PartMC  2.9.0
scenario.F90
Go to the documentation of this file.
1 ! Copyright (C) 2005-2016 Nicole Riemer and Matthew West
2 ! Licensed under the GNU General Public License version 2 or (at your
3 ! option) any later version. See the file COPYING for details.
4 
5 !> \file
6 !> The pmc_scenario module.
7 
8 !> The scenario_t structure and associated subroutines.
10 
11  use pmc_gas_state
12  use pmc_aero_dist
13  use pmc_util
14  use pmc_env_state
15  use pmc_aero_state
16  use pmc_spec_file
17  use pmc_aero_data
18  use pmc_gas_data
19  use pmc_chamber
20  use pmc_mpi
21  use pmc_netcdf
22 #ifdef PMC_USE_MPI
23  use mpi
24 #endif
25 #ifdef PMC_USE_QUADPACK
26  use quadpack_double, only: dqagse
27 #endif
28 
29  !> Type code for an undefined or invalid loss function.
30  integer, parameter :: scenario_loss_function_invalid = 0
31  !> Type code for a zero loss function.
32  integer, parameter :: scenario_loss_function_none = 1
33  !> Type code for a constant loss function.
34  integer, parameter :: scenario_loss_function_constant = 2
35  !> Type code for a loss rate function proportional to particle volume.
36  integer, parameter :: scenario_loss_function_volume = 3
37  !> Type code for a loss rate function based on dry deposition
38  integer, parameter :: scenario_loss_function_drydep = 4
39  !> Type code for a loss rate function for chamber experiments.
40  integer, parameter :: scenario_loss_function_chamber = 5
41 
42  !> Parameter to switch between algorithms for particle loss.
43  !! A value of 0 will always use the naive algorithm, and
44  !! a value of 1 will always use the accept-reject algorithm.
45  real(kind=dp), parameter :: scenario_loss_alg_threshold = 1.0d0
46 
47  !> Parameters for simulating dry deposition
49  !> Reference height
50  real(kind=dp) :: z_ref = 20.0d0
51  !> Mean wind speed at reference height
52  real(kind=dp) :: u_mean = 5.0d0
53  !> Roughness length (land-use category dependent)
54  ! crops, mixed farming (LUC 7 from Zhang et al., 2001)
55  real(kind=dp) :: z_rough = 0.8d0
56  !> Characteristic radius of collectors (land-use category dependent)
57  real(kind=dp) :: a = 2.0d0 / 1000.0d0
58  !> Impaction parameter
59  real(kind=dp) :: alpha = 1.0d0
60  !> Surface resistance parameter
61  real(kind=dp) :: eps_0 = 3.0d0
62  !> Diffusivity paramter
63  real(kind=dp) :: gamma = 0.56d0 ! LUC-dependent for Zhang et al., 2001
64  !> Brownian diffusion coefficient
65  real(kind=dp) :: c_b = 1.0d0
66  !> Interception coefficient
67  real(kind=dp) :: c_in = 0.5d0
68  !> Impaction coefficient
69  real(kind=dp) :: c_im = 1.0d0
70  !> Interception exponent
71  real(kind=dp) :: nu = 2.0d0
72  !> Impaction exponent
73  real(kind=dp) :: beta = 2.0d0
74  end type drydep_params_t
75 
76  !> Scenario data.
77  !!
78  !! This is everything needed to drive the scenario being simulated.
79  !!
80  !! The temperature, pressure, emissions and background states are profiles
81  !! prescribed as functions of time by giving a number of times and
82  !! the corresponding data. Simple data such as temperature and pressure is
83  !! linearly interpolated between times, with constant interpolation
84  !! outside of the range of times. Gases and aerosols are
85  !! interpolated with gas_state_interp_1d() and
86  !! aero_dist_interp_1d(), respectively.
88  !> Temperature set-point times (s).
89  real(kind=dp), allocatable :: temp_time(:)
90  !> Temperatures at set-points (K).
91  real(kind=dp), allocatable :: temp(:)
92 
93  !> Pressure set-point times (s).
94  real(kind=dp), allocatable :: pressure_time(:)
95  !> Pressures at set-points (Pa).
96  real(kind=dp), allocatable :: pressure(:)
97 
98  !> Height set-point times (s).
99  real(kind=dp), allocatable :: height_time(:)
100  !> Heights at set-points (m).
101  real(kind=dp), allocatable :: height(:)
102 
103  !> Gas emission set-point times (s).
104  real(kind=dp), allocatable :: gas_emission_time(:)
105  !> Gas emisssion rate scales at set-points (1).
106  real(kind=dp), allocatable :: gas_emission_rate_scale(:)
107  !> Gas emission rates at set-points (mol m^{-2} s^{-1}).
108  type(gas_state_t), allocatable :: gas_emission(:)
109 
110  !> Gas-background dilution set-point times (s).
111  real(kind=dp), allocatable :: gas_dilution_time(:)
112  !> Gas-background dilution rates at set-points (s^{-1}).
113  real(kind=dp), allocatable :: gas_dilution_rate(:)
114  !> Background gas mixing ratios at set-points (ppb).
115  type(gas_state_t), allocatable :: gas_background(:)
116 
117  !> Aerosol emission set-points times (s).
118  real(kind=dp), allocatable :: aero_emission_time(:)
119  !> Aerosol emission rate scales at set-points (1).
120  real(kind=dp), allocatable :: aero_emission_rate_scale(:)
121  !> Aerosol emissions at set-points (# m^{-2} s^{-1}).
122  type(aero_dist_t), allocatable :: aero_emission(:)
123 
124  !> Aerosol-background dilution set-point times (s).
125  real(kind=dp), allocatable :: aero_dilution_time(:)
126  !> Aerosol-background dilution rates at set-points (s^{-1}).
127  real(kind=dp), allocatable :: aero_dilution_rate(:)
128  !> Aerosol background at set-points (# m^{-3}).
129  type(aero_dist_t), allocatable :: aero_background(:)
130 
131  !> Type of loss rate function.
132  integer :: loss_function_type
133  !> Dry deposition parameters
134  type(drydep_params_t) :: drydep
135  !> Chamber parameters for wall loss and sedimentation.
136  type(chamber_t) :: chamber
137  end type scenario_t
138 
139 contains
140 
141 !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
142 
143  !> Initialize the time-dependent contents of the
144  !> environment. Thereafter scenario_update_env_state() should be used.
145  subroutine scenario_init_env_state(scenario, env_state, time)
146 
147  !> Scenario data.
148  type(scenario_t), intent(in) :: scenario
149  !> Environment state to update.
150  type(env_state_t), intent(inout) :: env_state
151  !> Current time (s).
152  real(kind=dp), intent(in) :: time
153 
154  env_state%temp = interp_1d(scenario%temp_time, scenario%temp, time)
155  env_state%pressure = interp_1d(scenario%pressure_time, &
156  scenario%pressure, time)
157  env_state%height = interp_1d(scenario%height_time, scenario%height, time)
158  env_state%elapsed_time = time
159  ! FIXME: should compute this at some point
160  env_state%solar_zenith_angle = 0d0
161 
162  end subroutine scenario_init_env_state
163 
164 !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
165 
166  !> Update time-dependent contents of the environment.
167  !> scenario_init_env_state() should have been called at the start.
168  subroutine scenario_update_env_state(scenario, env_state, time)
169 
170  !> Scenario data.
171  type(scenario_t), intent(in) :: scenario
172  !> Environment state to update.
173  type(env_state_t), intent(inout) :: env_state
174  !> Current time (s).
175  real(kind=dp), intent(in) :: time
176 
177  !> Ambient water vapor pressure (Pa).
178  real(kind=dp) :: pmv_old, pmv_new
179  !> Ambient pressure (Pa)
180  real(kind=dp) :: pressure_old
181  !> Ambient temperature (K)
182  real(kind=dp) :: temp_old
183 
184  ! Update temperature and pressure and adjust relative humidity to maintain
185  ! water mixing ratio.
186 
187  pmv_old = env_state_sat_vapor_pressure(env_state) * env_state%rel_humid
188  pressure_old = env_state%pressure
189  temp_old = env_state%temp
190 
191  env_state%temp = interp_1d(scenario%temp_time, scenario%temp, time)
192  env_state%pressure = interp_1d(scenario%pressure_time, &
193  scenario%pressure, time)
194 
195  pmv_new = pmv_old * env_state%pressure / pressure_old
196  env_state%rel_humid = pmv_new / env_state_sat_vapor_pressure(env_state)
197 
198  env_state%height = interp_1d(scenario%height_time, scenario%height, time)
199  env_state%elapsed_time = time
200 
201  end subroutine scenario_update_env_state
202 
203 !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
204 
205  !> Do gas emissions and background dilution.
206  !!
207  !! Emissions are given as an areal rate \f$e(t)\f$, and then divided
208  !! by the current box height \f$h(t)\f$ to obtain a volume
209  !! rate. There is also a dimensionless rate scaling \f$r(t)\f$. All
210  !! input functions are asusumed constant over the timestep, so the
211  !! concentration \f$c(t)\f$ change is given by
212  !! \f[
213  !! c(t) = c(0) + \frac{r t}{h} e.
214  !! \f]
215  !!
216  !! We model dilution by considering a gas concentration \f$c(t)\f$
217  !! in a box of height \f$h(t)\f$, subject to first-order dilution
218  !! with a rate \f$\lambda(t)\f$. Then the effective dilution rate is
219  !! \f[
220  !! \lambda_{\rm eff}(t) = \lambda(t) + \frac{\dot{h}(t)}{h(t)}
221  !! \f]
222  !! and the evolution of \f$c(t)\f$ is given by
223  !! \f[
224  !! \dot{c}(t) = - \lambda_{\rm eff}(t) c(t).
225  !! \f]
226  !! Solving this with separation of variables gives
227  !! \f[
228  !! \frac{c(t)}{c(0)} = \frac{h(0)}{h(t)}
229  !! \exp\left( - \int_0^t \lambda(t)\,dt\right).
230  !! \f]
231  !! If we define \f$p = c(t)/c(0)\f$ to be the remaining proportion
232  !! of the initial concentration, and \f$b\f$ to be the constant
233  !! background concentration, then we have
234  !! \f[
235  !! c(t) = p(t) c(0) + (1 - p(t)) b.
236  !! \f]
237  !! We assume constant \f$\lambda\f$ and we only do entrainment with
238  !! increasing height \f$h(t)\f$, so we have
239  !! \f[
240  !! p(t) = \min\left(1, \frac{h(0)}{h(t)}\right) \exp(-\lambda t).
241  !! \f]
242  subroutine scenario_update_gas_state(scenario, delta_t, env_state, &
243  old_env_state, gas_data, gas_state)
244 
245  !> Scenario data.
246  type(scenario_t), intent(in) :: scenario
247  !> Time increment to update over.
248  real(kind=dp), intent(in) :: delta_t
249  !> Current environment.
250  type(env_state_t), intent(in) :: env_state
251  !> Previous environment.
252  type(env_state_t), intent(in) :: old_env_state
253  !> Gas data values.
254  type(gas_data_t), intent(in) :: gas_data
255  !> Gas state to update.
256  type(gas_state_t), intent(inout) :: gas_state
257 
258  real(kind=dp) :: emission_rate_scale, dilution_rate, p
259  type(gas_state_t) :: emissions, background
260 
261  ! emissions
262  if (size(scenario%gas_emission) > 0) then
263  call gas_state_interp_1d(scenario%gas_emission, &
264  scenario%gas_emission_time, scenario%gas_emission_rate_scale, &
265  env_state%elapsed_time, emissions, emission_rate_scale)
266  call gas_state_molar_conc_to_ppb(emissions, env_state)
267  p = emission_rate_scale * delta_t / env_state%height
268  call gas_state_add_scaled(gas_state, emissions, p)
269  end if
270 #ifndef PMC_USE_WRF
271  ! dilution
272  call gas_state_interp_1d(scenario%gas_background, &
273  scenario%gas_dilution_time, scenario%gas_dilution_rate, &
274  env_state%elapsed_time, background, dilution_rate)
275  p = exp(- dilution_rate * delta_t)
276  if (env_state%height > old_env_state%height) then
277  p = p * old_env_state%height / env_state%height
278  end if
279  call gas_state_scale(gas_state, p)
280  call gas_state_add_scaled(gas_state, background, 1d0 - p)
281 #endif
282  call gas_state_ensure_nonnegative(gas_state)
283 
284  end subroutine scenario_update_gas_state
285 
286 !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
287 
288  !> Do emissions and background dilution for a particle aerosol
289  !> distribution.
290  !!
291  !! See scenario_update_gas_state() for a description of the
292  !! model. We additionally scale the number concentration to account
293  !! for temperature changes.
294  subroutine scenario_update_aero_state(scenario, delta_t, env_state, &
295  old_env_state, aero_data, aero_state, n_emit, n_dil_in, n_dil_out, &
296  allow_doubling, allow_halving)
297 
298  !> Scenario data.
299  type(scenario_t), intent(in) :: scenario
300  !> Time increment to update over.
301  real(kind=dp), intent(in) :: delta_t
302  !> Current environment.
303  type(env_state_t), intent(in) :: env_state
304  !> Previous environment.
305  type(env_state_t), intent(in) :: old_env_state
306  !> Aero data values.
307  type(aero_data_t), intent(in) :: aero_data
308  !> Aero state to update.
309  type(aero_state_t), intent(inout) :: aero_state
310  !> Number of emitted particles.
311  integer, intent(out) :: n_emit
312  !> Number of diluted-in particles.
313  integer, intent(out) :: n_dil_in
314  !> Number of diluted-out particles.
315  integer, intent(out) :: n_dil_out
316  !> Whether to allow doubling of the population.
317  logical, intent(in) :: allow_doubling
318  !> Whether to allow halving of the population.
319  logical, intent(in) :: allow_halving
320 
321  real(kind=dp), parameter :: sample_timescale = 3600.0d0
322  real(kind=dp) :: characteristic_factor, sample_timescale_effective
323  real(kind=dp) :: emission_rate_scale, dilution_rate, p
324  type(aero_dist_t) :: emissions, background
325  type(aero_state_t) :: aero_state_delta
326 
327  sample_timescale_effective = max(1.0, min(sample_timescale, &
328  env_state%elapsed_time))
329  characteristic_factor = sample_timescale_effective / delta_t
330 
331  ! emissions
332  if (size(scenario%aero_emission) > 0) then
333  call aero_dist_interp_1d(scenario%aero_emission, &
334  scenario%aero_emission_time, scenario%aero_emission_rate_scale, &
335  env_state%elapsed_time, emissions, emission_rate_scale)
336  p = emission_rate_scale * delta_t / env_state%height
337  call aero_state_add_aero_dist_sample(aero_state, aero_data, &
338  emissions, p, characteristic_factor, env_state%elapsed_time, &
339  allow_doubling, allow_halving, n_emit)
340  end if
341 #ifndef PMC_USE_WRF
342  ! dilution
343  call aero_dist_interp_1d(scenario%aero_background, &
344  scenario%aero_dilution_time, scenario%aero_dilution_rate, &
345  env_state%elapsed_time, background, dilution_rate)
346  p = exp(- dilution_rate * delta_t)
347  if (env_state%height > old_env_state%height) then
348  p = p * old_env_state%height / env_state%height
349  end if
350  ! loss to background
351  call aero_state_zero(aero_state_delta)
352  call aero_state_copy_weight(aero_state, aero_state_delta)
353  call aero_state_sample_particles(aero_state, aero_state_delta, &
354  aero_data, 1d0 - p, aero_info_dilution)
355  n_dil_out = aero_state_total_particles(aero_state_delta)
356  ! addition from background
357  call aero_state_add_aero_dist_sample(aero_state, aero_data, &
358  background, 1d0 - p, characteristic_factor, env_state%elapsed_time, &
359  allow_doubling, allow_halving, n_dil_in)
360 
361  ! particle loss function
362  call scenario_particle_loss(scenario, delta_t, aero_data, aero_state, &
363  env_state)
364 #endif
365 
366 #ifdef PMC_USE_WRF
367  call aero_weight_array_scale(aero_state%awa, &
368  old_env_state%inverse_density * (1.0d0 / env_state%inverse_density))
369 #else
370  ! update computational volume
371  call aero_weight_array_scale(aero_state%awa, &
372  old_env_state%temp * env_state%pressure &
373  / (env_state%temp * old_env_state%pressure))
374 #endif
375 
376  end subroutine scenario_update_aero_state
377 
378 !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
379 
380  !> Do emissions and background dilution from the environment for a
381  !> binned aerosol distribution.
382  !!
383  !! See scenario_update_gas_state() for a description of the model.
384  subroutine scenario_update_aero_binned(scenario, delta_t, env_state, &
385  old_env_state, bin_grid, aero_data, do_aero_dilution, aero_binned)
386 
387  !> Scenario data.
388  type(scenario_t), intent(in) :: scenario
389  !> Time increment to update over.
390  real(kind=dp), intent(in) :: delta_t
391  !> Current environment.
392  type(env_state_t), intent(in) :: env_state
393  !> Previous environment.
394  type(env_state_t), intent(in) :: old_env_state
395  !> Bin grid.
396  type(bin_grid_t), intent(in) :: bin_grid
397  !> Aero data values.
398  type(aero_data_t), intent(in) :: aero_data
399  !> Whether to do dilution.
400  logical, intent(in) :: do_aero_dilution
401  !> Aero binned to update.
402  type(aero_binned_t), intent(inout) :: aero_binned
403 
404  real(kind=dp) :: emission_rate_scale, dilution_rate, p
405  type(aero_dist_t) :: emissions, background
406  type(aero_binned_t) :: emissions_binned, background_binned
407 
408  ! emissions
409  call aero_dist_interp_1d(scenario%aero_emission, &
410  scenario%aero_emission_time, scenario%aero_emission_rate_scale, &
411  env_state%elapsed_time, emissions, emission_rate_scale)
412  call aero_binned_add_aero_dist(emissions_binned, bin_grid, aero_data, &
413  emissions)
414  p = emission_rate_scale * delta_t / env_state%height
415  call aero_binned_add_scaled(aero_binned, emissions_binned, p)
416 
417  ! dilution
418  if (do_aero_dilution) then
419  call aero_dist_interp_1d(scenario%aero_background, &
420  scenario%aero_dilution_time, scenario%aero_dilution_rate, &
421  env_state%elapsed_time, background, dilution_rate)
422  call aero_binned_add_aero_dist(background_binned, bin_grid, aero_data, &
423  background)
424  p = exp(- dilution_rate * delta_t)
425  if (env_state%height > old_env_state%height) then
426  p = p * old_env_state%height / env_state%height
427  end if
428  call aero_binned_scale(aero_binned, p)
429  call aero_binned_add_scaled(aero_binned, background_binned, 1d0 - p)
430  end if
431 
432  ! loss
433  call scenario_binned_loss(scenario, bin_grid, delta_t, aero_data, &
434  env_state, aero_binned)
435 
436  end subroutine scenario_update_aero_binned
437 
438 !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
439 
440  !> Update the modal aerosol distribution to account for particle loss.
441  subroutine scenario_update_aero_modes(aero_dist, del_t, env_state, &
442  density, scenario)
443 
444  !> Aerosol distribution.
445  type(aero_dist_t), intent(inout) :: aero_dist
446  !> Timestep.
447  real(kind=dp), intent(in) :: del_t
448  !> Environment state.
449  type(env_state_t), intent(in) :: env_state
450  !> Particle density (kg m^-3), assumed uniform across all modes.
451  real(kind=dp), intent(in) :: density
452  !> Scenario data.
453  type(scenario_t), intent(in) :: scenario
454 
455  real(kind=dp) :: n, d_pg, ln_sigma_g
456  real(kind=dp) :: m_0_rate, m_3_rate
457  real(kind=dp) :: m, new_m
458  real(kind=dp) :: new_n, new_d_pg
459  integer :: i_mode
460 
461  if (scenario%loss_function_type == scenario_loss_function_invalid) then
462  return
463  else if (scenario%loss_function_type == scenario_loss_function_none) then
464  return
465  else if (scenario%loss_function_type == scenario_loss_function_drydep) then
466  do i_mode = 1,aero_dist_n_mode(aero_dist)
467  n = aero_dist%mode(i_mode)%num_conc
468 
469  if (n == 0d0) cycle
470 
471  d_pg = aero_dist%mode(i_mode)%char_radius * 2.0d0
472  ln_sigma_g = aero_dist%mode(i_mode)%log10_std_dev_radius &
473  / log10(exp(1.0d0))
474 
475  ! Integrated deposition rate for the 0-th moment (num. conc.)
476  m_0_rate = -1.0d0 * scenario_integrated_loss_rate_drydep(scenario, &
477  aero_dist%mode(i_mode), 0.0d0, density, env_state)
478  new_n = n * exp(m_0_rate * del_t)
479 
480  aero_dist%mode(i_mode)%num_conc = new_n
481 
482  ! Integrated deposition rate for the 3-rd moment
483  ! (proportional to volume conc.)
484  m_3_rate = -1.0d0 * scenario_integrated_loss_rate_drydep(scenario, &
485  aero_dist%mode(i_mode), 3.0d0, density, env_state)
486  m = n * d_pg**3.0d0 * exp((3.0d0**2.0d0) / 2.0d0 &
487  * (ln_sigma_g**2.0d0))
488  new_m = m * exp(m_3_rate * del_t)
489 
490  ! New geometric mean diameter
491  new_d_pg = (new_m / new_n * exp(-(3.0d0**2.0d0) / 2.0d0 &
492  * (ln_sigma_g**2.0d0)))**(1.0d0/3.0d0)
493  aero_dist%mode(i_mode)%char_radius = new_d_pg / 2.0d0
494  end do
495  else
496  call die_msg(192500240, "loss_function must be none or drydep " &
497  // "for modal runs; unsupported loss function id: " &
498  // trim(integer_to_string(scenario%loss_function_type)))
499  end if
500 
501  end subroutine scenario_update_aero_modes
502 
503 !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
504 
505  !> Evaluate a loss rate function.
506  real(kind=dp) function scenario_loss_rate(scenario, vol, density, &
507  aero_data, env_state)
508 
509  !> Scenario data.
510  type(scenario_t), intent(in) :: scenario
511  !> Volume of particle (m^3).
512  real(kind=dp), intent(in) :: vol
513  !> Density of particle (kg/m^3).
514  real(kind=dp), intent(in) :: density
515  !> Aerosol data.
516  type(aero_data_t), intent(in) :: aero_data
517  !> Environment state.
518  type(env_state_t), intent(in) :: env_state
519 
520  scenario_loss_rate = 0d0
521  if (scenario%loss_function_type == scenario_loss_function_invalid) then
522  scenario_loss_rate = 0d0
523  else if (scenario%loss_function_type == scenario_loss_function_none) then
524  scenario_loss_rate = 0d0
525  else if (scenario%loss_function_type == scenario_loss_function_constant) &
526  then
527  scenario_loss_rate = 1d-3
528  else if (scenario%loss_function_type == scenario_loss_function_volume) then
529  scenario_loss_rate = 1d15*vol
530  else if (scenario%loss_function_type == scenario_loss_function_drydep) &
531  then
533  aero_data, env_state, scenario)
534  else if (scenario%loss_function_type == scenario_loss_function_chamber) &
535  then
536  scenario_loss_rate = chamber_loss_rate_wall(scenario%chamber, vol, &
537  aero_data, env_state) &
538  + chamber_loss_rate_sedi(scenario%chamber, vol, density, &
539  aero_data, env_state)
540  else
541  call die_msg(201594391, "Unknown loss function id: " &
542  // trim(integer_to_string(scenario%loss_function_type)))
543  end if
544 
545  end function scenario_loss_rate
546 
547 !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
548 
549  !> Compute and return the dry deposition rate for a given particle.
550  !! All equations used here are written in detail in the file
551  !! \c doc/deposition/deposition.tex.
552  real(kind=dp) function scenario_loss_rate_drydep(vol, density, aero_data, &
553  env_state, scenario)
554 
555  !> Particle volume (m^3).
556  real(kind=dp), intent(in) :: vol
557  !> Particle density (kg m^-3).
558  real(kind=dp), intent(in) :: density
559  !> Aerosol data.
560  type(aero_data_t), intent(in) :: aero_data
561  !> Environment state.
562  type(env_state_t), intent(in) :: env_state
563  !> Scenario data.
564  type(scenario_t), intent(in) :: scenario
565 
566  real(kind=dp) :: v_d
567  real(kind=dp) :: v_s
568  real(kind=dp) :: d_p
569  real(kind=dp) :: density_air
570  real(kind=dp) :: visc_d, visc_k
571  real(kind=dp) :: gas_speed, gas_mean_free_path
572  real(kind=dp) :: knud, cunning
573  real(kind=dp) :: grav
574  real(kind=dp) :: r_s, r_a
575  real(kind=dp) :: diff_p
576  real(kind=dp) :: von_karman
577  real(kind=dp) :: st, sc, u_star
578  real(kind=dp) :: e_b, e_im, e_in, r1
579  type(drydep_params_t) :: drydep_params
580 
581  drydep_params = scenario%drydep
582 
583  ! particle diameter
584  d_p = aero_data_vol2diam(aero_data, vol)
585  ! density of air
586  density_air = (const%air_molec_weight * env_state%pressure) &
587  / (const%univ_gas_const * env_state%temp)
588  ! dynamic viscosity
589  visc_d = 1.8325d-5 * (416.16 / (env_state%temp + 120.0d0)) &
590  * (env_state%temp / 296.16)**1.5d0
591  ! kinematic viscosity
592  visc_k = visc_d / density_air
593  ! gas speed
594  gas_speed = sqrt((8.0d0 * const%boltzmann * env_state%temp &
595  * const%avagadro) / (const%pi * const%air_molec_weight))
596  ! gas free path
597  gas_mean_free_path = (2.0d0 * visc_d) / (density_air * gas_speed)
598  ! knudson number
599  knud = (2.0d0 * gas_mean_free_path) / d_p
600  ! cunningham correction factor
601  cunning = 1.0d0 + knud * (1.257d0 + 0.4d0 * exp(-1.1d0 / knud))
602  ! gravity
603  grav = 9.81d0
604  ! Compute V_s
605  v_s = (density * d_p**2.0d0 * grav * cunning) / (18.0d0 * visc_d)
606 
607  ! Aerodynamic resistance
608  ! For neutral stability
609  u_star = .4d0 * drydep_params%u_mean &
610  / log(drydep_params%z_ref / drydep_params%z_rough)
611  r_a = (1.0d0 / (.4d0 * u_star)) &
612  * log(drydep_params%z_ref / drydep_params%z_rough)
613  ! Brownian diffusion efficiency
614  diff_p = (const%boltzmann * env_state%temp * cunning) &
615  / (3.d0 * const%pi * visc_d * d_p)
616  sc = visc_k / diff_p
617  e_b = drydep_params%C_B * sc**(-drydep_params%gamma)
618 
619  ! Interception efficiency
620  ! Characteristic radius of large collectors
621  e_in = drydep_params%C_IN * (d_p / drydep_params%A)**drydep_params%nu
622 
623  ! Impaction efficiency
624  st = (v_s * u_star) / (grav * drydep_params%A)
625  e_im = drydep_params%C_IM * (st &
626  / (drydep_params%alpha + st))**drydep_params%beta
627 
628  ! Rebound correction
629  r1 = exp(-st**.5d0)
630 
631  ! Surface resistance
632  r_s = 1.0d0 / (drydep_params%eps_0 * u_star * (e_b + e_in + e_im) * r1)
633 
634  ! Dry deposition
635  v_d = v_s + (1.0d0 / (r_a + r_s))
636 
637  ! The loss rate
638  scenario_loss_rate_drydep = v_d / env_state%height
639 
640  end function scenario_loss_rate_drydep
641 
642 !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
643 
644  !> Compute and return the integrated dry deposition rate for a given
645  !> lognormal aerosol mode (modal approximation).
646  real(kind=dp) function scenario_integrated_loss_rate_drydep(scenario, &
647  aero_mode, moment, density, env_state)
648 
649  !> Scenario data.
650  type(scenario_t), intent(in) :: scenario
651  !> Aerosol mode.
652  type(aero_mode_t), intent(in) :: aero_mode
653  !> Moment to calculate loss rate for.
654  real(kind=dp), intent(in) :: moment
655  !> Particle density assumed for entire mode (kg m^-3).
656  real(kind=dp), intent(in) :: density
657  !> Environment state.
658  type(env_state_t), intent(in) :: env_state
659 
660  real(kind=dp) :: v_d_hat, v_g_hat
661  real(kind=dp) :: v_g_bar
662  real(kind=dp) :: d_pg, ln_sigma_g
663  real(kind=dp) :: density_air
664  real(kind=dp) :: visc_d, visc_k
665  real(kind=dp) :: gas_speed, gas_mean_free_path
666  real(kind=dp) :: knud
667  real(kind=dp) :: d_bar, d_hat
668  real(kind=dp) :: st, sc
669  real(kind=dp) :: u_star
670  real(kind=dp) :: r_a, r_s
671  real(kind=dp) :: e_b, e_in, e_im, r1
672  type(drydep_params_t) :: drydep_params
673 
674 #ifdef PMC_USE_QUADPACK
675  ! Do numerical integration when QUADPACK is available
677  scenario_integrated_loss_rate_drydep_quadpack( &
678  scenario, aero_mode, moment, density, env_state)
679  return
680 #endif
681 
682  drydep_params = scenario%drydep
683 
684  ! particle diameter equal to geometric mean diameter
685  d_pg = aero_mode%char_radius * 2.0d0
686  ! natural log of geometric standard deviation
687  ln_sigma_g = aero_mode%log10_std_dev_radius / log10(exp(1.0d0))
688  ! density of air
689  density_air = (const%air_molec_weight * env_state%pressure) &
690  / (const%univ_gas_const * env_state%temp)
691  ! dynamic viscosity
692  visc_d = 1.8325d-5 * (416.16 / (env_state%temp + 120.0d0)) &
693  * (env_state%temp / 296.16)**1.5d0
694  ! kinematic viscosity
695  visc_k = visc_d / density_air
696  ! gas speed
697  gas_speed = sqrt((8.0d0 * const%boltzmann * env_state%temp &
698  * const%avagadro) / (const%pi * const%air_molec_weight))
699  ! gas mean free path
700  gas_mean_free_path = (2.0d0 * visc_d) / (density_air * gas_speed)
701  ! Knudsen number
702  knud = (2.0d0 * gas_mean_free_path) / d_pg
703  ! Settling velocity
704  v_g_bar = (density * d_pg**2.0d0 * const%std_grav) / (18.0d0 * visc_d)
705  ! Compute integrated settling velocity
706  v_g_hat = v_g_bar &
707  * (exp((4.0d0 * moment + 4.0d0) / 2.0d0 * ln_sigma_g**2.0d0) &
708  + 1.246d0 * knud &
709  * exp((2.0d0 * moment + 1.0d0) / 2.0d0 * ln_sigma_g**2.0d0))
710 
711  ! Aerodynamic resistance (assuming neutral stability)
712  u_star = 0.4d0 * drydep_params%u_mean / log(drydep_params%z_ref &
713  / drydep_params%z_rough)
714  r_a = (1.0d0 / (0.4d0 * u_star)) &
715  * log(drydep_params%z_ref / drydep_params%z_rough)
716 
717  ! Brownian diffusivity
718  d_bar = (const%boltzmann * env_state%temp) &
719  / (3.0d0 * const%pi * visc_d * d_pg)
720  ! Compute integrated Brownian diffusivity
721  d_hat = d_bar &
722  * ((exp((-2.0d0 * moment + 1.0d0) / 2.0d0 * ln_sigma_g**2.0d0) &
723  + 1.246d0 * knud &
724  * exp((-4.0d0 * moment + 4.0d0) / 2.0d0 * ln_sigma_g**2.0d0)))
725  ! Schmidt number based on integrated diffusivity
726  sc = visc_k / d_hat
727  ! Collection efficiency due to Brownian diffusion
728  e_b = drydep_params%C_B * sc**(-drydep_params%gamma)
729 
730  ! Collection efficiency due to interception
731  e_in = drydep_params%C_IN * (d_pg / drydep_params%A)**drydep_params%nu
732 
733  ! Stokes number based on integrated settling velocity
734  st = (v_g_hat * u_star) / (const%std_grav * drydep_params%A)
735  ! Collection efficiency due to impaction
736  e_im = drydep_params%C_IM * (st / (drydep_params%alpha + st)) &
737  **drydep_params%beta
738 
739  ! Rebound correction
740  r1 = exp(-st**0.5d0)
741 
742  ! Surface resistance
743  r_s = 1.0d0 / (drydep_params%eps_0 * u_star * (e_b + e_in + e_im) * r1)
744 
745  ! Integrated deposition velocity
746  v_d_hat = v_g_hat + (1.0d0 / (r_a + r_s))
747 
748  ! Loss rate
749  scenario_integrated_loss_rate_drydep = v_d_hat / env_state%height
750 
752 
753 !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
754 
755 #ifdef PMC_USE_QUADPACK
756  real(kind=dp) function scenario_integrated_loss_rate_drydep_quadpack( &
757  scenario, aero_mode, moment, density, env_state)
758 
759  !> Scenario data.
760  type(scenario_t), intent(in) :: scenario
761  !> Aerosol mode.
762  type(aero_mode_t), intent(in) :: aero_mode
763  !> Moment to calculate loss rate for.
764  real(kind=dp), intent(in) :: moment
765  !> Particle density assumed for entire mode (kg m^-3).
766  real(kind=dp), intent(in) :: density
767  !> Environment state.
768  type(env_state_t), intent(in) :: env_state
769 
770  real(kind=dp) :: d_pg, ln_sigma_g
771  real(kind=dp) :: density_air
772  real(kind=dp) :: visc_d, visc_k
773  real(kind=dp) :: gas_speed, gas_mean_free_path
774  real(kind=dp) :: m_k
775  real(kind=dp) :: lower, upper, epsabs, epsrel, result, abserr, ref
776  integer :: limit, neval, ier, last
777  real(kind=dp), allocatable :: alist(:), blist(:), rlist(:), elist(:)
778  integer, allocatable :: iord(:)
779 
780  type(drydep_params_t) :: drydep_params
781 
782  drydep_params = scenario%drydep
783 
784  ! particle diameter equal to geometric mean diameter
785  d_pg = aero_mode%char_radius * 2.0d0
786  ! natural log of geometric standard deviation
787  ln_sigma_g = aero_mode%log10_std_dev_radius / log10(exp(1.0d0))
788  ! density of air
789  density_air = (const%air_molec_weight * env_state%pressure) &
790  / (const%univ_gas_const * env_state%temp)
791  ! dynamic viscosity
792  visc_d = 1.8325d-5 * (416.16 / (env_state%temp + 120.0d0)) &
793  * (env_state%temp / 296.16)**1.5d0
794  ! kinematic viscosity
795  visc_k = visc_d / density_air
796  ! gas speed
797  gas_speed = sqrt((8.0d0 * const%boltzmann * env_state%temp &
798  * const%avagadro) / (const%pi * const%air_molec_weight))
799  ! gas mean free path
800  gas_mean_free_path = (2.0d0 * visc_d) / (density_air * gas_speed)
801 
802  ref = exp(log(d_pg) + moment*ln_sigma_g**2)
803  lower = ref / (exp(ln_sigma_g)*10.0)
804  upper = ref * exp(ln_sigma_g)*10.0
805 
806  ! Set integration parameters
807  limit = 1000
808  epsabs = 1.0d-10
809  epsrel = 1.0d-6
810 
811  ! Allocate arrays for QUADPACK integration
812  allocate(alist(limit), blist(limit), rlist(limit), &
813  elist(limit), iord(limit))
814 
815  ! Call QUADPACK integration routine
816  call dqagse(dep_vel_integrand, lower, upper, epsabs, epsrel, limit, &
817  result, abserr, neval, ier, alist, blist, rlist, elist, iord, last)
818 
819  call assert_msg(909106718, ier == 0, &
820  "QUADPACK integration failed, error code: " &
821  // trim(integer_to_string(ier)))
822 
823  m_k = d_pg**moment * exp(moment**2 * ln_sigma_g**2 / 2.0d0)
824 
825  ! Integration result
826  scenario_integrated_loss_rate_drydep_quadpack = 1.0d0 / m_k * result &
827  / env_state%height
828 
829  ! Clean up
830  deallocate(alist, blist, rlist, elist, iord)
831 
832  contains
833 
834  real(kind=dp) function dep_vel_integrand(d_p)
835  real(kind=dp), intent(in) :: d_p
836 
837  ! Local variables
838  real(kind=dp) :: v_d, v_s
839  real(kind=dp) :: knud_local, cunning
840  real(kind=dp) :: diff_p, sc, st
841  real(kind=dp) :: u_star, r_a, r_s
842  real(kind=dp) :: e_b, e_in, e_im, r1
843  real(kind=dp) :: ln_dp, ln_dp_g, n_ddp
844 
845  ! Knudsen number for this diameter
846  knud_local = (2.0d0 * gas_mean_free_path) / d_p
847 
848  ! Cunningham correction factor
849  cunning = 1.0d0 + knud_local * (1.257d0 + 0.4d0 * exp(-1.1d0 / knud_local))
850 
851  ! Settling velocity
852  v_s = (density * d_p**2.0d0 * const%std_grav * cunning) / (18.0d0 * visc_d)
853 
854  ! Friction velocity and aerodynamic resistance
855  u_star = 0.4d0 * drydep_params%u_mean &
856  / log(drydep_params%z_ref / drydep_params%z_rough)
857  r_a = (1.0d0 / (0.4d0 * u_star)) &
858  * log(drydep_params%z_ref / drydep_params%z_rough)
859 
860  ! Particle diffusivity and Schmidt number
861  diff_p = (const%boltzmann * env_state%temp * cunning) &
862  / (3.0d0 * const%pi * visc_d * d_p)
863  sc = visc_k / diff_p
864 
865  ! Collection efficiencies
866  e_b = drydep_params%C_B * sc**(-drydep_params%gamma)
867  e_in = drydep_params%C_IN * (d_p / drydep_params%A)**drydep_params%nu
868 
869  ! Stokes number and impaction efficiency
870  st = (v_s * u_star) / (const%std_grav * drydep_params%A)
871  e_im = drydep_params%C_IM &
872  * (st / (drydep_params%alpha + st))**drydep_params%beta
873 
874  ! Rebound correction
875  r1 = exp(-st**0.5d0)
876 
877  ! Surface resistance
878  r_s = 1.0d0 / (drydep_params%eps_0 * u_star * (e_b + e_in + e_im) * r1)
879 
880  ! Deposition velocity
881  v_d = v_s + (1.0d0 / (r_a + r_s))
882 
883  ! Log-normal size distribution
884  ln_dp = log(d_p)
885  ln_dp_g = log(d_pg)
886  n_ddp = (1.0d0/(sqrt(2.0d0 * const%pi) * d_p * ln_sigma_g)) &
887  * exp(-((ln_dp - ln_dp_g)**2) / (2.0d0 * ln_sigma_g**2))
888 
889  ! Final integrand
890  dep_vel_integrand = d_p**moment * v_d * n_ddp
891  end function dep_vel_integrand
892  end function scenario_integrated_loss_rate_drydep_quadpack
893 #endif
894 
895 !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
896 
897  !> Updates an array to contain the integrated deposition velocities for the
898  !> given moment of each aerosol mode in the distribution.
899  subroutine scenario_modal_drydep_velocities(scenario, aero_dist, moment, &
900  density, env_state, velocities)
901 
902  !> Scenario data.
903  type(scenario_t), intent(in) :: scenario
904  !> Aerosol distribution.
905  type(aero_dist_t), intent(in) :: aero_dist
906  !> Moment to compute deposition velocities for.
907  real(kind=dp), intent(in) :: moment
908  !> Density for the mode.
909  real(kind=dp), intent(in) :: density
910  !> Environment state.
911  type(env_state_t), intent(in) :: env_state
912  !> Modal dry deposition velocities.
913  real(kind=dp), intent(inout) :: velocities(:)
914 
915  integer :: i_mode
916 
917  do i_mode = 1,size(velocities)
918  velocities(i_mode) = scenario_integrated_loss_rate_drydep( &
919  scenario, aero_dist%mode(i_mode), moment, density, env_state) &
920  * env_state%height
921  end do
922 
923  end subroutine
924 
925 !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
926 
927  !> Compute and return the max loss rate function for a given volume.
928  real(kind=dp) function scenario_loss_rate_max(scenario, vol, aero_data, &
929  env_state)
930 
931  !> Scenario data.
932  type(scenario_t), intent(in) :: scenario
933  !> Particle volume (m^3).
934  real(kind=dp), intent(in) :: vol
935  !> Aerosol data.
936  type(aero_data_t), intent(in) :: aero_data
937  !> Environment state.
938  type(env_state_t), intent(in) :: env_state
939 
940  !> Number of density sample points.
941  integer, parameter :: n_sample = 3
942 
943  real(kind=dp) :: d, d_min, d_max, loss
944  integer :: i
945 
946  d_min = minval(aero_data%density)
947  d_max = maxval(aero_data%density)
948 
950  do i = 1,n_sample
951  d = interp_linear_disc(d_min, d_max, n_sample, i)
952  loss = scenario_loss_rate(scenario, vol, d, aero_data, env_state)
954  end do
955 
956  end function scenario_loss_rate_max
957 
958 !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
959 
960  !> Compute an upper bound on the maximum kernel value for each
961  !> bin.
962  !! Value over_scale is multiplied to the maximum sampled value
963  !! to get the upper bound. A tighter bound may be reached if over_scale
964  !! is smaller, but that also risks falling below a kernel value.
965  subroutine scenario_loss_rate_bin_max(scenario, bin_grid, aero_data, &
966  env_state, loss_max)
967 
968  !> Scenario data.
969  type(scenario_t), intent(in) :: scenario
970  !> Bin_grid.
971  type(bin_grid_t), intent(in) :: bin_grid
972  !> Aerosol data.
973  type(aero_data_t), intent(in) :: aero_data
974  !> Environment state.
975  type(env_state_t), intent(in) :: env_state
976  !> Maximum loss vals.
977  real(kind=dp), intent(out) :: loss_max(bin_grid_size(bin_grid))
978 
979  !> Number of sample points per bin.
980  integer, parameter :: n_sample = 3
981  !> Over-estimation scale factor parameter.
982  real(kind=dp), parameter :: over_scale = 2d0
983 
984  real(kind=dp) :: v_low, v_high, vol, r, r_max
985  integer :: b, i
986 
987  do b = 1,bin_grid_size(bin_grid)
988  v_low = aero_data_rad2vol(aero_data, bin_grid%edges(b))
989  v_high = aero_data_rad2vol(aero_data, bin_grid%edges(b + 1))
990  r_max = 0d0
991  do i = 1,n_sample
992  vol = interp_linear_disc(v_low, v_high, n_sample, i)
993  r = scenario_loss_rate_max(scenario, vol, aero_data, env_state)
994  r_max = max(r_max, r)
995  end do
996  loss_max(b) = r_max * over_scale
997  end do
998 
999  end subroutine scenario_loss_rate_bin_max
1000 
1001 !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
1002 
1003  !> Performs stochastic particle loss for one time-step.
1004  !! If a particle \c i_part has a scenario_loss_rate() value of rate, then the
1005  !! probability p will be removed by this function is
1006  !! <tt>1 - exp(-delta_t*rate)</tt>.
1007  !! Uses an accept-reject algorithm for efficiency, in which a particle
1008  !! is first sampled with rate <tt>1 - exp(-delta_t*over_rate) </tt>
1009  !! and then accepted with rate
1010  !! <tt>(1 - exp(-delta_t*rate))/(1 - exp(-delta_t*over_rate))</tt>.
1011  subroutine scenario_particle_loss(scenario, delta_t, aero_data, aero_state, &
1012  env_state)
1013 
1014  !> Scenario data.
1015  type(scenario_t), intent(in) :: scenario
1016  !> Time increment to update over.
1017  real(kind=dp), intent(in) :: delta_t
1018  !> Aerosol data.
1019  type(aero_data_t), intent(in) :: aero_data
1020  !> Aerosol state.
1021  type(aero_state_t), intent(inout) :: aero_state
1022  !> Environment state.
1023  type(env_state_t), intent(in) :: env_state
1024 
1025  integer :: c, b, s, i_part
1026  real(kind=dp) :: over_rate, over_prob, rand_real, rand_geom
1027 
1028  if (scenario%loss_function_type == scenario_loss_function_none .or. &
1029  scenario%loss_function_type == scenario_loss_function_invalid) return
1030 
1031  if (scenario_loss_alg_threshold <= 0d0) then
1032  ! use naive algorithm for everything
1033  do i_part = aero_state%apa%n_part, 1, -1
1034  call scenario_try_single_particle_loss(scenario, delta_t, &
1035  aero_data, aero_state, env_state, i_part, 1d0)
1036  end do
1037  return
1038  end if
1039 
1040  call aero_state_sort(aero_state, aero_data)
1041 
1042  if (.not. aero_state%aero_sorted%removal_rate_bounds_valid) then
1043  call scenario_loss_rate_bin_max(scenario, &
1044  aero_state%aero_sorted%bin_grid, aero_data, env_state, &
1045  aero_state%aero_sorted%removal_rate_max)
1046  aero_state%aero_sorted%removal_rate_bounds_valid = .true.
1047  end if
1048 
1049  do c = 1,aero_sorted_n_class(aero_state%aero_sorted)
1050  do b = 1,aero_sorted_n_bin(aero_state%aero_sorted)
1051  over_rate = aero_state%aero_sorted%removal_rate_max(b)
1052  if (delta_t * over_rate <= 0d0) cycle
1053  over_prob = 1d0 - exp(-delta_t * over_rate)
1054  if (over_prob >= scenario_loss_alg_threshold) then
1055  ! use naive algorithm over bin
1056  do s = aero_state%aero_sorted%size_class%inverse(b, c)%n_entry, &
1057  1,-1
1058  i_part = &
1059  aero_state%aero_sorted%size_class%inverse(b, c)%entry(s)
1060  call scenario_try_single_particle_loss(scenario, delta_t, &
1061  aero_data, aero_state, env_state, i_part, 1d0)
1062  end do
1063  else
1064  ! use accept-reject algorithm over bin
1065  s = aero_state%aero_sorted%size_class%inverse(b, c)%n_entry + 1
1066  do while (.true.)
1067  rand_real = pmc_random()
1068  if (rand_real <= 0d0) exit
1069  rand_geom = -log(rand_real) / (delta_t * over_rate) + 1d0
1070  if (rand_geom >= real(s, kind=dp)) exit
1071  s = s - floor(rand_geom)
1072 
1073  ! note: floor(rand_geom) is a random geometric variable
1074  ! with accept probability 1 - exp(-delta_t*over_rate)
1075 
1076  i_part = &
1077  aero_state%aero_sorted%size_class%inverse(b, c)%entry(s)
1078  call scenario_try_single_particle_loss(scenario, delta_t, &
1079  aero_data, aero_state, env_state, i_part, over_prob)
1080  end do
1081  end if
1082  end do
1083  end do
1084 
1085  !call aero_state_check_sort(aero_state)
1086 
1087  end subroutine scenario_particle_loss
1088 
1089 !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
1090 
1091  !> Test a candidate particle to see if it should be removed,
1092  !> and remove if necessary.
1093  !! Particle is removed with probability
1094  !! (1d0 - exp(-delta_t*rate))/over_prob, where rate is the loss function
1095  !! evaluated for the given particle.
1096  subroutine scenario_try_single_particle_loss(scenario, delta_t, &
1097  aero_data, aero_state, env_state, i_part, over_prob)
1098 
1099  !> Scenario data.
1100  type(scenario_t), intent(in) :: scenario
1101  !> Time increment to update over.
1102  real(kind=dp), intent(in) :: delta_t
1103  !> Aerosol data.
1104  type(aero_data_t), intent(in) :: aero_data
1105  !> Aerosol state.
1106  type(aero_state_t), intent(inout) :: aero_state
1107  !> Environment state.
1108  type(env_state_t), intent(in) :: env_state
1109  !> Index of particle to attempt removal
1110  integer, intent(in) :: i_part
1111  !> Overestimated removal probability used previously
1112  real(kind=dp), intent(in) :: over_prob
1113 
1114  real(kind=dp) :: prob, rate, vol, density
1115  type(aero_info_t) :: aero_info
1116 
1117  vol = aero_particle_volume(aero_state%apa%particle(i_part))
1118  density = aero_particle_density(aero_state%apa%particle(i_part), aero_data)
1119  rate = scenario_loss_rate(scenario, vol, density, aero_data, env_state)
1120  prob = 1d0 - exp(-delta_t * rate)
1121  call warn_assert_msg(295846288, prob <= over_prob, &
1122  "particle loss upper bound estimation is too tight: " &
1123  // trim(real_to_string(prob)) // " > " &
1124  // trim(real_to_string(over_prob)) )
1125  if (pmc_random() * over_prob > prob) return
1126 
1127  aero_info%id = aero_state%apa%particle(i_part)%id
1128  aero_info%action = aero_info_dilution
1129  aero_info%other_id = 0
1130  call aero_state_remove_particle_with_info(aero_state, i_part, aero_info)
1131 
1132  end subroutine scenario_try_single_particle_loss
1133 !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
1134 
1135  !> Performs loss for a binned aerosol distribution for one time step.
1136  subroutine scenario_binned_loss(scenario, bin_grid, delta_t, aero_data, &
1137  env_state, aero_binned)
1138 
1139  !> Scenario data.
1140  type(scenario_t), intent(in) :: scenario
1141  !> Bin grid.
1142  type(bin_grid_t), intent(in) :: bin_grid
1143  !> Time increment to update over.
1144  real(kind=dp), intent(in) :: delta_t
1145  !> Aerosol data.
1146  type(aero_data_t), intent(in) :: aero_data
1147  !> Environmental state.
1148  type(env_state_t), intent(in) :: env_state
1149  !> Binned aerosol data.
1150  type(aero_binned_t), intent(inout) :: aero_binned
1151 
1152  integer :: i_bin
1153  real(kind=dp) :: density, vol, loss_rate, p
1154 
1155  if (scenario%loss_function_type == scenario_loss_function_none .or. &
1156  scenario%loss_function_type == scenario_loss_function_invalid) then
1157  return
1158  else if (scenario%loss_function_type == scenario_loss_function_drydep) then
1159 
1160  ! Assumes a single aerosol species, as run_sect() requires. Both the
1161  ! density and the number diagnosis below use species 1 only, and
1162  ! must be generalized if more species are allowed.
1163  call assert_msg(258732274, aero_data_n_spec(aero_data) == 1, &
1164  "sectional loss assumes a single aerosol species")
1165  density = aero_data%density(1)
1166 
1167  do i_bin = 1,bin_grid_size(bin_grid)
1168 
1169  if (aero_binned%num_conc(i_bin) <= 0d0) cycle
1170 
1171  vol = aero_data_rad2vol(aero_data, bin_grid%centers(i_bin))
1172  loss_rate = scenario_loss_rate(scenario, vol, density, &
1173  aero_data, env_state)
1174  p = exp(- loss_rate * delta_t)
1175  aero_binned%vol_conc(i_bin,:) = aero_binned%vol_conc(i_bin,:) * p
1176  aero_binned%num_conc(i_bin) = aero_binned%vol_conc(i_bin,1) / vol
1177 
1178  end do
1179  else
1180  call die_msg(769879198, "loss_function must be none or drydep " &
1181  // "for sectional runs; unsupported loss function id: " &
1182  // trim(integer_to_string(scenario%loss_function_type)))
1183  end if
1184 
1185  end subroutine scenario_binned_loss
1186 
1187 !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
1188 
1189  !> Whether any of the contained aerosol modes are of the given type.
1190  elemental logical function scenario_contains_aero_mode_type(scenario, &
1191  aero_mode_type)
1192 
1193  !> Scenario data.
1194  type(scenario_t), intent(in) :: scenario
1195  !> Aerosol mode type to test for.
1196  integer, intent(in) :: aero_mode_type
1197 
1199  = any(aero_dist_contains_aero_mode_type(scenario%aero_emission, &
1200  aero_mode_type)) &
1201  .or. any(aero_dist_contains_aero_mode_type(scenario%aero_background, &
1202  aero_mode_type))
1203 
1205 
1206 !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
1207 
1208  !> Read environment data from an spec file.
1209  subroutine spec_file_read_scenario(file, gas_data, aero_data, &
1210  read_aero_weight_classes, scenario)
1211 
1212  !> Spec file.
1213  type(spec_file_t), intent(inout) :: file
1214  !> Gas data values.
1215  type(gas_data_t), intent(in) :: gas_data
1216  !> Aerosol data.
1217  type(aero_data_t), intent(inout) :: aero_data
1218  !> Whether the weight classes for each source are specified in inputs.
1219  logical, intent(in) :: read_aero_weight_classes
1220  !> Scenario data.
1221  type(scenario_t), intent(inout) :: scenario
1222 
1223  character(len=PMC_MAX_FILENAME_LEN) :: sub_filename
1224  type(spec_file_t) :: sub_file
1225  character(len=SPEC_LINE_MAX_VAR_LEN) :: function_name
1226  type(spec_line_t) :: line
1227 
1228  ! note that we have to hard-code the list for doxygen below
1229 
1230  !> \page input_format_scenario Input File Format: Scenario
1231  !!
1232  !! The scenario parameters are:
1233  !! <ul>
1234  !! <li> \b temp_profile (string): the name of the file from which to
1235  !! read the temperature profile --- the file format should be
1236  !! \subpage input_format_temp_profile
1237  !! <li> \b pressure_profile (string): the name of the file from which to
1238  !! read the pressure profile --- the file format should be
1239  !! \subpage input_format_pressure_profile
1240  !! <li> \b height_profile (string): the name of the file from which
1241  !! to read the mixing layer height profile --- the file format
1242  !! should be \subpage input_format_height_profile
1243  !! <li> \b gas_emissions (string): the name of the file from which to
1244  !! read the gas emissions profile --- the file format should be
1245  !! \subpage input_format_gas_profile
1246  !! <li> \b gas_background (string): the name of the file from which
1247  !! to read the gas background profile --- the file format should
1248  !! be \subpage input_format_gas_profile
1249  !! <li> \b aero_emissions (string): the name of the file from which
1250  !! to read the aerosol emissions profile --- the file format
1251  !! should be \subpage input_format_aero_dist_profile
1252  !! <li> \b aero_background (string): the name of the file from which
1253  !! to read the aerosol background profile --- the file format
1254  !! should be \subpage input_format_aero_dist_profile
1255  !! <li> \b loss_function (string): the type of loss function ---
1256  !! must be one of: \c none for no particle loss, \c constant
1257  !! for constant loss rate, \c volume for particle loss proportional
1258  !! to particle volume, \c drydep for particle loss proportional
1259  !! to dry deposition velocity, or \c chamber for a chamber model.
1260  !! Sectional and modal runs support only \c none and \c drydep.
1261  !! If \c loss_function is \c drydep, it may be followed by
1262  !! \b drydep_params (string), the name of the file from which to
1263  !! read the dry deposition parameters --- the file format should
1264  !! be \subpage input_format_drydep_params. If \c drydep_params is
1265  !! omitted, the default parameters are used and a warning is
1266  !! printed.
1267  !! If \c loss_function is \c chamber, then the following
1268  !! parameters must also be provided:
1269  !! - \subpage input_format_chamber
1270  !! </ul>
1271  !!
1272  !! See also:
1273  !! - \ref spec_file_format --- the input file text format
1274 
1275  ! temperature profile
1276  call spec_file_read_string(file, "temp_profile", sub_filename)
1277  call spec_file_open(sub_filename, sub_file)
1278  call spec_file_read_timed_real_array(sub_file, "temp", &
1279  scenario%temp_time, scenario%temp)
1280  call spec_file_close(sub_file)
1281 
1282  ! pressure profile
1283  call spec_file_read_string(file, "pressure_profile", sub_filename)
1284  call spec_file_open(sub_filename, sub_file)
1285  call spec_file_read_timed_real_array(sub_file, "pressure", &
1286  scenario%pressure_time, scenario%pressure)
1287  call spec_file_close(sub_file)
1288 
1289  ! height profile
1290  call spec_file_read_string(file, "height_profile", sub_filename)
1291  call spec_file_open(sub_filename, sub_file)
1292  call spec_file_read_timed_real_array(sub_file, "height", &
1293  scenario%height_time, scenario%height)
1294  call spec_file_close(sub_file)
1295 
1296  ! gas emissions profile
1297  call spec_file_read_string(file, "gas_emissions", sub_filename)
1298  call spec_file_open(sub_filename, sub_file)
1299  call spec_file_read_gas_states_times_rates(sub_file, gas_data, &
1300  scenario%gas_emission_time, scenario%gas_emission_rate_scale, &
1301  scenario%gas_emission)
1302  call spec_file_close(sub_file)
1303 
1304  ! gas background profile
1305  call spec_file_read_string(file, "gas_background", sub_filename)
1306  call spec_file_open(sub_filename, sub_file)
1307  call spec_file_read_gas_states_times_rates(sub_file, gas_data, &
1308  scenario%gas_dilution_time, scenario%gas_dilution_rate, &
1309  scenario%gas_background)
1310  call spec_file_close(sub_file)
1311 
1312  ! aerosol emissions profile
1313  call spec_file_read_string(file, "aero_emissions", sub_filename)
1314  call spec_file_open(sub_filename, sub_file)
1315  call spec_file_read_aero_dists_times_rates(sub_file, aero_data, &
1316  read_aero_weight_classes, scenario%aero_emission_time, &
1317  scenario%aero_emission_rate_scale, scenario%aero_emission)
1318  call spec_file_close(sub_file)
1319 
1320  ! aerosol background profile
1321  call spec_file_read_string(file, "aero_background", sub_filename)
1322  call spec_file_open(sub_filename, sub_file)
1323  call spec_file_read_aero_dists_times_rates(sub_file, aero_data, &
1324  read_aero_weight_classes, scenario%aero_dilution_time, &
1325  scenario%aero_dilution_rate, scenario%aero_background)
1326  call spec_file_close(sub_file)
1327 
1328  ! loss function
1329  call spec_file_read_string(file, 'loss_function', function_name)
1330  if (trim(function_name) == 'none') then
1331  scenario%loss_function_type = scenario_loss_function_none
1332  else if (trim(function_name) == 'constant') then
1333  scenario%loss_function_type = scenario_loss_function_constant
1334  else if (trim(function_name) == 'volume') then
1335  scenario%loss_function_type = scenario_loss_function_volume
1336  else if (trim(function_name) == 'drydep') then
1337  scenario%loss_function_type = scenario_loss_function_drydep
1338  call spec_file_read_line_no_eof(file, line)
1339  call spec_file_unread_line(file)
1340  if (line%name /= 'drydep_params') then
1341  call warn_msg(735291468, "using default dry deposition parameters")
1342  else
1343  call spec_file_read_string(file, 'drydep_params', sub_filename)
1344  call spec_file_open(sub_filename, sub_file)
1345  call spec_file_read_drydep_params(sub_file, scenario%drydep)
1346  call spec_file_close(sub_file)
1347  end if
1348  else if (trim(function_name) == 'chamber') then
1349  scenario%loss_function_type = scenario_loss_function_chamber
1350  call spec_file_read_chamber(file, scenario%chamber)
1351  else
1352  call spec_file_die_msg(518248400, file, &
1353  "Unknown loss function type: " // trim(function_name))
1354  end if
1355 
1356  end subroutine spec_file_read_scenario
1357 
1358  ! the following blocks belong in the subroutine above, but they are
1359  ! outside because Doxygen 1.8.7 doesn't resolve references when
1360  ! multiple \page blocks are in one subroutine
1361 
1362  !> \page input_format_temp_profile Input File Format: Temperature Profile
1363  !!
1364  !! A temperature profile input file must consist of two lines:
1365  !! - the first line must begin with \c time and should be followed
1366  !! by \f$N\f$ space-separated real scalars, giving the times (in
1367  !! s after the start of the simulation) of the temperature set
1368  !! points --- the times must be in increasing order
1369  !! - the second line must begin with \c temp and should be followed
1370  !! by \f$N\f$ space-separated real scalars, giving the
1371  !! temperatures (in K) at the corresponding times
1372  !!
1373  !! The temperature profile is linearly interpolated between the
1374  !! specified times, while before the first time it takes the first
1375  !! temperature value and after the last time it takes the last
1376  !! temperature value.
1377  !!
1378  !! Example:
1379  !! <pre>
1380  !! time 0 600 1800 # time (in s) after simulation start
1381  !! temp 270 290 280 # temperature (in K)
1382  !! </pre>
1383  !! Here the temperature starts at 270&nbsp;K at the start of the
1384  !! simulation, rises to 290&nbsp;K after 10&nbsp;min, and then
1385  !! falls again to 280&nbsp;K at 30&nbsp;min. Between these times
1386  !! the temperature is linearly interpolated, while after
1387  !! 30&nbsp;min it is held constant at 280&nbsp;K.
1388  !!
1389  !! See also:
1390  !! - \ref spec_file_format --- the input file text format
1391  !! - \ref input_format_scenario --- the environment data
1392  !! containing the temperature profile
1393 
1394  !> \page input_format_pressure_profile Input File Format: Pressure Profile
1395  !!
1396  !! A pressure profile input file must consist of two lines:
1397  !! - the first line must begin with \c time and should be followed
1398  !! by \f$N\f$ space-separated real scalars, giving the times (in
1399  !! s after the start of the simulation) of the pressure set
1400  !! points --- the times must be in increasing order
1401  !! - the second line must begin with \c pressure and should be followed
1402  !! by \f$N\f$ space-separated real scalars, giving the
1403  !! pressures (in Pa) at the corresponding times
1404  !!
1405  !! The pressure profile is linearly interpolated between the
1406  !! specified times, while before the first time it takes the first
1407  !! pressure value and after the last time it takes the last
1408  !! pressure value.
1409  !!
1410  !! Example:
1411  !! <pre>
1412  !! time 0 600 1800 # time (in s) after simulation start
1413  !! pressure 1e5 9e4 7.5e4 # pressure (in Pa)
1414  !! </pre>
1415  !! Here the pressure starts at 1e5&nbsp;Pa at the start of the
1416  !! simulation, decreases to 9e4&nbsp;Pa after 10&nbsp;min, and then
1417  !! decreases further to 7.5e4&nbsp;Pa at 30&nbsp;min. Between these times
1418  !! the pressure is linearly interpolated, while after
1419  !! 30&nbsp;min it is held constant at 7.5e4&nbsp;Pa.
1420  !!
1421  !! See also:
1422  !! - \ref spec_file_format --- the input file text format
1423  !! - \ref input_format_scenario --- the environment data
1424  !! containing the pressure profile
1425 
1426  !> \page input_format_height_profile Input File Format: Mixing Layer Height Profile
1427  !!
1428  !! A mixing layer height profile input file must consist of two
1429  !! lines:
1430  !! - the first line must begin with \c time and should be followed
1431  !! by \f$N\f$ space-separated real scalars, giving the times (in
1432  !! s after the start of the simulation) of the height set
1433  !! points --- the times must be in increasing order
1434  !! - the second line must begin with \c height and should be
1435  !! followed by \f$N\f$ space-separated real scalars, giving the
1436  !! mixing layer heights (in m) at the corresponding times
1437  !!
1438  !! The mixing layer height profile is linearly interpolated
1439  !! between the specified times, while before the first time it
1440  !! takes the first height value and after the last time it takes
1441  !! the last height value.
1442  !!
1443  !! Example:
1444  !! <pre>
1445  !! time 0 600 1800 # time (in s) after simulation start
1446  !! height 500 1000 800 # mixing layer height (in m)
1447  !! </pre>
1448  !! Here the mixing layer height starts at 500&nbsp;m at the start
1449  !! of the simulation, rises to 1000&nbsp;m after 10&nbsp;min, and
1450  !! then falls again to 800&nbsp;m at 30&nbsp;min. Between these
1451  !! times the mixing layer height is linearly interpolated, while
1452  !! after 30&nbsp;min it is held constant at 800&nbsp;m.
1453  !!
1454  !! See also:
1455  !! - \ref spec_file_format --- the input file text format
1456  !! - \ref input_format_scenario --- the environment data
1457  !! containing the mixing layer height profile
1458 
1459 !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
1460 
1461  !> Read dry deposition parameters from a spec file.
1462  subroutine spec_file_read_drydep_params(file, drydep_params)
1463 
1464  !> Spec file.
1465  type(spec_file_t), intent(inout) :: file
1466  !> Dry deposition parameters.
1467  type(drydep_params_t), intent(inout) :: drydep_params
1468 
1469  !> \page input_format_drydep_params Input File Format: Dry Deposition Parameters
1470  !!
1471  !! Dry deposition is simulated using the specified parameters:
1472  !! - \b z_ref (real, unit m): the reference height \f$z_{\rm ref}\f$ used
1473  !! in the calculation of aerodynamic resistance \f$R_a\f$
1474  !! - \b u_mean (real, unit m s^{-1}): the wind speed at the reference
1475  !! height
1476  !! - \b z_rough (real, unit m): the roughness length associated with
1477  !! the surface
1478  !! - \b A (real, unit m): the characteristic radius of collectors
1479  !! associated with the surface
1480  !! - \b alpha (real, dimensionless): the parameter \f$\alpha\f$ used
1481  !! in the calculation of impaction efficiency \f$E_{\rm IM}\f$
1482  !! - \b eps_0 (real, dimensionless): the empirical constant used in the
1483  !! calculation of surface resistance \f$R_s\f$
1484  !! - \b gamma (real, dimensionless): the exponent \f$\gamma\f$ used in the
1485  !! calculation of Brownian diffusion collection
1486  !! efficiency \f$E_{\rm B}\f$
1487  !! - \b C_B (real, dimensionless): the coefficient for Brownian diffusion
1488  !! collection efficiency \f$E_{\rm B}\f$
1489  !! - \b C_IN (real, dimensionless): the coefficient for interception
1490  !! collection efficiency \f$E_{\rm IN}\f$
1491  !! - \b C_IM (real, dimensionless): the coefficient for impaction
1492  !! collection efficiency \f$E_{\rm IM}\f$
1493  !! - \b nu (real, dimensionless): the exponent \f$\nu\f$ used in the
1494  !! calculation of interception collection efficiency \f$E_{\rm IN}\f$
1495  !! - \b beta (real, dimensionless): the exponent \f$\beta\f$ used in the
1496  !! calculation of impaction collection efficiency \f$E_{\rm IM}\f$
1497  !!
1498  !! See also:
1499  !! - \ref spec_file_format --- the input file text format
1500  !! - \ref input_format_scenario --- the prescribed profiles of
1501  !! other environment data
1502 
1503  call spec_file_read_real(file, "z_ref", drydep_params%z_ref)
1504  call spec_file_read_real(file, "u_mean", drydep_params%u_mean)
1505  call spec_file_read_real(file, "z_rough", drydep_params%z_rough)
1506  call spec_file_read_real(file, "A", drydep_params%A)
1507  call spec_file_read_real(file, "alpha", drydep_params%alpha)
1508  call spec_file_read_real(file, "eps_0", drydep_params%eps_0)
1509  call spec_file_read_real(file, "gamma", drydep_params%gamma)
1510  call spec_file_read_real(file, "C_B", drydep_params%C_B)
1511  call spec_file_read_real(file, "C_IN", drydep_params%C_IN)
1512  call spec_file_read_real(file, "C_IM", drydep_params%C_IM)
1513  call spec_file_read_real(file, "nu", drydep_params%nu)
1514  call spec_file_read_real(file, "beta", drydep_params%beta)
1515 
1516  end subroutine spec_file_read_drydep_params
1517 
1518 !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
1519 
1520  !> Write dry deposition parameters to a NetCDF file.
1521  subroutine drydep_params_output_netcdf(drydep_params, ncid)
1522 
1523  !> Dry deposition parameters.
1524  type(drydep_params_t), intent(in) :: drydep_params
1525  !> NetCDF file ID, in data mode.
1526  integer, intent(in) :: ncid
1527 
1528  associate(d => drydep_params)
1529  call pmc_nc_write_real(ncid, d%z_ref, "drydep_z_ref", unit="m")
1530  call pmc_nc_write_real(ncid, d%u_mean, "drydep_u_mean", &
1531  unit="m s^{-1}")
1532  call pmc_nc_write_real(ncid, d%z_rough, "drydep_z_rough", unit="m")
1533  call pmc_nc_write_real(ncid, d%A, "drydep_A", unit="m")
1534  call pmc_nc_write_real(ncid, d%alpha, "drydep_alpha", unit="1")
1535  call pmc_nc_write_real(ncid, d%eps_0, "drydep_eps_0", unit="1")
1536  call pmc_nc_write_real(ncid, d%gamma, "drydep_gamma", unit="1")
1537  call pmc_nc_write_real(ncid, d%C_B, "drydep_C_B", unit="1")
1538  call pmc_nc_write_real(ncid, d%C_IN, "drydep_C_IN", unit="1")
1539  call pmc_nc_write_real(ncid, d%C_IM, "drydep_C_IM", unit="1")
1540  call pmc_nc_write_real(ncid, d%nu, "drydep_nu", unit="1")
1541  call pmc_nc_write_real(ncid, d%beta, "drydep_beta", unit="1")
1542  end associate
1543 
1544  end subroutine drydep_params_output_netcdf
1545 
1546 !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
1547 
1548  !> Read dry deposition parameters from a NetCDF file.
1549  subroutine drydep_params_input_netcdf(drydep_params, ncid, must_be_present)
1550 
1551  !> Dry deposition parameters.
1552  type(drydep_params_t), intent(inout) :: drydep_params
1553  !> NetCDF file ID, in data mode.
1554  integer, intent(in) :: ncid
1555  !> Whether the parameters must be present in the file (default
1556  !> \c .true.). They are only written when the loss function is dry
1557  !> deposition, so readers that may be given either kind of file
1558  !> should pass \c .false., which leaves \c drydep_params unchanged.
1559  logical, optional, intent(in) :: must_be_present
1560 
1561  integer :: varid, status
1562  logical :: use_must_be_present
1563 
1564  use_must_be_present = .true.
1565  if (present(must_be_present)) use_must_be_present = must_be_present
1566 
1567  if (.not. use_must_be_present) then
1568  status = nf90_inq_varid(ncid, "drydep_z_ref", varid)
1569  if (status == nf90_enotvar) return
1570  end if
1571 
1572  associate(d => drydep_params)
1573  call pmc_nc_read_real(ncid, d%z_ref, "drydep_z_ref")
1574  call pmc_nc_read_real(ncid, d%u_mean, "drydep_u_mean")
1575  call pmc_nc_read_real(ncid, d%z_rough, "drydep_z_rough")
1576  call pmc_nc_read_real(ncid, d%A, "drydep_A")
1577  call pmc_nc_read_real(ncid, d%alpha, "drydep_alpha")
1578  call pmc_nc_read_real(ncid, d%eps_0, "drydep_eps_0")
1579  call pmc_nc_read_real(ncid, d%gamma, "drydep_gamma")
1580  call pmc_nc_read_real(ncid, d%C_B, "drydep_C_B")
1581  call pmc_nc_read_real(ncid, d%C_IN, "drydep_C_IN")
1582  call pmc_nc_read_real(ncid, d%C_IM, "drydep_C_IM")
1583  call pmc_nc_read_real(ncid, d%nu, "drydep_nu")
1584  call pmc_nc_read_real(ncid, d%beta, "drydep_beta")
1585  end associate
1586 
1587  end subroutine drydep_params_input_netcdf
1588 
1589 !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
1590 
1591  !> Determines the number of bytes required to pack the given value.
1592  integer function pmc_mpi_pack_size_scenario(val)
1593 
1594  !> Value to pack.
1595  type(scenario_t), intent(in) :: val
1596 
1597  integer :: total_size, i
1598 
1599  total_size = &
1600  pmc_mpi_pack_size_real_array(val%temp_time) &
1601  + pmc_mpi_pack_size_real_array(val%temp) &
1602  + pmc_mpi_pack_size_real_array(val%pressure_time) &
1603  + pmc_mpi_pack_size_real_array(val%pressure) &
1604  + pmc_mpi_pack_size_real_array(val%height_time) &
1605  + pmc_mpi_pack_size_real_array(val%height) &
1606  + pmc_mpi_pack_size_real_array(val%gas_emission_time) &
1607  + pmc_mpi_pack_size_real_array(val%gas_emission_rate_scale) &
1608  + pmc_mpi_pack_size_real_array(val%gas_dilution_time) &
1609  + pmc_mpi_pack_size_real_array(val%gas_dilution_rate) &
1610  + pmc_mpi_pack_size_real_array(val%aero_emission_time) &
1611  + pmc_mpi_pack_size_real_array(val%aero_emission_rate_scale) &
1612  + pmc_mpi_pack_size_real_array(val%aero_dilution_time) &
1613  + pmc_mpi_pack_size_real_array(val%aero_dilution_rate) &
1614  + pmc_mpi_pack_size_integer(val%loss_function_type) &
1615  + pmc_mpi_pack_size_drydep(val%drydep) &
1616  + pmc_mpi_pack_size_chamber(val%chamber)
1617  if (allocated(val%gas_emission_time)) then
1618  do i = 1,size(val%gas_emission)
1619  total_size = total_size &
1620  + pmc_mpi_pack_size_gas_state(val%gas_emission(i))
1621  end do
1622  end if
1623  if (allocated(val%gas_dilution_time)) then
1624  do i = 1,size(val%gas_background)
1625  total_size = total_size &
1626  + pmc_mpi_pack_size_gas_state(val%gas_background(i))
1627  end do
1628  end if
1629  if (allocated(val%aero_emission_time)) then
1630  do i = 1,size(val%aero_emission)
1631  total_size = total_size &
1632  + pmc_mpi_pack_size_aero_dist(val%aero_emission(i))
1633  end do
1634  end if
1635  if (allocated(val%aero_dilution_time)) then
1636  do i = 1,size(val%aero_background)
1637  total_size = total_size &
1638  + pmc_mpi_pack_size_aero_dist(val%aero_background(i))
1639  end do
1640  end if
1641 
1642  pmc_mpi_pack_size_scenario = total_size
1643 
1644  end function pmc_mpi_pack_size_scenario
1645 
1646 !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
1647 
1648  !> Packs the given value into the buffer, advancing position.
1649  subroutine pmc_mpi_pack_scenario(buffer, position, val)
1650 
1651  !> Memory buffer.
1652  character, intent(inout) :: buffer(:)
1653  !> Current buffer position.
1654  integer, intent(inout) :: position
1655  !> Value to pack.
1656  type(scenario_t), intent(in) :: val
1657 
1658 #ifdef PMC_USE_MPI
1659  integer :: prev_position, i
1660 
1661  prev_position = position
1662  call pmc_mpi_pack_real_array(buffer, position, val%temp_time)
1663  call pmc_mpi_pack_real_array(buffer, position, val%temp)
1664  call pmc_mpi_pack_real_array(buffer, position, val%pressure_time)
1665  call pmc_mpi_pack_real_array(buffer, position, val%pressure)
1666  call pmc_mpi_pack_real_array(buffer, position, val%height_time)
1667  call pmc_mpi_pack_real_array(buffer, position, val%height)
1668  call pmc_mpi_pack_real_array(buffer, position, val%gas_emission_time)
1669  call pmc_mpi_pack_real_array(buffer, position, val%gas_emission_rate_scale)
1670  call pmc_mpi_pack_real_array(buffer, position, val%gas_dilution_time)
1671  call pmc_mpi_pack_real_array(buffer, position, val%gas_dilution_rate)
1672  call pmc_mpi_pack_real_array(buffer, position, val%aero_emission_time)
1673  call pmc_mpi_pack_real_array(buffer, position, &
1674  val%aero_emission_rate_scale)
1675  call pmc_mpi_pack_real_array(buffer, position, val%aero_dilution_time)
1676  call pmc_mpi_pack_real_array(buffer, position, val%aero_dilution_rate)
1677  call pmc_mpi_pack_integer(buffer, position, val%loss_function_type)
1678  call pmc_mpi_pack_drydep(buffer, position, val%drydep)
1679  call pmc_mpi_pack_chamber(buffer, position, val%chamber)
1680  if (allocated(val%gas_emission_time)) then
1681  do i = 1,size(val%gas_emission)
1682  call pmc_mpi_pack_gas_state(buffer, position, val%gas_emission(i))
1683  end do
1684  end if
1685  if (allocated(val%gas_dilution_time)) then
1686  do i = 1,size(val%gas_background)
1687  call pmc_mpi_pack_gas_state(buffer, position, val%gas_background(i))
1688  end do
1689  end if
1690  if (allocated(val%aero_emission_time)) then
1691  do i = 1,size(val%aero_emission)
1692  call pmc_mpi_pack_aero_dist(buffer, position, val%aero_emission(i))
1693  end do
1694  end if
1695  if (allocated(val%aero_dilution_time)) then
1696  do i = 1,size(val%aero_background)
1697  call pmc_mpi_pack_aero_dist(buffer, position, val%aero_background(i))
1698  end do
1699  end if
1700  call assert(639466930, &
1701  position - prev_position <= pmc_mpi_pack_size_scenario(val))
1702 #endif
1703 
1704  end subroutine pmc_mpi_pack_scenario
1705 
1706 !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
1707 
1708  !> Unpacks the given value from the buffer, advancing position.
1709  subroutine pmc_mpi_unpack_scenario(buffer, position, val)
1710 
1711  !> Memory buffer.
1712  character, intent(inout) :: buffer(:)
1713  !> Current buffer position.
1714  integer, intent(inout) :: position
1715  !> Value to pack.
1716  type(scenario_t), intent(inout) :: val
1717 
1718 #ifdef PMC_USE_MPI
1719  integer :: prev_position, i
1720 
1721  prev_position = position
1722  call pmc_mpi_unpack_real_array(buffer, position, val%temp_time)
1723  call pmc_mpi_unpack_real_array(buffer, position, val%temp)
1724  call pmc_mpi_unpack_real_array(buffer, position, val%pressure_time)
1725  call pmc_mpi_unpack_real_array(buffer, position, val%pressure)
1726  call pmc_mpi_unpack_real_array(buffer, position, val%height_time)
1727  call pmc_mpi_unpack_real_array(buffer, position, val%height)
1728  call pmc_mpi_unpack_real_array(buffer, position, val%gas_emission_time)
1729  call pmc_mpi_unpack_real_array(buffer, position, &
1730  val%gas_emission_rate_scale)
1731  call pmc_mpi_unpack_real_array(buffer, position, val%gas_dilution_time)
1732  call pmc_mpi_unpack_real_array(buffer, position, val%gas_dilution_rate)
1733  call pmc_mpi_unpack_real_array(buffer, position, val%aero_emission_time)
1734  call pmc_mpi_unpack_real_array(buffer, position, &
1735  val%aero_emission_rate_scale)
1736  call pmc_mpi_unpack_real_array(buffer, position, val%aero_dilution_time)
1737  call pmc_mpi_unpack_real_array(buffer, position, val%aero_dilution_rate)
1738  call pmc_mpi_unpack_integer(buffer, position, val%loss_function_type)
1739  call pmc_mpi_unpack_drydep(buffer, position, val%drydep)
1740  call pmc_mpi_unpack_chamber(buffer, position, val%chamber)
1741  if (allocated(val%gas_emission)) deallocate(val%gas_emission)
1742  if (allocated(val%gas_background)) deallocate(val%gas_background)
1743  if (allocated(val%aero_emission)) deallocate(val%aero_emission)
1744  if (allocated(val%aero_background)) deallocate(val%aero_background)
1745  if (allocated(val%gas_emission_time)) then
1746  allocate(val%gas_emission(size(val%gas_emission_time)))
1747  do i = 1,size(val%gas_emission)
1748  call pmc_mpi_unpack_gas_state(buffer, position, val%gas_emission(i))
1749  end do
1750  end if
1751  if (allocated(val%gas_dilution_time)) then
1752  allocate(val%gas_background(size(val%gas_dilution_time)))
1753  do i = 1,size(val%gas_background)
1754  call pmc_mpi_unpack_gas_state(buffer, position, &
1755  val%gas_background(i))
1756  end do
1757  end if
1758  if (allocated(val%aero_emission_time)) then
1759  allocate(val%aero_emission(size(val%aero_emission_time)))
1760  do i = 1,size(val%aero_emission)
1761  call pmc_mpi_unpack_aero_dist(buffer, position, val%aero_emission(i))
1762  end do
1763  end if
1764  if (allocated(val%aero_dilution_time)) then
1765  allocate(val%aero_background(size(val%aero_dilution_time)))
1766  do i = 1,size(val%aero_background)
1767  call pmc_mpi_unpack_aero_dist(buffer, position, &
1768  val%aero_background(i))
1769  end do
1770  end if
1771  call assert(611542570, &
1772  position - prev_position <= pmc_mpi_pack_size_scenario(val))
1773 #endif
1774 
1775  end subroutine pmc_mpi_unpack_scenario
1776 
1777 !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
1778 
1779  !> Determines the number of bytes required to pack the given value.
1780  integer function pmc_mpi_pack_size_drydep(val)
1781 
1782  !> Value to pack.
1783  type(drydep_params_t), intent(in) :: val
1784 
1786  pmc_mpi_pack_size_real(val%z_ref) &
1787  + pmc_mpi_pack_size_real(val%u_mean) &
1788  + pmc_mpi_pack_size_real(val%z_rough) &
1789  + pmc_mpi_pack_size_real(val%A) &
1790  + pmc_mpi_pack_size_real(val%alpha) &
1791  + pmc_mpi_pack_size_real(val%eps_0) &
1792  + pmc_mpi_pack_size_real(val%gamma) &
1793  + pmc_mpi_pack_size_real(val%C_B) &
1794  + pmc_mpi_pack_size_real(val%C_IN) &
1795  + pmc_mpi_pack_size_real(val%C_IM) &
1796  + pmc_mpi_pack_size_real(val%nu) &
1797  + pmc_mpi_pack_size_real(val%beta)
1798 
1799  end function pmc_mpi_pack_size_drydep
1800 
1801 !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
1802 
1803  !> Packs the given value into the buffer, advancing position.
1804  subroutine pmc_mpi_pack_drydep(buffer, position, val)
1805 
1806  !> Memory buffer.
1807  character, intent(inout) :: buffer(:)
1808  !> Current buffer position.
1809  integer, intent(inout) :: position
1810  !> Value to pack.
1811  type(drydep_params_t), intent(in) :: val
1812 
1813 #ifdef PMC_USE_MPI
1814  integer :: prev_position
1815 
1816  prev_position = position
1817  call pmc_mpi_pack_real(buffer, position, val%z_ref)
1818  call pmc_mpi_pack_real(buffer, position, val%u_mean)
1819  call pmc_mpi_pack_real(buffer, position, val%z_rough)
1820  call pmc_mpi_pack_real(buffer, position, val%A)
1821  call pmc_mpi_pack_real(buffer, position, val%alpha)
1822  call pmc_mpi_pack_real(buffer, position, val%eps_0)
1823  call pmc_mpi_pack_real(buffer, position, val%gamma)
1824  call pmc_mpi_pack_real(buffer, position, val%C_B)
1825  call pmc_mpi_pack_real(buffer, position, val%C_IN)
1826  call pmc_mpi_pack_real(buffer, position, val%C_IM)
1827  call pmc_mpi_pack_real(buffer, position, val%nu)
1828  call pmc_mpi_pack_real(buffer, position, val%beta)
1829  call assert(371592468, &
1830  position - prev_position <= pmc_mpi_pack_size_drydep(val))
1831 #endif
1832 
1833  end subroutine pmc_mpi_pack_drydep
1834 
1835 !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
1836 
1837  !> Unpacks the given value from the buffer, advancing position.
1838  subroutine pmc_mpi_unpack_drydep(buffer, position, val)
1839 
1840  !> Memory buffer.
1841  character, intent(inout) :: buffer(:)
1842  !> Current buffer position.
1843  integer, intent(inout) :: position
1844  !> Value to pack.
1845  type(drydep_params_t), intent(inout) :: val
1846 
1847 #ifdef PMC_USE_MPI
1848  integer :: prev_position
1849 
1850  prev_position = position
1851  call pmc_mpi_unpack_real(buffer, position, val%z_ref)
1852  call pmc_mpi_unpack_real(buffer, position, val%u_mean)
1853  call pmc_mpi_unpack_real(buffer, position, val%z_rough)
1854  call pmc_mpi_unpack_real(buffer, position, val%A)
1855  call pmc_mpi_unpack_real(buffer, position, val%alpha)
1856  call pmc_mpi_unpack_real(buffer, position, val%eps_0)
1857  call pmc_mpi_unpack_real(buffer, position, val%gamma)
1858  call pmc_mpi_unpack_real(buffer, position, val%C_B)
1859  call pmc_mpi_unpack_real(buffer, position, val%C_IN)
1860  call pmc_mpi_unpack_real(buffer, position, val%C_IM)
1861  call pmc_mpi_unpack_real(buffer, position, val%nu)
1862  call pmc_mpi_unpack_real(buffer, position, val%beta)
1863  call assert(582741936, &
1864  position - prev_position <= pmc_mpi_pack_size_drydep(val))
1865 #endif
1866 
1867  end subroutine pmc_mpi_unpack_drydep
1868 
1869 !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
1870 
1871 end module pmc_scenario
pmc_aero_state::aero_state_zero
subroutine aero_state_zero(aero_state)
Resets an aero_state to have zero particles per bin.
Definition: aero_state.F90:350
pmc_scenario::scenario_contains_aero_mode_type
elemental logical function scenario_contains_aero_mode_type(scenario, aero_mode_type)
Whether any of the contained aerosol modes are of the given type.
Definition: scenario.F90:1192
pmc_scenario::pmc_mpi_unpack_drydep
subroutine pmc_mpi_unpack_drydep(buffer, position, val)
Unpacks the given value from the buffer, advancing position.
Definition: scenario.F90:1839
pmc_aero_dist::aero_dist_n_mode
elemental integer function aero_dist_n_mode(aero_dist)
Return the number of modes.
Definition: aero_dist.F90:44
pmc_aero_data::aero_data_n_spec
elemental integer function aero_data_n_spec(aero_data)
Return the number of aerosol species, or -1 if uninitialized.
Definition: aero_data.F90:250
pmc_gas_data::gas_data_t
Constant gas data.
Definition: gas_data.F90:35
pmc_mpi
Wrapper functions for MPI.
Definition: mpi.F90:13
pmc_scenario::drydep_params_output_netcdf
subroutine drydep_params_output_netcdf(drydep_params, ncid)
Write dry deposition parameters to a NetCDF file.
Definition: scenario.F90:1522
pmc_mpi::pmc_mpi_pack_size_real
integer function pmc_mpi_pack_size_real(val)
Determines the number of bytes required to pack the given value.
Definition: mpi.F90:385
pmc_scenario::scenario_loss_rate
real(kind=dp) function scenario_loss_rate(scenario, vol, density, aero_data, env_state)
Evaluate a loss rate function.
Definition: scenario.F90:508
pmc_scenario::pmc_mpi_pack_drydep
subroutine pmc_mpi_pack_drydep(buffer, position, val)
Packs the given value into the buffer, advancing position.
Definition: scenario.F90:1805
pmc_scenario::scenario_modal_drydep_velocities
subroutine scenario_modal_drydep_velocities(scenario, aero_dist, moment, density, env_state, velocities)
Updates an array to contain the integrated deposition velocities for the given moment of each aerosol...
Definition: scenario.F90:901
pmc_spec_file::spec_file_close
subroutine spec_file_close(file)
Close a spec file.
Definition: spec_file.F90:135
pmc_gas_state::gas_state_ensure_nonnegative
subroutine gas_state_ensure_nonnegative(gas_state)
Set any negative values to zero.
Definition: gas_state.F90:167
pmc_aero_state::aero_state_add_aero_dist_sample
subroutine aero_state_add_aero_dist_sample(aero_state, aero_data, aero_dist, sample_prop, characteristic_factor, create_time, allow_doubling, allow_halving, n_part_add)
Generates a Poisson sample of an aero_dist, adding to aero_state, with the given sample proportion.
Definition: aero_state.F90:761
pmc_scenario::scenario_loss_function_volume
integer, parameter scenario_loss_function_volume
Type code for a loss rate function proportional to particle volume.
Definition: scenario.F90:36
pmc_scenario
The scenario_t structure and associated subroutines.
Definition: scenario.F90:9
pmc_scenario::scenario_t
Scenario data.
Definition: scenario.F90:87
pmc_gas_data
The gas_data_t structure and associated subroutines.
Definition: gas_data.F90:9
pmc_scenario::pmc_mpi_pack_scenario
subroutine pmc_mpi_pack_scenario(buffer, position, val)
Packs the given value into the buffer, advancing position.
Definition: scenario.F90:1650
pmc_util::warn_assert_msg
subroutine warn_assert_msg(code, condition_ok, warning_msg)
Prints a warning message if condition_ok is false.
Definition: util.F90:60
pmc_util::die_msg
subroutine die_msg(code, error_msg)
Error immediately.
Definition: util.F90:135
pmc_netcdf
Wrapper functions for NetCDF. These all take a NetCDF ncid in data mode and return with it again in d...
Definition: netcdf.F90:11
pmc_scenario::scenario_loss_function_constant
integer, parameter scenario_loss_function_constant
Type code for a constant loss function.
Definition: scenario.F90:34
pmc_scenario::scenario_loss_function_none
integer, parameter scenario_loss_function_none
Type code for a zero loss function.
Definition: scenario.F90:32
pmc_constants::dp
integer, parameter dp
Kind of a double precision real number.
Definition: constants.F90:12
pmc_aero_dist::aero_dist_interp_1d
subroutine aero_dist_interp_1d(aero_dist_list, time_list, rate_list, time, aero_dist, rate)
Determine the current aero_dist and rate by interpolating at the current time with the lists of aero_...
Definition: aero_dist.F90:177
pmc_spec_file
Reading formatted text input.
Definition: spec_file.F90:43
pmc_gas_state::gas_state_add_scaled
subroutine gas_state_add_scaled(gas_state, gas_state_delta, alpha)
Adds the given gas_state_delta scaled by alpha.
Definition: gas_state.F90:124
pmc_util::interp_1d
real(kind=dp) function interp_1d(x_vals, y_vals, x)
1D linear interpolation.
Definition: util.F90:627
pmc_bin_grid::bin_grid_size
elemental integer function bin_grid_size(bin_grid)
Return the number of bins in the grid, or -1 if the bin grid is not allocated.
Definition: bin_grid.F90:51
pmc_scenario::pmc_mpi_unpack_scenario
subroutine pmc_mpi_unpack_scenario(buffer, position, val)
Unpacks the given value from the buffer, advancing position.
Definition: scenario.F90:1710
pmc_env_state::env_state_t
Current environment state.
Definition: env_state.F90:29
pmc_mpi::pmc_mpi_pack_real
subroutine pmc_mpi_pack_real(buffer, position, val)
Packs the given value into the buffer, advancing position.
Definition: mpi.F90:761
pmc_scenario::scenario_binned_loss
subroutine scenario_binned_loss(scenario, bin_grid, delta_t, aero_data, env_state, aero_binned)
Performs loss for a binned aerosol distribution for one time step.
Definition: scenario.F90:1138
pmc_util::assert
subroutine assert(code, condition_ok)
Errors unless condition_ok is true.
Definition: util.F90:104
pmc_scenario::scenario_update_gas_state
subroutine scenario_update_gas_state(scenario, delta_t, env_state, old_env_state, gas_data, gas_state)
Do gas emissions and background dilution.
Definition: scenario.F90:244
pmc_scenario::scenario_update_aero_state
subroutine scenario_update_aero_state(scenario, delta_t, env_state, old_env_state, aero_data, aero_state, n_emit, n_dil_in, n_dil_out, allow_doubling, allow_halving)
Do emissions and background dilution for a particle aerosol distribution.
Definition: scenario.F90:297
pmc_aero_state
The aero_state_t structure and assocated subroutines.
Definition: aero_state.F90:9
pmc_mpi::pmc_mpi_pack_size_real_array
integer function pmc_mpi_pack_size_real_array(val)
Determines the number of bytes required to pack the given value.
Definition: mpi.F90:527
pmc_scenario::scenario_loss_rate_max
real(kind=dp) function scenario_loss_rate_max(scenario, vol, aero_data, env_state)
Compute and return the max loss rate function for a given volume.
Definition: scenario.F90:930
pmc_util::interp_linear_disc
real(kind=dp) function interp_linear_disc(x_1, x_n, n, i)
Linear interpolation over discrete indices.
Definition: util.F90:664
pmc_scenario::scenario_update_env_state
subroutine scenario_update_env_state(scenario, env_state, time)
Update time-dependent contents of the environment. scenario_init_env_state() should have been called ...
Definition: scenario.F90:169
pmc_spec_file::spec_file_t
An input file with extra data for printing messages.
Definition: spec_file.F90:59
pmc_scenario::scenario_loss_rate_bin_max
subroutine scenario_loss_rate_bin_max(scenario, bin_grid, aero_data, env_state, loss_max)
Compute an upper bound on the maximum kernel value for each bin. Value over_scale is multiplied to th...
Definition: scenario.F90:967
pmc_scenario::scenario_loss_alg_threshold
real(kind=dp), parameter scenario_loss_alg_threshold
Parameter to switch between algorithms for particle loss. A value of 0 will always use the naive algo...
Definition: scenario.F90:45
pmc_gas_state
The gas_state_t structure and associated subroutines.
Definition: gas_state.F90:9
pmc_util::warn_msg
subroutine warn_msg(code, warning_msg, already_warned)
Prints a warning message.
Definition: util.F90:38
pmc_spec_file::spec_file_read_real
subroutine spec_file_read_real(file, name, var)
Read a real number from a spec file that must have the given name.
Definition: spec_file.F90:582
pmc_util::integer_to_string
character(len=pmc_util_convert_string_len) function integer_to_string(val)
Convert an integer to a string format.
Definition: util.F90:767
pmc_util::real_to_string
character(len=pmc_util_convert_string_len) function real_to_string(val)
Convert a real to a string format.
Definition: util.F90:799
pmc_util::assert_msg
subroutine assert_msg(code, condition_ok, error_msg)
Errors unless condition_ok is true.
Definition: util.F90:78
pmc_scenario::drydep_params_t
Parameters for simulating dry deposition.
Definition: scenario.F90:48
pmc_aero_dist
The aero_dist_t structure and associated subroutines.
Definition: aero_dist.F90:18
pmc_scenario::scenario_integrated_loss_rate_drydep
real(kind=dp) function scenario_integrated_loss_rate_drydep(scenario, aero_mode, moment, density, env_state)
Compute and return the integrated dry deposition rate for a given lognormal aerosol mode (modal appro...
Definition: scenario.F90:648
pmc_netcdf::pmc_nc_write_real
subroutine pmc_nc_write_real(ncid, var, name, unit, long_name, standard_name, description)
Write a single real to a NetCDF file.
Definition: netcdf.F90:703
pmc_gas_state::gas_state_scale
subroutine gas_state_scale(gas_state, alpha)
Scale a gas state.
Definition: gas_state.F90:86
pmc_scenario::scenario_update_aero_modes
subroutine scenario_update_aero_modes(aero_dist, del_t, env_state, density, scenario)
Update the modal aerosol distribution to account for particle loss.
Definition: scenario.F90:443
pmc_aero_state::aero_state_remove_particle_with_info
subroutine aero_state_remove_particle_with_info(aero_state, i_part, aero_info)
Remove the given particle and record the removal.
Definition: aero_state.F90:410
pmc_aero_state::aero_state_total_particles
integer function aero_state_total_particles(aero_state, i_group, i_class)
Returns the total number of particles in an aerosol distribution.
Definition: aero_state.F90:288
pmc_chamber::chamber_t
Definition: chamber.F90:18
pmc_constants::const
type(const_t), save const
Fixed variable for accessing the constant's values.
Definition: constants.F90:81
pmc_chamber::chamber_loss_rate_sedi
real(kind=dp) function chamber_loss_rate_sedi(chamber, vol, density, aero_data, env_state)
Calculate the loss rate due to sedimentation in chamber. Based on Eq. 37b in Naumann 2003 J....
Definition: chamber.F90:118
pmc_scenario::pmc_mpi_pack_size_drydep
integer function pmc_mpi_pack_size_drydep(val)
Determines the number of bytes required to pack the given value.
Definition: scenario.F90:1781
pmc_spec_file::spec_file_open
subroutine spec_file_open(filename, file)
Open a spec file for reading.
Definition: spec_file.F90:112
pmc_env_state::env_state_sat_vapor_pressure
real(kind=dp) function env_state_sat_vapor_pressure(env_state)
Computes the current saturation vapor pressure (Pa).
Definition: env_state.F90:166
pmc_spec_file::spec_file_read_timed_real_array
subroutine spec_file_read_timed_real_array(file, name, times, vals)
Read an a time-indexed array of real data.
Definition: spec_file.F90:707
pmc_scenario::pmc_mpi_pack_size_scenario
integer function pmc_mpi_pack_size_scenario(val)
Determines the number of bytes required to pack the given value.
Definition: scenario.F90:1593
pmc_spec_file::spec_file_read_line_no_eof
subroutine spec_file_read_line_no_eof(file, line)
Read a spec_line from the spec_file. This will always succeed or error out, so should only be called ...
Definition: spec_file.F90:298
pmc_env_state
The env_state_t structure and associated subroutines.
Definition: env_state.F90:9
pmc_gas_state::gas_state_t
Current state of the gas mixing ratios in the system.
Definition: gas_state.F90:33
pmc_aero_data::aero_data_t
Aerosol material properties and associated data.
Definition: aero_data.F90:55
pmc_mpi::pmc_mpi_unpack_integer
subroutine pmc_mpi_unpack_integer(buffer, position, val)
Unpacks the given value from the buffer, advancing position.
Definition: mpi.F90:1139
pmc_aero_state::aero_state_copy_weight
subroutine aero_state_copy_weight(aero_state_from, aero_state_to)
Copies weighting information for an aero_state.
Definition: aero_state.F90:171
pmc_scenario::scenario_update_aero_binned
subroutine scenario_update_aero_binned(scenario, delta_t, env_state, old_env_state, bin_grid, aero_data, do_aero_dilution, aero_binned)
Do emissions and background dilution from the environment for a binned aerosol distribution.
Definition: scenario.F90:386
pmc_aero_dist::aero_dist_t
A complete aerosol distribution, consisting of several modes.
Definition: aero_dist.F90:33
pmc_scenario::scenario_loss_function_drydep
integer, parameter scenario_loss_function_drydep
Type code for a loss rate function based on dry deposition.
Definition: scenario.F90:38
pmc_util
Common utility subroutines.
Definition: util.F90:9
pmc_spec_file::spec_file_unread_line
subroutine spec_file_unread_line(file)
Set the line number and file read pointer back one entry.
Definition: spec_file.F90:470
pmc_scenario::scenario_init_env_state
subroutine scenario_init_env_state(scenario, env_state, time)
Initialize the time-dependent contents of the environment. Thereafter scenario_update_env_state() sho...
Definition: scenario.F90:146
pmc_spec_file::spec_file_die_msg
subroutine spec_file_die_msg(code, file, msg)
Exit with an error message containing filename and line number.
Definition: spec_file.F90:74
pmc_aero_data::aero_data_vol2diam
real(kind=dp) elemental function aero_data_vol2diam(aero_data, v)
Convert mass-equivalent volume (m^3) to geometric diameter (m).
Definition: aero_data.F90:121
pmc_spec_file::spec_file_read_string
subroutine spec_file_read_string(file, name, var)
Read a string from a spec file that must have a given name.
Definition: spec_file.F90:624
pmc_scenario::scenario_try_single_particle_loss
subroutine scenario_try_single_particle_loss(scenario, delta_t, aero_data, aero_state, env_state, i_part, over_prob)
Test a candidate particle to see if it should be removed, and remove if necessary....
Definition: scenario.F90:1098
pmc_chamber
Definition: chamber.F90:8
pmc_gas_state::gas_state_interp_1d
subroutine gas_state_interp_1d(gas_state_list, time_list, rate_list, time, gas_state, rate)
Determine the current gas_state and rate by interpolating at the current time with the lists of gas_s...
Definition: gas_state.F90:239
pmc_mpi::pmc_mpi_pack_size_integer
integer function pmc_mpi_pack_size_integer(val)
Determines the number of bytes required to pack the given value.
Definition: mpi.F90:345
pmc_mpi::pmc_mpi_pack_integer
subroutine pmc_mpi_pack_integer(buffer, position, val)
Packs the given value into the buffer, advancing position.
Definition: mpi.F90:711
pmc_aero_data::aero_data_rad2vol
real(kind=dp) elemental function aero_data_rad2vol(aero_data, r)
Convert geometric radius (m) to mass-equivalent volume (m^3).
Definition: aero_data.F90:136
pmc_aero_data
The aero_data_t structure and associated subroutines.
Definition: aero_data.F90:9
pmc_mpi::pmc_mpi_pack_real_array
subroutine pmc_mpi_pack_real_array(buffer, position, val)
Packs the given value into the buffer, advancing position.
Definition: mpi.F90:927
pmc_bin_grid::bin_grid_t
1D grid, either logarithmic or linear.
Definition: bin_grid.F90:33
pmc_chamber::chamber_loss_rate_wall
real(kind=dp) function chamber_loss_rate_wall(chamber, vol, aero_data, env_state)
Calculate the loss rate due to wall diffusion in chamber. Based on Eq. 37a in Naumann 2003 J....
Definition: chamber.F90:91
pmc_gas_state::gas_state_molar_conc_to_ppb
subroutine gas_state_molar_conc_to_ppb(gas_state, env_state)
Convert (mol m^{-3}) to (ppb).
Definition: gas_state.F90:181
pmc_scenario::scenario_particle_loss
subroutine scenario_particle_loss(scenario, delta_t, aero_data, aero_state, env_state)
Performs stochastic particle loss for one time-step. If a particle i_part has a scenario_loss_rate() ...
Definition: scenario.F90:1013
pmc_mpi::pmc_mpi_unpack_real
subroutine pmc_mpi_unpack_real(buffer, position, val)
Unpacks the given value from the buffer, advancing position.
Definition: mpi.F90:1189
pmc_scenario::scenario_loss_function_chamber
integer, parameter scenario_loss_function_chamber
Type code for a loss rate function for chamber experiments.
Definition: scenario.F90:40
pmc_aero_dist::aero_dist_contains_aero_mode_type
elemental logical function aero_dist_contains_aero_mode_type(aero_dist, aero_mode_type)
Whether any of the modes are of the given type.
Definition: aero_dist.F90:155
pmc_mpi::pmc_mpi_unpack_real_array
subroutine pmc_mpi_unpack_real_array(buffer, position, val)
Unpacks the given value from the buffer, advancing position.
Definition: mpi.F90:1356
pmc_scenario::scenario_loss_function_invalid
integer, parameter scenario_loss_function_invalid
Type code for an undefined or invalid loss function.
Definition: scenario.F90:30
pmc_aero_state::aero_state_t
The current collection of aerosol particles.
Definition: aero_state.F90:69
pmc_aero_state::aero_state_sort
subroutine aero_state_sort(aero_state, aero_data, bin_grid, all_procs_same)
Sorts the particles if necessary.
Definition: aero_state.F90:3292
pmc_rand::pmc_random
real(kind=dp) function pmc_random()
Returns a random number between 0 and 1.
Definition: rand.F90:139
pmc_aero_state::aero_state_sample_particles
subroutine aero_state_sample_particles(aero_state_from, aero_state_to, aero_data, sample_prob, removal_action)
Generates a random sample by removing particles from aero_state_from and adding them to aero_state_to...
Definition: aero_state.F90:858
pmc_scenario::scenario_loss_rate_drydep
real(kind=dp) function scenario_loss_rate_drydep(vol, density, aero_data, env_state, scenario)
Compute and return the dry deposition rate for a given particle. All equations used here are written ...
Definition: scenario.F90:554
pmc_scenario::drydep_params_input_netcdf
subroutine drydep_params_input_netcdf(drydep_params, ncid, must_be_present)
Read dry deposition parameters from a NetCDF file.
Definition: scenario.F90:1550