PartMC 2.1.4
|
00001 ! Copyright (C) 2005-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_particle_array module. 00007 00008 !> The aero_particle_array_t structure and assoicated subroutines. 00009 module pmc_aero_particle_array 00010 00011 use pmc_aero_particle 00012 use pmc_util 00013 use pmc_spec_file 00014 use pmc_mpi 00015 #ifdef PMC_USE_MPI 00016 use mpi 00017 #endif 00018 00019 !> 1-D arrays of particles, used by aero_state to build a ragged 00020 !> array. 00021 !! 00022 !! One aero_particle_array is generally a list of particles in a 00023 !! single size bin, but the basic type can be used for any list of 00024 !! particles. 00025 !! 00026 !! To give a reasonable tradeoff between frequent re-allocs and 00027 !! memory usage, the length of an aero_particle_array is generally a 00028 !! bit longer than the number of particles stored in it. When the 00029 !! array is full then a larger array is allocated with new extra 00030 !! space. As a balance between memory usage and frequency of 00031 !! re-allocs the length of the array is currently doubled when 00032 !! necessary and halved when possible. 00033 !! 00034 !! The true allocated length of the aero_particle_array can be 00035 !! obtained by size(aero_particle_array%%particle), while the number 00036 !! of used particle slots in it is given by 00037 !! aero_particle_array%%n_part. It must be that 00038 !! aero_particle_array%%n_part is less than or equal to 00039 !! size(aero_particle_array%%particle). 00040 type aero_particle_array_t 00041 !> Number of particles. 00042 integer :: n_part 00043 !> Number of species. 00044 integer :: n_spec 00045 !> Number of sources. 00046 integer :: n_source 00047 !> Particle array. 00048 type(aero_particle_t), pointer :: particle(:) 00049 end type aero_particle_array_t 00050 00051 contains 00052 00053 !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! 00054 00055 !> Allocates and initializes. 00056 subroutine aero_particle_array_allocate(aero_particle_array) 00057 00058 !> Result. 00059 type(aero_particle_array_t), intent(out) :: aero_particle_array 00060 00061 aero_particle_array%n_part = 0 00062 aero_particle_array%n_spec = 0 00063 aero_particle_array%n_source = 0 00064 allocate(aero_particle_array%particle(0)) 00065 00066 end subroutine aero_particle_array_allocate 00067 00068 !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! 00069 00070 !> Allocates and initializes to the given size. 00071 subroutine aero_particle_array_allocate_size(aero_particle_array, & 00072 n_part, n_spec, n_source) 00073 00074 !> Result. 00075 type(aero_particle_array_t), intent(out) :: aero_particle_array 00076 !> Number of particles. 00077 integer, intent(in) :: n_part 00078 !> Number of species. 00079 integer, intent(in) :: n_spec 00080 !> Number of sources. 00081 integer, intent(in) :: n_source 00082 00083 integer :: i 00084 00085 aero_particle_array%n_part = n_part 00086 aero_particle_array%n_spec = n_spec 00087 aero_particle_array%n_source = n_source 00088 allocate(aero_particle_array%particle(n_part)) 00089 do i = 1,n_part 00090 call aero_particle_allocate_size(aero_particle_array%particle(i), & 00091 n_spec, n_source) 00092 end do 00093 00094 end subroutine aero_particle_array_allocate_size 00095 00096 !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! 00097 00098 !> Deallocates. 00099 subroutine aero_particle_array_deallocate(aero_particle_array) 00100 00101 !> Structure to deallocate. 00102 type(aero_particle_array_t), intent(inout) :: aero_particle_array 00103 00104 integer :: i 00105 00106 do i = 1,aero_particle_array%n_part 00107 call aero_particle_deallocate(aero_particle_array%particle(i)) 00108 end do 00109 deallocate(aero_particle_array%particle) 00110 00111 end subroutine aero_particle_array_deallocate 00112 00113 !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! 00114 00115 !> Copies aero_particle_array_from to aero_particle_array_to, both 00116 !> of which must already be allocated. 00117 subroutine aero_particle_array_copy(aero_particle_array_from, & 00118 aero_particle_array_to) 00119 00120 !> Origin structure. 00121 type(aero_particle_array_t), intent(in) :: aero_particle_array_from 00122 !> Destination structure. 00123 type(aero_particle_array_t), intent(inout) :: aero_particle_array_to 00124 00125 integer :: i 00126 00127 call aero_particle_array_deallocate(aero_particle_array_to) 00128 call aero_particle_array_allocate_size(aero_particle_array_to, & 00129 aero_particle_array_from%n_part, aero_particle_array_from%n_spec, & 00130 aero_particle_array_from%n_source) 00131 do i = 1,aero_particle_array_from%n_part 00132 call aero_particle_copy(aero_particle_array_from%particle(i), & 00133 aero_particle_array_to%particle(i)) 00134 end do 00135 00136 end subroutine aero_particle_array_copy 00137 00138 !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! 00139 00140 !> Resets an aero_particle_array to contain zero particles. 00141 subroutine aero_particle_array_zero(aero_particle_array) 00142 00143 !> Structure to reset. 00144 type(aero_particle_array_t), intent(inout) :: aero_particle_array 00145 00146 call aero_particle_array_deallocate(aero_particle_array) 00147 allocate(aero_particle_array%particle(0)) 00148 aero_particle_array%n_part = 0 00149 00150 end subroutine aero_particle_array_zero 00151 00152 !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! 00153 00154 !> Changes the given aero_particle_array to exactly the given 00155 !> new_length. 00156 !! 00157 !! This function should not be called directly, but rather use 00158 !! aero_particle_array_enlarge(), aero_particle_array_enlarge_to() 00159 !! or aero_particle_array_shrink(). 00160 subroutine aero_particle_array_realloc(aero_particle_array, new_length) 00161 00162 !> Array to reallocate (must already be allocated on entry). 00163 type(aero_particle_array_t), intent(inout) :: aero_particle_array 00164 !> New length of the array. 00165 integer, intent(in) :: new_length 00166 00167 integer :: n_part, i 00168 type(aero_particle_t), pointer :: new_particles(:) 00169 00170 n_part = aero_particle_array%n_part 00171 call assert(867444847, new_length >= n_part) 00172 allocate(new_particles(new_length)) 00173 do i = 1,aero_particle_array%n_part 00174 call aero_particle_shift(aero_particle_array%particle(i), & 00175 new_particles(i)) 00176 end do 00177 deallocate(aero_particle_array%particle) 00178 aero_particle_array%particle => new_particles 00179 00180 end subroutine aero_particle_array_realloc 00181 00182 !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! 00183 00184 !> Enlarges the given aero_particle_array by at least one element 00185 !! 00186 !! Currently this doubles the length. 00187 subroutine aero_particle_array_enlarge(aero_particle_array) 00188 00189 !> Array to enlarge. 00190 type(aero_particle_array_t), intent(inout) :: aero_particle_array 00191 00192 integer :: length, new_length 00193 00194 length = size(aero_particle_array%particle) 00195 new_length = max(length * 2, length + 1) 00196 call aero_particle_array_realloc(aero_particle_array, new_length) 00197 00198 end subroutine aero_particle_array_enlarge 00199 00200 !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! 00201 00202 !> Enlarges the given array so that it is at least of size n. 00203 subroutine aero_particle_array_enlarge_to(aero_particle_array, n) 00204 00205 !> Array to enlarge. 00206 type(aero_particle_array_t), intent(inout) :: aero_particle_array 00207 !> Minimum new size of array. 00208 integer, intent(in) :: n 00209 00210 do while (size(aero_particle_array%particle) < n) 00211 call aero_particle_array_enlarge(aero_particle_array) 00212 end do 00213 00214 end subroutine aero_particle_array_enlarge_to 00215 00216 !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! 00217 00218 !> Possibly shrinks the storage of the given array, ensuring that 00219 !> it can still store the allocated particles. 00220 subroutine aero_particle_array_shrink(aero_particle_array) 00221 00222 !> Array to shrink. 00223 type(aero_particle_array_t), intent(inout) :: aero_particle_array 00224 00225 integer :: n_part, length, new_length 00226 00227 n_part = aero_particle_array%n_part 00228 length = size(aero_particle_array%particle) 00229 new_length = length / 2 00230 do while ((n_part <= new_length) .and. (length > 0)) 00231 call aero_particle_array_realloc(aero_particle_array, new_length) 00232 length = size(aero_particle_array%particle) 00233 new_length = length / 2 00234 end do 00235 00236 end subroutine aero_particle_array_shrink 00237 00238 !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! 00239 00240 !> Adds the given particle to the end of the array. 00241 subroutine aero_particle_array_add_particle(aero_particle_array, & 00242 aero_particle) 00243 00244 !> Array to add to. 00245 type(aero_particle_array_t), intent(inout) :: aero_particle_array 00246 !> Particle to add. 00247 type(aero_particle_t), intent(in) :: aero_particle 00248 00249 integer :: n 00250 00251 n = aero_particle_array%n_part + 1 00252 call aero_particle_array_enlarge_to(aero_particle_array, n) 00253 call aero_particle_allocate(aero_particle_array%particle(n)) 00254 call aero_particle_copy(aero_particle, & 00255 aero_particle_array%particle(n)) 00256 aero_particle_array%n_part = aero_particle_array%n_part + 1 00257 00258 end subroutine aero_particle_array_add_particle 00259 00260 !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! 00261 00262 !> Removes the particle at the given index. 00263 subroutine aero_particle_array_remove_particle(aero_particle_array, & 00264 index) 00265 00266 !> Array to remove from. 00267 type(aero_particle_array_t), intent(inout) :: aero_particle_array 00268 !> Index of particle to remove. 00269 integer, intent(in) :: index 00270 00271 call assert(992946227, index >= 1) 00272 call assert(711246139, index <= aero_particle_array%n_part) 00273 call aero_particle_deallocate(aero_particle_array%particle(index)) 00274 if (index < aero_particle_array%n_part) then 00275 ! shift last particle into empty slot to preserve dense packing 00276 call aero_particle_shift( & 00277 aero_particle_array%particle(aero_particle_array%n_part), & 00278 aero_particle_array%particle(index)) 00279 end if 00280 aero_particle_array%n_part = aero_particle_array%n_part - 1 00281 call aero_particle_array_shrink(aero_particle_array) 00282 00283 end subroutine aero_particle_array_remove_particle 00284 00285 !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! 00286 00287 !> Doubles the number of particles by making a duplicate of each 00288 !> one. 00289 subroutine aero_particle_array_double(aero_particle_array) 00290 00291 !> Array to double. 00292 type(aero_particle_array_t), intent(inout) :: aero_particle_array 00293 00294 integer :: n, i 00295 00296 n = aero_particle_array%n_part 00297 call aero_particle_array_enlarge_to(aero_particle_array, 2 * n) 00298 do i = 1,n 00299 call aero_particle_allocate_size(aero_particle_array%particle(i + n), & 00300 aero_particle_array%n_spec, aero_particle_array%n_source) 00301 call aero_particle_copy(aero_particle_array%particle(i), & 00302 aero_particle_array%particle(i + n)) 00303 call aero_particle_new_id(aero_particle_array%particle(i + n)) 00304 end do 00305 aero_particle_array%n_part = 2 * n 00306 00307 end subroutine aero_particle_array_double 00308 00309 !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! 00310 00311 !> Determines the number of bytes required to pack the given value. 00312 integer function pmc_mpi_pack_size_apa(val) 00313 00314 !> Value to pack. 00315 type(aero_particle_array_t), intent(in) :: val 00316 00317 integer :: i, total_size 00318 00319 total_size = 0 00320 total_size = total_size + pmc_mpi_pack_size_integer(val%n_part) 00321 total_size = total_size + pmc_mpi_pack_size_integer(val%n_spec) 00322 total_size = total_size + pmc_mpi_pack_size_integer(val%n_source) 00323 do i = 1,val%n_part 00324 total_size = total_size & 00325 + pmc_mpi_pack_size_aero_particle(val%particle(i)) 00326 end do 00327 pmc_mpi_pack_size_apa = total_size 00328 00329 end function pmc_mpi_pack_size_apa 00330 00331 !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! 00332 00333 !> Packs the given value into the buffer, advancing position. 00334 subroutine pmc_mpi_pack_aero_particle_array(buffer, position, val) 00335 00336 !> Memory buffer. 00337 character, intent(inout) :: buffer(:) 00338 !> Current buffer position. 00339 integer, intent(inout) :: position 00340 !> Value to pack. 00341 type(aero_particle_array_t), intent(in) :: val 00342 00343 #ifdef PMC_USE_MPI 00344 integer :: prev_position, i 00345 00346 prev_position = position 00347 call pmc_mpi_pack_integer(buffer, position, val%n_part) 00348 call pmc_mpi_pack_integer(buffer, position, val%n_spec) 00349 call pmc_mpi_pack_integer(buffer, position, val%n_source) 00350 do i = 1,val%n_part 00351 call pmc_mpi_pack_aero_particle(buffer, position, val%particle(i)) 00352 end do 00353 call assert(803856329, & 00354 position - prev_position <= pmc_mpi_pack_size_apa(val)) 00355 #endif 00356 00357 end subroutine pmc_mpi_pack_aero_particle_array 00358 00359 !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! 00360 00361 !> Unpacks the given value from the buffer, advancing position. 00362 subroutine pmc_mpi_unpack_aero_particle_array(buffer, position, val) 00363 00364 !> Memory buffer. 00365 character, intent(inout) :: buffer(:) 00366 !> Current buffer position. 00367 integer, intent(inout) :: position 00368 !> Value to pack. 00369 type(aero_particle_array_t), intent(inout) :: val 00370 00371 #ifdef PMC_USE_MPI 00372 integer :: prev_position, i 00373 00374 call aero_particle_array_deallocate(val) 00375 prev_position = position 00376 call pmc_mpi_unpack_integer(buffer, position, val%n_part) 00377 call pmc_mpi_unpack_integer(buffer, position, val%n_spec) 00378 call pmc_mpi_unpack_integer(buffer, position, val%n_source) 00379 allocate(val%particle(val%n_part)) 00380 do i = 1,val%n_part 00381 call aero_particle_allocate(val%particle(i)) 00382 call pmc_mpi_unpack_aero_particle(buffer, position, val%particle(i)) 00383 end do 00384 call assert(138783294, & 00385 position - prev_position <= pmc_mpi_pack_size_apa(val)) 00386 #endif 00387 00388 end subroutine pmc_mpi_unpack_aero_particle_array 00389 00390 !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! 00391 00392 end module pmc_aero_particle_array