1 | !> @file salsa_mod.f90 |
---|
2 | !--------------------------------------------------------------------------------! |
---|
3 | ! This file is part of PALM-4U. |
---|
4 | ! |
---|
5 | ! PALM-4U is free software: you can redistribute it and/or modify it under the |
---|
6 | ! terms of the GNU General Public License as published by the Free Software |
---|
7 | ! Foundation, either version 3 of the License, or (at your option) any later |
---|
8 | ! version. |
---|
9 | ! |
---|
10 | ! PALM-4U is distributed in the hope that it will be useful, but WITHOUT ANY |
---|
11 | ! WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS FOR |
---|
12 | ! A PARTICULAR PURPOSE. See the GNU General Public License for more details. |
---|
13 | ! |
---|
14 | ! You should have received a copy of the GNU General Public License along with |
---|
15 | ! PALM. If not, see <http://www.gnu.org/licenses/>. |
---|
16 | ! |
---|
17 | ! Copyright 2018-2019 University of Helsinki |
---|
18 | ! Copyright 1997-2020 Leibniz Universitaet Hannover |
---|
19 | !--------------------------------------------------------------------------------! |
---|
20 | ! |
---|
21 | ! Current revisions: |
---|
22 | ! ----------------- |
---|
23 | ! |
---|
24 | ! |
---|
25 | ! Former revisions: |
---|
26 | ! ----------------- |
---|
27 | ! $Id: salsa_mod.f90 4417 2020-02-20 19:19:33Z monakurppa $ |
---|
28 | ! Bug fixes and reformatting for the restart data and averaged data output |
---|
29 | ! - add missing arrays (averaged data output) in salsa_wrd_local and |
---|
30 | ! salsa_rrd_local |
---|
31 | ! - set write_binary_salsa and read_restart_data_salsa to .T. by default |
---|
32 | ! - restructure the average arrays for gases and total mass concentrations of |
---|
33 | ! chemical components: set to 4d arrays instead of separate arrays |
---|
34 | ! - add allocation checks for averaged data output arrays |
---|
35 | ! |
---|
36 | ! 4416 2020-02-20 17:53:57Z monakurppa |
---|
37 | ! Time index error in salsa_emission_setup |
---|
38 | ! |
---|
39 | ! 4380 2020-01-17 23:39:51Z monakurppa |
---|
40 | ! - Error in saving the surface fluxes in an array that is applied in the |
---|
41 | ! deposition scheme |
---|
42 | ! - Corrections in the header: aerosol bin diameters and lower bin limits not |
---|
43 | ! printed correctly |
---|
44 | ! |
---|
45 | ! 4364 2020-01-08 02:12:31Z monakurppa |
---|
46 | ! Set time coordinate in the input data relative to origin_time rather than to |
---|
47 | ! 00:00:00 UTC |
---|
48 | ! |
---|
49 | ! 4360 2020-01-07 11:25:50Z suehring |
---|
50 | ! Introduction of wall_flags_total_0, which currently sets bits based on static |
---|
51 | ! topography information used in wall_flags_static_0 |
---|
52 | ! |
---|
53 | ! 4342 2019-12-16 13:49:14Z Giersch |
---|
54 | ! cdc replaced by canopy_drag_coeff |
---|
55 | ! |
---|
56 | ! 4329 2019-12-10 15:46:36Z motisi |
---|
57 | ! Renamed wall_flags_0 to wall_flags_static_0 |
---|
58 | ! |
---|
59 | ! 4315 2019-12-02 09:20:07Z monakurppa |
---|
60 | ! Add an additional check for the time dimension PIDS_SALSA in |
---|
61 | ! salsa_emission_setup and correct some error message identifiers. |
---|
62 | ! |
---|
63 | ! 4298 2019-11-21 15:59:16Z suehring |
---|
64 | ! Bugfix, close netcdf input files after reading |
---|
65 | ! |
---|
66 | ! 4295 2019-11-14 06:15:31Z monakurppa |
---|
67 | ! |
---|
68 | ! |
---|
69 | ! 4280 2019-10-29 14:34:15Z monakurppa |
---|
70 | ! Corrected a bug in boundary conditions and fac_dt in offline nesting |
---|
71 | ! |
---|
72 | ! 4273 2019-10-24 13:40:54Z monakurppa |
---|
73 | ! - Rename nest_salsa to nesting_salsa |
---|
74 | ! - Correct some errors in boundary condition flags |
---|
75 | ! - Add a check for not trying to output gas concentrations in salsa if the |
---|
76 | ! chemistry module is applied |
---|
77 | ! - Set the default value of nesting_salsa and nesting_offline_salsa to .TRUE. |
---|
78 | ! |
---|
79 | ! 4272 2019-10-23 15:18:57Z schwenkel |
---|
80 | ! Further modularization of boundary conditions: moved boundary conditions to |
---|
81 | ! respective modules |
---|
82 | ! |
---|
83 | ! 4270 2019-10-23 10:46:20Z monakurppa |
---|
84 | ! - Implement offline nesting for salsa |
---|
85 | ! - Alphabetic ordering for module interfaces |
---|
86 | ! - Remove init_aerosol_type and init_gases_type from salsa_parin and define them |
---|
87 | ! based on the initializing_actions |
---|
88 | ! - parameter definition removed from "season" and "season_z01" is added to parin |
---|
89 | ! - bugfix in application of index_hh after implementing the new |
---|
90 | ! palm_date_time_mod |
---|
91 | ! - Reformat salsa emission data with LOD=2: size distribution given for each |
---|
92 | ! emission category |
---|
93 | ! |
---|
94 | ! 4268 2019-10-17 11:29:38Z schwenkel |
---|
95 | ! Moving module specific boundary conditions from time_integration to module |
---|
96 | ! |
---|
97 | ! 4256 2019-10-07 10:08:52Z monakurppa |
---|
98 | ! Document previous changes: use global variables nx, ny and nz in salsa_header |
---|
99 | ! |
---|
100 | ! 4227 2019-09-10 18:04:34Z gronemeier |
---|
101 | ! implement new palm_date_time_mod |
---|
102 | ! |
---|
103 | ! 4226 2019-09-10 17:03:24Z suehring |
---|
104 | ! Netcdf input routine for dimension length renamed |
---|
105 | ! |
---|
106 | ! 4182 2019-08-22 15:20:23Z scharf |
---|
107 | ! Corrected "Former revisions" section |
---|
108 | ! |
---|
109 | ! 4167 2019-08-16 11:01:48Z suehring |
---|
110 | ! Changed behaviour of masked output over surface to follow terrain and ignore |
---|
111 | ! buildings (J.Resler, T.Gronemeier) |
---|
112 | ! |
---|
113 | ! 4131 2019-08-02 11:06:18Z monakurppa |
---|
114 | ! - Add "salsa_" before each salsa output variable |
---|
115 | ! - Add a possibility to output the number (salsa_N_UFP) and mass concentration |
---|
116 | ! (salsa_PM0.1) of ultrafine particles, i.e. particles with a diameter smaller |
---|
117 | ! than 100 nm |
---|
118 | ! - Implement aerosol emission mode "parameterized" which is based on the street |
---|
119 | ! type (similar to the chemistry module). |
---|
120 | ! - Remove unnecessary nucleation subroutines. |
---|
121 | ! - Add the z-dimension for gaseous emissions to correspond the implementation |
---|
122 | ! in the chemistry module |
---|
123 | ! |
---|
124 | ! 4118 2019-07-25 16:11:45Z suehring |
---|
125 | ! - When Dirichlet condition is applied in decycling, the boundary conditions are |
---|
126 | ! only set at the ghost points and not at the prognostic grid points as done |
---|
127 | ! before |
---|
128 | ! - Rename decycle_ns/lr to decycle_salsa_ns/lr and decycle_method to |
---|
129 | ! decycle_method_salsa |
---|
130 | ! - Allocation and initialization of special advection flags salsa_advc_flags_s |
---|
131 | ! used for salsa. These are exclusively used for salsa variables to |
---|
132 | ! distinguish from the usually-used flags which might be different when |
---|
133 | ! decycling is applied in combination with cyclic boundary conditions. |
---|
134 | ! Moreover, salsa_advc_flags_s considers extended zones around buildings where |
---|
135 | ! the first-order upwind scheme is applied for the horizontal advection terms. |
---|
136 | ! This is done to overcome high concentration peaks due to stationary numerical |
---|
137 | ! oscillations caused by horizontal advection discretization. |
---|
138 | ! |
---|
139 | ! 4117 2019-07-25 08:54:02Z monakurppa |
---|
140 | ! Pass integer flag array as well as boundary flags to WS scalar advection |
---|
141 | ! routine |
---|
142 | ! |
---|
143 | ! 4109 2019-07-22 17:00:34Z suehring |
---|
144 | ! Slightly revise setting of boundary conditions at horizontal walls, use |
---|
145 | ! data-structure offset index instead of pre-calculate it for each facing |
---|
146 | ! |
---|
147 | ! 4079 2019-07-09 18:04:41Z suehring |
---|
148 | ! Application of monotonic flux limiter for the vertical scalar advection |
---|
149 | ! up to the topography top (only for the cache-optimized version at the |
---|
150 | ! moment). |
---|
151 | ! |
---|
152 | ! 4069 2019-07-01 14:05:51Z Giersch |
---|
153 | ! Masked output running index mid has been introduced as a local variable to |
---|
154 | ! avoid runtime error (Loop variable has been modified) in time_integration |
---|
155 | ! |
---|
156 | ! 4058 2019-06-27 15:25:42Z knoop |
---|
157 | ! Bugfix: to_be_resorted was uninitialized in case of s_H2O in 3d_data_averaging |
---|
158 | ! |
---|
159 | ! 4012 2019-05-31 15:19:05Z monakurppa |
---|
160 | ! Merge salsa branch to trunk. List of changes: |
---|
161 | ! - Error corrected in distr_update that resulted in the aerosol number size |
---|
162 | ! distribution not converging if the concentration was nclim. |
---|
163 | ! - Added a separate output for aerosol liquid water (s_H2O) |
---|
164 | ! - aerosol processes for a size bin are now calculated only if the aerosol |
---|
165 | ! number of concentration of that bin is > 2*nclim |
---|
166 | ! - An initialisation error in the subroutine "deposition" corrected and the |
---|
167 | ! subroutine reformatted. |
---|
168 | ! - stuff from salsa_util_mod.f90 moved into salsa_mod.f90 |
---|
169 | ! - calls for closing the netcdf input files added |
---|
170 | ! |
---|
171 | ! 3956 2019-05-07 12:32:52Z monakurppa |
---|
172 | ! - Conceptual bug in depo_surf correct for urban and land surface model |
---|
173 | ! - Subroutine salsa_tendency_ij optimized. |
---|
174 | ! - Interfaces salsa_non_advective_processes and salsa_exchange_horiz_bounds |
---|
175 | ! created. These are now called in module_interface. |
---|
176 | ! salsa_exchange_horiz_bounds after calling salsa_driver only when needed |
---|
177 | ! (i.e. every dt_salsa). |
---|
178 | ! |
---|
179 | ! 3924 2019-04-23 09:33:06Z monakurppa |
---|
180 | ! Correct a bug introduced by the previous update. |
---|
181 | ! |
---|
182 | ! 3899 2019-04-16 14:05:27Z monakurppa |
---|
183 | ! - remove unnecessary error / location messages |
---|
184 | ! - corrected some error message numbers |
---|
185 | ! - allocate source arrays only if emissions or dry deposition is applied. |
---|
186 | ! |
---|
187 | ! 3885 2019-04-11 11:29:34Z kanani |
---|
188 | ! Changes related to global restructuring of location messages and introduction |
---|
189 | ! of additional debug messages |
---|
190 | ! |
---|
191 | ! 3876 2019-04-08 18:41:49Z knoop |
---|
192 | ! Introduced salsa_actions module interface |
---|
193 | ! |
---|
194 | ! 3871 2019-04-08 14:38:39Z knoop |
---|
195 | ! Major changes in formatting, performance and data input structure (see branch |
---|
196 | ! the history for details) |
---|
197 | ! - Time-dependent emissions enabled: lod=1 for yearly PM emissions that are |
---|
198 | ! normalised depending on the time, and lod=2 for preprocessed emissions |
---|
199 | ! (similar to the chemistry module). |
---|
200 | ! - Additionally, 'uniform' emissions allowed. This emission is set constant on |
---|
201 | ! all horisontal upward facing surfaces and it is created based on parameters |
---|
202 | ! surface_aerosol_flux, aerosol_flux_dpg/sigmag/mass_fracs_a/mass_fracs_b. |
---|
203 | ! - All emissions are now implemented as surface fluxes! No 3D sources anymore. |
---|
204 | ! - Update the emission information by calling salsa_emission_update if |
---|
205 | ! skip_time_do_salsa >= time_since_reference_point and |
---|
206 | ! next_aero_emission_update <= time_since_reference_point |
---|
207 | ! - Aerosol background concentrations read from PIDS_DYNAMIC. The vertical grid |
---|
208 | ! must match the one applied in the model. |
---|
209 | ! - Gas emissions and background concentrations can be also read in in salsa_mod |
---|
210 | ! if the chemistry module is not applied. |
---|
211 | ! - In deposition, information on the land use type can be now imported from |
---|
212 | ! the land use model |
---|
213 | ! - Use SI units in PARIN, i.e. n_lognorm given in #/m3 and dpg in metres. |
---|
214 | ! - Apply 100 character line limit |
---|
215 | ! - Change all variable names from capital to lowercase letter |
---|
216 | ! - Change real exponents to integer if possible. If not, precalculate the value |
---|
217 | ! value of exponent |
---|
218 | ! - Rename in1a to start_subrange_1a, fn2a to end_subrange_1a etc. |
---|
219 | ! - Rename nbins --> nbins_aerosol, ncc_tot --> ncomponents_mass and ngast --> |
---|
220 | ! ngases_salsa |
---|
221 | ! - Rename ibc to index_bc, idu to index_du etc. |
---|
222 | ! - Renamed loop indices b, c and sg to ib, ic and ig |
---|
223 | ! - run_salsa subroutine removed |
---|
224 | ! - Corrected a bud in salsa_driver: falsely applied ino instead of inh |
---|
225 | ! - Call salsa_tendency within salsa_prognostic_equations which is called in |
---|
226 | ! module_interface_mod instead of prognostic_equations_mod |
---|
227 | ! - Removed tailing white spaces and unused variables |
---|
228 | ! - Change error message to start by PA instead of SA |
---|
229 | ! |
---|
230 | ! 3833 2019-03-28 15:04:04Z forkel |
---|
231 | ! added USE chem_gasphase_mod for nvar, nspec and spc_names |
---|
232 | ! |
---|
233 | ! 3787 2019-03-07 08:43:54Z raasch |
---|
234 | ! unused variables removed |
---|
235 | ! |
---|
236 | ! 3780 2019-03-05 11:19:45Z forkel |
---|
237 | ! unused variable for file index removed from rrd-subroutines parameter list |
---|
238 | ! |
---|
239 | ! 3685 2019-01-21 01:02:11Z knoop |
---|
240 | ! Some interface calls moved to module_interface + cleanup |
---|
241 | ! |
---|
242 | ! 3655 2019-01-07 16:51:22Z knoop |
---|
243 | ! Implementation of the PALM module interface |
---|
244 | ! 3412 2018-10-24 07:25:57Z monakurppa |
---|
245 | ! |
---|
246 | ! Authors: |
---|
247 | ! -------- |
---|
248 | ! @author Mona Kurppa (University of Helsinki) |
---|
249 | ! |
---|
250 | ! |
---|
251 | ! Description: |
---|
252 | ! ------------ |
---|
253 | !> Sectional aerosol module for large scale applications SALSA |
---|
254 | !> (Kokkola et al., 2008, ACP 8, 2469-2483). Solves the aerosol number and mass |
---|
255 | !> concentration as well as chemical composition. Includes aerosol dynamic |
---|
256 | !> processes: nucleation, condensation/evaporation of vapours, coagulation and |
---|
257 | !> deposition on tree leaves, ground and roofs. |
---|
258 | !> Implementation is based on formulations implemented in UCLALES-SALSA except |
---|
259 | !> for deposition which is based on parametrisations by Zhang et al. (2001, |
---|
260 | !> Atmos. Environ. 35, 549-560) or Petroff&Zhang (2010, Geosci. Model Dev. 3, |
---|
261 | !> 753-769) |
---|
262 | !> |
---|
263 | !> @todo Apply information from emission_stack_height to lift emission sources |
---|
264 | !> @todo Allow insoluble emissions |
---|
265 | !------------------------------------------------------------------------------! |
---|
266 | MODULE salsa_mod |
---|
267 | |
---|
268 | USE basic_constants_and_equations_mod, & |
---|
269 | ONLY: c_p, g, p_0, pi, r_d |
---|
270 | |
---|
271 | USE chem_gasphase_mod, & |
---|
272 | ONLY: nspec, nvar, spc_names |
---|
273 | |
---|
274 | USE chem_modules, & |
---|
275 | ONLY: call_chem_at_all_substeps, chem_gasphase_on, chem_species |
---|
276 | |
---|
277 | USE control_parameters, & |
---|
278 | ONLY: air_chemistry, bc_dirichlet_l, bc_dirichlet_n, bc_dirichlet_r, bc_dirichlet_s, & |
---|
279 | bc_lr, bc_lr_cyc, bc_ns, bc_ns_cyc, bc_radiation_l, bc_radiation_n, bc_radiation_r, & |
---|
280 | bc_radiation_s, coupling_char, debug_output, dt_3d, intermediate_timestep_count, & |
---|
281 | intermediate_timestep_count_max, land_surface, max_pr_salsa, message_string, & |
---|
282 | monotonic_limiter_z, plant_canopy, pt_surface, salsa, scalar_advec, & |
---|
283 | surface_pressure, time_since_reference_point, timestep_scheme, tsc, urban_surface, & |
---|
284 | ws_scheme_sca |
---|
285 | |
---|
286 | USE indices, & |
---|
287 | ONLY: nbgp, nx, nxl, nxlg, nxr, nxrg, ny, nyn, nyng, nys, nysg, nzb, nz, nzt, & |
---|
288 | wall_flags_total_0 |
---|
289 | |
---|
290 | USE kinds |
---|
291 | |
---|
292 | USE netcdf_data_input_mod, & |
---|
293 | ONLY: chem_emis_att_type, chem_emis_val_type |
---|
294 | |
---|
295 | USE pegrid |
---|
296 | |
---|
297 | USE statistics, & |
---|
298 | ONLY: sums_salsa_ws_l |
---|
299 | |
---|
300 | IMPLICIT NONE |
---|
301 | ! |
---|
302 | !-- SALSA constants: |
---|
303 | ! |
---|
304 | !-- Local constants: |
---|
305 | INTEGER(iwp), PARAMETER :: luc_urban = 15 !< default landuse type for urban |
---|
306 | INTEGER(iwp), PARAMETER :: ngases_salsa = 5 !< total number of gaseous tracers: |
---|
307 | !< 1 = H2SO4, 2 = HNO3, 3 = NH3, 4 = OCNV |
---|
308 | !< (non-volatile OC), 5 = OCSV (semi-volatile) |
---|
309 | INTEGER(iwp), PARAMETER :: nmod = 7 !< number of modes for initialising the aerosol size distribution |
---|
310 | INTEGER(iwp), PARAMETER :: nreg = 2 !< Number of main size subranges |
---|
311 | INTEGER(iwp), PARAMETER :: maxspec = 7 !< Max. number of aerosol species |
---|
312 | |
---|
313 | |
---|
314 | REAL(wp), PARAMETER :: fill_value = -9999.0_wp !< value for the _FillValue attribute |
---|
315 | ! |
---|
316 | !-- Universal constants |
---|
317 | REAL(wp), PARAMETER :: abo = 1.380662E-23_wp !< Boltzmann constant (J/K) |
---|
318 | REAL(wp), PARAMETER :: alv = 2.260E+6_wp !< latent heat for H2O vaporisation (J/kg) |
---|
319 | REAL(wp), PARAMETER :: alv_d_rv = 4896.96865_wp !< alv / rv |
---|
320 | REAL(wp), PARAMETER :: am_airmol = 4.8096E-26_wp !< Average mass of an air molecule (Jacobson 2005, Eq.2.3) |
---|
321 | REAL(wp), PARAMETER :: api6 = 0.5235988_wp !< pi / 6 |
---|
322 | REAL(wp), PARAMETER :: argas = 8.314409_wp !< Gas constant (J/(mol K)) |
---|
323 | REAL(wp), PARAMETER :: argas_d_cpd = 8.281283865E-3_wp !< argas per cpd |
---|
324 | REAL(wp), PARAMETER :: avo = 6.02214E+23_wp !< Avogadro constant (1/mol) |
---|
325 | REAL(wp), PARAMETER :: d_sa = 5.539376964394570E-10_wp !< diameter of condensing H2SO4 molecule (m) |
---|
326 | REAL(wp), PARAMETER :: for_ppm_to_nconc = 7.243016311E+16_wp !< ppm * avo / R (K/(Pa*m3)) |
---|
327 | REAL(wp), PARAMETER :: epsoc = 0.15_wp !< water uptake of organic material |
---|
328 | REAL(wp), PARAMETER :: mclim = 1.0E-23_wp !< mass concentration min limit (kg/m3) |
---|
329 | REAL(wp), PARAMETER :: n3 = 158.79_wp !< Number of H2SO4 molecules in 3 nm cluster if d_sa=5.54e-10m |
---|
330 | REAL(wp), PARAMETER :: nclim = 1.0_wp !< number concentration min limit (#/m3) |
---|
331 | REAL(wp), PARAMETER :: surfw0 = 0.073_wp !< surface tension of water at 293 K (J/m2) |
---|
332 | ! |
---|
333 | !-- Molar masses in kg/mol |
---|
334 | REAL(wp), PARAMETER :: ambc = 12.0E-3_wp !< black carbon (BC) |
---|
335 | REAL(wp), PARAMETER :: amdair = 28.970E-3_wp !< dry air |
---|
336 | REAL(wp), PARAMETER :: amdu = 100.0E-3_wp !< mineral dust |
---|
337 | REAL(wp), PARAMETER :: amh2o = 18.0154E-3_wp !< H2O |
---|
338 | REAL(wp), PARAMETER :: amh2so4 = 98.06E-3_wp !< H2SO4 |
---|
339 | REAL(wp), PARAMETER :: amhno3 = 63.01E-3_wp !< HNO3 |
---|
340 | REAL(wp), PARAMETER :: amn2o = 44.013E-3_wp !< N2O |
---|
341 | REAL(wp), PARAMETER :: amnh3 = 17.031E-3_wp !< NH3 |
---|
342 | REAL(wp), PARAMETER :: amo2 = 31.9988E-3_wp !< O2 |
---|
343 | REAL(wp), PARAMETER :: amo3 = 47.998E-3_wp !< O3 |
---|
344 | REAL(wp), PARAMETER :: amoc = 150.0E-3_wp !< organic carbon (OC) |
---|
345 | REAL(wp), PARAMETER :: amss = 58.44E-3_wp !< sea salt (NaCl) |
---|
346 | ! |
---|
347 | !-- Densities in kg/m3 |
---|
348 | REAL(wp), PARAMETER :: arhobc = 2000.0_wp !< black carbon |
---|
349 | REAL(wp), PARAMETER :: arhodu = 2650.0_wp !< mineral dust |
---|
350 | REAL(wp), PARAMETER :: arhoh2o = 1000.0_wp !< H2O |
---|
351 | REAL(wp), PARAMETER :: arhoh2so4 = 1830.0_wp !< SO4 |
---|
352 | REAL(wp), PARAMETER :: arhohno3 = 1479.0_wp !< HNO3 |
---|
353 | REAL(wp), PARAMETER :: arhonh3 = 1530.0_wp !< NH3 |
---|
354 | REAL(wp), PARAMETER :: arhooc = 2000.0_wp !< organic carbon |
---|
355 | REAL(wp), PARAMETER :: arhoss = 2165.0_wp !< sea salt (NaCl) |
---|
356 | ! |
---|
357 | !-- Volume of molecule in m3/# |
---|
358 | REAL(wp), PARAMETER :: amvh2o = amh2o /avo / arhoh2o !< H2O |
---|
359 | REAL(wp), PARAMETER :: amvh2so4 = amh2so4 / avo / arhoh2so4 !< SO4 |
---|
360 | REAL(wp), PARAMETER :: amvhno3 = amhno3 / avo / arhohno3 !< HNO3 |
---|
361 | REAL(wp), PARAMETER :: amvnh3 = amnh3 / avo / arhonh3 !< NH3 |
---|
362 | REAL(wp), PARAMETER :: amvoc = amoc / avo / arhooc !< OC |
---|
363 | REAL(wp), PARAMETER :: amvss = amss / avo / arhoss !< sea salt |
---|
364 | ! |
---|
365 | !-- Constants for the dry deposition model by Petroff and Zhang (2010): |
---|
366 | !-- obstacle characteristic dimension "L" (cm) (plane obstacle by default) and empirical constants |
---|
367 | !-- C_B, C_IN, C_IM, beta_IM and C_IT for each land use category (15, as in Zhang et al. (2001)) |
---|
368 | REAL(wp), DIMENSION(1:15), PARAMETER :: l_p10 = & |
---|
369 | (/0.15, 4.0, 0.15, 3.0, 3.0, 0.5, 3.0, -99., 0.5, 2.0, 1.0, -99., -99., -99., 3.0/) |
---|
370 | REAL(wp), DIMENSION(1:15), PARAMETER :: c_b_p10 = & |
---|
371 | (/0.887, 1.262, 0.887, 1.262, 1.262, 0.996, 0.996, -99., 0.7, 0.93, 0.996, -99., -99., -99., 1.262/) |
---|
372 | REAL(wp), DIMENSION(1:15), PARAMETER :: c_in_p10 = & |
---|
373 | (/0.81, 0.216, 0.81, 0.216, 0.216, 0.191, 0.162, -99., 0.7, 0.14, 0.162, -99., -99., -99., 0.216/) |
---|
374 | REAL(wp), DIMENSION(1:15), PARAMETER :: c_im_p10 = & |
---|
375 | (/0.162, 0.13, 0.162, 0.13, 0.13, 0.191, 0.081, -99., 0.191,0.086,0.081, -99., -99., -99., 0.13/) |
---|
376 | REAL(wp), DIMENSION(1:15), PARAMETER :: beta_im_p10 = & |
---|
377 | (/0.6, 0.47, 0.6, 0.47, 0.47, 0.47, 0.47, -99., 0.6, 0.47, 0.47, -99., -99., -99., 0.47/) |
---|
378 | REAL(wp), DIMENSION(1:15), PARAMETER :: c_it_p10 = & |
---|
379 | (/0.0, 0.056, 0.0, 0.056, 0.056, 0.042, 0.056, -99., 0.042,0.014,0.056, -99., -99., -99., 0.056/) |
---|
380 | ! |
---|
381 | !-- Constants for the dry deposition model by Zhang et al. (2001): |
---|
382 | !-- empirical constants "alpha" and "gamma" and characteristic radius "A" for |
---|
383 | !-- each land use category (15) and season (5) |
---|
384 | REAL(wp), DIMENSION(1:15), PARAMETER :: alpha_z01 = & |
---|
385 | (/1.0, 0.6, 1.1, 0.8, 0.8, 1.2, 1.2, 50.0, 50.0, 1.3, 2.0, 50.0, 100.0, 100.0, 1.5/) |
---|
386 | REAL(wp), DIMENSION(1:15), PARAMETER :: gamma_z01 = & |
---|
387 | (/0.56, 0.58, 0.56, 0.56, 0.56, 0.54, 0.54, 0.54, 0.54, 0.54, 0.54, 0.54, 0.50, 0.50, 0.56/) |
---|
388 | REAL(wp), DIMENSION(1:15,1:5), PARAMETER :: A_z01 = RESHAPE( (/& |
---|
389 | 2.0, 5.0, 2.0, 5.0, 5.0, 2.0, 2.0, -99., -99., 10.0, 10.0, -99., -99., -99., 10.0,& ! SC1 |
---|
390 | 2.0, 5.0, 2.0, 5.0, 5.0, 2.0, 2.0, -99., -99., 10.0, 10.0, -99., -99., -99., 10.0,& ! SC2 |
---|
391 | 2.0, 5.0, 5.0, 10.0, 5.0, 5.0, 5.0, -99., -99., 10.0, 10.0, -99., -99., -99., 10.0,& ! SC3 |
---|
392 | 2.0, 5.0, 5.0, 10.0, 5.0, 5.0, 5.0, -99., -99., 10.0, 10.0, -99., -99., -99., 10.0,& ! SC4 |
---|
393 | 2.0, 5.0, 2.0, 5.0, 5.0, 2.0, 2.0, -99., -99., 10.0, 10.0, -99., -99., -99., 10.0 & ! SC5 |
---|
394 | /), (/ 15, 5 /) ) |
---|
395 | !-- Land use categories (based on Z01 but the same applies here also for P10): |
---|
396 | !-- 1 = evergreen needleleaf trees, |
---|
397 | !-- 2 = evergreen broadleaf trees, |
---|
398 | !-- 3 = deciduous needleleaf trees, |
---|
399 | !-- 4 = deciduous broadleaf trees, |
---|
400 | !-- 5 = mixed broadleaf and needleleaf trees (deciduous broadleaf trees for P10), |
---|
401 | !-- 6 = grass (short grass for P10), |
---|
402 | !-- 7 = crops, mixed farming, |
---|
403 | !-- 8 = desert, |
---|
404 | !-- 9 = tundra, |
---|
405 | !-- 10 = shrubs and interrupted woodlands (thorn shrubs for P10), |
---|
406 | !-- 11 = wetland with plants (long grass for P10) |
---|
407 | !-- 12 = ice cap and glacier, |
---|
408 | !-- 13 = inland water (inland lake for P10) |
---|
409 | !-- 14 = ocean (water for P10), |
---|
410 | !-- 15 = urban |
---|
411 | ! |
---|
412 | !-- SALSA variables: |
---|
413 | CHARACTER(LEN=20) :: bc_salsa_b = 'neumann' !< bottom boundary condition |
---|
414 | CHARACTER(LEN=20) :: bc_salsa_t = 'neumann' !< top boundary condition |
---|
415 | CHARACTER(LEN=20) :: depo_pcm_par = 'zhang2001' !< or 'petroff2010' |
---|
416 | CHARACTER(LEN=20) :: depo_pcm_type = 'deciduous_broadleaf' !< leaf type |
---|
417 | CHARACTER(LEN=20) :: depo_surf_par = 'zhang2001' !< or 'petroff2010' |
---|
418 | CHARACTER(LEN=100) :: input_file_dynamic = 'PIDS_DYNAMIC' !< file name for dynamic input |
---|
419 | CHARACTER(LEN=100) :: input_file_salsa = 'PIDS_SALSA' !< file name for emission data |
---|
420 | CHARACTER(LEN=20) :: salsa_emission_mode = 'no_emission' !< 'no_emission', 'uniform', |
---|
421 | !< 'parameterized', 'read_from_file' |
---|
422 | |
---|
423 | CHARACTER(LEN=20), DIMENSION(4) :: decycle_method_salsa = & |
---|
424 | (/'dirichlet','dirichlet','dirichlet','dirichlet'/) |
---|
425 | !< Decycling method at horizontal boundaries |
---|
426 | !< 1=left, 2=right, 3=south, 4=north |
---|
427 | !< dirichlet = initial profiles for the ghost and first 3 layers |
---|
428 | !< neumann = zero gradient |
---|
429 | |
---|
430 | CHARACTER(LEN=3), DIMENSION(maxspec) :: listspec = & !< Active aerosols |
---|
431 | (/'SO4',' ',' ',' ',' ',' ',' '/) |
---|
432 | |
---|
433 | INTEGER(iwp) :: depo_pcm_par_num = 1 !< parametrisation type: 1=zhang2001, 2=petroff2010 |
---|
434 | INTEGER(iwp) :: depo_pcm_type_num = 0 !< index for the dry deposition type on the plant canopy |
---|
435 | INTEGER(iwp) :: depo_surf_par_num = 1 !< parametrisation type: 1=zhang2001, 2=petroff2010 |
---|
436 | INTEGER(iwp) :: end_subrange_1a = 1 !< last index for bin subrange 1a |
---|
437 | INTEGER(iwp) :: end_subrange_2a = 1 !< last index for bin subrange 2a |
---|
438 | INTEGER(iwp) :: end_subrange_2b = 1 !< last index for bin subrange 2b |
---|
439 | INTEGER(iwp) :: ibc_salsa_b !< index for the bottom boundary condition |
---|
440 | INTEGER(iwp) :: ibc_salsa_t !< index for the top boundary condition |
---|
441 | INTEGER(iwp) :: index_bc = -1 !< index for black carbon (BC) |
---|
442 | INTEGER(iwp) :: index_du = -1 !< index for dust |
---|
443 | INTEGER(iwp) :: index_nh = -1 !< index for NH3 |
---|
444 | INTEGER(iwp) :: index_no = -1 !< index for HNO3 |
---|
445 | INTEGER(iwp) :: index_oc = -1 !< index for organic carbon (OC) |
---|
446 | INTEGER(iwp) :: index_so4 = -1 !< index for SO4 or H2SO4 |
---|
447 | INTEGER(iwp) :: index_ss = -1 !< index for sea salt |
---|
448 | INTEGER(iwp) :: init_aerosol_type = 0 !< Initial size distribution type |
---|
449 | !< 0 = uniform (read from PARIN) |
---|
450 | !< 1 = read vertical profiles from an input file |
---|
451 | INTEGER(iwp) :: init_gases_type = 0 !< Initial gas concentration type |
---|
452 | !< 0 = uniform (read from PARIN) |
---|
453 | !< 1 = read vertical profiles from an input file |
---|
454 | INTEGER(iwp) :: lod_gas_emissions = 0 !< level of detail of the gaseous emission data |
---|
455 | INTEGER(iwp) :: main_street_id = 0 !< lower bound of main street IDs for parameterized emission mode |
---|
456 | INTEGER(iwp) :: max_street_id = 0 !< upper bound of main street IDs for parameterized emission mode |
---|
457 | INTEGER(iwp) :: nbins_aerosol = 1 !< total number of size bins |
---|
458 | INTEGER(iwp) :: ncc = 1 !< number of chemical components used |
---|
459 | INTEGER(iwp) :: ncomponents_mass = 1 !< total number of chemical compounds (ncc+1) |
---|
460 | !< if particle water is advected) |
---|
461 | INTEGER(iwp) :: nj3 = 1 !< J3 parametrization (nucleation) |
---|
462 | !< 1 = condensational sink (Kerminen&Kulmala, 2002) |
---|
463 | !< 2 = coagulational sink (Lehtinen et al. 2007) |
---|
464 | !< 3 = coagS+self-coagulation (Anttila et al. 2010) |
---|
465 | INTEGER(iwp) :: nsnucl = 0 !< Choice of the nucleation scheme: |
---|
466 | !< 0 = off |
---|
467 | !< 1 = binary nucleation |
---|
468 | !< 2 = activation type nucleation |
---|
469 | !< 3 = kinetic nucleation |
---|
470 | !< 4 = ternary nucleation |
---|
471 | !< 5 = nucleation with ORGANICs |
---|
472 | !< 6 = activation type of nucleation with H2SO4+ORG |
---|
473 | !< 7 = heteromolecular nucleation with H2SO4*ORG |
---|
474 | !< 8 = homomolecular nucleation of H2SO4 |
---|
475 | !< + heteromolecular nucleation with H2SO4*ORG |
---|
476 | !< 9 = homomolecular nucleation of H2SO4 and ORG |
---|
477 | !< + heteromolecular nucleation with H2SO4*ORG |
---|
478 | INTEGER(iwp) :: salsa_pr_count = 0 !< counter for salsa variable profiles |
---|
479 | INTEGER(iwp) :: season_z01 = 1 !< For dry deposition by Zhang et al.: 1 = summer, |
---|
480 | !< 2 = autumn (no harvest yet), 3 = late autumn |
---|
481 | !< (already frost), 4 = winter, 5 = transitional spring |
---|
482 | INTEGER(iwp) :: side_street_id = 0 !< lower bound of side street IDs for parameterized emission mode |
---|
483 | INTEGER(iwp) :: start_subrange_1a = 1 !< start index for bin subranges: subrange 1a |
---|
484 | INTEGER(iwp) :: start_subrange_2a = 1 !< subrange 2a |
---|
485 | INTEGER(iwp) :: start_subrange_2b = 1 !< subrange 2b |
---|
486 | |
---|
487 | INTEGER(iwp), DIMENSION(nreg) :: nbin = (/ 3, 7/) !< Number of size bins per subrange: 1 & 2 |
---|
488 | |
---|
489 | INTEGER(iwp), DIMENSION(ngases_salsa) :: gas_index_chem = (/ 1, 1, 1, 1, 1/) !< gas indices in chemistry_model_mod |
---|
490 | !< 1 = H2SO4, 2 = HNO3, |
---|
491 | !< 3 = NH3, 4 = OCNV, 5 = OCSV |
---|
492 | INTEGER(iwp), DIMENSION(ngases_salsa) :: emission_index_chem !< gas indices in the gas emission file |
---|
493 | INTEGER(iwp), DIMENSION(99) :: salsa_pr_index = 0 !< index for salsa profiles |
---|
494 | |
---|
495 | INTEGER(iwp), DIMENSION(:,:), ALLOCATABLE :: k_topo_top !< vertical index of the topography top |
---|
496 | |
---|
497 | INTEGER(iwp), DIMENSION(:,:,:), ALLOCATABLE :: salsa_advc_flags_s !< flags used to degrade order of advection |
---|
498 | !< scheme for salsa variables near walls and |
---|
499 | !< lateral boundaries |
---|
500 | ! |
---|
501 | !-- SALSA switches: |
---|
502 | LOGICAL :: advect_particle_water = .TRUE. !< Advect water concentration of particles |
---|
503 | LOGICAL :: decycle_salsa_lr = .FALSE. !< Undo cyclic boundaries: left and right |
---|
504 | LOGICAL :: decycle_salsa_ns = .FALSE. !< Undo cyclic boundaries: north and south |
---|
505 | LOGICAL :: include_emission = .FALSE. !< Include or not emissions |
---|
506 | LOGICAL :: feedback_to_palm = .FALSE. !< Allow feedback due to condensation of H2O |
---|
507 | LOGICAL :: nesting_salsa = .TRUE. !< Apply nesting for salsa |
---|
508 | LOGICAL :: nesting_offline_salsa = .TRUE. !< Apply offline nesting for salsa |
---|
509 | LOGICAL :: no_insoluble = .FALSE. !< Exclude insoluble chemical components |
---|
510 | LOGICAL :: read_restart_data_salsa = .TRUE. !< Read restart data for salsa |
---|
511 | LOGICAL :: salsa_gases_from_chem = .FALSE. !< Transfer the gaseous components to SALSA |
---|
512 | LOGICAL :: van_der_waals_coagc = .FALSE. !< Include van der Waals and viscous forces in coagulation |
---|
513 | LOGICAL :: write_binary_salsa = .TRUE. !< read binary for salsa |
---|
514 | ! |
---|
515 | !-- Process switches: nl* is read from the NAMELIST and is NOT changed. |
---|
516 | !-- ls* is the switch used and will get the value of nl* |
---|
517 | !-- except for special circumstances (spinup period etc.) |
---|
518 | LOGICAL :: nlcoag = .FALSE. !< Coagulation master switch |
---|
519 | LOGICAL :: lscoag = .FALSE. !< |
---|
520 | LOGICAL :: nlcnd = .FALSE. !< Condensation master switch |
---|
521 | LOGICAL :: lscnd = .FALSE. !< |
---|
522 | LOGICAL :: nlcndgas = .FALSE. !< Condensation of precursor gases |
---|
523 | LOGICAL :: lscndgas = .FALSE. !< |
---|
524 | LOGICAL :: nlcndh2oae = .FALSE. !< Condensation of H2O on aerosol |
---|
525 | LOGICAL :: lscndh2oae = .FALSE. !< particles (FALSE -> equilibrium calc.) |
---|
526 | LOGICAL :: nldepo = .FALSE. !< Deposition master switch |
---|
527 | LOGICAL :: lsdepo = .FALSE. !< |
---|
528 | LOGICAL :: nldepo_surf = .FALSE. !< Deposition on vegetation master switch |
---|
529 | LOGICAL :: lsdepo_surf = .FALSE. !< |
---|
530 | LOGICAL :: nldepo_pcm = .FALSE. !< Deposition on walls master switch |
---|
531 | LOGICAL :: lsdepo_pcm = .FALSE. !< |
---|
532 | LOGICAL :: nldistupdate = .TRUE. !< Size distribution update master switch |
---|
533 | LOGICAL :: lsdistupdate = .FALSE. !< |
---|
534 | LOGICAL :: lspartition = .FALSE. !< Partition of HNO3 and NH3 |
---|
535 | |
---|
536 | REAL(wp) :: act_coeff = 1.0E-7_wp !< Activation coefficient (1/s) |
---|
537 | REAL(wp) :: dt_salsa = 0.00001_wp !< Time step of SALSA |
---|
538 | REAL(wp) :: emiss_factor_main = 0.0_wp !< relative emission factor for main streets |
---|
539 | REAL(wp) :: emiss_factor_side = 0.0_wp !< relative emission factor for side streets |
---|
540 | REAL(wp) :: h2so4_init = nclim !< Init value for sulphuric acid gas |
---|
541 | REAL(wp) :: hno3_init = nclim !< Init value for nitric acid gas |
---|
542 | REAL(wp) :: last_salsa_time = 0.0_wp !< previous salsa call |
---|
543 | REAL(wp) :: next_aero_emission_update = 0.0_wp !< previous emission update |
---|
544 | REAL(wp) :: next_gas_emission_update = 0.0_wp !< previous emission update |
---|
545 | REAL(wp) :: nf2a = 1.0_wp !< Number fraction allocated to 2a-bins |
---|
546 | REAL(wp) :: nh3_init = nclim !< Init value for ammonia gas |
---|
547 | REAL(wp) :: ocnv_init = nclim !< Init value for non-volatile organic gases |
---|
548 | REAL(wp) :: ocsv_init = nclim !< Init value for semi-volatile organic gases |
---|
549 | REAL(wp) :: rhlim = 1.20_wp !< RH limit in %/100. Prevents unrealistical RH |
---|
550 | REAL(wp) :: skip_time_do_salsa = 0.0_wp !< Starting time of SALSA (s) |
---|
551 | ! |
---|
552 | !-- Initial log-normal size distribution: mode diameter (dpg, metres), |
---|
553 | !-- standard deviation (sigmag) and concentration (n_lognorm, #/m3) |
---|
554 | REAL(wp), DIMENSION(nmod) :: dpg = & |
---|
555 | (/1.3E-8_wp, 5.4E-8_wp, 8.6E-7_wp, 2.0E-7_wp, 2.0E-7_wp, 2.0E-7_wp, 2.0E-7_wp/) |
---|
556 | REAL(wp), DIMENSION(nmod) :: sigmag = & |
---|
557 | (/1.8_wp, 2.16_wp, 2.21_wp, 2.0_wp, 2.0_wp, 2.0_wp, 2.0_wp/) |
---|
558 | REAL(wp), DIMENSION(nmod) :: n_lognorm = & |
---|
559 | (/1.04e+11_wp, 3.23E+10_wp, 5.4E+6_wp, 0.0_wp, 0.0_wp, 0.0_wp, 0.0_wp/) |
---|
560 | ! |
---|
561 | !-- Initial mass fractions / chemical composition of the size distribution |
---|
562 | REAL(wp), DIMENSION(maxspec) :: mass_fracs_a = & !< mass fractions between |
---|
563 | (/1.0, 0.0, 0.0, 0.0, 0.0, 0.0, 0.0/) !< aerosol species for A bins |
---|
564 | REAL(wp), DIMENSION(maxspec) :: mass_fracs_b = & !< mass fractions between |
---|
565 | (/0.0, 0.0, 0.0, 0.0, 0.0, 0.0, 0.0/) !< aerosol species for B bins |
---|
566 | REAL(wp), DIMENSION(nreg+1) :: reglim = & !< Min&max diameters of size subranges |
---|
567 | (/ 3.0E-9_wp, 5.0E-8_wp, 1.0E-5_wp/) |
---|
568 | ! |
---|
569 | !-- Initial log-normal size distribution: mode diameter (dpg, metres), standard deviation (sigmag) |
---|
570 | !-- concentration (n_lognorm, #/m3) and mass fractions of all chemical components (listed in |
---|
571 | !-- listspec) for both a (soluble) and b (insoluble) bins. |
---|
572 | REAL(wp), DIMENSION(nmod) :: aerosol_flux_dpg = & |
---|
573 | (/1.3E-8_wp, 5.4E-8_wp, 8.6E-7_wp, 2.0E-7_wp, 2.0E-7_wp, 2.0E-7_wp, 2.0E-7_wp/) |
---|
574 | REAL(wp), DIMENSION(nmod) :: aerosol_flux_sigmag = & |
---|
575 | (/1.8_wp, 2.16_wp, 2.21_wp, 2.0_wp, 2.0_wp, 2.0_wp, 2.0_wp/) |
---|
576 | REAL(wp), DIMENSION(maxspec) :: aerosol_flux_mass_fracs_a = & |
---|
577 | (/1.0, 0.0, 0.0, 0.0, 0.0, 0.0, 0.0/) |
---|
578 | REAL(wp), DIMENSION(maxspec) :: aerosol_flux_mass_fracs_b = & |
---|
579 | (/0.0, 0.0, 0.0, 0.0, 0.0, 0.0, 0.0/) |
---|
580 | REAL(wp), DIMENSION(nmod) :: surface_aerosol_flux = & |
---|
581 | (/1.0E+8_wp, 1.0E+9_wp, 1.0E+5_wp, 0.0_wp, 0.0_wp, 0.0_wp, 0.0_wp/) |
---|
582 | |
---|
583 | REAL(wp), DIMENSION(:), ALLOCATABLE :: bin_low_limits !< to deliver information about |
---|
584 | !< the lower diameters per bin |
---|
585 | REAL(wp), DIMENSION(:), ALLOCATABLE :: bc_am_t_val !< vertical gradient of: aerosol mass |
---|
586 | REAL(wp), DIMENSION(:), ALLOCATABLE :: bc_an_t_val !< of: aerosol number |
---|
587 | REAL(wp), DIMENSION(:), ALLOCATABLE :: bc_gt_t_val !< salsa gases near domain top |
---|
588 | REAL(wp), DIMENSION(:), ALLOCATABLE :: gas_emission_time !< Time array in gas emission data (s) |
---|
589 | REAL(wp), DIMENSION(:), ALLOCATABLE :: nsect !< Background number concentrations |
---|
590 | REAL(wp), DIMENSION(:), ALLOCATABLE :: massacc !< Mass accomodation coefficients |
---|
591 | ! |
---|
592 | !-- SALSA derived datatypes: |
---|
593 | ! |
---|
594 | !-- Component index |
---|
595 | TYPE component_index |
---|
596 | CHARACTER(len=3), ALLOCATABLE :: comp(:) !< Component name |
---|
597 | INTEGER(iwp) :: ncomp !< Number of components |
---|
598 | INTEGER(iwp), ALLOCATABLE :: ind(:) !< Component index |
---|
599 | END TYPE component_index |
---|
600 | ! |
---|
601 | !-- For matching LSM and USM surface types and the deposition module surface types |
---|
602 | TYPE match_surface |
---|
603 | INTEGER(iwp), DIMENSION(:), ALLOCATABLE :: match_lupg !< index for pavement / green roofs |
---|
604 | INTEGER(iwp), DIMENSION(:), ALLOCATABLE :: match_luvw !< index for vegetation / walls |
---|
605 | INTEGER(iwp), DIMENSION(:), ALLOCATABLE :: match_luww !< index for water / windows |
---|
606 | END TYPE match_surface |
---|
607 | ! |
---|
608 | !-- Aerosol emission data attributes |
---|
609 | TYPE salsa_emission_attribute_type |
---|
610 | |
---|
611 | CHARACTER(LEN=25) :: units |
---|
612 | |
---|
613 | CHARACTER(LEN=25), DIMENSION(:), ALLOCATABLE :: cat_name !< |
---|
614 | CHARACTER(LEN=25), DIMENSION(:), ALLOCATABLE :: cc_name !< |
---|
615 | CHARACTER(LEN=25), DIMENSION(:), ALLOCATABLE :: unit_time !< |
---|
616 | CHARACTER(LEN=100), DIMENSION(:), ALLOCATABLE :: var_names !< |
---|
617 | |
---|
618 | INTEGER(iwp) :: lod = 0 !< level of detail |
---|
619 | INTEGER(iwp) :: nbins = 10 !< number of aerosol size bins |
---|
620 | INTEGER(iwp) :: ncat = 0 !< number of emission categories |
---|
621 | INTEGER(iwp) :: ncc = 7 !< number of aerosol chemical components |
---|
622 | INTEGER(iwp) :: nhoursyear = 0 !< number of hours: HOURLY mode |
---|
623 | INTEGER(iwp) :: nmonthdayhour = 0 !< number of month days and hours: MDH mode |
---|
624 | INTEGER(iwp) :: num_vars !< number of variables |
---|
625 | INTEGER(iwp) :: nt = 0 !< number of time steps |
---|
626 | INTEGER(iwp) :: nz = 0 !< number of vertical levels |
---|
627 | INTEGER(iwp) :: tind !< time index for reference time in salsa emission data |
---|
628 | |
---|
629 | INTEGER(iwp), DIMENSION(maxspec) :: cc_in2mod = 0 !< |
---|
630 | |
---|
631 | INTEGER(iwp), DIMENSION(:), ALLOCATABLE :: cat_index !< Index of emission categories |
---|
632 | INTEGER(iwp), DIMENSION(:), ALLOCATABLE :: cc_index !< Index of chemical components |
---|
633 | |
---|
634 | REAL(wp) :: conversion_factor !< unit conversion factor for aerosol emissions |
---|
635 | |
---|
636 | REAL(wp), DIMENSION(:), ALLOCATABLE :: dmid !< mean diameters of size bins (m) |
---|
637 | REAL(wp), DIMENSION(:), ALLOCATABLE :: rho !< average density (kg/m3) |
---|
638 | REAL(wp), DIMENSION(:), ALLOCATABLE :: time !< time (s) |
---|
639 | REAL(wp), DIMENSION(:), ALLOCATABLE :: time_factor !< emission time factor |
---|
640 | REAL(wp), DIMENSION(:), ALLOCATABLE :: z !< height (m) |
---|
641 | |
---|
642 | REAL(wp), DIMENSION(:,:), ALLOCATABLE :: etf !< emission time factor |
---|
643 | REAL(wp), DIMENSION(:,:), ALLOCATABLE :: stack_height |
---|
644 | |
---|
645 | END TYPE salsa_emission_attribute_type |
---|
646 | ! |
---|
647 | !-- The default size distribution and mass composition per emission category: |
---|
648 | !-- 1 = traffic, 2 = road dust, 3 = wood combustion, 4 = other |
---|
649 | !-- Mass fractions: H2SO4, OC, BC, DU, SS, HNO3, NH3 |
---|
650 | TYPE salsa_emission_mode_type |
---|
651 | |
---|
652 | INTEGER(iwp) :: ndm = 3 !< number of default modes |
---|
653 | INTEGER(iwp) :: ndc = 4 !< number of default categories |
---|
654 | |
---|
655 | CHARACTER(LEN=25), DIMENSION(1:4) :: cat_name_table = (/'traffic exhaust', & |
---|
656 | 'road dust ', & |
---|
657 | 'wood combustion', & |
---|
658 | 'other '/) |
---|
659 | |
---|
660 | INTEGER(iwp), DIMENSION(1:4) :: cat_input_to_model !< |
---|
661 | |
---|
662 | REAL(wp), DIMENSION(1:3) :: dpg_table = (/ 13.5E-9_wp, 1.4E-6_wp, 5.4E-8_wp/) !< |
---|
663 | REAL(wp), DIMENSION(1:3) :: ntot_table !< |
---|
664 | REAL(wp), DIMENSION(1:3) :: sigmag_table = (/ 1.6_wp, 1.4_wp, 1.7_wp /) !< |
---|
665 | |
---|
666 | REAL(wp), DIMENSION(1:maxspec,1:4) :: mass_frac_table = & !< |
---|
667 | RESHAPE( (/ 0.04_wp, 0.48_wp, 0.48_wp, 0.0_wp, 0.0_wp, 0.0_wp, 0.0_wp, & |
---|
668 | 0.0_wp, 0.05_wp, 0.0_wp, 0.95_wp, 0.0_wp, 0.0_wp, 0.0_wp, & |
---|
669 | 0.0_wp, 0.5_wp, 0.5_wp, 0.0_wp, 0.0_wp, 0.0_wp, 0.0_wp, & |
---|
670 | 0.0_wp, 0.5_wp, 0.5_wp, 0.0_wp, 0.0_wp, 0.0_wp, 0.0_wp & |
---|
671 | /), (/maxspec,4/) ) |
---|
672 | |
---|
673 | REAL(wp), DIMENSION(1:3,1:4) :: pm_frac_table = & !< rel. mass |
---|
674 | RESHAPE( (/ 0.016_wp, 0.000_wp, 0.984_wp, & |
---|
675 | 0.000_wp, 1.000_wp, 0.000_wp, & |
---|
676 | 0.000_wp, 0.000_wp, 1.000_wp, & |
---|
677 | 1.000_wp, 0.000_wp, 1.000_wp & |
---|
678 | /), (/3,4/) ) |
---|
679 | |
---|
680 | END TYPE salsa_emission_mode_type |
---|
681 | ! |
---|
682 | !-- Aerosol emission data values |
---|
683 | TYPE salsa_emission_value_type |
---|
684 | |
---|
685 | REAL(wp) :: fill !< fill value |
---|
686 | |
---|
687 | REAL(wp), DIMENSION(:,:), ALLOCATABLE :: mass_fracs !< mass fractions per emis. category |
---|
688 | REAL(wp), DIMENSION(:,:), ALLOCATABLE :: num_fracs !< number fractions per emis. category |
---|
689 | |
---|
690 | REAL(wp), DIMENSION(:,:,:), ALLOCATABLE :: def_data !< surface emission in PM |
---|
691 | REAL(wp), DIMENSION(:,:,:), ALLOCATABLE :: preproc_data !< surface emission per category |
---|
692 | |
---|
693 | END TYPE salsa_emission_value_type |
---|
694 | ! |
---|
695 | !-- Offline nesting data type |
---|
696 | TYPE salsa_nest_offl_type |
---|
697 | |
---|
698 | CHARACTER(LEN=16) :: char_l = 'ls_forcing_left_' !< leading substring at left boundary |
---|
699 | CHARACTER(LEN=17) :: char_n = 'ls_forcing_north_' !< leading substring at north boundary |
---|
700 | CHARACTER(LEN=17) :: char_r = 'ls_forcing_right_' !< leading substring at right boundary |
---|
701 | CHARACTER(LEN=17) :: char_s = 'ls_forcing_south_' !< leading substring at south boundary |
---|
702 | CHARACTER(LEN=15) :: char_t = 'ls_forcing_top_' !< leading substring at top boundary |
---|
703 | |
---|
704 | CHARACTER(LEN=5), DIMENSION(1:ngases_salsa) :: gas_name = (/'H2SO4','HNO3 ','NH3 ','OCNV ','OCSV '/) |
---|
705 | |
---|
706 | CHARACTER(LEN=25), DIMENSION(:), ALLOCATABLE :: cc_name !< chemical component name |
---|
707 | CHARACTER(LEN=100), DIMENSION(:), ALLOCATABLE :: var_names !< list of variable names |
---|
708 | |
---|
709 | INTEGER(iwp) :: id_dynamic !< NetCDF id of dynamic input file |
---|
710 | INTEGER(iwp) :: ncc !< number of aerosol chemical components |
---|
711 | INTEGER(iwp) :: nt !< number of time levels in dynamic input file |
---|
712 | INTEGER(iwp) :: nzu !< number of vertical levels on scalar grid in dynamic input file |
---|
713 | INTEGER(iwp) :: tind !< time index for reference time in mesoscale-offline nesting |
---|
714 | INTEGER(iwp) :: tind_p !< time index for following time in mesoscale-offline nesting |
---|
715 | |
---|
716 | INTEGER(iwp), DIMENSION(maxspec) :: cc_in2mod = 0 !< to transfer chemical composition from input to model |
---|
717 | |
---|
718 | LOGICAL :: init = .FALSE. !< flag indicating the initialisation of offline nesting |
---|
719 | |
---|
720 | REAL(wp), DIMENSION(:), ALLOCATABLE :: dmid !< vertical profile of aerosol bin diameters |
---|
721 | REAL(wp), DIMENSION(:), ALLOCATABLE :: time !< time in dynamic input file |
---|
722 | REAL(wp), DIMENSION(:), ALLOCATABLE :: zu_atmos !< zu in dynamic input file |
---|
723 | |
---|
724 | REAL(wp), DIMENSION(:,:,:,:), ALLOCATABLE :: gconc_left !< gas conc. at left boundary |
---|
725 | REAL(wp), DIMENSION(:,:,:,:), ALLOCATABLE :: gconc_north !< gas conc. at north boundary |
---|
726 | REAL(wp), DIMENSION(:,:,:,:), ALLOCATABLE :: gconc_right !< gas conc. at right boundary |
---|
727 | REAL(wp), DIMENSION(:,:,:,:), ALLOCATABLE :: gconc_south !< gas conc. at south boundary |
---|
728 | REAL(wp), DIMENSION(:,:,:,:), ALLOCATABLE :: gconc_top !< gas conc.at top boundary |
---|
729 | REAL(wp), DIMENSION(:,:,:,:), ALLOCATABLE :: mconc_left !< aerosol mass conc. at left boundary |
---|
730 | REAL(wp), DIMENSION(:,:,:,:), ALLOCATABLE :: mconc_north !< aerosol mass conc. at north boundary |
---|
731 | REAL(wp), DIMENSION(:,:,:,:), ALLOCATABLE :: mconc_right !< aerosol mass conc. at right boundary |
---|
732 | REAL(wp), DIMENSION(:,:,:,:), ALLOCATABLE :: mconc_south !< aerosol mass conc. at south boundary |
---|
733 | REAL(wp), DIMENSION(:,:,:,:), ALLOCATABLE :: mconc_top !< aerosol mass conc. at top boundary |
---|
734 | REAL(wp), DIMENSION(:,:,:,:), ALLOCATABLE :: nconc_left !< aerosol number conc. at left boundary |
---|
735 | REAL(wp), DIMENSION(:,:,:,:), ALLOCATABLE :: nconc_north !< aerosol number conc. at north boundary |
---|
736 | REAL(wp), DIMENSION(:,:,:,:), ALLOCATABLE :: nconc_right !< aerosol number conc. at right boundary |
---|
737 | REAL(wp), DIMENSION(:,:,:,:), ALLOCATABLE :: nconc_south !< aerosol number conc. at south boundary |
---|
738 | REAL(wp), DIMENSION(:,:,:,:), ALLOCATABLE :: nconc_top !< aerosol number conc. at top boundary |
---|
739 | |
---|
740 | END TYPE salsa_nest_offl_type |
---|
741 | ! |
---|
742 | !-- Prognostic variable: Aerosol size bin information (number (#/m3) and mass (kg/m3) concentration) |
---|
743 | !-- and the concentration of gaseous tracers (#/m3). Gas tracers are contained sequentially in |
---|
744 | !-- dimension 4 as: |
---|
745 | !-- 1. H2SO4, 2. HNO3, 3. NH3, 4. OCNV (non-volatile organics), 5. OCSV (semi-volatile) |
---|
746 | TYPE salsa_variable |
---|
747 | |
---|
748 | REAL(wp), DIMENSION(:), ALLOCATABLE :: init !< |
---|
749 | |
---|
750 | REAL(wp), DIMENSION(:,:), ALLOCATABLE :: diss_s !< |
---|
751 | REAL(wp), DIMENSION(:,:), ALLOCATABLE :: flux_s !< |
---|
752 | REAL(wp), DIMENSION(:,:), ALLOCATABLE :: source !< |
---|
753 | REAL(wp), DIMENSION(:,:), ALLOCATABLE :: sums_ws_l !< |
---|
754 | |
---|
755 | REAL(wp), DIMENSION(:,:,:), ALLOCATABLE :: diss_l !< |
---|
756 | REAL(wp), DIMENSION(:,:,:), ALLOCATABLE :: flux_l !< |
---|
757 | |
---|
758 | REAL(wp), DIMENSION(:,:,:), POINTER, CONTIGUOUS :: conc !< |
---|
759 | REAL(wp), DIMENSION(:,:,:), POINTER, CONTIGUOUS :: conc_p !< |
---|
760 | REAL(wp), DIMENSION(:,:,:), POINTER, CONTIGUOUS :: tconc_m !< |
---|
761 | |
---|
762 | END TYPE salsa_variable |
---|
763 | ! |
---|
764 | !-- Datatype used to store information about the binned size distributions of aerosols |
---|
765 | TYPE t_section |
---|
766 | |
---|
767 | REAL(wp) :: dmid !< bin middle diameter (m) |
---|
768 | REAL(wp) :: vhilim !< bin volume at the high limit |
---|
769 | REAL(wp) :: vlolim !< bin volume at the low limit |
---|
770 | REAL(wp) :: vratiohi !< volume ratio between the center and high limit |
---|
771 | REAL(wp) :: vratiolo !< volume ratio between the center and low limit |
---|
772 | !****************************************************** |
---|
773 | ! ^ Do NOT change the stuff above after initialization ! |
---|
774 | !****************************************************** |
---|
775 | REAL(wp) :: core !< Volume of dry particle |
---|
776 | REAL(wp) :: dwet !< Wet diameter or mean droplet diameter (m) |
---|
777 | REAL(wp) :: numc !< Number concentration of particles/droplets (#/m3) |
---|
778 | REAL(wp) :: veqh2o !< Equilibrium H2O concentration for each particle |
---|
779 | |
---|
780 | REAL(wp), DIMENSION(maxspec+1) :: volc !< Volume concentrations (m^3/m^3) of aerosols + |
---|
781 | !< water. Since most of the stuff in SALSA is hard |
---|
782 | !< coded, these *have to be* in the order |
---|
783 | !< 1:SO4, 2:OC, 3:BC, 4:DU, 5:SS, 6:NO, 7:NH, 8:H2O |
---|
784 | END TYPE t_section |
---|
785 | |
---|
786 | TYPE(salsa_emission_attribute_type) :: aero_emission_att !< emission attributes |
---|
787 | TYPE(salsa_emission_value_type) :: aero_emission !< emission values |
---|
788 | TYPE(salsa_emission_mode_type) :: def_modes !< default emission modes |
---|
789 | |
---|
790 | TYPE(chem_emis_att_type) :: chem_emission_att !< chemistry emission attributes |
---|
791 | |
---|
792 | TYPE(chem_emis_val_type), DIMENSION(:), ALLOCATABLE :: chem_emission !< chemistry emissions |
---|
793 | |
---|
794 | TYPE(t_section), DIMENSION(:), ALLOCATABLE :: aero !< local aerosol properties |
---|
795 | |
---|
796 | TYPE(match_surface) :: lsm_to_depo_h !< to match the deposition module and horizontal LSM surfaces |
---|
797 | TYPE(match_surface) :: usm_to_depo_h !< to match the deposition module and horizontal USM surfaces |
---|
798 | |
---|
799 | TYPE(match_surface), DIMENSION(0:3) :: lsm_to_depo_v !< to match the deposition mod. and vertical LSM surfaces |
---|
800 | TYPE(match_surface), DIMENSION(0:3) :: usm_to_depo_v !< to match the deposition mod. and vertical USM surfaces |
---|
801 | ! |
---|
802 | !-- SALSA variables: as x = x(k,j,i,bin). |
---|
803 | !-- The 4th dimension contains all the size bins sequentially for each aerosol species + water. |
---|
804 | ! |
---|
805 | !-- Prognostic variables: |
---|
806 | ! |
---|
807 | !-- Number concentration (#/m3) |
---|
808 | TYPE(salsa_variable), DIMENSION(:), ALLOCATABLE, TARGET :: aerosol_number !< |
---|
809 | REAL(wp), DIMENSION(:,:,:,:), ALLOCATABLE, TARGET :: nconc_1 !< |
---|
810 | REAL(wp), DIMENSION(:,:,:,:), ALLOCATABLE, TARGET :: nconc_2 !< |
---|
811 | REAL(wp), DIMENSION(:,:,:,:), ALLOCATABLE, TARGET :: nconc_3 !< |
---|
812 | ! |
---|
813 | !-- Mass concentration (kg/m3) |
---|
814 | TYPE(salsa_variable), DIMENSION(:), ALLOCATABLE, TARGET :: aerosol_mass !< |
---|
815 | REAL(wp), DIMENSION(:,:,:,:), ALLOCATABLE, TARGET :: mconc_1 !< |
---|
816 | REAL(wp), DIMENSION(:,:,:,:), ALLOCATABLE, TARGET :: mconc_2 !< |
---|
817 | REAL(wp), DIMENSION(:,:,:,:), ALLOCATABLE, TARGET :: mconc_3 !< |
---|
818 | ! |
---|
819 | !-- Gaseous concentrations (#/m3) |
---|
820 | TYPE(salsa_variable), DIMENSION(:), ALLOCATABLE, TARGET :: salsa_gas !< |
---|
821 | REAL(wp), DIMENSION(:,:,:,:), ALLOCATABLE, TARGET :: gconc_1 !< |
---|
822 | REAL(wp), DIMENSION(:,:,:,:), ALLOCATABLE, TARGET :: gconc_2 !< |
---|
823 | REAL(wp), DIMENSION(:,:,:,:), ALLOCATABLE, TARGET :: gconc_3 !< |
---|
824 | ! |
---|
825 | !-- Diagnostic tracers |
---|
826 | REAL(wp), DIMENSION(:,:,:,:), ALLOCATABLE :: sedim_vd !< sedimentation velocity per bin (m/s) |
---|
827 | REAL(wp), DIMENSION(:,:,:,:), ALLOCATABLE :: ra_dry !< aerosol dry radius (m) |
---|
828 | |
---|
829 | !-- Particle component index tables |
---|
830 | TYPE(component_index) :: prtcl !< Contains "getIndex" which gives the index for a given aerosol |
---|
831 | !< component name: 1:SO4, 2:OC, 3:BC, 4:DU, 5:SS, 6:NO, 7:NH, 8:H2O |
---|
832 | ! |
---|
833 | !-- Offline nesting: |
---|
834 | TYPE(salsa_nest_offl_type) :: salsa_nest_offl !< data structure for offline nesting |
---|
835 | ! |
---|
836 | !-- Data output arrays: |
---|
837 | ! |
---|
838 | !-- Integrated: |
---|
839 | REAL(wp), DIMENSION(:,:,:), ALLOCATABLE, TARGET :: ldsa_av !< lung-deposited surface area |
---|
840 | REAL(wp), DIMENSION(:,:,:), ALLOCATABLE, TARGET :: ntot_av !< total number concentration |
---|
841 | REAL(wp), DIMENSION(:,:,:), ALLOCATABLE, TARGET :: nufp_av !< ultrafine particles (UFP) |
---|
842 | REAL(wp), DIMENSION(:,:,:), ALLOCATABLE, TARGET :: pm01_av !< PM0.1 |
---|
843 | REAL(wp), DIMENSION(:,:,:), ALLOCATABLE, TARGET :: pm25_av !< PM2.5 |
---|
844 | REAL(wp), DIMENSION(:,:,:), ALLOCATABLE, TARGET :: pm10_av !< PM10 |
---|
845 | ! |
---|
846 | !-- Bin specific mass and number concentrations: |
---|
847 | REAL(wp), DIMENSION(:,:,:,:), ALLOCATABLE, TARGET :: mbins_av !< bin mas |
---|
848 | REAL(wp), DIMENSION(:,:,:,:), ALLOCATABLE, TARGET :: nbins_av !< bin number |
---|
849 | ! |
---|
850 | !-- Gases: |
---|
851 | REAL(wp), DIMENSION(:,:,:,:), ALLOCATABLE, TARGET :: salsa_gases_av !< gases |
---|
852 | ! |
---|
853 | !-- In the particle phase: |
---|
854 | REAL(wp), DIMENSION(:,:,:), ALLOCATABLE, TARGET :: s_h2o_av !< liquid water |
---|
855 | REAL(wp), DIMENSION(:,:,:,:), ALLOCATABLE, TARGET :: s_mass_av !< mass components |
---|
856 | |
---|
857 | ! |
---|
858 | !-- PALM interfaces: |
---|
859 | |
---|
860 | INTERFACE salsa_actions |
---|
861 | MODULE PROCEDURE salsa_actions |
---|
862 | MODULE PROCEDURE salsa_actions_ij |
---|
863 | END INTERFACE salsa_actions |
---|
864 | |
---|
865 | INTERFACE salsa_3d_data_averaging |
---|
866 | MODULE PROCEDURE salsa_3d_data_averaging |
---|
867 | END INTERFACE salsa_3d_data_averaging |
---|
868 | |
---|
869 | INTERFACE salsa_boundary_conds |
---|
870 | MODULE PROCEDURE salsa_boundary_conds |
---|
871 | MODULE PROCEDURE salsa_boundary_conds_decycle |
---|
872 | END INTERFACE salsa_boundary_conds |
---|
873 | |
---|
874 | INTERFACE salsa_boundary_conditions |
---|
875 | MODULE PROCEDURE salsa_boundary_conditions |
---|
876 | END INTERFACE salsa_boundary_conditions |
---|
877 | |
---|
878 | INTERFACE salsa_check_data_output |
---|
879 | MODULE PROCEDURE salsa_check_data_output |
---|
880 | END INTERFACE salsa_check_data_output |
---|
881 | |
---|
882 | INTERFACE salsa_check_data_output_pr |
---|
883 | MODULE PROCEDURE salsa_check_data_output_pr |
---|
884 | END INTERFACE salsa_check_data_output_pr |
---|
885 | |
---|
886 | INTERFACE salsa_check_parameters |
---|
887 | MODULE PROCEDURE salsa_check_parameters |
---|
888 | END INTERFACE salsa_check_parameters |
---|
889 | |
---|
890 | INTERFACE salsa_data_output_2d |
---|
891 | MODULE PROCEDURE salsa_data_output_2d |
---|
892 | END INTERFACE salsa_data_output_2d |
---|
893 | |
---|
894 | INTERFACE salsa_data_output_3d |
---|
895 | MODULE PROCEDURE salsa_data_output_3d |
---|
896 | END INTERFACE salsa_data_output_3d |
---|
897 | |
---|
898 | INTERFACE salsa_data_output_mask |
---|
899 | MODULE PROCEDURE salsa_data_output_mask |
---|
900 | END INTERFACE salsa_data_output_mask |
---|
901 | |
---|
902 | INTERFACE salsa_define_netcdf_grid |
---|
903 | MODULE PROCEDURE salsa_define_netcdf_grid |
---|
904 | END INTERFACE salsa_define_netcdf_grid |
---|
905 | |
---|
906 | INTERFACE salsa_emission_update |
---|
907 | MODULE PROCEDURE salsa_emission_update |
---|
908 | END INTERFACE salsa_emission_update |
---|
909 | |
---|
910 | INTERFACE salsa_exchange_horiz_bounds |
---|
911 | MODULE PROCEDURE salsa_exchange_horiz_bounds |
---|
912 | END INTERFACE salsa_exchange_horiz_bounds |
---|
913 | |
---|
914 | INTERFACE salsa_header |
---|
915 | MODULE PROCEDURE salsa_header |
---|
916 | END INTERFACE salsa_header |
---|
917 | |
---|
918 | INTERFACE salsa_init |
---|
919 | MODULE PROCEDURE salsa_init |
---|
920 | END INTERFACE salsa_init |
---|
921 | |
---|
922 | INTERFACE salsa_init_arrays |
---|
923 | MODULE PROCEDURE salsa_init_arrays |
---|
924 | END INTERFACE salsa_init_arrays |
---|
925 | |
---|
926 | INTERFACE salsa_nesting_offl_bc |
---|
927 | MODULE PROCEDURE salsa_nesting_offl_bc |
---|
928 | END INTERFACE salsa_nesting_offl_bc |
---|
929 | |
---|
930 | INTERFACE salsa_nesting_offl_init |
---|
931 | MODULE PROCEDURE salsa_nesting_offl_init |
---|
932 | END INTERFACE salsa_nesting_offl_init |
---|
933 | |
---|
934 | INTERFACE salsa_nesting_offl_input |
---|
935 | MODULE PROCEDURE salsa_nesting_offl_input |
---|
936 | END INTERFACE salsa_nesting_offl_input |
---|
937 | |
---|
938 | INTERFACE salsa_non_advective_processes |
---|
939 | MODULE PROCEDURE salsa_non_advective_processes |
---|
940 | MODULE PROCEDURE salsa_non_advective_processes_ij |
---|
941 | END INTERFACE salsa_non_advective_processes |
---|
942 | |
---|
943 | INTERFACE salsa_parin |
---|
944 | MODULE PROCEDURE salsa_parin |
---|
945 | END INTERFACE salsa_parin |
---|
946 | |
---|
947 | INTERFACE salsa_prognostic_equations |
---|
948 | MODULE PROCEDURE salsa_prognostic_equations |
---|
949 | MODULE PROCEDURE salsa_prognostic_equations_ij |
---|
950 | END INTERFACE salsa_prognostic_equations |
---|
951 | |
---|
952 | INTERFACE salsa_rrd_local |
---|
953 | MODULE PROCEDURE salsa_rrd_local |
---|
954 | END INTERFACE salsa_rrd_local |
---|
955 | |
---|
956 | INTERFACE salsa_statistics |
---|
957 | MODULE PROCEDURE salsa_statistics |
---|
958 | END INTERFACE salsa_statistics |
---|
959 | |
---|
960 | INTERFACE salsa_swap_timelevel |
---|
961 | MODULE PROCEDURE salsa_swap_timelevel |
---|
962 | END INTERFACE salsa_swap_timelevel |
---|
963 | |
---|
964 | INTERFACE salsa_tendency |
---|
965 | MODULE PROCEDURE salsa_tendency |
---|
966 | MODULE PROCEDURE salsa_tendency_ij |
---|
967 | END INTERFACE salsa_tendency |
---|
968 | |
---|
969 | INTERFACE salsa_wrd_local |
---|
970 | MODULE PROCEDURE salsa_wrd_local |
---|
971 | END INTERFACE salsa_wrd_local |
---|
972 | |
---|
973 | |
---|
974 | SAVE |
---|
975 | |
---|
976 | PRIVATE |
---|
977 | ! |
---|
978 | !-- Public functions: |
---|
979 | PUBLIC salsa_3d_data_averaging, & |
---|
980 | salsa_actions, & |
---|
981 | salsa_boundary_conds, & |
---|
982 | salsa_boundary_conditions, & |
---|
983 | salsa_check_data_output, & |
---|
984 | salsa_check_data_output_pr, & |
---|
985 | salsa_check_parameters, & |
---|
986 | salsa_data_output_2d, & |
---|
987 | salsa_data_output_3d, & |
---|
988 | salsa_data_output_mask, & |
---|
989 | salsa_define_netcdf_grid, & |
---|
990 | salsa_diagnostics, & |
---|
991 | salsa_emission_update, & |
---|
992 | salsa_exchange_horiz_bounds, & |
---|
993 | salsa_header, & |
---|
994 | salsa_init, & |
---|
995 | salsa_init_arrays, & |
---|
996 | salsa_nesting_offl_bc, & |
---|
997 | salsa_nesting_offl_init, & |
---|
998 | salsa_nesting_offl_input, & |
---|
999 | salsa_non_advective_processes, & |
---|
1000 | salsa_parin, & |
---|
1001 | salsa_prognostic_equations, & |
---|
1002 | salsa_rrd_local, & |
---|
1003 | salsa_statistics, & |
---|
1004 | salsa_swap_timelevel, & |
---|
1005 | salsa_wrd_local |
---|
1006 | |
---|
1007 | ! |
---|
1008 | !-- Public parameters, constants and initial values |
---|
1009 | PUBLIC bc_am_t_val, & |
---|
1010 | bc_an_t_val, & |
---|
1011 | bc_gt_t_val, & |
---|
1012 | ibc_salsa_b, & |
---|
1013 | init_aerosol_type, & |
---|
1014 | init_gases_type, & |
---|
1015 | nesting_salsa, & |
---|
1016 | nesting_offline_salsa, & |
---|
1017 | salsa_gases_from_chem, & |
---|
1018 | skip_time_do_salsa |
---|
1019 | ! |
---|
1020 | !-- Public variables |
---|
1021 | PUBLIC aerosol_mass, & |
---|
1022 | aerosol_number, & |
---|
1023 | gconc_2, & |
---|
1024 | mconc_2, & |
---|
1025 | nbins_aerosol, & |
---|
1026 | ncomponents_mass, & |
---|
1027 | nconc_2, & |
---|
1028 | ngases_salsa, & |
---|
1029 | salsa_gas, & |
---|
1030 | salsa_nest_offl |
---|
1031 | |
---|
1032 | |
---|
1033 | CONTAINS |
---|
1034 | |
---|
1035 | !------------------------------------------------------------------------------! |
---|
1036 | ! Description: |
---|
1037 | ! ------------ |
---|
1038 | !> Parin for &salsa_par for new modules |
---|
1039 | !------------------------------------------------------------------------------! |
---|
1040 | SUBROUTINE salsa_parin |
---|
1041 | |
---|
1042 | USE control_parameters, & |
---|
1043 | ONLY: data_output_pr |
---|
1044 | |
---|
1045 | IMPLICIT NONE |
---|
1046 | |
---|
1047 | CHARACTER(LEN=80) :: line !< dummy string that contains the current line of parameter file |
---|
1048 | |
---|
1049 | INTEGER(iwp) :: i !< loop index |
---|
1050 | INTEGER(iwp) :: max_pr_salsa_tmp !< dummy variable |
---|
1051 | |
---|
1052 | NAMELIST /salsa_parameters/ aerosol_flux_dpg, & |
---|
1053 | aerosol_flux_mass_fracs_a, & |
---|
1054 | aerosol_flux_mass_fracs_b, & |
---|
1055 | aerosol_flux_sigmag, & |
---|
1056 | advect_particle_water, & |
---|
1057 | bc_salsa_b, & |
---|
1058 | bc_salsa_t, & |
---|
1059 | decycle_salsa_lr, & |
---|
1060 | decycle_method_salsa, & |
---|
1061 | decycle_salsa_ns, & |
---|
1062 | depo_pcm_par, & |
---|
1063 | depo_pcm_type, & |
---|
1064 | depo_surf_par, & |
---|
1065 | dpg, & |
---|
1066 | dt_salsa, & |
---|
1067 | emiss_factor_main, & |
---|
1068 | emiss_factor_side, & |
---|
1069 | feedback_to_palm, & |
---|
1070 | h2so4_init, & |
---|
1071 | hno3_init, & |
---|
1072 | listspec, & |
---|
1073 | main_street_id, & |
---|
1074 | mass_fracs_a, & |
---|
1075 | mass_fracs_b, & |
---|
1076 | max_street_id, & |
---|
1077 | n_lognorm, & |
---|
1078 | nbin, & |
---|
1079 | nesting_salsa, & |
---|
1080 | nesting_offline_salsa, & |
---|
1081 | nf2a, & |
---|
1082 | nh3_init, & |
---|
1083 | nj3, & |
---|
1084 | nlcnd, & |
---|
1085 | nlcndgas, & |
---|
1086 | nlcndh2oae, & |
---|
1087 | nlcoag, & |
---|
1088 | nldepo, & |
---|
1089 | nldepo_pcm, & |
---|
1090 | nldepo_surf, & |
---|
1091 | nldistupdate, & |
---|
1092 | nsnucl, & |
---|
1093 | ocnv_init, & |
---|
1094 | ocsv_init, & |
---|
1095 | read_restart_data_salsa, & |
---|
1096 | reglim, & |
---|
1097 | salsa, & |
---|
1098 | salsa_emission_mode, & |
---|
1099 | season_z01, & |
---|
1100 | sigmag, & |
---|
1101 | side_street_id, & |
---|
1102 | skip_time_do_salsa, & |
---|
1103 | surface_aerosol_flux, & |
---|
1104 | van_der_waals_coagc, & |
---|
1105 | write_binary_salsa |
---|
1106 | |
---|
1107 | line = ' ' |
---|
1108 | ! |
---|
1109 | !-- Try to find salsa package |
---|
1110 | REWIND ( 11 ) |
---|
1111 | line = ' ' |
---|
1112 | DO WHILE ( INDEX( line, '&salsa_parameters' ) == 0 ) |
---|
1113 | READ ( 11, '(A)', END=10 ) line |
---|
1114 | ENDDO |
---|
1115 | BACKSPACE ( 11 ) |
---|
1116 | ! |
---|
1117 | !-- Read user-defined namelist |
---|
1118 | READ ( 11, salsa_parameters ) |
---|
1119 | ! |
---|
1120 | !-- Enable salsa (salsa switch in modules.f90) |
---|
1121 | salsa = .TRUE. |
---|
1122 | |
---|
1123 | 10 CONTINUE |
---|
1124 | ! |
---|
1125 | !-- Update the number of output profiles |
---|
1126 | max_pr_salsa_tmp = 0 |
---|
1127 | i = 1 |
---|
1128 | DO WHILE ( data_output_pr(i) /= ' ' .AND. i <= 100 ) |
---|
1129 | IF ( TRIM( data_output_pr(i)(1:6) ) == 'salsa_' ) max_pr_salsa_tmp = max_pr_salsa_tmp + 1 |
---|
1130 | i = i + 1 |
---|
1131 | ENDDO |
---|
1132 | IF ( max_pr_salsa_tmp > 0 ) max_pr_salsa = max_pr_salsa_tmp |
---|
1133 | |
---|
1134 | END SUBROUTINE salsa_parin |
---|
1135 | |
---|
1136 | !------------------------------------------------------------------------------! |
---|
1137 | ! Description: |
---|
1138 | ! ------------ |
---|
1139 | !> Check parameters routine for salsa. |
---|
1140 | !------------------------------------------------------------------------------! |
---|
1141 | SUBROUTINE salsa_check_parameters |
---|
1142 | |
---|
1143 | USE control_parameters, & |
---|
1144 | ONLY: child_domain, humidity, initializing_actions, nesting_offline |
---|
1145 | |
---|
1146 | IMPLICIT NONE |
---|
1147 | |
---|
1148 | ! |
---|
1149 | !-- Check that humidity is switched on |
---|
1150 | IF ( salsa .AND. .NOT. humidity ) THEN |
---|
1151 | WRITE( message_string, * ) 'salsa = ', salsa, ' is not allowed with humidity = ', humidity |
---|
1152 | CALL message( 'salsa_check_parameters', 'PA0594', 1, 2, 0, 6, 0 ) |
---|
1153 | ENDIF |
---|
1154 | ! |
---|
1155 | !-- For nested runs, explicitly set nesting boundary conditions. |
---|
1156 | IF ( child_domain ) THEN |
---|
1157 | IF ( nesting_salsa ) THEN |
---|
1158 | bc_salsa_t = 'nested' |
---|
1159 | ELSE |
---|
1160 | bc_salsa_t = 'neumann' |
---|
1161 | ENDIF |
---|
1162 | ENDIF |
---|
1163 | ! |
---|
1164 | !-- Set boundary conditions also in case the model is offline-nested in larger-scale models. |
---|
1165 | IF ( nesting_offline ) THEN |
---|
1166 | IF ( nesting_offline_salsa ) THEN |
---|
1167 | bc_salsa_t = 'nesting_offline' |
---|
1168 | ELSE |
---|
1169 | bc_salsa_t = 'neumann' |
---|
1170 | ENDIF |
---|
1171 | ENDIF |
---|
1172 | ! |
---|
1173 | !-- Set bottom boundary condition flag |
---|
1174 | IF ( bc_salsa_b == 'dirichlet' ) THEN |
---|
1175 | ibc_salsa_b = 0 |
---|
1176 | ELSEIF ( bc_salsa_b == 'neumann' ) THEN |
---|
1177 | ibc_salsa_b = 1 |
---|
1178 | ELSE |
---|
1179 | message_string = 'unknown boundary condition: bc_salsa_b = "' // TRIM( bc_salsa_t ) // '"' |
---|
1180 | CALL message( 'salsa_check_parameters', 'PA0595', 1, 2, 0, 6, 0 ) |
---|
1181 | ENDIF |
---|
1182 | ! |
---|
1183 | !-- Set top boundary conditions flag |
---|
1184 | IF ( bc_salsa_t == 'dirichlet' ) THEN |
---|
1185 | ibc_salsa_t = 0 |
---|
1186 | ELSEIF ( bc_salsa_t == 'neumann' ) THEN |
---|
1187 | ibc_salsa_t = 1 |
---|
1188 | ELSEIF ( bc_salsa_t == 'initial_gradient' ) THEN |
---|
1189 | ibc_salsa_t = 2 |
---|
1190 | ELSEIF ( bc_salsa_t == 'nested' .OR. bc_salsa_t == 'nesting_offline' ) THEN |
---|
1191 | ibc_salsa_t = 3 |
---|
1192 | ELSE |
---|
1193 | message_string = 'unknown boundary condition: bc_salsa_t = "' // TRIM( bc_salsa_t ) // '"' |
---|
1194 | CALL message( 'salsa_check_parameters', 'PA0596', 1, 2, 0, 6, 0 ) |
---|
1195 | ENDIF |
---|
1196 | ! |
---|
1197 | !-- Check J3 parametrisation |
---|
1198 | IF ( nj3 < 1 .OR. nj3 > 3 ) THEN |
---|
1199 | message_string = 'unknown nj3 (must be 1-3)' |
---|
1200 | CALL message( 'salsa_check_parameters', 'PA0597', 1, 2, 0, 6, 0 ) |
---|
1201 | ENDIF |
---|
1202 | ! |
---|
1203 | !-- Check bottom boundary condition in case of surface emissions |
---|
1204 | IF ( salsa_emission_mode /= 'no_emission' .AND. ibc_salsa_b == 0 ) THEN |
---|
1205 | message_string = 'salsa_emission_mode /= "no_emission" requires bc_salsa_b = "Neumann"' |
---|
1206 | CALL message( 'salsa_check_parameters','PA0598', 1, 2, 0, 6, 0 ) |
---|
1207 | ENDIF |
---|
1208 | ! |
---|
1209 | !-- Check whether emissions are applied |
---|
1210 | IF ( salsa_emission_mode /= 'no_emission' ) include_emission = .TRUE. |
---|
1211 | ! |
---|
1212 | !-- Set the initialisation type: background concentration are read from PIDS_DYNAMIC if |
---|
1213 | !-- initializing_actions = 'inifor set_constant_profiles' |
---|
1214 | IF ( INDEX( initializing_actions, 'inifor' ) /= 0 ) THEN |
---|
1215 | init_aerosol_type = 1 |
---|
1216 | init_gases_type = 1 |
---|
1217 | ENDIF |
---|
1218 | ! |
---|
1219 | !-- If the run is not a restart run, set read_restart_data to .FALSE. |
---|
1220 | IF ( TRIM( initializing_actions ) /= 'read_restart_data' ) THEN |
---|
1221 | read_restart_data_salsa = .FALSE. |
---|
1222 | ENDIF |
---|
1223 | |
---|
1224 | END SUBROUTINE salsa_check_parameters |
---|
1225 | |
---|
1226 | !------------------------------------------------------------------------------! |
---|
1227 | ! |
---|
1228 | ! Description: |
---|
1229 | ! ------------ |
---|
1230 | !> Subroutine defining appropriate grid for netcdf variables. |
---|
1231 | !> It is called out from subroutine netcdf. |
---|
1232 | !> Same grid as for other scalars (see netcdf_interface_mod.f90) |
---|
1233 | !------------------------------------------------------------------------------! |
---|
1234 | SUBROUTINE salsa_define_netcdf_grid( var, found, grid_x, grid_y, grid_z ) |
---|
1235 | |
---|
1236 | IMPLICIT NONE |
---|
1237 | |
---|
1238 | CHARACTER(LEN=*), INTENT(OUT) :: grid_x !< |
---|
1239 | CHARACTER(LEN=*), INTENT(OUT) :: grid_y !< |
---|
1240 | CHARACTER(LEN=*), INTENT(OUT) :: grid_z !< |
---|
1241 | CHARACTER(LEN=*), INTENT(IN) :: var !< |
---|
1242 | |
---|
1243 | LOGICAL, INTENT(OUT) :: found !< |
---|
1244 | |
---|
1245 | found = .TRUE. |
---|
1246 | ! |
---|
1247 | !-- Check for the grid |
---|
1248 | |
---|
1249 | IF ( var(1:6) == 'salsa_' ) THEN ! same grid for all salsa output variables |
---|
1250 | grid_x = 'x' |
---|
1251 | grid_y = 'y' |
---|
1252 | grid_z = 'zu' |
---|
1253 | ELSE |
---|
1254 | found = .FALSE. |
---|
1255 | grid_x = 'none' |
---|
1256 | grid_y = 'none' |
---|
1257 | grid_z = 'none' |
---|
1258 | ENDIF |
---|
1259 | |
---|
1260 | END SUBROUTINE salsa_define_netcdf_grid |
---|
1261 | |
---|
1262 | !------------------------------------------------------------------------------! |
---|
1263 | ! Description: |
---|
1264 | ! ------------ |
---|
1265 | !> Header output for new module |
---|
1266 | !------------------------------------------------------------------------------! |
---|
1267 | SUBROUTINE salsa_header( io ) |
---|
1268 | |
---|
1269 | USE indices, & |
---|
1270 | ONLY: nx, ny, nz |
---|
1271 | |
---|
1272 | IMPLICIT NONE |
---|
1273 | |
---|
1274 | INTEGER(iwp), INTENT(IN) :: io !< Unit of the output file |
---|
1275 | ! |
---|
1276 | !-- Write SALSA header |
---|
1277 | WRITE( io, 1 ) |
---|
1278 | WRITE( io, 2 ) skip_time_do_salsa |
---|
1279 | WRITE( io, 3 ) dt_salsa |
---|
1280 | WRITE( io, 4 ) nz, ny, nx, nbins_aerosol |
---|
1281 | IF ( advect_particle_water ) THEN |
---|
1282 | WRITE( io, 5 ) nz, ny, nx, ncomponents_mass*nbins_aerosol, advect_particle_water |
---|
1283 | ELSE |
---|
1284 | WRITE( io, 5 ) nz, ny, nx, ncc*nbins_aerosol, advect_particle_water |
---|
1285 | ENDIF |
---|
1286 | IF ( .NOT. salsa_gases_from_chem ) THEN |
---|
1287 | WRITE( io, 6 ) nz, ny, nx, ngases_salsa, salsa_gases_from_chem |
---|
1288 | ENDIF |
---|
1289 | WRITE( io, 7 ) |
---|
1290 | IF ( nsnucl > 0 ) WRITE( io, 8 ) nsnucl, nj3 |
---|
1291 | IF ( nlcoag ) WRITE( io, 9 ) |
---|
1292 | IF ( nlcnd ) WRITE( io, 10 ) nlcndgas, nlcndh2oae |
---|
1293 | IF ( lspartition ) WRITE( io, 11 ) |
---|
1294 | IF ( nldepo ) WRITE( io, 12 ) nldepo_pcm, nldepo_surf |
---|
1295 | WRITE( io, 13 ) reglim, nbin, ( aero(:)%vlolim / api6 )**0.33333333_wp |
---|
1296 | WRITE( io, 25 ) aero(:)%dmid |
---|
1297 | IF ( init_aerosol_type == 0 ) WRITE( io, 14 ) nsect |
---|
1298 | WRITE( io, 15 ) ncc, listspec, mass_fracs_a, mass_fracs_b |
---|
1299 | IF ( .NOT. salsa_gases_from_chem ) THEN |
---|
1300 | WRITE( io, 16 ) ngases_salsa, h2so4_init, hno3_init, nh3_init, ocnv_init, ocsv_init |
---|
1301 | ENDIF |
---|
1302 | WRITE( io, 17 ) init_aerosol_type, init_gases_type |
---|
1303 | IF ( init_aerosol_type == 0 ) THEN |
---|
1304 | WRITE( io, 18 ) dpg, sigmag, n_lognorm |
---|
1305 | ELSE |
---|
1306 | WRITE( io, 19 ) |
---|
1307 | ENDIF |
---|
1308 | IF ( nesting_salsa ) WRITE( io, 20 ) nesting_salsa |
---|
1309 | IF ( nesting_offline_salsa ) WRITE( io, 21 ) nesting_offline_salsa |
---|
1310 | WRITE( io, 22 ) salsa_emission_mode |
---|
1311 | IF ( salsa_emission_mode == 'uniform' ) THEN |
---|
1312 | WRITE( io, 23 ) surface_aerosol_flux, aerosol_flux_dpg, aerosol_flux_sigmag, & |
---|
1313 | aerosol_flux_mass_fracs_a |
---|
1314 | ENDIF |
---|
1315 | IF ( SUM( aerosol_flux_mass_fracs_b ) > 0.0_wp .OR. salsa_emission_mode == 'read_from_file' ) & |
---|
1316 | THEN |
---|
1317 | WRITE( io, 24 ) |
---|
1318 | ENDIF |
---|
1319 | |
---|
1320 | 1 FORMAT (//' SALSA information:'/ & |
---|
1321 | ' ------------------------------'/) |
---|
1322 | 2 FORMAT (' Starts at: skip_time_do_salsa = ', F10.2, ' s') |
---|
1323 | 3 FORMAT (/' Timestep: dt_salsa = ', F6.2, ' s') |
---|
1324 | 4 FORMAT (/' Array shape (z,y,x,bins):'/ & |
---|
1325 | ' aerosol_number: ', 4(I5)) |
---|
1326 | 5 FORMAT (/' aerosol_mass: ', 4(I5),/ & |
---|
1327 | ' (advect_particle_water = ', L1, ')') |
---|
1328 | 6 FORMAT (' salsa_gas: ', 4(I5),/ & |
---|
1329 | ' (salsa_gases_from_chem = ', L1, ')') |
---|
1330 | 7 FORMAT (/' Aerosol dynamic processes included: ') |
---|
1331 | 8 FORMAT (/' nucleation (scheme = ', I1, ' and J3 parametrization = ', I1, ')') |
---|
1332 | 9 FORMAT (/' coagulation') |
---|
1333 | 10 FORMAT (/' condensation (of precursor gases = ', L1, ' and water vapour = ', L1, ')' ) |
---|
1334 | 11 FORMAT (/' dissolutional growth by HNO3 and NH3') |
---|
1335 | 12 FORMAT (/' dry deposition (on vegetation = ', L1, ' and on topography = ', L1, ')') |
---|
1336 | 13 FORMAT (/' Aerosol bin subrange limits (in metres): ', 3(ES10.2E3), / & |
---|
1337 | ' Number of size bins for each aerosol subrange: ', 2I3,/ & |
---|
1338 | ' Aerosol bin lower limits (in metres): ', 12(ES10.2E3)) |
---|
1339 | 25 FORMAT (/' Bin geometric mean diameters (in metres): ', 12(ES10.2E3)) |
---|
1340 | 14 FORMAT (' Initial number concentration in bins at the lowest level (#/m**3):', 9(ES10.2E3)) |
---|
1341 | 15 FORMAT (/' Number of chemical components used: ', I1,/ & |
---|
1342 | ' Species: ',7(A6),/ & |
---|
1343 | ' Initial relative contribution of each species to particle volume in:',/ & |
---|
1344 | ' a-bins: ', 7(F6.3),/ & |
---|
1345 | ' b-bins: ', 7(F6.3)) |
---|
1346 | 16 FORMAT (/' Number of gaseous tracers used: ', I1,/ & |
---|
1347 | ' Initial gas concentrations:',/ & |
---|
1348 | ' H2SO4: ',ES12.4E3, ' #/m**3',/ & |
---|
1349 | ' HNO3: ',ES12.4E3, ' #/m**3',/ & |
---|
1350 | ' NH3: ',ES12.4E3, ' #/m**3',/ & |
---|
1351 | ' OCNV: ',ES12.4E3, ' #/m**3',/ & |
---|
1352 | ' OCSV: ',ES12.4E3, ' #/m**3') |
---|
1353 | 17 FORMAT (/' Initialising concentrations: ', / & |
---|
1354 | ' Aerosol size distribution: init_aerosol_type = ', I1,/ & |
---|
1355 | ' Gas concentrations: init_gases_type = ', I1 ) |
---|
1356 | 18 FORMAT ( ' Mode diametres: dpg(nmod) = ', 7(F7.3), ' (m)', / & |
---|
1357 | ' Standard deviation: sigmag(nmod) = ', 7(F7.2),/ & |
---|
1358 | ' Number concentration: n_lognorm(nmod) = ', 7(ES12.4E3), ' (#/m3)' ) |
---|
1359 | 19 FORMAT (/' Size distribution read from a file.') |
---|
1360 | 20 FORMAT (/' Nesting for salsa variables: ', L1 ) |
---|
1361 | 21 FORMAT (/' Offline nesting for salsa variables: ', L1 ) |
---|
1362 | 22 FORMAT (/' Emissions: salsa_emission_mode = ', A ) |
---|
1363 | 23 FORMAT (/' surface_aerosol_flux = ', ES12.4E3, ' #/m**2/s', / & |
---|
1364 | ' aerosol_flux_dpg = ', 7(F7.3), ' (m)', / & |
---|
1365 | ' aerosol_flux_sigmag = ', 7(F7.2), / & |
---|
1366 | ' aerosol_mass_fracs_a = ', 7(ES12.4E3) ) |
---|
1367 | 24 FORMAT (/' (currently all emissions are soluble!)') |
---|
1368 | |
---|
1369 | END SUBROUTINE salsa_header |
---|
1370 | |
---|
1371 | !------------------------------------------------------------------------------! |
---|
1372 | ! Description: |
---|
1373 | ! ------------ |
---|
1374 | !> Allocate SALSA arrays and define pointers if required |
---|
1375 | !------------------------------------------------------------------------------! |
---|
1376 | SUBROUTINE salsa_init_arrays |
---|
1377 | |
---|
1378 | USE advec_ws, & |
---|
1379 | ONLY: ws_init_flags_scalar |
---|
1380 | |
---|
1381 | USE surface_mod, & |
---|
1382 | ONLY: surf_def_h, surf_def_v, surf_lsm_h, surf_lsm_v, surf_usm_h, surf_usm_v |
---|
1383 | |
---|
1384 | IMPLICIT NONE |
---|
1385 | |
---|
1386 | INTEGER(iwp) :: gases_available !< Number of available gas components in the chemistry model |
---|
1387 | INTEGER(iwp) :: i !< loop index for allocating |
---|
1388 | INTEGER(iwp) :: ii !< index for indexing chemical components |
---|
1389 | INTEGER(iwp) :: l !< loop index for allocating: surfaces |
---|
1390 | INTEGER(iwp) :: lsp !< loop index for chem species in the chemistry model |
---|
1391 | |
---|
1392 | gases_available = 0 |
---|
1393 | ! |
---|
1394 | !-- Allocate prognostic variables (see salsa_swap_timelevel) |
---|
1395 | ! |
---|
1396 | !-- Set derived indices: |
---|
1397 | !-- (This does the same as the subroutine salsa_initialize in SALSA/UCLALES-SALSA) |
---|
1398 | start_subrange_1a = 1 ! 1st index of subrange 1a |
---|
1399 | start_subrange_2a = start_subrange_1a + nbin(1) ! 1st index of subrange 2a |
---|
1400 | end_subrange_1a = start_subrange_2a - 1 ! last index of subrange 1a |
---|
1401 | end_subrange_2a = end_subrange_1a + nbin(2) ! last index of subrange 2a |
---|
1402 | |
---|
1403 | ! |
---|
1404 | !-- If the fraction of insoluble aerosols in subrange 2 is zero: do not allocate arrays for them |
---|
1405 | IF ( nf2a > 0.999999_wp .AND. SUM( mass_fracs_b ) < 0.00001_wp ) THEN |
---|
1406 | no_insoluble = .TRUE. |
---|
1407 | start_subrange_2b = end_subrange_2a+1 ! 1st index of subrange 2b |
---|
1408 | end_subrange_2b = end_subrange_2a ! last index of subrange 2b |
---|
1409 | ELSE |
---|
1410 | start_subrange_2b = start_subrange_2a + nbin(2) ! 1st index of subrange 2b |
---|
1411 | end_subrange_2b = end_subrange_2a + nbin(2) ! last index of subrange 2b |
---|
1412 | ENDIF |
---|
1413 | |
---|
1414 | nbins_aerosol = end_subrange_2b ! total number of aerosol size bins |
---|
1415 | ! |
---|
1416 | !-- Create index tables for different aerosol components |
---|
1417 | CALL component_index_constructor( prtcl, ncc, maxspec, listspec ) |
---|
1418 | |
---|
1419 | ncomponents_mass = ncc |
---|
1420 | IF ( advect_particle_water ) ncomponents_mass = ncc + 1 ! Add water |
---|
1421 | ! |
---|
1422 | !-- Indices for chemical components used (-1 = not used) |
---|
1423 | ii = 0 |
---|
1424 | IF ( is_used( prtcl, 'SO4' ) ) THEN |
---|
1425 | index_so4 = get_index( prtcl,'SO4' ) |
---|
1426 | ii = ii + 1 |
---|
1427 | ENDIF |
---|
1428 | IF ( is_used( prtcl,'OC' ) ) THEN |
---|
1429 | index_oc = get_index(prtcl, 'OC') |
---|
1430 | ii = ii + 1 |
---|
1431 | ENDIF |
---|
1432 | IF ( is_used( prtcl, 'BC' ) ) THEN |
---|
1433 | index_bc = get_index( prtcl, 'BC' ) |
---|
1434 | ii = ii + 1 |
---|
1435 | ENDIF |
---|
1436 | IF ( is_used( prtcl, 'DU' ) ) THEN |
---|
1437 | index_du = get_index( prtcl, 'DU' ) |
---|
1438 | ii = ii + 1 |
---|
1439 | ENDIF |
---|
1440 | IF ( is_used( prtcl, 'SS' ) ) THEN |
---|
1441 | index_ss = get_index( prtcl, 'SS' ) |
---|
1442 | ii = ii + 1 |
---|
1443 | ENDIF |
---|
1444 | IF ( is_used( prtcl, 'NO' ) ) THEN |
---|
1445 | index_no = get_index( prtcl, 'NO' ) |
---|
1446 | ii = ii + 1 |
---|
1447 | ENDIF |
---|
1448 | IF ( is_used( prtcl, 'NH' ) ) THEN |
---|
1449 | index_nh = get_index( prtcl, 'NH' ) |
---|
1450 | ii = ii + 1 |
---|
1451 | ENDIF |
---|
1452 | ! |
---|
1453 | !-- All species must be known |
---|
1454 | IF ( ii /= ncc ) THEN |
---|
1455 | message_string = 'Unknown aerosol species/component(s) given in the initialization' |
---|
1456 | CALL message( 'salsa_mod: salsa_init', 'PA0600', 1, 2, 0, 6, 0 ) |
---|
1457 | ENDIF |
---|
1458 | ! |
---|
1459 | !-- Allocate: |
---|
1460 | ALLOCATE( aero(nbins_aerosol), bc_am_t_val(nbins_aerosol*ncomponents_mass), & |
---|
1461 | bc_an_t_val(nbins_aerosol), bc_gt_t_val(ngases_salsa), bin_low_limits(nbins_aerosol),& |
---|
1462 | nsect(nbins_aerosol), massacc(nbins_aerosol) ) |
---|
1463 | ALLOCATE( k_topo_top(nysg:nyng,nxlg:nxrg) ) |
---|
1464 | IF ( nldepo ) ALLOCATE( sedim_vd(nzb:nzt+1,nysg:nyng,nxlg:nxrg,nbins_aerosol) ) |
---|
1465 | ALLOCATE( ra_dry(nzb:nzt+1,nysg:nyng,nxlg:nxrg,nbins_aerosol) ) |
---|
1466 | ! |
---|
1467 | !-- Initialise the sectional particle size distribution |
---|
1468 | CALL set_sizebins |
---|
1469 | ! |
---|
1470 | !-- Aerosol number concentration |
---|
1471 | ALLOCATE( aerosol_number(nbins_aerosol) ) |
---|
1472 | ALLOCATE( nconc_1(nzb:nzt+1,nysg:nyng,nxlg:nxrg,nbins_aerosol), & |
---|
1473 | nconc_2(nzb:nzt+1,nysg:nyng,nxlg:nxrg,nbins_aerosol), & |
---|
1474 | nconc_3(nzb:nzt+1,nysg:nyng,nxlg:nxrg,nbins_aerosol) ) |
---|
1475 | nconc_1 = 0.0_wp |
---|
1476 | nconc_2 = 0.0_wp |
---|
1477 | nconc_3 = 0.0_wp |
---|
1478 | |
---|
1479 | DO i = 1, nbins_aerosol |
---|
1480 | aerosol_number(i)%conc(nzb:nzt+1,nysg:nyng,nxlg:nxrg) => nconc_1(:,:,:,i) |
---|
1481 | aerosol_number(i)%conc_p(nzb:nzt+1,nysg:nyng,nxlg:nxrg) => nconc_2(:,:,:,i) |
---|
1482 | aerosol_number(i)%tconc_m(nzb:nzt+1,nysg:nyng,nxlg:nxrg) => nconc_3(:,:,:,i) |
---|
1483 | ALLOCATE( aerosol_number(i)%flux_s(nzb+1:nzt,0:threads_per_task-1), & |
---|
1484 | aerosol_number(i)%diss_s(nzb+1:nzt,0:threads_per_task-1), & |
---|
1485 | aerosol_number(i)%flux_l(nzb+1:nzt,nys:nyn,0:threads_per_task-1), & |
---|
1486 | aerosol_number(i)%diss_l(nzb+1:nzt,nys:nyn,0:threads_per_task-1), & |
---|
1487 | aerosol_number(i)%init(nzb:nzt+1), & |
---|
1488 | aerosol_number(i)%sums_ws_l(nzb:nzt+1,0:threads_per_task-1) ) |
---|
1489 | aerosol_number(i)%init = nclim |
---|
1490 | IF ( include_emission .OR. ( nldepo .AND. nldepo_surf ) ) THEN |
---|
1491 | ALLOCATE( aerosol_number(i)%source(nys:nyn,nxl:nxr) ) |
---|
1492 | aerosol_number(i)%source = 0.0_wp |
---|
1493 | ENDIF |
---|
1494 | ENDDO |
---|
1495 | |
---|
1496 | ! |
---|
1497 | !-- Aerosol mass concentration |
---|
1498 | ALLOCATE( aerosol_mass(ncomponents_mass*nbins_aerosol) ) |
---|
1499 | ALLOCATE( mconc_1(nzb:nzt+1,nysg:nyng,nxlg:nxrg,ncomponents_mass*nbins_aerosol), & |
---|
1500 | mconc_2(nzb:nzt+1,nysg:nyng,nxlg:nxrg,ncomponents_mass*nbins_aerosol), & |
---|
1501 | mconc_3(nzb:nzt+1,nysg:nyng,nxlg:nxrg,ncomponents_mass*nbins_aerosol) ) |
---|
1502 | mconc_1 = 0.0_wp |
---|
1503 | mconc_2 = 0.0_wp |
---|
1504 | mconc_3 = 0.0_wp |
---|
1505 | |
---|
1506 | DO i = 1, ncomponents_mass*nbins_aerosol |
---|
1507 | aerosol_mass(i)%conc(nzb:nzt+1,nysg:nyng,nxlg:nxrg) => mconc_1(:,:,:,i) |
---|
1508 | aerosol_mass(i)%conc_p(nzb:nzt+1,nysg:nyng,nxlg:nxrg) => mconc_2(:,:,:,i) |
---|
1509 | aerosol_mass(i)%tconc_m(nzb:nzt+1,nysg:nyng,nxlg:nxrg) => mconc_3(:,:,:,i) |
---|
1510 | ALLOCATE( aerosol_mass(i)%flux_s(nzb+1:nzt,0:threads_per_task-1), & |
---|
1511 | aerosol_mass(i)%diss_s(nzb+1:nzt,0:threads_per_task-1), & |
---|
1512 | aerosol_mass(i)%flux_l(nzb+1:nzt,nys:nyn,0:threads_per_task-1), & |
---|
1513 | aerosol_mass(i)%diss_l(nzb+1:nzt,nys:nyn,0:threads_per_task-1), & |
---|
1514 | aerosol_mass(i)%init(nzb:nzt+1), & |
---|
1515 | aerosol_mass(i)%sums_ws_l(nzb:nzt+1,0:threads_per_task-1) ) |
---|
1516 | aerosol_mass(i)%init = mclim |
---|
1517 | IF ( include_emission .OR. ( nldepo .AND. nldepo_surf ) ) THEN |
---|
1518 | ALLOCATE( aerosol_mass(i)%source(nys:nyn,nxl:nxr) ) |
---|
1519 | aerosol_mass(i)%source = 0.0_wp |
---|
1520 | ENDIF |
---|
1521 | ENDDO |
---|
1522 | |
---|
1523 | ! |
---|
1524 | !-- Surface fluxes: answs = aerosol number, amsws = aerosol mass |
---|
1525 | ! |
---|
1526 | !-- Horizontal surfaces: default type |
---|
1527 | DO l = 0, 2 ! upward (l=0), downward (l=1) and model top (l=2) |
---|
1528 | ALLOCATE( surf_def_h(l)%answs( 1:surf_def_h(l)%ns, nbins_aerosol ) ) |
---|
1529 | ALLOCATE( surf_def_h(l)%amsws( 1:surf_def_h(l)%ns, nbins_aerosol*ncomponents_mass ) ) |
---|
1530 | surf_def_h(l)%answs = 0.0_wp |
---|
1531 | surf_def_h(l)%amsws = 0.0_wp |
---|
1532 | ENDDO |
---|
1533 | ! |
---|
1534 | !-- Horizontal surfaces: natural type |
---|
1535 | ALLOCATE( surf_lsm_h%answs( 1:surf_lsm_h%ns, nbins_aerosol ) ) |
---|
1536 | ALLOCATE( surf_lsm_h%amsws( 1:surf_lsm_h%ns, nbins_aerosol*ncomponents_mass ) ) |
---|
1537 | surf_lsm_h%answs = 0.0_wp |
---|
1538 | surf_lsm_h%amsws = 0.0_wp |
---|
1539 | ! |
---|
1540 | !-- Horizontal surfaces: urban type |
---|
1541 | ALLOCATE( surf_usm_h%answs( 1:surf_usm_h%ns, nbins_aerosol ) ) |
---|
1542 | ALLOCATE( surf_usm_h%amsws( 1:surf_usm_h%ns, nbins_aerosol*ncomponents_mass ) ) |
---|
1543 | surf_usm_h%answs = 0.0_wp |
---|
1544 | surf_usm_h%amsws = 0.0_wp |
---|
1545 | |
---|
1546 | ! |
---|
1547 | !-- Vertical surfaces: northward (l=0), southward (l=1), eastward (l=2) and westward (l=3) facing |
---|
1548 | DO l = 0, 3 |
---|
1549 | ALLOCATE( surf_def_v(l)%answs( 1:surf_def_v(l)%ns, nbins_aerosol ) ) |
---|
1550 | surf_def_v(l)%answs = 0.0_wp |
---|
1551 | ALLOCATE( surf_def_v(l)%amsws( 1:surf_def_v(l)%ns, nbins_aerosol*ncomponents_mass ) ) |
---|
1552 | surf_def_v(l)%amsws = 0.0_wp |
---|
1553 | |
---|
1554 | ALLOCATE( surf_lsm_v(l)%answs( 1:surf_lsm_v(l)%ns, nbins_aerosol ) ) |
---|
1555 | surf_lsm_v(l)%answs = 0.0_wp |
---|
1556 | ALLOCATE( surf_lsm_v(l)%amsws( 1:surf_lsm_v(l)%ns, nbins_aerosol*ncomponents_mass ) ) |
---|
1557 | surf_lsm_v(l)%amsws = 0.0_wp |
---|
1558 | |
---|
1559 | ALLOCATE( surf_usm_v(l)%answs( 1:surf_usm_v(l)%ns, nbins_aerosol ) ) |
---|
1560 | surf_usm_v(l)%answs = 0.0_wp |
---|
1561 | ALLOCATE( surf_usm_v(l)%amsws( 1:surf_usm_v(l)%ns, nbins_aerosol*ncomponents_mass ) ) |
---|
1562 | surf_usm_v(l)%amsws = 0.0_wp |
---|
1563 | |
---|
1564 | ENDDO |
---|
1565 | |
---|
1566 | ! |
---|
1567 | !-- Concentration of gaseous tracers (1. SO4, 2. HNO3, 3. NH3, 4. OCNV, 5. OCSV) |
---|
1568 | !-- (number concentration (#/m3) ) |
---|
1569 | ! |
---|
1570 | !-- If chemistry is on, read gas phase concentrations from there. Otherwise, |
---|
1571 | !-- allocate salsa_gas array. |
---|
1572 | |
---|
1573 | IF ( air_chemistry ) THEN |
---|
1574 | DO lsp = 1, nvar |
---|
1575 | SELECT CASE ( TRIM( chem_species(lsp)%name ) ) |
---|
1576 | CASE ( 'H2SO4', 'h2so4' ) |
---|
1577 | gases_available = gases_available + 1 |
---|
1578 | gas_index_chem(1) = lsp |
---|
1579 | CASE ( 'HNO3', 'hno3' ) |
---|
1580 | gases_available = gases_available + 1 |
---|
1581 | gas_index_chem(2) = lsp |
---|
1582 | CASE ( 'NH3', 'nh3' ) |
---|
1583 | gases_available = gases_available + 1 |
---|
1584 | gas_index_chem(3) = lsp |
---|
1585 | CASE ( 'OCNV', 'ocnv' ) |
---|
1586 | gases_available = gases_available + 1 |
---|
1587 | gas_index_chem(4) = lsp |
---|
1588 | CASE ( 'OCSV', 'ocsv' ) |
---|
1589 | gases_available = gases_available + 1 |
---|
1590 | gas_index_chem(5) = lsp |
---|
1591 | END SELECT |
---|
1592 | ENDDO |
---|
1593 | |
---|
1594 | IF ( gases_available == ngases_salsa ) THEN |
---|
1595 | salsa_gases_from_chem = .TRUE. |
---|
1596 | ELSE |
---|
1597 | WRITE( message_string, * ) 'SALSA is run together with chemistry but not all gaseous '// & |
---|
1598 | 'components are provided by kpp (H2SO4, HNO3, NH3, OCNV, OCSV)' |
---|
1599 | CALL message( 'check_parameters', 'PA0599', 1, 2, 0, 6, 0 ) |
---|
1600 | ENDIF |
---|
1601 | |
---|
1602 | ELSE |
---|
1603 | |
---|
1604 | ALLOCATE( salsa_gas(ngases_salsa) ) |
---|
1605 | ALLOCATE( gconc_1(nzb:nzt+1,nysg:nyng,nxlg:nxrg,ngases_salsa), & |
---|
1606 | gconc_2(nzb:nzt+1,nysg:nyng,nxlg:nxrg,ngases_salsa), & |
---|
1607 | gconc_3(nzb:nzt+1,nysg:nyng,nxlg:nxrg,ngases_salsa) ) |
---|
1608 | gconc_1 = 0.0_wp |
---|
1609 | gconc_2 = 0.0_wp |
---|
1610 | gconc_3 = 0.0_wp |
---|
1611 | |
---|
1612 | DO i = 1, ngases_salsa |
---|
1613 | salsa_gas(i)%conc(nzb:nzt+1,nysg:nyng,nxlg:nxrg) => gconc_1(:,:,:,i) |
---|
1614 | salsa_gas(i)%conc_p(nzb:nzt+1,nysg:nyng,nxlg:nxrg) => gconc_2(:,:,:,i) |
---|
1615 | salsa_gas(i)%tconc_m(nzb:nzt+1,nysg:nyng,nxlg:nxrg) => gconc_3(:,:,:,i) |
---|
1616 | ALLOCATE( salsa_gas(i)%flux_s(nzb+1:nzt,0:threads_per_task-1), & |
---|
1617 | salsa_gas(i)%diss_s(nzb+1:nzt,0:threads_per_task-1), & |
---|
1618 | salsa_gas(i)%flux_l(nzb+1:nzt,nys:nyn,0:threads_per_task-1),& |
---|
1619 | salsa_gas(i)%diss_l(nzb+1:nzt,nys:nyn,0:threads_per_task-1),& |
---|
1620 | salsa_gas(i)%init(nzb:nzt+1), & |
---|
1621 | salsa_gas(i)%sums_ws_l(nzb:nzt+1,0:threads_per_task-1) ) |
---|
1622 | salsa_gas(i)%init = nclim |
---|
1623 | IF ( include_emission ) THEN |
---|
1624 | ALLOCATE( salsa_gas(i)%source(nys:nys,nxl:nxr) ) |
---|
1625 | salsa_gas(i)%source = 0.0_wp |
---|
1626 | ENDIF |
---|
1627 | ENDDO |
---|
1628 | ! |
---|
1629 | !-- Surface fluxes: gtsws = gaseous tracer flux |
---|
1630 | ! |
---|
1631 | !-- Horizontal surfaces: default type |
---|
1632 | DO l = 0, 2 ! upward (l=0), downward (l=1) and model top (l=2) |
---|
1633 | ALLOCATE( surf_def_h(l)%gtsws( 1:surf_def_h(l)%ns, ngases_salsa ) ) |
---|
1634 | surf_def_h(l)%gtsws = 0.0_wp |
---|
1635 | ENDDO |
---|
1636 | !-- Horizontal surfaces: natural type |
---|
1637 | ALLOCATE( surf_lsm_h%gtsws( 1:surf_lsm_h%ns, ngases_salsa ) ) |
---|
1638 | surf_lsm_h%gtsws = 0.0_wp |
---|
1639 | !-- Horizontal surfaces: urban type |
---|
1640 | ALLOCATE( surf_usm_h%gtsws( 1:surf_usm_h%ns, ngases_salsa ) ) |
---|
1641 | surf_usm_h%gtsws = 0.0_wp |
---|
1642 | ! |
---|
1643 | !-- Vertical surfaces: northward (l=0), southward (l=1), eastward (l=2) and |
---|
1644 | !-- westward (l=3) facing |
---|
1645 | DO l = 0, 3 |
---|
1646 | ALLOCATE( surf_def_v(l)%gtsws( 1:surf_def_v(l)%ns, ngases_salsa ) ) |
---|
1647 | surf_def_v(l)%gtsws = 0.0_wp |
---|
1648 | ALLOCATE( surf_lsm_v(l)%gtsws( 1:surf_lsm_v(l)%ns, ngases_salsa ) ) |
---|
1649 | surf_lsm_v(l)%gtsws = 0.0_wp |
---|
1650 | ALLOCATE( surf_usm_v(l)%gtsws( 1:surf_usm_v(l)%ns, ngases_salsa ) ) |
---|
1651 | surf_usm_v(l)%gtsws = 0.0_wp |
---|
1652 | ENDDO |
---|
1653 | ENDIF |
---|
1654 | |
---|
1655 | IF ( ws_scheme_sca ) THEN |
---|
1656 | |
---|
1657 | IF ( salsa ) THEN |
---|
1658 | ALLOCATE( sums_salsa_ws_l(nzb:nzt+1,0:threads_per_task-1) ) |
---|
1659 | sums_salsa_ws_l = 0.0_wp |
---|
1660 | ENDIF |
---|
1661 | |
---|
1662 | ENDIF |
---|
1663 | ! |
---|
1664 | !-- Set control flags for decycling only at lateral boundary cores. Within the inner cores the |
---|
1665 | !-- decycle flag is set to .FALSE.. Even though it does not affect the setting of chemistry boundary |
---|
1666 | !-- conditions, this flag is used to set advection control flags appropriately. |
---|
1667 | decycle_salsa_lr = MERGE( decycle_salsa_lr, .FALSE., nxl == 0 .OR. nxr == nx ) |
---|
1668 | decycle_salsa_ns = MERGE( decycle_salsa_ns, .FALSE., nys == 0 .OR. nyn == ny ) |
---|
1669 | ! |
---|
1670 | !-- Decycling can be applied separately for aerosol variables, while wind and other scalars may have |
---|
1671 | !-- cyclic or nested boundary conditions. However, large gradients near the boundaries may produce |
---|
1672 | !-- stationary numerical oscillations near the lateral boundaries when a higher-order scheme is |
---|
1673 | !-- applied near these boundaries. To get rid-off this, set-up additional flags that control the |
---|
1674 | !-- order of the scalar advection scheme near the lateral boundaries for passive scalars with |
---|
1675 | !-- decycling. |
---|
1676 | IF ( scalar_advec == 'ws-scheme' ) THEN |
---|
1677 | ALLOCATE( salsa_advc_flags_s(nzb:nzt+1,nysg:nyng,nxlg:nxrg) ) |
---|
1678 | ! |
---|
1679 | !-- In case of decycling, set Neuman boundary conditions for wall_flags_total_0 bit 31 instead of |
---|
1680 | !-- cyclic boundary conditions. Bit 31 is used to identify extended degradation zones (please see |
---|
1681 | !-- the following comment). Note, since several also other modules may access this bit but may |
---|
1682 | !-- have other boundary conditions, the original value of wall_flags_total_0 bit 31 must not be |
---|
1683 | !-- modified. Hence, store the boundary conditions directly on salsa_advc_flags_s. |
---|
1684 | !-- salsa_advc_flags_s will be later overwritten in ws_init_flags_scalar and bit 31 won't be used |
---|
1685 | !-- to control the numerical order. |
---|
1686 | !-- Initialize with flag 31 only. |
---|
1687 | salsa_advc_flags_s = 0 |
---|
1688 | salsa_advc_flags_s = MERGE( IBSET( salsa_advc_flags_s, 31 ), 0, BTEST( wall_flags_total_0, 31 ) ) |
---|
1689 | |
---|
1690 | IF ( decycle_salsa_ns ) THEN |
---|
1691 | IF ( nys == 0 ) THEN |
---|
1692 | DO i = 1, nbgp |
---|
1693 | salsa_advc_flags_s(:,nys-i,:) = MERGE( IBSET( salsa_advc_flags_s(:,nys,:), 31 ), & |
---|
1694 | IBCLR( salsa_advc_flags_s(:,nys,:), 31 ), & |
---|
1695 | BTEST( salsa_advc_flags_s(:,nys,:), 31 ) ) |
---|
1696 | ENDDO |
---|
1697 | ENDIF |
---|
1698 | IF ( nyn == ny ) THEN |
---|
1699 | DO i = 1, nbgp |
---|
1700 | salsa_advc_flags_s(:,nyn+i,:) = MERGE( IBSET( salsa_advc_flags_s(:,nyn,:), 31 ), & |
---|
1701 | IBCLR( salsa_advc_flags_s(:,nyn,:), 31 ), & |
---|
1702 | BTEST( salsa_advc_flags_s(:,nyn,:), 31 ) ) |
---|
1703 | ENDDO |
---|
1704 | ENDIF |
---|
1705 | ENDIF |
---|
1706 | IF ( decycle_salsa_lr ) THEN |
---|
1707 | IF ( nxl == 0 ) THEN |
---|
1708 | DO i = 1, nbgp |
---|
1709 | salsa_advc_flags_s(:,:,nxl-i) = MERGE( IBSET( salsa_advc_flags_s(:,:,nxl), 31 ), & |
---|
1710 | IBCLR( salsa_advc_flags_s(:,:,nxl), 31 ), & |
---|
1711 | BTEST( salsa_advc_flags_s(:,:,nxl), 31 ) ) |
---|
1712 | ENDDO |
---|
1713 | ENDIF |
---|
1714 | IF ( nxr == nx ) THEN |
---|
1715 | DO i = 1, nbgp |
---|
1716 | salsa_advc_flags_s(:,:,nxr+i) = MERGE( IBSET( salsa_advc_flags_s(:,:,nxr), 31 ), & |
---|
1717 | IBCLR( salsa_advc_flags_s(:,:,nxr), 31 ), & |
---|
1718 | BTEST( salsa_advc_flags_s(:,:,nxr), 31 ) ) |
---|
1719 | ENDDO |
---|
1720 | ENDIF |
---|
1721 | ENDIF |
---|
1722 | ! |
---|
1723 | !-- To initialise the advection flags appropriately, pass the boundary flags to |
---|
1724 | !-- ws_init_flags_scalar. The last argument in ws_init_flags_scalar indicates that a passive |
---|
1725 | !-- scalar is being treated and the horizontal advection terms are degraded already 2 grid points |
---|
1726 | !-- before the lateral boundary. Also, extended degradation zones are applied, where |
---|
1727 | !-- horizontal advection of scalars is discretised by the first-order scheme at all grid points |
---|
1728 | !-- in the vicinity of buildings (<= 3 grid points). Even though no building is within the |
---|
1729 | !-- numerical stencil, the first-order scheme is used. At fourth and fifth grid points, the order |
---|
1730 | !-- of the horizontal advection scheme is successively upgraded. |
---|
1731 | !-- These degradations of the advection scheme are done to avoid stationary numerical |
---|
1732 | !-- oscillations, which are responsible for high concentration maxima that may appear e.g. under |
---|
1733 | !-- shear-free stable conditions. |
---|
1734 | CALL ws_init_flags_scalar( bc_dirichlet_l .OR. bc_radiation_l .OR. decycle_salsa_lr, & |
---|
1735 | bc_dirichlet_n .OR. bc_radiation_n .OR. decycle_salsa_ns, & |
---|
1736 | bc_dirichlet_r .OR. bc_radiation_r .OR. decycle_salsa_lr, & |
---|
1737 | bc_dirichlet_s .OR. bc_radiation_s .OR. decycle_salsa_ns, & |
---|
1738 | salsa_advc_flags_s, .TRUE. ) |
---|
1739 | ENDIF |
---|
1740 | |
---|
1741 | |
---|
1742 | END SUBROUTINE salsa_init_arrays |
---|
1743 | |
---|
1744 | !------------------------------------------------------------------------------! |
---|
1745 | ! Description: |
---|
1746 | ! ------------ |
---|
1747 | !> Initialization of SALSA. Based on salsa_initialize in UCLALES-SALSA. |
---|
1748 | !> Subroutines salsa_initialize, SALSAinit and DiagInitAero in UCLALES-SALSA are |
---|
1749 | !> also merged here. |
---|
1750 | !------------------------------------------------------------------------------! |
---|
1751 | SUBROUTINE salsa_init |
---|
1752 | |
---|
1753 | IMPLICIT NONE |
---|
1754 | |
---|
1755 | INTEGER(iwp) :: i !< |
---|
1756 | INTEGER(iwp) :: ib !< loop index for aerosol number bins |
---|
1757 | INTEGER(iwp) :: ic !< loop index for aerosol mass bins |
---|
1758 | INTEGER(iwp) :: ig !< loop index for gases |
---|
1759 | INTEGER(iwp) :: j !< |
---|
1760 | |
---|
1761 | IF ( debug_output ) CALL debug_message( 'salsa_init', 'start' ) |
---|
1762 | |
---|
1763 | bin_low_limits = 0.0_wp |
---|
1764 | k_topo_top = 0 |
---|
1765 | nsect = 0.0_wp |
---|
1766 | massacc = 1.0_wp |
---|
1767 | ! |
---|
1768 | !-- Initialise |
---|
1769 | IF ( nldepo ) sedim_vd = 0.0_wp |
---|
1770 | |
---|
1771 | IF ( .NOT. salsa_gases_from_chem ) THEN |
---|
1772 | IF ( .NOT. read_restart_data_salsa ) THEN |
---|
1773 | salsa_gas(1)%conc = h2so4_init |
---|
1774 | salsa_gas(2)%conc = hno3_init |
---|
1775 | salsa_gas(3)%conc = nh3_init |
---|
1776 | salsa_gas(4)%conc = ocnv_init |
---|
1777 | salsa_gas(5)%conc = ocsv_init |
---|
1778 | ENDIF |
---|
1779 | DO ig = 1, ngases_salsa |
---|
1780 | salsa_gas(ig)%conc_p = 0.0_wp |
---|
1781 | salsa_gas(ig)%tconc_m = 0.0_wp |
---|
1782 | salsa_gas(ig)%flux_s = 0.0_wp |
---|
1783 | salsa_gas(ig)%diss_s = 0.0_wp |
---|
1784 | salsa_gas(ig)%flux_l = 0.0_wp |
---|
1785 | salsa_gas(ig)%diss_l = 0.0_wp |
---|
1786 | salsa_gas(ig)%sums_ws_l = 0.0_wp |
---|
1787 | salsa_gas(ig)%conc_p = salsa_gas(ig)%conc |
---|
1788 | ENDDO |
---|
1789 | ! |
---|
1790 | !-- Set initial value for gas compound tracer |
---|
1791 | salsa_gas(1)%init = h2so4_init |
---|
1792 | salsa_gas(2)%init = hno3_init |
---|
1793 | salsa_gas(3)%init = nh3_init |
---|
1794 | salsa_gas(4)%init = ocnv_init |
---|
1795 | salsa_gas(5)%init = ocsv_init |
---|
1796 | ENDIF |
---|
1797 | ! |
---|
1798 | !-- Aerosol radius in each bin: dry and wet (m) |
---|
1799 | ra_dry = 1.0E-10_wp |
---|
1800 | ! |
---|
1801 | !-- Initialise location-dependent aerosol size distributions and chemical compositions: |
---|
1802 | CALL aerosol_init |
---|
1803 | |
---|
1804 | !-- Initalisation run of SALSA + calculate the vertical top index of the topography |
---|
1805 | DO i = nxl, nxr |
---|
1806 | DO j = nys, nyn |
---|
1807 | |
---|
1808 | k_topo_top(j,i) = MAXLOC( MERGE( 1, 0, BTEST( wall_flags_total_0(:,j,i), 12 ) ), & |
---|
1809 | DIM = 1 ) - 1 |
---|
1810 | |
---|
1811 | CALL salsa_driver( i, j, 1 ) |
---|
1812 | CALL salsa_diagnostics( i, j ) |
---|
1813 | ENDDO |
---|
1814 | ENDDO |
---|
1815 | |
---|
1816 | DO ib = 1, nbins_aerosol |
---|
1817 | aerosol_number(ib)%conc_p = aerosol_number(ib)%conc |
---|
1818 | aerosol_number(ib)%tconc_m = 0.0_wp |
---|
1819 | aerosol_number(ib)%flux_s = 0.0_wp |
---|
1820 | aerosol_number(ib)%diss_s = 0.0_wp |
---|
1821 | aerosol_number(ib)%flux_l = 0.0_wp |
---|
1822 | aerosol_number(ib)%diss_l = 0.0_wp |
---|
1823 | aerosol_number(ib)%sums_ws_l = 0.0_wp |
---|
1824 | ENDDO |
---|
1825 | DO ic = 1, ncomponents_mass*nbins_aerosol |
---|
1826 | aerosol_mass(ic)%conc_p = aerosol_mass(ic)%conc |
---|
1827 | aerosol_mass(ic)%tconc_m = 0.0_wp |
---|
1828 | aerosol_mass(ic)%flux_s = 0.0_wp |
---|
1829 | aerosol_mass(ic)%diss_s = 0.0_wp |
---|
1830 | aerosol_mass(ic)%flux_l = 0.0_wp |
---|
1831 | aerosol_mass(ic)%diss_l = 0.0_wp |
---|
1832 | aerosol_mass(ic)%sums_ws_l = 0.0_wp |
---|
1833 | ENDDO |
---|
1834 | ! |
---|
1835 | ! |
---|
1836 | !-- Initialise the deposition scheme and surface types |
---|
1837 | IF ( nldepo ) CALL init_deposition |
---|
1838 | |
---|
1839 | IF ( include_emission ) THEN |
---|
1840 | ! |
---|
1841 | !-- Read in and initialize emissions |
---|
1842 | CALL salsa_emission_setup( .TRUE. ) |
---|
1843 | IF ( .NOT. salsa_gases_from_chem .AND. salsa_emission_mode == 'read_from_file' ) THEN |
---|
1844 | CALL salsa_gas_emission_setup( .TRUE. ) |
---|
1845 | ENDIF |
---|
1846 | ENDIF |
---|
1847 | ! |
---|
1848 | !-- Partition and dissolutional growth by gaseous HNO3 and NH3 |
---|
1849 | IF ( index_no > 0 .AND. index_nh > 0 .AND. index_so4 > 0 ) lspartition = .TRUE. |
---|
1850 | |
---|
1851 | IF ( debug_output ) CALL debug_message( 'salsa_init', 'end' ) |
---|
1852 | |
---|
1853 | END SUBROUTINE salsa_init |
---|
1854 | |
---|
1855 | !------------------------------------------------------------------------------! |
---|
1856 | ! Description: |
---|
1857 | ! ------------ |
---|
1858 | !> Initializes particle size distribution grid by calculating size bin limits |
---|
1859 | !> and mid-size for *dry* particles in each bin. Called from salsa_initialize |
---|
1860 | !> (only at the beginning of simulation). |
---|
1861 | !> Size distribution described using: |
---|
1862 | !> 1) moving center method (subranges 1 and 2) |
---|
1863 | !> (Jacobson, Atmos. Env., 31, 131-144, 1997) |
---|
1864 | !> 2) fixed sectional method (subrange 3) |
---|
1865 | !> Size bins in each subrange are spaced logarithmically |
---|
1866 | !> based on given subrange size limits and bin number. |
---|
1867 | ! |
---|
1868 | !> Mona changed 06/2017: Use geometric mean diameter to describe the mean |
---|
1869 | !> particle diameter in a size bin, not the arithmeric mean which clearly |
---|
1870 | !> overestimates the total particle volume concentration. |
---|
1871 | ! |
---|
1872 | !> Coded by: |
---|
1873 | !> Hannele Korhonen (FMI) 2005 |
---|
1874 | !> Harri Kokkola (FMI) 2006 |
---|
1875 | ! |
---|
1876 | !> Bug fixes for box model + updated for the new aerosol datatype: |
---|
1877 | !> Juha Tonttila (FMI) 2014 |
---|
1878 | !------------------------------------------------------------------------------! |
---|
1879 | SUBROUTINE set_sizebins |
---|
1880 | |
---|
1881 | IMPLICIT NONE |
---|
1882 | |
---|
1883 | INTEGER(iwp) :: cc !< running index |
---|
1884 | INTEGER(iwp) :: dd !< running index |
---|
1885 | |
---|
1886 | REAL(wp) :: ratio_d !< ratio of the upper and lower diameter of subranges |
---|
1887 | |
---|
1888 | aero(:)%dwet = 1.0E-10_wp |
---|
1889 | aero(:)%veqh2o = 1.0E-10_wp |
---|
1890 | aero(:)%numc = nclim |
---|
1891 | aero(:)%core = 1.0E-10_wp |
---|
1892 | DO cc = 1, maxspec+1 ! 1:SO4, 2:OC, 3:BC, 4:DU, 5:SS, 6:NO, 7:NH, 8:H2O |
---|
1893 | aero(:)%volc(cc) = 0.0_wp |
---|
1894 | ENDDO |
---|
1895 | ! |
---|
1896 | !-- vlolim&vhilim: min & max *dry* volumes [fxm] |
---|
1897 | !-- dmid: bin mid *dry* diameter (m) |
---|
1898 | !-- vratiolo&vratiohi: volume ratio between the center and low/high limit |
---|
1899 | ! |
---|
1900 | !-- 1) Size subrange 1: |
---|
1901 | ratio_d = reglim(2) / reglim(1) ! section spacing (m) |
---|
1902 | DO cc = start_subrange_1a, end_subrange_1a |
---|
1903 | aero(cc)%vlolim = api6 * ( reglim(1) * ratio_d**( REAL( cc-1 ) / nbin(1) ) )**3 |
---|
1904 | aero(cc)%vhilim = api6 * ( reglim(1) * ratio_d**( REAL( cc ) / nbin(1) ) )**3 |
---|
1905 | aero(cc)%dmid = SQRT( ( aero(cc)%vhilim / api6 )**0.33333333_wp * & |
---|
1906 | ( aero(cc)%vlolim / api6 )**0.33333333_wp ) |
---|
1907 | aero(cc)%vratiohi = aero(cc)%vhilim / ( api6 * aero(cc)%dmid**3 ) |
---|
1908 | aero(cc)%vratiolo = aero(cc)%vlolim / ( api6 * aero(cc)%dmid**3 ) |
---|
1909 | ENDDO |
---|
1910 | ! |
---|
1911 | !-- 2) Size subrange 2: |
---|
1912 | !-- 2.1) Sub-subrange 2a: high hygroscopicity |
---|
1913 | ratio_d = reglim(3) / reglim(2) ! section spacing |
---|
1914 | DO dd = start_subrange_2a, end_subrange_2a |
---|
1915 | cc = dd - start_subrange_2a |
---|
1916 | aero(dd)%vlolim = api6 * ( reglim(2) * ratio_d**( REAL( cc ) / nbin(2) ) )**3 |
---|
1917 | aero(dd)%vhilim = api6 * ( reglim(2) * ratio_d**( REAL( cc+1 ) / nbin(2) ) )**3 |
---|
1918 | aero(dd)%dmid = SQRT( ( aero(dd)%vhilim / api6 )**0.33333333_wp * & |
---|
1919 | ( aero(dd)%vlolim / api6 )**0.33333333_wp ) |
---|
1920 | aero(dd)%vratiohi = aero(dd)%vhilim / ( api6 * aero(dd)%dmid**3 ) |
---|
1921 | aero(dd)%vratiolo = aero(dd)%vlolim / ( api6 * aero(dd)%dmid**3 ) |
---|
1922 | ENDDO |
---|
1923 | ! |
---|
1924 | !-- 2.2) Sub-subrange 2b: low hygroscopicity |
---|
1925 | IF ( .NOT. no_insoluble ) THEN |
---|
1926 | aero(start_subrange_2b:end_subrange_2b)%vlolim = aero(start_subrange_2a:end_subrange_2a)%vlolim |
---|
1927 | aero(start_subrange_2b:end_subrange_2b)%vhilim = aero(start_subrange_2a:end_subrange_2a)%vhilim |
---|
1928 | aero(start_subrange_2b:end_subrange_2b)%dmid = aero(start_subrange_2a:end_subrange_2a)%dmid |
---|
1929 | aero(start_subrange_2b:end_subrange_2b)%vratiohi = aero(start_subrange_2a:end_subrange_2a)%vratiohi |
---|
1930 | aero(start_subrange_2b:end_subrange_2b)%vratiolo = aero(start_subrange_2a:end_subrange_2a)%vratiolo |
---|
1931 | ENDIF |
---|
1932 | ! |
---|
1933 | !-- Initialize the wet diameter with the bin dry diameter to avoid numerical problems later |
---|
1934 | aero(:)%dwet = aero(:)%dmid |
---|
1935 | ! |
---|
1936 | !-- Save bin limits (lower diameter) to be delivered to PALM if needed |
---|
1937 | DO cc = 1, nbins_aerosol |
---|
1938 | bin_low_limits(cc) = ( aero(cc)%vlolim / api6 )**0.33333333_wp |
---|
1939 | ENDDO |
---|
1940 | |
---|
1941 | END SUBROUTINE set_sizebins |
---|
1942 | |
---|
1943 | !------------------------------------------------------------------------------! |
---|
1944 | ! Description: |
---|
1945 | ! ------------ |
---|
1946 | !> Initilize altitude-dependent aerosol size distributions and compositions. |
---|
1947 | !> |
---|
1948 | !> Mona added 06/2017: Correct the number and mass concentrations by normalizing |
---|
1949 | !< by the given total number and mass concentration. |
---|
1950 | !> |
---|
1951 | !> Tomi Raatikainen, FMI, 29.2.2016 |
---|
1952 | !------------------------------------------------------------------------------! |
---|
1953 | SUBROUTINE aerosol_init |
---|
1954 | |
---|
1955 | USE netcdf_data_input_mod, & |
---|
1956 | ONLY: check_existence, close_input_file, get_dimension_length, & |
---|
1957 | get_attribute, get_variable, & |
---|
1958 | inquire_num_variables, inquire_variable_names, & |
---|
1959 | open_read_file |
---|
1960 | |
---|
1961 | IMPLICIT NONE |
---|
1962 | |
---|
1963 | CHARACTER(LEN=25), DIMENSION(:), ALLOCATABLE :: cc_name !< chemical component name |
---|
1964 | CHARACTER(LEN=100), DIMENSION(:), ALLOCATABLE :: var_names !< variable names |
---|
1965 | |
---|
1966 | INTEGER(iwp) :: ee !< index: end |
---|
1967 | INTEGER(iwp) :: i !< loop index: x-direction |
---|
1968 | INTEGER(iwp) :: ib !< loop index: size bins |
---|
1969 | INTEGER(iwp) :: ic !< loop index: chemical components |
---|
1970 | INTEGER(iwp) :: id_dyn !< NetCDF id of PIDS_DYNAMIC_SALSA |
---|
1971 | INTEGER(iwp) :: ig !< loop index: gases |
---|
1972 | INTEGER(iwp) :: j !< loop index: y-direction |
---|
1973 | INTEGER(iwp) :: k !< loop index: z-direction |
---|
1974 | INTEGER(iwp) :: lod_aero !< level of detail of inital aerosol concentrations |
---|
1975 | INTEGER(iwp) :: num_vars !< number of variables |
---|
1976 | INTEGER(iwp) :: pr_nbins !< number of aerosol size bins in file |
---|
1977 | INTEGER(iwp) :: pr_ncc !< number of aerosol chemical components in file |
---|
1978 | INTEGER(iwp) :: pr_nz !< number of vertical grid-points in file |
---|
1979 | INTEGER(iwp) :: prunmode !< running mode of SALSA |
---|
1980 | INTEGER(iwp) :: ss !< index: start |
---|
1981 | |
---|
1982 | INTEGER(iwp), DIMENSION(maxspec) :: cc_in2mod |
---|
1983 | |
---|
1984 | LOGICAL :: netcdf_extend = .FALSE. !< Flag: netcdf file exists |
---|
1985 | |
---|
1986 | REAL(wp) :: flag !< flag to mask topography grid points |
---|
1987 | |
---|
1988 | REAL(wp), DIMENSION(nbins_aerosol) :: core !< size of the bin mid aerosol particle |
---|
1989 | |
---|
1990 | REAL(wp), DIMENSION(0:nz+1) :: pnf2a !< number fraction in 2a |
---|
1991 | REAL(wp), DIMENSION(0:nz+1) :: pmfoc1a !< mass fraction of OC in 1a |
---|
1992 | |
---|
1993 | REAL(wp), DIMENSION(0:nz+1,nbins_aerosol) :: pndist !< vertical profile of size dist. (#/m3) |
---|
1994 | REAL(wp), DIMENSION(0:nz+1,maxspec) :: pmf2a !< mass distributions in subrange 2a |
---|
1995 | REAL(wp), DIMENSION(0:nz+1,maxspec) :: pmf2b !< mass distributions in subrange 2b |
---|
1996 | |
---|
1997 | REAL(wp), DIMENSION(:), ALLOCATABLE :: pr_dmid !< vertical profile of aerosol bin diameters |
---|
1998 | REAL(wp), DIMENSION(:), ALLOCATABLE :: pr_z !< z levels of profiles |
---|
1999 | |
---|
2000 | REAL(wp), DIMENSION(:,:), ALLOCATABLE :: pr_mass_fracs_a !< mass fraction: a |
---|
2001 | REAL(wp), DIMENSION(:,:), ALLOCATABLE :: pr_mass_fracs_b !< and b |
---|
2002 | |
---|
2003 | cc_in2mod = 0 |
---|
2004 | prunmode = 1 |
---|
2005 | ! |
---|
2006 | !-- Bin mean aerosol particle volume (m3) |
---|
2007 | core(1:nbins_aerosol) = api6 * aero(1:nbins_aerosol)%dmid**3 |
---|
2008 | ! |
---|
2009 | !-- Set concentrations to zero |
---|
2010 | pndist(:,:) = 0.0_wp |
---|
2011 | pnf2a(:) = nf2a |
---|
2012 | pmf2a(:,:) = 0.0_wp |
---|
2013 | pmf2b(:,:) = 0.0_wp |
---|
2014 | pmfoc1a(:) = 0.0_wp |
---|
2015 | |
---|
2016 | IF ( init_aerosol_type == 1 ) THEN |
---|
2017 | ! |
---|
2018 | !-- Read input profiles from PIDS_DYNAMIC_SALSA |
---|
2019 | #if defined( __netcdf ) |
---|
2020 | ! |
---|
2021 | !-- Location-dependent size distributions and compositions. |
---|
2022 | INQUIRE( FILE = TRIM( input_file_dynamic ) // TRIM( coupling_char ), EXIST = netcdf_extend ) |
---|
2023 | IF ( netcdf_extend ) THEN |
---|
2024 | ! |
---|
2025 | !-- Open file in read-only mode |
---|
2026 | CALL open_read_file( TRIM( input_file_dynamic ) // TRIM( coupling_char ), id_dyn ) |
---|
2027 | ! |
---|
2028 | !-- At first, inquire all variable names |
---|
2029 | CALL inquire_num_variables( id_dyn, num_vars ) |
---|
2030 | ! |
---|
2031 | !-- Allocate memory to store variable names |
---|
2032 | ALLOCATE( var_names(1:num_vars) ) |
---|
2033 | CALL inquire_variable_names( id_dyn, var_names ) |
---|
2034 | ! |
---|
2035 | !-- Inquire vertical dimension and number of aerosol chemical components |
---|
2036 | CALL get_dimension_length( id_dyn, pr_nz, 'z' ) |
---|
2037 | IF ( pr_nz /= nz ) THEN |
---|
2038 | WRITE( message_string, * ) 'Number of inifor horizontal grid points does not match '//& |
---|
2039 | 'the number of numeric grid points.' |
---|
2040 | CALL message( 'aerosol_init', 'PA0601', 1, 2, 0, 6, 0 ) |
---|
2041 | ENDIF |
---|
2042 | CALL get_dimension_length( id_dyn, pr_ncc, 'composition_index' ) |
---|
2043 | ! |
---|
2044 | !-- Allocate memory |
---|
2045 | ALLOCATE( pr_z(1:pr_nz), pr_mass_fracs_a(nzb:nzt+1,pr_ncc), & |
---|
2046 | pr_mass_fracs_b(nzb:nzt+1,pr_ncc) ) |
---|
2047 | pr_mass_fracs_a = 0.0_wp |
---|
2048 | pr_mass_fracs_b = 0.0_wp |
---|
2049 | ! |
---|
2050 | !-- Read vertical levels |
---|
2051 | CALL get_variable( id_dyn, 'z', pr_z ) |
---|
2052 | ! |
---|
2053 | !-- Read the names of chemical components |
---|
2054 | IF ( check_existence( var_names, 'composition_name' ) ) THEN |
---|
2055 | CALL get_variable( id_dyn, 'composition_name', cc_name, pr_ncc ) |
---|
2056 | ELSE |
---|
2057 | WRITE( message_string, * ) 'Missing composition_name in ' // TRIM( input_file_dynamic ) |
---|
2058 | CALL message( 'aerosol_init', 'PA0655', 1, 2, 0, 6, 0 ) |
---|
2059 | ENDIF |
---|
2060 | ! |
---|
2061 | !-- Define the index of each chemical component in the model |
---|
2062 | DO ic = 1, pr_ncc |
---|
2063 | SELECT CASE ( TRIM( cc_name(ic) ) ) |
---|
2064 | CASE ( 'H2SO4', 'SO4', 'h2so4', 'so4' ) |
---|
2065 | cc_in2mod(1) = ic |
---|
2066 | CASE ( 'OC', 'oc' ) |
---|
2067 | cc_in2mod(2) = ic |
---|
2068 | CASE ( 'BC', 'bc' ) |
---|
2069 | cc_in2mod(3) = ic |
---|
2070 | CASE ( 'DU', 'du' ) |
---|
2071 | cc_in2mod(4) = ic |
---|
2072 | CASE ( 'SS', 'ss' ) |
---|
2073 | cc_in2mod(5) = ic |
---|
2074 | CASE ( 'HNO3', 'hno3', 'NO3', 'no3', 'NO', 'no' ) |
---|
2075 | cc_in2mod(6) = ic |
---|
2076 | CASE ( 'NH3', 'nh3', 'NH4', 'nh4', 'NH', 'nh' ) |
---|
2077 | cc_in2mod(7) = ic |
---|
2078 | END SELECT |
---|
2079 | ENDDO |
---|
2080 | |
---|
2081 | IF ( SUM( cc_in2mod ) == 0 ) THEN |
---|
2082 | message_string = 'None of the aerosol chemical components in ' // TRIM( & |
---|
2083 | input_file_dynamic ) // ' correspond to ones applied in SALSA.' |
---|
2084 | CALL message( 'salsa_mod: aerosol_init', 'PA0602', 2, 2, 0, 6, 0 ) |
---|
2085 | ENDIF |
---|
2086 | ! |
---|
2087 | !-- Vertical profiles of mass fractions of different chemical components: |
---|
2088 | IF ( check_existence( var_names, 'init_atmosphere_mass_fracs_a' ) ) THEN |
---|
2089 | CALL get_variable( id_dyn, 'init_atmosphere_mass_fracs_a', pr_mass_fracs_a, & |
---|
2090 | 0, pr_ncc-1, 0, pr_nz-1 ) |
---|
2091 | ELSE |
---|
2092 | WRITE( message_string, * ) 'Missing init_atmosphere_mass_fracs_a in ' // & |
---|
2093 | TRIM( input_file_dynamic ) |
---|
2094 | CALL message( 'aerosol_init', 'PA0656', 1, 2, 0, 6, 0 ) |
---|
2095 | ENDIF |
---|
2096 | CALL get_variable( id_dyn, 'init_atmosphere_mass_fracs_b', pr_mass_fracs_b, & |
---|
2097 | 0, pr_ncc-1, 0, pr_nz-1 ) |
---|
2098 | ! |
---|
2099 | !-- Match the input data with the chemical composition applied in the model |
---|
2100 | DO ic = 1, maxspec |
---|
2101 | ss = cc_in2mod(ic) |
---|
2102 | IF ( ss == 0 ) CYCLE |
---|
2103 | pmf2a(nzb+1:nzt+1,ic) = pr_mass_fracs_a(nzb:nzt,ss) |
---|
2104 | pmf2b(nzb+1:nzt+1,ic) = pr_mass_fracs_b(nzb:nzt,ss) |
---|
2105 | ENDDO |
---|
2106 | ! |
---|
2107 | !-- Aerosol concentrations: lod=1 (vertical profile of sectional number size distribution) |
---|
2108 | CALL get_attribute( id_dyn, 'lod', lod_aero, .FALSE., 'init_atmosphere_aerosol' ) |
---|
2109 | IF ( lod_aero /= 1 ) THEN |
---|
2110 | message_string = 'Currently only lod=1 accepted for init_atmosphere_aerosol' |
---|
2111 | CALL message( 'salsa_mod: aerosol_init', 'PA0603', 2, 2, 0, 6, 0 ) |
---|
2112 | ELSE |
---|
2113 | ! |
---|
2114 | !-- Bin mean diameters in the input file |
---|
2115 | CALL get_dimension_length( id_dyn, pr_nbins, 'Dmid') |
---|
2116 | IF ( pr_nbins /= nbins_aerosol ) THEN |
---|
2117 | message_string = 'Number of size bins in init_atmosphere_aerosol does not match ' & |
---|
2118 | // 'with that applied in the model' |
---|
2119 | CALL message( 'salsa_mod: aerosol_init', 'PA0604', 2, 2, 0, 6, 0 ) |
---|
2120 | ENDIF |
---|
2121 | |
---|
2122 | ALLOCATE( pr_dmid(pr_nbins) ) |
---|
2123 | pr_dmid = 0.0_wp |
---|
2124 | |
---|
2125 | CALL get_variable( id_dyn, 'Dmid', pr_dmid ) |
---|
2126 | ! |
---|
2127 | !-- Check whether the sectional representation conform to the one |
---|
2128 | !-- applied in the model |
---|
2129 | IF ( ANY( ABS( ( aero(1:nbins_aerosol)%dmid - pr_dmid ) / & |
---|
2130 | aero(1:nbins_aerosol)%dmid ) > 0.1_wp ) ) THEN |
---|
2131 | message_string = 'Mean diameters of the aerosol size bins in ' // TRIM( & |
---|
2132 | input_file_dynamic ) // ' do not match with the sectional '// & |
---|
2133 | 'representation of the model.' |
---|
2134 | CALL message( 'salsa_mod: aerosol_init', 'PA0605', 2, 2, 0, 6, 0 ) |
---|
2135 | ENDIF |
---|
2136 | ! |
---|
2137 | !-- Inital aerosol concentrations |
---|
2138 | CALL get_variable( id_dyn, 'init_atmosphere_aerosol', pndist(nzb+1:nzt,:), & |
---|
2139 | 0, pr_nbins-1, 0, pr_nz-1 ) |
---|
2140 | ENDIF |
---|
2141 | ! |
---|
2142 | !-- Set bottom and top boundary condition (Neumann) |
---|
2143 | pmf2a(nzb,:) = pmf2a(nzb+1,:) |
---|
2144 | pmf2a(nzt+1,:) = pmf2a(nzt,:) |
---|
2145 | pmf2b(nzb,:) = pmf2b(nzb+1,:) |
---|
2146 | pmf2b(nzt+1,:) = pmf2b(nzt,:) |
---|
2147 | pndist(nzb,:) = pndist(nzb+1,:) |
---|
2148 | pndist(nzt+1,:) = pndist(nzt,:) |
---|
2149 | |
---|
2150 | IF ( index_so4 < 0 ) THEN |
---|
2151 | pmf2a(:,1) = 0.0_wp |
---|
2152 | pmf2b(:,1) = 0.0_wp |
---|
2153 | ENDIF |
---|
2154 | IF ( index_oc < 0 ) THEN |
---|
2155 | pmf2a(:,2) = 0.0_wp |
---|
2156 | pmf2b(:,2) = 0.0_wp |
---|
2157 | ENDIF |
---|
2158 | IF ( index_bc < 0 ) THEN |
---|
2159 | pmf2a(:,3) = 0.0_wp |
---|
2160 | pmf2b(:,3) = 0.0_wp |
---|
2161 | ENDIF |
---|
2162 | IF ( index_du < 0 ) THEN |
---|
2163 | pmf2a(:,4) = 0.0_wp |
---|
2164 | pmf2b(:,4) = 0.0_wp |
---|
2165 | ENDIF |
---|
2166 | IF ( index_ss < 0 ) THEN |
---|
2167 | pmf2a(:,5) = 0.0_wp |
---|
2168 | pmf2b(:,5) = 0.0_wp |
---|
2169 | ENDIF |
---|
2170 | IF ( index_no < 0 ) THEN |
---|
2171 | pmf2a(:,6) = 0.0_wp |
---|
2172 | pmf2b(:,6) = 0.0_wp |
---|
2173 | ENDIF |
---|
2174 | IF ( index_nh < 0 ) THEN |
---|
2175 | pmf2a(:,7) = 0.0_wp |
---|
2176 | pmf2b(:,7) = 0.0_wp |
---|
2177 | ENDIF |
---|
2178 | |
---|
2179 | IF ( SUM( pmf2a ) < 0.00001_wp .AND. SUM( pmf2b ) < 0.00001_wp ) THEN |
---|
2180 | message_string = 'Error in initialising mass fractions of chemical components. ' // & |
---|
2181 | 'Check that all chemical components are included in parameter file!' |
---|
2182 | CALL message( 'salsa_mod: aerosol_init', 'PA0606', 2, 2, 0, 6, 0 ) |
---|
2183 | ENDIF |
---|
2184 | ! |
---|
2185 | !-- Then normalise the mass fraction so that SUM = 1 |
---|
2186 | DO k = nzb, nzt+1 |
---|
2187 | pmf2a(k,:) = pmf2a(k,:) / SUM( pmf2a(k,:) ) |
---|
2188 | IF ( SUM( pmf2b(k,:) ) > 0.0_wp ) pmf2b(k,:) = pmf2b(k,:) / SUM( pmf2b(k,:) ) |
---|
2189 | ENDDO |
---|
2190 | |
---|
2191 | DEALLOCATE( pr_z, pr_mass_fracs_a, pr_mass_fracs_b ) |
---|
2192 | ! |
---|
2193 | !-- Close input file |
---|
2194 | CALL close_input_file( id_dyn ) |
---|
2195 | |
---|
2196 | ELSE |
---|
2197 | message_string = 'Input file '// TRIM( input_file_dynamic ) // TRIM( coupling_char ) // & |
---|
2198 | ' for SALSA missing!' |
---|
2199 | CALL message( 'salsa_mod: aerosol_init', 'PA0607', 1, 2, 0, 6, 0 ) |
---|
2200 | |
---|
2201 | ENDIF ! netcdf_extend |
---|
2202 | |
---|
2203 | #else |
---|
2204 | message_string = 'init_aerosol_type = 1 but preprocessor directive __netcdf is not used '// & |
---|
2205 | 'in compiling!' |
---|
2206 | CALL message( 'salsa_mod: aerosol_init', 'PA0608', 1, 2, 0, 6, 0 ) |
---|
2207 | |
---|
2208 | #endif |
---|
2209 | |
---|
2210 | ELSEIF ( init_aerosol_type == 0 ) THEN |
---|
2211 | ! |
---|
2212 | !-- Mass fractions for species in a and b-bins |
---|
2213 | IF ( index_so4 > 0 ) THEN |
---|
2214 | pmf2a(:,1) = mass_fracs_a(index_so4) |
---|
2215 | pmf2b(:,1) = mass_fracs_b(index_so4) |
---|
2216 | ENDIF |
---|
2217 | IF ( index_oc > 0 ) THEN |
---|
2218 | pmf2a(:,2) = mass_fracs_a(index_oc) |
---|
2219 | pmf2b(:,2) = mass_fracs_b(index_oc) |
---|
2220 | ENDIF |
---|
2221 | IF ( index_bc > 0 ) THEN |
---|
2222 | pmf2a(:,3) = mass_fracs_a(index_bc) |
---|
2223 | pmf2b(:,3) = mass_fracs_b(index_bc) |
---|
2224 | ENDIF |
---|
2225 | IF ( index_du > 0 ) THEN |
---|
2226 | pmf2a(:,4) = mass_fracs_a(index_du) |
---|
2227 | pmf2b(:,4) = mass_fracs_b(index_du) |
---|
2228 | ENDIF |
---|
2229 | IF ( index_ss > 0 ) THEN |
---|
2230 | pmf2a(:,5) = mass_fracs_a(index_ss) |
---|
2231 | pmf2b(:,5) = mass_fracs_b(index_ss) |
---|
2232 | ENDIF |
---|
2233 | IF ( index_no > 0 ) THEN |
---|
2234 | pmf2a(:,6) = mass_fracs_a(index_no) |
---|
2235 | pmf2b(:,6) = mass_fracs_b(index_no) |
---|
2236 | ENDIF |
---|
2237 | IF ( index_nh > 0 ) THEN |
---|
2238 | pmf2a(:,7) = mass_fracs_a(index_nh) |
---|
2239 | pmf2b(:,7) = mass_fracs_b(index_nh) |
---|
2240 | ENDIF |
---|
2241 | DO k = nzb, nzt+1 |
---|
2242 | pmf2a(k,:) = pmf2a(k,:) / SUM( pmf2a(k,:) ) |
---|
2243 | IF ( SUM( pmf2b(k,:) ) > 0.0_wp ) pmf2b(k,:) = pmf2b(k,:) / SUM( pmf2b(k,:) ) |
---|
2244 | ENDDO |
---|
2245 | |
---|
2246 | CALL size_distribution( n_lognorm, dpg, sigmag, nsect ) |
---|
2247 | ! |
---|
2248 | !-- Normalize by the given total number concentration |
---|
2249 | nsect = nsect * SUM( n_lognorm ) / SUM( nsect ) |
---|
2250 | DO ib = start_subrange_1a, end_subrange_2b |
---|
2251 | pndist(:,ib) = nsect(ib) |
---|
2252 | ENDDO |
---|
2253 | ENDIF |
---|
2254 | |
---|
2255 | IF ( init_gases_type == 1 ) THEN |
---|
2256 | ! |
---|
2257 | !-- Read input profiles from PIDS_CHEM |
---|
2258 | #if defined( __netcdf ) |
---|
2259 | ! |
---|
2260 | !-- Location-dependent size distributions and compositions. |
---|
2261 | INQUIRE( FILE = TRIM( input_file_dynamic ) // TRIM( coupling_char ), EXIST = netcdf_extend ) |
---|
2262 | IF ( netcdf_extend .AND. .NOT. salsa_gases_from_chem ) THEN |
---|
2263 | ! |
---|
2264 | !-- Open file in read-only mode |
---|
2265 | CALL open_read_file( TRIM( input_file_dynamic ) // TRIM( coupling_char ), id_dyn ) |
---|
2266 | ! |
---|
2267 | !-- Inquire dimensions: |
---|
2268 | CALL get_dimension_length( id_dyn, pr_nz, 'z' ) |
---|
2269 | IF ( pr_nz /= nz ) THEN |
---|
2270 | WRITE( message_string, * ) 'Number of inifor horizontal grid points does not match '//& |
---|
2271 | 'the number of numeric grid points.' |
---|
2272 | CALL message( 'aerosol_init', 'PA0609', 1, 2, 0, 6, 0 ) |
---|
2273 | ENDIF |
---|
2274 | ! |
---|
2275 | !-- Read vertical profiles of gases: |
---|
2276 | CALL get_variable( id_dyn, 'init_atmosphere_H2SO4', salsa_gas(1)%init(nzb+1:nzt) ) |
---|
2277 | CALL get_variable( id_dyn, 'init_atmosphere_HNO3', salsa_gas(2)%init(nzb+1:nzt) ) |
---|
2278 | CALL get_variable( id_dyn, 'init_atmosphere_NH3', salsa_gas(3)%init(nzb+1:nzt) ) |
---|
2279 | CALL get_variable( id_dyn, 'init_atmosphere_OCNV', salsa_gas(4)%init(nzb+1:nzt) ) |
---|
2280 | CALL get_variable( id_dyn, 'init_atmosphere_OCSV', salsa_gas(5)%init(nzb+1:nzt) ) |
---|
2281 | ! |
---|
2282 | !-- Set Neumann top and surface boundary condition for initial + initialise concentrations |
---|
2283 | DO ig = 1, ngases_salsa |
---|
2284 | salsa_gas(ig)%init(nzb) = salsa_gas(ig)%init(nzb+1) |
---|
2285 | salsa_gas(ig)%init(nzt+1) = salsa_gas(ig)%init(nzt) |
---|
2286 | IF ( .NOT. read_restart_data_salsa ) THEN |
---|
2287 | DO k = nzb, nzt+1 |
---|
2288 | salsa_gas(ig)%conc(k,:,:) = salsa_gas(ig)%init(k) |
---|
2289 | ENDDO |
---|
2290 | ENDIF |
---|
2291 | ENDDO |
---|
2292 | ! |
---|
2293 | !-- Close input file |
---|
2294 | CALL close_input_file( id_dyn ) |
---|
2295 | |
---|
2296 | ELSEIF ( .NOT. netcdf_extend .AND. .NOT. salsa_gases_from_chem ) THEN |
---|
2297 | message_string = 'Input file '// TRIM( input_file_dynamic ) // TRIM( coupling_char ) // & |
---|
2298 | ' for SALSA missing!' |
---|
2299 | CALL message( 'salsa_mod: aerosol_init', 'PA0610', 1, 2, 0, 6, 0 ) |
---|
2300 | |
---|
2301 | ENDIF ! netcdf_extend |
---|
2302 | #else |
---|
2303 | message_string = 'init_gases_type = 1 but preprocessor directive __netcdf is not used in '//& |
---|
2304 | 'compiling!' |
---|
2305 | CALL message( 'salsa_mod: aerosol_init', 'PA0611', 1, 2, 0, 6, 0 ) |
---|
2306 | |
---|
2307 | #endif |
---|
2308 | |
---|
2309 | ENDIF |
---|
2310 | ! |
---|
2311 | !-- Both SO4 and OC are included, so use the given mass fractions |
---|
2312 | IF ( index_oc > 0 .AND. index_so4 > 0 ) THEN |
---|
2313 | pmfoc1a(:) = pmf2a(:,2) / ( pmf2a(:,2) + pmf2a(:,1) ) ! Normalize |
---|
2314 | ! |
---|
2315 | !-- Pure organic carbon |
---|
2316 | ELSEIF ( index_oc > 0 ) THEN |
---|
2317 | pmfoc1a(:) = 1.0_wp |
---|
2318 | ! |
---|
2319 | !-- Pure SO4 |
---|
2320 | ELSEIF ( index_so4 > 0 ) THEN |
---|
2321 | pmfoc1a(:) = 0.0_wp |
---|
2322 | |
---|
2323 | ELSE |
---|
2324 | message_string = 'Either OC or SO4 must be active for aerosol region 1a!' |
---|
2325 | CALL message( 'salsa_mod: aerosol_init', 'PA0612', 1, 2, 0, 6, 0 ) |
---|
2326 | ENDIF |
---|
2327 | |
---|
2328 | ! |
---|
2329 | !-- Initialize concentrations |
---|
2330 | DO i = nxlg, nxrg |
---|
2331 | DO j = nysg, nyng |
---|
2332 | DO k = nzb, nzt+1 |
---|
2333 | ! |
---|
2334 | !-- Predetermine flag to mask topography |
---|
2335 | flag = MERGE( 1.0_wp, 0.0_wp, BTEST( wall_flags_total_0(k,j,i), 0 ) ) |
---|
2336 | ! |
---|
2337 | !-- a) Number concentrations |
---|
2338 | !-- Region 1: |
---|
2339 | DO ib = start_subrange_1a, end_subrange_1a |
---|
2340 | IF ( .NOT. read_restart_data_salsa ) THEN |
---|
2341 | aerosol_number(ib)%conc(k,j,i) = pndist(k,ib) * flag |
---|
2342 | ENDIF |
---|
2343 | IF ( prunmode == 1 ) THEN |
---|
2344 | aerosol_number(ib)%init = pndist(:,ib) |
---|
2345 | ENDIF |
---|
2346 | ENDDO |
---|
2347 | ! |
---|
2348 | !-- Region 2: |
---|
2349 | IF ( nreg > 1 ) THEN |
---|
2350 | DO ib = start_subrange_2a, end_subrange_2a |
---|
2351 | IF ( .NOT. read_restart_data_salsa ) THEN |
---|
2352 | aerosol_number(ib)%conc(k,j,i) = MAX( 0.0_wp, pnf2a(k) ) * pndist(k,ib) * flag |
---|
2353 | ENDIF |
---|
2354 | IF ( prunmode == 1 ) THEN |
---|
2355 | aerosol_number(ib)%init = MAX( 0.0_wp, nf2a ) * pndist(:,ib) |
---|
2356 | ENDIF |
---|
2357 | ENDDO |
---|
2358 | IF ( .NOT. no_insoluble ) THEN |
---|
2359 | DO ib = start_subrange_2b, end_subrange_2b |
---|
2360 | IF ( pnf2a(k) < 1.0_wp ) THEN |
---|
2361 | IF ( .NOT. read_restart_data_salsa ) THEN |
---|
2362 | aerosol_number(ib)%conc(k,j,i) = MAX( 0.0_wp, 1.0_wp - pnf2a(k) ) * & |
---|
2363 | pndist(k,ib) * flag |
---|
2364 | ENDIF |
---|
2365 | IF ( prunmode == 1 ) THEN |
---|
2366 | aerosol_number(ib)%init = MAX( 0.0_wp, 1.0_wp - nf2a ) * pndist(:,ib) |
---|
2367 | ENDIF |
---|
2368 | ENDIF |
---|
2369 | ENDDO |
---|
2370 | ENDIF |
---|
2371 | ENDIF |
---|
2372 | ! |
---|
2373 | !-- b) Aerosol mass concentrations |
---|
2374 | !-- bin subrange 1: done here separately due to the SO4/OC convention |
---|
2375 | ! |
---|
2376 | !-- SO4: |
---|
2377 | IF ( index_so4 > 0 ) THEN |
---|
2378 | ss = ( index_so4 - 1 ) * nbins_aerosol + start_subrange_1a !< start |
---|
2379 | ee = ( index_so4 - 1 ) * nbins_aerosol + end_subrange_1a !< end |
---|
2380 | ib = start_subrange_1a |
---|
2381 | DO ic = ss, ee |
---|
2382 | IF ( .NOT. read_restart_data_salsa ) THEN |
---|
2383 | aerosol_mass(ic)%conc(k,j,i) = MAX( 0.0_wp, 1.0_wp - pmfoc1a(k) ) * & |
---|
2384 | pndist(k,ib) * core(ib) * arhoh2so4 * flag |
---|
2385 | ENDIF |
---|
2386 | IF ( prunmode == 1 ) THEN |
---|
2387 | aerosol_mass(ic)%init(k) = MAX( 0.0_wp, 1.0_wp - pmfoc1a(k) ) * pndist(k,ib) & |
---|
2388 | * core(ib) * arhoh2so4 |
---|
2389 | ENDIF |
---|
2390 | ib = ib+1 |
---|
2391 | ENDDO |
---|
2392 | ENDIF |
---|
2393 | ! |
---|
2394 | !-- OC: |
---|
2395 | IF ( index_oc > 0 ) THEN |
---|
2396 | ss = ( index_oc - 1 ) * nbins_aerosol + start_subrange_1a !< start |
---|
2397 | ee = ( index_oc - 1 ) * nbins_aerosol + end_subrange_1a !< end |
---|
2398 | ib = start_subrange_1a |
---|
2399 | DO ic = ss, ee |
---|
2400 | IF ( .NOT. read_restart_data_salsa ) THEN |
---|
2401 | aerosol_mass(ic)%conc(k,j,i) = MAX( 0.0_wp, pmfoc1a(k) ) * pndist(k,ib) * & |
---|
2402 | core(ib) * arhooc * flag |
---|
2403 | ENDIF |
---|
2404 | IF ( prunmode == 1 ) THEN |
---|
2405 | aerosol_mass(ic)%init(k) = MAX( 0.0_wp, pmfoc1a(k) ) * pndist(k,ib) * & |
---|
2406 | core(ib) * arhooc |
---|
2407 | ENDIF |
---|
2408 | ib = ib+1 |
---|
2409 | ENDDO |
---|
2410 | ENDIF |
---|
2411 | ENDDO !< k |
---|
2412 | |
---|
2413 | prunmode = 3 ! Init only once |
---|
2414 | |
---|
2415 | ENDDO !< j |
---|
2416 | ENDDO !< i |
---|
2417 | |
---|
2418 | ! |
---|
2419 | !-- c) Aerosol mass concentrations |
---|
2420 | !-- bin subrange 2: |
---|
2421 | IF ( nreg > 1 ) THEN |
---|
2422 | |
---|
2423 | IF ( index_so4 > 0 ) THEN |
---|
2424 | CALL set_aero_mass( index_so4, pmf2a(:,1), pmf2b(:,1), pnf2a, pndist, core, arhoh2so4 ) |
---|
2425 | ENDIF |
---|
2426 | IF ( index_oc > 0 ) THEN |
---|
2427 | CALL set_aero_mass( index_oc, pmf2a(:,2), pmf2b(:,2), pnf2a, pndist, core, arhooc ) |
---|
2428 | ENDIF |
---|
2429 | IF ( index_bc > 0 ) THEN |
---|
2430 | CALL set_aero_mass( index_bc, pmf2a(:,3), pmf2b(:,3), pnf2a, pndist, core, arhobc ) |
---|
2431 | ENDIF |
---|
2432 | IF ( index_du > 0 ) THEN |
---|
2433 | CALL set_aero_mass( index_du, pmf2a(:,4), pmf2b(:,4), pnf2a, pndist, core, arhodu ) |
---|
2434 | ENDIF |
---|
2435 | IF ( index_ss > 0 ) THEN |
---|
2436 | CALL set_aero_mass( index_ss, pmf2a(:,5), pmf2b(:,5), pnf2a, pndist, core, arhoss ) |
---|
2437 | ENDIF |
---|
2438 | IF ( index_no > 0 ) THEN |
---|
2439 | CALL set_aero_mass( index_no, pmf2a(:,6), pmf2b(:,6), pnf2a, pndist, core, arhohno3 ) |
---|
2440 | ENDIF |
---|
2441 | IF ( index_nh > 0 ) THEN |
---|
2442 | CALL set_aero_mass( index_nh, pmf2a(:,7), pmf2b(:,7), pnf2a, pndist, core, arhonh3 ) |
---|
2443 | ENDIF |
---|
2444 | |
---|
2445 | ENDIF |
---|
2446 | |
---|
2447 | END SUBROUTINE aerosol_init |
---|
2448 | |
---|
2449 | !------------------------------------------------------------------------------! |
---|
2450 | ! Description: |
---|
2451 | ! ------------ |
---|
2452 | !> Create a lognormal size distribution and discretise to a sectional |
---|
2453 | !> representation. |
---|
2454 | !------------------------------------------------------------------------------! |
---|
2455 | SUBROUTINE size_distribution( in_ntot, in_dpg, in_sigma, psd_sect ) |
---|
2456 | |
---|
2457 | IMPLICIT NONE |
---|
2458 | |
---|
2459 | INTEGER(iwp) :: ib !< running index: bin |
---|
2460 | INTEGER(iwp) :: iteration !< running index: iteration |
---|
2461 | |
---|
2462 | REAL(wp) :: d1 !< particle diameter (m, dummy) |
---|
2463 | REAL(wp) :: d2 !< particle diameter (m, dummy) |
---|
2464 | REAL(wp) :: delta_d !< (d2-d1)/10 |
---|
2465 | REAL(wp) :: deltadp !< bin width |
---|
2466 | REAL(wp) :: dmidi !< ( d1 + d2 ) / 2 |
---|
2467 | |
---|
2468 | REAL(wp), DIMENSION(:), INTENT(in) :: in_dpg !< geometric mean diameter (m) |
---|
2469 | REAL(wp), DIMENSION(:), INTENT(in) :: in_ntot !< number conc. (#/m3) |
---|
2470 | REAL(wp), DIMENSION(:), INTENT(in) :: in_sigma !< standard deviation |
---|
2471 | |
---|
2472 | REAL(wp), DIMENSION(:), INTENT(inout) :: psd_sect !< sectional size distribution |
---|
2473 | |
---|
2474 | DO ib = start_subrange_1a, end_subrange_2b |
---|
2475 | psd_sect(ib) = 0.0_wp |
---|
2476 | ! |
---|
2477 | !-- Particle diameter at the low limit (largest in the bin) (m) |
---|
2478 | d1 = ( aero(ib)%vlolim / api6 )**0.33333333_wp |
---|
2479 | ! |
---|
2480 | !-- Particle diameter at the high limit (smallest in the bin) (m) |
---|
2481 | d2 = ( aero(ib)%vhilim / api6 )**0.33333333_wp |
---|
2482 | ! |
---|
2483 | !-- Span of particle diameter in a bin (m) |
---|
2484 | delta_d = 0.1_wp * ( d2 - d1 ) |
---|
2485 | ! |
---|
2486 | !-- Iterate: |
---|
2487 | DO iteration = 1, 10 |
---|
2488 | d1 = ( aero(ib)%vlolim / api6 )**0.33333333_wp + ( ib - 1) * delta_d |
---|
2489 | d2 = d1 + delta_d |
---|
2490 | dmidi = 0.5_wp * ( d1 + d2 ) |
---|
2491 | deltadp = LOG10( d2 / d1 ) |
---|
2492 | ! |
---|
2493 | !-- Size distribution |
---|
2494 | !-- in_ntot = total number, total area, or total volume concentration |
---|
2495 | !-- in_dpg = geometric-mean number, area, or volume diameter |
---|
2496 | !-- n(k) = number, area, or volume concentration in a bin |
---|
2497 | psd_sect(ib) = psd_sect(ib) + SUM( in_ntot * deltadp / ( SQRT( 2.0_wp * pi ) * & |
---|
2498 | LOG10( in_sigma ) ) * EXP( -LOG10( dmidi / in_dpg )**2.0_wp / & |
---|
2499 | ( 2.0_wp * LOG10( in_sigma ) ** 2.0_wp ) ) ) |
---|
2500 | |
---|
2501 | ENDDO |
---|
2502 | ENDDO |
---|
2503 | |
---|
2504 | END SUBROUTINE size_distribution |
---|
2505 | |
---|
2506 | !------------------------------------------------------------------------------! |
---|
2507 | ! Description: |
---|
2508 | ! ------------ |
---|
2509 | !> Sets the mass concentrations to aerosol arrays in 2a and 2b. |
---|
2510 | !> |
---|
2511 | !> Tomi Raatikainen, FMI, 29.2.2016 |
---|
2512 | !------------------------------------------------------------------------------! |
---|
2513 | SUBROUTINE set_aero_mass( ispec, pmf2a, pmf2b, pnf2a, pndist, pcore, prho ) |
---|
2514 | |
---|
2515 | IMPLICIT NONE |
---|
2516 | |
---|
2517 | INTEGER(iwp) :: ee !< index: end |
---|
2518 | INTEGER(iwp) :: i !< loop index |
---|
2519 | INTEGER(iwp) :: ib !< loop index |
---|
2520 | INTEGER(iwp) :: ic !< loop index |
---|
2521 | INTEGER(iwp) :: j !< loop index |
---|
2522 | INTEGER(iwp) :: k !< loop index |
---|
2523 | INTEGER(iwp) :: prunmode !< 1 = initialise |
---|
2524 | INTEGER(iwp) :: ss !< index: start |
---|
2525 | |
---|
2526 | INTEGER(iwp), INTENT(in) :: ispec !< Aerosol species index |
---|
2527 | |
---|
2528 | REAL(wp) :: flag !< flag to mask topography grid points |
---|
2529 | |
---|
2530 | REAL(wp), INTENT(in) :: prho !< Aerosol density |
---|
2531 | |
---|
2532 | REAL(wp), DIMENSION(nbins_aerosol), INTENT(in) :: pcore !< Aerosol bin mid core volume |
---|
2533 | REAL(wp), DIMENSION(0:nz+1), INTENT(in) :: pnf2a !< Number fraction for 2a |
---|
2534 | REAL(wp), DIMENSION(0:nz+1), INTENT(in) :: pmf2a !< Mass distributions for a |
---|
2535 | REAL(wp), DIMENSION(0:nz+1), INTENT(in) :: pmf2b !< and b bins |
---|
2536 | |
---|
2537 | REAL(wp), DIMENSION(0:nz+1,nbins_aerosol), INTENT(in) :: pndist !< Aerosol size distribution |
---|
2538 | |
---|
2539 | prunmode = 1 |
---|
2540 | |
---|
2541 | DO i = nxlg, nxrg |
---|
2542 | DO j = nysg, nyng |
---|
2543 | DO k = nzb, nzt+1 |
---|
2544 | ! |
---|
2545 | !-- Predetermine flag to mask topography |
---|
2546 | flag = MERGE( 1.0_wp, 0.0_wp, BTEST( wall_flags_total_0(k,j,i), 0 ) ) |
---|
2547 | ! |
---|
2548 | !-- Regime 2a: |
---|
2549 | ss = ( ispec - 1 ) * nbins_aerosol + start_subrange_2a |
---|
2550 | ee = ( ispec - 1 ) * nbins_aerosol + end_subrange_2a |
---|
2551 | ib = start_subrange_2a |
---|
2552 | DO ic = ss, ee |
---|
2553 | IF ( .NOT. read_restart_data_salsa ) THEN |
---|
2554 | aerosol_mass(ic)%conc(k,j,i) = MAX( 0.0_wp, pmf2a(k) ) * pnf2a(k) * pndist(k,ib)& |
---|
2555 | * pcore(ib) * prho * flag |
---|
2556 | ENDIF |
---|
2557 | IF ( prunmode == 1 ) THEN |
---|
2558 | aerosol_mass(ic)%init(k) = MAX( 0.0_wp, pmf2a(k) ) * pnf2a(k) * pndist(k,ib) * & |
---|
2559 | pcore(ib) * prho |
---|
2560 | ENDIF |
---|
2561 | ib = ib + 1 |
---|
2562 | ENDDO |
---|
2563 | ! |
---|
2564 | !-- Regime 2b: |
---|
2565 | IF ( .NOT. no_insoluble ) THEN |
---|
2566 | ss = ( ispec - 1 ) * nbins_aerosol + start_subrange_2b |
---|
2567 | ee = ( ispec - 1 ) * nbins_aerosol + end_subrange_2b |
---|
2568 | ib = start_subrange_2a |
---|
2569 | DO ic = ss, ee |
---|
2570 | IF ( .NOT. read_restart_data_salsa ) THEN |
---|
2571 | aerosol_mass(ic)%conc(k,j,i) = MAX( 0.0_wp, pmf2b(k) ) * ( 1.0_wp - pnf2a(k))& |
---|
2572 | * pndist(k,ib) * pcore(ib) * prho * flag |
---|
2573 | ENDIF |
---|
2574 | IF ( prunmode == 1 ) THEN |
---|
2575 | aerosol_mass(ic)%init(k) = MAX( 0.0_wp, pmf2b(k) ) * ( 1.0_wp - pnf2a(k) ) * & |
---|
2576 | pndist(k,ib) * pcore(ib) * prho |
---|
2577 | ENDIF |
---|
2578 | ib = ib + 1 |
---|
2579 | ENDDO ! c |
---|
2580 | |
---|
2581 | ENDIF |
---|
2582 | ENDDO ! k |
---|
2583 | |
---|
2584 | prunmode = 3 ! Init only once |
---|
2585 | |
---|
2586 | ENDDO ! j |
---|
2587 | ENDDO ! i |
---|
2588 | |
---|
2589 | END SUBROUTINE set_aero_mass |
---|
2590 | |
---|
2591 | !------------------------------------------------------------------------------! |
---|
2592 | ! Description: |
---|
2593 | ! ------------ |
---|
2594 | !> Initialise the matching between surface types in LSM and deposition models. |
---|
2595 | !> Do the matching based on Zhang et al. (2001). Atmos. Environ. 35, 549-560 |
---|
2596 | !> (here referred as Z01). |
---|
2597 | !------------------------------------------------------------------------------! |
---|
2598 | SUBROUTINE init_deposition |
---|
2599 | |
---|
2600 | USE surface_mod, & |
---|
2601 | ONLY: surf_lsm_h, surf_lsm_v, surf_usm_h, surf_usm_v |
---|
2602 | |
---|
2603 | IMPLICIT NONE |
---|
2604 | |
---|
2605 | INTEGER(iwp) :: l !< loop index for vertical surfaces |
---|
2606 | |
---|
2607 | LOGICAL :: match_lsm !< flag to initilise LSM surfaces (if false, initialise USM surfaces) |
---|
2608 | |
---|
2609 | IF ( depo_pcm_par == 'zhang2001' ) THEN |
---|
2610 | depo_pcm_par_num = 1 |
---|
2611 | ELSEIF ( depo_pcm_par == 'petroff2010' ) THEN |
---|
2612 | depo_pcm_par_num = 2 |
---|
2613 | ENDIF |
---|
2614 | |
---|
2615 | IF ( depo_surf_par == 'zhang2001' ) THEN |
---|
2616 | depo_surf_par_num = 1 |
---|
2617 | ELSEIF ( depo_surf_par == 'petroff2010' ) THEN |
---|
2618 | depo_surf_par_num = 2 |
---|
2619 | ENDIF |
---|
2620 | ! |
---|
2621 | !-- LSM: Pavement, vegetation and water |
---|
2622 | IF ( nldepo_surf .AND. land_surface ) THEN |
---|
2623 | match_lsm = .TRUE. |
---|
2624 | ALLOCATE( lsm_to_depo_h%match_lupg(1:surf_lsm_h%ns), & |
---|
2625 | lsm_to_depo_h%match_luvw(1:surf_lsm_h%ns), & |
---|
2626 | lsm_to_depo_h%match_luww(1:surf_lsm_h%ns) ) |
---|
2627 | lsm_to_depo_h%match_lupg = 0 |
---|
2628 | lsm_to_depo_h%match_luvw = 0 |
---|
2629 | lsm_to_depo_h%match_luww = 0 |
---|
2630 | CALL match_sm_zhang( surf_lsm_h, lsm_to_depo_h%match_lupg, lsm_to_depo_h%match_luvw, & |
---|
2631 | lsm_to_depo_h%match_luww, match_lsm ) |
---|
2632 | DO l = 0, 3 |
---|
2633 | ALLOCATE( lsm_to_depo_v(l)%match_lupg(1:surf_lsm_v(l)%ns), & |
---|
2634 | lsm_to_depo_v(l)%match_luvw(1:surf_lsm_v(l)%ns), & |
---|
2635 | lsm_to_depo_v(l)%match_luww(1:surf_lsm_v(l)%ns) ) |
---|
2636 | lsm_to_depo_v(l)%match_lupg = 0 |
---|
2637 | lsm_to_depo_v(l)%match_luvw = 0 |
---|
2638 | lsm_to_depo_v(l)%match_luww = 0 |
---|
2639 | CALL match_sm_zhang( surf_lsm_v(l), lsm_to_depo_v(l)%match_lupg, & |
---|
2640 | lsm_to_depo_v(l)%match_luvw, lsm_to_depo_v(l)%match_luww, match_lsm ) |
---|
2641 | ENDDO |
---|
2642 | ENDIF |
---|
2643 | ! |
---|
2644 | !-- USM: Green roofs/walls, wall surfaces and windows |
---|
2645 | IF ( nldepo_surf .AND. urban_surface ) THEN |
---|
2646 | match_lsm = .FALSE. |
---|
2647 | ALLOCATE( usm_to_depo_h%match_lupg(1:surf_usm_h%ns), & |
---|
2648 | usm_to_depo_h%match_luvw(1:surf_usm_h%ns), & |
---|
2649 | usm_to_depo_h%match_luww(1:surf_usm_h%ns) ) |
---|
2650 | usm_to_depo_h%match_lupg = 0 |
---|
2651 | usm_to_depo_h%match_luvw = 0 |
---|
2652 | usm_to_depo_h%match_luww = 0 |
---|
2653 | CALL match_sm_zhang( surf_usm_h, usm_to_depo_h%match_lupg, usm_to_depo_h%match_luvw, & |
---|
2654 | usm_to_depo_h%match_luww, match_lsm ) |
---|
2655 | DO l = 0, 3 |
---|
2656 | ALLOCATE( usm_to_depo_v(l)%match_lupg(1:surf_usm_v(l)%ns), & |
---|
2657 | usm_to_depo_v(l)%match_luvw(1:surf_usm_v(l)%ns), & |
---|
2658 | usm_to_depo_v(l)%match_luww(1:surf_usm_v(l)%ns) ) |
---|
2659 | usm_to_depo_v(l)%match_lupg = 0 |
---|
2660 | usm_to_depo_v(l)%match_luvw = 0 |
---|
2661 | usm_to_depo_v(l)%match_luww = 0 |
---|
2662 | CALL match_sm_zhang( surf_usm_v(l), usm_to_depo_v(l)%match_lupg, & |
---|
2663 | usm_to_depo_v(l)%match_luvw, usm_to_depo_v(l)%match_luww, match_lsm ) |
---|
2664 | ENDDO |
---|
2665 | ENDIF |
---|
2666 | |
---|
2667 | IF ( nldepo_pcm ) THEN |
---|
2668 | SELECT CASE ( depo_pcm_type ) |
---|
2669 | CASE ( 'evergreen_needleleaf' ) |
---|
2670 | depo_pcm_type_num = 1 |
---|
2671 | CASE ( 'evergreen_broadleaf' ) |
---|
2672 | depo_pcm_type_num = 2 |
---|
2673 | CASE ( 'deciduous_needleleaf' ) |
---|
2674 | depo_pcm_type_num = 3 |
---|
2675 | CASE ( 'deciduous_broadleaf' ) |
---|
2676 | depo_pcm_type_num = 4 |
---|
2677 | CASE DEFAULT |
---|
2678 | message_string = 'depo_pcm_type not set correctly.' |
---|
2679 | CALL message( 'salsa_mod: init_deposition', 'PA0613', 1, 2, 0, 6, 0 ) |
---|
2680 | END SELECT |
---|
2681 | ENDIF |
---|
2682 | |
---|
2683 | END SUBROUTINE init_deposition |
---|
2684 | |
---|
2685 | !------------------------------------------------------------------------------! |
---|
2686 | ! Description: |
---|
2687 | ! ------------ |
---|
2688 | !> Match the surface types in PALM and Zhang et al. 2001 deposition module |
---|
2689 | !------------------------------------------------------------------------------! |
---|
2690 | SUBROUTINE match_sm_zhang( surf, match_pav_green, match_veg_wall, match_wat_win, match_lsm ) |
---|
2691 | |
---|
2692 | USE surface_mod, & |
---|
2693 | ONLY: ind_pav_green, ind_veg_wall, ind_wat_win, surf_type |
---|
2694 | |
---|
2695 | IMPLICIT NONE |
---|
2696 | |
---|
2697 | INTEGER(iwp) :: m !< index for surface elements |
---|
2698 | INTEGER(iwp) :: pav_type_palm !< pavement / green wall type in PALM |
---|
2699 | INTEGER(iwp) :: veg_type_palm !< vegetation / wall type in PALM |
---|
2700 | INTEGER(iwp) :: wat_type_palm !< water / window type in PALM |
---|
2701 | |
---|
2702 | INTEGER(iwp), DIMENSION(:), INTENT(inout) :: match_pav_green !< matching pavement/green walls |
---|
2703 | INTEGER(iwp), DIMENSION(:), INTENT(inout) :: match_veg_wall !< matching vegetation/walls |
---|
2704 | INTEGER(iwp), DIMENSION(:), INTENT(inout) :: match_wat_win !< matching water/windows |
---|
2705 | |
---|
2706 | LOGICAL, INTENT(in) :: match_lsm !< flag to initilise LSM surfaces (if false, initialise USM) |
---|
2707 | |
---|
2708 | TYPE(surf_type), INTENT(in) :: surf !< respective surface type |
---|
2709 | |
---|
2710 | DO m = 1, surf%ns |
---|
2711 | IF ( match_lsm ) THEN |
---|
2712 | ! |
---|
2713 | !-- Vegetation (LSM): |
---|
2714 | IF ( surf%frac(ind_veg_wall,m) > 0 ) THEN |
---|
2715 | veg_type_palm = surf%vegetation_type(m) |
---|
2716 | SELECT CASE ( veg_type_palm ) |
---|
2717 | CASE ( 0 ) |
---|
2718 | message_string = 'No vegetation type defined.' |
---|
2719 | CALL message( 'salsa_mod: init_depo_surfaces', 'PA0614', 1, 2, 0, 6, 0 ) |
---|
2720 | CASE ( 1 ) ! bare soil |
---|
2721 | match_veg_wall(m) = 6 ! grass in Z01 |
---|
2722 | CASE ( 2 ) ! crops, mixed farming |
---|
2723 | match_veg_wall(m) = 7 ! crops, mixed farming Z01 |
---|
2724 | CASE ( 3 ) ! short grass |
---|
2725 | match_veg_wall(m) = 6 ! grass in Z01 |
---|
2726 | CASE ( 4 ) ! evergreen needleleaf trees |
---|
2727 | match_veg_wall(m) = 1 ! evergreen needleleaf trees in Z01 |
---|
2728 | CASE ( 5 ) ! deciduous needleleaf trees |
---|
2729 | match_veg_wall(m) = 3 ! deciduous needleleaf trees in Z01 |
---|
2730 | CASE ( 6 ) ! evergreen broadleaf trees |
---|
2731 | match_veg_wall(m) = 2 ! evergreen broadleaf trees in Z01 |
---|
2732 | CASE ( 7 ) ! deciduous broadleaf trees |
---|
2733 | match_veg_wall(m) = 4 ! deciduous broadleaf trees in Z01 |
---|
2734 | CASE ( 8 ) ! tall grass |
---|
2735 | match_veg_wall(m) = 6 ! grass in Z01 |
---|
2736 | CASE ( 9 ) ! desert |
---|
2737 | match_veg_wall(m) = 8 ! desert in Z01 |
---|
2738 | CASE ( 10 ) ! tundra |
---|
2739 | match_veg_wall(m) = 9 ! tundra in Z01 |
---|
2740 | CASE ( 11 ) ! irrigated crops |
---|
2741 | match_veg_wall(m) = 7 ! crops, mixed farming Z01 |
---|
2742 | CASE ( 12 ) ! semidesert |
---|
2743 | match_veg_wall(m) = 8 ! desert in Z01 |
---|
2744 | CASE ( 13 ) ! ice caps and glaciers |
---|
2745 | match_veg_wall(m) = 12 ! ice cap and glacier in Z01 |
---|
2746 | CASE ( 14 ) ! bogs and marshes |
---|
2747 | match_veg_wall(m) = 11 ! wetland with plants in Z01 |
---|
2748 | CASE ( 15 ) ! evergreen shrubs |
---|
2749 | match_veg_wall(m) = 10 ! shrubs and interrupted woodlands in Z01 |
---|
2750 | CASE ( 16 ) ! deciduous shrubs |
---|
2751 | match_veg_wall(m) = 10 ! shrubs and interrupted woodlands in Z01 |
---|
2752 | CASE ( 17 ) ! mixed forest/woodland |
---|
2753 | match_veg_wall(m) = 5 ! mixed broadleaf and needleleaf trees in Z01 |
---|
2754 | CASE ( 18 ) ! interrupted forest |
---|
2755 | match_veg_wall(m) = 10 ! shrubs and interrupted woodlands in Z01 |
---|
2756 | END SELECT |
---|
2757 | ENDIF |
---|
2758 | ! |
---|
2759 | !-- Pavement (LSM): |
---|
2760 | IF ( surf%frac(ind_pav_green,m) > 0 ) THEN |
---|
2761 | pav_type_palm = surf%pavement_type(m) |
---|
2762 | IF ( pav_type_palm == 0 ) THEN ! error |
---|
2763 | message_string = 'No pavement type defined.' |
---|
2764 | CALL message( 'salsa_mod: match_sm_zhang', 'PA0615', 1, 2, 0, 6, 0 ) |
---|
2765 | ELSE |
---|
2766 | match_pav_green(m) = 15 ! urban in Z01 |
---|
2767 | ENDIF |
---|
2768 | ENDIF |
---|
2769 | ! |
---|
2770 | !-- Water (LSM): |
---|
2771 | IF ( surf%frac(ind_wat_win,m) > 0 ) THEN |
---|
2772 | wat_type_palm = surf%water_type(m) |
---|
2773 | IF ( wat_type_palm == 0 ) THEN ! error |
---|
2774 | message_string = 'No water type defined.' |
---|
2775 | CALL message( 'salsa_mod: match_sm_zhang', 'PA0616', 1, 2, 0, 6, 0 ) |
---|
2776 | ELSEIF ( wat_type_palm == 3 ) THEN |
---|
2777 | match_wat_win(m) = 14 ! ocean in Z01 |
---|
2778 | ELSEIF ( wat_type_palm == 1 .OR. wat_type_palm == 2 .OR. wat_type_palm == 4 & |
---|
2779 | .OR. wat_type_palm == 5 ) THEN |
---|
2780 | match_wat_win(m) = 13 ! inland water in Z01 |
---|
2781 | ENDIF |
---|
2782 | ENDIF |
---|
2783 | ELSE |
---|
2784 | ! |
---|
2785 | !-- Wall surfaces (USM): |
---|
2786 | IF ( surf%frac(ind_veg_wall,m) > 0 ) THEN |
---|
2787 | match_veg_wall(m) = 15 ! urban in Z01 |
---|
2788 | ENDIF |
---|
2789 | ! |
---|
2790 | !-- Green walls and roofs (USM): |
---|
2791 | IF ( surf%frac(ind_pav_green,m) > 0 ) THEN |
---|
2792 | match_pav_green(m) = 6 ! (short) grass in Z01 |
---|
2793 | ENDIF |
---|
2794 | ! |
---|
2795 | !-- Windows (USM): |
---|
2796 | IF ( surf%frac(ind_wat_win,m) > 0 ) THEN |
---|
2797 | match_wat_win(m) = 15 ! urban in Z01 |
---|
2798 | ENDIF |
---|
2799 | ENDIF |
---|
2800 | |
---|
2801 | ENDDO |
---|
2802 | |
---|
2803 | END SUBROUTINE match_sm_zhang |
---|
2804 | |
---|
2805 | !------------------------------------------------------------------------------! |
---|
2806 | ! Description: |
---|
2807 | ! ------------ |
---|
2808 | !> Swapping of timelevels |
---|
2809 | !------------------------------------------------------------------------------! |
---|
2810 | SUBROUTINE salsa_swap_timelevel( mod_count ) |
---|
2811 | |
---|
2812 | IMPLICIT NONE |
---|
2813 | |
---|
2814 | INTEGER(iwp) :: ib !< |
---|
2815 | INTEGER(iwp) :: ic !< |
---|
2816 | INTEGER(iwp) :: icc !< |
---|
2817 | INTEGER(iwp) :: ig !< |
---|
2818 | |
---|
2819 | INTEGER(iwp), INTENT(IN) :: mod_count !< |
---|
2820 | |
---|
2821 | IF ( time_since_reference_point >= skip_time_do_salsa ) THEN |
---|
2822 | |
---|
2823 | SELECT CASE ( mod_count ) |
---|
2824 | |
---|
2825 | CASE ( 0 ) |
---|
2826 | |
---|
2827 | DO ib = 1, nbins_aerosol |
---|
2828 | aerosol_number(ib)%conc(nzb:nzt+1,nysg:nyng,nxlg:nxrg) => nconc_1(:,:,:,ib) |
---|
2829 | aerosol_number(ib)%conc_p(nzb:nzt+1,nysg:nyng,nxlg:nxrg) => nconc_2(:,:,:,ib) |
---|
2830 | |
---|
2831 | DO ic = 1, ncomponents_mass |
---|
2832 | icc = ( ic-1 ) * nbins_aerosol + ib |
---|
2833 | aerosol_mass(icc)%conc(nzb:nzt+1,nysg:nyng,nxlg:nxrg) => mconc_1(:,:,:,icc) |
---|
2834 | aerosol_mass(icc)%conc_p(nzb:nzt+1,nysg:nyng,nxlg:nxrg) => mconc_2(:,:,:,icc) |
---|
2835 | ENDDO |
---|
2836 | ENDDO |
---|
2837 | |
---|
2838 | IF ( .NOT. salsa_gases_from_chem ) THEN |
---|
2839 | DO ig = 1, ngases_salsa |
---|
2840 | salsa_gas(ig)%conc(nzb:nzt+1,nysg:nyng,nxlg:nxrg) => gconc_1(:,:,:,ig) |
---|
2841 | salsa_gas(ig)%conc_p(nzb:nzt+1,nysg:nyng,nxlg:nxrg) => gconc_2(:,:,:,ig) |
---|
2842 | ENDDO |
---|
2843 | ENDIF |
---|
2844 | |
---|
2845 | CASE ( 1 ) |
---|
2846 | |
---|
2847 | DO ib = 1, nbins_aerosol |
---|
2848 | aerosol_number(ib)%conc(nzb:nzt+1,nysg:nyng,nxlg:nxrg) => nconc_2(:,:,:,ib) |
---|
2849 | aerosol_number(ib)%conc_p(nzb:nzt+1,nysg:nyng,nxlg:nxrg) => nconc_1(:,:,:,ib) |
---|
2850 | DO ic = 1, ncomponents_mass |
---|
2851 | icc = ( ic-1 ) * nbins_aerosol + ib |
---|
2852 | aerosol_mass(icc)%conc(nzb:nzt+1,nysg:nyng,nxlg:nxrg) => mconc_2(:,:,:,icc) |
---|
2853 | aerosol_mass(icc)%conc_p(nzb:nzt+1,nysg:nyng,nxlg:nxrg) => mconc_1(:,:,:,icc) |
---|
2854 | ENDDO |
---|
2855 | ENDDO |
---|
2856 | |
---|
2857 | IF ( .NOT. salsa_gases_from_chem ) THEN |
---|
2858 | DO ig = 1, ngases_salsa |
---|
2859 | salsa_gas(ig)%conc(nzb:nzt+1,nysg:nyng,nxlg:nxrg) => gconc_2(:,:,:,ig) |
---|
2860 | salsa_gas(ig)%conc_p(nzb:nzt+1,nysg:nyng,nxlg:nxrg) => gconc_1(:,:,:,ig) |
---|
2861 | ENDDO |
---|
2862 | ENDIF |
---|
2863 | |
---|
2864 | END SELECT |
---|
2865 | |
---|
2866 | ENDIF |
---|
2867 | |
---|
2868 | END SUBROUTINE salsa_swap_timelevel |
---|
2869 | |
---|
2870 | |
---|
2871 | !------------------------------------------------------------------------------! |
---|
2872 | ! Description: |
---|
2873 | ! ------------ |
---|
2874 | !> This routine reads the respective restart data. |
---|
2875 | !------------------------------------------------------------------------------! |
---|
2876 | SUBROUTINE salsa_rrd_local( k, nxlf, nxlc, nxl_on_file, nxrf, nxrc, nxr_on_file, nynf, nync, & |
---|
2877 | nyn_on_file, nysf, nysc, nys_on_file, tmp_3d, found ) |
---|
2878 | |
---|
2879 | USE control_parameters, & |
---|
2880 | ONLY: length, restart_string |
---|
2881 | |
---|
2882 | IMPLICIT NONE |
---|
2883 | |
---|
2884 | INTEGER(iwp) :: ib !< |
---|
2885 | INTEGER(iwp) :: ic !< |
---|
2886 | INTEGER(iwp) :: ig !< |
---|
2887 | INTEGER(iwp) :: k !< |
---|
2888 | INTEGER(iwp) :: nxlc !< |
---|
2889 | INTEGER(iwp) :: nxlf !< |
---|
2890 | INTEGER(iwp) :: nxl_on_file !< |
---|
2891 | INTEGER(iwp) :: nxrc !< |
---|
2892 | INTEGER(iwp) :: nxrf !< |
---|
2893 | INTEGER(iwp) :: nxr_on_file !< |
---|
2894 | INTEGER(iwp) :: nync !< |
---|
2895 | INTEGER(iwp) :: nynf !< |
---|
2896 | INTEGER(iwp) :: nyn_on_file !< |
---|
2897 | INTEGER(iwp) :: nysc !< |
---|
2898 | INTEGER(iwp) :: nysf !< |
---|
2899 | INTEGER(iwp) :: nys_on_file !< |
---|
2900 | |
---|
2901 | LOGICAL, INTENT(OUT) :: found !< |
---|
2902 | |
---|
2903 | REAL(wp), & |
---|
2904 | DIMENSION(nzb:nzt+1,nys_on_file-nbgp:nyn_on_file+nbgp,nxl_on_file-nbgp:nxr_on_file+nbgp) :: tmp_3d !< |
---|
2905 | |
---|
2906 | found = .FALSE. |
---|
2907 | |
---|
2908 | IF ( read_restart_data_salsa ) THEN |
---|
2909 | |
---|
2910 | SELECT CASE ( restart_string(1:length) ) |
---|
2911 | |
---|
2912 | CASE ( 'aerosol_mass' ) |
---|
2913 | DO ic = 1, ncomponents_mass * nbins_aerosol |
---|
2914 | IF ( k == 1 ) READ ( 13 ) tmp_3d |
---|
2915 | aerosol_mass(ic)%conc(:,nysc-nbgp:nync+nbgp,nxlc-nbgp:nxrc+nbgp) = & |
---|
2916 | tmp_3d(:,nysf-nbgp:nynf+nbgp,nxlf-nbgp:nxrf+nbgp) |
---|
2917 | ENDDO |
---|
2918 | found = .TRUE. |
---|
2919 | |
---|
2920 | CASE ( 'aerosol_number' ) |
---|
2921 | DO ib = 1, nbins_aerosol |
---|
2922 | IF ( k == 1 ) READ ( 13 ) tmp_3d |
---|
2923 | aerosol_number(ib)%conc(:,nysc-nbgp:nync+nbgp,nxlc-nbgp:nxrc+nbgp) = & |
---|
2924 | tmp_3d(:,nysf-nbgp:nynf+nbgp,nxlf-nbgp:nxrf+nbgp) |
---|
2925 | ENDDO |
---|
2926 | found = .TRUE. |
---|
2927 | |
---|
2928 | CASE( 'salsa_gases_av' ) |
---|
2929 | IF ( .NOT. ALLOCATED( salsa_gases_av ) ) THEN |
---|
2930 | ALLOCATE( salsa_gases_av(nzb:nzt+1,nysg:nyng,nxlg:nxrg,ngases_salsa) ) |
---|
2931 | ENDIF |
---|
2932 | DO ig = 1, ngases_salsa |
---|
2933 | IF ( k == 1 ) READ ( 13 ) tmp_3d |
---|
2934 | salsa_gases_av(:,nysc-nbgp:nync+nbgp,nxlc-nbgp:nxrc+nbgp,ig) = & |
---|
2935 | tmp_3d(:,nysf-nbgp:nynf+nbgp,nxlf-nbgp:nxrf+nbgp) |
---|
2936 | ENDDO |
---|
2937 | found = .TRUE. |
---|
2938 | |
---|
2939 | CASE ( 'ldsa_av' ) |
---|
2940 | IF ( .NOT. ALLOCATED( ldsa_av ) ) ALLOCATE( ldsa_av(nzb:nzt+1,nysg:nyng,nxlg:nxrg) ) |
---|
2941 | IF ( k == 1 ) READ ( 13 ) tmp_3d |
---|
2942 | ldsa_av(:,nysc-nbgp:nync+nbgp,nxlc-nbgp:nxrc+nbgp) = & |
---|
2943 | tmp_3d(:,nysf-nbgp:nynf+nbgp,nxlf-nbgp:nxrf+nbgp) |
---|
2944 | found = .TRUE. |
---|
2945 | |
---|
2946 | CASE ( 'mbins_av' ) |
---|
2947 | IF ( .NOT. ALLOCATED( mbins_av ) ) THEN |
---|
2948 | ALLOCATE( mbins_av(nzb:nzt+1,nysg:nyng,nxlg:nxrg,nbins_aerosol) ) |
---|
2949 | ENDIF |
---|
2950 | DO ib = 1, nbins_aerosol |
---|
2951 | IF ( k == 1 ) READ ( 13 ) tmp_3d |
---|
2952 | mbins_av(:,nysc-nbgp:nync+nbgp,nxlc-nbgp:nxrc+nbgp,ib) = & |
---|
2953 | tmp_3d(:,nysf-nbgp:nynf+nbgp,nxlf-nbgp:nxrf+nbgp) |
---|
2954 | found = .TRUE. |
---|
2955 | ENDDO |
---|
2956 | |
---|
2957 | CASE ( 'nbins_av' ) |
---|
2958 | IF ( .NOT. ALLOCATED( nbins_av ) ) THEN |
---|
2959 | ALLOCATE( nbins_av(nzb:nzt+1,nysg:nyng,nxlg:nxrg,nbins_aerosol) ) |
---|
2960 | ENDIF |
---|
2961 | DO ib = 1, nbins_aerosol |
---|
2962 | IF ( k == 1 ) READ ( 13 ) tmp_3d |
---|
2963 | nbins_av(:,nysc-nbgp:nync+nbgp,nxlc-nbgp:nxrc+nbgp,ib) = & |
---|
2964 | tmp_3d(:,nysf-nbgp:nynf+nbgp,nxlf-nbgp:nxrf+nbgp) |
---|
2965 | found = .TRUE. |
---|
2966 | ENDDO |
---|
2967 | |
---|
2968 | CASE ( 'ntot_av' ) |
---|
2969 | IF ( .NOT. ALLOCATED( ntot_av ) ) ALLOCATE( ntot_av(nzb:nzt+1,nysg:nyng,nxlg:nxrg) ) |
---|
2970 | IF ( k == 1 ) READ ( 13 ) tmp_3d |
---|
2971 | ntot_av(:,nysc-nbgp:nync+nbgp,nxlc-nbgp:nxrc+nbgp) = & |
---|
2972 | tmp_3d(:,nysf-nbgp:nynf+nbgp,nxlf-nbgp:nxrf+nbgp) |
---|
2973 | found = .TRUE. |
---|
2974 | |
---|
2975 | CASE ( 'nufp_av' ) |
---|
2976 | IF ( .NOT. ALLOCATED( nufp_av ) ) ALLOCATE( nufp_av(nzb:nzt+1,nysg:nyng,nxlg:nxrg) ) |
---|
2977 | IF ( k == 1 ) READ ( 13 ) tmp_3d |
---|
2978 | nufp_av(:,nysc-nbgp:nync+nbgp,nxlc-nbgp:nxrc+nbgp) = & |
---|
2979 | tmp_3d(:,nysf-nbgp:nynf+nbgp,nxlf-nbgp:nxrf+nbgp) |
---|
2980 | found = .TRUE. |
---|
2981 | |
---|
2982 | CASE ( 'pm01_av' ) |
---|
2983 | IF ( .NOT. ALLOCATED( pm01_av ) ) ALLOCATE( pm01_av(nzb:nzt+1,nysg:nyng,nxlg:nxrg) ) |
---|
2984 | IF ( k == 1 ) READ ( 13 ) tmp_3d |
---|
2985 | pm01_av(:,nysc-nbgp:nync+nbgp,nxlc-nbgp:nxrc+nbgp) = & |
---|
2986 | tmp_3d(:,nysf-nbgp:nynf+nbgp,nxlf-nbgp:nxrf+nbgp) |
---|
2987 | found = .TRUE. |
---|
2988 | |
---|
2989 | CASE ( 'pm25_av' ) |
---|
2990 | IF ( .NOT. ALLOCATED( pm25_av ) ) ALLOCATE( pm25_av(nzb:nzt+1,nysg:nyng,nxlg:nxrg) ) |
---|
2991 | IF ( k == 1 ) READ ( 13 ) tmp_3d |
---|
2992 | pm25_av(:,nysc-nbgp:nync+nbgp,nxlc-nbgp:nxrc+nbgp) = & |
---|
2993 | tmp_3d(:,nysf-nbgp:nynf+nbgp,nxlf-nbgp:nxrf+nbgp) |
---|
2994 | found = .TRUE. |
---|
2995 | |
---|
2996 | CASE ( 'pm10_av' ) |
---|
2997 | IF ( .NOT. ALLOCATED( pm10_av ) ) ALLOCATE( pm10_av(nzb:nzt+1,nysg:nyng,nxlg:nxrg) ) |
---|
2998 | IF ( k == 1 ) READ ( 13 ) tmp_3d |
---|
2999 | pm10_av(:,nysc-nbgp:nync+nbgp,nxlc-nbgp:nxrc+nbgp) = & |
---|
3000 | tmp_3d(:,nysf-nbgp:nynf+nbgp,nxlf-nbgp:nxrf+nbgp) |
---|
3001 | found = .TRUE. |
---|
3002 | |
---|
3003 | CASE ( 's_mass_av' ) |
---|
3004 | IF ( .NOT. ALLOCATED( s_mass_av ) ) THEN |
---|
3005 | ALLOCATE( s_mass_av(nzb:nzt+1,nysg:nyng,nxlg:nxrg,ncomponents_mass) ) |
---|
3006 | ENDIF |
---|
3007 | DO ic = 1, ncomponents_mass |
---|
3008 | IF ( k == 1 ) READ ( 13 ) tmp_3d |
---|
3009 | s_mass_av(:,nysc-nbgp:nync+nbgp,nxlc-nbgp:nxrc+nbgp,ic) = & |
---|
3010 | tmp_3d(:,nysf-nbgp:nynf+nbgp,nxlf-nbgp:nxrf+nbgp) |
---|
3011 | ENDDO |
---|
3012 | found = .TRUE. |
---|
3013 | |
---|
3014 | CASE ( 's_h2o_av' ) |
---|
3015 | IF ( .NOT. ALLOCATED( s_h2o_av ) ) ALLOCATE( s_h2o_av(nzb:nzt+1,nysg:nyng,nxlg:nxrg) ) |
---|
3016 | IF ( k == 1 ) READ ( 13 ) tmp_3d |
---|
3017 | s_h2o_av(:,nysc-nbgp:nync+nbgp,nxlc-nbgp:nxrc+nbgp) = & |
---|
3018 | tmp_3d(:,nysf-nbgp:nynf+nbgp,nxlf-nbgp:nxrf+nbgp) |
---|
3019 | found = .TRUE. |
---|
3020 | |
---|
3021 | CASE ( 'salsa_gas' ) |
---|
3022 | IF ( .NOT. salsa_gases_from_chem ) THEN |
---|
3023 | DO ig = 1, ngases_salsa |
---|
3024 | IF ( k == 1 ) READ ( 13 ) tmp_3d |
---|
3025 | salsa_gas(ig)%conc(:,nysc-nbgp:nync+nbgp,nxlc-nbgp:nxrc+nbgp) = & |
---|
3026 | tmp_3d(:,nysf-nbgp:nynf+nbgp,nxlf-nbgp:nxrf+nbgp) |
---|
3027 | ENDDO |
---|
3028 | found = .TRUE. |
---|
3029 | ENDIF |
---|
3030 | |
---|
3031 | CASE DEFAULT |
---|
3032 | found = .FALSE. |
---|
3033 | |
---|
3034 | END SELECT |
---|
3035 | ENDIF |
---|
3036 | |
---|
3037 | END SUBROUTINE salsa_rrd_local |
---|
3038 | |
---|
3039 | !------------------------------------------------------------------------------! |
---|
3040 | ! Description: |
---|
3041 | ! ------------ |
---|
3042 | !> This routine writes the respective restart data. |
---|
3043 | !> Note that the following input variables in PARIN have to be equal between |
---|
3044 | !> restart runs: |
---|
3045 | !> listspec, nbin, nbin2, nf2a, ncc, mass_fracs_a, mass_fracs_b |
---|
3046 | !------------------------------------------------------------------------------! |
---|
3047 | SUBROUTINE salsa_wrd_local |
---|
3048 | |
---|
3049 | USE control_parameters, & |
---|
3050 | ONLY: write_binary |
---|
3051 | |
---|
3052 | IMPLICIT NONE |
---|
3053 | |
---|
3054 | INTEGER(iwp) :: ib !< |
---|
3055 | INTEGER(iwp) :: ic !< |
---|
3056 | INTEGER(iwp) :: ig !< |
---|
3057 | |
---|
3058 | IF ( write_binary .AND. write_binary_salsa ) THEN |
---|
3059 | |
---|
3060 | CALL wrd_write_string( 'aerosol_mass' ) |
---|
3061 | DO ic = 1, nbins_aerosol * ncomponents_mass |
---|
3062 | WRITE ( 14 ) aerosol_mass(ic)%conc |
---|
3063 | ENDDO |
---|
3064 | |
---|
3065 | CALL wrd_write_string( 'aerosol_number' ) |
---|
3066 | DO ib = 1, nbins_aerosol |
---|
3067 | WRITE ( 14 ) aerosol_number(ib)%conc |
---|
3068 | ENDDO |
---|
3069 | |
---|
3070 | IF ( .NOT. salsa_gases_from_chem ) THEN |
---|
3071 | |
---|
3072 | IF ( ALLOCATED( salsa_gases_av ) ) THEN |
---|
3073 | CALL wrd_write_string( 'salsa_gases_av' ) |
---|
3074 | DO ig = 1, ngases_salsa |
---|
3075 | WRITE ( 14 ) salsa_gases_av(:,:,:,ig) |
---|
3076 | ENDDO |
---|
3077 | ENDIF |
---|
3078 | ENDIF |
---|
3079 | |
---|
3080 | IF ( ALLOCATED( ldsa_av ) ) THEN |
---|
3081 | CALL wrd_write_string( 'ldsa_av' ) |
---|
3082 | WRITE ( 14 ) ldsa_av |
---|
3083 | ENDIF |
---|
3084 | |
---|
3085 | IF ( ALLOCATED( mbins_av ) ) THEN |
---|
3086 | CALL wrd_write_string( 'mbins_av' ) |
---|
3087 | DO ib = 1, nbins_aerosol |
---|
3088 | WRITE ( 14 ) mbins_av(:,:,:,ib) |
---|
3089 | ENDDO |
---|
3090 | ENDIF |
---|
3091 | |
---|
3092 | IF ( ALLOCATED( nbins_av ) ) THEN |
---|
3093 | CALL wrd_write_string( 'nbins_av' ) |
---|
3094 | DO ib = 1, nbins_aerosol |
---|
3095 | WRITE ( 14 ) nbins_av(:,:,:,ib) |
---|
3096 | ENDDO |
---|
3097 | ENDIF |
---|
3098 | |
---|
3099 | IF ( ALLOCATED( ldsa_av ) ) THEN |
---|
3100 | CALL wrd_write_string( 'ntot_av' ) |
---|
3101 | WRITE ( 14 ) ntot_av |
---|
3102 | ENDIF |
---|
3103 | |
---|
3104 | IF ( ALLOCATED( nufp_av ) ) THEN |
---|
3105 | CALL wrd_write_string( 'nufp_av' ) |
---|
3106 | WRITE ( 14 ) nufp_av |
---|
3107 | ENDIF |
---|
3108 | |
---|
3109 | IF ( ALLOCATED( pm01_av ) ) THEN |
---|
3110 | CALL wrd_write_string( 'pm01_av' ) |
---|
3111 | WRITE ( 14 ) pm01_av |
---|
3112 | ENDIF |
---|
3113 | |
---|
3114 | IF ( ALLOCATED( pm25_av ) ) THEN |
---|
3115 | CALL wrd_write_string( 'pm25_av' ) |
---|
3116 | WRITE ( 14 ) pm25_av |
---|
3117 | ENDIF |
---|
3118 | |
---|
3119 | IF ( ALLOCATED( pm10_av ) ) THEN |
---|
3120 | CALL wrd_write_string( 'pm10_av' ) |
---|
3121 | WRITE ( 14 ) pm10_av |
---|
3122 | ENDIF |
---|
3123 | |
---|
3124 | IF ( ALLOCATED( s_mass_av ) ) THEN |
---|
3125 | CALL wrd_write_string( 's_mass_av' ) |
---|
3126 | DO ic = 1, ncomponents_mass |
---|
3127 | WRITE ( 14 ) s_mass_av(:,:,:,ic) |
---|
3128 | ENDDO |
---|
3129 | ENDIF |
---|
3130 | |
---|
3131 | IF ( ALLOCATED( s_h2o_av ) ) THEN |
---|
3132 | CALL wrd_write_string( 's_h2o_av' ) |
---|
3133 | WRITE ( 14 ) s_h2o_av |
---|
3134 | ENDIF |
---|
3135 | |
---|
3136 | IF ( .NOT. salsa_gases_from_chem ) THEN |
---|
3137 | CALL wrd_write_string( 'salsa_gas' ) |
---|
3138 | DO ig = 1, ngases_salsa |
---|
3139 | WRITE ( 14 ) salsa_gas(ig)%conc |
---|
3140 | ENDDO |
---|
3141 | ENDIF |
---|
3142 | |
---|
3143 | ENDIF |
---|
3144 | |
---|
3145 | END SUBROUTINE salsa_wrd_local |
---|
3146 | |
---|
3147 | !------------------------------------------------------------------------------! |
---|
3148 | ! Description: |
---|
3149 | ! ------------ |
---|
3150 | !> Performs necessary unit and dimension conversion between the host model and |
---|
3151 | !> SALSA module, and calls the main SALSA routine. |
---|
3152 | !> Partially adobted form the original SALSA boxmodel version. |
---|
3153 | !> Now takes masses in as kg/kg from LES!! Converted to m3/m3 for SALSA |
---|
3154 | !> 05/2016 Juha: This routine is still pretty much in its original shape. |
---|
3155 | !> It's dumb as a mule and twice as ugly, so implementation of |
---|
3156 | !> an improved solution is necessary sooner or later. |
---|
3157 | !> Juha Tonttila, FMI, 2014 |
---|
3158 | !> Jaakko Ahola, FMI, 2016 |
---|
3159 | !> Only aerosol processes included, Mona Kurppa, UHel, 2017 |
---|
3160 | !------------------------------------------------------------------------------! |
---|
3161 | SUBROUTINE salsa_driver( i, j, prunmode ) |
---|
3162 | |
---|
3163 | USE arrays_3d, & |
---|
3164 | ONLY: pt_p, q_p, u, v, w |
---|
3165 | |
---|
3166 | USE plant_canopy_model_mod, & |
---|
3167 | ONLY: lad_s |
---|
3168 | |
---|
3169 | USE surface_mod, & |
---|
3170 | ONLY: surf_def_h, surf_def_v, surf_lsm_h, surf_lsm_v, surf_usm_h, surf_usm_v |
---|
3171 | |
---|
3172 | IMPLICIT NONE |
---|
3173 | |
---|
3174 | INTEGER(iwp) :: endi !< end index |
---|
3175 | INTEGER(iwp) :: ib !< loop index |
---|
3176 | INTEGER(iwp) :: ic !< loop index |
---|
3177 | INTEGER(iwp) :: ig !< loop index |
---|
3178 | INTEGER(iwp) :: k_wall !< vertical index of topography top |
---|
3179 | INTEGER(iwp) :: k !< loop index |
---|
3180 | INTEGER(iwp) :: l !< loop index |
---|
3181 | INTEGER(iwp) :: nc_h2o !< index of H2O in the prtcl index table |
---|
3182 | INTEGER(iwp) :: ss !< loop index |
---|
3183 | INTEGER(iwp) :: str !< start index |
---|
3184 | INTEGER(iwp) :: vc !< default index in prtcl |
---|
3185 | |
---|
3186 | INTEGER(iwp), INTENT(in) :: i !< loop index |
---|
3187 | INTEGER(iwp), INTENT(in) :: j !< loop index |
---|
3188 | INTEGER(iwp), INTENT(in) :: prunmode !< 1: Initialization, 2: Spinup, 3: Regular runtime |
---|
3189 | |
---|
3190 | REAL(wp) :: cw_old !< previous H2O mixing ratio |
---|
3191 | REAL(wp) :: flag !< flag to mask topography grid points |
---|
3192 | REAL(wp) :: in_lad !< leaf area density (m2/m3) |
---|
3193 | REAL(wp) :: in_rh !< relative humidity |
---|
3194 | REAL(wp) :: zgso4 !< SO4 |
---|
3195 | REAL(wp) :: zghno3 !< HNO3 |
---|
3196 | REAL(wp) :: zgnh3 !< NH3 |
---|
3197 | REAL(wp) :: zgocnv !< non-volatile OC |
---|
3198 | REAL(wp) :: zgocsv !< semi-volatile OC |
---|
3199 | |
---|
3200 | REAL(wp), DIMENSION(nzb:nzt+1) :: in_adn !< air density (kg/m3) |
---|
3201 | REAL(wp), DIMENSION(nzb:nzt+1) :: in_cs !< H2O sat. vapour conc. |
---|
3202 | REAL(wp), DIMENSION(nzb:nzt+1) :: in_cw !< H2O vapour concentration |
---|
3203 | REAL(wp), DIMENSION(nzb:nzt+1) :: in_p !< pressure (Pa) |
---|
3204 | REAL(wp), DIMENSION(nzb:nzt+1) :: in_t !< temperature (K) |
---|
3205 | REAL(wp), DIMENSION(nzb:nzt+1) :: in_u !< wind magnitude (m/s) |
---|
3206 | REAL(wp), DIMENSION(nzb:nzt+1) :: kvis !< kinematic viscosity of air(m2/s) |
---|
3207 | REAL(wp), DIMENSION(nzb:nzt+1) :: ppm_to_nconc !< Conversion factor from ppm to #/m3 |
---|
3208 | |
---|
3209 | REAL(wp), DIMENSION(nzb:nzt+1,nbins_aerosol) :: schmidt_num !< particle Schmidt number |
---|
3210 | REAL(wp), DIMENSION(nzb:nzt+1,nbins_aerosol) :: vd !< particle fall seed (m/s) |
---|
3211 | |
---|
3212 | TYPE(t_section), DIMENSION(nbins_aerosol) :: lo_aero !< additional variable for OpenMP |
---|
3213 | TYPE(t_section), DIMENSION(nbins_aerosol) :: aero_old !< helper array |
---|
3214 | |
---|
3215 | aero_old(:)%numc = 0.0_wp |
---|
3216 | in_lad = 0.0_wp |
---|
3217 | in_u = 0.0_wp |
---|
3218 | kvis = 0.0_wp |
---|
3219 | lo_aero = aero |
---|
3220 | schmidt_num = 0.0_wp |
---|
3221 | vd = 0.0_wp |
---|
3222 | zgso4 = nclim |
---|
3223 | zghno3 = nclim |
---|
3224 | zgnh3 = nclim |
---|
3225 | zgocnv = nclim |
---|
3226 | zgocsv = nclim |
---|
3227 | ! |
---|
3228 | !-- Aerosol number is always set, but mass can be uninitialized |
---|
3229 | DO ib = 1, nbins_aerosol |
---|
3230 | lo_aero(ib)%volc(:) = 0.0_wp |
---|
3231 | aero_old(ib)%volc(:) = 0.0_wp |
---|
3232 | ENDDO |
---|
3233 | ! |
---|
3234 | !-- Set the salsa runtime config (How to make this more efficient?) |
---|
3235 | CALL set_salsa_runtime( prunmode ) |
---|
3236 | ! |
---|
3237 | !-- Calculate thermodynamic quantities needed in SALSA |
---|
3238 | CALL salsa_thrm_ij( i, j, p_ij=in_p, temp_ij=in_t, cw_ij=in_cw, cs_ij=in_cs, adn_ij=in_adn ) |
---|
3239 | ! |
---|
3240 | !-- Magnitude of wind: needed for deposition |
---|
3241 | IF ( lsdepo ) THEN |
---|
3242 | in_u(nzb+1:nzt) = SQRT( ( 0.5_wp * ( u(nzb+1:nzt,j,i) + u(nzb+1:nzt,j,i+1) ) )**2 + & |
---|
3243 | ( 0.5_wp * ( v(nzb+1:nzt,j,i) + v(nzb+1:nzt,j+1,i) ) )**2 + & |
---|
3244 | ( 0.5_wp * ( w(nzb:nzt-1,j,i) + w(nzb+1:nzt,j, i) ) )**2 ) |
---|
3245 | ENDIF |
---|
3246 | ! |
---|
3247 | !-- Calculate conversion factors for gas concentrations |
---|
3248 | ppm_to_nconc(:) = for_ppm_to_nconc * in_p(:) / in_t(:) |
---|
3249 | ! |
---|
3250 | !-- Determine topography-top index on scalar grid |
---|
3251 | k_wall = k_topo_top(j,i) |
---|
3252 | |
---|
3253 | DO k = nzb+1, nzt |
---|
3254 | ! |
---|
3255 | !-- Predetermine flag to mask topography |
---|
3256 | flag = MERGE( 1.0_wp, 0.0_wp, BTEST( wall_flags_total_0(k,j,i), 0 ) ) |
---|
3257 | ! |
---|
3258 | !-- Wind velocity for dry depositon on vegetation |
---|
3259 | IF ( lsdepo_pcm .AND. plant_canopy ) THEN |
---|
3260 | in_lad = lad_s( MAX( k-k_wall,0 ),j,i) |
---|
3261 | ENDIF |
---|
3262 | ! |
---|
3263 | !-- For initialization and spinup, limit the RH with the parameter rhlim |
---|
3264 | IF ( prunmode < 3 ) THEN |
---|
3265 | in_cw(k) = MIN( in_cw(k), in_cs(k) * rhlim ) |
---|
3266 | ELSE |
---|
3267 | in_cw(k) = in_cw(k) |
---|
3268 | ENDIF |
---|
3269 | cw_old = in_cw(k) !* in_adn(k) |
---|
3270 | ! |
---|
3271 | !-- Set volume concentrations: |
---|
3272 | !-- Sulphate (SO4) or sulphuric acid H2SO4 |
---|
3273 | IF ( index_so4 > 0 ) THEN |
---|
3274 | vc = 1 |
---|
3275 | str = ( index_so4-1 ) * nbins_aerosol + 1 ! start index |
---|
3276 | endi = index_so4 * nbins_aerosol ! end index |
---|
3277 | ic = 1 |
---|
3278 | DO ss = str, endi |
---|
3279 | lo_aero(ic)%volc(vc) = aerosol_mass(ss)%conc(k,j,i) / arhoh2so4 |
---|
3280 | ic = ic+1 |
---|
3281 | ENDDO |
---|
3282 | aero_old(1:nbins_aerosol)%volc(vc) = lo_aero(1:nbins_aerosol)%volc(vc) |
---|
3283 | ENDIF |
---|
3284 | ! |
---|
3285 | !-- Organic carbon (OC) compounds |
---|
3286 | IF ( index_oc > 0 ) THEN |
---|
3287 | vc = 2 |
---|
3288 | str = ( index_oc-1 ) * nbins_aerosol + 1 |
---|
3289 | endi = index_oc * nbins_aerosol |
---|
3290 | ic = 1 |
---|
3291 | DO ss = str, endi |
---|
3292 | lo_aero(ic)%volc(vc) = aerosol_mass(ss)%conc(k,j,i) / arhooc |
---|
3293 | ic = ic+1 |
---|
3294 | ENDDO |
---|
3295 | aero_old(1:nbins_aerosol)%volc(vc) = lo_aero(1:nbins_aerosol)%volc(vc) |
---|
3296 | ENDIF |
---|
3297 | ! |
---|
3298 | !-- Black carbon (BC) |
---|
3299 | IF ( index_bc > 0 ) THEN |
---|
3300 | vc = 3 |
---|
3301 | str = ( index_bc-1 ) * nbins_aerosol + 1 + end_subrange_1a |
---|
3302 | endi = index_bc * nbins_aerosol |
---|
3303 | ic = 1 + end_subrange_1a |
---|
3304 | DO ss = str, endi |
---|
3305 | lo_aero(ic)%volc(vc) = aerosol_mass(ss)%conc(k,j,i) / arhobc |
---|
3306 | ic = ic+1 |
---|
3307 | ENDDO |
---|
3308 | aero_old(1:nbins_aerosol)%volc(vc) = lo_aero(1:nbins_aerosol)%volc(vc) |
---|
3309 | ENDIF |
---|
3310 | ! |
---|
3311 | !-- Dust (DU) |
---|
3312 | IF ( index_du > 0 ) THEN |
---|
3313 | vc = 4 |
---|
3314 | str = ( index_du-1 ) * nbins_aerosol + 1 + end_subrange_1a |
---|
3315 | endi = index_du * nbins_aerosol |
---|
3316 | ic = 1 + end_subrange_1a |
---|
3317 | DO ss = str, endi |
---|
3318 | lo_aero(ic)%volc(vc) = aerosol_mass(ss)%conc(k,j,i) / arhodu |
---|
3319 | ic = ic+1 |
---|
3320 | ENDDO |
---|
3321 | aero_old(1:nbins_aerosol)%volc(vc) = lo_aero(1:nbins_aerosol)%volc(vc) |
---|
3322 | ENDIF |
---|
3323 | ! |
---|
3324 | !-- Sea salt (SS) |
---|
3325 | IF ( index_ss > 0 ) THEN |
---|
3326 | vc = 5 |
---|
3327 | str = ( index_ss-1 ) * nbins_aerosol + 1 + end_subrange_1a |
---|
3328 | endi = index_ss * nbins_aerosol |
---|
3329 | ic = 1 + end_subrange_1a |
---|
3330 | DO ss = str, endi |
---|
3331 | lo_aero(ic)%volc(vc) = aerosol_mass(ss)%conc(k,j,i) / arhoss |
---|
3332 | ic = ic+1 |
---|
3333 | ENDDO |
---|
3334 | aero_old(1:nbins_aerosol)%volc(vc) = lo_aero(1:nbins_aerosol)%volc(vc) |
---|
3335 | ENDIF |
---|
3336 | ! |
---|
3337 | !-- Nitrate (NO(3-)) or nitric acid HNO3 |
---|
3338 | IF ( index_no > 0 ) THEN |
---|
3339 | vc = 6 |
---|
3340 | str = ( index_no-1 ) * nbins_aerosol + 1 |
---|
3341 | endi = index_no * nbins_aerosol |
---|
3342 | ic = 1 |
---|
3343 | DO ss = str, endi |
---|
3344 | lo_aero(ic)%volc(vc) = aerosol_mass(ss)%conc(k,j,i) / arhohno3 |
---|
3345 | ic = ic+1 |
---|
3346 | ENDDO |
---|
3347 | aero_old(1:nbins_aerosol)%volc(vc) = lo_aero(1:nbins_aerosol)%volc(vc) |
---|
3348 | ENDIF |
---|
3349 | ! |
---|
3350 | !-- Ammonium (NH(4+)) or ammonia NH3 |
---|
3351 | IF ( index_nh > 0 ) THEN |
---|
3352 | vc = 7 |
---|
3353 | str = ( index_nh-1 ) * nbins_aerosol + 1 |
---|
3354 | endi = index_nh * nbins_aerosol |
---|
3355 | ic = 1 |
---|
3356 | DO ss = str, endi |
---|
3357 | lo_aero(ic)%volc(vc) = aerosol_mass(ss)%conc(k,j,i) / arhonh3 |
---|
3358 | ic = ic+1 |
---|
3359 | ENDDO |
---|
3360 | aero_old(1:nbins_aerosol)%volc(vc) = lo_aero(1:nbins_aerosol)%volc(vc) |
---|
3361 | ENDIF |
---|
3362 | ! |
---|
3363 | !-- Water (always used) |
---|
3364 | nc_h2o = get_index( prtcl,'H2O' ) |
---|
3365 | vc = 8 |
---|
3366 | str = ( nc_h2o-1 ) * nbins_aerosol + 1 |
---|
3367 | endi = nc_h2o * nbins_aerosol |
---|
3368 | ic = 1 |
---|
3369 | IF ( advect_particle_water ) THEN |
---|
3370 | DO ss = str, endi |
---|
3371 | lo_aero(ic)%volc(vc) = aerosol_mass(ss)%conc(k,j,i) / arhoh2o |
---|
3372 | ic = ic+1 |
---|
3373 | ENDDO |
---|
3374 | ELSE |
---|
3375 | lo_aero(1:nbins_aerosol)%volc(vc) = mclim |
---|
3376 | ENDIF |
---|
3377 | aero_old(1:nbins_aerosol)%volc(vc) = lo_aero(1:nbins_aerosol)%volc(vc) |
---|
3378 | ! |
---|
3379 | !-- Number concentrations (numc) and particle sizes |
---|
3380 | !-- (dwet = wet diameter, core = dry volume) |
---|
3381 | DO ib = 1, nbins_aerosol |
---|
3382 | lo_aero(ib)%numc = aerosol_number(ib)%conc(k,j,i) |
---|
3383 | aero_old(ib)%numc = lo_aero(ib)%numc |
---|
3384 | IF ( lo_aero(ib)%numc > nclim ) THEN |
---|
3385 | lo_aero(ib)%dwet = ( SUM( lo_aero(ib)%volc(:) ) / lo_aero(ib)%numc / api6 )**0.33333333_wp |
---|
3386 | lo_aero(ib)%core = SUM( lo_aero(ib)%volc(1:7) ) / lo_aero(ib)%numc |
---|
3387 | ELSE |
---|
3388 | lo_aero(ib)%dwet = lo_aero(ib)%dmid |
---|
3389 | lo_aero(ib)%core = api6 * ( lo_aero(ib)%dwet )**3 |
---|
3390 | ENDIF |
---|
3391 | ENDDO |
---|
3392 | ! |
---|
3393 | !-- Calculate the ambient sizes of particles by equilibrating soluble fraction of particles with |
---|
3394 | !-- water using the ZSR method. |
---|
3395 | in_rh = in_cw(k) / in_cs(k) |
---|
3396 | IF ( prunmode==1 .OR. .NOT. advect_particle_water ) THEN |
---|
3397 | CALL equilibration( in_rh, in_t(k), lo_aero, .TRUE. ) |
---|
3398 | ENDIF |
---|
3399 | ! |
---|
3400 | !-- Gaseous tracer concentrations in #/m3 |
---|
3401 | IF ( salsa_gases_from_chem ) THEN |
---|
3402 | ! |
---|
3403 | !-- Convert concentrations in ppm to #/m3 |
---|
3404 | zgso4 = chem_species(gas_index_chem(1))%conc(k,j,i) * ppm_to_nconc(k) |
---|
3405 | zghno3 = chem_species(gas_index_chem(2))%conc(k,j,i) * ppm_to_nconc(k) |
---|
3406 | zgnh3 = chem_species(gas_index_chem(3))%conc(k,j,i) * ppm_to_nconc(k) |
---|
3407 | zgocnv = chem_species(gas_index_chem(4))%conc(k,j,i) * ppm_to_nconc(k) |
---|
3408 | zgocsv = chem_species(gas_index_chem(5))%conc(k,j,i) * ppm_to_nconc(k) |
---|
3409 | ELSE |
---|
3410 | zgso4 = salsa_gas(1)%conc(k,j,i) |
---|
3411 | zghno3 = salsa_gas(2)%conc(k,j,i) |
---|
3412 | zgnh3 = salsa_gas(3)%conc(k,j,i) |
---|
3413 | zgocnv = salsa_gas(4)%conc(k,j,i) |
---|
3414 | zgocsv = salsa_gas(5)%conc(k,j,i) |
---|
3415 | ENDIF |
---|
3416 | ! |
---|
3417 | !-- Calculate aerosol processes: |
---|
3418 | !-- ********************************************************************************************* |
---|
3419 | ! |
---|
3420 | !-- Coagulation |
---|
3421 | IF ( lscoag ) THEN |
---|
3422 | CALL coagulation( lo_aero, dt_salsa, in_t(k), in_p(k) ) |
---|
3423 | ENDIF |
---|
3424 | ! |
---|
3425 | !-- Condensation |
---|
3426 | IF ( lscnd ) THEN |
---|
3427 | CALL condensation( lo_aero, zgso4, zgocnv, zgocsv, zghno3, zgnh3, in_cw(k), in_cs(k), & |
---|
3428 | in_t(k), in_p(k), dt_salsa, prtcl ) |
---|
3429 | ENDIF |
---|
3430 | ! |
---|
3431 | !-- Deposition |
---|
3432 | IF ( lsdepo ) THEN |
---|
3433 | CALL deposition( lo_aero, in_t(k), in_adn(k), in_u(k), in_lad, kvis(k), schmidt_num(k,:),& |
---|
3434 | vd(k,:) ) |
---|
3435 | ENDIF |
---|
3436 | ! |
---|
3437 | !-- Size distribution bin update |
---|
3438 | IF ( lsdistupdate ) THEN |
---|
3439 | CALL distr_update( lo_aero ) |
---|
3440 | ENDIF |
---|
3441 | !-- ********************************************************************************************* |
---|
3442 | |
---|
3443 | IF ( lsdepo ) sedim_vd(k,j,i,:) = vd(k,:) |
---|
3444 | ! |
---|
3445 | !-- Calculate changes in concentrations |
---|
3446 | DO ib = 1, nbins_aerosol |
---|
3447 | aerosol_number(ib)%conc(k,j,i) = aerosol_number(ib)%conc(k,j,i) + ( lo_aero(ib)%numc - & |
---|
3448 | aero_old(ib)%numc ) * flag |
---|
3449 | ENDDO |
---|
3450 | |
---|
3451 | IF ( index_so4 > 0 ) THEN |
---|
3452 | vc = 1 |
---|
3453 | str = ( index_so4-1 ) * nbins_aerosol + 1 |
---|
3454 | endi = index_so4 * nbins_aerosol |
---|
3455 | ic = 1 |
---|
3456 | DO ss = str, endi |
---|
3457 | aerosol_mass(ss)%conc(k,j,i) = aerosol_mass(ss)%conc(k,j,i) + ( lo_aero(ic)%volc(vc) -& |
---|
3458 | aero_old(ic)%volc(vc) ) * arhoh2so4 * flag |
---|
3459 | ic = ic+1 |
---|
3460 | ENDDO |
---|
3461 | ENDIF |
---|
3462 | |
---|
3463 | IF ( index_oc > 0 ) THEN |
---|
3464 | vc = 2 |
---|
3465 | str = ( index_oc-1 ) * nbins_aerosol + 1 |
---|
3466 | endi = index_oc * nbins_aerosol |
---|
3467 | ic = 1 |
---|
3468 | DO ss = str, endi |
---|
3469 | aerosol_mass(ss)%conc(k,j,i) = aerosol_mass(ss)%conc(k,j,i) + ( lo_aero(ic)%volc(vc) -& |
---|
3470 | aero_old(ic)%volc(vc) ) * arhooc * flag |
---|
3471 | ic = ic+1 |
---|
3472 | ENDDO |
---|
3473 | ENDIF |
---|
3474 | |
---|
3475 | IF ( index_bc > 0 ) THEN |
---|
3476 | vc = 3 |
---|
3477 | str = ( index_bc-1 ) * nbins_aerosol + 1 + end_subrange_1a |
---|
3478 | endi = index_bc * nbins_aerosol |
---|
3479 | ic = 1 + end_subrange_1a |
---|
3480 | DO ss = str, endi |
---|
3481 | aerosol_mass(ss)%conc(k,j,i) = aerosol_mass(ss)%conc(k,j,i) + ( lo_aero(ic)%volc(vc) -& |
---|
3482 | aero_old(ic)%volc(vc) ) * arhobc * flag |
---|
3483 | ic = ic+1 |
---|
3484 | ENDDO |
---|
3485 | ENDIF |
---|
3486 | |
---|
3487 | IF ( index_du > 0 ) THEN |
---|
3488 | vc = 4 |
---|
3489 | str = ( index_du-1 ) * nbins_aerosol + 1 + end_subrange_1a |
---|
3490 | endi = index_du * nbins_aerosol |
---|
3491 | ic = 1 + end_subrange_1a |
---|
3492 | DO ss = str, endi |
---|
3493 | aerosol_mass(ss)%conc(k,j,i) = aerosol_mass(ss)%conc(k,j,i) + ( lo_aero(ic)%volc(vc) -& |
---|
3494 | aero_old(ic)%volc(vc) ) * arhodu * flag |
---|
3495 | ic = ic+1 |
---|
3496 | ENDDO |
---|
3497 | ENDIF |
---|
3498 | |
---|
3499 | IF ( index_ss > 0 ) THEN |
---|
3500 | vc = 5 |
---|
3501 | str = ( index_ss-1 ) * nbins_aerosol + 1 + end_subrange_1a |
---|
3502 | endi = index_ss * nbins_aerosol |
---|
3503 | ic = 1 + end_subrange_1a |
---|
3504 | DO ss = str, endi |
---|
3505 | aerosol_mass(ss)%conc(k,j,i) = aerosol_mass(ss)%conc(k,j,i) + ( lo_aero(ic)%volc(vc) -& |
---|
3506 | aero_old(ic)%volc(vc) ) * arhoss * flag |
---|
3507 | ic = ic+1 |
---|
3508 | ENDDO |
---|
3509 | ENDIF |
---|
3510 | |
---|
3511 | IF ( index_no > 0 ) THEN |
---|
3512 | vc = 6 |
---|
3513 | str = ( index_no-1 ) * nbins_aerosol + 1 |
---|
3514 | endi = index_no * nbins_aerosol |
---|
3515 | ic = 1 |
---|
3516 | DO ss = str, endi |
---|
3517 | aerosol_mass(ss)%conc(k,j,i) = aerosol_mass(ss)%conc(k,j,i) + ( lo_aero(ic)%volc(vc) -& |
---|
3518 | aero_old(ic)%volc(vc) ) * arhohno3 * flag |
---|
3519 | ic = ic+1 |
---|
3520 | ENDDO |
---|
3521 | ENDIF |
---|
3522 | |
---|
3523 | IF ( index_nh > 0 ) THEN |
---|
3524 | vc = 7 |
---|
3525 | str = ( index_nh-1 ) * nbins_aerosol + 1 |
---|
3526 | endi = index_nh * nbins_aerosol |
---|
3527 | ic = 1 |
---|
3528 | DO ss = str, endi |
---|
3529 | aerosol_mass(ss)%conc(k,j,i) = aerosol_mass(ss)%conc(k,j,i) + ( lo_aero(ic)%volc(vc) -& |
---|
3530 | aero_old(ic)%volc(vc) ) * arhonh3 * flag |
---|
3531 | ic = ic+1 |
---|
3532 | ENDDO |
---|
3533 | ENDIF |
---|
3534 | |
---|
3535 | IF ( advect_particle_water ) THEN |
---|
3536 | nc_h2o = get_index( prtcl,'H2O' ) |
---|
3537 | vc = 8 |
---|
3538 | str = ( nc_h2o-1 ) * nbins_aerosol + 1 |
---|
3539 | endi = nc_h2o * nbins_aerosol |
---|
3540 | ic = 1 |
---|
3541 | DO ss = str, endi |
---|
3542 | aerosol_mass(ss)%conc(k,j,i) = aerosol_mass(ss)%conc(k,j,i) + ( lo_aero(ic)%volc(vc) -& |
---|
3543 | aero_old(ic)%volc(vc) ) * arhoh2o * flag |
---|
3544 | ic = ic+1 |
---|
3545 | ENDDO |
---|
3546 | IF ( prunmode == 1 ) THEN |
---|
3547 | nc_h2o = get_index( prtcl,'H2O' ) |
---|
3548 | vc = 8 |
---|
3549 | str = ( nc_h2o-1 ) * nbins_aerosol + 1 |
---|
3550 | endi = nc_h2o * nbins_aerosol |
---|
3551 | ic = 1 |
---|
3552 | DO ss = str, endi |
---|
3553 | aerosol_mass(ss)%init(k) = MAX( aerosol_mass(ss)%init(k), ( lo_aero(ic)%volc(vc) - & |
---|
3554 | aero_old(ic)%volc(vc) ) * arhoh2o ) |
---|
3555 | IF ( k == nzb+1 ) THEN |
---|
3556 | aerosol_mass(ss)%init(k-1) = aerosol_mass(ss)%init(k) |
---|
3557 | ELSEIF ( k == nzt ) THEN |
---|
3558 | aerosol_mass(ss)%init(k+1) = aerosol_mass(ss)%init(k) |
---|
3559 | aerosol_mass(ss)%conc(k+1,j,i) = aerosol_mass(ss)%init(k) |
---|
3560 | ENDIF |
---|
3561 | ic = ic+1 |
---|
3562 | ENDDO |
---|
3563 | ENDIF |
---|
3564 | ENDIF |
---|
3565 | ! |
---|
3566 | !-- Condensation of precursor gases |
---|
3567 | IF ( lscndgas ) THEN |
---|
3568 | IF ( salsa_gases_from_chem ) THEN |
---|
3569 | ! |
---|
3570 | !-- SO4 (or H2SO4) |
---|
3571 | ig = gas_index_chem(1) |
---|
3572 | chem_species(ig)%conc(k,j,i) = chem_species(ig)%conc(k,j,i) + ( zgso4 / & |
---|
3573 | ppm_to_nconc(k) - chem_species(ig)%conc(k,j,i) ) * flag |
---|
3574 | ! |
---|
3575 | !-- HNO3 |
---|
3576 | ig = gas_index_chem(2) |
---|
3577 | chem_species(ig)%conc(k,j,i) = chem_species(ig)%conc(k,j,i) + ( zghno3 / & |
---|
3578 | ppm_to_nconc(k) - chem_species(ig)%conc(k,j,i) ) * flag |
---|
3579 | ! |
---|
3580 | !-- NH3 |
---|
3581 | ig = gas_index_chem(3) |
---|
3582 | chem_species(ig)%conc(k,j,i) = chem_species(ig)%conc(k,j,i) + ( zgnh3 / & |
---|
3583 | ppm_to_nconc(k) - chem_species(ig)%conc(k,j,i) ) * flag |
---|
3584 | ! |
---|
3585 | !-- non-volatile OC |
---|
3586 | ig = gas_index_chem(4) |
---|
3587 | chem_species(ig)%conc(k,j,i) = chem_species(ig)%conc(k,j,i) + ( zgocnv / & |
---|
3588 | ppm_to_nconc(k) - chem_species(ig)%conc(k,j,i) ) * flag |
---|
3589 | ! |
---|
3590 | !-- semi-volatile OC |
---|
3591 | ig = gas_index_chem(5) |
---|
3592 | chem_species(ig)%conc(k,j,i) = chem_species(ig)%conc(k,j,i) + ( zgocsv / & |
---|
3593 | ppm_to_nconc(k) - chem_species(ig)%conc(k,j,i) ) * flag |
---|
3594 | |
---|
3595 | ELSE |
---|
3596 | ! |
---|
3597 | !-- SO4 (or H2SO4) |
---|
3598 | salsa_gas(1)%conc(k,j,i) = salsa_gas(1)%conc(k,j,i) + ( zgso4 - & |
---|
3599 | salsa_gas(1)%conc(k,j,i) ) * flag |
---|
3600 | ! |
---|
3601 | !-- HNO3 |
---|
3602 | salsa_gas(2)%conc(k,j,i) = salsa_gas(2)%conc(k,j,i) + ( zghno3 - & |
---|
3603 | salsa_gas(2)%conc(k,j,i) ) * flag |
---|
3604 | ! |
---|
3605 | !-- NH3 |
---|
3606 | salsa_gas(3)%conc(k,j,i) = salsa_gas(3)%conc(k,j,i) + ( zgnh3 - & |
---|
3607 | salsa_gas(3)%conc(k,j,i) ) * flag |
---|
3608 | ! |
---|
3609 | !-- non-volatile OC |
---|
3610 | salsa_gas(4)%conc(k,j,i) = salsa_gas(4)%conc(k,j,i) + ( zgocnv - & |
---|
3611 | salsa_gas(4)%conc(k,j,i) ) * flag |
---|
3612 | ! |
---|
3613 | !-- semi-volatile OC |
---|
3614 | salsa_gas(5)%conc(k,j,i) = salsa_gas(5)%conc(k,j,i) + ( zgocsv - & |
---|
3615 | salsa_gas(5)%conc(k,j,i) ) * flag |
---|
3616 | ENDIF |
---|
3617 | ENDIF |
---|
3618 | ! |
---|
3619 | !-- Tendency of water vapour mixing ratio is obtained from the change in RH during SALSA run. |
---|
3620 | !-- This releases heat and changes pt. Assumes no temperature change during SALSA run. |
---|
3621 | !-- q = r / (1+r), Euler method for integration |
---|
3622 | ! |
---|
3623 | IF ( feedback_to_palm ) THEN |
---|
3624 | q_p(k,j,i) = q_p(k,j,i) + 1.0_wp / ( in_cw(k) * in_adn(k) + 1.0_wp )**2 * & |
---|
3625 | ( in_cw(k) - cw_old ) * in_adn(k) * flag |
---|
3626 | pt_p(k,j,i) = pt_p(k,j,i) + alv / c_p * ( in_cw(k) - cw_old ) * in_adn(k) / ( in_cw(k) / & |
---|
3627 | in_adn(k) + 1.0_wp )**2 * pt_p(k,j,i) / in_t(k) * flag |
---|
3628 | ENDIF |
---|
3629 | |
---|
3630 | ENDDO ! k |
---|
3631 | |
---|
3632 | ! |
---|
3633 | !-- Set surfaces and wall fluxes due to deposition |
---|
3634 | IF ( lsdepo .AND. lsdepo_surf .AND. prunmode == 3 ) THEN |
---|
3635 | IF ( .NOT. land_surface .AND. .NOT. urban_surface ) THEN |
---|
3636 | CALL depo_surf( i, j, surf_def_h(0), vd, schmidt_num, kvis, in_u, .TRUE. ) |
---|
3637 | DO l = 0, 3 |
---|
3638 | CALL depo_surf( i, j, surf_def_v(l), vd, schmidt_num, kvis, in_u, .FALSE. ) |
---|
3639 | ENDDO |
---|
3640 | ELSE |
---|
3641 | CALL depo_surf( i, j, surf_usm_h, vd, schmidt_num, kvis, in_u, .TRUE., usm_to_depo_h ) |
---|
3642 | DO l = 0, 3 |
---|
3643 | CALL depo_surf( i, j, surf_usm_v(l), vd, schmidt_num, kvis, in_u, .FALSE., & |
---|
3644 | usm_to_depo_v(l) ) |
---|
3645 | ENDDO |
---|
3646 | CALL depo_surf( i, j, surf_lsm_h, vd, schmidt_num, kvis, in_u, .TRUE., lsm_to_depo_h ) |
---|
3647 | DO l = 0, 3 |
---|
3648 | CALL depo_surf( i, j, surf_lsm_v(l), vd, schmidt_num, kvis, in_u, .FALSE., & |
---|
3649 | lsm_to_depo_v(l) ) |
---|
3650 | ENDDO |
---|
3651 | ENDIF |
---|
3652 | ENDIF |
---|
3653 | |
---|
3654 | IF ( prunmode < 3 ) THEN |
---|
3655 | !$OMP MASTER |
---|
3656 | aero = lo_aero |
---|
3657 | !$OMP END MASTER |
---|
3658 | END IF |
---|
3659 | |
---|
3660 | END SUBROUTINE salsa_driver |
---|
3661 | |
---|
3662 | !------------------------------------------------------------------------------! |
---|
3663 | ! Description: |
---|
3664 | ! ------------ |
---|
3665 | !> Set logical switches according to the salsa_parameters options. |
---|
3666 | !> Juha Tonttila, FMI, 2014 |
---|
3667 | !> Only aerosol processes included, Mona Kurppa, UHel, 2017 |
---|
3668 | !------------------------------------------------------------------------------! |
---|
3669 | SUBROUTINE set_salsa_runtime( prunmode ) |
---|
3670 | |
---|
3671 | IMPLICIT NONE |
---|
3672 | |
---|
3673 | INTEGER(iwp), INTENT(in) :: prunmode |
---|
3674 | |
---|
3675 | SELECT CASE(prunmode) |
---|
3676 | |
---|
3677 | CASE(1) !< Initialization |
---|
3678 | lscoag = .FALSE. |
---|
3679 | lscnd = .FALSE. |
---|
3680 | lscndgas = .FALSE. |
---|
3681 | lscndh2oae = .FALSE. |
---|
3682 | lsdepo = .FALSE. |
---|
3683 | lsdepo_pcm = .FALSE. |
---|
3684 | lsdepo_surf = .FALSE. |
---|
3685 | lsdistupdate = .TRUE. |
---|
3686 | lspartition = .FALSE. |
---|
3687 | |
---|
3688 | CASE(2) !< Spinup period |
---|
3689 | lscoag = ( .FALSE. .AND. nlcoag ) |
---|
3690 | lscnd = ( .TRUE. .AND. nlcnd ) |
---|
3691 | lscndgas = ( .TRUE. .AND. nlcndgas ) |
---|
3692 | lscndh2oae = ( .TRUE. .AND. nlcndh2oae ) |
---|
3693 | |
---|
3694 | CASE(3) !< Run |
---|
3695 | lscoag = nlcoag |
---|
3696 | lscnd = nlcnd |
---|
3697 | lscndgas = nlcndgas |
---|
3698 | lscndh2oae = nlcndh2oae |
---|
3699 | lsdepo = nldepo |
---|
3700 | lsdepo_pcm = nldepo_pcm |
---|
3701 | lsdepo_surf = nldepo_surf |
---|
3702 | lsdistupdate = nldistupdate |
---|
3703 | END SELECT |
---|
3704 | |
---|
3705 | |
---|
3706 | END SUBROUTINE set_salsa_runtime |
---|
3707 | |
---|
3708 | !------------------------------------------------------------------------------! |
---|
3709 | ! Description: |
---|
3710 | ! ------------ |
---|
3711 | !> Calculates the absolute temperature (using hydrostatic pressure), saturation |
---|
3712 | !> vapour pressure and mixing ratio over water, relative humidity and air |
---|
3713 | !> density needed in the SALSA model. |
---|
3714 | !> NOTE, no saturation adjustment takes place -> the resulting water vapour |
---|
3715 | !> mixing ratio can be supersaturated, allowing the microphysical calculations |
---|
3716 | !> in SALSA. |
---|
3717 | ! |
---|
3718 | !> Juha Tonttila, FMI, 2014 (original SALSAthrm) |
---|
3719 | !> Mona Kurppa, UHel, 2017 (adjustment for PALM and only aerosol processes) |
---|
3720 | !------------------------------------------------------------------------------! |
---|
3721 | SUBROUTINE salsa_thrm_ij( i, j, p_ij, temp_ij, cw_ij, cs_ij, adn_ij ) |
---|
3722 | |
---|
3723 | USE arrays_3d, & |
---|
3724 | ONLY: pt, q, zu |
---|
3725 | |
---|
3726 | USE basic_constants_and_equations_mod, & |
---|
3727 | ONLY: barometric_formula, exner_function, ideal_gas_law_rho, magnus |
---|
3728 | |
---|
3729 | IMPLICIT NONE |
---|
3730 | |
---|
3731 | INTEGER(iwp), INTENT(in) :: i !< |
---|
3732 | INTEGER(iwp), INTENT(in) :: j !< |
---|
3733 | |
---|
3734 | REAL(wp) :: t_surface !< absolute surface temperature (K) |
---|
3735 | |
---|
3736 | REAL(wp), DIMENSION(nzb:nzt+1) :: e_s !< saturation vapour pressure over water (Pa) |
---|
3737 | |
---|
3738 | REAL(wp), DIMENSION(:), INTENT(inout) :: adn_ij !< air density (kg/m3) |
---|
3739 | REAL(wp), DIMENSION(:), INTENT(inout) :: p_ij !< air pressure (Pa) |
---|
3740 | REAL(wp), DIMENSION(:), INTENT(inout) :: temp_ij !< air temperature (K) |
---|
3741 | |
---|
3742 | REAL(wp), DIMENSION(:), INTENT(inout), OPTIONAL :: cw_ij !< water vapour concentration (kg/m3) |
---|
3743 | REAL(wp), DIMENSION(:), INTENT(inout), OPTIONAL :: cs_ij !< saturation water vap. conc.(kg/m3) |
---|
3744 | ! |
---|
3745 | !-- Pressure p_ijk (Pa) = hydrostatic pressure |
---|
3746 | t_surface = pt_surface * exner_function( surface_pressure * 100.0_wp ) |
---|
3747 | p_ij(:) = barometric_formula( zu, t_surface, surface_pressure * 100.0_wp ) |
---|
3748 | ! |
---|
3749 | !-- Absolute ambient temperature (K) |
---|
3750 | temp_ij(:) = pt(:,j,i) * exner_function( p_ij(:) ) |
---|
3751 | ! |
---|
3752 | !-- Air density |
---|
3753 | adn_ij(:) = ideal_gas_law_rho( p_ij(:), temp_ij(:) ) |
---|
3754 | ! |
---|
3755 | !-- Water vapour concentration r_v (kg/m3) |
---|
3756 | IF ( PRESENT( cw_ij ) ) THEN |
---|
3757 | cw_ij(:) = ( q(:,j,i) / ( 1.0_wp - q(:,j,i) ) ) * adn_ij(:) |
---|
3758 | ENDIF |
---|
3759 | ! |
---|
3760 | !-- Saturation mixing ratio r_s (kg/kg) from vapour pressure at temp (Pa) |
---|
3761 | IF ( PRESENT( cs_ij ) ) THEN |
---|
3762 | e_s(:) = 611.0_wp * EXP( alv_d_rv * ( 3.6609E-3_wp - 1.0_wp / & |
---|
3763 | temp_ij(:) ) )! magnus( temp_ij(:) ) |
---|
3764 | cs_ij(:) = ( 0.622_wp * e_s / ( p_ij(:) - e_s(:) ) ) * adn_ij(:) |
---|
3765 | ENDIF |
---|
3766 | |
---|
3767 | END SUBROUTINE salsa_thrm_ij |
---|
3768 | |
---|
3769 | !------------------------------------------------------------------------------! |
---|
3770 | ! Description: |
---|
3771 | ! ------------ |
---|
3772 | !> Calculates ambient sizes of particles by equilibrating soluble fraction of |
---|
3773 | !> particles with water using the ZSR method (Stokes and Robinson, 1966). |
---|
3774 | !> Method: |
---|
3775 | !> Following chemical components are assumed water-soluble |
---|
3776 | !> - (ammonium) sulphate (100%) |
---|
3777 | !> - sea salt (100 %) |
---|
3778 | !> - organic carbon (epsoc * 100%) |
---|
3779 | !> Exact thermodynamic considerations neglected. |
---|
3780 | !> - If particles contain no sea salt, calculation according to sulphate |
---|
3781 | !> properties |
---|
3782 | !> - If contain sea salt but no sulphate, calculation according to sea salt |
---|
3783 | !> properties |
---|
3784 | !> - If contain both sulphate and sea salt -> the molar fraction of these |
---|
3785 | !> compounds determines which one of them is used as the basis of calculation. |
---|
3786 | !> If sulphate and sea salt coexist in a particle, it is assumed that the Cl is |
---|
3787 | !> replaced by sulphate; thus only either sulphate + organics or sea salt + |
---|
3788 | !> organics is included in the calculation of soluble fraction. |
---|
3789 | !> Molality parameterizations taken from Table 1 of Tang: Thermodynamic and |
---|
3790 | !> optical properties of mixed-salt aerosols of atmospheric importance, |
---|
3791 | !> J. Geophys. Res., 102 (D2), 1883-1893 (1997) |
---|
3792 | ! |
---|
3793 | !> Coded by: |
---|
3794 | !> Hannele Korhonen (FMI) 2005 |
---|
3795 | !> Harri Kokkola (FMI) 2006 |
---|
3796 | !> Matti Niskanen(FMI) 2012 |
---|
3797 | !> Anton Laakso (FMI) 2013 |
---|
3798 | !> Modified for the new aerosol datatype, Juha Tonttila (FMI) 2014 |
---|
3799 | ! |
---|
3800 | !> fxm: should sea salt form a solid particle when prh is very low (even though |
---|
3801 | !> it could be mixed with e.g. sulphate)? |
---|
3802 | !> fxm: crashes if no sulphate or sea salt |
---|
3803 | !> fxm: do we really need to consider Kelvin effect for subrange 2 |
---|
3804 | !------------------------------------------------------------------------------! |
---|
3805 | SUBROUTINE equilibration( prh, ptemp, paero, init ) |
---|
3806 | |
---|
3807 | IMPLICIT NONE |
---|
3808 | |
---|
3809 | INTEGER(iwp) :: ib !< loop index |
---|
3810 | INTEGER(iwp) :: counti !< loop index |
---|
3811 | |
---|
3812 | LOGICAL, INTENT(in) :: init !< TRUE: Initialization, FALSE: Normal runtime: update water |
---|
3813 | !< content only for 1a |
---|
3814 | |
---|
3815 | REAL(wp) :: zaw !< water activity [0-1] |
---|
3816 | REAL(wp) :: zcore !< Volume of dry particle |
---|
3817 | REAL(wp) :: zdold !< Old diameter |
---|
3818 | REAL(wp) :: zdwet !< Wet diameter or mean droplet diameter |
---|
3819 | REAL(wp) :: zke !< Kelvin term in the Köhler equation |
---|
3820 | REAL(wp) :: zlwc !< liquid water content [kg/m3-air] |
---|
3821 | REAL(wp) :: zrh !< Relative humidity |
---|
3822 | |
---|
3823 | REAL(wp), DIMENSION(maxspec) :: zbinmol !< binary molality of each components (mol/kg) |
---|
3824 | REAL(wp), DIMENSION(maxspec) :: zvpart !< volume of chem. compounds in one particle |
---|
3825 | |
---|
3826 | REAL(wp), INTENT(in) :: prh !< relative humidity [0-1] |
---|
3827 | REAL(wp), INTENT(in) :: ptemp !< temperature (K) |
---|
3828 | |
---|
3829 | TYPE(t_section), DIMENSION(nbins_aerosol), INTENT(inout) :: paero !< aerosol properties |
---|
3830 | |
---|
3831 | zaw = 0.0_wp |
---|
3832 | zlwc = 0.0_wp |
---|
3833 | ! |
---|
3834 | !-- Relative humidity: |
---|
3835 | zrh = prh |
---|
3836 | zrh = MAX( zrh, 0.05_wp ) |
---|
3837 | zrh = MIN( zrh, 0.98_wp) |
---|
3838 | ! |
---|
3839 | !-- 1) Regime 1: sulphate and partly water-soluble OC. Done for every CALL |
---|
3840 | DO ib = start_subrange_1a, end_subrange_1a ! size bin |
---|
3841 | |
---|
3842 | zbinmol = 0.0_wp |
---|
3843 | zdold = 1.0_wp |
---|
3844 | zke = 1.02_wp |
---|
3845 | |
---|
3846 | IF ( paero(ib)%numc > nclim ) THEN |
---|
3847 | ! |
---|
3848 | !-- Volume in one particle |
---|
3849 | zvpart = 0.0_wp |
---|
3850 | zvpart(1:2) = paero(ib)%volc(1:2) / paero(ib)%numc |
---|
3851 | zvpart(6:7) = paero(ib)%volc(6:7) / paero(ib)%numc |
---|
3852 | ! |
---|
3853 | !-- Total volume and wet diameter of one dry particle |
---|
3854 | zcore = SUM( zvpart(1:2) ) |
---|
3855 | zdwet = paero(ib)%dwet |
---|
3856 | |
---|
3857 | counti = 0 |
---|
3858 | DO WHILE ( ABS( zdwet / zdold - 1.0_wp ) > 1.0E-2_wp ) |
---|
3859 | |
---|
3860 | zdold = MAX( zdwet, 1.0E-20_wp ) |
---|
3861 | zaw = MAX( 1.0E-3_wp, zrh / zke ) ! To avoid underflow |
---|
3862 | ! |
---|
3863 | !-- Binary molalities (mol/kg): |
---|
3864 | !-- Sulphate |
---|
3865 | zbinmol(1) = 1.1065495E+2_wp - 3.6759197E+2_wp * zaw + 5.0462934E+2_wp * zaw**2 - & |
---|
3866 | 3.1543839E+2_wp * zaw**3 + 6.770824E+1_wp * zaw**4 |
---|
3867 | !-- Organic carbon |
---|
3868 | zbinmol(2) = 1.0_wp / ( zaw * amh2o ) - 1.0_wp / amh2o |
---|
3869 | !-- Nitric acid |
---|
3870 | zbinmol(6) = 2.306844303E+1_wp - 3.563608869E+1_wp * zaw - 6.210577919E+1_wp * zaw**2 & |
---|
3871 | + 5.510176187E+2_wp * zaw**3 - 1.460055286E+3_wp * zaw**4 & |
---|
3872 | + 1.894467542E+3_wp * zaw**5 - 1.220611402E+3_wp * zaw**6 & |
---|
3873 | + 3.098597737E+2_wp * zaw**7 |
---|
3874 | ! |
---|
3875 | !-- Calculate the liquid water content (kg/m3-air) using ZSR (see e.g. Eq. 10.98 in |
---|
3876 | !-- Seinfeld and Pandis (2006)) |
---|
3877 | zlwc = ( paero(ib)%volc(1) * ( arhoh2so4 / amh2so4 ) ) / zbinmol(1) + & |
---|
3878 | epsoc * paero(ib)%volc(2) * ( arhooc / amoc ) / zbinmol(2) + & |
---|
3879 | ( paero(ib)%volc(6) * ( arhohno3/amhno3 ) ) / zbinmol(6) |
---|
3880 | ! |
---|
3881 | !-- Particle wet diameter (m) |
---|
3882 | zdwet = ( zlwc / paero(ib)%numc / arhoh2o / api6 + ( SUM( zvpart(6:7) ) / api6 ) + & |
---|
3883 | zcore / api6 )**0.33333333_wp |
---|
3884 | ! |
---|
3885 | !-- Kelvin effect (Eq. 10.85 in in Seinfeld and Pandis (2006)). Avoid |
---|
3886 | !-- overflow. |
---|
3887 | zke = EXP( MIN( 50.0_wp, 4.0_wp * surfw0 * amvh2so4 / ( abo * ptemp * zdwet ) ) ) |
---|
3888 | |
---|
3889 | counti = counti + 1 |
---|
3890 | IF ( counti > 1000 ) THEN |
---|
3891 | message_string = 'Subrange 1: no convergence!' |
---|
3892 | CALL message( 'salsa_mod: equilibration', 'PA0617', 1, 2, 0, 6, 0 ) |
---|
3893 | ENDIF |
---|
3894 | ENDDO |
---|
3895 | ! |
---|
3896 | !-- Instead of lwc, use the volume concentration of water from now on |
---|
3897 | !-- (easy to convert...) |
---|
3898 | paero(ib)%volc(8) = zlwc / arhoh2o |
---|
3899 | ! |
---|
3900 | !-- If this is initialization, update the core and wet diameter |
---|
3901 | IF ( init ) THEN |
---|
3902 | paero(ib)%dwet = zdwet |
---|
3903 | paero(ib)%core = zcore |
---|
3904 | ENDIF |
---|
3905 | |
---|
3906 | ELSE |
---|
3907 | !-- If initialization |
---|
3908 | !-- 1.2) empty bins given bin average values |
---|
3909 | IF ( init ) THEN |
---|
3910 | paero(ib)%dwet = paero(ib)%dmid |
---|
3911 | paero(ib)%core = api6 * paero(ib)%dmid**3 |
---|
3912 | ENDIF |
---|
3913 | |
---|
3914 | ENDIF |
---|
3915 | |
---|
3916 | ENDDO ! ib |
---|
3917 | ! |
---|
3918 | !-- 2) Regime 2a: sulphate, OC, BC and sea salt |
---|
3919 | !-- This is done only for initialization call, otherwise the water contents |
---|
3920 | !-- are computed via condensation |
---|
3921 | IF ( init ) THEN |
---|
3922 | DO ib = start_subrange_2a, end_subrange_2b |
---|
3923 | ! |
---|
3924 | !-- Initialize |
---|
3925 | zke = 1.02_wp |
---|
3926 | zbinmol = 0.0_wp |
---|
3927 | zdold = 1.0_wp |
---|
3928 | ! |
---|
3929 | !-- 1) Particle properties calculated for non-empty bins |
---|
3930 | IF ( paero(ib)%numc > nclim ) THEN |
---|
3931 | ! |
---|
3932 | !-- Volume in one particle [fxm] |
---|
3933 | zvpart = 0.0_wp |
---|
3934 | zvpart(1:7) = paero(ib)%volc(1:7) / paero(ib)%numc |
---|
3935 | ! |
---|
3936 | !-- Total volume and wet diameter of one dry particle [fxm] |
---|
3937 | zcore = SUM( zvpart(1:5) ) |
---|
3938 | zdwet = paero(ib)%dwet |
---|
3939 | |
---|
3940 | counti = 0 |
---|
3941 | DO WHILE ( ABS( zdwet / zdold - 1.0_wp ) > 1.0E-12_wp ) |
---|
3942 | |
---|
3943 | zdold = MAX( zdwet, 1.0E-20_wp ) |
---|
3944 | zaw = zrh / zke |
---|
3945 | ! |
---|
3946 | !-- Binary molalities (mol/kg): |
---|
3947 | !-- Sulphate |
---|
3948 | zbinmol(1) = 1.1065495E+2_wp - 3.6759197E+2_wp * zaw + 5.0462934E+2_wp * zaw**2 - & |
---|
3949 | 3.1543839E+2_wp * zaw**3 + 6.770824E+1_wp * zaw**4 |
---|
3950 | !-- Organic carbon |
---|
3951 | zbinmol(2) = 1.0_wp / ( zaw * amh2o ) - 1.0_wp / amh2o |
---|
3952 | !-- Nitric acid |
---|
3953 | zbinmol(6) = 2.306844303E+1_wp - 3.563608869E+1_wp * zaw - & |
---|
3954 | 6.210577919E+1_wp * zaw**2 + 5.510176187E+2_wp * zaw**3 - & |
---|
3955 | 1.460055286E+3_wp * zaw**4 + 1.894467542E+3_wp * zaw**5 - & |
---|
3956 | 1.220611402E+3_wp * zaw**6 + 3.098597737E+2_wp * zaw**7 |
---|
3957 | !-- Sea salt (natrium chloride) |
---|
3958 | zbinmol(5) = 5.875248E+1_wp - 1.8781997E+2_wp * zaw + 2.7211377E+2_wp * zaw**2 - & |
---|
3959 | 1.8458287E+2_wp * zaw**3 + 4.153689E+1_wp * zaw**4 |
---|
3960 | ! |
---|
3961 | !-- Calculate the liquid water content (kg/m3-air) |
---|
3962 | zlwc = ( paero(ib)%volc(1) * ( arhoh2so4 / amh2so4 ) ) / zbinmol(1) + & |
---|
3963 | epsoc * ( paero(ib)%volc(2) * ( arhooc / amoc ) ) / zbinmol(2) + & |
---|
3964 | ( paero(ib)%volc(6) * ( arhohno3 / amhno3 ) ) / zbinmol(6) + & |
---|
3965 | ( paero(ib)%volc(5) * ( arhoss / amss ) ) / zbinmol(5) |
---|
3966 | |
---|
3967 | !-- Particle wet radius (m) |
---|
3968 | zdwet = ( zlwc / paero(ib)%numc / arhoh2o / api6 + ( SUM( zvpart(6:7) ) / api6 ) + & |
---|
3969 | zcore / api6 )**0.33333333_wp |
---|
3970 | ! |
---|
3971 | !-- Kelvin effect (Eq. 10.85 in Seinfeld and Pandis (2006)) |
---|
3972 | zke = EXP( MIN( 50.0_wp, 4.0_wp * surfw0 * amvh2so4 / ( abo * zdwet * ptemp ) ) ) |
---|
3973 | |
---|
3974 | counti = counti + 1 |
---|
3975 | IF ( counti > 1000 ) THEN |
---|
3976 | message_string = 'Subrange 2: no convergence!' |
---|
3977 | CALL message( 'salsa_mod: equilibration', 'PA0618', 1, 2, 0, 6, 0 ) |
---|
3978 | ENDIF |
---|
3979 | ENDDO |
---|
3980 | ! |
---|
3981 | !-- Liquid water content; instead of LWC use the volume concentration |
---|
3982 | paero(ib)%volc(8) = zlwc / arhoh2o |
---|
3983 | paero(ib)%dwet = zdwet |
---|
3984 | paero(ib)%core = zcore |
---|
3985 | |
---|
3986 | ELSE |
---|
3987 | !-- 2.2) empty bins given bin average values |
---|
3988 | paero(ib)%dwet = paero(ib)%dmid |
---|
3989 | paero(ib)%core = api6 * paero(ib)%dmid**3 |
---|
3990 | ENDIF |
---|
3991 | |
---|
3992 | ENDDO ! ib |
---|
3993 | ENDIF |
---|
3994 | |
---|
3995 | END SUBROUTINE equilibration |
---|
3996 | |
---|
3997 | !------------------------------------------------------------------------------! |
---|
3998 | !> Description: |
---|
3999 | !> ------------ |
---|
4000 | !> Calculation of the settling velocity vc (m/s) per aerosol size bin and |
---|
4001 | !> deposition on plant canopy (lsdepo_pcm). |
---|
4002 | ! |
---|
4003 | !> Deposition is based on either the scheme presented in: |
---|
4004 | !> Zhang et al. (2001), Atmos. Environ. 35, 549-560 (includes collection due to |
---|
4005 | !> Brownian diffusion, impaction, interception and sedimentation; hereafter ZO1) |
---|
4006 | !> OR |
---|
4007 | !> Petroff & Zhang (2010), Geosci. Model Dev. 3, 753-769 (includes also |
---|
4008 | !> collection due to turbulent impaction, hereafter P10) |
---|
4009 | ! |
---|
4010 | !> Equation numbers refer to equation in Jacobson (2005): Fundamentals of |
---|
4011 | !> Atmospheric Modeling, 2nd Edition. |
---|
4012 | ! |
---|
4013 | !> Subroutine follows closely sedim_SALSA in UCLALES-SALSA written by Juha |
---|
4014 | !> Tonttila (KIT/FMI) and Zubair Maalick (UEF). |
---|
4015 | !> Rewritten to PALM by Mona Kurppa (UH), 2017. |
---|
4016 | ! |
---|
4017 | !> Call for grid point i,j,k |
---|
4018 | !------------------------------------------------------------------------------! |
---|
4019 | |
---|
4020 | SUBROUTINE deposition( paero, tk, adn, mag_u, lad, kvis, schmidt_num, vc ) |
---|
4021 | |
---|
4022 | USE plant_canopy_model_mod, & |
---|
4023 | ONLY: canopy_drag_coeff |
---|
4024 | |
---|
4025 | IMPLICIT NONE |
---|
4026 | |
---|
4027 | INTEGER(iwp) :: ib !< loop index |
---|
4028 | INTEGER(iwp) :: ic !< loop index |
---|
4029 | |
---|
4030 | REAL(wp) :: alpha !< parameter, Table 3 in Z01 |
---|
4031 | REAL(wp) :: avis !< molecular viscocity of air (kg/(m*s)) |
---|
4032 | REAL(wp) :: beta_im !< parameter for turbulent impaction |
---|
4033 | REAL(wp) :: c_brownian_diff !< coefficient for Brownian diffusion |
---|
4034 | REAL(wp) :: c_impaction !< coefficient for inertial impaction |
---|
4035 | REAL(wp) :: c_interception !< coefficient for interception |
---|
4036 | REAL(wp) :: c_turb_impaction !< coefficient for turbulent impaction |
---|
4037 | REAL(wp) :: depo !< deposition velocity (m/s) |
---|
4038 | REAL(wp) :: gamma !< parameter, Table 3 in Z01 |
---|
4039 | REAL(wp) :: lambda !< molecular mean free path (m) |
---|
4040 | REAL(wp) :: mdiff !< particle diffusivity coefficient |
---|
4041 | REAL(wp) :: par_a !< parameter A for the characteristic radius of collectors, |
---|
4042 | !< Table 3 in Z01 |
---|
4043 | REAL(wp) :: par_l !< obstacle characteristic dimension in P10 |
---|
4044 | REAL(wp) :: pdn !< particle density (kg/m3) |
---|
4045 | REAL(wp) :: ustar !< friction velocity (m/s) |
---|
4046 | REAL(wp) :: va !< thermal speed of an air molecule (m/s) |
---|
4047 | |
---|
4048 | REAL(wp), INTENT(in) :: adn !< air density (kg/m3) |
---|
4049 | REAL(wp), INTENT(in) :: lad !< leaf area density (m2/m3) |
---|
4050 | REAL(wp), INTENT(in) :: mag_u !< wind velocity (m/s) |
---|
4051 | REAL(wp), INTENT(in) :: tk !< abs.temperature (K) |
---|
4052 | |
---|
4053 | REAL(wp), INTENT(inout) :: kvis !< kinematic viscosity of air (m2/s) |
---|
4054 | |
---|
4055 | REAL(wp), DIMENSION(nbins_aerosol) :: beta !< Cunningham slip-flow correction factor |
---|
4056 | REAL(wp), DIMENSION(nbins_aerosol) :: Kn !< Knudsen number |
---|
4057 | REAL(wp), DIMENSION(nbins_aerosol) :: zdwet !< wet diameter (m) |
---|
4058 | |
---|
4059 | REAL(wp), DIMENSION(:), INTENT(inout) :: schmidt_num !< particle Schmidt number |
---|
4060 | REAL(wp), DIMENSION(:), INTENT(inout) :: vc !< critical fall speed i.e. settling velocity of |
---|
4061 | !< an aerosol particle (m/s) |
---|
4062 | |
---|
4063 | TYPE(t_section), DIMENSION(nbins_aerosol), INTENT(inout) :: paero !< aerosol properties |
---|
4064 | ! |
---|
4065 | !-- Initialise |
---|
4066 | depo = 0.0_wp |
---|
4067 | pdn = 1500.0_wp ! default value |
---|
4068 | ustar = 0.0_wp |
---|
4069 | ! |
---|
4070 | !-- Molecular viscosity of air (Eq. 4.54) |
---|
4071 | avis = 1.8325E-5_wp * ( 416.16_wp / ( tk + 120.0_wp ) ) * ( tk / 296.16_wp )**1.5_wp |
---|
4072 | ! |
---|
4073 | !-- Kinematic viscosity (Eq. 4.55) |
---|
4074 | kvis = avis / adn |
---|
4075 | ! |
---|
4076 | !-- Thermal velocity of an air molecule (Eq. 15.32) |
---|
4077 | va = SQRT( 8.0_wp * abo * tk / ( pi * am_airmol ) ) |
---|
4078 | ! |
---|
4079 | !-- Mean free path (m) (Eq. 15.24) |
---|
4080 | lambda = 2.0_wp * avis / ( adn * va ) |
---|
4081 | ! |
---|
4082 | !-- Particle wet diameter (m) |
---|
4083 | zdwet = paero(:)%dwet |
---|
4084 | ! |
---|
4085 | !-- Knudsen number (Eq. 15.23) |
---|
4086 | Kn = MAX( 1.0E-2_wp, lambda / ( zdwet * 0.5_wp ) ) ! To avoid underflow |
---|
4087 | ! |
---|
4088 | !-- Cunningham slip-flow correction (Eq. 15.30) |
---|
4089 | beta = 1.0_wp + Kn * ( 1.249_wp + 0.42_wp * EXP( -0.87_wp / Kn ) ) |
---|
4090 | ! |
---|
4091 | !-- Critical fall speed i.e. settling velocity (Eq. 20.4) |
---|
4092 | vc = MIN( 1.0_wp, zdwet**2 * ( pdn - adn ) * g * beta / ( 18.0_wp * avis ) ) |
---|
4093 | ! |
---|
4094 | !-- Deposition on vegetation |
---|
4095 | IF ( lsdepo_pcm .AND. plant_canopy .AND. lad > 0.0_wp ) THEN |
---|
4096 | ! |
---|
4097 | !-- Parameters for the land use category 'deciduous broadleaf trees'(Table 3) |
---|
4098 | alpha = alpha_z01(depo_pcm_type_num) |
---|
4099 | gamma = gamma_z01(depo_pcm_type_num) |
---|
4100 | par_a = A_z01(depo_pcm_type_num, season_z01) * 1.0E-3_wp |
---|
4101 | ! |
---|
4102 | !-- Deposition efficiencies from Table 1. Constants from Table 2. |
---|
4103 | par_l = l_p10(depo_pcm_type_num) * 0.01_wp |
---|
4104 | c_brownian_diff = c_b_p10(depo_pcm_type_num) |
---|
4105 | c_interception = c_in_p10(depo_pcm_type_num) |
---|
4106 | c_impaction = c_im_p10(depo_pcm_type_num) |
---|
4107 | beta_im = beta_im_p10(depo_pcm_type_num) |
---|
4108 | c_turb_impaction = c_it_p10(depo_pcm_type_num) |
---|
4109 | |
---|
4110 | DO ib = 1, nbins_aerosol |
---|
4111 | |
---|
4112 | IF ( paero(ib)%numc < ( 2.0_wp * nclim ) ) CYCLE |
---|
4113 | |
---|
4114 | !-- Particle diffusivity coefficient (Eq. 15.29) |
---|
4115 | mdiff = ( abo * tk * beta(ib) ) / ( 3.0_wp * pi * avis * zdwet(ib) ) |
---|
4116 | ! |
---|
4117 | !-- Particle Schmidt number (Eq. 15.36) |
---|
4118 | schmidt_num(ib) = kvis / mdiff |
---|
4119 | ! |
---|
4120 | !-- Friction velocity for deposition on vegetation. Calculated following Prandtl (1925): |
---|
4121 | ustar = SQRT( canopy_drag_coeff ) * mag_u |
---|
4122 | SELECT CASE ( depo_pcm_par_num ) |
---|
4123 | |
---|
4124 | CASE ( 1 ) ! Zhang et al. (2001) |
---|
4125 | CALL depo_vel_Z01( vc(ib), ustar, schmidt_num(ib), paero(ib)%dwet, alpha, gamma, & |
---|
4126 | par_a, depo ) |
---|
4127 | CASE ( 2 ) ! Petroff & Zhang (2010) |
---|
4128 | CALL depo_vel_P10( vc(ib), mag_u, ustar, kvis, schmidt_num(ib), paero(ib)%dwet, & |
---|
4129 | par_l, c_brownian_diff, c_interception, c_impaction, beta_im, & |
---|
4130 | c_turb_impaction, depo ) |
---|
4131 | END SELECT |
---|
4132 | ! |
---|
4133 | !-- Calculate the change in concentrations |
---|
4134 | paero(ib)%numc = paero(ib)%numc - depo * lad * paero(ib)%numc * dt_salsa |
---|
4135 | DO ic = 1, maxspec+1 |
---|
4136 | paero(ib)%volc(ic) = paero(ib)%volc(ic) - depo * lad * paero(ib)%volc(ic) * dt_salsa |
---|
4137 | ENDDO |
---|
4138 | ENDDO |
---|
4139 | |
---|
4140 | ENDIF |
---|
4141 | |
---|
4142 | END SUBROUTINE deposition |
---|
4143 | |
---|
4144 | !------------------------------------------------------------------------------! |
---|
4145 | ! Description: |
---|
4146 | ! ------------ |
---|
4147 | !> Calculate deposition velocity (m/s) based on Zhan et al. (2001, case 1). |
---|
4148 | !------------------------------------------------------------------------------! |
---|
4149 | |
---|
4150 | SUBROUTINE depo_vel_Z01( vc, ustar, schmidt_num, diameter, alpha, gamma, par_a, depo ) |
---|
4151 | |
---|
4152 | IMPLICIT NONE |
---|
4153 | |
---|
4154 | REAL(wp) :: rs !< overall quasi-laminar resistance for particles |
---|
4155 | REAL(wp) :: stokes_num !< Stokes number for smooth or bluff surfaces |
---|
4156 | |
---|
4157 | REAL(wp), INTENT(in) :: alpha !< parameter, Table 3 in Z01 |
---|
4158 | REAL(wp), INTENT(in) :: gamma !< parameter, Table 3 in Z01 |
---|
4159 | REAL(wp), INTENT(in) :: par_a !< parameter A for the characteristic diameter of |
---|
4160 | !< collectors, Table 3 in Z01 |
---|
4161 | REAL(wp), INTENT(in) :: diameter !< particle diameter |
---|
4162 | REAL(wp), INTENT(in) :: schmidt_num !< particle Schmidt number |
---|
4163 | REAL(wp), INTENT(in) :: ustar !< friction velocity (m/s) |
---|
4164 | REAL(wp), INTENT(in) :: vc !< terminal velocity (m/s) |
---|
4165 | |
---|
4166 | REAL(wp), INTENT(inout) :: depo !< deposition efficiency (m/s) |
---|
4167 | |
---|
4168 | IF ( par_a > 0.0_wp ) THEN |
---|
4169 | ! |
---|
4170 | !-- Initialise |
---|
4171 | rs = 0.0_wp |
---|
4172 | ! |
---|
4173 | !-- Stokes number for vegetated surfaces (Seinfeld & Pandis (2006): Eq.19.24) |
---|
4174 | stokes_num = vc * ustar / ( g * par_a ) |
---|
4175 | ! |
---|
4176 | !-- The overall quasi-laminar resistance for particles (Zhang et al., Eq. 5) |
---|
4177 | rs = MAX( EPSILON( 1.0_wp ), ( 3.0_wp * ustar * EXP( -stokes_num**0.5_wp ) * & |
---|
4178 | ( schmidt_num**( -gamma ) + ( stokes_num / ( alpha + stokes_num ) )**2 + & |
---|
4179 | 0.5_wp * ( diameter / par_a )**2 ) ) ) |
---|
4180 | |
---|
4181 | depo = rs + vc |
---|
4182 | |
---|
4183 | ELSE |
---|
4184 | depo = 0.0_wp |
---|
4185 | ENDIF |
---|
4186 | |
---|
4187 | END SUBROUTINE depo_vel_Z01 |
---|
4188 | |
---|
4189 | !------------------------------------------------------------------------------! |
---|
4190 | ! Description: |
---|
4191 | ! ------------ |
---|
4192 | !> Calculate deposition velocity (m/s) based on Petroff & Zhang (2010, case 2). |
---|
4193 | !------------------------------------------------------------------------------! |
---|
4194 | |
---|
4195 | SUBROUTINE depo_vel_P10( vc, mag_u, ustar, kvis_a, schmidt_num, diameter, par_l, c_brownian_diff, & |
---|
4196 | c_interception, c_impaction, beta_im, c_turb_impaction, depo ) |
---|
4197 | |
---|
4198 | IMPLICIT NONE |
---|
4199 | |
---|
4200 | REAL(wp) :: stokes_num !< Stokes number for smooth or bluff surfaces |
---|
4201 | REAL(wp) :: tau_plus !< dimensionless particle relaxation time |
---|
4202 | REAL(wp) :: v_bd !< deposition velocity due to Brownian diffusion |
---|
4203 | REAL(wp) :: v_im !< deposition velocity due to impaction |
---|
4204 | REAL(wp) :: v_in !< deposition velocity due to interception |
---|
4205 | REAL(wp) :: v_it !< deposition velocity due to turbulent impaction |
---|
4206 | |
---|
4207 | REAL(wp), INTENT(in) :: beta_im !< parameter for turbulent impaction |
---|
4208 | REAL(wp), INTENT(in) :: c_brownian_diff !< coefficient for Brownian diffusion |
---|
4209 | REAL(wp), INTENT(in) :: c_impaction !< coefficient for inertial impaction |
---|
4210 | REAL(wp), INTENT(in) :: c_interception !< coefficient for interception |
---|
4211 | REAL(wp), INTENT(in) :: c_turb_impaction !< coefficient for turbulent impaction |
---|
4212 | REAL(wp), INTENT(in) :: kvis_a !< kinematic viscosity of air (m2/s) |
---|
4213 | REAL(wp), INTENT(in) :: mag_u !< wind velocity (m/s) |
---|
4214 | REAL(wp), INTENT(in) :: par_l !< obstacle characteristic dimension in P10 |
---|
4215 | REAL(wp), INTENT(in) :: diameter !< particle diameter |
---|
4216 | REAL(wp), INTENT(in) :: schmidt_num !< particle Schmidt number |
---|
4217 | REAL(wp), INTENT(in) :: ustar !< friction velocity (m/s) |
---|
4218 | REAL(wp), INTENT(in) :: vc !< terminal velocity (m/s) |
---|
4219 | |
---|
4220 | REAL(wp), INTENT(inout) :: depo !< deposition efficiency (m/s) |
---|
4221 | |
---|
4222 | IF ( par_l > 0.0_wp ) THEN |
---|
4223 | ! |
---|
4224 | !-- Initialise |
---|
4225 | tau_plus = 0.0_wp |
---|
4226 | v_bd = 0.0_wp |
---|
4227 | v_im = 0.0_wp |
---|
4228 | v_in = 0.0_wp |
---|
4229 | v_it = 0.0_wp |
---|
4230 | ! |
---|
4231 | !-- Stokes number for vegetated surfaces (Seinfeld & Pandis (2006): Eq.19.24) |
---|
4232 | stokes_num = vc * ustar / ( g * par_l ) |
---|
4233 | ! |
---|
4234 | !-- Non-dimensional relexation time of the particle on top of canopy |
---|
4235 | tau_plus = vc * ustar**2 / ( kvis_a * g ) |
---|
4236 | ! |
---|
4237 | !-- Brownian diffusion |
---|
4238 | v_bd = mag_u * c_brownian_diff * schmidt_num**( -0.66666666_wp ) * & |
---|
4239 | ( mag_u * par_l / kvis_a )**( -0.5_wp ) |
---|
4240 | ! |
---|
4241 | !-- Interception |
---|
4242 | v_in = mag_u * c_interception * diameter / par_l * & |
---|
4243 | ( 2.0_wp + LOG( 2.0_wp * par_l / diameter ) ) |
---|
4244 | ! |
---|
4245 | !-- Impaction: Petroff (2009) Eq. 18 |
---|
4246 | v_im = mag_u * c_impaction * ( stokes_num / ( stokes_num + beta_im ) )**2 |
---|
4247 | ! |
---|
4248 | !-- Turbulent impaction |
---|
4249 | IF ( tau_plus < 20.0_wp ) THEN |
---|
4250 | v_it = 2.5E-3_wp * c_turb_impaction * tau_plus**2 |
---|
4251 | ELSE |
---|
4252 | v_it = c_turb_impaction |
---|
4253 | ENDIF |
---|
4254 | |
---|
4255 | depo = ( v_bd + v_in + v_im + v_it + vc ) |
---|
4256 | |
---|
4257 | ELSE |
---|
4258 | depo = 0.0_wp |
---|
4259 | ENDIF |
---|
4260 | |
---|
4261 | END SUBROUTINE depo_vel_P10 |
---|
4262 | |
---|
4263 | !------------------------------------------------------------------------------! |
---|
4264 | ! Description: |
---|
4265 | ! ------------ |
---|
4266 | !> Calculate the dry deposition on horizontal and vertical surfaces. Implement |
---|
4267 | !> as a surface flux. |
---|
4268 | !> @todo aerodynamic resistance ignored for now (not important for |
---|
4269 | ! high-resolution simulations) |
---|
4270 | !------------------------------------------------------------------------------! |
---|
4271 | SUBROUTINE depo_surf( i, j, surf, vc, schmidt_num, kvis, mag_u, norm, match_array ) |
---|
4272 | |
---|
4273 | USE arrays_3d, & |
---|
4274 | ONLY: rho_air_zw |
---|
4275 | |
---|
4276 | USE surface_mod, & |
---|
4277 | ONLY: ind_pav_green, ind_veg_wall, ind_wat_win, surf_type |
---|
4278 | |
---|
4279 | IMPLICIT NONE |
---|
4280 | |
---|
4281 | INTEGER(iwp) :: ib !< loop index |
---|
4282 | INTEGER(iwp) :: ic !< loop index |
---|
4283 | INTEGER(iwp) :: icc !< additional loop index |
---|
4284 | INTEGER(iwp) :: k !< loop index |
---|
4285 | INTEGER(iwp) :: m !< loop index |
---|
4286 | INTEGER(iwp) :: surf_e !< End index of surface elements at (j,i)-gridpoint |
---|
4287 | INTEGER(iwp) :: surf_s !< Start index of surface elements at (j,i)-gridpoint |
---|
4288 | |
---|
4289 | INTEGER(iwp), INTENT(in) :: i !< loop index |
---|
4290 | INTEGER(iwp), INTENT(in) :: j !< loop index |
---|
4291 | |
---|
4292 | LOGICAL, INTENT(in) :: norm !< to normalise or not |
---|
4293 | |
---|
4294 | REAL(wp) :: alpha !< parameter, Table 3 in Z01 |
---|
4295 | REAL(wp) :: beta_im !< parameter for turbulent impaction |
---|
4296 | REAL(wp) :: c_brownian_diff !< coefficient for Brownian diffusion |
---|
4297 | REAL(wp) :: c_impaction !< coefficient for inertial impaction |
---|
4298 | REAL(wp) :: c_interception !< coefficient for interception |
---|
4299 | REAL(wp) :: c_turb_impaction !< coefficient for turbulent impaction |
---|
4300 | REAL(wp) :: gamma !< parameter, Table 3 in Z01 |
---|
4301 | REAL(wp) :: norm_fac !< normalisation factor (usually air density) |
---|
4302 | REAL(wp) :: par_a !< parameter A for the characteristic radius of collectors, |
---|
4303 | !< Table 3 in Z01 |
---|
4304 | REAL(wp) :: par_l !< obstacle characteristic dimension in P10 |
---|
4305 | REAL(wp) :: rs !< the overall quasi-laminar resistance for particles |
---|
4306 | REAL(wp) :: tau_plus !< dimensionless particle relaxation time |
---|
4307 | REAL(wp) :: v_bd !< deposition velocity due to Brownian diffusion |
---|
4308 | REAL(wp) :: v_im !< deposition velocity due to impaction |
---|
4309 | REAL(wp) :: v_in !< deposition velocity due to interception |
---|
4310 | REAL(wp) :: v_it !< deposition velocity due to turbulent impaction |
---|
4311 | |
---|
4312 | REAL(wp), DIMENSION(nbins_aerosol) :: depo !< deposition efficiency |
---|
4313 | REAL(wp), DIMENSION(nbins_aerosol) :: depo_sum !< sum of deposition efficiencies |
---|
4314 | |
---|
4315 | REAL(wp), DIMENSION(:), INTENT(in) :: kvis !< kinematic viscosity of air (m2/s) |
---|
4316 | REAL(wp), DIMENSION(:), INTENT(in) :: mag_u !< wind velocity (m/s) |
---|
4317 | |
---|
4318 | REAL(wp), DIMENSION(:,:), INTENT(in) :: schmidt_num !< particle Schmidt number |
---|
4319 | REAL(wp), DIMENSION(:,:), INTENT(in) :: vc !< terminal velocity (m/s) |
---|
4320 | |
---|
4321 | TYPE(match_surface), INTENT(in), OPTIONAL :: match_array !< match the deposition module and |
---|
4322 | !< LSM/USM surfaces |
---|
4323 | TYPE(surf_type), INTENT(inout) :: surf !< respective surface type |
---|
4324 | ! |
---|
4325 | !-- Initialise |
---|
4326 | depo = 0.0_wp |
---|
4327 | depo_sum = 0.0_wp |
---|
4328 | rs = 0.0_wp |
---|
4329 | surf_s = surf%start_index(j,i) |
---|
4330 | surf_e = surf%end_index(j,i) |
---|
4331 | tau_plus = 0.0_wp |
---|
4332 | v_bd = 0.0_wp |
---|
4333 | v_im = 0.0_wp |
---|
4334 | v_in = 0.0_wp |
---|
4335 | v_it = 0.0_wp |
---|
4336 | ! |
---|
4337 | !-- Model parameters for the land use category. If LSM or USM is applied, import |
---|
4338 | !-- characteristics. Otherwise, apply surface type "urban". |
---|
4339 | alpha = alpha_z01(luc_urban) |
---|
4340 | gamma = gamma_z01(luc_urban) |
---|
4341 | par_a = A_z01(luc_urban, season_z01) * 1.0E-3_wp |
---|
4342 | |
---|
4343 | par_l = l_p10(luc_urban) * 0.01_wp |
---|
4344 | c_brownian_diff = c_b_p10(luc_urban) |
---|
4345 | c_interception = c_in_p10(luc_urban) |
---|
4346 | c_impaction = c_im_p10(luc_urban) |
---|
4347 | beta_im = beta_im_p10(luc_urban) |
---|
4348 | c_turb_impaction = c_it_p10(luc_urban) |
---|
4349 | |
---|
4350 | |
---|
4351 | IF ( PRESENT( match_array ) ) THEN ! land or urban surface model |
---|
4352 | |
---|
4353 | DO m = surf_s, surf_e |
---|
4354 | |
---|
4355 | k = surf%k(m) |
---|
4356 | norm_fac = 1.0_wp |
---|
4357 | |
---|
4358 | IF ( norm ) norm_fac = rho_air_zw(k) ! normalise vertical fluxes by air density |
---|
4359 | |
---|
4360 | IF ( match_array%match_lupg(m) > 0 ) THEN |
---|
4361 | alpha = alpha_z01( match_array%match_lupg(m) ) |
---|
4362 | gamma = gamma_z01( match_array%match_lupg(m) ) |
---|
4363 | par_a = A_z01( match_array%match_lupg(m), season_z01 ) * 1.0E-3_wp |
---|
4364 | |
---|
4365 | beta_im = beta_im_p10( match_array%match_lupg(m) ) |
---|
4366 | c_brownian_diff = c_b_p10( match_array%match_lupg(m) ) |
---|
4367 | c_impaction = c_im_p10( match_array%match_lupg(m) ) |
---|
4368 | c_interception = c_in_p10( match_array%match_lupg(m) ) |
---|
4369 | c_turb_impaction = c_it_p10( match_array%match_lupg(m) ) |
---|
4370 | par_l = l_p10( match_array%match_lupg(m) ) * 0.01_wp |
---|
4371 | |
---|
4372 | DO ib = 1, nbins_aerosol |
---|
4373 | IF ( aerosol_number(ib)%conc(k,j,i) < ( 2.0_wp * nclim ) .OR. & |
---|
4374 | schmidt_num(k+1,ib) < 1.0_wp ) CYCLE |
---|
4375 | |
---|
4376 | SELECT CASE ( depo_surf_par_num ) |
---|
4377 | |
---|
4378 | CASE ( 1 ) |
---|
4379 | CALL depo_vel_Z01( vc(k+1,ib), surf%us(m), schmidt_num(k+1,ib), & |
---|
4380 | ra_dry(k,j,i,ib), alpha, gamma, par_a, depo(ib) ) |
---|
4381 | CASE ( 2 ) |
---|
4382 | CALL depo_vel_P10( vc(k+1,ib), mag_u(k+1), surf%us(m), kvis(k+1), & |
---|
4383 | schmidt_num(k+1,ib), ra_dry(k,j,i,ib), par_l, & |
---|
4384 | c_brownian_diff, c_interception, c_impaction, beta_im, & |
---|
4385 | c_turb_impaction, depo(ib) ) |
---|
4386 | END SELECT |
---|
4387 | ENDDO |
---|
4388 | depo_sum = depo_sum + surf%frac(ind_pav_green,m) * depo |
---|
4389 | ENDIF |
---|
4390 | |
---|
4391 | IF ( match_array%match_luvw(m) > 0 ) THEN |
---|
4392 | alpha = alpha_z01( match_array%match_luvw(m) ) |
---|
4393 | gamma = gamma_z01( match_array%match_luvw(m) ) |
---|
4394 | par_a = A_z01( match_array%match_luvw(m), season_z01 ) * 1.0E-3_wp |
---|
4395 | |
---|
4396 | beta_im = beta_im_p10( match_array%match_luvw(m) ) |
---|
4397 | c_brownian_diff = c_b_p10( match_array%match_luvw(m) ) |
---|
4398 | c_impaction = c_im_p10( match_array%match_luvw(m) ) |
---|
4399 | c_interception = c_in_p10( match_array%match_luvw(m) ) |
---|
4400 | c_turb_impaction = c_it_p10( match_array%match_luvw(m) ) |
---|
4401 | par_l = l_p10( match_array%match_luvw(m) ) * 0.01_wp |
---|
4402 | |
---|
4403 | DO ib = 1, nbins_aerosol |
---|
4404 | IF ( aerosol_number(ib)%conc(k,j,i) < ( 2.0_wp * nclim ) .OR. & |
---|
4405 | schmidt_num(k+1,ib) < 1.0_wp ) CYCLE |
---|
4406 | |
---|
4407 | SELECT CASE ( depo_surf_par_num ) |
---|
4408 | |
---|
4409 | CASE ( 1 ) |
---|
4410 | CALL depo_vel_Z01( vc(k+1,ib), surf%us(m), schmidt_num(k+1,ib), & |
---|
4411 | ra_dry(k,j,i,ib), alpha, gamma, par_a, depo(ib) ) |
---|
4412 | CASE ( 2 ) |
---|
4413 | CALL depo_vel_P10( vc(k+1,ib), mag_u(k+1), surf%us(m), kvis(k+1), & |
---|
4414 | schmidt_num(k+1,ib), ra_dry(k,j,i,ib), par_l, & |
---|
4415 | c_brownian_diff, c_interception, c_impaction, beta_im, & |
---|
4416 | c_turb_impaction, depo(ib) ) |
---|
4417 | END SELECT |
---|
4418 | ENDDO |
---|
4419 | depo_sum = depo_sum + surf%frac(ind_veg_wall,m) * depo |
---|
4420 | ENDIF |
---|
4421 | |
---|
4422 | IF ( match_array%match_luww(m) > 0 ) THEN |
---|
4423 | alpha = alpha_z01( match_array%match_luww(m) ) |
---|
4424 | gamma = gamma_z01( match_array%match_luww(m) ) |
---|
4425 | par_a = A_z01( match_array%match_luww(m), season_z01 ) * 1.0E-3_wp |
---|
4426 | |
---|
4427 | beta_im = beta_im_p10( match_array%match_luww(m) ) |
---|
4428 | c_brownian_diff = c_b_p10( match_array%match_luww(m) ) |
---|
4429 | c_impaction = c_im_p10( match_array%match_luww(m) ) |
---|
4430 | c_interception = c_in_p10( match_array%match_luww(m) ) |
---|
4431 | c_turb_impaction = c_it_p10( match_array%match_luww(m) ) |
---|
4432 | par_l = l_p10( match_array%match_luww(m) ) * 0.01_wp |
---|
4433 | |
---|
4434 | DO ib = 1, nbins_aerosol |
---|
4435 | IF ( aerosol_number(ib)%conc(k,j,i) < ( 2.0_wp * nclim ) .OR. & |
---|
4436 | schmidt_num(k+1,ib) < 1.0_wp ) CYCLE |
---|
4437 | |
---|
4438 | SELECT CASE ( depo_surf_par_num ) |
---|
4439 | |
---|
4440 | CASE ( 1 ) |
---|
4441 | CALL depo_vel_Z01( vc(k+1,ib), surf%us(m), schmidt_num(k+1,ib), & |
---|
4442 | ra_dry(k,j,i,ib), alpha, gamma, par_a, depo(ib) ) |
---|
4443 | CASE ( 2 ) |
---|
4444 | CALL depo_vel_P10( vc(k+1,ib), mag_u(k+1), surf%us(m), kvis(k+1), & |
---|
4445 | schmidt_num(k+1,ib), ra_dry(k,j,i,ib), par_l, & |
---|
4446 | c_brownian_diff, c_interception, c_impaction, beta_im, & |
---|
4447 | c_turb_impaction, depo(ib) ) |
---|
4448 | END SELECT |
---|
4449 | ENDDO |
---|
4450 | depo_sum = depo_sum + surf%frac(ind_wat_win,m) * depo |
---|
4451 | ENDIF |
---|
4452 | |
---|
4453 | DO ib = 1, nbins_aerosol |
---|
4454 | IF ( aerosol_number(ib)%conc(k,j,i) < ( 2.0_wp * nclim ) ) CYCLE |
---|
4455 | ! |
---|
4456 | !-- Calculate changes in surface fluxes due to dry deposition |
---|
4457 | IF ( include_emission ) THEN |
---|
4458 | surf%answs(m,ib) = aerosol_number(ib)%source(j,i) - MAX( 0.0_wp, & |
---|
4459 | depo_sum(ib) * norm_fac * aerosol_number(ib)%conc(k,j,i) ) |
---|
4460 | DO ic = 1, ncomponents_mass |
---|
4461 | icc = ( ic - 1 ) * nbins_aerosol + ib |
---|
4462 | surf%amsws(m,icc) = aerosol_mass(icc)%source(j,i) - MAX( 0.0_wp, & |
---|
4463 | depo_sum(ib) * norm_fac * aerosol_mass(icc)%conc(k,j,i) ) |
---|
4464 | ENDDO ! ic |
---|
4465 | ELSE |
---|
4466 | surf%answs(m,ib) = -depo_sum(ib) * norm_fac * aerosol_number(ib)%conc(k,j,i) |
---|
4467 | DO ic = 1, ncomponents_mass |
---|
4468 | icc = ( ic - 1 ) * nbins_aerosol + ib |
---|
4469 | surf%amsws(m,icc) = -depo_sum(ib) * norm_fac * aerosol_mass(icc)%conc(k,j,i) |
---|
4470 | ENDDO ! ic |
---|
4471 | ENDIF |
---|
4472 | ENDDO ! ib |
---|
4473 | |
---|
4474 | ENDDO |
---|
4475 | |
---|
4476 | ELSE ! default surfaces |
---|
4477 | |
---|
4478 | DO m = surf_s, surf_e |
---|
4479 | |
---|
4480 | k = surf%k(m) |
---|
4481 | norm_fac = 1.0_wp |
---|
4482 | |
---|
4483 | IF ( norm ) norm_fac = rho_air_zw(k) ! normalise vertical fluxes by air density |
---|
4484 | |
---|
4485 | DO ib = 1, nbins_aerosol |
---|
4486 | IF ( aerosol_number(ib)%conc(k,j,i) < ( 2.0_wp * nclim ) .OR. & |
---|
4487 | schmidt_num(k+1,ib) < 1.0_wp ) CYCLE |
---|
4488 | |
---|
4489 | SELECT CASE ( depo_surf_par_num ) |
---|
4490 | |
---|
4491 | CASE ( 1 ) |
---|
4492 | CALL depo_vel_Z01( vc(k+1,ib), surf%us(m), schmidt_num(k+1,ib), & |
---|
4493 | ra_dry(k,j,i,ib), alpha, gamma, par_a, depo(ib) ) |
---|
4494 | CASE ( 2 ) |
---|
4495 | CALL depo_vel_P10( vc(k+1,ib), mag_u(k+1), surf%us(m), kvis(k+1), & |
---|
4496 | schmidt_num(k+1,ib), ra_dry(k,j,i,ib), par_l, & |
---|
4497 | c_brownian_diff, c_interception, c_impaction, beta_im, & |
---|
4498 | c_turb_impaction, depo(ib) ) |
---|
4499 | END SELECT |
---|
4500 | ! |
---|
4501 | !-- Calculate changes in surface fluxes due to dry deposition |
---|
4502 | IF ( include_emission ) THEN |
---|
4503 | surf%answs(m,ib) = aerosol_number(ib)%source(j,i) - MAX( 0.0_wp, & |
---|
4504 | depo(ib) * norm_fac * aerosol_number(ib)%conc(k,j,i) ) |
---|
4505 | DO ic = 1, ncomponents_mass |
---|
4506 | icc = ( ic - 1 ) * nbins_aerosol + ib |
---|
4507 | surf%amsws(m,icc) = aerosol_mass(icc)%source(j,i) - MAX( 0.0_wp, & |
---|
4508 | depo(ib) * norm_fac * aerosol_mass(icc)%conc(k,j,i) ) |
---|
4509 | ENDDO ! ic |
---|
4510 | ELSE |
---|
4511 | surf%answs(m,ib) = -depo(ib) * norm_fac * aerosol_number(ib)%conc(k,j,i) |
---|
4512 | DO ic = 1, ncomponents_mass |
---|
4513 | icc = ( ic - 1 ) * nbins_aerosol + ib |
---|
4514 | surf%amsws(m,icc) = -depo(ib) * norm_fac * aerosol_mass(icc)%conc(k,j,i) |
---|
4515 | ENDDO ! ic |
---|
4516 | ENDIF |
---|
4517 | ENDDO ! ib |
---|
4518 | ENDDO |
---|
4519 | |
---|
4520 | ENDIF |
---|
4521 | |
---|
4522 | END SUBROUTINE depo_surf |
---|
4523 | |
---|
4524 | !------------------------------------------------------------------------------! |
---|
4525 | ! Description: |
---|
4526 | ! ------------ |
---|
4527 | !> Calculates particle loss and change in size distribution due to (Brownian) |
---|
4528 | !> coagulation. Only for particles with dwet < 30 micrometres. |
---|
4529 | ! |
---|
4530 | !> Method: |
---|
4531 | !> Semi-implicit, non-iterative method: (Jacobson, 1994) |
---|
4532 | !> Volume concentrations of the smaller colliding particles added to the bin of |
---|
4533 | !> the larger colliding particles. Start from first bin and use the updated |
---|
4534 | !> number and volume for calculation of following bins. NB! Our bin numbering |
---|
4535 | !> does not follow particle size in subrange 2. |
---|
4536 | ! |
---|
4537 | !> Schematic for bin numbers in different subranges: |
---|
4538 | !> 1 2 |
---|
4539 | !> +-------------------------------------------+ |
---|
4540 | !> a | 1 | 2 | 3 || 4 | 5 | 6 | 7 | 8 | 9 | 10|| |
---|
4541 | !> b | ||11 |12 |13 |14 | 15 | 16 | 17|| |
---|
4542 | !> +-------------------------------------------+ |
---|
4543 | ! |
---|
4544 | !> Exact coagulation coefficients for each pressure level are scaled according |
---|
4545 | !> to current particle wet size (linear scaling). |
---|
4546 | !> Bins are organized in terms of the dry size of the condensation nucleus, |
---|
4547 | !> while coagulation kernell is calculated with the actual hydrometeor |
---|
4548 | !> size. |
---|
4549 | ! |
---|
4550 | !> Called from salsa_driver |
---|
4551 | !> fxm: Process selection should be made smarter - now just lots of IFs inside |
---|
4552 | !> loops |
---|
4553 | ! |
---|
4554 | !> Coded by: |
---|
4555 | !> Hannele Korhonen (FMI) 2005 |
---|
4556 | !> Harri Kokkola (FMI) 2006 |
---|
4557 | !> Tommi Bergman (FMI) 2012 |
---|
4558 | !> Matti Niskanen(FMI) 2012 |
---|
4559 | !> Anton Laakso (FMI) 2013 |
---|
4560 | !> Juha Tonttila (FMI) 2014 |
---|
4561 | !------------------------------------------------------------------------------! |
---|
4562 | SUBROUTINE coagulation( paero, ptstep, ptemp, ppres ) |
---|
4563 | |
---|
4564 | IMPLICIT NONE |
---|
4565 | |
---|
4566 | INTEGER(iwp) :: index_2a !< corresponding bin in subrange 2a |
---|
4567 | INTEGER(iwp) :: index_2b !< corresponding bin in subrange 2b |
---|
4568 | INTEGER(iwp) :: ib !< loop index |
---|
4569 | INTEGER(iwp) :: ll !< loop index |
---|
4570 | INTEGER(iwp) :: mm !< loop index |
---|
4571 | INTEGER(iwp) :: nn !< loop index |
---|
4572 | |
---|
4573 | REAL(wp) :: pressi !< pressure |
---|
4574 | REAL(wp) :: temppi !< temperature |
---|
4575 | REAL(wp) :: zdpart_mm !< diameter of particle (m) |
---|
4576 | REAL(wp) :: zdpart_nn !< diameter of particle (m) |
---|
4577 | REAL(wp) :: zminusterm !< coagulation loss in a bin (1/s) |
---|
4578 | |
---|
4579 | REAL(wp), INTENT(in) :: ppres !< ambient pressure (Pa) |
---|
4580 | REAL(wp), INTENT(in) :: ptemp !< ambient temperature (K) |
---|
4581 | REAL(wp), INTENT(in) :: ptstep !< time step (s) |
---|
4582 | |
---|
4583 | REAL(wp), DIMENSION(nbins_aerosol) :: zmpart !< approximate mass of particles (kg) |
---|
4584 | REAL(wp), DIMENSION(maxspec+1) :: zplusterm !< coagulation gain in a bin (for each |
---|
4585 | !< chemical compound) |
---|
4586 | REAL(wp), DIMENSION(nbins_aerosol,nbins_aerosol) :: zcc !< updated coagulation coeff. (m3/s) |
---|
4587 | |
---|
4588 | TYPE(t_section), DIMENSION(nbins_aerosol), INTENT(inout) :: paero !< Aerosol properties |
---|
4589 | |
---|
4590 | zdpart_mm = 0.0_wp |
---|
4591 | zdpart_nn = 0.0_wp |
---|
4592 | ! |
---|
4593 | !-- 1) Coagulation to coarse mode calculated in a simplified way: |
---|
4594 | !-- CoagSink ~ Dp in continuum subrange --> 'effective' number conc. of coarse particles |
---|
4595 | |
---|
4596 | !-- 2) Updating coagulation coefficients |
---|
4597 | ! |
---|
4598 | !-- Aerosol mass (kg). Density of 1500 kg/m3 assumed |
---|
4599 | zmpart(1:end_subrange_2b) = api6 * ( MIN( paero(1:end_subrange_2b)%dwet, 30.0E-6_wp )**3 ) & |
---|
4600 | * 1500.0_wp |
---|
4601 | temppi = ptemp |
---|
4602 | pressi = ppres |
---|
4603 | zcc = 0.0_wp |
---|
4604 | ! |
---|
4605 | !-- Aero-aero coagulation |
---|
4606 | DO mm = 1, end_subrange_2b ! smaller colliding particle |
---|
4607 | IF ( paero(mm)%numc < ( 2.0_wp * nclim ) ) CYCLE |
---|
4608 | DO nn = mm, end_subrange_2b ! larger colliding particle |
---|
4609 | IF ( paero(nn)%numc < ( 2.0_wp * nclim ) ) CYCLE |
---|
4610 | |
---|
4611 | zdpart_mm = MIN( paero(mm)%dwet, 30.0E-6_wp ) ! Limit to 30 um |
---|
4612 | zdpart_nn = MIN( paero(nn)%dwet, 30.0E-6_wp ) ! Limit to 30 um |
---|
4613 | ! |
---|
4614 | !-- Coagulation coefficient of particles (m3/s) |
---|
4615 | zcc(mm,nn) = coagc( zdpart_mm, zdpart_nn, zmpart(mm), zmpart(nn), temppi, pressi ) |
---|
4616 | zcc(nn,mm) = zcc(mm,nn) |
---|
4617 | ENDDO |
---|
4618 | ENDDO |
---|
4619 | |
---|
4620 | ! |
---|
4621 | !-- 3) New particle and volume concentrations after coagulation: |
---|
4622 | !-- Calculated according to Jacobson (2005) eq. 15.9 |
---|
4623 | ! |
---|
4624 | !-- Aerosols in subrange 1a: |
---|
4625 | DO ib = start_subrange_1a, end_subrange_1a |
---|
4626 | IF ( paero(ib)%numc < ( 2.0_wp * nclim ) ) CYCLE |
---|
4627 | zminusterm = 0.0_wp |
---|
4628 | zplusterm(:) = 0.0_wp |
---|
4629 | ! |
---|
4630 | !-- Particles lost by coagulation with larger aerosols |
---|
4631 | DO ll = ib+1, end_subrange_2b |
---|
4632 | zminusterm = zminusterm + zcc(ib,ll) * paero(ll)%numc |
---|
4633 | ENDDO |
---|
4634 | ! |
---|
4635 | !-- Coagulation gain in a bin: change in volume conc. (cm3/cm3): |
---|
4636 | DO ll = start_subrange_1a, ib - 1 |
---|
4637 | zplusterm(1:2) = zplusterm(1:2) + zcc(ll,ib) * paero(ll)%volc(1:2) |
---|
4638 | zplusterm(6:7) = zplusterm(6:7) + zcc(ll,ib) * paero(ll)%volc(6:7) |
---|
4639 | zplusterm(8) = zplusterm(8) + zcc(ll,ib) * paero(ll)%volc(8) |
---|
4640 | ENDDO |
---|
4641 | ! |
---|
4642 | !-- Volume and number concentrations after coagulation update [fxm] |
---|
4643 | paero(ib)%volc(1:2) = ( paero(ib)%volc(1:2) + ptstep * zplusterm(1:2) * paero(ib)%numc ) / & |
---|
4644 | ( 1.0_wp + ptstep * zminusterm ) |
---|
4645 | paero(ib)%volc(6:8) = ( paero(ib)%volc(6:8) + ptstep * zplusterm(6:8) * paero(ib)%numc ) / & |
---|
4646 | ( 1.0_wp + ptstep * zminusterm ) |
---|
4647 | paero(ib)%numc = paero(ib)%numc / ( 1.0_wp + ptstep * zminusterm + 0.5_wp * ptstep * & |
---|
4648 | zcc(ib,ib) * paero(ib)%numc ) |
---|
4649 | ENDDO |
---|
4650 | ! |
---|
4651 | !-- Aerosols in subrange 2a: |
---|
4652 | DO ib = start_subrange_2a, end_subrange_2a |
---|
4653 | IF ( paero(ib)%numc < ( 2.0_wp * nclim ) ) CYCLE |
---|
4654 | zminusterm = 0.0_wp |
---|
4655 | zplusterm(:) = 0.0_wp |
---|
4656 | ! |
---|
4657 | !-- Find corresponding size bin in subrange 2b |
---|
4658 | index_2b = ib - start_subrange_2a + start_subrange_2b |
---|
4659 | ! |
---|
4660 | !-- Particles lost by larger particles in 2a |
---|
4661 | DO ll = ib+1, end_subrange_2a |
---|
4662 | zminusterm = zminusterm + zcc(ib,ll) * paero(ll)%numc |
---|
4663 | ENDDO |
---|
4664 | ! |
---|
4665 | !-- Particles lost by larger particles in 2b |
---|
4666 | IF ( .NOT. no_insoluble ) THEN |
---|
4667 | DO ll = index_2b+1, end_subrange_2b |
---|
4668 | zminusterm = zminusterm + zcc(ib,ll) * paero(ll)%numc |
---|
4669 | ENDDO |
---|
4670 | ENDIF |
---|
4671 | ! |
---|
4672 | !-- Particle volume gained from smaller particles in subranges 1, 2a and 2b |
---|
4673 | DO ll = start_subrange_1a, ib-1 |
---|
4674 | zplusterm(1:2) = zplusterm(1:2) + zcc(ll,ib) * paero(ll)%volc(1:2) |
---|
4675 | zplusterm(6:8) = zplusterm(6:8) + zcc(ll,ib) * paero(ll)%volc(6:8) |
---|
4676 | ENDDO |
---|
4677 | ! |
---|
4678 | !-- Particle volume gained from smaller particles in 2a |
---|
4679 | !-- (Note, for components not included in the previous loop!) |
---|
4680 | DO ll = start_subrange_2a, ib-1 |
---|
4681 | zplusterm(3:5) = zplusterm(3:5) + zcc(ll,ib)*paero(ll)%volc(3:5) |
---|
4682 | ENDDO |
---|
4683 | ! |
---|
4684 | !-- Particle volume gained from smaller (and equal) particles in 2b |
---|
4685 | IF ( .NOT. no_insoluble ) THEN |
---|
4686 | DO ll = start_subrange_2b, index_2b |
---|
4687 | zplusterm(1:8) = zplusterm(1:8) + zcc(ll,ib) * paero(ll)%volc(1:8) |
---|
4688 | ENDDO |
---|
4689 | ENDIF |
---|
4690 | ! |
---|
4691 | !-- Volume and number concentrations after coagulation update [fxm] |
---|
4692 | paero(ib)%volc(1:8) = ( paero(ib)%volc(1:8) + ptstep * zplusterm(1:8) * paero(ib)%numc ) / & |
---|
4693 | ( 1.0_wp + ptstep * zminusterm ) |
---|
4694 | paero(ib)%numc = paero(ib)%numc / ( 1.0_wp + ptstep * zminusterm + 0.5_wp * ptstep * & |
---|
4695 | zcc(ib,ib) * paero(ib)%numc ) |
---|
4696 | ENDDO |
---|
4697 | ! |
---|
4698 | !-- Aerosols in subrange 2b: |
---|
4699 | IF ( .NOT. no_insoluble ) THEN |
---|
4700 | DO ib = start_subrange_2b, end_subrange_2b |
---|
4701 | IF ( paero(ib)%numc < ( 2.0_wp * nclim ) ) CYCLE |
---|
4702 | zminusterm = 0.0_wp |
---|
4703 | zplusterm(:) = 0.0_wp |
---|
4704 | ! |
---|
4705 | !-- Find corresponding size bin in subsubrange 2a |
---|
4706 | index_2a = ib - start_subrange_2b + start_subrange_2a |
---|
4707 | ! |
---|
4708 | !-- Particles lost to larger particles in subranges 2b |
---|
4709 | DO ll = ib + 1, end_subrange_2b |
---|
4710 | zminusterm = zminusterm + zcc(ib,ll) * paero(ll)%numc |
---|
4711 | ENDDO |
---|
4712 | ! |
---|
4713 | !-- Particles lost to larger and equal particles in 2a |
---|
4714 | DO ll = index_2a, end_subrange_2a |
---|
4715 | zminusterm = zminusterm + zcc(ib,ll) * paero(ll)%numc |
---|
4716 | ENDDO |
---|
4717 | ! |
---|
4718 | !-- Particle volume gained from smaller particles in subranges 1 & 2a |
---|
4719 | DO ll = start_subrange_1a, index_2a - 1 |
---|
4720 | zplusterm(1:8) = zplusterm(1:8) + zcc(ll,ib) * paero(ll)%volc(1:8) |
---|
4721 | ENDDO |
---|
4722 | ! |
---|
4723 | !-- Particle volume gained from smaller particles in 2b |
---|
4724 | DO ll = start_subrange_2b, ib - 1 |
---|
4725 | zplusterm(1:8) = zplusterm(1:8) + zcc(ll,ib) * paero(ll)%volc(1:8) |
---|
4726 | ENDDO |
---|
4727 | ! |
---|
4728 | !-- Volume and number concentrations after coagulation update [fxm] |
---|
4729 | paero(ib)%volc(1:8) = ( paero(ib)%volc(1:8) + ptstep * zplusterm(1:8) * paero(ib)%numc ) & |
---|
4730 | / ( 1.0_wp + ptstep * zminusterm ) |
---|
4731 | paero(ib)%numc = paero(ib)%numc / ( 1.0_wp + ptstep * zminusterm + 0.5_wp * ptstep * & |
---|
4732 | zcc(ib,ib) * paero(ib)%numc ) |
---|
4733 | ENDDO |
---|
4734 | ENDIF |
---|
4735 | |
---|
4736 | END SUBROUTINE coagulation |
---|
4737 | |
---|
4738 | !------------------------------------------------------------------------------! |
---|
4739 | ! Description: |
---|
4740 | ! ------------ |
---|
4741 | !> Calculation of coagulation coefficients. Extended version of the function |
---|
4742 | !> originally found in mo_salsa_init. |
---|
4743 | ! |
---|
4744 | !> J. Tonttila, FMI, 05/2014 |
---|
4745 | !------------------------------------------------------------------------------! |
---|
4746 | REAL(wp) FUNCTION coagc( diam1, diam2, mass1, mass2, temp, pres ) |
---|
4747 | |
---|
4748 | IMPLICIT NONE |
---|
4749 | |
---|
4750 | REAL(wp) :: fmdist !< distance of flux matching (m) |
---|
4751 | REAL(wp) :: knud_p !< particle Knudsen number |
---|
4752 | REAL(wp) :: mdiam !< mean diameter of colliding particles (m) |
---|
4753 | REAL(wp) :: mfp !< mean free path of air molecules (m) |
---|
4754 | REAL(wp) :: visc !< viscosity of air (kg/(m s)) |
---|
4755 | |
---|
4756 | REAL(wp), INTENT(in) :: diam1 !< diameter of colliding particle 1 (m) |
---|
4757 | REAL(wp), INTENT(in) :: diam2 !< diameter of colliding particle 2 (m) |
---|
4758 | REAL(wp), INTENT(in) :: mass1 !< mass of colliding particle 1 (kg) |
---|
4759 | REAL(wp), INTENT(in) :: mass2 !< mass of colliding particle 2 (kg) |
---|
4760 | REAL(wp), INTENT(in) :: pres !< ambient pressure (Pa?) [fxm] |
---|
4761 | REAL(wp), INTENT(in) :: temp !< ambient temperature (K) |
---|
4762 | |
---|
4763 | REAL(wp), DIMENSION (2) :: beta !< Cunningham correction factor |
---|
4764 | REAL(wp), DIMENSION (2) :: dfpart !< particle diffusion coefficient (m2/s) |
---|
4765 | REAL(wp), DIMENSION (2) :: diam !< diameters of particles (m) |
---|
4766 | REAL(wp), DIMENSION (2) :: flux !< flux in continuum and free molec. regime (m/s) |
---|
4767 | REAL(wp), DIMENSION (2) :: knud !< particle Knudsen number |
---|
4768 | REAL(wp), DIMENSION (2) :: mpart !< masses of particles (kg) |
---|
4769 | REAL(wp), DIMENSION (2) :: mtvel !< particle mean thermal velocity (m/s) |
---|
4770 | REAL(wp), DIMENSION (2) :: omega !< particle mean free path |
---|
4771 | REAL(wp), DIMENSION (2) :: tva !< temporary variable (m) |
---|
4772 | ! |
---|
4773 | !-- Initialisation |
---|
4774 | coagc = 0.0_wp |
---|
4775 | ! |
---|
4776 | !-- 1) Initializing particle and ambient air variables |
---|
4777 | diam = (/ diam1, diam2 /) !< particle diameters (m) |
---|
4778 | mpart = (/ mass1, mass2 /) !< particle masses (kg) |
---|
4779 | ! |
---|
4780 | !-- Viscosity of air (kg/(m s)) |
---|
4781 | visc = ( 7.44523E-3_wp * temp ** 1.5_wp ) / ( 5093.0_wp * ( temp + 110.4_wp ) ) |
---|
4782 | ! |
---|
4783 | !-- Mean free path of air (m) |
---|
4784 | mfp = ( 1.656E-10_wp * temp + 1.828E-8_wp ) * ( p_0 + 1325.0_wp ) / pres |
---|
4785 | ! |
---|
4786 | !-- 2) Slip correction factor for small particles |
---|
4787 | knud = 2.0_wp * EXP( LOG(mfp) - LOG(diam) )! Knudsen number for air (15.23) |
---|
4788 | ! |
---|
4789 | !-- Cunningham correction factor (Allen and Raabe, Aerosol Sci. Tech. 4, 269) |
---|
4790 | beta = 1.0_wp + knud * ( 1.142_wp + 0.558_wp * EXP( -0.999_wp / knud ) ) |
---|
4791 | ! |
---|
4792 | !-- 3) Particle properties |
---|
4793 | !-- Diffusion coefficient (m2/s) (Jacobson (2005) eq. 15.29) |
---|
4794 | dfpart = beta * abo * temp / ( 3.0_wp * pi * visc * diam ) |
---|
4795 | ! |
---|
4796 | !-- Mean thermal velocity (m/s) (Jacobson (2005) eq. 15.32) |
---|
4797 | mtvel = SQRT( ( 8.0_wp * abo * temp ) / ( pi * mpart ) ) |
---|
4798 | ! |
---|
4799 | !-- Particle mean free path (m) (Jacobson (2005) eq. 15.34 ) |
---|
4800 | omega = 8.0_wp * dfpart / ( pi * mtvel ) |
---|
4801 | ! |
---|
4802 | !-- Mean diameter (m) |
---|
4803 | mdiam = 0.5_wp * ( diam(1) + diam(2) ) |
---|
4804 | ! |
---|
4805 | !-- 4) Calculation of fluxes (Brownian collision kernels) and flux matching |
---|
4806 | !-- following Jacobson (2005): |
---|
4807 | ! |
---|
4808 | !-- Flux in continuum regime (m3/s) (eq. 15.28) |
---|
4809 | flux(1) = 4.0_wp * pi * mdiam * ( dfpart(1) + dfpart(2) ) |
---|
4810 | ! |
---|
4811 | !-- Flux in free molec. regime (m3/s) (eq. 15.31) |
---|
4812 | flux(2) = pi * SQRT( ( mtvel(1)**2 ) + ( mtvel(2)**2 ) ) * ( mdiam**2 ) |
---|
4813 | ! |
---|
4814 | !-- temporary variables (m) to calculate flux matching distance (m) |
---|
4815 | tva(1) = ( ( mdiam + omega(1) )**3 - ( mdiam**2 + omega(1)**2 ) * SQRT( ( mdiam**2 + & |
---|
4816 | omega(1)**2 ) ) ) / ( 3.0_wp * mdiam * omega(1) ) - mdiam |
---|
4817 | tva(2) = ( ( mdiam + omega(2) )**3 - ( mdiam**2 + omega(2)**2 ) * SQRT( ( mdiam**2 + & |
---|
4818 | omega(2)**2 ) ) ) / ( 3.0_wp * mdiam * omega(2) ) - mdiam |
---|
4819 | ! |
---|
4820 | !-- Flux matching distance (m): the mean distance from the centre of a sphere reached by particles |
---|
4821 | !-- that leave sphere's surface and travel a distance of particle mean free path (eq. 15.34) |
---|
4822 | fmdist = SQRT( tva(1)**2 + tva(2)**2 ) |
---|
4823 | ! |
---|
4824 | !-- 5) Coagulation coefficient = coalescence efficiency * collision kernel (m3/s) (eq. 15.33). |
---|
4825 | !-- Here assumed coalescence efficiency 1!! |
---|
4826 | coagc = flux(1) / ( mdiam / ( mdiam + fmdist) + flux(1) / flux(2) ) |
---|
4827 | ! |
---|
4828 | !-- Corrected collision kernel (Karl et al., 2016 (ACP)): Include van der Waals and viscous forces |
---|
4829 | IF ( van_der_waals_coagc ) THEN |
---|
4830 | knud_p = SQRT( omega(1)**2 + omega(2)**2 ) / mdiam |
---|
4831 | IF ( knud_p >= 0.1_wp .AND. knud_p <= 10.0_wp ) THEN |
---|
4832 | coagc = coagc * ( 2.0_wp + 0.4_wp * LOG( knud_p ) ) |
---|
4833 | ELSE |
---|
4834 | coagc = coagc * 3.0_wp |
---|
4835 | ENDIF |
---|
4836 | ENDIF |
---|
4837 | |
---|
4838 | END FUNCTION coagc |
---|
4839 | |
---|
4840 | !------------------------------------------------------------------------------! |
---|
4841 | ! Description: |
---|
4842 | ! ------------ |
---|
4843 | !> Calculates the change in particle volume and gas phase |
---|
4844 | !> concentrations due to nucleation, condensation and dissolutional growth. |
---|
4845 | ! |
---|
4846 | !> Sulphuric acid and organic vapour: only condensation and no evaporation. |
---|
4847 | ! |
---|
4848 | !> New gas and aerosol phase concentrations calculated according to Jacobson |
---|
4849 | !> (1997): Numerical techniques to solve condensational and dissolutional growth |
---|
4850 | !> equations when growth is coupled to reversible reactions, Aerosol Sci. Tech., |
---|
4851 | !> 27, pp 491-498. |
---|
4852 | ! |
---|
4853 | !> Following parameterization has been used: |
---|
4854 | !> Molecular diffusion coefficient of condensing vapour (m2/s) |
---|
4855 | !> (Reid et al. (1987): Properties of gases and liquids, McGraw-Hill, New York.) |
---|
4856 | !> D = {1.d-7*sqrt(1/M_air + 1/M_gas)*T^1.75} / & |
---|
4857 | ! {p_atm/p_stand * (d_air^(1/3) + d_gas^(1/3))^2 } |
---|
4858 | !> M_air = 28.965 : molar mass of air (g/mol) |
---|
4859 | !> d_air = 19.70 : diffusion volume of air |
---|
4860 | !> M_h2so4 = 98.08 : molar mass of h2so4 (g/mol) |
---|
4861 | !> d_h2so4 = 51.96 : diffusion volume of h2so4 |
---|
4862 | ! |
---|
4863 | !> Called from main aerosol model |
---|
4864 | !> For equations, see Jacobson, Fundamentals of Atmospheric Modeling, 2nd Edition (2005) |
---|
4865 | ! |
---|
4866 | !> Coded by: |
---|
4867 | !> Hannele Korhonen (FMI) 2005 |
---|
4868 | !> Harri Kokkola (FMI) 2006 |
---|
4869 | !> Juha Tonttila (FMI) 2014 |
---|
4870 | !> Rewritten to PALM by Mona Kurppa (UHel) 2017 |
---|
4871 | !------------------------------------------------------------------------------! |
---|
4872 | SUBROUTINE condensation( paero, pc_sa, pc_ocnv, pcocsv, pchno3, pc_nh3, pcw, pcs, ptemp, ppres, & |
---|
4873 | ptstep, prtcl ) |
---|
4874 | |
---|
4875 | IMPLICIT NONE |
---|
4876 | |
---|
4877 | INTEGER(iwp) :: ss !< start index |
---|
4878 | INTEGER(iwp) :: ee !< end index |
---|
4879 | |
---|
4880 | REAL(wp) :: zcs_ocnv !< condensation sink of nonvolatile organics (1/s) |
---|
4881 | REAL(wp) :: zcs_ocsv !< condensation sink of semivolatile organics (1/s) |
---|
4882 | REAL(wp) :: zcs_su !< condensation sink of sulfate (1/s) |
---|
4883 | REAL(wp) :: zcs_tot !< total condensation sink (1/s) (gases) |
---|
4884 | REAL(wp) :: zcvap_new1 !< vapour concentration after time step (#/m3): sulphuric acid |
---|
4885 | REAL(wp) :: zcvap_new2 !< nonvolatile organics |
---|
4886 | REAL(wp) :: zcvap_new3 !< semivolatile organics |
---|
4887 | REAL(wp) :: zdfvap !< air diffusion coefficient (m2/s) |
---|
4888 | REAL(wp) :: zdvap1 !< change in vapour concentration (#/m3): sulphuric acid |
---|
4889 | REAL(wp) :: zdvap2 !< nonvolatile organics |
---|
4890 | REAL(wp) :: zdvap3 !< semivolatile organics |
---|
4891 | REAL(wp) :: zmfp !< mean free path of condensing vapour (m) |
---|
4892 | REAL(wp) :: zrh !< Relative humidity [0-1] |
---|
4893 | REAL(wp) :: zvisc !< viscosity of air (kg/(m s)) |
---|
4894 | REAL(wp) :: zn_vs_c !< ratio of nucleation of all mass transfer in the smallest bin |
---|
4895 | REAL(wp) :: zxocnv !< ratio of organic vapour in 3nm particles |
---|
4896 | REAL(wp) :: zxsa !< Ratio in 3nm particles: sulphuric acid |
---|
4897 | |
---|
4898 | REAL(wp), INTENT(in) :: ppres !< ambient pressure (Pa) |
---|
4899 | REAL(wp), INTENT(in) :: pcs !< Water vapour saturation concentration (kg/m3) |
---|
4900 | REAL(wp), INTENT(in) :: ptemp !< ambient temperature (K) |
---|
4901 | REAL(wp), INTENT(in) :: ptstep !< timestep (s) |
---|
4902 | |
---|
4903 | REAL(wp), INTENT(inout) :: pchno3 !< Gas concentrations (#/m3): nitric acid HNO3 |
---|
4904 | REAL(wp), INTENT(inout) :: pc_nh3 !< ammonia NH3 |
---|
4905 | REAL(wp), INTENT(inout) :: pc_ocnv !< non-volatile organics |
---|
4906 | REAL(wp), INTENT(inout) :: pcocsv !< semi-volatile organics |
---|
4907 | REAL(wp), INTENT(inout) :: pc_sa !< sulphuric acid H2SO4 |
---|
4908 | REAL(wp), INTENT(inout) :: pcw !< Water vapor concentration (kg/m3) |
---|
4909 | |
---|
4910 | REAL(wp), DIMENSION(nbins_aerosol) :: zbeta !< transitional correction factor |
---|
4911 | REAL(wp), DIMENSION(nbins_aerosol) :: zcolrate !< collision rate (1/s) |
---|
4912 | REAL(wp), DIMENSION(nbins_aerosol) :: zcolrate_ocnv !< collision rate of OCNV (1/s) |
---|
4913 | REAL(wp), DIMENSION(start_subrange_1a+1) :: zdfpart !< particle diffusion coef. (m2/s) |
---|
4914 | REAL(wp), DIMENSION(nbins_aerosol) :: zdvoloc !< change of organics volume |
---|
4915 | REAL(wp), DIMENSION(nbins_aerosol) :: zdvolsa !< change of sulphate volume |
---|
4916 | REAL(wp), DIMENSION(2) :: zj3n3 !< Formation massrate of molecules |
---|
4917 | !< in nucleation, (molec/m3s), |
---|
4918 | !< 1: H2SO4 and 2: organic vapor |
---|
4919 | REAL(wp), DIMENSION(nbins_aerosol) :: zknud !< particle Knudsen number |
---|
4920 | |
---|
4921 | TYPE(component_index), INTENT(in) :: prtcl !< Keeps track which substances are used |
---|
4922 | |
---|
4923 | TYPE(t_section), DIMENSION(nbins_aerosol), INTENT(inout) :: paero !< Aerosol properties |
---|
4924 | |
---|
4925 | zj3n3 = 0.0_wp |
---|
4926 | zrh = pcw / pcs |
---|
4927 | zxocnv = 0.0_wp |
---|
4928 | zxsa = 0.0_wp |
---|
4929 | ! |
---|
4930 | !-- Nucleation |
---|
4931 | IF ( nsnucl > 0 ) THEN |
---|
4932 | CALL nucleation( paero, ptemp, zrh, ppres, pc_sa, pc_ocnv, pc_nh3, ptstep, zj3n3, zxsa, & |
---|
4933 | zxocnv ) |
---|
4934 | ENDIF |
---|
4935 | ! |
---|
4936 | !-- Condensation on pre-existing particles |
---|
4937 | IF ( lscndgas ) THEN |
---|
4938 | ! |
---|
4939 | !-- Initialise: |
---|
4940 | zdvolsa = 0.0_wp |
---|
4941 | zdvoloc = 0.0_wp |
---|
4942 | zcolrate = 0.0_wp |
---|
4943 | ! |
---|
4944 | !-- 1) Properties of air and condensing gases: |
---|
4945 | !-- Viscosity of air (kg/(m s)) (Eq. 4.54 in Jabonson (2005)) |
---|
4946 | zvisc = ( 7.44523E-3_wp * ptemp ** 1.5_wp ) / ( 5093.0_wp * ( ptemp + 110.4_wp ) ) |
---|
4947 | ! |
---|
4948 | !-- Diffusion coefficient of air (m2/s) |
---|
4949 | zdfvap = 5.1111E-10_wp * ptemp ** 1.75_wp * ( p_0 + 1325.0_wp ) / ppres |
---|
4950 | ! |
---|
4951 | !-- Mean free path (m): same for H2SO4 and organic compounds |
---|
4952 | zmfp = 3.0_wp * zdfvap * SQRT( pi * amh2so4 / ( 8.0_wp * argas * ptemp ) ) |
---|
4953 | ! |
---|
4954 | !-- 2) Transition regime correction factor zbeta for particles (Fuchs and Sutugin (1971)): |
---|
4955 | !-- Size of condensing molecule considered only for nucleation mode (3 - 20 nm). |
---|
4956 | ! |
---|
4957 | !-- Particle Knudsen number: condensation of gases on aerosols |
---|
4958 | ss = start_subrange_1a |
---|
4959 | ee = start_subrange_1a+1 |
---|
4960 | zknud(ss:ee) = 2.0_wp * zmfp / ( paero(ss:ee)%dwet + d_sa ) |
---|
4961 | ss = start_subrange_1a+2 |
---|
4962 | ee = end_subrange_2b |
---|
4963 | zknud(ss:ee) = 2.0_wp * zmfp / paero(ss:ee)%dwet |
---|
4964 | ! |
---|
4965 | !-- Transitional correction factor: aerosol + gas (the semi-empirical Fuchs- Sutugin |
---|
4966 | !-- interpolation function (Fuchs and Sutugin, 1971)) |
---|
4967 | zbeta = ( zknud + 1.0_wp ) / ( 0.377_wp * zknud + 1.0_wp + 4.0_wp / ( 3.0_wp * massacc ) * & |
---|
4968 | ( zknud + zknud ** 2 ) ) |
---|
4969 | ! |
---|
4970 | !-- 3) Collision rate of molecules to particles |
---|
4971 | !-- Particle diffusion coefficient considered only for nucleation mode (3 - 20 nm) |
---|
4972 | ! |
---|
4973 | !-- Particle diffusion coefficient (m2/s) (e.g. Eq. 15.29 in Jacobson (2005)) |
---|
4974 | zdfpart = abo * ptemp * zbeta(start_subrange_1a:start_subrange_1a+1) / ( 3.0_wp * pi * zvisc& |
---|
4975 | * paero(start_subrange_1a:start_subrange_1a+1)%dwet) |
---|
4976 | ! |
---|
4977 | !-- Collision rate (mass-transfer coefficient): gases on aerosols (1/s) (Eq. 16.64 in |
---|
4978 | !-- Jacobson (2005)) |
---|
4979 | ss = start_subrange_1a |
---|
4980 | ee = start_subrange_1a+1 |
---|
4981 | zcolrate(ss:ee) = MERGE( 2.0_wp * pi * ( paero(ss:ee)%dwet + d_sa ) * ( zdfvap + zdfpart ) *& |
---|
4982 | zbeta(ss:ee) * paero(ss:ee)%numc, 0.0_wp, paero(ss:ee)%numc > nclim ) |
---|
4983 | ss = start_subrange_1a+2 |
---|
4984 | ee = end_subrange_2b |
---|
4985 | zcolrate(ss:ee) = MERGE( 2.0_wp * pi * paero(ss:ee)%dwet * zdfvap * zbeta(ss:ee) * & |
---|
4986 | paero(ss:ee)%numc, 0.0_wp, paero(ss:ee)%numc > nclim ) |
---|
4987 | ! |
---|
4988 | !-- 4) Condensation sink (1/s) |
---|
4989 | zcs_tot = SUM( zcolrate ) ! total sink |
---|
4990 | ! |
---|
4991 | !-- 5) Changes in gas-phase concentrations and particle volume |
---|
4992 | ! |
---|
4993 | !-- 5.1) Organic vapours |
---|
4994 | ! |
---|
4995 | !-- 5.1.1) Non-volatile organic compound: condenses onto all bins |
---|
4996 | IF ( pc_ocnv > 1.0E+10_wp .AND. zcs_tot > 1.0E-30_wp .AND. index_oc > 0 ) & |
---|
4997 | THEN |
---|
4998 | !-- Ratio of nucleation vs. condensation rates in the smallest bin |
---|
4999 | zn_vs_c = 0.0_wp |
---|
5000 | IF ( zj3n3(2) > 1.0_wp ) THEN |
---|
5001 | zn_vs_c = ( zj3n3(2) ) / ( zj3n3(2) + pc_ocnv * zcolrate(start_subrange_1a) ) |
---|
5002 | ENDIF |
---|
5003 | ! |
---|
5004 | !-- Collision rate in the smallest bin, including nucleation and condensation (see |
---|
5005 | !-- Jacobson (2005), eq. (16.73) ) |
---|
5006 | zcolrate_ocnv = zcolrate |
---|
5007 | zcolrate_ocnv(start_subrange_1a) = zcolrate_ocnv(start_subrange_1a) + zj3n3(2) / pc_ocnv |
---|
5008 | ! |
---|
5009 | !-- Total sink for organic vapor |
---|
5010 | zcs_ocnv = zcs_tot + zj3n3(2) / pc_ocnv |
---|
5011 | ! |
---|
5012 | !-- New gas phase concentration (#/m3) |
---|
5013 | zcvap_new2 = pc_ocnv / ( 1.0_wp + ptstep * zcs_ocnv ) |
---|
5014 | ! |
---|
5015 | !-- Change in gas concentration (#/m3) |
---|
5016 | zdvap2 = pc_ocnv - zcvap_new2 |
---|
5017 | ! |
---|
5018 | !-- Updated vapour concentration (#/m3) |
---|
5019 | pc_ocnv = zcvap_new2 |
---|
5020 | ! |
---|
5021 | !-- Volume change of particles (m3(OC)/m3(air)) |
---|
5022 | zdvoloc = zcolrate_ocnv(start_subrange_1a:end_subrange_2b) / zcs_ocnv * amvoc * zdvap2 |
---|
5023 | ! |
---|
5024 | !-- Change of volume due to condensation in 1a-2b |
---|
5025 | paero(start_subrange_1a:end_subrange_2b)%volc(2) = & |
---|
5026 | paero(start_subrange_1a:end_subrange_2b)%volc(2) + zdvoloc |
---|
5027 | ! |
---|
5028 | !-- Change of number concentration in the smallest bin caused by nucleation (Jacobson (2005), |
---|
5029 | !-- eq. (16.75)). If zxocnv = 0, then the chosen nucleation mechanism doesn't take into |
---|
5030 | !-- account the non-volatile organic vapors and thus the paero doesn't have to be updated. |
---|
5031 | IF ( zxocnv > 0.0_wp ) THEN |
---|
5032 | paero(start_subrange_1a)%numc = paero(start_subrange_1a)%numc + zn_vs_c * & |
---|
5033 | zdvoloc(start_subrange_1a) / amvoc / ( n3 * zxocnv ) |
---|
5034 | ENDIF |
---|
5035 | ENDIF |
---|
5036 | ! |
---|
5037 | !-- 5.1.2) Semivolatile organic compound: all bins except subrange 1 |
---|
5038 | zcs_ocsv = SUM( zcolrate(start_subrange_2a:end_subrange_2b) ) !< sink for semi-volatile org. |
---|
5039 | IF ( pcocsv > 1.0E+10_wp .AND. zcs_ocsv > 1.0E-30 .AND. is_used( prtcl,'OC') ) THEN |
---|
5040 | ! |
---|
5041 | !-- New gas phase concentration (#/m3) |
---|
5042 | zcvap_new3 = pcocsv / ( 1.0_wp + ptstep * zcs_ocsv ) |
---|
5043 | ! |
---|
5044 | !-- Change in gas concentration (#/m3) |
---|
5045 | zdvap3 = pcocsv - zcvap_new3 |
---|
5046 | ! |
---|
5047 | !-- Updated gas concentration (#/m3) |
---|
5048 | pcocsv = zcvap_new3 |
---|
5049 | ! |
---|
5050 | !-- Volume change of particles (m3(OC)/m3(air)) |
---|
5051 | ss = start_subrange_2a |
---|
5052 | ee = end_subrange_2b |
---|
5053 | zdvoloc(ss:ee) = zdvoloc(ss:ee) + zcolrate(ss:ee) / zcs_ocsv * amvoc * zdvap3 |
---|
5054 | ! |
---|
5055 | !-- Change of volume due to condensation in 1a-2b |
---|
5056 | paero(start_subrange_1a:end_subrange_2b)%volc(2) = & |
---|
5057 | paero(start_subrange_1a:end_subrange_2b)%volc(2) + zdvoloc |
---|
5058 | ENDIF |
---|
5059 | ! |
---|
5060 | !-- 5.2) Sulphate: condensed on all bins |
---|
5061 | IF ( pc_sa > 1.0E+10_wp .AND. zcs_tot > 1.0E-30_wp .AND. index_so4 > 0 ) THEN |
---|
5062 | ! |
---|
5063 | !-- Ratio of mass transfer between nucleation and condensation |
---|
5064 | zn_vs_c = 0.0_wp |
---|
5065 | IF ( zj3n3(1) > 1.0_wp ) THEN |
---|
5066 | zn_vs_c = ( zj3n3(1) ) / ( zj3n3(1) + pc_sa * zcolrate(start_subrange_1a) ) |
---|
5067 | ENDIF |
---|
5068 | ! |
---|
5069 | !-- Collision rate in the smallest bin, including nucleation and condensation (see |
---|
5070 | !-- Jacobson (2005), eq. (16.73)) |
---|
5071 | zcolrate(start_subrange_1a) = zcolrate(start_subrange_1a) + zj3n3(1) / pc_sa |
---|
5072 | ! |
---|
5073 | !-- Total sink for sulfate (1/s) |
---|
5074 | zcs_su = zcs_tot + zj3n3(1) / pc_sa |
---|
5075 | ! |
---|
5076 | !-- Sulphuric acid: |
---|
5077 | !-- New gas phase concentration (#/m3) |
---|
5078 | zcvap_new1 = pc_sa / ( 1.0_wp + ptstep * zcs_su ) |
---|
5079 | ! |
---|
5080 | !-- Change in gas concentration (#/m3) |
---|
5081 | zdvap1 = pc_sa - zcvap_new1 |
---|
5082 | ! |
---|
5083 | !-- Updating vapour concentration (#/m3) |
---|
5084 | pc_sa = zcvap_new1 |
---|
5085 | ! |
---|
5086 | !-- Volume change of particles (m3(SO4)/m3(air)) by condensation |
---|
5087 | zdvolsa = zcolrate(start_subrange_1a:end_subrange_2b) / zcs_su * amvh2so4 * zdvap1 |
---|
5088 | ! |
---|
5089 | !-- Change of volume concentration of sulphate in aerosol [fxm] |
---|
5090 | paero(start_subrange_1a:end_subrange_2b)%volc(1) = & |
---|
5091 | paero(start_subrange_1a:end_subrange_2b)%volc(1) + zdvolsa |
---|
5092 | ! |
---|
5093 | !-- Change of number concentration in the smallest bin caused by nucleation |
---|
5094 | !-- (Jacobson (2005), equation (16.75)) |
---|
5095 | IF ( zxsa > 0.0_wp ) THEN |
---|
5096 | paero(start_subrange_1a)%numc = paero(start_subrange_1a)%numc + zn_vs_c * & |
---|
5097 | zdvolsa(start_subrange_1a) / amvh2so4 / ( n3 * zxsa) |
---|
5098 | ENDIF |
---|
5099 | ENDIF |
---|
5100 | ! |
---|
5101 | !-- Partitioning of H2O, HNO3, and NH3: Dissolutional growth |
---|
5102 | IF ( lspartition .AND. ( pchno3 > 1.0E+10_wp .OR. pc_nh3 > 1.0E+10_wp ) ) THEN |
---|
5103 | CALL gpparthno3( ppres, ptemp, paero, pchno3, pc_nh3, pcw, pcs, zbeta, ptstep ) |
---|
5104 | ENDIF |
---|
5105 | ENDIF |
---|
5106 | ! |
---|
5107 | !-- Condensation of water vapour |
---|
5108 | IF ( lscndh2oae ) THEN |
---|
5109 | CALL gpparth2o( paero, ptemp, ppres, pcs, pcw, ptstep ) |
---|
5110 | ENDIF |
---|
5111 | |
---|
5112 | END SUBROUTINE condensation |
---|
5113 | |
---|
5114 | !------------------------------------------------------------------------------! |
---|
5115 | ! Description: |
---|
5116 | ! ------------ |
---|
5117 | !> Calculates the particle number and volume increase, and gas-phase |
---|
5118 | !> concentration decrease due to nucleation subsequent growth to detectable size |
---|
5119 | !> of 3 nm. |
---|
5120 | ! |
---|
5121 | !> Method: |
---|
5122 | !> When the formed clusters grow by condensation (possibly also by self- |
---|
5123 | !> coagulation), their number is reduced due to scavenging to pre-existing |
---|
5124 | !> particles. Thus, the apparent nucleation rate at 3 nm is significantly lower |
---|
5125 | !> than the real nucleation rate (at ~1 nm). |
---|
5126 | ! |
---|
5127 | !> Calculation of the formation rate of detectable particles at 3 nm (i.e. J3): |
---|
5128 | !> nj3 = 1: Kerminen, V.-M. and Kulmala, M. (2002), J. Aerosol Sci.,33, 609-622. |
---|
5129 | !> nj3 = 2: Lehtinen et al. (2007), J. Aerosol Sci., 38(9), 988-994. |
---|
5130 | !> nj3 = 3: Anttila et al. (2010), J. Aerosol Sci., 41(7), 621-636. |
---|
5131 | ! |
---|
5132 | !> c = aerosol of critical radius (1 nm) |
---|
5133 | !> x = aerosol with radius 3 nm |
---|
5134 | !> 2 = wet or mean droplet |
---|
5135 | ! |
---|
5136 | !> Called from subroutine condensation (in module salsa_dynamics_mod.f90) |
---|
5137 | ! |
---|
5138 | !> Calls one of the following subroutines: |
---|
5139 | !> - binnucl |
---|
5140 | !> - ternucl |
---|
5141 | !> - kinnucl |
---|
5142 | !> - actnucl |
---|
5143 | ! |
---|
5144 | !> fxm: currently only sulphuric acid grows particles from 1 to 3 nm |
---|
5145 | !> (if asked from Markku, this is terribly wrong!!!) |
---|
5146 | ! |
---|
5147 | !> Coded by: |
---|
5148 | !> Hannele Korhonen (FMI) 2005 |
---|
5149 | !> Harri Kokkola (FMI) 2006 |
---|
5150 | !> Matti Niskanen(FMI) 2012 |
---|
5151 | !> Anton Laakso (FMI) 2013 |
---|
5152 | !------------------------------------------------------------------------------! |
---|
5153 | |
---|
5154 | SUBROUTINE nucleation( paero, ptemp, prh, ppres, pc_sa, pc_ocnv, pc_nh3, ptstep, pj3n3, pxsa, & |
---|
5155 | pxocnv ) |
---|
5156 | |
---|
5157 | IMPLICIT NONE |
---|
5158 | |
---|
5159 | INTEGER(iwp) :: iteration |
---|
5160 | |
---|
5161 | REAL(wp) :: zc_h2so4 !< H2SO4 conc. (#/cm3) !UNITS! |
---|
5162 | REAL(wp) :: zc_org !< organic vapour conc. (#/cm3) |
---|
5163 | REAL(wp) :: zcc_c !< Cunningham correct factor for c = critical (1nm) |
---|
5164 | REAL(wp) :: zcc_x !< Cunningham correct factor for x = 3nm |
---|
5165 | REAL(wp) :: zcoags_c !< coagulation sink (1/s) for c = critical (1nm) |
---|
5166 | REAL(wp) :: zcoags_x !< coagulation sink (1/s) for x = 3nm |
---|
5167 | REAL(wp) :: zcoagstot !< total particle losses due to coagulation, including condensation |
---|
5168 | !< and self-coagulation |
---|
5169 | REAL(wp) :: zcocnv_local !< organic vapour conc. (#/m3) |
---|
5170 | REAL(wp) :: zcsink !< condensational sink (#/m2) |
---|
5171 | REAL(wp) :: zcsa_local !< H2SO4 conc. (#/m3) |
---|
5172 | REAL(wp) :: zcv_c !< mean relative thermal velocity (m/s) for c = critical (1nm) |
---|
5173 | REAL(wp) :: zcv_x !< mean relative thermal velocity (m/s) for x = 3nm |
---|
5174 | REAL(wp) :: zdcrit !< diameter of critical cluster (m) |
---|
5175 | REAL(wp) :: zdelta_vap !< change of H2SO4 and organic vapour concentration (#/m3) |
---|
5176 | REAL(wp) :: zdfvap !< air diffusion coefficient (m2/s) |
---|
5177 | REAL(wp) :: zdmean !< mean diameter of existing particles (m) |
---|
5178 | REAL(wp) :: zeta !< constant: proportional to ratio of CS/GR (m) |
---|
5179 | !< (condensation sink / growth rate) |
---|
5180 | REAL(wp) :: zgamma !< proportionality factor ((nm2*m2)/h) |
---|
5181 | REAL(wp) :: z_gr_clust !< growth rate of formed clusters (nm/h) |
---|
5182 | REAL(wp) :: z_gr_tot !< total growth rate |
---|
5183 | REAL(wp) :: zj3 !< number conc. of formed 3nm particles (#/m3) |
---|
5184 | REAL(wp) :: zjnuc !< nucleation rate at ~1nm (#/m3s) |
---|
5185 | REAL(wp) :: z_k_eff !< effective cogulation coefficient for freshly nucleated particles |
---|
5186 | REAL(wp) :: zknud_c !< Knudsen number for c = critical (1nm) |
---|
5187 | REAL(wp) :: zknud_x !< Knudsen number for x = 3nm |
---|
5188 | REAL(wp) :: zkocnv !< lever: zkocnv=1 --> organic compounds involved in nucleation |
---|
5189 | REAL(wp) :: zksa !< lever: zksa=1 --> H2SO4 involved in nucleation |
---|
5190 | REAL(wp) :: zlambda !< parameter for adjusting the growth rate due to self-coagulation |
---|
5191 | REAL(wp) :: zm_c !< particle mass (kg) for c = critical (1nm) |
---|
5192 | REAL(wp) :: zm_para !< Parameter m for calculating the coagulation sink (Eq. 5&6 in |
---|
5193 | !< Lehtinen et al. 2007) |
---|
5194 | REAL(wp) :: zm_x !< particle mass (kg) for x = 3nm |
---|
5195 | REAL(wp) :: zmfp !< mean free path of condesing vapour(m) |
---|
5196 | REAL(wp) :: zmixnh3 !< ammonia mixing ratio (ppt) |
---|
5197 | REAL(wp) :: zmyy !< gas dynamic viscosity (N*s/m2) |
---|
5198 | REAL(wp) :: z_n_nuc !< number of clusters/particles at the size range d1-dx (#/m3) |
---|
5199 | REAL(wp) :: znoc !< number of organic molecules in critical cluster |
---|
5200 | REAL(wp) :: znsa !< number of H2SO4 molecules in critical cluster |
---|
5201 | |
---|
5202 | REAL(wp), INTENT(in) :: pc_nh3 !< ammonia concentration (#/m3) |
---|
5203 | REAL(wp), INTENT(in) :: pc_ocnv !< conc. of non-volatile OC (#/m3) |
---|
5204 | REAL(wp), INTENT(in) :: pc_sa !< sulphuric acid conc. (#/m3) |
---|
5205 | REAL(wp), INTENT(in) :: ppres !< ambient air pressure (Pa) |
---|
5206 | REAL(wp), INTENT(in) :: prh !< ambient rel. humidity [0-1] |
---|
5207 | REAL(wp), INTENT(in) :: ptemp !< ambient temperature (K) |
---|
5208 | REAL(wp), INTENT(in) :: ptstep !< time step (s) of SALSA |
---|
5209 | |
---|
5210 | REAL(wp), INTENT(inout) :: pj3n3(2) !< formation mass rate of molecules (molec/m3s) for |
---|
5211 | !< 1: H2SO4 and 2: organic vapour |
---|
5212 | |
---|
5213 | REAL(wp), INTENT(out) :: pxocnv !< ratio of non-volatile organic vapours in 3 nm particles |
---|
5214 | REAL(wp), INTENT(out) :: pxsa !< ratio of H2SO4 in 3 nm aerosol particles |
---|
5215 | |
---|
5216 | REAL(wp), DIMENSION(nbins_aerosol) :: zbeta !< transitional correction factor |
---|
5217 | REAL(wp), DIMENSION(nbins_aerosol) :: zcc_2 !< Cunningham correct factor:2 |
---|
5218 | REAL(wp), DIMENSION(nbins_aerosol) :: zcv_2 !< mean relative thermal velocity (m/s): 2 |
---|
5219 | REAL(wp), DIMENSION(nbins_aerosol) :: zcv_c2 !< average velocity after coagulation: c & 2 |
---|
5220 | REAL(wp), DIMENSION(nbins_aerosol) :: zcv_x2 !< average velocity after coagulation: x & 2 |
---|
5221 | REAL(wp), DIMENSION(nbins_aerosol) :: zdc_2 !< particle diffusion coefficient (m2/s): 2 |
---|
5222 | REAL(wp), DIMENSION(nbins_aerosol) :: zdc_c !< particle diffusion coefficient (m2/s): c |
---|
5223 | REAL(wp), DIMENSION(nbins_aerosol) :: zdc_c2 !< sum of diffusion coef. for c and 2 |
---|
5224 | REAL(wp), DIMENSION(nbins_aerosol) :: zdc_x !< particle diffusion coefficient (m2/s): x |
---|
5225 | REAL(wp), DIMENSION(nbins_aerosol) :: zdc_x2 !< sum of diffusion coef. for: x & 2 |
---|
5226 | REAL(wp), DIMENSION(nbins_aerosol) :: zgamma_f_2 !< zgamma_f for calculating zomega |
---|
5227 | REAL(wp), DIMENSION(nbins_aerosol) :: zgamma_f_c !< zgamma_f for calculating zomega |
---|
5228 | REAL(wp), DIMENSION(nbins_aerosol) :: zgamma_f_x !< zgamma_f for calculating zomega |
---|
5229 | REAL(wp), DIMENSION(nbins_aerosol) :: z_k_c2 !< coagulation coef. in the continuum |
---|
5230 | !< regime: c & 2 |
---|
5231 | REAL(wp), DIMENSION(nbins_aerosol) :: z_k_x2 !< coagulation coef. in the continuum |
---|
5232 | !< regime: x & 2 |
---|
5233 | REAL(wp), DIMENSION(nbins_aerosol) :: zknud !< particle Knudsen number |
---|
5234 | REAL(wp), DIMENSION(nbins_aerosol) :: zknud_2 !< particle Knudsen number: 2 |
---|
5235 | REAL(wp), DIMENSION(nbins_aerosol) :: zm_2 !< particle mass (kg): 2 |
---|
5236 | REAL(wp), DIMENSION(nbins_aerosol) :: zomega_2c !< zomega (m) for calculating zsigma: c & 2 |
---|
5237 | REAL(wp), DIMENSION(nbins_aerosol) :: zomega_2x !< zomega (m) for calculating zsigma: x & 2 |
---|
5238 | REAL(wp), DIMENSION(nbins_aerosol) :: zomega_c !< zomega (m) for calculating zsigma: c |
---|
5239 | REAL(wp), DIMENSION(nbins_aerosol) :: zomega_x !< zomega (m) for calculating zsigma: x |
---|
5240 | REAL(wp), DIMENSION(nbins_aerosol) :: z_r_c2 !< sum of the radii: c & 2 |
---|
5241 | REAL(wp), DIMENSION(nbins_aerosol) :: z_r_x2 !< sum of the radii: x & 2 |
---|
5242 | REAL(wp), DIMENSION(nbins_aerosol) :: zsigma_c2 !< |
---|
5243 | REAL(wp), DIMENSION(nbins_aerosol) :: zsigma_x2 !< |
---|
5244 | |
---|
5245 | TYPE(t_section), DIMENSION(nbins_aerosol), INTENT(inout) :: paero !< aerosol properties |
---|
5246 | ! |
---|
5247 | !-- 1) Nucleation rate (zjnuc) and diameter of critical cluster (zdcrit) |
---|
5248 | zjnuc = 0.0_wp |
---|
5249 | znsa = 0.0_wp |
---|
5250 | znoc = 0.0_wp |
---|
5251 | zdcrit = 0.0_wp |
---|
5252 | zksa = 0.0_wp |
---|
5253 | zkocnv = 0.0_wp |
---|
5254 | |
---|
5255 | zc_h2so4 = pc_sa * 1.0E-6_wp ! sulphuric acid conc. to #/cm3 |
---|
5256 | zc_org = pc_ocnv * 1.0E-6_wp ! conc. of non-volatile OC to #/cm3 |
---|
5257 | zmixnh3 = pc_nh3 * ptemp * argas / ( ppres * avo ) |
---|
5258 | |
---|
5259 | SELECT CASE ( nsnucl ) |
---|
5260 | ! |
---|
5261 | !-- Binary H2SO4-H2O nucleation |
---|
5262 | CASE(1) |
---|
5263 | |
---|
5264 | CALL binnucl( zc_h2so4, ptemp, prh, zjnuc, znsa, znoc, zdcrit, zksa, zkocnv ) |
---|
5265 | ! |
---|
5266 | !-- Activation type nucleation (See Riipinen et al. (2007), Atmos. Chem. Phys., 7(8), 1899-1914) |
---|
5267 | CASE(2) |
---|
5268 | ! |
---|
5269 | !-- Nucleation rate (#/(m3 s)) |
---|
5270 | zc_h2so4 = MAX( zc_h2so4, 1.0E4_wp ) |
---|
5271 | zc_h2so4 = MIN( zc_h2so4, 1.0E11_wp ) |
---|
5272 | zjnuc = act_coeff * pc_sa ! (#/(m3 s)) |
---|
5273 | ! |
---|
5274 | !-- Organic compounds not involved when kinetic nucleation is assumed. |
---|
5275 | zdcrit = 7.9375E-10_wp ! (m) |
---|
5276 | zkocnv = 0.0_wp |
---|
5277 | zksa = 1.0_wp |
---|
5278 | znoc = 0.0_wp |
---|
5279 | znsa = 2.0_wp |
---|
5280 | ! |
---|
5281 | !-- Kinetically limited nucleation of (NH4)HSO4 clusters |
---|
5282 | !-- (See Sihto et al. (2006), Atmos. Chem. Phys., 6(12), 4079-4091.) |
---|
5283 | CASE(3) |
---|
5284 | ! |
---|
5285 | !-- Nucleation rate = coagcoeff*zpcsa**2 (#/(m3 s)) |
---|
5286 | zc_h2so4 = MAX( zc_h2so4, 1.0E4_wp ) |
---|
5287 | zc_h2so4 = MIN( zc_h2so4, 1.0E11_wp ) |
---|
5288 | zjnuc = 5.0E-13_wp * zc_h2so4**2.0_wp * 1.0E+6_wp |
---|
5289 | ! |
---|
5290 | !-- Organic compounds not involved when kinetic nucleation is assumed. |
---|
5291 | zdcrit = 7.9375E-10_wp ! (m) |
---|
5292 | zkocnv = 0.0_wp |
---|
5293 | zksa = 1.0_wp |
---|
5294 | znoc = 0.0_wp |
---|
5295 | znsa = 2.0_wp |
---|
5296 | ! |
---|
5297 | !-- Ternary H2SO4-H2O-NH3 nucleation |
---|
5298 | CASE(4) |
---|
5299 | |
---|
5300 | CALL ternucl( zc_h2so4, zmixnh3, ptemp, prh, zjnuc, znsa, znoc, zdcrit, zksa, zkocnv ) |
---|
5301 | ! |
---|
5302 | !-- Organic nucleation, J~[ORG] or J~[ORG]**2 |
---|
5303 | !-- (See Paasonen et al. (2010), Atmos. Chem. Phys., 10, 11223-11242.) |
---|
5304 | CASE(5) |
---|
5305 | ! |
---|
5306 | !-- Homomolecular nuleation rate |
---|
5307 | zjnuc = 1.3E-7_wp * pc_ocnv ! (1/s) (Paasonen et al. Table 4: median a_org) |
---|
5308 | ! |
---|
5309 | !-- H2SO4 not involved when pure organic nucleation is assumed. |
---|
5310 | zdcrit = 1.5E-9 ! (m) |
---|
5311 | zkocnv = 1.0_wp |
---|
5312 | zksa = 0.0_wp |
---|
5313 | znoc = 1.0_wp |
---|
5314 | znsa = 0.0_wp |
---|
5315 | ! |
---|
5316 | !-- Sum of H2SO4 and organic activation type nucleation, J~[H2SO4]+[ORG] |
---|
5317 | !-- (See Paasonen et al. (2010), Atmos. Chem. Phys., 10, 11223-11242) |
---|
5318 | CASE(6) |
---|
5319 | ! |
---|
5320 | !-- Nucleation rate (#/m3/s) |
---|
5321 | zjnuc = 6.1E-7_wp * pc_sa + 0.39E-7_wp * pc_ocnv ! (Paasonen et al. Table 3.) |
---|
5322 | ! |
---|
5323 | !-- Both organic compounds and H2SO4 are involved when sumnucleation is assumed. |
---|
5324 | zdcrit = 1.5E-9_wp ! (m) |
---|
5325 | zkocnv = 1.0_wp |
---|
5326 | zksa = 1.0_wp |
---|
5327 | znoc = 1.0_wp |
---|
5328 | znsa = 1.0_wp |
---|
5329 | ! |
---|
5330 | !-- Heteromolecular nucleation, J~[H2SO4]*[ORG] |
---|
5331 | !-- (See Paasonen et al. (2010), Atmos. Chem. Phys., 10, 11223-11242.) |
---|
5332 | CASE(7) |
---|
5333 | ! |
---|
5334 | !-- Nucleation rate (#/m3/s) |
---|
5335 | zjnuc = 4.1E-14_wp * pc_sa * pc_ocnv * 1.0E6_wp ! (Paasonen et al. Table 4: median) |
---|
5336 | ! |
---|
5337 | !-- Both organic compounds and H2SO4 are involved when heteromolecular nucleation is assumed |
---|
5338 | zdcrit = 1.5E-9_wp ! (m) |
---|
5339 | zkocnv = 1.0_wp |
---|
5340 | zksa = 1.0_wp |
---|
5341 | znoc = 1.0_wp |
---|
5342 | znsa = 1.0_wp |
---|
5343 | ! |
---|
5344 | !-- Homomolecular nucleation of H2SO4 and heteromolecular nucleation of H2SO4 and organic vapour, |
---|
5345 | !-- J~[H2SO4]**2 + [H2SO4]*[ORG] (EUCAARI project) |
---|
5346 | !-- (See Paasonen et al. (2010), Atmos. Chem. Phys., 10, 11223-11242) |
---|
5347 | CASE(8) |
---|
5348 | ! |
---|
5349 | !-- Nucleation rate (#/m3/s) |
---|
5350 | zjnuc = ( 1.1E-14_wp * zc_h2so4**2 + 3.2E-14_wp * zc_h2so4 * zc_org ) * 1.0E+6_wp |
---|
5351 | ! |
---|
5352 | !-- Both organic compounds and H2SO4 are involved when SAnucleation is assumed |
---|
5353 | zdcrit = 1.5E-9_wp ! (m) |
---|
5354 | zkocnv = 1.0_wp |
---|
5355 | zksa = 1.0_wp |
---|
5356 | znoc = 1.0_wp |
---|
5357 | znsa = 3.0_wp |
---|
5358 | ! |
---|
5359 | !-- Homomolecular nucleation of H2SO4 and organic vapour and heteromolecular nucleation of H2SO4 |
---|
5360 | !-- and organic vapour, J~[H2SO4]**2 + [H2SO4]*[ORG]+[ORG]**2 (EUCAARI project) |
---|
5361 | CASE(9) |
---|
5362 | ! |
---|
5363 | !-- Nucleation rate (#/m3/s) |
---|
5364 | zjnuc = ( 1.4E-14_wp * zc_h2so4**2 + 2.6E-14_wp * zc_h2so4 * zc_org + 0.037E-14_wp * & |
---|
5365 | zc_org**2 ) * 1.0E+6_wp |
---|
5366 | ! |
---|
5367 | !-- Both organic compounds and H2SO4 are involved when SAORGnucleation is assumed |
---|
5368 | zdcrit = 1.5E-9_wp ! (m) |
---|
5369 | zkocnv = 1.0_wp |
---|
5370 | zksa = 1.0_wp |
---|
5371 | znoc = 3.0_wp |
---|
5372 | znsa = 3.0_wp |
---|
5373 | |
---|
5374 | END SELECT |
---|
5375 | |
---|
5376 | zcsa_local = pc_sa |
---|
5377 | zcocnv_local = pc_ocnv |
---|
5378 | ! |
---|
5379 | !-- 2) Change of particle and gas concentrations due to nucleation |
---|
5380 | ! |
---|
5381 | !-- 2.1) Check that there is enough H2SO4 and organic vapour to produce the nucleation |
---|
5382 | IF ( nsnucl <= 4 ) THEN |
---|
5383 | ! |
---|
5384 | !-- If the chosen nucleation scheme is 1-4, nucleation occurs only due to H2SO4. All of the total |
---|
5385 | !-- vapour concentration that is taking part to the nucleation is there for sulphuric acid |
---|
5386 | !-- (sa = H2SO4) and non-volatile organic vapour is zero. |
---|
5387 | pxsa = 1.0_wp ! ratio of sulphuric acid in 3nm particles |
---|
5388 | pxocnv = 0.0_wp ! ratio of non-volatile origanic vapour |
---|
5389 | ! in 3nm particles |
---|
5390 | ELSEIF ( nsnucl > 4 ) THEN |
---|
5391 | ! |
---|
5392 | !-- If the chosen nucleation scheme is 5-9, nucleation occurs due to organic vapour or the |
---|
5393 | !-- combination of organic vapour and H2SO4. The number of needed molecules depends on the chosen |
---|
5394 | !-- nucleation type and it has an effect also on the minimum ratio of the molecules present. |
---|
5395 | IF ( pc_sa * znsa + pc_ocnv * znoc < 1.E-14_wp ) THEN |
---|
5396 | pxsa = 0.0_wp |
---|
5397 | pxocnv = 0.0_wp |
---|
5398 | ELSE |
---|
5399 | pxsa = pc_sa * znsa / ( pc_sa * znsa + pc_ocnv * znoc ) |
---|
5400 | pxocnv = pc_ocnv * znoc / ( pc_sa * znsa + pc_ocnv * znoc ) |
---|
5401 | ENDIF |
---|
5402 | ENDIF |
---|
5403 | ! |
---|
5404 | !-- The change in total vapour concentration is the sum of the concentrations of the vapours taking |
---|
5405 | !-- part to the nucleation (depends on the chosen nucleation scheme) |
---|
5406 | zdelta_vap = MIN( zjnuc * ( znoc + znsa ), ( pc_ocnv * zkocnv + pc_sa * zksa ) / ptstep ) |
---|
5407 | ! |
---|
5408 | !-- Nucleation rate J at ~1nm (#/m3s) |
---|
5409 | zjnuc = zdelta_vap / ( znoc + znsa ) |
---|
5410 | ! |
---|
5411 | !-- H2SO4 concentration after nucleation (#/m3) |
---|
5412 | zcsa_local = MAX( 1.0_wp, pc_sa - zdelta_vap * pxsa ) |
---|
5413 | ! |
---|
5414 | !-- Non-volative organic vapour concentration after nucleation (#/m3) |
---|
5415 | zcocnv_local = MAX( 1.0_wp, pc_ocnv - zdelta_vap * pxocnv ) |
---|
5416 | ! |
---|
5417 | !-- 2.2) Formation rate of 3 nm particles (Kerminen & Kulmala, 2002) |
---|
5418 | ! |
---|
5419 | !-- Growth rate by H2SO4 and organic vapour (nm/h, Eq. 21) |
---|
5420 | z_gr_clust = 2.3623E-15_wp * SQRT( ptemp ) * ( zcsa_local + zcocnv_local ) |
---|
5421 | ! |
---|
5422 | !-- 2.2.2) Condensational sink of pre-existing particle population |
---|
5423 | ! |
---|
5424 | !-- Diffusion coefficient (m2/s) |
---|
5425 | zdfvap = 5.1111E-10_wp * ptemp**1.75_wp * ( p_0 + 1325.0_wp ) / ppres |
---|
5426 | ! |
---|
5427 | !-- Mean free path of condensing vapour (m) (Jacobson (2005), Eq. 15.25 and 16.29) |
---|
5428 | zmfp = 3.0_wp * zdfvap * SQRT( pi * amh2so4 / ( 8.0_wp * argas * ptemp ) ) |
---|
5429 | ! |
---|
5430 | !-- Knudsen number |
---|
5431 | zknud = 2.0_wp * zmfp / ( paero(:)%dwet + d_sa ) |
---|
5432 | ! |
---|
5433 | !-- Transitional regime correction factor (zbeta) according to Fuchs and Sutugin (1971) (Eq. 4 in |
---|
5434 | !-- Kerminen and Kulmala, 2002) |
---|
5435 | zbeta = ( zknud + 1.0_wp) / ( 0.377_wp * zknud + 1.0_wp + 4.0_wp / ( 3.0_wp * massacc ) * & |
---|
5436 | ( zknud + zknud**2 ) ) |
---|
5437 | ! |
---|
5438 | !-- Condensational sink (#/m2, Eq. 3) |
---|
5439 | zcsink = SUM( paero(:)%dwet * zbeta * paero(:)%numc ) |
---|
5440 | ! |
---|
5441 | !-- 2.2.3) Parameterised formation rate of detectable 3 nm particles (i.e. J3) |
---|
5442 | IF ( nj3 == 1 ) THEN ! Kerminen and Kulmala (2002) |
---|
5443 | ! |
---|
5444 | !-- Constants needed for the parameterisation: dapp = 3 nm and dens_nuc = 1830 kg/m3 |
---|
5445 | IF ( zcsink < 1.0E-30_wp ) THEN |
---|
5446 | zeta = 0._dp |
---|
5447 | ELSE |
---|
5448 | ! |
---|
5449 | !-- Mean diameter of backgroud population (nm) |
---|
5450 | zdmean = 1.0_wp / SUM( paero(:)%numc ) * SUM( paero(:)%numc * paero(:)%dwet ) * 1.0E+9_wp |
---|
5451 | ! |
---|
5452 | !-- Proportionality factor (nm2*m2/h) (Eq. 22) |
---|
5453 | zgamma = 0.23_wp * ( zdcrit * 1.0E+9_wp )**0.2_wp * ( zdmean / 150.0_wp )**0.048_wp * & |
---|
5454 | ( ptemp / 293.0_wp )**( -0.75_wp ) * ( arhoh2so4 / 1000.0_wp )**( -0.33_wp ) |
---|
5455 | ! |
---|
5456 | !-- Factor eta (nm, Eq. 11) |
---|
5457 | zeta = MIN( zgamma * zcsink / z_gr_clust, zdcrit * 1.0E11_wp ) |
---|
5458 | ENDIF |
---|
5459 | ! |
---|
5460 | !-- Number conc. of clusters surviving to 3 nm in a time step (#/m3, Eq.14) |
---|
5461 | zj3 = zjnuc * EXP( MIN( 0.0_wp, zeta / 3.0_wp - zeta / ( zdcrit * 1.0E9_wp ) ) ) |
---|
5462 | |
---|
5463 | ELSEIF ( nj3 > 1 ) THEN ! Lehtinen et al. (2007) or Anttila et al. (2010) |
---|
5464 | ! |
---|
5465 | !-- Defining the parameter m (zm_para) for calculating the coagulation sink onto background |
---|
5466 | !-- particles (Eq. 5&6 in Lehtinen et al. 2007). The growth is investigated between |
---|
5467 | !-- [d1,reglim(1)] = [zdcrit,3nm] and m = LOG( CoagS_dx / CoagX_zdcrit ) / LOG( reglim / zdcrit ) |
---|
5468 | !-- (Lehtinen et al. 2007, Eq. 6). |
---|
5469 | !-- The steps for the coagulation sink for reglim = 3nm and zdcrit ~= 1nm are explained in |
---|
5470 | !-- Kulmala et al. (2001). The particles of diameter zdcrit ~1.14 nm and reglim = 3nm are both |
---|
5471 | !-- in turn the "number 1" variables (Kulmala et al. 2001). |
---|
5472 | !-- c = critical (1nm), x = 3nm, 2 = wet or mean droplet |
---|
5473 | ! |
---|
5474 | !-- Sum of the radii, R12 = R1 + R2 (m) of two particles 1 and 2 |
---|
5475 | z_r_c2 = zdcrit / 2.0_wp + paero(:)%dwet / 2.0_wp |
---|
5476 | z_r_x2 = reglim(1) / 2.0_wp + paero(:)%dwet / 2.0_wp |
---|
5477 | ! |
---|
5478 | !-- Particle mass (kg) (comes only from H2SO4) |
---|
5479 | zm_c = 4.0_wp / 3.0_wp * pi * ( zdcrit / 2.0_wp )**3 * arhoh2so4 |
---|
5480 | zm_x = 4.0_wp / 3.0_wp * pi * ( reglim(1) / 2.0_wp )**3 * arhoh2so4 |
---|
5481 | zm_2 = 4.0_wp / 3.0_wp * pi * ( 0.5_wp * paero(:)%dwet )**3 * arhoh2so4 |
---|
5482 | ! |
---|
5483 | !-- Mean relative thermal velocity between the particles (m/s) |
---|
5484 | zcv_c = SQRT( 8.0_wp * abo * ptemp / ( pi * zm_c ) ) |
---|
5485 | zcv_x = SQRT( 8.0_wp * abo * ptemp / ( pi * zm_x ) ) |
---|
5486 | zcv_2 = SQRT( 8.0_wp * abo * ptemp / ( pi * zm_2 ) ) |
---|
5487 | ! |
---|
5488 | !-- Average velocity after coagulation |
---|
5489 | zcv_c2(:) = SQRT( zcv_c**2 + zcv_2**2 ) |
---|
5490 | zcv_x2(:) = SQRT( zcv_x**2 + zcv_2**2 ) |
---|
5491 | ! |
---|
5492 | !-- Knudsen number (zmfp = mean free path of condensing vapour) |
---|
5493 | zknud_c = 2.0_wp * zmfp / zdcrit |
---|
5494 | zknud_x = 2.0_wp * zmfp / reglim(1) |
---|
5495 | zknud_2(:) = MAX( 0.0_wp, 2.0_wp * zmfp / paero(:)%dwet ) |
---|
5496 | ! |
---|
5497 | !-- Cunningham correction factors (Allen and Raabe, 1985) |
---|
5498 | zcc_c = 1.0_wp + zknud_c * ( 1.142_wp + 0.558_wp * EXP( -0.999_wp / zknud_c ) ) |
---|
5499 | zcc_x = 1.0_wp + zknud_x * ( 1.142_wp + 0.558_wp * EXP( -0.999_wp / zknud_x ) ) |
---|
5500 | zcc_2(:) = 1.0_wp + zknud_2(:) * ( 1.142_wp + 0.558_wp * EXP( -0.999_wp / zknud_2(:) ) ) |
---|
5501 | ! |
---|
5502 | !-- Gas dynamic viscosity (N*s/m2). Here, viscocity(air @20C) = 1.81e-5_dp N/m2 *s (Hinds, p. 25) |
---|
5503 | zmyy = 1.81E-5_wp * ( ptemp / 293.0_wp )**0.74_wp |
---|
5504 | ! |
---|
5505 | !-- Particle diffusion coefficient (m2/s) (continuum regime) |
---|
5506 | zdc_c(:) = abo * ptemp * zcc_c / ( 3.0_wp * pi * zmyy * zdcrit ) |
---|
5507 | zdc_x(:) = abo * ptemp * zcc_x / ( 3.0_wp * pi * zmyy * reglim(1) ) |
---|
5508 | zdc_2(:) = abo * ptemp * zcc_2(:) / ( 3.0_wp * pi * zmyy * paero(:)%dwet ) |
---|
5509 | ! |
---|
5510 | !-- D12 = D1+D2 (Seinfield and Pandis, 2nd ed. Eq. 13.38) |
---|
5511 | zdc_c2 = zdc_c + zdc_2 |
---|
5512 | zdc_x2 = zdc_x + zdc_2 |
---|
5513 | ! |
---|
5514 | !-- zgamma_f = 8*D/pi/zcv (m) for calculating zomega (Fuchs, 1964) |
---|
5515 | zgamma_f_c = 8.0_wp * zdc_c / pi / zcv_c |
---|
5516 | zgamma_f_x = 8.0_wp * zdc_x / pi / zcv_x |
---|
5517 | zgamma_f_2 = 8.0_wp * zdc_2 / pi / zcv_2 |
---|
5518 | ! |
---|
5519 | !-- zomega (m) for calculating zsigma |
---|
5520 | zomega_c = ( ( z_r_c2 + zgamma_f_c )**3 - ( z_r_c2 ** 2 + zgamma_f_c )**1.5_wp ) / & |
---|
5521 | ( 3.0_wp * z_r_c2 * zgamma_f_c ) - z_r_c2 |
---|
5522 | zomega_x = ( ( z_r_x2 + zgamma_f_x )**3 - ( z_r_x2**2 + zgamma_f_x )** 1.5_wp ) / & |
---|
5523 | ( 3.0_wp * z_r_x2 * zgamma_f_x ) - z_r_x2 |
---|
5524 | zomega_2c = ( ( z_r_c2 + zgamma_f_2 )**3 - ( z_r_c2**2 + zgamma_f_2 )**1.5_wp ) / & |
---|
5525 | ( 3.0_wp * z_r_c2 * zgamma_f_2 ) - z_r_c2 |
---|
5526 | zomega_2x = ( ( z_r_x2 + zgamma_f_2 )**3 - ( z_r_x2**2 + zgamma_f_2 )**1.5_wp ) / & |
---|
5527 | ( 3.0_wp * z_r_x2 * zgamma_f_2 ) - z_r_x2 |
---|
5528 | ! |
---|
5529 | !-- The distance (m) at which the two fluxes are matched (condensation and coagulation sinks) |
---|
5530 | zsigma_c2 = SQRT( zomega_c**2 + zomega_2c**2 ) |
---|
5531 | zsigma_x2 = SQRT( zomega_x**2 + zomega_2x**2 ) |
---|
5532 | ! |
---|
5533 | !-- Coagulation coefficient in the continuum regime (m*m2/s, Eq. 17 in Kulmala et al., 2001) |
---|
5534 | z_k_c2 = 4.0_wp * pi * z_r_c2 * zdc_c2 / ( z_r_c2 / ( z_r_c2 + zsigma_c2 ) + & |
---|
5535 | 4.0_wp * zdc_c2 / ( zcv_c2 * z_r_c2 ) ) |
---|
5536 | z_k_x2 = 4.0_wp * pi * z_r_x2 * zdc_x2 / ( z_r_x2 / ( z_r_x2 + zsigma_x2 ) + & |
---|
5537 | 4.0_wp * zdc_x2 / ( zcv_x2 * z_r_x2 ) ) |
---|
5538 | ! |
---|
5539 | !-- Coagulation sink (1/s, Eq. 16 in Kulmala et al., 2001) |
---|
5540 | zcoags_c = MAX( 1.0E-20_wp, SUM( z_k_c2 * paero(:)%numc ) ) |
---|
5541 | zcoags_x = MAX( 1.0E-20_wp, SUM( z_k_x2 * paero(:)%numc ) ) |
---|
5542 | ! |
---|
5543 | !-- Parameter m for calculating the coagulation sink onto background particles (Eq. 5&6 in |
---|
5544 | !-- Lehtinen et al. 2007) |
---|
5545 | zm_para = LOG( zcoags_x / zcoags_c ) / LOG( reglim(1) / zdcrit ) |
---|
5546 | ! |
---|
5547 | !-- Parameter gamma for calculating the formation rate J of particles having |
---|
5548 | !-- a diameter zdcrit < d < reglim(1) (Anttila et al. 2010, eq. 5 or Lehtinen et al.,2007, eq. 7) |
---|
5549 | zgamma = ( ( ( reglim(1) / zdcrit )**( zm_para + 1.0_wp ) ) - 1.0_wp ) / ( zm_para + 1.0_wp ) |
---|
5550 | |
---|
5551 | IF ( nj3 == 2 ) THEN ! Lehtinen et al. (2007): coagulation sink |
---|
5552 | ! |
---|
5553 | !-- Formation rate J before iteration (#/m3s) |
---|
5554 | zj3 = zjnuc * EXP( MIN( 0.0_wp, -zgamma * zdcrit * zcoags_c / ( z_gr_clust * 1.0E-9_wp / & |
---|
5555 | 60.0_wp**2 ) ) ) |
---|
5556 | |
---|
5557 | ELSEIF ( nj3 == 3 ) THEN ! Anttila et al. (2010): coagulation sink and self-coag. |
---|
5558 | ! |
---|
5559 | !-- If air is polluted, the self-coagulation becomes important. Self-coagulation of small |
---|
5560 | !-- particles < 3 nm. |
---|
5561 | ! |
---|
5562 | !-- "Effective" coagulation coefficient between freshly-nucleated particles: |
---|
5563 | z_k_eff = 5.0E-16_wp ! m3/s |
---|
5564 | ! |
---|
5565 | !-- zlambda parameter for "adjusting" the growth rate due to the self-coagulation |
---|
5566 | zlambda = 6.0_wp |
---|
5567 | |
---|
5568 | IF ( reglim(1) >= 10.0E-9_wp ) THEN ! for particles >10 nm: |
---|
5569 | z_k_eff = 5.0E-17_wp |
---|
5570 | zlambda = 3.0_wp |
---|
5571 | ENDIF |
---|
5572 | ! |
---|
5573 | !-- Initial values for coagulation sink and growth rate (m/s) |
---|
5574 | zcoagstot = zcoags_c |
---|
5575 | z_gr_tot = z_gr_clust * 1.0E-9_wp / 60.0_wp**2 |
---|
5576 | ! |
---|
5577 | !-- Number of clusters/particles at the size range [d1,dx] (#/m3): |
---|
5578 | z_n_nuc = zjnuc / zcoagstot !< Initial guess |
---|
5579 | ! |
---|
5580 | !-- Coagulation sink and growth rate due to self-coagulation: |
---|
5581 | DO iteration = 1, 5 |
---|
5582 | zcoagstot = zcoags_c + z_k_eff * z_n_nuc * 1.0E-6_wp ! (1/s, Anttila et al., eq. 1) |
---|
5583 | z_gr_tot = z_gr_clust * 2.77777777E-7_wp + 1.5708E-6_wp * zlambda * zdcrit**3 * & |
---|
5584 | ( z_n_nuc * 1.0E-6_wp ) * zcv_c * avo * 2.77777777E-7_wp ! (Eq. 3) |
---|
5585 | zeta = - zcoagstot / ( ( zm_para + 1.0_wp ) * z_gr_tot * ( zdcrit**zm_para ) ) ! (Eq.7b) |
---|
5586 | ! |
---|
5587 | !-- Calculate Eq. 7a (Taylor series for the number of particles between [d1,dx]) |
---|
5588 | z_n_nuc = z_n_nuc_tayl( zdcrit, reglim(1), zm_para, zjnuc, zeta, z_gr_tot ) |
---|
5589 | ENDDO |
---|
5590 | ! |
---|
5591 | !-- Calculate the final values with new z_n_nuc: |
---|
5592 | zcoagstot = zcoags_c + z_k_eff * z_n_nuc * 1.0E-6_wp ! (1/s) |
---|
5593 | z_gr_tot = z_gr_clust * 1.0E-9_wp / 3600.0_wp + 1.5708E-6_wp * zlambda * zdcrit**3 * & |
---|
5594 | ( z_n_nuc * 1.0E-6_wp ) * zcv_c * avo * 1.0E-9_wp / 3600.0_wp !< (m/s) |
---|
5595 | zj3 = zjnuc * EXP( MIN( 0.0_wp, -zgamma * zdcrit * zcoagstot / z_gr_tot ) ) ! (#/m3s, Eq.5a) |
---|
5596 | |
---|
5597 | ENDIF |
---|
5598 | ENDIF |
---|
5599 | ! |
---|
5600 | !-- If J3 very small (< 1 #/cm3), neglect particle formation. In real atmosphere this would mean |
---|
5601 | !-- that clusters form but coagulate to pre-existing particles who gain sulphate. Since |
---|
5602 | !-- CoagS ~ CS (4piD*CS'), we do *not* update H2SO4 concentration here but let condensation take |
---|
5603 | !-- care of it. Formation mass rate of molecules (molec/m3s) for 1: H2SO4 and 2: organic vapour |
---|
5604 | pj3n3(1) = zj3 * n3 * pxsa |
---|
5605 | pj3n3(2) = zj3 * n3 * pxocnv |
---|
5606 | |
---|
5607 | END SUBROUTINE nucleation |
---|
5608 | |
---|
5609 | !------------------------------------------------------------------------------! |
---|
5610 | ! Description: |
---|
5611 | ! ------------ |
---|
5612 | !> Calculate the nucleation rate and the size of critical clusters assuming |
---|
5613 | !> binary nucleation. |
---|
5614 | !> Parametrisation according to Vehkamaki et al. (2002), J. Geophys. Res., |
---|
5615 | !> 107(D22), 4622. Called from subroutine nucleation. |
---|
5616 | !------------------------------------------------------------------------------! |
---|
5617 | SUBROUTINE binnucl( pc_sa, ptemp, prh, pnuc_rate, pn_crit_sa, pn_crit_ocnv, pd_crit, pk_sa, & |
---|
5618 | pk_ocnv ) |
---|
5619 | |
---|
5620 | IMPLICIT NONE |
---|
5621 | |
---|
5622 | REAL(wp) :: za !< |
---|
5623 | REAL(wp) :: zb !< |
---|
5624 | REAL(wp) :: zc !< |
---|
5625 | REAL(wp) :: zcoll !< |
---|
5626 | REAL(wp) :: zlogsa !< LOG( zpcsa ) |
---|
5627 | REAL(wp) :: zlogrh !< LOG( zrh ) |
---|
5628 | REAL(wp) :: zm1 !< |
---|
5629 | REAL(wp) :: zm2 !< |
---|
5630 | REAL(wp) :: zma !< |
---|
5631 | REAL(wp) :: zmw !< |
---|
5632 | REAL(wp) :: zntot !< number of molecules in critical cluster |
---|
5633 | REAL(wp) :: zpcsa !< sulfuric acid concentration |
---|
5634 | REAL(wp) :: zrh !< relative humidity |
---|
5635 | REAL(wp) :: zroo !< |
---|
5636 | REAL(wp) :: zt !< temperature |
---|
5637 | REAL(wp) :: zv1 !< |
---|
5638 | REAL(wp) :: zv2 !< |
---|
5639 | REAL(wp) :: zx !< mole fraction of sulphate in critical cluster |
---|
5640 | REAL(wp) :: zxmass !< |
---|
5641 | |
---|
5642 | REAL(wp), INTENT(in) :: pc_sa !< H2SO4 conc. (#/cm3) |
---|
5643 | REAL(wp), INTENT(in) :: prh !< relative humidity [0-1 |
---|
5644 | REAL(wp), INTENT(in) :: ptemp !< ambient temperature (K) |
---|
5645 | |
---|
5646 | REAL(wp), INTENT(out) :: pnuc_rate !< nucleation rate (#/(m3 s)) |
---|
5647 | REAL(wp), INTENT(out) :: pn_crit_sa !< number of H2SO4 molecules in cluster (#) |
---|
5648 | REAL(wp), INTENT(out) :: pn_crit_ocnv !< number of organic molecules in cluster (#) |
---|
5649 | REAL(wp), INTENT(out) :: pd_crit !< diameter of critical cluster (m) |
---|
5650 | REAL(wp), INTENT(out) :: pk_sa !< Lever: if pk_sa = 1, H2SO4 is involved in nucleation. |
---|
5651 | REAL(wp), INTENT(out) :: pk_ocnv !< Lever: if pk_ocnv = 1, organic compounds are involved |
---|
5652 | |
---|
5653 | pnuc_rate = 0.0_wp |
---|
5654 | pd_crit = 1.0E-9_wp |
---|
5655 | ! |
---|
5656 | !-- 1) Checking that we are in the validity range of the parameterization |
---|
5657 | zpcsa = MAX( pc_sa, 1.0E4_wp ) |
---|
5658 | zpcsa = MIN( zpcsa, 1.0E11_wp ) |
---|
5659 | zrh = MAX( prh, 0.0001_wp ) |
---|
5660 | zrh = MIN( zrh, 1.0_wp ) |
---|
5661 | zt = MAX( ptemp, 190.15_wp ) |
---|
5662 | zt = MIN( zt, 300.15_wp ) |
---|
5663 | |
---|
5664 | zlogsa = LOG( zpcsa ) |
---|
5665 | zlogrh = LOG( prh ) |
---|
5666 | ! |
---|
5667 | !-- 2) Mole fraction of sulphate in a critical cluster (Eq. 11) |
---|
5668 | zx = 0.7409967177282139_wp - 0.002663785665140117_wp * zt + & |
---|
5669 | 0.002010478847383187_wp * zlogrh - 0.0001832894131464668_wp* zt * zlogrh + & |
---|
5670 | 0.001574072538464286_wp * zlogrh**2 - 0.00001790589121766952_wp * zt * zlogrh**2 + & |
---|
5671 | 0.0001844027436573778_wp * zlogrh**3 - 1.503452308794887E-6_wp * zt * zlogrh**3 - & |
---|
5672 | 0.003499978417957668_wp * zlogsa + 0.0000504021689382576_wp * zt * zlogsa |
---|
5673 | ! |
---|
5674 | !-- 3) Nucleation rate (Eq. 12) |
---|
5675 | pnuc_rate = 0.1430901615568665_wp + 2.219563673425199_wp * zt - & |
---|
5676 | 0.02739106114964264_wp * zt**2 + 0.00007228107239317088_wp * zt**3 + & |
---|
5677 | 5.91822263375044_wp / zx + 0.1174886643003278_wp * zlogrh + & |
---|
5678 | 0.4625315047693772_wp * zt * zlogrh - 0.01180591129059253_wp * zt**2 * zlogrh + & |
---|
5679 | 0.0000404196487152575_wp * zt**3 * zlogrh + & |
---|
5680 | ( 15.79628615047088_wp * zlogrh ) / zx - 0.215553951893509_wp * zlogrh**2 - & |
---|
5681 | 0.0810269192332194_wp * zt * zlogrh**2 + & |
---|
5682 | 0.001435808434184642_wp * zt**2 * zlogrh**2 - & |
---|
5683 | 4.775796947178588E-6_wp * zt**3 * zlogrh**2 - & |
---|
5684 | ( 2.912974063702185_wp * zlogrh**2 ) / zx - 3.588557942822751_wp * zlogrh**3 + & |
---|
5685 | 0.04950795302831703_wp * zt * zlogrh**3 - & |
---|
5686 | 0.0002138195118737068_wp * zt**2 * zlogrh**3 + & |
---|
5687 | 3.108005107949533E-7_wp * zt**3 * zlogrh**3 - & |
---|
5688 | ( 0.02933332747098296_wp * zlogrh**3 ) / zx + 1.145983818561277_wp * zlogsa - & |
---|
5689 | 0.6007956227856778_wp * zt * zlogsa + 0.00864244733283759_wp * zt**2 * zlogsa - & |
---|
5690 | 0.00002289467254710888_wp * zt**3 * zlogsa - & |
---|
5691 | ( 8.44984513869014_wp * zlogsa ) / zx + 2.158548369286559_wp * zlogrh * zlogsa + & |
---|
5692 | 0.0808121412840917_wp * zt * zlogrh * zlogsa - & |
---|
5693 | 0.0004073815255395214_wp * zt**2 * zlogrh * zlogsa - & |
---|
5694 | 4.019572560156515E-7_wp * zt**3 * zlogrh * zlogsa + & |
---|
5695 | ( 0.7213255852557236_wp * zlogrh * zlogsa ) / zx + & |
---|
5696 | 1.62409850488771_wp * zlogrh**2 * zlogsa - & |
---|
5697 | 0.01601062035325362_wp * zt * zlogrh**2 * zlogsa + & |
---|
5698 | 0.00003771238979714162_wp*zt**2* zlogrh**2 * zlogsa + & |
---|
5699 | 3.217942606371182E-8_wp * zt**3 * zlogrh**2 * zlogsa - & |
---|
5700 | ( 0.01132550810022116_wp * zlogrh**2 * zlogsa ) / zx + & |
---|
5701 | 9.71681713056504_wp * zlogsa**2 - 0.1150478558347306_wp * zt * zlogsa**2 + & |
---|
5702 | 0.0001570982486038294_wp * zt**2 * zlogsa**2 + & |
---|
5703 | 4.009144680125015E-7_wp * zt**3 * zlogsa**2 + & |
---|
5704 | ( 0.7118597859976135_wp * zlogsa**2 ) / zx - & |
---|
5705 | 1.056105824379897_wp * zlogrh * zlogsa**2 + & |
---|
5706 | 0.00903377584628419_wp * zt * zlogrh * zlogsa**2 - & |
---|
5707 | 0.00001984167387090606_wp * zt**2 * zlogrh * zlogsa**2 + & |
---|
5708 | 2.460478196482179E-8_wp * zt**3 * zlogrh * zlogsa**2 - & |
---|
5709 | ( 0.05790872906645181_wp * zlogrh * zlogsa**2 ) / zx - & |
---|
5710 | 0.1487119673397459_wp * zlogsa**3 + 0.002835082097822667_wp * zt * zlogsa**3 - & |
---|
5711 | 9.24618825471694E-6_wp * zt**2 * zlogsa**3 + & |
---|
5712 | 5.004267665960894E-9_wp * zt**3 * zlogsa**3 - & |
---|
5713 | ( 0.01270805101481648_wp * zlogsa**3 ) / zx |
---|
5714 | ! |
---|
5715 | !-- Nucleation rate in #/(cm3 s) |
---|
5716 | pnuc_rate = EXP( pnuc_rate ) |
---|
5717 | ! |
---|
5718 | !-- Check the validity of parameterization |
---|
5719 | IF ( pnuc_rate < 1.0E-7_wp ) THEN |
---|
5720 | pnuc_rate = 0.0_wp |
---|
5721 | pd_crit = 1.0E-9_wp |
---|
5722 | ENDIF |
---|
5723 | ! |
---|
5724 | !-- 4) Total number of molecules in the critical cluster (Eq. 13) |
---|
5725 | zntot = - 0.002954125078716302_wp - 0.0976834264241286_wp * zt + & |
---|
5726 | 0.001024847927067835_wp * zt**2 - 2.186459697726116E-6_wp * zt**3 - & |
---|
5727 | 0.1017165718716887_wp / zx - 0.002050640345231486_wp * zlogrh - & |
---|
5728 | 0.007585041382707174_wp * zt * zlogrh + 0.0001926539658089536_wp * zt**2 * zlogrh - & |
---|
5729 | 6.70429719683894E-7_wp * zt**3 * zlogrh - ( 0.2557744774673163_wp * zlogrh ) / zx + & |
---|
5730 | 0.003223076552477191_wp * zlogrh**2 + 0.000852636632240633_wp * zt * zlogrh**2 - & |
---|
5731 | 0.00001547571354871789_wp * zt**2 * zlogrh**2 + & |
---|
5732 | 5.666608424980593E-8_wp * zt**3 * zlogrh**2 + & |
---|
5733 | ( 0.03384437400744206_wp * zlogrh**2 ) / zx + & |
---|
5734 | 0.04743226764572505_wp * zlogrh**3 - 0.0006251042204583412_wp * zt * zlogrh**3 + & |
---|
5735 | 2.650663328519478E-6_wp * zt**2 * zlogrh**3 - & |
---|
5736 | 3.674710848763778E-9_wp * zt**3 * zlogrh**3 - & |
---|
5737 | ( 0.0002672510825259393_wp * zlogrh**3 ) / zx - 0.01252108546759328_wp * zlogsa + & |
---|
5738 | 0.005806550506277202_wp * zt * zlogsa - 0.0001016735312443444_wp * zt**2 * zlogsa + & |
---|
5739 | 2.881946187214505E-7_wp * zt**3 * zlogsa + ( 0.0942243379396279_wp * zlogsa ) / zx - & |
---|
5740 | 0.0385459592773097_wp * zlogrh * zlogsa - & |
---|
5741 | 0.0006723156277391984_wp * zt * zlogrh * zlogsa + & |
---|
5742 | 2.602884877659698E-6_wp * zt**2 * zlogrh * zlogsa + & |
---|
5743 | 1.194163699688297E-8_wp * zt**3 * zlogrh * zlogsa - & |
---|
5744 | ( 0.00851515345806281_wp * zlogrh * zlogsa ) / zx - & |
---|
5745 | 0.01837488495738111_wp * zlogrh**2 * zlogsa + & |
---|
5746 | 0.0001720723574407498_wp * zt * zlogrh**2 * zlogsa - & |
---|
5747 | 3.717657974086814E-7_wp * zt**2 * zlogrh**2 * zlogsa - & |
---|
5748 | 5.148746022615196E-10_wp * zt**3 * zlogrh**2 * zlogsa + & |
---|
5749 | ( 0.0002686602132926594_wp * zlogrh**2 * zlogsa ) / zx - & |
---|
5750 | 0.06199739728812199_wp * zlogsa**2 + 0.000906958053583576_wp * zt * zlogsa**2 - & |
---|
5751 | 9.11727926129757E-7_wp * zt**2 * zlogsa**2 - & |
---|
5752 | 5.367963396508457E-9_wp * zt**3 * zlogsa**2 - & |
---|
5753 | ( 0.007742343393937707_wp * zlogsa**2 ) / zx + & |
---|
5754 | 0.0121827103101659_wp * zlogrh * zlogsa**2 - & |
---|
5755 | 0.0001066499571188091_wp * zt * zlogrh * zlogsa**2 + & |
---|
5756 | 2.534598655067518E-7_wp * zt**2 * zlogrh * zlogsa**2 - & |
---|
5757 | 3.635186504599571E-10_wp * zt**3 * zlogrh * zlogsa**2 + & |
---|
5758 | ( 0.0006100650851863252_wp * zlogrh * zlogsa **2 ) / zx + & |
---|
5759 | 0.0003201836700403512_wp * zlogsa**3 - 0.0000174761713262546_wp * zt * zlogsa**3 + & |
---|
5760 | 6.065037668052182E-8_wp * zt**2 * zlogsa**3 - & |
---|
5761 | 1.421771723004557E-11_wp * zt**3 * zlogsa**3 + & |
---|
5762 | ( 0.0001357509859501723_wp * zlogsa**3 ) / zx |
---|
5763 | zntot = EXP( zntot ) ! in # |
---|
5764 | ! |
---|
5765 | !-- 5) Size of the critical cluster pd_crit (m) (diameter) (Eq. 14) |
---|
5766 | pn_crit_sa = zx * zntot |
---|
5767 | pd_crit = 2.0E-9_wp * EXP( -1.6524245_wp + 0.42316402_wp * zx + 0.33466487_wp * LOG( zntot ) ) |
---|
5768 | ! |
---|
5769 | !-- 6) Organic compounds not involved when binary nucleation is assumed |
---|
5770 | pn_crit_ocnv = 0.0_wp ! number of organic molecules |
---|
5771 | pk_sa = 1.0_wp ! if = 1, H2SO4 involved in nucleation |
---|
5772 | pk_ocnv = 0.0_wp ! if = 1, organic compounds involved |
---|
5773 | ! |
---|
5774 | !-- Set nucleation rate to collision rate |
---|
5775 | IF ( pn_crit_sa < 4.0_wp ) THEN |
---|
5776 | ! |
---|
5777 | !-- Volumes of the colliding objects |
---|
5778 | zma = 96.0_wp ! molar mass of SO4 in g/mol |
---|
5779 | zmw = 18.0_wp ! molar mass of water in g/mol |
---|
5780 | zxmass = 1.0_wp ! mass fraction of H2SO4 |
---|
5781 | za = 0.7681724_wp + zxmass * ( 2.1847140_wp + zxmass * & |
---|
5782 | ( 7.1630022_wp + zxmass * & |
---|
5783 | ( -44.31447_wp + zxmass * & |
---|
5784 | ( 88.75606 + zxmass * & |
---|
5785 | ( -75.73729_wp + zxmass * 23.43228_wp ) ) ) ) ) |
---|
5786 | zb = 1.808225E-3_wp + zxmass * ( -9.294656E-3_wp + zxmass * & |
---|
5787 | ( -0.03742148_wp + zxmass * & |
---|
5788 | ( 0.2565321_wp + zxmass * & |
---|
5789 | ( -0.5362872_wp + zxmass * & |
---|
5790 | ( 0.4857736 - zxmass * 0.1629592_wp ) ) ) ) ) |
---|
5791 | zc = - 3.478524E-6_wp + zxmass * ( 1.335867E-5_wp + zxmass * & |
---|
5792 | ( 5.195706E-5_wp + zxmass * & |
---|
5793 | ( -3.717636E-4_wp + zxmass * & |
---|
5794 | ( 7.990811E-4_wp + zxmass * & |
---|
5795 | ( -7.458060E-4_wp + zxmass * 2.58139E-4_wp ) ) ) ) ) |
---|
5796 | ! |
---|
5797 | !-- Density for the sulphuric acid solution (Eq. 10 in Vehkamaki) |
---|
5798 | zroo = ( za + zt * ( zb + zc * zt ) ) * 1.0E+3_wp ! (kg/m^3 |
---|
5799 | zm1 = 0.098_wp ! molar mass of H2SO4 in kg/mol |
---|
5800 | zm2 = zm1 |
---|
5801 | zv1 = zm1 / avo / zroo ! volume |
---|
5802 | zv2 = zv1 |
---|
5803 | ! |
---|
5804 | !-- Collision rate |
---|
5805 | zcoll = zpcsa * zpcsa * ( 3.0_wp * pi / 4.0_wp )**0.16666666_wp * & |
---|
5806 | SQRT( 6.0_wp * argas * zt / zm1 + 6.0_wp * argas * zt / zm2 ) * & |
---|
5807 | ( zv1**0.33333333_wp + zv2**0.33333333_wp )**2 * 1.0E+6_wp ! m3 -> cm3 |
---|
5808 | zcoll = MIN( zcoll, 1.0E+10_wp ) |
---|
5809 | pnuc_rate = zcoll ! (#/(cm3 s)) |
---|
5810 | |
---|
5811 | ELSE |
---|
5812 | pnuc_rate = MIN( pnuc_rate, 1.0E+10_wp ) |
---|
5813 | ENDIF |
---|
5814 | pnuc_rate = pnuc_rate * 1.0E+6_wp ! (#/(m3 s)) |
---|
5815 | |
---|
5816 | END SUBROUTINE binnucl |
---|
5817 | |
---|
5818 | !------------------------------------------------------------------------------! |
---|
5819 | ! Description: |
---|
5820 | ! ------------ |
---|
5821 | !> Calculate the nucleation rate and the size of critical clusters assuming |
---|
5822 | !> ternary nucleation. Parametrisation according to: |
---|
5823 | !> Napari et al. (2002), J. Chem. Phys., 116, 4221-4227 and |
---|
5824 | !> Napari et al. (2002), J. Geophys. Res., 107(D19), AAC 6-1-ACC 6-6. |
---|
5825 | !------------------------------------------------------------------------------! |
---|
5826 | SUBROUTINE ternucl( pc_sa, pc_nh3, ptemp, prh, pnuc_rate, pn_crit_sa, pn_crit_ocnv, pd_crit, & |
---|
5827 | pk_sa, pk_ocnv ) |
---|
5828 | |
---|
5829 | IMPLICIT NONE |
---|
5830 | |
---|
5831 | REAL(wp) :: zlnj !< logarithm of nucleation rate |
---|
5832 | REAL(wp) :: zlognh3 !< LOG( pc_nh3 ) |
---|
5833 | REAL(wp) :: zlogrh !< LOG( prh ) |
---|
5834 | REAL(wp) :: zlogsa !< LOG( pc_sa ) |
---|
5835 | |
---|
5836 | REAL(wp), INTENT(in) :: pc_nh3 !< ammonia mixing ratio (ppt) |
---|
5837 | REAL(wp), INTENT(in) :: pc_sa !< H2SO4 conc. (#/cm3) |
---|
5838 | REAL(wp), INTENT(in) :: prh !< relative humidity [0-1] |
---|
5839 | REAL(wp), INTENT(in) :: ptemp !< ambient temperature (K) |
---|
5840 | |
---|
5841 | REAL(wp), INTENT(out) :: pd_crit !< diameter of critical cluster (m) |
---|
5842 | REAL(wp), INTENT(out) :: pk_ocnv !< if pk_ocnv = 1, organic compounds participate in nucleation |
---|
5843 | REAL(wp), INTENT(out) :: pk_sa !< if pk_sa = 1, H2SO4 participate in nucleation |
---|
5844 | REAL(wp), INTENT(out) :: pn_crit_ocnv !< number of organic molecules in cluster (#) |
---|
5845 | REAL(wp), INTENT(out) :: pn_crit_sa !< number of H2SO4 molecules in cluster (#) |
---|
5846 | REAL(wp), INTENT(out) :: pnuc_rate !< nucleation rate (#/(m3 s)) |
---|
5847 | ! |
---|
5848 | !-- 1) Checking that we are in the validity range of the parameterization. |
---|
5849 | !-- Validity of parameterization : DO NOT REMOVE! |
---|
5850 | IF ( ptemp < 240.0_wp .OR. ptemp > 300.0_wp ) THEN |
---|
5851 | message_string = 'Invalid input value: ptemp' |
---|
5852 | CALL message( 'salsa_mod: ternucl', 'PA0689', 1, 2, 0, 6, 0 ) |
---|
5853 | ENDIF |
---|
5854 | IF ( prh < 0.05_wp .OR. prh > 0.95_wp ) THEN |
---|
5855 | message_string = 'Invalid input value: prh' |
---|
5856 | CALL message( 'salsa_mod: ternucl', 'PA0649', 1, 2, 0, 6, 0 ) |
---|
5857 | ENDIF |
---|
5858 | IF ( pc_sa < 1.0E+4_wp .OR. pc_sa > 1.0E+9_wp ) THEN |
---|
5859 | message_string = 'Invalid input value: pc_sa' |
---|
5860 | CALL message( 'salsa_mod: ternucl', 'PA0650', 1, 2, 0, 6, 0 ) |
---|
5861 | ENDIF |
---|
5862 | IF ( pc_nh3 < 0.1_wp .OR. pc_nh3 > 100.0_wp ) THEN |
---|
5863 | message_string = 'Invalid input value: pc_nh3' |
---|
5864 | CALL message( 'salsa_mod: ternucl', 'PA0651', 1, 2, 0, 6, 0 ) |
---|
5865 | ENDIF |
---|
5866 | |
---|
5867 | zlognh3 = LOG( pc_nh3 ) |
---|
5868 | zlogrh = LOG( prh ) |
---|
5869 | zlogsa = LOG( pc_sa ) |
---|
5870 | ! |
---|
5871 | !-- 2) Nucleation rate (Eq. 7 in Napari et al., 2002: Parameterization of |
---|
5872 | !-- ternary nucleation of sulfuric acid - ammonia - water. |
---|
5873 | zlnj = - 84.7551114741543_wp + 0.3117595133628944_wp * prh + & |
---|
5874 | 1.640089605712946_wp * prh * ptemp - 0.003438516933381083_wp * prh * ptemp**2 - & |
---|
5875 | 0.00001097530402419113_wp * prh * ptemp**3 - 0.3552967070274677_wp / zlogsa - & |
---|
5876 | ( 0.06651397829765026_wp * prh ) / zlogsa - ( 33.84493989762471_wp * ptemp ) / zlogsa - & |
---|
5877 | ( 7.823815852128623_wp * prh * ptemp ) / zlogsa + & |
---|
5878 | ( 0.3453602302090915_wp * ptemp**2 ) / zlogsa + & |
---|
5879 | ( 0.01229375748100015_wp * prh * ptemp**2 ) / zlogsa - & |
---|
5880 | ( 0.000824007160514956_wp *ptemp**3 ) / zlogsa + & |
---|
5881 | ( 0.00006185539100670249_wp * prh * ptemp**3 ) / zlogsa + & |
---|
5882 | 3.137345238574998_wp * zlogsa + 3.680240980277051_wp * prh * zlogsa - & |
---|
5883 | 0.7728606202085936_wp * ptemp * zlogsa - 0.204098217156962_wp * prh * ptemp * zlogsa + & |
---|
5884 | 0.005612037586790018_wp * ptemp**2 * zlogsa + & |
---|
5885 | 0.001062588391907444_wp * prh * ptemp**2 * zlogsa - & |
---|
5886 | 9.74575691760229E-6_wp * ptemp**3 * zlogsa - & |
---|
5887 | 1.265595265137352E-6_wp * prh * ptemp**3 * zlogsa + 19.03593713032114_wp * zlogsa**2 - & |
---|
5888 | 0.1709570721236754_wp * ptemp * zlogsa**2 + & |
---|
5889 | 0.000479808018162089_wp * ptemp**2 * zlogsa**2 - & |
---|
5890 | 4.146989369117246E-7_wp * ptemp**3 * zlogsa**2 + 1.076046750412183_wp * zlognh3 + & |
---|
5891 | 0.6587399318567337_wp * prh * zlognh3 + 1.48932164750748_wp * ptemp * zlognh3 + & |
---|
5892 | 0.1905424394695381_wp * prh * ptemp * zlognh3 - & |
---|
5893 | 0.007960522921316015_wp * ptemp**2 * zlognh3 - & |
---|
5894 | 0.001657184248661241_wp * prh * ptemp**2 * zlognh3 + & |
---|
5895 | 7.612287245047392E-6_wp * ptemp**3 * zlognh3 + & |
---|
5896 | 3.417436525881869E-6_wp * prh * ptemp**3 * zlognh3 + & |
---|
5897 | ( 0.1655358260404061_wp * zlognh3 ) / zlogsa + & |
---|
5898 | ( 0.05301667612522116_wp * prh * zlognh3 ) / zlogsa + & |
---|
5899 | ( 3.26622914116752_wp * ptemp * zlognh3 ) / zlogsa - & |
---|
5900 | ( 1.988145079742164_wp * prh * ptemp * zlognh3 ) / zlogsa - & |
---|
5901 | ( 0.04897027401984064_wp * ptemp**2 * zlognh3 ) / zlogsa + & |
---|
5902 | ( 0.01578269253599732_wp * prh * ptemp**2 * zlognh3 ) / zlogsa + & |
---|
5903 | ( 0.0001469672236351303_wp * ptemp**3 * zlognh3 ) / zlogsa - & |
---|
5904 | ( 0.00002935642836387197_wp * prh * ptemp**3 *zlognh3 ) / zlogsa + & |
---|
5905 | 6.526451177887659_wp * zlogsa * zlognh3 - & |
---|
5906 | 0.2580021816722099_wp * ptemp * zlogsa * zlognh3 + & |
---|
5907 | 0.001434563104474292_wp * ptemp**2 * zlogsa * zlognh3 - & |
---|
5908 | 2.020361939304473E-6_wp * ptemp**3 * zlogsa * zlognh3 - & |
---|
5909 | 0.160335824596627_wp * zlogsa**2 * zlognh3 + & |
---|
5910 | 0.00889880721460806_wp * ptemp * zlogsa**2 * zlognh3 - & |
---|
5911 | 0.00005395139051155007_wp * ptemp**2 * zlogsa**2 * zlognh3 + & |
---|
5912 | 8.39521718689596E-8_wp * ptemp**3 * zlogsa**2 * zlognh3 + & |
---|
5913 | 6.091597586754857_wp * zlognh3**2 + 8.5786763679309_wp * prh * zlognh3**2 - & |
---|
5914 | 1.253783854872055_wp * ptemp * zlognh3**2 - & |
---|
5915 | 0.1123577232346848_wp * prh * ptemp * zlognh3**2 + & |
---|
5916 | 0.00939835595219825_wp * ptemp**2 * zlognh3**2 + & |
---|
5917 | 0.0004726256283031513_wp * prh * ptemp**2 * zlognh3**2 - & |
---|
5918 | 0.00001749269360523252_wp * ptemp**3 * zlognh3**2 - & |
---|
5919 | 6.483647863710339E-7_wp * prh * ptemp**3 * zlognh3**2 + & |
---|
5920 | ( 0.7284285726576598_wp * zlognh3**2 ) / zlogsa + & |
---|
5921 | ( 3.647355600846383_wp * ptemp * zlognh3**2 ) / zlogsa - & |
---|
5922 | ( 0.02742195276078021_wp * ptemp**2 * zlognh3**2 ) / zlogsa + & |
---|
5923 | ( 0.00004934777934047135_wp * ptemp**3 * zlognh3**2 ) / zlogsa + & |
---|
5924 | 41.30162491567873_wp * zlogsa * zlognh3**2 - & |
---|
5925 | 0.357520416800604_wp * ptemp * zlogsa * zlognh3**2 + & |
---|
5926 | 0.000904383005178356_wp * ptemp**2 * zlogsa * zlognh3**2 - & |
---|
5927 | 5.737876676408978E-7_wp * ptemp**3 * zlogsa * zlognh3**2 - & |
---|
5928 | 2.327363918851818_wp * zlogsa**2 * zlognh3**2 + & |
---|
5929 | 0.02346464261919324_wp * ptemp * zlogsa**2 * zlognh3**2 - & |
---|
5930 | 0.000076518969516405_wp * ptemp**2 * zlogsa**2 * zlognh3**2 + & |
---|
5931 | 8.04589834836395E-8_wp * ptemp**3 * zlogsa**2 * zlognh3**2 - & |
---|
5932 | 0.02007379204248076_wp * zlogrh - 0.7521152446208771_wp * ptemp * zlogrh + & |
---|
5933 | 0.005258130151226247_wp * ptemp**2 * zlogrh - & |
---|
5934 | 8.98037634284419E-6_wp * ptemp**3 * zlogrh + & |
---|
5935 | ( 0.05993213079516759_wp * zlogrh ) / zlogsa + & |
---|
5936 | ( 5.964746463184173_wp * ptemp * zlogrh ) / zlogsa - & |
---|
5937 | ( 0.03624322255690942_wp * ptemp**2 * zlogrh ) / zlogsa + & |
---|
5938 | ( 0.00004933369382462509_wp * ptemp**3 * zlogrh ) / zlogsa - & |
---|
5939 | 0.7327310805365114_wp * zlognh3 * zlogrh - & |
---|
5940 | 0.01841792282958795_wp * ptemp * zlognh3 * zlogrh + & |
---|
5941 | 0.0001471855981005184_wp * ptemp**2 * zlognh3 * zlogrh - & |
---|
5942 | 2.377113195631848E-7_wp * ptemp**3 * zlognh3 * zlogrh |
---|
5943 | pnuc_rate = EXP( zlnj ) ! (#/(cm3 s)) |
---|
5944 | ! |
---|
5945 | !-- Check validity of parametrization |
---|
5946 | IF ( pnuc_rate < 1.0E-5_wp ) THEN |
---|
5947 | pnuc_rate = 0.0_wp |
---|
5948 | pd_crit = 1.0E-9_wp |
---|
5949 | ELSEIF ( pnuc_rate > 1.0E6_wp ) THEN |
---|
5950 | message_string = 'Invalid output value: nucleation rate > 10^6 1/cm3s' |
---|
5951 | CALL message( 'salsa_mod: ternucl', 'PA0623', 1, 2, 0, 6, 0 ) |
---|
5952 | ENDIF |
---|
5953 | pnuc_rate = pnuc_rate * 1.0E6_wp ! (#/(m3 s)) |
---|
5954 | ! |
---|
5955 | !-- 3) Number of H2SO4 molecules in a critical cluster (Eq. 9) |
---|
5956 | pn_crit_sa = 38.16448247950508_wp + 0.7741058259731187_wp * zlnj + & |
---|
5957 | 0.002988789927230632_wp * zlnj**2 - 0.3576046920535017_wp * ptemp - & |
---|
5958 | 0.003663583011953248_wp * zlnj * ptemp + 0.000855300153372776_wp * ptemp**2 |
---|
5959 | ! |
---|
5960 | !-- Kinetic limit: at least 2 H2SO4 molecules in a cluster |
---|
5961 | pn_crit_sa = MAX( pn_crit_sa, 2.0E0_wp ) |
---|
5962 | ! |
---|
5963 | !-- 4) Size of the critical cluster in nm (Eq. 12) |
---|
5964 | pd_crit = 0.1410271086638381_wp - 0.001226253898894878_wp * zlnj - & |
---|
5965 | 7.822111731550752E-6_wp * zlnj**2 - 0.001567273351921166_wp * ptemp - & |
---|
5966 | 0.00003075996088273962_wp * zlnj * ptemp + 0.00001083754117202233_wp * ptemp**2 |
---|
5967 | pd_crit = pd_crit * 2.0E-9_wp ! Diameter in m |
---|
5968 | ! |
---|
5969 | !-- 5) Organic compounds not involved when ternary nucleation assumed |
---|
5970 | pn_crit_ocnv = 0.0_wp |
---|
5971 | pk_sa = 1.0_wp |
---|
5972 | pk_ocnv = 0.0_wp |
---|
5973 | |
---|
5974 | END SUBROUTINE ternucl |
---|
5975 | |
---|
5976 | !------------------------------------------------------------------------------! |
---|
5977 | ! Description: |
---|
5978 | ! ------------ |
---|
5979 | !> Function z_n_nuc_tayl is connected to the calculation of self-coagualtion of |
---|
5980 | !> small particles. It calculates number of the particles in the size range |
---|
5981 | !> [zdcrit,dx] using Taylor-expansion (please note that the expansion is not |
---|
5982 | !> valid for certain rational numbers, e.g. -4/3 and -3/2) |
---|
5983 | !------------------------------------------------------------------------------! |
---|
5984 | FUNCTION z_n_nuc_tayl( d1, dx, zm_para, zjnuc_t, zeta, z_gr_tot ) |
---|
5985 | |
---|
5986 | IMPLICIT NONE |
---|
5987 | |
---|
5988 | INTEGER(iwp) :: i !< running index |
---|
5989 | |
---|
5990 | REAL(wp) :: d1 !< lower diameter limit |
---|
5991 | REAL(wp) :: dx !< upper diameter limit |
---|
5992 | REAL(wp) :: zjnuc_t !< initial nucleation rate (1/s) |
---|
5993 | REAL(wp) :: zeta !< ratio of CS/GR (m) (condensation sink / growth rate) |
---|
5994 | REAL(wp) :: term1 !< |
---|
5995 | REAL(wp) :: term2 !< |
---|
5996 | REAL(wp) :: term3 !< |
---|
5997 | REAL(wp) :: term4 !< |
---|
5998 | REAL(wp) :: term5 !< |
---|
5999 | REAL(wp) :: z_n_nuc_tayl !< final nucleation rate (1/s) |
---|
6000 | REAL(wp) :: z_gr_tot !< total growth rate (nm/h) |
---|
6001 | REAL(wp) :: zm_para !< m parameter in Lehtinen et al. (2007), Eq. 6 |
---|
6002 | |
---|
6003 | z_n_nuc_tayl = 0.0_wp |
---|
6004 | |
---|
6005 | DO i = 0, 29 |
---|
6006 | IF ( i == 0 .OR. i == 1 ) THEN |
---|
6007 | term1 = 1.0_wp |
---|
6008 | ELSE |
---|
6009 | term1 = term1 * REAL( i, SELECTED_REAL_KIND(12,307) ) |
---|
6010 | END IF |
---|
6011 | term2 = ( REAL( i, SELECTED_REAL_KIND(12,307) ) * ( zm_para + 1.0_wp ) + 1.0_wp ) * term1 |
---|
6012 | term3 = zeta**i |
---|
6013 | term4 = term3 / term2 |
---|
6014 | term5 = REAL( i, SELECTED_REAL_KIND(12,307) ) * ( zm_para + 1.0_wp ) + 1.0_wp |
---|
6015 | z_n_nuc_tayl = z_n_nuc_tayl + term4 * ( dx**term5 - d1**term5 ) |
---|
6016 | ENDDO |
---|
6017 | z_n_nuc_tayl = z_n_nuc_tayl * zjnuc_t * EXP( -zeta * ( d1**( zm_para + 1 ) ) ) / z_gr_tot |
---|
6018 | |
---|
6019 | END FUNCTION z_n_nuc_tayl |
---|
6020 | |
---|
6021 | !------------------------------------------------------------------------------! |
---|
6022 | ! Description: |
---|
6023 | ! ------------ |
---|
6024 | !> Calculates the condensation of water vapour on aerosol particles. Follows the |
---|
6025 | !> analytical predictor method by Jacobson (2005). |
---|
6026 | !> For equations, see Jacobson (2005), Fundamentals of atmospheric modelling |
---|
6027 | !> (2nd edition). |
---|
6028 | !------------------------------------------------------------------------------! |
---|
6029 | SUBROUTINE gpparth2o( paero, ptemp, ppres, pcs, pcw, ptstep ) |
---|
6030 | |
---|
6031 | IMPLICIT NONE |
---|
6032 | |
---|
6033 | INTEGER(iwp) :: ib !< loop index |
---|
6034 | INTEGER(iwp) :: nstr !< |
---|
6035 | |
---|
6036 | REAL(wp) :: adt !< internal timestep in this subroutine |
---|
6037 | REAL(wp) :: rhoair !< air density (kg/m3) |
---|
6038 | REAL(wp) :: ttot !< total time (s) |
---|
6039 | REAL(wp) :: zact !< Water activity |
---|
6040 | REAL(wp) :: zaelwc1 !< Current aerosol water content (kg/m3) |
---|
6041 | REAL(wp) :: zaelwc2 !< New aerosol water content after equilibrium calculation (kg/m3) |
---|
6042 | REAL(wp) :: zbeta !< Transitional correction factor |
---|
6043 | REAL(wp) :: zcwc !< Current water vapour mole concentration in aerosols (mol/m3) |
---|
6044 | REAL(wp) :: zcwint !< Current and new water vapour mole concentrations (mol/m3) |
---|
6045 | REAL(wp) :: zcwn !< New water vapour mole concentration (mol/m3) |
---|
6046 | REAL(wp) :: zcwtot !< Total water mole concentration (mol/m3) |
---|
6047 | REAL(wp) :: zdfh2o !< molecular diffusion coefficient (cm2/s) for water |
---|
6048 | REAL(wp) :: zhlp1 !< intermediate variable to calculate the mass transfer coefficient |
---|
6049 | REAL(wp) :: zhlp2 !< intermediate variable to calculate the mass transfer coefficient |
---|
6050 | REAL(wp) :: zhlp3 !< intermediate variable to calculate the mass transfer coefficient |
---|
6051 | REAL(wp) :: zknud !< Knudsen number |
---|
6052 | REAL(wp) :: zmfph2o !< mean free path of H2O gas molecule |
---|
6053 | REAL(wp) :: zrh !< relative humidity [0-1] |
---|
6054 | REAL(wp) :: zthcond !< thermal conductivity of air (W/m/K) |
---|
6055 | |
---|
6056 | REAL(wp), DIMENSION(nbins_aerosol) :: zcwcae !< Current water mole concentrations |
---|
6057 | REAL(wp), DIMENSION(nbins_aerosol) :: zcwintae !< Current and new aerosol water mole concentration |
---|
6058 | REAL(wp), DIMENSION(nbins_aerosol) :: zcwnae !< New water mole concentration in aerosols |
---|
6059 | REAL(wp), DIMENSION(nbins_aerosol) :: zcwsurfae !< Surface mole concentration |
---|
6060 | REAL(wp), DIMENSION(nbins_aerosol) :: zkelvin !< Kelvin effect |
---|
6061 | REAL(wp), DIMENSION(nbins_aerosol) :: zmtae !< Mass transfer coefficients |
---|
6062 | REAL(wp), DIMENSION(nbins_aerosol) :: zwsatae !< Water saturation ratio above aerosols |
---|
6063 | |
---|
6064 | REAL(wp), INTENT(in) :: ppres !< Air pressure (Pa) |
---|
6065 | REAL(wp), INTENT(in) :: pcs !< Water vapour saturation concentration (kg/m3) |
---|
6066 | REAL(wp), INTENT(in) :: ptemp !< Ambient temperature (K) |
---|
6067 | REAL(wp), INTENT(in) :: ptstep !< timestep (s) |
---|
6068 | |
---|
6069 | REAL(wp), INTENT(inout) :: pcw !< Water vapour concentration (kg/m3) |
---|
6070 | |
---|
6071 | TYPE(t_section), DIMENSION(nbins_aerosol), INTENT(inout) :: paero !< Aerosol properties |
---|
6072 | ! |
---|
6073 | !-- Relative humidity [0-1] |
---|
6074 | zrh = pcw / pcs |
---|
6075 | ! |
---|
6076 | !-- Calculate the condensation only for 2a/2b aerosol bins |
---|
6077 | nstr = start_subrange_2a |
---|
6078 | ! |
---|
6079 | !-- Save the current aerosol water content, 8 in paero is H2O |
---|
6080 | zaelwc1 = SUM( paero(start_subrange_1a:end_subrange_2b)%volc(8) ) * arhoh2o |
---|
6081 | ! |
---|
6082 | !-- Equilibration: |
---|
6083 | IF ( advect_particle_water ) THEN |
---|
6084 | IF ( zrh < 0.98_wp .OR. .NOT. lscndh2oae ) THEN |
---|
6085 | CALL equilibration( zrh, ptemp, paero, .TRUE. ) |
---|
6086 | ELSE |
---|
6087 | CALL equilibration( zrh, ptemp, paero, .FALSE. ) |
---|
6088 | ENDIF |
---|
6089 | ENDIF |
---|
6090 | ! |
---|
6091 | !-- The new aerosol water content after equilibrium calculation |
---|
6092 | zaelwc2 = SUM( paero(start_subrange_1a:end_subrange_2b)%volc(8) ) * arhoh2o |
---|
6093 | ! |
---|
6094 | !-- New water vapour mixing ratio (kg/m3) |
---|
6095 | pcw = pcw - ( zaelwc2 - zaelwc1 ) * ppres * amdair / ( argas * ptemp ) |
---|
6096 | ! |
---|
6097 | !-- Initialise variables |
---|
6098 | zcwsurfae(:) = 0.0_wp |
---|
6099 | zhlp1 = 0.0_wp |
---|
6100 | zhlp2 = 0.0_wp |
---|
6101 | zhlp3 = 0.0_wp |
---|
6102 | zmtae(:) = 0.0_wp |
---|
6103 | zwsatae(:) = 0.0_wp |
---|
6104 | ! |
---|
6105 | !-- Air: |
---|
6106 | !-- Density (kg/m3) |
---|
6107 | rhoair = amdair * ppres / ( argas * ptemp ) |
---|
6108 | ! |
---|
6109 | !-- Thermal conductivity of air |
---|
6110 | zthcond = 0.023807_wp + 7.1128E-5_wp * ( ptemp - 273.16_wp ) |
---|
6111 | ! |
---|
6112 | !-- Water vapour: |
---|
6113 | !-- Molecular diffusion coefficient (cm2/s) (eq.16.17) |
---|
6114 | zdfh2o = ( 5.0_wp / ( 16.0_wp * avo * rhoair * 1.0E-3_wp * 3.11E-8_wp**2 ) ) * SQRT( argas * & |
---|
6115 | 1.0E+7_wp * ptemp * amdair * 1.0E+3_wp * ( amh2o + amdair ) * 1.0E+3_wp / & |
---|
6116 | ( pi * amh2o * 2.0E+3_wp ) ) |
---|
6117 | zdfh2o = zdfh2o * 1.0E-4 ! Unit change to m^2/s |
---|
6118 | ! |
---|
6119 | !-- Mean free path (eq. 15.25 & 16.29) |
---|
6120 | zmfph2o = 3.0_wp * zdfh2o * SQRT( pi * amh2o / ( 8.0_wp * argas * ptemp ) ) |
---|
6121 | ! |
---|
6122 | !-- Kelvin effect (eq. 16.33) |
---|
6123 | zkelvin(:) = EXP( 4.0_wp * surfw0 * amh2o / ( argas * ptemp * arhoh2o * paero(:)%dwet) ) |
---|
6124 | |
---|
6125 | DO ib = 1, nbins_aerosol |
---|
6126 | IF ( paero(ib)%numc > nclim .AND. zrh > 0.98_wp ) THEN |
---|
6127 | ! |
---|
6128 | !-- Water activity |
---|
6129 | zact = acth2o( paero(ib) ) |
---|
6130 | ! |
---|
6131 | !-- Saturation mole concentration over flat surface. Limit the super- |
---|
6132 | !-- saturation to max 1.01 for the mass transfer. Experimental! |
---|
6133 | zcwsurfae(ib) = MAX( pcs, pcw / 1.01_wp ) * rhoair / amh2o |
---|
6134 | ! |
---|
6135 | !-- Equilibrium saturation ratio |
---|
6136 | zwsatae(ib) = zact * zkelvin(ib) |
---|
6137 | ! |
---|
6138 | !-- Knudsen number (eq. 16.20) |
---|
6139 | zknud = 2.0_wp * zmfph2o / paero(ib)%dwet |
---|
6140 | ! |
---|
6141 | !-- Transitional correction factor (Fuks & Sutugin, 1971) |
---|
6142 | zbeta = ( zknud + 1.0_wp ) / ( 0.377_wp * zknud + 1.0_wp + 4.0_wp / & |
---|
6143 | ( 3.0_wp * massacc(ib) ) * ( zknud + zknud**2 ) ) |
---|
6144 | ! |
---|
6145 | !-- Mass transfer of H2O: Eq. 16.64 but here D^eff = zdfh2o * zbeta |
---|
6146 | zhlp1 = paero(ib)%numc * 2.0_wp * pi * paero(ib)%dwet * zdfh2o * zbeta |
---|
6147 | ! |
---|
6148 | !-- 1st term on the left side of the denominator in eq. 16.55 |
---|
6149 | zhlp2 = amh2o * zdfh2o * alv * zwsatae(ib) * zcwsurfae(ib) / ( zthcond * ptemp ) |
---|
6150 | ! |
---|
6151 | !-- 2nd term on the left side of the denominator in eq. 16.55 |
---|
6152 | zhlp3 = ( ( alv * amh2o ) / ( argas * ptemp ) ) - 1.0_wp |
---|
6153 | ! |
---|
6154 | !-- Full eq. 16.64: Mass transfer coefficient (1/s) |
---|
6155 | zmtae(ib) = zhlp1 / ( zhlp2 * zhlp3 + 1.0_wp ) |
---|
6156 | ENDIF |
---|
6157 | ENDDO |
---|
6158 | ! |
---|
6159 | !-- Current mole concentrations of water |
---|
6160 | zcwc = pcw * rhoair / amh2o ! as vapour |
---|
6161 | zcwcae(:) = paero(:)%volc(8) * arhoh2o / amh2o ! in aerosols |
---|
6162 | zcwtot = zcwc + SUM( zcwcae ) ! total water concentration |
---|
6163 | zcwnae(:) = 0.0_wp |
---|
6164 | zcwintae(:) = zcwcae(:) |
---|
6165 | ! |
---|
6166 | !-- Substepping loop |
---|
6167 | zcwint = 0.0_wp |
---|
6168 | ttot = 0.0_wp |
---|
6169 | DO WHILE ( ttot < ptstep ) |
---|
6170 | adt = 2.0E-2_wp ! internal timestep |
---|
6171 | ! |
---|
6172 | !-- New vapour concentration: (eq. 16.71) |
---|
6173 | zhlp1 = zcwc + adt * ( SUM( zmtae(nstr:nbins_aerosol) * zwsatae(nstr:nbins_aerosol) * & |
---|
6174 | zcwsurfae(nstr:nbins_aerosol) ) ) ! numerator |
---|
6175 | zhlp2 = 1.0_wp + adt * ( SUM( zmtae(nstr:nbins_aerosol) ) ) ! denomin. |
---|
6176 | zcwint = zhlp1 / zhlp2 ! new vapour concentration |
---|
6177 | zcwint = MIN( zcwint, zcwtot ) |
---|
6178 | IF ( ANY( paero(:)%numc > nclim ) .AND. zrh > 0.98_wp ) THEN |
---|
6179 | DO ib = nstr, nbins_aerosol |
---|
6180 | zcwintae(ib) = zcwcae(ib) + MIN( MAX( adt * zmtae(ib) * ( zcwint - zwsatae(ib) * & |
---|
6181 | zcwsurfae(ib) ), -0.02_wp * zcwcae(ib) ), & |
---|
6182 | 0.05_wp * zcwcae(ib) ) |
---|
6183 | zwsatae(ib) = acth2o( paero(ib), zcwintae(ib) ) * zkelvin(ib) |
---|
6184 | ENDDO |
---|
6185 | ENDIF |
---|
6186 | zcwintae(nstr:nbins_aerosol) = MAX( zcwintae(nstr:nbins_aerosol), 0.0_wp ) |
---|
6187 | ! |
---|
6188 | !-- Update vapour concentration for consistency |
---|
6189 | zcwint = zcwtot - SUM( zcwintae(1:nbins_aerosol) ) |
---|
6190 | ! |
---|
6191 | !-- Update "old" values for next cycle |
---|
6192 | zcwcae = zcwintae |
---|
6193 | |
---|
6194 | ttot = ttot + adt |
---|
6195 | |
---|
6196 | ENDDO ! ADT |
---|
6197 | |
---|
6198 | zcwn = zcwint |
---|
6199 | zcwnae(:) = zcwintae(:) |
---|
6200 | pcw = zcwn * amh2o / rhoair |
---|
6201 | paero(:)%volc(8) = MAX( 0.0_wp, zcwnae(:) * amh2o / arhoh2o ) |
---|
6202 | |
---|
6203 | END SUBROUTINE gpparth2o |
---|
6204 | |
---|
6205 | !------------------------------------------------------------------------------! |
---|
6206 | ! Description: |
---|
6207 | ! ------------ |
---|
6208 | !> Calculates the activity coefficient of liquid water |
---|
6209 | !------------------------------------------------------------------------------! |
---|
6210 | REAL(wp) FUNCTION acth2o( ppart, pcw ) |
---|
6211 | |
---|
6212 | IMPLICIT NONE |
---|
6213 | |
---|
6214 | REAL(wp) :: zns !< molar concentration of solutes (mol/m3) |
---|
6215 | REAL(wp) :: znw !< molar concentration of water (mol/m3) |
---|
6216 | |
---|
6217 | REAL(wp), INTENT(in), OPTIONAL :: pcw !< molar concentration of water (mol/m3) |
---|
6218 | |
---|
6219 | TYPE(t_section), INTENT(in) :: ppart !< Aerosol properties of a bin |
---|
6220 | |
---|
6221 | zns = ( 3.0_wp * ( ppart%volc(1) * arhoh2so4 / amh2so4 ) + ( ppart%volc(2) * arhooc / amoc ) + & |
---|
6222 | 2.0_wp * ( ppart%volc(5) * arhoss / amss ) + ( ppart%volc(6) * arhohno3 / amhno3 ) + & |
---|
6223 | ( ppart%volc(7) * arhonh3 / amnh3 ) ) |
---|
6224 | |
---|
6225 | IF ( PRESENT(pcw) ) THEN |
---|
6226 | znw = pcw |
---|
6227 | ELSE |
---|
6228 | znw = ppart%volc(8) * arhoh2o / amh2o |
---|
6229 | ENDIF |
---|
6230 | ! |
---|
6231 | !-- Activity = partial pressure of water vapour / sat. vapour pressure of water over a liquid surface |
---|
6232 | !-- = molality * activity coefficient (Jacobson, 2005: eq. 17.20-21) |
---|
6233 | !-- Assume activity coefficient of 1 for water |
---|
6234 | acth2o = MAX( 0.1_wp, znw / MAX( EPSILON( 1.0_wp ),( znw + zns ) ) ) |
---|
6235 | |
---|
6236 | END FUNCTION acth2o |
---|
6237 | |
---|
6238 | !------------------------------------------------------------------------------! |
---|
6239 | ! Description: |
---|
6240 | ! ------------ |
---|
6241 | !> Calculates the dissolutional growth of particles (i.e. gas transfers to a |
---|
6242 | !> particle surface and dissolves in liquid water on the surface). Treated here |
---|
6243 | !> as a non-equilibrium (time-dependent) process. Gases: HNO3 and NH3 |
---|
6244 | !> (Chapter 17.14 in Jacobson, 2005). |
---|
6245 | ! |
---|
6246 | !> Called from subroutine condensation. |
---|
6247 | !> Coded by: |
---|
6248 | !> Harri Kokkola (FMI) |
---|
6249 | !------------------------------------------------------------------------------! |
---|
6250 | SUBROUTINE gpparthno3( ppres, ptemp, paero, pghno3, pgnh3, pcw, pcs, pbeta, ptstep ) |
---|
6251 | |
---|
6252 | IMPLICIT NONE |
---|
6253 | |
---|
6254 | INTEGER(iwp) :: ib !< loop index |
---|
6255 | |
---|
6256 | REAL(wp) :: adt !< timestep |
---|
6257 | REAL(wp) :: zc_nh3_c !< Current NH3 gas concentration |
---|
6258 | REAL(wp) :: zc_nh3_int !< Intermediate NH3 gas concentration |
---|
6259 | REAL(wp) :: zc_nh3_n !< New NH3 gas concentration |
---|
6260 | REAL(wp) :: zc_nh3_tot !< Total NH3 concentration |
---|
6261 | REAL(wp) :: zc_hno3_c !< Current HNO3 gas concentration |
---|
6262 | REAL(wp) :: zc_hno3_int !< Intermediate HNO3 gas concentration |
---|
6263 | REAL(wp) :: zc_hno3_n !< New HNO3 gas concentration |
---|
6264 | REAL(wp) :: zc_hno3_tot !< Total HNO3 concentration |
---|
6265 | REAL(wp) :: zdfvap !< Diffusion coefficient for vapors |
---|
6266 | REAL(wp) :: zhlp1 !< intermediate variable |
---|
6267 | REAL(wp) :: zhlp2 !< intermediate variable |
---|
6268 | REAL(wp) :: zrh !< relative humidity |
---|
6269 | |
---|
6270 | REAL(wp), INTENT(in) :: ppres !< ambient pressure (Pa) |
---|
6271 | REAL(wp), INTENT(in) :: pcs !< water vapour saturation |
---|
6272 | !< concentration (kg/m3) |
---|
6273 | REAL(wp), INTENT(in) :: ptemp !< ambient temperature (K) |
---|
6274 | REAL(wp), INTENT(in) :: ptstep !< time step (s) |
---|
6275 | |
---|
6276 | REAL(wp), INTENT(inout) :: pghno3 !< nitric acid concentration (#/m3) |
---|
6277 | REAL(wp), INTENT(inout) :: pgnh3 !< ammonia conc. (#/m3) |
---|
6278 | REAL(wp), INTENT(inout) :: pcw !< water vapour concentration (kg/m3) |
---|
6279 | |
---|
6280 | REAL(wp), DIMENSION(nbins_aerosol) :: zac_hno3_ae !< Activity coefficients for HNO3 |
---|
6281 | REAL(wp), DIMENSION(nbins_aerosol) :: zac_hhso4_ae !< Activity coefficients for HHSO4 |
---|
6282 | REAL(wp), DIMENSION(nbins_aerosol) :: zac_nh3_ae !< Activity coefficients for NH3 |
---|
6283 | REAL(wp), DIMENSION(nbins_aerosol) :: zac_nh4hso2_ae !< Activity coefficients for NH4HSO2 |
---|
6284 | REAL(wp), DIMENSION(nbins_aerosol) :: zcg_hno3_eq_ae !< Equilibrium gas concentration: HNO3 |
---|
6285 | REAL(wp), DIMENSION(nbins_aerosol) :: zcg_nh3_eq_ae !< Equilibrium gas concentration: NH3 |
---|
6286 | REAL(wp), DIMENSION(nbins_aerosol) :: zc_hno3_int_ae !< Intermediate HNO3 aerosol concentration |
---|
6287 | REAL(wp), DIMENSION(nbins_aerosol) :: zc_hno3_c_ae !< Current HNO3 in aerosols |
---|
6288 | REAL(wp), DIMENSION(nbins_aerosol) :: zc_hno3_n_ae !< New HNO3 in aerosols |
---|
6289 | REAL(wp), DIMENSION(nbins_aerosol) :: zc_nh3_int_ae !< Intermediate NH3 aerosol concentration |
---|
6290 | REAL(wp), DIMENSION(nbins_aerosol) :: zc_nh3_c_ae !< Current NH3 in aerosols |
---|
6291 | REAL(wp), DIMENSION(nbins_aerosol) :: zc_nh3_n_ae !< New NH3 in aerosols |
---|
6292 | REAL(wp), DIMENSION(nbins_aerosol) :: zkel_hno3_ae !< Kelvin effect for HNO3 |
---|
6293 | REAL(wp), DIMENSION(nbins_aerosol) :: zkel_nh3_ae !< Kelvin effects for NH3 |
---|
6294 | REAL(wp), DIMENSION(nbins_aerosol) :: zmt_hno3_ae !< Mass transfer coefficients for HNO3 |
---|
6295 | REAL(wp), DIMENSION(nbins_aerosol) :: zmt_nh3_ae !< Mass transfer coefficients for NH3 |
---|
6296 | REAL(wp), DIMENSION(nbins_aerosol) :: zsat_hno3_ae !< HNO3 saturation ratio over a surface |
---|
6297 | REAL(wp), DIMENSION(nbins_aerosol) :: zsat_nh3_ae !< NH3 saturation ratio over a surface |
---|
6298 | |
---|
6299 | REAL(wp), DIMENSION(nbins_aerosol,maxspec) :: zion_mols !< Ion molalities from pdfite aerosols |
---|
6300 | |
---|
6301 | REAL(wp), DIMENSION(nbins_aerosol), INTENT(in) :: pbeta !< transitional correction factor for |
---|
6302 | |
---|
6303 | TYPE(t_section), DIMENSION(nbins_aerosol), INTENT(inout) :: paero !< Aerosol properties |
---|
6304 | ! |
---|
6305 | !-- Initialise: |
---|
6306 | adt = ptstep |
---|
6307 | zac_hhso4_ae = 0.0_wp |
---|
6308 | zac_nh3_ae = 0.0_wp |
---|
6309 | zac_nh4hso2_ae = 0.0_wp |
---|
6310 | zac_hno3_ae = 0.0_wp |
---|
6311 | zcg_nh3_eq_ae = 0.0_wp |
---|
6312 | zcg_hno3_eq_ae = 0.0_wp |
---|
6313 | zion_mols = 0.0_wp |
---|
6314 | zsat_nh3_ae = 1.0_wp |
---|
6315 | zsat_hno3_ae = 1.0_wp |
---|
6316 | ! |
---|
6317 | !-- Diffusion coefficient (m2/s) |
---|
6318 | zdfvap = 5.1111E-10_wp * ptemp**1.75_wp * ( p_0 + 1325.0_wp ) / ppres |
---|
6319 | ! |
---|
6320 | !-- Kelvin effects (Jacobson (2005), eq. 16.33) |
---|
6321 | zkel_hno3_ae(1:nbins_aerosol) = EXP( 4.0_wp * surfw0 * amvhno3 / & |
---|
6322 | ( abo * ptemp * paero(1:nbins_aerosol)%dwet ) ) |
---|
6323 | zkel_nh3_ae(1:nbins_aerosol) = EXP( 4.0_wp * surfw0 * amvnh3 / & |
---|
6324 | ( abo * ptemp * paero(1:nbins_aerosol)%dwet ) ) |
---|
6325 | ! |
---|
6326 | !-- Current vapour mole concentrations (mol/m3) |
---|
6327 | zc_hno3_c = pghno3 / avo ! HNO3 |
---|
6328 | zc_nh3_c = pgnh3 / avo ! NH3 |
---|
6329 | ! |
---|
6330 | !-- Current particle mole concentrations (mol/m3) |
---|
6331 | zc_hno3_c_ae(1:nbins_aerosol) = paero(1:nbins_aerosol)%volc(6) * arhohno3 / amhno3 |
---|
6332 | zc_nh3_c_ae(1:nbins_aerosol) = paero(1:nbins_aerosol)%volc(7) * arhonh3 / amnh3 |
---|
6333 | ! |
---|
6334 | !-- Total mole concentrations: gas and particle phase |
---|
6335 | zc_hno3_tot = zc_hno3_c + SUM( zc_hno3_c_ae(1:nbins_aerosol) ) |
---|
6336 | zc_nh3_tot = zc_nh3_c + SUM( zc_nh3_c_ae(1:nbins_aerosol) ) |
---|
6337 | ! |
---|
6338 | !-- Relative humidity [0-1] |
---|
6339 | zrh = pcw / pcs |
---|
6340 | ! |
---|
6341 | !-- Mass transfer coefficients (Jacobson, Eq. 16.64) |
---|
6342 | zmt_hno3_ae(:) = 2.0_wp * pi * paero(:)%dwet * zdfvap * paero(:)%numc * pbeta(:) |
---|
6343 | zmt_nh3_ae(:) = 2.0_wp * pi * paero(:)%dwet * zdfvap * paero(:)%numc * pbeta(:) |
---|
6344 | |
---|
6345 | ! |
---|
6346 | !-- Get the equilibrium concentrations above aerosols |
---|
6347 | CALL nitrate_ammonium_equilibrium( zrh, ptemp, paero, zcg_hno3_eq_ae, zcg_nh3_eq_ae, & |
---|
6348 | zac_hno3_ae, zac_nh3_ae, zac_nh4hso2_ae, zac_hhso4_ae, & |
---|
6349 | zion_mols ) |
---|
6350 | ! |
---|
6351 | !-- Calculate NH3 and HNO3 saturation ratios for aerosols |
---|
6352 | CALL nitrate_ammonium_saturation( ptemp, paero, zac_hno3_ae, zac_nh4hso2_ae, zac_hhso4_ae, & |
---|
6353 | zcg_hno3_eq_ae, zc_hno3_c_ae, zc_nh3_c_ae, zkel_hno3_ae, & |
---|
6354 | zkel_nh3_ae, zsat_hno3_ae, zsat_nh3_ae ) |
---|
6355 | ! |
---|
6356 | !-- Intermediate gas concentrations of HNO3 and NH3 |
---|
6357 | zhlp1 = SUM( zc_hno3_c_ae(:) / ( 1.0_wp + adt * zmt_hno3_ae(:) * zsat_hno3_ae(:) ) ) |
---|
6358 | zhlp2 = SUM( zmt_hno3_ae(:) / ( 1.0_wp + adt * zmt_hno3_ae(:) * zsat_hno3_ae(:) ) ) |
---|
6359 | zc_hno3_int = ( zc_hno3_tot - zhlp1 ) / ( 1.0_wp + adt * zhlp2 ) |
---|
6360 | |
---|
6361 | zhlp1 = SUM( zc_nh3_c_ae(:) / ( 1.0_wp + adt * zmt_nh3_ae(:) * zsat_nh3_ae(:) ) ) |
---|
6362 | zhlp2 = SUM( zmt_nh3_ae(:) / ( 1.0_wp + adt * zmt_nh3_ae(:) * zsat_nh3_ae(:) ) ) |
---|
6363 | zc_nh3_int = ( zc_nh3_tot - zhlp1 )/( 1.0_wp + adt * zhlp2 ) |
---|
6364 | |
---|
6365 | zc_hno3_int = MIN( zc_hno3_int, zc_hno3_tot ) |
---|
6366 | zc_nh3_int = MIN( zc_nh3_int, zc_nh3_tot ) |
---|
6367 | ! |
---|
6368 | !-- Calculate the new concentration on aerosol particles |
---|
6369 | zc_hno3_int_ae = zc_hno3_c_ae |
---|
6370 | zc_nh3_int_ae = zc_nh3_c_ae |
---|
6371 | DO ib = 1, nbins_aerosol |
---|
6372 | zc_hno3_int_ae(ib) = ( zc_hno3_c_ae(ib) + adt * zmt_hno3_ae(ib) * zc_hno3_int ) / & |
---|
6373 | ( 1.0_wp + adt * zmt_hno3_ae(ib) * zsat_hno3_ae(ib) ) |
---|
6374 | zc_nh3_int_ae(ib) = ( zc_nh3_c_ae(ib) + adt * zmt_nh3_ae(ib) * zc_nh3_int ) / & |
---|
6375 | ( 1.0_wp + adt * zmt_nh3_ae(ib) * zsat_nh3_ae(ib) ) |
---|
6376 | ENDDO |
---|
6377 | |
---|
6378 | zc_hno3_int_ae(:) = MAX( zc_hno3_int_ae(:), 0.0_wp ) |
---|
6379 | zc_nh3_int_ae(:) = MAX( zc_nh3_int_ae(:), 0.0_wp ) |
---|
6380 | ! |
---|
6381 | !-- Final molar gas concentration and molar particle concentration of HNO3 |
---|
6382 | zc_hno3_n = zc_hno3_int |
---|
6383 | zc_hno3_n_ae = zc_hno3_int_ae |
---|
6384 | ! |
---|
6385 | !-- Final molar gas concentration and molar particle concentration of NH3 |
---|
6386 | zc_nh3_n = zc_nh3_int |
---|
6387 | zc_nh3_n_ae = zc_nh3_int_ae |
---|
6388 | ! |
---|
6389 | !-- Model timestep reached - update the gas concentrations |
---|
6390 | pghno3 = zc_hno3_n * avo |
---|
6391 | pgnh3 = zc_nh3_n * avo |
---|
6392 | ! |
---|
6393 | !-- Update the particle concentrations |
---|
6394 | DO ib = start_subrange_1a, end_subrange_2b |
---|
6395 | paero(ib)%volc(6) = zc_hno3_n_ae(ib) * amhno3 / arhohno3 |
---|
6396 | paero(ib)%volc(7) = zc_nh3_n_ae(ib) * amnh3 / arhonh3 |
---|
6397 | ENDDO |
---|
6398 | |
---|
6399 | END SUBROUTINE gpparthno3 |
---|
6400 | !------------------------------------------------------------------------------! |
---|
6401 | ! Description: |
---|
6402 | ! ------------ |
---|
6403 | !> Calculate the equilibrium concentrations above aerosols (reference?) |
---|
6404 | !------------------------------------------------------------------------------! |
---|
6405 | SUBROUTINE nitrate_ammonium_equilibrium( prh, ptemp, ppart, pcg_hno3_eq, pcg_nh3_eq, pgamma_hno3, & |
---|
6406 | pgamma_nh4, pgamma_nh4hso2, pgamma_hhso4, pmols ) |
---|
6407 | |
---|
6408 | IMPLICIT NONE |
---|
6409 | |
---|
6410 | INTEGER(iwp) :: ib !< loop index: aerosol bins |
---|
6411 | |
---|
6412 | REAL(wp) :: zhlp !< intermediate variable |
---|
6413 | REAL(wp) :: zp_hcl !< Equilibrium vapor pressures (Pa) of HCl |
---|
6414 | REAL(wp) :: zp_hno3 !< Equilibrium vapor pressures (Pa) of HNO3 |
---|
6415 | REAL(wp) :: zp_nh3 !< Equilibrium vapor pressures (Pa) of NH3 |
---|
6416 | REAL(wp) :: zwatertotal !< Total water in particles (mol/m3) |
---|
6417 | |
---|
6418 | REAL(wp), INTENT(in) :: prh !< relative humidity |
---|
6419 | REAL(wp), INTENT(in) :: ptemp !< ambient temperature (K) |
---|
6420 | |
---|
6421 | REAL(wp), DIMENSION(maxspec) :: zgammas !< Activity coefficients |
---|
6422 | REAL(wp), DIMENSION(maxspec) :: zions !< molar concentration of ion (mol/m3) |
---|
6423 | |
---|
6424 | REAL(wp), DIMENSION(nbins_aerosol), INTENT(inout) :: pcg_nh3_eq !< equilibrium molar |
---|
6425 | !< concentration: of NH3 |
---|
6426 | REAL(wp), DIMENSION(nbins_aerosol), INTENT(inout) :: pcg_hno3_eq !< of HNO3 |
---|
6427 | REAL(wp), DIMENSION(nbins_aerosol), INTENT(inout) :: pgamma_hhso4 !< activity coeff. of HHSO4 |
---|
6428 | REAL(wp), DIMENSION(nbins_aerosol), INTENT(inout) :: pgamma_nh4 !< activity coeff. of NH3 |
---|
6429 | REAL(wp), DIMENSION(nbins_aerosol), INTENT(inout) :: pgamma_nh4hso2 !< activity coeff. of NH4HSO2 |
---|
6430 | REAL(wp), DIMENSION(nbins_aerosol), INTENT(inout) :: pgamma_hno3 !< activity coeff. of HNO3 |
---|
6431 | |
---|
6432 | REAL(wp), DIMENSION(nbins_aerosol,maxspec), INTENT(inout) :: pmols !< Ion molalities |
---|
6433 | |
---|
6434 | TYPE(t_section), DIMENSION(nbins_aerosol), INTENT(inout) :: ppart !< Aerosol properties |
---|
6435 | |
---|
6436 | zgammas = 0.0_wp |
---|
6437 | zhlp = 0.0_wp |
---|
6438 | zions = 0.0_wp |
---|
6439 | zp_hcl = 0.0_wp |
---|
6440 | zp_hno3 = 0.0_wp |
---|
6441 | zp_nh3 = 0.0_wp |
---|
6442 | zwatertotal = 0.0_wp |
---|
6443 | |
---|
6444 | DO ib = 1, nbins_aerosol |
---|
6445 | |
---|
6446 | IF ( ppart(ib)%numc < nclim ) CYCLE |
---|
6447 | ! |
---|
6448 | !-- Ion molar concentrations: 2*H2SO4 + CL + NO3 - Na - NH4 |
---|
6449 | zhlp = 2.0_wp * ppart(ib)%volc(1) * arhoh2so4 / amh2so4 + ppart(ib)%volc(5) * arhoss / amss & |
---|
6450 | + ppart(ib)%volc(6) * arhohno3 / amhno3 - ppart(ib)%volc(5) * arhoss / amss - & |
---|
6451 | ppart(ib)%volc(7) * arhonh3 / amnh3 |
---|
6452 | |
---|
6453 | zions(1) = zhlp ! H+ |
---|
6454 | zions(2) = ppart(ib)%volc(7) * arhonh3 / amnh3 ! NH4+ |
---|
6455 | zions(3) = ppart(ib)%volc(5) * arhoss / amss ! Na+ |
---|
6456 | zions(4) = ppart(ib)%volc(1) * arhoh2so4 / amh2so4 ! SO4(2-) |
---|
6457 | zions(5) = 0.0_wp ! HSO4- |
---|
6458 | zions(6) = ppart(ib)%volc(6) * arhohno3 / amhno3 ! NO3- |
---|
6459 | zions(7) = ppart(ib)%volc(5) * arhoss / amss ! Cl- |
---|
6460 | |
---|
6461 | zwatertotal = ppart(ib)%volc(8) * arhoh2o / amh2o |
---|
6462 | IF ( zwatertotal > 1.0E-30_wp ) THEN |
---|
6463 | CALL inorganic_pdfite( prh, ptemp, zions, zwatertotal, zp_hno3, zp_hcl, zp_nh3, zgammas, & |
---|
6464 | pmols(ib,:) ) |
---|
6465 | ENDIF |
---|
6466 | ! |
---|
6467 | !-- Activity coefficients |
---|
6468 | pgamma_hno3(ib) = zgammas(1) ! HNO3 |
---|
6469 | pgamma_nh4(ib) = zgammas(3) ! NH3 |
---|
6470 | pgamma_nh4hso2(ib) = zgammas(6) ! NH4HSO2 |
---|
6471 | pgamma_hhso4(ib) = zgammas(7) ! HHSO4 |
---|
6472 | ! |
---|
6473 | !-- Equilibrium molar concentrations (mol/m3) from equlibrium pressures (Pa) |
---|
6474 | pcg_hno3_eq(ib) = zp_hno3 / ( argas * ptemp ) |
---|
6475 | pcg_nh3_eq(ib) = zp_nh3 / ( argas * ptemp ) |
---|
6476 | |
---|
6477 | ENDDO |
---|
6478 | |
---|
6479 | END SUBROUTINE nitrate_ammonium_equilibrium |
---|
6480 | |
---|
6481 | !------------------------------------------------------------------------------! |
---|
6482 | ! Description: |
---|
6483 | ! ------------ |
---|
6484 | !> Calculate saturation ratios of NH4 and HNO3 for aerosols |
---|
6485 | !------------------------------------------------------------------------------! |
---|
6486 | SUBROUTINE nitrate_ammonium_saturation( ptemp, ppart, pachno3, pacnh4hso2, pachhso4, pchno3eq, & |
---|
6487 | pchno3, pc_nh3, pkelhno3, pkelnh3, psathno3, psatnh3 ) |
---|
6488 | |
---|
6489 | IMPLICIT NONE |
---|
6490 | |
---|
6491 | INTEGER(iwp) :: ib !< running index for aerosol bins |
---|
6492 | |
---|
6493 | REAL(wp) :: k_ll_h2o !< equilibrium constants of equilibrium reactions: |
---|
6494 | !< H2O(aq) <--> H+ + OH- (mol/kg) |
---|
6495 | REAL(wp) :: k_ll_nh3 !< NH3(aq) + H2O(aq) <--> NH4+ + OH- (mol/kg) |
---|
6496 | REAL(wp) :: k_gl_nh3 !< NH3(g) <--> NH3(aq) (mol/kg/atm) |
---|
6497 | REAL(wp) :: k_gl_hno3 !< HNO3(g) <--> H+ + NO3- (mol2/kg2/atm) |
---|
6498 | REAL(wp) :: zmol_no3 !< molality of NO3- (mol/kg) |
---|
6499 | REAL(wp) :: zmol_h !< molality of H+ (mol/kg) |
---|
6500 | REAL(wp) :: zmol_so4 !< molality of SO4(2-) (mol/kg) |
---|
6501 | REAL(wp) :: zmol_cl !< molality of Cl- (mol/kg) |
---|
6502 | REAL(wp) :: zmol_nh4 !< molality of NH4+ (mol/kg) |
---|
6503 | REAL(wp) :: zmol_na !< molality of Na+ (mol/kg) |
---|
6504 | REAL(wp) :: zhlp1 !< intermediate variable |
---|
6505 | REAL(wp) :: zhlp2 !< intermediate variable |
---|
6506 | REAL(wp) :: zhlp3 !< intermediate variable |
---|
6507 | REAL(wp) :: zxi !< particle mole concentration ratio: (NH3+SS)/H2SO4 |
---|
6508 | REAL(wp) :: zt0 !< reference temp |
---|
6509 | |
---|
6510 | REAL(wp), PARAMETER :: a1 = -22.52_wp !< |
---|
6511 | REAL(wp), PARAMETER :: a2 = -1.50_wp !< |
---|
6512 | REAL(wp), PARAMETER :: a3 = 13.79_wp !< |
---|
6513 | REAL(wp), PARAMETER :: a4 = 29.17_wp !< |
---|
6514 | REAL(wp), PARAMETER :: b1 = 26.92_wp !< |
---|
6515 | REAL(wp), PARAMETER :: b2 = 26.92_wp !< |
---|
6516 | REAL(wp), PARAMETER :: b3 = -5.39_wp !< |
---|
6517 | REAL(wp), PARAMETER :: b4 = 16.84_wp !< |
---|
6518 | REAL(wp), PARAMETER :: K01 = 1.01E-14_wp !< |
---|
6519 | REAL(wp), PARAMETER :: K02 = 1.81E-5_wp !< |
---|
6520 | REAL(wp), PARAMETER :: K03 = 57.64_wp !< |
---|
6521 | REAL(wp), PARAMETER :: K04 = 2.51E+6_wp !< |
---|
6522 | |
---|
6523 | REAL(wp), INTENT(in) :: ptemp !< ambient temperature (K) |
---|
6524 | |
---|
6525 | REAL(wp), DIMENSION(nbins_aerosol), INTENT(in) :: pachhso4 !< activity coeff. of HHSO4 |
---|
6526 | REAL(wp), DIMENSION(nbins_aerosol), INTENT(in) :: pacnh4hso2 !< activity coeff. of NH4HSO2 |
---|
6527 | REAL(wp), DIMENSION(nbins_aerosol), INTENT(in) :: pachno3 !< activity coeff. of HNO3 |
---|
6528 | REAL(wp), DIMENSION(nbins_aerosol), INTENT(in) :: pchno3eq !< eq. surface concentration: HNO3 |
---|
6529 | REAL(wp), DIMENSION(nbins_aerosol), INTENT(in) :: pchno3 !< current particle mole |
---|
6530 | !< concentration of HNO3 (mol/m3) |
---|
6531 | REAL(wp), DIMENSION(nbins_aerosol), INTENT(in) :: pc_nh3 !< of NH3 (mol/m3) |
---|
6532 | REAL(wp), DIMENSION(nbins_aerosol), INTENT(in) :: pkelhno3 !< Kelvin effect for HNO3 |
---|
6533 | REAL(wp), DIMENSION(nbins_aerosol), INTENT(in) :: pkelnh3 !< Kelvin effect for NH3 |
---|
6534 | |
---|
6535 | REAL(wp), DIMENSION(nbins_aerosol), INTENT(out) :: psathno3 !< saturation ratio of HNO3 |
---|
6536 | REAL(wp), DIMENSION(nbins_aerosol), INTENT(out) :: psatnh3 !< saturation ratio of NH3 |
---|
6537 | |
---|
6538 | TYPE(t_section), DIMENSION(nbins_aerosol), INTENT(inout) :: ppart !< Aerosol properties |
---|
6539 | |
---|
6540 | zmol_cl = 0.0_wp |
---|
6541 | zmol_h = 0.0_wp |
---|
6542 | zmol_na = 0.0_wp |
---|
6543 | zmol_nh4 = 0.0_wp |
---|
6544 | zmol_no3 = 0.0_wp |
---|
6545 | zmol_so4 = 0.0_wp |
---|
6546 | zt0 = 298.15_wp |
---|
6547 | zxi = 0.0_wp |
---|
6548 | ! |
---|
6549 | !-- Calculates equlibrium rate constants based on Table B.7 in Jacobson (2005): |
---|
6550 | !-- K^ll_H20, K^ll_NH3, K^gl_NH3, K^gl_HNO3 |
---|
6551 | zhlp1 = zt0 / ptemp |
---|
6552 | zhlp2 = zhlp1 - 1.0_wp |
---|
6553 | zhlp3 = 1.0_wp + LOG( zhlp1 ) - zhlp1 |
---|
6554 | |
---|
6555 | k_ll_h2o = K01 * EXP( a1 * zhlp2 + b1 * zhlp3 ) |
---|
6556 | k_ll_nh3 = K02 * EXP( a2 * zhlp2 + b2 * zhlp3 ) |
---|
6557 | k_gl_nh3 = K03 * EXP( a3 * zhlp2 + b3 * zhlp3 ) |
---|
6558 | k_gl_hno3 = K04 * EXP( a4 * zhlp2 + b4 * zhlp3 ) |
---|
6559 | |
---|
6560 | DO ib = 1, nbins_aerosol |
---|
6561 | |
---|
6562 | IF ( ppart(ib)%numc > nclim .AND. ppart(ib)%volc(8) > 1.0E-30_wp ) THEN |
---|
6563 | ! |
---|
6564 | !-- Molality of H+ and NO3- |
---|
6565 | zhlp1 = pc_nh3(ib) * amnh3 + ppart(ib)%volc(1) * arhoh2so4 + ppart(ib)%volc(2) * arhooc & |
---|
6566 | + ppart(ib)%volc(5) * arhoss + ppart(ib)%volc(8) * arhoh2o |
---|
6567 | zmol_no3 = pchno3(ib) / zhlp1 !< mol/kg |
---|
6568 | ! |
---|
6569 | !-- Particle mole concentration ratio: (NH3+SS)/H2SO4 |
---|
6570 | zxi = ( pc_nh3(ib) + ppart(ib)%volc(5) * arhoss / amss ) / ( ppart(ib)%volc(1) * & |
---|
6571 | arhoh2so4 / amh2so4 ) |
---|
6572 | |
---|
6573 | IF ( zxi <= 2.0_wp ) THEN |
---|
6574 | ! |
---|
6575 | !-- Molality of SO4(2-) |
---|
6576 | zhlp1 = pc_nh3(ib) * amnh3 + pchno3(ib) * amhno3 + ppart(ib)%volc(2) * arhooc + & |
---|
6577 | ppart(ib)%volc(5) * arhoss + ppart(ib)%volc(8) * arhoh2o |
---|
6578 | zmol_so4 = ( ppart(ib)%volc(1) * arhoh2so4 / amh2so4 ) / zhlp1 |
---|
6579 | ! |
---|
6580 | !-- Molality of Cl- |
---|
6581 | zhlp1 = pc_nh3(ib) * amnh3 + pchno3(ib) * amhno3 + ppart(ib)%volc(2) * arhooc + & |
---|
6582 | ppart(ib)%volc(1) * arhoh2so4 + ppart(ib)%volc(8) * arhoh2o |
---|
6583 | zmol_cl = ( ppart(ib)%volc(5) * arhoss / amss ) / zhlp1 |
---|
6584 | ! |
---|
6585 | !-- Molality of NH4+ |
---|
6586 | zhlp1 = pchno3(ib) * amhno3 + ppart(ib)%volc(1) * arhoh2so4 + ppart(ib)%volc(2) * & |
---|
6587 | arhooc + ppart(ib)%volc(5) * arhoss + ppart(ib)%volc(8) * arhoh2o |
---|
6588 | zmol_nh4 = pc_nh3(ib) / zhlp1 |
---|
6589 | ! |
---|
6590 | !-- Molality of Na+ |
---|
6591 | zmol_na = zmol_cl |
---|
6592 | ! |
---|
6593 | !-- Molality of H+ |
---|
6594 | zmol_h = 2.0_wp * zmol_so4 + zmol_no3 + zmol_cl - ( zmol_nh4 + zmol_na ) |
---|
6595 | |
---|
6596 | ELSE |
---|
6597 | |
---|
6598 | zhlp2 = pkelhno3(ib) * zmol_no3 * pachno3(ib)**2 |
---|
6599 | |
---|
6600 | IF ( zhlp2 > 1.0E-30_wp ) THEN |
---|
6601 | zmol_h = k_gl_hno3 * pchno3eq(ib) / zhlp2 ! Eq. 17.38 |
---|
6602 | ELSE |
---|
6603 | zmol_h = 0.0_wp |
---|
6604 | ENDIF |
---|
6605 | |
---|
6606 | ENDIF |
---|
6607 | |
---|
6608 | zhlp1 = ppart(ib)%volc(8) * arhoh2o * argas * ptemp * k_gl_hno3 |
---|
6609 | ! |
---|
6610 | !-- Saturation ratio for NH3 and for HNO3 |
---|
6611 | IF ( zmol_h > 0.0_wp ) THEN |
---|
6612 | zhlp2 = pkelnh3(ib) / ( zhlp1 * zmol_h ) |
---|
6613 | zhlp3 = k_ll_h2o / ( k_ll_nh3 + k_gl_nh3 ) |
---|
6614 | psatnh3(ib) = zhlp2 * ( ( pacnh4hso2(ib) / pachhso4(ib) )**2 ) * zhlp3 |
---|
6615 | psathno3(ib) = ( pkelhno3(ib) * zmol_h * pachno3(ib)**2 ) / zhlp1 |
---|
6616 | ELSE |
---|
6617 | psatnh3(ib) = 1.0_wp |
---|
6618 | psathno3(ib) = 1.0_wp |
---|
6619 | ENDIF |
---|
6620 | ELSE |
---|
6621 | psatnh3(ib) = 1.0_wp |
---|
6622 | psathno3(ib) = 1.0_wp |
---|
6623 | ENDIF |
---|
6624 | |
---|
6625 | ENDDO |
---|
6626 | |
---|
6627 | END SUBROUTINE nitrate_ammonium_saturation |
---|
6628 | |
---|
6629 | !------------------------------------------------------------------------------! |
---|
6630 | ! Description: |
---|
6631 | ! ------------ |
---|
6632 | !> Prototype module for calculating the water content of a mixed inorganic/ |
---|
6633 | !> organic particle + equilibrium water vapour pressure above the solution |
---|
6634 | !> (HNO3, HCL, NH3 and representative organic compounds. Efficient calculation |
---|
6635 | !> of the partitioning of species between gas and aerosol. Based in a chamber |
---|
6636 | !> study. |
---|
6637 | ! |
---|
6638 | !> Written by Dave Topping. Pure organic component properties predicted by Mark |
---|
6639 | !> Barley based on VOCs predicted in MCM simulations performed by Mike Jenkin. |
---|
6640 | !> Delivered by Gordon McFiggans as Deliverable D22 from WP1.4 in the EU FP6 |
---|
6641 | !> EUCAARI Integrated Project. |
---|
6642 | ! |
---|
6643 | !> REFERENCES |
---|
6644 | !> Clegg et al. (1998) A Thermodynamic Model of the System H+-NH4+-Na+-SO42- -NO3--Cl--H2O at |
---|
6645 | !> 298.15 K, J. Phys. Chem., 102A, 2155-2171. |
---|
6646 | !> Clegg et al. (2001) Thermodynamic modelling of aqueous aerosols containing electrolytes and |
---|
6647 | !> dissolved organic compounds. Journal of Aerosol Science 2001;32(6):713-738. |
---|
6648 | !> Topping et al. (2005a) A curved multi-component aerosol hygroscopicity model framework: Part 1 - |
---|
6649 | !> Inorganic compounds. Atmospheric Chemistry and Physics 2005;5:1205-1222. |
---|
6650 | !> Topping et al. (2005b) A curved multi-component aerosol hygroscopicity model framework: Part 2 - |
---|
6651 | !> Including organic compounds. Atmospheric Chemistry and Physics 2005;5:1223-1242. |
---|
6652 | !> Wagman et al. (1982). The NBS tables of chemical thermodynamic properties: selected values for |
---|
6653 | !> inorganic and Câ and Câ organic substances in SI units (book) |
---|
6654 | !> Zaveri et al. (2005). A new method for multicomponent activity coefficients of electrolytes in |
---|
6655 | !> aqueous atmospheric aerosols, JGR, 110, D02201, 2005. |
---|
6656 | ! |
---|
6657 | !> Queries concerning the use of this code through Gordon McFiggans, |
---|
6658 | !> g.mcfiggans@manchester.ac.uk, |
---|
6659 | !> Ownership: D. Topping, Centre for Atmospheric Sciences, University of |
---|
6660 | !> Manchester, 2007 |
---|
6661 | ! |
---|
6662 | !> Rewritten to PALM by Mona Kurppa, UHel, 2017 |
---|
6663 | !------------------------------------------------------------------------------! |
---|
6664 | SUBROUTINE inorganic_pdfite( rh, temp, ions, water_total, press_hno3, press_hcl, press_nh3, & |
---|
6665 | gamma_out, mols_out ) |
---|
6666 | |
---|
6667 | IMPLICIT NONE |
---|
6668 | |
---|
6669 | INTEGER(iwp) :: binary_case |
---|
6670 | INTEGER(iwp) :: full_complexity |
---|
6671 | |
---|
6672 | REAL(wp) :: a !< auxiliary variable |
---|
6673 | REAL(wp) :: act_product !< ionic activity coef. product: |
---|
6674 | !< = (gamma_h2so4**3d0) / gamma_hhso4**2d0) |
---|
6675 | REAL(wp) :: ammonium_chloride !< |
---|
6676 | REAL(wp) :: ammonium_chloride_eq_frac !< |
---|
6677 | REAL(wp) :: ammonium_nitrate !< |
---|
6678 | REAL(wp) :: ammonium_nitrate_eq_frac !< |
---|
6679 | REAL(wp) :: ammonium_sulphate !< |
---|
6680 | REAL(wp) :: ammonium_sulphate_eq_frac !< |
---|
6681 | REAL(wp) :: b !< auxiliary variable |
---|
6682 | REAL(wp) :: binary_h2so4 !< binary H2SO4 activity coeff. |
---|
6683 | REAL(wp) :: binary_hcl !< binary HCL activity coeff. |
---|
6684 | REAL(wp) :: binary_hhso4 !< binary HHSO4 activity coeff. |
---|
6685 | REAL(wp) :: binary_hno3 !< binary HNO3 activity coeff. |
---|
6686 | REAL(wp) :: binary_nh4hso4 !< binary NH4HSO4 activity coeff. |
---|
6687 | REAL(wp) :: c !< auxiliary variable |
---|
6688 | REAL(wp) :: charge_sum !< sum of ionic charges |
---|
6689 | REAL(wp) :: gamma_h2so4 !< activity coefficient |
---|
6690 | REAL(wp) :: gamma_hcl !< activity coefficient |
---|
6691 | REAL(wp) :: gamma_hhso4 !< activity coeffient |
---|
6692 | REAL(wp) :: gamma_hno3 !< activity coefficient |
---|
6693 | REAL(wp) :: gamma_nh3 !< activity coefficient |
---|
6694 | REAL(wp) :: gamma_nh4hso4 !< activity coefficient |
---|
6695 | REAL(wp) :: h_out !< |
---|
6696 | REAL(wp) :: h_real !< new hydrogen ion conc. |
---|
6697 | REAL(wp) :: h2so4_hcl !< contribution of H2SO4 |
---|
6698 | REAL(wp) :: h2so4_hno3 !< contribution of H2SO4 |
---|
6699 | REAL(wp) :: h2so4_nh3 !< contribution of H2SO4 |
---|
6700 | REAL(wp) :: h2so4_nh4hso4 !< contribution of H2SO4 |
---|
6701 | REAL(wp) :: hcl_h2so4 !< contribution of HCL |
---|
6702 | REAL(wp) :: hcl_hhso4 !< contribution of HCL |
---|
6703 | REAL(wp) :: hcl_hno3 !< contribution of HCL |
---|
6704 | REAL(wp) :: hcl_nh4hso4 !< contribution of HCL |
---|
6705 | REAL(wp) :: henrys_temp_dep !< temperature dependence of Henry's Law |
---|
6706 | REAL(wp) :: hno3_h2so4 !< contribution of HNO3 |
---|
6707 | REAL(wp) :: hno3_hcl !< contribution of HNO3 |
---|
6708 | REAL(wp) :: hno3_hhso4 !< contribution of HNO3 |
---|
6709 | REAL(wp) :: hno3_nh3 !< contribution of HNO3 |
---|
6710 | REAL(wp) :: hno3_nh4hso4 !< contribution of HNO3 |
---|
6711 | REAL(wp) :: hso4_out !< |
---|
6712 | REAL(wp) :: hso4_real !< new bisulphate ion conc. |
---|
6713 | REAL(wp) :: hydrochloric_acid !< |
---|
6714 | REAL(wp) :: hydrochloric_acid_eq_frac !< |
---|
6715 | REAL(wp) :: k_h !< equilibrium constant for H+ |
---|
6716 | REAL(wp) :: k_hcl !< equilibrium constant of HCL |
---|
6717 | REAL(wp) :: k_hno3 !< equilibrium constant of HNO3 |
---|
6718 | REAL(wp) :: k_nh4 !< equilibrium constant for NH4+ |
---|
6719 | REAL(wp) :: k_h2o !< equil. const. for water_surface |
---|
6720 | REAL(wp) :: ln_h2so4_act !< gamma_h2so4 = EXP(ln_h2so4_act) |
---|
6721 | REAL(wp) :: ln_HCL_act !< gamma_hcl = EXP( ln_HCL_act ) |
---|
6722 | REAL(wp) :: ln_hhso4_act !< gamma_hhso4 = EXP(ln_hhso4_act) |
---|
6723 | REAL(wp) :: ln_hno3_act !< gamma_hno3 = EXP( ln_hno3_act ) |
---|
6724 | REAL(wp) :: ln_nh4hso4_act !< gamma_nh4hso4 = EXP( ln_nh4hso4_act ) |
---|
6725 | REAL(wp) :: molality_ratio_nh3 !< molality ratio of NH3 (NH4+ and H+) |
---|
6726 | REAL(wp) :: na2so4_h2so4 !< contribution of Na2SO4 |
---|
6727 | REAL(wp) :: na2so4_hcl !< contribution of Na2SO4 |
---|
6728 | REAL(wp) :: na2so4_hhso4 !< contribution of Na2SO4 |
---|
6729 | REAL(wp) :: na2so4_hno3 !< contribution of Na2SO4 |
---|
6730 | REAL(wp) :: na2so4_nh3 !< contribution of Na2SO4 |
---|
6731 | REAL(wp) :: na2so4_nh4hso4 !< contribution of Na2SO4 |
---|
6732 | REAL(wp) :: nacl_h2so4 !< contribution of NaCl |
---|
6733 | REAL(wp) :: nacl_hcl !< contribution of NaCl |
---|
6734 | REAL(wp) :: nacl_hhso4 !< contribution of NaCl |
---|
6735 | REAL(wp) :: nacl_hno3 !< contribution of NaCl |
---|
6736 | REAL(wp) :: nacl_nh3 !< contribution of NaCl |
---|
6737 | REAL(wp) :: nacl_nh4hso4 !< contribution of NaCl |
---|
6738 | REAL(wp) :: nano3_h2so4 !< contribution of NaNO3 |
---|
6739 | REAL(wp) :: nano3_hcl !< contribution of NaNO3 |
---|
6740 | REAL(wp) :: nano3_hhso4 !< contribution of NaNO3 |
---|
6741 | REAL(wp) :: nano3_hno3 !< contribution of NaNO3 |
---|
6742 | REAL(wp) :: nano3_nh3 !< contribution of NaNO3 |
---|
6743 | REAL(wp) :: nano3_nh4hso4 !< contribution of NaNO3 |
---|
6744 | REAL(wp) :: nh42so4_h2so4 !< contribution of NH42SO4 |
---|
6745 | REAL(wp) :: nh42so4_hcl !< contribution of NH42SO4 |
---|
6746 | REAL(wp) :: nh42so4_hhso4 !< contribution of NH42SO4 |
---|
6747 | REAL(wp) :: nh42so4_hno3 !< contribution of NH42SO4 |
---|
6748 | REAL(wp) :: nh42so4_nh3 !< contribution of NH42SO4 |
---|
6749 | REAL(wp) :: nh42so4_nh4hso4 !< contribution of NH42SO4 |
---|
6750 | REAL(wp) :: nh4cl_h2so4 !< contribution of NH4Cl |
---|
6751 | REAL(wp) :: nh4cl_hcl !< contribution of NH4Cl |
---|
6752 | REAL(wp) :: nh4cl_hhso4 !< contribution of NH4Cl |
---|
6753 | REAL(wp) :: nh4cl_hno3 !< contribution of NH4Cl |
---|
6754 | REAL(wp) :: nh4cl_nh3 !< contribution of NH4Cl |
---|
6755 | REAL(wp) :: nh4cl_nh4hso4 !< contribution of NH4Cl |
---|
6756 | REAL(wp) :: nh4no3_h2so4 !< contribution of NH4NO3 |
---|
6757 | REAL(wp) :: nh4no3_hcl !< contribution of NH4NO3 |
---|
6758 | REAL(wp) :: nh4no3_hhso4 !< contribution of NH4NO3 |
---|
6759 | REAL(wp) :: nh4no3_hno3 !< contribution of NH4NO3 |
---|
6760 | REAL(wp) :: nh4no3_nh3 !< contribution of NH4NO3 |
---|
6761 | REAL(wp) :: nh4no3_nh4hso4 !< contribution of NH4NO3 |
---|
6762 | REAL(wp) :: nitric_acid !< |
---|
6763 | REAL(wp) :: nitric_acid_eq_frac !< Equivalent fractions |
---|
6764 | REAL(wp) :: press_hcl !< partial pressure of HCL |
---|
6765 | REAL(wp) :: press_hno3 !< partial pressure of HNO3 |
---|
6766 | REAL(wp) :: press_nh3 !< partial pressure of NH3 |
---|
6767 | REAL(wp) :: rh !< relative humidity [0-1] |
---|
6768 | REAL(wp) :: root1 !< auxiliary variable |
---|
6769 | REAL(wp) :: root2 !< auxiliary variable |
---|
6770 | REAL(wp) :: so4_out !< |
---|
6771 | REAL(wp) :: so4_real !< new sulpate ion concentration |
---|
6772 | REAL(wp) :: sodium_chloride !< |
---|
6773 | REAL(wp) :: sodium_chloride_eq_frac !< |
---|
6774 | REAL(wp) :: sodium_nitrate !< |
---|
6775 | REAL(wp) :: sodium_nitrate_eq_frac !< |
---|
6776 | REAL(wp) :: sodium_sulphate !< |
---|
6777 | REAL(wp) :: sodium_sulphate_eq_frac !< |
---|
6778 | REAL(wp) :: solutes !< |
---|
6779 | REAL(wp) :: sulphuric_acid !< |
---|
6780 | REAL(wp) :: sulphuric_acid_eq_frac !< |
---|
6781 | REAL(wp) :: temp !< temperature |
---|
6782 | REAL(wp) :: water_total !< |
---|
6783 | |
---|
6784 | REAL(wp), DIMENSION(:) :: gamma_out !< Activity coefficient for calculating the non-ideal |
---|
6785 | !< dissociation constants |
---|
6786 | !< 1: HNO3, 2: HCL, 3: NH4+/H+ (NH3), 4: HHSO4**2/H2SO4, |
---|
6787 | !< 5: H2SO4**3/HHSO4**2, 6: NH4HSO2, 7: HHSO4 |
---|
6788 | REAL(wp), DIMENSION(:) :: ions !< ion molarities (mol/m3): 1: H+, 2: NH4+, 3: Na+, |
---|
6789 | !< 4: SO4(2-), 5: HSO4-, 6: NO3-, 7: Cl- |
---|
6790 | REAL(wp), DIMENSION(7) :: ions_mol !< ion molalities (mol/kg): 1: H+, 2: NH4+, 3: Na+, |
---|
6791 | !< 4: SO4(2-), 5: HSO4-, 6: NO3-, 7: Cl- |
---|
6792 | REAL(wp), DIMENSION(:) :: mols_out !< ion molality output (mol/kg): 1: H+, 2: NH4+, 3: Na+, |
---|
6793 | !< 4: SO4(2-), 5: HSO4-, 6: NO3-, 7: Cl- |
---|
6794 | ! |
---|
6795 | !-- Value initialisation |
---|
6796 | binary_h2so4 = 0.0_wp |
---|
6797 | binary_hcl = 0.0_wp |
---|
6798 | binary_hhso4 = 0.0_wp |
---|
6799 | binary_hno3 = 0.0_wp |
---|
6800 | binary_nh4hso4 = 0.0_wp |
---|
6801 | henrys_temp_dep = ( 1.0_wp / temp - 0.0033557_wp ) ! 1/T - 1/298 K |
---|
6802 | hcl_hno3 = 1.0_wp |
---|
6803 | h2so4_hno3 = 1.0_wp |
---|
6804 | nh42so4_hno3 = 1.0_wp |
---|
6805 | nh4no3_hno3 = 1.0_wp |
---|
6806 | nh4cl_hno3 = 1.0_wp |
---|
6807 | na2so4_hno3 = 1.0_wp |
---|
6808 | nano3_hno3 = 1.0_wp |
---|
6809 | nacl_hno3 = 1.0_wp |
---|
6810 | hno3_hcl = 1.0_wp |
---|
6811 | h2so4_hcl = 1.0_wp |
---|
6812 | nh42so4_hcl = 1.0_wp |
---|
6813 | nh4no3_hcl = 1.0_wp |
---|
6814 | nh4cl_hcl = 1.0_wp |
---|
6815 | na2so4_hcl = 1.0_wp |
---|
6816 | nano3_hcl = 1.0_wp |
---|
6817 | nacl_hcl = 1.0_wp |
---|
6818 | hno3_nh3 = 1.0_wp |
---|
6819 | h2so4_nh3 = 1.0_wp |
---|
6820 | nh42so4_nh3 = 1.0_wp |
---|
6821 | nh4no3_nh3 = 1.0_wp |
---|
6822 | nh4cl_nh3 = 1.0_wp |
---|
6823 | na2so4_nh3 = 1.0_wp |
---|
6824 | nano3_nh3 = 1.0_wp |
---|
6825 | nacl_nh3 = 1.0_wp |
---|
6826 | hno3_hhso4 = 1.0_wp |
---|
6827 | hcl_hhso4 = 1.0_wp |
---|
6828 | nh42so4_hhso4 = 1.0_wp |
---|
6829 | nh4no3_hhso4 = 1.0_wp |
---|
6830 | nh4cl_hhso4 = 1.0_wp |
---|
6831 | na2so4_hhso4 = 1.0_wp |
---|
6832 | nano3_hhso4 = 1.0_wp |
---|
6833 | nacl_hhso4 = 1.0_wp |
---|
6834 | hno3_h2so4 = 1.0_wp |
---|
6835 | hcl_h2so4 = 1.0_wp |
---|
6836 | nh42so4_h2so4 = 1.0_wp |
---|
6837 | nh4no3_h2so4 = 1.0_wp |
---|
6838 | nh4cl_h2so4 = 1.0_wp |
---|
6839 | na2so4_h2so4 = 1.0_wp |
---|
6840 | nano3_h2so4 = 1.0_wp |
---|
6841 | nacl_h2so4 = 1.0_wp |
---|
6842 | ! |
---|
6843 | !-- New NH3 variables |
---|
6844 | hno3_nh4hso4 = 1.0_wp |
---|
6845 | hcl_nh4hso4 = 1.0_wp |
---|
6846 | h2so4_nh4hso4 = 1.0_wp |
---|
6847 | nh42so4_nh4hso4 = 1.0_wp |
---|
6848 | nh4no3_nh4hso4 = 1.0_wp |
---|
6849 | nh4cl_nh4hso4 = 1.0_wp |
---|
6850 | na2so4_nh4hso4 = 1.0_wp |
---|
6851 | nano3_nh4hso4 = 1.0_wp |
---|
6852 | nacl_nh4hso4 = 1.0_wp |
---|
6853 | ! |
---|
6854 | !-- Juha Tonttila added |
---|
6855 | mols_out = 0.0_wp |
---|
6856 | press_hno3 = 0.0_wp !< Initialising vapour pressures over the |
---|
6857 | press_hcl = 0.0_wp !< multicomponent particle |
---|
6858 | press_nh3 = 0.0_wp |
---|
6859 | gamma_out = 1.0_wp !< i.e. don't alter the ideal mixing ratios if there's nothing there. |
---|
6860 | ! |
---|
6861 | !-- 1) - COMPOSITION DEFINITIONS |
---|
6862 | ! |
---|
6863 | !-- a) Inorganic ion pairing: |
---|
6864 | !-- In order to calculate the water content, which is also used in calculating vapour pressures, one |
---|
6865 | !-- needs to pair the anions and cations for use in the ZSR mixing rule. The equation provided by |
---|
6866 | !-- Clegg et al. (2001) is used for ion pairing. The solutes chosen comprise of 9 inorganic salts |
---|
6867 | !-- and acids which provide a pairing between each anion and cation: (NH4)2SO4, NH4NO3, NH4Cl, |
---|
6868 | !-- Na2SO4, NaNO3, NaCl, H2SO4, HNO3, HCL. The organic compound is treated as a seperate solute. |
---|
6869 | !-- Ions: 1: H+, 2: NH4+, 3: Na+, 4: SO4(2-), 5: HSO4-, 6: NO3-, 7: Cl- |
---|
6870 | ! |
---|
6871 | charge_sum = ions(1) + ions(2) + ions(3) + 2.0_wp * ions(4) + ions(5) + ions(6) + ions(7) |
---|
6872 | nitric_acid = ( 2.0_wp * ions(1) * ions(6) ) / charge_sum |
---|
6873 | hydrochloric_acid = ( 2.0_wp * ions(1) * ions(7) ) / charge_sum |
---|
6874 | sulphuric_acid = ( 2.0_wp * ions(1) * ions(4) ) / charge_sum |
---|
6875 | ammonium_sulphate = ( 2.0_wp * ions(2) * ions(4) ) / charge_sum |
---|
6876 | ammonium_nitrate = ( 2.0_wp * ions(2) * ions(6) ) / charge_sum |
---|
6877 | ammonium_chloride = ( 2.0_wp * ions(2) * ions(7) ) / charge_sum |
---|
6878 | sodium_sulphate = ( 2.0_wp * ions(3) * ions(4) ) / charge_sum |
---|
6879 | sodium_nitrate = ( 2.0_wp * ions(3) * ions(6) ) / charge_sum |
---|
6880 | sodium_chloride = ( 2.0_wp * ions(3) * ions(7) ) / charge_sum |
---|
6881 | solutes = 0.0_wp |
---|
6882 | solutes = 3.0_wp * sulphuric_acid + 2.0_wp * hydrochloric_acid + 2.0_wp * nitric_acid + & |
---|
6883 | 3.0_wp * ammonium_sulphate + 2.0_wp * ammonium_nitrate + 2.0_wp * ammonium_chloride +& |
---|
6884 | 3.0_wp * sodium_sulphate + 2.0_wp * sodium_nitrate + 2.0_wp * sodium_chloride |
---|
6885 | ! |
---|
6886 | !-- b) Inorganic equivalent fractions: |
---|
6887 | !-- These values are calculated so that activity coefficients can be expressed by a linear additive |
---|
6888 | !-- rule, thus allowing more efficient calculations and future expansion (see more detailed |
---|
6889 | !-- description below) |
---|
6890 | nitric_acid_eq_frac = 2.0_wp * nitric_acid / solutes |
---|
6891 | hydrochloric_acid_eq_frac = 2.0_wp * hydrochloric_acid / solutes |
---|
6892 | sulphuric_acid_eq_frac = 3.0_wp * sulphuric_acid / solutes |
---|
6893 | ammonium_sulphate_eq_frac = 3.0_wp * ammonium_sulphate / solutes |
---|
6894 | ammonium_nitrate_eq_frac = 2.0_wp * ammonium_nitrate / solutes |
---|
6895 | ammonium_chloride_eq_frac = 2.0_wp * ammonium_chloride / solutes |
---|
6896 | sodium_sulphate_eq_frac = 3.0_wp * sodium_sulphate / solutes |
---|
6897 | sodium_nitrate_eq_frac = 2.0_wp * sodium_nitrate / solutes |
---|
6898 | sodium_chloride_eq_frac = 2.0_wp * sodium_chloride / solutes |
---|
6899 | ! |
---|
6900 | !-- Inorganic ion molalities |
---|
6901 | ions_mol(1) = ions(1) / ( water_total * 18.01528E-3_wp ) ! H+ |
---|
6902 | ions_mol(2) = ions(2) / ( water_total * 18.01528E-3_wp ) ! NH4+ |
---|
6903 | ions_mol(3) = ions(3) / ( water_total * 18.01528E-3_wp ) ! Na+ |
---|
6904 | ions_mol(4) = ions(4) / ( water_total * 18.01528E-3_wp ) ! SO4(2-) |
---|
6905 | ions_mol(5) = ions(5) / ( water_total * 18.01528E-3_wp ) ! HSO4(2-) |
---|
6906 | ions_mol(6) = ions(6) / ( water_total * 18.01528E-3_wp ) ! NO3- |
---|
6907 | ions_mol(7) = ions(7) / ( water_total * 18.01528E-3_wp ) ! Cl- |
---|
6908 | |
---|
6909 | !-- *** |
---|
6910 | !-- At this point we may need to introduce a method for prescribing H+ when there is no 'real' value |
---|
6911 | !-- for H+..i.e. in the sulphate poor domain. This will give a value for solve quadratic proposed by |
---|
6912 | !-- Zaveri et al. 2005 |
---|
6913 | ! |
---|
6914 | !-- 2) - WATER CALCULATION |
---|
6915 | ! |
---|
6916 | !-- a) The water content is calculated using the ZSR rule with solute concentrations calculated |
---|
6917 | !-- using 1a above. Whilst the usual approximation of ZSR relies on binary data consisting of 5th or |
---|
6918 | !-- higher order polynomials, in this code 4 different RH regimes are used, each housing cubic |
---|
6919 | !-- equations for the water associated with each solute listed above. Binary water contents for |
---|
6920 | !-- inorganic components were calculated using AIM online (Clegg et al 1998). The water associated |
---|
6921 | !-- with the organic compound is calculated assuming ideality and that aw = RH. |
---|
6922 | ! |
---|
6923 | !-- b) Molality of each inorganic ion and organic solute (initial input) is calculated for use in |
---|
6924 | !-- vapour pressure calculation. |
---|
6925 | ! |
---|
6926 | !-- 3) - BISULPHATE ION DISSOCIATION CALCULATION |
---|
6927 | ! |
---|
6928 | !-- The dissociation of the bisulphate ion is calculated explicitly. A solution to the equilibrium |
---|
6929 | !-- equation between the bisulphate ion, hydrogen ion and sulphate ion is found using tabulated |
---|
6930 | !-- equilibrium constants (referenced). It is necessary to calculate the activity coefficients of |
---|
6931 | !-- HHSO4 and H2SO4 in a non-iterative manner. These are calculated using the same format as |
---|
6932 | !-- described in 4) below, where both activity coefficients were fit to the output from ADDEM |
---|
6933 | !-- (Topping et al 2005a,b) covering an extensive composition space, providing the activity |
---|
6934 | !-- coefficients and bisulphate ion dissociation as a function of equivalent mole fractions and |
---|
6935 | !-- relative humidity. |
---|
6936 | ! |
---|
6937 | !-- NOTE: the flags "binary_case" and "full_complexity" are not used in this prototype. They are |
---|
6938 | !-- used for simplification of the fit expressions when using limited composition regions. This |
---|
6939 | !-- section of code calculates the bisulphate ion concentration. |
---|
6940 | ! |
---|
6941 | IF ( ions(1) > 0.0_wp .AND. ions(4) > 0.0_wp ) THEN |
---|
6942 | ! |
---|
6943 | !-- HHSO4: |
---|
6944 | binary_case = 1 |
---|
6945 | IF ( rh > 0.1_wp .AND. rh < 0.9_wp ) THEN |
---|
6946 | binary_hhso4 = -4.9521_wp * rh**3 + 9.2881_wp * rh**2 - 10.777_wp * rh + 6.0534_wp |
---|
6947 | ELSEIF ( rh >= 0.9_wp .AND. rh < 0.955_wp ) THEN |
---|
6948 | binary_hhso4 = -6.3777_wp * rh + 5.962_wp |
---|
6949 | ELSEIF ( rh >= 0.955_wp .AND. rh < 0.99_wp ) THEN |
---|
6950 | binary_hhso4 = 2367.2_wp * rh**3 - 6849.7_wp * rh**2 + 6600.9_wp * rh - 2118.7_wp |
---|
6951 | ELSEIF ( rh >= 0.99_wp .AND. rh < 0.9999_wp ) THEN |
---|
6952 | binary_hhso4 = 3E-7_wp * rh**5 - 2E-5_wp * rh**4 + 0.0004_wp * rh**3 - 0.0035_wp * rh**2 & |
---|
6953 | + 0.0123_wp * rh - 0.3025_wp |
---|
6954 | ENDIF |
---|
6955 | |
---|
6956 | IF ( nitric_acid > 0.0_wp ) THEN |
---|
6957 | hno3_hhso4 = -4.2204_wp * rh**4 + 12.193_wp * rh**3 - 12.481_wp * rh**2 + 6.459_wp * rh & |
---|
6958 | - 1.9004_wp |
---|
6959 | ENDIF |
---|
6960 | |
---|
6961 | IF ( hydrochloric_acid > 0.0_wp ) THEN |
---|
6962 | hcl_hhso4 = -54.845_wp * rh**7 + 209.54_wp * rh**6 - 336.59_wp * rh**5 + 294.21_wp * & |
---|
6963 | rh**4 - 150.07_wp * rh**3 + 43.767_wp * rh**2 - 6.5495_wp * rh + 0.60048_wp |
---|
6964 | ENDIF |
---|
6965 | |
---|
6966 | IF ( ammonium_sulphate > 0.0_wp ) THEN |
---|
6967 | nh42so4_hhso4 = 16.768_wp * rh**3 - 28.75_wp * rh**2 + 20.011_wp * rh - 8.3206_wp |
---|
6968 | ENDIF |
---|
6969 | |
---|
6970 | IF ( ammonium_nitrate > 0.0_wp ) THEN |
---|
6971 | nh4no3_hhso4 = -17.184_wp * rh**4 + 56.834_wp * rh**3 - 65.765_wp * rh**2 + & |
---|
6972 | 35.321_wp * rh - 9.252_wp |
---|
6973 | ENDIF |
---|
6974 | |
---|
6975 | IF (ammonium_chloride > 0.0_wp ) THEN |
---|
6976 | IF ( rh < 0.2_wp .AND. rh >= 0.1_wp ) THEN |
---|
6977 | nh4cl_hhso4 = 3.2809_wp * rh - 2.0637_wp |
---|
6978 | ELSEIF ( rh >= 0.2_wp .AND. rh < 0.99_wp ) THEN |
---|
6979 | nh4cl_hhso4 = -1.2981_wp * rh**3 + 4.7461_wp * rh**2 - 2.3269_wp * rh - 1.1259_wp |
---|
6980 | ENDIF |
---|
6981 | ENDIF |
---|
6982 | |
---|
6983 | IF ( sodium_sulphate > 0.0_wp ) THEN |
---|
6984 | na2so4_hhso4 = 118.87_wp * rh**6 - 358.63_wp * rh**5 + 435.85_wp * rh**4 - 272.88_wp * & |
---|
6985 | rh**3 + 94.411_wp * rh**2 - 18.21_wp * rh + 0.45935_wp |
---|
6986 | ENDIF |
---|
6987 | |
---|
6988 | IF ( sodium_nitrate > 0.0_wp ) THEN |
---|
6989 | IF ( rh < 0.2_wp .AND. rh >= 0.1_wp ) THEN |
---|
6990 | nano3_hhso4 = 4.8456_wp * rh - 2.5773_wp |
---|
6991 | ELSEIF ( rh >= 0.2_wp .AND. rh < 0.99_wp ) THEN |
---|
6992 | nano3_hhso4 = 0.5964_wp * rh**3 - 0.38967_wp * rh**2 + 1.7918_wp * rh - 1.9691_wp |
---|
6993 | ENDIF |
---|
6994 | ENDIF |
---|
6995 | |
---|
6996 | IF ( sodium_chloride > 0.0_wp ) THEN |
---|
6997 | IF ( rh < 0.2_wp ) THEN |
---|
6998 | nacl_hhso4 = 0.51995_wp * rh - 1.3981_wp |
---|
6999 | ELSEIF ( rh >= 0.2_wp .AND. rh < 0.99_wp ) THEN |
---|
7000 | nacl_hhso4 = 1.6539_wp * rh - 1.6101_wp |
---|
7001 | ENDIF |
---|
7002 | ENDIF |
---|
7003 | |
---|
7004 | ln_hhso4_act = binary_hhso4 + nitric_acid_eq_frac * hno3_hhso4 + & |
---|
7005 | hydrochloric_acid_eq_frac * hcl_hhso4 + & |
---|
7006 | ammonium_sulphate_eq_frac * nh42so4_hhso4 + & |
---|
7007 | ammonium_nitrate_eq_frac * nh4no3_hhso4 + & |
---|
7008 | ammonium_chloride_eq_frac * nh4cl_hhso4 + & |
---|
7009 | sodium_sulphate_eq_frac * na2so4_hhso4 + & |
---|
7010 | sodium_nitrate_eq_frac * nano3_hhso4 + sodium_chloride_eq_frac * nacl_hhso4 |
---|
7011 | |
---|
7012 | gamma_hhso4 = EXP( ln_hhso4_act ) ! molal activity coefficient of HHSO4 |
---|
7013 | |
---|
7014 | !-- H2SO4 (sulphuric acid): |
---|
7015 | IF ( rh >= 0.1_wp .AND. rh < 0.9_wp ) THEN |
---|
7016 | binary_h2so4 = 2.4493_wp * rh**2 - 6.2326_wp * rh + 2.1763_wp |
---|
7017 | ELSEIF ( rh >= 0.9_wp .AND. rh < 0.98 ) THEN |
---|
7018 | binary_h2so4 = 914.68_wp * rh**3 - 2502.3_wp * rh**2 + 2281.9_wp * rh - 695.11_wp |
---|
7019 | ELSEIF ( rh >= 0.98 .AND. rh < 0.9999 ) THEN |
---|
7020 | binary_h2so4 = 3.0E-8_wp * rh**4 - 5E-6_wp * rh**3 + 0.0003_wp * rh**2 - 0.0022_wp * & |
---|
7021 | rh - 1.1305_wp |
---|
7022 | ENDIF |
---|
7023 | |
---|
7024 | IF ( nitric_acid > 0.0_wp ) THEN |
---|
7025 | hno3_h2so4 = - 16.382_wp * rh**5 + 46.677_wp * rh**4 - 54.149_wp * rh**3 + 34.36_wp * & |
---|
7026 | rh**2 - 12.54_wp * rh + 2.1368_wp |
---|
7027 | ENDIF |
---|
7028 | |
---|
7029 | IF ( hydrochloric_acid > 0.0_wp ) THEN |
---|
7030 | hcl_h2so4 = - 14.409_wp * rh**5 + 42.804_wp * rh**4 - 47.24_wp * rh**3 + 24.668_wp * & |
---|
7031 | rh**2 - 5.8015_wp * rh + 0.084627_wp |
---|
7032 | ENDIF |
---|
7033 | |
---|
7034 | IF ( ammonium_sulphate > 0.0_wp ) THEN |
---|
7035 | nh42so4_h2so4 = 66.71_wp * rh**5 - 187.5_wp * rh**4 + 210.57_wp * rh**3 - 121.04_wp * & |
---|
7036 | rh**2 + 39.182_wp * rh - 8.0606_wp |
---|
7037 | ENDIF |
---|
7038 | |
---|
7039 | IF ( ammonium_nitrate > 0.0_wp ) THEN |
---|
7040 | nh4no3_h2so4 = - 22.532_wp * rh**4 + 66.615_wp * rh**3 - 74.647_wp * rh**2 + 37.638_wp * & |
---|
7041 | rh - 6.9711_wp |
---|
7042 | ENDIF |
---|
7043 | |
---|
7044 | IF ( ammonium_chloride > 0.0_wp ) THEN |
---|
7045 | IF ( rh >= 0.1_wp .AND. rh < 0.2_wp ) THEN |
---|
7046 | nh4cl_h2so4 = - 0.32089_wp * rh + 0.57738_wp |
---|
7047 | ELSEIF ( rh >= 0.2_wp .AND. rh < 0.9_wp ) THEN |
---|
7048 | nh4cl_h2so4 = 18.089_wp * rh**5 - 51.083_wp * rh**4 + 50.32_wp * rh**3 - 17.012_wp * & |
---|
7049 | rh**2 - 0.93435_wp * rh + 1.0548_wp |
---|
7050 | ELSEIF ( rh >= 0.9_wp .AND. rh < 0.99_wp ) THEN |
---|
7051 | nh4cl_h2so4 = - 1.5749_wp * rh + 1.7002_wp |
---|
7052 | ENDIF |
---|
7053 | ENDIF |
---|
7054 | |
---|
7055 | IF ( sodium_sulphate > 0.0_wp ) THEN |
---|
7056 | na2so4_h2so4 = 29.843_wp * rh**4 - 69.417_wp * rh**3 + 61.507_wp * rh**2 - 29.874_wp * & |
---|
7057 | rh + 7.7556_wp |
---|
7058 | ENDIF |
---|
7059 | |
---|
7060 | IF ( sodium_nitrate > 0.0_wp ) THEN |
---|
7061 | nano3_h2so4 = - 122.37_wp * rh**6 + 427.43_wp * rh**5 - 604.68_wp * rh**4 + 443.08_wp * & |
---|
7062 | rh**3 - 178.61_wp * rh**2 + 37.242_wp * rh - 1.9564_wp |
---|
7063 | ENDIF |
---|
7064 | |
---|
7065 | IF ( sodium_chloride > 0.0_wp ) THEN |
---|
7066 | nacl_h2so4 = - 40.288_wp * rh**5 + 115.61_wp * rh**4 - 129.99_wp * rh**3 + 72.652_wp * & |
---|
7067 | rh**2 - 22.124_wp * rh + 4.2676_wp |
---|
7068 | ENDIF |
---|
7069 | |
---|
7070 | ln_h2so4_act = binary_h2so4 + nitric_acid_eq_frac * hno3_h2so4 + & |
---|
7071 | hydrochloric_acid_eq_frac * hcl_h2so4 + & |
---|
7072 | ammonium_sulphate_eq_frac * nh42so4_h2so4 + & |
---|
7073 | ammonium_nitrate_eq_frac * nh4no3_h2so4 + & |
---|
7074 | ammonium_chloride_eq_frac * nh4cl_h2so4 + & |
---|
7075 | sodium_sulphate_eq_frac * na2so4_h2so4 + & |
---|
7076 | sodium_nitrate_eq_frac * nano3_h2so4 + sodium_chloride_eq_frac * nacl_h2so4 |
---|
7077 | |
---|
7078 | gamma_h2so4 = EXP( ln_h2so4_act ) ! molal activity coefficient |
---|
7079 | ! |
---|
7080 | !-- Export activity coefficients |
---|
7081 | IF ( gamma_h2so4 > 1.0E-10_wp ) THEN |
---|
7082 | gamma_out(4) = gamma_hhso4**2 / gamma_h2so4 |
---|
7083 | ENDIF |
---|
7084 | IF ( gamma_hhso4 > 1.0E-10_wp ) THEN |
---|
7085 | gamma_out(5) = gamma_h2so4**3 / gamma_hhso4**2 |
---|
7086 | ENDIF |
---|
7087 | ! |
---|
7088 | !-- Ionic activity coefficient product |
---|
7089 | act_product = gamma_h2so4**3 / gamma_hhso4**2 |
---|
7090 | ! |
---|
7091 | !-- Solve the quadratic equation (i.e. x in ax**2 + bx + c = 0) |
---|
7092 | a = 1.0_wp |
---|
7093 | b = -1.0_wp * ( ions(4) + ions(1) + ( ( water_total * 18.0E-3_wp ) / & |
---|
7094 | ( 99.0_wp * act_product ) ) ) |
---|
7095 | c = ions(4) * ions(1) |
---|
7096 | root1 = ( ( -1.0_wp * b ) + ( ( ( b**2 ) - 4.0_wp * a * c )**0.5_wp ) ) / ( 2.0_wp * a ) |
---|
7097 | root2 = ( ( -1.0_wp * b ) - ( ( ( b**2 ) - 4.0_wp * a * c) **0.5_wp ) ) / ( 2.0_wp * a ) |
---|
7098 | |
---|
7099 | IF ( root1 > ions(1) .OR. root1 < 0.0_wp ) THEN |
---|
7100 | root1 = 0.0_wp |
---|
7101 | ENDIF |
---|
7102 | |
---|
7103 | IF ( root2 > ions(1) .OR. root2 < 0.0_wp ) THEN |
---|
7104 | root2 = 0.0_wp |
---|
7105 | ENDIF |
---|
7106 | ! |
---|
7107 | !-- Calculate the new hydrogen ion, bisulphate ion and sulphate ion |
---|
7108 | !-- concentration |
---|
7109 | h_real = ions(1) |
---|
7110 | so4_real = ions(4) |
---|
7111 | hso4_real = MAX( root1, root2 ) |
---|
7112 | h_real = ions(1) - hso4_real |
---|
7113 | so4_real = ions(4) - hso4_real |
---|
7114 | ! |
---|
7115 | !-- Recalculate ion molalities |
---|
7116 | ions_mol(1) = h_real / ( water_total * 18.01528E-3_wp ) ! H+ |
---|
7117 | ions_mol(4) = so4_real / ( water_total * 18.01528E-3_wp ) ! SO4(2-) |
---|
7118 | ions_mol(5) = hso4_real / ( water_total * 18.01528E-3_wp ) ! HSO4(2-) |
---|
7119 | |
---|
7120 | h_out = h_real |
---|
7121 | hso4_out = hso4_real |
---|
7122 | so4_out = so4_real |
---|
7123 | |
---|
7124 | ELSE |
---|
7125 | h_out = ions(1) |
---|
7126 | hso4_out = 0.0_wp |
---|
7127 | so4_out = ions(4) |
---|
7128 | ENDIF |
---|
7129 | |
---|
7130 | ! |
---|
7131 | !-- 4) ACTIVITY COEFFICIENTS -for vapour pressures of HNO3,HCL and NH3 |
---|
7132 | ! |
---|
7133 | !-- This section evaluates activity coefficients and vapour pressures using the water content |
---|
7134 | !-- calculated above) for each inorganic condensing species: a - HNO3, b - NH3, c - HCL. |
---|
7135 | !-- The following procedure is used: Zaveri et al (2005) found that one could express the variation |
---|
7136 | !-- of activity coefficients linearly in log-space if equivalent mole fractions were used. |
---|
7137 | !-- So, by a taylor series expansion LOG( activity coefficient ) = |
---|
7138 | !-- LOG( binary activity coefficient at a given RH ) + |
---|
7139 | !-- (equivalent mole fraction compound A) * |
---|
7140 | !-- ('interaction' parameter between A and condensing species) + |
---|
7141 | !-- equivalent mole fraction compound B) * |
---|
7142 | !-- ('interaction' parameter between B and condensing species). |
---|
7143 | !-- Here, the interaction parameters have been fit to ADDEM by searching the whole compositon space |
---|
7144 | !-- and fit usign the Levenberg-Marquardt non-linear least squares algorithm. |
---|
7145 | ! |
---|
7146 | !-- They are given as a function of RH and vary with complexity ranging from linear to 5th order |
---|
7147 | !-- polynomial expressions, the binary activity coefficients were calculated using AIM online. |
---|
7148 | !-- NOTE: for NH3, no binary activity coefficient was used and the data were fit to the ratio of the |
---|
7149 | !-- activity coefficients for the ammonium and hydrogen ions. Once the activity coefficients are |
---|
7150 | !-- obtained the vapour pressure can be easily calculated using tabulated equilibrium constants |
---|
7151 | !-- (referenced). This procedure differs from that of Zaveri et al (2005) in that it is not assumed |
---|
7152 | !-- one can carry behaviour from binary mixtures in multicomponent systems. To this end we have fit |
---|
7153 | !-- the 'interaction' parameters explicitly to a general inorganic equilibrium model |
---|
7154 | !-- (ADDEM - Topping et al. 2005a,b). Such parameters take into account bisulphate ion dissociation |
---|
7155 | !-- and water content. This also allows us to consider one regime for all composition space, rather |
---|
7156 | !-- than defining sulphate rich and sulphate poor regimes. |
---|
7157 | !-- NOTE: The flags "binary_case" and "full_complexity" are not used in this prototype. They are |
---|
7158 | !-- used for simplification of the fit expressions when using limited composition regions. |
---|
7159 | ! |
---|
7160 | !-- a) - ACTIVITY COEFF/VAPOUR PRESSURE - HNO3 |
---|
7161 | IF ( ions(1) > 0.0_wp .AND. ions(6) > 0.0_wp ) THEN |
---|
7162 | binary_case = 1 |
---|
7163 | IF ( rh > 0.1_wp .AND. rh < 0.98_wp ) THEN |
---|
7164 | IF ( binary_case == 1 ) THEN |
---|
7165 | binary_hno3 = 1.8514_wp * rh**3 - 4.6991_wp * rh**2 + 1.5514_wp * rh + 0.90236_wp |
---|
7166 | ELSEIF ( binary_case == 2 ) THEN |
---|
7167 | binary_hno3 = - 1.1751_wp * ( rh**2 ) - 0.53794_wp * rh + 1.2808_wp |
---|
7168 | ENDIF |
---|
7169 | ELSEIF ( rh >= 0.98_wp .AND. rh < 0.9999_wp ) THEN |
---|
7170 | binary_hno3 = 1244.69635941351_wp * rh**3 - 2613.93941099991_wp * rh**2 + & |
---|
7171 | 1525.0684974546_wp * rh -155.946764059316_wp |
---|
7172 | ENDIF |
---|
7173 | ! |
---|
7174 | !-- Contributions from other solutes |
---|
7175 | full_complexity = 1 |
---|
7176 | IF ( hydrochloric_acid > 0.0_wp ) THEN ! HCL |
---|
7177 | IF ( full_complexity == 1 .OR. rh < 0.4_wp ) THEN |
---|
7178 | hcl_hno3 = 16.051_wp * rh**4 - 44.357_wp * rh**3 + 45.141_wp * rh**2 - 21.638_wp * & |
---|
7179 | rh + 4.8182_wp |
---|
7180 | ELSEIF ( full_complexity == 0 .AND. rh > 0.4_wp ) THEN |
---|
7181 | hcl_hno3 = - 1.5833_wp * rh + 1.5569_wp |
---|
7182 | ENDIF |
---|
7183 | ENDIF |
---|
7184 | |
---|
7185 | IF ( sulphuric_acid > 0.0_wp ) THEN ! H2SO4 |
---|
7186 | IF ( full_complexity == 1 .OR. rh < 0.4_wp ) THEN |
---|
7187 | h2so4_hno3 = - 3.0849_wp * rh**3 + 5.9609_wp * rh**2 - 4.468_wp * rh + 1.5658_wp |
---|
7188 | ELSEIF ( full_complexity == 0 .AND. rh > 0.4_wp ) THEN |
---|
7189 | h2so4_hno3 = - 0.93473_wp * rh + 0.9363_wp |
---|
7190 | ENDIF |
---|
7191 | ENDIF |
---|
7192 | |
---|
7193 | IF ( ammonium_sulphate > 0.0_wp ) THEN ! NH42SO4 |
---|
7194 | nh42so4_hno3 = 16.821_wp * rh**3 - 28.391_wp * rh**2 + 18.133_wp * rh - 6.7356_wp |
---|
7195 | ENDIF |
---|
7196 | |
---|
7197 | IF ( ammonium_nitrate > 0.0_wp ) THEN ! NH4NO3 |
---|
7198 | nh4no3_hno3 = 11.01_wp * rh**3 - 21.578_wp * rh**2 + 14.808_wp * rh - 4.2593_wp |
---|
7199 | ENDIF |
---|
7200 | |
---|
7201 | IF ( ammonium_chloride > 0.0_wp ) THEN ! NH4Cl |
---|
7202 | IF ( full_complexity == 1 .OR. rh <= 0.4_wp ) THEN |
---|
7203 | nh4cl_hno3 = - 1.176_wp * rh**3 + 5.0828_wp * rh**2 - 3.8792_wp * rh - 0.05518_wp |
---|
7204 | ELSEIF ( full_complexity == 0 .AND. rh > 0.4_wp ) THEN |
---|
7205 | nh4cl_hno3 = 2.6219_wp * rh**2 - 2.2609_wp * rh - 0.38436_wp |
---|
7206 | ENDIF |
---|
7207 | ENDIF |
---|
7208 | |
---|
7209 | IF ( sodium_sulphate > 0.0_wp ) THEN ! Na2SO4 |
---|
7210 | na2so4_hno3 = 35.504_wp * rh**4 - 80.101_wp * rh**3 + 67.326_wp * rh**2 - 28.461_wp * & |
---|
7211 | rh + 5.6016_wp |
---|
7212 | ENDIF |
---|
7213 | |
---|
7214 | IF ( sodium_nitrate > 0.0_wp ) THEN ! NaNO3 |
---|
7215 | IF ( full_complexity == 1 .OR. rh <= 0.4_wp ) THEN |
---|
7216 | nano3_hno3 = 23.659_wp * rh**5 - 66.917_wp * rh**4 + 74.686_wp * rh**3 - 40.795_wp * & |
---|
7217 | rh**2 + 10.831_wp * rh - 1.4701_wp |
---|
7218 | ELSEIF ( full_complexity == 0 .AND. rh > 0.4_wp ) THEN |
---|
7219 | nano3_hno3 = 14.749_wp * rh**4 - 35.237_wp * rh**3 + 31.196_wp * rh**2 - 12.076_wp * & |
---|
7220 | rh + 1.3605_wp |
---|
7221 | ENDIF |
---|
7222 | ENDIF |
---|
7223 | |
---|
7224 | IF ( sodium_chloride > 0.0_wp ) THEN ! NaCl |
---|
7225 | IF ( full_complexity == 1 .OR. rh <= 0.4_wp ) THEN |
---|
7226 | nacl_hno3 = 13.682_wp * rh**4 - 35.122_wp * rh**3 + 33.397_wp * rh**2 - 14.586_wp * & |
---|
7227 | rh + 2.6276_wp |
---|
7228 | ELSEIF ( full_complexity == 0 .AND. rh > 0.4_wp ) THEN |
---|
7229 | nacl_hno3 = 1.1882_wp * rh**3 - 1.1037_wp * rh**2 - 0.7642_wp * rh + 0.6671_wp |
---|
7230 | ENDIF |
---|
7231 | ENDIF |
---|
7232 | |
---|
7233 | ln_hno3_act = binary_hno3 + hydrochloric_acid_eq_frac * hcl_hno3 + & |
---|
7234 | sulphuric_acid_eq_frac * h2so4_hno3 + & |
---|
7235 | ammonium_sulphate_eq_frac * nh42so4_hno3 + & |
---|
7236 | ammonium_nitrate_eq_frac * nh4no3_hno3 + & |
---|
7237 | ammonium_chloride_eq_frac * nh4cl_hno3 + & |
---|
7238 | sodium_sulphate_eq_frac * na2so4_hno3 + & |
---|
7239 | sodium_nitrate_eq_frac * nano3_hno3 + sodium_chloride_eq_frac * nacl_hno3 |
---|
7240 | |
---|
7241 | gamma_hno3 = EXP( ln_hno3_act ) ! Molal activity coefficient of HNO3 |
---|
7242 | gamma_out(1) = gamma_hno3 |
---|
7243 | ! |
---|
7244 | !-- Partial pressure calculation |
---|
7245 | !-- k_hno3 = 2.51 * ( 10**6 ) |
---|
7246 | !-- k_hno3 = 2.628145923d6 !< calculated by AIM online (Clegg et al 1998) after Chameides (1984) |
---|
7247 | k_hno3 = 2.6E6_wp * EXP( 8700.0_wp * henrys_temp_dep ) |
---|
7248 | press_hno3 = ( ions_mol(1) * ions_mol(6) * ( gamma_hno3**2 ) ) / k_hno3 |
---|
7249 | ENDIF |
---|
7250 | ! |
---|
7251 | !-- b) - ACTIVITY COEFF/VAPOUR PRESSURE - NH3 |
---|
7252 | !-- Follow the two solute approach of Zaveri et al. (2005) |
---|
7253 | IF ( ions(2) > 0.0_wp .AND. ions_mol(1) > 0.0_wp ) THEN |
---|
7254 | ! |
---|
7255 | !-- NH4HSO4: |
---|
7256 | binary_nh4hso4 = 56.907_wp * rh**6 - 155.32_wp * rh**5 + 142.94_wp * rh**4 - 32.298_wp * & |
---|
7257 | rh**3 - 27.936_wp * rh**2 + 19.502_wp * rh - 4.2618_wp |
---|
7258 | IF ( nitric_acid > 0.0_wp) THEN ! HNO3 |
---|
7259 | hno3_nh4hso4 = 104.8369_wp * rh**8 - 288.8923_wp * rh**7 + 129.3445_wp * rh**6 + & |
---|
7260 | 373.0471_wp * rh**5 - 571.0385_wp * rh**4 + 326.3528_wp * rh**3 - & |
---|
7261 | 74.169_wp * rh**2 - 2.4999_wp * rh + 3.17_wp |
---|
7262 | ENDIF |
---|
7263 | |
---|
7264 | IF ( hydrochloric_acid > 0.0_wp) THEN ! HCL |
---|
7265 | hcl_nh4hso4 = - 7.9133_wp * rh**8 + 126.6648_wp * rh**7 - 460.7425_wp * rh**6 + & |
---|
7266 | 731.606_wp * rh**5 - 582.7467_wp * rh**4 + 216.7197_wp * rh**3 - & |
---|
7267 | 11.3934_wp * rh**2 - 17.7728_wp * rh + 5.75_wp |
---|
7268 | ENDIF |
---|
7269 | |
---|
7270 | IF ( sulphuric_acid > 0.0_wp) THEN ! H2SO4 |
---|
7271 | h2so4_nh4hso4 = 195.981_wp * rh**8 - 779.2067_wp * rh**7 + 1226.3647_wp * rh**6 - & |
---|
7272 | 964.0261_wp * rh**5 + 391.7911_wp * rh**4 - 84.1409_wp * rh**3 + & |
---|
7273 | 20.0602_wp * rh**2 - 10.2663_wp * rh + 3.5817_wp |
---|
7274 | ENDIF |
---|
7275 | |
---|
7276 | IF ( ammonium_sulphate > 0.0_wp) THEN ! NH42SO4 |
---|
7277 | nh42so4_nh4hso4 = 617.777_wp * rh**8 - 2547.427_wp * rh**7 + 4361.6009_wp * rh**6 - & |
---|
7278 | 4003.162_wp * rh**5 + 2117.8281_wp * rh**4 - 640.0678_wp * rh**3 + & |
---|
7279 | 98.0902_wp * rh**2 - 2.2615_wp * rh - 2.3811_wp |
---|
7280 | ENDIF |
---|
7281 | |
---|
7282 | IF ( ammonium_nitrate > 0.0_wp) THEN ! NH4NO3 |
---|
7283 | nh4no3_nh4hso4 = - 104.4504_wp * rh**8 + 539.5921_wp * rh**7 - 1157.0498_wp * rh**6 + & |
---|
7284 | 1322.4507_wp * rh**5 - 852.2475_wp * rh**4 + 298.3734_wp * rh**3 - & |
---|
7285 | 47.0309_wp * rh**2 + 1.297_wp * rh - 0.8029_wp |
---|
7286 | ENDIF |
---|
7287 | |
---|
7288 | IF ( ammonium_chloride > 0.0_wp) THEN ! NH4Cl |
---|
7289 | nh4cl_nh4hso4 = 258.1792_wp * rh**8 - 1019.3777_wp * rh**7 + 1592.8918_wp * rh**6 - & |
---|
7290 | 1221.0726_wp * rh**5 + 442.2548_wp * rh**4 - 43.6278_wp * rh**3 - & |
---|
7291 | 7.5282_wp * rh**2 - 3.8459_wp * rh + 2.2728_wp |
---|
7292 | ENDIF |
---|
7293 | |
---|
7294 | IF ( sodium_sulphate > 0.0_wp) THEN ! Na2SO4 |
---|
7295 | na2so4_nh4hso4 = 225.4238_wp * rh**8 - 732.4113_wp * rh**7 + 843.7291_wp * rh**6 - & |
---|
7296 | 322.7328_wp * rh**5 - 88.6252_wp * rh**4 + 72.4434_wp * rh**3 + & |
---|
7297 | 22.9252_wp * rh**2 - 25.3954_wp * rh + 4.6971_wp |
---|
7298 | ENDIF |
---|
7299 | |
---|
7300 | IF ( sodium_nitrate > 0.0_wp) THEN ! NaNO3 |
---|
7301 | nano3_nh4hso4 = 96.1348_wp * rh**8 - 341.6738_wp * rh**7 + 406.5314_wp * rh**6 - & |
---|
7302 | 98.5777_wp * rh**5 - 172.8286_wp * rh**4 + 149.3151_wp * rh**3 - & |
---|
7303 | 38.9998_wp * rh**2 - 0.2251_wp * rh + 0.4953_wp |
---|
7304 | ENDIF |
---|
7305 | |
---|
7306 | IF ( sodium_chloride > 0.0_wp) THEN ! NaCl |
---|
7307 | nacl_nh4hso4 = 91.7856_wp * rh**8 - 316.6773_wp * rh**7 + 358.2703_wp * rh**6 - & |
---|
7308 | 68.9142_wp * rh**5 - 156.5031_wp * rh**4 + 116.9592_wp * rh**3 - & |
---|
7309 | 22.5271_wp * rh**2 - 3.7716_wp * rh + 1.56_wp |
---|
7310 | ENDIF |
---|
7311 | |
---|
7312 | ln_nh4hso4_act = binary_nh4hso4 + nitric_acid_eq_frac * hno3_nh4hso4 + & |
---|
7313 | hydrochloric_acid_eq_frac * hcl_nh4hso4 + & |
---|
7314 | sulphuric_acid_eq_frac * h2so4_nh4hso4 + & |
---|
7315 | ammonium_sulphate_eq_frac * nh42so4_nh4hso4 + & |
---|
7316 | ammonium_nitrate_eq_frac * nh4no3_nh4hso4 + & |
---|
7317 | ammonium_chloride_eq_frac * nh4cl_nh4hso4 + & |
---|
7318 | sodium_sulphate_eq_frac * na2so4_nh4hso4 + & |
---|
7319 | sodium_nitrate_eq_frac * nano3_nh4hso4 + & |
---|
7320 | sodium_chloride_eq_frac * nacl_nh4hso4 |
---|
7321 | |
---|
7322 | gamma_nh4hso4 = EXP( ln_nh4hso4_act ) ! molal act. coefficient of NH4HSO4 |
---|
7323 | ! |
---|
7324 | !-- Molal activity coefficient of NO3- |
---|
7325 | gamma_out(6) = gamma_nh4hso4 |
---|
7326 | ! |
---|
7327 | !-- Molal activity coefficient of NH4+ |
---|
7328 | gamma_nh3 = gamma_nh4hso4**2 / gamma_hhso4**2 |
---|
7329 | gamma_out(3) = gamma_nh3 |
---|
7330 | ! |
---|
7331 | !-- This actually represents the ratio of the ammonium to hydrogen ion activity coefficients |
---|
7332 | !-- (see Zaveri paper) - multiply this by the ratio of the ammonium to hydrogen ion molality and |
---|
7333 | !-- the ratio of appropriate equilibrium constants |
---|
7334 | ! |
---|
7335 | !-- Equilibrium constants |
---|
7336 | !-- k_h = 57.64d0 ! Zaveri et al. (2005) |
---|
7337 | k_h = 5.8E1_wp * EXP( 4085.0_wp * henrys_temp_dep ) ! after Chameides (1984) |
---|
7338 | !-- k_nh4 = 1.81E-5_wp ! Zaveri et al. (2005) |
---|
7339 | k_nh4 = 1.7E-5_wp * EXP( -4325.0_wp * henrys_temp_dep ) ! Chameides (1984) |
---|
7340 | !-- k_h2o = 1.01E-14_wp ! Zaveri et al (2005) |
---|
7341 | k_h2o = 1.E-14_wp * EXP( -6716.0_wp * henrys_temp_dep ) ! Chameides (1984) |
---|
7342 | ! |
---|
7343 | molality_ratio_nh3 = ions_mol(2) / ions_mol(1) |
---|
7344 | ! |
---|
7345 | !-- Partial pressure calculation |
---|
7346 | press_nh3 = molality_ratio_nh3 * gamma_nh3 * ( k_h2o / ( k_h * k_nh4 ) ) |
---|
7347 | |
---|
7348 | ENDIF |
---|
7349 | ! |
---|
7350 | !-- c) - ACTIVITY COEFF/VAPOUR PRESSURE - HCL |
---|
7351 | IF ( ions(1) > 0.0_wp .AND. ions(7) > 0.0_wp ) THEN |
---|
7352 | binary_case = 1 |
---|
7353 | IF ( rh > 0.1_wp .AND. rh < 0.98 ) THEN |
---|
7354 | IF ( binary_case == 1 ) THEN |
---|
7355 | binary_hcl = - 5.0179_wp * rh**3 + 9.8816_wp * rh**2 - 10.789_wp * rh + 5.4737_wp |
---|
7356 | ELSEIF ( binary_case == 2 ) THEN |
---|
7357 | binary_hcl = - 4.6221_wp * rh + 4.2633_wp |
---|
7358 | ENDIF |
---|
7359 | ELSEIF ( rh >= 0.98_wp .AND. rh < 0.9999_wp ) THEN |
---|
7360 | binary_hcl = 775.6111008626_wp * rh**3 - 2146.01320888771_wp * rh**2 + & |
---|
7361 | 1969.01979670259_wp * rh - 598.878230033926_wp |
---|
7362 | ENDIF |
---|
7363 | ENDIF |
---|
7364 | |
---|
7365 | IF ( nitric_acid > 0.0_wp ) THEN ! HNO3 |
---|
7366 | IF ( full_complexity == 1 .OR. rh <= 0.4_wp ) THEN |
---|
7367 | hno3_hcl = 9.6256_wp * rh**4 - 26.507_wp * rh**3 + 27.622_wp * rh**2 - 12.958_wp * rh + & |
---|
7368 | 2.2193_wp |
---|
7369 | ELSEIF ( full_complexity == 0 .AND. rh > 0.4_wp ) THEN |
---|
7370 | hno3_hcl = 1.3242_wp * rh**2 - 1.8827_wp * rh + 0.55706_wp |
---|
7371 | ENDIF |
---|
7372 | ENDIF |
---|
7373 | |
---|
7374 | IF ( sulphuric_acid > 0.0_wp ) THEN ! H2SO4 |
---|
7375 | IF ( full_complexity == 1 .OR. rh <= 0.4 ) THEN |
---|
7376 | h2so4_hcl = 1.4406_wp * rh**3 - 2.7132_wp * rh**2 + 1.014_wp * rh + 0.25226_wp |
---|
7377 | ELSEIF ( full_complexity == 0 .AND. rh > 0.4_wp ) THEN |
---|
7378 | h2so4_hcl = 0.30993_wp * rh**2 - 0.99171_wp * rh + 0.66913_wp |
---|
7379 | ENDIF |
---|
7380 | ENDIF |
---|
7381 | |
---|
7382 | IF ( ammonium_sulphate > 0.0_wp ) THEN ! NH42SO4 |
---|
7383 | nh42so4_hcl = 22.071_wp * rh**3 - 40.678_wp * rh**2 + 27.893_wp * rh - 9.4338_wp |
---|
7384 | ENDIF |
---|
7385 | |
---|
7386 | IF ( ammonium_nitrate > 0.0_wp ) THEN ! NH4NO3 |
---|
7387 | nh4no3_hcl = 19.935_wp * rh**3 - 42.335_wp * rh**2 + 31.275_wp * rh - 8.8675_wp |
---|
7388 | ENDIF |
---|
7389 | |
---|
7390 | IF ( ammonium_chloride > 0.0_wp ) THEN ! NH4Cl |
---|
7391 | IF ( full_complexity == 1 .OR. rh <= 0.4_wp ) THEN |
---|
7392 | nh4cl_hcl = 2.8048_wp * rh**3 - 4.3182_wp * rh**2 + 3.1971_wp * rh - 1.6824_wp |
---|
7393 | ELSEIF ( full_complexity == 0 .AND. rh > 0.4_wp ) THEN |
---|
7394 | nh4cl_hcl = 1.2304_wp * rh**2 - 0.18262_wp * rh - 1.0643_wp |
---|
7395 | ENDIF |
---|
7396 | ENDIF |
---|
7397 | |
---|
7398 | IF ( sodium_sulphate > 0.0_wp ) THEN ! Na2SO4 |
---|
7399 | na2so4_hcl = 36.104_wp * rh**4 - 78.658_wp * rh**3 + 63.441_wp * rh**2 - 26.727_wp * rh + & |
---|
7400 | 5.7007_wp |
---|
7401 | ENDIF |
---|
7402 | |
---|
7403 | IF ( sodium_nitrate > 0.0_wp ) THEN ! NaNO3 |
---|
7404 | IF ( full_complexity == 1 .OR. rh <= 0.4_wp ) THEN |
---|
7405 | nano3_hcl = 54.471_wp * rh**5 - 159.42_wp * rh**4 + 180.25_wp * rh**3 - 98.176_wp * rh**2& |
---|
7406 | + 25.309_wp * rh - 2.4275_wp |
---|
7407 | ELSEIF ( full_complexity == 0 .AND. rh > 0.4_wp ) THEN |
---|
7408 | nano3_hcl = 21.632_wp * rh**4 - 53.088_wp * rh**3 + 47.285_wp * rh**2 - 18.519_wp * rh & |
---|
7409 | + 2.6846_wp |
---|
7410 | ENDIF |
---|
7411 | ENDIF |
---|
7412 | |
---|
7413 | IF ( sodium_chloride > 0.0_wp ) THEN ! NaCl |
---|
7414 | IF ( full_complexity == 1 .OR. rh <= 0.4_wp ) THEN |
---|
7415 | nacl_hcl = 5.4138_wp * rh**4 - 12.079_wp * rh**3 + 9.627_wp * rh**2 - 3.3164_wp * rh + & |
---|
7416 | 0.35224_wp |
---|
7417 | ELSEIF ( full_complexity == 0 .AND. rh > 0.4_wp ) THEN |
---|
7418 | nacl_hcl = 2.432_wp * rh**3 - 4.3453_wp * rh**2 + 2.3834_wp * rh - 0.4762_wp |
---|
7419 | ENDIF |
---|
7420 | ENDIF |
---|
7421 | |
---|
7422 | ln_HCL_act = binary_hcl + nitric_acid_eq_frac * hno3_hcl + sulphuric_acid_eq_frac * h2so4_hcl +& |
---|
7423 | ammonium_sulphate_eq_frac * nh42so4_hcl + ammonium_nitrate_eq_frac * nh4no3_hcl + & |
---|
7424 | ammonium_chloride_eq_frac * nh4cl_hcl + sodium_sulphate_eq_frac * na2so4_hcl + & |
---|
7425 | sodium_nitrate_eq_frac * nano3_hcl + sodium_chloride_eq_frac * nacl_hcl |
---|
7426 | |
---|
7427 | gamma_hcl = EXP( ln_HCL_act ) ! Molal activity coefficient |
---|
7428 | gamma_out(2) = gamma_hcl |
---|
7429 | ! |
---|
7430 | !-- Equilibrium constant after Wagman et al. (1982) (and NIST database) |
---|
7431 | k_hcl = 2E6_wp * EXP( 9000.0_wp * henrys_temp_dep ) |
---|
7432 | |
---|
7433 | press_hcl = ( ions_mol(1) * ions_mol(7) * gamma_hcl**2 ) / k_hcl |
---|
7434 | ! |
---|
7435 | !-- 5) Ion molility output |
---|
7436 | mols_out = ions_mol |
---|
7437 | |
---|
7438 | END SUBROUTINE inorganic_pdfite |
---|
7439 | |
---|
7440 | !------------------------------------------------------------------------------! |
---|
7441 | ! Description: |
---|
7442 | ! ------------ |
---|
7443 | !> Update the particle size distribution. Put particles into corrects bins. |
---|
7444 | !> |
---|
7445 | !> Moving-centre method assumed, i.e. particles are allowed to grow to their |
---|
7446 | !> exact size as long as they are not crossing the fixed diameter bin limits. |
---|
7447 | !> If the particles in a size bin cross the lower or upper diameter limit, they |
---|
7448 | !> are all moved to the adjacent diameter bin and their volume is averaged with |
---|
7449 | !> the particles in the new bin, which then get a new diameter. |
---|
7450 | ! |
---|
7451 | !> Moving-centre method minimises numerical diffusion. |
---|
7452 | !------------------------------------------------------------------------------! |
---|
7453 | SUBROUTINE distr_update( paero ) |
---|
7454 | |
---|
7455 | IMPLICIT NONE |
---|
7456 | |
---|
7457 | INTEGER(iwp) :: ib !< loop index |
---|
7458 | INTEGER(iwp) :: mm !< loop index |
---|
7459 | INTEGER(iwp) :: counti !< number of while loops |
---|
7460 | |
---|
7461 | LOGICAL :: within_bins !< logical (particle belongs to the bin?) |
---|
7462 | |
---|
7463 | REAL(wp) :: znfrac !< number fraction to be moved to the larger bin |
---|
7464 | REAL(wp) :: zvfrac !< volume fraction to be moved to the larger bin |
---|
7465 | REAL(wp) :: zvexc !< Volume in the grown bin which exceeds the bin upper limit |
---|
7466 | REAL(wp) :: zvihi !< particle volume at the high end of the bin |
---|
7467 | REAL(wp) :: zvilo !< particle volume at the low end of the bin |
---|
7468 | REAL(wp) :: zvpart !< particle volume (m3) |
---|
7469 | REAL(wp) :: zvrat !< volume ratio of a size bin |
---|
7470 | |
---|
7471 | real(wp), dimension(nbins_aerosol) :: dummy |
---|
7472 | |
---|
7473 | TYPE(t_section), DIMENSION(nbins_aerosol), INTENT(inout) :: paero !< aerosol properties |
---|
7474 | |
---|
7475 | zvpart = 0.0_wp |
---|
7476 | zvfrac = 0.0_wp |
---|
7477 | within_bins = .FALSE. |
---|
7478 | |
---|
7479 | dummy = paero(:)%numc |
---|
7480 | ! |
---|
7481 | !-- Check if the volume of the bin is within bin limits after update |
---|
7482 | counti = 0 |
---|
7483 | DO WHILE ( .NOT. within_bins ) |
---|
7484 | within_bins = .TRUE. |
---|
7485 | ! |
---|
7486 | !-- Loop from larger to smaller size bins |
---|
7487 | DO ib = end_subrange_2b-1, start_subrange_1a, -1 |
---|
7488 | mm = 0 |
---|
7489 | IF ( paero(ib)%numc > nclim ) THEN |
---|
7490 | zvpart = 0.0_wp |
---|
7491 | zvfrac = 0.0_wp |
---|
7492 | |
---|
7493 | IF ( ib == end_subrange_2a ) CYCLE |
---|
7494 | ! |
---|
7495 | !-- Dry volume |
---|
7496 | zvpart = SUM( paero(ib)%volc(1:7) ) / paero(ib)%numc |
---|
7497 | ! |
---|
7498 | !-- Smallest bin cannot decrease |
---|
7499 | IF ( paero(ib)%vlolim > zvpart .AND. ib == start_subrange_1a ) CYCLE |
---|
7500 | ! |
---|
7501 | !-- Decreasing bins |
---|
7502 | IF ( paero(ib)%vlolim > zvpart ) THEN |
---|
7503 | mm = ib - 1 |
---|
7504 | IF ( ib == start_subrange_2b ) mm = end_subrange_1a ! 2b goes to 1a |
---|
7505 | |
---|
7506 | paero(mm)%numc = paero(mm)%numc + paero(ib)%numc |
---|
7507 | paero(ib)%numc = 0.0_wp |
---|
7508 | paero(mm)%volc(:) = paero(mm)%volc(:) + paero(ib)%volc(:) |
---|
7509 | paero(ib)%volc(:) = 0.0_wp |
---|
7510 | CYCLE |
---|
7511 | ENDIF |
---|
7512 | ! |
---|
7513 | !-- If size bin has not grown, cycle. |
---|
7514 | !-- Changed by Mona: compare to the arithmetic mean volume, as done originally. Now |
---|
7515 | !-- particle volume is derived from the geometric mean diameter, not arithmetic (see |
---|
7516 | !-- SUBROUTINE set_sizebins). |
---|
7517 | IF ( zvpart <= api6 * ( ( aero(ib)%vhilim + aero(ib)%vlolim ) / ( 2.0_wp * api6 ) ) ) & |
---|
7518 | CYCLE |
---|
7519 | ! |
---|
7520 | !-- Avoid precision problems |
---|
7521 | IF ( ABS( zvpart - api6 * paero(ib)%dmid**3 ) < 1.0E-35_wp ) CYCLE |
---|
7522 | ! |
---|
7523 | !-- Volume ratio of the size bin |
---|
7524 | zvrat = paero(ib)%vhilim / paero(ib)%vlolim |
---|
7525 | ! |
---|
7526 | !-- Particle volume at the low end of the bin |
---|
7527 | zvilo = 2.0_wp * zvpart / ( 1.0_wp + zvrat ) |
---|
7528 | ! |
---|
7529 | !-- Particle volume at the high end of the bin |
---|
7530 | zvihi = zvrat * zvilo |
---|
7531 | ! |
---|
7532 | !-- Volume in the grown bin which exceeds the bin upper limit |
---|
7533 | zvexc = 0.5_wp * ( zvihi + paero(ib)%vhilim ) |
---|
7534 | ! |
---|
7535 | !-- Number fraction to be moved to the larger bin |
---|
7536 | znfrac = MIN( 1.0_wp, ( zvihi - paero(ib)%vhilim) / ( zvihi - zvilo ) ) |
---|
7537 | ! |
---|
7538 | !-- Volume fraction to be moved to the larger bin |
---|
7539 | zvfrac = MIN( 0.99_wp, znfrac * zvexc / zvpart ) |
---|
7540 | IF ( zvfrac < 0.0_wp ) THEN |
---|
7541 | message_string = 'Error: zvfrac < 0' |
---|
7542 | CALL message( 'salsa_mod: distr_update', 'PA0624', 1, 2, 0, 6, 0 ) |
---|
7543 | ENDIF |
---|
7544 | ! |
---|
7545 | !-- Update bin |
---|
7546 | mm = ib + 1 |
---|
7547 | ! |
---|
7548 | !-- Volume (cm3/cm3) |
---|
7549 | paero(mm)%volc(:) = paero(mm)%volc(:) + znfrac * paero(ib)%numc * zvexc * & |
---|
7550 | paero(ib)%volc(:) / SUM( paero(ib)%volc(1:7) ) |
---|
7551 | paero(ib)%volc(:) = paero(ib)%volc(:) - znfrac * paero(ib)%numc * zvexc * & |
---|
7552 | paero(ib)%volc(:) / SUM( paero(ib)%volc(1:7) ) |
---|
7553 | |
---|
7554 | !-- Number concentration (#/m3) |
---|
7555 | paero(mm)%numc = paero(mm)%numc + znfrac * paero(ib)%numc |
---|
7556 | paero(ib)%numc = paero(ib)%numc * ( 1.0_wp - znfrac ) |
---|
7557 | |
---|
7558 | ENDIF ! nclim |
---|
7559 | |
---|
7560 | IF ( paero(ib)%numc > nclim ) THEN |
---|
7561 | zvpart = SUM( paero(ib)%volc(1:7) ) / paero(ib)%numc ! Note: dry volume! |
---|
7562 | within_bins = ( paero(ib)%vlolim < zvpart .AND. zvpart < paero(ib)%vhilim ) |
---|
7563 | ENDIF |
---|
7564 | |
---|
7565 | ENDDO ! - ib |
---|
7566 | |
---|
7567 | counti = counti + 1 |
---|
7568 | IF ( counti > 100 ) THEN |
---|
7569 | message_string = 'Error: Aerosol bin update not converged' |
---|
7570 | CALL message( 'salsa_mod: distr_update', 'PA0625', 1, 2, 0, 6, 0 ) |
---|
7571 | ENDIF |
---|
7572 | |
---|
7573 | ENDDO ! - within bins |
---|
7574 | |
---|
7575 | END SUBROUTINE distr_update |
---|
7576 | |
---|
7577 | !------------------------------------------------------------------------------! |
---|
7578 | ! Description: |
---|
7579 | ! ------------ |
---|
7580 | !> salsa_diagnostics: Update properties for the current timestep: |
---|
7581 | !> |
---|
7582 | !> Juha Tonttila, FMI, 2014 |
---|
7583 | !> Tomi Raatikainen, FMI, 2016 |
---|
7584 | !------------------------------------------------------------------------------! |
---|
7585 | SUBROUTINE salsa_diagnostics( i, j ) |
---|
7586 | |
---|
7587 | USE cpulog, & |
---|
7588 | ONLY: cpu_log, log_point_s |
---|
7589 | |
---|
7590 | IMPLICIT NONE |
---|
7591 | |
---|
7592 | INTEGER(iwp) :: ib !< |
---|
7593 | INTEGER(iwp) :: ic !< |
---|
7594 | INTEGER(iwp) :: icc !< |
---|
7595 | INTEGER(iwp) :: ig !< |
---|
7596 | INTEGER(iwp) :: k !< |
---|
7597 | |
---|
7598 | INTEGER(iwp), INTENT(in) :: i !< |
---|
7599 | INTEGER(iwp), INTENT(in) :: j !< |
---|
7600 | |
---|
7601 | REAL(wp), DIMENSION(nzb:nzt+1) :: flag !< flag to mask topography |
---|
7602 | REAL(wp), DIMENSION(nzb:nzt+1) :: flag_zddry !< flag to mask zddry |
---|
7603 | REAL(wp), DIMENSION(nzb:nzt+1) :: in_adn !< air density (kg/m3) |
---|
7604 | REAL(wp), DIMENSION(nzb:nzt+1) :: in_p !< pressure |
---|
7605 | REAL(wp), DIMENSION(nzb:nzt+1) :: in_t !< temperature (K) |
---|
7606 | REAL(wp), DIMENSION(nzb:nzt+1) :: mcsum !< sum of mass concentration |
---|
7607 | REAL(wp), DIMENSION(nzb:nzt+1) :: ppm_to_nconc !< Conversion factor: ppm to #/m3 |
---|
7608 | REAL(wp), DIMENSION(nzb:nzt+1) :: zddry !< particle dry diameter |
---|
7609 | REAL(wp), DIMENSION(nzb:nzt+1) :: zvol !< particle volume |
---|
7610 | |
---|
7611 | flag_zddry = 0.0_wp |
---|
7612 | in_adn = 0.0_wp |
---|
7613 | in_p = 0.0_wp |
---|
7614 | in_t = 0.0_wp |
---|
7615 | ppm_to_nconc = 1.0_wp |
---|
7616 | zddry = 0.0_wp |
---|
7617 | zvol = 0.0_wp |
---|
7618 | |
---|
7619 | !$OMP MASTER |
---|
7620 | CALL cpu_log( log_point_s(94), 'salsa diagnostics ', 'start' ) |
---|
7621 | !$OMP END MASTER |
---|
7622 | |
---|
7623 | ! |
---|
7624 | !-- Calculate thermodynamic quantities needed in SALSA |
---|
7625 | CALL salsa_thrm_ij( i, j, p_ij=in_p, temp_ij=in_t, adn_ij=in_adn ) |
---|
7626 | ! |
---|
7627 | !-- Calculate conversion factors for gas concentrations |
---|
7628 | ppm_to_nconc = for_ppm_to_nconc * in_p / in_t |
---|
7629 | ! |
---|
7630 | !-- Predetermine flag to mask topography |
---|
7631 | flag = MERGE( 1.0_wp, 0.0_wp, BTEST( wall_flags_total_0(:,j,i), 0 ) ) |
---|
7632 | |
---|
7633 | DO ib = 1, nbins_aerosol ! aerosol size bins |
---|
7634 | ! |
---|
7635 | !-- Remove negative values |
---|
7636 | aerosol_number(ib)%conc(:,j,i) = MAX( nclim, aerosol_number(ib)%conc(:,j,i) ) * flag |
---|
7637 | ! |
---|
7638 | !-- Calculate total mass concentration per bin |
---|
7639 | mcsum = 0.0_wp |
---|
7640 | DO ic = 1, ncomponents_mass |
---|
7641 | icc = ( ic - 1 ) * nbins_aerosol + ib |
---|
7642 | mcsum = mcsum + aerosol_mass(icc)%conc(:,j,i) * flag |
---|
7643 | aerosol_mass(icc)%conc(:,j,i) = MAX( mclim, aerosol_mass(icc)%conc(:,j,i) ) * flag |
---|
7644 | ENDDO |
---|
7645 | ! |
---|
7646 | !-- Check that number and mass concentration match qualitatively |
---|
7647 | IF ( ANY( aerosol_number(ib)%conc(:,j,i) > nclim .AND. mcsum <= 0.0_wp ) ) THEN |
---|
7648 | DO k = nzb+1, nzt |
---|
7649 | IF ( aerosol_number(ib)%conc(k,j,i) >= nclim .AND. mcsum(k) <= 0.0_wp ) THEN |
---|
7650 | aerosol_number(ib)%conc(k,j,i) = nclim * flag(k) |
---|
7651 | DO ic = 1, ncomponents_mass |
---|
7652 | icc = ( ic - 1 ) * nbins_aerosol + ib |
---|
7653 | aerosol_mass(icc)%conc(k,j,i) = mclim * flag(k) |
---|
7654 | ENDDO |
---|
7655 | ENDIF |
---|
7656 | ENDDO |
---|
7657 | ENDIF |
---|
7658 | ! |
---|
7659 | !-- Update aerosol particle radius |
---|
7660 | CALL bin_mixrat( 'dry', ib, i, j, zvol ) |
---|
7661 | zvol = zvol / arhoh2so4 ! Why on sulphate? |
---|
7662 | ! |
---|
7663 | !-- Particles smaller then 0.1 nm diameter are set to zero |
---|
7664 | zddry = ( zvol / MAX( nclim, aerosol_number(ib)%conc(:,j,i) ) / api6 )**0.33333333_wp |
---|
7665 | flag_zddry = MERGE( 1.0_wp, 0.0_wp, ( zddry < 1.0E-10_wp .AND. & |
---|
7666 | aerosol_number(ib)%conc(:,j,i) > nclim ) ) |
---|
7667 | ! |
---|
7668 | !-- Volatile species to the gas phase |
---|
7669 | IF ( index_so4 > 0 .AND. lscndgas ) THEN |
---|
7670 | ic = ( index_so4 - 1 ) * nbins_aerosol + ib |
---|
7671 | IF ( salsa_gases_from_chem ) THEN |
---|
7672 | ig = gas_index_chem(1) |
---|
7673 | chem_species(ig)%conc(:,j,i) = chem_species(ig)%conc(:,j,i) + & |
---|
7674 | aerosol_mass(ic)%conc(:,j,i) * avo * flag_zddry / & |
---|
7675 | ( amh2so4 * ppm_to_nconc ) * flag |
---|
7676 | ELSE |
---|
7677 | salsa_gas(1)%conc(:,j,i) = salsa_gas(1)%conc(:,j,i) + aerosol_mass(ic)%conc(:,j,i) / & |
---|
7678 | amh2so4 * avo * flag_zddry * flag |
---|
7679 | ENDIF |
---|
7680 | ENDIF |
---|
7681 | IF ( index_oc > 0 .AND. lscndgas ) THEN |
---|
7682 | ic = ( index_oc - 1 ) * nbins_aerosol + ib |
---|
7683 | IF ( salsa_gases_from_chem ) THEN |
---|
7684 | ig = gas_index_chem(5) |
---|
7685 | chem_species(ig)%conc(:,j,i) = chem_species(ig)%conc(:,j,i) + & |
---|
7686 | aerosol_mass(ic)%conc(:,j,i) * avo * flag_zddry / & |
---|
7687 | ( amoc * ppm_to_nconc ) * flag |
---|
7688 | ELSE |
---|
7689 | salsa_gas(5)%conc(:,j,i) = salsa_gas(5)%conc(:,j,i) + aerosol_mass(ic)%conc(:,j,i) / & |
---|
7690 | amoc * avo * flag_zddry * flag |
---|
7691 | ENDIF |
---|
7692 | ENDIF |
---|
7693 | IF ( index_no > 0 .AND. lscndgas ) THEN |
---|
7694 | ic = ( index_no - 1 ) * nbins_aerosol + ib |
---|
7695 | IF ( salsa_gases_from_chem ) THEN |
---|
7696 | ig = gas_index_chem(2) |
---|
7697 | chem_species(ig)%conc(:,j,i) = chem_species(ig)%conc(:,j,i) + & |
---|
7698 | aerosol_mass(ic)%conc(:,j,i) * avo * flag_zddry / & |
---|
7699 | ( amhno3 * ppm_to_nconc ) *flag |
---|
7700 | ELSE |
---|
7701 | salsa_gas(2)%conc(:,j,i) = salsa_gas(2)%conc(:,j,i) + aerosol_mass(ic)%conc(:,j,i) / & |
---|
7702 | amhno3 * avo * flag_zddry * flag |
---|
7703 | ENDIF |
---|
7704 | ENDIF |
---|
7705 | IF ( index_nh > 0 .AND. lscndgas ) THEN |
---|
7706 | ic = ( index_nh - 1 ) * nbins_aerosol + ib |
---|
7707 | IF ( salsa_gases_from_chem ) THEN |
---|
7708 | ig = gas_index_chem(3) |
---|
7709 | chem_species(ig)%conc(:,j,i) = chem_species(ig)%conc(:,j,i) + & |
---|
7710 | aerosol_mass(ic)%conc(:,j,i) * avo * flag_zddry / & |
---|
7711 | ( amnh3 * ppm_to_nconc ) *flag |
---|
7712 | ELSE |
---|
7713 | salsa_gas(3)%conc(:,j,i) = salsa_gas(3)%conc(:,j,i) + aerosol_mass(ic)%conc(:,j,i) / & |
---|
7714 | amnh3 * avo * flag_zddry *flag |
---|
7715 | ENDIF |
---|
7716 | ENDIF |
---|
7717 | ! |
---|
7718 | !-- Mass and number to zero (insoluble species and water are lost) |
---|
7719 | DO ic = 1, ncomponents_mass |
---|
7720 | icc = ( ic - 1 ) * nbins_aerosol + ib |
---|
7721 | aerosol_mass(icc)%conc(:,j,i) = MERGE( mclim * flag, aerosol_mass(icc)%conc(:,j,i), & |
---|
7722 | flag_zddry > 0.0_wp ) |
---|
7723 | ENDDO |
---|
7724 | aerosol_number(ib)%conc(:,j,i) = MERGE( nclim * flag, aerosol_number(ib)%conc(:,j,i), & |
---|
7725 | flag_zddry > 0.0_wp ) |
---|
7726 | ra_dry(:,j,i,ib) = MAX( 1.0E-10_wp, 0.5_wp * zddry ) |
---|
7727 | |
---|
7728 | ENDDO |
---|
7729 | IF ( .NOT. salsa_gases_from_chem ) THEN |
---|
7730 | DO ig = 1, ngases_salsa |
---|
7731 | salsa_gas(ig)%conc(:,j,i) = MAX( nclim, salsa_gas(ig)%conc(:,j,i) ) * flag |
---|
7732 | ENDDO |
---|
7733 | ENDIF |
---|
7734 | |
---|
7735 | !$OMP MASTER |
---|
7736 | CALL cpu_log( log_point_s(94), 'salsa diagnostics ', 'stop' ) |
---|
7737 | !$OMP END MASTER |
---|
7738 | |
---|
7739 | END SUBROUTINE salsa_diagnostics |
---|
7740 | |
---|
7741 | |
---|
7742 | !------------------------------------------------------------------------------! |
---|
7743 | ! Description: |
---|
7744 | ! ------------ |
---|
7745 | !> Call for all grid points |
---|
7746 | !------------------------------------------------------------------------------! |
---|
7747 | SUBROUTINE salsa_actions( location ) |
---|
7748 | |
---|
7749 | |
---|
7750 | CHARACTER (LEN=*), INTENT(IN) :: location !< call location string |
---|
7751 | |
---|
7752 | SELECT CASE ( location ) |
---|
7753 | |
---|
7754 | CASE ( 'before_timestep' ) |
---|
7755 | |
---|
7756 | IF ( ws_scheme_sca ) sums_salsa_ws_l = 0.0_wp |
---|
7757 | |
---|
7758 | CASE DEFAULT |
---|
7759 | CONTINUE |
---|
7760 | |
---|
7761 | END SELECT |
---|
7762 | |
---|
7763 | END SUBROUTINE salsa_actions |
---|
7764 | |
---|
7765 | |
---|
7766 | !------------------------------------------------------------------------------! |
---|
7767 | ! Description: |
---|
7768 | ! ------------ |
---|
7769 | !> Call for grid points i,j |
---|
7770 | !------------------------------------------------------------------------------! |
---|
7771 | |
---|
7772 | SUBROUTINE salsa_actions_ij( i, j, location ) |
---|
7773 | |
---|
7774 | |
---|
7775 | INTEGER(iwp), INTENT(IN) :: i !< grid index in x-direction |
---|
7776 | INTEGER(iwp), INTENT(IN) :: j !< grid index in y-direction |
---|
7777 | CHARACTER (LEN=*), INTENT(IN) :: location !< call location string |
---|
7778 | INTEGER(iwp) :: dummy !< call location string |
---|
7779 | |
---|
7780 | IF ( salsa ) dummy = i + j |
---|
7781 | |
---|
7782 | SELECT CASE ( location ) |
---|
7783 | |
---|
7784 | CASE ( 'before_timestep' ) |
---|
7785 | |
---|
7786 | IF ( ws_scheme_sca ) sums_salsa_ws_l = 0.0_wp |
---|
7787 | |
---|
7788 | CASE DEFAULT |
---|
7789 | CONTINUE |
---|
7790 | |
---|
7791 | END SELECT |
---|
7792 | |
---|
7793 | |
---|
7794 | END SUBROUTINE salsa_actions_ij |
---|
7795 | |
---|
7796 | !------------------------------------------------------------------------------! |
---|
7797 | ! Description: |
---|
7798 | ! ------------ |
---|
7799 | !> Call for all grid points |
---|
7800 | !------------------------------------------------------------------------------! |
---|
7801 | SUBROUTINE salsa_non_advective_processes |
---|
7802 | |
---|
7803 | USE cpulog, & |
---|
7804 | ONLY: cpu_log, log_point_s |
---|
7805 | |
---|
7806 | IMPLICIT NONE |
---|
7807 | |
---|
7808 | INTEGER(iwp) :: i !< |
---|
7809 | INTEGER(iwp) :: j !< |
---|
7810 | |
---|
7811 | IF ( time_since_reference_point >= skip_time_do_salsa ) THEN |
---|
7812 | IF ( ( time_since_reference_point - last_salsa_time ) >= dt_salsa ) THEN |
---|
7813 | ! |
---|
7814 | !-- Calculate aerosol dynamic processes. salsa_driver can be run with a longer time step. |
---|
7815 | CALL cpu_log( log_point_s(90), 'salsa processes ', 'start' ) |
---|
7816 | DO i = nxl, nxr |
---|
7817 | DO j = nys, nyn |
---|
7818 | CALL salsa_diagnostics( i, j ) |
---|
7819 | CALL salsa_driver( i, j, 3 ) |
---|
7820 | CALL salsa_diagnostics( i, j ) |
---|
7821 | ENDDO |
---|
7822 | ENDDO |
---|
7823 | CALL cpu_log( log_point_s(90), 'salsa processes ', 'stop' ) |
---|
7824 | ENDIF |
---|
7825 | ENDIF |
---|
7826 | |
---|
7827 | END SUBROUTINE salsa_non_advective_processes |
---|
7828 | |
---|
7829 | |
---|
7830 | !------------------------------------------------------------------------------! |
---|
7831 | ! Description: |
---|
7832 | ! ------------ |
---|
7833 | !> Call for grid points i,j |
---|
7834 | !------------------------------------------------------------------------------! |
---|
7835 | SUBROUTINE salsa_non_advective_processes_ij( i, j ) |
---|
7836 | |
---|
7837 | USE cpulog, & |
---|
7838 | ONLY: cpu_log, log_point_s |
---|
7839 | |
---|
7840 | IMPLICIT NONE |
---|
7841 | |
---|
7842 | INTEGER(iwp), INTENT(IN) :: i !< grid index in x-direction |
---|
7843 | INTEGER(iwp), INTENT(IN) :: j !< grid index in y-direction |
---|
7844 | |
---|
7845 | IF ( time_since_reference_point >= skip_time_do_salsa ) THEN |
---|
7846 | IF ( ( time_since_reference_point - last_salsa_time ) >= dt_salsa ) THEN |
---|
7847 | ! |
---|
7848 | !-- Calculate aerosol dynamic processes. salsa_driver can be run with a longer time step. |
---|
7849 | CALL cpu_log( log_point_s(90), 'salsa processes ', 'start' ) |
---|
7850 | CALL salsa_diagnostics( i, j ) |
---|
7851 | CALL salsa_driver( i, j, 3 ) |
---|
7852 | CALL salsa_diagnostics( i, j ) |
---|
7853 | CALL cpu_log( log_point_s(90), 'salsa processes ', 'stop' ) |
---|
7854 | ENDIF |
---|
7855 | ENDIF |
---|
7856 | |
---|
7857 | END SUBROUTINE salsa_non_advective_processes_ij |
---|
7858 | |
---|
7859 | !------------------------------------------------------------------------------! |
---|
7860 | ! Description: |
---|
7861 | ! ------------ |
---|
7862 | !> Routine for exchange horiz of salsa variables. |
---|
7863 | !------------------------------------------------------------------------------! |
---|
7864 | SUBROUTINE salsa_exchange_horiz_bounds |
---|
7865 | |
---|
7866 | USE cpulog, & |
---|
7867 | ONLY: cpu_log, log_point_s |
---|
7868 | |
---|
7869 | IMPLICIT NONE |
---|
7870 | |
---|
7871 | INTEGER(iwp) :: ib !< |
---|
7872 | INTEGER(iwp) :: ic !< |
---|
7873 | INTEGER(iwp) :: icc !< |
---|
7874 | INTEGER(iwp) :: ig !< |
---|
7875 | |
---|
7876 | IF ( time_since_reference_point >= skip_time_do_salsa ) THEN |
---|
7877 | IF ( ( time_since_reference_point - last_salsa_time ) >= dt_salsa ) THEN |
---|
7878 | |
---|
7879 | CALL cpu_log( log_point_s(91), 'salsa exch-horiz ', 'start' ) |
---|
7880 | ! |
---|
7881 | !-- Exchange ghost points and decycle if needed. |
---|
7882 | DO ib = 1, nbins_aerosol |
---|
7883 | CALL exchange_horiz( aerosol_number(ib)%conc, nbgp ) |
---|
7884 | CALL salsa_boundary_conds( aerosol_number(ib)%conc, aerosol_number(ib)%init ) |
---|
7885 | DO ic = 1, ncomponents_mass |
---|
7886 | icc = ( ic - 1 ) * nbins_aerosol + ib |
---|
7887 | CALL exchange_horiz( aerosol_mass(icc)%conc, nbgp ) |
---|
7888 | CALL salsa_boundary_conds( aerosol_mass(icc)%conc, aerosol_mass(icc)%init ) |
---|
7889 | ENDDO |
---|
7890 | ENDDO |
---|
7891 | IF ( .NOT. salsa_gases_from_chem ) THEN |
---|
7892 | DO ig = 1, ngases_salsa |
---|
7893 | CALL exchange_horiz( salsa_gas(ig)%conc, nbgp ) |
---|
7894 | CALL salsa_boundary_conds( salsa_gas(ig)%conc, salsa_gas(ig)%init ) |
---|
7895 | ENDDO |
---|
7896 | ENDIF |
---|
7897 | CALL cpu_log( log_point_s(91), 'salsa exch-horiz ', 'stop' ) |
---|
7898 | ! |
---|
7899 | !-- Update last_salsa_time |
---|
7900 | last_salsa_time = time_since_reference_point |
---|
7901 | ENDIF |
---|
7902 | ENDIF |
---|
7903 | |
---|
7904 | END SUBROUTINE salsa_exchange_horiz_bounds |
---|
7905 | |
---|
7906 | !------------------------------------------------------------------------------! |
---|
7907 | ! Description: |
---|
7908 | ! ------------ |
---|
7909 | !> Calculate the prognostic equation for aerosol number and mass, and gas |
---|
7910 | !> concentrations. Cache-optimized. |
---|
7911 | !------------------------------------------------------------------------------! |
---|
7912 | SUBROUTINE salsa_prognostic_equations_ij( i, j, i_omp_start, tn ) |
---|
7913 | |
---|
7914 | IMPLICIT NONE |
---|
7915 | |
---|
7916 | INTEGER(iwp) :: i !< |
---|
7917 | INTEGER(iwp) :: i_omp_start !< |
---|
7918 | INTEGER(iwp) :: ib !< loop index for aerosol number bin OR gas index |
---|
7919 | INTEGER(iwp) :: ic !< loop index for aerosol mass bin |
---|
7920 | INTEGER(iwp) :: icc !< (c-1)*nbins_aerosol+b |
---|
7921 | INTEGER(iwp) :: ig !< loop index for salsa gases |
---|
7922 | INTEGER(iwp) :: j !< |
---|
7923 | INTEGER(iwp) :: tn !< |
---|
7924 | |
---|
7925 | IF ( time_since_reference_point >= skip_time_do_salsa ) THEN |
---|
7926 | ! |
---|
7927 | !-- Aerosol number |
---|
7928 | DO ib = 1, nbins_aerosol |
---|
7929 | !kk sums_salsa_ws_l = aerosol_number(ib)%sums_ws_l |
---|
7930 | CALL salsa_tendency( 'aerosol_number', aerosol_number(ib)%conc_p, aerosol_number(ib)%conc,& |
---|
7931 | aerosol_number(ib)%tconc_m, i, j, i_omp_start, tn, ib, ib, & |
---|
7932 | aerosol_number(ib)%flux_s, aerosol_number(ib)%diss_s, & |
---|
7933 | aerosol_number(ib)%flux_l, aerosol_number(ib)%diss_l, & |
---|
7934 | aerosol_number(ib)%init, .TRUE. ) |
---|
7935 | !kk aerosol_number(ib)%sums_ws_l = sums_salsa_ws_l |
---|
7936 | ! |
---|
7937 | !-- Aerosol mass |
---|
7938 | DO ic = 1, ncomponents_mass |
---|
7939 | icc = ( ic - 1 ) * nbins_aerosol + ib |
---|
7940 | !kk sums_salsa_ws_l = aerosol_mass(icc)%sums_ws_l |
---|
7941 | CALL salsa_tendency( 'aerosol_mass', aerosol_mass(icc)%conc_p, aerosol_mass(icc)%conc,& |
---|
7942 | aerosol_mass(icc)%tconc_m, i, j, i_omp_start, tn, ib, ic, & |
---|
7943 | aerosol_mass(icc)%flux_s, aerosol_mass(icc)%diss_s, & |
---|
7944 | aerosol_mass(icc)%flux_l, aerosol_mass(icc)%diss_l, & |
---|
7945 | aerosol_mass(icc)%init, .TRUE. ) |
---|
7946 | !kk aerosol_mass(icc)%sums_ws_l = sums_salsa_ws_l |
---|
7947 | |
---|
7948 | ENDDO ! ic |
---|
7949 | ENDDO ! ib |
---|
7950 | ! |
---|
7951 | !-- Gases |
---|
7952 | IF ( .NOT. salsa_gases_from_chem ) THEN |
---|
7953 | |
---|
7954 | DO ig = 1, ngases_salsa |
---|
7955 | !kk sums_salsa_ws_l = salsa_gas(ig)%sums_ws_l |
---|
7956 | CALL salsa_tendency( 'salsa_gas', salsa_gas(ig)%conc_p, salsa_gas(ig)%conc, & |
---|
7957 | salsa_gas(ig)%tconc_m, i, j, i_omp_start, tn, ig, ig, & |
---|
7958 | salsa_gas(ig)%flux_s, salsa_gas(ig)%diss_s, salsa_gas(ig)%flux_l,& |
---|
7959 | salsa_gas(ig)%diss_l, salsa_gas(ig)%init, .FALSE. ) |
---|
7960 | !kk salsa_gas(ig)%sums_ws_l = sums_salsa_ws_l |
---|
7961 | |
---|
7962 | ENDDO ! ig |
---|
7963 | |
---|
7964 | ENDIF |
---|
7965 | |
---|
7966 | ENDIF |
---|
7967 | |
---|
7968 | END SUBROUTINE salsa_prognostic_equations_ij |
---|
7969 | ! |
---|
7970 | !------------------------------------------------------------------------------! |
---|
7971 | ! Description: |
---|
7972 | ! ------------ |
---|
7973 | !> Calculate the prognostic equation for aerosol number and mass, and gas |
---|
7974 | !> concentrations. For vector machines. |
---|
7975 | !------------------------------------------------------------------------------! |
---|
7976 | SUBROUTINE salsa_prognostic_equations() |
---|
7977 | |
---|
7978 | IMPLICIT NONE |
---|
7979 | |
---|
7980 | INTEGER(iwp) :: ib !< loop index for aerosol number bin OR gas index |
---|
7981 | INTEGER(iwp) :: ic !< loop index for aerosol mass bin |
---|
7982 | INTEGER(iwp) :: icc !< (c-1)*nbins_aerosol+b |
---|
7983 | INTEGER(iwp) :: ig !< loop index for salsa gases |
---|
7984 | |
---|
7985 | IF ( time_since_reference_point >= skip_time_do_salsa ) THEN |
---|
7986 | ! |
---|
7987 | !-- Aerosol number |
---|
7988 | DO ib = 1, nbins_aerosol |
---|
7989 | sums_salsa_ws_l = aerosol_number(ib)%sums_ws_l |
---|
7990 | CALL salsa_tendency( 'aerosol_number', aerosol_number(ib)%conc_p, aerosol_number(ib)%conc,& |
---|
7991 | aerosol_number(ib)%tconc_m, ib, ib, aerosol_number(ib)%init, .TRUE. ) |
---|
7992 | aerosol_number(ib)%sums_ws_l = sums_salsa_ws_l |
---|
7993 | ! |
---|
7994 | !-- Aerosol mass |
---|
7995 | DO ic = 1, ncomponents_mass |
---|
7996 | icc = ( ic - 1 ) * nbins_aerosol + ib |
---|
7997 | sums_salsa_ws_l = aerosol_mass(icc)%sums_ws_l |
---|
7998 | CALL salsa_tendency( 'aerosol_mass', aerosol_mass(icc)%conc_p, aerosol_mass(icc)%conc,& |
---|
7999 | aerosol_mass(icc)%tconc_m, ib, ic, aerosol_mass(icc)%init, .TRUE. ) |
---|
8000 | aerosol_mass(icc)%sums_ws_l = sums_salsa_ws_l |
---|
8001 | |
---|
8002 | ENDDO ! ic |
---|
8003 | ENDDO ! ib |
---|
8004 | ! |
---|
8005 | !-- Gases |
---|
8006 | IF ( .NOT. salsa_gases_from_chem ) THEN |
---|
8007 | |
---|
8008 | DO ig = 1, ngases_salsa |
---|
8009 | sums_salsa_ws_l = salsa_gas(ig)%sums_ws_l |
---|
8010 | CALL salsa_tendency( 'salsa_gas', salsa_gas(ig)%conc_p, salsa_gas(ig)%conc, & |
---|
8011 | salsa_gas(ig)%tconc_m, ig, ig, salsa_gas(ig)%init, .FALSE. ) |
---|
8012 | salsa_gas(ig)%sums_ws_l = sums_salsa_ws_l |
---|
8013 | |
---|
8014 | ENDDO ! ig |
---|
8015 | |
---|
8016 | ENDIF |
---|
8017 | |
---|
8018 | ENDIF |
---|
8019 | |
---|
8020 | END SUBROUTINE salsa_prognostic_equations |
---|
8021 | ! |
---|
8022 | !------------------------------------------------------------------------------! |
---|
8023 | ! Description: |
---|
8024 | ! ------------ |
---|
8025 | !> Tendencies for aerosol number and mass and gas concentrations. |
---|
8026 | !> Cache-optimized. |
---|
8027 | !------------------------------------------------------------------------------! |
---|
8028 | SUBROUTINE salsa_tendency_ij( id, rs_p, rs, trs_m, i, j, i_omp_start, tn, ib, ic, flux_s, diss_s, & |
---|
8029 | flux_l, diss_l, rs_init, do_sedimentation ) |
---|
8030 | |
---|
8031 | USE advec_ws, & |
---|
8032 | ONLY: advec_s_ws |
---|
8033 | |
---|
8034 | USE advec_s_pw_mod, & |
---|
8035 | ONLY: advec_s_pw |
---|
8036 | |
---|
8037 | USE advec_s_up_mod, & |
---|
8038 | ONLY: advec_s_up |
---|
8039 | |
---|
8040 | USE arrays_3d, & |
---|
8041 | ONLY: ddzu, rdf_sc, tend |
---|
8042 | |
---|
8043 | USE diffusion_s_mod, & |
---|
8044 | ONLY: diffusion_s |
---|
8045 | |
---|
8046 | USE indices, & |
---|
8047 | ONLY: wall_flags_total_0 |
---|
8048 | |
---|
8049 | USE surface_mod, & |
---|
8050 | ONLY : surf_def_h, surf_def_v, surf_lsm_h, surf_lsm_v, surf_usm_h, surf_usm_v |
---|
8051 | |
---|
8052 | IMPLICIT NONE |
---|
8053 | |
---|
8054 | CHARACTER(LEN = *) :: id !< |
---|
8055 | |
---|
8056 | INTEGER(iwp) :: i !< |
---|
8057 | INTEGER(iwp) :: i_omp_start !< |
---|
8058 | INTEGER(iwp) :: ib !< loop index for aerosol number bin OR gas index |
---|
8059 | INTEGER(iwp) :: ic !< loop index for aerosol mass bin |
---|
8060 | INTEGER(iwp) :: icc !< (c-1)*nbins_aerosol+b |
---|
8061 | INTEGER(iwp) :: j !< |
---|
8062 | INTEGER(iwp) :: k !< |
---|
8063 | INTEGER(iwp) :: tn !< |
---|
8064 | |
---|
8065 | LOGICAL :: do_sedimentation !< |
---|
8066 | |
---|
8067 | REAL(wp), DIMENSION(nzb:nzt+1) :: rs_init !< |
---|
8068 | |
---|
8069 | REAL(wp), DIMENSION(nzb+1:nzt,0:threads_per_task-1) :: diss_s !< |
---|
8070 | REAL(wp), DIMENSION(nzb+1:nzt,0:threads_per_task-1) :: flux_s !< |
---|
8071 | |
---|
8072 | REAL(wp), DIMENSION(nzb+1:nzt,nys:nyn,0:threads_per_task-1) :: diss_l !< |
---|
8073 | REAL(wp), DIMENSION(nzb+1:nzt,nys:nyn,0:threads_per_task-1) :: flux_l !< |
---|
8074 | |
---|
8075 | REAL(wp), DIMENSION(nzb:nzt+1,nysg:nyng,nxlg:nxrg) :: rs_p !< |
---|
8076 | REAL(wp), DIMENSION(nzb:nzt+1,nysg:nyng,nxlg:nxrg) :: rs !< |
---|
8077 | REAL(wp), DIMENSION(nzb:nzt+1,nysg:nyng,nxlg:nxrg) :: trs_m !< |
---|
8078 | |
---|
8079 | icc = ( ic - 1 ) * nbins_aerosol + ib |
---|
8080 | ! |
---|
8081 | !-- Tendency-terms for reactive scalar |
---|
8082 | tend(:,j,i) = 0.0_wp |
---|
8083 | ! |
---|
8084 | !-- Advection terms |
---|
8085 | IF ( timestep_scheme(1:5) == 'runge' ) THEN |
---|
8086 | IF ( ws_scheme_sca ) THEN |
---|
8087 | CALL advec_s_ws( salsa_advc_flags_s, i, j, rs, id, flux_s, diss_s, flux_l, diss_l, & |
---|
8088 | i_omp_start, tn, bc_dirichlet_l .OR. bc_radiation_l, & |
---|
8089 | bc_dirichlet_n .OR. bc_radiation_n, & |
---|
8090 | bc_dirichlet_r .OR. bc_radiation_r, & |
---|
8091 | bc_dirichlet_s .OR. bc_radiation_s, monotonic_limiter_z ) |
---|
8092 | ELSE |
---|
8093 | CALL advec_s_pw( i, j, rs ) |
---|
8094 | ENDIF |
---|
8095 | ELSE |
---|
8096 | CALL advec_s_up( i, j, rs ) |
---|
8097 | ENDIF |
---|
8098 | ! |
---|
8099 | !-- Diffusion terms |
---|
8100 | SELECT CASE ( id ) |
---|
8101 | CASE ( 'aerosol_number' ) |
---|
8102 | CALL diffusion_s( i, j, rs, surf_def_h(0)%answs(:,ib), & |
---|
8103 | surf_def_h(1)%answs(:,ib), surf_def_h(2)%answs(:,ib), & |
---|
8104 | surf_lsm_h%answs(:,ib), surf_usm_h%answs(:,ib), & |
---|
8105 | surf_def_v(0)%answs(:,ib), surf_def_v(1)%answs(:,ib), & |
---|
8106 | surf_def_v(2)%answs(:,ib), surf_def_v(3)%answs(:,ib), & |
---|
8107 | surf_lsm_v(0)%answs(:,ib), surf_lsm_v(1)%answs(:,ib), & |
---|
8108 | surf_lsm_v(2)%answs(:,ib), surf_lsm_v(3)%answs(:,ib), & |
---|
8109 | surf_usm_v(0)%answs(:,ib), surf_usm_v(1)%answs(:,ib), & |
---|
8110 | surf_usm_v(2)%answs(:,ib), surf_usm_v(3)%answs(:,ib) ) |
---|
8111 | CASE ( 'aerosol_mass' ) |
---|
8112 | CALL diffusion_s( i, j, rs, surf_def_h(0)%amsws(:,icc), & |
---|
8113 | surf_def_h(1)%amsws(:,icc), surf_def_h(2)%amsws(:,icc), & |
---|
8114 | surf_lsm_h%amsws(:,icc), surf_usm_h%amsws(:,icc), & |
---|
8115 | surf_def_v(0)%amsws(:,icc), surf_def_v(1)%amsws(:,icc), & |
---|
8116 | surf_def_v(2)%amsws(:,icc), surf_def_v(3)%amsws(:,icc), & |
---|
8117 | surf_lsm_v(0)%amsws(:,icc), surf_lsm_v(1)%amsws(:,icc), & |
---|
8118 | surf_lsm_v(2)%amsws(:,icc), surf_lsm_v(3)%amsws(:,icc), & |
---|
8119 | surf_usm_v(0)%amsws(:,icc), surf_usm_v(1)%amsws(:,icc), & |
---|
8120 | surf_usm_v(2)%amsws(:,icc), surf_usm_v(3)%amsws(:,icc) ) |
---|
8121 | CASE ( 'salsa_gas' ) |
---|
8122 | CALL diffusion_s( i, j, rs, surf_def_h(0)%gtsws(:,ib), & |
---|
8123 | surf_def_h(1)%gtsws(:,ib), surf_def_h(2)%gtsws(:,ib), & |
---|
8124 | surf_lsm_h%gtsws(:,ib), surf_usm_h%gtsws(:,ib), & |
---|
8125 | surf_def_v(0)%gtsws(:,ib), surf_def_v(1)%gtsws(:,ib), & |
---|
8126 | surf_def_v(2)%gtsws(:,ib), surf_def_v(3)%gtsws(:,ib), & |
---|
8127 | surf_lsm_v(0)%gtsws(:,ib), surf_lsm_v(1)%gtsws(:,ib), & |
---|
8128 | surf_lsm_v(2)%gtsws(:,ib), surf_lsm_v(3)%gtsws(:,ib), & |
---|
8129 | surf_usm_v(0)%gtsws(:,ib), surf_usm_v(1)%gtsws(:,ib), & |
---|
8130 | surf_usm_v(2)%gtsws(:,ib), surf_usm_v(3)%gtsws(:,ib) ) |
---|
8131 | END SELECT |
---|
8132 | ! |
---|
8133 | !-- Sedimentation and prognostic equation for aerosol number and mass |
---|
8134 | IF ( lsdepo .AND. do_sedimentation ) THEN |
---|
8135 | !DIR$ IVDEP |
---|
8136 | DO k = nzb+1, nzt |
---|
8137 | tend(k,j,i) = tend(k,j,i) - MAX( 0.0_wp, ( rs(k+1,j,i) * sedim_vd(k+1,j,i,ib) - & |
---|
8138 | rs(k,j,i) * sedim_vd(k,j,i,ib) ) * ddzu(k) ) & |
---|
8139 | * MERGE( 1.0_wp, 0.0_wp, BTEST( wall_flags_total_0(k-1,j,i), 0 ) ) |
---|
8140 | rs_p(k,j,i) = rs(k,j,i) + ( dt_3d * ( tsc(2) * tend(k,j,i) + tsc(3) * trs_m(k,j,i) ) & |
---|
8141 | - tsc(5) * rdf_sc(k) * ( rs(k,j,i) - rs_init(k) ) ) & |
---|
8142 | * MERGE( 1.0_wp, 0.0_wp, BTEST( wall_flags_total_0(k,j,i), 0 ) ) |
---|
8143 | IF ( rs_p(k,j,i) < 0.0_wp ) rs_p(k,j,i) = 0.1_wp * rs(k,j,i) |
---|
8144 | ENDDO |
---|
8145 | ELSE |
---|
8146 | ! |
---|
8147 | !-- Prognostic equation |
---|
8148 | !DIR$ IVDEP |
---|
8149 | DO k = nzb+1, nzt |
---|
8150 | rs_p(k,j,i) = rs(k,j,i) + ( dt_3d * ( tsc(2) * tend(k,j,i) + tsc(3) * trs_m(k,j,i) ) & |
---|
8151 | - tsc(5) * rdf_sc(k) * ( rs(k,j,i) - rs_init(k) ) )& |
---|
8152 | * MERGE( 1.0_wp, 0.0_wp, BTEST( wall_flags_total_0(k,j,i), 0 ) ) |
---|
8153 | IF ( rs_p(k,j,i) < 0.0_wp ) rs_p(k,j,i) = 0.1_wp * rs(k,j,i) |
---|
8154 | ENDDO |
---|
8155 | ENDIF |
---|
8156 | ! |
---|
8157 | !-- Calculate tendencies for the next Runge-Kutta step |
---|
8158 | IF ( timestep_scheme(1:5) == 'runge' ) THEN |
---|
8159 | IF ( intermediate_timestep_count == 1 ) THEN |
---|
8160 | DO k = nzb+1, nzt |
---|
8161 | trs_m(k,j,i) = tend(k,j,i) |
---|
8162 | ENDDO |
---|
8163 | ELSEIF ( intermediate_timestep_count < intermediate_timestep_count_max ) THEN |
---|
8164 | DO k = nzb+1, nzt |
---|
8165 | trs_m(k,j,i) = -9.5625_wp * tend(k,j,i) + 5.3125_wp * trs_m(k,j,i) |
---|
8166 | ENDDO |
---|
8167 | ENDIF |
---|
8168 | ENDIF |
---|
8169 | |
---|
8170 | END SUBROUTINE salsa_tendency_ij |
---|
8171 | ! |
---|
8172 | !------------------------------------------------------------------------------! |
---|
8173 | ! Description: |
---|
8174 | ! ------------ |
---|
8175 | !> Calculate the tendencies for aerosol number and mass concentrations. |
---|
8176 | !> For vector machines. |
---|
8177 | !------------------------------------------------------------------------------! |
---|
8178 | SUBROUTINE salsa_tendency( id, rs_p, rs, trs_m, ib, ic, rs_init, do_sedimentation ) |
---|
8179 | |
---|
8180 | USE advec_ws, & |
---|
8181 | ONLY: advec_s_ws |
---|
8182 | USE advec_s_pw_mod, & |
---|
8183 | ONLY: advec_s_pw |
---|
8184 | USE advec_s_up_mod, & |
---|
8185 | ONLY: advec_s_up |
---|
8186 | USE arrays_3d, & |
---|
8187 | ONLY: ddzu, rdf_sc, tend |
---|
8188 | USE diffusion_s_mod, & |
---|
8189 | ONLY: diffusion_s |
---|
8190 | USE indices, & |
---|
8191 | ONLY: wall_flags_total_0 |
---|
8192 | USE surface_mod, & |
---|
8193 | ONLY : surf_def_h, surf_def_v, surf_lsm_h, surf_lsm_v, surf_usm_h, surf_usm_v |
---|
8194 | |
---|
8195 | IMPLICIT NONE |
---|
8196 | |
---|
8197 | CHARACTER(LEN = *) :: id |
---|
8198 | |
---|
8199 | INTEGER(iwp) :: ib !< loop index for aerosol number bin OR gas index |
---|
8200 | INTEGER(iwp) :: ic !< loop index for aerosol mass bin |
---|
8201 | INTEGER(iwp) :: icc !< (c-1)*nbins_aerosol+b |
---|
8202 | INTEGER(iwp) :: i !< |
---|
8203 | INTEGER(iwp) :: j !< |
---|
8204 | INTEGER(iwp) :: k !< |
---|
8205 | |
---|
8206 | LOGICAL :: do_sedimentation !< |
---|
8207 | |
---|
8208 | REAL(wp), DIMENSION(nzb:nzt+1) :: rs_init !< |
---|
8209 | |
---|
8210 | REAL(wp), DIMENSION(:,:,:), POINTER :: rs_p !< |
---|
8211 | REAL(wp), DIMENSION(:,:,:), POINTER :: rs !< |
---|
8212 | REAL(wp), DIMENSION(:,:,:), POINTER :: trs_m !< |
---|
8213 | |
---|
8214 | icc = ( ic - 1 ) * nbins_aerosol + ib |
---|
8215 | ! |
---|
8216 | !-- Tendency-terms for reactive scalar |
---|
8217 | tend = 0.0_wp |
---|
8218 | ! |
---|
8219 | !-- Advection terms |
---|
8220 | IF ( timestep_scheme(1:5) == 'runge' ) THEN |
---|
8221 | IF ( ws_scheme_sca ) THEN |
---|
8222 | CALL advec_s_ws( salsa_advc_flags_s, rs, id, bc_dirichlet_l .OR. bc_radiation_l, & |
---|
8223 | bc_dirichlet_n .OR. bc_radiation_n, & |
---|
8224 | bc_dirichlet_r .OR. bc_radiation_r, & |
---|
8225 | bc_dirichlet_s .OR. bc_radiation_s ) |
---|
8226 | ELSE |
---|
8227 | CALL advec_s_pw( rs ) |
---|
8228 | ENDIF |
---|
8229 | ELSE |
---|
8230 | CALL advec_s_up( rs ) |
---|
8231 | ENDIF |
---|
8232 | ! |
---|
8233 | !-- Diffusion terms |
---|
8234 | SELECT CASE ( id ) |
---|
8235 | CASE ( 'aerosol_number' ) |
---|
8236 | CALL diffusion_s( rs, surf_def_h(0)%answs(:,ib), & |
---|
8237 | surf_def_h(1)%answs(:,ib), surf_def_h(2)%answs(:,ib), & |
---|
8238 | surf_lsm_h%answs(:,ib), surf_usm_h%answs(:,ib), & |
---|
8239 | surf_def_v(0)%answs(:,ib), surf_def_v(1)%answs(:,ib), & |
---|
8240 | surf_def_v(2)%answs(:,ib), surf_def_v(3)%answs(:,ib), & |
---|
8241 | surf_lsm_v(0)%answs(:,ib), surf_lsm_v(1)%answs(:,ib), & |
---|
8242 | surf_lsm_v(2)%answs(:,ib), surf_lsm_v(3)%answs(:,ib), & |
---|
8243 | surf_usm_v(0)%answs(:,ib), surf_usm_v(1)%answs(:,ib), & |
---|
8244 | surf_usm_v(2)%answs(:,ib), surf_usm_v(3)%answs(:,ib) ) |
---|
8245 | CASE ( 'aerosol_mass' ) |
---|
8246 | CALL diffusion_s( rs, surf_def_h(0)%amsws(:,icc), & |
---|
8247 | surf_def_h(1)%amsws(:,icc), surf_def_h(2)%amsws(:,icc), & |
---|
8248 | surf_lsm_h%amsws(:,icc), surf_usm_h%amsws(:,icc), & |
---|
8249 | surf_def_v(0)%amsws(:,icc), surf_def_v(1)%amsws(:,icc), & |
---|
8250 | surf_def_v(2)%amsws(:,icc), surf_def_v(3)%amsws(:,icc), & |
---|
8251 | surf_lsm_v(0)%amsws(:,icc), surf_lsm_v(1)%amsws(:,icc), & |
---|
8252 | surf_lsm_v(2)%amsws(:,icc), surf_lsm_v(3)%amsws(:,icc), & |
---|
8253 | surf_usm_v(0)%amsws(:,icc), surf_usm_v(1)%amsws(:,icc), & |
---|
8254 | surf_usm_v(2)%amsws(:,icc), surf_usm_v(3)%amsws(:,icc) ) |
---|
8255 | CASE ( 'salsa_gas' ) |
---|
8256 | CALL diffusion_s( rs, surf_def_h(0)%gtsws(:,ib), & |
---|
8257 | surf_def_h(1)%gtsws(:,ib), surf_def_h(2)%gtsws(:,ib), & |
---|
8258 | surf_lsm_h%gtsws(:,ib), surf_usm_h%gtsws(:,ib), & |
---|
8259 | surf_def_v(0)%gtsws(:,ib), surf_def_v(1)%gtsws(:,ib), & |
---|
8260 | surf_def_v(2)%gtsws(:,ib), surf_def_v(3)%gtsws(:,ib), & |
---|
8261 | surf_lsm_v(0)%gtsws(:,ib), surf_lsm_v(1)%gtsws(:,ib), & |
---|
8262 | surf_lsm_v(2)%gtsws(:,ib), surf_lsm_v(3)%gtsws(:,ib), & |
---|
8263 | surf_usm_v(0)%gtsws(:,ib), surf_usm_v(1)%gtsws(:,ib), & |
---|
8264 | surf_usm_v(2)%gtsws(:,ib), surf_usm_v(3)%gtsws(:,ib) ) |
---|
8265 | END SELECT |
---|
8266 | ! |
---|
8267 | !-- Prognostic equation for a scalar |
---|
8268 | DO i = nxl, nxr |
---|
8269 | DO j = nys, nyn |
---|
8270 | ! |
---|
8271 | !-- Sedimentation for aerosol number and mass |
---|
8272 | IF ( lsdepo .AND. do_sedimentation ) THEN |
---|
8273 | tend(nzb+1:nzt,j,i) = tend(nzb+1:nzt,j,i) - MAX( 0.0_wp, ( rs(nzb+2:nzt+1,j,i) * & |
---|
8274 | sedim_vd(nzb+2:nzt+1,j,i,ib) - rs(nzb+1:nzt,j,i) * & |
---|
8275 | sedim_vd(nzb+1:nzt,j,i,ib) ) * ddzu(nzb+1:nzt) ) * & |
---|
8276 | MERGE( 1.0_wp, 0.0_wp, BTEST( wall_flags_total_0(nzb:nzt-1,j,i), 0 ) ) |
---|
8277 | ENDIF |
---|
8278 | DO k = nzb+1, nzt |
---|
8279 | rs_p(k,j,i) = rs(k,j,i) + ( dt_3d * ( tsc(2) * tend(k,j,i) + tsc(3) * trs_m(k,j,i) )& |
---|
8280 | - tsc(5) * rdf_sc(k) * ( rs(k,j,i) - rs_init(k) )& |
---|
8281 | ) * MERGE( 1.0_wp, 0.0_wp, BTEST( wall_flags_total_0(k,j,i), 0 ) ) |
---|
8282 | IF ( rs_p(k,j,i) < 0.0_wp ) rs_p(k,j,i) = 0.1_wp * rs(k,j,i) |
---|
8283 | ENDDO |
---|
8284 | ENDDO |
---|
8285 | ENDDO |
---|
8286 | ! |
---|
8287 | !-- Calculate tendencies for the next Runge-Kutta step |
---|
8288 | IF ( timestep_scheme(1:5) == 'runge' ) THEN |
---|
8289 | IF ( intermediate_timestep_count == 1 ) THEN |
---|
8290 | DO i = nxl, nxr |
---|
8291 | DO j = nys, nyn |
---|
8292 | DO k = nzb+1, nzt |
---|
8293 | trs_m(k,j,i) = tend(k,j,i) |
---|
8294 | ENDDO |
---|
8295 | ENDDO |
---|
8296 | ENDDO |
---|
8297 | ELSEIF ( intermediate_timestep_count < intermediate_timestep_count_max ) THEN |
---|
8298 | DO i = nxl, nxr |
---|
8299 | DO j = nys, nyn |
---|
8300 | DO k = nzb+1, nzt |
---|
8301 | trs_m(k,j,i) = -9.5625_wp * tend(k,j,i) + 5.3125_wp * trs_m(k,j,i) |
---|
8302 | ENDDO |
---|
8303 | ENDDO |
---|
8304 | ENDDO |
---|
8305 | ENDIF |
---|
8306 | ENDIF |
---|
8307 | |
---|
8308 | END SUBROUTINE salsa_tendency |
---|
8309 | |
---|
8310 | |
---|
8311 | !------------------------------------------------------------------------------! |
---|
8312 | ! Description: |
---|
8313 | ! ------------ |
---|
8314 | !> Boundary conditions for prognostic variables in SALSA from module interface |
---|
8315 | !------------------------------------------------------------------------------! |
---|
8316 | SUBROUTINE salsa_boundary_conditions |
---|
8317 | |
---|
8318 | IMPLICIT NONE |
---|
8319 | |
---|
8320 | INTEGER(iwp) :: ib !< index for aerosol size bins |
---|
8321 | INTEGER(iwp) :: ic !< index for aerosol mass bins |
---|
8322 | INTEGER(iwp) :: icc !< additional index for aerosol mass bins |
---|
8323 | INTEGER(iwp) :: ig !< index for salsa gases |
---|
8324 | |
---|
8325 | |
---|
8326 | ! |
---|
8327 | !-- moved from boundary_conds |
---|
8328 | CALL salsa_boundary_conds |
---|
8329 | ! |
---|
8330 | !-- Boundary conditions for prognostic quantitites of other modules: |
---|
8331 | !-- Here, only decycling is carried out |
---|
8332 | IF ( time_since_reference_point >= skip_time_do_salsa ) THEN |
---|
8333 | |
---|
8334 | DO ib = 1, nbins_aerosol |
---|
8335 | CALL salsa_boundary_conds( aerosol_number(ib)%conc_p, aerosol_number(ib)%init ) |
---|
8336 | DO ic = 1, ncomponents_mass |
---|
8337 | icc = ( ic - 1 ) * nbins_aerosol + ib |
---|
8338 | CALL salsa_boundary_conds( aerosol_mass(icc)%conc_p, aerosol_mass(icc)%init ) |
---|
8339 | ENDDO |
---|
8340 | ENDDO |
---|
8341 | IF ( .NOT. salsa_gases_from_chem ) THEN |
---|
8342 | DO ig = 1, ngases_salsa |
---|
8343 | CALL salsa_boundary_conds( salsa_gas(ig)%conc_p, salsa_gas(ig)%init ) |
---|
8344 | ENDDO |
---|
8345 | ENDIF |
---|
8346 | |
---|
8347 | ENDIF |
---|
8348 | |
---|
8349 | END SUBROUTINE salsa_boundary_conditions |
---|
8350 | |
---|
8351 | !------------------------------------------------------------------------------! |
---|
8352 | ! Description: |
---|
8353 | ! ------------ |
---|
8354 | !> Boundary conditions for prognostic variables in SALSA |
---|
8355 | !------------------------------------------------------------------------------! |
---|
8356 | SUBROUTINE salsa_boundary_conds |
---|
8357 | |
---|
8358 | USE arrays_3d, & |
---|
8359 | ONLY: dzu |
---|
8360 | |
---|
8361 | USE surface_mod, & |
---|
8362 | ONLY : bc_h |
---|
8363 | |
---|
8364 | IMPLICIT NONE |
---|
8365 | |
---|
8366 | INTEGER(iwp) :: i !< grid index x direction |
---|
8367 | INTEGER(iwp) :: ib !< index for aerosol size bins |
---|
8368 | INTEGER(iwp) :: ic !< index for chemical compounds in aerosols |
---|
8369 | INTEGER(iwp) :: icc !< additional index for chemical compounds in aerosols |
---|
8370 | INTEGER(iwp) :: ig !< idex for gaseous compounds |
---|
8371 | INTEGER(iwp) :: j !< grid index y direction |
---|
8372 | INTEGER(iwp) :: k !< grid index y direction |
---|
8373 | INTEGER(iwp) :: l !< running index boundary type, for up- and downward-facing walls |
---|
8374 | INTEGER(iwp) :: m !< running index surface elements |
---|
8375 | |
---|
8376 | IF ( time_since_reference_point >= skip_time_do_salsa ) THEN |
---|
8377 | ! |
---|
8378 | !-- Surface conditions: |
---|
8379 | IF ( ibc_salsa_b == 0 ) THEN ! Dirichlet |
---|
8380 | ! |
---|
8381 | !-- Run loop over all non-natural and natural walls. Note, in wall-datatype the k coordinate |
---|
8382 | !-- belongs to the atmospheric grid point, therefore, set s_p at k-1 |
---|
8383 | DO l = 0, 1 |
---|
8384 | !$OMP PARALLEL PRIVATE( ib, ic, icc, ig, i, j, k ) |
---|
8385 | !$OMP DO |
---|
8386 | DO m = 1, bc_h(l)%ns |
---|
8387 | |
---|
8388 | i = bc_h(l)%i(m) |
---|
8389 | j = bc_h(l)%j(m) |
---|
8390 | k = bc_h(l)%k(m) |
---|
8391 | |
---|
8392 | DO ib = 1, nbins_aerosol |
---|
8393 | aerosol_number(ib)%conc_p(k+bc_h(l)%koff,j,i) = & |
---|
8394 | aerosol_number(ib)%conc(k+bc_h(l)%koff,j,i) |
---|
8395 | DO ic = 1, ncomponents_mass |
---|
8396 | icc = ( ic - 1 ) * nbins_aerosol + ib |
---|
8397 | aerosol_mass(icc)%conc_p(k+bc_h(l)%koff,j,i) = & |
---|
8398 | aerosol_mass(icc)%conc(k+bc_h(l)%koff,j,i) |
---|
8399 | ENDDO |
---|
8400 | ENDDO |
---|
8401 | IF ( .NOT. salsa_gases_from_chem ) THEN |
---|
8402 | DO ig = 1, ngases_salsa |
---|
8403 | salsa_gas(ig)%conc_p(k+bc_h(l)%koff,j,i) = & |
---|
8404 | salsa_gas(ig)%conc(k+bc_h(l)%koff,j,i) |
---|
8405 | ENDDO |
---|
8406 | ENDIF |
---|
8407 | |
---|
8408 | ENDDO |
---|
8409 | !$OMP END PARALLEL |
---|
8410 | |
---|
8411 | ENDDO |
---|
8412 | |
---|
8413 | ELSE ! Neumann |
---|
8414 | |
---|
8415 | DO l = 0, 1 |
---|
8416 | !$OMP PARALLEL PRIVATE( ib, ic, icc, ig, i, j, k ) |
---|
8417 | !$OMP DO |
---|
8418 | DO m = 1, bc_h(l)%ns |
---|
8419 | |
---|
8420 | i = bc_h(l)%i(m) |
---|
8421 | j = bc_h(l)%j(m) |
---|
8422 | k = bc_h(l)%k(m) |
---|
8423 | |
---|
8424 | DO ib = 1, nbins_aerosol |
---|
8425 | aerosol_number(ib)%conc_p(k+bc_h(l)%koff,j,i) = & |
---|
8426 | aerosol_number(ib)%conc_p(k,j,i) |
---|
8427 | DO ic = 1, ncomponents_mass |
---|
8428 | icc = ( ic - 1 ) * nbins_aerosol + ib |
---|
8429 | aerosol_mass(icc)%conc_p(k+bc_h(l)%koff,j,i) = & |
---|
8430 | aerosol_mass(icc)%conc_p(k,j,i) |
---|
8431 | ENDDO |
---|
8432 | ENDDO |
---|
8433 | IF ( .NOT. salsa_gases_from_chem ) THEN |
---|
8434 | DO ig = 1, ngases_salsa |
---|
8435 | salsa_gas(ig)%conc_p(k+bc_h(l)%koff,j,i) = & |
---|
8436 | salsa_gas(ig)%conc_p(k,j,i) |
---|
8437 | ENDDO |
---|
8438 | ENDIF |
---|
8439 | |
---|
8440 | ENDDO |
---|
8441 | !$OMP END PARALLEL |
---|
8442 | ENDDO |
---|
8443 | |
---|
8444 | ENDIF |
---|
8445 | ! |
---|
8446 | !-- Top boundary conditions: |
---|
8447 | IF ( ibc_salsa_t == 0 ) THEN ! Dirichlet |
---|
8448 | |
---|
8449 | DO ib = 1, nbins_aerosol |
---|
8450 | aerosol_number(ib)%conc_p(nzt+1,:,:) = aerosol_number(ib)%conc(nzt+1,:,:) |
---|
8451 | DO ic = 1, ncomponents_mass |
---|
8452 | icc = ( ic - 1 ) * nbins_aerosol + ib |
---|
8453 | aerosol_mass(icc)%conc_p(nzt+1,:,:) = aerosol_mass(icc)%conc(nzt+1,:,:) |
---|
8454 | ENDDO |
---|
8455 | ENDDO |
---|
8456 | IF ( .NOT. salsa_gases_from_chem ) THEN |
---|
8457 | DO ig = 1, ngases_salsa |
---|
8458 | salsa_gas(ig)%conc_p(nzt+1,:,:) = salsa_gas(ig)%conc(nzt+1,:,:) |
---|
8459 | ENDDO |
---|
8460 | ENDIF |
---|
8461 | |
---|
8462 | ELSEIF ( ibc_salsa_t == 1 ) THEN ! Neumann |
---|
8463 | |
---|
8464 | DO ib = 1, nbins_aerosol |
---|
8465 | aerosol_number(ib)%conc_p(nzt+1,:,:) = aerosol_number(ib)%conc_p(nzt,:,:) |
---|
8466 | DO ic = 1, ncomponents_mass |
---|
8467 | icc = ( ic - 1 ) * nbins_aerosol + ib |
---|
8468 | aerosol_mass(icc)%conc_p(nzt+1,:,:) = aerosol_mass(icc)%conc_p(nzt,:,:) |
---|
8469 | ENDDO |
---|
8470 | ENDDO |
---|
8471 | IF ( .NOT. salsa_gases_from_chem ) THEN |
---|
8472 | DO ig = 1, ngases_salsa |
---|
8473 | salsa_gas(ig)%conc_p(nzt+1,:,:) = salsa_gas(ig)%conc_p(nzt,:,:) |
---|
8474 | ENDDO |
---|
8475 | ENDIF |
---|
8476 | |
---|
8477 | ELSEIF ( ibc_salsa_t == 2 ) THEN ! Initial gradient |
---|
8478 | |
---|
8479 | DO ib = 1, nbins_aerosol |
---|
8480 | aerosol_number(ib)%conc_p(nzt+1,:,:) = aerosol_number(ib)%conc_p(nzt,:,:) + & |
---|
8481 | bc_an_t_val(ib) * dzu(nzt+1) |
---|
8482 | DO ic = 1, ncomponents_mass |
---|
8483 | icc = ( ic - 1 ) * nbins_aerosol + ib |
---|
8484 | aerosol_mass(icc)%conc_p(nzt+1,:,:) = aerosol_mass(icc)%conc_p(nzt,:,:) + & |
---|
8485 | bc_am_t_val(icc) * dzu(nzt+1) |
---|
8486 | ENDDO |
---|
8487 | ENDDO |
---|
8488 | IF ( .NOT. salsa_gases_from_chem ) THEN |
---|
8489 | DO ig = 1, ngases_salsa |
---|
8490 | salsa_gas(ig)%conc_p(nzt+1,:,:) = salsa_gas(ig)%conc_p(nzt,:,:) + & |
---|
8491 | bc_gt_t_val(ig) * dzu(nzt+1) |
---|
8492 | ENDDO |
---|
8493 | ENDIF |
---|
8494 | |
---|
8495 | ENDIF |
---|
8496 | ! |
---|
8497 | !-- Lateral boundary conditions at the outflow |
---|
8498 | IF ( bc_radiation_s ) THEN |
---|
8499 | DO ib = 1, nbins_aerosol |
---|
8500 | aerosol_number(ib)%conc_p(:,nys-1,:) = aerosol_number(ib)%conc_p(:,nys,:) |
---|
8501 | DO ic = 1, ncomponents_mass |
---|
8502 | icc = ( ic - 1 ) * nbins_aerosol + ib |
---|
8503 | aerosol_mass(icc)%conc_p(:,nys-1,:) = aerosol_mass(icc)%conc_p(:,nys,:) |
---|
8504 | ENDDO |
---|
8505 | ENDDO |
---|
8506 | IF ( .NOT. salsa_gases_from_chem ) THEN |
---|
8507 | DO ig = 1, ngases_salsa |
---|
8508 | salsa_gas(ig)%conc_p(:,nys-1,:) = salsa_gas(ig)%conc_p(:,nys,:) |
---|
8509 | ENDDO |
---|
8510 | ENDIF |
---|
8511 | |
---|
8512 | ELSEIF ( bc_radiation_n ) THEN |
---|
8513 | DO ib = 1, nbins_aerosol |
---|
8514 | aerosol_number(ib)%conc_p(:,nyn+1,:) = aerosol_number(ib)%conc_p(:,nyn,:) |
---|
8515 | DO ic = 1, ncomponents_mass |
---|
8516 | icc = ( ic - 1 ) * nbins_aerosol + ib |
---|
8517 | aerosol_mass(icc)%conc_p(:,nyn+1,:) = aerosol_mass(icc)%conc_p(:,nyn,:) |
---|
8518 | ENDDO |
---|
8519 | ENDDO |
---|
8520 | IF ( .NOT. salsa_gases_from_chem ) THEN |
---|
8521 | DO ig = 1, ngases_salsa |
---|
8522 | salsa_gas(ig)%conc_p(:,nyn+1,:) = salsa_gas(ig)%conc_p(:,nyn,:) |
---|
8523 | ENDDO |
---|
8524 | ENDIF |
---|
8525 | |
---|
8526 | ELSEIF ( bc_radiation_l ) THEN |
---|
8527 | DO ib = 1, nbins_aerosol |
---|
8528 | aerosol_number(ib)%conc_p(:,:,nxl-1) = aerosol_number(ib)%conc_p(:,:,nxl) |
---|
8529 | DO ic = 1, ncomponents_mass |
---|
8530 | icc = ( ic - 1 ) * nbins_aerosol + ib |
---|
8531 | aerosol_mass(icc)%conc_p(:,:,nxl-1) = aerosol_mass(icc)%conc_p(:,:,nxl) |
---|
8532 | ENDDO |
---|
8533 | ENDDO |
---|
8534 | IF ( .NOT. salsa_gases_from_chem ) THEN |
---|
8535 | DO ig = 1, ngases_salsa |
---|
8536 | salsa_gas(ig)%conc_p(:,:,nxl-1) = salsa_gas(ig)%conc_p(:,:,nxl) |
---|
8537 | ENDDO |
---|
8538 | ENDIF |
---|
8539 | |
---|
8540 | ELSEIF ( bc_radiation_r ) THEN |
---|
8541 | DO ib = 1, nbins_aerosol |
---|
8542 | aerosol_number(ib)%conc_p(:,:,nxr+1) = aerosol_number(ib)%conc_p(:,:,nxr) |
---|
8543 | DO ic = 1, ncomponents_mass |
---|
8544 | icc = ( ic - 1 ) * nbins_aerosol + ib |
---|
8545 | aerosol_mass(icc)%conc_p(:,:,nxr+1) = aerosol_mass(icc)%conc_p(:,:,nxr) |
---|
8546 | ENDDO |
---|
8547 | ENDDO |
---|
8548 | IF ( .NOT. salsa_gases_from_chem ) THEN |
---|
8549 | DO ig = 1, ngases_salsa |
---|
8550 | salsa_gas(ig)%conc_p(:,:,nxr+1) = salsa_gas(ig)%conc_p(:,:,nxr) |
---|
8551 | ENDDO |
---|
8552 | ENDIF |
---|
8553 | |
---|
8554 | ENDIF |
---|
8555 | |
---|
8556 | ENDIF |
---|
8557 | |
---|
8558 | END SUBROUTINE salsa_boundary_conds |
---|
8559 | |
---|
8560 | !------------------------------------------------------------------------------! |
---|
8561 | ! Description: |
---|
8562 | ! ------------ |
---|
8563 | ! Undoing of the previously done cyclic boundary conditions. |
---|
8564 | !------------------------------------------------------------------------------! |
---|
8565 | SUBROUTINE salsa_boundary_conds_decycle ( sq, sq_init ) |
---|
8566 | |
---|
8567 | USE control_parameters, & |
---|
8568 | ONLY: nesting_offline |
---|
8569 | |
---|
8570 | IMPLICIT NONE |
---|
8571 | |
---|
8572 | INTEGER(iwp) :: boundary !< |
---|
8573 | INTEGER(iwp) :: ee !< |
---|
8574 | INTEGER(iwp) :: copied !< |
---|
8575 | INTEGER(iwp) :: i !< |
---|
8576 | INTEGER(iwp) :: j !< |
---|
8577 | INTEGER(iwp) :: k !< |
---|
8578 | INTEGER(iwp) :: ss !< |
---|
8579 | |
---|
8580 | REAL(wp) :: flag !< flag to mask topography grid points |
---|
8581 | |
---|
8582 | REAL(wp), DIMENSION(nzb:nzt+1) :: sq_init !< initial concentration profile |
---|
8583 | |
---|
8584 | REAL(wp), DIMENSION(nzb:nzt+1,nysg:nyng,nxlg:nxrg) :: sq !< concentration array |
---|
8585 | |
---|
8586 | flag = 0.0_wp |
---|
8587 | ! |
---|
8588 | !-- Skip input if forcing from a larger-scale models is applied. |
---|
8589 | IF ( nesting_offline .AND. nesting_offline_salsa ) RETURN |
---|
8590 | ! |
---|
8591 | !-- Left and right boundaries |
---|
8592 | IF ( decycle_salsa_lr .AND. ( bc_lr_cyc .OR. bc_lr == 'nested' ) ) THEN |
---|
8593 | |
---|
8594 | DO boundary = 1, 2 |
---|
8595 | |
---|
8596 | IF ( decycle_method_salsa(boundary) == 'dirichlet' ) THEN |
---|
8597 | ! |
---|
8598 | !-- Initial profile is copied to ghost and first three layers |
---|
8599 | ss = 1 |
---|
8600 | ee = 0 |
---|
8601 | IF ( boundary == 1 .AND. nxl == 0 ) THEN |
---|
8602 | ss = nxlg |
---|
8603 | ee = nxl-1 |
---|
8604 | ELSEIF ( boundary == 2 .AND. nxr == nx ) THEN |
---|
8605 | ss = nxr+1 |
---|
8606 | ee = nxrg |
---|
8607 | ENDIF |
---|
8608 | |
---|
8609 | DO i = ss, ee |
---|
8610 | DO j = nysg, nyng |
---|
8611 | DO k = nzb+1, nzt |
---|
8612 | flag = MERGE( 1.0_wp, 0.0_wp, BTEST( wall_flags_total_0(k,j,i), 0 ) ) |
---|
8613 | sq(k,j,i) = sq_init(k) * flag |
---|
8614 | ENDDO |
---|
8615 | ENDDO |
---|
8616 | ENDDO |
---|
8617 | |
---|
8618 | ELSEIF ( decycle_method_salsa(boundary) == 'neumann' ) THEN |
---|
8619 | ! |
---|
8620 | !-- The value at the boundary is copied to the ghost layers to simulate an outlet with |
---|
8621 | !-- zero gradient |
---|
8622 | ss = 1 |
---|
8623 | ee = 0 |
---|
8624 | IF ( boundary == 1 .AND. nxl == 0 ) THEN |
---|
8625 | ss = nxlg |
---|
8626 | ee = nxl-1 |
---|
8627 | copied = nxl |
---|
8628 | ELSEIF ( boundary == 2 .AND. nxr == nx ) THEN |
---|
8629 | ss = nxr+1 |
---|
8630 | ee = nxrg |
---|
8631 | copied = nxr |
---|
8632 | ENDIF |
---|
8633 | |
---|
8634 | DO i = ss, ee |
---|
8635 | DO j = nysg, nyng |
---|
8636 | DO k = nzb+1, nzt |
---|
8637 | flag = MERGE( 1.0_wp, 0.0_wp, BTEST( wall_flags_total_0(k,j,i), 0 ) ) |
---|
8638 | sq(k,j,i) = sq(k,j,copied) * flag |
---|
8639 | ENDDO |
---|
8640 | ENDDO |
---|
8641 | ENDDO |
---|
8642 | |
---|
8643 | ELSE |
---|
8644 | WRITE(message_string,*) 'unknown decycling method: decycle_method_salsa (', boundary, & |
---|
8645 | ') ="' // TRIM( decycle_method_salsa(boundary) ) // '"' |
---|
8646 | CALL message( 'salsa_boundary_conds_decycle', 'PA0626', 1, 2, 0, 6, 0 ) |
---|
8647 | ENDIF |
---|
8648 | ENDDO |
---|
8649 | ENDIF |
---|
8650 | |
---|
8651 | ! |
---|
8652 | !-- South and north boundaries |
---|
8653 | IF ( decycle_salsa_ns .AND. ( bc_ns_cyc .OR. bc_ns == 'nested' ) ) THEN |
---|
8654 | |
---|
8655 | DO boundary = 3, 4 |
---|
8656 | |
---|
8657 | IF ( decycle_method_salsa(boundary) == 'dirichlet' ) THEN |
---|
8658 | ! |
---|
8659 | !-- Initial profile is copied to ghost and first three layers |
---|
8660 | ss = 1 |
---|
8661 | ee = 0 |
---|
8662 | IF ( boundary == 3 .AND. nys == 0 ) THEN |
---|
8663 | ss = nysg |
---|
8664 | ee = nys-1 |
---|
8665 | ELSEIF ( boundary == 4 .AND. nyn == ny ) THEN |
---|
8666 | ss = nyn+1 |
---|
8667 | ee = nyng |
---|
8668 | ENDIF |
---|
8669 | |
---|
8670 | DO i = nxlg, nxrg |
---|
8671 | DO j = ss, ee |
---|
8672 | DO k = nzb+1, nzt |
---|
8673 | flag = MERGE( 1.0_wp, 0.0_wp, BTEST( wall_flags_total_0(k,j,i), 0 ) ) |
---|
8674 | sq(k,j,i) = sq_init(k) * flag |
---|
8675 | ENDDO |
---|
8676 | ENDDO |
---|
8677 | ENDDO |
---|
8678 | |
---|
8679 | ELSEIF ( decycle_method_salsa(boundary) == 'neumann' ) THEN |
---|
8680 | ! |
---|
8681 | !-- The value at the boundary is copied to the ghost layers to simulate an outlet with |
---|
8682 | !-- zero gradient |
---|
8683 | ss = 1 |
---|
8684 | ee = 0 |
---|
8685 | IF ( boundary == 3 .AND. nys == 0 ) THEN |
---|
8686 | ss = nysg |
---|
8687 | ee = nys-1 |
---|
8688 | copied = nys |
---|
8689 | ELSEIF ( boundary == 4 .AND. nyn == ny ) THEN |
---|
8690 | ss = nyn+1 |
---|
8691 | ee = nyng |
---|
8692 | copied = nyn |
---|
8693 | ENDIF |
---|
8694 | |
---|
8695 | DO i = nxlg, nxrg |
---|
8696 | DO j = ss, ee |
---|
8697 | DO k = nzb+1, nzt |
---|
8698 | flag = MERGE( 1.0_wp, 0.0_wp, BTEST( wall_flags_total_0(k,j,i), 0 ) ) |
---|
8699 | sq(k,j,i) = sq(k,copied,i) * flag |
---|
8700 | ENDDO |
---|
8701 | ENDDO |
---|
8702 | ENDDO |
---|
8703 | |
---|
8704 | ELSE |
---|
8705 | WRITE(message_string,*) 'unknown decycling method: decycle_method_salsa (', boundary, & |
---|
8706 | ') ="' // TRIM( decycle_method_salsa(boundary) ) // '"' |
---|
8707 | CALL message( 'salsa_boundary_conds_decycle', 'PA0627', 1, 2, 0, 6, 0 ) |
---|
8708 | ENDIF |
---|
8709 | ENDDO |
---|
8710 | ENDIF |
---|
8711 | |
---|
8712 | END SUBROUTINE salsa_boundary_conds_decycle |
---|
8713 | |
---|
8714 | !------------------------------------------------------------------------------! |
---|
8715 | ! Description: |
---|
8716 | ! ------------ |
---|
8717 | !> Calculates the total dry or wet mass concentration for individual bins |
---|
8718 | !> Juha Tonttila (FMI) 2015 |
---|
8719 | !> Tomi Raatikainen (FMI) 2016 |
---|
8720 | !------------------------------------------------------------------------------! |
---|
8721 | SUBROUTINE bin_mixrat( itype, ibin, i, j, mconc ) |
---|
8722 | |
---|
8723 | IMPLICIT NONE |
---|
8724 | |
---|
8725 | CHARACTER(len=*), INTENT(in) :: itype !< 'dry' or 'wet' |
---|
8726 | |
---|
8727 | INTEGER(iwp) :: ic !< loop index for mass bin number |
---|
8728 | INTEGER(iwp) :: iend !< end index: include water or not |
---|
8729 | |
---|
8730 | INTEGER(iwp), INTENT(in) :: ibin !< index of the chemical component |
---|
8731 | INTEGER(iwp), INTENT(in) :: i !< loop index for x-direction |
---|
8732 | INTEGER(iwp), INTENT(in) :: j !< loop index for y-direction |
---|
8733 | |
---|
8734 | REAL(wp), DIMENSION(:), INTENT(out) :: mconc !< total dry or wet mass concentration |
---|
8735 | |
---|
8736 | !-- Number of components |
---|
8737 | IF ( itype == 'dry' ) THEN |
---|
8738 | iend = prtcl%ncomp - 1 |
---|
8739 | ELSE IF ( itype == 'wet' ) THEN |
---|
8740 | iend = prtcl%ncomp |
---|
8741 | ELSE |
---|
8742 | message_string = 'Error in itype!' |
---|
8743 | CALL message( 'bin_mixrat', 'PA0628', 2, 2, 0, 6, 0 ) |
---|
8744 | ENDIF |
---|
8745 | |
---|
8746 | mconc = 0.0_wp |
---|
8747 | |
---|
8748 | DO ic = ibin, iend*nbins_aerosol+ibin, nbins_aerosol !< every nbins'th element |
---|
8749 | mconc = mconc + aerosol_mass(ic)%conc(:,j,i) |
---|
8750 | ENDDO |
---|
8751 | |
---|
8752 | END SUBROUTINE bin_mixrat |
---|
8753 | |
---|
8754 | !------------------------------------------------------------------------------! |
---|
8755 | ! Description: |
---|
8756 | ! ------------ |
---|
8757 | !> Sets surface fluxes |
---|
8758 | !------------------------------------------------------------------------------! |
---|
8759 | SUBROUTINE salsa_emission_update |
---|
8760 | |
---|
8761 | IMPLICIT NONE |
---|
8762 | |
---|
8763 | IF ( include_emission ) THEN |
---|
8764 | |
---|
8765 | IF ( time_since_reference_point >= skip_time_do_salsa ) THEN |
---|
8766 | |
---|
8767 | IF ( next_aero_emission_update <= & |
---|
8768 | MAX( time_since_reference_point, 0.0_wp ) ) THEN |
---|
8769 | CALL salsa_emission_setup( .FALSE. ) |
---|
8770 | ENDIF |
---|
8771 | |
---|
8772 | IF ( next_gas_emission_update <= & |
---|
8773 | MAX( time_since_reference_point, 0.0_wp ) ) THEN |
---|
8774 | IF ( salsa_emission_mode == 'read_from_file' .AND. .NOT. salsa_gases_from_chem ) & |
---|
8775 | THEN |
---|
8776 | CALL salsa_gas_emission_setup( .FALSE. ) |
---|
8777 | ENDIF |
---|
8778 | ENDIF |
---|
8779 | |
---|
8780 | ENDIF |
---|
8781 | ENDIF |
---|
8782 | |
---|
8783 | END SUBROUTINE salsa_emission_update |
---|
8784 | |
---|
8785 | !------------------------------------------------------------------------------! |
---|
8786 | !> Description: |
---|
8787 | !> ------------ |
---|
8788 | !> Define aerosol fluxes: constant or read from a from file |
---|
8789 | !> @todo - Emission stack height is not used yet. For default mode, emissions |
---|
8790 | !> are assumed to occur on upward facing horizontal surfaces. |
---|
8791 | !------------------------------------------------------------------------------! |
---|
8792 | SUBROUTINE salsa_emission_setup( init ) |
---|
8793 | |
---|
8794 | USE control_parameters, & |
---|
8795 | ONLY: end_time, spinup_time |
---|
8796 | |
---|
8797 | USE netcdf_data_input_mod, & |
---|
8798 | ONLY: check_existence, close_input_file, get_attribute, get_variable, & |
---|
8799 | inquire_num_variables, inquire_variable_names, & |
---|
8800 | get_dimension_length, open_read_file, street_type_f |
---|
8801 | |
---|
8802 | USE palm_date_time_mod, & |
---|
8803 | ONLY: days_per_week, get_date_time, hours_per_day, months_per_year, seconds_per_hour |
---|
8804 | |
---|
8805 | USE surface_mod, & |
---|
8806 | ONLY: surf_def_h, surf_lsm_h, surf_usm_h |
---|
8807 | |
---|
8808 | IMPLICIT NONE |
---|
8809 | |
---|
8810 | CHARACTER(LEN=80) :: daytype = 'workday' !< default day type |
---|
8811 | CHARACTER(LEN=25) :: in_name !< name of a gas in the input file |
---|
8812 | CHARACTER(LEN=25) :: mod_name !< name in the input file |
---|
8813 | |
---|
8814 | INTEGER(iwp) :: day_of_month !< day of the month |
---|
8815 | INTEGER(iwp) :: day_of_week !< day of the week |
---|
8816 | INTEGER(iwp) :: day_of_year !< day of the year |
---|
8817 | INTEGER(iwp) :: hour_of_day !< hour of the day |
---|
8818 | INTEGER(iwp) :: i !< loop index |
---|
8819 | INTEGER(iwp) :: ib !< loop index: aerosol number bins |
---|
8820 | INTEGER(iwp) :: ic !< loop index: aerosol chemical components |
---|
8821 | INTEGER(iwp) :: id_salsa !< NetCDF id of aerosol emission input file |
---|
8822 | INTEGER(iwp) :: in !< loop index: emission category |
---|
8823 | INTEGER(iwp) :: index_dd !< index day |
---|
8824 | INTEGER(iwp) :: index_hh !< index hour |
---|
8825 | INTEGER(iwp) :: index_mm !< index month |
---|
8826 | INTEGER(iwp) :: inn !< loop index |
---|
8827 | INTEGER(iwp) :: j !< loop index |
---|
8828 | INTEGER(iwp) :: month_of_year !< month of the year |
---|
8829 | INTEGER(iwp) :: ss !< loop index |
---|
8830 | |
---|
8831 | INTEGER(iwp), DIMENSION(maxspec) :: cc_i2m !< |
---|
8832 | |
---|
8833 | LOGICAL :: netcdf_extend = .FALSE. !< NetCDF input file exists |
---|
8834 | |
---|
8835 | LOGICAL, INTENT(in) :: init !< if .TRUE. --> initialisation call |
---|
8836 | |
---|
8837 | REAL(wp) :: second_of_day !< second of the day |
---|
8838 | |
---|
8839 | REAL(wp), DIMENSION(24) :: par_emis_time_factor = & !< time factors for the parameterized mode |
---|
8840 | (/ 0.009, 0.004, 0.004, 0.009, 0.029, 0.039, & |
---|
8841 | 0.056, 0.053, 0.051, 0.051, 0.052, 0.055, & |
---|
8842 | 0.059, 0.061, 0.064, 0.067, 0.069, 0.069, & |
---|
8843 | 0.049, 0.039, 0.039, 0.029, 0.024, 0.019 /) |
---|
8844 | |
---|
8845 | REAL(wp), DIMENSION(:), ALLOCATABLE :: nsect_emission !< sectional number emission |
---|
8846 | |
---|
8847 | REAL(wp), DIMENSION(:,:,:), ALLOCATABLE :: source_array !< temporary source array |
---|
8848 | |
---|
8849 | ! |
---|
8850 | !-- Define emissions: |
---|
8851 | SELECT CASE ( salsa_emission_mode ) |
---|
8852 | |
---|
8853 | CASE ( 'uniform', 'parameterized' ) |
---|
8854 | |
---|
8855 | IF ( init ) THEN ! Do only once |
---|
8856 | ! |
---|
8857 | !- Form a sectional size distribution for the emissions |
---|
8858 | ALLOCATE( nsect_emission(1:nbins_aerosol), & |
---|
8859 | source_array(nys:nyn,nxl:nxr,1:nbins_aerosol) ) |
---|
8860 | ! |
---|
8861 | !-- Precalculate a size distribution for the emission based on the mean diameter, standard |
---|
8862 | !-- deviation and number concentration per each log-normal mode |
---|
8863 | CALL size_distribution( surface_aerosol_flux, aerosol_flux_dpg, aerosol_flux_sigmag, & |
---|
8864 | nsect_emission ) |
---|
8865 | IF ( salsa_emission_mode == 'uniform' ) THEN |
---|
8866 | DO ib = 1, nbins_aerosol |
---|
8867 | source_array(:,:,ib) = nsect_emission(ib) |
---|
8868 | ENDDO |
---|
8869 | ELSE |
---|
8870 | ! |
---|
8871 | !-- Get a time factor for the specific hour |
---|
8872 | IF ( .NOT. ALLOCATED( aero_emission_att%time_factor ) ) & |
---|
8873 | ALLOCATE( aero_emission_att%time_factor(1) ) |
---|
8874 | CALL get_date_time( MAX( time_since_reference_point, 0.0_wp ), hour=hour_of_day ) |
---|
8875 | index_hh = hour_of_day |
---|
8876 | aero_emission_att%time_factor(1) = par_emis_time_factor(index_hh+1) |
---|
8877 | |
---|
8878 | IF ( street_type_f%from_file ) THEN |
---|
8879 | DO i = nxl, nxr |
---|
8880 | DO j = nys, nyn |
---|
8881 | IF ( street_type_f%var(j,i) >= main_street_id .AND. & |
---|
8882 | street_type_f%var(j,i) < max_street_id ) THEN |
---|
8883 | source_array(j,i,:) = nsect_emission(:) * emiss_factor_main * & |
---|
8884 | aero_emission_att%time_factor(1) |
---|
8885 | ELSEIF ( street_type_f%var(j,i) >= side_street_id .AND. & |
---|
8886 | street_type_f%var(j,i) < main_street_id ) THEN |
---|
8887 | source_array(j,i,:) = nsect_emission(:) * emiss_factor_side * & |
---|
8888 | aero_emission_att%time_factor(1) |
---|
8889 | ENDIF |
---|
8890 | ENDDO |
---|
8891 | ENDDO |
---|
8892 | ELSE |
---|
8893 | WRITE( message_string, * ) 'salsa_emission_mode = "parameterized" but the '// & |
---|
8894 | 'street_type data is missing.' |
---|
8895 | CALL message( 'salsa_emission_setup', 'PA0695', 1, 2, 0, 6, 0 ) |
---|
8896 | ENDIF |
---|
8897 | ENDIF |
---|
8898 | ! |
---|
8899 | !-- Check which chemical components are used |
---|
8900 | cc_i2m = 0 |
---|
8901 | IF ( index_so4 > 0 ) cc_i2m(1) = index_so4 |
---|
8902 | IF ( index_oc > 0 ) cc_i2m(2) = index_oc |
---|
8903 | IF ( index_bc > 0 ) cc_i2m(3) = index_bc |
---|
8904 | IF ( index_du > 0 ) cc_i2m(4) = index_du |
---|
8905 | IF ( index_ss > 0 ) cc_i2m(5) = index_ss |
---|
8906 | IF ( index_no > 0 ) cc_i2m(6) = index_no |
---|
8907 | IF ( index_nh > 0 ) cc_i2m(7) = index_nh |
---|
8908 | ! |
---|
8909 | !-- Normalise mass fractions so that their sum is 1 |
---|
8910 | aerosol_flux_mass_fracs_a = aerosol_flux_mass_fracs_a / & |
---|
8911 | SUM( aerosol_flux_mass_fracs_a(1:ncc ) ) |
---|
8912 | IF ( salsa_emission_mode == 'uniform' ) THEN |
---|
8913 | ! |
---|
8914 | !-- Set uniform fluxes of default horizontal surfaces |
---|
8915 | CALL set_flux( surf_def_h(0), cc_i2m, aerosol_flux_mass_fracs_a, source_array ) |
---|
8916 | ELSE |
---|
8917 | ! |
---|
8918 | !-- Set fluxes normalised based on the street type on land surfaces |
---|
8919 | CALL set_flux( surf_lsm_h, cc_i2m, aerosol_flux_mass_fracs_a, source_array ) |
---|
8920 | ENDIF |
---|
8921 | |
---|
8922 | DEALLOCATE( nsect_emission, source_array ) |
---|
8923 | ENDIF |
---|
8924 | |
---|
8925 | CASE ( 'read_from_file' ) |
---|
8926 | ! |
---|
8927 | !-- Reset surface fluxes |
---|
8928 | surf_def_h(0)%answs = 0.0_wp |
---|
8929 | surf_def_h(0)%amsws = 0.0_wp |
---|
8930 | surf_lsm_h%answs = 0.0_wp |
---|
8931 | surf_lsm_h%amsws = 0.0_wp |
---|
8932 | surf_usm_h%answs = 0.0_wp |
---|
8933 | surf_usm_h%amsws = 0.0_wp |
---|
8934 | |
---|
8935 | ! |
---|
8936 | !-- Reset source arrays: |
---|
8937 | DO ib = 1, nbins_aerosol |
---|
8938 | aerosol_number(ib)%source = 0.0_wp |
---|
8939 | ENDDO |
---|
8940 | |
---|
8941 | DO ic = 1, ncomponents_mass * nbins_aerosol |
---|
8942 | aerosol_mass(ic)%source = 0.0_wp |
---|
8943 | ENDDO |
---|
8944 | |
---|
8945 | #if defined( __netcdf ) |
---|
8946 | ! |
---|
8947 | !-- Check existence of PIDS_SALSA file |
---|
8948 | INQUIRE( FILE = TRIM( input_file_salsa ) // TRIM( coupling_char ), EXIST = netcdf_extend ) |
---|
8949 | IF ( .NOT. netcdf_extend ) THEN |
---|
8950 | message_string = 'Input file '// TRIM( input_file_salsa ) // TRIM( coupling_char )& |
---|
8951 | // ' missing!' |
---|
8952 | CALL message( 'salsa_emission_setup', 'PA0629', 1, 2, 0, 6, 0 ) |
---|
8953 | ENDIF |
---|
8954 | ! |
---|
8955 | !-- Open file in read-only mode |
---|
8956 | CALL open_read_file( TRIM( input_file_salsa ) // TRIM( coupling_char ), id_salsa ) |
---|
8957 | |
---|
8958 | IF ( init ) THEN |
---|
8959 | ! |
---|
8960 | !-- Variable names |
---|
8961 | CALL inquire_num_variables( id_salsa, aero_emission_att%num_vars ) |
---|
8962 | ALLOCATE( aero_emission_att%var_names(1:aero_emission_att%num_vars) ) |
---|
8963 | CALL inquire_variable_names( id_salsa, aero_emission_att%var_names ) |
---|
8964 | ! |
---|
8965 | !-- Read the index and name of chemical components |
---|
8966 | CALL get_dimension_length( id_salsa, aero_emission_att%ncc, 'composition_index' ) |
---|
8967 | ALLOCATE( aero_emission_att%cc_index(1:aero_emission_att%ncc) ) |
---|
8968 | CALL get_variable( id_salsa, 'composition_index', aero_emission_att%cc_index ) |
---|
8969 | |
---|
8970 | IF ( check_existence( aero_emission_att%var_names, 'composition_name' ) ) THEN |
---|
8971 | CALL get_variable( id_salsa, 'composition_name', aero_emission_att%cc_name, & |
---|
8972 | aero_emission_att%ncc ) |
---|
8973 | ELSE |
---|
8974 | message_string = 'Missing composition_name in ' // TRIM( input_file_salsa ) |
---|
8975 | CALL message( 'salsa_emission_setup', 'PA0657', 1, 2, 0, 6, 0 ) |
---|
8976 | ENDIF |
---|
8977 | ! |
---|
8978 | !-- Find the corresponding chemical components in the model |
---|
8979 | aero_emission_att%cc_in2mod = 0 |
---|
8980 | DO ic = 1, aero_emission_att%ncc |
---|
8981 | in_name = aero_emission_att%cc_name(ic) |
---|
8982 | SELECT CASE ( TRIM( in_name ) ) |
---|
8983 | CASE ( 'H2SO4', 'h2so4', 'SO4', 'so4' ) |
---|
8984 | aero_emission_att%cc_in2mod(1) = ic |
---|
8985 | CASE ( 'OC', 'oc', 'organics' ) |
---|
8986 | aero_emission_att%cc_in2mod(2) = ic |
---|
8987 | CASE ( 'BC', 'bc' ) |
---|
8988 | aero_emission_att%cc_in2mod(3) = ic |
---|
8989 | CASE ( 'DU', 'du' ) |
---|
8990 | aero_emission_att%cc_in2mod(4) = ic |
---|
8991 | CASE ( 'SS', 'ss' ) |
---|
8992 | aero_emission_att%cc_in2mod(5) = ic |
---|
8993 | CASE ( 'HNO3', 'hno3', 'NO', 'no', 'NO3', 'no3' ) |
---|
8994 | aero_emission_att%cc_in2mod(6) = ic |
---|
8995 | CASE ( 'NH3', 'nh3', 'NH', 'nh', 'NH4', 'nh4' ) |
---|
8996 | aero_emission_att%cc_in2mod(7) = ic |
---|
8997 | END SELECT |
---|
8998 | |
---|
8999 | ENDDO |
---|
9000 | |
---|
9001 | IF ( SUM( aero_emission_att%cc_in2mod ) == 0 ) THEN |
---|
9002 | message_string = 'None of the aerosol chemical components in ' // TRIM( & |
---|
9003 | input_file_salsa ) // ' correspond to the ones applied in SALSA.' |
---|
9004 | CALL message( 'salsa_emission_setup', 'PA0630', 1, 2, 0, 6, 0 ) |
---|
9005 | ENDIF |
---|
9006 | ! |
---|
9007 | !-- Get number of emission categories |
---|
9008 | CALL get_dimension_length( id_salsa, aero_emission_att%ncat, 'ncat' ) |
---|
9009 | ! |
---|
9010 | !-- Get the chemical composition (i.e. mass fraction of different species) in aerosols |
---|
9011 | IF ( check_existence( aero_emission_att%var_names, 'emission_mass_fracs' ) ) THEN |
---|
9012 | ALLOCATE( aero_emission%mass_fracs(1:aero_emission_att%ncat, & |
---|
9013 | 1:aero_emission_att%ncc) ) |
---|
9014 | CALL get_variable( id_salsa, 'emission_mass_fracs', aero_emission%mass_fracs, & |
---|
9015 | 0, aero_emission_att%ncc-1, 0, aero_emission_att%ncat-1 ) |
---|
9016 | ELSE |
---|
9017 | message_string = 'Missing emission_mass_fracs in ' // TRIM( input_file_salsa ) |
---|
9018 | CALL message( 'salsa_emission_setup', 'PA0694', 1, 2, 0, 6, 0 ) |
---|
9019 | ENDIF |
---|
9020 | ! |
---|
9021 | !-- If the chemical component is not activated, set its mass fraction to 0 to avoid |
---|
9022 | !-- inbalance between number and mass flux |
---|
9023 | cc_i2m = aero_emission_att%cc_in2mod |
---|
9024 | IF ( index_so4 < 0 .AND. cc_i2m(1) > 0 ) & |
---|
9025 | aero_emission%mass_fracs(:,cc_i2m(1)) = 0.0_wp |
---|
9026 | IF ( index_oc < 0 .AND. cc_i2m(2) > 0 ) & |
---|
9027 | aero_emission%mass_fracs(:,cc_i2m(2)) = 0.0_wp |
---|
9028 | IF ( index_bc < 0 .AND. cc_i2m(3) > 0 ) & |
---|
9029 | aero_emission%mass_fracs(:,cc_i2m(3)) = 0.0_wp |
---|
9030 | IF ( index_du < 0 .AND. cc_i2m(4) > 0 ) & |
---|
9031 | aero_emission%mass_fracs(:,cc_i2m(4)) = 0.0_wp |
---|
9032 | IF ( index_ss < 0 .AND. cc_i2m(5) > 0 ) & |
---|
9033 | aero_emission%mass_fracs(:,cc_i2m(5)) = 0.0_wp |
---|
9034 | IF ( index_no < 0 .AND. cc_i2m(6) > 0 ) & |
---|
9035 | aero_emission%mass_fracs(:,cc_i2m(6)) = 0.0_wp |
---|
9036 | IF ( index_nh < 0 .AND. cc_i2m(7) > 0 ) & |
---|
9037 | aero_emission%mass_fracs(:,cc_i2m(7)) = 0.0_wp |
---|
9038 | ! |
---|
9039 | !-- Then normalise the mass fraction so that SUM = 1 |
---|
9040 | DO in = 1, aero_emission_att%ncat |
---|
9041 | aero_emission%mass_fracs(in,:) = aero_emission%mass_fracs(in,:) / & |
---|
9042 | SUM( aero_emission%mass_fracs(in,:) ) |
---|
9043 | ENDDO |
---|
9044 | ! |
---|
9045 | !-- Inquire the fill value |
---|
9046 | CALL get_attribute( id_salsa, '_FillValue', aero_emission%fill, .FALSE., & |
---|
9047 | 'aerosol_emission_values' ) |
---|
9048 | ! |
---|
9049 | !-- Inquire units of emissions |
---|
9050 | CALL get_attribute( id_salsa, 'units', aero_emission_att%units, .FALSE., & |
---|
9051 | 'aerosol_emission_values' ) |
---|
9052 | ! |
---|
9053 | !-- Inquire the level of detail (lod) |
---|
9054 | CALL get_attribute( id_salsa, 'lod', aero_emission_att%lod, .FALSE., & |
---|
9055 | 'aerosol_emission_values' ) |
---|
9056 | |
---|
9057 | ! |
---|
9058 | !-- Read different emission information depending on the level of detail of emissions: |
---|
9059 | |
---|
9060 | ! |
---|
9061 | !-- Default mode: |
---|
9062 | IF ( aero_emission_att%lod == 1 ) THEN |
---|
9063 | ! |
---|
9064 | !-- Unit conversion factor: convert to SI units (kg/m2/s) |
---|
9065 | IF ( aero_emission_att%units == 'kg/m2/yr' ) THEN |
---|
9066 | aero_emission_att%conversion_factor = 1.0_wp / 3600.0_wp |
---|
9067 | ELSEIF ( aero_emission_att%units == 'g/m2/yr' ) THEN |
---|
9068 | aero_emission_att%conversion_factor = 0.001_wp / 3600.0_wp |
---|
9069 | ELSE |
---|
9070 | message_string = 'unknown unit for aerosol emissions: ' // & |
---|
9071 | TRIM( aero_emission_att%units ) // ' (lod1)' |
---|
9072 | CALL message( 'salsa_emission_setup','PA0631', 1, 2, 0, 6, 0 ) |
---|
9073 | ENDIF |
---|
9074 | ! |
---|
9075 | !-- Allocate emission arrays |
---|
9076 | ALLOCATE( aero_emission_att%cat_index(1:aero_emission_att%ncat), & |
---|
9077 | aero_emission_att%rho(1:aero_emission_att%ncat), & |
---|
9078 | aero_emission_att%time_factor(1:aero_emission_att%ncat) ) |
---|
9079 | ! |
---|
9080 | !-- Get emission category names and indices |
---|
9081 | IF ( check_existence( aero_emission_att%var_names, 'emission_category_name' ) ) THEN |
---|
9082 | CALL get_variable( id_salsa, 'emission_category_name', & |
---|
9083 | aero_emission_att%cat_name, aero_emission_att%ncat ) |
---|
9084 | ELSE |
---|
9085 | message_string = 'Missing emission_category_name in ' // TRIM( input_file_salsa ) |
---|
9086 | CALL message( 'salsa_emission_setup', 'PA0658', 1, 2, 0, 6, 0 ) |
---|
9087 | ENDIF |
---|
9088 | CALL get_variable( id_salsa, 'emission_category_index', aero_emission_att%cat_index ) |
---|
9089 | ! |
---|
9090 | !-- Find corresponding emission categories |
---|
9091 | DO in = 1, aero_emission_att%ncat |
---|
9092 | in_name = aero_emission_att%cat_name(in) |
---|
9093 | DO ss = 1, def_modes%ndc |
---|
9094 | mod_name = def_modes%cat_name_table(ss) |
---|
9095 | IF ( TRIM( in_name(1:4) ) == TRIM( mod_name(1:4 ) ) ) THEN |
---|
9096 | def_modes%cat_input_to_model(ss) = in |
---|
9097 | ENDIF |
---|
9098 | ENDDO |
---|
9099 | ENDDO |
---|
9100 | |
---|
9101 | IF ( SUM( def_modes%cat_input_to_model ) == 0 ) THEN |
---|
9102 | message_string = 'None of the emission categories in ' // TRIM( & |
---|
9103 | input_file_salsa ) // ' match with the ones in the model.' |
---|
9104 | CALL message( 'salsa_emission_setup', 'PA0632', 1, 2, 0, 6, 0 ) |
---|
9105 | ENDIF |
---|
9106 | ! |
---|
9107 | !-- Emission time factors: Find check whether emission time factors are given for each |
---|
9108 | !-- hour of year OR based on month, day and hour |
---|
9109 | ! |
---|
9110 | !-- For each hour of year: |
---|
9111 | IF ( check_existence( aero_emission_att%var_names, 'nhoursyear' ) ) THEN |
---|
9112 | CALL get_dimension_length( id_salsa, aero_emission_att%nhoursyear, 'nhoursyear' ) |
---|
9113 | ALLOCATE( aero_emission_att%etf(1:aero_emission_att%ncat, & |
---|
9114 | 1:aero_emission_att%nhoursyear) ) |
---|
9115 | CALL get_variable( id_salsa, 'emission_time_factors', aero_emission_att%etf, & |
---|
9116 | 0, aero_emission_att%nhoursyear-1, 0, aero_emission_att%ncat-1 ) |
---|
9117 | ! |
---|
9118 | !-- Based on the month, day and hour: |
---|
9119 | ELSEIF ( check_existence( aero_emission_att%var_names, 'nmonthdayhour' ) ) THEN |
---|
9120 | CALL get_dimension_length( id_salsa, aero_emission_att%nmonthdayhour, & |
---|
9121 | 'nmonthdayhour' ) |
---|
9122 | ALLOCATE( aero_emission_att%etf(1:aero_emission_att%ncat, & |
---|
9123 | 1:aero_emission_att%nmonthdayhour) ) |
---|
9124 | CALL get_variable( id_salsa, 'emission_time_factors', aero_emission_att%etf, & |
---|
9125 | 0, aero_emission_att%nmonthdayhour-1, 0, aero_emission_att%ncat-1 ) |
---|
9126 | ELSE |
---|
9127 | message_string = 'emission_time_factors should be given for each nhoursyear ' //& |
---|
9128 | 'OR nmonthdayhour' |
---|
9129 | CALL message( 'salsa_emission_setup','PA0633', 1, 2, 0, 6, 0 ) |
---|
9130 | ENDIF |
---|
9131 | ! |
---|
9132 | !-- Next emission update |
---|
9133 | CALL get_date_time( time_since_reference_point, second_of_day=second_of_day ) |
---|
9134 | next_aero_emission_update = MOD( second_of_day, seconds_per_hour ) !- seconds_per_hour |
---|
9135 | ! |
---|
9136 | !-- Calculate average mass density (kg/m3) |
---|
9137 | aero_emission_att%rho = 0.0_wp |
---|
9138 | |
---|
9139 | IF ( cc_i2m(1) /= 0 ) aero_emission_att%rho = aero_emission_att%rho + arhoh2so4 *& |
---|
9140 | aero_emission%mass_fracs(:,cc_i2m(1)) |
---|
9141 | IF ( cc_i2m(2) /= 0 ) aero_emission_att%rho = aero_emission_att%rho + arhooc * & |
---|
9142 | aero_emission%mass_fracs(:,cc_i2m(2)) |
---|
9143 | IF ( cc_i2m(3) /= 0 ) aero_emission_att%rho = aero_emission_att%rho + arhobc * & |
---|
9144 | aero_emission%mass_fracs(:,cc_i2m(3)) |
---|
9145 | IF ( cc_i2m(4) /= 0 ) aero_emission_att%rho = aero_emission_att%rho + arhodu * & |
---|
9146 | aero_emission%mass_fracs(:,cc_i2m(4)) |
---|
9147 | IF ( cc_i2m(5) /= 0 ) aero_emission_att%rho = aero_emission_att%rho + arhoss * & |
---|
9148 | aero_emission%mass_fracs(:,cc_i2m(5)) |
---|
9149 | IF ( cc_i2m(6) /= 0 ) aero_emission_att%rho = aero_emission_att%rho + arhohno3 * & |
---|
9150 | aero_emission%mass_fracs(:,cc_i2m(6)) |
---|
9151 | IF ( cc_i2m(7) /= 0 ) aero_emission_att%rho = aero_emission_att%rho + arhonh3 * & |
---|
9152 | aero_emission%mass_fracs(:,cc_i2m(7)) |
---|
9153 | ! |
---|
9154 | !-- Allocate and read surface emission data (in total PM, get_variable_3d_real) |
---|
9155 | ALLOCATE( aero_emission%def_data(nys:nyn,nxl:nxr,1:aero_emission_att%ncat) ) |
---|
9156 | CALL get_variable( id_salsa, 'aerosol_emission_values', aero_emission%def_data, & |
---|
9157 | 0, aero_emission_att%ncat-1, nxl, nxr, nys, nyn ) |
---|
9158 | |
---|
9159 | ! |
---|
9160 | !-- Pre-processed mode |
---|
9161 | ELSEIF ( aero_emission_att%lod == 2 ) THEN |
---|
9162 | ! |
---|
9163 | !-- Unit conversion factor: convert to SI units (#/m2/s) |
---|
9164 | IF ( aero_emission_att%units == '#/m2/s' ) THEN |
---|
9165 | aero_emission_att%conversion_factor = 1.0_wp |
---|
9166 | ELSE |
---|
9167 | message_string = 'unknown unit for aerosol emissions: ' // & |
---|
9168 | TRIM( aero_emission_att%units ) |
---|
9169 | CALL message( 'salsa_emission_setup','PA0634', 1, 2, 0, 6, 0 ) |
---|
9170 | ENDIF |
---|
9171 | ! |
---|
9172 | !-- Number of aerosol size bins in the emission data |
---|
9173 | CALL get_dimension_length( id_salsa, aero_emission_att%nbins, 'Dmid' ) |
---|
9174 | IF ( aero_emission_att%nbins /= nbins_aerosol ) THEN |
---|
9175 | message_string = 'The number of size bins in aerosol input data does not ' // & |
---|
9176 | 'correspond to the model set-up' |
---|
9177 | CALL message( 'salsa_emission_setup','PA0635', 1, 2, 0, 6, 0 ) |
---|
9178 | ENDIF |
---|
9179 | ! |
---|
9180 | !-- Number of time steps in the emission data |
---|
9181 | CALL get_dimension_length( id_salsa, aero_emission_att%nt, 'time') |
---|
9182 | ! |
---|
9183 | !-- Allocate bin diameters, time and mass fraction array |
---|
9184 | ALLOCATE( aero_emission_att%dmid(1:nbins_aerosol), & |
---|
9185 | aero_emission_att%time(0:aero_emission_att%nt-1), & |
---|
9186 | aero_emission%num_fracs(1:aero_emission_att%ncat,1:nbins_aerosol) ) |
---|
9187 | ! |
---|
9188 | !-- Read mean diameters |
---|
9189 | CALL get_variable( id_salsa, 'Dmid', aero_emission_att%dmid ) |
---|
9190 | ! |
---|
9191 | !-- Check whether the sectional representation of the aerosol size distribution conform |
---|
9192 | !-- to the one applied in the model |
---|
9193 | IF ( ANY( ABS( ( aero(1:nbins_aerosol)%dmid - aero_emission_att%dmid ) / & |
---|
9194 | aero(1:nbins_aerosol)%dmid ) > 0.1_wp ) ) THEN |
---|
9195 | message_string = 'Mean diameters of size bins in ' // TRIM( input_file_salsa ) & |
---|
9196 | // ' do not match with the ones in the model.' |
---|
9197 | CALL message( 'salsa_emission_setup','PA0636', 1, 2, 0, 6, 0 ) |
---|
9198 | ENDIF |
---|
9199 | ! |
---|
9200 | !-- Read time stamps: |
---|
9201 | IF ( check_existence( aero_emission_att%var_names, 'time' ) ) THEN |
---|
9202 | CALL get_variable( id_salsa, 'time', aero_emission_att%time ) |
---|
9203 | ELSE |
---|
9204 | message_string = 'Missing time in ' // TRIM( input_file_salsa ) |
---|
9205 | CALL message( 'salsa_emission_setup', 'PA0660', 1, 2, 0, 6, 0 ) |
---|
9206 | ENDIF |
---|
9207 | ! |
---|
9208 | !-- Check if the provided data covers the entire simulation. The spinup time is added |
---|
9209 | !-- to the end_time, this must be considered here. |
---|
9210 | IF ( end_time - spinup_time > aero_emission_att%time(aero_emission_att%nt-1) ) THEN |
---|
9211 | message_string = 'end_time of the simulation exceeds the time dimension in ' // & |
---|
9212 | 'the salsa input file.' |
---|
9213 | CALL message( 'salsa_emission_setup', 'PA0692', 1, 2, 0, 6, 0 ) |
---|
9214 | ENDIF |
---|
9215 | ! |
---|
9216 | !-- Read emission number fractions per category |
---|
9217 | IF ( check_existence( aero_emission_att%var_names, 'emission_number_fracs' ) ) THEN |
---|
9218 | CALL get_variable( id_salsa, 'emission_number_fracs', aero_emission%num_fracs, & |
---|
9219 | 0, nbins_aerosol-1, 0, aero_emission_att%ncat-1 ) |
---|
9220 | ELSE |
---|
9221 | message_string = 'Missing emission_number_fracs in ' // TRIM( input_file_salsa ) |
---|
9222 | CALL message( 'salsa_emission_setup', 'PA0694', 1, 2, 0, 6, 0 ) |
---|
9223 | ENDIF |
---|
9224 | |
---|
9225 | ELSE |
---|
9226 | message_string = 'Unknown lod for aerosol_emission_values.' |
---|
9227 | CALL message( 'salsa_emission_setup','PA0637', 1, 2, 0, 6, 0 ) |
---|
9228 | |
---|
9229 | ENDIF ! lod |
---|
9230 | |
---|
9231 | ENDIF ! init |
---|
9232 | ! |
---|
9233 | !-- Define and set current emission values: |
---|
9234 | ! |
---|
9235 | !-- Default type emissions (aerosol emission given as total mass emission per year): |
---|
9236 | IF ( aero_emission_att%lod == 1 ) THEN |
---|
9237 | ! |
---|
9238 | !-- Emission time factors for each emission category at current time step |
---|
9239 | IF ( aero_emission_att%nhoursyear > aero_emission_att%nmonthdayhour ) THEN |
---|
9240 | ! |
---|
9241 | !-- Get the index of the current hour |
---|
9242 | CALL get_date_time( MAX( 0.0_wp, time_since_reference_point ), & |
---|
9243 | day_of_year=day_of_year, hour=hour_of_day ) |
---|
9244 | index_hh = ( day_of_year - 1_iwp ) * hours_per_day + hour_of_day |
---|
9245 | aero_emission_att%time_factor = aero_emission_att%etf(:,index_hh+1) |
---|
9246 | |
---|
9247 | ELSEIF ( aero_emission_att%nhoursyear < aero_emission_att%nmonthdayhour ) THEN |
---|
9248 | ! |
---|
9249 | !-- Get the index of current hour (index_hh) (TODO: Now "workday" is always assumed. |
---|
9250 | !-- Needs to be calculated.) |
---|
9251 | CALL get_date_time( MAX( 0.0_wp, time_since_reference_point ), month=month_of_year,& |
---|
9252 | day=day_of_month, hour=hour_of_day, day_of_week=day_of_week ) |
---|
9253 | index_mm = month_of_year |
---|
9254 | index_dd = months_per_year + day_of_week |
---|
9255 | SELECT CASE(TRIM(daytype)) |
---|
9256 | |
---|
9257 | CASE ("workday") |
---|
9258 | index_hh = months_per_year + days_per_week + hour_of_day |
---|
9259 | |
---|
9260 | CASE ("weekend") |
---|
9261 | index_hh = months_per_year + days_per_week + hours_per_day + hour_of_day |
---|
9262 | |
---|
9263 | CASE ("holiday") |
---|
9264 | index_hh = months_per_year + days_per_week + 2*hours_per_day + hour_of_day |
---|
9265 | |
---|
9266 | END SELECT |
---|
9267 | aero_emission_att%time_factor = aero_emission_att%etf(:,index_mm) * & |
---|
9268 | aero_emission_att%etf(:,index_dd) * & |
---|
9269 | aero_emission_att%etf(:,index_hh+1) |
---|
9270 | ENDIF |
---|
9271 | |
---|
9272 | ! |
---|
9273 | !-- Create a sectional number size distribution for emissions |
---|
9274 | ALLOCATE( nsect_emission(1:nbins_aerosol),source_array(nys:nyn,nxl:nxr,1:nbins_aerosol) ) |
---|
9275 | DO in = 1, aero_emission_att%ncat |
---|
9276 | |
---|
9277 | inn = def_modes%cat_input_to_model(in) |
---|
9278 | ! |
---|
9279 | !-- Calculate the number concentration (1/m3) of a log-normal size distribution |
---|
9280 | !-- following Jacobson (2005): Eq 13.25. |
---|
9281 | def_modes%ntot_table = 6.0_wp * def_modes%pm_frac_table(:,inn) / ( pi * & |
---|
9282 | ( def_modes%dpg_table )**3 * EXP( 4.5_wp * & |
---|
9283 | LOG( def_modes%sigmag_table )**2 ) ) |
---|
9284 | ! |
---|
9285 | !-- Sectional size distibution (1/m3) from a log-normal one |
---|
9286 | CALL size_distribution( def_modes%ntot_table, def_modes%dpg_table, & |
---|
9287 | def_modes%sigmag_table, nsect_emission ) |
---|
9288 | |
---|
9289 | source_array = 0.0_wp |
---|
9290 | DO ib = 1, nbins_aerosol |
---|
9291 | source_array(:,:,ib) = aero_emission%def_data(:,:,in) * & |
---|
9292 | aero_emission_att%conversion_factor / & |
---|
9293 | aero_emission_att%rho(in) * nsect_emission(ib) * & |
---|
9294 | aero_emission_att%time_factor(in) |
---|
9295 | ENDDO |
---|
9296 | ! |
---|
9297 | !-- Set surface fluxes of aerosol number and mass on horizontal surfaces. Set fluxes |
---|
9298 | !-- only for either default, land or urban surface. |
---|
9299 | IF ( .NOT. land_surface .AND. .NOT. urban_surface ) THEN |
---|
9300 | CALL set_flux( surf_def_h(0), aero_emission_att%cc_in2mod, & |
---|
9301 | aero_emission%mass_fracs(in,:), source_array ) |
---|
9302 | ELSE |
---|
9303 | CALL set_flux( surf_usm_h, aero_emission_att%cc_in2mod, & |
---|
9304 | aero_emission%mass_fracs(in,:), source_array ) |
---|
9305 | CALL set_flux( surf_lsm_h, aero_emission_att%cc_in2mod, & |
---|
9306 | aero_emission%mass_fracs(in,:), source_array ) |
---|
9307 | ENDIF |
---|
9308 | ENDDO |
---|
9309 | ! |
---|
9310 | !-- The next emission update is again after one hour |
---|
9311 | next_aero_emission_update = next_aero_emission_update + 3600.0_wp |
---|
9312 | |
---|
9313 | |
---|
9314 | DEALLOCATE( nsect_emission, source_array ) |
---|
9315 | ! |
---|
9316 | !-- Pre-processed: |
---|
9317 | ELSEIF ( aero_emission_att%lod == 2 ) THEN |
---|
9318 | ! |
---|
9319 | !-- Obtain time index for current point in time. |
---|
9320 | aero_emission_att%tind = MINLOC( ABS( aero_emission_att%time - & |
---|
9321 | MAX( time_since_reference_point, 0.0_wp ) ), & |
---|
9322 | DIM = 1 ) - 1 |
---|
9323 | ! |
---|
9324 | !-- Allocate the data input array always before reading in the data and deallocate after |
---|
9325 | ALLOCATE( aero_emission%preproc_data(nys:nyn,nxl:nxr,1:aero_emission_att%ncat), & |
---|
9326 | source_array(nys:nyn,nxl:nxr,1:nbins_aerosol) ) |
---|
9327 | ! |
---|
9328 | !-- Read in the next time step (get_variable_4d_to_3d_real) |
---|
9329 | CALL get_variable( id_salsa, 'aerosol_emission_values', aero_emission%preproc_data, & |
---|
9330 | aero_emission_att%tind, 0, aero_emission_att%ncat-1, & |
---|
9331 | nxl, nxr, nys, nyn ) |
---|
9332 | ! |
---|
9333 | !-- Calculate the sources per category and set surface fluxes |
---|
9334 | source_array = 0.0_wp |
---|
9335 | DO in = 1, aero_emission_att%ncat |
---|
9336 | DO ib = 1, nbins_aerosol |
---|
9337 | source_array(:,:,ib) = aero_emission%preproc_data(:,:,in) * & |
---|
9338 | aero_emission%num_fracs(in,ib) |
---|
9339 | ENDDO |
---|
9340 | ! |
---|
9341 | !-- Set fluxes only for either default, land and urban surface. |
---|
9342 | IF ( .NOT. land_surface .AND. .NOT. urban_surface ) THEN |
---|
9343 | CALL set_flux( surf_def_h(0), aero_emission_att%cc_in2mod, & |
---|
9344 | aero_emission%mass_fracs(in,:), source_array ) |
---|
9345 | ELSE |
---|
9346 | CALL set_flux( surf_usm_h, aero_emission_att%cc_in2mod, & |
---|
9347 | aero_emission%mass_fracs(in,:), source_array ) |
---|
9348 | CALL set_flux( surf_lsm_h, aero_emission_att%cc_in2mod, & |
---|
9349 | aero_emission%mass_fracs(in,:), source_array ) |
---|
9350 | ENDIF |
---|
9351 | ENDDO |
---|
9352 | ! |
---|
9353 | !-- Determine the next emission update |
---|
9354 | next_aero_emission_update = aero_emission_att%time(aero_emission_att%tind+2) |
---|
9355 | |
---|
9356 | DEALLOCATE( aero_emission%preproc_data, source_array ) |
---|
9357 | |
---|
9358 | ENDIF |
---|
9359 | ! |
---|
9360 | !-- Close input file |
---|
9361 | CALL close_input_file( id_salsa ) |
---|
9362 | #else |
---|
9363 | message_string = 'salsa_emission_mode = "read_from_file", but preprocessor directive ' //& |
---|
9364 | ' __netcdf is not used in compiling!' |
---|
9365 | CALL message( 'salsa_emission_setup', 'PA0638', 1, 2, 0, 6, 0 ) |
---|
9366 | |
---|
9367 | #endif |
---|
9368 | CASE DEFAULT |
---|
9369 | message_string = 'unknown salsa_emission_mode: ' // TRIM( salsa_emission_mode ) |
---|
9370 | CALL message( 'salsa_emission_setup', 'PA0639', 1, 2, 0, 6, 0 ) |
---|
9371 | |
---|
9372 | END SELECT |
---|
9373 | |
---|
9374 | CONTAINS |
---|
9375 | |
---|
9376 | !------------------------------------------------------------------------------! |
---|
9377 | ! Description: |
---|
9378 | ! ------------ |
---|
9379 | !> Sets the aerosol flux to aerosol arrays in 2a and 2b. |
---|
9380 | !------------------------------------------------------------------------------! |
---|
9381 | SUBROUTINE set_flux( surface, cc_i_mod, mass_fracs, source_array ) |
---|
9382 | |
---|
9383 | USE arrays_3d, & |
---|
9384 | ONLY: rho_air_zw |
---|
9385 | |
---|
9386 | USE surface_mod, & |
---|
9387 | ONLY: surf_type |
---|
9388 | |
---|
9389 | IMPLICIT NONE |
---|
9390 | |
---|
9391 | INTEGER(iwp) :: i !< loop index |
---|
9392 | INTEGER(iwp) :: ib !< loop index |
---|
9393 | INTEGER(iwp) :: ic !< loop index |
---|
9394 | INTEGER(iwp) :: j !< loop index |
---|
9395 | INTEGER(iwp) :: k !< loop index |
---|
9396 | INTEGER(iwp) :: m !< running index for surface elements |
---|
9397 | |
---|
9398 | INTEGER(iwp), DIMENSION(:) :: cc_i_mod !< index of chemical component in the input data |
---|
9399 | |
---|
9400 | REAL(wp) :: so4_oc !< mass fraction between SO4 and OC in 1a |
---|
9401 | |
---|
9402 | REAL(wp), DIMENSION(:), INTENT(in) :: mass_fracs !< mass fractions of chemical components |
---|
9403 | |
---|
9404 | REAL(wp), DIMENSION(nys:nyn,nxl:nxr,1:nbins_aerosol), INTENT(inout) :: source_array !< |
---|
9405 | |
---|
9406 | TYPE(surf_type), INTENT(inout) :: surface !< respective surface type |
---|
9407 | |
---|
9408 | so4_oc = 0.0_wp |
---|
9409 | |
---|
9410 | DO m = 1, surface%ns |
---|
9411 | ! |
---|
9412 | !-- Get indices of respective grid point |
---|
9413 | i = surface%i(m) |
---|
9414 | j = surface%j(m) |
---|
9415 | k = surface%k(m) |
---|
9416 | |
---|
9417 | DO ib = 1, nbins_aerosol |
---|
9418 | IF ( source_array(j,i,ib) < nclim ) THEN |
---|
9419 | source_array(j,i,ib) = 0.0_wp |
---|
9420 | ENDIF |
---|
9421 | ! |
---|
9422 | !-- Set mass fluxes. First bins include only SO4 and/or OC. |
---|
9423 | IF ( ib <= end_subrange_1a ) THEN |
---|
9424 | ! |
---|
9425 | !-- Both sulphate and organic carbon |
---|
9426 | IF ( index_so4 > 0 .AND. index_oc > 0 ) THEN |
---|
9427 | |
---|
9428 | ic = ( index_so4 - 1 ) * nbins_aerosol + ib |
---|
9429 | so4_oc = mass_fracs(cc_i_mod(1)) / ( mass_fracs(cc_i_mod(1)) + & |
---|
9430 | mass_fracs(cc_i_mod(2)) ) |
---|
9431 | surface%amsws(m,ic) = surface%amsws(m,ic) + so4_oc * source_array(j,i,ib) & |
---|
9432 | * api6 * aero(ib)%dmid**3 * arhoh2so4 * rho_air_zw(k-1) |
---|
9433 | aerosol_mass(ic)%source(j,i) = aerosol_mass(ic)%source(j,i) + surface%amsws(m,ic) |
---|
9434 | |
---|
9435 | ic = ( index_oc - 1 ) * nbins_aerosol + ib |
---|
9436 | surface%amsws(m,ic) = surface%amsws(m,ic) + ( 1-so4_oc ) * source_array(j,i,ib) & |
---|
9437 | * api6 * aero(ib)%dmid**3 * arhooc * rho_air_zw(k-1) |
---|
9438 | aerosol_mass(ic)%source(j,i) = aerosol_mass(ic)%source(j,i) + surface%amsws(m,ic) |
---|
9439 | ! |
---|
9440 | !-- Only sulphates |
---|
9441 | ELSEIF ( index_so4 > 0 .AND. index_oc < 0 ) THEN |
---|
9442 | ic = ( index_so4 - 1 ) * nbins_aerosol + ib |
---|
9443 | surface%amsws(m,ic) = surface%amsws(m,ic) + source_array(j,i,ib) * api6 * & |
---|
9444 | aero(ib)%dmid**3 * arhoh2so4 * rho_air_zw(k-1) |
---|
9445 | aerosol_mass(ic)%source(j,i) = aerosol_mass(ic)%source(j,i) + surface%amsws(m,ic) |
---|
9446 | ! |
---|
9447 | !-- Only organic carbon |
---|
9448 | ELSEIF ( index_so4 < 0 .AND. index_oc > 0 ) THEN |
---|
9449 | ic = ( index_oc - 1 ) * nbins_aerosol + ib |
---|
9450 | surface%amsws(m,ic) = surface%amsws(m,ic) + source_array(j,i,ib) * api6 * & |
---|
9451 | aero(ib)%dmid**3 * arhooc * rho_air_zw(k-1) |
---|
9452 | aerosol_mass(ic)%source(j,i) = aerosol_mass(ic)%source(j,i) + surface%amsws(m,ic) |
---|
9453 | ENDIF |
---|
9454 | |
---|
9455 | ELSE |
---|
9456 | ! |
---|
9457 | !-- Sulphate |
---|
9458 | IF ( index_so4 > 0 ) THEN |
---|
9459 | ic = cc_i_mod(1) |
---|
9460 | CALL set_mass_flux( surface, m, ib, index_so4, mass_fracs(ic), arhoh2so4, & |
---|
9461 | source_array(j,i,ib) ) |
---|
9462 | ENDIF |
---|
9463 | ! |
---|
9464 | !-- Organic carbon |
---|
9465 | IF ( index_oc > 0 ) THEN |
---|
9466 | ic = cc_i_mod(2) |
---|
9467 | CALL set_mass_flux( surface, m, ib, index_oc, mass_fracs(ic),arhooc, & |
---|
9468 | source_array(j,i,ib) ) |
---|
9469 | ENDIF |
---|
9470 | ! |
---|
9471 | !-- Black carbon |
---|
9472 | IF ( index_bc > 0 ) THEN |
---|
9473 | ic = cc_i_mod(3) |
---|
9474 | CALL set_mass_flux( surface, m, ib, index_bc, mass_fracs(ic), arhobc, & |
---|
9475 | source_array(j,i,ib) ) |
---|
9476 | ENDIF |
---|
9477 | ! |
---|
9478 | !-- Dust |
---|
9479 | IF ( index_du > 0 ) THEN |
---|
9480 | ic = cc_i_mod(4) |
---|
9481 | CALL set_mass_flux( surface, m, ib, index_du, mass_fracs(ic), arhodu, & |
---|
9482 | source_array(j,i,ib) ) |
---|
9483 | ENDIF |
---|
9484 | ! |
---|
9485 | !-- Sea salt |
---|
9486 | IF ( index_ss > 0 ) THEN |
---|
9487 | ic = cc_i_mod(5) |
---|
9488 | CALL set_mass_flux( surface, m, ib, index_ss, mass_fracs(ic), arhoss, & |
---|
9489 | source_array(j,i,ib) ) |
---|
9490 | ENDIF |
---|
9491 | ! |
---|
9492 | !-- Nitric acid |
---|
9493 | IF ( index_no > 0 ) THEN |
---|
9494 | ic = cc_i_mod(6) |
---|
9495 | CALL set_mass_flux( surface, m, ib, index_no, mass_fracs(ic), arhohno3, & |
---|
9496 | source_array(j,i,ib) ) |
---|
9497 | ENDIF |
---|
9498 | ! |
---|
9499 | !-- Ammonia |
---|
9500 | IF ( index_nh > 0 ) THEN |
---|
9501 | ic = cc_i_mod(7) |
---|
9502 | CALL set_mass_flux( surface, m, ib, index_nh, mass_fracs(ic), arhonh3, & |
---|
9503 | source_array(j,i,ib) ) |
---|
9504 | ENDIF |
---|
9505 | |
---|
9506 | ENDIF |
---|
9507 | ! |
---|
9508 | !-- Save number fluxes in the end |
---|
9509 | surface%answs(m,ib) = surface%answs(m,ib) + source_array(j,i,ib) * rho_air_zw(k-1) |
---|
9510 | aerosol_number(ib)%source(j,i) = surface%answs(m,ib) |
---|
9511 | |
---|
9512 | ENDDO ! ib |
---|
9513 | ENDDO ! m |
---|
9514 | |
---|
9515 | END SUBROUTINE set_flux |
---|
9516 | |
---|
9517 | !------------------------------------------------------------------------------! |
---|
9518 | ! Description: |
---|
9519 | ! ------------ |
---|
9520 | !> Sets the mass emissions to aerosol arrays in 2a and 2b. |
---|
9521 | !------------------------------------------------------------------------------! |
---|
9522 | SUBROUTINE set_mass_flux( surface, surf_num, ib, ispec, mass_frac, prho, nsource ) |
---|
9523 | |
---|
9524 | USE arrays_3d, & |
---|
9525 | ONLY: rho_air_zw |
---|
9526 | |
---|
9527 | USE surface_mod, & |
---|
9528 | ONLY: surf_type |
---|
9529 | |
---|
9530 | IMPLICIT NONE |
---|
9531 | |
---|
9532 | INTEGER(iwp) :: i !< loop index |
---|
9533 | INTEGER(iwp) :: j !< loop index |
---|
9534 | INTEGER(iwp) :: k !< loop index |
---|
9535 | INTEGER(iwp) :: ic !< loop index |
---|
9536 | |
---|
9537 | INTEGER(iwp), INTENT(in) :: ib !< Aerosol size bin index |
---|
9538 | INTEGER(iwp), INTENT(in) :: ispec !< Aerosol species index |
---|
9539 | INTEGER(iwp), INTENT(in) :: surf_num !< index surface elements |
---|
9540 | |
---|
9541 | REAL(wp), INTENT(in) :: mass_frac !< mass fraction of a chemical compound in all bins |
---|
9542 | REAL(wp), INTENT(in) :: nsource !< number source (#/m2/s) |
---|
9543 | REAL(wp), INTENT(in) :: prho !< Aerosol density |
---|
9544 | |
---|
9545 | TYPE(surf_type), INTENT(inout) :: surface !< respective surface type |
---|
9546 | ! |
---|
9547 | !-- Get indices of respective grid point |
---|
9548 | i = surface%i(surf_num) |
---|
9549 | j = surface%j(surf_num) |
---|
9550 | k = surface%k(surf_num) |
---|
9551 | ! |
---|
9552 | !-- Subrange 2a: |
---|
9553 | ic = ( ispec - 1 ) * nbins_aerosol + ib |
---|
9554 | surface%amsws(surf_num,ic) = surface%amsws(surf_num,ic) + mass_frac * nsource * & |
---|
9555 | aero(ib)%core * prho * rho_air_zw(k-1) |
---|
9556 | aerosol_mass(ic)%source(j,i) = surface%amsws(surf_num,ic) |
---|
9557 | |
---|
9558 | END SUBROUTINE set_mass_flux |
---|
9559 | |
---|
9560 | END SUBROUTINE salsa_emission_setup |
---|
9561 | |
---|
9562 | !------------------------------------------------------------------------------! |
---|
9563 | ! Description: |
---|
9564 | ! ------------ |
---|
9565 | !> Sets the gaseous fluxes |
---|
9566 | !------------------------------------------------------------------------------! |
---|
9567 | SUBROUTINE salsa_gas_emission_setup( init ) |
---|
9568 | |
---|
9569 | USE netcdf_data_input_mod, & |
---|
9570 | ONLY: check_existence, close_input_file, get_attribute, get_variable, & |
---|
9571 | inquire_num_variables, inquire_variable_names, & |
---|
9572 | get_dimension_length, open_read_file |
---|
9573 | |
---|
9574 | USE palm_date_time_mod, & |
---|
9575 | ONLY: days_per_week, get_date_time, hours_per_day, months_per_year, seconds_per_hour |
---|
9576 | |
---|
9577 | USE surface_mod, & |
---|
9578 | ONLY: surf_def_h, surf_lsm_h, surf_usm_h |
---|
9579 | |
---|
9580 | IMPLICIT NONE |
---|
9581 | |
---|
9582 | CHARACTER(LEN=80) :: daytype = 'workday' !< default day type |
---|
9583 | CHARACTER(LEN=25) :: in_name !< name of a gas in the input file |
---|
9584 | |
---|
9585 | CHARACTER(LEN=100), DIMENSION(:), ALLOCATABLE :: var_names !< variable names in input data |
---|
9586 | |
---|
9587 | |
---|
9588 | INTEGER(iwp) :: day_of_month !< day of the month |
---|
9589 | INTEGER(iwp) :: day_of_week !< day of the week |
---|
9590 | INTEGER(iwp) :: day_of_year !< day of the year |
---|
9591 | INTEGER(iwp) :: hour_of_day !< hour of the day |
---|
9592 | INTEGER(iwp) :: id_chem !< NetCDF id of chemistry emission file |
---|
9593 | INTEGER(iwp) :: i !< loop index |
---|
9594 | INTEGER(iwp) :: ig !< loop index |
---|
9595 | INTEGER(iwp) :: in !< running index for emission categories |
---|
9596 | INTEGER(iwp) :: index_dd !< index day |
---|
9597 | INTEGER(iwp) :: index_hh !< index hour |
---|
9598 | INTEGER(iwp) :: index_mm !< index month |
---|
9599 | INTEGER(iwp) :: j !< loop index |
---|
9600 | INTEGER(iwp) :: month_of_year !< month of the year |
---|
9601 | INTEGER(iwp) :: num_vars !< number of variables |
---|
9602 | |
---|
9603 | LOGICAL :: netcdf_extend = .FALSE. !< NetCDF input file exists |
---|
9604 | |
---|
9605 | LOGICAL, INTENT(in) :: init !< if .TRUE. --> initialisation call |
---|
9606 | |
---|
9607 | REAL(wp) :: second_of_day !< second of the day |
---|
9608 | |
---|
9609 | REAL(wp), DIMENSION(:), ALLOCATABLE :: time_factor !< emission time factor |
---|
9610 | |
---|
9611 | REAL(wp), DIMENSION(:,:,:), ALLOCATABLE :: dum_var_3d !< |
---|
9612 | |
---|
9613 | REAL(wp), DIMENSION(:,:,:,:,:), ALLOCATABLE :: dum_var_5d !< |
---|
9614 | |
---|
9615 | ! |
---|
9616 | !-- Reset surface fluxes |
---|
9617 | surf_def_h(0)%gtsws = 0.0_wp |
---|
9618 | surf_lsm_h%gtsws = 0.0_wp |
---|
9619 | surf_usm_h%gtsws = 0.0_wp |
---|
9620 | |
---|
9621 | #if defined( __netcdf ) |
---|
9622 | ! |
---|
9623 | !-- Check existence of PIDS_CHEM file |
---|
9624 | INQUIRE( FILE = 'PIDS_CHEM' // TRIM( coupling_char ), EXIST = netcdf_extend ) |
---|
9625 | IF ( .NOT. netcdf_extend ) THEN |
---|
9626 | message_string = 'Input file PIDS_CHEM' // TRIM( coupling_char ) // ' missing!' |
---|
9627 | CALL message( 'salsa_gas_emission_setup', 'PA0640', 1, 2, 0, 6, 0 ) |
---|
9628 | ENDIF |
---|
9629 | ! |
---|
9630 | !-- Open file in read-only mode |
---|
9631 | CALL open_read_file( 'PIDS_CHEM' // TRIM( coupling_char ), id_chem ) |
---|
9632 | |
---|
9633 | IF ( init ) THEN |
---|
9634 | ! |
---|
9635 | !-- Read the index and name of chemical components |
---|
9636 | CALL get_dimension_length( id_chem, chem_emission_att%n_emiss_species, 'nspecies' ) |
---|
9637 | ALLOCATE( chem_emission_att%species_index(1:chem_emission_att%n_emiss_species) ) |
---|
9638 | CALL get_variable( id_chem, 'emission_index', chem_emission_att%species_index ) |
---|
9639 | CALL get_variable( id_chem, 'emission_name', chem_emission_att%species_name, & |
---|
9640 | chem_emission_att%n_emiss_species ) |
---|
9641 | ! |
---|
9642 | !-- Allocate emission data |
---|
9643 | ALLOCATE( chem_emission(1:chem_emission_att%n_emiss_species) ) |
---|
9644 | ! |
---|
9645 | !-- Find the corresponding indices in the model |
---|
9646 | emission_index_chem = 0 |
---|
9647 | DO ig = 1, chem_emission_att%n_emiss_species |
---|
9648 | in_name = chem_emission_att%species_name(ig) |
---|
9649 | SELECT CASE ( TRIM( in_name ) ) |
---|
9650 | CASE ( 'H2SO4', 'h2so4' ) |
---|
9651 | emission_index_chem(1) = ig |
---|
9652 | CASE ( 'HNO3', 'hno3' ) |
---|
9653 | emission_index_chem(2) = ig |
---|
9654 | CASE ( 'NH3', 'nh3' ) |
---|
9655 | emission_index_chem(3) = ig |
---|
9656 | CASE ( 'OCNV', 'ocnv' ) |
---|
9657 | emission_index_chem(4) = ig |
---|
9658 | CASE ( 'OCSV', 'ocsv' ) |
---|
9659 | emission_index_chem(5) = ig |
---|
9660 | END SELECT |
---|
9661 | ENDDO |
---|
9662 | ! |
---|
9663 | !-- Inquire the fill value |
---|
9664 | CALL get_attribute( id_chem, '_FillValue', aero_emission%fill, .FALSE., 'emission_values' ) |
---|
9665 | ! |
---|
9666 | !-- Inquire units of emissions |
---|
9667 | CALL get_attribute( id_chem, 'units', chem_emission_att%units, .FALSE., 'emission_values' ) |
---|
9668 | ! |
---|
9669 | !-- Inquire the level of detail (lod) |
---|
9670 | CALL get_attribute( id_chem, 'lod', lod_gas_emissions, .FALSE., 'emission_values' ) |
---|
9671 | ! |
---|
9672 | !-- Variable names |
---|
9673 | CALL inquire_num_variables( id_chem, num_vars ) |
---|
9674 | ALLOCATE( var_names(1:num_vars) ) |
---|
9675 | CALL inquire_variable_names( id_chem, var_names ) |
---|
9676 | ! |
---|
9677 | !-- Default mode: as total emissions per year |
---|
9678 | IF ( lod_gas_emissions == 1 ) THEN |
---|
9679 | |
---|
9680 | ! |
---|
9681 | !-- Get number of emission categories and allocate emission arrays |
---|
9682 | CALL get_dimension_length( id_chem, chem_emission_att%ncat, 'ncat' ) |
---|
9683 | ALLOCATE( chem_emission_att%cat_index(1:chem_emission_att%ncat), & |
---|
9684 | time_factor(1:chem_emission_att%ncat) ) |
---|
9685 | ! |
---|
9686 | !-- Get emission category names and indices |
---|
9687 | CALL get_variable( id_chem, 'emission_category_name', chem_emission_att%cat_name, & |
---|
9688 | chem_emission_att%ncat) |
---|
9689 | CALL get_variable( id_chem, 'emission_category_index', chem_emission_att%cat_index ) |
---|
9690 | ! |
---|
9691 | !-- Emission time factors: Find check whether emission time factors are given for each hour |
---|
9692 | !-- of year OR based on month, day and hour |
---|
9693 | ! |
---|
9694 | !-- For each hour of year: |
---|
9695 | IF ( check_existence( var_names, 'nhoursyear' ) ) THEN |
---|
9696 | CALL get_dimension_length( id_chem, chem_emission_att%nhoursyear, 'nhoursyear' ) |
---|
9697 | ALLOCATE( chem_emission_att%hourly_emis_time_factor(1:chem_emission_att%ncat, & |
---|
9698 | 1:chem_emission_att%nhoursyear) ) |
---|
9699 | CALL get_variable( id_chem, 'emission_time_factors', & |
---|
9700 | chem_emission_att%hourly_emis_time_factor, & |
---|
9701 | 0, chem_emission_att%nhoursyear-1, 0, chem_emission_att%ncat-1 ) |
---|
9702 | ! |
---|
9703 | !-- Based on the month, day and hour: |
---|
9704 | ELSEIF ( check_existence( var_names, 'nmonthdayhour' ) ) THEN |
---|
9705 | CALL get_dimension_length( id_chem, chem_emission_att%nmonthdayhour, 'nmonthdayhour' ) |
---|
9706 | ALLOCATE( chem_emission_att%mdh_emis_time_factor(1:chem_emission_att%ncat, & |
---|
9707 | 1:chem_emission_att%nmonthdayhour) ) |
---|
9708 | CALL get_variable( id_chem, 'emission_time_factors', & |
---|
9709 | chem_emission_att%mdh_emis_time_factor, & |
---|
9710 | 0, chem_emission_att%nmonthdayhour-1, 0, chem_emission_att%ncat-1 ) |
---|
9711 | ELSE |
---|
9712 | message_string = 'emission_time_factors should be given for each nhoursyear OR ' // & |
---|
9713 | 'nmonthdayhour' |
---|
9714 | CALL message( 'salsa_gas_emission_setup','PA0641', 1, 2, 0, 6, 0 ) |
---|
9715 | ENDIF |
---|
9716 | ! |
---|
9717 | !-- Next emission update |
---|
9718 | CALL get_date_time( time_since_reference_point, second_of_day=second_of_day ) |
---|
9719 | next_gas_emission_update = MOD( second_of_day, seconds_per_hour ) !- seconds_per_hour |
---|
9720 | ! |
---|
9721 | !-- Allocate and read surface emission data (in total PM) (NOTE that "preprocessed" input data |
---|
9722 | !-- array is applied now here) |
---|
9723 | ALLOCATE( dum_var_5d(1,nys:nyn,nxl:nxr,1:chem_emission_att%n_emiss_species, & |
---|
9724 | 1:chem_emission_att%ncat) ) |
---|
9725 | CALL get_variable( id_chem, 'emission_values', dum_var_5d, 0, chem_emission_att%ncat-1, & |
---|
9726 | 0, chem_emission_att%n_emiss_species-1, nxl, nxr, nys, nyn, 0, 0 ) |
---|
9727 | DO ig = 1, chem_emission_att%n_emiss_species |
---|
9728 | ALLOCATE( chem_emission(ig)%default_emission_data(nys:nyn,nxl:nxr, & |
---|
9729 | 1:chem_emission_att%ncat) ) |
---|
9730 | DO in = 1, chem_emission_att%ncat |
---|
9731 | DO i = nxl, nxr |
---|
9732 | DO j = nys, nyn |
---|
9733 | chem_emission(ig)%default_emission_data(j,i,in) = dum_var_5d(1,j,i,ig,in) |
---|
9734 | ENDDO |
---|
9735 | ENDDO |
---|
9736 | ENDDO |
---|
9737 | ENDDO |
---|
9738 | DEALLOCATE( dum_var_5d ) |
---|
9739 | ! |
---|
9740 | !-- Pre-processed mode: |
---|
9741 | ELSEIF ( lod_gas_emissions == 2 ) THEN |
---|
9742 | ! |
---|
9743 | !-- Number of time steps in the emission data |
---|
9744 | CALL get_dimension_length( id_chem, chem_emission_att%dt_emission, 'time' ) |
---|
9745 | ! |
---|
9746 | !-- Allocate and read time |
---|
9747 | ALLOCATE( gas_emission_time(1:chem_emission_att%dt_emission) ) |
---|
9748 | CALL get_variable( id_chem, 'time', gas_emission_time ) |
---|
9749 | ELSE |
---|
9750 | message_string = 'Unknown lod for emission_values.' |
---|
9751 | CALL message( 'salsa_gas_emission_setup','PA0642', 1, 2, 0, 6, 0 ) |
---|
9752 | ENDIF ! lod |
---|
9753 | |
---|
9754 | ENDIF ! init |
---|
9755 | ! |
---|
9756 | !-- Define and set current emission values: |
---|
9757 | |
---|
9758 | IF ( lod_gas_emissions == 1 ) THEN |
---|
9759 | ! |
---|
9760 | !-- Emission time factors for each emission category at current time step |
---|
9761 | IF ( chem_emission_att%nhoursyear > chem_emission_att%nmonthdayhour ) THEN |
---|
9762 | ! |
---|
9763 | !-- Get the index of the current hour |
---|
9764 | CALL get_date_time( time_since_reference_point, & |
---|
9765 | day_of_year=day_of_year, hour=hour_of_day ) |
---|
9766 | index_hh = ( day_of_year - 1_iwp ) * hours_per_day + hour_of_day |
---|
9767 | IF ( .NOT. ALLOCATED( time_factor ) ) ALLOCATE( time_factor(1:chem_emission_att%ncat) ) |
---|
9768 | time_factor = 0.0_wp |
---|
9769 | time_factor = chem_emission_att%hourly_emis_time_factor(:,index_hh+1) |
---|
9770 | |
---|
9771 | ELSEIF ( chem_emission_att%nhoursyear < chem_emission_att%nmonthdayhour ) THEN |
---|
9772 | ! |
---|
9773 | !-- Get the index of current hour (index_hh) (TODO: Now "workday" is always assumed. |
---|
9774 | !-- Needs to be calculated.) |
---|
9775 | CALL get_date_time( time_since_reference_point, & |
---|
9776 | month=month_of_year, & |
---|
9777 | day=day_of_month, & |
---|
9778 | hour=hour_of_day, & |
---|
9779 | day_of_week=day_of_week ) |
---|
9780 | index_mm = month_of_year |
---|
9781 | index_dd = months_per_year + day_of_week |
---|
9782 | SELECT CASE( TRIM( daytype ) ) |
---|
9783 | |
---|
9784 | CASE ("workday") |
---|
9785 | index_hh = months_per_year + days_per_week + hour_of_day |
---|
9786 | |
---|
9787 | CASE ("weekend") |
---|
9788 | index_hh = months_per_year + days_per_week + hours_per_day + hour_of_day |
---|
9789 | |
---|
9790 | CASE ("holiday") |
---|
9791 | index_hh = months_per_year + days_per_week + 2*hours_per_day + hour_of_day |
---|
9792 | |
---|
9793 | END SELECT |
---|
9794 | time_factor = chem_emission_att%mdh_emis_time_factor(:,index_mm) * & |
---|
9795 | chem_emission_att%mdh_emis_time_factor(:,index_dd) * & |
---|
9796 | chem_emission_att%mdh_emis_time_factor(:,index_hh+1) |
---|
9797 | ENDIF |
---|
9798 | ! |
---|
9799 | !-- Set gas emissions for each emission category |
---|
9800 | ALLOCATE( dum_var_3d(nys:nyn,nxl:nxr,1:chem_emission_att%n_emiss_species) ) |
---|
9801 | |
---|
9802 | DO in = 1, chem_emission_att%ncat |
---|
9803 | DO ig = 1, chem_emission_att%n_emiss_species |
---|
9804 | dum_var_3d(:,:,ig) = chem_emission(ig)%default_emission_data(:,:,in) |
---|
9805 | ENDDO |
---|
9806 | ! |
---|
9807 | !-- Set surface fluxes only for either default, land or urban surface |
---|
9808 | IF ( .NOT. land_surface .AND. .NOT. urban_surface ) THEN |
---|
9809 | CALL set_gas_flux( surf_def_h(0), emission_index_chem, chem_emission_att%units, & |
---|
9810 | dum_var_3d, time_factor(in) ) |
---|
9811 | ELSE |
---|
9812 | CALL set_gas_flux( surf_usm_h, emission_index_chem, chem_emission_att%units, & |
---|
9813 | dum_var_3d, time_factor(in) ) |
---|
9814 | CALL set_gas_flux( surf_lsm_h, emission_index_chem, chem_emission_att%units, & |
---|
9815 | dum_var_3d, time_factor(in) ) |
---|
9816 | ENDIF |
---|
9817 | ENDDO |
---|
9818 | DEALLOCATE( dum_var_3d ) |
---|
9819 | ! |
---|
9820 | !-- The next emission update is again after one hour |
---|
9821 | next_gas_emission_update = next_gas_emission_update + 3600.0_wp |
---|
9822 | |
---|
9823 | ELSEIF ( lod_gas_emissions == 2 ) THEN |
---|
9824 | ! |
---|
9825 | !-- Obtain time index for current point in time. |
---|
9826 | chem_emission_att%i_hour = MINLOC( ABS( gas_emission_time - & |
---|
9827 | MAX( time_since_reference_point, 0.0_wp ) ), DIM = 1 ) - 1 |
---|
9828 | ! |
---|
9829 | !-- Allocate the data input array always before reading in the data and deallocate after (NOTE |
---|
9830 | !-- that "preprocessed" input data array is applied now here) |
---|
9831 | ALLOCATE( dum_var_5d(1,1,nys:nyn,nxl:nxr,1:chem_emission_att%n_emiss_species) ) |
---|
9832 | ! |
---|
9833 | !-- Read in the next time step |
---|
9834 | CALL get_variable( id_chem, 'emission_values', dum_var_5d, & |
---|
9835 | 0, chem_emission_att%n_emiss_species-1, nxl, nxr, nys, nyn, 0, 0, & |
---|
9836 | chem_emission_att%i_hour, chem_emission_att%i_hour ) |
---|
9837 | ! |
---|
9838 | !-- Set surface fluxes only for either default, land or urban surface |
---|
9839 | IF ( .NOT. land_surface .AND. .NOT. urban_surface ) THEN |
---|
9840 | CALL set_gas_flux( surf_def_h(0), emission_index_chem, chem_emission_att%units, & |
---|
9841 | dum_var_5d(1,1,:,:,:) ) |
---|
9842 | ELSE |
---|
9843 | CALL set_gas_flux( surf_usm_h, emission_index_chem, chem_emission_att%units, & |
---|
9844 | dum_var_5d(1,1,:,:,:) ) |
---|
9845 | CALL set_gas_flux( surf_lsm_h, emission_index_chem, chem_emission_att%units, & |
---|
9846 | dum_var_5d(1,1,:,:,:) ) |
---|
9847 | ENDIF |
---|
9848 | DEALLOCATE ( dum_var_5d ) |
---|
9849 | ! |
---|
9850 | !-- Determine the next emission update |
---|
9851 | next_gas_emission_update = gas_emission_time(chem_emission_att%i_hour+2) |
---|
9852 | |
---|
9853 | ENDIF |
---|
9854 | ! |
---|
9855 | !-- Close input file |
---|
9856 | CALL close_input_file( id_chem ) |
---|
9857 | |
---|
9858 | #else |
---|
9859 | message_string = 'salsa_emission_mode = "read_from_file", but preprocessor directive ' // & |
---|
9860 | ' __netcdf is not used in compiling!' |
---|
9861 | CALL message( 'salsa_gas_emission_setup', 'PA0643', 1, 2, 0, 6, 0 ) |
---|
9862 | |
---|
9863 | #endif |
---|
9864 | |
---|
9865 | CONTAINS |
---|
9866 | !------------------------------------------------------------------------------! |
---|
9867 | ! Description: |
---|
9868 | ! ------------ |
---|
9869 | !> Set gas fluxes for selected type of surfaces |
---|
9870 | !------------------------------------------------------------------------------! |
---|
9871 | SUBROUTINE set_gas_flux( surface, cc_i_mod, unit, source_array, time_fac ) |
---|
9872 | |
---|
9873 | USE arrays_3d, & |
---|
9874 | ONLY: dzw, hyp, pt, rho_air_zw |
---|
9875 | |
---|
9876 | USE grid_variables, & |
---|
9877 | ONLY: dx, dy |
---|
9878 | |
---|
9879 | USE surface_mod, & |
---|
9880 | ONLY: surf_type |
---|
9881 | |
---|
9882 | IMPLICIT NONE |
---|
9883 | |
---|
9884 | CHARACTER(LEN=*), INTENT(in) :: unit !< flux unit in the input file |
---|
9885 | |
---|
9886 | INTEGER(iwp) :: ig !< running index for gases |
---|
9887 | INTEGER(iwp) :: i !< loop index |
---|
9888 | INTEGER(iwp) :: j !< loop index |
---|
9889 | INTEGER(iwp) :: k !< loop index |
---|
9890 | INTEGER(iwp) :: m !< running index for surface elements |
---|
9891 | |
---|
9892 | INTEGER(iwp), DIMENSION(:) :: cc_i_mod !< index of different gases in the input data |
---|
9893 | |
---|
9894 | LOGICAL :: use_time_fac !< .TRUE. is time_fac present |
---|
9895 | |
---|
9896 | REAL(wp), OPTIONAL :: time_fac !< emission time factor |
---|
9897 | |
---|
9898 | REAL(wp), DIMENSION(ngases_salsa) :: conv !< unit conversion factor |
---|
9899 | |
---|
9900 | REAL(wp), DIMENSION(nys:nyn,nxl:nxr,1:chem_emission_att%n_emiss_species), INTENT(in) :: source_array !< |
---|
9901 | |
---|
9902 | TYPE(surf_type), INTENT(inout) :: surface !< respective surface type |
---|
9903 | |
---|
9904 | conv = 1.0_wp |
---|
9905 | use_time_fac = PRESENT( time_fac ) |
---|
9906 | |
---|
9907 | DO m = 1, surface%ns |
---|
9908 | ! |
---|
9909 | !-- Get indices of respective grid point |
---|
9910 | i = surface%i(m) |
---|
9911 | j = surface%j(m) |
---|
9912 | k = surface%k(m) |
---|
9913 | ! |
---|
9914 | !-- Unit conversion factor: convert to SI units (#/m2/s) |
---|
9915 | SELECT CASE ( TRIM( unit ) ) |
---|
9916 | CASE ( 'kg/m2/yr' ) |
---|
9917 | conv(1) = avo / ( amh2so4 * 3600.0_wp ) |
---|
9918 | conv(2) = avo / ( amhno3 * 3600.0_wp ) |
---|
9919 | conv(3) = avo / ( amnh3 * 3600.0_wp ) |
---|
9920 | conv(4) = avo / ( amoc * 3600.0_wp ) |
---|
9921 | conv(5) = avo / ( amoc * 3600.0_wp ) |
---|
9922 | CASE ( 'g/m2/yr' ) |
---|
9923 | conv(1) = avo / ( amh2so4 * 3.6E+6_wp ) |
---|
9924 | conv(2) = avo / ( amhno3 * 3.6E+6_wp ) |
---|
9925 | conv(3) = avo / ( amnh3 * 3.6E+6_wp ) |
---|
9926 | conv(4) = avo / ( amoc * 3.6E+6_wp ) |
---|
9927 | conv(5) = avo / ( amoc * 3.6E+6_wp ) |
---|
9928 | CASE ( 'g/m2/s' ) |
---|
9929 | conv(1) = avo / ( amh2so4 * 1000.0_wp ) |
---|
9930 | conv(2) = avo / ( amhno3 * 1000.0_wp ) |
---|
9931 | conv(3) = avo / ( amnh3 * 1000.0_wp ) |
---|
9932 | conv(4) = avo / ( amoc * 1000.0_wp ) |
---|
9933 | conv(5) = avo / ( amoc * 1000.0_wp ) |
---|
9934 | CASE ( '#/m2/s' ) |
---|
9935 | conv = 1.0_wp |
---|
9936 | CASE ( 'ppm/m2/s' ) |
---|
9937 | conv = for_ppm_to_nconc * hyp(k) / pt(k,j,i) * ( 1.0E5_wp / hyp(k) )**0.286_wp * & |
---|
9938 | dx * dy * dzw(k) |
---|
9939 | CASE ( 'mumol/m2/s' ) |
---|
9940 | conv = 1.0E-6_wp * avo |
---|
9941 | CASE DEFAULT |
---|
9942 | message_string = 'unknown unit for gas emissions: ' // TRIM( chem_emission_att%units ) |
---|
9943 | CALL message( 'set_gas_flux','PA0644', 1, 2, 0, 6, 0 ) |
---|
9944 | |
---|
9945 | END SELECT |
---|
9946 | |
---|
9947 | DO ig = 1, ngases_salsa |
---|
9948 | IF ( use_time_fac ) THEN |
---|
9949 | surface%gtsws(m,ig) = surface%gtsws(m,ig) + rho_air_zw(k-1) * conv(ig) * time_fac & |
---|
9950 | * MAX( 0.0_wp, source_array(j,i,cc_i_mod(ig) ) ) |
---|
9951 | ELSE |
---|
9952 | surface%gtsws(m,ig) = surface%gtsws(m,ig) + rho_air_zw(k-1) * conv(ig) & |
---|
9953 | * MAX( 0.0_wp, source_array(j,i,cc_i_mod(ig) ) ) |
---|
9954 | ENDIF |
---|
9955 | ENDDO ! ig |
---|
9956 | |
---|
9957 | ENDDO ! m |
---|
9958 | |
---|
9959 | END SUBROUTINE set_gas_flux |
---|
9960 | |
---|
9961 | END SUBROUTINE salsa_gas_emission_setup |
---|
9962 | |
---|
9963 | !------------------------------------------------------------------------------! |
---|
9964 | ! Description: |
---|
9965 | ! ------------ |
---|
9966 | !> Check data output for salsa. |
---|
9967 | !------------------------------------------------------------------------------! |
---|
9968 | SUBROUTINE salsa_check_data_output( var, unit ) |
---|
9969 | |
---|
9970 | IMPLICIT NONE |
---|
9971 | |
---|
9972 | CHARACTER(LEN=*) :: unit !< |
---|
9973 | CHARACTER(LEN=*) :: var !< |
---|
9974 | |
---|
9975 | INTEGER(iwp) :: char_to_int !< for converting character to integer |
---|
9976 | |
---|
9977 | IF ( var(1:6) /= 'salsa_' ) THEN |
---|
9978 | unit = 'illegal' |
---|
9979 | RETURN |
---|
9980 | ENDIF |
---|
9981 | ! |
---|
9982 | !-- Treat bin-specific outputs separately |
---|
9983 | IF ( var(7:11) == 'N_bin' ) THEN |
---|
9984 | READ( var(12:),* ) char_to_int |
---|
9985 | IF ( char_to_int >= 1 .AND. char_to_int <= SUM( nbin ) ) THEN |
---|
9986 | unit = '#/m3' |
---|
9987 | ELSE |
---|
9988 | unit = 'illegal' |
---|
9989 | RETURN |
---|
9990 | ENDIF |
---|
9991 | |
---|
9992 | ELSEIF ( var(7:11) == 'm_bin' ) THEN |
---|
9993 | READ( var(12:),* ) char_to_int |
---|
9994 | IF ( char_to_int >= 1 .AND. char_to_int <= SUM( nbin ) ) THEN |
---|
9995 | unit = 'kg/m3' |
---|
9996 | ELSE |
---|
9997 | unit = 'illegal' |
---|
9998 | RETURN |
---|
9999 | ENDIF |
---|
10000 | |
---|
10001 | ELSEIF ( var(7:11) == 's_H2O' ) THEN |
---|
10002 | IF ( .NOT. advect_particle_water ) THEN |
---|
10003 | message_string = 'to output s_H2O/s_H2O_av requires that advect_particle_water = .T.' |
---|
10004 | CALL message( 'check_parameters', 'PA0707', 1, 2, 0, 6, 0 ) |
---|
10005 | ENDIF |
---|
10006 | |
---|
10007 | ELSE |
---|
10008 | SELECT CASE ( TRIM( var(7:) ) ) |
---|
10009 | |
---|
10010 | CASE ( 'g_H2SO4', 'g_HNO3', 'g_NH3', 'g_OCNV', 'g_OCSV' ) |
---|
10011 | IF ( air_chemistry ) THEN |
---|
10012 | message_string = 'gases are imported from the chemistry module and thus output '// & |
---|
10013 | 'of "' // TRIM( var ) // '" is not allowed' |
---|
10014 | CALL message( 'check_parameters', 'PA0653', 1, 2, 0, 6, 0 ) |
---|
10015 | ENDIF |
---|
10016 | unit = '#/m3' |
---|
10017 | |
---|
10018 | CASE ( 'LDSA' ) |
---|
10019 | unit = 'mum2/cm3' |
---|
10020 | |
---|
10021 | CASE ( 'PM0.1', 'PM2.5', 'PM10', 's_BC', 's_DU', 's_H2O', 's_NH', 's_NO', 's_OC', & |
---|
10022 | 's_SO4', 's_SS' ) |
---|
10023 | unit = 'kg/m3' |
---|
10024 | |
---|
10025 | CASE ( 'N_UFP', 'Ntot' ) |
---|
10026 | unit = '#/m3' |
---|
10027 | |
---|
10028 | CASE DEFAULT |
---|
10029 | unit = 'illegal' |
---|
10030 | |
---|
10031 | END SELECT |
---|
10032 | ENDIF |
---|
10033 | |
---|
10034 | END SUBROUTINE salsa_check_data_output |
---|
10035 | |
---|
10036 | !------------------------------------------------------------------------------! |
---|
10037 | ! Description: |
---|
10038 | ! ------------ |
---|
10039 | !> Check profile data output for salsa. Currently only for diagnostic variables |
---|
10040 | !> Ntot, N_UFP, PM0.1, PM2.5, PM10 and LDSA |
---|
10041 | !------------------------------------------------------------------------------! |
---|
10042 | SUBROUTINE salsa_check_data_output_pr( var, var_count, unit, dopr_unit ) |
---|
10043 | |
---|
10044 | USE arrays_3d, & |
---|
10045 | ONLY: zu |
---|
10046 | |
---|
10047 | USE profil_parameter, & |
---|
10048 | ONLY: dopr_index |
---|
10049 | |
---|
10050 | USE statistics, & |
---|
10051 | ONLY: hom, pr_palm, statistic_regions |
---|
10052 | |
---|
10053 | IMPLICIT NONE |
---|
10054 | |
---|
10055 | CHARACTER(LEN=*) :: dopr_unit !< |
---|
10056 | CHARACTER(LEN=*) :: unit !< |
---|
10057 | CHARACTER(LEN=*) :: var !< |
---|
10058 | |
---|
10059 | INTEGER(iwp) :: var_count !< |
---|
10060 | |
---|
10061 | IF ( var(1:6) /= 'salsa_' ) THEN |
---|
10062 | unit = 'illegal' |
---|
10063 | RETURN |
---|
10064 | ENDIF |
---|
10065 | |
---|
10066 | SELECT CASE ( TRIM( var(7:) ) ) |
---|
10067 | |
---|
10068 | CASE( 'LDSA' ) |
---|
10069 | salsa_pr_count = salsa_pr_count + 1 |
---|
10070 | salsa_pr_index(salsa_pr_count) = 1 |
---|
10071 | dopr_index(var_count) = pr_palm + salsa_pr_count |
---|
10072 | dopr_unit = 'mum2/cm3' |
---|
10073 | unit = dopr_unit |
---|
10074 | hom(:,2,dopr_index(var_count),:) = SPREAD( zu, 2, statistic_regions+1 ) |
---|
10075 | |
---|
10076 | CASE( 'N_UFP' ) |
---|
10077 | salsa_pr_count = salsa_pr_count + 1 |
---|
10078 | salsa_pr_index(salsa_pr_count) = 2 |
---|
10079 | dopr_index(var_count) = pr_palm + salsa_pr_count |
---|
10080 | dopr_unit = '#/m3' |
---|
10081 | unit = dopr_unit |
---|
10082 | hom(:,2,dopr_index(var_count),:) = SPREAD( zu, 2, statistic_regions+1 ) |
---|
10083 | |
---|
10084 | CASE( 'Ntot' ) |
---|
10085 | salsa_pr_count = salsa_pr_count + 1 |
---|
10086 | salsa_pr_index(salsa_pr_count) = 3 |
---|
10087 | dopr_index(var_count) = pr_palm + salsa_pr_count |
---|
10088 | dopr_unit = '#/m3' |
---|
10089 | unit = dopr_unit |
---|
10090 | hom(:,2,dopr_index(var_count),:) = SPREAD( zu, 2, statistic_regions+1 ) |
---|
10091 | |
---|
10092 | CASE( 'PM0.1' ) |
---|
10093 | salsa_pr_count = salsa_pr_count + 1 |
---|
10094 | salsa_pr_index(salsa_pr_count) = 4 |
---|
10095 | dopr_index(var_count) = pr_palm + salsa_pr_count |
---|
10096 | dopr_unit = 'kg/m3' |
---|
10097 | unit = dopr_unit |
---|
10098 | hom(:,2,dopr_index(var_count),:) = SPREAD( zu, 2, statistic_regions+1 ) |
---|
10099 | |
---|
10100 | CASE( 'PM2.5' ) |
---|
10101 | salsa_pr_count = salsa_pr_count + 1 |
---|
10102 | salsa_pr_index(salsa_pr_count) = 5 |
---|
10103 | dopr_index(var_count) = pr_palm + salsa_pr_count |
---|
10104 | dopr_unit = 'kg/m3' |
---|
10105 | unit = dopr_unit |
---|
10106 | hom(:,2,dopr_index(var_count),:) = SPREAD( zu, 2, statistic_regions+1 ) |
---|
10107 | |
---|
10108 | CASE( 'PM10' ) |
---|
10109 | salsa_pr_count = salsa_pr_count + 1 |
---|
10110 | salsa_pr_index(salsa_pr_count) = 6 |
---|
10111 | dopr_index(var_count) = pr_palm + salsa_pr_count |
---|
10112 | dopr_unit = 'kg/m3' |
---|
10113 | unit = dopr_unit |
---|
10114 | hom(:,2,dopr_index(var_count),:) = SPREAD( zu, 2, statistic_regions+1 ) |
---|
10115 | |
---|
10116 | CASE DEFAULT |
---|
10117 | unit = 'illegal' |
---|
10118 | |
---|
10119 | END SELECT |
---|
10120 | |
---|
10121 | |
---|
10122 | END SUBROUTINE salsa_check_data_output_pr |
---|
10123 | |
---|
10124 | !-------------------------------------------------------------------------------! |
---|
10125 | !> Description: |
---|
10126 | !> Calculation of horizontally averaged profiles for salsa. |
---|
10127 | !-------------------------------------------------------------------------------! |
---|
10128 | SUBROUTINE salsa_statistics( mode, sr, tn ) |
---|
10129 | |
---|
10130 | USE control_parameters, & |
---|
10131 | ONLY: max_pr_user |
---|
10132 | |
---|
10133 | USE chem_modules, & |
---|
10134 | ONLY: max_pr_cs |
---|
10135 | |
---|
10136 | USE statistics, & |
---|
10137 | ONLY: pr_palm, rmask, sums_l |
---|
10138 | |
---|
10139 | IMPLICIT NONE |
---|
10140 | |
---|
10141 | CHARACTER(LEN=*) :: mode !< |
---|
10142 | |
---|
10143 | INTEGER(iwp) :: i !< loop index |
---|
10144 | INTEGER(iwp) :: ib !< loop index |
---|
10145 | INTEGER(iwp) :: ic !< loop index |
---|
10146 | INTEGER(iwp) :: ii !< loop index |
---|
10147 | INTEGER(iwp) :: ind !< index in the statistical output |
---|
10148 | INTEGER(iwp) :: j !< loop index |
---|
10149 | INTEGER(iwp) :: k !< loop index |
---|
10150 | INTEGER(iwp) :: sr !< statistical region |
---|
10151 | INTEGER(iwp) :: tn !< thread number |
---|
10152 | |
---|
10153 | REAL(wp) :: df !< For calculating LDSA: fraction of particles depositing in the alveolar |
---|
10154 | !< (or tracheobronchial) region of the lung. Depends on the particle size |
---|
10155 | REAL(wp) :: mean_d !< Particle diameter in micrometres |
---|
10156 | REAL(wp) :: temp_bin !< temporary variable |
---|
10157 | |
---|
10158 | IF ( mode == 'profiles' ) THEN |
---|
10159 | !$OMP DO |
---|
10160 | DO ii = 1, salsa_pr_count |
---|
10161 | |
---|
10162 | ind = pr_palm + max_pr_user + max_pr_cs + ii |
---|
10163 | |
---|
10164 | SELECT CASE( salsa_pr_index(ii) ) |
---|
10165 | |
---|
10166 | CASE( 1 ) ! LDSA |
---|
10167 | DO i = nxl, nxr |
---|
10168 | DO j = nys, nyn |
---|
10169 | DO k = nzb, nzt+1 |
---|
10170 | temp_bin = 0.0_wp |
---|
10171 | DO ib = 1, nbins_aerosol |
---|
10172 | ! |
---|
10173 | !-- Diameter in micrometres |
---|
10174 | mean_d = 1.0E+6_wp * ra_dry(k,j,i,ib) * 2.0_wp |
---|
10175 | ! |
---|
10176 | !-- Deposition factor: alveolar |
---|
10177 | df = ( 0.01555_wp / mean_d ) * ( EXP( -0.416_wp * ( LOG( mean_d ) + & |
---|
10178 | 2.84_wp )**2 ) + 19.11_wp * EXP( -0.482_wp * ( LOG( mean_d ) - & |
---|
10179 | 1.362_wp )**2 ) ) |
---|
10180 | ! |
---|
10181 | !-- Lung-deposited surface area LDSA (units mum2/cm3) |
---|
10182 | temp_bin = temp_bin + pi * mean_d**2 * df * 1.0E-6_wp * & |
---|
10183 | aerosol_number(ib)%conc(k,j,i) |
---|
10184 | ENDDO |
---|
10185 | sums_l(k,ind,tn) = sums_l(k,ind,tn) + temp_bin * rmask(j,i,sr) * & |
---|
10186 | MERGE( 1.0_wp, 0.0_wp, & |
---|
10187 | BTEST( wall_flags_total_0(k,j,i), 22 ) ) |
---|
10188 | ENDDO |
---|
10189 | ENDDO |
---|
10190 | ENDDO |
---|
10191 | |
---|
10192 | CASE( 2 ) ! N_UFP |
---|
10193 | DO i = nxl, nxr |
---|
10194 | DO j = nys, nyn |
---|
10195 | DO k = nzb, nzt+1 |
---|
10196 | temp_bin = 0.0_wp |
---|
10197 | DO ib = 1, nbins_aerosol |
---|
10198 | IF ( 2.0_wp * ra_dry(k,j,i,ib) <= 0.1E-6_wp ) & |
---|
10199 | temp_bin = temp_bin + aerosol_number(ib)%conc(k,j,i) |
---|
10200 | ENDDO |
---|
10201 | sums_l(k,ind,tn) = sums_l(k,ind,tn) + temp_bin * rmask(j,i,sr) * & |
---|
10202 | MERGE( 1.0_wp, 0.0_wp, & |
---|
10203 | BTEST( wall_flags_total_0(k,j,i), 22 ) ) |
---|
10204 | ENDDO |
---|
10205 | ENDDO |
---|
10206 | ENDDO |
---|
10207 | |
---|
10208 | CASE( 3 ) ! Ntot |
---|
10209 | DO i = nxl, nxr |
---|
10210 | DO j = nys, nyn |
---|
10211 | DO k = nzb, nzt+1 |
---|
10212 | temp_bin = 0.0_wp |
---|
10213 | DO ib = 1, nbins_aerosol |
---|
10214 | temp_bin = temp_bin + aerosol_number(ib)%conc(k,j,i) |
---|
10215 | ENDDO |
---|
10216 | sums_l(k,ind,tn) = sums_l(k,ind,tn) + temp_bin * rmask(j,i,sr) * & |
---|
10217 | MERGE( 1.0_wp, 0.0_wp, & |
---|
10218 | BTEST( wall_flags_total_0(k,j,i), 22 ) ) |
---|
10219 | ENDDO |
---|
10220 | ENDDO |
---|
10221 | ENDDO |
---|
10222 | |
---|
10223 | CASE( 4 ) ! PM0.1 |
---|
10224 | DO i = nxl, nxr |
---|
10225 | DO j = nys, nyn |
---|
10226 | DO k = nzb, nzt+1 |
---|
10227 | temp_bin = 0.0_wp |
---|
10228 | DO ib = 1, nbins_aerosol |
---|
10229 | IF ( 2.0_wp * ra_dry(k,j,i,ib) <= 0.1E-6_wp ) THEN |
---|
10230 | DO ic = ib, nbins_aerosol * ncc, nbins_aerosol |
---|
10231 | temp_bin = temp_bin + aerosol_mass(ic)%conc(k,j,i) |
---|
10232 | ENDDO |
---|
10233 | ENDIF |
---|
10234 | ENDDO |
---|
10235 | sums_l(k,ind,tn) = sums_l(k,ind,tn) + temp_bin * rmask(j,i,sr) * & |
---|
10236 | MERGE( 1.0_wp, 0.0_wp, & |
---|
10237 | BTEST( wall_flags_total_0(k,j,i), 22 ) ) |
---|
10238 | ENDDO |
---|
10239 | ENDDO |
---|
10240 | ENDDO |
---|
10241 | |
---|
10242 | CASE( 5 ) ! PM2.5 |
---|
10243 | DO i = nxl, nxr |
---|
10244 | DO j = nys, nyn |
---|
10245 | DO k = nzb, nzt+1 |
---|
10246 | temp_bin = 0.0_wp |
---|
10247 | DO ib = 1, nbins_aerosol |
---|
10248 | IF ( 2.0_wp * ra_dry(k,j,i,ib) <= 2.5E-6_wp ) THEN |
---|
10249 | DO ic = ib, nbins_aerosol * ncc, nbins_aerosol |
---|
10250 | temp_bin = temp_bin + aerosol_mass(ic)%conc(k,j,i) |
---|
10251 | ENDDO |
---|
10252 | ENDIF |
---|
10253 | ENDDO |
---|
10254 | sums_l(k,ind,tn) = sums_l(k,ind,tn) + temp_bin * rmask(j,i,sr) * & |
---|
10255 | MERGE( 1.0_wp, 0.0_wp, & |
---|
10256 | BTEST( wall_flags_total_0(k,j,i), 22 ) ) |
---|
10257 | ENDDO |
---|
10258 | ENDDO |
---|
10259 | ENDDO |
---|
10260 | |
---|
10261 | CASE( 6 ) ! PM10 |
---|
10262 | DO i = nxl, nxr |
---|
10263 | DO j = nys, nyn |
---|
10264 | DO k = nzb, nzt+1 |
---|
10265 | temp_bin = 0.0_wp |
---|
10266 | DO ib = 1, nbins_aerosol |
---|
10267 | IF ( 2.0_wp * ra_dry(k,j,i,ib) <= 10.0E-6_wp ) THEN |
---|
10268 | DO ic = ib, nbins_aerosol * ncc, nbins_aerosol |
---|
10269 | temp_bin = temp_bin + aerosol_mass(ic)%conc(k,j,i) |
---|
10270 | ENDDO |
---|
10271 | ENDIF |
---|
10272 | ENDDO |
---|
10273 | sums_l(k,ind,tn) = sums_l(k,ind,tn) + temp_bin * rmask(j,i,sr) * & |
---|
10274 | MERGE( 1.0_wp, 0.0_wp, & |
---|
10275 | BTEST( wall_flags_total_0(k,j,i), 22 ) ) |
---|
10276 | ENDDO |
---|
10277 | ENDDO |
---|
10278 | ENDDO |
---|
10279 | |
---|
10280 | END SELECT |
---|
10281 | ENDDO |
---|
10282 | |
---|
10283 | ELSEIF ( mode == 'time_series' ) THEN |
---|
10284 | ! |
---|
10285 | !-- TODO |
---|
10286 | ENDIF |
---|
10287 | |
---|
10288 | END SUBROUTINE salsa_statistics |
---|
10289 | |
---|
10290 | |
---|
10291 | !------------------------------------------------------------------------------! |
---|
10292 | ! |
---|
10293 | ! Description: |
---|
10294 | ! ------------ |
---|
10295 | !> Subroutine for averaging 3D data |
---|
10296 | !------------------------------------------------------------------------------! |
---|
10297 | SUBROUTINE salsa_3d_data_averaging( mode, variable ) |
---|
10298 | |
---|
10299 | USE control_parameters, & |
---|
10300 | ONLY: average_count_3d |
---|
10301 | |
---|
10302 | IMPLICIT NONE |
---|
10303 | |
---|
10304 | CHARACTER(LEN=*) :: mode !< |
---|
10305 | CHARACTER(LEN=10) :: vari !< |
---|
10306 | CHARACTER(LEN=*) :: variable !< |
---|
10307 | |
---|
10308 | INTEGER(iwp) :: char_to_int !< for converting character to integer |
---|
10309 | INTEGER(iwp) :: found_index !< |
---|
10310 | INTEGER(iwp) :: i !< |
---|
10311 | INTEGER(iwp) :: ib !< |
---|
10312 | INTEGER(iwp) :: ic !< |
---|
10313 | INTEGER(iwp) :: j !< |
---|
10314 | INTEGER(iwp) :: k !< |
---|
10315 | |
---|
10316 | REAL(wp) :: df !< For calculating LDSA: fraction of particles depositing in the alveolar |
---|
10317 | !< (or tracheobronchial) region of the lung. Depends on the particle size |
---|
10318 | REAL(wp) :: mean_d !< Particle diameter in micrometres |
---|
10319 | REAL(wp) :: temp_bin !< temporary variable |
---|
10320 | |
---|
10321 | REAL(wp), DIMENSION(:,:,:), POINTER :: to_be_resorted !< points to selected output variable |
---|
10322 | |
---|
10323 | temp_bin = 0.0_wp |
---|
10324 | |
---|
10325 | IF ( mode == 'allocate' ) THEN |
---|
10326 | |
---|
10327 | IF ( variable(7:11) == 'N_bin' ) THEN |
---|
10328 | IF ( .NOT. ALLOCATED( nbins_av ) ) THEN |
---|
10329 | ALLOCATE( nbins_av(nzb:nzt+1,nysg:nyng,nxlg:nxrg,nbins_aerosol) ) |
---|
10330 | ENDIF |
---|
10331 | nbins_av = 0.0_wp |
---|
10332 | |
---|
10333 | ELSEIF ( variable(7:11) == 'm_bin' ) THEN |
---|
10334 | IF ( .NOT. ALLOCATED( mbins_av ) ) THEN |
---|
10335 | ALLOCATE( mbins_av(nzb:nzt+1,nysg:nyng,nxlg:nxrg,nbins_aerosol) ) |
---|
10336 | ENDIF |
---|
10337 | mbins_av = 0.0_wp |
---|
10338 | |
---|
10339 | ELSE |
---|
10340 | |
---|
10341 | SELECT CASE ( TRIM( variable(7:) ) ) |
---|
10342 | |
---|
10343 | CASE ( 'g_H2SO4', 'g_HNO3', 'g_NH3', 'g_OCNV', 'g_OCSV' ) |
---|
10344 | IF ( .NOT. ALLOCATED( salsa_gases_av ) ) THEN |
---|
10345 | ALLOCATE( salsa_gases_av(nzb:nzt+1,nysg:nyng,nxlg:nxrg,ngases_salsa) ) |
---|
10346 | ENDIF |
---|
10347 | salsa_gases_av = 0.0_wp |
---|
10348 | |
---|
10349 | CASE ( 'LDSA' ) |
---|
10350 | IF ( .NOT. ALLOCATED( ldsa_av ) ) THEN |
---|
10351 | ALLOCATE( ldsa_av(nzb:nzt+1,nysg:nyng,nxlg:nxrg) ) |
---|
10352 | ENDIF |
---|
10353 | ldsa_av = 0.0_wp |
---|
10354 | |
---|
10355 | CASE ( 'N_UFP' ) |
---|
10356 | IF ( .NOT. ALLOCATED( nufp_av ) ) THEN |
---|
10357 | ALLOCATE( nufp_av(nzb:nzt+1,nysg:nyng,nxlg:nxrg) ) |
---|
10358 | ENDIF |
---|
10359 | nufp_av = 0.0_wp |
---|
10360 | |
---|
10361 | CASE ( 'Ntot' ) |
---|
10362 | IF ( .NOT. ALLOCATED( ntot_av ) ) THEN |
---|
10363 | ALLOCATE( ntot_av(nzb:nzt+1,nysg:nyng,nxlg:nxrg) ) |
---|
10364 | ENDIF |
---|
10365 | ntot_av = 0.0_wp |
---|
10366 | |
---|
10367 | CASE ( 'PM0.1' ) |
---|
10368 | IF ( .NOT. ALLOCATED( pm01_av ) ) THEN |
---|
10369 | ALLOCATE( pm01_av(nzb:nzt+1,nysg:nyng,nxlg:nxrg) ) |
---|
10370 | ENDIF |
---|
10371 | pm01_av = 0.0_wp |
---|
10372 | |
---|
10373 | CASE ( 'PM2.5' ) |
---|
10374 | IF ( .NOT. ALLOCATED( pm25_av ) ) THEN |
---|
10375 | ALLOCATE( pm25_av(nzb:nzt+1,nysg:nyng,nxlg:nxrg) ) |
---|
10376 | ENDIF |
---|
10377 | pm25_av = 0.0_wp |
---|
10378 | |
---|
10379 | CASE ( 'PM10' ) |
---|
10380 | IF ( .NOT. ALLOCATED( pm10_av ) ) THEN |
---|
10381 | ALLOCATE( pm10_av(nzb:nzt+1,nysg:nyng,nxlg:nxrg) ) |
---|
10382 | ENDIF |
---|
10383 | pm10_av = 0.0_wp |
---|
10384 | |
---|
10385 | CASE ( 's_BC', 's_DU', 's_NH', 's_NO', 's_OC', 's_SO4', 's_SS' ) |
---|
10386 | IF ( .NOT. ALLOCATED( s_mass_av ) ) THEN |
---|
10387 | ALLOCATE( s_mass_av(nzb:nzt+1,nysg:nyng,nxlg:nxrg,ncomponents_mass+1) ) |
---|
10388 | ENDIF |
---|
10389 | s_mass_av = 0.0_wp |
---|
10390 | |
---|
10391 | CASE ( 's_H2O' ) |
---|
10392 | IF ( .NOT. ALLOCATED( s_h2o_av ) ) THEN |
---|
10393 | ALLOCATE( s_h2o_av(nzb:nzt+1,nysg:nyng,nxlg:nxrg) ) |
---|
10394 | ENDIF |
---|
10395 | s_h2o_av = 0.0_wp |
---|
10396 | |
---|
10397 | CASE DEFAULT |
---|
10398 | CONTINUE |
---|
10399 | |
---|
10400 | END SELECT |
---|
10401 | |
---|
10402 | ENDIF |
---|
10403 | |
---|
10404 | ELSEIF ( mode == 'sum' ) THEN |
---|
10405 | |
---|
10406 | IF ( variable(7:11) == 'N_bin' ) THEN |
---|
10407 | IF ( ALLOCATED( nbins_av ) ) THEN |
---|
10408 | READ( variable(12:),* ) char_to_int |
---|
10409 | IF ( char_to_int >= 1 .AND. char_to_int <= SUM( nbin ) ) THEN |
---|
10410 | ib = char_to_int |
---|
10411 | DO i = nxlg, nxrg |
---|
10412 | DO j = nysg, nyng |
---|
10413 | DO k = nzb, nzt+1 |
---|
10414 | nbins_av(k,j,i,ib) = nbins_av(k,j,i,ib) + aerosol_number(ib)%conc(k,j,i) |
---|
10415 | ENDDO |
---|
10416 | ENDDO |
---|
10417 | ENDDO |
---|
10418 | ENDIF |
---|
10419 | ENDIF |
---|
10420 | |
---|
10421 | ELSEIF ( variable(7:11) == 'm_bin' ) THEN |
---|
10422 | IF ( ALLOCATED( mbins_av ) ) THEN |
---|
10423 | READ( variable(12:),* ) char_to_int |
---|
10424 | IF ( char_to_int >= 1 .AND. char_to_int <= SUM( nbin ) ) THEN |
---|
10425 | ib = char_to_int |
---|
10426 | DO i = nxlg, nxrg |
---|
10427 | DO j = nysg, nyng |
---|
10428 | DO k = nzb, nzt+1 |
---|
10429 | temp_bin = 0.0_wp |
---|
10430 | DO ic = ib, nbins_aerosol * ncomponents_mass, nbins_aerosol |
---|
10431 | temp_bin = temp_bin + aerosol_mass(ic)%conc(k,j,i) |
---|
10432 | ENDDO |
---|
10433 | mbins_av(k,j,i,ib) = mbins_av(k,j,i,ib) + temp_bin |
---|
10434 | ENDDO |
---|
10435 | ENDDO |
---|
10436 | ENDDO |
---|
10437 | ENDIF |
---|
10438 | ENDIF |
---|
10439 | ELSE |
---|
10440 | |
---|
10441 | SELECT CASE ( TRIM( variable(7:) ) ) |
---|
10442 | |
---|
10443 | CASE ( 'g_H2SO4', 'g_HNO3', 'g_NH3', 'g_OCNV', 'g_OCSV' ) |
---|
10444 | IF ( ALLOCATED( salsa_gases_av ) ) THEN |
---|
10445 | |
---|
10446 | vari = TRIM( variable(9:) ) ! remove salsa_g_ from beginning |
---|
10447 | |
---|
10448 | SELECT CASE( vari ) |
---|
10449 | |
---|
10450 | CASE( 'H2SO4' ) |
---|
10451 | found_index = 1 |
---|
10452 | CASE( 'HNO3' ) |
---|
10453 | found_index = 2 |
---|
10454 | CASE( 'NH3' ) |
---|
10455 | found_index = 3 |
---|
10456 | CASE( 'OCNV' ) |
---|
10457 | found_index = 4 |
---|
10458 | CASE( 'OCSV' ) |
---|
10459 | found_index = 5 |
---|
10460 | |
---|
10461 | END SELECT |
---|
10462 | |
---|
10463 | DO i = nxlg, nxrg |
---|
10464 | DO j = nysg, nyng |
---|
10465 | DO k = nzb, nzt+1 |
---|
10466 | salsa_gases_av(k,j,i,found_index) = salsa_gases_av(k,j,i,found_index) & |
---|
10467 | + salsa_gas(found_index)%conc(k,j,i) |
---|
10468 | ENDDO |
---|
10469 | ENDDO |
---|
10470 | ENDDO |
---|
10471 | ENDIF |
---|
10472 | |
---|
10473 | CASE ( 'LDSA' ) |
---|
10474 | IF ( ALLOCATED( ldsa_av ) ) THEN |
---|
10475 | DO i = nxlg, nxrg |
---|
10476 | DO j = nysg, nyng |
---|
10477 | DO k = nzb, nzt+1 |
---|
10478 | temp_bin = 0.0_wp |
---|
10479 | DO ib = 1, nbins_aerosol |
---|
10480 | ! |
---|
10481 | !-- Diameter in micrometres |
---|
10482 | mean_d = 1.0E+6_wp * ra_dry(k,j,i,ib) * 2.0_wp |
---|
10483 | ! |
---|
10484 | !-- Deposition factor: alveolar (use ra_dry) |
---|
10485 | df = ( 0.01555_wp / mean_d ) * ( EXP( -0.416_wp * ( LOG( mean_d ) + & |
---|
10486 | 2.84_wp )**2 ) + 19.11_wp * EXP( -0.482_wp * ( LOG( mean_d ) & |
---|
10487 | - 1.362_wp )**2 ) ) |
---|
10488 | ! |
---|
10489 | !-- Lung-deposited surface area LDSA (units mum2/cm3) |
---|
10490 | temp_bin = temp_bin + pi * mean_d**2 * df * 1.0E-6_wp * & |
---|
10491 | aerosol_number(ib)%conc(k,j,i) |
---|
10492 | ENDDO |
---|
10493 | ldsa_av(k,j,i) = ldsa_av(k,j,i) + temp_bin |
---|
10494 | ENDDO |
---|
10495 | ENDDO |
---|
10496 | ENDDO |
---|
10497 | ENDIF |
---|
10498 | |
---|
10499 | CASE ( 'N_UFP' ) |
---|
10500 | IF ( ALLOCATED( nufp_av ) ) THEN |
---|
10501 | DO i = nxlg, nxrg |
---|
10502 | DO j = nysg, nyng |
---|
10503 | DO k = nzb, nzt+1 |
---|
10504 | temp_bin = 0.0_wp |
---|
10505 | DO ib = 1, nbins_aerosol |
---|
10506 | IF ( 2.0_wp * ra_dry(k,j,i,ib) <= 0.1E-6_wp ) THEN |
---|
10507 | temp_bin = temp_bin + aerosol_number(ib)%conc(k,j,i) |
---|
10508 | ENDIF |
---|
10509 | ENDDO |
---|
10510 | nufp_av(k,j,i) = nufp_av(k,j,i) + temp_bin |
---|
10511 | ENDDO |
---|
10512 | ENDDO |
---|
10513 | ENDDO |
---|
10514 | ENDIF |
---|
10515 | |
---|
10516 | CASE ( 'Ntot' ) |
---|
10517 | IF ( ALLOCATED( ntot_av ) ) THEN |
---|
10518 | DO i = nxlg, nxrg |
---|
10519 | DO j = nysg, nyng |
---|
10520 | DO k = nzb, nzt+1 |
---|
10521 | DO ib = 1, nbins_aerosol |
---|
10522 | ntot_av(k,j,i) = ntot_av(k,j,i) + aerosol_number(ib)%conc(k,j,i) |
---|
10523 | ENDDO |
---|
10524 | ENDDO |
---|
10525 | ENDDO |
---|
10526 | ENDDO |
---|
10527 | ENDIF |
---|
10528 | |
---|
10529 | CASE ( 'PM0.1' ) |
---|
10530 | IF ( ALLOCATED( pm01_av ) ) THEN |
---|
10531 | DO i = nxlg, nxrg |
---|
10532 | DO j = nysg, nyng |
---|
10533 | DO k = nzb, nzt+1 |
---|
10534 | temp_bin = 0.0_wp |
---|
10535 | DO ib = 1, nbins_aerosol |
---|
10536 | IF ( 2.0_wp * ra_dry(k,j,i,ib) <= 0.1E-6_wp ) THEN |
---|
10537 | DO ic = ib, nbins_aerosol * ncc, nbins_aerosol |
---|
10538 | temp_bin = temp_bin + aerosol_mass(ic)%conc(k,j,i) |
---|
10539 | ENDDO |
---|
10540 | ENDIF |
---|
10541 | ENDDO |
---|
10542 | pm01_av(k,j,i) = pm01_av(k,j,i) + temp_bin |
---|
10543 | ENDDO |
---|
10544 | ENDDO |
---|
10545 | ENDDO |
---|
10546 | ENDIF |
---|
10547 | |
---|
10548 | CASE ( 'PM2.5' ) |
---|
10549 | IF ( ALLOCATED( pm25_av ) ) THEN |
---|
10550 | DO i = nxlg, nxrg |
---|
10551 | DO j = nysg, nyng |
---|
10552 | DO k = nzb, nzt+1 |
---|
10553 | temp_bin = 0.0_wp |
---|
10554 | DO ib = 1, nbins_aerosol |
---|
10555 | IF ( 2.0_wp * ra_dry(k,j,i,ib) <= 2.5E-6_wp ) THEN |
---|
10556 | DO ic = ib, nbins_aerosol * ncc, nbins_aerosol |
---|
10557 | temp_bin = temp_bin + aerosol_mass(ic)%conc(k,j,i) |
---|
10558 | ENDDO |
---|
10559 | ENDIF |
---|
10560 | ENDDO |
---|
10561 | pm25_av(k,j,i) = pm25_av(k,j,i) + temp_bin |
---|
10562 | ENDDO |
---|
10563 | ENDDO |
---|
10564 | ENDDO |
---|
10565 | ENDIF |
---|
10566 | |
---|
10567 | CASE ( 'PM10' ) |
---|
10568 | IF ( ALLOCATED( pm10_av ) ) THEN |
---|
10569 | DO i = nxlg, nxrg |
---|
10570 | DO j = nysg, nyng |
---|
10571 | DO k = nzb, nzt+1 |
---|
10572 | temp_bin = 0.0_wp |
---|
10573 | DO ib = 1, nbins_aerosol |
---|
10574 | IF ( 2.0_wp * ra_dry(k,j,i,ib) <= 10.0E-6_wp ) THEN |
---|
10575 | DO ic = ib, nbins_aerosol * ncc, nbins_aerosol |
---|
10576 | temp_bin = temp_bin + aerosol_mass(ic)%conc(k,j,i) |
---|
10577 | ENDDO |
---|
10578 | ENDIF |
---|
10579 | ENDDO |
---|
10580 | pm10_av(k,j,i) = pm10_av(k,j,i) + temp_bin |
---|
10581 | ENDDO |
---|
10582 | ENDDO |
---|
10583 | ENDDO |
---|
10584 | ENDIF |
---|
10585 | |
---|
10586 | CASE ( 's_BC', 's_DU', 's_NH', 's_NO', 's_OC', 's_SO4', 's_SS' ) |
---|
10587 | IF ( ALLOCATED( s_mass_av ) ) THEN |
---|
10588 | IF ( is_used( prtcl, TRIM( variable(9:) ) ) ) THEN ! 9: remove salsa_s_ |
---|
10589 | found_index = get_index( prtcl, TRIM( variable(9:) ) ) |
---|
10590 | DO i = nxlg, nxrg |
---|
10591 | DO j = nysg, nyng |
---|
10592 | DO k = nzb, nzt+1 |
---|
10593 | DO ic = ( found_index-1 ) * nbins_aerosol + 1, found_index * nbins_aerosol |
---|
10594 | s_mass_av(k,j,i,found_index) = s_mass_av(k,j,i,found_index) + & |
---|
10595 | aerosol_mass(ic)%conc(k,j,i) |
---|
10596 | ENDDO |
---|
10597 | ENDDO |
---|
10598 | ENDDO |
---|
10599 | ENDDO |
---|
10600 | ENDIF |
---|
10601 | ENDIF |
---|
10602 | |
---|
10603 | CASE ( 's_H2O' ) |
---|
10604 | IF ( ALLOCATED( s_H2O_av ) ) THEN |
---|
10605 | found_index = get_index( prtcl,'H2O' ) |
---|
10606 | to_be_resorted => s_h2o_av |
---|
10607 | DO i = nxlg, nxrg |
---|
10608 | DO j = nysg, nyng |
---|
10609 | DO k = nzb, nzt+1 |
---|
10610 | DO ic = ( found_index-1 ) * nbins_aerosol + 1, found_index * nbins_aerosol |
---|
10611 | s_h2o_av(k,j,i) = s_h2o_av(k,j,i) + aerosol_mass(ic)%conc(k,j,i) |
---|
10612 | ENDDO |
---|
10613 | ENDDO |
---|
10614 | ENDDO |
---|
10615 | ENDDO |
---|
10616 | ENDIF |
---|
10617 | |
---|
10618 | CASE DEFAULT |
---|
10619 | CONTINUE |
---|
10620 | |
---|
10621 | END SELECT |
---|
10622 | |
---|
10623 | ENDIF |
---|
10624 | |
---|
10625 | ELSEIF ( mode == 'average' ) THEN |
---|
10626 | |
---|
10627 | IF ( variable(7:11) == 'N_bin' ) THEN |
---|
10628 | IF ( ALLOCATED( nbins_av ) ) THEN |
---|
10629 | READ( variable(12:),* ) char_to_int |
---|
10630 | IF ( char_to_int >= 1 .AND. char_to_int <= SUM( nbin ) ) THEN |
---|
10631 | ib = char_to_int |
---|
10632 | DO i = nxlg, nxrg |
---|
10633 | DO j = nysg, nyng |
---|
10634 | DO k = nzb, nzt+1 |
---|
10635 | nbins_av(k,j,i,ib) = nbins_av(k,j,i,ib) / REAL( average_count_3d, KIND=wp ) |
---|
10636 | ENDDO |
---|
10637 | ENDDO |
---|
10638 | ENDDO |
---|
10639 | ENDIF |
---|
10640 | ENDIF |
---|
10641 | |
---|
10642 | ELSEIF ( variable(7:11) == 'm_bin' ) THEN |
---|
10643 | IF ( ALLOCATED( mbins_av ) ) THEN |
---|
10644 | READ( variable(12:),* ) char_to_int |
---|
10645 | IF ( char_to_int >= 1 .AND. char_to_int <= SUM( nbin ) ) THEN |
---|
10646 | ib = char_to_int |
---|
10647 | DO i = nxlg, nxrg |
---|
10648 | DO j = nysg, nyng |
---|
10649 | DO k = nzb, nzt+1 |
---|
10650 | mbins_av(k,j,i,ib) = mbins_av(k,j,i,ib) / REAL( average_count_3d, KIND=wp) |
---|
10651 | ENDDO |
---|
10652 | ENDDO |
---|
10653 | ENDDO |
---|
10654 | ENDIF |
---|
10655 | ENDIF |
---|
10656 | ELSE |
---|
10657 | |
---|
10658 | SELECT CASE ( TRIM( variable(7:) ) ) |
---|
10659 | |
---|
10660 | CASE ( 'g_H2SO4', 'g_HNO3', 'g_NH3', 'g_OCNV', 'g_OCSV' ) |
---|
10661 | IF ( ALLOCATED( salsa_gases_av ) ) THEN |
---|
10662 | IF ( TRIM( variable(9:) ) == 'H2SO4' ) THEN ! 9: remove salsa_g_ from beginning |
---|
10663 | found_index = 1 |
---|
10664 | ELSEIF ( TRIM( variable(9:) ) == 'HNO3' ) THEN |
---|
10665 | found_index = 2 |
---|
10666 | ELSEIF ( TRIM( variable(9:) ) == 'NH3' ) THEN |
---|
10667 | found_index = 3 |
---|
10668 | ELSEIF ( TRIM( variable(9:) ) == 'OCNV' ) THEN |
---|
10669 | found_index = 4 |
---|
10670 | ELSEIF ( TRIM( variable(9:) ) == 'OCSV' ) THEN |
---|
10671 | found_index = 5 |
---|
10672 | ENDIF |
---|
10673 | DO i = nxlg, nxrg |
---|
10674 | DO j = nysg, nyng |
---|
10675 | DO k = nzb, nzt+1 |
---|
10676 | salsa_gases_av(k,j,i,found_index) = salsa_gases_av(k,j,i,found_index) & |
---|
10677 | / REAL( average_count_3d, KIND=wp ) |
---|
10678 | ENDDO |
---|
10679 | ENDDO |
---|
10680 | ENDDO |
---|
10681 | ENDIF |
---|
10682 | |
---|
10683 | CASE ( 'LDSA' ) |
---|
10684 | IF ( ALLOCATED( ldsa_av ) ) THEN |
---|
10685 | DO i = nxlg, nxrg |
---|
10686 | DO j = nysg, nyng |
---|
10687 | DO k = nzb, nzt+1 |
---|
10688 | ldsa_av(k,j,i) = ldsa_av(k,j,i) / REAL( average_count_3d, KIND=wp ) |
---|
10689 | ENDDO |
---|
10690 | ENDDO |
---|
10691 | ENDDO |
---|
10692 | ENDIF |
---|
10693 | |
---|
10694 | CASE ( 'N_UFP' ) |
---|
10695 | IF ( ALLOCATED( nufp_av ) ) THEN |
---|
10696 | DO i = nxlg, nxrg |
---|
10697 | DO j = nysg, nyng |
---|
10698 | DO k = nzb, nzt+1 |
---|
10699 | nufp_av(k,j,i) = nufp_av(k,j,i) / REAL( average_count_3d, KIND=wp ) |
---|
10700 | ENDDO |
---|
10701 | ENDDO |
---|
10702 | ENDDO |
---|
10703 | ENDIF |
---|
10704 | |
---|
10705 | CASE ( 'Ntot' ) |
---|
10706 | IF ( ALLOCATED( ntot_av ) ) THEN |
---|
10707 | DO i = nxlg, nxrg |
---|
10708 | DO j = nysg, nyng |
---|
10709 | DO k = nzb, nzt+1 |
---|
10710 | ntot_av(k,j,i) = ntot_av(k,j,i) / REAL( average_count_3d, KIND=wp ) |
---|
10711 | ENDDO |
---|
10712 | ENDDO |
---|
10713 | ENDDO |
---|
10714 | ENDIF |
---|
10715 | |
---|
10716 | CASE ( 'PM0.1' ) |
---|
10717 | IF ( ALLOCATED( pm01_av ) ) THEN |
---|
10718 | DO i = nxlg, nxrg |
---|
10719 | DO j = nysg, nyng |
---|
10720 | DO k = nzb, nzt+1 |
---|
10721 | pm01_av(k,j,i) = pm01_av(k,j,i) / REAL( average_count_3d, KIND=wp ) |
---|
10722 | ENDDO |
---|
10723 | ENDDO |
---|
10724 | ENDDO |
---|
10725 | ENDIF |
---|
10726 | |
---|
10727 | CASE ( 'PM2.5' ) |
---|
10728 | IF ( ALLOCATED( pm25_av ) ) THEN |
---|
10729 | DO i = nxlg, nxrg |
---|
10730 | DO j = nysg, nyng |
---|
10731 | DO k = nzb, nzt+1 |
---|
10732 | pm25_av(k,j,i) = pm25_av(k,j,i) / REAL( average_count_3d, KIND=wp ) |
---|
10733 | ENDDO |
---|
10734 | ENDDO |
---|
10735 | ENDDO |
---|
10736 | ENDIF |
---|
10737 | |
---|
10738 | CASE ( 'PM10' ) |
---|
10739 | IF ( ALLOCATED( pm10_av ) ) THEN |
---|
10740 | DO i = nxlg, nxrg |
---|
10741 | DO j = nysg, nyng |
---|
10742 | DO k = nzb, nzt+1 |
---|
10743 | pm10_av(k,j,i) = pm10_av(k,j,i) / REAL( average_count_3d, KIND=wp ) |
---|
10744 | ENDDO |
---|
10745 | ENDDO |
---|
10746 | ENDDO |
---|
10747 | ENDIF |
---|
10748 | |
---|
10749 | CASE ( 's_BC', 's_DU', 's_NH', 's_NO', 's_OC', 's_SO4', 's_SS' ) |
---|
10750 | IF ( ALLOCATED( s_mass_av ) ) THEN |
---|
10751 | IF ( is_used( prtcl, TRIM( variable(9:) ) ) ) THEN ! 9: remove salsa_s_ |
---|
10752 | found_index = get_index( prtcl, TRIM( variable(9:) ) ) |
---|
10753 | DO i = nxlg, nxrg |
---|
10754 | DO j = nysg, nyng |
---|
10755 | DO k = nzb, nzt+1 |
---|
10756 | s_mass_av(k,j,i,found_index) = s_mass_av(k,j,i,found_index) / & |
---|
10757 | REAL( average_count_3d, KIND=wp ) |
---|
10758 | ENDDO |
---|
10759 | ENDDO |
---|
10760 | ENDDO |
---|
10761 | ENDIF |
---|
10762 | ENDIF |
---|
10763 | |
---|
10764 | CASE ( 's_H2O' ) |
---|
10765 | to_be_resorted => s_h2o_av |
---|
10766 | DO i = nxlg, nxrg |
---|
10767 | DO j = nysg, nyng |
---|
10768 | DO k = nzb, nzt+1 |
---|
10769 | to_be_resorted(k,j,i) = to_be_resorted(k,j,i) / & |
---|
10770 | REAL( average_count_3d, KIND=wp ) |
---|
10771 | ENDDO |
---|
10772 | ENDDO |
---|
10773 | ENDDO |
---|
10774 | |
---|
10775 | END SELECT |
---|
10776 | |
---|
10777 | ENDIF |
---|
10778 | ENDIF |
---|
10779 | |
---|
10780 | END SUBROUTINE salsa_3d_data_averaging |
---|
10781 | |
---|
10782 | |
---|
10783 | !------------------------------------------------------------------------------! |
---|
10784 | ! |
---|
10785 | ! Description: |
---|
10786 | ! ------------ |
---|
10787 | !> Subroutine defining 2D output variables |
---|
10788 | !------------------------------------------------------------------------------! |
---|
10789 | SUBROUTINE salsa_data_output_2d( av, variable, found, grid, mode, local_pf, two_d, nzb_do, nzt_do ) |
---|
10790 | |
---|
10791 | USE indices |
---|
10792 | |
---|
10793 | USE kinds |
---|
10794 | |
---|
10795 | |
---|
10796 | IMPLICIT NONE |
---|
10797 | |
---|
10798 | CHARACTER(LEN=*) :: grid !< |
---|
10799 | CHARACTER(LEN=*) :: mode !< |
---|
10800 | CHARACTER(LEN=*) :: variable !< |
---|
10801 | CHARACTER(LEN=5) :: vari !< trimmed format of variable |
---|
10802 | |
---|
10803 | INTEGER(iwp) :: av !< |
---|
10804 | INTEGER(iwp) :: char_to_int !< for converting character to integer |
---|
10805 | INTEGER(iwp) :: found_index !< index of a chemical compound |
---|
10806 | INTEGER(iwp) :: i !< |
---|
10807 | INTEGER(iwp) :: ib !< running index: size bins |
---|
10808 | INTEGER(iwp) :: ic !< running index: mass bins |
---|
10809 | INTEGER(iwp) :: j !< |
---|
10810 | INTEGER(iwp) :: k !< |
---|
10811 | INTEGER(iwp) :: nzb_do !< |
---|
10812 | INTEGER(iwp) :: nzt_do !< |
---|
10813 | |
---|
10814 | LOGICAL :: found !< |
---|
10815 | LOGICAL :: two_d !< flag parameter to indicate 2D variables (horizontal cross sections) |
---|
10816 | |
---|
10817 | REAL(wp) :: df !< For calculating LDSA: fraction of particles |
---|
10818 | !< depositing in the alveolar (or tracheobronchial) |
---|
10819 | !< region of the lung. Depends on the particle size |
---|
10820 | REAL(wp) :: mean_d !< Particle diameter in micrometres |
---|
10821 | REAL(wp) :: temp_bin !< temporary array for calculating output variables |
---|
10822 | |
---|
10823 | REAL(wp), DIMENSION(nxl:nxr,nys:nyn,nzb_do:nzt_do) :: local_pf !< output |
---|
10824 | ! |
---|
10825 | !-- Next statement is to avoid compiler warning about unused variable. May be removed in future. |
---|
10826 | IF ( two_d ) CONTINUE |
---|
10827 | |
---|
10828 | found = .TRUE. |
---|
10829 | temp_bin = 0.0_wp |
---|
10830 | |
---|
10831 | IF ( variable(7:11) == 'N_bin' ) THEN |
---|
10832 | |
---|
10833 | READ( variable( 12:LEN( TRIM( variable ) ) - 3 ), * ) char_to_int |
---|
10834 | IF ( char_to_int >= 1 .AND. char_to_int <= SUM( nbin ) ) THEN |
---|
10835 | |
---|
10836 | ib = char_to_int |
---|
10837 | IF ( av == 0 ) THEN |
---|
10838 | DO i = nxl, nxr |
---|
10839 | DO j = nys, nyn |
---|
10840 | DO k = nzb_do, nzt_do |
---|
10841 | local_pf(i,j,k) = MERGE( aerosol_number(ib)%conc(k,j,i), REAL( fill_value, & |
---|
10842 | KIND = wp ), BTEST( wall_flags_total_0(k,j,i), 0 ) ) |
---|
10843 | ENDDO |
---|
10844 | ENDDO |
---|
10845 | ENDDO |
---|
10846 | ELSE |
---|
10847 | IF ( .NOT. ALLOCATED( nbins_av ) ) THEN |
---|
10848 | ALLOCATE( nbins_av(nzb:nzt+1,nysg:nyng,nxlg:nxrg,nbins_aerosol) ) |
---|
10849 | nbins_av = REAL( fill_value, KIND = wp ) |
---|
10850 | ENDIF |
---|
10851 | DO i = nxl, nxr |
---|
10852 | DO j = nys, nyn |
---|
10853 | DO k = nzb_do, nzt_do |
---|
10854 | local_pf(i,j,k) = MERGE( nbins_av(k,j,i,ib), REAL( fill_value, KIND = wp ), & |
---|
10855 | BTEST( wall_flags_total_0(k,j,i), 0 ) ) |
---|
10856 | ENDDO |
---|
10857 | ENDDO |
---|
10858 | ENDDO |
---|
10859 | ENDIF |
---|
10860 | IF ( mode == 'xy' ) grid = 'zu' |
---|
10861 | ENDIF |
---|
10862 | |
---|
10863 | ELSEIF ( variable(7:11) == 'm_bin' ) THEN |
---|
10864 | |
---|
10865 | READ( variable( 12:LEN( TRIM( variable ) ) - 3 ), * ) char_to_int |
---|
10866 | IF ( char_to_int >= 1 .AND. char_to_int <= SUM( nbin ) ) THEN |
---|
10867 | |
---|
10868 | ib = char_to_int |
---|
10869 | IF ( av == 0 ) THEN |
---|
10870 | DO i = nxl, nxr |
---|
10871 | DO j = nys, nyn |
---|
10872 | DO k = nzb_do, nzt_do |
---|
10873 | temp_bin = 0.0_wp |
---|
10874 | DO ic = ib, ncomponents_mass * nbins_aerosol, nbins_aerosol |
---|
10875 | temp_bin = temp_bin + aerosol_mass(ic)%conc(k,j,i) |
---|
10876 | ENDDO |
---|
10877 | local_pf(i,j,k) = MERGE( temp_bin, REAL( fill_value, KIND = wp ), & |
---|
10878 | BTEST( wall_flags_total_0(k,j,i), 0 ) ) |
---|
10879 | ENDDO |
---|
10880 | ENDDO |
---|
10881 | ENDDO |
---|
10882 | ELSE |
---|
10883 | IF ( .NOT. ALLOCATED( mbins_av ) ) THEN |
---|
10884 | ALLOCATE( mbins_av(nzb:nzt+1,nysg:nyng,nxlg:nxrg,nbins_aerosol) ) |
---|
10885 | mbins_av = REAL( fill_value, KIND = wp ) |
---|
10886 | ENDIF |
---|
10887 | DO i = nxl, nxr |
---|
10888 | DO j = nys, nyn |
---|
10889 | DO k = nzb_do, nzt_do |
---|
10890 | local_pf(i,j,k) = MERGE( mbins_av(k,j,i,ib), REAL( fill_value, KIND = wp ), & |
---|
10891 | BTEST( wall_flags_total_0(k,j,i), 0 ) ) |
---|
10892 | ENDDO |
---|
10893 | ENDDO |
---|
10894 | ENDDO |
---|
10895 | ENDIF |
---|
10896 | IF ( mode == 'xy' ) grid = 'zu' |
---|
10897 | ENDIF |
---|
10898 | |
---|
10899 | ELSE |
---|
10900 | |
---|
10901 | SELECT CASE ( TRIM( variable( 7:LEN( TRIM( variable ) ) - 3 ) ) ) ! cut out _xy, _xz or _yz |
---|
10902 | |
---|
10903 | CASE ( 'g_H2SO4', 'g_HNO3', 'g_NH3', 'g_OCNV', 'g_OCSV' ) |
---|
10904 | vari = TRIM( variable( 9:LEN( TRIM( variable ) ) - 3 ) ) ! 9: remove salsa_g_ |
---|
10905 | IF ( vari == 'H2SO4') found_index = 1 |
---|
10906 | IF ( vari == 'HNO3') found_index = 2 |
---|
10907 | IF ( vari == 'NH3') found_index = 3 |
---|
10908 | IF ( vari == 'OCNV') found_index = 4 |
---|
10909 | IF ( vari == 'OCSV') found_index = 5 |
---|
10910 | IF ( av == 0 ) THEN |
---|
10911 | DO i = nxl, nxr |
---|
10912 | DO j = nys, nyn |
---|
10913 | DO k = nzb_do, nzt_do |
---|
10914 | local_pf(i,j,k) = MERGE( salsa_gas(found_index)%conc(k,j,i), & |
---|
10915 | REAL( fill_value, KIND = wp ), & |
---|
10916 | BTEST( wall_flags_total_0(k,j,i), 0 ) ) |
---|
10917 | ENDDO |
---|
10918 | ENDDO |
---|
10919 | ENDDO |
---|
10920 | ELSE |
---|
10921 | IF ( .NOT. ALLOCATED( salsa_gases_av ) ) THEN |
---|
10922 | ALLOCATE( salsa_gases_av(nzb:nzt+1,nysg:nyng,nxlg:nxrg,ngases_salsa) ) |
---|
10923 | salsa_gases_av = REAL( fill_value, KIND = wp ) |
---|
10924 | ENDIF |
---|
10925 | DO i = nxl, nxr |
---|
10926 | DO j = nys, nyn |
---|
10927 | DO k = nzb_do, nzt_do |
---|
10928 | local_pf(i,j,k) = MERGE( salsa_gases_av(k,j,i,found_index), & |
---|
10929 | REAL( fill_value, KIND = wp ), & |
---|
10930 | BTEST( wall_flags_total_0(k,j,i), 0 ) ) |
---|
10931 | ENDDO |
---|
10932 | ENDDO |
---|
10933 | ENDDO |
---|
10934 | ENDIF |
---|
10935 | |
---|
10936 | IF ( mode == 'xy' ) grid = 'zu' |
---|
10937 | |
---|
10938 | CASE ( 'LDSA' ) |
---|
10939 | IF ( av == 0 ) THEN |
---|
10940 | DO i = nxl, nxr |
---|
10941 | DO j = nys, nyn |
---|
10942 | DO k = nzb_do, nzt_do |
---|
10943 | temp_bin = 0.0_wp |
---|
10944 | DO ib = 1, nbins_aerosol |
---|
10945 | ! |
---|
10946 | !-- Diameter in micrometres |
---|
10947 | mean_d = 1.0E+6_wp * ra_dry(k,j,i,ib) * 2.0_wp |
---|
10948 | ! |
---|
10949 | !-- Deposition factor: alveolar |
---|
10950 | df = ( 0.01555_wp / mean_d ) * ( EXP( -0.416_wp * ( LOG( mean_d ) + & |
---|
10951 | 2.84_wp )**2 ) + 19.11_wp * EXP( -0.482_wp * ( LOG( mean_d ) - & |
---|
10952 | 1.362_wp )**2 ) ) |
---|
10953 | ! |
---|
10954 | !-- Lung-deposited surface area LDSA (units mum2/cm3) |
---|
10955 | temp_bin = temp_bin + pi * mean_d**2 * df * 1.0E-6_wp * & |
---|
10956 | aerosol_number(ib)%conc(k,j,i) |
---|
10957 | ENDDO |
---|
10958 | |
---|
10959 | local_pf(i,j,k) = MERGE( temp_bin, REAL( fill_value, KIND = wp ), & |
---|
10960 | BTEST( wall_flags_total_0(k,j,i), 0 ) ) |
---|
10961 | ENDDO |
---|
10962 | ENDDO |
---|
10963 | ENDDO |
---|
10964 | ELSE |
---|
10965 | IF ( .NOT. ALLOCATED( ldsa_av ) ) THEN |
---|
10966 | ALLOCATE( ldsa_av(nzb:nzt+1,nysg:nyng,nxlg:nxrg) ) |
---|
10967 | ldsa_av = REAL( fill_value, KIND = wp ) |
---|
10968 | ENDIF |
---|
10969 | DO i = nxl, nxr |
---|
10970 | DO j = nys, nyn |
---|
10971 | DO k = nzb_do, nzt_do |
---|
10972 | local_pf(i,j,k) = MERGE( ldsa_av(k,j,i), REAL( fill_value, KIND = wp ), & |
---|
10973 | BTEST( wall_flags_total_0(k,j,i), 0 ) ) |
---|
10974 | ENDDO |
---|
10975 | ENDDO |
---|
10976 | ENDDO |
---|
10977 | ENDIF |
---|
10978 | |
---|
10979 | IF ( mode == 'xy' ) grid = 'zu' |
---|
10980 | |
---|
10981 | CASE ( 'N_UFP' ) |
---|
10982 | |
---|
10983 | IF ( av == 0 ) THEN |
---|
10984 | DO i = nxl, nxr |
---|
10985 | DO j = nys, nyn |
---|
10986 | DO k = nzb_do, nzt_do |
---|
10987 | temp_bin = 0.0_wp |
---|
10988 | DO ib = 1, nbins_aerosol |
---|
10989 | IF ( 2.0_wp * ra_dry(k,j,i,ib) <= 0.1E-6_wp ) THEN |
---|
10990 | temp_bin = temp_bin + aerosol_number(ib)%conc(k,j,i) |
---|
10991 | ENDIF |
---|
10992 | ENDDO |
---|
10993 | local_pf(i,j,k) = MERGE( temp_bin, REAL( fill_value, KIND = wp ), & |
---|
10994 | BTEST( wall_flags_total_0(k,j,i), 0 ) ) |
---|
10995 | ENDDO |
---|
10996 | ENDDO |
---|
10997 | ENDDO |
---|
10998 | ELSE |
---|
10999 | IF ( .NOT. ALLOCATED( nufp_av ) ) THEN |
---|
11000 | ALLOCATE( nufp_av(nzb:nzt+1,nysg:nyng,nxlg:nxrg) ) |
---|
11001 | nufp_av = REAL( fill_value, KIND = wp ) |
---|
11002 | ENDIF |
---|
11003 | DO i = nxl, nxr |
---|
11004 | DO j = nys, nyn |
---|
11005 | DO k = nzb_do, nzt_do |
---|
11006 | local_pf(i,j,k) = MERGE( nufp_av(k,j,i), REAL( fill_value, KIND = wp ), & |
---|
11007 | BTEST( wall_flags_total_0(k,j,i), 0 ) ) |
---|
11008 | ENDDO |
---|
11009 | ENDDO |
---|
11010 | ENDDO |
---|
11011 | ENDIF |
---|
11012 | |
---|
11013 | IF ( mode == 'xy' ) grid = 'zu' |
---|
11014 | |
---|
11015 | CASE ( 'Ntot' ) |
---|
11016 | |
---|
11017 | IF ( av == 0 ) THEN |
---|
11018 | DO i = nxl, nxr |
---|
11019 | DO j = nys, nyn |
---|
11020 | DO k = nzb_do, nzt_do |
---|
11021 | temp_bin = 0.0_wp |
---|
11022 | DO ib = 1, nbins_aerosol |
---|
11023 | temp_bin = temp_bin + aerosol_number(ib)%conc(k,j,i) |
---|
11024 | ENDDO |
---|
11025 | local_pf(i,j,k) = MERGE( temp_bin, REAL( fill_value, KIND = wp ), & |
---|
11026 | BTEST( wall_flags_total_0(k,j,i), 0 ) ) |
---|
11027 | ENDDO |
---|
11028 | ENDDO |
---|
11029 | ENDDO |
---|
11030 | ELSE |
---|
11031 | IF ( .NOT. ALLOCATED( ntot_av ) ) THEN |
---|
11032 | ALLOCATE( ntot_av(nzb:nzt+1,nysg:nyng,nxlg:nxrg) ) |
---|
11033 | ntot_av = REAL( fill_value, KIND = wp ) |
---|
11034 | ENDIF |
---|
11035 | DO i = nxl, nxr |
---|
11036 | DO j = nys, nyn |
---|
11037 | DO k = nzb_do, nzt_do |
---|
11038 | local_pf(i,j,k) = MERGE( ntot_av(k,j,i), REAL( fill_value, KIND = wp ), & |
---|
11039 | BTEST( wall_flags_total_0(k,j,i), 0 ) ) |
---|
11040 | ENDDO |
---|
11041 | ENDDO |
---|
11042 | ENDDO |
---|
11043 | ENDIF |
---|
11044 | |
---|
11045 | IF ( mode == 'xy' ) grid = 'zu' |
---|
11046 | |
---|
11047 | CASE ( 'PM0.1' ) |
---|
11048 | IF ( av == 0 ) THEN |
---|
11049 | DO i = nxl, nxr |
---|
11050 | DO j = nys, nyn |
---|
11051 | DO k = nzb_do, nzt_do |
---|
11052 | temp_bin = 0.0_wp |
---|
11053 | DO ib = 1, nbins_aerosol |
---|
11054 | IF ( 2.0_wp * ra_dry(k,j,i,ib) <= 0.1E-6_wp ) THEN |
---|
11055 | DO ic = ib, nbins_aerosol * ncc, nbins_aerosol |
---|
11056 | temp_bin = temp_bin + aerosol_mass(ic)%conc(k,j,i) |
---|
11057 | ENDDO |
---|
11058 | ENDIF |
---|
11059 | ENDDO |
---|
11060 | local_pf(i,j,k) = MERGE( temp_bin, REAL( fill_value, KIND = wp ), & |
---|
11061 | BTEST( wall_flags_total_0(k,j,i), 0 ) ) |
---|
11062 | ENDDO |
---|
11063 | ENDDO |
---|
11064 | ENDDO |
---|
11065 | ELSE |
---|
11066 | IF ( .NOT. ALLOCATED( pm01_av ) ) THEN |
---|
11067 | ALLOCATE( pm01_av(nzb:nzt+1,nysg:nyng,nxlg:nxrg) ) |
---|
11068 | pm01_av = REAL( fill_value, KIND = wp ) |
---|
11069 | ENDIF |
---|
11070 | DO i = nxl, nxr |
---|
11071 | DO j = nys, nyn |
---|
11072 | DO k = nzb_do, nzt_do |
---|
11073 | local_pf(i,j,k) = MERGE( pm01_av(k,j,i), REAL( fill_value, KIND = wp ), & |
---|
11074 | BTEST( wall_flags_total_0(k,j,i), 0 ) ) |
---|
11075 | ENDDO |
---|
11076 | ENDDO |
---|
11077 | ENDDO |
---|
11078 | ENDIF |
---|
11079 | |
---|
11080 | IF ( mode == 'xy' ) grid = 'zu' |
---|
11081 | |
---|
11082 | CASE ( 'PM2.5' ) |
---|
11083 | IF ( av == 0 ) THEN |
---|
11084 | DO i = nxl, nxr |
---|
11085 | DO j = nys, nyn |
---|
11086 | DO k = nzb_do, nzt_do |
---|
11087 | temp_bin = 0.0_wp |
---|
11088 | DO ib = 1, nbins_aerosol |
---|
11089 | IF ( 2.0_wp * ra_dry(k,j,i,ib) <= 2.5E-6_wp ) THEN |
---|
11090 | DO ic = ib, nbins_aerosol * ncc, nbins_aerosol |
---|
11091 | temp_bin = temp_bin + aerosol_mass(ic)%conc(k,j,i) |
---|
11092 | ENDDO |
---|
11093 | ENDIF |
---|
11094 | ENDDO |
---|
11095 | local_pf(i,j,k) = MERGE( temp_bin, REAL( fill_value, KIND = wp ), & |
---|
11096 | BTEST( wall_flags_total_0(k,j,i), 0 ) ) |
---|
11097 | ENDDO |
---|
11098 | ENDDO |
---|
11099 | ENDDO |
---|
11100 | ELSE |
---|
11101 | IF ( .NOT. ALLOCATED( pm25_av ) ) THEN |
---|
11102 | ALLOCATE( pm25_av(nzb:nzt+1,nysg:nyng,nxlg:nxrg) ) |
---|
11103 | pm25_av = REAL( fill_value, KIND = wp ) |
---|
11104 | ENDIF |
---|
11105 | DO i = nxl, nxr |
---|
11106 | DO j = nys, nyn |
---|
11107 | DO k = nzb_do, nzt_do |
---|
11108 | local_pf(i,j,k) = MERGE( pm25_av(k,j,i), REAL( fill_value, KIND = wp ), & |
---|
11109 | BTEST( wall_flags_total_0(k,j,i), 0 ) ) |
---|
11110 | ENDDO |
---|
11111 | ENDDO |
---|
11112 | ENDDO |
---|
11113 | ENDIF |
---|
11114 | |
---|
11115 | IF ( mode == 'xy' ) grid = 'zu' |
---|
11116 | |
---|
11117 | CASE ( 'PM10' ) |
---|
11118 | IF ( av == 0 ) THEN |
---|
11119 | DO i = nxl, nxr |
---|
11120 | DO j = nys, nyn |
---|
11121 | DO k = nzb_do, nzt_do |
---|
11122 | temp_bin = 0.0_wp |
---|
11123 | DO ib = 1, nbins_aerosol |
---|
11124 | IF ( 2.0_wp * ra_dry(k,j,i,ib) <= 10.0E-6_wp ) THEN |
---|
11125 | DO ic = ib, nbins_aerosol * ncc, nbins_aerosol |
---|
11126 | temp_bin = temp_bin + aerosol_mass(ic)%conc(k,j,i) |
---|
11127 | ENDDO |
---|
11128 | ENDIF |
---|
11129 | ENDDO |
---|
11130 | local_pf(i,j,k) = MERGE( temp_bin, REAL( fill_value, KIND = wp ), & |
---|
11131 | BTEST( wall_flags_total_0(k,j,i), 0 ) ) |
---|
11132 | ENDDO |
---|
11133 | ENDDO |
---|
11134 | ENDDO |
---|
11135 | ELSE |
---|
11136 | IF ( .NOT. ALLOCATED( pm10_av ) ) THEN |
---|
11137 | ALLOCATE( pm10_av(nzb:nzt+1,nysg:nyng,nxlg:nxrg) ) |
---|
11138 | pm10_av = REAL( fill_value, KIND = wp ) |
---|
11139 | ENDIF |
---|
11140 | DO i = nxl, nxr |
---|
11141 | DO j = nys, nyn |
---|
11142 | DO k = nzb_do, nzt_do |
---|
11143 | local_pf(i,j,k) = MERGE( pm10_av(k,j,i), REAL( fill_value, KIND = wp ), & |
---|
11144 | BTEST( wall_flags_total_0(k,j,i), 0 ) ) |
---|
11145 | ENDDO |
---|
11146 | ENDDO |
---|
11147 | ENDDO |
---|
11148 | ENDIF |
---|
11149 | |
---|
11150 | IF ( mode == 'xy' ) grid = 'zu' |
---|
11151 | |
---|
11152 | CASE ( 's_BC', 's_DU', 's_NH', 's_NO', 's_OC', 's_SO4', 's_SS' ) |
---|
11153 | vari = TRIM( variable( 9:LEN( TRIM( variable ) ) - 3 ) ) ! 9: remove salsa_s_ |
---|
11154 | IF ( is_used( prtcl, vari ) ) THEN |
---|
11155 | found_index = get_index( prtcl, vari ) |
---|
11156 | IF ( av == 0 ) THEN |
---|
11157 | DO i = nxl, nxr |
---|
11158 | DO j = nys, nyn |
---|
11159 | DO k = nzb_do, nzt_do |
---|
11160 | temp_bin = 0.0_wp |
---|
11161 | DO ic = ( found_index-1 ) * nbins_aerosol+1, found_index * nbins_aerosol |
---|
11162 | temp_bin = temp_bin + aerosol_mass(ic)%conc(k,j,i) |
---|
11163 | ENDDO |
---|
11164 | local_pf(i,j,k) = MERGE( temp_bin, REAL( fill_value, KIND = wp ), & |
---|
11165 | BTEST( wall_flags_total_0(k,j,i), 0 ) ) |
---|
11166 | ENDDO |
---|
11167 | ENDDO |
---|
11168 | ENDDO |
---|
11169 | ELSE |
---|
11170 | IF ( .NOT. ALLOCATED( s_mass_av ) ) THEN |
---|
11171 | ALLOCATE( s_mass_av(nzb:nzt+1,nysg:nyng,nxlg:nxrg,ncomponents_mass) ) |
---|
11172 | s_mass_av = REAL( fill_value, KIND = wp ) |
---|
11173 | ENDIF |
---|
11174 | DO i = nxl, nxr |
---|
11175 | DO j = nys, nyn |
---|
11176 | DO k = nzb_do, nzt_do |
---|
11177 | local_pf(i,j,k) = MERGE( s_mass_av(k,j,i,found_index), & |
---|
11178 | REAL( fill_value, KIND = wp ), & |
---|
11179 | BTEST( wall_flags_total_0(k,j,i), 0 ) ) |
---|
11180 | ENDDO |
---|
11181 | ENDDO |
---|
11182 | ENDDO |
---|
11183 | ENDIF |
---|
11184 | ELSE |
---|
11185 | local_pf = fill_value |
---|
11186 | ENDIF |
---|
11187 | |
---|
11188 | IF ( mode == 'xy' ) grid = 'zu' |
---|
11189 | |
---|
11190 | CASE ( 's_H2O' ) |
---|
11191 | found_index = get_index( prtcl, 'H2O' ) |
---|
11192 | IF ( av == 0 ) THEN |
---|
11193 | DO i = nxl, nxr |
---|
11194 | DO j = nys, nyn |
---|
11195 | DO k = nzb_do, nzt_do |
---|
11196 | temp_bin = 0.0_wp |
---|
11197 | DO ic = ( found_index-1 ) * nbins_aerosol+1, found_index * nbins_aerosol |
---|
11198 | temp_bin = temp_bin + aerosol_mass(ic)%conc(k,j,i) |
---|
11199 | ENDDO |
---|
11200 | local_pf(i,j,k) = MERGE( temp_bin, REAL( fill_value, KIND = wp ), & |
---|
11201 | BTEST( wall_flags_total_0(k,j,i), 0 ) ) |
---|
11202 | ENDDO |
---|
11203 | ENDDO |
---|
11204 | ENDDO |
---|
11205 | ELSE |
---|
11206 | ! to_be_resorted => s_h2o_av |
---|
11207 | IF ( .NOT. ALLOCATED( s_h2o_av ) ) THEN |
---|
11208 | ALLOCATE( s_h2o_av(nzb:nzt+1,nysg:nyng,nxlg:nxrg) ) |
---|
11209 | s_h2o_av = REAL( fill_value, KIND = wp ) |
---|
11210 | ENDIF |
---|
11211 | DO i = nxl, nxr |
---|
11212 | DO j = nys, nyn |
---|
11213 | DO k = nzb_do, nzt_do |
---|
11214 | local_pf(i,j,k) = MERGE( s_h2o_av(k,j,i), REAL( fill_value, KIND = wp ), & |
---|
11215 | BTEST( wall_flags_total_0(k,j,i), 0 ) ) |
---|
11216 | ENDDO |
---|
11217 | ENDDO |
---|
11218 | ENDDO |
---|
11219 | ENDIF |
---|
11220 | |
---|
11221 | IF ( mode == 'xy' ) grid = 'zu' |
---|
11222 | |
---|
11223 | CASE DEFAULT |
---|
11224 | found = .FALSE. |
---|
11225 | grid = 'none' |
---|
11226 | |
---|
11227 | END SELECT |
---|
11228 | |
---|
11229 | ENDIF |
---|
11230 | |
---|
11231 | END SUBROUTINE salsa_data_output_2d |
---|
11232 | |
---|
11233 | !------------------------------------------------------------------------------! |
---|
11234 | ! |
---|
11235 | ! Description: |
---|
11236 | ! ------------ |
---|
11237 | !> Subroutine defining 3D output variables |
---|
11238 | !------------------------------------------------------------------------------! |
---|
11239 | SUBROUTINE salsa_data_output_3d( av, variable, found, local_pf, nzb_do, nzt_do ) |
---|
11240 | |
---|
11241 | USE indices |
---|
11242 | |
---|
11243 | USE kinds |
---|
11244 | |
---|
11245 | |
---|
11246 | IMPLICIT NONE |
---|
11247 | |
---|
11248 | CHARACTER(LEN=*), INTENT(in) :: variable !< |
---|
11249 | |
---|
11250 | INTEGER(iwp) :: av !< |
---|
11251 | INTEGER(iwp) :: char_to_int !< for converting character to integer |
---|
11252 | INTEGER(iwp) :: found_index !< index of a chemical compound |
---|
11253 | INTEGER(iwp) :: ib !< running index: size bins |
---|
11254 | INTEGER(iwp) :: ic !< running index: mass bins |
---|
11255 | INTEGER(iwp) :: i !< |
---|
11256 | INTEGER(iwp) :: j !< |
---|
11257 | INTEGER(iwp) :: k !< |
---|
11258 | INTEGER(iwp) :: nzb_do !< |
---|
11259 | INTEGER(iwp) :: nzt_do !< |
---|
11260 | |
---|
11261 | LOGICAL :: found !< |
---|
11262 | |
---|
11263 | REAL(wp) :: df !< For calculating LDSA: fraction of particles |
---|
11264 | !< depositing in the alveolar (or tracheobronchial) |
---|
11265 | !< region of the lung. Depends on the particle size |
---|
11266 | REAL(wp) :: mean_d !< Particle diameter in micrometres |
---|
11267 | REAL(wp) :: temp_bin !< temporary array for calculating output variables |
---|
11268 | |
---|
11269 | REAL(sp), DIMENSION(nxl:nxr,nys:nyn,nzb_do:nzt_do) :: local_pf !< local |
---|
11270 | |
---|
11271 | found = .TRUE. |
---|
11272 | temp_bin = 0.0_wp |
---|
11273 | |
---|
11274 | IF ( variable(7:11) == 'N_bin' ) THEN |
---|
11275 | READ( variable(12:),* ) char_to_int |
---|
11276 | IF ( char_to_int >= 1 .AND. char_to_int <= SUM( nbin ) ) THEN |
---|
11277 | |
---|
11278 | ib = char_to_int |
---|
11279 | IF ( av == 0 ) THEN |
---|
11280 | DO i = nxl, nxr |
---|
11281 | DO j = nys, nyn |
---|
11282 | DO k = nzb_do, nzt_do |
---|
11283 | local_pf(i,j,k) = MERGE( aerosol_number(ib)%conc(k,j,i), REAL( fill_value, & |
---|
11284 | KIND = wp ), BTEST( wall_flags_total_0(k,j,i), 0 ) ) |
---|
11285 | ENDDO |
---|
11286 | ENDDO |
---|
11287 | ENDDO |
---|
11288 | ELSE |
---|
11289 | IF ( .NOT. ALLOCATED( nbins_av ) ) THEN |
---|
11290 | ALLOCATE( nbins_av(nzb:nzt+1,nysg:nyng,nxlg:nxrg,nbins_aerosol) ) |
---|
11291 | nbins_av = REAL( fill_value, KIND = wp ) |
---|
11292 | ENDIF |
---|
11293 | DO i = nxl, nxr |
---|
11294 | DO j = nys, nyn |
---|
11295 | DO k = nzb_do, nzt_do |
---|
11296 | local_pf(i,j,k) = MERGE( nbins_av(k,j,i,ib), REAL( fill_value, KIND = wp ), & |
---|
11297 | BTEST( wall_flags_total_0(k,j,i), 0 ) ) |
---|
11298 | ENDDO |
---|
11299 | ENDDO |
---|
11300 | ENDDO |
---|
11301 | ENDIF |
---|
11302 | ENDIF |
---|
11303 | |
---|
11304 | ELSEIF ( variable(7:11) == 'm_bin' ) THEN |
---|
11305 | READ( variable(12:),* ) char_to_int |
---|
11306 | IF ( char_to_int >= 1 .AND. char_to_int <= SUM( nbin ) ) THEN |
---|
11307 | |
---|
11308 | ib = char_to_int |
---|
11309 | IF ( av == 0 ) THEN |
---|
11310 | DO i = nxl, nxr |
---|
11311 | DO j = nys, nyn |
---|
11312 | DO k = nzb_do, nzt_do |
---|
11313 | temp_bin = 0.0_wp |
---|
11314 | DO ic = ib, ncomponents_mass * nbins_aerosol, nbins_aerosol |
---|
11315 | temp_bin = temp_bin + aerosol_mass(ic)%conc(k,j,i) |
---|
11316 | ENDDO |
---|
11317 | local_pf(i,j,k) = MERGE( temp_bin, REAL( fill_value, KIND = wp ), & |
---|
11318 | BTEST( wall_flags_total_0(k,j,i), 0 ) ) |
---|
11319 | ENDDO |
---|
11320 | ENDDO |
---|
11321 | ENDDO |
---|
11322 | ELSE |
---|
11323 | IF ( .NOT. ALLOCATED( mbins_av ) ) THEN |
---|
11324 | ALLOCATE( mbins_av(nzb:nzt+1,nysg:nyng,nxlg:nxrg,nbins_aerosol) ) |
---|
11325 | mbins_av = REAL( fill_value, KIND = wp ) |
---|
11326 | ENDIF |
---|
11327 | DO i = nxl, nxr |
---|
11328 | DO j = nys, nyn |
---|
11329 | DO k = nzb_do, nzt_do |
---|
11330 | local_pf(i,j,k) = MERGE( mbins_av(k,j,i,ib), REAL( fill_value, KIND = wp ), & |
---|
11331 | BTEST( wall_flags_total_0(k,j,i), 0 ) ) |
---|
11332 | ENDDO |
---|
11333 | ENDDO |
---|
11334 | ENDDO |
---|
11335 | ENDIF |
---|
11336 | ENDIF |
---|
11337 | |
---|
11338 | ELSE |
---|
11339 | SELECT CASE ( TRIM( variable(7:) ) ) |
---|
11340 | |
---|
11341 | CASE ( 'g_H2SO4', 'g_HNO3', 'g_NH3', 'g_OCNV', 'g_OCSV' ) |
---|
11342 | IF ( TRIM( variable(7:) ) == 'g_H2SO4') found_index = 1 |
---|
11343 | IF ( TRIM( variable(7:) ) == 'g_HNO3') found_index = 2 |
---|
11344 | IF ( TRIM( variable(7:) ) == 'g_NH3') found_index = 3 |
---|
11345 | IF ( TRIM( variable(7:) ) == 'g_OCNV') found_index = 4 |
---|
11346 | IF ( TRIM( variable(7:) ) == 'g_OCSV') found_index = 5 |
---|
11347 | |
---|
11348 | IF ( av == 0 ) THEN |
---|
11349 | DO i = nxl, nxr |
---|
11350 | DO j = nys, nyn |
---|
11351 | DO k = nzb_do, nzt_do |
---|
11352 | local_pf(i,j,k) = MERGE( salsa_gas(found_index)%conc(k,j,i), & |
---|
11353 | REAL( fill_value, KIND = wp ), & |
---|
11354 | BTEST( wall_flags_total_0(k,j,i), 0 ) ) |
---|
11355 | ENDDO |
---|
11356 | ENDDO |
---|
11357 | ENDDO |
---|
11358 | ELSE |
---|
11359 | IF ( .NOT. ALLOCATED( salsa_gases_av ) ) THEN |
---|
11360 | ALLOCATE( salsa_gases_av(nzb:nzt+1,nysg:nyng,nxlg:nxrg,ngases_salsa) ) |
---|
11361 | salsa_gases_av = REAL( fill_value, KIND = wp ) |
---|
11362 | ENDIF |
---|
11363 | DO i = nxl, nxr |
---|
11364 | DO j = nys, nyn |
---|
11365 | DO k = nzb_do, nzt_do |
---|
11366 | ! local_pf(i,j,k) = MERGE( to_be_resorted(k,j,i), REAL( fill_value, & |
---|
11367 | ! KIND = wp ), BTEST( wall_flags_total_0(k,j,i), 0 ) ) |
---|
11368 | local_pf(i,j,k) = MERGE( salsa_gases_av(k,j,i,found_index), & |
---|
11369 | REAL( fill_value, KIND = wp ), & |
---|
11370 | BTEST( wall_flags_total_0(k,j,i), 0 ) ) |
---|
11371 | ENDDO |
---|
11372 | ENDDO |
---|
11373 | ENDDO |
---|
11374 | ENDIF |
---|
11375 | |
---|
11376 | CASE ( 'LDSA' ) |
---|
11377 | IF ( av == 0 ) THEN |
---|
11378 | DO i = nxl, nxr |
---|
11379 | DO j = nys, nyn |
---|
11380 | DO k = nzb_do, nzt_do |
---|
11381 | temp_bin = 0.0_wp |
---|
11382 | DO ib = 1, nbins_aerosol |
---|
11383 | ! |
---|
11384 | !-- Diameter in micrometres |
---|
11385 | mean_d = 1.0E+6_wp * ra_dry(k,j,i,ib) * 2.0_wp |
---|
11386 | ! |
---|
11387 | !-- Deposition factor: alveolar |
---|
11388 | df = ( 0.01555_wp / mean_d ) * ( EXP( -0.416_wp * ( LOG( mean_d ) + & |
---|
11389 | 2.84_wp )**2 ) + 19.11_wp * EXP( -0.482_wp * ( LOG( mean_d ) - & |
---|
11390 | 1.362_wp )**2 ) ) |
---|
11391 | ! |
---|
11392 | !-- Lung-deposited surface area LDSA (units mum2/cm3) |
---|
11393 | temp_bin = temp_bin + pi * mean_d**2 * df * 1.0E-6_wp * & |
---|
11394 | aerosol_number(ib)%conc(k,j,i) |
---|
11395 | ENDDO |
---|
11396 | local_pf(i,j,k) = MERGE( temp_bin, REAL( fill_value, KIND = wp ), & |
---|
11397 | BTEST( wall_flags_total_0(k,j,i), 0 ) ) |
---|
11398 | ENDDO |
---|
11399 | ENDDO |
---|
11400 | ENDDO |
---|
11401 | ELSE |
---|
11402 | IF ( .NOT. ALLOCATED( ldsa_av ) ) THEN |
---|
11403 | ALLOCATE( ldsa_av(nzb:nzt+1,nysg:nyng,nxlg:nxrg) ) |
---|
11404 | ldsa_av = REAL( fill_value, KIND = wp ) |
---|
11405 | ENDIF |
---|
11406 | DO i = nxl, nxr |
---|
11407 | DO j = nys, nyn |
---|
11408 | DO k = nzb_do, nzt_do |
---|
11409 | local_pf(i,j,k) = MERGE( ldsa_av(k,j,i), REAL( fill_value, KIND = wp ), & |
---|
11410 | BTEST( wall_flags_total_0(k,j,i), 0 ) ) |
---|
11411 | ENDDO |
---|
11412 | ENDDO |
---|
11413 | ENDDO |
---|
11414 | ENDIF |
---|
11415 | |
---|
11416 | CASE ( 'N_UFP' ) |
---|
11417 | IF ( av == 0 ) THEN |
---|
11418 | DO i = nxl, nxr |
---|
11419 | DO j = nys, nyn |
---|
11420 | DO k = nzb_do, nzt_do |
---|
11421 | temp_bin = 0.0_wp |
---|
11422 | DO ib = 1, nbins_aerosol |
---|
11423 | IF ( 2.0_wp * ra_dry(k,j,i,ib) <= 0.1E-6_wp ) THEN |
---|
11424 | temp_bin = temp_bin + aerosol_number(ib)%conc(k,j,i) |
---|
11425 | ENDIF |
---|
11426 | ENDDO |
---|
11427 | local_pf(i,j,k) = MERGE( temp_bin, REAL( fill_value, KIND = wp ), & |
---|
11428 | BTEST( wall_flags_total_0(k,j,i), 0 ) ) |
---|
11429 | ENDDO |
---|
11430 | ENDDO |
---|
11431 | ENDDO |
---|
11432 | ELSE |
---|
11433 | IF ( .NOT. ALLOCATED( nufp_av ) ) THEN |
---|
11434 | ALLOCATE( nufp_av(nzb:nzt+1,nysg:nyng,nxlg:nxrg) ) |
---|
11435 | nufp_av = REAL( fill_value, KIND = wp ) |
---|
11436 | ENDIF |
---|
11437 | DO i = nxl, nxr |
---|
11438 | DO j = nys, nyn |
---|
11439 | DO k = nzb_do, nzt_do |
---|
11440 | local_pf(i,j,k) = MERGE( nufp_av(k,j,i), REAL( fill_value, KIND = wp ), & |
---|
11441 | BTEST( wall_flags_total_0(k,j,i), 0 ) ) |
---|
11442 | ENDDO |
---|
11443 | ENDDO |
---|
11444 | ENDDO |
---|
11445 | ENDIF |
---|
11446 | |
---|
11447 | CASE ( 'Ntot' ) |
---|
11448 | IF ( av == 0 ) THEN |
---|
11449 | DO i = nxl, nxr |
---|
11450 | DO j = nys, nyn |
---|
11451 | DO k = nzb_do, nzt_do |
---|
11452 | temp_bin = 0.0_wp |
---|
11453 | DO ib = 1, nbins_aerosol |
---|
11454 | temp_bin = temp_bin + aerosol_number(ib)%conc(k,j,i) |
---|
11455 | ENDDO |
---|
11456 | local_pf(i,j,k) = MERGE( temp_bin, REAL( fill_value, KIND = wp ), & |
---|
11457 | BTEST( wall_flags_total_0(k,j,i), 0 ) ) |
---|
11458 | ENDDO |
---|
11459 | ENDDO |
---|
11460 | ENDDO |
---|
11461 | ELSE |
---|
11462 | IF ( .NOT. ALLOCATED( ntot_av ) ) THEN |
---|
11463 | ALLOCATE( ntot_av(nzb:nzt+1,nysg:nyng,nxlg:nxrg) ) |
---|
11464 | ntot_av = REAL( fill_value, KIND = wp ) |
---|
11465 | ENDIF |
---|
11466 | DO i = nxl, nxr |
---|
11467 | DO j = nys, nyn |
---|
11468 | DO k = nzb_do, nzt_do |
---|
11469 | local_pf(i,j,k) = MERGE( ntot_av(k,j,i), REAL( fill_value, KIND = wp ), & |
---|
11470 | BTEST( wall_flags_total_0(k,j,i), 0 ) ) |
---|
11471 | ENDDO |
---|
11472 | ENDDO |
---|
11473 | ENDDO |
---|
11474 | ENDIF |
---|
11475 | |
---|
11476 | CASE ( 'PM0.1' ) |
---|
11477 | IF ( av == 0 ) THEN |
---|
11478 | DO i = nxl, nxr |
---|
11479 | DO j = nys, nyn |
---|
11480 | DO k = nzb_do, nzt_do |
---|
11481 | temp_bin = 0.0_wp |
---|
11482 | DO ib = 1, nbins_aerosol |
---|
11483 | IF ( 2.0_wp * ra_dry(k,j,i,ib) <= 0.1E-6_wp ) THEN |
---|
11484 | DO ic = ib, nbins_aerosol * ncc, nbins_aerosol |
---|
11485 | temp_bin = temp_bin + aerosol_mass(ic)%conc(k,j,i) |
---|
11486 | ENDDO |
---|
11487 | ENDIF |
---|
11488 | ENDDO |
---|
11489 | local_pf(i,j,k) = MERGE( temp_bin, REAL( fill_value, KIND = wp ), & |
---|
11490 | BTEST( wall_flags_total_0(k,j,i), 0 ) ) |
---|
11491 | ENDDO |
---|
11492 | ENDDO |
---|
11493 | ENDDO |
---|
11494 | ELSE |
---|
11495 | IF ( .NOT. ALLOCATED( pm01_av ) ) THEN |
---|
11496 | ALLOCATE( pm01_av(nzb:nzt+1,nysg:nyng,nxlg:nxrg) ) |
---|
11497 | pm01_av = REAL( fill_value, KIND = wp ) |
---|
11498 | ENDIF |
---|
11499 | DO i = nxl, nxr |
---|
11500 | DO j = nys, nyn |
---|
11501 | DO k = nzb_do, nzt_do |
---|
11502 | local_pf(i,j,k) = MERGE( pm01_av(k,j,i), REAL( fill_value, KIND = wp ), & |
---|
11503 | BTEST( wall_flags_total_0(k,j,i), 0 ) ) |
---|
11504 | ENDDO |
---|
11505 | ENDDO |
---|
11506 | ENDDO |
---|
11507 | ENDIF |
---|
11508 | |
---|
11509 | CASE ( 'PM2.5' ) |
---|
11510 | IF ( av == 0 ) THEN |
---|
11511 | DO i = nxl, nxr |
---|
11512 | DO j = nys, nyn |
---|
11513 | DO k = nzb_do, nzt_do |
---|
11514 | temp_bin = 0.0_wp |
---|
11515 | DO ib = 1, nbins_aerosol |
---|
11516 | IF ( 2.0_wp * ra_dry(k,j,i,ib) <= 2.5E-6_wp ) THEN |
---|
11517 | DO ic = ib, nbins_aerosol * ncc, nbins_aerosol |
---|
11518 | temp_bin = temp_bin + aerosol_mass(ic)%conc(k,j,i) |
---|
11519 | ENDDO |
---|
11520 | ENDIF |
---|
11521 | ENDDO |
---|
11522 | local_pf(i,j,k) = MERGE( temp_bin, REAL( fill_value, KIND = wp ), & |
---|
11523 | BTEST( wall_flags_total_0(k,j,i), 0 ) ) |
---|
11524 | ENDDO |
---|
11525 | ENDDO |
---|
11526 | ENDDO |
---|
11527 | ELSE |
---|
11528 | IF ( .NOT. ALLOCATED( pm25_av ) ) THEN |
---|
11529 | ALLOCATE( pm25_av(nzb:nzt+1,nysg:nyng,nxlg:nxrg) ) |
---|
11530 | pm25_av = REAL( fill_value, KIND = wp ) |
---|
11531 | ENDIF |
---|
11532 | DO i = nxl, nxr |
---|
11533 | DO j = nys, nyn |
---|
11534 | DO k = nzb_do, nzt_do |
---|
11535 | local_pf(i,j,k) = MERGE( pm25_av(k,j,i), REAL( fill_value, KIND = wp ), & |
---|
11536 | BTEST( wall_flags_total_0(k,j,i), 0 ) ) |
---|
11537 | ENDDO |
---|
11538 | ENDDO |
---|
11539 | ENDDO |
---|
11540 | ENDIF |
---|
11541 | |
---|
11542 | CASE ( 'PM10' ) |
---|
11543 | IF ( av == 0 ) THEN |
---|
11544 | DO i = nxl, nxr |
---|
11545 | DO j = nys, nyn |
---|
11546 | DO k = nzb_do, nzt_do |
---|
11547 | temp_bin = 0.0_wp |
---|
11548 | DO ib = 1, nbins_aerosol |
---|
11549 | IF ( 2.0_wp * ra_dry(k,j,i,ib) <= 10.0E-6_wp ) THEN |
---|
11550 | DO ic = ib, nbins_aerosol * ncc, nbins_aerosol |
---|
11551 | temp_bin = temp_bin + aerosol_mass(ic)%conc(k,j,i) |
---|
11552 | ENDDO |
---|
11553 | ENDIF |
---|
11554 | ENDDO |
---|
11555 | local_pf(i,j,k) = MERGE( temp_bin, REAL( fill_value, KIND = wp ), & |
---|
11556 | BTEST( wall_flags_total_0(k,j,i), 0 ) ) |
---|
11557 | ENDDO |
---|
11558 | ENDDO |
---|
11559 | ENDDO |
---|
11560 | ELSE |
---|
11561 | IF ( .NOT. ALLOCATED( pm10_av ) ) THEN |
---|
11562 | ALLOCATE( pm10_av(nzb:nzt+1,nysg:nyng,nxlg:nxrg) ) |
---|
11563 | pm10_av = REAL( fill_value, KIND = wp ) |
---|
11564 | ENDIF |
---|
11565 | DO i = nxl, nxr |
---|
11566 | DO j = nys, nyn |
---|
11567 | DO k = nzb_do, nzt_do |
---|
11568 | local_pf(i,j,k) = MERGE( pm10_av(k,j,i), REAL( fill_value, KIND = wp ), & |
---|
11569 | BTEST( wall_flags_total_0(k,j,i), 0 ) ) |
---|
11570 | ENDDO |
---|
11571 | ENDDO |
---|
11572 | ENDDO |
---|
11573 | ENDIF |
---|
11574 | |
---|
11575 | CASE ( 's_BC', 's_DU', 's_NH', 's_NO', 's_OC', 's_SO4', 's_SS' ) |
---|
11576 | IF ( is_used( prtcl, TRIM( variable(9:) ) ) ) THEN ! 9: remove salsa_s_ |
---|
11577 | found_index = get_index( prtcl, TRIM( variable(9:) ) ) |
---|
11578 | IF ( av == 0 ) THEN |
---|
11579 | DO i = nxl, nxr |
---|
11580 | DO j = nys, nyn |
---|
11581 | DO k = nzb_do, nzt_do |
---|
11582 | temp_bin = 0.0_wp |
---|
11583 | DO ic = ( found_index-1 ) * nbins_aerosol + 1, found_index * nbins_aerosol |
---|
11584 | temp_bin = temp_bin + aerosol_mass(ic)%conc(k,j,i) |
---|
11585 | ENDDO |
---|
11586 | local_pf(i,j,k) = MERGE( temp_bin, REAL( fill_value, KIND = wp ), & |
---|
11587 | BTEST( wall_flags_total_0(k,j,i), 0 ) ) |
---|
11588 | ENDDO |
---|
11589 | ENDDO |
---|
11590 | ENDDO |
---|
11591 | ELSE |
---|
11592 | IF ( .NOT. ALLOCATED( s_mass_av ) ) THEN |
---|
11593 | ALLOCATE( s_mass_av(nzb:nzt+1,nysg:nyng,nxlg:nxrg,ncomponents_mass) ) |
---|
11594 | s_mass_av = REAL( fill_value, KIND = wp ) |
---|
11595 | ENDIF |
---|
11596 | DO i = nxl, nxr |
---|
11597 | DO j = nys, nyn |
---|
11598 | DO k = nzb_do, nzt_do |
---|
11599 | local_pf(i,j,k) = MERGE( s_mass_av(k,j,i,found_index), & |
---|
11600 | REAL( fill_value, KIND = wp ), & |
---|
11601 | BTEST( wall_flags_total_0(k,j,i), 0 ) ) |
---|
11602 | ENDDO |
---|
11603 | ENDDO |
---|
11604 | ENDDO |
---|
11605 | ENDIF |
---|
11606 | ENDIF |
---|
11607 | |
---|
11608 | CASE ( 's_H2O' ) |
---|
11609 | found_index = get_index( prtcl, 'H2O' ) |
---|
11610 | IF ( av == 0 ) THEN |
---|
11611 | DO i = nxl, nxr |
---|
11612 | DO j = nys, nyn |
---|
11613 | DO k = nzb_do, nzt_do |
---|
11614 | temp_bin = 0.0_wp |
---|
11615 | DO ic = ( found_index-1 ) * nbins_aerosol + 1, found_index * nbins_aerosol |
---|
11616 | temp_bin = temp_bin + aerosol_mass(ic)%conc(k,j,i) |
---|
11617 | ENDDO |
---|
11618 | local_pf(i,j,k) = MERGE( temp_bin, REAL( fill_value, KIND = wp ), & |
---|
11619 | BTEST( wall_flags_total_0(k,j,i), 0 ) ) |
---|
11620 | ENDDO |
---|
11621 | ENDDO |
---|
11622 | ENDDO |
---|
11623 | ELSE |
---|
11624 | IF ( .NOT. ALLOCATED( s_h2o_av ) ) THEN |
---|
11625 | ALLOCATE( s_h2o_av(nzb:nzt+1,nysg:nyng,nxlg:nxrg) ) |
---|
11626 | s_h2o_av = REAL( fill_value, KIND = wp ) |
---|
11627 | ENDIF |
---|
11628 | DO i = nxl, nxr |
---|
11629 | DO j = nys, nyn |
---|
11630 | DO k = nzb_do, nzt_do |
---|
11631 | local_pf(i,j,k) = MERGE( s_h2o_av(k,j,i), REAL( fill_value, KIND = wp ), & |
---|
11632 | BTEST( wall_flags_total_0(k,j,i), 0 ) ) |
---|
11633 | ENDDO |
---|
11634 | ENDDO |
---|
11635 | ENDDO |
---|
11636 | ENDIF |
---|
11637 | |
---|
11638 | CASE DEFAULT |
---|
11639 | found = .FALSE. |
---|
11640 | |
---|
11641 | END SELECT |
---|
11642 | ENDIF |
---|
11643 | |
---|
11644 | END SUBROUTINE salsa_data_output_3d |
---|
11645 | |
---|
11646 | !------------------------------------------------------------------------------! |
---|
11647 | ! |
---|
11648 | ! Description: |
---|
11649 | ! ------------ |
---|
11650 | !> Subroutine defining mask output variables |
---|
11651 | !------------------------------------------------------------------------------! |
---|
11652 | SUBROUTINE salsa_data_output_mask( av, variable, found, local_pf, mid ) |
---|
11653 | |
---|
11654 | USE arrays_3d, & |
---|
11655 | ONLY: tend |
---|
11656 | |
---|
11657 | USE control_parameters, & |
---|
11658 | ONLY: mask_i, mask_j, mask_k, mask_size_l, mask_surface, nz_do3d |
---|
11659 | |
---|
11660 | IMPLICIT NONE |
---|
11661 | |
---|
11662 | CHARACTER(LEN=5) :: grid !< flag to distinquish between staggered grid |
---|
11663 | CHARACTER(LEN=*) :: variable !< |
---|
11664 | CHARACTER(LEN=7) :: vari !< trimmed format of variable |
---|
11665 | |
---|
11666 | INTEGER(iwp) :: av !< |
---|
11667 | INTEGER(iwp) :: char_to_int !< for converting character to integer |
---|
11668 | INTEGER(iwp) :: found_index !< index of a chemical compound |
---|
11669 | INTEGER(iwp) :: ib !< loop index for aerosol size number bins |
---|
11670 | INTEGER(iwp) :: ic !< loop index for chemical components |
---|
11671 | INTEGER(iwp) :: i !< loop index in x-direction |
---|
11672 | INTEGER(iwp) :: j !< loop index in y-direction |
---|
11673 | INTEGER(iwp) :: k !< loop index in z-direction |
---|
11674 | INTEGER(iwp) :: im !< loop index for masked variables |
---|
11675 | INTEGER(iwp) :: jm !< loop index for masked variables |
---|
11676 | INTEGER(iwp) :: kk !< loop index for masked output in z-direction |
---|
11677 | INTEGER(iwp) :: mid !< masked output running index |
---|
11678 | INTEGER(iwp) :: ktt !< k index of highest terrain surface |
---|
11679 | |
---|
11680 | LOGICAL :: found !< |
---|
11681 | LOGICAL :: resorted !< |
---|
11682 | |
---|
11683 | REAL(wp) :: df !< For calculating LDSA: fraction of particles depositing in the alveolar |
---|
11684 | !< (or tracheobronchial) region of the lung. Depends on the particle size |
---|
11685 | REAL(wp) :: mean_d !< Particle diameter in micrometres |
---|
11686 | REAL(wp) :: temp_bin !< temporary array for calculating output variables |
---|
11687 | |
---|
11688 | REAL(wp), DIMENSION(mask_size_l(mid,1),mask_size_l(mid,2),mask_size_l(mid,3)) :: local_pf !< |
---|
11689 | |
---|
11690 | REAL(wp), DIMENSION(nzb:nzt+1,nysg:nyng,nxlg:nxrg), TARGET :: temp_array !< temporary array |
---|
11691 | |
---|
11692 | REAL(wp), DIMENSION(:,:,:), POINTER :: to_be_resorted !< pointer |
---|
11693 | |
---|
11694 | found = .TRUE. |
---|
11695 | resorted = .FALSE. |
---|
11696 | grid = 's' |
---|
11697 | tend = 0.0_wp |
---|
11698 | temp_array = 0.0_wp |
---|
11699 | temp_bin = 0.0_wp |
---|
11700 | |
---|
11701 | IF ( variable(7:11) == 'N_bin' ) THEN |
---|
11702 | READ( variable(12:),* ) char_to_int |
---|
11703 | IF ( char_to_int >= 1 .AND. char_to_int <= SUM( nbin ) ) THEN |
---|
11704 | ib = char_to_int |
---|
11705 | IF ( av == 0 ) THEN |
---|
11706 | IF ( .NOT. mask_surface(mid) ) THEN |
---|
11707 | DO i = 1, mask_size_l(mid,1) |
---|
11708 | DO j = 1, mask_size_l(mid,2) |
---|
11709 | DO k = 1, mask_size_l(mid,3) |
---|
11710 | local_pf(i,j,k) = aerosol_number(ib)%conc( mask_k(mid,k), mask_j(mid,j), & |
---|
11711 | mask_i(mid,i) ) |
---|
11712 | ENDDO |
---|
11713 | ENDDO |
---|
11714 | ENDDO |
---|
11715 | ELSE |
---|
11716 | DO i = 1, mask_size_l(mid,1) |
---|
11717 | DO j = 1, mask_size_l(mid,2) |
---|
11718 | ! |
---|
11719 | !-- Get k index of the highest terraing surface |
---|
11720 | im = mask_i(mid,i) |
---|
11721 | jm = mask_j(mid,j) |
---|
11722 | ktt = MINLOC( MERGE( 1, 0, BTEST( wall_flags_total_0(:,jm,im), 5 )), & |
---|
11723 | DIM = 1 ) - 1 |
---|
11724 | DO k = 1, mask_size_l(mid,3) |
---|
11725 | kk = MIN( ktt+mask_k(mid,k), nzt+1 ) |
---|
11726 | ! |
---|
11727 | !-- Set value if not in building |
---|
11728 | IF ( BTEST( wall_flags_total_0(kk,jm,im), 6 ) ) THEN |
---|
11729 | local_pf(i,j,k) = fill_value |
---|
11730 | ELSE |
---|
11731 | local_pf(i,j,k) = aerosol_number(ib)%conc(kk,jm,im) |
---|
11732 | ENDIF |
---|
11733 | ENDDO |
---|
11734 | ENDDO |
---|
11735 | ENDDO |
---|
11736 | ENDIF |
---|
11737 | resorted = .TRUE. |
---|
11738 | ELSE |
---|
11739 | temp_array = nbins_av(:,:,:,ib) |
---|
11740 | to_be_resorted => temp_array |
---|
11741 | ENDIF |
---|
11742 | ENDIF |
---|
11743 | |
---|
11744 | ELSEIF ( variable(7:11) == 'm_bin' ) THEN |
---|
11745 | |
---|
11746 | READ( variable(12:),* ) char_to_int |
---|
11747 | IF ( char_to_int >= 1 .AND. char_to_int <= SUM( nbin ) ) THEN |
---|
11748 | |
---|
11749 | ib = char_to_int |
---|
11750 | IF ( av == 0 ) THEN |
---|
11751 | DO i = nxl, nxr |
---|
11752 | DO j = nys, nyn |
---|
11753 | DO k = nzb, nz_do3d |
---|
11754 | temp_bin = 0.0_wp |
---|
11755 | DO ic = ib, ncomponents_mass * nbins_aerosol, nbins_aerosol |
---|
11756 | temp_bin = temp_bin + aerosol_mass(ic)%conc(k,j,i) |
---|
11757 | ENDDO |
---|
11758 | tend(k,j,i) = temp_bin |
---|
11759 | ENDDO |
---|
11760 | ENDDO |
---|
11761 | ENDDO |
---|
11762 | IF ( .NOT. mask_surface(mid) ) THEN |
---|
11763 | DO i = 1, mask_size_l(mid,1) |
---|
11764 | DO j = 1, mask_size_l(mid,2) |
---|
11765 | DO k = 1, mask_size_l(mid,3) |
---|
11766 | local_pf(i,j,k) = tend( mask_k(mid,k), mask_j(mid,j), mask_i(mid,i) ) |
---|
11767 | ENDDO |
---|
11768 | ENDDO |
---|
11769 | ENDDO |
---|
11770 | ELSE |
---|
11771 | DO i = 1, mask_size_l(mid,1) |
---|
11772 | DO j = 1, mask_size_l(mid,2) |
---|
11773 | ! |
---|
11774 | !-- Get k index of the highest terraing surface |
---|
11775 | im = mask_i(mid,i) |
---|
11776 | jm = mask_j(mid,j) |
---|
11777 | ktt = MINLOC( MERGE( 1, 0, BTEST( wall_flags_total_0(:,jm,im), 5 )), & |
---|
11778 | DIM = 1 ) - 1 |
---|
11779 | DO k = 1, mask_size_l(mid,3) |
---|
11780 | kk = MIN( ktt+mask_k(mid,k), nzt+1 ) |
---|
11781 | ! |
---|
11782 | !-- Set value if not in building |
---|
11783 | IF ( BTEST( wall_flags_total_0(kk,jm,im), 6 ) ) THEN |
---|
11784 | local_pf(i,j,k) = fill_value |
---|
11785 | ELSE |
---|
11786 | local_pf(i,j,k) = tend(kk,jm,im) |
---|
11787 | ENDIF |
---|
11788 | ENDDO |
---|
11789 | ENDDO |
---|
11790 | ENDDO |
---|
11791 | ENDIF |
---|
11792 | resorted = .TRUE. |
---|
11793 | ELSE |
---|
11794 | temp_array = mbins_av(:,:,:,ib) |
---|
11795 | to_be_resorted => temp_array |
---|
11796 | ENDIF |
---|
11797 | ENDIF |
---|
11798 | |
---|
11799 | ELSE |
---|
11800 | SELECT CASE ( TRIM( variable(7:) ) ) |
---|
11801 | |
---|
11802 | CASE ( 'g_H2SO4', 'g_HNO3', 'g_NH3', 'g_OCNV', 'g_OCSV' ) |
---|
11803 | vari = TRIM( variable(7:) ) |
---|
11804 | IF ( av == 0 ) THEN |
---|
11805 | IF ( vari == 'g_H2SO4') to_be_resorted => salsa_gas(1)%conc |
---|
11806 | IF ( vari == 'g_HNO3') to_be_resorted => salsa_gas(2)%conc |
---|
11807 | IF ( vari == 'g_NH3') to_be_resorted => salsa_gas(3)%conc |
---|
11808 | IF ( vari == 'g_OCNV') to_be_resorted => salsa_gas(4)%conc |
---|
11809 | IF ( vari == 'g_OCSV') to_be_resorted => salsa_gas(5)%conc |
---|
11810 | ELSE |
---|
11811 | IF ( vari == 'g_H2SO4') temp_array = salsa_gases_av(:,:,:,1) |
---|
11812 | IF ( vari == 'g_HNO3') temp_array = salsa_gases_av(:,:,:,2) |
---|
11813 | IF ( vari == 'g_NH3') temp_array = salsa_gases_av(:,:,:,3) |
---|
11814 | IF ( vari == 'g_OCNV') temp_array = salsa_gases_av(:,:,:,4) |
---|
11815 | IF ( vari == 'g_OCSV') temp_array = salsa_gases_av(:,:,:,5) |
---|
11816 | to_be_resorted => temp_array |
---|
11817 | ENDIF |
---|
11818 | |
---|
11819 | CASE ( 'LDSA' ) |
---|
11820 | IF ( av == 0 ) THEN |
---|
11821 | DO i = nxl, nxr |
---|
11822 | DO j = nys, nyn |
---|
11823 | DO k = nzb, nz_do3d |
---|
11824 | temp_bin = 0.0_wp |
---|
11825 | DO ib = 1, nbins_aerosol |
---|
11826 | ! |
---|
11827 | !-- Diameter in micrometres |
---|
11828 | mean_d = 1.0E+6_wp * ra_dry(k,j,i,ib) * 2.0_wp |
---|
11829 | ! |
---|
11830 | !-- Deposition factor: alveolar |
---|
11831 | df = ( 0.01555_wp / mean_d ) * ( EXP( -0.416_wp * ( LOG( mean_d ) + & |
---|
11832 | 2.84_wp )**2 ) + 19.11_wp * EXP( -0.482_wp * ( LOG( mean_d ) - & |
---|
11833 | 1.362_wp )**2 ) ) |
---|
11834 | ! |
---|
11835 | !-- Lung-deposited surface area LDSA (units mum2/cm3) |
---|
11836 | temp_bin = temp_bin + pi * mean_d**2 * df * 1.0E-6_wp * & |
---|
11837 | aerosol_number(ib)%conc(k,j,i) |
---|
11838 | ENDDO |
---|
11839 | tend(k,j,i) = temp_bin |
---|
11840 | ENDDO |
---|
11841 | ENDDO |
---|
11842 | ENDDO |
---|
11843 | IF ( .NOT. mask_surface(mid) ) THEN |
---|
11844 | DO i = 1, mask_size_l(mid,1) |
---|
11845 | DO j = 1, mask_size_l(mid,2) |
---|
11846 | DO k = 1, mask_size_l(mid,3) |
---|
11847 | local_pf(i,j,k) = tend( mask_k(mid,k), mask_j(mid,j), mask_i(mid,i) ) |
---|
11848 | ENDDO |
---|
11849 | ENDDO |
---|
11850 | ENDDO |
---|
11851 | ELSE |
---|
11852 | DO i = 1, mask_size_l(mid,1) |
---|
11853 | DO j = 1, mask_size_l(mid,2) |
---|
11854 | ! |
---|
11855 | !-- Get k index of the highest terraing surface |
---|
11856 | im = mask_i(mid,i) |
---|
11857 | jm = mask_j(mid,j) |
---|
11858 | ktt = MINLOC( MERGE( 1, 0, BTEST( wall_flags_total_0(:,jm,im), 5 )), & |
---|
11859 | DIM = 1 ) - 1 |
---|
11860 | DO k = 1, mask_size_l(mid,3) |
---|
11861 | kk = MIN( ktt+mask_k(mid,k), nzt+1 ) |
---|
11862 | ! |
---|
11863 | !-- Set value if not in building |
---|
11864 | IF ( BTEST( wall_flags_total_0(kk,jm,im), 6 ) ) THEN |
---|
11865 | local_pf(i,j,k) = fill_value |
---|
11866 | ELSE |
---|
11867 | local_pf(i,j,k) = tend(kk,jm,im) |
---|
11868 | ENDIF |
---|
11869 | ENDDO |
---|
11870 | ENDDO |
---|
11871 | ENDDO |
---|
11872 | ENDIF |
---|
11873 | resorted = .TRUE. |
---|
11874 | ELSE |
---|
11875 | to_be_resorted => ldsa_av |
---|
11876 | ENDIF |
---|
11877 | |
---|
11878 | CASE ( 'N_UFP' ) |
---|
11879 | IF ( av == 0 ) THEN |
---|
11880 | DO i = nxl, nxr |
---|
11881 | DO j = nys, nyn |
---|
11882 | DO k = nzb, nz_do3d |
---|
11883 | temp_bin = 0.0_wp |
---|
11884 | DO ib = 1, nbins_aerosol |
---|
11885 | IF ( 2.0_wp * ra_dry(k,j,i,ib) <= 0.1E-6_wp ) THEN |
---|
11886 | temp_bin = temp_bin + aerosol_number(ib)%conc(k,j,i) |
---|
11887 | ENDIF |
---|
11888 | ENDDO |
---|
11889 | tend(k,j,i) = temp_bin |
---|
11890 | ENDDO |
---|
11891 | ENDDO |
---|
11892 | ENDDO |
---|
11893 | IF ( .NOT. mask_surface(mid) ) THEN |
---|
11894 | DO i = 1, mask_size_l(mid,1) |
---|
11895 | DO j = 1, mask_size_l(mid,2) |
---|
11896 | DO k = 1, mask_size_l(mid,3) |
---|
11897 | local_pf(i,j,k) = tend( mask_k(mid,k), mask_j(mid,j), mask_i(mid,i) ) |
---|
11898 | ENDDO |
---|
11899 | ENDDO |
---|
11900 | ENDDO |
---|
11901 | ELSE |
---|
11902 | DO i = 1, mask_size_l(mid,1) |
---|
11903 | DO j = 1, mask_size_l(mid,2) |
---|
11904 | ! |
---|
11905 | !-- Get k index of the highest terraing surface |
---|
11906 | im = mask_i(mid,i) |
---|
11907 | jm = mask_j(mid,j) |
---|
11908 | ktt = MINLOC( MERGE( 1, 0, BTEST( wall_flags_total_0(:,jm,im), 5 )), & |
---|
11909 | DIM = 1 ) - 1 |
---|
11910 | DO k = 1, mask_size_l(mid,3) |
---|
11911 | kk = MIN( ktt+mask_k(mid,k), nzt+1 ) |
---|
11912 | ! |
---|
11913 | !-- Set value if not in building |
---|
11914 | IF ( BTEST( wall_flags_total_0(kk,jm,im), 6 ) ) THEN |
---|
11915 | local_pf(i,j,k) = fill_value |
---|
11916 | ELSE |
---|
11917 | local_pf(i,j,k) = tend(kk,jm,im) |
---|
11918 | ENDIF |
---|
11919 | ENDDO |
---|
11920 | ENDDO |
---|
11921 | ENDDO |
---|
11922 | ENDIF |
---|
11923 | resorted = .TRUE. |
---|
11924 | ELSE |
---|
11925 | to_be_resorted => nufp_av |
---|
11926 | ENDIF |
---|
11927 | |
---|
11928 | CASE ( 'Ntot' ) |
---|
11929 | IF ( av == 0 ) THEN |
---|
11930 | DO i = nxl, nxr |
---|
11931 | DO j = nys, nyn |
---|
11932 | DO k = nzb, nz_do3d |
---|
11933 | temp_bin = 0.0_wp |
---|
11934 | DO ib = 1, nbins_aerosol |
---|
11935 | temp_bin = temp_bin + aerosol_number(ib)%conc(k,j,i) |
---|
11936 | ENDDO |
---|
11937 | tend(k,j,i) = temp_bin |
---|
11938 | ENDDO |
---|
11939 | ENDDO |
---|
11940 | ENDDO |
---|
11941 | IF ( .NOT. mask_surface(mid) ) THEN |
---|
11942 | DO i = 1, mask_size_l(mid,1) |
---|
11943 | DO j = 1, mask_size_l(mid,2) |
---|
11944 | DO k = 1, mask_size_l(mid,3) |
---|
11945 | local_pf(i,j,k) = tend( mask_k(mid,k), mask_j(mid,j), mask_i(mid,i) ) |
---|
11946 | ENDDO |
---|
11947 | ENDDO |
---|
11948 | ENDDO |
---|
11949 | ELSE |
---|
11950 | DO i = 1, mask_size_l(mid,1) |
---|
11951 | DO j = 1, mask_size_l(mid,2) |
---|
11952 | ! |
---|
11953 | !-- Get k index of the highest terraing surface |
---|
11954 | im = mask_i(mid,i) |
---|
11955 | jm = mask_j(mid,j) |
---|
11956 | ktt = MINLOC( MERGE( 1, 0, BTEST( wall_flags_total_0(:,jm,im), 5 )), & |
---|
11957 | DIM = 1 ) - 1 |
---|
11958 | DO k = 1, mask_size_l(mid,3) |
---|
11959 | kk = MIN( ktt+mask_k(mid,k), nzt+1 ) |
---|
11960 | ! |
---|
11961 | !-- Set value if not in building |
---|
11962 | IF ( BTEST( wall_flags_total_0(kk,jm,im), 6 ) ) THEN |
---|
11963 | local_pf(i,j,k) = fill_value |
---|
11964 | ELSE |
---|
11965 | local_pf(i,j,k) = tend(kk,jm,im) |
---|
11966 | ENDIF |
---|
11967 | ENDDO |
---|
11968 | ENDDO |
---|
11969 | ENDDO |
---|
11970 | ENDIF |
---|
11971 | resorted = .TRUE. |
---|
11972 | ELSE |
---|
11973 | to_be_resorted => ntot_av |
---|
11974 | ENDIF |
---|
11975 | |
---|
11976 | CASE ( 'PM0.1' ) |
---|
11977 | IF ( av == 0 ) THEN |
---|
11978 | DO i = nxl, nxr |
---|
11979 | DO j = nys, nyn |
---|
11980 | DO k = nzb, nz_do3d |
---|
11981 | temp_bin = 0.0_wp |
---|
11982 | DO ib = 1, nbins_aerosol |
---|
11983 | IF ( 2.0_wp * ra_dry(k,j,i,ib) <= 0.1E-6_wp ) THEN |
---|
11984 | DO ic = ib, nbins_aerosol * ncc, nbins_aerosol |
---|
11985 | temp_bin = temp_bin + aerosol_mass(ic)%conc(k,j,i) |
---|
11986 | ENDDO |
---|
11987 | ENDIF |
---|
11988 | ENDDO |
---|
11989 | tend(k,j,i) = temp_bin |
---|
11990 | ENDDO |
---|
11991 | ENDDO |
---|
11992 | ENDDO |
---|
11993 | IF ( .NOT. mask_surface(mid) ) THEN |
---|
11994 | DO i = 1, mask_size_l(mid,1) |
---|
11995 | DO j = 1, mask_size_l(mid,2) |
---|
11996 | DO k = 1, mask_size_l(mid,3) |
---|
11997 | local_pf(i,j,k) = tend( mask_k(mid,k), mask_j(mid,j), mask_i(mid,i) ) |
---|
11998 | ENDDO |
---|
11999 | ENDDO |
---|
12000 | ENDDO |
---|
12001 | ELSE |
---|
12002 | DO i = 1, mask_size_l(mid,1) |
---|
12003 | DO j = 1, mask_size_l(mid,2) |
---|
12004 | ! |
---|
12005 | !-- Get k index of the highest terraing surface |
---|
12006 | im = mask_i(mid,i) |
---|
12007 | jm = mask_j(mid,j) |
---|
12008 | ktt = MINLOC( MERGE( 1, 0, BTEST( wall_flags_total_0(:,jm,im), 5 )), & |
---|
12009 | DIM = 1 ) - 1 |
---|
12010 | DO k = 1, mask_size_l(mid,3) |
---|
12011 | kk = MIN( ktt+mask_k(mid,k), nzt+1 ) |
---|
12012 | ! |
---|
12013 | !-- Set value if not in building |
---|
12014 | IF ( BTEST( wall_flags_total_0(kk,jm,im), 6 ) ) THEN |
---|
12015 | local_pf(i,j,k) = fill_value |
---|
12016 | ELSE |
---|
12017 | local_pf(i,j,k) = tend(kk,jm,im) |
---|
12018 | ENDIF |
---|
12019 | ENDDO |
---|
12020 | ENDDO |
---|
12021 | ENDDO |
---|
12022 | ENDIF |
---|
12023 | resorted = .TRUE. |
---|
12024 | ELSE |
---|
12025 | to_be_resorted => pm01_av |
---|
12026 | ENDIF |
---|
12027 | |
---|
12028 | CASE ( 'PM2.5' ) |
---|
12029 | IF ( av == 0 ) THEN |
---|
12030 | DO i = nxl, nxr |
---|
12031 | DO j = nys, nyn |
---|
12032 | DO k = nzb, nz_do3d |
---|
12033 | temp_bin = 0.0_wp |
---|
12034 | DO ib = 1, nbins_aerosol |
---|
12035 | IF ( 2.0_wp * ra_dry(k,j,i,ib) <= 2.5E-6_wp ) THEN |
---|
12036 | DO ic = ib, nbins_aerosol * ncc, nbins_aerosol |
---|
12037 | temp_bin = temp_bin + aerosol_mass(ic)%conc(k,j,i) |
---|
12038 | ENDDO |
---|
12039 | ENDIF |
---|
12040 | ENDDO |
---|
12041 | tend(k,j,i) = temp_bin |
---|
12042 | ENDDO |
---|
12043 | ENDDO |
---|
12044 | ENDDO |
---|
12045 | IF ( .NOT. mask_surface(mid) ) THEN |
---|
12046 | DO i = 1, mask_size_l(mid,1) |
---|
12047 | DO j = 1, mask_size_l(mid,2) |
---|
12048 | DO k = 1, mask_size_l(mid,3) |
---|
12049 | local_pf(i,j,k) = tend( mask_k(mid,k), mask_j(mid,j), mask_i(mid,i) ) |
---|
12050 | ENDDO |
---|
12051 | ENDDO |
---|
12052 | ENDDO |
---|
12053 | ELSE |
---|
12054 | DO i = 1, mask_size_l(mid,1) |
---|
12055 | DO j = 1, mask_size_l(mid,2) |
---|
12056 | ! |
---|
12057 | !-- Get k index of the highest terraing surface |
---|
12058 | im = mask_i(mid,i) |
---|
12059 | jm = mask_j(mid,j) |
---|
12060 | ktt = MINLOC( MERGE( 1, 0, BTEST( wall_flags_total_0(:,jm,im), 5 )), & |
---|
12061 | DIM = 1 ) - 1 |
---|
12062 | DO k = 1, mask_size_l(mid,3) |
---|
12063 | kk = MIN( ktt+mask_k(mid,k), nzt+1 ) |
---|
12064 | ! |
---|
12065 | !-- Set value if not in building |
---|
12066 | IF ( BTEST( wall_flags_total_0(kk,jm,im), 6 ) ) THEN |
---|
12067 | local_pf(i,j,k) = fill_value |
---|
12068 | ELSE |
---|
12069 | local_pf(i,j,k) = tend(kk,jm,im) |
---|
12070 | ENDIF |
---|
12071 | ENDDO |
---|
12072 | ENDDO |
---|
12073 | ENDDO |
---|
12074 | ENDIF |
---|
12075 | resorted = .TRUE. |
---|
12076 | ELSE |
---|
12077 | to_be_resorted => pm25_av |
---|
12078 | ENDIF |
---|
12079 | |
---|
12080 | CASE ( 'PM10' ) |
---|
12081 | IF ( av == 0 ) THEN |
---|
12082 | DO i = nxl, nxr |
---|
12083 | DO j = nys, nyn |
---|
12084 | DO k = nzb, nz_do3d |
---|
12085 | temp_bin = 0.0_wp |
---|
12086 | DO ib = 1, nbins_aerosol |
---|
12087 | IF ( 2.0_wp * ra_dry(k,j,i,ib) <= 10.0E-6_wp ) THEN |
---|
12088 | DO ic = ib, nbins_aerosol * ncc, nbins_aerosol |
---|
12089 | temp_bin = temp_bin + aerosol_mass(ic)%conc(k,j,i) |
---|
12090 | ENDDO |
---|
12091 | ENDIF |
---|
12092 | ENDDO |
---|
12093 | tend(k,j,i) = temp_bin |
---|
12094 | ENDDO |
---|
12095 | ENDDO |
---|
12096 | ENDDO |
---|
12097 | IF ( .NOT. mask_surface(mid) ) THEN |
---|
12098 | DO i = 1, mask_size_l(mid,1) |
---|
12099 | DO j = 1, mask_size_l(mid,2) |
---|
12100 | DO k = 1, mask_size_l(mid,3) |
---|
12101 | local_pf(i,j,k) = tend( mask_k(mid,k), mask_j(mid,j), mask_i(mid,i) ) |
---|
12102 | ENDDO |
---|
12103 | ENDDO |
---|
12104 | ENDDO |
---|
12105 | ELSE |
---|
12106 | DO i = 1, mask_size_l(mid,1) |
---|
12107 | DO j = 1, mask_size_l(mid,2) |
---|
12108 | ! |
---|
12109 | !-- Get k index of the highest terraing surface |
---|
12110 | im = mask_i(mid,i) |
---|
12111 | jm = mask_j(mid,j) |
---|
12112 | ktt = MINLOC( MERGE( 1, 0, BTEST( wall_flags_total_0(:,jm,im), 5 )), & |
---|
12113 | DIM = 1 ) - 1 |
---|
12114 | DO k = 1, mask_size_l(mid,3) |
---|
12115 | kk = MIN( ktt+mask_k(mid,k), nzt+1 ) |
---|
12116 | ! |
---|
12117 | !-- Set value if not in building |
---|
12118 | IF ( BTEST( wall_flags_total_0(kk,jm,im), 6 ) ) THEN |
---|
12119 | local_pf(i,j,k) = fill_value |
---|
12120 | ELSE |
---|
12121 | local_pf(i,j,k) = tend(kk,jm,im) |
---|
12122 | ENDIF |
---|
12123 | ENDDO |
---|
12124 | ENDDO |
---|
12125 | ENDDO |
---|
12126 | ENDIF |
---|
12127 | resorted = .TRUE. |
---|
12128 | ELSE |
---|
12129 | to_be_resorted => pm10_av |
---|
12130 | ENDIF |
---|
12131 | |
---|
12132 | CASE ( 's_BC', 's_DU', 's_NH', 's_NO', 's_OC', 's_SO4', 's_SS' ) |
---|
12133 | IF ( is_used( prtcl, TRIM( variable(9:) ) ) ) THEN |
---|
12134 | found_index = get_index( prtcl, TRIM( variable(9:) ) ) |
---|
12135 | IF ( av == 0 ) THEN |
---|
12136 | DO i = nxl, nxr |
---|
12137 | DO j = nys, nyn |
---|
12138 | DO k = nzb, nz_do3d |
---|
12139 | temp_bin = 0.0_wp |
---|
12140 | DO ic = ( found_index-1 ) * nbins_aerosol + 1, found_index * nbins_aerosol |
---|
12141 | temp_bin = temp_bin + aerosol_mass(ic)%conc(k,j,i) |
---|
12142 | ENDDO |
---|
12143 | tend(k,j,i) = temp_bin |
---|
12144 | ENDDO |
---|
12145 | ENDDO |
---|
12146 | ENDDO |
---|
12147 | IF ( .NOT. mask_surface(mid) ) THEN |
---|
12148 | DO i = 1, mask_size_l(mid,1) |
---|
12149 | DO j = 1, mask_size_l(mid,2) |
---|
12150 | DO k = 1, mask_size_l(mid,3) |
---|
12151 | local_pf(i,j,k) = tend( mask_k(mid,k), mask_j(mid,j), mask_i(mid,i) ) |
---|
12152 | ENDDO |
---|
12153 | ENDDO |
---|
12154 | ENDDO |
---|
12155 | ELSE |
---|
12156 | DO i = 1, mask_size_l(mid,1) |
---|
12157 | DO j = 1, mask_size_l(mid,2) |
---|
12158 | ! |
---|
12159 | !-- Get k index of the highest terraing surface |
---|
12160 | im = mask_i(mid,i) |
---|
12161 | jm = mask_j(mid,j) |
---|
12162 | ktt = MINLOC( MERGE( 1, 0, BTEST( wall_flags_total_0(:,jm,im), 5 )), & |
---|
12163 | DIM = 1 ) - 1 |
---|
12164 | DO k = 1, mask_size_l(mid,3) |
---|
12165 | kk = MIN( ktt+mask_k(mid,k), nzt+1 ) |
---|
12166 | ! |
---|
12167 | !-- Set value if not in building |
---|
12168 | IF ( BTEST( wall_flags_total_0(kk,jm,im), 6 ) ) THEN |
---|
12169 | local_pf(i,j,k) = fill_value |
---|
12170 | ELSE |
---|
12171 | local_pf(i,j,k) = tend(kk,jm,im) |
---|
12172 | ENDIF |
---|
12173 | ENDDO |
---|
12174 | ENDDO |
---|
12175 | ENDDO |
---|
12176 | ENDIF |
---|
12177 | resorted = .TRUE. |
---|
12178 | ELSE |
---|
12179 | temp_array = s_mass_av(:,:,:,found_index) |
---|
12180 | to_be_resorted => temp_array |
---|
12181 | ENDIF |
---|
12182 | ELSE |
---|
12183 | local_pf = fill_value |
---|
12184 | ENDIF |
---|
12185 | |
---|
12186 | CASE ( 's_H2O' ) |
---|
12187 | IF ( av == 0 ) THEN |
---|
12188 | found_index = get_index( prtcl, 'H2O' ) |
---|
12189 | DO i = nxl, nxr |
---|
12190 | DO j = nys, nyn |
---|
12191 | DO k = nzb, nz_do3d |
---|
12192 | temp_bin = 0.0_wp |
---|
12193 | DO ic = ( found_index-1 ) * nbins_aerosol + 1, found_index * nbins_aerosol |
---|
12194 | temp_bin = temp_bin + aerosol_mass(ic)%conc(k,j,i) |
---|
12195 | ENDDO |
---|
12196 | tend(k,j,i) = temp_bin |
---|
12197 | ENDDO |
---|
12198 | ENDDO |
---|
12199 | ENDDO |
---|
12200 | IF ( .NOT. mask_surface(mid) ) THEN |
---|
12201 | DO i = 1, mask_size_l(mid,1) |
---|
12202 | DO j = 1, mask_size_l(mid,2) |
---|
12203 | DO k = 1, mask_size_l(mid,3) |
---|
12204 | local_pf(i,j,k) = tend( mask_k(mid,k), mask_j(mid,j), mask_i(mid,i) ) |
---|
12205 | ENDDO |
---|
12206 | ENDDO |
---|
12207 | ENDDO |
---|
12208 | ELSE |
---|
12209 | DO i = 1, mask_size_l(mid,1) |
---|
12210 | DO j = 1, mask_size_l(mid,2) |
---|
12211 | ! |
---|
12212 | !-- Get k index of the highest terraing surface |
---|
12213 | im = mask_i(mid,i) |
---|
12214 | jm = mask_j(mid,j) |
---|
12215 | ktt = MINLOC( MERGE( 1, 0, BTEST( wall_flags_total_0(:,jm,im), 5 )), & |
---|
12216 | DIM = 1 ) - 1 |
---|
12217 | DO k = 1, mask_size_l(mid,3) |
---|
12218 | kk = MIN( ktt+mask_k(mid,k), nzt+1 ) |
---|
12219 | ! |
---|
12220 | !-- Set value if not in building |
---|
12221 | IF ( BTEST( wall_flags_total_0(kk,jm,im), 6 ) ) THEN |
---|
12222 | local_pf(i,j,k) = fill_value |
---|
12223 | ELSE |
---|
12224 | local_pf(i,j,k) = tend(kk,jm,im) |
---|
12225 | ENDIF |
---|
12226 | ENDDO |
---|
12227 | ENDDO |
---|
12228 | ENDDO |
---|
12229 | ENDIF |
---|
12230 | resorted = .TRUE. |
---|
12231 | ELSE |
---|
12232 | to_be_resorted => s_h2o_av |
---|
12233 | ENDIF |
---|
12234 | |
---|
12235 | CASE DEFAULT |
---|
12236 | found = .FALSE. |
---|
12237 | |
---|
12238 | END SELECT |
---|
12239 | ENDIF |
---|
12240 | |
---|
12241 | IF ( found .AND. .NOT. resorted ) THEN |
---|
12242 | IF ( .NOT. mask_surface(mid) ) THEN |
---|
12243 | ! |
---|
12244 | !-- Default masked output |
---|
12245 | DO i = 1, mask_size_l(mid,1) |
---|
12246 | DO j = 1, mask_size_l(mid,2) |
---|
12247 | DO k = 1, mask_size_l(mid,3) |
---|
12248 | local_pf(i,j,k) = to_be_resorted( mask_k(mid,k), mask_j(mid,j), mask_i(mid,i) ) |
---|
12249 | ENDDO |
---|
12250 | ENDDO |
---|
12251 | ENDDO |
---|
12252 | ELSE |
---|
12253 | ! |
---|
12254 | !-- Terrain-following masked output |
---|
12255 | DO i = 1, mask_size_l(mid,1) |
---|
12256 | DO j = 1, mask_size_l(mid,2) |
---|
12257 | ! |
---|
12258 | !-- Get k index of the highest terraing surface |
---|
12259 | im = mask_i(mid,i) |
---|
12260 | jm = mask_j(mid,j) |
---|
12261 | ktt = MINLOC( MERGE( 1, 0, BTEST( wall_flags_total_0(:,jm,im), 5 )), & |
---|
12262 | DIM = 1 ) - 1 |
---|
12263 | DO k = 1, mask_size_l(mid,3) |
---|
12264 | kk = MIN( ktt+mask_k(mid,k), nzt+1 ) |
---|
12265 | ! |
---|
12266 | !-- Set value if not in building |
---|
12267 | IF ( BTEST( wall_flags_total_0(kk,jm,im), 6 ) ) THEN |
---|
12268 | local_pf(i,j,k) = fill_value |
---|
12269 | ELSE |
---|
12270 | local_pf(i,j,k) = to_be_resorted(kk,jm,im) |
---|
12271 | ENDIF |
---|
12272 | ENDDO |
---|
12273 | ENDDO |
---|
12274 | ENDDO |
---|
12275 | ENDIF |
---|
12276 | ENDIF |
---|
12277 | |
---|
12278 | END SUBROUTINE salsa_data_output_mask |
---|
12279 | |
---|
12280 | !------------------------------------------------------------------------------! |
---|
12281 | ! Description: |
---|
12282 | ! ------------ |
---|
12283 | !> Creates index tables for different (aerosol) components |
---|
12284 | !------------------------------------------------------------------------------! |
---|
12285 | SUBROUTINE component_index_constructor( self, ncomp, nlist, listcomp ) |
---|
12286 | |
---|
12287 | IMPLICIT NONE |
---|
12288 | |
---|
12289 | INTEGER(iwp) :: ii !< |
---|
12290 | INTEGER(iwp) :: jj !< |
---|
12291 | |
---|
12292 | INTEGER(iwp), INTENT(in) :: nlist ! < Maximum number of components |
---|
12293 | |
---|
12294 | INTEGER(iwp), INTENT(inout) :: ncomp !< Number of components |
---|
12295 | |
---|
12296 | CHARACTER(LEN=3), INTENT(in) :: listcomp(nlist) !< List cof component names |
---|
12297 | |
---|
12298 | TYPE(component_index), INTENT(inout) :: self !< Object containing the indices of different |
---|
12299 | !< aerosol components |
---|
12300 | |
---|
12301 | ncomp = 0 |
---|
12302 | |
---|
12303 | DO WHILE ( listcomp(ncomp+1) /= ' ' .AND. ncomp < nlist ) |
---|
12304 | ncomp = ncomp + 1 |
---|
12305 | ENDDO |
---|
12306 | |
---|
12307 | self%ncomp = ncomp |
---|
12308 | ALLOCATE( self%ind(ncomp), self%comp(ncomp) ) |
---|
12309 | |
---|
12310 | DO ii = 1, ncomp |
---|
12311 | self%ind(ii) = ii |
---|
12312 | ENDDO |
---|
12313 | |
---|
12314 | jj = 1 |
---|
12315 | DO ii = 1, nlist |
---|
12316 | IF ( listcomp(ii) == '') CYCLE |
---|
12317 | self%comp(jj) = listcomp(ii) |
---|
12318 | jj = jj + 1 |
---|
12319 | ENDDO |
---|
12320 | |
---|
12321 | END SUBROUTINE component_index_constructor |
---|
12322 | |
---|
12323 | !------------------------------------------------------------------------------! |
---|
12324 | ! Description: |
---|
12325 | ! ------------ |
---|
12326 | !> Gives the index of a component in the component list |
---|
12327 | !------------------------------------------------------------------------------! |
---|
12328 | INTEGER FUNCTION get_index( self, incomp ) |
---|
12329 | |
---|
12330 | IMPLICIT NONE |
---|
12331 | |
---|
12332 | CHARACTER(LEN=*), INTENT(in) :: incomp !< Component name |
---|
12333 | |
---|
12334 | INTEGER(iwp) :: ii !< index |
---|
12335 | |
---|
12336 | TYPE(component_index), INTENT(in) :: self !< Object containing the indices of different |
---|
12337 | !< aerosol components |
---|
12338 | IF ( ANY( self%comp == incomp ) ) THEN |
---|
12339 | ii = 1 |
---|
12340 | DO WHILE ( (self%comp(ii) /= incomp) ) |
---|
12341 | ii = ii + 1 |
---|
12342 | ENDDO |
---|
12343 | get_index = ii |
---|
12344 | ELSEIF ( incomp == 'H2O' ) THEN |
---|
12345 | get_index = self%ncomp + 1 |
---|
12346 | ELSE |
---|
12347 | WRITE( message_string, * ) 'Incorrect component name given!' |
---|
12348 | CALL message( 'get_index', 'PA0591', 1, 2, 0, 6, 0 ) |
---|
12349 | ENDIF |
---|
12350 | |
---|
12351 | END FUNCTION get_index |
---|
12352 | |
---|
12353 | !------------------------------------------------------------------------------! |
---|
12354 | ! Description: |
---|
12355 | ! ------------ |
---|
12356 | !> Tells if the (aerosol) component is being used in the simulation |
---|
12357 | !------------------------------------------------------------------------------! |
---|
12358 | LOGICAL FUNCTION is_used( self, icomp ) |
---|
12359 | |
---|
12360 | IMPLICIT NONE |
---|
12361 | |
---|
12362 | CHARACTER(LEN=*), INTENT(in) :: icomp !< Component name |
---|
12363 | |
---|
12364 | TYPE(component_index), INTENT(in) :: self !< Object containing the indices of different |
---|
12365 | !< aerosol components |
---|
12366 | |
---|
12367 | IF ( ANY(self%comp == icomp) ) THEN |
---|
12368 | is_used = .TRUE. |
---|
12369 | ELSE |
---|
12370 | is_used = .FALSE. |
---|
12371 | ENDIF |
---|
12372 | |
---|
12373 | END FUNCTION |
---|
12374 | |
---|
12375 | !------------------------------------------------------------------------------! |
---|
12376 | ! Description: |
---|
12377 | ! ------------ |
---|
12378 | !> Set the lateral and top boundary conditions in case the PALM domain is |
---|
12379 | !> nested offline in a mesoscale model. Further, average boundary data and |
---|
12380 | !> determine mean profiles, further used for correct damping in the sponge |
---|
12381 | !> layer. |
---|
12382 | !------------------------------------------------------------------------------! |
---|
12383 | SUBROUTINE salsa_nesting_offl_bc |
---|
12384 | |
---|
12385 | USE control_parameters, & |
---|
12386 | ONLY: bc_dirichlet_l, bc_dirichlet_n, bc_dirichlet_r, bc_dirichlet_s, dt_3d, & |
---|
12387 | time_since_reference_point |
---|
12388 | |
---|
12389 | USE indices, & |
---|
12390 | ONLY: nbgp, nxl, nxr, nyn, nys, nzb, nzt |
---|
12391 | |
---|
12392 | IMPLICIT NONE |
---|
12393 | |
---|
12394 | INTEGER(iwp) :: i !< running index x-direction |
---|
12395 | INTEGER(iwp) :: ib !< running index for aerosol number bins |
---|
12396 | INTEGER(iwp) :: ic !< running index for aerosol mass bins |
---|
12397 | INTEGER(iwp) :: icc !< running index for aerosol mass bins |
---|
12398 | INTEGER(iwp) :: ig !< running index for gaseous species |
---|
12399 | INTEGER(iwp) :: j !< running index y-direction |
---|
12400 | INTEGER(iwp) :: k !< running index z-direction |
---|
12401 | |
---|
12402 | REAL(wp) :: fac_dt !< interpolation factor |
---|
12403 | |
---|
12404 | REAL(wp), DIMENSION(:,:), ALLOCATABLE :: ref_mconc !< reference profile for aerosol mass |
---|
12405 | REAL(wp), DIMENSION(:,:), ALLOCATABLE :: ref_mconc_l !< reference profile for aerosol mass: subdomain |
---|
12406 | REAL(wp), DIMENSION(:,:), ALLOCATABLE :: ref_nconc !< reference profile for aerosol number |
---|
12407 | REAL(wp), DIMENSION(:,:), ALLOCATABLE :: ref_nconc_l !< reference profile for aerosol_number: subdomain |
---|
12408 | REAL(wp), DIMENSION(:,:), ALLOCATABLE :: ref_gconc !< reference profile for gases |
---|
12409 | REAL(wp), DIMENSION(:,:), ALLOCATABLE :: ref_gconc_l !< reference profile for gases: subdomain |
---|
12410 | |
---|
12411 | ! |
---|
12412 | !-- Skip input if no forcing from larger-scale models is applied. |
---|
12413 | IF ( .NOT. nesting_offline_salsa ) RETURN |
---|
12414 | ! |
---|
12415 | !-- Allocate temporary arrays to compute salsa mean profiles |
---|
12416 | ALLOCATE( ref_gconc(nzb:nzt+1,1:ngases_salsa), ref_gconc_l(nzb:nzt+1,1:ngases_salsa), & |
---|
12417 | ref_mconc(nzb:nzt+1,1:nbins_aerosol*ncomponents_mass), & |
---|
12418 | ref_mconc_l(nzb:nzt+1,1:nbins_aerosol*ncomponents_mass), & |
---|
12419 | ref_nconc(nzb:nzt+1,1:nbins_aerosol), ref_nconc_l(nzb:nzt+1,1:nbins_aerosol) ) |
---|
12420 | ref_gconc = 0.0_wp |
---|
12421 | ref_gconc_l = 0.0_wp |
---|
12422 | ref_mconc = 0.0_wp |
---|
12423 | ref_mconc_l = 0.0_wp |
---|
12424 | ref_nconc = 0.0_wp |
---|
12425 | ref_nconc_l = 0.0_wp |
---|
12426 | |
---|
12427 | ! |
---|
12428 | !-- Determine interpolation factor and limit it to 1. This is because t+dt can slightly exceed |
---|
12429 | !-- time(tind_p) before boundary data is updated again. |
---|
12430 | fac_dt = ( time_since_reference_point - salsa_nest_offl%time(salsa_nest_offl%tind) + dt_3d ) / & |
---|
12431 | ( salsa_nest_offl%time(salsa_nest_offl%tind_p) - & |
---|
12432 | salsa_nest_offl%time(salsa_nest_offl%tind) ) |
---|
12433 | fac_dt = MIN( 1.0_wp, fac_dt ) |
---|
12434 | |
---|
12435 | IF ( bc_dirichlet_l ) THEN |
---|
12436 | DO ib = 1, nbins_aerosol |
---|
12437 | DO j = nys, nyn |
---|
12438 | DO k = nzb+1, nzt |
---|
12439 | aerosol_number(ib)%conc(k,j,-1) = ( 1.0_wp - fac_dt ) * & |
---|
12440 | salsa_nest_offl%nconc_left(0,k,j,ib) + fac_dt * & |
---|
12441 | salsa_nest_offl%nconc_left(1,k,j,ib) |
---|
12442 | ENDDO |
---|
12443 | ref_nconc_l(nzb+1:nzt,ib) = ref_nconc_l(nzb+1:nzt,ib) + & |
---|
12444 | aerosol_number(ib)%conc(nzb+1:nzt,j,-1) |
---|
12445 | ENDDO |
---|
12446 | DO ic = 1, ncomponents_mass |
---|
12447 | icc = ( ic-1 ) * nbins_aerosol + ib |
---|
12448 | DO j = nys, nyn |
---|
12449 | DO k = nzb+1, nzt |
---|
12450 | aerosol_mass(icc)%conc(k,j,-1) = ( 1.0_wp - fac_dt ) * & |
---|
12451 | salsa_nest_offl%mconc_left(0,k,j,icc) + fac_dt & |
---|
12452 | * salsa_nest_offl%mconc_left(1,k,j,icc) |
---|
12453 | ENDDO |
---|
12454 | ref_mconc_l(nzb+1:nzt,icc) = ref_mconc_l(nzb+1:nzt,icc) + & |
---|
12455 | aerosol_mass(icc)%conc(nzb+1:nzt,j,-1) |
---|
12456 | ENDDO |
---|
12457 | ENDDO |
---|
12458 | ENDDO |
---|
12459 | IF ( .NOT. salsa_gases_from_chem ) THEN |
---|
12460 | DO ig = 1, ngases_salsa |
---|
12461 | DO j = nys, nyn |
---|
12462 | DO k = nzb+1, nzt |
---|
12463 | salsa_gas(ig)%conc(k,j,-1) = ( 1.0_wp - fac_dt ) * & |
---|
12464 | salsa_nest_offl%gconc_left(0,k,j,ig) + fac_dt * & |
---|
12465 | salsa_nest_offl%gconc_left(1,k,j,ig) |
---|
12466 | ENDDO |
---|
12467 | ref_gconc_l(nzb+1:nzt,ig) = ref_gconc_l(nzb+1:nzt,ig) + & |
---|
12468 | salsa_gas(ig)%conc(nzb+1:nzt,j,-1) |
---|
12469 | ENDDO |
---|
12470 | ENDDO |
---|
12471 | ENDIF |
---|
12472 | ENDIF |
---|
12473 | |
---|
12474 | IF ( bc_dirichlet_r ) THEN |
---|
12475 | DO ib = 1, nbins_aerosol |
---|
12476 | DO j = nys, nyn |
---|
12477 | DO k = nzb+1, nzt |
---|
12478 | aerosol_number(ib)%conc(k,j,nxr+1) = ( 1.0_wp - fac_dt ) * & |
---|
12479 | salsa_nest_offl%nconc_right(0,k,j,ib) + fac_dt * & |
---|
12480 | salsa_nest_offl%nconc_right(1,k,j,ib) |
---|
12481 | ENDDO |
---|
12482 | ref_nconc_l(nzb+1:nzt,ib) = ref_nconc_l(nzb+1:nzt,ib) + & |
---|
12483 | aerosol_number(ib)%conc(nzb+1:nzt,j,nxr+1) |
---|
12484 | ENDDO |
---|
12485 | DO ic = 1, ncomponents_mass |
---|
12486 | icc = ( ic-1 ) * nbins_aerosol + ib |
---|
12487 | DO j = nys, nyn |
---|
12488 | DO k = nzb+1, nzt |
---|
12489 | aerosol_mass(icc)%conc(k,j,nxr+1) = ( 1.0_wp - fac_dt ) * & |
---|
12490 | salsa_nest_offl%mconc_right(0,k,j,icc) + fac_dt& |
---|
12491 | * salsa_nest_offl%mconc_right(1,k,j,icc) |
---|
12492 | ENDDO |
---|
12493 | ref_mconc_l(nzb+1:nzt,icc) = ref_mconc_l(nzb+1:nzt,icc) + & |
---|
12494 | aerosol_mass(icc)%conc(nzb+1:nzt,j,nxr+1) |
---|
12495 | ENDDO |
---|
12496 | ENDDO |
---|
12497 | ENDDO |
---|
12498 | IF ( .NOT. salsa_gases_from_chem ) THEN |
---|
12499 | DO ig = 1, ngases_salsa |
---|
12500 | DO j = nys, nyn |
---|
12501 | DO k = nzb+1, nzt |
---|
12502 | salsa_gas(ig)%conc(k,j,nxr+1) = ( 1.0_wp - fac_dt ) * & |
---|
12503 | salsa_nest_offl%gconc_right(0,k,j,ig) + fac_dt *& |
---|
12504 | salsa_nest_offl%gconc_right(1,k,j,ig) |
---|
12505 | ENDDO |
---|
12506 | ref_gconc_l(nzb+1:nzt,ig) = ref_gconc_l(nzb+1:nzt,ig) + & |
---|
12507 | salsa_gas(ig)%conc(nzb+1:nzt,j,nxr+1) |
---|
12508 | ENDDO |
---|
12509 | ENDDO |
---|
12510 | ENDIF |
---|
12511 | ENDIF |
---|
12512 | |
---|
12513 | IF ( bc_dirichlet_n ) THEN |
---|
12514 | DO ib = 1, nbins_aerosol |
---|
12515 | DO i = nxl, nxr |
---|
12516 | DO k = nzb+1, nzt |
---|
12517 | aerosol_number(ib)%conc(k,nyn+1,i) = ( 1.0_wp - fac_dt ) * & |
---|
12518 | salsa_nest_offl%nconc_north(0,k,i,ib) + fac_dt * & |
---|
12519 | salsa_nest_offl%nconc_north(1,k,i,ib) |
---|
12520 | ENDDO |
---|
12521 | ref_nconc_l(nzb+1:nzt,ib) = ref_nconc_l(nzb+1:nzt,ib) + & |
---|
12522 | aerosol_number(ib)%conc(nzb+1:nzt,nyn+1,i) |
---|
12523 | ENDDO |
---|
12524 | DO ic = 1, ncomponents_mass |
---|
12525 | icc = ( ic-1 ) * nbins_aerosol + ib |
---|
12526 | DO i = nxl, nxr |
---|
12527 | DO k = nzb+1, nzt |
---|
12528 | aerosol_mass(icc)%conc(k,nyn+1,i) = ( 1.0_wp - fac_dt ) * & |
---|
12529 | salsa_nest_offl%mconc_north(0,k,i,icc) + fac_dt& |
---|
12530 | * salsa_nest_offl%mconc_north(1,k,i,icc) |
---|
12531 | ENDDO |
---|
12532 | ref_mconc_l(nzb+1:nzt,icc) = ref_mconc_l(nzb+1:nzt,icc) + & |
---|
12533 | aerosol_mass(icc)%conc(nzb+1:nzt,nyn+1,i) |
---|
12534 | ENDDO |
---|
12535 | ENDDO |
---|
12536 | ENDDO |
---|
12537 | IF ( .NOT. salsa_gases_from_chem ) THEN |
---|
12538 | DO ig = 1, ngases_salsa |
---|
12539 | DO i = nxl, nxr |
---|
12540 | DO k = nzb+1, nzt |
---|
12541 | salsa_gas(ig)%conc(k,nyn+1,i) = ( 1.0_wp - fac_dt ) * & |
---|
12542 | salsa_nest_offl%gconc_north(0,k,i,ig) + fac_dt *& |
---|
12543 | salsa_nest_offl%gconc_north(1,k,i,ig) |
---|
12544 | ENDDO |
---|
12545 | ref_gconc_l(nzb+1:nzt,ig) = ref_gconc_l(nzb+1:nzt,ig) + & |
---|
12546 | salsa_gas(ig)%conc(nzb+1:nzt,nyn+1,i) |
---|
12547 | ENDDO |
---|
12548 | ENDDO |
---|
12549 | ENDIF |
---|
12550 | ENDIF |
---|
12551 | |
---|
12552 | IF ( bc_dirichlet_s ) THEN |
---|
12553 | DO ib = 1, nbins_aerosol |
---|
12554 | DO i = nxl, nxr |
---|
12555 | DO k = nzb+1, nzt |
---|
12556 | aerosol_number(ib)%conc(k,-1,i) = ( 1.0_wp - fac_dt ) * & |
---|
12557 | salsa_nest_offl%nconc_south(0,k,i,ib) + fac_dt * & |
---|
12558 | salsa_nest_offl%nconc_south(1,k,i,ib) |
---|
12559 | ENDDO |
---|
12560 | ref_nconc_l(nzb+1:nzt,ib) = ref_nconc_l(nzb+1:nzt,ib) + & |
---|
12561 | aerosol_number(ib)%conc(nzb+1:nzt,-1,i) |
---|
12562 | ENDDO |
---|
12563 | DO ic = 1, ncomponents_mass |
---|
12564 | icc = ( ic-1 ) * nbins_aerosol + ib |
---|
12565 | DO i = nxl, nxr |
---|
12566 | DO k = nzb+1, nzt |
---|
12567 | aerosol_mass(icc)%conc(k,-1,i) = ( 1.0_wp - fac_dt ) * & |
---|
12568 | salsa_nest_offl%mconc_south(0,k,i,icc) + fac_dt& |
---|
12569 | * salsa_nest_offl%mconc_south(1,k,i,icc) |
---|
12570 | ENDDO |
---|
12571 | ref_mconc_l(nzb+1:nzt,icc) = ref_mconc_l(nzb+1:nzt,icc) + & |
---|
12572 | aerosol_mass(icc)%conc(nzb+1:nzt,-1,i) |
---|
12573 | ENDDO |
---|
12574 | ENDDO |
---|
12575 | ENDDO |
---|
12576 | IF ( .NOT. salsa_gases_from_chem ) THEN |
---|
12577 | DO ig = 1, ngases_salsa |
---|
12578 | DO i = nxl, nxr |
---|
12579 | DO k = nzb+1, nzt |
---|
12580 | salsa_gas(ig)%conc(k,-1,i) = ( 1.0_wp - fac_dt ) * & |
---|
12581 | salsa_nest_offl%gconc_south(0,k,i,ig) + fac_dt * & |
---|
12582 | salsa_nest_offl%gconc_south(1,k,i,ig) |
---|
12583 | ENDDO |
---|
12584 | ref_gconc_l(nzb+1:nzt,ig) = ref_gconc_l(nzb+1:nzt,ig) + & |
---|
12585 | salsa_gas(ig)%conc(nzb+1:nzt,-1,i) |
---|
12586 | ENDDO |
---|
12587 | ENDDO |
---|
12588 | ENDIF |
---|
12589 | ENDIF |
---|
12590 | ! |
---|
12591 | !-- Top boundary |
---|
12592 | DO ib = 1, nbins_aerosol |
---|
12593 | DO i = nxl, nxr |
---|
12594 | DO j = nys, nyn |
---|
12595 | aerosol_number(ib)%conc(nzt+1,j,i) = ( 1.0_wp - fac_dt ) * & |
---|
12596 | salsa_nest_offl%nconc_top(0,j,i,ib) + fac_dt * & |
---|
12597 | salsa_nest_offl%nconc_top(1,j,i,ib) |
---|
12598 | ref_nconc_l(nzt+1,ib) = ref_nconc_l(nzt+1,ib) + aerosol_number(ib)%conc(nzt+1,j,i) |
---|
12599 | ENDDO |
---|
12600 | ENDDO |
---|
12601 | DO ic = 1, ncomponents_mass |
---|
12602 | icc = ( ic-1 ) * nbins_aerosol + ib |
---|
12603 | DO i = nxl, nxr |
---|
12604 | DO j = nys, nyn |
---|
12605 | aerosol_mass(icc)%conc(nzt+1,j,i) = ( 1.0_wp - fac_dt ) * & |
---|
12606 | salsa_nest_offl%mconc_top(0,j,i,icc) + fac_dt *& |
---|
12607 | salsa_nest_offl%mconc_top(1,j,i,icc) |
---|
12608 | ref_mconc_l(nzt+1,icc) = ref_mconc_l(nzt+1,icc) + aerosol_mass(icc)%conc(nzt+1,j,i) |
---|
12609 | ENDDO |
---|
12610 | ENDDO |
---|
12611 | ENDDO |
---|
12612 | ENDDO |
---|
12613 | IF ( .NOT. salsa_gases_from_chem ) THEN |
---|
12614 | DO ig = 1, ngases_salsa |
---|
12615 | DO i = nxl, nxr |
---|
12616 | DO j = nys, nyn |
---|
12617 | salsa_gas(ig)%conc(nzt+1,j,i) = ( 1.0_wp - fac_dt ) * & |
---|
12618 | salsa_nest_offl%gconc_top(0,j,i,ig) + fac_dt * & |
---|
12619 | salsa_nest_offl%gconc_top(1,j,i,ig) |
---|
12620 | ref_gconc_l(nzt+1,ig) = ref_gconc_l(nzt+1,ig) + salsa_gas(ig)%conc(nzt+1,j,i) |
---|
12621 | ENDDO |
---|
12622 | ENDDO |
---|
12623 | ENDDO |
---|
12624 | ENDIF |
---|
12625 | ! |
---|
12626 | !-- Do local exchange |
---|
12627 | DO ib = 1, nbins_aerosol |
---|
12628 | CALL exchange_horiz( aerosol_number(ib)%conc, nbgp ) |
---|
12629 | DO ic = 1, ncomponents_mass |
---|
12630 | icc = ( ic-1 ) * nbins_aerosol + ib |
---|
12631 | CALL exchange_horiz( aerosol_mass(icc)%conc, nbgp ) |
---|
12632 | ENDDO |
---|
12633 | ENDDO |
---|
12634 | IF ( .NOT. salsa_gases_from_chem ) THEN |
---|
12635 | DO ig = 1, ngases_salsa |
---|
12636 | CALL exchange_horiz( salsa_gas(ig)%conc, nbgp ) |
---|
12637 | ENDDO |
---|
12638 | ENDIF |
---|
12639 | ! |
---|
12640 | !-- In case of Rayleigh damping, where the initial profiles are still used, update these profiles |
---|
12641 | !-- from the averaged boundary data. But first, average these data. |
---|
12642 | #if defined( __parallel ) |
---|
12643 | IF ( .NOT. salsa_gases_from_chem ) & |
---|
12644 | CALL MPI_ALLREDUCE( ref_gconc_l, ref_gconc, ( nzt+1-nzb+1 ) * SIZE( ref_gconc(nzb,:) ), & |
---|
12645 | MPI_REAL, MPI_SUM, comm2d, ierr ) |
---|
12646 | CALL MPI_ALLREDUCE( ref_mconc_l, ref_mconc, ( nzt+1-nzb+1 ) * SIZE( ref_mconc(nzb,:) ), & |
---|
12647 | MPI_REAL, MPI_SUM, comm2d, ierr ) |
---|
12648 | CALL MPI_ALLREDUCE( ref_nconc_l, ref_nconc, ( nzt+1-nzb+1 ) * SIZE( ref_nconc(nzb,:) ), & |
---|
12649 | MPI_REAL, MPI_SUM, comm2d, ierr ) |
---|
12650 | #else |
---|
12651 | IF ( .NOT. salsa_gases_from_chem ) ref_gconc = ref_gconc_l |
---|
12652 | ref_mconc = ref_mconc_l |
---|
12653 | ref_nconc = ref_nconc_l |
---|
12654 | #endif |
---|
12655 | ! |
---|
12656 | !-- Average data. Note, reference profiles up to nzt are derived from lateral boundaries, at the |
---|
12657 | !-- model top it is derived from the top boundary. Thus, number of input data is different from |
---|
12658 | !-- nzb:nzt compared to nzt+1. |
---|
12659 | !-- Derived from lateral boundaries. |
---|
12660 | IF ( .NOT. salsa_gases_from_chem ) & |
---|
12661 | ref_gconc(nzb:nzt,:) = ref_gconc(nzb:nzt,:) / REAL( 2.0_wp * ( ny + 1 + nx + 1 ), KIND = wp ) |
---|
12662 | ref_mconc(nzb:nzt,:) = ref_mconc(nzb:nzt,:) / REAL( 2.0_wp * ( ny + 1 + nx + 1 ), KIND = wp ) |
---|
12663 | ref_nconc(nzb:nzt,:) = ref_nconc(nzb:nzt,:) / REAL( 2.0_wp * ( ny + 1 + nx + 1 ), KIND = wp ) |
---|
12664 | ! |
---|
12665 | !-- Derived from top boundary |
---|
12666 | IF ( .NOT. salsa_gases_from_chem ) & |
---|
12667 | ref_gconc(nzt+1,:) = ref_gconc(nzt+1,:) / REAL( ( ny + 1 ) * ( nx + 1 ), KIND = wp ) |
---|
12668 | ref_mconc(nzt+1,:) = ref_mconc(nzt+1,:) / REAL( ( ny + 1 ) * ( nx + 1 ), KIND = wp ) |
---|
12669 | ref_nconc(nzt+1,:) = ref_nconc(nzt+1,:) / REAL( ( ny + 1 ) * ( nx + 1 ), KIND = wp ) |
---|
12670 | ! |
---|
12671 | !-- Write onto init profiles, which are used for damping. Also set lower boundary condition. |
---|
12672 | DO ib = 1, nbins_aerosol |
---|
12673 | aerosol_number(ib)%init(:) = ref_nconc(:,ib) |
---|
12674 | aerosol_number(ib)%init(nzb) = aerosol_number(ib)%init(nzb+1) |
---|
12675 | DO ic = 1, ncomponents_mass |
---|
12676 | icc = ( ic-1 ) * nbins_aerosol + ib |
---|
12677 | aerosol_mass(icc)%init(:) = ref_mconc(:,icc) |
---|
12678 | aerosol_mass(icc)%init(nzb) = aerosol_mass(icc)%init(nzb+1) |
---|
12679 | ENDDO |
---|
12680 | ENDDO |
---|
12681 | IF ( .NOT. salsa_gases_from_chem ) THEN |
---|
12682 | DO ig = 1, ngases_salsa |
---|
12683 | salsa_gas(ig)%init(:) = ref_gconc(:,ig) |
---|
12684 | salsa_gas(ig)%init(nzb) = salsa_gas(ig)%init(nzb+1) |
---|
12685 | ENDDO |
---|
12686 | ENDIF |
---|
12687 | |
---|
12688 | DEALLOCATE( ref_gconc, ref_gconc_l, ref_mconc, ref_mconc_l, ref_nconc, ref_nconc_l ) |
---|
12689 | |
---|
12690 | END SUBROUTINE salsa_nesting_offl_bc |
---|
12691 | |
---|
12692 | !------------------------------------------------------------------------------! |
---|
12693 | ! Description: |
---|
12694 | ! ------------ |
---|
12695 | !> Allocate arrays used to read boundary data from NetCDF file and initialize |
---|
12696 | !> boundary data. |
---|
12697 | !------------------------------------------------------------------------------! |
---|
12698 | SUBROUTINE salsa_nesting_offl_init |
---|
12699 | |
---|
12700 | USE control_parameters, & |
---|
12701 | ONLY: end_time, initializing_actions, spinup_time |
---|
12702 | |
---|
12703 | USE palm_date_time_mod, & |
---|
12704 | ONLY: get_date_time |
---|
12705 | |
---|
12706 | IMPLICIT NONE |
---|
12707 | |
---|
12708 | INTEGER(iwp) :: ib !< running index for aerosol number bins |
---|
12709 | INTEGER(iwp) :: ic !< running index for aerosol mass bins |
---|
12710 | INTEGER(iwp) :: icc !< additional running index for aerosol mass bins |
---|
12711 | INTEGER(iwp) :: ig !< running index for gaseous species |
---|
12712 | INTEGER(iwp) :: nmass_bins !< number of aerosol mass bins |
---|
12713 | |
---|
12714 | nmass_bins = nbins_aerosol * ncomponents_mass |
---|
12715 | ! |
---|
12716 | !-- Allocate arrays for reading boundary values. Arrays will incorporate 2 time levels in order to |
---|
12717 | !-- interpolate in between. |
---|
12718 | IF ( nesting_offline_salsa ) THEN |
---|
12719 | IF ( bc_dirichlet_l ) THEN |
---|
12720 | ALLOCATE( salsa_nest_offl%nconc_left(0:1,nzb+1:nzt,nys:nyn,1:nbins_aerosol) ) |
---|
12721 | ALLOCATE( salsa_nest_offl%mconc_left(0:1,nzb+1:nzt,nys:nyn,1:nmass_bins) ) |
---|
12722 | ENDIF |
---|
12723 | IF ( bc_dirichlet_r ) THEN |
---|
12724 | ALLOCATE( salsa_nest_offl%nconc_right(0:1,nzb+1:nzt,nys:nyn,1:nbins_aerosol) ) |
---|
12725 | ALLOCATE( salsa_nest_offl%mconc_right(0:1,nzb+1:nzt,nys:nyn,1:nmass_bins) ) |
---|
12726 | ENDIF |
---|
12727 | IF ( bc_dirichlet_n ) THEN |
---|
12728 | ALLOCATE( salsa_nest_offl%nconc_north(0:1,nzb+1:nzt,nxl:nxr,1:nbins_aerosol) ) |
---|
12729 | ALLOCATE( salsa_nest_offl%mconc_north(0:1,nzb+1:nzt,nxl:nxr,1:nmass_bins) ) |
---|
12730 | ENDIF |
---|
12731 | IF ( bc_dirichlet_s ) THEN |
---|
12732 | ALLOCATE( salsa_nest_offl%nconc_south(0:1,nzb+1:nzt,nxl:nxr,1:nbins_aerosol) ) |
---|
12733 | ALLOCATE( salsa_nest_offl%mconc_south(0:1,nzb+1:nzt,nxl:nxr,1:nmass_bins) ) |
---|
12734 | ENDIF |
---|
12735 | ALLOCATE( salsa_nest_offl%nconc_top(0:1,nys:nyn,nxl:nxr,1:nbins_aerosol) ) |
---|
12736 | ALLOCATE( salsa_nest_offl%mconc_top(0:1,nys:nyn,nxl:nxr,1:nmass_bins) ) |
---|
12737 | |
---|
12738 | IF ( .NOT. salsa_gases_from_chem ) THEN |
---|
12739 | IF ( bc_dirichlet_l ) THEN |
---|
12740 | ALLOCATE( salsa_nest_offl%gconc_left(0:1,nzb+1:nzt,nys:nyn,1:ngases_salsa) ) |
---|
12741 | ENDIF |
---|
12742 | IF ( bc_dirichlet_r ) THEN |
---|
12743 | ALLOCATE( salsa_nest_offl%gconc_right(0:1,nzb+1:nzt,nys:nyn,1:ngases_salsa) ) |
---|
12744 | ENDIF |
---|
12745 | IF ( bc_dirichlet_n ) THEN |
---|
12746 | ALLOCATE( salsa_nest_offl%gconc_north(0:1,nzb+1:nzt,nxl:nxr,1:ngases_salsa) ) |
---|
12747 | ENDIF |
---|
12748 | IF ( bc_dirichlet_s ) THEN |
---|
12749 | ALLOCATE( salsa_nest_offl%gconc_south(0:1,nzb+1:nzt,nxl:nxr,1:ngases_salsa) ) |
---|
12750 | ENDIF |
---|
12751 | ALLOCATE( salsa_nest_offl%gconc_top(0:1,nys:nyn,nxl:nxr,1:ngases_salsa) ) |
---|
12752 | ENDIF |
---|
12753 | |
---|
12754 | ! |
---|
12755 | !-- Read data at lateral and top boundaries from a larger-scale model |
---|
12756 | CALL salsa_nesting_offl_input |
---|
12757 | ! |
---|
12758 | !-- Check if sufficient time steps are provided to cover the entire simulation. Note, dynamic |
---|
12759 | !-- input is only required for the 3D simulation, not for the soil/wall spinup. However, as the |
---|
12760 | !-- spinup time is added to the end_time, this must be considered here. |
---|
12761 | IF ( end_time - spinup_time > salsa_nest_offl%time(salsa_nest_offl%nt-1) ) THEN |
---|
12762 | message_string = 'end_time of the simulation exceeds the time dimension in the dynamic'//& |
---|
12763 | ' input file.' |
---|
12764 | CALL message( 'salsa_nesting_offl_init', 'PA0690', 1, 2, 0, 6, 0 ) |
---|
12765 | ENDIF |
---|
12766 | |
---|
12767 | IF ( salsa_nest_offl%time(0) /= 0.0_wp ) THEN |
---|
12768 | message_string = 'Offline nesting: time dimension must start at 0.0.' |
---|
12769 | CALL message( 'salsa_nesting_offl_init', 'PA0691', 1, 2, 0, 6, 0 ) |
---|
12770 | ENDIF |
---|
12771 | ! |
---|
12772 | !-- Initialize boundary data. Please note, do not initialize boundaries in case of restart runs. |
---|
12773 | IF ( TRIM( initializing_actions ) /= 'read_restart_data' .AND. read_restart_data_salsa ) & |
---|
12774 | THEN |
---|
12775 | IF ( bc_dirichlet_l ) THEN |
---|
12776 | DO ib = 1, nbins_aerosol |
---|
12777 | aerosol_number(ib)%conc(nzb+1:nzt,nys:nyn,-1) = & |
---|
12778 | salsa_nest_offl%nconc_left(0,nzb+1:nzt,nys:nyn,ib) |
---|
12779 | DO ic = 1, ncomponents_mass |
---|
12780 | icc = ( ic - 1 ) * nbins_aerosol + ib |
---|
12781 | aerosol_mass(icc)%conc(nzb+1:nzt,nys:nyn,-1) = & |
---|
12782 | salsa_nest_offl%mconc_left(0,nzb+1:nzt,nys:nyn,icc) |
---|
12783 | ENDDO |
---|
12784 | ENDDO |
---|
12785 | DO ig = 1, ngases_salsa |
---|
12786 | salsa_gas(ig)%conc(nzb+1:nzt,nys:nyn,-1) = & |
---|
12787 | salsa_nest_offl%gconc_left(0,nzb+1:nzt,nys:nyn,ig) |
---|
12788 | ENDDO |
---|
12789 | ENDIF |
---|
12790 | IF ( bc_dirichlet_r ) THEN |
---|
12791 | DO ib = 1, nbins_aerosol |
---|
12792 | aerosol_number(ib)%conc(nzb+1:nzt,nys:nyn,nxr+1) = & |
---|
12793 | salsa_nest_offl%nconc_right(0,nzb+1:nzt,nys:nyn,ib) |
---|
12794 | DO ic = 1, ncomponents_mass |
---|
12795 | icc = ( ic - 1 ) * nbins_aerosol + ib |
---|
12796 | aerosol_mass(icc)%conc(nzb+1:nzt,nys:nyn,nxr+1) = & |
---|
12797 | salsa_nest_offl%mconc_right(0,nzb+1:nzt,nys:nyn,icc) |
---|
12798 | ENDDO |
---|
12799 | ENDDO |
---|
12800 | DO ig = 1, ngases_salsa |
---|
12801 | salsa_gas(ig)%conc(nzb+1:nzt,nys:nyn,nxr+1) = & |
---|
12802 | salsa_nest_offl%gconc_right(0,nzb+1:nzt,nys:nyn,ig) |
---|
12803 | ENDDO |
---|
12804 | ENDIF |
---|
12805 | IF ( bc_dirichlet_n ) THEN |
---|
12806 | DO ib = 1, nbins_aerosol |
---|
12807 | aerosol_number(ib)%conc(nzb+1:nzt,nyn+1,nxl:nxr) = & |
---|
12808 | salsa_nest_offl%nconc_north(0,nzb+1:nzt,nxl:nxr,ib) |
---|
12809 | DO ic = 1, ncomponents_mass |
---|
12810 | icc = ( ic - 1 ) * nbins_aerosol + ib |
---|
12811 | aerosol_mass(icc)%conc(nzb+1:nzt,nyn+1,nxl:nxr) = & |
---|
12812 | salsa_nest_offl%mconc_north(0,nzb+1:nzt,nxl:nxr,icc) |
---|
12813 | ENDDO |
---|
12814 | ENDDO |
---|
12815 | DO ig = 1, ngases_salsa |
---|
12816 | salsa_gas(ig)%conc(nzb+1:nzt,nyn+1,nxl:nxr) = & |
---|
12817 | salsa_nest_offl%gconc_north(0,nzb+1:nzt,nxl:nxr,ig) |
---|
12818 | ENDDO |
---|
12819 | ENDIF |
---|
12820 | IF ( bc_dirichlet_s ) THEN |
---|
12821 | DO ib = 1, nbins_aerosol |
---|
12822 | aerosol_number(ib)%conc(nzb+1:nzt,-1,nxl:nxr) = & |
---|
12823 | salsa_nest_offl%nconc_south(0,nzb+1:nzt,nxl:nxr,ib) |
---|
12824 | DO ic = 1, ncomponents_mass |
---|
12825 | icc = ( ic - 1 ) * nbins_aerosol + ib |
---|
12826 | aerosol_mass(icc)%conc(nzb+1:nzt,-1,nxl:nxr) = & |
---|
12827 | salsa_nest_offl%mconc_south(0,nzb+1:nzt,nxl:nxr,icc) |
---|
12828 | ENDDO |
---|
12829 | ENDDO |
---|
12830 | DO ig = 1, ngases_salsa |
---|
12831 | salsa_gas(ig)%conc(nzb+1:nzt,-1,nxl:nxr) = & |
---|
12832 | salsa_nest_offl%gconc_south(0,nzb+1:nzt,nxl:nxr,ig) |
---|
12833 | ENDDO |
---|
12834 | ENDIF |
---|
12835 | ENDIF |
---|
12836 | ENDIF |
---|
12837 | |
---|
12838 | END SUBROUTINE salsa_nesting_offl_init |
---|
12839 | |
---|
12840 | !------------------------------------------------------------------------------! |
---|
12841 | ! Description: |
---|
12842 | ! ------------ |
---|
12843 | !> Set the lateral and top boundary conditions in case the PALM domain is |
---|
12844 | !> nested offline in a mesoscale model. Further, average boundary data and |
---|
12845 | !> determine mean profiles, further used for correct damping in the sponge |
---|
12846 | !> layer. |
---|
12847 | !------------------------------------------------------------------------------! |
---|
12848 | SUBROUTINE salsa_nesting_offl_input |
---|
12849 | |
---|
12850 | USE netcdf_data_input_mod, & |
---|
12851 | ONLY: check_existence, close_input_file, get_attribute, get_variable, & |
---|
12852 | inquire_num_variables, inquire_variable_names, & |
---|
12853 | get_dimension_length, open_read_file |
---|
12854 | |
---|
12855 | IMPLICIT NONE |
---|
12856 | |
---|
12857 | CHARACTER(LEN=25) :: vname !< variable name |
---|
12858 | |
---|
12859 | INTEGER(iwp) :: ic !< running index for aerosol chemical components |
---|
12860 | INTEGER(iwp) :: ig !< running index for gases |
---|
12861 | INTEGER(iwp) :: num_vars !< number of variables in netcdf input file |
---|
12862 | |
---|
12863 | ! |
---|
12864 | !-- Skip input if no forcing from larger-scale models is applied. |
---|
12865 | IF ( .NOT. nesting_offline_salsa ) RETURN |
---|
12866 | ! |
---|
12867 | !-- Initialise |
---|
12868 | IF ( .NOT. salsa_nest_offl%init ) THEN |
---|
12869 | |
---|
12870 | #if defined ( __netcdf ) |
---|
12871 | ! |
---|
12872 | !-- Open file in read-only mode |
---|
12873 | CALL open_read_file( TRIM( input_file_dynamic ) // TRIM( coupling_char ), & |
---|
12874 | salsa_nest_offl%id_dynamic ) |
---|
12875 | ! |
---|
12876 | !-- At first, inquire all variable names. |
---|
12877 | CALL inquire_num_variables( salsa_nest_offl%id_dynamic, num_vars ) |
---|
12878 | ! |
---|
12879 | !-- Allocate memory to store variable names. |
---|
12880 | ALLOCATE( salsa_nest_offl%var_names(1:num_vars) ) |
---|
12881 | CALL inquire_variable_names( salsa_nest_offl%id_dynamic, salsa_nest_offl%var_names ) |
---|
12882 | ! |
---|
12883 | !-- Read time dimension, allocate memory and finally read time array |
---|
12884 | CALL get_dimension_length( salsa_nest_offl%id_dynamic, salsa_nest_offl%nt,& |
---|
12885 | 'time' ) |
---|
12886 | |
---|
12887 | IF ( check_existence( salsa_nest_offl%var_names, 'time' ) ) THEN |
---|
12888 | ALLOCATE( salsa_nest_offl%time(0:salsa_nest_offl%nt-1) ) |
---|
12889 | CALL get_variable( salsa_nest_offl%id_dynamic, 'time', salsa_nest_offl%time ) |
---|
12890 | ENDIF |
---|
12891 | ! |
---|
12892 | !-- Read the vertical dimension |
---|
12893 | CALL get_dimension_length( salsa_nest_offl%id_dynamic, salsa_nest_offl%nzu, 'z' ) |
---|
12894 | ALLOCATE( salsa_nest_offl%zu_atmos(1:salsa_nest_offl%nzu) ) |
---|
12895 | CALL get_variable( salsa_nest_offl%id_dynamic, 'z', salsa_nest_offl%zu_atmos ) |
---|
12896 | ! |
---|
12897 | !-- Read the number of aerosol chemical components |
---|
12898 | CALL get_dimension_length( salsa_nest_offl%id_dynamic, salsa_nest_offl%ncc, & |
---|
12899 | 'composition_index' ) |
---|
12900 | ! |
---|
12901 | !-- Read the names of aerosol chemical components |
---|
12902 | CALL get_variable( salsa_nest_offl%id_dynamic, 'composition_name', salsa_nest_offl%cc_name, & |
---|
12903 | salsa_nest_offl%ncc ) |
---|
12904 | ! |
---|
12905 | !-- Define the index of each chemical component in the model |
---|
12906 | DO ic = 1, salsa_nest_offl%ncc |
---|
12907 | SELECT CASE ( TRIM( salsa_nest_offl%cc_name(ic) ) ) |
---|
12908 | CASE ( 'H2SO4', 'SO4', 'h2so4', 'so4' ) |
---|
12909 | salsa_nest_offl%cc_in2mod(1) = ic |
---|
12910 | CASE ( 'OC', 'oc' ) |
---|
12911 | salsa_nest_offl%cc_in2mod(2) = ic |
---|
12912 | CASE ( 'BC', 'bc' ) |
---|
12913 | salsa_nest_offl%cc_in2mod(3) = ic |
---|
12914 | CASE ( 'DU', 'du' ) |
---|
12915 | salsa_nest_offl%cc_in2mod(4) = ic |
---|
12916 | CASE ( 'SS', 'ss' ) |
---|
12917 | salsa_nest_offl%cc_in2mod(5) = ic |
---|
12918 | CASE ( 'HNO3', 'hno3', 'NO3', 'no3', 'NO', 'no' ) |
---|
12919 | salsa_nest_offl%cc_in2mod(6) = ic |
---|
12920 | CASE ( 'NH3', 'nh3', 'NH4', 'nh4', 'NH', 'nh' ) |
---|
12921 | salsa_nest_offl%cc_in2mod(7) = ic |
---|
12922 | END SELECT |
---|
12923 | ENDDO |
---|
12924 | IF ( SUM( salsa_nest_offl%cc_in2mod ) == 0 ) THEN |
---|
12925 | message_string = 'None of the aerosol chemical components in ' // & |
---|
12926 | TRIM( input_file_dynamic ) // ' correspond to ones applied in SALSA.' |
---|
12927 | CALL message( 'salsa_mod: salsa_nesting_offl_input', 'PA0693', 2, 2, 0, 6, 0 ) |
---|
12928 | ENDIF |
---|
12929 | |
---|
12930 | CALL close_input_file( salsa_nest_offl%id_dynamic ) |
---|
12931 | #endif |
---|
12932 | ENDIF |
---|
12933 | ! |
---|
12934 | !-- Check if dynamic driver data input is required. |
---|
12935 | IF ( salsa_nest_offl%time(salsa_nest_offl%tind_p) <= MAX( time_since_reference_point, 0.0_wp) & |
---|
12936 | .OR. .NOT. salsa_nest_offl%init ) THEN |
---|
12937 | CONTINUE |
---|
12938 | ! |
---|
12939 | !-- Return otherwise |
---|
12940 | ELSE |
---|
12941 | RETURN |
---|
12942 | ENDIF |
---|
12943 | ! |
---|
12944 | !-- Obtain time index for current point in time. |
---|
12945 | salsa_nest_offl%tind = MINLOC( ABS( salsa_nest_offl%time - & |
---|
12946 | MAX( time_since_reference_point, 0.0_wp ) ), DIM = 1 ) - 1 |
---|
12947 | salsa_nest_offl%tind_p = salsa_nest_offl%tind + 1 |
---|
12948 | ! |
---|
12949 | !-- Open file in read-only mode |
---|
12950 | #if defined ( __netcdf ) |
---|
12951 | |
---|
12952 | CALL open_read_file( TRIM( input_file_dynamic ) // TRIM( coupling_char ), & |
---|
12953 | salsa_nest_offl%id_dynamic ) |
---|
12954 | ! |
---|
12955 | !-- Read data at the western boundary |
---|
12956 | CALL get_variable( salsa_nest_offl%id_dynamic, 'ls_forcing_left_aerosol', & |
---|
12957 | salsa_nest_offl%nconc_left, & |
---|
12958 | MERGE( 0, 1, bc_dirichlet_l ), MERGE( nbins_aerosol-1, 0, bc_dirichlet_l ), & |
---|
12959 | MERGE( nys, 1, bc_dirichlet_l ), MERGE( nyn, 0, bc_dirichlet_l ), & |
---|
12960 | MERGE( nzb, 1, bc_dirichlet_l ), MERGE( nzt-1, 0, bc_dirichlet_l ), & |
---|
12961 | MERGE( salsa_nest_offl%tind, 1, bc_dirichlet_l ), & |
---|
12962 | MERGE( salsa_nest_offl%tind_p, 0, bc_dirichlet_l ) ) |
---|
12963 | IF ( bc_dirichlet_l ) THEN |
---|
12964 | salsa_nest_offl%nconc_left = MAX( nclim, salsa_nest_offl%nconc_left ) |
---|
12965 | CALL nesting_offl_aero_mass( salsa_nest_offl%tind, salsa_nest_offl%tind_p, nzb+1, nzt, nys, & |
---|
12966 | nyn, 'ls_forcing_left_mass_fracs_a', 1 ) |
---|
12967 | ENDIF |
---|
12968 | IF ( .NOT. salsa_gases_from_chem ) THEN |
---|
12969 | DO ig = 1, ngases_salsa |
---|
12970 | vname = salsa_nest_offl%char_l // salsa_nest_offl%gas_name(ig) |
---|
12971 | CALL get_variable( salsa_nest_offl%id_dynamic, TRIM( vname ), & |
---|
12972 | salsa_nest_offl%gconc_left(:,:,:,ig), & |
---|
12973 | MERGE( nys, 1, bc_dirichlet_l ), MERGE( nyn, 0, bc_dirichlet_l ), & |
---|
12974 | MERGE( nzb, 1, bc_dirichlet_l ), MERGE( nzt-1, 0, bc_dirichlet_l ), & |
---|
12975 | MERGE( salsa_nest_offl%tind, 1, bc_dirichlet_l ), & |
---|
12976 | MERGE( salsa_nest_offl%tind_p, 0, bc_dirichlet_l ) ) |
---|
12977 | IF ( bc_dirichlet_l ) salsa_nest_offl%gconc_left(:,:,:,ig) = & |
---|
12978 | MAX( nclim, salsa_nest_offl%gconc_left(:,:,:,ig) ) |
---|
12979 | ENDDO |
---|
12980 | ENDIF |
---|
12981 | ! |
---|
12982 | !-- Read data at the eastern boundary |
---|
12983 | CALL get_variable( salsa_nest_offl%id_dynamic, 'ls_forcing_right_aerosol', & |
---|
12984 | salsa_nest_offl%nconc_right, & |
---|
12985 | MERGE( 0, 1, bc_dirichlet_r ), MERGE( nbins_aerosol-1, 0, bc_dirichlet_r ), & |
---|
12986 | MERGE( nys, 1, bc_dirichlet_r ), MERGE( nyn, 0, bc_dirichlet_r ), & |
---|
12987 | MERGE( nzb, 1, bc_dirichlet_r ), MERGE( nzt-1, 0, bc_dirichlet_r ), & |
---|
12988 | MERGE( salsa_nest_offl%tind, 1, bc_dirichlet_r ), & |
---|
12989 | MERGE( salsa_nest_offl%tind_p, 0, bc_dirichlet_r ) ) |
---|
12990 | IF ( bc_dirichlet_r ) THEN |
---|
12991 | salsa_nest_offl%nconc_right = MAX( nclim, salsa_nest_offl%nconc_right ) |
---|
12992 | CALL nesting_offl_aero_mass( salsa_nest_offl%tind, salsa_nest_offl%tind_p, nzb+1, nzt, nys, & |
---|
12993 | nyn, 'ls_forcing_right_mass_fracs_a', 2 ) |
---|
12994 | ENDIF |
---|
12995 | IF ( .NOT. salsa_gases_from_chem ) THEN |
---|
12996 | DO ig = 1, ngases_salsa |
---|
12997 | vname = salsa_nest_offl%char_r // salsa_nest_offl%gas_name(ig) |
---|
12998 | CALL get_variable( salsa_nest_offl%id_dynamic, TRIM( vname ), & |
---|
12999 | salsa_nest_offl%gconc_right(:,:,:,ig), & |
---|
13000 | MERGE( nys, 1, bc_dirichlet_r ), MERGE( nyn, 0, bc_dirichlet_r ), & |
---|
13001 | MERGE( nzb, 1, bc_dirichlet_r ), MERGE( nzt-1, 0, bc_dirichlet_r ), & |
---|
13002 | MERGE( salsa_nest_offl%tind, 1, bc_dirichlet_r ), & |
---|
13003 | MERGE( salsa_nest_offl%tind_p, 0, bc_dirichlet_r ) ) |
---|
13004 | IF ( bc_dirichlet_r ) salsa_nest_offl%gconc_right(:,:,:,ig) = & |
---|
13005 | MAX( nclim, salsa_nest_offl%gconc_right(:,:,:,ig) ) |
---|
13006 | ENDDO |
---|
13007 | ENDIF |
---|
13008 | ! |
---|
13009 | !-- Read data at the northern boundary |
---|
13010 | CALL get_variable( salsa_nest_offl%id_dynamic, 'ls_forcing_north_aerosol', & |
---|
13011 | salsa_nest_offl%nconc_north, & |
---|
13012 | MERGE( 0, 1, bc_dirichlet_n ), MERGE( nbins_aerosol-1, 0, bc_dirichlet_n ), & |
---|
13013 | MERGE( nxl, 1, bc_dirichlet_n ), MERGE( nxr, 0, bc_dirichlet_n ), & |
---|
13014 | MERGE( nzb, 1, bc_dirichlet_n ), MERGE( nzt-1, 0, bc_dirichlet_n ), & |
---|
13015 | MERGE( salsa_nest_offl%tind, 1, bc_dirichlet_n ), & |
---|
13016 | MERGE( salsa_nest_offl%tind_p, 0, bc_dirichlet_n ) ) |
---|
13017 | IF ( bc_dirichlet_n ) THEN |
---|
13018 | salsa_nest_offl%nconc_north = MAX( nclim, salsa_nest_offl%nconc_north ) |
---|
13019 | CALL nesting_offl_aero_mass( salsa_nest_offl%tind, salsa_nest_offl%tind_p, nzb+1, nzt, nxl, & |
---|
13020 | nxr, 'ls_forcing_north_mass_fracs_a', 3 ) |
---|
13021 | ENDIF |
---|
13022 | IF ( .NOT. salsa_gases_from_chem ) THEN |
---|
13023 | DO ig = 1, ngases_salsa |
---|
13024 | vname = salsa_nest_offl%char_n // salsa_nest_offl%gas_name(ig) |
---|
13025 | CALL get_variable( salsa_nest_offl%id_dynamic, TRIM( vname ), & |
---|
13026 | salsa_nest_offl%gconc_north(:,:,:,ig), & |
---|
13027 | MERGE( nxl, 1, bc_dirichlet_n ), MERGE( nxr, 0, bc_dirichlet_n ), & |
---|
13028 | MERGE( nzb, 1, bc_dirichlet_n ), MERGE( nzt-1, 0, bc_dirichlet_n ), & |
---|
13029 | MERGE( salsa_nest_offl%tind, 1, bc_dirichlet_n ), & |
---|
13030 | MERGE( salsa_nest_offl%tind_p, 0, bc_dirichlet_n ) ) |
---|
13031 | IF ( bc_dirichlet_n ) salsa_nest_offl%gconc_north(:,:,:,ig) = & |
---|
13032 | MAX( nclim, salsa_nest_offl%gconc_north(:,:,:,ig) ) |
---|
13033 | ENDDO |
---|
13034 | ENDIF |
---|
13035 | ! |
---|
13036 | !-- Read data at the southern boundary |
---|
13037 | CALL get_variable( salsa_nest_offl%id_dynamic, 'ls_forcing_south_aerosol', & |
---|
13038 | salsa_nest_offl%nconc_south, & |
---|
13039 | MERGE( 0, 1, bc_dirichlet_s ), MERGE( nbins_aerosol-1, 0, bc_dirichlet_s ), & |
---|
13040 | MERGE( nxl, 1, bc_dirichlet_s ), MERGE( nxr, 0, bc_dirichlet_s ), & |
---|
13041 | MERGE( nzb, 1, bc_dirichlet_s ), MERGE( nzt-1, 0, bc_dirichlet_s ), & |
---|
13042 | MERGE( salsa_nest_offl%tind, 1, bc_dirichlet_s ), & |
---|
13043 | MERGE( salsa_nest_offl%tind_p, 0, bc_dirichlet_s ) ) |
---|
13044 | IF ( bc_dirichlet_s ) THEN |
---|
13045 | salsa_nest_offl%nconc_south = MAX( nclim, salsa_nest_offl%nconc_south ) |
---|
13046 | CALL nesting_offl_aero_mass( salsa_nest_offl%tind, salsa_nest_offl%tind_p, nzb+1, nzt, nxl, & |
---|
13047 | nxr, 'ls_forcing_south_mass_fracs_a', 4 ) |
---|
13048 | ENDIF |
---|
13049 | IF ( .NOT. salsa_gases_from_chem ) THEN |
---|
13050 | DO ig = 1, ngases_salsa |
---|
13051 | vname = salsa_nest_offl%char_s // salsa_nest_offl%gas_name(ig) |
---|
13052 | CALL get_variable( salsa_nest_offl%id_dynamic, TRIM( vname ), & |
---|
13053 | salsa_nest_offl%gconc_south(:,:,:,ig), & |
---|
13054 | MERGE( nxl, 1, bc_dirichlet_s ), MERGE( nxr, 0, bc_dirichlet_s ), & |
---|
13055 | MERGE( nzb, 1, bc_dirichlet_s ), MERGE( nzt-1, 0, bc_dirichlet_s ), & |
---|
13056 | MERGE( salsa_nest_offl%tind, 1, bc_dirichlet_s ), & |
---|
13057 | MERGE( salsa_nest_offl%tind_p, 0, bc_dirichlet_s ) ) |
---|
13058 | IF ( bc_dirichlet_s ) salsa_nest_offl%gconc_south(:,:,:,ig) = & |
---|
13059 | MAX( nclim, salsa_nest_offl%gconc_south(:,:,:,ig) ) |
---|
13060 | ENDDO |
---|
13061 | ENDIF |
---|
13062 | ! |
---|
13063 | !-- Read data at the top boundary |
---|
13064 | CALL get_variable( salsa_nest_offl%id_dynamic, 'ls_forcing_top_aerosol', & |
---|
13065 | salsa_nest_offl%nconc_top(0:1,nys:nyn,nxl:nxr,1:nbins_aerosol), & |
---|
13066 | 0, nbins_aerosol-1, nxl, nxr, nys, nyn, salsa_nest_offl%tind, & |
---|
13067 | salsa_nest_offl%tind_p ) |
---|
13068 | salsa_nest_offl%nconc_top = MAX( nclim, salsa_nest_offl%nconc_top ) |
---|
13069 | CALL nesting_offl_aero_mass( salsa_nest_offl%tind, salsa_nest_offl%tind_p, nys, nyn, nxl, nxr, & |
---|
13070 | 'ls_forcing_top_mass_fracs_a', 5 ) |
---|
13071 | IF ( .NOT. salsa_gases_from_chem ) THEN |
---|
13072 | DO ig = 1, ngases_salsa |
---|
13073 | vname = salsa_nest_offl%char_t // salsa_nest_offl%gas_name(ig) |
---|
13074 | CALL get_variable( salsa_nest_offl%id_dynamic, TRIM( vname ), & |
---|
13075 | salsa_nest_offl%gconc_top(:,:,:,ig), nxl, nxr, nys, nyn, & |
---|
13076 | salsa_nest_offl%tind, salsa_nest_offl%tind_p ) |
---|
13077 | salsa_nest_offl%gconc_top(:,:,:,ig) = MAX( nclim, salsa_nest_offl%gconc_top(:,:,:,ig) ) |
---|
13078 | ENDDO |
---|
13079 | ENDIF |
---|
13080 | ! |
---|
13081 | !-- Close input file |
---|
13082 | CALL close_input_file( salsa_nest_offl%id_dynamic ) |
---|
13083 | |
---|
13084 | #endif |
---|
13085 | ! |
---|
13086 | !-- Set control flag to indicate that initialization is already done |
---|
13087 | salsa_nest_offl%init = .TRUE. |
---|
13088 | |
---|
13089 | END SUBROUTINE salsa_nesting_offl_input |
---|
13090 | |
---|
13091 | !------------------------------------------------------------------------------! |
---|
13092 | ! Description: |
---|
13093 | ! ------------ |
---|
13094 | !> Sets the mass concentrations to aerosol arrays in 2a and 2b. |
---|
13095 | !------------------------------------------------------------------------------! |
---|
13096 | SUBROUTINE nesting_offl_aero_mass( ts, te, ks, ke, is, ie, varname_a, ibound ) |
---|
13097 | |
---|
13098 | USE netcdf_data_input_mod, & |
---|
13099 | ONLY: get_variable |
---|
13100 | |
---|
13101 | IMPLICIT NONE |
---|
13102 | |
---|
13103 | CHARACTER(LEN=25) :: varname_b !< name for bins b |
---|
13104 | |
---|
13105 | CHARACTER(LEN=*), INTENT(in) :: varname_a !< name for bins a |
---|
13106 | |
---|
13107 | INTEGER(iwp) :: ee !< loop index: end |
---|
13108 | INTEGER(iwp) :: i !< loop index |
---|
13109 | INTEGER(iwp) :: ib !< loop index |
---|
13110 | INTEGER(iwp) :: ic !< loop index |
---|
13111 | INTEGER(iwp) :: k !< loop index |
---|
13112 | INTEGER(iwp) :: ss !< loop index: start |
---|
13113 | INTEGER(iwp) :: t !< loop index |
---|
13114 | INTEGER(iwp) :: type_so4_oc = -1 !< |
---|
13115 | |
---|
13116 | INTEGER(iwp), INTENT(in) :: ibound !< index: 1=left, 2=right, 3=north, 4=south, 5=top |
---|
13117 | INTEGER(iwp), INTENT(in) :: ie !< loop index |
---|
13118 | INTEGER(iwp), INTENT(in) :: is !< loop index |
---|
13119 | INTEGER(iwp), INTENT(in) :: ks !< loop index |
---|
13120 | INTEGER(iwp), INTENT(in) :: ke !< loop index |
---|
13121 | INTEGER(iwp), INTENT(in) :: ts !< loop index |
---|
13122 | INTEGER(iwp), INTENT(in) :: te !< loop index |
---|
13123 | |
---|
13124 | INTEGER(iwp), DIMENSION(maxspec) :: cc_i2m !< |
---|
13125 | |
---|
13126 | REAL(wp) :: pmf1a !< mass fraction in 1a |
---|
13127 | |
---|
13128 | REAL(wp), DIMENSION(nbins_aerosol) :: core !< size of the bin mid aerosol particle |
---|
13129 | |
---|
13130 | REAL(wp), DIMENSION(0:1,ks:ke,is:ie,1:nbins_aerosol) :: to_nconc !< |
---|
13131 | REAL(wp), DIMENSION(0:1,ks:ke,is:ie,1:nbins_aerosol*ncomponents_mass) :: to_mconc !< |
---|
13132 | |
---|
13133 | REAL(wp), DIMENSION(:,:,:,:), ALLOCATABLE :: mf2a !< Mass distributions for a |
---|
13134 | REAL(wp), DIMENSION(:,:,:,:), ALLOCATABLE :: mf2b !< and b bins |
---|
13135 | |
---|
13136 | ! |
---|
13137 | !-- Variable name for insoluble mass fraction |
---|
13138 | varname_b = varname_a(1:LEN( TRIM( varname_a ) ) - 1 ) // 'b' |
---|
13139 | ! |
---|
13140 | !-- Bin mean aerosol particle volume (m3) |
---|
13141 | core(1:nbins_aerosol) = api6 * aero(1:nbins_aerosol)%dmid**3 |
---|
13142 | ! |
---|
13143 | !-- Allocate and read mass fraction arrays |
---|
13144 | ALLOCATE( mf2a(0:1,ks:ke,is:ie,1:salsa_nest_offl%ncc), & |
---|
13145 | mf2b(0:1,ks:ke,is:ie,1:salsa_nest_offl%ncc) ) |
---|
13146 | IF ( ibound == 5 ) THEN |
---|
13147 | CALL get_variable( salsa_nest_offl%id_dynamic, varname_a, & |
---|
13148 | mf2a(0:1,ks:ke,is:ie,1:salsa_nest_offl%ncc), 0, salsa_nest_offl%ncc-1, & |
---|
13149 | is, ie, ks, ke, ts, te ) |
---|
13150 | ELSE |
---|
13151 | CALL get_variable( salsa_nest_offl%id_dynamic, varname_a, & |
---|
13152 | mf2a(0:1,ks:ke,is:ie,1:salsa_nest_offl%ncc), 0, salsa_nest_offl%ncc-1, & |
---|
13153 | is, ie, ks-1, ke-1, ts, te ) |
---|
13154 | ENDIF |
---|
13155 | ! |
---|
13156 | !-- If the chemical component is not activated, set its mass fraction to 0 to avoid mass inbalance |
---|
13157 | cc_i2m = salsa_nest_offl%cc_in2mod |
---|
13158 | IF ( index_so4 < 0 .AND. cc_i2m(1) > 0 ) mf2a(:,:,:,cc_i2m(1)) = 0.0_wp |
---|
13159 | IF ( index_oc < 0 .AND. cc_i2m(2) > 0 ) mf2a(:,:,:,cc_i2m(2)) = 0.0_wp |
---|
13160 | IF ( index_bc < 0 .AND. cc_i2m(3) > 0 ) mf2a(:,:,:,cc_i2m(3)) = 0.0_wp |
---|
13161 | IF ( index_du < 0 .AND. cc_i2m(4) > 0 ) mf2a(:,:,:,cc_i2m(4)) = 0.0_wp |
---|
13162 | IF ( index_ss < 0 .AND. cc_i2m(5) > 0 ) mf2a(:,:,:,cc_i2m(5)) = 0.0_wp |
---|
13163 | IF ( index_no < 0 .AND. cc_i2m(6) > 0 ) mf2a(:,:,:,cc_i2m(6)) = 0.0_wp |
---|
13164 | IF ( index_nh < 0 .AND. cc_i2m(7) > 0 ) mf2a(:,:,:,cc_i2m(7)) = 0.0_wp |
---|
13165 | mf2b = 0.0_wp |
---|
13166 | ! |
---|
13167 | !-- Initialise variable type_so4_oc to indicate whether SO4 and/OC is included in mass fraction data |
---|
13168 | IF ( ( cc_i2m(1) > 0 .AND. index_so4 > 0 ) .AND. ( cc_i2m(2) > 0 .AND. index_oc > 0 ) ) & |
---|
13169 | THEN |
---|
13170 | type_so4_oc = 1 |
---|
13171 | ELSEIF ( cc_i2m(1) > 0 .AND. index_so4 > 0 ) THEN |
---|
13172 | type_so4_oc = 2 |
---|
13173 | ELSEIF ( cc_i2m(2) > 0 .AND. index_oc > 0 ) THEN |
---|
13174 | type_so4_oc = 3 |
---|
13175 | ENDIF |
---|
13176 | |
---|
13177 | SELECT CASE ( ibound ) |
---|
13178 | CASE( 1 ) |
---|
13179 | to_nconc = salsa_nest_offl%nconc_left |
---|
13180 | to_mconc = salsa_nest_offl%mconc_left |
---|
13181 | CASE( 2 ) |
---|
13182 | to_nconc = salsa_nest_offl%nconc_right |
---|
13183 | to_mconc = salsa_nest_offl%mconc_right |
---|
13184 | CASE( 3 ) |
---|
13185 | to_nconc = salsa_nest_offl%nconc_north |
---|
13186 | to_mconc = salsa_nest_offl%mconc_north |
---|
13187 | CASE( 4 ) |
---|
13188 | to_nconc = salsa_nest_offl%nconc_south |
---|
13189 | to_mconc = salsa_nest_offl%mconc_south |
---|
13190 | CASE( 5 ) |
---|
13191 | to_nconc = salsa_nest_offl%nconc_top |
---|
13192 | to_mconc = salsa_nest_offl%mconc_top |
---|
13193 | END SELECT |
---|
13194 | ! |
---|
13195 | !-- Set mass concentrations: |
---|
13196 | ! |
---|
13197 | !-- Regime 1: |
---|
13198 | SELECT CASE ( type_so4_oc ) |
---|
13199 | CASE ( 1 ) ! Both SO4 and OC given |
---|
13200 | |
---|
13201 | ss = ( index_so4 - 1 ) * nbins_aerosol + start_subrange_1a ! start |
---|
13202 | ee = ( index_so4 - 1 ) * nbins_aerosol + end_subrange_1a ! end |
---|
13203 | ib = start_subrange_1a |
---|
13204 | DO ic = ss, ee |
---|
13205 | DO i = is, ie |
---|
13206 | DO k = ks, ke |
---|
13207 | DO t = 0, 1 |
---|
13208 | pmf1a = mf2a(t,k,i,cc_i2m(1)) / ( mf2a(t,k,i,cc_i2m(1)) + mf2a(t,k,i,cc_i2m(2)) ) |
---|
13209 | to_mconc(t,k,i,ic) = pmf1a * to_nconc(t,k,i,ib) * core(ib) * arhoh2so4 |
---|
13210 | ENDDO |
---|
13211 | ENDDO |
---|
13212 | ENDDO |
---|
13213 | ib = ib + 1 |
---|
13214 | ENDDO |
---|
13215 | ss = ( index_oc - 1 ) * nbins_aerosol + start_subrange_1a ! start |
---|
13216 | ee = ( index_oc - 1 ) * nbins_aerosol + end_subrange_1a ! end |
---|
13217 | ib = start_subrange_1a |
---|
13218 | DO ic = ss, ee |
---|
13219 | DO i = is, ie |
---|
13220 | DO k = ks, ke |
---|
13221 | DO t = 0, 1 |
---|
13222 | pmf1a = mf2a(t,k,i,cc_i2m(2)) / ( mf2a(t,k,i,cc_i2m(1)) + mf2a(t,k,i,cc_i2m(2)) ) |
---|
13223 | to_mconc(t,k,i,ic) = pmf1a * to_nconc(t,k,i,ib) * core(ib) * arhooc |
---|
13224 | ENDDO |
---|
13225 | ENDDO |
---|
13226 | ENDDO |
---|
13227 | ib = ib + 1 |
---|
13228 | ENDDO |
---|
13229 | CASE ( 2 ) ! Only SO4 |
---|
13230 | ss = ( index_so4 - 1 ) * nbins_aerosol + start_subrange_1a ! start |
---|
13231 | ee = ( index_so4 - 1 ) * nbins_aerosol + end_subrange_1a ! end |
---|
13232 | ib = start_subrange_1a |
---|
13233 | DO ic = ss, ee |
---|
13234 | DO i = is, ie |
---|
13235 | DO k = ks, ke |
---|
13236 | DO t = 0, 1 |
---|
13237 | to_mconc(t,k,i,ic) = to_nconc(t,k,i,ib) * core(ib) * arhoh2so4 |
---|
13238 | ENDDO |
---|
13239 | ENDDO |
---|
13240 | ENDDO |
---|
13241 | ib = ib + 1 |
---|
13242 | ENDDO |
---|
13243 | CASE ( 3 ) ! Only OC |
---|
13244 | ss = ( index_oc - 1 ) * nbins_aerosol + start_subrange_1a ! start |
---|
13245 | ee = ( index_oc - 1 ) * nbins_aerosol + end_subrange_1a ! end |
---|
13246 | ib = start_subrange_1a |
---|
13247 | DO ic = ss, ee |
---|
13248 | DO i = is, ie |
---|
13249 | DO k = ks, ke |
---|
13250 | DO t = 0, 1 |
---|
13251 | to_mconc(t,k,i,ic) = to_nconc(t,k,i,ib) * core(ib) * arhooc |
---|
13252 | ENDDO |
---|
13253 | ENDDO |
---|
13254 | ENDDO |
---|
13255 | ib = ib + 1 |
---|
13256 | ENDDO |
---|
13257 | END SELECT |
---|
13258 | ! |
---|
13259 | !-- Regimes 2a and 2b: |
---|
13260 | IF ( index_so4 > 0 ) THEN |
---|
13261 | CALL set_nest_mass( index_so4, 1, arhoh2so4 ) |
---|
13262 | ENDIF |
---|
13263 | IF ( index_oc > 0 ) THEN |
---|
13264 | CALL set_nest_mass( index_oc, 2, arhooc ) |
---|
13265 | ENDIF |
---|
13266 | IF ( index_bc > 0 ) THEN |
---|
13267 | CALL set_nest_mass( index_bc, 3, arhobc ) |
---|
13268 | ENDIF |
---|
13269 | IF ( index_du > 0 ) THEN |
---|
13270 | CALL set_nest_mass( index_du, 4, arhodu ) |
---|
13271 | ENDIF |
---|
13272 | IF ( index_ss > 0 ) THEN |
---|
13273 | CALL set_nest_mass( index_ss, 5, arhoss ) |
---|
13274 | ENDIF |
---|
13275 | IF ( index_no > 0 ) THEN |
---|
13276 | CALL set_nest_mass( index_no, 6, arhohno3 ) |
---|
13277 | ENDIF |
---|
13278 | IF ( index_nh > 0 ) THEN |
---|
13279 | CALL set_nest_mass( index_nh, 7, arhonh3 ) |
---|
13280 | ENDIF |
---|
13281 | |
---|
13282 | DEALLOCATE( mf2a, mf2b ) |
---|
13283 | |
---|
13284 | SELECT CASE ( ibound ) |
---|
13285 | CASE( 1 ) |
---|
13286 | salsa_nest_offl%mconc_left = to_mconc |
---|
13287 | CASE( 2 ) |
---|
13288 | salsa_nest_offl%mconc_right = to_mconc |
---|
13289 | CASE( 3 ) |
---|
13290 | salsa_nest_offl%mconc_north = to_mconc |
---|
13291 | CASE( 4 ) |
---|
13292 | salsa_nest_offl%mconc_south = to_mconc |
---|
13293 | CASE( 5 ) |
---|
13294 | salsa_nest_offl%mconc_top = to_mconc |
---|
13295 | END SELECT |
---|
13296 | |
---|
13297 | CONTAINS |
---|
13298 | |
---|
13299 | !------------------------------------------------------------------------------! |
---|
13300 | ! Description: |
---|
13301 | ! ------------ |
---|
13302 | !> Set nesting boundaries for aerosol mass. |
---|
13303 | !------------------------------------------------------------------------------! |
---|
13304 | SUBROUTINE set_nest_mass( ispec, ispec_def, prho ) |
---|
13305 | |
---|
13306 | IMPLICIT NONE |
---|
13307 | |
---|
13308 | INTEGER(iwp) :: ic !< chemical component index: default |
---|
13309 | INTEGER(iwp) :: icc !< loop index: mass bin |
---|
13310 | |
---|
13311 | INTEGER(iwp), INTENT(in) :: ispec !< aerosol species index |
---|
13312 | INTEGER(iwp), INTENT(in) :: ispec_def !< default aerosol species index |
---|
13313 | |
---|
13314 | REAL(wp), INTENT(in) :: prho !< aerosol density |
---|
13315 | ! |
---|
13316 | !-- Define the index of the chemical component in the input data |
---|
13317 | ic = salsa_nest_offl%cc_in2mod(ispec_def) |
---|
13318 | |
---|
13319 | DO i = is, ie |
---|
13320 | DO k = ks, ke |
---|
13321 | DO t = 0, 1 |
---|
13322 | ! |
---|
13323 | !-- Regime 2a: |
---|
13324 | ss = ( ispec - 1 ) * nbins_aerosol + start_subrange_2a |
---|
13325 | ee = ( ispec - 1 ) * nbins_aerosol + end_subrange_2a |
---|
13326 | ib = start_subrange_2a |
---|
13327 | DO icc = ss, ee |
---|
13328 | to_mconc(t,k,i,icc) = MAX( 0.0_wp, mf2a(t,k,i,ic) / SUM( mf2a(t,k,i,:) ) ) * & |
---|
13329 | to_nconc(t,k,i,ib) * core(ib) * prho |
---|
13330 | ib = ib + 1 |
---|
13331 | ENDDO |
---|
13332 | ! |
---|
13333 | !-- Regime 2b: |
---|
13334 | IF ( .NOT. no_insoluble ) THEN |
---|
13335 | ! |
---|
13336 | !-- TODO! |
---|
13337 | mf2b(t,k,i,ic) = mf2b(t,k,i,ic) |
---|
13338 | ENDIF |
---|
13339 | ENDDO ! k |
---|
13340 | |
---|
13341 | ENDDO ! j |
---|
13342 | ENDDO ! i |
---|
13343 | |
---|
13344 | END SUBROUTINE set_nest_mass |
---|
13345 | |
---|
13346 | END SUBROUTINE nesting_offl_aero_mass |
---|
13347 | |
---|
13348 | |
---|
13349 | END MODULE salsa_mod |
---|