1
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
50 USE mpi
51 USE ftest_common, ONLY: init_mpi, finish_mpi, test_abort, cmp_arrays
52 USE test_idxlist_utils, ONLY: test_err_count
58#if defined __PGI && ( __PGIC__ == 15 || __PGIC__ == 14 )
61#endif
62 USE test_redist_common, ONLY: build_odd_selection_xmap, check_redist, &
63 check_wait_request, redist_exchanger_option
64 USE iso_c_binding, ONLY: c_int
65 IMPLICIT NONE
66 CHARACTER(len=*), PARAMETER :: filename = 'test_redist_repeat_f.f90'
67 CHARACTER(len=*), PARAMETER :: exch1name(2) = &
68 (/ "xt_redist_s_exchange1", "xt_redist_a_exchange1" /)
69 TYPE(xt_config) :: config
70
71 CALL init_mpi
73 config = redist_exchanger_option()
74
75 CALL simple_test(mpi_comm_world, config)
76 CALL test_repeated_redist(mpi_comm_world, config)
77 CALL test_repeated_redist_with_gap(mpi_comm_world, config)
78 CALL test_repeated_overlapping_redist(mpi_comm_world, config)
79 CALL test_repeated_redist_asym(mpi_comm_world, config)
80
81 IF (test_err_count() /= 0) &
82 CALL test_abort("non-zero error count!", filename, __line__)
85 CALL finish_mpi
86CONTAINS
87 SUBROUTINE simple_test(comm, config)
88 INTEGER, INTENT(in) :: comm
89 TYPE(xt_config), INTENT(in) :: config
90
91
92 TYPE(xt_xmap) :: xmap
93 TYPE(xt_redist) :: redist, redist_repeat
94 INTEGER, PARAMETER :: src_slice_len = 5, dst_slice_len = 3
95 DOUBLE PRECISION, PARAMETER :: ref_dst_data(dst_slice_len) &
96 = (/ 1.0d0, 3.0d0, 5.0d0 /), &
97 src_data(src_slice_len) = (/ 1.0d0, 2.0d0, 3.0d0, 4.0d0, 5.0d0 /)
98 DOUBLE PRECISION :: dst_data(dst_slice_len)
99 INTEGER(mpi_address_kind) :: src_extent, dst_extent
100 INTEGER(mpi_address_kind) :: base_address, temp_address
101 INTEGER(c_int) :: displacements(1) = 0
102 INTEGER :: ierror
103
104 xmap = build_odd_selection_xmap(src_slice_len, comm)
105
107
109
110 CALL mpi_get_address(src_data(1), base_address, ierror)
111 IF (ierror /= mpi_success) &
112 CALL test_abort('mpi_get_address failed', filename, __line__)
113 CALL mpi_get_address(src_data(2), temp_address, ierror)
114 IF (ierror /= mpi_success) &
115 CALL test_abort('mpi_get_address failed', filename, __line__)
116 src_extent = (temp_address - base_address) * src_slice_len
117 CALL mpi_get_address(dst_data(1), base_address, ierror)
118 IF (ierror /= mpi_success) &
119 CALL test_abort('mpi_get_address failed', filename, __line__)
120 CALL mpi_get_address(dst_data(2), temp_address, ierror)
121 IF (ierror /= mpi_success) &
122 CALL test_abort('mpi_get_address failed', filename, __line__)
123 dst_extent = (temp_address - base_address) * dst_slice_len
124
125
127 displacements, config)
128
130
131
132 CALL check_redist(redist_repeat, src_data, dst_data, ref_dst_data)
133
134
136 END SUBROUTINE simple_test
137
138 SUBROUTINE test_repeated_redist_ds1(redist_repeat)
139 TYPE(xt_redist), INTENT(in) :: redist_repeat
140 INTEGER :: i, j
141 DOUBLE PRECISION, PARAMETER :: src_data(5, 3) = reshape((/&
142 (dble(i), i = 1, 15)/), (/ 5, 3 /))
143 DOUBLE PRECISION, PARAMETER :: ref_dst_data(3, 3) &
144 = reshape((/ ((dble(i + j), i = 1,5,2), j = 0,10,5) /), (/ 3, 3 /))
145 DOUBLE PRECISION :: dst_data(3, 3)
146
147 CALL check_redist(redist_repeat, src_data, dst_data, ref_dst_data)
148 END SUBROUTINE test_repeated_redist_ds1
149
150#ifdef __PGI
151# define NO_2D_PARAM
152#elif defined(_CRAYFTN)
153# if _RELEASE_MAJOR < 8 || (_RELEASE_MAJOR == 8 && _RELEASE_MINOR < 7)
154# define NO_2D_PARAM
155# endif
156#endif
157
158 SUBROUTINE test_repeated_redist_ds1_with_gap(redist_repeat)
159 TYPE(xt_redist), INTENT(in) :: redist_repeat
160 INTEGER :: i, j
161 DOUBLE PRECISION, PARAMETER :: src_data(5, 5) = reshape((/&
162 (dble(i), i = 1, 25)/), (/ 5, 5 /))
163 DOUBLE PRECISION :: dst_data(3, 5)
164#ifdef NO_2D_PARAM
165 DOUBLE PRECISION :: ref_dst_data(3, 5)
166 ref_dst_data &
167 = reshape((/ ((dble((i + j)*mod(j+1,2)-mod(j,2)), i = 1,5,2), &
168 j = 0,20,5) /), (/ 3, 5 /))
169#else
170 DOUBLE PRECISION, PARAMETER :: ref_dst_data(3, 5) &
171 = reshape((/ ((dble((i + j)*mod(j+1,2)-mod(j,2)), i = 1,5,2), j = 0,20,5) /), (/ 3, 5 /))
172#endif
173 CALL check_redist(redist_repeat, src_data, dst_data, ref_dst_data)
174 END SUBROUTINE test_repeated_redist_ds1_with_gap
175
176 SUBROUTINE test_repeated_redist_ds2(redist_repeat)
177 TYPE(xt_redist), INTENT(in) :: redist_repeat
178 INTEGER :: i, j
179 DOUBLE PRECISION, PARAMETER :: src_data(5, 3) = reshape((/&
180 (dble(i), i = 20, 34)/), (/ 5, 3 /))
181 DOUBLE PRECISION, PARAMETER :: ref_dst_data(3, 3) &
182 = reshape((/ ((dble(i + j), i = 1,5,2), j = 19,33,5) /), (/ 3, 3 /))
183 DOUBLE PRECISION :: dst_data(3, 3)
184
185 CALL check_redist(redist_repeat, src_data, dst_data, ref_dst_data)
186 END SUBROUTINE test_repeated_redist_ds2
187
188 SUBROUTINE test_repeated_redist(comm, config)
189 INTEGER, INTENT(in) :: comm
190 TYPE(xt_config), INTENT(in) :: config
191
192
193
194 INTEGER, PARAMETER :: num_slice = 3
195 INTEGER, PARAMETER :: src_slice_len = 5
196 TYPE(xt_xmap) :: xmap
197 TYPE(xt_redist) :: redist, redist_repeat
198 INTEGER(mpi_address_kind) :: src_extent, dst_extent
199 INTEGER(mpi_address_kind) :: base_address, temp_address
200 INTEGER(c_int), PARAMETER :: &
201 displacements(3)= (/ 0_c_int, 1_c_int, 2_c_int /)
202 DOUBLE PRECISION, TARGET :: src_template(5, 3), dst_template(3, 3)
203 INTEGER :: ierror
204
205 xmap = build_odd_selection_xmap(src_slice_len, comm)
206
208
210
211
212 CALL mpi_get_address(src_template(1,1), base_address, ierror)
213 IF (ierror /= mpi_success) &
214 CALL test_abort('mpi_get_address failed', filename, __line__)
215 CALL mpi_get_address(src_template(1,2), temp_address, ierror)
216 IF (ierror /= mpi_success) &
217 CALL test_abort('mpi_get_address failed', filename, __line__)
218 src_extent = temp_address - base_address
219 CALL mpi_get_address(dst_template(1,1), base_address, ierror)
220 IF (ierror /= mpi_success) &
221 CALL test_abort('mpi_get_address failed', filename, __line__)
222 CALL mpi_get_address(dst_template(1,2), temp_address, ierror)
223 IF (ierror /= mpi_success) &
224 CALL test_abort('mpi_get_address failed', filename, __line__)
225 dst_extent = temp_address - base_address
226
228 num_slice, displacements, config)
230
231
232 CALL test_repeated_redist_ds1(redist_repeat)
233
234 CALL test_repeated_redist_ds2(redist_repeat)
235
237 END SUBROUTINE test_repeated_redist
238
239 SUBROUTINE test_repeated_redist_asym(comm, config)
240 INTEGER, INTENT(in) :: comm
241 TYPE(xt_config), INTENT(in) :: config
242
243
244 INTEGER, PARAMETER :: num_slice = 3
245 INTEGER, PARAMETER :: src_slice_len = 5
246 TYPE(xt_xmap) :: xmap
247 TYPE(xt_redist) :: redist, redist_repeat
248 INTEGER(mpi_address_kind) :: src_extent, dst_extent
249 INTEGER(mpi_address_kind) :: base_address, temp_address
250 INTEGER(c_int) :: src_displacements(3), dst_displacements(3)
251 INTEGER :: i, ierror
252 DOUBLE PRECISION, PARAMETER :: &
253 ref_dst_data(3, 3) = reshape([ 6.0d0, 8.0d0, 10.0d0, 11.0d0, 13.0d0, &
254 & 15.0d0, 1.0d0, 3.0d0, 5.0d0 ], [3,3] )
255 DOUBLE PRECISION, TARGET :: dst_data(3, 3)
256 DOUBLE PRECISION, TARGET, SAVE :: &
257 src_data(5, 3) = reshape([(dble(i), i = 1, 15)], [5,3])
258 INTEGER, PARAMETER :: dp = kind(src_data)
259
260
261 xmap = build_odd_selection_xmap(src_slice_len, comm)
262
264
266
267
268 CALL mpi_get_address(src_data(1,1), base_address, ierror)
269 CALL mpi_get_address(src_data(1,2), temp_address, ierror)
270 src_extent = temp_address - base_address
271 CALL mpi_get_address(dst_data(1,1), base_address, ierror)
272 CALL mpi_get_address(dst_data(1,2), temp_address, ierror)
273 dst_extent = temp_address - base_address
274
275
276 src_displacements = [0,1,2]
277 dst_displacements = [2,0,1]
278
279
281 num_slice, src_displacements, dst_displacements, config)
282 dst_data = -1.0_dp
283 CALL check_redist(redist_repeat, src_data, dst_data, ref_dst_data)
285
286
288 src_displacements, dst_displacements, config)
289 dst_data = -1.0_dp
290 CALL check_redist(redist_repeat, src_data, dst_data, ref_dst_data)
292
294 END SUBROUTINE test_repeated_redist_asym
295
296 SUBROUTINE test_repeated_redist_with_gap(comm, config)
297 INTEGER, INTENT(in) :: comm
298 TYPE(xt_config), INTENT(in) :: config
299
300
301
302
303 INTEGER, PARAMETER :: num_slice = 3
304 INTEGER, PARAMETER :: src_slice_len = 5
305 TYPE(xt_xmap) :: xmap
306 TYPE(xt_redist) :: redist, redist_repeat
307 INTEGER(mpi_address_kind) :: src_extent, dst_extent
308 INTEGER(mpi_address_kind) :: base_address, temp_address
309 INTEGER(c_int), PARAMETER :: displacements(3) = (/0,2,4/)
310 DOUBLE PRECISION, TARGET :: src_template(5, 3), dst_template(3, 3)
311 INTEGER :: ierror
312
313 xmap = build_odd_selection_xmap(src_slice_len, comm)
314
316
318
319
320 CALL mpi_get_address(src_template(1,1), base_address, ierror)
321 CALL mpi_get_address(src_template(1,2), temp_address, ierror)
322 src_extent = temp_address - base_address
323 CALL mpi_get_address(dst_template(1,1), base_address, ierror)
324 CALL mpi_get_address(dst_template(1,2), temp_address, ierror)
325 dst_extent = temp_address - base_address
326
328 num_slice, displacements, config)
330
331
332 CALL test_repeated_redist_ds1_with_gap(redist_repeat)
333
335 END SUBROUTINE test_repeated_redist_with_gap
336
337 SUBROUTINE test_repeated_overlapping_redist(comm, config)
338 INTEGER, INTENT(in) :: comm
339 TYPE(xt_config), INTENT(in) :: config
340
341
342
343
344 INTEGER, PARAMETER :: npt = 9, selection_len = 6
345 TYPE(xt_xmap) :: xmap
346 TYPE(xt_redist) :: redist, redist_repeat
347 INTEGER(mpi_address_kind) :: src_extent, dst_extent
348 INTEGER(mpi_address_kind) :: base_address, temp_address
349 INTEGER(c_int), PARAMETER :: displacements(2) = (/ 0_c_int, 1_c_int /)
350 INTEGER :: i, j, ierror
351 INTEGER, PARAMETER :: src_pos(npt) = (/ (i, i=1,npt) /), &
352 dst_pos(npt) = (/ (2*i, i = 0, npt-1) /)
353 DOUBLE PRECISION :: src_data(npt), dst_data(npt)
354#if __INTEL_COMPILER >= 1600 && __INTEL_COMPILER <= 1602 || defined __PGI
355 DOUBLE PRECISION :: ref_dst_data(npt)
356#else
357 DOUBLE PRECISION, PARAMETER :: ref_dst_data(npt) &
358 = (/ ((dble(((2-j)*3+i+101)*((abs(j)+j)/abs(j+max(1,j))) &
359 & +(j-1-abs(j-1))/2), &
360 & i=1,3 ),j=2,0,-1) /)
361#endif
362 DOUBLE PRECISION, TARGET :: src_template(2), dst_template(2)
363 INTEGER :: iexch
364 TYPE(xt_request) :: request(2)
365
366 xmap = build_odd_selection_xmap(selection_len, comm)
367
369
371
372
373#if __INTEL_COMPILER >= 1600 && __INTEL_COMPILER <= 1602 || defined __PGI
374 DO j = 2, 0, -1
375 DO i = 1, 3
376 ref_dst_data(i + (2-j)*3) = dble(((2-j)*3+i+101)*((abs(j)+j)/abs(j+1)) &
377 & +(j-1-abs(j-1))/2)
378 END DO
379 END DO
380#endif
381 DO i = 1, npt
382 src_data(i) = 1.0d2 + dble(i)
383 END DO
384
385 DO iexch = 1, 2
386
387 dst_data = -1.0d0
388
389
390 IF (iexch == 1) THEN
393 ELSE
396 CALL check_wait_request(request(1), filename, __line__)
397 CALL check_wait_request(request(2), filename, __line__)
398 ENDIF
399
400 IF (cmp_arrays(dst_data, ref_dst_data)) &
401 CALL test_abort("error in "//exch1name(iexch), filename,__line__)
402 ENDDO
403 dst_data = -1.0d0
404
405 CALL mpi_get_address(src_template(1), base_address, ierror)
406 CALL mpi_get_address(src_template(2), temp_address, ierror)
407 src_extent = temp_address - base_address
408 CALL mpi_get_address(dst_template(1), base_address, ierror)
409 CALL mpi_get_address(dst_template(2), temp_address, ierror)
410 dst_extent = temp_address - base_address
411
413 displacements, config)
415
416
417 CALL check_redist(redist_repeat, src_data, dst_data, ref_dst_data)
418
420 END SUBROUTINE test_repeated_overlapping_redist
421
422END PROGRAM test_redist_repeat
423
424
425
426
427
428
429
430
431
void xt_config_delete(Xt_config config)
void xt_initialize(MPI_Comm default_comm)
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_off_new(Xt_xmap xmap, const int *src_offsets, const int *dst_offsets, MPI_Datatype datatype)
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)