76 allocate(integer_rmap2%inverse(0, 0))
90 integer,
intent(in) :: n_range_1
92 integer,
intent(in) :: n_range_2
96 allocate(integer_rmap2%inverse(n_range_1, n_range_2))
113 deallocate(integer_rmap2%inverse)
142 integer,
intent(in) :: i_range_1
144 integer,
intent(in) :: i_range_2
146 call
assert(708651144, i_range_1 >= 1)
147 call
assert(779828769, i_range_1 <=
size(integer_rmap2%inverse, 1))
148 call
assert(978259336, i_range_2 >= 1)
149 call
assert(238981205, i_range_2 <=
size(integer_rmap2%inverse, 2))
155 integer_rmap2%forward1%n_entry)
157 integer_rmap2%inverse(i_range_1, i_range_2)%n_entry)
170 integer,
intent(in) :: i_domain
172 integer,
intent(in) :: i_range_1
174 integer,
intent(in) :: i_range_2
176 integer :: i_range_1_old, i_range_2_old, i_index_old, i_domain_shifted
178 call
assert(191141591, i_domain >= 1)
179 call
assert(240079303, i_domain <= integer_rmap2%forward1%n_entry)
180 call
assert(671426897, i_range_1 >= 1)
181 call
assert(311976942, i_range_1 <=
size(integer_rmap2%inverse, 1))
182 call
assert(383129645, i_range_2 >= 1)
183 call
assert(771283685, i_range_2 <=
size(integer_rmap2%inverse, 2))
185 i_range_1_old = integer_rmap2%forward1%entry(i_domain)
186 i_range_2_old = integer_rmap2%forward2%entry(i_domain)
187 if ((i_range_1_old == i_range_1) .and. (i_range_1_old == i_range_1))
return
188 i_index_old = integer_rmap2%index%entry(i_domain)
192 integer_rmap2%inverse(i_range_1_old, i_range_2_old), i_index_old)
194 <= integer_rmap2%inverse(i_range_1_old, i_range_2_old)%n_entry)
then
197 i_domain_shifted = integer_rmap2%inverse(i_range_1_old, &
198 i_range_2_old)%entry(i_index_old)
199 integer_rmap2%index%entry(i_domain_shifted) = i_index_old
203 integer_rmap2%forward1%entry(i_domain) = i_range_1
204 integer_rmap2%forward2%entry(i_domain) = i_range_2
207 integer_rmap2%index%entry(i_domain) &
208 = integer_rmap2%inverse(i_range_1, i_range_2)%n_entry
221 integer,
intent(in) :: i_domain
223 integer :: i_range_1_old, i_range_2_old, i_index_old, i_domain_shifted
224 integer :: i_range_1_fix, i_range_2_fix, i_index_fix, i_domain_fix
226 call
assert(242566612, i_domain >= 1)
227 call
assert(110569289, i_domain <= integer_rmap2%forward1%n_entry)
234 i_range_1_old = integer_rmap2%forward1%entry(i_domain)
235 i_range_2_old = integer_rmap2%forward2%entry(i_domain)
236 i_index_old = integer_rmap2%index%entry(i_domain)
238 i_domain_shifted = integer_rmap2%forward1%n_entry
239 if (i_domain_shifted /= i_domain)
then
240 i_range_1_fix = integer_rmap2%forward1%entry(i_domain_shifted)
241 i_range_2_fix = integer_rmap2%forward2%entry(i_domain_shifted)
242 i_index_fix = integer_rmap2%index%entry(i_domain_shifted)
243 integer_rmap2%inverse(i_range_1_fix, i_range_2_fix)%entry(i_index_fix) &
254 i_index_fix = integer_rmap2%inverse(i_range_1_old, i_range_2_old)%n_entry
255 i_domain_fix = integer_rmap2%inverse(i_range_1_old, i_range_2_old)%entry(&
258 integer_rmap2%inverse(i_range_1_old, i_range_2_old), i_index_old)
260 if (i_index_fix /= i_index_old)
then
262 integer_rmap2%index%entry(i_domain_fix) = i_index_old
271 n_range_2, continue_on_error)
276 character(len=*),
intent(in) :: name
278 integer,
intent(in) :: n_domain
280 integer,
intent(in) :: n_range_1
282 integer,
intent(in) :: n_range_2
284 logical,
intent(in) :: continue_on_error
286 integer :: i_domain, i_range_1, i_range_2, i_index
288 if ((n_domain /= integer_rmap2%forward1%n_entry) &
289 .or. (n_domain /= integer_rmap2%forward2%n_entry) &
290 .or. (n_domain /= integer_rmap2%index%n_entry) &
291 .or. (n_range_1 /=
size(integer_rmap2%inverse, 1)) &
292 .or. (n_range_2 /=
size(integer_rmap2%inverse, 2)))
then
293 write(0,*)
'ERROR integer_rmap2 A:', name
294 write(0,*)
'n_domain', n_domain
295 write(0,*)
'n_range_1', n_range_1
296 write(0,*)
'n_range_2', n_range_2
297 write(0,*)
'integer_rmap2%forward1%n_entry', &
298 integer_rmap2%forward1%n_entry
299 write(0,*)
'integer_rmap2%forward2%n_entry', &
300 integer_rmap2%forward2%n_entry
301 write(0,*)
'integer_rmap2%index%n_entry', integer_rmap2%index%n_entry
302 write(0,*)
'size(integer_rmap2%inverse, 1)', &
303 size(integer_rmap2%inverse, 1)
304 write(0,*)
'size(integer_rmap2%inverse, 2)', &
305 size(integer_rmap2%inverse, 2)
306 call
assert(786992107, continue_on_error)
309 do i_domain = 1,n_domain
310 i_range_1 = integer_rmap2%forward1%entry(i_domain)
311 i_range_2 = integer_rmap2%forward2%entry(i_domain)
312 if ((i_range_1 < 1) .or. (i_range_1 > n_range_1) &
313 .or. (i_range_2 < 1) .or. (i_range_2 > n_range_2))
then
314 write(0,*)
'ERROR integer_rmap2 B:', name
315 write(0,*)
'i_domain', i_domain
316 write(0,*)
'i_range_1', i_range_1
317 write(0,*)
'i_range_2', i_range_2
318 write(0,*)
'n_range_1', n_range_1
319 write(0,*)
'n_range_2', n_range_2
320 call
assert(723392756, continue_on_error)
323 i_index = integer_rmap2%index%entry(i_domain)
324 if ((i_index < 1) .or. (i_index &
325 > integer_rmap2%inverse(i_range_1, i_range_2)%n_entry))
then
326 write(0,*)
'ERROR integer_rmap2 C:', name
327 write(0,*)
'i_domain', i_domain
328 write(0,*)
'i_range_1', i_range_1
329 write(0,*)
'i_range_2', i_range_2
330 write(0,*)
'i_index', i_index
331 write(0,*)
'integer_rmap2%inverse(i_range_1, i_range_2)%n_entry', &
332 integer_rmap2%inverse(i_range_1, i_range_2)%n_entry
333 call
assert(317458796, continue_on_error)
336 /= integer_rmap2%inverse(i_range_1, i_range_2)%entry(i_index))
then
337 write(0,*)
'ERROR integer_rmap2 D:', name
338 write(0,*)
'i_domain', i_domain
339 write(0,*)
'i_range_1', i_range_1
340 write(0,*)
'i_range_2', i_range_2
341 write(0,*)
'i_index', i_index
342 write(0,*)
'integer_rmap2%inverse(i_range_1, ' &
343 //
'i_range_2)%entry(i_index)', &
344 integer_rmap2%inverse(i_range_1, i_range_2)%entry(i_index)
345 call
assert(662733308, continue_on_error)
349 do i_range_1 = 1,n_range_1
350 do i_range_2 = 1,n_range_2
351 do i_index = 1,integer_rmap2%inverse(i_range_1, i_range_2)%n_entry
353 = integer_rmap2%inverse(i_range_1, i_range_2)%entry(i_index)
354 if ((i_domain < 1) .or. (i_domain > n_domain))
then
355 write(0,*)
'ERROR integer_rmap2 E:', name
356 write(0,*)
'i_range_1', i_range_1
357 write(0,*)
'i_range_2', i_range_2
358 write(0,*)
'i_index', i_index
359 write(0,*)
'i_domain', i_domain
360 write(0,*)
'n_domain', n_domain
361 call
assert(639449827, continue_on_error)
363 if ((i_range_1 /= integer_rmap2%forward1%entry(i_domain)) &
364 .or. (i_range_2 /= integer_rmap2%forward2%entry(i_domain)) &
365 .or. (i_index /= integer_rmap2%index%entry(i_domain)))
then
366 write(0,*)
'ERROR integer_rmap2 F:', name
367 write(0,*)
'i_domain', i_domain
368 write(0,*)
'i_range_1', i_range_1
369 write(0,*)
'i_range_2', i_range_2
370 write(0,*)
'integer_rmap2%forward1%entry(i_domain)', &
371 integer_rmap2%forward1%entry(i_domain)
372 write(0,*)
'integer_rmap2%forward2%entry(i_domain)', &
373 integer_rmap2%forward2%entry(i_domain)
374 write(0,*)
'i_index', i_index
375 write(0,*)
'integer_rmap2%index%entry(i_domain)', &
376 integer_rmap2%index%entry(i_domain)
377 call
assert(636832060, continue_on_error)
393 integer :: i_1, i_2, total_size
400 do i_1 = 1,
size(val%inverse, 1)
401 do i_2 = 1,
size(val%inverse, 2)
402 total_size = total_size &
417 character,
intent(inout) :: buffer(:)
419 integer,
intent(inout) :: position
424 integer :: prev_position, i_1, i_2
426 prev_position = position
431 do i_1 = 1,
size(val%inverse, 1)
432 do i_2 = 1,
size(val%inverse, 2)
434 val%inverse(i_1, i_2))
450 character,
intent(inout) :: buffer(:)
452 integer,
intent(inout) :: position
457 integer :: prev_position, i_1, i_2, n_1, n_2
459 prev_position = position
466 do i_1 = 1,
size(val%inverse, 1)
467 do i_2 = 1,
size(val%inverse, 2)
469 val%inverse(i_1, i_2))
elemental subroutine integer_rmap2_allocate(integer_rmap2)
Allocates an empty structure.
integer function pmc_mpi_pack_size_integer_rmap2(val)
Determines the number of bytes required to pack the given value.
subroutine pmc_mpi_pack_integer_rmap2(buffer, position, val)
Packs the given value into the buffer, advancing position.
elemental subroutine integer_rmap2_allocate_size(integer_rmap2, n_range_1, n_range_2)
Allocates a structure with the given size.
elemental subroutine integer_rmap2_deallocate(integer_rmap2)
Deallocates a previously allocated structure.
integer function pmc_mpi_pack_size_integer(val)
Determines the number of bytes required to pack the given value.
subroutine integer_rmap2_append(integer_rmap2, i_range_1, i_range_2)
Set the map value of the next free domain value to (i_range_1, i_range_2.
subroutine integer_rmap2_check(integer_rmap2, name, n_domain, n_range_1, n_range_2, continue_on_error)
Check that the data is consistent.
subroutine pmc_mpi_unpack_integer_rmap2(buffer, position, val)
Unpacks the given value from the buffer, advancing position.
The integer_varray_t structure and assocated subroutines.
subroutine integer_rmap2_change(integer_rmap2, i_domain, i_range_1, i_range_2)
Change the map value of i_domain to (i_range_1, i_range_2).
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.
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.
A map , together with its multi-valued inverse.
elemental subroutine integer_varray_zero(integer_varray)
Resets an integer_varray to have zero particles per bin.
Wrapper functions for MPI.
elemental subroutine integer_rmap2_zero(integer_rmap2)
Resets an integer_rmap2 to have zero particles per bin.
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.
The integer_rmap2_t structure and assocated subroutines.
subroutine integer_rmap2_remove(integer_rmap2, 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_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.