46 xi => xt_int_kind, xt_stripe, &
49 USE ftest_common,
ONLY: init_mpi, finish_mpi, test_abort
50 USE test_idxlist_utils,
ONLY: check_idxlist, test_err_count
52 CHARACTER(len=*),
PARAMETER :: filename =
'test_idxmod_f.f90'
56 CALL test_idxvec_modifier
57 CALL test_idxstripes_modifier
62 IF (test_err_count() /= 0)
CALL test_abort(
"non-zero error count", &
68 SUBROUTINE test_idxvec_modifier
69 INTEGER,
PARAMETER :: g_src_num = 9, g_dst_num=9, patch_num=7
72 INTEGER(xi),
PARAMETER :: &
73 g_src_idx(g_src_num) = (/ (i, i=1,g_src_num) /), &
74 g_dst_idx(g_dst_num) = (/ (i, i=g_dst_num,1,-1) /), &
77 INTEGER(xi),
PARAMETER :: &
78 g_src_idx(g_src_num) = (/ (int(i, xi), i=1,g_src_num) /), &
79 g_dst_idx(g_dst_num) = (/ (int(i, xi), i=g_dst_num,1,-1) /), &
81 patch_idx(patch_num) = (/ 3_xi, 4_xi, 4_xi, 4_xi, 7_xi, 7_xi, 8_xi /)
83 INTEGER(xi),
PARAMETER :: &
84 ref_mpatch_idx(patch_num) = (/ 7_xi, 6_xi, 6_xi, 6_xi, 3_xi, 3_xi, &
87 TYPE(xt_idxlist) :: g_src_idxlist, g_dst_idxlist, patch_idxlist, &
89 TYPE(xt_modifier) :: modifier(1)
95 modifier(1) =
xt_modifier(g_src_idxlist, g_dst_idxlist, 0)
101 CALL check_idxlist(mpatch_idxlist, ref_mpatch_idx)
107 END SUBROUTINE test_idxvec_modifier
109 SUBROUTINE test_idxstripes_modifier
111 INTEGER,
PARAMETER :: patch_num = 8
112 TYPE(xt_stripe),
PARAMETER :: &
113 g_src_stripe = xt_stripe(1, 1, 20), &
114 g_dst_stripe = xt_stripe(100, -1, 20)
115 TYPE(xt_idxlist) :: g_src_idxlist, g_dst_idxlist, patch_idxlist, &
117 TYPE(xt_modifier) :: modifier(1)
118 INTEGER :: mstate(patch_num)
119 INTEGER,
PARAMETER :: ref_mstate(patch_num) &
120 = (/ 1, ior(2, 32), ior(3, 32), ior(4, 32), ior(5, 32), 6, 7, 8 /)
123 INTEGER(xi),
PARAMETER :: &
124 patch_idx(patch_num) = (/ 0_xi, 1_xi, 3_xi, 3_xi, &
125 & 5_xi, 50_xi, 100_xi, 150_xi /), &
126 ref_mpatch_idx(patch_num) = (/ 0_xi, 100_xi, 98_xi, 98_xi, &
127 & 96_xi, 50_xi, 100_xi, 150_xi /)
132 modifier(1) =
xt_modifier(g_src_idxlist, g_dst_idxlist, 32)
140 mpatch_idxlist =
xt_idxmod_new(patch_idxlist, modifier, mstate)
142 CALL check_idxlist(mpatch_idxlist, ref_mpatch_idx)
145 IF (any(mstate(:) /= ref_mstate(:))) &
146 CALL test_abort(
"mstate(:) /= ref_mstate(:)", filename, __line__)
151 END SUBROUTINE test_idxstripes_modifier
154 SUBROUTINE test_multimod
155 INTEGER,
PARAMETER :: g1_src_num = 9, g1_dst_num = 9, &
156 g2_src_num = 5, g2_dst_num = 5, patch_num = 6, num_mod = 2
159 INTEGER(xi),
PARAMETER :: &
160 g1_src_idx(g1_src_num) = (/ (i, i = 1,g1_src_num) /), &
161 g1_dst_idx(g1_dst_num) = (/ (i, i = g1_dst_num,1,-1) /), &
164 INTEGER(xi),
PARAMETER :: &
165 g1_src_idx(g1_src_num) = (/ (int(i, xi), i = 1,g1_src_num) /), &
166 g1_dst_idx(g1_dst_num) = (/ (int(i, xi), i = g1_dst_num,1,-1) /), &
168 g2_src_idx(g2_src_num) = (/ 1_xi, 2_xi, 8_xi, 9_xi, 10_xi /), &
169 g2_dst_idx(g2_dst_num) = (/ 8_xi, 2_xi, 8_xi, 2_xi, 5_xi /), &
170 patch_idx(patch_num) = (/ 6_xi, 7_xi, 25_xi, 8_xi, 9_xi, 10_xi /), &
174 ref_mpatch_idx(patch_num) = (/ 4_xi, 3_xi, 25_xi, 2_xi, 8_xi, 5_xi /)
176 TYPE(xt_idxlist) :: mod_idxlist(2,2), patch_idxlist, mpatch_idxlist
177 TYPE(xt_modifier) :: modifier(num_mod)
178 INTEGER :: mstate(patch_num), k
179 INTEGER,
PARAMETER :: ref_mstate(patch_num) &
180 = (/ ior(1, 0), ior(1, 0), ior(0, 0), &
181 & ior(1, 2), ior(1, 2), ior(0, 2) /), &
194 modifier(k) =
xt_modifier(mod_idxlist(k, src), mod_idxlist(k, dst), &
197 mpatch_idxlist =
xt_idxmod_new(patch_idxlist, modifier, 2, mstate)
198 CALL check_idxlist(mpatch_idxlist, ref_mpatch_idx)
201 IF (any(mstate(:) /= ref_mstate(:))) &
202 CALL test_abort(
"mstate(:) /= ref_mstate(:)", filename, __line__)
206 END SUBROUTINE test_multimod
208 END PROGRAM test_idxmod_f
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)