PartMC  2.3.0
aero_state.F90
Go to the documentation of this file.
1 ! Copyright (C) 2005-2015 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_aero_state module.
7 
8 !> The aero_state_t structure and assocated subroutines.
10 
12  use pmc_aero_sorted
14  use pmc_bin_grid
15  use pmc_aero_data
17  use pmc_aero_dist
18  use pmc_util
19  use pmc_rand
20  use pmc_aero_binned
21  use pmc_mpi
22  use pmc_spec_file
23  use pmc_aero_info
25  use pmc_aero_weight
27 #ifdef PMC_USE_MPI
28  use mpi
29 #endif
30 
31  !> MPI tag for mixing particles between processes.
32  integer, parameter :: AERO_STATE_TAG_MIX = 4987
33  !> MPI tag for gathering between processes.
34  integer, parameter :: AERO_STATE_TAG_GATHER = 4988
35  !> MPI tag for scattering between processes.
36  integer, parameter :: AERO_STATE_TAG_SCATTER = 4989
37 
38  !> Single flat weighting scheme.
39  integer, parameter :: AERO_STATE_WEIGHT_NONE = 1
40  !> Single flat weighting scheme.
41  integer, parameter :: AERO_STATE_WEIGHT_FLAT = 2
42  !> Power-law weighting scheme.
43  integer, parameter :: AERO_STATE_WEIGHT_POWER = 3
44  !> Coupled number/mass weighting scheme.
45  integer, parameter :: AERO_STATE_WEIGHT_NUMMASS = 4
46  !> Flat weighting by source.
47  integer, parameter :: AERO_STATE_WEIGHT_FLAT_SOURCE = 5
48  !> Power-law weighting by source.
49  integer, parameter :: AERO_STATE_WEIGHT_POWER_SOURCE = 6
50  !> Coupled number/mass weighting by source.
51  integer, parameter :: AERO_STATE_WEIGHT_NUMMASS_SOURCE = 7
52 
53  !> The current collection of aerosol particles.
54  !!
55  !! The particles in \c aero_state_t are stored in a single flat
56  !! array (the \c apa data member), with a sorting into size bins and
57  !! weight groups/classes possibly stored in the \c aero_sorted data
58  !! member (if \c valid_sort is true).
59  !!
60  !! Every time we remove particles we keep track of the particle ID
61  !! and the action performed in the aero_info_array_t structure. This
62  !! is typically cleared each time we output data to disk.
64  !> Linear array of particles.
65  type(aero_particle_array_t) :: apa
66  !> Sorting of particles into size bins and weight groups/classes.
67  type(aero_sorted_t) :: aero_sorted
68  !> Whether the \c aero_sorted is a correct sorting.
69  logical :: valid_sort
70  !> Weighting functions.
71  type(aero_weight_array_t) :: awa
72  !> Ideal number of computational particles, per weight group and class.
73  real(kind=dp), pointer :: n_part_ideal(:, :)
74  !> Information on removed particles.
75  type(aero_info_array_t) :: aero_info_array
76  end type aero_state_t
77 
78 contains
79 
80 !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
81 
82  !> Allocates aerosol arrays.
83  subroutine aero_state_allocate(aero_state)
84 
85  !> Aerosol to initialize.
86  type(aero_state_t), intent(out) :: aero_state
87 
88  call aero_particle_array_allocate(aero_state%apa)
89  call aero_sorted_allocate(aero_state%aero_sorted)
90  aero_state%valid_sort = .false.
91  call aero_weight_array_allocate(aero_state%awa)
92  allocate(aero_state%n_part_ideal(0, 0))
93  call aero_info_array_allocate(aero_state%aero_info_array)
94 
95  end subroutine aero_state_allocate
96 
97 !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
98 
99  !> Deallocates a previously allocated aerosol.
100  subroutine aero_state_deallocate(aero_state)
101 
102  !> Aerosol to deallocate.
103  type(aero_state_t), intent(inout) :: aero_state
104 
105  call aero_particle_array_deallocate(aero_state%apa)
106  call aero_sorted_deallocate(aero_state%aero_sorted)
107  aero_state%valid_sort = .false.
108  call aero_weight_array_deallocate(aero_state%awa)
109  deallocate(aero_state%n_part_ideal)
110  call aero_info_array_deallocate(aero_state%aero_info_array)
111 
112  end subroutine aero_state_deallocate
113 
114 !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
115 
116  !> Resets an \c aero_state to an empty state.
117  subroutine aero_state_reset(aero_state)
118 
119  !> Aerosol to reset.
120  type(aero_state_t), intent(inout) :: aero_state
121 
122  call aero_state_deallocate(aero_state)
123  call aero_state_allocate(aero_state)
124 
125  end subroutine aero_state_reset
126 
127 !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
128 
129  !> Copies aerosol to a destination that has already had
130  !> aero_state_allocate() called on it.
131  subroutine aero_state_copy(aero_state_from, aero_state_to)
132 
133  !> Reference aerosol.
134  type(aero_state_t), intent(in) :: aero_state_from
135  !> Already allocated.
136  type(aero_state_t), intent(inout) :: aero_state_to
137 
138  call aero_particle_array_copy(aero_state_from%apa, aero_state_to%apa)
139  aero_state_to%valid_sort = .false.
140  call aero_state_copy_weight(aero_state_from, aero_state_to)
141  call copy_real_2d(aero_state_from%n_part_ideal, aero_state_to%n_part_ideal)
142  call aero_info_array_copy(aero_state_from%aero_info_array, &
143  aero_state_to%aero_info_array)
144 
145  end subroutine aero_state_copy
146 
147 !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
148 
149  !> Copies weighting information for an \c aero_state.
150  subroutine aero_state_copy_weight(aero_state_from, aero_state_to)
151 
152  !> Reference aerosol.
153  type(aero_state_t), intent(in) :: aero_state_from
154  !> Already allocated.
155  type(aero_state_t), intent(inout) :: aero_state_to
156 
157  call aero_weight_array_copy(aero_state_from%awa, aero_state_to%awa)
158 
159  end subroutine aero_state_copy_weight
160 
161 !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
162 
163  !> Sets the weighting functions for an \c aero_state.
164  subroutine aero_state_set_weight(aero_state, aero_data, weight_type, &
165  exponent)
166 
167  !> Aerosol to set the weights on.
168  type(aero_state_t), intent(inout) :: aero_state
169  !> Aerosol data.
170  type(aero_data_t), intent(in) :: aero_data
171  !> Type of weighting scheme to use.
172  integer, intent(in) :: weight_type
173  !> Exponent for power-law weighting (only used if \c weight_type
174  !> is \c AERO_STATE_WEIGHT_POWER).
175  real(kind=dp), intent(in), optional :: exponent
176 
177  aero_state%valid_sort = .false.
178  call aero_weight_array_deallocate(aero_state%awa)
179  select case(weight_type)
180  case(aero_state_weight_none)
181  call aero_weight_array_allocate(aero_state%awa)
182  case(aero_state_weight_flat)
183  call aero_weight_array_allocate_flat(aero_state%awa, 1)
184  case(aero_state_weight_power)
185  call assert_msg(656670336, present(exponent), &
186  "exponent parameter required for AERO_STATE_WEIGHT_POWER")
187  call aero_weight_array_allocate_power(aero_state%awa, 1, exponent)
188  case(aero_state_weight_nummass)
189  call aero_weight_array_allocate_nummass(aero_state%awa, 1)
190  case(aero_state_weight_flat_source)
191  call aero_weight_array_allocate_flat(aero_state%awa, aero_data%n_source)
192  case(aero_state_weight_power_source)
193  call assert_msg(102143848, present(exponent), &
194  "exponent parameter required for AERO_STATE_WEIGHT_POWER")
195  call aero_weight_array_allocate_power(aero_state%awa, &
196  aero_data%n_source, exponent)
197  case(aero_state_weight_nummass_source)
198  call aero_weight_array_allocate_nummass(aero_state%awa, &
199  aero_data%n_source)
200  case default
201  call die_msg(969076992, "unknown weight_type: " &
202  // trim(integer_to_string(weight_type)))
203  end select
204 
205  end subroutine aero_state_set_weight
206 
207 !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
208 
209  !> Set the ideal number of particles to the given value. The \c
210  !> aero_state%%awa must be already set correctly.
211  subroutine aero_state_set_n_part_ideal(aero_state, n_part)
212 
213  !> Aerosol state (with \c aero_state%%awa set).
214  type(aero_state_t), intent(inout) :: aero_state
215  !> Ideal total number of particles.
216  real(kind=dp), intent(in) :: n_part
217 
218  integer :: n_group, n_class
219 
220  n_group = aero_weight_array_n_group(aero_state%awa)
221  n_class = aero_weight_array_n_class(aero_state%awa)
222  deallocate(aero_state%n_part_ideal)
223  allocate(aero_state%n_part_ideal(n_group, n_class))
224  aero_state%n_part_ideal = n_part / real(n_group * n_class, kind=dp)
225 
226  end subroutine aero_state_set_n_part_ideal
227 
228 !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
229 
230  !> Determine the appropriate weight class for a source.
231  integer function aero_state_weight_class_for_source(aero_state, source)
232 
233  !> Aerosol state.
234  type(aero_state_t), intent(in) :: aero_state
235  !> Source to find the class for.
236  integer, intent(in) :: source
237 
238  integer :: n_class
239 
240  call assert(932390238, source >= 1)
241  n_class = aero_weight_array_n_class(aero_state%awa)
242  ! we are either using i_class = i_source or always i_class = n_class = 1
243  if (n_class > 1) then
244  call assert(765048788, source <= n_class)
246  else
248  end if
249 
251 
252 !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
253 
254  !> Returns the total number of particles in an aerosol distribution.
255  integer function aero_state_total_particles(aero_state, i_group, i_class)
256 
257  !> Aerosol state.
258  type(aero_state_t), intent(in) :: aero_state
259  !> Weight group.
260  integer, optional, intent(in) :: i_group
261  !> Weight class.
262  integer, optional, intent(in) :: i_class
263 
264  integer :: i_part
265 
266  if (present(i_group)) then
267  call assert(908743823, present(i_class))
268  if (aero_state%valid_sort) then
270  = aero_state%aero_sorted%group_class%inverse(i_group, &
271  i_class)%n_entry
272  else
273  ! FIXME: should we just sort?
275  do i_part = 1,aero_state%apa%n_part
276  if ((aero_state%apa%particle(i_part)%weight_group == i_group) &
277  .and. &
278  (aero_state%apa%particle(i_part)%weight_class == i_class)) &
279  then
281  end if
282  end do
283  end if
284  else
285  aero_state_total_particles = aero_state%apa%n_part
286  end if
287 
288  end function aero_state_total_particles
289 
290 !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
291 
292  !> Returns the total number of particles across all processes.
293  integer function aero_state_total_particles_all_procs(aero_state, i_group, &
294  i_class)
295 
296  !> Aerosol state.
297  type(aero_state_t), intent(in) :: aero_state
298  !> Weight group.
299  integer, optional, intent(in) :: i_group
300  !> Weight class.
301  integer, optional, intent(in) :: i_class
302 
304  aero_state_total_particles(aero_state, i_group, i_class), &
306 
308 
309 !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
310 
311  !> Resets an aero_state to have zero particles per bin. This must
312  !> already have had aero_state_allocate() called on it. This
313  !> function can be called more than once on the same state.
314  subroutine aero_state_zero(aero_state)
315 
316  !> State to zero.
317  type(aero_state_t), intent(inout) :: aero_state
318 
319  integer :: i, n_bin
320 
321  call aero_particle_array_zero(aero_state%apa)
322  aero_state%valid_sort = .false.
323  call aero_info_array_zero(aero_state%aero_info_array)
324 
325  end subroutine aero_state_zero
326 
327 !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
328 
329  !> Add the given particle.
330  subroutine aero_state_add_particle(aero_state, aero_particle, allow_resort)
331 
332  !> Aerosol state.
333  type(aero_state_t), intent(inout) :: aero_state
334  !> Particle to add.
335  type(aero_particle_t), intent(in) :: aero_particle
336  !> Whether to allow a resort due to the add.
337  logical, optional, intent(in) :: allow_resort
338 
339  if (aero_state%valid_sort) then
340  call aero_sorted_add_particle(aero_state%aero_sorted, aero_state%apa, &
341  aero_particle, allow_resort)
342  else
343  call aero_particle_array_add_particle(aero_state%apa, aero_particle)
344  end if
345 
346  end subroutine aero_state_add_particle
347 
348 !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
349 
350  !> Remove the given particle without recording it.
351  subroutine aero_state_remove_particle_no_info(aero_state, i_part)
352 
353  !> Aerosol state.
354  type(aero_state_t), intent(inout) :: aero_state
355  !> Index of particle to remove.
356  integer, intent(in) :: i_part
357 
358  if (aero_state%valid_sort) then
359  call aero_sorted_remove_particle(aero_state%aero_sorted, &
360  aero_state%apa, i_part)
361  else
362  call aero_particle_array_remove_particle(aero_state%apa, i_part)
363  end if
364 
366 
367 !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
368 
369  !> Remove the given particle and record the removal.
370  subroutine aero_state_remove_particle_with_info(aero_state, i_part, &
371  aero_info)
372 
373  !> Aerosol state.
374  type(aero_state_t), intent(inout) :: aero_state
375  !> Index of particle to remove.
376  integer, intent(in) :: i_part
377  !> Removal info.
378  type(aero_info_t), intent(in) :: aero_info
379 
380  call aero_state_remove_particle_no_info(aero_state, i_part)
381  call aero_info_array_add_aero_info(aero_state%aero_info_array, &
382  aero_info)
383 
385 
386 !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
387 
388  !> Remove the given particle and possibly record the removal.
389  subroutine aero_state_remove_particle(aero_state, i_part, &
390  record_removal, aero_info)
391 
392  !> Aerosol state.
393  type(aero_state_t), intent(inout) :: aero_state
394  !> Index of particle to remove.
395  integer, intent(in) :: i_part
396  !> Whether to record the removal in the aero_info_array.
397  logical, intent(in) :: record_removal
398  !> Removal info.
399  type(aero_info_t), intent(in) :: aero_info
400 
401  if (record_removal) then
402  call aero_state_remove_particle_with_info(aero_state, i_part, &
403  aero_info)
404  else
405  call aero_state_remove_particle_no_info(aero_state, i_part)
406  end if
407 
408  end subroutine aero_state_remove_particle
409 
410 !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
411 
412  !> Remove a randomly chosen particle from the given bin and return
413  !> it.
415  i_bin, i_class, aero_particle)
416 
417  !> Aerosol state.
418  type(aero_state_t), intent(inout) :: aero_state
419  !> Bin number to remove particle from.
420  integer, intent(in) :: i_bin
421  !> Weight class to remove particle from.
422  integer, intent(in) :: i_class
423  !> Removed particle.
424  type(aero_particle_t), intent(inout) :: aero_particle
425 
426  integer :: i_entry, i_part
427 
428  call assert(742996300, aero_state%valid_sort)
429  call assert(392182617, &
430  aero_state%aero_sorted%size_class%inverse(i_bin, i_class)%n_entry > 0)
431  i_entry = pmc_rand_int(aero_state%aero_sorted%size_class%inverse(i_bin, &
432  i_class)%n_entry)
433  i_part = aero_state%aero_sorted%size_class%inverse(i_bin, &
434  i_class)%entry(i_entry)
435  call aero_particle_copy(aero_state%apa%particle(i_part), aero_particle)
436  call aero_state_remove_particle_no_info(aero_state, i_part)
437 
439 
440 !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
441 
442  !> Add copies or remove a particle, with a given mean number of
443  !> resulting particles.
444  !!
445  !! The particle number \c i_part is either removed, or zero or more
446  !! copies are added, with a random number of copies with the given
447  !! mean \c n_part_mean. The final number of particles is either
448  !! <tt>floor(n_part_mean)</tt> or <tt>ceiling(n_part_mean)</tt>,
449  !! chosen randomly so the mean is \c n_part_mean.
450  subroutine aero_state_dup_particle(aero_state, i_part, n_part_mean, &
451  random_weight_group)
452 
453  !> Aerosol state.
454  type(aero_state_t), intent(inout) :: aero_state
455  !> Particle number.
456  integer, intent(in) :: i_part
457  !> Mean number of resulting particles.
458  real(kind=dp), intent(in) :: n_part_mean
459  !> Whether particle copies should be placed in a randomly chosen
460  !> weight group.
461  logical, optional, intent(in) :: random_weight_group
462 
463  integer :: n_copies, i_dup, new_group
464  type(aero_particle_t), pointer :: aero_particle
465  type(aero_particle_t) :: new_aero_particle
466  type(aero_info_t) :: aero_info
467 
468  aero_particle => aero_state%apa%particle(i_part)
469  n_copies = prob_round(n_part_mean)
470  if (n_copies == 0) then
471  call aero_info_allocate(aero_info)
472  aero_info%id = aero_particle%id
473  aero_info%action = aero_info_weight
474  aero_info%other_id = 0
475  call aero_state_remove_particle_with_info(aero_state, &
476  i_part, aero_info)
477  call aero_info_deallocate(aero_info)
478  elseif (n_copies > 1) then
479  call aero_particle_allocate(new_aero_particle)
480  do i_dup = 1,(n_copies - 1)
481  call aero_particle_copy(aero_particle, new_aero_particle)
482  call aero_particle_new_id(new_aero_particle)
483  if (present(random_weight_group)) then
484  if (random_weight_group) then
485  new_group &
486  = aero_weight_array_rand_group(aero_state%awa, &
487  aero_particle%weight_class, &
488  aero_particle_radius(aero_particle))
489  call aero_particle_set_weight(new_aero_particle, new_group)
490  end if
491  end if
492  call aero_state_add_particle(aero_state, new_aero_particle)
493  ! re-get the particle pointer, which may have
494  ! changed due to reallocations caused by adding
495  aero_particle => aero_state%apa%particle(i_part)
496  end do
497  call aero_particle_deallocate(new_aero_particle)
498  end if
499 
500  end subroutine aero_state_dup_particle
501 
502 !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
503 
504  !> The number concentration of a single particle (m^{-3}).
505  real(kind=dp) function aero_state_particle_num_conc(aero_state, &
506  aero_particle)
507 
508  !> Aerosol state containing the particle.
509  type(aero_state_t), intent(in) :: aero_state
510  !> Aerosol particle.
511  type(aero_particle_t), intent(in) :: aero_particle
512 
514  = aero_weight_array_num_conc(aero_state%awa, aero_particle)
515 
516  end function aero_state_particle_num_conc
517 
518 !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
519 
520  !> Save the correct number concentrations for later use by
521  !> aero_state_reweight().
522  subroutine aero_state_num_conc_for_reweight(aero_state, reweight_num_conc)
523 
524  !> Aerosol state.
525  type(aero_state_t), intent(in) :: aero_state
526  !> Number concentrations for later use by aero_state_reweight().
527  real(kind=dp), intent(out) :: reweight_num_conc(aero_state%apa%n_part)
528 
529  integer :: i_part
530 
531  do i_part = 1,aero_state%apa%n_part
532  reweight_num_conc(i_part) &
533  = aero_weight_array_single_num_conc(aero_state%awa, &
534  aero_state%apa%particle(i_part))
535  end do
536 
537  end subroutine aero_state_num_conc_for_reweight
538 
539 !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
540 
541  !> Reweight all particles after their constituent volumes have been
542  !> altered.
543  !!
544  !! The pattern for use should be like:
545  !! <pre>
546  !! call aero_state_num_conc_for_reweight(aero_state, reweight_num_conc)
547  !! ... alter particle species volumes in aero_state ...
548  !! call aero_state_reweight(aero_state, reweight_num_conc)
549  !! </pre>
550  subroutine aero_state_reweight(aero_state, reweight_num_conc)
551 
552  !> Aerosol state.
553  type(aero_state_t), intent(inout) :: aero_state
554  !> Number concentrations previously computed by
555  !> aero_state_num_conc_for_reweight().
556  real(kind=dp), intent(in) :: reweight_num_conc(aero_state%apa%n_part)
557 
558  integer :: i_part, i_group, i_class
559  real(kind=dp) :: n_part_old(size(aero_state%awa%weight, 1), &
560  size(aero_state%awa%weight, 2))
561  real(kind=dp) :: n_part_new(size(aero_state%awa%weight, 1), &
562  size(aero_state%awa%weight, 2))
563  real(kind=dp) :: old_num_conc, new_num_conc, n_part_mean
564  type(aero_particle_t), pointer :: aero_particle
565 
566  ! find average number of new particles in each weight group, if
567  ! weight is not changed
568  n_part_old = 0d0
569  n_part_new = 0d0
570  do i_part = 1,aero_state%apa%n_part
571  aero_particle => aero_state%apa%particle(i_part)
572  old_num_conc = reweight_num_conc(i_part)
573  new_num_conc = aero_weight_array_single_num_conc(aero_state%awa, &
574  aero_particle)
575  n_part_mean = old_num_conc / new_num_conc
576  i_group = aero_particle%weight_group
577  i_class = aero_particle%weight_class
578  n_part_new(i_group, i_class) = n_part_new(i_group, i_class) &
579  + n_part_mean
580  n_part_old(i_group, i_class) = n_part_old(i_group, i_class) + 1d0
581  end do
582 
583  ! alter weight to leave the number of computational particles
584  ! per weight bin unchanged
585  do i_group = 1,size(aero_state%awa%weight, 1)
586  do i_class = 1,size(aero_state%awa%weight, 2)
587  if (n_part_old(i_group, i_class) == 0d0) cycle
588  call aero_weight_scale(aero_state%awa%weight(i_group, i_class), &
589  n_part_new(i_group, i_class) / n_part_old(i_group, i_class))
590  end do
591  end do
592 
593  ! work backwards so any additions and removals will only affect
594  ! particles that we've already dealt with
595  do i_part = aero_state%apa%n_part,1,-1
596  aero_particle => aero_state%apa%particle(i_part)
597  old_num_conc = reweight_num_conc(i_part)
598  new_num_conc &
599  = aero_weight_array_single_num_conc(aero_state%awa, aero_particle)
600  n_part_mean = old_num_conc / new_num_conc
601  call aero_state_dup_particle(aero_state, i_part, n_part_mean)
602  end do
603 
604  end subroutine aero_state_reweight
605 
606 !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
607 
608  !> <tt>aero_state += aero_state_delta</tt>, including combining the
609  !> weights, so the new concentration is the weighted average of the
610  !> two concentrations.
611  subroutine aero_state_add(aero_state, aero_state_delta)
612 
613  !> Aerosol state.
614  type(aero_state_t), intent(inout) :: aero_state
615  !> Increment.
616  type(aero_state_t), intent(in) :: aero_state_delta
617 
618  call aero_state_add_particles(aero_state, aero_state_delta)
619  call aero_weight_array_combine(aero_state%awa, aero_state_delta%awa)
620 
621  end subroutine aero_state_add
622 
623 !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
624 
625  !> <tt>aero_state += aero_state_delta</tt>, with the weight
626  !> of \c aero_state left unchanged, so the new concentration is the
627  !> sum of the two concentrations, computed with \c aero_state%%awa.
628  subroutine aero_state_add_particles(aero_state, aero_state_delta)
629 
630  !> Aerosol state.
631  type(aero_state_t), intent(inout) :: aero_state
632  !> Increment.
633  type(aero_state_t), intent(in) :: aero_state_delta
634 
635  integer :: i_part, i_bin
636 
637  do i_part = 1,aero_state_delta%apa%n_part
638  call aero_state_add_particle(aero_state, &
639  aero_state_delta%apa%particle(i_part))
640  end do
641  call aero_info_array_add(aero_state%aero_info_array, &
642  aero_state_delta%aero_info_array)
643 
644  end subroutine aero_state_add_particles
645 
646 !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
647 
648  !> Change the weight if necessary to ensure that the addition of
649  !> about \c n_add computational particles will give the correct
650  !> final particle number.
651  subroutine aero_state_prepare_weight_for_add(aero_state, i_group, &
652  i_class, n_add, allow_doubling, allow_halving)
653 
654  !> Aero state to add to.
655  type(aero_state_t), intent(inout) :: aero_state
656  !> Weight group number to add to.
657  integer, intent(in) :: i_group
658  !> Weight class number to add to.
659  integer, intent(in) :: i_class
660  !> Approximate number of particles to be added at current weighting.
661  real(kind=dp), intent(in) :: n_add
662  !> Whether to allow doubling of the population.
663  logical, intent(in) :: allow_doubling
664  !> Whether to allow halving of the population.
665  logical, intent(in) :: allow_halving
666 
667  integer :: global_n_part, n_group, n_class
668  real(kind=dp) :: mean_n_part, n_part_new, weight_ratio
669  real(kind=dp) :: n_part_ideal_local_group
670 
671  n_group = aero_weight_array_n_group(aero_state%awa)
672  n_class = aero_weight_array_n_class(aero_state%awa)
673  global_n_part = aero_state_total_particles_all_procs(aero_state, &
674  i_group, i_class)
675  mean_n_part = real(global_n_part, kind=dp) / real(pmc_mpi_size(), kind=dp)
676  n_part_new = mean_n_part + n_add
677  if (n_part_new == 0d0) return
678  n_part_ideal_local_group = aero_state%n_part_ideal(i_group, i_class) &
679  / real(pmc_mpi_size(), kind=dp)
680  if ((n_part_new < n_part_ideal_local_group / 2d0) &
681  .or. (n_part_new > n_part_ideal_local_group * 2d0)) &
682  then
683  weight_ratio = n_part_new / n_part_ideal_local_group
684  call aero_state_scale_weight(aero_state, i_group, i_class, &
685  weight_ratio, allow_doubling, allow_halving)
686  end if
687 
688  end subroutine aero_state_prepare_weight_for_add
689 
690 !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
691 
692  !> Generates a Poisson sample of an \c aero_dist, adding to \c
693  !> aero_state, with the given sample proportion.
694  subroutine aero_state_add_aero_dist_sample(aero_state, aero_data, &
695  aero_dist, sample_prop, create_time, allow_doubling, allow_halving, &
696  n_part_add)
697 
698  !> Aero state to add to.
699  type(aero_state_t), intent(inout) :: aero_state
700  !> Aero data values.
701  type(aero_data_t), intent(in) :: aero_data
702  !> Distribution to sample.
703  type(aero_dist_t), intent(in) :: aero_dist
704  !> Fraction to sample (1).
705  real(kind=dp), intent(in) :: sample_prop
706  !> Creation time for new particles (s).
707  real(kind=dp), intent(in) :: create_time
708  !> Whether to allow doubling of the population.
709  logical, intent(in) :: allow_doubling
710  !> Whether to allow halving of the population.
711  logical, intent(in) :: allow_halving
712  !> Number of particles added.
713  integer, intent(out), optional :: n_part_add
714 
715  real(kind=dp) :: n_samp_avg, radius, total_vol
716  real(kind=dp) :: vols(aero_data%n_spec)
717  integer :: n_samp, i_mode, i_samp, i_group, i_class, n_group, n_class
718  type(aero_mode_t), pointer :: aero_mode
719  type(aero_particle_t) :: aero_particle
720 
721  call aero_particle_allocate_size(aero_particle, aero_data%n_spec, &
722  aero_data%n_source)
723 
724  n_group = size(aero_state%awa%weight, 1)
725  n_class = size(aero_state%awa%weight, 2)
726  if (present(n_part_add)) then
727  n_part_add = 0
728  end if
729  do i_group = 1,n_group
730  do i_mode = 1,aero_dist%n_mode
731  aero_mode => aero_dist%mode(i_mode)
732  i_class = aero_state_weight_class_for_source(aero_state, &
733  aero_mode%source)
734 
735  ! adjust weight if necessary
736  n_samp_avg = sample_prop * aero_mode_number(aero_mode, &
737  aero_state%awa%weight(i_group, i_class))
738  call aero_state_prepare_weight_for_add(aero_state, i_group, &
739  i_class, n_samp_avg, allow_doubling, allow_halving)
740  if (n_samp_avg == 0d0) cycle
741 
742  ! sample particles
743  n_samp_avg = sample_prop * aero_mode_number(aero_mode, &
744  aero_state%awa%weight(i_group, i_class))
745  n_samp = rand_poisson(n_samp_avg)
746  if (present(n_part_add)) then
747  n_part_add = n_part_add + n_samp
748  end if
749  do i_samp = 1,n_samp
750  call aero_particle_zero(aero_particle)
751  call aero_mode_sample_radius(aero_mode, &
752  aero_state%awa%weight(i_group, i_class), radius)
753  total_vol = rad2vol(radius)
754  call aero_mode_sample_vols(aero_mode, total_vol, vols)
755  call aero_particle_set_vols(aero_particle, vols)
756  call aero_particle_new_id(aero_particle)
757  call aero_particle_set_weight(aero_particle, i_group, i_class)
758  call aero_particle_set_create_time(aero_particle, create_time)
759  call aero_particle_set_source(aero_particle, aero_mode%source)
760  call aero_state_add_particle(aero_state, aero_particle)
761  end do
762  end do
763  end do
764  call aero_particle_deallocate(aero_particle)
765 
766  end subroutine aero_state_add_aero_dist_sample
767 
768 !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
769 
770  !> Choose a random particle from the aero_state.
771  subroutine aero_state_rand_particle(aero_state, i_part)
772 
773  !> Original state.
774  type(aero_state_t), intent(in) :: aero_state
775  !> Chosen random particle number.
776  integer, intent(out) :: i_part
777 
778  call assert(950725003, aero_state%apa%n_part > 0)
779  i_part = pmc_rand_int(aero_state%apa%n_part)
780 
781  end subroutine aero_state_rand_particle
782 
783 !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
784 
785  !> Generates a random sample by removing particles from
786  !> aero_state_from and adding them to aero_state_to, which must be
787  !> already allocated (and should have its weight set).
788  !!
789  !! None of the weights are altered by this sampling, making this the
790  !! equivalent of aero_state_add_particles().
791  subroutine aero_state_sample_particles(aero_state_from, aero_state_to, &
792  sample_prob, removal_action)
793 
794  !> Original state.
795  type(aero_state_t), intent(inout) :: aero_state_from
796  !> Destination state.
797  type(aero_state_t), intent(inout) :: aero_state_to
798  !> Probability of sampling each particle.
799  real(kind=dp), intent(in) :: sample_prob
800  !> Action for removal (see pmc_aero_info module for action
801  !> parameters). Set to AERO_INFO_NONE to not log removal.
802  integer, intent(in) :: removal_action
803 
804  integer :: n_transfer, i_transfer, i_part
805  logical :: do_add, do_remove
806  real(kind=dp) :: num_conc_from, num_conc_to
807  type(aero_info_t) :: aero_info
808 
809  call assert(721006962, (sample_prob >= 0d0) .and. (sample_prob <= 1d0))
810  call aero_state_reset(aero_state_to)
811  call aero_state_copy_weight(aero_state_from, aero_state_to)
812  n_transfer = rand_binomial(aero_state_total_particles(aero_state_from), &
813  sample_prob)
814  i_transfer = 0
815  do while (i_transfer < n_transfer)
816  if (aero_state_total_particles(aero_state_from) <= 0) exit
817  call aero_state_rand_particle(aero_state_from, i_part)
818  num_conc_from = aero_weight_array_num_conc(aero_state_from%awa, &
819  aero_state_from%apa%particle(i_part))
820  num_conc_to = aero_weight_array_num_conc(aero_state_to%awa, &
821  aero_state_from%apa%particle(i_part))
822 
823  if (num_conc_to == num_conc_from) then ! add and remove
824  do_add = .true.
825  do_remove = .true.
826  elseif (num_conc_to < num_conc_from) then ! always add, maybe remove
827  do_add = .true.
828  do_remove = .false.
829  if (pmc_random() < num_conc_to / num_conc_from) then
830  do_remove = .true.
831  end if
832  else ! always remove, maybe add
833  do_add = .false.
834  if (pmc_random() < num_conc_from / num_conc_to) then
835  do_add = .true.
836  end if
837  do_remove = .true.
838  end if
839  if (do_add) then
840  call aero_state_add_particle(aero_state_to, &
841  aero_state_from%apa%particle(i_part))
842  end if
843  if (do_remove) then
844  if (removal_action /= aero_info_none) then
845  call aero_info_allocate(aero_info)
846  aero_info%id = aero_state_from%apa%particle(i_part)%id
847  aero_info%action = removal_action
848  call aero_state_remove_particle_with_info(aero_state_from, &
849  i_part, aero_info)
850  call aero_info_deallocate(aero_info)
851  else
852  call aero_state_remove_particle_no_info(aero_state_from, &
853  i_part)
854  end if
855  i_transfer = i_transfer + 1
856  end if
857  end do
858 
859  end subroutine aero_state_sample_particles
860 
861 !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
862 
863  !> Generates a random sample by removing particles from
864  !> aero_state_from and adding them to aero_state_to, transfering
865  !> weight as well. This is the equivalent of aero_state_add().
866  subroutine aero_state_sample(aero_state_from, aero_state_to, &
867  sample_prob, removal_action)
868 
869  !> Original state.
870  type(aero_state_t), intent(inout) :: aero_state_from
871  !> Destination state (previous contents will be lost).
872  type(aero_state_t), intent(inout) :: aero_state_to
873  !> Probability of sampling each particle.
874  real(kind=dp), intent(in) :: sample_prob
875  !> Action for removal (see pmc_aero_info module for action
876  !> parameters). Set to AERO_INFO_NONE to not log removal.
877  integer, intent(in) :: removal_action
878 
879  integer :: n_transfer, i_transfer, i_part
880  logical :: do_add, do_remove, overwrite_to
881  real(kind=dp) :: num_conc_from, num_conc_to
882  type(aero_info_t) :: aero_info
883 
884  call assert(393205561, (sample_prob >= 0d0) .and. (sample_prob <= 1d0))
885  call aero_state_reset(aero_state_to)
886  call aero_state_copy_weight(aero_state_from, aero_state_to)
887  call aero_weight_array_normalize(aero_state_to%awa)
888  n_transfer = rand_binomial(aero_state_total_particles(aero_state_from), &
889  sample_prob)
890  do i_transfer = 1,n_transfer
891  if (aero_state_total_particles(aero_state_from) <= 0) exit
892  call aero_state_rand_particle(aero_state_from, i_part)
893 
894  call aero_state_add_particle(aero_state_to, &
895  aero_state_from%apa%particle(i_part))
896  if (removal_action /= aero_info_none) then
897  call aero_info_allocate(aero_info)
898  aero_info%id = aero_state_from%apa%particle(i_part)%id
899  aero_info%action = removal_action
900  call aero_state_remove_particle_with_info(aero_state_from, &
901  i_part, aero_info)
902  call aero_info_deallocate(aero_info)
903  else
904  call aero_state_remove_particle_no_info(aero_state_from, &
905  i_part)
906  end if
907  end do
908  overwrite_to = .true.
909  call aero_weight_array_shift(aero_state_from%awa, aero_state_to%awa, &
910  sample_prob, overwrite_to)
911 
912  end subroutine aero_state_sample
913 
914 !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
915 
916  !> Create binned number and mass arrays.
917  subroutine aero_state_to_binned(bin_grid, aero_data, aero_state, &
918  aero_binned)
919 
920  !> Bin grid.
921  type(bin_grid_t), intent(in) :: bin_grid
922  !> Aerosol data.
923  type(aero_data_t), intent(in) :: aero_data
924  !> Aerosol state.
925  type(aero_state_t), intent(in) :: aero_state
926  !> Binned distributions.
927  type(aero_binned_t), intent(inout) :: aero_binned
928 
929  integer :: i_part, i_bin
930  type(aero_particle_t), pointer :: aero_particle
931 
932  aero_binned%num_conc = 0d0
933  aero_binned%vol_conc = 0d0
934  do i_part = 1,aero_state%apa%n_part
935  aero_particle => aero_state%apa%particle(i_part)
936  i_bin = bin_grid_find(bin_grid, aero_particle_radius(aero_particle))
937  if ((i_bin < 1) .or. (i_bin > bin_grid%n_bin)) then
938  call warn_msg(980232449, "particle ID " &
939  // trim(integer_to_string(aero_particle%id)) &
940  // " outside of bin_grid, discarding")
941  else
942  aero_binned%vol_conc(i_bin,:) = aero_binned%vol_conc(i_bin,:) &
943  + aero_particle%vol &
944  * aero_weight_array_num_conc(aero_state%awa, aero_particle) &
945  / bin_grid%widths(i_bin)
946  aero_binned%num_conc(i_bin) = aero_binned%num_conc(i_bin) &
947  + aero_weight_array_num_conc(aero_state%awa, aero_particle) &
948  / bin_grid%widths(i_bin)
949  end if
950  end do
951 
952  end subroutine aero_state_to_binned
953 
954 !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
955 
956  !> Returns the IDs of all particles.
957  function aero_state_ids(aero_state)
958 
959  !> Aerosol state.
960  type(aero_state_t), intent(in) :: aero_state
961 
962  !> Return value.
963  integer :: aero_state_ids(aero_state%apa%n_part)
964 
965  integer :: i_part
966 
967  do i_part = 1,aero_state%apa%n_part
968  aero_state_ids(i_part) = aero_state%apa%particle(i_part)%id
969  end do
970 
971  end function aero_state_ids
972 
973 !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
974 
975  !> Returns the diameters of all particles.
976  function aero_state_diameters(aero_state)
977 
978  !> Aerosol state.
979  type(aero_state_t), intent(in) :: aero_state
980 
981  !> Return diameters array (m).
982  real(kind=dp) :: aero_state_diameters(aero_state%apa%n_part)
983 
985  aero_state%apa%particle(1:aero_state%apa%n_part))
986 
987  end function aero_state_diameters
988 
989 !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
990 
991  !> Returns the dry diameters of all particles.
992  function aero_state_dry_diameters(aero_state, aero_data)
993 
994  !> Aerosol state.
995  type(aero_state_t), intent(in) :: aero_state
996  !> Aerosol data.
997  type(aero_data_t), intent(in) :: aero_data
998 
999  !> Return value (m).
1000  real(kind=dp) :: aero_state_dry_diameters(aero_state%apa%n_part)
1001 
1003  aero_state%apa%particle(1:aero_state%apa%n_part), aero_data)
1004 
1005  end function aero_state_dry_diameters
1006 
1007 !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
1008 
1009  !> Returns the masses of all particles.
1010  !!
1011  !! If \c include is specified then only those species are included
1012  !! in computing the masses. If \c exclude is specified then all
1013  !! species except those species are included. If both \c include and
1014  !! \c exclude arguments are specified then only those species in \c
1015  !! include but not in \c exclude are included.
1016  function aero_state_masses(aero_state, aero_data, include, exclude)
1017 
1018  !> Aerosol state.
1019  type(aero_state_t), intent(in) :: aero_state
1020  !> Aerosol data.
1021  type(aero_data_t), intent(in) :: aero_data
1022  !> Species names to include in the mass.
1023  character(len=*), optional :: include(:)
1024  !> Species names to exclude in the mass.
1025  character(len=*), optional :: exclude(:)
1026 
1027  !> Return masses array (kg).
1028  real(kind=dp) :: aero_state_masses(aero_state%apa%n_part)
1029 
1030  logical :: use_species(aero_data%n_spec)
1031  integer :: i_name, i_spec
1032 
1033  if ((.not. present(include)) .and. (.not. present(exclude))) then
1035  aero_state%apa%particle(1:aero_state%apa%n_part), aero_data)
1036  else
1037  if (present(include)) then
1038  use_species = .false.
1039  do i_name = 1, size(include)
1040  i_spec = aero_data_spec_by_name(aero_data, include(i_name))
1041  call assert_msg(963163690, i_spec > 0, &
1042  "unknown species: " // trim(include(i_name)))
1043  use_species(i_spec) = .true.
1044  end do
1045  else
1046  use_species = .true.
1047  end if
1048  if (present(exclude)) then
1049  do i_name = 1, size(exclude)
1050  i_spec = aero_data_spec_by_name(aero_data, exclude(i_name))
1051  call assert_msg(950847713, i_spec > 0, &
1052  "unknown species: " // trim(exclude(i_name)))
1053  use_species(i_spec) = .false.
1054  end do
1055  end if
1056  aero_state_masses = 0d0
1057  do i_spec = 1,aero_data%n_spec
1058  if (use_species(i_spec)) then
1061  aero_state%apa%particle(1:aero_state%apa%n_part), &
1062  i_spec, aero_data)
1063  end if
1064  end do
1065  end if
1066 
1067  end function aero_state_masses
1068 
1069 !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
1070 
1071  !> Returns the number concentrations of all particles.
1072  function aero_state_num_concs(aero_state)
1073 
1074  !> Aerosol state.
1075  type(aero_state_t), intent(in) :: aero_state
1076 
1077  !> Return number concentrations array (m^{-3}).
1078  real(kind=dp) :: aero_state_num_concs(aero_state%apa%n_part)
1079 
1080  integer :: i_part
1081 
1082  do i_part = 1,aero_state%apa%n_part
1083  aero_state_num_concs(i_part) &
1084  = aero_state_particle_num_conc(aero_state, &
1085  aero_state%apa%particle(i_part))
1086  end do
1087 
1088  end function aero_state_num_concs
1089 
1090 !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
1091 
1092  !> Returns the total number concentration.
1093  real(kind=dp) function aero_state_total_num_conc(aero_state)
1094 
1095  !> Aerosol state.
1096  type(aero_state_t), intent(in) :: aero_state
1097 
1098  integer :: i_part
1099 
1101  do i_part = 1,aero_state%apa%n_part
1103  + aero_state_particle_num_conc(aero_state, &
1104  aero_state%apa%particle(i_part))
1105  end do
1106 
1107  end function aero_state_total_num_conc
1108 
1109 !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
1110 
1111  !> Returns the mass-entropies of all particles.
1112  !!
1113  !! If \c include is specified then only those species are included
1114  !! in computing the entropy. If \c exclude is specified then all
1115  !! species except those species are included. If both \c include and
1116  !! \c exclude arguments are specified then only those species in \c
1117  !! include but not in \c exclude are included. If \c group is
1118  !! specified then the species are divided into two sets, given by
1119  !! those in the group and those not in the group. The entropy is
1120  !! then computed using the total mass of each set.
1121  function aero_state_mass_entropies(aero_state, aero_data, include, exclude, &
1122  group)
1123 
1124  !> Aerosol state.
1125  type(aero_state_t), intent(in) :: aero_state
1126  !> Aerosol data.
1127  type(aero_data_t), intent(in) :: aero_data
1128  !> Species names to include in the mass.
1129  character(len=*), optional :: include(:)
1130  !> Species names to exclude in the mass.
1131  character(len=*), optional :: exclude(:)
1132  !> Species names to group together.
1133  character(len=*), optional :: group(:)
1134 
1135  !> Return value.
1136  real(kind=dp) :: aero_state_mass_entropies(aero_state%apa%n_part)
1137 
1138  logical :: use_species(aero_data%n_spec), group_species(aero_data%n_spec)
1139  integer :: i_name, i_spec, i_part
1140  real(kind=dp) :: group_mass, non_group_mass, mass
1141 
1142  if (present(include)) then
1143  use_species = .false.
1144  do i_name = 1, size(include)
1145  i_spec = aero_data_spec_by_name(aero_data, include(i_name))
1146  call assert_msg(890212002, i_spec > 0, &
1147  "unknown species: " // trim(include(i_name)))
1148  use_species(i_spec) = .true.
1149  end do
1150  else
1151  use_species = .true.
1152  end if
1153  if (present(exclude)) then
1154  do i_name = 1, size(exclude)
1155  i_spec = aero_data_spec_by_name(aero_data, exclude(i_name))
1156  call assert_msg(859945006, i_spec > 0, &
1157  "unknown species: " // trim(exclude(i_name)))
1158  use_species(i_spec) = .false.
1159  end do
1160  end if
1161  if (present(group)) then
1162  group_species = .false.
1163  do i_name = 1, size(group)
1164  i_spec = aero_data_spec_by_name(aero_data, group(i_name))
1165  call assert_msg(376359046, i_spec > 0, &
1166  "unknown species: " // trim(group(i_name)))
1167  group_species(i_spec) = .true.
1168  end do
1169  do i_part = 1,aero_state%apa%n_part
1170  group_mass = 0d0
1171  non_group_mass = 0d0
1172  do i_spec = 1,aero_data%n_spec
1173  if (use_species(i_spec)) then
1174  mass = aero_particle_species_mass( &
1175  aero_state%apa%particle(i_part), i_spec, aero_data)
1176  if (group_species(i_spec)) then
1177  group_mass = group_mass + mass
1178  else
1179  non_group_mass = non_group_mass + mass
1180  end if
1181  end if
1182  end do
1183  aero_state_mass_entropies(i_part) &
1184  = entropy([group_mass, non_group_mass])
1185  end do
1186  else
1187  do i_part = 1,aero_state%apa%n_part
1188  aero_state_mass_entropies(i_part) = entropy(pack( &
1189  aero_particle_species_masses(aero_state%apa%particle(i_part), &
1190  aero_data), use_species))
1191  end do
1192  end if
1193 
1194  end function aero_state_mass_entropies
1195 
1196 !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
1197 
1198  !> Returns the approximate critical relative humidity for all particles (1).
1199  function aero_state_approx_crit_rel_humids(aero_state, aero_data, env_state)
1200 
1201  !> Aerosol state.
1202  type(aero_state_t), intent(in) :: aero_state
1203  !> Aerosol data.
1204  type(aero_data_t), intent(in) :: aero_data
1205  !> Environment state.
1206  type(env_state_t), intent(in) :: env_state
1207 
1208  !> Return value.
1209  real(kind=dp) :: aero_state_approx_crit_rel_humids(aero_state%apa%n_part)
1210 
1211  integer :: i_part
1212 
1213  do i_part = 1,aero_state%apa%n_part
1216  aero_state%apa%particle(i_part), aero_data, env_state)
1217  end do
1218 
1220 
1221 !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
1222 
1223  !> Returns the critical relative humidity for all particles (1).
1224  function aero_state_crit_rel_humids(aero_state, aero_data, env_state)
1225 
1226  !> Aerosol state.
1227  type(aero_state_t), intent(in) :: aero_state
1228  !> Aerosol data.
1229  type(aero_data_t), intent(in) :: aero_data
1230  !> Environment state.
1231  type(env_state_t), intent(in) :: env_state
1232 
1233  !> Return value.
1234  real(kind=dp) :: aero_state_crit_rel_humids(aero_state%apa%n_part)
1235 
1236  integer :: i_part
1237 
1238  do i_part = 1,aero_state%apa%n_part
1240  aero_state%apa%particle(i_part), aero_data, env_state)
1241  end do
1242 
1243  end function aero_state_crit_rel_humids
1244 
1245 !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
1246 
1247  !> Does the same thing as aero_state_to_bin() but based on dry radius.
1248  subroutine aero_state_to_binned_dry(bin_grid, aero_data, aero_state, &
1249  aero_binned)
1250 
1251  !> Bin grid.
1252  type(bin_grid_t), intent(in) :: bin_grid
1253  !> Aerosol data.
1254  type(aero_data_t), intent(in) :: aero_data
1255  !> Aerosol state.
1256  type(aero_state_t), intent(in) :: aero_state
1257  !> Binned distributions.
1258  type(aero_binned_t), intent(inout) :: aero_binned
1259 
1260  integer :: i_part, i_bin
1261  type(aero_particle_t), pointer :: aero_particle
1262 
1263  aero_binned%num_conc = 0d0
1264  aero_binned%vol_conc = 0d0
1265  do i_part = 1,aero_state%apa%n_part
1266  aero_particle => aero_state%apa%particle(i_part)
1267  i_bin = bin_grid_find(bin_grid, &
1268  aero_particle_solute_radius(aero_particle, aero_data))
1269  if ((i_bin < 1) .or. (i_bin > bin_grid%n_bin)) then
1270  call warn_msg(503871022, "particle ID " &
1271  // trim(integer_to_string(aero_particle%id)) &
1272  // " outside of bin_grid, discarding")
1273  else
1274  aero_binned%vol_conc(i_bin,:) = aero_binned%vol_conc(i_bin,:) &
1275  + aero_particle%vol &
1276  * aero_weight_array_num_conc(aero_state%awa, aero_particle) &
1277  / bin_grid%widths(i_bin)
1278  aero_binned%num_conc(i_bin) = aero_binned%num_conc(i_bin) &
1279  + aero_weight_array_num_conc(aero_state%awa, aero_particle) &
1280  / bin_grid%widths(i_bin)
1281  end if
1282  end do
1283 
1284  end subroutine aero_state_to_binned_dry
1285 
1286 !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
1287 
1288  !> Doubles number of particles in the given weight group.
1289  subroutine aero_state_double(aero_state, i_group, i_class)
1290 
1291  !> Aerosol state.
1292  type(aero_state_t), intent(inout) :: aero_state
1293  !> Weight group to double.
1294  integer, intent(in) :: i_group
1295  !> Weight class to double.
1296  integer, intent(in) :: i_class
1297 
1298  integer :: i_part
1299  type(aero_particle_t) :: aero_particle
1300 
1301  call aero_particle_allocate(aero_particle)
1302  do i_part = 1,aero_state%apa%n_part
1303  if ((aero_state%apa%particle(i_part)%weight_group == i_group) &
1304  .and. (aero_state%apa%particle(i_part)%weight_class == i_class)) &
1305  then
1306  call aero_particle_copy(aero_state%apa%particle(i_part), &
1307  aero_particle)
1308  call aero_particle_new_id(aero_particle)
1309  call aero_state_add_particle(aero_state, aero_particle)
1310  end if
1311  end do
1312  call aero_particle_deallocate(aero_particle)
1313  aero_state%valid_sort = .false.
1314  call aero_weight_scale(aero_state%awa%weight(i_group, i_class), 0.5d0)
1315 
1316  end subroutine aero_state_double
1317 
1318 !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
1319 
1320  !> Remove approximately half of the particles in the given weight group.
1321  subroutine aero_state_halve(aero_state, i_group, i_class)
1322 
1323  !> Aerosol state.
1324  type(aero_state_t), intent(inout) :: aero_state
1325  !> Weight group to halve.
1326  integer, intent(in) :: i_group
1327  !> Weight class to halve.
1328  integer, intent(in) :: i_class
1329 
1330  integer :: i_part
1331  type(aero_info_t) :: aero_info
1332 
1333  call aero_info_allocate(aero_info)
1334  do i_part = aero_state%apa%n_part,1,-1
1335  if ((aero_state%apa%particle(i_part)%weight_group == i_group) &
1336  .and. (aero_state%apa%particle(i_part)%weight_class == i_class)) &
1337  then
1338  if (pmc_random() < 0.5d0) then
1339  aero_info%id = aero_state%apa%particle(i_part)%id
1340  aero_info%action = aero_info_halved
1341  call aero_state_remove_particle_with_info(aero_state, i_part, &
1342  aero_info)
1343  end if
1344  end if
1345  end do
1346  call aero_info_deallocate(aero_info)
1347  call aero_weight_scale(aero_state%awa%weight(i_group, i_class), 2d0)
1348 
1349  end subroutine aero_state_halve
1350 
1351 !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
1352 
1353  !> Double or halve the particle population in each weight group to
1354  !> maintain close to \c n_part_ideal particles per process,
1355  !> allocated equally amongst the weight groups.
1356  subroutine aero_state_rebalance(aero_state, allow_doubling, allow_halving, &
1357  initial_state_warning)
1358 
1359  !> Aerosol state.
1360  type(aero_state_t), intent(inout) :: aero_state
1361  !> Whether to allow doubling of the population.
1362  logical, intent(in) :: allow_doubling
1363  !> Whether to allow halving of the population.
1364  logical, intent(in) :: allow_halving
1365  !> Whether to warn due to initial state doubling/halving.
1366  logical, intent(in) :: initial_state_warning
1367 
1368  integer :: i_group, i_class, n_group, n_class, global_n_part
1369 
1370  n_group = size(aero_state%awa%weight, 1)
1371  n_class = size(aero_state%awa%weight, 2)
1372 
1373  ! if we have less than half the maximum number of particles then
1374  ! double until we fill up the array
1375  if (allow_doubling) then
1376  do i_group = 1,n_group
1377  do i_class = 1,n_class
1378  global_n_part &
1379  = aero_state_total_particles_all_procs(aero_state, i_group, &
1380  i_class)
1381  do while ((real(global_n_part, kind=dp) &
1382  < aero_state%n_part_ideal(i_group, i_class) / 2d0) &
1383  .and. (global_n_part > 0))
1384  if (initial_state_warning) then
1385  call warn_msg(716882783, "doubling particles in initial " &
1386  // "condition")
1387  end if
1388  call aero_state_double(aero_state, i_group, i_class)
1389  global_n_part &
1390  = aero_state_total_particles_all_procs(aero_state, &
1391  i_group, i_class)
1392  end do
1393  end do
1394  end do
1395  end if
1396 
1397  ! same for halving if we have too many particles
1398  if (allow_halving) then
1399  do i_group = 1,n_group
1400  do i_class = 1,n_class
1401  do while (real(aero_state_total_particles_all_procs(aero_state, & i_group, i_class), kind=dp) &
1402  > aero_state%n_part_ideal(i_group, i_class) * 2d0)
1403  if (initial_state_warning) then
1404  call warn_msg(661936373, &
1405  "halving particles in initial condition")
1406  end if
1407  call aero_state_halve(aero_state, i_group, i_class)
1408  end do
1409  end do
1410  end do
1411  end if
1412 
1413  end subroutine aero_state_rebalance
1414 
1415 !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
1416 
1417  !> Scale the weighting of the given group/class by the given ratio,
1418  !> altering particle number as necessary to preserve the number
1419  !> concentration.
1420  subroutine aero_state_scale_weight(aero_state, i_group, i_class, &
1421  weight_ratio, allow_doubling, allow_halving)
1422 
1423  !> Aerosol state.
1424  type(aero_state_t), intent(inout) :: aero_state
1425  !> Weight group number.
1426  integer, intent(in) :: i_group
1427  !> Weight class number.
1428  integer, intent(in) :: i_class
1429  !> Ratio of <tt>new_weight / old_weight</tt>.
1430  real(kind=dp), intent(in) :: weight_ratio
1431  !> Whether to allow doubling of the population.
1432  logical, intent(in) :: allow_doubling
1433  !> Whether to allow halving of the population.
1434  logical, intent(in) :: allow_halving
1435 
1436  real(kind=dp) :: ratio
1437  integer :: i_part, i_remove, n_remove, i_entry, n_part
1438  type(aero_info_t) :: aero_info
1439 
1440  ! We could use the ratio < 1 case unconditionally, but that would
1441  ! have higher variance for the ratio > 1 case than the current
1442  ! scheme.
1443 
1444  call aero_state_sort(aero_state)
1445  n_part = aero_state%aero_sorted%group_class%inverse(i_group, &
1446  i_class)%n_entry
1447 
1448  if ((weight_ratio > 1d0) .and. (allow_halving .or. (n_part == 0))) then
1449  call aero_weight_scale(aero_state%awa%weight(i_group, i_class), &
1450  weight_ratio)
1451  n_remove = prob_round(real(n_part, kind=dp) &
1452  * (1d0 - 1d0 / weight_ratio))
1453  do i_remove = 1,n_remove
1454  i_entry = pmc_rand_int(aero_state%aero_sorted%group_class%inverse( &
1455  i_group, i_class)%n_entry)
1456  i_part = aero_state%aero_sorted%group_class%inverse(i_group, &
1457  i_class)%entry(i_entry)
1458  call aero_info_allocate(aero_info)
1459  aero_info%id = aero_state%apa%particle(i_part)%id
1460  aero_info%action = aero_info_halved
1461  call aero_state_remove_particle(aero_state, i_part, .true., &
1462  aero_info)
1463  call aero_info_deallocate(aero_info)
1464  end do
1465  elseif ((weight_ratio < 1d0) &
1466  .and. (allow_doubling .or. (n_part == 0))) then
1467  call aero_weight_scale(aero_state%awa%weight(i_group, i_class), &
1468  weight_ratio)
1469  do i_entry = n_part,1,-1
1470  i_part = aero_state%aero_sorted%group_class%inverse(i_group, &
1471  i_class)%entry(i_entry)
1472  call aero_state_dup_particle(aero_state, i_part, 1d0 / weight_ratio)
1473  end do
1474  end if
1475 
1476  end subroutine aero_state_scale_weight
1477 
1478 !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
1479 
1480  !> Mix the aero_states between all processes. Currently uses a
1481  !> simple all-to-all diffusion.
1482  subroutine aero_state_mix(aero_state, del_t, mix_timescale, &
1483  aero_data, specify_prob_transfer)
1484 
1485  !> Aerosol state.
1486  type(aero_state_t), intent(inout) :: aero_state
1487  !> Timestep (s).
1488  real(kind=dp), intent(in) :: del_t
1489  !> Mixing timescale (s).
1490  real(kind=dp), intent(in) :: mix_timescale
1491  !> Aero data values.
1492  type(aero_data_t), intent(in) :: aero_data
1493  !> Transfer probability of each particle (0 means no mixing, 1
1494  !> means total mixing).
1495  real(kind=dp), optional, intent(in) :: specify_prob_transfer
1496 
1497 #ifdef PMC_USE_MPI
1498  integer :: rank, n_proc, i_proc, ierr
1499  integer :: buffer_size, buffer_size_check
1500  character, allocatable :: buffer(:)
1501  type(aero_state_t), allocatable :: aero_state_sends(:)
1502  type(aero_state_t), allocatable :: aero_state_recvs(:)
1503  real(kind=dp) :: prob_transfer, prob_not_transferred
1504  real(kind=dp) :: prob_transfer_given_not_transferred
1505 
1506  ! process information
1507  rank = pmc_mpi_rank()
1508  n_proc = pmc_mpi_size()
1509  if (n_proc == 1) then
1510  ! buffer allocation below fails if n_proc == 1
1511  ! so bail out early (nothing to mix anyway)
1512  return
1513  end if
1514 
1515  ! allocate aero_state arrays
1516  allocate(aero_state_sends(n_proc))
1517  allocate(aero_state_recvs(n_proc))
1518  do i_proc = 0,(n_proc - 1)
1519  call aero_state_allocate(aero_state_sends(i_proc + 1))
1520  call aero_state_allocate(aero_state_recvs(i_proc + 1))
1521  end do
1522 
1523  ! compute the transfer probability
1524  if (present(specify_prob_transfer)) then
1525  prob_transfer = specify_prob_transfer / real(n_proc, kind=dp)
1526  else
1527  prob_transfer = (1d0 - exp(- del_t / mix_timescale)) &
1528  / real(n_proc, kind=dp)
1529  end if
1530 
1531  ! extract particles to send
1532  prob_not_transferred = 1d0
1533  do i_proc = 0,(n_proc - 1)
1534  if (i_proc /= rank) then
1535  ! because we are doing sequential sampling from the aero_state
1536  ! we need to scale up the later transfer probabilities, because
1537  ! the later particles are being transferred conditioned on the
1538  ! fact that they did not transfer already
1539  prob_transfer_given_not_transferred = prob_transfer &
1540  / prob_not_transferred
1541  call aero_state_sample(aero_state, &
1542  aero_state_sends(i_proc + 1), &
1543  prob_transfer_given_not_transferred, aero_info_none)
1544  prob_not_transferred = prob_not_transferred - prob_transfer
1545  end if
1546  end do
1547 
1548  ! exchange the particles
1549  call aero_state_mpi_alltoall(aero_state_sends, aero_state_recvs)
1550 
1551  ! process the received particles
1552  do i_proc = 0,(n_proc - 1)
1553  if (i_proc /= rank) then
1554  call aero_state_add(aero_state, aero_state_recvs(i_proc + 1))
1555  end if
1556  end do
1557 
1558  ! cleanup
1559  do i_proc = 0,(n_proc - 1)
1560  call aero_state_deallocate(aero_state_sends(i_proc + 1))
1561  call aero_state_deallocate(aero_state_recvs(i_proc + 1))
1562  end do
1563  deallocate(aero_state_sends)
1564  deallocate(aero_state_recvs)
1565 #endif
1566 
1567  end subroutine aero_state_mix
1568 
1569 !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
1570 
1571  !> Do an MPI all-to-all transfer of aerosol states.
1572  !!
1573  !! States without particles are not sent.
1574  subroutine aero_state_mpi_alltoall(send, recv)
1576  !> Array of aero_states to send (one per process).
1577  type(aero_state_t), intent(in) :: send(:)
1578  !> Array of aero_states to receives (one per process).
1579  type(aero_state_t), intent(inout) :: recv(size(send))
1580 
1581 #ifdef PMC_USE_MPI
1582  character, allocatable :: sendbuf(:), recvbuf(:)
1583  integer :: sendcounts(size(send)), sdispls(size(send))
1584  integer :: recvcounts(size(send)), rdispls(size(send))
1585  integer :: i_proc, position, old_position, max_sendbuf_size, ierr
1586 
1587  call assert(978709842, size(send) == pmc_mpi_size())
1588 
1589  max_sendbuf_size = 0
1590  do i_proc = 1,pmc_mpi_size()
1591  if (aero_state_total_particles(send(i_proc)) > 0) then
1592  max_sendbuf_size = max_sendbuf_size &
1593  + pmc_mpi_pack_size_aero_state(send(i_proc))
1594  end if
1595  end do
1596 
1597  allocate(sendbuf(max_sendbuf_size))
1598 
1599  position = 0
1600  do i_proc = 1,pmc_mpi_size()
1601  old_position = position
1602  if (aero_state_total_particles(send(i_proc)) > 0) then
1603  call pmc_mpi_pack_aero_state(sendbuf, position, send(i_proc))
1604  end if
1605  sendcounts(i_proc) = position - old_position
1606  end do
1607  call assert(393267406, position <= max_sendbuf_size)
1608 
1609  call pmc_mpi_alltoall_integer(sendcounts, recvcounts)
1610  allocate(recvbuf(sum(recvcounts)))
1611 
1612  sdispls(1) = 0
1613  rdispls(1) = 0
1614  do i_proc = 2,pmc_mpi_size()
1615  sdispls(i_proc) = sdispls(i_proc - 1) + sendcounts(i_proc - 1)
1616  rdispls(i_proc) = rdispls(i_proc - 1) + recvcounts(i_proc - 1)
1617  end do
1618 
1619  call mpi_alltoallv(sendbuf, sendcounts, sdispls, mpi_character, recvbuf, &
1620  recvcounts, rdispls, mpi_character, mpi_comm_world, ierr)
1621  call pmc_mpi_check_ierr(ierr)
1622 
1623  position = 0
1624  do i_proc = 1,pmc_mpi_size()
1625  call assert(189739257, position == rdispls(i_proc))
1626  if (recvcounts(i_proc) > 0) then
1627  call pmc_mpi_unpack_aero_state(recvbuf, position, recv(i_proc))
1628  end if
1629  end do
1630 
1631  deallocate(sendbuf)
1632  deallocate(recvbuf)
1633 #endif
1634 
1635  end subroutine aero_state_mpi_alltoall
1636 
1637 !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
1638 
1639  !> Set each aerosol particle to have its original total volume, but
1640  !> species volume ratios given by the total species volume ratio
1641  !> within each bin. This preserves the (weighted) total species
1642  !> volume per bin as well as per-particle total volumes.
1643  subroutine aero_state_bin_average_comp(aero_state, bin_grid, aero_data)
1645  !> Aerosol state to average.
1646  type(aero_state_t), intent(inout) :: aero_state
1647  !> Bin grid to average within.
1648  type(bin_grid_t), intent(in) :: bin_grid
1649  !> Aerosol data.
1650  type(aero_data_t), intent(in) :: aero_data
1651 
1652  real(kind=dp) :: species_volume_conc(aero_data%n_spec)
1653  real(kind=dp) :: total_volume_conc, particle_volume, num_conc
1654  integer :: i_bin, i_class, i_entry, i_part, i_spec
1655  type(aero_particle_t), pointer :: aero_particle
1656 
1657  call aero_state_sort(aero_state, bin_grid)
1658 
1659  do i_bin = 1,bin_grid%n_bin
1660  species_volume_conc = 0d0
1661  total_volume_conc = 0d0
1662  do i_class = 1,size(aero_state%awa%weight, 2)
1663  do i_entry = 1,aero_state%aero_sorted%size_class%inverse(i_bin, &
1664  i_class)%n_entry
1665  i_part = aero_state%aero_sorted%size_class%inverse(i_bin, &
1666  i_class)%entry(i_entry)
1667  aero_particle => aero_state%apa%particle(i_part)
1668  num_conc = aero_weight_array_num_conc(aero_state%awa, &
1669  aero_particle)
1670  particle_volume = aero_particle_volume(aero_particle)
1671  species_volume_conc = species_volume_conc &
1672  + num_conc * aero_particle%vol
1673  total_volume_conc = total_volume_conc + num_conc * particle_volume
1674  end do
1675  end do
1676  do i_class = 1,size(aero_state%awa%weight, 2)
1677  do i_entry = 1,aero_state%aero_sorted%size_class%inverse(i_bin, &
1678  i_class)%n_entry
1679  i_part = aero_state%aero_sorted%size_class%inverse(i_bin, &
1680  i_class)%entry(i_entry)
1681  aero_particle => aero_state%apa%particle(i_part)
1682  particle_volume = aero_particle_volume(aero_particle)
1683  aero_particle%vol = particle_volume * species_volume_conc &
1684  / total_volume_conc
1685  end do
1686  end do
1687  end do
1688 
1689  end subroutine aero_state_bin_average_comp
1690 
1691 !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
1692 
1693  !> Set each aerosol particle to have its original species ratios,
1694  !> but total volume given by the average volume of all particles
1695  !> within each bin.
1696  !!
1697  !! This does not preserve the total species volume
1698  !! per bin. If the \c bin_center parameter is \c .true. then the
1699  !! particles in each bin are set to have the bin center volume,
1700  !! rather than the average volume of the particles in that bin.
1701  !!
1702  !! If the weighting function is not constant (AERO_WEIGHT_TYPE_NONE)
1703  !! then the averaging can be performed in either a number-preserving
1704  !! way or in a volume-preserving way. The volume-preserving way does
1705  !! not preserve species volume ratios in gernal, but will do so if
1706  !! the particle population has already been composition-averaged.
1707  subroutine aero_state_bin_average_size(aero_state, bin_grid, aero_data, &
1708  bin_center, preserve_number)
1709 
1710  !> Aerosol state to average.
1711  type(aero_state_t), intent(inout) :: aero_state
1712  !> Bin grid to average within.
1713  type(bin_grid_t), intent(in) :: bin_grid
1714  !> Aerosol data.
1715  type(aero_data_t), intent(in) :: aero_data
1716  !> Whether to assign the bin center volume (rather than the average
1717  !> volume).
1718  logical, intent(in) :: bin_center
1719  !> Whether to use the number-preserving scheme (otherwise will use
1720  !> the volume-preserving scheme). This parameter has no effect if
1721  !> \c bin_center is \c .true.
1722  logical, intent(in) :: preserve_number
1723 
1724  real(kind=dp) :: total_volume_conc, particle_volume
1725  real(kind=dp) :: new_particle_volume, num_conc, total_num_conc
1726  real(kind=dp) :: lower_volume, upper_volume, center_volume
1727  real(kind=dp) :: lower_function, upper_function, center_function
1728  integer :: i_bin, i_class, i_entry, i_part, i_bisect, n_part
1729  logical :: monotone_increasing, monotone_decreasing
1730  type(aero_particle_t), pointer :: aero_particle
1731 
1732  call aero_state_sort(aero_state, bin_grid)
1733 
1734  do i_bin = 1,bin_grid%n_bin
1735  do i_class = 1,size(aero_state%awa%weight, 2)
1736  if (aero_state%aero_sorted%size_class%inverse(i_bin, &
1737  i_class)%n_entry == 0) then
1738  cycle
1739  end if
1740 
1741  n_part = aero_state%aero_sorted%size_class%inverse(i_bin, &
1742  i_class)%n_entry
1743  total_num_conc = 0d0
1744  total_volume_conc = 0d0
1745  do i_entry = 1,aero_state%aero_sorted%size_class%inverse(i_bin, &
1746  i_class)%n_entry
1747  i_part = aero_state%aero_sorted%size_class%inverse(i_bin, &
1748  i_class)%entry(i_entry)
1749  aero_particle => aero_state%apa%particle(i_part)
1750  num_conc = aero_weight_array_num_conc(aero_state%awa, &
1751  aero_particle)
1752  total_num_conc = total_num_conc + num_conc
1753  particle_volume = aero_particle_volume(aero_particle)
1754  total_volume_conc = total_volume_conc &
1755  + num_conc * particle_volume
1756  end do
1757 
1758  ! determine the new_particle_volume for all particles in this bin
1759  if (bin_center) then
1760  new_particle_volume = rad2vol(bin_grid%centers(i_bin))
1761  elseif (aero_weight_array_check_flat(aero_state%awa)) then
1762  num_conc & ! any radius will have the same num_conc
1763  = aero_weight_array_num_conc_at_radius(aero_state%awa, &
1764  i_class, 1d0)
1765  new_particle_volume = total_volume_conc / num_conc &
1766  / real(aero_state%aero_sorted%size_class%inverse(i_bin, &
1767  i_class)%n_entry, kind=dp)
1768  elseif (preserve_number) then
1769  ! number-preserving scheme: Solve the implicit equation:
1770  ! n_part * W(new_vol) = total_num_conc
1771  !
1772  ! We assume that the weighting function is strictly monotone
1773  ! so this equation has a unique solution and the solution
1774  ! lies between the min and max particle volumes. We use
1775  ! bisection as this doesn't really need to be fast, just
1776  ! robust.
1777 
1778  call aero_weight_array_check_monotonicity(aero_state%awa, &
1779  monotone_increasing, monotone_decreasing)
1780  call assert_msg(214077200, &
1781  monotone_increasing .or. monotone_decreasing, &
1782  "monotone weight function required for averaging")
1783 
1784  ! initialize to min and max particle volumes
1785  do i_entry = 1,n_part
1786  i_part = aero_state%aero_sorted%size_class%inverse(i_bin, &
1787  i_class)%entry(i_entry)
1788  aero_particle => aero_state%apa%particle(i_part)
1789  particle_volume = aero_particle_volume(aero_particle)
1790  if (i_part == 1) then
1791  lower_volume = particle_volume
1792  upper_volume = particle_volume
1793  end if
1794  lower_volume = min(lower_volume, particle_volume)
1795  upper_volume = max(upper_volume, particle_volume)
1796  end do
1797 
1798  lower_function = real(n_part, kind=dp) &
1799  * aero_weight_array_num_conc_at_radius(aero_state%awa, &
1800  i_class, vol2rad(lower_volume)) - total_num_conc
1801  upper_function = real(n_part, kind=dp) &
1802  * aero_weight_array_num_conc_at_radius(aero_state%awa, &
1803  i_class, vol2rad(upper_volume)) - total_num_conc
1804 
1805  ! do 50 rounds of bisection (2^50 = 10^15)
1806  do i_bisect = 1,50
1807  center_volume = (lower_volume + upper_volume) / 2d0
1808  center_function = real(n_part, kind=dp) &
1809  * aero_weight_array_num_conc_at_radius(aero_state%awa, &
1810  i_class, vol2rad(center_volume)) - total_num_conc
1811  if ((lower_function > 0d0 .and. center_function > 0d0) &
1812  .or. (lower_function < 0d0 .and. center_function < 0d0)) &
1813  then
1814  lower_volume = center_volume
1815  lower_function = center_function
1816  else
1817  upper_volume = center_volume
1818  upper_function = center_function
1819  end if
1820  end do
1821 
1822  new_particle_volume = center_volume
1823  else
1824  ! volume-preserving scheme: Solve the implicit equation:
1825  ! n_part * W(new_vol) * new_vol = total_volume_conc
1826  !
1827  ! We assume that the weighting function is strictly monotone
1828  ! so this equation has a unique solution and the solution
1829  ! lies between the min and max particle volumes. We use
1830  ! bisection as this doesn't really need to be fast, just
1831  ! robust.
1832 
1833  call aero_weight_array_check_monotonicity(aero_state%awa, &
1834  monotone_increasing, monotone_decreasing)
1835  call assert_msg(483078128, &
1836  monotone_increasing .or. monotone_decreasing, &
1837  "monotone weight function required for averaging")
1838 
1839  ! initialize to min and max particle volumes
1840  do i_entry = 1,n_part
1841  i_part = aero_state%aero_sorted%size_class%inverse(i_bin, &
1842  i_class)%entry(i_entry)
1843  aero_particle => aero_state%apa%particle(i_part)
1844  particle_volume = aero_particle_volume(aero_particle)
1845  if (i_part == 1) then
1846  lower_volume = particle_volume
1847  upper_volume = particle_volume
1848  end if
1849  lower_volume = min(lower_volume, particle_volume)
1850  upper_volume = max(upper_volume, particle_volume)
1851  end do
1852 
1853  lower_function = real(n_part, kind=dp) &
1855  aero_state%awa, i_class, vol2rad(lower_volume)) &
1856  * lower_volume - total_volume_conc
1857  upper_function = real(n_part, kind=dp) &
1859  aero_state%awa, i_class, vol2rad(upper_volume)) &
1860  * upper_volume - total_volume_conc
1861 
1862  ! do 50 rounds of bisection (2^50 = 10^15)
1863  do i_bisect = 1,50
1864  center_volume = (lower_volume + upper_volume) / 2d0
1865  center_function = real(n_part, kind=dp) &
1867  aero_state%awa, i_class, vol2rad(center_volume)) &
1868  * center_volume - total_volume_conc
1869  if ((lower_function > 0d0 .and. center_function > 0d0) &
1870  .or. (lower_function < 0d0 .and. center_function < 0d0)) &
1871  then
1872  lower_volume = center_volume
1873  lower_function = center_function
1874  else
1875  upper_volume = center_volume
1876  upper_function = center_function
1877  end if
1878  end do
1879 
1880  new_particle_volume = center_volume
1881  end if
1882 
1883  do i_entry = 1,n_part
1884  i_part = aero_state%aero_sorted%size_class%inverse(i_bin, &
1885  i_class)%entry(i_entry)
1886  aero_particle => aero_state%apa%particle(i_part)
1887  particle_volume = aero_particle_volume(aero_particle)
1888  aero_particle%vol = aero_particle%vol / particle_volume &
1889  * new_particle_volume
1890  end do
1891  end do
1892  end do
1893 
1894  end subroutine aero_state_bin_average_size
1895 
1896 !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
1897 
1898  !> Make all particles dry (water set to zero).
1899  subroutine aero_state_make_dry(aero_state, aero_data)
1901  !> Aerosol state to make dry.
1902  type(aero_state_t), intent(inout) :: aero_state
1903  !> Aerosol data.
1904  type(aero_data_t), intent(in) :: aero_data
1905 
1906  integer :: i_part
1907  real(kind=dp) :: reweight_num_conc(aero_state%apa%n_part)
1908 
1909  ! We're modifying particle diameters, so bin sorting is now invalid
1910  aero_state%valid_sort = .false.
1911 
1912  call aero_state_num_conc_for_reweight(aero_state, reweight_num_conc)
1913  if (aero_data%i_water > 0) then
1914  do i_part = 1,aero_state%apa%n_part
1915  aero_state%apa%particle(i_part)%vol(aero_data%i_water) = 0d0
1916  end do
1917  aero_state%valid_sort = .false.
1918  end if
1919  ! adjust particles to account for weight changes
1920  call aero_state_reweight(aero_state, reweight_num_conc)
1921 
1922  end subroutine aero_state_make_dry
1923 
1924 !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
1925 
1926  !> Determines the number of bytes required to pack the given value.
1927  integer function pmc_mpi_pack_size_aero_state(val)
1929  !> Value to pack.
1930  type(aero_state_t), intent(in) :: val
1931 
1932  integer :: total_size, i_group
1933 
1934  total_size = 0
1935  total_size = total_size + pmc_mpi_pack_size_apa(val%apa)
1936  total_size = total_size + pmc_mpi_pack_size_aero_weight_array(val%awa)
1937  total_size = total_size + pmc_mpi_pack_size_real_array_2d(val%n_part_ideal)
1938  total_size = total_size + pmc_mpi_pack_size_aia(val%aero_info_array)
1939  pmc_mpi_pack_size_aero_state = total_size
1940 
1941  end function pmc_mpi_pack_size_aero_state
1942 
1943 !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
1944 
1945  !> Packs the given value into the buffer, advancing position.
1946  subroutine pmc_mpi_pack_aero_state(buffer, position, val)
1948  !> Memory buffer.
1949  character, intent(inout) :: buffer(:)
1950  !> Current buffer position.
1951  integer, intent(inout) :: position
1952  !> Value to pack.
1953  type(aero_state_t), intent(in) :: val
1954 
1955 #ifdef PMC_USE_MPI
1956  integer :: prev_position, i_group
1957 
1958  prev_position = position
1959  call pmc_mpi_pack_aero_particle_array(buffer, position, val%apa)
1960  call pmc_mpi_pack_aero_weight_array(buffer,position,val%awa)
1961  call pmc_mpi_pack_real_array_2d(buffer, position, val%n_part_ideal)
1962  call pmc_mpi_pack_aero_info_array(buffer, position, val%aero_info_array)
1963  call assert(850997402, &
1964  position - prev_position <= pmc_mpi_pack_size_aero_state(val))
1965 #endif
1966 
1967  end subroutine pmc_mpi_pack_aero_state
1968 
1969 !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
1970 
1971  !> Unpacks the given value from the buffer, advancing position.
1972  subroutine pmc_mpi_unpack_aero_state(buffer, position, val)
1974  !> Memory buffer.
1975  character, intent(inout) :: buffer(:)
1976  !> Current buffer position.
1977  integer, intent(inout) :: position
1978  !> Value to pack.
1979  type(aero_state_t), intent(inout) :: val
1980 
1981 #ifdef PMC_USE_MPI
1982  integer :: prev_position, i_group, n_group
1983 
1984  val%valid_sort = .false.
1985  prev_position = position
1986  call pmc_mpi_unpack_aero_particle_array(buffer, position, val%apa)
1987  call pmc_mpi_unpack_aero_weight_array(buffer,position,val%awa)
1988  call pmc_mpi_unpack_real_array_2d(buffer, position, val%n_part_ideal)
1989  call pmc_mpi_unpack_aero_info_array(buffer, position, val%aero_info_array)
1990  call assert(132104747, &
1991  position - prev_position <= pmc_mpi_pack_size_aero_state(val))
1992 #endif
1993 
1994  end subroutine pmc_mpi_unpack_aero_state
1995 
1996 !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
1997 
1998  !> Gathers data from all processes into one aero_state on process 0.
1999  subroutine aero_state_mpi_gather(aero_state, aero_state_total)
2001  !> Local aero_state.
2002  type(aero_state_t), intent(in) :: aero_state
2003  !> Centralized aero_state (only on process 0).
2004  type(aero_state_t), intent(inout) :: aero_state_total
2005 
2006 #ifdef PMC_USE_MPI
2007  type(aero_state_t) :: aero_state_transfer
2008  integer :: n_proc, ierr, status(mpi_status_size)
2009  integer :: buffer_size, max_buffer_size, i_proc, position
2010  character, allocatable :: buffer(:)
2011 #endif
2012 
2013  if (pmc_mpi_rank() == 0) then
2014  call aero_state_copy(aero_state, aero_state_total)
2015  end if
2016 
2017 #ifdef PMC_USE_MPI
2018 
2019  if (pmc_mpi_rank() /= 0) then
2020  ! send data from remote processes
2021  max_buffer_size = 0
2022  max_buffer_size = max_buffer_size &
2023  + pmc_mpi_pack_size_aero_state(aero_state)
2024  allocate(buffer(max_buffer_size))
2025  position = 0
2026  call pmc_mpi_pack_aero_state(buffer, position, aero_state)
2027  call assert(542772170, position <= max_buffer_size)
2028  buffer_size = position
2029  call mpi_send(buffer, buffer_size, mpi_character, 0, &
2030  aero_state_tag_gather, mpi_comm_world, ierr)
2031  call pmc_mpi_check_ierr(ierr)
2032  deallocate(buffer)
2033  else
2034  ! root process receives data from each remote proc
2035  n_proc = pmc_mpi_size()
2036  do i_proc = 1,(n_proc - 1)
2037  ! determine buffer size at root process
2038  call mpi_probe(i_proc, aero_state_tag_gather, mpi_comm_world, &
2039  status, ierr)
2040  call pmc_mpi_check_ierr(ierr)
2041  call mpi_get_count(status, mpi_character, buffer_size, ierr)
2042  call pmc_mpi_check_ierr(ierr)
2043 
2044  ! get buffer at root process
2045  allocate(buffer(buffer_size))
2046  call mpi_recv(buffer, buffer_size, mpi_character, i_proc, &
2047  aero_state_tag_gather, mpi_comm_world, status, ierr)
2048 
2049  ! unpack it
2050  position = 0
2051  call aero_state_allocate(aero_state_transfer)
2052  call pmc_mpi_unpack_aero_state(buffer, position, &
2053  aero_state_transfer)
2054  call assert(518174881, position == buffer_size)
2055  deallocate(buffer)
2056 
2057  call aero_state_add(aero_state_total, aero_state_transfer)
2058 
2059  call aero_state_deallocate(aero_state_transfer)
2060  end do
2061  end if
2062 
2063 #endif
2064 
2065  end subroutine aero_state_mpi_gather
2066 
2067 !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
2068 
2069  !> Write the aero particle dimension to the given NetCDF file if it
2070  !> is not already present and in any case return the associated
2071  !> dimid.
2072  subroutine aero_state_netcdf_dim_aero_particle(aero_state, ncid, &
2073  dimid_aero_particle)
2074 
2075  !> aero_state structure.
2076  type(aero_state_t), intent(in) :: aero_state
2077  !> NetCDF file ID, in data mode.
2078  integer, intent(in) :: ncid
2079  !> Dimid of the aero particle dimension.
2080  integer, intent(out) :: dimid_aero_particle
2081 
2082  integer :: status, i_part
2083  integer :: varid_aero_particle
2084  integer :: aero_particle_centers(aero_state%apa%n_part)
2085 
2086  ! try to get the dimension ID
2087  status = nf90_inq_dimid(ncid, "aero_particle", dimid_aero_particle)
2088  if (status == nf90_noerr) return
2089  if (status /= nf90_ebaddim) call pmc_nc_check(status)
2090 
2091  ! dimension not defined, so define now define it
2092  call pmc_nc_check(nf90_redef(ncid))
2093 
2094  call pmc_nc_check(nf90_def_dim(ncid, "aero_particle", &
2095  aero_state%apa%n_part, dimid_aero_particle))
2096 
2097  call pmc_nc_check(nf90_enddef(ncid))
2098 
2099  do i_part = 1,aero_state%apa%n_part
2100  aero_particle_centers(i_part) = i_part
2101  end do
2102  call pmc_nc_write_integer_1d(ncid, aero_particle_centers, &
2103  "aero_particle", (/ dimid_aero_particle /), &
2104  description="dummy dimension variable (no useful value)")
2105 
2107 
2108 !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
2109 
2110  !> Write the aero removed dimension to the given NetCDF file if it
2111  !> is not already present and in any case return the associated
2112  !> dimid.
2113  subroutine aero_state_netcdf_dim_aero_removed(aero_state, ncid, &
2114  dimid_aero_removed)
2115 
2116  !> aero_state structure.
2117  type(aero_state_t), intent(in) :: aero_state
2118  !> NetCDF file ID, in data mode.
2119  integer, intent(in) :: ncid
2120  !> Dimid of the aero removed dimension.
2121  integer, intent(out) :: dimid_aero_removed
2122 
2123  integer :: status, i_remove, dim_size
2124  integer :: varid_aero_removed
2125  integer :: aero_removed_centers(max(aero_state%aero_info_array%n_item,1))
2126 
2127  ! try to get the dimension ID
2128  status = nf90_inq_dimid(ncid, "aero_removed", dimid_aero_removed)
2129  if (status == nf90_noerr) return
2130  if (status /= nf90_ebaddim) call pmc_nc_check(status)
2131 
2132  ! dimension not defined, so define now define it
2133  call pmc_nc_check(nf90_redef(ncid))
2134 
2135  dim_size = max(aero_state%aero_info_array%n_item, 1)
2136  call pmc_nc_check(nf90_def_dim(ncid, "aero_removed", &
2137  dim_size, dimid_aero_removed))
2138 
2139  call pmc_nc_check(nf90_enddef(ncid))
2140 
2141  do i_remove = 1,dim_size
2142  aero_removed_centers(i_remove) = i_remove
2143  end do
2144  call pmc_nc_write_integer_1d(ncid, aero_removed_centers, &
2145  "aero_removed", (/ dimid_aero_removed /), &
2146  description="dummy dimension variable (no useful value)")
2147 
2148  end subroutine aero_state_netcdf_dim_aero_removed
2149 
2150 !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
2151 
2152  !> Write full state.
2153  subroutine aero_state_output_netcdf(aero_state, ncid, aero_data, &
2154  record_removals, record_optical)
2155 
2156  !> aero_state to write.
2157  type(aero_state_t), intent(in) :: aero_state
2158  !> NetCDF file ID, in data mode.
2159  integer, intent(in) :: ncid
2160  !> aero_data structure.
2161  type(aero_data_t), intent(in) :: aero_data
2162  !> Whether to output particle removal info.
2163  logical, intent(in) :: record_removals
2164  !> Whether to output aerosol optical properties.
2165  logical, intent(in) :: record_optical
2166 
2167  integer :: dimid_aero_particle, dimid_aero_species, dimid_aero_source
2168  integer :: dimid_aero_removed
2169  integer :: i_part, i_remove
2170  type(aero_particle_t), pointer :: particle
2171  real(kind=dp) :: aero_particle_mass(aero_state%apa%n_part, &
2172  aero_data%n_spec)
2173  integer :: aero_n_orig_part(aero_state%apa%n_part, aero_data%n_source)
2174  integer :: aero_particle_weight_group(aero_state%apa%n_part)
2175  integer :: aero_particle_weight_class(aero_state%apa%n_part)
2176  real(kind=dp) :: aero_absorb_cross_sect(aero_state%apa%n_part)
2177  real(kind=dp) :: aero_scatter_cross_sect(aero_state%apa%n_part)
2178  real(kind=dp) :: aero_asymmetry(aero_state%apa%n_part)
2179  real(kind=dp) :: aero_refract_shell_real(aero_state%apa%n_part)
2180  real(kind=dp) :: aero_refract_shell_imag(aero_state%apa%n_part)
2181  real(kind=dp) :: aero_refract_core_real(aero_state%apa%n_part)
2182  real(kind=dp) :: aero_refract_core_imag(aero_state%apa%n_part)
2183  real(kind=dp) :: aero_core_vol(aero_state%apa%n_part)
2184  integer :: aero_water_hyst_leg(aero_state%apa%n_part)
2185  real(kind=dp) :: aero_num_conc(aero_state%apa%n_part)
2186  integer :: aero_id(aero_state%apa%n_part)
2187  real(kind=dp) :: aero_least_create_time(aero_state%apa%n_part)
2188  real(kind=dp) :: aero_greatest_create_time(aero_state%apa%n_part)
2189  integer :: aero_removed_id(max(aero_state%aero_info_array%n_item,1))
2190  integer :: aero_removed_action(max(aero_state%aero_info_array%n_item,1))
2191  integer :: aero_removed_other_id(max(aero_state%aero_info_array%n_item,1))
2192 
2193  !> \page output_format_aero_state Output File Format: Aerosol Particle State
2194  !!
2195  !! The aerosol state consists of a set of individual aerosol
2196  !! particles, each with its own individual properties. The
2197  !! properties of all particles are stored in arrays, one per
2198  !! property. For example, <tt>aero_absorb_cross_sect(i)</tt> gives
2199  !! the absorption cross section of particle number \c i, while
2200  !! <tt>aero_particle_mass(i,s)</tt> gives the mass of species \c s
2201  !! in particle \c i. The aerosol species are described in \ref
2202  !! output_format_aero_data.
2203  !!
2204  !! Each aerosol particle \c i represents a number concentration
2205  !! given by <tt>aero_num_conc(i)</tt>. Multiplying a per-particle
2206  !! quantity by the respective number concentration gives the
2207  !! concentration of that quantity contributed by the particle. For
2208  !! example, summing <tt>aero_particle_mass(i,s) *
2209  !! aero_num_conc(i)</tt> over all \c i gives the total mass
2210  !! concentration of species \c s in kg/m^3. Similarly, summing
2211  !! <tt>aero_absorb_cross_sect(i) * aero_num_conc(i)</tt> over all
2212  !! \c i will give the concentration of scattering cross section in
2213  !! m^2/m^3.
2214  !!
2215  !! FIXME: the aero_weight is also output
2216  !!
2217  !! The aerosol state uses the \c aero_species NetCDF dimension as
2218  !! specified in the \ref output_format_aero_data section, as well
2219  !! as the NetCDF dimension:
2220  !! - \b aero_particle: number of aerosol particles
2221  !!
2222  !! The aerosol state NetCDF variables are:
2223  !! - \b aero_particle (dim \c aero_particle): dummy dimension variable
2224  !! (no useful value)
2225  !! - \b aero_particle_mass (unit kg,
2226  !! dim <tt>aero_particle x aero_species</tt>): constituent masses of
2227  !! each aerosol particle - <tt>aero_particle_mass(i,s)</tt> gives the
2228  !! mass of species \c s in particle \c i
2229  !! - \b aero_n_orig_part (dim <tt>aero_particle x
2230  !! aero_source</tt>): number of original particles from each
2231  !! source that formed each aerosol particle -
2232  !! <tt>aero_n_orig_part(i,s)</tt> is the number of particles
2233  !! from source \c s that contributed to particle \c i - when
2234  !! particle \c i first enters the simulation (by emissions,
2235  !! dilution, etc.) it has <tt>aero_n_orig_part(i,s) = 1</tt>
2236  !! for the source number \c s it came from (otherwise zero)
2237  !! and when two particles coagulate, their values of \c
2238  !! aero_n_orig_part are added (the number of coagulation
2239  !! events that formed each particle is thus
2240  !! <tt>sum(aero_n_orig_part(i,:)) - 1</tt>)
2241  !! - \b aero_particle_weight_group (dim <tt>aero_particle</tt>):
2242  !! weight group number (1 to <tt>aero_weight_group</tt>) of
2243  !! each aerosol particle
2244  !! - \b aero_particle_weight_class (dim <tt>aero_particle</tt>):
2245  !! weight class number (1 to <tt>aero_weight_class</tt>) of each
2246  !! aerosol particle
2247  !! - \b aero_absorb_cross_sect (unit m^2, dim \c aero_particle):
2248  !! optical absorption cross sections of each aerosol particle
2249  !! - \b aero_scatter_cross_sect (unit m^2, dim \c aero_particle):
2250  !! optical scattering cross sections of each aerosol particle
2251  !! - \b aero_asymmetry (dimensionless, dim \c aero_particle): optical
2252  !! asymmetry parameters of each aerosol particle
2253  !! - \b aero_refract_shell_real (dimensionless, dim \c aero_particle):
2254  !! real part of the refractive indices of the shell of each
2255  !! aerosol particle
2256  !! - \b aero_refract_shell_imag (dimensionless, dim \c aero_particle):
2257  !! imaginary part of the refractive indices of the shell of each
2258  !! aerosol particle
2259  !! - \b aero_refract_core_real (dimensionless, dim \c aero_particle):
2260  !! real part of the refractive indices of the core of each
2261  !! aerosol particle
2262  !! - \b aero_refract_core_imag (dimensionless, dim \c aero_particle):
2263  !! imaginary part of the refractive indices of the core of each
2264  !! aerosol particle
2265  !! - \b aero_core_vol (unit m^3, dim \c aero_particle): volume of the
2266  !! optical cores of each aerosol particle
2267  !! - \b aero_water_hyst_leg (dim \c aero_particle): integers
2268  !! specifying which leg of the water hysteresis curve each
2269  !! particle is on, using the MOSAIC numbering convention
2270  !! - \b aero_num_conc (unit m^{-3}, dim \c aero_particle): number
2271  !! concentration associated with each particle
2272  !! - \b aero_id (dim \c aero_particle): unique ID number of each
2273  !! aerosol particle
2274  !! - \b aero_least_create_time (unit s, dim \c aero_particle): least
2275  !! (earliest) creation time of any original constituent particles
2276  !! that coagulated to form each particle, measured from the start
2277  !! of the simulation - a particle is said to be created when it
2278  !! first enters the simulation (by emissions, dilution, etc.)
2279  !! - \b aero_greatest_create_time (unit s, dim \c
2280  !! aero_particle): greatest (latest) creation time of any
2281  !! original constituent particles that coagulated to form each
2282  !! particle, measured from the start of the simulation - a
2283  !! particle is said to be created when it first enters the
2284  !! simulation (by emissions, dilution, etc.)
2285 
2286  call aero_weight_array_output_netcdf(aero_state%awa, ncid)
2287 
2288  call aero_data_netcdf_dim_aero_species(aero_data, ncid, &
2289  dimid_aero_species)
2290  call aero_data_netcdf_dim_aero_source(aero_data, ncid, &
2291  dimid_aero_source)
2292 
2293  if (aero_state%apa%n_part > 0) then
2294  call aero_state_netcdf_dim_aero_particle(aero_state, ncid, &
2295  dimid_aero_particle)
2296 
2297  ! FIXME: replace this loop with statements like
2298  ! aero_n_orig_part = aero_state%apa%particle%n_orig_part
2299  do i_part = 1,aero_state%apa%n_part
2300  particle => aero_state%apa%particle(i_part)
2301  aero_particle_mass(i_part, :) = particle%vol * aero_data%density
2302  aero_n_orig_part(i_part, :) = particle%n_orig_part
2303  aero_particle_weight_group(i_part) = particle%weight_group
2304  aero_particle_weight_class(i_part) = particle%weight_class
2305  aero_water_hyst_leg(i_part) = particle%water_hyst_leg
2306  aero_num_conc(i_part) &
2307  = aero_state_particle_num_conc(aero_state, particle)
2308  aero_id(i_part) = particle%id
2309  aero_least_create_time(i_part) = particle%least_create_time
2310  aero_greatest_create_time(i_part) = particle%greatest_create_time
2311  if (record_optical) then
2312  aero_absorb_cross_sect(i_part) = particle%absorb_cross_sect
2313  aero_scatter_cross_sect(i_part) = particle%scatter_cross_sect
2314  aero_asymmetry(i_part) = particle%asymmetry
2315  aero_refract_shell_real(i_part) = real(particle%refract_shell)
2316  aero_refract_shell_imag(i_part) = aimag(particle%refract_shell)
2317  aero_refract_core_real(i_part) = real(particle%refract_core)
2318  aero_refract_core_imag(i_part) = aimag(particle%refract_core)
2319  aero_core_vol(i_part) = particle%core_vol
2320  end if
2321  end do
2323  "aero_particle_mass", (/ dimid_aero_particle, &
2324  dimid_aero_species /), unit="kg", &
2325  long_name="constituent masses of each aerosol particle")
2326  call pmc_nc_write_integer_2d(ncid, aero_n_orig_part, &
2327  "aero_n_orig_part", (/ dimid_aero_particle, &
2328  dimid_aero_source /), &
2329  long_name="number of original constituent particles from " &
2330  // "each source that coagulated to form each aerosol particle")
2331  call pmc_nc_write_integer_1d(ncid, aero_particle_weight_group, &
2332  "aero_particle_weight_group", (/ dimid_aero_particle /), &
2333  long_name="weight group number of each aerosol particle")
2334  call pmc_nc_write_integer_1d(ncid, aero_particle_weight_class, &
2335  "aero_particle_weight_class", (/ dimid_aero_particle /), &
2336  long_name="weight class number of each aerosol particle")
2337  call pmc_nc_write_integer_1d(ncid, aero_water_hyst_leg, &
2338  "aero_water_hyst_leg", (/ dimid_aero_particle /), &
2339  long_name="leg of the water hysteresis curve leg of each "&
2340  // "aerosol particle")
2341  call pmc_nc_write_real_1d(ncid, aero_num_conc, &
2342  "aero_num_conc", (/ dimid_aero_particle /), unit="m^{-3}", &
2343  long_name="number concentration for each particle")
2344  call pmc_nc_write_integer_1d(ncid, aero_id, &
2345  "aero_id", (/ dimid_aero_particle /), &
2346  long_name="unique ID number of each aerosol particle")
2347  call pmc_nc_write_real_1d(ncid, aero_least_create_time, &
2348  "aero_least_create_time", (/ dimid_aero_particle /), unit="s", &
2349  long_name="least creation time of each aerosol particle", &
2350  description="least (earliest) creation time of any original " &
2351  // "constituent particles that coagulated to form each " &
2352  // "particle, measured from the start of the simulation")
2353  call pmc_nc_write_real_1d(ncid, aero_greatest_create_time, &
2354  "aero_greatest_create_time", (/ dimid_aero_particle /), &
2355  unit="s", &
2356  long_name="greatest creation time of each aerosol particle", &
2357  description="greatest (latest) creation time of any original " &
2358  // "constituent particles that coagulated to form each " &
2359  // "particle, measured from the start of the simulation")
2360  if (record_optical) then
2361  call pmc_nc_write_real_1d(ncid, aero_absorb_cross_sect, &
2362  "aero_absorb_cross_sect", (/ dimid_aero_particle /), &
2363  unit="m^2", &
2364  long_name="optical absorption cross sections of each " &
2365  // "aerosol particle")
2366  call pmc_nc_write_real_1d(ncid, aero_scatter_cross_sect, &
2367  "aero_scatter_cross_sect", (/ dimid_aero_particle /), &
2368  unit="m^2", &
2369  long_name="optical scattering cross sections of each " &
2370  // "aerosol particle")
2371  call pmc_nc_write_real_1d(ncid, aero_asymmetry, &
2372  "aero_asymmetry", (/ dimid_aero_particle /), unit="1", &
2373  long_name="optical asymmetry parameters of each " &
2374  // "aerosol particle")
2375  call pmc_nc_write_real_1d(ncid, aero_refract_shell_real, &
2376  "aero_refract_shell_real", (/ dimid_aero_particle /), &
2377  unit="1", &
2378  long_name="real part of the refractive indices of the " &
2379  // "shell of each aerosol particle")
2380  call pmc_nc_write_real_1d(ncid, aero_refract_shell_imag, &
2381  "aero_refract_shell_imag", (/ dimid_aero_particle /), &
2382  unit="1", &
2383  long_name="imaginary part of the refractive indices of " &
2384  // "the shell of each aerosol particle")
2385  call pmc_nc_write_real_1d(ncid, aero_refract_core_real, &
2386  "aero_refract_core_real", (/ dimid_aero_particle /), &
2387  unit="1", &
2388  long_name="real part of the refractive indices of the core " &
2389  // "of each aerosol particle")
2390  call pmc_nc_write_real_1d(ncid, aero_refract_core_imag, &
2391  "aero_refract_core_imag", (/ dimid_aero_particle /), &
2392  unit="1", &
2393  long_name="imaginary part of the refractive indices of " &
2394  // "the core of each aerosol particle")
2395  call pmc_nc_write_real_1d(ncid, aero_core_vol, &
2396  "aero_core_vol", (/ dimid_aero_particle /), unit="m^3", &
2397  long_name="volume of the optical cores of each " &
2398  // "aerosol particle")
2399  end if
2400  end if
2401 
2402  ! FIXME: move this to aero_info_array.F90, together with
2403  ! aero_state_netcdf_dim_aero_removed() ?
2404  if (record_removals) then
2405  call aero_state_netcdf_dim_aero_removed(aero_state, ncid, &
2406  dimid_aero_removed)
2407  if (aero_state%aero_info_array%n_item >= 1) then
2408  do i_remove = 1,aero_state%aero_info_array%n_item
2409  aero_removed_id(i_remove) = &
2410  aero_state%aero_info_array%aero_info(i_remove)%id
2411  aero_removed_action(i_remove) = &
2412  aero_state%aero_info_array%aero_info(i_remove)%action
2413  aero_removed_other_id(i_remove) = &
2414  aero_state%aero_info_array%aero_info(i_remove)%other_id
2415  end do
2416  else
2417  aero_removed_id(1) = 0
2418  aero_removed_action(1) = aero_info_none
2419  aero_removed_other_id(1) = 0
2420  end if
2421  call pmc_nc_write_integer_1d(ncid, aero_removed_id, &
2422  "aero_removed_id", (/ dimid_aero_removed /), &
2423  long_name="ID of removed particles")
2424  call pmc_nc_write_integer_1d(ncid, aero_removed_action, &
2425  "aero_removed_action", (/ dimid_aero_removed /), &
2426  long_name="reason for particle removal", &
2427  description="valid is 0 (invalid entry), 1 (removed due to " &
2428  // "dilution), 2 (removed due to coagulation -- combined " &
2429  // "particle ID is in \c aero_removed_other_id), 3 (removed " &
2430  // "due to populating halving), or 4 (removed due to " &
2431  // "weighting changes")
2432  call pmc_nc_write_integer_1d(ncid, aero_removed_other_id, &
2433  "aero_removed_other_id", (/ dimid_aero_removed /), &
2434  long_name="ID of other particle involved in removal", &
2435  description="if <tt>aero_removed_action(i)</tt> is 2 " &
2436  // "(due to coagulation), then " &
2437  // "<tt>aero_removed_other_id(i)</tt> is the ID of the " &
2438  // "resulting combined particle, or 0 if the new particle " &
2439  // "was not created")
2440  end if
2441 
2442  end subroutine aero_state_output_netcdf
2443 
2444  ! this belongs in the subroutine above, but is outside because
2445  ! Doxygen 1.8.7 doesn't resolve references when multiple \page
2446  ! blocks are in one subroutine
2447 
2448  !> \page output_format_aero_removed Output File Format: Aerosol Particle Removal Information
2449  !!
2450  !! When an aerosol particle is introduced into the simulation it
2451  !! is assigned a unique ID number. This ID number will persist
2452  !! over time, allowing tracking of a paticular particle's
2453  !! evolution. If the \c record_removals variable in the input spec
2454  !! file is \c yes, then the every time a particle is removed from
2455  !! the simulation its removal will be recorded in the removal
2456  !! information.
2457  !!
2458  !! The removal information written at timestep \c n contains
2459  !! information about every particle ID that is present at time
2460  !! <tt>(n - 1)</tt> but not present at time \c n.
2461  !!
2462  !! The removal information is always written in the output files,
2463  !! even if no particles were removed in the previous
2464  !! timestep. Unfortunately, NetCDF files cannot contain arrays of
2465  !! length 0. In the case of no particles being removed, the \c
2466  !! aero_removed dimension will be set to 1 and
2467  !! <tt>aero_removed_action(1)</tt> will be 0 (\c AERO_INFO_NONE).
2468  !!
2469  !! When two particles coagulate, the ID number of the combined
2470  !! particle will be the ID particle of the largest constituent, if
2471  !! possible (weighting functions can make this impossible to
2472  !! achieve). A given particle ID may thus be lost due to
2473  !! coagulation (if the resulting combined particle has a different
2474  !! ID), or the ID may be preserved (as the ID of the combined
2475  !! particle). Only if the ID is lost will the particle be recorded
2476  !! in the removal information, and in this case
2477  !! <tt>aero_removed_action(i)</tt> will be 2 (\c AERO_INFO_COAG)
2478  !! and <tt>aero_removed_other_id(i)</tt> will be the ID number of
2479  !! the combined particle.
2480  !!
2481  !! The aerosol removal information NetCDF dimensions are:
2482  !! - \b aero_removed: number of aerosol particles removed from the
2483  !! simulation during the previous timestep (or 1, as described
2484  !! above)
2485  !!
2486  !! The aerosol removal information NetCDF variables are:
2487  !! - \b aero_removed (dim \c aero_removed): dummy dimension variable
2488  !! (no useful value)
2489  !! - \b aero_removed_id (dim \c aero_removed): the ID number of each
2490  !! removed particle
2491  !! - \b aero_removed_action (dim \c aero_removed): the reasons for
2492  !! removal for each particle, with values:
2493  !! - 0 (\c AERO_INFO_NONE): no information (invalid entry)
2494  !! - 1 (\c AERO_INFO_DILUTION): particle was removed due to dilution
2495  !! with outside air
2496  !! - 2 (\c AERO_INFO_COAG): particle was removed due to coagulation
2497  !! - 3 (\c AERO_INFO_HALVED): particle was removed due to halving of
2498  !! the aerosol population
2499  !! - 4 (\c AERO_INFO_WEIGHT): particle was removed due to adjustments
2500  !! in the particle's weighting function
2501  !! - \b aero_removed_other_id (dim \c aero_removed): the ID number of
2502  !! the combined particle formed by coagulation, if the removal reason
2503  !! was coagulation (2, \c AERO_INFO_COAG). May be 0, if the new
2504  !! coagulated particle was not created due to weighting.
2505 
2506 !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
2507 
2508  !> Read full state.
2509  subroutine aero_state_input_netcdf(aero_state, ncid, aero_data)
2511  !> aero_state to read.
2512  type(aero_state_t), intent(inout) :: aero_state
2513  !> NetCDF file ID, in data mode.
2514  integer, intent(in) :: ncid
2515  !> aero_data structure.
2516  type(aero_data_t), intent(in) :: aero_data
2517 
2518  integer :: dimid_aero_particle, dimid_aero_removed, n_info_item, n_part
2519  integer :: i_bin, i_part_in_bin, i_part, i_remove, status
2520  type(aero_particle_t) :: aero_particle
2521  character(len=1000) :: name
2522 
2523  real(kind=dp), allocatable :: aero_particle_mass(:,:)
2524  integer, allocatable :: aero_n_orig_part(:,:)
2525  integer, allocatable :: aero_particle_weight_group(:)
2526  integer, allocatable :: aero_particle_weight_class(:)
2527  real(kind=dp), allocatable :: aero_absorb_cross_sect(:)
2528  real(kind=dp), allocatable :: aero_scatter_cross_sect(:)
2529  real(kind=dp), allocatable :: aero_asymmetry(:)
2530  real(kind=dp), allocatable :: aero_refract_shell_real(:)
2531  real(kind=dp), allocatable :: aero_refract_shell_imag(:)
2532  real(kind=dp), allocatable :: aero_refract_core_real(:)
2533  real(kind=dp), allocatable :: aero_refract_core_imag(:)
2534  real(kind=dp), allocatable :: aero_core_vol(:)
2535  integer, allocatable :: aero_water_hyst_leg(:)
2536  real(kind=dp), allocatable :: aero_num_conc(:)
2537  integer, allocatable :: aero_id(:)
2538  real(kind=dp), allocatable :: aero_least_create_time(:)
2539  real(kind=dp), allocatable :: aero_greatest_create_time(:)
2540  integer, allocatable :: aero_removed_id(:)
2541  integer, allocatable :: aero_removed_action(:)
2542  integer, allocatable :: aero_removed_other_id(:)
2543 
2544  status = nf90_inq_dimid(ncid, "aero_particle", dimid_aero_particle)
2545  if (status == nf90_ebaddim) then
2546  ! no aero_particle dimension means no particles present
2547  call aero_state_deallocate(aero_state)
2548  call aero_state_allocate(aero_state)
2549  call aero_weight_array_input_netcdf(aero_state%awa, ncid)
2550  return
2551  end if
2552  call pmc_nc_check(status)
2553  call pmc_nc_check(nf90_inquire_dimension(ncid, dimid_aero_particle, &
2554  name, n_part))
2555 
2556  allocate(aero_particle_mass(n_part, aero_data%n_spec))
2557  allocate(aero_n_orig_part(n_part, aero_data%n_source))
2558  allocate(aero_particle_weight_group(n_part))
2559  allocate(aero_particle_weight_class(n_part))
2560  allocate(aero_absorb_cross_sect(n_part))
2561  allocate(aero_scatter_cross_sect(n_part))
2562  allocate(aero_asymmetry(n_part))
2563  allocate(aero_refract_shell_real(n_part))
2564  allocate(aero_refract_shell_imag(n_part))
2565  allocate(aero_refract_core_real(n_part))
2566  allocate(aero_refract_core_imag(n_part))
2567  allocate(aero_core_vol(n_part))
2568  allocate(aero_water_hyst_leg(n_part))
2569  allocate(aero_num_conc(n_part))
2570  allocate(aero_id(n_part))
2571  allocate(aero_least_create_time(n_part))
2572  allocate(aero_greatest_create_time(n_part))
2573 
2575  "aero_particle_mass")
2576  call pmc_nc_read_integer_2d(ncid, aero_n_orig_part, &
2577  "aero_n_orig_part")
2578  call pmc_nc_read_integer_1d(ncid, aero_particle_weight_group, &
2579  "aero_particle_weight_group")
2580  call pmc_nc_read_integer_1d(ncid, aero_particle_weight_class, &
2581  "aero_particle_weight_class")
2582  call pmc_nc_read_real_1d(ncid, aero_absorb_cross_sect, &
2583  "aero_absorb_cross_sect", must_be_present=.false.)
2584  call pmc_nc_read_real_1d(ncid, aero_scatter_cross_sect, &
2585  "aero_scatter_cross_sect", must_be_present=.false.)
2586  call pmc_nc_read_real_1d(ncid, aero_asymmetry, &
2587  "aero_asymmetry", must_be_present=.false.)
2588  call pmc_nc_read_real_1d(ncid, aero_refract_shell_real, &
2589  "aero_refract_shell_real", must_be_present=.false.)
2590  call pmc_nc_read_real_1d(ncid, aero_refract_shell_imag, &
2591  "aero_refract_shell_imag", must_be_present=.false.)
2592  call pmc_nc_read_real_1d(ncid, aero_refract_core_real, &
2593  "aero_refract_core_real", must_be_present=.false.)
2594  call pmc_nc_read_real_1d(ncid, aero_refract_core_imag, &
2595  "aero_refract_core_imag", must_be_present=.false.)
2596  call pmc_nc_read_real_1d(ncid, aero_core_vol, &
2597  "aero_core_vol", must_be_present=.false.)
2598  call pmc_nc_read_integer_1d(ncid, aero_water_hyst_leg, &
2599  "aero_water_hyst_leg")
2600  call pmc_nc_read_real_1d(ncid, aero_num_conc, &
2601  "aero_num_conc")
2602  call pmc_nc_read_integer_1d(ncid, aero_id, &
2603  "aero_id")
2604  call pmc_nc_read_real_1d(ncid, aero_least_create_time, &
2605  "aero_least_create_time")
2606  call pmc_nc_read_real_1d(ncid, aero_greatest_create_time, &
2607  "aero_greatest_create_time")
2608 
2609  call aero_state_deallocate(aero_state)
2610  call aero_state_allocate(aero_state)
2611 
2612  call aero_weight_array_input_netcdf(aero_state%awa, ncid)
2613  call aero_state_set_n_part_ideal(aero_state, 0d0)
2614 
2615  call aero_particle_allocate_size(aero_particle, aero_data%n_spec, &
2616  aero_data%n_source)
2617  do i_part = 1,n_part
2618  aero_particle%vol = aero_particle_mass(i_part, :) / aero_data%density
2619  aero_particle%n_orig_part = aero_n_orig_part(i_part, :)
2620  aero_particle%weight_group = aero_particle_weight_group(i_part)
2621  aero_particle%weight_class = aero_particle_weight_class(i_part)
2622  aero_particle%absorb_cross_sect = aero_absorb_cross_sect(i_part)
2623  aero_particle%scatter_cross_sect = aero_scatter_cross_sect(i_part)
2624  aero_particle%asymmetry = aero_asymmetry(i_part)
2625  aero_particle%refract_shell = &
2626  cmplx(aero_refract_shell_real(i_part), &
2627  aero_refract_shell_imag(i_part), kind=dc)
2628  aero_particle%refract_core = cmplx(aero_refract_core_real(i_part), &
2629  aero_refract_core_imag(i_part), kind=dc)
2630  aero_particle%core_vol = aero_core_vol(i_part)
2631  aero_particle%water_hyst_leg = aero_water_hyst_leg(i_part)
2632  aero_particle%id = aero_id(i_part)
2633  aero_particle%least_create_time = aero_least_create_time(i_part)
2634  aero_particle%greatest_create_time = aero_greatest_create_time(i_part)
2635 
2636  call assert(314368871, almost_equal(aero_num_conc(i_part), &
2637  aero_weight_array_num_conc(aero_state%awa, aero_particle)))
2638 
2639  call aero_state_add_particle(aero_state, aero_particle)
2640  end do
2641  call aero_particle_deallocate(aero_particle)
2642 
2643  deallocate(aero_particle_mass)
2644  deallocate(aero_n_orig_part)
2645  deallocate(aero_particle_weight_group)
2646  deallocate(aero_particle_weight_class)
2647  deallocate(aero_absorb_cross_sect)
2648  deallocate(aero_scatter_cross_sect)
2649  deallocate(aero_asymmetry)
2650  deallocate(aero_refract_shell_real)
2651  deallocate(aero_refract_shell_imag)
2652  deallocate(aero_refract_core_real)
2653  deallocate(aero_refract_core_imag)
2654  deallocate(aero_core_vol)
2655  deallocate(aero_water_hyst_leg)
2656  deallocate(aero_num_conc)
2657  deallocate(aero_id)
2658  deallocate(aero_least_create_time)
2659  deallocate(aero_greatest_create_time)
2660 
2661  status = nf90_inq_dimid(ncid, "aero_removed", dimid_aero_removed)
2662  if ((status /= nf90_noerr) .and. (status /= nf90_ebaddim)) then
2663  call pmc_nc_check(status)
2664  end if
2665  if (status == nf90_noerr) then
2666  call pmc_nc_check(nf90_inquire_dimension(ncid, dimid_aero_removed, &
2667  name, n_info_item))
2668 
2669  allocate(aero_removed_id(max(n_info_item,1)))
2670  allocate(aero_removed_action(max(n_info_item,1)))
2671  allocate(aero_removed_other_id(max(n_info_item,1)))
2672 
2673  call pmc_nc_read_integer_1d(ncid, aero_removed_id, &
2674  "aero_removed_id")
2675  call pmc_nc_read_integer_1d(ncid, aero_removed_action, &
2676  "aero_removed_action")
2677  call pmc_nc_read_integer_1d(ncid, aero_removed_other_id, &
2678  "aero_removed_other_id")
2679 
2680  if ((n_info_item > 1) .or. (aero_removed_id(1) /= 0)) then
2681  call aero_info_array_enlarge_to(aero_state%aero_info_array, &
2682  n_info_item)
2683  do i_remove = 1,n_info_item
2684  aero_state%aero_info_array%aero_info(i_remove)%id &
2685  = aero_removed_id(i_remove)
2686  aero_state%aero_info_array%aero_info(i_remove)%action &
2687  = aero_removed_action(i_remove)
2688  aero_state%aero_info_array%aero_info(i_remove)%other_id &
2689  = aero_removed_other_id(i_remove)
2690  end do
2691  end if
2692 
2693  deallocate(aero_removed_id)
2694  deallocate(aero_removed_action)
2695  deallocate(aero_removed_other_id)
2696  end if
2697 
2698  end subroutine aero_state_input_netcdf
2699 
2700 !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
2701 
2702  !> Sorts the particles if necessary.
2703  subroutine aero_state_sort(aero_state, bin_grid, all_procs_same)
2705  !> Aerosol state to sort.
2706  type(aero_state_t), intent(inout) :: aero_state
2707  !> Bin grid.
2708  type(bin_grid_t), optional, intent(in) :: bin_grid
2709  !> Whether all processors should use the same bin grid.
2710  logical, optional, intent(in) :: all_procs_same
2711 
2712  call aero_sorted_remake_if_needed(aero_state%aero_sorted, aero_state%apa, &
2713  aero_state%valid_sort, size(aero_state%awa%weight, 1), &
2714  size(aero_state%awa%weight, 2), bin_grid, all_procs_same)
2715  aero_state%valid_sort = .true.
2716 
2717  end subroutine aero_state_sort
2718 
2719 !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
2720 
2721  !> Check that the sorted data is consistent.
2722  subroutine aero_state_check_sort(aero_state)
2724  !> Aerosol state to check.
2725  type(aero_state_t), intent(in) :: aero_state
2726 
2727  logical, parameter :: continue_on_error = .false.
2728 
2729  integer :: i_part, i_bin
2730 
2731  if (.not. aero_state%valid_sort) then
2732  write(0,*) 'SORTED CHECK ERROR: SORT NOT VALID'
2733  return
2734  end if
2735 
2736  call aero_sorted_check(aero_state%aero_sorted, aero_state%apa, &
2737  size(aero_state%awa%weight, 1), size(aero_state%awa%weight, 2), &
2738  continue_on_error)
2739 
2740  end subroutine aero_state_check_sort
2741 
2742 !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
2743 
2744 end module pmc_aero_state
2745 
subroutine aero_particle_set_weight(aero_particle, i_group, i_class)
Sets the aerosol particle weight group.
real(kind=dp) function aero_weight_array_single_num_conc(aero_weight_array, aero_particle)
Compute the number concentration for a particle (m^{-3}).
The aero_sorted_t structure and assocated subroutines.
Definition: aero_sorted.F90:9
subroutine aero_state_copy(aero_state_from, aero_state_to)
Copies aerosol to a destination that has already had aero_state_allocate() called on it...
Definition: aero_state.F90:131
subroutine aero_state_netcdf_dim_aero_removed(aero_state, ncid, dimid_aero_removed)
Write the aero removed dimension to the given NetCDF file if it is not already present and in any cas...
subroutine aero_state_to_binned_dry(bin_grid, aero_data, aero_state, aero_binned)
Does the same thing as aero_state_to_bin() but based on dry radius.
subroutine aero_particle_set_vols(aero_particle, vols)
Sets the aerosol particle volumes.
subroutine aero_particle_array_copy(aero_particle_array_from, aero_particle_array_to)
Copies aero_particle_array_from to aero_particle_array_to, both of which must already be allocated...
subroutine aero_state_mix(aero_state, del_t, mix_timescale, aero_data, specify_prob_transfer)
Mix the aero_states between all processes. Currently uses a simple all-to-all diffusion.
subroutine pmc_mpi_unpack_aero_info_array(buffer, position, val)
Unpacks the given value from the buffer, advancing position.
subroutine pmc_nc_write_real_1d(ncid, var, name, dimids, dim_name, unit, long_name, standard_name, description)
Write a simple real array to a NetCDF file.
Definition: netcdf.F90:504
subroutine aero_state_bin_average_size(aero_state, bin_grid, aero_data, bin_center, preserve_number)
Set each aerosol particle to have its original species ratios, but total volume given by the average ...
subroutine aero_particle_array_deallocate(aero_particle_array)
Deallocates.
subroutine aero_sorted_add_particle(aero_sorted, aero_particle_array, aero_particle, allow_resort)
Add a new particle to both an aero_sorted and the corresponding aero_particle_array.
The aero_data_t structure and associated subroutines.
Definition: aero_data.F90:9
integer function pmc_mpi_pack_size_aero_state(val)
Determines the number of bytes required to pack the given value.
subroutine die_msg(code, error_msg)
Error immediately.
Definition: util.F90:133
subroutine aero_info_deallocate(aero_info)
Deallocates.
Definition: aero_info.F90:75
subroutine aero_weight_array_check_monotonicity(aero_weight_array, monotone_increasing, monotone_decreasing)
Determine whether all weight functions in an array are monotone increasing, monotone decreasing...
1-D arrays of particles, used by aero_state to build a ragged array.
subroutine pmc_mpi_pack_real_array_2d(buffer, position, val)
Packs the given value into the buffer, advancing position.
Definition: mpi.F90:742
The aero_info_array_t structure and assoicated subroutines.
subroutine copy_real_2d(source, dest)
Copy a 2D array of reals, reallocating if necessary.
Definition: util.F90:1533
subroutine aero_particle_array_zero(aero_particle_array)
Resets an aero_particle_array to contain zero particles.
subroutine aero_info_array_copy(aero_info_array_from, aero_info_array_to)
Copies aero_info_array_from to aero_info_array_to, both of which must already be allocated.
subroutine aero_state_reset(aero_state)
Resets an aero_state to an empty state.
Definition: aero_state.F90:117
subroutine aero_particle_zero(aero_particle)
Resets an aero_particle to be zero.
subroutine aero_mode_sample_vols(aero_mode, total_vol, vols)
Return an array of volumes randomly sampled from the volume fractions.
Definition: aero_mode.F90:679
subroutine aero_weight_array_deallocate(aero_weight_array)
Free all storage.
subroutine aero_info_allocate(aero_info)
Allocates and initializes.
Definition: aero_info.F90:63
real(kind=dp) elemental function rad2vol(r)
Convert radius (m) to volume (m^3).
Definition: util.F90:274
integer function rand_binomial(n, p)
Generate a Binomial-distributed random number with the given parameters.
Definition: rand.F90:319
real(kind=dp) function entropy(p)
Compute the entropy of a probability mass function (non necessarily normalized).
Definition: util.F90:1583
real(kind=dp) function, dimension(aero_state%apa%n_part) aero_state_mass_entropies(aero_state, aero_data, include, exclude, group)
Returns the mass-entropies of all particles.
The aero_weight_t structure and associated subroutines.
Definition: aero_weight.F90:9
The aero_dist_t structure and associated subroutines.
Definition: aero_dist.F90:18
subroutine aero_state_scale_weight(aero_state, i_group, i_class, weight_ratio, allow_doubling, allow_halving)
Scale the weighting of the given group/class by the given ratio, altering particle number as necessar...
integer function aero_data_spec_by_name(aero_data, name)
Returns the number of the species in aero_data with the given name, or returns 0 if there is no such ...
Definition: aero_data.F90:160
The aero_particle_t structure and associated subroutines.
real(kind=dp) function, dimension(aero_state%apa%n_part) aero_state_crit_rel_humids(aero_state, aero_data, env_state)
Returns the critical relative humidity for all particles (1).
subroutine aero_particle_deallocate(aero_particle)
Deallocates memory associated with an aero_particle_t.
elemental real(kind=dp) function aero_particle_species_mass(aero_particle, i_spec, aero_data)
Mass of a single species in the particle (kg).
subroutine aero_state_allocate(aero_state)
Allocates aerosol arrays.
Definition: aero_state.F90:83
subroutine aero_info_array_allocate(aero_info_array)
Allocates the structure.
The integer_varray_t structure and assocated subroutines.
subroutine aero_info_array_deallocate(aero_info_array)
Deallocates.
subroutine aero_state_add_particles(aero_state, aero_state_delta)
aero_state += aero_state_delta, with the weight of aero_state left unchanged, so the new concentratio...
Definition: aero_state.F90:628
integer function, dimension(aero_state%apa%n_part) aero_state_ids(aero_state)
Returns the IDs of all particles.
Definition: aero_state.F90:957
integer function pmc_mpi_pack_size_aero_weight_array(val)
Determines the number of bytes required to pack the given value.
subroutine pmc_nc_check(status)
Check the status of a NetCDF function call.
Definition: netcdf.F90:22
subroutine aero_particle_allocate_size(aero_particle, n_spec, n_source)
Allocates an aero_particle_t of the given size.
subroutine aero_weight_array_allocate_flat(aero_weight_array, n_class)
Allocates an aero_weight_array as flat weightings.
subroutine aero_particle_set_create_time(aero_particle, create_time)
Sets the creation times for the particle.
subroutine aero_state_add_particle(aero_state, aero_particle, allow_resort)
Add the given particle.
Definition: aero_state.F90:330
subroutine pmc_mpi_allreduce_sum_integer(val, val_sum)
Computes the sum of val across all processes, storing the result in val_sum on all processes...
Definition: mpi.F90:1140
real(kind=dp) function, dimension(aero_state%apa%n_part) aero_state_diameters(aero_state)
Returns the diameters of all particles.
Definition: aero_state.F90:976
subroutine aero_state_sample(aero_state_from, aero_state_to, 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:866
subroutine aero_state_mpi_gather(aero_state, aero_state_total)
Gathers data from all processes into one aero_state on process 0.
subroutine aero_state_num_conc_for_reweight(aero_state, reweight_num_conc)
Save the correct number concentrations for later use by aero_state_reweight().
Definition: aero_state.F90:522
subroutine aero_state_halve(aero_state, i_group, i_class)
Remove approximately half of the particles in the given weight group.
integer function bin_grid_find(bin_grid, val)
Find the bin number that contains a given value.
Definition: bin_grid.F90:196
subroutine assert_msg(code, condition_ok, error_msg)
Errors unless condition_ok is true.
Definition: util.F90:76
elemental real(kind=dp) function aero_particle_diameter(aero_particle)
Total diameter of the particle (m).
logical function almost_equal(d1, d2)
Tests whether two real numbers are almost equal using only a relative tolerance.
Definition: util.F90:311
subroutine aero_state_to_binned(bin_grid, aero_data, aero_state, aero_binned)
Create binned number and mass arrays.
Definition: aero_state.F90:917
elemental subroutine aero_weight_scale(aero_weight, factor)
Scale the weight by the given fraction, so new_weight = old_weight * factor.
subroutine pmc_nc_read_integer_1d(ncid, var, name, must_be_present)
Read a simple integer array from a NetCDF file.
Definition: netcdf.F90:253
subroutine aero_state_copy_weight(aero_state_from, aero_state_to)
Copies weighting information for an aero_state.
Definition: aero_state.F90:150
subroutine aero_info_array_add_aero_info(aero_info_array, aero_info)
Adds the given aero_info to the end of the array.
integer function aero_state_weight_class_for_source(aero_state, source)
Determine the appropriate weight class for a source.
Definition: aero_state.F90:231
subroutine aero_particle_set_source(aero_particle, i_source)
Sets the aerosol particle source.
elemental real(kind=dp) function aero_particle_radius(aero_particle)
Total radius of the particle (m).
subroutine aero_state_set_n_part_ideal(aero_state, n_part)
Set the ideal number of particles to the given value. The aero_state%awa must be already set correctl...
Definition: aero_state.F90:211
subroutine aero_sorted_remake_if_needed(aero_sorted, aero_particle_array, valid_sort, n_group, n_class, bin_grid, all_procs_same)
Remake a sorting if particles are getting too close to the edges.
integer function aero_weight_array_rand_group(aero_weight_array, i_class, radius)
Choose a random group at the given radius, with probability inversely proportional to group weight at...
real(kind=dp) function, dimension(aero_state%apa%n_part) aero_state_masses(aero_state, aero_data, include, exclude)
Returns the masses of all particles.
Random number generators.
Definition: rand.F90:9
The aero_particle_array_t structure and assoicated subroutines.
real(kind=dp) function aero_mode_number(aero_mode, aero_weight)
Return the total number of computational particles for an aero_mode.
Definition: aero_mode.F90:547
real(kind=dp) function aero_weight_array_num_conc(aero_weight_array, aero_particle)
Compute the number concentration for a particle (m^{-3}).
real(kind=dp) function aero_state_particle_num_conc(aero_state, aero_particle)
The number concentration of a single particle (m^{-3}).
Definition: aero_state.F90:505
subroutine aero_state_add_aero_dist_sample(aero_state, aero_data, aero_dist, sample_prop, 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:694
integer function pmc_mpi_size()
Returns the total number of processes.
Definition: mpi.F90:133
subroutine aero_info_array_enlarge_to(aero_info_array, n)
Enlarges the given array so that it is at least of size n.
subroutine aero_state_set_weight(aero_state, aero_data, weight_type, exponent)
Sets the weighting functions for an aero_state.
Definition: aero_state.F90:164
subroutine pmc_nc_write_integer_1d(ncid, var, name, dimids, dim_name, unit, long_name, standard_name, description)
Write a simple integer array to a NetCDF file.
Definition: netcdf.F90:553
subroutine aero_info_array_zero(aero_info_array)
Resets an aero_info_array to contain zero particles.
subroutine aero_sorted_check(aero_sorted, aero_particle_array, n_group, n_class, continue_on_error)
Check sorting.
subroutine pmc_mpi_pack_aero_info_array(buffer, position, val)
Packs the given value into the buffer, advancing position.
subroutine aero_particle_array_add_particle(aero_particle_array, aero_particle)
Adds the given particle to the end of the array.
A complete aerosol distribution, consisting of several modes.
Definition: aero_dist.F90:33
subroutine aero_data_netcdf_dim_aero_species(aero_data, ncid, dimid_aero_species)
Write the aero species dimension to the given NetCDF file if it is not already present and in any cas...
Definition: aero_data.F90:491
Common utility subroutines.
Definition: util.F90:9
1-D arrays of aero_info_t structure.
subroutine aero_weight_array_input_netcdf(aero_weight_array, ncid)
Read full aero_weight_array.
subroutine aero_state_sort(aero_state, bin_grid, all_procs_same)
Sorts the particles if necessary.
subroutine pmc_nc_read_real_1d(ncid, var, name, must_be_present)
Read a simple real array from a NetCDF file.
Definition: netcdf.F90:218
subroutine aero_state_dup_particle(aero_state, i_part, n_part_mean, random_weight_group)
Add copies or remove a particle, with a given mean number of resulting particles. ...
Definition: aero_state.F90:450
subroutine aero_weight_array_allocate(aero_weight_array)
Allocates an aero_weight_array.
subroutine aero_state_remove_rand_particle_from_bin(aero_state, i_bin, i_class, aero_particle)
Remove a randomly chosen particle from the given bin and return it.
Definition: aero_state.F90:414
The aero_info_t structure and associated subroutines.
Definition: aero_info.F90:9
An array of aerosol size distribution weighting functions.
integer function pmc_rand_int(n)
Returns a random integer between 1 and n.
Definition: rand.F90:172
subroutine pmc_nc_read_real_2d(ncid, var, name, must_be_present)
Read a simple real 2D array from a NetCDF file.
Definition: netcdf.F90:288
subroutine aero_state_remove_particle(aero_state, i_part, record_removal, aero_info)
Remove the given particle and possibly record the removal.
Definition: aero_state.F90:389
The aero_state_t structure and assocated subroutines.
Definition: aero_state.F90:9
integer function pmc_mpi_rank()
Returns the rank of the current process.
Definition: mpi.F90:116
Wrapper functions for MPI.
Definition: mpi.F90:13
real(kind=dp) function, dimension(aero_state%apa%n_part) aero_state_approx_crit_rel_humids(aero_state, aero_data, env_state)
Returns the approximate critical relative humidity for all particles (1).
subroutine aero_weight_array_allocate_power(aero_weight_array, n_class, exponent)
Allocates an aero_weight_array as power weightings.
subroutine aero_state_check_sort(aero_state)
Check that the sorted data is consistent.
integer function pmc_mpi_pack_size_real_array_2d(val)
Determines the number of bytes required to pack the given value.
Definition: mpi.F90:511
real(kind=dp) function aero_weight_array_num_conc_at_radius(aero_weight_array, i_class, radius)
Compute the total number concentration at a given radius (m^3).
The aero_weight_array_t structure and associated subroutines.
subroutine aero_particle_allocate(aero_particle)
Allocates memory in an aero_particle_t.
subroutine aero_state_mpi_alltoall(send, recv)
Do an MPI all-to-all transfer of aerosol states.
subroutine aero_state_double(aero_state, i_group, i_class)
Doubles number of particles in the given weight group.
integer function rand_poisson(mean)
Generate a Poisson-distributed random number with the given mean.
Definition: rand.F90:252
subroutine pmc_mpi_unpack_aero_weight_array(buffer, position, val)
Unpacks the given value from the buffer, advancing position.
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:255
character(len=pmc_util_convert_string_len) function integer_to_string(val)
Convert an integer to a string format.
Definition: util.F90:743
subroutine pmc_mpi_pack_aero_weight_array(buffer, position, val)
Packs the given value into the buffer, advancing position.
subroutine aero_state_reweight(aero_state, reweight_num_conc)
Reweight all particles after their constituent volumes have been altered.
Definition: aero_state.F90:550
The current collection of aerosol particles.
Definition: aero_state.F90:63
subroutine aero_state_make_dry(aero_state, aero_data)
Make all particles dry (water set to zero).
subroutine pmc_mpi_pack_aero_state(buffer, position, val)
Packs the given value into the buffer, advancing position.
subroutine aero_mode_sample_radius(aero_mode, aero_weight, radius)
Return a radius randomly sampled from the mode distribution.
Definition: aero_mode.F90:600
integer function aero_weight_array_n_class(aero_weight_array)
Return the number of weight classes.
subroutine aero_state_remove_particle_no_info(aero_state, i_part)
Remove the given particle without recording it.
Definition: aero_state.F90:351
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:370
real(kind=dp) function aero_particle_crit_rel_humid(aero_particle, aero_data, env_state)
Returns the critical relative humidity (1).
subroutine aero_info_array_add(aero_info_array, aero_info_array_delta)
Adds aero_info_array_delta to the end of aero_info_array.
Single aerosol particle data structure.
1D grid, either logarithmic or linear.
Definition: bin_grid.F90:33
subroutine pmc_mpi_check_ierr(ierr)
Dies if ierr is not ok.
Definition: mpi.F90:39
The bin_grid_t structure and associated subroutines.
Definition: bin_grid.F90:9
subroutine pmc_mpi_unpack_real_array_2d(buffer, position, val)
Unpacks the given value from the buffer, advancing position.
Definition: mpi.F90:983
subroutine aero_particle_new_id(aero_particle)
Assigns a globally-unique new ID number to the particle.
subroutine aero_state_deallocate(aero_state)
Deallocates a previously allocated aerosol.
Definition: aero_state.F90:100
subroutine pmc_nc_write_real_2d(ncid, var, name, dimids, dim_name_1, dim_name_2, unit, long_name, standard_name, description)
Write a simple real 2D array to a NetCDF file.
Definition: netcdf.F90:602
integer function prob_round(val)
Round val to floor(val) or ceiling(val) with probability proportional to the relative distance from v...
Definition: rand.F90:214
real(kind=dp) function aero_state_total_num_conc(aero_state)
Returns the total number concentration.
Reading formatted text input.
Definition: spec_file.F90:43
subroutine aero_state_bin_average_comp(aero_state, bin_grid, aero_data)
Set each aerosol particle to have its original total volume, but species volume ratios given by the t...
real(kind=dp) function, dimension(aero_state%apa%n_part) aero_state_dry_diameters(aero_state, aero_data)
Returns the dry diameters of all particles.
Definition: aero_state.F90:992
subroutine aero_state_add(aero_state, aero_state_delta)
aero_state += aero_state_delta, including combining the weights, so the new concentration is the weig...
Definition: aero_state.F90:611
The aero_binned_t structure and associated subroutines.
Definition: aero_binned.F90:9
subroutine warn_msg(code, warning_msg, already_warned)
Prints a warning message.
Definition: util.F90:36
subroutine aero_state_input_netcdf(aero_state, ncid, aero_data)
Read full state.
Sorting of particles into bins.
Definition: aero_sorted.F90:46
integer function aero_weight_array_n_group(aero_weight_array)
Return the number of weight groups.
subroutine aero_state_zero(aero_state)
Resets an aero_state to have zero particles per bin. This must already have had aero_state_allocate()...
Definition: aero_state.F90:314
subroutine pmc_nc_write_integer_2d(ncid, var, name, dimids, dim_name_1, dim_name_2, unit, long_name, standard_name, description)
Write a simple integer 2D array to a NetCDF file.
Definition: netcdf.F90:656
integer function pmc_mpi_pack_size_aia(val)
Determines the number of bytes required to pack the given value.
subroutine aero_state_sample_particles(aero_state_from, aero_state_to, 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:791
subroutine aero_weight_array_allocate_nummass(aero_weight_array, n_class)
Allocates an aero_weight_array as joint flat/power-3 weightings..
subroutine aero_particle_array_remove_particle(aero_particle_array, index)
Removes the particle at the given index.
real(kind=dp) function, dimension(aero_state%apa%n_part) aero_state_num_concs(aero_state)
Returns the number concentrations of all particles.
real(kind=dp) function pmc_random()
Returns a random number between 0 and 1.
Definition: rand.F90:138
logical function aero_weight_array_check_flat(aero_weight_array)
Check whether a given aero_weight array is flat in total.
subroutine pmc_mpi_unpack_aero_state(buffer, position, val)
Unpacks the given value from the buffer, advancing position.
real(kind=dp) function, dimension(aero_data%n_spec) aero_particle_species_masses(aero_particle, aero_data)
Mass of all species in the particle (kg).
elemental real(kind=dp) function aero_particle_mass(aero_particle, aero_data)
Total mass of the particle (kg).
real(kind=dp) function aero_particle_approx_crit_rel_humid(aero_particle, aero_data, env_state)
Returns the approximate critical relative humidity (1).
subroutine pmc_mpi_unpack_aero_particle_array(buffer, position, val)
Unpacks the given value from the buffer, advancing position.
real(kind=dp) elemental function vol2rad(v)
Convert volume (m^3) to radius (m).
Definition: util.F90:238
subroutine aero_particle_array_allocate(aero_particle_array)
Allocates and initializes.
subroutine pmc_nc_read_integer_2d(ncid, var, name, must_be_present)
Read a simple integer 2D array from a NetCDF file.
Definition: netcdf.F90:323
elemental real(kind=dp) function aero_particle_volume(aero_particle)
Total volume of the particle (m^3).
real(kind=dp) function aero_particle_solute_radius(aero_particle, aero_data)
Returns the total solute radius (m).
subroutine aero_state_netcdf_dim_aero_particle(aero_state, ncid, dimid_aero_particle)
Write the aero particle dimension to the given NetCDF file if it is not already present and in any ca...
integer function aero_state_total_particles_all_procs(aero_state, i_group, i_class)
Returns the total number of particles across all processes.
Definition: aero_state.F90:293
subroutine pmc_mpi_alltoall_integer(send, recv)
Does an all-to-all transfer of integers.
Definition: mpi.F90:1406
Aerosol material properties and associated data.
Definition: aero_data.F90:40
subroutine aero_state_rand_particle(aero_state, i_part)
Choose a random particle from the aero_state.
Definition: aero_state.F90:771
subroutine assert(code, condition_ok)
Errors unless condition_ok is true.
Definition: util.F90:102
subroutine aero_sorted_allocate(aero_sorted)
Allocate an empty structure.
Definition: aero_sorted.F90:77
subroutine aero_weight_array_shift(aero_weight_array_from, aero_weight_array_to, sample_prop, overwrite_to)
Adjust source and destination weights to reflect moving sample_prop proportion of particles from aero...
elemental real(kind=dp) function aero_particle_dry_diameter(aero_particle, aero_data)
Total dry diameter of the particle (m).
subroutine aero_data_netcdf_dim_aero_source(aero_data, ncid, dimid_aero_source)
Write the aero source dimension to the given NetCDF file if it is not already present and in any case...
Definition: aero_data.F90:547
subroutine aero_state_prepare_weight_for_add(aero_state, i_group, i_class, n_add, allow_doubling, allow_halving)
Change the weight if necessary to ensure that the addition of about n_add computational particles wil...
Definition: aero_state.F90:651
Information about removed particles describing the sink.
Definition: aero_info.F90:48
subroutine aero_weight_array_combine(aero_weight_array, aero_weight_array_delta)
Combine aero_weight_array_delta into aero_weight_array with a harmonic mean.
subroutine aero_sorted_deallocate(aero_sorted)
Deallocates a previously allocated structure.
subroutine pmc_mpi_pack_aero_particle_array(buffer, position, val)
Packs the given value into the buffer, advancing position.
subroutine aero_sorted_remove_particle(aero_sorted, aero_particle_array, i_part)
Remove a particle from both an aero_sorted and the corresponding aero_particle_array.
subroutine aero_particle_copy(aero_particle_from, aero_particle_to)
Copies a particle.
Aerosol number and volume distributions stored per bin.
Definition: aero_binned.F90:33
subroutine aero_weight_array_copy(aero_weight_array_from, aero_weight_array_to)
Copy an aero_weight_array.
elemental subroutine aero_weight_array_normalize(aero_weight_array)
Normalizes the aero_weight_array to a non-zero value.
integer function pmc_mpi_pack_size_apa(val)
Determines the number of bytes required to pack the given value.
subroutine aero_state_rebalance(aero_state, allow_doubling, allow_halving, initial_state_warning)
Double or halve the particle population in each weight group to maintain close to n_part_ideal partic...