69 allocate(integer_rmap%inverse(0))
82 integer,
intent(in) :: n_range
85 allocate(integer_rmap%inverse(n_range))
101 deallocate(integer_rmap%inverse)
128 integer,
intent(in) :: i_range
130 call
assert(549740445, i_range >= 1)
131 call
assert(145872613, i_range <=
size(integer_rmap%inverse))
136 integer_rmap%forward%n_entry)
138 integer_rmap%inverse(i_range)%n_entry)
150 integer,
intent(in) :: i_domain
152 integer,
intent(in) :: i_range
154 integer :: i_range_old, i_index_old, i_domain_shifted
156 call
assert(709581778, i_domain >= 1)
157 call
assert(494892311, i_domain <= integer_rmap%forward%n_entry)
159 call
assert(590911054, i_range >= 1)
160 call
assert(859774512, i_range <=
size(integer_rmap%inverse))
162 i_range_old = integer_rmap%forward%entry(i_domain)
163 if (i_range_old == i_range)
return
164 i_index_old = integer_rmap%index%entry(i_domain)
169 if (i_index_old <= integer_rmap%inverse(i_range_old)%n_entry)
then
172 i_domain_shifted = integer_rmap%inverse(i_range_old)%entry(i_index_old)
173 integer_rmap%index%entry(i_domain_shifted) = i_index_old
177 integer_rmap%forward%entry(i_domain) = i_range
179 integer_rmap%index%entry(i_domain) = integer_rmap%inverse(i_range)%n_entry
192 integer,
intent(in) :: i_domain
194 integer :: i_range_old, i_index_old, i_domain_shifted, i_range_fix
195 integer :: i_index_fix, i_domain_fix
197 call
assert(745161821, i_domain >= 1)
198 call
assert(143043782, i_domain <= integer_rmap%forward%n_entry)
205 i_range_old = integer_rmap%forward%entry(i_domain)
206 i_index_old = integer_rmap%index%entry(i_domain)
208 i_domain_shifted = integer_rmap%forward%n_entry
209 if (i_domain_shifted /= i_domain)
then
210 i_range_fix = integer_rmap%forward%entry(i_domain_shifted)
211 i_index_fix = integer_rmap%index%entry(i_domain_shifted)
212 integer_rmap%inverse(i_range_fix)%entry(i_index_fix) = i_domain
221 i_index_fix = integer_rmap%inverse(i_range_old)%n_entry
222 i_domain_fix = integer_rmap%inverse(i_range_old)%entry(i_index_fix)
226 if (i_index_fix /= i_index_old)
then
228 integer_rmap%index%entry(i_domain_fix) = i_index_old
242 character(len=*),
intent(in) :: name
244 integer,
intent(in) :: n_domain
246 integer,
intent(in) :: n_range
248 logical,
intent(in) :: continue_on_error
250 integer :: i_domain, i_range, i_index
252 if ((n_domain /= integer_rmap%forward%n_entry) &
253 .or. (n_domain /= integer_rmap%index%n_entry) &
254 .or. (n_range /=
size(integer_rmap%inverse)))
then
255 write(0,*)
'ERROR integer_rmap A:', name
256 write(0,*)
'n_domain', n_domain
257 write(0,*)
'n_range', n_range
258 write(0,*)
'integer_rmap%forward%n_entry', integer_rmap%forward%n_entry
259 write(0,*)
'integer_rmap%index%n_entry', integer_rmap%index%n_entry
260 write(0,*)
'size(integer_rmap%inverse)',
size(integer_rmap%inverse)
261 call
assert(973643016, continue_on_error)
264 do i_domain = 1,n_domain
265 i_range = integer_rmap%forward%entry(i_domain)
266 if ((i_range < 1) .or. (i_range > n_range))
then
267 write(0,*)
'ERROR integer_rmap B:', name
268 write(0,*)
'i_domain', i_domain
269 write(0,*)
'i_range', i_range
270 write(0,*)
'n_range', n_range
271 call
assert(798857945, continue_on_error)
274 i_index = integer_rmap%index%entry(i_domain)
276 .or. (i_index > integer_rmap%inverse(i_range)%n_entry))
then
277 write(0,*)
'ERROR integer_rmap C:', name
278 write(0,*)
'i_domain', i_domain
279 write(0,*)
'i_range', i_range
280 write(0,*)
'i_index', i_index
281 write(0,*)
'integer_rmap%inverse(i_range)%n_entry', &
282 integer_rmap%inverse(i_range)%n_entry
283 call
assert(823748734, continue_on_error)
285 if (i_domain /= integer_rmap%inverse(i_range)%entry(i_index))
then
286 write(0,*)
'ERROR integer_rmap D:', name
287 write(0,*)
'i_domain', i_domain
288 write(0,*)
'i_range', i_range
289 write(0,*)
'i_index', i_index
290 write(0,*)
'integer_rmap%inverse(i_range)%entry(i_index)', &
291 integer_rmap%inverse(i_range)%entry(i_index)
292 call
assert(735205557, continue_on_error)
296 do i_range = 1,n_range
297 do i_index = 1,integer_rmap%inverse(i_range)%n_entry
298 i_domain = integer_rmap%inverse(i_range)%entry(i_index)
299 if ((i_domain < 1) .or. (i_domain > n_domain))
then
300 write(0,*)
'ERROR integer_rmap E:', name
301 write(0,*)
'i_range', i_range
302 write(0,*)
'i_index', i_index
303 write(0,*)
'i_domain', i_domain
304 write(0,*)
'n_domain', n_domain
305 call
assert(502643520, continue_on_error)
307 if ((i_range /= integer_rmap%forward%entry(i_domain)) &
308 .or. (i_index /= integer_rmap%index%entry(i_domain)))
then
309 write(0,*)
'ERROR integer_rmap F:', name
310 write(0,*)
'i_domain', i_domain
311 write(0,*)
'i_range', i_range
312 write(0,*)
'integer_rmap%forward%entry(i_domain)', &
313 integer_rmap%forward%entry(i_domain)
314 write(0,*)
'i_index', i_index
315 write(0,*)
'integer_rmap%index%entry(i_domain)', &
316 integer_rmap%index%entry(i_domain)
317 call
assert(544747928, continue_on_error)
332 integer :: i, total_size
337 do i = 1,
size(val%inverse)
338 total_size = total_size &
352 character,
intent(inout) :: buffer(:)
354 integer,
intent(inout) :: position
359 integer :: prev_position, i
361 prev_position = position
364 do i = 1,
size(val%inverse)
380 character,
intent(inout) :: buffer(:)
382 integer,
intent(inout) :: position
387 integer :: prev_position, i, n
389 prev_position = position
394 do i = 1,
size(val%inverse)
integer function pmc_mpi_pack_size_integer(val)
Determines the number of bytes required to pack the given value.
elemental subroutine integer_rmap_allocate_size(integer_rmap, n_range)
Allocates a structure with the given size.
The integer_varray_t structure and assocated subroutines.
integer function pmc_mpi_pack_size_integer_rmap(val)
Determines the number of bytes required to pack the given value.
subroutine integer_rmap_check(integer_rmap, name, n_domain, n_range, continue_on_error)
Check that the data is consistent.
subroutine integer_varray_append(integer_varray, val)
Adds the given number to the end of the array.
subroutine integer_varray_remove_entry(integer_varray, index)
Removes the entry at the given index, repacking values to maintain contiguous data.
subroutine pmc_mpi_pack_integer(buffer, position, val)
Packs the given value into the buffer, advancing position.
A map from integers to integers, together with its multi-valued inverse.
Common utility subroutines.
elemental subroutine integer_varray_deallocate(integer_varray)
Deallocates a previously allocated structure.
subroutine pmc_mpi_unpack_integer(buffer, position, val)
Unpacks the given value from the buffer, advancing position.
elemental subroutine integer_varray_zero(integer_varray)
Resets an integer_varray to have zero particles per bin.
Wrapper functions for MPI.
elemental subroutine integer_rmap_deallocate(integer_rmap)
Deallocates a previously allocated structure.
elemental subroutine integer_varray_allocate(integer_varray)
Allocates an empty structure.
subroutine pmc_mpi_unpack_integer_rmap(buffer, position, val)
Unpacks the given value from the buffer, advancing position.
subroutine integer_rmap_remove(integer_rmap, i_domain)
Replace the map at the given i_domain with the map value of the last entry, and delete the last entry...
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.
The integer_rmap_t structure and assocated subroutines.
subroutine pmc_mpi_pack_integer_rmap(buffer, position, val)
Packs the given value into the buffer, advancing position.
elemental subroutine integer_rmap_zero(integer_rmap)
Resets an integer_rmap to have zero particles per bin.
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.
elemental subroutine integer_rmap_allocate(integer_rmap)
Allocates an empty structure.
subroutine integer_rmap_change(integer_rmap, i_domain, i_range)
Change the map value of i_domain to i_range.
subroutine assert(code, condition_ok)
Errors unless condition_ok is true.
subroutine integer_rmap_append(integer_rmap, i_range)
Set the map value of the next free domain value to i_range.