47 MODULE test_idxlist_utils
50 USE ftest_common,
ONLY: test_abort
51 USE iso_c_binding,
ONLY: c_ptr, c_int, c_size_t
55 FUNCTION test_err_count() bind(c, name='test_err_count')
RESULT(code)
57 INTEGER(c_int) :: code
58 END FUNCTION test_err_count
60 PUBLIC :: test_err_count
61 PUBLIC :: check_idxlist, check_stripes, check_offsets, &
62 idxlist_pack_unpack_copy, check_idxlist_copy
64 CHARACTER(len=*),
PARAMETER :: filename =
'test_idxlist_utils_f.f90'
66 SUBROUTINE check_idxlist(idxlist, ref_indices)
67 TYPE(xt_idxlist),
INTENT(in) :: idxlist
68 INTEGER(xt_int_kind),
INTENT(in) :: ref_indices(:)
70 INTEGER :: num_ref_indices
71 INTEGER(xt_int_kind) :: dummy(1)
72 INTEGER(c_int) :: num_ref_indices_c
75 SUBROUTINE check_idxlist_c(idxlist, ref_indices, ref_num_indices) &
76 bind(c, name=
'check_idxlist')
77 IMPORT :: xt_int_kind, c_ptr, c_int
79 TYPE(c_ptr),
VALUE,
INTENT(in) :: idxlist
80 INTEGER(xt_int_kind),
INTENT(in) :: ref_indices(*)
81 INTEGER(c_int),
VALUE,
INTENT(in) :: ref_num_indices
82 END SUBROUTINE check_idxlist_c
85 num_ref_indices =
SIZE(ref_indices)
86 IF (num_ref_indices > 0)
THEN
87 num_ref_indices_c = int(num_ref_indices, c_int)
91 dummy(1) = 0_xt_int_kind
95 END SUBROUTINE check_idxlist
97 SUBROUTINE check_stripes(stripes, ref_stripes)
98 TYPE(xt_stripe),
INTENT(in) :: stripes(:), ref_stripes(:)
99 INTEGER(c_int) :: num_stripes_c, ref_num_stripes_c
101 SUBROUTINE check_stripes_c(stripes, num_stripes, ref_stripes, &
102 ref_num_stripes) bind(c, name='check_stripes')
103 IMPORT :: xt_stripe, c_int
105 TYPE(xt_stripe),
INTENT(in) :: stripes(*), ref_stripes(*)
106 INTEGER(c_int),
VALUE,
INTENT(in) :: num_stripes, ref_num_stripes
107 END SUBROUTINE check_stripes_c
110 num_stripes_c = int(
SIZE(stripes), c_int)
111 ref_num_stripes_c = int(
SIZE(ref_stripes), c_int)
112 CALL check_stripes_c(stripes, num_stripes_c, ref_stripes, ref_num_stripes_c)
114 END SUBROUTINE check_stripes
116 SUBROUTINE check_offsets(offsets_a, offsets_b)
117 INTEGER(c_int),
INTENT(in) :: offsets_a(:), offsets_b(:)
118 INTEGER(c_size_t) :: num_offsets_c
120 SUBROUTINE check_offsets_c(num_offsets, offsets_a, offsets_b) &
121 bind(c, name=
'check_offsets')
122 IMPORT :: c_size_t, c_int
124 INTEGER(c_size_t),
VALUE,
INTENT(in) :: num_offsets
125 INTEGER(c_int),
INTENT(IN) :: offsets_a(num_offsets), &
126 offsets_b(num_offsets)
127 END SUBROUTINE check_offsets_c
130 IF (
SIZE(offsets_a) /=
size(offsets_b)) &
131 CALL test_abort(
"inequal number of array elements in eq test", &
134 num_offsets_c = int(
SIZE(offsets_a), c_size_t)
135 CALL check_offsets_c(num_offsets_c, offsets_a, offsets_b)
137 END SUBROUTINE check_offsets
139 FUNCTION idxlist_pack_unpack_copy(idxlist)
RESULT(idxlist_copy)
140 TYPE(xt_idxlist),
INTENT(in) :: idxlist
141 TYPE(xt_idxlist) :: idxlist_copy
144 FUNCTION idxlist_pack_unpack_copy_c(idxlist)
RESULT(idxlist_copy) &
145 bind(c, name=
'idxlist_pack_unpack_copy')
147 TYPE(c_ptr),
VALUE,
INTENT(in) :: idxlist
148 TYPE(c_ptr) :: idxlist_copy
149 END FUNCTION idxlist_pack_unpack_copy_c
153 = xt_idxlist_c2f(idxlist_pack_unpack_copy_c(
xt_idxlist_f2c(idxlist)))
155 END FUNCTION idxlist_pack_unpack_copy
157 SUBROUTINE check_idxlist_copy(idxlist, idxlist_copy, ref_indices, ref_stripes)
158 TYPE(xt_idxlist),
INTENT(in) :: idxlist, idxlist_copy
159 INTEGER(xt_int_kind),
INTENT(in) :: ref_indices(:)
160 TYPE(xt_stripe),
INTENT(in) :: ref_stripes(:)
161 INTEGER(c_size_t) :: num_ref_indices_c, num_ref_stripes_c
163 SUBROUTINE check_idxlist_copy_c(idxlist, idxlist_copy, &
164 num_ref_indices, ref_indices, &
165 num_ref_stripes, ref_stripes) bind(c, name='check_idxlist_copy')
166 IMPORT :: c_size_t, c_ptr, xt_int_kind, xt_stripe
167 TYPE(c_ptr),
VALUE,
INTENT(in) :: idxlist, idxlist_copy
168 INTEGER(c_size_t),
VALUE,
INTENT(in) :: num_ref_indices, num_ref_stripes
169 INTEGER(xt_int_kind),
INTENT(in) :: ref_indices(*)
170 TYPE(xt_stripe),
INTENT(in) :: ref_stripes(*)
171 END SUBROUTINE check_idxlist_copy_c
173 num_ref_indices_c = int(
SIZE(ref_indices), c_size_t)
174 num_ref_stripes_c = int(
SIZE(ref_stripes), c_size_t)
177 num_ref_stripes_c, ref_stripes)
178 END SUBROUTINE check_idxlist_copy
180 END MODULE test_idxlist_utils
Xt_idxlist xt_idxlist_f2c(struct xt_idxlist_f *p)