PartMC  2.2.0
integer_varray.F90
Go to the documentation of this file.
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