52 USE iso_c_binding,
ONLY: c_ptr, c_int, c_f_pointer, c_null_ptr, &
60 TYPE,
BIND(C),
PUBLIC :: xt_idxlist
64 TYPE(c_ptr) :: cptr = c_null_ptr
74 TYPE(xt_idxlist),
INTENT(in) :: idxlist
79 bind(c, name=
'xt_idxlist_get_pack_size_f2c') result(pack_size)
82 TYPE(xt_idxlist),
INTENT(in) :: idxlist
83 INTEGER(xt_mpi_fint_kind),
VALUE,
INTENT(in) :: comm
84 INTEGER(xt_mpi_fint_kind) :: pack_size
114 FUNCTION xt_idxlist_get_num_indices_c(idxlist)
RESULT(num_indices) &
115 bind(c, name=
'xt_idxlist_get_num_indices')
116 IMPORT :: c_int, c_ptr
118 TYPE(c_ptr),
VALUE,
INTENT(in) :: idxlist
119 INTEGER(c_int) :: num_indices
120 END FUNCTION xt_idxlist_get_num_indices_c
122 SUBROUTINE xt_idxlist_get_indices_c(idxlist, indices) &
123 bind(c, name=
'xt_idxlist_get_indices')
124 IMPORT :: c_ptr, xt_int_kind
126 TYPE(c_ptr),
VALUE,
INTENT(in) :: idxlist
127 INTEGER(xt_int_kind),
INTENT(out) :: indices(*)
128 END SUBROUTINE xt_idxlist_get_indices_c
130 SUBROUTINE xt_idxlist_delete_c(idxlist) bind(C, name='xt_idxlist_delete')
133 TYPE(c_ptr),
VALUE,
INTENT(in) :: idxlist
134 END SUBROUTINE xt_idxlist_delete_c
136 FUNCTION xt_idxlist_get_indices_at_positions_c(idxlist, positions, &
137 num_pos, indices, undef_idx) &
138 bind(c, name=
'xt_idxlist_get_indices_at_positions') result(num_subst)
139 IMPORT :: c_ptr, c_int, xt_int_kind
140 TYPE(c_ptr),
VALUE,
INTENT(in) :: idxlist
141 INTEGER(c_int),
INTENT(in) :: positions(*)
142 INTEGER(c_int),
VALUE,
INTENT(in) :: num_pos
143 INTEGER(xt_int_kind),
VALUE,
INTENT(in) :: undef_idx
144 INTEGER(xt_int_kind),
INTENT(out) :: indices(*)
145 INTEGER(c_int) :: num_subst
146 END FUNCTION xt_idxlist_get_indices_at_positions_c
151 MODULE PROCEDURE xt_idxlist_delete_1
152 MODULE PROCEDURE xt_idxlist_delete_a1d
153 MODULE PROCEDURE xt_idxlist_delete_a2d
157 MODULE PROCEDURE xt_idxlist_get_indices_1d
158 MODULE PROCEDURE xt_idxlist_get_indices_2d
159 MODULE PROCEDURE xt_idxlist_get_indices_3d
160 MODULE PROCEDURE xt_idxlist_get_indices_4d
161 MODULE PROCEDURE xt_idxlist_get_indices_5d
162 MODULE PROCEDURE xt_idxlist_get_indices_6d
163 MODULE PROCEDURE xt_idxlist_get_indices_7d
167 MODULE PROCEDURE xt_idxlist_is_null
168 END INTERFACE xt_is_null
171 MODULE PROCEDURE xt_idxlist_get_indices_at_positions_a1d
172 MODULE PROCEDURE xt_idxlist_get_indices_at_positions_a1d_i2
173 MODULE PROCEDURE xt_idxlist_get_indices_at_positions_a1d_i4
174 MODULE PROCEDURE xt_idxlist_get_indices_at_positions_a1d_i8
178 FUNCTION xt_idxlist_get_pos_exts_of_index_stripes_c(idxlist, &
179 num_stripes, stripes, num_ext, pos_ext, single_match_only) &
180 bind(c, name=
'xt_idxlist_get_pos_exts_of_index_stripes') &
181 result(num_unmatched)
182 IMPORT :: c_ptr, c_int
183 TYPE(c_ptr),
VALUE,
INTENT(in) :: idxlist
184 INTEGER(c_int),
VALUE,
INTENT(in) :: num_stripes
185 TYPE(c_ptr),
VALUE,
INTENT(in) :: stripes
186 INTEGER(c_int),
INTENT(out) :: num_ext
187 TYPE(c_ptr),
INTENT(out) :: pos_ext
188 INTEGER(c_int),
VALUE,
INTENT(in) :: single_match_only
189 INTEGER(c_int) :: num_unmatched
190 END FUNCTION xt_idxlist_get_pos_exts_of_index_stripes_c
192 SUBROUTINE free_c(p) bind(c, name='free')
194 TYPE(c_ptr),
VALUE,
INTENT(in) :: p
195 END SUBROUTINE free_c
199 MODULE PROCEDURE gpe_is_i4_a_i4_p1d_l
200 MODULE PROCEDURE gpe_is_a_p1d_l
203 CHARACTER(len=*),
PARAMETER :: filename =
'xt_idxlist_f.f90'
206 FUNCTION xt_idxlist_is_null(idxlist)
RESULT(p)
209 p = .NOT. c_associated(idxlist%cptr)
210 END FUNCTION xt_idxlist_is_null
212 SUBROUTINE xt_idxlist_delete_1(idxlist)
215 idxlist%cptr = c_null_ptr
216 END SUBROUTINE xt_idxlist_delete_1
218 SUBROUTINE xt_idxlist_delete_a1d(idxlists)
219 TYPE(
xt_idxlist),
INTENT(inout) :: idxlists(:)
224 idxlists(i)%cptr = c_null_ptr
226 END SUBROUTINE xt_idxlist_delete_a1d
228 SUBROUTINE xt_idxlist_delete_a2d(idxlists)
229 TYPE(
xt_idxlist),
INTENT(inout) :: idxlists(:, :)
230 INTEGER :: i, j, m, n
231 m =
SIZE(idxlists, 1)
232 n =
SIZE(idxlists, 2)
236 idxlists(i, j)%cptr = c_null_ptr
239 END SUBROUTINE xt_idxlist_delete_a2d
244 INTEGER,
VALUE,
INTENT(in) :: position
245 INTEGER(xt_int_kind),
INTENT(out) :: idx
247 INTEGER(c_int) :: position_c
250 FUNCTION xt_idxlist_get_index_at_position_c(idxlist, position, idx) &
251 bind(c, name=
'xt_idxlist_get_index_at_position') result(res)
252 IMPORT :: c_ptr, c_int, xt_int_kind
253 TYPE(c_ptr),
VALUE,
INTENT(in) :: idxlist
254 INTEGER(c_int),
VALUE,
INTENT(in) :: position
255 INTEGER(xt_int_kind),
INTENT(out) :: idx
256 INTEGER(c_int) :: res
257 END FUNCTION xt_idxlist_get_index_at_position_c
260 position_c = int(position, c_int)
261 res = xt_idxlist_get_index_at_position_c(
xt_idxlist_f2c(idxlist), &
262 position_c, idx) /= 0
265 FUNCTION xt_idxlist_get_indices_at_positions_a1d(idxlist, positions, &
266 indices, undef_idx)
RESULT(num_subst)
269 INTEGER,
INTENT(in) :: positions(:)
270 INTEGER(xt_int_kind),
INTENT(out) :: indices(:)
271 INTEGER(xt_int_kind),
INTENT(in) :: undef_idx
272 INTEGER :: num_subst, n
273 INTEGER(c_int) :: num_positions_c
276 IF (n > huge(1_c_int)) n = huge(1_c_int)
278 num_positions_c = int(n, c_int)
279 num_subst = xt_idxlist_get_indices_at_positions_c(
xt_idxlist_f2c(idxlist), &
280 int(positions, c_int), num_positions_c, &
282 END FUNCTION xt_idxlist_get_indices_at_positions_a1d
284 FUNCTION xt_idxlist_get_indices_at_positions_a1d_i2(idxlist, positions, &
285 num_pos, indices, undef_idx)
RESULT(num_subst)
288 INTEGER,
INTENT(in) :: positions(*)
289 INTEGER(xt_int_kind),
INTENT(out) :: indices(*)
290 INTEGER(xt_int_kind),
INTENT(in) :: undef_idx
291 INTEGER(i2),
INTENT(in) :: num_pos
293 INTEGER(c_int) :: num_pos_c
295 num_pos_c = int(num_pos, c_int)
296 num_subst = xt_idxlist_get_indices_at_positions_c(
xt_idxlist_f2c(idxlist), &
297 int(positions(1:num_pos), c_int), num_pos_c, &
299 END FUNCTION xt_idxlist_get_indices_at_positions_a1d_i2
301 FUNCTION xt_idxlist_get_indices_at_positions_a1d_i4(idxlist, positions, &
302 num_pos, indices, undef_idx)
RESULT(num_subst)
305 INTEGER,
INTENT(in) :: positions(*)
306 INTEGER(xt_int_kind),
INTENT(out) :: indices(*)
307 INTEGER(xt_int_kind),
INTENT(in) :: undef_idx
308 INTEGER(i4),
INTENT(in) :: num_pos
310 INTEGER(c_int) :: num_pos_c
312 IF (num_pos > huge(1_c_int) .OR. num_pos < 0) &
313 CALL xt_abort(
"invalid number of positions", filename, __line__)
315 num_pos_c = int(num_pos, c_int)
316 num_subst = xt_idxlist_get_indices_at_positions_c(
xt_idxlist_f2c(idxlist), &
317 int(positions(1:num_pos), c_int), num_pos_c, indices, undef_idx)
318 END FUNCTION xt_idxlist_get_indices_at_positions_a1d_i4
320 FUNCTION xt_idxlist_get_indices_at_positions_a1d_i8(idxlist, positions, &
321 num_pos, indices, undef_idx)
RESULT(num_subst)
324 INTEGER,
INTENT(in) :: positions(*)
325 INTEGER(xt_int_kind),
INTENT(out) :: indices(*)
326 INTEGER(xt_int_kind),
INTENT(in) :: undef_idx
327 INTEGER(i8),
INTENT(in) :: num_pos
329 INTEGER(c_int) :: num_pos_c
331 IF (num_pos > huge(1_c_int) .OR. num_pos < 0) &
332 CALL xt_abort(
"invalid number of positions", filename, __line__)
334 num_pos_c = int(num_pos, c_int)
335 num_subst = xt_idxlist_get_indices_at_positions_c(
xt_idxlist_f2c(idxlist), &
336 int(positions(1:num_pos), c_int), num_pos_c, indices, undef_idx)
337 END FUNCTION xt_idxlist_get_indices_at_positions_a1d_i8
343 INTEGER(xt_int_kind),
VALUE,
INTENT(in) :: idx
344 INTEGER,
INTENT(out) :: position
346 INTEGER(c_int) :: position_c
349 FUNCTION xt_idxlist_get_position_of_index_c(idxlist, idx, position) &
350 bind(c, name=
'xt_idxlist_get_position_of_index') result(res)
351 IMPORT ::
xt_idxlist, xt_int_kind, c_int, c_ptr
352 TYPE(c_ptr),
VALUE,
INTENT(in) :: idxlist
353 INTEGER(xt_int_kind),
VALUE,
INTENT(in) :: idx
354 INTEGER(c_int),
INTENT(out) :: position
355 INTEGER(c_int) :: res
356 END FUNCTION xt_idxlist_get_position_of_index_c
359 notfound = xt_idxlist_get_position_of_index_c(
xt_idxlist_f2c(idxlist), &
360 idx, position_c) /= 0
361 position = int(position_c)
365 offset)
RESULT(notfound)
368 INTEGER(xt_int_kind),
VALUE,
INTENT(in) :: idx
369 INTEGER,
INTENT(out) :: position
370 INTEGER,
INTENT(in) :: offset
372 INTEGER(c_int) :: position_c, offset_c
375 FUNCTION xt_idxlist_get_position_of_index_off_c(idxlist, idx, position, &
376 offset) bind(c, name='xt_idxlist_get_position_of_index_off') &
378 IMPORT ::
xt_idxlist, xt_int_kind, c_int, c_ptr
379 TYPE(c_ptr),
VALUE,
INTENT(in) :: idxlist
380 INTEGER(xt_int_kind),
VALUE,
INTENT(in) :: idx
381 INTEGER(c_int),
INTENT(out) :: position
382 INTEGER(c_int),
VALUE,
INTENT(in) :: offset
383 INTEGER(c_int) :: res
384 END FUNCTION xt_idxlist_get_position_of_index_off_c
387 offset_c = int(offset, c_int)
388 notfound = xt_idxlist_get_position_of_index_off_c(
xt_idxlist_f2c(idxlist), &
389 idx, position_c, offset_c) /= 0
390 position = int(position_c)
394 single_match_only)
RESULT(num_missing)
397 INTEGER(xt_int_kind),
INTENT(in) :: indices(:)
398 INTEGER,
INTENT(out) :: positions(:)
399 LOGICAL,
INTENT(in) :: single_match_only
400 INTEGER :: num_missing, n, ofs
401 INTEGER(c_int) :: single_match_only_, num_pos_c
404 FUNCTION xt_idxlist_get_positions_of_indices_c(idxlist, indices, &
405 num_indices, positions, single_match_only) &
406 bind(c, name=
'xt_idxlist_get_positions_of_indices') &
408 IMPORT ::
xt_idxlist, xt_int_kind, c_int, c_ptr
409 TYPE(c_ptr),
VALUE,
INTENT(in) :: idxlist
410 INTEGER(xt_int_kind),
INTENT(in) :: indices(*)
411 INTEGER(c_int),
VALUE,
INTENT(in) :: num_indices
412 INTEGER(c_int),
INTENT(out) :: positions(*)
413 INTEGER(c_int),
VALUE,
INTENT(in) :: single_match_only
414 INTEGER(c_int) :: num_missing
415 END FUNCTION xt_idxlist_get_positions_of_indices_c
419 IF (
SIZE(positions) < n)
THEN
420 CALL xt_abort(
"positions array too small", filename, __line__)
424 single_match_only_ = merge(1_c_int, 0_c_int, single_match_only)
426 IF (n > huge(1_c_int))
THEN
427 num_missing = num_missing &
428 + int(xt_idxlist_get_positions_of_indices_c(&
430 positions(ofs:), single_match_only_))
431 ofs = ofs + huge(1_c_int)
432 n = n - huge(1_c_int)
434 num_pos_c = int(n, c_int)
435 num_missing = num_missing &
436 + int(xt_idxlist_get_positions_of_indices_c(&
438 num_pos_c, positions(ofs:), single_match_only_))
446 TYPE(xt_stripe),
ALLOCATABLE,
INTENT(out) :: stripes(:)
449 SUBROUTINE xt_idxlist_get_index_stripes_c(idxlist, stripes,&
450 num_stripes) bind(c, name='xt_idxlist_get_index_stripes')
451 IMPORT :: c_ptr, c_int
452 TYPE(c_ptr),
VALUE,
INTENT(in) :: idxlist
453 TYPE(c_ptr),
INTENT(out) :: stripes
454 INTEGER(c_int),
INTENT(out) :: num_stripes
455 END SUBROUTINE xt_idxlist_get_index_stripes_c
457 TYPE(c_ptr) :: stripes_c_ptr
458 INTEGER(c_int) :: num_stripes
459 TYPE(xt_stripe),
POINTER :: stripes_f_ptr(:)
460 INTEGER :: stripes_shape(1)
462 stripes_c_ptr, num_stripes)
463 IF (num_stripes > huge(stripes_shape)) &
464 CALL xt_abort(
"number of stripes too large", filename, __line__)
465 stripes_shape(1) = int(num_stripes)
466 IF (num_stripes > 0)
THEN
467 ALLOCATE(stripes(int(num_stripes)))
468 CALL c_f_pointer(stripes_c_ptr, stripes_f_ptr, stripes_shape)
469 stripes = stripes_f_ptr
471 CALL free_c(stripes_c_ptr)
475 global_start_index)
RESULT(bounds)
477 INTEGER(xt_int_kind),
INTENT(in) :: global_size(:)
478 INTEGER(xt_int_kind),
INTENT(in) :: global_start_index
479 TYPE(xt_bounds) :: bounds(size(global_size))
480 INTEGER(c_int) :: ndim
483 SUBROUTINE xt_idxlist_get_bounding_box_c(idxlist, ndim, global_size, &
484 global_start_index, bounds) &
485 bind(c, name=
'xt_idxlist_get_bounding_box')
486 IMPORT :: c_int, c_ptr, xt_int_kind, xt_bounds
487 TYPE(c_ptr),
VALUE,
INTENT(in) :: idxlist
488 INTEGER(c_int),
VALUE :: ndim
489 INTEGER(xt_int_kind),
INTENT(in) :: global_size(ndim)
490 INTEGER(xt_int_kind),
VALUE,
INTENT(in) :: global_start_index
491 TYPE(xt_bounds),
INTENT(out) :: bounds(ndim)
492 END SUBROUTINE xt_idxlist_get_bounding_box_c
495 ndim = int(
SIZE(global_size), c_int)
497 ndim, global_size, global_start_index, bounds)
502 TYPE(
xt_idxlist),
INTENT(in) :: idxlist_src, idxlist_dst
506 FUNCTION xt_idxlist_get_intersection_c(idxlist_src, idxlist_dst) &
507 bind(c, name=
'xt_idxlist_get_intersection') result(intersection)
509 TYPE(c_ptr),
VALUE,
INTENT(in) :: idxlist_src, idxlist_dst
510 TYPE(c_ptr) :: intersection
511 END FUNCTION xt_idxlist_get_intersection_c
523 FUNCTION xt_idxlist_copy_c(idxlist) bind(c, name='xt_idxlist_copy') &
526 TYPE(c_ptr),
VALUE,
INTENT(IN) :: idxlist
528 END FUNCTION xt_idxlist_copy_c
536 TYPE(c_ptr),
INTENT(in) :: idxlist
543 INTEGER :: num_indices
546 IF (n > huge(num_indices) .OR. n < -huge(num_indices)) &
547 CALL xt_abort(
"num_indices out of bounds", filename, __line__)
551 SUBROUTINE xt_idxlist_get_indices_1d(idxlist, indices)
553 INTEGER(xt_int_kind),
INTENT(out) :: indices(:)
554 INTEGER(c_int) :: num_indices
555 num_indices = xt_idxlist_get_num_indices_c(
xt_idxlist_f2c(idxlist))
556 IF (num_indices >
SIZE(indices))
THEN
557 CALL xt_abort(
"indices array too small", filename, __line__)
560 END SUBROUTINE xt_idxlist_get_indices_1d
562 SUBROUTINE xt_idxlist_get_indices_2d(idxlist, indices)
564 INTEGER(xt_int_kind),
INTENT(out) :: indices(:,:)
565 INTEGER(c_int) :: num_indices
566 num_indices = xt_idxlist_get_num_indices_c(
xt_idxlist_f2c(idxlist))
567 IF (num_indices >
SIZE(indices))
THEN
568 CALL xt_abort(
"indices array too small", filename, __line__)
571 END SUBROUTINE xt_idxlist_get_indices_2d
573 SUBROUTINE xt_idxlist_get_indices_3d(idxlist, indices)
575 INTEGER(xt_int_kind),
INTENT(out) :: indices(:,:,:)
576 INTEGER(c_int) :: num_indices
577 num_indices = xt_idxlist_get_num_indices_c(
xt_idxlist_f2c(idxlist))
578 IF (num_indices >
SIZE(indices))
THEN
579 CALL xt_abort(
"indices array too small", filename, __line__)
582 END SUBROUTINE xt_idxlist_get_indices_3d
584 SUBROUTINE xt_idxlist_get_indices_4d(idxlist, indices)
586 INTEGER(xt_int_kind),
INTENT(out) :: indices(:,:,:,:)
587 INTEGER(c_int) :: num_indices
588 num_indices = xt_idxlist_get_num_indices_c(
xt_idxlist_f2c(idxlist))
589 IF (num_indices >
SIZE(indices))
THEN
590 CALL xt_abort(
"indices array too small", filename, __line__)
593 END SUBROUTINE xt_idxlist_get_indices_4d
595 SUBROUTINE xt_idxlist_get_indices_5d(idxlist, indices)
597 INTEGER(xt_int_kind),
INTENT(out) :: indices(:,:,:,:,:)
598 INTEGER(c_int) :: num_indices
599 num_indices = xt_idxlist_get_num_indices_c(
xt_idxlist_f2c(idxlist))
600 IF (num_indices >
SIZE(indices))
THEN
601 CALL xt_abort(
"indices array too small", filename, __line__)
604 END SUBROUTINE xt_idxlist_get_indices_5d
606 SUBROUTINE xt_idxlist_get_indices_6d(idxlist, indices)
608 INTEGER(xt_int_kind),
INTENT(out) :: indices(:,:,:,:,:,:)
609 INTEGER(c_int) :: num_indices
610 num_indices = xt_idxlist_get_num_indices_c(
xt_idxlist_f2c(idxlist))
611 IF (num_indices >
SIZE(indices))
THEN
612 CALL xt_abort(
"indices array too small", filename, __line__)
615 END SUBROUTINE xt_idxlist_get_indices_6d
617 SUBROUTINE xt_idxlist_get_indices_7d(idxlist, indices)
619 INTEGER(xt_int_kind),
INTENT(out) :: indices(:,:,:,:,:,:,:)
620 INTEGER(c_int) :: num_indices
621 num_indices = xt_idxlist_get_num_indices_c(
xt_idxlist_f2c(idxlist))
622 IF (num_indices >
SIZE(indices))
THEN
623 CALL xt_abort(
"indices array too small", filename, __line__)
626 END SUBROUTINE xt_idxlist_get_indices_7d
630 INTEGER(xt_int_kind),
POINTER :: indices(:)
631 INTEGER(c_int) :: num_indices
632 TYPE(c_ptr) :: c_indices
633 INTEGER(xt_int_kind),
SAVE,
TARGET :: dummy(1) = -huge(indices)
634 INTEGER :: indices_shape(1)
636 FUNCTION xt_idxlist_get_indices_const_c(idxlist) &
637 bind(c, name=
'xt_idxlist_get_indices_const') result(indices)
640 TYPE(c_ptr),
VALUE,
INTENT(in) :: idxlist
641 TYPE(c_ptr) :: indices
642 END FUNCTION xt_idxlist_get_indices_const_c
644 num_indices = xt_idxlist_get_num_indices_c(
xt_idxlist_f2c(idxlist))
645 IF (num_indices > 0_xt_int_kind)
THEN
646 IF (num_indices > huge(indices_shape)) &
647 CALL xt_abort(
"too many indices for default integer kind", &
649 indices_shape(1) = int(num_indices)
650 c_indices = xt_idxlist_get_indices_const_c(
xt_idxlist_f2c(idxlist))
651 CALL c_f_pointer(c_indices, indices, indices_shape)
653 indices => dummy(1:0)
657 FUNCTION gpe_is_i4_a_i4_p1d_l(idxlist, &
658 num_stripes, stripes, num_ext, pos_ext, single_match_only) &
659 result(num_unmatched)
661 INTEGER(i4),
INTENT(in) :: num_stripes
662 TYPE(xt_stripe),
INTENT(in),
TARGET :: stripes(num_stripes)
663 INTEGER,
INTENT(out) :: num_ext
664 TYPE(xt_pos_ext),
ALLOCATABLE,
INTENT(out) :: pos_ext(:)
665 LOGICAL,
INTENT(in) :: single_match_only
666 INTEGER :: num_unmatched
668 INTEGER(c_int) :: num_unmatched_c, num_ext_c, num_stripes_c
669 TYPE(c_ptr) :: pos_ext_c, stripes_c
670 TYPE(xt_pos_ext),
POINTER :: pos_ext_fptr(:)
671 INTEGER :: pos_ext_shape(1)
672 TYPE(xt_pos_ext),
TARGET :: dummy_stripe(1)
674 IF (num_stripes > huge(1_c_int) .OR. num_stripes < 0) &
675 CALL xt_abort(
"interface violation detected", filename, __line__)
677 IF (num_stripes > 0_i4)
THEN
678 stripes_c = c_loc(stripes)
680 stripes_c = c_loc(dummy_stripe)
682 num_stripes_c = int(num_stripes, c_int)
683 num_unmatched_c = xt_idxlist_get_pos_exts_of_index_stripes_c(&
685 num_ext_c, pos_ext_c, merge(1_c_int, 0_c_int, single_match_only))
687 IF (num_ext_c > huge(1) .OR. num_ext_c < 0 &
688 .OR. num_unmatched_c > huge(1) .OR. num_unmatched_c < 0) &
689 CALL xt_abort(
"data representation problem", filename, __line__)
690 num_unmatched = int(num_unmatched_c)
691 num_ext = int(num_ext_c)
692 IF (num_ext > 0)
THEN
693 ALLOCATE(pos_ext(num_ext))
694 pos_ext_shape(1) = num_ext
695 CALL c_f_pointer(pos_ext_c, pos_ext_fptr, pos_ext_shape)
696 pos_ext = pos_ext_fptr
697 CALL free_c(pos_ext_c)
699 END FUNCTION gpe_is_i4_a_i4_p1d_l
701 FUNCTION gpe_is_a_p1d_l(idxlist, stripes, pos_ext, single_match_only) &
702 result(num_unmatched)
704 TYPE(xt_stripe),
INTENT(in) :: stripes(:)
705 TYPE(xt_pos_ext),
ALLOCATABLE,
INTENT(out) :: pos_ext(:)
706 LOGICAL,
INTENT(in) :: single_match_only
707 INTEGER :: num_unmatched
710 INTEGER(i4) :: num_stripes
712 num_stripes =
SIZE(stripes)
713 IF (num_stripes > 0)
THEN
714 num_unmatched = gpe_is_i4_a_i4_p1d_l(idxlist, num_stripes, stripes, &
715 num_ext, pos_ext, single_match_only)
719 END FUNCTION gpe_is_a_p1d_l
integer, parameter, public i8
integer, parameter, public xt_int_kind
integer, parameter, public i4
integer, parameter, public i2
external, public xt_idxlist_unpack_f
external, public xt_idxlist_pack_f
type(xt_idxlist) function, public xt_idxlist_c2f(idxlist)
describes range of positions starting with start up to start + size - 1 i.e. [start,...
int xt_idxlist_get_num_indices(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)
int xt_idxlist_get_index_at_position(Xt_idxlist idxlist, int position, Xt_int *index)
void xt_idxlist_get_indices(Xt_idxlist idxlist, Xt_int *indices)
int xt_idxlist_get_position_of_index_off(Xt_idxlist idxlist, Xt_int index, int *position, int offset)
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)
const Xt_int * xt_idxlist_get_indices_const(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)