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