| 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 3481 2018-11-02 09:14:13Z raasch $ |
|---|
| 27 | ! temporary variable cc introduced to circumvent a possible Intel18 compiler bug |
|---|
| 28 | ! related to contiguous/non-contguous pointer/target attributes |
|---|
| 29 | ! |
|---|
| 30 | ! 3473 2018-10-30 20:50:15Z suehring |
|---|
| 31 | ! NetCDF input routine renamed |
|---|
| 32 | ! |
|---|
| 33 | ! 3467 2018-10-30 19:05:21Z suehring |
|---|
| 34 | ! Initial revision |
|---|
| 35 | ! |
|---|
| 36 | ! 3412 2018-10-24 07:25:57Z monakurppa |
|---|
| 37 | ! |
|---|
| 38 | ! Authors: |
|---|
| 39 | ! -------- |
|---|
| 40 | ! @author monakurppa |
|---|
| 41 | ! |
|---|
| 42 | ! |
|---|
| 43 | ! Description: |
|---|
| 44 | ! ------------ |
|---|
| 45 | !> Sectional aerosol module for large scale applications SALSA |
|---|
| 46 | !> (Kokkola et al., 2008, ACP 8, 2469-2483). Solves the aerosol number and mass |
|---|
| 47 | !> concentration as well as chemical composition. Includes aerosol dynamic |
|---|
| 48 | !> processes: nucleation, condensation/evaporation of vapours, coagulation and |
|---|
| 49 | !> deposition on tree leaves, ground and roofs. |
|---|
| 50 | !> Implementation is based on formulations implemented in UCLALES-SALSA except |
|---|
| 51 | !> for deposition which is based on parametrisations by Zhang et al. (2001, |
|---|
| 52 | !> Atmos. Environ. 35, 549-560) or Petroff&Zhang (2010, Geosci. Model Dev. 3, |
|---|
| 53 | !> 753-769) |
|---|
| 54 | !> |
|---|
| 55 | !> @todo Implement turbulent inflow of aerosols in inflow_turbulence. |
|---|
| 56 | !> @todo Deposition on walls and horizontal surfaces calculated from the aerosol |
|---|
| 57 | !> dry radius, not wet |
|---|
| 58 | !> @todo Deposition on subgrid scale vegetation |
|---|
| 59 | !> @todo Deposition on vegetation calculated by default for deciduous broadleaf |
|---|
| 60 | !> trees |
|---|
| 61 | !> @todo Revise masked data output. There is a potential bug in case of |
|---|
| 62 | !> terrain-following masked output, according to data_output_mask. |
|---|
| 63 | !> @todo There are now improved interfaces for NetCDF data input which can be |
|---|
| 64 | !> used instead of get variable etc. |
|---|
| 65 | !------------------------------------------------------------------------------! |
|---|
| 66 | MODULE salsa_mod |
|---|
| 67 | |
|---|
| 68 | USE basic_constants_and_equations_mod, & |
|---|
| 69 | ONLY: c_p, g, p_0, pi, r_d |
|---|
| 70 | |
|---|
| 71 | USE chemistry_model_mod, & |
|---|
| 72 | ONLY: chem_species, nspec, nvar, spc_names |
|---|
| 73 | |
|---|
| 74 | USE chem_modules, & |
|---|
| 75 | ONLY: call_chem_at_all_substeps, chem_gasphase_on |
|---|
| 76 | |
|---|
| 77 | USE control_parameters |
|---|
| 78 | |
|---|
| 79 | USE indices, & |
|---|
| 80 | ONLY: nbgp, nx, nxl, nxlg, nxr, nxrg, ny, nyn, nyng, nys, nysg, nzb, & |
|---|
| 81 | nzb_s_inner, nz, nzt, wall_flags_0 |
|---|
| 82 | |
|---|
| 83 | USE kinds |
|---|
| 84 | |
|---|
| 85 | USE pegrid |
|---|
| 86 | |
|---|
| 87 | USE salsa_util_mod |
|---|
| 88 | |
|---|
| 89 | IMPLICIT NONE |
|---|
| 90 | ! |
|---|
| 91 | !-- SALSA constants: |
|---|
| 92 | ! |
|---|
| 93 | !-- Local constants: |
|---|
| 94 | INTEGER(iwp), PARAMETER :: ngast = 5 !< total number of gaseous tracers: |
|---|
| 95 | !< 1 = H2SO4, 2 = HNO3, 3 = NH3, |
|---|
| 96 | !< 4 = OCNV (non-volatile OC), |
|---|
| 97 | !< 5 = OCSV (semi-volatile) |
|---|
| 98 | INTEGER(iwp), PARAMETER :: nmod = 7 !< number of modes for initialising |
|---|
| 99 | !< the aerosol size distribution |
|---|
| 100 | INTEGER(iwp), PARAMETER :: nreg = 2 !< Number of main size subranges |
|---|
| 101 | INTEGER(iwp), PARAMETER :: maxspec = 7 !< Max. number of aerosol species |
|---|
| 102 | ! |
|---|
| 103 | !-- Universal constants |
|---|
| 104 | REAL(wp), PARAMETER :: abo = 1.380662E-23_wp !< Boltzmann constant (J/K) |
|---|
| 105 | REAL(wp), PARAMETER :: alv = 2.260E+6_wp !< latent heat for H2O |
|---|
| 106 | !< vaporisation (J/kg) |
|---|
| 107 | REAL(wp), PARAMETER :: alv_d_rv = 4896.96865_wp !< alv / rv |
|---|
| 108 | REAL(wp), PARAMETER :: am_airmol = 4.8096E-26_wp !< Average mass of one air |
|---|
| 109 | !< molecule (Jacobson, |
|---|
| 110 | !< 2005, Eq. 2.3) |
|---|
| 111 | REAL(wp), PARAMETER :: api6 = 0.5235988_wp !< pi / 6 |
|---|
| 112 | REAL(wp), PARAMETER :: argas = 8.314409_wp !< Gas constant (J/(mol K)) |
|---|
| 113 | REAL(wp), PARAMETER :: argas_d_cpd = 8.281283865E-3_wp !< argas per cpd |
|---|
| 114 | REAL(wp), PARAMETER :: avo = 6.02214E+23_wp !< Avogadro constant (1/mol) |
|---|
| 115 | REAL(wp), PARAMETER :: d_sa = 5.539376964394570E-10_wp !< diameter of |
|---|
| 116 | !< condensing sulphuric |
|---|
| 117 | !< acid molecule (m) |
|---|
| 118 | REAL(wp), PARAMETER :: for_ppm_to_nconc = 7.243016311E+16_wp !< |
|---|
| 119 | !< ppm * avo / R (K/(Pa*m3)) |
|---|
| 120 | REAL(wp), PARAMETER :: epsoc = 0.15_wp !< water uptake of organic |
|---|
| 121 | !< material |
|---|
| 122 | REAL(wp), PARAMETER :: mclim = 1.0E-23_wp !< mass concentration min |
|---|
| 123 | !< limit for aerosols (kg/m3) |
|---|
| 124 | REAL(wp), PARAMETER :: n3 = 158.79_wp !< Number of H2SO4 molecules in |
|---|
| 125 | !< 3 nm cluster if d_sa=5.54e-10m |
|---|
| 126 | REAL(wp), PARAMETER :: nclim = 1.0_wp !< number concentration min limit |
|---|
| 127 | !< for aerosols and gases (#/m3) |
|---|
| 128 | REAL(wp), PARAMETER :: surfw0 = 0.073_wp !< surface tension of pure water |
|---|
| 129 | !< at ~ 293 K (J/m2) |
|---|
| 130 | REAL(wp), PARAMETER :: vclim = 1.0E-24_wp !< volume concentration min |
|---|
| 131 | !< limit for aerosols (m3/m3) |
|---|
| 132 | !-- Molar masses in kg/mol |
|---|
| 133 | REAL(wp), PARAMETER :: ambc = 12.0E-3_wp !< black carbon (BC) |
|---|
| 134 | REAL(wp), PARAMETER :: amdair = 28.970E-3_wp !< dry air |
|---|
| 135 | REAL(wp), PARAMETER :: amdu = 100.E-3_wp !< mineral dust |
|---|
| 136 | REAL(wp), PARAMETER :: amh2o = 18.0154E-3_wp !< H2O |
|---|
| 137 | REAL(wp), PARAMETER :: amh2so4 = 98.06E-3_wp !< H2SO4 |
|---|
| 138 | REAL(wp), PARAMETER :: amhno3 = 63.01E-3_wp !< HNO3 |
|---|
| 139 | REAL(wp), PARAMETER :: amn2o = 44.013E-3_wp !< N2O |
|---|
| 140 | REAL(wp), PARAMETER :: amnh3 = 17.031E-3_wp !< NH3 |
|---|
| 141 | REAL(wp), PARAMETER :: amo2 = 31.9988E-3_wp !< O2 |
|---|
| 142 | REAL(wp), PARAMETER :: amo3 = 47.998E-3_wp !< O3 |
|---|
| 143 | REAL(wp), PARAMETER :: amoc = 150.E-3_wp !< organic carbon (OC) |
|---|
| 144 | REAL(wp), PARAMETER :: amss = 58.44E-3_wp !< sea salt (NaCl) |
|---|
| 145 | !-- Densities in kg/m3 |
|---|
| 146 | REAL(wp), PARAMETER :: arhobc = 2000.0_wp !< black carbon |
|---|
| 147 | REAL(wp), PARAMETER :: arhodu = 2650.0_wp !< mineral dust |
|---|
| 148 | REAL(wp), PARAMETER :: arhoh2o = 1000.0_wp !< H2O |
|---|
| 149 | REAL(wp), PARAMETER :: arhoh2so4 = 1830.0_wp !< SO4 |
|---|
| 150 | REAL(wp), PARAMETER :: arhohno3 = 1479.0_wp !< HNO3 |
|---|
| 151 | REAL(wp), PARAMETER :: arhonh3 = 1530.0_wp !< NH3 |
|---|
| 152 | REAL(wp), PARAMETER :: arhooc = 2000.0_wp !< organic carbon |
|---|
| 153 | REAL(wp), PARAMETER :: arhoss = 2165.0_wp !< sea salt (NaCl) |
|---|
| 154 | !-- Volume of molecule in m3/# |
|---|
| 155 | REAL(wp), PARAMETER :: amvh2o = amh2o /avo / arhoh2o !< H2O |
|---|
| 156 | REAL(wp), PARAMETER :: amvh2so4 = amh2so4 / avo / arhoh2so4 !< SO4 |
|---|
| 157 | REAL(wp), PARAMETER :: amvhno3 = amhno3 / avo / arhohno3 !< HNO3 |
|---|
| 158 | REAL(wp), PARAMETER :: amvnh3 = amnh3 / avo / arhonh3 !< NH3 |
|---|
| 159 | REAL(wp), PARAMETER :: amvoc = amoc / avo / arhooc !< OC |
|---|
| 160 | REAL(wp), PARAMETER :: amvss = amss / avo / arhoss !< sea salt |
|---|
| 161 | |
|---|
| 162 | ! |
|---|
| 163 | !-- SALSA switches: |
|---|
| 164 | INTEGER(iwp) :: nj3 = 1 !< J3 parametrization (nucleation) |
|---|
| 165 | !< 1 = condensational sink (Kerminen&Kulmala, 2002) |
|---|
| 166 | !< 2 = coagulational sink (Lehtinen et al. 2007) |
|---|
| 167 | !< 3 = coagS+self-coagulation (Anttila et al. 2010) |
|---|
| 168 | INTEGER(iwp) :: nsnucl = 0 !< Choice of the nucleation scheme: |
|---|
| 169 | !< 0 = off |
|---|
| 170 | !< 1 = binary nucleation |
|---|
| 171 | !< 2 = activation type nucleation |
|---|
| 172 | !< 3 = kinetic nucleation |
|---|
| 173 | !< 4 = ternary nucleation |
|---|
| 174 | !< 5 = nucleation with ORGANICs |
|---|
| 175 | !< 6 = activation type of nucleation with |
|---|
| 176 | !< H2SO4+ORG |
|---|
| 177 | !< 7 = heteromolecular nucleation with H2SO4*ORG |
|---|
| 178 | !< 8 = homomolecular nucleation of H2SO4 + |
|---|
| 179 | !< heteromolecular nucleation with H2SO4*ORG |
|---|
| 180 | !< 9 = homomolecular nucleation of H2SO4 and ORG |
|---|
| 181 | !< +heteromolecular nucleation with H2SO4*ORG |
|---|
| 182 | LOGICAL :: advect_particle_water = .TRUE. !< advect water concentration of |
|---|
| 183 | !< particles |
|---|
| 184 | LOGICAL :: decycle_lr = .FALSE. !< Undo cyclic boundary |
|---|
| 185 | !< conditions: left and right |
|---|
| 186 | LOGICAL :: decycle_ns = .FALSE. !< north and south boundaries |
|---|
| 187 | LOGICAL :: feedback_to_palm = .FALSE. !< allow feedback due to |
|---|
| 188 | !< hydration and/or condensation |
|---|
| 189 | !< of H20 |
|---|
| 190 | LOGICAL :: no_insoluble = .FALSE. !< Switch to exclude insoluble |
|---|
| 191 | !< chemical components |
|---|
| 192 | LOGICAL :: read_restart_data_salsa = .FALSE. !< read restart data for salsa |
|---|
| 193 | LOGICAL :: salsa = .FALSE. !< SALSA master switch |
|---|
| 194 | LOGICAL :: salsa_gases_from_chem = .FALSE. !< Transfer the gaseous |
|---|
| 195 | !< components to SALSA from |
|---|
| 196 | !< from chemistry model |
|---|
| 197 | LOGICAL :: van_der_waals_coagc = .FALSE. !< Enhancement of coagulation |
|---|
| 198 | !< kernel by van der Waals and |
|---|
| 199 | !< viscous forces |
|---|
| 200 | LOGICAL :: write_binary_salsa = .FALSE. !< read binary for salsa |
|---|
| 201 | !-- Process switches: nl* is read from the NAMELIST and is NOT changed. |
|---|
| 202 | !-- ls* is the switch used and will get the value of nl* |
|---|
| 203 | !-- except for special circumstances (spinup period etc.) |
|---|
| 204 | LOGICAL :: nlcoag = .FALSE. !< Coagulation master switch |
|---|
| 205 | LOGICAL :: lscoag = .FALSE. !< |
|---|
| 206 | LOGICAL :: nlcnd = .FALSE. !< Condensation master switch |
|---|
| 207 | LOGICAL :: lscnd = .FALSE. !< |
|---|
| 208 | LOGICAL :: nlcndgas = .FALSE. !< Condensation of precursor gases |
|---|
| 209 | LOGICAL :: lscndgas = .FALSE. !< |
|---|
| 210 | LOGICAL :: nlcndh2oae = .FALSE. !< Condensation of H2O on aerosol |
|---|
| 211 | LOGICAL :: lscndh2oae = .FALSE. !< particles (FALSE -> equilibrium calc.) |
|---|
| 212 | LOGICAL :: nldepo = .FALSE. !< Deposition master switch |
|---|
| 213 | LOGICAL :: lsdepo = .FALSE. !< |
|---|
| 214 | LOGICAL :: nldepo_topo = .FALSE. !< Deposition on vegetation master switch |
|---|
| 215 | LOGICAL :: lsdepo_topo = .FALSE. !< |
|---|
| 216 | LOGICAL :: nldepo_vege = .FALSE. !< Deposition on walls master switch |
|---|
| 217 | LOGICAL :: lsdepo_vege = .FALSE. !< |
|---|
| 218 | LOGICAL :: nldistupdate = .TRUE. !< Size distribution update master switch |
|---|
| 219 | LOGICAL :: lsdistupdate = .FALSE. !< |
|---|
| 220 | ! |
|---|
| 221 | !-- SALSA variables: |
|---|
| 222 | CHARACTER (LEN=20) :: bc_salsa_b = 'neumann' !< bottom boundary condition |
|---|
| 223 | CHARACTER (LEN=20) :: bc_salsa_t = 'neumann' !< top boundary condition |
|---|
| 224 | CHARACTER (LEN=20) :: depo_vege_type = 'zhang2001' !< or 'petroff2010' |
|---|
| 225 | CHARACTER (LEN=20) :: depo_topo_type = 'zhang2001' !< or 'petroff2010' |
|---|
| 226 | CHARACTER (LEN=20), DIMENSION(4) :: decycle_method = & |
|---|
| 227 | (/'dirichlet','dirichlet','dirichlet','dirichlet'/) |
|---|
| 228 | !< Decycling method at horizontal boundaries, |
|---|
| 229 | !< 1=left, 2=right, 3=south, 4=north |
|---|
| 230 | !< dirichlet = initial size distribution and |
|---|
| 231 | !< chemical composition set for the ghost and |
|---|
| 232 | !< first three layers |
|---|
| 233 | !< neumann = zero gradient |
|---|
| 234 | CHARACTER (LEN=3), DIMENSION(maxspec) :: listspec = & !< Active aerosols |
|---|
| 235 | (/'SO4',' ',' ',' ',' ',' ',' '/) |
|---|
| 236 | CHARACTER (LEN=20) :: salsa_source_mode = 'no_source' |
|---|
| 237 | !< 'read_from_file', |
|---|
| 238 | !< 'constant' or 'no_source' |
|---|
| 239 | INTEGER(iwp) :: dots_salsa = 0 !< starting index for salsa-timeseries |
|---|
| 240 | INTEGER(iwp) :: fn1a = 1 !< last index for bin subranges: subrange 1a |
|---|
| 241 | INTEGER(iwp) :: fn2a = 1 !< subrange 2a |
|---|
| 242 | INTEGER(iwp) :: fn2b = 1 !< subrange 2b |
|---|
| 243 | INTEGER(iwp), DIMENSION(ngast) :: gas_index_chem = (/ 1, 1, 1, 1, 1/) !< |
|---|
| 244 | !< Index of gaseous compounds in the chemistry |
|---|
| 245 | !< model. In SALSA, 1 = H2SO4, 2 = HNO3, |
|---|
| 246 | !< 3 = NH3, 4 = OCNV, 5 = OCSV |
|---|
| 247 | INTEGER(iwp) :: ibc_salsa_b !< |
|---|
| 248 | INTEGER(iwp) :: ibc_salsa_t !< |
|---|
| 249 | INTEGER(iwp) :: igctyp = 0 !< Initial gas concentration type |
|---|
| 250 | !< 0 = uniform (use H2SO4_init, HNO3_init, |
|---|
| 251 | !< NH3_init, OCNV_init and OCSV_init) |
|---|
| 252 | !< 1 = read vertical profile from an input file |
|---|
| 253 | INTEGER(iwp) :: in1a = 1 !< start index for bin subranges: subrange 1a |
|---|
| 254 | INTEGER(iwp) :: in2a = 1 !< subrange 2a |
|---|
| 255 | INTEGER(iwp) :: in2b = 1 !< subrange 2b |
|---|
| 256 | INTEGER(iwp) :: isdtyp = 0 !< Initial size distribution type |
|---|
| 257 | !< 0 = uniform |
|---|
| 258 | !< 1 = read vertical profile of the mode number |
|---|
| 259 | !< concentration from an input file |
|---|
| 260 | INTEGER(iwp) :: ibc = -1 !< Indice for: black carbon (BC) |
|---|
| 261 | INTEGER(iwp) :: idu = -1 !< dust |
|---|
| 262 | INTEGER(iwp) :: inh = -1 !< NH3 |
|---|
| 263 | INTEGER(iwp) :: ino = -1 !< HNO3 |
|---|
| 264 | INTEGER(iwp) :: ioc = -1 !< organic carbon (OC) |
|---|
| 265 | INTEGER(iwp) :: iso4 = -1 !< SO4 or H2SO4 |
|---|
| 266 | INTEGER(iwp) :: iss = -1 !< sea salt |
|---|
| 267 | INTEGER(iwp) :: lod_aero = 0 !< level of detail for aerosol emissions |
|---|
| 268 | INTEGER(iwp) :: lod_gases = 0 !< level of detail for gaseous emissions |
|---|
| 269 | INTEGER(iwp), DIMENSION(nreg) :: nbin = (/ 3, 7/) !< Number of size bins |
|---|
| 270 | !< for each aerosol size subrange |
|---|
| 271 | INTEGER(iwp) :: nbins = 1 !< total number of size bins |
|---|
| 272 | INTEGER(iwp) :: ncc = 1 !< number of chemical components used |
|---|
| 273 | INTEGER(iwp) :: ncc_tot = 1!< total number of chemical compounds (ncc+1 |
|---|
| 274 | !< if particle water is advected) |
|---|
| 275 | REAL(wp) :: act_coeff = 1.0E-7_wp !< Activation coefficient |
|---|
| 276 | REAL(wp) :: aerosol_source = 0.0_wp !< Constant aerosol flux (#/(m3*s)) |
|---|
| 277 | REAL(wp), ALLOCATABLE, DIMENSION(:,:) :: emission_mass_fracs !< array for |
|---|
| 278 | !< aerosol composition per emission category |
|---|
| 279 | !< 1:SO4 2:OC 3:BC 4:DU 5:SS 6:NO 7:NH |
|---|
| 280 | REAL(wp) :: dt_salsa = 0.00001_wp !< Time step of SALSA |
|---|
| 281 | REAL(wp) :: H2SO4_init = nclim !< Init value for sulphuric acid gas |
|---|
| 282 | REAL(wp) :: HNO3_init = nclim !< Init value for nitric acid gas |
|---|
| 283 | REAL(wp) :: last_salsa_time = 0.0_wp !< time of the previous salsa |
|---|
| 284 | !< timestep |
|---|
| 285 | REAL(wp) :: nf2a = 1.0_wp !< Number fraction allocated to a- |
|---|
| 286 | !< bins in subrange 2 |
|---|
| 287 | !< (b-bins will get 1-nf2a) |
|---|
| 288 | REAL(wp) :: NH3_init = nclim !< Init value for ammonia gas |
|---|
| 289 | REAL(wp) :: OCNV_init = nclim !< Init value for non-volatile |
|---|
| 290 | !< organic gases |
|---|
| 291 | REAL(wp) :: OCSV_init = nclim !< Init value for semi-volatile |
|---|
| 292 | !< organic gases |
|---|
| 293 | REAL(wp), DIMENSION(nreg+1) :: reglim = & !< Min&max diameters of size subranges |
|---|
| 294 | (/ 3.0E-9_wp, 5.0E-8_wp, 1.0E-5_wp/) |
|---|
| 295 | REAL(wp) :: rhlim = 1.20_wp !< RH limit in %/100. Prevents |
|---|
| 296 | !< unrealistically high RH in condensation |
|---|
| 297 | REAL(wp) :: skip_time_do_salsa = 0.0_wp !< Starting time of SALSA (s) |
|---|
| 298 | !-- Initial log-normal size distribution: mode diameter (dpg, micrometres), |
|---|
| 299 | !-- standard deviation (sigmag) and concentration (n_lognorm, #/cm3) |
|---|
| 300 | REAL(wp), DIMENSION(nmod) :: dpg = (/0.013_wp, 0.054_wp, 0.86_wp, & |
|---|
| 301 | 0.2_wp, 0.2_wp, 0.2_wp, 0.2_wp/) |
|---|
| 302 | REAL(wp), DIMENSION(nmod) :: sigmag = (/1.8_wp, 2.16_wp, 2.21_wp, & |
|---|
| 303 | 2.0_wp, 2.0_wp, 2.0_wp, 2.0_wp/) |
|---|
| 304 | REAL(wp), DIMENSION(nmod) :: n_lognorm = (/1.04e+5_wp, 3.23E+4_wp, 5.4_wp,& |
|---|
| 305 | 0.0_wp, 0.0_wp, 0.0_wp, 0.0_wp/) |
|---|
| 306 | !-- Initial mass fractions / chemical composition of the size distribution |
|---|
| 307 | REAL(wp), DIMENSION(maxspec) :: mass_fracs_a = & !< mass fractions between |
|---|
| 308 | (/1.0, 0.0, 0.0, 0.0, 0.0, 0.0, 0.0/) !< aerosol species for A bins |
|---|
| 309 | REAL(wp), DIMENSION(maxspec) :: mass_fracs_b = & !< mass fractions between |
|---|
| 310 | (/0.0, 0.0, 0.0, 0.0, 0.0, 0.0, 0.0/) !< aerosol species for B bins |
|---|
| 311 | |
|---|
| 312 | REAL(wp), ALLOCATABLE, DIMENSION(:) :: bin_low_limits !< to deliver |
|---|
| 313 | !< information about |
|---|
| 314 | !< the lower |
|---|
| 315 | !< diameters per bin |
|---|
| 316 | REAL(wp), ALLOCATABLE, DIMENSION(:) :: nsect !< Background number |
|---|
| 317 | !< concentration per bin |
|---|
| 318 | REAL(wp), ALLOCATABLE, DIMENSION(:) :: massacc !< Mass accomodation |
|---|
| 319 | !< coefficients per bin |
|---|
| 320 | ! |
|---|
| 321 | !-- SALSA derived datatypes: |
|---|
| 322 | ! |
|---|
| 323 | !-- Prognostic variable: Aerosol size bin information (number (#/m3) and |
|---|
| 324 | !-- mass (kg/m3) concentration) and the concentration of gaseous tracers (#/m3). |
|---|
| 325 | !-- Gas tracers are contained sequentially in dimension 4 as: |
|---|
| 326 | !-- 1. H2SO4, 2. HNO3, 3. NH3, 4. OCNV (non-volatile organics), |
|---|
| 327 | !-- 5. OCSV (semi-volatile) |
|---|
| 328 | TYPE salsa_variable |
|---|
| 329 | REAL(wp), POINTER, DIMENSION(:,:,:), CONTIGUOUS :: conc |
|---|
| 330 | REAL(wp), POINTER, DIMENSION(:,:,:), CONTIGUOUS :: conc_p |
|---|
| 331 | REAL(wp), POINTER, DIMENSION(:,:,:), CONTIGUOUS :: tconc_m |
|---|
| 332 | REAL(wp), ALLOCATABLE, DIMENSION(:,:) :: flux_s, diss_s |
|---|
| 333 | REAL(wp), ALLOCATABLE, DIMENSION(:,:,:) :: flux_l, diss_l |
|---|
| 334 | REAL(wp), ALLOCATABLE, DIMENSION(:) :: init |
|---|
| 335 | REAL(wp), ALLOCATABLE, DIMENSION(:,:,:) :: source |
|---|
| 336 | REAL(wp), ALLOCATABLE, DIMENSION(:,:) :: sums_ws_l |
|---|
| 337 | END TYPE salsa_variable |
|---|
| 338 | |
|---|
| 339 | !-- Map bin indices between parallel size distributions |
|---|
| 340 | TYPE t_parallelbin |
|---|
| 341 | INTEGER(iwp) :: cur ! Index for current distribution |
|---|
| 342 | INTEGER(iwp) :: par ! Index for corresponding parallel distribution |
|---|
| 343 | END TYPE t_parallelbin |
|---|
| 344 | |
|---|
| 345 | !-- Datatype used to store information about the binned size distributions of |
|---|
| 346 | !-- aerosols |
|---|
| 347 | TYPE t_section |
|---|
| 348 | REAL(wp) :: vhilim !< bin volume at the high limit |
|---|
| 349 | REAL(wp) :: vlolim !< bin volume at the low limit |
|---|
| 350 | REAL(wp) :: vratiohi !< volume ratio between the center and high limit |
|---|
| 351 | REAL(wp) :: vratiolo !< volume ratio between the center and low limit |
|---|
| 352 | REAL(wp) :: dmid !< bin middle diameter (m) |
|---|
| 353 | !****************************************************** |
|---|
| 354 | ! ^ Do NOT change the stuff above after initialization ! |
|---|
| 355 | !****************************************************** |
|---|
| 356 | REAL(wp) :: dwet !< Wet diameter or mean droplet diameter (m) |
|---|
| 357 | REAL(wp), DIMENSION(maxspec+1) :: volc !< Volume concentrations |
|---|
| 358 | !< (m^3/m^3) of aerosols + water. Since most of |
|---|
| 359 | !< the stuff in SALSA is hard coded, these *have to |
|---|
| 360 | !< be* in the order |
|---|
| 361 | !< 1:SO4, 2:OC, 3:BC, 4:DU, 5:SS, 6:NO, 7:NH, 8:H2O |
|---|
| 362 | REAL(wp) :: veqh2o !< Equilibrium H2O concentration for each particle |
|---|
| 363 | REAL(wp) :: numc !< Number concentration of particles/droplets (#/m3) |
|---|
| 364 | REAL(wp) :: core !< Volume of dry particle |
|---|
| 365 | END TYPE t_section |
|---|
| 366 | ! |
|---|
| 367 | !-- Local aerosol properties in SALSA |
|---|
| 368 | TYPE(t_section), ALLOCATABLE :: aero(:) |
|---|
| 369 | ! |
|---|
| 370 | !-- SALSA tracers: |
|---|
| 371 | !-- Tracers as x = x(k,j,i,bin). The 4th dimension contains all the size bins |
|---|
| 372 | !-- sequentially for each aerosol species + water. |
|---|
| 373 | ! |
|---|
| 374 | !-- Prognostic tracers: |
|---|
| 375 | ! |
|---|
| 376 | !-- Number concentration (#/m3) |
|---|
| 377 | TYPE(salsa_variable), ALLOCATABLE, DIMENSION(:), TARGET :: aerosol_number |
|---|
| 378 | REAL(wp), ALLOCATABLE, DIMENSION(:,:,:,:), TARGET :: nconc_1 |
|---|
| 379 | REAL(wp), ALLOCATABLE, DIMENSION(:,:,:,:), TARGET :: nconc_2 |
|---|
| 380 | REAL(wp), ALLOCATABLE, DIMENSION(:,:,:,:), TARGET :: nconc_3 |
|---|
| 381 | ! |
|---|
| 382 | !-- Mass concentration (kg/m3) |
|---|
| 383 | TYPE(salsa_variable), ALLOCATABLE, DIMENSION(:), TARGET :: aerosol_mass |
|---|
| 384 | REAL(wp), ALLOCATABLE, DIMENSION(:,:,:,:), TARGET :: mconc_1 |
|---|
| 385 | REAL(wp), ALLOCATABLE, DIMENSION(:,:,:,:), TARGET :: mconc_2 |
|---|
| 386 | REAL(wp), ALLOCATABLE, DIMENSION(:,:,:,:), TARGET :: mconc_3 |
|---|
| 387 | ! |
|---|
| 388 | !-- Gaseous tracers (#/m3) |
|---|
| 389 | TYPE(salsa_variable), ALLOCATABLE, DIMENSION(:), TARGET :: salsa_gas |
|---|
| 390 | REAL(wp), ALLOCATABLE, DIMENSION(:,:,:,:), TARGET :: gconc_1 |
|---|
| 391 | REAL(wp), ALLOCATABLE, DIMENSION(:,:,:,:), TARGET :: gconc_2 |
|---|
| 392 | REAL(wp), ALLOCATABLE, DIMENSION(:,:,:,:), TARGET :: gconc_3 |
|---|
| 393 | ! |
|---|
| 394 | !-- Diagnostic tracers |
|---|
| 395 | REAL(wp), ALLOCATABLE, DIMENSION(:,:,:,:) :: sedim_vd !< sedimentation |
|---|
| 396 | !< velocity per size |
|---|
| 397 | !< bin (m/s) |
|---|
| 398 | REAL(wp), ALLOCATABLE, DIMENSION(:,:,:,:) :: Ra_dry !< dry radius (m) |
|---|
| 399 | |
|---|
| 400 | !-- Particle component index tables |
|---|
| 401 | TYPE(component_index) :: prtcl !< Contains "getIndex" which gives the index |
|---|
| 402 | !< for a given aerosol component name, i.e. |
|---|
| 403 | !< 1:SO4, 2:OC, 3:BC, 4:DU, |
|---|
| 404 | !< 5:SS, 6:NO, 7:NH, 8:H2O |
|---|
| 405 | ! |
|---|
| 406 | !-- Data output arrays: |
|---|
| 407 | !-- Gases: |
|---|
| 408 | REAL(wp), ALLOCATABLE, DIMENSION(:,:,:), TARGET :: g_H2SO4_av !< H2SO4 |
|---|
| 409 | REAL(wp), ALLOCATABLE, DIMENSION(:,:,:), TARGET :: g_HNO3_av !< HNO3 |
|---|
| 410 | REAL(wp), ALLOCATABLE, DIMENSION(:,:,:), TARGET :: g_NH3_av !< NH3 |
|---|
| 411 | REAL(wp), ALLOCATABLE, DIMENSION(:,:,:), TARGET :: g_OCNV_av !< non-vola- |
|---|
| 412 | !< tile OC |
|---|
| 413 | REAL(wp), ALLOCATABLE, DIMENSION(:,:,:), TARGET :: g_OCSV_av !< semi-vol. |
|---|
| 414 | !< OC |
|---|
| 415 | !-- Integrated: |
|---|
| 416 | REAL(wp), ALLOCATABLE, DIMENSION(:,:,:) :: LDSA_av !< lung deposited |
|---|
| 417 | !< surface area |
|---|
| 418 | REAL(wp), ALLOCATABLE, DIMENSION(:,:,:) :: Ntot_av !< total number conc. |
|---|
| 419 | REAL(wp), ALLOCATABLE, DIMENSION(:,:,:) :: PM25_av !< PM2.5 |
|---|
| 420 | REAL(wp), ALLOCATABLE, DIMENSION(:,:,:) :: PM10_av !< PM10 |
|---|
| 421 | !-- In the particle phase: |
|---|
| 422 | REAL(wp), ALLOCATABLE, DIMENSION(:,:,:), TARGET :: s_BC_av !< black carbon |
|---|
| 423 | REAL(wp), ALLOCATABLE, DIMENSION(:,:,:), TARGET :: s_DU_av !< dust |
|---|
| 424 | REAL(wp), ALLOCATABLE, DIMENSION(:,:,:), TARGET :: s_H2O_av !< liquid water |
|---|
| 425 | REAL(wp), ALLOCATABLE, DIMENSION(:,:,:), TARGET :: s_NH_av !< ammonia |
|---|
| 426 | REAL(wp), ALLOCATABLE, DIMENSION(:,:,:), TARGET :: s_NO_av !< nitrates |
|---|
| 427 | REAL(wp), ALLOCATABLE, DIMENSION(:,:,:), TARGET :: s_OC_av !< org. carbon |
|---|
| 428 | REAL(wp), ALLOCATABLE, DIMENSION(:,:,:), TARGET :: s_SO4_av !< sulphates |
|---|
| 429 | REAL(wp), ALLOCATABLE, DIMENSION(:,:,:), TARGET :: s_SS_av !< sea salt |
|---|
| 430 | !-- Bins: |
|---|
| 431 | REAL(wp), ALLOCATABLE, DIMENSION(:,:,:,:) :: mbins_av !< bin mass |
|---|
| 432 | !< concentration |
|---|
| 433 | REAL(wp), ALLOCATABLE, DIMENSION(:,:,:,:) :: Nbins_av !< bin number |
|---|
| 434 | !< concentration |
|---|
| 435 | |
|---|
| 436 | ! |
|---|
| 437 | !-- PALM interfaces: |
|---|
| 438 | ! |
|---|
| 439 | !-- Boundary conditions: |
|---|
| 440 | INTERFACE salsa_boundary_conds |
|---|
| 441 | MODULE PROCEDURE salsa_boundary_conds |
|---|
| 442 | MODULE PROCEDURE salsa_boundary_conds_decycle |
|---|
| 443 | END INTERFACE salsa_boundary_conds |
|---|
| 444 | ! |
|---|
| 445 | !-- Data output checks for 2D/3D data to be done in check_parameters |
|---|
| 446 | INTERFACE salsa_check_data_output |
|---|
| 447 | MODULE PROCEDURE salsa_check_data_output |
|---|
| 448 | END INTERFACE salsa_check_data_output |
|---|
| 449 | |
|---|
| 450 | ! |
|---|
| 451 | !-- Input parameter checks to be done in check_parameters |
|---|
| 452 | INTERFACE salsa_check_parameters |
|---|
| 453 | MODULE PROCEDURE salsa_check_parameters |
|---|
| 454 | END INTERFACE salsa_check_parameters |
|---|
| 455 | |
|---|
| 456 | ! |
|---|
| 457 | !-- Averaging of 3D data for output |
|---|
| 458 | INTERFACE salsa_3d_data_averaging |
|---|
| 459 | MODULE PROCEDURE salsa_3d_data_averaging |
|---|
| 460 | END INTERFACE salsa_3d_data_averaging |
|---|
| 461 | |
|---|
| 462 | ! |
|---|
| 463 | !-- Data output of 2D quantities |
|---|
| 464 | INTERFACE salsa_data_output_2d |
|---|
| 465 | MODULE PROCEDURE salsa_data_output_2d |
|---|
| 466 | END INTERFACE salsa_data_output_2d |
|---|
| 467 | |
|---|
| 468 | ! |
|---|
| 469 | !-- Data output of 3D data |
|---|
| 470 | INTERFACE salsa_data_output_3d |
|---|
| 471 | MODULE PROCEDURE salsa_data_output_3d |
|---|
| 472 | END INTERFACE salsa_data_output_3d |
|---|
| 473 | |
|---|
| 474 | ! |
|---|
| 475 | !-- Data output of 3D data |
|---|
| 476 | INTERFACE salsa_data_output_mask |
|---|
| 477 | MODULE PROCEDURE salsa_data_output_mask |
|---|
| 478 | END INTERFACE salsa_data_output_mask |
|---|
| 479 | |
|---|
| 480 | ! |
|---|
| 481 | !-- Definition of data output quantities |
|---|
| 482 | INTERFACE salsa_define_netcdf_grid |
|---|
| 483 | MODULE PROCEDURE salsa_define_netcdf_grid |
|---|
| 484 | END INTERFACE salsa_define_netcdf_grid |
|---|
| 485 | |
|---|
| 486 | ! |
|---|
| 487 | !-- Output of information to the header file |
|---|
| 488 | INTERFACE salsa_header |
|---|
| 489 | MODULE PROCEDURE salsa_header |
|---|
| 490 | END INTERFACE salsa_header |
|---|
| 491 | |
|---|
| 492 | ! |
|---|
| 493 | !-- Initialization actions |
|---|
| 494 | INTERFACE salsa_init |
|---|
| 495 | MODULE PROCEDURE salsa_init |
|---|
| 496 | END INTERFACE salsa_init |
|---|
| 497 | |
|---|
| 498 | ! |
|---|
| 499 | !-- Initialization of arrays |
|---|
| 500 | INTERFACE salsa_init_arrays |
|---|
| 501 | MODULE PROCEDURE salsa_init_arrays |
|---|
| 502 | END INTERFACE salsa_init_arrays |
|---|
| 503 | |
|---|
| 504 | ! |
|---|
| 505 | !-- Writing of binary output for restart runs !!! renaming?! |
|---|
| 506 | INTERFACE salsa_wrd_local |
|---|
| 507 | MODULE PROCEDURE salsa_wrd_local |
|---|
| 508 | END INTERFACE salsa_wrd_local |
|---|
| 509 | |
|---|
| 510 | ! |
|---|
| 511 | !-- Reading of NAMELIST parameters |
|---|
| 512 | INTERFACE salsa_parin |
|---|
| 513 | MODULE PROCEDURE salsa_parin |
|---|
| 514 | END INTERFACE salsa_parin |
|---|
| 515 | |
|---|
| 516 | ! |
|---|
| 517 | !-- Reading of parameters for restart runs |
|---|
| 518 | INTERFACE salsa_rrd_local |
|---|
| 519 | MODULE PROCEDURE salsa_rrd_local |
|---|
| 520 | END INTERFACE salsa_rrd_local |
|---|
| 521 | |
|---|
| 522 | ! |
|---|
| 523 | !-- Swapping of time levels (required for prognostic variables) |
|---|
| 524 | INTERFACE salsa_swap_timelevel |
|---|
| 525 | MODULE PROCEDURE salsa_swap_timelevel |
|---|
| 526 | END INTERFACE salsa_swap_timelevel |
|---|
| 527 | |
|---|
| 528 | INTERFACE salsa_driver |
|---|
| 529 | MODULE PROCEDURE salsa_driver |
|---|
| 530 | END INTERFACE salsa_driver |
|---|
| 531 | |
|---|
| 532 | INTERFACE salsa_tendency |
|---|
| 533 | MODULE PROCEDURE salsa_tendency |
|---|
| 534 | MODULE PROCEDURE salsa_tendency_ij |
|---|
| 535 | END INTERFACE salsa_tendency |
|---|
| 536 | |
|---|
| 537 | |
|---|
| 538 | |
|---|
| 539 | SAVE |
|---|
| 540 | |
|---|
| 541 | PRIVATE |
|---|
| 542 | ! |
|---|
| 543 | !-- Public functions: |
|---|
| 544 | PUBLIC salsa_boundary_conds, salsa_check_data_output, & |
|---|
| 545 | salsa_check_parameters, salsa_3d_data_averaging, & |
|---|
| 546 | salsa_data_output_2d, salsa_data_output_3d, salsa_data_output_mask, & |
|---|
| 547 | salsa_define_netcdf_grid, salsa_diagnostics, salsa_driver, & |
|---|
| 548 | salsa_header, salsa_init, salsa_init_arrays, salsa_parin, & |
|---|
| 549 | salsa_rrd_local, salsa_swap_timelevel, salsa_tendency, & |
|---|
| 550 | salsa_wrd_local |
|---|
| 551 | ! |
|---|
| 552 | !-- Public parameters, constants and initial values |
|---|
| 553 | PUBLIC dots_salsa, dt_salsa, last_salsa_time, lsdepo, salsa, & |
|---|
| 554 | salsa_gases_from_chem, skip_time_do_salsa |
|---|
| 555 | ! |
|---|
| 556 | !-- Public prognostic variables |
|---|
| 557 | PUBLIC aerosol_mass, aerosol_number, fn2a, fn2b, gconc_2, in1a, in2b, & |
|---|
| 558 | mconc_2, nbins, ncc, ncc_tot, nclim, nconc_2, ngast, prtcl, Ra_dry, & |
|---|
| 559 | salsa_gas, sedim_vd |
|---|
| 560 | |
|---|
| 561 | CONTAINS |
|---|
| 562 | |
|---|
| 563 | !------------------------------------------------------------------------------! |
|---|
| 564 | ! Description: |
|---|
| 565 | ! ------------ |
|---|
| 566 | !> Parin for &salsa_par for new modules |
|---|
| 567 | !------------------------------------------------------------------------------! |
|---|
| 568 | SUBROUTINE salsa_parin |
|---|
| 569 | |
|---|
| 570 | IMPLICIT NONE |
|---|
| 571 | |
|---|
| 572 | CHARACTER (LEN=80) :: line !< dummy string that contains the current line |
|---|
| 573 | !< of the parameter file |
|---|
| 574 | |
|---|
| 575 | NAMELIST /salsa_parameters/ & |
|---|
| 576 | advect_particle_water, & ! Switch for advecting |
|---|
| 577 | ! particle water. If .FALSE., |
|---|
| 578 | ! equilibration is called at |
|---|
| 579 | ! each time step. |
|---|
| 580 | bc_salsa_b, & ! bottom boundary condition |
|---|
| 581 | bc_salsa_t, & ! top boundary condition |
|---|
| 582 | decycle_lr, & ! decycle SALSA components |
|---|
| 583 | decycle_method, & ! decycle method applied: |
|---|
| 584 | ! 1=left 2=right 3=south 4=north |
|---|
| 585 | decycle_ns, & ! decycle SALSA components |
|---|
| 586 | depo_vege_type, & ! Parametrisation type |
|---|
| 587 | depo_topo_type, & ! Parametrisation type |
|---|
| 588 | dpg, & ! Mean diameter for the initial |
|---|
| 589 | ! log-normal modes |
|---|
| 590 | dt_salsa, & ! SALSA timestep in seconds |
|---|
| 591 | feedback_to_palm, & ! allow feedback due to |
|---|
| 592 | ! hydration / condensation |
|---|
| 593 | H2SO4_init, & ! Init value for sulphuric acid |
|---|
| 594 | HNO3_init, & ! Init value for nitric acid |
|---|
| 595 | igctyp, & ! Initial gas concentration type |
|---|
| 596 | isdtyp, & ! Initial size distribution type |
|---|
| 597 | listspec, & ! List of actived aerosols |
|---|
| 598 | ! (string list) |
|---|
| 599 | mass_fracs_a, & ! Initial relative contribution |
|---|
| 600 | ! of each species to particle |
|---|
| 601 | ! volume in a-bins, 0 for unused |
|---|
| 602 | mass_fracs_b, & ! Initial relative contribution |
|---|
| 603 | ! of each species to particle |
|---|
| 604 | ! volume in b-bins, 0 for unused |
|---|
| 605 | n_lognorm, & ! Number concentration for the |
|---|
| 606 | ! log-normal modes |
|---|
| 607 | nbin, & ! Number of size bins for |
|---|
| 608 | ! aerosol size subranges 1 & 2 |
|---|
| 609 | nf2a, & ! Number fraction of particles |
|---|
| 610 | ! allocated to a-bins in |
|---|
| 611 | ! subrange 2 b-bins will get |
|---|
| 612 | ! 1-nf2a |
|---|
| 613 | NH3_init, & ! Init value for ammonia |
|---|
| 614 | nj3, & ! J3 parametrization |
|---|
| 615 | ! 1 = condensational sink |
|---|
| 616 | ! (Kerminen&Kulmala, 2002) |
|---|
| 617 | ! 2 = coagulational sink |
|---|
| 618 | ! (Lehtinen et al. 2007) |
|---|
| 619 | ! 3 = coagS+self-coagulation |
|---|
| 620 | ! (Anttila et al. 2010) |
|---|
| 621 | nlcnd, & ! Condensation master switch |
|---|
| 622 | nlcndgas, & ! Condensation of gases |
|---|
| 623 | nlcndh2oae, & ! Condensation of H2O |
|---|
| 624 | nlcoag, & ! Coagulation master switch |
|---|
| 625 | nldepo, & ! Deposition master switch |
|---|
| 626 | nldepo_vege, & ! Deposition on vegetation |
|---|
| 627 | ! master switch |
|---|
| 628 | nldepo_topo, & ! Deposition on topo master |
|---|
| 629 | ! switch |
|---|
| 630 | nldistupdate, & ! Size distribution update |
|---|
| 631 | ! master switch |
|---|
| 632 | nsnucl, & ! Nucleation scheme: |
|---|
| 633 | ! 0 = off, |
|---|
| 634 | ! 1 = binary nucleation |
|---|
| 635 | ! 2 = activation type nucleation |
|---|
| 636 | ! 3 = kinetic nucleation |
|---|
| 637 | ! 4 = ternary nucleation |
|---|
| 638 | ! 5 = nucleation with organics |
|---|
| 639 | ! 6 = activation type of |
|---|
| 640 | ! nucleation with H2SO4+ORG |
|---|
| 641 | ! 7 = heteromolecular nucleation |
|---|
| 642 | ! with H2SO4*ORG |
|---|
| 643 | ! 8 = homomolecular nucleation |
|---|
| 644 | ! of H2SO4 + heteromolecular |
|---|
| 645 | ! nucleation with H2SO4*ORG |
|---|
| 646 | ! 9 = homomolecular nucleation |
|---|
| 647 | ! of H2SO4 and ORG + hetero- |
|---|
| 648 | ! molecular nucleation with |
|---|
| 649 | ! H2SO4*ORG |
|---|
| 650 | OCNV_init, & ! Init value for non-volatile |
|---|
| 651 | ! organic gases |
|---|
| 652 | OCSV_init, & ! Init value for semi-volatile |
|---|
| 653 | ! organic gases |
|---|
| 654 | read_restart_data_salsa, & ! read restart data for |
|---|
| 655 | ! salsa |
|---|
| 656 | reglim, & ! Min&max diameter limits of |
|---|
| 657 | ! size subranges |
|---|
| 658 | salsa, & ! Master switch for SALSA |
|---|
| 659 | salsa_source_mode,& ! 'read_from_file' or 'constant' |
|---|
| 660 | ! or 'no_source' |
|---|
| 661 | sigmag, & ! stdev for the initial log- |
|---|
| 662 | ! normal modes |
|---|
| 663 | skip_time_do_salsa, & ! Starting time of SALSA (s) |
|---|
| 664 | van_der_waals_coagc,& ! include van der Waals forces |
|---|
| 665 | write_binary_salsa ! Write binary for salsa |
|---|
| 666 | |
|---|
| 667 | |
|---|
| 668 | line = ' ' |
|---|
| 669 | |
|---|
| 670 | ! |
|---|
| 671 | !-- Try to find salsa package |
|---|
| 672 | REWIND ( 11 ) |
|---|
| 673 | line = ' ' |
|---|
| 674 | DO WHILE ( INDEX( line, '&salsa_parameters' ) == 0 ) |
|---|
| 675 | READ ( 11, '(A)', END=10 ) line |
|---|
| 676 | ENDDO |
|---|
| 677 | BACKSPACE ( 11 ) |
|---|
| 678 | |
|---|
| 679 | ! |
|---|
| 680 | !-- Read user-defined namelist |
|---|
| 681 | READ ( 11, salsa_parameters ) |
|---|
| 682 | |
|---|
| 683 | ! |
|---|
| 684 | !-- Set flag that indicates that the new module is switched on |
|---|
| 685 | !-- Note that this parameter needs to be declared in modules.f90 |
|---|
| 686 | salsa = .TRUE. |
|---|
| 687 | |
|---|
| 688 | 10 CONTINUE |
|---|
| 689 | |
|---|
| 690 | END SUBROUTINE salsa_parin |
|---|
| 691 | |
|---|
| 692 | |
|---|
| 693 | !------------------------------------------------------------------------------! |
|---|
| 694 | ! Description: |
|---|
| 695 | ! ------------ |
|---|
| 696 | !> Check parameters routine for salsa. |
|---|
| 697 | !------------------------------------------------------------------------------! |
|---|
| 698 | SUBROUTINE salsa_check_parameters |
|---|
| 699 | |
|---|
| 700 | USE control_parameters, & |
|---|
| 701 | ONLY: message_string |
|---|
| 702 | |
|---|
| 703 | IMPLICIT NONE |
|---|
| 704 | |
|---|
| 705 | ! |
|---|
| 706 | !-- Checks go here (cf. check_parameters.f90). |
|---|
| 707 | IF ( salsa .AND. .NOT. humidity ) THEN |
|---|
| 708 | WRITE( message_string, * ) 'salsa = ', salsa, ' is ', & |
|---|
| 709 | 'not allowed with humidity = ', humidity |
|---|
| 710 | CALL message( 'check_parameters', 'SA0009', 1, 2, 0, 6, 0 ) |
|---|
| 711 | ENDIF |
|---|
| 712 | |
|---|
| 713 | IF ( bc_salsa_b == 'dirichlet' ) THEN |
|---|
| 714 | ibc_salsa_b = 0 |
|---|
| 715 | ELSEIF ( bc_salsa_b == 'neumann' ) THEN |
|---|
| 716 | ibc_salsa_b = 1 |
|---|
| 717 | ELSE |
|---|
| 718 | message_string = 'unknown boundary condition: bc_salsa_b = "' & |
|---|
| 719 | // TRIM( bc_salsa_t ) // '"' |
|---|
| 720 | CALL message( 'check_parameters', 'SA0011', 1, 2, 0, 6, 0 ) |
|---|
| 721 | ENDIF |
|---|
| 722 | |
|---|
| 723 | IF ( bc_salsa_t == 'dirichlet' ) THEN |
|---|
| 724 | ibc_salsa_t = 0 |
|---|
| 725 | ELSEIF ( bc_salsa_t == 'neumann' ) THEN |
|---|
| 726 | ibc_salsa_t = 1 |
|---|
| 727 | ELSE |
|---|
| 728 | message_string = 'unknown boundary condition: bc_salsa_t = "' & |
|---|
| 729 | // TRIM( bc_salsa_t ) // '"' |
|---|
| 730 | CALL message( 'check_parameters', 'SA0012', 1, 2, 0, 6, 0 ) |
|---|
| 731 | ENDIF |
|---|
| 732 | |
|---|
| 733 | IF ( nj3 < 1 .OR. nj3 > 3 ) THEN |
|---|
| 734 | message_string = 'unknown nj3 (must be 1-3)' |
|---|
| 735 | CALL message( 'check_parameters', 'SA0044', 1, 2, 0, 6, 0 ) |
|---|
| 736 | ENDIF |
|---|
| 737 | |
|---|
| 738 | END SUBROUTINE salsa_check_parameters |
|---|
| 739 | |
|---|
| 740 | !------------------------------------------------------------------------------! |
|---|
| 741 | ! |
|---|
| 742 | ! Description: |
|---|
| 743 | ! ------------ |
|---|
| 744 | !> Subroutine defining appropriate grid for netcdf variables. |
|---|
| 745 | !> It is called out from subroutine netcdf. |
|---|
| 746 | !> Same grid as for other scalars (see netcdf_interface_mod.f90) |
|---|
| 747 | !------------------------------------------------------------------------------! |
|---|
| 748 | SUBROUTINE salsa_define_netcdf_grid( var, found, grid_x, grid_y, grid_z ) |
|---|
| 749 | |
|---|
| 750 | IMPLICIT NONE |
|---|
| 751 | |
|---|
| 752 | CHARACTER (LEN=*), INTENT(OUT) :: grid_x !< |
|---|
| 753 | CHARACTER (LEN=*), INTENT(OUT) :: grid_y !< |
|---|
| 754 | CHARACTER (LEN=*), INTENT(OUT) :: grid_z !< |
|---|
| 755 | CHARACTER (LEN=*), INTENT(IN) :: var !< |
|---|
| 756 | |
|---|
| 757 | LOGICAL, INTENT(OUT) :: found !< |
|---|
| 758 | |
|---|
| 759 | found = .TRUE. |
|---|
| 760 | ! |
|---|
| 761 | !-- Check for the grid |
|---|
| 762 | |
|---|
| 763 | IF ( var(1:2) == 'g_' ) THEN |
|---|
| 764 | grid_x = 'x' |
|---|
| 765 | grid_y = 'y' |
|---|
| 766 | grid_z = 'zu' |
|---|
| 767 | ELSEIF ( var(1:4) == 'LDSA' ) THEN |
|---|
| 768 | grid_x = 'x' |
|---|
| 769 | grid_y = 'y' |
|---|
| 770 | grid_z = 'zu' |
|---|
| 771 | ELSEIF ( var(1:5) == 'm_bin' ) THEN |
|---|
| 772 | grid_x = 'x' |
|---|
| 773 | grid_y = 'y' |
|---|
| 774 | grid_z = 'zu' |
|---|
| 775 | ELSEIF ( var(1:5) == 'N_bin' ) THEN |
|---|
| 776 | grid_x = 'x' |
|---|
| 777 | grid_y = 'y' |
|---|
| 778 | grid_z = 'zu' |
|---|
| 779 | ELSEIF ( var(1:4) == 'Ntot' ) THEN |
|---|
| 780 | grid_x = 'x' |
|---|
| 781 | grid_y = 'y' |
|---|
| 782 | grid_z = 'zu' |
|---|
| 783 | ELSEIF ( var(1:2) == 'PM' ) THEN |
|---|
| 784 | grid_x = 'x' |
|---|
| 785 | grid_y = 'y' |
|---|
| 786 | grid_z = 'zu' |
|---|
| 787 | ELSEIF ( var(1:2) == 's_' ) THEN |
|---|
| 788 | grid_x = 'x' |
|---|
| 789 | grid_y = 'y' |
|---|
| 790 | grid_z = 'zu' |
|---|
| 791 | ELSE |
|---|
| 792 | found = .FALSE. |
|---|
| 793 | grid_x = 'none' |
|---|
| 794 | grid_y = 'none' |
|---|
| 795 | grid_z = 'none' |
|---|
| 796 | ENDIF |
|---|
| 797 | |
|---|
| 798 | END SUBROUTINE salsa_define_netcdf_grid |
|---|
| 799 | |
|---|
| 800 | |
|---|
| 801 | !------------------------------------------------------------------------------! |
|---|
| 802 | ! Description: |
|---|
| 803 | ! ------------ |
|---|
| 804 | !> Header output for new module |
|---|
| 805 | !------------------------------------------------------------------------------! |
|---|
| 806 | SUBROUTINE salsa_header( io ) |
|---|
| 807 | |
|---|
| 808 | IMPLICIT NONE |
|---|
| 809 | |
|---|
| 810 | INTEGER(iwp), INTENT(IN) :: io !< Unit of the output file |
|---|
| 811 | ! |
|---|
| 812 | !-- Write SALSA header |
|---|
| 813 | WRITE( io, 1 ) |
|---|
| 814 | WRITE( io, 2 ) skip_time_do_salsa |
|---|
| 815 | WRITE( io, 3 ) dt_salsa |
|---|
| 816 | WRITE( io, 12 ) SHAPE( aerosol_number(1)%conc ), nbins |
|---|
| 817 | IF ( advect_particle_water ) THEN |
|---|
| 818 | WRITE( io, 16 ) SHAPE( aerosol_mass(1)%conc ), ncc_tot*nbins, & |
|---|
| 819 | advect_particle_water |
|---|
| 820 | ELSE |
|---|
| 821 | WRITE( io, 16 ) SHAPE( aerosol_mass(1)%conc ), ncc*nbins, & |
|---|
| 822 | advect_particle_water |
|---|
| 823 | ENDIF |
|---|
| 824 | IF ( .NOT. salsa_gases_from_chem ) THEN |
|---|
| 825 | WRITE( io, 17 ) SHAPE( aerosol_mass(1)%conc ), ngast, & |
|---|
| 826 | salsa_gases_from_chem |
|---|
| 827 | ENDIF |
|---|
| 828 | WRITE( io, 4 ) |
|---|
| 829 | IF ( nsnucl > 0 ) THEN |
|---|
| 830 | WRITE( io, 5 ) nsnucl, nj3 |
|---|
| 831 | ENDIF |
|---|
| 832 | IF ( nlcoag ) THEN |
|---|
| 833 | WRITE( io, 6 ) |
|---|
| 834 | ENDIF |
|---|
| 835 | IF ( nlcnd ) THEN |
|---|
| 836 | WRITE( io, 7 ) nlcndgas, nlcndh2oae |
|---|
| 837 | ENDIF |
|---|
| 838 | IF ( nldepo ) THEN |
|---|
| 839 | WRITE( io, 14 ) nldepo_vege, nldepo_topo |
|---|
| 840 | ENDIF |
|---|
| 841 | WRITE( io, 8 ) reglim, nbin, bin_low_limits |
|---|
| 842 | WRITE( io, 15 ) nsect |
|---|
| 843 | WRITE( io, 13 ) ncc, listspec, mass_fracs_a, mass_fracs_b |
|---|
| 844 | IF ( .NOT. salsa_gases_from_chem ) THEN |
|---|
| 845 | WRITE( io, 18 ) ngast, H2SO4_init, HNO3_init, NH3_init, OCNV_init, & |
|---|
| 846 | OCSV_init |
|---|
| 847 | ENDIF |
|---|
| 848 | WRITE( io, 9 ) isdtyp, igctyp |
|---|
| 849 | IF ( isdtyp == 0 ) THEN |
|---|
| 850 | WRITE( io, 10 ) dpg, sigmag, n_lognorm |
|---|
| 851 | ELSE |
|---|
| 852 | WRITE( io, 11 ) |
|---|
| 853 | ENDIF |
|---|
| 854 | |
|---|
| 855 | |
|---|
| 856 | 1 FORMAT (//' SALSA information:'/ & |
|---|
| 857 | ' ------------------------------'/) |
|---|
| 858 | 2 FORMAT (' Starts at: skip_time_do_salsa = ', F10.2, ' s') |
|---|
| 859 | 3 FORMAT (/' Timestep: dt_salsa = ', F6.2, ' s') |
|---|
| 860 | 12 FORMAT (/' Array shape (z,y,x,bins):'/ & |
|---|
| 861 | ' aerosol_number: ', 4(I3)) |
|---|
| 862 | 16 FORMAT (/' aerosol_mass: ', 4(I3),/ & |
|---|
| 863 | ' (advect_particle_water = ', L1, ')') |
|---|
| 864 | 17 FORMAT (' salsa_gas: ', 4(I3),/ & |
|---|
| 865 | ' (salsa_gases_from_chem = ', L1, ')') |
|---|
| 866 | 4 FORMAT (/' Aerosol dynamic processes included: ') |
|---|
| 867 | 5 FORMAT (/' nucleation (scheme = ', I1, ' and J3 parametrization = ',& |
|---|
| 868 | I1, ')') |
|---|
| 869 | 6 FORMAT (/' coagulation') |
|---|
| 870 | 7 FORMAT (/' condensation (of precursor gases = ', L1, & |
|---|
| 871 | ' and water vapour = ', L1, ')' ) |
|---|
| 872 | 14 FORMAT (/' dry deposition (on vegetation = ', L1, & |
|---|
| 873 | ' and on topography = ', L1, ')') |
|---|
| 874 | 8 FORMAT (/' Aerosol bin subrange limits (in metres): ', 3(ES10.2E3) / & |
|---|
| 875 | ' Number of size bins for each aerosol subrange: ', 2I3,/ & |
|---|
| 876 | ' Aerosol bin limits (in metres): ', *(ES10.2E3)) |
|---|
| 877 | 15 FORMAT (' Initial number concentration in bins at the lowest level', & |
|---|
| 878 | ' (#/m**3):', *(ES10.2E3)) |
|---|
| 879 | 13 FORMAT (/' Number of chemical components used: ', I1,/ & |
|---|
| 880 | ' Species: ',7(A6),/ & |
|---|
| 881 | ' Initial relative contribution of each species to particle', & |
|---|
| 882 | ' volume in:',/ & |
|---|
| 883 | ' a-bins: ', 7(F6.3),/ & |
|---|
| 884 | ' b-bins: ', 7(F6.3)) |
|---|
| 885 | 18 FORMAT (/' Number of gaseous tracers used: ', I1,/ & |
|---|
| 886 | ' Initial gas concentrations:',/ & |
|---|
| 887 | ' H2SO4: ',ES12.4E3, ' #/m**3',/ & |
|---|
| 888 | ' HNO3: ',ES12.4E3, ' #/m**3',/ & |
|---|
| 889 | ' NH3: ',ES12.4E3, ' #/m**3',/ & |
|---|
| 890 | ' OCNV: ',ES12.4E3, ' #/m**3',/ & |
|---|
| 891 | ' OCSV: ',ES12.4E3, ' #/m**3') |
|---|
| 892 | 9 FORMAT (/' Initialising concentrations: ', / & |
|---|
| 893 | ' Aerosol size distribution: isdtyp = ', I1,/ & |
|---|
| 894 | ' Gas concentrations: igctyp = ', I1 ) |
|---|
| 895 | 10 FORMAT ( ' Mode diametres: dpg(nmod) = ', 7(F7.3),/ & |
|---|
| 896 | ' Standard deviation: sigmag(nmod) = ', 7(F7.2),/ & |
|---|
| 897 | ' Number concentration: n_lognorm(nmod) = ', 7(ES12.4E3) ) |
|---|
| 898 | 11 FORMAT (/' Size distribution read from a file.') |
|---|
| 899 | |
|---|
| 900 | END SUBROUTINE salsa_header |
|---|
| 901 | |
|---|
| 902 | !------------------------------------------------------------------------------! |
|---|
| 903 | ! Description: |
|---|
| 904 | ! ------------ |
|---|
| 905 | !> Allocate SALSA arrays and define pointers if required |
|---|
| 906 | !------------------------------------------------------------------------------! |
|---|
| 907 | SUBROUTINE salsa_init_arrays |
|---|
| 908 | |
|---|
| 909 | USE surface_mod, & |
|---|
| 910 | ONLY: surf_def_h, surf_def_v, surf_lsm_h, surf_lsm_v, surf_usm_h, & |
|---|
| 911 | surf_usm_v |
|---|
| 912 | |
|---|
| 913 | IMPLICIT NONE |
|---|
| 914 | |
|---|
| 915 | INTEGER(iwp) :: gases_available !< Number of available gas components in |
|---|
| 916 | !< the chemistry model |
|---|
| 917 | INTEGER(iwp) :: i !< loop index for allocating |
|---|
| 918 | INTEGER(iwp) :: l !< loop index for allocating: surfaces |
|---|
| 919 | INTEGER(iwp) :: lsp !< loop index for chem species in the chemistry model |
|---|
| 920 | |
|---|
| 921 | gases_available = 0 |
|---|
| 922 | |
|---|
| 923 | ! |
|---|
| 924 | !-- Allocate prognostic variables (see salsa_swap_timelevel) |
|---|
| 925 | #if defined( __nopointer ) |
|---|
| 926 | message_string = 'SALSA runs only with POINTER Version' |
|---|
| 927 | CALL message( 'salsa_mod: salsa_init_arrays', 'SA0023', 1, 2, 0, 6, 0 ) |
|---|
| 928 | #else |
|---|
| 929 | ! |
|---|
| 930 | !-- Set derived indices: |
|---|
| 931 | !-- (This does the same as the subroutine salsa_initialize in SALSA/ |
|---|
| 932 | !-- UCLALES-SALSA) |
|---|
| 933 | in1a = 1 ! 1st index of subrange 1a |
|---|
| 934 | in2a = in1a + nbin(1) ! 1st index of subrange 2a |
|---|
| 935 | fn1a = in2a - 1 ! last index of subrange 1a |
|---|
| 936 | fn2a = fn1a + nbin(2) ! last index of subrange 2a |
|---|
| 937 | |
|---|
| 938 | ! |
|---|
| 939 | !-- If the fraction of insoluble aerosols in subrange 2 is zero: do not allocate |
|---|
| 940 | !-- arrays for them |
|---|
| 941 | IF ( nf2a > 0.999999_wp .AND. SUM( mass_fracs_b ) < 0.00001_wp ) THEN |
|---|
| 942 | no_insoluble = .TRUE. |
|---|
| 943 | in2b = fn2a+1 ! 1st index of subrange 2b |
|---|
| 944 | fn2b = fn2a ! last index of subrange 2b |
|---|
| 945 | ELSE |
|---|
| 946 | in2b = in2a + nbin(2) ! 1st index of subrange 2b |
|---|
| 947 | fn2b = fn2a + nbin(2) ! last index of subrange 2b |
|---|
| 948 | ENDIF |
|---|
| 949 | |
|---|
| 950 | |
|---|
| 951 | nbins = fn2b ! total number of aerosol size bins |
|---|
| 952 | ! |
|---|
| 953 | !-- Create index tables for different aerosol components |
|---|
| 954 | CALL component_index_constructor( prtcl, ncc, maxspec, listspec ) |
|---|
| 955 | |
|---|
| 956 | ncc_tot = ncc |
|---|
| 957 | IF ( advect_particle_water ) ncc_tot = ncc + 1 ! Add water |
|---|
| 958 | |
|---|
| 959 | ! |
|---|
| 960 | !-- Allocate: |
|---|
| 961 | ALLOCATE( aero(nbins), bin_low_limits(nbins), nsect(nbins), massacc(nbins) ) |
|---|
| 962 | IF ( nldepo ) ALLOCATE( sedim_vd(nzb:nzt+1,nysg:nyng,nxlg:nxrg,nbins) ) |
|---|
| 963 | ALLOCATE( Ra_dry(nzb:nzt+1,nysg:nyng,nxlg:nxrg,nbins) ) |
|---|
| 964 | |
|---|
| 965 | ! |
|---|
| 966 | !-- Aerosol number concentration |
|---|
| 967 | ALLOCATE( aerosol_number(nbins) ) |
|---|
| 968 | ALLOCATE( nconc_1(nzb:nzt+1,nysg:nyng,nxlg:nxrg,nbins), & |
|---|
| 969 | nconc_2(nzb:nzt+1,nysg:nyng,nxlg:nxrg,nbins), & |
|---|
| 970 | nconc_3(nzb:nzt+1,nysg:nyng,nxlg:nxrg,nbins) ) |
|---|
| 971 | nconc_1 = 0.0_wp |
|---|
| 972 | nconc_2 = 0.0_wp |
|---|
| 973 | nconc_3 = 0.0_wp |
|---|
| 974 | |
|---|
| 975 | DO i = 1, nbins |
|---|
| 976 | aerosol_number(i)%conc(nzb:nzt+1,nysg:nyng,nxlg:nxrg) => nconc_1(:,:,:,i) |
|---|
| 977 | aerosol_number(i)%conc_p(nzb:nzt+1,nysg:nyng,nxlg:nxrg) => nconc_2(:,:,:,i) |
|---|
| 978 | aerosol_number(i)%tconc_m(nzb:nzt+1,nysg:nyng,nxlg:nxrg) => nconc_3(:,:,:,i) |
|---|
| 979 | ALLOCATE( aerosol_number(i)%flux_s(nzb+1:nzt,0:threads_per_task-1), & |
|---|
| 980 | aerosol_number(i)%diss_s(nzb+1:nzt,0:threads_per_task-1), & |
|---|
| 981 | aerosol_number(i)%flux_l(nzb+1:nzt,nys:nyn,0:threads_per_task-1),& |
|---|
| 982 | aerosol_number(i)%diss_l(nzb+1:nzt,nys:nyn,0:threads_per_task-1),& |
|---|
| 983 | aerosol_number(i)%init(nzb:nzt+1), & |
|---|
| 984 | aerosol_number(i)%sums_ws_l(nzb:nzt+1,0:threads_per_task-1) ) |
|---|
| 985 | ENDDO |
|---|
| 986 | |
|---|
| 987 | ! |
|---|
| 988 | !-- Aerosol mass concentration |
|---|
| 989 | ALLOCATE( aerosol_mass(ncc_tot*nbins) ) |
|---|
| 990 | ALLOCATE( mconc_1(nzb:nzt+1,nysg:nyng,nxlg:nxrg,ncc_tot*nbins), & |
|---|
| 991 | mconc_2(nzb:nzt+1,nysg:nyng,nxlg:nxrg,ncc_tot*nbins), & |
|---|
| 992 | mconc_3(nzb:nzt+1,nysg:nyng,nxlg:nxrg,ncc_tot*nbins) ) |
|---|
| 993 | mconc_1 = 0.0_wp |
|---|
| 994 | mconc_2 = 0.0_wp |
|---|
| 995 | mconc_3 = 0.0_wp |
|---|
| 996 | |
|---|
| 997 | DO i = 1, ncc_tot*nbins |
|---|
| 998 | aerosol_mass(i)%conc(nzb:nzt+1,nysg:nyng,nxlg:nxrg) => mconc_1(:,:,:,i) |
|---|
| 999 | aerosol_mass(i)%conc_p(nzb:nzt+1,nysg:nyng,nxlg:nxrg) => mconc_2(:,:,:,i) |
|---|
| 1000 | aerosol_mass(i)%tconc_m(nzb:nzt+1,nysg:nyng,nxlg:nxrg) => mconc_3(:,:,:,i) |
|---|
| 1001 | ALLOCATE( aerosol_mass(i)%flux_s(nzb+1:nzt,0:threads_per_task-1), & |
|---|
| 1002 | aerosol_mass(i)%diss_s(nzb+1:nzt,0:threads_per_task-1), & |
|---|
| 1003 | aerosol_mass(i)%flux_l(nzb+1:nzt,nys:nyn,0:threads_per_task-1),& |
|---|
| 1004 | aerosol_mass(i)%diss_l(nzb+1:nzt,nys:nyn,0:threads_per_task-1),& |
|---|
| 1005 | aerosol_mass(i)%init(nzb:nzt+1), & |
|---|
| 1006 | aerosol_mass(i)%sums_ws_l(nzb:nzt+1,0:threads_per_task-1) ) |
|---|
| 1007 | ENDDO |
|---|
| 1008 | |
|---|
| 1009 | ! |
|---|
| 1010 | !-- Surface fluxes: answs = aerosol number, amsws = aerosol mass |
|---|
| 1011 | ! |
|---|
| 1012 | !-- Horizontal surfaces: default type |
|---|
| 1013 | DO l = 0, 2 ! upward (l=0), downward (l=1) and model top (l=2) |
|---|
| 1014 | ALLOCATE( surf_def_h(l)%answs( 1:surf_def_h(l)%ns, nbins ) ) |
|---|
| 1015 | ALLOCATE( surf_def_h(l)%amsws( 1:surf_def_h(l)%ns, nbins*ncc_tot ) ) |
|---|
| 1016 | surf_def_h(l)%answs = 0.0_wp |
|---|
| 1017 | surf_def_h(l)%amsws = 0.0_wp |
|---|
| 1018 | ENDDO |
|---|
| 1019 | !-- Horizontal surfaces: natural type |
|---|
| 1020 | IF ( land_surface ) THEN |
|---|
| 1021 | ALLOCATE( surf_lsm_h%answs( 1:surf_lsm_h%ns, nbins ) ) |
|---|
| 1022 | ALLOCATE( surf_lsm_h%amsws( 1:surf_lsm_h%ns, nbins*ncc_tot ) ) |
|---|
| 1023 | surf_lsm_h%answs = 0.0_wp |
|---|
| 1024 | surf_lsm_h%amsws = 0.0_wp |
|---|
| 1025 | ENDIF |
|---|
| 1026 | !-- Horizontal surfaces: urban type |
|---|
| 1027 | IF ( urban_surface ) THEN |
|---|
| 1028 | ALLOCATE( surf_usm_h%answs( 1:surf_usm_h%ns, nbins ) ) |
|---|
| 1029 | ALLOCATE( surf_usm_h%amsws( 1:surf_usm_h%ns, nbins*ncc_tot ) ) |
|---|
| 1030 | surf_usm_h%answs = 0.0_wp |
|---|
| 1031 | surf_usm_h%amsws = 0.0_wp |
|---|
| 1032 | ENDIF |
|---|
| 1033 | ! |
|---|
| 1034 | !-- Vertical surfaces: northward (l=0), southward (l=1), eastward (l=2) and |
|---|
| 1035 | !-- westward (l=3) facing |
|---|
| 1036 | DO l = 0, 3 |
|---|
| 1037 | ALLOCATE( surf_def_v(l)%answs( 1:surf_def_v(l)%ns, nbins ) ) |
|---|
| 1038 | surf_def_v(l)%answs = 0.0_wp |
|---|
| 1039 | ALLOCATE( surf_def_v(l)%amsws( 1:surf_def_v(l)%ns, nbins*ncc_tot ) ) |
|---|
| 1040 | surf_def_v(l)%amsws = 0.0_wp |
|---|
| 1041 | |
|---|
| 1042 | IF ( land_surface) THEN |
|---|
| 1043 | ALLOCATE( surf_lsm_v(l)%answs( 1:surf_lsm_v(l)%ns, nbins ) ) |
|---|
| 1044 | surf_lsm_v(l)%answs = 0.0_wp |
|---|
| 1045 | ALLOCATE( surf_lsm_v(l)%amsws( 1:surf_lsm_v(l)%ns, nbins*ncc_tot ) ) |
|---|
| 1046 | surf_lsm_v(l)%amsws = 0.0_wp |
|---|
| 1047 | ENDIF |
|---|
| 1048 | |
|---|
| 1049 | IF ( urban_surface ) THEN |
|---|
| 1050 | ALLOCATE( surf_usm_v(l)%answs( 1:surf_usm_v(l)%ns, nbins ) ) |
|---|
| 1051 | surf_usm_v(l)%answs = 0.0_wp |
|---|
| 1052 | ALLOCATE( surf_usm_v(l)%amsws( 1:surf_usm_v(l)%ns, nbins*ncc_tot ) ) |
|---|
| 1053 | surf_usm_v(l)%amsws = 0.0_wp |
|---|
| 1054 | ENDIF |
|---|
| 1055 | ENDDO |
|---|
| 1056 | |
|---|
| 1057 | ! |
|---|
| 1058 | !-- Concentration of gaseous tracers (1. SO4, 2. HNO3, 3. NH3, 4. OCNV, 5. OCSV) |
|---|
| 1059 | !-- (number concentration (#/m3) ) |
|---|
| 1060 | ! |
|---|
| 1061 | !-- If chemistry is on, read gas phase concentrations from there. Otherwise, |
|---|
| 1062 | !-- allocate salsa_gas array. |
|---|
| 1063 | |
|---|
| 1064 | IF ( air_chemistry ) THEN |
|---|
| 1065 | DO lsp = 1, nvar |
|---|
| 1066 | IF ( TRIM( chem_species(lsp)%name ) == 'H2SO4' ) THEN |
|---|
| 1067 | gases_available = gases_available + 1 |
|---|
| 1068 | gas_index_chem(1) = lsp |
|---|
| 1069 | ELSEIF ( TRIM( chem_species(lsp)%name ) == 'HNO3' ) THEN |
|---|
| 1070 | gases_available = gases_available + 1 |
|---|
| 1071 | gas_index_chem(2) = lsp |
|---|
| 1072 | ELSEIF ( TRIM( chem_species(lsp)%name ) == 'NH3' ) THEN |
|---|
| 1073 | gases_available = gases_available + 1 |
|---|
| 1074 | gas_index_chem(3) = lsp |
|---|
| 1075 | ELSEIF ( TRIM( chem_species(lsp)%name ) == 'OCNV' ) THEN |
|---|
| 1076 | gases_available = gases_available + 1 |
|---|
| 1077 | gas_index_chem(4) = lsp |
|---|
| 1078 | ELSEIF ( TRIM( chem_species(lsp)%name ) == 'OCSV' ) THEN |
|---|
| 1079 | gases_available = gases_available + 1 |
|---|
| 1080 | gas_index_chem(5) = lsp |
|---|
| 1081 | ENDIF |
|---|
| 1082 | ENDDO |
|---|
| 1083 | |
|---|
| 1084 | IF ( gases_available == ngast ) THEN |
|---|
| 1085 | salsa_gases_from_chem = .TRUE. |
|---|
| 1086 | ELSE |
|---|
| 1087 | WRITE( message_string, * ) 'SALSA is run together with chemistry '// & |
|---|
| 1088 | 'but not all gaseous components are '// & |
|---|
| 1089 | 'provided by kpp (H2SO4, HNO3, NH3, '// & |
|---|
| 1090 | 'OCNV, OCSC)' |
|---|
| 1091 | CALL message( 'check_parameters', 'SA0024', 1, 2, 0, 6, 0 ) |
|---|
| 1092 | ENDIF |
|---|
| 1093 | |
|---|
| 1094 | ELSE |
|---|
| 1095 | |
|---|
| 1096 | ALLOCATE( salsa_gas(ngast) ) |
|---|
| 1097 | ALLOCATE( gconc_1(nzb:nzt+1,nysg:nyng,nxlg:nxrg,ngast), & |
|---|
| 1098 | gconc_2(nzb:nzt+1,nysg:nyng,nxlg:nxrg,ngast), & |
|---|
| 1099 | gconc_3(nzb:nzt+1,nysg:nyng,nxlg:nxrg,ngast) ) |
|---|
| 1100 | gconc_1 = 0.0_wp |
|---|
| 1101 | gconc_2 = 0.0_wp |
|---|
| 1102 | gconc_3 = 0.0_wp |
|---|
| 1103 | |
|---|
| 1104 | DO i = 1, ngast |
|---|
| 1105 | salsa_gas(i)%conc(nzb:nzt+1,nysg:nyng,nxlg:nxrg) => gconc_1(:,:,:,i) |
|---|
| 1106 | salsa_gas(i)%conc_p(nzb:nzt+1,nysg:nyng,nxlg:nxrg) => gconc_2(:,:,:,i) |
|---|
| 1107 | salsa_gas(i)%tconc_m(nzb:nzt+1,nysg:nyng,nxlg:nxrg) => gconc_3(:,:,:,i) |
|---|
| 1108 | ALLOCATE( salsa_gas(i)%flux_s(nzb+1:nzt,0:threads_per_task-1), & |
|---|
| 1109 | salsa_gas(i)%diss_s(nzb+1:nzt,0:threads_per_task-1), & |
|---|
| 1110 | salsa_gas(i)%flux_l(nzb+1:nzt,nys:nyn,0:threads_per_task-1),& |
|---|
| 1111 | salsa_gas(i)%diss_l(nzb+1:nzt,nys:nyn,0:threads_per_task-1),& |
|---|
| 1112 | salsa_gas(i)%init(nzb:nzt+1), & |
|---|
| 1113 | salsa_gas(i)%sums_ws_l(nzb:nzt+1,0:threads_per_task-1) ) |
|---|
| 1114 | ENDDO |
|---|
| 1115 | ! |
|---|
| 1116 | !-- Surface fluxes: gtsws = gaseous tracer flux |
|---|
| 1117 | ! |
|---|
| 1118 | !-- Horizontal surfaces: default type |
|---|
| 1119 | DO l = 0, 2 ! upward (l=0), downward (l=1) and model top (l=2) |
|---|
| 1120 | ALLOCATE( surf_def_h(l)%gtsws( 1:surf_def_h(l)%ns, ngast ) ) |
|---|
| 1121 | surf_def_h(l)%gtsws = 0.0_wp |
|---|
| 1122 | ENDDO |
|---|
| 1123 | !-- Horizontal surfaces: natural type |
|---|
| 1124 | IF ( land_surface ) THEN |
|---|
| 1125 | ALLOCATE( surf_lsm_h%gtsws( 1:surf_lsm_h%ns, ngast ) ) |
|---|
| 1126 | surf_lsm_h%gtsws = 0.0_wp |
|---|
| 1127 | ENDIF |
|---|
| 1128 | !-- Horizontal surfaces: urban type |
|---|
| 1129 | IF ( urban_surface ) THEN |
|---|
| 1130 | ALLOCATE( surf_usm_h%gtsws( 1:surf_usm_h%ns, ngast ) ) |
|---|
| 1131 | surf_usm_h%gtsws = 0.0_wp |
|---|
| 1132 | ENDIF |
|---|
| 1133 | ! |
|---|
| 1134 | !-- Vertical surfaces: northward (l=0), southward (l=1), eastward (l=2) and |
|---|
| 1135 | !-- westward (l=3) facing |
|---|
| 1136 | DO l = 0, 3 |
|---|
| 1137 | ALLOCATE( surf_def_v(l)%gtsws( 1:surf_def_v(l)%ns, ngast ) ) |
|---|
| 1138 | surf_def_v(l)%gtsws = 0.0_wp |
|---|
| 1139 | IF ( land_surface ) THEN |
|---|
| 1140 | ALLOCATE( surf_lsm_v(l)%gtsws( 1:surf_lsm_v(l)%ns, ngast ) ) |
|---|
| 1141 | surf_lsm_v(l)%gtsws = 0.0_wp |
|---|
| 1142 | ENDIF |
|---|
| 1143 | IF ( urban_surface ) THEN |
|---|
| 1144 | ALLOCATE( surf_usm_v(l)%gtsws( 1:surf_usm_v(l)%ns, ngast ) ) |
|---|
| 1145 | surf_usm_v(l)%gtsws = 0.0_wp |
|---|
| 1146 | ENDIF |
|---|
| 1147 | ENDDO |
|---|
| 1148 | ENDIF |
|---|
| 1149 | |
|---|
| 1150 | #endif |
|---|
| 1151 | |
|---|
| 1152 | END SUBROUTINE salsa_init_arrays |
|---|
| 1153 | |
|---|
| 1154 | !------------------------------------------------------------------------------! |
|---|
| 1155 | ! Description: |
|---|
| 1156 | ! ------------ |
|---|
| 1157 | !> Initialization of SALSA. Based on salsa_initialize in UCLALES-SALSA. |
|---|
| 1158 | !> Subroutines salsa_initialize, SALSAinit and DiagInitAero in UCLALES-SALSA are |
|---|
| 1159 | !> also merged here. |
|---|
| 1160 | !------------------------------------------------------------------------------! |
|---|
| 1161 | SUBROUTINE salsa_init |
|---|
| 1162 | |
|---|
| 1163 | IMPLICIT NONE |
|---|
| 1164 | |
|---|
| 1165 | INTEGER(iwp) :: b |
|---|
| 1166 | INTEGER(iwp) :: c |
|---|
| 1167 | INTEGER(iwp) :: g |
|---|
| 1168 | INTEGER(iwp) :: i |
|---|
| 1169 | INTEGER(iwp) :: j |
|---|
| 1170 | |
|---|
| 1171 | bin_low_limits = 0.0_wp |
|---|
| 1172 | nsect = 0.0_wp |
|---|
| 1173 | massacc = 1.0_wp |
|---|
| 1174 | |
|---|
| 1175 | ! |
|---|
| 1176 | !-- Indices for chemical components used (-1 = not used) |
|---|
| 1177 | i = 0 |
|---|
| 1178 | IF ( is_used( prtcl, 'SO4' ) ) THEN |
|---|
| 1179 | iso4 = get_index( prtcl,'SO4' ) |
|---|
| 1180 | i = i + 1 |
|---|
| 1181 | ENDIF |
|---|
| 1182 | IF ( is_used( prtcl,'OC' ) ) THEN |
|---|
| 1183 | ioc = get_index(prtcl, 'OC') |
|---|
| 1184 | i = i + 1 |
|---|
| 1185 | ENDIF |
|---|
| 1186 | IF ( is_used( prtcl, 'BC' ) ) THEN |
|---|
| 1187 | ibc = get_index( prtcl, 'BC' ) |
|---|
| 1188 | i = i + 1 |
|---|
| 1189 | ENDIF |
|---|
| 1190 | IF ( is_used( prtcl, 'DU' ) ) THEN |
|---|
| 1191 | idu = get_index( prtcl, 'DU' ) |
|---|
| 1192 | i = i + 1 |
|---|
| 1193 | ENDIF |
|---|
| 1194 | IF ( is_used( prtcl, 'SS' ) ) THEN |
|---|
| 1195 | iss = get_index( prtcl, 'SS' ) |
|---|
| 1196 | i = i + 1 |
|---|
| 1197 | ENDIF |
|---|
| 1198 | IF ( is_used( prtcl, 'NO' ) ) THEN |
|---|
| 1199 | ino = get_index( prtcl, 'NO' ) |
|---|
| 1200 | i = i + 1 |
|---|
| 1201 | ENDIF |
|---|
| 1202 | IF ( is_used( prtcl, 'NH' ) ) THEN |
|---|
| 1203 | inh = get_index( prtcl, 'NH' ) |
|---|
| 1204 | i = i + 1 |
|---|
| 1205 | ENDIF |
|---|
| 1206 | ! |
|---|
| 1207 | !-- All species must be known |
|---|
| 1208 | IF ( i /= ncc ) THEN |
|---|
| 1209 | message_string = 'Unknown aerosol species/component(s) given in the' // & |
|---|
| 1210 | ' initialization' |
|---|
| 1211 | CALL message( 'salsa_mod: salsa_init', 'SA0020', 1, 2, 0, 6, 0 ) |
|---|
| 1212 | ENDIF |
|---|
| 1213 | |
|---|
| 1214 | ! |
|---|
| 1215 | !-- Initialise |
|---|
| 1216 | ! |
|---|
| 1217 | !-- Aerosol size distribution (TYPE t_section) |
|---|
| 1218 | aero(:)%dwet = 1.0E-10_wp |
|---|
| 1219 | aero(:)%veqh2o = 1.0E-10_wp |
|---|
| 1220 | aero(:)%numc = nclim |
|---|
| 1221 | aero(:)%core = 1.0E-10_wp |
|---|
| 1222 | DO c = 1, maxspec+1 ! 1:SO4, 2:OC, 3:BC, 4:DU, 5:SS, 6:NO, 7:NH, 8:H2O |
|---|
| 1223 | aero(:)%volc(c) = 0.0_wp |
|---|
| 1224 | ENDDO |
|---|
| 1225 | |
|---|
| 1226 | IF ( nldepo ) sedim_vd = 0.0_wp |
|---|
| 1227 | ! |
|---|
| 1228 | !-- Initilisation actions that are NOT conducted for restart runs |
|---|
| 1229 | IF ( .NOT. read_restart_data_salsa ) THEN |
|---|
| 1230 | |
|---|
| 1231 | DO b = 1, nbins |
|---|
| 1232 | aerosol_number(b)%conc = nclim |
|---|
| 1233 | aerosol_number(b)%conc_p = 0.0_wp |
|---|
| 1234 | aerosol_number(b)%tconc_m = 0.0_wp |
|---|
| 1235 | aerosol_number(b)%flux_s = 0.0_wp |
|---|
| 1236 | aerosol_number(b)%diss_s = 0.0_wp |
|---|
| 1237 | aerosol_number(b)%flux_l = 0.0_wp |
|---|
| 1238 | aerosol_number(b)%diss_l = 0.0_wp |
|---|
| 1239 | aerosol_number(b)%init = nclim |
|---|
| 1240 | aerosol_number(b)%sums_ws_l = 0.0_wp |
|---|
| 1241 | ENDDO |
|---|
| 1242 | DO c = 1, ncc_tot*nbins |
|---|
| 1243 | aerosol_mass(c)%conc = mclim |
|---|
| 1244 | aerosol_mass(c)%conc_p = 0.0_wp |
|---|
| 1245 | aerosol_mass(c)%tconc_m = 0.0_wp |
|---|
| 1246 | aerosol_mass(c)%flux_s = 0.0_wp |
|---|
| 1247 | aerosol_mass(c)%diss_s = 0.0_wp |
|---|
| 1248 | aerosol_mass(c)%flux_l = 0.0_wp |
|---|
| 1249 | aerosol_mass(c)%diss_l = 0.0_wp |
|---|
| 1250 | aerosol_mass(c)%init = mclim |
|---|
| 1251 | aerosol_mass(c)%sums_ws_l = 0.0_wp |
|---|
| 1252 | ENDDO |
|---|
| 1253 | |
|---|
| 1254 | IF ( .NOT. salsa_gases_from_chem ) THEN |
|---|
| 1255 | DO g = 1, ngast |
|---|
| 1256 | salsa_gas(g)%conc_p = 0.0_wp |
|---|
| 1257 | salsa_gas(g)%tconc_m = 0.0_wp |
|---|
| 1258 | salsa_gas(g)%flux_s = 0.0_wp |
|---|
| 1259 | salsa_gas(g)%diss_s = 0.0_wp |
|---|
| 1260 | salsa_gas(g)%flux_l = 0.0_wp |
|---|
| 1261 | salsa_gas(g)%diss_l = 0.0_wp |
|---|
| 1262 | salsa_gas(g)%sums_ws_l = 0.0_wp |
|---|
| 1263 | ENDDO |
|---|
| 1264 | |
|---|
| 1265 | ! |
|---|
| 1266 | !-- Set initial value for gas compound tracers and initial values |
|---|
| 1267 | salsa_gas(1)%conc = H2SO4_init |
|---|
| 1268 | salsa_gas(1)%init = H2SO4_init |
|---|
| 1269 | salsa_gas(2)%conc = HNO3_init |
|---|
| 1270 | salsa_gas(2)%init = HNO3_init |
|---|
| 1271 | salsa_gas(3)%conc = NH3_init |
|---|
| 1272 | salsa_gas(3)%init = NH3_init |
|---|
| 1273 | salsa_gas(4)%conc = OCNV_init |
|---|
| 1274 | salsa_gas(4)%init = OCNV_init |
|---|
| 1275 | salsa_gas(5)%conc = OCSV_init |
|---|
| 1276 | salsa_gas(5)%init = OCSV_init |
|---|
| 1277 | ENDIF |
|---|
| 1278 | ! |
|---|
| 1279 | !-- Aerosol radius in each bin: dry and wet (m) |
|---|
| 1280 | Ra_dry = 1.0E-10_wp |
|---|
| 1281 | ! |
|---|
| 1282 | !-- Initialise aerosol tracers |
|---|
| 1283 | aero(:)%vhilim = 0.0_wp |
|---|
| 1284 | aero(:)%vlolim = 0.0_wp |
|---|
| 1285 | aero(:)%vratiohi = 0.0_wp |
|---|
| 1286 | aero(:)%vratiolo = 0.0_wp |
|---|
| 1287 | aero(:)%dmid = 0.0_wp |
|---|
| 1288 | ! |
|---|
| 1289 | !-- Initialise the sectional particle size distribution |
|---|
| 1290 | CALL set_sizebins() |
|---|
| 1291 | ! |
|---|
| 1292 | !-- Initialise location-dependent aerosol size distributions and |
|---|
| 1293 | !-- chemical compositions: |
|---|
| 1294 | CALL aerosol_init |
|---|
| 1295 | ! |
|---|
| 1296 | !-- Initalisation run of SALSA |
|---|
| 1297 | DO i = nxl, nxr |
|---|
| 1298 | DO j = nys, nyn |
|---|
| 1299 | CALL salsa_driver( i, j, 1 ) |
|---|
| 1300 | CALL salsa_diagnostics( i, j ) |
|---|
| 1301 | ENDDO |
|---|
| 1302 | ENDDO |
|---|
| 1303 | ENDIF |
|---|
| 1304 | ! |
|---|
| 1305 | !-- Set the aerosol and gas sources |
|---|
| 1306 | IF ( salsa_source_mode == 'read_from_file' ) THEN |
|---|
| 1307 | CALL salsa_set_source |
|---|
| 1308 | ENDIF |
|---|
| 1309 | |
|---|
| 1310 | END SUBROUTINE salsa_init |
|---|
| 1311 | |
|---|
| 1312 | !------------------------------------------------------------------------------! |
|---|
| 1313 | ! Description: |
|---|
| 1314 | ! ------------ |
|---|
| 1315 | !> Initializes particle size distribution grid by calculating size bin limits |
|---|
| 1316 | !> and mid-size for *dry* particles in each bin. Called from salsa_initialize |
|---|
| 1317 | !> (only at the beginning of simulation). |
|---|
| 1318 | !> Size distribution described using: |
|---|
| 1319 | !> 1) moving center method (subranges 1 and 2) |
|---|
| 1320 | !> (Jacobson, Atmos. Env., 31, 131-144, 1997) |
|---|
| 1321 | !> 2) fixed sectional method (subrange 3) |
|---|
| 1322 | !> Size bins in each subrange are spaced logarithmically |
|---|
| 1323 | !> based on given subrange size limits and bin number. |
|---|
| 1324 | ! |
|---|
| 1325 | !> Mona changed 06/2017: Use geometric mean diameter to describe the mean |
|---|
| 1326 | !> particle diameter in a size bin, not the arithmeric mean which clearly |
|---|
| 1327 | !> overestimates the total particle volume concentration. |
|---|
| 1328 | ! |
|---|
| 1329 | !> Coded by: |
|---|
| 1330 | !> Hannele Korhonen (FMI) 2005 |
|---|
| 1331 | !> Harri Kokkola (FMI) 2006 |
|---|
| 1332 | ! |
|---|
| 1333 | !> Bug fixes for box model + updated for the new aerosol datatype: |
|---|
| 1334 | !> Juha Tonttila (FMI) 2014 |
|---|
| 1335 | !------------------------------------------------------------------------------! |
|---|
| 1336 | SUBROUTINE set_sizebins |
|---|
| 1337 | |
|---|
| 1338 | IMPLICIT NONE |
|---|
| 1339 | ! |
|---|
| 1340 | !-- Local variables |
|---|
| 1341 | INTEGER(iwp) :: cc |
|---|
| 1342 | INTEGER(iwp) :: dd |
|---|
| 1343 | REAL(wp) :: ratio_d !< ratio of the upper and lower diameter of subranges |
|---|
| 1344 | ! |
|---|
| 1345 | !-- vlolim&vhilim: min & max *dry* volumes [fxm] |
|---|
| 1346 | !-- dmid: bin mid *dry* diameter (m) |
|---|
| 1347 | !-- vratiolo&vratiohi: volume ratio between the center and low/high limit |
|---|
| 1348 | ! |
|---|
| 1349 | !-- 1) Size subrange 1: |
|---|
| 1350 | ratio_d = reglim(2) / reglim(1) ! section spacing (m) |
|---|
| 1351 | DO cc = in1a,fn1a |
|---|
| 1352 | aero(cc)%vlolim = api6 * ( reglim(1) * ratio_d ** & |
|---|
| 1353 | ( REAL( cc-1 ) / nbin(1) ) ) ** 3.0_wp |
|---|
| 1354 | aero(cc)%vhilim = api6 * ( reglim(1) * ratio_d ** & |
|---|
| 1355 | ( REAL( cc ) / nbin(1) ) ) ** 3.0_wp |
|---|
| 1356 | aero(cc)%dmid = SQRT( ( aero(cc)%vhilim / api6 ) ** ( 1.0_wp / 3.0_wp ) & |
|---|
| 1357 | * ( aero(cc)%vlolim / api6 ) ** ( 1.0_wp / 3.0_wp ) ) |
|---|
| 1358 | aero(cc)%vratiohi = aero(cc)%vhilim / ( api6 * aero(cc)%dmid ** 3.0_wp ) |
|---|
| 1359 | aero(cc)%vratiolo = aero(cc)%vlolim / ( api6 * aero(cc)%dmid ** 3.0_wp ) |
|---|
| 1360 | ENDDO |
|---|
| 1361 | ! |
|---|
| 1362 | !-- 2) Size subrange 2: |
|---|
| 1363 | !-- 2.1) Sub-subrange 2a: high hygroscopicity |
|---|
| 1364 | ratio_d = reglim(3) / reglim(2) ! section spacing |
|---|
| 1365 | DO dd = in2a, fn2a |
|---|
| 1366 | cc = dd - in2a |
|---|
| 1367 | aero(dd)%vlolim = api6 * ( reglim(2) * ratio_d ** & |
|---|
| 1368 | ( REAL( cc ) / nbin(2) ) ) ** 3.0_wp |
|---|
| 1369 | aero(dd)%vhilim = api6 * ( reglim(2) * ratio_d ** & |
|---|
| 1370 | ( REAL( cc+1 ) / nbin(2) ) ) ** 3.0_wp |
|---|
| 1371 | aero(dd)%dmid = SQRT( ( aero(dd)%vhilim / api6 ) ** ( 1.0_wp / 3.0_wp ) & |
|---|
| 1372 | * ( aero(dd)%vlolim / api6 ) ** ( 1.0_wp / 3.0_wp ) ) |
|---|
| 1373 | aero(dd)%vratiohi = aero(dd)%vhilim / ( api6 * aero(dd)%dmid ** 3.0_wp ) |
|---|
| 1374 | aero(dd)%vratiolo = aero(dd)%vlolim / ( api6 * aero(dd)%dmid ** 3.0_wp ) |
|---|
| 1375 | ENDDO |
|---|
| 1376 | ! |
|---|
| 1377 | !-- 2.2) Sub-subrange 2b: low hygroscopicity |
|---|
| 1378 | IF ( .NOT. no_insoluble ) THEN |
|---|
| 1379 | aero(in2b:fn2b)%vlolim = aero(in2a:fn2a)%vlolim |
|---|
| 1380 | aero(in2b:fn2b)%vhilim = aero(in2a:fn2a)%vhilim |
|---|
| 1381 | aero(in2b:fn2b)%dmid = aero(in2a:fn2a)%dmid |
|---|
| 1382 | aero(in2b:fn2b)%vratiohi = aero(in2a:fn2a)%vratiohi |
|---|
| 1383 | aero(in2b:fn2b)%vratiolo = aero(in2a:fn2a)%vratiolo |
|---|
| 1384 | ENDIF |
|---|
| 1385 | ! |
|---|
| 1386 | !-- Initialize the wet diameter with the bin dry diameter to avoid numerical |
|---|
| 1387 | !-- problems later |
|---|
| 1388 | aero(:)%dwet = aero(:)%dmid |
|---|
| 1389 | ! |
|---|
| 1390 | !-- Save bin limits (lower diameter) to be delivered to the host model if needed |
|---|
| 1391 | DO cc = 1, nbins |
|---|
| 1392 | bin_low_limits(cc) = ( aero(cc)%vlolim / api6 )**( 1.0_wp / 3.0_wp ) |
|---|
| 1393 | ENDDO |
|---|
| 1394 | |
|---|
| 1395 | END SUBROUTINE set_sizebins |
|---|
| 1396 | |
|---|
| 1397 | !------------------------------------------------------------------------------! |
|---|
| 1398 | ! Description: |
|---|
| 1399 | ! ------------ |
|---|
| 1400 | !> Initilize altitude-dependent aerosol size distributions and compositions. |
|---|
| 1401 | !> |
|---|
| 1402 | !> Mona added 06/2017: Correct the number and mass concentrations by normalizing |
|---|
| 1403 | !< by the given total number and mass concentration. |
|---|
| 1404 | !> |
|---|
| 1405 | !> Tomi Raatikainen, FMI, 29.2.2016 |
|---|
| 1406 | !------------------------------------------------------------------------------! |
|---|
| 1407 | SUBROUTINE aerosol_init |
|---|
| 1408 | |
|---|
| 1409 | USE arrays_3d, & |
|---|
| 1410 | ONLY: zu |
|---|
| 1411 | |
|---|
| 1412 | USE NETCDF |
|---|
| 1413 | |
|---|
| 1414 | USE netcdf_data_input_mod, & |
|---|
| 1415 | ONLY: get_attribute, netcdf_data_input_get_dimension_length, & |
|---|
| 1416 | get_variable, open_read_file |
|---|
| 1417 | |
|---|
| 1418 | IMPLICIT NONE |
|---|
| 1419 | |
|---|
| 1420 | INTEGER(iwp) :: b !< loop index: size bins |
|---|
| 1421 | INTEGER(iwp) :: c !< loop index: chemical components |
|---|
| 1422 | INTEGER(iwp) :: ee !< index: end |
|---|
| 1423 | INTEGER(iwp) :: g !< loop index: gases |
|---|
| 1424 | INTEGER(iwp) :: i !< loop index: x-direction |
|---|
| 1425 | INTEGER(iwp) :: id_faero !< NetCDF id of PIDS_SALSA |
|---|
| 1426 | INTEGER(iwp) :: id_fchem !< NetCDF id of PIDS_CHEM |
|---|
| 1427 | INTEGER(iwp) :: j !< loop index: y-direction |
|---|
| 1428 | INTEGER(iwp) :: k !< loop index: z-direction |
|---|
| 1429 | INTEGER(iwp) :: kk !< loop index: z-direction |
|---|
| 1430 | INTEGER(iwp) :: nz_file !< Number of grid-points in file (heights) |
|---|
| 1431 | INTEGER(iwp) :: prunmode |
|---|
| 1432 | INTEGER(iwp) :: ss !< index: start |
|---|
| 1433 | LOGICAL :: netcdf_extend = .FALSE. !< Flag indicating wether netcdf |
|---|
| 1434 | !< topography input file or not |
|---|
| 1435 | REAL(wp), DIMENSION(nbins) :: core !< size of the bin mid aerosol particle, |
|---|
| 1436 | REAL(wp) :: flag !< flag to mask topography grid points |
|---|
| 1437 | REAL(wp), DIMENSION(:,:), ALLOCATABLE :: pr_gas !< gas profiles |
|---|
| 1438 | REAL(wp), DIMENSION(:,:), ALLOCATABLE :: pr_mass_fracs_a !< mass fraction |
|---|
| 1439 | !< profiles: a |
|---|
| 1440 | REAL(wp), DIMENSION(:,:), ALLOCATABLE :: pr_mass_fracs_b !< and b |
|---|
| 1441 | REAL(wp), DIMENSION(:,:), ALLOCATABLE :: pr_nsect !< sectional size |
|---|
| 1442 | !< distribution profile |
|---|
| 1443 | REAL(wp), DIMENSION(nbins) :: nsect !< size distribution (#/m3) |
|---|
| 1444 | REAL(wp), DIMENSION(0:nz+1,nbins) :: pndist !< size dist as a function |
|---|
| 1445 | !< of height (#/m3) |
|---|
| 1446 | REAL(wp), DIMENSION(0:nz+1) :: pnf2a !< number fraction: bins 2a |
|---|
| 1447 | REAL(wp), DIMENSION(0:nz+1,maxspec) :: pvf2a !< mass distributions of |
|---|
| 1448 | !< aerosol species for a |
|---|
| 1449 | REAL(wp), DIMENSION(0:nz+1,maxspec) :: pvf2b !< and b-bins |
|---|
| 1450 | REAL(wp), DIMENSION(0:nz+1) :: pvfOC1a !< mass fraction between |
|---|
| 1451 | !< SO4 and OC in 1a |
|---|
| 1452 | REAL(wp), DIMENSION(:), ALLOCATABLE :: pr_z |
|---|
| 1453 | |
|---|
| 1454 | prunmode = 1 |
|---|
| 1455 | ! |
|---|
| 1456 | !-- Bin mean aerosol particle volume (m3) |
|---|
| 1457 | core(:) = 0.0_wp |
|---|
| 1458 | core(1:nbins) = api6 * aero(1:nbins)%dmid ** 3.0_wp |
|---|
| 1459 | ! |
|---|
| 1460 | !-- Set concentrations to zero |
|---|
| 1461 | nsect(:) = 0.0_wp |
|---|
| 1462 | pndist(:,:) = 0.0_wp |
|---|
| 1463 | pnf2a(:) = nf2a |
|---|
| 1464 | pvf2a(:,:) = 0.0_wp |
|---|
| 1465 | pvf2b(:,:) = 0.0_wp |
|---|
| 1466 | pvfOC1a(:) = 0.0_wp |
|---|
| 1467 | |
|---|
| 1468 | IF ( isdtyp == 1 ) THEN |
|---|
| 1469 | ! |
|---|
| 1470 | !-- Read input profiles from PIDS_SALSA |
|---|
| 1471 | ! |
|---|
| 1472 | !-- Location-dependent size distributions and compositions. |
|---|
| 1473 | INQUIRE( FILE='PIDS_SALSA'// TRIM( coupling_char ), EXIST=netcdf_extend ) |
|---|
| 1474 | IF ( netcdf_extend ) THEN |
|---|
| 1475 | ! |
|---|
| 1476 | !-- Open file in read-only mode |
|---|
| 1477 | CALL open_read_file( 'PIDS_SALSA' // TRIM( coupling_char ), id_faero ) |
|---|
| 1478 | ! |
|---|
| 1479 | !-- Input heights |
|---|
| 1480 | CALL netcdf_data_input_get_dimension_length( id_faero, nz_file, "profile_z" ) |
|---|
| 1481 | |
|---|
| 1482 | ALLOCATE( pr_z(nz_file), pr_mass_fracs_a(maxspec,nz_file), & |
|---|
| 1483 | pr_mass_fracs_b(maxspec,nz_file), pr_nsect(nbins,nz_file) ) |
|---|
| 1484 | CALL get_variable( id_faero, 'profile_z', pr_z ) |
|---|
| 1485 | ! |
|---|
| 1486 | !-- Mass fracs profile: 1: H2SO4 (sulphuric acid), 2: OC (organic carbon), |
|---|
| 1487 | !-- 3: BC (black carbon), 4: DU (dust), |
|---|
| 1488 | !-- 5: SS (sea salt), 6: HNO3 (nitric acid), |
|---|
| 1489 | !-- 7: NH3 (ammonia) |
|---|
| 1490 | CALL get_variable( id_faero, "profile_mass_fracs_a", pr_mass_fracs_a,& |
|---|
| 1491 | 0, nz_file-1, 0, maxspec-1 ) |
|---|
| 1492 | CALL get_variable( id_faero, "profile_mass_fracs_b", pr_mass_fracs_b,& |
|---|
| 1493 | 0, nz_file-1, 0, maxspec-1 ) |
|---|
| 1494 | CALL get_variable( id_faero, "profile_nsect", pr_nsect, 0, nz_file-1,& |
|---|
| 1495 | 0, nbins-1 ) |
|---|
| 1496 | |
|---|
| 1497 | kk = 1 |
|---|
| 1498 | DO k = nzb, nz+1 |
|---|
| 1499 | IF ( kk < nz_file ) THEN |
|---|
| 1500 | DO WHILE ( pr_z(kk+1) <= zu(k) ) |
|---|
| 1501 | kk = kk + 1 |
|---|
| 1502 | IF ( kk == nz_file ) EXIT |
|---|
| 1503 | ENDDO |
|---|
| 1504 | ENDIF |
|---|
| 1505 | IF ( kk < nz_file ) THEN |
|---|
| 1506 | ! |
|---|
| 1507 | !-- Set initial value for gas compound tracers and initial values |
|---|
| 1508 | pvf2a(k,:) = pr_mass_fracs_a(:,kk) + ( zu(k) - pr_z(kk) ) / ( & |
|---|
| 1509 | pr_z(kk+1) - pr_z(kk) ) * ( pr_mass_fracs_a(:,kk+1)& |
|---|
| 1510 | - pr_mass_fracs_a(:,kk) ) |
|---|
| 1511 | pvf2b(k,:) = pr_mass_fracs_b(:,kk) + ( zu(k) - pr_z(kk) ) / ( & |
|---|
| 1512 | pr_z(kk+1) - pr_z(kk) ) * ( pr_mass_fracs_b(:,kk+1)& |
|---|
| 1513 | - pr_mass_fracs_b(:,kk) ) |
|---|
| 1514 | pndist(k,:) = pr_nsect(:,kk) + ( zu(k) - pr_z(kk) ) / ( & |
|---|
| 1515 | pr_z(kk+1) - pr_z(kk) ) * ( pr_nsect(:,kk+1) - & |
|---|
| 1516 | pr_nsect(:,kk) ) |
|---|
| 1517 | ELSE |
|---|
| 1518 | pvf2a(k,:) = pr_mass_fracs_a(:,kk) |
|---|
| 1519 | pvf2b(k,:) = pr_mass_fracs_b(:,kk) |
|---|
| 1520 | pndist(k,:) = pr_nsect(:,kk) |
|---|
| 1521 | ENDIF |
|---|
| 1522 | IF ( iso4 < 0 ) THEN |
|---|
| 1523 | pvf2a(k,1) = 0.0_wp |
|---|
| 1524 | pvf2b(k,1) = 0.0_wp |
|---|
| 1525 | ENDIF |
|---|
| 1526 | IF ( ioc < 0 ) THEN |
|---|
| 1527 | pvf2a(k,2) = 0.0_wp |
|---|
| 1528 | pvf2b(k,2) = 0.0_wp |
|---|
| 1529 | ENDIF |
|---|
| 1530 | IF ( ibc < 0 ) THEN |
|---|
| 1531 | pvf2a(k,3) = 0.0_wp |
|---|
| 1532 | pvf2b(k,3) = 0.0_wp |
|---|
| 1533 | ENDIF |
|---|
| 1534 | IF ( idu < 0 ) THEN |
|---|
| 1535 | pvf2a(k,4) = 0.0_wp |
|---|
| 1536 | pvf2b(k,4) = 0.0_wp |
|---|
| 1537 | ENDIF |
|---|
| 1538 | IF ( iss < 0 ) THEN |
|---|
| 1539 | pvf2a(k,5) = 0.0_wp |
|---|
| 1540 | pvf2b(k,5) = 0.0_wp |
|---|
| 1541 | ENDIF |
|---|
| 1542 | IF ( ino < 0 ) THEN |
|---|
| 1543 | pvf2a(k,6) = 0.0_wp |
|---|
| 1544 | pvf2b(k,6) = 0.0_wp |
|---|
| 1545 | ENDIF |
|---|
| 1546 | IF ( inh < 0 ) THEN |
|---|
| 1547 | pvf2a(k,7) = 0.0_wp |
|---|
| 1548 | pvf2b(k,7) = 0.0_wp |
|---|
| 1549 | ENDIF |
|---|
| 1550 | ! |
|---|
| 1551 | !-- Then normalise the mass fraction so that SUM = 1 |
|---|
| 1552 | pvf2a(k,:) = pvf2a(k,:) / SUM( pvf2a(k,:) ) |
|---|
| 1553 | IF ( SUM( pvf2b(k,:) ) > 0.0_wp ) pvf2b(k,:) = pvf2b(k,:) / & |
|---|
| 1554 | SUM( pvf2b(k,:) ) |
|---|
| 1555 | ENDDO |
|---|
| 1556 | DEALLOCATE( pr_z, pr_mass_fracs_a, pr_mass_fracs_b, pr_nsect ) |
|---|
| 1557 | ELSE |
|---|
| 1558 | message_string = 'Input file '// TRIM( 'PIDS_SALSA' ) // & |
|---|
| 1559 | TRIM( coupling_char ) // ' for SALSA missing!' |
|---|
| 1560 | CALL message( 'salsa_mod: aerosol_init', 'SA0032', 1, 2, 0, 6, 0 ) |
|---|
| 1561 | ENDIF ! netcdf_extend |
|---|
| 1562 | |
|---|
| 1563 | ELSEIF ( isdtyp == 0 ) THEN |
|---|
| 1564 | ! |
|---|
| 1565 | !-- Mass fractions for species in a and b-bins |
|---|
| 1566 | IF ( iso4 > 0 ) THEN |
|---|
| 1567 | pvf2a(:,1) = mass_fracs_a(iso4) |
|---|
| 1568 | pvf2b(:,1) = mass_fracs_b(iso4) |
|---|
| 1569 | ENDIF |
|---|
| 1570 | IF ( ioc > 0 ) THEN |
|---|
| 1571 | pvf2a(:,2) = mass_fracs_a(ioc) |
|---|
| 1572 | pvf2b(:,2) = mass_fracs_b(ioc) |
|---|
| 1573 | ENDIF |
|---|
| 1574 | IF ( ibc > 0 ) THEN |
|---|
| 1575 | pvf2a(:,3) = mass_fracs_a(ibc) |
|---|
| 1576 | pvf2b(:,3) = mass_fracs_b(ibc) |
|---|
| 1577 | ENDIF |
|---|
| 1578 | IF ( idu > 0 ) THEN |
|---|
| 1579 | pvf2a(:,4) = mass_fracs_a(idu) |
|---|
| 1580 | pvf2b(:,4) = mass_fracs_b(idu) |
|---|
| 1581 | ENDIF |
|---|
| 1582 | IF ( iss > 0 ) THEN |
|---|
| 1583 | pvf2a(:,5) = mass_fracs_a(iss) |
|---|
| 1584 | pvf2b(:,5) = mass_fracs_b(iss) |
|---|
| 1585 | ENDIF |
|---|
| 1586 | IF ( ino > 0 ) THEN |
|---|
| 1587 | pvf2a(:,6) = mass_fracs_a(ino) |
|---|
| 1588 | pvf2b(:,6) = mass_fracs_b(ino) |
|---|
| 1589 | ENDIF |
|---|
| 1590 | IF ( inh > 0 ) THEN |
|---|
| 1591 | pvf2a(:,7) = mass_fracs_a(inh) |
|---|
| 1592 | pvf2b(:,7) = mass_fracs_b(inh) |
|---|
| 1593 | ENDIF |
|---|
| 1594 | DO k = nzb, nz+1 |
|---|
| 1595 | pvf2a(k,:) = pvf2a(k,:) / SUM( pvf2a(k,:) ) |
|---|
| 1596 | IF ( SUM( pvf2b(k,:) ) > 0.0_wp ) pvf2b(k,:) = pvf2b(k,:) / & |
|---|
| 1597 | SUM( pvf2b(k,:) ) |
|---|
| 1598 | ENDDO |
|---|
| 1599 | |
|---|
| 1600 | CALL size_distribution( n_lognorm, dpg, sigmag, nsect ) |
|---|
| 1601 | ! |
|---|
| 1602 | !-- Normalize by the given total number concentration |
|---|
| 1603 | nsect = nsect * SUM( n_lognorm ) * 1.0E+6_wp / SUM( nsect ) |
|---|
| 1604 | DO b = in1a, fn2b |
|---|
| 1605 | pndist(:,b) = nsect(b) |
|---|
| 1606 | ENDDO |
|---|
| 1607 | ENDIF |
|---|
| 1608 | |
|---|
| 1609 | IF ( igctyp == 1 ) THEN |
|---|
| 1610 | ! |
|---|
| 1611 | !-- Read input profiles from PIDS_CHEM |
|---|
| 1612 | ! |
|---|
| 1613 | !-- Location-dependent size distributions and compositions. |
|---|
| 1614 | INQUIRE( FILE='PIDS_CHEM' // TRIM( coupling_char ), EXIST=netcdf_extend ) |
|---|
| 1615 | IF ( netcdf_extend .AND. .NOT. salsa_gases_from_chem ) THEN |
|---|
| 1616 | ! |
|---|
| 1617 | !-- Open file in read-only mode |
|---|
| 1618 | CALL open_read_file( 'PIDS_CHEM' // TRIM( coupling_char ), id_fchem ) |
|---|
| 1619 | ! |
|---|
| 1620 | !-- Input heights |
|---|
| 1621 | CALL netcdf_data_input_get_dimension_length( id_fchem, nz_file, "profile_z" ) |
|---|
| 1622 | ALLOCATE( pr_z(nz_file), pr_gas(ngast,nz_file) ) |
|---|
| 1623 | CALL get_variable( id_fchem, 'profile_z', pr_z ) |
|---|
| 1624 | ! |
|---|
| 1625 | !-- Gases: |
|---|
| 1626 | CALL get_variable( id_fchem, "profile_H2SO4", pr_gas(1,:) ) |
|---|
| 1627 | CALL get_variable( id_fchem, "profile_HNO3", pr_gas(2,:) ) |
|---|
| 1628 | CALL get_variable( id_fchem, "profile_NH3", pr_gas(3,:) ) |
|---|
| 1629 | CALL get_variable( id_fchem, "profile_OCNV", pr_gas(4,:) ) |
|---|
| 1630 | CALL get_variable( id_fchem, "profile_OCSV", pr_gas(5,:) ) |
|---|
| 1631 | |
|---|
| 1632 | kk = 1 |
|---|
| 1633 | DO k = nzb, nz+1 |
|---|
| 1634 | IF ( kk < nz_file ) THEN |
|---|
| 1635 | DO WHILE ( pr_z(kk+1) <= zu(k) ) |
|---|
| 1636 | kk = kk + 1 |
|---|
| 1637 | IF ( kk == nz_file ) EXIT |
|---|
| 1638 | ENDDO |
|---|
| 1639 | ENDIF |
|---|
| 1640 | IF ( kk < nz_file ) THEN |
|---|
| 1641 | ! |
|---|
| 1642 | !-- Set initial value for gas compound tracers and initial values |
|---|
| 1643 | DO g = 1, ngast |
|---|
| 1644 | salsa_gas(g)%init(k) = pr_gas(g,kk) + ( zu(k) - pr_z(kk) ) & |
|---|
| 1645 | / ( pr_z(kk+1) - pr_z(kk) ) * & |
|---|
| 1646 | ( pr_gas(g,kk+1) - pr_gas(g,kk) ) |
|---|
| 1647 | salsa_gas(g)%conc(k,:,:) = salsa_gas(g)%init(k) |
|---|
| 1648 | ENDDO |
|---|
| 1649 | ELSE |
|---|
| 1650 | DO g = 1, ngast |
|---|
| 1651 | salsa_gas(g)%init(k) = pr_gas(g,kk) |
|---|
| 1652 | salsa_gas(g)%conc(k,:,:) = salsa_gas(g)%init(k) |
|---|
| 1653 | ENDDO |
|---|
| 1654 | ENDIF |
|---|
| 1655 | ENDDO |
|---|
| 1656 | |
|---|
| 1657 | DEALLOCATE( pr_z, pr_gas ) |
|---|
| 1658 | ELSEIF ( .NOT. netcdf_extend .AND. .NOT. salsa_gases_from_chem ) THEN |
|---|
| 1659 | message_string = 'Input file '// TRIM( 'PIDS_CHEM' ) // & |
|---|
| 1660 | TRIM( coupling_char ) // ' for SALSA missing!' |
|---|
| 1661 | CALL message( 'salsa_mod: aerosol_init', 'SA0033', 1, 2, 0, 6, 0 ) |
|---|
| 1662 | ENDIF ! netcdf_extend |
|---|
| 1663 | ENDIF |
|---|
| 1664 | |
|---|
| 1665 | IF ( ioc > 0 .AND. iso4 > 0 ) THEN |
|---|
| 1666 | !-- Both are there, so use the given "massDistrA" |
|---|
| 1667 | pvfOC1a(:) = pvf2a(:,2) / ( pvf2a(:,2) + pvf2a(:,1) ) ! Normalize |
|---|
| 1668 | ELSEIF ( ioc > 0 ) THEN |
|---|
| 1669 | !-- Pure organic carbon |
|---|
| 1670 | pvfOC1a(:) = 1.0_wp |
|---|
| 1671 | ELSEIF ( iso4 > 0 ) THEN |
|---|
| 1672 | !-- Pure SO4 |
|---|
| 1673 | pvfOC1a(:) = 0.0_wp |
|---|
| 1674 | ELSE |
|---|
| 1675 | message_string = 'Either OC or SO4 must be active for aerosol region 1a!' |
|---|
| 1676 | CALL message( 'salsa_mod: aerosol_init', 'SA0021', 1, 2, 0, 6, 0 ) |
|---|
| 1677 | ENDIF |
|---|
| 1678 | |
|---|
| 1679 | ! |
|---|
| 1680 | !-- Initialize concentrations |
|---|
| 1681 | DO i = nxlg, nxrg |
|---|
| 1682 | DO j = nysg, nyng |
|---|
| 1683 | DO k = nzb, nzt+1 |
|---|
| 1684 | ! |
|---|
| 1685 | !-- Predetermine flag to mask topography |
|---|
| 1686 | flag = MERGE( 1.0_wp, 0.0_wp, BTEST( wall_flags_0(k,j,i), 0 ) ) |
|---|
| 1687 | ! |
|---|
| 1688 | !-- a) Number concentrations |
|---|
| 1689 | !-- Region 1: |
|---|
| 1690 | DO b = in1a, fn1a |
|---|
| 1691 | aerosol_number(b)%conc(k,j,i) = pndist(k,b) * flag |
|---|
| 1692 | IF ( prunmode == 1 ) THEN |
|---|
| 1693 | aerosol_number(b)%init = pndist(:,b) |
|---|
| 1694 | ENDIF |
|---|
| 1695 | ENDDO |
|---|
| 1696 | ! |
|---|
| 1697 | !-- Region 2: |
|---|
| 1698 | IF ( nreg > 1 ) THEN |
|---|
| 1699 | DO b = in2a, fn2a |
|---|
| 1700 | aerosol_number(b)%conc(k,j,i) = MAX( 0.0_wp, pnf2a(k) ) * & |
|---|
| 1701 | pndist(k,b) * flag |
|---|
| 1702 | IF ( prunmode == 1 ) THEN |
|---|
| 1703 | aerosol_number(b)%init = MAX( 0.0_wp, nf2a ) * pndist(:,b) |
|---|
| 1704 | ENDIF |
|---|
| 1705 | ENDDO |
|---|
| 1706 | IF ( .NOT. no_insoluble ) THEN |
|---|
| 1707 | DO b = in2b, fn2b |
|---|
| 1708 | IF ( pnf2a(k) < 1.0_wp ) THEN |
|---|
| 1709 | aerosol_number(b)%conc(k,j,i) = MAX( 0.0_wp, 1.0_wp & |
|---|
| 1710 | - pnf2a(k) ) * pndist(k,b) * flag |
|---|
| 1711 | IF ( prunmode == 1 ) THEN |
|---|
| 1712 | aerosol_number(b)%init = MAX( 0.0_wp, 1.0_wp - & |
|---|
| 1713 | nf2a ) * pndist(:,b) |
|---|
| 1714 | ENDIF |
|---|
| 1715 | ENDIF |
|---|
| 1716 | ENDDO |
|---|
| 1717 | ENDIF |
|---|
| 1718 | ENDIF |
|---|
| 1719 | ! |
|---|
| 1720 | !-- b) Aerosol mass concentrations |
|---|
| 1721 | !-- bin subrange 1: done here separately due to the SO4/OC convention |
|---|
| 1722 | !-- SO4: |
|---|
| 1723 | IF ( iso4 > 0 ) THEN |
|---|
| 1724 | ss = ( iso4 - 1 ) * nbins + in1a !< start |
|---|
| 1725 | ee = ( iso4 - 1 ) * nbins + fn1a !< end |
|---|
| 1726 | b = in1a |
|---|
| 1727 | DO c = ss, ee |
|---|
| 1728 | aerosol_mass(c)%conc(k,j,i) = MAX( 0.0_wp, 1.0_wp - & |
|---|
| 1729 | pvfOC1a(k) ) * pndist(k,b) * & |
|---|
| 1730 | core(b) * arhoh2so4 * flag |
|---|
| 1731 | IF ( prunmode == 1 ) THEN |
|---|
| 1732 | aerosol_mass(c)%init = MAX( 0.0_wp, 1.0_wp - MAXVAL( & |
|---|
| 1733 | pvfOC1a ) ) * pndist(:,b) * & |
|---|
| 1734 | core(b) * arhoh2so4 |
|---|
| 1735 | ENDIF |
|---|
| 1736 | b = b+1 |
|---|
| 1737 | ENDDO |
|---|
| 1738 | ENDIF |
|---|
| 1739 | !-- OC: |
|---|
| 1740 | IF ( ioc > 0 ) THEN |
|---|
| 1741 | ss = ( ioc - 1 ) * nbins + in1a !< start |
|---|
| 1742 | ee = ( ioc - 1 ) * nbins + fn1a !< end |
|---|
| 1743 | b = in1a |
|---|
| 1744 | DO c = ss, ee |
|---|
| 1745 | aerosol_mass(c)%conc(k,j,i) = MAX( 0.0_wp, pvfOC1a(k) ) * & |
|---|
| 1746 | pndist(k,b) * core(b) * arhooc * flag |
|---|
| 1747 | IF ( prunmode == 1 ) THEN |
|---|
| 1748 | aerosol_mass(c)%init = MAX( 0.0_wp, MAXVAL( pvfOC1a ) ) & |
|---|
| 1749 | * pndist(:,b) * core(b) * arhooc |
|---|
| 1750 | ENDIF |
|---|
| 1751 | b = b+1 |
|---|
| 1752 | ENDDO |
|---|
| 1753 | ENDIF |
|---|
| 1754 | |
|---|
| 1755 | prunmode = 3 ! Init only once |
|---|
| 1756 | |
|---|
| 1757 | ENDDO !< k |
|---|
| 1758 | ENDDO !< j |
|---|
| 1759 | ENDDO !< i |
|---|
| 1760 | |
|---|
| 1761 | ! |
|---|
| 1762 | !-- c) Aerosol mass concentrations |
|---|
| 1763 | !-- bin subrange 2: |
|---|
| 1764 | IF ( nreg > 1 ) THEN |
|---|
| 1765 | |
|---|
| 1766 | IF ( iso4 > 0 ) THEN |
|---|
| 1767 | CALL set_aero_mass( iso4, pvf2a(:,1), pvf2b(:,1), pnf2a, pndist, & |
|---|
| 1768 | core, arhoh2so4 ) |
|---|
| 1769 | ENDIF |
|---|
| 1770 | IF ( ioc > 0 ) THEN |
|---|
| 1771 | CALL set_aero_mass( ioc, pvf2a(:,2), pvf2b(:,2), pnf2a, pndist, core,& |
|---|
| 1772 | arhooc ) |
|---|
| 1773 | ENDIF |
|---|
| 1774 | IF ( ibc > 0 ) THEN |
|---|
| 1775 | CALL set_aero_mass( ibc, pvf2a(:,3), pvf2b(:,3), pnf2a, pndist, core,& |
|---|
| 1776 | arhobc ) |
|---|
| 1777 | ENDIF |
|---|
| 1778 | IF ( idu > 0 ) THEN |
|---|
| 1779 | CALL set_aero_mass( idu, pvf2a(:,4), pvf2b(:,4), pnf2a, pndist, core,& |
|---|
| 1780 | arhodu ) |
|---|
| 1781 | ENDIF |
|---|
| 1782 | IF ( iss > 0 ) THEN |
|---|
| 1783 | CALL set_aero_mass( iss, pvf2a(:,5), pvf2b(:,5), pnf2a, pndist, core,& |
|---|
| 1784 | arhoss ) |
|---|
| 1785 | ENDIF |
|---|
| 1786 | IF ( ino > 0 ) THEN |
|---|
| 1787 | CALL set_aero_mass( ino, pvf2a(:,6), pvf2b(:,6), pnf2a, pndist, core,& |
|---|
| 1788 | arhohno3 ) |
|---|
| 1789 | ENDIF |
|---|
| 1790 | IF ( inh > 0 ) THEN |
|---|
| 1791 | CALL set_aero_mass( inh, pvf2a(:,7), pvf2b(:,7), pnf2a, pndist, core,& |
|---|
| 1792 | arhonh3 ) |
|---|
| 1793 | ENDIF |
|---|
| 1794 | |
|---|
| 1795 | ENDIF |
|---|
| 1796 | |
|---|
| 1797 | END SUBROUTINE aerosol_init |
|---|
| 1798 | |
|---|
| 1799 | !------------------------------------------------------------------------------! |
|---|
| 1800 | ! Description: |
|---|
| 1801 | ! ------------ |
|---|
| 1802 | !> Create a lognormal size distribution and discretise to a sectional |
|---|
| 1803 | !> representation. |
|---|
| 1804 | !------------------------------------------------------------------------------! |
|---|
| 1805 | SUBROUTINE size_distribution( in_ntot, in_dpg, in_sigma, psd_sect ) |
|---|
| 1806 | |
|---|
| 1807 | IMPLICIT NONE |
|---|
| 1808 | |
|---|
| 1809 | !-- Log-normal size distribution: modes |
|---|
| 1810 | REAL(wp), DIMENSION(:), INTENT(in) :: in_dpg !< geometric mean diameter |
|---|
| 1811 | !< (micrometres) |
|---|
| 1812 | REAL(wp), DIMENSION(:), INTENT(in) :: in_ntot !< number conc. (#/cm3) |
|---|
| 1813 | REAL(wp), DIMENSION(:), INTENT(in) :: in_sigma !< standard deviation |
|---|
| 1814 | REAL(wp), DIMENSION(:), INTENT(inout) :: psd_sect !< sectional size |
|---|
| 1815 | !< distribution |
|---|
| 1816 | INTEGER(iwp) :: b !< running index: bin |
|---|
| 1817 | INTEGER(iwp) :: ib !< running index: iteration |
|---|
| 1818 | REAL(wp) :: d1 !< particle diameter (m, dummy) |
|---|
| 1819 | REAL(wp) :: d2 !< particle diameter (m, dummy) |
|---|
| 1820 | REAL(wp) :: delta_d !< (d2-d1)/10 |
|---|
| 1821 | REAL(wp) :: deltadp !< bin width |
|---|
| 1822 | REAL(wp) :: dmidi !< ( d1 + d2 ) / 2 |
|---|
| 1823 | |
|---|
| 1824 | DO b = in1a, fn2b !< aerosol size bins |
|---|
| 1825 | psd_sect(b) = 0.0_wp |
|---|
| 1826 | !-- Particle diameter at the low limit (largest in the bin) (m) |
|---|
| 1827 | d1 = ( aero(b)%vlolim / api6 ) ** ( 1.0_wp / 3.0_wp ) |
|---|
| 1828 | !-- Particle diameter at the high limit (smallest in the bin) (m) |
|---|
| 1829 | d2 = ( aero(b)%vhilim / api6 ) ** ( 1.0_wp / 3.0_wp ) |
|---|
| 1830 | !-- Span of particle diameter in a bin (m) |
|---|
| 1831 | delta_d = ( d2 - d1 ) / 10.0_wp |
|---|
| 1832 | !-- Iterate: |
|---|
| 1833 | DO ib = 1, 10 |
|---|
| 1834 | d1 = ( aero(b)%vlolim / api6 ) ** ( 1.0_wp / 3.0_wp ) + ( ib - 1) & |
|---|
| 1835 | * delta_d |
|---|
| 1836 | d2 = d1 + delta_d |
|---|
| 1837 | dmidi = ( d1 + d2 ) / 2.0_wp |
|---|
| 1838 | deltadp = LOG10( d2 / d1 ) |
|---|
| 1839 | |
|---|
| 1840 | !-- Size distribution |
|---|
| 1841 | !-- in_ntot = total number, total area, or total volume concentration |
|---|
| 1842 | !-- in_dpg = geometric-mean number, area, or volume diameter |
|---|
| 1843 | !-- n(k) = number, area, or volume concentration in a bin |
|---|
| 1844 | !-- n_lognorm and dpg converted to units of #/m3 and m |
|---|
| 1845 | psd_sect(b) = psd_sect(b) + SUM( in_ntot * 1.0E+6_wp * deltadp / & |
|---|
| 1846 | ( SQRT( 2.0_wp * pi ) * LOG10( in_sigma ) ) * & |
|---|
| 1847 | EXP( -LOG10( dmidi / ( 1.0E-6_wp * in_dpg ) )**2.0_wp / & |
|---|
| 1848 | ( 2.0_wp * LOG10( in_sigma ) ** 2.0_wp ) ) ) |
|---|
| 1849 | |
|---|
| 1850 | ENDDO |
|---|
| 1851 | ENDDO |
|---|
| 1852 | |
|---|
| 1853 | END SUBROUTINE size_distribution |
|---|
| 1854 | |
|---|
| 1855 | !------------------------------------------------------------------------------! |
|---|
| 1856 | ! Description: |
|---|
| 1857 | ! ------------ |
|---|
| 1858 | !> Sets the mass concentrations to aerosol arrays in 2a and 2b. |
|---|
| 1859 | !> |
|---|
| 1860 | !> Tomi Raatikainen, FMI, 29.2.2016 |
|---|
| 1861 | !------------------------------------------------------------------------------! |
|---|
| 1862 | SUBROUTINE set_aero_mass( ispec, ppvf2a, ppvf2b, ppnf2a, ppndist, pcore, prho ) |
|---|
| 1863 | |
|---|
| 1864 | IMPLICIT NONE |
|---|
| 1865 | |
|---|
| 1866 | INTEGER(iwp), INTENT(in) :: ispec !< Aerosol species index |
|---|
| 1867 | REAL(wp), INTENT(in) :: pcore(nbins) !< Aerosol bin mid core volume |
|---|
| 1868 | REAL(wp), INTENT(in) :: ppndist(0:nz+1,nbins) !< Aerosol size distribution |
|---|
| 1869 | REAL(wp), INTENT(in) :: ppnf2a(0:nz+1) !< Number fraction for 2a |
|---|
| 1870 | REAL(wp), INTENT(in) :: ppvf2a(0:nz+1) !< Mass distributions for a |
|---|
| 1871 | REAL(wp), INTENT(in) :: ppvf2b(0:nz+1) !< and b bins |
|---|
| 1872 | REAL(wp), INTENT(in) :: prho !< Aerosol density |
|---|
| 1873 | INTEGER(iwp) :: b !< loop index |
|---|
| 1874 | INTEGER(iwp) :: c !< loop index |
|---|
| 1875 | INTEGER(iwp) :: ee !< index: end |
|---|
| 1876 | INTEGER(iwp) :: i !< loop index |
|---|
| 1877 | INTEGER(iwp) :: j !< loop index |
|---|
| 1878 | INTEGER(iwp) :: k !< loop index |
|---|
| 1879 | INTEGER(iwp) :: prunmode !< 1 = initialise |
|---|
| 1880 | INTEGER(iwp) :: ss !< index: start |
|---|
| 1881 | REAL(wp) :: flag !< flag to mask topography grid points |
|---|
| 1882 | |
|---|
| 1883 | prunmode = 1 |
|---|
| 1884 | |
|---|
| 1885 | DO i = nxlg, nxrg |
|---|
| 1886 | DO j = nysg, nyng |
|---|
| 1887 | DO k = nzb, nzt+1 |
|---|
| 1888 | ! |
|---|
| 1889 | !-- Predetermine flag to mask topography |
|---|
| 1890 | flag = MERGE( 1.0_wp, 0.0_wp, BTEST( wall_flags_0(k,j,i), 0 ) ) |
|---|
| 1891 | ! |
|---|
| 1892 | !-- Regime 2a: |
|---|
| 1893 | ss = ( ispec - 1 ) * nbins + in2a |
|---|
| 1894 | ee = ( ispec - 1 ) * nbins + fn2a |
|---|
| 1895 | b = in2a |
|---|
| 1896 | DO c = ss, ee |
|---|
| 1897 | aerosol_mass(c)%conc(k,j,i) = MAX( 0.0_wp, ppvf2a(k) ) * & |
|---|
| 1898 | ppnf2a(k) * ppndist(k,b) * pcore(b) * prho * flag |
|---|
| 1899 | IF ( prunmode == 1 ) THEN |
|---|
| 1900 | aerosol_mass(c)%init = MAX( 0.0_wp, MAXVAL( ppvf2a(:) ) ) * & |
|---|
| 1901 | MAXVAL( ppnf2a ) * pcore(b) * prho * & |
|---|
| 1902 | MAXVAL( ppndist(:,b) ) |
|---|
| 1903 | ENDIF |
|---|
| 1904 | b = b+1 |
|---|
| 1905 | ENDDO |
|---|
| 1906 | !-- Regime 2b: |
|---|
| 1907 | IF ( .NOT. no_insoluble ) THEN |
|---|
| 1908 | ss = ( ispec - 1 ) * nbins + in2b |
|---|
| 1909 | ee = ( ispec - 1 ) * nbins + fn2b |
|---|
| 1910 | b = in2a |
|---|
| 1911 | DO c = ss, ee |
|---|
| 1912 | aerosol_mass(c)%conc(k,j,i) = MAX( 0.0_wp, ppvf2b(k) ) * ( & |
|---|
| 1913 | 1.0_wp - ppnf2a(k) ) * ppndist(k,b) * & |
|---|
| 1914 | pcore(b) * prho * flag |
|---|
| 1915 | IF ( prunmode == 1 ) THEN |
|---|
| 1916 | aerosol_mass(c)%init = MAX( 0.0_wp, MAXVAL( ppvf2b(:) ) )& |
|---|
| 1917 | * ( 1.0_wp - MAXVAL( ppnf2a ) ) * & |
|---|
| 1918 | MAXVAL( ppndist(:,b) ) * pcore(b) * prho |
|---|
| 1919 | ENDIF |
|---|
| 1920 | b = b+1 |
|---|
| 1921 | ENDDO |
|---|
| 1922 | ENDIF |
|---|
| 1923 | prunmode = 3 ! Init only once |
|---|
| 1924 | ENDDO |
|---|
| 1925 | ENDDO |
|---|
| 1926 | ENDDO |
|---|
| 1927 | END SUBROUTINE set_aero_mass |
|---|
| 1928 | |
|---|
| 1929 | !------------------------------------------------------------------------------! |
|---|
| 1930 | ! Description: |
|---|
| 1931 | ! ------------ |
|---|
| 1932 | !> Swapping of timelevels |
|---|
| 1933 | !------------------------------------------------------------------------------! |
|---|
| 1934 | SUBROUTINE salsa_swap_timelevel( mod_count ) |
|---|
| 1935 | |
|---|
| 1936 | IMPLICIT NONE |
|---|
| 1937 | |
|---|
| 1938 | INTEGER(iwp), INTENT(IN) :: mod_count !< |
|---|
| 1939 | INTEGER(iwp) :: b !< |
|---|
| 1940 | INTEGER(iwp) :: c !< |
|---|
| 1941 | INTEGER(iwp) :: cc !< |
|---|
| 1942 | INTEGER(iwp) :: g !< |
|---|
| 1943 | |
|---|
| 1944 | ! |
|---|
| 1945 | !-- Example for prognostic variable "prog_var" |
|---|
| 1946 | #if defined( __nopointer ) |
|---|
| 1947 | IF ( myid == 0 ) THEN |
|---|
| 1948 | message_string = ' SALSA runs only with POINTER Version' |
|---|
| 1949 | CALL message( 'salsa_swap_timelevel', 'SA0022', 1, 2, 0, 6, 0 ) |
|---|
| 1950 | ENDIF |
|---|
| 1951 | #else |
|---|
| 1952 | |
|---|
| 1953 | SELECT CASE ( mod_count ) |
|---|
| 1954 | |
|---|
| 1955 | CASE ( 0 ) |
|---|
| 1956 | |
|---|
| 1957 | DO b = 1, nbins |
|---|
| 1958 | aerosol_number(b)%conc(nzb:nzt+1,nysg:nyng,nxlg:nxrg) => & |
|---|
| 1959 | nconc_1(:,:,:,b) |
|---|
| 1960 | aerosol_number(b)%conc_p(nzb:nzt+1,nysg:nyng,nxlg:nxrg) => & |
|---|
| 1961 | nconc_2(:,:,:,b) |
|---|
| 1962 | DO c = 1, ncc_tot |
|---|
| 1963 | cc = ( c-1 ) * nbins + b ! required due to possible Intel18 bug |
|---|
| 1964 | aerosol_mass(cc)%conc(nzb:nzt+1,nysg:nyng,nxlg:nxrg) => & |
|---|
| 1965 | mconc_1(:,:,:,cc) |
|---|
| 1966 | aerosol_mass(cc)%conc_p(nzb:nzt+1,nysg:nyng,nxlg:nxrg) => & |
|---|
| 1967 | mconc_2(:,:,:,cc) |
|---|
| 1968 | ENDDO |
|---|
| 1969 | ENDDO |
|---|
| 1970 | |
|---|
| 1971 | IF ( .NOT. salsa_gases_from_chem ) THEN |
|---|
| 1972 | DO g = 1, ngast |
|---|
| 1973 | salsa_gas(g)%conc(nzb:nzt+1,nysg:nyng,nxlg:nxrg) => & |
|---|
| 1974 | gconc_1(:,:,:,g) |
|---|
| 1975 | salsa_gas(g)%conc_p(nzb:nzt+1,nysg:nyng,nxlg:nxrg) => & |
|---|
| 1976 | gconc_2(:,:,:,g) |
|---|
| 1977 | ENDDO |
|---|
| 1978 | ENDIF |
|---|
| 1979 | |
|---|
| 1980 | CASE ( 1 ) |
|---|
| 1981 | |
|---|
| 1982 | DO b = 1, nbins |
|---|
| 1983 | aerosol_number(b)%conc(nzb:nzt+1,nysg:nyng,nxlg:nxrg) => & |
|---|
| 1984 | nconc_2(:,:,:,b) |
|---|
| 1985 | aerosol_number(b)%conc_p(nzb:nzt+1,nysg:nyng,nxlg:nxrg) => & |
|---|
| 1986 | nconc_1(:,:,:,b) |
|---|
| 1987 | DO c = 1, ncc_tot |
|---|
| 1988 | cc = ( c-1 ) * nbins + b ! required due to possible Intel18 bug |
|---|
| 1989 | aerosol_mass(cc)%conc(nzb:nzt+1,nysg:nyng,nxlg:nxrg) => & |
|---|
| 1990 | mconc_2(:,:,:,cc) |
|---|
| 1991 | aerosol_mass(cc)%conc_p(nzb:nzt+1,nysg:nyng,nxlg:nxrg) => & |
|---|
| 1992 | mconc_1(:,:,:,cc) |
|---|
| 1993 | ENDDO |
|---|
| 1994 | ENDDO |
|---|
| 1995 | |
|---|
| 1996 | IF ( .NOT. salsa_gases_from_chem ) THEN |
|---|
| 1997 | DO g = 1, ngast |
|---|
| 1998 | salsa_gas(g)%conc(nzb:nzt+1,nysg:nyng,nxlg:nxrg) => & |
|---|
| 1999 | gconc_2(:,:,:,g) |
|---|
| 2000 | salsa_gas(g)%conc_p(nzb:nzt+1,nysg:nyng,nxlg:nxrg) => & |
|---|
| 2001 | gconc_1(:,:,:,g) |
|---|
| 2002 | ENDDO |
|---|
| 2003 | ENDIF |
|---|
| 2004 | |
|---|
| 2005 | END SELECT |
|---|
| 2006 | #endif |
|---|
| 2007 | |
|---|
| 2008 | END SUBROUTINE salsa_swap_timelevel |
|---|
| 2009 | |
|---|
| 2010 | |
|---|
| 2011 | !------------------------------------------------------------------------------! |
|---|
| 2012 | ! Description: |
|---|
| 2013 | ! ------------ |
|---|
| 2014 | !> This routine reads the respective restart data. |
|---|
| 2015 | !------------------------------------------------------------------------------! |
|---|
| 2016 | SUBROUTINE salsa_rrd_local |
|---|
| 2017 | |
|---|
| 2018 | |
|---|
| 2019 | IMPLICIT NONE |
|---|
| 2020 | |
|---|
| 2021 | CHARACTER (LEN=20) :: field_char !< |
|---|
| 2022 | INTEGER(iwp) :: b !< |
|---|
| 2023 | INTEGER(iwp) :: c !< |
|---|
| 2024 | INTEGER(iwp) :: g !< |
|---|
| 2025 | INTEGER(iwp) :: i !< |
|---|
| 2026 | INTEGER(iwp) :: j !< |
|---|
| 2027 | INTEGER(iwp) :: k !< |
|---|
| 2028 | |
|---|
| 2029 | IF ( read_restart_data_salsa ) THEN |
|---|
| 2030 | READ ( 13 ) field_char |
|---|
| 2031 | |
|---|
| 2032 | DO WHILE ( TRIM( field_char ) /= '*** end salsa ***' ) |
|---|
| 2033 | |
|---|
| 2034 | DO b = 1, nbins |
|---|
| 2035 | READ ( 13 ) aero(b)%vlolim |
|---|
| 2036 | READ ( 13 ) aero(b)%vhilim |
|---|
| 2037 | READ ( 13 ) aero(b)%dmid |
|---|
| 2038 | READ ( 13 ) aero(b)%vratiohi |
|---|
| 2039 | READ ( 13 ) aero(b)%vratiolo |
|---|
| 2040 | ENDDO |
|---|
| 2041 | |
|---|
| 2042 | DO i = nxl, nxr |
|---|
| 2043 | DO j = nys, nyn |
|---|
| 2044 | DO k = nzb+1, nzt |
|---|
| 2045 | DO b = 1, nbins |
|---|
| 2046 | READ ( 13 ) aerosol_number(b)%conc(k,j,i) |
|---|
| 2047 | DO c = 1, ncc_tot |
|---|
| 2048 | READ ( 13 ) aerosol_mass((c-1)*nbins+b)%conc(k,j,i) |
|---|
| 2049 | ENDDO |
|---|
| 2050 | ENDDO |
|---|
| 2051 | IF ( .NOT. salsa_gases_from_chem ) THEN |
|---|
| 2052 | DO g = 1, ngast |
|---|
| 2053 | READ ( 13 ) salsa_gas(g)%conc(k,j,i) |
|---|
| 2054 | ENDDO |
|---|
| 2055 | ENDIF |
|---|
| 2056 | ENDDO |
|---|
| 2057 | ENDDO |
|---|
| 2058 | ENDDO |
|---|
| 2059 | |
|---|
| 2060 | READ ( 13 ) field_char |
|---|
| 2061 | |
|---|
| 2062 | ENDDO |
|---|
| 2063 | |
|---|
| 2064 | ENDIF |
|---|
| 2065 | |
|---|
| 2066 | END SUBROUTINE salsa_rrd_local |
|---|
| 2067 | |
|---|
| 2068 | |
|---|
| 2069 | !------------------------------------------------------------------------------! |
|---|
| 2070 | ! Description: |
|---|
| 2071 | ! ------------ |
|---|
| 2072 | !> This routine writes the respective restart data. |
|---|
| 2073 | !> Note that the following input variables in PARIN have to be equal between |
|---|
| 2074 | !> restart runs: |
|---|
| 2075 | !> listspec, nbin, nbin2, nf2a, ncc, mass_fracs_a, mass_fracs_b |
|---|
| 2076 | !------------------------------------------------------------------------------! |
|---|
| 2077 | SUBROUTINE salsa_wrd_local |
|---|
| 2078 | |
|---|
| 2079 | IMPLICIT NONE |
|---|
| 2080 | |
|---|
| 2081 | INTEGER(iwp) :: b !< |
|---|
| 2082 | INTEGER(iwp) :: c !< |
|---|
| 2083 | INTEGER(iwp) :: g !< |
|---|
| 2084 | INTEGER(iwp) :: i !< |
|---|
| 2085 | INTEGER(iwp) :: j !< |
|---|
| 2086 | INTEGER(iwp) :: k !< |
|---|
| 2087 | |
|---|
| 2088 | IF ( write_binary .AND. write_binary_salsa ) THEN |
|---|
| 2089 | |
|---|
| 2090 | DO b = 1, nbins |
|---|
| 2091 | WRITE ( 14 ) aero(b)%vlolim |
|---|
| 2092 | WRITE ( 14 ) aero(b)%vhilim |
|---|
| 2093 | WRITE ( 14 ) aero(b)%dmid |
|---|
| 2094 | WRITE ( 14 ) aero(b)%vratiohi |
|---|
| 2095 | WRITE ( 14 ) aero(b)%vratiolo |
|---|
| 2096 | ENDDO |
|---|
| 2097 | |
|---|
| 2098 | DO i = nxl, nxr |
|---|
| 2099 | DO j = nys, nyn |
|---|
| 2100 | DO k = nzb+1, nzt |
|---|
| 2101 | DO b = 1, nbins |
|---|
| 2102 | WRITE ( 14 ) aerosol_number(b)%conc(k,j,i) |
|---|
| 2103 | DO c = 1, ncc_tot |
|---|
| 2104 | WRITE ( 14 ) aerosol_mass((c-1)*nbins+b)%conc(k,j,i) |
|---|
| 2105 | ENDDO |
|---|
| 2106 | ENDDO |
|---|
| 2107 | IF ( .NOT. salsa_gases_from_chem ) THEN |
|---|
| 2108 | DO g = 1, ngast |
|---|
| 2109 | WRITE ( 14 ) salsa_gas(g)%conc(k,j,i) |
|---|
| 2110 | ENDDO |
|---|
| 2111 | ENDIF |
|---|
| 2112 | ENDDO |
|---|
| 2113 | ENDDO |
|---|
| 2114 | ENDDO |
|---|
| 2115 | |
|---|
| 2116 | WRITE ( 14 ) '*** end salsa *** ' |
|---|
| 2117 | |
|---|
| 2118 | ENDIF |
|---|
| 2119 | |
|---|
| 2120 | END SUBROUTINE salsa_wrd_local |
|---|
| 2121 | |
|---|
| 2122 | |
|---|
| 2123 | !------------------------------------------------------------------------------! |
|---|
| 2124 | ! Description: |
|---|
| 2125 | ! ------------ |
|---|
| 2126 | !> Performs necessary unit and dimension conversion between the host model and |
|---|
| 2127 | !> SALSA module, and calls the main SALSA routine. |
|---|
| 2128 | !> Partially adobted form the original SALSA boxmodel version. |
|---|
| 2129 | !> Now takes masses in as kg/kg from LES!! Converted to m3/m3 for SALSA |
|---|
| 2130 | !> 05/2016 Juha: This routine is still pretty much in its original shape. |
|---|
| 2131 | !> It's dumb as a mule and twice as ugly, so implementation of |
|---|
| 2132 | !> an improved solution is necessary sooner or later. |
|---|
| 2133 | !> Juha Tonttila, FMI, 2014 |
|---|
| 2134 | !> Jaakko Ahola, FMI, 2016 |
|---|
| 2135 | !> Only aerosol processes included, Mona Kurppa, UHel, 2017 |
|---|
| 2136 | !------------------------------------------------------------------------------! |
|---|
| 2137 | SUBROUTINE salsa_driver( i, j, prunmode ) |
|---|
| 2138 | |
|---|
| 2139 | USE arrays_3d, & |
|---|
| 2140 | ONLY: pt_p, q_p, rho_air_zw, u, v, w |
|---|
| 2141 | |
|---|
| 2142 | USE plant_canopy_model_mod, & |
|---|
| 2143 | ONLY: lad_s |
|---|
| 2144 | |
|---|
| 2145 | USE surface_mod, & |
|---|
| 2146 | ONLY: surf_def_h, surf_def_v, surf_lsm_h, surf_lsm_v, surf_usm_h, & |
|---|
| 2147 | surf_usm_v |
|---|
| 2148 | |
|---|
| 2149 | IMPLICIT NONE |
|---|
| 2150 | |
|---|
| 2151 | INTEGER(iwp), INTENT(in) :: i !< loop index |
|---|
| 2152 | INTEGER(iwp), INTENT(in) :: j !< loop index |
|---|
| 2153 | INTEGER(iwp), INTENT(in) :: prunmode !< 1: Initialization call |
|---|
| 2154 | !< 2: Spinup period call |
|---|
| 2155 | !< 3: Regular runtime call |
|---|
| 2156 | !-- Local variables |
|---|
| 2157 | TYPE(t_section), DIMENSION(fn2b) :: aero_old !< helper array |
|---|
| 2158 | INTEGER(iwp) :: bb !< loop index |
|---|
| 2159 | INTEGER(iwp) :: cc !< loop index |
|---|
| 2160 | INTEGER(iwp) :: endi !< end index |
|---|
| 2161 | INTEGER(iwp) :: k_wall !< vertical index of topography top |
|---|
| 2162 | INTEGER(iwp) :: k !< loop index |
|---|
| 2163 | INTEGER(iwp) :: l !< loop index |
|---|
| 2164 | INTEGER(iwp) :: nc_h2o !< index of H2O in the prtcl index table |
|---|
| 2165 | INTEGER(iwp) :: ss !< loop index |
|---|
| 2166 | INTEGER(iwp) :: str !< start index |
|---|
| 2167 | INTEGER(iwp) :: vc !< default index in prtcl |
|---|
| 2168 | REAL(wp) :: cw_old !< previous H2O mixing ratio |
|---|
| 2169 | REAL(wp) :: flag !< flag to mask topography grid points |
|---|
| 2170 | REAL(wp), DIMENSION(nzb:nzt+1) :: in_adn !< air density (kg/m3) |
|---|
| 2171 | REAL(wp), DIMENSION(nzb:nzt+1) :: in_cs !< H2O sat. vapour conc. |
|---|
| 2172 | REAL(wp), DIMENSION(nzb:nzt+1) :: in_cw !< H2O vapour concentration |
|---|
| 2173 | REAL(wp) :: in_lad !< leaf area density (m2/m3) |
|---|
| 2174 | REAL(wp), DIMENSION(nzb:nzt+1) :: in_p !< pressure (Pa) |
|---|
| 2175 | REAL(wp) :: in_rh !< relative humidity |
|---|
| 2176 | REAL(wp), DIMENSION(nzb:nzt+1) :: in_t !< temperature (K) |
|---|
| 2177 | REAL(wp), DIMENSION(nzb:nzt+1) :: in_u !< wind magnitude (m/s) |
|---|
| 2178 | REAL(wp), DIMENSION(nzb:nzt+1) :: kvis !< kinematic viscosity of air(m2/s) |
|---|
| 2179 | REAL(wp), DIMENSION(nzb:nzt+1,fn2b) :: Sc !< particle Schmidt number |
|---|
| 2180 | REAL(wp), DIMENSION(nzb:nzt+1,fn2b) :: vd !< particle fall seed (m/s, |
|---|
| 2181 | !< sedimentation velocity) |
|---|
| 2182 | REAL(wp), DIMENSION(nzb:nzt+1) :: ppm_to_nconc !< Conversion factor |
|---|
| 2183 | !< from ppm to #/m3 |
|---|
| 2184 | REAL(wp) :: zgso4 !< SO4 |
|---|
| 2185 | REAL(wp) :: zghno3 !< HNO3 |
|---|
| 2186 | REAL(wp) :: zgnh3 !< NH3 |
|---|
| 2187 | REAL(wp) :: zgocnv !< non-volatile OC |
|---|
| 2188 | REAL(wp) :: zgocsv !< semi-volatile OC |
|---|
| 2189 | |
|---|
| 2190 | aero_old(:)%numc = 0.0_wp |
|---|
| 2191 | in_adn = 0.0_wp |
|---|
| 2192 | in_cs = 0.0_wp |
|---|
| 2193 | in_cw = 0.0_wp |
|---|
| 2194 | in_lad = 0.0_wp |
|---|
| 2195 | in_rh = 0.0_wp |
|---|
| 2196 | in_p = 0.0_wp |
|---|
| 2197 | in_t = 0.0_wp |
|---|
| 2198 | in_u = 0.0_wp |
|---|
| 2199 | kvis = 0.0_wp |
|---|
| 2200 | Sc = 0.0_wp |
|---|
| 2201 | vd = 0.0_wp |
|---|
| 2202 | ppm_to_nconc = 1.0_wp |
|---|
| 2203 | zgso4 = nclim |
|---|
| 2204 | zghno3 = nclim |
|---|
| 2205 | zgnh3 = nclim |
|---|
| 2206 | zgocnv = nclim |
|---|
| 2207 | zgocsv = nclim |
|---|
| 2208 | |
|---|
| 2209 | ! |
|---|
| 2210 | !-- Aerosol number is always set, but mass can be uninitialized |
|---|
| 2211 | DO cc = 1, nbins |
|---|
| 2212 | aero(cc)%volc = 0.0_wp |
|---|
| 2213 | aero_old(cc)%volc = 0.0_wp |
|---|
| 2214 | ENDDO |
|---|
| 2215 | ! |
|---|
| 2216 | !-- Set the salsa runtime config (How to make this more efficient?) |
|---|
| 2217 | CALL set_salsa_runtime( prunmode ) |
|---|
| 2218 | ! |
|---|
| 2219 | !-- Calculate thermodynamic quantities needed in SALSA |
|---|
| 2220 | CALL salsa_thrm_ij( i, j, p_ij=in_p, temp_ij=in_t, cw_ij=in_cw, & |
|---|
| 2221 | cs_ij=in_cs, adn_ij=in_adn ) |
|---|
| 2222 | ! |
|---|
| 2223 | !-- Magnitude of wind: needed for deposition |
|---|
| 2224 | IF ( lsdepo ) THEN |
|---|
| 2225 | in_u(nzb+1:nzt) = SQRT( & |
|---|
| 2226 | ( 0.5_wp * ( u(nzb+1:nzt,j,i) + u(nzb+1:nzt,j,i+1) ) )**2 + & |
|---|
| 2227 | ( 0.5_wp * ( v(nzb+1:nzt,j,i) + v(nzb+1:nzt,j+1,i) ) )**2 + & |
|---|
| 2228 | ( 0.5_wp * ( w(nzb:nzt-1,j,i) + w(nzb+1:nzt,j, i) ) )**2 ) |
|---|
| 2229 | ENDIF |
|---|
| 2230 | ! |
|---|
| 2231 | !-- Calculate conversion factors for gas concentrations |
|---|
| 2232 | ppm_to_nconc = for_ppm_to_nconc * in_p / in_t |
|---|
| 2233 | ! |
|---|
| 2234 | !-- Determine topography-top index on scalar grid |
|---|
| 2235 | k_wall = MAXLOC( MERGE( 1, 0, BTEST( wall_flags_0(:,j,i), 12 ) ), & |
|---|
| 2236 | DIM = 1 ) - 1 |
|---|
| 2237 | |
|---|
| 2238 | DO k = nzb+1, nzt |
|---|
| 2239 | ! |
|---|
| 2240 | !-- Predetermine flag to mask topography |
|---|
| 2241 | flag = MERGE( 1.0_wp, 0.0_wp, BTEST( wall_flags_0(k,j,i), 0 ) ) |
|---|
| 2242 | ! |
|---|
| 2243 | !-- Do not run inside buildings |
|---|
| 2244 | IF ( flag == 0.0_wp ) CYCLE |
|---|
| 2245 | ! |
|---|
| 2246 | !-- Wind velocity for dry depositon on vegetation |
|---|
| 2247 | IF ( lsdepo_vege .AND. plant_canopy ) THEN |
|---|
| 2248 | in_lad = lad_s(k-k_wall,j,i) |
|---|
| 2249 | ENDIF |
|---|
| 2250 | ! |
|---|
| 2251 | !-- For initialization and spinup, limit the RH with the parameter rhlim |
|---|
| 2252 | IF ( prunmode < 3 ) THEN |
|---|
| 2253 | in_cw(k) = MIN( in_cw(k), in_cs(k) * rhlim ) |
|---|
| 2254 | ELSE |
|---|
| 2255 | in_cw(k) = in_cw(k) |
|---|
| 2256 | ENDIF |
|---|
| 2257 | cw_old = in_cw(k) !* in_adn(k) |
|---|
| 2258 | ! |
|---|
| 2259 | !-- Set volume concentrations: |
|---|
| 2260 | !-- Sulphate (SO4) or sulphuric acid H2SO4 |
|---|
| 2261 | IF ( iso4 > 0 ) THEN |
|---|
| 2262 | vc = 1 |
|---|
| 2263 | str = ( iso4-1 ) * nbins + 1 ! start index |
|---|
| 2264 | endi = iso4 * nbins ! end index |
|---|
| 2265 | cc = 1 |
|---|
| 2266 | DO ss = str, endi |
|---|
| 2267 | aero(cc)%volc(vc) = aerosol_mass(ss)%conc(k,j,i) / arhoh2so4 |
|---|
| 2268 | cc = cc+1 |
|---|
| 2269 | ENDDO |
|---|
| 2270 | aero_old(1:nbins)%volc(vc) = aero(1:nbins)%volc(vc) |
|---|
| 2271 | ENDIF |
|---|
| 2272 | |
|---|
| 2273 | !-- Organic carbon (OC) compounds |
|---|
| 2274 | IF ( ioc > 0 ) THEN |
|---|
| 2275 | vc = 2 |
|---|
| 2276 | str = ( ioc-1 ) * nbins + 1 |
|---|
| 2277 | endi = ioc * nbins |
|---|
| 2278 | cc = 1 |
|---|
| 2279 | DO ss = str, endi |
|---|
| 2280 | aero(cc)%volc(vc) = aerosol_mass(ss)%conc(k,j,i) / arhooc |
|---|
| 2281 | cc = cc+1 |
|---|
| 2282 | ENDDO |
|---|
| 2283 | aero_old(1:nbins)%volc(vc) = aero(1:nbins)%volc(vc) |
|---|
| 2284 | ENDIF |
|---|
| 2285 | |
|---|
| 2286 | !-- Black carbon (BC) |
|---|
| 2287 | IF ( ibc > 0 ) THEN |
|---|
| 2288 | vc = 3 |
|---|
| 2289 | str = ( ibc-1 ) * nbins + 1 + fn1a |
|---|
| 2290 | endi = ibc * nbins |
|---|
| 2291 | cc = 1 + fn1a |
|---|
| 2292 | DO ss = str, endi |
|---|
| 2293 | aero(cc)%volc(vc) = aerosol_mass(ss)%conc(k,j,i) / arhobc |
|---|
| 2294 | cc = cc+1 |
|---|
| 2295 | ENDDO |
|---|
| 2296 | aero_old(1:nbins)%volc(vc) = aero(1:nbins)%volc(vc) |
|---|
| 2297 | ENDIF |
|---|
| 2298 | |
|---|
| 2299 | !-- Dust (DU) |
|---|
| 2300 | IF ( idu > 0 ) THEN |
|---|
| 2301 | vc = 4 |
|---|
| 2302 | str = ( idu-1 ) * nbins + 1 + fn1a |
|---|
| 2303 | endi = idu * nbins |
|---|
| 2304 | cc = 1 + fn1a |
|---|
| 2305 | DO ss = str, endi |
|---|
| 2306 | aero(cc)%volc(vc) = aerosol_mass(ss)%conc(k,j,i) / arhodu |
|---|
| 2307 | cc = cc+1 |
|---|
| 2308 | ENDDO |
|---|
| 2309 | aero_old(1:nbins)%volc(vc) = aero(1:nbins)%volc(vc) |
|---|
| 2310 | ENDIF |
|---|
| 2311 | |
|---|
| 2312 | !-- Sea salt (SS) |
|---|
| 2313 | IF ( iss > 0 ) THEN |
|---|
| 2314 | vc = 5 |
|---|
| 2315 | str = ( iss-1 ) * nbins + 1 + fn1a |
|---|
| 2316 | endi = iss * nbins |
|---|
| 2317 | cc = 1 + fn1a |
|---|
| 2318 | DO ss = str, endi |
|---|
| 2319 | aero(cc)%volc(vc) = aerosol_mass(ss)%conc(k,j,i) / arhoss |
|---|
| 2320 | cc = cc+1 |
|---|
| 2321 | ENDDO |
|---|
| 2322 | aero_old(1:nbins)%volc(vc) = aero(1:nbins)%volc(vc) |
|---|
| 2323 | ENDIF |
|---|
| 2324 | |
|---|
| 2325 | !-- Nitrate (NO(3-)) or nitric acid HNO3 |
|---|
| 2326 | IF ( ino > 0 ) THEN |
|---|
| 2327 | vc = 6 |
|---|
| 2328 | str = ( ino-1 ) * nbins + 1 |
|---|
| 2329 | endi = ino * nbins |
|---|
| 2330 | cc = 1 |
|---|
| 2331 | DO ss = str, endi |
|---|
| 2332 | aero(cc)%volc(vc) = aerosol_mass(ss)%conc(k,j,i) / arhohno3 |
|---|
| 2333 | cc = cc+1 |
|---|
| 2334 | ENDDO |
|---|
| 2335 | aero_old(1:nbins)%volc(vc) = aero(1:nbins)%volc(vc) |
|---|
| 2336 | ENDIF |
|---|
| 2337 | |
|---|
| 2338 | !-- Ammonium (NH(4+)) or ammonia NH3 |
|---|
| 2339 | IF ( inh > 0 ) THEN |
|---|
| 2340 | vc = 7 |
|---|
| 2341 | str = ( inh-1 ) * nbins + 1 |
|---|
| 2342 | endi = inh * nbins |
|---|
| 2343 | cc = 1 |
|---|
| 2344 | DO ss = str, endi |
|---|
| 2345 | aero(cc)%volc(vc) = aerosol_mass(ss)%conc(k,j,i) / arhonh3 |
|---|
| 2346 | cc = cc+1 |
|---|
| 2347 | ENDDO |
|---|
| 2348 | aero_old(1:nbins)%volc(vc) = aero(1:nbins)%volc(vc) |
|---|
| 2349 | ENDIF |
|---|
| 2350 | |
|---|
| 2351 | !-- Water (always used) |
|---|
| 2352 | nc_h2o = get_index( prtcl,'H2O' ) |
|---|
| 2353 | vc = 8 |
|---|
| 2354 | str = ( nc_h2o-1 ) * nbins + 1 |
|---|
| 2355 | endi = nc_h2o * nbins |
|---|
| 2356 | cc = 1 |
|---|
| 2357 | IF ( advect_particle_water ) THEN |
|---|
| 2358 | DO ss = str, endi |
|---|
| 2359 | aero(cc)%volc(vc) = aerosol_mass(ss)%conc(k,j,i) / arhoh2o |
|---|
| 2360 | cc = cc+1 |
|---|
| 2361 | ENDDO |
|---|
| 2362 | ELSE |
|---|
| 2363 | aero(1:nbins)%volc(vc) = mclim |
|---|
| 2364 | ENDIF |
|---|
| 2365 | aero_old(1:nbins)%volc(vc) = aero(1:nbins)%volc(vc) |
|---|
| 2366 | ! |
|---|
| 2367 | !-- Number concentrations (numc) and particle sizes |
|---|
| 2368 | !-- (dwet = wet diameter, core = dry volume) |
|---|
| 2369 | DO bb = 1, nbins |
|---|
| 2370 | aero(bb)%numc = aerosol_number(bb)%conc(k,j,i) |
|---|
| 2371 | aero_old(bb)%numc = aero(bb)%numc |
|---|
| 2372 | IF ( aero(bb)%numc > nclim ) THEN |
|---|
| 2373 | aero(bb)%dwet = ( SUM( aero(bb)%volc(:) ) / aero(bb)%numc / api6 )& |
|---|
| 2374 | **( 1.0_wp / 3.0_wp ) |
|---|
| 2375 | aero(bb)%core = SUM( aero(bb)%volc(1:7) ) / aero(bb)%numc |
|---|
| 2376 | ELSE |
|---|
| 2377 | aero(bb)%dwet = aero(bb)%dmid |
|---|
| 2378 | aero(bb)%core = api6 * ( aero(bb)%dwet ) ** 3.0_wp |
|---|
| 2379 | ENDIF |
|---|
| 2380 | ENDDO |
|---|
| 2381 | ! |
|---|
| 2382 | !-- On EACH call of salsa_driver, calculate the ambient sizes of |
|---|
| 2383 | !-- particles by equilibrating soluble fraction of particles with water |
|---|
| 2384 | !-- using the ZSR method. |
|---|
| 2385 | in_rh = in_cw(k) / in_cs(k) |
|---|
| 2386 | IF ( prunmode==1 .OR. .NOT. advect_particle_water ) THEN |
|---|
| 2387 | CALL equilibration( in_rh, in_t(k), aero, .TRUE. ) |
|---|
| 2388 | ENDIF |
|---|
| 2389 | ! |
|---|
| 2390 | !-- Gaseous tracer concentrations in #/m3 |
|---|
| 2391 | IF ( salsa_gases_from_chem ) THEN |
|---|
| 2392 | ! |
|---|
| 2393 | !-- Convert concentrations in ppm to #/m3 |
|---|
| 2394 | zgso4 = chem_species(gas_index_chem(1))%conc(k,j,i) * ppm_to_nconc(k) |
|---|
| 2395 | zghno3 = chem_species(gas_index_chem(2))%conc(k,j,i) * ppm_to_nconc(k) |
|---|
| 2396 | zgnh3 = chem_species(gas_index_chem(3))%conc(k,j,i) * ppm_to_nconc(k) |
|---|
| 2397 | zgocnv = chem_species(gas_index_chem(4))%conc(k,j,i) * ppm_to_nconc(k) |
|---|
| 2398 | zgocsv = chem_species(gas_index_chem(5))%conc(k,j,i) * ppm_to_nconc(k) |
|---|
| 2399 | ELSE |
|---|
| 2400 | zgso4 = salsa_gas(1)%conc(k,j,i) |
|---|
| 2401 | zghno3 = salsa_gas(2)%conc(k,j,i) |
|---|
| 2402 | zgnh3 = salsa_gas(3)%conc(k,j,i) |
|---|
| 2403 | zgocnv = salsa_gas(4)%conc(k,j,i) |
|---|
| 2404 | zgocsv = salsa_gas(5)%conc(k,j,i) |
|---|
| 2405 | ENDIF |
|---|
| 2406 | ! |
|---|
| 2407 | !-- ***************************************! |
|---|
| 2408 | !-- Run SALSA ! |
|---|
| 2409 | !-- ***************************************! |
|---|
| 2410 | CALL run_salsa( in_p(k), in_cw(k), in_cs(k), in_t(k), in_u(k), & |
|---|
| 2411 | in_adn(k), in_lad, zgso4, zgocnv, zgocsv, zghno3, zgnh3,& |
|---|
| 2412 | aero, prtcl, kvis(k), Sc(k,:), vd(k,:), dt_salsa ) |
|---|
| 2413 | !-- ***************************************! |
|---|
| 2414 | IF ( lsdepo ) sedim_vd(k,j,i,:) = vd(k,:) |
|---|
| 2415 | ! |
|---|
| 2416 | !-- Calculate changes in concentrations |
|---|
| 2417 | DO bb = 1, nbins |
|---|
| 2418 | aerosol_number(bb)%conc(k,j,i) = aerosol_number(bb)%conc(k,j,i) & |
|---|
| 2419 | + ( aero(bb)%numc - aero_old(bb)%numc ) * flag |
|---|
| 2420 | ENDDO |
|---|
| 2421 | |
|---|
| 2422 | IF ( iso4 > 0 ) THEN |
|---|
| 2423 | vc = 1 |
|---|
| 2424 | str = ( iso4-1 ) * nbins + 1 |
|---|
| 2425 | endi = iso4 * nbins |
|---|
| 2426 | cc = 1 |
|---|
| 2427 | DO ss = str, endi |
|---|
| 2428 | aerosol_mass(ss)%conc(k,j,i) = aerosol_mass(ss)%conc(k,j,i) & |
|---|
| 2429 | + ( aero(cc)%volc(vc) - aero_old(cc)%volc(vc) ) & |
|---|
| 2430 | * arhoh2so4 * flag |
|---|
| 2431 | cc = cc+1 |
|---|
| 2432 | ENDDO |
|---|
| 2433 | ENDIF |
|---|
| 2434 | |
|---|
| 2435 | IF ( ioc > 0 ) THEN |
|---|
| 2436 | vc = 2 |
|---|
| 2437 | str = ( ioc-1 ) * nbins + 1 |
|---|
| 2438 | endi = ioc * nbins |
|---|
| 2439 | cc = 1 |
|---|
| 2440 | DO ss = str, endi |
|---|
| 2441 | aerosol_mass(ss)%conc(k,j,i) = aerosol_mass(ss)%conc(k,j,i) & |
|---|
| 2442 | + ( aero(cc)%volc(vc) - aero_old(cc)%volc(vc) ) & |
|---|
| 2443 | * arhooc * flag |
|---|
| 2444 | cc = cc+1 |
|---|
| 2445 | ENDDO |
|---|
| 2446 | ENDIF |
|---|
| 2447 | |
|---|
| 2448 | IF ( ibc > 0 ) THEN |
|---|
| 2449 | vc = 3 |
|---|
| 2450 | str = ( ibc-1 ) * nbins + 1 + fn1a |
|---|
| 2451 | endi = ibc * nbins |
|---|
| 2452 | cc = 1 + fn1a |
|---|
| 2453 | DO ss = str, endi |
|---|
| 2454 | aerosol_mass(ss)%conc(k,j,i) = aerosol_mass(ss)%conc(k,j,i) & |
|---|
| 2455 | + ( aero(cc)%volc(vc) - aero_old(cc)%volc(vc) ) & |
|---|
| 2456 | * arhobc * flag |
|---|
| 2457 | cc = cc+1 |
|---|
| 2458 | ENDDO |
|---|
| 2459 | ENDIF |
|---|
| 2460 | |
|---|
| 2461 | IF ( idu > 0 ) THEN |
|---|
| 2462 | vc = 4 |
|---|
| 2463 | str = ( idu-1 ) * nbins + 1 + fn1a |
|---|
| 2464 | endi = idu * nbins |
|---|
| 2465 | cc = 1 + fn1a |
|---|
| 2466 | DO ss = str, endi |
|---|
| 2467 | aerosol_mass(ss)%conc(k,j,i) = aerosol_mass(ss)%conc(k,j,i) & |
|---|
| 2468 | + ( aero(cc)%volc(vc) - aero_old(cc)%volc(vc) ) & |
|---|
| 2469 | * arhodu * flag |
|---|
| 2470 | cc = cc+1 |
|---|
| 2471 | ENDDO |
|---|
| 2472 | ENDIF |
|---|
| 2473 | |
|---|
| 2474 | IF ( iss > 0 ) THEN |
|---|
| 2475 | vc = 5 |
|---|
| 2476 | str = ( iss-1 ) * nbins + 1 + fn1a |
|---|
| 2477 | endi = iss * nbins |
|---|
| 2478 | cc = 1 + fn1a |
|---|
| 2479 | DO ss = str, endi |
|---|
| 2480 | aerosol_mass(ss)%conc(k,j,i) = aerosol_mass(ss)%conc(k,j,i) & |
|---|
| 2481 | + ( aero(cc)%volc(vc) - aero_old(cc)%volc(vc) ) & |
|---|
| 2482 | * arhoss * flag |
|---|
| 2483 | cc = cc+1 |
|---|
| 2484 | ENDDO |
|---|
| 2485 | ENDIF |
|---|
| 2486 | |
|---|
| 2487 | IF ( ino > 0 ) THEN |
|---|
| 2488 | vc = 6 |
|---|
| 2489 | str = ( ino-1 ) * nbins + 1 |
|---|
| 2490 | endi = ino * nbins |
|---|
| 2491 | cc = 1 |
|---|
| 2492 | DO ss = str, endi |
|---|
| 2493 | aerosol_mass(ss)%conc(k,j,i) = aerosol_mass(ss)%conc(k,j,i) & |
|---|
| 2494 | + ( aero(cc)%volc(vc) - aero_old(cc)%volc(vc) ) & |
|---|
| 2495 | * arhohno3 * flag |
|---|
| 2496 | cc = cc+1 |
|---|
| 2497 | ENDDO |
|---|
| 2498 | ENDIF |
|---|
| 2499 | |
|---|
| 2500 | IF ( inh > 0 ) THEN |
|---|
| 2501 | vc = 7 |
|---|
| 2502 | str = ( ino-1 ) * nbins + 1 |
|---|
| 2503 | endi = ino * nbins |
|---|
| 2504 | cc = 1 |
|---|
| 2505 | DO ss = str, endi |
|---|
| 2506 | aerosol_mass(ss)%conc(k,j,i) = aerosol_mass(ss)%conc(k,j,i) & |
|---|
| 2507 | + ( aero(cc)%volc(vc) - aero_old(cc)%volc(vc) ) & |
|---|
| 2508 | * arhonh3 * flag |
|---|
| 2509 | cc = cc+1 |
|---|
| 2510 | ENDDO |
|---|
| 2511 | ENDIF |
|---|
| 2512 | |
|---|
| 2513 | IF ( advect_particle_water ) THEN |
|---|
| 2514 | nc_h2o = get_index( prtcl,'H2O' ) |
|---|
| 2515 | vc = 8 |
|---|
| 2516 | str = ( nc_h2o-1 ) * nbins + 1 |
|---|
| 2517 | endi = nc_h2o * nbins |
|---|
| 2518 | cc = 1 |
|---|
| 2519 | DO ss = str, endi |
|---|
| 2520 | aerosol_mass(ss)%conc(k,j,i) = aerosol_mass(ss)%conc(k,j,i) & |
|---|
| 2521 | + ( aero(cc)%volc(vc) - aero_old(cc)%volc(vc) ) & |
|---|
| 2522 | * arhoh2o * flag |
|---|
| 2523 | IF ( prunmode == 1 ) THEN |
|---|
| 2524 | aerosol_mass(ss)%init(k) = MAX( aerosol_mass(ss)%init(k), & |
|---|
| 2525 | aerosol_mass(ss)%conc(k,j,i) ) |
|---|
| 2526 | ENDIF |
|---|
| 2527 | cc = cc+1 |
|---|
| 2528 | ENDDO |
|---|
| 2529 | ENDIF |
|---|
| 2530 | |
|---|
| 2531 | !-- Condensation of precursor gases |
|---|
| 2532 | IF ( lscndgas ) THEN |
|---|
| 2533 | IF ( salsa_gases_from_chem ) THEN |
|---|
| 2534 | ! |
|---|
| 2535 | !-- SO4 (or H2SO4) |
|---|
| 2536 | chem_species( gas_index_chem(1) )%conc(k,j,i) = & |
|---|
| 2537 | chem_species( gas_index_chem(1) )%conc(k,j,i) + & |
|---|
| 2538 | ( zgso4 / ppm_to_nconc(k) - & |
|---|
| 2539 | chem_species( gas_index_chem(1) )%conc(k,j,i) ) * flag |
|---|
| 2540 | ! |
|---|
| 2541 | !-- HNO3 |
|---|
| 2542 | chem_species( gas_index_chem(2) )%conc(k,j,i) = & |
|---|
| 2543 | chem_species( gas_index_chem(2) )%conc(k,j,i) + & |
|---|
| 2544 | ( zghno3 / ppm_to_nconc(k) - & |
|---|
| 2545 | chem_species( gas_index_chem(2) )%conc(k,j,i) ) * flag |
|---|
| 2546 | ! |
|---|
| 2547 | !-- NH3 |
|---|
| 2548 | chem_species( gas_index_chem(3) )%conc(k,j,i) = & |
|---|
| 2549 | chem_species( gas_index_chem(3) )%conc(k,j,i) + & |
|---|
| 2550 | ( zgnh3 / ppm_to_nconc(k) - & |
|---|
| 2551 | chem_species( gas_index_chem(3) )%conc(k,j,i) ) * flag |
|---|
| 2552 | ! |
|---|
| 2553 | !-- non-volatile OC |
|---|
| 2554 | chem_species( gas_index_chem(4) )%conc(k,j,i) = & |
|---|
| 2555 | chem_species( gas_index_chem(4) )%conc(k,j,i) + & |
|---|
| 2556 | ( zgocnv / ppm_to_nconc(k) - & |
|---|
| 2557 | chem_species( gas_index_chem(4) )%conc(k,j,i) ) * flag |
|---|
| 2558 | ! |
|---|
| 2559 | !-- semi-volatile OC |
|---|
| 2560 | chem_species( gas_index_chem(5) )%conc(k,j,i) = & |
|---|
| 2561 | chem_species( gas_index_chem(5) )%conc(k,j,i) + & |
|---|
| 2562 | ( zgocsv / ppm_to_nconc(k) - & |
|---|
| 2563 | chem_species( gas_index_chem(5) )%conc(k,j,i) ) * flag |
|---|
| 2564 | |
|---|
| 2565 | ELSE |
|---|
| 2566 | ! |
|---|
| 2567 | !-- SO4 (or H2SO4) |
|---|
| 2568 | salsa_gas(1)%conc(k,j,i) = salsa_gas(1)%conc(k,j,i) + ( zgso4 - & |
|---|
| 2569 | salsa_gas(1)%conc(k,j,i) ) * flag |
|---|
| 2570 | ! |
|---|
| 2571 | !-- HNO3 |
|---|
| 2572 | salsa_gas(2)%conc(k,j,i) = salsa_gas(2)%conc(k,j,i) + ( zghno3 - & |
|---|
| 2573 | salsa_gas(2)%conc(k,j,i) ) * flag |
|---|
| 2574 | ! |
|---|
| 2575 | !-- NH3 |
|---|
| 2576 | salsa_gas(3)%conc(k,j,i) = salsa_gas(3)%conc(k,j,i) + ( zgnh3 - & |
|---|
| 2577 | salsa_gas(3)%conc(k,j,i) ) * flag |
|---|
| 2578 | ! |
|---|
| 2579 | !-- non-volatile OC |
|---|
| 2580 | salsa_gas(4)%conc(k,j,i) = salsa_gas(4)%conc(k,j,i) + ( zgocnv - & |
|---|
| 2581 | salsa_gas(4)%conc(k,j,i) ) * flag |
|---|
| 2582 | ! |
|---|
| 2583 | !-- semi-volatile OC |
|---|
| 2584 | salsa_gas(5)%conc(k,j,i) = salsa_gas(5)%conc(k,j,i) + ( zgocsv - & |
|---|
| 2585 | salsa_gas(5)%conc(k,j,i) ) * flag |
|---|
| 2586 | ENDIF |
|---|
| 2587 | ENDIF |
|---|
| 2588 | ! |
|---|
| 2589 | !-- Tendency of water vapour mixing ratio is obtained from the |
|---|
| 2590 | !-- change in RH during SALSA run. This releases heat and changes pt. |
|---|
| 2591 | !-- Assumes no temperature change during SALSA run. |
|---|
| 2592 | !-- q = r / (1+r), Euler method for integration |
|---|
| 2593 | ! |
|---|
| 2594 | IF ( feedback_to_palm ) THEN |
|---|
| 2595 | q_p(k,j,i) = q_p(k,j,i) + 1.0_wp / ( in_cw(k) * in_adn(k) + 1.0_wp ) & |
|---|
| 2596 | ** 2.0_wp * ( in_cw(k) - cw_old ) * in_adn(k) |
|---|
| 2597 | pt_p(k,j,i) = pt_p(k,j,i) + alv / c_p * ( in_cw(k) - cw_old ) * & |
|---|
| 2598 | in_adn(k) / ( in_cw(k) / in_adn(k) + 1.0_wp ) ** 2.0_wp& |
|---|
| 2599 | * pt_p(k,j,i) / in_t(k) |
|---|
| 2600 | ENDIF |
|---|
| 2601 | |
|---|
| 2602 | ENDDO ! k |
|---|
| 2603 | ! |
|---|
| 2604 | !-- Set surfaces and wall fluxes due to deposition |
|---|
| 2605 | IF ( lsdepo_topo .AND. prunmode == 3 ) THEN |
|---|
| 2606 | IF ( .NOT. land_surface .AND. .NOT. urban_surface ) THEN |
|---|
| 2607 | CALL depo_topo( i, j, surf_def_h(0), vd, Sc, kvis, in_u, rho_air_zw ) |
|---|
| 2608 | DO l = 0, 3 |
|---|
| 2609 | CALL depo_topo( i, j, surf_def_v(l), vd, Sc, kvis, in_u, & |
|---|
| 2610 | rho_air_zw**0.0_wp ) |
|---|
| 2611 | ENDDO |
|---|
| 2612 | ELSE |
|---|
| 2613 | CALL depo_topo( i, j, surf_usm_h, vd, Sc, kvis, in_u, rho_air_zw ) |
|---|
| 2614 | DO l = 0, 3 |
|---|
| 2615 | CALL depo_topo( i, j, surf_usm_v(l), vd, Sc, kvis, in_u, & |
|---|
| 2616 | rho_air_zw**0.0_wp ) |
|---|
| 2617 | ENDDO |
|---|
| 2618 | CALL depo_topo( i, j, surf_lsm_h, vd, Sc, kvis, in_u, rho_air_zw ) |
|---|
| 2619 | DO l = 0, 3 |
|---|
| 2620 | CALL depo_topo( i, j, surf_lsm_v(l), vd, Sc, kvis, in_u, & |
|---|
| 2621 | rho_air_zw**0.0_wp ) |
|---|
| 2622 | ENDDO |
|---|
| 2623 | ENDIF |
|---|
| 2624 | ENDIF |
|---|
| 2625 | |
|---|
| 2626 | END SUBROUTINE salsa_driver |
|---|
| 2627 | |
|---|
| 2628 | !------------------------------------------------------------------------------! |
|---|
| 2629 | ! Description: |
|---|
| 2630 | ! ------------ |
|---|
| 2631 | !> The SALSA subroutine |
|---|
| 2632 | !> Modified for the new aerosol datatype, |
|---|
| 2633 | !> Juha Tonttila, FMI, 2014. |
|---|
| 2634 | !> Only aerosol processes included, Mona Kurppa, UHel, 2017 |
|---|
| 2635 | !------------------------------------------------------------------------------! |
|---|
| 2636 | SUBROUTINE run_salsa( ppres, pcw, pcs, ptemp, mag_u, adn, lad, pc_h2so4, & |
|---|
| 2637 | pc_ocnv, pc_ocsv, pc_hno3, pc_nh3, paero, prtcl, kvis, & |
|---|
| 2638 | Sc, vc, ptstep ) |
|---|
| 2639 | |
|---|
| 2640 | IMPLICIT NONE |
|---|
| 2641 | ! |
|---|
| 2642 | !-- Input parameters and variables |
|---|
| 2643 | REAL(wp), INTENT(in) :: adn !< air density (kg/m3) |
|---|
| 2644 | REAL(wp), INTENT(in) :: lad !< leaf area density (m2/m3) |
|---|
| 2645 | REAL(wp), INTENT(in) :: mag_u !< magnitude of wind (m/s) |
|---|
| 2646 | REAL(wp), INTENT(in) :: ppres !< atmospheric pressure at each grid |
|---|
| 2647 | !< point (Pa) |
|---|
| 2648 | REAL(wp), INTENT(in) :: ptemp !< temperature at each grid point (K) |
|---|
| 2649 | REAL(wp), INTENT(in) :: ptstep !< time step of salsa processes (s) |
|---|
| 2650 | TYPE(component_index), INTENT(in) :: prtcl !< part. component index table |
|---|
| 2651 | ! |
|---|
| 2652 | !-- Input variables that are changed within: |
|---|
| 2653 | REAL(wp), INTENT(inout) :: kvis !< kinematic viscosity of air (m2/s) |
|---|
| 2654 | REAL(wp), INTENT(inout) :: Sc(:) !< particle Schmidt number |
|---|
| 2655 | REAL(wp), INTENT(inout) :: vc(:) !< particle fall speed (m/s, |
|---|
| 2656 | !< sedimentation velocity) |
|---|
| 2657 | !-- Gas phase concentrations at each grid point (#/m3) |
|---|
| 2658 | REAL(wp), INTENT(inout) :: pc_h2so4 !< sulphuric acid |
|---|
| 2659 | REAL(wp), INTENT(inout) :: pc_hno3 !< nitric acid |
|---|
| 2660 | REAL(wp), INTENT(inout) :: pc_nh3 !< ammonia |
|---|
| 2661 | REAL(wp), INTENT(inout) :: pc_ocnv !< nonvolatile OC |
|---|
| 2662 | REAL(wp), INTENT(inout) :: pc_ocsv !< semivolatile OC |
|---|
| 2663 | REAL(wp), INTENT(inout) :: pcs !< Saturation concentration of water |
|---|
| 2664 | !< vapour (kg/m3) |
|---|
| 2665 | REAL(wp), INTENT(inout) :: pcw !< Water vapour concentration (kg/m3) |
|---|
| 2666 | TYPE(t_section), INTENT(inout) :: paero(fn2b) |
|---|
| 2667 | ! |
|---|
| 2668 | !-- Coagulation |
|---|
| 2669 | IF ( lscoag ) THEN |
|---|
| 2670 | CALL coagulation( paero, ptstep, ptemp, ppres ) |
|---|
| 2671 | ENDIF |
|---|
| 2672 | ! |
|---|
| 2673 | !-- Condensation |
|---|
| 2674 | IF ( lscnd ) THEN |
|---|
| 2675 | CALL condensation( paero, pc_h2so4, pc_ocnv, pc_ocsv, pc_hno3, pc_nh3, & |
|---|
| 2676 | pcw, pcs, ptemp, ppres, ptstep, prtcl ) |
|---|
| 2677 | ENDIF |
|---|
| 2678 | ! |
|---|
| 2679 | !-- Deposition |
|---|
| 2680 | IF ( lsdepo ) THEN |
|---|
| 2681 | CALL deposition( paero, ptemp, adn, mag_u, lad, kvis, Sc, vc ) |
|---|
| 2682 | ENDIF |
|---|
| 2683 | ! |
|---|
| 2684 | !-- Size distribution bin update |
|---|
| 2685 | !-- Mona: why done 3 times in SALSA-standalone? |
|---|
| 2686 | IF ( lsdistupdate ) THEN |
|---|
| 2687 | CALL distr_update( paero ) |
|---|
| 2688 | ENDIF |
|---|
| 2689 | |
|---|
| 2690 | END SUBROUTINE run_salsa |
|---|
| 2691 | |
|---|
| 2692 | !------------------------------------------------------------------------------! |
|---|
| 2693 | ! Description: |
|---|
| 2694 | ! ------------ |
|---|
| 2695 | !> Set logical switches according to the host model state and user-specified |
|---|
| 2696 | !> NAMELIST options. |
|---|
| 2697 | !> Juha Tonttila, FMI, 2014 |
|---|
| 2698 | !> Only aerosol processes included, Mona Kurppa, UHel, 2017 |
|---|
| 2699 | !------------------------------------------------------------------------------! |
|---|
| 2700 | SUBROUTINE set_salsa_runtime( prunmode ) |
|---|
| 2701 | |
|---|
| 2702 | IMPLICIT NONE |
|---|
| 2703 | |
|---|
| 2704 | INTEGER(iwp), INTENT(in) :: prunmode |
|---|
| 2705 | |
|---|
| 2706 | SELECT CASE(prunmode) |
|---|
| 2707 | |
|---|
| 2708 | CASE(1) !< Initialization |
|---|
| 2709 | lscoag = .FALSE. |
|---|
| 2710 | lscnd = .FALSE. |
|---|
| 2711 | lscndgas = .FALSE. |
|---|
| 2712 | lscndh2oae = .FALSE. |
|---|
| 2713 | lsdepo = .FALSE. |
|---|
| 2714 | lsdepo_vege = .FALSE. |
|---|
| 2715 | lsdepo_topo = .FALSE. |
|---|
| 2716 | lsdistupdate = .TRUE. |
|---|
| 2717 | |
|---|
| 2718 | CASE(2) !< Spinup period |
|---|
| 2719 | lscoag = ( .FALSE. .AND. nlcoag ) |
|---|
| 2720 | lscnd = ( .TRUE. .AND. nlcnd ) |
|---|
| 2721 | lscndgas = ( .TRUE. .AND. nlcndgas ) |
|---|
| 2722 | lscndh2oae = ( .TRUE. .AND. nlcndh2oae ) |
|---|
| 2723 | |
|---|
| 2724 | CASE(3) !< Run |
|---|
| 2725 | lscoag = nlcoag |
|---|
| 2726 | lscnd = nlcnd |
|---|
| 2727 | lscndgas = nlcndgas |
|---|
| 2728 | lscndh2oae = nlcndh2oae |
|---|
| 2729 | lsdepo = nldepo |
|---|
| 2730 | lsdepo_vege = nldepo_vege |
|---|
| 2731 | lsdepo_topo = nldepo_topo |
|---|
| 2732 | lsdistupdate = nldistupdate |
|---|
| 2733 | |
|---|
| 2734 | END SELECT |
|---|
| 2735 | |
|---|
| 2736 | |
|---|
| 2737 | END SUBROUTINE set_salsa_runtime |
|---|
| 2738 | |
|---|
| 2739 | !------------------------------------------------------------------------------! |
|---|
| 2740 | ! Description: |
|---|
| 2741 | ! ------------ |
|---|
| 2742 | !> Calculates the absolute temperature (using hydrostatic pressure), saturation |
|---|
| 2743 | !> vapour pressure and mixing ratio over water, relative humidity and air |
|---|
| 2744 | !> density needed in the SALSA model. |
|---|
| 2745 | !> NOTE, no saturation adjustment takes place -> the resulting water vapour |
|---|
| 2746 | !> mixing ratio can be supersaturated, allowing the microphysical calculations |
|---|
| 2747 | !> in SALSA. |
|---|
| 2748 | ! |
|---|
| 2749 | !> Juha Tonttila, FMI, 2014 (original SALSAthrm) |
|---|
| 2750 | !> Mona Kurppa, UHel, 2017 (adjustment for PALM and only aerosol processes) |
|---|
| 2751 | !------------------------------------------------------------------------------! |
|---|
| 2752 | SUBROUTINE salsa_thrm_ij( i, j, p_ij, temp_ij, cw_ij, cs_ij, adn_ij ) |
|---|
| 2753 | |
|---|
| 2754 | USE arrays_3d, & |
|---|
| 2755 | ONLY: p, pt, q, zu |
|---|
| 2756 | |
|---|
| 2757 | USE basic_constants_and_equations_mod, & |
|---|
| 2758 | ONLY: barometric_formula, exner_function, ideal_gas_law_rho, magnus |
|---|
| 2759 | |
|---|
| 2760 | USE control_parameters, & |
|---|
| 2761 | ONLY: pt_surface, surface_pressure |
|---|
| 2762 | |
|---|
| 2763 | IMPLICIT NONE |
|---|
| 2764 | |
|---|
| 2765 | INTEGER(iwp), INTENT(in) :: i |
|---|
| 2766 | INTEGER(iwp), INTENT(in) :: j |
|---|
| 2767 | REAL(wp), DIMENSION(:), INTENT(inout) :: adn_ij |
|---|
| 2768 | REAL(wp), DIMENSION(:), INTENT(inout) :: p_ij |
|---|
| 2769 | REAL(wp), DIMENSION(:), INTENT(inout) :: temp_ij |
|---|
| 2770 | REAL(wp), DIMENSION(:), INTENT(inout), OPTIONAL :: cw_ij |
|---|
| 2771 | REAL(wp), DIMENSION(:), INTENT(inout), OPTIONAL :: cs_ij |
|---|
| 2772 | REAL(wp), DIMENSION(nzb:nzt+1) :: e_s !< saturation vapour pressure |
|---|
| 2773 | !< over water (Pa) |
|---|
| 2774 | REAL(wp) :: t_surface !< absolute surface temperature (K) |
|---|
| 2775 | ! |
|---|
| 2776 | !-- Pressure p_ijk (Pa) = hydrostatic pressure + perturbation pressure (p) |
|---|
| 2777 | t_surface = pt_surface * exner_function( surface_pressure ) |
|---|
| 2778 | p_ij(:) = 100.0_wp * barometric_formula( zu, t_surface, surface_pressure ) & |
|---|
| 2779 | + p(:,j,i) |
|---|
| 2780 | ! |
|---|
| 2781 | !-- Absolute ambient temperature (K) |
|---|
| 2782 | temp_ij(:) = pt(:,j,i) * exner_function( p_ij(:) ) |
|---|
| 2783 | ! |
|---|
| 2784 | !-- Air density |
|---|
| 2785 | adn_ij(:) = ideal_gas_law_rho( p_ij(:), temp_ij(:) ) |
|---|
| 2786 | ! |
|---|
| 2787 | !-- Water vapour concentration r_v (kg/m3) |
|---|
| 2788 | IF ( PRESENT( cw_ij ) ) THEN |
|---|
| 2789 | cw_ij(:) = ( q(:,j,i) / ( 1.0_wp - q(:,j,i) ) ) * adn_ij(:) |
|---|
| 2790 | ENDIF |
|---|
| 2791 | ! |
|---|
| 2792 | !-- Saturation mixing ratio r_s (kg/kg) from vapour pressure at temp (Pa) |
|---|
| 2793 | IF ( PRESENT( cs_ij ) ) THEN |
|---|
| 2794 | e_s(:) = magnus( temp_ij(:) ) |
|---|
| 2795 | cs_ij(:) = ( 0.622_wp * e_s / ( p_ij(:) - e_s(:) ) ) * adn_ij(:) |
|---|
| 2796 | ENDIF |
|---|
| 2797 | |
|---|
| 2798 | END SUBROUTINE salsa_thrm_ij |
|---|
| 2799 | |
|---|
| 2800 | !------------------------------------------------------------------------------! |
|---|
| 2801 | ! Description: |
|---|
| 2802 | ! ------------ |
|---|
| 2803 | !> Calculates ambient sizes of particles by equilibrating soluble fraction of |
|---|
| 2804 | !> particles with water using the ZSR method (Stokes and Robinson, 1966). |
|---|
| 2805 | !> Method: |
|---|
| 2806 | !> Following chemical components are assumed water-soluble |
|---|
| 2807 | !> - (ammonium) sulphate (100%) |
|---|
| 2808 | !> - sea salt (100 %) |
|---|
| 2809 | !> - organic carbon (epsoc * 100%) |
|---|
| 2810 | !> Exact thermodynamic considerations neglected. |
|---|
| 2811 | !> - If particles contain no sea salt, calculation according to sulphate |
|---|
| 2812 | !> properties |
|---|
| 2813 | !> - If contain sea salt but no sulphate, calculation according to sea salt |
|---|
| 2814 | !> properties |
|---|
| 2815 | !> - If contain both sulphate and sea salt -> the molar fraction of these |
|---|
| 2816 | !> compounds determines which one of them is used as the basis of calculation. |
|---|
| 2817 | !> If sulphate and sea salt coexist in a particle, it is assumed that the Cl is |
|---|
| 2818 | !> replaced by sulphate; thus only either sulphate + organics or sea salt + |
|---|
| 2819 | !> organics is included in the calculation of soluble fraction. |
|---|
| 2820 | !> Molality parameterizations taken from Table 1 of Tang: Thermodynamic and |
|---|
| 2821 | !> optical properties of mixed-salt aerosols of atmospheric importance, |
|---|
| 2822 | !> J. Geophys. Res., 102 (D2), 1883-1893 (1997) |
|---|
| 2823 | ! |
|---|
| 2824 | !> Coded by: |
|---|
| 2825 | !> Hannele Korhonen (FMI) 2005 |
|---|
| 2826 | !> Harri Kokkola (FMI) 2006 |
|---|
| 2827 | !> Matti Niskanen(FMI) 2012 |
|---|
| 2828 | !> Anton Laakso (FMI) 2013 |
|---|
| 2829 | !> Modified for the new aerosol datatype, Juha Tonttila (FMI) 2014 |
|---|
| 2830 | ! |
|---|
| 2831 | !> fxm: should sea salt form a solid particle when prh is very low (even though |
|---|
| 2832 | !> it could be mixed with e.g. sulphate)? |
|---|
| 2833 | !> fxm: crashes if no sulphate or sea salt |
|---|
| 2834 | !> fxm: do we really need to consider Kelvin effect for subrange 2 |
|---|
| 2835 | !------------------------------------------------------------------------------! |
|---|
| 2836 | SUBROUTINE equilibration( prh, ptemp, paero, init ) |
|---|
| 2837 | |
|---|
| 2838 | IMPLICIT NONE |
|---|
| 2839 | ! |
|---|
| 2840 | !-- Input variables |
|---|
| 2841 | LOGICAL, INTENT(in) :: init !< TRUE: Initialization call |
|---|
| 2842 | !< FALSE: Normal runtime: update water |
|---|
| 2843 | !< content only for 1a |
|---|
| 2844 | REAL(wp), INTENT(in) :: prh !< relative humidity [0-1] |
|---|
| 2845 | REAL(wp), INTENT(in) :: ptemp !< temperature (K) |
|---|
| 2846 | ! |
|---|
| 2847 | !-- Output variables |
|---|
| 2848 | TYPE(t_section), INTENT(inout) :: paero(fn2b) |
|---|
| 2849 | ! |
|---|
| 2850 | !-- Local |
|---|
| 2851 | INTEGER(iwp) :: b !< loop index |
|---|
| 2852 | INTEGER(iwp) :: counti !< loop index |
|---|
| 2853 | REAL(wp) :: zaw !< water activity [0-1] |
|---|
| 2854 | REAL(wp) :: zbinmol(7) !< binary molality of each components (mol/kg) |
|---|
| 2855 | REAL(wp) :: zcore !< Volume of dry particle |
|---|
| 2856 | REAL(wp) :: zdold !< Old diameter |
|---|
| 2857 | REAL(wp) :: zdwet !< Wet diameter or mean droplet diameter |
|---|
| 2858 | REAL(wp) :: zke !< Kelvin term in the Köhler equation |
|---|
| 2859 | REAL(wp) :: zlwc !< liquid water content [kg/m3-air] |
|---|
| 2860 | REAL(wp) :: zrh !< Relative humidity |
|---|
| 2861 | REAL(wp) :: zvpart(7) !< volume of chem. compounds in one particle |
|---|
| 2862 | |
|---|
| 2863 | zaw = 0.0_wp |
|---|
| 2864 | zbinmol = 0.0_wp |
|---|
| 2865 | zcore = 0.0_wp |
|---|
| 2866 | zdold = 0.0_wp |
|---|
| 2867 | zdwet = 0.0_wp |
|---|
| 2868 | zlwc = 0.0_wp |
|---|
| 2869 | zrh = 0.0_wp |
|---|
| 2870 | |
|---|
| 2871 | ! |
|---|
| 2872 | !-- Relative humidity: |
|---|
| 2873 | zrh = prh |
|---|
| 2874 | zrh = MAX( zrh, 0.05_wp ) |
|---|
| 2875 | zrh = MIN( zrh, 0.98_wp) |
|---|
| 2876 | ! |
|---|
| 2877 | !-- 1) Regime 1: sulphate and partly water-soluble OC. Done for every CALL |
|---|
| 2878 | DO b = in1a, fn1a ! size bin |
|---|
| 2879 | |
|---|
| 2880 | zbinmol = 0.0_wp |
|---|
| 2881 | zdold = 1.0_wp |
|---|
| 2882 | zke = 1.02_wp |
|---|
| 2883 | |
|---|
| 2884 | IF ( paero(b)%numc > nclim ) THEN |
|---|
| 2885 | ! |
|---|
| 2886 | !-- Volume in one particle |
|---|
| 2887 | zvpart = 0.0_wp |
|---|
| 2888 | zvpart(1:2) = paero(b)%volc(1:2) / paero(b)%numc |
|---|
| 2889 | zvpart(6:7) = paero(b)%volc(6:7) / paero(b)%numc |
|---|
| 2890 | ! |
|---|
| 2891 | !-- Total volume and wet diameter of one dry particle |
|---|
| 2892 | zcore = SUM( zvpart(1:2) ) |
|---|
| 2893 | zdwet = paero(b)%dwet |
|---|
| 2894 | |
|---|
| 2895 | counti = 0 |
|---|
| 2896 | DO WHILE ( ABS( zdwet / zdold - 1.0_wp ) > 1.0E-2_wp ) |
|---|
| 2897 | |
|---|
| 2898 | zdold = MAX( zdwet, 1.0E-20_wp ) |
|---|
| 2899 | zaw = MAX( 1.0E-3_wp, zrh / zke ) ! To avoid underflow |
|---|
| 2900 | ! |
|---|
| 2901 | !-- Binary molalities (mol/kg): |
|---|
| 2902 | !-- Sulphate |
|---|
| 2903 | zbinmol(1) = 1.1065495E+2_wp - 3.6759197E+2_wp * zaw & |
|---|
| 2904 | + 5.0462934E+2_wp * zaw**2.0_wp & |
|---|
| 2905 | - 3.1543839E+2_wp * zaw**3.0_wp & |
|---|
| 2906 | + 6.770824E+1_wp * zaw**4.0_wp |
|---|
| 2907 | !-- Organic carbon |
|---|
| 2908 | zbinmol(2) = 1.0_wp / ( zaw * amh2o ) - 1.0_wp / amh2o |
|---|
| 2909 | !-- Nitric acid |
|---|
| 2910 | zbinmol(6) = 2.306844303E+1_wp - 3.563608869E+1_wp * zaw & |
|---|
| 2911 | - 6.210577919E+1_wp * zaw**2.0_wp & |
|---|
| 2912 | + 5.510176187E+2_wp * zaw**3.0_wp & |
|---|
| 2913 | - 1.460055286E+3_wp * zaw**4.0_wp & |
|---|
| 2914 | + 1.894467542E+3_wp * zaw**5.0_wp & |
|---|
| 2915 | - 1.220611402E+3_wp * zaw**6.0_wp & |
|---|
| 2916 | + 3.098597737E+2_wp * zaw**7.0_wp |
|---|
| 2917 | ! |
|---|
| 2918 | !-- Calculate the liquid water content (kg/m3-air) using ZSR (see e.g. |
|---|
| 2919 | !-- Eq. 10.98 in Seinfeld and Pandis (2006)) |
|---|
| 2920 | zlwc = ( paero(b)%volc(1) * ( arhoh2so4 / amh2so4 ) ) / & |
|---|
| 2921 | zbinmol(1) + epsoc * paero(b)%volc(2) * ( arhooc / amoc ) & |
|---|
| 2922 | / zbinmol(2) + ( paero(b)%volc(6) * ( arhohno3/amhno3 ) ) & |
|---|
| 2923 | / zbinmol(6) |
|---|
| 2924 | ! |
|---|
| 2925 | !-- Particle wet diameter (m) |
|---|
| 2926 | zdwet = ( zlwc / paero(b)%numc / arhoh2o / api6 + & |
|---|
| 2927 | ( SUM( zvpart(6:7) ) / api6 ) + & |
|---|
| 2928 | zcore / api6 )**( 1.0_wp / 3.0_wp ) |
|---|
| 2929 | ! |
|---|
| 2930 | !-- Kelvin effect (Eq. 10.85 in in Seinfeld and Pandis (2006)). Avoid |
|---|
| 2931 | !-- overflow. |
|---|
| 2932 | zke = EXP( MIN( 50.0_wp, & |
|---|
| 2933 | 4.0_wp * surfw0 * amvh2so4 / ( abo * ptemp * zdwet ) ) ) |
|---|
| 2934 | |
|---|
| 2935 | counti = counti + 1 |
|---|
| 2936 | IF ( counti > 1000 ) THEN |
|---|
| 2937 | message_string = 'Subrange 1: no convergence!' |
|---|
| 2938 | CALL message( 'salsa_mod: equilibration', 'SA0042', & |
|---|
| 2939 | 1, 2, 0, 6, 0 ) |
|---|
| 2940 | ENDIF |
|---|
| 2941 | ENDDO |
|---|
| 2942 | ! |
|---|
| 2943 | !-- Instead of lwc, use the volume concentration of water from now on |
|---|
| 2944 | !-- (easy to convert...) |
|---|
| 2945 | paero(b)%volc(8) = zlwc / arhoh2o |
|---|
| 2946 | ! |
|---|
| 2947 | !-- If this is initialization, update the core and wet diameter |
|---|
| 2948 | IF ( init ) THEN |
|---|
| 2949 | paero(b)%dwet = zdwet |
|---|
| 2950 | paero(b)%core = zcore |
|---|
| 2951 | ENDIF |
|---|
| 2952 | |
|---|
| 2953 | ELSE |
|---|
| 2954 | !-- If initialization |
|---|
| 2955 | !-- 1.2) empty bins given bin average values |
|---|
| 2956 | IF ( init ) THEN |
|---|
| 2957 | paero(b)%dwet = paero(b)%dmid |
|---|
| 2958 | paero(b)%core = api6 * paero(b)%dmid ** 3.0_wp |
|---|
| 2959 | ENDIF |
|---|
| 2960 | |
|---|
| 2961 | ENDIF |
|---|
| 2962 | |
|---|
| 2963 | ENDDO !< b |
|---|
| 2964 | ! |
|---|
| 2965 | !-- 2) Regime 2a: sulphate, OC, BC and sea salt |
|---|
| 2966 | !-- This is done only for initialization call, otherwise the water contents |
|---|
| 2967 | !-- are computed via condensation |
|---|
| 2968 | IF ( init ) THEN |
|---|
| 2969 | DO b = in2a, fn2b |
|---|
| 2970 | |
|---|
| 2971 | !-- Initialize |
|---|
| 2972 | zke = 1.02_wp |
|---|
| 2973 | zbinmol = 0.0_wp |
|---|
| 2974 | zdold = 1.0_wp |
|---|
| 2975 | ! |
|---|
| 2976 | !-- 1) Particle properties calculated for non-empty bins |
|---|
| 2977 | IF ( paero(b)%numc > nclim ) THEN |
|---|
| 2978 | ! |
|---|
| 2979 | !-- Volume in one particle [fxm] |
|---|
| 2980 | zvpart = 0.0_wp |
|---|
| 2981 | zvpart(1:7) = paero(b)%volc(1:7) / paero(b)%numc |
|---|
| 2982 | ! |
|---|
| 2983 | !-- Total volume and wet diameter of one dry particle [fxm] |
|---|
| 2984 | zcore = SUM( zvpart(1:5) ) |
|---|
| 2985 | zdwet = paero(b)%dwet |
|---|
| 2986 | |
|---|
| 2987 | counti = 0 |
|---|
| 2988 | DO WHILE ( ABS( zdwet / zdold - 1.0_wp ) > 1.0E-12_wp ) |
|---|
| 2989 | |
|---|
| 2990 | zdold = MAX( zdwet, 1.0E-20_wp ) |
|---|
| 2991 | zaw = zrh / zke |
|---|
| 2992 | ! |
|---|
| 2993 | !-- Binary molalities (mol/kg): |
|---|
| 2994 | !-- Sulphate |
|---|
| 2995 | zbinmol(1) = 1.1065495E+2_wp - 3.6759197E+2_wp * zaw & |
|---|
| 2996 | + 5.0462934E+2_wp * zaw**2 - 3.1543839E+2_wp * zaw**3 & |
|---|
| 2997 | + 6.770824E+1_wp * zaw**4 |
|---|
| 2998 | !-- Organic carbon |
|---|
| 2999 | zbinmol(2) = 1.0_wp / ( zaw * amh2o ) - 1.0_wp / amh2o |
|---|
| 3000 | !-- Nitric acid |
|---|
| 3001 | zbinmol(6) = 2.306844303E+1_wp - 3.563608869E+1_wp * zaw & |
|---|
| 3002 | - 6.210577919E+1_wp * zaw**2 + 5.510176187E+2_wp * zaw**3 & |
|---|
| 3003 | - 1.460055286E+3_wp * zaw**4 + 1.894467542E+3_wp * zaw**5 & |
|---|
| 3004 | - 1.220611402E+3_wp * zaw**6 + 3.098597737E+2_wp * zaw**7 |
|---|
| 3005 | !-- Sea salt (natrium chloride) |
|---|
| 3006 | zbinmol(5) = 5.875248E+1_wp - 1.8781997E+2_wp * zaw & |
|---|
| 3007 | + 2.7211377E+2_wp * zaw**2 - 1.8458287E+2_wp * zaw**3 & |
|---|
| 3008 | + 4.153689E+1_wp * zaw**4 |
|---|
| 3009 | ! |
|---|
| 3010 | !-- Calculate the liquid water content (kg/m3-air) |
|---|
| 3011 | zlwc = ( paero(b)%volc(1) * ( arhoh2so4 / amh2so4 ) ) / & |
|---|
| 3012 | zbinmol(1) + epsoc * ( paero(b)%volc(2) * ( arhooc / & |
|---|
| 3013 | amoc ) ) / zbinmol(2) + ( paero(b)%volc(6) * ( arhohno3 & |
|---|
| 3014 | / amhno3 ) ) / zbinmol(6) + ( paero(b)%volc(5) * & |
|---|
| 3015 | ( arhoss / amss ) ) / zbinmol(5) |
|---|
| 3016 | |
|---|
| 3017 | !-- Particle wet radius (m) |
|---|
| 3018 | zdwet = ( zlwc / paero(b)%numc / arhoh2o / api6 + & |
|---|
| 3019 | ( SUM( zvpart(6:7) ) / api6 ) + & |
|---|
| 3020 | zcore / api6 ) ** ( 1.0_wp / 3.0_wp ) |
|---|
| 3021 | ! |
|---|
| 3022 | !-- Kelvin effect (Eq. 10.85 in Seinfeld and Pandis (2006)) |
|---|
| 3023 | zke = EXP( MIN( 50.0_wp, & |
|---|
| 3024 | 4.0_wp * surfw0 * amvh2so4 / ( abo * zdwet * ptemp ) ) ) |
|---|
| 3025 | |
|---|
| 3026 | counti = counti + 1 |
|---|
| 3027 | IF ( counti > 1000 ) THEN |
|---|
| 3028 | message_string = 'Subrange 2: no convergence!' |
|---|
| 3029 | CALL message( 'salsa_mod: equilibration', 'SA0043', & |
|---|
| 3030 | 1, 2, 0, 6, 0 ) |
|---|
| 3031 | ENDIF |
|---|
| 3032 | ENDDO |
|---|
| 3033 | ! |
|---|
| 3034 | !-- Liquid water content; instead of LWC use the volume concentration |
|---|
| 3035 | paero(b)%volc(8) = zlwc / arhoh2o |
|---|
| 3036 | paero(b)%dwet = zdwet |
|---|
| 3037 | paero(b)%core = zcore |
|---|
| 3038 | |
|---|
| 3039 | ELSE |
|---|
| 3040 | !-- 2.2) empty bins given bin average values |
|---|
| 3041 | paero(b)%dwet = paero(b)%dmid |
|---|
| 3042 | paero(b)%core = api6 * paero(b)%dmid ** 3.0_wp |
|---|
| 3043 | ENDIF |
|---|
| 3044 | |
|---|
| 3045 | ENDDO ! b |
|---|
| 3046 | ENDIF |
|---|
| 3047 | |
|---|
| 3048 | END SUBROUTINE equilibration |
|---|
| 3049 | |
|---|
| 3050 | !------------------------------------------------------------------------------! |
|---|
| 3051 | !> Description: |
|---|
| 3052 | !> ------------ |
|---|
| 3053 | !> Calculation of the settling velocity vc (m/s) per aerosol size bin and |
|---|
| 3054 | !> deposition on plant canopy (lsdepo_vege). |
|---|
| 3055 | ! |
|---|
| 3056 | !> Deposition is based on either the scheme presented in: |
|---|
| 3057 | !> Zhang et al. (2001), Atmos. Environ. 35, 549-560 (includes collection due to |
|---|
| 3058 | !> Brownian diffusion, impaction, interception and sedimentation) |
|---|
| 3059 | !> OR |
|---|
| 3060 | !> Petroff & Zhang (2010), Geosci. Model Dev. 3, 753-769 (includes also |
|---|
| 3061 | !> collection due to turbulent impaction) |
|---|
| 3062 | ! |
|---|
| 3063 | !> Equation numbers refer to equation in Jacobson (2005): Fundamentals of |
|---|
| 3064 | !> Atmospheric Modeling, 2nd Edition. |
|---|
| 3065 | ! |
|---|
| 3066 | !> Subroutine follows closely sedim_SALSA in UCLALES-SALSA written by Juha |
|---|
| 3067 | !> Tonttila (KIT/FMI) and Zubair Maalick (UEF). |
|---|
| 3068 | !> Rewritten to PALM by Mona Kurppa (UH), 2017. |
|---|
| 3069 | ! |
|---|
| 3070 | !> Call for grid point i,j,k |
|---|
| 3071 | !------------------------------------------------------------------------------! |
|---|
| 3072 | |
|---|
| 3073 | SUBROUTINE deposition( paero, tk, adn, mag_u, lad, kvis, Sc, vc ) |
|---|
| 3074 | |
|---|
| 3075 | USE plant_canopy_model_mod, & |
|---|
| 3076 | ONLY: cdc |
|---|
| 3077 | |
|---|
| 3078 | IMPLICIT NONE |
|---|
| 3079 | |
|---|
| 3080 | REAL(wp), INTENT(in) :: adn !< air density (kg/m3) |
|---|
| 3081 | REAL(wp), INTENT(out) :: kvis !< kinematic viscosity of air (m2/s) |
|---|
| 3082 | REAL(wp), INTENT(in) :: lad !< leaf area density (m2/m3) |
|---|
| 3083 | REAL(wp), INTENT(in) :: mag_u !< wind velocity (m/s) |
|---|
| 3084 | REAL(wp), INTENT(out) :: Sc(:) !< particle Schmidt number |
|---|
| 3085 | REAL(wp), INTENT(in) :: tk !< abs.temperature (K) |
|---|
| 3086 | REAL(wp), INTENT(out) :: vc(:) !< critical fall speed i.e. settling |
|---|
| 3087 | !< velocity of an aerosol particle (m/s) |
|---|
| 3088 | TYPE(t_section), INTENT(inout) :: paero(fn2b) |
|---|
| 3089 | |
|---|
| 3090 | INTEGER(iwp) :: b !< loop index |
|---|
| 3091 | INTEGER(iwp) :: c !< loop index |
|---|
| 3092 | REAL(wp) :: avis !< molecular viscocity of air (kg/(m*s)) |
|---|
| 3093 | REAL(wp), PARAMETER :: c_A = 1.249_wp !< Constants A, B and C for |
|---|
| 3094 | REAL(wp), PARAMETER :: c_B = 0.42_wp !< calculating the Cunningham |
|---|
| 3095 | REAL(wp), PARAMETER :: c_C = 0.87_wp !< slip-flow correction (Cc) |
|---|
| 3096 | !< according to Jacobson (2005), |
|---|
| 3097 | !< Eq. 15.30 |
|---|
| 3098 | REAL(wp) :: Cc !< Cunningham slip-flow correction factor |
|---|
| 3099 | REAL(wp) :: Kn !< Knudsen number |
|---|
| 3100 | REAL(wp) :: lambda !< molecular mean free path (m) |
|---|
| 3101 | REAL(wp) :: mdiff !< particle diffusivity coefficient |
|---|
| 3102 | REAL(wp) :: pdn !< particle density (kg/m3) |
|---|
| 3103 | REAL(wp) :: ustar !< friction velocity (m/s) |
|---|
| 3104 | REAL(wp) :: va !< thermal speed of an air molecule (m/s) |
|---|
| 3105 | REAL(wp) :: zdwet !< wet diameter (m) |
|---|
| 3106 | ! |
|---|
| 3107 | !-- Initialise |
|---|
| 3108 | Cc = 0.0_wp |
|---|
| 3109 | Kn = 0.0_wp |
|---|
| 3110 | mdiff = 0.0_wp |
|---|
| 3111 | pdn = 1500.0_wp ! default value |
|---|
| 3112 | ustar = 0.0_wp |
|---|
| 3113 | ! |
|---|
| 3114 | !-- Molecular viscosity of air (Eq. 4.54) |
|---|
| 3115 | avis = 1.8325E-5_wp * ( 416.16_wp / ( tk + 120.0_wp ) ) * ( tk / & |
|---|
| 3116 | 296.16_wp )**1.5_wp |
|---|
| 3117 | ! |
|---|
| 3118 | !-- Kinematic viscosity (Eq. 4.55) |
|---|
| 3119 | kvis = avis / adn |
|---|
| 3120 | ! |
|---|
| 3121 | !-- Thermal velocity of an air molecule (Eq. 15.32) |
|---|
| 3122 | va = SQRT( 8.0_wp * abo * tk / ( pi * am_airmol ) ) |
|---|
| 3123 | ! |
|---|
| 3124 | !-- Mean free path (m) (Eq. 15.24) |
|---|
| 3125 | lambda = 2.0_wp * avis / ( adn * va ) |
|---|
| 3126 | |
|---|
| 3127 | DO b = 1, nbins |
|---|
| 3128 | |
|---|
| 3129 | IF ( paero(b)%numc < nclim ) CYCLE |
|---|
| 3130 | zdwet = paero(b)%dwet |
|---|
| 3131 | ! |
|---|
| 3132 | !-- Knudsen number (Eq. 15.23) |
|---|
| 3133 | Kn = MAX( 1.0E-2_wp, lambda / ( zdwet * 0.5_wp ) ) ! To avoid underflow |
|---|
| 3134 | ! |
|---|
| 3135 | !-- Cunningham slip-flow correction (Eq. 15.30) |
|---|
| 3136 | Cc = 1.0_wp + Kn * ( c_A + c_B * EXP( -c_C / Kn ) ) |
|---|
| 3137 | |
|---|
| 3138 | !-- Particle diffusivity coefficient (Eq. 15.29) |
|---|
| 3139 | mdiff = ( abo * tk * Cc ) / ( 3.0_wp * pi * avis * zdwet ) |
|---|
| 3140 | ! |
|---|
| 3141 | !-- Particle Schmidt number (Eq. 15.36) |
|---|
| 3142 | Sc(b) = kvis / mdiff |
|---|
| 3143 | ! |
|---|
| 3144 | !-- Critical fall speed i.e. settling velocity (Eq. 20.4) |
|---|
| 3145 | vc(b) = MIN( 1.0_wp, terminal_vel( 0.5_wp * zdwet, pdn, adn, avis, Cc) ) |
|---|
| 3146 | |
|---|
| 3147 | IF ( lsdepo_vege .AND. plant_canopy .AND. lad > 0.0_wp ) THEN |
|---|
| 3148 | ! |
|---|
| 3149 | !-- Friction velocity calculated following Prandtl (1925): |
|---|
| 3150 | ustar = SQRT( cdc ) * mag_u |
|---|
| 3151 | CALL depo_vege( paero, b, vc(b), mag_u, ustar, kvis, Sc(b), lad ) |
|---|
| 3152 | ENDIF |
|---|
| 3153 | ENDDO |
|---|
| 3154 | |
|---|
| 3155 | END SUBROUTINE deposition |
|---|
| 3156 | |
|---|
| 3157 | !------------------------------------------------------------------------------! |
|---|
| 3158 | ! Description: |
|---|
| 3159 | ! ------------ |
|---|
| 3160 | !> Calculate change in number and volume concentrations due to deposition on |
|---|
| 3161 | !> plant canopy. |
|---|
| 3162 | !------------------------------------------------------------------------------! |
|---|
| 3163 | SUBROUTINE depo_vege( paero, b, vc, mag_u, ustar, kvis_a, Sc, lad ) |
|---|
| 3164 | |
|---|
| 3165 | IMPLICIT NONE |
|---|
| 3166 | |
|---|
| 3167 | INTEGER(iwp), INTENT(in) :: b !< loop index |
|---|
| 3168 | REAL(wp), INTENT(in) :: kvis_a !< kinematic viscosity of air (m2/s) |
|---|
| 3169 | REAL(wp), INTENT(in) :: lad !< leaf area density (m2/m3) |
|---|
| 3170 | REAL(wp), INTENT(in) :: mag_u !< wind velocity (m/s) |
|---|
| 3171 | REAL(wp), INTENT(in) :: Sc !< particle Schmidt number |
|---|
| 3172 | REAL(wp), INTENT(in) :: ustar !< friction velocity (m/s) |
|---|
| 3173 | REAL(wp), INTENT(in) :: vc !< terminal velocity (m/s) |
|---|
| 3174 | TYPE(t_section), INTENT(inout) :: paero(fn2b) |
|---|
| 3175 | |
|---|
| 3176 | INTEGER(iwp) :: c !< loop index |
|---|
| 3177 | REAL(wp), PARAMETER :: c_A = 1.249_wp !< Constants A, B and C for |
|---|
| 3178 | REAL(wp), PARAMETER :: c_B = 0.42_wp !< calculating the Cunningham |
|---|
| 3179 | REAL(wp), PARAMETER :: c_C = 0.87_wp !< slip-flow correction (Cc) |
|---|
| 3180 | !< according to Jacobson (2005), |
|---|
| 3181 | !< Eq. 15.30 |
|---|
| 3182 | REAL(wp) :: alpha !< parameter, Table 3 in Zhang et al. (2001) |
|---|
| 3183 | REAL(wp) :: depo !< deposition efficiency |
|---|
| 3184 | REAL(wp) :: C_Br !< coefficient for Brownian diffusion |
|---|
| 3185 | REAL(wp) :: C_IM !< coefficient for inertial impaction |
|---|
| 3186 | REAL(wp) :: C_IN !< coefficient for interception |
|---|
| 3187 | REAL(wp) :: C_IT !< coefficient for turbulent impaction |
|---|
| 3188 | REAL(wp) :: gamma !< parameter, Table 3 in Zhang et al. (2001) |
|---|
| 3189 | REAL(wp) :: par_A !< parameter A for the characteristic radius of |
|---|
| 3190 | !< collectors, Table 3 in Zhang et al. (2001) |
|---|
| 3191 | REAL(wp) :: rt !< the overall quasi-laminar resistance for |
|---|
| 3192 | !< particles |
|---|
| 3193 | REAL(wp) :: St !< Stokes number for smooth surfaces or bluff |
|---|
| 3194 | !< surface elements |
|---|
| 3195 | REAL(wp) :: tau_plus !< dimensionless particle relaxation time |
|---|
| 3196 | REAL(wp) :: v_bd !< deposition velocity due to Brownian diffusion |
|---|
| 3197 | REAL(wp) :: v_im !< deposition velocity due to impaction |
|---|
| 3198 | REAL(wp) :: v_in !< deposition velocity due to interception |
|---|
| 3199 | REAL(wp) :: v_it !< deposition velocity due to turbulent impaction |
|---|
| 3200 | ! |
|---|
| 3201 | !-- Initialise |
|---|
| 3202 | depo = 0.0_wp |
|---|
| 3203 | rt = 0.0_wp |
|---|
| 3204 | St = 0.0_wp |
|---|
| 3205 | tau_plus = 0.0_wp |
|---|
| 3206 | v_bd = 0.0_wp |
|---|
| 3207 | v_im = 0.0_wp |
|---|
| 3208 | v_in = 0.0_wp |
|---|
| 3209 | v_it = 0.0_wp |
|---|
| 3210 | |
|---|
| 3211 | IF ( depo_vege_type == 'zhang2001' ) THEN |
|---|
| 3212 | ! |
|---|
| 3213 | !-- Parameters for the land use category 'deciduous broadleaf trees'(Table 3) |
|---|
| 3214 | par_A = 5.0E-3_wp |
|---|
| 3215 | alpha = 0.8_wp |
|---|
| 3216 | gamma = 0.56_wp |
|---|
| 3217 | ! |
|---|
| 3218 | !-- Stokes number for vegetated surfaces (Seinfeld & Pandis (2006): Eq.19.24) |
|---|
| 3219 | St = vc * ustar / ( g * par_A ) |
|---|
| 3220 | ! |
|---|
| 3221 | !-- The overall quasi-laminar resistance for particles (Zhang et al., Eq. 5) |
|---|
| 3222 | rt = MAX( EPSILON( 1.0_wp ), ( 3.0_wp * ustar * EXP( -St**0.5_wp ) * & |
|---|
| 3223 | ( Sc**( -gamma ) + ( St / ( alpha + St ) )**2.0_wp + & |
|---|
| 3224 | 0.5_wp * ( paero(b)%dwet / par_A )**2.0_wp ) ) ) |
|---|
| 3225 | depo = ( rt + vc ) * lad |
|---|
| 3226 | paero(b)%numc = paero(b)%numc - depo * paero(b)%numc * dt_salsa |
|---|
| 3227 | DO c = 1, maxspec+1 |
|---|
| 3228 | paero(b)%volc(c) = paero(b)%volc(c) - depo * paero(b)%volc(c) * & |
|---|
| 3229 | dt_salsa |
|---|
| 3230 | ENDDO |
|---|
| 3231 | |
|---|
| 3232 | ELSEIF ( depo_vege_type == 'petroff2010' ) THEN |
|---|
| 3233 | ! |
|---|
| 3234 | !-- vd = v_BD + v_IN + v_IM + v_IT + vc |
|---|
| 3235 | !-- Deposition efficiencies from Table 1. Constants from Table 2. |
|---|
| 3236 | C_Br = 1.262_wp |
|---|
| 3237 | C_IM = 0.130_wp |
|---|
| 3238 | C_IN = 0.216_wp |
|---|
| 3239 | C_IT = 0.056_wp |
|---|
| 3240 | par_A = 0.03_wp ! Here: leaf width (m) |
|---|
| 3241 | ! |
|---|
| 3242 | !-- Stokes number for vegetated surfaces (Seinfeld & Pandis (2006): Eq.19.24) |
|---|
| 3243 | St = vc * ustar / ( g * par_A ) |
|---|
| 3244 | ! |
|---|
| 3245 | !-- Non-dimensional relexation time of the particle on top of canopy |
|---|
| 3246 | tau_plus = vc * ustar**2.0_wp / ( kvis_a * g ) |
|---|
| 3247 | ! |
|---|
| 3248 | !-- Brownian diffusion |
|---|
| 3249 | v_bd = mag_u * C_Br * Sc**( -2.0_wp / 3.0_wp ) * & |
|---|
| 3250 | ( mag_u * par_A / kvis_a )**( -0.5_wp ) |
|---|
| 3251 | ! |
|---|
| 3252 | !-- Interception |
|---|
| 3253 | v_in = mag_u * C_IN * paero(b)%dwet / par_A * ( 2.0_wp + LOG( 2.0_wp * & |
|---|
| 3254 | par_A / paero(b)%dwet ) ) |
|---|
| 3255 | ! |
|---|
| 3256 | !-- Impaction: Petroff (2009) Eq. 18 |
|---|
| 3257 | v_im = mag_u * C_IM * ( St / ( St + 0.47_wp ) )**2.0_wp |
|---|
| 3258 | |
|---|
| 3259 | IF ( tau_plus < 20.0_wp ) THEN |
|---|
| 3260 | v_it = 2.5E-3_wp * C_IT * tau_plus**2.0_wp |
|---|
| 3261 | ELSE |
|---|
| 3262 | v_it = C_IT |
|---|
| 3263 | ENDIF |
|---|
| 3264 | depo = ( v_bd + v_in + v_im + v_it + vc ) * lad |
|---|
| 3265 | paero(b)%numc = paero(b)%numc - depo * paero(b)%numc * dt_salsa |
|---|
| 3266 | DO c = 1, maxspec+1 |
|---|
| 3267 | paero(b)%volc(c) = paero(b)%volc(c) - depo * paero(b)%volc(c) * & |
|---|
| 3268 | dt_salsa |
|---|
| 3269 | ENDDO |
|---|
| 3270 | ENDIF |
|---|
| 3271 | |
|---|
| 3272 | END SUBROUTINE depo_vege |
|---|
| 3273 | |
|---|
| 3274 | !------------------------------------------------------------------------------! |
|---|
| 3275 | ! Description: |
|---|
| 3276 | ! ------------ |
|---|
| 3277 | !> Calculate deposition on horizontal and vertical surfaces. Implement as |
|---|
| 3278 | !> surface flux. |
|---|
| 3279 | !------------------------------------------------------------------------------! |
|---|
| 3280 | |
|---|
| 3281 | SUBROUTINE depo_topo( i, j, surf, vc, Sc, kvis, mag_u, norm ) |
|---|
| 3282 | |
|---|
| 3283 | USE surface_mod, & |
|---|
| 3284 | ONLY: surf_type |
|---|
| 3285 | |
|---|
| 3286 | IMPLICIT NONE |
|---|
| 3287 | |
|---|
| 3288 | INTEGER(iwp), INTENT(in) :: i !< loop index |
|---|
| 3289 | INTEGER(iwp), INTENT(in) :: j !< loop index |
|---|
| 3290 | REAL(wp), INTENT(in) :: kvis(:) !< kinematic viscosity of air (m2/s) |
|---|
| 3291 | REAL(wp), INTENT(in) :: mag_u(:) !< wind velocity (m/s) |
|---|
| 3292 | REAL(wp), INTENT(in) :: norm(:) !< normalisation (usually air density) |
|---|
| 3293 | REAL(wp), INTENT(in) :: Sc(:,:) !< particle Schmidt number |
|---|
| 3294 | REAL(wp), INTENT(in) :: vc(:,:) !< terminal velocity (m/s) |
|---|
| 3295 | TYPE(surf_type), INTENT(inout) :: surf !< respective surface type |
|---|
| 3296 | INTEGER(iwp) :: b !< loop index |
|---|
| 3297 | INTEGER(iwp) :: c !< loop index |
|---|
| 3298 | INTEGER(iwp) :: k !< loop index |
|---|
| 3299 | INTEGER(iwp) :: m !< loop index |
|---|
| 3300 | INTEGER(iwp) :: surf_e !< End index of surface elements at (j,i)-gridpoint |
|---|
| 3301 | INTEGER(iwp) :: surf_s !< Start index of surface elements at (j,i)-gridpoint |
|---|
| 3302 | REAL(wp) :: alpha !< parameter, Table 3 in Zhang et al. (2001) |
|---|
| 3303 | REAL(wp) :: C_Br !< coefficient for Brownian diffusion |
|---|
| 3304 | REAL(wp) :: C_IM !< coefficient for inertial impaction |
|---|
| 3305 | REAL(wp) :: C_IN !< coefficient for interception |
|---|
| 3306 | REAL(wp) :: C_IT !< coefficient for turbulent impaction |
|---|
| 3307 | REAL(wp) :: depo !< deposition efficiency |
|---|
| 3308 | REAL(wp) :: gamma !< parameter, Table 3 in Zhang et al. (2001) |
|---|
| 3309 | REAL(wp) :: par_A !< parameter A for the characteristic radius of |
|---|
| 3310 | !< collectors, Table 3 in Zhang et al. (2001) |
|---|
| 3311 | REAL(wp) :: rt !< the overall quasi-laminar resistance for |
|---|
| 3312 | !< particles |
|---|
| 3313 | REAL(wp) :: St !< Stokes number for bluff surface elements |
|---|
| 3314 | REAL(wp) :: tau_plus !< dimensionless particle relaxation time |
|---|
| 3315 | REAL(wp) :: v_bd !< deposition velocity due to Brownian diffusion |
|---|
| 3316 | REAL(wp) :: v_im !< deposition velocity due to impaction |
|---|
| 3317 | REAL(wp) :: v_in !< deposition velocity due to interception |
|---|
| 3318 | REAL(wp) :: v_it !< deposition velocity due to turbulent impaction |
|---|
| 3319 | ! |
|---|
| 3320 | !-- Initialise |
|---|
| 3321 | rt = 0.0_wp |
|---|
| 3322 | St = 0.0_wp |
|---|
| 3323 | tau_plus = 0.0_wp |
|---|
| 3324 | v_bd = 0.0_wp |
|---|
| 3325 | v_im = 0.0_wp |
|---|
| 3326 | v_in = 0.0_wp |
|---|
| 3327 | v_it = 0.0_wp |
|---|
| 3328 | surf_s = surf%start_index(j,i) |
|---|
| 3329 | surf_e = surf%end_index(j,i) |
|---|
| 3330 | |
|---|
| 3331 | DO m = surf_s, surf_e |
|---|
| 3332 | k = surf%k(m) |
|---|
| 3333 | DO b = 1, nbins |
|---|
| 3334 | IF ( aerosol_number(b)%conc(k,j,i) <= nclim .OR. & |
|---|
| 3335 | Sc(k+1,b) < 1.0_wp ) CYCLE |
|---|
| 3336 | |
|---|
| 3337 | IF ( depo_topo_type == 'zhang2001' ) THEN |
|---|
| 3338 | ! |
|---|
| 3339 | !-- Parameters for the land use category 'urban' in Table 3 |
|---|
| 3340 | alpha = 1.5_wp |
|---|
| 3341 | gamma = 0.56_wp |
|---|
| 3342 | par_A = 10.0E-3_wp |
|---|
| 3343 | ! |
|---|
| 3344 | !-- Stokes number for smooth surfaces or surfaces with bluff roughness |
|---|
| 3345 | !-- elements (Seinfeld and Pandis, 2nd edition (2006): Eq. 19.23) |
|---|
| 3346 | St = MAX( 0.01_wp, vc(k+1,b) * surf%us(m) ** 2.0_wp / & |
|---|
| 3347 | ( g * kvis(k+1) ) ) |
|---|
| 3348 | ! |
|---|
| 3349 | !-- The overall quasi-laminar resistance for particles (Eq. 5) |
|---|
| 3350 | rt = MAX( EPSILON( 1.0_wp ), ( 3.0_wp * surf%us(m) * ( & |
|---|
| 3351 | Sc(k+1,b)**( -gamma ) + ( St / ( alpha + St ) )**2.0_wp & |
|---|
| 3352 | + 0.5_wp * ( Ra_dry(k,j,i,b) / par_A )**2.0_wp ) * & |
|---|
| 3353 | EXP( -St**0.5_wp ) ) ) |
|---|
| 3354 | depo = vc(k+1,b) + rt |
|---|
| 3355 | |
|---|
| 3356 | ELSEIF ( depo_topo_type == 'petroff2010' ) THEN |
|---|
| 3357 | ! |
|---|
| 3358 | !-- vd = v_BD + v_IN + v_IM + v_IT + vc |
|---|
| 3359 | !-- Deposition efficiencies from Table 1. Constants from Table 2. |
|---|
| 3360 | C_Br = 1.262_wp |
|---|
| 3361 | C_IM = 0.130_wp |
|---|
| 3362 | C_IN = 0.216_wp |
|---|
| 3363 | C_IT = 0.056_wp |
|---|
| 3364 | par_A = 0.03_wp ! Here: leaf width (m) |
|---|
| 3365 | ! |
|---|
| 3366 | !-- Stokes number for smooth surfaces or surfaces with bluff roughness |
|---|
| 3367 | !-- elements (Seinfeld and Pandis, 2nd edition (2006): Eq. 19.23) |
|---|
| 3368 | St = MAX( 0.01_wp, vc(k+1,b) * surf%us(m) ** 2.0_wp / & |
|---|
| 3369 | ( g * kvis(k+1) ) ) |
|---|
| 3370 | ! |
|---|
| 3371 | !-- Non-dimensional relexation time of the particle on top of canopy |
|---|
| 3372 | tau_plus = vc(k+1,b) * surf%us(m)**2.0_wp / ( kvis(k+1) * g ) |
|---|
| 3373 | ! |
|---|
| 3374 | !-- Brownian diffusion |
|---|
| 3375 | v_bd = mag_u(k+1) * C_Br * Sc(k+1,b)**( -2.0_wp / 3.0_wp ) * & |
|---|
| 3376 | ( mag_u(k+1) * par_A / kvis(k+1) )**( -0.5_wp ) |
|---|
| 3377 | ! |
|---|
| 3378 | !-- Interception |
|---|
| 3379 | v_in = mag_u(k+1) * C_IN * Ra_dry(k,j,i,b)/ par_A * ( 2.0_wp + & |
|---|
| 3380 | LOG( 2.0_wp * par_A / Ra_dry(k,j,i,b) ) ) |
|---|
| 3381 | ! |
|---|
| 3382 | !-- Impaction: Petroff (2009) Eq. 18 |
|---|
| 3383 | v_im = mag_u(k+1) * C_IM * ( St / ( St + 0.47_wp ) )**2.0_wp |
|---|
| 3384 | |
|---|
| 3385 | IF ( tau_plus < 20.0_wp ) THEN |
|---|
| 3386 | v_it = 2.5E-3_wp * C_IT * tau_plus**2.0_wp |
|---|
| 3387 | ELSE |
|---|
| 3388 | v_it = C_IT |
|---|
| 3389 | ENDIF |
|---|
| 3390 | depo = v_bd + v_in + v_im + v_it + vc(k+1,b) |
|---|
| 3391 | |
|---|
| 3392 | ENDIF |
|---|
| 3393 | IF ( lod_aero == 3 .OR. salsa_source_mode == 'no_source' ) THEN |
|---|
| 3394 | surf%answs(m,b) = -depo * norm(k) * aerosol_number(b)%conc(k,j,i) |
|---|
| 3395 | DO c = 1, ncc_tot |
|---|
| 3396 | surf%amsws(m,(c-1)*nbins+b) = -depo * norm(k) * & |
|---|
| 3397 | aerosol_mass((c-1)*nbins+b)%conc(k,j,i) |
|---|
| 3398 | ENDDO ! c |
|---|
| 3399 | ELSE |
|---|
| 3400 | surf%answs(m,b) = SUM( aerosol_number(b)%source(:,j,i) ) - & |
|---|
| 3401 | MAX( 0.0_wp, depo * norm(k) * & |
|---|
| 3402 | aerosol_number(b)%conc(k,j,i) ) |
|---|
| 3403 | DO c = 1, ncc_tot |
|---|
| 3404 | surf%amsws(m,(c-1)*nbins+b) = SUM( & |
|---|
| 3405 | aerosol_mass((c-1)*nbins+b)%source(:,j,i) ) - & |
|---|
| 3406 | MAX( 0.0_wp, depo * norm(k) * & |
|---|
| 3407 | aerosol_mass((c-1)*nbins+b)%conc(k,j,i) ) |
|---|
| 3408 | ENDDO |
|---|
| 3409 | ENDIF |
|---|
| 3410 | ENDDO ! b |
|---|
| 3411 | ENDDO ! m |
|---|
| 3412 | |
|---|
| 3413 | END SUBROUTINE depo_topo |
|---|
| 3414 | |
|---|
| 3415 | !------------------------------------------------------------------------------! |
|---|
| 3416 | ! Description: |
|---|
| 3417 | ! ------------ |
|---|
| 3418 | ! Function for calculating terminal velocities for different particles sizes. |
|---|
| 3419 | !------------------------------------------------------------------------------! |
|---|
| 3420 | REAL(wp) FUNCTION terminal_vel( radius, rhop, rhoa, visc, beta ) |
|---|
| 3421 | |
|---|
| 3422 | IMPLICIT NONE |
|---|
| 3423 | |
|---|
| 3424 | REAL(wp), INTENT(in) :: beta !< Cunningham correction factor |
|---|
| 3425 | REAL(wp), INTENT(in) :: radius !< particle radius (m) |
|---|
| 3426 | REAL(wp), INTENT(in) :: rhop !< particle density (kg/m3) |
|---|
| 3427 | REAL(wp), INTENT(in) :: rhoa !< air density (kg/m3) |
|---|
| 3428 | REAL(wp), INTENT(in) :: visc !< molecular viscosity of air (kg/(m*s)) |
|---|
| 3429 | |
|---|
| 3430 | REAL(wp), PARAMETER :: rhoa_ref = 1.225_wp ! reference air density (kg/m3) |
|---|
| 3431 | ! |
|---|
| 3432 | !-- Stokes law with Cunningham slip correction factor |
|---|
| 3433 | terminal_vel = ( 4.0_wp * radius**2.0_wp ) * ( rhop - rhoa ) * g * beta / & |
|---|
| 3434 | ( 18.0_wp * visc ) ! (m/s) |
|---|
| 3435 | |
|---|
| 3436 | END FUNCTION terminal_vel |
|---|
| 3437 | |
|---|
| 3438 | !------------------------------------------------------------------------------! |
|---|
| 3439 | ! Description: |
|---|
| 3440 | ! ------------ |
|---|
| 3441 | !> Calculates particle loss and change in size distribution due to (Brownian) |
|---|
| 3442 | !> coagulation. Only for particles with dwet < 30 micrometres. |
|---|
| 3443 | ! |
|---|
| 3444 | !> Method: |
|---|
| 3445 | !> Semi-implicit, non-iterative method: (Jacobson, 1994) |
|---|
| 3446 | !> Volume concentrations of the smaller colliding particles added to the bin of |
|---|
| 3447 | !> the larger colliding particles. Start from first bin and use the updated |
|---|
| 3448 | !> number and volume for calculation of following bins. NB! Our bin numbering |
|---|
| 3449 | !> does not follow particle size in subrange 2. |
|---|
| 3450 | ! |
|---|
| 3451 | !> Schematic for bin numbers in different subranges: |
|---|
| 3452 | !> 1 2 |
|---|
| 3453 | !> +-------------------------------------------+ |
|---|
| 3454 | !> a | 1 | 2 | 3 || 4 | 5 | 6 | 7 | 8 | 9 | 10|| |
|---|
| 3455 | !> b | ||11 |12 |13 |14 | 15 | 16 | 17|| |
|---|
| 3456 | !> +-------------------------------------------+ |
|---|
| 3457 | ! |
|---|
| 3458 | !> Exact coagulation coefficients for each pressure level are scaled according |
|---|
| 3459 | !> to current particle wet size (linear scaling). |
|---|
| 3460 | !> Bins are organized in terms of the dry size of the condensation nucleus, |
|---|
| 3461 | !> while coagulation kernell is calculated with the actual hydrometeor |
|---|
| 3462 | !> size. |
|---|
| 3463 | ! |
|---|
| 3464 | !> Called from salsa_driver |
|---|
| 3465 | !> fxm: Process selection should be made smarter - now just lots of IFs inside |
|---|
| 3466 | !> loops |
|---|
| 3467 | ! |
|---|
| 3468 | !> Coded by: |
|---|
| 3469 | !> Hannele Korhonen (FMI) 2005 |
|---|
| 3470 | !> Harri Kokkola (FMI) 2006 |
|---|
| 3471 | !> Tommi Bergman (FMI) 2012 |
|---|
| 3472 | !> Matti Niskanen(FMI) 2012 |
|---|
| 3473 | !> Anton Laakso (FMI) 2013 |
|---|
| 3474 | !> Juha Tonttila (FMI) 2014 |
|---|
| 3475 | !------------------------------------------------------------------------------! |
|---|
| 3476 | SUBROUTINE coagulation( paero, ptstep, ptemp, ppres ) |
|---|
| 3477 | |
|---|
| 3478 | IMPLICIT NONE |
|---|
| 3479 | |
|---|
| 3480 | !-- Input and output variables |
|---|
| 3481 | TYPE(t_section), INTENT(inout) :: paero(fn2b) !< Aerosol properties |
|---|
| 3482 | REAL(wp), INTENT(in) :: ppres !< ambient pressure (Pa) |
|---|
| 3483 | REAL(wp), INTENT(in) :: ptemp !< ambient temperature (K) |
|---|
| 3484 | REAL(wp), INTENT(in) :: ptstep !< time step (s) |
|---|
| 3485 | !-- Local variables |
|---|
| 3486 | INTEGER(iwp) :: index_2a !< corresponding bin in subrange 2a |
|---|
| 3487 | INTEGER(iwp) :: index_2b !< corresponding bin in subrange 2b |
|---|
| 3488 | INTEGER(iwp) :: b !< loop index |
|---|
| 3489 | INTEGER(iwp) :: ll !< loop index |
|---|
| 3490 | INTEGER(iwp) :: mm !< loop index |
|---|
| 3491 | INTEGER(iwp) :: nn !< loop index |
|---|
| 3492 | REAL(wp) :: pressi !< pressure |
|---|
| 3493 | REAL(wp) :: temppi !< temperature |
|---|
| 3494 | REAL(wp) :: zcc(fn2b,fn2b) !< updated coagulation coefficients (m3/s) |
|---|
| 3495 | REAL(wp) :: zdpart_mm !< diameter of particle (m) |
|---|
| 3496 | REAL(wp) :: zdpart_nn !< diameter of particle (m) |
|---|
| 3497 | REAL(wp) :: zminusterm !< coagulation loss in a bin (1/s) |
|---|
| 3498 | REAL(wp) :: zplusterm(8) !< coagulation gain in a bin (fxm/s) |
|---|
| 3499 | !< (for each chemical compound) |
|---|
| 3500 | REAL(wp) :: zmpart(fn2b) !< approximate mass of particles (kg) |
|---|
| 3501 | |
|---|
| 3502 | zcc = 0.0_wp |
|---|
| 3503 | zmpart = 0.0_wp |
|---|
| 3504 | zdpart_mm = 0.0_wp |
|---|
| 3505 | zdpart_nn = 0.0_wp |
|---|
| 3506 | ! |
|---|
| 3507 | !-- 1) Coagulation to coarse mode calculated in a simplified way: |
|---|
| 3508 | !-- CoagSink ~ Dp in continuum subrange, thus we calculate 'effective' |
|---|
| 3509 | !-- number concentration of coarse particles |
|---|
| 3510 | |
|---|
| 3511 | !-- 2) Updating coagulation coefficients |
|---|
| 3512 | ! |
|---|
| 3513 | !-- Aerosol mass (kg). Density of 1500 kg/m3 assumed |
|---|
| 3514 | zmpart(1:fn2b) = api6 * ( MIN( paero(1:fn2b)%dwet, 30.0E-6_wp )**3.0_wp ) & |
|---|
| 3515 | * 1500.0_wp |
|---|
| 3516 | temppi = ptemp |
|---|
| 3517 | pressi = ppres |
|---|
| 3518 | zcc = 0.0_wp |
|---|
| 3519 | ! |
|---|
| 3520 | !-- Aero-aero coagulation |
|---|
| 3521 | DO mm = 1, fn2b ! smaller colliding particle |
|---|
| 3522 | IF ( paero(mm)%numc < nclim ) CYCLE |
|---|
| 3523 | DO nn = mm, fn2b ! larger colliding particle |
|---|
| 3524 | IF ( paero(nn)%numc < nclim ) CYCLE |
|---|
| 3525 | |
|---|
| 3526 | zdpart_mm = MIN( paero(mm)%dwet, 30.0E-6_wp ) ! Limit to 30 um |
|---|
| 3527 | zdpart_nn = MIN( paero(nn)%dwet, 30.0E-6_wp ) ! Limit to 30 um |
|---|
| 3528 | ! |
|---|
| 3529 | !-- Coagulation coefficient of particles (m3/s) |
|---|
| 3530 | zcc(mm,nn) = coagc( zdpart_mm, zdpart_nn, zmpart(mm), zmpart(nn), & |
|---|
| 3531 | temppi, pressi ) |
|---|
| 3532 | zcc(nn,mm) = zcc(mm,nn) |
|---|
| 3533 | ENDDO |
|---|
| 3534 | ENDDO |
|---|
| 3535 | |
|---|
| 3536 | ! |
|---|
| 3537 | !-- 3) New particle and volume concentrations after coagulation: |
|---|
| 3538 | !-- Calculated according to Jacobson (2005) eq. 15.9 |
|---|
| 3539 | ! |
|---|
| 3540 | !-- Aerosols in subrange 1a: |
|---|
| 3541 | DO b = in1a, fn1a |
|---|
| 3542 | IF ( paero(b)%numc < nclim ) CYCLE |
|---|
| 3543 | zminusterm = 0.0_wp |
|---|
| 3544 | zplusterm(:) = 0.0_wp |
|---|
| 3545 | ! |
|---|
| 3546 | !-- Particles lost by coagulation with larger aerosols |
|---|
| 3547 | DO ll = b+1, fn2b |
|---|
| 3548 | zminusterm = zminusterm + zcc(b,ll) * paero(ll)%numc |
|---|
| 3549 | ENDDO |
|---|
| 3550 | ! |
|---|
| 3551 | !-- Coagulation gain in a bin: change in volume conc. (cm3/cm3): |
|---|
| 3552 | DO ll = in1a, b-1 |
|---|
| 3553 | zplusterm(1:2) = zplusterm(1:2) + zcc(ll,b) * paero(ll)%volc(1:2) |
|---|
| 3554 | zplusterm(6:7) = zplusterm(6:7) + zcc(ll,b) * paero(ll)%volc(6:7) |
|---|
| 3555 | zplusterm(8) = zplusterm(8) + zcc(ll,b) * paero(ll)%volc(8) |
|---|
| 3556 | ENDDO |
|---|
| 3557 | ! |
|---|
| 3558 | !-- Volume and number concentrations after coagulation update [fxm] |
|---|
| 3559 | paero(b)%volc(1:2) = ( paero(b)%volc(1:2) + ptstep * zplusterm(1:2) * & |
|---|
| 3560 | paero(b)%numc ) / ( 1.0_wp + ptstep * zminusterm ) |
|---|
| 3561 | paero(b)%volc(6:7) = ( paero(b)%volc(6:7) + ptstep * zplusterm(6:7) * & |
|---|
| 3562 | paero(b)%numc ) / ( 1.0_wp + ptstep * zminusterm ) |
|---|
| 3563 | paero(b)%volc(8) = ( paero(b)%volc(8) + ptstep * zplusterm(8) * & |
|---|
| 3564 | paero(b)%numc ) / ( 1.0_wp + ptstep * zminusterm ) |
|---|
| 3565 | paero(b)%numc = paero(b)%numc / ( 1.0_wp + ptstep * zminusterm + & |
|---|
| 3566 | 0.5_wp * ptstep * zcc(b,b) * paero(b)%numc ) |
|---|
| 3567 | ENDDO |
|---|
| 3568 | ! |
|---|
| 3569 | !-- Aerosols in subrange 2a: |
|---|
| 3570 | DO b = in2a, fn2a |
|---|
| 3571 | IF ( paero(b)%numc < nclim ) CYCLE |
|---|
| 3572 | zminusterm = 0.0_wp |
|---|
| 3573 | zplusterm(:) = 0.0_wp |
|---|
| 3574 | ! |
|---|
| 3575 | !-- Find corresponding size bin in subrange 2b |
|---|
| 3576 | index_2b = b - in2a + in2b |
|---|
| 3577 | ! |
|---|
| 3578 | !-- Particles lost by larger particles in 2a |
|---|
| 3579 | DO ll = b+1, fn2a |
|---|
| 3580 | zminusterm = zminusterm + zcc(b,ll) * paero(ll)%numc |
|---|
| 3581 | ENDDO |
|---|
| 3582 | ! |
|---|
| 3583 | !-- Particles lost by larger particles in 2b |
|---|
| 3584 | IF ( .NOT. no_insoluble ) THEN |
|---|
| 3585 | DO ll = index_2b+1, fn2b |
|---|
| 3586 | zminusterm = zminusterm + zcc(b,ll) * paero(ll)%numc |
|---|
| 3587 | ENDDO |
|---|
| 3588 | ENDIF |
|---|
| 3589 | ! |
|---|
| 3590 | !-- Particle volume gained from smaller particles in subranges 1, 2a and 2b |
|---|
| 3591 | DO ll = in1a, b-1 |
|---|
| 3592 | zplusterm(1:2) = zplusterm(1:2) + zcc(ll,b) * paero(ll)%volc(1:2) |
|---|
| 3593 | zplusterm(6:7) = zplusterm(6:7) + zcc(ll,b) * paero(ll)%volc(6:7) |
|---|
| 3594 | zplusterm(8) = zplusterm(8) + zcc(ll,b) * paero(ll)%volc(8) |
|---|
| 3595 | ENDDO |
|---|
| 3596 | ! |
|---|
| 3597 | !-- Particle volume gained from smaller particles in 2a |
|---|
| 3598 | !-- (Note, for components not included in the previous loop!) |
|---|
| 3599 | DO ll = in2a, b-1 |
|---|
| 3600 | zplusterm(3:5) = zplusterm(3:5) + zcc(ll,b)*paero(ll)%volc(3:5) |
|---|
| 3601 | ENDDO |
|---|
| 3602 | |
|---|
| 3603 | ! |
|---|
| 3604 | !-- Particle volume gained from smaller (and equal) particles in 2b |
|---|
| 3605 | IF ( .NOT. no_insoluble ) THEN |
|---|
| 3606 | DO ll = in2b, index_2b |
|---|
| 3607 | zplusterm(1:8) = zplusterm(1:8) + zcc(ll,b) * paero(ll)%volc(1:8) |
|---|
| 3608 | ENDDO |
|---|
| 3609 | ENDIF |
|---|
| 3610 | ! |
|---|
| 3611 | !-- Volume and number concentrations after coagulation update [fxm] |
|---|
| 3612 | paero(b)%volc(1:8) = ( paero(b)%volc(1:8) + ptstep * zplusterm(1:8) * & |
|---|
| 3613 | paero(b)%numc ) / ( 1.0_wp + ptstep * zminusterm ) |
|---|
| 3614 | paero(b)%numc = paero(b)%numc / ( 1.0_wp + ptstep * zminusterm + & |
|---|
| 3615 | 0.5_wp * ptstep * zcc(b,b) * paero(b)%numc ) |
|---|
| 3616 | ENDDO |
|---|
| 3617 | ! |
|---|
| 3618 | !-- Aerosols in subrange 2b: |
|---|
| 3619 | IF ( .NOT. no_insoluble ) THEN |
|---|
| 3620 | DO b = in2b, fn2b |
|---|
| 3621 | IF ( paero(b)%numc < nclim ) CYCLE |
|---|
| 3622 | zminusterm = 0.0_wp |
|---|
| 3623 | zplusterm(:) = 0.0_wp |
|---|
| 3624 | ! |
|---|
| 3625 | !-- Find corresponding size bin in subsubrange 2a |
|---|
| 3626 | index_2a = b - in2b + in2a |
|---|
| 3627 | ! |
|---|
| 3628 | !-- Particles lost to larger particles in subranges 2b |
|---|
| 3629 | DO ll = b+1, fn2b |
|---|
| 3630 | zminusterm = zminusterm + zcc(b,ll) * paero(ll)%numc |
|---|
| 3631 | ENDDO |
|---|
| 3632 | ! |
|---|
| 3633 | !-- Particles lost to larger and equal particles in 2a |
|---|
| 3634 | DO ll = index_2a, fn2a |
|---|
| 3635 | zminusterm = zminusterm + zcc(b,ll) * paero(ll)%numc |
|---|
| 3636 | ENDDO |
|---|
| 3637 | ! |
|---|
| 3638 | !-- Particle volume gained from smaller particles in subranges 1 & 2a |
|---|
| 3639 | DO ll = in1a, index_2a-1 |
|---|
| 3640 | zplusterm(1:8) = zplusterm(1:8) + zcc(ll,b) * paero(ll)%volc(1:8) |
|---|
| 3641 | ENDDO |
|---|
| 3642 | ! |
|---|
| 3643 | !-- Particle volume gained from smaller particles in 2b |
|---|
| 3644 | DO ll = in2b, b-1 |
|---|
| 3645 | zplusterm(1:8) = zplusterm(1:8) + zcc(ll,b) * paero(ll)%volc(1:8) |
|---|
| 3646 | ENDDO |
|---|
| 3647 | ! |
|---|
| 3648 | !-- Volume and number concentrations after coagulation update [fxm] |
|---|
| 3649 | paero(b)%volc(1:8) = ( paero(b)%volc(1:8) + ptstep * zplusterm(1:8)& |
|---|
| 3650 | * paero(b)%numc ) / ( 1.0_wp + ptstep * zminusterm ) |
|---|
| 3651 | paero(b)%numc = paero(b)%numc / ( 1.0_wp + ptstep * zminusterm + & |
|---|
| 3652 | 0.5_wp * ptstep * zcc(b,b) * paero(b)%numc ) |
|---|
| 3653 | ENDDO |
|---|
| 3654 | ENDIF |
|---|
| 3655 | |
|---|
| 3656 | END SUBROUTINE coagulation |
|---|
| 3657 | |
|---|
| 3658 | !------------------------------------------------------------------------------! |
|---|
| 3659 | ! Description: |
|---|
| 3660 | ! ------------ |
|---|
| 3661 | !> Calculation of coagulation coefficients. Extended version of the function |
|---|
| 3662 | !> originally found in mo_salsa_init. |
|---|
| 3663 | ! |
|---|
| 3664 | !> J. Tonttila, FMI, 05/2014 |
|---|
| 3665 | !------------------------------------------------------------------------------! |
|---|
| 3666 | REAL(wp) FUNCTION coagc( diam1, diam2, mass1, mass2, temp, pres ) |
|---|
| 3667 | |
|---|
| 3668 | IMPLICIT NONE |
|---|
| 3669 | ! |
|---|
| 3670 | !-- Input and output variables |
|---|
| 3671 | REAL(wp), INTENT(in) :: diam1 !< diameter of colliding particle 1 (m) |
|---|
| 3672 | REAL(wp), INTENT(in) :: diam2 !< diameter of colliding particle 2 (m) |
|---|
| 3673 | REAL(wp), INTENT(in) :: mass1 !< mass of colliding particle 1 (kg) |
|---|
| 3674 | REAL(wp), INTENT(in) :: mass2 !< mass of colliding particle 2 (kg) |
|---|
| 3675 | REAL(wp), INTENT(in) :: pres !< ambient pressure (Pa?) [fxm] |
|---|
| 3676 | REAL(wp), INTENT(in) :: temp !< ambient temperature (K) |
|---|
| 3677 | ! |
|---|
| 3678 | !-- Local variables |
|---|
| 3679 | REAL(wp) :: fmdist !< distance of flux matching (m) |
|---|
| 3680 | REAL(wp) :: knud_p !< particle Knudsen number |
|---|
| 3681 | REAL(wp) :: mdiam !< mean diameter of colliding particles (m) |
|---|
| 3682 | REAL(wp) :: mfp !< mean free path of air molecules (m) |
|---|
| 3683 | REAL(wp) :: visc !< viscosity of air (kg/(m s)) |
|---|
| 3684 | REAL(wp), DIMENSION (2) :: beta !< Cunningham correction factor |
|---|
| 3685 | REAL(wp), DIMENSION (2) :: dfpart !< particle diffusion coefficient |
|---|
| 3686 | !< (m2/s) |
|---|
| 3687 | REAL(wp), DIMENSION (2) :: diam !< diameters of particles (m) |
|---|
| 3688 | REAL(wp), DIMENSION (2) :: flux !< flux in continuum and free molec. |
|---|
| 3689 | !< regime (m/s) |
|---|
| 3690 | REAL(wp), DIMENSION (2) :: knud !< particle Knudsen number |
|---|
| 3691 | REAL(wp), DIMENSION (2) :: mpart !< masses of particles (kg) |
|---|
| 3692 | REAL(wp), DIMENSION (2) :: mtvel !< particle mean thermal velocity (m/s) |
|---|
| 3693 | REAL(wp), DIMENSION (2) :: omega !< particle mean free path |
|---|
| 3694 | REAL(wp), DIMENSION (2) :: tva !< temporary variable (m) |
|---|
| 3695 | ! |
|---|
| 3696 | !-- Initialisation |
|---|
| 3697 | coagc = 0.0_wp |
|---|
| 3698 | ! |
|---|
| 3699 | !-- 1) Initializing particle and ambient air variables |
|---|
| 3700 | diam = (/ diam1, diam2 /) !< particle diameters (m) |
|---|
| 3701 | mpart = (/ mass1, mass2 /) !< particle masses (kg) |
|---|
| 3702 | !-- Viscosity of air (kg/(m s)) |
|---|
| 3703 | visc = ( 7.44523E-3_wp * temp ** 1.5_wp ) / & |
|---|
| 3704 | ( 5093.0_wp * ( temp + 110.4_wp ) ) |
|---|
| 3705 | !-- Mean free path of air (m) |
|---|
| 3706 | mfp = ( 1.656E-10_wp * temp + 1.828E-8_wp ) * ( p_0 + 1325.0_wp ) / pres |
|---|
| 3707 | ! |
|---|
| 3708 | !-- 2) Slip correction factor for small particles |
|---|
| 3709 | knud = 2.0_wp * EXP( LOG(mfp) - LOG(diam) )! Knudsen number for air (15.23) |
|---|
| 3710 | !-- Cunningham correction factor (Allen and Raabe, Aerosol Sci. Tech. 4, 269) |
|---|
| 3711 | beta = 1.0_wp + knud * ( 1.142_wp + 0.558_wp * EXP( -0.999_wp / knud ) ) |
|---|
| 3712 | ! |
|---|
| 3713 | !-- 3) Particle properties |
|---|
| 3714 | !-- Diffusion coefficient (m2/s) (Jacobson (2005) eq. 15.29) |
|---|
| 3715 | dfpart = beta * abo * temp / ( 3.0_wp * pi * visc * diam ) |
|---|
| 3716 | !-- Mean thermal velocity (m/s) (Jacobson (2005) eq. 15.32) |
|---|
| 3717 | mtvel = SQRT( ( 8.0_wp * abo * temp ) / ( pi * mpart ) ) |
|---|
| 3718 | !-- Particle mean free path (m) (Jacobson (2005) eq. 15.34 ) |
|---|
| 3719 | omega = 8.0_wp * dfpart / ( pi * mtvel ) |
|---|
| 3720 | !-- Mean diameter (m) |
|---|
| 3721 | mdiam = 0.5_wp * ( diam(1) + diam(2) ) |
|---|
| 3722 | ! |
|---|
| 3723 | !-- 4) Calculation of fluxes (Brownian collision kernels) and flux matching |
|---|
| 3724 | !-- following Jacobson (2005): |
|---|
| 3725 | !-- Flux in continuum regime (m3/s) (eq. 15.28) |
|---|
| 3726 | flux(1) = 4.0_wp * pi * mdiam * ( dfpart(1) + dfpart(2) ) |
|---|
| 3727 | !-- Flux in free molec. regime (m3/s) (eq. 15.31) |
|---|
| 3728 | flux(2) = pi * SQRT( ( mtvel(1)**2.0_wp ) + ( mtvel(2)**2.0_wp ) ) * & |
|---|
| 3729 | ( mdiam**2.0_wp ) |
|---|
| 3730 | !-- temporary variables (m) to calculate flux matching distance (m) |
|---|
| 3731 | tva(1) = ( ( mdiam + omega(1) )**3.0_wp - ( mdiam**2.0_wp + & |
|---|
| 3732 | omega(1)**2.0_wp ) * SQRT( ( mdiam**2.0_wp + omega(1)**2.0_wp ) & |
|---|
| 3733 | ) ) / ( 3.0_wp * mdiam * omega(1) ) - mdiam |
|---|
| 3734 | tva(2) = ( ( mdiam + omega(2) )**3.0_wp - ( mdiam**2.0_wp + & |
|---|
| 3735 | omega(2)**2.0_wp ) * SQRT( ( mdiam**2 + omega(2)**2 ) ) ) / & |
|---|
| 3736 | ( 3.0_wp * mdiam * omega(2) ) - mdiam |
|---|
| 3737 | !-- Flux matching distance (m) i.e. the mean distance from the centre of a |
|---|
| 3738 | !-- sphere reached by particles leaving sphere's surface and travelling a |
|---|
| 3739 | !-- distance of particle mean free path mfp (eq. 15 34) |
|---|
| 3740 | fmdist = SQRT( tva(1)**2 + tva(2)**2.0_wp) |
|---|
| 3741 | ! |
|---|
| 3742 | !-- 5) Coagulation coefficient (m3/s) (eq. 15.33). Here assumed |
|---|
| 3743 | !-- coalescence efficiency 1!! |
|---|
| 3744 | coagc = flux(1) / ( mdiam / ( mdiam + fmdist) + flux(1) / flux(2) ) |
|---|
| 3745 | !-- coagulation coefficient = coalescence efficiency * collision kernel |
|---|
| 3746 | ! |
|---|
| 3747 | !-- Corrected collision kernel following Karl et al., 2016 (ACP): |
|---|
| 3748 | !-- Inclusion of van der Waals and viscous forces |
|---|
| 3749 | IF ( van_der_waals_coagc ) THEN |
|---|
| 3750 | knud_p = SQRT( omega(1)**2 + omega(2)**2 ) / mdiam |
|---|
| 3751 | IF ( knud_p >= 0.1_wp .AND. knud_p <= 10.0_wp ) THEN |
|---|
| 3752 | coagc = coagc * ( 2.0_wp + 0.4_wp * LOG( knud_p ) ) |
|---|
| 3753 | ELSE |
|---|
| 3754 | coagc = coagc * 3.0_wp |
|---|
| 3755 | ENDIF |
|---|
| 3756 | ENDIF |
|---|
| 3757 | |
|---|
| 3758 | END FUNCTION coagc |
|---|
| 3759 | |
|---|
| 3760 | !------------------------------------------------------------------------------! |
|---|
| 3761 | ! Description: |
|---|
| 3762 | ! ------------ |
|---|
| 3763 | !> Calculates the change in particle volume and gas phase |
|---|
| 3764 | !> concentrations due to nucleation, condensation and dissolutional growth. |
|---|
| 3765 | ! |
|---|
| 3766 | !> Sulphuric acid and organic vapour: only condensation and no evaporation. |
|---|
| 3767 | ! |
|---|
| 3768 | !> New gas and aerosol phase concentrations calculated according to Jacobson |
|---|
| 3769 | !> (1997): Numerical techniques to solve condensational and dissolutional growth |
|---|
| 3770 | !> equations when growth is coupled to reversible reactions, Aerosol Sci. Tech., |
|---|
| 3771 | !> 27, pp 491-498. |
|---|
| 3772 | ! |
|---|
| 3773 | !> Following parameterization has been used: |
|---|
| 3774 | !> Molecular diffusion coefficient of condensing vapour (m2/s) |
|---|
| 3775 | !> (Reid et al. (1987): Properties of gases and liquids, McGraw-Hill, New York.) |
|---|
| 3776 | !> D = {1.d-7*sqrt(1/M_air + 1/M_gas)*T^1.75} / & |
|---|
| 3777 | ! {p_atm/p_stand * (d_air^(1/3) + d_gas^(1/3))^2 } |
|---|
| 3778 | ! M_air = 28.965 : molar mass of air (g/mol) |
|---|
| 3779 | ! d_air = 19.70 : diffusion volume of air |
|---|
| 3780 | ! M_h2so4 = 98.08 : molar mass of h2so4 (g/mol) |
|---|
| 3781 | ! d_h2so4 = 51.96 : diffusion volume of h2so4 |
|---|
| 3782 | ! |
|---|
| 3783 | !> Called from main aerosol model |
|---|
| 3784 | ! |
|---|
| 3785 | !> fxm: calculated for empty bins too |
|---|
| 3786 | !> fxm: same diffusion coefficients and mean free paths used for sulphuric acid |
|---|
| 3787 | !> and organic vapours (average values? 'real' values for each?) |
|---|
| 3788 | !> fxm: one should really couple with vapour production and loss terms as well |
|---|
| 3789 | !> should nucleation be coupled here as well???? |
|---|
| 3790 | ! |
|---|
| 3791 | ! Coded by: |
|---|
| 3792 | ! Hannele Korhonen (FMI) 2005 |
|---|
| 3793 | ! Harri Kokkola (FMI) 2006 |
|---|
| 3794 | ! Juha Tonttila (FMI) 2014 |
|---|
| 3795 | ! Rewritten to PALM by Mona Kurppa (UHel) 2017 |
|---|
| 3796 | !------------------------------------------------------------------------------! |
|---|
| 3797 | SUBROUTINE condensation( paero, pcsa, pcocnv, pcocsv, pchno3, pcnh3, pcw, pcs,& |
|---|
| 3798 | ptemp, ppres, ptstep, prtcl ) |
|---|
| 3799 | |
|---|
| 3800 | IMPLICIT NONE |
|---|
| 3801 | |
|---|
| 3802 | !-- Input and output variables |
|---|
| 3803 | REAL(wp), INTENT(IN) :: ppres !< ambient pressure (Pa) |
|---|
| 3804 | REAL(wp), INTENT(IN) :: pcs !< Water vapour saturation concentration |
|---|
| 3805 | !< (kg/m3) |
|---|
| 3806 | REAL(wp), INTENT(IN) :: ptemp !< ambient temperature (K) |
|---|
| 3807 | REAL(wp), INTENT(IN) :: ptstep !< timestep (s) |
|---|
| 3808 | TYPE(component_index), INTENT(in) :: prtcl !< Keeps track which substances |
|---|
| 3809 | !< are used |
|---|
| 3810 | REAL(wp), INTENT(INOUT) :: pchno3 !< Gas concentrations (#/m3): |
|---|
| 3811 | !< nitric acid HNO3 |
|---|
| 3812 | REAL(wp), INTENT(INOUT) :: pcnh3 !< ammonia NH3 |
|---|
| 3813 | REAL(wp), INTENT(INOUT) :: pcocnv !< non-volatile organics |
|---|
| 3814 | REAL(wp), INTENT(INOUT) :: pcocsv !< semi-volatile organics |
|---|
| 3815 | REAL(wp), INTENT(INOUT) :: pcsa !< sulphuric acid H2SO4 |
|---|
| 3816 | REAL(wp), INTENT(INOUT) :: pcw !< Water vapor concentration (kg/m3) |
|---|
| 3817 | TYPE(t_section), INTENT(inout) :: paero(fn2b) !< Aerosol properties |
|---|
| 3818 | !-- Local variables |
|---|
| 3819 | REAL(wp) :: zbeta(fn2b) !< transitional correction factor for aerosols |
|---|
| 3820 | REAL(wp) :: zcolrate(fn2b) !< collision rate of molecules to particles |
|---|
| 3821 | !< (1/s) |
|---|
| 3822 | REAL(wp) :: zcolrate_ocnv(fn2b) !< collision rate of organic molecules |
|---|
| 3823 | !< to particles (1/s) |
|---|
| 3824 | REAL(wp) :: zcs_ocnv !< condensation sink of nonvolatile organics (1/s) |
|---|
| 3825 | REAL(wp) :: zcs_ocsv !< condensation sink of semivolatile organics (1/s) |
|---|
| 3826 | REAL(wp) :: zcs_su !< condensation sink of sulfate (1/s) |
|---|
| 3827 | REAL(wp) :: zcs_tot!< total condensation sink (1/s) (gases) |
|---|
| 3828 | !-- vapour concentration after time step (#/m3) |
|---|
| 3829 | REAL(wp) :: zcvap_new1 !< sulphuric acid |
|---|
| 3830 | REAL(wp) :: zcvap_new2 !< nonvolatile organics |
|---|
| 3831 | REAL(wp) :: zcvap_new3 !< semivolatile organics |
|---|
| 3832 | REAL(wp) :: zdfpart(in1a+1) !< particle diffusion coefficient (m2/s) |
|---|
| 3833 | REAL(wp) :: zdfvap !< air diffusion coefficient (m2/s) |
|---|
| 3834 | !-- change in vapour concentration (#/m3) |
|---|
| 3835 | REAL(wp) :: zdvap1 !< sulphuric acid |
|---|
| 3836 | REAL(wp) :: zdvap2 !< nonvolatile organics |
|---|
| 3837 | REAL(wp) :: zdvap3 !< semivolatile organics |
|---|
| 3838 | REAL(wp) :: zdvoloc(fn2b) !< change of organics volume in each bin [fxm] |
|---|
| 3839 | REAL(wp) :: zdvolsa(fn2b) !< change of sulphate volume in each bin [fxm] |
|---|
| 3840 | REAL(wp) :: zj3n3(2) !< Formation massrate of molecules in |
|---|
| 3841 | !< nucleation, (molec/m3s). 1: H2SO4 |
|---|
| 3842 | !< and 2: organic vapor |
|---|
| 3843 | REAL(wp) :: zknud(fn2b) !< particle Knudsen number |
|---|
| 3844 | REAL(wp) :: zmfp !< mean free path of condensing vapour (m) |
|---|
| 3845 | REAL(wp) :: zrh !< Relative humidity [0-1] |
|---|
| 3846 | REAL(wp) :: zvisc !< viscosity of air (kg/(m s)) |
|---|
| 3847 | REAL(wp) :: zn_vs_c !< ratio of nucleation of all mass transfer in the |
|---|
| 3848 | !< smallest bin |
|---|
| 3849 | REAL(wp) :: zxocnv !< ratio of organic vapour in 3nm particles |
|---|
| 3850 | REAL(wp) :: zxsa !< Ratio in 3nm particles: sulphuric acid |
|---|
| 3851 | |
|---|
| 3852 | zj3n3 = 0.0_wp |
|---|
| 3853 | zrh = pcw / pcs |
|---|
| 3854 | zxocnv = 0.0_wp |
|---|
| 3855 | zxsa = 0.0_wp |
|---|
| 3856 | ! |
|---|
| 3857 | !-- Nucleation |
|---|
| 3858 | IF ( nsnucl > 0 ) THEN |
|---|
| 3859 | CALL nucleation( paero, ptemp, zrh, ppres, pcsa, pcocnv, pcnh3, ptstep, & |
|---|
| 3860 | zj3n3, zxsa, zxocnv ) |
|---|
| 3861 | ENDIF |
|---|
| 3862 | ! |
|---|
| 3863 | !-- Condensation on pre-existing particles |
|---|
| 3864 | IF ( lscndgas ) THEN |
|---|
| 3865 | ! |
|---|
| 3866 | !-- Initialise: |
|---|
| 3867 | zdvolsa = 0.0_wp |
|---|
| 3868 | zdvoloc = 0.0_wp |
|---|
| 3869 | zcolrate = 0.0_wp |
|---|
| 3870 | ! |
|---|
| 3871 | !-- 1) Properties of air and condensing gases: |
|---|
| 3872 | !-- Viscosity of air (kg/(m s)) (Eq. 4.54 in Jabonson (2005)) |
|---|
| 3873 | zvisc = ( 7.44523E-3_wp * ptemp ** 1.5_wp ) / ( 5093.0_wp * & |
|---|
| 3874 | ( ptemp + 110.4_wp ) ) |
|---|
| 3875 | !-- Diffusion coefficient of air (m2/s) |
|---|
| 3876 | zdfvap = 5.1111E-10_wp * ptemp ** 1.75_wp * ( p_0 + 1325.0_wp ) / ppres |
|---|
| 3877 | !-- Mean free path (m): same for H2SO4 and organic compounds |
|---|
| 3878 | zmfp = 3.0_wp * zdfvap * SQRT( pi * amh2so4 / ( 8.0_wp * argas * ptemp ) ) |
|---|
| 3879 | ! |
|---|
| 3880 | !-- 2) Transition regime correction factor zbeta for particles: |
|---|
| 3881 | !-- Fuchs and Sutugin (1971), In: Hidy et al. (ed.) Topics in current |
|---|
| 3882 | !-- aerosol research, Pergamon. Size of condensing molecule considered |
|---|
| 3883 | !-- only for nucleation mode (3 - 20 nm) |
|---|
| 3884 | ! |
|---|
| 3885 | !-- Particle Knudsen number: condensation of gases on aerosols |
|---|
| 3886 | zknud(in1a:in1a+1) = 2.0_wp * zmfp / ( paero(in1a:in1a+1)%dwet + d_sa ) |
|---|
| 3887 | zknud(in1a+2:fn2b) = 2.0_wp * zmfp / paero(in1a+2:fn2b)%dwet |
|---|
| 3888 | ! |
|---|
| 3889 | !-- Transitional correction factor: aerosol + gas (the semi-empirical Fuchs- |
|---|
| 3890 | !-- Sutugin interpolation function (Fuchs and Sutugin, 1971)) |
|---|
| 3891 | zbeta = ( zknud + 1.0_wp ) / ( 0.377_wp * zknud + 1.0_wp + 4.0_wp / & |
|---|
| 3892 | ( 3.0_wp * massacc ) * ( zknud + zknud ** 2.0_wp ) ) |
|---|
| 3893 | ! |
|---|
| 3894 | !-- 3) Collision rate of molecules to particles |
|---|
| 3895 | !-- Particle diffusion coefficient considered only for nucleation mode |
|---|
| 3896 | !-- (3 - 20 nm) |
|---|
| 3897 | ! |
|---|
| 3898 | !-- Particle diffusion coefficient (m2/s) (e.g. Eq. 15.29 in Jacobson (2005)) |
|---|
| 3899 | zdfpart = abo * ptemp * zbeta(in1a:in1a+1) / ( 3.0_wp * pi * zvisc * & |
|---|
| 3900 | paero(in1a:in1a+1)%dwet ) |
|---|
| 3901 | ! |
|---|
| 3902 | !-- Collision rate (mass-transfer coefficient): gases on aerosols (1/s) |
|---|
| 3903 | !-- (Eq. 16.64 in Jacobson (2005)) |
|---|
| 3904 | zcolrate(in1a:in1a+1) = MERGE( 2.0_wp * pi * & |
|---|
| 3905 | ( paero(in1a:in1a+1)%dwet + d_sa ) * & |
|---|
| 3906 | ( zdfvap + zdfpart ) * zbeta(in1a:in1a+1)& |
|---|
| 3907 | * paero(in1a:in1a+1)%numc, 0.0_wp, & |
|---|
| 3908 | paero(in1a:in1a+1)%numc > nclim ) |
|---|
| 3909 | zcolrate(in1a+2:fn2b) = MERGE( 2.0_wp * pi * paero(in1a+2:fn2b)%dwet * & |
|---|
| 3910 | zdfvap * zbeta(in1a+2:fn2b) * & |
|---|
| 3911 | paero(in1a+2:fn2b)%numc, 0.0_wp, & |
|---|
| 3912 | paero(in1a+2:fn2b)%numc > nclim ) |
|---|
| 3913 | ! |
|---|
| 3914 | !-- 4) Condensation sink (1/s) |
|---|
| 3915 | zcs_tot = SUM( zcolrate ) ! total sink |
|---|
| 3916 | ! |
|---|
| 3917 | !-- 5) Changes in gas-phase concentrations and particle volume |
|---|
| 3918 | ! |
|---|
| 3919 | !-- 5.1) Organic vapours |
|---|
| 3920 | ! |
|---|
| 3921 | !-- 5.1.1) Non-volatile organic compound: condenses onto all bins |
|---|
| 3922 | IF ( pcocnv > 1.0E+10_wp .AND. zcs_tot > 1.0E-30_wp .AND. & |
|---|
| 3923 | is_used( prtcl,'OC' ) ) & |
|---|
| 3924 | THEN |
|---|
| 3925 | !-- Ratio of nucleation vs. condensation rates in the smallest bin |
|---|
| 3926 | zn_vs_c = 0.0_wp |
|---|
| 3927 | IF ( zj3n3(2) > 1.0_wp ) THEN |
|---|
| 3928 | zn_vs_c = ( zj3n3(2) ) / ( zj3n3(2) + pcocnv * zcolrate(in1a) ) |
|---|
| 3929 | ENDIF |
|---|
| 3930 | ! |
|---|
| 3931 | !-- Collision rate in the smallest bin, including nucleation and |
|---|
| 3932 | !-- condensation(see Jacobson, Fundamentals of Atmospheric Modeling, 2nd |
|---|
| 3933 | !-- Edition (2005), equation (16.73) ) |
|---|
| 3934 | zcolrate_ocnv = zcolrate |
|---|
| 3935 | zcolrate_ocnv(in1a) = zcolrate_ocnv(in1a) + zj3n3(2) / pcocnv |
|---|
| 3936 | ! |
|---|
| 3937 | !-- Total sink for organic vapor |
|---|
| 3938 | zcs_ocnv = zcs_tot + zj3n3(2) / pcocnv |
|---|
| 3939 | ! |
|---|
| 3940 | !-- New gas phase concentration (#/m3) |
|---|
| 3941 | zcvap_new2 = pcocnv / ( 1.0_wp + ptstep * zcs_ocnv ) |
|---|
| 3942 | ! |
|---|
| 3943 | !-- Change in gas concentration (#/m3) |
|---|
| 3944 | zdvap2 = pcocnv - zcvap_new2 |
|---|
| 3945 | ! |
|---|
| 3946 | !-- Updated vapour concentration (#/m3) |
|---|
| 3947 | pcocnv = zcvap_new2 |
|---|
| 3948 | ! |
|---|
| 3949 | !-- Volume change of particles (m3(OC)/m3(air)) |
|---|
| 3950 | zdvoloc = zcolrate_ocnv(in1a:fn2b) / zcs_ocnv * amvoc * zdvap2 |
|---|
| 3951 | ! |
|---|
| 3952 | !-- Change of volume due to condensation in 1a-2b |
|---|
| 3953 | paero(in1a:fn2b)%volc(2) = paero(in1a:fn2b)%volc(2) + zdvoloc |
|---|
| 3954 | ! |
|---|
| 3955 | !-- Change of number concentration in the smallest bin caused by |
|---|
| 3956 | !-- nucleation (Jacobson (2005), equation (16.75)). If zxocnv = 0, then |
|---|
| 3957 | !-- the chosen nucleation mechanism doesn't take into account the non- |
|---|
| 3958 | !-- volatile organic vapors and thus the paero doesn't have to be updated. |
|---|
| 3959 | IF ( zxocnv > 0.0_wp ) THEN |
|---|
| 3960 | paero(in1a)%numc = paero(in1a)%numc + zn_vs_c * zdvoloc(in1a) / & |
|---|
| 3961 | amvoc / ( n3 * zxocnv ) |
|---|
| 3962 | ENDIF |
|---|
| 3963 | ENDIF |
|---|
| 3964 | ! |
|---|
| 3965 | !-- 5.1.2) Semivolatile organic compound: all bins except subrange 1 |
|---|
| 3966 | zcs_ocsv = SUM( zcolrate(in2a:fn2b) ) !< sink for semi-volatile organics |
|---|
| 3967 | IF ( pcocsv > 1.0E+10_wp .AND. zcs_ocsv > 1.0E-30 .AND. & |
|---|
| 3968 | is_used( prtcl,'OC') ) & |
|---|
| 3969 | THEN |
|---|
| 3970 | ! |
|---|
| 3971 | !-- New gas phase concentration (#/m3) |
|---|
| 3972 | zcvap_new3 = pcocsv / ( 1.0_wp + ptstep * zcs_ocsv ) |
|---|
| 3973 | ! |
|---|
| 3974 | !-- Change in gas concentration (#/m3) |
|---|
| 3975 | zdvap3 = pcocsv - zcvap_new3 |
|---|
| 3976 | ! |
|---|
| 3977 | !-- Updated gas concentration (#/m3) |
|---|
| 3978 | pcocsv = zcvap_new3 |
|---|
| 3979 | ! |
|---|
| 3980 | !-- Volume change of particles (m3(OC)/m3(air)) |
|---|
| 3981 | zdvoloc(in2a:fn2b) = zdvoloc(in2a:fn2b) + zcolrate(in2a:fn2b) / & |
|---|
| 3982 | zcs_ocsv * amvoc * zdvap3 |
|---|
| 3983 | ! |
|---|
| 3984 | !-- Change of volume due to condensation in 1a-2b |
|---|
| 3985 | paero(in1a:fn2b)%volc(2) = paero(in1a:fn2b)%volc(2) + zdvoloc |
|---|
| 3986 | ENDIF |
|---|
| 3987 | ! |
|---|
| 3988 | !-- 5.2) Sulphate: condensed on all bins |
|---|
| 3989 | IF ( pcsa > 1.0E+10_wp .AND. zcs_tot > 1.0E-30_wp .AND. & |
|---|
| 3990 | is_used( prtcl,'SO4' ) ) & |
|---|
| 3991 | THEN |
|---|
| 3992 | ! |
|---|
| 3993 | !-- Ratio of mass transfer between nucleation and condensation |
|---|
| 3994 | zn_vs_c = 0.0_wp |
|---|
| 3995 | IF ( zj3n3(1) > 1.0_wp ) THEN |
|---|
| 3996 | zn_vs_c = ( zj3n3(1) ) / ( zj3n3(1) + pcsa * zcolrate(in1a) ) |
|---|
| 3997 | ENDIF |
|---|
| 3998 | ! |
|---|
| 3999 | !-- Collision rate in the smallest bin, including nucleation and |
|---|
| 4000 | !-- condensation (see Jacobson, Fundamentals of Atmospheric Modeling, 2nd |
|---|
| 4001 | !-- Edition (2005), equation (16.73)) |
|---|
| 4002 | zcolrate(in1a) = zcolrate(in1a) + zj3n3(1) / pcsa |
|---|
| 4003 | ! |
|---|
| 4004 | !-- Total sink for sulfate (1/s) |
|---|
| 4005 | zcs_su = zcs_tot + zj3n3(1) / pcsa |
|---|
| 4006 | ! |
|---|
| 4007 | !-- Sulphuric acid: |
|---|
| 4008 | !-- New gas phase concentration (#/m3) |
|---|
| 4009 | zcvap_new1 = pcsa / ( 1.0_wp + ptstep * zcs_su ) |
|---|
| 4010 | ! |
|---|
| 4011 | !-- Change in gas concentration (#/m3) |
|---|
| 4012 | zdvap1 = pcsa - zcvap_new1 |
|---|
| 4013 | ! |
|---|
| 4014 | !-- Updating vapour concentration (#/m3) |
|---|
| 4015 | pcsa = zcvap_new1 |
|---|
| 4016 | ! |
|---|
| 4017 | !-- Volume change of particles (m3(SO4)/m3(air)) by condensation |
|---|
| 4018 | zdvolsa = zcolrate(in1a:fn2b) / zcs_su * amvh2so4 * zdvap1 |
|---|
| 4019 | !-- For validation: zdvolsa = 5.5 mum3/cm3 per 12 h |
|---|
| 4020 | ! zdvolsa = zdvolsa / SUM( zdvolsa ) * 5.5E-12_wp * dt_salsa / 43200.0_wp |
|---|
| 4021 | !0.3E-12_wp, 0.6E-12_wp, 11.0E-12_wp, 4.6E-12_wp, 9.2E-12_wp |
|---|
| 4022 | ! |
|---|
| 4023 | !-- Change of volume concentration of sulphate in aerosol [fxm] |
|---|
| 4024 | paero(in1a:fn2b)%volc(1) = paero(in1a:fn2b)%volc(1) + zdvolsa |
|---|
| 4025 | ! |
|---|
| 4026 | !-- Change of number concentration in the smallest bin caused by nucleation |
|---|
| 4027 | !-- (Jacobson (2005), equation (16.75)) |
|---|
| 4028 | IF ( zxsa > 0.0_wp ) THEN |
|---|
| 4029 | paero(in1a)%numc = paero(in1a)%numc + zn_vs_c * zdvolsa(in1a) / & |
|---|
| 4030 | amvh2so4 / ( n3 * zxsa ) |
|---|
| 4031 | ENDIF |
|---|
| 4032 | ENDIF |
|---|
| 4033 | ENDIF |
|---|
| 4034 | ! |
|---|
| 4035 | ! |
|---|
| 4036 | !-- Condensation of water vapour |
|---|
| 4037 | IF ( lscndh2oae ) THEN |
|---|
| 4038 | CALL gpparth2o( paero, ptemp, ppres, pcs, pcw, ptstep ) |
|---|
| 4039 | ENDIF |
|---|
| 4040 | ! |
|---|
| 4041 | ! |
|---|
| 4042 | !-- Partitioning of H2O, HNO3, and NH3: Dissolutional growth |
|---|
| 4043 | IF ( lscndgas .AND. ino > 0 .AND. inh > 0 .AND. & |
|---|
| 4044 | ( pchno3 > 1.0E+10_wp .OR. pcnh3 > 1.0E+10_wp ) ) & |
|---|
| 4045 | THEN |
|---|
| 4046 | CALL gpparthno3( ppres, ptemp, paero, pchno3, pcnh3, pcw, pcs, zbeta, & |
|---|
| 4047 | ptstep ) |
|---|
| 4048 | ENDIF |
|---|
| 4049 | |
|---|
| 4050 | END SUBROUTINE condensation |
|---|
| 4051 | |
|---|
| 4052 | !------------------------------------------------------------------------------! |
|---|
| 4053 | ! Description: |
|---|
| 4054 | ! ------------ |
|---|
| 4055 | !> Calculates the particle number and volume increase, and gas-phase |
|---|
| 4056 | !> concentration decrease due to nucleation subsequent growth to detectable size |
|---|
| 4057 | !> of 3 nm. |
|---|
| 4058 | ! |
|---|
| 4059 | !> Method: |
|---|
| 4060 | !> When the formed clusters grow by condensation (possibly also by self- |
|---|
| 4061 | !> coagulation), their number is reduced due to scavenging to pre-existing |
|---|
| 4062 | !> particles. Thus, the apparent nucleation rate at 3 nm is significantly lower |
|---|
| 4063 | !> than the real nucleation rate (at ~1 nm). |
|---|
| 4064 | ! |
|---|
| 4065 | !> Calculation of the formation rate of detectable particles at 3 nm (i.e. J3): |
|---|
| 4066 | !> nj3 = 1: Kerminen, V.-M. and Kulmala, M. (2002), J. Aerosol Sci.,33, 609-622. |
|---|
| 4067 | !> nj3 = 2: Lehtinen et al. (2007), J. Aerosol Sci., 38(9), 988-994. |
|---|
| 4068 | !> nj3 = 3: Anttila et al. (2010), J. Aerosol Sci., 41(7), 621-636. |
|---|
| 4069 | ! |
|---|
| 4070 | !> Called from subroutine condensation (in module salsa_dynamics_mod.f90) |
|---|
| 4071 | ! |
|---|
| 4072 | !> Calls one of the following subroutines: |
|---|
| 4073 | !> - binnucl |
|---|
| 4074 | !> - ternucl |
|---|
| 4075 | !> - kinnucl |
|---|
| 4076 | !> - actnucl |
|---|
| 4077 | ! |
|---|
| 4078 | !> fxm: currently only sulphuric acid grows particles from 1 to 3 nm |
|---|
| 4079 | !> (if asked from Markku, this is terribly wrong!!!) |
|---|
| 4080 | ! |
|---|
| 4081 | !> Coded by: |
|---|
| 4082 | !> Hannele Korhonen (FMI) 2005 |
|---|
| 4083 | !> Harri Kokkola (FMI) 2006 |
|---|
| 4084 | !> Matti Niskanen(FMI) 2012 |
|---|
| 4085 | !> Anton Laakso (FMI) 2013 |
|---|
| 4086 | !------------------------------------------------------------------------------! |
|---|
| 4087 | |
|---|
| 4088 | SUBROUTINE nucleation( paero, ptemp, prh, ppres, pcsa, pcocnv, pcnh3, ptstep, & |
|---|
| 4089 | pj3n3, pxsa, pxocnv ) |
|---|
| 4090 | IMPLICIT NONE |
|---|
| 4091 | ! |
|---|
| 4092 | !-- Input and output variables |
|---|
| 4093 | REAL(wp), INTENT(in) :: pcnh3 !< ammonia concentration (#/m3) |
|---|
| 4094 | REAL(wp), INTENT(in) :: pcocnv !< conc. of non-volatile OC (#/m3) |
|---|
| 4095 | REAL(wp), INTENT(in) :: pcsa !< sulphuric acid conc. (#/m3) |
|---|
| 4096 | REAL(wp), INTENT(in) :: ppres !< ambient air pressure (Pa) |
|---|
| 4097 | REAL(wp), INTENT(in) :: prh !< ambient rel. humidity [0-1] |
|---|
| 4098 | REAL(wp), INTENT(in) :: ptemp !< ambient temperature (K) |
|---|
| 4099 | REAL(wp), INTENT(in) :: ptstep !< time step (s) of SALSA |
|---|
| 4100 | TYPE(t_section), INTENT(inout) :: paero(fn2b) !< aerosol properties |
|---|
| 4101 | REAL(wp), INTENT(inout) :: pj3n3(2) !< formation mass rate of molecules |
|---|
| 4102 | !< (molec/m3s) for 1: H2SO4 and |
|---|
| 4103 | !< 2: organic vapour |
|---|
| 4104 | REAL(wp), INTENT(out) :: pxocnv !< ratio of non-volatile organic vapours in |
|---|
| 4105 | !< 3nm aerosol particles |
|---|
| 4106 | REAL(wp), INTENT(out) :: pxsa !< ratio of H2SO4 in 3nm aerosol particles |
|---|
| 4107 | !-- Local variables |
|---|
| 4108 | INTEGER(iwp) :: iteration |
|---|
| 4109 | REAL(wp) :: zbeta(fn2b) !< transitional correction factor |
|---|
| 4110 | REAL(wp) :: zc_h2so4 !< H2SO4 conc. (#/cm3) !UNITS! |
|---|
| 4111 | REAL(wp) :: zc_org !< organic vapour conc. (#/cm3) |
|---|
| 4112 | REAL(wp) :: zCoagStot !< total losses due to coagulation, including |
|---|
| 4113 | !< condensation and self-coagulation |
|---|
| 4114 | REAL(wp) :: zcocnv_local !< organic vapour conc. (#/m3) |
|---|
| 4115 | REAL(wp) :: zcsink !< condensational sink (#/m2) |
|---|
| 4116 | REAL(wp) :: zcsa_local !< H2SO4 conc. (#/m3) |
|---|
| 4117 | REAL(wp) :: zdcrit !< diameter of critical cluster (m) |
|---|
| 4118 | REAL(wp) :: zdelta_vap !< change of H2SO4 and organic vapour |
|---|
| 4119 | !< concentration (#/m3) |
|---|
| 4120 | REAL(wp) :: zdfvap !< air diffusion coefficient (m2/s) |
|---|
| 4121 | REAL(wp) :: zdmean !< mean diameter of existing particles (m) |
|---|
| 4122 | REAL(wp) :: zeta !< constant: proportional to ratio of CS/GR (m) |
|---|
| 4123 | !< (condensation sink / growth rate) |
|---|
| 4124 | REAL(wp) :: zgamma !< proportionality factor ((nm2*m2)/h) |
|---|
| 4125 | REAL(wp) :: zGRclust !< growth rate of formed clusters (nm/h) |
|---|
| 4126 | REAL(wp) :: zGRtot !< total growth rate |
|---|
| 4127 | REAL(wp) :: zj3 !< number conc. of formed 3nm particles (#/m3) |
|---|
| 4128 | REAL(wp) :: zjnuc !< nucleation rate at ~1nm (#/m3s) |
|---|
| 4129 | REAL(wp) :: zKeff !< effective cogulation coefficient between |
|---|
| 4130 | !< freshly nucleated particles |
|---|
| 4131 | REAL(wp) :: zknud(fn2b) !< particle Knudsen number |
|---|
| 4132 | REAL(wp) :: zkocnv !< lever: zkocnv=1 --> organic compounds involved |
|---|
| 4133 | !< in nucleation |
|---|
| 4134 | REAL(wp) :: zksa !< lever: zksa=1 --> H2SO4 involved in nucleation |
|---|
| 4135 | REAL(wp) :: zlambda !< parameter for adjusting the growth rate due to |
|---|
| 4136 | !< self-coagulation |
|---|
| 4137 | REAL(wp) :: zmfp !< mean free path of condesing vapour(m) |
|---|
| 4138 | REAL(wp) :: zmixnh3 !< ammonia mixing ratio (ppt) |
|---|
| 4139 | REAL(wp) :: zNnuc !< number of clusters/particles at the size range |
|---|
| 4140 | !< d1-dx (#/m3) |
|---|
| 4141 | REAL(wp) :: znoc !< number of organic molecules in critical cluster |
|---|
| 4142 | REAL(wp) :: znsa !< number of H2SO4 molecules in critical cluster |
|---|
| 4143 | ! |
|---|
| 4144 | !-- Variable determined for the m-parameter |
|---|
| 4145 | REAL(wp) :: zCc_2(fn2b) !< |
|---|
| 4146 | REAL(wp) :: zCc_c !< |
|---|
| 4147 | REAL(wp) :: zCc_x !< |
|---|
| 4148 | REAL(wp) :: zCoagS_c !< |
|---|
| 4149 | REAL(wp) :: zCoagS_x !< |
|---|
| 4150 | REAL(wp) :: zcv_2(fn2b) !< |
|---|
| 4151 | REAL(wp) :: zcv_c !< |
|---|
| 4152 | REAL(wp) :: zcv_c2(fn2b) !< |
|---|
| 4153 | REAL(wp) :: zcv_x !< |
|---|
| 4154 | REAL(wp) :: zcv_x2(fn2b) !< |
|---|
| 4155 | REAL(wp) :: zDc_2(fn2b) !< |
|---|
| 4156 | REAL(wp) :: zDc_c(fn2b) !< |
|---|
| 4157 | REAL(wp) :: zDc_c2(fn2b) !< |
|---|
| 4158 | REAL(wp) :: zDc_x(fn2b) !< |
|---|
| 4159 | REAL(wp) :: zDc_x2(fn2b) !< |
|---|
| 4160 | REAL(wp) :: zgammaF_2(fn2b) !< |
|---|
| 4161 | REAL(wp) :: zgammaF_c(fn2b) !< |
|---|
| 4162 | REAL(wp) :: zgammaF_x(fn2b) !< |
|---|
| 4163 | REAL(wp) :: zK_c2(fn2b) !< |
|---|
| 4164 | REAL(wp) :: zK_x2(fn2b) !< |
|---|
| 4165 | REAL(wp) :: zknud_2(fn2b) !< |
|---|
| 4166 | REAL(wp) :: zknud_c !< |
|---|
| 4167 | REAL(wp) :: zknud_x !< |
|---|
| 4168 | REAL(wp) :: zm_2(fn2b) !< |
|---|
| 4169 | REAL(wp) :: zm_c !< |
|---|
| 4170 | REAL(wp) :: zm_para !< |
|---|
| 4171 | REAL(wp) :: zm_x !< |
|---|
| 4172 | REAL(wp) :: zmyy !< |
|---|
| 4173 | REAL(wp) :: zomega_2c(fn2b) !< |
|---|
| 4174 | REAL(wp) :: zomega_2x(fn2b) !< |
|---|
| 4175 | REAL(wp) :: zomega_c(fn2b) !< |
|---|
| 4176 | REAL(wp) :: zomega_x(fn2b) !< |
|---|
| 4177 | REAL(wp) :: zRc2(fn2b) !< |
|---|
| 4178 | REAL(wp) :: zRx2(fn2b) !< |
|---|
| 4179 | REAL(wp) :: zsigma_c2(fn2b) !< |
|---|
| 4180 | REAL(wp) :: zsigma_x2(fn2b) !< |
|---|
| 4181 | ! |
|---|
| 4182 | !-- 1) Nucleation rate (zjnuc) and diameter of critical cluster (zdcrit) |
|---|
| 4183 | zjnuc = 0.0_wp |
|---|
| 4184 | znsa = 0.0_wp |
|---|
| 4185 | znoc = 0.0_wp |
|---|
| 4186 | zdcrit = 0.0_wp |
|---|
| 4187 | zksa = 0.0_wp |
|---|
| 4188 | zkocnv = 0.0_wp |
|---|
| 4189 | |
|---|
| 4190 | SELECT CASE ( nsnucl ) |
|---|
| 4191 | |
|---|
| 4192 | CASE(1) ! Binary H2SO4-H2O nucleation |
|---|
| 4193 | |
|---|
| 4194 | zc_h2so4 = pcsa * 1.0E-6_wp ! sulphuric acid conc. to #/cm3 |
|---|
| 4195 | CALL binnucl( zc_h2so4, ptemp, prh, zjnuc, znsa, znoc, zdcrit, zksa, & |
|---|
| 4196 | zkocnv ) |
|---|
| 4197 | |
|---|
| 4198 | CASE(2) ! Activation type nucleation |
|---|
| 4199 | |
|---|
| 4200 | zc_h2so4 = pcsa * 1.0E-6_wp ! sulphuric acid conc. to #/cm3 |
|---|
| 4201 | CALL binnucl( zc_h2so4, ptemp, prh, zjnuc, znsa, znoc, zdcrit, zksa, & |
|---|
| 4202 | zkocnv ) |
|---|
| 4203 | CALL actnucl( pcsa, zjnuc, zdcrit, znsa, znoc, zksa, zkocnv, act_coeff ) |
|---|
| 4204 | |
|---|
| 4205 | CASE(3) ! Kinetically limited nucleation of (NH4)HSO4 clusters |
|---|
| 4206 | |
|---|
| 4207 | zc_h2so4 = pcsa * 1.0E-6_wp ! sulphuric acid conc. to #/cm3 |
|---|
| 4208 | CALL binnucl( zc_h2so4, ptemp, prh, zjnuc, znsa, znoc, zdcrit, zksa, & |
|---|
| 4209 | zkocnv ) |
|---|
| 4210 | |
|---|
| 4211 | CALL kinnucl( zc_h2so4, zjnuc, zdcrit, znsa, znoc, zksa, zkocnv ) |
|---|
| 4212 | |
|---|
| 4213 | CASE(4) ! Ternary H2SO4-H2O-NH3 nucleation |
|---|
| 4214 | |
|---|
| 4215 | zmixnh3 = pcnh3 * ptemp * argas / ( ppres * avo ) |
|---|
| 4216 | zc_h2so4 = pcsa * 1.0E-6_wp ! sulphuric acid conc. to #/cm3 |
|---|
| 4217 | CALL ternucl( zc_h2so4, zmixnh3, ptemp, prh, zjnuc, znsa, znoc, zdcrit, & |
|---|
| 4218 | zksa, zkocnv ) |
|---|
| 4219 | |
|---|
| 4220 | CASE(5) ! Organic nucleation, J~[ORG] or J~[ORG]**2 |
|---|
| 4221 | |
|---|
| 4222 | zc_org = pcocnv * 1.0E-6_wp ! conc. of non-volatile OC to #/cm3 |
|---|
| 4223 | zc_h2so4 = pcsa * 1.0E-6_wp ! sulphuric acid conc. to #/cm3 |
|---|
| 4224 | CALL binnucl( zc_h2so4, ptemp, prh, zjnuc, znsa, znoc, zdcrit, zksa, & |
|---|
| 4225 | zkocnv ) |
|---|
| 4226 | CALL orgnucl( pcocnv, zjnuc, zdcrit, znsa, znoc, zksa, zkocnv ) |
|---|
| 4227 | |
|---|
| 4228 | CASE(6) ! Sum of H2SO4 and organic activation type nucleation, |
|---|
| 4229 | ! J~[H2SO4]+[ORG] |
|---|
| 4230 | |
|---|
| 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 sumnucl( pcsa, pcocnv, zjnuc, zdcrit, znsa, znoc, zksa, zkocnv ) |
|---|
| 4235 | |
|---|
| 4236 | |
|---|
| 4237 | CASE(7) ! Heteromolecular nucleation, J~[H2SO4]*[ORG] |
|---|
| 4238 | |
|---|
| 4239 | zc_h2so4 = pcsa * 1.0E-6_wp ! sulphuric acid conc. to #/cm3 |
|---|
| 4240 | zc_org = pcocnv * 1.0E-6_wp ! conc. of non-volatile OC to #/cm3 |
|---|
| 4241 | CALL binnucl( zc_h2so4, ptemp, prh, zjnuc, znsa, znoc, zdcrit, zksa, & |
|---|
| 4242 | zkocnv ) |
|---|
| 4243 | CALL hetnucl( zc_h2so4, zc_org, zjnuc, zdcrit, znsa, znoc, zksa, zkocnv ) |
|---|
| 4244 | |
|---|
| 4245 | CASE(8) ! Homomolecular nucleation of H2SO4 and heteromolecular |
|---|
| 4246 | ! nucleation of H2SO4 and organic vapour, |
|---|
| 4247 | ! J~[H2SO4]**2 + [H2SO4]*[ORG] (EUCAARI project) |
|---|
| 4248 | zc_h2so4 = pcsa * 1.0E-6_wp ! sulphuric acid conc. to #/cm3 |
|---|
| 4249 | zc_org = pcocnv * 1.0E-6_wp ! conc. of non-volatile OC to #/cm3 |
|---|
| 4250 | CALL binnucl( zc_h2so4, ptemp, prh, zjnuc, znsa, znoc, zdcrit, zksa, & |
|---|
| 4251 | zkocnv ) |
|---|
| 4252 | CALL SAnucl( zc_h2so4, zc_org, zjnuc, zdcrit, znsa, znoc, zksa, zkocnv ) |
|---|
| 4253 | |
|---|
| 4254 | CASE(9) ! Homomolecular nucleation of H2SO4 and organic vapour and |
|---|
| 4255 | ! heteromolecular nucleation of H2SO4 and organic vapour, |
|---|
| 4256 | ! J~[H2SO4]**2 + [H2SO4]*[ORG]+[ORG]**2 (EUCAARI project) |
|---|
| 4257 | |
|---|
| 4258 | zc_h2so4 = pcsa * 1.0E-6_wp ! sulphuric acid conc. to #/cm3 |
|---|
| 4259 | zc_org = pcocnv * 1.0E-6_wp ! conc. of non-volatile OC to #/cm3 |
|---|
| 4260 | CALL binnucl( zc_h2so4, ptemp, prh, zjnuc, znsa, znoc, zdcrit, zksa, & |
|---|
| 4261 | zkocnv ) |
|---|
| 4262 | |
|---|
| 4263 | CALL SAORGnucl( zc_h2so4, zc_org, zjnuc, zdcrit, znsa, znoc, zksa, & |
|---|
| 4264 | zkocnv ) |
|---|
| 4265 | END SELECT |
|---|
| 4266 | |
|---|
| 4267 | zcsa_local = pcsa |
|---|
| 4268 | zcocnv_local = pcocnv |
|---|
| 4269 | ! |
|---|
| 4270 | !-- 2) Change of particle and gas concentrations due to nucleation |
|---|
| 4271 | ! |
|---|
| 4272 | !-- 2.1) Check that there is enough H2SO4 and organic vapour to produce the |
|---|
| 4273 | !-- nucleation |
|---|
| 4274 | IF ( nsnucl <= 4 ) THEN |
|---|
| 4275 | !-- If the chosen nucleation scheme is 1-4, nucleation occurs only due to |
|---|
| 4276 | !-- H2SO4. All of the total vapour concentration that is taking part to the |
|---|
| 4277 | !-- nucleation is there for sulphuric acid (sa = H2SO4) and non-volatile |
|---|
| 4278 | !-- organic vapour is zero. |
|---|
| 4279 | pxsa = 1.0_wp ! ratio of sulphuric acid in 3nm particles |
|---|
| 4280 | pxocnv = 0.0_wp ! ratio of non-volatile origanic vapour |
|---|
| 4281 | ! in 3nm particles |
|---|
| 4282 | ELSEIF ( nsnucl > 4 ) THEN |
|---|
| 4283 | !-- If the chosen nucleation scheme is 5-9, nucleation occurs due to organic |
|---|
| 4284 | !-- vapour or the combination of organic vapour and H2SO4. The number of |
|---|
| 4285 | !-- needed molecules depends on the chosen nucleation type and it has an |
|---|
| 4286 | !-- effect also on the minimum ratio of the molecules present. |
|---|
| 4287 | IF ( pcsa * znsa + pcocnv * znoc < 1.E-14_wp ) THEN |
|---|
| 4288 | pxsa = 0.0_wp |
|---|
| 4289 | pxocnv = 0.0_wp |
|---|
| 4290 | ELSE |
|---|
| 4291 | pxsa = pcsa * znsa / ( pcsa * znsa + pcocnv * znoc ) |
|---|
| 4292 | pxocnv = pcocnv * znoc / ( pcsa * znsa + pcocnv * znoc ) |
|---|
| 4293 | ENDIF |
|---|
| 4294 | ENDIF |
|---|
| 4295 | ! |
|---|
| 4296 | !-- The change in total vapour concentration is the sum of the concentrations |
|---|
| 4297 | !-- of the vapours taking part to the nucleation (depends on the chosen |
|---|
| 4298 | !-- nucleation scheme) |
|---|
| 4299 | zdelta_vap = MIN( zjnuc * ( znoc + znsa ), ( pcocnv * zkocnv + pcsa * & |
|---|
| 4300 | zksa ) / ptstep ) |
|---|
| 4301 | ! |
|---|
| 4302 | !-- Nucleation rate J at ~1nm (#/m3s) |
|---|
| 4303 | zjnuc = zdelta_vap / ( znoc + znsa ) |
|---|
| 4304 | ! |
|---|
| 4305 | !-- H2SO4 concentration after nucleation in #/m3 |
|---|
| 4306 | zcsa_local = MAX( 1.0_wp, pcsa - zdelta_vap * pxsa ) |
|---|
| 4307 | ! |
|---|
| 4308 | !-- Non-volative organic vapour concentration after nucleation (#/m3) |
|---|
| 4309 | zcocnv_local = MAX( 1.0_wp, pcocnv - zdelta_vap * pxocnv ) |
|---|
| 4310 | ! |
|---|
| 4311 | !-- 2.2) Formation rate of 3 nm particles (Kerminen & Kulmala, 2002) |
|---|
| 4312 | ! |
|---|
| 4313 | !-- 2.2.1) Growth rate of clusters formed by H2SO4 |
|---|
| 4314 | ! |
|---|
| 4315 | !-- GR = 3.0e-15 / dens_clus * sum( molecspeed * molarmass * conc ) |
|---|
| 4316 | ! |
|---|
| 4317 | !-- dens_clus = density of the clusters (here 1830 kg/m3) |
|---|
| 4318 | !-- molarmass = molar mass of condensing species (here 98.08 g/mol) |
|---|
| 4319 | !-- conc = concentration of condensing species [#/m3] |
|---|
| 4320 | !-- molecspeed = molecular speed of condensing species [m/s] |
|---|
| 4321 | !-- = sqrt( 8.0 * R * ptemp / ( pi * molarmass ) ) |
|---|
| 4322 | !-- (Seinfeld & Pandis, 1998) |
|---|
| 4323 | ! |
|---|
| 4324 | !-- Growth rate by H2SO4 and organic vapour in nm/h (Eq. 21) |
|---|
| 4325 | zGRclust = 2.3623E-15_wp * SQRT( ptemp ) * ( zcsa_local + zcocnv_local ) |
|---|
| 4326 | ! |
|---|
| 4327 | !-- 2.2.2) Condensational sink of pre-existing particle population |
|---|
| 4328 | ! |
|---|
| 4329 | !-- Diffusion coefficient (m2/s) |
|---|
| 4330 | zdfvap = 5.1111E-10_wp * ptemp ** 1.75_wp * ( p_0 + 1325.0_wp ) / ppres |
|---|
| 4331 | !-- Mean free path of condensing vapour (m) (Jacobson (2005), Eq. 15.25 and |
|---|
| 4332 | !-- 16.29) |
|---|
| 4333 | zmfp = 3.0_wp * zdfvap * SQRT( pi * amh2so4 / ( 8.0_wp * argas * ptemp ) ) |
|---|
| 4334 | !-- Knudsen number |
|---|
| 4335 | zknud = 2.0_wp * zmfp / ( paero(:)%dwet + d_sa ) |
|---|
| 4336 | !-- Transitional regime correction factor (zbeta) according to Fuchs and |
|---|
| 4337 | !-- Sutugin (1971), In: Hidy et al. (ed.), Topics in current aerosol research, |
|---|
| 4338 | !-- Pergamon. (Eq. 4 in Kerminen and Kulmala, 2002) |
|---|
| 4339 | zbeta = ( zknud + 1.0_wp) / ( 0.377_wp * zknud + 1.0_wp + 4.0_wp / & |
|---|
| 4340 | ( 3.0_wp * massacc ) * ( zknud + zknud ** 2 ) ) |
|---|
| 4341 | !-- Condensational sink (#/m2) (Eq. 3) |
|---|
| 4342 | zcsink = SUM( paero(:)%dwet * zbeta * paero(:)%numc ) |
|---|
| 4343 | ! |
|---|
| 4344 | !-- Parameterised formation rate of detectable 3 nm particles (i.e. J3) |
|---|
| 4345 | IF ( nj3 == 1 ) THEN ! Kerminen and Kulmala (2002) |
|---|
| 4346 | !-- 2.2.3) Parameterised formation rate of detectable 3 nm particles |
|---|
| 4347 | !-- Constants needed for the parameterisation: |
|---|
| 4348 | !-- dapp = 3 nm and dens_nuc = 1830 kg/m3 |
|---|
| 4349 | IF ( zcsink < 1.0E-30_wp ) THEN |
|---|
| 4350 | zeta = 0._dp |
|---|
| 4351 | ELSE |
|---|
| 4352 | !-- Mean diameter of backgroud population (nm) |
|---|
| 4353 | zdmean = 1.0_wp / SUM( paero(:)%numc ) * SUM( paero(:)%numc * & |
|---|
| 4354 | paero(:)%dwet ) * 1.0E+9_wp |
|---|
| 4355 | !-- Proportionality factor (nm2*m2/h) (Eq. 22) |
|---|
| 4356 | zgamma = 0.23_wp * ( zdcrit * 1.0E+9_wp ) ** 0.2_wp * ( zdmean / & |
|---|
| 4357 | 150.0_wp ) ** 0.048_wp * ( ptemp / 293.0_wp ) ** ( -0.75_wp ) & |
|---|
| 4358 | * ( arhoh2so4 / 1000.0_wp ) ** ( -0.33_wp ) |
|---|
| 4359 | !-- Factor eta (nm) (Eq. 11) |
|---|
| 4360 | zeta = MIN( zgamma * zcsink / zGRclust, zdcrit * 1.0E11_wp ) |
|---|
| 4361 | ENDIF |
|---|
| 4362 | ! |
|---|
| 4363 | !-- Number conc. of clusters surviving to 3 nm in a time step (#/m3) (Eq.14) |
|---|
| 4364 | zj3 = zjnuc * EXP( MIN( 0.0_wp, zeta / 3.0_wp - zeta / & |
|---|
| 4365 | ( zdcrit * 1.0E9_wp ) ) ) |
|---|
| 4366 | |
|---|
| 4367 | ELSEIF ( nj3 > 1 ) THEN |
|---|
| 4368 | !-- Defining the value for zm_para. The growth is investigated between |
|---|
| 4369 | !-- [d1,reglim(1)] = [zdcrit,3nm] |
|---|
| 4370 | !-- m = LOG( CoagS_dx / CoagX_zdcrit ) / LOG( reglim / zdcrit ) |
|---|
| 4371 | !-- (Lehtinen et al. 2007, Eq. 5) |
|---|
| 4372 | !-- The steps for the coagulation sink for reglim = 3nm and zdcrit ~= 1nm are |
|---|
| 4373 | !-- explained in article of Kulmala et al. (2001). The particles of diameter |
|---|
| 4374 | !-- zdcrit ~1.14 nm and reglim = 3nm are both in turn the "number 1" |
|---|
| 4375 | !-- variables (Kulmala et al. 2001). |
|---|
| 4376 | !-- c = critical (1nm), x = 3nm, 2 = wet or mean droplet |
|---|
| 4377 | !-- Sum of the radii, R12 = R1 + zR2 (m) of two particles 1 and 2 |
|---|
| 4378 | zRc2 = zdcrit / 2.0_wp + paero(:)%dwet / 2.0_wp |
|---|
| 4379 | zRx2 = reglim(1) / 2.0_wp + paero(:)%dwet / 2.0_wp |
|---|
| 4380 | ! |
|---|
| 4381 | !-- The mass of particle (kg) (comes only from H2SO4) |
|---|
| 4382 | zm_c = 4.0_wp / 3.0_wp * pi * ( zdcrit / 2.0_wp ) ** 3.0_wp * arhoh2so4 |
|---|
| 4383 | zm_x = 4.0_wp / 3.0_wp * pi * ( reglim(1) / 2.0_wp ) ** 3.0_wp * & |
|---|
| 4384 | arhoh2so4 |
|---|
| 4385 | zm_2 = 4.0_wp / 3.0_wp * pi * ( paero(:)%dwet / 2.0_wp )** 3.0_wp * & |
|---|
| 4386 | arhoh2so4 |
|---|
| 4387 | ! |
|---|
| 4388 | !-- Mean relative thermal velocity between the particles (m/s) |
|---|
| 4389 | zcv_c = SQRT( 8.0_wp * abo * ptemp / ( pi * zm_c ) ) |
|---|
| 4390 | zcv_x = SQRT( 8.0_wp * abo * ptemp / ( pi * zm_x ) ) |
|---|
| 4391 | zcv_2 = SQRT( 8.0_wp * abo * ptemp / ( pi * zm_2 ) ) |
|---|
| 4392 | ! |
|---|
| 4393 | !-- Average velocity after coagulation |
|---|
| 4394 | zcv_c2 = SQRT( zcv_c ** 2.0_wp + zcv_2 ** 2.0_wp ) |
|---|
| 4395 | zcv_x2 = SQRT( zcv_x ** 2.0_wp + zcv_2 ** 2.0_wp ) |
|---|
| 4396 | ! |
|---|
| 4397 | !-- Knudsen number (zmfp = mean free path of condensing vapour) |
|---|
| 4398 | zknud_c = 2.0_wp * zmfp / zdcrit |
|---|
| 4399 | zknud_x = 2.0_wp * zmfp / reglim(1) |
|---|
| 4400 | zknud_2 = MAX( 0.0_wp, 2.0_wp * zmfp / paero(:)%dwet ) |
|---|
| 4401 | ! |
|---|
| 4402 | !-- Cunningham correction factor |
|---|
| 4403 | zCc_c = 1.0_wp + zknud_c * ( 1.142_wp + 0.558_wp * & |
|---|
| 4404 | EXP( -0.999_wp / zknud_c ) ) |
|---|
| 4405 | zCc_x = 1.0_wp + zknud_x * ( 1.142_wp + 0.558_wp * & |
|---|
| 4406 | EXP( -0.999_wp / zknud_x ) ) |
|---|
| 4407 | zCc_2 = 1.0_wp + zknud_2 * ( 1.142_wp + 0.558_wp * & |
|---|
| 4408 | EXP( -0.999_wp / zknud_2 ) ) |
|---|
| 4409 | ! |
|---|
| 4410 | !-- Gas dynamic viscosity (N*s/m2). |
|---|
| 4411 | !-- Viscocity(air @20C) = 1.81e-5_dp N/m2 *s (Hinds, p. 25) |
|---|
| 4412 | zmyy = 1.81E-5_wp * ( ptemp / 293.0_wp) ** ( 0.74_wp ) |
|---|
| 4413 | ! |
|---|
| 4414 | !-- Particle diffusion coefficient (m2/s) |
|---|
| 4415 | zDc_c = abo * ptemp * zCc_c / ( 3.0_wp * pi * zmyy * zdcrit ) |
|---|
| 4416 | zDc_x = abo * ptemp * zCc_x / ( 3.0_wp * pi * zmyy * reglim(1) ) |
|---|
| 4417 | zDc_2 = abo * ptemp * zCc_2 / ( 3.0_wp * pi * zmyy * paero(:)%dwet ) |
|---|
| 4418 | ! |
|---|
| 4419 | !-- D12 = D1+D2 (Seinfield and Pandis, 2nd ed. Eq. 13.38) |
|---|
| 4420 | zDc_c2 = zDc_c + zDc_2 |
|---|
| 4421 | zDc_x2 = zDc_x + zDc_2 |
|---|
| 4422 | ! |
|---|
| 4423 | !-- zgammaF = 8*D/pi/zcv (m) for calculating zomega |
|---|
| 4424 | zgammaF_c = 8.0_wp * zDc_c / pi / zcv_c |
|---|
| 4425 | zgammaF_x = 8.0_wp * zDc_x / pi / zcv_x |
|---|
| 4426 | zgammaF_2 = 8.0_wp * zDc_2 / pi / zcv_2 |
|---|
| 4427 | ! |
|---|
| 4428 | !-- zomega (m) for calculating zsigma |
|---|
| 4429 | zomega_c = ( ( zRc2 + zgammaF_c ) ** 3 - ( zRc2 ** 2 + & |
|---|
| 4430 | zgammaF_c ) ** ( 3.0_wp / 2.0_wp ) ) / ( 3.0_wp * & |
|---|
| 4431 | zRc2 * zgammaF_c ) - zRc2 |
|---|
| 4432 | zomega_x = ( ( zRx2 + zgammaF_x ) ** 3.0_wp - ( zRx2 ** 2.0_wp + & |
|---|
| 4433 | zgammaF_x ) ** ( 3.0_wp / 2.0_wp ) ) / ( 3.0_wp * & |
|---|
| 4434 | zRx2 * zgammaF_x ) - zRx2 |
|---|
| 4435 | zomega_2c = ( ( zRc2 + zgammaF_2 ) ** 3.0_wp - ( zRc2 ** 2.0_wp + & |
|---|
| 4436 | zgammaF_2 ) ** ( 3.0_wp / 2.0_wp ) ) / ( 3.0_wp * & |
|---|
| 4437 | zRc2 * zgammaF_2 ) - zRc2 |
|---|
| 4438 | zomega_2x = ( ( zRx2 + zgammaF_2 ) ** 3.0_wp - ( zRx2 ** 2.0_wp + & |
|---|
| 4439 | zgammaF_2 ) ** ( 3.0_wp / 2.0_wp ) ) / ( 3.0_wp * & |
|---|
| 4440 | zRx2 * zgammaF_2 ) - zRx2 |
|---|
| 4441 | ! |
|---|
| 4442 | !-- The distance (m) at which the two fluxes are matched (condensation and |
|---|
| 4443 | !-- coagulation sinks?) |
|---|
| 4444 | zsigma_c2 = SQRT( zomega_c ** 2.0_wp + zomega_2c ** 2.0_wp ) |
|---|
| 4445 | zsigma_x2 = SQRT( zomega_x ** 2.0_wp + zomega_2x ** 2.0_wp ) |
|---|
| 4446 | ! |
|---|
| 4447 | !-- Coagulation coefficient in the continuum regime (m*m2/s) |
|---|
| 4448 | zK_c2 = 4.0_wp * pi * zRc2 * zDc_c2 / ( zRc2 / ( zRc2 + zsigma_c2 ) + & |
|---|
| 4449 | 4.0_wp * zDc_c2 / ( zcv_c2 * zRc2 ) ) |
|---|
| 4450 | zK_x2 = 4.0_wp * pi * zRx2 * zDc_x2 / ( zRx2 / ( zRx2 + zsigma_x2 ) + & |
|---|
| 4451 | 4.0_wp * zDc_x2 / ( zcv_x2 * zRx2 ) ) |
|---|
| 4452 | ! |
|---|
| 4453 | !-- Coagulation sink (1/s) |
|---|
| 4454 | zCoagS_c = MAX( 1.0E-20_wp, SUM( zK_c2 * paero(:)%numc ) ) |
|---|
| 4455 | zCoagS_x = MAX( 1.0E-20_wp, SUM( zK_x2 * paero(:)%numc ) ) |
|---|
| 4456 | ! |
|---|
| 4457 | !-- Parameter m for calculating the coagulation sink onto background |
|---|
| 4458 | !-- particles (Eq. 5&6 in Lehtinen et al. 2007) |
|---|
| 4459 | zm_para = LOG( zCoagS_x / zCoagS_c ) / LOG( reglim(1) / zdcrit ) |
|---|
| 4460 | ! |
|---|
| 4461 | !-- Parameter gamma for calculating the formation rate J of particles having |
|---|
| 4462 | !-- a diameter zdcrit < d < reglim(1) (Anttila et al. 2010, eq. 5) |
|---|
| 4463 | zgamma = ( ( ( reglim(1) / zdcrit ) ** ( zm_para + 1.0_wp ) ) - 1.0_wp )& |
|---|
| 4464 | / ( zm_para + 1.0_wp ) |
|---|
| 4465 | |
|---|
| 4466 | IF ( nj3 == 2 ) THEN ! Coagulation sink |
|---|
| 4467 | ! |
|---|
| 4468 | !-- Formation rate J before iteration (#/m3s) |
|---|
| 4469 | zj3 = zjnuc * EXP( MIN( 0.0_wp, -zgamma * zdcrit * zCoagS_c / & |
|---|
| 4470 | ( zGRclust * 1.0E-9_wp / ( 60.0_wp ** 2.0_wp ) ) ) ) |
|---|
| 4471 | |
|---|
| 4472 | ELSEIF ( nj3 == 3 ) THEN ! Coagulation sink and self-coag. |
|---|
| 4473 | !-- IF polluted air... then the self-coagulation becomes important. |
|---|
| 4474 | !-- Self-coagulation of small particles < 3 nm. |
|---|
| 4475 | ! |
|---|
| 4476 | !-- "Effective" coagulation coefficient between freshly-nucleated |
|---|
| 4477 | !-- particles: |
|---|
| 4478 | zKeff = 5.0E-16_wp ! cm3/s |
|---|
| 4479 | ! |
|---|
| 4480 | !-- zlambda parameter for "adjusting" the growth rate due to the |
|---|
| 4481 | !-- self-coagulation |
|---|
| 4482 | zlambda = 6.0_wp |
|---|
| 4483 | IF ( reglim(1) >= 10.0E-9_wp ) THEN ! for particles >10 nm: |
|---|
| 4484 | zKeff = 5.0E-17_wp |
|---|
| 4485 | zlambda = 3.0_wp |
|---|
| 4486 | ENDIF |
|---|
| 4487 | ! |
|---|
| 4488 | !-- Initial values for coagulation sink and growth rate (m/s) |
|---|
| 4489 | zCoagStot = zCoagS_c |
|---|
| 4490 | zGRtot = zGRclust * 1.0E-9_wp / 60.0_wp ** 2.0_wp |
|---|
| 4491 | ! |
|---|
| 4492 | !-- Number of clusters/particles at the size range [d1,dx] (#/m3): |
|---|
| 4493 | zNnuc = zjnuc / zCoagStot !< Initial guess |
|---|
| 4494 | ! |
|---|
| 4495 | !-- Coagulation sink and growth rate due to self-coagulation: |
|---|
| 4496 | DO iteration = 1, 5 |
|---|
| 4497 | zCoagStot = zCoagS_c + zKeff * zNnuc * 1.0E-6_wp ! (1/s) |
|---|
| 4498 | zGRtot = zGRclust * 1.0E-9_wp / ( 3600.0_wp ) + 1.5708E-6_wp * & |
|---|
| 4499 | zlambda * zdcrit ** 3.0_wp * ( zNnuc * 1.0E-6_wp ) * & |
|---|
| 4500 | zcv_c * avo * 1.0E-9_wp / 3600.0_wp |
|---|
| 4501 | zeta = - zCoagStot / ( ( zm_para + 1.0_wp ) * zGRtot * ( zdcrit **& |
|---|
| 4502 | zm_para ) ) ! Eq. 7b (Anttila) |
|---|
| 4503 | zNnuc = zNnuc_tayl( zdcrit, reglim(1), zm_para, zjnuc, zeta, & |
|---|
| 4504 | zGRtot ) |
|---|
| 4505 | ENDDO |
|---|
| 4506 | ! |
|---|
| 4507 | !-- Calculate the final values with new zNnuc: |
|---|
| 4508 | zCoagStot = zCoagS_c + zKeff * zNnuc * 1.0E-6_wp ! (1/s) |
|---|
| 4509 | zGRtot = zGRclust * 1.0E-9_wp / 3600.0_wp + 1.5708E-6_wp * zlambda & |
|---|
| 4510 | * zdcrit ** 3.0_wp * ( zNnuc * 1.0E-6_wp ) * zcv_c * avo * & |
|---|
| 4511 | 1.0E-9_wp / 3600.0_wp !< (m/s) |
|---|
| 4512 | zj3 = zjnuc * EXP( MIN( 0.0_wp, -zgamma * zdcrit * zCoagStot / & |
|---|
| 4513 | zGRtot ) ) ! (Eq. 5a) (#/m3s) |
|---|
| 4514 | |
|---|
| 4515 | ENDIF |
|---|
| 4516 | |
|---|
| 4517 | ENDIF |
|---|
| 4518 | !-- If J3 very small (< 1 #/cm3), neglect particle formation. In real atmosphere |
|---|
| 4519 | !-- this would mean that clusters form but coagulate to pre-existing particles |
|---|
| 4520 | !-- who gain sulphate. Since CoagS ~ CS (4piD*CS'), we do *not* update H2SO4 |
|---|
| 4521 | !-- concentration here but let condensation take care of it. |
|---|
| 4522 | !-- Formation mass rate of molecules (molec/m3s) for 1: H2SO4 and 2: organic |
|---|
| 4523 | !-- vapour |
|---|
| 4524 | pj3n3(1) = zj3 * n3 * pxsa |
|---|
| 4525 | pj3n3(2) = zj3 * n3 * pxocnv |
|---|
| 4526 | |
|---|
| 4527 | |
|---|
| 4528 | END SUBROUTINE nucleation |
|---|
| 4529 | |
|---|
| 4530 | !------------------------------------------------------------------------------! |
|---|
| 4531 | ! Description: |
|---|
| 4532 | ! ------------ |
|---|
| 4533 | !> Calculate the nucleation rate and the size of critical clusters assuming |
|---|
| 4534 | !> binary nucleation. |
|---|
| 4535 | !> Parametrisation according to Vehkamaki et al. (2002), J. Geophys. Res., |
|---|
| 4536 | !> 107(D22), 4622. Called from subroutine nucleation. |
|---|
| 4537 | !------------------------------------------------------------------------------! |
|---|
| 4538 | SUBROUTINE binnucl( pc_sa, ptemp, prh, pnuc_rate, pn_crit_sa, pn_crit_ocnv, & |
|---|
| 4539 | pd_crit, pk_sa, pk_ocnv ) |
|---|
| 4540 | |
|---|
| 4541 | IMPLICIT NONE |
|---|
| 4542 | ! |
|---|
| 4543 | !-- Input and output variables |
|---|
| 4544 | REAL(wp), INTENT(in) :: pc_sa !< H2SO4 conc. (#/cm3) |
|---|
| 4545 | REAL(wp), INTENT(in) :: prh !< relative humidity [0-1] |
|---|
| 4546 | REAL(wp), INTENT(in) :: ptemp !< ambient temperature (K) |
|---|
| 4547 | REAL(wp), INTENT(out) :: pnuc_rate !< nucleation rate (#/(m3 s)) |
|---|
| 4548 | REAL(wp), INTENT(out) :: pn_crit_sa !< number of H2SO4 molecules in |
|---|
| 4549 | !< cluster (#) |
|---|
| 4550 | REAL(wp), INTENT(out) :: pn_crit_ocnv !< number of organic molecules in |
|---|
| 4551 | !< cluster (#) |
|---|
| 4552 | REAL(wp), INTENT(out) :: pd_crit !< diameter of critical cluster (m) |
|---|
| 4553 | REAL(wp), INTENT(out) :: pk_sa !< Lever: if pk_sa = 1, H2SO4 is |
|---|
| 4554 | !< involved in nucleation. |
|---|
| 4555 | REAL(wp), INTENT(out) :: pk_ocnv !< Lever: if pk_ocnv = 1, organic |
|---|
| 4556 | !< compounds are involved in |
|---|
| 4557 | !< nucleation. |
|---|
| 4558 | !-- Local variables |
|---|
| 4559 | REAL(wp) :: zx !< mole fraction of sulphate in critical cluster |
|---|
| 4560 | REAL(wp) :: zntot !< number of molecules in critical cluster |
|---|
| 4561 | REAL(wp) :: zt !< temperature |
|---|
| 4562 | REAL(wp) :: zpcsa !< sulfuric acid concentration |
|---|
| 4563 | REAL(wp) :: zrh !< relative humidity |
|---|
| 4564 | REAL(wp) :: zma !< |
|---|
| 4565 | REAL(wp) :: zmw !< |
|---|
| 4566 | REAL(wp) :: zxmass!< |
|---|
| 4567 | REAL(wp) :: za !< |
|---|
| 4568 | REAL(wp) :: zb !< |
|---|
| 4569 | REAL(wp) :: zc !< |
|---|
| 4570 | REAL(wp) :: zroo !< |
|---|
| 4571 | REAL(wp) :: zm1 !< |
|---|
| 4572 | REAL(wp) :: zm2 !< |
|---|
| 4573 | REAL(wp) :: zv1 !< |
|---|
| 4574 | REAL(wp) :: zv2 !< |
|---|
| 4575 | REAL(wp) :: zcoll !< |
|---|
| 4576 | |
|---|
| 4577 | pnuc_rate = 0.0_wp |
|---|
| 4578 | pd_crit = 1.0E-9_wp |
|---|
| 4579 | |
|---|
| 4580 | ! |
|---|
| 4581 | !-- 1) Checking that we are in the validity range of the parameterization |
|---|
| 4582 | zt = MAX( ptemp, 190.15_wp ) |
|---|
| 4583 | zt = MIN( zt, 300.15_wp ) |
|---|
| 4584 | zpcsa = MAX( pc_sa, 1.0E4_wp ) |
|---|
| 4585 | zpcsa = MIN( zpcsa, 1.0E11_wp ) |
|---|
| 4586 | zrh = MAX( prh, 0.0001_wp ) |
|---|
| 4587 | zrh = MIN( zrh, 1.0_wp ) |
|---|
| 4588 | ! |
|---|
| 4589 | !-- 2) Mole fraction of sulphate in a critical cluster (Eq. 11) |
|---|
| 4590 | zx = 0.7409967177282139_wp & |
|---|
| 4591 | - 0.002663785665140117_wp * zt & |
|---|
| 4592 | + 0.002010478847383187_wp * LOG( zrh ) & |
|---|
| 4593 | - 0.0001832894131464668_wp* zt * LOG( zrh ) & |
|---|
| 4594 | + 0.001574072538464286_wp * LOG( zrh ) ** 2 & |
|---|
| 4595 | - 0.00001790589121766952_wp * zt * LOG( zrh ) ** 2 & |
|---|
| 4596 | + 0.0001844027436573778_wp * LOG( zrh ) ** 3 & |
|---|
| 4597 | - 1.503452308794887E-6_wp * zt * LOG( zrh ) ** 3 & |
|---|
| 4598 | - 0.003499978417957668_wp * LOG( zpcsa ) & |
|---|
| 4599 | + 0.0000504021689382576_wp * zt * LOG( zpcsa ) |
|---|
| 4600 | ! |
|---|
| 4601 | !-- 3) Nucleation rate (Eq. 12) |
|---|
| 4602 | pnuc_rate = 0.1430901615568665_wp & |
|---|
| 4603 | + 2.219563673425199_wp * zt & |
|---|
| 4604 | - 0.02739106114964264_wp * zt ** 2 & |
|---|
| 4605 | + 0.00007228107239317088_wp * zt ** 3 & |
|---|
| 4606 | + 5.91822263375044_wp / zx & |
|---|
| 4607 | + 0.1174886643003278_wp * LOG( zrh ) & |
|---|
| 4608 | + 0.4625315047693772_wp * zt * LOG( zrh ) & |
|---|
| 4609 | - 0.01180591129059253_wp * zt ** 2 * LOG( zrh ) & |
|---|
| 4610 | + 0.0000404196487152575_wp * zt ** 3 * LOG( zrh ) & |
|---|
| 4611 | + ( 15.79628615047088_wp * LOG( zrh ) ) / zx & |
|---|
| 4612 | - 0.215553951893509_wp * LOG( zrh ) ** 2 & |
|---|
| 4613 | - 0.0810269192332194_wp * zt * LOG( zrh ) ** 2 & |
|---|
| 4614 | + 0.001435808434184642_wp * zt ** 2 * LOG( zrh ) ** 2 & |
|---|
| 4615 | - 4.775796947178588E-6_wp * zt ** 3 * LOG( zrh ) ** 2 & |
|---|
| 4616 | - (2.912974063702185_wp * LOG( zrh ) ** 2 ) / zx & |
|---|
| 4617 | - 3.588557942822751_wp * LOG( zrh ) ** 3 & |
|---|
| 4618 | + 0.04950795302831703_wp * zt * LOG( zrh ) ** 3 & |
|---|
| 4619 | - 0.0002138195118737068_wp * zt ** 2 * LOG( zrh ) ** 3 & |
|---|
| 4620 | + 3.108005107949533E-7_wp * zt ** 3 * LOG( zrh ) ** 3 & |
|---|
| 4621 | - ( 0.02933332747098296_wp * LOG( zrh ) ** 3 ) / zx & |
|---|
| 4622 | + 1.145983818561277_wp * LOG( zpcsa ) & |
|---|
| 4623 | - 0.6007956227856778_wp * zt * LOG( zpcsa ) & |
|---|
| 4624 | + 0.00864244733283759_wp * zt ** 2 * LOG( zpcsa ) & |
|---|
| 4625 | - 0.00002289467254710888_wp * zt ** 3 * LOG( zpcsa ) & |
|---|
| 4626 | - ( 8.44984513869014_wp * LOG( zpcsa ) ) / zx & |
|---|
| 4627 | + 2.158548369286559_wp * LOG( zrh ) * LOG( zpcsa ) & |
|---|
| 4628 | + 0.0808121412840917_wp * zt * LOG( zrh ) * LOG( zpcsa ) & |
|---|
| 4629 | - 0.0004073815255395214_wp * zt ** 2 * LOG( zrh ) * LOG( zpcsa ) & |
|---|
| 4630 | - 4.019572560156515E-7_wp * zt ** 3 * LOG( zrh ) * LOG( zpcsa ) & |
|---|
| 4631 | + ( 0.7213255852557236_wp * LOG( zrh ) * LOG( zpcsa ) ) / zx & |
|---|
| 4632 | + 1.62409850488771_wp * LOG( zrh ) ** 2 * LOG( zpcsa ) & |
|---|
| 4633 | - 0.01601062035325362_wp * zt * LOG( zrh ) ** 2 * LOG( zpcsa ) & |
|---|
| 4634 | + 0.00003771238979714162_wp*zt**2* LOG( zrh )**2 * LOG( zpcsa ) & |
|---|
| 4635 | + 3.217942606371182E-8_wp * zt**3 * LOG( zrh )**2 * LOG( zpcsa ) & |
|---|
| 4636 | - (0.01132550810022116_wp * LOG( zrh )**2 * LOG( zpcsa ) ) / zx & |
|---|
| 4637 | + 9.71681713056504_wp * LOG( zpcsa ) ** 2 & |
|---|
| 4638 | - 0.1150478558347306_wp * zt * LOG( zpcsa ) ** 2 & |
|---|
| 4639 | + 0.0001570982486038294_wp * zt ** 2 * LOG( zpcsa ) ** 2 & |
|---|
| 4640 | + 4.009144680125015E-7_wp * zt ** 3 * LOG( zpcsa ) ** 2 & |
|---|
| 4641 | + ( 0.7118597859976135_wp * LOG( zpcsa ) ** 2 ) / zx & |
|---|
| 4642 | - 1.056105824379897_wp * LOG( zrh ) * LOG( zpcsa ) ** 2 & |
|---|
| 4643 | + 0.00903377584628419_wp * zt * LOG( zrh ) * LOG( zpcsa )**2 & |
|---|
| 4644 | - 0.00001984167387090606_wp*zt**2*LOG( zrh )*LOG( zpcsa )**2 & |
|---|
| 4645 | + 2.460478196482179E-8_wp * zt**3 * LOG( zrh ) * LOG( zpcsa )**2 & |
|---|
| 4646 | - ( 0.05790872906645181_wp * LOG( zrh ) * LOG( zpcsa )**2 ) / zx & |
|---|
| 4647 | - 0.1487119673397459_wp * LOG( zpcsa ) ** 3 & |
|---|
| 4648 | + 0.002835082097822667_wp * zt * LOG( zpcsa ) ** 3 & |
|---|
| 4649 | - 9.24618825471694E-6_wp * zt ** 2 * LOG( zpcsa ) ** 3 & |
|---|
| 4650 | + 5.004267665960894E-9_wp * zt ** 3 * LOG( zpcsa ) ** 3 & |
|---|
| 4651 | - ( 0.01270805101481648_wp * LOG( zpcsa ) ** 3 ) / zx |
|---|
| 4652 | ! |
|---|
| 4653 | !-- Nucleation rate in #/(cm3 s) |
|---|
| 4654 | pnuc_rate = EXP( pnuc_rate ) |
|---|
| 4655 | ! |
|---|
| 4656 | !-- Check the validity of parameterization |
|---|
| 4657 | IF ( pnuc_rate < 1.0E-7_wp ) THEN |
|---|
| 4658 | pnuc_rate = 0.0_wp |
|---|
| 4659 | pd_crit = 1.0E-9_wp |
|---|
| 4660 | ENDIF |
|---|
| 4661 | ! |
|---|
| 4662 | !-- 4) Total number of molecules in the critical cluster (Eq. 13) |
|---|
| 4663 | zntot = - 0.002954125078716302_wp & |
|---|
| 4664 | - 0.0976834264241286_wp * zt & |
|---|
| 4665 | + 0.001024847927067835_wp * zt ** 2 & |
|---|
| 4666 | - 2.186459697726116E-6_wp * zt ** 3 & |
|---|
| 4667 | - 0.1017165718716887_wp / zx & |
|---|
| 4668 | - 0.002050640345231486_wp * LOG( zrh ) & |
|---|
| 4669 | - 0.007585041382707174_wp * zt * LOG( zrh ) & |
|---|
| 4670 | + 0.0001926539658089536_wp * zt ** 2 * LOG( zrh ) & |
|---|
| 4671 | - 6.70429719683894E-7_wp * zt ** 3 * LOG( zrh ) & |
|---|
| 4672 | - ( 0.2557744774673163_wp * LOG( zrh ) ) / zx & |
|---|
| 4673 | + 0.003223076552477191_wp * LOG( zrh ) ** 2 & |
|---|
| 4674 | + 0.000852636632240633_wp * zt * LOG( zrh ) ** 2 & |
|---|
| 4675 | - 0.00001547571354871789_wp * zt ** 2 * LOG( zrh ) ** 2 & |
|---|
| 4676 | + 5.666608424980593E-8_wp * zt ** 3 * LOG( zrh ) ** 2 & |
|---|
| 4677 | + ( 0.03384437400744206_wp * LOG( zrh ) ** 2 ) / zx & |
|---|
| 4678 | + 0.04743226764572505_wp * LOG( zrh ) ** 3 & |
|---|
| 4679 | - 0.0006251042204583412_wp * zt * LOG( zrh ) ** 3 & |
|---|
| 4680 | + 2.650663328519478E-6_wp * zt ** 2 * LOG( zrh ) ** 3 & |
|---|
| 4681 | - 3.674710848763778E-9_wp * zt ** 3 * LOG( zrh ) ** 3 & |
|---|
| 4682 | - ( 0.0002672510825259393_wp * LOG( zrh ) ** 3 ) / zx & |
|---|
| 4683 | - 0.01252108546759328_wp * LOG( zpcsa ) & |
|---|
| 4684 | + 0.005806550506277202_wp * zt * LOG( zpcsa ) & |
|---|
| 4685 | - 0.0001016735312443444_wp * zt ** 2 * LOG( zpcsa ) & |
|---|
| 4686 | + 2.881946187214505E-7_wp * zt ** 3 * LOG( zpcsa ) & |
|---|
| 4687 | + ( 0.0942243379396279_wp * LOG( zpcsa ) ) / zx & |
|---|
| 4688 | - 0.0385459592773097_wp * LOG( zrh ) * LOG( zpcsa ) & |
|---|
| 4689 | - 0.0006723156277391984_wp * zt * LOG( zrh ) * LOG( zpcsa ) & |
|---|
| 4690 | + 2.602884877659698E-6_wp * zt ** 2 * LOG( zrh ) * LOG( zpcsa ) & |
|---|
| 4691 | + 1.194163699688297E-8_wp * zt ** 3 * LOG( zrh ) * LOG( zpcsa ) & |
|---|
| 4692 | - ( 0.00851515345806281_wp * LOG( zrh ) * LOG( zpcsa ) ) / zx & |
|---|
| 4693 | - 0.01837488495738111_wp * LOG( zrh ) ** 2 * LOG( zpcsa ) & |
|---|
| 4694 | + 0.0001720723574407498_wp * zt * LOG( zrh ) ** 2 * LOG( zpcsa ) & |
|---|
| 4695 | - 3.717657974086814E-7_wp * zt**2 * LOG( zrh )**2 * LOG( zpcsa ) & |
|---|
| 4696 | - 5.148746022615196E-10_wp * zt**3 * LOG( zrh )**2 * LOG( zpcsa ) & |
|---|
| 4697 | + ( 0.0002686602132926594_wp * LOG(zrh)**2 * LOG(zpcsa) ) / zx & |
|---|
| 4698 | - 0.06199739728812199_wp * LOG( zpcsa ) ** 2 & |
|---|
| 4699 | + 0.000906958053583576_wp * zt * LOG( zpcsa ) ** 2 & |
|---|
| 4700 | - 9.11727926129757E-7_wp * zt ** 2 * LOG( zpcsa ) ** 2 & |
|---|
| 4701 | - 5.367963396508457E-9_wp * zt ** 3 * LOG( zpcsa ) ** 2 & |
|---|
| 4702 | - ( 0.007742343393937707_wp * LOG( zpcsa ) ** 2 ) / zx & |
|---|
| 4703 | + 0.0121827103101659_wp * LOG( zrh ) * LOG( zpcsa ) ** 2 & |
|---|
| 4704 | - 0.0001066499571188091_wp * zt * LOG( zrh ) * LOG( zpcsa ) ** 2 & |
|---|
| 4705 | + 2.534598655067518E-7_wp * zt**2 * LOG( zrh ) * LOG( zpcsa )**2 & |
|---|
| 4706 | - 3.635186504599571E-10_wp * zt**3 * LOG( zrh ) * LOG( zpcsa )**2 & |
|---|
| 4707 | + ( 0.0006100650851863252_wp * LOG( zrh ) * LOG( zpcsa ) **2 )/ zx & |
|---|
| 4708 | + 0.0003201836700403512_wp * LOG( zpcsa ) ** 3 & |
|---|
| 4709 | - 0.0000174761713262546_wp * zt * LOG( zpcsa ) ** 3 & |
|---|
| 4710 | + 6.065037668052182E-8_wp * zt ** 2 * LOG( zpcsa ) ** 3 & |
|---|
| 4711 | - 1.421771723004557E-11_wp * zt ** 3 * LOG( zpcsa ) ** 3 & |
|---|
| 4712 | + ( 0.0001357509859501723_wp * LOG( zpcsa ) ** 3 ) / zx |
|---|
| 4713 | zntot = EXP( zntot ) ! in # |
|---|
| 4714 | ! |
|---|
| 4715 | !-- 5) Size of the critical cluster pd_crit (m) (diameter) (Eq. 14) |
|---|
| 4716 | pn_crit_sa = zx * zntot |
|---|
| 4717 | pd_crit = 2.0E-9_wp * EXP( -1.6524245_wp + 0.42316402_wp * zx + & |
|---|
| 4718 | 0.33466487_wp * LOG( zntot ) ) |
|---|
| 4719 | ! |
|---|
| 4720 | !-- 6) Organic compounds not involved when binary nucleation is assumed |
|---|
| 4721 | pn_crit_ocnv = 0.0_wp ! number of organic molecules |
|---|
| 4722 | pk_sa = 1.0_wp ! if = 1, H2SO4 involved in nucleation |
|---|
| 4723 | pk_ocnv = 0.0_wp ! if = 1, organic compounds involved |
|---|
| 4724 | ! |
|---|
| 4725 | !-- Set nucleation rate to collision rate |
|---|
| 4726 | IF ( pn_crit_sa < 4.0_wp ) THEN |
|---|
| 4727 | ! |
|---|
| 4728 | !-- Volumes of the colliding objects |
|---|
| 4729 | zma = 96.0_wp ! molar mass of SO4 in g/mol |
|---|
| 4730 | zmw = 18.0_wp ! molar mass of water in g/mol |
|---|
| 4731 | zxmass = 1.0_wp ! mass fraction of H2SO4 |
|---|
| 4732 | za = 0.7681724_wp + zxmass * ( 2.1847140_wp + zxmass * ( & |
|---|
| 4733 | 7.1630022_wp + zxmass * ( -44.31447_wp + zxmass * ( & |
|---|
| 4734 | 88.75606 + zxmass * ( -75.73729_wp + zxmass * & |
|---|
| 4735 | 23.43228_wp ) ) ) ) ) |
|---|
| 4736 | zb = 1.808225E-3_wp + zxmass * ( -9.294656E-3_wp + zxmass * & |
|---|
| 4737 | ( -0.03742148_wp + zxmass * ( 0.2565321_wp + zxmass * & |
|---|
| 4738 | ( -0.5362872_wp + zxmass * ( 0.4857736 - zxmass * & |
|---|
| 4739 | 0.1629592_wp ) ) ) ) ) |
|---|
| 4740 | zc = - 3.478524E-6_wp + zxmass * ( 1.335867E-5_wp + zxmass * & |
|---|
| 4741 | ( 5.195706E-5_wp + zxmass * ( -3.717636E-4_wp + zxmass * & |
|---|
| 4742 | ( 7.990811E-4_wp + zxmass * ( -7.458060E-4_wp + zxmass * & |
|---|
| 4743 | 2.58139E-4_wp ) ) ) ) ) |
|---|
| 4744 | ! |
|---|
| 4745 | !-- Density for the sulphuric acid solution (Eq. 10 in Vehkamaki) |
|---|
| 4746 | zroo = za + zt * ( zb + zc * zt ) ! g/cm^3 |
|---|
| 4747 | zroo = zroo * 1.0E+3_wp ! kg/m^3 |
|---|
| 4748 | zm1 = 0.098_wp ! molar mass of H2SO4 in kg/mol |
|---|
| 4749 | zm2 = zm1 |
|---|
| 4750 | zv1 = zm1 / avo / zroo ! volume |
|---|
| 4751 | zv2 = zv1 |
|---|
| 4752 | ! |
|---|
| 4753 | !-- Collision rate |
|---|
| 4754 | zcoll = zpcsa * zpcsa * ( 3.0_wp * pi / 4.0_wp ) ** ( 1.0_wp / 6.0_wp )& |
|---|
| 4755 | * SQRT( 6.0_wp * argas * zt / zm1 + 6.0_wp * argas * zt / zm2 )& |
|---|
| 4756 | * ( zv1 ** ( 1.0_wp / 3.0_wp ) + zv2 ** ( 1.0_wp /3.0_wp ) ) **& |
|---|
| 4757 | 2.0_wp * 1.0E+6_wp ! m3 -> cm3 |
|---|
| 4758 | |
|---|
| 4759 | zcoll = MIN( zcoll, 1.0E+10_wp ) |
|---|
| 4760 | pnuc_rate = zcoll ! (#/(cm3 s)) |
|---|
| 4761 | |
|---|
| 4762 | ELSE |
|---|
| 4763 | pnuc_rate = MIN( pnuc_rate, 1.0E+10_wp ) |
|---|
| 4764 | ENDIF |
|---|
| 4765 | pnuc_rate = pnuc_rate * 1.0E+6_wp ! (#/(m3 s)) |
|---|
| 4766 | |
|---|
| 4767 | END SUBROUTINE binnucl |
|---|
| 4768 | |
|---|
| 4769 | !------------------------------------------------------------------------------! |
|---|
| 4770 | ! Description: |
|---|
| 4771 | ! ------------ |
|---|
| 4772 | !> Calculate the nucleation rate and the size of critical clusters assuming |
|---|
| 4773 | !> ternary nucleation. Parametrisation according to: |
|---|
| 4774 | !> Napari et al. (2002), J. Chem. Phys., 116, 4221-4227 and |
|---|
| 4775 | !> Napari et al. (2002), J. Geophys. Res., 107(D19), AAC 6-1-ACC 6-6. |
|---|
| 4776 | !> Called from subroutine nucleation. |
|---|
| 4777 | !------------------------------------------------------------------------------! |
|---|
| 4778 | SUBROUTINE ternucl( pc_sa, pc_nh3, ptemp, prh, pnuc_rate, pn_crit_sa, & |
|---|
| 4779 | pn_crit_ocnv, pd_crit, pk_sa, pk_ocnv ) |
|---|
| 4780 | |
|---|
| 4781 | IMPLICIT NONE |
|---|
| 4782 | |
|---|
| 4783 | !-- Input and output variables |
|---|
| 4784 | REAL(wp), INTENT(in) :: pc_nh3 !< ammonia mixing ratio (ppt) |
|---|
| 4785 | REAL(wp), INTENT(in) :: pc_sa !< H2SO4 conc. (#/cm3) |
|---|
| 4786 | REAL(wp), INTENT(in) :: prh !< relative humidity [0-1] |
|---|
| 4787 | REAL(wp), INTENT(in) :: ptemp !< ambient temperature (K) |
|---|
| 4788 | REAL(wp), INTENT(out) :: pd_crit !< diameter of critical |
|---|
| 4789 | !< cluster (m) |
|---|
| 4790 | REAL(wp), INTENT(out) :: pk_ocnv !< Lever: if pk_ocnv = 1,organic compounds |
|---|
| 4791 | !< are involved in nucleation |
|---|
| 4792 | REAL(wp), INTENT(out) :: pk_sa !< Lever: if pk_sa = 1, H2SO4 is involved |
|---|
| 4793 | !< in nucleation |
|---|
| 4794 | REAL(wp), INTENT(out) :: pn_crit_ocnv !< number of organic molecules in |
|---|
| 4795 | !< cluster (#) |
|---|
| 4796 | REAL(wp), INTENT(out) :: pn_crit_sa !< number of H2SO4 molecules in |
|---|
| 4797 | !< cluster (#) |
|---|
| 4798 | REAL(wp), INTENT(out) :: pnuc_rate !< nucleation rate (#/(m3 s)) |
|---|
| 4799 | !-- Local variables |
|---|
| 4800 | REAL(wp) :: zlnj !< logarithm of nucleation rate |
|---|
| 4801 | |
|---|
| 4802 | !-- 1) Checking that we are in the validity range of the parameterization. |
|---|
| 4803 | !-- Validity of parameterization : DO NOT REMOVE! |
|---|
| 4804 | IF ( ptemp < 240.0_wp .OR. ptemp > 300.0_wp ) THEN |
|---|
| 4805 | message_string = 'Invalid input value: ptemp' |
|---|
| 4806 | CALL message( 'salsa_mod: ternucl', 'SA0045', 1, 2, 0, 6, 0 ) |
|---|
| 4807 | ENDIF |
|---|
| 4808 | IF ( prh < 0.05_wp .OR. prh > 0.95_wp ) THEN |
|---|
| 4809 | message_string = 'Invalid input value: prh' |
|---|
| 4810 | CALL message( 'salsa_mod: ternucl', 'SA0046', 1, 2, 0, 6, 0 ) |
|---|
| 4811 | ENDIF |
|---|
| 4812 | IF ( pc_sa < 1.0E+4_wp .OR. pc_sa > 1.0E+9_wp ) THEN |
|---|
| 4813 | message_string = 'Invalid input value: pc_sa' |
|---|
| 4814 | CALL message( 'salsa_mod: ternucl', 'SA0047', 1, 2, 0, 6, 0 ) |
|---|
| 4815 | ENDIF |
|---|
| 4816 | IF ( pc_nh3 < 0.1_wp .OR. pc_nh3 > 100.0_wp ) THEN |
|---|
| 4817 | message_string = 'Invalid input value: pc_nh3' |
|---|
| 4818 | CALL message( 'salsa_mod: ternucl', 'SA0048', 1, 2, 0, 6, 0 ) |
|---|
| 4819 | ENDIF |
|---|
| 4820 | ! |
|---|
| 4821 | !-- 2) Nucleation rate (Eq. 7 in Napari et al., 2002: Parameterization of |
|---|
| 4822 | !-- ternary nucleation of sulfuric acid - ammonia - water. |
|---|
| 4823 | zlnj = - 84.7551114741543_wp & |
|---|
| 4824 | + 0.3117595133628944_wp * prh & |
|---|
| 4825 | + 1.640089605712946_wp * prh * ptemp & |
|---|
| 4826 | - 0.003438516933381083_wp * prh * ptemp ** 2.0_wp & |
|---|
| 4827 | - 0.00001097530402419113_wp * prh * ptemp ** 3.0_wp & |
|---|
| 4828 | - 0.3552967070274677_wp / LOG( pc_sa ) & |
|---|
| 4829 | - ( 0.06651397829765026_wp * prh ) / LOG( pc_sa ) & |
|---|
| 4830 | - ( 33.84493989762471_wp * ptemp ) / LOG( pc_sa ) & |
|---|
| 4831 | - ( 7.823815852128623_wp * prh * ptemp ) / LOG( pc_sa) & |
|---|
| 4832 | + ( 0.3453602302090915_wp * ptemp ** 2.0_wp ) / LOG( pc_sa ) & |
|---|
| 4833 | + ( 0.01229375748100015_wp * prh * ptemp ** 2.0_wp ) / LOG( pc_sa ) & |
|---|
| 4834 | - ( 0.000824007160514956_wp *ptemp ** 3.0_wp ) / LOG( pc_sa ) & |
|---|
| 4835 | + ( 0.00006185539100670249_wp * prh * ptemp ** 3.0_wp ) & |
|---|
| 4836 | / LOG( pc_sa ) & |
|---|
| 4837 | + 3.137345238574998_wp * LOG( pc_sa ) & |
|---|
| 4838 | + 3.680240980277051_wp * prh * LOG( pc_sa ) & |
|---|
| 4839 | - 0.7728606202085936_wp * ptemp * LOG( pc_sa ) & |
|---|
| 4840 | - 0.204098217156962_wp * prh * ptemp * LOG( pc_sa ) & |
|---|
| 4841 | + 0.005612037586790018_wp * ptemp ** 2.0_wp * LOG( pc_sa ) & |
|---|
| 4842 | + 0.001062588391907444_wp * prh * ptemp ** 2.0_wp * LOG( pc_sa ) & |
|---|
| 4843 | - 9.74575691760229E-6_wp * ptemp ** 3.0_wp * LOG( pc_sa ) & |
|---|
| 4844 | - 1.265595265137352E-6_wp * prh * ptemp ** 3.0_wp * LOG( pc_sa ) & |
|---|
| 4845 | + 19.03593713032114_wp * LOG( pc_sa ) ** 2.0_wp & |
|---|
| 4846 | - 0.1709570721236754_wp * ptemp * LOG( pc_sa ) ** 2.0_wp & |
|---|
| 4847 | + 0.000479808018162089_wp * ptemp ** 2.0_wp * LOG( pc_sa ) ** 2.0_wp& |
|---|
| 4848 | - 4.146989369117246E-7_wp * ptemp ** 3.0_wp * LOG( pc_sa ) ** 2.0_wp& |
|---|
| 4849 | + 1.076046750412183_wp * LOG( pc_nh3 ) & |
|---|
| 4850 | + 0.6587399318567337_wp * prh * LOG( pc_nh3 ) & |
|---|
| 4851 | + 1.48932164750748_wp * ptemp * LOG( pc_nh3 ) & |
|---|
| 4852 | + 0.1905424394695381_wp * prh * ptemp * LOG( pc_nh3 ) & |
|---|
| 4853 | - 0.007960522921316015_wp * ptemp ** 2.0_wp * LOG( pc_nh3 ) & |
|---|
| 4854 | - 0.001657184248661241_wp * prh * ptemp ** 2.0_wp * LOG( pc_nh3 ) & |
|---|
| 4855 | + 7.612287245047392E-6_wp * ptemp ** 3.0_wp * LOG( pc_nh3 ) & |
|---|
| 4856 | + 3.417436525881869E-6_wp * prh * ptemp ** 3.0_wp * LOG( pc_nh3 ) & |
|---|
| 4857 | + ( 0.1655358260404061_wp * LOG( pc_nh3 ) ) / LOG( pc_sa) & |
|---|
| 4858 | + ( 0.05301667612522116_wp * prh * LOG( pc_nh3 ) ) / LOG( pc_sa ) & |
|---|
| 4859 | + ( 3.26622914116752_wp * ptemp * LOG( pc_nh3 ) ) / LOG( pc_sa ) & |
|---|
| 4860 | - ( 1.988145079742164_wp * prh * ptemp * LOG( pc_nh3 ) ) & |
|---|
| 4861 | / LOG( pc_sa ) & |
|---|
| 4862 | - ( 0.04897027401984064_wp * ptemp ** 2.0_wp * LOG( pc_nh3) ) & |
|---|
| 4863 | / LOG( pc_sa ) & |
|---|
| 4864 | + ( 0.01578269253599732_wp * prh * ptemp ** 2.0_wp * LOG( pc_nh3 ) & |
|---|
| 4865 | ) / LOG( pc_sa ) & |
|---|
| 4866 | + ( 0.0001469672236351303_wp * ptemp ** 3.0_wp * LOG( pc_nh3 ) ) & |
|---|
| 4867 | / LOG( pc_sa ) & |
|---|
| 4868 | - ( 0.00002935642836387197_wp * prh * ptemp ** 3.0_wp *LOG( pc_nh3 )& |
|---|
| 4869 | ) / LOG( pc_sa ) & |
|---|
| 4870 | + 6.526451177887659_wp * LOG( pc_sa ) * LOG( pc_nh3 ) & |
|---|
| 4871 | - 0.2580021816722099_wp * ptemp * LOG( pc_sa ) * LOG( pc_nh3 ) & |
|---|
| 4872 | + 0.001434563104474292_wp * ptemp ** 2.0_wp * LOG( pc_sa ) & |
|---|
| 4873 | * LOG( pc_nh3 ) & |
|---|
| 4874 | - 2.020361939304473E-6_wp * ptemp ** 3.0_wp * LOG( pc_sa ) & |
|---|
| 4875 | * LOG( pc_nh3 ) & |
|---|
| 4876 | - 0.160335824596627_wp * LOG( pc_sa ) ** 2.0_wp * LOG( pc_nh3 ) & |
|---|
| 4877 | + 0.00889880721460806_wp * ptemp * LOG( pc_sa ) ** 2.0_wp & |
|---|
| 4878 | * LOG( pc_nh3 ) & |
|---|
| 4879 | - 0.00005395139051155007_wp * ptemp ** 2.0_wp & |
|---|
| 4880 | * LOG( pc_sa) ** 2.0_wp * LOG( pc_nh3 ) & |
|---|
| 4881 | + 8.39521718689596E-8_wp * ptemp ** 3.0_wp * LOG( pc_sa ) ** 2.0_wp& |
|---|
| 4882 | * LOG( pc_nh3 ) & |
|---|
| 4883 | + 6.091597586754857_wp * LOG( pc_nh3 ) ** 2.0_wp & |
|---|
| 4884 | + 8.5786763679309_wp * prh * LOG( pc_nh3 ) ** 2.0_wp & |
|---|
| 4885 | - 1.253783854872055_wp * ptemp * LOG( pc_nh3 ) ** 2.0_wp & |
|---|
| 4886 | - 0.1123577232346848_wp * prh * ptemp * LOG( pc_nh3 ) ** 2.0_wp & |
|---|
| 4887 | + 0.00939835595219825_wp * ptemp ** 2.0_wp * LOG( pc_nh3 ) ** 2.0_wp& |
|---|
| 4888 | + 0.0004726256283031513_wp * prh * ptemp ** 2.0_wp & |
|---|
| 4889 | * LOG( pc_nh3) ** 2.0_wp & |
|---|
| 4890 | - 0.00001749269360523252_wp * ptemp ** 3.0_wp & |
|---|
| 4891 | * LOG( pc_nh3 ) ** 2.0_wp & |
|---|
| 4892 | - 6.483647863710339E-7_wp * prh * ptemp ** 3.0_wp & |
|---|
| 4893 | * LOG( pc_nh3 ) ** 2.0_wp & |
|---|
| 4894 | + ( 0.7284285726576598_wp * LOG( pc_nh3 ) ** 2.0_wp ) / LOG( pc_sa )& |
|---|
| 4895 | + ( 3.647355600846383_wp * ptemp * LOG( pc_nh3 ) ** 2.0_wp ) & |
|---|
| 4896 | / LOG( pc_sa ) & |
|---|
| 4897 | - ( 0.02742195276078021_wp * ptemp ** 2.0_wp & |
|---|
| 4898 | * LOG( pc_nh3) ** 2.0_wp ) / LOG( pc_sa ) & |
|---|
| 4899 | + ( 0.00004934777934047135_wp * ptemp ** 3.0_wp & |
|---|
| 4900 | * LOG( pc_nh3 ) ** 2.0_wp ) / LOG( pc_sa ) & |
|---|
| 4901 | + 41.30162491567873_wp * LOG( pc_sa ) * LOG( pc_nh3 ) ** 2.0_wp & |
|---|
| 4902 | - 0.357520416800604_wp * ptemp * LOG( pc_sa ) & |
|---|
| 4903 | * LOG( pc_nh3 ) ** 2.0_wp & |
|---|
| 4904 | + 0.000904383005178356_wp * ptemp ** 2.0_wp * LOG( pc_sa ) & |
|---|
| 4905 | * LOG( pc_nh3 ) ** 2.0_wp & |
|---|
| 4906 | - 5.737876676408978E-7_wp * ptemp ** 3.0_wp * LOG( pc_sa ) & |
|---|
| 4907 | * LOG( pc_nh3 ) ** 2.0_wp & |
|---|
| 4908 | - 2.327363918851818_wp * LOG( pc_sa ) ** 2.0_wp & |
|---|
| 4909 | * LOG( pc_nh3 ) ** 2.0_wp & |
|---|
| 4910 | + 0.02346464261919324_wp * ptemp * LOG( pc_sa ) ** 2.0_wp & |
|---|
| 4911 | * LOG( pc_nh3 ) ** 2.0_wp & |
|---|
| 4912 | - 0.000076518969516405_wp * ptemp ** 2.0_wp & |
|---|
| 4913 | * LOG( pc_sa ) ** 2.0_wp * LOG( pc_nh3 ) ** 2.0_wp & |
|---|
| 4914 | + 8.04589834836395E-8_wp * ptemp ** 3.0_wp * LOG( pc_sa ) ** 2.0_wp & |
|---|
| 4915 | * LOG( pc_nh3 ) ** 2.0_wp & |
|---|
| 4916 | - 0.02007379204248076_wp * LOG( prh ) & |
|---|
| 4917 | - 0.7521152446208771_wp * ptemp * LOG( prh ) & |
|---|
| 4918 | + 0.005258130151226247_wp * ptemp ** 2.0_wp * LOG( prh ) & |
|---|
| 4919 | - 8.98037634284419E-6_wp * ptemp ** 3.0_wp * LOG( prh ) & |
|---|
| 4920 | + ( 0.05993213079516759_wp * LOG( prh ) ) / LOG( pc_sa ) & |
|---|
| 4921 | + ( 5.964746463184173_wp * ptemp * LOG( prh ) ) / LOG( pc_sa ) & |
|---|
| 4922 | - ( 0.03624322255690942_wp * ptemp ** 2.0_wp * LOG( prh ) ) & |
|---|
| 4923 | / LOG( pc_sa ) & |
|---|
| 4924 | + ( 0.00004933369382462509_wp * ptemp ** 3.0_wp * LOG( prh ) ) & |
|---|
| 4925 | / LOG( pc_sa ) & |
|---|
| 4926 | - 0.7327310805365114_wp * LOG( pc_nh3 ) * LOG( prh ) & |
|---|
| 4927 | - 0.01841792282958795_wp * ptemp * LOG( pc_nh3 ) * LOG( prh ) & |
|---|
| 4928 | + 0.0001471855981005184_wp * ptemp ** 2.0_wp * LOG( pc_nh3 ) & |
|---|
| 4929 | * LOG( prh ) & |
|---|
| 4930 | - 2.377113195631848E-7_wp * ptemp ** 3.0_wp * LOG( pc_nh3 ) & |
|---|
| 4931 | * LOG( prh ) |
|---|
| 4932 | pnuc_rate = EXP( zlnj ) ! (#/(cm3 s)) |
|---|
| 4933 | ! |
|---|
| 4934 | !-- Check validity of parametrization |
|---|
| 4935 | IF ( pnuc_rate < 1.0E-5_wp ) THEN |
|---|
| 4936 | pnuc_rate = 0.0_wp |
|---|
| 4937 | pd_crit = 1.0E-9_wp |
|---|
| 4938 | ELSEIF ( pnuc_rate > 1.0E6_wp ) THEN |
|---|
| 4939 | message_string = 'Invalid output value: nucleation rate > 10^6 1/cm3s' |
|---|
| 4940 | CALL message( 'salsa_mod: ternucl', 'SA0049', 1, 2, 0, 6, 0 ) |
|---|
| 4941 | ENDIF |
|---|
| 4942 | pnuc_rate = pnuc_rate * 1.0E6_wp ! (#/(m3 s)) |
|---|
| 4943 | ! |
|---|
| 4944 | !-- 3) Number of H2SO4 molecules in a critical cluster (Eq. 9) |
|---|
| 4945 | pn_crit_sa = 38.16448247950508_wp + 0.7741058259731187_wp * zlnj + & |
|---|
| 4946 | 0.002988789927230632_wp * zlnj ** 2.0_wp - & |
|---|
| 4947 | 0.3576046920535017_wp * ptemp - & |
|---|
| 4948 | 0.003663583011953248_wp * zlnj * ptemp + & |
|---|
| 4949 | 0.000855300153372776_wp * ptemp ** 2.0_wp |
|---|
| 4950 | !-- Kinetic limit: at least 2 H2SO4 molecules in a cluster |
|---|
| 4951 | pn_crit_sa = MAX( pn_crit_sa, 2.0E0_wp ) |
|---|
| 4952 | ! |
|---|
| 4953 | !-- 4) Size of the critical cluster in nm (Eq. 12) |
|---|
| 4954 | pd_crit = 0.1410271086638381_wp - 0.001226253898894878_wp * zlnj - & |
|---|
| 4955 | 7.822111731550752E-6_wp * zlnj ** 2.0_wp - & |
|---|
| 4956 | 0.001567273351921166_wp * ptemp - & |
|---|
| 4957 | 0.00003075996088273962_wp * zlnj * ptemp + & |
|---|
| 4958 | 0.00001083754117202233_wp * ptemp ** 2.0_wp |
|---|
| 4959 | pd_crit = pd_crit * 2.0E-9_wp ! Diameter in m |
|---|
| 4960 | ! |
|---|
| 4961 | !-- 5) Organic compounds not involved when ternary nucleation assumed |
|---|
| 4962 | pn_crit_ocnv = 0.0_wp |
|---|
| 4963 | pk_sa = 1.0_wp |
|---|
| 4964 | pk_ocnv = 0.0_wp |
|---|
| 4965 | |
|---|
| 4966 | END SUBROUTINE ternucl |
|---|
| 4967 | |
|---|
| 4968 | !------------------------------------------------------------------------------! |
|---|
| 4969 | ! Description: |
|---|
| 4970 | ! ------------ |
|---|
| 4971 | !> Calculate the nucleation rate and the size of critical clusters assuming |
|---|
| 4972 | !> kinetic nucleation. Each sulphuric acid molecule forms an (NH4)HSO4 molecule |
|---|
| 4973 | !> in the atmosphere and two colliding (NH4)HSO4 molecules form a stable |
|---|
| 4974 | !> cluster. See Sihto et al. (2006), Atmos. Chem. Phys., 6(12), 4079-4091. |
|---|
| 4975 | !> |
|---|
| 4976 | !> Below the following assumption have been made: |
|---|
| 4977 | !> nucrate = coagcoeff*zpcsa**2 |
|---|
| 4978 | !> coagcoeff = 8*sqrt(3*boltz*ptemp*r_abs/dens_abs) |
|---|
| 4979 | !> r_abs = 0.315d-9 radius of bisulphate molecule [m] |
|---|
| 4980 | !> dens_abs = 1465 density of - " - [kg/m3] |
|---|
| 4981 | !------------------------------------------------------------------------------! |
|---|
| 4982 | SUBROUTINE kinnucl( pc_sa, pnuc_rate, pd_crit, pn_crit_sa, pn_crit_ocnv, & |
|---|
| 4983 | pk_sa, pk_ocnv ) |
|---|
| 4984 | |
|---|
| 4985 | IMPLICIT NONE |
|---|
| 4986 | |
|---|
| 4987 | !-- Input and output variables |
|---|
| 4988 | REAL(wp), INTENT(in) :: pc_sa !< H2SO4 conc. (#/m3) |
|---|
| 4989 | REAL(wp), INTENT(out) :: pd_crit !< critical diameter of clusters (m) |
|---|
| 4990 | REAL(wp), INTENT(out) :: pk_ocnv !< Lever: if pk_ocnv = 1, organic |
|---|
| 4991 | !< compounds are involved in nucleation |
|---|
| 4992 | REAL(wp), INTENT(out) :: pk_sa !< Lever: if pk_sa = 1, H2SO4 is involved |
|---|
| 4993 | !< in nucleation |
|---|
| 4994 | REAL(wp), INTENT(out) :: pn_crit_ocnv !< number of organic molecules in |
|---|
| 4995 | !< cluster (#) |
|---|
| 4996 | REAL(wp), INTENT(out) :: pn_crit_sa !< number of H2SO4 molecules in |
|---|
| 4997 | !< cluster (#) |
|---|
| 4998 | REAL(wp), INTENT(out) :: pnuc_rate !< nucl. rate (#/(m3 s)) |
|---|
| 4999 | |
|---|
| 5000 | !-- Nucleation rate (#/(m3 s)) |
|---|
| 5001 | pnuc_rate = 5.0E-13_wp * pc_sa ** 2.0_wp * 1.0E+6_wp |
|---|
| 5002 | !-- Organic compounds not involved when kinetic nucleation is assumed. |
|---|
| 5003 | pn_crit_sa = 2.0_wp |
|---|
| 5004 | pn_crit_ocnv = 0.0_wp |
|---|
| 5005 | pk_sa = 1.0_wp |
|---|
| 5006 | pk_ocnv = 0.0_wp |
|---|
| 5007 | pd_crit = 7.9375E-10_wp ! (m) |
|---|
| 5008 | |
|---|
| 5009 | END SUBROUTINE kinnucl |
|---|
| 5010 | !------------------------------------------------------------------------------! |
|---|
| 5011 | ! Description: |
|---|
| 5012 | ! ------------ |
|---|
| 5013 | !> Calculate the nucleation rate and the size of critical clusters assuming |
|---|
| 5014 | !> activation type nucleation. |
|---|
| 5015 | !> See Riipinen et al. (2007), Atmos. Chem. Phys., 7(8), 1899-1914. |
|---|
| 5016 | !------------------------------------------------------------------------------! |
|---|
| 5017 | SUBROUTINE actnucl( psa_conc, pnuc_rate, pd_crit, pn_crit_sa, pn_crit_ocnv, & |
|---|
| 5018 | pk_sa, pk_ocnv, activ ) |
|---|
| 5019 | |
|---|
| 5020 | IMPLICIT NONE |
|---|
| 5021 | |
|---|
| 5022 | !-- Input and output variables |
|---|
| 5023 | REAL(wp), INTENT(in) :: psa_conc !< H2SO4 conc. (#/m3) |
|---|
| 5024 | REAL(wp), INTENT(in) :: activ !< |
|---|
| 5025 | REAL(wp), INTENT(out) :: pd_crit !< critical diameter of clusters (m) |
|---|
| 5026 | REAL(wp), INTENT(out) :: pk_ocnv !< Lever: if pk_ocnv = 1, organic |
|---|
| 5027 | !< compounds are involved in nucleation |
|---|
| 5028 | REAL(wp), INTENT(out) :: pk_sa !< Lever: if pk_sa = 1, H2SO4 is involved |
|---|
| 5029 | !< in nucleation |
|---|
| 5030 | REAL(wp), INTENT(out) :: pn_crit_ocnv !< number of organic molecules in |
|---|
| 5031 | !< cluster (#) |
|---|
| 5032 | REAL(wp), INTENT(out) :: pn_crit_sa !< number of H2SO4 molecules in |
|---|
| 5033 | !< cluster (#) |
|---|
| 5034 | REAL(wp), INTENT(out) :: pnuc_rate !< nucl. rate (#/(m3 s)) |
|---|
| 5035 | |
|---|
| 5036 | !-- act_coeff 1e-7 by default |
|---|
| 5037 | pnuc_rate = activ * psa_conc ! (#/(m3 s)) |
|---|
| 5038 | !-- Organic compounds not involved when kinetic nucleation is assumed. |
|---|
| 5039 | pn_crit_sa = 2.0_wp |
|---|
| 5040 | pn_crit_ocnv = 0.0_wp |
|---|
| 5041 | pk_sa = 1.0_wp |
|---|
| 5042 | pk_ocnv = 0.0_wp |
|---|
| 5043 | pd_crit = 7.9375E-10_wp ! (m) |
|---|
| 5044 | END SUBROUTINE actnucl |
|---|
| 5045 | !------------------------------------------------------------------------------! |
|---|
| 5046 | ! Description: |
|---|
| 5047 | ! ------------ |
|---|
| 5048 | !> Conciders only the organic matter in nucleation. Paasonen et al. (2010) |
|---|
| 5049 | !> determined particle formation rates for 2 nm particles, J2, from different |
|---|
| 5050 | !> kind of combinations of sulphuric acid and organic matter concentration. |
|---|
| 5051 | !> See Paasonen et al. (2010), Atmos. Chem. Phys., 10, 11223-11242. |
|---|
| 5052 | !------------------------------------------------------------------------------! |
|---|
| 5053 | SUBROUTINE orgnucl( pc_org, pnuc_rate, pd_crit, pn_crit_sa, pn_crit_ocnv, & |
|---|
| 5054 | pk_sa, pk_ocnv ) |
|---|
| 5055 | |
|---|
| 5056 | IMPLICIT NONE |
|---|
| 5057 | |
|---|
| 5058 | !-- Input and output variables |
|---|
| 5059 | REAL(wp), INTENT(in) :: pc_org !< organic vapour concentration (#/m3) |
|---|
| 5060 | REAL(wp), INTENT(out) :: pd_crit !< critical diameter of clusters (m) |
|---|
| 5061 | REAL(wp), INTENT(out) :: pk_ocnv !< Lever: if pk_ocnv = 1, organic |
|---|
| 5062 | !< compounds are involved in nucleation |
|---|
| 5063 | REAL(wp), INTENT(out) :: pk_sa !< Lever: if pk_sa = 1, H2SO4 is involved |
|---|
| 5064 | !< in nucleation |
|---|
| 5065 | REAL(wp), INTENT(out) :: pn_crit_ocnv !< number of organic molecules in |
|---|
| 5066 | !< cluster (#) |
|---|
| 5067 | REAL(wp), INTENT(out) :: pn_crit_sa !< number of H2SO4 molecules in |
|---|
| 5068 | !< cluster (#) |
|---|
| 5069 | REAL(wp), INTENT(out) :: pnuc_rate !< nucl. rate (#/(m3 s)) |
|---|
| 5070 | !-- Local variables |
|---|
| 5071 | REAL(wp) :: Aorg = 1.3E-7_wp !< (1/s) (Paasonen et al. Table 4: median) |
|---|
| 5072 | |
|---|
| 5073 | !-- Homomolecular nuleation - which one? |
|---|
| 5074 | pnuc_rate = Aorg * pc_org |
|---|
| 5075 | !-- H2SO4 not involved when pure organic nucleation is assumed. |
|---|
| 5076 | pn_crit_sa = 0.0_wp |
|---|
| 5077 | pn_crit_ocnv = 1.0_wp |
|---|
| 5078 | pk_sa = 0.0_wp |
|---|
| 5079 | pk_ocnv = 1.0_wp |
|---|
| 5080 | pd_crit = 1.5E-9_wp ! (m) |
|---|
| 5081 | |
|---|
| 5082 | END SUBROUTINE orgnucl |
|---|
| 5083 | !------------------------------------------------------------------------------! |
|---|
| 5084 | ! Description: |
|---|
| 5085 | ! ------------ |
|---|
| 5086 | !> Conciders both the organic vapor and H2SO4 in nucleation - activation type |
|---|
| 5087 | !> of nucleation. |
|---|
| 5088 | !> See Paasonen et al. (2010), Atmos. Chem. Phys., 10, 11223-11242. |
|---|
| 5089 | !------------------------------------------------------------------------------! |
|---|
| 5090 | SUBROUTINE sumnucl( pc_sa, pc_org, pnuc_rate, pd_crit, pn_crit_sa, & |
|---|
| 5091 | pn_crit_ocnv, pk_sa, pk_ocnv ) |
|---|
| 5092 | |
|---|
| 5093 | IMPLICIT NONE |
|---|
| 5094 | |
|---|
| 5095 | !-- Input and output variables |
|---|
| 5096 | REAL(wp), INTENT(in) :: pc_org !< organic vapour concentration (#/m3) |
|---|
| 5097 | REAL(wp), INTENT(in) :: pc_sa !< H2SO4 conc. (#/m3) |
|---|
| 5098 | REAL(wp), INTENT(out) :: pd_crit !< critical diameter of clusters (m) |
|---|
| 5099 | REAL(wp), INTENT(out) :: pk_ocnv !< Lever: if pk_ocnv = 1, organic |
|---|
| 5100 | !< compounds are involved in nucleation |
|---|
| 5101 | REAL(wp), INTENT(out) :: pk_sa !< Lever: if pk_sa = 1, H2SO4 is involved |
|---|
| 5102 | !< in nucleation |
|---|
| 5103 | REAL(wp), INTENT(out) :: pn_crit_ocnv !< number of organic molecules in |
|---|
| 5104 | !< cluster (#) |
|---|
| 5105 | REAL(wp), INTENT(out) :: pn_crit_sa !< number of H2SO4 molecules in |
|---|
| 5106 | !< cluster (#) |
|---|
| 5107 | REAL(wp), INTENT(out) :: pnuc_rate !< nucl. rate (#/(m3 s)) |
|---|
| 5108 | !-- Local variables |
|---|
| 5109 | REAL(wp) :: As1 = 6.1E-7_wp !< (1/s) |
|---|
| 5110 | REAL(wp) :: As2 = 0.39E-7_wp !< (1/s) (Paasonen et al. Table 3.) |
|---|
| 5111 | |
|---|
| 5112 | !-- Nucleation rate (#/m3/s) |
|---|
| 5113 | pnuc_rate = As1 * pc_sa + As2 * pc_org |
|---|
| 5114 | !-- Both Organic compounds and H2SO4 are involved when SUMnucleation is assumed. |
|---|
| 5115 | pn_crit_sa = 1.0_wp |
|---|
| 5116 | pn_crit_ocnv = 1.0_wp |
|---|
| 5117 | pk_sa = 1.0_wp |
|---|
| 5118 | pk_ocnv = 1.0_wp |
|---|
| 5119 | pd_crit = 1.5E-9_wp ! (m) |
|---|
| 5120 | |
|---|
| 5121 | END SUBROUTINE sumnucl |
|---|
| 5122 | !------------------------------------------------------------------------------! |
|---|
| 5123 | ! Description: |
|---|
| 5124 | ! ------------ |
|---|
| 5125 | !> Conciders both the organic vapor and H2SO4 in nucleation - heteromolecular |
|---|
| 5126 | !> nucleation. |
|---|
| 5127 | !> See Paasonen et al. (2010), Atmos. Chem. Phys., 10, 11223-11242. |
|---|
| 5128 | !------------------------------------------------------------------------------! |
|---|
| 5129 | SUBROUTINE hetnucl( pc_sa, pc_org, pnuc_rate, pd_crit, pn_crit_sa, & |
|---|
| 5130 | pn_crit_ocnv, pk_sa, pk_ocnv ) |
|---|
| 5131 | |
|---|
| 5132 | IMPLICIT NONE |
|---|
| 5133 | |
|---|
| 5134 | !-- Input and output variables |
|---|
| 5135 | REAL(wp), INTENT(in) :: pc_org !< organic vapour concentration (#/m3) |
|---|
| 5136 | REAL(wp), INTENT(in) :: pc_sa !< H2SO4 conc. (#/m3) |
|---|
| 5137 | REAL(wp), INTENT(out) :: pd_crit !< critical diameter of clusters (m) |
|---|
| 5138 | REAL(wp), INTENT(out) :: pk_ocnv !< Lever: if pk_ocnv = 1, organic |
|---|
| 5139 | !< compounds are involved in nucleation |
|---|
| 5140 | REAL(wp), INTENT(out) :: pk_sa !< Lever: if pk_sa = 1, H2SO4 is involved |
|---|
| 5141 | !< in nucleation |
|---|
| 5142 | REAL(wp), INTENT(out) :: pn_crit_ocnv !< number of organic molecules in |
|---|
| 5143 | !< cluster (#) |
|---|
| 5144 | REAL(wp), INTENT(out) :: pn_crit_sa !< number of H2SO4 molecules in |
|---|
| 5145 | !< cluster (#) |
|---|
| 5146 | REAL(wp), INTENT(out) :: pnuc_rate !< nucl. rate (#/(m3 s)) |
|---|
| 5147 | !-- Local variables |
|---|
| 5148 | REAL(wp) :: zKhet = 4.1E-14_wp !< (cm3/s) (Paasonen et al. Table 4: median) |
|---|
| 5149 | |
|---|
| 5150 | !-- Nucleation rate (#/m3/s) |
|---|
| 5151 | pnuc_rate = zKhet * pc_sa * pc_org * 1.0E6_wp |
|---|
| 5152 | !-- Both Organic compounds and H2SO4 are involved when heteromolecular |
|---|
| 5153 | !-- nucleation is assumed. |
|---|
| 5154 | pn_crit_sa = 1.0_wp |
|---|
| 5155 | pn_crit_ocnv = 1.0_wp |
|---|
| 5156 | pk_sa = 1.0_wp |
|---|
| 5157 | pk_ocnv = 1.0_wp |
|---|
| 5158 | pd_crit = 1.5E-9_wp ! (m) |
|---|
| 5159 | |
|---|
| 5160 | END SUBROUTINE hetnucl |
|---|
| 5161 | !------------------------------------------------------------------------------! |
|---|
| 5162 | ! Description: |
|---|
| 5163 | ! ------------ |
|---|
| 5164 | !> Takes into account the homomolecular nucleation of sulphuric acid H2SO4 with |
|---|
| 5165 | !> both of the available vapours. |
|---|
| 5166 | !> See Paasonen et al. (2010), Atmos. Chem. Phys., 10, 11223-11242. |
|---|
| 5167 | !------------------------------------------------------------------------------! |
|---|
| 5168 | SUBROUTINE SAnucl( pc_sa, pc_org, pnuc_rate, pd_crit, pn_crit_sa, & |
|---|
| 5169 | pn_crit_ocnv, pk_sa, pk_ocnv ) |
|---|
| 5170 | |
|---|
| 5171 | IMPLICIT NONE |
|---|
| 5172 | |
|---|
| 5173 | !-- Input and output variables |
|---|
| 5174 | REAL(wp), INTENT(in) :: pc_org !< organic vapour concentration (#/m3) |
|---|
| 5175 | REAL(wp), INTENT(in) :: pc_sa !< H2SO4 conc. (#/m3) |
|---|
| 5176 | REAL(wp), INTENT(out) :: pd_crit !< critical diameter of clusters (m) |
|---|
| 5177 | REAL(wp), INTENT(out) :: pk_ocnv !< Lever: if pk_ocnv = 1, organic |
|---|
| 5178 | !< compounds are involved in nucleation |
|---|
| 5179 | REAL(wp), INTENT(out) :: pk_sa !< Lever: if pk_sa = 1, H2SO4 is involved |
|---|
| 5180 | !< in nucleation |
|---|
| 5181 | REAL(wp), INTENT(out) :: pn_crit_ocnv !< number of organic molecules in |
|---|
| 5182 | !< cluster (#) |
|---|
| 5183 | REAL(wp), INTENT(out) :: pn_crit_sa !< number of H2SO4 molecules in |
|---|
| 5184 | !< cluster (#) |
|---|
| 5185 | REAL(wp), INTENT(out) :: pnuc_rate !< nucleation rate (#/(m3 s)) |
|---|
| 5186 | !-- Local variables |
|---|
| 5187 | REAL(wp) :: zKsa1 = 1.1E-14_wp !< (cm3/s) |
|---|
| 5188 | REAL(wp) :: zKsa2 = 3.2E-14_wp !< (cm3/s) (Paasonen et al. Table 3.) |
|---|
| 5189 | |
|---|
| 5190 | !-- Nucleation rate (#/m3/s) |
|---|
| 5191 | pnuc_rate = ( zKsa1 * pc_sa ** 2.0_wp + zKsa2 * pc_sa * pc_org ) * 1.0E+6_wp |
|---|
| 5192 | !-- Both Organic compounds and H2SO4 are involved when SAnucleation is assumed. |
|---|
| 5193 | pn_crit_sa = 3.0_wp |
|---|
| 5194 | pn_crit_ocnv = 1.0_wp |
|---|
| 5195 | pk_sa = 1.0_wp |
|---|
| 5196 | pk_ocnv = 1.0_wp |
|---|
| 5197 | pd_crit = 1.5E-9_wp ! (m) |
|---|
| 5198 | |
|---|
| 5199 | END SUBROUTINE SAnucl |
|---|
| 5200 | !------------------------------------------------------------------------------! |
|---|
| 5201 | ! Description: |
|---|
| 5202 | ! ------------ |
|---|
| 5203 | !> Takes into account the homomolecular nucleation of both sulphuric acid and |
|---|
| 5204 | !> Lorganic with heteromolecular nucleation. |
|---|
| 5205 | !> See Paasonen et al. (2010), Atmos. Chem. Phys., 10, 11223-11242. |
|---|
| 5206 | !------------------------------------------------------------------------------! |
|---|
| 5207 | SUBROUTINE SAORGnucl( pc_sa, pc_org, pnuc_rate, pd_crit, pn_crit_sa, & |
|---|
| 5208 | pn_crit_ocnv, pk_sa, pk_ocnv ) |
|---|
| 5209 | |
|---|
| 5210 | IMPLICIT NONE |
|---|
| 5211 | |
|---|
| 5212 | !-- Input and output variables |
|---|
| 5213 | REAL(wp), INTENT(in) :: pc_org !< organic vapour concentration (#/m3) |
|---|
| 5214 | REAL(wp), INTENT(in) :: pc_sa !< H2SO4 conc. (#/m3) |
|---|
| 5215 | REAL(wp), INTENT(out) :: pd_crit !< critical diameter of clusters (m) |
|---|
| 5216 | REAL(wp), INTENT(out) :: pk_ocnv !< Lever: if pk_ocnv = 1, organic |
|---|
| 5217 | !< compounds are involved in nucleation |
|---|
| 5218 | REAL(wp), INTENT(out) :: pk_sa !< Lever: if pk_sa = 1, H2SO4 is involved |
|---|
| 5219 | !< in nucleation |
|---|
| 5220 | REAL(wp), INTENT(out) :: pn_crit_ocnv !< number of organic molecules in |
|---|
| 5221 | !< cluster (#) |
|---|
| 5222 | REAL(wp), INTENT(out) :: pn_crit_sa !< number of H2SO4 molecules in |
|---|
| 5223 | !< cluster (#) |
|---|
| 5224 | REAL(wp), INTENT(out) :: pnuc_rate !< nucl. rate (#/(m3 s)) |
|---|
| 5225 | !-- Local variables |
|---|
| 5226 | REAL(wp) :: zKs1 = 1.4E-14_wp !< (cm3/s]) |
|---|
| 5227 | REAL(wp) :: zKs2 = 2.6E-14_wp !< (cm3/s]) |
|---|
| 5228 | REAL(wp) :: zKs3 = 0.037E-14_wp !< (cm3/s]) (Paasonen et al. Table 3.) |
|---|
| 5229 | |
|---|
| 5230 | !-- Nucleation rate (#/m3/s) |
|---|
| 5231 | pnuc_rate = ( zKs1 * pc_sa **2 + zKs2 * pc_sa * pc_org + zKs3 * & |
|---|
| 5232 | pc_org ** 2.0_wp ) * 1.0E+6_wp |
|---|
| 5233 | !-- Organic compounds not involved when kinetic nucleation is assumed. |
|---|
| 5234 | pn_crit_sa = 3.0_wp |
|---|
| 5235 | pn_crit_ocnv = 3.0_wp |
|---|
| 5236 | pk_sa = 1.0_wp |
|---|
| 5237 | pk_ocnv = 1.0_wp |
|---|
| 5238 | pd_crit = 1.5E-9_wp ! (m) |
|---|
| 5239 | |
|---|
| 5240 | END SUBROUTINE SAORGnucl |
|---|
| 5241 | |
|---|
| 5242 | !------------------------------------------------------------------------------! |
|---|
| 5243 | ! Description: |
|---|
| 5244 | ! ------------ |
|---|
| 5245 | !> Function zNnuc_tayl is connected to the calculation of self-coagualtion of |
|---|
| 5246 | !> small particles. It calculates number of the particles in the size range |
|---|
| 5247 | !> [zdcrit,dx] using Taylor-expansion (please note that the expansion is not |
|---|
| 5248 | !> valid for certain rational numbers, e.g. -4/3 and -3/2) |
|---|
| 5249 | !------------------------------------------------------------------------------! |
|---|
| 5250 | FUNCTION zNnuc_tayl( d1, dx, zm_para, zjnuc_t, zeta, zGRtot ) |
|---|
| 5251 | IMPLICIT NONE |
|---|
| 5252 | |
|---|
| 5253 | INTEGER(iwp) :: i |
|---|
| 5254 | REAL(wp) :: d1 |
|---|
| 5255 | REAL(wp) :: dx |
|---|
| 5256 | REAL(wp) :: zjnuc_t |
|---|
| 5257 | REAL(wp) :: zeta |
|---|
| 5258 | REAL(wp) :: term1 |
|---|
| 5259 | REAL(wp) :: term2 |
|---|
| 5260 | REAL(wp) :: term3 |
|---|
| 5261 | REAL(wp) :: term4 |
|---|
| 5262 | REAL(wp) :: term5 |
|---|
| 5263 | REAL(wp) :: zNnuc_tayl |
|---|
| 5264 | REAL(wp) :: zGRtot |
|---|
| 5265 | REAL(wp) :: zm_para |
|---|
| 5266 | |
|---|
| 5267 | zNnuc_tayl = 0.0_wp |
|---|
| 5268 | |
|---|
| 5269 | DO i = 0, 29 |
|---|
| 5270 | IF ( i == 0 .OR. i == 1 ) THEN |
|---|
| 5271 | term1 = 1.0_wp |
|---|
| 5272 | ELSE |
|---|
| 5273 | term1 = term1 * REAL( i, SELECTED_REAL_KIND(12,307) ) |
|---|
| 5274 | END IF |
|---|
| 5275 | term2 = ( REAL( i, SELECTED_REAL_KIND(12,307) ) * ( zm_para + 1.0_wp & |
|---|
| 5276 | ) + 1.0_wp ) * term1 |
|---|
| 5277 | term3 = zeta ** i |
|---|
| 5278 | term4 = term3 / term2 |
|---|
| 5279 | term5 = REAL( i, SELECTED_REAL_KIND(12,307) ) * ( zm_para + 1.0_wp ) & |
|---|
| 5280 | + 1.0_wp |
|---|
| 5281 | zNnuc_tayl = zNnuc_tayl + term4 * ( dx ** term5 - d1 ** term5 ) |
|---|
| 5282 | ENDDO |
|---|
| 5283 | zNnuc_tayl = zNnuc_tayl * zjnuc_t * EXP( -zeta * & |
|---|
| 5284 | ( d1 ** ( zm_para + 1 ) ) ) / zGRtot |
|---|
| 5285 | |
|---|
| 5286 | END FUNCTION zNnuc_tayl |
|---|
| 5287 | |
|---|
| 5288 | !------------------------------------------------------------------------------! |
|---|
| 5289 | ! Description: |
|---|
| 5290 | ! ------------ |
|---|
| 5291 | !> Calculates the condensation of water vapour on aerosol particles. Follows the |
|---|
| 5292 | !> analytical predictor method by Jacobson (2005). |
|---|
| 5293 | !> For equations, see Jacobson (2005), Fundamentals of atmospheric modelling |
|---|
| 5294 | !> (2nd edition). |
|---|
| 5295 | !------------------------------------------------------------------------------! |
|---|
| 5296 | SUBROUTINE gpparth2o( paero, ptemp, ppres, pcs, pcw, ptstep ) |
|---|
| 5297 | |
|---|
| 5298 | IMPLICIT NONE |
|---|
| 5299 | ! |
|---|
| 5300 | !-- Input and output variables |
|---|
| 5301 | REAL(wp), INTENT(in) :: ppres !< Air pressure (Pa) |
|---|
| 5302 | REAL(wp), INTENT(in) :: pcs !< Water vapour saturation |
|---|
| 5303 | !< concentration (kg/m3) |
|---|
| 5304 | REAL(wp), INTENT(in) :: ptemp !< Ambient temperature (K) |
|---|
| 5305 | REAL(wp), INTENT(in) :: ptstep !< timestep (s) |
|---|
| 5306 | REAL(wp), INTENT(inout) :: pcw !< Water vapour concentration |
|---|
| 5307 | !< (kg/m3) |
|---|
| 5308 | TYPE(t_section), INTENT(inout) :: paero(nbins) !< Aerosol properties |
|---|
| 5309 | !-- Local variables |
|---|
| 5310 | INTEGER(iwp) :: b !< loop index |
|---|
| 5311 | INTEGER(iwp) :: nstr |
|---|
| 5312 | REAL(wp) :: adt !< internal timestep in this subroutine |
|---|
| 5313 | REAL(wp) :: adtc(nbins) |
|---|
| 5314 | REAL(wp) :: rhoair |
|---|
| 5315 | REAL(wp) :: ttot |
|---|
| 5316 | REAL(wp) :: zact !< Water activity |
|---|
| 5317 | REAL(wp) :: zaelwc1 !< Current aerosol water content |
|---|
| 5318 | REAL(wp) :: zaelwc2 !< New aerosol water content after |
|---|
| 5319 | !< equilibrium calculation |
|---|
| 5320 | REAL(wp) :: zbeta !< Transitional correction factor |
|---|
| 5321 | REAL(wp) :: zcwc !< Current water vapour mole concentration |
|---|
| 5322 | REAL(wp) :: zcwcae(nbins) !< Current water mole concentrations |
|---|
| 5323 | !< in aerosols |
|---|
| 5324 | REAL(wp) :: zcwint !< Current and new water vapour mole concentrations |
|---|
| 5325 | REAL(wp) :: zcwintae(nbins) !< Current and new water mole concentrations |
|---|
| 5326 | !< in aerosols |
|---|
| 5327 | REAL(wp) :: zcwn !< New water vapour mole concentration |
|---|
| 5328 | REAL(wp) :: zcwnae(nbins) !< New water mole concentration in aerosols |
|---|
| 5329 | REAL(wp) :: zcwsurfae(nbins) !< Surface mole concentration |
|---|
| 5330 | REAL(wp) :: zcwtot !< Total water mole concentration |
|---|
| 5331 | REAL(wp) :: zdfh2o |
|---|
| 5332 | REAL(wp) :: zhlp1 |
|---|
| 5333 | REAL(wp) :: zhlp2 |
|---|
| 5334 | REAL(wp) :: zhlp3 |
|---|
| 5335 | REAL(wp) :: zka(nbins) !< Activity coefficient |
|---|
| 5336 | REAL(wp) :: zkelvin(nbins) !< Kelvin effect |
|---|
| 5337 | REAL(wp) :: zknud |
|---|
| 5338 | REAL(wp) :: zmfph2o !< mean free path of H2O gas molecule |
|---|
| 5339 | REAL(wp) :: zmtae(nbins) !< Mass transfer coefficients |
|---|
| 5340 | REAL(wp) :: zrh !< Relative humidity [0-1] |
|---|
| 5341 | REAL(wp) :: zthcond |
|---|
| 5342 | REAL(wp) :: zwsatae(nbins) !< Water saturation ratio above aerosols |
|---|
| 5343 | ! |
|---|
| 5344 | !-- Relative humidity [0-1] |
|---|
| 5345 | zrh = pcw / pcs |
|---|
| 5346 | !-- Calculate the condensation only for 2a/2b aerosol bins |
|---|
| 5347 | nstr = in2a |
|---|
| 5348 | !-- Save the current aerosol water content, 8 in paero is H2O |
|---|
| 5349 | zaelwc1 = SUM( paero(in1a:fn2b)%volc(8) ) * arhoh2o |
|---|
| 5350 | ! |
|---|
| 5351 | !-- Equilibration: |
|---|
| 5352 | IF ( advect_particle_water ) THEN |
|---|
| 5353 | IF ( zrh < 0.98_wp .OR. .NOT. lscndh2oae ) THEN |
|---|
| 5354 | CALL equilibration( zrh, ptemp, paero, .TRUE. ) |
|---|
| 5355 | ELSE |
|---|
| 5356 | CALL equilibration( zrh, ptemp, paero, .FALSE. ) |
|---|
| 5357 | ENDIF |
|---|
| 5358 | ENDIF |
|---|
| 5359 | ! |
|---|
| 5360 | !-- The new aerosol water content after equilibrium calculation |
|---|
| 5361 | zaelwc2 = SUM( paero(in1a:fn2b)%volc(8) ) * arhoh2o |
|---|
| 5362 | !-- New water vapour mixing ratio (kg/m3) |
|---|
| 5363 | pcw = pcw - ( zaelwc2 - zaelwc1 ) * ppres * amdair / ( argas * ptemp ) |
|---|
| 5364 | ! |
|---|
| 5365 | !-- Initialise variables |
|---|
| 5366 | adtc(:) = 0.0_wp |
|---|
| 5367 | zcwc = 0.0_wp |
|---|
| 5368 | zcwcae = 0.0_wp |
|---|
| 5369 | zcwint = 0.0_wp |
|---|
| 5370 | zcwintae = 0.0_wp |
|---|
| 5371 | zcwn = 0.0_wp |
|---|
| 5372 | zcwnae = 0.0_wp |
|---|
| 5373 | zhlp1 = 0.0_wp |
|---|
| 5374 | zwsatae = 0.0_wp |
|---|
| 5375 | ! |
|---|
| 5376 | !-- Air: |
|---|
| 5377 | !-- Density (kg/m3) |
|---|
| 5378 | rhoair = amdair * ppres / ( argas * ptemp ) |
|---|
| 5379 | !-- Thermal conductivity of air |
|---|
| 5380 | zthcond = 0.023807_wp + 7.1128E-5_wp * ( ptemp - 273.16_wp ) |
|---|
| 5381 | ! |
|---|
| 5382 | !-- Water vapour: |
|---|
| 5383 | ! |
|---|
| 5384 | !-- Molecular diffusion coefficient (cm2/s) (eq.16.17) |
|---|
| 5385 | zdfh2o = ( 5.0_wp / ( 16.0_wp * avo * rhoair * 1.0E-3_wp * & |
|---|
| 5386 | ( 3.11E-8_wp ) ** 2.0_wp ) ) * SQRT( argas * 1.0E+7_wp * ptemp * & |
|---|
| 5387 | amdair * 1.0E+3_wp * ( amh2o + amdair ) * 1.0E+3_wp / ( 2.0_wp * & |
|---|
| 5388 | pi * amh2o * 1.0E+3_wp ) ) |
|---|
| 5389 | zdfh2o = zdfh2o * 1.0E-4 ! Unit change to m^2/s |
|---|
| 5390 | ! |
|---|
| 5391 | !-- Mean free path (eq. 15.25 & 16.29) |
|---|
| 5392 | zmfph2o = 3.0_wp * zdfh2o * SQRT( pi * amh2o / ( 8.0_wp * argas * ptemp ) ) |
|---|
| 5393 | zka = 1.0_wp ! Assume activity coefficients as 1 for now. |
|---|
| 5394 | ! |
|---|
| 5395 | !-- Kelvin effect (eq. 16.33) |
|---|
| 5396 | zkelvin = 1.0_wp |
|---|
| 5397 | zkelvin(1:nbins) = EXP( 4.0_wp * surfw0 * amh2o / ( argas * ptemp * & |
|---|
| 5398 | arhoh2o * paero(1:nbins)%dwet) ) |
|---|
| 5399 | ! |
|---|
| 5400 | ! --Aerosols: |
|---|
| 5401 | zmtae(:) = 0.0_wp ! mass transfer coefficient |
|---|
| 5402 | zcwsurfae(:) = 0.0_wp ! surface mole concentrations |
|---|
| 5403 | DO b = 1, nbins |
|---|
| 5404 | IF ( paero(b)%numc > nclim .AND. zrh > 0.98_wp ) THEN |
|---|
| 5405 | ! |
|---|
| 5406 | !-- Water activity |
|---|
| 5407 | zact = acth2o( paero(b) ) |
|---|
| 5408 | ! |
|---|
| 5409 | !-- Saturation mole concentration over flat surface. Limit the super- |
|---|
| 5410 | !-- saturation to max 1.01 for the mass transfer. Experimental! |
|---|
| 5411 | zcwsurfae(b) = MAX( pcs, pcw / 1.01_wp ) * rhoair / amh2o |
|---|
| 5412 | ! |
|---|
| 5413 | !-- Equilibrium saturation ratio |
|---|
| 5414 | zwsatae(b) = zact * zkelvin(b) |
|---|
| 5415 | ! |
|---|
| 5416 | !-- Knudsen number (eq. 16.20) |
|---|
| 5417 | zknud = 2.0_wp * zmfph2o / paero(b)%dwet |
|---|
| 5418 | ! |
|---|
| 5419 | !-- Transitional correction factor (Fuks & Sutugin, 1971) |
|---|
| 5420 | zbeta = ( zknud + 1.0_wp ) / ( 0.377_wp * zknud + 1.0_wp + 4.0_wp / & |
|---|
| 5421 | ( 3.0_wp * massacc(b) ) * ( zknud + zknud ** 2.0_wp ) ) |
|---|
| 5422 | ! |
|---|
| 5423 | !-- Mass transfer of H2O: Eq. 16.64 but here D^eff = zdfh2o * zbeta |
|---|
| 5424 | zhlp1 = paero(b)%numc * 2.0_wp * pi * paero(b)%dwet * zdfh2o * & |
|---|
| 5425 | zbeta |
|---|
| 5426 | !-- 1st term on the left side of the denominator in eq. 16.55 |
|---|
| 5427 | zhlp2 = amh2o * zdfh2o * alv * zwsatae(b) * zcwsurfae(b) / & |
|---|
| 5428 | ( zthcond * ptemp ) |
|---|
| 5429 | !-- 2nd term on the left side of the denominator in eq. 16.55 |
|---|
| 5430 | zhlp3 = ( (alv * amh2o ) / ( argas * ptemp ) ) - 1.0_wp |
|---|
| 5431 | !-- Full eq. 16.64: Mass transfer coefficient (1/s) |
|---|
| 5432 | zmtae(b) = zhlp1 / ( zhlp2 * zhlp3 + 1.0_wp ) |
|---|
| 5433 | ENDIF |
|---|
| 5434 | ENDDO |
|---|
| 5435 | ! |
|---|
| 5436 | !-- Current mole concentrations of water |
|---|
| 5437 | zcwc = pcw * rhoair / amh2o ! as vapour |
|---|
| 5438 | zcwcae(1:nbins) = paero(1:nbins)%volc(8) * arhoh2o / amh2o ! in aerosols |
|---|
| 5439 | zcwtot = zcwc + SUM( zcwcae ) ! total water concentration |
|---|
| 5440 | ttot = 0.0_wp |
|---|
| 5441 | adtc = 0.0_wp |
|---|
| 5442 | zcwintae = zcwcae |
|---|
| 5443 | ! |
|---|
| 5444 | !-- Substepping loop |
|---|
| 5445 | zcwint = 0.0_wp |
|---|
| 5446 | DO WHILE ( ttot < ptstep ) |
|---|
| 5447 | adt = 2.0E-2_wp ! internal timestep |
|---|
| 5448 | ! |
|---|
| 5449 | !-- New vapour concentration: (eq. 16.71) |
|---|
| 5450 | zhlp1 = zcwc + adt * ( SUM( zmtae(nstr:nbins) * zwsatae(nstr:nbins) * & |
|---|
| 5451 | zcwsurfae(nstr:nbins) ) ) ! numerator |
|---|
| 5452 | zhlp2 = 1.0_wp + adt * ( SUM( zmtae(nstr:nbins) ) ) ! denomin. |
|---|
| 5453 | zcwint = zhlp1 / zhlp2 ! new vapour concentration |
|---|
| 5454 | zcwint = MIN( zcwint, zcwtot ) |
|---|
| 5455 | IF ( ANY( paero(:)%numc > nclim ) .AND. zrh > 0.98_wp ) THEN |
|---|
| 5456 | DO b = nstr, nbins |
|---|
| 5457 | zcwintae(b) = zcwcae(b) + MIN( MAX( adt * zmtae(b) * & |
|---|
| 5458 | ( zcwint - zwsatae(b) * zcwsurfae(b) ), & |
|---|
| 5459 | -0.02_wp * zcwcae(b) ), 0.05_wp * zcwcae(b) ) |
|---|
| 5460 | zwsatae(b) = acth2o( paero(b), zcwintae(b) ) * zkelvin(b) |
|---|
| 5461 | ENDDO |
|---|
| 5462 | ENDIF |
|---|
| 5463 | zcwintae(nstr:nbins) = MAX( zcwintae(nstr:nbins), 0.0_wp ) |
|---|
| 5464 | ! |
|---|
| 5465 | !-- Update vapour concentration for consistency |
|---|
| 5466 | zcwint = zcwtot - SUM( zcwintae(1:nbins) ) |
|---|
| 5467 | !-- Update "old" values for next cycle |
|---|
| 5468 | zcwcae = zcwintae |
|---|
| 5469 | |
|---|
| 5470 | ttot = ttot + adt |
|---|
| 5471 | ENDDO ! ADT |
|---|
| 5472 | zcwn = zcwint |
|---|
| 5473 | zcwnae = zcwintae |
|---|
| 5474 | pcw = zcwn * amh2o / rhoair |
|---|
| 5475 | paero(1:nbins)%volc(8) = MAX( 0.0_wp, zcwnae(1:nbins) * amh2o / arhoh2o ) |
|---|
| 5476 | |
|---|
| 5477 | END SUBROUTINE gpparth2o |
|---|
| 5478 | |
|---|
| 5479 | !------------------------------------------------------------------------------! |
|---|
| 5480 | ! Description: |
|---|
| 5481 | ! ------------ |
|---|
| 5482 | !> Calculates the activity coefficient of liquid water |
|---|
| 5483 | !------------------------------------------------------------------------------! |
|---|
| 5484 | REAL(wp) FUNCTION acth2o( ppart, pcw ) |
|---|
| 5485 | |
|---|
| 5486 | IMPLICIT NONE |
|---|
| 5487 | |
|---|
| 5488 | TYPE(t_section), INTENT(in) :: ppart !< Aerosol properties of a bin |
|---|
| 5489 | REAL(wp), INTENT(in), OPTIONAL :: pcw !< molar concentration of water |
|---|
| 5490 | !< (mol/m3) |
|---|
| 5491 | |
|---|
| 5492 | REAL(wp) :: zns !< molar concentration of solutes (mol/m3) |
|---|
| 5493 | REAL(wp) :: znw !< molar concentration of water (mol/m3) |
|---|
| 5494 | |
|---|
| 5495 | zns = ( 3.0_wp * ( ppart%volc(1) * arhoh2so4 / amh2so4 ) + & |
|---|
| 5496 | ( ppart%volc(2) * arhooc / amoc ) + & |
|---|
| 5497 | 2.0_wp * ( ppart%volc(5) * arhoss / amss ) + & |
|---|
| 5498 | ( ppart%volc(6) * arhohno3 / amhno3 ) + & |
|---|
| 5499 | ( ppart%volc(7) * arhonh3 / amnh3 ) ) |
|---|
| 5500 | IF ( PRESENT(pcw) ) THEN |
|---|
| 5501 | znw = pcw |
|---|
| 5502 | ELSE |
|---|
| 5503 | znw = ppart%volc(8) * arhoh2o / amh2o |
|---|
| 5504 | ENDIF |
|---|
| 5505 | !-- Activity = partial pressure of water vapour / |
|---|
| 5506 | !-- sat. vapour pressure of water over a bulk liquid surface |
|---|
| 5507 | !-- = molality * activity coefficient (Jacobson, 2005: eq. 17.20-21) |
|---|
| 5508 | !-- Assume activity coefficient of 1 for water |
|---|
| 5509 | acth2o = MAX( 0.1_wp, znw / MAX( EPSILON( 1.0_wp ),( znw + zns ) ) ) |
|---|
| 5510 | END FUNCTION acth2o |
|---|
| 5511 | |
|---|
| 5512 | !------------------------------------------------------------------------------! |
|---|
| 5513 | ! Description: |
|---|
| 5514 | ! ------------ |
|---|
| 5515 | !> Calculates the dissolutional growth of particles (i.e. gas transfers to a |
|---|
| 5516 | !> particle surface and dissolves in liquid water on the surface). Treated here |
|---|
| 5517 | !> as a non-equilibrium (time-dependent) process. Gases: HNO3 and NH3 |
|---|
| 5518 | !> (Chapter 17.14 in Jacobson, 2005). |
|---|
| 5519 | ! |
|---|
| 5520 | !> Called from subroutine condensation. |
|---|
| 5521 | !> Coded by: |
|---|
| 5522 | !> Harri Kokkola (FMI) |
|---|
| 5523 | !------------------------------------------------------------------------------! |
|---|
| 5524 | SUBROUTINE gpparthno3( ppres, ptemp, paero, pghno3, pgnh3, pcw, pcs, pbeta, & |
|---|
| 5525 | ptstep ) |
|---|
| 5526 | |
|---|
| 5527 | IMPLICIT NONE |
|---|
| 5528 | ! |
|---|
| 5529 | !-- Input and output variables |
|---|
| 5530 | REAL(wp), INTENT(in) :: pbeta(nbins) !< transitional correction factor for |
|---|
| 5531 | !< aerosols |
|---|
| 5532 | REAL(wp), INTENT(in) :: ppres !< ambient pressure (Pa) |
|---|
| 5533 | REAL(wp), INTENT(in) :: pcs !< water vapour saturation |
|---|
| 5534 | !< concentration (kg/m3) |
|---|
| 5535 | REAL(wp), INTENT(in) :: ptemp !< ambient temperature (K) |
|---|
| 5536 | REAL(wp), INTENT(in) :: ptstep !< time step (s) |
|---|
| 5537 | REAL(wp), INTENT(inout) :: pghno3 !< nitric acid concentration (#/m3) |
|---|
| 5538 | REAL(wp), INTENT(inout) :: pgnh3 !< ammonia conc. (#/m3) |
|---|
| 5539 | REAL(wp), INTENT(inout) :: pcw !< water vapour concentration (kg/m3) |
|---|
| 5540 | TYPE(t_section), INTENT(inout) :: paero(nbins) !< Aerosol properties |
|---|
| 5541 | ! |
|---|
| 5542 | !-- Local variables |
|---|
| 5543 | INTEGER(iwp) :: b !< loop index |
|---|
| 5544 | REAL(wp) :: adt !< timestep |
|---|
| 5545 | REAL(wp) :: zachhso4ae(nbins) !< Activity coefficients for HHSO4 |
|---|
| 5546 | REAL(wp) :: zacnh3ae(nbins) !< Activity coefficients for NH3 |
|---|
| 5547 | REAL(wp) :: zacnh4hso2ae(nbins)!< Activity coefficients for NH4HSO2 |
|---|
| 5548 | REAL(wp) :: zacno3ae(nbins) !< Activity coefficients for HNO3 |
|---|
| 5549 | REAL(wp) :: zcgnh3eqae(nbins) !< Equilibrium gas concentration: NH3 |
|---|
| 5550 | REAL(wp) :: zcgno3eqae(nbins) !< Equilibrium gas concentration: HNO3 |
|---|
| 5551 | REAL(wp) :: zcgwaeqae(nbins) !< Equilibrium gas concentration: H2O |
|---|
| 5552 | REAL(wp) :: zcnh3c !< Current NH3 gas concentration |
|---|
| 5553 | REAL(wp) :: zcnh3int !< Intermediate NH3 gas concentration |
|---|
| 5554 | REAL(wp) :: zcnh3intae(nbins) !< Intermediate NH3 aerosol concentration |
|---|
| 5555 | REAL(wp) :: zcnh3n !< New NH3 gas concentration |
|---|
| 5556 | REAL(wp) :: zcnh3cae(nbins) !< Current NH3 in aerosols |
|---|
| 5557 | REAL(wp) :: zcnh3nae(nbins) !< New NH3 in aerosols |
|---|
| 5558 | REAL(wp) :: zcnh3tot !< Total NH3 concentration |
|---|
| 5559 | REAL(wp) :: zcno3c !< Current HNO3 gas concentration |
|---|
| 5560 | REAL(wp) :: zcno3int !< Intermediate HNO3 gas concentration |
|---|
| 5561 | REAL(wp) :: zcno3intae(nbins) !< Intermediate HNO3 aerosol concentration |
|---|
| 5562 | REAL(wp) :: zcno3n !< New HNO3 gas concentration |
|---|
| 5563 | REAL(wp) :: zcno3cae(nbins) !< Current HNO3 in aerosols |
|---|
| 5564 | REAL(wp) :: zcno3nae(nbins) !< New HNO3 in aerosols |
|---|
| 5565 | REAL(wp) :: zcno3tot !< Total HNO3 concentration |
|---|
| 5566 | REAL(wp) :: zdfvap !< Diffusion coefficient for vapors |
|---|
| 5567 | REAL(wp) :: zhlp1 !< helping variable |
|---|
| 5568 | REAL(wp) :: zhlp2 !< helping variable |
|---|
| 5569 | REAL(wp) :: zkelnh3ae(nbins) !< Kelvin effects for NH3 |
|---|
| 5570 | REAL(wp) :: zkelno3ae(nbins) !< Kelvin effect for HNO3 |
|---|
| 5571 | REAL(wp) :: zmolsae(nbins,7) !< Ion molalities from pdfite |
|---|
| 5572 | REAL(wp) :: zmtnh3ae(nbins) !< Mass transfer coefficients for NH3 |
|---|
| 5573 | REAL(wp) :: zmtno3ae(nbins) !< Mass transfer coefficients for HNO3 |
|---|
| 5574 | REAL(wp) :: zrh !< relative humidity |
|---|
| 5575 | REAL(wp) :: zsathno3ae(nbins) !< HNO3 saturation ratio |
|---|
| 5576 | REAL(wp) :: zsatnh3ae(nbins) !< NH3 saturation ratio = the partial |
|---|
| 5577 | !< pressure of a gas divided by its |
|---|
| 5578 | !< saturation vapor pressure over a surface |
|---|
| 5579 | ! |
|---|
| 5580 | !-- Initialise: |
|---|
| 5581 | adt = ptstep |
|---|
| 5582 | zachhso4ae = 0.0_wp |
|---|
| 5583 | zacnh3ae = 0.0_wp |
|---|
| 5584 | zacnh4hso2ae = 0.0_wp |
|---|
| 5585 | zacno3ae = 0.0_wp |
|---|
| 5586 | zcgnh3eqae = 0.0_wp |
|---|
| 5587 | zcgno3eqae = 0.0_wp |
|---|
| 5588 | zcnh3c = 0.0_wp |
|---|
| 5589 | zcnh3cae = 0.0_wp |
|---|
| 5590 | zcnh3int = 0.0_wp |
|---|
| 5591 | zcnh3intae = 0.0_wp |
|---|
| 5592 | zcnh3n = 0.0_wp |
|---|
| 5593 | zcnh3nae = 0.0_wp |
|---|
| 5594 | zcnh3tot = 0.0_wp |
|---|
| 5595 | zcno3c = 0.0_wp |
|---|
| 5596 | zcno3cae = 0.0_wp |
|---|
| 5597 | zcno3int = 0.0_wp |
|---|
| 5598 | zcno3intae = 0.0_wp |
|---|
| 5599 | zcno3n = 0.0_wp |
|---|
| 5600 | zcno3nae = 0.0_wp |
|---|
| 5601 | zcno3tot = 0.0_wp |
|---|
| 5602 | zhlp1 = 0.0_wp |
|---|
| 5603 | zhlp2 = 0.0_wp |
|---|
| 5604 | zkelno3ae = 1.0_wp |
|---|
| 5605 | zkelnh3ae = 1.0_wp |
|---|
| 5606 | zmolsae = 0.0_wp |
|---|
| 5607 | zmtno3ae = 0.0_wp |
|---|
| 5608 | zmtnh3ae = 0.0_wp |
|---|
| 5609 | zrh = 0.0_wp |
|---|
| 5610 | zsatnh3ae = 1.0_wp |
|---|
| 5611 | zsathno3ae = 1.0_wp |
|---|
| 5612 | ! |
|---|
| 5613 | !-- Diffusion coefficient (m2/s) |
|---|
| 5614 | zdfvap = 5.1111E-10_wp * ptemp ** 1.75_wp * ( p_0 + 1325.0_wp ) / ppres |
|---|
| 5615 | ! |
|---|
| 5616 | !-- Kelvin effects (Jacobson (2005), eq. 16.33) |
|---|
| 5617 | zkelno3ae(1:nbins) = EXP( 4.0_wp * surfw0 * amvhno3 / ( abo * ptemp * & |
|---|
| 5618 | paero(1:nbins)%dwet ) ) |
|---|
| 5619 | zkelnh3ae(1:nbins) = EXP( 4.0_wp * surfw0 * amvnh3 / ( abo * ptemp * & |
|---|
| 5620 | paero(1:nbins)%dwet ) ) |
|---|
| 5621 | ! |
|---|
| 5622 | !-- Current vapour mole concentrations (mol/m3) |
|---|
| 5623 | zcno3c = pghno3 / avo ! HNO3 |
|---|
| 5624 | zcnh3c = pgnh3 / avo ! NH3 |
|---|
| 5625 | ! |
|---|
| 5626 | !-- Current particle mole concentrations (mol/m3) |
|---|
| 5627 | zcno3cae(1:nbins) = paero(1:nbins)%volc(6) * arhohno3 / amhno3 |
|---|
| 5628 | zcnh3cae(1:nbins) = paero(1:nbins)%volc(7) * arhonh3 / amnh3 |
|---|
| 5629 | ! |
|---|
| 5630 | !-- Total mole concentrations: gas and particle phase |
|---|
| 5631 | zcno3tot = zcno3c + SUM( zcno3cae(1:nbins) ) |
|---|
| 5632 | zcnh3tot = zcnh3c + SUM( zcnh3cae(1:nbins) ) |
|---|
| 5633 | ! |
|---|
| 5634 | !-- Relative humidity [0-1] |
|---|
| 5635 | zrh = pcw / pcs |
|---|
| 5636 | ! |
|---|
| 5637 | !-- Mass transfer coefficients (Jacobson, Eq. 16.64) |
|---|
| 5638 | zmtno3ae(1:nbins) = 2.0_wp * pi * paero(1:nbins)%dwet * zdfvap * & |
|---|
| 5639 | paero(1:nbins)%numc * pbeta(1:nbins) |
|---|
| 5640 | zmtnh3ae(1:nbins) = 2.0_wp * pi * paero(1:nbins)%dwet * zdfvap * & |
|---|
| 5641 | paero(1:nbins)%numc * pbeta(1:nbins) |
|---|
| 5642 | |
|---|
| 5643 | ! |
|---|
| 5644 | !-- Get the equilibrium concentrations above aerosols |
|---|
| 5645 | CALL NONHEquil( zrh, ptemp, paero, zcgno3eqae, zcgnh3eqae, zacno3ae, & |
|---|
| 5646 | zacnh3ae, zacnh4hso2ae, zachhso4ae, zmolsae ) |
|---|
| 5647 | |
|---|
| 5648 | ! |
|---|
| 5649 | !-- NH4/HNO3 saturation ratios for aerosols |
|---|
| 5650 | CALL SVsat( ptemp, paero, zacno3ae, zacnh3ae, zacnh4hso2ae, zachhso4ae, & |
|---|
| 5651 | zcgno3eqae, zcno3cae, zcnh3cae, zkelno3ae, zkelnh3ae, & |
|---|
| 5652 | zsathno3ae, zsatnh3ae, zmolsae ) |
|---|
| 5653 | ! |
|---|
| 5654 | !-- Intermediate concentrations |
|---|
| 5655 | zhlp1 = SUM( zcno3cae(1:nbins) / ( 1.0_wp + adt * zmtno3ae(1:nbins) * & |
|---|
| 5656 | zsathno3ae(1:nbins) ) ) |
|---|
| 5657 | zhlp2 = SUM( zmtno3ae(1:nbins) / ( 1.0_wp + adt * zmtno3ae(1:nbins) * & |
|---|
| 5658 | zsathno3ae(1:nbins) ) ) |
|---|
| 5659 | zcno3int = ( zcno3tot - zhlp1 ) / ( 1.0_wp + adt * zhlp2 ) |
|---|
| 5660 | |
|---|
| 5661 | zhlp1 = SUM( zcnh3cae(1:nbins) / ( 1.0_wp + adt * zmtnh3ae(1:nbins) * & |
|---|
| 5662 | zsatnh3ae(1:nbins) ) ) |
|---|
| 5663 | zhlp2 = SUM( zmtnh3ae(1:nbins) / ( 1.0_wp + adt * zmtnh3ae(1:nbins) * & |
|---|
| 5664 | zsatnh3ae(1:nbins) ) ) |
|---|
| 5665 | zcnh3int = ( zcnh3tot - zhlp1 )/( 1.0_wp + adt * zhlp2 ) |
|---|
| 5666 | |
|---|
| 5667 | zcno3int = MIN(zcno3int, zcno3tot) |
|---|
| 5668 | zcnh3int = MIN(zcnh3int, zcnh3tot) |
|---|
| 5669 | ! |
|---|
| 5670 | !-- Calculate the new particle concentrations |
|---|
| 5671 | zcno3intae = zcno3cae |
|---|
| 5672 | zcnh3intae = zcnh3cae |
|---|
| 5673 | DO b = 1, nbins |
|---|
| 5674 | zcno3intae(b) = ( zcno3cae(b) + adt * zmtno3ae(b) * zcno3int ) / & |
|---|
| 5675 | ( 1.0_wp + adt * zmtno3ae(b) * zsathno3ae(b) ) |
|---|
| 5676 | zcnh3intae(b) = ( zcnh3cae(b) + adt * zmtnh3ae(b) * zcnh3int ) / & |
|---|
| 5677 | ( 1.0_wp + adt * zmtnh3ae(b) * zsatnh3ae(b) ) |
|---|
| 5678 | ENDDO |
|---|
| 5679 | |
|---|
| 5680 | zcno3intae(1:nbins) = MAX( zcno3intae(1:nbins), 0.0_wp ) |
|---|
| 5681 | zcnh3intae(1:nbins) = MAX( zcnh3intae(1:nbins), 0.0_wp ) |
|---|
| 5682 | |
|---|
| 5683 | zcno3n = zcno3int ! Final molar gas concentration of HNO3 |
|---|
| 5684 | zcno3nae = zcno3intae ! Final molar particle concentration of HNO3 |
|---|
| 5685 | |
|---|
| 5686 | zcnh3n = zcnh3int ! Final molar gas concentration of NH3 |
|---|
| 5687 | zcnh3nae = zcnh3intae ! Final molar particle concentration of NH3 |
|---|
| 5688 | ! |
|---|
| 5689 | !-- Model timestep reached - update the new arrays |
|---|
| 5690 | pghno3 = zcno3n * avo |
|---|
| 5691 | pgnh3 = zcnh3n * avo |
|---|
| 5692 | |
|---|
| 5693 | DO b = in1a, fn2b |
|---|
| 5694 | paero(b)%volc(6) = zcno3nae(b) * amhno3 / arhohno3 |
|---|
| 5695 | paero(b)%volc(7) = zcnh3nae(b) * amnh3 / arhonh3 |
|---|
| 5696 | ENDDO |
|---|
| 5697 | |
|---|
| 5698 | |
|---|
| 5699 | END SUBROUTINE gpparthno3 |
|---|
| 5700 | !------------------------------------------------------------------------------! |
|---|
| 5701 | ! Description: |
|---|
| 5702 | ! ------------ |
|---|
| 5703 | !> Calculate the equilibrium concentrations above aerosols (reference?) |
|---|
| 5704 | !------------------------------------------------------------------------------! |
|---|
| 5705 | SUBROUTINE NONHEquil( prh, ptemp, ppart, pcgno3eq, pcgnh3eq, pgammano, & |
|---|
| 5706 | pgammanh, pgammanh4hso2, pgammahhso4, pmols ) |
|---|
| 5707 | |
|---|
| 5708 | IMPLICIT NONE |
|---|
| 5709 | |
|---|
| 5710 | REAL(wp), INTENT(in) :: prh !< relative humidity |
|---|
| 5711 | REAL(wp), INTENT(in) :: ptemp !< ambient temperature (K) |
|---|
| 5712 | |
|---|
| 5713 | TYPE(t_section), INTENT(inout) :: ppart(nbins) !< Aerosol properties |
|---|
| 5714 | !-- Equilibrium molar concentration above aerosols: |
|---|
| 5715 | REAL(wp), INTENT(inout) :: pcgnh3eq(nbins) !< of NH3 |
|---|
| 5716 | REAL(wp), INTENT(inout) :: pcgno3eq(nbins) !< of HNO3 |
|---|
| 5717 | !< Activity coefficients: |
|---|
| 5718 | REAL(wp), INTENT(inout) :: pgammahhso4(nbins) !< HHSO4 |
|---|
| 5719 | REAL(wp), INTENT(inout) :: pgammanh(nbins) !< NH3 |
|---|
| 5720 | REAL(wp), INTENT(inout) :: pgammanh4hso2(nbins) !< NH4HSO2 |
|---|
| 5721 | REAL(wp), INTENT(inout) :: pgammano(nbins) !< HNO3 |
|---|
| 5722 | REAL(wp), INTENT(inout) :: pmols(nbins,7) !< Ion molalities |
|---|
| 5723 | |
|---|
| 5724 | INTEGER(iwp) :: b |
|---|
| 5725 | |
|---|
| 5726 | REAL(wp) :: zgammas(7) !< Activity coefficients |
|---|
| 5727 | REAL(wp) :: zhlp !< Dummy variable |
|---|
| 5728 | REAL(wp) :: zions(7) !< molar concentration of ion (mol/m3) |
|---|
| 5729 | REAL(wp) :: zphcl !< Equilibrium vapor pressures (Pa??) |
|---|
| 5730 | REAL(wp) :: zphno3 !< Equilibrium vapor pressures (Pa??) |
|---|
| 5731 | REAL(wp) :: zpnh3 !< Equilibrium vapor pressures (Pa??) |
|---|
| 5732 | REAL(wp) :: zwatertotal !< Total water in particles (mol/m3) ??? |
|---|
| 5733 | |
|---|
| 5734 | zgammas = 0.0_wp |
|---|
| 5735 | zhlp = 0.0_wp |
|---|
| 5736 | zions = 0.0_wp |
|---|
| 5737 | zphcl = 0.0_wp |
|---|
| 5738 | zphno3 = 0.0_wp |
|---|
| 5739 | zpnh3 = 0.0_wp |
|---|
| 5740 | zwatertotal = 0.0_wp |
|---|
| 5741 | |
|---|
| 5742 | DO b = 1, nbins |
|---|
| 5743 | |
|---|
| 5744 | IF ( ppart(b)%numc < nclim ) CYCLE |
|---|
| 5745 | ! |
|---|
| 5746 | !-- 2*H2SO4 + CL + NO3 - Na - NH4 |
|---|
| 5747 | zhlp = 2.0_wp * ppart(b)%volc(1) * arhoh2so4 / amh2so4 + & |
|---|
| 5748 | ppart(b)%volc(5) * arhoss / amss + & |
|---|
| 5749 | ppart(b)%volc(6) * arhohno3 / amhno3 - & |
|---|
| 5750 | ppart(b)%volc(5) * arhoss / amss - & |
|---|
| 5751 | ppart(b)%volc(7) * arhonh3 / amnh3 |
|---|
| 5752 | |
|---|
| 5753 | zhlp = MAX( zhlp, 1.0E-30_wp ) |
|---|
| 5754 | |
|---|
| 5755 | zions(1) = zhlp ! H+ |
|---|
| 5756 | zions(2) = ppart(b)%volc(7) * arhonh3 / amnh3 ! NH4+ |
|---|
| 5757 | zions(3) = ppart(b)%volc(5) * arhoss / amss ! Na+ |
|---|
| 5758 | zions(4) = ppart(b)%volc(1) * arhoh2so4 / amh2so4 ! SO4(2-) |
|---|
| 5759 | zions(5) = 0.0_wp ! HSO4- |
|---|
| 5760 | zions(6) = ppart(b)%volc(6) * arhohno3 / amhno3 ! NO3- |
|---|
| 5761 | zions(7) = ppart(b)%volc(5) * arhoss / amss ! Cl- |
|---|
| 5762 | |
|---|
| 5763 | zwatertotal = ppart(b)%volc(8) * arhoh2o / amh2o |
|---|
| 5764 | IF ( zwatertotal > 1.0E-30_wp ) THEN |
|---|
| 5765 | CALL inorganic_pdfite( prh, ptemp, zions, zwatertotal, zphno3, zphcl,& |
|---|
| 5766 | zpnh3, zgammas, pmols(b,:) ) |
|---|
| 5767 | ENDIF |
|---|
| 5768 | ! |
|---|
| 5769 | !-- Activity coefficients |
|---|
| 5770 | pgammano(b) = zgammas(1) ! HNO3 |
|---|
| 5771 | pgammanh(b) = zgammas(3) ! NH3 |
|---|
| 5772 | pgammanh4hso2(b) = zgammas(6) ! NH4HSO2 |
|---|
| 5773 | pgammahhso4(b) = zgammas(7) ! HHSO4 |
|---|
| 5774 | ! |
|---|
| 5775 | !-- Equilibrium molar concentrations (mol/m3) from equlibrium pressures (Pa) |
|---|
| 5776 | pcgno3eq(b) = zphno3 / ( argas * ptemp ) |
|---|
| 5777 | pcgnh3eq(b) = zpnh3 / ( argas * ptemp ) |
|---|
| 5778 | |
|---|
| 5779 | ENDDO |
|---|
| 5780 | |
|---|
| 5781 | END SUBROUTINE NONHEquil |
|---|
| 5782 | |
|---|
| 5783 | !------------------------------------------------------------------------------! |
|---|
| 5784 | ! Description: |
|---|
| 5785 | ! ------------ |
|---|
| 5786 | !> Calculate saturation ratios of NH4 and HNO3 for aerosols |
|---|
| 5787 | !------------------------------------------------------------------------------! |
|---|
| 5788 | SUBROUTINE SVsat( ptemp, ppart, pachno3, pacnh3, pacnh4hso2, pachhso4, & |
|---|
| 5789 | pchno3eq, pchno3, pcnh3, pkelhno3, pkelnh3, psathno3, & |
|---|
| 5790 | psatnh3, pmols ) |
|---|
| 5791 | |
|---|
| 5792 | IMPLICIT NONE |
|---|
| 5793 | |
|---|
| 5794 | REAL(wp), INTENT(in) :: ptemp !< ambient temperature (K) |
|---|
| 5795 | |
|---|
| 5796 | TYPE(t_section), INTENT(inout) :: ppart(nbins) !< Aerosol properties |
|---|
| 5797 | !-- Activity coefficients |
|---|
| 5798 | REAL(wp), INTENT(in) :: pachhso4(nbins) !< |
|---|
| 5799 | REAL(wp), INTENT(in) :: pacnh3(nbins) !< |
|---|
| 5800 | REAL(wp), INTENT(in) :: pacnh4hso2(nbins) !< |
|---|
| 5801 | REAL(wp), INTENT(in) :: pachno3(nbins) !< |
|---|
| 5802 | REAL(wp), INTENT(in) :: pchno3eq(nbins) !< Equilibrium surface concentration |
|---|
| 5803 | !< of HNO3 |
|---|
| 5804 | REAL(wp), INTENT(in) :: pchno3(nbins) !< Current particle mole |
|---|
| 5805 | !< concentration of HNO3 (mol/m3) |
|---|
| 5806 | REAL(wp), INTENT(in) :: pcnh3(nbins) !< Current particle mole |
|---|
| 5807 | !< concentration of NH3 (mol/m3) |
|---|
| 5808 | REAL(wp), INTENT(in) :: pkelhno3(nbins) !< Kelvin effect for HNO3 |
|---|
| 5809 | REAL(wp), INTENT(in) :: pkelnh3(nbins) !< Kelvin effect for NH3 |
|---|
| 5810 | REAL(wp), INTENT(in) :: pmols(nbins,7) |
|---|
| 5811 | !-- Saturation ratios |
|---|
| 5812 | REAL(wp), INTENT(out) :: psathno3(nbins) !< |
|---|
| 5813 | REAL(wp), INTENT(out) :: psatnh3(nbins) !< |
|---|
| 5814 | |
|---|
| 5815 | INTEGER :: b !< running index for aerosol bins |
|---|
| 5816 | !-- Constants for calculating equilibrium constants: |
|---|
| 5817 | REAL(wp), PARAMETER :: a1 = -22.52_wp !< |
|---|
| 5818 | REAL(wp), PARAMETER :: a2 = -1.50_wp !< |
|---|
| 5819 | REAL(wp), PARAMETER :: a3 = 13.79_wp !< |
|---|
| 5820 | REAL(wp), PARAMETER :: a4 = 29.17_wp !< |
|---|
| 5821 | REAL(wp), PARAMETER :: b1 = 26.92_wp !< |
|---|
| 5822 | REAL(wp), PARAMETER :: b2 = 26.92_wp !< |
|---|
| 5823 | REAL(wp), PARAMETER :: b3 = -5.39_wp !< |
|---|
| 5824 | REAL(wp), PARAMETER :: b4 = 16.84_wp !< |
|---|
| 5825 | REAL(wp), PARAMETER :: K01 = 1.01E-14_wp !< |
|---|
| 5826 | REAL(wp), PARAMETER :: K02 = 1.81E-5_wp !< |
|---|
| 5827 | REAL(wp), PARAMETER :: K03 = 57.64_wp !< |
|---|
| 5828 | REAL(wp), PARAMETER :: K04 = 2.51E+6_wp !< |
|---|
| 5829 | !-- Equilibrium constants of equilibrium reactions |
|---|
| 5830 | REAL(wp) :: KllH2O !< H2O(aq) <--> H+ + OH- (mol/kg) |
|---|
| 5831 | REAL(wp) :: KllNH3 !< NH3(aq) + H2O(aq) <--> NH4+ + OH- (mol/kg) |
|---|
| 5832 | REAL(wp) :: KglNH3 !< NH3(g) <--> NH3(aq) (mol/kg/atm) |
|---|
| 5833 | REAL(wp) :: KglHNO3 !< HNO3(g) <--> H+ + NO3- (mol2/kg2/atm) |
|---|
| 5834 | REAL(wp) :: zmolno3 !< molality of NO3- (mol/kg) |
|---|
| 5835 | REAL(wp) :: zmolhp !< molality of H+ (mol/kg) |
|---|
| 5836 | REAL(wp) :: zmolso4 !< molality of SO4(2-) (mol/kg) |
|---|
| 5837 | REAL(wp) :: zmolcl !< molality of Cl (mol/kg) |
|---|
| 5838 | REAL(wp) :: zmolnh4 !< Molality of NH4 (mol/kg) |
|---|
| 5839 | REAL(wp) :: zmolna !< Molality of Na (mol/kg) |
|---|
| 5840 | REAL(wp) :: zhlp1 !< |
|---|
| 5841 | REAL(wp) :: zhlp2 !< |
|---|
| 5842 | REAL(wp) :: zhlp3 !< |
|---|
| 5843 | REAL(wp) :: zxi !< |
|---|
| 5844 | REAL(wp) :: zt0 !< Reference temp |
|---|
| 5845 | |
|---|
| 5846 | zhlp1 = 0.0_wp |
|---|
| 5847 | zhlp2 = 0.0_wp |
|---|
| 5848 | zhlp3 = 0.0_wp |
|---|
| 5849 | zmolcl = 0.0_wp |
|---|
| 5850 | zmolhp = 0.0_wp |
|---|
| 5851 | zmolna = 0.0_wp |
|---|
| 5852 | zmolnh4 = 0.0_wp |
|---|
| 5853 | zmolno3 = 0.0_wp |
|---|
| 5854 | zmolso4 = 0.0_wp |
|---|
| 5855 | zt0 = 298.15_wp |
|---|
| 5856 | zxi = 0.0_wp |
|---|
| 5857 | ! |
|---|
| 5858 | !-- Calculates equlibrium rate constants based on Table B.7 in Jacobson (2005) |
|---|
| 5859 | !-- K^ll_H20, K^ll_NH3, K^gl_NH3, K^gl_HNO3 |
|---|
| 5860 | zhlp1 = zt0 / ptemp |
|---|
| 5861 | zhlp2 = zhlp1 - 1.0_wp |
|---|
| 5862 | zhlp3 = 1.0_wp + LOG( zhlp1 ) - zhlp1 |
|---|
| 5863 | |
|---|
| 5864 | KllH2O = K01 * EXP( a1 * zhlp2 + b1 * zhlp3 ) |
|---|
| 5865 | KllNH3 = K02 * EXP( a2 * zhlp2 + b2 * zhlp3 ) |
|---|
| 5866 | KglNH3 = K03 * EXP( a3 * zhlp2 + b3 * zhlp3 ) |
|---|
| 5867 | KglHNO3 = K04 * EXP( a4 * zhlp2 + b4 * zhlp3 ) |
|---|
| 5868 | |
|---|
| 5869 | DO b = 1, nbins |
|---|
| 5870 | |
|---|
| 5871 | IF ( ppart(b)%numc > nclim .AND. ppart(b)%volc(8) > 1.0E-30_wp ) THEN |
|---|
| 5872 | ! |
|---|
| 5873 | !-- Molality of H+ and NO3- |
|---|
| 5874 | zhlp1 = pcnh3(b) * amnh3 + ppart(b)%volc(1) * arhoh2so4 + & |
|---|
| 5875 | ppart(b)%volc(2) * arhooc + ppart(b)%volc(5) * arhoss + & |
|---|
| 5876 | ppart(b)%volc(8) * arhoh2o |
|---|
| 5877 | zmolno3 = pchno3(b) / zhlp1 !< mol/kg |
|---|
| 5878 | ! |
|---|
| 5879 | !-- Particle mole concentration ratio: (NH3+SS)/H2SO4 |
|---|
| 5880 | zxi = ( pcnh3(b) + ppart(b)%volc(5) * arhoss / amss ) / & |
|---|
| 5881 | ( ppart(b)%volc(1) * arhoh2so4 / amh2so4 ) |
|---|
| 5882 | |
|---|
| 5883 | IF ( zxi <= 2.0_wp ) THEN |
|---|
| 5884 | ! |
|---|
| 5885 | !-- Molality of SO4(2-) |
|---|
| 5886 | zhlp1 = pcnh3(b) * amnh3 + pchno3(b) * amhno3 + & |
|---|
| 5887 | ppart(b)%volc(2) * arhooc + ppart(b)%volc(5) * arhoss + & |
|---|
| 5888 | ppart(b)%volc(8) * arhoh2o |
|---|
| 5889 | zmolso4 = ( ppart(b)%volc(1) * arhoh2so4 / amh2so4 ) / zhlp1 |
|---|
| 5890 | ! |
|---|
| 5891 | !-- Molality of Cl- |
|---|
| 5892 | zhlp1 = pcnh3(b) * amnh3 + pchno3(b) * amhno3 + & |
|---|
| 5893 | ppart(b)%volc(2) * arhooc + ppart(b)%volc(1) * arhoh2so4 & |
|---|
| 5894 | + ppart(b)%volc(8) * arhoh2o |
|---|
| 5895 | zmolcl = ( ppart(b)%volc(5) * arhoss / amss ) / zhlp1 |
|---|
| 5896 | ! |
|---|
| 5897 | !-- Molality of NH4+ |
|---|
| 5898 | zhlp1 = pchno3(b) * amhno3 + ppart(b)%volc(1) * arhoh2so4 + & |
|---|
| 5899 | ppart(b)%volc(2) * arhooc + ppart(b)%volc(5) * arhoss + & |
|---|
| 5900 | ppart(b)%volc(8) * arhoh2o |
|---|
| 5901 | zmolnh4 = pcnh3(b) / zhlp1 |
|---|
| 5902 | ! |
|---|
| 5903 | !-- Molality of Na+ |
|---|
| 5904 | zmolna = zmolcl |
|---|
| 5905 | ! |
|---|
| 5906 | !-- Molality of H+ |
|---|
| 5907 | zmolhp = 2.0_wp * zmolso4 + zmolno3 + zmolcl - ( zmolnh4 + zmolna ) |
|---|
| 5908 | |
|---|
| 5909 | ELSE |
|---|
| 5910 | |
|---|
| 5911 | zhlp2 = pkelhno3(b) * zmolno3 * pachno3(b) ** 2.0_wp |
|---|
| 5912 | ! |
|---|
| 5913 | !-- Mona debugging |
|---|
| 5914 | IF ( zhlp2 > 1.0E-30_wp ) THEN |
|---|
| 5915 | zmolhp = KglHNO3 * pchno3eq(b) / zhlp2 ! Eq. 17.38 |
|---|
| 5916 | ELSE |
|---|
| 5917 | zmolhp = 0.0_wp |
|---|
| 5918 | ENDIF |
|---|
| 5919 | |
|---|
| 5920 | ENDIF |
|---|
| 5921 | |
|---|
| 5922 | zhlp1 = ppart(b)%volc(8) * arhoh2o * argas * ptemp * KglHNO3 |
|---|
| 5923 | ! |
|---|
| 5924 | !-- Saturation ratio for NH3 and for HNO3 |
|---|
| 5925 | IF ( zmolhp > 0.0_wp ) THEN |
|---|
| 5926 | zhlp2 = pkelnh3(b) / ( zhlp1 * zmolhp ) |
|---|
| 5927 | zhlp3 = KllH2O / ( KllNH3 + KglNH3 ) |
|---|
| 5928 | psatnh3(b) = zhlp2 * ( ( pacnh4hso2(b) / pachhso4(b) ) **2.0_wp ) & |
|---|
| 5929 | * zhlp3 |
|---|
| 5930 | psathno3(b) = ( pkelhno3(b) * zmolhp * pachno3(b)**2.0_wp ) / zhlp1 |
|---|
| 5931 | ELSE |
|---|
| 5932 | psatnh3(b) = 1.0_wp |
|---|
| 5933 | psathno3(b) = 1.0_wp |
|---|
| 5934 | ENDIF |
|---|
| 5935 | ELSE |
|---|
| 5936 | psatnh3(b) = 1.0_wp |
|---|
| 5937 | psathno3(b) = 1.0_wp |
|---|
| 5938 | ENDIF |
|---|
| 5939 | |
|---|
| 5940 | ENDDO |
|---|
| 5941 | |
|---|
| 5942 | END SUBROUTINE SVsat |
|---|
| 5943 | |
|---|
| 5944 | !------------------------------------------------------------------------------! |
|---|
| 5945 | ! Description: |
|---|
| 5946 | ! ------------ |
|---|
| 5947 | !> Prototype module for calculating the water content of a mixed inorganic/ |
|---|
| 5948 | !> organic particle + equilibrium water vapour pressure above the solution |
|---|
| 5949 | !> (HNO3, HCL, NH3 and representative organic compounds. Efficient calculation |
|---|
| 5950 | !> of the partitioning of species between gas and aerosol. Based in a chamber |
|---|
| 5951 | !> study. |
|---|
| 5952 | ! |
|---|
| 5953 | !> Written by Dave Topping. Pure organic component properties predicted by Mark |
|---|
| 5954 | !> Barley based on VOCs predicted in MCM simulations performed by Mike Jenkin. |
|---|
| 5955 | !> Delivered by Gordon McFiggans as Deliverable D22 from WP1.4 in the EU FP6 |
|---|
| 5956 | !> EUCAARI Integrated Project. |
|---|
| 5957 | ! |
|---|
| 5958 | !> Queries concerning the use of this code through Gordon McFiggans, |
|---|
| 5959 | !> g.mcfiggans@manchester.ac.uk, |
|---|
| 5960 | !> Ownership: D. Topping, Centre for Atmospheric Sciences, University of |
|---|
| 5961 | !> Manchester, 2007 |
|---|
| 5962 | ! |
|---|
| 5963 | !> Rewritten to PALM by Mona Kurppa, UHel, 2017 |
|---|
| 5964 | !------------------------------------------------------------------------------! |
|---|
| 5965 | SUBROUTINE inorganic_pdfite( RH, temp, ions, water_total, Press_HNO3, & |
|---|
| 5966 | Press_HCL, Press_NH3, gamma_out, mols_out ) |
|---|
| 5967 | |
|---|
| 5968 | IMPLICIT NONE |
|---|
| 5969 | |
|---|
| 5970 | REAL(wp), DIMENSION(:) :: gamma_out !< Activity coefficient for calculating |
|---|
| 5971 | !< the non-ideal dissociation constants |
|---|
| 5972 | !< 1: HNO3, 2: HCL, 3: NH4+/H+ (NH3) |
|---|
| 5973 | !< 4: HHSO4**2/H2SO4, |
|---|
| 5974 | !< 5: H2SO4**3/HHSO4**2 |
|---|
| 5975 | !< 6: NH4HSO2, 7: HHSO4 |
|---|
| 5976 | REAL(wp), DIMENSION(:) :: ions !< ion molarities (mol/m3) |
|---|
| 5977 | !< 1: H+, 2: NH4+, 3: Na+, 4: SO4(2-), |
|---|
| 5978 | !< 5: HSO4-, 6: NO3-, 7: Cl- |
|---|
| 5979 | REAL(wp), DIMENSION(7) :: ions_mol !< ion molalities (mol/kg) |
|---|
| 5980 | !< 1: H+, 2: NH4+, 3: Na+, 4: SO4(2-), |
|---|
| 5981 | !< 5: HSO4-, 6: NO3-, 7: Cl- |
|---|
| 5982 | REAL(wp), DIMENSION(:) :: mols_out !< ion molality output (mol/kg) |
|---|
| 5983 | !< 1: H+, 2: NH4+, 3: Na+, 4: SO4(2-), |
|---|
| 5984 | !< 5: HSO4-, 6: NO3-, 7: Cl- |
|---|
| 5985 | REAL(wp) :: act_product !< ionic activity coef. product: |
|---|
| 5986 | !< = (gamma_h2so4**3d0) / |
|---|
| 5987 | !< (gamma_hhso4**2d0) |
|---|
| 5988 | REAL(wp) :: ammonium_chloride !< |
|---|
| 5989 | REAL(wp) :: ammonium_chloride_eq_frac !< |
|---|
| 5990 | REAL(wp) :: ammonium_nitrate !< |
|---|
| 5991 | REAL(wp) :: ammonium_nitrate_eq_frac !< |
|---|
| 5992 | REAL(wp) :: ammonium_sulphate !< |
|---|
| 5993 | REAL(wp) :: ammonium_sulphate_eq_frac !< |
|---|
| 5994 | REAL(wp) :: binary_h2so4 !< binary H2SO4 activity coeff. |
|---|
| 5995 | REAL(wp) :: binary_hcl !< binary HCL activity coeff. |
|---|
| 5996 | REAL(wp) :: binary_hhso4 !< binary HHSO4 activity coeff. |
|---|
| 5997 | REAL(wp) :: binary_hno3 !< binary HNO3 activity coeff. |
|---|
| 5998 | REAL(wp) :: binary_nh4hso4 !< binary NH4HSO4 activity coeff. |
|---|
| 5999 | REAL(wp) :: charge_sum !< sum of ionic charges |
|---|
| 6000 | REAL(wp) :: gamma_h2so4 !< activity coefficient |
|---|
| 6001 | REAL(wp) :: gamma_hcl !< activity coefficient |
|---|
| 6002 | REAL(wp) :: gamma_hhso4 !< activity coeffient |
|---|
| 6003 | REAL(wp) :: gamma_hno3 !< activity coefficient |
|---|
| 6004 | REAL(wp) :: gamma_nh3 !< activity coefficient |
|---|
| 6005 | REAL(wp) :: gamma_nh4hso4 !< activity coefficient |
|---|
| 6006 | REAL(wp) :: h_out !< |
|---|
| 6007 | REAL(wp) :: h_real !< new hydrogen ion conc. |
|---|
| 6008 | REAL(wp) :: H2SO4_hcl !< contribution of H2SO4 |
|---|
| 6009 | REAL(wp) :: H2SO4_hno3 !< contribution of H2SO4 |
|---|
| 6010 | REAL(wp) :: H2SO4_nh3 !< contribution of H2SO4 |
|---|
| 6011 | REAL(wp) :: H2SO4_nh4hso4 !< contribution of H2SO4 |
|---|
| 6012 | REAL(wp) :: HCL_h2so4 !< contribution of HCL |
|---|
| 6013 | REAL(wp) :: HCL_hhso4 !< contribution of HCL |
|---|
| 6014 | REAL(wp) :: HCL_hno3 !< contribution of HCL |
|---|
| 6015 | REAL(wp) :: HCL_nh3 !< contribution of HCL |
|---|
| 6016 | REAL(wp) :: HCL_nh4hso4 !< contribution of HCL |
|---|
| 6017 | REAL(wp) :: henrys_temp_dep !< temperature dependence of |
|---|
| 6018 | !< Henry's Law |
|---|
| 6019 | REAL(wp) :: HNO3_h2so4 !< contribution of HNO3 |
|---|
| 6020 | REAL(wp) :: HNO3_hcl !< contribution of HNO3 |
|---|
| 6021 | REAL(wp) :: HNO3_hhso4 !< contribution of HNO3 |
|---|
| 6022 | REAL(wp) :: HNO3_nh3 !< contribution of HNO3 |
|---|
| 6023 | REAL(wp) :: HNO3_nh4hso4 !< contribution of HNO3 |
|---|
| 6024 | REAL(wp) :: hso4_out !< |
|---|
| 6025 | REAL(wp) :: hso4_real !< new bisulphate ion conc. |
|---|
| 6026 | REAL(wp) :: hydrochloric_acid !< |
|---|
| 6027 | REAL(wp) :: hydrochloric_acid_eq_frac !< |
|---|
| 6028 | REAL(wp) :: Kh !< equilibrium constant for H+ |
|---|
| 6029 | REAL(wp) :: K_hcl !< equilibrium constant of HCL |
|---|
| 6030 | REAL(wp) :: K_hno3 !< equilibrium constant of HNO3 |
|---|
| 6031 | REAL(wp) :: Knh4 !< equilibrium constant for NH4+ |
|---|
| 6032 | REAL(wp) :: Kw !< equil. const. for water_surface |
|---|
| 6033 | REAL(wp) :: Ln_h2so4_act !< gamma_h2so4 = EXP(Ln_h2so4_act) |
|---|
| 6034 | REAL(wp) :: Ln_HCL_act !< gamma_hcl = EXP( Ln_HCL_act ) |
|---|
| 6035 | REAL(wp) :: Ln_hhso4_act !< gamma_hhso4 = EXP(Ln_hhso4_act) |
|---|
| 6036 | REAL(wp) :: Ln_HNO3_act !< gamma_hno3 = EXP( Ln_HNO3_act ) |
|---|
| 6037 | REAL(wp) :: Ln_NH4HSO4_act !< gamma_nh4hso4 = |
|---|
| 6038 | !< EXP( Ln_NH4HSO4_act ) |
|---|
| 6039 | REAL(wp) :: molality_ratio_nh3 !< molality ratio of NH3 |
|---|
| 6040 | !< (NH4+ and H+) |
|---|
| 6041 | REAL(wp) :: Na2SO4_h2so4 !< contribution of Na2SO4 |
|---|
| 6042 | REAL(wp) :: Na2SO4_hcl !< contribution of Na2SO4 |
|---|
| 6043 | REAL(wp) :: Na2SO4_hhso4 !< contribution of Na2SO4 |
|---|
| 6044 | REAL(wp) :: Na2SO4_hno3 !< contribution of Na2SO4 |
|---|
| 6045 | REAL(wp) :: Na2SO4_nh3 !< contribution of Na2SO4 |
|---|
| 6046 | REAL(wp) :: Na2SO4_nh4hso4 !< contribution of Na2SO4 |
|---|
| 6047 | REAL(wp) :: NaCl_h2so4 !< contribution of NaCl |
|---|
| 6048 | REAL(wp) :: NaCl_hcl !< contribution of NaCl |
|---|
| 6049 | REAL(wp) :: NaCl_hhso4 !< contribution of NaCl |
|---|
| 6050 | REAL(wp) :: NaCl_hno3 !< contribution of NaCl |
|---|
| 6051 | REAL(wp) :: NaCl_nh3 !< contribution of NaCl |
|---|
| 6052 | REAL(wp) :: NaCl_nh4hso4 !< contribution of NaCl |
|---|
| 6053 | REAL(wp) :: NaNO3_h2so4 !< contribution of NaNO3 |
|---|
| 6054 | REAL(wp) :: NaNO3_hcl !< contribution of NaNO3 |
|---|
| 6055 | REAL(wp) :: NaNO3_hhso4 !< contribution of NaNO3 |
|---|
| 6056 | REAL(wp) :: NaNO3_hno3 !< contribution of NaNO3 |
|---|
| 6057 | REAL(wp) :: NaNO3_nh3 !< contribution of NaNO3 |
|---|
| 6058 | REAL(wp) :: NaNO3_nh4hso4 !< contribution of NaNO3 |
|---|
| 6059 | REAL(wp) :: NH42SO4_h2so4 !< contribution of NH42SO4 |
|---|
| 6060 | REAL(wp) :: NH42SO4_hcl !< contribution of NH42SO4 |
|---|
| 6061 | REAL(wp) :: NH42SO4_hhso4 !< contribution of NH42SO4 |
|---|
| 6062 | REAL(wp) :: NH42SO4_hno3 !< contribution of NH42SO4 |
|---|
| 6063 | REAL(wp) :: NH42SO4_nh3 !< contribution of NH42SO4 |
|---|
| 6064 | REAL(wp) :: NH42SO4_nh4hso4 !< contribution of NH42SO4 |
|---|
| 6065 | REAL(wp) :: NH4Cl_h2so4 !< contribution of NH4Cl |
|---|
| 6066 | REAL(wp) :: NH4Cl_hcl !< contribution of NH4Cl |
|---|
| 6067 | REAL(wp) :: NH4Cl_hhso4 !< contribution of NH4Cl |
|---|
| 6068 | REAL(wp) :: NH4Cl_hno3 !< contribution of NH4Cl |
|---|
| 6069 | REAL(wp) :: NH4Cl_nh3 !< contribution of NH4Cl |
|---|
| 6070 | REAL(wp) :: NH4Cl_nh4hso4 !< contribution of NH4Cl |
|---|
| 6071 | REAL(wp) :: NH4NO3_h2so4 !< contribution of NH4NO3 |
|---|
| 6072 | REAL(wp) :: NH4NO3_hcl !< contribution of NH4NO3 |
|---|
| 6073 | REAL(wp) :: NH4NO3_hhso4 !< contribution of NH4NO3 |
|---|
| 6074 | REAL(wp) :: NH4NO3_hno3 !< contribution of NH4NO3 |
|---|
| 6075 | REAL(wp) :: NH4NO3_nh3 !< contribution of NH4NO3 |
|---|
| 6076 | REAL(wp) :: NH4NO3_nh4hso4 !< contribution of NH4NO3 |
|---|
| 6077 | REAL(wp) :: nitric_acid !< |
|---|
| 6078 | REAL(wp) :: nitric_acid_eq_frac !< Equivalent fractions |
|---|
| 6079 | REAL(wp) :: Press_HCL !< partial pressure of HCL |
|---|
| 6080 | REAL(wp) :: Press_HNO3 !< partial pressure of HNO3 |
|---|
| 6081 | REAL(wp) :: Press_NH3 !< partial pressure of NH3 |
|---|
| 6082 | REAL(wp) :: RH !< relative humidity [0-1] |
|---|
| 6083 | REAL(wp) :: temp !< temperature |
|---|
| 6084 | REAL(wp) :: so4_out !< |
|---|
| 6085 | REAL(wp) :: so4_real !< new sulpate ion concentration |
|---|
| 6086 | REAL(wp) :: sodium_chloride !< |
|---|
| 6087 | REAL(wp) :: sodium_chloride_eq_frac !< |
|---|
| 6088 | REAL(wp) :: sodium_nitrate !< |
|---|
| 6089 | REAL(wp) :: sodium_nitrate_eq_frac !< |
|---|
| 6090 | REAL(wp) :: sodium_sulphate !< |
|---|
| 6091 | REAL(wp) :: sodium_sulphate_eq_frac !< |
|---|
| 6092 | REAL(wp) :: solutes !< |
|---|
| 6093 | REAL(wp) :: sulphuric_acid !< |
|---|
| 6094 | REAL(wp) :: sulphuric_acid_eq_frac !< |
|---|
| 6095 | REAL(wp) :: water_total !< |
|---|
| 6096 | |
|---|
| 6097 | REAL(wp) :: a !< auxiliary variable |
|---|
| 6098 | REAL(wp) :: b !< auxiliary variable |
|---|
| 6099 | REAL(wp) :: c !< auxiliary variable |
|---|
| 6100 | REAL(wp) :: root1 !< auxiliary variable |
|---|
| 6101 | REAL(wp) :: root2 !< auxiliary variable |
|---|
| 6102 | |
|---|
| 6103 | INTEGER(iwp) :: binary_case |
|---|
| 6104 | INTEGER(iwp) :: full_complexity |
|---|
| 6105 | ! |
|---|
| 6106 | !-- Value initialisation |
|---|
| 6107 | binary_h2so4 = 0.0_wp |
|---|
| 6108 | binary_hcl = 0.0_wp |
|---|
| 6109 | binary_hhso4 = 0.0_wp |
|---|
| 6110 | binary_hno3 = 0.0_wp |
|---|
| 6111 | binary_nh4hso4 = 0.0_wp |
|---|
| 6112 | henrys_temp_dep = ( 1.0_wp / temp - 1.0_wp / 298.0_wp ) |
|---|
| 6113 | HCL_hno3 = 1.0_wp |
|---|
| 6114 | H2SO4_hno3 = 1.0_wp |
|---|
| 6115 | NH42SO4_hno3 = 1.0_wp |
|---|
| 6116 | NH4NO3_hno3 = 1.0_wp |
|---|
| 6117 | NH4Cl_hno3 = 1.0_wp |
|---|
| 6118 | Na2SO4_hno3 = 1.0_wp |
|---|
| 6119 | NaNO3_hno3 = 1.0_wp |
|---|
| 6120 | NaCl_hno3 = 1.0_wp |
|---|
| 6121 | HNO3_hcl = 1.0_wp |
|---|
| 6122 | H2SO4_hcl = 1.0_wp |
|---|
| 6123 | NH42SO4_hcl = 1.0_wp |
|---|
| 6124 | NH4NO3_hcl = 1.0_wp |
|---|
| 6125 | NH4Cl_hcl = 1.0_wp |
|---|
| 6126 | Na2SO4_hcl = 1.0_wp |
|---|
| 6127 | NaNO3_hcl = 1.0_wp |
|---|
| 6128 | NaCl_hcl = 1.0_wp |
|---|
| 6129 | HNO3_nh3 = 1.0_wp |
|---|
| 6130 | HCL_nh3 = 1.0_wp |
|---|
| 6131 | H2SO4_nh3 = 1.0_wp |
|---|
| 6132 | NH42SO4_nh3 = 1.0_wp |
|---|
| 6133 | NH4NO3_nh3 = 1.0_wp |
|---|
| 6134 | NH4Cl_nh3 = 1.0_wp |
|---|
| 6135 | Na2SO4_nh3 = 1.0_wp |
|---|
| 6136 | NaNO3_nh3 = 1.0_wp |
|---|
| 6137 | NaCl_nh3 = 1.0_wp |
|---|
| 6138 | HNO3_hhso4 = 1.0_wp |
|---|
| 6139 | HCL_hhso4 = 1.0_wp |
|---|
| 6140 | NH42SO4_hhso4 = 1.0_wp |
|---|
| 6141 | NH4NO3_hhso4 = 1.0_wp |
|---|
| 6142 | NH4Cl_hhso4 = 1.0_wp |
|---|
| 6143 | Na2SO4_hhso4 = 1.0_wp |
|---|
| 6144 | NaNO3_hhso4 = 1.0_wp |
|---|
| 6145 | NaCl_hhso4 = 1.0_wp |
|---|
| 6146 | HNO3_h2so4 = 1.0_wp |
|---|
| 6147 | HCL_h2so4 = 1.0_wp |
|---|
| 6148 | NH42SO4_h2so4 = 1.0_wp |
|---|
| 6149 | NH4NO3_h2so4 = 1.0_wp |
|---|
| 6150 | NH4Cl_h2so4 = 1.0_wp |
|---|
| 6151 | Na2SO4_h2so4 = 1.0_wp |
|---|
| 6152 | NaNO3_h2so4 = 1.0_wp |
|---|
| 6153 | NaCl_h2so4 = 1.0_wp |
|---|
| 6154 | !-- New NH3 variables |
|---|
| 6155 | HNO3_nh4hso4 = 1.0_wp |
|---|
| 6156 | HCL_nh4hso4 = 1.0_wp |
|---|
| 6157 | H2SO4_nh4hso4 = 1.0_wp |
|---|
| 6158 | NH42SO4_nh4hso4 = 1.0_wp |
|---|
| 6159 | NH4NO3_nh4hso4 = 1.0_wp |
|---|
| 6160 | NH4Cl_nh4hso4 = 1.0_wp |
|---|
| 6161 | Na2SO4_nh4hso4 = 1.0_wp |
|---|
| 6162 | NaNO3_nh4hso4 = 1.0_wp |
|---|
| 6163 | NaCl_nh4hso4 = 1.0_wp |
|---|
| 6164 | ! |
|---|
| 6165 | !-- Juha Tonttila added |
|---|
| 6166 | mols_out = 0.0_wp |
|---|
| 6167 | Press_HNO3 = 0.0_wp |
|---|
| 6168 | Press_HCL = 0.0_wp |
|---|
| 6169 | Press_NH3 = 0.0_wp !< Initialising vapour pressure over the |
|---|
| 6170 | !< multicomponent particle |
|---|
| 6171 | gamma_out = 1.0_wp !< i.e. don't alter the ideal mixing ratios if |
|---|
| 6172 | !< there's nothing there. |
|---|
| 6173 | ! |
|---|
| 6174 | !-- 1) - COMPOSITION DEFINITIONS |
|---|
| 6175 | ! |
|---|
| 6176 | !-- a) Inorganic ion pairing: |
|---|
| 6177 | !-- In order to calculate the water content, which is also used in |
|---|
| 6178 | !-- calculating vapour pressures, one needs to pair the anions and cations |
|---|
| 6179 | !-- for use in the ZSR mixing rule. The equation provided by Clegg et al. |
|---|
| 6180 | !-- (2001) is used for ion pairing. The solutes chosen comprise of 9 |
|---|
| 6181 | !-- inorganic salts and acids which provide a pairing between each anion and |
|---|
| 6182 | !-- cation: (NH4)2SO4, NH4NO3, NH4Cl, Na2SO4, NaNO3, NaCl, H2SO4, HNO3, HCL. |
|---|
| 6183 | !-- The organic compound is treated as a seperate solute. |
|---|
| 6184 | !-- Ions: 1: H+, 2: NH4+, 3: Na+, 4: SO4(2-), 5: HSO4-, 6: NO3-, 7: Cl- |
|---|
| 6185 | ! |
|---|
| 6186 | charge_sum = ions(1) + ions(2) + ions(3) + 2.0_wp * ions(4) + ions(5) + & |
|---|
| 6187 | ions(6) + ions(7) |
|---|
| 6188 | nitric_acid = 0.0_wp ! HNO3 |
|---|
| 6189 | nitric_acid = ( 2.0_wp * ions(1) * ions(6) * & |
|---|
| 6190 | ( ( 1.0_wp / 1.0_wp ) ** 0.5_wp ) ) / ( charge_sum ) |
|---|
| 6191 | hydrochloric_acid = 0.0_wp ! HCL |
|---|
| 6192 | hydrochloric_acid = ( 2.0_wp * ions(1) * ions(7) * & |
|---|
| 6193 | ( ( 1.0_wp / 1.0_wp ) ** 0.5_wp ) ) / ( charge_sum ) |
|---|
| 6194 | sulphuric_acid = 0.0_wp ! H2SO4 |
|---|
| 6195 | sulphuric_acid = ( 2.0_wp * ions(1) * ions(4) * & |
|---|
| 6196 | ( ( 2.0_wp / 2.0_wp ) ** 0.5_wp ) ) / ( charge_sum ) |
|---|
| 6197 | ammonium_sulphate = 0.0_wp ! (NH4)2SO4 |
|---|
| 6198 | ammonium_sulphate = ( 2.0_wp * ions(2) * ions(4) * & |
|---|
| 6199 | ( ( 2.0_wp / 2.0_wp ) ** 0.5_wp ) ) / ( charge_sum ) |
|---|
| 6200 | ammonium_nitrate = 0.0_wp ! NH4NO3 |
|---|
| 6201 | ammonium_nitrate = ( 2.0_wp * ions(2) * ions(6) * & |
|---|
| 6202 | ( ( 1.0_wp / 1.0_wp ) ** 0.5_wp ) ) / ( charge_sum ) |
|---|
| 6203 | ammonium_chloride = 0.0_wp ! NH4Cl |
|---|
| 6204 | ammonium_chloride = ( 2.0_wp * ions(2) * ions(7) * & |
|---|
| 6205 | ( ( 1.0_wp / 1.0_wp ) ** 0.5_wp ) ) / ( charge_sum ) |
|---|
| 6206 | sodium_sulphate = 0.0_wp ! Na2SO4 |
|---|
| 6207 | sodium_sulphate = ( 2.0_wp * ions(3) * ions(4) * & |
|---|
| 6208 | ( ( 2.0_wp / 2.0_wp ) ** 0.5_wp ) ) / ( charge_sum ) |
|---|
| 6209 | sodium_nitrate = 0.0_wp ! NaNO3 |
|---|
| 6210 | sodium_nitrate = ( 2.0_wp * ions(3) *ions(6) * & |
|---|
| 6211 | ( ( 1.0_wp / 1.0_wp ) ** 0.5_wp ) ) / ( charge_sum ) |
|---|
| 6212 | sodium_chloride = 0.0_wp ! NaCl |
|---|
| 6213 | sodium_chloride = ( 2.0_wp * ions(3) * ions(7) * & |
|---|
| 6214 | ( ( 1.0_wp / 1.0_wp ) ** 0.5_wp ) ) / ( charge_sum ) |
|---|
| 6215 | solutes = 0.0_wp |
|---|
| 6216 | solutes = 3.0_wp * sulphuric_acid + 2.0_wp * hydrochloric_acid + & |
|---|
| 6217 | 2.0_wp * nitric_acid + 3.0_wp * ammonium_sulphate + & |
|---|
| 6218 | 2.0_wp * ammonium_nitrate + 2.0_wp * ammonium_chloride + & |
|---|
| 6219 | 3.0_wp * sodium_sulphate + 2.0_wp * sodium_nitrate + & |
|---|
| 6220 | 2.0_wp * sodium_chloride |
|---|
| 6221 | |
|---|
| 6222 | ! |
|---|
| 6223 | !-- b) Inorganic equivalent fractions: |
|---|
| 6224 | !-- These values are calculated so that activity coefficients can be |
|---|
| 6225 | !-- expressed by a linear additive rule, thus allowing more efficient |
|---|
| 6226 | !-- calculations and future expansion (see more detailed description below) |
|---|
| 6227 | nitric_acid_eq_frac = 2.0_wp * nitric_acid / ( solutes ) |
|---|
| 6228 | hydrochloric_acid_eq_frac = 2.0_wp * hydrochloric_acid / ( solutes ) |
|---|
| 6229 | sulphuric_acid_eq_frac = 3.0_wp * sulphuric_acid / ( solutes ) |
|---|
| 6230 | ammonium_sulphate_eq_frac = 3.0_wp * ammonium_sulphate / ( solutes ) |
|---|
| 6231 | ammonium_nitrate_eq_frac = 2.0_wp * ammonium_nitrate / ( solutes ) |
|---|
| 6232 | ammonium_chloride_eq_frac = 2.0_wp * ammonium_chloride / ( solutes ) |
|---|
| 6233 | sodium_sulphate_eq_frac = 3.0_wp * sodium_sulphate / ( solutes ) |
|---|
| 6234 | sodium_nitrate_eq_frac = 2.0_wp * sodium_nitrate / ( solutes ) |
|---|
| 6235 | sodium_chloride_eq_frac = 2.0_wp * sodium_chloride / ( solutes ) |
|---|
| 6236 | ! |
|---|
| 6237 | !-- Inorganic ion molalities |
|---|
| 6238 | ions_mol(:) = 0.0_wp |
|---|
| 6239 | ions_mol(1) = ions(1) / ( water_total * 18.01528E-3_wp ) ! H+ |
|---|
| 6240 | ions_mol(2) = ions(2) / ( water_total * 18.01528E-3_wp ) ! NH4+ |
|---|
| 6241 | ions_mol(3) = ions(3) / ( water_total * 18.01528E-3_wp ) ! Na+ |
|---|
| 6242 | ions_mol(4) = ions(4) / ( water_total * 18.01528E-3_wp ) ! SO4(2-) |
|---|
| 6243 | ions_mol(5) = ions(5) / ( water_total * 18.01528E-3_wp ) ! HSO4(2-) |
|---|
| 6244 | ions_mol(6) = ions(6) / ( water_total * 18.01528E-3_wp ) ! NO3- |
|---|
| 6245 | ions_mol(7) = ions(7) / ( water_total * 18.01528E-3_wp ) ! Cl- |
|---|
| 6246 | |
|---|
| 6247 | !-- *** |
|---|
| 6248 | !-- At this point we may need to introduce a method for prescribing H+ when |
|---|
| 6249 | !-- there is no 'real' value for H+..i.e. in the sulphate poor domain |
|---|
| 6250 | !-- This will give a value for solve quadratic proposed by Zaveri et al. 2005 |
|---|
| 6251 | ! |
|---|
| 6252 | !-- 2) - WATER CALCULATION |
|---|
| 6253 | ! |
|---|
| 6254 | !-- a) The water content is calculated using the ZSR rule with solute |
|---|
| 6255 | !-- concentrations calculated using 1a above. Whilst the usual approximation of |
|---|
| 6256 | !-- ZSR relies on binary data consisting of 5th or higher order polynomials, in |
|---|
| 6257 | !-- this code 4 different RH regimes are used, each housing cubic equations for |
|---|
| 6258 | !-- the water associated with each solute listed above. Binary water contents |
|---|
| 6259 | !-- for inorganic components were calculated using AIM online (Clegg et al |
|---|
| 6260 | !-- 1998). The water associated with the organic compound is calculated assuming |
|---|
| 6261 | !-- ideality and that aw = RH. |
|---|
| 6262 | ! |
|---|
| 6263 | !-- b) Molality of each inorganic ion and organic solute (initial input) is |
|---|
| 6264 | !-- calculated for use in vapour pressure calculation. |
|---|
| 6265 | ! |
|---|
| 6266 | !-- 3) - BISULPHATE ION DISSOCIATION CALCULATION |
|---|
| 6267 | ! |
|---|
| 6268 | !-- The dissociation of the bisulphate ion is calculated explicitly. A solution |
|---|
| 6269 | !-- to the equilibrium equation between the bisulphate ion, hydrogen ion and |
|---|
| 6270 | !-- sulphate ion is found using tabulated equilibrium constants (referenced). It |
|---|
| 6271 | !-- is necessary to calculate the activity coefficients of HHSO4 and H2SO4 in a |
|---|
| 6272 | !-- non-iterative manner. These are calculated using the same format as |
|---|
| 6273 | !-- described in 4) below, where both activity coefficients were fit to the |
|---|
| 6274 | !-- output from ADDEM (Topping et al 2005a,b) covering an extensive composition |
|---|
| 6275 | !-- space, providing the activity coefficients and bisulphate ion dissociation |
|---|
| 6276 | !-- as a function of equivalent mole fractions and relative humidity. |
|---|
| 6277 | ! |
|---|
| 6278 | !-- NOTE: the flags "binary_case" and "full_complexity" are not used in this |
|---|
| 6279 | !-- prototype. They are used for simplification of the fit expressions when |
|---|
| 6280 | !-- using limited composition regions. This section of code calculates the |
|---|
| 6281 | !-- bisulphate ion concentration |
|---|
| 6282 | ! |
|---|
| 6283 | IF ( ions(1) > 0.0_wp .AND. ions(4) > 0.0_wp ) THEN |
|---|
| 6284 | ! |
|---|
| 6285 | !-- HHSO4: |
|---|
| 6286 | binary_case = 1 |
|---|
| 6287 | IF ( RH > 0.1_wp .AND. RH < 0.9_wp ) THEN |
|---|
| 6288 | binary_hhso4 = - 4.9521_wp * ( RH**3 ) + 9.2881_wp * ( RH**2 ) - & |
|---|
| 6289 | 10.777_wp * RH + 6.0534_wp |
|---|
| 6290 | ELSEIF ( RH >= 0.9_wp .AND. RH < 0.955_wp ) THEN |
|---|
| 6291 | binary_hhso4 = - 6.3777_wp * RH + 5.962_wp |
|---|
| 6292 | ELSEIF ( RH >= 0.955_wp .AND. RH < 0.99_wp ) THEN |
|---|
| 6293 | binary_hhso4 = 2367.2_wp * ( RH**3 ) - 6849.7_wp * ( RH**2 ) + & |
|---|
| 6294 | 6600.9_wp * RH - 2118.7_wp |
|---|
| 6295 | ELSEIF ( RH >= 0.99_wp .AND. RH < 0.9999_wp ) THEN |
|---|
| 6296 | binary_hhso4 = 3E-7_wp * ( RH**5 ) - 2E-5_wp * ( RH**4 ) + & |
|---|
| 6297 | 0.0004_wp * ( RH**3 ) - 0.0035_wp * ( RH**2 ) + & |
|---|
| 6298 | 0.0123_wp * RH - 0.3025_wp |
|---|
| 6299 | ENDIF |
|---|
| 6300 | |
|---|
| 6301 | IF ( nitric_acid > 0.0_wp ) THEN |
|---|
| 6302 | HNO3_hhso4 = - 4.2204_wp * ( RH**4 ) + 12.193_wp * ( RH**3 ) - & |
|---|
| 6303 | 12.481_wp * ( RH**2 ) + 6.459_wp * RH - 1.9004_wp |
|---|
| 6304 | ENDIF |
|---|
| 6305 | |
|---|
| 6306 | IF ( hydrochloric_acid > 0.0_wp ) THEN |
|---|
| 6307 | HCL_hhso4 = - 54.845_wp * ( RH**7 ) + 209.54_wp * ( RH**6 ) - & |
|---|
| 6308 | 336.59_wp * ( RH**5 ) + 294.21_wp * ( RH**4 ) - & |
|---|
| 6309 | 150.07_wp * ( RH**3 ) + 43.767_wp * ( RH**2 ) - & |
|---|
| 6310 | 6.5495_wp * RH + 0.60048_wp |
|---|
| 6311 | ENDIF |
|---|
| 6312 | |
|---|
| 6313 | IF ( ammonium_sulphate > 0.0_wp ) THEN |
|---|
| 6314 | NH42SO4_hhso4 = 16.768_wp * ( RH**3 ) - 28.75_wp * ( RH**2 ) + & |
|---|
| 6315 | 20.011_wp * RH - 8.3206_wp |
|---|
| 6316 | ENDIF |
|---|
| 6317 | |
|---|
| 6318 | IF ( ammonium_nitrate > 0.0_wp ) THEN |
|---|
| 6319 | NH4NO3_hhso4 = - 17.184_wp * ( RH**4 ) + 56.834_wp * ( RH**3 ) - & |
|---|
| 6320 | 65.765_wp * ( RH**2 ) + 35.321_wp * RH - 9.252_wp |
|---|
| 6321 | ENDIF |
|---|
| 6322 | |
|---|
| 6323 | IF (ammonium_chloride > 0.0_wp ) THEN |
|---|
| 6324 | IF ( RH < 0.2_wp .AND. RH >= 0.1_wp ) THEN |
|---|
| 6325 | NH4Cl_hhso4 = 3.2809_wp * RH - 2.0637_wp |
|---|
| 6326 | ELSEIF ( RH >= 0.2_wp .AND. RH < 0.99_wp ) THEN |
|---|
| 6327 | NH4Cl_hhso4 = - 1.2981_wp * ( RH**3 ) + 4.7461_wp * ( RH**2 ) - & |
|---|
| 6328 | 2.3269_wp * RH - 1.1259_wp |
|---|
| 6329 | ENDIF |
|---|
| 6330 | ENDIF |
|---|
| 6331 | |
|---|
| 6332 | IF ( sodium_sulphate > 0.0_wp ) THEN |
|---|
| 6333 | Na2SO4_hhso4 = 118.87_wp * ( RH**6 ) - 358.63_wp * ( RH**5 ) + & |
|---|
| 6334 | 435.85_wp * ( RH**4 ) - 272.88_wp * ( RH**3 ) + & |
|---|
| 6335 | 94.411_wp * ( RH**2 ) - 18.21_wp * RH + 0.45935_wp |
|---|
| 6336 | ENDIF |
|---|
| 6337 | |
|---|
| 6338 | IF ( sodium_nitrate > 0.0_wp ) THEN |
|---|
| 6339 | IF ( RH < 0.2_wp .AND. RH >= 0.1_wp ) THEN |
|---|
| 6340 | NaNO3_hhso4 = 4.8456_wp * RH - 2.5773_wp |
|---|
| 6341 | ELSEIF ( RH >= 0.2_wp .AND. RH < 0.99_wp ) THEN |
|---|
| 6342 | NaNO3_hhso4 = 0.5964_wp * ( RH**3 ) - 0.38967_wp * ( RH**2 ) + & |
|---|
| 6343 | 1.7918_wp * RH - 1.9691_wp |
|---|
| 6344 | ENDIF |
|---|
| 6345 | ENDIF |
|---|
| 6346 | |
|---|
| 6347 | IF ( sodium_chloride > 0.0_wp ) THEN |
|---|
| 6348 | IF ( RH < 0.2_wp ) THEN |
|---|
| 6349 | NaCl_hhso4 = 0.51995_wp * RH - 1.3981_wp |
|---|
| 6350 | ELSEIF ( RH >= 0.2_wp .AND. RH < 0.99_wp ) THEN |
|---|
| 6351 | NaCl_hhso4 = 1.6539_wp * RH - 1.6101_wp |
|---|
| 6352 | ENDIF |
|---|
| 6353 | ENDIF |
|---|
| 6354 | |
|---|
| 6355 | Ln_hhso4_act = binary_hhso4 + & |
|---|
| 6356 | nitric_acid_eq_frac * HNO3_hhso4 + & |
|---|
| 6357 | hydrochloric_acid_eq_frac * HCL_hhso4 + & |
|---|
| 6358 | ammonium_sulphate_eq_frac * NH42SO4_hhso4 + & |
|---|
| 6359 | ammonium_nitrate_eq_frac * NH4NO3_hhso4 + & |
|---|
| 6360 | ammonium_chloride_eq_frac * NH4Cl_hhso4 + & |
|---|
| 6361 | sodium_sulphate_eq_frac * Na2SO4_hhso4 + & |
|---|
| 6362 | sodium_nitrate_eq_frac * NaNO3_hhso4 + & |
|---|
| 6363 | sodium_chloride_eq_frac * NaCl_hhso4 |
|---|
| 6364 | gamma_hhso4 = EXP( Ln_hhso4_act ) ! molal activity coefficient of HHSO4 |
|---|
| 6365 | |
|---|
| 6366 | !-- H2SO4 (sulphuric acid): |
|---|
| 6367 | IF ( RH >= 0.1_wp .AND. RH < 0.9_wp ) THEN |
|---|
| 6368 | binary_h2so4 = 2.4493_wp * ( RH**2 ) - 6.2326_wp * RH + 2.1763_wp |
|---|
| 6369 | ELSEIF ( RH >= 0.9_wp .AND. RH < 0.98 ) THEN |
|---|
| 6370 | binary_h2so4 = 914.68_wp * ( RH**3 ) - 2502.3_wp * ( RH**2 ) + & |
|---|
| 6371 | 2281.9_wp * RH - 695.11_wp |
|---|
| 6372 | ELSEIF ( RH >= 0.98 .AND. RH < 0.9999 ) THEN |
|---|
| 6373 | binary_h2so4 = 3E-8_wp * ( RH**4 ) - 5E-6_wp * ( RH**3 ) + & |
|---|
| 6374 | 0.0003_wp * ( RH**2 ) - 0.0022_wp * RH - 1.1305_wp |
|---|
| 6375 | ENDIF |
|---|
| 6376 | |
|---|
| 6377 | IF ( nitric_acid > 0.0_wp ) THEN |
|---|
| 6378 | HNO3_h2so4 = - 16.382_wp * ( RH**5 ) + 46.677_wp * ( RH**4 ) - & |
|---|
| 6379 | 54.149_wp * ( RH**3 ) + 34.36_wp * ( RH**2 ) - & |
|---|
| 6380 | 12.54_wp * RH + 2.1368_wp |
|---|
| 6381 | ENDIF |
|---|
| 6382 | |
|---|
| 6383 | IF ( hydrochloric_acid > 0.0_wp ) THEN |
|---|
| 6384 | HCL_h2so4 = - 14.409_wp * ( RH**5 ) + 42.804_wp * ( RH**4 ) - & |
|---|
| 6385 | 47.24_wp * ( RH**3 ) + 24.668_wp * ( RH**2 ) - & |
|---|
| 6386 | 5.8015_wp * RH + 0.084627_wp |
|---|
| 6387 | ENDIF |
|---|
| 6388 | |
|---|
| 6389 | IF ( ammonium_sulphate > 0.0_wp ) THEN |
|---|
| 6390 | NH42SO4_h2so4 = 66.71_wp * ( RH**5 ) - 187.5_wp * ( RH**4 ) + & |
|---|
| 6391 | 210.57_wp * ( RH**3 ) - 121.04_wp * ( RH**2 ) + & |
|---|
| 6392 | 39.182_wp * RH - 8.0606_wp |
|---|
| 6393 | ENDIF |
|---|
| 6394 | |
|---|
| 6395 | IF ( ammonium_nitrate > 0.0_wp ) THEN |
|---|
| 6396 | NH4NO3_h2so4 = - 22.532_wp * ( RH**4 ) + 66.615_wp * ( RH**3 ) - & |
|---|
| 6397 | 74.647_wp * ( RH**2 ) + 37.638_wp * RH - 6.9711_wp |
|---|
| 6398 | ENDIF |
|---|
| 6399 | |
|---|
| 6400 | IF ( ammonium_chloride > 0.0_wp ) THEN |
|---|
| 6401 | IF ( RH >= 0.1_wp .AND. RH < 0.2_wp ) THEN |
|---|
| 6402 | NH4Cl_h2so4 = - 0.32089_wp * RH + 0.57738_wp |
|---|
| 6403 | ELSEIF ( RH >= 0.2_wp .AND. RH < 0.9_wp ) THEN |
|---|
| 6404 | NH4Cl_h2so4 = 18.089_wp * ( RH**5 ) - 51.083_wp * ( RH**4 ) + & |
|---|
| 6405 | 50.32_wp * ( RH**3 ) - 17.012_wp * ( RH**2 ) - & |
|---|
| 6406 | 0.93435_wp * RH + 1.0548_wp |
|---|
| 6407 | ELSEIF ( RH >= 0.9_wp .AND. RH < 0.99_wp ) THEN |
|---|
| 6408 | NH4Cl_h2so4 = - 1.5749_wp * RH + 1.7002_wp |
|---|
| 6409 | ENDIF |
|---|
| 6410 | ENDIF |
|---|
| 6411 | |
|---|
| 6412 | IF ( sodium_sulphate > 0.0_wp ) THEN |
|---|
| 6413 | Na2SO4_h2so4 = 29.843_wp * ( RH**4 ) - 69.417_wp * ( RH**3 ) + & |
|---|
| 6414 | 61.507_wp * ( RH**2 ) - 29.874_wp * RH + 7.7556_wp |
|---|
| 6415 | ENDIF |
|---|
| 6416 | |
|---|
| 6417 | IF ( sodium_nitrate > 0.0_wp ) THEN |
|---|
| 6418 | NaNO3_h2so4 = - 122.37_wp * ( RH**6 ) + 427.43_wp * ( RH**5 ) - & |
|---|
| 6419 | 604.68_wp * ( RH**4 ) + 443.08_wp * ( RH**3 ) - & |
|---|
| 6420 | 178.61_wp * ( RH**2 ) + 37.242_wp * RH - 1.9564_wp |
|---|
| 6421 | ENDIF |
|---|
| 6422 | |
|---|
| 6423 | IF ( sodium_chloride > 0.0_wp ) THEN |
|---|
| 6424 | NaCl_h2so4 = - 40.288_wp * ( RH**5 ) + 115.61_wp * ( RH**4 ) - & |
|---|
| 6425 | 129.99_wp * ( RH**3 ) + 72.652_wp * ( RH**2 ) - & |
|---|
| 6426 | 22.124_wp * RH + 4.2676_wp |
|---|
| 6427 | ENDIF |
|---|
| 6428 | |
|---|
| 6429 | Ln_h2so4_act = binary_h2so4 + & |
|---|
| 6430 | nitric_acid_eq_frac * HNO3_h2so4 + & |
|---|
| 6431 | hydrochloric_acid_eq_frac * HCL_h2so4 + & |
|---|
| 6432 | ammonium_sulphate_eq_frac * NH42SO4_h2so4 + & |
|---|
| 6433 | ammonium_nitrate_eq_frac * NH4NO3_h2so4 + & |
|---|
| 6434 | ammonium_chloride_eq_frac * NH4Cl_h2so4 + & |
|---|
| 6435 | sodium_sulphate_eq_frac * Na2SO4_h2so4 + & |
|---|
| 6436 | sodium_nitrate_eq_frac * NaNO3_h2so4 + & |
|---|
| 6437 | sodium_chloride_eq_frac * NaCl_h2so4 |
|---|
| 6438 | |
|---|
| 6439 | gamma_h2so4 = EXP( Ln_h2so4_act ) ! molal activity coefficient |
|---|
| 6440 | ! |
|---|
| 6441 | !-- Export activity coefficients |
|---|
| 6442 | IF ( gamma_h2so4 > 1.0E-10_wp ) THEN |
|---|
| 6443 | gamma_out(4) = ( gamma_hhso4**2.0_wp ) / gamma_h2so4 |
|---|
| 6444 | ENDIF |
|---|
| 6445 | IF ( gamma_hhso4 > 1.0E-10_wp ) THEN |
|---|
| 6446 | gamma_out(5) = ( gamma_h2so4**3.0_wp ) / ( gamma_hhso4**2.0_wp ) |
|---|
| 6447 | ENDIF |
|---|
| 6448 | ! |
|---|
| 6449 | !-- Ionic activity coefficient product |
|---|
| 6450 | act_product = ( gamma_h2so4**3.0_wp ) / ( gamma_hhso4**2.0_wp ) |
|---|
| 6451 | ! |
|---|
| 6452 | !-- Solve the quadratic equation (i.e. x in ax**2 + bx + c = 0) |
|---|
| 6453 | a = 1.0_wp |
|---|
| 6454 | b = - 1.0_wp * ( ions(4) + ions(1) + ( ( water_total * 18.0E-3_wp ) / & |
|---|
| 6455 | ( 99.0_wp * act_product ) ) ) |
|---|
| 6456 | c = ions(4) * ions(1) |
|---|
| 6457 | root1 = ( ( -1.0_wp * b ) + ( ( ( b**2 ) - 4.0_wp * a * c )**0.5_wp & |
|---|
| 6458 | ) ) / ( 2 * a ) |
|---|
| 6459 | root2 = ( ( -1.0_wp * b ) - ( ( ( b**2 ) - 4.0_wp * a * c) **0.5_wp & |
|---|
| 6460 | ) ) / ( 2 * a ) |
|---|
| 6461 | |
|---|
| 6462 | IF ( root1 > ions(1) .OR. root1 < 0.0_wp ) THEN |
|---|
| 6463 | root1 = 0.0_wp |
|---|
| 6464 | ENDIF |
|---|
| 6465 | |
|---|
| 6466 | IF ( root2 > ions(1) .OR. root2 < 0.0_wp ) THEN |
|---|
| 6467 | root2 = 0.0_wp |
|---|
| 6468 | ENDIF |
|---|
| 6469 | ! |
|---|
| 6470 | !-- Calculate the new hydrogen ion, bisulphate ion and sulphate ion |
|---|
| 6471 | !-- concentration |
|---|
| 6472 | hso4_real = 0.0_wp |
|---|
| 6473 | h_real = ions(1) |
|---|
| 6474 | so4_real = ions(4) |
|---|
| 6475 | IF ( root1 == 0.0_wp ) THEN |
|---|
| 6476 | hso4_real = root2 |
|---|
| 6477 | ELSEIF ( root2 == 0.0_wp ) THEN |
|---|
| 6478 | hso4_real = root1 |
|---|
| 6479 | ENDIF |
|---|
| 6480 | h_real = ions(1) - hso4_real |
|---|
| 6481 | so4_real = ions(4) - hso4_real |
|---|
| 6482 | ! |
|---|
| 6483 | !-- Recalculate ion molalities |
|---|
| 6484 | ions_mol(1) = h_real / ( water_total * 18.01528E-3_wp ) ! H+ |
|---|
| 6485 | ions_mol(4) = so4_real / ( water_total * 18.01528E-3_wp ) ! SO4(2-) |
|---|
| 6486 | ions_mol(5) = hso4_real / ( water_total * 18.01528E-3_wp ) ! HSO4(2-) |
|---|
| 6487 | |
|---|
| 6488 | h_out = h_real |
|---|
| 6489 | hso4_out = hso4_real |
|---|
| 6490 | so4_out = so4_real |
|---|
| 6491 | |
|---|
| 6492 | ELSEIF ( ions(1) == 0.0_wp .OR. ions(4) == 0.0_wp ) THEN |
|---|
| 6493 | h_out = ions(1) |
|---|
| 6494 | hso4_out = 0.0_wp |
|---|
| 6495 | so4_out = ions(4) |
|---|
| 6496 | ENDIF |
|---|
| 6497 | |
|---|
| 6498 | ! |
|---|
| 6499 | !-- 4) ACTIVITY COEFFICIENTS -for vapour pressures of HNO3,HCL and NH3 |
|---|
| 6500 | ! |
|---|
| 6501 | !-- This section evaluates activity coefficients and vapour pressures using the |
|---|
| 6502 | !-- water content calculated above) for each inorganic condensing species: |
|---|
| 6503 | !-- a - HNO3, b - NH3, c - HCL. |
|---|
| 6504 | !-- The following procedure is used: |
|---|
| 6505 | !-- Zaveri et al (2005) found that one could express the variation of activity |
|---|
| 6506 | !-- coefficients linearly in log-space if equivalent mole fractions were used. |
|---|
| 6507 | !-- So, by a taylor series expansion LOG( activity coefficient ) = |
|---|
| 6508 | !-- LOG( binary activity coefficient at a given RH ) + |
|---|
| 6509 | !-- (equivalent mole fraction compound A) * |
|---|
| 6510 | !-- ('interaction' parameter between A and condensing species) + |
|---|
| 6511 | !-- equivalent mole fraction compound B) * |
|---|
| 6512 | !-- ('interaction' parameter between B and condensing species). |
|---|
| 6513 | !-- Here, the interaction parameters have been fit to ADDEM by searching the |
|---|
| 6514 | !-- whole compositon space and fit usign the Levenberg-Marquardt non-linear |
|---|
| 6515 | !-- least squares algorithm. |
|---|
| 6516 | ! |
|---|
| 6517 | !-- They are given as a function of RH and vary with complexity ranging from |
|---|
| 6518 | !-- linear to 5th order polynomial expressions, the binary activity coefficients |
|---|
| 6519 | !-- were calculated using AIM online. |
|---|
| 6520 | !-- NOTE: for NH3, no binary activity coefficient was used and the data were fit |
|---|
| 6521 | !-- to the ratio of the activity coefficients for the ammonium and hydrogen |
|---|
| 6522 | !-- ions. Once the activity coefficients are obtained the vapour pressure can be |
|---|
| 6523 | !-- easily calculated using tabulated equilibrium constants (referenced). This |
|---|
| 6524 | !-- procedure differs from that of Zaveri et al (2005) in that it is not assumed |
|---|
| 6525 | !-- one can carry behaviour from binary mixtures in multicomponent systems. To |
|---|
| 6526 | !-- this end we have fit the 'interaction' parameters explicitly to a general |
|---|
| 6527 | !-- inorganic equilibrium model (ADDEM - Topping et al. 2005a,b). Such |
|---|
| 6528 | !-- parameters take into account bisulphate ion dissociation and water content. |
|---|
| 6529 | !-- This also allows us to consider one regime for all composition space, rather |
|---|
| 6530 | !-- than defining sulphate rich and sulphate poor regimes |
|---|
| 6531 | !-- NOTE: The flags "binary_case" and "full_complexity" are not used in this |
|---|
| 6532 | !-- prototype. They are used for simplification of the fit expressions when |
|---|
| 6533 | !-- using limited composition regions. |
|---|
| 6534 | ! |
|---|
| 6535 | !-- a) - ACTIVITY COEFF/VAPOUR PRESSURE - HNO3 |
|---|
| 6536 | IF ( ions(1) > 0.0_wp .AND. ions(6) > 0.0_wp ) THEN |
|---|
| 6537 | binary_case = 1 |
|---|
| 6538 | IF ( RH > 0.1_wp .AND. RH < 0.98_wp ) THEN |
|---|
| 6539 | IF ( binary_case == 1 ) THEN |
|---|
| 6540 | binary_hno3 = 1.8514_wp * ( RH**3 ) - 4.6991_wp * ( RH**2 ) + & |
|---|
| 6541 | 1.5514_wp * RH + 0.90236_wp |
|---|
| 6542 | ELSEIF ( binary_case == 2 ) THEN |
|---|
| 6543 | binary_hno3 = - 1.1751_wp * ( RH**2 ) - 0.53794_wp * RH + & |
|---|
| 6544 | 1.2808_wp |
|---|
| 6545 | ENDIF |
|---|
| 6546 | ELSEIF ( RH >= 0.98_wp .AND. RH < 0.9999_wp ) THEN |
|---|
| 6547 | binary_hno3 = 1244.69635941351_wp * ( RH**3 ) - & |
|---|
| 6548 | 2613.93941099991_wp * ( RH**2 ) + & |
|---|
| 6549 | 1525.0684974546_wp * RH -155.946764059316_wp |
|---|
| 6550 | ENDIF |
|---|
| 6551 | ! |
|---|
| 6552 | !-- Contributions from other solutes |
|---|
| 6553 | full_complexity = 1 |
|---|
| 6554 | IF ( hydrochloric_acid > 0.0_wp ) THEN ! HCL |
|---|
| 6555 | IF ( full_complexity == 1 .OR. RH < 0.4_wp ) THEN |
|---|
| 6556 | HCL_hno3 = 16.051_wp * ( RH**4 ) - 44.357_wp * ( RH**3 ) + & |
|---|
| 6557 | 45.141_wp * ( RH**2 ) - 21.638_wp * RH + 4.8182_wp |
|---|
| 6558 | ELSEIF ( full_complexity == 0 .AND. RH > 0.4_wp ) THEN |
|---|
| 6559 | HCL_hno3 = - 1.5833_wp * RH + 1.5569_wp |
|---|
| 6560 | ENDIF |
|---|
| 6561 | ENDIF |
|---|
| 6562 | |
|---|
| 6563 | IF ( sulphuric_acid > 0.0_wp ) THEN ! H2SO4 |
|---|
| 6564 | IF ( full_complexity == 1 .OR. RH < 0.4_wp ) THEN |
|---|
| 6565 | H2SO4_hno3 = - 3.0849_wp * ( RH**3 ) + 5.9609_wp * ( RH**2 ) - & |
|---|
| 6566 | 4.468_wp * RH + 1.5658_wp |
|---|
| 6567 | ELSEIF ( full_complexity == 0 .AND. RH > 0.4_wp ) THEN |
|---|
| 6568 | H2SO4_hno3 = - 0.93473_wp * RH + 0.9363_wp |
|---|
| 6569 | ENDIF |
|---|
| 6570 | ENDIF |
|---|
| 6571 | |
|---|
| 6572 | IF ( ammonium_sulphate > 0.0_wp ) THEN ! NH42SO4 |
|---|
| 6573 | NH42SO4_hno3 = 16.821_wp * ( RH**3 ) - 28.391_wp * ( RH**2 ) + & |
|---|
| 6574 | 18.133_wp * RH - 6.7356_wp |
|---|
| 6575 | ENDIF |
|---|
| 6576 | |
|---|
| 6577 | IF ( ammonium_nitrate > 0.0_wp ) THEN ! NH4NO3 |
|---|
| 6578 | NH4NO3_hno3 = 11.01_wp * ( RH**3 ) - 21.578_wp * ( RH**2 ) + & |
|---|
| 6579 | 14.808_wp * RH - 4.2593_wp |
|---|
| 6580 | ENDIF |
|---|
| 6581 | |
|---|
| 6582 | IF ( ammonium_chloride > 0.0_wp ) THEN ! NH4Cl |
|---|
| 6583 | IF ( full_complexity == 1 .OR. RH <= 0.4_wp ) THEN |
|---|
| 6584 | NH4Cl_hno3 = - 1.176_wp * ( RH**3 ) + 5.0828_wp * ( RH**2 ) - & |
|---|
| 6585 | 3.8792_wp * RH - 0.05518_wp |
|---|
| 6586 | ELSEIF ( full_complexity == 0 .AND. RH > 0.4_wp ) THEN |
|---|
| 6587 | NH4Cl_hno3 = 2.6219_wp * ( RH**2 ) - 2.2609_wp * RH - 0.38436_wp |
|---|
| 6588 | ENDIF |
|---|
| 6589 | ENDIF |
|---|
| 6590 | |
|---|
| 6591 | IF ( sodium_sulphate > 0.0_wp ) THEN ! Na2SO4 |
|---|
| 6592 | Na2SO4_hno3 = 35.504_wp * ( RH**4 ) - 80.101_wp * ( RH**3 ) + & |
|---|
| 6593 | 67.326_wp * ( RH**2 ) - 28.461_wp * RH + 5.6016_wp |
|---|
| 6594 | ENDIF |
|---|
| 6595 | |
|---|
| 6596 | IF ( sodium_nitrate > 0.0_wp ) THEN ! NaNO3 |
|---|
| 6597 | IF ( full_complexity == 1 .OR. RH <= 0.4_wp ) THEN |
|---|
| 6598 | NaNO3_hno3 = 23.659_wp * ( RH**5 ) - 66.917_wp * ( RH**4 ) + & |
|---|
| 6599 | 74.686_wp * ( RH**3 ) - 40.795_wp * ( RH**2 ) + & |
|---|
| 6600 | 10.831_wp * RH - 1.4701_wp |
|---|
| 6601 | ELSEIF ( full_complexity == 0 .AND. RH > 0.4_wp ) THEN |
|---|
| 6602 | NaNO3_hno3 = 14.749_wp * ( RH**4 ) - 35.237_wp * ( RH**3 ) + & |
|---|
| 6603 | 31.196_wp * ( RH**2 ) - 12.076_wp * RH + 1.3605_wp |
|---|
| 6604 | ENDIF |
|---|
| 6605 | ENDIF |
|---|
| 6606 | |
|---|
| 6607 | IF ( sodium_chloride > 0.0_wp ) THEN ! NaCl |
|---|
| 6608 | IF ( full_complexity == 1 .OR. RH <= 0.4_wp ) THEN |
|---|
| 6609 | NaCl_hno3 = 13.682_wp * ( RH**4 ) - 35.122_wp * ( RH**3 ) + & |
|---|
| 6610 | 33.397_wp * ( RH**2 ) - 14.586_wp * RH + 2.6276_wp |
|---|
| 6611 | ELSEIF ( full_complexity == 0 .AND. RH > 0.4_wp ) THEN |
|---|
| 6612 | NaCl_hno3 = 1.1882_wp * ( RH**3 ) - 1.1037_wp * ( RH**2 ) - & |
|---|
| 6613 | 0.7642_wp * RH + 0.6671_wp |
|---|
| 6614 | ENDIF |
|---|
| 6615 | ENDIF |
|---|
| 6616 | |
|---|
| 6617 | Ln_HNO3_act = binary_hno3 + & |
|---|
| 6618 | hydrochloric_acid_eq_frac * HCL_hno3 + & |
|---|
| 6619 | sulphuric_acid_eq_frac * H2SO4_hno3 + & |
|---|
| 6620 | ammonium_sulphate_eq_frac * NH42SO4_hno3 + & |
|---|
| 6621 | ammonium_nitrate_eq_frac * NH4NO3_hno3 + & |
|---|
| 6622 | ammonium_chloride_eq_frac * NH4Cl_hno3 + & |
|---|
| 6623 | sodium_sulphate_eq_frac * Na2SO4_hno3 + & |
|---|
| 6624 | sodium_nitrate_eq_frac * NaNO3_hno3 + & |
|---|
| 6625 | sodium_chloride_eq_frac * NaCl_hno3 |
|---|
| 6626 | |
|---|
| 6627 | gamma_hno3 = EXP( Ln_HNO3_act ) ! Molal activity coefficient of HNO3 |
|---|
| 6628 | gamma_out(1) = gamma_hno3 |
|---|
| 6629 | ! |
|---|
| 6630 | !-- Partial pressure calculation |
|---|
| 6631 | !-- K_hno3 = 2.51 * ( 10**6 ) |
|---|
| 6632 | !-- K_hno3 = 2.628145923d6 !< calculated by AIM online (Clegg et al 1998) |
|---|
| 6633 | !-- after Chameides (1984) (and NIST database) |
|---|
| 6634 | K_hno3 = 2.6E6_wp * EXP( 8700.0_wp * henrys_temp_dep) |
|---|
| 6635 | Press_HNO3 = ( ions_mol(1) * ions_mol(6) * ( gamma_hno3**2 ) ) / & |
|---|
| 6636 | K_hno3 |
|---|
| 6637 | ENDIF |
|---|
| 6638 | ! |
|---|
| 6639 | !-- b) - ACTIVITY COEFF/VAPOUR PRESSURE - NH3 |
|---|
| 6640 | !-- Follow the two solute approach of Zaveri et al. (2005) |
|---|
| 6641 | IF ( ions(2) > 0.0_wp .AND. ions_mol(1) > 0.0_wp ) THEN |
|---|
| 6642 | !-- NH4HSO4: |
|---|
| 6643 | binary_nh4hso4 = 56.907_wp * ( RH**6 ) - 155.32_wp * ( RH**5 ) + & |
|---|
| 6644 | 142.94_wp * ( RH**4 ) - 32.298_wp * ( RH**3 ) - & |
|---|
| 6645 | 27.936_wp * ( RH**2 ) + 19.502_wp * RH - 4.2618_wp |
|---|
| 6646 | IF ( nitric_acid > 0.0_wp) THEN ! HNO3 |
|---|
| 6647 | HNO3_nh4hso4 = 104.8369_wp * ( RH**8 ) - 288.8923_wp * ( RH**7 ) + & |
|---|
| 6648 | 129.3445_wp * ( RH**6 ) + 373.0471_wp * ( RH**5 ) - & |
|---|
| 6649 | 571.0385_wp * ( RH**4 ) + 326.3528_wp * ( RH**3 ) - & |
|---|
| 6650 | 74.169_wp * ( RH**2 ) - 2.4999_wp * RH + 3.17_wp |
|---|
| 6651 | ENDIF |
|---|
| 6652 | |
|---|
| 6653 | IF ( hydrochloric_acid > 0.0_wp) THEN ! HCL |
|---|
| 6654 | HCL_nh4hso4 = - 7.9133_wp * ( RH**8 ) + 126.6648_wp * ( RH**7 ) - & |
|---|
| 6655 | 460.7425_wp * ( RH**6 ) + 731.606_wp * ( RH**5 ) - & |
|---|
| 6656 | 582.7467_wp * ( RH**4 ) + 216.7197_wp * ( RH**3 ) - & |
|---|
| 6657 | 11.3934_wp * ( RH**2 ) - 17.7728_wp * RH + 5.75_wp |
|---|
| 6658 | ENDIF |
|---|
| 6659 | |
|---|
| 6660 | IF ( sulphuric_acid > 0.0_wp) THEN ! H2SO4 |
|---|
| 6661 | H2SO4_nh4hso4 = 195.981_wp * ( RH**8 ) - 779.2067_wp * ( RH**7 ) + & |
|---|
| 6662 | 1226.3647_wp * ( RH**6 ) - 964.0261_wp * ( RH**5 ) + & |
|---|
| 6663 | 391.7911_wp * ( RH**4 ) - 84.1409_wp * ( RH**3 ) + & |
|---|
| 6664 | 20.0602_wp * ( RH**2 ) - 10.2663_wp * RH + 3.5817_wp |
|---|
| 6665 | ENDIF |
|---|
| 6666 | |
|---|
| 6667 | IF ( ammonium_sulphate > 0.0_wp) THEN ! NH42SO4 |
|---|
| 6668 | NH42SO4_nh4hso4 = 617.777_wp * ( RH**8 ) - 2547.427_wp * ( RH**7 ) & |
|---|
| 6669 | + 4361.6009_wp * ( RH**6 ) - 4003.162_wp * ( RH**5 ) & |
|---|
| 6670 | + 2117.8281_wp * ( RH**4 ) - 640.0678_wp * ( RH**3 ) & |
|---|
| 6671 | + 98.0902_wp * ( RH**2 ) - 2.2615_wp * RH - 2.3811_wp |
|---|
| 6672 | ENDIF |
|---|
| 6673 | |
|---|
| 6674 | IF ( ammonium_nitrate > 0.0_wp) THEN ! NH4NO3 |
|---|
| 6675 | NH4NO3_nh4hso4 = - 104.4504_wp * ( RH**8 ) + 539.5921_wp * & |
|---|
| 6676 | ( RH**7 ) - 1157.0498_wp * ( RH**6 ) + 1322.4507_wp * & |
|---|
| 6677 | ( RH**5 ) - 852.2475_wp * ( RH**4 ) + 298.3734_wp * & |
|---|
| 6678 | ( RH**3 ) - 47.0309_wp * ( RH**2 ) + 1.297_wp * RH - & |
|---|
| 6679 | 0.8029_wp |
|---|
| 6680 | ENDIF |
|---|
| 6681 | |
|---|
| 6682 | IF ( ammonium_chloride > 0.0_wp) THEN ! NH4Cl |
|---|
| 6683 | NH4Cl_nh4hso4 = 258.1792_wp * ( RH**8 ) - 1019.3777_wp * & |
|---|
| 6684 | ( RH**7 ) + 1592.8918_wp * ( RH**6 ) - 1221.0726_wp * & |
|---|
| 6685 | ( RH**5 ) + 442.2548_wp * ( RH**4 ) - 43.6278_wp * & |
|---|
| 6686 | ( RH**3 ) - 7.5282_wp * ( RH**2 ) - 3.8459_wp * RH + 2.2728_wp |
|---|
| 6687 | ENDIF |
|---|
| 6688 | |
|---|
| 6689 | IF ( sodium_sulphate > 0.0_wp) THEN ! Na2SO4 |
|---|
| 6690 | Na2SO4_nh4hso4 = 225.4238_wp * ( RH**8 ) - 732.4113_wp * & |
|---|
| 6691 | ( RH**7 ) + 843.7291_wp * ( RH**6 ) - 322.7328_wp * & |
|---|
| 6692 | ( RH**5 ) - 88.6252_wp * ( RH**4 ) + 72.4434_wp * & |
|---|
| 6693 | ( RH**3 ) + 22.9252_wp * ( RH**2 ) - 25.3954_wp * RH + & |
|---|
| 6694 | 4.6971_wp |
|---|
| 6695 | ENDIF |
|---|
| 6696 | |
|---|
| 6697 | IF ( sodium_nitrate > 0.0_wp) THEN ! NaNO3 |
|---|
| 6698 | NaNO3_nh4hso4 = 96.1348_wp * ( RH**8 ) - 341.6738_wp * ( RH**7 ) + & |
|---|
| 6699 | 406.5314_wp * ( RH**6 ) - 98.5777_wp * ( RH**5 ) - & |
|---|
| 6700 | 172.8286_wp * ( RH**4 ) + 149.3151_wp * ( RH**3 ) - & |
|---|
| 6701 | 38.9998_wp * ( RH**2 ) - 0.2251 * RH + 0.4953_wp |
|---|
| 6702 | ENDIF |
|---|
| 6703 | |
|---|
| 6704 | IF ( sodium_chloride > 0.0_wp) THEN ! NaCl |
|---|
| 6705 | NaCl_nh4hso4 = 91.7856_wp * ( RH**8 ) - 316.6773_wp * ( RH**7 ) + & |
|---|
| 6706 | 358.2703_wp * ( RH**6 ) - 68.9142 * ( RH**5 ) - & |
|---|
| 6707 | 156.5031_wp * ( RH**4 ) + 116.9592_wp * ( RH**3 ) - & |
|---|
| 6708 | 22.5271_wp * ( RH**2 ) - 3.7716_wp * RH + 1.56_wp |
|---|
| 6709 | ENDIF |
|---|
| 6710 | |
|---|
| 6711 | Ln_NH4HSO4_act = binary_nh4hso4 + & |
|---|
| 6712 | nitric_acid_eq_frac * HNO3_nh4hso4 + & |
|---|
| 6713 | hydrochloric_acid_eq_frac * HCL_nh4hso4 + & |
|---|
| 6714 | sulphuric_acid_eq_frac * H2SO4_nh4hso4 + & |
|---|
| 6715 | ammonium_sulphate_eq_frac * NH42SO4_nh4hso4 + & |
|---|
| 6716 | ammonium_nitrate_eq_frac * NH4NO3_nh4hso4 + & |
|---|
| 6717 | ammonium_chloride_eq_frac * NH4Cl_nh4hso4 + & |
|---|
| 6718 | sodium_sulphate_eq_frac * Na2SO4_nh4hso4 + & |
|---|
| 6719 | sodium_nitrate_eq_frac * NaNO3_nh4hso4 + & |
|---|
| 6720 | sodium_chloride_eq_frac * NaCl_nh4hso4 |
|---|
| 6721 | |
|---|
| 6722 | gamma_nh4hso4 = EXP( Ln_NH4HSO4_act ) ! molal act. coefficient of NH4HSO4 |
|---|
| 6723 | !-- Molal activity coefficient of NO3- |
|---|
| 6724 | gamma_out(6) = gamma_nh4hso4 |
|---|
| 6725 | !-- Molal activity coefficient of NH4+ |
|---|
| 6726 | gamma_nh3 = ( gamma_nh4hso4**2 ) / ( gamma_hhso4**2 ) |
|---|
| 6727 | gamma_out(3) = gamma_nh3 |
|---|
| 6728 | ! |
|---|
| 6729 | !-- This actually represents the ratio of the ammonium to hydrogen ion |
|---|
| 6730 | !-- activity coefficients (see Zaveri paper) - multiply this by the ratio |
|---|
| 6731 | !-- of the ammonium to hydrogen ion molality and the ratio of appropriate |
|---|
| 6732 | !-- equilibrium constants |
|---|
| 6733 | ! |
|---|
| 6734 | !-- Equilibrium constants |
|---|
| 6735 | !-- Kh = 57.64d0 ! Zaveri et al. (2005) |
|---|
| 6736 | Kh = 5.8E1_wp * EXP( 4085.0_wp * henrys_temp_dep ) ! after Chameides |
|---|
| 6737 | ! ! (1984) (and NIST database) |
|---|
| 6738 | !-- Knh4 = 1.81E-5_wp ! Zaveri et al. (2005) |
|---|
| 6739 | Knh4 = 1.7E-5_wp * EXP( -4325.0_wp * henrys_temp_dep ) ! Chameides |
|---|
| 6740 | ! (1984) |
|---|
| 6741 | !-- Kw = 1.01E-14_wp ! Zaveri et al (2005) |
|---|
| 6742 | Kw = 1.E-14_wp * EXP( -6716.0_wp * henrys_temp_dep ) ! Chameides |
|---|
| 6743 | ! (1984) |
|---|
| 6744 | ! |
|---|
| 6745 | molality_ratio_nh3 = ions_mol(2) / ions_mol(1) |
|---|
| 6746 | !-- Partial pressure calculation |
|---|
| 6747 | Press_NH3 = molality_ratio_nh3 * gamma_nh3 * ( Kw / ( Kh * Knh4 ) ) |
|---|
| 6748 | |
|---|
| 6749 | ENDIF |
|---|
| 6750 | ! |
|---|
| 6751 | !-- c) - ACTIVITY COEFF/VAPOUR PRESSURE - HCL |
|---|
| 6752 | IF ( ions(1) > 0.0_wp .AND. ions(7) > 0.0_wp ) THEN |
|---|
| 6753 | binary_case = 1 |
|---|
| 6754 | IF ( RH > 0.1_wp .AND. RH < 0.98 ) THEN |
|---|
| 6755 | IF ( binary_case == 1 ) THEN |
|---|
| 6756 | binary_hcl = - 5.0179_wp * ( RH**3 ) + 9.8816_wp * ( RH**2 ) - & |
|---|
| 6757 | 10.789_wp * RH + 5.4737_wp |
|---|
| 6758 | ELSEIF ( binary_case == 2 ) THEN |
|---|
| 6759 | binary_hcl = - 4.6221_wp * RH + 4.2633_wp |
|---|
| 6760 | ENDIF |
|---|
| 6761 | ELSEIF ( RH >= 0.98_wp .AND. RH < 0.9999_wp ) THEN |
|---|
| 6762 | binary_hcl = 775.6111008626_wp * ( RH**3 ) - 2146.01320888771_wp * & |
|---|
| 6763 | ( RH**2 ) + 1969.01979670259_wp * RH - 598.878230033926_wp |
|---|
| 6764 | ENDIF |
|---|
| 6765 | ENDIF |
|---|
| 6766 | |
|---|
| 6767 | IF ( nitric_acid > 0.0_wp ) THEN ! HNO3 |
|---|
| 6768 | IF ( full_complexity == 1 .OR. RH <= 0.4_wp ) THEN |
|---|
| 6769 | HNO3_hcl = 9.6256_wp * ( RH**4 ) - 26.507_wp * ( RH**3 ) + & |
|---|
| 6770 | 27.622_wp * ( RH**2 ) - 12.958_wp * RH + 2.2193_wp |
|---|
| 6771 | ELSEIF ( full_complexity == 0 .AND. RH > 0.4_wp ) THEN |
|---|
| 6772 | HNO3_hcl = 1.3242_wp * ( RH**2 ) - 1.8827_wp * RH + 0.55706_wp |
|---|
| 6773 | ENDIF |
|---|
| 6774 | ENDIF |
|---|
| 6775 | |
|---|
| 6776 | IF ( sulphuric_acid > 0.0_wp ) THEN ! H2SO4 |
|---|
| 6777 | IF ( full_complexity == 1 .OR. RH <= 0.4 ) THEN |
|---|
| 6778 | H2SO4_hcl = 1.4406_wp * ( RH**3 ) - 2.7132_wp * ( RH**2 ) + & |
|---|
| 6779 | 1.014_wp * RH + 0.25226_wp |
|---|
| 6780 | ELSEIF ( full_complexity == 0 .AND. RH > 0.4_wp ) THEN |
|---|
| 6781 | H2SO4_hcl = 0.30993_wp * ( RH**2 ) - 0.99171_wp * RH + 0.66913_wp |
|---|
| 6782 | ENDIF |
|---|
| 6783 | ENDIF |
|---|
| 6784 | |
|---|
| 6785 | IF ( ammonium_sulphate > 0.0_wp ) THEN ! NH42SO4 |
|---|
| 6786 | NH42SO4_hcl = 22.071_wp * ( RH**3 ) - 40.678_wp * ( RH**2 ) + & |
|---|
| 6787 | 27.893_wp * RH - 9.4338_wp |
|---|
| 6788 | ENDIF |
|---|
| 6789 | |
|---|
| 6790 | IF ( ammonium_nitrate > 0.0_wp ) THEN ! NH4NO3 |
|---|
| 6791 | NH4NO3_hcl = 19.935_wp * ( RH**3 ) - 42.335_wp * ( RH**2 ) + & |
|---|
| 6792 | 31.275_wp * RH - 8.8675_wp |
|---|
| 6793 | ENDIF |
|---|
| 6794 | |
|---|
| 6795 | IF ( ammonium_chloride > 0.0_wp ) THEN ! NH4Cl |
|---|
| 6796 | IF ( full_complexity == 1 .OR. RH <= 0.4_wp ) THEN |
|---|
| 6797 | NH4Cl_hcl = 2.8048_wp * ( RH**3 ) - 4.3182_wp * ( RH**2 ) + & |
|---|
| 6798 | 3.1971_wp * RH - 1.6824_wp |
|---|
| 6799 | ELSEIF ( full_complexity == 0 .AND. RH > 0.4_wp ) THEN |
|---|
| 6800 | NH4Cl_hcl = 1.2304_wp * ( RH**2 ) - 0.18262_wp * RH - 1.0643_wp |
|---|
| 6801 | ENDIF |
|---|
| 6802 | ENDIF |
|---|
| 6803 | |
|---|
| 6804 | IF ( sodium_sulphate > 0.0_wp ) THEN ! Na2SO4 |
|---|
| 6805 | Na2SO4_hcl = 36.104_wp * ( RH**4 ) - 78.658_wp * ( RH**3 ) + & |
|---|
| 6806 | 63.441_wp * ( RH**2 ) - 26.727_wp * RH + 5.7007_wp |
|---|
| 6807 | ENDIF |
|---|
| 6808 | |
|---|
| 6809 | IF ( sodium_nitrate > 0.0_wp ) THEN ! NaNO3 |
|---|
| 6810 | IF ( full_complexity == 1 .OR. RH <= 0.4_wp ) THEN |
|---|
| 6811 | NaNO3_hcl = 54.471_wp * ( RH**5 ) - 159.42_wp * ( RH**4 ) + & |
|---|
| 6812 | 180.25_wp * ( RH**3 ) - 98.176_wp * ( RH**2 ) + & |
|---|
| 6813 | 25.309_wp * RH - 2.4275_wp |
|---|
| 6814 | ELSEIF ( full_complexity == 0 .AND. RH > 0.4_wp ) THEN |
|---|
| 6815 | NaNO3_hcl = 21.632_wp * ( RH**4 ) - 53.088_wp * ( RH**3 ) + & |
|---|
| 6816 | 47.285_wp * ( RH**2 ) - 18.519_wp * RH + 2.6846_wp |
|---|
| 6817 | ENDIF |
|---|
| 6818 | ENDIF |
|---|
| 6819 | |
|---|
| 6820 | IF ( sodium_chloride > 0.0_wp ) THEN ! NaCl |
|---|
| 6821 | IF ( full_complexity == 1 .OR. RH <= 0.4_wp ) THEN |
|---|
| 6822 | NaCl_hcl = 5.4138_wp * ( RH**4 ) - 12.079_wp * ( RH**3 ) + & |
|---|
| 6823 | 9.627_wp * ( RH**2 ) - 3.3164_wp * RH + 0.35224_wp |
|---|
| 6824 | ELSEIF ( full_complexity == 0 .AND. RH > 0.4_wp ) THEN |
|---|
| 6825 | NaCl_hcl = 2.432_wp * ( RH**3 ) - 4.3453_wp * ( RH**2 ) + & |
|---|
| 6826 | 2.3834_wp * RH - 0.4762_wp |
|---|
| 6827 | ENDIF |
|---|
| 6828 | ENDIF |
|---|
| 6829 | |
|---|
| 6830 | Ln_HCL_act = binary_hcl + & |
|---|
| 6831 | nitric_acid_eq_frac * HNO3_hcl + & |
|---|
| 6832 | sulphuric_acid_eq_frac * H2SO4_hcl + & |
|---|
| 6833 | ammonium_sulphate_eq_frac * NH42SO4_hcl + & |
|---|
| 6834 | ammonium_nitrate_eq_frac * NH4NO3_hcl + & |
|---|
| 6835 | ammonium_chloride_eq_frac * NH4Cl_hcl + & |
|---|
| 6836 | sodium_sulphate_eq_frac * Na2SO4_hcl + & |
|---|
| 6837 | sodium_nitrate_eq_frac * NaNO3_hcl + & |
|---|
| 6838 | sodium_chloride_eq_frac * NaCl_hcl |
|---|
| 6839 | |
|---|
| 6840 | gamma_hcl = EXP( Ln_HCL_act ) ! Molal activity coefficient |
|---|
| 6841 | gamma_out(2) = gamma_hcl |
|---|
| 6842 | ! |
|---|
| 6843 | !-- Equilibrium constant after Wagman et al. (1982) (and NIST database) |
|---|
| 6844 | K_hcl = 2E6_wp * EXP( 9000.0_wp * henrys_temp_dep ) |
|---|
| 6845 | |
|---|
| 6846 | Press_HCL = ( ions_mol(1) * ions_mol(7) * ( gamma_hcl**2 ) ) / K_hcl |
|---|
| 6847 | ! |
|---|
| 6848 | !-- 5) Ion molility output |
|---|
| 6849 | mols_out = ions_mol |
|---|
| 6850 | ! |
|---|
| 6851 | !-- REFERENCES |
|---|
| 6852 | !-- Clegg et al. (1998) A Thermodynamic Model of the System |
|---|
| 6853 | !-- H+-NH4+-Na+-SO42- -NO3--Cl--H2O at 298.15 K, J. Phys. Chem., 102A, |
|---|
| 6854 | !-- 2155-2171. |
|---|
| 6855 | !-- Clegg et al. (2001) Thermodynamic modelling of aqueous aerosols containing |
|---|
| 6856 | !-- electrolytes and dissolved organic compounds. Journal of Aerosol Science |
|---|
| 6857 | !-- 2001;32(6):713-738. |
|---|
| 6858 | !-- Topping et al. (2005a) A curved multi-component aerosol hygroscopicity model |
|---|
| 6859 | !-- framework: Part 1 - Inorganic compounds. Atmospheric Chemistry and |
|---|
| 6860 | !-- Physics 2005;5:1205-1222. |
|---|
| 6861 | !-- Topping et al. (2005b) A curved multi-component aerosol hygroscopicity model |
|---|
| 6862 | !-- framework: Part 2 - Including organic compounds. Atmospheric Chemistry |
|---|
| 6863 | !-- and Physics 2005;5:1223-1242. |
|---|
| 6864 | !-- Wagman et al. (1982). The NBS tables of chemical thermodynamic properties: |
|---|
| 6865 | !-- selected values for inorganic and Câ and Câ organic substances in SI |
|---|
| 6866 | !-- units (book) |
|---|
| 6867 | !-- Zaveri et al. (2005). A new method for multicomponent activity coefficients |
|---|
| 6868 | !-- of electrolytes in aqueous atmospheric aerosols, JGR, 110, D02201, 2005. |
|---|
| 6869 | END SUBROUTINE inorganic_pdfite |
|---|
| 6870 | |
|---|
| 6871 | !------------------------------------------------------------------------------! |
|---|
| 6872 | ! Description: |
|---|
| 6873 | ! ------------ |
|---|
| 6874 | !> Update the particle size distribution. Put particles into corrects bins. |
|---|
| 6875 | !> |
|---|
| 6876 | !> Moving-centre method assumed, i.e. particles are allowed to grow to their |
|---|
| 6877 | !> exact size as long as they are not crossing the fixed diameter bin limits. |
|---|
| 6878 | !> If the particles in a size bin cross the lower or upper diameter limit, they |
|---|
| 6879 | !> are all moved to the adjacent diameter bin and their volume is averaged with |
|---|
| 6880 | !> the particles in the new bin, which then get a new diameter. |
|---|
| 6881 | ! |
|---|
| 6882 | !> Moving-centre method minimises numerical diffusion. |
|---|
| 6883 | !------------------------------------------------------------------------------! |
|---|
| 6884 | SUBROUTINE distr_update( paero ) |
|---|
| 6885 | |
|---|
| 6886 | IMPLICIT NONE |
|---|
| 6887 | |
|---|
| 6888 | !-- Input and output variables |
|---|
| 6889 | TYPE(t_section), INTENT(inout) :: paero(fn2b) !< Aerosols particle |
|---|
| 6890 | !< size distribution and properties |
|---|
| 6891 | !-- Local variables |
|---|
| 6892 | INTEGER(iwp) :: b !< loop index |
|---|
| 6893 | INTEGER(iwp) :: mm !< loop index |
|---|
| 6894 | INTEGER(iwp) :: counti |
|---|
| 6895 | LOGICAL :: within_bins !< logical (particle belongs to the bin?) |
|---|
| 6896 | REAL(wp) :: znfrac !< number fraction to be moved to the larger bin |
|---|
| 6897 | REAL(wp) :: zvfrac !< volume fraction to be moved to the larger bin |
|---|
| 6898 | REAL(wp) :: zVexc !< Volume in the grown bin which exceeds the bin |
|---|
| 6899 | !< upper limit |
|---|
| 6900 | REAL(wp) :: zVihi !< particle volume at the high end of the bin |
|---|
| 6901 | REAL(wp) :: zVilo !< particle volume at the low end of the bin |
|---|
| 6902 | REAL(wp) :: zvpart !< particle volume (m3) |
|---|
| 6903 | REAL(wp) :: zVrat !< volume ratio of a size bin |
|---|
| 6904 | |
|---|
| 6905 | zvpart = 0.0_wp |
|---|
| 6906 | zvfrac = 0.0_wp |
|---|
| 6907 | |
|---|
| 6908 | within_bins = .FALSE. |
|---|
| 6909 | |
|---|
| 6910 | ! |
|---|
| 6911 | !-- Check if the volume of the bin is within bin limits after update |
|---|
| 6912 | counti = 0 |
|---|
| 6913 | DO WHILE ( .NOT. within_bins ) |
|---|
| 6914 | within_bins = .TRUE. |
|---|
| 6915 | |
|---|
| 6916 | DO b = fn2b-1, in1a, -1 |
|---|
| 6917 | mm = 0 |
|---|
| 6918 | IF ( paero(b)%numc > nclim ) THEN |
|---|
| 6919 | |
|---|
| 6920 | zvpart = 0.0_wp |
|---|
| 6921 | zvfrac = 0.0_wp |
|---|
| 6922 | |
|---|
| 6923 | IF ( b == fn2a ) CYCLE |
|---|
| 6924 | ! |
|---|
| 6925 | !-- Dry volume |
|---|
| 6926 | zvpart = SUM( paero(b)%volc(1:7) ) / paero(b)%numc |
|---|
| 6927 | ! |
|---|
| 6928 | !-- Smallest bin cannot decrease |
|---|
| 6929 | IF ( paero(b)%vlolim > zvpart .AND. b == in1a ) CYCLE |
|---|
| 6930 | ! |
|---|
| 6931 | !-- Decreasing bins |
|---|
| 6932 | IF ( paero(b)%vlolim > zvpart ) THEN |
|---|
| 6933 | mm = b - 1 |
|---|
| 6934 | IF ( b == in2b ) mm = fn1a ! 2b goes to 1a |
|---|
| 6935 | |
|---|
| 6936 | paero(mm)%numc = paero(mm)%numc + paero(b)%numc |
|---|
| 6937 | paero(b)%numc = 0.0_wp |
|---|
| 6938 | paero(mm)%volc(:) = paero(mm)%volc(:) + paero(b)%volc(:) |
|---|
| 6939 | paero(b)%volc(:) = 0.0_wp |
|---|
| 6940 | CYCLE |
|---|
| 6941 | ENDIF |
|---|
| 6942 | ! |
|---|
| 6943 | !-- If size bin has not grown, cycle |
|---|
| 6944 | !-- Changed by Mona: compare to the arithmetic mean volume, as done |
|---|
| 6945 | !-- originally. Now particle volume is derived from the geometric mean |
|---|
| 6946 | !-- diameter, not arithmetic (see SUBROUTINE set_sizebins). |
|---|
| 6947 | IF ( zvpart <= api6 * ( ( aero(b)%vhilim + aero(b)%vlolim ) / & |
|---|
| 6948 | ( 2.0_wp * api6 ) ) ) CYCLE |
|---|
| 6949 | IF ( ABS( zvpart - api6 * paero(b)%dmid ** 3.0_wp ) < & |
|---|
| 6950 | 1.0E-35_wp ) CYCLE ! Mona: to avoid precision problems |
|---|
| 6951 | ! |
|---|
| 6952 | !-- Volume ratio of the size bin |
|---|
| 6953 | zVrat = paero(b)%vhilim / paero(b)%vlolim |
|---|
| 6954 | !-- Particle volume at the low end of the bin |
|---|
| 6955 | zVilo = 2.0_wp * zvpart / ( 1.0_wp + zVrat ) |
|---|
| 6956 | !-- Particle volume at the high end of the bin |
|---|
| 6957 | zVihi = zVrat * zVilo |
|---|
| 6958 | !-- Volume in the grown bin which exceeds the bin upper limit |
|---|
| 6959 | zVexc = 0.5_wp * ( zVihi + paero(b)%vhilim ) |
|---|
| 6960 | !-- Number fraction to be moved to the larger bin |
|---|
| 6961 | znfrac = MIN( 1.0_wp, ( zVihi - paero(b)%vhilim) / & |
|---|
| 6962 | ( zVihi - zVilo ) ) |
|---|
| 6963 | !-- Volume fraction to be moved to the larger bin |
|---|
| 6964 | zvfrac = MIN( 0.99_wp, znfrac * zVexc / zvpart ) |
|---|
| 6965 | IF ( zvfrac < 0.0_wp ) THEN |
|---|
| 6966 | message_string = 'Error: zvfrac < 0' |
|---|
| 6967 | CALL message( 'salsa_mod: distr_update', 'SA0050', & |
|---|
| 6968 | 1, 2, 0, 6, 0 ) |
|---|
| 6969 | ENDIF |
|---|
| 6970 | ! |
|---|
| 6971 | !-- Update bin |
|---|
| 6972 | mm = b + 1 |
|---|
| 6973 | !-- Volume (cm3/cm3) |
|---|
| 6974 | paero(mm)%volc(:) = paero(mm)%volc(:) + znfrac * paero(b)%numc * & |
|---|
| 6975 | zVexc * paero(b)%volc(:) / & |
|---|
| 6976 | SUM( paero(b)%volc(1:7) ) |
|---|
| 6977 | paero(b)%volc(:) = paero(b)%volc(:) - znfrac * paero(b)%numc * & |
|---|
| 6978 | zVexc * paero(b)%volc(:) / & |
|---|
| 6979 | SUM( paero(b)%volc(1:7) ) |
|---|
| 6980 | |
|---|
| 6981 | !-- Number concentration (#/m3) |
|---|
| 6982 | paero(mm)%numc = paero(mm)%numc + znfrac * paero(b)%numc |
|---|
| 6983 | paero(b)%numc = paero(b)%numc * ( 1.0_wp - znfrac ) |
|---|
| 6984 | |
|---|
| 6985 | ENDIF ! nclim |
|---|
| 6986 | |
|---|
| 6987 | IF ( paero(b)%numc > nclim ) THEN |
|---|
| 6988 | zvpart = SUM( paero(b)%volc(1:7) ) / paero(b)%numc |
|---|
| 6989 | within_bins = ( paero(b)%vlolim < zvpart .AND. & |
|---|
| 6990 | zvpart < paero(b)%vhilim ) |
|---|
| 6991 | ENDIF |
|---|
| 6992 | |
|---|
| 6993 | ENDDO ! - b |
|---|
| 6994 | |
|---|
| 6995 | counti = counti + 1 |
|---|
| 6996 | IF ( counti > 100 ) THEN |
|---|
| 6997 | message_string = 'Error: Aerosol bin update not converged' |
|---|
| 6998 | CALL message( 'salsa_mod: distr_update', 'SA0051', 1, 2, 0, 6, 0 ) |
|---|
| 6999 | ENDIF |
|---|
| 7000 | |
|---|
| 7001 | ENDDO ! - within bins |
|---|
| 7002 | |
|---|
| 7003 | END SUBROUTINE distr_update |
|---|
| 7004 | |
|---|
| 7005 | !------------------------------------------------------------------------------! |
|---|
| 7006 | ! Description: |
|---|
| 7007 | ! ------------ |
|---|
| 7008 | !> salsa_diagnostics: Update properties for the current timestep: |
|---|
| 7009 | !> |
|---|
| 7010 | !> Juha Tonttila, FMI, 2014 |
|---|
| 7011 | !> Tomi Raatikainen, FMI, 2016 |
|---|
| 7012 | !------------------------------------------------------------------------------! |
|---|
| 7013 | SUBROUTINE salsa_diagnostics( i, j ) |
|---|
| 7014 | |
|---|
| 7015 | USE arrays_3d, & |
|---|
| 7016 | ONLY: p, pt, zu |
|---|
| 7017 | |
|---|
| 7018 | USE basic_constants_and_equations_mod, & |
|---|
| 7019 | ONLY: g |
|---|
| 7020 | |
|---|
| 7021 | USE control_parameters, & |
|---|
| 7022 | ONLY: pt_surface, surface_pressure |
|---|
| 7023 | |
|---|
| 7024 | USE cpulog, & |
|---|
| 7025 | ONLY: cpu_log, log_point_s |
|---|
| 7026 | |
|---|
| 7027 | IMPLICIT NONE |
|---|
| 7028 | |
|---|
| 7029 | INTEGER(iwp), INTENT(in) :: i !< |
|---|
| 7030 | INTEGER(iwp), INTENT(in) :: j !< |
|---|
| 7031 | |
|---|
| 7032 | INTEGER(iwp) :: b !< |
|---|
| 7033 | INTEGER(iwp) :: c !< |
|---|
| 7034 | INTEGER(iwp) :: gt !< |
|---|
| 7035 | INTEGER(iwp) :: k !< |
|---|
| 7036 | INTEGER(iwp) :: nc !< |
|---|
| 7037 | REAL(wp), DIMENSION(nzb:nzt+1) :: flag !< flag to mask topography |
|---|
| 7038 | REAL(wp), DIMENSION(nzb:nzt+1) :: flag_zddry !< flag to mask zddry |
|---|
| 7039 | REAL(wp), DIMENSION(nzb:nzt+1) :: in_adn !< air density (kg/m3) |
|---|
| 7040 | REAL(wp), DIMENSION(nzb:nzt+1) :: in_p !< pressure |
|---|
| 7041 | REAL(wp), DIMENSION(nzb:nzt+1) :: in_t !< temperature (K) |
|---|
| 7042 | REAL(wp), DIMENSION(nzb:nzt+1) :: mcsum !< sum of mass concentration |
|---|
| 7043 | REAL(wp), DIMENSION(nzb:nzt+1) :: ppm_to_nconc !< Conversion factor |
|---|
| 7044 | !< from ppm to #/m3 |
|---|
| 7045 | REAL(wp), DIMENSION(nzb:nzt+1) :: zddry !< |
|---|
| 7046 | REAL(wp), DIMENSION(nzb:nzt+1) :: zvol !< |
|---|
| 7047 | |
|---|
| 7048 | flag_zddry = 0.0_wp |
|---|
| 7049 | in_adn = 0.0_wp |
|---|
| 7050 | in_p = 0.0_wp |
|---|
| 7051 | in_t = 0.0_wp |
|---|
| 7052 | ppm_to_nconc = 1.0_wp |
|---|
| 7053 | zddry = 0.0_wp |
|---|
| 7054 | zvol = 0.0_wp |
|---|
| 7055 | |
|---|
| 7056 | CALL cpu_log( log_point_s(94), 'salsa diagnostics ', 'start' ) |
|---|
| 7057 | |
|---|
| 7058 | ! |
|---|
| 7059 | !-- Calculate thermodynamic quantities needed in SALSA |
|---|
| 7060 | CALL salsa_thrm_ij( i, j, p_ij=in_p, temp_ij=in_t, adn_ij=in_adn ) |
|---|
| 7061 | ! |
|---|
| 7062 | !-- Calculate conversion factors for gas concentrations |
|---|
| 7063 | ppm_to_nconc = for_ppm_to_nconc * in_p / in_t |
|---|
| 7064 | ! |
|---|
| 7065 | !-- Predetermine flag to mask topography |
|---|
| 7066 | flag = MERGE( 1.0_wp, 0.0_wp, BTEST( wall_flags_0(:,j,i), 0 ) ) |
|---|
| 7067 | |
|---|
| 7068 | DO b = 1, nbins ! aerosol size bins |
|---|
| 7069 | ! |
|---|
| 7070 | !-- Remove negative values |
|---|
| 7071 | aerosol_number(b)%conc(:,j,i) = MAX( nclim, & |
|---|
| 7072 | aerosol_number(b)%conc(:,j,i) ) * flag |
|---|
| 7073 | mcsum = 0.0_wp ! total mass concentration |
|---|
| 7074 | DO c = 1, ncc_tot |
|---|
| 7075 | ! |
|---|
| 7076 | !-- Remove negative concentrations |
|---|
| 7077 | aerosol_mass((c-1)*nbins+b)%conc(:,j,i) = MAX( mclim, & |
|---|
| 7078 | aerosol_mass((c-1)*nbins+b)%conc(:,j,i) ) & |
|---|
| 7079 | * flag |
|---|
| 7080 | mcsum = mcsum + aerosol_mass((c-1)*nbins+b)%conc(:,j,i) * flag |
|---|
| 7081 | ENDDO |
|---|
| 7082 | ! |
|---|
| 7083 | !-- Check that number and mass concentration match qualitatively |
|---|
| 7084 | IF ( ANY ( aerosol_number(b)%conc(:,j,i) > nclim .AND. & |
|---|
| 7085 | mcsum <= 0.0_wp ) ) & |
|---|
| 7086 | THEN |
|---|
| 7087 | DO k = nzb+1, nzt |
|---|
| 7088 | IF ( aerosol_number(b)%conc(k,j,i) > nclim .AND. & |
|---|
| 7089 | mcsum(k) <= 0.0_wp ) & |
|---|
| 7090 | THEN |
|---|
| 7091 | aerosol_number(b)%conc(k,j,i) = nclim * flag(k) |
|---|
| 7092 | DO c = 1, ncc_tot |
|---|
| 7093 | aerosol_mass((c-1)*nbins+b)%conc(k,j,i) = mclim * flag(k) |
|---|
| 7094 | ENDDO |
|---|
| 7095 | ENDIF |
|---|
| 7096 | ENDDO |
|---|
| 7097 | ENDIF |
|---|
| 7098 | ! |
|---|
| 7099 | !-- Update aerosol particle radius |
|---|
| 7100 | CALL bin_mixrat( 'dry', b, i, j, zvol ) |
|---|
| 7101 | zvol = zvol / arhoh2so4 ! Why on sulphate? |
|---|
| 7102 | ! |
|---|
| 7103 | !-- Particles smaller then 0.1 nm diameter are set to zero |
|---|
| 7104 | zddry = ( zvol / MAX( nclim, aerosol_number(b)%conc(:,j,i) ) / api6 )** & |
|---|
| 7105 | ( 1.0_wp / 3.0_wp ) |
|---|
| 7106 | flag_zddry = MERGE( 1.0_wp, 0.0_wp, ( zddry < 1.0E-10_wp .AND. & |
|---|
| 7107 | aerosol_number(b)%conc(:,j,i) > nclim ) ) |
|---|
| 7108 | ! |
|---|
| 7109 | !-- Volatile species to the gas phase |
|---|
| 7110 | IF ( is_used( prtcl, 'SO4' ) .AND. lscndgas ) THEN |
|---|
| 7111 | nc = get_index( prtcl, 'SO4' ) |
|---|
| 7112 | c = ( nc - 1 ) * nbins + b |
|---|
| 7113 | IF ( salsa_gases_from_chem ) THEN |
|---|
| 7114 | chem_species( gas_index_chem(1) )%conc(:,j,i) = & |
|---|
| 7115 | chem_species( gas_index_chem(1) )%conc(:,j,i) + & |
|---|
| 7116 | aerosol_mass(c)%conc(:,j,i) * avo * flag * & |
|---|
| 7117 | flag_zddry / ( amh2so4 * ppm_to_nconc ) |
|---|
| 7118 | ELSE |
|---|
| 7119 | salsa_gas(1)%conc(:,j,i) = salsa_gas(1)%conc(:,j,i) + & |
|---|
| 7120 | aerosol_mass(c)%conc(:,j,i) / amh2so4 *& |
|---|
| 7121 | avo * flag * flag_zddry |
|---|
| 7122 | ENDIF |
|---|
| 7123 | ENDIF |
|---|
| 7124 | IF ( is_used( prtcl, 'OC' ) .AND. lscndgas ) THEN |
|---|
| 7125 | nc = get_index( prtcl, 'OC' ) |
|---|
| 7126 | c = ( nc - 1 ) * nbins + b |
|---|
| 7127 | IF ( salsa_gases_from_chem ) THEN |
|---|
| 7128 | chem_species( gas_index_chem(5) )%conc(:,j,i) = & |
|---|
| 7129 | chem_species( gas_index_chem(5) )%conc(:,j,i) + & |
|---|
| 7130 | aerosol_mass(c)%conc(:,j,i) * avo * flag * & |
|---|
| 7131 | flag_zddry / ( amoc * ppm_to_nconc ) |
|---|
| 7132 | ELSE |
|---|
| 7133 | salsa_gas(5)%conc(:,j,i) = salsa_gas(5)%conc(:,j,i) + & |
|---|
| 7134 | aerosol_mass(c)%conc(:,j,i) / amoc * & |
|---|
| 7135 | avo * flag * flag_zddry |
|---|
| 7136 | ENDIF |
|---|
| 7137 | ENDIF |
|---|
| 7138 | IF ( is_used( prtcl, 'NO' ) .AND. lscndgas ) THEN |
|---|
| 7139 | nc = get_index( prtcl, 'NO' ) |
|---|
| 7140 | c = ( nc - 1 ) * nbins + b |
|---|
| 7141 | IF ( salsa_gases_from_chem ) THEN |
|---|
| 7142 | chem_species( gas_index_chem(2) )%conc(:,j,i) = & |
|---|
| 7143 | chem_species( gas_index_chem(2) )%conc(:,j,i) + & |
|---|
| 7144 | aerosol_mass(c)%conc(:,j,i) * avo * flag * & |
|---|
| 7145 | flag_zddry / ( amhno3 * ppm_to_nconc ) |
|---|
| 7146 | ELSE |
|---|
| 7147 | salsa_gas(2)%conc(:,j,i) = salsa_gas(2)%conc(:,j,i) + & |
|---|
| 7148 | aerosol_mass(c)%conc(:,j,i) / amhno3 * & |
|---|
| 7149 | avo * flag * flag_zddry |
|---|
| 7150 | ENDIF |
|---|
| 7151 | ENDIF |
|---|
| 7152 | IF ( is_used( prtcl, 'NH' ) .AND. lscndgas ) THEN |
|---|
| 7153 | nc = get_index( prtcl, 'NH' ) |
|---|
| 7154 | c = ( nc - 1 ) * nbins + b |
|---|
| 7155 | IF ( salsa_gases_from_chem ) THEN |
|---|
| 7156 | chem_species( gas_index_chem(3) )%conc(:,j,i) = & |
|---|
| 7157 | chem_species( gas_index_chem(3) )%conc(:,j,i) + & |
|---|
| 7158 | aerosol_mass(c)%conc(:,j,i) * avo * flag * & |
|---|
| 7159 | flag_zddry / ( amnh3 * ppm_to_nconc ) |
|---|
| 7160 | ELSE |
|---|
| 7161 | salsa_gas(3)%conc(:,j,i) = salsa_gas(3)%conc(:,j,i) + & |
|---|
| 7162 | aerosol_mass(c)%conc(:,j,i) / amnh3 * & |
|---|
| 7163 | avo * flag * flag_zddry |
|---|
| 7164 | ENDIF |
|---|
| 7165 | ENDIF |
|---|
| 7166 | ! |
|---|
| 7167 | !-- Mass and number to zero (insoluble species and water are lost) |
|---|
| 7168 | DO c = 1, ncc_tot |
|---|
| 7169 | aerosol_mass((c-1)*nbins+b)%conc(:,j,i) = MERGE( mclim * flag, & |
|---|
| 7170 | aerosol_mass((c-1)*nbins+b)%conc(:,j,i), & |
|---|
| 7171 | flag_zddry > 0.0_wp ) |
|---|
| 7172 | ENDDO |
|---|
| 7173 | aerosol_number(b)%conc(:,j,i) = MERGE( nclim * flag, & |
|---|
| 7174 | aerosol_number(b)%conc(:,j,i), & |
|---|
| 7175 | flag_zddry > 0.0_wp ) |
|---|
| 7176 | Ra_dry(:,j,i,b) = MAX( 1.0E-10_wp, 0.5_wp * zddry ) |
|---|
| 7177 | |
|---|
| 7178 | ENDDO |
|---|
| 7179 | IF ( .NOT. salsa_gases_from_chem ) THEN |
|---|
| 7180 | DO gt = 1, ngast |
|---|
| 7181 | salsa_gas(gt)%conc(:,j,i) = MAX( nclim, salsa_gas(gt)%conc(:,j,i) ) & |
|---|
| 7182 | * flag |
|---|
| 7183 | ENDDO |
|---|
| 7184 | ENDIF |
|---|
| 7185 | |
|---|
| 7186 | CALL cpu_log( log_point_s(94), 'salsa diagnostics ', 'stop' ) |
|---|
| 7187 | |
|---|
| 7188 | END SUBROUTINE salsa_diagnostics |
|---|
| 7189 | |
|---|
| 7190 | |
|---|
| 7191 | ! |
|---|
| 7192 | !------------------------------------------------------------------------------! |
|---|
| 7193 | ! Description: |
|---|
| 7194 | ! ------------ |
|---|
| 7195 | !> Calculate the tendencies for aerosol number and mass concentrations. |
|---|
| 7196 | !> Cache-optimized. |
|---|
| 7197 | !------------------------------------------------------------------------------! |
|---|
| 7198 | SUBROUTINE salsa_tendency_ij( id, rs_p, rs, trs_m, i, j, i_omp_start, tn, b, & |
|---|
| 7199 | c, flux_s, diss_s, flux_l, diss_l, rs_init ) |
|---|
| 7200 | |
|---|
| 7201 | USE advec_ws, & |
|---|
| 7202 | ONLY: advec_s_ws |
|---|
| 7203 | USE advec_s_pw_mod, & |
|---|
| 7204 | ONLY: advec_s_pw |
|---|
| 7205 | USE advec_s_up_mod, & |
|---|
| 7206 | ONLY: advec_s_up |
|---|
| 7207 | USE arrays_3d, & |
|---|
| 7208 | ONLY: ddzu, hyp, pt, rdf_sc, tend |
|---|
| 7209 | USE diffusion_s_mod, & |
|---|
| 7210 | ONLY: diffusion_s |
|---|
| 7211 | USE indices, & |
|---|
| 7212 | ONLY: wall_flags_0 |
|---|
| 7213 | USE pegrid, & |
|---|
| 7214 | ONLY: threads_per_task, myid |
|---|
| 7215 | USE surface_mod, & |
|---|
| 7216 | ONLY : surf_def_h, surf_def_v, surf_lsm_h, surf_lsm_v, surf_usm_h, & |
|---|
| 7217 | surf_usm_v |
|---|
| 7218 | |
|---|
| 7219 | IMPLICIT NONE |
|---|
| 7220 | |
|---|
| 7221 | CHARACTER (LEN = *) :: id |
|---|
| 7222 | INTEGER(iwp) :: b !< bin index in derived type aerosol_size_bin |
|---|
| 7223 | INTEGER(iwp) :: c !< bin index in derived type aerosol_size_bin |
|---|
| 7224 | INTEGER(iwp) :: i !< |
|---|
| 7225 | INTEGER(iwp) :: i_omp_start !< |
|---|
| 7226 | INTEGER(iwp) :: j !< |
|---|
| 7227 | INTEGER(iwp) :: k !< |
|---|
| 7228 | INTEGER(iwp) :: nc !< (c-1)*nbins+b |
|---|
| 7229 | INTEGER(iwp) :: tn !< |
|---|
| 7230 | REAL(wp), DIMENSION(nzb+1:nzt,nys:nyn,0:threads_per_task-1) :: diss_l !< |
|---|
| 7231 | REAL(wp), DIMENSION(nzb+1:nzt,0:threads_per_task-1) :: diss_s !< |
|---|
| 7232 | REAL(wp), DIMENSION(nzb+1:nzt,nys:nyn,0:threads_per_task-1) :: flux_l !< |
|---|
| 7233 | REAL(wp), DIMENSION(nzb+1:nzt,0:threads_per_task-1) :: flux_s !< |
|---|
| 7234 | REAL(wp), DIMENSION(nzb:nzt+1) :: rs_init !< |
|---|
| 7235 | REAL(wp), DIMENSION(:,:,:), POINTER :: rs_p !< |
|---|
| 7236 | REAL(wp), DIMENSION(:,:,:), POINTER :: rs !< |
|---|
| 7237 | REAL(wp), DIMENSION(:,:,:), POINTER :: trs_m !< |
|---|
| 7238 | |
|---|
| 7239 | nc = (c-1)*nbins+b |
|---|
| 7240 | ! |
|---|
| 7241 | !-- Tendency-terms for reactive scalar |
|---|
| 7242 | tend(:,j,i) = 0.0_wp |
|---|
| 7243 | |
|---|
| 7244 | IF ( id == 'aerosol_number' .AND. lod_aero == 3 ) THEN |
|---|
| 7245 | tend(:,j,i) = tend(:,j,i) + aerosol_number(b)%source(:,j,i) |
|---|
| 7246 | ELSEIF ( id == 'aerosol_mass' .AND. lod_aero == 3 ) THEN |
|---|
| 7247 | tend(:,j,i) = tend(:,j,i) + aerosol_mass(nc)%source(:,j,i) |
|---|
| 7248 | ENDIF |
|---|
| 7249 | ! |
|---|
| 7250 | !-- Advection terms |
|---|
| 7251 | IF ( timestep_scheme(1:5) == 'runge' ) THEN |
|---|
| 7252 | IF ( ws_scheme_sca ) THEN |
|---|
| 7253 | CALL advec_s_ws( i, j, rs, id, flux_s, diss_s, flux_l, diss_l, & |
|---|
| 7254 | i_omp_start, tn ) |
|---|
| 7255 | ELSE |
|---|
| 7256 | CALL advec_s_pw( i, j, rs ) |
|---|
| 7257 | ENDIF |
|---|
| 7258 | ELSE |
|---|
| 7259 | CALL advec_s_up( i, j, rs ) |
|---|
| 7260 | ENDIF |
|---|
| 7261 | ! |
|---|
| 7262 | !-- Diffusion terms |
|---|
| 7263 | IF ( id == 'aerosol_number' ) THEN |
|---|
| 7264 | CALL diffusion_s( i, j, rs, surf_def_h(0)%answs(:,b), & |
|---|
| 7265 | surf_def_h(1)%answs(:,b), surf_def_h(2)%answs(:,b), & |
|---|
| 7266 | surf_lsm_h%answs(:,b), surf_usm_h%answs(:,b), & |
|---|
| 7267 | surf_def_v(0)%answs(:,b), surf_def_v(1)%answs(:,b), & |
|---|
| 7268 | surf_def_v(2)%answs(:,b), surf_def_v(3)%answs(:,b), & |
|---|
| 7269 | surf_lsm_v(0)%answs(:,b), surf_lsm_v(1)%answs(:,b), & |
|---|
| 7270 | surf_lsm_v(2)%answs(:,b), surf_lsm_v(3)%answs(:,b), & |
|---|
| 7271 | surf_usm_v(0)%answs(:,b), surf_usm_v(1)%answs(:,b), & |
|---|
| 7272 | surf_usm_v(2)%answs(:,b), surf_usm_v(3)%answs(:,b) ) |
|---|
| 7273 | ! |
|---|
| 7274 | !-- Sedimentation for aerosol number and mass |
|---|
| 7275 | IF ( lsdepo ) THEN |
|---|
| 7276 | tend(nzb+1:nzt,j,i) = tend(nzb+1:nzt,j,i) - MAX( 0.0_wp, & |
|---|
| 7277 | ( rs(nzb+2:nzt+1,j,i) * sedim_vd(nzb+2:nzt+1,j,i,b) - & |
|---|
| 7278 | rs(nzb+1:nzt,j,i) * sedim_vd(nzb+1:nzt,j,i,b) ) * & |
|---|
| 7279 | ddzu(nzb+1:nzt) ) * MERGE( 1.0_wp, 0.0_wp, & |
|---|
| 7280 | BTEST( wall_flags_0(nzb:nzt-1,j,i), 0 ) ) |
|---|
| 7281 | ENDIF |
|---|
| 7282 | |
|---|
| 7283 | ELSEIF ( id == 'aerosol_mass' ) THEN |
|---|
| 7284 | CALL diffusion_s( i, j, rs, surf_def_h(0)%amsws(:,nc), & |
|---|
| 7285 | surf_def_h(1)%amsws(:,nc), surf_def_h(2)%amsws(:,nc), & |
|---|
| 7286 | surf_lsm_h%amsws(:,nc), surf_usm_h%amsws(:,nc), & |
|---|
| 7287 | surf_def_v(0)%amsws(:,nc), surf_def_v(1)%amsws(:,nc), & |
|---|
| 7288 | surf_def_v(2)%amsws(:,nc), surf_def_v(3)%amsws(:,nc), & |
|---|
| 7289 | surf_lsm_v(0)%amsws(:,nc), surf_lsm_v(1)%amsws(:,nc), & |
|---|
| 7290 | surf_lsm_v(2)%amsws(:,nc), surf_lsm_v(3)%amsws(:,nc), & |
|---|
| 7291 | surf_usm_v(0)%amsws(:,nc), surf_usm_v(1)%amsws(:,nc), & |
|---|
| 7292 | surf_usm_v(2)%amsws(:,nc), surf_usm_v(3)%amsws(:,nc) ) |
|---|
| 7293 | ! |
|---|
| 7294 | !-- Sedimentation for aerosol number and mass |
|---|
| 7295 | IF ( lsdepo ) THEN |
|---|
| 7296 | tend(nzb+1:nzt,j,i) = tend(nzb+1:nzt,j,i) - MAX( 0.0_wp, & |
|---|
| 7297 | ( rs(nzb+2:nzt+1,j,i) * sedim_vd(nzb+2:nzt+1,j,i,b) - & |
|---|
| 7298 | rs(nzb+1:nzt,j,i) * sedim_vd(nzb+1:nzt,j,i,b) ) * & |
|---|
| 7299 | ddzu(nzb+1:nzt) ) * MERGE( 1.0_wp, 0.0_wp, & |
|---|
| 7300 | BTEST( wall_flags_0(nzb:nzt-1,j,i), 0 ) ) |
|---|
| 7301 | ENDIF |
|---|
| 7302 | ELSEIF ( id == 'salsa_gas' ) THEN |
|---|
| 7303 | CALL diffusion_s( i, j, rs, surf_def_h(0)%gtsws(:,b), & |
|---|
| 7304 | surf_def_h(1)%gtsws(:,b), surf_def_h(2)%gtsws(:,b), & |
|---|
| 7305 | surf_lsm_h%gtsws(:,b), surf_usm_h%gtsws(:,b), & |
|---|
| 7306 | surf_def_v(0)%gtsws(:,b), surf_def_v(1)%gtsws(:,b), & |
|---|
| 7307 | surf_def_v(2)%gtsws(:,b), surf_def_v(3)%gtsws(:,b), & |
|---|
| 7308 | surf_lsm_v(0)%gtsws(:,b), surf_lsm_v(1)%gtsws(:,b), & |
|---|
| 7309 | surf_lsm_v(2)%gtsws(:,b), surf_lsm_v(3)%gtsws(:,b), & |
|---|
| 7310 | surf_usm_v(0)%gtsws(:,b), surf_usm_v(1)%gtsws(:,b), & |
|---|
| 7311 | surf_usm_v(2)%gtsws(:,b), surf_usm_v(3)%gtsws(:,b) ) |
|---|
| 7312 | ENDIF |
|---|
| 7313 | ! |
|---|
| 7314 | !-- Prognostic equation for a scalar |
|---|
| 7315 | DO k = nzb+1, nzt |
|---|
| 7316 | rs_p(k,j,i) = rs(k,j,i) + ( dt_3d * ( tsc(2) * tend(k,j,i) + & |
|---|
| 7317 | tsc(3) * trs_m(k,j,i) ) & |
|---|
| 7318 | - tsc(5) * rdf_sc(k) & |
|---|
| 7319 | * ( rs(k,j,i) - rs_init(k) ) ) & |
|---|
| 7320 | * MERGE( 1.0_wp, 0.0_wp, & |
|---|
| 7321 | BTEST( wall_flags_0(k,j,i), 0 ) ) |
|---|
| 7322 | IF ( rs_p(k,j,i) < 0.0_wp ) rs_p(k,j,i) = 0.1_wp * rs(k,j,i) |
|---|
| 7323 | ENDDO |
|---|
| 7324 | |
|---|
| 7325 | ! |
|---|
| 7326 | !-- Calculate tendencies for the next Runge-Kutta step |
|---|
| 7327 | IF ( timestep_scheme(1:5) == 'runge' ) THEN |
|---|
| 7328 | IF ( intermediate_timestep_count == 1 ) THEN |
|---|
| 7329 | DO k = nzb+1, nzt |
|---|
| 7330 | trs_m(k,j,i) = tend(k,j,i) |
|---|
| 7331 | ENDDO |
|---|
| 7332 | ELSEIF ( intermediate_timestep_count < & |
|---|
| 7333 | intermediate_timestep_count_max ) THEN |
|---|
| 7334 | DO k = nzb+1, nzt |
|---|
| 7335 | trs_m(k,j,i) = -9.5625_wp * tend(k,j,i) + 5.3125_wp * trs_m(k,j,i) |
|---|
| 7336 | ENDDO |
|---|
| 7337 | ENDIF |
|---|
| 7338 | ENDIF |
|---|
| 7339 | |
|---|
| 7340 | END SUBROUTINE salsa_tendency_ij |
|---|
| 7341 | |
|---|
| 7342 | ! |
|---|
| 7343 | !------------------------------------------------------------------------------! |
|---|
| 7344 | ! Description: |
|---|
| 7345 | ! ------------ |
|---|
| 7346 | !> Calculate the tendencies for aerosol number and mass concentrations. |
|---|
| 7347 | !> Vector-optimized. |
|---|
| 7348 | !------------------------------------------------------------------------------! |
|---|
| 7349 | SUBROUTINE salsa_tendency( id, rs_p, rs, trs_m, b, c, rs_init ) |
|---|
| 7350 | |
|---|
| 7351 | USE advec_ws, & |
|---|
| 7352 | ONLY: advec_s_ws |
|---|
| 7353 | USE advec_s_pw_mod, & |
|---|
| 7354 | ONLY: advec_s_pw |
|---|
| 7355 | USE advec_s_up_mod, & |
|---|
| 7356 | ONLY: advec_s_up |
|---|
| 7357 | USE arrays_3d, & |
|---|
| 7358 | ONLY: ddzu, hyp, pt, rdf_sc, tend |
|---|
| 7359 | USE diffusion_s_mod, & |
|---|
| 7360 | ONLY: diffusion_s |
|---|
| 7361 | USE indices, & |
|---|
| 7362 | ONLY: wall_flags_0 |
|---|
| 7363 | USE surface_mod, & |
|---|
| 7364 | ONLY : surf_def_h, surf_def_v, surf_lsm_h, surf_lsm_v, surf_usm_h, & |
|---|
| 7365 | surf_usm_v |
|---|
| 7366 | |
|---|
| 7367 | IMPLICIT NONE |
|---|
| 7368 | |
|---|
| 7369 | CHARACTER (LEN = *) :: id |
|---|
| 7370 | INTEGER(iwp) :: b !< bin index in derived type aerosol_size_bin |
|---|
| 7371 | INTEGER(iwp) :: c !< bin index in derived type aerosol_size_bin |
|---|
| 7372 | INTEGER(iwp) :: i !< |
|---|
| 7373 | INTEGER(iwp) :: j !< |
|---|
| 7374 | INTEGER(iwp) :: k !< |
|---|
| 7375 | INTEGER(iwp) :: nc !< (c-1)*nbins+b |
|---|
| 7376 | REAL(wp), DIMENSION(nzb:nzt+1) :: rs_init !< |
|---|
| 7377 | REAL(wp), DIMENSION(:,:,:), POINTER :: rs_p !< |
|---|
| 7378 | REAL(wp), DIMENSION(:,:,:), POINTER :: rs !< |
|---|
| 7379 | REAL(wp), DIMENSION(:,:,:), POINTER :: trs_m !< |
|---|
| 7380 | |
|---|
| 7381 | nc = (c-1)*nbins+b |
|---|
| 7382 | ! |
|---|
| 7383 | !-- Tendency-terms for reactive scalar |
|---|
| 7384 | tend = 0.0_wp |
|---|
| 7385 | |
|---|
| 7386 | IF ( id == 'aerosol_number' .AND. lod_aero == 3 ) THEN |
|---|
| 7387 | tend = tend + aerosol_number(b)%source |
|---|
| 7388 | ELSEIF ( id == 'aerosol_mass' .AND. lod_aero == 3 ) THEN |
|---|
| 7389 | tend = tend + aerosol_mass(nc)%source |
|---|
| 7390 | ENDIF |
|---|
| 7391 | ! |
|---|
| 7392 | !-- Advection terms |
|---|
| 7393 | IF ( timestep_scheme(1:5) == 'runge' ) THEN |
|---|
| 7394 | IF ( ws_scheme_sca ) THEN |
|---|
| 7395 | CALL advec_s_ws( rs, id ) |
|---|
| 7396 | ELSE |
|---|
| 7397 | CALL advec_s_pw( rs ) |
|---|
| 7398 | ENDIF |
|---|
| 7399 | ELSE |
|---|
| 7400 | CALL advec_s_up( rs ) |
|---|
| 7401 | ENDIF |
|---|
| 7402 | ! |
|---|
| 7403 | !-- Diffusion terms |
|---|
| 7404 | IF ( id == 'aerosol_number' ) THEN |
|---|
| 7405 | CALL diffusion_s( rs, surf_def_h(0)%answs(:,b), & |
|---|
| 7406 | surf_def_h(1)%answs(:,b), surf_def_h(2)%answs(:,b), & |
|---|
| 7407 | surf_lsm_h%answs(:,b), surf_usm_h%answs(:,b), & |
|---|
| 7408 | surf_def_v(0)%answs(:,b), surf_def_v(1)%answs(:,b), & |
|---|
| 7409 | surf_def_v(2)%answs(:,b), surf_def_v(3)%answs(:,b), & |
|---|
| 7410 | surf_lsm_v(0)%answs(:,b), surf_lsm_v(1)%answs(:,b), & |
|---|
| 7411 | surf_lsm_v(2)%answs(:,b), surf_lsm_v(3)%answs(:,b), & |
|---|
| 7412 | surf_usm_v(0)%answs(:,b), surf_usm_v(1)%answs(:,b), & |
|---|
| 7413 | surf_usm_v(2)%answs(:,b), surf_usm_v(3)%answs(:,b) ) |
|---|
| 7414 | ELSEIF ( id == 'aerosol_mass' ) THEN |
|---|
| 7415 | CALL diffusion_s( rs, surf_def_h(0)%amsws(:,nc), & |
|---|
| 7416 | surf_def_h(1)%amsws(:,nc), surf_def_h(2)%amsws(:,nc), & |
|---|
| 7417 | surf_lsm_h%amsws(:,nc), surf_usm_h%amsws(:,nc), & |
|---|
| 7418 | surf_def_v(0)%amsws(:,nc), surf_def_v(1)%amsws(:,nc), & |
|---|
| 7419 | surf_def_v(2)%amsws(:,nc), surf_def_v(3)%amsws(:,nc), & |
|---|
| 7420 | surf_lsm_v(0)%amsws(:,nc), surf_lsm_v(1)%amsws(:,nc), & |
|---|
| 7421 | surf_lsm_v(2)%amsws(:,nc), surf_lsm_v(3)%amsws(:,nc), & |
|---|
| 7422 | surf_usm_v(0)%amsws(:,nc), surf_usm_v(1)%amsws(:,nc), & |
|---|
| 7423 | surf_usm_v(2)%amsws(:,nc), surf_usm_v(3)%amsws(:,nc) ) |
|---|
| 7424 | ELSEIF ( id == 'salsa_gas' ) THEN |
|---|
| 7425 | CALL diffusion_s( rs, surf_def_h(0)%gtsws(:,b), & |
|---|
| 7426 | surf_def_h(1)%gtsws(:,b), surf_def_h(2)%gtsws(:,b), & |
|---|
| 7427 | surf_lsm_h%gtsws(:,b), surf_usm_h%gtsws(:,b), & |
|---|
| 7428 | surf_def_v(0)%gtsws(:,b), surf_def_v(1)%gtsws(:,b), & |
|---|
| 7429 | surf_def_v(2)%gtsws(:,b), surf_def_v(3)%gtsws(:,b), & |
|---|
| 7430 | surf_lsm_v(0)%gtsws(:,b), surf_lsm_v(1)%gtsws(:,b), & |
|---|
| 7431 | surf_lsm_v(2)%gtsws(:,b), surf_lsm_v(3)%gtsws(:,b), & |
|---|
| 7432 | surf_usm_v(0)%gtsws(:,b), surf_usm_v(1)%gtsws(:,b), & |
|---|
| 7433 | surf_usm_v(2)%gtsws(:,b), surf_usm_v(3)%gtsws(:,b) ) |
|---|
| 7434 | ENDIF |
|---|
| 7435 | ! |
|---|
| 7436 | !-- Prognostic equation for a scalar |
|---|
| 7437 | DO i = nxl, nxr |
|---|
| 7438 | DO j = nys, nyn |
|---|
| 7439 | IF ( id == 'salsa_gas' .AND. lod_gases == 3 ) THEN |
|---|
| 7440 | tend(:,j,i) = tend(:,j,i) + salsa_gas(b)%source(:,j,i) * & |
|---|
| 7441 | for_ppm_to_nconc * hyp(:) / pt(:,j,i) * ( hyp(:) / & |
|---|
| 7442 | 100000.0_wp )**0.286_wp ! ppm to #/m3 |
|---|
| 7443 | ELSEIF ( id == 'aerosol_mass' .OR. id == 'aerosol_number') THEN |
|---|
| 7444 | ! |
|---|
| 7445 | !-- Sedimentation for aerosol number and mass |
|---|
| 7446 | IF ( lsdepo ) THEN |
|---|
| 7447 | tend(nzb+1:nzt,j,i) = tend(nzb+1:nzt,j,i) - MAX( 0.0_wp, & |
|---|
| 7448 | ( rs(nzb+2:nzt+1,j,i) * sedim_vd(nzb+2:nzt+1,j,i,b) - & |
|---|
| 7449 | rs(nzb+1:nzt,j,i) * sedim_vd(nzb+1:nzt,j,i,b) ) * & |
|---|
| 7450 | ddzu(nzb+1:nzt) ) * MERGE( 1.0_wp, 0.0_wp, & |
|---|
| 7451 | BTEST( wall_flags_0(nzb:nzt-1,j,i), 0 ) ) |
|---|
| 7452 | ENDIF |
|---|
| 7453 | ENDIF |
|---|
| 7454 | DO k = nzb+1, nzt |
|---|
| 7455 | rs_p(k,j,i) = rs(k,j,i) + ( dt_3d * ( tsc(2) * tend(k,j,i) + & |
|---|
| 7456 | tsc(3) * trs_m(k,j,i) ) & |
|---|
| 7457 | - tsc(5) * rdf_sc(k) & |
|---|
| 7458 | * ( rs(k,j,i) - rs_init(k) ) )& |
|---|
| 7459 | * MERGE( 1.0_wp, 0.0_wp, & |
|---|
| 7460 | BTEST( wall_flags_0(k,j,i), 0 ) ) |
|---|
| 7461 | IF ( rs_p(k,j,i) < 0.0_wp ) rs_p(k,j,i) = 0.1_wp * rs(k,j,i) |
|---|
| 7462 | ENDDO |
|---|
| 7463 | ENDDO |
|---|
| 7464 | ENDDO |
|---|
| 7465 | |
|---|
| 7466 | ! |
|---|
| 7467 | !-- Calculate tendencies for the next Runge-Kutta step |
|---|
| 7468 | IF ( timestep_scheme(1:5) == 'runge' ) THEN |
|---|
| 7469 | IF ( intermediate_timestep_count == 1 ) THEN |
|---|
| 7470 | DO i = nxl, nxr |
|---|
| 7471 | DO j = nys, nyn |
|---|
| 7472 | DO k = nzb+1, nzt |
|---|
| 7473 | trs_m(k,j,i) = tend(k,j,i) |
|---|
| 7474 | ENDDO |
|---|
| 7475 | ENDDO |
|---|
| 7476 | ENDDO |
|---|
| 7477 | ELSEIF ( intermediate_timestep_count < & |
|---|
| 7478 | intermediate_timestep_count_max ) THEN |
|---|
| 7479 | DO i = nxl, nxr |
|---|
| 7480 | DO j = nys, nyn |
|---|
| 7481 | DO k = nzb+1, nzt |
|---|
| 7482 | trs_m(k,j,i) = -9.5625_wp * tend(k,j,i) & |
|---|
| 7483 | + 5.3125_wp * trs_m(k,j,i) |
|---|
| 7484 | ENDDO |
|---|
| 7485 | ENDDO |
|---|
| 7486 | ENDDO |
|---|
| 7487 | ENDIF |
|---|
| 7488 | ENDIF |
|---|
| 7489 | |
|---|
| 7490 | END SUBROUTINE salsa_tendency |
|---|
| 7491 | |
|---|
| 7492 | !------------------------------------------------------------------------------! |
|---|
| 7493 | ! Description: |
|---|
| 7494 | ! ------------ |
|---|
| 7495 | !> Boundary conditions for prognostic variables in SALSA |
|---|
| 7496 | !------------------------------------------------------------------------------! |
|---|
| 7497 | SUBROUTINE salsa_boundary_conds |
|---|
| 7498 | |
|---|
| 7499 | USE surface_mod, & |
|---|
| 7500 | ONLY : bc_h |
|---|
| 7501 | |
|---|
| 7502 | IMPLICIT NONE |
|---|
| 7503 | |
|---|
| 7504 | INTEGER(iwp) :: b !< index for aerosol size bins |
|---|
| 7505 | INTEGER(iwp) :: c !< index for chemical compounds in aerosols |
|---|
| 7506 | INTEGER(iwp) :: g !< idex for gaseous compounds |
|---|
| 7507 | INTEGER(iwp) :: i !< grid index x direction |
|---|
| 7508 | INTEGER(iwp) :: j !< grid index y direction |
|---|
| 7509 | INTEGER(iwp) :: k !< grid index y direction |
|---|
| 7510 | INTEGER(iwp) :: kb !< variable to set respective boundary value, depends on |
|---|
| 7511 | !< facing. |
|---|
| 7512 | INTEGER(iwp) :: l !< running index boundary type, for up- and downward- |
|---|
| 7513 | !< facing walls |
|---|
| 7514 | INTEGER(iwp) :: m !< running index surface elements |
|---|
| 7515 | |
|---|
| 7516 | ! |
|---|
| 7517 | !-- Surface conditions: |
|---|
| 7518 | IF ( ibc_salsa_b == 0 ) THEN ! Dirichlet |
|---|
| 7519 | ! |
|---|
| 7520 | !-- Run loop over all non-natural and natural walls. Note, in wall-datatype |
|---|
| 7521 | !-- the k coordinate belongs to the atmospheric grid point, therefore, set |
|---|
| 7522 | !-- s_p at k-1 |
|---|
| 7523 | |
|---|
| 7524 | DO l = 0, 1 |
|---|
| 7525 | ! |
|---|
| 7526 | !-- Set kb, for upward-facing surfaces value at topography top (k-1) is |
|---|
| 7527 | !-- set, for downward-facing surfaces at topography bottom (k+1) |
|---|
| 7528 | kb = MERGE ( -1, 1, l == 0 ) |
|---|
| 7529 | !$OMP PARALLEL PRIVATE( b, c, g, i, j, k ) |
|---|
| 7530 | !$OMP DO |
|---|
| 7531 | DO m = 1, bc_h(l)%ns |
|---|
| 7532 | |
|---|
| 7533 | i = bc_h(l)%i(m) |
|---|
| 7534 | j = bc_h(l)%j(m) |
|---|
| 7535 | k = bc_h(l)%k(m) |
|---|
| 7536 | |
|---|
| 7537 | DO b = 1, nbins |
|---|
| 7538 | aerosol_number(b)%conc_p(k+kb,j,i) = & |
|---|
| 7539 | aerosol_number(b)%conc(k+kb,j,i) |
|---|
| 7540 | DO c = 1, ncc_tot |
|---|
| 7541 | aerosol_mass((c-1)*nbins+b)%conc_p(k+kb,j,i) = & |
|---|
| 7542 | aerosol_mass((c-1)*nbins+b)%conc(k+kb,j,i) |
|---|
| 7543 | ENDDO |
|---|
| 7544 | ENDDO |
|---|
| 7545 | IF ( .NOT. salsa_gases_from_chem ) THEN |
|---|
| 7546 | DO g = 1, ngast |
|---|
| 7547 | salsa_gas(g)%conc_p(k+kb,j,i) = salsa_gas(g)%conc(k+kb,j,i) |
|---|
| 7548 | ENDDO |
|---|
| 7549 | ENDIF |
|---|
| 7550 | |
|---|
| 7551 | ENDDO |
|---|
| 7552 | !$OMP END PARALLEL |
|---|
| 7553 | |
|---|
| 7554 | ENDDO |
|---|
| 7555 | |
|---|
| 7556 | ELSE ! Neumann |
|---|
| 7557 | |
|---|
| 7558 | DO l = 0, 1 |
|---|
| 7559 | ! |
|---|
| 7560 | !-- Set kb, for upward-facing surfaces value at topography top (k-1) is |
|---|
| 7561 | !-- set, for downward-facing surfaces at topography bottom (k+1) |
|---|
| 7562 | kb = MERGE( -1, 1, l == 0 ) |
|---|
| 7563 | !$OMP PARALLEL PRIVATE( b, c, g, i, j, k ) |
|---|
| 7564 | !$OMP DO |
|---|
| 7565 | DO m = 1, bc_h(l)%ns |
|---|
| 7566 | |
|---|
| 7567 | i = bc_h(l)%i(m) |
|---|
| 7568 | j = bc_h(l)%j(m) |
|---|
| 7569 | k = bc_h(l)%k(m) |
|---|
| 7570 | |
|---|
| 7571 | DO b = 1, nbins |
|---|
| 7572 | aerosol_number(b)%conc_p(k+kb,j,i) = & |
|---|
| 7573 | aerosol_number(b)%conc_p(k,j,i) |
|---|
| 7574 | DO c = 1, ncc_tot |
|---|
| 7575 | aerosol_mass((c-1)*nbins+b)%conc_p(k+kb,j,i) = & |
|---|
| 7576 | aerosol_mass((c-1)*nbins+b)%conc_p(k,j,i) |
|---|
| 7577 | ENDDO |
|---|
| 7578 | ENDDO |
|---|
| 7579 | IF ( .NOT. salsa_gases_from_chem ) THEN |
|---|
| 7580 | DO g = 1, ngast |
|---|
| 7581 | salsa_gas(g)%conc_p(k+kb,j,i) = salsa_gas(g)%conc_p(k,j,i) |
|---|
| 7582 | ENDDO |
|---|
| 7583 | ENDIF |
|---|
| 7584 | |
|---|
| 7585 | ENDDO |
|---|
| 7586 | !$OMP END PARALLEL |
|---|
| 7587 | ENDDO |
|---|
| 7588 | |
|---|
| 7589 | ENDIF |
|---|
| 7590 | |
|---|
| 7591 | ! |
|---|
| 7592 | !--Top boundary conditions: |
|---|
| 7593 | IF ( ibc_salsa_t == 0 ) THEN ! Dirichlet |
|---|
| 7594 | |
|---|
| 7595 | DO b = 1, nbins |
|---|
| 7596 | aerosol_number(b)%conc_p(nzt+1,:,:) = & |
|---|
| 7597 | aerosol_number(b)%conc(nzt+1,:,:) |
|---|
| 7598 | DO c = 1, ncc_tot |
|---|
| 7599 | aerosol_mass((c-1)*nbins+b)%conc_p(nzt+1,:,:) = & |
|---|
| 7600 | aerosol_mass((c-1)*nbins+b)%conc(nzt+1,:,:) |
|---|
| 7601 | ENDDO |
|---|
| 7602 | ENDDO |
|---|
| 7603 | IF ( .NOT. salsa_gases_from_chem ) THEN |
|---|
| 7604 | DO g = 1, ngast |
|---|
| 7605 | salsa_gas(g)%conc_p(nzt+1,:,:) = salsa_gas(g)%conc(nzt+1,:,:) |
|---|
| 7606 | ENDDO |
|---|
| 7607 | ENDIF |
|---|
| 7608 | |
|---|
| 7609 | ELSEIF ( ibc_salsa_t == 1 ) THEN ! Neumann |
|---|
| 7610 | |
|---|
| 7611 | DO b = 1, nbins |
|---|
| 7612 | aerosol_number(b)%conc_p(nzt+1,:,:) = & |
|---|
| 7613 | aerosol_number(b)%conc_p(nzt,:,:) |
|---|
| 7614 | DO c = 1, ncc_tot |
|---|
| 7615 | aerosol_mass((c-1)*nbins+b)%conc_p(nzt+1,:,:) = & |
|---|
| 7616 | aerosol_mass((c-1)*nbins+b)%conc_p(nzt,:,:) |
|---|
| 7617 | ENDDO |
|---|
| 7618 | ENDDO |
|---|
| 7619 | IF ( .NOT. salsa_gases_from_chem ) THEN |
|---|
| 7620 | DO g = 1, ngast |
|---|
| 7621 | salsa_gas(g)%conc_p(nzt+1,:,:) = salsa_gas(g)%conc_p(nzt,:,:) |
|---|
| 7622 | ENDDO |
|---|
| 7623 | ENDIF |
|---|
| 7624 | |
|---|
| 7625 | ENDIF |
|---|
| 7626 | ! |
|---|
| 7627 | !-- Lateral boundary conditions at the outflow |
|---|
| 7628 | IF ( bc_radiation_s ) THEN |
|---|
| 7629 | DO b = 1, nbins |
|---|
| 7630 | aerosol_number(b)%conc_p(:,nys-1,:) = aerosol_number(b)%conc_p(:,nys,:) |
|---|
| 7631 | DO c = 1, ncc_tot |
|---|
| 7632 | aerosol_mass((c-1)*nbins+b)%conc_p(:,nys-1,:) = & |
|---|
| 7633 | aerosol_mass((c-1)*nbins+b)%conc_p(:,nys,:) |
|---|
| 7634 | ENDDO |
|---|
| 7635 | ENDDO |
|---|
| 7636 | ELSEIF ( bc_radiation_n ) THEN |
|---|
| 7637 | DO b = 1, nbins |
|---|
| 7638 | aerosol_number(b)%conc_p(:,nyn+1,:) = aerosol_number(b)%conc_p(:,nyn,:) |
|---|
| 7639 | DO c = 1, ncc_tot |
|---|
| 7640 | aerosol_mass((c-1)*nbins+b)%conc_p(:,nyn+1,:) = & |
|---|
| 7641 | aerosol_mass((c-1)*nbins+b)%conc_p(:,nyn,:) |
|---|
| 7642 | ENDDO |
|---|
| 7643 | ENDDO |
|---|
| 7644 | ELSEIF ( bc_radiation_l ) THEN |
|---|
| 7645 | DO b = 1, nbins |
|---|
| 7646 | aerosol_number(b)%conc_p(:,nxl-1,:) = aerosol_number(b)%conc_p(:,nxl,:) |
|---|
| 7647 | DO c = 1, ncc_tot |
|---|
| 7648 | aerosol_mass((c-1)*nbins+b)%conc_p(:,nxl-1,:) = & |
|---|
| 7649 | aerosol_mass((c-1)*nbins+b)%conc_p(:,nxl,:) |
|---|
| 7650 | ENDDO |
|---|
| 7651 | ENDDO |
|---|
| 7652 | ELSEIF ( bc_radiation_r ) THEN |
|---|
| 7653 | DO b = 1, nbins |
|---|
| 7654 | aerosol_number(b)%conc_p(:,nxr+1,:) = aerosol_number(b)%conc_p(:,nxr,:) |
|---|
| 7655 | DO c = 1, ncc_tot |
|---|
| 7656 | aerosol_mass((c-1)*nbins+b)%conc_p(:,nxr+1,:) = & |
|---|
| 7657 | aerosol_mass((c-1)*nbins+b)%conc_p(:,nxr,:) |
|---|
| 7658 | ENDDO |
|---|
| 7659 | ENDDO |
|---|
| 7660 | ENDIF |
|---|
| 7661 | |
|---|
| 7662 | END SUBROUTINE salsa_boundary_conds |
|---|
| 7663 | |
|---|
| 7664 | !------------------------------------------------------------------------------! |
|---|
| 7665 | ! Description: |
|---|
| 7666 | ! ------------ |
|---|
| 7667 | ! Undoing of the previously done cyclic boundary conditions. |
|---|
| 7668 | !------------------------------------------------------------------------------! |
|---|
| 7669 | SUBROUTINE salsa_boundary_conds_decycle ( sq, sq_init ) |
|---|
| 7670 | |
|---|
| 7671 | IMPLICIT NONE |
|---|
| 7672 | |
|---|
| 7673 | INTEGER(iwp) :: boundary !< |
|---|
| 7674 | INTEGER(iwp) :: ee !< |
|---|
| 7675 | INTEGER(iwp) :: copied !< |
|---|
| 7676 | INTEGER(iwp) :: i !< |
|---|
| 7677 | INTEGER(iwp) :: j !< |
|---|
| 7678 | INTEGER(iwp) :: k !< |
|---|
| 7679 | INTEGER(iwp) :: ss !< |
|---|
| 7680 | REAL(wp), DIMENSION(nzb:nzt+1) :: sq_init |
|---|
| 7681 | REAL(wp), DIMENSION(nzb:nzt+1,nysg:nyng,nxlg:nxrg) :: sq |
|---|
| 7682 | REAL(wp) :: flag !< flag to mask topography grid points |
|---|
| 7683 | |
|---|
| 7684 | flag = 0.0_wp |
|---|
| 7685 | ! |
|---|
| 7686 | !-- Left and right boundaries |
|---|
| 7687 | IF ( decycle_lr .AND. ( bc_lr_cyc .OR. bc_lr == 'nested' ) ) THEN |
|---|
| 7688 | |
|---|
| 7689 | DO boundary = 1, 2 |
|---|
| 7690 | |
|---|
| 7691 | IF ( decycle_method(boundary) == 'dirichlet' ) THEN |
|---|
| 7692 | ! |
|---|
| 7693 | !-- Initial profile is copied to ghost and first three layers |
|---|
| 7694 | ss = 1 |
|---|
| 7695 | ee = 0 |
|---|
| 7696 | IF ( boundary == 1 .AND. nxl == 0 ) THEN |
|---|
| 7697 | ss = nxlg |
|---|
| 7698 | ee = nxl+2 |
|---|
| 7699 | ELSEIF ( boundary == 2 .AND. nxr == nx ) THEN |
|---|
| 7700 | ss = nxr-2 |
|---|
| 7701 | ee = nxrg |
|---|
| 7702 | ENDIF |
|---|
| 7703 | |
|---|
| 7704 | DO i = ss, ee |
|---|
| 7705 | DO j = nysg, nyng |
|---|
| 7706 | DO k = nzb+1, nzt |
|---|
| 7707 | flag = MERGE( 1.0_wp, 0.0_wp, & |
|---|
| 7708 | BTEST( wall_flags_0(k,j,i), 0 ) ) |
|---|
| 7709 | sq(k,j,i) = sq_init(k) * flag |
|---|
| 7710 | ENDDO |
|---|
| 7711 | ENDDO |
|---|
| 7712 | ENDDO |
|---|
| 7713 | |
|---|
| 7714 | ELSEIF ( decycle_method(boundary) == 'neumann' ) THEN |
|---|
| 7715 | ! |
|---|
| 7716 | !-- The value at the boundary is copied to the ghost layers to simulate |
|---|
| 7717 | !-- an outlet with zero gradient |
|---|
| 7718 | ss = 1 |
|---|
| 7719 | ee = 0 |
|---|
| 7720 | IF ( boundary == 1 .AND. nxl == 0 ) THEN |
|---|
| 7721 | ss = nxlg |
|---|
| 7722 | ee = nxl-1 |
|---|
| 7723 | copied = nxl |
|---|
| 7724 | ELSEIF ( boundary == 2 .AND. nxr == nx ) THEN |
|---|
| 7725 | ss = nxr+1 |
|---|
| 7726 | ee = nxrg |
|---|
| 7727 | copied = nxr |
|---|
| 7728 | ENDIF |
|---|
| 7729 | |
|---|
| 7730 | DO i = ss, ee |
|---|
| 7731 | DO j = nysg, nyng |
|---|
| 7732 | DO k = nzb+1, nzt |
|---|
| 7733 | flag = MERGE( 1.0_wp, 0.0_wp, & |
|---|
| 7734 | BTEST( wall_flags_0(k,j,i), 0 ) ) |
|---|
| 7735 | sq(k,j,i) = sq(k,j,copied) * flag |
|---|
| 7736 | ENDDO |
|---|
| 7737 | ENDDO |
|---|
| 7738 | ENDDO |
|---|
| 7739 | |
|---|
| 7740 | ELSE |
|---|
| 7741 | WRITE(message_string,*) & |
|---|
| 7742 | 'unknown decycling method: decycle_method (', & |
|---|
| 7743 | boundary, ') ="' // TRIM( decycle_method(boundary) ) // '"' |
|---|
| 7744 | CALL message( 'salsa_boundary_conds_decycle', 'SA0029', & |
|---|
| 7745 | 1, 2, 0, 6, 0 ) |
|---|
| 7746 | ENDIF |
|---|
| 7747 | ENDDO |
|---|
| 7748 | ENDIF |
|---|
| 7749 | |
|---|
| 7750 | ! |
|---|
| 7751 | !-- South and north boundaries |
|---|
| 7752 | IF ( decycle_ns .AND. ( bc_ns_cyc .OR. bc_ns == 'nested' ) ) THEN |
|---|
| 7753 | |
|---|
| 7754 | DO boundary = 3, 4 |
|---|
| 7755 | |
|---|
| 7756 | IF ( decycle_method(boundary) == 'dirichlet' ) THEN |
|---|
| 7757 | ! |
|---|
| 7758 | !-- Initial profile is copied to ghost and first three layers |
|---|
| 7759 | ss = 1 |
|---|
| 7760 | ee = 0 |
|---|
| 7761 | IF ( boundary == 3 .AND. nys == 0 ) THEN |
|---|
| 7762 | ss = nysg |
|---|
| 7763 | ee = nys+2 |
|---|
| 7764 | ELSEIF ( boundary == 4 .AND. nyn == ny ) THEN |
|---|
| 7765 | ss = nyn-2 |
|---|
| 7766 | ee = nyng |
|---|
| 7767 | ENDIF |
|---|
| 7768 | |
|---|
| 7769 | DO i = nxlg, nxrg |
|---|
| 7770 | DO j = ss, ee |
|---|
| 7771 | DO k = nzb+1, nzt |
|---|
| 7772 | flag = MERGE( 1.0_wp, 0.0_wp, & |
|---|
| 7773 | BTEST( wall_flags_0(k,j,i), 0 ) ) |
|---|
| 7774 | sq(k,j,i) = sq_init(k) * flag |
|---|
| 7775 | ENDDO |
|---|
| 7776 | ENDDO |
|---|
| 7777 | ENDDO |
|---|
| 7778 | |
|---|
| 7779 | ELSEIF ( decycle_method(boundary) == 'neumann' ) THEN |
|---|
| 7780 | ! |
|---|
| 7781 | !-- The value at the boundary is copied to the ghost layers to simulate |
|---|
| 7782 | !-- an outlet with zero gradient |
|---|
| 7783 | ss = 1 |
|---|
| 7784 | ee = 0 |
|---|
| 7785 | IF ( boundary == 3 .AND. nys == 0 ) THEN |
|---|
| 7786 | ss = nysg |
|---|
| 7787 | ee = nys-1 |
|---|
| 7788 | copied = nys |
|---|
| 7789 | ELSEIF ( boundary == 4 .AND. nyn == ny ) THEN |
|---|
| 7790 | ss = nyn+1 |
|---|
| 7791 | ee = nyng |
|---|
| 7792 | copied = nyn |
|---|
| 7793 | ENDIF |
|---|
| 7794 | |
|---|
| 7795 | DO i = nxlg, nxrg |
|---|
| 7796 | DO j = ss, ee |
|---|
| 7797 | DO k = nzb+1, nzt |
|---|
| 7798 | flag = MERGE( 1.0_wp, 0.0_wp, & |
|---|
| 7799 | BTEST( wall_flags_0(k,j,i), 0 ) ) |
|---|
| 7800 | sq(k,j,i) = sq(k,copied,i) * flag |
|---|
| 7801 | ENDDO |
|---|
| 7802 | ENDDO |
|---|
| 7803 | ENDDO |
|---|
| 7804 | |
|---|
| 7805 | ELSE |
|---|
| 7806 | WRITE(message_string,*) & |
|---|
| 7807 | 'unknown decycling method: decycle_method (', & |
|---|
| 7808 | boundary, ') ="' // TRIM( decycle_method(boundary) ) // '"' |
|---|
| 7809 | CALL message( 'salsa_boundary_conds_decycle', 'SA0030', & |
|---|
| 7810 | 1, 2, 0, 6, 0 ) |
|---|
| 7811 | ENDIF |
|---|
| 7812 | ENDDO |
|---|
| 7813 | ENDIF |
|---|
| 7814 | |
|---|
| 7815 | END SUBROUTINE salsa_boundary_conds_decycle |
|---|
| 7816 | |
|---|
| 7817 | !------------------------------------------------------------------------------! |
|---|
| 7818 | ! Description: |
|---|
| 7819 | ! ------------ |
|---|
| 7820 | !> Calculates the total dry or wet mass concentration for individual bins |
|---|
| 7821 | !> Juha Tonttila (FMI) 2015 |
|---|
| 7822 | !> Tomi Raatikainen (FMI) 2016 |
|---|
| 7823 | !------------------------------------------------------------------------------! |
|---|
| 7824 | SUBROUTINE bin_mixrat( itype, ibin, i, j, mconc ) |
|---|
| 7825 | |
|---|
| 7826 | IMPLICIT NONE |
|---|
| 7827 | |
|---|
| 7828 | CHARACTER(len=*), INTENT(in) :: itype !< 'dry' or 'wet' |
|---|
| 7829 | INTEGER(iwp), INTENT(in) :: ibin !< index of the chemical component |
|---|
| 7830 | INTEGER(iwp), INTENT(in) :: i !< loop index for x-direction |
|---|
| 7831 | INTEGER(iwp), INTENT(in) :: j !< loop index for y-direction |
|---|
| 7832 | REAL(wp), DIMENSION(:), INTENT(out) :: mconc !< total dry or wet mass |
|---|
| 7833 | !< concentration |
|---|
| 7834 | |
|---|
| 7835 | INTEGER(iwp) :: c !< loop index for mass bin number |
|---|
| 7836 | INTEGER(iwp) :: iend !< end index: include water or not |
|---|
| 7837 | |
|---|
| 7838 | !-- Number of components |
|---|
| 7839 | IF ( itype == 'dry' ) THEN |
|---|
| 7840 | iend = get_n_comp( prtcl ) - 1 |
|---|
| 7841 | ELSE IF ( itype == 'wet' ) THEN |
|---|
| 7842 | iend = get_n_comp( prtcl ) |
|---|
| 7843 | ELSE |
|---|
| 7844 | STOP 'bin_mixrat: Error in itype' |
|---|
| 7845 | ENDIF |
|---|
| 7846 | |
|---|
| 7847 | mconc = 0.0_wp |
|---|
| 7848 | |
|---|
| 7849 | DO c = ibin, iend*nbins+ibin, nbins !< every nbins'th element |
|---|
| 7850 | mconc = mconc + aerosol_mass(c)%conc(:,j,i) |
|---|
| 7851 | ENDDO |
|---|
| 7852 | |
|---|
| 7853 | END SUBROUTINE bin_mixrat |
|---|
| 7854 | |
|---|
| 7855 | !------------------------------------------------------------------------------! |
|---|
| 7856 | !> Description: |
|---|
| 7857 | !> ------------ |
|---|
| 7858 | !> Define aerosol fluxes: constant or read from a from file |
|---|
| 7859 | !------------------------------------------------------------------------------! |
|---|
| 7860 | SUBROUTINE salsa_set_source |
|---|
| 7861 | |
|---|
| 7862 | ! USE date_and_time_mod, & |
|---|
| 7863 | ! ONLY: index_dd, index_hh, index_mm |
|---|
| 7864 | #if defined( __netcdf ) |
|---|
| 7865 | USE NETCDF |
|---|
| 7866 | |
|---|
| 7867 | USE netcdf_data_input_mod, & |
|---|
| 7868 | ONLY: get_attribute, netcdf_data_input_get_dimension_length, & |
|---|
| 7869 | get_variable, open_read_file |
|---|
| 7870 | |
|---|
| 7871 | USE surface_mod, & |
|---|
| 7872 | ONLY: surf_def_h, surf_lsm_h, surf_usm_h |
|---|
| 7873 | |
|---|
| 7874 | IMPLICIT NONE |
|---|
| 7875 | |
|---|
| 7876 | INTEGER(iwp), PARAMETER :: ndm = 3 !< number of default modes |
|---|
| 7877 | INTEGER(iwp), PARAMETER :: ndc = 4 !< number of default categories |
|---|
| 7878 | |
|---|
| 7879 | CHARACTER (LEN=10) :: unita !< Unit of aerosol fluxes |
|---|
| 7880 | CHARACTER (LEN=10) :: unitg !< Unit of gaseous fluxes |
|---|
| 7881 | INTEGER(iwp) :: b !< loop index: aerosol number bins |
|---|
| 7882 | INTEGER(iwp) :: c !< loop index: aerosol chemical components |
|---|
| 7883 | INTEGER(iwp) :: ee !< loop index: end |
|---|
| 7884 | INTEGER(iwp), ALLOCATABLE, DIMENSION(:) :: eci !< emission category index |
|---|
| 7885 | INTEGER(iwp) :: g !< loop index: gaseous tracers |
|---|
| 7886 | INTEGER(iwp) :: i !< loop index: x-direction |
|---|
| 7887 | INTEGER(iwp) :: id_faero !< NetCDF id of aerosol source input file |
|---|
| 7888 | INTEGER(iwp) :: id_fchem !< NetCDF id of aerosol source input file |
|---|
| 7889 | INTEGER(iwp) :: id_sa !< NetCDF id of variable: source |
|---|
| 7890 | INTEGER(iwp) :: j !< loop index: y-direction |
|---|
| 7891 | INTEGER(iwp) :: k !< loop index: z-direction |
|---|
| 7892 | INTEGER(iwp) :: kg !< loop index: z-direction (gases) |
|---|
| 7893 | INTEGER(iwp) :: n_dt !< number of time steps in the emission file |
|---|
| 7894 | INTEGER(iwp) :: nc_stat !< local variable for storing the result of |
|---|
| 7895 | !< netCDF calls for error message handling |
|---|
| 7896 | INTEGER(iwp) :: nb_file !< Number of grid-points in file (bins) |
|---|
| 7897 | INTEGER(iwp) :: ncat !< Number of emission categories |
|---|
| 7898 | INTEGER(iwp) :: ng_file !< Number of grid-points in file (gases) |
|---|
| 7899 | INTEGER(iwp) :: num_vars !< number of variables in input file |
|---|
| 7900 | INTEGER(iwp) :: nz_file !< number of grid-points in file |
|---|
| 7901 | INTEGER(iwp) :: n !< loop index |
|---|
| 7902 | INTEGER(iwp) :: ni !< loop index |
|---|
| 7903 | INTEGER(iwp) :: ss !< loop index |
|---|
| 7904 | LOGICAL :: netcdf_extend = .FALSE. !< Flag indicating wether netcdf |
|---|
| 7905 | !< topography input file or not |
|---|
| 7906 | REAL(wp), ALLOCATABLE, DIMENSION(:,:,:,:) :: dum_var_4d !< variable for |
|---|
| 7907 | !< temporary data |
|---|
| 7908 | REAL(wp) :: fillval !< fill value |
|---|
| 7909 | REAL(wp) :: flag !< flag to mask topography grid points |
|---|
| 7910 | REAL(wp), DIMENSION(nbins) :: nsect_emission !< sectional emission (lod1) |
|---|
| 7911 | REAL(wp), ALLOCATABLE, DIMENSION(:,:,:) :: pm_emission !< aerosol mass |
|---|
| 7912 | !< emission (lod1) |
|---|
| 7913 | REAL(wp), DIMENSION(nbins) :: source_ijka !< aerosol source at (k,j,i) |
|---|
| 7914 | ! |
|---|
| 7915 | !-- The default size distribution and mass composition per emission category: |
|---|
| 7916 | !-- 1 = traffic, 2 = road dust, 3 = wood combustion, 4 = other |
|---|
| 7917 | !-- Mass fractions: H2SO4, OC, BC, DU, SS, HNO3, NH3 |
|---|
| 7918 | CHARACTER(LEN=15), DIMENSION(ndc) :: cat_name_table = &!< emission category |
|---|
| 7919 | (/'road traffic ','road dust ',& |
|---|
| 7920 | 'wood combustion','other '/) |
|---|
| 7921 | REAL(wp), DIMENSION(ndc) :: avg_density !< average density |
|---|
| 7922 | REAL(wp), DIMENSION(ndc) :: conversion_factor !< unit conversion factor |
|---|
| 7923 | !< for aerosol emissions |
|---|
| 7924 | REAL(wp), DIMENSION(ndm), PARAMETER :: dpg_table = & !< mean diameter (mum) |
|---|
| 7925 | (/ 13.5E-3_wp, 1.4_wp, 5.4E-2_wp/) |
|---|
| 7926 | REAL(wp), DIMENSION(ndm) :: ntot_table |
|---|
| 7927 | REAL(wp), DIMENSION(maxspec,ndc), PARAMETER :: mass_fraction_table = & |
|---|
| 7928 | RESHAPE( (/ 0.04_wp, 0.48_wp, 0.48_wp, 0.0_wp, 0.0_wp, 0.0_wp, 0.0_wp, & |
|---|
| 7929 | 0.0_wp, 0.05_wp, 0.0_wp, 0.95_wp, 0.0_wp, 0.0_wp, 0.0_wp, & |
|---|
| 7930 | 0.0_wp, 0.5_wp, 0.5_wp, 0.0_wp, 0.0_wp, 0.0_wp, 0.0_wp, & |
|---|
| 7931 | 0.0_wp, 0.5_wp, 0.5_wp, 0.0_wp, 0.0_wp, 0.0_wp, 0.0_wp & |
|---|
| 7932 | /), (/maxspec,ndc/) ) |
|---|
| 7933 | REAL(wp), DIMENSION(ndm,ndc), PARAMETER :: PMfrac_table = & !< rel. mass |
|---|
| 7934 | RESHAPE( (/ 0.016_wp, 0.000_wp, 0.984_wp, & |
|---|
| 7935 | 0.000_wp, 1.000_wp, 0.000_wp, & |
|---|
| 7936 | 0.000_wp, 0.000_wp, 1.000_wp, & |
|---|
| 7937 | 1.000_wp, 0.000_wp, 1.000_wp & |
|---|
| 7938 | /), (/ndm,ndc/) ) |
|---|
| 7939 | REAL(wp), DIMENSION(ndm), PARAMETER :: sigmag_table = & !< mode std |
|---|
| 7940 | (/1.6_wp, 1.4_wp, 1.7_wp/) |
|---|
| 7941 | avg_density = 1.0_wp |
|---|
| 7942 | nb_file = 0 |
|---|
| 7943 | ng_file = 0 |
|---|
| 7944 | nsect_emission = 0.0_wp |
|---|
| 7945 | nz_file = 0 |
|---|
| 7946 | source_ijka = 0.0_wp |
|---|
| 7947 | ! |
|---|
| 7948 | !-- First gases, if needed: |
|---|
| 7949 | IF ( .NOT. salsa_gases_from_chem ) THEN |
|---|
| 7950 | ! |
|---|
| 7951 | !-- Read sources from PIDS_CHEM |
|---|
| 7952 | INQUIRE( FILE='PIDS_CHEM' // TRIM( coupling_char ), EXIST=netcdf_extend ) |
|---|
| 7953 | IF ( .NOT. netcdf_extend ) THEN |
|---|
| 7954 | message_string = 'Input file '// TRIM( 'PIDS_CHEM' ) // & |
|---|
| 7955 | TRIM( coupling_char ) // ' for SALSA missing!' |
|---|
| 7956 | CALL message( 'salsa_mod: salsa_set_source', 'SA0027', 1, 2, 0, 6, 0 ) |
|---|
| 7957 | ENDIF ! netcdf_extend |
|---|
| 7958 | |
|---|
| 7959 | CALL location_message( ' salsa_set_source: NOTE! Gaseous emissions'//& |
|---|
| 7960 | ' should be provided with following emission indices:'// & |
|---|
| 7961 | ' 1=H2SO4, 2=HNO3, 3=NH3, 4=OCNV, 5=OCSV', .TRUE. ) |
|---|
| 7962 | CALL location_message( ' salsa_set_source: No time dependency for '//& |
|---|
| 7963 | 'gaseous emissions. Use emission_values '// & |
|---|
| 7964 | 'directly.', .TRUE. ) |
|---|
| 7965 | ! |
|---|
| 7966 | !-- Open PIDS_CHEM in read-only mode |
|---|
| 7967 | CALL open_read_file( 'PIDS_CHEM' // TRIM( coupling_char ), id_fchem ) |
|---|
| 7968 | ! |
|---|
| 7969 | !-- Inquire the level of detail (lod) |
|---|
| 7970 | CALL get_attribute( id_fchem, 'lod', lod_gases, .FALSE., & |
|---|
| 7971 | "emission_values" ) |
|---|
| 7972 | |
|---|
| 7973 | IF ( lod_gases == 2 ) THEN |
|---|
| 7974 | ! |
|---|
| 7975 | !-- Index of gaseous compounds |
|---|
| 7976 | CALL netcdf_data_input_get_dimension_length( id_fchem, ng_file, "nspecies" ) |
|---|
| 7977 | IF ( ng_file < 5 ) THEN |
|---|
| 7978 | message_string = 'Some gaseous emissions missing.' |
|---|
| 7979 | CALL message( 'salsa_mod: salsa_set_source', 'SA0041', & |
|---|
| 7980 | 1, 2, 0, 6, 0 ) |
|---|
| 7981 | ENDIF |
|---|
| 7982 | ! |
|---|
| 7983 | !-- Get number of emission categories |
|---|
| 7984 | CALL netcdf_data_input_get_dimension_length( id_fchem, ncat, "ncat" ) |
|---|
| 7985 | ! |
|---|
| 7986 | !-- Inquire the unit of gaseous fluxes |
|---|
| 7987 | CALL get_attribute( id_fchem, 'units', unitg, .FALSE., & |
|---|
| 7988 | "emission_values") |
|---|
| 7989 | ! |
|---|
| 7990 | !-- Inquire the fill value |
|---|
| 7991 | CALL get_attribute( id_fchem, '_FillValue', fillval, .FALSE., & |
|---|
| 7992 | "emission_values" ) |
|---|
| 7993 | ! |
|---|
| 7994 | !-- Read surface emission data (x,y) PE-wise |
|---|
| 7995 | ALLOCATE( dum_var_4d(ng_file,ncat,nys:nyn,nxl:nxr) ) |
|---|
| 7996 | CALL get_variable( id_fchem, 'emission_values', dum_var_4d, nxl, nxr,& |
|---|
| 7997 | nys, nyn, 0, ncat-1, 0, ng_file-1 ) |
|---|
| 7998 | DO g = 1, ngast |
|---|
| 7999 | ALLOCATE( salsa_gas(g)%source(ncat,nys:nyn,nxl:nxr) ) |
|---|
| 8000 | salsa_gas(g)%source = 0.0_wp |
|---|
| 8001 | salsa_gas(g)%source = salsa_gas(g)%source + dum_var_4d(g,:,:,:) |
|---|
| 8002 | ENDDO |
|---|
| 8003 | ! |
|---|
| 8004 | !-- Set surface fluxes of gaseous compounds on horizontal surfaces. |
|---|
| 8005 | !-- Set fluxes only for either default, land or urban surface. |
|---|
| 8006 | IF ( .NOT. land_surface .AND. .NOT. urban_surface ) THEN |
|---|
| 8007 | CALL set_gas_flux( surf_def_h(0), ncat, unitg ) |
|---|
| 8008 | ELSE |
|---|
| 8009 | CALL set_gas_flux( surf_lsm_h, ncat, unitg ) |
|---|
| 8010 | CALL set_gas_flux( surf_usm_h, ncat, unitg ) |
|---|
| 8011 | ENDIF |
|---|
| 8012 | |
|---|
| 8013 | DEALLOCATE( dum_var_4d ) |
|---|
| 8014 | DO g = 1, ngast |
|---|
| 8015 | DEALLOCATE( salsa_gas(g)%source ) |
|---|
| 8016 | ENDDO |
|---|
| 8017 | ELSE |
|---|
| 8018 | message_string = 'Input file PIDS_CHEM needs to have lod = 2 when '//& |
|---|
| 8019 | 'SALSA is applied but not the chemistry module!' |
|---|
| 8020 | CALL message( 'salsa_mod: salsa_set_source', 'SA0039', 1, 2, 0, 6, 0 ) |
|---|
| 8021 | ENDIF |
|---|
| 8022 | ENDIF |
|---|
| 8023 | ! |
|---|
| 8024 | !-- Read sources from PIDS_SALSA |
|---|
| 8025 | INQUIRE( FILE='PIDS_SALSA' // TRIM( coupling_char ), EXIST=netcdf_extend ) |
|---|
| 8026 | IF ( .NOT. netcdf_extend ) THEN |
|---|
| 8027 | message_string = 'Input file '// TRIM( 'PIDS_SALSA' ) // & |
|---|
| 8028 | TRIM( coupling_char ) // ' for SALSA missing!' |
|---|
| 8029 | CALL message( 'salsa_mod: salsa_set_source', 'SA0034', 1, 2, 0, 6, 0 ) |
|---|
| 8030 | ENDIF ! netcdf_extend |
|---|
| 8031 | ! |
|---|
| 8032 | !-- Open file in read-only mode |
|---|
| 8033 | CALL open_read_file( 'PIDS_SALSA' // TRIM( coupling_char ), id_faero ) |
|---|
| 8034 | ! |
|---|
| 8035 | !-- Get number of emission categories and their indices |
|---|
| 8036 | CALL netcdf_data_input_get_dimension_length( id_faero, ncat, "ncat" ) |
|---|
| 8037 | ! |
|---|
| 8038 | !-- Get emission category indices |
|---|
| 8039 | ALLOCATE( eci(1:ncat) ) |
|---|
| 8040 | CALL get_variable( id_faero, 'emission_category_index', eci ) |
|---|
| 8041 | ! |
|---|
| 8042 | !-- Inquire the level of detail (lod) |
|---|
| 8043 | CALL get_attribute( id_faero, 'lod', lod_aero, .FALSE., & |
|---|
| 8044 | "aerosol_emission_values" ) |
|---|
| 8045 | |
|---|
| 8046 | IF ( lod_aero < 3 .AND. ibc_salsa_b == 0 ) THEN |
|---|
| 8047 | message_string = 'lod1/2 for aerosol emissions requires '// & |
|---|
| 8048 | 'bc_salsa_b = "Neumann"' |
|---|
| 8049 | CALL message( 'salsa_mod: salsa_set_source','SA0025', 1, 2, 0, 6, 0 ) |
|---|
| 8050 | ENDIF |
|---|
| 8051 | ! |
|---|
| 8052 | !-- Inquire the fill value |
|---|
| 8053 | CALL get_attribute( id_faero, '_FillValue', fillval, .FALSE., & |
|---|
| 8054 | "aerosol_emission_values" ) |
|---|
| 8055 | ! |
|---|
| 8056 | !-- Aerosol chemical composition: |
|---|
| 8057 | ALLOCATE( emission_mass_fracs(1:ncat,1:maxspec) ) |
|---|
| 8058 | emission_mass_fracs = 0.0_wp |
|---|
| 8059 | !-- Chemical composition: 1: H2SO4 (sulphuric acid), 2: OC (organic carbon), |
|---|
| 8060 | !-- 3: BC (black carbon), 4: DU (dust), |
|---|
| 8061 | !-- 5: SS (sea salt), 6: HNO3 (nitric acid), |
|---|
| 8062 | !-- 7: NH3 (ammonia) |
|---|
| 8063 | DO n = 1, ncat |
|---|
| 8064 | IF ( lod_aero < 2 ) THEN |
|---|
| 8065 | emission_mass_fracs(n,:) = mass_fraction_table(:,n) |
|---|
| 8066 | ELSE |
|---|
| 8067 | CALL get_variable( id_faero, "emission_mass_fracs", & |
|---|
| 8068 | emission_mass_fracs(n,:) ) |
|---|
| 8069 | ENDIF |
|---|
| 8070 | ! |
|---|
| 8071 | !-- If the chemical component is not activated, set its mass fraction to 0 |
|---|
| 8072 | !-- to avoid inbalance between number and mass flux |
|---|
| 8073 | IF ( iso4 < 0 ) emission_mass_fracs(n,1) = 0.0_wp |
|---|
| 8074 | IF ( ioc < 0 ) emission_mass_fracs(n,2) = 0.0_wp |
|---|
| 8075 | IF ( ibc < 0 ) emission_mass_fracs(n,3) = 0.0_wp |
|---|
| 8076 | IF ( idu < 0 ) emission_mass_fracs(n,4) = 0.0_wp |
|---|
| 8077 | IF ( iss < 0 ) emission_mass_fracs(n,5) = 0.0_wp |
|---|
| 8078 | IF ( ino < 0 ) emission_mass_fracs(n,6) = 0.0_wp |
|---|
| 8079 | IF ( inh < 0 ) emission_mass_fracs(n,7) = 0.0_wp |
|---|
| 8080 | !-- Then normalise the mass fraction so that SUM = 1 |
|---|
| 8081 | emission_mass_fracs(n,:) = emission_mass_fracs(n,:) / & |
|---|
| 8082 | SUM( emission_mass_fracs(n,:) ) |
|---|
| 8083 | ENDDO |
|---|
| 8084 | |
|---|
| 8085 | IF ( lod_aero > 1 ) THEN |
|---|
| 8086 | ! |
|---|
| 8087 | !-- Aerosol geometric mean diameter |
|---|
| 8088 | CALL netcdf_data_input_get_dimension_length( id_faero, nb_file, 'Dmid' ) |
|---|
| 8089 | IF ( nb_file /= nbins ) THEN |
|---|
| 8090 | message_string = 'The number of size bins in aerosol input data '// & |
|---|
| 8091 | 'does not correspond to the model set-up' |
|---|
| 8092 | CALL message( 'salsa_mod: salsa_set_source','SA0040', 1, 2, 0, 6, 0 ) |
|---|
| 8093 | ENDIF |
|---|
| 8094 | ENDIF |
|---|
| 8095 | |
|---|
| 8096 | IF ( lod_aero < 3 ) THEN |
|---|
| 8097 | CALL location_message( ' salsa_set_source: No time dependency for '//& |
|---|
| 8098 | 'aerosol emissions. Use aerosol_emission_values'//& |
|---|
| 8099 | ' directly.', .TRUE. ) |
|---|
| 8100 | ! |
|---|
| 8101 | !-- Allocate source arrays |
|---|
| 8102 | DO b = 1, nbins |
|---|
| 8103 | ALLOCATE( aerosol_number(b)%source(1:ncat,nys:nyn,nxl:nxr) ) |
|---|
| 8104 | aerosol_number(b)%source = 0.0_wp |
|---|
| 8105 | ENDDO |
|---|
| 8106 | DO c = 1, ncc_tot*nbins |
|---|
| 8107 | ALLOCATE( aerosol_mass(c)%source(1:ncat,nys:nyn,nxl:nxr) ) |
|---|
| 8108 | aerosol_mass(c)%source = 0.0_wp |
|---|
| 8109 | ENDDO |
|---|
| 8110 | |
|---|
| 8111 | IF ( lod_aero == 1 ) THEN |
|---|
| 8112 | DO n = 1, ncat |
|---|
| 8113 | avg_density(n) = emission_mass_fracs(n,1) * arhoh2so4 + & |
|---|
| 8114 | emission_mass_fracs(n,2) * arhooc + & |
|---|
| 8115 | emission_mass_fracs(n,3) * arhobc + & |
|---|
| 8116 | emission_mass_fracs(n,4) * arhodu + & |
|---|
| 8117 | emission_mass_fracs(n,5) * arhoss + & |
|---|
| 8118 | emission_mass_fracs(n,6) * arhohno3 + & |
|---|
| 8119 | emission_mass_fracs(n,7) * arhonh3 |
|---|
| 8120 | ENDDO |
|---|
| 8121 | ! |
|---|
| 8122 | !-- Emission unit |
|---|
| 8123 | CALL get_attribute( id_faero, 'units', unita, .FALSE., & |
|---|
| 8124 | "aerosol_emission_values") |
|---|
| 8125 | conversion_factor = 1.0_wp |
|---|
| 8126 | IF ( unita == 'kg/m2/yr' ) THEN |
|---|
| 8127 | conversion_factor = 3.170979e-8_wp / avg_density |
|---|
| 8128 | ELSEIF ( unita == 'g/m2/yr' ) THEN |
|---|
| 8129 | conversion_factor = 3.170979e-8_wp * 1.0E-3_wp / avg_density |
|---|
| 8130 | ELSEIF ( unita == 'kg/m2/s' ) THEN |
|---|
| 8131 | conversion_factor = 1.0_wp / avg_density |
|---|
| 8132 | ELSEIF ( unita == 'g/m2/s' ) THEN |
|---|
| 8133 | conversion_factor = 1.0E-3_wp / avg_density |
|---|
| 8134 | ELSE |
|---|
| 8135 | message_string = 'unknown unit for aerosol emissions: ' & |
|---|
| 8136 | // TRIM( unita ) // ' (lod1)' |
|---|
| 8137 | CALL message( 'salsa_mod: salsa_set_source','SA0035', & |
|---|
| 8138 | 1, 2, 0, 6, 0 ) |
|---|
| 8139 | ENDIF |
|---|
| 8140 | ! |
|---|
| 8141 | !-- Read surface emission data (x,y) PE-wise |
|---|
| 8142 | ALLOCATE( pm_emission(ncat,nys:nyn,nxl:nxr) ) |
|---|
| 8143 | CALL get_variable( id_faero, 'aerosol_emission_values', pm_emission, & |
|---|
| 8144 | nxl, nxr, nys, nyn, 0, ncat-1 ) |
|---|
| 8145 | DO ni = 1, SIZE( eci ) |
|---|
| 8146 | n = eci(ni) |
|---|
| 8147 | ! |
|---|
| 8148 | !-- Calculate the number concentration of a log-normal size |
|---|
| 8149 | !-- distribution following Jacobson (2005): Eq 13.25. |
|---|
| 8150 | ntot_table = 6.0_wp * PMfrac_table(:,n) / ( pi * dpg_table**3 * & |
|---|
| 8151 | EXP( 4.5_wp * LOG( sigmag_table )**2 ) ) * 1.0E+12_wp |
|---|
| 8152 | ! |
|---|
| 8153 | !-- Sectional size distibution from a log-normal one |
|---|
| 8154 | CALL size_distribution( ntot_table, dpg_table, sigmag_table, & |
|---|
| 8155 | nsect_emission ) |
|---|
| 8156 | DO b = 1, nbins |
|---|
| 8157 | aerosol_number(b)%source(ni,:,:) = & |
|---|
| 8158 | aerosol_number(b)%source(ni,:,:) + & |
|---|
| 8159 | pm_emission(ni,:,:) * conversion_factor(n) & |
|---|
| 8160 | * nsect_emission(b) |
|---|
| 8161 | ENDDO |
|---|
| 8162 | ENDDO |
|---|
| 8163 | ELSEIF ( lod_aero == 2 ) THEN |
|---|
| 8164 | ! |
|---|
| 8165 | !-- Read surface emission data (x,y) PE-wise |
|---|
| 8166 | ALLOCATE( dum_var_4d(nb_file,ncat,nys:nyn,nxl:nxr) ) |
|---|
| 8167 | CALL get_variable( id_faero, 'aerosol_emission_values', dum_var_4d, & |
|---|
| 8168 | nxl, nxr, nys, nyn, 0, ncat-1, 0, nb_file-1 ) |
|---|
| 8169 | DO b = 1, nbins |
|---|
| 8170 | aerosol_number(b)%source = dum_var_4d(b,:,:,:) |
|---|
| 8171 | ENDDO |
|---|
| 8172 | DEALLOCATE( dum_var_4d ) |
|---|
| 8173 | ENDIF |
|---|
| 8174 | ! |
|---|
| 8175 | !-- Set surface fluxes of aerosol number and mass on horizontal surfaces. |
|---|
| 8176 | !-- Set fluxes only for either default, land or urban surface. |
|---|
| 8177 | IF ( .NOT. land_surface .AND. .NOT. urban_surface ) THEN |
|---|
| 8178 | CALL set_flux( surf_def_h(0), ncat ) |
|---|
| 8179 | ELSE |
|---|
| 8180 | CALL set_flux( surf_usm_h, ncat ) |
|---|
| 8181 | CALL set_flux( surf_lsm_h, ncat ) |
|---|
| 8182 | ENDIF |
|---|
| 8183 | |
|---|
| 8184 | ELSEIF ( lod_aero == 3 ) THEN |
|---|
| 8185 | ! |
|---|
| 8186 | !-- Inquire aerosol emission rate per bin (#/(m3s)) |
|---|
| 8187 | nc_stat = NF90_INQ_VARID( id_faero, "aerosol_emission_values", id_sa ) |
|---|
| 8188 | |
|---|
| 8189 | ! |
|---|
| 8190 | !-- Emission time step |
|---|
| 8191 | CALL netcdf_data_input_get_dimension_length( id_faero, n_dt, 'dt_emission' ) |
|---|
| 8192 | IF ( n_dt > 1 ) THEN |
|---|
| 8193 | CALL location_message( ' salsa_set_source: hourly emission data'//& |
|---|
| 8194 | ' provided but currently the value of the '// & |
|---|
| 8195 | ' first hour is applied.', .TRUE. ) |
|---|
| 8196 | ENDIF |
|---|
| 8197 | ! |
|---|
| 8198 | !-- Allocate source arrays |
|---|
| 8199 | DO b = 1, nbins |
|---|
| 8200 | ALLOCATE( aerosol_number(b)%source(nzb:nzt+1,nys:nyn,nxl:nxr) ) |
|---|
| 8201 | aerosol_number(b)%source = 0.0_wp |
|---|
| 8202 | ENDDO |
|---|
| 8203 | DO c = 1, ncc_tot*nbins |
|---|
| 8204 | ALLOCATE( aerosol_mass(c)%source(nzb:nzt+1,nys:nyn,nxl:nxr) ) |
|---|
| 8205 | aerosol_mass(c)%source = 0.0_wp |
|---|
| 8206 | ENDDO |
|---|
| 8207 | ! |
|---|
| 8208 | !-- Get dimension of z-axis: |
|---|
| 8209 | CALL netcdf_data_input_get_dimension_length( id_faero, nz_file, 'z' ) |
|---|
| 8210 | ! |
|---|
| 8211 | !-- Read surface emission data (x,y) PE-wise |
|---|
| 8212 | DO i = nxl, nxr |
|---|
| 8213 | DO j = nys, nyn |
|---|
| 8214 | DO k = 0, nz_file-1 |
|---|
| 8215 | ! |
|---|
| 8216 | !-- Predetermine flag to mask topography |
|---|
| 8217 | flag = MERGE( 1.0_wp, 0.0_wp, BTEST(wall_flags_0(k,j,i), 0 )) |
|---|
| 8218 | ! |
|---|
| 8219 | !-- No sources inside buildings ! |
|---|
| 8220 | IF ( flag == 0.0_wp ) CYCLE |
|---|
| 8221 | ! |
|---|
| 8222 | !-- Read volume source: |
|---|
| 8223 | nc_stat = NF90_GET_VAR( id_faero, id_sa, source_ijka, & |
|---|
| 8224 | start = (/ i+1, j+1, k+1, 1, 1 /), & |
|---|
| 8225 | count = (/ 1, 1, 1, 1, nb_file /) ) |
|---|
| 8226 | IF ( nc_stat /= NF90_NOERR ) THEN |
|---|
| 8227 | message_string = 'error in aerosol emissions: lod3' |
|---|
| 8228 | CALL message( 'salsa_mod: salsa_set_source','SA0038', 1, 2, & |
|---|
| 8229 | 0, 6, 0 ) |
|---|
| 8230 | ENDIF |
|---|
| 8231 | ! |
|---|
| 8232 | !-- Set mass fluxes. First bins include only SO4 and/or OC. Call |
|---|
| 8233 | !-- subroutine set_mass_source for larger bins. |
|---|
| 8234 | ! |
|---|
| 8235 | !-- Sulphate and organic carbon |
|---|
| 8236 | IF ( iso4 > 0 .AND. ioc > 0 ) THEN |
|---|
| 8237 | !-- First sulphate: |
|---|
| 8238 | ss = ( iso4 - 1 ) * nbins + in1a ! start |
|---|
| 8239 | ee = ( iso4 - 1 ) * nbins + fn1a ! end |
|---|
| 8240 | b = in1a |
|---|
| 8241 | DO c = ss, ee |
|---|
| 8242 | IF ( source_ijka(b) /= fillval ) & |
|---|
| 8243 | aerosol_mass(c)%source(k,j,i) = & |
|---|
| 8244 | aerosol_mass(c)%source(k,j,i) + & |
|---|
| 8245 | emission_mass_fracs(1,1) / ( emission_mass_fracs(1,1) & |
|---|
| 8246 | + emission_mass_fracs(1,2) ) * source_ijka(b) * & |
|---|
| 8247 | aero(b)%core * arhoh2so4 |
|---|
| 8248 | b = b+1 |
|---|
| 8249 | ENDDO |
|---|
| 8250 | !-- Then organic carbon: |
|---|
| 8251 | ss = ( ioc - 1 ) * nbins + in1a ! start |
|---|
| 8252 | ee = ( ioc - 1 ) * nbins + fn1a ! end |
|---|
| 8253 | b = in1a |
|---|
| 8254 | DO c = ss, ee |
|---|
| 8255 | IF ( source_ijka(b) /= fillval ) & |
|---|
| 8256 | aerosol_mass(c)%source(k,j,i) = & |
|---|
| 8257 | aerosol_mass(c)%source(k,j,i) + & |
|---|
| 8258 | emission_mass_fracs(1,2) / ( emission_mass_fracs(1,1) & |
|---|
| 8259 | + emission_mass_fracs(1,2) ) * source_ijka(b) * & |
|---|
| 8260 | aero(b)%core * arhooc |
|---|
| 8261 | b = b+1 |
|---|
| 8262 | ENDDO |
|---|
| 8263 | |
|---|
| 8264 | CALL set_mass_source( k, j, i, iso4, & |
|---|
| 8265 | emission_mass_fracs(1,1), arhoh2so4, & |
|---|
| 8266 | source_ijka, fillval ) |
|---|
| 8267 | CALL set_mass_source( k, j, i, ioc, emission_mass_fracs(1,2),& |
|---|
| 8268 | arhooc, source_ijka, fillval ) |
|---|
| 8269 | !-- Only sulphate: |
|---|
| 8270 | ELSEIF ( iso4 > 0 .AND. ioc < 0 ) THEN |
|---|
| 8271 | ss = ( iso4 - 1 ) * nbins + in1a ! start |
|---|
| 8272 | ee = ( iso4 - 1 ) * nbins + fn1a ! end |
|---|
| 8273 | b = in1a |
|---|
| 8274 | DO c = ss, ee |
|---|
| 8275 | IF ( source_ijka(b) /= fillval ) & |
|---|
| 8276 | aerosol_mass(c)%source(k,j,i) = & |
|---|
| 8277 | aerosol_mass(c)%source(k,j,i) + source_ijka(b) * & |
|---|
| 8278 | aero(b)%core * arhoh2so4 |
|---|
| 8279 | b = b+1 |
|---|
| 8280 | ENDDO |
|---|
| 8281 | CALL set_mass_source( k, j, i, iso4, & |
|---|
| 8282 | emission_mass_fracs(1,1), arhoh2so4, & |
|---|
| 8283 | source_ijka, fillval ) |
|---|
| 8284 | !-- Only organic carbon: |
|---|
| 8285 | ELSEIF ( iso4 < 0 .AND. ioc > 0 ) THEN |
|---|
| 8286 | ss = ( ioc - 1 ) * nbins + in1a ! start |
|---|
| 8287 | ee = ( ioc - 1 ) * nbins + fn1a ! end |
|---|
| 8288 | b = in1a |
|---|
| 8289 | DO c = ss, ee |
|---|
| 8290 | IF ( source_ijka(b) /= fillval ) & |
|---|
| 8291 | aerosol_mass(c)%source(k,j,i) = & |
|---|
| 8292 | aerosol_mass(c)%source(k,j,i) + source_ijka(b) * & |
|---|
| 8293 | aero(b)%core * arhooc |
|---|
| 8294 | b = b+1 |
|---|
| 8295 | ENDDO |
|---|
| 8296 | CALL set_mass_source( k, j, i, ioc, emission_mass_fracs(1,2),& |
|---|
| 8297 | arhooc, source_ijka, fillval ) |
|---|
| 8298 | ENDIF |
|---|
| 8299 | !-- Black carbon |
|---|
| 8300 | IF ( ibc > 0 ) THEN |
|---|
| 8301 | CALL set_mass_source( k, j, i, ibc, emission_mass_fracs(1,3),& |
|---|
| 8302 | arhobc, source_ijka, fillval ) |
|---|
| 8303 | ENDIF |
|---|
| 8304 | !-- Dust |
|---|
| 8305 | IF ( idu > 0 ) THEN |
|---|
| 8306 | CALL set_mass_source( k, j, i, idu, emission_mass_fracs(1,4),& |
|---|
| 8307 | arhodu, source_ijka, fillval ) |
|---|
| 8308 | ENDIF |
|---|
| 8309 | !-- Sea salt |
|---|
| 8310 | IF ( iss > 0 ) THEN |
|---|
| 8311 | CALL set_mass_source( k, j, i, iss, emission_mass_fracs(1,5),& |
|---|
| 8312 | arhoss, source_ijka, fillval ) |
|---|
| 8313 | ENDIF |
|---|
| 8314 | !-- Nitric acid |
|---|
| 8315 | IF ( ino > 0 ) THEN |
|---|
| 8316 | CALL set_mass_source( k, j, i, ino, emission_mass_fracs(1,6),& |
|---|
| 8317 | arhohno3, source_ijka, fillval ) |
|---|
| 8318 | ENDIF |
|---|
| 8319 | !-- Ammonia |
|---|
| 8320 | IF ( inh > 0 ) THEN |
|---|
| 8321 | CALL set_mass_source( k, j, i, inh, emission_mass_fracs(1,7),& |
|---|
| 8322 | arhonh3, source_ijka, fillval ) |
|---|
| 8323 | ENDIF |
|---|
| 8324 | ! |
|---|
| 8325 | !-- Save aerosol number sources in the end |
|---|
| 8326 | DO b = 1, nbins |
|---|
| 8327 | IF ( source_ijka(b) /= fillval ) & |
|---|
| 8328 | aerosol_number(b)%source(k,j,i) = & |
|---|
| 8329 | aerosol_number(b)%source(k,j,i) + source_ijka(b) |
|---|
| 8330 | ENDDO |
|---|
| 8331 | ENDDO ! k |
|---|
| 8332 | ENDDO ! j |
|---|
| 8333 | ENDDO ! i |
|---|
| 8334 | |
|---|
| 8335 | ELSE |
|---|
| 8336 | message_string = 'NetCDF attribute lod is not set properly.' |
|---|
| 8337 | CALL message( 'salsa_mod: salsa_set_source','SA0026', 1, 2, 0, 6, 0 ) |
|---|
| 8338 | ENDIF |
|---|
| 8339 | |
|---|
| 8340 | #endif |
|---|
| 8341 | END SUBROUTINE salsa_set_source |
|---|
| 8342 | |
|---|
| 8343 | !------------------------------------------------------------------------------! |
|---|
| 8344 | ! Description: |
|---|
| 8345 | ! ------------ |
|---|
| 8346 | !> Sets the gaseous fluxes |
|---|
| 8347 | !------------------------------------------------------------------------------! |
|---|
| 8348 | SUBROUTINE set_gas_flux( surface, ncat_emission, unit ) |
|---|
| 8349 | |
|---|
| 8350 | USE arrays_3d, & |
|---|
| 8351 | ONLY: dzw, hyp, pt, rho_air_zw |
|---|
| 8352 | |
|---|
| 8353 | USE grid_variables, & |
|---|
| 8354 | ONLY: dx, dy |
|---|
| 8355 | |
|---|
| 8356 | USE surface_mod, & |
|---|
| 8357 | ONLY: surf_type |
|---|
| 8358 | |
|---|
| 8359 | IMPLICIT NONE |
|---|
| 8360 | |
|---|
| 8361 | CHARACTER(LEN=*) :: unit !< flux unit in the input file |
|---|
| 8362 | INTEGER(iwp) :: ncat_emission !< number of emission categories |
|---|
| 8363 | TYPE(surf_type), INTENT(inout) :: surface !< respective surface type |
|---|
| 8364 | INTEGER(iwp) :: g !< loop index |
|---|
| 8365 | INTEGER(iwp) :: i !< loop index |
|---|
| 8366 | INTEGER(iwp) :: j !< loop index |
|---|
| 8367 | INTEGER(iwp) :: k !< loop index |
|---|
| 8368 | INTEGER(iwp) :: m !< running index for surface elements |
|---|
| 8369 | INTEGER(iwp) :: n !< running index for emission categories |
|---|
| 8370 | REAL(wp), DIMENSION(ngast) :: conversion_factor |
|---|
| 8371 | |
|---|
| 8372 | conversion_factor = 1.0_wp |
|---|
| 8373 | |
|---|
| 8374 | DO m = 1, surface%ns |
|---|
| 8375 | ! |
|---|
| 8376 | !-- Get indices of respective grid point |
|---|
| 8377 | i = surface%i(m) |
|---|
| 8378 | j = surface%j(m) |
|---|
| 8379 | k = surface%k(m) |
|---|
| 8380 | |
|---|
| 8381 | IF ( unit == '#/m2/s' ) THEN |
|---|
| 8382 | conversion_factor = 1.0_wp |
|---|
| 8383 | ELSEIF ( unit == 'g/m2/s' ) THEN |
|---|
| 8384 | conversion_factor(1) = avo / ( amh2so4 * 1000.0_wp ) |
|---|
| 8385 | conversion_factor(2) = avo / ( amhno3 * 1000.0_wp ) |
|---|
| 8386 | conversion_factor(3) = avo / ( amnh3 * 1000.0_wp ) |
|---|
| 8387 | conversion_factor(4) = avo / ( amoc * 1000.0_wp ) |
|---|
| 8388 | conversion_factor(5) = avo / ( amoc * 1000.0_wp ) |
|---|
| 8389 | ELSEIF ( unit == 'ppm/m2/s' ) THEN |
|---|
| 8390 | conversion_factor = for_ppm_to_nconc * hyp(k) / pt(k,j,i) * ( hyp(k) & |
|---|
| 8391 | / 100000.0_wp )**0.286_wp * dx * dy * dzw(k) |
|---|
| 8392 | ELSEIF ( unit == 'mumol/m2/s' ) THEN |
|---|
| 8393 | conversion_factor = 1.0E-6_wp * avo |
|---|
| 8394 | ELSE |
|---|
| 8395 | message_string = 'Unknown unit for gaseous emissions!' |
|---|
| 8396 | CALL message( 'salsa_mod: set_gas_flux', 'SA0031', 1, 2, 0, 6, 0 ) |
|---|
| 8397 | ENDIF |
|---|
| 8398 | |
|---|
| 8399 | DO n = 1, ncat_emission |
|---|
| 8400 | DO g = 1, ngast |
|---|
| 8401 | IF ( .NOT. salsa_gas(g)%source(n,j,i) > 0.0_wp ) THEN |
|---|
| 8402 | salsa_gas(g)%source(n,j,i) = 0.0_wp |
|---|
| 8403 | CYCLE |
|---|
| 8404 | ENDIF |
|---|
| 8405 | surface%gtsws(m,g) = surface%gtsws(m,g) + & |
|---|
| 8406 | salsa_gas(g)%source(n,j,i) * rho_air_zw(k-1) & |
|---|
| 8407 | * conversion_factor(g) |
|---|
| 8408 | ENDDO |
|---|
| 8409 | ENDDO |
|---|
| 8410 | ENDDO |
|---|
| 8411 | |
|---|
| 8412 | END SUBROUTINE set_gas_flux |
|---|
| 8413 | |
|---|
| 8414 | |
|---|
| 8415 | !------------------------------------------------------------------------------! |
|---|
| 8416 | ! Description: |
|---|
| 8417 | ! ------------ |
|---|
| 8418 | !> Sets the aerosol flux to aerosol arrays in 2a and 2b. |
|---|
| 8419 | !------------------------------------------------------------------------------! |
|---|
| 8420 | SUBROUTINE set_flux( surface, ncat_emission ) |
|---|
| 8421 | |
|---|
| 8422 | USE arrays_3d, & |
|---|
| 8423 | ONLY: hyp, pt, rho_air_zw |
|---|
| 8424 | |
|---|
| 8425 | USE surface_mod, & |
|---|
| 8426 | ONLY: surf_type |
|---|
| 8427 | |
|---|
| 8428 | IMPLICIT NONE |
|---|
| 8429 | |
|---|
| 8430 | INTEGER(iwp) :: ncat_emission !< number of emission categories |
|---|
| 8431 | TYPE(surf_type), INTENT(inout) :: surface !< respective surface type |
|---|
| 8432 | INTEGER(iwp) :: b !< loop index |
|---|
| 8433 | INTEGER(iwp) :: ee !< loop index |
|---|
| 8434 | INTEGER(iwp) :: g !< loop index |
|---|
| 8435 | INTEGER(iwp) :: i !< loop index |
|---|
| 8436 | INTEGER(iwp) :: j !< loop index |
|---|
| 8437 | INTEGER(iwp) :: k !< loop index |
|---|
| 8438 | INTEGER(iwp) :: m !< running index for surface elements |
|---|
| 8439 | INTEGER(iwp) :: n !< loop index for emission categories |
|---|
| 8440 | INTEGER(iwp) :: c !< loop index |
|---|
| 8441 | INTEGER(iwp) :: ss !< loop index |
|---|
| 8442 | |
|---|
| 8443 | DO m = 1, surface%ns |
|---|
| 8444 | ! |
|---|
| 8445 | !-- Get indices of respective grid point |
|---|
| 8446 | i = surface%i(m) |
|---|
| 8447 | j = surface%j(m) |
|---|
| 8448 | k = surface%k(m) |
|---|
| 8449 | |
|---|
| 8450 | DO n = 1, ncat_emission |
|---|
| 8451 | DO b = 1, nbins |
|---|
| 8452 | IF ( aerosol_number(b)%source(n,j,i) < 0.0_wp ) THEN |
|---|
| 8453 | aerosol_number(b)%source(n,j,i) = 0.0_wp |
|---|
| 8454 | CYCLE |
|---|
| 8455 | ENDIF |
|---|
| 8456 | ! |
|---|
| 8457 | !-- Set mass fluxes. First bins include only SO4 and/or OC. |
|---|
| 8458 | |
|---|
| 8459 | IF ( b <= fn1a ) THEN |
|---|
| 8460 | ! |
|---|
| 8461 | !-- Both sulphate and organic carbon |
|---|
| 8462 | IF ( iso4 > 0 .AND. ioc > 0 ) THEN |
|---|
| 8463 | |
|---|
| 8464 | c = ( iso4 - 1 ) * nbins + b |
|---|
| 8465 | surface%amsws(m,c) = surface%amsws(m,c) + & |
|---|
| 8466 | emission_mass_fracs(n,1) / & |
|---|
| 8467 | ( emission_mass_fracs(n,1) + & |
|---|
| 8468 | emission_mass_fracs(n,2) ) * & |
|---|
| 8469 | aerosol_number(b)%source(n,j,i) * & |
|---|
| 8470 | api6 * aero(b)%dmid**3.0_wp * & |
|---|
| 8471 | arhoh2so4 * rho_air_zw(k-1) |
|---|
| 8472 | aerosol_mass(c)%source(n,j,i) = & |
|---|
| 8473 | aerosol_mass(c)%source(n,j,i) + surface%amsws(m,c) |
|---|
| 8474 | c = ( ioc - 1 ) * nbins + b |
|---|
| 8475 | surface%amsws(m,c) = surface%amsws(m,c) + & |
|---|
| 8476 | emission_mass_fracs(n,2) / & |
|---|
| 8477 | ( emission_mass_fracs(n,1) + & |
|---|
| 8478 | emission_mass_fracs(n,2) ) * & |
|---|
| 8479 | aerosol_number(b)%source(n,j,i) * & |
|---|
| 8480 | api6 * aero(b)%dmid**3.0_wp * arhooc & |
|---|
| 8481 | * rho_air_zw(k-1) |
|---|
| 8482 | aerosol_mass(c)%source(n,j,i) = & |
|---|
| 8483 | aerosol_mass(c)%source(n,j,i) + surface%amsws(m,c) |
|---|
| 8484 | ! |
|---|
| 8485 | !-- Only sulphates |
|---|
| 8486 | ELSEIF ( iso4 > 0 .AND. ioc < 0 ) THEN |
|---|
| 8487 | c = ( iso4 - 1 ) * nbins + b |
|---|
| 8488 | surface%amsws(m,c) = surface%amsws(m,c) + & |
|---|
| 8489 | aerosol_number(b)%source(n,j,i) * api6 & |
|---|
| 8490 | * aero(b)%dmid**3.0_wp * arhoh2so4 & |
|---|
| 8491 | * rho_air_zw(k-1) |
|---|
| 8492 | aerosol_mass(c)%source(n,j,i) = & |
|---|
| 8493 | aerosol_mass(c)%source(n,j,i) + surface%amsws(m,c) |
|---|
| 8494 | ! |
|---|
| 8495 | !-- Only organic carbon |
|---|
| 8496 | ELSEIF ( iso4 < 0 .AND. ioc > 0 ) THEN |
|---|
| 8497 | c = ( ioc - 1 ) * nbins + b |
|---|
| 8498 | surface%amsws(m,c) = surface%amsws(m,c) + & |
|---|
| 8499 | aerosol_number(b)%source(n,j,i) * api6 & |
|---|
| 8500 | * aero(b)%dmid**3.0_wp * arhooc & |
|---|
| 8501 | * rho_air_zw(k-1) |
|---|
| 8502 | aerosol_mass(c)%source(n,j,i) = & |
|---|
| 8503 | aerosol_mass(c)%source(n,j,i) + surface%amsws(m,c) |
|---|
| 8504 | ENDIF |
|---|
| 8505 | |
|---|
| 8506 | ELSEIF ( b > fn1a ) THEN |
|---|
| 8507 | ! |
|---|
| 8508 | !-- Sulphate |
|---|
| 8509 | IF ( iso4 > 0 ) THEN |
|---|
| 8510 | CALL set_mass_flux( surface, m, b, iso4, n, & |
|---|
| 8511 | emission_mass_fracs(n,1), arhoh2so4, & |
|---|
| 8512 | aerosol_number(b)%source(n,j,i) ) |
|---|
| 8513 | ENDIF |
|---|
| 8514 | ! |
|---|
| 8515 | !-- Organic carbon |
|---|
| 8516 | IF ( ioc > 0 ) THEN |
|---|
| 8517 | CALL set_mass_flux( surface, m, b, ioc, n, & |
|---|
| 8518 | emission_mass_fracs(n,2), arhooc, & |
|---|
| 8519 | aerosol_number(b)%source(n,j,i) ) |
|---|
| 8520 | ENDIF |
|---|
| 8521 | ! |
|---|
| 8522 | !-- Black carbon |
|---|
| 8523 | IF ( ibc > 0 ) THEN |
|---|
| 8524 | CALL set_mass_flux( surface, m, b, ibc, n, & |
|---|
| 8525 | emission_mass_fracs(n,3), arhobc, & |
|---|
| 8526 | aerosol_number(b)%source(n,j,i) ) |
|---|
| 8527 | ENDIF |
|---|
| 8528 | ! |
|---|
| 8529 | !-- Dust |
|---|
| 8530 | IF ( idu > 0 ) THEN |
|---|
| 8531 | CALL set_mass_flux( surface, m, b, idu, n, & |
|---|
| 8532 | emission_mass_fracs(n,4), arhodu, & |
|---|
| 8533 | aerosol_number(b)%source(n,j,i) ) |
|---|
| 8534 | ENDIF |
|---|
| 8535 | ! |
|---|
| 8536 | !-- Sea salt |
|---|
| 8537 | IF ( iss > 0 ) THEN |
|---|
| 8538 | CALL set_mass_flux( surface, m, b, iss, n, & |
|---|
| 8539 | emission_mass_fracs(n,5), arhoss, & |
|---|
| 8540 | aerosol_number(b)%source(n,j,i) ) |
|---|
| 8541 | ENDIF |
|---|
| 8542 | ! |
|---|
| 8543 | !-- Nitric acid |
|---|
| 8544 | IF ( ino > 0 ) THEN |
|---|
| 8545 | CALL set_mass_flux( surface, m, b, ino, n, & |
|---|
| 8546 | emission_mass_fracs(n,6), arhohno3, & |
|---|
| 8547 | aerosol_number(b)%source(n,j,i) ) |
|---|
| 8548 | ENDIF |
|---|
| 8549 | ! |
|---|
| 8550 | !-- Ammonia |
|---|
| 8551 | IF ( inh > 0 ) THEN |
|---|
| 8552 | CALL set_mass_flux( surface, m, b, inh, n, & |
|---|
| 8553 | emission_mass_fracs(n,7), arhonh3, & |
|---|
| 8554 | aerosol_number(b)%source(n,j,i) ) |
|---|
| 8555 | ENDIF |
|---|
| 8556 | |
|---|
| 8557 | ENDIF |
|---|
| 8558 | ! |
|---|
| 8559 | !-- Save number fluxes in the end |
|---|
| 8560 | surface%answs(m,b) = surface%answs(m,b) + & |
|---|
| 8561 | aerosol_number(b)%source(n,j,i) * rho_air_zw(k-1) |
|---|
| 8562 | aerosol_number(b)%source(n,j,i) = surface%answs(m,b) |
|---|
| 8563 | ENDDO |
|---|
| 8564 | |
|---|
| 8565 | ENDDO |
|---|
| 8566 | |
|---|
| 8567 | ENDDO |
|---|
| 8568 | |
|---|
| 8569 | END SUBROUTINE set_flux |
|---|
| 8570 | |
|---|
| 8571 | !------------------------------------------------------------------------------! |
|---|
| 8572 | ! Description: |
|---|
| 8573 | ! ------------ |
|---|
| 8574 | !> Sets the mass emissions to aerosol arrays in 2a and 2b. |
|---|
| 8575 | !------------------------------------------------------------------------------! |
|---|
| 8576 | SUBROUTINE set_mass_flux( surface, surf_num, b, ispec, n, mass_frac, prho, & |
|---|
| 8577 | nsource ) |
|---|
| 8578 | |
|---|
| 8579 | USE arrays_3d, & |
|---|
| 8580 | ONLY: rho_air_zw |
|---|
| 8581 | |
|---|
| 8582 | USE surface_mod, & |
|---|
| 8583 | ONLY: surf_type |
|---|
| 8584 | |
|---|
| 8585 | IMPLICIT NONE |
|---|
| 8586 | |
|---|
| 8587 | INTEGER(iwp), INTENT(in) :: b !< Aerosol size bin index |
|---|
| 8588 | INTEGER(iwp), INTENT(in) :: ispec !< Aerosol species index |
|---|
| 8589 | INTEGER(iwp), INTENT(in) :: n !< emission category number |
|---|
| 8590 | INTEGER(iwp), INTENT(in) :: surf_num !< index surface elements |
|---|
| 8591 | REAL(wp), INTENT(in) :: mass_frac !< mass fraction of a chemical |
|---|
| 8592 | !< compound in all bins |
|---|
| 8593 | REAL(wp), INTENT(in) :: nsource !< number source (#/m2/s) |
|---|
| 8594 | REAL(wp), INTENT(in) :: prho !< Aerosol density |
|---|
| 8595 | TYPE(surf_type), INTENT(inout) :: surface !< respective surface type |
|---|
| 8596 | |
|---|
| 8597 | INTEGER(iwp) :: ee !< index: end |
|---|
| 8598 | INTEGER(iwp) :: i !< loop index |
|---|
| 8599 | INTEGER(iwp) :: j !< loop index |
|---|
| 8600 | INTEGER(iwp) :: k !< loop index |
|---|
| 8601 | INTEGER(iwp) :: c !< loop index |
|---|
| 8602 | INTEGER(iwp) :: ss !<index: start |
|---|
| 8603 | |
|---|
| 8604 | ! |
|---|
| 8605 | !-- Get indices of respective grid point |
|---|
| 8606 | i = surface%i(surf_num) |
|---|
| 8607 | j = surface%j(surf_num) |
|---|
| 8608 | k = surface%k(surf_num) |
|---|
| 8609 | ! |
|---|
| 8610 | !-- Subrange 2a: |
|---|
| 8611 | c = ( ispec - 1 ) * nbins + b |
|---|
| 8612 | surface%amsws(surf_num,c) = surface%amsws(surf_num,c) + mass_frac * nsource& |
|---|
| 8613 | * aero(b)%core * prho * rho_air_zw(k-1) |
|---|
| 8614 | aerosol_mass(c)%source(n,j,i) = aerosol_mass(c)%source(n,j,i) + & |
|---|
| 8615 | surface%amsws(surf_num,c) |
|---|
| 8616 | ! |
|---|
| 8617 | !-- Subrange 2b: |
|---|
| 8618 | IF ( .NOT. no_insoluble ) THEN |
|---|
| 8619 | WRITE(*,*) 'All emissions are soluble!' |
|---|
| 8620 | ENDIF |
|---|
| 8621 | |
|---|
| 8622 | END SUBROUTINE set_mass_flux |
|---|
| 8623 | |
|---|
| 8624 | !------------------------------------------------------------------------------! |
|---|
| 8625 | ! Description: |
|---|
| 8626 | ! ------------ |
|---|
| 8627 | !> Sets the mass sources to aerosol arrays in 2a and 2b. |
|---|
| 8628 | !------------------------------------------------------------------------------! |
|---|
| 8629 | SUBROUTINE set_mass_source( k, j, i, ispec, mass_frac, prho, nsource, fillval ) |
|---|
| 8630 | |
|---|
| 8631 | USE surface_mod, & |
|---|
| 8632 | ONLY: surf_type |
|---|
| 8633 | |
|---|
| 8634 | IMPLICIT NONE |
|---|
| 8635 | |
|---|
| 8636 | INTEGER(iwp), INTENT(in) :: ispec !< Aerosol species index |
|---|
| 8637 | REAL(wp), INTENT(in) :: fillval !< _FillValue in the NetCDF file |
|---|
| 8638 | REAL(wp), INTENT(in) :: mass_frac !< mass fraction of a chemical |
|---|
| 8639 | !< compound in all bins |
|---|
| 8640 | REAL(wp), INTENT(in), DIMENSION(:) :: nsource !< number source |
|---|
| 8641 | REAL(wp), INTENT(in) :: prho !< Aerosol density |
|---|
| 8642 | |
|---|
| 8643 | INTEGER(iwp) :: b !< loop index |
|---|
| 8644 | INTEGER(iwp) :: ee !< index: end |
|---|
| 8645 | INTEGER(iwp) :: i !< loop index |
|---|
| 8646 | INTEGER(iwp) :: j !< loop index |
|---|
| 8647 | INTEGER(iwp) :: k !< loop index |
|---|
| 8648 | INTEGER(iwp) :: c !< loop index |
|---|
| 8649 | INTEGER(iwp) :: ss !<index: start |
|---|
| 8650 | ! |
|---|
| 8651 | !-- Subrange 2a: |
|---|
| 8652 | ss = ( ispec - 1 ) * nbins + in2a |
|---|
| 8653 | ee = ( ispec - 1 ) * nbins + fn2a |
|---|
| 8654 | b = in2a |
|---|
| 8655 | DO c = ss, ee |
|---|
| 8656 | IF ( nsource(b) /= fillval ) THEN |
|---|
| 8657 | aerosol_mass(c)%source(k,j,i) = aerosol_mass(c)%source(k,j,i) + & |
|---|
| 8658 | mass_frac * nsource(b) * aero(b)%core * & |
|---|
| 8659 | prho |
|---|
| 8660 | ENDIF |
|---|
| 8661 | b = b+1 |
|---|
| 8662 | ENDDO |
|---|
| 8663 | ! |
|---|
| 8664 | !-- Subrange 2b: |
|---|
| 8665 | IF ( .NOT. no_insoluble ) THEN |
|---|
| 8666 | WRITE(*,*) 'All sources are soluble!' |
|---|
| 8667 | ENDIF |
|---|
| 8668 | |
|---|
| 8669 | END SUBROUTINE set_mass_source |
|---|
| 8670 | |
|---|
| 8671 | !------------------------------------------------------------------------------! |
|---|
| 8672 | ! Description: |
|---|
| 8673 | ! ------------ |
|---|
| 8674 | !> Check data output for salsa. |
|---|
| 8675 | !------------------------------------------------------------------------------! |
|---|
| 8676 | SUBROUTINE salsa_check_data_output( var, unit ) |
|---|
| 8677 | |
|---|
| 8678 | USE control_parameters, & |
|---|
| 8679 | ONLY: message_string |
|---|
| 8680 | |
|---|
| 8681 | IMPLICIT NONE |
|---|
| 8682 | |
|---|
| 8683 | CHARACTER (LEN=*) :: unit !< |
|---|
| 8684 | CHARACTER (LEN=*) :: var !< |
|---|
| 8685 | |
|---|
| 8686 | SELECT CASE ( TRIM( var ) ) |
|---|
| 8687 | |
|---|
| 8688 | CASE ( 'g_H2SO4', 'g_HNO3', 'g_NH3', 'g_OCNV', 'g_OCSV', & |
|---|
| 8689 | 'N_bin1', 'N_bin2', 'N_bin3', 'N_bin4', 'N_bin5', 'N_bin6', & |
|---|
| 8690 | 'N_bin7', 'N_bin8', 'N_bin9', 'N_bin10', 'N_bin11', 'N_bin12', & |
|---|
| 8691 | 'Ntot' ) |
|---|
| 8692 | IF ( .NOT. salsa ) THEN |
|---|
| 8693 | message_string = 'output of "' // TRIM( var ) // '" requi' // & |
|---|
| 8694 | 'res salsa = .TRUE.' |
|---|
| 8695 | CALL message( 'check_parameters', 'SA0006', 1, 2, 0, 6, 0 ) |
|---|
| 8696 | ENDIF |
|---|
| 8697 | unit = '#/m3' |
|---|
| 8698 | |
|---|
| 8699 | CASE ( 'LDSA' ) |
|---|
| 8700 | IF ( .NOT. salsa ) THEN |
|---|
| 8701 | message_string = 'output of "' // TRIM( var ) // '" requi' // & |
|---|
| 8702 | 'res salsa = .TRUE.' |
|---|
| 8703 | CALL message( 'check_parameters', 'SA0003', 1, 2, 0, 6, 0 ) |
|---|
| 8704 | ENDIF |
|---|
| 8705 | unit = 'mum2/cm3' |
|---|
| 8706 | |
|---|
| 8707 | CASE ( 'm_bin1', 'm_bin2', 'm_bin3', 'm_bin4', 'm_bin5', 'm_bin6', & |
|---|
| 8708 | 'm_bin7', 'm_bin8', 'm_bin9', 'm_bin10', 'm_bin11', 'm_bin12', & |
|---|
| 8709 | 'PM2.5', 'PM10', 's_BC', 's_DU', 's_H2O', 's_NH', & |
|---|
| 8710 | 's_NO', 's_OC', 's_SO4', 's_SS' ) |
|---|
| 8711 | IF ( .NOT. salsa ) THEN |
|---|
| 8712 | message_string = 'output of "' // TRIM( var ) // '" requi' // & |
|---|
| 8713 | 'res salsa = .TRUE.' |
|---|
| 8714 | CALL message( 'check_parameters', 'SA0001', 1, 2, 0, 6, 0 ) |
|---|
| 8715 | ENDIF |
|---|
| 8716 | unit = 'kg/m3' |
|---|
| 8717 | |
|---|
| 8718 | CASE DEFAULT |
|---|
| 8719 | unit = 'illegal' |
|---|
| 8720 | |
|---|
| 8721 | END SELECT |
|---|
| 8722 | |
|---|
| 8723 | END SUBROUTINE salsa_check_data_output |
|---|
| 8724 | |
|---|
| 8725 | !------------------------------------------------------------------------------! |
|---|
| 8726 | ! |
|---|
| 8727 | ! Description: |
|---|
| 8728 | ! ------------ |
|---|
| 8729 | !> Subroutine for averaging 3D data |
|---|
| 8730 | !------------------------------------------------------------------------------! |
|---|
| 8731 | SUBROUTINE salsa_3d_data_averaging( mode, variable ) |
|---|
| 8732 | |
|---|
| 8733 | |
|---|
| 8734 | USE control_parameters |
|---|
| 8735 | |
|---|
| 8736 | USE indices |
|---|
| 8737 | |
|---|
| 8738 | USE kinds |
|---|
| 8739 | |
|---|
| 8740 | IMPLICIT NONE |
|---|
| 8741 | |
|---|
| 8742 | CHARACTER (LEN=*) :: mode !< |
|---|
| 8743 | CHARACTER (LEN=*) :: variable !< |
|---|
| 8744 | |
|---|
| 8745 | INTEGER(iwp) :: b !< |
|---|
| 8746 | INTEGER(iwp) :: c !< |
|---|
| 8747 | INTEGER(iwp) :: i !< |
|---|
| 8748 | INTEGER(iwp) :: icc !< |
|---|
| 8749 | INTEGER(iwp) :: j !< |
|---|
| 8750 | INTEGER(iwp) :: k !< |
|---|
| 8751 | |
|---|
| 8752 | REAL(wp) :: df !< For calculating LDSA: fraction of particles |
|---|
| 8753 | !< depositing in the alveolar (or tracheobronchial) |
|---|
| 8754 | !< region of the lung. Depends on the particle size |
|---|
| 8755 | REAL(wp) :: mean_d !< Particle diameter in micrometres |
|---|
| 8756 | REAL(wp) :: nc !< Particle number concentration in units 1/cm**3 |
|---|
| 8757 | REAL(wp) :: temp_bin !< |
|---|
| 8758 | REAL(wp), DIMENSION(:,:,:), POINTER :: to_be_resorted !< points to |
|---|
| 8759 | !< selected output variable |
|---|
| 8760 | |
|---|
| 8761 | temp_bin = 0.0_wp |
|---|
| 8762 | |
|---|
| 8763 | IF ( mode == 'allocate' ) THEN |
|---|
| 8764 | |
|---|
| 8765 | SELECT CASE ( TRIM( variable ) ) |
|---|
| 8766 | |
|---|
| 8767 | CASE ( 'g_H2SO4' ) |
|---|
| 8768 | IF ( .NOT. ALLOCATED( g_H2SO4_av ) ) THEN |
|---|
| 8769 | ALLOCATE( g_H2SO4_av(nzb:nzt+1,nysg:nyng,nxlg:nxrg) ) |
|---|
| 8770 | ENDIF |
|---|
| 8771 | g_H2SO4_av = 0.0_wp |
|---|
| 8772 | |
|---|
| 8773 | CASE ( 'g_HNO3' ) |
|---|
| 8774 | IF ( .NOT. ALLOCATED( g_HNO3_av ) ) THEN |
|---|
| 8775 | ALLOCATE( g_HNO3_av(nzb:nzt+1,nysg:nyng,nxlg:nxrg) ) |
|---|
| 8776 | ENDIF |
|---|
| 8777 | g_HNO3_av = 0.0_wp |
|---|
| 8778 | |
|---|
| 8779 | CASE ( 'g_NH3' ) |
|---|
| 8780 | IF ( .NOT. ALLOCATED( g_NH3_av ) ) THEN |
|---|
| 8781 | ALLOCATE( g_NH3_av(nzb:nzt+1,nysg:nyng,nxlg:nxrg) ) |
|---|
| 8782 | ENDIF |
|---|
| 8783 | g_NH3_av = 0.0_wp |
|---|
| 8784 | |
|---|
| 8785 | CASE ( 'g_OCNV' ) |
|---|
| 8786 | IF ( .NOT. ALLOCATED( g_OCNV_av ) ) THEN |
|---|
| 8787 | ALLOCATE( g_OCNV_av(nzb:nzt+1,nysg:nyng,nxlg:nxrg) ) |
|---|
| 8788 | ENDIF |
|---|
| 8789 | g_OCNV_av = 0.0_wp |
|---|
| 8790 | |
|---|
| 8791 | CASE ( 'g_OCSV' ) |
|---|
| 8792 | IF ( .NOT. ALLOCATED( g_OCSV_av ) ) THEN |
|---|
| 8793 | ALLOCATE( g_OCSV_av(nzb:nzt+1,nysg:nyng,nxlg:nxrg) ) |
|---|
| 8794 | ENDIF |
|---|
| 8795 | g_OCSV_av = 0.0_wp |
|---|
| 8796 | |
|---|
| 8797 | CASE ( 'LDSA' ) |
|---|
| 8798 | IF ( .NOT. ALLOCATED( LDSA_av ) ) THEN |
|---|
| 8799 | ALLOCATE( LDSA_av(nzb:nzt+1,nysg:nyng,nxlg:nxrg) ) |
|---|
| 8800 | ENDIF |
|---|
| 8801 | LDSA_av = 0.0_wp |
|---|
| 8802 | |
|---|
| 8803 | CASE ( 'N_bin1', 'N_bin2', 'N_bin3', 'N_bin4', 'N_bin5', 'N_bin6', & |
|---|
| 8804 | 'N_bin7', 'N_bin8', 'N_bin9', 'N_bin10', 'N_bin11', 'N_bin12' ) |
|---|
| 8805 | IF ( .NOT. ALLOCATED( Nbins_av ) ) THEN |
|---|
| 8806 | ALLOCATE( Nbins_av(nzb:nzt+1,nysg:nyng,nxlg:nxrg,nbins) ) |
|---|
| 8807 | ENDIF |
|---|
| 8808 | Nbins_av = 0.0_wp |
|---|
| 8809 | |
|---|
| 8810 | CASE ( 'Ntot' ) |
|---|
| 8811 | IF ( .NOT. ALLOCATED( Ntot_av ) ) THEN |
|---|
| 8812 | ALLOCATE( Ntot_av(nzb:nzt+1,nysg:nyng,nxlg:nxrg) ) |
|---|
| 8813 | ENDIF |
|---|
| 8814 | Ntot_av = 0.0_wp |
|---|
| 8815 | |
|---|
| 8816 | CASE ( 'm_bin1', 'm_bin2', 'm_bin3', 'm_bin4', 'm_bin5', 'm_bin6', & |
|---|
| 8817 | 'm_bin7', 'm_bin8', 'm_bin9', 'm_bin10', 'm_bin11', 'm_bin12' ) |
|---|
| 8818 | IF ( .NOT. ALLOCATED( mbins_av ) ) THEN |
|---|
| 8819 | ALLOCATE( mbins_av(nzb:nzt+1,nysg:nyng,nxlg:nxrg,nbins) ) |
|---|
| 8820 | ENDIF |
|---|
| 8821 | mbins_av = 0.0_wp |
|---|
| 8822 | |
|---|
| 8823 | CASE ( 'PM2.5' ) |
|---|
| 8824 | IF ( .NOT. ALLOCATED( PM25_av ) ) THEN |
|---|
| 8825 | ALLOCATE( PM25_av(nzb:nzt+1,nysg:nyng,nxlg:nxrg) ) |
|---|
| 8826 | ENDIF |
|---|
| 8827 | PM25_av = 0.0_wp |
|---|
| 8828 | |
|---|
| 8829 | CASE ( 'PM10' ) |
|---|
| 8830 | IF ( .NOT. ALLOCATED( PM10_av ) ) THEN |
|---|
| 8831 | ALLOCATE( PM10_av(nzb:nzt+1,nysg:nyng,nxlg:nxrg) ) |
|---|
| 8832 | ENDIF |
|---|
| 8833 | PM10_av = 0.0_wp |
|---|
| 8834 | |
|---|
| 8835 | CASE ( 's_BC' ) |
|---|
| 8836 | IF ( .NOT. ALLOCATED( s_BC_av ) ) THEN |
|---|
| 8837 | ALLOCATE( s_BC_av(nzb:nzt+1,nysg:nyng,nxlg:nxrg) ) |
|---|
| 8838 | ENDIF |
|---|
| 8839 | s_BC_av = 0.0_wp |
|---|
| 8840 | |
|---|
| 8841 | CASE ( 's_DU' ) |
|---|
| 8842 | IF ( .NOT. ALLOCATED( s_DU_av ) ) THEN |
|---|
| 8843 | ALLOCATE( s_DU_av(nzb:nzt+1,nysg:nyng,nxlg:nxrg) ) |
|---|
| 8844 | ENDIF |
|---|
| 8845 | s_DU_av = 0.0_wp |
|---|
| 8846 | |
|---|
| 8847 | CASE ( 's_H2O' ) |
|---|
| 8848 | IF ( .NOT. ALLOCATED( s_H2O_av ) ) THEN |
|---|
| 8849 | ALLOCATE( s_H2O_av(nzb:nzt+1,nysg:nyng,nxlg:nxrg) ) |
|---|
| 8850 | ENDIF |
|---|
| 8851 | s_H2O_av = 0.0_wp |
|---|
| 8852 | |
|---|
| 8853 | CASE ( 's_NH' ) |
|---|
| 8854 | IF ( .NOT. ALLOCATED( s_NH_av ) ) THEN |
|---|
| 8855 | ALLOCATE( s_NH_av(nzb:nzt+1,nysg:nyng,nxlg:nxrg) ) |
|---|
| 8856 | ENDIF |
|---|
| 8857 | s_NH_av = 0.0_wp |
|---|
| 8858 | |
|---|
| 8859 | CASE ( 's_NO' ) |
|---|
| 8860 | IF ( .NOT. ALLOCATED( s_NO_av ) ) THEN |
|---|
| 8861 | ALLOCATE( s_NO_av(nzb:nzt+1,nysg:nyng,nxlg:nxrg) ) |
|---|
| 8862 | ENDIF |
|---|
| 8863 | s_NO_av = 0.0_wp |
|---|
| 8864 | |
|---|
| 8865 | CASE ( 's_OC' ) |
|---|
| 8866 | IF ( .NOT. ALLOCATED( s_OC_av ) ) THEN |
|---|
| 8867 | ALLOCATE( s_OC_av(nzb:nzt+1,nysg:nyng,nxlg:nxrg) ) |
|---|
| 8868 | ENDIF |
|---|
| 8869 | s_OC_av = 0.0_wp |
|---|
| 8870 | |
|---|
| 8871 | CASE ( 's_SO4' ) |
|---|
| 8872 | IF ( .NOT. ALLOCATED( s_SO4_av ) ) THEN |
|---|
| 8873 | ALLOCATE( s_SO4_av(nzb:nzt+1,nysg:nyng,nxlg:nxrg) ) |
|---|
| 8874 | ENDIF |
|---|
| 8875 | s_SO4_av = 0.0_wp |
|---|
| 8876 | |
|---|
| 8877 | CASE ( 's_SS' ) |
|---|
| 8878 | IF ( .NOT. ALLOCATED( s_SS_av ) ) THEN |
|---|
| 8879 | ALLOCATE( s_SS_av(nzb:nzt+1,nysg:nyng,nxlg:nxrg) ) |
|---|
| 8880 | ENDIF |
|---|
| 8881 | s_SS_av = 0.0_wp |
|---|
| 8882 | |
|---|
| 8883 | CASE DEFAULT |
|---|
| 8884 | CONTINUE |
|---|
| 8885 | |
|---|
| 8886 | END SELECT |
|---|
| 8887 | |
|---|
| 8888 | ELSEIF ( mode == 'sum' ) THEN |
|---|
| 8889 | |
|---|
| 8890 | SELECT CASE ( TRIM( variable ) ) |
|---|
| 8891 | |
|---|
| 8892 | CASE ( 'g_H2SO4', 'g_HNO3', 'g_NH3', 'g_OCNV', 'g_OCSV' ) |
|---|
| 8893 | IF ( TRIM( variable(3:) ) == 'H2SO4' ) THEN |
|---|
| 8894 | icc = 1 |
|---|
| 8895 | to_be_resorted => g_H2SO4_av |
|---|
| 8896 | ELSEIF ( TRIM( variable(3:) ) == 'HNO3' ) THEN |
|---|
| 8897 | icc = 2 |
|---|
| 8898 | to_be_resorted => g_HNO3_av |
|---|
| 8899 | ELSEIF ( TRIM( variable(3:) ) == 'NH3' ) THEN |
|---|
| 8900 | icc = 3 |
|---|
| 8901 | to_be_resorted => g_NH3_av |
|---|
| 8902 | ELSEIF ( TRIM( variable(3:) ) == 'OCNV' ) THEN |
|---|
| 8903 | icc = 4 |
|---|
| 8904 | to_be_resorted => g_OCNV_av |
|---|
| 8905 | ELSEIF ( TRIM( variable(3:) ) == 'OCSV' ) THEN |
|---|
| 8906 | icc = 5 |
|---|
| 8907 | to_be_resorted => g_OCSV_av |
|---|
| 8908 | ENDIF |
|---|
| 8909 | DO i = nxlg, nxrg |
|---|
| 8910 | DO j = nysg, nyng |
|---|
| 8911 | DO k = nzb, nzt+1 |
|---|
| 8912 | to_be_resorted(k,j,i) = to_be_resorted(k,j,i) + & |
|---|
| 8913 | salsa_gas(icc)%conc(k,j,i) |
|---|
| 8914 | ENDDO |
|---|
| 8915 | ENDDO |
|---|
| 8916 | ENDDO |
|---|
| 8917 | |
|---|
| 8918 | CASE ( 'LDSA' ) |
|---|
| 8919 | DO i = nxlg, nxrg |
|---|
| 8920 | DO j = nysg, nyng |
|---|
| 8921 | DO k = nzb, nzt+1 |
|---|
| 8922 | temp_bin = 0.0_wp |
|---|
| 8923 | DO b = 1, nbins |
|---|
| 8924 | ! |
|---|
| 8925 | !-- Diameter in micrometres |
|---|
| 8926 | mean_d = 1.0E+6_wp * Ra_dry(k,j,i,b) * 2.0_wp |
|---|
| 8927 | ! |
|---|
| 8928 | !-- Deposition factor: alveolar (use Ra_dry) |
|---|
| 8929 | df = ( 0.01555_wp / mean_d ) * ( EXP( -0.416_wp * & |
|---|
| 8930 | ( LOG( mean_d ) + 2.84_wp )**2.0_wp ) & |
|---|
| 8931 | + 19.11_wp * EXP( -0.482_wp * & |
|---|
| 8932 | ( LOG( mean_d ) - 1.362_wp )**2.0_wp ) ) |
|---|
| 8933 | ! |
|---|
| 8934 | !-- Number concentration in 1/cm3 |
|---|
| 8935 | nc = 1.0E-6_wp * aerosol_number(b)%conc(k,j,i) |
|---|
| 8936 | ! |
|---|
| 8937 | !-- Lung-deposited surface area LDSA (units mum2/cm3) |
|---|
| 8938 | temp_bin = temp_bin + pi * mean_d**2.0_wp * df * nc |
|---|
| 8939 | ENDDO |
|---|
| 8940 | LDSA_av(k,j,i) = LDSA_av(k,j,i) + temp_bin |
|---|
| 8941 | ENDDO |
|---|
| 8942 | ENDDO |
|---|
| 8943 | ENDDO |
|---|
| 8944 | |
|---|
| 8945 | CASE ( 'N_bin1', 'N_bin2', 'N_bin3', 'N_bin4', 'N_bin5', 'N_bin6', & |
|---|
| 8946 | 'N_bin7', 'N_bin8', 'N_bin9', 'N_bin10', 'N_bin11', 'N_bin12' ) |
|---|
| 8947 | DO i = nxlg, nxrg |
|---|
| 8948 | DO j = nysg, nyng |
|---|
| 8949 | DO k = nzb, nzt+1 |
|---|
| 8950 | DO b = 1, nbins |
|---|
| 8951 | Nbins_av(k,j,i,b) = Nbins_av(k,j,i,b) + & |
|---|
| 8952 | aerosol_number(b)%conc(k,j,i) |
|---|
| 8953 | ENDDO |
|---|
| 8954 | ENDDO |
|---|
| 8955 | ENDDO |
|---|
| 8956 | ENDDO |
|---|
| 8957 | |
|---|
| 8958 | CASE ( 'Ntot' ) |
|---|
| 8959 | DO i = nxlg, nxrg |
|---|
| 8960 | DO j = nysg, nyng |
|---|
| 8961 | DO k = nzb, nzt+1 |
|---|
| 8962 | DO b = 1, nbins |
|---|
| 8963 | Ntot_av(k,j,i) = Ntot_av(k,j,i) + & |
|---|
| 8964 | aerosol_number(b)%conc(k,j,i) |
|---|
| 8965 | ENDDO |
|---|
| 8966 | ENDDO |
|---|
| 8967 | ENDDO |
|---|
| 8968 | ENDDO |
|---|
| 8969 | |
|---|
| 8970 | CASE ( 'm_bin1', 'm_bin2', 'm_bin3', 'm_bin4', 'm_bin5', 'm_bin6', & |
|---|
| 8971 | 'm_bin7', 'm_bin8', 'm_bin9', 'm_bin10', 'm_bin11', 'm_bin12' ) |
|---|
| 8972 | DO i = nxlg, nxrg |
|---|
| 8973 | DO j = nysg, nyng |
|---|
| 8974 | DO k = nzb, nzt+1 |
|---|
| 8975 | DO b = 1, nbins |
|---|
| 8976 | DO c = b, nbins*ncc_tot, nbins |
|---|
| 8977 | mbins_av(k,j,i,b) = mbins_av(k,j,i,b) + & |
|---|
| 8978 | aerosol_mass(c)%conc(k,j,i) |
|---|
| 8979 | ENDDO |
|---|
| 8980 | ENDDO |
|---|
| 8981 | ENDDO |
|---|
| 8982 | ENDDO |
|---|
| 8983 | ENDDO |
|---|
| 8984 | |
|---|
| 8985 | CASE ( 'PM2.5' ) |
|---|
| 8986 | DO i = nxlg, nxrg |
|---|
| 8987 | DO j = nysg, nyng |
|---|
| 8988 | DO k = nzb, nzt+1 |
|---|
| 8989 | temp_bin = 0.0_wp |
|---|
| 8990 | DO b = 1, nbins |
|---|
| 8991 | IF ( 2.0_wp * Ra_dry(k,j,i,b) <= 2.5E-6_wp ) THEN |
|---|
| 8992 | DO c = b, nbins*ncc, nbins |
|---|
| 8993 | temp_bin = temp_bin + aerosol_mass(c)%conc(k,j,i) |
|---|
| 8994 | ENDDO |
|---|
| 8995 | ENDIF |
|---|
| 8996 | ENDDO |
|---|
| 8997 | PM25_av(k,j,i) = PM25_av(k,j,i) + temp_bin |
|---|
| 8998 | ENDDO |
|---|
| 8999 | ENDDO |
|---|
| 9000 | ENDDO |
|---|
| 9001 | |
|---|
| 9002 | CASE ( 'PM10' ) |
|---|
| 9003 | DO i = nxlg, nxrg |
|---|
| 9004 | DO j = nysg, nyng |
|---|
| 9005 | DO k = nzb, nzt+1 |
|---|
| 9006 | temp_bin = 0.0_wp |
|---|
| 9007 | DO b = 1, nbins |
|---|
| 9008 | IF ( 2.0_wp * Ra_dry(k,j,i,b) <= 10.0E-6_wp ) THEN |
|---|
| 9009 | DO c = b, nbins*ncc, nbins |
|---|
| 9010 | temp_bin = temp_bin + aerosol_mass(c)%conc(k,j,i) |
|---|
| 9011 | ENDDO |
|---|
| 9012 | ENDIF |
|---|
| 9013 | ENDDO |
|---|
| 9014 | PM10_av(k,j,i) = PM10_av(k,j,i) + temp_bin |
|---|
| 9015 | ENDDO |
|---|
| 9016 | ENDDO |
|---|
| 9017 | ENDDO |
|---|
| 9018 | |
|---|
| 9019 | CASE ( 's_BC', 's_DU', 's_H2O', 's_NH', 's_NO', 's_OC', 's_SO4', & |
|---|
| 9020 | 's_SS' ) |
|---|
| 9021 | IF ( is_used( prtcl, TRIM( variable(3:) ) ) ) THEN |
|---|
| 9022 | icc = get_index( prtcl, TRIM( variable(3:) ) ) |
|---|
| 9023 | IF ( TRIM( variable(3:) ) == 'BC' ) to_be_resorted => s_BC_av |
|---|
| 9024 | IF ( TRIM( variable(3:) ) == 'DU' ) to_be_resorted => s_DU_av |
|---|
| 9025 | IF ( TRIM( variable(3:) ) == 'NH' ) to_be_resorted => s_NH_av |
|---|
| 9026 | IF ( TRIM( variable(3:) ) == 'NO' ) to_be_resorted => s_NO_av |
|---|
| 9027 | IF ( TRIM( variable(3:) ) == 'OC' ) to_be_resorted => s_OC_av |
|---|
| 9028 | IF ( TRIM( variable(3:) ) == 'SO4' ) to_be_resorted => s_SO4_av |
|---|
| 9029 | IF ( TRIM( variable(3:) ) == 'SS' ) to_be_resorted => s_SS_av |
|---|
| 9030 | DO i = nxlg, nxrg |
|---|
| 9031 | DO j = nysg, nyng |
|---|
| 9032 | DO k = nzb, nzt+1 |
|---|
| 9033 | DO c = ( icc-1 )*nbins+1, icc*nbins |
|---|
| 9034 | to_be_resorted(k,j,i) = to_be_resorted(k,j,i) + & |
|---|
| 9035 | aerosol_mass(c)%conc(k,j,i) |
|---|
| 9036 | ENDDO |
|---|
| 9037 | ENDDO |
|---|
| 9038 | ENDDO |
|---|
| 9039 | ENDDO |
|---|
| 9040 | ENDIF |
|---|
| 9041 | |
|---|
| 9042 | CASE DEFAULT |
|---|
| 9043 | CONTINUE |
|---|
| 9044 | |
|---|
| 9045 | END SELECT |
|---|
| 9046 | |
|---|
| 9047 | ELSEIF ( mode == 'average' ) THEN |
|---|
| 9048 | |
|---|
| 9049 | SELECT CASE ( TRIM( variable ) ) |
|---|
| 9050 | |
|---|
| 9051 | CASE ( 'g_H2SO4', 'g_HNO3', 'g_NH3', 'g_OCNV', 'g_OCSV' ) |
|---|
| 9052 | IF ( TRIM( variable(3:) ) == 'H2SO4' ) THEN |
|---|
| 9053 | icc = 1 |
|---|
| 9054 | to_be_resorted => g_H2SO4_av |
|---|
| 9055 | ELSEIF ( TRIM( variable(3:) ) == 'HNO3' ) THEN |
|---|
| 9056 | icc = 2 |
|---|
| 9057 | to_be_resorted => g_HNO3_av |
|---|
| 9058 | ELSEIF ( TRIM( variable(3:) ) == 'NH3' ) THEN |
|---|
| 9059 | icc = 3 |
|---|
| 9060 | to_be_resorted => g_NH3_av |
|---|
| 9061 | ELSEIF ( TRIM( variable(3:) ) == 'OCNV' ) THEN |
|---|
| 9062 | icc = 4 |
|---|
| 9063 | to_be_resorted => g_OCNV_av |
|---|
| 9064 | ELSEIF ( TRIM( variable(3:) ) == 'OCSV' ) THEN |
|---|
| 9065 | icc = 5 |
|---|
| 9066 | to_be_resorted => g_OCSV_av |
|---|
| 9067 | ENDIF |
|---|
| 9068 | DO i = nxlg, nxrg |
|---|
| 9069 | DO j = nysg, nyng |
|---|
| 9070 | DO k = nzb, nzt+1 |
|---|
| 9071 | to_be_resorted(k,j,i) = to_be_resorted(k,j,i) & |
|---|
| 9072 | / REAL( average_count_3d, KIND=wp ) |
|---|
| 9073 | ENDDO |
|---|
| 9074 | ENDDO |
|---|
| 9075 | ENDDO |
|---|
| 9076 | |
|---|
| 9077 | CASE ( 'LDSA' ) |
|---|
| 9078 | DO i = nxlg, nxrg |
|---|
| 9079 | DO j = nysg, nyng |
|---|
| 9080 | DO k = nzb, nzt+1 |
|---|
| 9081 | LDSA_av(k,j,i) = LDSA_av(k,j,i) & |
|---|
| 9082 | / REAL( average_count_3d, KIND=wp ) |
|---|
| 9083 | ENDDO |
|---|
| 9084 | ENDDO |
|---|
| 9085 | ENDDO |
|---|
| 9086 | |
|---|
| 9087 | CASE ( 'N_bin1', 'N_bin2', 'N_bin3', 'N_bin4', 'N_bin5', 'N_bin6', & |
|---|
| 9088 | 'N_bin7', 'N_bin8', 'N_bin9', 'N_bin10', 'N_bin11', 'N_bin12' ) |
|---|
| 9089 | DO i = nxlg, nxrg |
|---|
| 9090 | DO j = nysg, nyng |
|---|
| 9091 | DO k = nzb, nzt+1 |
|---|
| 9092 | DO b = 1, nbins |
|---|
| 9093 | Nbins_av(k,j,i,b) = Nbins_av(k,j,i,b) & |
|---|
| 9094 | / REAL( average_count_3d, KIND=wp ) |
|---|
| 9095 | ENDDO |
|---|
| 9096 | ENDDO |
|---|
| 9097 | ENDDO |
|---|
| 9098 | ENDDO |
|---|
| 9099 | |
|---|
| 9100 | CASE ( 'Ntot' ) |
|---|
| 9101 | DO i = nxlg, nxrg |
|---|
| 9102 | DO j = nysg, nyng |
|---|
| 9103 | DO k = nzb, nzt+1 |
|---|
| 9104 | Ntot_av(k,j,i) = Ntot_av(k,j,i) & |
|---|
| 9105 | / REAL( average_count_3d, KIND=wp ) |
|---|
| 9106 | ENDDO |
|---|
| 9107 | ENDDO |
|---|
| 9108 | ENDDO |
|---|
| 9109 | |
|---|
| 9110 | CASE ( 'm_bin1', 'm_bin2', 'm_bin3', 'm_bin4', 'm_bin5', 'm_bin6', & |
|---|
| 9111 | 'm_bin7', 'm_bin8', 'm_bin9', 'm_bin10', 'm_bin11', 'm_bin12' ) |
|---|
| 9112 | DO i = nxlg, nxrg |
|---|
| 9113 | DO j = nysg, nyng |
|---|
| 9114 | DO k = nzb, nzt+1 |
|---|
| 9115 | DO b = 1, nbins |
|---|
| 9116 | DO c = b, nbins*ncc, nbins |
|---|
| 9117 | mbins_av(k,j,i,b) = mbins_av(k,j,i,b) & |
|---|
| 9118 | / REAL( average_count_3d, KIND=wp ) |
|---|
| 9119 | ENDDO |
|---|
| 9120 | ENDDO |
|---|
| 9121 | ENDDO |
|---|
| 9122 | ENDDO |
|---|
| 9123 | ENDDO |
|---|
| 9124 | |
|---|
| 9125 | CASE ( 'PM2.5' ) |
|---|
| 9126 | DO i = nxlg, nxrg |
|---|
| 9127 | DO j = nysg, nyng |
|---|
| 9128 | DO k = nzb, nzt+1 |
|---|
| 9129 | PM25_av(k,j,i) = PM25_av(k,j,i) & |
|---|
| 9130 | / REAL( average_count_3d, KIND=wp ) |
|---|
| 9131 | ENDDO |
|---|
| 9132 | ENDDO |
|---|
| 9133 | ENDDO |
|---|
| 9134 | |
|---|
| 9135 | CASE ( 'PM10' ) |
|---|
| 9136 | DO i = nxlg, nxrg |
|---|
| 9137 | DO j = nysg, nyng |
|---|
| 9138 | DO k = nzb, nzt+1 |
|---|
| 9139 | PM10_av(k,j,i) = PM10_av(k,j,i) & |
|---|
| 9140 | / REAL( average_count_3d, KIND=wp ) |
|---|
| 9141 | ENDDO |
|---|
| 9142 | ENDDO |
|---|
| 9143 | ENDDO |
|---|
| 9144 | |
|---|
| 9145 | CASE ( 's_BC', 's_DU', 's_H2O', 's_NH', 's_NO', 's_OC', 's_SO4', & |
|---|
| 9146 | 's_SS' ) |
|---|
| 9147 | IF ( is_used( prtcl, TRIM( variable(3:) ) ) ) THEN |
|---|
| 9148 | icc = get_index( prtcl, TRIM( variable(3:) ) ) |
|---|
| 9149 | IF ( TRIM( variable(3:) ) == 'BC' ) to_be_resorted => s_BC_av |
|---|
| 9150 | IF ( TRIM( variable(3:) ) == 'DU' ) to_be_resorted => s_DU_av |
|---|
| 9151 | IF ( TRIM( variable(3:) ) == 'NH' ) to_be_resorted => s_NH_av |
|---|
| 9152 | IF ( TRIM( variable(3:) ) == 'NO' ) to_be_resorted => s_NO_av |
|---|
| 9153 | IF ( TRIM( variable(3:) ) == 'OC' ) to_be_resorted => s_OC_av |
|---|
| 9154 | IF ( TRIM( variable(3:) ) == 'SO4' ) to_be_resorted => s_SO4_av |
|---|
| 9155 | IF ( TRIM( variable(3:) ) == 'SS' ) to_be_resorted => s_SS_av |
|---|
| 9156 | DO i = nxlg, nxrg |
|---|
| 9157 | DO j = nysg, nyng |
|---|
| 9158 | DO k = nzb, nzt+1 |
|---|
| 9159 | to_be_resorted(k,j,i) = to_be_resorted(k,j,i) & |
|---|
| 9160 | / REAL( average_count_3d, KIND=wp ) |
|---|
| 9161 | ENDDO |
|---|
| 9162 | ENDDO |
|---|
| 9163 | ENDDO |
|---|
| 9164 | ENDIF |
|---|
| 9165 | |
|---|
| 9166 | END SELECT |
|---|
| 9167 | |
|---|
| 9168 | ENDIF |
|---|
| 9169 | |
|---|
| 9170 | END SUBROUTINE salsa_3d_data_averaging |
|---|
| 9171 | |
|---|
| 9172 | |
|---|
| 9173 | !------------------------------------------------------------------------------! |
|---|
| 9174 | ! |
|---|
| 9175 | ! Description: |
|---|
| 9176 | ! ------------ |
|---|
| 9177 | !> Subroutine defining 2D output variables |
|---|
| 9178 | !------------------------------------------------------------------------------! |
|---|
| 9179 | SUBROUTINE salsa_data_output_2d( av, variable, found, grid, mode, & |
|---|
| 9180 | local_pf, two_d ) |
|---|
| 9181 | |
|---|
| 9182 | USE indices |
|---|
| 9183 | |
|---|
| 9184 | USE kinds |
|---|
| 9185 | |
|---|
| 9186 | IMPLICIT NONE |
|---|
| 9187 | |
|---|
| 9188 | CHARACTER (LEN=*) :: grid !< |
|---|
| 9189 | CHARACTER (LEN=*) :: mode !< |
|---|
| 9190 | CHARACTER (LEN=*) :: variable !< |
|---|
| 9191 | CHARACTER (LEN=5) :: vari !< trimmed format of variable |
|---|
| 9192 | |
|---|
| 9193 | INTEGER(iwp) :: av !< |
|---|
| 9194 | INTEGER(iwp) :: b !< |
|---|
| 9195 | INTEGER(iwp) :: c !< |
|---|
| 9196 | INTEGER(iwp) :: i !< |
|---|
| 9197 | INTEGER(iwp) :: icc !< index of a chemical compound |
|---|
| 9198 | INTEGER(iwp) :: j !< |
|---|
| 9199 | INTEGER(iwp) :: k !< |
|---|
| 9200 | |
|---|
| 9201 | LOGICAL :: found !< |
|---|
| 9202 | LOGICAL :: two_d !< flag parameter that indicates 2D variables |
|---|
| 9203 | !< (horizontal cross sections) |
|---|
| 9204 | |
|---|
| 9205 | REAL(wp) :: df !< For calculating LDSA: fraction of particles |
|---|
| 9206 | !< depositing in the alveolar (or tracheobronchial) |
|---|
| 9207 | !< region of the lung. Depends on the particle size |
|---|
| 9208 | REAL(wp) :: mean_d !< Particle diameter in micrometres |
|---|
| 9209 | REAL(wp) :: nc !< Particle number concentration in units 1/cm**3 |
|---|
| 9210 | REAL(wp), DIMENSION(nxl:nxr,nys:nyn,nzb:nzt+1) :: local_pf !< local |
|---|
| 9211 | !< array to which output data is resorted to |
|---|
| 9212 | REAL(wp) :: temp_bin !< |
|---|
| 9213 | REAL(wp), DIMENSION(:,:,:), POINTER :: to_be_resorted !< points to |
|---|
| 9214 | !< selected output variable |
|---|
| 9215 | |
|---|
| 9216 | found = .TRUE. |
|---|
| 9217 | temp_bin = 0.0_wp |
|---|
| 9218 | |
|---|
| 9219 | IF ( TRIM( variable(1:2) ) == 'g_' ) THEN |
|---|
| 9220 | vari = TRIM( variable( 3:LEN( TRIM( variable ) ) - 3 ) ) |
|---|
| 9221 | IF ( av == 0 ) THEN |
|---|
| 9222 | IF ( vari == 'H2SO4') icc = 1 |
|---|
| 9223 | IF ( vari == 'HNO3') icc = 2 |
|---|
| 9224 | IF ( vari == 'NH3') icc = 3 |
|---|
| 9225 | IF ( vari == 'OCNV') icc = 4 |
|---|
| 9226 | IF ( vari == 'OCSV') icc = 5 |
|---|
| 9227 | DO i = nxl, nxr |
|---|
| 9228 | DO j = nys, nyn |
|---|
| 9229 | DO k = nzb, nzt+1 |
|---|
| 9230 | local_pf(i,j,k) = MERGE( salsa_gas(icc)%conc(k,j,i), & |
|---|
| 9231 | REAL( -999.0_wp, KIND = wp ), & |
|---|
| 9232 | BTEST( wall_flags_0(k,j,i), 0 ) ) |
|---|
| 9233 | ENDDO |
|---|
| 9234 | ENDDO |
|---|
| 9235 | ENDDO |
|---|
| 9236 | ELSE |
|---|
| 9237 | IF ( vari == 'H2SO4' ) to_be_resorted => g_H2SO4_av |
|---|
| 9238 | IF ( vari == 'HNO3' ) to_be_resorted => g_HNO3_av |
|---|
| 9239 | IF ( vari == 'NH3' ) to_be_resorted => g_NH3_av |
|---|
| 9240 | IF ( vari == 'OCNV' ) to_be_resorted => g_OCNV_av |
|---|
| 9241 | IF ( vari == 'OCSV' ) to_be_resorted => g_OCSV_av |
|---|
| 9242 | DO i = nxl, nxr |
|---|
| 9243 | DO j = nys, nyn |
|---|
| 9244 | DO k = nzb, nzt+1 |
|---|
| 9245 | local_pf(i,j,k) = MERGE( to_be_resorted(k,j,i), & |
|---|
| 9246 | REAL( -999.0_wp, KIND = wp ), & |
|---|
| 9247 | BTEST( wall_flags_0(k,j,i), 0 ) ) |
|---|
| 9248 | ENDDO |
|---|
| 9249 | ENDDO |
|---|
| 9250 | ENDDO |
|---|
| 9251 | ENDIF |
|---|
| 9252 | |
|---|
| 9253 | IF ( mode == 'xy' ) grid = 'zu' |
|---|
| 9254 | |
|---|
| 9255 | ELSEIF ( TRIM( variable(1:4) ) == 'LDSA' ) THEN |
|---|
| 9256 | IF ( av == 0 ) THEN |
|---|
| 9257 | DO i = nxl, nxr |
|---|
| 9258 | DO j = nys, nyn |
|---|
| 9259 | DO k = nzb, nzt+1 |
|---|
| 9260 | temp_bin = 0.0_wp |
|---|
| 9261 | DO b = 1, nbins |
|---|
| 9262 | ! |
|---|
| 9263 | !-- Diameter in micrometres |
|---|
| 9264 | mean_d = 1.0E+6_wp * Ra_dry(k,j,i,b) * 2.0_wp |
|---|
| 9265 | ! |
|---|
| 9266 | !-- Deposition factor: alveolar |
|---|
| 9267 | df = ( 0.01555_wp / mean_d ) * ( EXP( -0.416_wp * ( LOG( & |
|---|
| 9268 | mean_d ) + 2.84_wp )**2.0_wp ) + 19.11_wp * EXP( & |
|---|
| 9269 | -0.482_wp * ( LOG( mean_d ) - 1.362_wp )**2.0_wp ) ) |
|---|
| 9270 | ! |
|---|
| 9271 | !-- Number concentration in 1/cm3 |
|---|
| 9272 | nc = 1.0E-6_wp * aerosol_number(b)%conc(k,j,i) |
|---|
| 9273 | ! |
|---|
| 9274 | !-- Lung-deposited surface area LDSA (units mum2/cm3) |
|---|
| 9275 | temp_bin = temp_bin + pi * mean_d**2.0_wp * df * nc |
|---|
| 9276 | ENDDO |
|---|
| 9277 | local_pf(i,j,k) = MERGE( temp_bin, REAL( -999.0_wp, & |
|---|
| 9278 | KIND = wp ), BTEST( wall_flags_0(k,j,i), 0 ) ) |
|---|
| 9279 | ENDDO |
|---|
| 9280 | ENDDO |
|---|
| 9281 | ENDDO |
|---|
| 9282 | ELSE |
|---|
| 9283 | DO i = nxl, nxr |
|---|
| 9284 | DO j = nys, nyn |
|---|
| 9285 | DO k = nzb, nzt+1 |
|---|
| 9286 | local_pf(i,j,k) = MERGE( LDSA_av(k,j,i), REAL( -999.0_wp, & |
|---|
| 9287 | KIND = wp ), BTEST( wall_flags_0(k,j,i), 0 ) ) |
|---|
| 9288 | ENDDO |
|---|
| 9289 | ENDDO |
|---|
| 9290 | ENDDO |
|---|
| 9291 | ENDIF |
|---|
| 9292 | |
|---|
| 9293 | IF ( mode == 'xy' ) grid = 'zu' |
|---|
| 9294 | |
|---|
| 9295 | ELSEIF ( TRIM( variable(1:6) ) == 'N_bin1' ) THEN |
|---|
| 9296 | IF ( av == 0 ) THEN |
|---|
| 9297 | DO i = nxl, nxr |
|---|
| 9298 | DO j = nys, nyn |
|---|
| 9299 | DO k = nzb, nzt+1 |
|---|
| 9300 | local_pf(i,j,k) = MERGE( aerosol_number(1)%conc(k,j,i), & |
|---|
| 9301 | REAL( -999.0_wp, KIND = wp ), & |
|---|
| 9302 | BTEST( wall_flags_0(k,j,i), 0 ) ) |
|---|
| 9303 | ENDDO |
|---|
| 9304 | ENDDO |
|---|
| 9305 | ENDDO |
|---|
| 9306 | ELSE |
|---|
| 9307 | DO i = nxl, nxr |
|---|
| 9308 | DO j = nys, nyn |
|---|
| 9309 | DO k = nzb, nzt+1 |
|---|
| 9310 | local_pf(i,j,k) = MERGE( Nbins_av(k,j,i,1), & |
|---|
| 9311 | REAL( -999.0_wp, KIND = wp ), & |
|---|
| 9312 | BTEST( wall_flags_0(k,j,i), 0 ) ) |
|---|
| 9313 | ENDDO |
|---|
| 9314 | ENDDO |
|---|
| 9315 | ENDDO |
|---|
| 9316 | ENDIF |
|---|
| 9317 | |
|---|
| 9318 | ELSEIF ( TRIM( variable(1:6) ) == 'N_bin2' ) THEN |
|---|
| 9319 | IF ( av == 0 ) THEN |
|---|
| 9320 | DO i = nxl, nxr |
|---|
| 9321 | DO j = nys, nyn |
|---|
| 9322 | DO k = nzb, nzt+1 |
|---|
| 9323 | local_pf(i,j,k) = MERGE( aerosol_number(2)%conc(k,j,i), & |
|---|
| 9324 | REAL( -999.0_wp, KIND = wp ), & |
|---|
| 9325 | BTEST( wall_flags_0(k,j,i), 0 ) ) |
|---|
| 9326 | ENDDO |
|---|
| 9327 | ENDDO |
|---|
| 9328 | ENDDO |
|---|
| 9329 | ELSE |
|---|
| 9330 | DO i = nxl, nxr |
|---|
| 9331 | DO j = nys, nyn |
|---|
| 9332 | DO k = nzb, nzt+1 |
|---|
| 9333 | local_pf(i,j,k) = MERGE( Nbins_av(k,j,i,2), & |
|---|
| 9334 | REAL( -999.0_wp, KIND = wp ), & |
|---|
| 9335 | BTEST( wall_flags_0(k,j,i), 0 ) ) |
|---|
| 9336 | ENDDO |
|---|
| 9337 | ENDDO |
|---|
| 9338 | ENDDO |
|---|
| 9339 | ENDIF |
|---|
| 9340 | |
|---|
| 9341 | ELSEIF ( TRIM( variable(1:6) ) == 'N_bin3' ) THEN |
|---|
| 9342 | IF ( av == 0 ) THEN |
|---|
| 9343 | DO i = nxl, nxr |
|---|
| 9344 | DO j = nys, nyn |
|---|
| 9345 | DO k = nzb, nzt+1 |
|---|
| 9346 | local_pf(i,j,k) = MERGE( aerosol_number(3)%conc(k,j,i), & |
|---|
| 9347 | REAL( -999.0_wp, KIND = wp ), & |
|---|
| 9348 | BTEST( wall_flags_0(k,j,i), 0 ) ) |
|---|
| 9349 | ENDDO |
|---|
| 9350 | ENDDO |
|---|
| 9351 | ENDDO |
|---|
| 9352 | ELSE |
|---|
| 9353 | DO i = nxl, nxr |
|---|
| 9354 | DO j = nys, nyn |
|---|
| 9355 | DO k = nzb, nzt+1 |
|---|
| 9356 | local_pf(i,j,k) = MERGE( Nbins_av(k,j,i,3), & |
|---|
| 9357 | REAL( -999.0_wp, KIND = wp ), & |
|---|
| 9358 | BTEST( wall_flags_0(k,j,i), 0 ) ) |
|---|
| 9359 | ENDDO |
|---|
| 9360 | ENDDO |
|---|
| 9361 | ENDDO |
|---|
| 9362 | ENDIF |
|---|
| 9363 | |
|---|
| 9364 | ELSEIF ( TRIM( variable(1:6) ) == 'N_bin4' ) THEN |
|---|
| 9365 | IF ( av == 0 ) THEN |
|---|
| 9366 | DO i = nxl, nxr |
|---|
| 9367 | DO j = nys, nyn |
|---|
| 9368 | DO k = nzb, nzt+1 |
|---|
| 9369 | local_pf(i,j,k) = MERGE( aerosol_number(4)%conc(k,j,i), & |
|---|
| 9370 | REAL( -999.0_wp, KIND = wp ), & |
|---|
| 9371 | BTEST( wall_flags_0(k,j,i), 0 ) ) |
|---|
| 9372 | ENDDO |
|---|
| 9373 | ENDDO |
|---|
| 9374 | ENDDO |
|---|
| 9375 | ELSE |
|---|
| 9376 | DO i = nxl, nxr |
|---|
| 9377 | DO j = nys, nyn |
|---|
| 9378 | DO k = nzb, nzt+1 |
|---|
| 9379 | local_pf(i,j,k) = MERGE( Nbins_av(k,j,i,4), & |
|---|
| 9380 | REAL( -999.0_wp, KIND = wp ), & |
|---|
| 9381 | BTEST( wall_flags_0(k,j,i), 0 ) ) |
|---|
| 9382 | ENDDO |
|---|
| 9383 | ENDDO |
|---|
| 9384 | ENDDO |
|---|
| 9385 | ENDIF |
|---|
| 9386 | |
|---|
| 9387 | ELSEIF ( TRIM( variable(1:6) ) == 'N_bin5' ) THEN |
|---|
| 9388 | IF ( av == 0 ) THEN |
|---|
| 9389 | DO i = nxl, nxr |
|---|
| 9390 | DO j = nys, nyn |
|---|
| 9391 | DO k = nzb, nzt+1 |
|---|
| 9392 | local_pf(i,j,k) = MERGE( aerosol_number(5)%conc(k,j,i), & |
|---|
| 9393 | REAL( -999.0_wp, KIND = wp ), & |
|---|
| 9394 | BTEST( wall_flags_0(k,j,i), 0 ) ) |
|---|
| 9395 | ENDDO |
|---|
| 9396 | ENDDO |
|---|
| 9397 | ENDDO |
|---|
| 9398 | ELSE |
|---|
| 9399 | DO i = nxl, nxr |
|---|
| 9400 | DO j = nys, nyn |
|---|
| 9401 | DO k = nzb, nzt+1 |
|---|
| 9402 | local_pf(i,j,k) = MERGE( Nbins_av(k,j,i,5), & |
|---|
| 9403 | REAL( -999.0_wp, KIND = wp ), & |
|---|
| 9404 | BTEST( wall_flags_0(k,j,i), 0 ) ) |
|---|
| 9405 | ENDDO |
|---|
| 9406 | ENDDO |
|---|
| 9407 | ENDDO |
|---|
| 9408 | ENDIF |
|---|
| 9409 | |
|---|
| 9410 | ELSEIF ( TRIM( variable(1:6) ) == 'N_bin6' ) THEN |
|---|
| 9411 | IF ( av == 0 ) THEN |
|---|
| 9412 | DO i = nxl, nxr |
|---|
| 9413 | DO j = nys, nyn |
|---|
| 9414 | DO k = nzb, nzt+1 |
|---|
| 9415 | local_pf(i,j,k) = MERGE( aerosol_number(6)%conc(k,j,i), & |
|---|
| 9416 | REAL( -999.0_wp, KIND = wp ), & |
|---|
| 9417 | BTEST( wall_flags_0(k,j,i), 0 ) ) |
|---|
| 9418 | ENDDO |
|---|
| 9419 | ENDDO |
|---|
| 9420 | ENDDO |
|---|
| 9421 | ELSE |
|---|
| 9422 | DO i = nxl, nxr |
|---|
| 9423 | DO j = nys, nyn |
|---|
| 9424 | DO k = nzb, nzt+1 |
|---|
| 9425 | local_pf(i,j,k) = MERGE( Nbins_av(k,j,i,6), & |
|---|
| 9426 | REAL( -999.0_wp, KIND = wp ), & |
|---|
| 9427 | BTEST( wall_flags_0(k,j,i), 0 ) ) |
|---|
| 9428 | ENDDO |
|---|
| 9429 | ENDDO |
|---|
| 9430 | ENDDO |
|---|
| 9431 | ENDIF |
|---|
| 9432 | |
|---|
| 9433 | ELSEIF ( TRIM( variable(1:6) ) == 'N_bin7' ) THEN |
|---|
| 9434 | IF ( av == 0 ) THEN |
|---|
| 9435 | DO i = nxl, nxr |
|---|
| 9436 | DO j = nys, nyn |
|---|
| 9437 | DO k = nzb, nzt+1 |
|---|
| 9438 | local_pf(i,j,k) = MERGE( aerosol_number(7)%conc(k,j,i), & |
|---|
| 9439 | REAL( -999.0_wp, KIND = wp ), & |
|---|
| 9440 | BTEST( wall_flags_0(k,j,i), 0 ) ) |
|---|
| 9441 | ENDDO |
|---|
| 9442 | ENDDO |
|---|
| 9443 | ENDDO |
|---|
| 9444 | ELSE |
|---|
| 9445 | DO i = nxl, nxr |
|---|
| 9446 | DO j = nys, nyn |
|---|
| 9447 | DO k = nzb, nzt+1 |
|---|
| 9448 | local_pf(i,j,k) = MERGE( Nbins_av(k,j,i,7), & |
|---|
| 9449 | REAL( -999.0_wp, KIND = wp ), & |
|---|
| 9450 | BTEST( wall_flags_0(k,j,i), 0 ) ) |
|---|
| 9451 | ENDDO |
|---|
| 9452 | ENDDO |
|---|
| 9453 | ENDDO |
|---|
| 9454 | ENDIF |
|---|
| 9455 | |
|---|
| 9456 | ELSEIF ( TRIM( variable(1:6) ) == 'N_bin8' ) THEN |
|---|
| 9457 | IF ( av == 0 ) THEN |
|---|
| 9458 | DO i = nxl, nxr |
|---|
| 9459 | DO j = nys, nyn |
|---|
| 9460 | DO k = nzb, nzt+1 |
|---|
| 9461 | local_pf(i,j,k) = MERGE( aerosol_number(8)%conc(k,j,i), & |
|---|
| 9462 | REAL( -999.0_wp, KIND = wp ), & |
|---|
| 9463 | BTEST( wall_flags_0(k,j,i), 0 ) ) |
|---|
| 9464 | ENDDO |
|---|
| 9465 | ENDDO |
|---|
| 9466 | ENDDO |
|---|
| 9467 | ELSE |
|---|
| 9468 | DO i = nxl, nxr |
|---|
| 9469 | DO j = nys, nyn |
|---|
| 9470 | DO k = nzb, nzt+1 |
|---|
| 9471 | local_pf(i,j,k) = MERGE( Nbins_av(k,j,i,8), & |
|---|
| 9472 | REAL( -999.0_wp, KIND = wp ), & |
|---|
| 9473 | BTEST( wall_flags_0(k,j,i), 0 ) ) |
|---|
| 9474 | ENDDO |
|---|
| 9475 | ENDDO |
|---|
| 9476 | ENDDO |
|---|
| 9477 | ENDIF |
|---|
| 9478 | |
|---|
| 9479 | ELSEIF ( TRIM( variable(1:6) ) == 'N_bin9' ) THEN |
|---|
| 9480 | IF ( av == 0 ) THEN |
|---|
| 9481 | DO i = nxl, nxr |
|---|
| 9482 | DO j = nys, nyn |
|---|
| 9483 | DO k = nzb, nzt+1 |
|---|
| 9484 | local_pf(i,j,k) = MERGE( aerosol_number(9)%conc(k,j,i), & |
|---|
| 9485 | REAL( -999.0_wp, KIND = wp ), & |
|---|
| 9486 | BTEST( wall_flags_0(k,j,i), 0 ) ) |
|---|
| 9487 | ENDDO |
|---|
| 9488 | ENDDO |
|---|
| 9489 | ENDDO |
|---|
| 9490 | ELSE |
|---|
| 9491 | DO i = nxl, nxr |
|---|
| 9492 | DO j = nys, nyn |
|---|
| 9493 | DO k = nzb, nzt+1 |
|---|
| 9494 | local_pf(i,j,k) = MERGE( Nbins_av(k,j,i,9), & |
|---|
| 9495 | REAL( -999.0_wp, KIND = wp ), & |
|---|
| 9496 | BTEST( wall_flags_0(k,j,i), 0 ) ) |
|---|
| 9497 | ENDDO |
|---|
| 9498 | ENDDO |
|---|
| 9499 | ENDDO |
|---|
| 9500 | ENDIF |
|---|
| 9501 | |
|---|
| 9502 | ELSEIF ( TRIM( variable(1:7) ) == 'N_bin10' ) THEN |
|---|
| 9503 | IF ( av == 0 ) THEN |
|---|
| 9504 | DO i = nxl, nxr |
|---|
| 9505 | DO j = nys, nyn |
|---|
| 9506 | DO k = nzb, nzt+1 |
|---|
| 9507 | local_pf(i,j,k) = MERGE( aerosol_number(10)%conc(k,j,i), & |
|---|
| 9508 | REAL( -999.0_wp, KIND = wp ), & |
|---|
| 9509 | BTEST( wall_flags_0(k,j,i), 0 ) ) |
|---|
| 9510 | ENDDO |
|---|
| 9511 | ENDDO |
|---|
| 9512 | ENDDO |
|---|
| 9513 | ELSE |
|---|
| 9514 | DO i = nxl, nxr |
|---|
| 9515 | DO j = nys, nyn |
|---|
| 9516 | DO k = nzb, nzt+1 |
|---|
| 9517 | local_pf(i,j,k) = MERGE( Nbins_av(k,j,i,10), & |
|---|
| 9518 | REAL( -999.0_wp, KIND = wp ), & |
|---|
| 9519 | BTEST( wall_flags_0(k,j,i), 0 ) ) |
|---|
| 9520 | ENDDO |
|---|
| 9521 | ENDDO |
|---|
| 9522 | ENDDO |
|---|
| 9523 | ENDIF |
|---|
| 9524 | |
|---|
| 9525 | ELSEIF ( TRIM( variable(1:7) ) == 'N_bin11' ) THEN |
|---|
| 9526 | IF ( av == 0 ) THEN |
|---|
| 9527 | DO i = nxl, nxr |
|---|
| 9528 | DO j = nys, nyn |
|---|
| 9529 | DO k = nzb, nzt+1 |
|---|
| 9530 | local_pf(i,j,k) = MERGE( aerosol_number(11)%conc(k,j,i), & |
|---|
| 9531 | REAL( -999.0_wp, KIND = wp ), & |
|---|
| 9532 | BTEST( wall_flags_0(k,j,i), 0 ) ) |
|---|
| 9533 | ENDDO |
|---|
| 9534 | ENDDO |
|---|
| 9535 | ENDDO |
|---|
| 9536 | ELSE |
|---|
| 9537 | DO i = nxl, nxr |
|---|
| 9538 | DO j = nys, nyn |
|---|
| 9539 | DO k = nzb, nzt+1 |
|---|
| 9540 | local_pf(i,j,k) = MERGE( Nbins_av(k,j,i,11), & |
|---|
| 9541 | REAL( -999.0_wp, KIND = wp ), & |
|---|
| 9542 | BTEST( wall_flags_0(k,j,i), 0 ) ) |
|---|
| 9543 | ENDDO |
|---|
| 9544 | ENDDO |
|---|
| 9545 | ENDDO |
|---|
| 9546 | ENDIF |
|---|
| 9547 | |
|---|
| 9548 | ELSEIF ( TRIM( variable(1:7) ) == 'N_bin12' ) THEN |
|---|
| 9549 | IF ( av == 0 ) THEN |
|---|
| 9550 | DO i = nxl, nxr |
|---|
| 9551 | DO j = nys, nyn |
|---|
| 9552 | DO k = nzb, nzt+1 |
|---|
| 9553 | local_pf(i,j,k) = MERGE( aerosol_number(12)%conc(k,j,i), & |
|---|
| 9554 | REAL( -999.0_wp, KIND = wp ), & |
|---|
| 9555 | BTEST( wall_flags_0(k,j,i), 0 ) ) |
|---|
| 9556 | ENDDO |
|---|
| 9557 | ENDDO |
|---|
| 9558 | ENDDO |
|---|
| 9559 | ELSE |
|---|
| 9560 | DO i = nxl, nxr |
|---|
| 9561 | DO j = nys, nyn |
|---|
| 9562 | DO k = nzb, nzt+1 |
|---|
| 9563 | local_pf(i,j,k) = MERGE( Nbins_av(k,j,i,12), & |
|---|
| 9564 | REAL( -999.0_wp, KIND = wp ), & |
|---|
| 9565 | BTEST( wall_flags_0(k,j,i), 0 ) ) |
|---|
| 9566 | ENDDO |
|---|
| 9567 | ENDDO |
|---|
| 9568 | ENDDO |
|---|
| 9569 | ENDIF |
|---|
| 9570 | |
|---|
| 9571 | ELSEIF ( TRIM( variable(1:4) ) == 'Ntot' ) THEN |
|---|
| 9572 | IF ( av == 0 ) THEN |
|---|
| 9573 | DO i = nxl, nxr |
|---|
| 9574 | DO j = nys, nyn |
|---|
| 9575 | DO k = nzb, nzt+1 |
|---|
| 9576 | temp_bin = 0.0_wp |
|---|
| 9577 | DO b = 1, nbins |
|---|
| 9578 | temp_bin = temp_bin + aerosol_number(b)%conc(k,j,i) |
|---|
| 9579 | ENDDO |
|---|
| 9580 | local_pf(i,j,k) = MERGE( temp_bin, REAL( -999.0_wp, & |
|---|
| 9581 | KIND = wp ), BTEST( wall_flags_0(k,j,i), 0 ) ) |
|---|
| 9582 | ENDDO |
|---|
| 9583 | ENDDO |
|---|
| 9584 | ENDDO |
|---|
| 9585 | ELSE |
|---|
| 9586 | DO i = nxl, nxr |
|---|
| 9587 | DO j = nys, nyn |
|---|
| 9588 | DO k = nzb, nzt+1 |
|---|
| 9589 | local_pf(i,j,k) = MERGE( Ntot_av(k,j,i), REAL( -999.0_wp, & |
|---|
| 9590 | KIND = wp ), BTEST( wall_flags_0(k,j,i), 0 ) ) |
|---|
| 9591 | ENDDO |
|---|
| 9592 | ENDDO |
|---|
| 9593 | ENDDO |
|---|
| 9594 | ENDIF |
|---|
| 9595 | |
|---|
| 9596 | IF ( mode == 'xy' ) grid = 'zu' |
|---|
| 9597 | |
|---|
| 9598 | |
|---|
| 9599 | ELSEIF ( TRIM( variable(1:6) ) == 'm_bin1' ) THEN |
|---|
| 9600 | IF ( av == 0 ) THEN |
|---|
| 9601 | DO i = nxl, nxr |
|---|
| 9602 | DO j = nys, nyn |
|---|
| 9603 | DO k = nzb, nzt+1 |
|---|
| 9604 | temp_bin = 0.0_wp |
|---|
| 9605 | DO c = 1, ncc_tot*nbins, nbins |
|---|
| 9606 | temp_bin = temp_bin + aerosol_mass(c)%conc(k,j,i) |
|---|
| 9607 | ENDDO |
|---|
| 9608 | local_pf(i,j,k) = MERGE( temp_bin, REAL( -999.0_wp, & |
|---|
| 9609 | KIND = wp ), BTEST( wall_flags_0(k,j,i), 0 ) ) |
|---|
| 9610 | ENDDO |
|---|
| 9611 | ENDDO |
|---|
| 9612 | ENDDO |
|---|
| 9613 | ELSE |
|---|
| 9614 | DO i = nxl, nxr |
|---|
| 9615 | DO j = nys, nyn |
|---|
| 9616 | DO k = nzb, nzt+1 |
|---|
| 9617 | local_pf(i,j,k) = MERGE( mbins_av(k,j,i,1), REAL( -999.0_wp,& |
|---|
| 9618 | KIND = wp ), BTEST( wall_flags_0(k,j,i), 0 ) ) |
|---|
| 9619 | ENDDO |
|---|
| 9620 | ENDDO |
|---|
| 9621 | ENDDO |
|---|
| 9622 | ENDIF |
|---|
| 9623 | |
|---|
| 9624 | ELSEIF ( TRIM( variable(1:6) ) == 'm_bin2' ) THEN |
|---|
| 9625 | IF ( av == 0 ) THEN |
|---|
| 9626 | DO i = nxl, nxr |
|---|
| 9627 | DO j = nys, nyn |
|---|
| 9628 | DO k = nzb, nzt+1 |
|---|
| 9629 | temp_bin = 0.0_wp |
|---|
| 9630 | DO c = 2, ncc_tot*nbins, nbins |
|---|
| 9631 | temp_bin = temp_bin + aerosol_mass(c)%conc(k,j,i) |
|---|
| 9632 | ENDDO |
|---|
| 9633 | local_pf(i,j,k) = MERGE( temp_bin, REAL( -999.0_wp, & |
|---|
| 9634 | KIND = wp ), BTEST( wall_flags_0(k,j,i), 0 ) ) |
|---|
| 9635 | ENDDO |
|---|
| 9636 | ENDDO |
|---|
| 9637 | ENDDO |
|---|
| 9638 | ELSE |
|---|
| 9639 | DO i = nxl, nxr |
|---|
| 9640 | DO j = nys, nyn |
|---|
| 9641 | DO k = nzb, nzt+1 |
|---|
| 9642 | local_pf(i,j,k) = MERGE( mbins_av(k,j,i,2), REAL( -999.0_wp,& |
|---|
| 9643 | KIND = wp ), BTEST( wall_flags_0(k,j,i), 0 ) ) |
|---|
| 9644 | ENDDO |
|---|
| 9645 | ENDDO |
|---|
| 9646 | ENDDO |
|---|
| 9647 | ENDIF |
|---|
| 9648 | |
|---|
| 9649 | ELSEIF ( TRIM( variable(1:6) ) == 'm_bin3' ) THEN |
|---|
| 9650 | IF ( av == 0 ) THEN |
|---|
| 9651 | DO i = nxl, nxr |
|---|
| 9652 | DO j = nys, nyn |
|---|
| 9653 | DO k = nzb, nzt+1 |
|---|
| 9654 | temp_bin = 0.0_wp |
|---|
| 9655 | DO c = 3, ncc_tot*nbins, nbins |
|---|
| 9656 | temp_bin = temp_bin + aerosol_mass(c)%conc(k,j,i) |
|---|
| 9657 | ENDDO |
|---|
| 9658 | local_pf(i,j,k) = MERGE( temp_bin, REAL( -999.0_wp, & |
|---|
| 9659 | KIND = wp ), BTEST( wall_flags_0(k,j,i), 0 ) ) |
|---|
| 9660 | ENDDO |
|---|
| 9661 | ENDDO |
|---|
| 9662 | ENDDO |
|---|
| 9663 | ELSE |
|---|
| 9664 | DO i = nxl, nxr |
|---|
| 9665 | DO j = nys, nyn |
|---|
| 9666 | DO k = nzb, nzt+1 |
|---|
| 9667 | local_pf(i,j,k) = MERGE( mbins_av(k,j,i,3), REAL( -999.0_wp,& |
|---|
| 9668 | KIND = wp ), BTEST( wall_flags_0(k,j,i), 0 ) ) |
|---|
| 9669 | ENDDO |
|---|
| 9670 | ENDDO |
|---|
| 9671 | ENDDO |
|---|
| 9672 | ENDIF |
|---|
| 9673 | |
|---|
| 9674 | ELSEIF ( TRIM( variable(1:6) ) == 'm_bin4' ) THEN |
|---|
| 9675 | IF ( av == 0 ) THEN |
|---|
| 9676 | DO i = nxl, nxr |
|---|
| 9677 | DO j = nys, nyn |
|---|
| 9678 | DO k = nzb, nzt+1 |
|---|
| 9679 | temp_bin = 0.0_wp |
|---|
| 9680 | DO c = 4, ncc_tot*nbins, nbins |
|---|
| 9681 | temp_bin = temp_bin + aerosol_mass(c)%conc(k,j,i) |
|---|
| 9682 | ENDDO |
|---|
| 9683 | local_pf(i,j,k) = MERGE( temp_bin, REAL( -999.0_wp, & |
|---|
| 9684 | KIND = wp ), BTEST( wall_flags_0(k,j,i), 0 ) ) |
|---|
| 9685 | ENDDO |
|---|
| 9686 | ENDDO |
|---|
| 9687 | ENDDO |
|---|
| 9688 | ELSE |
|---|
| 9689 | DO i = nxl, nxr |
|---|
| 9690 | DO j = nys, nyn |
|---|
| 9691 | DO k = nzb, nzt+1 |
|---|
| 9692 | local_pf(i,j,k) = MERGE( mbins_av(k,j,i,4), REAL( -999.0_wp,& |
|---|
| 9693 | KIND = wp ), BTEST( wall_flags_0(k,j,i), 0 ) ) |
|---|
| 9694 | ENDDO |
|---|
| 9695 | ENDDO |
|---|
| 9696 | ENDDO |
|---|
| 9697 | ENDIF |
|---|
| 9698 | |
|---|
| 9699 | ELSEIF ( TRIM( variable(1:6) ) == 'm_bin5' ) THEN |
|---|
| 9700 | IF ( av == 0 ) THEN |
|---|
| 9701 | DO i = nxl, nxr |
|---|
| 9702 | DO j = nys, nyn |
|---|
| 9703 | DO k = nzb, nzt+1 |
|---|
| 9704 | temp_bin = 0.0_wp |
|---|
| 9705 | DO c = 5, ncc_tot*nbins, nbins |
|---|
| 9706 | temp_bin = temp_bin + aerosol_mass(c)%conc(k,j,i) |
|---|
| 9707 | ENDDO |
|---|
| 9708 | local_pf(i,j,k) = MERGE( temp_bin, REAL( -999.0_wp, & |
|---|
| 9709 | KIND = wp ), BTEST( wall_flags_0(k,j,i), 0 ) ) |
|---|
| 9710 | ENDDO |
|---|
| 9711 | ENDDO |
|---|
| 9712 | ENDDO |
|---|
| 9713 | ELSE |
|---|
| 9714 | DO i = nxl, nxr |
|---|
| 9715 | DO j = nys, nyn |
|---|
| 9716 | DO k = nzb, nzt+1 |
|---|
| 9717 | local_pf(i,j,k) = MERGE( mbins_av(k,j,i,5), REAL( -999.0_wp,& |
|---|
| 9718 | KIND = wp ), BTEST( wall_flags_0(k,j,i), 0 ) ) |
|---|
| 9719 | ENDDO |
|---|
| 9720 | ENDDO |
|---|
| 9721 | ENDDO |
|---|
| 9722 | ENDIF |
|---|
| 9723 | |
|---|
| 9724 | ELSEIF ( TRIM( variable(1:6) ) == 'm_bin6' ) THEN |
|---|
| 9725 | IF ( av == 0 ) THEN |
|---|
| 9726 | DO i = nxl, nxr |
|---|
| 9727 | DO j = nys, nyn |
|---|
| 9728 | DO k = nzb, nzt+1 |
|---|
| 9729 | temp_bin = 0.0_wp |
|---|
| 9730 | DO c = 6, ncc_tot*nbins, nbins |
|---|
| 9731 | temp_bin = temp_bin + aerosol_mass(c)%conc(k,j,i) |
|---|
| 9732 | ENDDO |
|---|
| 9733 | local_pf(i,j,k) = MERGE( temp_bin, REAL( -999.0_wp, & |
|---|
| 9734 | KIND = wp ), BTEST( wall_flags_0(k,j,i), 0 ) ) |
|---|
| 9735 | ENDDO |
|---|
| 9736 | ENDDO |
|---|
| 9737 | ENDDO |
|---|
| 9738 | ELSE |
|---|
| 9739 | DO i = nxl, nxr |
|---|
| 9740 | DO j = nys, nyn |
|---|
| 9741 | DO k = nzb, nzt+1 |
|---|
| 9742 | local_pf(i,j,k) = MERGE( mbins_av(k,j,i,6), REAL( -999.0_wp,& |
|---|
| 9743 | KIND = wp ), BTEST( wall_flags_0(k,j,i), 0 ) ) |
|---|
| 9744 | ENDDO |
|---|
| 9745 | ENDDO |
|---|
| 9746 | ENDDO |
|---|
| 9747 | ENDIF |
|---|
| 9748 | |
|---|
| 9749 | ELSEIF ( TRIM( variable(1:6) ) == 'm_bin7' ) THEN |
|---|
| 9750 | IF ( av == 0 ) THEN |
|---|
| 9751 | DO i = nxl, nxr |
|---|
| 9752 | DO j = nys, nyn |
|---|
| 9753 | DO k = nzb, nzt+1 |
|---|
| 9754 | temp_bin = 0.0_wp |
|---|
| 9755 | DO c = 7, ncc_tot*nbins, nbins |
|---|
| 9756 | temp_bin = temp_bin + aerosol_mass(c)%conc(k,j,i) |
|---|
| 9757 | ENDDO |
|---|
| 9758 | local_pf(i,j,k) = MERGE( temp_bin, REAL( -999.0_wp, & |
|---|
| 9759 | KIND = wp ), BTEST( wall_flags_0(k,j,i), 0 ) ) |
|---|
| 9760 | ENDDO |
|---|
| 9761 | ENDDO |
|---|
| 9762 | ENDDO |
|---|
| 9763 | ELSE |
|---|
| 9764 | DO i = nxl, nxr |
|---|
| 9765 | DO j = nys, nyn |
|---|
| 9766 | DO k = nzb, nzt+1 |
|---|
| 9767 | local_pf(i,j,k) = MERGE( mbins_av(k,j,i,7), REAL( -999.0_wp,& |
|---|
| 9768 | KIND = wp ), BTEST( wall_flags_0(k,j,i), 0 ) ) |
|---|
| 9769 | ENDDO |
|---|
| 9770 | ENDDO |
|---|
| 9771 | ENDDO |
|---|
| 9772 | ENDIF |
|---|
| 9773 | |
|---|
| 9774 | ELSEIF ( TRIM( variable(1:6) ) == 'm_bin8' ) THEN |
|---|
| 9775 | IF ( av == 0 ) THEN |
|---|
| 9776 | DO i = nxl, nxr |
|---|
| 9777 | DO j = nys, nyn |
|---|
| 9778 | DO k = nzb, nzt+1 |
|---|
| 9779 | temp_bin = 0.0_wp |
|---|
| 9780 | DO c = 8, ncc_tot*nbins, nbins |
|---|
| 9781 | temp_bin = temp_bin + aerosol_mass(c)%conc(k,j,i) |
|---|
| 9782 | ENDDO |
|---|
| 9783 | local_pf(i,j,k) = MERGE( temp_bin, REAL( -999.0_wp, & |
|---|
| 9784 | KIND = wp ), BTEST( wall_flags_0(k,j,i), 0 ) ) |
|---|
| 9785 | ENDDO |
|---|
| 9786 | ENDDO |
|---|
| 9787 | ENDDO |
|---|
| 9788 | ELSE |
|---|
| 9789 | DO i = nxl, nxr |
|---|
| 9790 | DO j = nys, nyn |
|---|
| 9791 | DO k = nzb, nzt+1 |
|---|
| 9792 | local_pf(i,j,k) = MERGE( mbins_av(k,j,i,8), REAL( -999.0_wp,& |
|---|
| 9793 | KIND = wp ), BTEST( wall_flags_0(k,j,i), 0 ) ) |
|---|
| 9794 | ENDDO |
|---|
| 9795 | ENDDO |
|---|
| 9796 | ENDDO |
|---|
| 9797 | ENDIF |
|---|
| 9798 | |
|---|
| 9799 | ELSEIF ( TRIM( variable(1:6) ) == 'm_bin9' ) THEN |
|---|
| 9800 | IF ( av == 0 ) THEN |
|---|
| 9801 | DO i = nxl, nxr |
|---|
| 9802 | DO j = nys, nyn |
|---|
| 9803 | DO k = nzb, nzt+1 |
|---|
| 9804 | temp_bin = 0.0_wp |
|---|
| 9805 | DO c = 9, ncc_tot*nbins, nbins |
|---|
| 9806 | temp_bin = temp_bin + aerosol_mass(c)%conc(k,j,i) |
|---|
| 9807 | ENDDO |
|---|
| 9808 | local_pf(i,j,k) = MERGE( temp_bin, REAL( -999.0_wp, & |
|---|
| 9809 | KIND = wp ), BTEST( wall_flags_0(k,j,i), 0 ) ) |
|---|
| 9810 | ENDDO |
|---|
| 9811 | ENDDO |
|---|
| 9812 | ENDDO |
|---|
| 9813 | ELSE |
|---|
| 9814 | DO i = nxl, nxr |
|---|
| 9815 | DO j = nys, nyn |
|---|
| 9816 | DO k = nzb, nzt+1 |
|---|
| 9817 | local_pf(i,j,k) = MERGE( mbins_av(k,j,i,9), REAL( -999.0_wp,& |
|---|
| 9818 | KIND = wp ), BTEST( wall_flags_0(k,j,i), 0 ) ) |
|---|
| 9819 | ENDDO |
|---|
| 9820 | ENDDO |
|---|
| 9821 | ENDDO |
|---|
| 9822 | ENDIF |
|---|
| 9823 | |
|---|
| 9824 | ELSEIF ( TRIM( variable(1:7) ) == 'm_bin10' ) THEN |
|---|
| 9825 | IF ( av == 0 ) THEN |
|---|
| 9826 | DO i = nxl, nxr |
|---|
| 9827 | DO j = nys, nyn |
|---|
| 9828 | DO k = nzb, nzt+1 |
|---|
| 9829 | temp_bin = 0.0_wp |
|---|
| 9830 | DO c = 10, ncc_tot*nbins, nbins |
|---|
| 9831 | temp_bin = temp_bin + aerosol_mass(c)%conc(k,j,i) |
|---|
| 9832 | ENDDO |
|---|
| 9833 | local_pf(i,j,k) = MERGE( temp_bin, REAL( -999.0_wp, & |
|---|
| 9834 | KIND = wp ), BTEST( wall_flags_0(k,j,i), 0 ) ) |
|---|
| 9835 | ENDDO |
|---|
| 9836 | ENDDO |
|---|
| 9837 | ENDDO |
|---|
| 9838 | ELSE |
|---|
| 9839 | DO i = nxl, nxr |
|---|
| 9840 | DO j = nys, nyn |
|---|
| 9841 | DO k = nzb, nzt+1 |
|---|
| 9842 | local_pf(i,j,k) = MERGE( mbins_av(k,j,i,10), REAL( & |
|---|
| 9843 | -999.0_wp, KIND = wp ), BTEST( wall_flags_0(k,j,i), 0 ) ) |
|---|
| 9844 | ENDDO |
|---|
| 9845 | ENDDO |
|---|
| 9846 | ENDDO |
|---|
| 9847 | ENDIF |
|---|
| 9848 | |
|---|
| 9849 | ELSEIF ( TRIM( variable(1:7) ) == 'm_bin11' ) THEN |
|---|
| 9850 | IF ( av == 0 ) THEN |
|---|
| 9851 | DO i = nxl, nxr |
|---|
| 9852 | DO j = nys, nyn |
|---|
| 9853 | DO k = nzb, nzt+1 |
|---|
| 9854 | temp_bin = 0.0_wp |
|---|
| 9855 | DO c = 11, ncc_tot*nbins, nbins |
|---|
| 9856 | temp_bin = temp_bin + aerosol_mass(c)%conc(k,j,i) |
|---|
| 9857 | ENDDO |
|---|
| 9858 | local_pf(i,j,k) = MERGE( temp_bin, REAL( -999.0_wp, & |
|---|
| 9859 | KIND = wp ), BTEST( wall_flags_0(k,j,i), 0 ) ) |
|---|
| 9860 | ENDDO |
|---|
| 9861 | ENDDO |
|---|
| 9862 | ENDDO |
|---|
| 9863 | ELSE |
|---|
| 9864 | DO i = nxl, nxr |
|---|
| 9865 | DO j = nys, nyn |
|---|
| 9866 | DO k = nzb, nzt+1 |
|---|
| 9867 | local_pf(i,j,k) = MERGE( mbins_av(k,j,i,11), REAL( & |
|---|
| 9868 | -999.0_wp, KIND = wp ), BTEST( wall_flags_0(k,j,i), 0 ) ) |
|---|
| 9869 | ENDDO |
|---|
| 9870 | ENDDO |
|---|
| 9871 | ENDDO |
|---|
| 9872 | ENDIF |
|---|
| 9873 | |
|---|
| 9874 | ELSEIF ( TRIM( variable(1:7) ) == 'm_bin12' ) THEN |
|---|
| 9875 | IF ( av == 0 ) THEN |
|---|
| 9876 | DO i = nxl, nxr |
|---|
| 9877 | DO j = nys, nyn |
|---|
| 9878 | DO k = nzb, nzt+1 |
|---|
| 9879 | temp_bin = 0.0_wp |
|---|
| 9880 | DO c = 12, ncc_tot*nbins, nbins |
|---|
| 9881 | temp_bin = temp_bin + aerosol_mass(c)%conc(k,j,i) |
|---|
| 9882 | ENDDO |
|---|
| 9883 | local_pf(i,j,k) = MERGE( temp_bin, REAL( -999.0_wp, & |
|---|
| 9884 | KIND = wp ), BTEST( wall_flags_0(k,j,i), 0 ) ) |
|---|
| 9885 | ENDDO |
|---|
| 9886 | ENDDO |
|---|
| 9887 | ENDDO |
|---|
| 9888 | ELSE |
|---|
| 9889 | DO i = nxl, nxr |
|---|
| 9890 | DO j = nys, nyn |
|---|
| 9891 | DO k = nzb, nzt+1 |
|---|
| 9892 | local_pf(i,j,k) = MERGE( mbins_av(k,j,i,12), REAL( & |
|---|
| 9893 | -999.0_wp, KIND = wp ), BTEST( wall_flags_0(k,j,i), 0 ) ) |
|---|
| 9894 | ENDDO |
|---|
| 9895 | ENDDO |
|---|
| 9896 | ENDDO |
|---|
| 9897 | ENDIF |
|---|
| 9898 | |
|---|
| 9899 | ELSEIF ( TRIM( variable(1:5) ) == 'PM2.5' ) THEN |
|---|
| 9900 | IF ( av == 0 ) THEN |
|---|
| 9901 | DO i = nxl, nxr |
|---|
| 9902 | DO j = nys, nyn |
|---|
| 9903 | DO k = nzb, nzt+1 |
|---|
| 9904 | temp_bin = 0.0_wp |
|---|
| 9905 | DO b = 1, nbins |
|---|
| 9906 | IF ( 2.0_wp * Ra_dry(k,j,i,b) <= 2.5E-6_wp ) THEN |
|---|
| 9907 | DO c = b, nbins*ncc, nbins |
|---|
| 9908 | temp_bin = temp_bin + aerosol_mass(c)%conc(k,j,i) |
|---|
| 9909 | ENDDO |
|---|
| 9910 | ENDIF |
|---|
| 9911 | ENDDO |
|---|
| 9912 | local_pf(i,j,k) = MERGE( temp_bin, REAL( -999.0_wp, & |
|---|
| 9913 | KIND = wp ), BTEST( wall_flags_0(k,j,i), 0 ) ) |
|---|
| 9914 | ENDDO |
|---|
| 9915 | ENDDO |
|---|
| 9916 | ENDDO |
|---|
| 9917 | ELSE |
|---|
| 9918 | DO i = nxl, nxr |
|---|
| 9919 | DO j = nys, nyn |
|---|
| 9920 | DO k = nzb, nzt+1 |
|---|
| 9921 | local_pf(i,j,k) = MERGE( PM25_av(k,j,i), REAL( -999.0_wp, & |
|---|
| 9922 | KIND = wp ), BTEST( wall_flags_0(k,j,i), 0 ) ) |
|---|
| 9923 | ENDDO |
|---|
| 9924 | ENDDO |
|---|
| 9925 | ENDDO |
|---|
| 9926 | ENDIF |
|---|
| 9927 | |
|---|
| 9928 | IF ( mode == 'xy' ) grid = 'zu' |
|---|
| 9929 | |
|---|
| 9930 | |
|---|
| 9931 | ELSEIF ( TRIM( variable(1:4) ) == 'PM10' ) THEN |
|---|
| 9932 | IF ( av == 0 ) THEN |
|---|
| 9933 | DO i = nxl, nxr |
|---|
| 9934 | DO j = nys, nyn |
|---|
| 9935 | DO k = nzb, nzt+1 |
|---|
| 9936 | temp_bin = 0.0_wp |
|---|
| 9937 | DO b = 1, nbins |
|---|
| 9938 | IF ( 2.0_wp * Ra_dry(k,j,i,b) <= 10.0E-6_wp ) THEN |
|---|
| 9939 | DO c = b, nbins*ncc, nbins |
|---|
| 9940 | temp_bin = temp_bin + aerosol_mass(c)%conc(k,j,i) |
|---|
| 9941 | ENDDO |
|---|
| 9942 | ENDIF |
|---|
| 9943 | ENDDO |
|---|
| 9944 | local_pf(i,j,k) = MERGE( temp_bin, REAL( -999.0_wp, & |
|---|
| 9945 | KIND = wp ), BTEST( wall_flags_0(k,j,i), 0 ) ) |
|---|
| 9946 | ENDDO |
|---|
| 9947 | ENDDO |
|---|
| 9948 | ENDDO |
|---|
| 9949 | ELSE |
|---|
| 9950 | DO i = nxl, nxr |
|---|
| 9951 | DO j = nys, nyn |
|---|
| 9952 | DO k = nzb, nzt+1 |
|---|
| 9953 | local_pf(i,j,k) = MERGE( PM10_av(k,j,i), REAL( -999.0_wp, & |
|---|
| 9954 | KIND = wp ), BTEST( wall_flags_0(k,j,i), 0 ) ) |
|---|
| 9955 | ENDDO |
|---|
| 9956 | ENDDO |
|---|
| 9957 | ENDDO |
|---|
| 9958 | ENDIF |
|---|
| 9959 | |
|---|
| 9960 | IF ( mode == 'xy' ) grid = 'zu' |
|---|
| 9961 | |
|---|
| 9962 | ELSEIF ( TRIM( variable(1:2) ) == 's_' ) THEN |
|---|
| 9963 | vari = TRIM( variable( 3:LEN( TRIM( variable ) ) - 3 ) ) |
|---|
| 9964 | IF ( is_used( prtcl, vari ) ) THEN |
|---|
| 9965 | icc = get_index( prtcl, vari ) |
|---|
| 9966 | IF ( av == 0 ) THEN |
|---|
| 9967 | DO i = nxl, nxr |
|---|
| 9968 | DO j = nys, nyn |
|---|
| 9969 | DO k = nzb, nzt+1 |
|---|
| 9970 | temp_bin = 0.0_wp |
|---|
| 9971 | DO c = ( icc-1 )*nbins+1, icc*nbins, 1 |
|---|
| 9972 | temp_bin = temp_bin + aerosol_mass(c)%conc(k,j,i) |
|---|
| 9973 | ENDDO |
|---|
| 9974 | local_pf(i,j,k) = MERGE( temp_bin, REAL( -999.0_wp, & |
|---|
| 9975 | KIND = wp ), BTEST( wall_flags_0(k,j,i), 0 ) ) |
|---|
| 9976 | ENDDO |
|---|
| 9977 | ENDDO |
|---|
| 9978 | ENDDO |
|---|
| 9979 | ELSE |
|---|
| 9980 | IF ( vari == 'BC' ) to_be_resorted => s_BC_av |
|---|
| 9981 | IF ( vari == 'DU' ) to_be_resorted => s_DU_av |
|---|
| 9982 | IF ( vari == 'NH' ) to_be_resorted => s_NH_av |
|---|
| 9983 | IF ( vari == 'NO' ) to_be_resorted => s_NO_av |
|---|
| 9984 | IF ( vari == 'OC' ) to_be_resorted => s_OC_av |
|---|
| 9985 | IF ( vari == 'SO4' ) to_be_resorted => s_SO4_av |
|---|
| 9986 | IF ( vari == 'SS' ) to_be_resorted => s_SS_av |
|---|
| 9987 | DO i = nxl, nxr |
|---|
| 9988 | DO j = nys, nyn |
|---|
| 9989 | DO k = nzb, nzt+1 |
|---|
| 9990 | local_pf(i,j,k) = MERGE( to_be_resorted(k,j,i), & |
|---|
| 9991 | REAL( -999.0_wp, KIND = wp ), & |
|---|
| 9992 | BTEST( wall_flags_0(k,j,i), 0 ) ) |
|---|
| 9993 | ENDDO |
|---|
| 9994 | ENDDO |
|---|
| 9995 | ENDDO |
|---|
| 9996 | ENDIF |
|---|
| 9997 | ELSE |
|---|
| 9998 | local_pf = 0.0_wp |
|---|
| 9999 | ENDIF |
|---|
| 10000 | |
|---|
| 10001 | IF ( mode == 'xy' ) grid = 'zu' |
|---|
| 10002 | |
|---|
| 10003 | ELSE |
|---|
| 10004 | found = .FALSE. |
|---|
| 10005 | grid = 'none' |
|---|
| 10006 | |
|---|
| 10007 | ENDIF |
|---|
| 10008 | |
|---|
| 10009 | END SUBROUTINE salsa_data_output_2d |
|---|
| 10010 | |
|---|
| 10011 | |
|---|
| 10012 | !------------------------------------------------------------------------------! |
|---|
| 10013 | ! |
|---|
| 10014 | ! Description: |
|---|
| 10015 | ! ------------ |
|---|
| 10016 | !> Subroutine defining 3D output variables |
|---|
| 10017 | !------------------------------------------------------------------------------! |
|---|
| 10018 | SUBROUTINE salsa_data_output_3d( av, variable, found, local_pf ) |
|---|
| 10019 | |
|---|
| 10020 | USE indices |
|---|
| 10021 | |
|---|
| 10022 | USE kinds |
|---|
| 10023 | |
|---|
| 10024 | IMPLICIT NONE |
|---|
| 10025 | |
|---|
| 10026 | CHARACTER (LEN=*), INTENT(in) :: variable !< |
|---|
| 10027 | |
|---|
| 10028 | INTEGER(iwp) :: av !< |
|---|
| 10029 | INTEGER(iwp) :: c !< |
|---|
| 10030 | INTEGER(iwp) :: i !< |
|---|
| 10031 | INTEGER(iwp) :: icc !< index of a chemical compound |
|---|
| 10032 | INTEGER(iwp) :: j !< |
|---|
| 10033 | INTEGER(iwp) :: k !< |
|---|
| 10034 | INTEGER(iwp) :: n !< |
|---|
| 10035 | |
|---|
| 10036 | LOGICAL :: found !< |
|---|
| 10037 | REAL(wp) :: df !< For calculating LDSA: fraction of particles |
|---|
| 10038 | !< depositing in the alveolar (or tracheobronchial) |
|---|
| 10039 | !< region of the lung. Depends on the particle size |
|---|
| 10040 | REAL(wp) :: mean_d !< Particle diameter in micrometres |
|---|
| 10041 | REAL(wp) :: nc !< Particle number concentration in units 1/cm**3 |
|---|
| 10042 | |
|---|
| 10043 | REAL(sp), DIMENSION(nxl:nxr,nys:nyn,nzb:nzt+1) :: local_pf !< local |
|---|
| 10044 | !< array to which output data is resorted to |
|---|
| 10045 | REAL(wp) :: temp_bin !< |
|---|
| 10046 | REAL(wp), DIMENSION(:,:,:), POINTER :: to_be_resorted !< points to |
|---|
| 10047 | !< selected output variable |
|---|
| 10048 | |
|---|
| 10049 | found = .TRUE. |
|---|
| 10050 | temp_bin = 0.0_wp |
|---|
| 10051 | |
|---|
| 10052 | SELECT CASE ( TRIM( variable ) ) |
|---|
| 10053 | |
|---|
| 10054 | CASE ( 'g_H2SO4', 'g_HNO3', 'g_NH3', 'g_OCNV', 'g_OCSV' ) |
|---|
| 10055 | IF ( av == 0 ) THEN |
|---|
| 10056 | IF ( TRIM( variable ) == 'g_H2SO4') icc = 1 |
|---|
| 10057 | IF ( TRIM( variable ) == 'g_HNO3') icc = 2 |
|---|
| 10058 | IF ( TRIM( variable ) == 'g_NH3') icc = 3 |
|---|
| 10059 | IF ( TRIM( variable ) == 'g_OCNV') icc = 4 |
|---|
| 10060 | IF ( TRIM( variable ) == 'g_OCSV') icc = 5 |
|---|
| 10061 | |
|---|
| 10062 | DO i = nxl, nxr |
|---|
| 10063 | DO j = nys, nyn |
|---|
| 10064 | DO k = nzb, nzt+1 |
|---|
| 10065 | local_pf(i,j,k) = MERGE( salsa_gas(icc)%conc(k,j,i), & |
|---|
| 10066 | REAL( -999.0_wp, KIND = wp ), & |
|---|
| 10067 | BTEST( wall_flags_0(k,j,i), 0 ) ) |
|---|
| 10068 | ENDDO |
|---|
| 10069 | ENDDO |
|---|
| 10070 | ENDDO |
|---|
| 10071 | ELSE |
|---|
| 10072 | IF ( TRIM( variable(3:) ) == 'H2SO4' ) to_be_resorted => g_H2SO4_av |
|---|
| 10073 | IF ( TRIM( variable(3:) ) == 'HNO3' ) to_be_resorted => g_HNO3_av |
|---|
| 10074 | IF ( TRIM( variable(3:) ) == 'NH3' ) to_be_resorted => g_NH3_av |
|---|
| 10075 | IF ( TRIM( variable(3:) ) == 'OCNV' ) to_be_resorted => g_OCNV_av |
|---|
| 10076 | IF ( TRIM( variable(3:) ) == 'OCSV' ) to_be_resorted => g_OCSV_av |
|---|
| 10077 | DO i = nxl, nxr |
|---|
| 10078 | DO j = nys, nyn |
|---|
| 10079 | DO k = nzb, nzt+1 |
|---|
| 10080 | local_pf(i,j,k) = MERGE( to_be_resorted(k,j,i), & |
|---|
| 10081 | REAL( -999.0_wp, KIND = wp ), & |
|---|
| 10082 | BTEST( wall_flags_0(k,j,i), 0 ) ) |
|---|
| 10083 | ENDDO |
|---|
| 10084 | ENDDO |
|---|
| 10085 | ENDDO |
|---|
| 10086 | ENDIF |
|---|
| 10087 | |
|---|
| 10088 | CASE ( 'LDSA' ) |
|---|
| 10089 | IF ( av == 0 ) THEN |
|---|
| 10090 | DO i = nxl, nxr |
|---|
| 10091 | DO j = nys, nyn |
|---|
| 10092 | DO k = nzb, nzt+1 |
|---|
| 10093 | temp_bin = 0.0_wp |
|---|
| 10094 | DO n = 1, nbins |
|---|
| 10095 | ! |
|---|
| 10096 | !-- Diameter in micrometres |
|---|
| 10097 | mean_d = 1.0E+6_wp * Ra_dry(k,j,i,n) * 2.0_wp |
|---|
| 10098 | ! |
|---|
| 10099 | !-- Deposition factor: alveolar |
|---|
| 10100 | df = ( 0.01555_wp / mean_d ) * ( EXP( -0.416_wp * & |
|---|
| 10101 | ( LOG( mean_d ) + 2.84_wp )**2.0_wp ) & |
|---|
| 10102 | + 19.11_wp * EXP( -0.482_wp * & |
|---|
| 10103 | ( LOG( mean_d ) - 1.362_wp )**2.0_wp ) ) |
|---|
| 10104 | ! |
|---|
| 10105 | !-- Number concentration in 1/cm3 |
|---|
| 10106 | nc = 1.0E-6_wp * aerosol_number(n)%conc(k,j,i) |
|---|
| 10107 | ! |
|---|
| 10108 | !-- Lung-deposited surface area LDSA (units mum2/cm3) |
|---|
| 10109 | temp_bin = temp_bin + pi * mean_d**2.0_wp * df * nc |
|---|
| 10110 | ENDDO |
|---|
| 10111 | local_pf(i,j,k) = MERGE( temp_bin, & |
|---|
| 10112 | REAL( -999.0_wp, KIND = wp ), & |
|---|
| 10113 | BTEST( wall_flags_0(k,j,i), 0 ) ) |
|---|
| 10114 | ENDDO |
|---|
| 10115 | ENDDO |
|---|
| 10116 | ENDDO |
|---|
| 10117 | ELSE |
|---|
| 10118 | DO i = nxl, nxr |
|---|
| 10119 | DO j = nys, nyn |
|---|
| 10120 | DO k = nzb, nzt+1 |
|---|
| 10121 | local_pf(i,j,k) = MERGE( LDSA_av(k,j,i), & |
|---|
| 10122 | REAL( -999.0_wp, KIND = wp ), & |
|---|
| 10123 | BTEST( wall_flags_0(k,j,i), 0 ) ) |
|---|
| 10124 | ENDDO |
|---|
| 10125 | ENDDO |
|---|
| 10126 | ENDDO |
|---|
| 10127 | ENDIF |
|---|
| 10128 | |
|---|
| 10129 | CASE ( 'Ntot' ) |
|---|
| 10130 | IF ( av == 0 ) THEN |
|---|
| 10131 | DO i = nxl, nxr |
|---|
| 10132 | DO j = nys, nyn |
|---|
| 10133 | DO k = nzb, nzt+1 |
|---|
| 10134 | temp_bin = 0.0_wp |
|---|
| 10135 | DO n = 1, nbins |
|---|
| 10136 | temp_bin = temp_bin + aerosol_number(n)%conc(k,j,i) |
|---|
| 10137 | ENDDO |
|---|
| 10138 | local_pf(i,j,k) = MERGE( temp_bin, & |
|---|
| 10139 | REAL( -999.0_wp, KIND = wp ), & |
|---|
| 10140 | BTEST( wall_flags_0(k,j,i), 0 ) ) |
|---|
| 10141 | ENDDO |
|---|
| 10142 | ENDDO |
|---|
| 10143 | ENDDO |
|---|
| 10144 | ELSE |
|---|
| 10145 | DO i = nxl, nxr |
|---|
| 10146 | DO j = nys, nyn |
|---|
| 10147 | DO k = nzb, nzt+1 |
|---|
| 10148 | local_pf(i,j,k) = MERGE( Ntot_av(k,j,i), & |
|---|
| 10149 | REAL( -999.0_wp, KIND = wp ), & |
|---|
| 10150 | BTEST( wall_flags_0(k,j,i), 0 ) ) |
|---|
| 10151 | ENDDO |
|---|
| 10152 | ENDDO |
|---|
| 10153 | ENDDO |
|---|
| 10154 | ENDIF |
|---|
| 10155 | |
|---|
| 10156 | CASE ( 'PM2.5' ) |
|---|
| 10157 | IF ( av == 0 ) THEN |
|---|
| 10158 | DO i = nxl, nxr |
|---|
| 10159 | DO j = nys, nyn |
|---|
| 10160 | DO k = nzb, nzt+1 |
|---|
| 10161 | temp_bin = 0.0_wp |
|---|
| 10162 | DO n = 1, nbins |
|---|
| 10163 | IF ( 2.0_wp * Ra_dry(k,j,i,n) <= 2.5E-6_wp ) THEN |
|---|
| 10164 | DO c = n, nbins*ncc, nbins |
|---|
| 10165 | temp_bin = temp_bin + aerosol_mass(c)%conc(k,j,i) |
|---|
| 10166 | ENDDO |
|---|
| 10167 | ENDIF |
|---|
| 10168 | ENDDO |
|---|
| 10169 | local_pf(i,j,k) = MERGE( temp_bin, & |
|---|
| 10170 | REAL( -999.0_wp, KIND = wp ), & |
|---|
| 10171 | BTEST( wall_flags_0(k,j,i), 0 ) ) |
|---|
| 10172 | ENDDO |
|---|
| 10173 | ENDDO |
|---|
| 10174 | ENDDO |
|---|
| 10175 | ELSE |
|---|
| 10176 | DO i = nxl, nxr |
|---|
| 10177 | DO j = nys, nyn |
|---|
| 10178 | DO k = nzb, nzt+1 |
|---|
| 10179 | local_pf(i,j,k) = MERGE( PM25_av(k,j,i), & |
|---|
| 10180 | REAL( -999.0_wp, KIND = wp ), & |
|---|
| 10181 | BTEST( wall_flags_0(k,j,i), 0 ) ) |
|---|
| 10182 | ENDDO |
|---|
| 10183 | ENDDO |
|---|
| 10184 | ENDDO |
|---|
| 10185 | ENDIF |
|---|
| 10186 | |
|---|
| 10187 | CASE ( 'PM10' ) |
|---|
| 10188 | IF ( av == 0 ) THEN |
|---|
| 10189 | DO i = nxl, nxr |
|---|
| 10190 | DO j = nys, nyn |
|---|
| 10191 | DO k = nzb, nzt+1 |
|---|
| 10192 | temp_bin = 0.0_wp |
|---|
| 10193 | DO n = 1, nbins |
|---|
| 10194 | IF ( 2.0_wp * Ra_dry(k,j,i,n) <= 10.0E-6_wp ) THEN |
|---|
| 10195 | DO c = n, nbins*ncc, nbins |
|---|
| 10196 | temp_bin = temp_bin + aerosol_mass(c)%conc(k,j,i) |
|---|
| 10197 | ENDDO |
|---|
| 10198 | ENDIF |
|---|
| 10199 | ENDDO |
|---|
| 10200 | local_pf(i,j,k) = MERGE( temp_bin, & |
|---|
| 10201 | REAL( -999.0_wp, KIND = wp ), & |
|---|
| 10202 | BTEST( wall_flags_0(k,j,i), 0 ) ) |
|---|
| 10203 | ENDDO |
|---|
| 10204 | ENDDO |
|---|
| 10205 | ENDDO |
|---|
| 10206 | ELSE |
|---|
| 10207 | DO i = nxl, nxr |
|---|
| 10208 | DO j = nys, nyn |
|---|
| 10209 | DO k = nzb, nzt+1 |
|---|
| 10210 | local_pf(i,j,k) = MERGE( PM10_av(k,j,i), & |
|---|
| 10211 | REAL( -999.0_wp, KIND = wp ), & |
|---|
| 10212 | BTEST( wall_flags_0(k,j,i), 0 ) ) |
|---|
| 10213 | ENDDO |
|---|
| 10214 | ENDDO |
|---|
| 10215 | ENDDO |
|---|
| 10216 | ENDIF |
|---|
| 10217 | |
|---|
| 10218 | CASE ( 'N_bin1' ) |
|---|
| 10219 | IF ( av == 0 ) THEN |
|---|
| 10220 | DO i = nxl, nxr |
|---|
| 10221 | DO j = nys, nyn |
|---|
| 10222 | DO k = nzb, nzt+1 |
|---|
| 10223 | local_pf(i,j,k) = MERGE( aerosol_number(1)%conc(k,j,i), & |
|---|
| 10224 | REAL( -999.0_wp, KIND = wp ), & |
|---|
| 10225 | BTEST( wall_flags_0(k,j,i), 0 ) ) |
|---|
| 10226 | ENDDO |
|---|
| 10227 | ENDDO |
|---|
| 10228 | ENDDO |
|---|
| 10229 | ELSE |
|---|
| 10230 | DO i = nxl, nxr |
|---|
| 10231 | DO j = nys, nyn |
|---|
| 10232 | DO k = nzb, nzt+1 |
|---|
| 10233 | local_pf(i,j,k) = MERGE( Nbins_av(k,j,i,1), & |
|---|
| 10234 | REAL( -999.0_wp, KIND = wp ), & |
|---|
| 10235 | BTEST( wall_flags_0(k,j,i), 0 ) ) |
|---|
| 10236 | ENDDO |
|---|
| 10237 | ENDDO |
|---|
| 10238 | ENDDO |
|---|
| 10239 | ENDIF |
|---|
| 10240 | |
|---|
| 10241 | CASE ( 'N_bin2' ) |
|---|
| 10242 | IF ( av == 0 ) THEN |
|---|
| 10243 | DO i = nxl, nxr |
|---|
| 10244 | DO j = nys, nyn |
|---|
| 10245 | DO k = nzb, nzt+1 |
|---|
| 10246 | local_pf(i,j,k) = MERGE( aerosol_number(2)%conc(k,j,i), & |
|---|
| 10247 | REAL( -999.0_wp, KIND = wp ), & |
|---|
| 10248 | BTEST( wall_flags_0(k,j,i), 0 ) ) |
|---|
| 10249 | ENDDO |
|---|
| 10250 | ENDDO |
|---|
| 10251 | ENDDO |
|---|
| 10252 | ELSE |
|---|
| 10253 | DO i = nxl, nxr |
|---|
| 10254 | DO j = nys, nyn |
|---|
| 10255 | DO k = nzb, nzt+1 |
|---|
| 10256 | local_pf(i,j,k) = MERGE( Nbins_av(k,j,i,2), & |
|---|
| 10257 | REAL( -999.0_wp, KIND = wp ), & |
|---|
| 10258 | BTEST( wall_flags_0(k,j,i), 0 ) ) |
|---|
| 10259 | ENDDO |
|---|
| 10260 | ENDDO |
|---|
| 10261 | ENDDO |
|---|
| 10262 | ENDIF |
|---|
| 10263 | |
|---|
| 10264 | CASE ( 'N_bin3' ) |
|---|
| 10265 | IF ( av == 0 ) THEN |
|---|
| 10266 | DO i = nxl, nxr |
|---|
| 10267 | DO j = nys, nyn |
|---|
| 10268 | DO k = nzb, nzt+1 |
|---|
| 10269 | local_pf(i,j,k) = MERGE( aerosol_number(3)%conc(k,j,i), & |
|---|
| 10270 | REAL( -999.0_wp, KIND = wp ), & |
|---|
| 10271 | BTEST( wall_flags_0(k,j,i), 0 ) ) |
|---|
| 10272 | ENDDO |
|---|
| 10273 | ENDDO |
|---|
| 10274 | ENDDO |
|---|
| 10275 | ELSE |
|---|
| 10276 | DO i = nxl, nxr |
|---|
| 10277 | DO j = nys, nyn |
|---|
| 10278 | DO k = nzb, nzt+1 |
|---|
| 10279 | local_pf(i,j,k) = MERGE( Nbins_av(k,j,i,3), & |
|---|
| 10280 | REAL( -999.0_wp, KIND = wp ), & |
|---|
| 10281 | BTEST( wall_flags_0(k,j,i), 0 ) ) |
|---|
| 10282 | ENDDO |
|---|
| 10283 | ENDDO |
|---|
| 10284 | ENDDO |
|---|
| 10285 | ENDIF |
|---|
| 10286 | |
|---|
| 10287 | CASE ( 'N_bin4' ) |
|---|
| 10288 | IF ( av == 0 ) THEN |
|---|
| 10289 | DO i = nxl, nxr |
|---|
| 10290 | DO j = nys, nyn |
|---|
| 10291 | DO k = nzb, nzt+1 |
|---|
| 10292 | local_pf(i,j,k) = MERGE( aerosol_number(4)%conc(k,j,i), & |
|---|
| 10293 | REAL( -999.0_wp, KIND = wp ), & |
|---|
| 10294 | BTEST( wall_flags_0(k,j,i), 0 ) ) |
|---|
| 10295 | ENDDO |
|---|
| 10296 | ENDDO |
|---|
| 10297 | ENDDO |
|---|
| 10298 | ELSE |
|---|
| 10299 | DO i = nxl, nxr |
|---|
| 10300 | DO j = nys, nyn |
|---|
| 10301 | DO k = nzb, nzt+1 |
|---|
| 10302 | local_pf(i,j,k) = MERGE( Nbins_av(k,j,i,4), & |
|---|
| 10303 | REAL( -999.0_wp, KIND = wp ), & |
|---|
| 10304 | BTEST( wall_flags_0(k,j,i), 0 ) ) |
|---|
| 10305 | ENDDO |
|---|
| 10306 | ENDDO |
|---|
| 10307 | ENDDO |
|---|
| 10308 | ENDIF |
|---|
| 10309 | |
|---|
| 10310 | CASE ( 'N_bin5' ) |
|---|
| 10311 | IF ( av == 0 ) THEN |
|---|
| 10312 | DO i = nxl, nxr |
|---|
| 10313 | DO j = nys, nyn |
|---|
| 10314 | DO k = nzb, nzt+1 |
|---|
| 10315 | local_pf(i,j,k) = MERGE( aerosol_number(5)%conc(k,j,i), & |
|---|
| 10316 | REAL( -999.0_wp, KIND = wp ), & |
|---|
| 10317 | BTEST( wall_flags_0(k,j,i), 0 ) ) |
|---|
| 10318 | ENDDO |
|---|
| 10319 | ENDDO |
|---|
| 10320 | ENDDO |
|---|
| 10321 | ELSE |
|---|
| 10322 | DO i = nxl, nxr |
|---|
| 10323 | DO j = nys, nyn |
|---|
| 10324 | DO k = nzb, nzt+1 |
|---|
| 10325 | local_pf(i,j,k) = MERGE( Nbins_av(k,j,i,5), & |
|---|
| 10326 | REAL( -999.0_wp, KIND = wp ), & |
|---|
| 10327 | BTEST( wall_flags_0(k,j,i), 0 ) ) |
|---|
| 10328 | ENDDO |
|---|
| 10329 | ENDDO |
|---|
| 10330 | ENDDO |
|---|
| 10331 | ENDIF |
|---|
| 10332 | |
|---|
| 10333 | CASE ( 'N_bin6' ) |
|---|
| 10334 | IF ( av == 0 ) THEN |
|---|
| 10335 | DO i = nxl, nxr |
|---|
| 10336 | DO j = nys, nyn |
|---|
| 10337 | DO k = nzb, nzt+1 |
|---|
| 10338 | local_pf(i,j,k) = MERGE( aerosol_number(6)%conc(k,j,i), & |
|---|
| 10339 | REAL( -999.0_wp, KIND = wp ), & |
|---|
| 10340 | BTEST( wall_flags_0(k,j,i), 0 ) ) |
|---|
| 10341 | ENDDO |
|---|
| 10342 | ENDDO |
|---|
| 10343 | ENDDO |
|---|
| 10344 | ELSE |
|---|
| 10345 | DO i = nxl, nxr |
|---|
| 10346 | DO j = nys, nyn |
|---|
| 10347 | DO k = nzb, nzt+1 |
|---|
| 10348 | local_pf(i,j,k) = MERGE( Nbins_av(k,j,i,6), & |
|---|
| 10349 | REAL( -999.0_wp, KIND = wp ), & |
|---|
| 10350 | BTEST( wall_flags_0(k,j,i), 0 ) ) |
|---|
| 10351 | ENDDO |
|---|
| 10352 | ENDDO |
|---|
| 10353 | ENDDO |
|---|
| 10354 | ENDIF |
|---|
| 10355 | |
|---|
| 10356 | CASE ( 'N_bin7' ) |
|---|
| 10357 | IF ( av == 0 ) THEN |
|---|
| 10358 | DO i = nxl, nxr |
|---|
| 10359 | DO j = nys, nyn |
|---|
| 10360 | DO k = nzb, nzt+1 |
|---|
| 10361 | local_pf(i,j,k) = MERGE( aerosol_number(7)%conc(k,j,i), & |
|---|
| 10362 | REAL( -999.0_wp, KIND = wp ), & |
|---|
| 10363 | BTEST( wall_flags_0(k,j,i), 0 ) ) |
|---|
| 10364 | ENDDO |
|---|
| 10365 | ENDDO |
|---|
| 10366 | ENDDO |
|---|
| 10367 | ELSE |
|---|
| 10368 | DO i = nxl, nxr |
|---|
| 10369 | DO j = nys, nyn |
|---|
| 10370 | DO k = nzb, nzt+1 |
|---|
| 10371 | local_pf(i,j,k) = MERGE( Nbins_av(k,j,i,7), & |
|---|
| 10372 | REAL( -999.0_wp, KIND = wp ), & |
|---|
| 10373 | BTEST( wall_flags_0(k,j,i), 0 ) ) |
|---|
| 10374 | ENDDO |
|---|
| 10375 | ENDDO |
|---|
| 10376 | ENDDO |
|---|
| 10377 | ENDIF |
|---|
| 10378 | |
|---|
| 10379 | CASE ( 'N_bin8' ) |
|---|
| 10380 | IF ( av == 0 ) THEN |
|---|
| 10381 | DO i = nxl, nxr |
|---|
| 10382 | DO j = nys, nyn |
|---|
| 10383 | DO k = nzb, nzt+1 |
|---|
| 10384 | local_pf(i,j,k) = MERGE( aerosol_number(8)%conc(k,j,i), & |
|---|
| 10385 | REAL( -999.0_wp, KIND = wp ), & |
|---|
| 10386 | BTEST( wall_flags_0(k,j,i), 0 ) ) |
|---|
| 10387 | ENDDO |
|---|
| 10388 | ENDDO |
|---|
| 10389 | ENDDO |
|---|
| 10390 | ELSE |
|---|
| 10391 | DO i = nxl, nxr |
|---|
| 10392 | DO j = nys, nyn |
|---|
| 10393 | DO k = nzb, nzt+1 |
|---|
| 10394 | local_pf(i,j,k) = MERGE( Nbins_av(k,j,i,8), & |
|---|
| 10395 | REAL( -999.0_wp, KIND = wp ), & |
|---|
| 10396 | BTEST( wall_flags_0(k,j,i), 0 ) ) |
|---|
| 10397 | ENDDO |
|---|
| 10398 | ENDDO |
|---|
| 10399 | ENDDO |
|---|
| 10400 | ENDIF |
|---|
| 10401 | |
|---|
| 10402 | CASE ( 'N_bin9' ) |
|---|
| 10403 | IF ( av == 0 ) THEN |
|---|
| 10404 | DO i = nxl, nxr |
|---|
| 10405 | DO j = nys, nyn |
|---|
| 10406 | DO k = nzb, nzt+1 |
|---|
| 10407 | local_pf(i,j,k) = MERGE( aerosol_number(9)%conc(k,j,i), & |
|---|
| 10408 | REAL( -999.0_wp, KIND = wp ), & |
|---|
| 10409 | BTEST( wall_flags_0(k,j,i), 0 ) ) |
|---|
| 10410 | ENDDO |
|---|
| 10411 | ENDDO |
|---|
| 10412 | ENDDO |
|---|
| 10413 | ELSE |
|---|
| 10414 | DO i = nxl, nxr |
|---|
| 10415 | DO j = nys, nyn |
|---|
| 10416 | DO k = nzb, nzt+1 |
|---|
| 10417 | local_pf(i,j,k) = MERGE( Nbins_av(k,j,i,9), & |
|---|
| 10418 | REAL( -999.0_wp, KIND = wp ), & |
|---|
| 10419 | BTEST( wall_flags_0(k,j,i), 0 ) ) |
|---|
| 10420 | ENDDO |
|---|
| 10421 | ENDDO |
|---|
| 10422 | ENDDO |
|---|
| 10423 | ENDIF |
|---|
| 10424 | |
|---|
| 10425 | CASE ( 'N_bin10' ) |
|---|
| 10426 | IF ( av == 0 ) THEN |
|---|
| 10427 | DO i = nxl, nxr |
|---|
| 10428 | DO j = nys, nyn |
|---|
| 10429 | DO k = nzb, nzt+1 |
|---|
| 10430 | local_pf(i,j,k) = MERGE( aerosol_number(10)%conc(k,j,i), & |
|---|
| 10431 | REAL( -999.0_wp, KIND = wp ), & |
|---|
| 10432 | BTEST( wall_flags_0(k,j,i), 0 ) ) |
|---|
| 10433 | ENDDO |
|---|
| 10434 | ENDDO |
|---|
| 10435 | ENDDO |
|---|
| 10436 | ELSE |
|---|
| 10437 | DO i = nxl, nxr |
|---|
| 10438 | DO j = nys, nyn |
|---|
| 10439 | DO k = nzb, nzt+1 |
|---|
| 10440 | local_pf(i,j,k) = MERGE( Nbins_av(k,j,i,10), & |
|---|
| 10441 | REAL( -999.0_wp, KIND = wp ), & |
|---|
| 10442 | BTEST( wall_flags_0(k,j,i), 0 ) ) |
|---|
| 10443 | ENDDO |
|---|
| 10444 | ENDDO |
|---|
| 10445 | ENDDO |
|---|
| 10446 | ENDIF |
|---|
| 10447 | |
|---|
| 10448 | CASE ( 'N_bin11' ) |
|---|
| 10449 | IF ( av == 0 ) THEN |
|---|
| 10450 | DO i = nxl, nxr |
|---|
| 10451 | DO j = nys, nyn |
|---|
| 10452 | DO k = nzb, nzt+1 |
|---|
| 10453 | local_pf(i,j,k) = MERGE( aerosol_number(11)%conc(k,j,i), & |
|---|
| 10454 | REAL( -999.0_wp, KIND = wp ), & |
|---|
| 10455 | BTEST( wall_flags_0(k,j,i), 0 ) ) |
|---|
| 10456 | ENDDO |
|---|
| 10457 | ENDDO |
|---|
| 10458 | ENDDO |
|---|
| 10459 | ELSE |
|---|
| 10460 | DO i = nxl, nxr |
|---|
| 10461 | DO j = nys, nyn |
|---|
| 10462 | DO k = nzb, nzt+1 |
|---|
| 10463 | local_pf(i,j,k) = MERGE( Nbins_av(k,j,i,11), & |
|---|
| 10464 | REAL( -999.0_wp, KIND = wp ), & |
|---|
| 10465 | BTEST( wall_flags_0(k,j,i), 0 ) ) |
|---|
| 10466 | ENDDO |
|---|
| 10467 | ENDDO |
|---|
| 10468 | ENDDO |
|---|
| 10469 | ENDIF |
|---|
| 10470 | |
|---|
| 10471 | CASE ( 'N_bin12' ) |
|---|
| 10472 | IF ( av == 0 ) THEN |
|---|
| 10473 | DO i = nxl, nxr |
|---|
| 10474 | DO j = nys, nyn |
|---|
| 10475 | DO k = nzb, nzt+1 |
|---|
| 10476 | local_pf(i,j,k) = MERGE( aerosol_number(12)%conc(k,j,i), & |
|---|
| 10477 | REAL( -999.0_wp, KIND = wp ), & |
|---|
| 10478 | BTEST( wall_flags_0(k,j,i), 0 ) ) |
|---|
| 10479 | ENDDO |
|---|
| 10480 | ENDDO |
|---|
| 10481 | ENDDO |
|---|
| 10482 | ELSE |
|---|
| 10483 | DO i = nxl, nxr |
|---|
| 10484 | DO j = nys, nyn |
|---|
| 10485 | DO k = nzb, nzt+1 |
|---|
| 10486 | local_pf(i,j,k) = MERGE( Nbins_av(k,j,i,12), & |
|---|
| 10487 | REAL( -999.0_wp, KIND = wp ), & |
|---|
| 10488 | BTEST( wall_flags_0(k,j,i), 0 ) ) |
|---|
| 10489 | ENDDO |
|---|
| 10490 | ENDDO |
|---|
| 10491 | ENDDO |
|---|
| 10492 | ENDIF |
|---|
| 10493 | |
|---|
| 10494 | CASE ( 'm_bin1' ) |
|---|
| 10495 | IF ( av == 0 ) THEN |
|---|
| 10496 | DO i = nxl, nxr |
|---|
| 10497 | DO j = nys, nyn |
|---|
| 10498 | DO k = nzb, nzt+1 |
|---|
| 10499 | temp_bin = 0.0_wp |
|---|
| 10500 | DO c = 1, ncc_tot*nbins, nbins |
|---|
| 10501 | temp_bin = temp_bin + aerosol_mass(c)%conc(k,j,i) |
|---|
| 10502 | ENDDO |
|---|
| 10503 | local_pf(i,j,k) = MERGE( temp_bin, & |
|---|
| 10504 | REAL( -999.0_wp, KIND = wp ), & |
|---|
| 10505 | BTEST( wall_flags_0(k,j,i), 0 ) ) |
|---|
| 10506 | ENDDO |
|---|
| 10507 | ENDDO |
|---|
| 10508 | ENDDO |
|---|
| 10509 | ELSE |
|---|
| 10510 | DO i = nxl, nxr |
|---|
| 10511 | DO j = nys, nyn |
|---|
| 10512 | DO k = nzb, nzt+1 |
|---|
| 10513 | local_pf(i,j,k) = MERGE( mbins_av(k,j,i,1), & |
|---|
| 10514 | REAL( -999.0_wp, KIND = wp ), & |
|---|
| 10515 | BTEST( wall_flags_0(k,j,i), 0 ) ) |
|---|
| 10516 | ENDDO |
|---|
| 10517 | ENDDO |
|---|
| 10518 | ENDDO |
|---|
| 10519 | ENDIF |
|---|
| 10520 | |
|---|
| 10521 | CASE ( 'm_bin2' ) |
|---|
| 10522 | IF ( av == 0 ) THEN |
|---|
| 10523 | DO i = nxl, nxr |
|---|
| 10524 | DO j = nys, nyn |
|---|
| 10525 | DO k = nzb, nzt+1 |
|---|
| 10526 | temp_bin = 0.0_wp |
|---|
| 10527 | DO c = 2, ncc_tot*nbins, nbins |
|---|
| 10528 | temp_bin = temp_bin + aerosol_mass(c)%conc(k,j,i) |
|---|
| 10529 | ENDDO |
|---|
| 10530 | local_pf(i,j,k) = MERGE( temp_bin, & |
|---|
| 10531 | REAL( -999.0_wp, KIND = wp ), & |
|---|
| 10532 | BTEST( wall_flags_0(k,j,i), 0 ) ) |
|---|
| 10533 | ENDDO |
|---|
| 10534 | ENDDO |
|---|
| 10535 | ENDDO |
|---|
| 10536 | ELSE |
|---|
| 10537 | DO i = nxl, nxr |
|---|
| 10538 | DO j = nys, nyn |
|---|
| 10539 | DO k = nzb, nzt+1 |
|---|
| 10540 | local_pf(i,j,k) = MERGE( mbins_av(k,j,i,2), & |
|---|
| 10541 | REAL( -999.0_wp, KIND = wp ), & |
|---|
| 10542 | BTEST( wall_flags_0(k,j,i), 0 ) ) |
|---|
| 10543 | ENDDO |
|---|
| 10544 | ENDDO |
|---|
| 10545 | ENDDO |
|---|
| 10546 | ENDIF |
|---|
| 10547 | |
|---|
| 10548 | CASE ( 'm_bin3' ) |
|---|
| 10549 | IF ( av == 0 ) THEN |
|---|
| 10550 | DO i = nxl, nxr |
|---|
| 10551 | DO j = nys, nyn |
|---|
| 10552 | DO k = nzb, nzt+1 |
|---|
| 10553 | temp_bin = 0.0_wp |
|---|
| 10554 | DO c = 3, ncc_tot*nbins, nbins |
|---|
| 10555 | temp_bin = temp_bin + aerosol_mass(c)%conc(k,j,i) |
|---|
| 10556 | ENDDO |
|---|
| 10557 | local_pf(i,j,k) = MERGE( temp_bin, & |
|---|
| 10558 | REAL( -999.0_wp, KIND = wp ), & |
|---|
| 10559 | BTEST( wall_flags_0(k,j,i), 0 ) ) |
|---|
| 10560 | ENDDO |
|---|
| 10561 | ENDDO |
|---|
| 10562 | ENDDO |
|---|
| 10563 | ELSE |
|---|
| 10564 | DO i = nxl, nxr |
|---|
| 10565 | DO j = nys, nyn |
|---|
| 10566 | DO k = nzb, nzt+1 |
|---|
| 10567 | local_pf(i,j,k) = MERGE( mbins_av(k,j,i,3), & |
|---|
| 10568 | REAL( -999.0_wp, KIND = wp ), & |
|---|
| 10569 | BTEST( wall_flags_0(k,j,i), 0 ) ) |
|---|
| 10570 | ENDDO |
|---|
| 10571 | ENDDO |
|---|
| 10572 | ENDDO |
|---|
| 10573 | ENDIF |
|---|
| 10574 | |
|---|
| 10575 | CASE ( 'm_bin4' ) |
|---|
| 10576 | IF ( av == 0 ) THEN |
|---|
| 10577 | DO i = nxl, nxr |
|---|
| 10578 | DO j = nys, nyn |
|---|
| 10579 | DO k = nzb, nzt+1 |
|---|
| 10580 | temp_bin = 0.0_wp |
|---|
| 10581 | DO c = 4, ncc_tot*nbins, nbins |
|---|
| 10582 | temp_bin = temp_bin + aerosol_mass(c)%conc(k,j,i) |
|---|
| 10583 | ENDDO |
|---|
| 10584 | local_pf(i,j,k) = MERGE( temp_bin, & |
|---|
| 10585 | REAL( -999.0_wp, KIND = wp ), & |
|---|
| 10586 | BTEST( wall_flags_0(k,j,i), 0 ) ) |
|---|
| 10587 | ENDDO |
|---|
| 10588 | ENDDO |
|---|
| 10589 | ENDDO |
|---|
| 10590 | ELSE |
|---|
| 10591 | DO i = nxl, nxr |
|---|
| 10592 | DO j = nys, nyn |
|---|
| 10593 | DO k = nzb, nzt+1 |
|---|
| 10594 | local_pf(i,j,k) = MERGE( mbins_av(k,j,i,4), & |
|---|
| 10595 | REAL( -999.0_wp, KIND = wp ), & |
|---|
| 10596 | BTEST( wall_flags_0(k,j,i), 0 ) ) |
|---|
| 10597 | ENDDO |
|---|
| 10598 | ENDDO |
|---|
| 10599 | ENDDO |
|---|
| 10600 | ENDIF |
|---|
| 10601 | |
|---|
| 10602 | CASE ( 'm_bin5' ) |
|---|
| 10603 | IF ( av == 0 ) THEN |
|---|
| 10604 | DO i = nxl, nxr |
|---|
| 10605 | DO j = nys, nyn |
|---|
| 10606 | DO k = nzb, nzt+1 |
|---|
| 10607 | temp_bin = 0.0_wp |
|---|
| 10608 | DO c = 5, ncc_tot*nbins, nbins |
|---|
| 10609 | temp_bin = temp_bin + aerosol_mass(c)%conc(k,j,i) |
|---|
| 10610 | ENDDO |
|---|
| 10611 | local_pf(i,j,k) = MERGE( temp_bin, & |
|---|
| 10612 | REAL( -999.0_wp, KIND = wp ), & |
|---|
| 10613 | BTEST( wall_flags_0(k,j,i), 0 ) ) |
|---|
| 10614 | ENDDO |
|---|
| 10615 | ENDDO |
|---|
| 10616 | ENDDO |
|---|
| 10617 | ELSE |
|---|
| 10618 | DO i = nxl, nxr |
|---|
| 10619 | DO j = nys, nyn |
|---|
| 10620 | DO k = nzb, nzt+1 |
|---|
| 10621 | local_pf(i,j,k) = MERGE( mbins_av(k,j,i,5), & |
|---|
| 10622 | REAL( -999.0_wp, KIND = wp ), & |
|---|
| 10623 | BTEST( wall_flags_0(k,j,i), 0 ) ) |
|---|
| 10624 | ENDDO |
|---|
| 10625 | ENDDO |
|---|
| 10626 | ENDDO |
|---|
| 10627 | ENDIF |
|---|
| 10628 | |
|---|
| 10629 | CASE ( 'm_bin6' ) |
|---|
| 10630 | IF ( av == 0 ) THEN |
|---|
| 10631 | DO i = nxl, nxr |
|---|
| 10632 | DO j = nys, nyn |
|---|
| 10633 | DO k = nzb, nzt+1 |
|---|
| 10634 | temp_bin = 0.0_wp |
|---|
| 10635 | DO c = 6, ncc_tot*nbins, nbins |
|---|
| 10636 | temp_bin = temp_bin + aerosol_mass(c)%conc(k,j,i) |
|---|
| 10637 | ENDDO |
|---|
| 10638 | local_pf(i,j,k) = MERGE( temp_bin, & |
|---|
| 10639 | REAL( -999.0_wp, KIND = wp ), & |
|---|
| 10640 | BTEST( wall_flags_0(k,j,i), 0 ) ) |
|---|
| 10641 | ENDDO |
|---|
| 10642 | ENDDO |
|---|
| 10643 | ENDDO |
|---|
| 10644 | ELSE |
|---|
| 10645 | DO i = nxl, nxr |
|---|
| 10646 | DO j = nys, nyn |
|---|
| 10647 | DO k = nzb, nzt+1 |
|---|
| 10648 | local_pf(i,j,k) = MERGE( mbins_av(k,j,i,6), & |
|---|
| 10649 | REAL( -999.0_wp, KIND = wp ), & |
|---|
| 10650 | BTEST( wall_flags_0(k,j,i), 0 ) ) |
|---|
| 10651 | ENDDO |
|---|
| 10652 | ENDDO |
|---|
| 10653 | ENDDO |
|---|
| 10654 | ENDIF |
|---|
| 10655 | |
|---|
| 10656 | CASE ( 'm_bin7' ) |
|---|
| 10657 | IF ( av == 0 ) THEN |
|---|
| 10658 | DO i = nxl, nxr |
|---|
| 10659 | DO j = nys, nyn |
|---|
| 10660 | DO k = nzb, nzt+1 |
|---|
| 10661 | temp_bin = 0.0_wp |
|---|
| 10662 | DO c = 7, ncc_tot*nbins, nbins |
|---|
| 10663 | temp_bin = temp_bin + aerosol_mass(c)%conc(k,j,i) |
|---|
| 10664 | ENDDO |
|---|
| 10665 | local_pf(i,j,k) = MERGE( temp_bin, & |
|---|
| 10666 | REAL( -999.0_wp, KIND = wp ), & |
|---|
| 10667 | BTEST( wall_flags_0(k,j,i), 0 ) ) |
|---|
| 10668 | ENDDO |
|---|
| 10669 | ENDDO |
|---|
| 10670 | ENDDO |
|---|
| 10671 | ELSE |
|---|
| 10672 | DO i = nxl, nxr |
|---|
| 10673 | DO j = nys, nyn |
|---|
| 10674 | DO k = nzb, nzt+1 |
|---|
| 10675 | local_pf(i,j,k) = MERGE( mbins_av(k,j,i,7), & |
|---|
| 10676 | REAL( -999.0_wp, KIND = wp ), & |
|---|
| 10677 | BTEST( wall_flags_0(k,j,i), 0 ) ) |
|---|
| 10678 | ENDDO |
|---|
| 10679 | ENDDO |
|---|
| 10680 | ENDDO |
|---|
| 10681 | ENDIF |
|---|
| 10682 | |
|---|
| 10683 | CASE ( 'm_bin8' ) |
|---|
| 10684 | IF ( av == 0 ) THEN |
|---|
| 10685 | DO i = nxl, nxr |
|---|
| 10686 | DO j = nys, nyn |
|---|
| 10687 | DO k = nzb, nzt+1 |
|---|
| 10688 | temp_bin = 0.0_wp |
|---|
| 10689 | DO c = 8, ncc_tot*nbins, nbins |
|---|
| 10690 | temp_bin = temp_bin + aerosol_mass(c)%conc(k,j,i) |
|---|
| 10691 | ENDDO |
|---|
| 10692 | local_pf(i,j,k) = MERGE( temp_bin, & |
|---|
| 10693 | REAL( -999.0_wp, KIND = wp ), & |
|---|
| 10694 | BTEST( wall_flags_0(k,j,i), 0 ) ) |
|---|
| 10695 | ENDDO |
|---|
| 10696 | ENDDO |
|---|
| 10697 | ENDDO |
|---|
| 10698 | ELSE |
|---|
| 10699 | DO i = nxl, nxr |
|---|
| 10700 | DO j = nys, nyn |
|---|
| 10701 | DO k = nzb, nzt+1 |
|---|
| 10702 | local_pf(i,j,k) = MERGE( mbins_av(k,j,i,8), & |
|---|
| 10703 | REAL( -999.0_wp, KIND = wp ), & |
|---|
| 10704 | BTEST( wall_flags_0(k,j,i), 0 ) ) |
|---|
| 10705 | ENDDO |
|---|
| 10706 | ENDDO |
|---|
| 10707 | ENDDO |
|---|
| 10708 | ENDIF |
|---|
| 10709 | |
|---|
| 10710 | CASE ( 'm_bin9' ) |
|---|
| 10711 | IF ( av == 0 ) THEN |
|---|
| 10712 | DO i = nxl, nxr |
|---|
| 10713 | DO j = nys, nyn |
|---|
| 10714 | DO k = nzb, nzt+1 |
|---|
| 10715 | temp_bin = 0.0_wp |
|---|
| 10716 | DO c = 9, ncc_tot*nbins, nbins |
|---|
| 10717 | temp_bin = temp_bin + aerosol_mass(c)%conc(k,j,i) |
|---|
| 10718 | ENDDO |
|---|
| 10719 | local_pf(i,j,k) = MERGE( temp_bin, & |
|---|
| 10720 | REAL( -999.0_wp, KIND = wp ), & |
|---|
| 10721 | BTEST( wall_flags_0(k,j,i), 0 ) ) |
|---|
| 10722 | ENDDO |
|---|
| 10723 | ENDDO |
|---|
| 10724 | ENDDO |
|---|
| 10725 | ELSE |
|---|
| 10726 | DO i = nxl, nxr |
|---|
| 10727 | DO j = nys, nyn |
|---|
| 10728 | DO k = nzb, nzt+1 |
|---|
| 10729 | local_pf(i,j,k) = MERGE( mbins_av(k,j,i,9), & |
|---|
| 10730 | REAL( -999.0_wp, KIND = wp ), & |
|---|
| 10731 | BTEST( wall_flags_0(k,j,i), 0 ) ) |
|---|
| 10732 | ENDDO |
|---|
| 10733 | ENDDO |
|---|
| 10734 | ENDDO |
|---|
| 10735 | ENDIF |
|---|
| 10736 | |
|---|
| 10737 | CASE ( 'm_bin10' ) |
|---|
| 10738 | IF ( av == 0 ) THEN |
|---|
| 10739 | DO i = nxl, nxr |
|---|
| 10740 | DO j = nys, nyn |
|---|
| 10741 | DO k = nzb, nzt+1 |
|---|
| 10742 | temp_bin = 0.0_wp |
|---|
| 10743 | DO c = 10, ncc_tot*nbins, nbins |
|---|
| 10744 | temp_bin = temp_bin + aerosol_mass(c)%conc(k,j,i) |
|---|
| 10745 | ENDDO |
|---|
| 10746 | local_pf(i,j,k) = MERGE( temp_bin, & |
|---|
| 10747 | REAL( -999.0_wp, KIND = wp ), & |
|---|
| 10748 | BTEST( wall_flags_0(k,j,i), 0 ) ) |
|---|
| 10749 | ENDDO |
|---|
| 10750 | ENDDO |
|---|
| 10751 | ENDDO |
|---|
| 10752 | ELSE |
|---|
| 10753 | DO i = nxl, nxr |
|---|
| 10754 | DO j = nys, nyn |
|---|
| 10755 | DO k = nzb, nzt+1 |
|---|
| 10756 | local_pf(i,j,k) = MERGE( mbins_av(k,j,i,10), & |
|---|
| 10757 | REAL( -999.0_wp, KIND = wp ), & |
|---|
| 10758 | BTEST( wall_flags_0(k,j,i), 0 ) ) |
|---|
| 10759 | ENDDO |
|---|
| 10760 | ENDDO |
|---|
| 10761 | ENDDO |
|---|
| 10762 | ENDIF |
|---|
| 10763 | |
|---|
| 10764 | CASE ( 'm_bin11' ) |
|---|
| 10765 | IF ( av == 0 ) THEN |
|---|
| 10766 | DO i = nxl, nxr |
|---|
| 10767 | DO j = nys, nyn |
|---|
| 10768 | DO k = nzb, nzt+1 |
|---|
| 10769 | temp_bin = 0.0_wp |
|---|
| 10770 | DO c = 11, ncc_tot*nbins, nbins |
|---|
| 10771 | temp_bin = temp_bin + aerosol_mass(c)%conc(k,j,i) |
|---|
| 10772 | ENDDO |
|---|
| 10773 | local_pf(i,j,k) = MERGE( temp_bin, & |
|---|
| 10774 | REAL( -999.0_wp, KIND = wp ), & |
|---|
| 10775 | BTEST( wall_flags_0(k,j,i), 0 ) ) |
|---|
| 10776 | ENDDO |
|---|
| 10777 | ENDDO |
|---|
| 10778 | ENDDO |
|---|
| 10779 | ELSE |
|---|
| 10780 | DO i = nxl, nxr |
|---|
| 10781 | DO j = nys, nyn |
|---|
| 10782 | DO k = nzb, nzt+1 |
|---|
| 10783 | local_pf(i,j,k) = MERGE( mbins_av(k,j,i,11), & |
|---|
| 10784 | REAL( -999.0_wp, KIND = wp ), & |
|---|
| 10785 | BTEST( wall_flags_0(k,j,i), 0 ) ) |
|---|
| 10786 | ENDDO |
|---|
| 10787 | ENDDO |
|---|
| 10788 | ENDDO |
|---|
| 10789 | ENDIF |
|---|
| 10790 | |
|---|
| 10791 | CASE ( 'm_bin12' ) |
|---|
| 10792 | IF ( av == 0 ) THEN |
|---|
| 10793 | DO i = nxl, nxr |
|---|
| 10794 | DO j = nys, nyn |
|---|
| 10795 | DO k = nzb, nzt+1 |
|---|
| 10796 | temp_bin = 0.0_wp |
|---|
| 10797 | DO c = 12, ncc_tot*nbins, nbins |
|---|
| 10798 | temp_bin = temp_bin + aerosol_mass(c)%conc(k,j,i) |
|---|
| 10799 | ENDDO |
|---|
| 10800 | local_pf(i,j,k) = MERGE( temp_bin, & |
|---|
| 10801 | REAL( -999.0_wp, KIND = wp ), & |
|---|
| 10802 | BTEST( wall_flags_0(k,j,i), 0 ) ) |
|---|
| 10803 | ENDDO |
|---|
| 10804 | ENDDO |
|---|
| 10805 | ENDDO |
|---|
| 10806 | ELSE |
|---|
| 10807 | DO i = nxl, nxr |
|---|
| 10808 | DO j = nys, nyn |
|---|
| 10809 | DO k = nzb, nzt+1 |
|---|
| 10810 | local_pf(i,j,k) = MERGE( mbins_av(k,j,i,12), & |
|---|
| 10811 | REAL( -999.0_wp, KIND = wp ), & |
|---|
| 10812 | BTEST( wall_flags_0(k,j,i), 0 ) ) |
|---|
| 10813 | ENDDO |
|---|
| 10814 | ENDDO |
|---|
| 10815 | ENDDO |
|---|
| 10816 | ENDIF |
|---|
| 10817 | |
|---|
| 10818 | CASE ( 's_BC', 's_DU', 's_H2O', 's_NH', 's_NO', 's_OC', 's_SO4', 's_SS' ) |
|---|
| 10819 | IF ( is_used( prtcl, TRIM( variable(3:) ) ) ) THEN |
|---|
| 10820 | icc = get_index( prtcl, TRIM( variable(3:) ) ) |
|---|
| 10821 | IF ( av == 0 ) THEN |
|---|
| 10822 | DO i = nxl, nxr |
|---|
| 10823 | DO j = nys, nyn |
|---|
| 10824 | DO k = nzb, nzt+1 |
|---|
| 10825 | temp_bin = 0.0_wp |
|---|
| 10826 | DO c = ( icc-1 )*nbins+1, icc*nbins |
|---|
| 10827 | temp_bin = temp_bin + aerosol_mass(c)%conc(k,j,i) |
|---|
| 10828 | ENDDO |
|---|
| 10829 | local_pf(i,j,k) = MERGE( temp_bin, & |
|---|
| 10830 | REAL( -999.0_wp, KIND = wp ), & |
|---|
| 10831 | BTEST( wall_flags_0(k,j,i), 0 ) ) |
|---|
| 10832 | ENDDO |
|---|
| 10833 | ENDDO |
|---|
| 10834 | ENDDO |
|---|
| 10835 | ELSE |
|---|
| 10836 | IF ( TRIM( variable(3:) ) == 'BC' ) to_be_resorted => s_BC_av |
|---|
| 10837 | IF ( TRIM( variable(3:) ) == 'DU' ) to_be_resorted => s_DU_av |
|---|
| 10838 | IF ( TRIM( variable(3:) ) == 'NH' ) to_be_resorted => s_NH_av |
|---|
| 10839 | IF ( TRIM( variable(3:) ) == 'NO' ) to_be_resorted => s_NO_av |
|---|
| 10840 | IF ( TRIM( variable(3:) ) == 'OC' ) to_be_resorted => s_OC_av |
|---|
| 10841 | IF ( TRIM( variable(3:) ) == 'SO4' ) to_be_resorted => s_SO4_av |
|---|
| 10842 | IF ( TRIM( variable(3:) ) == 'SS' ) to_be_resorted => s_SS_av |
|---|
| 10843 | DO i = nxl, nxr |
|---|
| 10844 | DO j = nys, nyn |
|---|
| 10845 | DO k = nzb, nzt+1 |
|---|
| 10846 | local_pf(i,j,k) = MERGE( to_be_resorted(k,j,i), & |
|---|
| 10847 | REAL( -999.0_wp, KIND = wp ), & |
|---|
| 10848 | BTEST( wall_flags_0(k,j,i), 0 ) ) |
|---|
| 10849 | ENDDO |
|---|
| 10850 | ENDDO |
|---|
| 10851 | ENDDO |
|---|
| 10852 | ENDIF |
|---|
| 10853 | ENDIF |
|---|
| 10854 | CASE DEFAULT |
|---|
| 10855 | found = .FALSE. |
|---|
| 10856 | |
|---|
| 10857 | END SELECT |
|---|
| 10858 | |
|---|
| 10859 | END SUBROUTINE salsa_data_output_3d |
|---|
| 10860 | |
|---|
| 10861 | !------------------------------------------------------------------------------! |
|---|
| 10862 | ! |
|---|
| 10863 | ! Description: |
|---|
| 10864 | ! ------------ |
|---|
| 10865 | !> Subroutine defining mask output variables |
|---|
| 10866 | !------------------------------------------------------------------------------! |
|---|
| 10867 | SUBROUTINE salsa_data_output_mask( av, variable, found, local_pf ) |
|---|
| 10868 | |
|---|
| 10869 | USE control_parameters, & |
|---|
| 10870 | ONLY: mask_size_l, mid |
|---|
| 10871 | |
|---|
| 10872 | IMPLICIT NONE |
|---|
| 10873 | |
|---|
| 10874 | CHARACTER (LEN=*) :: variable !< |
|---|
| 10875 | |
|---|
| 10876 | INTEGER(iwp) :: av !< |
|---|
| 10877 | INTEGER(iwp) :: c !< |
|---|
| 10878 | INTEGER(iwp) :: i !< |
|---|
| 10879 | INTEGER(iwp) :: icc !< index of a chemical compound |
|---|
| 10880 | INTEGER(iwp) :: j !< |
|---|
| 10881 | INTEGER(iwp) :: k !< |
|---|
| 10882 | INTEGER(iwp) :: n !< |
|---|
| 10883 | |
|---|
| 10884 | LOGICAL :: found !< |
|---|
| 10885 | REAL(wp) :: df !< For calculating LDSA: fraction of particles |
|---|
| 10886 | !< depositing in the alveolar (or tracheobronchial) |
|---|
| 10887 | !< region of the lung. Depends on the particle size |
|---|
| 10888 | REAL(wp) :: mean_d !< Particle diameter in micrometres |
|---|
| 10889 | REAL(wp) :: nc !< Particle number concentration in units 1/cm**3 |
|---|
| 10890 | |
|---|
| 10891 | REAL(wp), & |
|---|
| 10892 | DIMENSION(mask_size_l(mid,1),mask_size_l(mid,2),mask_size_l(mid,3)) :: & |
|---|
| 10893 | local_pf !< |
|---|
| 10894 | REAL(wp) :: temp_bin !< |
|---|
| 10895 | REAL(wp), DIMENSION(:,:,:), POINTER :: to_be_resorted !< points to |
|---|
| 10896 | !< selected output variable |
|---|
| 10897 | |
|---|
| 10898 | found = .TRUE. |
|---|
| 10899 | temp_bin = 0.0_wp |
|---|
| 10900 | |
|---|
| 10901 | SELECT CASE ( TRIM( variable ) ) |
|---|
| 10902 | |
|---|
| 10903 | CASE ( 'g_H2SO4', 'g_HNO3', 'g_NH3', 'g_OCNV', 'g_OCSV' ) |
|---|
| 10904 | IF ( av == 0 ) THEN |
|---|
| 10905 | IF ( TRIM( variable ) == 'g_H2SO4') icc = 1 |
|---|
| 10906 | IF ( TRIM( variable ) == 'g_HNO3') icc = 2 |
|---|
| 10907 | IF ( TRIM( variable ) == 'g_NH3') icc = 3 |
|---|
| 10908 | IF ( TRIM( variable ) == 'g_OCNV') icc = 4 |
|---|
| 10909 | IF ( TRIM( variable ) == 'g_OCSV') icc = 5 |
|---|
| 10910 | |
|---|
| 10911 | DO i = 1, mask_size_l(mid,1) |
|---|
| 10912 | DO j = 1, mask_size_l(mid,2) |
|---|
| 10913 | DO k = 1, mask_size_l(mid,3) |
|---|
| 10914 | local_pf(i,j,k) = salsa_gas(icc)%conc(mask_k(mid,k), & |
|---|
| 10915 | mask_j(mid,j),mask_i(mid,i)) |
|---|
| 10916 | ENDDO |
|---|
| 10917 | ENDDO |
|---|
| 10918 | ENDDO |
|---|
| 10919 | ELSE |
|---|
| 10920 | IF ( TRIM( variable(3:) ) == 'H2SO4' ) to_be_resorted => g_H2SO4_av |
|---|
| 10921 | IF ( TRIM( variable(3:) ) == 'HNO3' ) to_be_resorted => g_HNO3_av |
|---|
| 10922 | IF ( TRIM( variable(3:) ) == 'NH3' ) to_be_resorted => g_NH3_av |
|---|
| 10923 | IF ( TRIM( variable(3:) ) == 'OCNV' ) to_be_resorted => g_OCNV_av |
|---|
| 10924 | IF ( TRIM( variable(3:) ) == 'OCSV' ) to_be_resorted => g_OCSV_av |
|---|
| 10925 | DO i = 1, mask_size_l(mid,1) |
|---|
| 10926 | DO j = 1, mask_size_l(mid,2) |
|---|
| 10927 | DO k = 1, mask_size_l(mid,3) |
|---|
| 10928 | local_pf(i,j,k) = to_be_resorted(mask_k(mid,k), & |
|---|
| 10929 | mask_j(mid,j),mask_i(mid,i)) |
|---|
| 10930 | ENDDO |
|---|
| 10931 | ENDDO |
|---|
| 10932 | ENDDO |
|---|
| 10933 | ENDIF |
|---|
| 10934 | |
|---|
| 10935 | CASE ( 'LDSA' ) |
|---|
| 10936 | IF ( av == 0 ) THEN |
|---|
| 10937 | DO i = 1, mask_size_l(mid,1) |
|---|
| 10938 | DO j = 1, mask_size_l(mid,2) |
|---|
| 10939 | DO k = 1, mask_size_l(mid,3) |
|---|
| 10940 | temp_bin = 0.0_wp |
|---|
| 10941 | DO n = 1, nbins |
|---|
| 10942 | ! |
|---|
| 10943 | !-- Diameter in micrometres |
|---|
| 10944 | mean_d = 1.0E+6_wp * Ra_dry(mask_k(mid,k), & |
|---|
| 10945 | mask_j(mid,j),mask_i(mid,i),n) * 2.0_wp |
|---|
| 10946 | ! |
|---|
| 10947 | !-- Deposition factor: alveolar (use Ra_dry for the size??) |
|---|
| 10948 | df = ( 0.01555_wp / mean_d ) * ( EXP( -0.416_wp * & |
|---|
| 10949 | ( LOG( mean_d ) + 2.84_wp )**2.0_wp ) & |
|---|
| 10950 | + 19.11_wp * EXP( -0.482_wp * & |
|---|
| 10951 | ( LOG( mean_d ) - 1.362_wp )**2.0_wp ) ) |
|---|
| 10952 | ! |
|---|
| 10953 | !-- Number concentration in 1/cm3 |
|---|
| 10954 | nc = 1.0E-6_wp * aerosol_number(n)%conc(mask_k(mid,k),& |
|---|
| 10955 | mask_j(mid,j),mask_i(mid,i)) |
|---|
| 10956 | ! |
|---|
| 10957 | !-- Lung-deposited surface area LDSA (units mum2/cm3) |
|---|
| 10958 | temp_bin = temp_bin + pi * mean_d**2.0_wp * df * nc |
|---|
| 10959 | ENDDO |
|---|
| 10960 | local_pf(i,j,k) = temp_bin |
|---|
| 10961 | ENDDO |
|---|
| 10962 | ENDDO |
|---|
| 10963 | ENDDO |
|---|
| 10964 | ELSE |
|---|
| 10965 | DO i = 1, mask_size_l(mid,1) |
|---|
| 10966 | DO j = 1, mask_size_l(mid,2) |
|---|
| 10967 | DO k = 1, mask_size_l(mid,3) |
|---|
| 10968 | local_pf(i,j,k) = LDSA_av(mask_k(mid,k), & |
|---|
| 10969 | mask_j(mid,j),mask_i(mid,i)) |
|---|
| 10970 | ENDDO |
|---|
| 10971 | ENDDO |
|---|
| 10972 | ENDDO |
|---|
| 10973 | ENDIF |
|---|
| 10974 | |
|---|
| 10975 | CASE ( 'Ntot' ) |
|---|
| 10976 | IF ( av == 0 ) THEN |
|---|
| 10977 | DO i = 1, mask_size_l(mid,1) |
|---|
| 10978 | DO j = 1, mask_size_l(mid,2) |
|---|
| 10979 | DO k = 1, mask_size_l(mid,3) |
|---|
| 10980 | temp_bin = 0.0_wp |
|---|
| 10981 | DO n = 1, nbins |
|---|
| 10982 | temp_bin = temp_bin + aerosol_number(n)%conc( & |
|---|
| 10983 | mask_k(mid,k),mask_j(mid,j),mask_i(mid,i)) |
|---|
| 10984 | ENDDO |
|---|
| 10985 | local_pf(i,j,k) = temp_bin |
|---|
| 10986 | ENDDO |
|---|
| 10987 | ENDDO |
|---|
| 10988 | ENDDO |
|---|
| 10989 | ELSE |
|---|
| 10990 | DO i = 1, mask_size_l(mid,1) |
|---|
| 10991 | DO j = 1, mask_size_l(mid,2) |
|---|
| 10992 | DO k = 1, mask_size_l(mid,3) |
|---|
| 10993 | local_pf(i,j,k) = Ntot_av(mask_k(mid,k), & |
|---|
| 10994 | mask_j(mid,j),mask_i(mid,i)) |
|---|
| 10995 | ENDDO |
|---|
| 10996 | ENDDO |
|---|
| 10997 | ENDDO |
|---|
| 10998 | ENDIF |
|---|
| 10999 | |
|---|
| 11000 | CASE ( 'PM2.5' ) |
|---|
| 11001 | IF ( av == 0 ) THEN |
|---|
| 11002 | DO i = 1, mask_size_l(mid,1) |
|---|
| 11003 | DO j = 1, mask_size_l(mid,2) |
|---|
| 11004 | DO k = 1, mask_size_l(mid,3) |
|---|
| 11005 | temp_bin = 0.0_wp |
|---|
| 11006 | DO n = 1, nbins |
|---|
| 11007 | IF ( 2.0_wp * Ra_dry(mask_k(mid,k),mask_j(mid,j), & |
|---|
| 11008 | mask_i(mid,i),n) <= 2.5E-6_wp ) THEN |
|---|
| 11009 | DO c = n, nbins*ncc, nbins |
|---|
| 11010 | temp_bin = temp_bin + aerosol_mass(c)%conc( & |
|---|
| 11011 | mask_k(mid,k), mask_j(mid,j),mask_i(mid,i)) |
|---|
| 11012 | ENDDO |
|---|
| 11013 | ENDIF |
|---|
| 11014 | ENDDO |
|---|
| 11015 | local_pf(i,j,k) = temp_bin |
|---|
| 11016 | ENDDO |
|---|
| 11017 | ENDDO |
|---|
| 11018 | ENDDO |
|---|
| 11019 | ELSE |
|---|
| 11020 | DO i = 1, mask_size_l(mid,1) |
|---|
| 11021 | DO j = 1, mask_size_l(mid,2) |
|---|
| 11022 | DO k = 1, mask_size_l(mid,3) |
|---|
| 11023 | local_pf(i,j,k) = PM25_av(mask_k(mid,k), & |
|---|
| 11024 | mask_j(mid,j),mask_i(mid,i)) |
|---|
| 11025 | ENDDO |
|---|
| 11026 | ENDDO |
|---|
| 11027 | ENDDO |
|---|
| 11028 | ENDIF |
|---|
| 11029 | |
|---|
| 11030 | CASE ( 'PM10' ) |
|---|
| 11031 | IF ( av == 0 ) THEN |
|---|
| 11032 | DO i = 1, mask_size_l(mid,1) |
|---|
| 11033 | DO j = 1, mask_size_l(mid,2) |
|---|
| 11034 | DO k = 1, mask_size_l(mid,3) |
|---|
| 11035 | temp_bin = 0.0_wp |
|---|
| 11036 | DO n = 1, nbins |
|---|
| 11037 | IF ( 2.0_wp * Ra_dry(mask_k(mid,k),mask_j(mid,j), & |
|---|
| 11038 | mask_i(mid,i),n) <= 10.0E-6_wp ) THEN |
|---|
| 11039 | DO c = n, nbins*ncc, nbins |
|---|
| 11040 | temp_bin = temp_bin + aerosol_mass(c)%conc( & |
|---|
| 11041 | mask_k(mid,k),mask_j(mid,j),mask_i(mid,i)) |
|---|
| 11042 | ENDDO |
|---|
| 11043 | ENDIF |
|---|
| 11044 | ENDDO |
|---|
| 11045 | local_pf(i,j,k) = temp_bin |
|---|
| 11046 | ENDDO |
|---|
| 11047 | ENDDO |
|---|
| 11048 | ENDDO |
|---|
| 11049 | ELSE |
|---|
| 11050 | DO i = 1, mask_size_l(mid,1) |
|---|
| 11051 | DO j = 1, mask_size_l(mid,2) |
|---|
| 11052 | DO k = 1, mask_size_l(mid,3) |
|---|
| 11053 | local_pf(i,j,k) = PM10_av(mask_k(mid,k), & |
|---|
| 11054 | mask_j(mid,j),mask_i(mid,i)) |
|---|
| 11055 | ENDDO |
|---|
| 11056 | ENDDO |
|---|
| 11057 | ENDDO |
|---|
| 11058 | ENDIF |
|---|
| 11059 | |
|---|
| 11060 | CASE ( 'N_bin1' ) |
|---|
| 11061 | IF ( av == 0 ) THEN |
|---|
| 11062 | DO i = 1, mask_size_l(mid,1) |
|---|
| 11063 | DO j = 1, mask_size_l(mid,2) |
|---|
| 11064 | DO k = 1, mask_size_l(mid,3) |
|---|
| 11065 | local_pf(i,j,k) = aerosol_number(1)%conc(mask_k(mid,k), & |
|---|
| 11066 | mask_j(mid,j),mask_i(mid,i)) |
|---|
| 11067 | ENDDO |
|---|
| 11068 | ENDDO |
|---|
| 11069 | ENDDO |
|---|
| 11070 | ELSE |
|---|
| 11071 | DO i = 1, mask_size_l(mid,1) |
|---|
| 11072 | DO j = 1, mask_size_l(mid,2) |
|---|
| 11073 | DO k = 1, mask_size_l(mid,3) |
|---|
| 11074 | local_pf(i,j,k) = Nbins_av(mask_k(mid,k), & |
|---|
| 11075 | mask_j(mid,j),mask_i(mid,i),1) |
|---|
| 11076 | ENDDO |
|---|
| 11077 | ENDDO |
|---|
| 11078 | ENDDO |
|---|
| 11079 | ENDIF |
|---|
| 11080 | |
|---|
| 11081 | CASE ( 'N_bin2' ) |
|---|
| 11082 | IF ( av == 0 ) THEN |
|---|
| 11083 | DO i = 1, mask_size_l(mid,1) |
|---|
| 11084 | DO j = 1, mask_size_l(mid,2) |
|---|
| 11085 | DO k = 1, mask_size_l(mid,3) |
|---|
| 11086 | local_pf(i,j,k) = aerosol_number(2)%conc(mask_k(mid,k), & |
|---|
| 11087 | mask_j(mid,j),mask_i(mid,i)) |
|---|
| 11088 | ENDDO |
|---|
| 11089 | ENDDO |
|---|
| 11090 | ENDDO |
|---|
| 11091 | ELSE |
|---|
| 11092 | DO i = 1, mask_size_l(mid,1) |
|---|
| 11093 | DO j = 1, mask_size_l(mid,2) |
|---|
| 11094 | DO k = 1, mask_size_l(mid,3) |
|---|
| 11095 | local_pf(i,j,k) = Nbins_av(mask_k(mid,k), & |
|---|
| 11096 | mask_j(mid,j),mask_i(mid,i),2) |
|---|
| 11097 | ENDDO |
|---|
| 11098 | ENDDO |
|---|
| 11099 | ENDDO |
|---|
| 11100 | ENDIF |
|---|
| 11101 | |
|---|
| 11102 | CASE ( 'N_bin3' ) |
|---|
| 11103 | IF ( av == 0 ) THEN |
|---|
| 11104 | DO i = 1, mask_size_l(mid,1) |
|---|
| 11105 | DO j = 1, mask_size_l(mid,2) |
|---|
| 11106 | DO k = 1, mask_size_l(mid,3) |
|---|
| 11107 | local_pf(i,j,k) = aerosol_number(3)%conc(mask_k(mid,k), & |
|---|
| 11108 | mask_j(mid,j),mask_i(mid,i)) |
|---|
| 11109 | ENDDO |
|---|
| 11110 | ENDDO |
|---|
| 11111 | ENDDO |
|---|
| 11112 | ELSE |
|---|
| 11113 | DO i = 1, mask_size_l(mid,1) |
|---|
| 11114 | DO j = 1, mask_size_l(mid,2) |
|---|
| 11115 | DO k = 1, mask_size_l(mid,3) |
|---|
| 11116 | local_pf(i,j,k) = Nbins_av(mask_k(mid,k), & |
|---|
| 11117 | mask_j(mid,j),mask_i(mid,i),3) |
|---|
| 11118 | ENDDO |
|---|
| 11119 | ENDDO |
|---|
| 11120 | ENDDO |
|---|
| 11121 | ENDIF |
|---|
| 11122 | |
|---|
| 11123 | CASE ( 'N_bin4' ) |
|---|
| 11124 | IF ( av == 0 ) THEN |
|---|
| 11125 | DO i = 1, mask_size_l(mid,1) |
|---|
| 11126 | DO j = 1, mask_size_l(mid,2) |
|---|
| 11127 | DO k = 1, mask_size_l(mid,3) |
|---|
| 11128 | local_pf(i,j,k) = aerosol_number(4)%conc(mask_k(mid,k), & |
|---|
| 11129 | mask_j(mid,j),mask_i(mid,i)) |
|---|
| 11130 | ENDDO |
|---|
| 11131 | ENDDO |
|---|
| 11132 | ENDDO |
|---|
| 11133 | ELSE |
|---|
| 11134 | DO i = 1, mask_size_l(mid,1) |
|---|
| 11135 | DO j = 1, mask_size_l(mid,2) |
|---|
| 11136 | DO k = 1, mask_size_l(mid,3) |
|---|
| 11137 | local_pf(i,j,k) = Nbins_av(mask_k(mid,k), & |
|---|
| 11138 | mask_j(mid,j),mask_i(mid,i),4) |
|---|
| 11139 | ENDDO |
|---|
| 11140 | ENDDO |
|---|
| 11141 | ENDDO |
|---|
| 11142 | ENDIF |
|---|
| 11143 | |
|---|
| 11144 | CASE ( 'N_bin5' ) |
|---|
| 11145 | IF ( av == 0 ) THEN |
|---|
| 11146 | DO i = 1, mask_size_l(mid,1) |
|---|
| 11147 | DO j = 1, mask_size_l(mid,2) |
|---|
| 11148 | DO k = 1, mask_size_l(mid,3) |
|---|
| 11149 | local_pf(i,j,k) = aerosol_number(5)%conc(mask_k(mid,k), & |
|---|
| 11150 | mask_j(mid,j),mask_i(mid,i)) |
|---|
| 11151 | ENDDO |
|---|
| 11152 | ENDDO |
|---|
| 11153 | ENDDO |
|---|
| 11154 | ELSE |
|---|
| 11155 | DO i = 1, mask_size_l(mid,1) |
|---|
| 11156 | DO j = 1, mask_size_l(mid,2) |
|---|
| 11157 | DO k = 1, mask_size_l(mid,3) |
|---|
| 11158 | local_pf(i,j,k) = Nbins_av(mask_k(mid,k), & |
|---|
| 11159 | mask_j(mid,j),mask_i(mid,i),5) |
|---|
| 11160 | ENDDO |
|---|
| 11161 | ENDDO |
|---|
| 11162 | ENDDO |
|---|
| 11163 | ENDIF |
|---|
| 11164 | |
|---|
| 11165 | CASE ( 'N_bin6' ) |
|---|
| 11166 | IF ( av == 0 ) THEN |
|---|
| 11167 | DO i = 1, mask_size_l(mid,1) |
|---|
| 11168 | DO j = 1, mask_size_l(mid,2) |
|---|
| 11169 | DO k = 1, mask_size_l(mid,3) |
|---|
| 11170 | local_pf(i,j,k) = aerosol_number(6)%conc(mask_k(mid,k), & |
|---|
| 11171 | mask_j(mid,j),mask_i(mid,i)) |
|---|
| 11172 | ENDDO |
|---|
| 11173 | ENDDO |
|---|
| 11174 | ENDDO |
|---|
| 11175 | ELSE |
|---|
| 11176 | DO i = 1, mask_size_l(mid,1) |
|---|
| 11177 | DO j = 1, mask_size_l(mid,2) |
|---|
| 11178 | DO k = 1, mask_size_l(mid,3) |
|---|
| 11179 | local_pf(i,j,k) = Nbins_av(mask_k(mid,k), & |
|---|
| 11180 | mask_j(mid,j),mask_i(mid,i),6) |
|---|
| 11181 | ENDDO |
|---|
| 11182 | ENDDO |
|---|
| 11183 | ENDDO |
|---|
| 11184 | ENDIF |
|---|
| 11185 | |
|---|
| 11186 | CASE ( 'N_bin7' ) |
|---|
| 11187 | IF ( av == 0 ) THEN |
|---|
| 11188 | DO i = 1, mask_size_l(mid,1) |
|---|
| 11189 | DO j = 1, mask_size_l(mid,2) |
|---|
| 11190 | DO k = 1, mask_size_l(mid,3) |
|---|
| 11191 | local_pf(i,j,k) = aerosol_number(7)%conc(mask_k(mid,k), & |
|---|
| 11192 | mask_j(mid,j),mask_i(mid,i)) |
|---|
| 11193 | ENDDO |
|---|
| 11194 | ENDDO |
|---|
| 11195 | ENDDO |
|---|
| 11196 | ELSE |
|---|
| 11197 | DO i = 1, mask_size_l(mid,1) |
|---|
| 11198 | DO j = 1, mask_size_l(mid,2) |
|---|
| 11199 | DO k = 1, mask_size_l(mid,3) |
|---|
| 11200 | local_pf(i,j,k) = Nbins_av(mask_k(mid,k), & |
|---|
| 11201 | mask_j(mid,j),mask_i(mid,i),7) |
|---|
| 11202 | ENDDO |
|---|
| 11203 | ENDDO |
|---|
| 11204 | ENDDO |
|---|
| 11205 | ENDIF |
|---|
| 11206 | |
|---|
| 11207 | CASE ( 'N_bin8' ) |
|---|
| 11208 | IF ( av == 0 ) THEN |
|---|
| 11209 | DO i = 1, mask_size_l(mid,1) |
|---|
| 11210 | DO j = 1, mask_size_l(mid,2) |
|---|
| 11211 | DO k = 1, mask_size_l(mid,3) |
|---|
| 11212 | local_pf(i,j,k) = aerosol_number(8)%conc(mask_k(mid,k), & |
|---|
| 11213 | mask_j(mid,j),mask_i(mid,i)) |
|---|
| 11214 | ENDDO |
|---|
| 11215 | ENDDO |
|---|
| 11216 | ENDDO |
|---|
| 11217 | ELSE |
|---|
| 11218 | DO i = 1, mask_size_l(mid,1) |
|---|
| 11219 | DO j = 1, mask_size_l(mid,2) |
|---|
| 11220 | DO k = 1, mask_size_l(mid,3) |
|---|
| 11221 | local_pf(i,j,k) = Nbins_av(mask_k(mid,k), & |
|---|
| 11222 | mask_j(mid,j),mask_i(mid,i),8) |
|---|
| 11223 | ENDDO |
|---|
| 11224 | ENDDO |
|---|
| 11225 | ENDDO |
|---|
| 11226 | ENDIF |
|---|
| 11227 | |
|---|
| 11228 | CASE ( 'N_bin9' ) |
|---|
| 11229 | IF ( av == 0 ) THEN |
|---|
| 11230 | DO i = 1, mask_size_l(mid,1) |
|---|
| 11231 | DO j = 1, mask_size_l(mid,2) |
|---|
| 11232 | DO k = 1, mask_size_l(mid,3) |
|---|
| 11233 | local_pf(i,j,k) = aerosol_number(9)%conc(mask_k(mid,k), & |
|---|
| 11234 | mask_j(mid,j),mask_i(mid,i)) |
|---|
| 11235 | ENDDO |
|---|
| 11236 | ENDDO |
|---|
| 11237 | ENDDO |
|---|
| 11238 | ELSE |
|---|
| 11239 | DO i = 1, mask_size_l(mid,1) |
|---|
| 11240 | DO j = 1, mask_size_l(mid,2) |
|---|
| 11241 | DO k = 1, mask_size_l(mid,3) |
|---|
| 11242 | local_pf(i,j,k) = Nbins_av(mask_k(mid,k), & |
|---|
| 11243 | mask_j(mid,j),mask_i(mid,i),9) |
|---|
| 11244 | ENDDO |
|---|
| 11245 | ENDDO |
|---|
| 11246 | ENDDO |
|---|
| 11247 | ENDIF |
|---|
| 11248 | |
|---|
| 11249 | CASE ( 'N_bin10' ) |
|---|
| 11250 | IF ( av == 0 ) THEN |
|---|
| 11251 | DO i = 1, mask_size_l(mid,1) |
|---|
| 11252 | DO j = 1, mask_size_l(mid,2) |
|---|
| 11253 | DO k = 1, mask_size_l(mid,3) |
|---|
| 11254 | local_pf(i,j,k) = aerosol_number(10)%conc(mask_k(mid,k), & |
|---|
| 11255 | mask_j(mid,j),mask_i(mid,i)) |
|---|
| 11256 | ENDDO |
|---|
| 11257 | ENDDO |
|---|
| 11258 | ENDDO |
|---|
| 11259 | ELSE |
|---|
| 11260 | DO i = 1, mask_size_l(mid,1) |
|---|
| 11261 | DO j = 1, mask_size_l(mid,2) |
|---|
| 11262 | DO k = 1, mask_size_l(mid,3) |
|---|
| 11263 | local_pf(i,j,k) = Nbins_av(mask_k(mid,k), & |
|---|
| 11264 | mask_j(mid,j),mask_i(mid,i),10) |
|---|
| 11265 | ENDDO |
|---|
| 11266 | ENDDO |
|---|
| 11267 | ENDDO |
|---|
| 11268 | ENDIF |
|---|
| 11269 | |
|---|
| 11270 | CASE ( 'N_bin11' ) |
|---|
| 11271 | IF ( av == 0 ) THEN |
|---|
| 11272 | DO i = 1, mask_size_l(mid,1) |
|---|
| 11273 | DO j = 1, mask_size_l(mid,2) |
|---|
| 11274 | DO k = 1, mask_size_l(mid,3) |
|---|
| 11275 | local_pf(i,j,k) = aerosol_number(11)%conc(mask_k(mid,k), & |
|---|
| 11276 | mask_j(mid,j),mask_i(mid,i)) |
|---|
| 11277 | ENDDO |
|---|
| 11278 | ENDDO |
|---|
| 11279 | ENDDO |
|---|
| 11280 | ELSE |
|---|
| 11281 | DO i = 1, mask_size_l(mid,1) |
|---|
| 11282 | DO j = 1, mask_size_l(mid,2) |
|---|
| 11283 | DO k = 1, mask_size_l(mid,3) |
|---|
| 11284 | local_pf(i,j,k) = Nbins_av(mask_k(mid,k), & |
|---|
| 11285 | mask_j(mid,j),mask_i(mid,i),11) |
|---|
| 11286 | ENDDO |
|---|
| 11287 | ENDDO |
|---|
| 11288 | ENDDO |
|---|
| 11289 | ENDIF |
|---|
| 11290 | |
|---|
| 11291 | CASE ( 'N_bin12' ) |
|---|
| 11292 | IF ( av == 0 ) THEN |
|---|
| 11293 | DO i = 1, mask_size_l(mid,1) |
|---|
| 11294 | DO j = 1, mask_size_l(mid,2) |
|---|
| 11295 | DO k = 1, mask_size_l(mid,3) |
|---|
| 11296 | local_pf(i,j,k) = aerosol_number(12)%conc(mask_k(mid,k), & |
|---|
| 11297 | mask_j(mid,j),mask_i(mid,i)) |
|---|
| 11298 | ENDDO |
|---|
| 11299 | ENDDO |
|---|
| 11300 | ENDDO |
|---|
| 11301 | ELSE |
|---|
| 11302 | DO i = 1, mask_size_l(mid,1) |
|---|
| 11303 | DO j = 1, mask_size_l(mid,2) |
|---|
| 11304 | DO k = 1, mask_size_l(mid,3) |
|---|
| 11305 | local_pf(i,j,k) = Nbins_av(mask_k(mid,k), & |
|---|
| 11306 | mask_j(mid,j),mask_i(mid,i),12) |
|---|
| 11307 | ENDDO |
|---|
| 11308 | ENDDO |
|---|
| 11309 | ENDDO |
|---|
| 11310 | ENDIF |
|---|
| 11311 | |
|---|
| 11312 | CASE ( 'm_bin1' ) |
|---|
| 11313 | IF ( av == 0 ) THEN |
|---|
| 11314 | DO i = 1, mask_size_l(mid,1) |
|---|
| 11315 | DO j = 1, mask_size_l(mid,2) |
|---|
| 11316 | DO k = 1, mask_size_l(mid,3) |
|---|
| 11317 | temp_bin = 0.0_wp |
|---|
| 11318 | DO c = 1, ncc_tot*nbins, nbins |
|---|
| 11319 | temp_bin = temp_bin + aerosol_mass(c)%conc( & |
|---|
| 11320 | mask_k(mid,k),mask_j(mid,j),mask_i(mid,i)) |
|---|
| 11321 | ENDDO |
|---|
| 11322 | local_pf(i,j,k) = temp_bin |
|---|
| 11323 | ENDDO |
|---|
| 11324 | ENDDO |
|---|
| 11325 | ENDDO |
|---|
| 11326 | ELSE |
|---|
| 11327 | DO i = 1, mask_size_l(mid,1) |
|---|
| 11328 | DO j = 1, mask_size_l(mid,2) |
|---|
| 11329 | DO k = 1, mask_size_l(mid,3) |
|---|
| 11330 | local_pf(i,j,k) = mbins_av(mask_k(mid,k), & |
|---|
| 11331 | mask_j(mid,j),mask_i(mid,i),1) |
|---|
| 11332 | ENDDO |
|---|
| 11333 | ENDDO |
|---|
| 11334 | ENDDO |
|---|
| 11335 | ENDIF |
|---|
| 11336 | |
|---|
| 11337 | CASE ( 'm_bin2' ) |
|---|
| 11338 | IF ( av == 0 ) THEN |
|---|
| 11339 | DO i = 1, mask_size_l(mid,1) |
|---|
| 11340 | DO j = 1, mask_size_l(mid,2) |
|---|
| 11341 | DO k = 1, mask_size_l(mid,3) |
|---|
| 11342 | temp_bin = 0.0_wp |
|---|
| 11343 | DO c = 2, ncc_tot*nbins, nbins |
|---|
| 11344 | temp_bin = temp_bin + aerosol_mass(c)%conc( & |
|---|
| 11345 | mask_k(mid,k),mask_j(mid,j),mask_i(mid,i)) |
|---|
| 11346 | ENDDO |
|---|
| 11347 | local_pf(i,j,k) = temp_bin |
|---|
| 11348 | ENDDO |
|---|
| 11349 | ENDDO |
|---|
| 11350 | ENDDO |
|---|
| 11351 | ELSE |
|---|
| 11352 | DO i = 1, mask_size_l(mid,1) |
|---|
| 11353 | DO j = 1, mask_size_l(mid,2) |
|---|
| 11354 | DO k = 1, mask_size_l(mid,3) |
|---|
| 11355 | local_pf(i,j,k) = mbins_av(mask_k(mid,k), & |
|---|
| 11356 | mask_j(mid,j),mask_i(mid,i),2) |
|---|
| 11357 | ENDDO |
|---|
| 11358 | ENDDO |
|---|
| 11359 | ENDDO |
|---|
| 11360 | ENDIF |
|---|
| 11361 | |
|---|
| 11362 | CASE ( 'm_bin3' ) |
|---|
| 11363 | IF ( av == 0 ) THEN |
|---|
| 11364 | DO i = 1, mask_size_l(mid,1) |
|---|
| 11365 | DO j = 1, mask_size_l(mid,2) |
|---|
| 11366 | DO k = 1, mask_size_l(mid,3) |
|---|
| 11367 | temp_bin = 0.0_wp |
|---|
| 11368 | DO c = 3, ncc_tot*nbins, nbins |
|---|
| 11369 | temp_bin = temp_bin + aerosol_mass(c)%conc( & |
|---|
| 11370 | mask_k(mid,k),mask_j(mid,j),mask_i(mid,i)) |
|---|
| 11371 | ENDDO |
|---|
| 11372 | local_pf(i,j,k) = temp_bin |
|---|
| 11373 | ENDDO |
|---|
| 11374 | ENDDO |
|---|
| 11375 | ENDDO |
|---|
| 11376 | ELSE |
|---|
| 11377 | DO i = 1, mask_size_l(mid,1) |
|---|
| 11378 | DO j = 1, mask_size_l(mid,2) |
|---|
| 11379 | DO k = 1, mask_size_l(mid,3) |
|---|
| 11380 | local_pf(i,j,k) = mbins_av(mask_k(mid,k), & |
|---|
| 11381 | mask_j(mid,j),mask_i(mid,i),3) |
|---|
| 11382 | ENDDO |
|---|
| 11383 | ENDDO |
|---|
| 11384 | ENDDO |
|---|
| 11385 | ENDIF |
|---|
| 11386 | |
|---|
| 11387 | CASE ( 'm_bin4' ) |
|---|
| 11388 | IF ( av == 0 ) THEN |
|---|
| 11389 | DO i = 1, mask_size_l(mid,1) |
|---|
| 11390 | DO j = 1, mask_size_l(mid,2) |
|---|
| 11391 | DO k = 1, mask_size_l(mid,3) |
|---|
| 11392 | temp_bin = 0.0_wp |
|---|
| 11393 | DO c = 4, ncc_tot*nbins, nbins |
|---|
| 11394 | temp_bin = temp_bin + aerosol_mass(c)%conc( & |
|---|
| 11395 | mask_k(mid,k),mask_j(mid,j),mask_i(mid,i)) |
|---|
| 11396 | ENDDO |
|---|
| 11397 | local_pf(i,j,k) = temp_bin |
|---|
| 11398 | ENDDO |
|---|
| 11399 | ENDDO |
|---|
| 11400 | ENDDO |
|---|
| 11401 | ELSE |
|---|
| 11402 | DO i = 1, mask_size_l(mid,1) |
|---|
| 11403 | DO j = 1, mask_size_l(mid,2) |
|---|
| 11404 | DO k = 1, mask_size_l(mid,3) |
|---|
| 11405 | local_pf(i,j,k) = mbins_av(mask_k(mid,k), & |
|---|
| 11406 | mask_j(mid,j),mask_i(mid,i),4) |
|---|
| 11407 | ENDDO |
|---|
| 11408 | ENDDO |
|---|
| 11409 | ENDDO |
|---|
| 11410 | ENDIF |
|---|
| 11411 | |
|---|
| 11412 | CASE ( 'm_bin5' ) |
|---|
| 11413 | IF ( av == 0 ) THEN |
|---|
| 11414 | DO i = 1, mask_size_l(mid,1) |
|---|
| 11415 | DO j = 1, mask_size_l(mid,2) |
|---|
| 11416 | DO k = 1, mask_size_l(mid,3) |
|---|
| 11417 | temp_bin = 0.0_wp |
|---|
| 11418 | DO c = 5, ncc_tot*nbins, nbins |
|---|
| 11419 | temp_bin = temp_bin + aerosol_mass(c)%conc( & |
|---|
| 11420 | mask_k(mid,k),mask_j(mid,j),mask_i(mid,i)) |
|---|
| 11421 | ENDDO |
|---|
| 11422 | local_pf(i,j,k) = temp_bin |
|---|
| 11423 | ENDDO |
|---|
| 11424 | ENDDO |
|---|
| 11425 | ENDDO |
|---|
| 11426 | ELSE |
|---|
| 11427 | DO i = 1, mask_size_l(mid,1) |
|---|
| 11428 | DO j = 1, mask_size_l(mid,2) |
|---|
| 11429 | DO k = 1, mask_size_l(mid,3) |
|---|
| 11430 | local_pf(i,j,k) = mbins_av(mask_k(mid,k), & |
|---|
| 11431 | mask_j(mid,j),mask_i(mid,i),5) |
|---|
| 11432 | ENDDO |
|---|
| 11433 | ENDDO |
|---|
| 11434 | ENDDO |
|---|
| 11435 | ENDIF |
|---|
| 11436 | |
|---|
| 11437 | CASE ( 'm_bin6' ) |
|---|
| 11438 | IF ( av == 0 ) THEN |
|---|
| 11439 | DO i = 1, mask_size_l(mid,1) |
|---|
| 11440 | DO j = 1, mask_size_l(mid,2) |
|---|
| 11441 | DO k = 1, mask_size_l(mid,3) |
|---|
| 11442 | temp_bin = 0.0_wp |
|---|
| 11443 | DO c = 6, ncc_tot*nbins, nbins |
|---|
| 11444 | temp_bin = temp_bin + aerosol_mass(c)%conc( & |
|---|
| 11445 | mask_k(mid,k),mask_j(mid,j),mask_i(mid,i)) |
|---|
| 11446 | ENDDO |
|---|
| 11447 | local_pf(i,j,k) = temp_bin |
|---|
| 11448 | ENDDO |
|---|
| 11449 | ENDDO |
|---|
| 11450 | ENDDO |
|---|
| 11451 | ELSE |
|---|
| 11452 | DO i = 1, mask_size_l(mid,1) |
|---|
| 11453 | DO j = 1, mask_size_l(mid,2) |
|---|
| 11454 | DO k = 1, mask_size_l(mid,3) |
|---|
| 11455 | local_pf(i,j,k) = mbins_av(mask_k(mid,k), & |
|---|
| 11456 | mask_j(mid,j),mask_i(mid,i),6) |
|---|
| 11457 | ENDDO |
|---|
| 11458 | ENDDO |
|---|
| 11459 | ENDDO |
|---|
| 11460 | ENDIF |
|---|
| 11461 | |
|---|
| 11462 | CASE ( 'm_bin7' ) |
|---|
| 11463 | IF ( av == 0 ) THEN |
|---|
| 11464 | DO i = 1, mask_size_l(mid,1) |
|---|
| 11465 | DO j = 1, mask_size_l(mid,2) |
|---|
| 11466 | DO k = 1, mask_size_l(mid,3) |
|---|
| 11467 | temp_bin = 0.0_wp |
|---|
| 11468 | DO c = 7, ncc_tot*nbins, nbins |
|---|
| 11469 | temp_bin = temp_bin + aerosol_mass(c)%conc( & |
|---|
| 11470 | mask_k(mid,k),mask_j(mid,j),mask_i(mid,i)) |
|---|
| 11471 | ENDDO |
|---|
| 11472 | local_pf(i,j,k) = temp_bin |
|---|
| 11473 | ENDDO |
|---|
| 11474 | ENDDO |
|---|
| 11475 | ENDDO |
|---|
| 11476 | ELSE |
|---|
| 11477 | DO i = 1, mask_size_l(mid,1) |
|---|
| 11478 | DO j = 1, mask_size_l(mid,2) |
|---|
| 11479 | DO k = 1, mask_size_l(mid,3) |
|---|
| 11480 | local_pf(i,j,k) = mbins_av(mask_k(mid,k), & |
|---|
| 11481 | mask_j(mid,j),mask_i(mid,i),7) |
|---|
| 11482 | ENDDO |
|---|
| 11483 | ENDDO |
|---|
| 11484 | ENDDO |
|---|
| 11485 | ENDIF |
|---|
| 11486 | |
|---|
| 11487 | CASE ( 'm_bin8' ) |
|---|
| 11488 | IF ( av == 0 ) THEN |
|---|
| 11489 | DO i = 1, mask_size_l(mid,1) |
|---|
| 11490 | DO j = 1, mask_size_l(mid,2) |
|---|
| 11491 | DO k = 1, mask_size_l(mid,3) |
|---|
| 11492 | temp_bin = 0.0_wp |
|---|
| 11493 | DO c = 8, ncc_tot*nbins, nbins |
|---|
| 11494 | temp_bin = temp_bin + aerosol_mass(c)%conc( & |
|---|
| 11495 | mask_k(mid,k),mask_j(mid,j),mask_i(mid,i)) |
|---|
| 11496 | ENDDO |
|---|
| 11497 | local_pf(i,j,k) = temp_bin |
|---|
| 11498 | ENDDO |
|---|
| 11499 | ENDDO |
|---|
| 11500 | ENDDO |
|---|
| 11501 | ELSE |
|---|
| 11502 | DO i = 1, mask_size_l(mid,1) |
|---|
| 11503 | DO j = 1, mask_size_l(mid,2) |
|---|
| 11504 | DO k = 1, mask_size_l(mid,3) |
|---|
| 11505 | local_pf(i,j,k) = mbins_av(mask_k(mid,k), & |
|---|
| 11506 | mask_j(mid,j),mask_i(mid,i),8) |
|---|
| 11507 | ENDDO |
|---|
| 11508 | ENDDO |
|---|
| 11509 | ENDDO |
|---|
| 11510 | ENDIF |
|---|
| 11511 | |
|---|
| 11512 | CASE ( 'm_bin9' ) |
|---|
| 11513 | IF ( av == 0 ) THEN |
|---|
| 11514 | DO i = 1, mask_size_l(mid,1) |
|---|
| 11515 | DO j = 1, mask_size_l(mid,2) |
|---|
| 11516 | DO k = 1, mask_size_l(mid,3) |
|---|
| 11517 | temp_bin = 0.0_wp |
|---|
| 11518 | DO c = 9, ncc_tot*nbins, nbins |
|---|
| 11519 | temp_bin = temp_bin + aerosol_mass(c)%conc( & |
|---|
| 11520 | mask_k(mid,k),mask_j(mid,j),mask_i(mid,i)) |
|---|
| 11521 | ENDDO |
|---|
| 11522 | local_pf(i,j,k) = temp_bin |
|---|
| 11523 | ENDDO |
|---|
| 11524 | ENDDO |
|---|
| 11525 | ENDDO |
|---|
| 11526 | ELSE |
|---|
| 11527 | DO i = 1, mask_size_l(mid,1) |
|---|
| 11528 | DO j = 1, mask_size_l(mid,2) |
|---|
| 11529 | DO k = 1, mask_size_l(mid,3) |
|---|
| 11530 | local_pf(i,j,k) = mbins_av(mask_k(mid,k), & |
|---|
| 11531 | mask_j(mid,j),mask_i(mid,i),9) |
|---|
| 11532 | ENDDO |
|---|
| 11533 | ENDDO |
|---|
| 11534 | ENDDO |
|---|
| 11535 | ENDIF |
|---|
| 11536 | |
|---|
| 11537 | CASE ( 'm_bin10' ) |
|---|
| 11538 | IF ( av == 0 ) THEN |
|---|
| 11539 | DO i = 1, mask_size_l(mid,1) |
|---|
| 11540 | DO j = 1, mask_size_l(mid,2) |
|---|
| 11541 | DO k = 1, mask_size_l(mid,3) |
|---|
| 11542 | temp_bin = 0.0_wp |
|---|
| 11543 | DO c = 10, ncc_tot*nbins, nbins |
|---|
| 11544 | temp_bin = temp_bin + aerosol_mass(c)%conc( & |
|---|
| 11545 | mask_k(mid,k),mask_j(mid,j),mask_i(mid,i)) |
|---|
| 11546 | ENDDO |
|---|
| 11547 | local_pf(i,j,k) = temp_bin |
|---|
| 11548 | ENDDO |
|---|
| 11549 | ENDDO |
|---|
| 11550 | ENDDO |
|---|
| 11551 | ELSE |
|---|
| 11552 | DO i = 1, mask_size_l(mid,1) |
|---|
| 11553 | DO j = 1, mask_size_l(mid,2) |
|---|
| 11554 | DO k = 1, mask_size_l(mid,3) |
|---|
| 11555 | local_pf(i,j,k) = mbins_av(mask_k(mid,k), & |
|---|
| 11556 | mask_j(mid,j),mask_i(mid,i),10) |
|---|
| 11557 | ENDDO |
|---|
| 11558 | ENDDO |
|---|
| 11559 | ENDDO |
|---|
| 11560 | ENDIF |
|---|
| 11561 | |
|---|
| 11562 | CASE ( 'm_bin11' ) |
|---|
| 11563 | IF ( av == 0 ) THEN |
|---|
| 11564 | DO i = 1, mask_size_l(mid,1) |
|---|
| 11565 | DO j = 1, mask_size_l(mid,2) |
|---|
| 11566 | DO k = 1, mask_size_l(mid,3) |
|---|
| 11567 | temp_bin = 0.0_wp |
|---|
| 11568 | DO c = 11, ncc_tot*nbins, nbins |
|---|
| 11569 | temp_bin = temp_bin + aerosol_mass(c)%conc( & |
|---|
| 11570 | mask_k(mid,k),mask_j(mid,j),mask_i(mid,i)) |
|---|
| 11571 | ENDDO |
|---|
| 11572 | local_pf(i,j,k) = temp_bin |
|---|
| 11573 | ENDDO |
|---|
| 11574 | ENDDO |
|---|
| 11575 | ENDDO |
|---|
| 11576 | ELSE |
|---|
| 11577 | DO i = 1, mask_size_l(mid,1) |
|---|
| 11578 | DO j = 1, mask_size_l(mid,2) |
|---|
| 11579 | DO k = 1, mask_size_l(mid,3) |
|---|
| 11580 | local_pf(i,j,k) = mbins_av(mask_k(mid,k), & |
|---|
| 11581 | mask_j(mid,j),mask_i(mid,i),11) |
|---|
| 11582 | ENDDO |
|---|
| 11583 | ENDDO |
|---|
| 11584 | ENDDO |
|---|
| 11585 | ENDIF |
|---|
| 11586 | |
|---|
| 11587 | CASE ( 'm_bin12' ) |
|---|
| 11588 | IF ( av == 0 ) THEN |
|---|
| 11589 | DO i = 1, mask_size_l(mid,1) |
|---|
| 11590 | DO j = 1, mask_size_l(mid,2) |
|---|
| 11591 | DO k = 1, mask_size_l(mid,3) |
|---|
| 11592 | temp_bin = 0.0_wp |
|---|
| 11593 | DO c = 12, ncc_tot*nbins, nbins |
|---|
| 11594 | temp_bin = temp_bin + aerosol_mass(c)%conc( & |
|---|
| 11595 | mask_k(mid,k),mask_j(mid,j),mask_i(mid,i)) |
|---|
| 11596 | ENDDO |
|---|
| 11597 | local_pf(i,j,k) = temp_bin |
|---|
| 11598 | ENDDO |
|---|
| 11599 | ENDDO |
|---|
| 11600 | ENDDO |
|---|
| 11601 | ELSE |
|---|
| 11602 | DO i = 1, mask_size_l(mid,1) |
|---|
| 11603 | DO j = 1, mask_size_l(mid,2) |
|---|
| 11604 | DO k = 1, mask_size_l(mid,3) |
|---|
| 11605 | local_pf(i,j,k) = mbins_av(mask_k(mid,k), & |
|---|
| 11606 | mask_j(mid,j),mask_i(mid,i),12) |
|---|
| 11607 | ENDDO |
|---|
| 11608 | ENDDO |
|---|
| 11609 | ENDDO |
|---|
| 11610 | ENDIF |
|---|
| 11611 | |
|---|
| 11612 | CASE ( 's_BC', 's_DU', 's_NH', 's_NO', 's_OC', 's_SO4', 's_SS' ) |
|---|
| 11613 | IF ( is_used( prtcl, TRIM( variable(3:) ) ) ) THEN |
|---|
| 11614 | icc = get_index( prtcl, TRIM( variable(3:) ) ) |
|---|
| 11615 | IF ( av == 0 ) THEN |
|---|
| 11616 | DO i = 1, mask_size_l(mid,1) |
|---|
| 11617 | DO j = 1, mask_size_l(mid,2) |
|---|
| 11618 | DO k = 1, mask_size_l(mid,3) |
|---|
| 11619 | temp_bin = 0.0_wp |
|---|
| 11620 | DO c = ( icc-1 )*nbins+1, icc*nbins |
|---|
| 11621 | temp_bin = temp_bin + aerosol_mass(c)%conc( & |
|---|
| 11622 | mask_k(mid,k),mask_j(mid,j),mask_i(mid,i)) |
|---|
| 11623 | ENDDO |
|---|
| 11624 | local_pf(i,j,k) = temp_bin |
|---|
| 11625 | ENDDO |
|---|
| 11626 | ENDDO |
|---|
| 11627 | ENDDO |
|---|
| 11628 | ELSE |
|---|
| 11629 | IF ( TRIM( variable(3:) ) == 'BC' ) to_be_resorted => s_BC_av |
|---|
| 11630 | IF ( TRIM( variable(3:) ) == 'DU' ) to_be_resorted => s_DU_av |
|---|
| 11631 | IF ( TRIM( variable(3:) ) == 'NH' ) to_be_resorted => s_NH_av |
|---|
| 11632 | IF ( TRIM( variable(3:) ) == 'NO' ) to_be_resorted => s_NO_av |
|---|
| 11633 | IF ( TRIM( variable(3:) ) == 'OC' ) to_be_resorted => s_OC_av |
|---|
| 11634 | IF ( TRIM( variable(3:) ) == 'SO4' ) to_be_resorted => s_SO4_av |
|---|
| 11635 | IF ( TRIM( variable(3:) ) == 'SS' ) to_be_resorted => s_SS_av |
|---|
| 11636 | DO i = 1, mask_size_l(mid,1) |
|---|
| 11637 | DO j = 1, mask_size_l(mid,2) |
|---|
| 11638 | DO k = 1, mask_size_l(mid,3) |
|---|
| 11639 | local_pf(i,j,k) = to_be_resorted(mask_k(mid,k), & |
|---|
| 11640 | mask_j(mid,j),mask_i(mid,i)) |
|---|
| 11641 | ENDDO |
|---|
| 11642 | ENDDO |
|---|
| 11643 | ENDDO |
|---|
| 11644 | ENDIF |
|---|
| 11645 | ENDIF |
|---|
| 11646 | |
|---|
| 11647 | CASE DEFAULT |
|---|
| 11648 | found = .FALSE. |
|---|
| 11649 | |
|---|
| 11650 | END SELECT |
|---|
| 11651 | |
|---|
| 11652 | END SUBROUTINE salsa_data_output_mask |
|---|
| 11653 | |
|---|
| 11654 | |
|---|
| 11655 | END MODULE salsa_mod |
|---|
