PartMC 2.1.3
|
00001 ! Copyright (C) 2007-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_info_array module. 00007 00008 !> The aero_info_array_t structure and assoicated subroutines. 00009 module pmc_aero_info_array 00010 00011 use pmc_aero_info 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 aero_info_t structure. 00020 !! 00021 !! This type implements a variable-length array of aero_info_t 00022 !! structures. To give a reasonable tradeoff between frequent 00023 !! re-allocs and memory usage, the length of an aero_info_array is 00024 !! generally a bit longer than the number of particles stored in 00025 !! it. When the array is full then a larger array is allocated with 00026 !! new extra space. As a balance between memory usage and frequency 00027 !! of re-allocs the length of the array is currently doubled when 00028 !! necessary and halved when possible. 00029 !! 00030 !! The true allocated length of the aero_info_array can be obtained 00031 !! by size(aero_info_array%%aero_info), while the number of used 00032 !! particle slots in it is given by aero_info_array%%n_item. It must 00033 !! be that aero_info_array%%n_item is less than or equal to 00034 !! size(aero_info_array%%aero_info). 00035 type aero_info_array_t 00036 !> Number of items in the array (not the same as the length of 00037 !> the allocated memory). 00038 integer :: n_item 00039 !> Array of aero_info_t structures. 00040 type(aero_info_t), pointer :: aero_info(:) 00041 end type aero_info_array_t 00042 00043 contains 00044 00045 !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! 00046 00047 !> Allocates the structure. 00048 subroutine aero_info_array_allocate(aero_info_array) 00049 00050 !> Result. 00051 type(aero_info_array_t), intent(out) :: aero_info_array 00052 00053 integer :: i 00054 00055 aero_info_array%n_item = 0 00056 allocate(aero_info_array%aero_info(0)) 00057 00058 end subroutine aero_info_array_allocate 00059 00060 !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! 00061 00062 !> Allocates with the given size. 00063 subroutine aero_info_array_allocate_size(aero_info_array, n_item) 00064 00065 !> Result. 00066 type(aero_info_array_t), intent(out) :: aero_info_array 00067 !> Number of items. 00068 integer, intent(in) :: n_item 00069 00070 integer :: i 00071 00072 aero_info_array%n_item = n_item 00073 allocate(aero_info_array%aero_info(n_item)) 00074 do i = 1,n_item 00075 call aero_info_allocate(aero_info_array%aero_info(i)) 00076 end do 00077 00078 end subroutine aero_info_array_allocate_size 00079 00080 !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! 00081 00082 !> Deallocates. 00083 subroutine aero_info_array_deallocate(aero_info_array) 00084 00085 !> Structure to deallocate. 00086 type(aero_info_array_t), intent(inout) :: aero_info_array 00087 00088 integer :: i 00089 00090 do i = 1,aero_info_array%n_item 00091 call aero_info_deallocate(aero_info_array%aero_info(i)) 00092 end do 00093 deallocate(aero_info_array%aero_info) 00094 00095 end subroutine aero_info_array_deallocate 00096 00097 !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! 00098 00099 !> Copies aero_info_array_from to aero_info_array_to, both 00100 !> of which must already be allocated. 00101 subroutine aero_info_array_copy(aero_info_array_from, & 00102 aero_info_array_to) 00103 00104 !> Origin structure. 00105 type(aero_info_array_t), intent(in) :: aero_info_array_from 00106 !> Destination structure. 00107 type(aero_info_array_t), intent(inout) :: aero_info_array_to 00108 00109 integer :: i 00110 00111 call aero_info_array_deallocate(aero_info_array_to) 00112 call aero_info_array_allocate_size(aero_info_array_to, & 00113 aero_info_array_from%n_item) 00114 do i = 1,aero_info_array_from%n_item 00115 call aero_info_copy(aero_info_array_from%aero_info(i), & 00116 aero_info_array_to%aero_info(i)) 00117 end do 00118 00119 end subroutine aero_info_array_copy 00120 00121 !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! 00122 00123 !> Resets an aero_info_array to contain zero particles. 00124 subroutine aero_info_array_zero(aero_info_array) 00125 00126 !> Structure to reset. 00127 type(aero_info_array_t), intent(inout) :: aero_info_array 00128 00129 call aero_info_array_deallocate(aero_info_array) 00130 allocate(aero_info_array%aero_info(0)) 00131 aero_info_array%n_item = 0 00132 00133 end subroutine aero_info_array_zero 00134 00135 !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! 00136 00137 !> Changes the given aero_info_array to exactly the given 00138 !> new_length. 00139 !! 00140 !! This function should not be called directly, but rather use 00141 !! aero_info_array_enlarge(), aero_info_array_enlarge_to() 00142 !! or aero_info_array_shrink(). 00143 subroutine aero_info_array_realloc(aero_info_array, new_length) 00144 00145 !> Array to reallocate (must already be allocated on entry). 00146 type(aero_info_array_t), intent(inout) :: aero_info_array 00147 !> New length of the array. 00148 integer, intent(in) :: new_length 00149 00150 integer :: n_item, i 00151 type(aero_info_t), pointer :: new_particles(:) 00152 00153 n_item = aero_info_array%n_item 00154 call assert(372938429, new_length >= n_item) 00155 allocate(new_particles(new_length)) 00156 do i = 1,aero_info_array%n_item 00157 call aero_info_copy(aero_info_array%aero_info(i), & 00158 new_particles(i)) 00159 call aero_info_deallocate(aero_info_array%aero_info(i)) 00160 end do 00161 deallocate(aero_info_array%aero_info) 00162 aero_info_array%aero_info => new_particles 00163 00164 end subroutine aero_info_array_realloc 00165 00166 !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! 00167 00168 !> Enlarges the given aero_info_array by at least one element 00169 !! 00170 !! Currently this doubles the length. 00171 subroutine aero_info_array_enlarge(aero_info_array) 00172 00173 !> Array to enlarge. 00174 type(aero_info_array_t), intent(inout) :: aero_info_array 00175 00176 integer :: length, new_length 00177 00178 length = size(aero_info_array%aero_info) 00179 new_length = max(length * 2, length + 1) 00180 call aero_info_array_realloc(aero_info_array, new_length) 00181 00182 end subroutine aero_info_array_enlarge 00183 00184 !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! 00185 00186 !> Enlarges the given array so that it is at least of size n. 00187 subroutine aero_info_array_enlarge_to(aero_info_array, n) 00188 00189 !> Array to enlarge. 00190 type(aero_info_array_t), intent(inout) :: aero_info_array 00191 !> Minimum new size of array. 00192 integer, intent(in) :: n 00193 00194 do while (size(aero_info_array%aero_info) < n) 00195 call aero_info_array_enlarge(aero_info_array) 00196 end do 00197 00198 end subroutine aero_info_array_enlarge_to 00199 00200 !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! 00201 00202 !> Possibly shrinks the storage of the given array, ensuring that 00203 !> it can still store the allocated particles. 00204 subroutine aero_info_array_shrink(aero_info_array) 00205 00206 !> Array to shrink. 00207 type(aero_info_array_t), intent(inout) :: aero_info_array 00208 00209 integer :: n_item, length, new_length 00210 00211 n_item = aero_info_array%n_item 00212 length = size(aero_info_array%aero_info) 00213 new_length = length / 2 00214 do while ((n_item <= new_length) .and. (length > 0)) 00215 call aero_info_array_realloc(aero_info_array, new_length) 00216 length = size(aero_info_array%aero_info) 00217 new_length = length / 2 00218 end do 00219 00220 end subroutine aero_info_array_shrink 00221 00222 !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! 00223 00224 !> Adds the given aero_info to the end of the array. 00225 subroutine aero_info_array_add_aero_info(aero_info_array, & 00226 aero_info) 00227 00228 !> Array to add to. 00229 type(aero_info_array_t), intent(inout) :: aero_info_array 00230 !> Aero_info to add. 00231 type(aero_info_t), intent(in) :: aero_info 00232 00233 integer :: n 00234 00235 n = aero_info_array%n_item + 1 00236 call aero_info_array_enlarge_to(aero_info_array, n) 00237 call aero_info_allocate(aero_info_array%aero_info(n)) 00238 call aero_info_copy(aero_info, aero_info_array%aero_info(n)) 00239 aero_info_array%n_item = aero_info_array%n_item + 1 00240 00241 end subroutine aero_info_array_add_aero_info 00242 00243 !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! 00244 00245 !> Removes the aero_info at the given index. 00246 subroutine aero_info_array_remove_aero_info(aero_info_array, & 00247 index) 00248 00249 !> Array to remove from. 00250 type(aero_info_array_t), intent(inout) :: aero_info_array 00251 !> Index of aero_info to remove. 00252 integer, intent(in) :: index 00253 00254 call assert(213892348, index >= 1) 00255 call assert(953927392, index <= aero_info_array%n_item) 00256 call aero_info_deallocate(aero_info_array%aero_info(index)) 00257 if (index < aero_info_array%n_item) then 00258 ! shift last aero_info into empty slot to preserve dense packing 00259 call aero_info_copy( & 00260 aero_info_array%aero_info(aero_info_array%n_item), & 00261 aero_info_array%aero_info(index)) 00262 call aero_info_deallocate( & 00263 aero_info_array%aero_info(aero_info_array%n_item)) 00264 end if 00265 aero_info_array%n_item = aero_info_array%n_item - 1 00266 call aero_info_array_shrink(aero_info_array) 00267 00268 end subroutine aero_info_array_remove_aero_info 00269 00270 !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! 00271 00272 !> Adds \c aero_info_array_delta to the end of \c aero_info_array. 00273 subroutine aero_info_array_add(aero_info_array, & 00274 aero_info_array_delta) 00275 00276 !> Array to add to. 00277 type(aero_info_array_t), intent(inout) :: aero_info_array 00278 !> Aero_info to add. 00279 type(aero_info_array_t), intent(in) :: aero_info_array_delta 00280 00281 integer :: i, n, n_delta, n_new 00282 00283 n = aero_info_array%n_item 00284 n_delta = aero_info_array_delta%n_item 00285 n_new = n + n_delta 00286 call aero_info_array_enlarge_to(aero_info_array, n_new) 00287 do i = 1,n_delta 00288 call aero_info_allocate(aero_info_array%aero_info(n + i)) 00289 call aero_info_copy(aero_info_array_delta%aero_info(i), & 00290 aero_info_array%aero_info(n + i)) 00291 end do 00292 aero_info_array%n_item = n_new 00293 00294 end subroutine aero_info_array_add 00295 00296 !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! 00297 00298 !> Determines the number of bytes required to pack the given value. 00299 integer function pmc_mpi_pack_size_aia(val) 00300 00301 !> Value to pack. 00302 type(aero_info_array_t), intent(in) :: val 00303 00304 integer :: i, total_size 00305 00306 total_size = 0 00307 total_size = total_size + pmc_mpi_pack_size_integer(val%n_item) 00308 do i = 1,val%n_item 00309 total_size = total_size & 00310 + pmc_mpi_pack_size_aero_info(val%aero_info(i)) 00311 end do 00312 pmc_mpi_pack_size_aia = total_size 00313 00314 end function pmc_mpi_pack_size_aia 00315 00316 !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! 00317 00318 !> Packs the given value into the buffer, advancing position. 00319 subroutine pmc_mpi_pack_aero_info_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_info_array_t), intent(in) :: val 00327 00328 #ifdef PMC_USE_MPI 00329 integer :: prev_position, i 00330 00331 prev_position = position 00332 call pmc_mpi_pack_integer(buffer, position, val%n_item) 00333 do i = 1,val%n_item 00334 call pmc_mpi_pack_aero_info(buffer, position, val%aero_info(i)) 00335 end do 00336 call assert(732927292, & 00337 position - prev_position <= pmc_mpi_pack_size_aia(val)) 00338 #endif 00339 00340 end subroutine pmc_mpi_pack_aero_info_array 00341 00342 !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! 00343 00344 !> Unpacks the given value from the buffer, advancing position. 00345 subroutine pmc_mpi_unpack_aero_info_array(buffer, position, val) 00346 00347 !> Memory buffer. 00348 character, intent(inout) :: buffer(:) 00349 !> Current buffer position. 00350 integer, intent(inout) :: position 00351 !> Value to pack. 00352 type(aero_info_array_t), intent(inout) :: val 00353 00354 #ifdef PMC_USE_MPI 00355 integer :: prev_position, i 00356 00357 call aero_info_array_deallocate(val) 00358 prev_position = position 00359 call pmc_mpi_unpack_integer(buffer, position, val%n_item) 00360 allocate(val%aero_info(val%n_item)) 00361 do i = 1,val%n_item 00362 call aero_info_allocate(val%aero_info(i)) 00363 call pmc_mpi_unpack_aero_info(buffer, position, val%aero_info(i)) 00364 end do 00365 call assert(262838429, & 00366 position - prev_position <= pmc_mpi_pack_size_aia(val)) 00367 #endif 00368 00369 end subroutine pmc_mpi_unpack_aero_info_array 00370 00371 !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! 00372 00373 end module pmc_aero_info_array