1
2
3
4
5
6
7
8
9
10
11
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#include "fc_feature_defs.inc"
44PROGRAM test_idxmod_f
45 USE mpi
50 USE ftest_common, ONLY: init_mpi, finish_mpi, test_abort
51 USE test_idxlist_utils, ONLY: check_idxlist, test_err_count
52 IMPLICIT NONE
53 CHARACTER(len=*), PARAMETER :: filename = 'test_idxmod_f.f90'
54 CALL init_mpi
56
57 CALL test_idxvec_modifier
58 CALL test_idxstripes_modifier
59 CALL test_multimod
60
62
63 IF (test_err_count() /= 0) CALL test_abort("non-zero error count", &
64 filename, __line__)
65
66 CALL finish_mpi
67
68CONTAINS
69 SUBROUTINE test_idxvec_modifier
70 INTEGER, PARAMETER :: g_src_num = 9, g_dst_num=9, patch_num=7
71#ifndef __G95__
72 INTEGER(xi) :: i
73 INTEGER(xi), PARAMETER :: &
74 g_src_idx(g_src_num) = (/ (i, i=1,g_src_num) /), &
75 g_dst_idx(g_dst_num) = (/ (i, i=g_dst_num,1,-1) /), &
76#else
77 INTEGER :: i
78 INTEGER(xi), PARAMETER :: &
79 g_src_idx(g_src_num) = (/ (int(i, xi), i=1,g_src_num) /), &
80 g_dst_idx(g_dst_num) = (/ (int(i, xi), i=g_dst_num,1,-1) /), &
81#endif
82 patch_idx(patch_num) = (/ 3_xi, 4_xi, 4_xi, 4_xi, 7_xi, 7_xi, 8_xi /)
83
84 INTEGER(xi), PARAMETER :: &
85 ref_mpatch_idx(patch_num) = (/ 7_xi, 6_xi, 6_xi, 6_xi, 3_xi, 3_xi, &
86 2_xi /)
87
88 TYPE(xt_idxlist) :: g_src_idxlist, g_dst_idxlist, patch_idxlist, &
89 mpatch_idxlist
90 TYPE(xt_modifier) :: modifier(1)
91
93
95
96 modifier(1) =
xt_modifier(g_src_idxlist, g_dst_idxlist, 0)
97
99
101
102 CALL check_idxlist(mpatch_idxlist, ref_mpatch_idx)
103
108 END SUBROUTINE test_idxvec_modifier
109
110 SUBROUTINE test_idxstripes_modifier
111 INTEGER :: i
112 INTEGER, PARAMETER :: patch_num = 8
113 TYPE(xt_stripe), PARAMETER :: &
116 TYPE(xt_idxlist) :: g_src_idxlist, g_dst_idxlist, patch_idxlist, &
117 mpatch_idxlist
118 TYPE(xt_modifier) :: modifier(1)
119 INTEGER :: mstate(patch_num)
120 INTEGER, PARAMETER :: ref_mstate(patch_num) &
121 = (/ 1, ior(2, 32), ior(3, 32), ior(4, 32), ior(5, 32), 6, 7, 8 /)
122
123
124 INTEGER(xi), PARAMETER :: &
125 patch_idx(patch_num) = (/ 0_xi, 1_xi, 3_xi, 3_xi, &
126 & 5_xi, 50_xi, 100_xi, 150_xi /), &
127 ref_mpatch_idx(patch_num) = (/ 0_xi, 100_xi, 98_xi, 98_xi, &
128 & 96_xi, 50_xi, 100_xi, 150_xi /)
129
132
133 modifier(1) =
xt_modifier(g_src_idxlist, g_dst_idxlist, 32)
134
136
137 DO i = 1, patch_num
138 mstate(i) = i
139 END DO
140
141 mpatch_idxlist =
xt_idxmod_new(patch_idxlist, modifier, mstate)
142
143 CALL check_idxlist(mpatch_idxlist, ref_mpatch_idx)
144
145
146 IF (any(mstate(:) /= ref_mstate(:))) &
147 CALL test_abort("mstate(:) /= ref_mstate(:)", filename, __line__)
152 END SUBROUTINE test_idxstripes_modifier
153
154
155 SUBROUTINE test_multimod
156 INTEGER, PARAMETER :: g1_src_num = 9, g1_dst_num = 9, &
157 g2_src_num = 5, g2_dst_num = 5, patch_num = 6, num_mod = 2
158#ifndef __G95__
159 INTEGER(xi) :: i
160 INTEGER(xi), PARAMETER :: &
161 g1_src_idx(g1_src_num) = (/ (i, i = 1,g1_src_num) /), &
162 g1_dst_idx(g1_dst_num) = (/ (i, i = g1_dst_num,1,-1) /), &
163#else
164 INTEGER :: i
165 INTEGER(xi), PARAMETER :: &
166 g1_src_idx(g1_src_num) = (/ (int(i, xi), i = 1,g1_src_num) /), &
167 g1_dst_idx(g1_dst_num) = (/ (int(i, xi), i = g1_dst_num,1,-1) /), &
168#endif
169 g2_src_idx(g2_src_num) = (/ 1_xi, 2_xi, 8_xi, 9_xi, 10_xi /), &
170 g2_dst_idx(g2_dst_num) = (/ 8_xi, 2_xi, 8_xi, 2_xi, 5_xi /), &
171 patch_idx(patch_num) = (/ 6_xi, 7_xi, 25_xi, 8_xi, 9_xi, 10_xi /), &
172
173
174
175 ref_mpatch_idx(patch_num) = (/ 4_xi, 3_xi, 25_xi, 2_xi, 8_xi, 5_xi /)
176
177 TYPE(xt_idxlist) :: mod_idxlist(2,2), patch_idxlist, mpatch_idxlist
178 TYPE(xt_modifier) :: modifier(num_mod)
179 INTEGER :: mstate(patch_num), k
180 INTEGER, PARAMETER :: ref_mstate(patch_num) &
181 = (/ ior(1, 0), ior(1, 0), ior(0, 0), &
182 & ior(1, 2), ior(1, 2), ior(0, 2) /), &
183 src = 1, dst = 2
184
189
191
192 mstate(:) = 0
193
194 DO k = 1, num_mod
195 modifier(k) =
xt_modifier(mod_idxlist(k, src), mod_idxlist(k, dst), &
196 ishft(1, k - 1))
197 END DO
198 mpatch_idxlist =
xt_idxmod_new(patch_idxlist, modifier, 2, mstate)
199 CALL check_idxlist(mpatch_idxlist, ref_mpatch_idx)
200
201
202 IF (any(mstate(:) /= ref_mstate(:))) &
203 CALL test_abort("mstate(:) /= ref_mstate(:)", filename, __line__)
207 END SUBROUTINE test_multimod
208
209END PROGRAM test_idxmod_f
210
211
212
213
214
215
216
217
218
void xt_initialize(MPI_Comm default_comm)
void xt_idxlist_delete(Xt_idxlist idxlist)
Xt_idxlist xt_idxmod_new(Xt_idxlist patch_idxlist, struct Xt_modifier *modifier, int modifier_num, int *mstate)
generates a new index list based on an index list and a sequence of modifiers
Xt_idxlist xt_idxstripes_new(struct Xt_stripe const *stripes, int num_stripes)
Xt_idxlist xt_idxvec_new(const Xt_int *idxlist, int num_indices)