PartMC
2.2.1
|
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 !> Particle array. 00044 type(aero_particle_t), pointer :: particle(:) 00045 end type aero_particle_array_t 00046 00047 contains 00048 00049 !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! 00050 00051 !> Allocates and initializes. 00052 subroutine aero_particle_array_allocate(aero_particle_array) 00053 00054 !> Result. 00055 type(aero_particle_array_t), intent(out) :: aero_particle_array 00056 00057 aero_particle_array%n_part = 0 00058 allocate(aero_particle_array%particle(0)) 00059 00060 end subroutine aero_particle_array_allocate 00061 00062 !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! 00063 00064 !> Allocates and initializes to the given size. 00065 subroutine aero_particle_array_allocate_size(aero_particle_array, n_part) 00066 00067 !> Result. 00068 type(aero_particle_array_t), intent(out) :: aero_particle_array 00069 !> Number of particles. 00070 integer, intent(in) :: n_part 00071 00072 integer :: i 00073 00074 aero_particle_array%n_part = n_part 00075 allocate(aero_particle_array%particle(n_part)) 00076 do i = 1,n_part 00077 call aero_particle_allocate(aero_particle_array%particle(i)) 00078 end do 00079 00080 end subroutine aero_particle_array_allocate_size 00081 00082 !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! 00083 00084 !> Deallocates. 00085 subroutine aero_particle_array_deallocate(aero_particle_array) 00086 00087 !> Structure to deallocate. 00088 type(aero_particle_array_t), intent(inout) :: aero_particle_array 00089 00090 integer :: i 00091 00092 do i = 1,aero_particle_array%n_part 00093 call aero_particle_deallocate(aero_particle_array%particle(i)) 00094 end do 00095 deallocate(aero_particle_array%particle) 00096 00097 end subroutine aero_particle_array_deallocate 00098 00099 !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! 00100 00101 !> Copies aero_particle_array_from to aero_particle_array_to, both 00102 !> of which must already be allocated. 00103 subroutine aero_particle_array_copy(aero_particle_array_from, & 00104 aero_particle_array_to) 00105 00106 !> Origin structure. 00107 type(aero_particle_array_t), intent(in) :: aero_particle_array_from 00108 !> Destination structure. 00109 type(aero_particle_array_t), intent(inout) :: aero_particle_array_to 00110 00111 integer :: i 00112 00113 call aero_particle_array_deallocate(aero_particle_array_to) 00114 call aero_particle_array_allocate_size(aero_particle_array_to, & 00115 aero_particle_array_from%n_part) 00116 do i = 1,aero_particle_array_from%n_part 00117 call aero_particle_copy(aero_particle_array_from%particle(i), & 00118 aero_particle_array_to%particle(i)) 00119 end do 00120 00121 end subroutine aero_particle_array_copy 00122 00123 !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! 00124 00125 !> Resets an aero_particle_array to contain zero particles. 00126 subroutine aero_particle_array_zero(aero_particle_array) 00127 00128 !> Structure to reset. 00129 type(aero_particle_array_t), intent(inout) :: aero_particle_array 00130 00131 call aero_particle_array_deallocate(aero_particle_array) 00132 allocate(aero_particle_array%particle(0)) 00133 aero_particle_array%n_part = 0 00134 00135 end subroutine aero_particle_array_zero 00136 00137 !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! 00138 00139 !> Changes the given aero_particle_array to exactly the given 00140 !> new_length. 00141 !! 00142 !! This function should not be called directly, but rather use 00143 !! aero_particle_array_enlarge(), aero_particle_array_enlarge_to() 00144 !! or aero_particle_array_shrink(). 00145 subroutine aero_particle_array_realloc(aero_particle_array, new_length) 00146 00147 !> Array to reallocate (must already be allocated on entry). 00148 type(aero_particle_array_t), intent(inout) :: aero_particle_array 00149 !> New length of the array. 00150 integer, intent(in) :: new_length 00151 00152 integer :: n_part, i 00153 type(aero_particle_t), pointer :: new_particles(:) 00154 00155 n_part = aero_particle_array%n_part 00156 call assert(867444847, new_length >= n_part) 00157 allocate(new_particles(new_length)) 00158 do i = 1,aero_particle_array%n_part 00159 call aero_particle_shift(aero_particle_array%particle(i), & 00160 new_particles(i)) 00161 end do 00162 deallocate(aero_particle_array%particle) 00163 aero_particle_array%particle => new_particles 00164 00165 end subroutine aero_particle_array_realloc 00166 00167 !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! 00168 00169 !> Enlarges the given aero_particle_array by at least one element 00170 !! 00171 !! Currently this doubles the length. 00172 subroutine aero_particle_array_enlarge(aero_particle_array) 00173 00174 !> Array to enlarge. 00175 type(aero_particle_array_t), intent(inout) :: aero_particle_array 00176 00177 integer :: length, new_length 00178 00179 length = size(aero_particle_array%particle) 00180 new_length = max(length * 2, length + 1) 00181 call aero_particle_array_realloc(aero_particle_array, new_length) 00182 00183 end subroutine aero_particle_array_enlarge 00184 00185 !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! 00186 00187 !> Enlarges the given array so that it is at least of size n. 00188 subroutine aero_particle_array_enlarge_to(aero_particle_array, n) 00189 00190 !> Array to enlarge. 00191 type(aero_particle_array_t), intent(inout) :: aero_particle_array 00192 !> Minimum new size of array. 00193 integer, intent(in) :: n 00194 00195 do while (size(aero_particle_array%particle) < n) 00196 call aero_particle_array_enlarge(aero_particle_array) 00197 end do 00198 00199 end subroutine aero_particle_array_enlarge_to 00200 00201 !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! 00202 00203 !> Possibly shrinks the storage of the given array, ensuring that 00204 !> it can still store the allocated particles. 00205 subroutine aero_particle_array_shrink(aero_particle_array) 00206 00207 !> Array to shrink. 00208 type(aero_particle_array_t), intent(inout) :: aero_particle_array 00209 00210 integer :: n_part, length, new_length 00211 00212 n_part = aero_particle_array%n_part 00213 length = size(aero_particle_array%particle) 00214 new_length = length / 2 00215 do while ((n_part <= new_length) .and. (length > 0)) 00216 call aero_particle_array_realloc(aero_particle_array, new_length) 00217 length = size(aero_particle_array%particle) 00218 new_length = length / 2 00219 end do 00220 00221 end subroutine aero_particle_array_shrink 00222 00223 !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! 00224 00225 !> Adds the given particle to the end of the array. 00226 subroutine aero_particle_array_add_particle(aero_particle_array, & 00227 aero_particle) 00228 00229 !> Array to add to. 00230 type(aero_particle_array_t), intent(inout) :: aero_particle_array 00231 !> Particle to add. 00232 type(aero_particle_t), intent(in) :: aero_particle 00233 00234 integer :: n 00235 00236 n = aero_particle_array%n_part + 1 00237 call aero_particle_array_enlarge_to(aero_particle_array, n) 00238 call aero_particle_allocate(aero_particle_array%particle(n)) 00239 call aero_particle_copy(aero_particle, & 00240 aero_particle_array%particle(n)) 00241 aero_particle_array%n_part = aero_particle_array%n_part + 1 00242 00243 end subroutine aero_particle_array_add_particle 00244 00245 !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! 00246 00247 !> Removes the particle at the given index. 00248 subroutine aero_particle_array_remove_particle(aero_particle_array, & 00249 index) 00250 00251 !> Array to remove from. 00252 type(aero_particle_array_t), intent(inout) :: aero_particle_array 00253 !> Index of particle to remove. 00254 integer, intent(in) :: index 00255 00256 call assert(992946227, index >= 1) 00257 call assert(711246139, index <= aero_particle_array%n_part) 00258 call aero_particle_deallocate(aero_particle_array%particle(index)) 00259 if (index < aero_particle_array%n_part) then 00260 ! shift last particle into empty slot to preserve dense packing 00261 call aero_particle_shift( & 00262 aero_particle_array%particle(aero_particle_array%n_part), & 00263 aero_particle_array%particle(index)) 00264 end if 00265 aero_particle_array%n_part = aero_particle_array%n_part - 1 00266 call aero_particle_array_shrink(aero_particle_array) 00267 00268 end subroutine aero_particle_array_remove_particle 00269 00270 !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! 00271 00272 !> Determines the number of bytes required to pack the given value. 00273 integer function pmc_mpi_pack_size_apa(val) 00274 00275 !> Value to pack. 00276 type(aero_particle_array_t), intent(in) :: val 00277 00278 integer :: i, total_size 00279 00280 total_size = 0 00281 total_size = total_size + pmc_mpi_pack_size_integer(val%n_part) 00282 do i = 1,val%n_part 00283 total_size = total_size & 00284 + pmc_mpi_pack_size_aero_particle(val%particle(i)) 00285 end do 00286 pmc_mpi_pack_size_apa = total_size 00287 00288 end function pmc_mpi_pack_size_apa 00289 00290 !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! 00291 00292 !> Packs the given value into the buffer, advancing position. 00293 subroutine pmc_mpi_pack_aero_particle_array(buffer, position, val) 00294 00295 !> Memory buffer. 00296 character, intent(inout) :: buffer(:) 00297 !> Current buffer position. 00298 integer, intent(inout) :: position 00299 !> Value to pack. 00300 type(aero_particle_array_t), intent(in) :: val 00301 00302 #ifdef PMC_USE_MPI 00303 integer :: prev_position, i 00304 00305 prev_position = position 00306 call pmc_mpi_pack_integer(buffer, position, val%n_part) 00307 do i = 1,val%n_part 00308 call pmc_mpi_pack_aero_particle(buffer, position, val%particle(i)) 00309 end do 00310 call assert(803856329, & 00311 position - prev_position <= pmc_mpi_pack_size_apa(val)) 00312 #endif 00313 00314 end subroutine pmc_mpi_pack_aero_particle_array 00315 00316 !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! 00317 00318 !> Unpacks the given value from the buffer, advancing position. 00319 subroutine pmc_mpi_unpack_aero_particle_array(buffer, position, val) 00320 00321 !> Memory buffer. 00322 character, intent(inout) :: buffer(:) 00323 !> Current buffer position. 00324 integer, intent(inout) :: position 00325 !> Value to pack. 00326 type(aero_particle_array_t), intent(inout) :: val 00327 00328 #ifdef PMC_USE_MPI 00329 integer :: prev_position, i 00330 00331 call aero_particle_array_deallocate(val) 00332 prev_position = position 00333 call pmc_mpi_unpack_integer(buffer, position, val%n_part) 00334 allocate(val%particle(val%n_part)) 00335 do i = 1,val%n_part 00336 call aero_particle_allocate(val%particle(i)) 00337 call pmc_mpi_unpack_aero_particle(buffer, position, val%particle(i)) 00338 end do 00339 call assert(138783294, & 00340 position - prev_position <= pmc_mpi_pack_size_apa(val)) 00341 #endif 00342 00343 end subroutine pmc_mpi_unpack_aero_particle_array 00344 00345 !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! 00346 00347 end module pmc_aero_particle_array