PartMC
2.2.0
|
00001 ! Copyright (C) 2011 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_integer_varray module. 00007 00008 !> The integer_varray_t structure and assocated subroutines. 00009 module pmc_integer_varray 00010 00011 use pmc_util 00012 use pmc_mpi 00013 00014 !> A variable-length 1D array of integers. 00015 !! 00016 !! The number of currently used entries in \c n_entry will generally 00017 !! be less than the allocated storage. 00018 type integer_varray_t 00019 !> Number of currently used entries. 00020 integer :: n_entry 00021 !> Array of integer values. 00022 integer, allocatable, dimension(:) :: entry 00023 end type integer_varray_t 00024 00025 contains 00026 00027 !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! 00028 00029 !> Allocates an empty structure. 00030 elemental subroutine integer_varray_allocate(integer_varray) 00031 00032 !> Structure to initialize. 00033 type(integer_varray_t), intent(out) :: integer_varray 00034 00035 integer_varray%n_entry = 0 00036 allocate(integer_varray%entry(0)) 00037 00038 end subroutine integer_varray_allocate 00039 00040 !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! 00041 00042 !> Allocates a structure with the given size. 00043 elemental subroutine integer_varray_allocate_size(integer_varray, n_entry) 00044 00045 !> Structure to initialize. 00046 type(integer_varray_t), intent(out) :: integer_varray 00047 !> Number of entries. 00048 integer, intent(in) :: n_entry 00049 00050 integer_varray%n_entry = n_entry 00051 allocate(integer_varray%entry(n_entry)) 00052 integer_varray%entry = 0 00053 00054 end subroutine integer_varray_allocate_size 00055 00056 !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! 00057 00058 !> Deallocates a previously allocated structure. 00059 elemental subroutine integer_varray_deallocate(integer_varray) 00060 00061 !> Structure to deallocate. 00062 type(integer_varray_t), intent(inout) :: integer_varray 00063 00064 deallocate(integer_varray%entry) 00065 00066 end subroutine integer_varray_deallocate 00067 00068 !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! 00069 00070 !> Changes the given integer_varray to exactly the given new_length. 00071 !! 00072 !! This function should not be called directly, but rather use 00073 !! integer_varray_enlarge(), integer_varray_enlarge_to() or 00074 !! integer_varray_shrink(). 00075 subroutine integer_varray_reallocate(integer_varray, new_length) 00076 00077 !> Array to reallocate. 00078 type(integer_varray_t), intent(inout) :: integer_varray 00079 !> New length of the array. 00080 integer, intent(in) :: new_length 00081 00082 integer, dimension(integer_varray%n_entry) :: temp_array 00083 00084 call assert(753399394, new_length >= integer_varray%n_entry) 00085 temp_array = integer_varray%entry(1:integer_varray%n_entry) 00086 deallocate(integer_varray%entry) 00087 allocate(integer_varray%entry(new_length)) 00088 integer_varray%entry(1:integer_varray%n_entry) = temp_array 00089 00090 end subroutine integer_varray_reallocate 00091 00092 !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! 00093 00094 !> Resets an integer_varray to have zero particles per bin. 00095 elemental subroutine integer_varray_zero(integer_varray) 00096 00097 !> Structure to zero. 00098 type(integer_varray_t), intent(inout) :: integer_varray 00099 00100 integer_varray%entry = 0 00101 integer_varray%n_entry = 0 00102 00103 end subroutine integer_varray_zero 00104 00105 !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! 00106 00107 !> Copies an integer_varray. 00108 subroutine integer_varray_copy(integer_varray_from, integer_varray_to) 00109 00110 !> Structure to copy from. 00111 type(integer_varray_t), intent(in) :: integer_varray_from 00112 !> Structure to copy to. 00113 type(integer_varray_t), intent(inout) :: integer_varray_to 00114 00115 call integer_varray_deallocate(integer_varray_to) 00116 call integer_varray_allocate_size(integer_varray_to, & 00117 integer_varray_from%n_entry) 00118 integer_varray_to%entry(1:integer_varray_from%n_entry) & 00119 = integer_varray_from%entry(1:integer_varray_from%n_entry) 00120 00121 end subroutine integer_varray_copy 00122 00123 !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! 00124 00125 !> Enlarges the given integer_varray by at least one element. 00126 !! 00127 !! Currently this at least doubles the length. 00128 subroutine integer_varray_enlarge(integer_varray) 00129 00130 !> Array to enlarge. 00131 type(integer_varray_t), intent(inout) :: integer_varray 00132 00133 integer :: length, new_length 00134 00135 length = size(integer_varray%entry) 00136 new_length = max(length * 2, length + 1) 00137 call integer_varray_reallocate(integer_varray, new_length) 00138 00139 end subroutine integer_varray_enlarge 00140 00141 !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! 00142 00143 !> Enlarges the given array so that it is at least of size n. 00144 subroutine integer_varray_enlarge_to(integer_varray, n) 00145 00146 !> Array to enlarge. 00147 type(integer_varray_t), intent(inout) :: integer_varray 00148 !> Minimum new size of array. 00149 integer, intent(in) :: n 00150 00151 do while (size(integer_varray%entry) < n) 00152 call integer_varray_enlarge(integer_varray) 00153 end do 00154 00155 end subroutine integer_varray_enlarge_to 00156 00157 !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! 00158 00159 !> Possibly shrinks the storage of the given array, ensuring that 00160 !> it can still store the used entries. 00161 subroutine integer_varray_shrink(integer_varray) 00162 00163 !> Array to shrink. 00164 type(integer_varray_t), intent(inout) :: integer_varray 00165 00166 integer :: length, new_length 00167 00168 length = size(integer_varray%entry) 00169 new_length = length / 2 00170 do while ((integer_varray%n_entry <= new_length) .and. (length > 0)) 00171 call integer_varray_reallocate(integer_varray, new_length) 00172 length = size(integer_varray%entry) 00173 new_length = length / 2 00174 end do 00175 00176 end subroutine integer_varray_shrink 00177 00178 !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! 00179 00180 !> Adds the given number to the end of the array. 00181 subroutine integer_varray_append(integer_varray, val) 00182 00183 !> Array to add to. 00184 type(integer_varray_t), intent(inout) :: integer_varray 00185 !> Value to add. 00186 integer, intent(in) :: val 00187 00188 integer :: n 00189 00190 n = integer_varray%n_entry + 1 00191 call integer_varray_enlarge_to(integer_varray, n) 00192 integer_varray%entry(n) = val 00193 integer_varray%n_entry = n 00194 00195 end subroutine integer_varray_append 00196 00197 !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! 00198 00199 !> Removes the entry at the given index, repacking values to 00200 !> maintain contiguous data. 00201 subroutine integer_varray_remove_entry(integer_varray, index) 00202 00203 !> Array to remove from. 00204 type(integer_varray_t), intent(inout) :: integer_varray 00205 !> Index of entry to remove. 00206 integer, intent(in) :: index 00207 00208 call assert(541032660, index >= 1) 00209 call assert(385739765, index <= integer_varray%n_entry) 00210 if (index < integer_varray%n_entry) then 00211 ! shift last entry into now-empty slot to preserve dense packing 00212 integer_varray%entry(index) & 00213 = integer_varray%entry(integer_varray%n_entry) 00214 end if 00215 ! clear now-unused last entry for safety 00216 integer_varray%entry(integer_varray%n_entry) = 0 00217 integer_varray%n_entry = integer_varray%n_entry - 1 00218 call integer_varray_shrink(integer_varray) 00219 00220 end subroutine integer_varray_remove_entry 00221 00222 !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! 00223 00224 !> Determines the number of bytes required to pack the given value. 00225 integer function pmc_mpi_pack_size_integer_varray(val) 00226 00227 !> Value to pack. 00228 type(integer_varray_t), intent(in) :: val 00229 00230 integer :: total_size 00231 00232 total_size = 0 00233 total_size = total_size & 00234 + pmc_mpi_pack_size_integer_array(val%entry(1:val%n_entry)) 00235 pmc_mpi_pack_size_integer_varray = total_size 00236 00237 end function pmc_mpi_pack_size_integer_varray 00238 00239 !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! 00240 00241 !> Packs the given value into the buffer, advancing position. 00242 subroutine pmc_mpi_pack_integer_varray(buffer, position, val) 00243 00244 !> Memory buffer. 00245 character, intent(inout) :: buffer(:) 00246 !> Current buffer position. 00247 integer, intent(inout) :: position 00248 !> Value to pack. 00249 type(integer_varray_t), intent(in) :: val 00250 00251 #ifdef PMC_USE_MPI 00252 integer :: prev_position 00253 00254 prev_position = position 00255 call pmc_mpi_pack_integer_array(buffer, position, & 00256 val%entry(1:val%n_entry)) 00257 call assert(230655880, & 00258 position - prev_position <= pmc_mpi_pack_size_integer_varray(val)) 00259 #endif 00260 00261 end subroutine pmc_mpi_pack_integer_varray 00262 00263 !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! 00264 00265 !> Unpacks the given value from the buffer, advancing position. 00266 subroutine pmc_mpi_unpack_integer_varray(buffer, position, val) 00267 00268 !> Memory buffer. 00269 character, intent(inout) :: buffer(:) 00270 !> Current buffer position. 00271 integer, intent(inout) :: position 00272 !> Value to pack. 00273 type(integer_varray_t), intent(inout) :: val 00274 00275 #ifdef PMC_USE_MPI 00276 integer :: prev_position 00277 ! FIXME: should switch to allocatable arrays in pmc_mpi_unpack_*() 00278 integer, pointer, dimension(:) :: tmp_entry 00279 00280 prev_position = position 00281 allocate(tmp_entry(0)) 00282 call pmc_mpi_unpack_integer_array(buffer, position, tmp_entry) 00283 call integer_varray_deallocate(val) 00284 call integer_varray_allocate_size(val, size(tmp_entry)) 00285 val%entry = tmp_entry 00286 deallocate(tmp_entry) 00287 call assert(355866103, & 00288 position - prev_position <= pmc_mpi_pack_size_integer_varray(val)) 00289 #endif 00290 00291 end subroutine pmc_mpi_unpack_integer_varray 00292 00293 !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! 00294 00295 end module pmc_integer_varray