1
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47#include "fc_feature_defs.inc"
48MODULE test_idxlist_utils
51 USE ftest_common, ONLY: test_abort
52 USE iso_c_binding, ONLY: c_ptr, c_int, c_size_t
53 IMPLICIT NONE
54 PRIVATE
55 INTERFACE
56 FUNCTION test_err_count() bind(c, name='test_err_count') RESULT(code)
57 IMPORT :: c_int
58 INTEGER(c_int) :: code
59 END FUNCTION test_err_count
60 END INTERFACE
61 PUBLIC :: test_err_count
62 PUBLIC :: check_idxlist, check_stripes, check_offsets, &
63 idxlist_pack_unpack_copy, check_idxlist_copy
64
65 CHARACTER(len=*), PARAMETER :: filename = 'test_idxlist_utils_f.f90'
66CONTAINS
67 SUBROUTINE check_idxlist(idxlist, ref_indices)
68 TYPE(xt_idxlist), INTENT(in) :: idxlist
69 INTEGER(xt_int_kind), INTENT(in) :: ref_indices(:)
70
71 INTEGER :: num_ref_indices
72 INTEGER(xt_int_kind) :: dummy(1)
73 INTEGER(c_int) :: num_ref_indices_c
74
75 INTERFACE
76 SUBROUTINE check_idxlist_c(idxlist, ref_indices, ref_num_indices) &
77 bind(c, name='check_idxlist')
78 IMPORT :: xt_int_kind, c_ptr, c_int
79 IMPLICIT NONE
80 TYPE(c_ptr), VALUE, INTENT(in) :: idxlist
81 INTEGER(xt_int_kind), INTENT(in) :: ref_indices(*)
82 INTEGER(c_int), VALUE, INTENT(in) :: ref_num_indices
83 END SUBROUTINE check_idxlist_c
84 END INTERFACE
85
86 num_ref_indices = SIZE(ref_indices)
87 IF (num_ref_indices > 0) THEN
88 num_ref_indices_c = int(num_ref_indices, c_int)
90 num_ref_indices_c)
91 ELSE
92 dummy(1) = 0_xt_int_kind
94 0_c_int)
95 END IF
96 END SUBROUTINE check_idxlist
97
98 SUBROUTINE check_stripes(stripes, ref_stripes)
99 TYPE(xt_stripe), INTENT(in) :: stripes(:), ref_stripes(:)
100 INTEGER(c_int) :: num_stripes_c, ref_num_stripes_c
101 INTERFACE
102 SUBROUTINE check_stripes_c(stripes, num_stripes, ref_stripes, &
103 ref_num_stripes) bind(c, name='check_stripes')
105 IMPLICIT NONE
106 TYPE(xt_stripe), INTENT(in) :: stripes(*), ref_stripes(*)
107 INTEGER(c_int), VALUE, INTENT(in) :: num_stripes, ref_num_stripes
108 END SUBROUTINE check_stripes_c
109 END INTERFACE
110
111 num_stripes_c = int(SIZE(stripes), c_int)
112 ref_num_stripes_c = int(SIZE(ref_stripes), c_int)
113 CALL check_stripes_c(stripes, num_stripes_c, ref_stripes, ref_num_stripes_c)
114
115 END SUBROUTINE check_stripes
116
117 SUBROUTINE check_offsets(offsets_a, offsets_b)
118 INTEGER(c_int), INTENT(in) :: offsets_a(:), offsets_b(:)
119 INTEGER(c_size_t) :: num_offsets_c
120 INTERFACE
121 SUBROUTINE check_offsets_c(num_offsets, offsets_a, offsets_b) &
122 bind(c, name='check_offsets')
123 IMPORT :: c_size_t, c_int
124 IMPLICIT NONE
125 INTEGER(c_size_t), VALUE, INTENT(in) :: num_offsets
126 INTEGER(c_int), INTENT(IN) :: offsets_a(num_offsets), &
127 offsets_b(num_offsets)
128 END SUBROUTINE check_offsets_c
129 END INTERFACE
130
131 IF (SIZE(offsets_a) /= SIZE(offsets_b)) &
132 CALL test_abort("inequal number of array elements in eq test", &
133 filename, __line__)
134
135 num_offsets_c = int(SIZE(offsets_a), c_size_t)
136 CALL check_offsets_c(num_offsets_c, offsets_a, offsets_b)
137
138 END SUBROUTINE check_offsets
139
140 FUNCTION idxlist_pack_unpack_copy(idxlist) RESULT(idxlist_copy)
141 TYPE(xt_idxlist), INTENT(in) :: idxlist
142 TYPE(xt_idxlist) :: idxlist_copy
143
144 INTERFACE
145 FUNCTION idxlist_pack_unpack_copy_c(idxlist) RESULT(idxlist_copy) &
146 bind(c, name='idxlist_pack_unpack_copy')
147 IMPORT :: c_ptr
148 TYPE(c_ptr), VALUE, INTENT(in) :: idxlist
149 TYPE(c_ptr) :: idxlist_copy
150 END FUNCTION idxlist_pack_unpack_copy_c
151 END INTERFACE
152
153 idxlist_copy &
154 = xt_idxlist_c2f(idxlist_pack_unpack_copy_c(
xt_idxlist_f2c(idxlist)))
155
156 END FUNCTION idxlist_pack_unpack_copy
157
158 SUBROUTINE check_idxlist_copy(idxlist, idxlist_copy, ref_indices, ref_stripes)
159 TYPE(xt_idxlist), INTENT(in) :: idxlist, idxlist_copy
160 INTEGER(xt_int_kind), INTENT(in) :: ref_indices(:)
161 TYPE(xt_stripe), INTENT(in) :: ref_stripes(:)
162 INTEGER(c_size_t) :: num_ref_indices_c, num_ref_stripes_c
163 INTERFACE
164 SUBROUTINE check_idxlist_copy_c(idxlist, idxlist_copy, &
165 num_ref_indices, ref_indices, &
166 num_ref_stripes, ref_stripes) bind(c, name='check_idxlist_copy')
167 IMPORT :: c_size_t, c_ptr, xt_int_kind,
xt_stripe
168 TYPE(c_ptr), VALUE, INTENT(in) :: idxlist, idxlist_copy
169 INTEGER(c_size_t), VALUE, INTENT(in) :: num_ref_indices, num_ref_stripes
170 INTEGER(xt_int_kind), INTENT(in) :: ref_indices(*)
171 TYPE(xt_stripe), INTENT(in) :: ref_stripes(*)
172 END SUBROUTINE check_idxlist_copy_c
173 END INTERFACE
174 num_ref_indices_c = int(SIZE(ref_indices), c_size_t)
175 num_ref_stripes_c = int(SIZE(ref_stripes), c_size_t)
178 num_ref_stripes_c, ref_stripes)
179 END SUBROUTINE check_idxlist_copy
180
181END MODULE test_idxlist_utils
182
183
184
185
186
187
188
189
190
Xt_idxlist xt_idxlist_f2c(struct xt_idxlist_f *p)