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
44
45
46
47
48#include "fc_feature_defs.inc"
49PROGRAM test_redist_repeat_parallel
50 USE mpi
51 USE ftest_common, ONLY: init_mpi, finish_mpi, test_abort
52 USE test_idxlist_utils, ONLY: test_err_count
61
62#if defined __PGI
66#endif
67 USE test_redist_common, ONLY: check_wait_request, redist_exchanger_option
68 USE iso_c_binding, ONLY: c_int
69 IMPLICIT NONE
70 CHARACTER(len=*), PARAMETER :: filename = 'test_redist_repeat_parallel_f.f90'
71 CHARACTER(len=*), PARAMETER :: err_msg(2) = &
72 (/ "error on xt_redist_s_exchange", "error on xt_redist_a_exchange" /)
73 TYPE(xt_config) :: config
74 INTEGER :: comm_size, ierror
75 CALL init_mpi
77 config = redist_exchanger_option()
78
79 CALL mpi_comm_size(mpi_comm_world, comm_size, ierror)
80 IF (ierror /= mpi_success) &
81 CALL test_abort('mpi_comm_size failed', filename, __line__)
82
83 IF (comm_size > 1) THEN
84 CALL test_4redist(mpi_comm_world, config, 2*comm_size**2)
85 END IF
86
87 IF (test_err_count() /= 0) &
88 CALL test_abort("non-zero error count!", filename, __line__)
91 CALL finish_mpi
92CONTAINS
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109 SUBROUTINE build_idxlists(indices_a, indices_b, comm_size, comm_rank)
110 TYPE(xt_idxlist), INTENT(out) :: indices_a, indices_b
111 INTEGER, INTENT(in) :: comm_size, comm_rank
112
113 INTEGER, PARAMETER :: glob_rank = 4
114 TYPE(xt_idxlist) :: indices_a_(2)
115 INTEGER :: i
116 INTEGER(xt_int_kind), PARAMETER :: start = 0
117 INTEGER(xt_int_kind) :: global_size(glob_rank), local_start(glob_rank, 2)
118 INTEGER :: local_size(glob_rank)
119
120 TYPE(xt_stripe) :: stripe
121
122 global_size(1) = int(comm_size, xi)
123 global_size(2) = int(comm_size, xi)
124 global_size(3) = int(comm_size, xi)
125 global_size(4) = 2_xi
126 local_size(1) = comm_size
127 local_size(2) = 1
128 local_size(3) = comm_size
129 local_size(4) = 1
130 local_start(1, 1) = 1_xi
131 local_start(2, 1) = int(comm_rank + 1, xi)
132 local_start(3, 1) = 1_xi
133 local_start(4, 1) = 1_xi
134
135 local_start(1, 2) = 1_xi
136 local_start(2, 2) = int(comm_size-comm_rank, xi)
137 local_start(3, 2) = 1_xi
138 local_start(4, 2) = 2_xi
139
140 DO i = 1, 2
141 indices_a_(i) = xt_idxfsection_new(start, global_size, local_size, &
142 local_start(:, i))
143 END DO
145
148
149 stripe =
xt_stripe(start = int(comm_rank * 2 * comm_size**2, xi), &
150 & stride = 1_xi, &
151 & nstrides = int(2*comm_size**2, c_int))
153 END SUBROUTINE build_idxlists
154
155
156
157 SUBROUTINE test_4redist(comm, config, dim1)
158 INTEGER, INTENT(in) :: comm
159 TYPE(xt_config), INTENT(in) :: config
160 INTEGER, INTENT(in) :: dim1
161 TYPE(xt_idxlist) :: indices_a, indices_b
162 INTEGER(xt_int_kind) :: index_vector_a(dim1), &
163 index_vector_b(dim1)
164 TYPE(xt_xmap) :: xmap
165 TYPE(xt_redist) :: redist_repeat, redist_repeat_2, redist_p2p
166 INTEGER, PARAMETER :: dim2a = 9, rpt_cnt = 4
167 INTEGER(xt_int_kind) :: results_1(dim1,rpt_cnt), &
168 results_2(dim1,dim2a), dim1_xi
169 INTEGER(xt_int_kind) :: input_data(dim1,dim2a)
170 INTEGER(xt_int_kind) :: ref_results_1(dim1,rpt_cnt), &
171 ref_results_2(dim1,dim2a)
172 INTEGER(mpi_address_kind) :: extent
173 INTEGER(mpi_address_kind) :: base_address, temp_address
174 INTEGER(c_int), PARAMETER :: &
175 displacements(rpt_cnt, 2) &
176 = reshape((/ 0_c_int, 1_c_int, 2_c_int, 3_c_int, &
177 & 1_c_int, 2_c_int, 4_c_int, 8_c_int /), (/ rpt_cnt, 2 /))
178
179 LOGICAL, PARAMETER :: skip_lev_2(9) &
180 = (/ .true., .false., .false., &
181 & .true., .false., .true., &
182 & .true., .true., .false. /)
183 INTEGER :: i, j, ierror
184 TYPE(xt_request) :: request1, request2
185 INTEGER :: iexch
186 INTEGER :: comm_rank, comm_size
187
188 CALL mpi_comm_rank(comm, comm_rank, ierror)
189 IF (ierror /= mpi_success) &
190 CALL test_abort('mpi_comm_rank failed', filename, __line__)
191 CALL mpi_comm_size(comm, comm_size, ierror)
192 IF (ierror /= mpi_success) &
193 CALL test_abort('mpi_comm_size failed', filename, __line__)
194
195 CALL build_idxlists(indices_a, indices_b, comm_size, comm_rank)
196
199
201
204
207
208 CALL mpi_get_address(input_data(1,1), base_address, ierror)
209 CALL mpi_get_address(input_data(1,2), temp_address, ierror)
210 extent = temp_address - base_address
211
213 rpt_cnt, displacements(:, 1), config)
215 rpt_cnt, displacements(:, 2), config)
216
218
219 dim1_xi = int(dim1, xi)
220 DO j = 1, dim2a
221 DO i = 1, dim1
222 input_data(i, j) = index_vector_a(i) + int(j-1, xi) * 2_xi * dim1_xi
223 END DO
224 END DO
225
226 DO j = 1, rpt_cnt
227 DO i = 1, dim1
228 ref_results_1(i, j) = index_vector_b(i) + int(j-1, xi) * 2_xi * dim1_xi
229 END DO
230 END DO
231 DO j = 1, dim2a
232 IF (skip_lev_2(j)) THEN
233 ref_results_2(:, j) = -1_xi
234 ELSE
235 DO i = 1, dim1
236 ref_results_2(i, j) &
237 = index_vector_b(i) + int(j-1, xi) * 2_xi * dim1_xi
238 END DO
239 END IF
240 END DO
241
242 DO iexch = 1, 2
243 results_1 = -1
244 results_2 = -1
245
246 IF (iexch == 1) THEN
249 ELSE
251 request1)
253 request2)
254 CALL check_wait_request(request1, filename, __line__)
255 CALL check_wait_request(request2, filename, __line__)
256 ENDIF
257
258
259 IF (any(results_1 /= ref_results_1)) &
260 CALL test_abort(err_msg(iexch), filename, __line__)
261 IF (any(results_2 /= ref_results_2)) &
262 CALL test_abort(err_msg(iexch), filename, __line__)
263 ENDDO
264
265
268 END SUBROUTINE test_4redist
269
270END PROGRAM test_redist_repeat_parallel
271
272
273
274
275
276
277
278
279
void xt_config_delete(Xt_config config)
void xt_initialize(MPI_Comm default_comm)
void xt_idxlist_get_indices(Xt_idxlist idxlist, Xt_int *indices)
void xt_idxlist_delete(Xt_idxlist idxlist)
Xt_idxlist xt_idxlist_collection_new(Xt_idxlist *idxlists, int num_idxlists)
Xt_idxlist xt_idxstripes_new(struct Xt_stripe const *stripes, int num_stripes)
void xt_redist_delete(Xt_redist redist)
void xt_redist_s_exchange(Xt_redist redist, int num_arrays, const void *const src_data[], void *const dst_data[])
void xt_redist_a_exchange(Xt_redist redist, int num_arrays, const void *const src_data[], void *const dst_data[], Xt_request *request)
Xt_redist xt_redist_p2p_new(Xt_xmap xmap, MPI_Datatype datatype)
Xt_redist xt_redist_repeat_new(Xt_redist redist, MPI_Aint src_extent, MPI_Aint dst_extent, int num_repetitions, const int displacements[num_repetitions])
void xt_xmap_delete(Xt_xmap xmap)
Xt_xmap xt_xmap_all2all_new(Xt_idxlist src_idxlist, Xt_idxlist dst_idxlist, MPI_Comm comm)