48#include "fc_feature_defs.inc"
49MODULE xt_idxlist_abstract
50 USE xt_core,
ONLY: xt_int_kind, xt_mpi_fint_kind,
xt_stripe, &
54 USE iso_c_binding,
ONLY: c_ptr, c_int, c_f_pointer, c_null_ptr, &
62 TYPE,
BIND(C),
PUBLIC :: xt_idxlist
66 TYPE(c_ptr) :: cptr = c_null_ptr
73 FUNCTION xt_idxlist_f2c(idxlist) bind(c, name='xt_idxlist_f2c')
RESULT(p)
76 TYPE(xt_idxlist),
INTENT(in) :: idxlist
81 bind(c, name=
'xt_idxlist_get_pack_size_f2c') result(pack_size)
84 TYPE(xt_idxlist),
INTENT(in) :: idxlist
85 INTEGER(xt_mpi_fint_kind),
VALUE,
INTENT(in) :: comm
86 INTEGER(xt_mpi_fint_kind) :: pack_size
95 EXTERNAL :: xt_idxlist_pack_f
102 EXTERNAL :: xt_idxlist_unpack_f
122 FUNCTION xt_idxlist_get_num_indices_c(idxlist)
RESULT(num_indices) &
123 bind(c, name=
'xt_idxlist_get_num_indices')
124 IMPORT :: c_int, c_ptr
126 TYPE(c_ptr),
VALUE,
INTENT(in) :: idxlist
127 INTEGER(c_int) :: num_indices
128 END FUNCTION xt_idxlist_get_num_indices_c
130 SUBROUTINE xt_idxlist_get_indices_c(idxlist, indices) &
131 bind(c, name=
'xt_idxlist_get_indices')
132 IMPORT :: c_ptr, xt_int_kind
134 TYPE(c_ptr),
VALUE,
INTENT(in) :: idxlist
135 INTEGER(xt_int_kind),
INTENT(out) :: indices(*)
136 END SUBROUTINE xt_idxlist_get_indices_c
138 SUBROUTINE xt_idxlist_delete_c(idxlist) bind(C, name='xt_idxlist_delete')
141 TYPE(c_ptr),
VALUE,
INTENT(in) :: idxlist
142 END SUBROUTINE xt_idxlist_delete_c
144 FUNCTION xt_idxlist_get_indices_at_positions_c(idxlist, positions, &
145 num_pos, indices, undef_idx) &
146 bind(c, name=
'xt_idxlist_get_indices_at_positions') result(num_subst)
147 IMPORT :: c_ptr, c_int, xt_int_kind
148 TYPE(c_ptr),
VALUE,
INTENT(in) :: idxlist
149 INTEGER(c_int),
INTENT(in) :: positions(*)
150 INTEGER(c_int),
VALUE,
INTENT(in) :: num_pos
151 INTEGER(xt_int_kind),
VALUE,
INTENT(in) :: undef_idx
152 INTEGER(xt_int_kind),
INTENT(out) :: indices(*)
153 INTEGER(c_int) :: num_subst
154 END FUNCTION xt_idxlist_get_indices_at_positions_c
159 MODULE PROCEDURE xt_idxlist_delete_1
160 MODULE PROCEDURE xt_idxlist_delete_a1d
161 MODULE PROCEDURE xt_idxlist_delete_a2d
165 MODULE PROCEDURE xt_idxlist_get_indices_1d
166 MODULE PROCEDURE xt_idxlist_get_indices_2d
167 MODULE PROCEDURE xt_idxlist_get_indices_3d
168 MODULE PROCEDURE xt_idxlist_get_indices_4d
169 MODULE PROCEDURE xt_idxlist_get_indices_5d
170 MODULE PROCEDURE xt_idxlist_get_indices_6d
171 MODULE PROCEDURE xt_idxlist_get_indices_7d
175 MODULE PROCEDURE xt_idxlist_is_null
176 END INTERFACE xt_is_null
179 MODULE PROCEDURE xt_idxlist_get_indices_at_positions_a1d
180 MODULE PROCEDURE xt_idxlist_get_indices_at_positions_a1d_i2
181 MODULE PROCEDURE xt_idxlist_get_indices_at_positions_a1d_i4
182 MODULE PROCEDURE xt_idxlist_get_indices_at_positions_a1d_i8
186 FUNCTION xt_idxlist_get_pos_exts_of_index_stripes_c(idxlist, &
187 num_stripes, stripes, num_ext, pos_ext, single_match_only) &
188 bind(c, name=
'xt_idxlist_get_pos_exts_of_index_stripes') &
189 result(num_unmatched)
190 IMPORT :: c_ptr, c_int
191 TYPE(c_ptr),
VALUE,
INTENT(in) :: idxlist
192 INTEGER(c_int),
VALUE,
INTENT(in) :: num_stripes
193 TYPE(c_ptr),
VALUE,
INTENT(in) :: stripes
194 INTEGER(c_int),
INTENT(out) :: num_ext
195 TYPE(c_ptr),
INTENT(out) :: pos_ext
196 INTEGER(c_int),
VALUE,
INTENT(in) :: single_match_only
197 INTEGER(c_int) :: num_unmatched
198 END FUNCTION xt_idxlist_get_pos_exts_of_index_stripes_c
200 SUBROUTINE free_c(p) bind(c, name='free')
202 TYPE(c_ptr),
VALUE,
INTENT(in) :: p
203 END SUBROUTINE free_c
207 MODULE PROCEDURE gpe_is_i4_a_i4_p1d_l
208 MODULE PROCEDURE gpe_is_a_p1d_l
216 CHARACTER(len=*),
PARAMETER :: filename =
'xt_idxlist_f.f90'
219 FUNCTION xt_idxlist_is_null(idxlist)
RESULT(p)
220 TYPE(xt_idxlist),
INTENT(in) :: idxlist
222 p = .NOT. c_associated(idxlist%cptr)
223 END FUNCTION xt_idxlist_is_null
225 SUBROUTINE xt_idxlist_delete_1(idxlist)
226 TYPE(xt_idxlist),
INTENT(inout) :: idxlist
227 CALL xt_idxlist_delete_c(idxlist%cptr)
228 idxlist%cptr = c_null_ptr
229 END SUBROUTINE xt_idxlist_delete_1
231 SUBROUTINE xt_idxlist_delete_a1d(idxlists)
232 TYPE(xt_idxlist),
INTENT(inout) :: idxlists(:)
236 CALL xt_idxlist_delete_c(idxlists(i)%cptr)
237 idxlists(i)%cptr = c_null_ptr
239 END SUBROUTINE xt_idxlist_delete_a1d
241 SUBROUTINE xt_idxlist_delete_a2d(idxlists)
242 TYPE(xt_idxlist),
INTENT(inout) :: idxlists(:, :)
243 INTEGER :: i, j, m, n
244 m =
SIZE(idxlists, 1)
245 n =
SIZE(idxlists, 2)
248 CALL xt_idxlist_delete_c(idxlists(i, j)%cptr)
249 idxlists(i, j)%cptr = c_null_ptr
252 END SUBROUTINE xt_idxlist_delete_a2d
256 TYPE(xt_idxlist),
INTENT(in) :: idxlist
257 INTEGER,
VALUE,
INTENT(in) :: position
258 INTEGER(xt_int_kind),
INTENT(out) :: idx
260 INTEGER(c_int) :: position_c
263 FUNCTION xt_idxlist_get_index_at_position_c(idxlist, position, idx) &
264 bind(c, name=
'xt_idxlist_get_index_at_position') result(res)
265 IMPORT :: c_ptr, c_int, xt_int_kind
266 TYPE(c_ptr),
VALUE,
INTENT(in) :: idxlist
267 INTEGER(c_int),
VALUE,
INTENT(in) :: position
268 INTEGER(xt_int_kind),
INTENT(out) :: idx
269 INTEGER(c_int) :: res
270 END FUNCTION xt_idxlist_get_index_at_position_c
273 position_c = int(position, c_int)
274 res = xt_idxlist_get_index_at_position_c(idxlist%cptr, &
275 position_c, idx) /= 0
278 FUNCTION xt_idxlist_get_indices_at_positions_a1d(idxlist, positions, &
279 indices, undef_idx)
RESULT(num_subst)
281 TYPE(xt_idxlist),
INTENT(in) :: idxlist
282 INTEGER,
INTENT(in) :: positions(:)
283 INTEGER(xt_int_kind),
INTENT(out) :: indices(:)
284 INTEGER(xt_int_kind),
INTENT(in) :: undef_idx
285 INTEGER :: num_subst, n
286 INTEGER(c_int) :: num_positions_c
289 IF (n > huge(1_c_int)) n = huge(1_c_int)
291 num_positions_c = int(n, c_int)
292 num_subst = xt_idxlist_get_indices_at_positions_c(idxlist%cptr, &
293 int(positions, c_int), num_positions_c, &
295 END FUNCTION xt_idxlist_get_indices_at_positions_a1d
297 FUNCTION xt_idxlist_get_indices_at_positions_a1d_i2(idxlist, positions, &
298 num_pos, indices, undef_idx)
RESULT(num_subst)
300 TYPE(xt_idxlist),
INTENT(in) :: idxlist
301 INTEGER,
INTENT(in) :: positions(*)
302 INTEGER(xt_int_kind),
INTENT(out) :: indices(*)
303 INTEGER(xt_int_kind),
INTENT(in) :: undef_idx
304 INTEGER(i2),
INTENT(in) :: num_pos
306 INTEGER(c_int) :: num_pos_c
308 num_pos_c = int(num_pos, c_int)
309 num_subst = xt_idxlist_get_indices_at_positions_c(idxlist%cptr, &
310 int(positions(1:num_pos), c_int), num_pos_c, &
312 END FUNCTION xt_idxlist_get_indices_at_positions_a1d_i2
314 FUNCTION xt_idxlist_get_indices_at_positions_a1d_i4(idxlist, positions, &
315 num_pos, indices, undef_idx)
RESULT(num_subst)
317 TYPE(xt_idxlist),
INTENT(in) :: idxlist
318 INTEGER,
INTENT(in) :: positions(*)
319 INTEGER(xt_int_kind),
INTENT(out) :: indices(*)
320 INTEGER(xt_int_kind),
INTENT(in) :: undef_idx
321 INTEGER(i4),
INTENT(in) :: num_pos
323 INTEGER(c_int) :: num_pos_c
325 IF (num_pos > huge(1_c_int) .OR. num_pos < 0) &
326 CALL xt_abort(
"invalid number of positions", filename, __line__)
328 num_pos_c = int(num_pos, c_int)
329 num_subst = xt_idxlist_get_indices_at_positions_c(idxlist%cptr, &
330 int(positions(1:num_pos), c_int), num_pos_c, indices, undef_idx)
331 END FUNCTION xt_idxlist_get_indices_at_positions_a1d_i4
333 FUNCTION xt_idxlist_get_indices_at_positions_a1d_i8(idxlist, positions, &
334 num_pos, indices, undef_idx)
RESULT(num_subst)
336 TYPE(xt_idxlist),
INTENT(in) :: idxlist
337 INTEGER,
INTENT(in) :: positions(*)
338 INTEGER(xt_int_kind),
INTENT(out) :: indices(*)
339 INTEGER(xt_int_kind),
INTENT(in) :: undef_idx
340 INTEGER(i8),
INTENT(in) :: num_pos
342 INTEGER(c_int) :: num_pos_c
344 IF (num_pos > huge(1_c_int) .OR. num_pos < 0) &
345 CALL xt_abort(
"invalid number of positions", filename, __line__)
347 num_pos_c = int(num_pos, c_int)
348 num_subst = xt_idxlist_get_indices_at_positions_c(idxlist%cptr, &
349 int(positions(1:num_pos), c_int), num_pos_c, indices, undef_idx)
350 END FUNCTION xt_idxlist_get_indices_at_positions_a1d_i8
355 TYPE(xt_idxlist),
INTENT(in) :: idxlist
356 INTEGER(xt_int_kind),
VALUE,
INTENT(in) :: idx
357 INTEGER,
INTENT(out) :: position
359 INTEGER(c_int) :: position_c
362 FUNCTION xt_idxlist_get_position_of_index_c(idxlist, idx, position) &
363 bind(c, name=
'xt_idxlist_get_position_of_index') result(res)
364 IMPORT ::
xt_idxlist, xt_int_kind, c_int, c_ptr
365 TYPE(c_ptr),
VALUE,
INTENT(in) :: idxlist
366 INTEGER(xt_int_kind),
VALUE,
INTENT(in) :: idx
367 INTEGER(c_int),
INTENT(out) :: position
368 INTEGER(c_int) :: res
369 END FUNCTION xt_idxlist_get_position_of_index_c
372 notfound = xt_idxlist_get_position_of_index_c(idxlist%cptr, &
373 idx, position_c) /= 0
374 position = int(position_c)
378 offset)
RESULT(notfound)
380 TYPE(xt_idxlist),
INTENT(in) :: idxlist
381 INTEGER(xt_int_kind),
VALUE,
INTENT(in) :: idx
382 INTEGER,
INTENT(out) :: position
383 INTEGER,
INTENT(in) :: offset
385 INTEGER(c_int) :: position_c, offset_c
388 FUNCTION xt_idxlist_get_position_of_index_off_c(idxlist, idx, position, &
389 offset) bind(c, name='xt_idxlist_get_position_of_index_off') &
391 IMPORT ::
xt_idxlist, xt_int_kind, c_int, c_ptr
392 TYPE(c_ptr),
VALUE,
INTENT(in) :: idxlist
393 INTEGER(xt_int_kind),
VALUE,
INTENT(in) :: idx
394 INTEGER(c_int),
INTENT(out) :: position
395 INTEGER(c_int),
VALUE,
INTENT(in) :: offset
396 INTEGER(c_int) :: res
397 END FUNCTION xt_idxlist_get_position_of_index_off_c
400 offset_c = int(offset, c_int)
401 notfound = xt_idxlist_get_position_of_index_off_c(idxlist%cptr, &
402 idx, position_c, offset_c) /= 0
403 position = int(position_c)
407 single_match_only)
RESULT(num_missing)
409 TYPE(xt_idxlist),
INTENT(in) :: idxlist
410 INTEGER(xt_int_kind),
INTENT(in) :: indices(:)
411 INTEGER,
INTENT(out) :: positions(:)
412 LOGICAL,
INTENT(in) :: single_match_only
413 INTEGER :: num_missing, n, ofs
414 INTEGER(c_int) :: single_match_only_, num_pos_c
417 FUNCTION xt_idxlist_get_positions_of_indices_c(idxlist, indices, &
418 num_indices, positions, single_match_only) &
419 bind(c, name=
'xt_idxlist_get_positions_of_indices') &
421 IMPORT ::
xt_idxlist, xt_int_kind, c_int, c_ptr
422 TYPE(c_ptr),
VALUE,
INTENT(in) :: idxlist
423 INTEGER(xt_int_kind),
INTENT(in) :: indices(*)
424 INTEGER(c_int),
VALUE,
INTENT(in) :: num_indices
425 INTEGER(c_int),
INTENT(out) :: positions(*)
426 INTEGER(c_int),
VALUE,
INTENT(in) :: single_match_only
427 INTEGER(c_int) :: num_missing
428 END FUNCTION xt_idxlist_get_positions_of_indices_c
432 IF (
SIZE(positions) < n)
THEN
433 CALL xt_abort(
"positions array too small", filename, __line__)
437 single_match_only_ = merge(1_c_int, 0_c_int, single_match_only)
439 IF (n > huge(1_c_int))
THEN
440 num_missing = num_missing &
441 + int(xt_idxlist_get_positions_of_indices_c(&
442 idxlist%cptr, indices(ofs:), huge(1_c_int), &
443 positions(ofs:), single_match_only_))
444 ofs = ofs + huge(1_c_int)
445 n = n - huge(1_c_int)
447 num_pos_c = int(n, c_int)
448 num_missing = num_missing &
449 + int(xt_idxlist_get_positions_of_indices_c(&
450 idxlist%cptr, indices(ofs:), &
451 num_pos_c, positions(ofs:), single_match_only_))
459 TYPE(xt_idxlist),
INTENT(in) :: idxlist
460 INTEGER :: num_stripes
463 FUNCTION xt_idxlist_get_num_index_stripes_c(idxlist) &
464 bind(c, name=
'xt_idxlist_get_num_index_stripes') result(num_stripes)
465 IMPORT :: c_ptr, c_int
466 TYPE(c_ptr),
VALUE,
INTENT(in) :: idxlist
467 INTEGER(c_int) :: num_stripes
468 END FUNCTION xt_idxlist_get_num_index_stripes_c
471 INTEGER(c_int) :: num_stripes_c
473 num_stripes_c = xt_idxlist_get_num_index_stripes_c(idxlist%cptr)
474 IF (num_stripes_c > huge(num_stripes)) &
475 CALL xt_abort(
"number of stripes too large", filename, __line__)
476 num_stripes = int(num_stripes_c)
481 TYPE(xt_idxlist),
INTENT(in) :: idxlist
482 INTEGER(xt_int_kind) :: min_index
485 FUNCTION xt_idxlist_get_min_index_c(idxlist) &
486 bind(c, name=
'xt_idxlist_get_min_index') result(min_index)
487 IMPORT :: c_ptr, xt_int_kind
488 TYPE(c_ptr),
VALUE,
INTENT(in) :: idxlist
489 INTEGER(xt_int_kind) :: min_index
490 END FUNCTION xt_idxlist_get_min_index_c
493 min_index = xt_idxlist_get_min_index_c(idxlist%cptr)
498 TYPE(xt_idxlist),
INTENT(in) :: idxlist
499 INTEGER(xt_int_kind) :: max_index
502 FUNCTION xt_idxlist_get_max_index_c(idxlist) &
503 bind(c, name=
'xt_idxlist_get_max_index') result(max_index)
504 IMPORT :: c_ptr, xt_int_kind
505 TYPE(c_ptr),
VALUE,
INTENT(in) :: idxlist
506 INTEGER(xt_int_kind) :: max_index
507 END FUNCTION xt_idxlist_get_max_index_c
510 max_index = xt_idxlist_get_max_index_c(idxlist%cptr)
514 TYPE(xt_idxlist),
INTENT(in) :: idxlist
515 TYPE(xt_stripe),
ALLOCATABLE,
INTENT(out) :: stripes(:)
518 SUBROUTINE xt_idxlist_get_index_stripes_c(idxlist, stripes,&
519 num_stripes) bind(c, name='xt_idxlist_get_index_stripes')
520 IMPORT :: c_ptr, c_int
521 TYPE(c_ptr),
VALUE,
INTENT(in) :: idxlist
522 TYPE(c_ptr),
INTENT(out) :: stripes
523 INTEGER(c_int),
INTENT(out) :: num_stripes
524 END SUBROUTINE xt_idxlist_get_index_stripes_c
526 TYPE(c_ptr) :: stripes_c_ptr
527 INTEGER(c_int) :: num_stripes
528 TYPE(xt_stripe),
POINTER :: stripes_f_ptr(:)
529 INTEGER :: stripes_shape(1)
530 CALL xt_idxlist_get_index_stripes_c(idxlist%cptr, &
531 stripes_c_ptr, num_stripes)
532 IF (num_stripes > huge(stripes_shape)) &
533 CALL xt_abort(
"number of stripes too large", filename, __line__)
534 stripes_shape(1) = int(num_stripes)
535 IF (num_stripes > 0)
THEN
536 ALLOCATE(stripes(int(num_stripes)))
537 CALL c_f_pointer(stripes_c_ptr, stripes_f_ptr, stripes_shape)
538 stripes = stripes_f_ptr
540 CALL free_c(stripes_c_ptr)
544 global_start_index)
RESULT(bounds)
545 TYPE(xt_idxlist),
INTENT(in) :: idxlist
546 INTEGER(xt_int_kind),
INTENT(in) :: global_size(:)
547 INTEGER(xt_int_kind),
INTENT(in) :: global_start_index
548 TYPE(xt_bounds) :: bounds(SIZE(global_size))
549 INTEGER(c_int) :: ndim
552 SUBROUTINE xt_idxlist_get_bounding_box_c(idxlist, ndim, global_size, &
553 global_start_index, bounds) &
554 bind(c, name=
'xt_idxlist_get_bounding_box')
555 IMPORT :: c_int, c_ptr, xt_int_kind,
xt_bounds
556 TYPE(c_ptr),
VALUE,
INTENT(in) :: idxlist
557 INTEGER(c_int),
VALUE :: ndim
558 INTEGER(xt_int_kind),
INTENT(in) :: global_size(ndim)
559 INTEGER(xt_int_kind),
VALUE,
INTENT(in) :: global_start_index
560 TYPE(xt_bounds),
INTENT(out) :: bounds(ndim)
561 END SUBROUTINE xt_idxlist_get_bounding_box_c
564 ndim = int(
SIZE(global_size), c_int)
565 CALL xt_idxlist_get_bounding_box_c(idxlist%cptr, &
566 ndim, global_size, global_start_index, bounds)
571 TYPE(xt_idxlist),
INTENT(in) :: idxlist_src, idxlist_dst
572 TYPE(xt_idxlist) :: intersection
575 FUNCTION xt_idxlist_get_intersection_c(idxlist_src, idxlist_dst) &
576 bind(c, name=
'xt_idxlist_get_intersection') result(intersection)
578 TYPE(c_ptr),
VALUE,
INTENT(in) :: idxlist_src, idxlist_dst
579 TYPE(c_ptr) :: intersection
580 END FUNCTION xt_idxlist_get_intersection_c
583 intersection = xt_idxlist_c2f(xt_idxlist_get_intersection_c(&
584 idxlist_src%cptr, idxlist_dst%cptr))
588 TYPE(xt_idxlist),
INTENT(in) :: idxlist
589 TYPE(xt_idxlist) :: copy
592 FUNCTION xt_idxlist_copy_c(idxlist) bind(c, name='xt_idxlist_copy') &
595 TYPE(c_ptr),
VALUE,
INTENT(IN) :: idxlist
597 END FUNCTION xt_idxlist_copy_c
600 copy = xt_idxlist_c2f(xt_idxlist_copy_c(idxlist%cptr))
605 TYPE(xt_idxlist),
INTENT(in) :: idxlist
609 FUNCTION xt_idxlist_get_sorting_c(idxlist) &
610 bind(c, name=
'xt_idxlist_get_sorting') result(sorting)
611 IMPORT :: c_ptr, c_int
612 TYPE(c_ptr),
VALUE,
INTENT(IN) :: idxlist
613 INTEGER(c_int) :: sorting
614 END FUNCTION xt_idxlist_get_sorting_c
617 sorting = int(xt_idxlist_get_sorting_c(idxlist%cptr))
622 TYPE(xt_idxlist),
INTENT(in) :: idxlist
623 TYPE(xt_idxlist) :: copy
626 FUNCTION xt_idxlist_sorted_copy_c(idxlist) &
627 bind(c, name=
'xt_idxlist_sorted_copy') &
630 TYPE(c_ptr),
VALUE,
INTENT(IN) :: idxlist
632 END FUNCTION xt_idxlist_sorted_copy_c
635 copy = xt_idxlist_c2f(xt_idxlist_sorted_copy_c(idxlist%cptr))
640 TYPE(xt_idxlist),
INTENT(in) :: idxlist
641 TYPE(xt_config),
INTENT(in) :: config
642 TYPE(xt_idxlist) :: copy
645 FUNCTION xt_idxlist_sorted_copy_custom_c(idxlist, config) &
646 bind(c, name=
'xt_idxlist_sorted_copy_custom') &
649 TYPE(c_ptr),
VALUE,
INTENT(IN) :: idxlist, config
651 END FUNCTION xt_idxlist_sorted_copy_custom_c
654 copy = xt_idxlist_c2f(xt_idxlist_sorted_copy_custom_c(idxlist%cptr, &
659 FUNCTION xt_idxlist_c2f(idxlist)
RESULT(p)
660 TYPE(c_ptr),
INTENT(in) :: idxlist
661 TYPE(xt_idxlist) :: p
663 END FUNCTION xt_idxlist_c2f
666 TYPE(xt_idxlist),
INTENT(in) :: idxlist
667 INTEGER :: num_indices
669 n = xt_idxlist_get_num_indices_c(idxlist%cptr)
670 IF (n > huge(num_indices) .OR. n < -huge(num_indices)) &
671 CALL xt_abort(
"num_indices out of bounds", filename, __line__)
675 SUBROUTINE xt_idxlist_get_indices_1d(idxlist, indices)
676 TYPE(xt_idxlist),
INTENT(in) :: idxlist
677 INTEGER(xt_int_kind),
INTENT(out) :: indices(:)
678 INTEGER(c_int) :: num_indices
679 num_indices = xt_idxlist_get_num_indices_c(idxlist%cptr)
680 IF (num_indices >
SIZE(indices))
THEN
681 CALL xt_abort(
"indices array too small", filename, __line__)
683 CALL xt_idxlist_get_indices_c(idxlist%cptr, indices)
684 END SUBROUTINE xt_idxlist_get_indices_1d
686 SUBROUTINE xt_idxlist_get_indices_2d(idxlist, indices)
687 TYPE(xt_idxlist),
INTENT(in) :: idxlist
688 INTEGER(xt_int_kind),
INTENT(out) :: indices(:,:)
689 INTEGER(c_int) :: num_indices
690 num_indices = xt_idxlist_get_num_indices_c(idxlist%cptr)
691 IF (num_indices >
SIZE(indices))
THEN
692 CALL xt_abort(
"indices array too small", filename, __line__)
694 CALL xt_idxlist_get_indices_c(idxlist%cptr, indices)
695 END SUBROUTINE xt_idxlist_get_indices_2d
697 SUBROUTINE xt_idxlist_get_indices_3d(idxlist, indices)
698 TYPE(xt_idxlist),
INTENT(in) :: idxlist
699 INTEGER(xt_int_kind),
INTENT(out) :: indices(:,:,:)
700 INTEGER(c_int) :: num_indices
701 num_indices = xt_idxlist_get_num_indices_c(idxlist%cptr)
702 IF (num_indices >
SIZE(indices))
THEN
703 CALL xt_abort(
"indices array too small", filename, __line__)
705 CALL xt_idxlist_get_indices_c(idxlist%cptr, indices)
706 END SUBROUTINE xt_idxlist_get_indices_3d
708 SUBROUTINE xt_idxlist_get_indices_4d(idxlist, indices)
709 TYPE(xt_idxlist),
INTENT(in) :: idxlist
710 INTEGER(xt_int_kind),
INTENT(out) :: indices(:,:,:,:)
711 INTEGER(c_int) :: num_indices
712 num_indices = xt_idxlist_get_num_indices_c(idxlist%cptr)
713 IF (num_indices >
SIZE(indices))
THEN
714 CALL xt_abort(
"indices array too small", filename, __line__)
716 CALL xt_idxlist_get_indices_c(idxlist%cptr, indices)
717 END SUBROUTINE xt_idxlist_get_indices_4d
719 SUBROUTINE xt_idxlist_get_indices_5d(idxlist, indices)
720 TYPE(xt_idxlist),
INTENT(in) :: idxlist
721 INTEGER(xt_int_kind),
INTENT(out) :: indices(:,:,:,:,:)
722 INTEGER(c_int) :: num_indices
723 num_indices = xt_idxlist_get_num_indices_c(idxlist%cptr)
724 IF (num_indices >
SIZE(indices))
THEN
725 CALL xt_abort(
"indices array too small", filename, __line__)
727 CALL xt_idxlist_get_indices_c(idxlist%cptr, indices)
728 END SUBROUTINE xt_idxlist_get_indices_5d
730 SUBROUTINE xt_idxlist_get_indices_6d(idxlist, indices)
731 TYPE(xt_idxlist),
INTENT(in) :: idxlist
732 INTEGER(xt_int_kind),
INTENT(out) :: indices(:,:,:,:,:,:)
733 INTEGER(c_int) :: num_indices
734 num_indices = xt_idxlist_get_num_indices_c(idxlist%cptr)
735 IF (num_indices >
SIZE(indices))
THEN
736 CALL xt_abort(
"indices array too small", filename, __line__)
738 CALL xt_idxlist_get_indices_c(idxlist%cptr, indices)
739 END SUBROUTINE xt_idxlist_get_indices_6d
741 SUBROUTINE xt_idxlist_get_indices_7d(idxlist, indices)
742 TYPE(xt_idxlist),
INTENT(in) :: idxlist
743 INTEGER(xt_int_kind),
INTENT(out) :: indices(:,:,:,:,:,:,:)
744 INTEGER(c_int) :: num_indices
745 num_indices = xt_idxlist_get_num_indices_c(idxlist%cptr)
746 IF (num_indices >
SIZE(indices))
THEN
747 CALL xt_abort(
"indices array too small", filename, __line__)
749 CALL xt_idxlist_get_indices_c(idxlist%cptr, indices)
750 END SUBROUTINE xt_idxlist_get_indices_7d
753 TYPE(xt_idxlist),
INTENT(in) :: idxlist
754 INTEGER(xt_int_kind),
POINTER :: indices(:)
755 INTEGER(c_int) :: num_indices
756 TYPE(c_ptr) :: c_indices
757 INTEGER(xt_int_kind),
SAVE,
TARGET :: dummy(1) = -huge(indices)
758 INTEGER :: indices_shape(1)
760 FUNCTION xt_idxlist_get_indices_const_c(idxlist) &
761 bind(c, name=
'xt_idxlist_get_indices_const') result(indices)
764 TYPE(c_ptr),
VALUE,
INTENT(in) :: idxlist
765 TYPE(c_ptr) :: indices
766 END FUNCTION xt_idxlist_get_indices_const_c
768 num_indices = xt_idxlist_get_num_indices_c(idxlist%cptr)
769 IF (num_indices > 0_xt_int_kind)
THEN
770 IF (num_indices > huge(indices_shape)) &
771 CALL xt_abort(
"too many indices for default integer kind", &
773 indices_shape(1) = int(num_indices)
774 c_indices = xt_idxlist_get_indices_const_c(idxlist%cptr)
775 CALL c_f_pointer(c_indices, indices, indices_shape)
777 indices => dummy(1:0)
783 TYPE(xt_idxlist),
INTENT(in) :: idxlist
784 TYPE(xt_config),
INTENT(in) :: config
787 FUNCTION is_stripe_conversion_profitable_c(idxlist, config) &
789 BIND(c, name="xt_idxlist_is_stripe_conversion_profitable")
790 IMPORT :: c_ptr, c_int
791 TYPE(c_ptr),
VALUE,
INTENT(in) :: idxlist, config
792 INTEGER(c_int) :: profit
793 END FUNCTION is_stripe_conversion_profitable_c
795 profit = int(is_stripe_conversion_profitable_c(idxlist%cptr, &
799 FUNCTION gpe_is_i4_a_i4_p1d_l(idxlist, &
800 num_stripes, stripes, num_ext, pos_ext, single_match_only) &
801 result(num_unmatched)
802 TYPE(xt_idxlist),
INTENT(in) :: idxlist
803 INTEGER(i4),
INTENT(in) :: num_stripes
804 TYPE(xt_stripe),
INTENT(in),
TARGET :: stripes(num_stripes)
805 INTEGER,
INTENT(out) :: num_ext
806 TYPE(xt_pos_ext),
ALLOCATABLE,
INTENT(out) :: pos_ext(:)
807 LOGICAL,
INTENT(in) :: single_match_only
808 INTEGER :: num_unmatched
810 INTEGER(c_int) :: num_unmatched_c, num_ext_c, num_stripes_c
811 TYPE(c_ptr) :: pos_ext_c, stripes_c
812 TYPE(xt_pos_ext),
POINTER :: pos_ext_fptr(:)
813 INTEGER :: pos_ext_shape(1)
814 TYPE(xt_pos_ext),
TARGET :: dummy_stripe(1)
816 IF (num_stripes > huge(1_c_int) .OR. num_stripes < 0) &
817 CALL xt_abort(
"interface violation detected", filename, __line__)
819 IF (num_stripes > 0_i4)
THEN
820 stripes_c = c_loc(stripes)
822 stripes_c = c_loc(dummy_stripe)
824 num_stripes_c = int(num_stripes, c_int)
825 num_unmatched_c = xt_idxlist_get_pos_exts_of_index_stripes_c(&
826 idxlist%cptr, num_stripes_c, stripes_c, &
827 num_ext_c, pos_ext_c, merge(1_c_int, 0_c_int, single_match_only))
829 IF (num_ext_c > huge(1) .OR. num_ext_c < 0 &
830 .OR. num_unmatched_c > huge(1) .OR. num_unmatched_c < 0) &
831 CALL xt_abort(
"data representation problem", filename, __line__)
832 num_unmatched = int(num_unmatched_c)
833 num_ext = int(num_ext_c)
834 IF (num_ext > 0)
THEN
835 ALLOCATE(pos_ext(num_ext))
836 pos_ext_shape(1) = num_ext
837 CALL c_f_pointer(pos_ext_c, pos_ext_fptr, pos_ext_shape)
838 pos_ext = pos_ext_fptr
839 CALL free_c(pos_ext_c)
841 END FUNCTION gpe_is_i4_a_i4_p1d_l
843 FUNCTION gpe_is_a_p1d_l(idxlist, stripes, pos_ext, single_match_only) &
844 result(num_unmatched)
845 TYPE(xt_idxlist),
INTENT(in) :: idxlist
846 TYPE(xt_stripe),
INTENT(in) :: stripes(:)
847 TYPE(xt_pos_ext),
ALLOCATABLE,
INTENT(out) :: pos_ext(:)
848 LOGICAL,
INTENT(in) :: single_match_only
849 INTEGER :: num_unmatched
852 INTEGER(i4) :: num_stripes
854 num_stripes =
SIZE(stripes)
855 IF (num_stripes > 0)
THEN
856 num_unmatched = gpe_is_i4_a_i4_p1d_l(idxlist, num_stripes, stripes, &
857 num_ext, pos_ext, single_match_only)
861 END FUNCTION gpe_is_a_p1d_l
863END MODULE xt_idxlist_abstract
describes range of positions starting with start up to start + size - 1 i.e. [start,...
Xt_idxlist xt_idxlist_sorted_copy(Xt_idxlist idxlist)
int xt_idxlist_get_positions_of_indices(Xt_idxlist idxlist, const Xt_int *indices, int num_indices, int *positions, int single_match_only)
Xt_int xt_idxlist_get_min_index(Xt_idxlist idxlist)
int xt_idxlist_is_stripe_conversion_profitable(Xt_idxlist idxlist, Xt_config config)
const Xt_int * xt_idxlist_get_indices_const(Xt_idxlist idxlist)
int xt_idxlist_get_index_at_position(Xt_idxlist idxlist, int position, Xt_int *index)
Xt_int xt_idxlist_get_max_index(Xt_idxlist idxlist)
void xt_idxlist_get_indices(Xt_idxlist idxlist, Xt_int *indices)
int xt_idxlist_get_num_index_stripes(Xt_idxlist idxlist)
int xt_idxlist_get_position_of_index_off(Xt_idxlist idxlist, Xt_int index, int *position, int offset)
Xt_idxlist xt_idxlist_sorted_copy_custom(Xt_idxlist idxlist, Xt_config config)
size_t xt_idxlist_get_pack_size(Xt_idxlist idxlist, MPI_Comm comm)
int xt_idxlist_get_indices_at_positions(Xt_idxlist idxlist, const int *positions, int num_pos, Xt_int *indices, Xt_int undef_idx)
void xt_idxlist_get_index_stripes(Xt_idxlist idxlist, struct Xt_stripe **stripes, int *num_stripes)
void xt_idxlist_get_bounding_box(Xt_idxlist idxlist, unsigned ndim, const Xt_int global_size[ndim], Xt_int global_start_index, struct Xt_bounds bounds[ndim])
int xt_idxlist_get_pos_exts_of_index_stripes(Xt_idxlist idxlist, int num_stripes, const struct Xt_stripe stripes[num_stripes], int *num_ext, struct Xt_pos_ext **pos_ext, int single_match_only)
Xt_idxlist xt_idxlist_get_intersection(Xt_idxlist idxlist_src, Xt_idxlist idxlist_dst)
Xt_idxlist xt_idxlist_copy(Xt_idxlist idxlist)
int xt_idxlist_get_sorting(Xt_idxlist idxlist)
int xt_idxlist_get_position_of_index(Xt_idxlist idxlist, Xt_int index, int *position)
void xt_idxlist_delete(Xt_idxlist idxlist)
#define xt_idxlist_get_num_indices(idxlist)
Xt_idxlist xt_idxlist_f2c(struct xt_idxlist_f *p)
Xt_config xt_config_f2c(struct xt_config_f *p)