PartMC  2.3.0
aero_sorted.F90
Go to the documentation of this file.
1 ! Copyright (C) 2011, 2012 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_sorted module.
7 
8 !> The aero_sorted_t structure and assocated subroutines.
10 
16  use pmc_bin_grid
17  use pmc_mpi
18 
19  !> Sorting of particles into bins.
20  !!
21  !! Two different bin-sortings are maintained, one per size bin and
22  !! weight class, and the other per weight group and weight class.
23  !!
24  !! A particle can thus be identified by its position \c i_part in an
25  !! \c aero_particle_array_t, or by an entry in one of the two
26  !! sortings.
27  !!
28  !! For example, for size bin \c i_bin and weight class \c i_class,
29  !! the number of particles with this size and class are
30  !! <pre>
31  !! n = aero_sorted%%size_class%%inverse(i_bin, i_class)%%n_entry
32  !! </pre>
33  !! For particle number \c i_entry in this size/class bin, the
34  !! particle number is
35  !! <pre>
36  !! i_part = aero_sorted%%size_class%%inverse(i_bin, i_class)%%entry(i_entry)
37  !! </pre>
38  !! For particle number \c i_part, the size bin and weight class are
39  !! <pre>
40  !! i_bin = aero_sorted%%size_class%%forward1%%entry(i_part)
41  !! i_class = aero_sorted%%size_class%%forward2%%entry(i_part)
42  !! </pre>
43  !!
44  !! Similar relationships hold for \c aero_sorted%%group_class which
45  !! sorts particles per weight group/class.
47  !> Bin grid for sorting.
48  type(bin_grid_t) :: bin_grid
49  !> Map of size bin and weight class numbers.
50  type(integer_rmap2_t) :: size_class
51  !> Map of weight group and weight class numbers.
52  type(integer_rmap2_t) :: group_class
53  !> Whether coagulation kernel bounds are valid.
54  logical :: coag_kernel_bounds_valid
55  !> Coagulation kernel lower bound [<tt>n_bin x n_bin</tt>].
56  real(kind=dp), allocatable, dimension(:,:) :: coag_kernel_min
57  !> Coagulation kernel upper bound [<tt>n_bin x n_bin</tt>].
58  real(kind=dp), allocatable, dimension(:,:) :: coag_kernel_max
59  !> Whether particle removal rate bounds are valid.
60  logical :: removal_rate_bounds_valid
61  !> Particle removal rate upper bound [<tt>n_bin x n_bin</tt>].
62  real(kind=dp), allocatable, dimension(:) :: removal_rate_max
63  end type aero_sorted_t
64 
65  !> How many size bins to use per decade of particle radius.
66  real(kind=dp), parameter :: AERO_SORTED_BINS_PER_DECADE = 10d0
67  !> Factor to extend size grid beyond largest/smallest particles.
68  real(kind=dp), parameter :: AERO_SORTED_BIN_OVER_FACTOR = 10d0
69  !> Size grid extension factor when we should regenerate grid.
70  real(kind=dp), parameter :: AERO_SORTED_BIN_SAFETY_FACTOR = 3d0
71 
72 contains
73 
74 !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
75 
76  !> Allocate an empty structure.
77  subroutine aero_sorted_allocate(aero_sorted)
78 
79  !> Structure to initialize.
80  type(aero_sorted_t), intent(out) :: aero_sorted
81 
82  call bin_grid_allocate(aero_sorted%bin_grid)
83  call integer_rmap2_allocate(aero_sorted%size_class)
84  call integer_rmap2_allocate(aero_sorted%group_class)
85  aero_sorted%coag_kernel_bounds_valid = .false.
86  allocate(aero_sorted%coag_kernel_min(0, 0))
87  allocate(aero_sorted%coag_kernel_max(0, 0))
88  aero_sorted%removal_rate_bounds_valid = .false.
89  allocate(aero_sorted%removal_rate_max(0))
90 
91  end subroutine aero_sorted_allocate
92 
93 !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
94 
95  !> Allocate a strcture with the given size.
96  subroutine aero_sorted_allocate_size(aero_sorted, n_bin, n_group, n_class)
97 
98  !> Structure to initialize.
99  type(aero_sorted_t), intent(out) :: aero_sorted
100  !> Number of bins.
101  integer, intent(in) :: n_bin
102  !> Number of weight groups.
103  integer, intent(in) :: n_group
104  !> Number of weight classes.
105  integer, intent(in) :: n_class
106 
107  call bin_grid_allocate(aero_sorted%bin_grid)
108  call integer_rmap2_allocate_size(aero_sorted%size_class, n_bin, n_class)
109  call integer_rmap2_allocate_size(aero_sorted%group_class, n_group, n_class)
110  aero_sorted%coag_kernel_bounds_valid = .false.
111  allocate(aero_sorted%coag_kernel_min(n_bin, n_bin))
112  allocate(aero_sorted%coag_kernel_max(n_bin, n_bin))
113  aero_sorted%removal_rate_bounds_valid = .false.
114  allocate(aero_sorted%removal_rate_max(n_bin))
115 
116  end subroutine aero_sorted_allocate_size
117 
118 !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
119 
120  !> Deallocates a previously allocated structure.
121  subroutine aero_sorted_deallocate(aero_sorted)
122 
123  !> Structure to deallocate.
124  type(aero_sorted_t), intent(inout) :: aero_sorted
125 
126  call bin_grid_deallocate(aero_sorted%bin_grid)
127  call integer_rmap2_deallocate(aero_sorted%size_class)
128  call integer_rmap2_deallocate(aero_sorted%group_class)
129  aero_sorted%coag_kernel_bounds_valid = .false.
130  deallocate(aero_sorted%coag_kernel_min)
131  deallocate(aero_sorted%coag_kernel_max)
132  aero_sorted%removal_rate_bounds_valid = .false.
133  deallocate(aero_sorted%removal_rate_max)
134 
135  end subroutine aero_sorted_deallocate
136 
137 !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
138 
139  !> Resets an aero_sorted to have zero particles per bin.
140  subroutine aero_sorted_zero(aero_sorted)
141 
142  !> Structure to zero.
143  type(aero_sorted_t), intent(inout) :: aero_sorted
144 
145  call integer_rmap2_zero(aero_sorted%size_class)
146  call integer_rmap2_zero(aero_sorted%group_class)
147  aero_sorted%coag_kernel_bounds_valid = .false.
148  aero_sorted%coag_kernel_min = 0d0
149  aero_sorted%coag_kernel_max = 0d0
150  aero_sorted%removal_rate_bounds_valid = .false.
151  aero_sorted%removal_rate_max = 0d0
152 
153  end subroutine aero_sorted_zero
154 
155 !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
156 
157  !> Returns the number of size bins.
158  integer function aero_sorted_n_bin(aero_sorted)
159 
160  !> Aerosol sorting to use.
161  type(aero_sorted_t), intent(in) :: aero_sorted
162 
163  aero_sorted_n_bin = size(aero_sorted%size_class%inverse, 1)
164 
165  end function aero_sorted_n_bin
166 
167 !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
168 
169  !> Returns the number of weight groups.
170  integer function aero_sorted_n_group(aero_sorted)
171 
172  !> Aerosol sorting to use.
173  type(aero_sorted_t), intent(in) :: aero_sorted
174 
175  aero_sorted_n_group = size(aero_sorted%group_class%inverse, 1)
176 
177  end function aero_sorted_n_group
178 
179 !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
180 
181  !> Returns the number of weight classes.
182  integer function aero_sorted_n_class(aero_sorted)
183 
184  !> Aerosol sorting to use.
185  type(aero_sorted_t), intent(in) :: aero_sorted
186 
187  aero_sorted_n_class = size(aero_sorted%size_class%inverse, 2)
188 
189  end function aero_sorted_n_class
190 
191 !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
192 
193  !> Do a sorting of a set of aerosol particles.
194  subroutine aero_sorted_set_bin_grid(aero_sorted, bin_grid, n_group, n_class)
195 
196  !> Aerosol sorted.
197  type(aero_sorted_t), intent(inout) :: aero_sorted
198  !> Bin grid.
199  type(bin_grid_t), intent(in) :: bin_grid
200  !> Number of weight groups.
201  integer, intent(in) :: n_group
202  !> Number of weight classes.
203  integer, intent(in) :: n_class
204 
205  call aero_sorted_deallocate(aero_sorted)
206  call aero_sorted_allocate_size(aero_sorted, bin_grid%n_bin, n_group, &
207  n_class)
208  call bin_grid_copy(bin_grid, aero_sorted%bin_grid)
209 
210  end subroutine aero_sorted_set_bin_grid
211 
212 !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
213 
214  !> Discard particles that don't fit the bin grid.
215  subroutine aero_sorted_discard_outside_grid(aero_sorted, &
216  aero_particle_array)
217 
218  !> Aerosol sorted.
219  type(aero_sorted_t), intent(in) :: aero_sorted
220  !> Aerosol particles to discard from.
221  type(aero_particle_array_t), intent(inout) :: aero_particle_array
222 
223  integer :: i_part, i_bin
224 
225  ! Work backwards so we only shift particles that we've already
226  ! tested.
227  do i_part = aero_particle_array%n_part,1,-1
228  i_bin = aero_sorted_particle_in_bin(aero_sorted, &
229  aero_particle_array%particle(i_part))
230  if ((i_bin < 1) .or. (i_bin > aero_sorted%bin_grid%n_bin)) then
231  call warn_msg(954800836, "particle ID " &
232  // trim(integer_to_string( &
233  aero_particle_array%particle(i_part)%id)) &
234  // " outside of bin_grid, discarding")
235  call aero_particle_array_remove_particle(aero_particle_array, &
236  i_part)
237  end if
238  end do
239 
240  end subroutine aero_sorted_discard_outside_grid
241 
242 !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
243 
244  !> Sort the particles.
245  subroutine aero_sorted_sort_particles(aero_sorted, aero_particle_array)
246 
247  !> Aerosol sorted.
248  type(aero_sorted_t), intent(inout) :: aero_sorted
249  !> Aerosol particles to sort.
250  type(aero_particle_array_t), intent(in) :: aero_particle_array
251 
252  integer :: i_part, i_bin, i_group, i_class
253 
254  call integer_rmap2_zero(aero_sorted%size_class)
255  call integer_rmap2_zero(aero_sorted%group_class)
256 
257  do i_part = 1,aero_particle_array%n_part
258  i_bin = aero_sorted_particle_in_bin(aero_sorted, &
259  aero_particle_array%particle(i_part))
260  i_group = aero_particle_array%particle(i_part)%weight_group
261  i_class = aero_particle_array%particle(i_part)%weight_class
262  call integer_rmap2_append(aero_sorted%size_class, i_bin, i_class)
263  call integer_rmap2_append(aero_sorted%group_class, i_group, i_class)
264  end do
265 
266  end subroutine aero_sorted_sort_particles
267 
268 !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
269 
270  !> Remake a sorting if particles are getting too close to the edges.
271  subroutine aero_sorted_remake_if_needed(aero_sorted, aero_particle_array, &
272  valid_sort, n_group, n_class, bin_grid, all_procs_same)
273 
274  !> Aerosol sorted to (possibly) remake.
275  type(aero_sorted_t), intent(inout) :: aero_sorted
276  !> Aerosol particles to sort.
277  type(aero_particle_array_t), intent(inout) :: aero_particle_array
278  !> Whether the given aero_sorted is valid.
279  logical, intent(in) :: valid_sort
280  !> Number of weight groups.
281  integer, optional, intent(in) :: n_group
282  !> Number of weight classes.
283  integer, optional, intent(in) :: n_class
284  !> An optional bin_grid to use for the sort.
285  type(bin_grid_t), optional, intent(in) :: bin_grid
286  !> Whether all processors should use the same bin grid.
287  logical, optional, intent(in) :: all_procs_same
288 
289  integer :: i_bin, i_bin_min, i_bin_max, i_part, n_bin, use_n_group
290  integer :: use_n_class
291  real(kind=dp) :: r, r_min, r_max, grid_r_min, grid_r_max
292  real(kind=dp) :: local_r_min, local_r_max
293  logical :: need_new_bin_grid
294  type(bin_grid_t) :: new_bin_grid
295 
296  if (present(n_group)) then
297  call assert(267881270, present(n_class))
298  use_n_group = n_group
299  use_n_class = n_class
300  else
301  call assert(352582858, valid_sort)
302  use_n_group = aero_sorted_n_group(aero_sorted)
303  use_n_class = aero_sorted_n_class(aero_sorted)
304  end if
305 
306  if (present(bin_grid)) then
307  call aero_sorted_set_bin_grid(aero_sorted, bin_grid, use_n_group, &
308  use_n_class)
309  call aero_sorted_discard_outside_grid(aero_sorted, aero_particle_array)
310  call aero_sorted_sort_particles(aero_sorted, aero_particle_array)
311  return
312  end if
313 
314  need_new_bin_grid = .false.
315 
316  ! determine r_min and r_max
317  r_min = 0d0
318  r_max = 0d0
319  if (valid_sort) then
320  ! use bin data to avoid looping over all particles
321  i_bin_min = 0
322  i_bin_max = 0
323  do i_bin = 1,aero_sorted%bin_grid%n_bin
324  if (sum(aero_sorted%size_class%inverse(i_bin, :)%n_entry) > 0) then
325  if (i_bin_min == 0) then
326  i_bin_min = i_bin
327  end if
328  i_bin_max = i_bin
329  end if
330  end do
331 
332  if (i_bin_min == 0) then
333  ! there aren't any particles
334  call assert(333430891, i_bin_max == 0)
335  if (aero_sorted%bin_grid%n_bin > 0) then
336  ! take r_min = upper edge, etc.
337  r_min = aero_sorted%bin_grid%edges(aero_sorted%bin_grid%n_bin + 1)
338  r_max = aero_sorted%bin_grid%edges(1)
339  end if
340  else
341  r_min = aero_sorted%bin_grid%edges(i_bin_min)
342  r_max = aero_sorted%bin_grid%edges(i_bin_max + 1)
343  end if
344  else
345  ! no bin data, need to loop over all particles
346  do i_part = 1,aero_particle_array%n_part
347  r = aero_particle_radius(aero_particle_array%particle(i_part))
348  if (i_part == 1) then
349  r_min = r
350  r_max = r
351  else
352  r_min = min(r_min, r)
353  r_max = max(r_max, r)
354  end if
355  end do
356  end if
357 
358  if (present(all_procs_same)) then
359  if (all_procs_same) then
360  ! take global min/max
361  local_r_max = r_max
362  call pmc_mpi_allreduce_max_real(local_r_max, r_max)
363  ! don't contaminate global min with zeros
364  if (r_min == 0d0) then
365  local_r_min = r_max
366  else
367  local_r_min = r_min
368  end if
369  call pmc_mpi_allreduce_min_real(local_r_min, r_min)
370 
371  ! check that all the bin grids are really the same
372  if (.not. pmc_mpi_allequal_bin_grid(aero_sorted%bin_grid)) then
373  need_new_bin_grid = .true.
374  end if
375  end if
376  end if
377 
378  ! no particles and no existing useful bin_grid
379  if (r_max == 0d0) then
380  if (valid_sort) return
381  call bin_grid_allocate(new_bin_grid)
382  call bin_grid_make(new_bin_grid, bin_grid_type_log, n_bin=0, min=0d0, &
383  max=0d0)
384  call aero_sorted_set_bin_grid(aero_sorted, new_bin_grid, use_n_group, &
385  use_n_class)
386  call bin_grid_deallocate(new_bin_grid)
387  return
388  end if
389 
390  if (aero_sorted%bin_grid%n_bin < 1) then
391  need_new_bin_grid = .true.
392  else
393  grid_r_min = aero_sorted%bin_grid%edges(1)
394  grid_r_max = aero_sorted%bin_grid%edges(aero_sorted%bin_grid%n_bin + 1)
395 
396  ! We don't check to see whether we could make the bin grid
397  ! smaller, as there doesn't seem much point. It would be easy
398  ! to add if desired.
399  if ((r_min / grid_r_min < aero_sorted_bin_safety_factor) &
400  .or. (grid_r_max / r_max < aero_sorted_bin_safety_factor)) then
401  need_new_bin_grid = .true.
402  end if
403  end if
404 
405  if (need_new_bin_grid) then
406  grid_r_min = r_min / aero_sorted_bin_over_factor
407  grid_r_max = r_max * aero_sorted_bin_over_factor
408  n_bin = ceiling((log10(grid_r_max) - log10(grid_r_min)) &
409  * aero_sorted_bins_per_decade)
410  call bin_grid_allocate(new_bin_grid)
411  call bin_grid_make(new_bin_grid, bin_grid_type_log, n_bin, grid_r_min, &
412  grid_r_max)
413  call aero_sorted_set_bin_grid(aero_sorted, new_bin_grid, use_n_group, &
414  use_n_class)
415  call bin_grid_deallocate(new_bin_grid)
416  call aero_sorted_sort_particles(aero_sorted, aero_particle_array)
417  else
418  if (.not. valid_sort) then
419  call aero_sorted_sort_particles(aero_sorted, aero_particle_array)
420  end if
421  end if
422 
423  end subroutine aero_sorted_remake_if_needed
424 
425 !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
426 
427  !> Find the bin number that contains a given particle.
428  integer function aero_sorted_particle_in_bin(aero_sorted, aero_particle)
429 
430  !> Aerosol sort.
431  type(aero_sorted_t), intent(in) :: aero_sorted
432  !> Particle.
433  type(aero_particle_t), intent(in) :: aero_particle
434 
435  aero_sorted_particle_in_bin = bin_grid_find(aero_sorted%bin_grid, &
436  aero_particle_radius(aero_particle))
437 
438  end function aero_sorted_particle_in_bin
439 
440 !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
441 
442  !> Add a new particle to both an aero_sorted and the corresponding
443  !> aero_particle_array.
444  subroutine aero_sorted_add_particle(aero_sorted, aero_particle_array, &
445  aero_particle, allow_resort)
446 
447  !> Sorted particle structure.
448  type(aero_sorted_t), intent(inout) :: aero_sorted
449  !> Aerosol particles.
450  type(aero_particle_array_t), intent(inout) :: aero_particle_array
451  !> Particle to add.
452  type(aero_particle_t), intent(in) :: aero_particle
453  !> Whether to allow a resort due to the add.
454  logical, optional, intent(in) :: allow_resort
455 
456  integer :: i_bin, i_group, i_class, n_bin, n_group, n_class
457 
458  i_bin = aero_sorted_particle_in_bin(aero_sorted, aero_particle)
459  i_group = aero_particle%weight_group
460  i_class = aero_particle%weight_class
461 
462  n_bin = aero_sorted%bin_grid%n_bin
463  n_group = aero_sorted_n_group(aero_sorted)
464  n_class = aero_sorted_n_class(aero_sorted)
465  call assert(417177855, (i_group >= 1) .and. (i_group <= n_group))
466  call assert(233133947, (i_class >= 1) .and. (i_class <= n_class))
467 
468  ! add the particle to the aero_particle_array
469  call aero_particle_array_add_particle(aero_particle_array, aero_particle)
470 
471  if ((i_bin < 1) .or. (i_bin > n_bin)) then
472  ! particle doesn't fit in the current bin_grid, so remake the
473  ! bin_grid if we are allowed
474  if (present(allow_resort)) then
475  if (.not. allow_resort) then
476  ! FIXME: this could be avoided if the new bin_grid was an
477  ! extension of the old one (only added bins, first bins
478  ! are the same)
479  call die_msg(134572570, "particle outside of bin_grid: " &
480  // "try reducing the timestep del_t")
481  end if
482  end if
483  call aero_sorted_remake_if_needed(aero_sorted, aero_particle_array, &
484  valid_sort=.false., n_group=n_group, n_class=n_class)
485  else
486  ! particle fits in the current bin_grid
487  call integer_rmap2_append(aero_sorted%size_class, i_bin, i_class)
488  call integer_rmap2_append(aero_sorted%group_class, i_group, i_class)
489  end if
490 
491  end subroutine aero_sorted_add_particle
492 
493 !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
494 
495  !> Remove a particle from both an aero_sorted and the corresponding
496  !> aero_particle_array.
497  subroutine aero_sorted_remove_particle(aero_sorted, aero_particle_array, &
498  i_part)
499 
500  !> Sorted particle structure.
501  type(aero_sorted_t), intent(inout) :: aero_sorted
502  !> Aerosol particles.
503  type(aero_particle_array_t), intent(inout) :: aero_particle_array
504  !> Index of particle to remove.
505  integer, intent(in) :: i_part
506 
507  ! all of these shift the last item into the newly-empty slot
508  call aero_particle_array_remove_particle(aero_particle_array, i_part)
509  call integer_rmap2_remove(aero_sorted%size_class, i_part)
510  call integer_rmap2_remove(aero_sorted%group_class, i_part)
511 
512  end subroutine aero_sorted_remove_particle
513 
514 !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
515 
516  !> Move a particle to a different bin and group.
517  subroutine aero_sorted_move_particle(aero_sorted, i_part, new_bin, &
518  new_group, new_class)
519 
520  !> Aerosol sorted.
521  type(aero_sorted_t), intent(inout) :: aero_sorted
522  !> Particle number to move.
523  integer, intent(in) :: i_part
524  !> New bin to move particle to.
525  integer, intent(in) :: new_bin
526  !> New weight group to move particle to.
527  integer, intent(in) :: new_group
528  !> New weight class to move particle to.
529  integer, intent(in) :: new_class
530 
531  call integer_rmap2_change(aero_sorted%size_class, i_part, new_bin, &
532  new_class)
533  call integer_rmap2_change(aero_sorted%group_class, i_part, new_group, &
534  new_class)
535 
536  end subroutine aero_sorted_move_particle
537 
538 !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
539 
540  !> Check sorting.
541  subroutine aero_sorted_check(aero_sorted, aero_particle_array, &
542  n_group, n_class, continue_on_error)
543 
544  !> Aerosol sorted to check.
545  type(aero_sorted_t), intent(in) :: aero_sorted
546  !> Aerosol particles.
547  type(aero_particle_array_t), intent(in) :: aero_particle_array
548  !> Number of weight groups.
549  integer, optional, intent(in) :: n_group
550  !> Number of weight classes.
551  integer, optional, intent(in) :: n_class
552  !> Whether to continue despite error.
553  logical, intent(in) :: continue_on_error
554 
555  integer :: i_part, i_bin
556 
557  call integer_rmap2_check(aero_sorted%size_class, "size_class", &
558  n_domain=aero_particle_array%n_part, &
559  n_range_1=aero_sorted%bin_grid%n_bin, n_range_2=n_class, &
560  continue_on_error=continue_on_error)
561  do i_part = 1,aero_particle_array%n_part
562  i_bin = aero_sorted_particle_in_bin(aero_sorted, &
563  aero_particle_array%particle(i_part))
564  if ((i_bin /= aero_sorted%size_class%forward1%entry(i_part)) &
565  .or. (i_bin /= aero_sorted%size_class%forward1%entry(i_part))) then
566  write(0,*) 'ERROR aero_sorted A: ', "size_class"
567  write(0,*) 'i_part', i_part
568  write(0,*) 'i_bin', i_bin
569  write(0,*) 'aero_sorted%size_class%forward1%entry(i_part)', &
570  aero_sorted%size_class%forward1%entry(i_part)
571  write(0,*) 'aero_sorted%size_class%forward2%entry(i_part)', &
572  aero_sorted%size_class%forward2%entry(i_part)
573  call assert(565030916, continue_on_error)
574  end if
575  end do
576 
577  call integer_rmap2_check(aero_sorted%group_class, "group_class", &
578  n_domain=aero_particle_array%n_part, &
579  n_range_1=n_group, n_range_2=n_class, &
580  continue_on_error=continue_on_error)
581  do i_part = 1,aero_particle_array%n_part
582  if ((aero_particle_array%particle(i_part)%weight_group &
583  /= aero_sorted%group_class%forward1%entry(i_part)) &
584  .or. (aero_particle_array%particle(i_part)%weight_class &
585  /= aero_sorted%group_class%forward2%entry(i_part))) then
586  write(0,*) 'ERROR aero_sorted B: ', "group_class"
587  write(0,*) 'i_part', i_part
588  write(0,*) 'aero_particle_array%particle(i_part)%weight_group', &
589  aero_particle_array%particle(i_part)%weight_group
590  write(0,*) 'aero_particle_array%particle(i_part)%weight_class', &
591  aero_particle_array%particle(i_part)%weight_class
592  write(0,*) 'aero_sorted%group_class%forward1%entry(i_part)', &
593  aero_sorted%group_class%forward1%entry(i_part)
594  write(0,*) 'aero_sorted%group_class%forward2%entry(i_part)', &
595  aero_sorted%group_class%forward2%entry(i_part)
596  call assert(803595412, continue_on_error)
597  end if
598  end do
599 
600  end subroutine aero_sorted_check
601 
602 !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
603 
604  !> Determines the number of bytes required to pack the given value.
605  integer function pmc_mpi_pack_size_aero_sorted(val)
606 
607  !> Value to pack.
608  type(aero_sorted_t), intent(in) :: val
609 
610  integer :: total_size
611 
612  total_size = 0
613  total_size = total_size + pmc_mpi_pack_size_integer(aero_sorted_n_bin(val))
614  total_size = total_size &
616  total_size = total_size &
618  total_size = total_size + pmc_mpi_pack_size_bin_grid(val%bin_grid)
619  total_size = total_size + pmc_mpi_pack_size_integer_rmap2(val%size_class)
620  total_size = total_size + pmc_mpi_pack_size_integer_rmap2(val%group_class)
621  pmc_mpi_pack_size_aero_sorted = total_size
622 
623  end function pmc_mpi_pack_size_aero_sorted
624 
625 !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
626 
627  !> Packs the given value into the buffer, advancing position.
628  subroutine pmc_mpi_pack_aero_sorted(buffer, position, val)
629 
630  !> Memory buffer.
631  character, intent(inout) :: buffer(:)
632  !> Current buffer position.
633  integer, intent(inout) :: position
634  !> Value to pack.
635  type(aero_sorted_t), intent(in) :: val
636 
637 #ifdef PMC_USE_MPI
638  integer :: prev_position
639 
640  prev_position = position
641  call pmc_mpi_pack_integer(buffer, position, aero_sorted_n_bin(val))
642  call pmc_mpi_pack_integer(buffer, position, aero_sorted_n_group(val))
643  call pmc_mpi_pack_integer(buffer, position, aero_sorted_n_class(val))
644  call pmc_mpi_pack_bin_grid(buffer, position, val%bin_grid)
645  call pmc_mpi_pack_integer_rmap2(buffer, position, val%size_class)
646  call pmc_mpi_pack_integer_rmap2(buffer, position, val%group_class)
647  call assert(786981367, &
648  position - prev_position <= pmc_mpi_pack_size_aero_sorted(val))
649 #endif
650 
651  end subroutine pmc_mpi_pack_aero_sorted
652 
653 !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
654 
655  !> Unpacks the given value from the buffer, advancing position.
656  subroutine pmc_mpi_unpack_aero_sorted(buffer, position, val)
657 
658  !> Memory buffer.
659  character, intent(inout) :: buffer(:)
660  !> Current buffer position.
661  integer, intent(inout) :: position
662  !> Value to pack.
663  type(aero_sorted_t), intent(inout) :: val
664 
665 #ifdef PMC_USE_MPI
666  integer :: prev_position, n_bin, n_group, n_class
667 
668  prev_position = position
669  call pmc_mpi_unpack_integer(buffer, position, n_bin)
670  call pmc_mpi_unpack_integer(buffer, position, n_group)
671  call pmc_mpi_unpack_integer(buffer, position, n_class)
672  call aero_sorted_deallocate(val)
673  call aero_sorted_allocate_size(val, n_bin, n_group, n_class)
674  call pmc_mpi_unpack_bin_grid(buffer, position, val%bin_grid)
675  call pmc_mpi_unpack_integer_rmap2(buffer, position, val%size_class)
676  call pmc_mpi_unpack_integer_rmap2(buffer, position, val%group_class)
677  call assert(703866072, &
678  position - prev_position <= pmc_mpi_pack_size_aero_sorted(val))
679 #endif
680 
681  end subroutine pmc_mpi_unpack_aero_sorted
682 
683 !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
684 
685 end module pmc_aero_sorted
The aero_sorted_t structure and assocated subroutines.
Definition: aero_sorted.F90:9
elemental subroutine integer_rmap2_allocate(integer_rmap2)
Allocates an empty structure.
integer function pmc_mpi_pack_size_integer_rmap2(val)
Determines the number of bytes required to pack the given value.
subroutine pmc_mpi_pack_integer_rmap2(buffer, position, val)
Packs the given value into the buffer, advancing position.
elemental subroutine integer_rmap2_allocate_size(integer_rmap2, n_range_1, n_range_2)
Allocates a structure with the given size.
elemental subroutine integer_rmap2_deallocate(integer_rmap2)
Deallocates a previously allocated structure.
subroutine aero_sorted_add_particle(aero_sorted, aero_particle_array, aero_particle, allow_resort)
Add a new particle to both an aero_sorted and the corresponding aero_particle_array.
integer function pmc_mpi_pack_size_integer(val)
Determines the number of bytes required to pack the given value.
Definition: mpi.F90:347
subroutine integer_rmap2_append(integer_rmap2, i_range_1, i_range_2)
Set the map value of the next free domain value to (i_range_1, i_range_2.
subroutine die_msg(code, error_msg)
Error immediately.
Definition: util.F90:133
1-D arrays of particles, used by aero_state to build a ragged array.
subroutine integer_rmap2_check(integer_rmap2, name, n_domain, n_range_1, n_range_2, continue_on_error)
Check that the data is consistent.
subroutine pmc_mpi_allreduce_min_real(val, val_min)
Computes the minimum of val across all processes, storing the result in val_min on all processes...
Definition: mpi.F90:1313
subroutine pmc_mpi_unpack_integer_rmap2(buffer, position, val)
Unpacks the given value from the buffer, advancing position.
subroutine aero_sorted_allocate_size(aero_sorted, n_bin, n_group, n_class)
Allocate a strcture with the given size.
Definition: aero_sorted.F90:96
The aero_particle_t structure and associated subroutines.
The integer_varray_t structure and assocated subroutines.
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:136
subroutine integer_rmap2_change(integer_rmap2, i_domain, i_range_1, i_range_2)
Change the map value of i_domain to (i_range_1, i_range_2).
integer function bin_grid_find(bin_grid, val)
Find the bin number that contains a given value.
Definition: bin_grid.F90:196
integer function pmc_mpi_pack_size_aero_sorted(val)
Determines the number of bytes required to pack the given value.
elemental real(kind=dp) function aero_particle_radius(aero_particle)
Total radius of the particle (m).
subroutine aero_sorted_remake_if_needed(aero_sorted, aero_particle_array, valid_sort, n_group, n_class, bin_grid, all_procs_same)
Remake a sorting if particles are getting too close to the edges.
subroutine pmc_mpi_unpack_aero_sorted(buffer, position, val)
Unpacks the given value from the buffer, advancing position.
The aero_particle_array_t structure and assoicated subroutines.
subroutine bin_grid_allocate(bin_grid)
Allocates a bin_grid.
Definition: bin_grid.F90:51
subroutine pmc_mpi_pack_integer(buffer, position, val)
Packs the given value into the buffer, advancing position.
Definition: mpi.F90:534
subroutine aero_sorted_check(aero_sorted, aero_particle_array, n_group, n_class, continue_on_error)
Check sorting.
subroutine aero_particle_array_add_particle(aero_particle_array, aero_particle)
Adds the given particle to the end of the array.
integer function aero_sorted_n_bin(aero_sorted)
Returns the number of size bins.
integer function pmc_mpi_pack_size_bin_grid(val)
Determines the number of bytes required to pack the given value.
Definition: bin_grid.F90:330
subroutine pmc_mpi_unpack_integer(buffer, position, val)
Unpacks the given value from the buffer, advancing position.
Definition: mpi.F90:771
logical function pmc_mpi_allequal_bin_grid(val)
Check whether all processors have the same value.
Definition: bin_grid.F90:401
subroutine aero_sorted_sort_particles(aero_sorted, aero_particle_array)
Sort the particles.
A map , together with its multi-valued inverse.
Wrapper functions for MPI.
Definition: mpi.F90:13
elemental subroutine integer_rmap2_zero(integer_rmap2)
Resets an integer_rmap2 to have zero particles per bin.
integer function aero_sorted_n_class(aero_sorted)
Returns the number of weight classes.
subroutine aero_sorted_move_particle(aero_sorted, i_part, new_bin, new_group, new_class)
Move a particle to a different bin and group.
subroutine aero_sorted_discard_outside_grid(aero_sorted, aero_particle_array)
Discard particles that don't fit the bin grid.
subroutine pmc_mpi_pack_aero_sorted(buffer, position, val)
Packs the given value into the buffer, advancing position.
subroutine aero_sorted_set_bin_grid(aero_sorted, bin_grid, n_group, n_class)
Do a sorting of a set of aerosol particles.
subroutine pmc_mpi_allreduce_max_real(val, val_max)
Computes the maximum of val across all processes, storing the result in val_max on all processes...
Definition: mpi.F90:1336
character(len=pmc_util_convert_string_len) function integer_to_string(val)
Convert an integer to a string format.
Definition: util.F90:743
subroutine aero_sorted_zero(aero_sorted)
Resets an aero_sorted to have zero particles per bin.
Single aerosol particle data structure.
1D grid, either logarithmic or linear.
Definition: bin_grid.F90:33
The bin_grid_t structure and associated subroutines.
Definition: bin_grid.F90:9
integer function aero_sorted_n_group(aero_sorted)
Returns the number of weight groups.
subroutine warn_msg(code, warning_msg, already_warned)
Prints a warning message.
Definition: util.F90:36
The integer_rmap_t structure and assocated subroutines.
Definition: integer_rmap.F90:9
Sorting of particles into bins.
Definition: aero_sorted.F90:46
subroutine aero_particle_array_remove_particle(aero_particle_array, index)
Removes the particle at the given index.
The integer_rmap2_t structure and assocated subroutines.
subroutine integer_rmap2_remove(integer_rmap2, i_domain)
Replace the map at the given i_domain with the map value of the last entry, and delete the last entry...
subroutine pmc_mpi_unpack_bin_grid(buffer, position, val)
Unpacks the given value from the buffer, advancing position.
Definition: bin_grid.F90:374
subroutine assert(code, condition_ok)
Errors unless condition_ok is true.
Definition: util.F90:102
subroutine bin_grid_copy(bin_grid_from, bin_grid_to)
Copies a bin grid.
Definition: bin_grid.F90:99
subroutine aero_sorted_allocate(aero_sorted)
Allocate an empty structure.
Definition: aero_sorted.F90:77
subroutine pmc_mpi_pack_bin_grid(buffer, position, val)
Packs the given value into the buffer, advancing position.
Definition: bin_grid.F90:347
subroutine bin_grid_deallocate(bin_grid)
Frees all memory.
Definition: bin_grid.F90:85
integer function aero_sorted_particle_in_bin(aero_sorted, aero_particle)
Find the bin number that contains a given particle.
subroutine aero_sorted_deallocate(aero_sorted)
Deallocates a previously allocated structure.
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.