1 | !> @file salsa_mod.f90 |
---|
2 | !--------------------------------------------------------------------------------! |
---|
3 | ! This file is part of PALM-4U. |
---|
4 | ! |
---|
5 | ! PALM-4U is free software: you can redistribute it and/or modify it under the |
---|
6 | ! terms of the GNU General Public License as published by the Free Software |
---|
7 | ! Foundation, either version 3 of the License, or (at your option) any later |
---|
8 | ! version. |
---|
9 | ! |
---|
10 | ! PALM-4U is distributed in the hope that it will be useful, but WITHOUT ANY |
---|
11 | ! WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS FOR |
---|
12 | ! A PARTICULAR PURPOSE. See the GNU General Public License for more details. |
---|
13 | ! |
---|
14 | ! You should have received a copy of the GNU General Public License along with |
---|
15 | ! PALM. If not, see <http://www.gnu.org/licenses/>. |
---|
16 | ! |
---|
17 | ! Copyright 2018-2019 University of Helsinki |
---|
18 | ! Copyright 1997-2019 Leibniz Universitaet Hannover |
---|
19 | !--------------------------------------------------------------------------------! |
---|
20 | ! |
---|
21 | ! Current revisions: |
---|
22 | ! ----------------- |
---|
23 | ! |
---|
24 | ! |
---|
25 | ! Former revisions: |
---|
26 | ! ----------------- |
---|
27 | ! $Id: salsa_mod.f90 4256 2019-10-07 10:08:52Z monakurppa $ |
---|
28 | ! Document previous changes: use global variables nx, ny and nz in salsa_header |
---|
29 | ! |
---|
30 | ! 4255 2019-10-04 11:50:55Z monakurppa |
---|
31 | ! implement new palm_date_time_mod |
---|
32 | ! |
---|
33 | ! 4226 2019-09-10 17:03:24Z suehring |
---|
34 | ! Netcdf input routine for dimension length renamed |
---|
35 | ! |
---|
36 | ! 4182 2019-08-22 15:20:23Z scharf |
---|
37 | ! Corrected "Former revisions" section |
---|
38 | ! |
---|
39 | ! 4167 2019-08-16 11:01:48Z suehring |
---|
40 | ! Changed behaviour of masked output over surface to follow terrain and ignore |
---|
41 | ! buildings (J.Resler, T.Gronemeier) |
---|
42 | ! |
---|
43 | ! 4131 2019-08-02 11:06:18Z monakurppa |
---|
44 | ! - Add "salsa_" before each salsa output variable |
---|
45 | ! - Add a possibility to output the number (salsa_N_UFP) and mass concentration |
---|
46 | ! (salsa_PM0.1) of ultrafine particles, i.e. particles with a diameter smaller |
---|
47 | ! than 100 nm |
---|
48 | ! - Implement aerosol emission mode "parameterized" which is based on the street |
---|
49 | ! type (similar to the chemistry module). |
---|
50 | ! - Remove unnecessary nucleation subroutines. |
---|
51 | ! - Add the z-dimension for gaseous emissions to correspond the implementation |
---|
52 | ! in the chemistry module |
---|
53 | ! |
---|
54 | ! 4118 2019-07-25 16:11:45Z suehring |
---|
55 | ! - When Dirichlet condition is applied in decycling, the boundary conditions are |
---|
56 | ! only set at the ghost points and not at the prognostic grid points as done |
---|
57 | ! before |
---|
58 | ! - Rename decycle_ns/lr to decycle_salsa_ns/lr and decycle_method to |
---|
59 | ! decycle_method_salsa |
---|
60 | ! - Allocation and initialization of special advection flags salsa_advc_flags_s |
---|
61 | ! used for salsa. These are exclusively used for salsa variables to |
---|
62 | ! distinguish from the usually-used flags which might be different when |
---|
63 | ! decycling is applied in combination with cyclic boundary conditions. |
---|
64 | ! Moreover, salsa_advc_flags_s considers extended zones around buildings where |
---|
65 | ! the first-order upwind scheme is applied for the horizontal advection terms. |
---|
66 | ! This is done to overcome high concentration peaks due to stationary numerical |
---|
67 | ! oscillations caused by horizontal advection discretization. |
---|
68 | ! |
---|
69 | ! 4117 2019-07-25 08:54:02Z monakurppa |
---|
70 | ! Pass integer flag array as well as boundary flags to WS scalar advection |
---|
71 | ! routine |
---|
72 | ! |
---|
73 | ! 4109 2019-07-22 17:00:34Z suehring |
---|
74 | ! Slightly revise setting of boundary conditions at horizontal walls, use |
---|
75 | ! data-structure offset index instead of pre-calculate it for each facing |
---|
76 | ! |
---|
77 | ! 4079 2019-07-09 18:04:41Z suehring |
---|
78 | ! Application of monotonic flux limiter for the vertical scalar advection |
---|
79 | ! up to the topography top (only for the cache-optimized version at the |
---|
80 | ! moment). |
---|
81 | ! |
---|
82 | ! 4069 2019-07-01 14:05:51Z Giersch |
---|
83 | ! Masked output running index mid has been introduced as a local variable to |
---|
84 | ! avoid runtime error (Loop variable has been modified) in time_integration |
---|
85 | ! |
---|
86 | ! 4058 2019-06-27 15:25:42Z knoop |
---|
87 | ! Bugfix: to_be_resorted was uninitialized in case of s_H2O in 3d_data_averaging |
---|
88 | ! |
---|
89 | ! 4012 2019-05-31 15:19:05Z monakurppa |
---|
90 | ! Merge salsa branch to trunk. List of changes: |
---|
91 | ! - Error corrected in distr_update that resulted in the aerosol number size |
---|
92 | ! distribution not converging if the concentration was nclim. |
---|
93 | ! - Added a separate output for aerosol liquid water (s_H2O) |
---|
94 | ! - aerosol processes for a size bin are now calculated only if the aerosol |
---|
95 | ! number of concentration of that bin is > 2*nclim |
---|
96 | ! - An initialisation error in the subroutine "deposition" corrected and the |
---|
97 | ! subroutine reformatted. |
---|
98 | ! - stuff from salsa_util_mod.f90 moved into salsa_mod.f90 |
---|
99 | ! - calls for closing the netcdf input files added |
---|
100 | ! |
---|
101 | ! 3956 2019-05-07 12:32:52Z monakurppa |
---|
102 | ! - Conceptual bug in depo_surf correct for urban and land surface model |
---|
103 | ! - Subroutine salsa_tendency_ij optimized. |
---|
104 | ! - Interfaces salsa_non_advective_processes and salsa_exchange_horiz_bounds |
---|
105 | ! created. These are now called in module_interface. |
---|
106 | ! salsa_exchange_horiz_bounds after calling salsa_driver only when needed |
---|
107 | ! (i.e. every dt_salsa). |
---|
108 | ! |
---|
109 | ! 3924 2019-04-23 09:33:06Z monakurppa |
---|
110 | ! Correct a bug introduced by the previous update. |
---|
111 | ! |
---|
112 | ! 3899 2019-04-16 14:05:27Z monakurppa |
---|
113 | ! - remove unnecessary error / location messages |
---|
114 | ! - corrected some error message numbers |
---|
115 | ! - allocate source arrays only if emissions or dry deposition is applied. |
---|
116 | ! |
---|
117 | ! 3885 2019-04-11 11:29:34Z kanani |
---|
118 | ! Changes related to global restructuring of location messages and introduction |
---|
119 | ! of additional debug messages |
---|
120 | ! |
---|
121 | ! 3876 2019-04-08 18:41:49Z knoop |
---|
122 | ! Introduced salsa_actions module interface |
---|
123 | ! |
---|
124 | ! 3871 2019-04-08 14:38:39Z knoop |
---|
125 | ! Major changes in formatting, performance and data input structure (see branch |
---|
126 | ! the history for details) |
---|
127 | ! - Time-dependent emissions enabled: lod=1 for yearly PM emissions that are |
---|
128 | ! normalised depending on the time, and lod=2 for preprocessed emissions |
---|
129 | ! (similar to the chemistry module). |
---|
130 | ! - Additionally, 'uniform' emissions allowed. This emission is set constant on |
---|
131 | ! all horisontal upward facing surfaces and it is created based on parameters |
---|
132 | ! surface_aerosol_flux, aerosol_flux_dpg/sigmag/mass_fracs_a/mass_fracs_b. |
---|
133 | ! - All emissions are now implemented as surface fluxes! No 3D sources anymore. |
---|
134 | ! - Update the emission information by calling salsa_emission_update if |
---|
135 | ! skip_time_do_salsa >= time_since_reference_point and |
---|
136 | ! next_aero_emission_update <= time_since_reference_point |
---|
137 | ! - Aerosol background concentrations read from PIDS_DYNAMIC. The vertical grid |
---|
138 | ! must match the one applied in the model. |
---|
139 | ! - Gas emissions and background concentrations can be also read in in salsa_mod |
---|
140 | ! if the chemistry module is not applied. |
---|
141 | ! - In deposition, information on the land use type can be now imported from |
---|
142 | ! the land use model |
---|
143 | ! - Use SI units in PARIN, i.e. n_lognorm given in #/m3 and dpg in metres. |
---|
144 | ! - Apply 100 character line limit |
---|
145 | ! - Change all variable names from capital to lowercase letter |
---|
146 | ! - Change real exponents to integer if possible. If not, precalculate the value |
---|
147 | ! value of exponent |
---|
148 | ! - Rename in1a to start_subrange_1a, fn2a to end_subrange_1a etc. |
---|
149 | ! - Rename nbins --> nbins_aerosol, ncc_tot --> ncomponents_mass and ngast --> |
---|
150 | ! ngases_salsa |
---|
151 | ! - Rename ibc to index_bc, idu to index_du etc. |
---|
152 | ! - Renamed loop indices b, c and sg to ib, ic and ig |
---|
153 | ! - run_salsa subroutine removed |
---|
154 | ! - Corrected a bud in salsa_driver: falsely applied ino instead of inh |
---|
155 | ! - Call salsa_tendency within salsa_prognostic_equations which is called in |
---|
156 | ! module_interface_mod instead of prognostic_equations_mod |
---|
157 | ! - Removed tailing white spaces and unused variables |
---|
158 | ! - Change error message to start by PA instead of SA |
---|
159 | ! |
---|
160 | ! 3833 2019-03-28 15:04:04Z forkel |
---|
161 | ! added USE chem_gasphase_mod for nvar, nspec and spc_names |
---|
162 | ! |
---|
163 | ! 3787 2019-03-07 08:43:54Z raasch |
---|
164 | ! unused variables removed |
---|
165 | ! |
---|
166 | ! 3780 2019-03-05 11:19:45Z forkel |
---|
167 | ! unused variable for file index removed from rrd-subroutines parameter list |
---|
168 | ! |
---|
169 | ! 3685 2019-01-21 01:02:11Z knoop |
---|
170 | ! Some interface calls moved to module_interface + cleanup |
---|
171 | ! |
---|
172 | ! 3655 2019-01-07 16:51:22Z knoop |
---|
173 | ! Implementation of the PALM module interface |
---|
174 | ! 3412 2018-10-24 07:25:57Z monakurppa |
---|
175 | ! |
---|
176 | ! Authors: |
---|
177 | ! -------- |
---|
178 | ! @author Mona Kurppa (University of Helsinki) |
---|
179 | ! |
---|
180 | ! |
---|
181 | ! Description: |
---|
182 | ! ------------ |
---|
183 | !> Sectional aerosol module for large scale applications SALSA |
---|
184 | !> (Kokkola et al., 2008, ACP 8, 2469-2483). Solves the aerosol number and mass |
---|
185 | !> concentration as well as chemical composition. Includes aerosol dynamic |
---|
186 | !> processes: nucleation, condensation/evaporation of vapours, coagulation and |
---|
187 | !> deposition on tree leaves, ground and roofs. |
---|
188 | !> Implementation is based on formulations implemented in UCLALES-SALSA except |
---|
189 | !> for deposition which is based on parametrisations by Zhang et al. (2001, |
---|
190 | !> Atmos. Environ. 35, 549-560) or Petroff&Zhang (2010, Geosci. Model Dev. 3, |
---|
191 | !> 753-769) |
---|
192 | !> |
---|
193 | !> @todo Apply information from emission_stack_height to lift emission sources |
---|
194 | !> @todo emission mode "parameterized", i.e. based on street type |
---|
195 | !> @todo Allow insoluble emissions |
---|
196 | !> @todo Apply flux limiter in prognostic equations |
---|
197 | !------------------------------------------------------------------------------! |
---|
198 | MODULE salsa_mod |
---|
199 | |
---|
200 | USE basic_constants_and_equations_mod, & |
---|
201 | ONLY: c_p, g, p_0, pi, r_d |
---|
202 | |
---|
203 | USE chem_gasphase_mod, & |
---|
204 | ONLY: nspec, nvar, spc_names |
---|
205 | |
---|
206 | USE chem_modules, & |
---|
207 | ONLY: call_chem_at_all_substeps, chem_gasphase_on, chem_species |
---|
208 | |
---|
209 | USE control_parameters, & |
---|
210 | ONLY: air_chemistry, bc_dirichlet_l, bc_dirichlet_n, bc_dirichlet_r, bc_dirichlet_s, & |
---|
211 | bc_lr, bc_lr_cyc, bc_ns, bc_ns_cyc, bc_radiation_l, bc_radiation_n, bc_radiation_r, & |
---|
212 | bc_radiation_s, coupling_char, debug_output, dt_3d, intermediate_timestep_count, & |
---|
213 | intermediate_timestep_count_max, land_surface, max_pr_salsa, message_string, & |
---|
214 | monotonic_limiter_z, plant_canopy, pt_surface, salsa, scalar_advec, & |
---|
215 | surface_pressure, time_since_reference_point, timestep_scheme, tsc, urban_surface, & |
---|
216 | ws_scheme_sca |
---|
217 | |
---|
218 | USE indices, & |
---|
219 | ONLY: nbgp, nx, nxl, nxlg, nxr, nxrg, ny, nyn, nyng, nys, nysg, nzb, nz, nzt, wall_flags_0 |
---|
220 | |
---|
221 | USE kinds |
---|
222 | |
---|
223 | USE netcdf_data_input_mod, & |
---|
224 | ONLY: chem_emis_att_type, chem_emis_val_type |
---|
225 | |
---|
226 | USE pegrid |
---|
227 | |
---|
228 | USE statistics, & |
---|
229 | ONLY: sums_salsa_ws_l |
---|
230 | |
---|
231 | IMPLICIT NONE |
---|
232 | ! |
---|
233 | !-- SALSA constants: |
---|
234 | ! |
---|
235 | !-- Local constants: |
---|
236 | INTEGER(iwp), PARAMETER :: luc_urban = 15 !< default landuse type for urban |
---|
237 | INTEGER(iwp), PARAMETER :: ngases_salsa = 5 !< total number of gaseous tracers: |
---|
238 | !< 1 = H2SO4, 2 = HNO3, 3 = NH3, 4 = OCNV |
---|
239 | !< (non-volatile OC), 5 = OCSV (semi-volatile) |
---|
240 | INTEGER(iwp), PARAMETER :: nmod = 7 !< number of modes for initialising the aerosol size |
---|
241 | !< distribution |
---|
242 | INTEGER(iwp), PARAMETER :: nreg = 2 !< Number of main size subranges |
---|
243 | INTEGER(iwp), PARAMETER :: maxspec = 7 !< Max. number of aerosol species |
---|
244 | INTEGER(iwp), PARAMETER :: season = 1 !< For dry depostion by Zhang et al.: 1 = summer, |
---|
245 | !< 2 = autumn (no harvest yet), 3 = late autumn |
---|
246 | !< (already frost), 4 = winter, 5 = transitional spring |
---|
247 | |
---|
248 | REAL(wp), PARAMETER :: fill_value = -9999.0_wp !< value for the _FillValue attribute |
---|
249 | ! |
---|
250 | !-- Universal constants |
---|
251 | REAL(wp), PARAMETER :: abo = 1.380662E-23_wp !< Boltzmann constant (J/K) |
---|
252 | REAL(wp), PARAMETER :: alv = 2.260E+6_wp !< latent heat for H2O |
---|
253 | !< vaporisation (J/kg) |
---|
254 | REAL(wp), PARAMETER :: alv_d_rv = 4896.96865_wp !< alv / rv |
---|
255 | REAL(wp), PARAMETER :: am_airmol = 4.8096E-26_wp !< Average mass of one air |
---|
256 | !< molecule (Jacobson, |
---|
257 | !< 2005, Eq. 2.3) |
---|
258 | REAL(wp), PARAMETER :: api6 = 0.5235988_wp !< pi / 6 |
---|
259 | REAL(wp), PARAMETER :: argas = 8.314409_wp !< Gas constant (J/(mol K)) |
---|
260 | REAL(wp), PARAMETER :: argas_d_cpd = 8.281283865E-3_wp !< argas per cpd |
---|
261 | REAL(wp), PARAMETER :: avo = 6.02214E+23_wp !< Avogadro constant (1/mol) |
---|
262 | REAL(wp), PARAMETER :: d_sa = 5.539376964394570E-10_wp !< diameter of condensing sulphuric |
---|
263 | !< acid molecule (m) |
---|
264 | REAL(wp), PARAMETER :: for_ppm_to_nconc = 7.243016311E+16_wp !< ppm * avo / R (K/(Pa*m3)) |
---|
265 | REAL(wp), PARAMETER :: epsoc = 0.15_wp !< water uptake of organic |
---|
266 | !< material |
---|
267 | REAL(wp), PARAMETER :: mclim = 1.0E-23_wp !< mass concentration min limit (kg/m3) |
---|
268 | REAL(wp), PARAMETER :: n3 = 158.79_wp !< Number of H2SO4 molecules in 3 nm cluster |
---|
269 | !< if d_sa=5.54e-10m |
---|
270 | REAL(wp), PARAMETER :: nclim = 1.0_wp !< number concentration min limit (#/m3) |
---|
271 | REAL(wp), PARAMETER :: surfw0 = 0.073_wp !< surface tension of water at 293 K (J/m2) |
---|
272 | ! |
---|
273 | !-- Molar masses in kg/mol |
---|
274 | REAL(wp), PARAMETER :: ambc = 12.0E-3_wp !< black carbon (BC) |
---|
275 | REAL(wp), PARAMETER :: amdair = 28.970E-3_wp !< dry air |
---|
276 | REAL(wp), PARAMETER :: amdu = 100.E-3_wp !< mineral dust |
---|
277 | REAL(wp), PARAMETER :: amh2o = 18.0154E-3_wp !< H2O |
---|
278 | REAL(wp), PARAMETER :: amh2so4 = 98.06E-3_wp !< H2SO4 |
---|
279 | REAL(wp), PARAMETER :: amhno3 = 63.01E-3_wp !< HNO3 |
---|
280 | REAL(wp), PARAMETER :: amn2o = 44.013E-3_wp !< N2O |
---|
281 | REAL(wp), PARAMETER :: amnh3 = 17.031E-3_wp !< NH3 |
---|
282 | REAL(wp), PARAMETER :: amo2 = 31.9988E-3_wp !< O2 |
---|
283 | REAL(wp), PARAMETER :: amo3 = 47.998E-3_wp !< O3 |
---|
284 | REAL(wp), PARAMETER :: amoc = 150.E-3_wp !< organic carbon (OC) |
---|
285 | REAL(wp), PARAMETER :: amss = 58.44E-3_wp !< sea salt (NaCl) |
---|
286 | ! |
---|
287 | !-- Densities in kg/m3 |
---|
288 | REAL(wp), PARAMETER :: arhobc = 2000.0_wp !< black carbon |
---|
289 | REAL(wp), PARAMETER :: arhodu = 2650.0_wp !< mineral dust |
---|
290 | REAL(wp), PARAMETER :: arhoh2o = 1000.0_wp !< H2O |
---|
291 | REAL(wp), PARAMETER :: arhoh2so4 = 1830.0_wp !< SO4 |
---|
292 | REAL(wp), PARAMETER :: arhohno3 = 1479.0_wp !< HNO3 |
---|
293 | REAL(wp), PARAMETER :: arhonh3 = 1530.0_wp !< NH3 |
---|
294 | REAL(wp), PARAMETER :: arhooc = 2000.0_wp !< organic carbon |
---|
295 | REAL(wp), PARAMETER :: arhoss = 2165.0_wp !< sea salt (NaCl) |
---|
296 | ! |
---|
297 | !-- Volume of molecule in m3/# |
---|
298 | REAL(wp), PARAMETER :: amvh2o = amh2o /avo / arhoh2o !< H2O |
---|
299 | REAL(wp), PARAMETER :: amvh2so4 = amh2so4 / avo / arhoh2so4 !< SO4 |
---|
300 | REAL(wp), PARAMETER :: amvhno3 = amhno3 / avo / arhohno3 !< HNO3 |
---|
301 | REAL(wp), PARAMETER :: amvnh3 = amnh3 / avo / arhonh3 !< NH3 |
---|
302 | REAL(wp), PARAMETER :: amvoc = amoc / avo / arhooc !< OC |
---|
303 | REAL(wp), PARAMETER :: amvss = amss / avo / arhoss !< sea salt |
---|
304 | ! |
---|
305 | !-- Constants for the dry deposition model by Petroff and Zhang (2010): |
---|
306 | !-- obstacle characteristic dimension "L" (cm) (plane obstacle by default) and empirical constants |
---|
307 | !-- C_B, C_IN, C_IM, beta_IM and C_IT for each land use category (15, as in Zhang et al. (2001)) |
---|
308 | REAL(wp), DIMENSION(1:15), PARAMETER :: l_p10 = & |
---|
309 | (/0.15, 4.0, 0.15, 3.0, 3.0, 0.5, 3.0, -99., 0.5, 2.0, 1.0, -99., -99., -99., 3.0/) |
---|
310 | REAL(wp), DIMENSION(1:15), PARAMETER :: c_b_p10 = & |
---|
311 | (/0.887, 1.262, 0.887, 1.262, 1.262, 0.996, 0.996, -99., 0.7, 0.93, 0.996, -99., -99., -99., 1.262/) |
---|
312 | REAL(wp), DIMENSION(1:15), PARAMETER :: c_in_p10 = & |
---|
313 | (/0.81, 0.216, 0.81, 0.216, 0.216, 0.191, 0.162, -99., 0.7, 0.14, 0.162, -99., -99., -99., 0.216/) |
---|
314 | REAL(wp), DIMENSION(1:15), PARAMETER :: c_im_p10 = & |
---|
315 | (/0.162, 0.13, 0.162, 0.13, 0.13, 0.191, 0.081, -99., 0.191,0.086,0.081, -99., -99., -99., 0.13/) |
---|
316 | REAL(wp), DIMENSION(1:15), PARAMETER :: beta_im_p10 = & |
---|
317 | (/0.6, 0.47, 0.6, 0.47, 0.47, 0.47, 0.47, -99., 0.6, 0.47, 0.47, -99., -99., -99., 0.47/) |
---|
318 | REAL(wp), DIMENSION(1:15), PARAMETER :: c_it_p10 = & |
---|
319 | (/0.0, 0.056, 0.0, 0.056, 0.056, 0.042, 0.056, -99., 0.042,0.014,0.056, -99., -99., -99., 0.056/) |
---|
320 | ! |
---|
321 | !-- Constants for the dry deposition model by Zhang et al. (2001): |
---|
322 | !-- empirical constants "alpha" and "gamma" and characteristic radius "A" for |
---|
323 | !-- each land use category (15) and season (5) |
---|
324 | REAL(wp), DIMENSION(1:15), PARAMETER :: alpha_z01 = & |
---|
325 | (/1.0, 0.6, 1.1, 0.8, 0.8, 1.2, 1.2, 50.0, 50.0, 1.3, 2.0, 50.0, 100.0, 100.0, 1.5/) |
---|
326 | REAL(wp), DIMENSION(1:15), PARAMETER :: gamma_z01 = & |
---|
327 | (/0.56, 0.58, 0.56, 0.56, 0.56, 0.54, 0.54, 0.54, 0.54, 0.54, 0.54, 0.54, 0.50, 0.50, 0.56/) |
---|
328 | REAL(wp), DIMENSION(1:15,1:5), PARAMETER :: A_z01 = RESHAPE( (/& |
---|
329 | 2.0, 5.0, 2.0, 5.0, 5.0, 2.0, 2.0, -99., -99., 10.0, 10.0, -99., -99., -99., 10.0,& ! SC1 |
---|
330 | 2.0, 5.0, 2.0, 5.0, 5.0, 2.0, 2.0, -99., -99., 10.0, 10.0, -99., -99., -99., 10.0,& ! SC2 |
---|
331 | 2.0, 5.0, 5.0, 10.0, 5.0, 5.0, 5.0, -99., -99., 10.0, 10.0, -99., -99., -99., 10.0,& ! SC3 |
---|
332 | 2.0, 5.0, 5.0, 10.0, 5.0, 5.0, 5.0, -99., -99., 10.0, 10.0, -99., -99., -99., 10.0,& ! SC4 |
---|
333 | 2.0, 5.0, 2.0, 5.0, 5.0, 2.0, 2.0, -99., -99., 10.0, 10.0, -99., -99., -99., 10.0 & ! SC5 |
---|
334 | /), (/ 15, 5 /) ) |
---|
335 | !-- Land use categories (based on Z01 but the same applies here also for P10): |
---|
336 | !-- 1 = evergreen needleleaf trees, |
---|
337 | !-- 2 = evergreen broadleaf trees, |
---|
338 | !-- 3 = deciduous needleleaf trees, |
---|
339 | !-- 4 = deciduous broadleaf trees, |
---|
340 | !-- 5 = mixed broadleaf and needleleaf trees (deciduous broadleaf trees for P10), |
---|
341 | !-- 6 = grass (short grass for P10), |
---|
342 | !-- 7 = crops, mixed farming, |
---|
343 | !-- 8 = desert, |
---|
344 | !-- 9 = tundra, |
---|
345 | !-- 10 = shrubs and interrupted woodlands (thorn shrubs for P10), |
---|
346 | !-- 11 = wetland with plants (long grass for P10) |
---|
347 | !-- 12 = ice cap and glacier, |
---|
348 | !-- 13 = inland water (inland lake for P10) |
---|
349 | !-- 14 = ocean (water for P10), |
---|
350 | !-- 15 = urban |
---|
351 | ! |
---|
352 | !-- SALSA variables: |
---|
353 | CHARACTER(LEN=20) :: bc_salsa_b = 'neumann' !< bottom boundary condition |
---|
354 | CHARACTER(LEN=20) :: bc_salsa_t = 'neumann' !< top boundary condition |
---|
355 | CHARACTER(LEN=20) :: depo_pcm_par = 'zhang2001' !< or 'petroff2010' |
---|
356 | CHARACTER(LEN=20) :: depo_pcm_type = 'deciduous_broadleaf' !< leaf type |
---|
357 | CHARACTER(LEN=20) :: depo_surf_par = 'zhang2001' !< or 'petroff2010' |
---|
358 | CHARACTER(LEN=100) :: input_file_dynamic = 'PIDS_DYNAMIC' !< file name for dynamic input |
---|
359 | CHARACTER(LEN=100) :: input_file_salsa = 'PIDS_SALSA' !< file name for emission data |
---|
360 | CHARACTER(LEN=20) :: salsa_emission_mode = 'no_emission' !< 'no_emission', 'uniform', |
---|
361 | !< 'parameterized', 'read_from_file' |
---|
362 | |
---|
363 | CHARACTER(LEN=20), DIMENSION(4) :: decycle_method_salsa = & |
---|
364 | (/'dirichlet','dirichlet','dirichlet','dirichlet'/) |
---|
365 | !< Decycling method at horizontal boundaries |
---|
366 | !< 1=left, 2=right, 3=south, 4=north |
---|
367 | !< dirichlet = initial profiles for the ghost and first 3 layers |
---|
368 | !< neumann = zero gradient |
---|
369 | |
---|
370 | CHARACTER(LEN=3), DIMENSION(maxspec) :: listspec = & !< Active aerosols |
---|
371 | (/'SO4',' ',' ',' ',' ',' ',' '/) |
---|
372 | |
---|
373 | INTEGER(iwp) :: depo_pcm_par_num = 1 !< parametrisation type: 1=zhang2001, 2=petroff2010 |
---|
374 | INTEGER(iwp) :: depo_pcm_type_num = 0 !< index for the dry deposition type on the plant canopy |
---|
375 | INTEGER(iwp) :: depo_surf_par_num = 1 !< parametrisation type: 1=zhang2001, 2=petroff2010 |
---|
376 | INTEGER(iwp) :: dots_salsa = 0 !< starting index for salsa-timeseries |
---|
377 | INTEGER(iwp) :: end_subrange_1a = 1 !< last index for bin subrange 1a |
---|
378 | INTEGER(iwp) :: end_subrange_2a = 1 !< last index for bin subrange 2a |
---|
379 | INTEGER(iwp) :: end_subrange_2b = 1 !< last index for bin subrange 2b |
---|
380 | INTEGER(iwp) :: ibc_salsa_b !< index for the bottom boundary condition |
---|
381 | INTEGER(iwp) :: ibc_salsa_t !< index for the top boundary condition |
---|
382 | INTEGER(iwp) :: index_bc = -1 !< index for black carbon (BC) |
---|
383 | INTEGER(iwp) :: index_du = -1 !< index for dust |
---|
384 | INTEGER(iwp) :: index_nh = -1 !< index for NH3 |
---|
385 | INTEGER(iwp) :: index_no = -1 !< index for HNO3 |
---|
386 | INTEGER(iwp) :: index_oc = -1 !< index for organic carbon (OC) |
---|
387 | INTEGER(iwp) :: index_so4 = -1 !< index for SO4 or H2SO4 |
---|
388 | INTEGER(iwp) :: index_ss = -1 !< index for sea salt |
---|
389 | INTEGER(iwp) :: init_aerosol_type = 0 !< Initial size distribution type |
---|
390 | !< 0 = uniform (read from PARIN) |
---|
391 | !< 1 = read vertical profile of the mode number |
---|
392 | !< concentration from an input file |
---|
393 | INTEGER(iwp) :: init_gases_type = 0 !< Initial gas concentration type |
---|
394 | !< 0 = uniform (read from PARIN) |
---|
395 | !< 1 = read vertical profile from an input file |
---|
396 | INTEGER(iwp) :: lod_gas_emissions = 0 !< level of detail of the gaseous emission data |
---|
397 | INTEGER(iwp) :: main_street_id = 0 !< lower bound of main street IDs (OpenStreetMaps) for parameterized mode |
---|
398 | INTEGER(iwp) :: max_street_id = 0 !< upper bound of main street IDs (OpenStreetMaps) for parameterized mode |
---|
399 | INTEGER(iwp) :: nbins_aerosol = 1 !< total number of size bins |
---|
400 | INTEGER(iwp) :: ncc = 1 !< number of chemical components used |
---|
401 | INTEGER(iwp) :: ncomponents_mass = 1 !< total number of chemical compounds (ncc+1) |
---|
402 | !< if particle water is advected) |
---|
403 | INTEGER(iwp) :: nj3 = 1 !< J3 parametrization (nucleation) |
---|
404 | !< 1 = condensational sink (Kerminen&Kulmala, 2002) |
---|
405 | !< 2 = coagulational sink (Lehtinen et al. 2007) |
---|
406 | !< 3 = coagS+self-coagulation (Anttila et al. 2010) |
---|
407 | INTEGER(iwp) :: nsnucl = 0 !< Choice of the nucleation scheme: |
---|
408 | !< 0 = off |
---|
409 | !< 1 = binary nucleation |
---|
410 | !< 2 = activation type nucleation |
---|
411 | !< 3 = kinetic nucleation |
---|
412 | !< 4 = ternary nucleation |
---|
413 | !< 5 = nucleation with ORGANICs |
---|
414 | !< 6 = activation type of nucleation with H2SO4+ORG |
---|
415 | !< 7 = heteromolecular nucleation with H2SO4*ORG |
---|
416 | !< 8 = homomolecular nucleation of H2SO4 |
---|
417 | !< + heteromolecular nucleation with H2SO4*ORG |
---|
418 | !< 9 = homomolecular nucleation of H2SO4 and ORG |
---|
419 | !< + heteromolecular nucleation with H2SO4*ORG |
---|
420 | INTEGER(iwp) :: salsa_pr_count = 0 !< counter for salsa variable profiles |
---|
421 | INTEGER(iwp) :: side_street_id = 0 !< lower bound of side street IDs (OpenStreetMaps) for parameterized mode |
---|
422 | INTEGER(iwp) :: start_subrange_1a = 1 !< start index for bin subranges: subrange 1a |
---|
423 | INTEGER(iwp) :: start_subrange_2a = 1 !< subrange 2a |
---|
424 | INTEGER(iwp) :: start_subrange_2b = 1 !< subrange 2b |
---|
425 | |
---|
426 | INTEGER(iwp), DIMENSION(nreg) :: nbin = (/ 3, 7/) !< Number of size bins per subrange: 1 & 2 |
---|
427 | |
---|
428 | INTEGER(iwp), DIMENSION(ngases_salsa) :: gas_index_chem = (/ 1, 1, 1, 1, 1/) !< gas indices in chemistry_model_mod |
---|
429 | !< 1 = H2SO4, 2 = HNO3, |
---|
430 | !< 3 = NH3, 4 = OCNV, 5 = OCSV |
---|
431 | INTEGER(iwp), DIMENSION(ngases_salsa) :: emission_index_chem !< gas indices in the gas emission file |
---|
432 | INTEGER(iwp), DIMENSION(99) :: salsa_pr_index = 0 !< index for salsa profiles |
---|
433 | |
---|
434 | INTEGER(iwp), DIMENSION(:,:), ALLOCATABLE :: k_topo_top !< vertical index of the topography top |
---|
435 | |
---|
436 | INTEGER(iwp), DIMENSION(:,:,:), ALLOCATABLE :: salsa_advc_flags_s !< flags used to degrade order of advection |
---|
437 | !< scheme for salsa variables near walls and |
---|
438 | !< lateral boundaries |
---|
439 | ! |
---|
440 | !-- SALSA switches: |
---|
441 | LOGICAL :: advect_particle_water = .TRUE. !< Advect water concentration of particles |
---|
442 | LOGICAL :: decycle_salsa_lr = .FALSE. !< Undo cyclic boundaries: left and right |
---|
443 | LOGICAL :: decycle_salsa_ns = .FALSE. !< Undo cyclic boundaries: north and south |
---|
444 | LOGICAL :: include_emission = .FALSE. !< Include or not emissions |
---|
445 | LOGICAL :: feedback_to_palm = .FALSE. !< Allow feedback due to condensation of H2O |
---|
446 | LOGICAL :: nest_salsa = .FALSE. !< Apply nesting for salsa |
---|
447 | LOGICAL :: no_insoluble = .FALSE. !< Exclude insoluble chemical components |
---|
448 | LOGICAL :: read_restart_data_salsa = .FALSE. !< Read restart data for salsa |
---|
449 | LOGICAL :: salsa_gases_from_chem = .FALSE. !< Transfer the gaseous components to SALSA from |
---|
450 | !< the chemistry model |
---|
451 | LOGICAL :: van_der_waals_coagc = .FALSE. !< Enhancement of coagulation kernel by van der |
---|
452 | !< Waals and viscous forces |
---|
453 | LOGICAL :: write_binary_salsa = .FALSE. !< read binary for salsa |
---|
454 | ! |
---|
455 | !-- Process switches: nl* is read from the NAMELIST and is NOT changed. |
---|
456 | !-- ls* is the switch used and will get the value of nl* |
---|
457 | !-- except for special circumstances (spinup period etc.) |
---|
458 | LOGICAL :: nlcoag = .FALSE. !< Coagulation master switch |
---|
459 | LOGICAL :: lscoag = .FALSE. !< |
---|
460 | LOGICAL :: nlcnd = .FALSE. !< Condensation master switch |
---|
461 | LOGICAL :: lscnd = .FALSE. !< |
---|
462 | LOGICAL :: nlcndgas = .FALSE. !< Condensation of precursor gases |
---|
463 | LOGICAL :: lscndgas = .FALSE. !< |
---|
464 | LOGICAL :: nlcndh2oae = .FALSE. !< Condensation of H2O on aerosol |
---|
465 | LOGICAL :: lscndh2oae = .FALSE. !< particles (FALSE -> equilibrium calc.) |
---|
466 | LOGICAL :: nldepo = .FALSE. !< Deposition master switch |
---|
467 | LOGICAL :: lsdepo = .FALSE. !< |
---|
468 | LOGICAL :: nldepo_surf = .FALSE. !< Deposition on vegetation master switch |
---|
469 | LOGICAL :: lsdepo_surf = .FALSE. !< |
---|
470 | LOGICAL :: nldepo_pcm = .FALSE. !< Deposition on walls master switch |
---|
471 | LOGICAL :: lsdepo_pcm = .FALSE. !< |
---|
472 | LOGICAL :: nldistupdate = .TRUE. !< Size distribution update master switch |
---|
473 | LOGICAL :: lsdistupdate = .FALSE. !< |
---|
474 | LOGICAL :: lspartition = .FALSE. !< Partition of HNO3 and NH3 |
---|
475 | |
---|
476 | REAL(wp) :: act_coeff = 1.0E-7_wp !< Activation coefficient (1/s) |
---|
477 | REAL(wp) :: dt_salsa = 0.00001_wp !< Time step of SALSA |
---|
478 | REAL(wp) :: emiss_factor_main = 0.0_wp !< relative emission factor for main streets |
---|
479 | REAL(wp) :: emiss_factor_side = 0.0_wp !< relative emission factor for side streets |
---|
480 | REAL(wp) :: h2so4_init = nclim !< Init value for sulphuric acid gas |
---|
481 | REAL(wp) :: hno3_init = nclim !< Init value for nitric acid gas |
---|
482 | REAL(wp) :: last_salsa_time = 0.0_wp !< previous salsa call |
---|
483 | REAL(wp) :: next_aero_emission_update = 0.0_wp !< previous emission update |
---|
484 | REAL(wp) :: next_gas_emission_update = 0.0_wp !< previous emission update |
---|
485 | REAL(wp) :: nf2a = 1.0_wp !< Number fraction allocated to 2a-bins |
---|
486 | REAL(wp) :: nh3_init = nclim !< Init value for ammonia gas |
---|
487 | REAL(wp) :: ocnv_init = nclim !< Init value for non-volatile organic gases |
---|
488 | REAL(wp) :: ocsv_init = nclim !< Init value for semi-volatile organic gases |
---|
489 | REAL(wp) :: rhlim = 1.20_wp !< RH limit in %/100. Prevents unrealistical RH |
---|
490 | REAL(wp) :: skip_time_do_salsa = 0.0_wp !< Starting time of SALSA (s) |
---|
491 | ! |
---|
492 | !-- Initial log-normal size distribution: mode diameter (dpg, metres), |
---|
493 | !-- standard deviation (sigmag) and concentration (n_lognorm, #/m3) |
---|
494 | REAL(wp), DIMENSION(nmod) :: dpg = & |
---|
495 | (/1.3E-8_wp, 5.4E-8_wp, 8.6E-7_wp, 2.0E-7_wp, 2.0E-7_wp, 2.0E-7_wp, 2.0E-7_wp/) |
---|
496 | REAL(wp), DIMENSION(nmod) :: sigmag = & |
---|
497 | (/1.8_wp, 2.16_wp, 2.21_wp, 2.0_wp, 2.0_wp, 2.0_wp, 2.0_wp/) |
---|
498 | REAL(wp), DIMENSION(nmod) :: n_lognorm = & |
---|
499 | (/1.04e+11_wp, 3.23E+10_wp, 5.4E+6_wp, 0.0_wp, 0.0_wp, 0.0_wp, 0.0_wp/) |
---|
500 | ! |
---|
501 | !-- Initial mass fractions / chemical composition of the size distribution |
---|
502 | REAL(wp), DIMENSION(maxspec) :: mass_fracs_a = & !< mass fractions between |
---|
503 | (/1.0, 0.0, 0.0, 0.0, 0.0, 0.0, 0.0/) !< aerosol species for A bins |
---|
504 | REAL(wp), DIMENSION(maxspec) :: mass_fracs_b = & !< mass fractions between |
---|
505 | (/0.0, 0.0, 0.0, 0.0, 0.0, 0.0, 0.0/) !< aerosol species for B bins |
---|
506 | REAL(wp), DIMENSION(nreg+1) :: reglim = & !< Min&max diameters of size subranges |
---|
507 | (/ 3.0E-9_wp, 5.0E-8_wp, 1.0E-5_wp/) |
---|
508 | ! |
---|
509 | !-- Initial log-normal size distribution: mode diameter (dpg, metres), standard deviation (sigmag) |
---|
510 | !-- concentration (n_lognorm, #/m3) and mass fractions of all chemical components (listed in |
---|
511 | !-- listspec) for both a (soluble) and b (insoluble) bins. |
---|
512 | REAL(wp), DIMENSION(nmod) :: aerosol_flux_dpg = & |
---|
513 | (/1.3E-8_wp, 5.4E-8_wp, 8.6E-7_wp, 2.0E-7_wp, 2.0E-7_wp, 2.0E-7_wp, 2.0E-7_wp/) |
---|
514 | REAL(wp), DIMENSION(nmod) :: aerosol_flux_sigmag = & |
---|
515 | (/1.8_wp, 2.16_wp, 2.21_wp, 2.0_wp, 2.0_wp, 2.0_wp, 2.0_wp/) |
---|
516 | REAL(wp), DIMENSION(maxspec) :: aerosol_flux_mass_fracs_a = & |
---|
517 | (/1.0, 0.0, 0.0, 0.0, 0.0, 0.0, 0.0/) |
---|
518 | REAL(wp), DIMENSION(maxspec) :: aerosol_flux_mass_fracs_b = & |
---|
519 | (/0.0, 0.0, 0.0, 0.0, 0.0, 0.0, 0.0/) |
---|
520 | REAL(wp), DIMENSION(nmod) :: surface_aerosol_flux = & |
---|
521 | (/1.0E+8_wp, 1.0E+9_wp, 1.0E+5_wp, 0.0_wp, 0.0_wp, 0.0_wp, 0.0_wp/) |
---|
522 | |
---|
523 | REAL(wp), DIMENSION(:), ALLOCATABLE :: bin_low_limits !< to deliver information about |
---|
524 | !< the lower diameters per bin |
---|
525 | REAL(wp), DIMENSION(:), ALLOCATABLE :: bc_am_t_val !< vertical gradient of: aerosol mass |
---|
526 | REAL(wp), DIMENSION(:), ALLOCATABLE :: bc_an_t_val !< of: aerosol number |
---|
527 | REAL(wp), DIMENSION(:), ALLOCATABLE :: bc_gt_t_val !< salsa gases near domain top |
---|
528 | REAL(wp), DIMENSION(:), ALLOCATABLE :: gas_emission_time !< Time array in gas emission data (s) |
---|
529 | REAL(wp), DIMENSION(:), ALLOCATABLE :: nsect !< Background number concentrations |
---|
530 | REAL(wp), DIMENSION(:), ALLOCATABLE :: massacc !< Mass accomodation coefficients |
---|
531 | ! |
---|
532 | !-- SALSA derived datatypes: |
---|
533 | ! |
---|
534 | !-- Component index |
---|
535 | TYPE component_index |
---|
536 | CHARACTER(len=3), ALLOCATABLE :: comp(:) !< Component name |
---|
537 | INTEGER(iwp) :: ncomp !< Number of components |
---|
538 | INTEGER(iwp), ALLOCATABLE :: ind(:) !< Component index |
---|
539 | END TYPE component_index |
---|
540 | ! |
---|
541 | !-- For matching LSM and USM surface types and the deposition module surface types |
---|
542 | TYPE match_surface |
---|
543 | INTEGER(iwp), DIMENSION(:), ALLOCATABLE :: match_lupg !< index for pavement / green roofs |
---|
544 | INTEGER(iwp), DIMENSION(:), ALLOCATABLE :: match_luvw !< index for vegetation / walls |
---|
545 | INTEGER(iwp), DIMENSION(:), ALLOCATABLE :: match_luww !< index for water / windows |
---|
546 | END TYPE match_surface |
---|
547 | ! |
---|
548 | !-- Aerosol emission data attributes |
---|
549 | TYPE salsa_emission_attribute_type |
---|
550 | |
---|
551 | CHARACTER(LEN=25) :: units |
---|
552 | |
---|
553 | CHARACTER(LEN=25), DIMENSION(:), ALLOCATABLE :: cat_name !< |
---|
554 | CHARACTER(LEN=25), DIMENSION(:), ALLOCATABLE :: cc_name !< |
---|
555 | CHARACTER(LEN=25), DIMENSION(:), ALLOCATABLE :: unit_time !< |
---|
556 | CHARACTER(LEN=100), DIMENSION(:), ALLOCATABLE :: var_names !< |
---|
557 | |
---|
558 | INTEGER(iwp) :: lod = 0 !< level of detail |
---|
559 | INTEGER(iwp) :: nbins = 10 !< number of aerosol size bins |
---|
560 | INTEGER(iwp) :: ncat = 0 !< number of emission categories |
---|
561 | INTEGER(iwp) :: ncc = 7 !< number of aerosol chemical components |
---|
562 | INTEGER(iwp) :: nhoursyear = 0 !< number of hours: HOURLY mode |
---|
563 | INTEGER(iwp) :: nmonthdayhour = 0 !< number of month days and hours: MDH mode |
---|
564 | INTEGER(iwp) :: num_vars !< number of variables |
---|
565 | INTEGER(iwp) :: nt = 0 !< number of time steps |
---|
566 | INTEGER(iwp) :: nz = 0 !< number of vertical levels |
---|
567 | INTEGER(iwp) :: tind !< time index for reference time in salsa emission data |
---|
568 | |
---|
569 | INTEGER(iwp), DIMENSION(maxspec) :: cc_in2mod = 0 !< |
---|
570 | |
---|
571 | INTEGER(iwp), DIMENSION(:), ALLOCATABLE :: cat_index !< Index of emission categories |
---|
572 | INTEGER(iwp), DIMENSION(:), ALLOCATABLE :: cc_index !< Index of chemical components |
---|
573 | |
---|
574 | REAL(wp) :: conversion_factor !< unit conversion factor for aerosol emissions |
---|
575 | |
---|
576 | REAL(wp), DIMENSION(:), ALLOCATABLE :: dmid !< mean diameters of size bins (m) |
---|
577 | REAL(wp), DIMENSION(:), ALLOCATABLE :: rho !< average density (kg/m3) |
---|
578 | REAL(wp), DIMENSION(:), ALLOCATABLE :: time !< time (s) |
---|
579 | REAL(wp), DIMENSION(:), ALLOCATABLE :: time_factor !< emission time factor |
---|
580 | REAL(wp), DIMENSION(:), ALLOCATABLE :: z !< height (m) |
---|
581 | |
---|
582 | REAL(wp), DIMENSION(:,:), ALLOCATABLE :: etf !< emission time factor |
---|
583 | REAL(wp), DIMENSION(:,:), ALLOCATABLE :: stack_height |
---|
584 | |
---|
585 | END TYPE salsa_emission_attribute_type |
---|
586 | ! |
---|
587 | !-- The default size distribution and mass composition per emission category: |
---|
588 | !-- 1 = traffic, 2 = road dust, 3 = wood combustion, 4 = other |
---|
589 | !-- Mass fractions: H2SO4, OC, BC, DU, SS, HNO3, NH3 |
---|
590 | TYPE salsa_emission_mode_type |
---|
591 | |
---|
592 | INTEGER(iwp) :: ndm = 3 !< number of default modes |
---|
593 | INTEGER(iwp) :: ndc = 4 !< number of default categories |
---|
594 | |
---|
595 | CHARACTER(LEN=25), DIMENSION(1:4) :: cat_name_table = (/'traffic exhaust', & |
---|
596 | 'road dust ', & |
---|
597 | 'wood combustion', & |
---|
598 | 'other '/) |
---|
599 | |
---|
600 | INTEGER(iwp), DIMENSION(1:4) :: cat_input_to_model !< |
---|
601 | |
---|
602 | REAL(wp), DIMENSION(1:3) :: dpg_table = (/ 13.5E-9_wp, 1.4E-6_wp, 5.4E-8_wp/) !< |
---|
603 | REAL(wp), DIMENSION(1:3) :: ntot_table !< |
---|
604 | REAL(wp), DIMENSION(1:3) :: sigmag_table = (/ 1.6_wp, 1.4_wp, 1.7_wp /) !< |
---|
605 | |
---|
606 | REAL(wp), DIMENSION(1:maxspec,1:4) :: mass_frac_table = & !< |
---|
607 | RESHAPE( (/ 0.04_wp, 0.48_wp, 0.48_wp, 0.0_wp, 0.0_wp, 0.0_wp, 0.0_wp, & |
---|
608 | 0.0_wp, 0.05_wp, 0.0_wp, 0.95_wp, 0.0_wp, 0.0_wp, 0.0_wp, & |
---|
609 | 0.0_wp, 0.5_wp, 0.5_wp, 0.0_wp, 0.0_wp, 0.0_wp, 0.0_wp, & |
---|
610 | 0.0_wp, 0.5_wp, 0.5_wp, 0.0_wp, 0.0_wp, 0.0_wp, 0.0_wp & |
---|
611 | /), (/maxspec,4/) ) |
---|
612 | |
---|
613 | REAL(wp), DIMENSION(1:3,1:4) :: pm_frac_table = & !< rel. mass |
---|
614 | RESHAPE( (/ 0.016_wp, 0.000_wp, 0.984_wp, & |
---|
615 | 0.000_wp, 1.000_wp, 0.000_wp, & |
---|
616 | 0.000_wp, 0.000_wp, 1.000_wp, & |
---|
617 | 1.000_wp, 0.000_wp, 1.000_wp & |
---|
618 | /), (/3,4/) ) |
---|
619 | |
---|
620 | END TYPE salsa_emission_mode_type |
---|
621 | ! |
---|
622 | !-- Aerosol emission data values |
---|
623 | TYPE salsa_emission_value_type |
---|
624 | |
---|
625 | REAL(wp) :: fill !< fill value |
---|
626 | |
---|
627 | REAL(wp), DIMENSION(:), ALLOCATABLE :: preproc_mass_fracs !< mass fractions |
---|
628 | |
---|
629 | REAL(wp), DIMENSION(:,:), ALLOCATABLE :: def_mass_fracs !< mass fractions per emis. category |
---|
630 | |
---|
631 | REAL(wp), DIMENSION(:,:,:), ALLOCATABLE :: def_data !< surface emission values in PM |
---|
632 | REAL(wp), DIMENSION(:,:,:), ALLOCATABLE :: preproc_data !< surface emission values per bin |
---|
633 | |
---|
634 | END TYPE salsa_emission_value_type |
---|
635 | ! |
---|
636 | !-- Prognostic variable: Aerosol size bin information (number (#/m3) and mass (kg/m3) concentration) |
---|
637 | !-- and the concentration of gaseous tracers (#/m3). Gas tracers are contained sequentially in |
---|
638 | !-- dimension 4 as: |
---|
639 | !-- 1. H2SO4, 2. HNO3, 3. NH3, 4. OCNV (non-volatile organics), 5. OCSV (semi-volatile) |
---|
640 | TYPE salsa_variable |
---|
641 | |
---|
642 | REAL(wp), DIMENSION(:), ALLOCATABLE :: init !< |
---|
643 | |
---|
644 | REAL(wp), DIMENSION(:,:), ALLOCATABLE :: diss_s !< |
---|
645 | REAL(wp), DIMENSION(:,:), ALLOCATABLE :: flux_s !< |
---|
646 | REAL(wp), DIMENSION(:,:), ALLOCATABLE :: source !< |
---|
647 | REAL(wp), DIMENSION(:,:), ALLOCATABLE :: sums_ws_l !< |
---|
648 | |
---|
649 | REAL(wp), DIMENSION(:,:,:), ALLOCATABLE :: diss_l !< |
---|
650 | REAL(wp), DIMENSION(:,:,:), ALLOCATABLE :: flux_l !< |
---|
651 | |
---|
652 | REAL(wp), DIMENSION(:,:,:), POINTER, CONTIGUOUS :: conc !< |
---|
653 | REAL(wp), DIMENSION(:,:,:), POINTER, CONTIGUOUS :: conc_p !< |
---|
654 | REAL(wp), DIMENSION(:,:,:), POINTER, CONTIGUOUS :: tconc_m !< |
---|
655 | |
---|
656 | END TYPE salsa_variable |
---|
657 | ! |
---|
658 | !-- Datatype used to store information about the binned size distributions of aerosols |
---|
659 | TYPE t_section |
---|
660 | |
---|
661 | REAL(wp) :: dmid !< bin middle diameter (m) |
---|
662 | REAL(wp) :: vhilim !< bin volume at the high limit |
---|
663 | REAL(wp) :: vlolim !< bin volume at the low limit |
---|
664 | REAL(wp) :: vratiohi !< volume ratio between the center and high limit |
---|
665 | REAL(wp) :: vratiolo !< volume ratio between the center and low limit |
---|
666 | !****************************************************** |
---|
667 | ! ^ Do NOT change the stuff above after initialization ! |
---|
668 | !****************************************************** |
---|
669 | REAL(wp) :: core !< Volume of dry particle |
---|
670 | REAL(wp) :: dwet !< Wet diameter or mean droplet diameter (m) |
---|
671 | REAL(wp) :: numc !< Number concentration of particles/droplets (#/m3) |
---|
672 | REAL(wp) :: veqh2o !< Equilibrium H2O concentration for each particle |
---|
673 | |
---|
674 | REAL(wp), DIMENSION(maxspec+1) :: volc !< Volume concentrations (m^3/m^3) of aerosols + |
---|
675 | !< water. Since most of the stuff in SALSA is hard |
---|
676 | !< coded, these *have to be* in the order |
---|
677 | !< 1:SO4, 2:OC, 3:BC, 4:DU, 5:SS, 6:NO, 7:NH, 8:H2O |
---|
678 | END TYPE t_section |
---|
679 | |
---|
680 | TYPE(salsa_emission_attribute_type) :: aero_emission_att !< emission attributes |
---|
681 | TYPE(salsa_emission_value_type) :: aero_emission !< emission values |
---|
682 | TYPE(salsa_emission_mode_type) :: def_modes !< default emission modes |
---|
683 | |
---|
684 | TYPE(chem_emis_att_type) :: chem_emission_att !< chemistry emission attributes |
---|
685 | |
---|
686 | TYPE(chem_emis_val_type), DIMENSION(:), ALLOCATABLE :: chem_emission !< chemistry emissions |
---|
687 | |
---|
688 | TYPE(t_section), DIMENSION(:), ALLOCATABLE :: aero !< local aerosol properties |
---|
689 | |
---|
690 | TYPE(match_surface) :: lsm_to_depo_h !< to match the deposition module and horizontal LSM surfaces |
---|
691 | TYPE(match_surface) :: usm_to_depo_h !< to match the deposition module and horizontal USM surfaces |
---|
692 | |
---|
693 | TYPE(match_surface), DIMENSION(0:3) :: lsm_to_depo_v !< to match the deposition mod. and vertical LSM surfaces |
---|
694 | TYPE(match_surface), DIMENSION(0:3) :: usm_to_depo_v !< to match the deposition mod. and vertical USM surfaces |
---|
695 | ! |
---|
696 | !-- SALSA variables: as x = x(k,j,i,bin). |
---|
697 | !-- The 4th dimension contains all the size bins sequentially for each aerosol species + water. |
---|
698 | ! |
---|
699 | !-- Prognostic variables: |
---|
700 | ! |
---|
701 | !-- Number concentration (#/m3) |
---|
702 | TYPE(salsa_variable), DIMENSION(:), ALLOCATABLE, TARGET :: aerosol_number !< |
---|
703 | REAL(wp), DIMENSION(:,:,:,:), ALLOCATABLE, TARGET :: nconc_1 !< |
---|
704 | REAL(wp), DIMENSION(:,:,:,:), ALLOCATABLE, TARGET :: nconc_2 !< |
---|
705 | REAL(wp), DIMENSION(:,:,:,:), ALLOCATABLE, TARGET :: nconc_3 !< |
---|
706 | ! |
---|
707 | !-- Mass concentration (kg/m3) |
---|
708 | TYPE(salsa_variable), DIMENSION(:), ALLOCATABLE, TARGET :: aerosol_mass !< |
---|
709 | REAL(wp), DIMENSION(:,:,:,:), ALLOCATABLE, TARGET :: mconc_1 !< |
---|
710 | REAL(wp), DIMENSION(:,:,:,:), ALLOCATABLE, TARGET :: mconc_2 !< |
---|
711 | REAL(wp), DIMENSION(:,:,:,:), ALLOCATABLE, TARGET :: mconc_3 !< |
---|
712 | ! |
---|
713 | !-- Gaseous concentrations (#/m3) |
---|
714 | TYPE(salsa_variable), DIMENSION(:), ALLOCATABLE, TARGET :: salsa_gas !< |
---|
715 | REAL(wp), DIMENSION(:,:,:,:), ALLOCATABLE, TARGET :: gconc_1 !< |
---|
716 | REAL(wp), DIMENSION(:,:,:,:), ALLOCATABLE, TARGET :: gconc_2 !< |
---|
717 | REAL(wp), DIMENSION(:,:,:,:), ALLOCATABLE, TARGET :: gconc_3 !< |
---|
718 | ! |
---|
719 | !-- Diagnostic tracers |
---|
720 | REAL(wp), DIMENSION(:,:,:,:), ALLOCATABLE :: sedim_vd !< sedimentation velocity per bin (m/s) |
---|
721 | REAL(wp), DIMENSION(:,:,:,:), ALLOCATABLE :: ra_dry !< aerosol dry radius (m) |
---|
722 | |
---|
723 | !-- Particle component index tables |
---|
724 | TYPE(component_index) :: prtcl !< Contains "getIndex" which gives the index for a given aerosol |
---|
725 | !< component name: 1:SO4, 2:OC, 3:BC, 4:DU, 5:SS, 6:NO, 7:NH, 8:H2O |
---|
726 | ! |
---|
727 | !-- Data output arrays: |
---|
728 | ! |
---|
729 | !-- Gases: |
---|
730 | REAL(wp), DIMENSION(:,:,:), ALLOCATABLE, TARGET :: g_h2so4_av !< H2SO4 |
---|
731 | REAL(wp), DIMENSION(:,:,:), ALLOCATABLE, TARGET :: g_hno3_av !< HNO3 |
---|
732 | REAL(wp), DIMENSION(:,:,:), ALLOCATABLE, TARGET :: g_nh3_av !< NH3 |
---|
733 | REAL(wp), DIMENSION(:,:,:), ALLOCATABLE, TARGET :: g_ocnv_av !< non-volatile OC |
---|
734 | REAL(wp), DIMENSION(:,:,:), ALLOCATABLE, TARGET :: g_ocsv_av !< semi-volatile OC |
---|
735 | ! |
---|
736 | !-- Integrated: |
---|
737 | REAL(wp), DIMENSION(:,:,:), ALLOCATABLE, TARGET :: ldsa_av !< lung-deposited surface area |
---|
738 | REAL(wp), DIMENSION(:,:,:), ALLOCATABLE, TARGET :: ntot_av !< total number concentration |
---|
739 | REAL(wp), DIMENSION(:,:,:), ALLOCATABLE, TARGET :: nufp_av !< ultrafine particles (UFP) |
---|
740 | REAL(wp), DIMENSION(:,:,:), ALLOCATABLE, TARGET :: pm01_av !< PM0.1 |
---|
741 | REAL(wp), DIMENSION(:,:,:), ALLOCATABLE, TARGET :: pm25_av !< PM2.5 |
---|
742 | REAL(wp), DIMENSION(:,:,:), ALLOCATABLE, TARGET :: pm10_av !< PM10 |
---|
743 | ! |
---|
744 | !-- In the particle phase: |
---|
745 | REAL(wp), DIMENSION(:,:,:), ALLOCATABLE, TARGET :: s_bc_av !< black carbon |
---|
746 | REAL(wp), DIMENSION(:,:,:), ALLOCATABLE, TARGET :: s_du_av !< dust |
---|
747 | REAL(wp), DIMENSION(:,:,:), ALLOCATABLE, TARGET :: s_h2o_av !< liquid water |
---|
748 | REAL(wp), DIMENSION(:,:,:), ALLOCATABLE, TARGET :: s_nh_av !< ammonia |
---|
749 | REAL(wp), DIMENSION(:,:,:), ALLOCATABLE, TARGET :: s_no_av !< nitrates |
---|
750 | REAL(wp), DIMENSION(:,:,:), ALLOCATABLE, TARGET :: s_oc_av !< org. carbon |
---|
751 | REAL(wp), DIMENSION(:,:,:), ALLOCATABLE, TARGET :: s_so4_av !< sulphates |
---|
752 | REAL(wp), DIMENSION(:,:,:), ALLOCATABLE, TARGET :: s_ss_av !< sea salt |
---|
753 | ! |
---|
754 | !-- Bin specific mass and number concentrations: |
---|
755 | REAL(wp), DIMENSION(:,:,:,:), ALLOCATABLE, TARGET :: mbins_av !< bin mas |
---|
756 | REAL(wp), DIMENSION(:,:,:,:), ALLOCATABLE, TARGET :: nbins_av !< bin number |
---|
757 | |
---|
758 | ! |
---|
759 | !-- PALM interfaces: |
---|
760 | |
---|
761 | INTERFACE salsa_actions |
---|
762 | MODULE PROCEDURE salsa_actions |
---|
763 | MODULE PROCEDURE salsa_actions_ij |
---|
764 | END INTERFACE salsa_actions |
---|
765 | |
---|
766 | INTERFACE salsa_3d_data_averaging |
---|
767 | MODULE PROCEDURE salsa_3d_data_averaging |
---|
768 | END INTERFACE salsa_3d_data_averaging |
---|
769 | |
---|
770 | INTERFACE salsa_boundary_conds |
---|
771 | MODULE PROCEDURE salsa_boundary_conds |
---|
772 | MODULE PROCEDURE salsa_boundary_conds_decycle |
---|
773 | END INTERFACE salsa_boundary_conds |
---|
774 | |
---|
775 | INTERFACE salsa_check_data_output |
---|
776 | MODULE PROCEDURE salsa_check_data_output |
---|
777 | END INTERFACE salsa_check_data_output |
---|
778 | |
---|
779 | INTERFACE salsa_check_data_output_pr |
---|
780 | MODULE PROCEDURE salsa_check_data_output_pr |
---|
781 | END INTERFACE salsa_check_data_output_pr |
---|
782 | |
---|
783 | INTERFACE salsa_check_parameters |
---|
784 | MODULE PROCEDURE salsa_check_parameters |
---|
785 | END INTERFACE salsa_check_parameters |
---|
786 | |
---|
787 | INTERFACE salsa_data_output_2d |
---|
788 | MODULE PROCEDURE salsa_data_output_2d |
---|
789 | END INTERFACE salsa_data_output_2d |
---|
790 | |
---|
791 | INTERFACE salsa_data_output_3d |
---|
792 | MODULE PROCEDURE salsa_data_output_3d |
---|
793 | END INTERFACE salsa_data_output_3d |
---|
794 | |
---|
795 | INTERFACE salsa_data_output_mask |
---|
796 | MODULE PROCEDURE salsa_data_output_mask |
---|
797 | END INTERFACE salsa_data_output_mask |
---|
798 | |
---|
799 | INTERFACE salsa_define_netcdf_grid |
---|
800 | MODULE PROCEDURE salsa_define_netcdf_grid |
---|
801 | END INTERFACE salsa_define_netcdf_grid |
---|
802 | |
---|
803 | INTERFACE salsa_driver |
---|
804 | MODULE PROCEDURE salsa_driver |
---|
805 | END INTERFACE salsa_driver |
---|
806 | |
---|
807 | INTERFACE salsa_emission_update |
---|
808 | MODULE PROCEDURE salsa_emission_update |
---|
809 | END INTERFACE salsa_emission_update |
---|
810 | |
---|
811 | INTERFACE salsa_exchange_horiz_bounds |
---|
812 | MODULE PROCEDURE salsa_exchange_horiz_bounds |
---|
813 | END INTERFACE salsa_exchange_horiz_bounds |
---|
814 | |
---|
815 | INTERFACE salsa_header |
---|
816 | MODULE PROCEDURE salsa_header |
---|
817 | END INTERFACE salsa_header |
---|
818 | |
---|
819 | INTERFACE salsa_init |
---|
820 | MODULE PROCEDURE salsa_init |
---|
821 | END INTERFACE salsa_init |
---|
822 | |
---|
823 | INTERFACE salsa_init_arrays |
---|
824 | MODULE PROCEDURE salsa_init_arrays |
---|
825 | END INTERFACE salsa_init_arrays |
---|
826 | |
---|
827 | INTERFACE salsa_non_advective_processes |
---|
828 | MODULE PROCEDURE salsa_non_advective_processes |
---|
829 | MODULE PROCEDURE salsa_non_advective_processes_ij |
---|
830 | END INTERFACE salsa_non_advective_processes |
---|
831 | |
---|
832 | INTERFACE salsa_parin |
---|
833 | MODULE PROCEDURE salsa_parin |
---|
834 | END INTERFACE salsa_parin |
---|
835 | |
---|
836 | INTERFACE salsa_prognostic_equations |
---|
837 | MODULE PROCEDURE salsa_prognostic_equations |
---|
838 | MODULE PROCEDURE salsa_prognostic_equations_ij |
---|
839 | END INTERFACE salsa_prognostic_equations |
---|
840 | |
---|
841 | INTERFACE salsa_rrd_local |
---|
842 | MODULE PROCEDURE salsa_rrd_local |
---|
843 | END INTERFACE salsa_rrd_local |
---|
844 | |
---|
845 | INTERFACE salsa_statistics |
---|
846 | MODULE PROCEDURE salsa_statistics |
---|
847 | END INTERFACE salsa_statistics |
---|
848 | |
---|
849 | INTERFACE salsa_swap_timelevel |
---|
850 | MODULE PROCEDURE salsa_swap_timelevel |
---|
851 | END INTERFACE salsa_swap_timelevel |
---|
852 | |
---|
853 | INTERFACE salsa_tendency |
---|
854 | MODULE PROCEDURE salsa_tendency |
---|
855 | MODULE PROCEDURE salsa_tendency_ij |
---|
856 | END INTERFACE salsa_tendency |
---|
857 | |
---|
858 | INTERFACE salsa_wrd_local |
---|
859 | MODULE PROCEDURE salsa_wrd_local |
---|
860 | END INTERFACE salsa_wrd_local |
---|
861 | |
---|
862 | |
---|
863 | SAVE |
---|
864 | |
---|
865 | PRIVATE |
---|
866 | ! |
---|
867 | !-- Public functions: |
---|
868 | PUBLIC salsa_boundary_conds, salsa_check_data_output, salsa_check_parameters, & |
---|
869 | salsa_3d_data_averaging, salsa_data_output_2d, salsa_data_output_3d, & |
---|
870 | salsa_data_output_mask, salsa_define_netcdf_grid, salsa_diagnostics, salsa_driver, & |
---|
871 | salsa_emission_update, salsa_header, salsa_init, salsa_init_arrays, salsa_parin, & |
---|
872 | salsa_rrd_local, salsa_swap_timelevel, salsa_prognostic_equations, salsa_wrd_local, & |
---|
873 | salsa_actions, salsa_non_advective_processes, salsa_exchange_horiz_bounds, & |
---|
874 | salsa_check_data_output_pr, salsa_statistics |
---|
875 | ! |
---|
876 | !-- Public parameters, constants and initial values |
---|
877 | PUBLIC bc_am_t_val, bc_an_t_val, bc_gt_t_val, dots_salsa, dt_salsa, & |
---|
878 | ibc_salsa_b, last_salsa_time, lsdepo, nest_salsa, salsa, salsa_gases_from_chem, & |
---|
879 | skip_time_do_salsa |
---|
880 | ! |
---|
881 | !-- Public prognostic variables |
---|
882 | PUBLIC aerosol_mass, aerosol_number, gconc_2, mconc_2, nbins_aerosol, ncc, ncomponents_mass, & |
---|
883 | nclim, nconc_2, ngases_salsa, prtcl, ra_dry, salsa_gas, sedim_vd |
---|
884 | |
---|
885 | |
---|
886 | CONTAINS |
---|
887 | |
---|
888 | !------------------------------------------------------------------------------! |
---|
889 | ! Description: |
---|
890 | ! ------------ |
---|
891 | !> Parin for &salsa_par for new modules |
---|
892 | !------------------------------------------------------------------------------! |
---|
893 | SUBROUTINE salsa_parin |
---|
894 | |
---|
895 | USE control_parameters, & |
---|
896 | ONLY: data_output_pr |
---|
897 | |
---|
898 | IMPLICIT NONE |
---|
899 | |
---|
900 | CHARACTER(LEN=80) :: line !< dummy string that contains the current line of parameter file |
---|
901 | |
---|
902 | INTEGER(iwp) :: i !< loop index |
---|
903 | INTEGER(iwp) :: max_pr_salsa_tmp !< dummy variable |
---|
904 | |
---|
905 | NAMELIST /salsa_parameters/ aerosol_flux_dpg, & |
---|
906 | aerosol_flux_mass_fracs_a, & |
---|
907 | aerosol_flux_mass_fracs_b, & |
---|
908 | aerosol_flux_sigmag, & |
---|
909 | advect_particle_water, & |
---|
910 | bc_salsa_b, & |
---|
911 | bc_salsa_t, & |
---|
912 | decycle_salsa_lr, & |
---|
913 | decycle_method_salsa, & |
---|
914 | decycle_salsa_ns, & |
---|
915 | depo_pcm_par, & |
---|
916 | depo_pcm_type, & |
---|
917 | depo_surf_par, & |
---|
918 | dpg, & |
---|
919 | dt_salsa, & |
---|
920 | emiss_factor_main, & |
---|
921 | emiss_factor_side, & |
---|
922 | feedback_to_palm, & |
---|
923 | h2so4_init, & |
---|
924 | hno3_init, & |
---|
925 | init_gases_type, & |
---|
926 | init_aerosol_type, & |
---|
927 | listspec, & |
---|
928 | main_street_id, & |
---|
929 | mass_fracs_a, & |
---|
930 | mass_fracs_b, & |
---|
931 | max_street_id, & |
---|
932 | n_lognorm, & |
---|
933 | nbin, & |
---|
934 | nest_salsa, & |
---|
935 | nf2a, & |
---|
936 | nh3_init, & |
---|
937 | nj3, & |
---|
938 | nlcnd, & |
---|
939 | nlcndgas, & |
---|
940 | nlcndh2oae, & |
---|
941 | nlcoag, & |
---|
942 | nldepo, & |
---|
943 | nldepo_pcm, & |
---|
944 | nldepo_surf, & |
---|
945 | nldistupdate, & |
---|
946 | nsnucl, & |
---|
947 | ocnv_init, & |
---|
948 | ocsv_init, & |
---|
949 | read_restart_data_salsa, & |
---|
950 | reglim, & |
---|
951 | salsa, & |
---|
952 | salsa_emission_mode, & |
---|
953 | sigmag, & |
---|
954 | side_street_id, & |
---|
955 | skip_time_do_salsa, & |
---|
956 | surface_aerosol_flux, & |
---|
957 | van_der_waals_coagc, & |
---|
958 | write_binary_salsa |
---|
959 | |
---|
960 | line = ' ' |
---|
961 | ! |
---|
962 | !-- Try to find salsa package |
---|
963 | REWIND ( 11 ) |
---|
964 | line = ' ' |
---|
965 | DO WHILE ( INDEX( line, '&salsa_parameters' ) == 0 ) |
---|
966 | READ ( 11, '(A)', END=10 ) line |
---|
967 | ENDDO |
---|
968 | BACKSPACE ( 11 ) |
---|
969 | ! |
---|
970 | !-- Read user-defined namelist |
---|
971 | READ ( 11, salsa_parameters ) |
---|
972 | ! |
---|
973 | !-- Enable salsa (salsa switch in modules.f90) |
---|
974 | salsa = .TRUE. |
---|
975 | |
---|
976 | 10 CONTINUE |
---|
977 | ! |
---|
978 | !-- Update the number of output profiles |
---|
979 | max_pr_salsa_tmp = 0 |
---|
980 | i = 1 |
---|
981 | DO WHILE ( data_output_pr(i) /= ' ' .AND. i <= 100 ) |
---|
982 | IF ( TRIM( data_output_pr(i)(1:6) ) == 'salsa_' ) max_pr_salsa_tmp = max_pr_salsa_tmp + 1 |
---|
983 | i = i + 1 |
---|
984 | ENDDO |
---|
985 | IF ( max_pr_salsa_tmp > 0 ) max_pr_salsa = max_pr_salsa_tmp |
---|
986 | |
---|
987 | END SUBROUTINE salsa_parin |
---|
988 | |
---|
989 | !------------------------------------------------------------------------------! |
---|
990 | ! Description: |
---|
991 | ! ------------ |
---|
992 | !> Check parameters routine for salsa. |
---|
993 | !------------------------------------------------------------------------------! |
---|
994 | SUBROUTINE salsa_check_parameters |
---|
995 | |
---|
996 | USE control_parameters, & |
---|
997 | ONLY: humidity |
---|
998 | |
---|
999 | IMPLICIT NONE |
---|
1000 | |
---|
1001 | ! |
---|
1002 | !-- Checks go here (cf. check_parameters.f90). |
---|
1003 | IF ( salsa .AND. .NOT. humidity ) THEN |
---|
1004 | WRITE( message_string, * ) 'salsa = ', salsa, ' is not allowed with humidity = ', humidity |
---|
1005 | CALL message( 'salsa_check_parameters', 'PA0594', 1, 2, 0, 6, 0 ) |
---|
1006 | ENDIF |
---|
1007 | |
---|
1008 | IF ( bc_salsa_b == 'dirichlet' ) THEN |
---|
1009 | ibc_salsa_b = 0 |
---|
1010 | ELSEIF ( bc_salsa_b == 'neumann' ) THEN |
---|
1011 | ibc_salsa_b = 1 |
---|
1012 | ELSE |
---|
1013 | message_string = 'unknown boundary condition: bc_salsa_b = "' // TRIM( bc_salsa_t ) // '"' |
---|
1014 | CALL message( 'salsa_check_parameters', 'PA0595', 1, 2, 0, 6, 0 ) |
---|
1015 | ENDIF |
---|
1016 | |
---|
1017 | IF ( bc_salsa_t == 'dirichlet' ) THEN |
---|
1018 | ibc_salsa_t = 0 |
---|
1019 | ELSEIF ( bc_salsa_t == 'neumann' ) THEN |
---|
1020 | ibc_salsa_t = 1 |
---|
1021 | ELSEIF ( bc_salsa_t == 'nested' ) THEN |
---|
1022 | ibc_salsa_t = 2 |
---|
1023 | ELSE |
---|
1024 | message_string = 'unknown boundary condition: bc_salsa_t = "' // TRIM( bc_salsa_t ) // '"' |
---|
1025 | CALL message( 'salsa_check_parameters', 'PA0596', 1, 2, 0, 6, 0 ) |
---|
1026 | ENDIF |
---|
1027 | |
---|
1028 | IF ( nj3 < 1 .OR. nj3 > 3 ) THEN |
---|
1029 | message_string = 'unknown nj3 (must be 1-3)' |
---|
1030 | CALL message( 'salsa_check_parameters', 'PA0597', 1, 2, 0, 6, 0 ) |
---|
1031 | ENDIF |
---|
1032 | |
---|
1033 | IF ( salsa_emission_mode /= 'no_emission' .AND. ibc_salsa_b == 0 ) THEN |
---|
1034 | message_string = 'salsa_emission_mode /= "no_emission" requires bc_salsa_b = "Neumann"' |
---|
1035 | CALL message( 'salsa_check_parameters','PA0598', 1, 2, 0, 6, 0 ) |
---|
1036 | ENDIF |
---|
1037 | |
---|
1038 | IF ( salsa_emission_mode /= 'no_emission' ) include_emission = .TRUE. |
---|
1039 | |
---|
1040 | END SUBROUTINE salsa_check_parameters |
---|
1041 | |
---|
1042 | !------------------------------------------------------------------------------! |
---|
1043 | ! |
---|
1044 | ! Description: |
---|
1045 | ! ------------ |
---|
1046 | !> Subroutine defining appropriate grid for netcdf variables. |
---|
1047 | !> It is called out from subroutine netcdf. |
---|
1048 | !> Same grid as for other scalars (see netcdf_interface_mod.f90) |
---|
1049 | !------------------------------------------------------------------------------! |
---|
1050 | SUBROUTINE salsa_define_netcdf_grid( var, found, grid_x, grid_y, grid_z ) |
---|
1051 | |
---|
1052 | IMPLICIT NONE |
---|
1053 | |
---|
1054 | CHARACTER(LEN=*), INTENT(OUT) :: grid_x !< |
---|
1055 | CHARACTER(LEN=*), INTENT(OUT) :: grid_y !< |
---|
1056 | CHARACTER(LEN=*), INTENT(OUT) :: grid_z !< |
---|
1057 | CHARACTER(LEN=*), INTENT(IN) :: var !< |
---|
1058 | |
---|
1059 | LOGICAL, INTENT(OUT) :: found !< |
---|
1060 | |
---|
1061 | found = .TRUE. |
---|
1062 | ! |
---|
1063 | !-- Check for the grid |
---|
1064 | |
---|
1065 | IF ( var(1:6) == 'salsa_' ) THEN ! same grid for all salsa output variables |
---|
1066 | grid_x = 'x' |
---|
1067 | grid_y = 'y' |
---|
1068 | grid_z = 'zu' |
---|
1069 | ELSE |
---|
1070 | found = .FALSE. |
---|
1071 | grid_x = 'none' |
---|
1072 | grid_y = 'none' |
---|
1073 | grid_z = 'none' |
---|
1074 | ENDIF |
---|
1075 | |
---|
1076 | END SUBROUTINE salsa_define_netcdf_grid |
---|
1077 | |
---|
1078 | !------------------------------------------------------------------------------! |
---|
1079 | ! Description: |
---|
1080 | ! ------------ |
---|
1081 | !> Header output for new module |
---|
1082 | !------------------------------------------------------------------------------! |
---|
1083 | SUBROUTINE salsa_header( io ) |
---|
1084 | |
---|
1085 | USE indices, & |
---|
1086 | ONLY: nx, ny, nz |
---|
1087 | |
---|
1088 | IMPLICIT NONE |
---|
1089 | |
---|
1090 | INTEGER(iwp), INTENT(IN) :: io !< Unit of the output file |
---|
1091 | ! |
---|
1092 | !-- Write SALSA header |
---|
1093 | WRITE( io, 1 ) |
---|
1094 | WRITE( io, 2 ) skip_time_do_salsa |
---|
1095 | WRITE( io, 3 ) dt_salsa |
---|
1096 | WRITE( io, 4 ) nz, ny, nx, nbins_aerosol |
---|
1097 | IF ( advect_particle_water ) THEN |
---|
1098 | WRITE( io, 5 ) nz, ny, nx, ncomponents_mass*nbins_aerosol, advect_particle_water |
---|
1099 | ELSE |
---|
1100 | WRITE( io, 5 ) nz, ny, nx, ncc*nbins_aerosol, advect_particle_water |
---|
1101 | ENDIF |
---|
1102 | IF ( .NOT. salsa_gases_from_chem ) THEN |
---|
1103 | WRITE( io, 6 ) nz, ny, nx, ngases_salsa, salsa_gases_from_chem |
---|
1104 | ENDIF |
---|
1105 | WRITE( io, 7 ) |
---|
1106 | IF ( nsnucl > 0 ) WRITE( io, 8 ) nsnucl, nj3 |
---|
1107 | IF ( nlcoag ) WRITE( io, 9 ) |
---|
1108 | IF ( nlcnd ) WRITE( io, 10 ) nlcndgas, nlcndh2oae |
---|
1109 | IF ( lspartition ) WRITE( io, 11 ) |
---|
1110 | IF ( nldepo ) WRITE( io, 12 ) nldepo_pcm, nldepo_surf |
---|
1111 | WRITE( io, 13 ) reglim, nbin, bin_low_limits |
---|
1112 | IF ( init_aerosol_type == 0 ) WRITE( io, 14 ) nsect |
---|
1113 | WRITE( io, 15 ) ncc, listspec, mass_fracs_a, mass_fracs_b |
---|
1114 | IF ( .NOT. salsa_gases_from_chem ) THEN |
---|
1115 | WRITE( io, 16 ) ngases_salsa, h2so4_init, hno3_init, nh3_init, ocnv_init, ocsv_init |
---|
1116 | ENDIF |
---|
1117 | WRITE( io, 17 ) init_aerosol_type, init_gases_type |
---|
1118 | IF ( init_aerosol_type == 0 ) THEN |
---|
1119 | WRITE( io, 18 ) dpg, sigmag, n_lognorm |
---|
1120 | ELSE |
---|
1121 | WRITE( io, 19 ) |
---|
1122 | ENDIF |
---|
1123 | IF ( nest_salsa ) WRITE( io, 20 ) nest_salsa |
---|
1124 | WRITE( io, 21 ) salsa_emission_mode |
---|
1125 | IF ( salsa_emission_mode == 'uniform' ) THEN |
---|
1126 | WRITE( io, 22 ) surface_aerosol_flux, aerosol_flux_dpg, aerosol_flux_sigmag, & |
---|
1127 | aerosol_flux_mass_fracs_a |
---|
1128 | ENDIF |
---|
1129 | IF ( SUM( aerosol_flux_mass_fracs_b ) > 0.0_wp .OR. salsa_emission_mode == 'read_from_file' ) & |
---|
1130 | THEN |
---|
1131 | WRITE( io, 23 ) |
---|
1132 | ENDIF |
---|
1133 | |
---|
1134 | 1 FORMAT (//' SALSA information:'/ & |
---|
1135 | ' ------------------------------'/) |
---|
1136 | 2 FORMAT (' Starts at: skip_time_do_salsa = ', F10.2, ' s') |
---|
1137 | 3 FORMAT (/' Timestep: dt_salsa = ', F6.2, ' s') |
---|
1138 | 4 FORMAT (/' Array shape (z,y,x,bins):'/ & |
---|
1139 | ' aerosol_number: ', 4(I3)) |
---|
1140 | 5 FORMAT (/' aerosol_mass: ', 4(I3),/ & |
---|
1141 | ' (advect_particle_water = ', L1, ')') |
---|
1142 | 6 FORMAT (' salsa_gas: ', 4(I3),/ & |
---|
1143 | ' (salsa_gases_from_chem = ', L1, ')') |
---|
1144 | 7 FORMAT (/' Aerosol dynamic processes included: ') |
---|
1145 | 8 FORMAT (/' nucleation (scheme = ', I1, ' and J3 parametrization = ', I1, ')') |
---|
1146 | 9 FORMAT (/' coagulation') |
---|
1147 | 10 FORMAT (/' condensation (of precursor gases = ', L1, ' and water vapour = ', L1, ')' ) |
---|
1148 | 11 FORMAT (/' dissolutional growth by HNO3 and NH3') |
---|
1149 | 12 FORMAT (/' dry deposition (on vegetation = ', L1, ' and on topography = ', L1, ')') |
---|
1150 | 13 FORMAT (/' Aerosol bin subrange limits (in metres): ', 3(ES10.2E3), / & |
---|
1151 | ' Number of size bins for each aerosol subrange: ', 2I3,/ & |
---|
1152 | ' Aerosol bin limits (in metres): ', 9(ES10.2E3)) |
---|
1153 | 14 FORMAT (' Initial number concentration in bins at the lowest level (#/m**3):', 9(ES10.2E3)) |
---|
1154 | 15 FORMAT (/' Number of chemical components used: ', I1,/ & |
---|
1155 | ' Species: ',7(A6),/ & |
---|
1156 | ' Initial relative contribution of each species to particle volume in:',/ & |
---|
1157 | ' a-bins: ', 7(F6.3),/ & |
---|
1158 | ' b-bins: ', 7(F6.3)) |
---|
1159 | 16 FORMAT (/' Number of gaseous tracers used: ', I1,/ & |
---|
1160 | ' Initial gas concentrations:',/ & |
---|
1161 | ' H2SO4: ',ES12.4E3, ' #/m**3',/ & |
---|
1162 | ' HNO3: ',ES12.4E3, ' #/m**3',/ & |
---|
1163 | ' NH3: ',ES12.4E3, ' #/m**3',/ & |
---|
1164 | ' OCNV: ',ES12.4E3, ' #/m**3',/ & |
---|
1165 | ' OCSV: ',ES12.4E3, ' #/m**3') |
---|
1166 | 17 FORMAT (/' Initialising concentrations: ', / & |
---|
1167 | ' Aerosol size distribution: init_aerosol_type = ', I1,/ & |
---|
1168 | ' Gas concentrations: init_gases_type = ', I1 ) |
---|
1169 | 18 FORMAT ( ' Mode diametres: dpg(nmod) = ', 7(F7.3), ' (m)', / & |
---|
1170 | ' Standard deviation: sigmag(nmod) = ', 7(F7.2),/ & |
---|
1171 | ' Number concentration: n_lognorm(nmod) = ', 7(ES12.4E3), ' (#/m3)' ) |
---|
1172 | 19 FORMAT (/' Size distribution read from a file.') |
---|
1173 | 20 FORMAT (/' Nesting for salsa variables: ', L1 ) |
---|
1174 | 21 FORMAT (/' Emissions: salsa_emission_mode = ', A ) |
---|
1175 | 22 FORMAT (/' surface_aerosol_flux = ', ES12.4E3, ' #/m**2/s', / & |
---|
1176 | ' aerosol_flux_dpg = ', 7(F7.3), ' (m)', / & |
---|
1177 | ' aerosol_flux_sigmag = ', 7(F7.2), / & |
---|
1178 | ' aerosol_mass_fracs_a = ', 7(ES12.4E3) ) |
---|
1179 | 23 FORMAT (/' (currently all emissions are soluble!)') |
---|
1180 | |
---|
1181 | END SUBROUTINE salsa_header |
---|
1182 | |
---|
1183 | !------------------------------------------------------------------------------! |
---|
1184 | ! Description: |
---|
1185 | ! ------------ |
---|
1186 | !> Allocate SALSA arrays and define pointers if required |
---|
1187 | !------------------------------------------------------------------------------! |
---|
1188 | SUBROUTINE salsa_init_arrays |
---|
1189 | |
---|
1190 | USE advec_ws, & |
---|
1191 | ONLY: ws_init_flags_scalar |
---|
1192 | |
---|
1193 | USE surface_mod, & |
---|
1194 | ONLY: surf_def_h, surf_def_v, surf_lsm_h, surf_lsm_v, surf_usm_h, surf_usm_v |
---|
1195 | |
---|
1196 | IMPLICIT NONE |
---|
1197 | |
---|
1198 | INTEGER(iwp) :: gases_available !< Number of available gas components in the chemistry model |
---|
1199 | INTEGER(iwp) :: i !< loop index for allocating |
---|
1200 | INTEGER(iwp) :: ii !< index for indexing chemical components |
---|
1201 | INTEGER(iwp) :: l !< loop index for allocating: surfaces |
---|
1202 | INTEGER(iwp) :: lsp !< loop index for chem species in the chemistry model |
---|
1203 | |
---|
1204 | gases_available = 0 |
---|
1205 | ! |
---|
1206 | !-- Allocate prognostic variables (see salsa_swap_timelevel) |
---|
1207 | ! |
---|
1208 | !-- Set derived indices: |
---|
1209 | !-- (This does the same as the subroutine salsa_initialize in SALSA/UCLALES-SALSA) |
---|
1210 | start_subrange_1a = 1 ! 1st index of subrange 1a |
---|
1211 | start_subrange_2a = start_subrange_1a + nbin(1) ! 1st index of subrange 2a |
---|
1212 | end_subrange_1a = start_subrange_2a - 1 ! last index of subrange 1a |
---|
1213 | end_subrange_2a = end_subrange_1a + nbin(2) ! last index of subrange 2a |
---|
1214 | |
---|
1215 | ! |
---|
1216 | !-- If the fraction of insoluble aerosols in subrange 2 is zero: do not allocate arrays for them |
---|
1217 | IF ( nf2a > 0.999999_wp .AND. SUM( mass_fracs_b ) < 0.00001_wp ) THEN |
---|
1218 | no_insoluble = .TRUE. |
---|
1219 | start_subrange_2b = end_subrange_2a+1 ! 1st index of subrange 2b |
---|
1220 | end_subrange_2b = end_subrange_2a ! last index of subrange 2b |
---|
1221 | ELSE |
---|
1222 | start_subrange_2b = start_subrange_2a + nbin(2) ! 1st index of subrange 2b |
---|
1223 | end_subrange_2b = end_subrange_2a + nbin(2) ! last index of subrange 2b |
---|
1224 | ENDIF |
---|
1225 | |
---|
1226 | nbins_aerosol = end_subrange_2b ! total number of aerosol size bins |
---|
1227 | ! |
---|
1228 | !-- Create index tables for different aerosol components |
---|
1229 | CALL component_index_constructor( prtcl, ncc, maxspec, listspec ) |
---|
1230 | |
---|
1231 | ncomponents_mass = ncc |
---|
1232 | IF ( advect_particle_water ) ncomponents_mass = ncc + 1 ! Add water |
---|
1233 | ! |
---|
1234 | !-- Indices for chemical components used (-1 = not used) |
---|
1235 | ii = 0 |
---|
1236 | IF ( is_used( prtcl, 'SO4' ) ) THEN |
---|
1237 | index_so4 = get_index( prtcl,'SO4' ) |
---|
1238 | ii = ii + 1 |
---|
1239 | ENDIF |
---|
1240 | IF ( is_used( prtcl,'OC' ) ) THEN |
---|
1241 | index_oc = get_index(prtcl, 'OC') |
---|
1242 | ii = ii + 1 |
---|
1243 | ENDIF |
---|
1244 | IF ( is_used( prtcl, 'BC' ) ) THEN |
---|
1245 | index_bc = get_index( prtcl, 'BC' ) |
---|
1246 | ii = ii + 1 |
---|
1247 | ENDIF |
---|
1248 | IF ( is_used( prtcl, 'DU' ) ) THEN |
---|
1249 | index_du = get_index( prtcl, 'DU' ) |
---|
1250 | ii = ii + 1 |
---|
1251 | ENDIF |
---|
1252 | IF ( is_used( prtcl, 'SS' ) ) THEN |
---|
1253 | index_ss = get_index( prtcl, 'SS' ) |
---|
1254 | ii = ii + 1 |
---|
1255 | ENDIF |
---|
1256 | IF ( is_used( prtcl, 'NO' ) ) THEN |
---|
1257 | index_no = get_index( prtcl, 'NO' ) |
---|
1258 | ii = ii + 1 |
---|
1259 | ENDIF |
---|
1260 | IF ( is_used( prtcl, 'NH' ) ) THEN |
---|
1261 | index_nh = get_index( prtcl, 'NH' ) |
---|
1262 | ii = ii + 1 |
---|
1263 | ENDIF |
---|
1264 | ! |
---|
1265 | !-- All species must be known |
---|
1266 | IF ( ii /= ncc ) THEN |
---|
1267 | message_string = 'Unknown aerosol species/component(s) given in the initialization' |
---|
1268 | CALL message( 'salsa_mod: salsa_init', 'PA0600', 1, 2, 0, 6, 0 ) |
---|
1269 | ENDIF |
---|
1270 | ! |
---|
1271 | !-- Allocate: |
---|
1272 | ALLOCATE( aero(nbins_aerosol), bc_am_t_val(nbins_aerosol*ncomponents_mass), & |
---|
1273 | bc_an_t_val(nbins_aerosol), bc_gt_t_val(ngases_salsa), bin_low_limits(nbins_aerosol),& |
---|
1274 | nsect(nbins_aerosol), massacc(nbins_aerosol) ) |
---|
1275 | ALLOCATE( k_topo_top(nysg:nyng,nxlg:nxrg) ) |
---|
1276 | IF ( nldepo ) ALLOCATE( sedim_vd(nzb:nzt+1,nysg:nyng,nxlg:nxrg,nbins_aerosol) ) |
---|
1277 | ALLOCATE( ra_dry(nzb:nzt+1,nysg:nyng,nxlg:nxrg,nbins_aerosol) ) |
---|
1278 | ! |
---|
1279 | !-- Initialise the sectional particle size distribution |
---|
1280 | CALL set_sizebins |
---|
1281 | ! |
---|
1282 | !-- Aerosol number concentration |
---|
1283 | ALLOCATE( aerosol_number(nbins_aerosol) ) |
---|
1284 | ALLOCATE( nconc_1(nzb:nzt+1,nysg:nyng,nxlg:nxrg,nbins_aerosol), & |
---|
1285 | nconc_2(nzb:nzt+1,nysg:nyng,nxlg:nxrg,nbins_aerosol), & |
---|
1286 | nconc_3(nzb:nzt+1,nysg:nyng,nxlg:nxrg,nbins_aerosol) ) |
---|
1287 | nconc_1 = 0.0_wp |
---|
1288 | nconc_2 = 0.0_wp |
---|
1289 | nconc_3 = 0.0_wp |
---|
1290 | |
---|
1291 | DO i = 1, nbins_aerosol |
---|
1292 | aerosol_number(i)%conc(nzb:nzt+1,nysg:nyng,nxlg:nxrg) => nconc_1(:,:,:,i) |
---|
1293 | aerosol_number(i)%conc_p(nzb:nzt+1,nysg:nyng,nxlg:nxrg) => nconc_2(:,:,:,i) |
---|
1294 | aerosol_number(i)%tconc_m(nzb:nzt+1,nysg:nyng,nxlg:nxrg) => nconc_3(:,:,:,i) |
---|
1295 | ALLOCATE( aerosol_number(i)%flux_s(nzb+1:nzt,0:threads_per_task-1), & |
---|
1296 | aerosol_number(i)%diss_s(nzb+1:nzt,0:threads_per_task-1), & |
---|
1297 | aerosol_number(i)%flux_l(nzb+1:nzt,nys:nyn,0:threads_per_task-1), & |
---|
1298 | aerosol_number(i)%diss_l(nzb+1:nzt,nys:nyn,0:threads_per_task-1), & |
---|
1299 | aerosol_number(i)%init(nzb:nzt+1), & |
---|
1300 | aerosol_number(i)%sums_ws_l(nzb:nzt+1,0:threads_per_task-1) ) |
---|
1301 | aerosol_number(i)%init = nclim |
---|
1302 | IF ( include_emission .OR. ( nldepo .AND. nldepo_surf ) ) THEN |
---|
1303 | ALLOCATE( aerosol_number(i)%source(nys:nyn,nxl:nxr) ) |
---|
1304 | aerosol_number(i)%source = 0.0_wp |
---|
1305 | ENDIF |
---|
1306 | ENDDO |
---|
1307 | |
---|
1308 | ! |
---|
1309 | !-- Aerosol mass concentration |
---|
1310 | ALLOCATE( aerosol_mass(ncomponents_mass*nbins_aerosol) ) |
---|
1311 | ALLOCATE( mconc_1(nzb:nzt+1,nysg:nyng,nxlg:nxrg,ncomponents_mass*nbins_aerosol), & |
---|
1312 | mconc_2(nzb:nzt+1,nysg:nyng,nxlg:nxrg,ncomponents_mass*nbins_aerosol), & |
---|
1313 | mconc_3(nzb:nzt+1,nysg:nyng,nxlg:nxrg,ncomponents_mass*nbins_aerosol) ) |
---|
1314 | mconc_1 = 0.0_wp |
---|
1315 | mconc_2 = 0.0_wp |
---|
1316 | mconc_3 = 0.0_wp |
---|
1317 | |
---|
1318 | DO i = 1, ncomponents_mass*nbins_aerosol |
---|
1319 | aerosol_mass(i)%conc(nzb:nzt+1,nysg:nyng,nxlg:nxrg) => mconc_1(:,:,:,i) |
---|
1320 | aerosol_mass(i)%conc_p(nzb:nzt+1,nysg:nyng,nxlg:nxrg) => mconc_2(:,:,:,i) |
---|
1321 | aerosol_mass(i)%tconc_m(nzb:nzt+1,nysg:nyng,nxlg:nxrg) => mconc_3(:,:,:,i) |
---|
1322 | ALLOCATE( aerosol_mass(i)%flux_s(nzb+1:nzt,0:threads_per_task-1), & |
---|
1323 | aerosol_mass(i)%diss_s(nzb+1:nzt,0:threads_per_task-1), & |
---|
1324 | aerosol_mass(i)%flux_l(nzb+1:nzt,nys:nyn,0:threads_per_task-1), & |
---|
1325 | aerosol_mass(i)%diss_l(nzb+1:nzt,nys:nyn,0:threads_per_task-1), & |
---|
1326 | aerosol_mass(i)%init(nzb:nzt+1), & |
---|
1327 | aerosol_mass(i)%sums_ws_l(nzb:nzt+1,0:threads_per_task-1) ) |
---|
1328 | aerosol_mass(i)%init = mclim |
---|
1329 | IF ( include_emission .OR. ( nldepo .AND. nldepo_surf ) ) THEN |
---|
1330 | ALLOCATE( aerosol_mass(i)%source(nys:nyn,nxl:nxr) ) |
---|
1331 | aerosol_mass(i)%source = 0.0_wp |
---|
1332 | ENDIF |
---|
1333 | ENDDO |
---|
1334 | |
---|
1335 | ! |
---|
1336 | !-- Surface fluxes: answs = aerosol number, amsws = aerosol mass |
---|
1337 | ! |
---|
1338 | !-- Horizontal surfaces: default type |
---|
1339 | DO l = 0, 2 ! upward (l=0), downward (l=1) and model top (l=2) |
---|
1340 | ALLOCATE( surf_def_h(l)%answs( 1:surf_def_h(l)%ns, nbins_aerosol ) ) |
---|
1341 | ALLOCATE( surf_def_h(l)%amsws( 1:surf_def_h(l)%ns, nbins_aerosol*ncomponents_mass ) ) |
---|
1342 | surf_def_h(l)%answs = 0.0_wp |
---|
1343 | surf_def_h(l)%amsws = 0.0_wp |
---|
1344 | ENDDO |
---|
1345 | ! |
---|
1346 | !-- Horizontal surfaces: natural type |
---|
1347 | ALLOCATE( surf_lsm_h%answs( 1:surf_lsm_h%ns, nbins_aerosol ) ) |
---|
1348 | ALLOCATE( surf_lsm_h%amsws( 1:surf_lsm_h%ns, nbins_aerosol*ncomponents_mass ) ) |
---|
1349 | surf_lsm_h%answs = 0.0_wp |
---|
1350 | surf_lsm_h%amsws = 0.0_wp |
---|
1351 | ! |
---|
1352 | !-- Horizontal surfaces: urban type |
---|
1353 | ALLOCATE( surf_usm_h%answs( 1:surf_usm_h%ns, nbins_aerosol ) ) |
---|
1354 | ALLOCATE( surf_usm_h%amsws( 1:surf_usm_h%ns, nbins_aerosol*ncomponents_mass ) ) |
---|
1355 | surf_usm_h%answs = 0.0_wp |
---|
1356 | surf_usm_h%amsws = 0.0_wp |
---|
1357 | |
---|
1358 | ! |
---|
1359 | !-- Vertical surfaces: northward (l=0), southward (l=1), eastward (l=2) and westward (l=3) facing |
---|
1360 | DO l = 0, 3 |
---|
1361 | ALLOCATE( surf_def_v(l)%answs( 1:surf_def_v(l)%ns, nbins_aerosol ) ) |
---|
1362 | surf_def_v(l)%answs = 0.0_wp |
---|
1363 | ALLOCATE( surf_def_v(l)%amsws( 1:surf_def_v(l)%ns, nbins_aerosol*ncomponents_mass ) ) |
---|
1364 | surf_def_v(l)%amsws = 0.0_wp |
---|
1365 | |
---|
1366 | ALLOCATE( surf_lsm_v(l)%answs( 1:surf_lsm_v(l)%ns, nbins_aerosol ) ) |
---|
1367 | surf_lsm_v(l)%answs = 0.0_wp |
---|
1368 | ALLOCATE( surf_lsm_v(l)%amsws( 1:surf_lsm_v(l)%ns, nbins_aerosol*ncomponents_mass ) ) |
---|
1369 | surf_lsm_v(l)%amsws = 0.0_wp |
---|
1370 | |
---|
1371 | ALLOCATE( surf_usm_v(l)%answs( 1:surf_usm_v(l)%ns, nbins_aerosol ) ) |
---|
1372 | surf_usm_v(l)%answs = 0.0_wp |
---|
1373 | ALLOCATE( surf_usm_v(l)%amsws( 1:surf_usm_v(l)%ns, nbins_aerosol*ncomponents_mass ) ) |
---|
1374 | surf_usm_v(l)%amsws = 0.0_wp |
---|
1375 | |
---|
1376 | ENDDO |
---|
1377 | |
---|
1378 | ! |
---|
1379 | !-- Concentration of gaseous tracers (1. SO4, 2. HNO3, 3. NH3, 4. OCNV, 5. OCSV) |
---|
1380 | !-- (number concentration (#/m3) ) |
---|
1381 | ! |
---|
1382 | !-- If chemistry is on, read gas phase concentrations from there. Otherwise, |
---|
1383 | !-- allocate salsa_gas array. |
---|
1384 | |
---|
1385 | IF ( air_chemistry ) THEN |
---|
1386 | DO lsp = 1, nvar |
---|
1387 | SELECT CASE ( TRIM( chem_species(lsp)%name ) ) |
---|
1388 | CASE ( 'H2SO4', 'h2so4' ) |
---|
1389 | gases_available = gases_available + 1 |
---|
1390 | gas_index_chem(1) = lsp |
---|
1391 | CASE ( 'HNO3', 'hno3' ) |
---|
1392 | gases_available = gases_available + 1 |
---|
1393 | gas_index_chem(2) = lsp |
---|
1394 | CASE ( 'NH3', 'nh3' ) |
---|
1395 | gases_available = gases_available + 1 |
---|
1396 | gas_index_chem(3) = lsp |
---|
1397 | CASE ( 'OCNV', 'ocnv' ) |
---|
1398 | gases_available = gases_available + 1 |
---|
1399 | gas_index_chem(4) = lsp |
---|
1400 | CASE ( 'OCSV', 'ocsv' ) |
---|
1401 | gases_available = gases_available + 1 |
---|
1402 | gas_index_chem(5) = lsp |
---|
1403 | END SELECT |
---|
1404 | ENDDO |
---|
1405 | |
---|
1406 | IF ( gases_available == ngases_salsa ) THEN |
---|
1407 | salsa_gases_from_chem = .TRUE. |
---|
1408 | ELSE |
---|
1409 | WRITE( message_string, * ) 'SALSA is run together with chemistry but not all gaseous '// & |
---|
1410 | 'components are provided by kpp (H2SO4, HNO3, NH3, OCNV, OCSV)' |
---|
1411 | CALL message( 'check_parameters', 'PA0599', 1, 2, 0, 6, 0 ) |
---|
1412 | ENDIF |
---|
1413 | |
---|
1414 | ELSE |
---|
1415 | |
---|
1416 | ALLOCATE( salsa_gas(ngases_salsa) ) |
---|
1417 | ALLOCATE( gconc_1(nzb:nzt+1,nysg:nyng,nxlg:nxrg,ngases_salsa), & |
---|
1418 | gconc_2(nzb:nzt+1,nysg:nyng,nxlg:nxrg,ngases_salsa), & |
---|
1419 | gconc_3(nzb:nzt+1,nysg:nyng,nxlg:nxrg,ngases_salsa) ) |
---|
1420 | gconc_1 = 0.0_wp |
---|
1421 | gconc_2 = 0.0_wp |
---|
1422 | gconc_3 = 0.0_wp |
---|
1423 | |
---|
1424 | DO i = 1, ngases_salsa |
---|
1425 | salsa_gas(i)%conc(nzb:nzt+1,nysg:nyng,nxlg:nxrg) => gconc_1(:,:,:,i) |
---|
1426 | salsa_gas(i)%conc_p(nzb:nzt+1,nysg:nyng,nxlg:nxrg) => gconc_2(:,:,:,i) |
---|
1427 | salsa_gas(i)%tconc_m(nzb:nzt+1,nysg:nyng,nxlg:nxrg) => gconc_3(:,:,:,i) |
---|
1428 | ALLOCATE( salsa_gas(i)%flux_s(nzb+1:nzt,0:threads_per_task-1), & |
---|
1429 | salsa_gas(i)%diss_s(nzb+1:nzt,0:threads_per_task-1), & |
---|
1430 | salsa_gas(i)%flux_l(nzb+1:nzt,nys:nyn,0:threads_per_task-1),& |
---|
1431 | salsa_gas(i)%diss_l(nzb+1:nzt,nys:nyn,0:threads_per_task-1),& |
---|
1432 | salsa_gas(i)%init(nzb:nzt+1), & |
---|
1433 | salsa_gas(i)%sums_ws_l(nzb:nzt+1,0:threads_per_task-1) ) |
---|
1434 | salsa_gas(i)%init = nclim |
---|
1435 | IF ( include_emission ) THEN |
---|
1436 | ALLOCATE( salsa_gas(i)%source(nys:nys,nxl:nxr) ) |
---|
1437 | salsa_gas(i)%source = 0.0_wp |
---|
1438 | ENDIF |
---|
1439 | ENDDO |
---|
1440 | ! |
---|
1441 | !-- Surface fluxes: gtsws = gaseous tracer flux |
---|
1442 | ! |
---|
1443 | !-- Horizontal surfaces: default type |
---|
1444 | DO l = 0, 2 ! upward (l=0), downward (l=1) and model top (l=2) |
---|
1445 | ALLOCATE( surf_def_h(l)%gtsws( 1:surf_def_h(l)%ns, ngases_salsa ) ) |
---|
1446 | surf_def_h(l)%gtsws = 0.0_wp |
---|
1447 | ENDDO |
---|
1448 | !-- Horizontal surfaces: natural type |
---|
1449 | ALLOCATE( surf_lsm_h%gtsws( 1:surf_lsm_h%ns, ngases_salsa ) ) |
---|
1450 | surf_lsm_h%gtsws = 0.0_wp |
---|
1451 | !-- Horizontal surfaces: urban type |
---|
1452 | ALLOCATE( surf_usm_h%gtsws( 1:surf_usm_h%ns, ngases_salsa ) ) |
---|
1453 | surf_usm_h%gtsws = 0.0_wp |
---|
1454 | ! |
---|
1455 | !-- Vertical surfaces: northward (l=0), southward (l=1), eastward (l=2) and |
---|
1456 | !-- westward (l=3) facing |
---|
1457 | DO l = 0, 3 |
---|
1458 | ALLOCATE( surf_def_v(l)%gtsws( 1:surf_def_v(l)%ns, ngases_salsa ) ) |
---|
1459 | surf_def_v(l)%gtsws = 0.0_wp |
---|
1460 | ALLOCATE( surf_lsm_v(l)%gtsws( 1:surf_lsm_v(l)%ns, ngases_salsa ) ) |
---|
1461 | surf_lsm_v(l)%gtsws = 0.0_wp |
---|
1462 | ALLOCATE( surf_usm_v(l)%gtsws( 1:surf_usm_v(l)%ns, ngases_salsa ) ) |
---|
1463 | surf_usm_v(l)%gtsws = 0.0_wp |
---|
1464 | ENDDO |
---|
1465 | ENDIF |
---|
1466 | |
---|
1467 | IF ( ws_scheme_sca ) THEN |
---|
1468 | |
---|
1469 | IF ( salsa ) THEN |
---|
1470 | ALLOCATE( sums_salsa_ws_l(nzb:nzt+1,0:threads_per_task-1) ) |
---|
1471 | sums_salsa_ws_l = 0.0_wp |
---|
1472 | ENDIF |
---|
1473 | |
---|
1474 | ENDIF |
---|
1475 | ! |
---|
1476 | !-- Set control flags for decycling only at lateral boundary cores. Within the inner cores the |
---|
1477 | !-- decycle flag is set to .FALSE.. Even though it does not affect the setting of chemistry boundary |
---|
1478 | !-- conditions, this flag is used to set advection control flags appropriately. |
---|
1479 | decycle_salsa_lr = MERGE( decycle_salsa_lr, .FALSE., nxl == 0 .OR. nxr == nx ) |
---|
1480 | decycle_salsa_ns = MERGE( decycle_salsa_ns, .FALSE., nys == 0 .OR. nyn == ny ) |
---|
1481 | ! |
---|
1482 | !-- Decycling can be applied separately for aerosol variables, while wind and other scalars may have |
---|
1483 | !-- cyclic or nested boundary conditions. However, large gradients near the boundaries may produce |
---|
1484 | !-- stationary numerical oscillations near the lateral boundaries when a higher-order scheme is |
---|
1485 | !-- applied near these boundaries. To get rid-off this, set-up additional flags that control the |
---|
1486 | !-- order of the scalar advection scheme near the lateral boundaries for passive scalars with |
---|
1487 | !-- decycling. |
---|
1488 | IF ( scalar_advec == 'ws-scheme' ) THEN |
---|
1489 | ALLOCATE( salsa_advc_flags_s(nzb:nzt+1,nysg:nyng,nxlg:nxrg) ) |
---|
1490 | ! |
---|
1491 | !-- In case of decycling, set Neuman boundary conditions for wall_flags_0 bit 31 instead of |
---|
1492 | !-- cyclic boundary conditions. Bit 31 is used to identify extended degradation zones (please see |
---|
1493 | !-- the following comment). Note, since several also other modules may access this bit but may |
---|
1494 | !-- have other boundary conditions, the original value of wall_flags_0 bit 31 must not be |
---|
1495 | !-- modified. Hence, store the boundary conditions directly on salsa_advc_flags_s. |
---|
1496 | !-- salsa_advc_flags_s will be later overwritten in ws_init_flags_scalar and bit 31 won't be used |
---|
1497 | !-- to control the numerical order. |
---|
1498 | !-- Initialize with flag 31 only. |
---|
1499 | salsa_advc_flags_s = 0 |
---|
1500 | salsa_advc_flags_s = MERGE( IBSET( salsa_advc_flags_s, 31 ), 0, BTEST( wall_flags_0, 31 ) ) |
---|
1501 | |
---|
1502 | IF ( decycle_salsa_ns ) THEN |
---|
1503 | IF ( nys == 0 ) THEN |
---|
1504 | DO i = 1, nbgp |
---|
1505 | salsa_advc_flags_s(:,nys-i,:) = MERGE( IBSET( salsa_advc_flags_s(:,nys,:), 31 ), & |
---|
1506 | IBCLR( salsa_advc_flags_s(:,nys,:), 31 ), & |
---|
1507 | BTEST( salsa_advc_flags_s(:,nys,:), 31 ) ) |
---|
1508 | ENDDO |
---|
1509 | ENDIF |
---|
1510 | IF ( nyn == ny ) THEN |
---|
1511 | DO i = 1, nbgp |
---|
1512 | salsa_advc_flags_s(:,nyn+i,:) = MERGE( IBSET( salsa_advc_flags_s(:,nyn,:), 31 ), & |
---|
1513 | IBCLR( salsa_advc_flags_s(:,nyn,:), 31 ), & |
---|
1514 | BTEST( salsa_advc_flags_s(:,nyn,:), 31 ) ) |
---|
1515 | ENDDO |
---|
1516 | ENDIF |
---|
1517 | ENDIF |
---|
1518 | IF ( decycle_salsa_lr ) THEN |
---|
1519 | IF ( nxl == 0 ) THEN |
---|
1520 | DO i = 1, nbgp |
---|
1521 | salsa_advc_flags_s(:,:,nxl-i) = MERGE( IBSET( salsa_advc_flags_s(:,:,nxl), 31 ), & |
---|
1522 | IBCLR( salsa_advc_flags_s(:,:,nxl), 31 ), & |
---|
1523 | BTEST( salsa_advc_flags_s(:,:,nxl), 31 ) ) |
---|
1524 | ENDDO |
---|
1525 | ENDIF |
---|
1526 | IF ( nxr == nx ) THEN |
---|
1527 | DO i = 1, nbgp |
---|
1528 | salsa_advc_flags_s(:,:,nxr+i) = MERGE( IBSET( salsa_advc_flags_s(:,:,nxr), 31 ), & |
---|
1529 | IBCLR( salsa_advc_flags_s(:,:,nxr), 31 ), & |
---|
1530 | BTEST( salsa_advc_flags_s(:,:,nxr), 31 ) ) |
---|
1531 | ENDDO |
---|
1532 | ENDIF |
---|
1533 | ENDIF |
---|
1534 | ! |
---|
1535 | !-- To initialise the advection flags appropriately, pass the boundary flags to |
---|
1536 | !-- ws_init_flags_scalar. The last argument in ws_init_flags_scalar indicates that a passive |
---|
1537 | !-- scalar is being treated and the horizontal advection terms are degraded already 2 grid points |
---|
1538 | !-- before the lateral boundary. Also, extended degradation zones are applied, where |
---|
1539 | !-- horizontal advection of scalars is discretised by the first-order scheme at all grid points |
---|
1540 | !-- in the vicinity of buildings (<= 3 grid points). Even though no building is within the |
---|
1541 | !-- numerical stencil, the first-order scheme is used. At fourth and fifth grid points, the order |
---|
1542 | !-- of the horizontal advection scheme is successively upgraded. |
---|
1543 | !-- These degradations of the advection scheme are done to avoid stationary numerical |
---|
1544 | !-- oscillations, which are responsible for high concentration maxima that may appear e.g. under |
---|
1545 | !-- shear-free stable conditions. |
---|
1546 | CALL ws_init_flags_scalar( bc_dirichlet_l .OR. bc_radiation_l .OR. decycle_salsa_lr, & |
---|
1547 | bc_dirichlet_n .OR. bc_radiation_n .OR. decycle_salsa_ns, & |
---|
1548 | bc_dirichlet_r .OR. bc_radiation_r .OR. decycle_salsa_lr, & |
---|
1549 | bc_dirichlet_s .OR. bc_radiation_s .OR. decycle_salsa_ns, & |
---|
1550 | salsa_advc_flags_s, .TRUE. ) |
---|
1551 | ENDIF |
---|
1552 | |
---|
1553 | |
---|
1554 | END SUBROUTINE salsa_init_arrays |
---|
1555 | |
---|
1556 | !------------------------------------------------------------------------------! |
---|
1557 | ! Description: |
---|
1558 | ! ------------ |
---|
1559 | !> Initialization of SALSA. Based on salsa_initialize in UCLALES-SALSA. |
---|
1560 | !> Subroutines salsa_initialize, SALSAinit and DiagInitAero in UCLALES-SALSA are |
---|
1561 | !> also merged here. |
---|
1562 | !------------------------------------------------------------------------------! |
---|
1563 | SUBROUTINE salsa_init |
---|
1564 | |
---|
1565 | IMPLICIT NONE |
---|
1566 | |
---|
1567 | INTEGER(iwp) :: i !< |
---|
1568 | INTEGER(iwp) :: ib !< loop index for aerosol number bins |
---|
1569 | INTEGER(iwp) :: ic !< loop index for aerosol mass bins |
---|
1570 | INTEGER(iwp) :: ig !< loop index for gases |
---|
1571 | INTEGER(iwp) :: j !< |
---|
1572 | |
---|
1573 | IF ( debug_output ) CALL debug_message( 'salsa_init', 'start' ) |
---|
1574 | |
---|
1575 | bin_low_limits = 0.0_wp |
---|
1576 | k_topo_top = 0 |
---|
1577 | nsect = 0.0_wp |
---|
1578 | massacc = 1.0_wp |
---|
1579 | ! |
---|
1580 | !-- Initialise |
---|
1581 | IF ( nldepo ) sedim_vd = 0.0_wp |
---|
1582 | |
---|
1583 | IF ( .NOT. salsa_gases_from_chem ) THEN |
---|
1584 | IF ( .NOT. read_restart_data_salsa ) THEN |
---|
1585 | salsa_gas(1)%conc = h2so4_init |
---|
1586 | salsa_gas(2)%conc = hno3_init |
---|
1587 | salsa_gas(3)%conc = nh3_init |
---|
1588 | salsa_gas(4)%conc = ocnv_init |
---|
1589 | salsa_gas(5)%conc = ocsv_init |
---|
1590 | ENDIF |
---|
1591 | DO ig = 1, ngases_salsa |
---|
1592 | salsa_gas(ig)%conc_p = 0.0_wp |
---|
1593 | salsa_gas(ig)%tconc_m = 0.0_wp |
---|
1594 | salsa_gas(ig)%flux_s = 0.0_wp |
---|
1595 | salsa_gas(ig)%diss_s = 0.0_wp |
---|
1596 | salsa_gas(ig)%flux_l = 0.0_wp |
---|
1597 | salsa_gas(ig)%diss_l = 0.0_wp |
---|
1598 | salsa_gas(ig)%sums_ws_l = 0.0_wp |
---|
1599 | salsa_gas(ig)%conc_p = salsa_gas(ig)%conc |
---|
1600 | ENDDO |
---|
1601 | ! |
---|
1602 | !-- Set initial value for gas compound tracer |
---|
1603 | salsa_gas(1)%init = h2so4_init |
---|
1604 | salsa_gas(2)%init = hno3_init |
---|
1605 | salsa_gas(3)%init = nh3_init |
---|
1606 | salsa_gas(4)%init = ocnv_init |
---|
1607 | salsa_gas(5)%init = ocsv_init |
---|
1608 | ENDIF |
---|
1609 | ! |
---|
1610 | !-- Aerosol radius in each bin: dry and wet (m) |
---|
1611 | ra_dry = 1.0E-10_wp |
---|
1612 | ! |
---|
1613 | !-- Initialise location-dependent aerosol size distributions and chemical compositions: |
---|
1614 | CALL aerosol_init |
---|
1615 | |
---|
1616 | !-- Initalisation run of SALSA + calculate the vertical top index of the topography |
---|
1617 | DO i = nxl, nxr |
---|
1618 | DO j = nys, nyn |
---|
1619 | |
---|
1620 | k_topo_top(j,i) = MAXLOC( MERGE( 1, 0, BTEST( wall_flags_0(:,j,i), 12 ) ), DIM = 1 ) - 1 |
---|
1621 | |
---|
1622 | CALL salsa_driver( i, j, 1 ) |
---|
1623 | CALL salsa_diagnostics( i, j ) |
---|
1624 | ENDDO |
---|
1625 | ENDDO |
---|
1626 | |
---|
1627 | DO ib = 1, nbins_aerosol |
---|
1628 | aerosol_number(ib)%conc_p = aerosol_number(ib)%conc |
---|
1629 | aerosol_number(ib)%tconc_m = 0.0_wp |
---|
1630 | aerosol_number(ib)%flux_s = 0.0_wp |
---|
1631 | aerosol_number(ib)%diss_s = 0.0_wp |
---|
1632 | aerosol_number(ib)%flux_l = 0.0_wp |
---|
1633 | aerosol_number(ib)%diss_l = 0.0_wp |
---|
1634 | aerosol_number(ib)%sums_ws_l = 0.0_wp |
---|
1635 | ENDDO |
---|
1636 | DO ic = 1, ncomponents_mass*nbins_aerosol |
---|
1637 | aerosol_mass(ic)%conc_p = aerosol_mass(ic)%conc |
---|
1638 | aerosol_mass(ic)%tconc_m = 0.0_wp |
---|
1639 | aerosol_mass(ic)%flux_s = 0.0_wp |
---|
1640 | aerosol_mass(ic)%diss_s = 0.0_wp |
---|
1641 | aerosol_mass(ic)%flux_l = 0.0_wp |
---|
1642 | aerosol_mass(ic)%diss_l = 0.0_wp |
---|
1643 | aerosol_mass(ic)%sums_ws_l = 0.0_wp |
---|
1644 | ENDDO |
---|
1645 | ! |
---|
1646 | ! |
---|
1647 | !-- Initialise the deposition scheme and surface types |
---|
1648 | IF ( nldepo ) CALL init_deposition |
---|
1649 | |
---|
1650 | IF ( include_emission ) THEN |
---|
1651 | ! |
---|
1652 | !-- Read in and initialize emissions |
---|
1653 | CALL salsa_emission_setup( .TRUE. ) |
---|
1654 | IF ( .NOT. salsa_gases_from_chem .AND. salsa_emission_mode == 'read_from_file' ) THEN |
---|
1655 | CALL salsa_gas_emission_setup( .TRUE. ) |
---|
1656 | ENDIF |
---|
1657 | ENDIF |
---|
1658 | ! |
---|
1659 | !-- Partition and dissolutional growth by gaseous HNO3 and NH3 |
---|
1660 | IF ( index_no > 0 .AND. index_nh > 0 .AND. index_so4 > 0 ) lspartition = .TRUE. |
---|
1661 | |
---|
1662 | IF ( debug_output ) CALL debug_message( 'salsa_init', 'end' ) |
---|
1663 | |
---|
1664 | END SUBROUTINE salsa_init |
---|
1665 | |
---|
1666 | !------------------------------------------------------------------------------! |
---|
1667 | ! Description: |
---|
1668 | ! ------------ |
---|
1669 | !> Initializes particle size distribution grid by calculating size bin limits |
---|
1670 | !> and mid-size for *dry* particles in each bin. Called from salsa_initialize |
---|
1671 | !> (only at the beginning of simulation). |
---|
1672 | !> Size distribution described using: |
---|
1673 | !> 1) moving center method (subranges 1 and 2) |
---|
1674 | !> (Jacobson, Atmos. Env., 31, 131-144, 1997) |
---|
1675 | !> 2) fixed sectional method (subrange 3) |
---|
1676 | !> Size bins in each subrange are spaced logarithmically |
---|
1677 | !> based on given subrange size limits and bin number. |
---|
1678 | ! |
---|
1679 | !> Mona changed 06/2017: Use geometric mean diameter to describe the mean |
---|
1680 | !> particle diameter in a size bin, not the arithmeric mean which clearly |
---|
1681 | !> overestimates the total particle volume concentration. |
---|
1682 | ! |
---|
1683 | !> Coded by: |
---|
1684 | !> Hannele Korhonen (FMI) 2005 |
---|
1685 | !> Harri Kokkola (FMI) 2006 |
---|
1686 | ! |
---|
1687 | !> Bug fixes for box model + updated for the new aerosol datatype: |
---|
1688 | !> Juha Tonttila (FMI) 2014 |
---|
1689 | !------------------------------------------------------------------------------! |
---|
1690 | SUBROUTINE set_sizebins |
---|
1691 | |
---|
1692 | IMPLICIT NONE |
---|
1693 | |
---|
1694 | INTEGER(iwp) :: cc !< running index |
---|
1695 | INTEGER(iwp) :: dd !< running index |
---|
1696 | |
---|
1697 | REAL(wp) :: ratio_d !< ratio of the upper and lower diameter of subranges |
---|
1698 | |
---|
1699 | aero(:)%dwet = 1.0E-10_wp |
---|
1700 | aero(:)%veqh2o = 1.0E-10_wp |
---|
1701 | aero(:)%numc = nclim |
---|
1702 | aero(:)%core = 1.0E-10_wp |
---|
1703 | DO cc = 1, maxspec+1 ! 1:SO4, 2:OC, 3:BC, 4:DU, 5:SS, 6:NO, 7:NH, 8:H2O |
---|
1704 | aero(:)%volc(cc) = 0.0_wp |
---|
1705 | ENDDO |
---|
1706 | ! |
---|
1707 | !-- vlolim&vhilim: min & max *dry* volumes [fxm] |
---|
1708 | !-- dmid: bin mid *dry* diameter (m) |
---|
1709 | !-- vratiolo&vratiohi: volume ratio between the center and low/high limit |
---|
1710 | ! |
---|
1711 | !-- 1) Size subrange 1: |
---|
1712 | ratio_d = reglim(2) / reglim(1) ! section spacing (m) |
---|
1713 | DO cc = start_subrange_1a, end_subrange_1a |
---|
1714 | aero(cc)%vlolim = api6 * ( reglim(1) * ratio_d**( REAL( cc-1 ) / nbin(1) ) )**3 |
---|
1715 | aero(cc)%vhilim = api6 * ( reglim(1) * ratio_d**( REAL( cc ) / nbin(1) ) )**3 |
---|
1716 | aero(cc)%dmid = SQRT( ( aero(cc)%vhilim / api6 )**0.33333333_wp * & |
---|
1717 | ( aero(cc)%vlolim / api6 )**0.33333333_wp ) |
---|
1718 | aero(cc)%vratiohi = aero(cc)%vhilim / ( api6 * aero(cc)%dmid**3 ) |
---|
1719 | aero(cc)%vratiolo = aero(cc)%vlolim / ( api6 * aero(cc)%dmid**3 ) |
---|
1720 | ENDDO |
---|
1721 | ! |
---|
1722 | !-- 2) Size subrange 2: |
---|
1723 | !-- 2.1) Sub-subrange 2a: high hygroscopicity |
---|
1724 | ratio_d = reglim(3) / reglim(2) ! section spacing |
---|
1725 | DO dd = start_subrange_2a, end_subrange_2a |
---|
1726 | cc = dd - start_subrange_2a |
---|
1727 | aero(dd)%vlolim = api6 * ( reglim(2) * ratio_d**( REAL( cc ) / nbin(2) ) )**3 |
---|
1728 | aero(dd)%vhilim = api6 * ( reglim(2) * ratio_d**( REAL( cc+1 ) / nbin(2) ) )**3 |
---|
1729 | aero(dd)%dmid = SQRT( ( aero(dd)%vhilim / api6 )**0.33333333_wp * & |
---|
1730 | ( aero(dd)%vlolim / api6 )**0.33333333_wp ) |
---|
1731 | aero(dd)%vratiohi = aero(dd)%vhilim / ( api6 * aero(dd)%dmid**3 ) |
---|
1732 | aero(dd)%vratiolo = aero(dd)%vlolim / ( api6 * aero(dd)%dmid**3 ) |
---|
1733 | ENDDO |
---|
1734 | ! |
---|
1735 | !-- 2.2) Sub-subrange 2b: low hygroscopicity |
---|
1736 | IF ( .NOT. no_insoluble ) THEN |
---|
1737 | aero(start_subrange_2b:end_subrange_2b)%vlolim = aero(start_subrange_2a:end_subrange_2a)%vlolim |
---|
1738 | aero(start_subrange_2b:end_subrange_2b)%vhilim = aero(start_subrange_2a:end_subrange_2a)%vhilim |
---|
1739 | aero(start_subrange_2b:end_subrange_2b)%dmid = aero(start_subrange_2a:end_subrange_2a)%dmid |
---|
1740 | aero(start_subrange_2b:end_subrange_2b)%vratiohi = aero(start_subrange_2a:end_subrange_2a)%vratiohi |
---|
1741 | aero(start_subrange_2b:end_subrange_2b)%vratiolo = aero(start_subrange_2a:end_subrange_2a)%vratiolo |
---|
1742 | ENDIF |
---|
1743 | ! |
---|
1744 | !-- Initialize the wet diameter with the bin dry diameter to avoid numerical problems later |
---|
1745 | aero(:)%dwet = aero(:)%dmid |
---|
1746 | ! |
---|
1747 | !-- Save bin limits (lower diameter) to be delivered to PALM if needed |
---|
1748 | DO cc = 1, nbins_aerosol |
---|
1749 | bin_low_limits(cc) = ( aero(cc)%vlolim / api6 )**0.33333333_wp |
---|
1750 | ENDDO |
---|
1751 | |
---|
1752 | END SUBROUTINE set_sizebins |
---|
1753 | |
---|
1754 | !------------------------------------------------------------------------------! |
---|
1755 | ! Description: |
---|
1756 | ! ------------ |
---|
1757 | !> Initilize altitude-dependent aerosol size distributions and compositions. |
---|
1758 | !> |
---|
1759 | !> Mona added 06/2017: Correct the number and mass concentrations by normalizing |
---|
1760 | !< by the given total number and mass concentration. |
---|
1761 | !> |
---|
1762 | !> Tomi Raatikainen, FMI, 29.2.2016 |
---|
1763 | !------------------------------------------------------------------------------! |
---|
1764 | SUBROUTINE aerosol_init |
---|
1765 | |
---|
1766 | USE netcdf_data_input_mod, & |
---|
1767 | ONLY: check_existence, close_input_file, get_dimension_length, & |
---|
1768 | get_attribute, get_variable, & |
---|
1769 | inquire_num_variables, inquire_variable_names, & |
---|
1770 | open_read_file |
---|
1771 | |
---|
1772 | IMPLICIT NONE |
---|
1773 | |
---|
1774 | CHARACTER(LEN=25), DIMENSION(:), ALLOCATABLE :: cc_name !< chemical component name |
---|
1775 | CHARACTER(LEN=100), DIMENSION(:), ALLOCATABLE :: var_names !< variable names |
---|
1776 | |
---|
1777 | INTEGER(iwp) :: ee !< index: end |
---|
1778 | INTEGER(iwp) :: i !< loop index: x-direction |
---|
1779 | INTEGER(iwp) :: ib !< loop index: size bins |
---|
1780 | INTEGER(iwp) :: ic !< loop index: chemical components |
---|
1781 | INTEGER(iwp) :: id_dyn !< NetCDF id of PIDS_DYNAMIC_SALSA |
---|
1782 | INTEGER(iwp) :: ig !< loop index: gases |
---|
1783 | INTEGER(iwp) :: j !< loop index: y-direction |
---|
1784 | INTEGER(iwp) :: k !< loop index: z-direction |
---|
1785 | INTEGER(iwp) :: lod_aero !< level of detail of inital aerosol concentrations |
---|
1786 | INTEGER(iwp) :: num_vars !< number of variables |
---|
1787 | INTEGER(iwp) :: pr_nbins !< number of aerosol size bins in file |
---|
1788 | INTEGER(iwp) :: pr_ncc !< number of aerosol chemical components in file |
---|
1789 | INTEGER(iwp) :: pr_nz !< number of vertical grid-points in file |
---|
1790 | INTEGER(iwp) :: prunmode !< running mode of SALSA |
---|
1791 | INTEGER(iwp) :: ss !< index: start |
---|
1792 | |
---|
1793 | INTEGER(iwp), DIMENSION(maxspec) :: cc_in2mod |
---|
1794 | |
---|
1795 | LOGICAL :: netcdf_extend = .FALSE. !< Flag: netcdf file exists |
---|
1796 | |
---|
1797 | REAL(wp) :: flag !< flag to mask topography grid points |
---|
1798 | |
---|
1799 | REAL(wp), DIMENSION(nbins_aerosol) :: core !< size of the bin mid aerosol particle |
---|
1800 | |
---|
1801 | REAL(wp), DIMENSION(0:nz+1) :: pnf2a !< number fraction in 2a |
---|
1802 | REAL(wp), DIMENSION(0:nz+1) :: pmfoc1a !< mass fraction of OC in 1a |
---|
1803 | |
---|
1804 | REAL(wp), DIMENSION(0:nz+1,nbins_aerosol) :: pndist !< vertical profile of size dist. (#/m3) |
---|
1805 | REAL(wp), DIMENSION(0:nz+1,maxspec) :: pmf2a !< mass distributions in subrange 2a |
---|
1806 | REAL(wp), DIMENSION(0:nz+1,maxspec) :: pmf2b !< mass distributions in subrange 2b |
---|
1807 | |
---|
1808 | REAL(wp), DIMENSION(:), ALLOCATABLE :: pr_dmid !< vertical profile of aerosol bin diameters |
---|
1809 | REAL(wp), DIMENSION(:), ALLOCATABLE :: pr_z !< z levels of profiles |
---|
1810 | |
---|
1811 | REAL(wp), DIMENSION(:,:), ALLOCATABLE :: pr_mass_fracs_a !< mass fraction: a |
---|
1812 | REAL(wp), DIMENSION(:,:), ALLOCATABLE :: pr_mass_fracs_b !< and b |
---|
1813 | |
---|
1814 | cc_in2mod = 0 |
---|
1815 | prunmode = 1 |
---|
1816 | ! |
---|
1817 | !-- Bin mean aerosol particle volume (m3) |
---|
1818 | core(1:nbins_aerosol) = api6 * aero(1:nbins_aerosol)%dmid**3 |
---|
1819 | ! |
---|
1820 | !-- Set concentrations to zero |
---|
1821 | pndist(:,:) = 0.0_wp |
---|
1822 | pnf2a(:) = nf2a |
---|
1823 | pmf2a(:,:) = 0.0_wp |
---|
1824 | pmf2b(:,:) = 0.0_wp |
---|
1825 | pmfoc1a(:) = 0.0_wp |
---|
1826 | |
---|
1827 | IF ( init_aerosol_type == 1 ) THEN |
---|
1828 | ! |
---|
1829 | !-- Read input profiles from PIDS_DYNAMIC_SALSA |
---|
1830 | #if defined( __netcdf ) |
---|
1831 | ! |
---|
1832 | !-- Location-dependent size distributions and compositions. |
---|
1833 | INQUIRE( FILE = TRIM( input_file_dynamic ) // TRIM( coupling_char ), EXIST = netcdf_extend ) |
---|
1834 | IF ( netcdf_extend ) THEN |
---|
1835 | ! |
---|
1836 | !-- Open file in read-only mode |
---|
1837 | CALL open_read_file( TRIM( input_file_dynamic ) // TRIM( coupling_char ), id_dyn ) |
---|
1838 | ! |
---|
1839 | !-- At first, inquire all variable names |
---|
1840 | CALL inquire_num_variables( id_dyn, num_vars ) |
---|
1841 | ! |
---|
1842 | !-- Allocate memory to store variable names |
---|
1843 | ALLOCATE( var_names(1:num_vars) ) |
---|
1844 | CALL inquire_variable_names( id_dyn, var_names ) |
---|
1845 | ! |
---|
1846 | !-- Inquire vertical dimension and number of aerosol chemical components |
---|
1847 | CALL get_dimension_length( id_dyn, pr_nz, 'z' ) |
---|
1848 | IF ( pr_nz /= nz ) THEN |
---|
1849 | WRITE( message_string, * ) 'Number of inifor horizontal grid points does not match '//& |
---|
1850 | 'the number of numeric grid points.' |
---|
1851 | CALL message( 'aerosol_init', 'PA0601', 1, 2, 0, 6, 0 ) |
---|
1852 | ENDIF |
---|
1853 | CALL get_dimension_length( id_dyn, pr_ncc, 'composition_index' ) |
---|
1854 | ! |
---|
1855 | !-- Allocate memory |
---|
1856 | ALLOCATE( pr_z(1:pr_nz), pr_mass_fracs_a(nzb:nzt+1,pr_ncc), & |
---|
1857 | pr_mass_fracs_b(nzb:nzt+1,pr_ncc) ) |
---|
1858 | pr_mass_fracs_a = 0.0_wp |
---|
1859 | pr_mass_fracs_b = 0.0_wp |
---|
1860 | ! |
---|
1861 | !-- Read vertical levels |
---|
1862 | CALL get_variable( id_dyn, 'z', pr_z ) |
---|
1863 | ! |
---|
1864 | !-- Read the names of chemical components |
---|
1865 | IF ( check_existence( var_names, 'composition_name' ) ) THEN |
---|
1866 | CALL get_variable( id_dyn, 'composition_name', cc_name, pr_ncc ) |
---|
1867 | ELSE |
---|
1868 | WRITE( message_string, * ) 'Missing composition_name in ' // TRIM( input_file_dynamic ) |
---|
1869 | CALL message( 'aerosol_init', 'PA0655', 1, 2, 0, 6, 0 ) |
---|
1870 | ENDIF |
---|
1871 | ! |
---|
1872 | !-- Define the index of each chemical component in the model |
---|
1873 | DO ic = 1, pr_ncc |
---|
1874 | SELECT CASE ( TRIM( cc_name(ic) ) ) |
---|
1875 | CASE ( 'H2SO4', 'SO4', 'h2so4', 'so4' ) |
---|
1876 | cc_in2mod(1) = ic |
---|
1877 | CASE ( 'OC', 'oc' ) |
---|
1878 | cc_in2mod(2) = ic |
---|
1879 | CASE ( 'BC', 'bc' ) |
---|
1880 | cc_in2mod(3) = ic |
---|
1881 | CASE ( 'DU', 'du' ) |
---|
1882 | cc_in2mod(4) = ic |
---|
1883 | CASE ( 'SS', 'ss' ) |
---|
1884 | cc_in2mod(5) = ic |
---|
1885 | CASE ( 'HNO3', 'hno3', 'NO3', 'no3', 'NO', 'no' ) |
---|
1886 | cc_in2mod(6) = ic |
---|
1887 | CASE ( 'NH3', 'nh3', 'NH4', 'nh4', 'NH', 'nh' ) |
---|
1888 | cc_in2mod(7) = ic |
---|
1889 | END SELECT |
---|
1890 | ENDDO |
---|
1891 | |
---|
1892 | IF ( SUM( cc_in2mod ) == 0 ) THEN |
---|
1893 | message_string = 'None of the aerosol chemical components in ' // TRIM( & |
---|
1894 | input_file_dynamic ) // ' correspond to ones applied in SALSA.' |
---|
1895 | CALL message( 'salsa_mod: aerosol_init', 'PA0602', 2, 2, 0, 6, 0 ) |
---|
1896 | ENDIF |
---|
1897 | ! |
---|
1898 | !-- Vertical profiles of mass fractions of different chemical components: |
---|
1899 | IF ( check_existence( var_names, 'init_atmosphere_mass_fracs_a' ) ) THEN |
---|
1900 | CALL get_variable( id_dyn, 'init_atmosphere_mass_fracs_a', pr_mass_fracs_a, & |
---|
1901 | 0, pr_ncc-1, 0, pr_nz-1 ) |
---|
1902 | ELSE |
---|
1903 | WRITE( message_string, * ) 'Missing init_atmosphere_mass_fracs_a in ' // & |
---|
1904 | TRIM( input_file_dynamic ) |
---|
1905 | CALL message( 'aerosol_init', 'PA0656', 1, 2, 0, 6, 0 ) |
---|
1906 | ENDIF |
---|
1907 | CALL get_variable( id_dyn, 'init_atmosphere_mass_fracs_b', pr_mass_fracs_b, & |
---|
1908 | 0, pr_ncc-1, 0, pr_nz-1 ) |
---|
1909 | ! |
---|
1910 | !-- Match the input data with the chemical composition applied in the model |
---|
1911 | DO ic = 1, maxspec |
---|
1912 | ss = cc_in2mod(ic) |
---|
1913 | IF ( ss == 0 ) CYCLE |
---|
1914 | pmf2a(nzb+1:nzt+1,ic) = pr_mass_fracs_a(nzb:nzt,ss) |
---|
1915 | pmf2b(nzb+1:nzt+1,ic) = pr_mass_fracs_b(nzb:nzt,ss) |
---|
1916 | ENDDO |
---|
1917 | ! |
---|
1918 | !-- Aerosol concentrations: lod=1 (vertical profile of sectional number size distribution) |
---|
1919 | CALL get_attribute( id_dyn, 'lod', lod_aero, .FALSE., 'init_atmosphere_aerosol' ) |
---|
1920 | IF ( lod_aero /= 1 ) THEN |
---|
1921 | message_string = 'Currently only lod=1 accepted for init_atmosphere_aerosol' |
---|
1922 | CALL message( 'salsa_mod: aerosol_init', 'PA0603', 2, 2, 0, 6, 0 ) |
---|
1923 | ELSE |
---|
1924 | ! |
---|
1925 | !-- Bin mean diameters in the input file |
---|
1926 | CALL get_dimension_length( id_dyn, pr_nbins, 'Dmid') |
---|
1927 | IF ( pr_nbins /= nbins_aerosol ) THEN |
---|
1928 | message_string = 'Number of size bins in init_atmosphere_aerosol does not match ' & |
---|
1929 | // 'with that applied in the model' |
---|
1930 | CALL message( 'salsa_mod: aerosol_init', 'PA0604', 2, 2, 0, 6, 0 ) |
---|
1931 | ENDIF |
---|
1932 | |
---|
1933 | ALLOCATE( pr_dmid(pr_nbins) ) |
---|
1934 | pr_dmid = 0.0_wp |
---|
1935 | |
---|
1936 | CALL get_variable( id_dyn, 'Dmid', pr_dmid ) |
---|
1937 | ! |
---|
1938 | !-- Check whether the sectional representation conform to the one |
---|
1939 | !-- applied in the model |
---|
1940 | IF ( ANY( ABS( ( aero(1:nbins_aerosol)%dmid - pr_dmid ) / & |
---|
1941 | aero(1:nbins_aerosol)%dmid ) > 0.1_wp ) ) THEN |
---|
1942 | message_string = 'Mean diameters of the aerosol size bins in ' // TRIM( & |
---|
1943 | input_file_dynamic ) // ' do not match with the sectional '// & |
---|
1944 | 'representation of the model.' |
---|
1945 | CALL message( 'salsa_mod: aerosol_init', 'PA0605', 2, 2, 0, 6, 0 ) |
---|
1946 | ENDIF |
---|
1947 | ! |
---|
1948 | !-- Inital aerosol concentrations |
---|
1949 | CALL get_variable( id_dyn, 'init_atmosphere_aerosol', pndist(nzb+1:nzt,:), & |
---|
1950 | 0, pr_nbins-1, 0, pr_nz-1 ) |
---|
1951 | ENDIF |
---|
1952 | ! |
---|
1953 | !-- Set bottom and top boundary condition (Neumann) |
---|
1954 | pmf2a(nzb,:) = pmf2a(nzb+1,:) |
---|
1955 | pmf2a(nzt+1,:) = pmf2a(nzt,:) |
---|
1956 | pmf2b(nzb,:) = pmf2b(nzb+1,:) |
---|
1957 | pmf2b(nzt+1,:) = pmf2b(nzt,:) |
---|
1958 | pndist(nzb,:) = pndist(nzb+1,:) |
---|
1959 | pndist(nzt+1,:) = pndist(nzt,:) |
---|
1960 | |
---|
1961 | IF ( index_so4 < 0 ) THEN |
---|
1962 | pmf2a(:,1) = 0.0_wp |
---|
1963 | pmf2b(:,1) = 0.0_wp |
---|
1964 | ENDIF |
---|
1965 | IF ( index_oc < 0 ) THEN |
---|
1966 | pmf2a(:,2) = 0.0_wp |
---|
1967 | pmf2b(:,2) = 0.0_wp |
---|
1968 | ENDIF |
---|
1969 | IF ( index_bc < 0 ) THEN |
---|
1970 | pmf2a(:,3) = 0.0_wp |
---|
1971 | pmf2b(:,3) = 0.0_wp |
---|
1972 | ENDIF |
---|
1973 | IF ( index_du < 0 ) THEN |
---|
1974 | pmf2a(:,4) = 0.0_wp |
---|
1975 | pmf2b(:,4) = 0.0_wp |
---|
1976 | ENDIF |
---|
1977 | IF ( index_ss < 0 ) THEN |
---|
1978 | pmf2a(:,5) = 0.0_wp |
---|
1979 | pmf2b(:,5) = 0.0_wp |
---|
1980 | ENDIF |
---|
1981 | IF ( index_no < 0 ) THEN |
---|
1982 | pmf2a(:,6) = 0.0_wp |
---|
1983 | pmf2b(:,6) = 0.0_wp |
---|
1984 | ENDIF |
---|
1985 | IF ( index_nh < 0 ) THEN |
---|
1986 | pmf2a(:,7) = 0.0_wp |
---|
1987 | pmf2b(:,7) = 0.0_wp |
---|
1988 | ENDIF |
---|
1989 | |
---|
1990 | IF ( SUM( pmf2a ) < 0.00001_wp .AND. SUM( pmf2b ) < 0.00001_wp ) THEN |
---|
1991 | message_string = 'Error in initialising mass fractions of chemical components. ' // & |
---|
1992 | 'Check that all chemical components are included in parameter file!' |
---|
1993 | CALL message( 'salsa_mod: aerosol_init', 'PA0606', 2, 2, 0, 6, 0 ) |
---|
1994 | ENDIF |
---|
1995 | ! |
---|
1996 | !-- Then normalise the mass fraction so that SUM = 1 |
---|
1997 | DO k = nzb, nzt+1 |
---|
1998 | pmf2a(k,:) = pmf2a(k,:) / SUM( pmf2a(k,:) ) |
---|
1999 | IF ( SUM( pmf2b(k,:) ) > 0.0_wp ) pmf2b(k,:) = pmf2b(k,:) / SUM( pmf2b(k,:) ) |
---|
2000 | ENDDO |
---|
2001 | |
---|
2002 | DEALLOCATE( pr_z, pr_mass_fracs_a, pr_mass_fracs_b ) |
---|
2003 | |
---|
2004 | ELSE |
---|
2005 | message_string = 'Input file '// TRIM( input_file_dynamic ) // TRIM( coupling_char ) // & |
---|
2006 | ' for SALSA missing!' |
---|
2007 | CALL message( 'salsa_mod: aerosol_init', 'PA0607', 1, 2, 0, 6, 0 ) |
---|
2008 | ! |
---|
2009 | !-- Close input file |
---|
2010 | CALL close_input_file( id_dyn ) |
---|
2011 | ENDIF ! netcdf_extend |
---|
2012 | |
---|
2013 | #else |
---|
2014 | message_string = 'init_aerosol_type = 1 but preprocessor directive __netcdf is not used '// & |
---|
2015 | 'in compiling!' |
---|
2016 | CALL message( 'salsa_mod: aerosol_init', 'PA0608', 1, 2, 0, 6, 0 ) |
---|
2017 | |
---|
2018 | #endif |
---|
2019 | |
---|
2020 | ELSEIF ( init_aerosol_type == 0 ) THEN |
---|
2021 | ! |
---|
2022 | !-- Mass fractions for species in a and b-bins |
---|
2023 | IF ( index_so4 > 0 ) THEN |
---|
2024 | pmf2a(:,1) = mass_fracs_a(index_so4) |
---|
2025 | pmf2b(:,1) = mass_fracs_b(index_so4) |
---|
2026 | ENDIF |
---|
2027 | IF ( index_oc > 0 ) THEN |
---|
2028 | pmf2a(:,2) = mass_fracs_a(index_oc) |
---|
2029 | pmf2b(:,2) = mass_fracs_b(index_oc) |
---|
2030 | ENDIF |
---|
2031 | IF ( index_bc > 0 ) THEN |
---|
2032 | pmf2a(:,3) = mass_fracs_a(index_bc) |
---|
2033 | pmf2b(:,3) = mass_fracs_b(index_bc) |
---|
2034 | ENDIF |
---|
2035 | IF ( index_du > 0 ) THEN |
---|
2036 | pmf2a(:,4) = mass_fracs_a(index_du) |
---|
2037 | pmf2b(:,4) = mass_fracs_b(index_du) |
---|
2038 | ENDIF |
---|
2039 | IF ( index_ss > 0 ) THEN |
---|
2040 | pmf2a(:,5) = mass_fracs_a(index_ss) |
---|
2041 | pmf2b(:,5) = mass_fracs_b(index_ss) |
---|
2042 | ENDIF |
---|
2043 | IF ( index_no > 0 ) THEN |
---|
2044 | pmf2a(:,6) = mass_fracs_a(index_no) |
---|
2045 | pmf2b(:,6) = mass_fracs_b(index_no) |
---|
2046 | ENDIF |
---|
2047 | IF ( index_nh > 0 ) THEN |
---|
2048 | pmf2a(:,7) = mass_fracs_a(index_nh) |
---|
2049 | pmf2b(:,7) = mass_fracs_b(index_nh) |
---|
2050 | ENDIF |
---|
2051 | DO k = nzb, nzt+1 |
---|
2052 | pmf2a(k,:) = pmf2a(k,:) / SUM( pmf2a(k,:) ) |
---|
2053 | IF ( SUM( pmf2b(k,:) ) > 0.0_wp ) pmf2b(k,:) = pmf2b(k,:) / SUM( pmf2b(k,:) ) |
---|
2054 | ENDDO |
---|
2055 | |
---|
2056 | CALL size_distribution( n_lognorm, dpg, sigmag, nsect ) |
---|
2057 | ! |
---|
2058 | !-- Normalize by the given total number concentration |
---|
2059 | nsect = nsect * SUM( n_lognorm ) / SUM( nsect ) |
---|
2060 | DO ib = start_subrange_1a, end_subrange_2b |
---|
2061 | pndist(:,ib) = nsect(ib) |
---|
2062 | ENDDO |
---|
2063 | ENDIF |
---|
2064 | |
---|
2065 | IF ( init_gases_type == 1 ) THEN |
---|
2066 | ! |
---|
2067 | !-- Read input profiles from PIDS_CHEM |
---|
2068 | #if defined( __netcdf ) |
---|
2069 | ! |
---|
2070 | !-- Location-dependent size distributions and compositions. |
---|
2071 | INQUIRE( FILE = TRIM( input_file_dynamic ) // TRIM( coupling_char ), EXIST = netcdf_extend ) |
---|
2072 | IF ( netcdf_extend .AND. .NOT. salsa_gases_from_chem ) THEN |
---|
2073 | ! |
---|
2074 | !-- Open file in read-only mode |
---|
2075 | CALL open_read_file( TRIM( input_file_dynamic ) // TRIM( coupling_char ), id_dyn ) |
---|
2076 | ! |
---|
2077 | !-- Inquire dimensions: |
---|
2078 | CALL get_dimension_length( id_dyn, pr_nz, 'z' ) |
---|
2079 | IF ( pr_nz /= nz ) THEN |
---|
2080 | WRITE( message_string, * ) 'Number of inifor horizontal grid points does not match '//& |
---|
2081 | 'the number of numeric grid points.' |
---|
2082 | CALL message( 'aerosol_init', 'PA0609', 1, 2, 0, 6, 0 ) |
---|
2083 | ENDIF |
---|
2084 | ! |
---|
2085 | !-- Read vertical profiles of gases: |
---|
2086 | CALL get_variable( id_dyn, 'init_atmosphere_h2so4', salsa_gas(1)%init(nzb+1:nzt) ) |
---|
2087 | CALL get_variable( id_dyn, 'init_atmosphere_hno3', salsa_gas(2)%init(nzb+1:nzt) ) |
---|
2088 | CALL get_variable( id_dyn, 'init_atmosphere_nh3', salsa_gas(3)%init(nzb+1:nzt) ) |
---|
2089 | CALL get_variable( id_dyn, 'init_atmosphere_ocnv', salsa_gas(4)%init(nzb+1:nzt) ) |
---|
2090 | CALL get_variable( id_dyn, 'init_atmosphere_ocsv', salsa_gas(5)%init(nzb+1:nzt) ) |
---|
2091 | ! |
---|
2092 | !-- Set Neumann top and surface boundary condition for initial + initialise concentrations |
---|
2093 | DO ig = 1, ngases_salsa |
---|
2094 | salsa_gas(ig)%init(nzb) = salsa_gas(ig)%init(nzb+1) |
---|
2095 | salsa_gas(ig)%init(nzt+1) = salsa_gas(ig)%init(nzt) |
---|
2096 | IF ( .NOT. read_restart_data_salsa ) THEN |
---|
2097 | DO k = nzb, nzt+1 |
---|
2098 | salsa_gas(ig)%conc(k,:,:) = salsa_gas(ig)%init(k) |
---|
2099 | ENDDO |
---|
2100 | ENDIF |
---|
2101 | ENDDO |
---|
2102 | |
---|
2103 | ELSEIF ( .NOT. netcdf_extend .AND. .NOT. salsa_gases_from_chem ) THEN |
---|
2104 | message_string = 'Input file '// TRIM( input_file_dynamic ) // TRIM( coupling_char ) // & |
---|
2105 | ' for SALSA missing!' |
---|
2106 | CALL message( 'salsa_mod: aerosol_init', 'PA0610', 1, 2, 0, 6, 0 ) |
---|
2107 | ! |
---|
2108 | !-- Close input file |
---|
2109 | CALL close_input_file( id_dyn ) |
---|
2110 | ENDIF ! netcdf_extend |
---|
2111 | #else |
---|
2112 | message_string = 'init_gases_type = 1 but preprocessor directive __netcdf is not used in '//& |
---|
2113 | 'compiling!' |
---|
2114 | CALL message( 'salsa_mod: aerosol_init', 'PA0611', 1, 2, 0, 6, 0 ) |
---|
2115 | |
---|
2116 | #endif |
---|
2117 | |
---|
2118 | ENDIF |
---|
2119 | ! |
---|
2120 | !-- Both SO4 and OC are included, so use the given mass fractions |
---|
2121 | IF ( index_oc > 0 .AND. index_so4 > 0 ) THEN |
---|
2122 | pmfoc1a(:) = pmf2a(:,2) / ( pmf2a(:,2) + pmf2a(:,1) ) ! Normalize |
---|
2123 | ! |
---|
2124 | !-- Pure organic carbon |
---|
2125 | ELSEIF ( index_oc > 0 ) THEN |
---|
2126 | pmfoc1a(:) = 1.0_wp |
---|
2127 | ! |
---|
2128 | !-- Pure SO4 |
---|
2129 | ELSEIF ( index_so4 > 0 ) THEN |
---|
2130 | pmfoc1a(:) = 0.0_wp |
---|
2131 | |
---|
2132 | ELSE |
---|
2133 | message_string = 'Either OC or SO4 must be active for aerosol region 1a!' |
---|
2134 | CALL message( 'salsa_mod: aerosol_init', 'PA0612', 1, 2, 0, 6, 0 ) |
---|
2135 | ENDIF |
---|
2136 | |
---|
2137 | ! |
---|
2138 | !-- Initialize concentrations |
---|
2139 | DO i = nxlg, nxrg |
---|
2140 | DO j = nysg, nyng |
---|
2141 | DO k = nzb, nzt+1 |
---|
2142 | ! |
---|
2143 | !-- Predetermine flag to mask topography |
---|
2144 | flag = MERGE( 1.0_wp, 0.0_wp, BTEST( wall_flags_0(k,j,i), 0 ) ) |
---|
2145 | ! |
---|
2146 | !-- a) Number concentrations |
---|
2147 | !-- Region 1: |
---|
2148 | DO ib = start_subrange_1a, end_subrange_1a |
---|
2149 | IF ( .NOT. read_restart_data_salsa ) THEN |
---|
2150 | aerosol_number(ib)%conc(k,j,i) = pndist(k,ib) * flag |
---|
2151 | ENDIF |
---|
2152 | IF ( prunmode == 1 ) THEN |
---|
2153 | aerosol_number(ib)%init = pndist(:,ib) |
---|
2154 | ENDIF |
---|
2155 | ENDDO |
---|
2156 | ! |
---|
2157 | !-- Region 2: |
---|
2158 | IF ( nreg > 1 ) THEN |
---|
2159 | DO ib = start_subrange_2a, end_subrange_2a |
---|
2160 | IF ( .NOT. read_restart_data_salsa ) THEN |
---|
2161 | aerosol_number(ib)%conc(k,j,i) = MAX( 0.0_wp, pnf2a(k) ) * pndist(k,ib) * flag |
---|
2162 | ENDIF |
---|
2163 | IF ( prunmode == 1 ) THEN |
---|
2164 | aerosol_number(ib)%init = MAX( 0.0_wp, nf2a ) * pndist(:,ib) |
---|
2165 | ENDIF |
---|
2166 | ENDDO |
---|
2167 | IF ( .NOT. no_insoluble ) THEN |
---|
2168 | DO ib = start_subrange_2b, end_subrange_2b |
---|
2169 | IF ( pnf2a(k) < 1.0_wp ) THEN |
---|
2170 | IF ( .NOT. read_restart_data_salsa ) THEN |
---|
2171 | aerosol_number(ib)%conc(k,j,i) = MAX( 0.0_wp, 1.0_wp - pnf2a(k) ) * & |
---|
2172 | pndist(k,ib) * flag |
---|
2173 | ENDIF |
---|
2174 | IF ( prunmode == 1 ) THEN |
---|
2175 | aerosol_number(ib)%init = MAX( 0.0_wp, 1.0_wp - nf2a ) * pndist(:,ib) |
---|
2176 | ENDIF |
---|
2177 | ENDIF |
---|
2178 | ENDDO |
---|
2179 | ENDIF |
---|
2180 | ENDIF |
---|
2181 | ! |
---|
2182 | !-- b) Aerosol mass concentrations |
---|
2183 | !-- bin subrange 1: done here separately due to the SO4/OC convention |
---|
2184 | ! |
---|
2185 | !-- SO4: |
---|
2186 | IF ( index_so4 > 0 ) THEN |
---|
2187 | ss = ( index_so4 - 1 ) * nbins_aerosol + start_subrange_1a !< start |
---|
2188 | ee = ( index_so4 - 1 ) * nbins_aerosol + end_subrange_1a !< end |
---|
2189 | ib = start_subrange_1a |
---|
2190 | DO ic = ss, ee |
---|
2191 | IF ( .NOT. read_restart_data_salsa ) THEN |
---|
2192 | aerosol_mass(ic)%conc(k,j,i) = MAX( 0.0_wp, 1.0_wp - pmfoc1a(k) ) * & |
---|
2193 | pndist(k,ib) * core(ib) * arhoh2so4 * flag |
---|
2194 | ENDIF |
---|
2195 | IF ( prunmode == 1 ) THEN |
---|
2196 | aerosol_mass(ic)%init(k) = MAX( 0.0_wp, 1.0_wp - pmfoc1a(k) ) * pndist(k,ib) & |
---|
2197 | * core(ib) * arhoh2so4 |
---|
2198 | ENDIF |
---|
2199 | ib = ib+1 |
---|
2200 | ENDDO |
---|
2201 | ENDIF |
---|
2202 | ! |
---|
2203 | !-- OC: |
---|
2204 | IF ( index_oc > 0 ) THEN |
---|
2205 | ss = ( index_oc - 1 ) * nbins_aerosol + start_subrange_1a !< start |
---|
2206 | ee = ( index_oc - 1 ) * nbins_aerosol + end_subrange_1a !< end |
---|
2207 | ib = start_subrange_1a |
---|
2208 | DO ic = ss, ee |
---|
2209 | IF ( .NOT. read_restart_data_salsa ) THEN |
---|
2210 | aerosol_mass(ic)%conc(k,j,i) = MAX( 0.0_wp, pmfoc1a(k) ) * pndist(k,ib) * & |
---|
2211 | core(ib) * arhooc * flag |
---|
2212 | ENDIF |
---|
2213 | IF ( prunmode == 1 ) THEN |
---|
2214 | aerosol_mass(ic)%init(k) = MAX( 0.0_wp, pmfoc1a(k) ) * pndist(k,ib) * & |
---|
2215 | core(ib) * arhooc |
---|
2216 | ENDIF |
---|
2217 | ib = ib+1 |
---|
2218 | ENDDO |
---|
2219 | ENDIF |
---|
2220 | ENDDO !< k |
---|
2221 | |
---|
2222 | prunmode = 3 ! Init only once |
---|
2223 | |
---|
2224 | ENDDO !< j |
---|
2225 | ENDDO !< i |
---|
2226 | |
---|
2227 | ! |
---|
2228 | !-- c) Aerosol mass concentrations |
---|
2229 | !-- bin subrange 2: |
---|
2230 | IF ( nreg > 1 ) THEN |
---|
2231 | |
---|
2232 | IF ( index_so4 > 0 ) THEN |
---|
2233 | CALL set_aero_mass( index_so4, pmf2a(:,1), pmf2b(:,1), pnf2a, pndist, core, arhoh2so4 ) |
---|
2234 | ENDIF |
---|
2235 | IF ( index_oc > 0 ) THEN |
---|
2236 | CALL set_aero_mass( index_oc, pmf2a(:,2), pmf2b(:,2), pnf2a, pndist, core, arhooc ) |
---|
2237 | ENDIF |
---|
2238 | IF ( index_bc > 0 ) THEN |
---|
2239 | CALL set_aero_mass( index_bc, pmf2a(:,3), pmf2b(:,3), pnf2a, pndist, core, arhobc ) |
---|
2240 | ENDIF |
---|
2241 | IF ( index_du > 0 ) THEN |
---|
2242 | CALL set_aero_mass( index_du, pmf2a(:,4), pmf2b(:,4), pnf2a, pndist, core, arhodu ) |
---|
2243 | ENDIF |
---|
2244 | IF ( index_ss > 0 ) THEN |
---|
2245 | CALL set_aero_mass( index_ss, pmf2a(:,5), pmf2b(:,5), pnf2a, pndist, core, arhoss ) |
---|
2246 | ENDIF |
---|
2247 | IF ( index_no > 0 ) THEN |
---|
2248 | CALL set_aero_mass( index_no, pmf2a(:,6), pmf2b(:,6), pnf2a, pndist, core, arhohno3 ) |
---|
2249 | ENDIF |
---|
2250 | IF ( index_nh > 0 ) THEN |
---|
2251 | CALL set_aero_mass( index_nh, pmf2a(:,7), pmf2b(:,7), pnf2a, pndist, core, arhonh3 ) |
---|
2252 | ENDIF |
---|
2253 | |
---|
2254 | ENDIF |
---|
2255 | |
---|
2256 | END SUBROUTINE aerosol_init |
---|
2257 | |
---|
2258 | !------------------------------------------------------------------------------! |
---|
2259 | ! Description: |
---|
2260 | ! ------------ |
---|
2261 | !> Create a lognormal size distribution and discretise to a sectional |
---|
2262 | !> representation. |
---|
2263 | !------------------------------------------------------------------------------! |
---|
2264 | SUBROUTINE size_distribution( in_ntot, in_dpg, in_sigma, psd_sect ) |
---|
2265 | |
---|
2266 | IMPLICIT NONE |
---|
2267 | |
---|
2268 | INTEGER(iwp) :: ib !< running index: bin |
---|
2269 | INTEGER(iwp) :: iteration !< running index: iteration |
---|
2270 | |
---|
2271 | REAL(wp) :: d1 !< particle diameter (m, dummy) |
---|
2272 | REAL(wp) :: d2 !< particle diameter (m, dummy) |
---|
2273 | REAL(wp) :: delta_d !< (d2-d1)/10 |
---|
2274 | REAL(wp) :: deltadp !< bin width |
---|
2275 | REAL(wp) :: dmidi !< ( d1 + d2 ) / 2 |
---|
2276 | |
---|
2277 | REAL(wp), DIMENSION(:), INTENT(in) :: in_dpg !< geometric mean diameter (m) |
---|
2278 | REAL(wp), DIMENSION(:), INTENT(in) :: in_ntot !< number conc. (#/m3) |
---|
2279 | REAL(wp), DIMENSION(:), INTENT(in) :: in_sigma !< standard deviation |
---|
2280 | |
---|
2281 | REAL(wp), DIMENSION(:), INTENT(inout) :: psd_sect !< sectional size distribution |
---|
2282 | |
---|
2283 | DO ib = start_subrange_1a, end_subrange_2b |
---|
2284 | psd_sect(ib) = 0.0_wp |
---|
2285 | ! |
---|
2286 | !-- Particle diameter at the low limit (largest in the bin) (m) |
---|
2287 | d1 = ( aero(ib)%vlolim / api6 )**0.33333333_wp |
---|
2288 | ! |
---|
2289 | !-- Particle diameter at the high limit (smallest in the bin) (m) |
---|
2290 | d2 = ( aero(ib)%vhilim / api6 )**0.33333333_wp |
---|
2291 | ! |
---|
2292 | !-- Span of particle diameter in a bin (m) |
---|
2293 | delta_d = 0.1_wp * ( d2 - d1 ) |
---|
2294 | ! |
---|
2295 | !-- Iterate: |
---|
2296 | DO iteration = 1, 10 |
---|
2297 | d1 = ( aero(ib)%vlolim / api6 )**0.33333333_wp + ( ib - 1) * delta_d |
---|
2298 | d2 = d1 + delta_d |
---|
2299 | dmidi = 0.5_wp * ( d1 + d2 ) |
---|
2300 | deltadp = LOG10( d2 / d1 ) |
---|
2301 | ! |
---|
2302 | !-- Size distribution |
---|
2303 | !-- in_ntot = total number, total area, or total volume concentration |
---|
2304 | !-- in_dpg = geometric-mean number, area, or volume diameter |
---|
2305 | !-- n(k) = number, area, or volume concentration in a bin |
---|
2306 | psd_sect(ib) = psd_sect(ib) + SUM( in_ntot * deltadp / ( SQRT( 2.0_wp * pi ) * & |
---|
2307 | LOG10( in_sigma ) ) * EXP( -LOG10( dmidi / in_dpg )**2.0_wp / & |
---|
2308 | ( 2.0_wp * LOG10( in_sigma ) ** 2.0_wp ) ) ) |
---|
2309 | |
---|
2310 | ENDDO |
---|
2311 | ENDDO |
---|
2312 | |
---|
2313 | END SUBROUTINE size_distribution |
---|
2314 | |
---|
2315 | !------------------------------------------------------------------------------! |
---|
2316 | ! Description: |
---|
2317 | ! ------------ |
---|
2318 | !> Sets the mass concentrations to aerosol arrays in 2a and 2b. |
---|
2319 | !> |
---|
2320 | !> Tomi Raatikainen, FMI, 29.2.2016 |
---|
2321 | !------------------------------------------------------------------------------! |
---|
2322 | SUBROUTINE set_aero_mass( ispec, pmf2a, pmf2b, pnf2a, pndist, pcore, prho ) |
---|
2323 | |
---|
2324 | IMPLICIT NONE |
---|
2325 | |
---|
2326 | INTEGER(iwp) :: ee !< index: end |
---|
2327 | INTEGER(iwp) :: i !< loop index |
---|
2328 | INTEGER(iwp) :: ib !< loop index |
---|
2329 | INTEGER(iwp) :: ic !< loop index |
---|
2330 | INTEGER(iwp) :: j !< loop index |
---|
2331 | INTEGER(iwp) :: k !< loop index |
---|
2332 | INTEGER(iwp) :: prunmode !< 1 = initialise |
---|
2333 | INTEGER(iwp) :: ss !< index: start |
---|
2334 | |
---|
2335 | INTEGER(iwp), INTENT(in) :: ispec !< Aerosol species index |
---|
2336 | |
---|
2337 | REAL(wp) :: flag !< flag to mask topography grid points |
---|
2338 | |
---|
2339 | REAL(wp), INTENT(in) :: prho !< Aerosol density |
---|
2340 | |
---|
2341 | REAL(wp), DIMENSION(nbins_aerosol), INTENT(in) :: pcore !< Aerosol bin mid core volume |
---|
2342 | REAL(wp), DIMENSION(0:nz+1), INTENT(in) :: pnf2a !< Number fraction for 2a |
---|
2343 | REAL(wp), DIMENSION(0:nz+1), INTENT(in) :: pmf2a !< Mass distributions for a |
---|
2344 | REAL(wp), DIMENSION(0:nz+1), INTENT(in) :: pmf2b !< and b bins |
---|
2345 | |
---|
2346 | REAL(wp), DIMENSION(0:nz+1,nbins_aerosol), INTENT(in) :: pndist !< Aerosol size distribution |
---|
2347 | |
---|
2348 | prunmode = 1 |
---|
2349 | |
---|
2350 | DO i = nxlg, nxrg |
---|
2351 | DO j = nysg, nyng |
---|
2352 | DO k = nzb, nzt+1 |
---|
2353 | ! |
---|
2354 | !-- Predetermine flag to mask topography |
---|
2355 | flag = MERGE( 1.0_wp, 0.0_wp, BTEST( wall_flags_0(k,j,i), 0 ) ) |
---|
2356 | ! |
---|
2357 | !-- Regime 2a: |
---|
2358 | ss = ( ispec - 1 ) * nbins_aerosol + start_subrange_2a |
---|
2359 | ee = ( ispec - 1 ) * nbins_aerosol + end_subrange_2a |
---|
2360 | ib = start_subrange_2a |
---|
2361 | DO ic = ss, ee |
---|
2362 | IF ( .NOT. read_restart_data_salsa ) THEN |
---|
2363 | aerosol_mass(ic)%conc(k,j,i) = MAX( 0.0_wp, pmf2a(k) ) * pnf2a(k) * pndist(k,ib)& |
---|
2364 | * pcore(ib) * prho * flag |
---|
2365 | ENDIF |
---|
2366 | IF ( prunmode == 1 ) THEN |
---|
2367 | aerosol_mass(ic)%init(k) = MAX( 0.0_wp, pmf2a(k) ) * pnf2a(k) * pndist(k,ib) * & |
---|
2368 | pcore(ib) * prho |
---|
2369 | ENDIF |
---|
2370 | ib = ib + 1 |
---|
2371 | ENDDO |
---|
2372 | ! |
---|
2373 | !-- Regime 2b: |
---|
2374 | IF ( .NOT. no_insoluble ) THEN |
---|
2375 | ss = ( ispec - 1 ) * nbins_aerosol + start_subrange_2b |
---|
2376 | ee = ( ispec - 1 ) * nbins_aerosol + end_subrange_2b |
---|
2377 | ib = start_subrange_2a |
---|
2378 | DO ic = ss, ee |
---|
2379 | IF ( .NOT. read_restart_data_salsa ) THEN |
---|
2380 | aerosol_mass(ic)%conc(k,j,i) = MAX( 0.0_wp, pmf2b(k) ) * ( 1.0_wp - pnf2a(k))& |
---|
2381 | * pndist(k,ib) * pcore(ib) * prho * flag |
---|
2382 | ENDIF |
---|
2383 | IF ( prunmode == 1 ) THEN |
---|
2384 | aerosol_mass(ic)%init(k) = MAX( 0.0_wp, pmf2b(k) ) * ( 1.0_wp - pnf2a(k) ) * & |
---|
2385 | pndist(k,ib) * pcore(ib) * prho |
---|
2386 | ENDIF |
---|
2387 | ib = ib + 1 |
---|
2388 | ENDDO ! c |
---|
2389 | |
---|
2390 | ENDIF |
---|
2391 | ENDDO ! k |
---|
2392 | |
---|
2393 | prunmode = 3 ! Init only once |
---|
2394 | |
---|
2395 | ENDDO ! j |
---|
2396 | ENDDO ! i |
---|
2397 | |
---|
2398 | END SUBROUTINE set_aero_mass |
---|
2399 | |
---|
2400 | !------------------------------------------------------------------------------! |
---|
2401 | ! Description: |
---|
2402 | ! ------------ |
---|
2403 | !> Initialise the matching between surface types in LSM and deposition models. |
---|
2404 | !> Do the matching based on Zhang et al. (2001). Atmos. Environ. 35, 549-560 |
---|
2405 | !> (here referred as Z01). |
---|
2406 | !------------------------------------------------------------------------------! |
---|
2407 | SUBROUTINE init_deposition |
---|
2408 | |
---|
2409 | USE surface_mod, & |
---|
2410 | ONLY: surf_lsm_h, surf_lsm_v, surf_usm_h, surf_usm_v |
---|
2411 | |
---|
2412 | IMPLICIT NONE |
---|
2413 | |
---|
2414 | INTEGER(iwp) :: l !< loop index for vertical surfaces |
---|
2415 | |
---|
2416 | LOGICAL :: match_lsm !< flag to initilise LSM surfaces (if false, initialise USM surfaces) |
---|
2417 | |
---|
2418 | IF ( depo_pcm_par == 'zhang2001' ) THEN |
---|
2419 | depo_pcm_par_num = 1 |
---|
2420 | ELSEIF ( depo_pcm_par == 'petroff2010' ) THEN |
---|
2421 | depo_pcm_par_num = 2 |
---|
2422 | ENDIF |
---|
2423 | |
---|
2424 | IF ( depo_surf_par == 'zhang2001' ) THEN |
---|
2425 | depo_surf_par_num = 1 |
---|
2426 | ELSEIF ( depo_surf_par == 'petroff2010' ) THEN |
---|
2427 | depo_surf_par_num = 2 |
---|
2428 | ENDIF |
---|
2429 | ! |
---|
2430 | !-- LSM: Pavement, vegetation and water |
---|
2431 | IF ( nldepo_surf .AND. land_surface ) THEN |
---|
2432 | match_lsm = .TRUE. |
---|
2433 | ALLOCATE( lsm_to_depo_h%match_lupg(1:surf_lsm_h%ns), & |
---|
2434 | lsm_to_depo_h%match_luvw(1:surf_lsm_h%ns), & |
---|
2435 | lsm_to_depo_h%match_luww(1:surf_lsm_h%ns) ) |
---|
2436 | lsm_to_depo_h%match_lupg = 0 |
---|
2437 | lsm_to_depo_h%match_luvw = 0 |
---|
2438 | lsm_to_depo_h%match_luww = 0 |
---|
2439 | CALL match_sm_zhang( surf_lsm_h, lsm_to_depo_h%match_lupg, lsm_to_depo_h%match_luvw, & |
---|
2440 | lsm_to_depo_h%match_luww, match_lsm ) |
---|
2441 | DO l = 0, 3 |
---|
2442 | ALLOCATE( lsm_to_depo_v(l)%match_lupg(1:surf_lsm_v(l)%ns), & |
---|
2443 | lsm_to_depo_v(l)%match_luvw(1:surf_lsm_v(l)%ns), & |
---|
2444 | lsm_to_depo_v(l)%match_luww(1:surf_lsm_v(l)%ns) ) |
---|
2445 | lsm_to_depo_v(l)%match_lupg = 0 |
---|
2446 | lsm_to_depo_v(l)%match_luvw = 0 |
---|
2447 | lsm_to_depo_v(l)%match_luww = 0 |
---|
2448 | CALL match_sm_zhang( surf_lsm_v(l), lsm_to_depo_v(l)%match_lupg, & |
---|
2449 | lsm_to_depo_v(l)%match_luvw, lsm_to_depo_v(l)%match_luww, match_lsm ) |
---|
2450 | ENDDO |
---|
2451 | ENDIF |
---|
2452 | ! |
---|
2453 | !-- USM: Green roofs/walls, wall surfaces and windows |
---|
2454 | IF ( nldepo_surf .AND. urban_surface ) THEN |
---|
2455 | match_lsm = .FALSE. |
---|
2456 | ALLOCATE( usm_to_depo_h%match_lupg(1:surf_usm_h%ns), & |
---|
2457 | usm_to_depo_h%match_luvw(1:surf_usm_h%ns), & |
---|
2458 | usm_to_depo_h%match_luww(1:surf_usm_h%ns) ) |
---|
2459 | usm_to_depo_h%match_lupg = 0 |
---|
2460 | usm_to_depo_h%match_luvw = 0 |
---|
2461 | usm_to_depo_h%match_luww = 0 |
---|
2462 | CALL match_sm_zhang( surf_usm_h, usm_to_depo_h%match_lupg, usm_to_depo_h%match_luvw, & |
---|
2463 | usm_to_depo_h%match_luww, match_lsm ) |
---|
2464 | DO l = 0, 3 |
---|
2465 | ALLOCATE( usm_to_depo_v(l)%match_lupg(1:surf_usm_v(l)%ns), & |
---|
2466 | usm_to_depo_v(l)%match_luvw(1:surf_usm_v(l)%ns), & |
---|
2467 | usm_to_depo_v(l)%match_luww(1:surf_usm_v(l)%ns) ) |
---|
2468 | usm_to_depo_v(l)%match_lupg = 0 |
---|
2469 | usm_to_depo_v(l)%match_luvw = 0 |
---|
2470 | usm_to_depo_v(l)%match_luww = 0 |
---|
2471 | CALL match_sm_zhang( surf_usm_v(l), usm_to_depo_v(l)%match_lupg, & |
---|
2472 | usm_to_depo_v(l)%match_luvw, usm_to_depo_v(l)%match_luww, match_lsm ) |
---|
2473 | ENDDO |
---|
2474 | ENDIF |
---|
2475 | |
---|
2476 | IF ( nldepo_pcm ) THEN |
---|
2477 | SELECT CASE ( depo_pcm_type ) |
---|
2478 | CASE ( 'evergreen_needleleaf' ) |
---|
2479 | depo_pcm_type_num = 1 |
---|
2480 | CASE ( 'evergreen_broadleaf' ) |
---|
2481 | depo_pcm_type_num = 2 |
---|
2482 | CASE ( 'deciduous_needleleaf' ) |
---|
2483 | depo_pcm_type_num = 3 |
---|
2484 | CASE ( 'deciduous_broadleaf' ) |
---|
2485 | depo_pcm_type_num = 4 |
---|
2486 | CASE DEFAULT |
---|
2487 | message_string = 'depo_pcm_type not set correctly.' |
---|
2488 | CALL message( 'salsa_mod: init_deposition', 'PA0613', 1, 2, 0, 6, 0 ) |
---|
2489 | END SELECT |
---|
2490 | ENDIF |
---|
2491 | |
---|
2492 | END SUBROUTINE init_deposition |
---|
2493 | |
---|
2494 | !------------------------------------------------------------------------------! |
---|
2495 | ! Description: |
---|
2496 | ! ------------ |
---|
2497 | !> Match the surface types in PALM and Zhang et al. 2001 deposition module |
---|
2498 | !------------------------------------------------------------------------------! |
---|
2499 | SUBROUTINE match_sm_zhang( surf, match_pav_green, match_veg_wall, match_wat_win, match_lsm ) |
---|
2500 | |
---|
2501 | USE surface_mod, & |
---|
2502 | ONLY: ind_pav_green, ind_veg_wall, ind_wat_win, surf_type |
---|
2503 | |
---|
2504 | IMPLICIT NONE |
---|
2505 | |
---|
2506 | INTEGER(iwp) :: m !< index for surface elements |
---|
2507 | INTEGER(iwp) :: pav_type_palm !< pavement / green wall type in PALM |
---|
2508 | INTEGER(iwp) :: veg_type_palm !< vegetation / wall type in PALM |
---|
2509 | INTEGER(iwp) :: wat_type_palm !< water / window type in PALM |
---|
2510 | |
---|
2511 | INTEGER(iwp), DIMENSION(:), INTENT(inout) :: match_pav_green !< matching pavement/green walls |
---|
2512 | INTEGER(iwp), DIMENSION(:), INTENT(inout) :: match_veg_wall !< matching vegetation/walls |
---|
2513 | INTEGER(iwp), DIMENSION(:), INTENT(inout) :: match_wat_win !< matching water/windows |
---|
2514 | |
---|
2515 | LOGICAL, INTENT(in) :: match_lsm !< flag to initilise LSM surfaces (if false, initialise USM) |
---|
2516 | |
---|
2517 | TYPE(surf_type), INTENT(in) :: surf !< respective surface type |
---|
2518 | |
---|
2519 | DO m = 1, surf%ns |
---|
2520 | IF ( match_lsm ) THEN |
---|
2521 | ! |
---|
2522 | !-- Vegetation (LSM): |
---|
2523 | IF ( surf%frac(ind_veg_wall,m) > 0 ) THEN |
---|
2524 | veg_type_palm = surf%vegetation_type(m) |
---|
2525 | SELECT CASE ( veg_type_palm ) |
---|
2526 | CASE ( 0 ) |
---|
2527 | message_string = 'No vegetation type defined.' |
---|
2528 | CALL message( 'salsa_mod: init_depo_surfaces', 'PA0614', 1, 2, 0, 6, 0 ) |
---|
2529 | CASE ( 1 ) ! bare soil |
---|
2530 | match_veg_wall(m) = 6 ! grass in Z01 |
---|
2531 | CASE ( 2 ) ! crops, mixed farming |
---|
2532 | match_veg_wall(m) = 7 ! crops, mixed farming Z01 |
---|
2533 | CASE ( 3 ) ! short grass |
---|
2534 | match_veg_wall(m) = 6 ! grass in Z01 |
---|
2535 | CASE ( 4 ) ! evergreen needleleaf trees |
---|
2536 | match_veg_wall(m) = 1 ! evergreen needleleaf trees in Z01 |
---|
2537 | CASE ( 5 ) ! deciduous needleleaf trees |
---|
2538 | match_veg_wall(m) = 3 ! deciduous needleleaf trees in Z01 |
---|
2539 | CASE ( 6 ) ! evergreen broadleaf trees |
---|
2540 | match_veg_wall(m) = 2 ! evergreen broadleaf trees in Z01 |
---|
2541 | CASE ( 7 ) ! deciduous broadleaf trees |
---|
2542 | match_veg_wall(m) = 4 ! deciduous broadleaf trees in Z01 |
---|
2543 | CASE ( 8 ) ! tall grass |
---|
2544 | match_veg_wall(m) = 6 ! grass in Z01 |
---|
2545 | CASE ( 9 ) ! desert |
---|
2546 | match_veg_wall(m) = 8 ! desert in Z01 |
---|
2547 | CASE ( 10 ) ! tundra |
---|
2548 | match_veg_wall(m) = 9 ! tundra in Z01 |
---|
2549 | CASE ( 11 ) ! irrigated crops |
---|
2550 | match_veg_wall(m) = 7 ! crops, mixed farming Z01 |
---|
2551 | CASE ( 12 ) ! semidesert |
---|
2552 | match_veg_wall(m) = 8 ! desert in Z01 |
---|
2553 | CASE ( 13 ) ! ice caps and glaciers |
---|
2554 | match_veg_wall(m) = 12 ! ice cap and glacier in Z01 |
---|
2555 | CASE ( 14 ) ! bogs and marshes |
---|
2556 | match_veg_wall(m) = 11 ! wetland with plants in Z01 |
---|
2557 | CASE ( 15 ) ! evergreen shrubs |
---|
2558 | match_veg_wall(m) = 10 ! shrubs and interrupted woodlands in Z01 |
---|
2559 | CASE ( 16 ) ! deciduous shrubs |
---|
2560 | match_veg_wall(m) = 10 ! shrubs and interrupted woodlands in Z01 |
---|
2561 | CASE ( 17 ) ! mixed forest/woodland |
---|
2562 | match_veg_wall(m) = 5 ! mixed broadleaf and needleleaf trees in Z01 |
---|
2563 | CASE ( 18 ) ! interrupted forest |
---|
2564 | match_veg_wall(m) = 10 ! shrubs and interrupted woodlands in Z01 |
---|
2565 | END SELECT |
---|
2566 | ENDIF |
---|
2567 | ! |
---|
2568 | !-- Pavement (LSM): |
---|
2569 | IF ( surf%frac(ind_pav_green,m) > 0 ) THEN |
---|
2570 | pav_type_palm = surf%pavement_type(m) |
---|
2571 | IF ( pav_type_palm == 0 ) THEN ! error |
---|
2572 | message_string = 'No pavement type defined.' |
---|
2573 | CALL message( 'salsa_mod: match_sm_zhang', 'PA0615', 1, 2, 0, 6, 0 ) |
---|
2574 | ELSE |
---|
2575 | match_pav_green(m) = 15 ! urban in Z01 |
---|
2576 | ENDIF |
---|
2577 | ENDIF |
---|
2578 | ! |
---|
2579 | !-- Water (LSM): |
---|
2580 | IF ( surf%frac(ind_wat_win,m) > 0 ) THEN |
---|
2581 | wat_type_palm = surf%water_type(m) |
---|
2582 | IF ( wat_type_palm == 0 ) THEN ! error |
---|
2583 | message_string = 'No water type defined.' |
---|
2584 | CALL message( 'salsa_mod: match_sm_zhang', 'PA0616', 1, 2, 0, 6, 0 ) |
---|
2585 | ELSEIF ( wat_type_palm == 3 ) THEN |
---|
2586 | match_wat_win(m) = 14 ! ocean in Z01 |
---|
2587 | ELSEIF ( wat_type_palm == 1 .OR. wat_type_palm == 2 .OR. wat_type_palm == 4 & |
---|
2588 | .OR. wat_type_palm == 5 ) THEN |
---|
2589 | match_wat_win(m) = 13 ! inland water in Z01 |
---|
2590 | ENDIF |
---|
2591 | ENDIF |
---|
2592 | ELSE |
---|
2593 | ! |
---|
2594 | !-- Wall surfaces (USM): |
---|
2595 | IF ( surf%frac(ind_veg_wall,m) > 0 ) THEN |
---|
2596 | match_veg_wall(m) = 15 ! urban in Z01 |
---|
2597 | ENDIF |
---|
2598 | ! |
---|
2599 | !-- Green walls and roofs (USM): |
---|
2600 | IF ( surf%frac(ind_pav_green,m) > 0 ) THEN |
---|
2601 | match_pav_green(m) = 6 ! (short) grass in Z01 |
---|
2602 | ENDIF |
---|
2603 | ! |
---|
2604 | !-- Windows (USM): |
---|
2605 | IF ( surf%frac(ind_wat_win,m) > 0 ) THEN |
---|
2606 | match_wat_win(m) = 15 ! urban in Z01 |
---|
2607 | ENDIF |
---|
2608 | ENDIF |
---|
2609 | |
---|
2610 | ENDDO |
---|
2611 | |
---|
2612 | END SUBROUTINE match_sm_zhang |
---|
2613 | |
---|
2614 | !------------------------------------------------------------------------------! |
---|
2615 | ! Description: |
---|
2616 | ! ------------ |
---|
2617 | !> Swapping of timelevels |
---|
2618 | !------------------------------------------------------------------------------! |
---|
2619 | SUBROUTINE salsa_swap_timelevel( mod_count ) |
---|
2620 | |
---|
2621 | IMPLICIT NONE |
---|
2622 | |
---|
2623 | INTEGER(iwp) :: ib !< |
---|
2624 | INTEGER(iwp) :: ic !< |
---|
2625 | INTEGER(iwp) :: icc !< |
---|
2626 | INTEGER(iwp) :: ig !< |
---|
2627 | |
---|
2628 | INTEGER(iwp), INTENT(IN) :: mod_count !< |
---|
2629 | |
---|
2630 | IF ( time_since_reference_point >= skip_time_do_salsa ) THEN |
---|
2631 | |
---|
2632 | SELECT CASE ( mod_count ) |
---|
2633 | |
---|
2634 | CASE ( 0 ) |
---|
2635 | |
---|
2636 | DO ib = 1, nbins_aerosol |
---|
2637 | aerosol_number(ib)%conc(nzb:nzt+1,nysg:nyng,nxlg:nxrg) => nconc_1(:,:,:,ib) |
---|
2638 | aerosol_number(ib)%conc_p(nzb:nzt+1,nysg:nyng,nxlg:nxrg) => nconc_2(:,:,:,ib) |
---|
2639 | |
---|
2640 | DO ic = 1, ncomponents_mass |
---|
2641 | icc = ( ic-1 ) * nbins_aerosol + ib |
---|
2642 | aerosol_mass(icc)%conc(nzb:nzt+1,nysg:nyng,nxlg:nxrg) => mconc_1(:,:,:,icc) |
---|
2643 | aerosol_mass(icc)%conc_p(nzb:nzt+1,nysg:nyng,nxlg:nxrg) => mconc_2(:,:,:,icc) |
---|
2644 | ENDDO |
---|
2645 | ENDDO |
---|
2646 | |
---|
2647 | IF ( .NOT. salsa_gases_from_chem ) THEN |
---|
2648 | DO ig = 1, ngases_salsa |
---|
2649 | salsa_gas(ig)%conc(nzb:nzt+1,nysg:nyng,nxlg:nxrg) => gconc_1(:,:,:,ig) |
---|
2650 | salsa_gas(ig)%conc_p(nzb:nzt+1,nysg:nyng,nxlg:nxrg) => gconc_2(:,:,:,ig) |
---|
2651 | ENDDO |
---|
2652 | ENDIF |
---|
2653 | |
---|
2654 | CASE ( 1 ) |
---|
2655 | |
---|
2656 | DO ib = 1, nbins_aerosol |
---|
2657 | aerosol_number(ib)%conc(nzb:nzt+1,nysg:nyng,nxlg:nxrg) => nconc_2(:,:,:,ib) |
---|
2658 | aerosol_number(ib)%conc_p(nzb:nzt+1,nysg:nyng,nxlg:nxrg) => nconc_1(:,:,:,ib) |
---|
2659 | DO ic = 1, ncomponents_mass |
---|
2660 | icc = ( ic-1 ) * nbins_aerosol + ib |
---|
2661 | aerosol_mass(icc)%conc(nzb:nzt+1,nysg:nyng,nxlg:nxrg) => mconc_2(:,:,:,icc) |
---|
2662 | aerosol_mass(icc)%conc_p(nzb:nzt+1,nysg:nyng,nxlg:nxrg) => mconc_1(:,:,:,icc) |
---|
2663 | ENDDO |
---|
2664 | ENDDO |
---|
2665 | |
---|
2666 | IF ( .NOT. salsa_gases_from_chem ) THEN |
---|
2667 | DO ig = 1, ngases_salsa |
---|
2668 | salsa_gas(ig)%conc(nzb:nzt+1,nysg:nyng,nxlg:nxrg) => gconc_2(:,:,:,ig) |
---|
2669 | salsa_gas(ig)%conc_p(nzb:nzt+1,nysg:nyng,nxlg:nxrg) => gconc_1(:,:,:,ig) |
---|
2670 | ENDDO |
---|
2671 | ENDIF |
---|
2672 | |
---|
2673 | END SELECT |
---|
2674 | |
---|
2675 | ENDIF |
---|
2676 | |
---|
2677 | END SUBROUTINE salsa_swap_timelevel |
---|
2678 | |
---|
2679 | |
---|
2680 | !------------------------------------------------------------------------------! |
---|
2681 | ! Description: |
---|
2682 | ! ------------ |
---|
2683 | !> This routine reads the respective restart data. |
---|
2684 | !------------------------------------------------------------------------------! |
---|
2685 | SUBROUTINE salsa_rrd_local( k, nxlf, nxlc, nxl_on_file, nxrf, nxrc, nxr_on_file, nynf, nync, & |
---|
2686 | nyn_on_file, nysf, nysc, nys_on_file, tmp_3d, found ) |
---|
2687 | |
---|
2688 | USE control_parameters, & |
---|
2689 | ONLY: length, restart_string |
---|
2690 | |
---|
2691 | IMPLICIT NONE |
---|
2692 | |
---|
2693 | INTEGER(iwp) :: ib !< |
---|
2694 | INTEGER(iwp) :: ic !< |
---|
2695 | INTEGER(iwp) :: ig !< |
---|
2696 | INTEGER(iwp) :: k !< |
---|
2697 | INTEGER(iwp) :: nxlc !< |
---|
2698 | INTEGER(iwp) :: nxlf !< |
---|
2699 | INTEGER(iwp) :: nxl_on_file !< |
---|
2700 | INTEGER(iwp) :: nxrc !< |
---|
2701 | INTEGER(iwp) :: nxrf !< |
---|
2702 | INTEGER(iwp) :: nxr_on_file !< |
---|
2703 | INTEGER(iwp) :: nync !< |
---|
2704 | INTEGER(iwp) :: nynf !< |
---|
2705 | INTEGER(iwp) :: nyn_on_file !< |
---|
2706 | INTEGER(iwp) :: nysc !< |
---|
2707 | INTEGER(iwp) :: nysf !< |
---|
2708 | INTEGER(iwp) :: nys_on_file !< |
---|
2709 | |
---|
2710 | LOGICAL, INTENT(OUT) :: found !< |
---|
2711 | |
---|
2712 | REAL(wp), & |
---|
2713 | DIMENSION(nzb:nzt+1,nys_on_file-nbgp:nyn_on_file+nbgp,nxl_on_file-nbgp:nxr_on_file+nbgp) :: tmp_3d !< |
---|
2714 | |
---|
2715 | found = .FALSE. |
---|
2716 | |
---|
2717 | IF ( read_restart_data_salsa ) THEN |
---|
2718 | |
---|
2719 | SELECT CASE ( restart_string(1:length) ) |
---|
2720 | |
---|
2721 | CASE ( 'aerosol_number' ) |
---|
2722 | DO ib = 1, nbins_aerosol |
---|
2723 | IF ( k == 1 ) READ ( 13 ) tmp_3d |
---|
2724 | aerosol_number(ib)%conc(:,nysc-nbgp:nync+nbgp,nxlc-nbgp:nxrc+nbgp) = & |
---|
2725 | tmp_3d(:,nysf-nbgp:nynf+nbgp,nxlf-nbgp:nxrf+nbgp) |
---|
2726 | found = .TRUE. |
---|
2727 | ENDDO |
---|
2728 | |
---|
2729 | CASE ( 'aerosol_mass' ) |
---|
2730 | DO ic = 1, ncomponents_mass * nbins_aerosol |
---|
2731 | IF ( k == 1 ) READ ( 13 ) tmp_3d |
---|
2732 | aerosol_mass(ic)%conc(:,nysc-nbgp:nync+nbgp,nxlc-nbgp:nxrc+nbgp) = & |
---|
2733 | tmp_3d(:,nysf-nbgp:nynf+nbgp,nxlf-nbgp:nxrf+nbgp) |
---|
2734 | found = .TRUE. |
---|
2735 | ENDDO |
---|
2736 | |
---|
2737 | CASE ( 'salsa_gas' ) |
---|
2738 | DO ig = 1, ngases_salsa |
---|
2739 | IF ( k == 1 ) READ ( 13 ) tmp_3d |
---|
2740 | salsa_gas(ig)%conc(:,nysc-nbgp:nync+nbgp,nxlc-nbgp:nxrc+nbgp) = & |
---|
2741 | tmp_3d(:,nysf-nbgp:nynf+nbgp,nxlf-nbgp:nxrf+nbgp) |
---|
2742 | found = .TRUE. |
---|
2743 | ENDDO |
---|
2744 | |
---|
2745 | CASE DEFAULT |
---|
2746 | found = .FALSE. |
---|
2747 | |
---|
2748 | END SELECT |
---|
2749 | ENDIF |
---|
2750 | |
---|
2751 | END SUBROUTINE salsa_rrd_local |
---|
2752 | |
---|
2753 | !------------------------------------------------------------------------------! |
---|
2754 | ! Description: |
---|
2755 | ! ------------ |
---|
2756 | !> This routine writes the respective restart data. |
---|
2757 | !> Note that the following input variables in PARIN have to be equal between |
---|
2758 | !> restart runs: |
---|
2759 | !> listspec, nbin, nbin2, nf2a, ncc, mass_fracs_a, mass_fracs_b |
---|
2760 | !------------------------------------------------------------------------------! |
---|
2761 | SUBROUTINE salsa_wrd_local |
---|
2762 | |
---|
2763 | USE control_parameters, & |
---|
2764 | ONLY: write_binary |
---|
2765 | |
---|
2766 | IMPLICIT NONE |
---|
2767 | |
---|
2768 | INTEGER(iwp) :: ib !< |
---|
2769 | INTEGER(iwp) :: ic !< |
---|
2770 | INTEGER(iwp) :: ig !< |
---|
2771 | |
---|
2772 | IF ( write_binary .AND. write_binary_salsa ) THEN |
---|
2773 | |
---|
2774 | CALL wrd_write_string( 'aerosol_number' ) |
---|
2775 | DO ib = 1, nbins_aerosol |
---|
2776 | WRITE ( 14 ) aerosol_number(ib)%conc |
---|
2777 | ENDDO |
---|
2778 | |
---|
2779 | CALL wrd_write_string( 'aerosol_mass' ) |
---|
2780 | DO ic = 1, nbins_aerosol * ncomponents_mass |
---|
2781 | WRITE ( 14 ) aerosol_mass(ic)%conc |
---|
2782 | ENDDO |
---|
2783 | |
---|
2784 | CALL wrd_write_string( 'salsa_gas' ) |
---|
2785 | DO ig = 1, ngases_salsa |
---|
2786 | WRITE ( 14 ) salsa_gas(ig)%conc |
---|
2787 | ENDDO |
---|
2788 | |
---|
2789 | ENDIF |
---|
2790 | |
---|
2791 | END SUBROUTINE salsa_wrd_local |
---|
2792 | |
---|
2793 | !------------------------------------------------------------------------------! |
---|
2794 | ! Description: |
---|
2795 | ! ------------ |
---|
2796 | !> Performs necessary unit and dimension conversion between the host model and |
---|
2797 | !> SALSA module, and calls the main SALSA routine. |
---|
2798 | !> Partially adobted form the original SALSA boxmodel version. |
---|
2799 | !> Now takes masses in as kg/kg from LES!! Converted to m3/m3 for SALSA |
---|
2800 | !> 05/2016 Juha: This routine is still pretty much in its original shape. |
---|
2801 | !> It's dumb as a mule and twice as ugly, so implementation of |
---|
2802 | !> an improved solution is necessary sooner or later. |
---|
2803 | !> Juha Tonttila, FMI, 2014 |
---|
2804 | !> Jaakko Ahola, FMI, 2016 |
---|
2805 | !> Only aerosol processes included, Mona Kurppa, UHel, 2017 |
---|
2806 | !------------------------------------------------------------------------------! |
---|
2807 | SUBROUTINE salsa_driver( i, j, prunmode ) |
---|
2808 | |
---|
2809 | USE arrays_3d, & |
---|
2810 | ONLY: pt_p, q_p, u, v, w |
---|
2811 | |
---|
2812 | USE plant_canopy_model_mod, & |
---|
2813 | ONLY: lad_s |
---|
2814 | |
---|
2815 | USE surface_mod, & |
---|
2816 | ONLY: surf_def_h, surf_def_v, surf_lsm_h, surf_lsm_v, surf_usm_h, surf_usm_v |
---|
2817 | |
---|
2818 | IMPLICIT NONE |
---|
2819 | |
---|
2820 | INTEGER(iwp) :: endi !< end index |
---|
2821 | INTEGER(iwp) :: ib !< loop index |
---|
2822 | INTEGER(iwp) :: ic !< loop index |
---|
2823 | INTEGER(iwp) :: ig !< loop index |
---|
2824 | INTEGER(iwp) :: k_wall !< vertical index of topography top |
---|
2825 | INTEGER(iwp) :: k !< loop index |
---|
2826 | INTEGER(iwp) :: l !< loop index |
---|
2827 | INTEGER(iwp) :: nc_h2o !< index of H2O in the prtcl index table |
---|
2828 | INTEGER(iwp) :: ss !< loop index |
---|
2829 | INTEGER(iwp) :: str !< start index |
---|
2830 | INTEGER(iwp) :: vc !< default index in prtcl |
---|
2831 | |
---|
2832 | INTEGER(iwp), INTENT(in) :: i !< loop index |
---|
2833 | INTEGER(iwp), INTENT(in) :: j !< loop index |
---|
2834 | INTEGER(iwp), INTENT(in) :: prunmode !< 1: Initialization, 2: Spinup, 3: Regular runtime |
---|
2835 | |
---|
2836 | REAL(wp) :: cw_old !< previous H2O mixing ratio |
---|
2837 | REAL(wp) :: flag !< flag to mask topography grid points |
---|
2838 | REAL(wp) :: in_lad !< leaf area density (m2/m3) |
---|
2839 | REAL(wp) :: in_rh !< relative humidity |
---|
2840 | REAL(wp) :: zgso4 !< SO4 |
---|
2841 | REAL(wp) :: zghno3 !< HNO3 |
---|
2842 | REAL(wp) :: zgnh3 !< NH3 |
---|
2843 | REAL(wp) :: zgocnv !< non-volatile OC |
---|
2844 | REAL(wp) :: zgocsv !< semi-volatile OC |
---|
2845 | |
---|
2846 | REAL(wp), DIMENSION(nzb:nzt+1) :: in_adn !< air density (kg/m3) |
---|
2847 | REAL(wp), DIMENSION(nzb:nzt+1) :: in_cs !< H2O sat. vapour conc. |
---|
2848 | REAL(wp), DIMENSION(nzb:nzt+1) :: in_cw !< H2O vapour concentration |
---|
2849 | REAL(wp), DIMENSION(nzb:nzt+1) :: in_p !< pressure (Pa) |
---|
2850 | REAL(wp), DIMENSION(nzb:nzt+1) :: in_t !< temperature (K) |
---|
2851 | REAL(wp), DIMENSION(nzb:nzt+1) :: in_u !< wind magnitude (m/s) |
---|
2852 | REAL(wp), DIMENSION(nzb:nzt+1) :: kvis !< kinematic viscosity of air(m2/s) |
---|
2853 | REAL(wp), DIMENSION(nzb:nzt+1) :: ppm_to_nconc !< Conversion factor from ppm to #/m3 |
---|
2854 | |
---|
2855 | REAL(wp), DIMENSION(nzb:nzt+1,nbins_aerosol) :: schmidt_num !< particle Schmidt number |
---|
2856 | REAL(wp), DIMENSION(nzb:nzt+1,nbins_aerosol) :: vd !< particle fall seed (m/s) |
---|
2857 | |
---|
2858 | TYPE(t_section), DIMENSION(nbins_aerosol) :: lo_aero !< additional variable for OpenMP |
---|
2859 | TYPE(t_section), DIMENSION(nbins_aerosol) :: aero_old !< helper array |
---|
2860 | |
---|
2861 | aero_old(:)%numc = 0.0_wp |
---|
2862 | in_lad = 0.0_wp |
---|
2863 | in_u = 0.0_wp |
---|
2864 | kvis = 0.0_wp |
---|
2865 | lo_aero = aero |
---|
2866 | schmidt_num = 0.0_wp |
---|
2867 | vd = 0.0_wp |
---|
2868 | zgso4 = nclim |
---|
2869 | zghno3 = nclim |
---|
2870 | zgnh3 = nclim |
---|
2871 | zgocnv = nclim |
---|
2872 | zgocsv = nclim |
---|
2873 | ! |
---|
2874 | !-- Aerosol number is always set, but mass can be uninitialized |
---|
2875 | DO ib = 1, nbins_aerosol |
---|
2876 | lo_aero(ib)%volc(:) = 0.0_wp |
---|
2877 | aero_old(ib)%volc(:) = 0.0_wp |
---|
2878 | ENDDO |
---|
2879 | ! |
---|
2880 | !-- Set the salsa runtime config (How to make this more efficient?) |
---|
2881 | CALL set_salsa_runtime( prunmode ) |
---|
2882 | ! |
---|
2883 | !-- Calculate thermodynamic quantities needed in SALSA |
---|
2884 | CALL salsa_thrm_ij( i, j, p_ij=in_p, temp_ij=in_t, cw_ij=in_cw, cs_ij=in_cs, adn_ij=in_adn ) |
---|
2885 | ! |
---|
2886 | !-- Magnitude of wind: needed for deposition |
---|
2887 | IF ( lsdepo ) THEN |
---|
2888 | in_u(nzb+1:nzt) = SQRT( ( 0.5_wp * ( u(nzb+1:nzt,j,i) + u(nzb+1:nzt,j,i+1) ) )**2 + & |
---|
2889 | ( 0.5_wp * ( v(nzb+1:nzt,j,i) + v(nzb+1:nzt,j+1,i) ) )**2 + & |
---|
2890 | ( 0.5_wp * ( w(nzb:nzt-1,j,i) + w(nzb+1:nzt,j, i) ) )**2 ) |
---|
2891 | ENDIF |
---|
2892 | ! |
---|
2893 | !-- Calculate conversion factors for gas concentrations |
---|
2894 | ppm_to_nconc(:) = for_ppm_to_nconc * in_p(:) / in_t(:) |
---|
2895 | ! |
---|
2896 | !-- Determine topography-top index on scalar grid |
---|
2897 | k_wall = k_topo_top(j,i) |
---|
2898 | |
---|
2899 | DO k = nzb+1, nzt |
---|
2900 | ! |
---|
2901 | !-- Predetermine flag to mask topography |
---|
2902 | flag = MERGE( 1.0_wp, 0.0_wp, BTEST( wall_flags_0(k,j,i), 0 ) ) |
---|
2903 | ! |
---|
2904 | !-- Wind velocity for dry depositon on vegetation |
---|
2905 | IF ( lsdepo_pcm .AND. plant_canopy ) THEN |
---|
2906 | in_lad = lad_s( MAX( k-k_wall,0 ),j,i) |
---|
2907 | ENDIF |
---|
2908 | ! |
---|
2909 | !-- For initialization and spinup, limit the RH with the parameter rhlim |
---|
2910 | IF ( prunmode < 3 ) THEN |
---|
2911 | in_cw(k) = MIN( in_cw(k), in_cs(k) * rhlim ) |
---|
2912 | ELSE |
---|
2913 | in_cw(k) = in_cw(k) |
---|
2914 | ENDIF |
---|
2915 | cw_old = in_cw(k) !* in_adn(k) |
---|
2916 | ! |
---|
2917 | !-- Set volume concentrations: |
---|
2918 | !-- Sulphate (SO4) or sulphuric acid H2SO4 |
---|
2919 | IF ( index_so4 > 0 ) THEN |
---|
2920 | vc = 1 |
---|
2921 | str = ( index_so4-1 ) * nbins_aerosol + 1 ! start index |
---|
2922 | endi = index_so4 * nbins_aerosol ! end index |
---|
2923 | ic = 1 |
---|
2924 | DO ss = str, endi |
---|
2925 | lo_aero(ic)%volc(vc) = aerosol_mass(ss)%conc(k,j,i) / arhoh2so4 |
---|
2926 | ic = ic+1 |
---|
2927 | ENDDO |
---|
2928 | aero_old(1:nbins_aerosol)%volc(vc) = lo_aero(1:nbins_aerosol)%volc(vc) |
---|
2929 | ENDIF |
---|
2930 | ! |
---|
2931 | !-- Organic carbon (OC) compounds |
---|
2932 | IF ( index_oc > 0 ) THEN |
---|
2933 | vc = 2 |
---|
2934 | str = ( index_oc-1 ) * nbins_aerosol + 1 |
---|
2935 | endi = index_oc * nbins_aerosol |
---|
2936 | ic = 1 |
---|
2937 | DO ss = str, endi |
---|
2938 | lo_aero(ic)%volc(vc) = aerosol_mass(ss)%conc(k,j,i) / arhooc |
---|
2939 | ic = ic+1 |
---|
2940 | ENDDO |
---|
2941 | aero_old(1:nbins_aerosol)%volc(vc) = lo_aero(1:nbins_aerosol)%volc(vc) |
---|
2942 | ENDIF |
---|
2943 | ! |
---|
2944 | !-- Black carbon (BC) |
---|
2945 | IF ( index_bc > 0 ) THEN |
---|
2946 | vc = 3 |
---|
2947 | str = ( index_bc-1 ) * nbins_aerosol + 1 + end_subrange_1a |
---|
2948 | endi = index_bc * nbins_aerosol |
---|
2949 | ic = 1 + end_subrange_1a |
---|
2950 | DO ss = str, endi |
---|
2951 | lo_aero(ic)%volc(vc) = aerosol_mass(ss)%conc(k,j,i) / arhobc |
---|
2952 | ic = ic+1 |
---|
2953 | ENDDO |
---|
2954 | aero_old(1:nbins_aerosol)%volc(vc) = lo_aero(1:nbins_aerosol)%volc(vc) |
---|
2955 | ENDIF |
---|
2956 | ! |
---|
2957 | !-- Dust (DU) |
---|
2958 | IF ( index_du > 0 ) THEN |
---|
2959 | vc = 4 |
---|
2960 | str = ( index_du-1 ) * nbins_aerosol + 1 + end_subrange_1a |
---|
2961 | endi = index_du * nbins_aerosol |
---|
2962 | ic = 1 + end_subrange_1a |
---|
2963 | DO ss = str, endi |
---|
2964 | lo_aero(ic)%volc(vc) = aerosol_mass(ss)%conc(k,j,i) / arhodu |
---|
2965 | ic = ic+1 |
---|
2966 | ENDDO |
---|
2967 | aero_old(1:nbins_aerosol)%volc(vc) = lo_aero(1:nbins_aerosol)%volc(vc) |
---|
2968 | ENDIF |
---|
2969 | ! |
---|
2970 | !-- Sea salt (SS) |
---|
2971 | IF ( index_ss > 0 ) THEN |
---|
2972 | vc = 5 |
---|
2973 | str = ( index_ss-1 ) * nbins_aerosol + 1 + end_subrange_1a |
---|
2974 | endi = index_ss * nbins_aerosol |
---|
2975 | ic = 1 + end_subrange_1a |
---|
2976 | DO ss = str, endi |
---|
2977 | lo_aero(ic)%volc(vc) = aerosol_mass(ss)%conc(k,j,i) / arhoss |
---|
2978 | ic = ic+1 |
---|
2979 | ENDDO |
---|
2980 | aero_old(1:nbins_aerosol)%volc(vc) = lo_aero(1:nbins_aerosol)%volc(vc) |
---|
2981 | ENDIF |
---|
2982 | ! |
---|
2983 | !-- Nitrate (NO(3-)) or nitric acid HNO3 |
---|
2984 | IF ( index_no > 0 ) THEN |
---|
2985 | vc = 6 |
---|
2986 | str = ( index_no-1 ) * nbins_aerosol + 1 |
---|
2987 | endi = index_no * nbins_aerosol |
---|
2988 | ic = 1 |
---|
2989 | DO ss = str, endi |
---|
2990 | lo_aero(ic)%volc(vc) = aerosol_mass(ss)%conc(k,j,i) / arhohno3 |
---|
2991 | ic = ic+1 |
---|
2992 | ENDDO |
---|
2993 | aero_old(1:nbins_aerosol)%volc(vc) = lo_aero(1:nbins_aerosol)%volc(vc) |
---|
2994 | ENDIF |
---|
2995 | ! |
---|
2996 | !-- Ammonium (NH(4+)) or ammonia NH3 |
---|
2997 | IF ( index_nh > 0 ) THEN |
---|
2998 | vc = 7 |
---|
2999 | str = ( index_nh-1 ) * nbins_aerosol + 1 |
---|
3000 | endi = index_nh * nbins_aerosol |
---|
3001 | ic = 1 |
---|
3002 | DO ss = str, endi |
---|
3003 | lo_aero(ic)%volc(vc) = aerosol_mass(ss)%conc(k,j,i) / arhonh3 |
---|
3004 | ic = ic+1 |
---|
3005 | ENDDO |
---|
3006 | aero_old(1:nbins_aerosol)%volc(vc) = lo_aero(1:nbins_aerosol)%volc(vc) |
---|
3007 | ENDIF |
---|
3008 | ! |
---|
3009 | !-- Water (always used) |
---|
3010 | nc_h2o = get_index( prtcl,'H2O' ) |
---|
3011 | vc = 8 |
---|
3012 | str = ( nc_h2o-1 ) * nbins_aerosol + 1 |
---|
3013 | endi = nc_h2o * nbins_aerosol |
---|
3014 | ic = 1 |
---|
3015 | IF ( advect_particle_water ) THEN |
---|
3016 | DO ss = str, endi |
---|
3017 | lo_aero(ic)%volc(vc) = aerosol_mass(ss)%conc(k,j,i) / arhoh2o |
---|
3018 | ic = ic+1 |
---|
3019 | ENDDO |
---|
3020 | ELSE |
---|
3021 | lo_aero(1:nbins_aerosol)%volc(vc) = mclim |
---|
3022 | ENDIF |
---|
3023 | aero_old(1:nbins_aerosol)%volc(vc) = lo_aero(1:nbins_aerosol)%volc(vc) |
---|
3024 | ! |
---|
3025 | !-- Number concentrations (numc) and particle sizes |
---|
3026 | !-- (dwet = wet diameter, core = dry volume) |
---|
3027 | DO ib = 1, nbins_aerosol |
---|
3028 | lo_aero(ib)%numc = aerosol_number(ib)%conc(k,j,i) |
---|
3029 | aero_old(ib)%numc = lo_aero(ib)%numc |
---|
3030 | IF ( lo_aero(ib)%numc > nclim ) THEN |
---|
3031 | lo_aero(ib)%dwet = ( SUM( lo_aero(ib)%volc(:) ) / lo_aero(ib)%numc / api6 )**0.33333333_wp |
---|
3032 | lo_aero(ib)%core = SUM( lo_aero(ib)%volc(1:7) ) / lo_aero(ib)%numc |
---|
3033 | ELSE |
---|
3034 | lo_aero(ib)%dwet = lo_aero(ib)%dmid |
---|
3035 | lo_aero(ib)%core = api6 * ( lo_aero(ib)%dwet )**3 |
---|
3036 | ENDIF |
---|
3037 | ENDDO |
---|
3038 | ! |
---|
3039 | !-- Calculate the ambient sizes of particles by equilibrating soluble fraction of particles with |
---|
3040 | !-- water using the ZSR method. |
---|
3041 | in_rh = in_cw(k) / in_cs(k) |
---|
3042 | IF ( prunmode==1 .OR. .NOT. advect_particle_water ) THEN |
---|
3043 | CALL equilibration( in_rh, in_t(k), lo_aero, .TRUE. ) |
---|
3044 | ENDIF |
---|
3045 | ! |
---|
3046 | !-- Gaseous tracer concentrations in #/m3 |
---|
3047 | IF ( salsa_gases_from_chem ) THEN |
---|
3048 | ! |
---|
3049 | !-- Convert concentrations in ppm to #/m3 |
---|
3050 | zgso4 = chem_species(gas_index_chem(1))%conc(k,j,i) * ppm_to_nconc(k) |
---|
3051 | zghno3 = chem_species(gas_index_chem(2))%conc(k,j,i) * ppm_to_nconc(k) |
---|
3052 | zgnh3 = chem_species(gas_index_chem(3))%conc(k,j,i) * ppm_to_nconc(k) |
---|
3053 | zgocnv = chem_species(gas_index_chem(4))%conc(k,j,i) * ppm_to_nconc(k) |
---|
3054 | zgocsv = chem_species(gas_index_chem(5))%conc(k,j,i) * ppm_to_nconc(k) |
---|
3055 | ELSE |
---|
3056 | zgso4 = salsa_gas(1)%conc(k,j,i) |
---|
3057 | zghno3 = salsa_gas(2)%conc(k,j,i) |
---|
3058 | zgnh3 = salsa_gas(3)%conc(k,j,i) |
---|
3059 | zgocnv = salsa_gas(4)%conc(k,j,i) |
---|
3060 | zgocsv = salsa_gas(5)%conc(k,j,i) |
---|
3061 | ENDIF |
---|
3062 | ! |
---|
3063 | !-- Calculate aerosol processes: |
---|
3064 | !-- ********************************************************************************************* |
---|
3065 | ! |
---|
3066 | !-- Coagulation |
---|
3067 | IF ( lscoag ) THEN |
---|
3068 | CALL coagulation( lo_aero, dt_salsa, in_t(k), in_p(k) ) |
---|
3069 | ENDIF |
---|
3070 | ! |
---|
3071 | !-- Condensation |
---|
3072 | IF ( lscnd ) THEN |
---|
3073 | CALL condensation( lo_aero, zgso4, zgocnv, zgocsv, zghno3, zgnh3, in_cw(k), in_cs(k), & |
---|
3074 | in_t(k), in_p(k), dt_salsa, prtcl ) |
---|
3075 | ENDIF |
---|
3076 | ! |
---|
3077 | !-- Deposition |
---|
3078 | IF ( lsdepo ) THEN |
---|
3079 | CALL deposition( lo_aero, in_t(k), in_adn(k), in_u(k), in_lad, kvis(k), schmidt_num(k,:),& |
---|
3080 | vd(k,:) ) |
---|
3081 | ENDIF |
---|
3082 | ! |
---|
3083 | !-- Size distribution bin update |
---|
3084 | IF ( lsdistupdate ) THEN |
---|
3085 | CALL distr_update( lo_aero ) |
---|
3086 | ENDIF |
---|
3087 | !-- ********************************************************************************************* |
---|
3088 | |
---|
3089 | IF ( lsdepo ) sedim_vd(k,j,i,:) = vd(k,:) |
---|
3090 | ! |
---|
3091 | !-- Calculate changes in concentrations |
---|
3092 | DO ib = 1, nbins_aerosol |
---|
3093 | aerosol_number(ib)%conc(k,j,i) = aerosol_number(ib)%conc(k,j,i) + ( lo_aero(ib)%numc - & |
---|
3094 | aero_old(ib)%numc ) * flag |
---|
3095 | ENDDO |
---|
3096 | |
---|
3097 | IF ( index_so4 > 0 ) THEN |
---|
3098 | vc = 1 |
---|
3099 | str = ( index_so4-1 ) * nbins_aerosol + 1 |
---|
3100 | endi = index_so4 * nbins_aerosol |
---|
3101 | ic = 1 |
---|
3102 | DO ss = str, endi |
---|
3103 | aerosol_mass(ss)%conc(k,j,i) = aerosol_mass(ss)%conc(k,j,i) + ( lo_aero(ic)%volc(vc) -& |
---|
3104 | aero_old(ic)%volc(vc) ) * arhoh2so4 * flag |
---|
3105 | ic = ic+1 |
---|
3106 | ENDDO |
---|
3107 | ENDIF |
---|
3108 | |
---|
3109 | IF ( index_oc > 0 ) THEN |
---|
3110 | vc = 2 |
---|
3111 | str = ( index_oc-1 ) * nbins_aerosol + 1 |
---|
3112 | endi = index_oc * nbins_aerosol |
---|
3113 | ic = 1 |
---|
3114 | DO ss = str, endi |
---|
3115 | aerosol_mass(ss)%conc(k,j,i) = aerosol_mass(ss)%conc(k,j,i) + ( lo_aero(ic)%volc(vc) -& |
---|
3116 | aero_old(ic)%volc(vc) ) * arhooc * flag |
---|
3117 | ic = ic+1 |
---|
3118 | ENDDO |
---|
3119 | ENDIF |
---|
3120 | |
---|
3121 | IF ( index_bc > 0 ) THEN |
---|
3122 | vc = 3 |
---|
3123 | str = ( index_bc-1 ) * nbins_aerosol + 1 + end_subrange_1a |
---|
3124 | endi = index_bc * nbins_aerosol |
---|
3125 | ic = 1 + end_subrange_1a |
---|
3126 | DO ss = str, endi |
---|
3127 | aerosol_mass(ss)%conc(k,j,i) = aerosol_mass(ss)%conc(k,j,i) + ( lo_aero(ic)%volc(vc) -& |
---|
3128 | aero_old(ic)%volc(vc) ) * arhobc * flag |
---|
3129 | ic = ic+1 |
---|
3130 | ENDDO |
---|
3131 | ENDIF |
---|
3132 | |
---|
3133 | IF ( index_du > 0 ) THEN |
---|
3134 | vc = 4 |
---|
3135 | str = ( index_du-1 ) * nbins_aerosol + 1 + end_subrange_1a |
---|
3136 | endi = index_du * nbins_aerosol |
---|
3137 | ic = 1 + end_subrange_1a |
---|
3138 | DO ss = str, endi |
---|
3139 | aerosol_mass(ss)%conc(k,j,i) = aerosol_mass(ss)%conc(k,j,i) + ( lo_aero(ic)%volc(vc) -& |
---|
3140 | aero_old(ic)%volc(vc) ) * arhodu * flag |
---|
3141 | ic = ic+1 |
---|
3142 | ENDDO |
---|
3143 | ENDIF |
---|
3144 | |
---|
3145 | IF ( index_ss > 0 ) THEN |
---|
3146 | vc = 5 |
---|
3147 | str = ( index_ss-1 ) * nbins_aerosol + 1 + end_subrange_1a |
---|
3148 | endi = index_ss * nbins_aerosol |
---|
3149 | ic = 1 + end_subrange_1a |
---|
3150 | DO ss = str, endi |
---|
3151 | aerosol_mass(ss)%conc(k,j,i) = aerosol_mass(ss)%conc(k,j,i) + ( lo_aero(ic)%volc(vc) -& |
---|
3152 | aero_old(ic)%volc(vc) ) * arhoss * flag |
---|
3153 | ic = ic+1 |
---|
3154 | ENDDO |
---|
3155 | ENDIF |
---|
3156 | |
---|
3157 | IF ( index_no > 0 ) THEN |
---|
3158 | vc = 6 |
---|
3159 | str = ( index_no-1 ) * nbins_aerosol + 1 |
---|
3160 | endi = index_no * nbins_aerosol |
---|
3161 | ic = 1 |
---|
3162 | DO ss = str, endi |
---|
3163 | aerosol_mass(ss)%conc(k,j,i) = aerosol_mass(ss)%conc(k,j,i) + ( lo_aero(ic)%volc(vc) -& |
---|
3164 | aero_old(ic)%volc(vc) ) * arhohno3 * flag |
---|
3165 | ic = ic+1 |
---|
3166 | ENDDO |
---|
3167 | ENDIF |
---|
3168 | |
---|
3169 | IF ( index_nh > 0 ) THEN |
---|
3170 | vc = 7 |
---|
3171 | str = ( index_nh-1 ) * nbins_aerosol + 1 |
---|
3172 | endi = index_nh * nbins_aerosol |
---|
3173 | ic = 1 |
---|
3174 | DO ss = str, endi |
---|
3175 | aerosol_mass(ss)%conc(k,j,i) = aerosol_mass(ss)%conc(k,j,i) + ( lo_aero(ic)%volc(vc) -& |
---|
3176 | aero_old(ic)%volc(vc) ) * arhonh3 * flag |
---|
3177 | ic = ic+1 |
---|
3178 | ENDDO |
---|
3179 | ENDIF |
---|
3180 | |
---|
3181 | IF ( advect_particle_water ) THEN |
---|
3182 | nc_h2o = get_index( prtcl,'H2O' ) |
---|
3183 | vc = 8 |
---|
3184 | str = ( nc_h2o-1 ) * nbins_aerosol + 1 |
---|
3185 | endi = nc_h2o * nbins_aerosol |
---|
3186 | ic = 1 |
---|
3187 | DO ss = str, endi |
---|
3188 | aerosol_mass(ss)%conc(k,j,i) = aerosol_mass(ss)%conc(k,j,i) + ( lo_aero(ic)%volc(vc) -& |
---|
3189 | aero_old(ic)%volc(vc) ) * arhoh2o * flag |
---|
3190 | ic = ic+1 |
---|
3191 | ENDDO |
---|
3192 | ENDIF |
---|
3193 | IF ( prunmode == 1 ) THEN |
---|
3194 | nc_h2o = get_index( prtcl,'H2O' ) |
---|
3195 | vc = 8 |
---|
3196 | str = ( nc_h2o-1 ) * nbins_aerosol + 1 |
---|
3197 | endi = nc_h2o * nbins_aerosol |
---|
3198 | ic = 1 |
---|
3199 | DO ss = str, endi |
---|
3200 | aerosol_mass(ss)%init(k) = MAX( aerosol_mass(ss)%init(k), ( lo_aero(ic)%volc(vc) - & |
---|
3201 | aero_old(ic)%volc(vc) ) * arhoh2o ) |
---|
3202 | IF ( k == nzb+1 ) THEN |
---|
3203 | aerosol_mass(ss)%init(k-1) = aerosol_mass(ss)%init(k) |
---|
3204 | ELSEIF ( k == nzt ) THEN |
---|
3205 | aerosol_mass(ss)%init(k+1) = aerosol_mass(ss)%init(k) |
---|
3206 | aerosol_mass(ss)%conc(k+1,j,i) = aerosol_mass(ss)%init(k) |
---|
3207 | ENDIF |
---|
3208 | ic = ic+1 |
---|
3209 | ENDDO |
---|
3210 | ENDIF |
---|
3211 | ! |
---|
3212 | !-- Condensation of precursor gases |
---|
3213 | IF ( lscndgas ) THEN |
---|
3214 | IF ( salsa_gases_from_chem ) THEN |
---|
3215 | ! |
---|
3216 | !-- SO4 (or H2SO4) |
---|
3217 | ig = gas_index_chem(1) |
---|
3218 | chem_species(ig)%conc(k,j,i) = chem_species(ig)%conc(k,j,i) + ( zgso4 / & |
---|
3219 | ppm_to_nconc(k) - chem_species(ig)%conc(k,j,i) ) * flag |
---|
3220 | ! |
---|
3221 | !-- HNO3 |
---|
3222 | ig = gas_index_chem(2) |
---|
3223 | chem_species(ig)%conc(k,j,i) = chem_species(ig)%conc(k,j,i) + ( zghno3 / & |
---|
3224 | ppm_to_nconc(k) - chem_species(ig)%conc(k,j,i) ) * flag |
---|
3225 | ! |
---|
3226 | !-- NH3 |
---|
3227 | ig = gas_index_chem(3) |
---|
3228 | chem_species(ig)%conc(k,j,i) = chem_species(ig)%conc(k,j,i) + ( zgnh3 / & |
---|
3229 | ppm_to_nconc(k) - chem_species(ig)%conc(k,j,i) ) * flag |
---|
3230 | ! |
---|
3231 | !-- non-volatile OC |
---|
3232 | ig = gas_index_chem(4) |
---|
3233 | chem_species(ig)%conc(k,j,i) = chem_species(ig)%conc(k,j,i) + ( zgocnv / & |
---|
3234 | ppm_to_nconc(k) - chem_species(ig)%conc(k,j,i) ) * flag |
---|
3235 | ! |
---|
3236 | !-- semi-volatile OC |
---|
3237 | ig = gas_index_chem(5) |
---|
3238 | chem_species(ig)%conc(k,j,i) = chem_species(ig)%conc(k,j,i) + ( zgocsv / & |
---|
3239 | ppm_to_nconc(k) - chem_species(ig)%conc(k,j,i) ) * flag |
---|
3240 | |
---|
3241 | ELSE |
---|
3242 | ! |
---|
3243 | !-- SO4 (or H2SO4) |
---|
3244 | salsa_gas(1)%conc(k,j,i) = salsa_gas(1)%conc(k,j,i) + ( zgso4 - & |
---|
3245 | salsa_gas(1)%conc(k,j,i) ) * flag |
---|
3246 | ! |
---|
3247 | !-- HNO3 |
---|
3248 | salsa_gas(2)%conc(k,j,i) = salsa_gas(2)%conc(k,j,i) + ( zghno3 - & |
---|
3249 | salsa_gas(2)%conc(k,j,i) ) * flag |
---|
3250 | ! |
---|
3251 | !-- NH3 |
---|
3252 | salsa_gas(3)%conc(k,j,i) = salsa_gas(3)%conc(k,j,i) + ( zgnh3 - & |
---|
3253 | salsa_gas(3)%conc(k,j,i) ) * flag |
---|
3254 | ! |
---|
3255 | !-- non-volatile OC |
---|
3256 | salsa_gas(4)%conc(k,j,i) = salsa_gas(4)%conc(k,j,i) + ( zgocnv - & |
---|
3257 | salsa_gas(4)%conc(k,j,i) ) * flag |
---|
3258 | ! |
---|
3259 | !-- semi-volatile OC |
---|
3260 | salsa_gas(5)%conc(k,j,i) = salsa_gas(5)%conc(k,j,i) + ( zgocsv - & |
---|
3261 | salsa_gas(5)%conc(k,j,i) ) * flag |
---|
3262 | ENDIF |
---|
3263 | ENDIF |
---|
3264 | ! |
---|
3265 | !-- Tendency of water vapour mixing ratio is obtained from the change in RH during SALSA run. |
---|
3266 | !-- This releases heat and changes pt. Assumes no temperature change during SALSA run. |
---|
3267 | !-- q = r / (1+r), Euler method for integration |
---|
3268 | ! |
---|
3269 | IF ( feedback_to_palm ) THEN |
---|
3270 | q_p(k,j,i) = q_p(k,j,i) + 1.0_wp / ( in_cw(k) * in_adn(k) + 1.0_wp )**2 * & |
---|
3271 | ( in_cw(k) - cw_old ) * in_adn(k) * flag |
---|
3272 | pt_p(k,j,i) = pt_p(k,j,i) + alv / c_p * ( in_cw(k) - cw_old ) * in_adn(k) / ( in_cw(k) / & |
---|
3273 | in_adn(k) + 1.0_wp )**2 * pt_p(k,j,i) / in_t(k) * flag |
---|
3274 | ENDIF |
---|
3275 | |
---|
3276 | ENDDO ! k |
---|
3277 | |
---|
3278 | ! |
---|
3279 | !-- Set surfaces and wall fluxes due to deposition |
---|
3280 | IF ( lsdepo .AND. lsdepo_surf .AND. prunmode == 3 ) THEN |
---|
3281 | IF ( .NOT. land_surface .AND. .NOT. urban_surface ) THEN |
---|
3282 | CALL depo_surf( i, j, surf_def_h(0), vd, schmidt_num, kvis, in_u, .TRUE. ) |
---|
3283 | DO l = 0, 3 |
---|
3284 | CALL depo_surf( i, j, surf_def_v(l), vd, schmidt_num, kvis, in_u, .FALSE. ) |
---|
3285 | ENDDO |
---|
3286 | ELSE |
---|
3287 | CALL depo_surf( i, j, surf_usm_h, vd, schmidt_num, kvis, in_u, .TRUE., usm_to_depo_h ) |
---|
3288 | DO l = 0, 3 |
---|
3289 | CALL depo_surf( i, j, surf_usm_v(l), vd, schmidt_num, kvis, in_u, .FALSE., & |
---|
3290 | usm_to_depo_v(l) ) |
---|
3291 | ENDDO |
---|
3292 | CALL depo_surf( i, j, surf_lsm_h, vd, schmidt_num, kvis, in_u, .TRUE., lsm_to_depo_h ) |
---|
3293 | DO l = 0, 3 |
---|
3294 | CALL depo_surf( i, j, surf_lsm_v(l), vd, schmidt_num, kvis, in_u, .FALSE., & |
---|
3295 | lsm_to_depo_v(l) ) |
---|
3296 | ENDDO |
---|
3297 | ENDIF |
---|
3298 | ENDIF |
---|
3299 | |
---|
3300 | IF ( prunmode < 3 ) THEN |
---|
3301 | !$OMP MASTER |
---|
3302 | aero = lo_aero |
---|
3303 | !$OMP END MASTER |
---|
3304 | END IF |
---|
3305 | |
---|
3306 | END SUBROUTINE salsa_driver |
---|
3307 | |
---|
3308 | !------------------------------------------------------------------------------! |
---|
3309 | ! Description: |
---|
3310 | ! ------------ |
---|
3311 | !> Set logical switches according to the salsa_parameters options. |
---|
3312 | !> Juha Tonttila, FMI, 2014 |
---|
3313 | !> Only aerosol processes included, Mona Kurppa, UHel, 2017 |
---|
3314 | !------------------------------------------------------------------------------! |
---|
3315 | SUBROUTINE set_salsa_runtime( prunmode ) |
---|
3316 | |
---|
3317 | IMPLICIT NONE |
---|
3318 | |
---|
3319 | INTEGER(iwp), INTENT(in) :: prunmode |
---|
3320 | |
---|
3321 | SELECT CASE(prunmode) |
---|
3322 | |
---|
3323 | CASE(1) !< Initialization |
---|
3324 | lscoag = .FALSE. |
---|
3325 | lscnd = .FALSE. |
---|
3326 | lscndgas = .FALSE. |
---|
3327 | lscndh2oae = .FALSE. |
---|
3328 | lsdepo = .FALSE. |
---|
3329 | lsdepo_pcm = .FALSE. |
---|
3330 | lsdepo_surf = .FALSE. |
---|
3331 | lsdistupdate = .TRUE. |
---|
3332 | lspartition = .FALSE. |
---|
3333 | |
---|
3334 | CASE(2) !< Spinup period |
---|
3335 | lscoag = ( .FALSE. .AND. nlcoag ) |
---|
3336 | lscnd = ( .TRUE. .AND. nlcnd ) |
---|
3337 | lscndgas = ( .TRUE. .AND. nlcndgas ) |
---|
3338 | lscndh2oae = ( .TRUE. .AND. nlcndh2oae ) |
---|
3339 | |
---|
3340 | CASE(3) !< Run |
---|
3341 | lscoag = nlcoag |
---|
3342 | lscnd = nlcnd |
---|
3343 | lscndgas = nlcndgas |
---|
3344 | lscndh2oae = nlcndh2oae |
---|
3345 | lsdepo = nldepo |
---|
3346 | lsdepo_pcm = nldepo_pcm |
---|
3347 | lsdepo_surf = nldepo_surf |
---|
3348 | lsdistupdate = nldistupdate |
---|
3349 | END SELECT |
---|
3350 | |
---|
3351 | |
---|
3352 | END SUBROUTINE set_salsa_runtime |
---|
3353 | |
---|
3354 | !------------------------------------------------------------------------------! |
---|
3355 | ! Description: |
---|
3356 | ! ------------ |
---|
3357 | !> Calculates the absolute temperature (using hydrostatic pressure), saturation |
---|
3358 | !> vapour pressure and mixing ratio over water, relative humidity and air |
---|
3359 | !> density needed in the SALSA model. |
---|
3360 | !> NOTE, no saturation adjustment takes place -> the resulting water vapour |
---|
3361 | !> mixing ratio can be supersaturated, allowing the microphysical calculations |
---|
3362 | !> in SALSA. |
---|
3363 | ! |
---|
3364 | !> Juha Tonttila, FMI, 2014 (original SALSAthrm) |
---|
3365 | !> Mona Kurppa, UHel, 2017 (adjustment for PALM and only aerosol processes) |
---|
3366 | !------------------------------------------------------------------------------! |
---|
3367 | SUBROUTINE salsa_thrm_ij( i, j, p_ij, temp_ij, cw_ij, cs_ij, adn_ij ) |
---|
3368 | |
---|
3369 | USE arrays_3d, & |
---|
3370 | ONLY: pt, q, zu |
---|
3371 | |
---|
3372 | USE basic_constants_and_equations_mod, & |
---|
3373 | ONLY: barometric_formula, exner_function, ideal_gas_law_rho, magnus |
---|
3374 | |
---|
3375 | IMPLICIT NONE |
---|
3376 | |
---|
3377 | INTEGER(iwp), INTENT(in) :: i !< |
---|
3378 | INTEGER(iwp), INTENT(in) :: j !< |
---|
3379 | |
---|
3380 | REAL(wp) :: t_surface !< absolute surface temperature (K) |
---|
3381 | |
---|
3382 | REAL(wp), DIMENSION(nzb:nzt+1) :: e_s !< saturation vapour pressure over water (Pa) |
---|
3383 | |
---|
3384 | REAL(wp), DIMENSION(:), INTENT(inout) :: adn_ij !< air density (kg/m3) |
---|
3385 | REAL(wp), DIMENSION(:), INTENT(inout) :: p_ij !< air pressure (Pa) |
---|
3386 | REAL(wp), DIMENSION(:), INTENT(inout) :: temp_ij !< air temperature (K) |
---|
3387 | |
---|
3388 | REAL(wp), DIMENSION(:), INTENT(inout), OPTIONAL :: cw_ij !< water vapour concentration (kg/m3) |
---|
3389 | REAL(wp), DIMENSION(:), INTENT(inout), OPTIONAL :: cs_ij !< saturation water vap. conc.(kg/m3) |
---|
3390 | ! |
---|
3391 | !-- Pressure p_ijk (Pa) = hydrostatic pressure |
---|
3392 | t_surface = pt_surface * exner_function( surface_pressure * 100.0_wp ) |
---|
3393 | p_ij(:) = barometric_formula( zu, t_surface, surface_pressure * 100.0_wp ) |
---|
3394 | ! |
---|
3395 | !-- Absolute ambient temperature (K) |
---|
3396 | temp_ij(:) = pt(:,j,i) * exner_function( p_ij(:) ) |
---|
3397 | ! |
---|
3398 | !-- Air density |
---|
3399 | adn_ij(:) = ideal_gas_law_rho( p_ij(:), temp_ij(:) ) |
---|
3400 | ! |
---|
3401 | !-- Water vapour concentration r_v (kg/m3) |
---|
3402 | IF ( PRESENT( cw_ij ) ) THEN |
---|
3403 | cw_ij(:) = ( q(:,j,i) / ( 1.0_wp - q(:,j,i) ) ) * adn_ij(:) |
---|
3404 | ENDIF |
---|
3405 | ! |
---|
3406 | !-- Saturation mixing ratio r_s (kg/kg) from vapour pressure at temp (Pa) |
---|
3407 | IF ( PRESENT( cs_ij ) ) THEN |
---|
3408 | e_s(:) = 611.0_wp * EXP( alv_d_rv * ( 3.6609E-3_wp - 1.0_wp / & |
---|
3409 | temp_ij(:) ) )! magnus( temp_ij(:) ) |
---|
3410 | cs_ij(:) = ( 0.622_wp * e_s / ( p_ij(:) - e_s(:) ) ) * adn_ij(:) |
---|
3411 | ENDIF |
---|
3412 | |
---|
3413 | END SUBROUTINE salsa_thrm_ij |
---|
3414 | |
---|
3415 | !------------------------------------------------------------------------------! |
---|
3416 | ! Description: |
---|
3417 | ! ------------ |
---|
3418 | !> Calculates ambient sizes of particles by equilibrating soluble fraction of |
---|
3419 | !> particles with water using the ZSR method (Stokes and Robinson, 1966). |
---|
3420 | !> Method: |
---|
3421 | !> Following chemical components are assumed water-soluble |
---|
3422 | !> - (ammonium) sulphate (100%) |
---|
3423 | !> - sea salt (100 %) |
---|
3424 | !> - organic carbon (epsoc * 100%) |
---|
3425 | !> Exact thermodynamic considerations neglected. |
---|
3426 | !> - If particles contain no sea salt, calculation according to sulphate |
---|
3427 | !> properties |
---|
3428 | !> - If contain sea salt but no sulphate, calculation according to sea salt |
---|
3429 | !> properties |
---|
3430 | !> - If contain both sulphate and sea salt -> the molar fraction of these |
---|
3431 | !> compounds determines which one of them is used as the basis of calculation. |
---|
3432 | !> If sulphate and sea salt coexist in a particle, it is assumed that the Cl is |
---|
3433 | !> replaced by sulphate; thus only either sulphate + organics or sea salt + |
---|
3434 | !> organics is included in the calculation of soluble fraction. |
---|
3435 | !> Molality parameterizations taken from Table 1 of Tang: Thermodynamic and |
---|
3436 | !> optical properties of mixed-salt aerosols of atmospheric importance, |
---|
3437 | !> J. Geophys. Res., 102 (D2), 1883-1893 (1997) |
---|
3438 | ! |
---|
3439 | !> Coded by: |
---|
3440 | !> Hannele Korhonen (FMI) 2005 |
---|
3441 | !> Harri Kokkola (FMI) 2006 |
---|
3442 | !> Matti Niskanen(FMI) 2012 |
---|
3443 | !> Anton Laakso (FMI) 2013 |
---|
3444 | !> Modified for the new aerosol datatype, Juha Tonttila (FMI) 2014 |
---|
3445 | ! |
---|
3446 | !> fxm: should sea salt form a solid particle when prh is very low (even though |
---|
3447 | !> it could be mixed with e.g. sulphate)? |
---|
3448 | !> fxm: crashes if no sulphate or sea salt |
---|
3449 | !> fxm: do we really need to consider Kelvin effect for subrange 2 |
---|
3450 | !------------------------------------------------------------------------------! |
---|
3451 | SUBROUTINE equilibration( prh, ptemp, paero, init ) |
---|
3452 | |
---|
3453 | IMPLICIT NONE |
---|
3454 | |
---|
3455 | INTEGER(iwp) :: ib !< loop index |
---|
3456 | INTEGER(iwp) :: counti !< loop index |
---|
3457 | |
---|
3458 | LOGICAL, INTENT(in) :: init !< TRUE: Initialization, FALSE: Normal runtime: update water |
---|
3459 | !< content only for 1a |
---|
3460 | |
---|
3461 | REAL(wp) :: zaw !< water activity [0-1] |
---|
3462 | REAL(wp) :: zcore !< Volume of dry particle |
---|
3463 | REAL(wp) :: zdold !< Old diameter |
---|
3464 | REAL(wp) :: zdwet !< Wet diameter or mean droplet diameter |
---|
3465 | REAL(wp) :: zke !< Kelvin term in the Köhler equation |
---|
3466 | REAL(wp) :: zlwc !< liquid water content [kg/m3-air] |
---|
3467 | REAL(wp) :: zrh !< Relative humidity |
---|
3468 | |
---|
3469 | REAL(wp), DIMENSION(maxspec) :: zbinmol !< binary molality of each components (mol/kg) |
---|
3470 | REAL(wp), DIMENSION(maxspec) :: zvpart !< volume of chem. compounds in one particle |
---|
3471 | |
---|
3472 | REAL(wp), INTENT(in) :: prh !< relative humidity [0-1] |
---|
3473 | REAL(wp), INTENT(in) :: ptemp !< temperature (K) |
---|
3474 | |
---|
3475 | TYPE(t_section), DIMENSION(nbins_aerosol), INTENT(inout) :: paero !< aerosol properties |
---|
3476 | |
---|
3477 | zaw = 0.0_wp |
---|
3478 | zlwc = 0.0_wp |
---|
3479 | ! |
---|
3480 | !-- Relative humidity: |
---|
3481 | zrh = prh |
---|
3482 | zrh = MAX( zrh, 0.05_wp ) |
---|
3483 | zrh = MIN( zrh, 0.98_wp) |
---|
3484 | ! |
---|
3485 | !-- 1) Regime 1: sulphate and partly water-soluble OC. Done for every CALL |
---|
3486 | DO ib = start_subrange_1a, end_subrange_1a ! size bin |
---|
3487 | |
---|
3488 | zbinmol = 0.0_wp |
---|
3489 | zdold = 1.0_wp |
---|
3490 | zke = 1.02_wp |
---|
3491 | |
---|
3492 | IF ( paero(ib)%numc > nclim ) THEN |
---|
3493 | ! |
---|
3494 | !-- Volume in one particle |
---|
3495 | zvpart = 0.0_wp |
---|
3496 | zvpart(1:2) = paero(ib)%volc(1:2) / paero(ib)%numc |
---|
3497 | zvpart(6:7) = paero(ib)%volc(6:7) / paero(ib)%numc |
---|
3498 | ! |
---|
3499 | !-- Total volume and wet diameter of one dry particle |
---|
3500 | zcore = SUM( zvpart(1:2) ) |
---|
3501 | zdwet = paero(ib)%dwet |
---|
3502 | |
---|
3503 | counti = 0 |
---|
3504 | DO WHILE ( ABS( zdwet / zdold - 1.0_wp ) > 1.0E-2_wp ) |
---|
3505 | |
---|
3506 | zdold = MAX( zdwet, 1.0E-20_wp ) |
---|
3507 | zaw = MAX( 1.0E-3_wp, zrh / zke ) ! To avoid underflow |
---|
3508 | ! |
---|
3509 | !-- Binary molalities (mol/kg): |
---|
3510 | !-- Sulphate |
---|
3511 | zbinmol(1) = 1.1065495E+2_wp - 3.6759197E+2_wp * zaw + 5.0462934E+2_wp * zaw**2 - & |
---|
3512 | 3.1543839E+2_wp * zaw**3 + 6.770824E+1_wp * zaw**4 |
---|
3513 | !-- Organic carbon |
---|
3514 | zbinmol(2) = 1.0_wp / ( zaw * amh2o ) - 1.0_wp / amh2o |
---|
3515 | !-- Nitric acid |
---|
3516 | zbinmol(6) = 2.306844303E+1_wp - 3.563608869E+1_wp * zaw - 6.210577919E+1_wp * zaw**2 & |
---|
3517 | + 5.510176187E+2_wp * zaw**3 - 1.460055286E+3_wp * zaw**4 & |
---|
3518 | + 1.894467542E+3_wp * zaw**5 - 1.220611402E+3_wp * zaw**6 & |
---|
3519 | + 3.098597737E+2_wp * zaw**7 |
---|
3520 | ! |
---|
3521 | !-- Calculate the liquid water content (kg/m3-air) using ZSR (see e.g. Eq. 10.98 in |
---|
3522 | !-- Seinfeld and Pandis (2006)) |
---|
3523 | zlwc = ( paero(ib)%volc(1) * ( arhoh2so4 / amh2so4 ) ) / zbinmol(1) + & |
---|
3524 | epsoc * paero(ib)%volc(2) * ( arhooc / amoc ) / zbinmol(2) + & |
---|
3525 | ( paero(ib)%volc(6) * ( arhohno3/amhno3 ) ) / zbinmol(6) |
---|
3526 | ! |
---|
3527 | !-- Particle wet diameter (m) |
---|
3528 | zdwet = ( zlwc / paero(ib)%numc / arhoh2o / api6 + ( SUM( zvpart(6:7) ) / api6 ) + & |
---|
3529 | zcore / api6 )**0.33333333_wp |
---|
3530 | ! |
---|
3531 | !-- Kelvin effect (Eq. 10.85 in in Seinfeld and Pandis (2006)). Avoid |
---|
3532 | !-- overflow. |
---|
3533 | zke = EXP( MIN( 50.0_wp, 4.0_wp * surfw0 * amvh2so4 / ( abo * ptemp * zdwet ) ) ) |
---|
3534 | |
---|
3535 | counti = counti + 1 |
---|
3536 | IF ( counti > 1000 ) THEN |
---|
3537 | message_string = 'Subrange 1: no convergence!' |
---|
3538 | CALL message( 'salsa_mod: equilibration', 'PA0617', 1, 2, 0, 6, 0 ) |
---|
3539 | ENDIF |
---|
3540 | ENDDO |
---|
3541 | ! |
---|
3542 | !-- Instead of lwc, use the volume concentration of water from now on |
---|
3543 | !-- (easy to convert...) |
---|
3544 | paero(ib)%volc(8) = zlwc / arhoh2o |
---|
3545 | ! |
---|
3546 | !-- If this is initialization, update the core and wet diameter |
---|
3547 | IF ( init ) THEN |
---|
3548 | paero(ib)%dwet = zdwet |
---|
3549 | paero(ib)%core = zcore |
---|
3550 | ENDIF |
---|
3551 | |
---|
3552 | ELSE |
---|
3553 | !-- If initialization |
---|
3554 | !-- 1.2) empty bins given bin average values |
---|
3555 | IF ( init ) THEN |
---|
3556 | paero(ib)%dwet = paero(ib)%dmid |
---|
3557 | paero(ib)%core = api6 * paero(ib)%dmid**3 |
---|
3558 | ENDIF |
---|
3559 | |
---|
3560 | ENDIF |
---|
3561 | |
---|
3562 | ENDDO ! ib |
---|
3563 | ! |
---|
3564 | !-- 2) Regime 2a: sulphate, OC, BC and sea salt |
---|
3565 | !-- This is done only for initialization call, otherwise the water contents |
---|
3566 | !-- are computed via condensation |
---|
3567 | IF ( init ) THEN |
---|
3568 | DO ib = start_subrange_2a, end_subrange_2b |
---|
3569 | ! |
---|
3570 | !-- Initialize |
---|
3571 | zke = 1.02_wp |
---|
3572 | zbinmol = 0.0_wp |
---|
3573 | zdold = 1.0_wp |
---|
3574 | ! |
---|
3575 | !-- 1) Particle properties calculated for non-empty bins |
---|
3576 | IF ( paero(ib)%numc > nclim ) THEN |
---|
3577 | ! |
---|
3578 | !-- Volume in one particle [fxm] |
---|
3579 | zvpart = 0.0_wp |
---|
3580 | zvpart(1:7) = paero(ib)%volc(1:7) / paero(ib)%numc |
---|
3581 | ! |
---|
3582 | !-- Total volume and wet diameter of one dry particle [fxm] |
---|
3583 | zcore = SUM( zvpart(1:5) ) |
---|
3584 | zdwet = paero(ib)%dwet |
---|
3585 | |
---|
3586 | counti = 0 |
---|
3587 | DO WHILE ( ABS( zdwet / zdold - 1.0_wp ) > 1.0E-12_wp ) |
---|
3588 | |
---|
3589 | zdold = MAX( zdwet, 1.0E-20_wp ) |
---|
3590 | zaw = zrh / zke |
---|
3591 | ! |
---|
3592 | !-- Binary molalities (mol/kg): |
---|
3593 | !-- Sulphate |
---|
3594 | zbinmol(1) = 1.1065495E+2_wp - 3.6759197E+2_wp * zaw + 5.0462934E+2_wp * zaw**2 - & |
---|
3595 | 3.1543839E+2_wp * zaw**3 + 6.770824E+1_wp * zaw**4 |
---|
3596 | !-- Organic carbon |
---|
3597 | zbinmol(2) = 1.0_wp / ( zaw * amh2o ) - 1.0_wp / amh2o |
---|
3598 | !-- Nitric acid |
---|
3599 | zbinmol(6) = 2.306844303E+1_wp - 3.563608869E+1_wp * zaw - & |
---|
3600 | 6.210577919E+1_wp * zaw**2 + 5.510176187E+2_wp * zaw**3 - & |
---|
3601 | 1.460055286E+3_wp * zaw**4 + 1.894467542E+3_wp * zaw**5 - & |
---|
3602 | 1.220611402E+3_wp * zaw**6 + 3.098597737E+2_wp * zaw**7 |
---|
3603 | !-- Sea salt (natrium chloride) |
---|
3604 | zbinmol(5) = 5.875248E+1_wp - 1.8781997E+2_wp * zaw + 2.7211377E+2_wp * zaw**2 - & |
---|
3605 | 1.8458287E+2_wp * zaw**3 + 4.153689E+1_wp * zaw**4 |
---|
3606 | ! |
---|
3607 | !-- Calculate the liquid water content (kg/m3-air) |
---|
3608 | zlwc = ( paero(ib)%volc(1) * ( arhoh2so4 / amh2so4 ) ) / zbinmol(1) + & |
---|
3609 | epsoc * ( paero(ib)%volc(2) * ( arhooc / amoc ) ) / zbinmol(2) + & |
---|
3610 | ( paero(ib)%volc(6) * ( arhohno3 / amhno3 ) ) / zbinmol(6) + & |
---|
3611 | ( paero(ib)%volc(5) * ( arhoss / amss ) ) / zbinmol(5) |
---|
3612 | |
---|
3613 | !-- Particle wet radius (m) |
---|
3614 | zdwet = ( zlwc / paero(ib)%numc / arhoh2o / api6 + ( SUM( zvpart(6:7) ) / api6 ) + & |
---|
3615 | zcore / api6 )**0.33333333_wp |
---|
3616 | ! |
---|
3617 | !-- Kelvin effect (Eq. 10.85 in Seinfeld and Pandis (2006)) |
---|
3618 | zke = EXP( MIN( 50.0_wp, 4.0_wp * surfw0 * amvh2so4 / ( abo * zdwet * ptemp ) ) ) |
---|
3619 | |
---|
3620 | counti = counti + 1 |
---|
3621 | IF ( counti > 1000 ) THEN |
---|
3622 | message_string = 'Subrange 2: no convergence!' |
---|
3623 | CALL message( 'salsa_mod: equilibration', 'PA0618', 1, 2, 0, 6, 0 ) |
---|
3624 | ENDIF |
---|
3625 | ENDDO |
---|
3626 | ! |
---|
3627 | !-- Liquid water content; instead of LWC use the volume concentration |
---|
3628 | paero(ib)%volc(8) = zlwc / arhoh2o |
---|
3629 | paero(ib)%dwet = zdwet |
---|
3630 | paero(ib)%core = zcore |
---|
3631 | |
---|
3632 | ELSE |
---|
3633 | !-- 2.2) empty bins given bin average values |
---|
3634 | paero(ib)%dwet = paero(ib)%dmid |
---|
3635 | paero(ib)%core = api6 * paero(ib)%dmid**3 |
---|
3636 | ENDIF |
---|
3637 | |
---|
3638 | ENDDO ! ib |
---|
3639 | ENDIF |
---|
3640 | |
---|
3641 | END SUBROUTINE equilibration |
---|
3642 | |
---|
3643 | !------------------------------------------------------------------------------! |
---|
3644 | !> Description: |
---|
3645 | !> ------------ |
---|
3646 | !> Calculation of the settling velocity vc (m/s) per aerosol size bin and |
---|
3647 | !> deposition on plant canopy (lsdepo_pcm). |
---|
3648 | ! |
---|
3649 | !> Deposition is based on either the scheme presented in: |
---|
3650 | !> Zhang et al. (2001), Atmos. Environ. 35, 549-560 (includes collection due to |
---|
3651 | !> Brownian diffusion, impaction, interception and sedimentation; hereafter ZO1) |
---|
3652 | !> OR |
---|
3653 | !> Petroff & Zhang (2010), Geosci. Model Dev. 3, 753-769 (includes also |
---|
3654 | !> collection due to turbulent impaction, hereafter P10) |
---|
3655 | ! |
---|
3656 | !> Equation numbers refer to equation in Jacobson (2005): Fundamentals of |
---|
3657 | !> Atmospheric Modeling, 2nd Edition. |
---|
3658 | ! |
---|
3659 | !> Subroutine follows closely sedim_SALSA in UCLALES-SALSA written by Juha |
---|
3660 | !> Tonttila (KIT/FMI) and Zubair Maalick (UEF). |
---|
3661 | !> Rewritten to PALM by Mona Kurppa (UH), 2017. |
---|
3662 | ! |
---|
3663 | !> Call for grid point i,j,k |
---|
3664 | !------------------------------------------------------------------------------! |
---|
3665 | |
---|
3666 | SUBROUTINE deposition( paero, tk, adn, mag_u, lad, kvis, schmidt_num, vc ) |
---|
3667 | |
---|
3668 | USE plant_canopy_model_mod, & |
---|
3669 | ONLY: cdc |
---|
3670 | |
---|
3671 | IMPLICIT NONE |
---|
3672 | |
---|
3673 | INTEGER(iwp) :: ib !< loop index |
---|
3674 | INTEGER(iwp) :: ic !< loop index |
---|
3675 | |
---|
3676 | REAL(wp) :: alpha !< parameter, Table 3 in Z01 |
---|
3677 | REAL(wp) :: avis !< molecular viscocity of air (kg/(m*s)) |
---|
3678 | REAL(wp) :: beta_im !< parameter for turbulent impaction |
---|
3679 | REAL(wp) :: c_brownian_diff !< coefficient for Brownian diffusion |
---|
3680 | REAL(wp) :: c_impaction !< coefficient for inertial impaction |
---|
3681 | REAL(wp) :: c_interception !< coefficient for interception |
---|
3682 | REAL(wp) :: c_turb_impaction !< coefficient for turbulent impaction |
---|
3683 | REAL(wp) :: depo !< deposition velocity (m/s) |
---|
3684 | REAL(wp) :: gamma !< parameter, Table 3 in Z01 |
---|
3685 | REAL(wp) :: lambda !< molecular mean free path (m) |
---|
3686 | REAL(wp) :: mdiff !< particle diffusivity coefficient |
---|
3687 | REAL(wp) :: par_a !< parameter A for the characteristic radius of collectors, |
---|
3688 | !< Table 3 in Z01 |
---|
3689 | REAL(wp) :: par_l !< obstacle characteristic dimension in P10 |
---|
3690 | REAL(wp) :: pdn !< particle density (kg/m3) |
---|
3691 | REAL(wp) :: ustar !< friction velocity (m/s) |
---|
3692 | REAL(wp) :: va !< thermal speed of an air molecule (m/s) |
---|
3693 | |
---|
3694 | REAL(wp), INTENT(in) :: adn !< air density (kg/m3) |
---|
3695 | REAL(wp), INTENT(in) :: lad !< leaf area density (m2/m3) |
---|
3696 | REAL(wp), INTENT(in) :: mag_u !< wind velocity (m/s) |
---|
3697 | REAL(wp), INTENT(in) :: tk !< abs.temperature (K) |
---|
3698 | |
---|
3699 | REAL(wp), INTENT(inout) :: kvis !< kinematic viscosity of air (m2/s) |
---|
3700 | |
---|
3701 | REAL(wp), DIMENSION(nbins_aerosol) :: beta !< Cunningham slip-flow correction factor |
---|
3702 | REAL(wp), DIMENSION(nbins_aerosol) :: Kn !< Knudsen number |
---|
3703 | REAL(wp), DIMENSION(nbins_aerosol) :: zdwet !< wet diameter (m) |
---|
3704 | |
---|
3705 | REAL(wp), DIMENSION(:), INTENT(inout) :: schmidt_num !< particle Schmidt number |
---|
3706 | REAL(wp), DIMENSION(:), INTENT(inout) :: vc !< critical fall speed i.e. settling velocity of |
---|
3707 | !< an aerosol particle (m/s) |
---|
3708 | |
---|
3709 | TYPE(t_section), DIMENSION(nbins_aerosol), INTENT(inout) :: paero !< aerosol properties |
---|
3710 | ! |
---|
3711 | !-- Initialise |
---|
3712 | depo = 0.0_wp |
---|
3713 | pdn = 1500.0_wp ! default value |
---|
3714 | ustar = 0.0_wp |
---|
3715 | ! |
---|
3716 | !-- Molecular viscosity of air (Eq. 4.54) |
---|
3717 | avis = 1.8325E-5_wp * ( 416.16_wp / ( tk + 120.0_wp ) ) * ( tk / 296.16_wp )**1.5_wp |
---|
3718 | ! |
---|
3719 | !-- Kinematic viscosity (Eq. 4.55) |
---|
3720 | kvis = avis / adn |
---|
3721 | ! |
---|
3722 | !-- Thermal velocity of an air molecule (Eq. 15.32) |
---|
3723 | va = SQRT( 8.0_wp * abo * tk / ( pi * am_airmol ) ) |
---|
3724 | ! |
---|
3725 | !-- Mean free path (m) (Eq. 15.24) |
---|
3726 | lambda = 2.0_wp * avis / ( adn * va ) |
---|
3727 | ! |
---|
3728 | !-- Particle wet diameter (m) |
---|
3729 | zdwet = paero(:)%dwet |
---|
3730 | ! |
---|
3731 | !-- Knudsen number (Eq. 15.23) |
---|
3732 | Kn = MAX( 1.0E-2_wp, lambda / ( zdwet * 0.5_wp ) ) ! To avoid underflow |
---|
3733 | ! |
---|
3734 | !-- Cunningham slip-flow correction (Eq. 15.30) |
---|
3735 | beta = 1.0_wp + Kn * ( 1.249_wp + 0.42_wp * EXP( -0.87_wp / Kn ) ) |
---|
3736 | ! |
---|
3737 | !-- Critical fall speed i.e. settling velocity (Eq. 20.4) |
---|
3738 | vc = MIN( 1.0_wp, zdwet**2 * ( pdn - adn ) * g * beta / ( 18.0_wp * avis ) ) |
---|
3739 | ! |
---|
3740 | !-- Deposition on vegetation |
---|
3741 | IF ( lsdepo_pcm .AND. plant_canopy .AND. lad > 0.0_wp ) THEN |
---|
3742 | ! |
---|
3743 | !-- Parameters for the land use category 'deciduous broadleaf trees'(Table 3) |
---|
3744 | alpha = alpha_z01(depo_pcm_type_num) |
---|
3745 | gamma = gamma_z01(depo_pcm_type_num) |
---|
3746 | par_a = A_z01(depo_pcm_type_num, season) * 1.0E-3_wp |
---|
3747 | ! |
---|
3748 | !-- Deposition efficiencies from Table 1. Constants from Table 2. |
---|
3749 | par_l = l_p10(depo_pcm_type_num) * 0.01_wp |
---|
3750 | c_brownian_diff = c_b_p10(depo_pcm_type_num) |
---|
3751 | c_interception = c_in_p10(depo_pcm_type_num) |
---|
3752 | c_impaction = c_im_p10(depo_pcm_type_num) |
---|
3753 | beta_im = beta_im_p10(depo_pcm_type_num) |
---|
3754 | c_turb_impaction = c_it_p10(depo_pcm_type_num) |
---|
3755 | |
---|
3756 | DO ib = 1, nbins_aerosol |
---|
3757 | |
---|
3758 | IF ( paero(ib)%numc < ( 2.0_wp * nclim ) ) CYCLE |
---|
3759 | |
---|
3760 | !-- Particle diffusivity coefficient (Eq. 15.29) |
---|
3761 | mdiff = ( abo * tk * beta(ib) ) / ( 3.0_wp * pi * avis * zdwet(ib) ) |
---|
3762 | ! |
---|
3763 | !-- Particle Schmidt number (Eq. 15.36) |
---|
3764 | schmidt_num(ib) = kvis / mdiff |
---|
3765 | ! |
---|
3766 | !-- Friction velocity for deposition on vegetation. Calculated following Prandtl (1925): |
---|
3767 | ustar = SQRT( cdc ) * mag_u |
---|
3768 | SELECT CASE ( depo_pcm_par_num ) |
---|
3769 | |
---|
3770 | CASE ( 1 ) ! Zhang et al. (2001) |
---|
3771 | CALL depo_vel_Z01( vc(ib), ustar, schmidt_num(ib), paero(ib)%dwet, alpha, gamma, & |
---|
3772 | par_a, depo ) |
---|
3773 | CASE ( 2 ) ! Petroff & Zhang (2010) |
---|
3774 | CALL depo_vel_P10( vc(ib), mag_u, ustar, kvis, schmidt_num(ib), paero(ib)%dwet, & |
---|
3775 | par_l, c_brownian_diff, c_interception, c_impaction, beta_im, & |
---|
3776 | c_turb_impaction, depo ) |
---|
3777 | END SELECT |
---|
3778 | ! |
---|
3779 | !-- Calculate the change in concentrations |
---|
3780 | paero(ib)%numc = paero(ib)%numc - depo * lad * paero(ib)%numc * dt_salsa |
---|
3781 | DO ic = 1, maxspec+1 |
---|
3782 | paero(ib)%volc(ic) = paero(ib)%volc(ic) - depo * lad * paero(ib)%volc(ic) * dt_salsa |
---|
3783 | ENDDO |
---|
3784 | ENDDO |
---|
3785 | |
---|
3786 | ENDIF |
---|
3787 | |
---|
3788 | END SUBROUTINE deposition |
---|
3789 | |
---|
3790 | !------------------------------------------------------------------------------! |
---|
3791 | ! Description: |
---|
3792 | ! ------------ |
---|
3793 | !> Calculate deposition velocity (m/s) based on Zhan et al. (2001, case 1). |
---|
3794 | !------------------------------------------------------------------------------! |
---|
3795 | |
---|
3796 | SUBROUTINE depo_vel_Z01( vc, ustar, schmidt_num, diameter, alpha, gamma, par_a, depo ) |
---|
3797 | |
---|
3798 | IMPLICIT NONE |
---|
3799 | |
---|
3800 | REAL(wp) :: rs !< overall quasi-laminar resistance for particles |
---|
3801 | REAL(wp) :: stokes_num !< Stokes number for smooth or bluff surfaces |
---|
3802 | |
---|
3803 | REAL(wp), INTENT(in) :: alpha !< parameter, Table 3 in Z01 |
---|
3804 | REAL(wp), INTENT(in) :: gamma !< parameter, Table 3 in Z01 |
---|
3805 | REAL(wp), INTENT(in) :: par_a !< parameter A for the characteristic diameter of |
---|
3806 | !< collectors, Table 3 in Z01 |
---|
3807 | REAL(wp), INTENT(in) :: diameter !< particle diameter |
---|
3808 | REAL(wp), INTENT(in) :: schmidt_num !< particle Schmidt number |
---|
3809 | REAL(wp), INTENT(in) :: ustar !< friction velocity (m/s) |
---|
3810 | REAL(wp), INTENT(in) :: vc !< terminal velocity (m/s) |
---|
3811 | |
---|
3812 | REAL(wp), INTENT(inout) :: depo !< deposition efficiency (m/s) |
---|
3813 | |
---|
3814 | IF ( par_a > 0.0_wp ) THEN |
---|
3815 | ! |
---|
3816 | !-- Initialise |
---|
3817 | rs = 0.0_wp |
---|
3818 | ! |
---|
3819 | !-- Stokes number for vegetated surfaces (Seinfeld & Pandis (2006): Eq.19.24) |
---|
3820 | stokes_num = vc * ustar / ( g * par_a ) |
---|
3821 | ! |
---|
3822 | !-- The overall quasi-laminar resistance for particles (Zhang et al., Eq. 5) |
---|
3823 | rs = MAX( EPSILON( 1.0_wp ), ( 3.0_wp * ustar * EXP( -stokes_num**0.5_wp ) * & |
---|
3824 | ( schmidt_num**( -gamma ) + ( stokes_num / ( alpha + stokes_num ) )**2 + & |
---|
3825 | 0.5_wp * ( diameter / par_a )**2 ) ) ) |
---|
3826 | |
---|
3827 | depo = rs + vc |
---|
3828 | |
---|
3829 | ELSE |
---|
3830 | depo = 0.0_wp |
---|
3831 | ENDIF |
---|
3832 | |
---|
3833 | END SUBROUTINE depo_vel_Z01 |
---|
3834 | |
---|
3835 | !------------------------------------------------------------------------------! |
---|
3836 | ! Description: |
---|
3837 | ! ------------ |
---|
3838 | !> Calculate deposition velocity (m/s) based on Petroff & Zhang (2010, case 2). |
---|
3839 | !------------------------------------------------------------------------------! |
---|
3840 | |
---|
3841 | SUBROUTINE depo_vel_P10( vc, mag_u, ustar, kvis_a, schmidt_num, diameter, par_l, c_brownian_diff, & |
---|
3842 | c_interception, c_impaction, beta_im, c_turb_impaction, depo ) |
---|
3843 | |
---|
3844 | IMPLICIT NONE |
---|
3845 | |
---|
3846 | REAL(wp) :: stokes_num !< Stokes number for smooth or bluff surfaces |
---|
3847 | REAL(wp) :: tau_plus !< dimensionless particle relaxation time |
---|
3848 | REAL(wp) :: v_bd !< deposition velocity due to Brownian diffusion |
---|
3849 | REAL(wp) :: v_im !< deposition velocity due to impaction |
---|
3850 | REAL(wp) :: v_in !< deposition velocity due to interception |
---|
3851 | REAL(wp) :: v_it !< deposition velocity due to turbulent impaction |
---|
3852 | |
---|
3853 | REAL(wp), INTENT(in) :: beta_im !< parameter for turbulent impaction |
---|
3854 | REAL(wp), INTENT(in) :: c_brownian_diff !< coefficient for Brownian diffusion |
---|
3855 | REAL(wp), INTENT(in) :: c_impaction !< coefficient for inertial impaction |
---|
3856 | REAL(wp), INTENT(in) :: c_interception !< coefficient for interception |
---|
3857 | REAL(wp), INTENT(in) :: c_turb_impaction !< coefficient for turbulent impaction |
---|
3858 | REAL(wp), INTENT(in) :: kvis_a !< kinematic viscosity of air (m2/s) |
---|
3859 | REAL(wp), INTENT(in) :: mag_u !< wind velocity (m/s) |
---|
3860 | REAL(wp), INTENT(in) :: par_l !< obstacle characteristic dimension in P10 |
---|
3861 | REAL(wp), INTENT(in) :: diameter !< particle diameter |
---|
3862 | REAL(wp), INTENT(in) :: schmidt_num !< particle Schmidt number |
---|
3863 | REAL(wp), INTENT(in) :: ustar !< friction velocity (m/s) |
---|
3864 | REAL(wp), INTENT(in) :: vc !< terminal velocity (m/s) |
---|
3865 | |
---|
3866 | REAL(wp), INTENT(inout) :: depo !< deposition efficiency (m/s) |
---|
3867 | |
---|
3868 | IF ( par_l > 0.0_wp ) THEN |
---|
3869 | ! |
---|
3870 | !-- Initialise |
---|
3871 | tau_plus = 0.0_wp |
---|
3872 | v_bd = 0.0_wp |
---|
3873 | v_im = 0.0_wp |
---|
3874 | v_in = 0.0_wp |
---|
3875 | v_it = 0.0_wp |
---|
3876 | ! |
---|
3877 | !-- Stokes number for vegetated surfaces (Seinfeld & Pandis (2006): Eq.19.24) |
---|
3878 | stokes_num = vc * ustar / ( g * par_l ) |
---|
3879 | ! |
---|
3880 | !-- Non-dimensional relexation time of the particle on top of canopy |
---|
3881 | tau_plus = vc * ustar**2 / ( kvis_a * g ) |
---|
3882 | ! |
---|
3883 | !-- Brownian diffusion |
---|
3884 | v_bd = mag_u * c_brownian_diff * schmidt_num**( -0.66666666_wp ) * & |
---|
3885 | ( mag_u * par_l / kvis_a )**( -0.5_wp ) |
---|
3886 | ! |
---|
3887 | !-- Interception |
---|
3888 | v_in = mag_u * c_interception * diameter / par_l * & |
---|
3889 | ( 2.0_wp + LOG( 2.0_wp * par_l / diameter ) ) |
---|
3890 | ! |
---|
3891 | !-- Impaction: Petroff (2009) Eq. 18 |
---|
3892 | v_im = mag_u * c_impaction * ( stokes_num / ( stokes_num + beta_im ) )**2 |
---|
3893 | ! |
---|
3894 | !-- Turbulent impaction |
---|
3895 | IF ( tau_plus < 20.0_wp ) THEN |
---|
3896 | v_it = 2.5E-3_wp * c_turb_impaction * tau_plus**2 |
---|
3897 | ELSE |
---|
3898 | v_it = c_turb_impaction |
---|
3899 | ENDIF |
---|
3900 | |
---|
3901 | depo = ( v_bd + v_in + v_im + v_it + vc ) |
---|
3902 | |
---|
3903 | ELSE |
---|
3904 | depo = 0.0_wp |
---|
3905 | ENDIF |
---|
3906 | |
---|
3907 | END SUBROUTINE depo_vel_P10 |
---|
3908 | |
---|
3909 | !------------------------------------------------------------------------------! |
---|
3910 | ! Description: |
---|
3911 | ! ------------ |
---|
3912 | !> Calculate the dry deposition on horizontal and vertical surfaces. Implement |
---|
3913 | !> as a surface flux. |
---|
3914 | !> @todo aerodynamic resistance ignored for now (not important for |
---|
3915 | ! high-resolution simulations) |
---|
3916 | !------------------------------------------------------------------------------! |
---|
3917 | SUBROUTINE depo_surf( i, j, surf, vc, schmidt_num, kvis, mag_u, norm, match_array ) |
---|
3918 | |
---|
3919 | USE arrays_3d, & |
---|
3920 | ONLY: rho_air_zw |
---|
3921 | |
---|
3922 | USE surface_mod, & |
---|
3923 | ONLY: ind_pav_green, ind_veg_wall, ind_wat_win, surf_type |
---|
3924 | |
---|
3925 | IMPLICIT NONE |
---|
3926 | |
---|
3927 | INTEGER(iwp) :: ib !< loop index |
---|
3928 | INTEGER(iwp) :: ic !< loop index |
---|
3929 | INTEGER(iwp) :: icc !< additional loop index |
---|
3930 | INTEGER(iwp) :: k !< loop index |
---|
3931 | INTEGER(iwp) :: m !< loop index |
---|
3932 | INTEGER(iwp) :: surf_e !< End index of surface elements at (j,i)-gridpoint |
---|
3933 | INTEGER(iwp) :: surf_s !< Start index of surface elements at (j,i)-gridpoint |
---|
3934 | |
---|
3935 | INTEGER(iwp), INTENT(in) :: i !< loop index |
---|
3936 | INTEGER(iwp), INTENT(in) :: j !< loop index |
---|
3937 | |
---|
3938 | LOGICAL, INTENT(in) :: norm !< to normalise or not |
---|
3939 | |
---|
3940 | REAL(wp) :: alpha !< parameter, Table 3 in Z01 |
---|
3941 | REAL(wp) :: beta_im !< parameter for turbulent impaction |
---|
3942 | REAL(wp) :: c_brownian_diff !< coefficient for Brownian diffusion |
---|
3943 | REAL(wp) :: c_impaction !< coefficient for inertial impaction |
---|
3944 | REAL(wp) :: c_interception !< coefficient for interception |
---|
3945 | REAL(wp) :: c_turb_impaction !< coefficient for turbulent impaction |
---|
3946 | REAL(wp) :: gamma !< parameter, Table 3 in Z01 |
---|
3947 | REAL(wp) :: norm_fac !< normalisation factor (usually air density) |
---|
3948 | REAL(wp) :: par_a !< parameter A for the characteristic radius of collectors, |
---|
3949 | !< Table 3 in Z01 |
---|
3950 | REAL(wp) :: par_l !< obstacle characteristic dimension in P10 |
---|
3951 | REAL(wp) :: rs !< the overall quasi-laminar resistance for particles |
---|
3952 | REAL(wp) :: tau_plus !< dimensionless particle relaxation time |
---|
3953 | REAL(wp) :: v_bd !< deposition velocity due to Brownian diffusion |
---|
3954 | REAL(wp) :: v_im !< deposition velocity due to impaction |
---|
3955 | REAL(wp) :: v_in !< deposition velocity due to interception |
---|
3956 | REAL(wp) :: v_it !< deposition velocity due to turbulent impaction |
---|
3957 | |
---|
3958 | REAL(wp), DIMENSION(nbins_aerosol) :: depo !< deposition efficiency |
---|
3959 | REAL(wp), DIMENSION(nbins_aerosol) :: depo_sum !< sum of deposition efficiencies |
---|
3960 | |
---|
3961 | REAL(wp), DIMENSION(:), INTENT(in) :: kvis !< kinematic viscosity of air (m2/s) |
---|
3962 | REAL(wp), DIMENSION(:), INTENT(in) :: mag_u !< wind velocity (m/s) |
---|
3963 | |
---|
3964 | REAL(wp), DIMENSION(:,:), INTENT(in) :: schmidt_num !< particle Schmidt number |
---|
3965 | REAL(wp), DIMENSION(:,:), INTENT(in) :: vc !< terminal velocity (m/s) |
---|
3966 | |
---|
3967 | TYPE(match_surface), INTENT(in), OPTIONAL :: match_array !< match the deposition module and |
---|
3968 | !< LSM/USM surfaces |
---|
3969 | TYPE(surf_type), INTENT(inout) :: surf !< respective surface type |
---|
3970 | ! |
---|
3971 | !-- Initialise |
---|
3972 | depo = 0.0_wp |
---|
3973 | depo_sum = 0.0_wp |
---|
3974 | rs = 0.0_wp |
---|
3975 | surf_s = surf%start_index(j,i) |
---|
3976 | surf_e = surf%end_index(j,i) |
---|
3977 | tau_plus = 0.0_wp |
---|
3978 | v_bd = 0.0_wp |
---|
3979 | v_im = 0.0_wp |
---|
3980 | v_in = 0.0_wp |
---|
3981 | v_it = 0.0_wp |
---|
3982 | ! |
---|
3983 | !-- Model parameters for the land use category. If LSM or USM is applied, import |
---|
3984 | !-- characteristics. Otherwise, apply surface type "urban". |
---|
3985 | alpha = alpha_z01(luc_urban) |
---|
3986 | gamma = gamma_z01(luc_urban) |
---|
3987 | par_a = A_z01(luc_urban, season) * 1.0E-3_wp |
---|
3988 | |
---|
3989 | par_l = l_p10(luc_urban) * 0.01_wp |
---|
3990 | c_brownian_diff = c_b_p10(luc_urban) |
---|
3991 | c_interception = c_in_p10(luc_urban) |
---|
3992 | c_impaction = c_im_p10(luc_urban) |
---|
3993 | beta_im = beta_im_p10(luc_urban) |
---|
3994 | c_turb_impaction = c_it_p10(luc_urban) |
---|
3995 | |
---|
3996 | |
---|
3997 | IF ( PRESENT( match_array ) ) THEN ! land or urban surface model |
---|
3998 | |
---|
3999 | DO m = surf_s, surf_e |
---|
4000 | |
---|
4001 | k = surf%k(m) |
---|
4002 | norm_fac = 1.0_wp |
---|
4003 | |
---|
4004 | IF ( norm ) norm_fac = rho_air_zw(k) ! normalise vertical fluxes by air density |
---|
4005 | |
---|
4006 | IF ( match_array%match_lupg(m) > 0 ) THEN |
---|
4007 | alpha = alpha_z01( match_array%match_lupg(m) ) |
---|
4008 | gamma = gamma_z01( match_array%match_lupg(m) ) |
---|
4009 | par_a = A_z01( match_array%match_lupg(m), season ) * 1.0E-3_wp |
---|
4010 | |
---|
4011 | beta_im = beta_im_p10( match_array%match_lupg(m) ) |
---|
4012 | c_brownian_diff = c_b_p10( match_array%match_lupg(m) ) |
---|
4013 | c_impaction = c_im_p10( match_array%match_lupg(m) ) |
---|
4014 | c_interception = c_in_p10( match_array%match_lupg(m) ) |
---|
4015 | c_turb_impaction = c_it_p10( match_array%match_lupg(m) ) |
---|
4016 | par_l = l_p10( match_array%match_lupg(m) ) * 0.01_wp |
---|
4017 | |
---|
4018 | DO ib = 1, nbins_aerosol |
---|
4019 | IF ( aerosol_number(ib)%conc(k,j,i) < ( 2.0_wp * nclim ) .OR. & |
---|
4020 | schmidt_num(k+1,ib) < 1.0_wp ) CYCLE |
---|
4021 | |
---|
4022 | SELECT CASE ( depo_surf_par_num ) |
---|
4023 | |
---|
4024 | CASE ( 1 ) |
---|
4025 | CALL depo_vel_Z01( vc(k+1,ib), surf%us(m), schmidt_num(k+1,ib), & |
---|
4026 | ra_dry(k,j,i,ib), alpha, gamma, par_a, depo(ib) ) |
---|
4027 | CASE ( 2 ) |
---|
4028 | CALL depo_vel_P10( vc(k+1,ib), mag_u(k+1), surf%us(m), kvis(k+1), & |
---|
4029 | schmidt_num(k+1,ib), ra_dry(k,j,i,ib), par_l, & |
---|
4030 | c_brownian_diff, c_interception, c_impaction, beta_im, & |
---|
4031 | c_turb_impaction, depo(ib) ) |
---|
4032 | END SELECT |
---|
4033 | ENDDO |
---|
4034 | depo_sum = depo_sum + surf%frac(ind_pav_green,m) * depo |
---|
4035 | ENDIF |
---|
4036 | |
---|
4037 | IF ( match_array%match_luvw(m) > 0 ) THEN |
---|
4038 | alpha = alpha_z01( match_array%match_luvw(m) ) |
---|
4039 | gamma = gamma_z01( match_array%match_luvw(m) ) |
---|
4040 | par_a = A_z01( match_array%match_luvw(m), season ) * 1.0E-3_wp |
---|
4041 | |
---|
4042 | beta_im = beta_im_p10( match_array%match_luvw(m) ) |
---|
4043 | c_brownian_diff = c_b_p10( match_array%match_luvw(m) ) |
---|
4044 | c_impaction = c_im_p10( match_array%match_luvw(m) ) |
---|
4045 | c_interception = c_in_p10( match_array%match_luvw(m) ) |
---|
4046 | c_turb_impaction = c_it_p10( match_array%match_luvw(m) ) |
---|
4047 | par_l = l_p10( match_array%match_luvw(m) ) * 0.01_wp |
---|
4048 | |
---|
4049 | DO ib = 1, nbins_aerosol |
---|
4050 | IF ( aerosol_number(ib)%conc(k,j,i) < ( 2.0_wp * nclim ) .OR. & |
---|
4051 | schmidt_num(k+1,ib) < 1.0_wp ) CYCLE |
---|
4052 | |
---|
4053 | SELECT CASE ( depo_surf_par_num ) |
---|
4054 | |
---|
4055 | CASE ( 1 ) |
---|
4056 | CALL depo_vel_Z01( vc(k+1,ib), surf%us(m), schmidt_num(k+1,ib), & |
---|
4057 | ra_dry(k,j,i,ib), alpha, gamma, par_a, depo(ib) ) |
---|
4058 | CASE ( 2 ) |
---|
4059 | CALL depo_vel_P10( vc(k+1,ib), mag_u(k+1), surf%us(m), kvis(k+1), & |
---|
4060 | schmidt_num(k+1,ib), ra_dry(k,j,i,ib), par_l, & |
---|
4061 | c_brownian_diff, c_interception, c_impaction, beta_im, & |
---|
4062 | c_turb_impaction, depo(ib) ) |
---|
4063 | END SELECT |
---|
4064 | ENDDO |
---|
4065 | depo_sum = depo_sum + surf%frac(ind_veg_wall,m) * depo |
---|
4066 | ENDIF |
---|
4067 | |
---|
4068 | IF ( match_array%match_luww(m) > 0 ) THEN |
---|
4069 | alpha = alpha_z01( match_array%match_luww(m) ) |
---|
4070 | gamma = gamma_z01( match_array%match_luww(m) ) |
---|
4071 | par_a = A_z01( match_array%match_luww(m), season ) * 1.0E-3_wp |
---|
4072 | |
---|
4073 | beta_im = beta_im_p10( match_array%match_luww(m) ) |
---|
4074 | c_brownian_diff = c_b_p10( match_array%match_luww(m) ) |
---|
4075 | c_impaction = c_im_p10( match_array%match_luww(m) ) |
---|
4076 | c_interception = c_in_p10( match_array%match_luww(m) ) |
---|
4077 | c_turb_impaction = c_it_p10( match_array%match_luww(m) ) |
---|
4078 | par_l = l_p10( match_array%match_luww(m) ) * 0.01_wp |
---|
4079 | |
---|
4080 | DO ib = 1, nbins_aerosol |
---|
4081 | IF ( aerosol_number(ib)%conc(k,j,i) < ( 2.0_wp * nclim ) .OR. & |
---|
4082 | schmidt_num(k+1,ib) < 1.0_wp ) CYCLE |
---|
4083 | |
---|
4084 | SELECT CASE ( depo_surf_par_num ) |
---|
4085 | |
---|
4086 | CASE ( 1 ) |
---|
4087 | CALL depo_vel_Z01( vc(k+1,ib), surf%us(m), schmidt_num(k+1,ib), & |
---|
4088 | ra_dry(k,j,i,ib), alpha, gamma, par_a, depo(ib) ) |
---|
4089 | CASE ( 2 ) |
---|
4090 | CALL depo_vel_P10( vc(k+1,ib), mag_u(k+1), surf%us(m), kvis(k+1), & |
---|
4091 | schmidt_num(k+1,ib), ra_dry(k,j,i,ib), par_l, & |
---|
4092 | c_brownian_diff, c_interception, c_impaction, beta_im, & |
---|
4093 | c_turb_impaction, depo(ib) ) |
---|
4094 | END SELECT |
---|
4095 | ENDDO |
---|
4096 | depo_sum = depo_sum + surf%frac(ind_wat_win,m) * depo |
---|
4097 | ENDIF |
---|
4098 | |
---|
4099 | DO ib = 1, nbins_aerosol |
---|
4100 | IF ( aerosol_number(ib)%conc(k,j,i) < ( 2.0_wp * nclim ) ) CYCLE |
---|
4101 | ! |
---|
4102 | !-- Calculate changes in surface fluxes due to dry deposition |
---|
4103 | IF ( include_emission ) THEN |
---|
4104 | surf%answs(m,ib) = aerosol_number(ib)%source(j,i) - MAX( 0.0_wp, & |
---|
4105 | depo_sum(ib) * norm_fac * aerosol_number(ib)%conc(k,j,i) ) |
---|
4106 | DO ic = 1, ncomponents_mass |
---|
4107 | icc = ( ic - 1 ) * nbins_aerosol + ib |
---|
4108 | surf%amsws(m,icc) = aerosol_mass(icc)%source(j,i) - MAX( 0.0_wp, & |
---|
4109 | depo_sum(ib) * norm_fac * aerosol_mass(icc)%conc(k,j,i) ) |
---|
4110 | ENDDO ! ic |
---|
4111 | ELSE |
---|
4112 | surf%answs(m,ib) = -depo_sum(ib) * norm_fac * aerosol_number(ib)%conc(k,j,i) |
---|
4113 | DO ic = 1, ncomponents_mass |
---|
4114 | icc = ( ic - 1 ) * nbins_aerosol + ib |
---|
4115 | surf%amsws(m,icc) = -depo_sum(ib) * norm_fac * aerosol_mass(icc)%conc(k,j,i) |
---|
4116 | ENDDO ! ic |
---|
4117 | ENDIF |
---|
4118 | ENDDO ! ib |
---|
4119 | |
---|
4120 | ENDDO |
---|
4121 | |
---|
4122 | ELSE ! default surfaces |
---|
4123 | |
---|
4124 | DO m = surf_s, surf_e |
---|
4125 | |
---|
4126 | k = surf%k(m) |
---|
4127 | norm_fac = 1.0_wp |
---|
4128 | |
---|
4129 | IF ( norm ) norm_fac = rho_air_zw(k) ! normalise vertical fluxes by air density |
---|
4130 | |
---|
4131 | DO ib = 1, nbins_aerosol |
---|
4132 | IF ( aerosol_number(ib)%conc(k,j,i) < ( 2.0_wp * nclim ) .OR. & |
---|
4133 | schmidt_num(k+1,ib) < 1.0_wp ) CYCLE |
---|
4134 | |
---|
4135 | SELECT CASE ( depo_surf_par_num ) |
---|
4136 | |
---|
4137 | CASE ( 1 ) |
---|
4138 | CALL depo_vel_Z01( vc(k+1,ib), surf%us(m), schmidt_num(k+1,ib), & |
---|
4139 | ra_dry(k,j,i,ib), alpha, gamma, par_a, depo(ib) ) |
---|
4140 | CASE ( 2 ) |
---|
4141 | CALL depo_vel_P10( vc(k+1,ib), mag_u(k+1), surf%us(m), kvis(k+1), & |
---|
4142 | schmidt_num(k+1,ib), ra_dry(k,j,i,ib), par_l, & |
---|
4143 | c_brownian_diff, c_interception, c_impaction, beta_im, & |
---|
4144 | c_turb_impaction, depo(ib) ) |
---|
4145 | END SELECT |
---|
4146 | ! |
---|
4147 | !-- Calculate changes in surface fluxes due to dry deposition |
---|
4148 | IF ( include_emission ) THEN |
---|
4149 | surf%answs(m,ib) = aerosol_number(ib)%source(j,i) - MAX( 0.0_wp, & |
---|
4150 | depo(ib) * norm_fac * aerosol_number(ib)%conc(k,j,i) ) |
---|
4151 | DO ic = 1, ncomponents_mass |
---|
4152 | icc = ( ic - 1 ) * nbins_aerosol + ib |
---|
4153 | surf%amsws(m,icc) = aerosol_mass(icc)%source(j,i) - MAX( 0.0_wp, & |
---|
4154 | depo(ib) * norm_fac * aerosol_mass(icc)%conc(k,j,i) ) |
---|
4155 | ENDDO ! ic |
---|
4156 | ELSE |
---|
4157 | surf%answs(m,ib) = -depo(ib) * norm_fac * aerosol_number(ib)%conc(k,j,i) |
---|
4158 | DO ic = 1, ncomponents_mass |
---|
4159 | icc = ( ic - 1 ) * nbins_aerosol + ib |
---|
4160 | surf%amsws(m,icc) = -depo(ib) * norm_fac * aerosol_mass(icc)%conc(k,j,i) |
---|
4161 | ENDDO ! ic |
---|
4162 | ENDIF |
---|
4163 | ENDDO ! ib |
---|
4164 | ENDDO |
---|
4165 | |
---|
4166 | ENDIF |
---|
4167 | |
---|
4168 | END SUBROUTINE depo_surf |
---|
4169 | |
---|
4170 | !------------------------------------------------------------------------------! |
---|
4171 | ! Description: |
---|
4172 | ! ------------ |
---|
4173 | !> Calculates particle loss and change in size distribution due to (Brownian) |
---|
4174 | !> coagulation. Only for particles with dwet < 30 micrometres. |
---|
4175 | ! |
---|
4176 | !> Method: |
---|
4177 | !> Semi-implicit, non-iterative method: (Jacobson, 1994) |
---|
4178 | !> Volume concentrations of the smaller colliding particles added to the bin of |
---|
4179 | !> the larger colliding particles. Start from first bin and use the updated |
---|
4180 | !> number and volume for calculation of following bins. NB! Our bin numbering |
---|
4181 | !> does not follow particle size in subrange 2. |
---|
4182 | ! |
---|
4183 | !> Schematic for bin numbers in different subranges: |
---|
4184 | !> 1 2 |
---|
4185 | !> +-------------------------------------------+ |
---|
4186 | !> a | 1 | 2 | 3 || 4 | 5 | 6 | 7 | 8 | 9 | 10|| |
---|
4187 | !> b | ||11 |12 |13 |14 | 15 | 16 | 17|| |
---|
4188 | !> +-------------------------------------------+ |
---|
4189 | ! |
---|
4190 | !> Exact coagulation coefficients for each pressure level are scaled according |
---|
4191 | !> to current particle wet size (linear scaling). |
---|
4192 | !> Bins are organized in terms of the dry size of the condensation nucleus, |
---|
4193 | !> while coagulation kernell is calculated with the actual hydrometeor |
---|
4194 | !> size. |
---|
4195 | ! |
---|
4196 | !> Called from salsa_driver |
---|
4197 | !> fxm: Process selection should be made smarter - now just lots of IFs inside |
---|
4198 | !> loops |
---|
4199 | ! |
---|
4200 | !> Coded by: |
---|
4201 | !> Hannele Korhonen (FMI) 2005 |
---|
4202 | !> Harri Kokkola (FMI) 2006 |
---|
4203 | !> Tommi Bergman (FMI) 2012 |
---|
4204 | !> Matti Niskanen(FMI) 2012 |
---|
4205 | !> Anton Laakso (FMI) 2013 |
---|
4206 | !> Juha Tonttila (FMI) 2014 |
---|
4207 | !------------------------------------------------------------------------------! |
---|
4208 | SUBROUTINE coagulation( paero, ptstep, ptemp, ppres ) |
---|
4209 | |
---|
4210 | IMPLICIT NONE |
---|
4211 | |
---|
4212 | INTEGER(iwp) :: index_2a !< corresponding bin in subrange 2a |
---|
4213 | INTEGER(iwp) :: index_2b !< corresponding bin in subrange 2b |
---|
4214 | INTEGER(iwp) :: ib !< loop index |
---|
4215 | INTEGER(iwp) :: ll !< loop index |
---|
4216 | INTEGER(iwp) :: mm !< loop index |
---|
4217 | INTEGER(iwp) :: nn !< loop index |
---|
4218 | |
---|
4219 | REAL(wp) :: pressi !< pressure |
---|
4220 | REAL(wp) :: temppi !< temperature |
---|
4221 | REAL(wp) :: zdpart_mm !< diameter of particle (m) |
---|
4222 | REAL(wp) :: zdpart_nn !< diameter of particle (m) |
---|
4223 | REAL(wp) :: zminusterm !< coagulation loss in a bin (1/s) |
---|
4224 | |
---|
4225 | REAL(wp), INTENT(in) :: ppres !< ambient pressure (Pa) |
---|
4226 | REAL(wp), INTENT(in) :: ptemp !< ambient temperature (K) |
---|
4227 | REAL(wp), INTENT(in) :: ptstep !< time step (s) |
---|
4228 | |
---|
4229 | REAL(wp), DIMENSION(nbins_aerosol) :: zmpart !< approximate mass of particles (kg) |
---|
4230 | REAL(wp), DIMENSION(maxspec+1) :: zplusterm !< coagulation gain in a bin (for each |
---|
4231 | !< chemical compound) |
---|
4232 | REAL(wp), DIMENSION(nbins_aerosol,nbins_aerosol) :: zcc !< updated coagulation coeff. (m3/s) |
---|
4233 | |
---|
4234 | TYPE(t_section), DIMENSION(nbins_aerosol), INTENT(inout) :: paero !< Aerosol properties |
---|
4235 | |
---|
4236 | zdpart_mm = 0.0_wp |
---|
4237 | zdpart_nn = 0.0_wp |
---|
4238 | ! |
---|
4239 | !-- 1) Coagulation to coarse mode calculated in a simplified way: |
---|
4240 | !-- CoagSink ~ Dp in continuum subrange --> 'effective' number conc. of coarse particles |
---|
4241 | |
---|
4242 | !-- 2) Updating coagulation coefficients |
---|
4243 | ! |
---|
4244 | !-- Aerosol mass (kg). Density of 1500 kg/m3 assumed |
---|
4245 | zmpart(1:end_subrange_2b) = api6 * ( MIN( paero(1:end_subrange_2b)%dwet, 30.0E-6_wp )**3 ) & |
---|
4246 | * 1500.0_wp |
---|
4247 | temppi = ptemp |
---|
4248 | pressi = ppres |
---|
4249 | zcc = 0.0_wp |
---|
4250 | ! |
---|
4251 | !-- Aero-aero coagulation |
---|
4252 | DO mm = 1, end_subrange_2b ! smaller colliding particle |
---|
4253 | IF ( paero(mm)%numc < ( 2.0_wp * nclim ) ) CYCLE |
---|
4254 | DO nn = mm, end_subrange_2b ! larger colliding particle |
---|
4255 | IF ( paero(nn)%numc < ( 2.0_wp * nclim ) ) CYCLE |
---|
4256 | |
---|
4257 | zdpart_mm = MIN( paero(mm)%dwet, 30.0E-6_wp ) ! Limit to 30 um |
---|
4258 | zdpart_nn = MIN( paero(nn)%dwet, 30.0E-6_wp ) ! Limit to 30 um |
---|
4259 | ! |
---|
4260 | !-- Coagulation coefficient of particles (m3/s) |
---|
4261 | zcc(mm,nn) = coagc( zdpart_mm, zdpart_nn, zmpart(mm), zmpart(nn), temppi, pressi ) |
---|
4262 | zcc(nn,mm) = zcc(mm,nn) |
---|
4263 | ENDDO |
---|
4264 | ENDDO |
---|
4265 | |
---|
4266 | ! |
---|
4267 | !-- 3) New particle and volume concentrations after coagulation: |
---|
4268 | !-- Calculated according to Jacobson (2005) eq. 15.9 |
---|
4269 | ! |
---|
4270 | !-- Aerosols in subrange 1a: |
---|
4271 | DO ib = start_subrange_1a, end_subrange_1a |
---|
4272 | IF ( paero(ib)%numc < ( 2.0_wp * nclim ) ) CYCLE |
---|
4273 | zminusterm = 0.0_wp |
---|
4274 | zplusterm(:) = 0.0_wp |
---|
4275 | ! |
---|
4276 | !-- Particles lost by coagulation with larger aerosols |
---|
4277 | DO ll = ib+1, end_subrange_2b |
---|
4278 | zminusterm = zminusterm + zcc(ib,ll) * paero(ll)%numc |
---|
4279 | ENDDO |
---|
4280 | ! |
---|
4281 | !-- Coagulation gain in a bin: change in volume conc. (cm3/cm3): |
---|
4282 | DO ll = start_subrange_1a, ib - 1 |
---|
4283 | zplusterm(1:2) = zplusterm(1:2) + zcc(ll,ib) * paero(ll)%volc(1:2) |
---|
4284 | zplusterm(6:7) = zplusterm(6:7) + zcc(ll,ib) * paero(ll)%volc(6:7) |
---|
4285 | zplusterm(8) = zplusterm(8) + zcc(ll,ib) * paero(ll)%volc(8) |
---|
4286 | ENDDO |
---|
4287 | ! |
---|
4288 | !-- Volume and number concentrations after coagulation update [fxm] |
---|
4289 | paero(ib)%volc(1:2) = ( paero(ib)%volc(1:2) + ptstep * zplusterm(1:2) * paero(ib)%numc ) / & |
---|
4290 | ( 1.0_wp + ptstep * zminusterm ) |
---|
4291 | paero(ib)%volc(6:8) = ( paero(ib)%volc(6:8) + ptstep * zplusterm(6:8) * paero(ib)%numc ) / & |
---|
4292 | ( 1.0_wp + ptstep * zminusterm ) |
---|
4293 | paero(ib)%numc = paero(ib)%numc / ( 1.0_wp + ptstep * zminusterm + 0.5_wp * ptstep * & |
---|
4294 | zcc(ib,ib) * paero(ib)%numc ) |
---|
4295 | ENDDO |
---|
4296 | ! |
---|
4297 | !-- Aerosols in subrange 2a: |
---|
4298 | DO ib = start_subrange_2a, end_subrange_2a |
---|
4299 | IF ( paero(ib)%numc < ( 2.0_wp * nclim ) ) CYCLE |
---|
4300 | zminusterm = 0.0_wp |
---|
4301 | zplusterm(:) = 0.0_wp |
---|
4302 | ! |
---|
4303 | !-- Find corresponding size bin in subrange 2b |
---|
4304 | index_2b = ib - start_subrange_2a + start_subrange_2b |
---|
4305 | ! |
---|
4306 | !-- Particles lost by larger particles in 2a |
---|
4307 | DO ll = ib+1, end_subrange_2a |
---|
4308 | zminusterm = zminusterm + zcc(ib,ll) * paero(ll)%numc |
---|
4309 | ENDDO |
---|
4310 | ! |
---|
4311 | !-- Particles lost by larger particles in 2b |
---|
4312 | IF ( .NOT. no_insoluble ) THEN |
---|
4313 | DO ll = index_2b+1, end_subrange_2b |
---|
4314 | zminusterm = zminusterm + zcc(ib,ll) * paero(ll)%numc |
---|
4315 | ENDDO |
---|
4316 | ENDIF |
---|
4317 | ! |
---|
4318 | !-- Particle volume gained from smaller particles in subranges 1, 2a and 2b |
---|
4319 | DO ll = start_subrange_1a, ib-1 |
---|
4320 | zplusterm(1:2) = zplusterm(1:2) + zcc(ll,ib) * paero(ll)%volc(1:2) |
---|
4321 | zplusterm(6:8) = zplusterm(6:8) + zcc(ll,ib) * paero(ll)%volc(6:8) |
---|
4322 | ENDDO |
---|
4323 | ! |
---|
4324 | !-- Particle volume gained from smaller particles in 2a |
---|
4325 | !-- (Note, for components not included in the previous loop!) |
---|
4326 | DO ll = start_subrange_2a, ib-1 |
---|
4327 | zplusterm(3:5) = zplusterm(3:5) + zcc(ll,ib)*paero(ll)%volc(3:5) |
---|
4328 | ENDDO |
---|
4329 | ! |
---|
4330 | !-- Particle volume gained from smaller (and equal) particles in 2b |
---|
4331 | IF ( .NOT. no_insoluble ) THEN |
---|
4332 | DO ll = start_subrange_2b, index_2b |
---|
4333 | zplusterm(1:8) = zplusterm(1:8) + zcc(ll,ib) * paero(ll)%volc(1:8) |
---|
4334 | ENDDO |
---|
4335 | ENDIF |
---|
4336 | ! |
---|
4337 | !-- Volume and number concentrations after coagulation update [fxm] |
---|
4338 | paero(ib)%volc(1:8) = ( paero(ib)%volc(1:8) + ptstep * zplusterm(1:8) * paero(ib)%numc ) / & |
---|
4339 | ( 1.0_wp + ptstep * zminusterm ) |
---|
4340 | paero(ib)%numc = paero(ib)%numc / ( 1.0_wp + ptstep * zminusterm + 0.5_wp * ptstep * & |
---|
4341 | zcc(ib,ib) * paero(ib)%numc ) |
---|
4342 | ENDDO |
---|
4343 | ! |
---|
4344 | !-- Aerosols in subrange 2b: |
---|
4345 | IF ( .NOT. no_insoluble ) THEN |
---|
4346 | DO ib = start_subrange_2b, end_subrange_2b |
---|
4347 | IF ( paero(ib)%numc < ( 2.0_wp * nclim ) ) CYCLE |
---|
4348 | zminusterm = 0.0_wp |
---|
4349 | zplusterm(:) = 0.0_wp |
---|
4350 | ! |
---|
4351 | !-- Find corresponding size bin in subsubrange 2a |
---|
4352 | index_2a = ib - start_subrange_2b + start_subrange_2a |
---|
4353 | ! |
---|
4354 | !-- Particles lost to larger particles in subranges 2b |
---|
4355 | DO ll = ib + 1, end_subrange_2b |
---|
4356 | zminusterm = zminusterm + zcc(ib,ll) * paero(ll)%numc |
---|
4357 | ENDDO |
---|
4358 | ! |
---|
4359 | !-- Particles lost to larger and equal particles in 2a |
---|
4360 | DO ll = index_2a, end_subrange_2a |
---|
4361 | zminusterm = zminusterm + zcc(ib,ll) * paero(ll)%numc |
---|
4362 | ENDDO |
---|
4363 | ! |
---|
4364 | !-- Particle volume gained from smaller particles in subranges 1 & 2a |
---|
4365 | DO ll = start_subrange_1a, index_2a - 1 |
---|
4366 | zplusterm(1:8) = zplusterm(1:8) + zcc(ll,ib) * paero(ll)%volc(1:8) |
---|
4367 | ENDDO |
---|
4368 | ! |
---|
4369 | !-- Particle volume gained from smaller particles in 2b |
---|
4370 | DO ll = start_subrange_2b, ib - 1 |
---|
4371 | zplusterm(1:8) = zplusterm(1:8) + zcc(ll,ib) * paero(ll)%volc(1:8) |
---|
4372 | ENDDO |
---|
4373 | ! |
---|
4374 | !-- Volume and number concentrations after coagulation update [fxm] |
---|
4375 | paero(ib)%volc(1:8) = ( paero(ib)%volc(1:8) + ptstep * zplusterm(1:8) * paero(ib)%numc ) & |
---|
4376 | / ( 1.0_wp + ptstep * zminusterm ) |
---|
4377 | paero(ib)%numc = paero(ib)%numc / ( 1.0_wp + ptstep * zminusterm + 0.5_wp * ptstep * & |
---|
4378 | zcc(ib,ib) * paero(ib)%numc ) |
---|
4379 | ENDDO |
---|
4380 | ENDIF |
---|
4381 | |
---|
4382 | END SUBROUTINE coagulation |
---|
4383 | |
---|
4384 | !------------------------------------------------------------------------------! |
---|
4385 | ! Description: |
---|
4386 | ! ------------ |
---|
4387 | !> Calculation of coagulation coefficients. Extended version of the function |
---|
4388 | !> originally found in mo_salsa_init. |
---|
4389 | ! |
---|
4390 | !> J. Tonttila, FMI, 05/2014 |
---|
4391 | !------------------------------------------------------------------------------! |
---|
4392 | REAL(wp) FUNCTION coagc( diam1, diam2, mass1, mass2, temp, pres ) |
---|
4393 | |
---|
4394 | IMPLICIT NONE |
---|
4395 | |
---|
4396 | REAL(wp) :: fmdist !< distance of flux matching (m) |
---|
4397 | REAL(wp) :: knud_p !< particle Knudsen number |
---|
4398 | REAL(wp) :: mdiam !< mean diameter of colliding particles (m) |
---|
4399 | REAL(wp) :: mfp !< mean free path of air molecules (m) |
---|
4400 | REAL(wp) :: visc !< viscosity of air (kg/(m s)) |
---|
4401 | |
---|
4402 | REAL(wp), INTENT(in) :: diam1 !< diameter of colliding particle 1 (m) |
---|
4403 | REAL(wp), INTENT(in) :: diam2 !< diameter of colliding particle 2 (m) |
---|
4404 | REAL(wp), INTENT(in) :: mass1 !< mass of colliding particle 1 (kg) |
---|
4405 | REAL(wp), INTENT(in) :: mass2 !< mass of colliding particle 2 (kg) |
---|
4406 | REAL(wp), INTENT(in) :: pres !< ambient pressure (Pa?) [fxm] |
---|
4407 | REAL(wp), INTENT(in) :: temp !< ambient temperature (K) |
---|
4408 | |
---|
4409 | REAL(wp), DIMENSION (2) :: beta !< Cunningham correction factor |
---|
4410 | REAL(wp), DIMENSION (2) :: dfpart !< particle diffusion coefficient (m2/s) |
---|
4411 | REAL(wp), DIMENSION (2) :: diam !< diameters of particles (m) |
---|
4412 | REAL(wp), DIMENSION (2) :: flux !< flux in continuum and free molec. regime (m/s) |
---|
4413 | REAL(wp), DIMENSION (2) :: knud !< particle Knudsen number |
---|
4414 | REAL(wp), DIMENSION (2) :: mpart !< masses of particles (kg) |
---|
4415 | REAL(wp), DIMENSION (2) :: mtvel !< particle mean thermal velocity (m/s) |
---|
4416 | REAL(wp), DIMENSION (2) :: omega !< particle mean free path |
---|
4417 | REAL(wp), DIMENSION (2) :: tva !< temporary variable (m) |
---|
4418 | ! |
---|
4419 | !-- Initialisation |
---|
4420 | coagc = 0.0_wp |
---|
4421 | ! |
---|
4422 | !-- 1) Initializing particle and ambient air variables |
---|
4423 | diam = (/ diam1, diam2 /) !< particle diameters (m) |
---|
4424 | mpart = (/ mass1, mass2 /) !< particle masses (kg) |
---|
4425 | ! |
---|
4426 | !-- Viscosity of air (kg/(m s)) |
---|
4427 | visc = ( 7.44523E-3_wp * temp ** 1.5_wp ) / ( 5093.0_wp * ( temp + 110.4_wp ) ) |
---|
4428 | ! |
---|
4429 | !-- Mean free path of air (m) |
---|
4430 | mfp = ( 1.656E-10_wp * temp + 1.828E-8_wp ) * ( p_0 + 1325.0_wp ) / pres |
---|
4431 | ! |
---|
4432 | !-- 2) Slip correction factor for small particles |
---|
4433 | knud = 2.0_wp * EXP( LOG(mfp) - LOG(diam) )! Knudsen number for air (15.23) |
---|
4434 | ! |
---|
4435 | !-- Cunningham correction factor (Allen and Raabe, Aerosol Sci. Tech. 4, 269) |
---|
4436 | beta = 1.0_wp + knud * ( 1.142_wp + 0.558_wp * EXP( -0.999_wp / knud ) ) |
---|
4437 | ! |
---|
4438 | !-- 3) Particle properties |
---|
4439 | !-- Diffusion coefficient (m2/s) (Jacobson (2005) eq. 15.29) |
---|
4440 | dfpart = beta * abo * temp / ( 3.0_wp * pi * visc * diam ) |
---|
4441 | ! |
---|
4442 | !-- Mean thermal velocity (m/s) (Jacobson (2005) eq. 15.32) |
---|
4443 | mtvel = SQRT( ( 8.0_wp * abo * temp ) / ( pi * mpart ) ) |
---|
4444 | ! |
---|
4445 | !-- Particle mean free path (m) (Jacobson (2005) eq. 15.34 ) |
---|
4446 | omega = 8.0_wp * dfpart / ( pi * mtvel ) |
---|
4447 | ! |
---|
4448 | !-- Mean diameter (m) |
---|
4449 | mdiam = 0.5_wp * ( diam(1) + diam(2) ) |
---|
4450 | ! |
---|
4451 | !-- 4) Calculation of fluxes (Brownian collision kernels) and flux matching |
---|
4452 | !-- following Jacobson (2005): |
---|
4453 | ! |
---|
4454 | !-- Flux in continuum regime (m3/s) (eq. 15.28) |
---|
4455 | flux(1) = 4.0_wp * pi * mdiam * ( dfpart(1) + dfpart(2) ) |
---|
4456 | ! |
---|
4457 | !-- Flux in free molec. regime (m3/s) (eq. 15.31) |
---|
4458 | flux(2) = pi * SQRT( ( mtvel(1)**2 ) + ( mtvel(2)**2 ) ) * ( mdiam**2 ) |
---|
4459 | ! |
---|
4460 | !-- temporary variables (m) to calculate flux matching distance (m) |
---|
4461 | tva(1) = ( ( mdiam + omega(1) )**3 - ( mdiam**2 + omega(1)**2 ) * SQRT( ( mdiam**2 + & |
---|
4462 | omega(1)**2 ) ) ) / ( 3.0_wp * mdiam * omega(1) ) - mdiam |
---|
4463 | tva(2) = ( ( mdiam + omega(2) )**3 - ( mdiam**2 + omega(2)**2 ) * SQRT( ( mdiam**2 + & |
---|
4464 | omega(2)**2 ) ) ) / ( 3.0_wp * mdiam * omega(2) ) - mdiam |
---|
4465 | ! |
---|
4466 | !-- Flux matching distance (m): the mean distance from the centre of a sphere reached by particles |
---|
4467 | !-- that leave sphere's surface and travel a distance of particle mean free path (eq. 15.34) |
---|
4468 | fmdist = SQRT( tva(1)**2 + tva(2)**2 ) |
---|
4469 | ! |
---|
4470 | !-- 5) Coagulation coefficient = coalescence efficiency * collision kernel (m3/s) (eq. 15.33). |
---|
4471 | !-- Here assumed coalescence efficiency 1!! |
---|
4472 | coagc = flux(1) / ( mdiam / ( mdiam + fmdist) + flux(1) / flux(2) ) |
---|
4473 | ! |
---|
4474 | !-- Corrected collision kernel (Karl et al., 2016 (ACP)): Include van der Waals and viscous forces |
---|
4475 | IF ( van_der_waals_coagc ) THEN |
---|
4476 | knud_p = SQRT( omega(1)**2 + omega(2)**2 ) / mdiam |
---|
4477 | IF ( knud_p >= 0.1_wp .AND. knud_p <= 10.0_wp ) THEN |
---|
4478 | coagc = coagc * ( 2.0_wp + 0.4_wp * LOG( knud_p ) ) |
---|
4479 | ELSE |
---|
4480 | coagc = coagc * 3.0_wp |
---|
4481 | ENDIF |
---|
4482 | ENDIF |
---|
4483 | |
---|
4484 | END FUNCTION coagc |
---|
4485 | |
---|
4486 | !------------------------------------------------------------------------------! |
---|
4487 | ! Description: |
---|
4488 | ! ------------ |
---|
4489 | !> Calculates the change in particle volume and gas phase |
---|
4490 | !> concentrations due to nucleation, condensation and dissolutional growth. |
---|
4491 | ! |
---|
4492 | !> Sulphuric acid and organic vapour: only condensation and no evaporation. |
---|
4493 | ! |
---|
4494 | !> New gas and aerosol phase concentrations calculated according to Jacobson |
---|
4495 | !> (1997): Numerical techniques to solve condensational and dissolutional growth |
---|
4496 | !> equations when growth is coupled to reversible reactions, Aerosol Sci. Tech., |
---|
4497 | !> 27, pp 491-498. |
---|
4498 | ! |
---|
4499 | !> Following parameterization has been used: |
---|
4500 | !> Molecular diffusion coefficient of condensing vapour (m2/s) |
---|
4501 | !> (Reid et al. (1987): Properties of gases and liquids, McGraw-Hill, New York.) |
---|
4502 | !> D = {1.d-7*sqrt(1/M_air + 1/M_gas)*T^1.75} / & |
---|
4503 | ! {p_atm/p_stand * (d_air^(1/3) + d_gas^(1/3))^2 } |
---|
4504 | !> M_air = 28.965 : molar mass of air (g/mol) |
---|
4505 | !> d_air = 19.70 : diffusion volume of air |
---|
4506 | !> M_h2so4 = 98.08 : molar mass of h2so4 (g/mol) |
---|
4507 | !> d_h2so4 = 51.96 : diffusion volume of h2so4 |
---|
4508 | ! |
---|
4509 | !> Called from main aerosol model |
---|
4510 | !> For equations, see Jacobson, Fundamentals of Atmospheric Modeling, 2nd Edition (2005) |
---|
4511 | ! |
---|
4512 | !> Coded by: |
---|
4513 | !> Hannele Korhonen (FMI) 2005 |
---|
4514 | !> Harri Kokkola (FMI) 2006 |
---|
4515 | !> Juha Tonttila (FMI) 2014 |
---|
4516 | !> Rewritten to PALM by Mona Kurppa (UHel) 2017 |
---|
4517 | !------------------------------------------------------------------------------! |
---|
4518 | SUBROUTINE condensation( paero, pc_sa, pc_ocnv, pcocsv, pchno3, pc_nh3, pcw, pcs, ptemp, ppres, & |
---|
4519 | ptstep, prtcl ) |
---|
4520 | |
---|
4521 | IMPLICIT NONE |
---|
4522 | |
---|
4523 | INTEGER(iwp) :: ss !< start index |
---|
4524 | INTEGER(iwp) :: ee !< end index |
---|
4525 | |
---|
4526 | REAL(wp) :: zcs_ocnv !< condensation sink of nonvolatile organics (1/s) |
---|
4527 | REAL(wp) :: zcs_ocsv !< condensation sink of semivolatile organics (1/s) |
---|
4528 | REAL(wp) :: zcs_su !< condensation sink of sulfate (1/s) |
---|
4529 | REAL(wp) :: zcs_tot !< total condensation sink (1/s) (gases) |
---|
4530 | REAL(wp) :: zcvap_new1 !< vapour concentration after time step (#/m3): sulphuric acid |
---|
4531 | REAL(wp) :: zcvap_new2 !< nonvolatile organics |
---|
4532 | REAL(wp) :: zcvap_new3 !< semivolatile organics |
---|
4533 | REAL(wp) :: zdfvap !< air diffusion coefficient (m2/s) |
---|
4534 | REAL(wp) :: zdvap1 !< change in vapour concentration (#/m3): sulphuric acid |
---|
4535 | REAL(wp) :: zdvap2 !< nonvolatile organics |
---|
4536 | REAL(wp) :: zdvap3 !< semivolatile organics |
---|
4537 | REAL(wp) :: zmfp !< mean free path of condensing vapour (m) |
---|
4538 | REAL(wp) :: zrh !< Relative humidity [0-1] |
---|
4539 | REAL(wp) :: zvisc !< viscosity of air (kg/(m s)) |
---|
4540 | REAL(wp) :: zn_vs_c !< ratio of nucleation of all mass transfer in the smallest bin |
---|
4541 | REAL(wp) :: zxocnv !< ratio of organic vapour in 3nm particles |
---|
4542 | REAL(wp) :: zxsa !< Ratio in 3nm particles: sulphuric acid |
---|
4543 | |
---|
4544 | REAL(wp), INTENT(in) :: ppres !< ambient pressure (Pa) |
---|
4545 | REAL(wp), INTENT(in) :: pcs !< Water vapour saturation concentration (kg/m3) |
---|
4546 | REAL(wp), INTENT(in) :: ptemp !< ambient temperature (K) |
---|
4547 | REAL(wp), INTENT(in) :: ptstep !< timestep (s) |
---|
4548 | |
---|
4549 | REAL(wp), INTENT(inout) :: pchno3 !< Gas concentrations (#/m3): nitric acid HNO3 |
---|
4550 | REAL(wp), INTENT(inout) :: pc_nh3 !< ammonia NH3 |
---|
4551 | REAL(wp), INTENT(inout) :: pc_ocnv !< non-volatile organics |
---|
4552 | REAL(wp), INTENT(inout) :: pcocsv !< semi-volatile organics |
---|
4553 | REAL(wp), INTENT(inout) :: pc_sa !< sulphuric acid H2SO4 |
---|
4554 | REAL(wp), INTENT(inout) :: pcw !< Water vapor concentration (kg/m3) |
---|
4555 | |
---|
4556 | REAL(wp), DIMENSION(nbins_aerosol) :: zbeta !< transitional correction factor |
---|
4557 | REAL(wp), DIMENSION(nbins_aerosol) :: zcolrate !< collision rate (1/s) |
---|
4558 | REAL(wp), DIMENSION(nbins_aerosol) :: zcolrate_ocnv !< collision rate of OCNV (1/s) |
---|
4559 | REAL(wp), DIMENSION(start_subrange_1a+1) :: zdfpart !< particle diffusion coef. (m2/s) |
---|
4560 | REAL(wp), DIMENSION(nbins_aerosol) :: zdvoloc !< change of organics volume |
---|
4561 | REAL(wp), DIMENSION(nbins_aerosol) :: zdvolsa !< change of sulphate volume |
---|
4562 | REAL(wp), DIMENSION(2) :: zj3n3 !< Formation massrate of molecules |
---|
4563 | !< in nucleation, (molec/m3s), |
---|
4564 | !< 1: H2SO4 and 2: organic vapor |
---|
4565 | REAL(wp), DIMENSION(nbins_aerosol) :: zknud !< particle Knudsen number |
---|
4566 | |
---|
4567 | TYPE(component_index), INTENT(in) :: prtcl !< Keeps track which substances are used |
---|
4568 | |
---|
4569 | TYPE(t_section), DIMENSION(nbins_aerosol), INTENT(inout) :: paero !< Aerosol properties |
---|
4570 | |
---|
4571 | zj3n3 = 0.0_wp |
---|
4572 | zrh = pcw / pcs |
---|
4573 | zxocnv = 0.0_wp |
---|
4574 | zxsa = 0.0_wp |
---|
4575 | ! |
---|
4576 | !-- Nucleation |
---|
4577 | IF ( nsnucl > 0 ) THEN |
---|
4578 | CALL nucleation( paero, ptemp, zrh, ppres, pc_sa, pc_ocnv, pc_nh3, ptstep, zj3n3, zxsa, & |
---|
4579 | zxocnv ) |
---|
4580 | ENDIF |
---|
4581 | ! |
---|
4582 | !-- Condensation on pre-existing particles |
---|
4583 | IF ( lscndgas ) THEN |
---|
4584 | ! |
---|
4585 | !-- Initialise: |
---|
4586 | zdvolsa = 0.0_wp |
---|
4587 | zdvoloc = 0.0_wp |
---|
4588 | zcolrate = 0.0_wp |
---|
4589 | ! |
---|
4590 | !-- 1) Properties of air and condensing gases: |
---|
4591 | !-- Viscosity of air (kg/(m s)) (Eq. 4.54 in Jabonson (2005)) |
---|
4592 | zvisc = ( 7.44523E-3_wp * ptemp ** 1.5_wp ) / ( 5093.0_wp * ( ptemp + 110.4_wp ) ) |
---|
4593 | ! |
---|
4594 | !-- Diffusion coefficient of air (m2/s) |
---|
4595 | zdfvap = 5.1111E-10_wp * ptemp ** 1.75_wp * ( p_0 + 1325.0_wp ) / ppres |
---|
4596 | ! |
---|
4597 | !-- Mean free path (m): same for H2SO4 and organic compounds |
---|
4598 | zmfp = 3.0_wp * zdfvap * SQRT( pi * amh2so4 / ( 8.0_wp * argas * ptemp ) ) |
---|
4599 | ! |
---|
4600 | !-- 2) Transition regime correction factor zbeta for particles (Fuchs and Sutugin (1971)): |
---|
4601 | !-- Size of condensing molecule considered only for nucleation mode (3 - 20 nm). |
---|
4602 | ! |
---|
4603 | !-- Particle Knudsen number: condensation of gases on aerosols |
---|
4604 | ss = start_subrange_1a |
---|
4605 | ee = start_subrange_1a+1 |
---|
4606 | zknud(ss:ee) = 2.0_wp * zmfp / ( paero(ss:ee)%dwet + d_sa ) |
---|
4607 | ss = start_subrange_1a+2 |
---|
4608 | ee = end_subrange_2b |
---|
4609 | zknud(ss:ee) = 2.0_wp * zmfp / paero(ss:ee)%dwet |
---|
4610 | ! |
---|
4611 | !-- Transitional correction factor: aerosol + gas (the semi-empirical Fuchs- Sutugin |
---|
4612 | !-- interpolation function (Fuchs and Sutugin, 1971)) |
---|
4613 | zbeta = ( zknud + 1.0_wp ) / ( 0.377_wp * zknud + 1.0_wp + 4.0_wp / ( 3.0_wp * massacc ) * & |
---|
4614 | ( zknud + zknud ** 2 ) ) |
---|
4615 | ! |
---|
4616 | !-- 3) Collision rate of molecules to particles |
---|
4617 | !-- Particle diffusion coefficient considered only for nucleation mode (3 - 20 nm) |
---|
4618 | ! |
---|
4619 | !-- Particle diffusion coefficient (m2/s) (e.g. Eq. 15.29 in Jacobson (2005)) |
---|
4620 | zdfpart = abo * ptemp * zbeta(start_subrange_1a:start_subrange_1a+1) / ( 3.0_wp * pi * zvisc& |
---|
4621 | * paero(start_subrange_1a:start_subrange_1a+1)%dwet) |
---|
4622 | ! |
---|
4623 | !-- Collision rate (mass-transfer coefficient): gases on aerosols (1/s) (Eq. 16.64 in |
---|
4624 | !-- Jacobson (2005)) |
---|
4625 | ss = start_subrange_1a |
---|
4626 | ee = start_subrange_1a+1 |
---|
4627 | zcolrate(ss:ee) = MERGE( 2.0_wp * pi * ( paero(ss:ee)%dwet + d_sa ) * ( zdfvap + zdfpart ) *& |
---|
4628 | zbeta(ss:ee) * paero(ss:ee)%numc, 0.0_wp, paero(ss:ee)%numc > nclim ) |
---|
4629 | ss = start_subrange_1a+2 |
---|
4630 | ee = end_subrange_2b |
---|
4631 | zcolrate(ss:ee) = MERGE( 2.0_wp * pi * paero(ss:ee)%dwet * zdfvap * zbeta(ss:ee) * & |
---|
4632 | paero(ss:ee)%numc, 0.0_wp, paero(ss:ee)%numc > nclim ) |
---|
4633 | ! |
---|
4634 | !-- 4) Condensation sink (1/s) |
---|
4635 | zcs_tot = SUM( zcolrate ) ! total sink |
---|
4636 | ! |
---|
4637 | !-- 5) Changes in gas-phase concentrations and particle volume |
---|
4638 | ! |
---|
4639 | !-- 5.1) Organic vapours |
---|
4640 | ! |
---|
4641 | !-- 5.1.1) Non-volatile organic compound: condenses onto all bins |
---|
4642 | IF ( pc_ocnv > 1.0E+10_wp .AND. zcs_tot > 1.0E-30_wp .AND. index_oc > 0 ) & |
---|
4643 | THEN |
---|
4644 | !-- Ratio of nucleation vs. condensation rates in the smallest bin |
---|
4645 | zn_vs_c = 0.0_wp |
---|
4646 | IF ( zj3n3(2) > 1.0_wp ) THEN |
---|
4647 | zn_vs_c = ( zj3n3(2) ) / ( zj3n3(2) + pc_ocnv * zcolrate(start_subrange_1a) ) |
---|
4648 | ENDIF |
---|
4649 | ! |
---|
4650 | !-- Collision rate in the smallest bin, including nucleation and condensation (see |
---|
4651 | !-- Jacobson (2005), eq. (16.73) ) |
---|
4652 | zcolrate_ocnv = zcolrate |
---|
4653 | zcolrate_ocnv(start_subrange_1a) = zcolrate_ocnv(start_subrange_1a) + zj3n3(2) / pc_ocnv |
---|
4654 | ! |
---|
4655 | !-- Total sink for organic vapor |
---|
4656 | zcs_ocnv = zcs_tot + zj3n3(2) / pc_ocnv |
---|
4657 | ! |
---|
4658 | !-- New gas phase concentration (#/m3) |
---|
4659 | zcvap_new2 = pc_ocnv / ( 1.0_wp + ptstep * zcs_ocnv ) |
---|
4660 | ! |
---|
4661 | !-- Change in gas concentration (#/m3) |
---|
4662 | zdvap2 = pc_ocnv - zcvap_new2 |
---|
4663 | ! |
---|
4664 | !-- Updated vapour concentration (#/m3) |
---|
4665 | pc_ocnv = zcvap_new2 |
---|
4666 | ! |
---|
4667 | !-- Volume change of particles (m3(OC)/m3(air)) |
---|
4668 | zdvoloc = zcolrate_ocnv(start_subrange_1a:end_subrange_2b) / zcs_ocnv * amvoc * zdvap2 |
---|
4669 | ! |
---|
4670 | !-- Change of volume due to condensation in 1a-2b |
---|
4671 | paero(start_subrange_1a:end_subrange_2b)%volc(2) = & |
---|
4672 | paero(start_subrange_1a:end_subrange_2b)%volc(2) + zdvoloc |
---|
4673 | ! |
---|
4674 | !-- Change of number concentration in the smallest bin caused by nucleation (Jacobson (2005), |
---|
4675 | !-- eq. (16.75)). If zxocnv = 0, then the chosen nucleation mechanism doesn't take into |
---|
4676 | !-- account the non-volatile organic vapors and thus the paero doesn't have to be updated. |
---|
4677 | IF ( zxocnv > 0.0_wp ) THEN |
---|
4678 | paero(start_subrange_1a)%numc = paero(start_subrange_1a)%numc + zn_vs_c * & |
---|
4679 | zdvoloc(start_subrange_1a) / amvoc / ( n3 * zxocnv ) |
---|
4680 | ENDIF |
---|
4681 | ENDIF |
---|
4682 | ! |
---|
4683 | !-- 5.1.2) Semivolatile organic compound: all bins except subrange 1 |
---|
4684 | zcs_ocsv = SUM( zcolrate(start_subrange_2a:end_subrange_2b) ) !< sink for semi-volatile org. |
---|
4685 | IF ( pcocsv > 1.0E+10_wp .AND. zcs_ocsv > 1.0E-30 .AND. is_used( prtcl,'OC') ) THEN |
---|
4686 | ! |
---|
4687 | !-- New gas phase concentration (#/m3) |
---|
4688 | zcvap_new3 = pcocsv / ( 1.0_wp + ptstep * zcs_ocsv ) |
---|
4689 | ! |
---|
4690 | !-- Change in gas concentration (#/m3) |
---|
4691 | zdvap3 = pcocsv - zcvap_new3 |
---|
4692 | ! |
---|
4693 | !-- Updated gas concentration (#/m3) |
---|
4694 | pcocsv = zcvap_new3 |
---|
4695 | ! |
---|
4696 | !-- Volume change of particles (m3(OC)/m3(air)) |
---|
4697 | ss = start_subrange_2a |
---|
4698 | ee = end_subrange_2b |
---|
4699 | zdvoloc(ss:ee) = zdvoloc(ss:ee) + zcolrate(ss:ee) / zcs_ocsv * amvoc * zdvap3 |
---|
4700 | ! |
---|
4701 | !-- Change of volume due to condensation in 1a-2b |
---|
4702 | paero(start_subrange_1a:end_subrange_2b)%volc(2) = & |
---|
4703 | paero(start_subrange_1a:end_subrange_2b)%volc(2) + zdvoloc |
---|
4704 | ENDIF |
---|
4705 | ! |
---|
4706 | !-- 5.2) Sulphate: condensed on all bins |
---|
4707 | IF ( pc_sa > 1.0E+10_wp .AND. zcs_tot > 1.0E-30_wp .AND. index_so4 > 0 ) THEN |
---|
4708 | ! |
---|
4709 | !-- Ratio of mass transfer between nucleation and condensation |
---|
4710 | zn_vs_c = 0.0_wp |
---|
4711 | IF ( zj3n3(1) > 1.0_wp ) THEN |
---|
4712 | zn_vs_c = ( zj3n3(1) ) / ( zj3n3(1) + pc_sa * zcolrate(start_subrange_1a) ) |
---|
4713 | ENDIF |
---|
4714 | ! |
---|
4715 | !-- Collision rate in the smallest bin, including nucleation and condensation (see |
---|
4716 | !-- Jacobson (2005), eq. (16.73)) |
---|
4717 | zcolrate(start_subrange_1a) = zcolrate(start_subrange_1a) + zj3n3(1) / pc_sa |
---|
4718 | ! |
---|
4719 | !-- Total sink for sulfate (1/s) |
---|
4720 | zcs_su = zcs_tot + zj3n3(1) / pc_sa |
---|
4721 | ! |
---|
4722 | !-- Sulphuric acid: |
---|
4723 | !-- New gas phase concentration (#/m3) |
---|
4724 | zcvap_new1 = pc_sa / ( 1.0_wp + ptstep * zcs_su ) |
---|
4725 | ! |
---|
4726 | !-- Change in gas concentration (#/m3) |
---|
4727 | zdvap1 = pc_sa - zcvap_new1 |
---|
4728 | ! |
---|
4729 | !-- Updating vapour concentration (#/m3) |
---|
4730 | pc_sa = zcvap_new1 |
---|
4731 | ! |
---|
4732 | !-- Volume change of particles (m3(SO4)/m3(air)) by condensation |
---|
4733 | zdvolsa = zcolrate(start_subrange_1a:end_subrange_2b) / zcs_su * amvh2so4 * zdvap1 |
---|
4734 | ! |
---|
4735 | !-- Change of volume concentration of sulphate in aerosol [fxm] |
---|
4736 | paero(start_subrange_1a:end_subrange_2b)%volc(1) = & |
---|
4737 | paero(start_subrange_1a:end_subrange_2b)%volc(1) + zdvolsa |
---|
4738 | ! |
---|
4739 | !-- Change of number concentration in the smallest bin caused by nucleation |
---|
4740 | !-- (Jacobson (2005), equation (16.75)) |
---|
4741 | IF ( zxsa > 0.0_wp ) THEN |
---|
4742 | paero(start_subrange_1a)%numc = paero(start_subrange_1a)%numc + zn_vs_c * & |
---|
4743 | zdvolsa(start_subrange_1a) / amvh2so4 / ( n3 * zxsa) |
---|
4744 | ENDIF |
---|
4745 | ENDIF |
---|
4746 | ! |
---|
4747 | !-- Partitioning of H2O, HNO3, and NH3: Dissolutional growth |
---|
4748 | IF ( lspartition .AND. ( pchno3 > 1.0E+10_wp .OR. pc_nh3 > 1.0E+10_wp ) ) THEN |
---|
4749 | CALL gpparthno3( ppres, ptemp, paero, pchno3, pc_nh3, pcw, pcs, zbeta, ptstep ) |
---|
4750 | ENDIF |
---|
4751 | ENDIF |
---|
4752 | ! |
---|
4753 | !-- Condensation of water vapour |
---|
4754 | IF ( lscndh2oae ) THEN |
---|
4755 | CALL gpparth2o( paero, ptemp, ppres, pcs, pcw, ptstep ) |
---|
4756 | ENDIF |
---|
4757 | |
---|
4758 | END SUBROUTINE condensation |
---|
4759 | |
---|
4760 | !------------------------------------------------------------------------------! |
---|
4761 | ! Description: |
---|
4762 | ! ------------ |
---|
4763 | !> Calculates the particle number and volume increase, and gas-phase |
---|
4764 | !> concentration decrease due to nucleation subsequent growth to detectable size |
---|
4765 | !> of 3 nm. |
---|
4766 | ! |
---|
4767 | !> Method: |
---|
4768 | !> When the formed clusters grow by condensation (possibly also by self- |
---|
4769 | !> coagulation), their number is reduced due to scavenging to pre-existing |
---|
4770 | !> particles. Thus, the apparent nucleation rate at 3 nm is significantly lower |
---|
4771 | !> than the real nucleation rate (at ~1 nm). |
---|
4772 | ! |
---|
4773 | !> Calculation of the formation rate of detectable particles at 3 nm (i.e. J3): |
---|
4774 | !> nj3 = 1: Kerminen, V.-M. and Kulmala, M. (2002), J. Aerosol Sci.,33, 609-622. |
---|
4775 | !> nj3 = 2: Lehtinen et al. (2007), J. Aerosol Sci., 38(9), 988-994. |
---|
4776 | !> nj3 = 3: Anttila et al. (2010), J. Aerosol Sci., 41(7), 621-636. |
---|
4777 | ! |
---|
4778 | !> c = aerosol of critical radius (1 nm) |
---|
4779 | !> x = aerosol with radius 3 nm |
---|
4780 | !> 2 = wet or mean droplet |
---|
4781 | ! |
---|
4782 | !> Called from subroutine condensation (in module salsa_dynamics_mod.f90) |
---|
4783 | ! |
---|
4784 | !> Calls one of the following subroutines: |
---|
4785 | !> - binnucl |
---|
4786 | !> - ternucl |
---|
4787 | !> - kinnucl |
---|
4788 | !> - actnucl |
---|
4789 | ! |
---|
4790 | !> fxm: currently only sulphuric acid grows particles from 1 to 3 nm |
---|
4791 | !> (if asked from Markku, this is terribly wrong!!!) |
---|
4792 | ! |
---|
4793 | !> Coded by: |
---|
4794 | !> Hannele Korhonen (FMI) 2005 |
---|
4795 | !> Harri Kokkola (FMI) 2006 |
---|
4796 | !> Matti Niskanen(FMI) 2012 |
---|
4797 | !> Anton Laakso (FMI) 2013 |
---|
4798 | !------------------------------------------------------------------------------! |
---|
4799 | |
---|
4800 | SUBROUTINE nucleation( paero, ptemp, prh, ppres, pc_sa, pc_ocnv, pc_nh3, ptstep, pj3n3, pxsa, & |
---|
4801 | pxocnv ) |
---|
4802 | |
---|
4803 | IMPLICIT NONE |
---|
4804 | |
---|
4805 | INTEGER(iwp) :: iteration |
---|
4806 | |
---|
4807 | REAL(wp) :: zc_h2so4 !< H2SO4 conc. (#/cm3) !UNITS! |
---|
4808 | REAL(wp) :: zc_org !< organic vapour conc. (#/cm3) |
---|
4809 | REAL(wp) :: zcc_c !< Cunningham correct factor for c = critical (1nm) |
---|
4810 | REAL(wp) :: zcc_x !< Cunningham correct factor for x = 3nm |
---|
4811 | REAL(wp) :: zcoags_c !< coagulation sink (1/s) for c = critical (1nm) |
---|
4812 | REAL(wp) :: zcoags_x !< coagulation sink (1/s) for x = 3nm |
---|
4813 | REAL(wp) :: zcoagstot !< total particle losses due to coagulation, including condensation |
---|
4814 | !< and self-coagulation |
---|
4815 | REAL(wp) :: zcocnv_local !< organic vapour conc. (#/m3) |
---|
4816 | REAL(wp) :: zcsink !< condensational sink (#/m2) |
---|
4817 | REAL(wp) :: zcsa_local !< H2SO4 conc. (#/m3) |
---|
4818 | REAL(wp) :: zcv_c !< mean relative thermal velocity (m/s) for c = critical (1nm) |
---|
4819 | REAL(wp) :: zcv_x !< mean relative thermal velocity (m/s) for x = 3nm |
---|
4820 | REAL(wp) :: zdcrit !< diameter of critical cluster (m) |
---|
4821 | REAL(wp) :: zdelta_vap !< change of H2SO4 and organic vapour concentration (#/m3) |
---|
4822 | REAL(wp) :: zdfvap !< air diffusion coefficient (m2/s) |
---|
4823 | REAL(wp) :: zdmean !< mean diameter of existing particles (m) |
---|
4824 | REAL(wp) :: zeta !< constant: proportional to ratio of CS/GR (m) |
---|
4825 | !< (condensation sink / growth rate) |
---|
4826 | REAL(wp) :: zgamma !< proportionality factor ((nm2*m2)/h) |
---|
4827 | REAL(wp) :: z_gr_clust !< growth rate of formed clusters (nm/h) |
---|
4828 | REAL(wp) :: z_gr_tot !< total growth rate |
---|
4829 | REAL(wp) :: zj3 !< number conc. of formed 3nm particles (#/m3) |
---|
4830 | REAL(wp) :: zjnuc !< nucleation rate at ~1nm (#/m3s) |
---|
4831 | REAL(wp) :: z_k_eff !< effective cogulation coefficient for freshly nucleated particles |
---|
4832 | REAL(wp) :: zknud_c !< Knudsen number for c = critical (1nm) |
---|
4833 | REAL(wp) :: zknud_x !< Knudsen number for x = 3nm |
---|
4834 | REAL(wp) :: zkocnv !< lever: zkocnv=1 --> organic compounds involved in nucleation |
---|
4835 | REAL(wp) :: zksa !< lever: zksa=1 --> H2SO4 involved in nucleation |
---|
4836 | REAL(wp) :: zlambda !< parameter for adjusting the growth rate due to self-coagulation |
---|
4837 | REAL(wp) :: zm_c !< particle mass (kg) for c = critical (1nm) |
---|
4838 | REAL(wp) :: zm_para !< Parameter m for calculating the coagulation sink (Eq. 5&6 in |
---|
4839 | !< Lehtinen et al. 2007) |
---|
4840 | REAL(wp) :: zm_x !< particle mass (kg) for x = 3nm |
---|
4841 | REAL(wp) :: zmfp !< mean free path of condesing vapour(m) |
---|
4842 | REAL(wp) :: zmixnh3 !< ammonia mixing ratio (ppt) |
---|
4843 | REAL(wp) :: zmyy !< gas dynamic viscosity (N*s/m2) |
---|
4844 | REAL(wp) :: z_n_nuc !< number of clusters/particles at the size range d1-dx (#/m3) |
---|
4845 | REAL(wp) :: znoc !< number of organic molecules in critical cluster |
---|
4846 | REAL(wp) :: znsa !< number of H2SO4 molecules in critical cluster |
---|
4847 | |
---|
4848 | REAL(wp), INTENT(in) :: pc_nh3 !< ammonia concentration (#/m3) |
---|
4849 | REAL(wp), INTENT(in) :: pc_ocnv !< conc. of non-volatile OC (#/m3) |
---|
4850 | REAL(wp), INTENT(in) :: pc_sa !< sulphuric acid conc. (#/m3) |
---|
4851 | REAL(wp), INTENT(in) :: ppres !< ambient air pressure (Pa) |
---|
4852 | REAL(wp), INTENT(in) :: prh !< ambient rel. humidity [0-1] |
---|
4853 | REAL(wp), INTENT(in) :: ptemp !< ambient temperature (K) |
---|
4854 | REAL(wp), INTENT(in) :: ptstep !< time step (s) of SALSA |
---|
4855 | |
---|
4856 | REAL(wp), INTENT(inout) :: pj3n3(2) !< formation mass rate of molecules (molec/m3s) for |
---|
4857 | !< 1: H2SO4 and 2: organic vapour |
---|
4858 | |
---|
4859 | REAL(wp), INTENT(out) :: pxocnv !< ratio of non-volatile organic vapours in 3 nm particles |
---|
4860 | REAL(wp), INTENT(out) :: pxsa !< ratio of H2SO4 in 3 nm aerosol particles |
---|
4861 | |
---|
4862 | REAL(wp), DIMENSION(nbins_aerosol) :: zbeta !< transitional correction factor |
---|
4863 | REAL(wp), DIMENSION(nbins_aerosol) :: zcc_2 !< Cunningham correct factor:2 |
---|
4864 | REAL(wp), DIMENSION(nbins_aerosol) :: zcv_2 !< mean relative thermal velocity (m/s): 2 |
---|
4865 | REAL(wp), DIMENSION(nbins_aerosol) :: zcv_c2 !< average velocity after coagulation: c & 2 |
---|
4866 | REAL(wp), DIMENSION(nbins_aerosol) :: zcv_x2 !< average velocity after coagulation: x & 2 |
---|
4867 | REAL(wp), DIMENSION(nbins_aerosol) :: zdc_2 !< particle diffusion coefficient (m2/s): 2 |
---|
4868 | REAL(wp), DIMENSION(nbins_aerosol) :: zdc_c !< particle diffusion coefficient (m2/s): c |
---|
4869 | REAL(wp), DIMENSION(nbins_aerosol) :: zdc_c2 !< sum of diffusion coef. for c and 2 |
---|
4870 | REAL(wp), DIMENSION(nbins_aerosol) :: zdc_x !< particle diffusion coefficient (m2/s): x |
---|
4871 | REAL(wp), DIMENSION(nbins_aerosol) :: zdc_x2 !< sum of diffusion coef. for: x & 2 |
---|
4872 | REAL(wp), DIMENSION(nbins_aerosol) :: zgamma_f_2 !< zgamma_f for calculating zomega |
---|
4873 | REAL(wp), DIMENSION(nbins_aerosol) :: zgamma_f_c !< zgamma_f for calculating zomega |
---|
4874 | REAL(wp), DIMENSION(nbins_aerosol) :: zgamma_f_x !< zgamma_f for calculating zomega |
---|
4875 | REAL(wp), DIMENSION(nbins_aerosol) :: z_k_c2 !< coagulation coef. in the continuum |
---|
4876 | !< regime: c & 2 |
---|
4877 | REAL(wp), DIMENSION(nbins_aerosol) :: z_k_x2 !< coagulation coef. in the continuum |
---|
4878 | !< regime: x & 2 |
---|
4879 | REAL(wp), DIMENSION(nbins_aerosol) :: zknud !< particle Knudsen number |
---|
4880 | REAL(wp), DIMENSION(nbins_aerosol) :: zknud_2 !< particle Knudsen number: 2 |
---|
4881 | REAL(wp), DIMENSION(nbins_aerosol) :: zm_2 !< particle mass (kg): 2 |
---|
4882 | REAL(wp), DIMENSION(nbins_aerosol) :: zomega_2c !< zomega (m) for calculating zsigma: c & 2 |
---|
4883 | REAL(wp), DIMENSION(nbins_aerosol) :: zomega_2x !< zomega (m) for calculating zsigma: x & 2 |
---|
4884 | REAL(wp), DIMENSION(nbins_aerosol) :: zomega_c !< zomega (m) for calculating zsigma: c |
---|
4885 | REAL(wp), DIMENSION(nbins_aerosol) :: zomega_x !< zomega (m) for calculating zsigma: x |
---|
4886 | REAL(wp), DIMENSION(nbins_aerosol) :: z_r_c2 !< sum of the radii: c & 2 |
---|
4887 | REAL(wp), DIMENSION(nbins_aerosol) :: z_r_x2 !< sum of the radii: x & 2 |
---|
4888 | REAL(wp), DIMENSION(nbins_aerosol) :: zsigma_c2 !< |
---|
4889 | REAL(wp), DIMENSION(nbins_aerosol) :: zsigma_x2 !< |
---|
4890 | |
---|
4891 | TYPE(t_section), DIMENSION(nbins_aerosol), INTENT(inout) :: paero !< aerosol properties |
---|
4892 | ! |
---|
4893 | !-- 1) Nucleation rate (zjnuc) and diameter of critical cluster (zdcrit) |
---|
4894 | zjnuc = 0.0_wp |
---|
4895 | znsa = 0.0_wp |
---|
4896 | znoc = 0.0_wp |
---|
4897 | zdcrit = 0.0_wp |
---|
4898 | zksa = 0.0_wp |
---|
4899 | zkocnv = 0.0_wp |
---|
4900 | |
---|
4901 | zc_h2so4 = pc_sa * 1.0E-6_wp ! sulphuric acid conc. to #/cm3 |
---|
4902 | zc_org = pc_ocnv * 1.0E-6_wp ! conc. of non-volatile OC to #/cm3 |
---|
4903 | zmixnh3 = pc_nh3 * ptemp * argas / ( ppres * avo ) |
---|
4904 | |
---|
4905 | SELECT CASE ( nsnucl ) |
---|
4906 | ! |
---|
4907 | !-- Binary H2SO4-H2O nucleation |
---|
4908 | CASE(1) |
---|
4909 | |
---|
4910 | CALL binnucl( zc_h2so4, ptemp, prh, zjnuc, znsa, znoc, zdcrit, zksa, zkocnv ) |
---|
4911 | ! |
---|
4912 | !-- Activation type nucleation (See Riipinen et al. (2007), Atmos. Chem. Phys., 7(8), 1899-1914) |
---|
4913 | CASE(2) |
---|
4914 | ! |
---|
4915 | !-- Nucleation rate (#/(m3 s)) |
---|
4916 | zc_h2so4 = MAX( zc_h2so4, 1.0E4_wp ) |
---|
4917 | zc_h2so4 = MIN( zc_h2so4, 1.0E11_wp ) |
---|
4918 | zjnuc = act_coeff * pc_sa ! (#/(m3 s)) |
---|
4919 | ! |
---|
4920 | !-- Organic compounds not involved when kinetic nucleation is assumed. |
---|
4921 | zdcrit = 7.9375E-10_wp ! (m) |
---|
4922 | zkocnv = 0.0_wp |
---|
4923 | zksa = 1.0_wp |
---|
4924 | znoc = 0.0_wp |
---|
4925 | znsa = 2.0_wp |
---|
4926 | ! |
---|
4927 | !-- Kinetically limited nucleation of (NH4)HSO4 clusters |
---|
4928 | !-- (See Sihto et al. (2006), Atmos. Chem. Phys., 6(12), 4079-4091.) |
---|
4929 | CASE(3) |
---|
4930 | ! |
---|
4931 | !-- Nucleation rate = coagcoeff*zpcsa**2 (#/(m3 s)) |
---|
4932 | zc_h2so4 = MAX( zc_h2so4, 1.0E4_wp ) |
---|
4933 | zc_h2so4 = MIN( zc_h2so4, 1.0E11_wp ) |
---|
4934 | zjnuc = 5.0E-13_wp * zc_h2so4**2.0_wp * 1.0E+6_wp |
---|
4935 | ! |
---|
4936 | !-- Organic compounds not involved when kinetic nucleation is assumed. |
---|
4937 | zdcrit = 7.9375E-10_wp ! (m) |
---|
4938 | zkocnv = 0.0_wp |
---|
4939 | zksa = 1.0_wp |
---|
4940 | znoc = 0.0_wp |
---|
4941 | znsa = 2.0_wp |
---|
4942 | ! |
---|
4943 | !-- Ternary H2SO4-H2O-NH3 nucleation |
---|
4944 | CASE(4) |
---|
4945 | |
---|
4946 | CALL ternucl( zc_h2so4, zmixnh3, ptemp, prh, zjnuc, znsa, znoc, zdcrit, zksa, zkocnv ) |
---|
4947 | ! |
---|
4948 | !-- Organic nucleation, J~[ORG] or J~[ORG]**2 |
---|
4949 | !-- (See Paasonen et al. (2010), Atmos. Chem. Phys., 10, 11223-11242.) |
---|
4950 | CASE(5) |
---|
4951 | ! |
---|
4952 | !-- Homomolecular nuleation rate |
---|
4953 | zjnuc = 1.3E-7_wp * pc_ocnv ! (1/s) (Paasonen et al. Table 4: median a_org) |
---|
4954 | ! |
---|
4955 | !-- H2SO4 not involved when pure organic nucleation is assumed. |
---|
4956 | zdcrit = 1.5E-9 ! (m) |
---|
4957 | zkocnv = 1.0_wp |
---|
4958 | zksa = 0.0_wp |
---|
4959 | znoc = 1.0_wp |
---|
4960 | znsa = 0.0_wp |
---|
4961 | ! |
---|
4962 | !-- Sum of H2SO4 and organic activation type nucleation, J~[H2SO4]+[ORG] |
---|
4963 | !-- (See Paasonen et al. (2010), Atmos. Chem. Phys., 10, 11223-11242) |
---|
4964 | CASE(6) |
---|
4965 | ! |
---|
4966 | !-- Nucleation rate (#/m3/s) |
---|
4967 | zjnuc = 6.1E-7_wp * pc_sa + 0.39E-7_wp * pc_ocnv ! (Paasonen et al. Table 3.) |
---|
4968 | ! |
---|
4969 | !-- Both organic compounds and H2SO4 are involved when sumnucleation is assumed. |
---|
4970 | zdcrit = 1.5E-9_wp ! (m) |
---|
4971 | zkocnv = 1.0_wp |
---|
4972 | zksa = 1.0_wp |
---|
4973 | znoc = 1.0_wp |
---|
4974 | znsa = 1.0_wp |
---|
4975 | ! |
---|
4976 | !-- Heteromolecular nucleation, J~[H2SO4]*[ORG] |
---|
4977 | !-- (See Paasonen et al. (2010), Atmos. Chem. Phys., 10, 11223-11242.) |
---|
4978 | CASE(7) |
---|
4979 | ! |
---|
4980 | !-- Nucleation rate (#/m3/s) |
---|
4981 | zjnuc = 4.1E-14_wp * pc_sa * pc_ocnv * 1.0E6_wp ! (Paasonen et al. Table 4: median) |
---|
4982 | ! |
---|
4983 | !-- Both organic compounds and H2SO4 are involved when heteromolecular nucleation is assumed |
---|
4984 | zdcrit = 1.5E-9_wp ! (m) |
---|
4985 | zkocnv = 1.0_wp |
---|
4986 | zksa = 1.0_wp |
---|
4987 | znoc = 1.0_wp |
---|
4988 | znsa = 1.0_wp |
---|
4989 | ! |
---|
4990 | !-- Homomolecular nucleation of H2SO4 and heteromolecular nucleation of H2SO4 and organic vapour, |
---|
4991 | !-- J~[H2SO4]**2 + [H2SO4]*[ORG] (EUCAARI project) |
---|
4992 | !-- (See Paasonen et al. (2010), Atmos. Chem. Phys., 10, 11223-11242) |
---|
4993 | CASE(8) |
---|
4994 | ! |
---|
4995 | !-- Nucleation rate (#/m3/s) |
---|
4996 | zjnuc = ( 1.1E-14_wp * zc_h2so4**2 + 3.2E-14_wp * zc_h2so4 * zc_org ) * 1.0E+6_wp |
---|
4997 | ! |
---|
4998 | !-- Both organic compounds and H2SO4 are involved when SAnucleation is assumed |
---|
4999 | zdcrit = 1.5E-9_wp ! (m) |
---|
5000 | zkocnv = 1.0_wp |
---|
5001 | zksa = 1.0_wp |
---|
5002 | znoc = 1.0_wp |
---|
5003 | znsa = 3.0_wp |
---|
5004 | ! |
---|
5005 | !-- Homomolecular nucleation of H2SO4 and organic vapour and heteromolecular nucleation of H2SO4 |
---|
5006 | !-- and organic vapour, J~[H2SO4]**2 + [H2SO4]*[ORG]+[ORG]**2 (EUCAARI project) |
---|
5007 | CASE(9) |
---|
5008 | ! |
---|
5009 | !-- Nucleation rate (#/m3/s) |
---|
5010 | zjnuc = ( 1.4E-14_wp * zc_h2so4**2 + 2.6E-14_wp * zc_h2so4 * zc_org + 0.037E-14_wp * & |
---|
5011 | zc_org**2 ) * 1.0E+6_wp |
---|
5012 | ! |
---|
5013 | !-- Both organic compounds and H2SO4 are involved when SAORGnucleation is assumed |
---|
5014 | zdcrit = 1.5E-9_wp ! (m) |
---|
5015 | zkocnv = 1.0_wp |
---|
5016 | zksa = 1.0_wp |
---|
5017 | znoc = 3.0_wp |
---|
5018 | znsa = 3.0_wp |
---|
5019 | |
---|
5020 | END SELECT |
---|
5021 | |
---|
5022 | zcsa_local = pc_sa |
---|
5023 | zcocnv_local = pc_ocnv |
---|
5024 | ! |
---|
5025 | !-- 2) Change of particle and gas concentrations due to nucleation |
---|
5026 | ! |
---|
5027 | !-- 2.1) Check that there is enough H2SO4 and organic vapour to produce the nucleation |
---|
5028 | IF ( nsnucl <= 4 ) THEN |
---|
5029 | ! |
---|
5030 | !-- If the chosen nucleation scheme is 1-4, nucleation occurs only due to H2SO4. All of the total |
---|
5031 | !-- vapour concentration that is taking part to the nucleation is there for sulphuric acid |
---|
5032 | !-- (sa = H2SO4) and non-volatile organic vapour is zero. |
---|
5033 | pxsa = 1.0_wp ! ratio of sulphuric acid in 3nm particles |
---|
5034 | pxocnv = 0.0_wp ! ratio of non-volatile origanic vapour |
---|
5035 | ! in 3nm particles |
---|
5036 | ELSEIF ( nsnucl > 4 ) THEN |
---|
5037 | ! |
---|
5038 | !-- If the chosen nucleation scheme is 5-9, nucleation occurs due to organic vapour or the |
---|
5039 | !-- combination of organic vapour and H2SO4. The number of needed molecules depends on the chosen |
---|
5040 | !-- nucleation type and it has an effect also on the minimum ratio of the molecules present. |
---|
5041 | IF ( pc_sa * znsa + pc_ocnv * znoc < 1.E-14_wp ) THEN |
---|
5042 | pxsa = 0.0_wp |
---|
5043 | pxocnv = 0.0_wp |
---|
5044 | ELSE |
---|
5045 | pxsa = pc_sa * znsa / ( pc_sa * znsa + pc_ocnv * znoc ) |
---|
5046 | pxocnv = pc_ocnv * znoc / ( pc_sa * znsa + pc_ocnv * znoc ) |
---|
5047 | ENDIF |
---|
5048 | ENDIF |
---|
5049 | ! |
---|
5050 | !-- The change in total vapour concentration is the sum of the concentrations of the vapours taking |
---|
5051 | !-- part to the nucleation (depends on the chosen nucleation scheme) |
---|
5052 | zdelta_vap = MIN( zjnuc * ( znoc + znsa ), ( pc_ocnv * zkocnv + pc_sa * zksa ) / ptstep ) |
---|
5053 | ! |
---|
5054 | !-- Nucleation rate J at ~1nm (#/m3s) |
---|
5055 | zjnuc = zdelta_vap / ( znoc + znsa ) |
---|
5056 | ! |
---|
5057 | !-- H2SO4 concentration after nucleation (#/m3) |
---|
5058 | zcsa_local = MAX( 1.0_wp, pc_sa - zdelta_vap * pxsa ) |
---|
5059 | ! |
---|
5060 | !-- Non-volative organic vapour concentration after nucleation (#/m3) |
---|
5061 | zcocnv_local = MAX( 1.0_wp, pc_ocnv - zdelta_vap * pxocnv ) |
---|
5062 | ! |
---|
5063 | !-- 2.2) Formation rate of 3 nm particles (Kerminen & Kulmala, 2002) |
---|
5064 | ! |
---|
5065 | !-- Growth rate by H2SO4 and organic vapour (nm/h, Eq. 21) |
---|
5066 | z_gr_clust = 2.3623E-15_wp * SQRT( ptemp ) * ( zcsa_local + zcocnv_local ) |
---|
5067 | ! |
---|
5068 | !-- 2.2.2) Condensational sink of pre-existing particle population |
---|
5069 | ! |
---|
5070 | !-- Diffusion coefficient (m2/s) |
---|
5071 | zdfvap = 5.1111E-10_wp * ptemp**1.75_wp * ( p_0 + 1325.0_wp ) / ppres |
---|
5072 | ! |
---|
5073 | !-- Mean free path of condensing vapour (m) (Jacobson (2005), Eq. 15.25 and 16.29) |
---|
5074 | zmfp = 3.0_wp * zdfvap * SQRT( pi * amh2so4 / ( 8.0_wp * argas * ptemp ) ) |
---|
5075 | ! |
---|
5076 | !-- Knudsen number |
---|
5077 | zknud = 2.0_wp * zmfp / ( paero(:)%dwet + d_sa ) |
---|
5078 | ! |
---|
5079 | !-- Transitional regime correction factor (zbeta) according to Fuchs and Sutugin (1971) (Eq. 4 in |
---|
5080 | !-- Kerminen and Kulmala, 2002) |
---|
5081 | zbeta = ( zknud + 1.0_wp) / ( 0.377_wp * zknud + 1.0_wp + 4.0_wp / ( 3.0_wp * massacc ) * & |
---|
5082 | ( zknud + zknud**2 ) ) |
---|
5083 | ! |
---|
5084 | !-- Condensational sink (#/m2, Eq. 3) |
---|
5085 | zcsink = SUM( paero(:)%dwet * zbeta * paero(:)%numc ) |
---|
5086 | ! |
---|
5087 | !-- 2.2.3) Parameterised formation rate of detectable 3 nm particles (i.e. J3) |
---|
5088 | IF ( nj3 == 1 ) THEN ! Kerminen and Kulmala (2002) |
---|
5089 | ! |
---|
5090 | !-- Constants needed for the parameterisation: dapp = 3 nm and dens_nuc = 1830 kg/m3 |
---|
5091 | IF ( zcsink < 1.0E-30_wp ) THEN |
---|
5092 | zeta = 0._dp |
---|
5093 | ELSE |
---|
5094 | ! |
---|
5095 | !-- Mean diameter of backgroud population (nm) |
---|
5096 | zdmean = 1.0_wp / SUM( paero(:)%numc ) * SUM( paero(:)%numc * paero(:)%dwet ) * 1.0E+9_wp |
---|
5097 | ! |
---|
5098 | !-- Proportionality factor (nm2*m2/h) (Eq. 22) |
---|
5099 | zgamma = 0.23_wp * ( zdcrit * 1.0E+9_wp )**0.2_wp * ( zdmean / 150.0_wp )**0.048_wp * & |
---|
5100 | ( ptemp / 293.0_wp )**( -0.75_wp ) * ( arhoh2so4 / 1000.0_wp )**( -0.33_wp ) |
---|
5101 | ! |
---|
5102 | !-- Factor eta (nm, Eq. 11) |
---|
5103 | zeta = MIN( zgamma * zcsink / z_gr_clust, zdcrit * 1.0E11_wp ) |
---|
5104 | ENDIF |
---|
5105 | ! |
---|
5106 | !-- Number conc. of clusters surviving to 3 nm in a time step (#/m3, Eq.14) |
---|
5107 | zj3 = zjnuc * EXP( MIN( 0.0_wp, zeta / 3.0_wp - zeta / ( zdcrit * 1.0E9_wp ) ) ) |
---|
5108 | |
---|
5109 | ELSEIF ( nj3 > 1 ) THEN ! Lehtinen et al. (2007) or Anttila et al. (2010) |
---|
5110 | ! |
---|
5111 | !-- Defining the parameter m (zm_para) for calculating the coagulation sink onto background |
---|
5112 | !-- particles (Eq. 5&6 in Lehtinen et al. 2007). The growth is investigated between |
---|
5113 | !-- [d1,reglim(1)] = [zdcrit,3nm] and m = LOG( CoagS_dx / CoagX_zdcrit ) / LOG( reglim / zdcrit ) |
---|
5114 | !-- (Lehtinen et al. 2007, Eq. 6). |
---|
5115 | !-- The steps for the coagulation sink for reglim = 3nm and zdcrit ~= 1nm are explained in |
---|
5116 | !-- Kulmala et al. (2001). The particles of diameter zdcrit ~1.14 nm and reglim = 3nm are both |
---|
5117 | !-- in turn the "number 1" variables (Kulmala et al. 2001). |
---|
5118 | !-- c = critical (1nm), x = 3nm, 2 = wet or mean droplet |
---|
5119 | ! |
---|
5120 | !-- Sum of the radii, R12 = R1 + R2 (m) of two particles 1 and 2 |
---|
5121 | z_r_c2 = zdcrit / 2.0_wp + paero(:)%dwet / 2.0_wp |
---|
5122 | z_r_x2 = reglim(1) / 2.0_wp + paero(:)%dwet / 2.0_wp |
---|
5123 | ! |
---|
5124 | !-- Particle mass (kg) (comes only from H2SO4) |
---|
5125 | zm_c = 4.0_wp / 3.0_wp * pi * ( zdcrit / 2.0_wp )**3 * arhoh2so4 |
---|
5126 | zm_x = 4.0_wp / 3.0_wp * pi * ( reglim(1) / 2.0_wp )**3 * arhoh2so4 |
---|
5127 | zm_2 = 4.0_wp / 3.0_wp * pi * ( 0.5_wp * paero(:)%dwet )**3 * arhoh2so4 |
---|
5128 | ! |
---|
5129 | !-- Mean relative thermal velocity between the particles (m/s) |
---|
5130 | zcv_c = SQRT( 8.0_wp * abo * ptemp / ( pi * zm_c ) ) |
---|
5131 | zcv_x = SQRT( 8.0_wp * abo * ptemp / ( pi * zm_x ) ) |
---|
5132 | zcv_2 = SQRT( 8.0_wp * abo * ptemp / ( pi * zm_2 ) ) |
---|
5133 | ! |
---|
5134 | !-- Average velocity after coagulation |
---|
5135 | zcv_c2(:) = SQRT( zcv_c**2 + zcv_2**2 ) |
---|
5136 | zcv_x2(:) = SQRT( zcv_x**2 + zcv_2**2 ) |
---|
5137 | ! |
---|
5138 | !-- Knudsen number (zmfp = mean free path of condensing vapour) |
---|
5139 | zknud_c = 2.0_wp * zmfp / zdcrit |
---|
5140 | zknud_x = 2.0_wp * zmfp / reglim(1) |
---|
5141 | zknud_2(:) = MAX( 0.0_wp, 2.0_wp * zmfp / paero(:)%dwet ) |
---|
5142 | ! |
---|
5143 | !-- Cunningham correction factors (Allen and Raabe, 1985) |
---|
5144 | zcc_c = 1.0_wp + zknud_c * ( 1.142_wp + 0.558_wp * EXP( -0.999_wp / zknud_c ) ) |
---|
5145 | zcc_x = 1.0_wp + zknud_x * ( 1.142_wp + 0.558_wp * EXP( -0.999_wp / zknud_x ) ) |
---|
5146 | zcc_2(:) = 1.0_wp + zknud_2(:) * ( 1.142_wp + 0.558_wp * EXP( -0.999_wp / zknud_2(:) ) ) |
---|
5147 | ! |
---|
5148 | !-- Gas dynamic viscosity (N*s/m2). Here, viscocity(air @20C) = 1.81e-5_dp N/m2 *s (Hinds, p. 25) |
---|
5149 | zmyy = 1.81E-5_wp * ( ptemp / 293.0_wp )**0.74_wp |
---|
5150 | ! |
---|
5151 | !-- Particle diffusion coefficient (m2/s) (continuum regime) |
---|
5152 | zdc_c(:) = abo * ptemp * zcc_c / ( 3.0_wp * pi * zmyy * zdcrit ) |
---|
5153 | zdc_x(:) = abo * ptemp * zcc_x / ( 3.0_wp * pi * zmyy * reglim(1) ) |
---|
5154 | zdc_2(:) = abo * ptemp * zcc_2(:) / ( 3.0_wp * pi * zmyy * paero(:)%dwet ) |
---|
5155 | ! |
---|
5156 | !-- D12 = D1+D2 (Seinfield and Pandis, 2nd ed. Eq. 13.38) |
---|
5157 | zdc_c2 = zdc_c + zdc_2 |
---|
5158 | zdc_x2 = zdc_x + zdc_2 |
---|
5159 | ! |
---|
5160 | !-- zgamma_f = 8*D/pi/zcv (m) for calculating zomega (Fuchs, 1964) |
---|
5161 | zgamma_f_c = 8.0_wp * zdc_c / pi / zcv_c |
---|
5162 | zgamma_f_x = 8.0_wp * zdc_x / pi / zcv_x |
---|
5163 | zgamma_f_2 = 8.0_wp * zdc_2 / pi / zcv_2 |
---|
5164 | ! |
---|
5165 | !-- zomega (m) for calculating zsigma |
---|
5166 | zomega_c = ( ( z_r_c2 + zgamma_f_c )**3 - ( z_r_c2 ** 2 + zgamma_f_c )**1.5_wp ) / & |
---|
5167 | ( 3.0_wp * z_r_c2 * zgamma_f_c ) - z_r_c2 |
---|
5168 | zomega_x = ( ( z_r_x2 + zgamma_f_x )**3 - ( z_r_x2**2 + zgamma_f_x )** 1.5_wp ) / & |
---|
5169 | ( 3.0_wp * z_r_x2 * zgamma_f_x ) - z_r_x2 |
---|
5170 | zomega_2c = ( ( z_r_c2 + zgamma_f_2 )**3 - ( z_r_c2**2 + zgamma_f_2 )**1.5_wp ) / & |
---|
5171 | ( 3.0_wp * z_r_c2 * zgamma_f_2 ) - z_r_c2 |
---|
5172 | zomega_2x = ( ( z_r_x2 + zgamma_f_2 )**3 - ( z_r_x2**2 + zgamma_f_2 )**1.5_wp ) / & |
---|
5173 | ( 3.0_wp * z_r_x2 * zgamma_f_2 ) - z_r_x2 |
---|
5174 | ! |
---|
5175 | !-- The distance (m) at which the two fluxes are matched (condensation and coagulation sinks) |
---|
5176 | zsigma_c2 = SQRT( zomega_c**2 + zomega_2c**2 ) |
---|
5177 | zsigma_x2 = SQRT( zomega_x**2 + zomega_2x**2 ) |
---|
5178 | ! |
---|
5179 | !-- Coagulation coefficient in the continuum regime (m*m2/s, Eq. 17 in Kulmala et al., 2001) |
---|
5180 | z_k_c2 = 4.0_wp * pi * z_r_c2 * zdc_c2 / ( z_r_c2 / ( z_r_c2 + zsigma_c2 ) + & |
---|
5181 | 4.0_wp * zdc_c2 / ( zcv_c2 * z_r_c2 ) ) |
---|
5182 | z_k_x2 = 4.0_wp * pi * z_r_x2 * zdc_x2 / ( z_r_x2 / ( z_r_x2 + zsigma_x2 ) + & |
---|
5183 | 4.0_wp * zdc_x2 / ( zcv_x2 * z_r_x2 ) ) |
---|
5184 | ! |
---|
5185 | !-- Coagulation sink (1/s, Eq. 16 in Kulmala et al., 2001) |
---|
5186 | zcoags_c = MAX( 1.0E-20_wp, SUM( z_k_c2 * paero(:)%numc ) ) |
---|
5187 | zcoags_x = MAX( 1.0E-20_wp, SUM( z_k_x2 * paero(:)%numc ) ) |
---|
5188 | ! |
---|
5189 | !-- Parameter m for calculating the coagulation sink onto background particles (Eq. 5&6 in |
---|
5190 | !-- Lehtinen et al. 2007) |
---|
5191 | zm_para = LOG( zcoags_x / zcoags_c ) / LOG( reglim(1) / zdcrit ) |
---|
5192 | ! |
---|
5193 | !-- Parameter gamma for calculating the formation rate J of particles having |
---|
5194 | !-- a diameter zdcrit < d < reglim(1) (Anttila et al. 2010, eq. 5 or Lehtinen et al.,2007, eq. 7) |
---|
5195 | zgamma = ( ( ( reglim(1) / zdcrit )**( zm_para + 1.0_wp ) ) - 1.0_wp ) / ( zm_para + 1.0_wp ) |
---|
5196 | |
---|
5197 | IF ( nj3 == 2 ) THEN ! Lehtinen et al. (2007): coagulation sink |
---|
5198 | ! |
---|
5199 | !-- Formation rate J before iteration (#/m3s) |
---|
5200 | zj3 = zjnuc * EXP( MIN( 0.0_wp, -zgamma * zdcrit * zcoags_c / ( z_gr_clust * 1.0E-9_wp / & |
---|
5201 | 60.0_wp**2 ) ) ) |
---|
5202 | |
---|
5203 | ELSEIF ( nj3 == 3 ) THEN ! Anttila et al. (2010): coagulation sink and self-coag. |
---|
5204 | ! |
---|
5205 | !-- If air is polluted, the self-coagulation becomes important. Self-coagulation of small |
---|
5206 | !-- particles < 3 nm. |
---|
5207 | ! |
---|
5208 | !-- "Effective" coagulation coefficient between freshly-nucleated particles: |
---|
5209 | z_k_eff = 5.0E-16_wp ! m3/s |
---|
5210 | ! |
---|
5211 | !-- zlambda parameter for "adjusting" the growth rate due to the self-coagulation |
---|
5212 | zlambda = 6.0_wp |
---|
5213 | |
---|
5214 | IF ( reglim(1) >= 10.0E-9_wp ) THEN ! for particles >10 nm: |
---|
5215 | z_k_eff = 5.0E-17_wp |
---|
5216 | zlambda = 3.0_wp |
---|
5217 | ENDIF |
---|
5218 | ! |
---|
5219 | !-- Initial values for coagulation sink and growth rate (m/s) |
---|
5220 | zcoagstot = zcoags_c |
---|
5221 | z_gr_tot = z_gr_clust * 1.0E-9_wp / 60.0_wp**2 |
---|
5222 | ! |
---|
5223 | !-- Number of clusters/particles at the size range [d1,dx] (#/m3): |
---|
5224 | z_n_nuc = zjnuc / zcoagstot !< Initial guess |
---|
5225 | ! |
---|
5226 | !-- Coagulation sink and growth rate due to self-coagulation: |
---|
5227 | DO iteration = 1, 5 |
---|
5228 | zcoagstot = zcoags_c + z_k_eff * z_n_nuc * 1.0E-6_wp ! (1/s, Anttila et al., eq. 1) |
---|
5229 | z_gr_tot = z_gr_clust * 2.77777777E-7_wp + 1.5708E-6_wp * zlambda * zdcrit**3 * & |
---|
5230 | ( z_n_nuc * 1.0E-6_wp ) * zcv_c * avo * 2.77777777E-7_wp ! (Eq. 3) |
---|
5231 | zeta = - zcoagstot / ( ( zm_para + 1.0_wp ) * z_gr_tot * ( zdcrit**zm_para ) ) ! (Eq.7b) |
---|
5232 | ! |
---|
5233 | !-- Calculate Eq. 7a (Taylor series for the number of particles between [d1,dx]) |
---|
5234 | z_n_nuc = z_n_nuc_tayl( zdcrit, reglim(1), zm_para, zjnuc, zeta, z_gr_tot ) |
---|
5235 | ENDDO |
---|
5236 | ! |
---|
5237 | !-- Calculate the final values with new z_n_nuc: |
---|
5238 | zcoagstot = zcoags_c + z_k_eff * z_n_nuc * 1.0E-6_wp ! (1/s) |
---|
5239 | z_gr_tot = z_gr_clust * 1.0E-9_wp / 3600.0_wp + 1.5708E-6_wp * zlambda * zdcrit**3 * & |
---|
5240 | ( z_n_nuc * 1.0E-6_wp ) * zcv_c * avo * 1.0E-9_wp / 3600.0_wp !< (m/s) |
---|
5241 | zj3 = zjnuc * EXP( MIN( 0.0_wp, -zgamma * zdcrit * zcoagstot / z_gr_tot ) ) ! (#/m3s, Eq.5a) |
---|
5242 | |
---|
5243 | ENDIF |
---|
5244 | ENDIF |
---|
5245 | ! |
---|
5246 | !-- If J3 very small (< 1 #/cm3), neglect particle formation. In real atmosphere this would mean |
---|
5247 | !-- that clusters form but coagulate to pre-existing particles who gain sulphate. Since |
---|
5248 | !-- CoagS ~ CS (4piD*CS'), we do *not* update H2SO4 concentration here but let condensation take |
---|
5249 | !-- care of it. Formation mass rate of molecules (molec/m3s) for 1: H2SO4 and 2: organic vapour |
---|
5250 | pj3n3(1) = zj3 * n3 * pxsa |
---|
5251 | pj3n3(2) = zj3 * n3 * pxocnv |
---|
5252 | |
---|
5253 | END SUBROUTINE nucleation |
---|
5254 | |
---|
5255 | !------------------------------------------------------------------------------! |
---|
5256 | ! Description: |
---|
5257 | ! ------------ |
---|
5258 | !> Calculate the nucleation rate and the size of critical clusters assuming |
---|
5259 | !> binary nucleation. |
---|
5260 | !> Parametrisation according to Vehkamaki et al. (2002), J. Geophys. Res., |
---|
5261 | !> 107(D22), 4622. Called from subroutine nucleation. |
---|
5262 | !------------------------------------------------------------------------------! |
---|
5263 | SUBROUTINE binnucl( pc_sa, ptemp, prh, pnuc_rate, pn_crit_sa, pn_crit_ocnv, pd_crit, pk_sa, & |
---|
5264 | pk_ocnv ) |
---|
5265 | |
---|
5266 | IMPLICIT NONE |
---|
5267 | |
---|
5268 | REAL(wp) :: za !< |
---|
5269 | REAL(wp) :: zb !< |
---|
5270 | REAL(wp) :: zc !< |
---|
5271 | REAL(wp) :: zcoll !< |
---|
5272 | REAL(wp) :: zlogsa !< LOG( zpcsa ) |
---|
5273 | REAL(wp) :: zlogrh !< LOG( zrh ) |
---|
5274 | REAL(wp) :: zm1 !< |
---|
5275 | REAL(wp) :: zm2 !< |
---|
5276 | REAL(wp) :: zma !< |
---|
5277 | REAL(wp) :: zmw !< |
---|
5278 | REAL(wp) :: zntot !< number of molecules in critical cluster |
---|
5279 | REAL(wp) :: zpcsa !< sulfuric acid concentration |
---|
5280 | REAL(wp) :: zrh !< relative humidity |
---|
5281 | REAL(wp) :: zroo !< |
---|
5282 | REAL(wp) :: zt !< temperature |
---|
5283 | REAL(wp) :: zv1 !< |
---|
5284 | REAL(wp) :: zv2 !< |
---|
5285 | REAL(wp) :: zx !< mole fraction of sulphate in critical cluster |
---|
5286 | REAL(wp) :: zxmass !< |
---|
5287 | |
---|
5288 | REAL(wp), INTENT(in) :: pc_sa !< H2SO4 conc. (#/cm3) |
---|
5289 | REAL(wp), INTENT(in) :: prh !< relative humidity [0-1 |
---|
5290 | REAL(wp), INTENT(in) :: ptemp !< ambient temperature (K) |
---|
5291 | |
---|
5292 | REAL(wp), INTENT(out) :: pnuc_rate !< nucleation rate (#/(m3 s)) |
---|
5293 | REAL(wp), INTENT(out) :: pn_crit_sa !< number of H2SO4 molecules in cluster (#) |
---|
5294 | REAL(wp), INTENT(out) :: pn_crit_ocnv !< number of organic molecules in cluster (#) |
---|
5295 | REAL(wp), INTENT(out) :: pd_crit !< diameter of critical cluster (m) |
---|
5296 | REAL(wp), INTENT(out) :: pk_sa !< Lever: if pk_sa = 1, H2SO4 is involved in nucleation. |
---|
5297 | REAL(wp), INTENT(out) :: pk_ocnv !< Lever: if pk_ocnv = 1, organic compounds are involved |
---|
5298 | |
---|
5299 | pnuc_rate = 0.0_wp |
---|
5300 | pd_crit = 1.0E-9_wp |
---|
5301 | ! |
---|
5302 | !-- 1) Checking that we are in the validity range of the parameterization |
---|
5303 | zpcsa = MAX( pc_sa, 1.0E4_wp ) |
---|
5304 | zpcsa = MIN( zpcsa, 1.0E11_wp ) |
---|
5305 | zrh = MAX( prh, 0.0001_wp ) |
---|
5306 | zrh = MIN( zrh, 1.0_wp ) |
---|
5307 | zt = MAX( ptemp, 190.15_wp ) |
---|
5308 | zt = MIN( zt, 300.15_wp ) |
---|
5309 | |
---|
5310 | zlogsa = LOG( zpcsa ) |
---|
5311 | zlogrh = LOG( prh ) |
---|
5312 | ! |
---|
5313 | !-- 2) Mole fraction of sulphate in a critical cluster (Eq. 11) |
---|
5314 | zx = 0.7409967177282139_wp - 0.002663785665140117_wp * zt + & |
---|
5315 | 0.002010478847383187_wp * zlogrh - 0.0001832894131464668_wp* zt * zlogrh + & |
---|
5316 | 0.001574072538464286_wp * zlogrh**2 - 0.00001790589121766952_wp * zt * zlogrh**2 + & |
---|
5317 | 0.0001844027436573778_wp * zlogrh**3 - 1.503452308794887E-6_wp * zt * zlogrh**3 - & |
---|
5318 | 0.003499978417957668_wp * zlogsa + 0.0000504021689382576_wp * zt * zlogsa |
---|
5319 | ! |
---|
5320 | !-- 3) Nucleation rate (Eq. 12) |
---|
5321 | pnuc_rate = 0.1430901615568665_wp + 2.219563673425199_wp * zt - & |
---|
5322 | 0.02739106114964264_wp * zt**2 + 0.00007228107239317088_wp * zt**3 + & |
---|
5323 | 5.91822263375044_wp / zx + 0.1174886643003278_wp * zlogrh + & |
---|
5324 | 0.4625315047693772_wp * zt * zlogrh - 0.01180591129059253_wp * zt**2 * zlogrh + & |
---|
5325 | 0.0000404196487152575_wp * zt**3 * zlogrh + & |
---|
5326 | ( 15.79628615047088_wp * zlogrh ) / zx - 0.215553951893509_wp * zlogrh**2 - & |
---|
5327 | 0.0810269192332194_wp * zt * zlogrh**2 + & |
---|
5328 | 0.001435808434184642_wp * zt**2 * zlogrh**2 - & |
---|
5329 | 4.775796947178588E-6_wp * zt**3 * zlogrh**2 - & |
---|
5330 | ( 2.912974063702185_wp * zlogrh**2 ) / zx - 3.588557942822751_wp * zlogrh**3 + & |
---|
5331 | 0.04950795302831703_wp * zt * zlogrh**3 - & |
---|
5332 | 0.0002138195118737068_wp * zt**2 * zlogrh**3 + & |
---|
5333 | 3.108005107949533E-7_wp * zt**3 * zlogrh**3 - & |
---|
5334 | ( 0.02933332747098296_wp * zlogrh**3 ) / zx + 1.145983818561277_wp * zlogsa - & |
---|
5335 | 0.6007956227856778_wp * zt * zlogsa + 0.00864244733283759_wp * zt**2 * zlogsa - & |
---|
5336 | 0.00002289467254710888_wp * zt**3 * zlogsa - & |
---|
5337 | ( 8.44984513869014_wp * zlogsa ) / zx + 2.158548369286559_wp * zlogrh * zlogsa + & |
---|
5338 | 0.0808121412840917_wp * zt * zlogrh * zlogsa - & |
---|
5339 | 0.0004073815255395214_wp * zt**2 * zlogrh * zlogsa - & |
---|
5340 | 4.019572560156515E-7_wp * zt**3 * zlogrh * zlogsa + & |
---|
5341 | ( 0.7213255852557236_wp * zlogrh * zlogsa ) / zx + & |
---|
5342 | 1.62409850488771_wp * zlogrh**2 * zlogsa - & |
---|
5343 | 0.01601062035325362_wp * zt * zlogrh**2 * zlogsa + & |
---|
5344 | 0.00003771238979714162_wp*zt**2* zlogrh**2 * zlogsa + & |
---|
5345 | 3.217942606371182E-8_wp * zt**3 * zlogrh**2 * zlogsa - & |
---|
5346 | ( 0.01132550810022116_wp * zlogrh**2 * zlogsa ) / zx + & |
---|
5347 | 9.71681713056504_wp * zlogsa**2 - 0.1150478558347306_wp * zt * zlogsa**2 + & |
---|
5348 | 0.0001570982486038294_wp * zt**2 * zlogsa**2 + & |
---|
5349 | 4.009144680125015E-7_wp * zt**3 * zlogsa**2 + & |
---|
5350 | ( 0.7118597859976135_wp * zlogsa**2 ) / zx - & |
---|
5351 | 1.056105824379897_wp * zlogrh * zlogsa**2 + & |
---|
5352 | 0.00903377584628419_wp * zt * zlogrh * zlogsa**2 - & |
---|
5353 | 0.00001984167387090606_wp * zt**2 * zlogrh * zlogsa**2 + & |
---|
5354 | 2.460478196482179E-8_wp * zt**3 * zlogrh * zlogsa**2 - & |
---|
5355 | ( 0.05790872906645181_wp * zlogrh * zlogsa**2 ) / zx - & |
---|
5356 | 0.1487119673397459_wp * zlogsa**3 + 0.002835082097822667_wp * zt * zlogsa**3 - & |
---|
5357 | 9.24618825471694E-6_wp * zt**2 * zlogsa**3 + & |
---|
5358 | 5.004267665960894E-9_wp * zt**3 * zlogsa**3 - & |
---|
5359 | ( 0.01270805101481648_wp * zlogsa**3 ) / zx |
---|
5360 | ! |
---|
5361 | !-- Nucleation rate in #/(cm3 s) |
---|
5362 | pnuc_rate = EXP( pnuc_rate ) |
---|
5363 | ! |
---|
5364 | !-- Check the validity of parameterization |
---|
5365 | IF ( pnuc_rate < 1.0E-7_wp ) THEN |
---|
5366 | pnuc_rate = 0.0_wp |
---|
5367 | pd_crit = 1.0E-9_wp |
---|
5368 | ENDIF |
---|
5369 | ! |
---|
5370 | !-- 4) Total number of molecules in the critical cluster (Eq. 13) |
---|
5371 | zntot = - 0.002954125078716302_wp - 0.0976834264241286_wp * zt + & |
---|
5372 | 0.001024847927067835_wp * zt**2 - 2.186459697726116E-6_wp * zt**3 - & |
---|
5373 | 0.1017165718716887_wp / zx - 0.002050640345231486_wp * zlogrh - & |
---|
5374 | 0.007585041382707174_wp * zt * zlogrh + 0.0001926539658089536_wp * zt**2 * zlogrh - & |
---|
5375 | 6.70429719683894E-7_wp * zt**3 * zlogrh - ( 0.2557744774673163_wp * zlogrh ) / zx + & |
---|
5376 | 0.003223076552477191_wp * zlogrh**2 + 0.000852636632240633_wp * zt * zlogrh**2 - & |
---|
5377 | 0.00001547571354871789_wp * zt**2 * zlogrh**2 + & |
---|
5378 | 5.666608424980593E-8_wp * zt**3 * zlogrh**2 + & |
---|
5379 | ( 0.03384437400744206_wp * zlogrh**2 ) / zx + & |
---|
5380 | 0.04743226764572505_wp * zlogrh**3 - 0.0006251042204583412_wp * zt * zlogrh**3 + & |
---|
5381 | 2.650663328519478E-6_wp * zt**2 * zlogrh**3 - & |
---|
5382 | 3.674710848763778E-9_wp * zt**3 * zlogrh**3 - & |
---|
5383 | ( 0.0002672510825259393_wp * zlogrh**3 ) / zx - 0.01252108546759328_wp * zlogsa + & |
---|
5384 | 0.005806550506277202_wp * zt * zlogsa - 0.0001016735312443444_wp * zt**2 * zlogsa + & |
---|
5385 | 2.881946187214505E-7_wp * zt**3 * zlogsa + ( 0.0942243379396279_wp * zlogsa ) / zx - & |
---|
5386 | 0.0385459592773097_wp * zlogrh * zlogsa - & |
---|
5387 | 0.0006723156277391984_wp * zt * zlogrh * zlogsa + & |
---|
5388 | 2.602884877659698E-6_wp * zt**2 * zlogrh * zlogsa + & |
---|
5389 | 1.194163699688297E-8_wp * zt**3 * zlogrh * zlogsa - & |
---|
5390 | ( 0.00851515345806281_wp * zlogrh * zlogsa ) / zx - & |
---|
5391 | 0.01837488495738111_wp * zlogrh**2 * zlogsa + & |
---|
5392 | 0.0001720723574407498_wp * zt * zlogrh**2 * zlogsa - & |
---|
5393 | 3.717657974086814E-7_wp * zt**2 * zlogrh**2 * zlogsa - & |
---|
5394 | 5.148746022615196E-10_wp * zt**3 * zlogrh**2 * zlogsa + & |
---|
5395 | ( 0.0002686602132926594_wp * zlogrh**2 * zlogsa ) / zx - & |
---|
5396 | 0.06199739728812199_wp * zlogsa**2 + 0.000906958053583576_wp * zt * zlogsa**2 - & |
---|
5397 | 9.11727926129757E-7_wp * zt**2 * zlogsa**2 - & |
---|
5398 | 5.367963396508457E-9_wp * zt**3 * zlogsa**2 - & |
---|
5399 | ( 0.007742343393937707_wp * zlogsa**2 ) / zx + & |
---|
5400 | 0.0121827103101659_wp * zlogrh * zlogsa**2 - & |
---|
5401 | 0.0001066499571188091_wp * zt * zlogrh * zlogsa**2 + & |
---|
5402 | 2.534598655067518E-7_wp * zt**2 * zlogrh * zlogsa**2 - & |
---|
5403 | 3.635186504599571E-10_wp * zt**3 * zlogrh * zlogsa**2 + & |
---|
5404 | ( 0.0006100650851863252_wp * zlogrh * zlogsa **2 ) / zx + & |
---|
5405 | 0.0003201836700403512_wp * zlogsa**3 - 0.0000174761713262546_wp * zt * zlogsa**3 + & |
---|
5406 | 6.065037668052182E-8_wp * zt**2 * zlogsa**3 - & |
---|
5407 | 1.421771723004557E-11_wp * zt**3 * zlogsa**3 + & |
---|
5408 | ( 0.0001357509859501723_wp * zlogsa**3 ) / zx |
---|
5409 | zntot = EXP( zntot ) ! in # |
---|
5410 | ! |
---|
5411 | !-- 5) Size of the critical cluster pd_crit (m) (diameter) (Eq. 14) |
---|
5412 | pn_crit_sa = zx * zntot |
---|
5413 | pd_crit = 2.0E-9_wp * EXP( -1.6524245_wp + 0.42316402_wp * zx + 0.33466487_wp * LOG( zntot ) ) |
---|
5414 | ! |
---|
5415 | !-- 6) Organic compounds not involved when binary nucleation is assumed |
---|
5416 | pn_crit_ocnv = 0.0_wp ! number of organic molecules |
---|
5417 | pk_sa = 1.0_wp ! if = 1, H2SO4 involved in nucleation |
---|
5418 | pk_ocnv = 0.0_wp ! if = 1, organic compounds involved |
---|
5419 | ! |
---|
5420 | !-- Set nucleation rate to collision rate |
---|
5421 | IF ( pn_crit_sa < 4.0_wp ) THEN |
---|
5422 | ! |
---|
5423 | !-- Volumes of the colliding objects |
---|
5424 | zma = 96.0_wp ! molar mass of SO4 in g/mol |
---|
5425 | zmw = 18.0_wp ! molar mass of water in g/mol |
---|
5426 | zxmass = 1.0_wp ! mass fraction of H2SO4 |
---|
5427 | za = 0.7681724_wp + zxmass * ( 2.1847140_wp + zxmass * & |
---|
5428 | ( 7.1630022_wp + zxmass * & |
---|
5429 | ( -44.31447_wp + zxmass * & |
---|
5430 | ( 88.75606 + zxmass * & |
---|
5431 | ( -75.73729_wp + zxmass * 23.43228_wp ) ) ) ) ) |
---|
5432 | zb = 1.808225E-3_wp + zxmass * ( -9.294656E-3_wp + zxmass * & |
---|
5433 | ( -0.03742148_wp + zxmass * & |
---|
5434 | ( 0.2565321_wp + zxmass * & |
---|
5435 | ( -0.5362872_wp + zxmass * & |
---|
5436 | ( 0.4857736 - zxmass * 0.1629592_wp ) ) ) ) ) |
---|
5437 | zc = - 3.478524E-6_wp + zxmass * ( 1.335867E-5_wp + zxmass * & |
---|
5438 | ( 5.195706E-5_wp + zxmass * & |
---|
5439 | ( -3.717636E-4_wp + zxmass * & |
---|
5440 | ( 7.990811E-4_wp + zxmass * & |
---|
5441 | ( -7.458060E-4_wp + zxmass * 2.58139E-4_wp ) ) ) ) ) |
---|
5442 | ! |
---|
5443 | !-- Density for the sulphuric acid solution (Eq. 10 in Vehkamaki) |
---|
5444 | zroo = ( za + zt * ( zb + zc * zt ) ) * 1.0E+3_wp ! (kg/m^3 |
---|
5445 | zm1 = 0.098_wp ! molar mass of H2SO4 in kg/mol |
---|
5446 | zm2 = zm1 |
---|
5447 | zv1 = zm1 / avo / zroo ! volume |
---|
5448 | zv2 = zv1 |
---|
5449 | ! |
---|
5450 | !-- Collision rate |
---|
5451 | zcoll = zpcsa * zpcsa * ( 3.0_wp * pi / 4.0_wp )**0.16666666_wp * & |
---|
5452 | SQRT( 6.0_wp * argas * zt / zm1 + 6.0_wp * argas * zt / zm2 ) * & |
---|
5453 | ( zv1**0.33333333_wp + zv2**0.33333333_wp )**2 * 1.0E+6_wp ! m3 -> cm3 |
---|
5454 | zcoll = MIN( zcoll, 1.0E+10_wp ) |
---|
5455 | pnuc_rate = zcoll ! (#/(cm3 s)) |
---|
5456 | |
---|
5457 | ELSE |
---|
5458 | pnuc_rate = MIN( pnuc_rate, 1.0E+10_wp ) |
---|
5459 | ENDIF |
---|
5460 | pnuc_rate = pnuc_rate * 1.0E+6_wp ! (#/(m3 s)) |
---|
5461 | |
---|
5462 | END SUBROUTINE binnucl |
---|
5463 | |
---|
5464 | !------------------------------------------------------------------------------! |
---|
5465 | ! Description: |
---|
5466 | ! ------------ |
---|
5467 | !> Calculate the nucleation rate and the size of critical clusters assuming |
---|
5468 | !> ternary nucleation. Parametrisation according to: |
---|
5469 | !> Napari et al. (2002), J. Chem. Phys., 116, 4221-4227 and |
---|
5470 | !> Napari et al. (2002), J. Geophys. Res., 107(D19), AAC 6-1-ACC 6-6. |
---|
5471 | !------------------------------------------------------------------------------! |
---|
5472 | SUBROUTINE ternucl( pc_sa, pc_nh3, ptemp, prh, pnuc_rate, pn_crit_sa, pn_crit_ocnv, pd_crit, & |
---|
5473 | pk_sa, pk_ocnv ) |
---|
5474 | |
---|
5475 | IMPLICIT NONE |
---|
5476 | |
---|
5477 | REAL(wp) :: zlnj !< logarithm of nucleation rate |
---|
5478 | REAL(wp) :: zlognh3 !< LOG( pc_nh3 ) |
---|
5479 | REAL(wp) :: zlogrh !< LOG( prh ) |
---|
5480 | REAL(wp) :: zlogsa !< LOG( pc_sa ) |
---|
5481 | |
---|
5482 | REAL(wp), INTENT(in) :: pc_nh3 !< ammonia mixing ratio (ppt) |
---|
5483 | REAL(wp), INTENT(in) :: pc_sa !< H2SO4 conc. (#/cm3) |
---|
5484 | REAL(wp), INTENT(in) :: prh !< relative humidity [0-1] |
---|
5485 | REAL(wp), INTENT(in) :: ptemp !< ambient temperature (K) |
---|
5486 | |
---|
5487 | REAL(wp), INTENT(out) :: pd_crit !< diameter of critical cluster (m) |
---|
5488 | REAL(wp), INTENT(out) :: pk_ocnv !< if pk_ocnv = 1, organic compounds participate in nucleation |
---|
5489 | REAL(wp), INTENT(out) :: pk_sa !< if pk_sa = 1, H2SO4 participate in nucleation |
---|
5490 | REAL(wp), INTENT(out) :: pn_crit_ocnv !< number of organic molecules in cluster (#) |
---|
5491 | REAL(wp), INTENT(out) :: pn_crit_sa !< number of H2SO4 molecules in cluster (#) |
---|
5492 | REAL(wp), INTENT(out) :: pnuc_rate !< nucleation rate (#/(m3 s)) |
---|
5493 | ! |
---|
5494 | !-- 1) Checking that we are in the validity range of the parameterization. |
---|
5495 | !-- Validity of parameterization : DO NOT REMOVE! |
---|
5496 | IF ( ptemp < 240.0_wp .OR. ptemp > 300.0_wp ) THEN |
---|
5497 | message_string = 'Invalid input value: ptemp' |
---|
5498 | CALL message( 'salsa_mod: ternucl', 'PA0648', 1, 2, 0, 6, 0 ) |
---|
5499 | ENDIF |
---|
5500 | IF ( prh < 0.05_wp .OR. prh > 0.95_wp ) THEN |
---|
5501 | message_string = 'Invalid input value: prh' |
---|
5502 | CALL message( 'salsa_mod: ternucl', 'PA0649', 1, 2, 0, 6, 0 ) |
---|
5503 | ENDIF |
---|
5504 | IF ( pc_sa < 1.0E+4_wp .OR. pc_sa > 1.0E+9_wp ) THEN |
---|
5505 | message_string = 'Invalid input value: pc_sa' |
---|
5506 | CALL message( 'salsa_mod: ternucl', 'PA0650', 1, 2, 0, 6, 0 ) |
---|
5507 | ENDIF |
---|
5508 | IF ( pc_nh3 < 0.1_wp .OR. pc_nh3 > 100.0_wp ) THEN |
---|
5509 | message_string = 'Invalid input value: pc_nh3' |
---|
5510 | CALL message( 'salsa_mod: ternucl', 'PA0651', 1, 2, 0, 6, 0 ) |
---|
5511 | ENDIF |
---|
5512 | |
---|
5513 | zlognh3 = LOG( pc_nh3 ) |
---|
5514 | zlogrh = LOG( prh ) |
---|
5515 | zlogsa = LOG( pc_sa ) |
---|
5516 | ! |
---|
5517 | !-- 2) Nucleation rate (Eq. 7 in Napari et al., 2002: Parameterization of |
---|
5518 | !-- ternary nucleation of sulfuric acid - ammonia - water. |
---|
5519 | zlnj = - 84.7551114741543_wp + 0.3117595133628944_wp * prh + & |
---|
5520 | 1.640089605712946_wp * prh * ptemp - 0.003438516933381083_wp * prh * ptemp**2 - & |
---|
5521 | 0.00001097530402419113_wp * prh * ptemp**3 - 0.3552967070274677_wp / zlogsa - & |
---|
5522 | ( 0.06651397829765026_wp * prh ) / zlogsa - ( 33.84493989762471_wp * ptemp ) / zlogsa - & |
---|
5523 | ( 7.823815852128623_wp * prh * ptemp ) / zlogsa + & |
---|
5524 | ( 0.3453602302090915_wp * ptemp**2 ) / zlogsa + & |
---|
5525 | ( 0.01229375748100015_wp * prh * ptemp**2 ) / zlogsa - & |
---|
5526 | ( 0.000824007160514956_wp *ptemp**3 ) / zlogsa + & |
---|
5527 | ( 0.00006185539100670249_wp * prh * ptemp**3 ) / zlogsa + & |
---|
5528 | 3.137345238574998_wp * zlogsa + 3.680240980277051_wp * prh * zlogsa - & |
---|
5529 | 0.7728606202085936_wp * ptemp * zlogsa - 0.204098217156962_wp * prh * ptemp * zlogsa + & |
---|
5530 | 0.005612037586790018_wp * ptemp**2 * zlogsa + & |
---|
5531 | 0.001062588391907444_wp * prh * ptemp**2 * zlogsa - & |
---|
5532 | 9.74575691760229E-6_wp * ptemp**3 * zlogsa - & |
---|
5533 | 1.265595265137352E-6_wp * prh * ptemp**3 * zlogsa + 19.03593713032114_wp * zlogsa**2 - & |
---|
5534 | 0.1709570721236754_wp * ptemp * zlogsa**2 + & |
---|
5535 | 0.000479808018162089_wp * ptemp**2 * zlogsa**2 - & |
---|
5536 | 4.146989369117246E-7_wp * ptemp**3 * zlogsa**2 + 1.076046750412183_wp * zlognh3 + & |
---|
5537 | 0.6587399318567337_wp * prh * zlognh3 + 1.48932164750748_wp * ptemp * zlognh3 + & |
---|
5538 | 0.1905424394695381_wp * prh * ptemp * zlognh3 - & |
---|
5539 | 0.007960522921316015_wp * ptemp**2 * zlognh3 - & |
---|
5540 | 0.001657184248661241_wp * prh * ptemp**2 * zlognh3 + & |
---|
5541 | 7.612287245047392E-6_wp * ptemp**3 * zlognh3 + & |
---|
5542 | 3.417436525881869E-6_wp * prh * ptemp**3 * zlognh3 + & |
---|
5543 | ( 0.1655358260404061_wp * zlognh3 ) / zlogsa + & |
---|
5544 | ( 0.05301667612522116_wp * prh * zlognh3 ) / zlogsa + & |
---|
5545 | ( 3.26622914116752_wp * ptemp * zlognh3 ) / zlogsa - & |
---|
5546 | ( 1.988145079742164_wp * prh * ptemp * zlognh3 ) / zlogsa - & |
---|
5547 | ( 0.04897027401984064_wp * ptemp**2 * zlognh3 ) / zlogsa + & |
---|
5548 | ( 0.01578269253599732_wp * prh * ptemp**2 * zlognh3 ) / zlogsa + & |
---|
5549 | ( 0.0001469672236351303_wp * ptemp**3 * zlognh3 ) / zlogsa - & |
---|
5550 | ( 0.00002935642836387197_wp * prh * ptemp**3 *zlognh3 ) / zlogsa + & |
---|
5551 | 6.526451177887659_wp * zlogsa * zlognh3 - & |
---|
5552 | 0.2580021816722099_wp * ptemp * zlogsa * zlognh3 + & |
---|
5553 | 0.001434563104474292_wp * ptemp**2 * zlogsa * zlognh3 - & |
---|
5554 | 2.020361939304473E-6_wp * ptemp**3 * zlogsa * zlognh3 - & |
---|
5555 | 0.160335824596627_wp * zlogsa**2 * zlognh3 + & |
---|
5556 | 0.00889880721460806_wp * ptemp * zlogsa**2 * zlognh3 - & |
---|
5557 | 0.00005395139051155007_wp * ptemp**2 * zlogsa**2 * zlognh3 + & |
---|
5558 | 8.39521718689596E-8_wp * ptemp**3 * zlogsa**2 * zlognh3 + & |
---|
5559 | 6.091597586754857_wp * zlognh3**2 + 8.5786763679309_wp * prh * zlognh3**2 - & |
---|
5560 | 1.253783854872055_wp * ptemp * zlognh3**2 - & |
---|
5561 | 0.1123577232346848_wp * prh * ptemp * zlognh3**2 + & |
---|
5562 | 0.00939835595219825_wp * ptemp**2 * zlognh3**2 + & |
---|
5563 | 0.0004726256283031513_wp * prh * ptemp**2 * zlognh3**2 - & |
---|
5564 | 0.00001749269360523252_wp * ptemp**3 * zlognh3**2 - & |
---|
5565 | 6.483647863710339E-7_wp * prh * ptemp**3 * zlognh3**2 + & |
---|
5566 | ( 0.7284285726576598_wp * zlognh3**2 ) / zlogsa + & |
---|
5567 | ( 3.647355600846383_wp * ptemp * zlognh3**2 ) / zlogsa - & |
---|
5568 | ( 0.02742195276078021_wp * ptemp**2 * zlognh3**2 ) / zlogsa + & |
---|
5569 | ( 0.00004934777934047135_wp * ptemp**3 * zlognh3**2 ) / zlogsa + & |
---|
5570 | 41.30162491567873_wp * zlogsa * zlognh3**2 - & |
---|
5571 | 0.357520416800604_wp * ptemp * zlogsa * zlognh3**2 + & |
---|
5572 | 0.000904383005178356_wp * ptemp**2 * zlogsa * zlognh3**2 - & |
---|
5573 | 5.737876676408978E-7_wp * ptemp**3 * zlogsa * zlognh3**2 - & |
---|
5574 | 2.327363918851818_wp * zlogsa**2 * zlognh3**2 + & |
---|
5575 | 0.02346464261919324_wp * ptemp * zlogsa**2 * zlognh3**2 - & |
---|
5576 | 0.000076518969516405_wp * ptemp**2 * zlogsa**2 * zlognh3**2 + & |
---|
5577 | 8.04589834836395E-8_wp * ptemp**3 * zlogsa**2 * zlognh3**2 - & |
---|
5578 | 0.02007379204248076_wp * zlogrh - 0.7521152446208771_wp * ptemp * zlogrh + & |
---|
5579 | 0.005258130151226247_wp * ptemp**2 * zlogrh - & |
---|
5580 | 8.98037634284419E-6_wp * ptemp**3 * zlogrh + & |
---|
5581 | ( 0.05993213079516759_wp * zlogrh ) / zlogsa + & |
---|
5582 | ( 5.964746463184173_wp * ptemp * zlogrh ) / zlogsa - & |
---|
5583 | ( 0.03624322255690942_wp * ptemp**2 * zlogrh ) / zlogsa + & |
---|
5584 | ( 0.00004933369382462509_wp * ptemp**3 * zlogrh ) / zlogsa - & |
---|
5585 | 0.7327310805365114_wp * zlognh3 * zlogrh - & |
---|
5586 | 0.01841792282958795_wp * ptemp * zlognh3 * zlogrh + & |
---|
5587 | 0.0001471855981005184_wp * ptemp**2 * zlognh3 * zlogrh - & |
---|
5588 | 2.377113195631848E-7_wp * ptemp**3 * zlognh3 * zlogrh |
---|
5589 | pnuc_rate = EXP( zlnj ) ! (#/(cm3 s)) |
---|
5590 | ! |
---|
5591 | !-- Check validity of parametrization |
---|
5592 | IF ( pnuc_rate < 1.0E-5_wp ) THEN |
---|
5593 | pnuc_rate = 0.0_wp |
---|
5594 | pd_crit = 1.0E-9_wp |
---|
5595 | ELSEIF ( pnuc_rate > 1.0E6_wp ) THEN |
---|
5596 | message_string = 'Invalid output value: nucleation rate > 10^6 1/cm3s' |
---|
5597 | CALL message( 'salsa_mod: ternucl', 'PA0623', 1, 2, 0, 6, 0 ) |
---|
5598 | ENDIF |
---|
5599 | pnuc_rate = pnuc_rate * 1.0E6_wp ! (#/(m3 s)) |
---|
5600 | ! |
---|
5601 | !-- 3) Number of H2SO4 molecules in a critical cluster (Eq. 9) |
---|
5602 | pn_crit_sa = 38.16448247950508_wp + 0.7741058259731187_wp * zlnj + & |
---|
5603 | 0.002988789927230632_wp * zlnj**2 - 0.3576046920535017_wp * ptemp - & |
---|
5604 | 0.003663583011953248_wp * zlnj * ptemp + 0.000855300153372776_wp * ptemp**2 |
---|
5605 | ! |
---|
5606 | !-- Kinetic limit: at least 2 H2SO4 molecules in a cluster |
---|
5607 | pn_crit_sa = MAX( pn_crit_sa, 2.0E0_wp ) |
---|
5608 | ! |
---|
5609 | !-- 4) Size of the critical cluster in nm (Eq. 12) |
---|
5610 | pd_crit = 0.1410271086638381_wp - 0.001226253898894878_wp * zlnj - & |
---|
5611 | 7.822111731550752E-6_wp * zlnj**2 - 0.001567273351921166_wp * ptemp - & |
---|
5612 | 0.00003075996088273962_wp * zlnj * ptemp + 0.00001083754117202233_wp * ptemp**2 |
---|
5613 | pd_crit = pd_crit * 2.0E-9_wp ! Diameter in m |
---|
5614 | ! |
---|
5615 | !-- 5) Organic compounds not involved when ternary nucleation assumed |
---|
5616 | pn_crit_ocnv = 0.0_wp |
---|
5617 | pk_sa = 1.0_wp |
---|
5618 | pk_ocnv = 0.0_wp |
---|
5619 | |
---|
5620 | END SUBROUTINE ternucl |
---|
5621 | |
---|
5622 | !------------------------------------------------------------------------------! |
---|
5623 | ! Description: |
---|
5624 | ! ------------ |
---|
5625 | !> Function z_n_nuc_tayl is connected to the calculation of self-coagualtion of |
---|
5626 | !> small particles. It calculates number of the particles in the size range |
---|
5627 | !> [zdcrit,dx] using Taylor-expansion (please note that the expansion is not |
---|
5628 | !> valid for certain rational numbers, e.g. -4/3 and -3/2) |
---|
5629 | !------------------------------------------------------------------------------! |
---|
5630 | FUNCTION z_n_nuc_tayl( d1, dx, zm_para, zjnuc_t, zeta, z_gr_tot ) |
---|
5631 | |
---|
5632 | IMPLICIT NONE |
---|
5633 | |
---|
5634 | INTEGER(iwp) :: i !< running index |
---|
5635 | |
---|
5636 | REAL(wp) :: d1 !< lower diameter limit |
---|
5637 | REAL(wp) :: dx !< upper diameter limit |
---|
5638 | REAL(wp) :: zjnuc_t !< initial nucleation rate (1/s) |
---|
5639 | REAL(wp) :: zeta !< ratio of CS/GR (m) (condensation sink / growth rate) |
---|
5640 | REAL(wp) :: term1 !< |
---|
5641 | REAL(wp) :: term2 !< |
---|
5642 | REAL(wp) :: term3 !< |
---|
5643 | REAL(wp) :: term4 !< |
---|
5644 | REAL(wp) :: term5 !< |
---|
5645 | REAL(wp) :: z_n_nuc_tayl !< final nucleation rate (1/s) |
---|
5646 | REAL(wp) :: z_gr_tot !< total growth rate (nm/h) |
---|
5647 | REAL(wp) :: zm_para !< m parameter in Lehtinen et al. (2007), Eq. 6 |
---|
5648 | |
---|
5649 | z_n_nuc_tayl = 0.0_wp |
---|
5650 | |
---|
5651 | DO i = 0, 29 |
---|
5652 | IF ( i == 0 .OR. i == 1 ) THEN |
---|
5653 | term1 = 1.0_wp |
---|
5654 | ELSE |
---|
5655 | term1 = term1 * REAL( i, SELECTED_REAL_KIND(12,307) ) |
---|
5656 | END IF |
---|
5657 | term2 = ( REAL( i, SELECTED_REAL_KIND(12,307) ) * ( zm_para + 1.0_wp ) + 1.0_wp ) * term1 |
---|
5658 | term3 = zeta**i |
---|
5659 | term4 = term3 / term2 |
---|
5660 | term5 = REAL( i, SELECTED_REAL_KIND(12,307) ) * ( zm_para + 1.0_wp ) + 1.0_wp |
---|
5661 | z_n_nuc_tayl = z_n_nuc_tayl + term4 * ( dx**term5 - d1**term5 ) |
---|
5662 | ENDDO |
---|
5663 | z_n_nuc_tayl = z_n_nuc_tayl * zjnuc_t * EXP( -zeta * ( d1**( zm_para + 1 ) ) ) / z_gr_tot |
---|
5664 | |
---|
5665 | END FUNCTION z_n_nuc_tayl |
---|
5666 | |
---|
5667 | !------------------------------------------------------------------------------! |
---|
5668 | ! Description: |
---|
5669 | ! ------------ |
---|
5670 | !> Calculates the condensation of water vapour on aerosol particles. Follows the |
---|
5671 | !> analytical predictor method by Jacobson (2005). |
---|
5672 | !> For equations, see Jacobson (2005), Fundamentals of atmospheric modelling |
---|
5673 | !> (2nd edition). |
---|
5674 | !------------------------------------------------------------------------------! |
---|
5675 | SUBROUTINE gpparth2o( paero, ptemp, ppres, pcs, pcw, ptstep ) |
---|
5676 | |
---|
5677 | IMPLICIT NONE |
---|
5678 | |
---|
5679 | INTEGER(iwp) :: ib !< loop index |
---|
5680 | INTEGER(iwp) :: nstr !< |
---|
5681 | |
---|
5682 | REAL(wp) :: adt !< internal timestep in this subroutine |
---|
5683 | REAL(wp) :: rhoair !< air density (kg/m3) |
---|
5684 | REAL(wp) :: ttot !< total time (s) |
---|
5685 | REAL(wp) :: zact !< Water activity |
---|
5686 | REAL(wp) :: zaelwc1 !< Current aerosol water content (kg/m3) |
---|
5687 | REAL(wp) :: zaelwc2 !< New aerosol water content after equilibrium calculation (kg/m3) |
---|
5688 | REAL(wp) :: zbeta !< Transitional correction factor |
---|
5689 | REAL(wp) :: zcwc !< Current water vapour mole concentration in aerosols (mol/m3) |
---|
5690 | REAL(wp) :: zcwint !< Current and new water vapour mole concentrations (mol/m3) |
---|
5691 | REAL(wp) :: zcwn !< New water vapour mole concentration (mol/m3) |
---|
5692 | REAL(wp) :: zcwtot !< Total water mole concentration (mol/m3) |
---|
5693 | REAL(wp) :: zdfh2o !< molecular diffusion coefficient (cm2/s) for water |
---|
5694 | REAL(wp) :: zhlp1 !< intermediate variable to calculate the mass transfer coefficient |
---|
5695 | REAL(wp) :: zhlp2 !< intermediate variable to calculate the mass transfer coefficient |
---|
5696 | REAL(wp) :: zhlp3 !< intermediate variable to calculate the mass transfer coefficient |
---|
5697 | REAL(wp) :: zknud !< Knudsen number |
---|
5698 | REAL(wp) :: zmfph2o !< mean free path of H2O gas molecule |
---|
5699 | REAL(wp) :: zrh !< relative humidity [0-1] |
---|
5700 | REAL(wp) :: zthcond !< thermal conductivity of air (W/m/K) |
---|
5701 | |
---|
5702 | REAL(wp), DIMENSION(nbins_aerosol) :: zcwcae !< Current water mole concentrations |
---|
5703 | REAL(wp), DIMENSION(nbins_aerosol) :: zcwintae !< Current and new aerosol water mole concentration |
---|
5704 | REAL(wp), DIMENSION(nbins_aerosol) :: zcwnae !< New water mole concentration in aerosols |
---|
5705 | REAL(wp), DIMENSION(nbins_aerosol) :: zcwsurfae !< Surface mole concentration |
---|
5706 | REAL(wp), DIMENSION(nbins_aerosol) :: zkelvin !< Kelvin effect |
---|
5707 | REAL(wp), DIMENSION(nbins_aerosol) :: zmtae !< Mass transfer coefficients |
---|
5708 | REAL(wp), DIMENSION(nbins_aerosol) :: zwsatae !< Water saturation ratio above aerosols |
---|
5709 | |
---|
5710 | REAL(wp), INTENT(in) :: ppres !< Air pressure (Pa) |
---|
5711 | REAL(wp), INTENT(in) :: pcs !< Water vapour saturation concentration (kg/m3) |
---|
5712 | REAL(wp), INTENT(in) :: ptemp !< Ambient temperature (K) |
---|
5713 | REAL(wp), INTENT(in) :: ptstep !< timestep (s) |
---|
5714 | |
---|
5715 | REAL(wp), INTENT(inout) :: pcw !< Water vapour concentration (kg/m3) |
---|
5716 | |
---|
5717 | TYPE(t_section), DIMENSION(nbins_aerosol), INTENT(inout) :: paero !< Aerosol properties |
---|
5718 | ! |
---|
5719 | !-- Relative humidity [0-1] |
---|
5720 | zrh = pcw / pcs |
---|
5721 | ! |
---|
5722 | !-- Calculate the condensation only for 2a/2b aerosol bins |
---|
5723 | nstr = start_subrange_2a |
---|
5724 | ! |
---|
5725 | !-- Save the current aerosol water content, 8 in paero is H2O |
---|
5726 | zaelwc1 = SUM( paero(start_subrange_1a:end_subrange_2b)%volc(8) ) * arhoh2o |
---|
5727 | ! |
---|
5728 | !-- Equilibration: |
---|
5729 | IF ( advect_particle_water ) THEN |
---|
5730 | IF ( zrh < 0.98_wp .OR. .NOT. lscndh2oae ) THEN |
---|
5731 | CALL equilibration( zrh, ptemp, paero, .TRUE. ) |
---|
5732 | ELSE |
---|
5733 | CALL equilibration( zrh, ptemp, paero, .FALSE. ) |
---|
5734 | ENDIF |
---|
5735 | ENDIF |
---|
5736 | ! |
---|
5737 | !-- The new aerosol water content after equilibrium calculation |
---|
5738 | zaelwc2 = SUM( paero(start_subrange_1a:end_subrange_2b)%volc(8) ) * arhoh2o |
---|
5739 | ! |
---|
5740 | !-- New water vapour mixing ratio (kg/m3) |
---|
5741 | pcw = pcw - ( zaelwc2 - zaelwc1 ) * ppres * amdair / ( argas * ptemp ) |
---|
5742 | ! |
---|
5743 | !-- Initialise variables |
---|
5744 | zcwsurfae(:) = 0.0_wp |
---|
5745 | zhlp1 = 0.0_wp |
---|
5746 | zhlp2 = 0.0_wp |
---|
5747 | zhlp3 = 0.0_wp |
---|
5748 | zmtae(:) = 0.0_wp |
---|
5749 | zwsatae(:) = 0.0_wp |
---|
5750 | ! |
---|
5751 | !-- Air: |
---|
5752 | !-- Density (kg/m3) |
---|
5753 | rhoair = amdair * ppres / ( argas * ptemp ) |
---|
5754 | ! |
---|
5755 | !-- Thermal conductivity of air |
---|
5756 | zthcond = 0.023807_wp + 7.1128E-5_wp * ( ptemp - 273.16_wp ) |
---|
5757 | ! |
---|
5758 | !-- Water vapour: |
---|
5759 | !-- Molecular diffusion coefficient (cm2/s) (eq.16.17) |
---|
5760 | zdfh2o = ( 5.0_wp / ( 16.0_wp * avo * rhoair * 1.0E-3_wp * 3.11E-8_wp**2 ) ) * SQRT( argas * & |
---|
5761 | 1.0E+7_wp * ptemp * amdair * 1.0E+3_wp * ( amh2o + amdair ) * 1.0E+3_wp / & |
---|
5762 | ( pi * amh2o * 2.0E+3_wp ) ) |
---|
5763 | zdfh2o = zdfh2o * 1.0E-4 ! Unit change to m^2/s |
---|
5764 | ! |
---|
5765 | !-- Mean free path (eq. 15.25 & 16.29) |
---|
5766 | zmfph2o = 3.0_wp * zdfh2o * SQRT( pi * amh2o / ( 8.0_wp * argas * ptemp ) ) |
---|
5767 | ! |
---|
5768 | !-- Kelvin effect (eq. 16.33) |
---|
5769 | zkelvin(:) = EXP( 4.0_wp * surfw0 * amh2o / ( argas * ptemp * arhoh2o * paero(:)%dwet) ) |
---|
5770 | |
---|
5771 | DO ib = 1, nbins_aerosol |
---|
5772 | IF ( paero(ib)%numc > nclim .AND. zrh > 0.98_wp ) THEN |
---|
5773 | ! |
---|
5774 | !-- Water activity |
---|
5775 | zact = acth2o( paero(ib) ) |
---|
5776 | ! |
---|
5777 | !-- Saturation mole concentration over flat surface. Limit the super- |
---|
5778 | !-- saturation to max 1.01 for the mass transfer. Experimental! |
---|
5779 | zcwsurfae(ib) = MAX( pcs, pcw / 1.01_wp ) * rhoair / amh2o |
---|
5780 | ! |
---|
5781 | !-- Equilibrium saturation ratio |
---|
5782 | zwsatae(ib) = zact * zkelvin(ib) |
---|
5783 | ! |
---|
5784 | !-- Knudsen number (eq. 16.20) |
---|
5785 | zknud = 2.0_wp * zmfph2o / paero(ib)%dwet |
---|
5786 | ! |
---|
5787 | !-- Transitional correction factor (Fuks & Sutugin, 1971) |
---|
5788 | zbeta = ( zknud + 1.0_wp ) / ( 0.377_wp * zknud + 1.0_wp + 4.0_wp / & |
---|
5789 | ( 3.0_wp * massacc(ib) ) * ( zknud + zknud**2 ) ) |
---|
5790 | ! |
---|
5791 | !-- Mass transfer of H2O: Eq. 16.64 but here D^eff = zdfh2o * zbeta |
---|
5792 | zhlp1 = paero(ib)%numc * 2.0_wp * pi * paero(ib)%dwet * zdfh2o * zbeta |
---|
5793 | ! |
---|
5794 | !-- 1st term on the left side of the denominator in eq. 16.55 |
---|
5795 | zhlp2 = amh2o * zdfh2o * alv * zwsatae(ib) * zcwsurfae(ib) / ( zthcond * ptemp ) |
---|
5796 | ! |
---|
5797 | !-- 2nd term on the left side of the denominator in eq. 16.55 |
---|
5798 | zhlp3 = ( ( alv * amh2o ) / ( argas * ptemp ) ) - 1.0_wp |
---|
5799 | ! |
---|
5800 | !-- Full eq. 16.64: Mass transfer coefficient (1/s) |
---|
5801 | zmtae(ib) = zhlp1 / ( zhlp2 * zhlp3 + 1.0_wp ) |
---|
5802 | ENDIF |
---|
5803 | ENDDO |
---|
5804 | ! |
---|
5805 | !-- Current mole concentrations of water |
---|
5806 | zcwc = pcw * rhoair / amh2o ! as vapour |
---|
5807 | zcwcae(:) = paero(:)%volc(8) * arhoh2o / amh2o ! in aerosols |
---|
5808 | zcwtot = zcwc + SUM( zcwcae ) ! total water concentration |
---|
5809 | zcwnae(:) = 0.0_wp |
---|
5810 | zcwintae(:) = zcwcae(:) |
---|
5811 | ! |
---|
5812 | !-- Substepping loop |
---|
5813 | zcwint = 0.0_wp |
---|
5814 | ttot = 0.0_wp |
---|
5815 | DO WHILE ( ttot < ptstep ) |
---|
5816 | adt = 2.0E-2_wp ! internal timestep |
---|
5817 | ! |
---|
5818 | !-- New vapour concentration: (eq. 16.71) |
---|
5819 | zhlp1 = zcwc + adt * ( SUM( zmtae(nstr:nbins_aerosol) * zwsatae(nstr:nbins_aerosol) * & |
---|
5820 | zcwsurfae(nstr:nbins_aerosol) ) ) ! numerator |
---|
5821 | zhlp2 = 1.0_wp + adt * ( SUM( zmtae(nstr:nbins_aerosol) ) ) ! denomin. |
---|
5822 | zcwint = zhlp1 / zhlp2 ! new vapour concentration |
---|
5823 | zcwint = MIN( zcwint, zcwtot ) |
---|
5824 | IF ( ANY( paero(:)%numc > nclim ) .AND. zrh > 0.98_wp ) THEN |
---|
5825 | DO ib = nstr, nbins_aerosol |
---|
5826 | zcwintae(ib) = zcwcae(ib) + MIN( MAX( adt * zmtae(ib) * ( zcwint - zwsatae(ib) * & |
---|
5827 | zcwsurfae(ib) ), -0.02_wp * zcwcae(ib) ), & |
---|
5828 | 0.05_wp * zcwcae(ib) ) |
---|
5829 | zwsatae(ib) = acth2o( paero(ib), zcwintae(ib) ) * zkelvin(ib) |
---|
5830 | ENDDO |
---|
5831 | ENDIF |
---|
5832 | zcwintae(nstr:nbins_aerosol) = MAX( zcwintae(nstr:nbins_aerosol), 0.0_wp ) |
---|
5833 | ! |
---|
5834 | !-- Update vapour concentration for consistency |
---|
5835 | zcwint = zcwtot - SUM( zcwintae(1:nbins_aerosol) ) |
---|
5836 | ! |
---|
5837 | !-- Update "old" values for next cycle |
---|
5838 | zcwcae = zcwintae |
---|
5839 | |
---|
5840 | ttot = ttot + adt |
---|
5841 | |
---|
5842 | ENDDO ! ADT |
---|
5843 | |
---|
5844 | zcwn = zcwint |
---|
5845 | zcwnae(:) = zcwintae(:) |
---|
5846 | pcw = zcwn * amh2o / rhoair |
---|
5847 | paero(:)%volc(8) = MAX( 0.0_wp, zcwnae(:) * amh2o / arhoh2o ) |
---|
5848 | |
---|
5849 | END SUBROUTINE gpparth2o |
---|
5850 | |
---|
5851 | !------------------------------------------------------------------------------! |
---|
5852 | ! Description: |
---|
5853 | ! ------------ |
---|
5854 | !> Calculates the activity coefficient of liquid water |
---|
5855 | !------------------------------------------------------------------------------! |
---|
5856 | REAL(wp) FUNCTION acth2o( ppart, pcw ) |
---|
5857 | |
---|
5858 | IMPLICIT NONE |
---|
5859 | |
---|
5860 | REAL(wp) :: zns !< molar concentration of solutes (mol/m3) |
---|
5861 | REAL(wp) :: znw !< molar concentration of water (mol/m3) |
---|
5862 | |
---|
5863 | REAL(wp), INTENT(in), OPTIONAL :: pcw !< molar concentration of water (mol/m3) |
---|
5864 | |
---|
5865 | TYPE(t_section), INTENT(in) :: ppart !< Aerosol properties of a bin |
---|
5866 | |
---|
5867 | zns = ( 3.0_wp * ( ppart%volc(1) * arhoh2so4 / amh2so4 ) + ( ppart%volc(2) * arhooc / amoc ) + & |
---|
5868 | 2.0_wp * ( ppart%volc(5) * arhoss / amss ) + ( ppart%volc(6) * arhohno3 / amhno3 ) + & |
---|
5869 | ( ppart%volc(7) * arhonh3 / amnh3 ) ) |
---|
5870 | |
---|
5871 | IF ( PRESENT(pcw) ) THEN |
---|
5872 | znw = pcw |
---|
5873 | ELSE |
---|
5874 | znw = ppart%volc(8) * arhoh2o / amh2o |
---|
5875 | ENDIF |
---|
5876 | ! |
---|
5877 | !-- Activity = partial pressure of water vapour / sat. vapour pressure of water over a liquid surface |
---|
5878 | !-- = molality * activity coefficient (Jacobson, 2005: eq. 17.20-21) |
---|
5879 | !-- Assume activity coefficient of 1 for water |
---|
5880 | acth2o = MAX( 0.1_wp, znw / MAX( EPSILON( 1.0_wp ),( znw + zns ) ) ) |
---|
5881 | |
---|
5882 | END FUNCTION acth2o |
---|
5883 | |
---|
5884 | !------------------------------------------------------------------------------! |
---|
5885 | ! Description: |
---|
5886 | ! ------------ |
---|
5887 | !> Calculates the dissolutional growth of particles (i.e. gas transfers to a |
---|
5888 | !> particle surface and dissolves in liquid water on the surface). Treated here |
---|
5889 | !> as a non-equilibrium (time-dependent) process. Gases: HNO3 and NH3 |
---|
5890 | !> (Chapter 17.14 in Jacobson, 2005). |
---|
5891 | ! |
---|
5892 | !> Called from subroutine condensation. |
---|
5893 | !> Coded by: |
---|
5894 | !> Harri Kokkola (FMI) |
---|
5895 | !------------------------------------------------------------------------------! |
---|
5896 | SUBROUTINE gpparthno3( ppres, ptemp, paero, pghno3, pgnh3, pcw, pcs, pbeta, ptstep ) |
---|
5897 | |
---|
5898 | IMPLICIT NONE |
---|
5899 | |
---|
5900 | INTEGER(iwp) :: ib !< loop index |
---|
5901 | |
---|
5902 | REAL(wp) :: adt !< timestep |
---|
5903 | REAL(wp) :: zc_nh3_c !< Current NH3 gas concentration |
---|
5904 | REAL(wp) :: zc_nh3_int !< Intermediate NH3 gas concentration |
---|
5905 | REAL(wp) :: zc_nh3_n !< New NH3 gas concentration |
---|
5906 | REAL(wp) :: zc_nh3_tot !< Total NH3 concentration |
---|
5907 | REAL(wp) :: zc_hno3_c !< Current HNO3 gas concentration |
---|
5908 | REAL(wp) :: zc_hno3_int !< Intermediate HNO3 gas concentration |
---|
5909 | REAL(wp) :: zc_hno3_n !< New HNO3 gas concentration |
---|
5910 | REAL(wp) :: zc_hno3_tot !< Total HNO3 concentration |
---|
5911 | REAL(wp) :: zdfvap !< Diffusion coefficient for vapors |
---|
5912 | REAL(wp) :: zhlp1 !< intermediate variable |
---|
5913 | REAL(wp) :: zhlp2 !< intermediate variable |
---|
5914 | REAL(wp) :: zrh !< relative humidity |
---|
5915 | |
---|
5916 | REAL(wp), INTENT(in) :: ppres !< ambient pressure (Pa) |
---|
5917 | REAL(wp), INTENT(in) :: pcs !< water vapour saturation |
---|
5918 | !< concentration (kg/m3) |
---|
5919 | REAL(wp), INTENT(in) :: ptemp !< ambient temperature (K) |
---|
5920 | REAL(wp), INTENT(in) :: ptstep !< time step (s) |
---|
5921 | |
---|
5922 | REAL(wp), INTENT(inout) :: pghno3 !< nitric acid concentration (#/m3) |
---|
5923 | REAL(wp), INTENT(inout) :: pgnh3 !< ammonia conc. (#/m3) |
---|
5924 | REAL(wp), INTENT(inout) :: pcw !< water vapour concentration (kg/m3) |
---|
5925 | |
---|
5926 | REAL(wp), DIMENSION(nbins_aerosol) :: zac_hno3_ae !< Activity coefficients for HNO3 |
---|
5927 | REAL(wp), DIMENSION(nbins_aerosol) :: zac_hhso4_ae !< Activity coefficients for HHSO4 |
---|
5928 | REAL(wp), DIMENSION(nbins_aerosol) :: zac_nh3_ae !< Activity coefficients for NH3 |
---|
5929 | REAL(wp), DIMENSION(nbins_aerosol) :: zac_nh4hso2_ae !< Activity coefficients for NH4HSO2 |
---|
5930 | REAL(wp), DIMENSION(nbins_aerosol) :: zcg_hno3_eq_ae !< Equilibrium gas concentration: HNO3 |
---|
5931 | REAL(wp), DIMENSION(nbins_aerosol) :: zcg_nh3_eq_ae !< Equilibrium gas concentration: NH3 |
---|
5932 | REAL(wp), DIMENSION(nbins_aerosol) :: zc_hno3_int_ae !< Intermediate HNO3 aerosol concentration |
---|
5933 | REAL(wp), DIMENSION(nbins_aerosol) :: zc_hno3_c_ae !< Current HNO3 in aerosols |
---|
5934 | REAL(wp), DIMENSION(nbins_aerosol) :: zc_hno3_n_ae !< New HNO3 in aerosols |
---|
5935 | REAL(wp), DIMENSION(nbins_aerosol) :: zc_nh3_int_ae !< Intermediate NH3 aerosol concentration |
---|
5936 | REAL(wp), DIMENSION(nbins_aerosol) :: zc_nh3_c_ae !< Current NH3 in aerosols |
---|
5937 | REAL(wp), DIMENSION(nbins_aerosol) :: zc_nh3_n_ae !< New NH3 in aerosols |
---|
5938 | REAL(wp), DIMENSION(nbins_aerosol) :: zkel_hno3_ae !< Kelvin effect for HNO3 |
---|
5939 | REAL(wp), DIMENSION(nbins_aerosol) :: zkel_nh3_ae !< Kelvin effects for NH3 |
---|
5940 | REAL(wp), DIMENSION(nbins_aerosol) :: zmt_hno3_ae !< Mass transfer coefficients for HNO3 |
---|
5941 | REAL(wp), DIMENSION(nbins_aerosol) :: zmt_nh3_ae !< Mass transfer coefficients for NH3 |
---|
5942 | REAL(wp), DIMENSION(nbins_aerosol) :: zsat_hno3_ae !< HNO3 saturation ratio over a surface |
---|
5943 | REAL(wp), DIMENSION(nbins_aerosol) :: zsat_nh3_ae !< NH3 saturation ratio over a surface |
---|
5944 | |
---|
5945 | REAL(wp), DIMENSION(nbins_aerosol,maxspec) :: zion_mols !< Ion molalities from pdfite aerosols |
---|
5946 | |
---|
5947 | REAL(wp), DIMENSION(nbins_aerosol), INTENT(in) :: pbeta !< transitional correction factor for |
---|
5948 | |
---|
5949 | TYPE(t_section), DIMENSION(nbins_aerosol), INTENT(inout) :: paero !< Aerosol properties |
---|
5950 | ! |
---|
5951 | !-- Initialise: |
---|
5952 | adt = ptstep |
---|
5953 | zac_hhso4_ae = 0.0_wp |
---|
5954 | zac_nh3_ae = 0.0_wp |
---|
5955 | zac_nh4hso2_ae = 0.0_wp |
---|
5956 | zac_hno3_ae = 0.0_wp |
---|
5957 | zcg_nh3_eq_ae = 0.0_wp |
---|
5958 | zcg_hno3_eq_ae = 0.0_wp |
---|
5959 | zion_mols = 0.0_wp |
---|
5960 | zsat_nh3_ae = 1.0_wp |
---|
5961 | zsat_hno3_ae = 1.0_wp |
---|
5962 | ! |
---|
5963 | !-- Diffusion coefficient (m2/s) |
---|
5964 | zdfvap = 5.1111E-10_wp * ptemp**1.75_wp * ( p_0 + 1325.0_wp ) / ppres |
---|
5965 | ! |
---|
5966 | !-- Kelvin effects (Jacobson (2005), eq. 16.33) |
---|
5967 | zkel_hno3_ae(1:nbins_aerosol) = EXP( 4.0_wp * surfw0 * amvhno3 / & |
---|
5968 | ( abo * ptemp * paero(1:nbins_aerosol)%dwet ) ) |
---|
5969 | zkel_nh3_ae(1:nbins_aerosol) = EXP( 4.0_wp * surfw0 * amvnh3 / & |
---|
5970 | ( abo * ptemp * paero(1:nbins_aerosol)%dwet ) ) |
---|
5971 | ! |
---|
5972 | !-- Current vapour mole concentrations (mol/m3) |
---|
5973 | zc_hno3_c = pghno3 / avo ! HNO3 |
---|
5974 | zc_nh3_c = pgnh3 / avo ! NH3 |
---|
5975 | ! |
---|
5976 | !-- Current particle mole concentrations (mol/m3) |
---|
5977 | zc_hno3_c_ae(1:nbins_aerosol) = paero(1:nbins_aerosol)%volc(6) * arhohno3 / amhno3 |
---|
5978 | zc_nh3_c_ae(1:nbins_aerosol) = paero(1:nbins_aerosol)%volc(7) * arhonh3 / amnh3 |
---|
5979 | ! |
---|
5980 | !-- Total mole concentrations: gas and particle phase |
---|
5981 | zc_hno3_tot = zc_hno3_c + SUM( zc_hno3_c_ae(1:nbins_aerosol) ) |
---|
5982 | zc_nh3_tot = zc_nh3_c + SUM( zc_nh3_c_ae(1:nbins_aerosol) ) |
---|
5983 | ! |
---|
5984 | !-- Relative humidity [0-1] |
---|
5985 | zrh = pcw / pcs |
---|
5986 | ! |
---|
5987 | !-- Mass transfer coefficients (Jacobson, Eq. 16.64) |
---|
5988 | zmt_hno3_ae(:) = 2.0_wp * pi * paero(:)%dwet * zdfvap * paero(:)%numc * pbeta(:) |
---|
5989 | zmt_nh3_ae(:) = 2.0_wp * pi * paero(:)%dwet * zdfvap * paero(:)%numc * pbeta(:) |
---|
5990 | |
---|
5991 | ! |
---|
5992 | !-- Get the equilibrium concentrations above aerosols |
---|
5993 | CALL nitrate_ammonium_equilibrium( zrh, ptemp, paero, zcg_hno3_eq_ae, zcg_nh3_eq_ae, & |
---|
5994 | zac_hno3_ae, zac_nh3_ae, zac_nh4hso2_ae, zac_hhso4_ae, & |
---|
5995 | zion_mols ) |
---|
5996 | ! |
---|
5997 | !-- Calculate NH3 and HNO3 saturation ratios for aerosols |
---|
5998 | CALL nitrate_ammonium_saturation( ptemp, paero, zac_hno3_ae, zac_nh4hso2_ae, zac_hhso4_ae, & |
---|
5999 | zcg_hno3_eq_ae, zc_hno3_c_ae, zc_nh3_c_ae, zkel_hno3_ae, & |
---|
6000 | zkel_nh3_ae, zsat_hno3_ae, zsat_nh3_ae ) |
---|
6001 | ! |
---|
6002 | !-- Intermediate gas concentrations of HNO3 and NH3 |
---|
6003 | zhlp1 = SUM( zc_hno3_c_ae(:) / ( 1.0_wp + adt * zmt_hno3_ae(:) * zsat_hno3_ae(:) ) ) |
---|
6004 | zhlp2 = SUM( zmt_hno3_ae(:) / ( 1.0_wp + adt * zmt_hno3_ae(:) * zsat_hno3_ae(:) ) ) |
---|
6005 | zc_hno3_int = ( zc_hno3_tot - zhlp1 ) / ( 1.0_wp + adt * zhlp2 ) |
---|
6006 | |
---|
6007 | zhlp1 = SUM( zc_nh3_c_ae(:) / ( 1.0_wp + adt * zmt_nh3_ae(:) * zsat_nh3_ae(:) ) ) |
---|
6008 | zhlp2 = SUM( zmt_nh3_ae(:) / ( 1.0_wp + adt * zmt_nh3_ae(:) * zsat_nh3_ae(:) ) ) |
---|
6009 | zc_nh3_int = ( zc_nh3_tot - zhlp1 )/( 1.0_wp + adt * zhlp2 ) |
---|
6010 | |
---|
6011 | zc_hno3_int = MIN( zc_hno3_int, zc_hno3_tot ) |
---|
6012 | zc_nh3_int = MIN( zc_nh3_int, zc_nh3_tot ) |
---|
6013 | ! |
---|
6014 | !-- Calculate the new concentration on aerosol particles |
---|
6015 | zc_hno3_int_ae = zc_hno3_c_ae |
---|
6016 | zc_nh3_int_ae = zc_nh3_c_ae |
---|
6017 | DO ib = 1, nbins_aerosol |
---|
6018 | zc_hno3_int_ae(ib) = ( zc_hno3_c_ae(ib) + adt * zmt_hno3_ae(ib) * zc_hno3_int ) / & |
---|
6019 | ( 1.0_wp + adt * zmt_hno3_ae(ib) * zsat_hno3_ae(ib) ) |
---|
6020 | zc_nh3_int_ae(ib) = ( zc_nh3_c_ae(ib) + adt * zmt_nh3_ae(ib) * zc_nh3_int ) / & |
---|
6021 | ( 1.0_wp + adt * zmt_nh3_ae(ib) * zsat_nh3_ae(ib) ) |
---|
6022 | ENDDO |
---|
6023 | |
---|
6024 | zc_hno3_int_ae(:) = MAX( zc_hno3_int_ae(:), 0.0_wp ) |
---|
6025 | zc_nh3_int_ae(:) = MAX( zc_nh3_int_ae(:), 0.0_wp ) |
---|
6026 | ! |
---|
6027 | !-- Final molar gas concentration and molar particle concentration of HNO3 |
---|
6028 | zc_hno3_n = zc_hno3_int |
---|
6029 | zc_hno3_n_ae = zc_hno3_int_ae |
---|
6030 | ! |
---|
6031 | !-- Final molar gas concentration and molar particle concentration of NH3 |
---|
6032 | zc_nh3_n = zc_nh3_int |
---|
6033 | zc_nh3_n_ae = zc_nh3_int_ae |
---|
6034 | ! |
---|
6035 | !-- Model timestep reached - update the gas concentrations |
---|
6036 | pghno3 = zc_hno3_n * avo |
---|
6037 | pgnh3 = zc_nh3_n * avo |
---|
6038 | ! |
---|
6039 | !-- Update the particle concentrations |
---|
6040 | DO ib = start_subrange_1a, end_subrange_2b |
---|
6041 | paero(ib)%volc(6) = zc_hno3_n_ae(ib) * amhno3 / arhohno3 |
---|
6042 | paero(ib)%volc(7) = zc_nh3_n_ae(ib) * amnh3 / arhonh3 |
---|
6043 | ENDDO |
---|
6044 | |
---|
6045 | END SUBROUTINE gpparthno3 |
---|
6046 | !------------------------------------------------------------------------------! |
---|
6047 | ! Description: |
---|
6048 | ! ------------ |
---|
6049 | !> Calculate the equilibrium concentrations above aerosols (reference?) |
---|
6050 | !------------------------------------------------------------------------------! |
---|
6051 | SUBROUTINE nitrate_ammonium_equilibrium( prh, ptemp, ppart, pcg_hno3_eq, pcg_nh3_eq, pgamma_hno3, & |
---|
6052 | pgamma_nh4, pgamma_nh4hso2, pgamma_hhso4, pmols ) |
---|
6053 | |
---|
6054 | IMPLICIT NONE |
---|
6055 | |
---|
6056 | INTEGER(iwp) :: ib !< loop index: aerosol bins |
---|
6057 | |
---|
6058 | REAL(wp) :: zhlp !< intermediate variable |
---|
6059 | REAL(wp) :: zp_hcl !< Equilibrium vapor pressures (Pa) of HCl |
---|
6060 | REAL(wp) :: zp_hno3 !< Equilibrium vapor pressures (Pa) of HNO3 |
---|
6061 | REAL(wp) :: zp_nh3 !< Equilibrium vapor pressures (Pa) of NH3 |
---|
6062 | REAL(wp) :: zwatertotal !< Total water in particles (mol/m3) |
---|
6063 | |
---|
6064 | REAL(wp), INTENT(in) :: prh !< relative humidity |
---|
6065 | REAL(wp), INTENT(in) :: ptemp !< ambient temperature (K) |
---|
6066 | |
---|
6067 | REAL(wp), DIMENSION(maxspec) :: zgammas !< Activity coefficients |
---|
6068 | REAL(wp), DIMENSION(maxspec) :: zions !< molar concentration of ion (mol/m3) |
---|
6069 | |
---|
6070 | REAL(wp), DIMENSION(nbins_aerosol), INTENT(inout) :: pcg_nh3_eq !< equilibrium molar |
---|
6071 | !< concentration: of NH3 |
---|
6072 | REAL(wp), DIMENSION(nbins_aerosol), INTENT(inout) :: pcg_hno3_eq !< of HNO3 |
---|
6073 | REAL(wp), DIMENSION(nbins_aerosol), INTENT(inout) :: pgamma_hhso4 !< activity coeff. of HHSO4 |
---|
6074 | REAL(wp), DIMENSION(nbins_aerosol), INTENT(inout) :: pgamma_nh4 !< activity coeff. of NH3 |
---|
6075 | REAL(wp), DIMENSION(nbins_aerosol), INTENT(inout) :: pgamma_nh4hso2 !< activity coeff. of NH4HSO2 |
---|
6076 | REAL(wp), DIMENSION(nbins_aerosol), INTENT(inout) :: pgamma_hno3 !< activity coeff. of HNO3 |
---|
6077 | |
---|
6078 | REAL(wp), DIMENSION(nbins_aerosol,maxspec), INTENT(inout) :: pmols !< Ion molalities |
---|
6079 | |
---|
6080 | TYPE(t_section), DIMENSION(nbins_aerosol), INTENT(inout) :: ppart !< Aerosol properties |
---|
6081 | |
---|
6082 | zgammas = 0.0_wp |
---|
6083 | zhlp = 0.0_wp |
---|
6084 | zions = 0.0_wp |
---|
6085 | zp_hcl = 0.0_wp |
---|
6086 | zp_hno3 = 0.0_wp |
---|
6087 | zp_nh3 = 0.0_wp |
---|
6088 | zwatertotal = 0.0_wp |
---|
6089 | |
---|
6090 | DO ib = 1, nbins_aerosol |
---|
6091 | |
---|
6092 | IF ( ppart(ib)%numc < nclim ) CYCLE |
---|
6093 | ! |
---|
6094 | !-- Ion molar concentrations: 2*H2SO4 + CL + NO3 - Na - NH4 |
---|
6095 | zhlp = 2.0_wp * ppart(ib)%volc(1) * arhoh2so4 / amh2so4 + ppart(ib)%volc(5) * arhoss / amss & |
---|
6096 | + ppart(ib)%volc(6) * arhohno3 / amhno3 - ppart(ib)%volc(5) * arhoss / amss - & |
---|
6097 | ppart(ib)%volc(7) * arhonh3 / amnh3 |
---|
6098 | |
---|
6099 | zions(1) = zhlp ! H+ |
---|
6100 | zions(2) = ppart(ib)%volc(7) * arhonh3 / amnh3 ! NH4+ |
---|
6101 | zions(3) = ppart(ib)%volc(5) * arhoss / amss ! Na+ |
---|
6102 | zions(4) = ppart(ib)%volc(1) * arhoh2so4 / amh2so4 ! SO4(2-) |
---|
6103 | zions(5) = 0.0_wp ! HSO4- |
---|
6104 | zions(6) = ppart(ib)%volc(6) * arhohno3 / amhno3 ! NO3- |
---|
6105 | zions(7) = ppart(ib)%volc(5) * arhoss / amss ! Cl- |
---|
6106 | |
---|
6107 | zwatertotal = ppart(ib)%volc(8) * arhoh2o / amh2o |
---|
6108 | IF ( zwatertotal > 1.0E-30_wp ) THEN |
---|
6109 | CALL inorganic_pdfite( prh, ptemp, zions, zwatertotal, zp_hno3, zp_hcl, zp_nh3, zgammas, & |
---|
6110 | pmols(ib,:) ) |
---|
6111 | ENDIF |
---|
6112 | ! |
---|
6113 | !-- Activity coefficients |
---|
6114 | pgamma_hno3(ib) = zgammas(1) ! HNO3 |
---|
6115 | pgamma_nh4(ib) = zgammas(3) ! NH3 |
---|
6116 | pgamma_nh4hso2(ib) = zgammas(6) ! NH4HSO2 |
---|
6117 | pgamma_hhso4(ib) = zgammas(7) ! HHSO4 |
---|
6118 | ! |
---|
6119 | !-- Equilibrium molar concentrations (mol/m3) from equlibrium pressures (Pa) |
---|
6120 | pcg_hno3_eq(ib) = zp_hno3 / ( argas * ptemp ) |
---|
6121 | pcg_nh3_eq(ib) = zp_nh3 / ( argas * ptemp ) |
---|
6122 | |
---|
6123 | ENDDO |
---|
6124 | |
---|
6125 | END SUBROUTINE nitrate_ammonium_equilibrium |
---|
6126 | |
---|
6127 | !------------------------------------------------------------------------------! |
---|
6128 | ! Description: |
---|
6129 | ! ------------ |
---|
6130 | !> Calculate saturation ratios of NH4 and HNO3 for aerosols |
---|
6131 | !------------------------------------------------------------------------------! |
---|
6132 | SUBROUTINE nitrate_ammonium_saturation( ptemp, ppart, pachno3, pacnh4hso2, pachhso4, pchno3eq, & |
---|
6133 | pchno3, pc_nh3, pkelhno3, pkelnh3, psathno3, psatnh3 ) |
---|
6134 | |
---|
6135 | IMPLICIT NONE |
---|
6136 | |
---|
6137 | INTEGER(iwp) :: ib !< running index for aerosol bins |
---|
6138 | |
---|
6139 | REAL(wp) :: k_ll_h2o !< equilibrium constants of equilibrium reactions: |
---|
6140 | !< H2O(aq) <--> H+ + OH- (mol/kg) |
---|
6141 | REAL(wp) :: k_ll_nh3 !< NH3(aq) + H2O(aq) <--> NH4+ + OH- (mol/kg) |
---|
6142 | REAL(wp) :: k_gl_nh3 !< NH3(g) <--> NH3(aq) (mol/kg/atm) |
---|
6143 | REAL(wp) :: k_gl_hno3 !< HNO3(g) <--> H+ + NO3- (mol2/kg2/atm) |
---|
6144 | REAL(wp) :: zmol_no3 !< molality of NO3- (mol/kg) |
---|
6145 | REAL(wp) :: zmol_h !< molality of H+ (mol/kg) |
---|
6146 | REAL(wp) :: zmol_so4 !< molality of SO4(2-) (mol/kg) |
---|
6147 | REAL(wp) :: zmol_cl !< molality of Cl- (mol/kg) |
---|
6148 | REAL(wp) :: zmol_nh4 !< molality of NH4+ (mol/kg) |
---|
6149 | REAL(wp) :: zmol_na !< molality of Na+ (mol/kg) |
---|
6150 | REAL(wp) :: zhlp1 !< intermediate variable |
---|
6151 | REAL(wp) :: zhlp2 !< intermediate variable |
---|
6152 | REAL(wp) :: zhlp3 !< intermediate variable |
---|
6153 | REAL(wp) :: zxi !< particle mole concentration ratio: (NH3+SS)/H2SO4 |
---|
6154 | REAL(wp) :: zt0 !< reference temp |
---|
6155 | |
---|
6156 | REAL(wp), PARAMETER :: a1 = -22.52_wp !< |
---|
6157 | REAL(wp), PARAMETER :: a2 = -1.50_wp !< |
---|
6158 | REAL(wp), PARAMETER :: a3 = 13.79_wp !< |
---|
6159 | REAL(wp), PARAMETER :: a4 = 29.17_wp !< |
---|
6160 | REAL(wp), PARAMETER :: b1 = 26.92_wp !< |
---|
6161 | REAL(wp), PARAMETER :: b2 = 26.92_wp !< |
---|
6162 | REAL(wp), PARAMETER :: b3 = -5.39_wp !< |
---|
6163 | REAL(wp), PARAMETER :: b4 = 16.84_wp !< |
---|
6164 | REAL(wp), PARAMETER :: K01 = 1.01E-14_wp !< |
---|
6165 | REAL(wp), PARAMETER :: K02 = 1.81E-5_wp !< |
---|
6166 | REAL(wp), PARAMETER :: K03 = 57.64_wp !< |
---|
6167 | REAL(wp), PARAMETER :: K04 = 2.51E+6_wp !< |
---|
6168 | |
---|
6169 | REAL(wp), INTENT(in) :: ptemp !< ambient temperature (K) |
---|
6170 | |
---|
6171 | REAL(wp), DIMENSION(nbins_aerosol), INTENT(in) :: pachhso4 !< activity coeff. of HHSO4 |
---|
6172 | REAL(wp), DIMENSION(nbins_aerosol), INTENT(in) :: pacnh4hso2 !< activity coeff. of NH4HSO2 |
---|
6173 | REAL(wp), DIMENSION(nbins_aerosol), INTENT(in) :: pachno3 !< activity coeff. of HNO3 |
---|
6174 | REAL(wp), DIMENSION(nbins_aerosol), INTENT(in) :: pchno3eq !< eq. surface concentration: HNO3 |
---|
6175 | REAL(wp), DIMENSION(nbins_aerosol), INTENT(in) :: pchno3 !< current particle mole |
---|
6176 | !< concentration of HNO3 (mol/m3) |
---|
6177 | REAL(wp), DIMENSION(nbins_aerosol), INTENT(in) :: pc_nh3 !< of NH3 (mol/m3) |
---|
6178 | REAL(wp), DIMENSION(nbins_aerosol), INTENT(in) :: pkelhno3 !< Kelvin effect for HNO3 |
---|
6179 | REAL(wp), DIMENSION(nbins_aerosol), INTENT(in) :: pkelnh3 !< Kelvin effect for NH3 |
---|
6180 | |
---|
6181 | REAL(wp), DIMENSION(nbins_aerosol), INTENT(out) :: psathno3 !< saturation ratio of HNO3 |
---|
6182 | REAL(wp), DIMENSION(nbins_aerosol), INTENT(out) :: psatnh3 !< saturation ratio of NH3 |
---|
6183 | |
---|
6184 | TYPE(t_section), DIMENSION(nbins_aerosol), INTENT(inout) :: ppart !< Aerosol properties |
---|
6185 | |
---|
6186 | zmol_cl = 0.0_wp |
---|
6187 | zmol_h = 0.0_wp |
---|
6188 | zmol_na = 0.0_wp |
---|
6189 | zmol_nh4 = 0.0_wp |
---|
6190 | zmol_no3 = 0.0_wp |
---|
6191 | zmol_so4 = 0.0_wp |
---|
6192 | zt0 = 298.15_wp |
---|
6193 | zxi = 0.0_wp |
---|
6194 | ! |
---|
6195 | !-- Calculates equlibrium rate constants based on Table B.7 in Jacobson (2005): |
---|
6196 | !-- K^ll_H20, K^ll_NH3, K^gl_NH3, K^gl_HNO3 |
---|
6197 | zhlp1 = zt0 / ptemp |
---|
6198 | zhlp2 = zhlp1 - 1.0_wp |
---|
6199 | zhlp3 = 1.0_wp + LOG( zhlp1 ) - zhlp1 |
---|
6200 | |
---|
6201 | k_ll_h2o = K01 * EXP( a1 * zhlp2 + b1 * zhlp3 ) |
---|
6202 | k_ll_nh3 = K02 * EXP( a2 * zhlp2 + b2 * zhlp3 ) |
---|
6203 | k_gl_nh3 = K03 * EXP( a3 * zhlp2 + b3 * zhlp3 ) |
---|
6204 | k_gl_hno3 = K04 * EXP( a4 * zhlp2 + b4 * zhlp3 ) |
---|
6205 | |
---|
6206 | DO ib = 1, nbins_aerosol |
---|
6207 | |
---|
6208 | IF ( ppart(ib)%numc > nclim .AND. ppart(ib)%volc(8) > 1.0E-30_wp ) THEN |
---|
6209 | ! |
---|
6210 | !-- Molality of H+ and NO3- |
---|
6211 | zhlp1 = pc_nh3(ib) * amnh3 + ppart(ib)%volc(1) * arhoh2so4 + ppart(ib)%volc(2) * arhooc & |
---|
6212 | + ppart(ib)%volc(5) * arhoss + ppart(ib)%volc(8) * arhoh2o |
---|
6213 | zmol_no3 = pchno3(ib) / zhlp1 !< mol/kg |
---|
6214 | ! |
---|
6215 | !-- Particle mole concentration ratio: (NH3+SS)/H2SO4 |
---|
6216 | zxi = ( pc_nh3(ib) + ppart(ib)%volc(5) * arhoss / amss ) / ( ppart(ib)%volc(1) * & |
---|
6217 | arhoh2so4 / amh2so4 ) |
---|
6218 | |
---|
6219 | IF ( zxi <= 2.0_wp ) THEN |
---|
6220 | ! |
---|
6221 | !-- Molality of SO4(2-) |
---|
6222 | zhlp1 = pc_nh3(ib) * amnh3 + pchno3(ib) * amhno3 + ppart(ib)%volc(2) * arhooc + & |
---|
6223 | ppart(ib)%volc(5) * arhoss + ppart(ib)%volc(8) * arhoh2o |
---|
6224 | zmol_so4 = ( ppart(ib)%volc(1) * arhoh2so4 / amh2so4 ) / zhlp1 |
---|
6225 | ! |
---|
6226 | !-- Molality of Cl- |
---|
6227 | zhlp1 = pc_nh3(ib) * amnh3 + pchno3(ib) * amhno3 + ppart(ib)%volc(2) * arhooc + & |
---|
6228 | ppart(ib)%volc(1) * arhoh2so4 + ppart(ib)%volc(8) * arhoh2o |
---|
6229 | zmol_cl = ( ppart(ib)%volc(5) * arhoss / amss ) / zhlp1 |
---|
6230 | ! |
---|
6231 | !-- Molality of NH4+ |
---|
6232 | zhlp1 = pchno3(ib) * amhno3 + ppart(ib)%volc(1) * arhoh2so4 + ppart(ib)%volc(2) * & |
---|
6233 | arhooc + ppart(ib)%volc(5) * arhoss + ppart(ib)%volc(8) * arhoh2o |
---|
6234 | zmol_nh4 = pc_nh3(ib) / zhlp1 |
---|
6235 | ! |
---|
6236 | !-- Molality of Na+ |
---|
6237 | zmol_na = zmol_cl |
---|
6238 | ! |
---|
6239 | !-- Molality of H+ |
---|
6240 | zmol_h = 2.0_wp * zmol_so4 + zmol_no3 + zmol_cl - ( zmol_nh4 + zmol_na ) |
---|
6241 | |
---|
6242 | ELSE |
---|
6243 | |
---|
6244 | zhlp2 = pkelhno3(ib) * zmol_no3 * pachno3(ib)**2 |
---|
6245 | |
---|
6246 | IF ( zhlp2 > 1.0E-30_wp ) THEN |
---|
6247 | zmol_h = k_gl_hno3 * pchno3eq(ib) / zhlp2 ! Eq. 17.38 |
---|
6248 | ELSE |
---|
6249 | zmol_h = 0.0_wp |
---|
6250 | ENDIF |
---|
6251 | |
---|
6252 | ENDIF |
---|
6253 | |
---|
6254 | zhlp1 = ppart(ib)%volc(8) * arhoh2o * argas * ptemp * k_gl_hno3 |
---|
6255 | ! |
---|
6256 | !-- Saturation ratio for NH3 and for HNO3 |
---|
6257 | IF ( zmol_h > 0.0_wp ) THEN |
---|
6258 | zhlp2 = pkelnh3(ib) / ( zhlp1 * zmol_h ) |
---|
6259 | zhlp3 = k_ll_h2o / ( k_ll_nh3 + k_gl_nh3 ) |
---|
6260 | psatnh3(ib) = zhlp2 * ( ( pacnh4hso2(ib) / pachhso4(ib) )**2 ) * zhlp3 |
---|
6261 | psathno3(ib) = ( pkelhno3(ib) * zmol_h * pachno3(ib)**2 ) / zhlp1 |
---|
6262 | ELSE |
---|
6263 | psatnh3(ib) = 1.0_wp |
---|
6264 | psathno3(ib) = 1.0_wp |
---|
6265 | ENDIF |
---|
6266 | ELSE |
---|
6267 | psatnh3(ib) = 1.0_wp |
---|
6268 | psathno3(ib) = 1.0_wp |
---|
6269 | ENDIF |
---|
6270 | |
---|
6271 | ENDDO |
---|
6272 | |
---|
6273 | END SUBROUTINE nitrate_ammonium_saturation |
---|
6274 | |
---|
6275 | !------------------------------------------------------------------------------! |
---|
6276 | ! Description: |
---|
6277 | ! ------------ |
---|
6278 | !> Prototype module for calculating the water content of a mixed inorganic/ |
---|
6279 | !> organic particle + equilibrium water vapour pressure above the solution |
---|
6280 | !> (HNO3, HCL, NH3 and representative organic compounds. Efficient calculation |
---|
6281 | !> of the partitioning of species between gas and aerosol. Based in a chamber |
---|
6282 | !> study. |
---|
6283 | ! |
---|
6284 | !> Written by Dave Topping. Pure organic component properties predicted by Mark |
---|
6285 | !> Barley based on VOCs predicted in MCM simulations performed by Mike Jenkin. |
---|
6286 | !> Delivered by Gordon McFiggans as Deliverable D22 from WP1.4 in the EU FP6 |
---|
6287 | !> EUCAARI Integrated Project. |
---|
6288 | ! |
---|
6289 | !> REFERENCES |
---|
6290 | !> Clegg et al. (1998) A Thermodynamic Model of the System H+-NH4+-Na+-SO42- -NO3--Cl--H2O at |
---|
6291 | !> 298.15 K, J. Phys. Chem., 102A, 2155-2171. |
---|
6292 | !> Clegg et al. (2001) Thermodynamic modelling of aqueous aerosols containing electrolytes and |
---|
6293 | !> dissolved organic compounds. Journal of Aerosol Science 2001;32(6):713-738. |
---|
6294 | !> Topping et al. (2005a) A curved multi-component aerosol hygroscopicity model framework: Part 1 - |
---|
6295 | !> Inorganic compounds. Atmospheric Chemistry and Physics 2005;5:1205-1222. |
---|
6296 | !> Topping et al. (2005b) A curved multi-component aerosol hygroscopicity model framework: Part 2 - |
---|
6297 | !> Including organic compounds. Atmospheric Chemistry and Physics 2005;5:1223-1242. |
---|
6298 | !> Wagman et al. (1982). The NBS tables of chemical thermodynamic properties: selected values for |
---|
6299 | !> inorganic and Câ and Câ organic substances in SI units (book) |
---|
6300 | !> Zaveri et al. (2005). A new method for multicomponent activity coefficients of electrolytes in |
---|
6301 | !> aqueous atmospheric aerosols, JGR, 110, D02201, 2005. |
---|
6302 | ! |
---|
6303 | !> Queries concerning the use of this code through Gordon McFiggans, |
---|
6304 | !> g.mcfiggans@manchester.ac.uk, |
---|
6305 | !> Ownership: D. Topping, Centre for Atmospheric Sciences, University of |
---|
6306 | !> Manchester, 2007 |
---|
6307 | ! |
---|
6308 | !> Rewritten to PALM by Mona Kurppa, UHel, 2017 |
---|
6309 | !------------------------------------------------------------------------------! |
---|
6310 | SUBROUTINE inorganic_pdfite( rh, temp, ions, water_total, press_hno3, press_hcl, press_nh3, & |
---|
6311 | gamma_out, mols_out ) |
---|
6312 | |
---|
6313 | IMPLICIT NONE |
---|
6314 | |
---|
6315 | INTEGER(iwp) :: binary_case |
---|
6316 | INTEGER(iwp) :: full_complexity |
---|
6317 | |
---|
6318 | REAL(wp) :: a !< auxiliary variable |
---|
6319 | REAL(wp) :: act_product !< ionic activity coef. product: |
---|
6320 | !< = (gamma_h2so4**3d0) / gamma_hhso4**2d0) |
---|
6321 | REAL(wp) :: ammonium_chloride !< |
---|
6322 | REAL(wp) :: ammonium_chloride_eq_frac !< |
---|
6323 | REAL(wp) :: ammonium_nitrate !< |
---|
6324 | REAL(wp) :: ammonium_nitrate_eq_frac !< |
---|
6325 | REAL(wp) :: ammonium_sulphate !< |
---|
6326 | REAL(wp) :: ammonium_sulphate_eq_frac !< |
---|
6327 | REAL(wp) :: b !< auxiliary variable |
---|
6328 | REAL(wp) :: binary_h2so4 !< binary H2SO4 activity coeff. |
---|
6329 | REAL(wp) :: binary_hcl !< binary HCL activity coeff. |
---|
6330 | REAL(wp) :: binary_hhso4 !< binary HHSO4 activity coeff. |
---|
6331 | REAL(wp) :: binary_hno3 !< binary HNO3 activity coeff. |
---|
6332 | REAL(wp) :: binary_nh4hso4 !< binary NH4HSO4 activity coeff. |
---|
6333 | REAL(wp) :: c !< auxiliary variable |
---|
6334 | REAL(wp) :: charge_sum !< sum of ionic charges |
---|
6335 | REAL(wp) :: gamma_h2so4 !< activity coefficient |
---|
6336 | REAL(wp) :: gamma_hcl !< activity coefficient |
---|
6337 | REAL(wp) :: gamma_hhso4 !< activity coeffient |
---|
6338 | REAL(wp) :: gamma_hno3 !< activity coefficient |
---|
6339 | REAL(wp) :: gamma_nh3 !< activity coefficient |
---|
6340 | REAL(wp) :: gamma_nh4hso4 !< activity coefficient |
---|
6341 | REAL(wp) :: h_out !< |
---|
6342 | REAL(wp) :: h_real !< new hydrogen ion conc. |
---|
6343 | REAL(wp) :: h2so4_hcl !< contribution of H2SO4 |
---|
6344 | REAL(wp) :: h2so4_hno3 !< contribution of H2SO4 |
---|
6345 | REAL(wp) :: h2so4_nh3 !< contribution of H2SO4 |
---|
6346 | REAL(wp) :: h2so4_nh4hso4 !< contribution of H2SO4 |
---|
6347 | REAL(wp) :: hcl_h2so4 !< contribution of HCL |
---|
6348 | REAL(wp) :: hcl_hhso4 !< contribution of HCL |
---|
6349 | REAL(wp) :: hcl_hno3 !< contribution of HCL |
---|
6350 | REAL(wp) :: hcl_nh4hso4 !< contribution of HCL |
---|
6351 | REAL(wp) :: henrys_temp_dep !< temperature dependence of Henry's Law |
---|
6352 | REAL(wp) :: hno3_h2so4 !< contribution of HNO3 |
---|
6353 | REAL(wp) :: hno3_hcl !< contribution of HNO3 |
---|
6354 | REAL(wp) :: hno3_hhso4 !< contribution of HNO3 |
---|
6355 | REAL(wp) :: hno3_nh3 !< contribution of HNO3 |
---|
6356 | REAL(wp) :: hno3_nh4hso4 !< contribution of HNO3 |
---|
6357 | REAL(wp) :: hso4_out !< |
---|
6358 | REAL(wp) :: hso4_real !< new bisulphate ion conc. |
---|
6359 | REAL(wp) :: hydrochloric_acid !< |
---|
6360 | REAL(wp) :: hydrochloric_acid_eq_frac !< |
---|
6361 | REAL(wp) :: k_h !< equilibrium constant for H+ |
---|
6362 | REAL(wp) :: k_hcl !< equilibrium constant of HCL |
---|
6363 | REAL(wp) :: k_hno3 !< equilibrium constant of HNO3 |
---|
6364 | REAL(wp) :: k_nh4 !< equilibrium constant for NH4+ |
---|
6365 | REAL(wp) :: k_h2o !< equil. const. for water_surface |
---|
6366 | REAL(wp) :: ln_h2so4_act !< gamma_h2so4 = EXP(ln_h2so4_act) |
---|
6367 | REAL(wp) :: ln_HCL_act !< gamma_hcl = EXP( ln_HCL_act ) |
---|
6368 | REAL(wp) :: ln_hhso4_act !< gamma_hhso4 = EXP(ln_hhso4_act) |
---|
6369 | REAL(wp) :: ln_hno3_act !< gamma_hno3 = EXP( ln_hno3_act ) |
---|
6370 | REAL(wp) :: ln_nh4hso4_act !< gamma_nh4hso4 = EXP( ln_nh4hso4_act ) |
---|
6371 | REAL(wp) :: molality_ratio_nh3 !< molality ratio of NH3 (NH4+ and H+) |
---|
6372 | REAL(wp) :: na2so4_h2so4 !< contribution of Na2SO4 |
---|
6373 | REAL(wp) :: na2so4_hcl !< contribution of Na2SO4 |
---|
6374 | REAL(wp) :: na2so4_hhso4 !< contribution of Na2SO4 |
---|
6375 | REAL(wp) :: na2so4_hno3 !< contribution of Na2SO4 |
---|
6376 | REAL(wp) :: na2so4_nh3 !< contribution of Na2SO4 |
---|
6377 | REAL(wp) :: na2so4_nh4hso4 !< contribution of Na2SO4 |
---|
6378 | REAL(wp) :: nacl_h2so4 !< contribution of NaCl |
---|
6379 | REAL(wp) :: nacl_hcl !< contribution of NaCl |
---|
6380 | REAL(wp) :: nacl_hhso4 !< contribution of NaCl |
---|
6381 | REAL(wp) :: nacl_hno3 !< contribution of NaCl |
---|
6382 | REAL(wp) :: nacl_nh3 !< contribution of NaCl |
---|
6383 | REAL(wp) :: nacl_nh4hso4 !< contribution of NaCl |
---|
6384 | REAL(wp) :: nano3_h2so4 !< contribution of NaNO3 |
---|
6385 | REAL(wp) :: nano3_hcl !< contribution of NaNO3 |
---|
6386 | REAL(wp) :: nano3_hhso4 !< contribution of NaNO3 |
---|
6387 | REAL(wp) :: nano3_hno3 !< contribution of NaNO3 |
---|
6388 | REAL(wp) :: nano3_nh3 !< contribution of NaNO3 |
---|
6389 | REAL(wp) :: nano3_nh4hso4 !< contribution of NaNO3 |
---|
6390 | REAL(wp) :: nh42so4_h2so4 !< contribution of NH42SO4 |
---|
6391 | REAL(wp) :: nh42so4_hcl !< contribution of NH42SO4 |
---|
6392 | REAL(wp) :: nh42so4_hhso4 !< contribution of NH42SO4 |
---|
6393 | REAL(wp) :: nh42so4_hno3 !< contribution of NH42SO4 |
---|
6394 | REAL(wp) :: nh42so4_nh3 !< contribution of NH42SO4 |
---|
6395 | REAL(wp) :: nh42so4_nh4hso4 !< contribution of NH42SO4 |
---|
6396 | REAL(wp) :: nh4cl_h2so4 !< contribution of NH4Cl |
---|
6397 | REAL(wp) :: nh4cl_hcl !< contribution of NH4Cl |
---|
6398 | REAL(wp) :: nh4cl_hhso4 !< contribution of NH4Cl |
---|
6399 | REAL(wp) :: nh4cl_hno3 !< contribution of NH4Cl |
---|
6400 | REAL(wp) :: nh4cl_nh3 !< contribution of NH4Cl |
---|
6401 | REAL(wp) :: nh4cl_nh4hso4 !< contribution of NH4Cl |
---|
6402 | REAL(wp) :: nh4no3_h2so4 !< contribution of NH4NO3 |
---|
6403 | REAL(wp) :: nh4no3_hcl !< contribution of NH4NO3 |
---|
6404 | REAL(wp) :: nh4no3_hhso4 !< contribution of NH4NO3 |
---|
6405 | REAL(wp) :: nh4no3_hno3 !< contribution of NH4NO3 |
---|
6406 | REAL(wp) :: nh4no3_nh3 !< contribution of NH4NO3 |
---|
6407 | REAL(wp) :: nh4no3_nh4hso4 !< contribution of NH4NO3 |
---|
6408 | REAL(wp) :: nitric_acid !< |
---|
6409 | REAL(wp) :: nitric_acid_eq_frac !< Equivalent fractions |
---|
6410 | REAL(wp) :: press_hcl !< partial pressure of HCL |
---|
6411 | REAL(wp) :: press_hno3 !< partial pressure of HNO3 |
---|
6412 | REAL(wp) :: press_nh3 !< partial pressure of NH3 |
---|
6413 | REAL(wp) :: rh !< relative humidity [0-1] |
---|
6414 | REAL(wp) :: root1 !< auxiliary variable |
---|
6415 | REAL(wp) :: root2 !< auxiliary variable |
---|
6416 | REAL(wp) :: so4_out !< |
---|
6417 | REAL(wp) :: so4_real !< new sulpate ion concentration |
---|
6418 | REAL(wp) :: sodium_chloride !< |
---|
6419 | REAL(wp) :: sodium_chloride_eq_frac !< |
---|
6420 | REAL(wp) :: sodium_nitrate !< |
---|
6421 | REAL(wp) :: sodium_nitrate_eq_frac !< |
---|
6422 | REAL(wp) :: sodium_sulphate !< |
---|
6423 | REAL(wp) :: sodium_sulphate_eq_frac !< |
---|
6424 | REAL(wp) :: solutes !< |
---|
6425 | REAL(wp) :: sulphuric_acid !< |
---|
6426 | REAL(wp) :: sulphuric_acid_eq_frac !< |
---|
6427 | REAL(wp) :: temp !< temperature |
---|
6428 | REAL(wp) :: water_total !< |
---|
6429 | |
---|
6430 | REAL(wp), DIMENSION(:) :: gamma_out !< Activity coefficient for calculating the non-ideal |
---|
6431 | !< dissociation constants |
---|
6432 | !< 1: HNO3, 2: HCL, 3: NH4+/H+ (NH3), 4: HHSO4**2/H2SO4, |
---|
6433 | !< 5: H2SO4**3/HHSO4**2, 6: NH4HSO2, 7: HHSO4 |
---|
6434 | REAL(wp), DIMENSION(:) :: ions !< ion molarities (mol/m3): 1: H+, 2: NH4+, 3: Na+, |
---|
6435 | !< 4: SO4(2-), 5: HSO4-, 6: NO3-, 7: Cl- |
---|
6436 | REAL(wp), DIMENSION(7) :: ions_mol !< ion molalities (mol/kg): 1: H+, 2: NH4+, 3: Na+, |
---|
6437 | !< 4: SO4(2-), 5: HSO4-, 6: NO3-, 7: Cl- |
---|
6438 | REAL(wp), DIMENSION(:) :: mols_out !< ion molality output (mol/kg): 1: H+, 2: NH4+, 3: Na+, |
---|
6439 | !< 4: SO4(2-), 5: HSO4-, 6: NO3-, 7: Cl- |
---|
6440 | ! |
---|
6441 | !-- Value initialisation |
---|
6442 | binary_h2so4 = 0.0_wp |
---|
6443 | binary_hcl = 0.0_wp |
---|
6444 | binary_hhso4 = 0.0_wp |
---|
6445 | binary_hno3 = 0.0_wp |
---|
6446 | binary_nh4hso4 = 0.0_wp |
---|
6447 | henrys_temp_dep = ( 1.0_wp / temp - 0.0033557_wp ) ! 1/T - 1/298 K |
---|
6448 | hcl_hno3 = 1.0_wp |
---|
6449 | h2so4_hno3 = 1.0_wp |
---|
6450 | nh42so4_hno3 = 1.0_wp |
---|
6451 | nh4no3_hno3 = 1.0_wp |
---|
6452 | nh4cl_hno3 = 1.0_wp |
---|
6453 | na2so4_hno3 = 1.0_wp |
---|
6454 | nano3_hno3 = 1.0_wp |
---|
6455 | nacl_hno3 = 1.0_wp |
---|
6456 | hno3_hcl = 1.0_wp |
---|
6457 | h2so4_hcl = 1.0_wp |
---|
6458 | nh42so4_hcl = 1.0_wp |
---|
6459 | nh4no3_hcl = 1.0_wp |
---|
6460 | nh4cl_hcl = 1.0_wp |
---|
6461 | na2so4_hcl = 1.0_wp |
---|
6462 | nano3_hcl = 1.0_wp |
---|
6463 | nacl_hcl = 1.0_wp |
---|
6464 | hno3_nh3 = 1.0_wp |
---|
6465 | h2so4_nh3 = 1.0_wp |
---|
6466 | nh42so4_nh3 = 1.0_wp |
---|
6467 | nh4no3_nh3 = 1.0_wp |
---|
6468 | nh4cl_nh3 = 1.0_wp |
---|
6469 | na2so4_nh3 = 1.0_wp |
---|
6470 | nano3_nh3 = 1.0_wp |
---|
6471 | nacl_nh3 = 1.0_wp |
---|
6472 | hno3_hhso4 = 1.0_wp |
---|
6473 | hcl_hhso4 = 1.0_wp |
---|
6474 | nh42so4_hhso4 = 1.0_wp |
---|
6475 | nh4no3_hhso4 = 1.0_wp |
---|
6476 | nh4cl_hhso4 = 1.0_wp |
---|
6477 | na2so4_hhso4 = 1.0_wp |
---|
6478 | nano3_hhso4 = 1.0_wp |
---|
6479 | nacl_hhso4 = 1.0_wp |
---|
6480 | hno3_h2so4 = 1.0_wp |
---|
6481 | hcl_h2so4 = 1.0_wp |
---|
6482 | nh42so4_h2so4 = 1.0_wp |
---|
6483 | nh4no3_h2so4 = 1.0_wp |
---|
6484 | nh4cl_h2so4 = 1.0_wp |
---|
6485 | na2so4_h2so4 = 1.0_wp |
---|
6486 | nano3_h2so4 = 1.0_wp |
---|
6487 | nacl_h2so4 = 1.0_wp |
---|
6488 | ! |
---|
6489 | !-- New NH3 variables |
---|
6490 | hno3_nh4hso4 = 1.0_wp |
---|
6491 | hcl_nh4hso4 = 1.0_wp |
---|
6492 | h2so4_nh4hso4 = 1.0_wp |
---|
6493 | nh42so4_nh4hso4 = 1.0_wp |
---|
6494 | nh4no3_nh4hso4 = 1.0_wp |
---|
6495 | nh4cl_nh4hso4 = 1.0_wp |
---|
6496 | na2so4_nh4hso4 = 1.0_wp |
---|
6497 | nano3_nh4hso4 = 1.0_wp |
---|
6498 | nacl_nh4hso4 = 1.0_wp |
---|
6499 | ! |
---|
6500 | !-- Juha Tonttila added |
---|
6501 | mols_out = 0.0_wp |
---|
6502 | press_hno3 = 0.0_wp !< Initialising vapour pressures over the |
---|
6503 | press_hcl = 0.0_wp !< multicomponent particle |
---|
6504 | press_nh3 = 0.0_wp |
---|
6505 | gamma_out = 1.0_wp !< i.e. don't alter the ideal mixing ratios if there's nothing there. |
---|
6506 | ! |
---|
6507 | !-- 1) - COMPOSITION DEFINITIONS |
---|
6508 | ! |
---|
6509 | !-- a) Inorganic ion pairing: |
---|
6510 | !-- In order to calculate the water content, which is also used in calculating vapour pressures, one |
---|
6511 | !-- needs to pair the anions and cations for use in the ZSR mixing rule. The equation provided by |
---|
6512 | !-- Clegg et al. (2001) is used for ion pairing. The solutes chosen comprise of 9 inorganic salts |
---|
6513 | !-- and acids which provide a pairing between each anion and cation: (NH4)2SO4, NH4NO3, NH4Cl, |
---|
6514 | !-- Na2SO4, NaNO3, NaCl, H2SO4, HNO3, HCL. The organic compound is treated as a seperate solute. |
---|
6515 | !-- Ions: 1: H+, 2: NH4+, 3: Na+, 4: SO4(2-), 5: HSO4-, 6: NO3-, 7: Cl- |
---|
6516 | ! |
---|
6517 | charge_sum = ions(1) + ions(2) + ions(3) + 2.0_wp * ions(4) + ions(5) + ions(6) + ions(7) |
---|
6518 | nitric_acid = ( 2.0_wp * ions(1) * ions(6) ) / charge_sum |
---|
6519 | hydrochloric_acid = ( 2.0_wp * ions(1) * ions(7) ) / charge_sum |
---|
6520 | sulphuric_acid = ( 2.0_wp * ions(1) * ions(4) ) / charge_sum |
---|
6521 | ammonium_sulphate = ( 2.0_wp * ions(2) * ions(4) ) / charge_sum |
---|
6522 | ammonium_nitrate = ( 2.0_wp * ions(2) * ions(6) ) / charge_sum |
---|
6523 | ammonium_chloride = ( 2.0_wp * ions(2) * ions(7) ) / charge_sum |
---|
6524 | sodium_sulphate = ( 2.0_wp * ions(3) * ions(4) ) / charge_sum |
---|
6525 | sodium_nitrate = ( 2.0_wp * ions(3) * ions(6) ) / charge_sum |
---|
6526 | sodium_chloride = ( 2.0_wp * ions(3) * ions(7) ) / charge_sum |
---|
6527 | solutes = 0.0_wp |
---|
6528 | solutes = 3.0_wp * sulphuric_acid + 2.0_wp * hydrochloric_acid + 2.0_wp * nitric_acid + & |
---|
6529 | 3.0_wp * ammonium_sulphate + 2.0_wp * ammonium_nitrate + 2.0_wp * ammonium_chloride +& |
---|
6530 | 3.0_wp * sodium_sulphate + 2.0_wp * sodium_nitrate + 2.0_wp * sodium_chloride |
---|
6531 | ! |
---|
6532 | !-- b) Inorganic equivalent fractions: |
---|
6533 | !-- These values are calculated so that activity coefficients can be expressed by a linear additive |
---|
6534 | !-- rule, thus allowing more efficient calculations and future expansion (see more detailed |
---|
6535 | !-- description below) |
---|
6536 | nitric_acid_eq_frac = 2.0_wp * nitric_acid / solutes |
---|
6537 | hydrochloric_acid_eq_frac = 2.0_wp * hydrochloric_acid / solutes |
---|
6538 | sulphuric_acid_eq_frac = 3.0_wp * sulphuric_acid / solutes |
---|
6539 | ammonium_sulphate_eq_frac = 3.0_wp * ammonium_sulphate / solutes |
---|
6540 | ammonium_nitrate_eq_frac = 2.0_wp * ammonium_nitrate / solutes |
---|
6541 | ammonium_chloride_eq_frac = 2.0_wp * ammonium_chloride / solutes |
---|
6542 | sodium_sulphate_eq_frac = 3.0_wp * sodium_sulphate / solutes |
---|
6543 | sodium_nitrate_eq_frac = 2.0_wp * sodium_nitrate / solutes |
---|
6544 | sodium_chloride_eq_frac = 2.0_wp * sodium_chloride / solutes |
---|
6545 | ! |
---|
6546 | !-- Inorganic ion molalities |
---|
6547 | ions_mol(1) = ions(1) / ( water_total * 18.01528E-3_wp ) ! H+ |
---|
6548 | ions_mol(2) = ions(2) / ( water_total * 18.01528E-3_wp ) ! NH4+ |
---|
6549 | ions_mol(3) = ions(3) / ( water_total * 18.01528E-3_wp ) ! Na+ |
---|
6550 | ions_mol(4) = ions(4) / ( water_total * 18.01528E-3_wp ) ! SO4(2-) |
---|
6551 | ions_mol(5) = ions(5) / ( water_total * 18.01528E-3_wp ) ! HSO4(2-) |
---|
6552 | ions_mol(6) = ions(6) / ( water_total * 18.01528E-3_wp ) ! NO3- |
---|
6553 | ions_mol(7) = ions(7) / ( water_total * 18.01528E-3_wp ) ! Cl- |
---|
6554 | |
---|
6555 | !-- *** |
---|
6556 | !-- At this point we may need to introduce a method for prescribing H+ when there is no 'real' value |
---|
6557 | !-- for H+..i.e. in the sulphate poor domain. This will give a value for solve quadratic proposed by |
---|
6558 | !-- Zaveri et al. 2005 |
---|
6559 | ! |
---|
6560 | !-- 2) - WATER CALCULATION |
---|
6561 | ! |
---|
6562 | !-- a) The water content is calculated using the ZSR rule with solute concentrations calculated |
---|
6563 | !-- using 1a above. Whilst the usual approximation of ZSR relies on binary data consisting of 5th or |
---|
6564 | !-- higher order polynomials, in this code 4 different RH regimes are used, each housing cubic |
---|
6565 | !-- equations for the water associated with each solute listed above. Binary water contents for |
---|
6566 | !-- inorganic components were calculated using AIM online (Clegg et al 1998). The water associated |
---|
6567 | !-- with the organic compound is calculated assuming ideality and that aw = RH. |
---|
6568 | ! |
---|
6569 | !-- b) Molality of each inorganic ion and organic solute (initial input) is calculated for use in |
---|
6570 | !-- vapour pressure calculation. |
---|
6571 | ! |
---|
6572 | !-- 3) - BISULPHATE ION DISSOCIATION CALCULATION |
---|
6573 | ! |
---|
6574 | !-- The dissociation of the bisulphate ion is calculated explicitly. A solution to the equilibrium |
---|
6575 | !-- equation between the bisulphate ion, hydrogen ion and sulphate ion is found using tabulated |
---|
6576 | !-- equilibrium constants (referenced). It is necessary to calculate the activity coefficients of |
---|
6577 | !-- HHSO4 and H2SO4 in a non-iterative manner. These are calculated using the same format as |
---|
6578 | !-- described in 4) below, where both activity coefficients were fit to the output from ADDEM |
---|
6579 | !-- (Topping et al 2005a,b) covering an extensive composition space, providing the activity |
---|
6580 | !-- coefficients and bisulphate ion dissociation as a function of equivalent mole fractions and |
---|
6581 | !-- relative humidity. |
---|
6582 | ! |
---|
6583 | !-- NOTE: the flags "binary_case" and "full_complexity" are not used in this prototype. They are |
---|
6584 | !-- used for simplification of the fit expressions when using limited composition regions. This |
---|
6585 | !-- section of code calculates the bisulphate ion concentration. |
---|
6586 | ! |
---|
6587 | IF ( ions(1) > 0.0_wp .AND. ions(4) > 0.0_wp ) THEN |
---|
6588 | ! |
---|
6589 | !-- HHSO4: |
---|
6590 | binary_case = 1 |
---|
6591 | IF ( rh > 0.1_wp .AND. rh < 0.9_wp ) THEN |
---|
6592 | binary_hhso4 = -4.9521_wp * rh**3 + 9.2881_wp * rh**2 - 10.777_wp * rh + 6.0534_wp |
---|
6593 | ELSEIF ( rh >= 0.9_wp .AND. rh < 0.955_wp ) THEN |
---|
6594 | binary_hhso4 = -6.3777_wp * rh + 5.962_wp |
---|
6595 | ELSEIF ( rh >= 0.955_wp .AND. rh < 0.99_wp ) THEN |
---|
6596 | binary_hhso4 = 2367.2_wp * rh**3 - 6849.7_wp * rh**2 + 6600.9_wp * rh - 2118.7_wp |
---|
6597 | ELSEIF ( rh >= 0.99_wp .AND. rh < 0.9999_wp ) THEN |
---|
6598 | binary_hhso4 = 3E-7_wp * rh**5 - 2E-5_wp * rh**4 + 0.0004_wp * rh**3 - 0.0035_wp * rh**2 & |
---|
6599 | + 0.0123_wp * rh - 0.3025_wp |
---|
6600 | ENDIF |
---|
6601 | |
---|
6602 | IF ( nitric_acid > 0.0_wp ) THEN |
---|
6603 | hno3_hhso4 = -4.2204_wp * rh**4 + 12.193_wp * rh**3 - 12.481_wp * rh**2 + 6.459_wp * rh & |
---|
6604 | - 1.9004_wp |
---|
6605 | ENDIF |
---|
6606 | |
---|
6607 | IF ( hydrochloric_acid > 0.0_wp ) THEN |
---|
6608 | hcl_hhso4 = -54.845_wp * rh**7 + 209.54_wp * rh**6 - 336.59_wp * rh**5 + 294.21_wp * & |
---|
6609 | rh**4 - 150.07_wp * rh**3 + 43.767_wp * rh**2 - 6.5495_wp * rh + 0.60048_wp |
---|
6610 | ENDIF |
---|
6611 | |
---|
6612 | IF ( ammonium_sulphate > 0.0_wp ) THEN |
---|
6613 | nh42so4_hhso4 = 16.768_wp * rh**3 - 28.75_wp * rh**2 + 20.011_wp * rh - 8.3206_wp |
---|
6614 | ENDIF |
---|
6615 | |
---|
6616 | IF ( ammonium_nitrate > 0.0_wp ) THEN |
---|
6617 | nh4no3_hhso4 = -17.184_wp * rh**4 + 56.834_wp * rh**3 - 65.765_wp * rh**2 + & |
---|
6618 | 35.321_wp * rh - 9.252_wp |
---|
6619 | ENDIF |
---|
6620 | |
---|
6621 | IF (ammonium_chloride > 0.0_wp ) THEN |
---|
6622 | IF ( rh < 0.2_wp .AND. rh >= 0.1_wp ) THEN |
---|
6623 | nh4cl_hhso4 = 3.2809_wp * rh - 2.0637_wp |
---|
6624 | ELSEIF ( rh >= 0.2_wp .AND. rh < 0.99_wp ) THEN |
---|
6625 | nh4cl_hhso4 = -1.2981_wp * rh**3 + 4.7461_wp * rh**2 - 2.3269_wp * rh - 1.1259_wp |
---|
6626 | ENDIF |
---|
6627 | ENDIF |
---|
6628 | |
---|
6629 | IF ( sodium_sulphate > 0.0_wp ) THEN |
---|
6630 | na2so4_hhso4 = 118.87_wp * rh**6 - 358.63_wp * rh**5 + 435.85_wp * rh**4 - 272.88_wp * & |
---|
6631 | rh**3 + 94.411_wp * rh**2 - 18.21_wp * rh + 0.45935_wp |
---|
6632 | ENDIF |
---|
6633 | |
---|
6634 | IF ( sodium_nitrate > 0.0_wp ) THEN |
---|
6635 | IF ( rh < 0.2_wp .AND. rh >= 0.1_wp ) THEN |
---|
6636 | nano3_hhso4 = 4.8456_wp * rh - 2.5773_wp |
---|
6637 | ELSEIF ( rh >= 0.2_wp .AND. rh < 0.99_wp ) THEN |
---|
6638 | nano3_hhso4 = 0.5964_wp * rh**3 - 0.38967_wp * rh**2 + 1.7918_wp * rh - 1.9691_wp |
---|
6639 | ENDIF |
---|
6640 | ENDIF |
---|
6641 | |
---|
6642 | IF ( sodium_chloride > 0.0_wp ) THEN |
---|
6643 | IF ( rh < 0.2_wp ) THEN |
---|
6644 | nacl_hhso4 = 0.51995_wp * rh - 1.3981_wp |
---|
6645 | ELSEIF ( rh >= 0.2_wp .AND. rh < 0.99_wp ) THEN |
---|
6646 | nacl_hhso4 = 1.6539_wp * rh - 1.6101_wp |
---|
6647 | ENDIF |
---|
6648 | ENDIF |
---|
6649 | |
---|
6650 | ln_hhso4_act = binary_hhso4 + nitric_acid_eq_frac * hno3_hhso4 + & |
---|
6651 | hydrochloric_acid_eq_frac * hcl_hhso4 + & |
---|
6652 | ammonium_sulphate_eq_frac * nh42so4_hhso4 + & |
---|
6653 | ammonium_nitrate_eq_frac * nh4no3_hhso4 + & |
---|
6654 | ammonium_chloride_eq_frac * nh4cl_hhso4 + & |
---|
6655 | sodium_sulphate_eq_frac * na2so4_hhso4 + & |
---|
6656 | sodium_nitrate_eq_frac * nano3_hhso4 + sodium_chloride_eq_frac * nacl_hhso4 |
---|
6657 | |
---|
6658 | gamma_hhso4 = EXP( ln_hhso4_act ) ! molal activity coefficient of HHSO4 |
---|
6659 | |
---|
6660 | !-- H2SO4 (sulphuric acid): |
---|
6661 | IF ( rh >= 0.1_wp .AND. rh < 0.9_wp ) THEN |
---|
6662 | binary_h2so4 = 2.4493_wp * rh**2 - 6.2326_wp * rh + 2.1763_wp |
---|
6663 | ELSEIF ( rh >= 0.9_wp .AND. rh < 0.98 ) THEN |
---|
6664 | binary_h2so4 = 914.68_wp * rh**3 - 2502.3_wp * rh**2 + 2281.9_wp * rh - 695.11_wp |
---|
6665 | ELSEIF ( rh >= 0.98 .AND. rh < 0.9999 ) THEN |
---|
6666 | binary_h2so4 = 3.0E-8_wp * rh**4 - 5E-6_wp * rh**3 + 0.0003_wp * rh**2 - 0.0022_wp * & |
---|
6667 | rh - 1.1305_wp |
---|
6668 | ENDIF |
---|
6669 | |
---|
6670 | IF ( nitric_acid > 0.0_wp ) THEN |
---|
6671 | hno3_h2so4 = - 16.382_wp * rh**5 + 46.677_wp * rh**4 - 54.149_wp * rh**3 + 34.36_wp * & |
---|
6672 | rh**2 - 12.54_wp * rh + 2.1368_wp |
---|
6673 | ENDIF |
---|
6674 | |
---|
6675 | IF ( hydrochloric_acid > 0.0_wp ) THEN |
---|
6676 | hcl_h2so4 = - 14.409_wp * rh**5 + 42.804_wp * rh**4 - 47.24_wp * rh**3 + 24.668_wp * & |
---|
6677 | rh**2 - 5.8015_wp * rh + 0.084627_wp |
---|
6678 | ENDIF |
---|
6679 | |
---|
6680 | IF ( ammonium_sulphate > 0.0_wp ) THEN |
---|
6681 | nh42so4_h2so4 = 66.71_wp * rh**5 - 187.5_wp * rh**4 + 210.57_wp * rh**3 - 121.04_wp * & |
---|
6682 | rh**2 + 39.182_wp * rh - 8.0606_wp |
---|
6683 | ENDIF |
---|
6684 | |
---|
6685 | IF ( ammonium_nitrate > 0.0_wp ) THEN |
---|
6686 | nh4no3_h2so4 = - 22.532_wp * rh**4 + 66.615_wp * rh**3 - 74.647_wp * rh**2 + 37.638_wp * & |
---|
6687 | rh - 6.9711_wp |
---|
6688 | ENDIF |
---|
6689 | |
---|
6690 | IF ( ammonium_chloride > 0.0_wp ) THEN |
---|
6691 | IF ( rh >= 0.1_wp .AND. rh < 0.2_wp ) THEN |
---|
6692 | nh4cl_h2so4 = - 0.32089_wp * rh + 0.57738_wp |
---|
6693 | ELSEIF ( rh >= 0.2_wp .AND. rh < 0.9_wp ) THEN |
---|
6694 | nh4cl_h2so4 = 18.089_wp * rh**5 - 51.083_wp * rh**4 + 50.32_wp * rh**3 - 17.012_wp * & |
---|
6695 | rh**2 - 0.93435_wp * rh + 1.0548_wp |
---|
6696 | ELSEIF ( rh >= 0.9_wp .AND. rh < 0.99_wp ) THEN |
---|
6697 | nh4cl_h2so4 = - 1.5749_wp * rh + 1.7002_wp |
---|
6698 | ENDIF |
---|
6699 | ENDIF |
---|
6700 | |
---|
6701 | IF ( sodium_sulphate > 0.0_wp ) THEN |
---|
6702 | na2so4_h2so4 = 29.843_wp * rh**4 - 69.417_wp * rh**3 + 61.507_wp * rh**2 - 29.874_wp * & |
---|
6703 | rh + 7.7556_wp |
---|
6704 | ENDIF |
---|
6705 | |
---|
6706 | IF ( sodium_nitrate > 0.0_wp ) THEN |
---|
6707 | nano3_h2so4 = - 122.37_wp * rh**6 + 427.43_wp * rh**5 - 604.68_wp * rh**4 + 443.08_wp * & |
---|
6708 | rh**3 - 178.61_wp * rh**2 + 37.242_wp * rh - 1.9564_wp |
---|
6709 | ENDIF |
---|
6710 | |
---|
6711 | IF ( sodium_chloride > 0.0_wp ) THEN |
---|
6712 | nacl_h2so4 = - 40.288_wp * rh**5 + 115.61_wp * rh**4 - 129.99_wp * rh**3 + 72.652_wp * & |
---|
6713 | rh**2 - 22.124_wp * rh + 4.2676_wp |
---|
6714 | ENDIF |
---|
6715 | |
---|
6716 | ln_h2so4_act = binary_h2so4 + nitric_acid_eq_frac * hno3_h2so4 + & |
---|
6717 | hydrochloric_acid_eq_frac * hcl_h2so4 + & |
---|
6718 | ammonium_sulphate_eq_frac * nh42so4_h2so4 + & |
---|
6719 | ammonium_nitrate_eq_frac * nh4no3_h2so4 + & |
---|
6720 | ammonium_chloride_eq_frac * nh4cl_h2so4 + & |
---|
6721 | sodium_sulphate_eq_frac * na2so4_h2so4 + & |
---|
6722 | sodium_nitrate_eq_frac * nano3_h2so4 + sodium_chloride_eq_frac * nacl_h2so4 |
---|
6723 | |
---|
6724 | gamma_h2so4 = EXP( ln_h2so4_act ) ! molal activity coefficient |
---|
6725 | ! |
---|
6726 | !-- Export activity coefficients |
---|
6727 | IF ( gamma_h2so4 > 1.0E-10_wp ) THEN |
---|
6728 | gamma_out(4) = gamma_hhso4**2 / gamma_h2so4 |
---|
6729 | ENDIF |
---|
6730 | IF ( gamma_hhso4 > 1.0E-10_wp ) THEN |
---|
6731 | gamma_out(5) = gamma_h2so4**3 / gamma_hhso4**2 |
---|
6732 | ENDIF |
---|
6733 | ! |
---|
6734 | !-- Ionic activity coefficient product |
---|
6735 | act_product = gamma_h2so4**3 / gamma_hhso4**2 |
---|
6736 | ! |
---|
6737 | !-- Solve the quadratic equation (i.e. x in ax**2 + bx + c = 0) |
---|
6738 | a = 1.0_wp |
---|
6739 | b = -1.0_wp * ( ions(4) + ions(1) + ( ( water_total * 18.0E-3_wp ) / & |
---|
6740 | ( 99.0_wp * act_product ) ) ) |
---|
6741 | c = ions(4) * ions(1) |
---|
6742 | root1 = ( ( -1.0_wp * b ) + ( ( ( b**2 ) - 4.0_wp * a * c )**0.5_wp ) ) / ( 2.0_wp * a ) |
---|
6743 | root2 = ( ( -1.0_wp * b ) - ( ( ( b**2 ) - 4.0_wp * a * c) **0.5_wp ) ) / ( 2.0_wp * a ) |
---|
6744 | |
---|
6745 | IF ( root1 > ions(1) .OR. root1 < 0.0_wp ) THEN |
---|
6746 | root1 = 0.0_wp |
---|
6747 | ENDIF |
---|
6748 | |
---|
6749 | IF ( root2 > ions(1) .OR. root2 < 0.0_wp ) THEN |
---|
6750 | root2 = 0.0_wp |
---|
6751 | ENDIF |
---|
6752 | ! |
---|
6753 | !-- Calculate the new hydrogen ion, bisulphate ion and sulphate ion |
---|
6754 | !-- concentration |
---|
6755 | h_real = ions(1) |
---|
6756 | so4_real = ions(4) |
---|
6757 | hso4_real = MAX( root1, root2 ) |
---|
6758 | h_real = ions(1) - hso4_real |
---|
6759 | so4_real = ions(4) - hso4_real |
---|
6760 | ! |
---|
6761 | !-- Recalculate ion molalities |
---|
6762 | ions_mol(1) = h_real / ( water_total * 18.01528E-3_wp ) ! H+ |
---|
6763 | ions_mol(4) = so4_real / ( water_total * 18.01528E-3_wp ) ! SO4(2-) |
---|
6764 | ions_mol(5) = hso4_real / ( water_total * 18.01528E-3_wp ) ! HSO4(2-) |
---|
6765 | |
---|
6766 | h_out = h_real |
---|
6767 | hso4_out = hso4_real |
---|
6768 | so4_out = so4_real |
---|
6769 | |
---|
6770 | ELSE |
---|
6771 | h_out = ions(1) |
---|
6772 | hso4_out = 0.0_wp |
---|
6773 | so4_out = ions(4) |
---|
6774 | ENDIF |
---|
6775 | |
---|
6776 | ! |
---|
6777 | !-- 4) ACTIVITY COEFFICIENTS -for vapour pressures of HNO3,HCL and NH3 |
---|
6778 | ! |
---|
6779 | !-- This section evaluates activity coefficients and vapour pressures using the water content |
---|
6780 | !-- calculated above) for each inorganic condensing species: a - HNO3, b - NH3, c - HCL. |
---|
6781 | !-- The following procedure is used: Zaveri et al (2005) found that one could express the variation |
---|
6782 | !-- of activity coefficients linearly in log-space if equivalent mole fractions were used. |
---|
6783 | !-- So, by a taylor series expansion LOG( activity coefficient ) = |
---|
6784 | !-- LOG( binary activity coefficient at a given RH ) + |
---|
6785 | !-- (equivalent mole fraction compound A) * |
---|
6786 | !-- ('interaction' parameter between A and condensing species) + |
---|
6787 | !-- equivalent mole fraction compound B) * |
---|
6788 | !-- ('interaction' parameter between B and condensing species). |
---|
6789 | !-- Here, the interaction parameters have been fit to ADDEM by searching the whole compositon space |
---|
6790 | !-- and fit usign the Levenberg-Marquardt non-linear least squares algorithm. |
---|
6791 | ! |
---|
6792 | !-- They are given as a function of RH and vary with complexity ranging from linear to 5th order |
---|
6793 | !-- polynomial expressions, the binary activity coefficients were calculated using AIM online. |
---|
6794 | !-- NOTE: for NH3, no binary activity coefficient was used and the data were fit to the ratio of the |
---|
6795 | !-- activity coefficients for the ammonium and hydrogen ions. Once the activity coefficients are |
---|
6796 | !-- obtained the vapour pressure can be easily calculated using tabulated equilibrium constants |
---|
6797 | !-- (referenced). This procedure differs from that of Zaveri et al (2005) in that it is not assumed |
---|
6798 | !-- one can carry behaviour from binary mixtures in multicomponent systems. To this end we have fit |
---|
6799 | !-- the 'interaction' parameters explicitly to a general inorganic equilibrium model |
---|
6800 | !-- (ADDEM - Topping et al. 2005a,b). Such parameters take into account bisulphate ion dissociation |
---|
6801 | !-- and water content. This also allows us to consider one regime for all composition space, rather |
---|
6802 | !-- than defining sulphate rich and sulphate poor regimes. |
---|
6803 | !-- NOTE: The flags "binary_case" and "full_complexity" are not used in this prototype. They are |
---|
6804 | !-- used for simplification of the fit expressions when using limited composition regions. |
---|
6805 | ! |
---|
6806 | !-- a) - ACTIVITY COEFF/VAPOUR PRESSURE - HNO3 |
---|
6807 | IF ( ions(1) > 0.0_wp .AND. ions(6) > 0.0_wp ) THEN |
---|
6808 | binary_case = 1 |
---|
6809 | IF ( rh > 0.1_wp .AND. rh < 0.98_wp ) THEN |
---|
6810 | IF ( binary_case == 1 ) THEN |
---|
6811 | binary_hno3 = 1.8514_wp * rh**3 - 4.6991_wp * rh**2 + 1.5514_wp * rh + 0.90236_wp |
---|
6812 | ELSEIF ( binary_case == 2 ) THEN |
---|
6813 | binary_hno3 = - 1.1751_wp * ( rh**2 ) - 0.53794_wp * rh + 1.2808_wp |
---|
6814 | ENDIF |
---|
6815 | ELSEIF ( rh >= 0.98_wp .AND. rh < 0.9999_wp ) THEN |
---|
6816 | binary_hno3 = 1244.69635941351_wp * rh**3 - 2613.93941099991_wp * rh**2 + & |
---|
6817 | 1525.0684974546_wp * rh -155.946764059316_wp |
---|
6818 | ENDIF |
---|
6819 | ! |
---|
6820 | !-- Contributions from other solutes |
---|
6821 | full_complexity = 1 |
---|
6822 | IF ( hydrochloric_acid > 0.0_wp ) THEN ! HCL |
---|
6823 | IF ( full_complexity == 1 .OR. rh < 0.4_wp ) THEN |
---|
6824 | hcl_hno3 = 16.051_wp * rh**4 - 44.357_wp * rh**3 + 45.141_wp * rh**2 - 21.638_wp * & |
---|
6825 | rh + 4.8182_wp |
---|
6826 | ELSEIF ( full_complexity == 0 .AND. rh > 0.4_wp ) THEN |
---|
6827 | hcl_hno3 = - 1.5833_wp * rh + 1.5569_wp |
---|
6828 | ENDIF |
---|
6829 | ENDIF |
---|
6830 | |
---|
6831 | IF ( sulphuric_acid > 0.0_wp ) THEN ! H2SO4 |
---|
6832 | IF ( full_complexity == 1 .OR. rh < 0.4_wp ) THEN |
---|
6833 | h2so4_hno3 = - 3.0849_wp * rh**3 + 5.9609_wp * rh**2 - 4.468_wp * rh + 1.5658_wp |
---|
6834 | ELSEIF ( full_complexity == 0 .AND. rh > 0.4_wp ) THEN |
---|
6835 | h2so4_hno3 = - 0.93473_wp * rh + 0.9363_wp |
---|
6836 | ENDIF |
---|
6837 | ENDIF |
---|
6838 | |
---|
6839 | IF ( ammonium_sulphate > 0.0_wp ) THEN ! NH42SO4 |
---|
6840 | nh42so4_hno3 = 16.821_wp * rh**3 - 28.391_wp * rh**2 + 18.133_wp * rh - 6.7356_wp |
---|
6841 | ENDIF |
---|
6842 | |
---|
6843 | IF ( ammonium_nitrate > 0.0_wp ) THEN ! NH4NO3 |
---|
6844 | nh4no3_hno3 = 11.01_wp * rh**3 - 21.578_wp * rh**2 + 14.808_wp * rh - 4.2593_wp |
---|
6845 | ENDIF |
---|
6846 | |
---|
6847 | IF ( ammonium_chloride > 0.0_wp ) THEN ! NH4Cl |
---|
6848 | IF ( full_complexity == 1 .OR. rh <= 0.4_wp ) THEN |
---|
6849 | nh4cl_hno3 = - 1.176_wp * rh**3 + 5.0828_wp * rh**2 - 3.8792_wp * rh - 0.05518_wp |
---|
6850 | ELSEIF ( full_complexity == 0 .AND. rh > 0.4_wp ) THEN |
---|
6851 | nh4cl_hno3 = 2.6219_wp * rh**2 - 2.2609_wp * rh - 0.38436_wp |
---|
6852 | ENDIF |
---|
6853 | ENDIF |
---|
6854 | |
---|
6855 | IF ( sodium_sulphate > 0.0_wp ) THEN ! Na2SO4 |
---|
6856 | na2so4_hno3 = 35.504_wp * rh**4 - 80.101_wp * rh**3 + 67.326_wp * rh**2 - 28.461_wp * & |
---|
6857 | rh + 5.6016_wp |
---|
6858 | ENDIF |
---|
6859 | |
---|
6860 | IF ( sodium_nitrate > 0.0_wp ) THEN ! NaNO3 |
---|
6861 | IF ( full_complexity == 1 .OR. rh <= 0.4_wp ) THEN |
---|
6862 | nano3_hno3 = 23.659_wp * rh**5 - 66.917_wp * rh**4 + 74.686_wp * rh**3 - 40.795_wp * & |
---|
6863 | rh**2 + 10.831_wp * rh - 1.4701_wp |
---|
6864 | ELSEIF ( full_complexity == 0 .AND. rh > 0.4_wp ) THEN |
---|
6865 | nano3_hno3 = 14.749_wp * rh**4 - 35.237_wp * rh**3 + 31.196_wp * rh**2 - 12.076_wp * & |
---|
6866 | rh + 1.3605_wp |
---|
6867 | ENDIF |
---|
6868 | ENDIF |
---|
6869 | |
---|
6870 | IF ( sodium_chloride > 0.0_wp ) THEN ! NaCl |
---|
6871 | IF ( full_complexity == 1 .OR. rh <= 0.4_wp ) THEN |
---|
6872 | nacl_hno3 = 13.682_wp * rh**4 - 35.122_wp * rh**3 + 33.397_wp * rh**2 - 14.586_wp * & |
---|
6873 | rh + 2.6276_wp |
---|
6874 | ELSEIF ( full_complexity == 0 .AND. rh > 0.4_wp ) THEN |
---|
6875 | nacl_hno3 = 1.1882_wp * rh**3 - 1.1037_wp * rh**2 - 0.7642_wp * rh + 0.6671_wp |
---|
6876 | ENDIF |
---|
6877 | ENDIF |
---|
6878 | |
---|
6879 | ln_hno3_act = binary_hno3 + hydrochloric_acid_eq_frac * hcl_hno3 + & |
---|
6880 | sulphuric_acid_eq_frac * h2so4_hno3 + & |
---|
6881 | ammonium_sulphate_eq_frac * nh42so4_hno3 + & |
---|
6882 | ammonium_nitrate_eq_frac * nh4no3_hno3 + & |
---|
6883 | ammonium_chloride_eq_frac * nh4cl_hno3 + & |
---|
6884 | sodium_sulphate_eq_frac * na2so4_hno3 + & |
---|
6885 | sodium_nitrate_eq_frac * nano3_hno3 + sodium_chloride_eq_frac * nacl_hno3 |
---|
6886 | |
---|
6887 | gamma_hno3 = EXP( ln_hno3_act ) ! Molal activity coefficient of HNO3 |
---|
6888 | gamma_out(1) = gamma_hno3 |
---|
6889 | ! |
---|
6890 | !-- Partial pressure calculation |
---|
6891 | !-- k_hno3 = 2.51 * ( 10**6 ) |
---|
6892 | !-- k_hno3 = 2.628145923d6 !< calculated by AIM online (Clegg et al 1998) after Chameides (1984) |
---|
6893 | k_hno3 = 2.6E6_wp * EXP( 8700.0_wp * henrys_temp_dep ) |
---|
6894 | press_hno3 = ( ions_mol(1) * ions_mol(6) * ( gamma_hno3**2 ) ) / k_hno3 |
---|
6895 | ENDIF |
---|
6896 | ! |
---|
6897 | !-- b) - ACTIVITY COEFF/VAPOUR PRESSURE - NH3 |
---|
6898 | !-- Follow the two solute approach of Zaveri et al. (2005) |
---|
6899 | IF ( ions(2) > 0.0_wp .AND. ions_mol(1) > 0.0_wp ) THEN |
---|
6900 | ! |
---|
6901 | !-- NH4HSO4: |
---|
6902 | binary_nh4hso4 = 56.907_wp * rh**6 - 155.32_wp * rh**5 + 142.94_wp * rh**4 - 32.298_wp * & |
---|
6903 | rh**3 - 27.936_wp * rh**2 + 19.502_wp * rh - 4.2618_wp |
---|
6904 | IF ( nitric_acid > 0.0_wp) THEN ! HNO3 |
---|
6905 | hno3_nh4hso4 = 104.8369_wp * rh**8 - 288.8923_wp * rh**7 + 129.3445_wp * rh**6 + & |
---|
6906 | 373.0471_wp * rh**5 - 571.0385_wp * rh**4 + 326.3528_wp * rh**3 - & |
---|
6907 | 74.169_wp * rh**2 - 2.4999_wp * rh + 3.17_wp |
---|
6908 | ENDIF |
---|
6909 | |
---|
6910 | IF ( hydrochloric_acid > 0.0_wp) THEN ! HCL |
---|
6911 | hcl_nh4hso4 = - 7.9133_wp * rh**8 + 126.6648_wp * rh**7 - 460.7425_wp * rh**6 + & |
---|
6912 | 731.606_wp * rh**5 - 582.7467_wp * rh**4 + 216.7197_wp * rh**3 - & |
---|
6913 | 11.3934_wp * rh**2 - 17.7728_wp * rh + 5.75_wp |
---|
6914 | ENDIF |
---|
6915 | |
---|
6916 | IF ( sulphuric_acid > 0.0_wp) THEN ! H2SO4 |
---|
6917 | h2so4_nh4hso4 = 195.981_wp * rh**8 - 779.2067_wp * rh**7 + 1226.3647_wp * rh**6 - & |
---|
6918 | 964.0261_wp * rh**5 + 391.7911_wp * rh**4 - 84.1409_wp * rh**3 + & |
---|
6919 | 20.0602_wp * rh**2 - 10.2663_wp * rh + 3.5817_wp |
---|
6920 | ENDIF |
---|
6921 | |
---|
6922 | IF ( ammonium_sulphate > 0.0_wp) THEN ! NH42SO4 |
---|
6923 | nh42so4_nh4hso4 = 617.777_wp * rh**8 - 2547.427_wp * rh**7 + 4361.6009_wp * rh**6 - & |
---|
6924 | 4003.162_wp * rh**5 + 2117.8281_wp * rh**4 - 640.0678_wp * rh**3 + & |
---|
6925 | 98.0902_wp * rh**2 - 2.2615_wp * rh - 2.3811_wp |
---|
6926 | ENDIF |
---|
6927 | |
---|
6928 | IF ( ammonium_nitrate > 0.0_wp) THEN ! NH4NO3 |
---|
6929 | nh4no3_nh4hso4 = - 104.4504_wp * rh**8 + 539.5921_wp * rh**7 - 1157.0498_wp * rh**6 + & |
---|
6930 | 1322.4507_wp * rh**5 - 852.2475_wp * rh**4 + 298.3734_wp * rh**3 - & |
---|
6931 | 47.0309_wp * rh**2 + 1.297_wp * rh - 0.8029_wp |
---|
6932 | ENDIF |
---|
6933 | |
---|
6934 | IF ( ammonium_chloride > 0.0_wp) THEN ! NH4Cl |
---|
6935 | nh4cl_nh4hso4 = 258.1792_wp * rh**8 - 1019.3777_wp * rh**7 + 1592.8918_wp * rh**6 - & |
---|
6936 | 1221.0726_wp * rh**5 + 442.2548_wp * rh**4 - 43.6278_wp * rh**3 - & |
---|
6937 | 7.5282_wp * rh**2 - 3.8459_wp * rh + 2.2728_wp |
---|
6938 | ENDIF |
---|
6939 | |
---|
6940 | IF ( sodium_sulphate > 0.0_wp) THEN ! Na2SO4 |
---|
6941 | na2so4_nh4hso4 = 225.4238_wp * rh**8 - 732.4113_wp * rh**7 + 843.7291_wp * rh**6 - & |
---|
6942 | 322.7328_wp * rh**5 - 88.6252_wp * rh**4 + 72.4434_wp * rh**3 + & |
---|
6943 | 22.9252_wp * rh**2 - 25.3954_wp * rh + 4.6971_wp |
---|
6944 | ENDIF |
---|
6945 | |
---|
6946 | IF ( sodium_nitrate > 0.0_wp) THEN ! NaNO3 |
---|
6947 | nano3_nh4hso4 = 96.1348_wp * rh**8 - 341.6738_wp * rh**7 + 406.5314_wp * rh**6 - & |
---|
6948 | 98.5777_wp * rh**5 - 172.8286_wp * rh**4 + 149.3151_wp * rh**3 - & |
---|
6949 | 38.9998_wp * rh**2 - 0.2251_wp * rh + 0.4953_wp |
---|
6950 | ENDIF |
---|
6951 | |
---|
6952 | IF ( sodium_chloride > 0.0_wp) THEN ! NaCl |
---|
6953 | nacl_nh4hso4 = 91.7856_wp * rh**8 - 316.6773_wp * rh**7 + 358.2703_wp * rh**6 - & |
---|
6954 | 68.9142_wp * rh**5 - 156.5031_wp * rh**4 + 116.9592_wp * rh**3 - & |
---|
6955 | 22.5271_wp * rh**2 - 3.7716_wp * rh + 1.56_wp |
---|
6956 | ENDIF |
---|
6957 | |
---|
6958 | ln_nh4hso4_act = binary_nh4hso4 + nitric_acid_eq_frac * hno3_nh4hso4 + & |
---|
6959 | hydrochloric_acid_eq_frac * hcl_nh4hso4 + & |
---|
6960 | sulphuric_acid_eq_frac * h2so4_nh4hso4 + & |
---|
6961 | ammonium_sulphate_eq_frac * nh42so4_nh4hso4 + & |
---|
6962 | ammonium_nitrate_eq_frac * nh4no3_nh4hso4 + & |
---|
6963 | ammonium_chloride_eq_frac * nh4cl_nh4hso4 + & |
---|
6964 | sodium_sulphate_eq_frac * na2so4_nh4hso4 + & |
---|
6965 | sodium_nitrate_eq_frac * nano3_nh4hso4 + & |
---|
6966 | sodium_chloride_eq_frac * nacl_nh4hso4 |
---|
6967 | |
---|
6968 | gamma_nh4hso4 = EXP( ln_nh4hso4_act ) ! molal act. coefficient of NH4HSO4 |
---|
6969 | ! |
---|
6970 | !-- Molal activity coefficient of NO3- |
---|
6971 | gamma_out(6) = gamma_nh4hso4 |
---|
6972 | ! |
---|
6973 | !-- Molal activity coefficient of NH4+ |
---|
6974 | gamma_nh3 = gamma_nh4hso4**2 / gamma_hhso4**2 |
---|
6975 | gamma_out(3) = gamma_nh3 |
---|
6976 | ! |
---|
6977 | !-- This actually represents the ratio of the ammonium to hydrogen ion activity coefficients |
---|
6978 | !-- (see Zaveri paper) - multiply this by the ratio of the ammonium to hydrogen ion molality and |
---|
6979 | !-- the ratio of appropriate equilibrium constants |
---|
6980 | ! |
---|
6981 | !-- Equilibrium constants |
---|
6982 | !-- k_h = 57.64d0 ! Zaveri et al. (2005) |
---|
6983 | k_h = 5.8E1_wp * EXP( 4085.0_wp * henrys_temp_dep ) ! after Chameides (1984) |
---|
6984 | !-- k_nh4 = 1.81E-5_wp ! Zaveri et al. (2005) |
---|
6985 | k_nh4 = 1.7E-5_wp * EXP( -4325.0_wp * henrys_temp_dep ) ! Chameides (1984) |
---|
6986 | !-- k_h2o = 1.01E-14_wp ! Zaveri et al (2005) |
---|
6987 | k_h2o = 1.E-14_wp * EXP( -6716.0_wp * henrys_temp_dep ) ! Chameides (1984) |
---|
6988 | ! |
---|
6989 | molality_ratio_nh3 = ions_mol(2) / ions_mol(1) |
---|
6990 | ! |
---|
6991 | !-- Partial pressure calculation |
---|
6992 | press_nh3 = molality_ratio_nh3 * gamma_nh3 * ( k_h2o / ( k_h * k_nh4 ) ) |
---|
6993 | |
---|
6994 | ENDIF |
---|
6995 | ! |
---|
6996 | !-- c) - ACTIVITY COEFF/VAPOUR PRESSURE - HCL |
---|
6997 | IF ( ions(1) > 0.0_wp .AND. ions(7) > 0.0_wp ) THEN |
---|
6998 | binary_case = 1 |
---|
6999 | IF ( rh > 0.1_wp .AND. rh < 0.98 ) THEN |
---|
7000 | IF ( binary_case == 1 ) THEN |
---|
7001 | binary_hcl = - 5.0179_wp * rh**3 + 9.8816_wp * rh**2 - 10.789_wp * rh + 5.4737_wp |
---|
7002 | ELSEIF ( binary_case == 2 ) THEN |
---|
7003 | binary_hcl = - 4.6221_wp * rh + 4.2633_wp |
---|
7004 | ENDIF |
---|
7005 | ELSEIF ( rh >= 0.98_wp .AND. rh < 0.9999_wp ) THEN |
---|
7006 | binary_hcl = 775.6111008626_wp * rh**3 - 2146.01320888771_wp * rh**2 + & |
---|
7007 | 1969.01979670259_wp * rh - 598.878230033926_wp |
---|
7008 | ENDIF |
---|
7009 | ENDIF |
---|
7010 | |
---|
7011 | IF ( nitric_acid > 0.0_wp ) THEN ! HNO3 |
---|
7012 | IF ( full_complexity == 1 .OR. rh <= 0.4_wp ) THEN |
---|
7013 | hno3_hcl = 9.6256_wp * rh**4 - 26.507_wp * rh**3 + 27.622_wp * rh**2 - 12.958_wp * rh + & |
---|
7014 | 2.2193_wp |
---|
7015 | ELSEIF ( full_complexity == 0 .AND. rh > 0.4_wp ) THEN |
---|
7016 | hno3_hcl = 1.3242_wp * rh**2 - 1.8827_wp * rh + 0.55706_wp |
---|
7017 | ENDIF |
---|
7018 | ENDIF |
---|
7019 | |
---|
7020 | IF ( sulphuric_acid > 0.0_wp ) THEN ! H2SO4 |
---|
7021 | IF ( full_complexity == 1 .OR. rh <= 0.4 ) THEN |
---|
7022 | h2so4_hcl = 1.4406_wp * rh**3 - 2.7132_wp * rh**2 + 1.014_wp * rh + 0.25226_wp |
---|
7023 | ELSEIF ( full_complexity == 0 .AND. rh > 0.4_wp ) THEN |
---|
7024 | h2so4_hcl = 0.30993_wp * rh**2 - 0.99171_wp * rh + 0.66913_wp |
---|
7025 | ENDIF |
---|
7026 | ENDIF |
---|
7027 | |
---|
7028 | IF ( ammonium_sulphate > 0.0_wp ) THEN ! NH42SO4 |
---|
7029 | nh42so4_hcl = 22.071_wp * rh**3 - 40.678_wp * rh**2 + 27.893_wp * rh - 9.4338_wp |
---|
7030 | ENDIF |
---|
7031 | |
---|
7032 | IF ( ammonium_nitrate > 0.0_wp ) THEN ! NH4NO3 |
---|
7033 | nh4no3_hcl = 19.935_wp * rh**3 - 42.335_wp * rh**2 + 31.275_wp * rh - 8.8675_wp |
---|
7034 | ENDIF |
---|
7035 | |
---|
7036 | IF ( ammonium_chloride > 0.0_wp ) THEN ! NH4Cl |
---|
7037 | IF ( full_complexity == 1 .OR. rh <= 0.4_wp ) THEN |
---|
7038 | nh4cl_hcl = 2.8048_wp * rh**3 - 4.3182_wp * rh**2 + 3.1971_wp * rh - 1.6824_wp |
---|
7039 | ELSEIF ( full_complexity == 0 .AND. rh > 0.4_wp ) THEN |
---|
7040 | nh4cl_hcl = 1.2304_wp * rh**2 - 0.18262_wp * rh - 1.0643_wp |
---|
7041 | ENDIF |
---|
7042 | ENDIF |
---|
7043 | |
---|
7044 | IF ( sodium_sulphate > 0.0_wp ) THEN ! Na2SO4 |
---|
7045 | na2so4_hcl = 36.104_wp * rh**4 - 78.658_wp * rh**3 + 63.441_wp * rh**2 - 26.727_wp * rh + & |
---|
7046 | 5.7007_wp |
---|
7047 | ENDIF |
---|
7048 | |
---|
7049 | IF ( sodium_nitrate > 0.0_wp ) THEN ! NaNO3 |
---|
7050 | IF ( full_complexity == 1 .OR. rh <= 0.4_wp ) THEN |
---|
7051 | nano3_hcl = 54.471_wp * rh**5 - 159.42_wp * rh**4 + 180.25_wp * rh**3 - 98.176_wp * rh**2& |
---|
7052 | + 25.309_wp * rh - 2.4275_wp |
---|
7053 | ELSEIF ( full_complexity == 0 .AND. rh > 0.4_wp ) THEN |
---|
7054 | nano3_hcl = 21.632_wp * rh**4 - 53.088_wp * rh**3 + 47.285_wp * rh**2 - 18.519_wp * rh & |
---|
7055 | + 2.6846_wp |
---|
7056 | ENDIF |
---|
7057 | ENDIF |
---|
7058 | |
---|
7059 | IF ( sodium_chloride > 0.0_wp ) THEN ! NaCl |
---|
7060 | IF ( full_complexity == 1 .OR. rh <= 0.4_wp ) THEN |
---|
7061 | nacl_hcl = 5.4138_wp * rh**4 - 12.079_wp * rh**3 + 9.627_wp * rh**2 - 3.3164_wp * rh + & |
---|
7062 | 0.35224_wp |
---|
7063 | ELSEIF ( full_complexity == 0 .AND. rh > 0.4_wp ) THEN |
---|
7064 | nacl_hcl = 2.432_wp * rh**3 - 4.3453_wp * rh**2 + 2.3834_wp * rh - 0.4762_wp |
---|
7065 | ENDIF |
---|
7066 | ENDIF |
---|
7067 | |
---|
7068 | ln_HCL_act = binary_hcl + nitric_acid_eq_frac * hno3_hcl + sulphuric_acid_eq_frac * h2so4_hcl +& |
---|
7069 | ammonium_sulphate_eq_frac * nh42so4_hcl + ammonium_nitrate_eq_frac * nh4no3_hcl + & |
---|
7070 | ammonium_chloride_eq_frac * nh4cl_hcl + sodium_sulphate_eq_frac * na2so4_hcl + & |
---|
7071 | sodium_nitrate_eq_frac * nano3_hcl + sodium_chloride_eq_frac * nacl_hcl |
---|
7072 | |
---|
7073 | gamma_hcl = EXP( ln_HCL_act ) ! Molal activity coefficient |
---|
7074 | gamma_out(2) = gamma_hcl |
---|
7075 | ! |
---|
7076 | !-- Equilibrium constant after Wagman et al. (1982) (and NIST database) |
---|
7077 | k_hcl = 2E6_wp * EXP( 9000.0_wp * henrys_temp_dep ) |
---|
7078 | |
---|
7079 | press_hcl = ( ions_mol(1) * ions_mol(7) * gamma_hcl**2 ) / k_hcl |
---|
7080 | ! |
---|
7081 | !-- 5) Ion molility output |
---|
7082 | mols_out = ions_mol |
---|
7083 | |
---|
7084 | END SUBROUTINE inorganic_pdfite |
---|
7085 | |
---|
7086 | !------------------------------------------------------------------------------! |
---|
7087 | ! Description: |
---|
7088 | ! ------------ |
---|
7089 | !> Update the particle size distribution. Put particles into corrects bins. |
---|
7090 | !> |
---|
7091 | !> Moving-centre method assumed, i.e. particles are allowed to grow to their |
---|
7092 | !> exact size as long as they are not crossing the fixed diameter bin limits. |
---|
7093 | !> If the particles in a size bin cross the lower or upper diameter limit, they |
---|
7094 | !> are all moved to the adjacent diameter bin and their volume is averaged with |
---|
7095 | !> the particles in the new bin, which then get a new diameter. |
---|
7096 | ! |
---|
7097 | !> Moving-centre method minimises numerical diffusion. |
---|
7098 | !------------------------------------------------------------------------------! |
---|
7099 | SUBROUTINE distr_update( paero ) |
---|
7100 | |
---|
7101 | IMPLICIT NONE |
---|
7102 | |
---|
7103 | INTEGER(iwp) :: ib !< loop index |
---|
7104 | INTEGER(iwp) :: mm !< loop index |
---|
7105 | INTEGER(iwp) :: counti !< number of while loops |
---|
7106 | |
---|
7107 | LOGICAL :: within_bins !< logical (particle belongs to the bin?) |
---|
7108 | |
---|
7109 | REAL(wp) :: znfrac !< number fraction to be moved to the larger bin |
---|
7110 | REAL(wp) :: zvfrac !< volume fraction to be moved to the larger bin |
---|
7111 | REAL(wp) :: zvexc !< Volume in the grown bin which exceeds the bin upper limit |
---|
7112 | REAL(wp) :: zvihi !< particle volume at the high end of the bin |
---|
7113 | REAL(wp) :: zvilo !< particle volume at the low end of the bin |
---|
7114 | REAL(wp) :: zvpart !< particle volume (m3) |
---|
7115 | REAL(wp) :: zvrat !< volume ratio of a size bin |
---|
7116 | |
---|
7117 | real(wp), dimension(nbins_aerosol) :: dummy |
---|
7118 | |
---|
7119 | TYPE(t_section), DIMENSION(nbins_aerosol), INTENT(inout) :: paero !< aerosol properties |
---|
7120 | |
---|
7121 | zvpart = 0.0_wp |
---|
7122 | zvfrac = 0.0_wp |
---|
7123 | within_bins = .FALSE. |
---|
7124 | |
---|
7125 | dummy = paero(:)%numc |
---|
7126 | ! |
---|
7127 | !-- Check if the volume of the bin is within bin limits after update |
---|
7128 | counti = 0 |
---|
7129 | DO WHILE ( .NOT. within_bins ) |
---|
7130 | within_bins = .TRUE. |
---|
7131 | ! |
---|
7132 | !-- Loop from larger to smaller size bins |
---|
7133 | DO ib = end_subrange_2b-1, start_subrange_1a, -1 |
---|
7134 | mm = 0 |
---|
7135 | IF ( paero(ib)%numc > nclim ) THEN |
---|
7136 | zvpart = 0.0_wp |
---|
7137 | zvfrac = 0.0_wp |
---|
7138 | |
---|
7139 | IF ( ib == end_subrange_2a ) CYCLE |
---|
7140 | ! |
---|
7141 | !-- Dry volume |
---|
7142 | zvpart = SUM( paero(ib)%volc(1:7) ) / paero(ib)%numc |
---|
7143 | ! |
---|
7144 | !-- Smallest bin cannot decrease |
---|
7145 | IF ( paero(ib)%vlolim > zvpart .AND. ib == start_subrange_1a ) CYCLE |
---|
7146 | ! |
---|
7147 | !-- Decreasing bins |
---|
7148 | IF ( paero(ib)%vlolim > zvpart ) THEN |
---|
7149 | mm = ib - 1 |
---|
7150 | IF ( ib == start_subrange_2b ) mm = end_subrange_1a ! 2b goes to 1a |
---|
7151 | |
---|
7152 | paero(mm)%numc = paero(mm)%numc + paero(ib)%numc |
---|
7153 | paero(ib)%numc = 0.0_wp |
---|
7154 | paero(mm)%volc(:) = paero(mm)%volc(:) + paero(ib)%volc(:) |
---|
7155 | paero(ib)%volc(:) = 0.0_wp |
---|
7156 | CYCLE |
---|
7157 | ENDIF |
---|
7158 | ! |
---|
7159 | !-- If size bin has not grown, cycle. |
---|
7160 | !-- Changed by Mona: compare to the arithmetic mean volume, as done originally. Now |
---|
7161 | !-- particle volume is derived from the geometric mean diameter, not arithmetic (see |
---|
7162 | !-- SUBROUTINE set_sizebins). |
---|
7163 | IF ( zvpart <= api6 * ( ( aero(ib)%vhilim + aero(ib)%vlolim ) / ( 2.0_wp * api6 ) ) ) & |
---|
7164 | CYCLE |
---|
7165 | ! |
---|
7166 | !-- Avoid precision problems |
---|
7167 | IF ( ABS( zvpart - api6 * paero(ib)%dmid**3 ) < 1.0E-35_wp ) CYCLE |
---|
7168 | ! |
---|
7169 | !-- Volume ratio of the size bin |
---|
7170 | zvrat = paero(ib)%vhilim / paero(ib)%vlolim |
---|
7171 | ! |
---|
7172 | !-- Particle volume at the low end of the bin |
---|
7173 | zvilo = 2.0_wp * zvpart / ( 1.0_wp + zvrat ) |
---|
7174 | ! |
---|
7175 | !-- Particle volume at the high end of the bin |
---|
7176 | zvihi = zvrat * zvilo |
---|
7177 | ! |
---|
7178 | !-- Volume in the grown bin which exceeds the bin upper limit |
---|
7179 | zvexc = 0.5_wp * ( zvihi + paero(ib)%vhilim ) |
---|
7180 | ! |
---|
7181 | !-- Number fraction to be moved to the larger bin |
---|
7182 | znfrac = MIN( 1.0_wp, ( zvihi - paero(ib)%vhilim) / ( zvihi - zvilo ) ) |
---|
7183 | ! |
---|
7184 | !-- Volume fraction to be moved to the larger bin |
---|
7185 | zvfrac = MIN( 0.99_wp, znfrac * zvexc / zvpart ) |
---|
7186 | IF ( zvfrac < 0.0_wp ) THEN |
---|
7187 | message_string = 'Error: zvfrac < 0' |
---|
7188 | CALL message( 'salsa_mod: distr_update', 'PA0624', 1, 2, 0, 6, 0 ) |
---|
7189 | ENDIF |
---|
7190 | ! |
---|
7191 | !-- Update bin |
---|
7192 | mm = ib + 1 |
---|
7193 | ! |
---|
7194 | !-- Volume (cm3/cm3) |
---|
7195 | paero(mm)%volc(:) = paero(mm)%volc(:) + znfrac * paero(ib)%numc * zvexc * & |
---|
7196 | paero(ib)%volc(:) / SUM( paero(ib)%volc(1:7) ) |
---|
7197 | paero(ib)%volc(:) = paero(ib)%volc(:) - znfrac * paero(ib)%numc * zvexc * & |
---|
7198 | paero(ib)%volc(:) / SUM( paero(ib)%volc(1:7) ) |
---|
7199 | |
---|
7200 | !-- Number concentration (#/m3) |
---|
7201 | paero(mm)%numc = paero(mm)%numc + znfrac * paero(ib)%numc |
---|
7202 | paero(ib)%numc = paero(ib)%numc * ( 1.0_wp - znfrac ) |
---|
7203 | |
---|
7204 | ENDIF ! nclim |
---|
7205 | |
---|
7206 | IF ( paero(ib)%numc > nclim ) THEN |
---|
7207 | zvpart = SUM( paero(ib)%volc(1:7) ) / paero(ib)%numc ! Note: dry volume! |
---|
7208 | within_bins = ( paero(ib)%vlolim < zvpart .AND. zvpart < paero(ib)%vhilim ) |
---|
7209 | ENDIF |
---|
7210 | |
---|
7211 | ENDDO ! - ib |
---|
7212 | |
---|
7213 | counti = counti + 1 |
---|
7214 | IF ( counti > 100 ) THEN |
---|
7215 | message_string = 'Error: Aerosol bin update not converged' |
---|
7216 | CALL message( 'salsa_mod: distr_update', 'PA0625', 1, 2, 0, 6, 0 ) |
---|
7217 | ENDIF |
---|
7218 | |
---|
7219 | ENDDO ! - within bins |
---|
7220 | |
---|
7221 | END SUBROUTINE distr_update |
---|
7222 | |
---|
7223 | !------------------------------------------------------------------------------! |
---|
7224 | ! Description: |
---|
7225 | ! ------------ |
---|
7226 | !> salsa_diagnostics: Update properties for the current timestep: |
---|
7227 | !> |
---|
7228 | !> Juha Tonttila, FMI, 2014 |
---|
7229 | !> Tomi Raatikainen, FMI, 2016 |
---|
7230 | !------------------------------------------------------------------------------! |
---|
7231 | SUBROUTINE salsa_diagnostics( i, j ) |
---|
7232 | |
---|
7233 | USE cpulog, & |
---|
7234 | ONLY: cpu_log, log_point_s |
---|
7235 | |
---|
7236 | IMPLICIT NONE |
---|
7237 | |
---|
7238 | INTEGER(iwp) :: ib !< |
---|
7239 | INTEGER(iwp) :: ic !< |
---|
7240 | INTEGER(iwp) :: icc !< |
---|
7241 | INTEGER(iwp) :: ig !< |
---|
7242 | INTEGER(iwp) :: k !< |
---|
7243 | |
---|
7244 | INTEGER(iwp), INTENT(in) :: i !< |
---|
7245 | INTEGER(iwp), INTENT(in) :: j !< |
---|
7246 | |
---|
7247 | REAL(wp), DIMENSION(nzb:nzt+1) :: flag !< flag to mask topography |
---|
7248 | REAL(wp), DIMENSION(nzb:nzt+1) :: flag_zddry !< flag to mask zddry |
---|
7249 | REAL(wp), DIMENSION(nzb:nzt+1) :: in_adn !< air density (kg/m3) |
---|
7250 | REAL(wp), DIMENSION(nzb:nzt+1) :: in_p !< pressure |
---|
7251 | REAL(wp), DIMENSION(nzb:nzt+1) :: in_t !< temperature (K) |
---|
7252 | REAL(wp), DIMENSION(nzb:nzt+1) :: mcsum !< sum of mass concentration |
---|
7253 | REAL(wp), DIMENSION(nzb:nzt+1) :: ppm_to_nconc !< Conversion factor: ppm to #/m3 |
---|
7254 | REAL(wp), DIMENSION(nzb:nzt+1) :: zddry !< particle dry diameter |
---|
7255 | REAL(wp), DIMENSION(nzb:nzt+1) :: zvol !< particle volume |
---|
7256 | |
---|
7257 | flag_zddry = 0.0_wp |
---|
7258 | in_adn = 0.0_wp |
---|
7259 | in_p = 0.0_wp |
---|
7260 | in_t = 0.0_wp |
---|
7261 | ppm_to_nconc = 1.0_wp |
---|
7262 | zddry = 0.0_wp |
---|
7263 | zvol = 0.0_wp |
---|
7264 | |
---|
7265 | !$OMP MASTER |
---|
7266 | CALL cpu_log( log_point_s(94), 'salsa diagnostics ', 'start' ) |
---|
7267 | !$OMP END MASTER |
---|
7268 | |
---|
7269 | ! |
---|
7270 | !-- Calculate thermodynamic quantities needed in SALSA |
---|
7271 | CALL salsa_thrm_ij( i, j, p_ij=in_p, temp_ij=in_t, adn_ij=in_adn ) |
---|
7272 | ! |
---|
7273 | !-- Calculate conversion factors for gas concentrations |
---|
7274 | ppm_to_nconc = for_ppm_to_nconc * in_p / in_t |
---|
7275 | ! |
---|
7276 | !-- Predetermine flag to mask topography |
---|
7277 | flag = MERGE( 1.0_wp, 0.0_wp, BTEST( wall_flags_0(:,j,i), 0 ) ) |
---|
7278 | |
---|
7279 | DO ib = 1, nbins_aerosol ! aerosol size bins |
---|
7280 | ! |
---|
7281 | !-- Remove negative values |
---|
7282 | aerosol_number(ib)%conc(:,j,i) = MAX( nclim, aerosol_number(ib)%conc(:,j,i) ) * flag |
---|
7283 | ! |
---|
7284 | !-- Calculate total mass concentration per bin |
---|
7285 | mcsum = 0.0_wp |
---|
7286 | DO ic = 1, ncomponents_mass |
---|
7287 | icc = ( ic - 1 ) * nbins_aerosol + ib |
---|
7288 | mcsum = mcsum + aerosol_mass(icc)%conc(:,j,i) * flag |
---|
7289 | aerosol_mass(icc)%conc(:,j,i) = MAX( mclim, aerosol_mass(icc)%conc(:,j,i) ) * flag |
---|
7290 | ENDDO |
---|
7291 | ! |
---|
7292 | !-- Check that number and mass concentration match qualitatively |
---|
7293 | IF ( ANY( aerosol_number(ib)%conc(:,j,i) > nclim .AND. mcsum <= 0.0_wp ) ) THEN |
---|
7294 | DO k = nzb+1, nzt |
---|
7295 | IF ( aerosol_number(ib)%conc(k,j,i) >= nclim .AND. mcsum(k) <= 0.0_wp ) THEN |
---|
7296 | aerosol_number(ib)%conc(k,j,i) = nclim * flag(k) |
---|
7297 | DO ic = 1, ncomponents_mass |
---|
7298 | icc = ( ic - 1 ) * nbins_aerosol + ib |
---|
7299 | aerosol_mass(icc)%conc(k,j,i) = mclim * flag(k) |
---|
7300 | ENDDO |
---|
7301 | ENDIF |
---|
7302 | ENDDO |
---|
7303 | ENDIF |
---|
7304 | ! |
---|
7305 | !-- Update aerosol particle radius |
---|
7306 | CALL bin_mixrat( 'dry', ib, i, j, zvol ) |
---|
7307 | zvol = zvol / arhoh2so4 ! Why on sulphate? |
---|
7308 | ! |
---|
7309 | !-- Particles smaller then 0.1 nm diameter are set to zero |
---|
7310 | zddry = ( zvol / MAX( nclim, aerosol_number(ib)%conc(:,j,i) ) / api6 )**0.33333333_wp |
---|
7311 | flag_zddry = MERGE( 1.0_wp, 0.0_wp, ( zddry < 1.0E-10_wp .AND. & |
---|
7312 | aerosol_number(ib)%conc(:,j,i) > nclim ) ) |
---|
7313 | ! |
---|
7314 | !-- Volatile species to the gas phase |
---|
7315 | IF ( index_so4 > 0 .AND. lscndgas ) THEN |
---|
7316 | ic = ( index_so4 - 1 ) * nbins_aerosol + ib |
---|
7317 | IF ( salsa_gases_from_chem ) THEN |
---|
7318 | ig = gas_index_chem(1) |
---|
7319 | chem_species(ig)%conc(:,j,i) = chem_species(ig)%conc(:,j,i) + & |
---|
7320 | aerosol_mass(ic)%conc(:,j,i) * avo * flag_zddry / & |
---|
7321 | ( amh2so4 * ppm_to_nconc ) * flag |
---|
7322 | ELSE |
---|
7323 | salsa_gas(1)%conc(:,j,i) = salsa_gas(1)%conc(:,j,i) + aerosol_mass(ic)%conc(:,j,i) / & |
---|
7324 | amh2so4 * avo * flag_zddry * flag |
---|
7325 | ENDIF |
---|
7326 | ENDIF |
---|
7327 | IF ( index_oc > 0 .AND. lscndgas ) THEN |
---|
7328 | ic = ( index_oc - 1 ) * nbins_aerosol + ib |
---|
7329 | IF ( salsa_gases_from_chem ) THEN |
---|
7330 | ig = gas_index_chem(5) |
---|
7331 | chem_species(ig)%conc(:,j,i) = chem_species(ig)%conc(:,j,i) + & |
---|
7332 | aerosol_mass(ic)%conc(:,j,i) * avo * flag_zddry / & |
---|
7333 | ( amoc * ppm_to_nconc ) * flag |
---|
7334 | ELSE |
---|
7335 | salsa_gas(5)%conc(:,j,i) = salsa_gas(5)%conc(:,j,i) + aerosol_mass(ic)%conc(:,j,i) / & |
---|
7336 | amoc * avo * flag_zddry * flag |
---|
7337 | ENDIF |
---|
7338 | ENDIF |
---|
7339 | IF ( index_no > 0 .AND. lscndgas ) THEN |
---|
7340 | ic = ( index_no - 1 ) * nbins_aerosol + ib |
---|
7341 | IF ( salsa_gases_from_chem ) THEN |
---|
7342 | ig = gas_index_chem(2) |
---|
7343 | chem_species(ig)%conc(:,j,i) = chem_species(ig)%conc(:,j,i) + & |
---|
7344 | aerosol_mass(ic)%conc(:,j,i) * avo * flag_zddry / & |
---|
7345 | ( amhno3 * ppm_to_nconc ) *flag |
---|
7346 | ELSE |
---|
7347 | salsa_gas(2)%conc(:,j,i) = salsa_gas(2)%conc(:,j,i) + aerosol_mass(ic)%conc(:,j,i) / & |
---|
7348 | amhno3 * avo * flag_zddry * flag |
---|
7349 | ENDIF |
---|
7350 | ENDIF |
---|
7351 | IF ( index_nh > 0 .AND. lscndgas ) THEN |
---|
7352 | ic = ( index_nh - 1 ) * nbins_aerosol + ib |
---|
7353 | IF ( salsa_gases_from_chem ) THEN |
---|
7354 | ig = gas_index_chem(3) |
---|
7355 | chem_species(ig)%conc(:,j,i) = chem_species(ig)%conc(:,j,i) + & |
---|
7356 | aerosol_mass(ic)%conc(:,j,i) * avo * flag_zddry / & |
---|
7357 | ( amnh3 * ppm_to_nconc ) *flag |
---|
7358 | ELSE |
---|
7359 | salsa_gas(3)%conc(:,j,i) = salsa_gas(3)%conc(:,j,i) + aerosol_mass(ic)%conc(:,j,i) / & |
---|
7360 | amnh3 * avo * flag_zddry *flag |
---|
7361 | ENDIF |
---|
7362 | ENDIF |
---|
7363 | ! |
---|
7364 | !-- Mass and number to zero (insoluble species and water are lost) |
---|
7365 | DO ic = 1, ncomponents_mass |
---|
7366 | icc = ( ic - 1 ) * nbins_aerosol + ib |
---|
7367 | aerosol_mass(icc)%conc(:,j,i) = MERGE( mclim * flag, aerosol_mass(icc)%conc(:,j,i), & |
---|
7368 | flag_zddry > 0.0_wp ) |
---|
7369 | ENDDO |
---|
7370 | aerosol_number(ib)%conc(:,j,i) = MERGE( nclim * flag, aerosol_number(ib)%conc(:,j,i), & |
---|
7371 | flag_zddry > 0.0_wp ) |
---|
7372 | ra_dry(:,j,i,ib) = MAX( 1.0E-10_wp, 0.5_wp * zddry ) |
---|
7373 | |
---|
7374 | ENDDO |
---|
7375 | IF ( .NOT. salsa_gases_from_chem ) THEN |
---|
7376 | DO ig = 1, ngases_salsa |
---|
7377 | salsa_gas(ig)%conc(:,j,i) = MAX( nclim, salsa_gas(ig)%conc(:,j,i) ) * flag |
---|
7378 | ENDDO |
---|
7379 | ENDIF |
---|
7380 | |
---|
7381 | !$OMP MASTER |
---|
7382 | CALL cpu_log( log_point_s(94), 'salsa diagnostics ', 'stop' ) |
---|
7383 | !$OMP END MASTER |
---|
7384 | |
---|
7385 | END SUBROUTINE salsa_diagnostics |
---|
7386 | |
---|
7387 | |
---|
7388 | !------------------------------------------------------------------------------! |
---|
7389 | ! Description: |
---|
7390 | ! ------------ |
---|
7391 | !> Call for all grid points |
---|
7392 | !------------------------------------------------------------------------------! |
---|
7393 | SUBROUTINE salsa_actions( location ) |
---|
7394 | |
---|
7395 | |
---|
7396 | CHARACTER (LEN=*), INTENT(IN) :: location !< call location string |
---|
7397 | |
---|
7398 | SELECT CASE ( location ) |
---|
7399 | |
---|
7400 | CASE ( 'before_timestep' ) |
---|
7401 | |
---|
7402 | IF ( ws_scheme_sca ) sums_salsa_ws_l = 0.0_wp |
---|
7403 | |
---|
7404 | CASE DEFAULT |
---|
7405 | CONTINUE |
---|
7406 | |
---|
7407 | END SELECT |
---|
7408 | |
---|
7409 | END SUBROUTINE salsa_actions |
---|
7410 | |
---|
7411 | |
---|
7412 | !------------------------------------------------------------------------------! |
---|
7413 | ! Description: |
---|
7414 | ! ------------ |
---|
7415 | !> Call for grid points i,j |
---|
7416 | !------------------------------------------------------------------------------! |
---|
7417 | |
---|
7418 | SUBROUTINE salsa_actions_ij( i, j, location ) |
---|
7419 | |
---|
7420 | |
---|
7421 | INTEGER(iwp), INTENT(IN) :: i !< grid index in x-direction |
---|
7422 | INTEGER(iwp), INTENT(IN) :: j !< grid index in y-direction |
---|
7423 | CHARACTER (LEN=*), INTENT(IN) :: location !< call location string |
---|
7424 | INTEGER(iwp) :: dummy !< call location string |
---|
7425 | |
---|
7426 | IF ( salsa ) dummy = i + j |
---|
7427 | |
---|
7428 | SELECT CASE ( location ) |
---|
7429 | |
---|
7430 | CASE ( 'before_timestep' ) |
---|
7431 | |
---|
7432 | IF ( ws_scheme_sca ) sums_salsa_ws_l = 0.0_wp |
---|
7433 | |
---|
7434 | CASE DEFAULT |
---|
7435 | CONTINUE |
---|
7436 | |
---|
7437 | END SELECT |
---|
7438 | |
---|
7439 | |
---|
7440 | END SUBROUTINE salsa_actions_ij |
---|
7441 | |
---|
7442 | !------------------------------------------------------------------------------! |
---|
7443 | ! Description: |
---|
7444 | ! ------------ |
---|
7445 | !> Call for all grid points |
---|
7446 | !------------------------------------------------------------------------------! |
---|
7447 | SUBROUTINE salsa_non_advective_processes |
---|
7448 | |
---|
7449 | USE cpulog, & |
---|
7450 | ONLY: cpu_log, log_point_s |
---|
7451 | |
---|
7452 | IMPLICIT NONE |
---|
7453 | |
---|
7454 | INTEGER(iwp) :: i !< |
---|
7455 | INTEGER(iwp) :: j !< |
---|
7456 | |
---|
7457 | IF ( time_since_reference_point >= skip_time_do_salsa ) THEN |
---|
7458 | IF ( ( time_since_reference_point - last_salsa_time ) >= dt_salsa ) THEN |
---|
7459 | ! |
---|
7460 | !-- Calculate aerosol dynamic processes. salsa_driver can be run with a longer time step. |
---|
7461 | CALL cpu_log( log_point_s(90), 'salsa processes ', 'start' ) |
---|
7462 | DO i = nxl, nxr |
---|
7463 | DO j = nys, nyn |
---|
7464 | CALL salsa_diagnostics( i, j ) |
---|
7465 | CALL salsa_driver( i, j, 3 ) |
---|
7466 | CALL salsa_diagnostics( i, j ) |
---|
7467 | ENDDO |
---|
7468 | ENDDO |
---|
7469 | CALL cpu_log( log_point_s(90), 'salsa processes ', 'stop' ) |
---|
7470 | ENDIF |
---|
7471 | ENDIF |
---|
7472 | |
---|
7473 | END SUBROUTINE salsa_non_advective_processes |
---|
7474 | |
---|
7475 | |
---|
7476 | !------------------------------------------------------------------------------! |
---|
7477 | ! Description: |
---|
7478 | ! ------------ |
---|
7479 | !> Call for grid points i,j |
---|
7480 | !------------------------------------------------------------------------------! |
---|
7481 | SUBROUTINE salsa_non_advective_processes_ij( i, j ) |
---|
7482 | |
---|
7483 | USE cpulog, & |
---|
7484 | ONLY: cpu_log, log_point_s |
---|
7485 | |
---|
7486 | IMPLICIT NONE |
---|
7487 | |
---|
7488 | INTEGER(iwp), INTENT(IN) :: i !< grid index in x-direction |
---|
7489 | INTEGER(iwp), INTENT(IN) :: j !< grid index in y-direction |
---|
7490 | |
---|
7491 | IF ( time_since_reference_point >= skip_time_do_salsa ) THEN |
---|
7492 | IF ( ( time_since_reference_point - last_salsa_time ) >= dt_salsa ) THEN |
---|
7493 | ! |
---|
7494 | !-- Calculate aerosol dynamic processes. salsa_driver can be run with a longer time step. |
---|
7495 | CALL cpu_log( log_point_s(90), 'salsa processes ', 'start' ) |
---|
7496 | CALL salsa_diagnostics( i, j ) |
---|
7497 | CALL salsa_driver( i, j, 3 ) |
---|
7498 | CALL salsa_diagnostics( i, j ) |
---|
7499 | CALL cpu_log( log_point_s(90), 'salsa processes ', 'stop' ) |
---|
7500 | ENDIF |
---|
7501 | ENDIF |
---|
7502 | |
---|
7503 | END SUBROUTINE salsa_non_advective_processes_ij |
---|
7504 | |
---|
7505 | !------------------------------------------------------------------------------! |
---|
7506 | ! Description: |
---|
7507 | ! ------------ |
---|
7508 | !> Routine for exchange horiz of salsa variables. |
---|
7509 | !------------------------------------------------------------------------------! |
---|
7510 | SUBROUTINE salsa_exchange_horiz_bounds |
---|
7511 | |
---|
7512 | USE cpulog, & |
---|
7513 | ONLY: cpu_log, log_point_s |
---|
7514 | |
---|
7515 | IMPLICIT NONE |
---|
7516 | |
---|
7517 | INTEGER(iwp) :: ib !< |
---|
7518 | INTEGER(iwp) :: ic !< |
---|
7519 | INTEGER(iwp) :: icc !< |
---|
7520 | INTEGER(iwp) :: ig !< |
---|
7521 | |
---|
7522 | IF ( time_since_reference_point >= skip_time_do_salsa ) THEN |
---|
7523 | IF ( ( time_since_reference_point - last_salsa_time ) >= dt_salsa ) THEN |
---|
7524 | |
---|
7525 | CALL cpu_log( log_point_s(91), 'salsa exch-horiz ', 'start' ) |
---|
7526 | ! |
---|
7527 | !-- Exchange ghost points and decycle if needed. |
---|
7528 | DO ib = 1, nbins_aerosol |
---|
7529 | CALL exchange_horiz( aerosol_number(ib)%conc, nbgp ) |
---|
7530 | CALL salsa_boundary_conds( aerosol_number(ib)%conc, aerosol_number(ib)%init ) |
---|
7531 | DO ic = 1, ncomponents_mass |
---|
7532 | icc = ( ic - 1 ) * nbins_aerosol + ib |
---|
7533 | CALL exchange_horiz( aerosol_mass(icc)%conc, nbgp ) |
---|
7534 | CALL salsa_boundary_conds( aerosol_mass(icc)%conc, aerosol_mass(icc)%init ) |
---|
7535 | ENDDO |
---|
7536 | ENDDO |
---|
7537 | IF ( .NOT. salsa_gases_from_chem ) THEN |
---|
7538 | DO ig = 1, ngases_salsa |
---|
7539 | CALL exchange_horiz( salsa_gas(ig)%conc, nbgp ) |
---|
7540 | CALL salsa_boundary_conds( salsa_gas(ig)%conc, salsa_gas(ig)%init ) |
---|
7541 | ENDDO |
---|
7542 | ENDIF |
---|
7543 | CALL cpu_log( log_point_s(91), 'salsa exch-horiz ', 'stop' ) |
---|
7544 | ! |
---|
7545 | !-- Update last_salsa_time |
---|
7546 | last_salsa_time = time_since_reference_point |
---|
7547 | ENDIF |
---|
7548 | ENDIF |
---|
7549 | |
---|
7550 | END SUBROUTINE salsa_exchange_horiz_bounds |
---|
7551 | |
---|
7552 | !------------------------------------------------------------------------------! |
---|
7553 | ! Description: |
---|
7554 | ! ------------ |
---|
7555 | !> Calculate the prognostic equation for aerosol number and mass, and gas |
---|
7556 | !> concentrations. Cache-optimized. |
---|
7557 | !------------------------------------------------------------------------------! |
---|
7558 | SUBROUTINE salsa_prognostic_equations_ij( i, j, i_omp_start, tn ) |
---|
7559 | |
---|
7560 | IMPLICIT NONE |
---|
7561 | |
---|
7562 | INTEGER(iwp) :: i !< |
---|
7563 | INTEGER(iwp) :: i_omp_start !< |
---|
7564 | INTEGER(iwp) :: ib !< loop index for aerosol number bin OR gas index |
---|
7565 | INTEGER(iwp) :: ic !< loop index for aerosol mass bin |
---|
7566 | INTEGER(iwp) :: icc !< (c-1)*nbins_aerosol+b |
---|
7567 | INTEGER(iwp) :: ig !< loop index for salsa gases |
---|
7568 | INTEGER(iwp) :: j !< |
---|
7569 | INTEGER(iwp) :: tn !< |
---|
7570 | |
---|
7571 | IF ( time_since_reference_point >= skip_time_do_salsa ) THEN |
---|
7572 | ! |
---|
7573 | !-- Aerosol number |
---|
7574 | DO ib = 1, nbins_aerosol |
---|
7575 | !kk sums_salsa_ws_l = aerosol_number(ib)%sums_ws_l |
---|
7576 | CALL salsa_tendency( 'aerosol_number', aerosol_number(ib)%conc_p, aerosol_number(ib)%conc,& |
---|
7577 | aerosol_number(ib)%tconc_m, i, j, i_omp_start, tn, ib, ib, & |
---|
7578 | aerosol_number(ib)%flux_s, aerosol_number(ib)%diss_s, & |
---|
7579 | aerosol_number(ib)%flux_l, aerosol_number(ib)%diss_l, & |
---|
7580 | aerosol_number(ib)%init, .TRUE. ) |
---|
7581 | !kk aerosol_number(ib)%sums_ws_l = sums_salsa_ws_l |
---|
7582 | ! |
---|
7583 | !-- Aerosol mass |
---|
7584 | DO ic = 1, ncomponents_mass |
---|
7585 | icc = ( ic - 1 ) * nbins_aerosol + ib |
---|
7586 | !kk sums_salsa_ws_l = aerosol_mass(icc)%sums_ws_l |
---|
7587 | CALL salsa_tendency( 'aerosol_mass', aerosol_mass(icc)%conc_p, aerosol_mass(icc)%conc,& |
---|
7588 | aerosol_mass(icc)%tconc_m, i, j, i_omp_start, tn, ib, ic, & |
---|
7589 | aerosol_mass(icc)%flux_s, aerosol_mass(icc)%diss_s, & |
---|
7590 | aerosol_mass(icc)%flux_l, aerosol_mass(icc)%diss_l, & |
---|
7591 | aerosol_mass(icc)%init, .TRUE. ) |
---|
7592 | !kk aerosol_mass(icc)%sums_ws_l = sums_salsa_ws_l |
---|
7593 | |
---|
7594 | ENDDO ! ic |
---|
7595 | ENDDO ! ib |
---|
7596 | ! |
---|
7597 | !-- Gases |
---|
7598 | IF ( .NOT. salsa_gases_from_chem ) THEN |
---|
7599 | |
---|
7600 | DO ig = 1, ngases_salsa |
---|
7601 | !kk sums_salsa_ws_l = salsa_gas(ig)%sums_ws_l |
---|
7602 | CALL salsa_tendency( 'salsa_gas', salsa_gas(ig)%conc_p, salsa_gas(ig)%conc, & |
---|
7603 | salsa_gas(ig)%tconc_m, i, j, i_omp_start, tn, ig, ig, & |
---|
7604 | salsa_gas(ig)%flux_s, salsa_gas(ig)%diss_s, salsa_gas(ig)%flux_l,& |
---|
7605 | salsa_gas(ig)%diss_l, salsa_gas(ig)%init, .FALSE. ) |
---|
7606 | !kk salsa_gas(ig)%sums_ws_l = sums_salsa_ws_l |
---|
7607 | |
---|
7608 | ENDDO ! ig |
---|
7609 | |
---|
7610 | ENDIF |
---|
7611 | |
---|
7612 | ENDIF |
---|
7613 | |
---|
7614 | END SUBROUTINE salsa_prognostic_equations_ij |
---|
7615 | ! |
---|
7616 | !------------------------------------------------------------------------------! |
---|
7617 | ! Description: |
---|
7618 | ! ------------ |
---|
7619 | !> Calculate the prognostic equation for aerosol number and mass, and gas |
---|
7620 | !> concentrations. For vector machines. |
---|
7621 | !------------------------------------------------------------------------------! |
---|
7622 | SUBROUTINE salsa_prognostic_equations() |
---|
7623 | |
---|
7624 | IMPLICIT NONE |
---|
7625 | |
---|
7626 | INTEGER(iwp) :: ib !< loop index for aerosol number bin OR gas index |
---|
7627 | INTEGER(iwp) :: ic !< loop index for aerosol mass bin |
---|
7628 | INTEGER(iwp) :: icc !< (c-1)*nbins_aerosol+b |
---|
7629 | INTEGER(iwp) :: ig !< loop index for salsa gases |
---|
7630 | |
---|
7631 | IF ( time_since_reference_point >= skip_time_do_salsa ) THEN |
---|
7632 | ! |
---|
7633 | !-- Aerosol number |
---|
7634 | DO ib = 1, nbins_aerosol |
---|
7635 | sums_salsa_ws_l = aerosol_number(ib)%sums_ws_l |
---|
7636 | CALL salsa_tendency( 'aerosol_number', aerosol_number(ib)%conc_p, aerosol_number(ib)%conc,& |
---|
7637 | aerosol_number(ib)%tconc_m, ib, ib, aerosol_number(ib)%init, .TRUE. ) |
---|
7638 | aerosol_number(ib)%sums_ws_l = sums_salsa_ws_l |
---|
7639 | ! |
---|
7640 | !-- Aerosol mass |
---|
7641 | DO ic = 1, ncomponents_mass |
---|
7642 | icc = ( ic - 1 ) * nbins_aerosol + ib |
---|
7643 | sums_salsa_ws_l = aerosol_mass(icc)%sums_ws_l |
---|
7644 | CALL salsa_tendency( 'aerosol_mass', aerosol_mass(icc)%conc_p, aerosol_mass(icc)%conc,& |
---|
7645 | aerosol_mass(icc)%tconc_m, ib, ic, aerosol_mass(icc)%init, .TRUE. ) |
---|
7646 | aerosol_mass(icc)%sums_ws_l = sums_salsa_ws_l |
---|
7647 | |
---|
7648 | ENDDO ! ic |
---|
7649 | ENDDO ! ib |
---|
7650 | ! |
---|
7651 | !-- Gases |
---|
7652 | IF ( .NOT. salsa_gases_from_chem ) THEN |
---|
7653 | |
---|
7654 | DO ig = 1, ngases_salsa |
---|
7655 | sums_salsa_ws_l = salsa_gas(ig)%sums_ws_l |
---|
7656 | CALL salsa_tendency( 'salsa_gas', salsa_gas(ig)%conc_p, salsa_gas(ig)%conc, & |
---|
7657 | salsa_gas(ig)%tconc_m, ig, ig, salsa_gas(ig)%init, .FALSE. ) |
---|
7658 | salsa_gas(ig)%sums_ws_l = sums_salsa_ws_l |
---|
7659 | |
---|
7660 | ENDDO ! ig |
---|
7661 | |
---|
7662 | ENDIF |
---|
7663 | |
---|
7664 | ENDIF |
---|
7665 | |
---|
7666 | END SUBROUTINE salsa_prognostic_equations |
---|
7667 | ! |
---|
7668 | !------------------------------------------------------------------------------! |
---|
7669 | ! Description: |
---|
7670 | ! ------------ |
---|
7671 | !> Tendencies for aerosol number and mass and gas concentrations. |
---|
7672 | !> Cache-optimized. |
---|
7673 | !------------------------------------------------------------------------------! |
---|
7674 | SUBROUTINE salsa_tendency_ij( id, rs_p, rs, trs_m, i, j, i_omp_start, tn, ib, ic, flux_s, diss_s, & |
---|
7675 | flux_l, diss_l, rs_init, do_sedimentation ) |
---|
7676 | |
---|
7677 | USE advec_ws, & |
---|
7678 | ONLY: advec_s_ws |
---|
7679 | |
---|
7680 | USE advec_s_pw_mod, & |
---|
7681 | ONLY: advec_s_pw |
---|
7682 | |
---|
7683 | USE advec_s_up_mod, & |
---|
7684 | ONLY: advec_s_up |
---|
7685 | |
---|
7686 | USE arrays_3d, & |
---|
7687 | ONLY: ddzu, rdf_sc, tend |
---|
7688 | |
---|
7689 | USE diffusion_s_mod, & |
---|
7690 | ONLY: diffusion_s |
---|
7691 | |
---|
7692 | USE indices, & |
---|
7693 | ONLY: wall_flags_0 |
---|
7694 | |
---|
7695 | USE surface_mod, & |
---|
7696 | ONLY : surf_def_h, surf_def_v, surf_lsm_h, surf_lsm_v, surf_usm_h, surf_usm_v |
---|
7697 | |
---|
7698 | IMPLICIT NONE |
---|
7699 | |
---|
7700 | CHARACTER(LEN = *) :: id !< |
---|
7701 | |
---|
7702 | INTEGER(iwp) :: i !< |
---|
7703 | INTEGER(iwp) :: i_omp_start !< |
---|
7704 | INTEGER(iwp) :: ib !< loop index for aerosol number bin OR gas index |
---|
7705 | INTEGER(iwp) :: ic !< loop index for aerosol mass bin |
---|
7706 | INTEGER(iwp) :: icc !< (c-1)*nbins_aerosol+b |
---|
7707 | INTEGER(iwp) :: j !< |
---|
7708 | INTEGER(iwp) :: k !< |
---|
7709 | INTEGER(iwp) :: tn !< |
---|
7710 | |
---|
7711 | LOGICAL :: do_sedimentation !< |
---|
7712 | |
---|
7713 | REAL(wp), DIMENSION(nzb:nzt+1) :: rs_init !< |
---|
7714 | |
---|
7715 | REAL(wp), DIMENSION(nzb+1:nzt,0:threads_per_task-1) :: diss_s !< |
---|
7716 | REAL(wp), DIMENSION(nzb+1:nzt,0:threads_per_task-1) :: flux_s !< |
---|
7717 | |
---|
7718 | REAL(wp), DIMENSION(nzb+1:nzt,nys:nyn,0:threads_per_task-1) :: diss_l !< |
---|
7719 | REAL(wp), DIMENSION(nzb+1:nzt,nys:nyn,0:threads_per_task-1) :: flux_l !< |
---|
7720 | |
---|
7721 | REAL(wp), DIMENSION(nzb:nzt+1,nysg:nyng,nxlg:nxrg) :: rs_p !< |
---|
7722 | REAL(wp), DIMENSION(nzb:nzt+1,nysg:nyng,nxlg:nxrg) :: rs !< |
---|
7723 | REAL(wp), DIMENSION(nzb:nzt+1,nysg:nyng,nxlg:nxrg) :: trs_m !< |
---|
7724 | |
---|
7725 | icc = ( ic - 1 ) * nbins_aerosol + ib |
---|
7726 | ! |
---|
7727 | !-- Tendency-terms for reactive scalar |
---|
7728 | tend(:,j,i) = 0.0_wp |
---|
7729 | ! |
---|
7730 | !-- Advection terms |
---|
7731 | IF ( timestep_scheme(1:5) == 'runge' ) THEN |
---|
7732 | IF ( ws_scheme_sca ) THEN |
---|
7733 | CALL advec_s_ws( salsa_advc_flags_s, i, j, rs, id, flux_s, diss_s, flux_l, diss_l, & |
---|
7734 | i_omp_start, tn, bc_dirichlet_l .OR. bc_radiation_l, & |
---|
7735 | bc_dirichlet_n .OR. bc_radiation_n, & |
---|
7736 | bc_dirichlet_r .OR. bc_radiation_r, & |
---|
7737 | bc_dirichlet_s .OR. bc_radiation_s, monotonic_limiter_z ) |
---|
7738 | ELSE |
---|
7739 | CALL advec_s_pw( i, j, rs ) |
---|
7740 | ENDIF |
---|
7741 | ELSE |
---|
7742 | CALL advec_s_up( i, j, rs ) |
---|
7743 | ENDIF |
---|
7744 | ! |
---|
7745 | !-- Diffusion terms |
---|
7746 | SELECT CASE ( id ) |
---|
7747 | CASE ( 'aerosol_number' ) |
---|
7748 | CALL diffusion_s( i, j, rs, surf_def_h(0)%answs(:,ib), & |
---|
7749 | surf_def_h(1)%answs(:,ib), surf_def_h(2)%answs(:,ib), & |
---|
7750 | surf_lsm_h%answs(:,ib), surf_usm_h%answs(:,ib), & |
---|
7751 | surf_def_v(0)%answs(:,ib), surf_def_v(1)%answs(:,ib), & |
---|
7752 | surf_def_v(2)%answs(:,ib), surf_def_v(3)%answs(:,ib), & |
---|
7753 | surf_lsm_v(0)%answs(:,ib), surf_lsm_v(1)%answs(:,ib), & |
---|
7754 | surf_lsm_v(2)%answs(:,ib), surf_lsm_v(3)%answs(:,ib), & |
---|
7755 | surf_usm_v(0)%answs(:,ib), surf_usm_v(1)%answs(:,ib), & |
---|
7756 | surf_usm_v(2)%answs(:,ib), surf_usm_v(3)%answs(:,ib) ) |
---|
7757 | CASE ( 'aerosol_mass' ) |
---|
7758 | CALL diffusion_s( i, j, rs, surf_def_h(0)%amsws(:,icc), & |
---|
7759 | surf_def_h(1)%amsws(:,icc), surf_def_h(2)%amsws(:,icc), & |
---|
7760 | surf_lsm_h%amsws(:,icc), surf_usm_h%amsws(:,icc), & |
---|
7761 | surf_def_v(0)%amsws(:,icc), surf_def_v(1)%amsws(:,icc), & |
---|
7762 | surf_def_v(2)%amsws(:,icc), surf_def_v(3)%amsws(:,icc), & |
---|
7763 | surf_lsm_v(0)%amsws(:,icc), surf_lsm_v(1)%amsws(:,icc), & |
---|
7764 | surf_lsm_v(2)%amsws(:,icc), surf_lsm_v(3)%amsws(:,icc), & |
---|
7765 | surf_usm_v(0)%amsws(:,icc), surf_usm_v(1)%amsws(:,icc), & |
---|
7766 | surf_usm_v(2)%amsws(:,icc), surf_usm_v(3)%amsws(:,icc) ) |
---|
7767 | CASE ( 'salsa_gas' ) |
---|
7768 | CALL diffusion_s( i, j, rs, surf_def_h(0)%gtsws(:,ib), & |
---|
7769 | surf_def_h(1)%gtsws(:,ib), surf_def_h(2)%gtsws(:,ib), & |
---|
7770 | surf_lsm_h%gtsws(:,ib), surf_usm_h%gtsws(:,ib), & |
---|
7771 | surf_def_v(0)%gtsws(:,ib), surf_def_v(1)%gtsws(:,ib), & |
---|
7772 | surf_def_v(2)%gtsws(:,ib), surf_def_v(3)%gtsws(:,ib), & |
---|
7773 | surf_lsm_v(0)%gtsws(:,ib), surf_lsm_v(1)%gtsws(:,ib), & |
---|
7774 | surf_lsm_v(2)%gtsws(:,ib), surf_lsm_v(3)%gtsws(:,ib), & |
---|
7775 | surf_usm_v(0)%gtsws(:,ib), surf_usm_v(1)%gtsws(:,ib), & |
---|
7776 | surf_usm_v(2)%gtsws(:,ib), surf_usm_v(3)%gtsws(:,ib) ) |
---|
7777 | END SELECT |
---|
7778 | ! |
---|
7779 | !-- Sedimentation and prognostic equation for aerosol number and mass |
---|
7780 | IF ( lsdepo .AND. do_sedimentation ) THEN |
---|
7781 | !DIR$ IVDEP |
---|
7782 | DO k = nzb+1, nzt |
---|
7783 | tend(k,j,i) = tend(k,j,i) - MAX( 0.0_wp, ( rs(k+1,j,i) * sedim_vd(k+1,j,i,ib) - & |
---|
7784 | rs(k,j,i) * sedim_vd(k,j,i,ib) ) * ddzu(k) ) & |
---|
7785 | * MERGE( 1.0_wp, 0.0_wp, BTEST( wall_flags_0(k-1,j,i), 0 ) ) |
---|
7786 | rs_p(k,j,i) = rs(k,j,i) + ( dt_3d * ( tsc(2) * tend(k,j,i) + tsc(3) * trs_m(k,j,i) ) & |
---|
7787 | - tsc(5) * rdf_sc(k) * ( rs(k,j,i) - rs_init(k) ) ) & |
---|
7788 | * MERGE( 1.0_wp, 0.0_wp, BTEST( wall_flags_0(k,j,i), 0 ) ) |
---|
7789 | IF ( rs_p(k,j,i) < 0.0_wp ) rs_p(k,j,i) = 0.1_wp * rs(k,j,i) |
---|
7790 | ENDDO |
---|
7791 | ELSE |
---|
7792 | ! |
---|
7793 | !-- Prognostic equation |
---|
7794 | !DIR$ IVDEP |
---|
7795 | DO k = nzb+1, nzt |
---|
7796 | rs_p(k,j,i) = rs(k,j,i) + ( dt_3d * ( tsc(2) * tend(k,j,i) + tsc(3) * trs_m(k,j,i) ) & |
---|
7797 | - tsc(5) * rdf_sc(k) * ( rs(k,j,i) - rs_init(k) ) )& |
---|
7798 | * MERGE( 1.0_wp, 0.0_wp, BTEST( wall_flags_0(k,j,i), 0 ) ) |
---|
7799 | IF ( rs_p(k,j,i) < 0.0_wp ) rs_p(k,j,i) = 0.1_wp * rs(k,j,i) |
---|
7800 | ENDDO |
---|
7801 | ENDIF |
---|
7802 | ! |
---|
7803 | !-- Calculate tendencies for the next Runge-Kutta step |
---|
7804 | IF ( timestep_scheme(1:5) == 'runge' ) THEN |
---|
7805 | IF ( intermediate_timestep_count == 1 ) THEN |
---|
7806 | DO k = nzb+1, nzt |
---|
7807 | trs_m(k,j,i) = tend(k,j,i) |
---|
7808 | ENDDO |
---|
7809 | ELSEIF ( intermediate_timestep_count < intermediate_timestep_count_max ) THEN |
---|
7810 | DO k = nzb+1, nzt |
---|
7811 | trs_m(k,j,i) = -9.5625_wp * tend(k,j,i) + 5.3125_wp * trs_m(k,j,i) |
---|
7812 | ENDDO |
---|
7813 | ENDIF |
---|
7814 | ENDIF |
---|
7815 | |
---|
7816 | END SUBROUTINE salsa_tendency_ij |
---|
7817 | ! |
---|
7818 | !------------------------------------------------------------------------------! |
---|
7819 | ! Description: |
---|
7820 | ! ------------ |
---|
7821 | !> Calculate the tendencies for aerosol number and mass concentrations. |
---|
7822 | !> For vector machines. |
---|
7823 | !------------------------------------------------------------------------------! |
---|
7824 | SUBROUTINE salsa_tendency( id, rs_p, rs, trs_m, ib, ic, rs_init, do_sedimentation ) |
---|
7825 | |
---|
7826 | USE advec_ws, & |
---|
7827 | ONLY: advec_s_ws |
---|
7828 | USE advec_s_pw_mod, & |
---|
7829 | ONLY: advec_s_pw |
---|
7830 | USE advec_s_up_mod, & |
---|
7831 | ONLY: advec_s_up |
---|
7832 | USE arrays_3d, & |
---|
7833 | ONLY: ddzu, rdf_sc, tend |
---|
7834 | USE diffusion_s_mod, & |
---|
7835 | ONLY: diffusion_s |
---|
7836 | USE indices, & |
---|
7837 | ONLY: wall_flags_0 |
---|
7838 | USE surface_mod, & |
---|
7839 | ONLY : surf_def_h, surf_def_v, surf_lsm_h, surf_lsm_v, surf_usm_h, surf_usm_v |
---|
7840 | |
---|
7841 | IMPLICIT NONE |
---|
7842 | |
---|
7843 | CHARACTER(LEN = *) :: id |
---|
7844 | |
---|
7845 | INTEGER(iwp) :: ib !< loop index for aerosol number bin OR gas index |
---|
7846 | INTEGER(iwp) :: ic !< loop index for aerosol mass bin |
---|
7847 | INTEGER(iwp) :: icc !< (c-1)*nbins_aerosol+b |
---|
7848 | INTEGER(iwp) :: i !< |
---|
7849 | INTEGER(iwp) :: j !< |
---|
7850 | INTEGER(iwp) :: k !< |
---|
7851 | |
---|
7852 | LOGICAL :: do_sedimentation !< |
---|
7853 | |
---|
7854 | REAL(wp), DIMENSION(nzb:nzt+1) :: rs_init !< |
---|
7855 | |
---|
7856 | REAL(wp), DIMENSION(:,:,:), POINTER :: rs_p !< |
---|
7857 | REAL(wp), DIMENSION(:,:,:), POINTER :: rs !< |
---|
7858 | REAL(wp), DIMENSION(:,:,:), POINTER :: trs_m !< |
---|
7859 | |
---|
7860 | icc = ( ic - 1 ) * nbins_aerosol + ib |
---|
7861 | ! |
---|
7862 | !-- Tendency-terms for reactive scalar |
---|
7863 | tend = 0.0_wp |
---|
7864 | ! |
---|
7865 | !-- Advection terms |
---|
7866 | IF ( timestep_scheme(1:5) == 'runge' ) THEN |
---|
7867 | IF ( ws_scheme_sca ) THEN |
---|
7868 | CALL advec_s_ws( salsa_advc_flags_s, rs, id, bc_dirichlet_l .OR. bc_radiation_l, & |
---|
7869 | bc_dirichlet_n .OR. bc_radiation_n, & |
---|
7870 | bc_dirichlet_r .OR. bc_radiation_r, & |
---|
7871 | bc_dirichlet_s .OR. bc_radiation_s ) |
---|
7872 | ELSE |
---|
7873 | CALL advec_s_pw( rs ) |
---|
7874 | ENDIF |
---|
7875 | ELSE |
---|
7876 | CALL advec_s_up( rs ) |
---|
7877 | ENDIF |
---|
7878 | ! |
---|
7879 | !-- Diffusion terms |
---|
7880 | SELECT CASE ( id ) |
---|
7881 | CASE ( 'aerosol_number' ) |
---|
7882 | CALL diffusion_s( rs, surf_def_h(0)%answs(:,ib), & |
---|
7883 | surf_def_h(1)%answs(:,ib), surf_def_h(2)%answs(:,ib), & |
---|
7884 | surf_lsm_h%answs(:,ib), surf_usm_h%answs(:,ib), & |
---|
7885 | surf_def_v(0)%answs(:,ib), surf_def_v(1)%answs(:,ib), & |
---|
7886 | surf_def_v(2)%answs(:,ib), surf_def_v(3)%answs(:,ib), & |
---|
7887 | surf_lsm_v(0)%answs(:,ib), surf_lsm_v(1)%answs(:,ib), & |
---|
7888 | surf_lsm_v(2)%answs(:,ib), surf_lsm_v(3)%answs(:,ib), & |
---|
7889 | surf_usm_v(0)%answs(:,ib), surf_usm_v(1)%answs(:,ib), & |
---|
7890 | surf_usm_v(2)%answs(:,ib), surf_usm_v(3)%answs(:,ib) ) |
---|
7891 | CASE ( 'aerosol_mass' ) |
---|
7892 | CALL diffusion_s( rs, surf_def_h(0)%amsws(:,icc), & |
---|
7893 | surf_def_h(1)%amsws(:,icc), surf_def_h(2)%amsws(:,icc), & |
---|
7894 | surf_lsm_h%amsws(:,icc), surf_usm_h%amsws(:,icc), & |
---|
7895 | surf_def_v(0)%amsws(:,icc), surf_def_v(1)%amsws(:,icc), & |
---|
7896 | surf_def_v(2)%amsws(:,icc), surf_def_v(3)%amsws(:,icc), & |
---|
7897 | surf_lsm_v(0)%amsws(:,icc), surf_lsm_v(1)%amsws(:,icc), & |
---|
7898 | surf_lsm_v(2)%amsws(:,icc), surf_lsm_v(3)%amsws(:,icc), & |
---|
7899 | surf_usm_v(0)%amsws(:,icc), surf_usm_v(1)%amsws(:,icc), & |
---|
7900 | surf_usm_v(2)%amsws(:,icc), surf_usm_v(3)%amsws(:,icc) ) |
---|
7901 | CASE ( 'salsa_gas' ) |
---|
7902 | CALL diffusion_s( rs, surf_def_h(0)%gtsws(:,ib), & |
---|
7903 | surf_def_h(1)%gtsws(:,ib), surf_def_h(2)%gtsws(:,ib), & |
---|
7904 | surf_lsm_h%gtsws(:,ib), surf_usm_h%gtsws(:,ib), & |
---|
7905 | surf_def_v(0)%gtsws(:,ib), surf_def_v(1)%gtsws(:,ib), & |
---|
7906 | surf_def_v(2)%gtsws(:,ib), surf_def_v(3)%gtsws(:,ib), & |
---|
7907 | surf_lsm_v(0)%gtsws(:,ib), surf_lsm_v(1)%gtsws(:,ib), & |
---|
7908 | surf_lsm_v(2)%gtsws(:,ib), surf_lsm_v(3)%gtsws(:,ib), & |
---|
7909 | surf_usm_v(0)%gtsws(:,ib), surf_usm_v(1)%gtsws(:,ib), & |
---|
7910 | surf_usm_v(2)%gtsws(:,ib), surf_usm_v(3)%gtsws(:,ib) ) |
---|
7911 | END SELECT |
---|
7912 | ! |
---|
7913 | !-- Prognostic equation for a scalar |
---|
7914 | DO i = nxl, nxr |
---|
7915 | DO j = nys, nyn |
---|
7916 | ! |
---|
7917 | !-- Sedimentation for aerosol number and mass |
---|
7918 | IF ( lsdepo .AND. do_sedimentation ) THEN |
---|
7919 | tend(nzb+1:nzt,j,i) = tend(nzb+1:nzt,j,i) - MAX( 0.0_wp, ( rs(nzb+2:nzt+1,j,i) * & |
---|
7920 | sedim_vd(nzb+2:nzt+1,j,i,ib) - rs(nzb+1:nzt,j,i) * & |
---|
7921 | sedim_vd(nzb+1:nzt,j,i,ib) ) * ddzu(nzb+1:nzt) ) * & |
---|
7922 | MERGE( 1.0_wp, 0.0_wp, BTEST( wall_flags_0(nzb:nzt-1,j,i), 0 ) ) |
---|
7923 | ENDIF |
---|
7924 | DO k = nzb+1, nzt |
---|
7925 | rs_p(k,j,i) = rs(k,j,i) + ( dt_3d * ( tsc(2) * tend(k,j,i) + tsc(3) * trs_m(k,j,i) )& |
---|
7926 | - tsc(5) * rdf_sc(k) * ( rs(k,j,i) - rs_init(k) )& |
---|
7927 | ) * MERGE( 1.0_wp, 0.0_wp, BTEST( wall_flags_0(k,j,i), 0 ) ) |
---|
7928 | IF ( rs_p(k,j,i) < 0.0_wp ) rs_p(k,j,i) = 0.1_wp * rs(k,j,i) |
---|
7929 | ENDDO |
---|
7930 | ENDDO |
---|
7931 | ENDDO |
---|
7932 | ! |
---|
7933 | !-- Calculate tendencies for the next Runge-Kutta step |
---|
7934 | IF ( timestep_scheme(1:5) == 'runge' ) THEN |
---|
7935 | IF ( intermediate_timestep_count == 1 ) THEN |
---|
7936 | DO i = nxl, nxr |
---|
7937 | DO j = nys, nyn |
---|
7938 | DO k = nzb+1, nzt |
---|
7939 | trs_m(k,j,i) = tend(k,j,i) |
---|
7940 | ENDDO |
---|
7941 | ENDDO |
---|
7942 | ENDDO |
---|
7943 | ELSEIF ( intermediate_timestep_count < intermediate_timestep_count_max ) THEN |
---|
7944 | DO i = nxl, nxr |
---|
7945 | DO j = nys, nyn |
---|
7946 | DO k = nzb+1, nzt |
---|
7947 | trs_m(k,j,i) = -9.5625_wp * tend(k,j,i) + 5.3125_wp * trs_m(k,j,i) |
---|
7948 | ENDDO |
---|
7949 | ENDDO |
---|
7950 | ENDDO |
---|
7951 | ENDIF |
---|
7952 | ENDIF |
---|
7953 | |
---|
7954 | END SUBROUTINE salsa_tendency |
---|
7955 | |
---|
7956 | !------------------------------------------------------------------------------! |
---|
7957 | ! Description: |
---|
7958 | ! ------------ |
---|
7959 | !> Boundary conditions for prognostic variables in SALSA |
---|
7960 | !------------------------------------------------------------------------------! |
---|
7961 | SUBROUTINE salsa_boundary_conds |
---|
7962 | |
---|
7963 | USE arrays_3d, & |
---|
7964 | ONLY: dzu |
---|
7965 | |
---|
7966 | USE surface_mod, & |
---|
7967 | ONLY : bc_h |
---|
7968 | |
---|
7969 | IMPLICIT NONE |
---|
7970 | |
---|
7971 | INTEGER(iwp) :: i !< grid index x direction |
---|
7972 | INTEGER(iwp) :: ib !< index for aerosol size bins |
---|
7973 | INTEGER(iwp) :: ic !< index for chemical compounds in aerosols |
---|
7974 | INTEGER(iwp) :: icc !< additional index for chemical compounds in aerosols |
---|
7975 | INTEGER(iwp) :: ig !< idex for gaseous compounds |
---|
7976 | INTEGER(iwp) :: j !< grid index y direction |
---|
7977 | INTEGER(iwp) :: k !< grid index y direction |
---|
7978 | INTEGER(iwp) :: l !< running index boundary type, for up- and downward-facing walls |
---|
7979 | INTEGER(iwp) :: m !< running index surface elements |
---|
7980 | |
---|
7981 | IF ( time_since_reference_point >= skip_time_do_salsa ) THEN |
---|
7982 | |
---|
7983 | ! |
---|
7984 | !-- Surface conditions: |
---|
7985 | IF ( ibc_salsa_b == 0 ) THEN ! Dirichlet |
---|
7986 | ! |
---|
7987 | !-- Run loop over all non-natural and natural walls. Note, in wall-datatype the k coordinate |
---|
7988 | !-- belongs to the atmospheric grid point, therefore, set s_p at k-1 |
---|
7989 | DO l = 0, 1 |
---|
7990 | !$OMP PARALLEL PRIVATE( ib, ic, icc, ig, i, j, k ) |
---|
7991 | !$OMP DO |
---|
7992 | DO m = 1, bc_h(l)%ns |
---|
7993 | |
---|
7994 | i = bc_h(l)%i(m) |
---|
7995 | j = bc_h(l)%j(m) |
---|
7996 | k = bc_h(l)%k(m) |
---|
7997 | |
---|
7998 | DO ib = 1, nbins_aerosol |
---|
7999 | aerosol_number(ib)%conc_p(k+bc_h(l)%koff,j,i) = & |
---|
8000 | aerosol_number(ib)%conc(k+bc_h(l)%koff,j,i) |
---|
8001 | DO ic = 1, ncomponents_mass |
---|
8002 | icc = ( ic - 1 ) * nbins_aerosol + ib |
---|
8003 | aerosol_mass(icc)%conc_p(k+bc_h(l)%koff,j,i) = & |
---|
8004 | aerosol_mass(icc)%conc(k+bc_h(l)%koff,j,i) |
---|
8005 | ENDDO |
---|
8006 | ENDDO |
---|
8007 | IF ( .NOT. salsa_gases_from_chem ) THEN |
---|
8008 | DO ig = 1, ngases_salsa |
---|
8009 | salsa_gas(ig)%conc_p(k+bc_h(l)%koff,j,i) = & |
---|
8010 | salsa_gas(ig)%conc(k+bc_h(l)%koff,j,i) |
---|
8011 | ENDDO |
---|
8012 | ENDIF |
---|
8013 | |
---|
8014 | ENDDO |
---|
8015 | !$OMP END PARALLEL |
---|
8016 | |
---|
8017 | ENDDO |
---|
8018 | |
---|
8019 | ELSE ! Neumann |
---|
8020 | |
---|
8021 | DO l = 0, 1 |
---|
8022 | !$OMP PARALLEL PRIVATE( ib, ic, icc, ig, i, j, k ) |
---|
8023 | !$OMP DO |
---|
8024 | DO m = 1, bc_h(l)%ns |
---|
8025 | |
---|
8026 | i = bc_h(l)%i(m) |
---|
8027 | j = bc_h(l)%j(m) |
---|
8028 | k = bc_h(l)%k(m) |
---|
8029 | |
---|
8030 | DO ib = 1, nbins_aerosol |
---|
8031 | aerosol_number(ib)%conc_p(k+bc_h(l)%koff,j,i) = & |
---|
8032 | aerosol_number(ib)%conc_p(k,j,i) |
---|
8033 | DO ic = 1, ncomponents_mass |
---|
8034 | icc = ( ic - 1 ) * nbins_aerosol + ib |
---|
8035 | aerosol_mass(icc)%conc_p(k+bc_h(l)%koff,j,i) = & |
---|
8036 | aerosol_mass(icc)%conc_p(k,j,i) |
---|
8037 | ENDDO |
---|
8038 | ENDDO |
---|
8039 | IF ( .NOT. salsa_gases_from_chem ) THEN |
---|
8040 | DO ig = 1, ngases_salsa |
---|
8041 | salsa_gas(ig)%conc_p(k+bc_h(l)%koff,j,i) = & |
---|
8042 | salsa_gas(ig)%conc_p(k,j,i) |
---|
8043 | ENDDO |
---|
8044 | ENDIF |
---|
8045 | |
---|
8046 | ENDDO |
---|
8047 | !$OMP END PARALLEL |
---|
8048 | ENDDO |
---|
8049 | |
---|
8050 | ENDIF |
---|
8051 | ! |
---|
8052 | !-- Top boundary conditions: |
---|
8053 | IF ( ibc_salsa_t == 0 ) THEN ! Dirichlet |
---|
8054 | |
---|
8055 | DO ib = 1, nbins_aerosol |
---|
8056 | aerosol_number(ib)%conc_p(nzt+1,:,:) = aerosol_number(ib)%conc(nzt+1,:,:) |
---|
8057 | DO ic = 1, ncomponents_mass |
---|
8058 | icc = ( ic - 1 ) * nbins_aerosol + ib |
---|
8059 | aerosol_mass(icc)%conc_p(nzt+1,:,:) = aerosol_mass(icc)%conc(nzt+1,:,:) |
---|
8060 | ENDDO |
---|
8061 | ENDDO |
---|
8062 | IF ( .NOT. salsa_gases_from_chem ) THEN |
---|
8063 | DO ig = 1, ngases_salsa |
---|
8064 | salsa_gas(ig)%conc_p(nzt+1,:,:) = salsa_gas(ig)%conc(nzt+1,:,:) |
---|
8065 | ENDDO |
---|
8066 | ENDIF |
---|
8067 | |
---|
8068 | ELSEIF ( ibc_salsa_t == 1 ) THEN ! Neumann |
---|
8069 | |
---|
8070 | DO ib = 1, nbins_aerosol |
---|
8071 | aerosol_number(ib)%conc_p(nzt+1,:,:) = aerosol_number(ib)%conc_p(nzt,:,:) |
---|
8072 | DO ic = 1, ncomponents_mass |
---|
8073 | icc = ( ic - 1 ) * nbins_aerosol + ib |
---|
8074 | aerosol_mass(icc)%conc_p(nzt+1,:,:) = aerosol_mass(icc)%conc_p(nzt,:,:) |
---|
8075 | ENDDO |
---|
8076 | ENDDO |
---|
8077 | IF ( .NOT. salsa_gases_from_chem ) THEN |
---|
8078 | DO ig = 1, ngases_salsa |
---|
8079 | salsa_gas(ig)%conc_p(nzt+1,:,:) = salsa_gas(ig)%conc_p(nzt,:,:) |
---|
8080 | ENDDO |
---|
8081 | ENDIF |
---|
8082 | |
---|
8083 | ELSEIF ( ibc_salsa_t == 2 ) THEN ! nested |
---|
8084 | |
---|
8085 | DO ib = 1, nbins_aerosol |
---|
8086 | aerosol_number(ib)%conc_p(nzt+1,:,:) = aerosol_number(ib)%conc_p(nzt,:,:) + & |
---|
8087 | bc_an_t_val(ib) * dzu(nzt+1) |
---|
8088 | DO ic = 1, ncomponents_mass |
---|
8089 | icc = ( ic - 1 ) * nbins_aerosol + ib |
---|
8090 | aerosol_mass(icc)%conc_p(nzt+1,:,:) = aerosol_mass(icc)%conc_p(nzt,:,:) + & |
---|
8091 | bc_am_t_val(icc) * dzu(nzt+1) |
---|
8092 | ENDDO |
---|
8093 | ENDDO |
---|
8094 | IF ( .NOT. salsa_gases_from_chem ) THEN |
---|
8095 | DO ig = 1, ngases_salsa |
---|
8096 | salsa_gas(ig)%conc_p(nzt+1,:,:) = salsa_gas(ig)%conc_p(nzt,:,:) + & |
---|
8097 | bc_gt_t_val(ig) * dzu(nzt+1) |
---|
8098 | ENDDO |
---|
8099 | ENDIF |
---|
8100 | |
---|
8101 | ENDIF |
---|
8102 | ! |
---|
8103 | !-- Lateral boundary conditions at the outflow |
---|
8104 | IF ( bc_radiation_s ) THEN |
---|
8105 | DO ib = 1, nbins_aerosol |
---|
8106 | aerosol_number(ib)%conc_p(:,nys-1,:) = aerosol_number(ib)%conc_p(:,nys,:) |
---|
8107 | DO ic = 1, ncomponents_mass |
---|
8108 | icc = ( ic - 1 ) * nbins_aerosol + ib |
---|
8109 | aerosol_mass(icc)%conc_p(:,nys-1,:) = aerosol_mass(icc)%conc_p(:,nys,:) |
---|
8110 | ENDDO |
---|
8111 | ENDDO |
---|
8112 | IF ( .NOT. salsa_gases_from_chem ) THEN |
---|
8113 | DO ig = 1, ngases_salsa |
---|
8114 | salsa_gas(ig)%conc_p(:,nys-1,:) = salsa_gas(ig)%conc_p(:,nys,:) |
---|
8115 | ENDDO |
---|
8116 | ENDIF |
---|
8117 | |
---|
8118 | ELSEIF ( bc_radiation_n ) THEN |
---|
8119 | DO ib = 1, nbins_aerosol |
---|
8120 | aerosol_number(ib)%conc_p(:,nyn+1,:) = aerosol_number(ib)%conc_p(:,nyn,:) |
---|
8121 | DO ic = 1, ncomponents_mass |
---|
8122 | icc = ( ic - 1 ) * nbins_aerosol + ib |
---|
8123 | aerosol_mass(icc)%conc_p(:,nyn+1,:) = aerosol_mass(icc)%conc_p(:,nyn,:) |
---|
8124 | ENDDO |
---|
8125 | ENDDO |
---|
8126 | IF ( .NOT. salsa_gases_from_chem ) THEN |
---|
8127 | DO ig = 1, ngases_salsa |
---|
8128 | salsa_gas(ig)%conc_p(:,nyn+1,:) = salsa_gas(ig)%conc_p(:,nyn,:) |
---|
8129 | ENDDO |
---|
8130 | ENDIF |
---|
8131 | |
---|
8132 | ELSEIF ( bc_radiation_l ) THEN |
---|
8133 | DO ib = 1, nbins_aerosol |
---|
8134 | aerosol_number(ib)%conc_p(:,:,nxl-1) = aerosol_number(ib)%conc_p(:,:,nxl) |
---|
8135 | DO ic = 1, ncomponents_mass |
---|
8136 | icc = ( ic - 1 ) * nbins_aerosol + ib |
---|
8137 | aerosol_mass(icc)%conc_p(:,:,nxl-1) = aerosol_mass(icc)%conc_p(:,:,nxl) |
---|
8138 | ENDDO |
---|
8139 | ENDDO |
---|
8140 | IF ( .NOT. salsa_gases_from_chem ) THEN |
---|
8141 | DO ig = 1, ngases_salsa |
---|
8142 | salsa_gas(ig)%conc_p(:,:,nxl-1) = salsa_gas(ig)%conc_p(:,:,nxl) |
---|
8143 | ENDDO |
---|
8144 | ENDIF |
---|
8145 | |
---|
8146 | ELSEIF ( bc_radiation_r ) THEN |
---|
8147 | DO ib = 1, nbins_aerosol |
---|
8148 | aerosol_number(ib)%conc_p(:,:,nxr+1) = aerosol_number(ib)%conc_p(:,:,nxr) |
---|
8149 | DO ic = 1, ncomponents_mass |
---|
8150 | icc = ( ic - 1 ) * nbins_aerosol + ib |
---|
8151 | aerosol_mass(icc)%conc_p(:,:,nxr+1) = aerosol_mass(icc)%conc_p(:,:,nxr) |
---|
8152 | ENDDO |
---|
8153 | ENDDO |
---|
8154 | IF ( .NOT. salsa_gases_from_chem ) THEN |
---|
8155 | DO ig = 1, ngases_salsa |
---|
8156 | salsa_gas(ig)%conc_p(:,:,nxr+1) = salsa_gas(ig)%conc_p(:,:,nxr) |
---|
8157 | ENDDO |
---|
8158 | ENDIF |
---|
8159 | |
---|
8160 | ENDIF |
---|
8161 | |
---|
8162 | ENDIF |
---|
8163 | |
---|
8164 | END SUBROUTINE salsa_boundary_conds |
---|
8165 | |
---|
8166 | !------------------------------------------------------------------------------! |
---|
8167 | ! Description: |
---|
8168 | ! ------------ |
---|
8169 | ! Undoing of the previously done cyclic boundary conditions. |
---|
8170 | !------------------------------------------------------------------------------! |
---|
8171 | SUBROUTINE salsa_boundary_conds_decycle ( sq, sq_init ) |
---|
8172 | |
---|
8173 | IMPLICIT NONE |
---|
8174 | |
---|
8175 | INTEGER(iwp) :: boundary !< |
---|
8176 | INTEGER(iwp) :: ee !< |
---|
8177 | INTEGER(iwp) :: copied !< |
---|
8178 | INTEGER(iwp) :: i !< |
---|
8179 | INTEGER(iwp) :: j !< |
---|
8180 | INTEGER(iwp) :: k !< |
---|
8181 | INTEGER(iwp) :: ss !< |
---|
8182 | |
---|
8183 | REAL(wp) :: flag !< flag to mask topography grid points |
---|
8184 | |
---|
8185 | REAL(wp), DIMENSION(nzb:nzt+1) :: sq_init !< initial concentration profile |
---|
8186 | |
---|
8187 | REAL(wp), DIMENSION(nzb:nzt+1,nysg:nyng,nxlg:nxrg) :: sq !< concentration array |
---|
8188 | |
---|
8189 | flag = 0.0_wp |
---|
8190 | ! |
---|
8191 | !-- Left and right boundaries |
---|
8192 | IF ( decycle_salsa_lr .AND. ( bc_lr_cyc .OR. bc_lr == 'nested' ) ) THEN |
---|
8193 | |
---|
8194 | DO boundary = 1, 2 |
---|
8195 | |
---|
8196 | IF ( decycle_method_salsa(boundary) == 'dirichlet' ) THEN |
---|
8197 | ! |
---|
8198 | !-- Initial profile is copied to ghost and first three layers |
---|
8199 | ss = 1 |
---|
8200 | ee = 0 |
---|
8201 | IF ( boundary == 1 .AND. nxl == 0 ) THEN |
---|
8202 | ss = nxlg |
---|
8203 | ee = nxl-1 |
---|
8204 | ELSEIF ( boundary == 2 .AND. nxr == nx ) THEN |
---|
8205 | ss = nxr+1 |
---|
8206 | ee = nxrg |
---|
8207 | ENDIF |
---|
8208 | |
---|
8209 | DO i = ss, ee |
---|
8210 | DO j = nysg, nyng |
---|
8211 | DO k = nzb+1, nzt |
---|
8212 | flag = MERGE( 1.0_wp, 0.0_wp, BTEST( wall_flags_0(k,j,i), 0 ) ) |
---|
8213 | sq(k,j,i) = sq_init(k) * flag |
---|
8214 | ENDDO |
---|
8215 | ENDDO |
---|
8216 | ENDDO |
---|
8217 | |
---|
8218 | ELSEIF ( decycle_method_salsa(boundary) == 'neumann' ) THEN |
---|
8219 | ! |
---|
8220 | !-- The value at the boundary is copied to the ghost layers to simulate an outlet with |
---|
8221 | !-- zero gradient |
---|
8222 | ss = 1 |
---|
8223 | ee = 0 |
---|
8224 | IF ( boundary == 1 .AND. nxl == 0 ) THEN |
---|
8225 | ss = nxlg |
---|
8226 | ee = nxl-1 |
---|
8227 | copied = nxl |
---|
8228 | ELSEIF ( boundary == 2 .AND. nxr == nx ) THEN |
---|
8229 | ss = nxr+1 |
---|
8230 | ee = nxrg |
---|
8231 | copied = nxr |
---|
8232 | ENDIF |
---|
8233 | |
---|
8234 | DO i = ss, ee |
---|
8235 | DO j = nysg, nyng |
---|
8236 | DO k = nzb+1, nzt |
---|
8237 | flag = MERGE( 1.0_wp, 0.0_wp, BTEST( wall_flags_0(k,j,i), 0 ) ) |
---|
8238 | sq(k,j,i) = sq(k,j,copied) * flag |
---|
8239 | ENDDO |
---|
8240 | ENDDO |
---|
8241 | ENDDO |
---|
8242 | |
---|
8243 | ELSE |
---|
8244 | WRITE(message_string,*) 'unknown decycling method: decycle_method_salsa (', boundary, & |
---|
8245 | ') ="' // TRIM( decycle_method_salsa(boundary) ) // '"' |
---|
8246 | CALL message( 'salsa_boundary_conds_decycle', 'PA0626', 1, 2, 0, 6, 0 ) |
---|
8247 | ENDIF |
---|
8248 | ENDDO |
---|
8249 | ENDIF |
---|
8250 | |
---|
8251 | ! |
---|
8252 | !-- South and north boundaries |
---|
8253 | IF ( decycle_salsa_ns .AND. ( bc_ns_cyc .OR. bc_ns == 'nested' ) ) THEN |
---|
8254 | |
---|
8255 | DO boundary = 3, 4 |
---|
8256 | |
---|
8257 | IF ( decycle_method_salsa(boundary) == 'dirichlet' ) THEN |
---|
8258 | ! |
---|
8259 | !-- Initial profile is copied to ghost and first three layers |
---|
8260 | ss = 1 |
---|
8261 | ee = 0 |
---|
8262 | IF ( boundary == 3 .AND. nys == 0 ) THEN |
---|
8263 | ss = nysg |
---|
8264 | ee = nys-1 |
---|
8265 | ELSEIF ( boundary == 4 .AND. nyn == ny ) THEN |
---|
8266 | ss = nyn+1 |
---|
8267 | ee = nyng |
---|
8268 | ENDIF |
---|
8269 | |
---|
8270 | DO i = nxlg, nxrg |
---|
8271 | DO j = ss, ee |
---|
8272 | DO k = nzb+1, nzt |
---|
8273 | flag = MERGE( 1.0_wp, 0.0_wp, BTEST( wall_flags_0(k,j,i), 0 ) ) |
---|
8274 | sq(k,j,i) = sq_init(k) * flag |
---|
8275 | ENDDO |
---|
8276 | ENDDO |
---|
8277 | ENDDO |
---|
8278 | |
---|
8279 | ELSEIF ( decycle_method_salsa(boundary) == 'neumann' ) THEN |
---|
8280 | ! |
---|
8281 | !-- The value at the boundary is copied to the ghost layers to simulate an outlet with |
---|
8282 | !-- zero gradient |
---|
8283 | ss = 1 |
---|
8284 | ee = 0 |
---|
8285 | IF ( boundary == 3 .AND. nys == 0 ) THEN |
---|
8286 | ss = nysg |
---|
8287 | ee = nys-1 |
---|
8288 | copied = nys |
---|
8289 | ELSEIF ( boundary == 4 .AND. nyn == ny ) THEN |
---|
8290 | ss = nyn+1 |
---|
8291 | ee = nyng |
---|
8292 | copied = nyn |
---|
8293 | ENDIF |
---|
8294 | |
---|
8295 | DO i = nxlg, nxrg |
---|
8296 | DO j = ss, ee |
---|
8297 | DO k = nzb+1, nzt |
---|
8298 | flag = MERGE( 1.0_wp, 0.0_wp, BTEST( wall_flags_0(k,j,i), 0 ) ) |
---|
8299 | sq(k,j,i) = sq(k,copied,i) * flag |
---|
8300 | ENDDO |
---|
8301 | ENDDO |
---|
8302 | ENDDO |
---|
8303 | |
---|
8304 | ELSE |
---|
8305 | WRITE(message_string,*) 'unknown decycling method: decycle_method_salsa (', boundary, & |
---|
8306 | ') ="' // TRIM( decycle_method_salsa(boundary) ) // '"' |
---|
8307 | CALL message( 'salsa_boundary_conds_decycle', 'PA0627', 1, 2, 0, 6, 0 ) |
---|
8308 | ENDIF |
---|
8309 | ENDDO |
---|
8310 | ENDIF |
---|
8311 | |
---|
8312 | END SUBROUTINE salsa_boundary_conds_decycle |
---|
8313 | |
---|
8314 | !------------------------------------------------------------------------------! |
---|
8315 | ! Description: |
---|
8316 | ! ------------ |
---|
8317 | !> Calculates the total dry or wet mass concentration for individual bins |
---|
8318 | !> Juha Tonttila (FMI) 2015 |
---|
8319 | !> Tomi Raatikainen (FMI) 2016 |
---|
8320 | !------------------------------------------------------------------------------! |
---|
8321 | SUBROUTINE bin_mixrat( itype, ibin, i, j, mconc ) |
---|
8322 | |
---|
8323 | IMPLICIT NONE |
---|
8324 | |
---|
8325 | CHARACTER(len=*), INTENT(in) :: itype !< 'dry' or 'wet' |
---|
8326 | |
---|
8327 | INTEGER(iwp) :: ic !< loop index for mass bin number |
---|
8328 | INTEGER(iwp) :: iend !< end index: include water or not |
---|
8329 | |
---|
8330 | INTEGER(iwp), INTENT(in) :: ibin !< index of the chemical component |
---|
8331 | INTEGER(iwp), INTENT(in) :: i !< loop index for x-direction |
---|
8332 | INTEGER(iwp), INTENT(in) :: j !< loop index for y-direction |
---|
8333 | |
---|
8334 | REAL(wp), DIMENSION(:), INTENT(out) :: mconc !< total dry or wet mass concentration |
---|
8335 | |
---|
8336 | !-- Number of components |
---|
8337 | IF ( itype == 'dry' ) THEN |
---|
8338 | iend = prtcl%ncomp - 1 |
---|
8339 | ELSE IF ( itype == 'wet' ) THEN |
---|
8340 | iend = prtcl%ncomp |
---|
8341 | ELSE |
---|
8342 | message_string = 'Error in itype!' |
---|
8343 | CALL message( 'bin_mixrat', 'PA0628', 2, 2, 0, 6, 0 ) |
---|
8344 | ENDIF |
---|
8345 | |
---|
8346 | mconc = 0.0_wp |
---|
8347 | |
---|
8348 | DO ic = ibin, iend*nbins_aerosol+ibin, nbins_aerosol !< every nbins'th element |
---|
8349 | mconc = mconc + aerosol_mass(ic)%conc(:,j,i) |
---|
8350 | ENDDO |
---|
8351 | |
---|
8352 | END SUBROUTINE bin_mixrat |
---|
8353 | |
---|
8354 | !------------------------------------------------------------------------------! |
---|
8355 | ! Description: |
---|
8356 | ! ------------ |
---|
8357 | !> Sets surface fluxes |
---|
8358 | !------------------------------------------------------------------------------! |
---|
8359 | SUBROUTINE salsa_emission_update |
---|
8360 | |
---|
8361 | IMPLICIT NONE |
---|
8362 | |
---|
8363 | IF ( include_emission ) THEN |
---|
8364 | |
---|
8365 | IF ( time_since_reference_point >= skip_time_do_salsa ) THEN |
---|
8366 | |
---|
8367 | IF ( next_aero_emission_update <= time_since_reference_point ) THEN |
---|
8368 | CALL salsa_emission_setup( .FALSE. ) |
---|
8369 | ENDIF |
---|
8370 | |
---|
8371 | IF ( next_gas_emission_update <= time_since_reference_point ) THEN |
---|
8372 | IF ( salsa_emission_mode == 'read_from_file' .AND. .NOT. salsa_gases_from_chem ) & |
---|
8373 | THEN |
---|
8374 | CALL salsa_gas_emission_setup( .FALSE. ) |
---|
8375 | ENDIF |
---|
8376 | ENDIF |
---|
8377 | |
---|
8378 | ENDIF |
---|
8379 | ENDIF |
---|
8380 | |
---|
8381 | END SUBROUTINE salsa_emission_update |
---|
8382 | |
---|
8383 | !------------------------------------------------------------------------------! |
---|
8384 | !> Description: |
---|
8385 | !> ------------ |
---|
8386 | !> Define aerosol fluxes: constant or read from a from file |
---|
8387 | !> @todo - Emission stack height is not used yet. For default mode, emissions |
---|
8388 | !> are assumed to occur on upward facing horizontal surfaces. |
---|
8389 | !------------------------------------------------------------------------------! |
---|
8390 | SUBROUTINE salsa_emission_setup( init ) |
---|
8391 | |
---|
8392 | USE netcdf_data_input_mod, & |
---|
8393 | ONLY: check_existence, close_input_file, get_attribute, get_variable, & |
---|
8394 | inquire_num_variables, inquire_variable_names, & |
---|
8395 | get_dimension_length, open_read_file, street_type_f |
---|
8396 | |
---|
8397 | USE palm_date_time_mod, & |
---|
8398 | ONLY: days_per_week, get_date_time, hours_per_day, months_per_year, seconds_per_hour |
---|
8399 | |
---|
8400 | USE surface_mod, & |
---|
8401 | ONLY: surf_def_h, surf_lsm_h, surf_usm_h |
---|
8402 | |
---|
8403 | IMPLICIT NONE |
---|
8404 | |
---|
8405 | CHARACTER(LEN=80) :: daytype = 'workday' !< default day type |
---|
8406 | CHARACTER(LEN=25) :: in_name !< name of a gas in the input file |
---|
8407 | CHARACTER(LEN=25) :: mod_name !< name in the input file |
---|
8408 | |
---|
8409 | INTEGER(iwp) :: day_of_month !< day of the month |
---|
8410 | INTEGER(iwp) :: day_of_week !< day of the week |
---|
8411 | INTEGER(iwp) :: day_of_year !< day of the year |
---|
8412 | INTEGER(iwp) :: hour_of_day !< hour of the day |
---|
8413 | INTEGER(iwp) :: i !< loop index |
---|
8414 | INTEGER(iwp) :: ib !< loop index: aerosol number bins |
---|
8415 | INTEGER(iwp) :: ic !< loop index: aerosol chemical components |
---|
8416 | INTEGER(iwp) :: id_salsa !< NetCDF id of aerosol emission input file |
---|
8417 | INTEGER(iwp) :: in !< loop index: emission category |
---|
8418 | INTEGER(iwp) :: index_dd !< index day |
---|
8419 | INTEGER(iwp) :: index_hh !< index hour |
---|
8420 | INTEGER(iwp) :: index_mm !< index month |
---|
8421 | INTEGER(iwp) :: inn !< loop index |
---|
8422 | INTEGER(iwp) :: j !< loop index |
---|
8423 | INTEGER(iwp) :: month_of_year !< month of the year |
---|
8424 | INTEGER(iwp) :: ss !< loop index |
---|
8425 | |
---|
8426 | INTEGER(iwp), DIMENSION(maxspec) :: cc_i2m !< |
---|
8427 | |
---|
8428 | LOGICAL :: netcdf_extend = .FALSE. !< NetCDF input file exists |
---|
8429 | |
---|
8430 | LOGICAL, INTENT(in) :: init !< if .TRUE. --> initialisation call |
---|
8431 | |
---|
8432 | REAL(wp) :: second_of_day !< second of the day |
---|
8433 | |
---|
8434 | REAL(wp), DIMENSION(:), ALLOCATABLE :: nsect_emission !< sectional number emission |
---|
8435 | |
---|
8436 | REAL(wp), DIMENSION(:,:,:), ALLOCATABLE :: source_array !< temporary source array |
---|
8437 | |
---|
8438 | ! |
---|
8439 | !-- Define emissions: |
---|
8440 | SELECT CASE ( salsa_emission_mode ) |
---|
8441 | |
---|
8442 | CASE ( 'uniform', 'parameterized' ) |
---|
8443 | |
---|
8444 | IF ( init ) THEN ! Do only once |
---|
8445 | ! |
---|
8446 | !- Form a sectional size distribution for the emissions |
---|
8447 | ALLOCATE( nsect_emission(1:nbins_aerosol), & |
---|
8448 | source_array(nys:nyn,nxl:nxr,1:nbins_aerosol) ) |
---|
8449 | ! |
---|
8450 | !-- Precalculate a size distribution for the emission based on the mean diameter, standard |
---|
8451 | !-- deviation and number concentration per each log-normal mode |
---|
8452 | CALL size_distribution( surface_aerosol_flux, aerosol_flux_dpg, aerosol_flux_sigmag, & |
---|
8453 | nsect_emission ) |
---|
8454 | IF ( salsa_emission_mode == 'uniform' ) THEN |
---|
8455 | DO ib = 1, nbins_aerosol |
---|
8456 | source_array(:,:,ib) = nsect_emission(ib) |
---|
8457 | ENDDO |
---|
8458 | ELSE |
---|
8459 | IF ( street_type_f%from_file ) THEN |
---|
8460 | DO i = nxl, nxr |
---|
8461 | DO j = nys, nyn |
---|
8462 | IF ( street_type_f%var(j,i) >= main_street_id .AND. & |
---|
8463 | street_type_f%var(j,i) < max_street_id ) THEN |
---|
8464 | source_array(j,i,:) = nsect_emission(:) * emiss_factor_main |
---|
8465 | ELSEIF ( street_type_f%var(j,i) >= side_street_id .AND. & |
---|
8466 | street_type_f%var(j,i) < main_street_id ) THEN |
---|
8467 | source_array(j,i,:) = nsect_emission(:) * emiss_factor_side |
---|
8468 | ENDIF |
---|
8469 | ENDDO |
---|
8470 | ENDDO |
---|
8471 | ELSE |
---|
8472 | WRITE( message_string, * ) 'salsa_emission_mode = "parameterized" but the '// & |
---|
8473 | 'street_type data is missing.' |
---|
8474 | CALL message( 'salsa_emission_setup', 'PA0661', 1, 2, 0, 6, 0 ) |
---|
8475 | ENDIF |
---|
8476 | ENDIF |
---|
8477 | ! |
---|
8478 | !-- Check which chemical components are used |
---|
8479 | cc_i2m = 0 |
---|
8480 | IF ( index_so4 > 0 ) cc_i2m(1) = index_so4 |
---|
8481 | IF ( index_oc > 0 ) cc_i2m(2) = index_oc |
---|
8482 | IF ( index_bc > 0 ) cc_i2m(3) = index_bc |
---|
8483 | IF ( index_du > 0 ) cc_i2m(4) = index_du |
---|
8484 | IF ( index_ss > 0 ) cc_i2m(5) = index_ss |
---|
8485 | IF ( index_no > 0 ) cc_i2m(6) = index_no |
---|
8486 | IF ( index_nh > 0 ) cc_i2m(7) = index_nh |
---|
8487 | ! |
---|
8488 | !-- Normalise mass fractions so that their sum is 1 |
---|
8489 | aerosol_flux_mass_fracs_a = aerosol_flux_mass_fracs_a / & |
---|
8490 | SUM( aerosol_flux_mass_fracs_a(1:ncc ) ) |
---|
8491 | IF ( salsa_emission_mode == 'uniform' ) THEN |
---|
8492 | ! |
---|
8493 | !-- Set uniform fluxes of default horizontal surfaces |
---|
8494 | CALL set_flux( surf_def_h(0), cc_i2m, aerosol_flux_mass_fracs_a, source_array ) |
---|
8495 | ELSE |
---|
8496 | ! |
---|
8497 | !-- Set fluxes normalised based on the street type on land surfaces |
---|
8498 | CALL set_flux( surf_lsm_h, cc_i2m, aerosol_flux_mass_fracs_a, source_array ) |
---|
8499 | ENDIF |
---|
8500 | |
---|
8501 | DEALLOCATE( nsect_emission, source_array ) |
---|
8502 | ENDIF |
---|
8503 | |
---|
8504 | CASE ( 'read_from_file' ) |
---|
8505 | ! |
---|
8506 | !-- Reset surface fluxes |
---|
8507 | surf_def_h(0)%answs = 0.0_wp |
---|
8508 | surf_def_h(0)%amsws = 0.0_wp |
---|
8509 | surf_lsm_h%answs = 0.0_wp |
---|
8510 | surf_lsm_h%amsws = 0.0_wp |
---|
8511 | surf_usm_h%answs = 0.0_wp |
---|
8512 | surf_usm_h%amsws = 0.0_wp |
---|
8513 | |
---|
8514 | ! |
---|
8515 | !-- Reset source arrays: |
---|
8516 | DO ib = 1, nbins_aerosol |
---|
8517 | aerosol_number(ib)%source = 0.0_wp |
---|
8518 | ENDDO |
---|
8519 | |
---|
8520 | DO ic = 1, ncomponents_mass * nbins_aerosol |
---|
8521 | aerosol_mass(ic)%source = 0.0_wp |
---|
8522 | ENDDO |
---|
8523 | |
---|
8524 | #if defined( __netcdf ) |
---|
8525 | ! |
---|
8526 | !-- Check existence of PIDS_SALSA file |
---|
8527 | INQUIRE( FILE = TRIM( input_file_salsa ) // TRIM( coupling_char ), EXIST = netcdf_extend ) |
---|
8528 | IF ( .NOT. netcdf_extend ) THEN |
---|
8529 | message_string = 'Input file '// TRIM( input_file_salsa ) // TRIM( coupling_char )& |
---|
8530 | // ' missing!' |
---|
8531 | CALL message( 'salsa_emission_setup', 'PA0629', 1, 2, 0, 6, 0 ) |
---|
8532 | ENDIF |
---|
8533 | ! |
---|
8534 | !-- Open file in read-only mode |
---|
8535 | CALL open_read_file( TRIM( input_file_salsa ) // TRIM( coupling_char ), id_salsa ) |
---|
8536 | |
---|
8537 | IF ( init ) THEN |
---|
8538 | ! |
---|
8539 | !-- Variable names |
---|
8540 | CALL inquire_num_variables( id_salsa, aero_emission_att%num_vars ) |
---|
8541 | ALLOCATE( aero_emission_att%var_names(1:aero_emission_att%num_vars) ) |
---|
8542 | CALL inquire_variable_names( id_salsa, aero_emission_att%var_names ) |
---|
8543 | ! |
---|
8544 | !-- Read the index and name of chemical components |
---|
8545 | CALL get_dimension_length( id_salsa, aero_emission_att%ncc, & |
---|
8546 | 'composition_index' ) |
---|
8547 | ALLOCATE( aero_emission_att%cc_index(1:aero_emission_att%ncc) ) |
---|
8548 | CALL get_variable( id_salsa, 'composition_index', aero_emission_att%cc_index ) |
---|
8549 | |
---|
8550 | IF ( check_existence( aero_emission_att%var_names, 'composition_name' ) ) THEN |
---|
8551 | CALL get_variable( id_salsa, 'composition_name', aero_emission_att%cc_name, & |
---|
8552 | aero_emission_att%ncc ) |
---|
8553 | ELSE |
---|
8554 | message_string = 'Missing composition_name in ' // TRIM( input_file_salsa ) |
---|
8555 | CALL message( 'salsa_emission_setup', 'PA0657', 1, 2, 0, 6, 0 ) |
---|
8556 | ENDIF |
---|
8557 | ! |
---|
8558 | !-- Find the corresponding chemical components in the model |
---|
8559 | aero_emission_att%cc_in2mod = 0 |
---|
8560 | DO ic = 1, aero_emission_att%ncc |
---|
8561 | in_name = aero_emission_att%cc_name(ic) |
---|
8562 | SELECT CASE ( TRIM( in_name ) ) |
---|
8563 | CASE ( 'H2SO4', 'h2so4', 'SO4', 'so4' ) |
---|
8564 | aero_emission_att%cc_in2mod(1) = ic |
---|
8565 | CASE ( 'OC', 'oc', 'organics' ) |
---|
8566 | aero_emission_att%cc_in2mod(2) = ic |
---|
8567 | CASE ( 'BC', 'bc' ) |
---|
8568 | aero_emission_att%cc_in2mod(3) = ic |
---|
8569 | CASE ( 'DU', 'du' ) |
---|
8570 | aero_emission_att%cc_in2mod(4) = ic |
---|
8571 | CASE ( 'SS', 'ss' ) |
---|
8572 | aero_emission_att%cc_in2mod(5) = ic |
---|
8573 | CASE ( 'HNO3', 'hno3', 'NO', 'no', 'NO3', 'no3' ) |
---|
8574 | aero_emission_att%cc_in2mod(6) = ic |
---|
8575 | CASE ( 'NH3', 'nh3', 'NH', 'nh', 'NH4', 'nh4' ) |
---|
8576 | aero_emission_att%cc_in2mod(7) = ic |
---|
8577 | END SELECT |
---|
8578 | |
---|
8579 | ENDDO |
---|
8580 | |
---|
8581 | IF ( SUM( aero_emission_att%cc_in2mod ) == 0 ) THEN |
---|
8582 | message_string = 'None of the aerosol chemical components in ' // TRIM( & |
---|
8583 | input_file_salsa ) // ' correspond to the ones applied in SALSA.' |
---|
8584 | CALL message( 'salsa_emission_setup', 'PA0630', 1, 2, 0, 6, 0 ) |
---|
8585 | ENDIF |
---|
8586 | ! |
---|
8587 | !-- Inquire the fill value |
---|
8588 | CALL get_attribute( id_salsa, '_FillValue', aero_emission%fill, .FALSE., & |
---|
8589 | 'aerosol_emission_values' ) |
---|
8590 | ! |
---|
8591 | !-- Inquire units of emissions |
---|
8592 | CALL get_attribute( id_salsa, 'units', aero_emission_att%units, .FALSE., & |
---|
8593 | 'aerosol_emission_values' ) |
---|
8594 | ! |
---|
8595 | !-- Inquire the level of detail (lod) |
---|
8596 | CALL get_attribute( id_salsa, 'lod', aero_emission_att%lod, .FALSE., & |
---|
8597 | 'aerosol_emission_values' ) |
---|
8598 | |
---|
8599 | ! |
---|
8600 | !-- Read different emission information depending on the level of detail of emissions: |
---|
8601 | |
---|
8602 | ! |
---|
8603 | !-- Default mode: |
---|
8604 | IF ( aero_emission_att%lod == 1 ) THEN |
---|
8605 | ! |
---|
8606 | !-- Unit conversion factor: convert to SI units (kg/m2/s) |
---|
8607 | IF ( aero_emission_att%units == 'kg/m2/yr' ) THEN |
---|
8608 | aero_emission_att%conversion_factor = 1.0_wp / 3600.0_wp |
---|
8609 | ELSEIF ( aero_emission_att%units == 'g/m2/yr' ) THEN |
---|
8610 | aero_emission_att%conversion_factor = 0.001_wp / 3600.0_wp |
---|
8611 | ELSE |
---|
8612 | message_string = 'unknown unit for aerosol emissions: ' // & |
---|
8613 | TRIM( aero_emission_att%units ) // ' (lod1)' |
---|
8614 | CALL message( 'salsa_emission_setup','PA0631', 1, 2, 0, 6, 0 ) |
---|
8615 | ENDIF |
---|
8616 | ! |
---|
8617 | !-- Get number of emission categories and allocate emission arrays |
---|
8618 | CALL get_dimension_length( id_salsa, aero_emission_att%ncat, 'ncat' ) |
---|
8619 | ALLOCATE( aero_emission_att%cat_index(1:aero_emission_att%ncat), & |
---|
8620 | aero_emission_att%rho(1:aero_emission_att%ncat), & |
---|
8621 | aero_emission_att%time_factor(1:aero_emission_att%ncat) ) |
---|
8622 | ! |
---|
8623 | !-- Get emission category names and indices |
---|
8624 | IF ( check_existence( aero_emission_att%var_names, 'emission_category_name' ) ) THEN |
---|
8625 | CALL get_variable( id_salsa, 'emission_category_name', & |
---|
8626 | aero_emission_att%cat_name, aero_emission_att%ncat ) |
---|
8627 | ELSE |
---|
8628 | message_string = 'Missing emission_category_name in ' // TRIM( input_file_salsa ) |
---|
8629 | CALL message( 'salsa_emission_setup', 'PA0658', 1, 2, 0, 6, 0 ) |
---|
8630 | ENDIF |
---|
8631 | CALL get_variable( id_salsa, 'emission_category_index', aero_emission_att%cat_index ) |
---|
8632 | ! |
---|
8633 | !-- Find corresponding emission categories |
---|
8634 | DO in = 1, aero_emission_att%ncat |
---|
8635 | in_name = aero_emission_att%cat_name(in) |
---|
8636 | DO ss = 1, def_modes%ndc |
---|
8637 | mod_name = def_modes%cat_name_table(ss) |
---|
8638 | IF ( TRIM( in_name(1:4) ) == TRIM( mod_name(1:4 ) ) ) THEN |
---|
8639 | def_modes%cat_input_to_model(ss) = in |
---|
8640 | ENDIF |
---|
8641 | ENDDO |
---|
8642 | ENDDO |
---|
8643 | |
---|
8644 | IF ( SUM( def_modes%cat_input_to_model ) == 0 ) THEN |
---|
8645 | message_string = 'None of the emission categories in ' // TRIM( & |
---|
8646 | input_file_salsa ) // ' match with the ones in the model.' |
---|
8647 | CALL message( 'salsa_emission_setup', 'PA0632', 1, 2, 0, 6, 0 ) |
---|
8648 | ENDIF |
---|
8649 | ! |
---|
8650 | !-- Emission time factors: Find check whether emission time factors are given for each |
---|
8651 | !-- hour of year OR based on month, day and hour |
---|
8652 | ! |
---|
8653 | !-- For each hour of year: |
---|
8654 | IF ( check_existence( aero_emission_att%var_names, 'nhoursyear' ) ) THEN |
---|
8655 | CALL get_dimension_length( id_salsa, & |
---|
8656 | aero_emission_att%nhoursyear, 'nhoursyear' ) |
---|
8657 | ALLOCATE( aero_emission_att%etf(1:aero_emission_att%ncat, & |
---|
8658 | 1:aero_emission_att%nhoursyear) ) |
---|
8659 | CALL get_variable( id_salsa, 'emission_time_factors', aero_emission_att%etf, & |
---|
8660 | 0, aero_emission_att%nhoursyear-1, 0, aero_emission_att%ncat-1 ) |
---|
8661 | ! |
---|
8662 | !-- Based on the month, day and hour: |
---|
8663 | ELSEIF ( check_existence( aero_emission_att%var_names, 'nmonthdayhour' ) ) THEN |
---|
8664 | CALL get_dimension_length( id_salsa, & |
---|
8665 | aero_emission_att%nmonthdayhour, & |
---|
8666 | 'nmonthdayhour' ) |
---|
8667 | ALLOCATE( aero_emission_att%etf(1:aero_emission_att%ncat, & |
---|
8668 | 1:aero_emission_att%nmonthdayhour) ) |
---|
8669 | CALL get_variable( id_salsa, 'emission_time_factors', aero_emission_att%etf, & |
---|
8670 | 0, aero_emission_att%nmonthdayhour-1, 0, aero_emission_att%ncat-1 ) |
---|
8671 | ELSE |
---|
8672 | message_string = 'emission_time_factors should be given for each nhoursyear ' //& |
---|
8673 | 'OR nmonthdayhour' |
---|
8674 | CALL message( 'salsa_emission_setup','PA0633', 1, 2, 0, 6, 0 ) |
---|
8675 | ENDIF |
---|
8676 | ! |
---|
8677 | !-- Next emission update |
---|
8678 | CALL get_date_time( 0.0_wp, second_of_day=second_of_day ) |
---|
8679 | next_aero_emission_update = MOD( second_of_day, seconds_per_hour ) - seconds_per_hour |
---|
8680 | ! |
---|
8681 | !-- Get chemical composition (i.e. mass fraction of different species) in aerosols |
---|
8682 | IF ( check_existence( aero_emission_att%var_names, 'emission_mass_fracs' ) ) THEN |
---|
8683 | ALLOCATE( aero_emission%def_mass_fracs(1:aero_emission_att%ncat, & |
---|
8684 | 1:aero_emission_att%ncc) ) |
---|
8685 | aero_emission%def_mass_fracs = 0.0_wp |
---|
8686 | CALL get_variable( id_salsa, 'emission_mass_fracs', aero_emission%def_mass_fracs,& |
---|
8687 | 0, aero_emission_att%ncc-1, 0, aero_emission_att%ncat-1 ) |
---|
8688 | ELSE |
---|
8689 | message_string = 'Missing emission_mass_fracs in ' // TRIM( input_file_salsa ) |
---|
8690 | CALL message( 'salsa_emission_setup', 'PA0659', 1, 2, 0, 6, 0 ) |
---|
8691 | ENDIF |
---|
8692 | ! |
---|
8693 | !-- If the chemical component is not activated, set its mass fraction to 0 to avoid |
---|
8694 | !-- inbalance between number and mass flux |
---|
8695 | cc_i2m = aero_emission_att%cc_in2mod |
---|
8696 | IF ( index_so4 < 0 .AND. cc_i2m(1) > 0 ) & |
---|
8697 | aero_emission%def_mass_fracs(:,cc_i2m(1)) = 0.0_wp |
---|
8698 | IF ( index_oc < 0 .AND. cc_i2m(2) > 0 ) & |
---|
8699 | aero_emission%def_mass_fracs(:,cc_i2m(2)) = 0.0_wp |
---|
8700 | IF ( index_bc < 0 .AND. cc_i2m(3) > 0 ) & |
---|
8701 | aero_emission%def_mass_fracs(:,cc_i2m(3)) = 0.0_wp |
---|
8702 | IF ( index_du < 0 .AND. cc_i2m(4) > 0 ) & |
---|
8703 | aero_emission%def_mass_fracs(:,cc_i2m(4)) = 0.0_wp |
---|
8704 | IF ( index_ss < 0 .AND. cc_i2m(5) > 0 ) & |
---|
8705 | aero_emission%def_mass_fracs(:,cc_i2m(5)) = 0.0_wp |
---|
8706 | IF ( index_no < 0 .AND. cc_i2m(6) > 0 ) & |
---|
8707 | aero_emission%def_mass_fracs(:,cc_i2m(6)) = 0.0_wp |
---|
8708 | IF ( index_nh < 0 .AND. cc_i2m(7) > 0 ) & |
---|
8709 | aero_emission%def_mass_fracs(:,cc_i2m(7)) = 0.0_wp |
---|
8710 | ! |
---|
8711 | !-- Then normalise the mass fraction so that SUM = 1 |
---|
8712 | DO in = 1, aero_emission_att%ncat |
---|
8713 | aero_emission%def_mass_fracs(in,:) = aero_emission%def_mass_fracs(in,:) / & |
---|
8714 | SUM( aero_emission%def_mass_fracs(in,:) ) |
---|
8715 | ENDDO |
---|
8716 | ! |
---|
8717 | !-- Calculate average mass density (kg/m3) |
---|
8718 | aero_emission_att%rho = 0.0_wp |
---|
8719 | |
---|
8720 | IF ( cc_i2m(1) /= 0 ) aero_emission_att%rho = aero_emission_att%rho + arhoh2so4 *& |
---|
8721 | aero_emission%def_mass_fracs(:,cc_i2m(1)) |
---|
8722 | IF ( cc_i2m(2) /= 0 ) aero_emission_att%rho = aero_emission_att%rho + arhooc * & |
---|
8723 | aero_emission%def_mass_fracs(:,cc_i2m(2)) |
---|
8724 | IF ( cc_i2m(3) /= 0 ) aero_emission_att%rho = aero_emission_att%rho + arhobc * & |
---|
8725 | aero_emission%def_mass_fracs(:,cc_i2m(3)) |
---|
8726 | IF ( cc_i2m(4) /= 0 ) aero_emission_att%rho = aero_emission_att%rho + arhodu * & |
---|
8727 | aero_emission%def_mass_fracs(:,cc_i2m(4)) |
---|
8728 | IF ( cc_i2m(5) /= 0 ) aero_emission_att%rho = aero_emission_att%rho + arhoss * & |
---|
8729 | aero_emission%def_mass_fracs(:,cc_i2m(5)) |
---|
8730 | IF ( cc_i2m(6) /= 0 ) aero_emission_att%rho = aero_emission_att%rho + arhohno3 * & |
---|
8731 | aero_emission%def_mass_fracs(:,cc_i2m(6)) |
---|
8732 | IF ( cc_i2m(7) /= 0 ) aero_emission_att%rho = aero_emission_att%rho + arhonh3 * & |
---|
8733 | aero_emission%def_mass_fracs(:,cc_i2m(7)) |
---|
8734 | ! |
---|
8735 | !-- Allocate and read surface emission data (in total PM) |
---|
8736 | ALLOCATE( aero_emission%def_data(nys:nyn,nxl:nxr,1:aero_emission_att%ncat) ) |
---|
8737 | CALL get_variable( id_salsa, 'aerosol_emission_values', aero_emission%def_data, & |
---|
8738 | 0, aero_emission_att%ncat-1, nxl, nxr, nys, nyn ) |
---|
8739 | |
---|
8740 | ! |
---|
8741 | !-- Pre-processed mode |
---|
8742 | ELSEIF ( aero_emission_att%lod == 2 ) THEN |
---|
8743 | ! |
---|
8744 | !-- Unit conversion factor: convert to SI units (#/m2/s) |
---|
8745 | IF ( aero_emission_att%units == '#/m2/s' ) THEN |
---|
8746 | aero_emission_att%conversion_factor = 1.0_wp |
---|
8747 | ELSE |
---|
8748 | message_string = 'unknown unit for aerosol emissions: ' // & |
---|
8749 | TRIM( aero_emission_att%units ) |
---|
8750 | CALL message( 'salsa_emission_setup','PA0634', 1, 2, 0, 6, 0 ) |
---|
8751 | ENDIF |
---|
8752 | ! |
---|
8753 | !-- Number of aerosol size bins in the emission data |
---|
8754 | CALL get_dimension_length( id_salsa, aero_emission_att%nbins, 'Dmid' ) |
---|
8755 | IF ( aero_emission_att%nbins /= nbins_aerosol ) THEN |
---|
8756 | message_string = 'The number of size bins in aerosol input data does not ' // & |
---|
8757 | 'correspond to the model set-up' |
---|
8758 | CALL message( 'salsa_emission_setup','PA0635', 1, 2, 0, 6, 0 ) |
---|
8759 | ENDIF |
---|
8760 | ! |
---|
8761 | !-- Number of time steps in the emission data |
---|
8762 | CALL get_dimension_length( id_salsa, aero_emission_att%nt, 'time') |
---|
8763 | ! |
---|
8764 | !-- Allocate bin diameters, time and mass fraction array |
---|
8765 | ALLOCATE( aero_emission_att%dmid(1:nbins_aerosol), & |
---|
8766 | aero_emission_att%time(1:aero_emission_att%nt), & |
---|
8767 | aero_emission%preproc_mass_fracs(1:aero_emission_att%ncc) ) |
---|
8768 | ! |
---|
8769 | !-- Read mean diameters |
---|
8770 | CALL get_variable( id_salsa, 'Dmid', aero_emission_att%dmid ) |
---|
8771 | ! |
---|
8772 | !-- Check whether the sectional representation of the aerosol size distribution conform |
---|
8773 | !-- to the one applied in the model |
---|
8774 | IF ( ANY( ABS( ( aero(1:nbins_aerosol)%dmid - aero_emission_att%dmid ) / & |
---|
8775 | aero(1:nbins_aerosol)%dmid ) > 0.1_wp ) ) THEN |
---|
8776 | message_string = 'Mean diameters of size bins in ' // TRIM( input_file_salsa ) & |
---|
8777 | // ' do not match with the ones in the model.' |
---|
8778 | CALL message( 'salsa_emission_setup','PA0636', 1, 2, 0, 6, 0 ) |
---|
8779 | ENDIF |
---|
8780 | ! |
---|
8781 | !-- Read time stamps: |
---|
8782 | IF ( check_existence( aero_emission_att%var_names, 'time' ) ) THEN |
---|
8783 | CALL get_variable( id_salsa, 'time', aero_emission_att%time ) |
---|
8784 | ELSE |
---|
8785 | message_string = 'Missing time in ' // TRIM( input_file_salsa ) |
---|
8786 | CALL message( 'salsa_emission_setup', 'PA0660', 1, 2, 0, 6, 0 ) |
---|
8787 | ENDIF |
---|
8788 | ! |
---|
8789 | !-- Read emission mass fractions |
---|
8790 | IF ( check_existence( aero_emission_att%var_names, 'emission_mass_fracs' ) ) THEN |
---|
8791 | CALL get_variable( id_salsa, 'emission_mass_fracs', & |
---|
8792 | aero_emission%preproc_mass_fracs ) |
---|
8793 | ELSE |
---|
8794 | message_string = 'Missing emission_mass_fracs in ' // TRIM( input_file_salsa ) |
---|
8795 | CALL message( 'salsa_emission_setup', 'PA0659', 1, 2, 0, 6, 0 ) |
---|
8796 | ENDIF |
---|
8797 | ! |
---|
8798 | !-- If the chemical component is not activated, set its mass fraction to 0 |
---|
8799 | cc_i2m = aero_emission_att%cc_in2mod |
---|
8800 | IF ( index_so4 < 0 .AND. cc_i2m(1) /= 0 ) & |
---|
8801 | aero_emission%preproc_mass_fracs(cc_i2m(1)) = 0.0_wp |
---|
8802 | IF ( index_oc < 0 .AND. cc_i2m(2) /= 0 ) & |
---|
8803 | aero_emission%preproc_mass_fracs(cc_i2m(2)) = 0.0_wp |
---|
8804 | IF ( index_bc < 0 .AND. cc_i2m(3) /= 0 ) & |
---|
8805 | aero_emission%preproc_mass_fracs(cc_i2m(3)) = 0.0_wp |
---|
8806 | IF ( index_du < 0 .AND. cc_i2m(4) /= 0 ) & |
---|
8807 | aero_emission%preproc_mass_fracs(cc_i2m(4)) = 0.0_wp |
---|
8808 | IF ( index_ss < 0 .AND. cc_i2m(5) /= 0 ) & |
---|
8809 | aero_emission%preproc_mass_fracs(cc_i2m(5)) = 0.0_wp |
---|
8810 | IF ( index_no < 0 .AND. cc_i2m(6) /= 0 ) & |
---|
8811 | aero_emission%preproc_mass_fracs(cc_i2m(6)) = 0.0_wp |
---|
8812 | IF ( index_nh < 0 .AND. cc_i2m(7) /= 0 ) & |
---|
8813 | aero_emission%preproc_mass_fracs(cc_i2m(7)) = 0.0_wp |
---|
8814 | ! |
---|
8815 | !-- Then normalise the mass fraction so that SUM = 1 |
---|
8816 | aero_emission%preproc_mass_fracs = aero_emission%preproc_mass_fracs / & |
---|
8817 | SUM( aero_emission%preproc_mass_fracs ) |
---|
8818 | |
---|
8819 | ELSE |
---|
8820 | message_string = 'Unknown lod for aerosol_emission_values.' |
---|
8821 | CALL message( 'salsa_emission','PA0637', 1, 2, 0, 6, 0 ) |
---|
8822 | ENDIF |
---|
8823 | |
---|
8824 | ENDIF ! init |
---|
8825 | ! |
---|
8826 | !-- Define and set current emission values: |
---|
8827 | ! |
---|
8828 | !-- Default type emissions (aerosol emission given as total mass emission per year): |
---|
8829 | IF ( aero_emission_att%lod == 1 ) THEN |
---|
8830 | ! |
---|
8831 | !-- Emission time factors for each emission category at current time step |
---|
8832 | IF ( aero_emission_att%nhoursyear > aero_emission_att%nmonthdayhour ) THEN |
---|
8833 | ! |
---|
8834 | !-- Get the index of the current hour |
---|
8835 | CALL get_date_time( time_since_reference_point, & |
---|
8836 | day_of_year=day_of_year, hour=hour_of_day ) |
---|
8837 | index_hh = ( day_of_year - 1_iwp ) * hours_per_day + hour_of_day |
---|
8838 | aero_emission_att%time_factor = aero_emission_att%etf(:,index_hh) |
---|
8839 | |
---|
8840 | ELSEIF ( aero_emission_att%nhoursyear < aero_emission_att%nmonthdayhour ) THEN |
---|
8841 | ! |
---|
8842 | !-- Get the index of current hour (index_hh) (TODO: Now "workday" is always assumed. |
---|
8843 | !-- Needs to be calculated.) |
---|
8844 | CALL get_date_time( time_since_reference_point, & |
---|
8845 | month=month_of_year, & |
---|
8846 | day=day_of_month, & |
---|
8847 | hour=hour_of_day, & |
---|
8848 | day_of_week=day_of_week ) |
---|
8849 | index_mm = month_of_year |
---|
8850 | index_dd = months_per_year + day_of_week |
---|
8851 | SELECT CASE(TRIM(daytype)) |
---|
8852 | |
---|
8853 | CASE ("workday") |
---|
8854 | index_hh = months_per_year + days_per_week + hour_of_day |
---|
8855 | |
---|
8856 | CASE ("weekend") |
---|
8857 | index_hh = months_per_year + days_per_week + hours_per_day + hour_of_day |
---|
8858 | |
---|
8859 | CASE ("holiday") |
---|
8860 | index_hh = months_per_year + days_per_week + 2*hours_per_day + hour_of_day |
---|
8861 | |
---|
8862 | END SELECT |
---|
8863 | aero_emission_att%time_factor = aero_emission_att%etf(:,index_mm) * & |
---|
8864 | aero_emission_att%etf(:,index_dd) * & |
---|
8865 | aero_emission_att%etf(:,index_hh) |
---|
8866 | ENDIF |
---|
8867 | |
---|
8868 | ! |
---|
8869 | !-- Create a sectional number size distribution for emissions |
---|
8870 | ALLOCATE( nsect_emission(1:nbins_aerosol),source_array(nys:nyn,nxl:nxr,1:nbins_aerosol) ) |
---|
8871 | DO in = 1, aero_emission_att%ncat |
---|
8872 | |
---|
8873 | inn = def_modes%cat_input_to_model(in) |
---|
8874 | ! |
---|
8875 | !-- Calculate the number concentration (1/m3) of a log-normal size distribution |
---|
8876 | !-- following Jacobson (2005): Eq 13.25. |
---|
8877 | def_modes%ntot_table = 6.0_wp * def_modes%pm_frac_table(:,inn) / ( pi * & |
---|
8878 | ( def_modes%dpg_table )**3 * EXP( 4.5_wp * & |
---|
8879 | LOG( def_modes%sigmag_table )**2 ) ) |
---|
8880 | ! |
---|
8881 | !-- Sectional size distibution (1/m3) from a log-normal one |
---|
8882 | CALL size_distribution( def_modes%ntot_table, def_modes%dpg_table, & |
---|
8883 | def_modes%sigmag_table, nsect_emission ) |
---|
8884 | |
---|
8885 | source_array = 0.0_wp |
---|
8886 | DO ib = 1, nbins_aerosol |
---|
8887 | source_array(:,:,ib) = aero_emission%def_data(:,:,in) * & |
---|
8888 | aero_emission_att%conversion_factor / & |
---|
8889 | aero_emission_att%rho(in) * nsect_emission(ib) * & |
---|
8890 | aero_emission_att%time_factor(in) |
---|
8891 | ENDDO |
---|
8892 | ! |
---|
8893 | !-- Set surface fluxes of aerosol number and mass on horizontal surfaces. Set fluxes |
---|
8894 | !-- only for either default, land or urban surface. |
---|
8895 | IF ( .NOT. land_surface .AND. .NOT. urban_surface ) THEN |
---|
8896 | CALL set_flux( surf_def_h(0), aero_emission_att%cc_in2mod, & |
---|
8897 | aero_emission%def_mass_fracs(in,:), source_array ) |
---|
8898 | ELSE |
---|
8899 | CALL set_flux( surf_usm_h, aero_emission_att%cc_in2mod, & |
---|
8900 | aero_emission%def_mass_fracs(in,:), source_array ) |
---|
8901 | CALL set_flux( surf_lsm_h, aero_emission_att%cc_in2mod, & |
---|
8902 | aero_emission%def_mass_fracs(in,:), source_array ) |
---|
8903 | ENDIF |
---|
8904 | ENDDO |
---|
8905 | ! |
---|
8906 | !-- The next emission update is again after one hour |
---|
8907 | next_aero_emission_update = next_aero_emission_update + 3600.0_wp |
---|
8908 | |
---|
8909 | |
---|
8910 | DEALLOCATE( nsect_emission, source_array ) |
---|
8911 | ! |
---|
8912 | !-- Pre-processed: |
---|
8913 | ELSEIF ( aero_emission_att%lod == 2 ) THEN |
---|
8914 | ! |
---|
8915 | !-- Obtain time index for current input starting at 0. |
---|
8916 | !-- @todo: At the moment emission data and simulated time correspond to each other. |
---|
8917 | aero_emission_att%tind = MINLOC( ABS( aero_emission_att%time - & |
---|
8918 | time_since_reference_point ), DIM = 1 ) - 1 |
---|
8919 | ! |
---|
8920 | !-- Allocate the data input array always before reading in the data and deallocate after |
---|
8921 | ALLOCATE( aero_emission%preproc_data(nys:nyn,nxl:nxr,1:nbins_aerosol) ) |
---|
8922 | ! |
---|
8923 | !-- Read in the next time step |
---|
8924 | CALL get_variable( id_salsa, 'aerosol_emission_values', aero_emission%preproc_data,& |
---|
8925 | aero_emission_att%tind, 0, nbins_aerosol-1, nxl, nxr, nys, nyn ) |
---|
8926 | ! |
---|
8927 | !-- Set surface fluxes of aerosol number and mass on horizontal surfaces. Set fluxes only |
---|
8928 | !-- for either default, land and urban surface. |
---|
8929 | IF ( .NOT. land_surface .AND. .NOT. urban_surface ) THEN |
---|
8930 | CALL set_flux( surf_def_h(0), aero_emission_att%cc_in2mod, & |
---|
8931 | aero_emission%preproc_mass_fracs, aero_emission%preproc_data ) |
---|
8932 | ELSE |
---|
8933 | CALL set_flux( surf_usm_h, aero_emission_att%cc_in2mod, & |
---|
8934 | aero_emission%preproc_mass_fracs, aero_emission%preproc_data ) |
---|
8935 | CALL set_flux( surf_lsm_h, aero_emission_att%cc_in2mod, & |
---|
8936 | aero_emission%preproc_mass_fracs, aero_emission%preproc_data ) |
---|
8937 | ENDIF |
---|
8938 | ! |
---|
8939 | !-- Determine the next emission update |
---|
8940 | next_aero_emission_update = aero_emission_att%time(aero_emission_att%tind+2) |
---|
8941 | |
---|
8942 | DEALLOCATE( aero_emission%preproc_data ) |
---|
8943 | |
---|
8944 | ENDIF |
---|
8945 | ! |
---|
8946 | !-- Close input file |
---|
8947 | CALL close_input_file( id_salsa ) |
---|
8948 | #else |
---|
8949 | message_string = 'salsa_emission_mode = "read_from_file", but preprocessor directive ' //& |
---|
8950 | ' __netcdf is not used in compiling!' |
---|
8951 | CALL message( 'salsa_emission_setup', 'PA0638', 1, 2, 0, 6, 0 ) |
---|
8952 | |
---|
8953 | #endif |
---|
8954 | CASE DEFAULT |
---|
8955 | message_string = 'unknown salsa_emission_mode: ' // TRIM( salsa_emission_mode ) |
---|
8956 | CALL message( 'salsa_emission_setup', 'PA0639', 1, 2, 0, 6, 0 ) |
---|
8957 | |
---|
8958 | END SELECT |
---|
8959 | |
---|
8960 | CONTAINS |
---|
8961 | |
---|
8962 | !------------------------------------------------------------------------------! |
---|
8963 | ! Description: |
---|
8964 | ! ------------ |
---|
8965 | !> Sets the aerosol flux to aerosol arrays in 2a and 2b. |
---|
8966 | !------------------------------------------------------------------------------! |
---|
8967 | SUBROUTINE set_flux( surface, cc_i_mod, mass_fracs, source_array ) |
---|
8968 | |
---|
8969 | USE arrays_3d, & |
---|
8970 | ONLY: rho_air_zw |
---|
8971 | |
---|
8972 | USE surface_mod, & |
---|
8973 | ONLY: surf_type |
---|
8974 | |
---|
8975 | IMPLICIT NONE |
---|
8976 | |
---|
8977 | INTEGER(iwp) :: i !< loop index |
---|
8978 | INTEGER(iwp) :: ib !< loop index |
---|
8979 | INTEGER(iwp) :: ic !< loop index |
---|
8980 | INTEGER(iwp) :: j !< loop index |
---|
8981 | INTEGER(iwp) :: k !< loop index |
---|
8982 | INTEGER(iwp) :: m !< running index for surface elements |
---|
8983 | |
---|
8984 | INTEGER(iwp), DIMENSION(:) :: cc_i_mod !< index of chemical component in the input data |
---|
8985 | |
---|
8986 | REAL(wp) :: so4_oc !< mass fraction between SO4 and OC in 1a |
---|
8987 | |
---|
8988 | REAL(wp), DIMENSION(:), INTENT(in) :: mass_fracs !< mass fractions of chemical components |
---|
8989 | |
---|
8990 | REAL(wp), DIMENSION(nys:nyn,nxl:nxr,1:nbins_aerosol), INTENT(inout) :: source_array !< |
---|
8991 | |
---|
8992 | TYPE(surf_type), INTENT(inout) :: surface !< respective surface type |
---|
8993 | |
---|
8994 | so4_oc = 0.0_wp |
---|
8995 | |
---|
8996 | DO m = 1, surface%ns |
---|
8997 | ! |
---|
8998 | !-- Get indices of respective grid point |
---|
8999 | i = surface%i(m) |
---|
9000 | j = surface%j(m) |
---|
9001 | k = surface%k(m) |
---|
9002 | |
---|
9003 | DO ib = 1, nbins_aerosol |
---|
9004 | IF ( source_array(j,i,ib) < nclim ) THEN |
---|
9005 | source_array(j,i,ib) = 0.0_wp |
---|
9006 | ENDIF |
---|
9007 | ! |
---|
9008 | !-- Set mass fluxes. First bins include only SO4 and/or OC. |
---|
9009 | IF ( ib <= end_subrange_1a ) THEN |
---|
9010 | ! |
---|
9011 | !-- Both sulphate and organic carbon |
---|
9012 | IF ( index_so4 > 0 .AND. index_oc > 0 ) THEN |
---|
9013 | |
---|
9014 | ic = ( index_so4 - 1 ) * nbins_aerosol + ib |
---|
9015 | so4_oc = mass_fracs(cc_i_mod(1)) / ( mass_fracs(cc_i_mod(1)) + & |
---|
9016 | mass_fracs(cc_i_mod(2)) ) |
---|
9017 | surface%amsws(m,ic) = surface%amsws(m,ic) + so4_oc * source_array(j,i,ib) & |
---|
9018 | * api6 * aero(ib)%dmid**3 * arhoh2so4 * rho_air_zw(k-1) |
---|
9019 | aerosol_mass(ic)%source(j,i) = aerosol_mass(ic)%source(j,i) + surface%amsws(m,ic) |
---|
9020 | |
---|
9021 | ic = ( index_oc - 1 ) * nbins_aerosol + ib |
---|
9022 | surface%amsws(m,ic) = surface%amsws(m,ic) + ( 1-so4_oc ) * source_array(j,i,ib) & |
---|
9023 | * api6 * aero(ib)%dmid**3 * arhooc * rho_air_zw(k-1) |
---|
9024 | aerosol_mass(ic)%source(j,i) = aerosol_mass(ic)%source(j,i) + surface%amsws(m,ic) |
---|
9025 | ! |
---|
9026 | !-- Only sulphates |
---|
9027 | ELSEIF ( index_so4 > 0 .AND. index_oc < 0 ) THEN |
---|
9028 | ic = ( index_so4 - 1 ) * nbins_aerosol + ib |
---|
9029 | surface%amsws(m,ic) = surface%amsws(m,ic) + source_array(j,i,ib) * api6 * & |
---|
9030 | aero(ib)%dmid**3 * arhoh2so4 * rho_air_zw(k-1) |
---|
9031 | aerosol_mass(ic)%source(j,i) = aerosol_mass(ic)%source(j,i) + surface%amsws(m,ic) |
---|
9032 | ! |
---|
9033 | !-- Only organic carbon |
---|
9034 | ELSEIF ( index_so4 < 0 .AND. index_oc > 0 ) THEN |
---|
9035 | ic = ( index_oc - 1 ) * nbins_aerosol + ib |
---|
9036 | surface%amsws(m,ic) = surface%amsws(m,ic) + source_array(j,i,ib) * api6 * & |
---|
9037 | aero(ib)%dmid**3 * arhooc * rho_air_zw(k-1) |
---|
9038 | aerosol_mass(ic)%source(j,i) = aerosol_mass(ic)%source(j,i) + surface%amsws(m,ic) |
---|
9039 | ENDIF |
---|
9040 | |
---|
9041 | ELSE |
---|
9042 | ! |
---|
9043 | !-- Sulphate |
---|
9044 | IF ( index_so4 > 0 ) THEN |
---|
9045 | ic = cc_i_mod(1) |
---|
9046 | CALL set_mass_flux( surface, m, ib, index_so4, mass_fracs(ic), arhoh2so4, & |
---|
9047 | source_array(j,i,ib) ) |
---|
9048 | ENDIF |
---|
9049 | ! |
---|
9050 | !-- Organic carbon |
---|
9051 | IF ( index_oc > 0 ) THEN |
---|
9052 | ic = cc_i_mod(2) |
---|
9053 | CALL set_mass_flux( surface, m, ib, index_oc, mass_fracs(ic),arhooc, & |
---|
9054 | source_array(j,i,ib) ) |
---|
9055 | ENDIF |
---|
9056 | ! |
---|
9057 | !-- Black carbon |
---|
9058 | IF ( index_bc > 0 ) THEN |
---|
9059 | ic = cc_i_mod(3) |
---|
9060 | CALL set_mass_flux( surface, m, ib, index_bc, mass_fracs(ic), arhobc, & |
---|
9061 | source_array(j,i,ib) ) |
---|
9062 | ENDIF |
---|
9063 | ! |
---|
9064 | !-- Dust |
---|
9065 | IF ( index_du > 0 ) THEN |
---|
9066 | ic = cc_i_mod(4) |
---|
9067 | CALL set_mass_flux( surface, m, ib, index_du, mass_fracs(ic), arhodu, & |
---|
9068 | source_array(j,i,ib) ) |
---|
9069 | ENDIF |
---|
9070 | ! |
---|
9071 | !-- Sea salt |
---|
9072 | IF ( index_ss > 0 ) THEN |
---|
9073 | ic = cc_i_mod(5) |
---|
9074 | CALL set_mass_flux( surface, m, ib, index_ss, mass_fracs(ic), arhoss, & |
---|
9075 | source_array(j,i,ib) ) |
---|
9076 | ENDIF |
---|
9077 | ! |
---|
9078 | !-- Nitric acid |
---|
9079 | IF ( index_no > 0 ) THEN |
---|
9080 | ic = cc_i_mod(6) |
---|
9081 | CALL set_mass_flux( surface, m, ib, index_no, mass_fracs(ic), arhohno3, & |
---|
9082 | source_array(j,i,ib) ) |
---|
9083 | ENDIF |
---|
9084 | ! |
---|
9085 | !-- Ammonia |
---|
9086 | IF ( index_nh > 0 ) THEN |
---|
9087 | ic = cc_i_mod(7) |
---|
9088 | CALL set_mass_flux( surface, m, ib, index_nh, mass_fracs(ic), arhonh3, & |
---|
9089 | source_array(j,i,ib) ) |
---|
9090 | ENDIF |
---|
9091 | |
---|
9092 | ENDIF |
---|
9093 | ! |
---|
9094 | !-- Save number fluxes in the end |
---|
9095 | surface%answs(m,ib) = surface%answs(m,ib) + source_array(j,i,ib) * rho_air_zw(k-1) |
---|
9096 | aerosol_number(ib)%source(j,i) = aerosol_number(ib)%source(j,i) + surface%answs(m,ib) |
---|
9097 | |
---|
9098 | ENDDO ! ib |
---|
9099 | ENDDO ! m |
---|
9100 | |
---|
9101 | END SUBROUTINE set_flux |
---|
9102 | |
---|
9103 | !------------------------------------------------------------------------------! |
---|
9104 | ! Description: |
---|
9105 | ! ------------ |
---|
9106 | !> Sets the mass emissions to aerosol arrays in 2a and 2b. |
---|
9107 | !------------------------------------------------------------------------------! |
---|
9108 | SUBROUTINE set_mass_flux( surface, surf_num, ib, ispec, mass_frac, prho, nsource ) |
---|
9109 | |
---|
9110 | USE arrays_3d, & |
---|
9111 | ONLY: rho_air_zw |
---|
9112 | |
---|
9113 | USE surface_mod, & |
---|
9114 | ONLY: surf_type |
---|
9115 | |
---|
9116 | IMPLICIT NONE |
---|
9117 | |
---|
9118 | INTEGER(iwp) :: i !< loop index |
---|
9119 | INTEGER(iwp) :: j !< loop index |
---|
9120 | INTEGER(iwp) :: k !< loop index |
---|
9121 | INTEGER(iwp) :: ic !< loop index |
---|
9122 | |
---|
9123 | INTEGER(iwp), INTENT(in) :: ib !< Aerosol size bin index |
---|
9124 | INTEGER(iwp), INTENT(in) :: ispec !< Aerosol species index |
---|
9125 | INTEGER(iwp), INTENT(in) :: surf_num !< index surface elements |
---|
9126 | |
---|
9127 | REAL(wp), INTENT(in) :: mass_frac !< mass fraction of a chemical compound in all bins |
---|
9128 | REAL(wp), INTENT(in) :: nsource !< number source (#/m2/s) |
---|
9129 | REAL(wp), INTENT(in) :: prho !< Aerosol density |
---|
9130 | |
---|
9131 | TYPE(surf_type), INTENT(inout) :: surface !< respective surface type |
---|
9132 | ! |
---|
9133 | !-- Get indices of respective grid point |
---|
9134 | i = surface%i(surf_num) |
---|
9135 | j = surface%j(surf_num) |
---|
9136 | k = surface%k(surf_num) |
---|
9137 | ! |
---|
9138 | !-- Subrange 2a: |
---|
9139 | ic = ( ispec - 1 ) * nbins_aerosol + ib |
---|
9140 | surface%amsws(surf_num,ic) = surface%amsws(surf_num,ic) + mass_frac * nsource * & |
---|
9141 | aero(ib)%core * prho * rho_air_zw(k-1) |
---|
9142 | aerosol_mass(ic)%source(j,i) = aerosol_mass(ic)%source(j,i) + surface%amsws(surf_num,ic) |
---|
9143 | |
---|
9144 | END SUBROUTINE set_mass_flux |
---|
9145 | |
---|
9146 | END SUBROUTINE salsa_emission_setup |
---|
9147 | |
---|
9148 | !------------------------------------------------------------------------------! |
---|
9149 | ! Description: |
---|
9150 | ! ------------ |
---|
9151 | !> Sets the gaseous fluxes |
---|
9152 | !------------------------------------------------------------------------------! |
---|
9153 | SUBROUTINE salsa_gas_emission_setup( init ) |
---|
9154 | |
---|
9155 | USE netcdf_data_input_mod, & |
---|
9156 | ONLY: check_existence, close_input_file, get_attribute, get_variable, & |
---|
9157 | inquire_num_variables, inquire_variable_names, & |
---|
9158 | get_dimension_length, open_read_file |
---|
9159 | |
---|
9160 | USE palm_date_time_mod, & |
---|
9161 | ONLY: days_per_week, get_date_time, hours_per_day, months_per_year, seconds_per_hour |
---|
9162 | |
---|
9163 | USE surface_mod, & |
---|
9164 | ONLY: surf_def_h, surf_lsm_h, surf_usm_h |
---|
9165 | |
---|
9166 | IMPLICIT NONE |
---|
9167 | |
---|
9168 | CHARACTER(LEN=80) :: daytype = 'workday' !< default day type |
---|
9169 | CHARACTER(LEN=25) :: in_name !< name of a gas in the input file |
---|
9170 | |
---|
9171 | CHARACTER(LEN=100), DIMENSION(:), ALLOCATABLE :: var_names !< variable names in input data |
---|
9172 | |
---|
9173 | |
---|
9174 | INTEGER(iwp) :: day_of_month !< day of the month |
---|
9175 | INTEGER(iwp) :: day_of_week !< day of the week |
---|
9176 | INTEGER(iwp) :: day_of_year !< day of the year |
---|
9177 | INTEGER(iwp) :: hour_of_day !< hour of the day |
---|
9178 | INTEGER(iwp) :: id_chem !< NetCDF id of chemistry emission file |
---|
9179 | INTEGER(iwp) :: i !< loop index |
---|
9180 | INTEGER(iwp) :: ig !< loop index |
---|
9181 | INTEGER(iwp) :: in !< running index for emission categories |
---|
9182 | INTEGER(iwp) :: index_dd !< index day |
---|
9183 | INTEGER(iwp) :: index_hh !< index hour |
---|
9184 | INTEGER(iwp) :: index_mm !< index month |
---|
9185 | INTEGER(iwp) :: j !< loop index |
---|
9186 | INTEGER(iwp) :: month_of_year !< month of the year |
---|
9187 | INTEGER(iwp) :: num_vars !< number of variables |
---|
9188 | |
---|
9189 | LOGICAL :: netcdf_extend = .FALSE. !< NetCDF input file exists |
---|
9190 | |
---|
9191 | LOGICAL, INTENT(in) :: init !< if .TRUE. --> initialisation call |
---|
9192 | |
---|
9193 | REAL(wp) :: second_of_day !< second of the day |
---|
9194 | |
---|
9195 | REAL(wp), DIMENSION(:), ALLOCATABLE :: time_factor !< emission time factor |
---|
9196 | |
---|
9197 | REAL(wp), DIMENSION(:,:,:), ALLOCATABLE :: dum_var_3d !< |
---|
9198 | |
---|
9199 | REAL(wp), DIMENSION(:,:,:,:,:), ALLOCATABLE :: dum_var_5d !< |
---|
9200 | |
---|
9201 | ! |
---|
9202 | !-- Reset surface fluxes |
---|
9203 | surf_def_h(0)%gtsws = 0.0_wp |
---|
9204 | surf_lsm_h%gtsws = 0.0_wp |
---|
9205 | surf_usm_h%gtsws = 0.0_wp |
---|
9206 | |
---|
9207 | #if defined( __netcdf ) |
---|
9208 | ! |
---|
9209 | !-- Check existence of PIDS_CHEM file |
---|
9210 | INQUIRE( FILE = 'PIDS_CHEM' // TRIM( coupling_char ), EXIST = netcdf_extend ) |
---|
9211 | IF ( .NOT. netcdf_extend ) THEN |
---|
9212 | message_string = 'Input file PIDS_CHEM' // TRIM( coupling_char ) // ' missing!' |
---|
9213 | CALL message( 'salsa_gas_emission_setup', 'PA0640', 1, 2, 0, 6, 0 ) |
---|
9214 | ENDIF |
---|
9215 | ! |
---|
9216 | !-- Open file in read-only mode |
---|
9217 | CALL open_read_file( 'PIDS_CHEM' // TRIM( coupling_char ), id_chem ) |
---|
9218 | |
---|
9219 | IF ( init ) THEN |
---|
9220 | ! |
---|
9221 | !-- Read the index and name of chemical components |
---|
9222 | CALL get_dimension_length( id_chem, chem_emission_att%n_emiss_species, 'nspecies' ) |
---|
9223 | ALLOCATE( chem_emission_att%species_index(1:chem_emission_att%n_emiss_species) ) |
---|
9224 | CALL get_variable( id_chem, 'emission_index', chem_emission_att%species_index ) |
---|
9225 | CALL get_variable( id_chem, 'emission_name', chem_emission_att%species_name, & |
---|
9226 | chem_emission_att%n_emiss_species ) |
---|
9227 | ! |
---|
9228 | !-- Allocate emission data |
---|
9229 | ALLOCATE( chem_emission(1:chem_emission_att%n_emiss_species) ) |
---|
9230 | ! |
---|
9231 | !-- Find the corresponding indices in the model |
---|
9232 | emission_index_chem = 0 |
---|
9233 | DO ig = 1, chem_emission_att%n_emiss_species |
---|
9234 | in_name = chem_emission_att%species_name(ig) |
---|
9235 | SELECT CASE ( TRIM( in_name ) ) |
---|
9236 | CASE ( 'H2SO4', 'h2so4' ) |
---|
9237 | emission_index_chem(1) = ig |
---|
9238 | CASE ( 'HNO3', 'hno3' ) |
---|
9239 | emission_index_chem(2) = ig |
---|
9240 | CASE ( 'NH3', 'nh3' ) |
---|
9241 | emission_index_chem(3) = ig |
---|
9242 | CASE ( 'OCNV', 'ocnv' ) |
---|
9243 | emission_index_chem(4) = ig |
---|
9244 | CASE ( 'OCSV', 'ocsv' ) |
---|
9245 | emission_index_chem(5) = ig |
---|
9246 | END SELECT |
---|
9247 | ENDDO |
---|
9248 | ! |
---|
9249 | !-- Inquire the fill value |
---|
9250 | CALL get_attribute( id_chem, '_FillValue', aero_emission%fill, .FALSE., 'emission_values' ) |
---|
9251 | ! |
---|
9252 | !-- Inquire units of emissions |
---|
9253 | CALL get_attribute( id_chem, 'units', chem_emission_att%units, .FALSE., 'emission_values' ) |
---|
9254 | ! |
---|
9255 | !-- Inquire the level of detail (lod) |
---|
9256 | CALL get_attribute( id_chem, 'lod', lod_gas_emissions, .FALSE., 'emission_values' ) |
---|
9257 | ! |
---|
9258 | !-- Variable names |
---|
9259 | CALL inquire_num_variables( id_chem, num_vars ) |
---|
9260 | ALLOCATE( var_names(1:num_vars) ) |
---|
9261 | CALL inquire_variable_names( id_chem, var_names ) |
---|
9262 | ! |
---|
9263 | !-- Default mode: as total emissions per year |
---|
9264 | IF ( lod_gas_emissions == 1 ) THEN |
---|
9265 | |
---|
9266 | ! |
---|
9267 | !-- Get number of emission categories and allocate emission arrays |
---|
9268 | CALL get_dimension_length( id_chem, chem_emission_att%ncat, 'ncat' ) |
---|
9269 | ALLOCATE( chem_emission_att%cat_index(1:chem_emission_att%ncat), & |
---|
9270 | time_factor(1:chem_emission_att%ncat) ) |
---|
9271 | ! |
---|
9272 | !-- Get emission category names and indices |
---|
9273 | CALL get_variable( id_chem, 'emission_category_name', chem_emission_att%cat_name, & |
---|
9274 | chem_emission_att%ncat) |
---|
9275 | CALL get_variable( id_chem, 'emission_category_index', chem_emission_att%cat_index ) |
---|
9276 | ! |
---|
9277 | !-- Emission time factors: Find check whether emission time factors are given for each hour |
---|
9278 | !-- of year OR based on month, day and hour |
---|
9279 | ! |
---|
9280 | !-- For each hour of year: |
---|
9281 | IF ( check_existence( var_names, 'nhoursyear' ) ) THEN |
---|
9282 | CALL get_dimension_length( id_chem, chem_emission_att%nhoursyear, 'nhoursyear' ) |
---|
9283 | ALLOCATE( chem_emission_att%hourly_emis_time_factor(1:chem_emission_att%ncat, & |
---|
9284 | 1:chem_emission_att%nhoursyear) ) |
---|
9285 | CALL get_variable( id_chem, 'emission_time_factors', & |
---|
9286 | chem_emission_att%hourly_emis_time_factor, & |
---|
9287 | 0, chem_emission_att%nhoursyear-1, 0, chem_emission_att%ncat-1 ) |
---|
9288 | ! |
---|
9289 | !-- Based on the month, day and hour: |
---|
9290 | ELSEIF ( check_existence( var_names, 'nmonthdayhour' ) ) THEN |
---|
9291 | CALL get_dimension_length( id_chem, chem_emission_att%nmonthdayhour, 'nmonthdayhour' ) |
---|
9292 | ALLOCATE( chem_emission_att%mdh_emis_time_factor(1:chem_emission_att%ncat, & |
---|
9293 | 1:chem_emission_att%nmonthdayhour) ) |
---|
9294 | CALL get_variable( id_chem, 'emission_time_factors', & |
---|
9295 | chem_emission_att%mdh_emis_time_factor, & |
---|
9296 | 0, chem_emission_att%nmonthdayhour-1, 0, chem_emission_att%ncat-1 ) |
---|
9297 | ELSE |
---|
9298 | message_string = 'emission_time_factors should be given for each nhoursyear OR ' // & |
---|
9299 | 'nmonthdayhour' |
---|
9300 | CALL message( 'salsa_gas_emission_setup','PA0641', 1, 2, 0, 6, 0 ) |
---|
9301 | ENDIF |
---|
9302 | ! |
---|
9303 | !-- Next emission update |
---|
9304 | CALL get_date_time( time_since_reference_point, second_of_day=second_of_day ) |
---|
9305 | next_gas_emission_update = MOD( second_of_day, seconds_per_hour ) - seconds_per_hour |
---|
9306 | ! |
---|
9307 | !-- Allocate and read surface emission data (in total PM) (NOTE that "preprocessed" input data |
---|
9308 | !-- array is applied now here) |
---|
9309 | ALLOCATE( dum_var_5d(1,nys:nyn,nxl:nxr,1:chem_emission_att%n_emiss_species, & |
---|
9310 | 1:chem_emission_att%ncat) ) |
---|
9311 | CALL get_variable( id_chem, 'emission_values', dum_var_5d, 0, chem_emission_att%ncat-1, & |
---|
9312 | 0, chem_emission_att%n_emiss_species-1, nxl, nxr, nys, nyn, 0, 0 ) |
---|
9313 | DO ig = 1, chem_emission_att%n_emiss_species |
---|
9314 | ALLOCATE( chem_emission(ig)%default_emission_data(nys:nyn,nxl:nxr, & |
---|
9315 | 1:chem_emission_att%ncat) ) |
---|
9316 | DO in = 1, chem_emission_att%ncat |
---|
9317 | DO i = nxl, nxr |
---|
9318 | DO j = nys, nyn |
---|
9319 | chem_emission(ig)%default_emission_data(j,i,in) = dum_var_5d(1,j,i,ig,in) |
---|
9320 | ENDDO |
---|
9321 | ENDDO |
---|
9322 | ENDDO |
---|
9323 | ENDDO |
---|
9324 | DEALLOCATE( dum_var_5d ) |
---|
9325 | ! |
---|
9326 | !-- Pre-processed mode: |
---|
9327 | ELSEIF ( lod_gas_emissions == 2 ) THEN |
---|
9328 | ! |
---|
9329 | !-- Number of time steps in the emission data |
---|
9330 | CALL get_dimension_length( id_chem, chem_emission_att%dt_emission, 'time' ) |
---|
9331 | ! |
---|
9332 | !-- Allocate and read time |
---|
9333 | ALLOCATE( gas_emission_time(1:chem_emission_att%dt_emission) ) |
---|
9334 | CALL get_variable( id_chem, 'time', gas_emission_time ) |
---|
9335 | ELSE |
---|
9336 | message_string = 'Unknown lod for emission_values.' |
---|
9337 | CALL message( 'salsa_gas_emission_setup','PA0642', 1, 2, 0, 6, 0 ) |
---|
9338 | ENDIF ! lod |
---|
9339 | |
---|
9340 | ENDIF ! init |
---|
9341 | ! |
---|
9342 | !-- Define and set current emission values: |
---|
9343 | |
---|
9344 | IF ( lod_gas_emissions == 1 ) THEN |
---|
9345 | ! |
---|
9346 | !-- Emission time factors for each emission category at current time step |
---|
9347 | IF ( chem_emission_att%nhoursyear > chem_emission_att%nmonthdayhour ) THEN |
---|
9348 | ! |
---|
9349 | !-- Get the index of the current hour |
---|
9350 | CALL get_date_time( time_since_reference_point, & |
---|
9351 | day_of_year=day_of_year, hour=hour_of_day ) |
---|
9352 | index_hh = ( day_of_year - 1_iwp ) * hours_per_day + hour_of_day |
---|
9353 | time_factor = chem_emission_att%hourly_emis_time_factor(:,index_hh) |
---|
9354 | |
---|
9355 | ELSEIF ( chem_emission_att%nhoursyear < chem_emission_att%nmonthdayhour ) THEN |
---|
9356 | ! |
---|
9357 | !-- Get the index of current hour (index_hh) (TODO: Now "workday" is always assumed. |
---|
9358 | !-- Needs to be calculated.) |
---|
9359 | CALL get_date_time( time_since_reference_point, & |
---|
9360 | month=month_of_year, & |
---|
9361 | day=day_of_month, & |
---|
9362 | hour=hour_of_day, & |
---|
9363 | day_of_week=day_of_week ) |
---|
9364 | index_mm = month_of_year |
---|
9365 | index_dd = months_per_year + day_of_week |
---|
9366 | SELECT CASE(TRIM(daytype)) |
---|
9367 | |
---|
9368 | CASE ("workday") |
---|
9369 | index_hh = months_per_year + days_per_week + hour_of_day |
---|
9370 | |
---|
9371 | CASE ("weekend") |
---|
9372 | index_hh = months_per_year + days_per_week + hours_per_day + hour_of_day |
---|
9373 | |
---|
9374 | CASE ("holiday") |
---|
9375 | index_hh = months_per_year + days_per_week + 2*hours_per_day + hour_of_day |
---|
9376 | |
---|
9377 | END SELECT |
---|
9378 | time_factor = chem_emission_att%mdh_emis_time_factor(:,index_mm) * & |
---|
9379 | chem_emission_att%mdh_emis_time_factor(:,index_dd) * & |
---|
9380 | chem_emission_att%mdh_emis_time_factor(:,index_hh) |
---|
9381 | ENDIF |
---|
9382 | ! |
---|
9383 | !-- Set gas emissions for each emission category |
---|
9384 | ALLOCATE( dum_var_3d(nys:nyn,nxl:nxr,1:chem_emission_att%n_emiss_species) ) |
---|
9385 | |
---|
9386 | DO in = 1, chem_emission_att%ncat |
---|
9387 | DO ig = 1, chem_emission_att%n_emiss_species |
---|
9388 | dum_var_3d(:,:,ig) = chem_emission(ig)%default_emission_data(:,:,in) |
---|
9389 | ENDDO |
---|
9390 | ! |
---|
9391 | !-- Set surface fluxes only for either default, land or urban surface |
---|
9392 | IF ( .NOT. land_surface .AND. .NOT. urban_surface ) THEN |
---|
9393 | CALL set_gas_flux( surf_def_h(0), emission_index_chem, chem_emission_att%units, & |
---|
9394 | dum_var_3d(:,:,in), time_factor(in) ) |
---|
9395 | ELSE |
---|
9396 | CALL set_gas_flux( surf_usm_h, emission_index_chem, chem_emission_att%units, & |
---|
9397 | dum_var_3d(:,:,in), time_factor(in) ) |
---|
9398 | CALL set_gas_flux( surf_lsm_h, emission_index_chem, chem_emission_att%units, & |
---|
9399 | dum_var_3d(:,:,in), time_factor(in) ) |
---|
9400 | ENDIF |
---|
9401 | ENDDO |
---|
9402 | DEALLOCATE( dum_var_3d ) |
---|
9403 | ! |
---|
9404 | !-- The next emission update is again after one hour |
---|
9405 | next_gas_emission_update = next_gas_emission_update + 3600.0_wp |
---|
9406 | |
---|
9407 | ELSEIF ( lod_gas_emissions == 2 ) THEN |
---|
9408 | ! |
---|
9409 | !-- Obtain time index for current input starting at 0. |
---|
9410 | !-- @todo: At the moment emission data and simulated time correspond to each other. |
---|
9411 | chem_emission_att%i_hour = MINLOC( ABS( gas_emission_time - time_since_reference_point ), & |
---|
9412 | DIM = 1 ) - 1 |
---|
9413 | ! |
---|
9414 | !-- Allocate the data input array always before reading in the data and deallocate after (NOTE |
---|
9415 | !-- that "preprocessed" input data array is applied now here) |
---|
9416 | ALLOCATE( dum_var_5d(1,1,nys:nyn,nxl:nxr,1:chem_emission_att%n_emiss_species) ) |
---|
9417 | ! |
---|
9418 | !-- Read in the next time step |
---|
9419 | CALL get_variable( id_chem, 'emission_values', dum_var_5d, & |
---|
9420 | 0, chem_emission_att%n_emiss_species-1, nxl, nxr, nys, nyn, 0, 0, & |
---|
9421 | chem_emission_att%i_hour, chem_emission_att%i_hour ) |
---|
9422 | ! |
---|
9423 | !-- Set surface fluxes only for either default, land or urban surface |
---|
9424 | IF ( .NOT. land_surface .AND. .NOT. urban_surface ) THEN |
---|
9425 | CALL set_gas_flux( surf_def_h(0), emission_index_chem, chem_emission_att%units, & |
---|
9426 | dum_var_5d(1,1,:,:,:) ) |
---|
9427 | ELSE |
---|
9428 | CALL set_gas_flux( surf_usm_h, emission_index_chem, chem_emission_att%units, & |
---|
9429 | dum_var_5d(1,1,:,:,:) ) |
---|
9430 | CALL set_gas_flux( surf_lsm_h, emission_index_chem, chem_emission_att%units, & |
---|
9431 | dum_var_5d(1,1,:,:,:) ) |
---|
9432 | ENDIF |
---|
9433 | DEALLOCATE ( dum_var_5d ) |
---|
9434 | ! |
---|
9435 | !-- Determine the next emission update |
---|
9436 | next_gas_emission_update = gas_emission_time(chem_emission_att%i_hour+2) |
---|
9437 | |
---|
9438 | ENDIF |
---|
9439 | ! |
---|
9440 | !-- Close input file |
---|
9441 | CALL close_input_file( id_chem ) |
---|
9442 | |
---|
9443 | #else |
---|
9444 | message_string = 'salsa_emission_mode = "read_from_file", but preprocessor directive ' // & |
---|
9445 | ' __netcdf is not used in compiling!' |
---|
9446 | CALL message( 'salsa_gas_emission_setup', 'PA0643', 1, 2, 0, 6, 0 ) |
---|
9447 | |
---|
9448 | #endif |
---|
9449 | |
---|
9450 | CONTAINS |
---|
9451 | !------------------------------------------------------------------------------! |
---|
9452 | ! Description: |
---|
9453 | ! ------------ |
---|
9454 | !> Set gas fluxes for selected type of surfaces |
---|
9455 | !------------------------------------------------------------------------------! |
---|
9456 | SUBROUTINE set_gas_flux( surface, cc_i_mod, unit, source_array, time_fac ) |
---|
9457 | |
---|
9458 | USE arrays_3d, & |
---|
9459 | ONLY: dzw, hyp, pt, rho_air_zw |
---|
9460 | |
---|
9461 | USE grid_variables, & |
---|
9462 | ONLY: dx, dy |
---|
9463 | |
---|
9464 | USE surface_mod, & |
---|
9465 | ONLY: surf_type |
---|
9466 | |
---|
9467 | IMPLICIT NONE |
---|
9468 | |
---|
9469 | CHARACTER(LEN=*), INTENT(in) :: unit !< flux unit in the input file |
---|
9470 | |
---|
9471 | INTEGER(iwp) :: ig !< running index for gases |
---|
9472 | INTEGER(iwp) :: i !< loop index |
---|
9473 | INTEGER(iwp) :: j !< loop index |
---|
9474 | INTEGER(iwp) :: k !< loop index |
---|
9475 | INTEGER(iwp) :: m !< running index for surface elements |
---|
9476 | |
---|
9477 | INTEGER(iwp), DIMENSION(:) :: cc_i_mod !< index of different gases in the input data |
---|
9478 | |
---|
9479 | LOGICAL :: use_time_fac !< .TRUE. is time_fac present |
---|
9480 | |
---|
9481 | REAL(wp), OPTIONAL :: time_fac !< emission time factor |
---|
9482 | |
---|
9483 | REAL(wp), DIMENSION(ngases_salsa) :: conv !< unit conversion factor |
---|
9484 | |
---|
9485 | REAL(wp), DIMENSION(nys:nyn,nxl:nxr,chem_emission_att%n_emiss_species), INTENT(in) :: source_array !< |
---|
9486 | |
---|
9487 | TYPE(surf_type), INTENT(inout) :: surface !< respective surface type |
---|
9488 | |
---|
9489 | conv = 1.0_wp |
---|
9490 | use_time_fac = PRESENT( time_fac ) |
---|
9491 | |
---|
9492 | DO m = 1, surface%ns |
---|
9493 | ! |
---|
9494 | !-- Get indices of respective grid point |
---|
9495 | i = surface%i(m) |
---|
9496 | j = surface%j(m) |
---|
9497 | k = surface%k(m) |
---|
9498 | ! |
---|
9499 | !-- Unit conversion factor: convert to SI units (#/m2/s) |
---|
9500 | SELECT CASE ( TRIM( unit ) ) |
---|
9501 | CASE ( 'kg/m2/yr' ) |
---|
9502 | conv(1) = avo / ( amh2so4 * 3600.0_wp ) |
---|
9503 | conv(2) = avo / ( amhno3 * 3600.0_wp ) |
---|
9504 | conv(3) = avo / ( amnh3 * 3600.0_wp ) |
---|
9505 | conv(4) = avo / ( amoc * 3600.0_wp ) |
---|
9506 | conv(5) = avo / ( amoc * 3600.0_wp ) |
---|
9507 | CASE ( 'g/m2/yr' ) |
---|
9508 | conv(1) = avo / ( amh2so4 * 3.6E+6_wp ) |
---|
9509 | conv(2) = avo / ( amhno3 * 3.6E+6_wp ) |
---|
9510 | conv(3) = avo / ( amnh3 * 3.6E+6_wp ) |
---|
9511 | conv(4) = avo / ( amoc * 3.6E+6_wp ) |
---|
9512 | conv(5) = avo / ( amoc * 3.6E+6_wp ) |
---|
9513 | CASE ( 'g/m2/s' ) |
---|
9514 | conv(1) = avo / ( amh2so4 * 1000.0_wp ) |
---|
9515 | conv(2) = avo / ( amhno3 * 1000.0_wp ) |
---|
9516 | conv(3) = avo / ( amnh3 * 1000.0_wp ) |
---|
9517 | conv(4) = avo / ( amoc * 1000.0_wp ) |
---|
9518 | conv(5) = avo / ( amoc * 1000.0_wp ) |
---|
9519 | CASE ( '#/m2/s' ) |
---|
9520 | conv = 1.0_wp |
---|
9521 | CASE ( 'ppm/m2/s' ) |
---|
9522 | conv = for_ppm_to_nconc * hyp(k) / pt(k,j,i) * ( 1.0E5_wp / hyp(k) )**0.286_wp * & |
---|
9523 | dx * dy * dzw(k) |
---|
9524 | CASE ( 'mumol/m2/s' ) |
---|
9525 | conv = 1.0E-6_wp * avo |
---|
9526 | CASE DEFAULT |
---|
9527 | message_string = 'unknown unit for gas emissions: ' // TRIM( chem_emission_att%units ) |
---|
9528 | CALL message( 'set_gas_flux','PA0644', 1, 2, 0, 6, 0 ) |
---|
9529 | |
---|
9530 | END SELECT |
---|
9531 | |
---|
9532 | DO ig = 1, ngases_salsa |
---|
9533 | IF ( use_time_fac ) THEN |
---|
9534 | surface%gtsws(m,ig) = surface%gtsws(m,ig) + rho_air_zw(k-1) * conv(ig) * time_fac & |
---|
9535 | * MAX( 0.0_wp, source_array(j,i,cc_i_mod(ig) ) ) |
---|
9536 | ELSE |
---|
9537 | surface%gtsws(m,ig) = surface%gtsws(m,ig) + rho_air_zw(k-1) * conv(ig) & |
---|
9538 | * MAX( 0.0_wp, source_array(j,i,cc_i_mod(ig) ) ) |
---|
9539 | ENDIF |
---|
9540 | ENDDO ! ig |
---|
9541 | |
---|
9542 | ENDDO ! m |
---|
9543 | |
---|
9544 | END SUBROUTINE set_gas_flux |
---|
9545 | |
---|
9546 | END SUBROUTINE salsa_gas_emission_setup |
---|
9547 | |
---|
9548 | !------------------------------------------------------------------------------! |
---|
9549 | ! Description: |
---|
9550 | ! ------------ |
---|
9551 | !> Check data output for salsa. |
---|
9552 | !------------------------------------------------------------------------------! |
---|
9553 | SUBROUTINE salsa_check_data_output( var, unit ) |
---|
9554 | |
---|
9555 | IMPLICIT NONE |
---|
9556 | |
---|
9557 | CHARACTER(LEN=*) :: unit !< |
---|
9558 | CHARACTER(LEN=*) :: var !< |
---|
9559 | |
---|
9560 | INTEGER(iwp) :: char_to_int !< for converting character to integer |
---|
9561 | |
---|
9562 | IF ( var(1:6) /= 'salsa_' ) THEN |
---|
9563 | unit = 'illegal' |
---|
9564 | RETURN |
---|
9565 | ENDIF |
---|
9566 | ! |
---|
9567 | !-- Treat bin-specific outputs separately |
---|
9568 | IF ( var(7:11) == 'N_bin' ) THEN |
---|
9569 | READ( var(12:),* ) char_to_int |
---|
9570 | IF ( char_to_int >= 1 .AND. char_to_int <= SUM( nbin ) ) THEN |
---|
9571 | unit = '#/m3' |
---|
9572 | ELSE |
---|
9573 | unit = 'illegal' |
---|
9574 | RETURN |
---|
9575 | ENDIF |
---|
9576 | |
---|
9577 | ELSEIF ( var(7:11) == 'm_bin' ) THEN |
---|
9578 | READ( var(12:),* ) char_to_int |
---|
9579 | IF ( char_to_int >= 1 .AND. char_to_int <= SUM( nbin ) ) THEN |
---|
9580 | unit = 'kg/m3' |
---|
9581 | ELSE |
---|
9582 | unit = 'illegal' |
---|
9583 | RETURN |
---|
9584 | ENDIF |
---|
9585 | |
---|
9586 | ELSE |
---|
9587 | SELECT CASE ( TRIM( var(7:) ) ) |
---|
9588 | |
---|
9589 | CASE ( 'g_H2SO4', 'g_HNO3', 'g_NH3', 'g_OCNV', 'g_OCSV' ) |
---|
9590 | IF ( salsa_gases_from_chem ) THEN |
---|
9591 | message_string = 'gases are imported from the chemistry module and thus output '// & |
---|
9592 | 'of "' // TRIM( var ) // '" is not allowed' |
---|
9593 | CALL message( 'check_parameters', 'PA0653', 1, 2, 0, 6, 0 ) |
---|
9594 | ENDIF |
---|
9595 | unit = '#/m3' |
---|
9596 | |
---|
9597 | CASE ( 'LDSA' ) |
---|
9598 | unit = 'mum2/cm3' |
---|
9599 | |
---|
9600 | CASE ( 'PM0.1', 'PM2.5', 'PM10', 's_BC', 's_DU', 's_H2O', 's_NH', 's_NO', 's_OC', & |
---|
9601 | 's_SO4', 's_SS' ) |
---|
9602 | unit = 'kg/m3' |
---|
9603 | |
---|
9604 | CASE ( 'N_UFP', 'Ntot' ) |
---|
9605 | unit = '#/m3' |
---|
9606 | |
---|
9607 | CASE DEFAULT |
---|
9608 | unit = 'illegal' |
---|
9609 | |
---|
9610 | END SELECT |
---|
9611 | ENDIF |
---|
9612 | |
---|
9613 | END SUBROUTINE salsa_check_data_output |
---|
9614 | |
---|
9615 | !------------------------------------------------------------------------------! |
---|
9616 | ! Description: |
---|
9617 | ! ------------ |
---|
9618 | !> Check profile data output for salsa. Currently only for diagnostic variables |
---|
9619 | !> Ntot, N_UFP, PM0.1, PM2.5, PM10 and LDSA |
---|
9620 | !------------------------------------------------------------------------------! |
---|
9621 | SUBROUTINE salsa_check_data_output_pr( var, var_count, unit, dopr_unit ) |
---|
9622 | |
---|
9623 | USE arrays_3d, & |
---|
9624 | ONLY: zu |
---|
9625 | |
---|
9626 | USE profil_parameter, & |
---|
9627 | ONLY: dopr_index |
---|
9628 | |
---|
9629 | USE statistics, & |
---|
9630 | ONLY: hom, pr_palm, statistic_regions |
---|
9631 | |
---|
9632 | IMPLICIT NONE |
---|
9633 | |
---|
9634 | CHARACTER(LEN=*) :: dopr_unit !< |
---|
9635 | CHARACTER(LEN=*) :: unit !< |
---|
9636 | CHARACTER(LEN=*) :: var !< |
---|
9637 | |
---|
9638 | INTEGER(iwp) :: var_count !< |
---|
9639 | |
---|
9640 | IF ( var(1:6) /= 'salsa_' ) THEN |
---|
9641 | unit = 'illegal' |
---|
9642 | RETURN |
---|
9643 | ENDIF |
---|
9644 | |
---|
9645 | SELECT CASE ( TRIM( var(7:) ) ) |
---|
9646 | |
---|
9647 | CASE( 'LDSA' ) |
---|
9648 | salsa_pr_count = salsa_pr_count + 1 |
---|
9649 | salsa_pr_index(salsa_pr_count) = 1 |
---|
9650 | dopr_index(var_count) = pr_palm + salsa_pr_count |
---|
9651 | dopr_unit = 'mum2/cm3' |
---|
9652 | unit = dopr_unit |
---|
9653 | hom(:,2,dopr_index(var_count),:) = SPREAD( zu, 2, statistic_regions+1 ) |
---|
9654 | |
---|
9655 | CASE( 'N_UFP' ) |
---|
9656 | salsa_pr_count = salsa_pr_count + 1 |
---|
9657 | salsa_pr_index(salsa_pr_count) = 2 |
---|
9658 | dopr_index(var_count) = pr_palm + salsa_pr_count |
---|
9659 | dopr_unit = '#/m3' |
---|
9660 | unit = dopr_unit |
---|
9661 | hom(:,2,dopr_index(var_count),:) = SPREAD( zu, 2, statistic_regions+1 ) |
---|
9662 | |
---|
9663 | CASE( 'Ntot' ) |
---|
9664 | salsa_pr_count = salsa_pr_count + 1 |
---|
9665 | salsa_pr_index(salsa_pr_count) = 3 |
---|
9666 | dopr_index(var_count) = pr_palm + salsa_pr_count |
---|
9667 | dopr_unit = '#/m3' |
---|
9668 | unit = dopr_unit |
---|
9669 | hom(:,2,dopr_index(var_count),:) = SPREAD( zu, 2, statistic_regions+1 ) |
---|
9670 | |
---|
9671 | CASE( 'PM0.1' ) |
---|
9672 | salsa_pr_count = salsa_pr_count + 1 |
---|
9673 | salsa_pr_index(salsa_pr_count) = 4 |
---|
9674 | dopr_index(var_count) = pr_palm + salsa_pr_count |
---|
9675 | dopr_unit = 'kg/m3' |
---|
9676 | unit = dopr_unit |
---|
9677 | hom(:,2,dopr_index(var_count),:) = SPREAD( zu, 2, statistic_regions+1 ) |
---|
9678 | |
---|
9679 | CASE( 'PM2.5' ) |
---|
9680 | salsa_pr_count = salsa_pr_count + 1 |
---|
9681 | salsa_pr_index(salsa_pr_count) = 5 |
---|
9682 | dopr_index(var_count) = pr_palm + salsa_pr_count |
---|
9683 | dopr_unit = 'kg/m3' |
---|
9684 | unit = dopr_unit |
---|
9685 | hom(:,2,dopr_index(var_count),:) = SPREAD( zu, 2, statistic_regions+1 ) |
---|
9686 | |
---|
9687 | CASE( 'PM10' ) |
---|
9688 | salsa_pr_count = salsa_pr_count + 1 |
---|
9689 | salsa_pr_index(salsa_pr_count) = 6 |
---|
9690 | dopr_index(var_count) = pr_palm + salsa_pr_count |
---|
9691 | dopr_unit = 'kg/m3' |
---|
9692 | unit = dopr_unit |
---|
9693 | hom(:,2,dopr_index(var_count),:) = SPREAD( zu, 2, statistic_regions+1 ) |
---|
9694 | |
---|
9695 | CASE DEFAULT |
---|
9696 | unit = 'illegal' |
---|
9697 | |
---|
9698 | END SELECT |
---|
9699 | |
---|
9700 | |
---|
9701 | END SUBROUTINE salsa_check_data_output_pr |
---|
9702 | |
---|
9703 | !-------------------------------------------------------------------------------! |
---|
9704 | !> Description: |
---|
9705 | !> Calculation of horizontally averaged profiles for salsa. |
---|
9706 | !-------------------------------------------------------------------------------! |
---|
9707 | SUBROUTINE salsa_statistics( mode, sr, tn ) |
---|
9708 | |
---|
9709 | USE control_parameters, & |
---|
9710 | ONLY: max_pr_user |
---|
9711 | |
---|
9712 | USE chem_modules, & |
---|
9713 | ONLY: max_pr_cs |
---|
9714 | |
---|
9715 | USE statistics, & |
---|
9716 | ONLY: pr_palm, rmask, sums_l |
---|
9717 | |
---|
9718 | IMPLICIT NONE |
---|
9719 | |
---|
9720 | CHARACTER(LEN=*) :: mode !< |
---|
9721 | |
---|
9722 | INTEGER(iwp) :: i !< loop index |
---|
9723 | INTEGER(iwp) :: ib !< loop index |
---|
9724 | INTEGER(iwp) :: ic !< loop index |
---|
9725 | INTEGER(iwp) :: ii !< loop index |
---|
9726 | INTEGER(iwp) :: ind !< index in the statistical output |
---|
9727 | INTEGER(iwp) :: j !< loop index |
---|
9728 | INTEGER(iwp) :: k !< loop index |
---|
9729 | INTEGER(iwp) :: sr !< statistical region |
---|
9730 | INTEGER(iwp) :: tn !< thread number |
---|
9731 | |
---|
9732 | REAL(wp) :: df !< For calculating LDSA: fraction of particles depositing in the alveolar |
---|
9733 | !< (or tracheobronchial) region of the lung. Depends on the particle size |
---|
9734 | REAL(wp) :: mean_d !< Particle diameter in micrometres |
---|
9735 | REAL(wp) :: temp_bin !< temporary variable |
---|
9736 | |
---|
9737 | IF ( mode == 'profiles' ) THEN |
---|
9738 | !$OMP DO |
---|
9739 | DO ii = 1, salsa_pr_count |
---|
9740 | |
---|
9741 | ind = pr_palm + max_pr_user + max_pr_cs + ii |
---|
9742 | |
---|
9743 | SELECT CASE( salsa_pr_index(ii) ) |
---|
9744 | |
---|
9745 | CASE( 1 ) ! LDSA |
---|
9746 | DO i = nxl, nxr |
---|
9747 | DO j = nys, nyn |
---|
9748 | DO k = nzb, nzt+1 |
---|
9749 | temp_bin = 0.0_wp |
---|
9750 | DO ib = 1, nbins_aerosol |
---|
9751 | ! |
---|
9752 | !-- Diameter in micrometres |
---|
9753 | mean_d = 1.0E+6_wp * ra_dry(k,j,i,ib) * 2.0_wp |
---|
9754 | ! |
---|
9755 | !-- Deposition factor: alveolar |
---|
9756 | df = ( 0.01555_wp / mean_d ) * ( EXP( -0.416_wp * ( LOG( mean_d ) + & |
---|
9757 | 2.84_wp )**2 ) + 19.11_wp * EXP( -0.482_wp * ( LOG( mean_d ) - & |
---|
9758 | 1.362_wp )**2 ) ) |
---|
9759 | ! |
---|
9760 | !-- Lung-deposited surface area LDSA (units mum2/cm3) |
---|
9761 | temp_bin = temp_bin + pi * mean_d**2 * df * 1.0E-6_wp * & |
---|
9762 | aerosol_number(ib)%conc(k,j,i) |
---|
9763 | ENDDO |
---|
9764 | sums_l(k,ind,tn) = sums_l(k,ind,tn) + temp_bin * rmask(j,i,sr) * & |
---|
9765 | MERGE( 1.0_wp, 0.0_wp, BTEST( wall_flags_0(k,j,i), 22 ) ) |
---|
9766 | ENDDO |
---|
9767 | ENDDO |
---|
9768 | ENDDO |
---|
9769 | |
---|
9770 | CASE( 2 ) ! N_UFP |
---|
9771 | DO i = nxl, nxr |
---|
9772 | DO j = nys, nyn |
---|
9773 | DO k = nzb, nzt+1 |
---|
9774 | temp_bin = 0.0_wp |
---|
9775 | DO ib = 1, nbins_aerosol |
---|
9776 | IF ( 2.0_wp * ra_dry(k,j,i,ib) <= 0.1E-6_wp ) & |
---|
9777 | temp_bin = temp_bin + aerosol_number(ib)%conc(k,j,i) |
---|
9778 | ENDDO |
---|
9779 | sums_l(k,ind,tn) = sums_l(k,ind,tn) + temp_bin * rmask(j,i,sr) * & |
---|
9780 | MERGE( 1.0_wp, 0.0_wp, BTEST( wall_flags_0(k,j,i), 22 ) ) |
---|
9781 | ENDDO |
---|
9782 | ENDDO |
---|
9783 | ENDDO |
---|
9784 | |
---|
9785 | CASE( 3 ) ! Ntot |
---|
9786 | DO i = nxl, nxr |
---|
9787 | DO j = nys, nyn |
---|
9788 | DO k = nzb, nzt+1 |
---|
9789 | temp_bin = 0.0_wp |
---|
9790 | DO ib = 1, nbins_aerosol |
---|
9791 | temp_bin = temp_bin + aerosol_number(ib)%conc(k,j,i) |
---|
9792 | ENDDO |
---|
9793 | sums_l(k,ind,tn) = sums_l(k,ind,tn) + temp_bin * rmask(j,i,sr) * & |
---|
9794 | MERGE( 1.0_wp, 0.0_wp, BTEST( wall_flags_0(k,j,i), 22 ) ) |
---|
9795 | ENDDO |
---|
9796 | ENDDO |
---|
9797 | ENDDO |
---|
9798 | |
---|
9799 | CASE( 4 ) ! PM0.1 |
---|
9800 | DO i = nxl, nxr |
---|
9801 | DO j = nys, nyn |
---|
9802 | DO k = nzb, nzt+1 |
---|
9803 | temp_bin = 0.0_wp |
---|
9804 | DO ib = 1, nbins_aerosol |
---|
9805 | IF ( 2.0_wp * ra_dry(k,j,i,ib) <= 0.1E-6_wp ) THEN |
---|
9806 | DO ic = ib, nbins_aerosol * ncc, nbins_aerosol |
---|
9807 | temp_bin = temp_bin + aerosol_mass(ic)%conc(k,j,i) |
---|
9808 | ENDDO |
---|
9809 | ENDIF |
---|
9810 | ENDDO |
---|
9811 | sums_l(k,ind,tn) = sums_l(k,ind,tn) + temp_bin * rmask(j,i,sr) * & |
---|
9812 | MERGE( 1.0_wp, 0.0_wp, BTEST( wall_flags_0(k,j,i), 22 ) ) |
---|
9813 | ENDDO |
---|
9814 | ENDDO |
---|
9815 | ENDDO |
---|
9816 | |
---|
9817 | CASE( 5 ) ! PM2.5 |
---|
9818 | DO i = nxl, nxr |
---|
9819 | DO j = nys, nyn |
---|
9820 | DO k = nzb, nzt+1 |
---|
9821 | temp_bin = 0.0_wp |
---|
9822 | DO ib = 1, nbins_aerosol |
---|
9823 | IF ( 2.0_wp * ra_dry(k,j,i,ib) <= 2.5E-6_wp ) THEN |
---|
9824 | DO ic = ib, nbins_aerosol * ncc, nbins_aerosol |
---|
9825 | temp_bin = temp_bin + aerosol_mass(ic)%conc(k,j,i) |
---|
9826 | ENDDO |
---|
9827 | ENDIF |
---|
9828 | ENDDO |
---|
9829 | sums_l(k,ind,tn) = sums_l(k,ind,tn) + temp_bin * rmask(j,i,sr) * & |
---|
9830 | MERGE( 1.0_wp, 0.0_wp, BTEST( wall_flags_0(k,j,i), 22 ) ) |
---|
9831 | ENDDO |
---|
9832 | ENDDO |
---|
9833 | ENDDO |
---|
9834 | |
---|
9835 | CASE( 6 ) ! PM10 |
---|
9836 | DO i = nxl, nxr |
---|
9837 | DO j = nys, nyn |
---|
9838 | DO k = nzb, nzt+1 |
---|
9839 | temp_bin = 0.0_wp |
---|
9840 | DO ib = 1, nbins_aerosol |
---|
9841 | IF ( 2.0_wp * ra_dry(k,j,i,ib) <= 10.0E-6_wp ) THEN |
---|
9842 | DO ic = ib, nbins_aerosol * ncc, nbins_aerosol |
---|
9843 | temp_bin = temp_bin + aerosol_mass(ic)%conc(k,j,i) |
---|
9844 | ENDDO |
---|
9845 | ENDIF |
---|
9846 | ENDDO |
---|
9847 | sums_l(k,ind,tn) = sums_l(k,ind,tn) + temp_bin * rmask(j,i,sr) * & |
---|
9848 | MERGE( 1.0_wp, 0.0_wp, BTEST( wall_flags_0(k,j,i), 22 ) ) |
---|
9849 | ENDDO |
---|
9850 | ENDDO |
---|
9851 | ENDDO |
---|
9852 | |
---|
9853 | END SELECT |
---|
9854 | ENDDO |
---|
9855 | |
---|
9856 | ELSEIF ( mode == 'time_series' ) THEN |
---|
9857 | ! |
---|
9858 | !-- TODO |
---|
9859 | ENDIF |
---|
9860 | |
---|
9861 | END SUBROUTINE salsa_statistics |
---|
9862 | |
---|
9863 | |
---|
9864 | !------------------------------------------------------------------------------! |
---|
9865 | ! |
---|
9866 | ! Description: |
---|
9867 | ! ------------ |
---|
9868 | !> Subroutine for averaging 3D data |
---|
9869 | !------------------------------------------------------------------------------! |
---|
9870 | SUBROUTINE salsa_3d_data_averaging( mode, variable ) |
---|
9871 | |
---|
9872 | USE control_parameters, & |
---|
9873 | ONLY: average_count_3d |
---|
9874 | |
---|
9875 | IMPLICIT NONE |
---|
9876 | |
---|
9877 | CHARACTER(LEN=*) :: mode !< |
---|
9878 | CHARACTER(LEN=10) :: vari !< |
---|
9879 | CHARACTER(LEN=*) :: variable !< |
---|
9880 | |
---|
9881 | INTEGER(iwp) :: char_to_int !< for converting character to integer |
---|
9882 | INTEGER(iwp) :: found_index !< |
---|
9883 | INTEGER(iwp) :: i !< |
---|
9884 | INTEGER(iwp) :: ib !< |
---|
9885 | INTEGER(iwp) :: ic !< |
---|
9886 | INTEGER(iwp) :: j !< |
---|
9887 | INTEGER(iwp) :: k !< |
---|
9888 | |
---|
9889 | REAL(wp) :: df !< For calculating LDSA: fraction of particles depositing in the alveolar |
---|
9890 | !< (or tracheobronchial) region of the lung. Depends on the particle size |
---|
9891 | REAL(wp) :: mean_d !< Particle diameter in micrometres |
---|
9892 | REAL(wp) :: temp_bin !< temporary variable |
---|
9893 | |
---|
9894 | REAL(wp), DIMENSION(:,:,:), POINTER :: to_be_resorted !< points to selected output variable |
---|
9895 | |
---|
9896 | temp_bin = 0.0_wp |
---|
9897 | |
---|
9898 | IF ( mode == 'allocate' ) THEN |
---|
9899 | |
---|
9900 | IF ( variable(7:11) == 'N_bin' ) THEN |
---|
9901 | IF ( .NOT. ALLOCATED( nbins_av ) ) THEN |
---|
9902 | ALLOCATE( nbins_av(nzb:nzt+1,nysg:nyng,nxlg:nxrg,nbins_aerosol) ) |
---|
9903 | ENDIF |
---|
9904 | nbins_av = 0.0_wp |
---|
9905 | |
---|
9906 | ELSEIF ( variable(7:11) == 'm_bin' ) THEN |
---|
9907 | IF ( .NOT. ALLOCATED( mbins_av ) ) THEN |
---|
9908 | ALLOCATE( mbins_av(nzb:nzt+1,nysg:nyng,nxlg:nxrg,nbins_aerosol) ) |
---|
9909 | ENDIF |
---|
9910 | mbins_av = 0.0_wp |
---|
9911 | |
---|
9912 | ELSE |
---|
9913 | |
---|
9914 | SELECT CASE ( TRIM( variable(7:) ) ) |
---|
9915 | |
---|
9916 | CASE ( 'g_H2SO4' ) |
---|
9917 | IF ( .NOT. ALLOCATED( g_h2so4_av ) ) THEN |
---|
9918 | ALLOCATE( g_h2so4_av(nzb:nzt+1,nysg:nyng,nxlg:nxrg) ) |
---|
9919 | ENDIF |
---|
9920 | g_h2so4_av = 0.0_wp |
---|
9921 | |
---|
9922 | CASE ( 'g_HNO3' ) |
---|
9923 | IF ( .NOT. ALLOCATED( g_hno3_av ) ) THEN |
---|
9924 | ALLOCATE( g_hno3_av(nzb:nzt+1,nysg:nyng,nxlg:nxrg) ) |
---|
9925 | ENDIF |
---|
9926 | g_hno3_av = 0.0_wp |
---|
9927 | |
---|
9928 | CASE ( 'g_NH3' ) |
---|
9929 | IF ( .NOT. ALLOCATED( g_nh3_av ) ) THEN |
---|
9930 | ALLOCATE( g_nh3_av(nzb:nzt+1,nysg:nyng,nxlg:nxrg) ) |
---|
9931 | ENDIF |
---|
9932 | g_nh3_av = 0.0_wp |
---|
9933 | |
---|
9934 | CASE ( 'g_OCNV' ) |
---|
9935 | IF ( .NOT. ALLOCATED( g_ocnv_av ) ) THEN |
---|
9936 | ALLOCATE( g_ocnv_av(nzb:nzt+1,nysg:nyng,nxlg:nxrg) ) |
---|
9937 | ENDIF |
---|
9938 | g_ocnv_av = 0.0_wp |
---|
9939 | |
---|
9940 | CASE ( 'g_OCSV' ) |
---|
9941 | IF ( .NOT. ALLOCATED( g_ocsv_av ) ) THEN |
---|
9942 | ALLOCATE( g_ocsv_av(nzb:nzt+1,nysg:nyng,nxlg:nxrg) ) |
---|
9943 | ENDIF |
---|
9944 | g_ocsv_av = 0.0_wp |
---|
9945 | |
---|
9946 | CASE ( 'LDSA' ) |
---|
9947 | IF ( .NOT. ALLOCATED( ldsa_av ) ) THEN |
---|
9948 | ALLOCATE( ldsa_av(nzb:nzt+1,nysg:nyng,nxlg:nxrg) ) |
---|
9949 | ENDIF |
---|
9950 | ldsa_av = 0.0_wp |
---|
9951 | |
---|
9952 | CASE ( 'N_UFP' ) |
---|
9953 | IF ( .NOT. ALLOCATED( nufp_av ) ) THEN |
---|
9954 | ALLOCATE( nufp_av(nzb:nzt+1,nysg:nyng,nxlg:nxrg) ) |
---|
9955 | ENDIF |
---|
9956 | nufp_av = 0.0_wp |
---|
9957 | |
---|
9958 | CASE ( 'Ntot' ) |
---|
9959 | IF ( .NOT. ALLOCATED( ntot_av ) ) THEN |
---|
9960 | ALLOCATE( ntot_av(nzb:nzt+1,nysg:nyng,nxlg:nxrg) ) |
---|
9961 | ENDIF |
---|
9962 | ntot_av = 0.0_wp |
---|
9963 | |
---|
9964 | CASE ( 'PM0.1' ) |
---|
9965 | IF ( .NOT. ALLOCATED( pm01_av ) ) THEN |
---|
9966 | ALLOCATE( pm01_av(nzb:nzt+1,nysg:nyng,nxlg:nxrg) ) |
---|
9967 | ENDIF |
---|
9968 | pm01_av = 0.0_wp |
---|
9969 | |
---|
9970 | CASE ( 'PM2.5' ) |
---|
9971 | IF ( .NOT. ALLOCATED( pm25_av ) ) THEN |
---|
9972 | ALLOCATE( pm25_av(nzb:nzt+1,nysg:nyng,nxlg:nxrg) ) |
---|
9973 | ENDIF |
---|
9974 | pm25_av = 0.0_wp |
---|
9975 | |
---|
9976 | CASE ( 'PM10' ) |
---|
9977 | IF ( .NOT. ALLOCATED( pm10_av ) ) THEN |
---|
9978 | ALLOCATE( pm10_av(nzb:nzt+1,nysg:nyng,nxlg:nxrg) ) |
---|
9979 | ENDIF |
---|
9980 | pm10_av = 0.0_wp |
---|
9981 | |
---|
9982 | CASE ( 's_BC' ) |
---|
9983 | IF ( .NOT. ALLOCATED( s_bc_av ) ) THEN |
---|
9984 | ALLOCATE( s_bc_av(nzb:nzt+1,nysg:nyng,nxlg:nxrg) ) |
---|
9985 | ENDIF |
---|
9986 | s_bc_av = 0.0_wp |
---|
9987 | |
---|
9988 | CASE ( 's_DU' ) |
---|
9989 | IF ( .NOT. ALLOCATED( s_du_av ) ) THEN |
---|
9990 | ALLOCATE( s_du_av(nzb:nzt+1,nysg:nyng,nxlg:nxrg) ) |
---|
9991 | ENDIF |
---|
9992 | s_du_av = 0.0_wp |
---|
9993 | |
---|
9994 | CASE ( 's_H2O' ) |
---|
9995 | IF ( .NOT. ALLOCATED( s_h2o_av ) ) THEN |
---|
9996 | ALLOCATE( s_h2o_av(nzb:nzt+1,nysg:nyng,nxlg:nxrg) ) |
---|
9997 | ENDIF |
---|
9998 | s_h2o_av = 0.0_wp |
---|
9999 | |
---|
10000 | CASE ( 's_NH' ) |
---|
10001 | IF ( .NOT. ALLOCATED( s_nh_av ) ) THEN |
---|
10002 | ALLOCATE( s_nh_av(nzb:nzt+1,nysg:nyng,nxlg:nxrg) ) |
---|
10003 | ENDIF |
---|
10004 | s_nh_av = 0.0_wp |
---|
10005 | |
---|
10006 | CASE ( 's_NO' ) |
---|
10007 | IF ( .NOT. ALLOCATED( s_no_av ) ) THEN |
---|
10008 | ALLOCATE( s_no_av(nzb:nzt+1,nysg:nyng,nxlg:nxrg) ) |
---|
10009 | ENDIF |
---|
10010 | s_no_av = 0.0_wp |
---|
10011 | |
---|
10012 | CASE ( 's_OC' ) |
---|
10013 | IF ( .NOT. ALLOCATED( s_oc_av ) ) THEN |
---|
10014 | ALLOCATE( s_oc_av(nzb:nzt+1,nysg:nyng,nxlg:nxrg) ) |
---|
10015 | ENDIF |
---|
10016 | s_oc_av = 0.0_wp |
---|
10017 | |
---|
10018 | CASE ( 's_SO4' ) |
---|
10019 | IF ( .NOT. ALLOCATED( s_so4_av ) ) THEN |
---|
10020 | ALLOCATE( s_so4_av(nzb:nzt+1,nysg:nyng,nxlg:nxrg) ) |
---|
10021 | ENDIF |
---|
10022 | s_so4_av = 0.0_wp |
---|
10023 | |
---|
10024 | CASE ( 's_SS' ) |
---|
10025 | IF ( .NOT. ALLOCATED( s_ss_av ) ) THEN |
---|
10026 | ALLOCATE( s_ss_av(nzb:nzt+1,nysg:nyng,nxlg:nxrg) ) |
---|
10027 | ENDIF |
---|
10028 | s_ss_av = 0.0_wp |
---|
10029 | |
---|
10030 | CASE DEFAULT |
---|
10031 | CONTINUE |
---|
10032 | |
---|
10033 | END SELECT |
---|
10034 | |
---|
10035 | ENDIF |
---|
10036 | |
---|
10037 | ELSEIF ( mode == 'sum' ) THEN |
---|
10038 | |
---|
10039 | IF ( variable(7:11) == 'N_bin' ) THEN |
---|
10040 | READ( variable(12:),* ) char_to_int |
---|
10041 | IF ( char_to_int >= 1 .AND. char_to_int <= SUM( nbin ) ) THEN |
---|
10042 | ib = char_to_int |
---|
10043 | DO i = nxlg, nxrg |
---|
10044 | DO j = nysg, nyng |
---|
10045 | DO k = nzb, nzt+1 |
---|
10046 | nbins_av(k,j,i,ib) = nbins_av(k,j,i,ib) + aerosol_number(ib)%conc(k,j,i) |
---|
10047 | ENDDO |
---|
10048 | ENDDO |
---|
10049 | ENDDO |
---|
10050 | ENDIF |
---|
10051 | |
---|
10052 | ELSEIF ( variable(7:11) == 'm_bin' ) THEN |
---|
10053 | READ( variable(12:),* ) char_to_int |
---|
10054 | IF ( char_to_int >= 1 .AND. char_to_int <= SUM( nbin ) ) THEN |
---|
10055 | ib = char_to_int |
---|
10056 | DO i = nxlg, nxrg |
---|
10057 | DO j = nysg, nyng |
---|
10058 | DO k = nzb, nzt+1 |
---|
10059 | temp_bin = 0.0_wp |
---|
10060 | DO ic = ib, nbins_aerosol * ncomponents_mass, nbins_aerosol |
---|
10061 | temp_bin = temp_bin + aerosol_mass(ic)%conc(k,j,i) |
---|
10062 | ENDDO |
---|
10063 | mbins_av(k,j,i,ib) = mbins_av(k,j,i,ib) + temp_bin |
---|
10064 | ENDDO |
---|
10065 | ENDDO |
---|
10066 | ENDDO |
---|
10067 | ENDIF |
---|
10068 | ELSE |
---|
10069 | |
---|
10070 | SELECT CASE ( TRIM( variable(7:) ) ) |
---|
10071 | |
---|
10072 | CASE ( 'g_H2SO4', 'g_HNO3', 'g_NH3', 'g_OCNV', 'g_OCSV' ) |
---|
10073 | |
---|
10074 | vari = TRIM( variable(9:) ) ! remove salsa_g_ from beginning |
---|
10075 | |
---|
10076 | SELECT CASE( vari ) |
---|
10077 | |
---|
10078 | CASE( 'H2SO4' ) |
---|
10079 | found_index = 1 |
---|
10080 | to_be_resorted => g_h2so4_av |
---|
10081 | |
---|
10082 | CASE( 'HNO3' ) |
---|
10083 | found_index = 2 |
---|
10084 | to_be_resorted => g_hno3_av |
---|
10085 | |
---|
10086 | CASE( 'NH3' ) |
---|
10087 | found_index = 3 |
---|
10088 | to_be_resorted => g_nh3_av |
---|
10089 | |
---|
10090 | CASE( 'OCNV' ) |
---|
10091 | found_index = 4 |
---|
10092 | to_be_resorted => g_ocnv_av |
---|
10093 | |
---|
10094 | CASE( 'OCSV' ) |
---|
10095 | found_index = 5 |
---|
10096 | to_be_resorted => g_ocsv_av |
---|
10097 | |
---|
10098 | END SELECT |
---|
10099 | |
---|
10100 | DO i = nxlg, nxrg |
---|
10101 | DO j = nysg, nyng |
---|
10102 | DO k = nzb, nzt+1 |
---|
10103 | to_be_resorted(k,j,i) = to_be_resorted(k,j,i) + & |
---|
10104 | salsa_gas(found_index)%conc(k,j,i) |
---|
10105 | ENDDO |
---|
10106 | ENDDO |
---|
10107 | ENDDO |
---|
10108 | |
---|
10109 | CASE ( 'LDSA' ) |
---|
10110 | DO i = nxlg, nxrg |
---|
10111 | DO j = nysg, nyng |
---|
10112 | DO k = nzb, nzt+1 |
---|
10113 | temp_bin = 0.0_wp |
---|
10114 | DO ib = 1, nbins_aerosol |
---|
10115 | ! |
---|
10116 | !-- Diameter in micrometres |
---|
10117 | mean_d = 1.0E+6_wp * ra_dry(k,j,i,ib) * 2.0_wp |
---|
10118 | ! |
---|
10119 | !-- Deposition factor: alveolar (use ra_dry) |
---|
10120 | df = ( 0.01555_wp / mean_d ) * ( EXP( -0.416_wp * ( LOG( mean_d ) + & |
---|
10121 | 2.84_wp )**2 ) + 19.11_wp * EXP( -0.482_wp * ( LOG( mean_d ) - & |
---|
10122 | 1.362_wp )**2 ) ) |
---|
10123 | ! |
---|
10124 | !-- Lung-deposited surface area LDSA (units mum2/cm3) |
---|
10125 | temp_bin = temp_bin + pi * mean_d**2 * df * 1.0E-6_wp * & |
---|
10126 | aerosol_number(ib)%conc(k,j,i) |
---|
10127 | ENDDO |
---|
10128 | ldsa_av(k,j,i) = ldsa_av(k,j,i) + temp_bin |
---|
10129 | ENDDO |
---|
10130 | ENDDO |
---|
10131 | ENDDO |
---|
10132 | |
---|
10133 | CASE ( 'N_UFP' ) |
---|
10134 | DO i = nxlg, nxrg |
---|
10135 | DO j = nysg, nyng |
---|
10136 | DO k = nzb, nzt+1 |
---|
10137 | temp_bin = 0.0_wp |
---|
10138 | DO ib = 1, nbins_aerosol |
---|
10139 | IF ( 2.0_wp * ra_dry(k,j,i,ib) <= 0.1E-6_wp ) THEN |
---|
10140 | temp_bin = temp_bin + aerosol_number(ib)%conc(k,j,i) |
---|
10141 | ENDIF |
---|
10142 | ENDDO |
---|
10143 | nufp_av(k,j,i) = nufp_av(k,j,i) + temp_bin |
---|
10144 | ENDDO |
---|
10145 | ENDDO |
---|
10146 | ENDDO |
---|
10147 | |
---|
10148 | CASE ( 'Ntot' ) |
---|
10149 | DO i = nxlg, nxrg |
---|
10150 | DO j = nysg, nyng |
---|
10151 | DO k = nzb, nzt+1 |
---|
10152 | DO ib = 1, nbins_aerosol |
---|
10153 | ntot_av(k,j,i) = ntot_av(k,j,i) + aerosol_number(ib)%conc(k,j,i) |
---|
10154 | ENDDO |
---|
10155 | ENDDO |
---|
10156 | ENDDO |
---|
10157 | ENDDO |
---|
10158 | |
---|
10159 | CASE ( 'PM0.1' ) |
---|
10160 | DO i = nxlg, nxrg |
---|
10161 | DO j = nysg, nyng |
---|
10162 | DO k = nzb, nzt+1 |
---|
10163 | temp_bin = 0.0_wp |
---|
10164 | DO ib = 1, nbins_aerosol |
---|
10165 | IF ( 2.0_wp * ra_dry(k,j,i,ib) <= 0.1E-6_wp ) THEN |
---|
10166 | DO ic = ib, nbins_aerosol * ncc, nbins_aerosol |
---|
10167 | temp_bin = temp_bin + aerosol_mass(ic)%conc(k,j,i) |
---|
10168 | ENDDO |
---|
10169 | ENDIF |
---|
10170 | ENDDO |
---|
10171 | pm01_av(k,j,i) = pm01_av(k,j,i) + temp_bin |
---|
10172 | ENDDO |
---|
10173 | ENDDO |
---|
10174 | ENDDO |
---|
10175 | |
---|
10176 | CASE ( 'PM2.5' ) |
---|
10177 | DO i = nxlg, nxrg |
---|
10178 | DO j = nysg, nyng |
---|
10179 | DO k = nzb, nzt+1 |
---|
10180 | temp_bin = 0.0_wp |
---|
10181 | DO ib = 1, nbins_aerosol |
---|
10182 | IF ( 2.0_wp * ra_dry(k,j,i,ib) <= 2.5E-6_wp ) THEN |
---|
10183 | DO ic = ib, nbins_aerosol * ncc, nbins_aerosol |
---|
10184 | temp_bin = temp_bin + aerosol_mass(ic)%conc(k,j,i) |
---|
10185 | ENDDO |
---|
10186 | ENDIF |
---|
10187 | ENDDO |
---|
10188 | pm25_av(k,j,i) = pm25_av(k,j,i) + temp_bin |
---|
10189 | ENDDO |
---|
10190 | ENDDO |
---|
10191 | ENDDO |
---|
10192 | |
---|
10193 | CASE ( 'PM10' ) |
---|
10194 | DO i = nxlg, nxrg |
---|
10195 | DO j = nysg, nyng |
---|
10196 | DO k = nzb, nzt+1 |
---|
10197 | temp_bin = 0.0_wp |
---|
10198 | DO ib = 1, nbins_aerosol |
---|
10199 | IF ( 2.0_wp * ra_dry(k,j,i,ib) <= 10.0E-6_wp ) THEN |
---|
10200 | DO ic = ib, nbins_aerosol * ncc, nbins_aerosol |
---|
10201 | temp_bin = temp_bin + aerosol_mass(ic)%conc(k,j,i) |
---|
10202 | ENDDO |
---|
10203 | ENDIF |
---|
10204 | ENDDO |
---|
10205 | pm10_av(k,j,i) = pm10_av(k,j,i) + temp_bin |
---|
10206 | ENDDO |
---|
10207 | ENDDO |
---|
10208 | ENDDO |
---|
10209 | |
---|
10210 | CASE ( 's_BC', 's_DU', 's_NH', 's_NO', 's_OC', 's_SO4', 's_SS' ) |
---|
10211 | IF ( is_used( prtcl, TRIM( variable(9:) ) ) ) THEN ! 9: remove salsa_s_ |
---|
10212 | found_index = get_index( prtcl, TRIM( variable(9:) ) ) |
---|
10213 | IF ( TRIM( variable(9:) ) == 'BC' ) to_be_resorted => s_bc_av |
---|
10214 | IF ( TRIM( variable(9:) ) == 'DU' ) to_be_resorted => s_du_av |
---|
10215 | IF ( TRIM( variable(9:) ) == 'NH' ) to_be_resorted => s_nh_av |
---|
10216 | IF ( TRIM( variable(9:) ) == 'NO' ) to_be_resorted => s_no_av |
---|
10217 | IF ( TRIM( variable(9:) ) == 'OC' ) to_be_resorted => s_oc_av |
---|
10218 | IF ( TRIM( variable(9:) ) == 'SO4' ) to_be_resorted => s_so4_av |
---|
10219 | IF ( TRIM( variable(9:) ) == 'SS' ) to_be_resorted => s_ss_av |
---|
10220 | DO i = nxlg, nxrg |
---|
10221 | DO j = nysg, nyng |
---|
10222 | DO k = nzb, nzt+1 |
---|
10223 | DO ic = ( found_index-1 ) * nbins_aerosol + 1, found_index * nbins_aerosol |
---|
10224 | to_be_resorted(k,j,i) = to_be_resorted(k,j,i) + & |
---|
10225 | aerosol_mass(ic)%conc(k,j,i) |
---|
10226 | ENDDO |
---|
10227 | ENDDO |
---|
10228 | ENDDO |
---|
10229 | ENDDO |
---|
10230 | ENDIF |
---|
10231 | |
---|
10232 | CASE ( 's_H2O' ) |
---|
10233 | found_index = get_index( prtcl,'H2O' ) |
---|
10234 | to_be_resorted => s_h2o_av |
---|
10235 | DO i = nxlg, nxrg |
---|
10236 | DO j = nysg, nyng |
---|
10237 | DO k = nzb, nzt+1 |
---|
10238 | DO ic = ( found_index-1 ) * nbins_aerosol + 1, found_index * nbins_aerosol |
---|
10239 | s_h2o_av(k,j,i) = s_h2o_av(k,j,i) + aerosol_mass(ic)%conc(k,j,i) |
---|
10240 | ENDDO |
---|
10241 | ENDDO |
---|
10242 | ENDDO |
---|
10243 | ENDDO |
---|
10244 | |
---|
10245 | CASE DEFAULT |
---|
10246 | CONTINUE |
---|
10247 | |
---|
10248 | END SELECT |
---|
10249 | |
---|
10250 | ENDIF |
---|
10251 | |
---|
10252 | ELSEIF ( mode == 'average' ) THEN |
---|
10253 | |
---|
10254 | IF ( variable(7:11) == 'N_bin' ) THEN |
---|
10255 | READ( variable(12:),* ) char_to_int |
---|
10256 | IF ( char_to_int >= 1 .AND. char_to_int <= SUM( nbin ) ) THEN |
---|
10257 | ib = char_to_int |
---|
10258 | DO i = nxlg, nxrg |
---|
10259 | DO j = nysg, nyng |
---|
10260 | DO k = nzb, nzt+1 |
---|
10261 | nbins_av(k,j,i,ib) = nbins_av(k,j,i,ib) / REAL( average_count_3d, KIND=wp ) |
---|
10262 | ENDDO |
---|
10263 | ENDDO |
---|
10264 | ENDDO |
---|
10265 | ENDIF |
---|
10266 | |
---|
10267 | ELSEIF ( variable(7:11) == 'm_bin' ) THEN |
---|
10268 | READ( variable(12:),* ) char_to_int |
---|
10269 | IF ( char_to_int >= 1 .AND. char_to_int <= SUM( nbin ) ) THEN |
---|
10270 | ib = char_to_int |
---|
10271 | DO i = nxlg, nxrg |
---|
10272 | DO j = nysg, nyng |
---|
10273 | DO k = nzb, nzt+1 |
---|
10274 | mbins_av(k,j,i,ib) = mbins_av(k,j,i,ib) / REAL( average_count_3d, KIND=wp) |
---|
10275 | ENDDO |
---|
10276 | ENDDO |
---|
10277 | ENDDO |
---|
10278 | ENDIF |
---|
10279 | ELSE |
---|
10280 | |
---|
10281 | SELECT CASE ( TRIM( variable(7:) ) ) |
---|
10282 | |
---|
10283 | CASE ( 'g_H2SO4', 'g_HNO3', 'g_NH3', 'g_OCNV', 'g_OCSV' ) |
---|
10284 | IF ( TRIM( variable(9:) ) == 'H2SO4' ) THEN ! 9: remove salsa_g_ from beginning |
---|
10285 | found_index = 1 |
---|
10286 | to_be_resorted => g_h2so4_av |
---|
10287 | ELSEIF ( TRIM( variable(9:) ) == 'HNO3' ) THEN |
---|
10288 | found_index = 2 |
---|
10289 | to_be_resorted => g_hno3_av |
---|
10290 | ELSEIF ( TRIM( variable(9:) ) == 'NH3' ) THEN |
---|
10291 | found_index = 3 |
---|
10292 | to_be_resorted => g_nh3_av |
---|
10293 | ELSEIF ( TRIM( variable(9:) ) == 'OCNV' ) THEN |
---|
10294 | found_index = 4 |
---|
10295 | to_be_resorted => g_ocnv_av |
---|
10296 | ELSEIF ( TRIM( variable(9:) ) == 'OCSV' ) THEN |
---|
10297 | found_index = 5 |
---|
10298 | to_be_resorted => g_ocsv_av |
---|
10299 | ENDIF |
---|
10300 | DO i = nxlg, nxrg |
---|
10301 | DO j = nysg, nyng |
---|
10302 | DO k = nzb, nzt+1 |
---|
10303 | to_be_resorted(k,j,i) = to_be_resorted(k,j,i) / & |
---|
10304 | REAL( average_count_3d, KIND=wp ) |
---|
10305 | ENDDO |
---|
10306 | ENDDO |
---|
10307 | ENDDO |
---|
10308 | |
---|
10309 | CASE ( 'LDSA' ) |
---|
10310 | DO i = nxlg, nxrg |
---|
10311 | DO j = nysg, nyng |
---|
10312 | DO k = nzb, nzt+1 |
---|
10313 | ldsa_av(k,j,i) = ldsa_av(k,j,i) / REAL( average_count_3d, KIND=wp ) |
---|
10314 | ENDDO |
---|
10315 | ENDDO |
---|
10316 | ENDDO |
---|
10317 | |
---|
10318 | CASE ( 'N_UFP' ) |
---|
10319 | DO i = nxlg, nxrg |
---|
10320 | DO j = nysg, nyng |
---|
10321 | DO k = nzb, nzt+1 |
---|
10322 | nufp_av(k,j,i) = nufp_av(k,j,i) / REAL( average_count_3d, KIND=wp ) |
---|
10323 | ENDDO |
---|
10324 | ENDDO |
---|
10325 | ENDDO |
---|
10326 | |
---|
10327 | CASE ( 'Ntot' ) |
---|
10328 | DO i = nxlg, nxrg |
---|
10329 | DO j = nysg, nyng |
---|
10330 | DO k = nzb, nzt+1 |
---|
10331 | ntot_av(k,j,i) = ntot_av(k,j,i) / REAL( average_count_3d, KIND=wp ) |
---|
10332 | ENDDO |
---|
10333 | ENDDO |
---|
10334 | ENDDO |
---|
10335 | |
---|
10336 | |
---|
10337 | CASE ( 'PM0.1' ) |
---|
10338 | DO i = nxlg, nxrg |
---|
10339 | DO j = nysg, nyng |
---|
10340 | DO k = nzb, nzt+1 |
---|
10341 | pm01_av(k,j,i) = pm01_av(k,j,i) / REAL( average_count_3d, KIND=wp ) |
---|
10342 | ENDDO |
---|
10343 | ENDDO |
---|
10344 | ENDDO |
---|
10345 | |
---|
10346 | CASE ( 'PM2.5' ) |
---|
10347 | DO i = nxlg, nxrg |
---|
10348 | DO j = nysg, nyng |
---|
10349 | DO k = nzb, nzt+1 |
---|
10350 | pm25_av(k,j,i) = pm25_av(k,j,i) / REAL( average_count_3d, KIND=wp ) |
---|
10351 | ENDDO |
---|
10352 | ENDDO |
---|
10353 | ENDDO |
---|
10354 | |
---|
10355 | CASE ( 'PM10' ) |
---|
10356 | DO i = nxlg, nxrg |
---|
10357 | DO j = nysg, nyng |
---|
10358 | DO k = nzb, nzt+1 |
---|
10359 | pm10_av(k,j,i) = pm10_av(k,j,i) / REAL( average_count_3d, KIND=wp ) |
---|
10360 | ENDDO |
---|
10361 | ENDDO |
---|
10362 | ENDDO |
---|
10363 | |
---|
10364 | CASE ( 's_BC', 's_DU', 's_NH', 's_NO', 's_OC', 's_SO4', 's_SS' ) |
---|
10365 | IF ( is_used( prtcl, TRIM( variable(9:) ) ) ) THEN ! 9: remove salsa_s_ |
---|
10366 | IF ( TRIM( variable(9:) ) == 'BC' ) to_be_resorted => s_bc_av |
---|
10367 | IF ( TRIM( variable(9:) ) == 'DU' ) to_be_resorted => s_du_av |
---|
10368 | IF ( TRIM( variable(9:) ) == 'NH' ) to_be_resorted => s_nh_av |
---|
10369 | IF ( TRIM( variable(9:) ) == 'NO' ) to_be_resorted => s_no_av |
---|
10370 | IF ( TRIM( variable(9:) ) == 'OC' ) to_be_resorted => s_oc_av |
---|
10371 | IF ( TRIM( variable(9:) ) == 'SO4' ) to_be_resorted => s_so4_av |
---|
10372 | IF ( TRIM( variable(9:) ) == 'SS' ) to_be_resorted => s_ss_av |
---|
10373 | DO i = nxlg, nxrg |
---|
10374 | DO j = nysg, nyng |
---|
10375 | DO k = nzb, nzt+1 |
---|
10376 | to_be_resorted(k,j,i) = to_be_resorted(k,j,i) / & |
---|
10377 | REAL( average_count_3d, KIND=wp ) |
---|
10378 | ENDDO |
---|
10379 | ENDDO |
---|
10380 | ENDDO |
---|
10381 | ENDIF |
---|
10382 | |
---|
10383 | CASE ( 's_H2O' ) |
---|
10384 | to_be_resorted => s_h2o_av |
---|
10385 | DO i = nxlg, nxrg |
---|
10386 | DO j = nysg, nyng |
---|
10387 | DO k = nzb, nzt+1 |
---|
10388 | to_be_resorted(k,j,i) = to_be_resorted(k,j,i) / & |
---|
10389 | REAL( average_count_3d, KIND=wp ) |
---|
10390 | ENDDO |
---|
10391 | ENDDO |
---|
10392 | ENDDO |
---|
10393 | |
---|
10394 | END SELECT |
---|
10395 | |
---|
10396 | ENDIF |
---|
10397 | ENDIF |
---|
10398 | |
---|
10399 | END SUBROUTINE salsa_3d_data_averaging |
---|
10400 | |
---|
10401 | |
---|
10402 | !------------------------------------------------------------------------------! |
---|
10403 | ! |
---|
10404 | ! Description: |
---|
10405 | ! ------------ |
---|
10406 | !> Subroutine defining 2D output variables |
---|
10407 | !------------------------------------------------------------------------------! |
---|
10408 | SUBROUTINE salsa_data_output_2d( av, variable, found, grid, mode, local_pf, two_d, nzb_do, nzt_do ) |
---|
10409 | |
---|
10410 | USE indices |
---|
10411 | |
---|
10412 | USE kinds |
---|
10413 | |
---|
10414 | |
---|
10415 | IMPLICIT NONE |
---|
10416 | |
---|
10417 | CHARACTER(LEN=*) :: grid !< |
---|
10418 | CHARACTER(LEN=*) :: mode !< |
---|
10419 | CHARACTER(LEN=*) :: variable !< |
---|
10420 | CHARACTER(LEN=5) :: vari !< trimmed format of variable |
---|
10421 | |
---|
10422 | INTEGER(iwp) :: av !< |
---|
10423 | INTEGER(iwp) :: char_to_int !< for converting character to integer |
---|
10424 | INTEGER(iwp) :: found_index !< index of a chemical compound |
---|
10425 | INTEGER(iwp) :: i !< |
---|
10426 | INTEGER(iwp) :: ib !< running index: size bins |
---|
10427 | INTEGER(iwp) :: ic !< running index: mass bins |
---|
10428 | INTEGER(iwp) :: j !< |
---|
10429 | INTEGER(iwp) :: k !< |
---|
10430 | INTEGER(iwp) :: nzb_do !< |
---|
10431 | INTEGER(iwp) :: nzt_do !< |
---|
10432 | |
---|
10433 | LOGICAL :: found !< |
---|
10434 | LOGICAL :: two_d !< flag parameter to indicate 2D variables (horizontal cross sections) |
---|
10435 | |
---|
10436 | REAL(wp) :: df !< For calculating LDSA: fraction of particles |
---|
10437 | !< depositing in the alveolar (or tracheobronchial) |
---|
10438 | !< region of the lung. Depends on the particle size |
---|
10439 | REAL(wp) :: mean_d !< Particle diameter in micrometres |
---|
10440 | REAL(wp) :: temp_bin !< temporary array for calculating output variables |
---|
10441 | |
---|
10442 | REAL(wp), DIMENSION(nxl:nxr,nys:nyn,nzb_do:nzt_do) :: local_pf !< output |
---|
10443 | |
---|
10444 | REAL(wp), DIMENSION(:,:,:), POINTER :: to_be_resorted !< pointer |
---|
10445 | ! |
---|
10446 | !-- Next statement is to avoid compiler warning about unused variable. May be removed in future. |
---|
10447 | IF ( two_d ) CONTINUE |
---|
10448 | |
---|
10449 | found = .TRUE. |
---|
10450 | temp_bin = 0.0_wp |
---|
10451 | |
---|
10452 | IF ( variable(7:11) == 'N_bin' ) THEN |
---|
10453 | |
---|
10454 | READ( variable( 12:LEN( TRIM( variable ) ) - 3 ), * ) char_to_int |
---|
10455 | IF ( char_to_int >= 1 .AND. char_to_int <= SUM( nbin ) ) THEN |
---|
10456 | |
---|
10457 | ib = char_to_int |
---|
10458 | IF ( av == 0 ) THEN |
---|
10459 | DO i = nxl, nxr |
---|
10460 | DO j = nys, nyn |
---|
10461 | DO k = nzb_do, nzt_do |
---|
10462 | local_pf(i,j,k) = MERGE( aerosol_number(ib)%conc(k,j,i), REAL( fill_value, & |
---|
10463 | KIND = wp ), BTEST( wall_flags_0(k,j,i), 0 ) ) |
---|
10464 | ENDDO |
---|
10465 | ENDDO |
---|
10466 | ENDDO |
---|
10467 | ELSE |
---|
10468 | DO i = nxl, nxr |
---|
10469 | DO j = nys, nyn |
---|
10470 | DO k = nzb_do, nzt_do |
---|
10471 | local_pf(i,j,k) = MERGE( nbins_av(k,j,i,ib), REAL( fill_value, KIND = wp ), & |
---|
10472 | BTEST( wall_flags_0(k,j,i), 0 ) ) |
---|
10473 | ENDDO |
---|
10474 | ENDDO |
---|
10475 | ENDDO |
---|
10476 | ENDIF |
---|
10477 | IF ( mode == 'xy' ) grid = 'zu' |
---|
10478 | ENDIF |
---|
10479 | |
---|
10480 | ELSEIF ( variable(7:11) == 'm_bin' ) THEN |
---|
10481 | |
---|
10482 | READ( variable( 12:LEN( TRIM( variable ) ) - 3 ), * ) char_to_int |
---|
10483 | IF ( char_to_int >= 1 .AND. char_to_int <= SUM( nbin ) ) THEN |
---|
10484 | |
---|
10485 | ib = char_to_int |
---|
10486 | IF ( av == 0 ) THEN |
---|
10487 | DO i = nxl, nxr |
---|
10488 | DO j = nys, nyn |
---|
10489 | DO k = nzb_do, nzt_do |
---|
10490 | temp_bin = 0.0_wp |
---|
10491 | DO ic = ib, ncomponents_mass * nbins_aerosol, nbins_aerosol |
---|
10492 | temp_bin = temp_bin + aerosol_mass(ic)%conc(k,j,i) |
---|
10493 | ENDDO |
---|
10494 | local_pf(i,j,k) = MERGE( temp_bin, REAL( fill_value, KIND = wp ), & |
---|
10495 | BTEST( wall_flags_0(k,j,i), 0 ) ) |
---|
10496 | ENDDO |
---|
10497 | ENDDO |
---|
10498 | ENDDO |
---|
10499 | ELSE |
---|
10500 | DO i = nxl, nxr |
---|
10501 | DO j = nys, nyn |
---|
10502 | DO k = nzb_do, nzt_do |
---|
10503 | local_pf(i,j,k) = MERGE( mbins_av(k,j,i,ib), REAL( fill_value, KIND = wp ), & |
---|
10504 | BTEST( wall_flags_0(k,j,i), 0 ) ) |
---|
10505 | ENDDO |
---|
10506 | ENDDO |
---|
10507 | ENDDO |
---|
10508 | ENDIF |
---|
10509 | IF ( mode == 'xy' ) grid = 'zu' |
---|
10510 | ENDIF |
---|
10511 | |
---|
10512 | ELSE |
---|
10513 | |
---|
10514 | SELECT CASE ( TRIM( variable( 7:LEN( TRIM( variable ) ) - 3 ) ) ) ! cut out _xy, _xz or _yz |
---|
10515 | |
---|
10516 | CASE ( 'g_H2SO4', 'g_HNO3', 'g_NH3', 'g_OCNV', 'g_OCSV' ) |
---|
10517 | vari = TRIM( variable( 9:LEN( TRIM( variable ) ) - 3 ) ) ! 9: remove salsa_g_ |
---|
10518 | IF ( av == 0 ) THEN |
---|
10519 | IF ( vari == 'H2SO4') found_index = 1 |
---|
10520 | IF ( vari == 'HNO3') found_index = 2 |
---|
10521 | IF ( vari == 'NH3') found_index = 3 |
---|
10522 | IF ( vari == 'OCNV') found_index = 4 |
---|
10523 | IF ( vari == 'OCSV') found_index = 5 |
---|
10524 | DO i = nxl, nxr |
---|
10525 | DO j = nys, nyn |
---|
10526 | DO k = nzb_do, nzt_do |
---|
10527 | local_pf(i,j,k) = MERGE( salsa_gas(found_index)%conc(k,j,i), & |
---|
10528 | REAL( fill_value, KIND = wp ), & |
---|
10529 | BTEST( wall_flags_0(k,j,i), 0 ) ) |
---|
10530 | ENDDO |
---|
10531 | ENDDO |
---|
10532 | ENDDO |
---|
10533 | ELSE |
---|
10534 | IF ( vari == 'H2SO4' ) to_be_resorted => g_h2so4_av |
---|
10535 | IF ( vari == 'HNO3' ) to_be_resorted => g_hno3_av |
---|
10536 | IF ( vari == 'NH3' ) to_be_resorted => g_nh3_av |
---|
10537 | IF ( vari == 'OCNV' ) to_be_resorted => g_ocnv_av |
---|
10538 | IF ( vari == 'OCSV' ) to_be_resorted => g_ocsv_av |
---|
10539 | DO i = nxl, nxr |
---|
10540 | DO j = nys, nyn |
---|
10541 | DO k = nzb_do, nzt_do |
---|
10542 | local_pf(i,j,k) = MERGE( to_be_resorted(k,j,i), REAL( fill_value, & |
---|
10543 | KIND = wp ), BTEST( wall_flags_0(k,j,i), 0 ) ) |
---|
10544 | ENDDO |
---|
10545 | ENDDO |
---|
10546 | ENDDO |
---|
10547 | ENDIF |
---|
10548 | |
---|
10549 | IF ( mode == 'xy' ) grid = 'zu' |
---|
10550 | |
---|
10551 | CASE ( 'LDSA' ) |
---|
10552 | IF ( av == 0 ) THEN |
---|
10553 | DO i = nxl, nxr |
---|
10554 | DO j = nys, nyn |
---|
10555 | DO k = nzb_do, nzt_do |
---|
10556 | temp_bin = 0.0_wp |
---|
10557 | DO ib = 1, nbins_aerosol |
---|
10558 | ! |
---|
10559 | !-- Diameter in micrometres |
---|
10560 | mean_d = 1.0E+6_wp * ra_dry(k,j,i,ib) * 2.0_wp |
---|
10561 | ! |
---|
10562 | !-- Deposition factor: alveolar |
---|
10563 | df = ( 0.01555_wp / mean_d ) * ( EXP( -0.416_wp * ( LOG( mean_d ) + & |
---|
10564 | 2.84_wp )**2 ) + 19.11_wp * EXP( -0.482_wp * ( LOG( mean_d ) - & |
---|
10565 | 1.362_wp )**2 ) ) |
---|
10566 | ! |
---|
10567 | !-- Lung-deposited surface area LDSA (units mum2/cm3) |
---|
10568 | temp_bin = temp_bin + pi * mean_d**2 * df * 1.0E-6_wp * & |
---|
10569 | aerosol_number(ib)%conc(k,j,i) |
---|
10570 | ENDDO |
---|
10571 | |
---|
10572 | local_pf(i,j,k) = MERGE( temp_bin, REAL( fill_value, KIND = wp ), & |
---|
10573 | BTEST( wall_flags_0(k,j,i), 0 ) ) |
---|
10574 | ENDDO |
---|
10575 | ENDDO |
---|
10576 | ENDDO |
---|
10577 | ELSE |
---|
10578 | DO i = nxl, nxr |
---|
10579 | DO j = nys, nyn |
---|
10580 | DO k = nzb_do, nzt_do |
---|
10581 | local_pf(i,j,k) = MERGE( ldsa_av(k,j,i), REAL( fill_value, KIND = wp ), & |
---|
10582 | BTEST( wall_flags_0(k,j,i), 0 ) ) |
---|
10583 | ENDDO |
---|
10584 | ENDDO |
---|
10585 | ENDDO |
---|
10586 | ENDIF |
---|
10587 | |
---|
10588 | IF ( mode == 'xy' ) grid = 'zu' |
---|
10589 | |
---|
10590 | CASE ( 'N_UFP' ) |
---|
10591 | |
---|
10592 | IF ( av == 0 ) THEN |
---|
10593 | DO i = nxl, nxr |
---|
10594 | DO j = nys, nyn |
---|
10595 | DO k = nzb_do, nzt_do |
---|
10596 | temp_bin = 0.0_wp |
---|
10597 | DO ib = 1, nbins_aerosol |
---|
10598 | IF ( 2.0_wp * ra_dry(k,j,i,ib) <= 0.1E-6_wp ) THEN |
---|
10599 | temp_bin = temp_bin + aerosol_number(ib)%conc(k,j,i) |
---|
10600 | ENDIF |
---|
10601 | ENDDO |
---|
10602 | local_pf(i,j,k) = MERGE( temp_bin, REAL( fill_value, KIND = wp ), & |
---|
10603 | BTEST( wall_flags_0(k,j,i), 0 ) ) |
---|
10604 | ENDDO |
---|
10605 | ENDDO |
---|
10606 | ENDDO |
---|
10607 | ELSE |
---|
10608 | DO i = nxl, nxr |
---|
10609 | DO j = nys, nyn |
---|
10610 | DO k = nzb_do, nzt_do |
---|
10611 | local_pf(i,j,k) = MERGE( nufp_av(k,j,i), REAL( fill_value, KIND = wp ), & |
---|
10612 | BTEST( wall_flags_0(k,j,i), 0 ) ) |
---|
10613 | ENDDO |
---|
10614 | ENDDO |
---|
10615 | ENDDO |
---|
10616 | ENDIF |
---|
10617 | |
---|
10618 | IF ( mode == 'xy' ) grid = 'zu' |
---|
10619 | |
---|
10620 | CASE ( 'Ntot' ) |
---|
10621 | |
---|
10622 | IF ( av == 0 ) THEN |
---|
10623 | DO i = nxl, nxr |
---|
10624 | DO j = nys, nyn |
---|
10625 | DO k = nzb_do, nzt_do |
---|
10626 | temp_bin = 0.0_wp |
---|
10627 | DO ib = 1, nbins_aerosol |
---|
10628 | temp_bin = temp_bin + aerosol_number(ib)%conc(k,j,i) |
---|
10629 | ENDDO |
---|
10630 | local_pf(i,j,k) = MERGE( temp_bin, REAL( fill_value, KIND = wp ), & |
---|
10631 | BTEST( wall_flags_0(k,j,i), 0 ) ) |
---|
10632 | ENDDO |
---|
10633 | ENDDO |
---|
10634 | ENDDO |
---|
10635 | ELSE |
---|
10636 | DO i = nxl, nxr |
---|
10637 | DO j = nys, nyn |
---|
10638 | DO k = nzb_do, nzt_do |
---|
10639 | local_pf(i,j,k) = MERGE( ntot_av(k,j,i), REAL( fill_value, KIND = wp ), & |
---|
10640 | BTEST( wall_flags_0(k,j,i), 0 ) ) |
---|
10641 | ENDDO |
---|
10642 | ENDDO |
---|
10643 | ENDDO |
---|
10644 | ENDIF |
---|
10645 | |
---|
10646 | IF ( mode == 'xy' ) grid = 'zu' |
---|
10647 | |
---|
10648 | CASE ( 'PM0.1' ) |
---|
10649 | IF ( av == 0 ) THEN |
---|
10650 | DO i = nxl, nxr |
---|
10651 | DO j = nys, nyn |
---|
10652 | DO k = nzb_do, nzt_do |
---|
10653 | temp_bin = 0.0_wp |
---|
10654 | DO ib = 1, nbins_aerosol |
---|
10655 | IF ( 2.0_wp * ra_dry(k,j,i,ib) <= 0.1E-6_wp ) THEN |
---|
10656 | DO ic = ib, nbins_aerosol * ncc, nbins_aerosol |
---|
10657 | temp_bin = temp_bin + aerosol_mass(ic)%conc(k,j,i) |
---|
10658 | ENDDO |
---|
10659 | ENDIF |
---|
10660 | ENDDO |
---|
10661 | local_pf(i,j,k) = MERGE( temp_bin, REAL( fill_value, KIND = wp ), & |
---|
10662 | BTEST( wall_flags_0(k,j,i), 0 ) ) |
---|
10663 | ENDDO |
---|
10664 | ENDDO |
---|
10665 | ENDDO |
---|
10666 | ELSE |
---|
10667 | DO i = nxl, nxr |
---|
10668 | DO j = nys, nyn |
---|
10669 | DO k = nzb_do, nzt_do |
---|
10670 | local_pf(i,j,k) = MERGE( pm01_av(k,j,i), REAL( fill_value, KIND = wp ), & |
---|
10671 | BTEST( wall_flags_0(k,j,i), 0 ) ) |
---|
10672 | ENDDO |
---|
10673 | ENDDO |
---|
10674 | ENDDO |
---|
10675 | ENDIF |
---|
10676 | |
---|
10677 | IF ( mode == 'xy' ) grid = 'zu' |
---|
10678 | |
---|
10679 | CASE ( 'PM2.5' ) |
---|
10680 | IF ( av == 0 ) THEN |
---|
10681 | DO i = nxl, nxr |
---|
10682 | DO j = nys, nyn |
---|
10683 | DO k = nzb_do, nzt_do |
---|
10684 | temp_bin = 0.0_wp |
---|
10685 | DO ib = 1, nbins_aerosol |
---|
10686 | IF ( 2.0_wp * ra_dry(k,j,i,ib) <= 2.5E-6_wp ) THEN |
---|
10687 | DO ic = ib, nbins_aerosol * ncc, nbins_aerosol |
---|
10688 | temp_bin = temp_bin + aerosol_mass(ic)%conc(k,j,i) |
---|
10689 | ENDDO |
---|
10690 | ENDIF |
---|
10691 | ENDDO |
---|
10692 | local_pf(i,j,k) = MERGE( temp_bin, REAL( fill_value, KIND = wp ), & |
---|
10693 | BTEST( wall_flags_0(k,j,i), 0 ) ) |
---|
10694 | ENDDO |
---|
10695 | ENDDO |
---|
10696 | ENDDO |
---|
10697 | ELSE |
---|
10698 | DO i = nxl, nxr |
---|
10699 | DO j = nys, nyn |
---|
10700 | DO k = nzb_do, nzt_do |
---|
10701 | local_pf(i,j,k) = MERGE( pm25_av(k,j,i), REAL( fill_value, KIND = wp ), & |
---|
10702 | BTEST( wall_flags_0(k,j,i), 0 ) ) |
---|
10703 | ENDDO |
---|
10704 | ENDDO |
---|
10705 | ENDDO |
---|
10706 | ENDIF |
---|
10707 | |
---|
10708 | IF ( mode == 'xy' ) grid = 'zu' |
---|
10709 | |
---|
10710 | CASE ( 'PM10' ) |
---|
10711 | IF ( av == 0 ) THEN |
---|
10712 | DO i = nxl, nxr |
---|
10713 | DO j = nys, nyn |
---|
10714 | DO k = nzb_do, nzt_do |
---|
10715 | temp_bin = 0.0_wp |
---|
10716 | DO ib = 1, nbins_aerosol |
---|
10717 | IF ( 2.0_wp * ra_dry(k,j,i,ib) <= 10.0E-6_wp ) THEN |
---|
10718 | DO ic = ib, nbins_aerosol * ncc, nbins_aerosol |
---|
10719 | temp_bin = temp_bin + aerosol_mass(ic)%conc(k,j,i) |
---|
10720 | ENDDO |
---|
10721 | ENDIF |
---|
10722 | ENDDO |
---|
10723 | local_pf(i,j,k) = MERGE( temp_bin, REAL( fill_value, KIND = wp ), & |
---|
10724 | BTEST( wall_flags_0(k,j,i), 0 ) ) |
---|
10725 | ENDDO |
---|
10726 | ENDDO |
---|
10727 | ENDDO |
---|
10728 | ELSE |
---|
10729 | DO i = nxl, nxr |
---|
10730 | DO j = nys, nyn |
---|
10731 | DO k = nzb_do, nzt_do |
---|
10732 | local_pf(i,j,k) = MERGE( pm10_av(k,j,i), REAL( fill_value, KIND = wp ), & |
---|
10733 | BTEST( wall_flags_0(k,j,i), 0 ) ) |
---|
10734 | ENDDO |
---|
10735 | ENDDO |
---|
10736 | ENDDO |
---|
10737 | ENDIF |
---|
10738 | |
---|
10739 | IF ( mode == 'xy' ) grid = 'zu' |
---|
10740 | |
---|
10741 | CASE ( 's_BC', 's_DU', 's_NH', 's_NO', 's_OC', 's_SO4', 's_SS' ) |
---|
10742 | vari = TRIM( variable( 9:LEN( TRIM( variable ) ) - 3 ) ) ! 9: remove salsa_s_ |
---|
10743 | IF ( is_used( prtcl, vari ) ) THEN |
---|
10744 | found_index = get_index( prtcl, vari ) |
---|
10745 | IF ( av == 0 ) THEN |
---|
10746 | DO i = nxl, nxr |
---|
10747 | DO j = nys, nyn |
---|
10748 | DO k = nzb_do, nzt_do |
---|
10749 | temp_bin = 0.0_wp |
---|
10750 | DO ic = ( found_index-1 ) * nbins_aerosol+1, found_index * nbins_aerosol |
---|
10751 | temp_bin = temp_bin + aerosol_mass(ic)%conc(k,j,i) |
---|
10752 | ENDDO |
---|
10753 | local_pf(i,j,k) = MERGE( temp_bin, REAL( fill_value, KIND = wp ), & |
---|
10754 | BTEST( wall_flags_0(k,j,i), 0 ) ) |
---|
10755 | ENDDO |
---|
10756 | ENDDO |
---|
10757 | ENDDO |
---|
10758 | ELSE |
---|
10759 | IF ( vari == 'BC' ) to_be_resorted => s_bc_av |
---|
10760 | IF ( vari == 'DU' ) to_be_resorted => s_du_av |
---|
10761 | IF ( vari == 'NH' ) to_be_resorted => s_nh_av |
---|
10762 | IF ( vari == 'NO' ) to_be_resorted => s_no_av |
---|
10763 | IF ( vari == 'OC' ) to_be_resorted => s_oc_av |
---|
10764 | IF ( vari == 'SO4' ) to_be_resorted => s_so4_av |
---|
10765 | IF ( vari == 'SS' ) to_be_resorted => s_ss_av |
---|
10766 | DO i = nxl, nxr |
---|
10767 | DO j = nys, nyn |
---|
10768 | DO k = nzb_do, nzt_do |
---|
10769 | local_pf(i,j,k) = MERGE( to_be_resorted(k,j,i), REAL( fill_value, & |
---|
10770 | KIND = wp ), BTEST( wall_flags_0(k,j,i), 0 ) ) |
---|
10771 | ENDDO |
---|
10772 | ENDDO |
---|
10773 | ENDDO |
---|
10774 | ENDIF |
---|
10775 | ELSE |
---|
10776 | local_pf = fill_value |
---|
10777 | ENDIF |
---|
10778 | |
---|
10779 | IF ( mode == 'xy' ) grid = 'zu' |
---|
10780 | |
---|
10781 | CASE ( 's_H2O' ) |
---|
10782 | found_index = get_index( prtcl, 'H2O' ) |
---|
10783 | IF ( av == 0 ) THEN |
---|
10784 | DO i = nxl, nxr |
---|
10785 | DO j = nys, nyn |
---|
10786 | DO k = nzb_do, nzt_do |
---|
10787 | temp_bin = 0.0_wp |
---|
10788 | DO ic = ( found_index-1 ) * nbins_aerosol+1, found_index * nbins_aerosol |
---|
10789 | temp_bin = temp_bin + aerosol_mass(ic)%conc(k,j,i) |
---|
10790 | ENDDO |
---|
10791 | local_pf(i,j,k) = MERGE( temp_bin, REAL( fill_value, KIND = wp ), & |
---|
10792 | BTEST( wall_flags_0(k,j,i), 0 ) ) |
---|
10793 | ENDDO |
---|
10794 | ENDDO |
---|
10795 | ENDDO |
---|
10796 | ELSE |
---|
10797 | to_be_resorted => s_h2o_av |
---|
10798 | DO i = nxl, nxr |
---|
10799 | DO j = nys, nyn |
---|
10800 | DO k = nzb_do, nzt_do |
---|
10801 | local_pf(i,j,k) = MERGE( to_be_resorted(k,j,i), REAL( fill_value, & |
---|
10802 | KIND = wp ), BTEST( wall_flags_0(k,j,i), 0 ) ) |
---|
10803 | ENDDO |
---|
10804 | ENDDO |
---|
10805 | ENDDO |
---|
10806 | ENDIF |
---|
10807 | |
---|
10808 | IF ( mode == 'xy' ) grid = 'zu' |
---|
10809 | |
---|
10810 | CASE DEFAULT |
---|
10811 | found = .FALSE. |
---|
10812 | grid = 'none' |
---|
10813 | |
---|
10814 | END SELECT |
---|
10815 | |
---|
10816 | ENDIF |
---|
10817 | |
---|
10818 | END SUBROUTINE salsa_data_output_2d |
---|
10819 | |
---|
10820 | !------------------------------------------------------------------------------! |
---|
10821 | ! |
---|
10822 | ! Description: |
---|
10823 | ! ------------ |
---|
10824 | !> Subroutine defining 3D output variables |
---|
10825 | !------------------------------------------------------------------------------! |
---|
10826 | SUBROUTINE salsa_data_output_3d( av, variable, found, local_pf, nzb_do, nzt_do ) |
---|
10827 | |
---|
10828 | USE indices |
---|
10829 | |
---|
10830 | USE kinds |
---|
10831 | |
---|
10832 | |
---|
10833 | IMPLICIT NONE |
---|
10834 | |
---|
10835 | CHARACTER(LEN=*), INTENT(in) :: variable !< |
---|
10836 | |
---|
10837 | INTEGER(iwp) :: av !< |
---|
10838 | INTEGER(iwp) :: char_to_int !< for converting character to integer |
---|
10839 | INTEGER(iwp) :: found_index !< index of a chemical compound |
---|
10840 | INTEGER(iwp) :: ib !< running index: size bins |
---|
10841 | INTEGER(iwp) :: ic !< running index: mass bins |
---|
10842 | INTEGER(iwp) :: i !< |
---|
10843 | INTEGER(iwp) :: j !< |
---|
10844 | INTEGER(iwp) :: k !< |
---|
10845 | INTEGER(iwp) :: nzb_do !< |
---|
10846 | INTEGER(iwp) :: nzt_do !< |
---|
10847 | |
---|
10848 | LOGICAL :: found !< |
---|
10849 | |
---|
10850 | REAL(wp) :: df !< For calculating LDSA: fraction of particles |
---|
10851 | !< depositing in the alveolar (or tracheobronchial) |
---|
10852 | !< region of the lung. Depends on the particle size |
---|
10853 | REAL(wp) :: mean_d !< Particle diameter in micrometres |
---|
10854 | REAL(wp) :: temp_bin !< temporary array for calculating output variables |
---|
10855 | |
---|
10856 | REAL(sp), DIMENSION(nxl:nxr,nys:nyn,nzb_do:nzt_do) :: local_pf !< local |
---|
10857 | |
---|
10858 | REAL(wp), DIMENSION(:,:,:), POINTER :: to_be_resorted !< pointer |
---|
10859 | |
---|
10860 | found = .TRUE. |
---|
10861 | temp_bin = 0.0_wp |
---|
10862 | |
---|
10863 | IF ( variable(7:11) == 'N_bin' ) THEN |
---|
10864 | READ( variable(12:),* ) char_to_int |
---|
10865 | IF ( char_to_int >= 1 .AND. char_to_int <= SUM( nbin ) ) THEN |
---|
10866 | |
---|
10867 | ib = char_to_int |
---|
10868 | IF ( av == 0 ) THEN |
---|
10869 | DO i = nxl, nxr |
---|
10870 | DO j = nys, nyn |
---|
10871 | DO k = nzb_do, nzt_do |
---|
10872 | local_pf(i,j,k) = MERGE( aerosol_number(ib)%conc(k,j,i), REAL( fill_value, & |
---|
10873 | KIND = wp ), BTEST( wall_flags_0(k,j,i), 0 ) ) |
---|
10874 | ENDDO |
---|
10875 | ENDDO |
---|
10876 | ENDDO |
---|
10877 | ELSE |
---|
10878 | DO i = nxl, nxr |
---|
10879 | DO j = nys, nyn |
---|
10880 | DO k = nzb_do, nzt_do |
---|
10881 | local_pf(i,j,k) = MERGE( nbins_av(k,j,i,ib), REAL( fill_value, KIND = wp ), & |
---|
10882 | BTEST( wall_flags_0(k,j,i), 0 ) ) |
---|
10883 | ENDDO |
---|
10884 | ENDDO |
---|
10885 | ENDDO |
---|
10886 | ENDIF |
---|
10887 | ENDIF |
---|
10888 | |
---|
10889 | ELSEIF ( variable(7:11) == 'm_bin' ) THEN |
---|
10890 | READ( variable(12:),* ) char_to_int |
---|
10891 | IF ( char_to_int >= 1 .AND. char_to_int <= SUM( nbin ) ) THEN |
---|
10892 | |
---|
10893 | ib = char_to_int |
---|
10894 | IF ( av == 0 ) THEN |
---|
10895 | DO i = nxl, nxr |
---|
10896 | DO j = nys, nyn |
---|
10897 | DO k = nzb_do, nzt_do |
---|
10898 | temp_bin = 0.0_wp |
---|
10899 | DO ic = ib, ncomponents_mass * nbins_aerosol, nbins_aerosol |
---|
10900 | temp_bin = temp_bin + aerosol_mass(ic)%conc(k,j,i) |
---|
10901 | ENDDO |
---|
10902 | local_pf(i,j,k) = MERGE( temp_bin, REAL( fill_value, KIND = wp ), & |
---|
10903 | BTEST( wall_flags_0(k,j,i), 0 ) ) |
---|
10904 | ENDDO |
---|
10905 | ENDDO |
---|
10906 | ENDDO |
---|
10907 | ELSE |
---|
10908 | DO i = nxl, nxr |
---|
10909 | DO j = nys, nyn |
---|
10910 | DO k = nzb_do, nzt_do |
---|
10911 | local_pf(i,j,k) = MERGE( mbins_av(k,j,i,ib), REAL( fill_value, KIND = wp ), & |
---|
10912 | BTEST( wall_flags_0(k,j,i), 0 ) ) |
---|
10913 | ENDDO |
---|
10914 | ENDDO |
---|
10915 | ENDDO |
---|
10916 | ENDIF |
---|
10917 | ENDIF |
---|
10918 | |
---|
10919 | ELSE |
---|
10920 | SELECT CASE ( TRIM( variable(7:) ) ) |
---|
10921 | |
---|
10922 | CASE ( 'g_H2SO4', 'g_HNO3', 'g_NH3', 'g_OCNV', 'g_OCSV' ) |
---|
10923 | IF ( av == 0 ) THEN |
---|
10924 | IF ( TRIM( variable(7:) ) == 'g_H2SO4') found_index = 1 |
---|
10925 | IF ( TRIM( variable(7:) ) == 'g_HNO3') found_index = 2 |
---|
10926 | IF ( TRIM( variable(7:) ) == 'g_NH3') found_index = 3 |
---|
10927 | IF ( TRIM( variable(7:) ) == 'g_OCNV') found_index = 4 |
---|
10928 | IF ( TRIM( variable(7:) ) == 'g_OCSV') found_index = 5 |
---|
10929 | |
---|
10930 | DO i = nxl, nxr |
---|
10931 | DO j = nys, nyn |
---|
10932 | DO k = nzb_do, nzt_do |
---|
10933 | local_pf(i,j,k) = MERGE( salsa_gas(found_index)%conc(k,j,i), & |
---|
10934 | REAL( fill_value, KIND = wp ), & |
---|
10935 | BTEST( wall_flags_0(k,j,i), 0 ) ) |
---|
10936 | ENDDO |
---|
10937 | ENDDO |
---|
10938 | ENDDO |
---|
10939 | ELSE |
---|
10940 | ! |
---|
10941 | !-- 9: remove salsa_g_ from the beginning |
---|
10942 | IF ( TRIM( variable(9:) ) == 'H2SO4' ) to_be_resorted => g_h2so4_av |
---|
10943 | IF ( TRIM( variable(9:) ) == 'HNO3' ) to_be_resorted => g_hno3_av |
---|
10944 | IF ( TRIM( variable(9:) ) == 'NH3' ) to_be_resorted => g_nh3_av |
---|
10945 | IF ( TRIM( variable(9:) ) == 'OCNV' ) to_be_resorted => g_ocnv_av |
---|
10946 | IF ( TRIM( variable(9:) ) == 'OCSV' ) to_be_resorted => g_ocsv_av |
---|
10947 | DO i = nxl, nxr |
---|
10948 | DO j = nys, nyn |
---|
10949 | DO k = nzb_do, nzt_do |
---|
10950 | local_pf(i,j,k) = MERGE( to_be_resorted(k,j,i), REAL( fill_value, & |
---|
10951 | KIND = wp ), BTEST( wall_flags_0(k,j,i), 0 ) ) |
---|
10952 | ENDDO |
---|
10953 | ENDDO |
---|
10954 | ENDDO |
---|
10955 | ENDIF |
---|
10956 | |
---|
10957 | CASE ( 'LDSA' ) |
---|
10958 | IF ( av == 0 ) THEN |
---|
10959 | DO i = nxl, nxr |
---|
10960 | DO j = nys, nyn |
---|
10961 | DO k = nzb_do, nzt_do |
---|
10962 | temp_bin = 0.0_wp |
---|
10963 | DO ib = 1, nbins_aerosol |
---|
10964 | ! |
---|
10965 | !-- Diameter in micrometres |
---|
10966 | mean_d = 1.0E+6_wp * ra_dry(k,j,i,ib) * 2.0_wp |
---|
10967 | ! |
---|
10968 | !-- Deposition factor: alveolar |
---|
10969 | df = ( 0.01555_wp / mean_d ) * ( EXP( -0.416_wp * ( LOG( mean_d ) + & |
---|
10970 | 2.84_wp )**2 ) + 19.11_wp * EXP( -0.482_wp * ( LOG( mean_d ) - & |
---|
10971 | 1.362_wp )**2 ) ) |
---|
10972 | ! |
---|
10973 | !-- Lung-deposited surface area LDSA (units mum2/cm3) |
---|
10974 | temp_bin = temp_bin + pi * mean_d**2 * df * 1.0E-6_wp * & |
---|
10975 | aerosol_number(ib)%conc(k,j,i) |
---|
10976 | ENDDO |
---|
10977 | local_pf(i,j,k) = MERGE( temp_bin, REAL( fill_value, KIND = wp ), & |
---|
10978 | BTEST( wall_flags_0(k,j,i), 0 ) ) |
---|
10979 | ENDDO |
---|
10980 | ENDDO |
---|
10981 | ENDDO |
---|
10982 | ELSE |
---|
10983 | DO i = nxl, nxr |
---|
10984 | DO j = nys, nyn |
---|
10985 | DO k = nzb_do, nzt_do |
---|
10986 | local_pf(i,j,k) = MERGE( ldsa_av(k,j,i), REAL( fill_value, KIND = wp ), & |
---|
10987 | BTEST( wall_flags_0(k,j,i), 0 ) ) |
---|
10988 | ENDDO |
---|
10989 | ENDDO |
---|
10990 | ENDDO |
---|
10991 | ENDIF |
---|
10992 | |
---|
10993 | CASE ( 'N_UFP' ) |
---|
10994 | IF ( av == 0 ) THEN |
---|
10995 | DO i = nxl, nxr |
---|
10996 | DO j = nys, nyn |
---|
10997 | DO k = nzb_do, nzt_do |
---|
10998 | temp_bin = 0.0_wp |
---|
10999 | DO ib = 1, nbins_aerosol |
---|
11000 | IF ( 2.0_wp * ra_dry(k,j,i,ib) <= 0.1E-6_wp ) THEN |
---|
11001 | temp_bin = temp_bin + aerosol_number(ib)%conc(k,j,i) |
---|
11002 | ENDIF |
---|
11003 | ENDDO |
---|
11004 | local_pf(i,j,k) = MERGE( temp_bin, REAL( fill_value, KIND = wp ), & |
---|
11005 | BTEST( wall_flags_0(k,j,i), 0 ) ) |
---|
11006 | ENDDO |
---|
11007 | ENDDO |
---|
11008 | ENDDO |
---|
11009 | ELSE |
---|
11010 | DO i = nxl, nxr |
---|
11011 | DO j = nys, nyn |
---|
11012 | DO k = nzb_do, nzt_do |
---|
11013 | local_pf(i,j,k) = MERGE( nufp_av(k,j,i), REAL( fill_value, KIND = wp ), & |
---|
11014 | BTEST( wall_flags_0(k,j,i), 0 ) ) |
---|
11015 | ENDDO |
---|
11016 | ENDDO |
---|
11017 | ENDDO |
---|
11018 | ENDIF |
---|
11019 | |
---|
11020 | CASE ( 'Ntot' ) |
---|
11021 | IF ( av == 0 ) THEN |
---|
11022 | DO i = nxl, nxr |
---|
11023 | DO j = nys, nyn |
---|
11024 | DO k = nzb_do, nzt_do |
---|
11025 | temp_bin = 0.0_wp |
---|
11026 | DO ib = 1, nbins_aerosol |
---|
11027 | temp_bin = temp_bin + aerosol_number(ib)%conc(k,j,i) |
---|
11028 | ENDDO |
---|
11029 | local_pf(i,j,k) = MERGE( temp_bin, REAL( fill_value, KIND = wp ), & |
---|
11030 | BTEST( wall_flags_0(k,j,i), 0 ) ) |
---|
11031 | ENDDO |
---|
11032 | ENDDO |
---|
11033 | ENDDO |
---|
11034 | ELSE |
---|
11035 | DO i = nxl, nxr |
---|
11036 | DO j = nys, nyn |
---|
11037 | DO k = nzb_do, nzt_do |
---|
11038 | local_pf(i,j,k) = MERGE( ntot_av(k,j,i), REAL( fill_value, KIND = wp ), & |
---|
11039 | BTEST( wall_flags_0(k,j,i), 0 ) ) |
---|
11040 | ENDDO |
---|
11041 | ENDDO |
---|
11042 | ENDDO |
---|
11043 | ENDIF |
---|
11044 | |
---|
11045 | CASE ( 'PM0.1' ) |
---|
11046 | IF ( av == 0 ) THEN |
---|
11047 | DO i = nxl, nxr |
---|
11048 | DO j = nys, nyn |
---|
11049 | DO k = nzb_do, nzt_do |
---|
11050 | temp_bin = 0.0_wp |
---|
11051 | DO ib = 1, nbins_aerosol |
---|
11052 | IF ( 2.0_wp * ra_dry(k,j,i,ib) <= 0.1E-6_wp ) THEN |
---|
11053 | DO ic = ib, nbins_aerosol * ncc, nbins_aerosol |
---|
11054 | temp_bin = temp_bin + aerosol_mass(ic)%conc(k,j,i) |
---|
11055 | ENDDO |
---|
11056 | ENDIF |
---|
11057 | ENDDO |
---|
11058 | local_pf(i,j,k) = MERGE( temp_bin, REAL( fill_value, KIND = wp ), & |
---|
11059 | BTEST( wall_flags_0(k,j,i), 0 ) ) |
---|
11060 | ENDDO |
---|
11061 | ENDDO |
---|
11062 | ENDDO |
---|
11063 | ELSE |
---|
11064 | DO i = nxl, nxr |
---|
11065 | DO j = nys, nyn |
---|
11066 | DO k = nzb_do, nzt_do |
---|
11067 | local_pf(i,j,k) = MERGE( pm01_av(k,j,i), REAL( fill_value, KIND = wp ), & |
---|
11068 | BTEST( wall_flags_0(k,j,i), 0 ) ) |
---|
11069 | ENDDO |
---|
11070 | ENDDO |
---|
11071 | ENDDO |
---|
11072 | ENDIF |
---|
11073 | |
---|
11074 | CASE ( 'PM2.5' ) |
---|
11075 | IF ( av == 0 ) THEN |
---|
11076 | DO i = nxl, nxr |
---|
11077 | DO j = nys, nyn |
---|
11078 | DO k = nzb_do, nzt_do |
---|
11079 | temp_bin = 0.0_wp |
---|
11080 | DO ib = 1, nbins_aerosol |
---|
11081 | IF ( 2.0_wp * ra_dry(k,j,i,ib) <= 2.5E-6_wp ) THEN |
---|
11082 | DO ic = ib, nbins_aerosol * ncc, nbins_aerosol |
---|
11083 | temp_bin = temp_bin + aerosol_mass(ic)%conc(k,j,i) |
---|
11084 | ENDDO |
---|
11085 | ENDIF |
---|
11086 | ENDDO |
---|
11087 | local_pf(i,j,k) = MERGE( temp_bin, REAL( fill_value, KIND = wp ), & |
---|
11088 | BTEST( wall_flags_0(k,j,i), 0 ) ) |
---|
11089 | ENDDO |
---|
11090 | ENDDO |
---|
11091 | ENDDO |
---|
11092 | ELSE |
---|
11093 | DO i = nxl, nxr |
---|
11094 | DO j = nys, nyn |
---|
11095 | DO k = nzb_do, nzt_do |
---|
11096 | local_pf(i,j,k) = MERGE( pm25_av(k,j,i), REAL( fill_value, KIND = wp ), & |
---|
11097 | BTEST( wall_flags_0(k,j,i), 0 ) ) |
---|
11098 | ENDDO |
---|
11099 | ENDDO |
---|
11100 | ENDDO |
---|
11101 | ENDIF |
---|
11102 | |
---|
11103 | CASE ( 'PM10' ) |
---|
11104 | IF ( av == 0 ) THEN |
---|
11105 | DO i = nxl, nxr |
---|
11106 | DO j = nys, nyn |
---|
11107 | DO k = nzb_do, nzt_do |
---|
11108 | temp_bin = 0.0_wp |
---|
11109 | DO ib = 1, nbins_aerosol |
---|
11110 | IF ( 2.0_wp * ra_dry(k,j,i,ib) <= 10.0E-6_wp ) THEN |
---|
11111 | DO ic = ib, nbins_aerosol * ncc, nbins_aerosol |
---|
11112 | temp_bin = temp_bin + aerosol_mass(ic)%conc(k,j,i) |
---|
11113 | ENDDO |
---|
11114 | ENDIF |
---|
11115 | ENDDO |
---|
11116 | local_pf(i,j,k) = MERGE( temp_bin, REAL( fill_value, KIND = wp ), & |
---|
11117 | BTEST( wall_flags_0(k,j,i), 0 ) ) |
---|
11118 | ENDDO |
---|
11119 | ENDDO |
---|
11120 | ENDDO |
---|
11121 | ELSE |
---|
11122 | DO i = nxl, nxr |
---|
11123 | DO j = nys, nyn |
---|
11124 | DO k = nzb_do, nzt_do |
---|
11125 | local_pf(i,j,k) = MERGE( pm10_av(k,j,i), REAL( fill_value, KIND = wp ), & |
---|
11126 | BTEST( wall_flags_0(k,j,i), 0 ) ) |
---|
11127 | ENDDO |
---|
11128 | ENDDO |
---|
11129 | ENDDO |
---|
11130 | ENDIF |
---|
11131 | |
---|
11132 | CASE ( 's_BC', 's_DU', 's_NH', 's_NO', 's_OC', 's_SO4', 's_SS' ) |
---|
11133 | IF ( is_used( prtcl, TRIM( variable(9:) ) ) ) THEN ! 9: remove salsa_s_ |
---|
11134 | found_index = get_index( prtcl, TRIM( variable(9:) ) ) |
---|
11135 | IF ( av == 0 ) THEN |
---|
11136 | DO i = nxl, nxr |
---|
11137 | DO j = nys, nyn |
---|
11138 | DO k = nzb_do, nzt_do |
---|
11139 | temp_bin = 0.0_wp |
---|
11140 | DO ic = ( found_index-1 ) * nbins_aerosol + 1, found_index * nbins_aerosol |
---|
11141 | temp_bin = temp_bin + aerosol_mass(ic)%conc(k,j,i) |
---|
11142 | ENDDO |
---|
11143 | local_pf(i,j,k) = MERGE( temp_bin, REAL( fill_value, KIND = wp ), & |
---|
11144 | BTEST( wall_flags_0(k,j,i), 0 ) ) |
---|
11145 | ENDDO |
---|
11146 | ENDDO |
---|
11147 | ENDDO |
---|
11148 | ELSE |
---|
11149 | ! |
---|
11150 | !-- 9: remove salsa_s_ from the beginning |
---|
11151 | IF ( TRIM( variable(9:) ) == 'BC' ) to_be_resorted => s_bc_av |
---|
11152 | IF ( TRIM( variable(9:) ) == 'DU' ) to_be_resorted => s_du_av |
---|
11153 | IF ( TRIM( variable(9:) ) == 'NH' ) to_be_resorted => s_nh_av |
---|
11154 | IF ( TRIM( variable(9:) ) == 'NO' ) to_be_resorted => s_no_av |
---|
11155 | IF ( TRIM( variable(9:) ) == 'OC' ) to_be_resorted => s_oc_av |
---|
11156 | IF ( TRIM( variable(9:) ) == 'SO4' ) to_be_resorted => s_so4_av |
---|
11157 | IF ( TRIM( variable(9:) ) == 'SS' ) to_be_resorted => s_ss_av |
---|
11158 | DO i = nxl, nxr |
---|
11159 | DO j = nys, nyn |
---|
11160 | DO k = nzb_do, nzt_do |
---|
11161 | local_pf(i,j,k) = MERGE( to_be_resorted(k,j,i), REAL( fill_value, & |
---|
11162 | KIND = wp ), BTEST( wall_flags_0(k,j,i), 0 ) ) |
---|
11163 | ENDDO |
---|
11164 | ENDDO |
---|
11165 | ENDDO |
---|
11166 | ENDIF |
---|
11167 | ENDIF |
---|
11168 | |
---|
11169 | CASE ( 's_H2O' ) |
---|
11170 | found_index = get_index( prtcl, 'H2O' ) |
---|
11171 | IF ( av == 0 ) THEN |
---|
11172 | DO i = nxl, nxr |
---|
11173 | DO j = nys, nyn |
---|
11174 | DO k = nzb_do, nzt_do |
---|
11175 | temp_bin = 0.0_wp |
---|
11176 | DO ic = ( found_index-1 ) * nbins_aerosol + 1, found_index * nbins_aerosol |
---|
11177 | temp_bin = temp_bin + aerosol_mass(ic)%conc(k,j,i) |
---|
11178 | ENDDO |
---|
11179 | local_pf(i,j,k) = MERGE( temp_bin, REAL( fill_value, KIND = wp ), & |
---|
11180 | BTEST( wall_flags_0(k,j,i), 0 ) ) |
---|
11181 | ENDDO |
---|
11182 | ENDDO |
---|
11183 | ENDDO |
---|
11184 | ELSE |
---|
11185 | to_be_resorted => s_h2o_av |
---|
11186 | DO i = nxl, nxr |
---|
11187 | DO j = nys, nyn |
---|
11188 | DO k = nzb_do, nzt_do |
---|
11189 | local_pf(i,j,k) = MERGE( to_be_resorted(k,j,i), REAL( fill_value, & |
---|
11190 | KIND = wp ), BTEST( wall_flags_0(k,j,i), 0 ) ) |
---|
11191 | ENDDO |
---|
11192 | ENDDO |
---|
11193 | ENDDO |
---|
11194 | ENDIF |
---|
11195 | |
---|
11196 | CASE DEFAULT |
---|
11197 | found = .FALSE. |
---|
11198 | |
---|
11199 | END SELECT |
---|
11200 | ENDIF |
---|
11201 | |
---|
11202 | END SUBROUTINE salsa_data_output_3d |
---|
11203 | |
---|
11204 | !------------------------------------------------------------------------------! |
---|
11205 | ! |
---|
11206 | ! Description: |
---|
11207 | ! ------------ |
---|
11208 | !> Subroutine defining mask output variables |
---|
11209 | !------------------------------------------------------------------------------! |
---|
11210 | SUBROUTINE salsa_data_output_mask( av, variable, found, local_pf, mid ) |
---|
11211 | |
---|
11212 | USE arrays_3d, & |
---|
11213 | ONLY: tend |
---|
11214 | |
---|
11215 | USE control_parameters, & |
---|
11216 | ONLY: mask_i, mask_j, mask_k, mask_size_l, mask_surface, nz_do3d |
---|
11217 | |
---|
11218 | IMPLICIT NONE |
---|
11219 | |
---|
11220 | CHARACTER(LEN=5) :: grid !< flag to distinquish between staggered grid |
---|
11221 | CHARACTER(LEN=*) :: variable !< |
---|
11222 | CHARACTER(LEN=7) :: vari !< trimmed format of variable |
---|
11223 | |
---|
11224 | INTEGER(iwp) :: av !< |
---|
11225 | INTEGER(iwp) :: char_to_int !< for converting character to integer |
---|
11226 | INTEGER(iwp) :: found_index !< index of a chemical compound |
---|
11227 | INTEGER(iwp) :: ib !< loop index for aerosol size number bins |
---|
11228 | INTEGER(iwp) :: ic !< loop index for chemical components |
---|
11229 | INTEGER(iwp) :: i !< loop index in x-direction |
---|
11230 | INTEGER(iwp) :: j !< loop index in y-direction |
---|
11231 | INTEGER(iwp) :: k !< loop index in z-direction |
---|
11232 | INTEGER(iwp) :: im !< loop index for masked variables |
---|
11233 | INTEGER(iwp) :: jm !< loop index for masked variables |
---|
11234 | INTEGER(iwp) :: kk !< loop index for masked output in z-direction |
---|
11235 | INTEGER(iwp) :: mid !< masked output running index |
---|
11236 | INTEGER(iwp) :: ktt !< k index of highest terrain surface |
---|
11237 | |
---|
11238 | LOGICAL :: found !< |
---|
11239 | LOGICAL :: resorted !< |
---|
11240 | |
---|
11241 | REAL(wp) :: df !< For calculating LDSA: fraction of particles depositing in the alveolar |
---|
11242 | !< (or tracheobronchial) region of the lung. Depends on the particle size |
---|
11243 | REAL(wp) :: mean_d !< Particle diameter in micrometres |
---|
11244 | REAL(wp) :: temp_bin !< temporary array for calculating output variables |
---|
11245 | |
---|
11246 | REAL(wp), DIMENSION(mask_size_l(mid,1),mask_size_l(mid,2),mask_size_l(mid,3)) :: local_pf !< |
---|
11247 | |
---|
11248 | REAL(wp), DIMENSION(nzb:nzt+1,nysg:nyng,nxlg:nxrg), TARGET :: temp_array !< temporary array |
---|
11249 | |
---|
11250 | REAL(wp), DIMENSION(:,:,:), POINTER :: to_be_resorted !< pointer |
---|
11251 | |
---|
11252 | found = .TRUE. |
---|
11253 | resorted = .FALSE. |
---|
11254 | grid = 's' |
---|
11255 | temp_array = 0.0_wp |
---|
11256 | temp_bin = 0.0_wp |
---|
11257 | |
---|
11258 | IF ( variable(7:11) == 'N_bin' ) THEN |
---|
11259 | READ( variable(12:),* ) char_to_int |
---|
11260 | IF ( char_to_int >= 1 .AND. char_to_int <= SUM( nbin ) ) THEN |
---|
11261 | ib = char_to_int |
---|
11262 | IF ( av == 0 ) THEN |
---|
11263 | IF ( .NOT. mask_surface(mid) ) THEN |
---|
11264 | DO i = 1, mask_size_l(mid,1) |
---|
11265 | DO j = 1, mask_size_l(mid,2) |
---|
11266 | DO k = 1, mask_size_l(mid,3) |
---|
11267 | local_pf(i,j,k) = aerosol_number(ib)%conc( mask_k(mid,k), mask_j(mid,j), & |
---|
11268 | mask_i(mid,i) ) |
---|
11269 | ENDDO |
---|
11270 | ENDDO |
---|
11271 | ENDDO |
---|
11272 | ELSE |
---|
11273 | DO i = 1, mask_size_l(mid,1) |
---|
11274 | DO j = 1, mask_size_l(mid,2) |
---|
11275 | ! |
---|
11276 | !-- Get k index of the highest terraing surface |
---|
11277 | im = mask_i(mid,i) |
---|
11278 | jm = mask_j(mid,j) |
---|
11279 | ktt = MINLOC( MERGE( 1, 0, BTEST( wall_flags_0(:,jm,im), 5 )), DIM = 1 ) - 1 |
---|
11280 | DO k = 1, mask_size_l(mid,3) |
---|
11281 | kk = MIN( ktt+mask_k(mid,k), nzt+1 ) |
---|
11282 | ! |
---|
11283 | !-- Set value if not in building |
---|
11284 | IF ( BTEST( wall_flags_0(kk,jm,im), 6 ) ) THEN |
---|
11285 | local_pf(i,j,k) = fill_value |
---|
11286 | ELSE |
---|
11287 | local_pf(i,j,k) = aerosol_number(ib)%conc(kk,jm,im) |
---|
11288 | ENDIF |
---|
11289 | ENDDO |
---|
11290 | ENDDO |
---|
11291 | ENDDO |
---|
11292 | ENDIF |
---|
11293 | resorted = .TRUE. |
---|
11294 | ELSE |
---|
11295 | temp_array = nbins_av(:,:,:,ib) |
---|
11296 | to_be_resorted => temp_array |
---|
11297 | ENDIF |
---|
11298 | ENDIF |
---|
11299 | |
---|
11300 | ELSEIF ( variable(7:11) == 'm_bin' ) THEN |
---|
11301 | |
---|
11302 | READ( variable(12:),* ) char_to_int |
---|
11303 | IF ( char_to_int >= 1 .AND. char_to_int <= SUM( nbin ) ) THEN |
---|
11304 | |
---|
11305 | ib = char_to_int |
---|
11306 | IF ( av == 0 ) THEN |
---|
11307 | DO i = nxl, nxr |
---|
11308 | DO j = nys, nyn |
---|
11309 | DO k = nzb, nz_do3d |
---|
11310 | temp_bin = 0.0_wp |
---|
11311 | DO ic = ib, ncomponents_mass * nbins_aerosol, nbins_aerosol |
---|
11312 | temp_bin = temp_bin + aerosol_mass(ic)%conc(k,j,i) |
---|
11313 | ENDDO |
---|
11314 | tend(k,j,i) = temp_bin |
---|
11315 | ENDDO |
---|
11316 | ENDDO |
---|
11317 | ENDDO |
---|
11318 | IF ( .NOT. mask_surface(mid) ) THEN |
---|
11319 | DO i = 1, mask_size_l(mid,1) |
---|
11320 | DO j = 1, mask_size_l(mid,2) |
---|
11321 | DO k = 1, mask_size_l(mid,3) |
---|
11322 | local_pf(i,j,k) = tend( mask_k(mid,k), mask_j(mid,j), mask_i(mid,i) ) |
---|
11323 | ENDDO |
---|
11324 | ENDDO |
---|
11325 | ENDDO |
---|
11326 | ELSE |
---|
11327 | DO i = 1, mask_size_l(mid,1) |
---|
11328 | DO j = 1, mask_size_l(mid,2) |
---|
11329 | ! |
---|
11330 | !-- Get k index of the highest terraing surface |
---|
11331 | im = mask_i(mid,i) |
---|
11332 | jm = mask_j(mid,j) |
---|
11333 | ktt = MINLOC( MERGE( 1, 0, BTEST( wall_flags_0(:,jm,im), 5 )), DIM = 1 ) - 1 |
---|
11334 | DO k = 1, mask_size_l(mid,3) |
---|
11335 | kk = MIN( ktt+mask_k(mid,k), nzt+1 ) |
---|
11336 | ! |
---|
11337 | !-- Set value if not in building |
---|
11338 | IF ( BTEST( wall_flags_0(kk,jm,im), 6 ) ) THEN |
---|
11339 | local_pf(i,j,k) = fill_value |
---|
11340 | ELSE |
---|
11341 | local_pf(i,j,k) = tend(kk,jm,im) |
---|
11342 | ENDIF |
---|
11343 | ENDDO |
---|
11344 | ENDDO |
---|
11345 | ENDDO |
---|
11346 | ENDIF |
---|
11347 | resorted = .TRUE. |
---|
11348 | ELSE |
---|
11349 | temp_array = mbins_av(:,:,:,ib) |
---|
11350 | to_be_resorted => temp_array |
---|
11351 | ENDIF |
---|
11352 | ENDIF |
---|
11353 | |
---|
11354 | ELSE |
---|
11355 | SELECT CASE ( TRIM( variable(7:) ) ) |
---|
11356 | |
---|
11357 | CASE ( 'g_H2SO4', 'g_HNO3', 'g_NH3', 'g_OCNV', 'g_OCSV' ) |
---|
11358 | vari = TRIM( variable(7:) ) |
---|
11359 | IF ( av == 0 ) THEN |
---|
11360 | IF ( vari == 'g_H2SO4') to_be_resorted => salsa_gas(1)%conc |
---|
11361 | IF ( vari == 'g_HNO3') to_be_resorted => salsa_gas(2)%conc |
---|
11362 | IF ( vari == 'g_NH3') to_be_resorted => salsa_gas(3)%conc |
---|
11363 | IF ( vari == 'g_OCNV') to_be_resorted => salsa_gas(4)%conc |
---|
11364 | IF ( vari == 'g_OCSV') to_be_resorted => salsa_gas(5)%conc |
---|
11365 | ELSE |
---|
11366 | IF ( vari == 'g_H2SO4') to_be_resorted => g_h2so4_av |
---|
11367 | IF ( vari == 'g_HNO3') to_be_resorted => g_hno3_av |
---|
11368 | IF ( vari == 'g_NH3') to_be_resorted => g_nh3_av |
---|
11369 | IF ( vari == 'g_OCNV') to_be_resorted => g_ocnv_av |
---|
11370 | IF ( vari == 'g_OCSV') to_be_resorted => g_ocsv_av |
---|
11371 | ENDIF |
---|
11372 | |
---|
11373 | CASE ( 'LDSA' ) |
---|
11374 | IF ( av == 0 ) THEN |
---|
11375 | DO i = nxl, nxr |
---|
11376 | DO j = nys, nyn |
---|
11377 | DO k = nzb, nz_do3d |
---|
11378 | temp_bin = 0.0_wp |
---|
11379 | DO ib = 1, nbins_aerosol |
---|
11380 | ! |
---|
11381 | !-- Diameter in micrometres |
---|
11382 | mean_d = 1.0E+6_wp * ra_dry(k,j,i,ib) * 2.0_wp |
---|
11383 | ! |
---|
11384 | !-- Deposition factor: alveolar |
---|
11385 | df = ( 0.01555_wp / mean_d ) * ( EXP( -0.416_wp * ( LOG( mean_d ) + & |
---|
11386 | 2.84_wp )**2 ) + 19.11_wp * EXP( -0.482_wp * ( LOG( mean_d ) - & |
---|
11387 | 1.362_wp )**2 ) ) |
---|
11388 | ! |
---|
11389 | !-- Lung-deposited surface area LDSA (units mum2/cm3) |
---|
11390 | temp_bin = temp_bin + pi * mean_d**2 * df * 1.0E-6_wp * & |
---|
11391 | aerosol_number(ib)%conc(k,j,i) |
---|
11392 | ENDDO |
---|
11393 | tend(k,j,i) = temp_bin |
---|
11394 | ENDDO |
---|
11395 | ENDDO |
---|
11396 | ENDDO |
---|
11397 | IF ( .NOT. mask_surface(mid) ) THEN |
---|
11398 | DO i = 1, mask_size_l(mid,1) |
---|
11399 | DO j = 1, mask_size_l(mid,2) |
---|
11400 | DO k = 1, mask_size_l(mid,3) |
---|
11401 | local_pf(i,j,k) = tend( mask_k(mid,k), mask_j(mid,j), mask_i(mid,i) ) |
---|
11402 | ENDDO |
---|
11403 | ENDDO |
---|
11404 | ENDDO |
---|
11405 | ELSE |
---|
11406 | DO i = 1, mask_size_l(mid,1) |
---|
11407 | DO j = 1, mask_size_l(mid,2) |
---|
11408 | ! |
---|
11409 | !-- Get k index of the highest terraing surface |
---|
11410 | im = mask_i(mid,i) |
---|
11411 | jm = mask_j(mid,j) |
---|
11412 | ktt = MINLOC( MERGE( 1, 0, BTEST( wall_flags_0(:,jm,im), 5 )), DIM = 1 ) - 1 |
---|
11413 | DO k = 1, mask_size_l(mid,3) |
---|
11414 | kk = MIN( ktt+mask_k(mid,k), nzt+1 ) |
---|
11415 | ! |
---|
11416 | !-- Set value if not in building |
---|
11417 | IF ( BTEST( wall_flags_0(kk,jm,im), 6 ) ) THEN |
---|
11418 | local_pf(i,j,k) = fill_value |
---|
11419 | ELSE |
---|
11420 | local_pf(i,j,k) = tend(kk,jm,im) |
---|
11421 | ENDIF |
---|
11422 | ENDDO |
---|
11423 | ENDDO |
---|
11424 | ENDDO |
---|
11425 | ENDIF |
---|
11426 | resorted = .TRUE. |
---|
11427 | ELSE |
---|
11428 | to_be_resorted => ldsa_av |
---|
11429 | ENDIF |
---|
11430 | |
---|
11431 | CASE ( 'N_UFP' ) |
---|
11432 | IF ( av == 0 ) THEN |
---|
11433 | DO i = nxl, nxr |
---|
11434 | DO j = nys, nyn |
---|
11435 | DO k = nzb, nz_do3d |
---|
11436 | temp_bin = 0.0_wp |
---|
11437 | DO ib = 1, nbins_aerosol |
---|
11438 | IF ( 2.0_wp * ra_dry(k,j,i,ib) <= 0.1E-6_wp ) THEN |
---|
11439 | temp_bin = temp_bin + aerosol_number(ib)%conc(k,j,i) |
---|
11440 | ENDIF |
---|
11441 | ENDDO |
---|
11442 | tend(k,j,i) = temp_bin |
---|
11443 | ENDDO |
---|
11444 | ENDDO |
---|
11445 | ENDDO |
---|
11446 | IF ( .NOT. mask_surface(mid) ) THEN |
---|
11447 | DO i = 1, mask_size_l(mid,1) |
---|
11448 | DO j = 1, mask_size_l(mid,2) |
---|
11449 | DO k = 1, mask_size_l(mid,3) |
---|
11450 | local_pf(i,j,k) = tend( mask_k(mid,k), mask_j(mid,j), mask_i(mid,i) ) |
---|
11451 | ENDDO |
---|
11452 | ENDDO |
---|
11453 | ENDDO |
---|
11454 | ELSE |
---|
11455 | DO i = 1, mask_size_l(mid,1) |
---|
11456 | DO j = 1, mask_size_l(mid,2) |
---|
11457 | ! |
---|
11458 | !-- Get k index of the highest terraing surface |
---|
11459 | im = mask_i(mid,i) |
---|
11460 | jm = mask_j(mid,j) |
---|
11461 | ktt = MINLOC( MERGE( 1, 0, BTEST( wall_flags_0(:,jm,im), 5 )), DIM = 1 ) - 1 |
---|
11462 | DO k = 1, mask_size_l(mid,3) |
---|
11463 | kk = MIN( ktt+mask_k(mid,k), nzt+1 ) |
---|
11464 | ! |
---|
11465 | !-- Set value if not in building |
---|
11466 | IF ( BTEST( wall_flags_0(kk,jm,im), 6 ) ) THEN |
---|
11467 | local_pf(i,j,k) = fill_value |
---|
11468 | ELSE |
---|
11469 | local_pf(i,j,k) = tend(kk,jm,im) |
---|
11470 | ENDIF |
---|
11471 | ENDDO |
---|
11472 | ENDDO |
---|
11473 | ENDDO |
---|
11474 | ENDIF |
---|
11475 | resorted = .TRUE. |
---|
11476 | ELSE |
---|
11477 | to_be_resorted => nufp_av |
---|
11478 | ENDIF |
---|
11479 | |
---|
11480 | CASE ( 'Ntot' ) |
---|
11481 | IF ( av == 0 ) THEN |
---|
11482 | DO i = nxl, nxr |
---|
11483 | DO j = nys, nyn |
---|
11484 | DO k = nzb, nz_do3d |
---|
11485 | temp_bin = 0.0_wp |
---|
11486 | DO ib = 1, nbins_aerosol |
---|
11487 | temp_bin = temp_bin + aerosol_number(ib)%conc(k,j,i) |
---|
11488 | ENDDO |
---|
11489 | tend(k,j,i) = temp_bin |
---|
11490 | ENDDO |
---|
11491 | ENDDO |
---|
11492 | ENDDO |
---|
11493 | IF ( .NOT. mask_surface(mid) ) THEN |
---|
11494 | DO i = 1, mask_size_l(mid,1) |
---|
11495 | DO j = 1, mask_size_l(mid,2) |
---|
11496 | DO k = 1, mask_size_l(mid,3) |
---|
11497 | local_pf(i,j,k) = tend( mask_k(mid,k), mask_j(mid,j), mask_i(mid,i) ) |
---|
11498 | ENDDO |
---|
11499 | ENDDO |
---|
11500 | ENDDO |
---|
11501 | ELSE |
---|
11502 | DO i = 1, mask_size_l(mid,1) |
---|
11503 | DO j = 1, mask_size_l(mid,2) |
---|
11504 | ! |
---|
11505 | !-- Get k index of the highest terraing surface |
---|
11506 | im = mask_i(mid,i) |
---|
11507 | jm = mask_j(mid,j) |
---|
11508 | ktt = MINLOC( MERGE( 1, 0, BTEST( wall_flags_0(:,jm,im), 5 )), DIM = 1 ) - 1 |
---|
11509 | DO k = 1, mask_size_l(mid,3) |
---|
11510 | kk = MIN( ktt+mask_k(mid,k), nzt+1 ) |
---|
11511 | ! |
---|
11512 | !-- Set value if not in building |
---|
11513 | IF ( BTEST( wall_flags_0(kk,jm,im), 6 ) ) THEN |
---|
11514 | local_pf(i,j,k) = fill_value |
---|
11515 | ELSE |
---|
11516 | local_pf(i,j,k) = tend(kk,jm,im) |
---|
11517 | ENDIF |
---|
11518 | ENDDO |
---|
11519 | ENDDO |
---|
11520 | ENDDO |
---|
11521 | ENDIF |
---|
11522 | resorted = .TRUE. |
---|
11523 | ELSE |
---|
11524 | to_be_resorted => ntot_av |
---|
11525 | ENDIF |
---|
11526 | |
---|
11527 | CASE ( 'PM0.1' ) |
---|
11528 | IF ( av == 0 ) THEN |
---|
11529 | DO i = nxl, nxr |
---|
11530 | DO j = nys, nyn |
---|
11531 | DO k = nzb, nz_do3d |
---|
11532 | temp_bin = 0.0_wp |
---|
11533 | DO ib = 1, nbins_aerosol |
---|
11534 | IF ( 2.0_wp * ra_dry(k,j,i,ib) <= 0.1E-6_wp ) THEN |
---|
11535 | DO ic = ib, nbins_aerosol * ncc, nbins_aerosol |
---|
11536 | temp_bin = temp_bin + aerosol_mass(ic)%conc(k,j,i) |
---|
11537 | ENDDO |
---|
11538 | ENDIF |
---|
11539 | ENDDO |
---|
11540 | tend(k,j,i) = temp_bin |
---|
11541 | ENDDO |
---|
11542 | ENDDO |
---|
11543 | ENDDO |
---|
11544 | IF ( .NOT. mask_surface(mid) ) THEN |
---|
11545 | DO i = 1, mask_size_l(mid,1) |
---|
11546 | DO j = 1, mask_size_l(mid,2) |
---|
11547 | DO k = 1, mask_size_l(mid,3) |
---|
11548 | local_pf(i,j,k) = tend( mask_k(mid,k), mask_j(mid,j), mask_i(mid,i) ) |
---|
11549 | ENDDO |
---|
11550 | ENDDO |
---|
11551 | ENDDO |
---|
11552 | ELSE |
---|
11553 | DO i = 1, mask_size_l(mid,1) |
---|
11554 | DO j = 1, mask_size_l(mid,2) |
---|
11555 | ! |
---|
11556 | !-- Get k index of the highest terraing surface |
---|
11557 | im = mask_i(mid,i) |
---|
11558 | jm = mask_j(mid,j) |
---|
11559 | ktt = MINLOC( MERGE( 1, 0, BTEST( wall_flags_0(:,jm,im), 5 )), DIM = 1 ) - 1 |
---|
11560 | DO k = 1, mask_size_l(mid,3) |
---|
11561 | kk = MIN( ktt+mask_k(mid,k), nzt+1 ) |
---|
11562 | ! |
---|
11563 | !-- Set value if not in building |
---|
11564 | IF ( BTEST( wall_flags_0(kk,jm,im), 6 ) ) THEN |
---|
11565 | local_pf(i,j,k) = fill_value |
---|
11566 | ELSE |
---|
11567 | local_pf(i,j,k) = tend(kk,jm,im) |
---|
11568 | ENDIF |
---|
11569 | ENDDO |
---|
11570 | ENDDO |
---|
11571 | ENDDO |
---|
11572 | ENDIF |
---|
11573 | resorted = .TRUE. |
---|
11574 | ELSE |
---|
11575 | to_be_resorted => pm01_av |
---|
11576 | ENDIF |
---|
11577 | |
---|
11578 | CASE ( 'PM2.5' ) |
---|
11579 | IF ( av == 0 ) THEN |
---|
11580 | DO i = nxl, nxr |
---|
11581 | DO j = nys, nyn |
---|
11582 | DO k = nzb, nz_do3d |
---|
11583 | temp_bin = 0.0_wp |
---|
11584 | DO ib = 1, nbins_aerosol |
---|
11585 | IF ( 2.0_wp * ra_dry(k,j,i,ib) <= 2.5E-6_wp ) THEN |
---|
11586 | DO ic = ib, nbins_aerosol * ncc, nbins_aerosol |
---|
11587 | temp_bin = temp_bin + aerosol_mass(ic)%conc(k,j,i) |
---|
11588 | ENDDO |
---|
11589 | ENDIF |
---|
11590 | ENDDO |
---|
11591 | tend(k,j,i) = temp_bin |
---|
11592 | ENDDO |
---|
11593 | ENDDO |
---|
11594 | ENDDO |
---|
11595 | IF ( .NOT. mask_surface(mid) ) THEN |
---|
11596 | DO i = 1, mask_size_l(mid,1) |
---|
11597 | DO j = 1, mask_size_l(mid,2) |
---|
11598 | DO k = 1, mask_size_l(mid,3) |
---|
11599 | local_pf(i,j,k) = tend( mask_k(mid,k), mask_j(mid,j), mask_i(mid,i) ) |
---|
11600 | ENDDO |
---|
11601 | ENDDO |
---|
11602 | ENDDO |
---|
11603 | ELSE |
---|
11604 | DO i = 1, mask_size_l(mid,1) |
---|
11605 | DO j = 1, mask_size_l(mid,2) |
---|
11606 | ! |
---|
11607 | !-- Get k index of the highest terraing surface |
---|
11608 | im = mask_i(mid,i) |
---|
11609 | jm = mask_j(mid,j) |
---|
11610 | ktt = MINLOC( MERGE( 1, 0, BTEST( wall_flags_0(:,jm,im), 5 )), DIM = 1 ) - 1 |
---|
11611 | DO k = 1, mask_size_l(mid,3) |
---|
11612 | kk = MIN( ktt+mask_k(mid,k), nzt+1 ) |
---|
11613 | ! |
---|
11614 | !-- Set value if not in building |
---|
11615 | IF ( BTEST( wall_flags_0(kk,jm,im), 6 ) ) THEN |
---|
11616 | local_pf(i,j,k) = fill_value |
---|
11617 | ELSE |
---|
11618 | local_pf(i,j,k) = tend(kk,jm,im) |
---|
11619 | ENDIF |
---|
11620 | ENDDO |
---|
11621 | ENDDO |
---|
11622 | ENDDO |
---|
11623 | ENDIF |
---|
11624 | resorted = .TRUE. |
---|
11625 | ELSE |
---|
11626 | to_be_resorted => pm25_av |
---|
11627 | ENDIF |
---|
11628 | |
---|
11629 | CASE ( 'PM10' ) |
---|
11630 | IF ( av == 0 ) THEN |
---|
11631 | DO i = nxl, nxr |
---|
11632 | DO j = nys, nyn |
---|
11633 | DO k = nzb, nz_do3d |
---|
11634 | temp_bin = 0.0_wp |
---|
11635 | DO ib = 1, nbins_aerosol |
---|
11636 | IF ( 2.0_wp * ra_dry(k,j,i,ib) <= 10.0E-6_wp ) THEN |
---|
11637 | DO ic = ib, nbins_aerosol * ncc, nbins_aerosol |
---|
11638 | temp_bin = temp_bin + aerosol_mass(ic)%conc(k,j,i) |
---|
11639 | ENDDO |
---|
11640 | ENDIF |
---|
11641 | ENDDO |
---|
11642 | tend(k,j,i) = temp_bin |
---|
11643 | ENDDO |
---|
11644 | ENDDO |
---|
11645 | ENDDO |
---|
11646 | IF ( .NOT. mask_surface(mid) ) THEN |
---|
11647 | DO i = 1, mask_size_l(mid,1) |
---|
11648 | DO j = 1, mask_size_l(mid,2) |
---|
11649 | DO k = 1, mask_size_l(mid,3) |
---|
11650 | local_pf(i,j,k) = tend( mask_k(mid,k), mask_j(mid,j), mask_i(mid,i) ) |
---|
11651 | ENDDO |
---|
11652 | ENDDO |
---|
11653 | ENDDO |
---|
11654 | ELSE |
---|
11655 | DO i = 1, mask_size_l(mid,1) |
---|
11656 | DO j = 1, mask_size_l(mid,2) |
---|
11657 | ! |
---|
11658 | !-- Get k index of the highest terraing surface |
---|
11659 | im = mask_i(mid,i) |
---|
11660 | jm = mask_j(mid,j) |
---|
11661 | ktt = MINLOC( MERGE( 1, 0, BTEST( wall_flags_0(:,jm,im), 5 )), DIM = 1 ) - 1 |
---|
11662 | DO k = 1, mask_size_l(mid,3) |
---|
11663 | kk = MIN( ktt+mask_k(mid,k), nzt+1 ) |
---|
11664 | ! |
---|
11665 | !-- Set value if not in building |
---|
11666 | IF ( BTEST( wall_flags_0(kk,jm,im), 6 ) ) THEN |
---|
11667 | local_pf(i,j,k) = fill_value |
---|
11668 | ELSE |
---|
11669 | local_pf(i,j,k) = tend(kk,jm,im) |
---|
11670 | ENDIF |
---|
11671 | ENDDO |
---|
11672 | ENDDO |
---|
11673 | ENDDO |
---|
11674 | ENDIF |
---|
11675 | resorted = .TRUE. |
---|
11676 | ELSE |
---|
11677 | to_be_resorted => pm10_av |
---|
11678 | ENDIF |
---|
11679 | |
---|
11680 | CASE ( 's_BC', 's_DU', 's_NH', 's_NO', 's_OC', 's_SO4', 's_SS' ) |
---|
11681 | IF ( av == 0 ) THEN |
---|
11682 | IF ( is_used( prtcl, TRIM( variable(3:) ) ) ) THEN |
---|
11683 | found_index = get_index( prtcl, TRIM( variable(3:) ) ) |
---|
11684 | DO i = nxl, nxr |
---|
11685 | DO j = nys, nyn |
---|
11686 | DO k = nzb, nz_do3d |
---|
11687 | temp_bin = 0.0_wp |
---|
11688 | DO ic = ( found_index-1 ) * nbins_aerosol + 1, found_index * nbins_aerosol |
---|
11689 | temp_bin = temp_bin + aerosol_mass(ic)%conc(k,j,i) |
---|
11690 | ENDDO |
---|
11691 | tend(k,j,i) = temp_bin |
---|
11692 | ENDDO |
---|
11693 | ENDDO |
---|
11694 | ENDDO |
---|
11695 | ELSE |
---|
11696 | tend = 0.0_wp |
---|
11697 | ENDIF |
---|
11698 | IF ( .NOT. mask_surface(mid) ) THEN |
---|
11699 | DO i = 1, mask_size_l(mid,1) |
---|
11700 | DO j = 1, mask_size_l(mid,2) |
---|
11701 | DO k = 1, mask_size_l(mid,3) |
---|
11702 | local_pf(i,j,k) = tend( mask_k(mid,k), mask_j(mid,j), mask_i(mid,i) ) |
---|
11703 | ENDDO |
---|
11704 | ENDDO |
---|
11705 | ENDDO |
---|
11706 | ELSE |
---|
11707 | DO i = 1, mask_size_l(mid,1) |
---|
11708 | DO j = 1, mask_size_l(mid,2) |
---|
11709 | ! |
---|
11710 | !-- Get k index of the highest terraing surface |
---|
11711 | im = mask_i(mid,i) |
---|
11712 | jm = mask_j(mid,j) |
---|
11713 | ktt = MINLOC( MERGE( 1, 0, BTEST( wall_flags_0(:,jm,im), 5 )), DIM = 1 ) - 1 |
---|
11714 | DO k = 1, mask_size_l(mid,3) |
---|
11715 | kk = MIN( ktt+mask_k(mid,k), nzt+1 ) |
---|
11716 | ! |
---|
11717 | !-- Set value if not in building |
---|
11718 | IF ( BTEST( wall_flags_0(kk,jm,im), 6 ) ) THEN |
---|
11719 | local_pf(i,j,k) = fill_value |
---|
11720 | ELSE |
---|
11721 | local_pf(i,j,k) = tend(kk,jm,im) |
---|
11722 | ENDIF |
---|
11723 | ENDDO |
---|
11724 | ENDDO |
---|
11725 | ENDDO |
---|
11726 | ENDIF |
---|
11727 | resorted = .TRUE. |
---|
11728 | ELSE |
---|
11729 | ! |
---|
11730 | !-- 9: remove salsa_s_ from the beginning |
---|
11731 | IF ( TRIM( variable(9:) ) == 'BC' ) to_be_resorted => s_bc_av |
---|
11732 | IF ( TRIM( variable(9:) ) == 'DU' ) to_be_resorted => s_du_av |
---|
11733 | IF ( TRIM( variable(9:) ) == 'NH' ) to_be_resorted => s_nh_av |
---|
11734 | IF ( TRIM( variable(9:) ) == 'NO' ) to_be_resorted => s_no_av |
---|
11735 | IF ( TRIM( variable(9:) ) == 'OC' ) to_be_resorted => s_oc_av |
---|
11736 | IF ( TRIM( variable(9:) ) == 'SO4' ) to_be_resorted => s_so4_av |
---|
11737 | IF ( TRIM( variable(9:) ) == 'SS' ) to_be_resorted => s_ss_av |
---|
11738 | ENDIF |
---|
11739 | |
---|
11740 | CASE ( 's_H2O' ) |
---|
11741 | IF ( av == 0 ) THEN |
---|
11742 | found_index = get_index( prtcl, 'H2O' ) |
---|
11743 | DO i = nxl, nxr |
---|
11744 | DO j = nys, nyn |
---|
11745 | DO k = nzb, nz_do3d |
---|
11746 | temp_bin = 0.0_wp |
---|
11747 | DO ic = ( found_index-1 ) * nbins_aerosol + 1, found_index * nbins_aerosol |
---|
11748 | temp_bin = temp_bin + aerosol_mass(ic)%conc(k,j,i) |
---|
11749 | ENDDO |
---|
11750 | tend(k,j,i) = temp_bin |
---|
11751 | ENDDO |
---|
11752 | ENDDO |
---|
11753 | ENDDO |
---|
11754 | IF ( .NOT. mask_surface(mid) ) THEN |
---|
11755 | DO i = 1, mask_size_l(mid,1) |
---|
11756 | DO j = 1, mask_size_l(mid,2) |
---|
11757 | DO k = 1, mask_size_l(mid,3) |
---|
11758 | local_pf(i,j,k) = tend( mask_k(mid,k), mask_j(mid,j), mask_i(mid,i) ) |
---|
11759 | ENDDO |
---|
11760 | ENDDO |
---|
11761 | ENDDO |
---|
11762 | ELSE |
---|
11763 | DO i = 1, mask_size_l(mid,1) |
---|
11764 | DO j = 1, mask_size_l(mid,2) |
---|
11765 | ! |
---|
11766 | !-- Get k index of the highest terraing surface |
---|
11767 | im = mask_i(mid,i) |
---|
11768 | jm = mask_j(mid,j) |
---|
11769 | ktt = MINLOC( MERGE( 1, 0, BTEST( wall_flags_0(:,jm,im), 5 )), DIM = 1 ) - 1 |
---|
11770 | DO k = 1, mask_size_l(mid,3) |
---|
11771 | kk = MIN( ktt+mask_k(mid,k), nzt+1 ) |
---|
11772 | ! |
---|
11773 | !-- Set value if not in building |
---|
11774 | IF ( BTEST( wall_flags_0(kk,jm,im), 6 ) ) THEN |
---|
11775 | local_pf(i,j,k) = fill_value |
---|
11776 | ELSE |
---|
11777 | local_pf(i,j,k) = tend(kk,jm,im) |
---|
11778 | ENDIF |
---|
11779 | ENDDO |
---|
11780 | ENDDO |
---|
11781 | ENDDO |
---|
11782 | ENDIF |
---|
11783 | resorted = .TRUE. |
---|
11784 | ELSE |
---|
11785 | to_be_resorted => s_h2o_av |
---|
11786 | ENDIF |
---|
11787 | |
---|
11788 | CASE DEFAULT |
---|
11789 | found = .FALSE. |
---|
11790 | |
---|
11791 | END SELECT |
---|
11792 | ENDIF |
---|
11793 | |
---|
11794 | IF ( found .AND. .NOT. resorted ) THEN |
---|
11795 | IF ( .NOT. mask_surface(mid) ) THEN |
---|
11796 | ! |
---|
11797 | !-- Default masked output |
---|
11798 | DO i = 1, mask_size_l(mid,1) |
---|
11799 | DO j = 1, mask_size_l(mid,2) |
---|
11800 | DO k = 1, mask_size_l(mid,3) |
---|
11801 | local_pf(i,j,k) = to_be_resorted( mask_k(mid,k), mask_j(mid,j), mask_i(mid,i) ) |
---|
11802 | ENDDO |
---|
11803 | ENDDO |
---|
11804 | ENDDO |
---|
11805 | ELSE |
---|
11806 | ! |
---|
11807 | !-- Terrain-following masked output |
---|
11808 | DO i = 1, mask_size_l(mid,1) |
---|
11809 | DO j = 1, mask_size_l(mid,2) |
---|
11810 | !-- Get k index of the highest terraing surface |
---|
11811 | im = mask_i(mid,i) |
---|
11812 | jm = mask_j(mid,j) |
---|
11813 | ktt = MINLOC( MERGE( 1, 0, BTEST( wall_flags_0(:,jm,im), 5 )), DIM = 1 ) - 1 |
---|
11814 | DO k = 1, mask_size_l(mid,3) |
---|
11815 | kk = MIN( ktt+mask_k(mid,k), nzt+1 ) |
---|
11816 | !-- Set value if not in building |
---|
11817 | IF ( BTEST( wall_flags_0(kk,jm,im), 6 ) ) THEN |
---|
11818 | local_pf(i,j,k) = fill_value |
---|
11819 | ELSE |
---|
11820 | local_pf(i,j,k) = to_be_resorted(kk,jm,im) |
---|
11821 | ENDIF |
---|
11822 | ENDDO |
---|
11823 | ENDDO |
---|
11824 | ENDDO |
---|
11825 | ENDIF |
---|
11826 | ENDIF |
---|
11827 | |
---|
11828 | END SUBROUTINE salsa_data_output_mask |
---|
11829 | |
---|
11830 | !------------------------------------------------------------------------------! |
---|
11831 | ! Description: |
---|
11832 | ! ------------ |
---|
11833 | !> Creates index tables for different (aerosol) components |
---|
11834 | !------------------------------------------------------------------------------! |
---|
11835 | SUBROUTINE component_index_constructor( self, ncomp, nlist, listcomp ) |
---|
11836 | |
---|
11837 | IMPLICIT NONE |
---|
11838 | |
---|
11839 | INTEGER(iwp) :: ii !< |
---|
11840 | INTEGER(iwp) :: jj !< |
---|
11841 | |
---|
11842 | INTEGER(iwp), INTENT(in) :: nlist ! < Maximum number of components |
---|
11843 | |
---|
11844 | INTEGER(iwp), INTENT(inout) :: ncomp !< Number of components |
---|
11845 | |
---|
11846 | CHARACTER(LEN=3), INTENT(in) :: listcomp(nlist) !< List cof component names |
---|
11847 | |
---|
11848 | TYPE(component_index), INTENT(inout) :: self !< Object containing the indices of different |
---|
11849 | !< aerosol components |
---|
11850 | |
---|
11851 | ncomp = 0 |
---|
11852 | |
---|
11853 | DO WHILE ( listcomp(ncomp+1) /= ' ' .AND. ncomp < nlist ) |
---|
11854 | ncomp = ncomp + 1 |
---|
11855 | ENDDO |
---|
11856 | |
---|
11857 | self%ncomp = ncomp |
---|
11858 | ALLOCATE( self%ind(ncomp), self%comp(ncomp) ) |
---|
11859 | |
---|
11860 | DO ii = 1, ncomp |
---|
11861 | self%ind(ii) = ii |
---|
11862 | ENDDO |
---|
11863 | |
---|
11864 | jj = 1 |
---|
11865 | DO ii = 1, nlist |
---|
11866 | IF ( listcomp(ii) == '') CYCLE |
---|
11867 | self%comp(jj) = listcomp(ii) |
---|
11868 | jj = jj + 1 |
---|
11869 | ENDDO |
---|
11870 | |
---|
11871 | END SUBROUTINE component_index_constructor |
---|
11872 | |
---|
11873 | !------------------------------------------------------------------------------! |
---|
11874 | ! Description: |
---|
11875 | ! ------------ |
---|
11876 | !> Gives the index of a component in the component list |
---|
11877 | !------------------------------------------------------------------------------! |
---|
11878 | INTEGER FUNCTION get_index( self, incomp ) |
---|
11879 | |
---|
11880 | IMPLICIT NONE |
---|
11881 | |
---|
11882 | CHARACTER(LEN=*), INTENT(in) :: incomp !< Component name |
---|
11883 | |
---|
11884 | INTEGER(iwp) :: ii !< index |
---|
11885 | |
---|
11886 | TYPE(component_index), INTENT(in) :: self !< Object containing the indices of different |
---|
11887 | !< aerosol components |
---|
11888 | IF ( ANY( self%comp == incomp ) ) THEN |
---|
11889 | ii = 1 |
---|
11890 | DO WHILE ( (self%comp(ii) /= incomp) ) |
---|
11891 | ii = ii + 1 |
---|
11892 | ENDDO |
---|
11893 | get_index = ii |
---|
11894 | ELSEIF ( incomp == 'H2O' ) THEN |
---|
11895 | get_index = self%ncomp + 1 |
---|
11896 | ELSE |
---|
11897 | WRITE( message_string, * ) 'Incorrect component name given!' |
---|
11898 | CALL message( 'get_index', 'PA0591', 1, 2, 0, 6, 0 ) |
---|
11899 | ENDIF |
---|
11900 | |
---|
11901 | END FUNCTION get_index |
---|
11902 | |
---|
11903 | !------------------------------------------------------------------------------! |
---|
11904 | ! Description: |
---|
11905 | ! ------------ |
---|
11906 | !> Tells if the (aerosol) component is being used in the simulation |
---|
11907 | !------------------------------------------------------------------------------! |
---|
11908 | LOGICAL FUNCTION is_used( self, icomp ) |
---|
11909 | |
---|
11910 | IMPLICIT NONE |
---|
11911 | |
---|
11912 | CHARACTER(LEN=*), INTENT(in) :: icomp !< Component name |
---|
11913 | |
---|
11914 | TYPE(component_index), INTENT(in) :: self !< Object containing the indices of different |
---|
11915 | !< aerosol components |
---|
11916 | |
---|
11917 | IF ( ANY(self%comp == icomp) ) THEN |
---|
11918 | is_used = .TRUE. |
---|
11919 | ELSE |
---|
11920 | is_used = .FALSE. |
---|
11921 | ENDIF |
---|
11922 | |
---|
11923 | END FUNCTION |
---|
11924 | |
---|
11925 | END MODULE salsa_mod |
---|