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