PartMC
2.2.0
|
00001 ! Copyright (C) 2011 Nicole Riemer and Matthew West 00002 ! Licensed under the GNU General Public License version 2 or (at your 00003 ! option) any later version. See the file COPYING for details. 00004 00005 !> \file 00006 !> The pmc_aero_sorted module. 00007 00008 !> The aero_sorted_t structure and assocated subroutines. 00009 module pmc_aero_sorted 00010 00011 use pmc_integer_varray 00012 use pmc_integer_rmap 00013 use pmc_aero_particle 00014 use pmc_aero_particle_array 00015 use pmc_bin_grid 00016 use pmc_mpi 00017 00018 !> Bin index for particles sorted into bins. 00019 !! 00020 !! Both forward and reverse indexes are maintained. Particles are 00021 !! stored with both a linear index \c i_part, and binned indexes 00022 !! <tt>(i_bin, i_entry)</tt>, indicating that the particle is number 00023 !! \c i_entry in bin number \c i_bin. The forward index satisfies 00024 !! \code 00025 !! i_part = aero_sorted%bin(i_bin)%entry(i_part) 00026 !! \endcode 00027 !! while the reverse index satisfies 00028 !! \code 00029 !! i_bin = aero_sorted%reverse_bin%entry(i_part) 00030 !! i_entry = aero_sorted%reverse_entry%entry(i_part) 00031 !! \endcode 00032 type aero_sorted_t 00033 !> Bin grid for sorting. 00034 type(bin_grid_t) :: bin_grid 00035 !> Map of size bin numbers. 00036 type(integer_rmap_t) :: size 00037 !> Map of weight group numbers. 00038 type(integer_rmap_t) :: weight 00039 !> Whether coagulation kernel bounds are valid. 00040 logical :: coag_kernel_bounds_valid 00041 !> Coagulation kernel lower bound. 00042 real(kind=dp), allocatable, dimension(:,:) :: coag_kernel_min 00043 !> Coagulation kernel upper bound. 00044 real(kind=dp), allocatable, dimension(:,:) :: coag_kernel_max 00045 end type aero_sorted_t 00046 00047 !> How many size bins to use per decade of particle radius. 00048 real(kind=dp), parameter :: AERO_SORTED_BINS_PER_DECADE = 10d0 00049 !> Factor to extend size grid beyond largest/smallest particles. 00050 real(kind=dp), parameter :: AERO_SORTED_BIN_OVER_FACTOR = 10d0 00051 !> Size grid extension factor when we should regenerate grid. 00052 real(kind=dp), parameter :: AERO_SORTED_BIN_SAFETY_FACTOR = 3d0 00053 00054 contains 00055 00056 !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! 00057 00058 !> Allocate an empty structure. 00059 subroutine aero_sorted_allocate(aero_sorted) 00060 00061 !> Structure to initialize. 00062 type(aero_sorted_t), intent(out) :: aero_sorted 00063 00064 call bin_grid_allocate(aero_sorted%bin_grid) 00065 call integer_rmap_allocate(aero_sorted%size) 00066 call integer_rmap_allocate(aero_sorted%weight) 00067 aero_sorted%coag_kernel_bounds_valid = .false. 00068 allocate(aero_sorted%coag_kernel_min(0,0)) 00069 allocate(aero_sorted%coag_kernel_max(0,0)) 00070 00071 end subroutine aero_sorted_allocate 00072 00073 !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! 00074 00075 !> Allocate a strcture with the given size. 00076 subroutine aero_sorted_allocate_size(aero_sorted, n_bin, n_group) 00077 00078 !> Structure to initialize. 00079 type(aero_sorted_t), intent(out) :: aero_sorted 00080 !> Number of bins. 00081 integer, intent(in) :: n_bin 00082 !> Number of weight groups. 00083 integer, intent(in) :: n_group 00084 00085 call bin_grid_allocate_size(aero_sorted%bin_grid, n_bin) 00086 call integer_rmap_allocate_size(aero_sorted%size, n_bin) 00087 call integer_rmap_allocate_size(aero_sorted%weight, n_group) 00088 aero_sorted%coag_kernel_bounds_valid = .false. 00089 allocate(aero_sorted%coag_kernel_min(n_bin, n_bin)) 00090 allocate(aero_sorted%coag_kernel_max(n_bin, n_bin)) 00091 00092 end subroutine aero_sorted_allocate_size 00093 00094 !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! 00095 00096 !> Deallocates a previously allocated structure. 00097 subroutine aero_sorted_deallocate(aero_sorted) 00098 00099 !> Structure to deallocate. 00100 type(aero_sorted_t), intent(inout) :: aero_sorted 00101 00102 call bin_grid_deallocate(aero_sorted%bin_grid) 00103 call integer_rmap_deallocate(aero_sorted%size) 00104 call integer_rmap_deallocate(aero_sorted%weight) 00105 aero_sorted%coag_kernel_bounds_valid = .false. 00106 deallocate(aero_sorted%coag_kernel_min) 00107 deallocate(aero_sorted%coag_kernel_max) 00108 00109 end subroutine aero_sorted_deallocate 00110 00111 !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! 00112 00113 !> Resets an aero_sorted to have zero particles per bin. 00114 subroutine aero_sorted_zero(aero_sorted) 00115 00116 !> Structure to zero. 00117 type(aero_sorted_t), intent(inout) :: aero_sorted 00118 00119 call integer_rmap_zero(aero_sorted%size) 00120 call integer_rmap_zero(aero_sorted%weight) 00121 aero_sorted%coag_kernel_bounds_valid = .false. 00122 aero_sorted%coag_kernel_min = 0d0 00123 aero_sorted%coag_kernel_max = 0d0 00124 00125 end subroutine aero_sorted_zero 00126 00127 !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! 00128 00129 !> Do a sorting of a set of aerosol particles. 00130 subroutine aero_sorted_set_bin_grid(aero_sorted, bin_grid, n_group) 00131 00132 !> Aerosol sorted. 00133 type(aero_sorted_t), intent(inout) :: aero_sorted 00134 !> Bin grid. 00135 type(bin_grid_t), intent(in) :: bin_grid 00136 !> Number of weight groups. 00137 integer, optional, intent(in) :: n_group 00138 00139 integer :: use_n_group 00140 00141 if (present(n_group)) then 00142 use_n_group = n_group 00143 else 00144 use_n_group = size(aero_sorted%weight%inverse) 00145 end if 00146 call aero_sorted_deallocate(aero_sorted) 00147 call aero_sorted_allocate_size(aero_sorted, bin_grid%n_bin, use_n_group) 00148 call bin_grid_copy(bin_grid, aero_sorted%bin_grid) 00149 00150 end subroutine aero_sorted_set_bin_grid 00151 00152 !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! 00153 00154 !> Discard particles that don't fit the bin grid. 00155 subroutine aero_sorted_discard_outside_grid(aero_sorted, & 00156 aero_particle_array) 00157 00158 !> Aerosol sorted. 00159 type(aero_sorted_t), intent(in) :: aero_sorted 00160 !> Aerosol particles to discard from. 00161 type(aero_particle_array_t), intent(inout) :: aero_particle_array 00162 00163 integer :: i_part, i_bin 00164 00165 ! Work backwards so we only shift particles that we've already 00166 ! tested. 00167 do i_part = aero_particle_array%n_part,1,-1 00168 i_bin = aero_sorted_particle_in_bin(aero_sorted, & 00169 aero_particle_array%particle(i_part)) 00170 if ((i_bin < 1) .or. (i_bin > aero_sorted%bin_grid%n_bin)) then 00171 call warn_msg(954800836, "particle ID " & 00172 // trim(integer_to_string( & 00173 aero_particle_array%particle(i_part)%id)) & 00174 // " outside of bin_grid, discarding") 00175 call aero_particle_array_remove_particle(aero_particle_array, & 00176 i_part) 00177 end if 00178 end do 00179 00180 end subroutine aero_sorted_discard_outside_grid 00181 00182 !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! 00183 00184 !> Sort the particles. 00185 subroutine aero_sorted_sort_particles(aero_sorted, aero_particle_array) 00186 00187 !> Aerosol sorted. 00188 type(aero_sorted_t), intent(inout) :: aero_sorted 00189 !> Aerosol particles to sort. 00190 type(aero_particle_array_t), intent(in) :: aero_particle_array 00191 00192 integer :: i_part, i_bin, i_group 00193 00194 call integer_rmap_zero(aero_sorted%size) 00195 call integer_rmap_zero(aero_sorted%weight) 00196 00197 do i_part = 1,aero_particle_array%n_part 00198 i_bin = aero_sorted_particle_in_bin(aero_sorted, & 00199 aero_particle_array%particle(i_part)) 00200 call integer_rmap_append(aero_sorted%size, i_bin) 00201 00202 i_group = aero_particle_array%particle(i_part)%weight_group 00203 call integer_rmap_append(aero_sorted%weight, i_group) 00204 end do 00205 00206 end subroutine aero_sorted_sort_particles 00207 00208 !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! 00209 00210 !> Remake a sorting if particles are getting too close to the edges. 00211 subroutine aero_sorted_remake_if_needed(aero_sorted, aero_particle_array, & 00212 valid_sort, n_group, bin_grid, all_procs_same) 00213 00214 !> Aerosol sorted to (possibly) remake. 00215 type(aero_sorted_t), intent(inout) :: aero_sorted 00216 !> Aerosol particles to sort. 00217 type(aero_particle_array_t), intent(inout) :: aero_particle_array 00218 !> Whether the given aero_sorted is valid. 00219 logical, intent(in) :: valid_sort 00220 !> Number of weight groups. 00221 integer, optional, intent(in) :: n_group 00222 !> An optional bin_grid to use for the sort. 00223 type(bin_grid_t), optional, intent(in) :: bin_grid 00224 !> Whether all processors should use the same bin grid. 00225 logical, optional, intent(in) :: all_procs_same 00226 00227 integer :: i_bin, i_bin_min, i_bin_max, i_part, n_bin 00228 real(kind=dp) :: r, r_min, r_max, grid_r_min, grid_r_max 00229 real(kind=dp) :: local_r_min, local_r_max 00230 logical :: need_new_bin_grid 00231 type(bin_grid_t) :: new_bin_grid 00232 00233 call assert(886415045, present(n_group) .or. valid_sort) 00234 00235 if (present(bin_grid)) then 00236 call aero_sorted_set_bin_grid(aero_sorted, bin_grid, n_group) 00237 call aero_sorted_discard_outside_grid(aero_sorted, aero_particle_array) 00238 call aero_sorted_sort_particles(aero_sorted, aero_particle_array) 00239 return 00240 end if 00241 00242 if (aero_particle_array%n_part == 0) then 00243 call assert(274242189, pmc_mpi_size() == 1) 00244 ! FIXME: this breaks on MPI: what if some procs have no 00245 ! particles and some do? 00246 call bin_grid_allocate(new_bin_grid) 00247 call bin_grid_make(new_bin_grid, n_bin=0, r_min=0d0, r_max=0d0) 00248 call aero_sorted_set_bin_grid(aero_sorted, new_bin_grid, n_group) 00249 call bin_grid_deallocate(new_bin_grid) 00250 return 00251 end if 00252 00253 need_new_bin_grid = .false. 00254 00255 ! determine r_min and r_max 00256 r_min = 0d0 00257 r_max = 0d0 00258 if (valid_sort) then 00259 ! use bin data to avoid looping over all particles 00260 i_bin_min = 0 00261 i_bin_max = 0 00262 do i_bin = 1,aero_sorted%bin_grid%n_bin 00263 if (aero_sorted%size%inverse(i_bin)%n_entry > 0) then 00264 if (i_bin_min == 0) then 00265 i_bin_min = i_bin 00266 end if 00267 i_bin_max = i_bin 00268 end if 00269 end do 00270 00271 if (i_bin_min == 0) then 00272 ! there are't any particles, take r_min = upper edge, etc. 00273 call assert(333430891, i_bin_max == 0) 00274 r_min = aero_sorted%bin_grid%edge_radius( & 00275 aero_sorted%bin_grid%n_bin + 1) 00276 r_max = aero_sorted%bin_grid%edge_radius(1) 00277 else 00278 r_min = aero_sorted%bin_grid%edge_radius(i_bin_min) 00279 r_max = aero_sorted%bin_grid%edge_radius(i_bin_max + 1) 00280 end if 00281 else 00282 ! no bin data, need to loop over all particles 00283 do i_part = 1,aero_particle_array%n_part 00284 r = aero_particle_radius(aero_particle_array%particle(i_part)) 00285 if (i_part == 1) then 00286 r_min = r 00287 r_max = r 00288 else 00289 r_min = min(r_min, r) 00290 r_max = max(r_max, r) 00291 end if 00292 end do 00293 end if 00294 00295 if (present(all_procs_same)) then 00296 if (all_procs_same) then 00297 ! take global min/max 00298 local_r_min = r_min 00299 local_r_max = r_max 00300 call assert(146323278, r_min > 0d0) ! FIXME: not true if some 00301 call assert(539388373, r_max > 0d0) ! procs have no particles 00302 call pmc_mpi_allreduce_min_real(local_r_min, r_min) 00303 call pmc_mpi_allreduce_max_real(local_r_max, r_max) 00304 00305 ! check that all the bin grids are really the same 00306 if (.not. pmc_mpi_allequal_bin_grid(aero_sorted%bin_grid)) then 00307 need_new_bin_grid = .true. 00308 end if 00309 end if 00310 end if 00311 00312 if (aero_sorted%bin_grid%n_bin < 1) then 00313 need_new_bin_grid = .true. 00314 else 00315 grid_r_min = aero_sorted%bin_grid%edge_radius(1) 00316 grid_r_max & 00317 = aero_sorted%bin_grid%edge_radius(aero_sorted%bin_grid%n_bin + 1) 00318 00319 ! We don't check to see whether we could make the bin grid 00320 ! smaller, as there doesn't seem much point. It would be easy 00321 ! to add if desired. 00322 if ((r_min / grid_r_min < AERO_SORTED_BIN_SAFETY_FACTOR) & 00323 .or. (grid_r_max / r_max < AERO_SORTED_BIN_SAFETY_FACTOR)) then 00324 need_new_bin_grid = .true. 00325 end if 00326 end if 00327 00328 if (need_new_bin_grid) then 00329 grid_r_min = r_min / AERO_SORTED_BIN_OVER_FACTOR 00330 grid_r_max = r_max * AERO_SORTED_BIN_OVER_FACTOR 00331 n_bin = ceiling((log10(grid_r_max) - log10(grid_r_min)) & 00332 * AERO_SORTED_BINS_PER_DECADE) 00333 call bin_grid_allocate(new_bin_grid) 00334 call bin_grid_make(new_bin_grid, n_bin, grid_r_min, grid_r_max) 00335 call aero_sorted_set_bin_grid(aero_sorted, new_bin_grid, n_group) 00336 call bin_grid_deallocate(new_bin_grid) 00337 call aero_sorted_sort_particles(aero_sorted, aero_particle_array) 00338 else 00339 if (.not. valid_sort) then 00340 call aero_sorted_sort_particles(aero_sorted, aero_particle_array) 00341 end if 00342 end if 00343 00344 end subroutine aero_sorted_remake_if_needed 00345 00346 !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! 00347 00348 !> Find the bin number that contains a given particle. 00349 integer function aero_sorted_particle_in_bin(aero_sorted, aero_particle) 00350 00351 !> Aerosol sort. 00352 type(aero_sorted_t), intent(in) :: aero_sorted 00353 !> Particle. 00354 type(aero_particle_t), intent(in) :: aero_particle 00355 00356 aero_sorted_particle_in_bin & 00357 = bin_grid_particle_in_bin(aero_sorted%bin_grid, & 00358 aero_particle_radius(aero_particle)) 00359 00360 end function aero_sorted_particle_in_bin 00361 00362 !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! 00363 00364 !> Add a new particle to both an aero_sorted and the corresponding 00365 !> aero_particle_array. 00366 subroutine aero_sorted_add_particle(aero_sorted, aero_particle_array, & 00367 aero_particle, n_group, allow_resort) 00368 00369 !> Sorted particle structure. 00370 type(aero_sorted_t), intent(inout) :: aero_sorted 00371 !> Aerosol particles. 00372 type(aero_particle_array_t), intent(inout) :: aero_particle_array 00373 !> Particle to add. 00374 type(aero_particle_t), intent(in) :: aero_particle 00375 !> Number of weight groups. 00376 integer, intent(in) :: n_group 00377 !> Whether to allow a resort due to the add. 00378 logical, optional, intent(in) :: allow_resort 00379 00380 integer :: i_bin, i_group 00381 00382 i_bin = aero_sorted_particle_in_bin(aero_sorted, aero_particle) 00383 i_group = aero_particle%weight_group 00384 00385 call assert(894889664, i_group >= 1) 00386 call assert(517084587, i_group <= size(aero_sorted%weight%inverse)) 00387 00388 ! add the particle to the aero_particle_array 00389 call aero_particle_array_add_particle(aero_particle_array, aero_particle) 00390 00391 if ((i_bin < 1) .or. (i_bin > aero_sorted%bin_grid%n_bin)) then 00392 ! particle doesn't fit in the current bin_grid, so remake the 00393 ! bin_grid if we are allowed 00394 if (present(allow_resort)) then 00395 if (.not. allow_resort) then 00396 ! FIXME: this could be avoided if the new bin_grid was an 00397 ! extension of the old one (only added bins, first bins 00398 ! are the same) 00399 call die_msg(134572570, "particle outside of bin_grid: " & 00400 // "try reducing the timestep del_t") 00401 end if 00402 end if 00403 call aero_sorted_remake_if_needed(aero_sorted, aero_particle_array, & 00404 valid_sort=.false., n_group=n_group) 00405 else 00406 ! particle fits in the current bin_grid 00407 call integer_rmap_append(aero_sorted%size, i_bin) 00408 call integer_rmap_append(aero_sorted%weight, i_group) 00409 end if 00410 00411 end subroutine aero_sorted_add_particle 00412 00413 !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! 00414 00415 !> Remove a particle from both an aero_sorted and the corresponding 00416 !> aero_particle_array. 00417 subroutine aero_sorted_remove_particle(aero_sorted, aero_particle_array, & 00418 i_part) 00419 00420 !> Sorted particle structure. 00421 type(aero_sorted_t), intent(inout) :: aero_sorted 00422 !> Aerosol particles. 00423 type(aero_particle_array_t), intent(inout) :: aero_particle_array 00424 !> Index of particle to remove. 00425 integer, intent(in) :: i_part 00426 00427 ! all of these shift the last item into the newly-empty slot 00428 call aero_particle_array_remove_particle(aero_particle_array, i_part) 00429 call integer_rmap_remove(aero_sorted%size, i_part) 00430 call integer_rmap_remove(aero_sorted%weight, i_part) 00431 00432 end subroutine aero_sorted_remove_particle 00433 00434 !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! 00435 00436 !> Move a particle to a different bin and group. 00437 subroutine aero_sorted_move_particle(aero_sorted, i_part, new_bin, new_group) 00438 00439 !> Aerosol sorted. 00440 type(aero_sorted_t), intent(inout) :: aero_sorted 00441 !> Particle number to move. 00442 integer, intent(in) :: i_part 00443 !> New bin to move particle to. 00444 integer, intent(in) :: new_bin 00445 !> New group to move particle to. 00446 integer, intent(in) :: new_group 00447 00448 call integer_rmap_change(aero_sorted%size, i_part, new_bin) 00449 call integer_rmap_change(aero_sorted%weight, i_part, new_group) 00450 00451 end subroutine aero_sorted_move_particle 00452 00453 !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! 00454 00455 !> Check sorting. 00456 subroutine aero_sorted_check(aero_sorted, aero_particle_array, & 00457 n_group, continue_on_error) 00458 00459 !> Aerosol sorted to check. 00460 type(aero_sorted_t), intent(in) :: aero_sorted 00461 !> Aerosol particles. 00462 type(aero_particle_array_t), intent(in) :: aero_particle_array 00463 !> Number of weight groups. 00464 integer, optional, intent(in) :: n_group 00465 !> Whether to continue despite error. 00466 logical, intent(in) :: continue_on_error 00467 00468 integer :: i_part, i_bin 00469 00470 call integer_rmap_check(aero_sorted%size, "size", & 00471 n_domain=aero_particle_array%n_part, & 00472 n_range=aero_sorted%bin_grid%n_bin, & 00473 continue_on_error=continue_on_error) 00474 do i_part = 1,aero_particle_array%n_part 00475 i_bin = aero_sorted_particle_in_bin(aero_sorted, & 00476 aero_particle_array%particle(i_part)) 00477 if (i_bin /= aero_sorted%size%forward%entry(i_part)) then 00478 write(0,*) 'ERROR aero_sorted A: ', "size" 00479 write(0,*) 'i_part', i_part 00480 write(0,*) 'i_bin', i_bin 00481 write(0,*) 'aero_sorted%size%forward%entry(i_part)', & 00482 aero_sorted%size%forward%entry(i_part) 00483 call assert(553067208, continue_on_error) 00484 end if 00485 end do 00486 00487 call integer_rmap_check(aero_sorted%weight, "weight", & 00488 n_domain=aero_particle_array%n_part, & 00489 n_range=n_group, & 00490 continue_on_error=continue_on_error) 00491 do i_part = 1,aero_particle_array%n_part 00492 if (aero_particle_array%particle(i_part)%weight_group & 00493 /= aero_sorted%weight%forward%entry(i_part)) then 00494 write(0,*) 'ERROR aero_sorted B: ', "group" 00495 write(0,*) 'i_part', i_part 00496 write(0,*) 'aero_particle_array%particle(i_part)%weight_group', & 00497 aero_particle_array%particle(i_part)%weight_group 00498 write(0,*) 'aero_sorted%weight%forward%entry(i_part)', & 00499 aero_sorted%weight%forward%entry(i_part) 00500 call assert(389482223, continue_on_error) 00501 end if 00502 end do 00503 00504 end subroutine aero_sorted_check 00505 00506 !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! 00507 00508 !> Determines the number of bytes required to pack the given value. 00509 integer function pmc_mpi_pack_size_aero_sorted(val) 00510 00511 !> Value to pack. 00512 type(aero_sorted_t), intent(in) :: val 00513 00514 integer :: total_size 00515 00516 total_size = 0 00517 total_size = total_size & 00518 + pmc_mpi_pack_size_integer(size(val%size%inverse)) 00519 total_size = total_size & 00520 + pmc_mpi_pack_size_integer(size(val%weight%inverse)) 00521 total_size = total_size + pmc_mpi_pack_size_bin_grid(val%bin_grid) 00522 total_size = total_size + pmc_mpi_pack_size_integer_rmap(val%size) 00523 total_size = total_size + pmc_mpi_pack_size_integer_rmap(val%weight) 00524 pmc_mpi_pack_size_aero_sorted = total_size 00525 00526 end function pmc_mpi_pack_size_aero_sorted 00527 00528 !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! 00529 00530 !> Packs the given value into the buffer, advancing position. 00531 subroutine pmc_mpi_pack_aero_sorted(buffer, position, val) 00532 00533 !> Memory buffer. 00534 character, intent(inout) :: buffer(:) 00535 !> Current buffer position. 00536 integer, intent(inout) :: position 00537 !> Value to pack. 00538 type(aero_sorted_t), intent(in) :: val 00539 00540 #ifdef PMC_USE_MPI 00541 integer :: prev_position 00542 00543 prev_position = position 00544 call pmc_mpi_pack_integer(buffer, position, size(val%size%inverse)) 00545 call pmc_mpi_pack_integer(buffer, position, size(val%weight%inverse)) 00546 call pmc_mpi_pack_bin_grid(buffer, position, val%bin_grid) 00547 call pmc_mpi_pack_integer_rmap(buffer, position, val%size) 00548 call pmc_mpi_pack_integer_rmap(buffer, position, val%weight) 00549 call assert(178297816, & 00550 position - prev_position <= pmc_mpi_pack_size_aero_sorted(val)) 00551 #endif 00552 00553 end subroutine pmc_mpi_pack_aero_sorted 00554 00555 !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! 00556 00557 !> Unpacks the given value from the buffer, advancing position. 00558 subroutine pmc_mpi_unpack_aero_sorted(buffer, position, val) 00559 00560 !> Memory buffer. 00561 character, intent(inout) :: buffer(:) 00562 !> Current buffer position. 00563 integer, intent(inout) :: position 00564 !> Value to pack. 00565 type(aero_sorted_t), intent(inout) :: val 00566 00567 #ifdef PMC_USE_MPI 00568 integer :: prev_position, n_bin, n_group 00569 00570 prev_position = position 00571 call pmc_mpi_unpack_integer(buffer, position, n_bin) 00572 call pmc_mpi_unpack_integer(buffer, position, n_group) 00573 call aero_sorted_deallocate(val) 00574 call aero_sorted_allocate_size(val, n_bin, n_group) 00575 call pmc_mpi_unpack_bin_grid(buffer, position, val%bin_grid) 00576 call pmc_mpi_unpack_integer_rmap(buffer, position, val%size) 00577 call pmc_mpi_unpack_integer_rmap(buffer, position, val%weight) 00578 call assert(364064630, & 00579 position - prev_position <= pmc_mpi_pack_size_aero_sorted(val)) 00580 #endif 00581 00582 end subroutine pmc_mpi_unpack_aero_sorted 00583 00584 !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! 00585 00586 end module pmc_aero_sorted