PartMC  2.3.0
integer_varray.F90
Go to the documentation of this file.
1 ! Copyright (C) 2011 Matthew West
2 ! Licensed under the GNU General Public License version 2 or (at your
3 ! option) any later version. See the file COPYING for details.
4 
5 !> \file
6 !> The pmc_integer_varray module.
7 
8 !> The integer_varray_t structure and assocated subroutines.
10 
11  use pmc_util
12  use pmc_mpi
13 
14  !> A variable-length 1D array of integers.
15  !!
16  !! The number of currently used entries in \c n_entry will generally
17  !! be less than the allocated storage.
19  !> Number of currently used entries.
20  integer :: n_entry
21  !> Array of integer values.
22  integer, allocatable, dimension(:) :: entry
23  end type integer_varray_t
24 
25 contains
26 
27 !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
28 
29  !> Allocates an empty structure.
30  elemental subroutine integer_varray_allocate(integer_varray)
31 
32  !> Structure to initialize.
33  type(integer_varray_t), intent(out) :: integer_varray
34 
35  integer_varray%n_entry = 0
36  allocate(integer_varray%entry(0))
37 
38  end subroutine integer_varray_allocate
39 
40 !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
41 
42  !> Allocates a structure with the given size.
43  elemental subroutine integer_varray_allocate_size(integer_varray, n_entry)
44 
45  !> Structure to initialize.
46  type(integer_varray_t), intent(out) :: integer_varray
47  !> Number of entries.
48  integer, intent(in) :: n_entry
49 
50  integer_varray%n_entry = n_entry
51  allocate(integer_varray%entry(n_entry))
52  integer_varray%entry = 0
53 
54  end subroutine integer_varray_allocate_size
55 
56 !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
57 
58  !> Deallocates a previously allocated structure.
59  elemental subroutine integer_varray_deallocate(integer_varray)
60 
61  !> Structure to deallocate.
62  type(integer_varray_t), intent(inout) :: integer_varray
63 
64  deallocate(integer_varray%entry)
65 
66  end subroutine integer_varray_deallocate
67 
68 !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
69 
70  !> Changes the given integer_varray to exactly the given new_length.
71  !!
72  !! This function should not be called directly, but rather use
73  !! integer_varray_enlarge(), integer_varray_enlarge_to() or
74  !! integer_varray_shrink().
75  subroutine integer_varray_reallocate(integer_varray, new_length)
76 
77  !> Array to reallocate.
78  type(integer_varray_t), intent(inout) :: integer_varray
79  !> New length of the array.
80  integer, intent(in) :: new_length
81 
82  integer, dimension(integer_varray%n_entry) :: temp_array
83 
84  call assert(753399394, new_length >= integer_varray%n_entry)
85  temp_array = integer_varray%entry(1:integer_varray%n_entry)
86  deallocate(integer_varray%entry)
87  allocate(integer_varray%entry(new_length))
88  integer_varray%entry(1:integer_varray%n_entry) = temp_array
89 
90  end subroutine integer_varray_reallocate
91 
92 !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
93 
94  !> Resets an integer_varray to have zero particles per bin.
95  elemental subroutine integer_varray_zero(integer_varray)
96 
97  !> Structure to zero.
98  type(integer_varray_t), intent(inout) :: integer_varray
99 
100  integer_varray%entry = 0
101  integer_varray%n_entry = 0
102 
103  end subroutine integer_varray_zero
104 
105 !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
106 
107  !> Copies an integer_varray.
108  subroutine integer_varray_copy(integer_varray_from, integer_varray_to)
109 
110  !> Structure to copy from.
111  type(integer_varray_t), intent(in) :: integer_varray_from
112  !> Structure to copy to.
113  type(integer_varray_t), intent(inout) :: integer_varray_to
114 
115  call integer_varray_deallocate(integer_varray_to)
116  call integer_varray_allocate_size(integer_varray_to, &
117  integer_varray_from%n_entry)
118  integer_varray_to%entry(1:integer_varray_from%n_entry) &
119  = integer_varray_from%entry(1:integer_varray_from%n_entry)
120 
121  end subroutine integer_varray_copy
122 
123 !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
124 
125  !> Enlarges the given integer_varray by at least one element.
126  !!
127  !! Currently this at least doubles the length.
128  subroutine integer_varray_enlarge(integer_varray)
129 
130  !> Array to enlarge.
131  type(integer_varray_t), intent(inout) :: integer_varray
132 
133  integer :: length, new_length
134 
135  length = size(integer_varray%entry)
136  new_length = max(length * 2, length + 1)
137  call integer_varray_reallocate(integer_varray, new_length)
138 
139  end subroutine integer_varray_enlarge
140 
141 !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
142 
143  !> Enlarges the given array so that it is at least of size n.
144  subroutine integer_varray_enlarge_to(integer_varray, n)
145 
146  !> Array to enlarge.
147  type(integer_varray_t), intent(inout) :: integer_varray
148  !> Minimum new size of array.
149  integer, intent(in) :: n
150 
151  do while (size(integer_varray%entry) < n)
152  call integer_varray_enlarge(integer_varray)
153  end do
154 
155  end subroutine integer_varray_enlarge_to
156 
157 !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
158 
159  !> Possibly shrinks the storage of the given array, ensuring that
160  !> it can still store the used entries.
161  subroutine integer_varray_shrink(integer_varray)
162 
163  !> Array to shrink.
164  type(integer_varray_t), intent(inout) :: integer_varray
165 
166  integer :: length, new_length
167 
168  length = size(integer_varray%entry)
169  new_length = length / 2
170  do while ((integer_varray%n_entry <= new_length) .and. (length > 0))
171  call integer_varray_reallocate(integer_varray, new_length)
172  length = size(integer_varray%entry)
173  new_length = length / 2
174  end do
175 
176  end subroutine integer_varray_shrink
177 
178 !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
179 
180  !> Adds the given number to the end of the array.
181  subroutine integer_varray_append(integer_varray, val)
182 
183  !> Array to add to.
184  type(integer_varray_t), intent(inout) :: integer_varray
185  !> Value to add.
186  integer, intent(in) :: val
187 
188  integer :: n
189 
190  n = integer_varray%n_entry + 1
191  call integer_varray_enlarge_to(integer_varray, n)
192  integer_varray%entry(n) = val
193  integer_varray%n_entry = n
194 
195  end subroutine integer_varray_append
196 
197 !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
198 
199  !> Removes the entry at the given index, repacking values to
200  !> maintain contiguous data.
201  subroutine integer_varray_remove_entry(integer_varray, index)
202 
203  !> Array to remove from.
204  type(integer_varray_t), intent(inout) :: integer_varray
205  !> Index of entry to remove.
206  integer, intent(in) :: index
207 
208  call assert(541032660, index >= 1)
209  call assert(385739765, index <= integer_varray%n_entry)
210  if (index < integer_varray%n_entry) then
211  ! shift last entry into now-empty slot to preserve dense packing
212  integer_varray%entry(index) &
213  = integer_varray%entry(integer_varray%n_entry)
214  end if
215  ! clear now-unused last entry for safety
216  integer_varray%entry(integer_varray%n_entry) = 0
217  integer_varray%n_entry = integer_varray%n_entry - 1
218  call integer_varray_shrink(integer_varray)
219 
220  end subroutine integer_varray_remove_entry
221 
222 !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
223 
224  !> Determines the number of bytes required to pack the given value.
225  integer function pmc_mpi_pack_size_integer_varray(val)
226 
227  !> Value to pack.
228  type(integer_varray_t), intent(in) :: val
229 
230  integer :: total_size
231 
232  total_size = 0
233  total_size = total_size &
234  + pmc_mpi_pack_size_integer_array(val%entry(1:val%n_entry))
236 
238 
239 !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
240 
241  !> Packs the given value into the buffer, advancing position.
242  subroutine pmc_mpi_pack_integer_varray(buffer, position, val)
243 
244  !> Memory buffer.
245  character, intent(inout) :: buffer(:)
246  !> Current buffer position.
247  integer, intent(inout) :: position
248  !> Value to pack.
249  type(integer_varray_t), intent(in) :: val
250 
251 #ifdef PMC_USE_MPI
252  integer :: prev_position
253 
254  prev_position = position
255  call pmc_mpi_pack_integer_array(buffer, position, &
256  val%entry(1:val%n_entry))
257  call assert(230655880, &
258  position - prev_position <= pmc_mpi_pack_size_integer_varray(val))
259 #endif
260 
261  end subroutine pmc_mpi_pack_integer_varray
262 
263 !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
264 
265  !> Unpacks the given value from the buffer, advancing position.
266  subroutine pmc_mpi_unpack_integer_varray(buffer, position, val)
267 
268  !> Memory buffer.
269  character, intent(inout) :: buffer(:)
270  !> Current buffer position.
271  integer, intent(inout) :: position
272  !> Value to pack.
273  type(integer_varray_t), intent(inout) :: val
274 
275 #ifdef PMC_USE_MPI
276  integer :: prev_position
277  ! FIXME: should switch to allocatable arrays in pmc_mpi_unpack_*()
278  integer, pointer, dimension(:) :: tmp_entry
279 
280  prev_position = position
281  allocate(tmp_entry(0))
282  call pmc_mpi_unpack_integer_array(buffer, position, tmp_entry)
283  call integer_varray_deallocate(val)
284  call integer_varray_allocate_size(val, size(tmp_entry))
285  val%entry = tmp_entry
286  deallocate(tmp_entry)
287  call assert(355866103, &
288  position - prev_position <= pmc_mpi_pack_size_integer_varray(val))
289 #endif
290 
291  end subroutine pmc_mpi_unpack_integer_varray
292 
293 !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
294 
295 end module pmc_integer_varray
subroutine integer_varray_enlarge(integer_varray)
Enlarges the given integer_varray by at least one element.
subroutine integer_varray_shrink(integer_varray)
Possibly shrinks the storage of the given array, ensuring that it can still store the used entries...
The integer_varray_t structure and assocated subroutines.
elemental subroutine integer_varray_allocate_size(integer_varray, n_entry)
Allocates a structure with the given size.
subroutine integer_varray_append(integer_varray, val)
Adds the given number to the end of the array.
subroutine integer_varray_enlarge_to(integer_varray, n)
Enlarges the given array so that it is at least of size n.
subroutine integer_varray_remove_entry(integer_varray, index)
Removes the entry at the given index, repacking values to maintain contiguous data.
subroutine integer_varray_copy(integer_varray_from, integer_varray_to)
Copies an integer_varray.
Common utility subroutines.
Definition: util.F90:9
elemental subroutine integer_varray_deallocate(integer_varray)
Deallocates a previously allocated structure.
elemental subroutine integer_varray_zero(integer_varray)
Resets an integer_varray to have zero particles per bin.
Wrapper functions for MPI.
Definition: mpi.F90:13
subroutine pmc_mpi_unpack_integer_array(buffer, position, val)
Unpacks the given value from the buffer, advancing position.
Definition: mpi.F90:899
elemental subroutine integer_varray_allocate(integer_varray)
Allocates an empty structure.
subroutine pmc_mpi_pack_integer_varray(buffer, position, val)
Packs the given value into the buffer, advancing position.
A variable-length 1D array of integers.
subroutine integer_varray_reallocate(integer_varray, new_length)
Changes the given integer_varray to exactly the given new_length.
integer function pmc_mpi_pack_size_integer_array(val)
Determines the number of bytes required to pack the given value.
Definition: mpi.F90:449
subroutine pmc_mpi_unpack_integer_varray(buffer, position, val)
Unpacks the given value from the buffer, advancing position.
integer function pmc_mpi_pack_size_integer_varray(val)
Determines the number of bytes required to pack the given value.
subroutine assert(code, condition_ok)
Errors unless condition_ok is true.
Definition: util.F90:102
subroutine pmc_mpi_pack_integer_array(buffer, position, val)
Packs the given value into the buffer, advancing position.
Definition: mpi.F90:661