48 PROGRAM test_redist_repeat
50 USE ftest_common,
ONLY: init_mpi, finish_mpi, test_abort, cmp_arrays
51 USE test_idxlist_utils,
ONLY: test_err_count
57 #if defined __PGI && ( __PGIC__ == 15 || __PGIC__ == 14 )
61 USE test_redist_common,
ONLY: build_odd_selection_xmap, check_redist, &
62 check_wait_request, redist_exchanger_option
63 USE iso_c_binding,
ONLY: c_int
65 CHARACTER(len=*),
PARAMETER :: filename =
'test_redist_repeat_f.f90'
66 CHARACTER(len=*),
PARAMETER :: exch1name(2) = &
67 (/
"xt_redist_s_exchange1",
"xt_redist_a_exchange1" /)
68 TYPE(xt_config) :: config
72 config = redist_exchanger_option()
74 CALL simple_test(mpi_comm_world, config)
75 CALL test_repeated_redist(mpi_comm_world, config)
76 CALL test_repeated_redist_with_gap(mpi_comm_world, config)
77 CALL test_repeated_overlapping_redist(mpi_comm_world, config)
78 CALL test_repeated_redist_asym(mpi_comm_world, config)
80 IF (test_err_count() /= 0) &
81 CALL test_abort(
"non-zero error count!", filename, __line__)
86 SUBROUTINE simple_test(comm, config)
87 INTEGER,
INTENT(in) :: comm
88 TYPE(xt_config),
INTENT(in) :: config
92 TYPE(xt_redist) :: redist, redist_repeat
93 INTEGER,
PARAMETER :: src_slice_len = 5, dst_slice_len = 3
94 DOUBLE PRECISION,
PARAMETER :: ref_dst_data(dst_slice_len) &
95 = (/ 1.0d0, 3.0d0, 5.0d0 /), &
96 src_data(src_slice_len) = (/ 1.0d0, 2.0d0, 3.0d0, 4.0d0, 5.0d0 /)
97 DOUBLE PRECISION :: dst_data(dst_slice_len)
98 INTEGER(mpi_address_kind) :: src_extent, dst_extent
99 INTEGER(mpi_address_kind) :: base_address, temp_address
100 INTEGER(c_int) :: displacements(1) = 0
103 xmap = build_odd_selection_xmap(src_slice_len)
109 CALL mpi_get_address(src_data(1), base_address, ierror)
110 CALL mpi_get_address(src_data(2), temp_address, ierror)
111 src_extent = (temp_address - base_address) * src_slice_len
112 CALL mpi_get_address(dst_data(1), base_address, ierror)
113 CALL mpi_get_address(dst_data(2), temp_address, ierror)
114 dst_extent = (temp_address - base_address) * dst_slice_len
118 displacements, config)
123 CALL check_redist(redist_repeat, src_data, dst_data, ref_dst_data)
127 END SUBROUTINE simple_test
129 SUBROUTINE test_repeated_redist_ds1(redist_repeat)
130 TYPE(xt_redist),
INTENT(in) :: redist_repeat
132 DOUBLE PRECISION,
PARAMETER :: src_data(5, 3) = reshape((/&
133 (dble(i), i = 1, 15)/), (/ 5, 3 /))
134 DOUBLE PRECISION,
PARAMETER :: ref_dst_data(3, 3) &
135 = reshape((/ ((dble(i + j), i = 1,5,2), j = 0,10,5) /), (/ 3, 3 /))
136 DOUBLE PRECISION :: dst_data(3, 3)
138 CALL check_redist(redist_repeat, src_data, dst_data, ref_dst_data)
139 END SUBROUTINE test_repeated_redist_ds1
143 #elif defined(_CRAYFTN)
144 # if _RELEASE_MAJOR < 8 || (_RELEASE_MAJOR == 8 && _RELEASE_MINOR < 7)
149 SUBROUTINE test_repeated_redist_ds1_with_gap(redist_repeat)
150 TYPE(xt_redist),
INTENT(in) :: redist_repeat
152 DOUBLE PRECISION,
PARAMETER :: src_data(5, 5) = reshape((/&
153 (dble(i), i = 1, 25)/), (/ 5, 5 /))
154 DOUBLE PRECISION :: dst_data(3, 5)
156 DOUBLE PRECISION :: ref_dst_data(3, 5)
158 = reshape((/ ((dble((i + j)*mod(j+1,2)-mod(j,2)), i = 1,5,2), &
159 j = 0,20,5) /), (/ 3, 5 /))
161 DOUBLE PRECISION,
PARAMETER :: ref_dst_data(3, 5) &
162 = reshape((/ ((dble((i + j)*mod(j+1,2)-mod(j,2)), i = 1,5,2), j = 0,20,5) /), (/ 3, 5 /))
164 CALL check_redist(redist_repeat, src_data, dst_data, ref_dst_data)
165 END SUBROUTINE test_repeated_redist_ds1_with_gap
167 SUBROUTINE test_repeated_redist_ds2(redist_repeat)
168 TYPE(xt_redist),
INTENT(in) :: redist_repeat
170 DOUBLE PRECISION,
PARAMETER :: src_data(5, 3) = reshape((/&
171 (dble(i), i = 20, 34)/), (/ 5, 3 /))
172 DOUBLE PRECISION,
PARAMETER :: ref_dst_data(3, 3) &
173 = reshape((/ ((dble(i + j), i = 1,5,2), j = 19,33,5) /), (/ 3, 3 /))
174 DOUBLE PRECISION :: dst_data(3, 3)
176 CALL check_redist(redist_repeat, src_data, dst_data, ref_dst_data)
177 END SUBROUTINE test_repeated_redist_ds2
179 SUBROUTINE test_repeated_redist(comm, config)
180 INTEGER,
INTENT(in) :: comm
181 TYPE(xt_config),
INTENT(in) :: config
185 INTEGER,
PARAMETER :: num_slice = 3
186 INTEGER,
PARAMETER :: src_slice_len = 5
187 TYPE(xt_xmap) :: xmap
188 TYPE(xt_redist) :: redist, redist_repeat
189 INTEGER(mpi_address_kind) :: src_extent, dst_extent
190 INTEGER(mpi_address_kind) :: base_address, temp_address
191 INTEGER(c_int) :: displacements(3)
192 DOUBLE PRECISION,
TARGET :: src_template(5, 3), dst_template(3, 3)
195 xmap = build_odd_selection_xmap(src_slice_len)
202 CALL mpi_get_address(src_template(1,1), base_address, ierror)
203 CALL mpi_get_address(src_template(1,2), temp_address, ierror)
204 src_extent = temp_address - base_address
205 CALL mpi_get_address(dst_template(1,1), base_address, ierror)
206 CALL mpi_get_address(dst_template(1,2), temp_address, ierror)
207 dst_extent = temp_address - base_address
208 displacements = (/0,1,2/)
211 num_slice, displacements, config)
215 CALL test_repeated_redist_ds1(redist_repeat)
217 CALL test_repeated_redist_ds2(redist_repeat)
220 END SUBROUTINE test_repeated_redist
222 SUBROUTINE test_repeated_redist_asym(comm, config)
223 INTEGER,
INTENT(in) :: comm
224 TYPE(xt_config),
INTENT(in) :: config
227 INTEGER,
PARAMETER :: num_slice = 3
228 INTEGER,
PARAMETER :: src_slice_len = 5
229 TYPE(xt_xmap) :: xmap
230 TYPE(xt_redist) :: redist, redist_repeat
231 INTEGER(mpi_address_kind) :: src_extent, dst_extent
232 INTEGER(mpi_address_kind) :: base_address, temp_address
233 INTEGER(c_int) :: src_displacements(3), dst_displacements(3)
235 DOUBLE PRECISION,
PARAMETER :: &
236 ref_dst_data(3, 3) = reshape([ 6.0d0, 8.0d0, 10.0d0, 11.0d0, 13.0d0, &
237 & 15.0d0, 1.0d0, 3.0d0, 5.0d0 ], [3,3] )
238 DOUBLE PRECISION,
TARGET :: dst_data(3, 3)
239 DOUBLE PRECISION,
TARGET,
SAVE :: &
240 src_data(5, 3) = reshape([(dble(i), i = 1, 15)], [5,3])
241 INTEGER,
PARAMETER :: dp = kind(src_data)
244 xmap = build_odd_selection_xmap(src_slice_len)
251 CALL mpi_get_address(src_data(1,1), base_address, ierror)
252 CALL mpi_get_address(src_data(1,2), temp_address, ierror)
253 src_extent = temp_address - base_address
254 CALL mpi_get_address(dst_data(1,1), base_address, ierror)
255 CALL mpi_get_address(dst_data(1,2), temp_address, ierror)
256 dst_extent = temp_address - base_address
259 src_displacements = [0,1,2]
260 dst_displacements = [2,0,1]
264 num_slice, src_displacements, dst_displacements, config)
266 CALL check_redist(redist_repeat, src_data, dst_data, ref_dst_data)
271 src_displacements, dst_displacements, config)
273 CALL check_redist(redist_repeat, src_data, dst_data, ref_dst_data)
277 END SUBROUTINE test_repeated_redist_asym
279 SUBROUTINE test_repeated_redist_with_gap(comm, config)
280 INTEGER,
INTENT(in) :: comm
281 TYPE(xt_config),
INTENT(in) :: config
286 INTEGER,
PARAMETER :: num_slice = 3
287 INTEGER,
PARAMETER :: src_slice_len = 5
288 TYPE(xt_xmap) :: xmap
289 TYPE(xt_redist) :: redist, redist_repeat
290 INTEGER(mpi_address_kind) :: src_extent, dst_extent
291 INTEGER(mpi_address_kind) :: base_address, temp_address
292 INTEGER(c_int),
PARAMETER :: displacements(3) = (/0,2,4/)
293 DOUBLE PRECISION,
TARGET :: src_template(5, 3), dst_template(3, 3)
296 xmap = build_odd_selection_xmap(src_slice_len)
303 CALL mpi_get_address(src_template(1,1), base_address, ierror)
304 CALL mpi_get_address(src_template(1,2), temp_address, ierror)
305 src_extent = temp_address - base_address
306 CALL mpi_get_address(dst_template(1,1), base_address, ierror)
307 CALL mpi_get_address(dst_template(1,2), temp_address, ierror)
308 dst_extent = temp_address - base_address
311 num_slice, displacements, config)
315 CALL test_repeated_redist_ds1_with_gap(redist_repeat)
318 END SUBROUTINE test_repeated_redist_with_gap
320 SUBROUTINE test_repeated_overlapping_redist(comm, config)
321 INTEGER,
INTENT(in) :: comm
322 TYPE(xt_config),
INTENT(in) :: config
327 INTEGER,
PARAMETER :: npt = 9, selection_len = 6
328 TYPE(xt_xmap) :: xmap
329 TYPE(xt_redist) :: redist, redist_repeat
330 INTEGER(mpi_address_kind) :: src_extent, dst_extent
331 INTEGER(mpi_address_kind) :: base_address, temp_address
332 INTEGER(c_int),
PARAMETER :: displacements(2) = (/ 0_c_int, 1_c_int /)
333 INTEGER :: i, j, ierror
334 INTEGER,
PARAMETER :: src_pos(npt) = (/ (i, i=1,npt) /), &
335 dst_pos(npt) = (/ (2*i, i = 0, npt-1) /)
336 DOUBLE PRECISION :: src_data(npt), dst_data(npt)
337 #if __INTEL_COMPILER >= 1600 && __INTEL_COMPILER <= 1602 || defined __PGI
338 DOUBLE PRECISION :: ref_dst_data(npt)
340 DOUBLE PRECISION,
PARAMETER :: ref_dst_data(npt) &
341 = (/ ((dble(((2-j)*3+i+101)*((abs(j)+j)/abs(j+max(1,j))) &
342 & +(j-1-abs(j-1))/2), &
343 & i=1,3 ),j=2,0,-1) /)
345 DOUBLE PRECISION,
TARGET :: src_template(2), dst_template(2)
347 TYPE(xt_request) :: request(2)
349 xmap = build_odd_selection_xmap(selection_len)
356 #if __INTEL_COMPILER >= 1600 && __INTEL_COMPILER <= 1602 || defined __PGI
359 ref_dst_data(i + (2-j)*3) = dble(((2-j)*3+i+101)*((abs(j)+j)/abs(j+1)) &
365 src_data(i) = 1.0d2 + dble(i)
379 CALL check_wait_request(request(1), filename, __line__)
380 CALL check_wait_request(request(2), filename, __line__)
383 IF (cmp_arrays(dst_data, ref_dst_data)) &
384 CALL test_abort(
"error in "//exch1name(iexch), filename,__line__)
388 CALL mpi_get_address(src_template(1), base_address, ierror)
389 CALL mpi_get_address(src_template(2), temp_address, ierror)
390 src_extent = temp_address - base_address
391 CALL mpi_get_address(dst_template(1), base_address, ierror)
392 CALL mpi_get_address(dst_template(2), temp_address, ierror)
393 dst_extent = temp_address - base_address
396 displacements, config)
400 CALL check_redist(redist_repeat, src_data, dst_data, ref_dst_data)
403 END SUBROUTINE test_repeated_overlapping_redist
405 END PROGRAM test_redist_repeat
void xt_config_delete(Xt_config config)
void xt_initialize(MPI_Comm default_comm)
void xt_redist_delete(Xt_redist redist)
void xt_redist_a_exchange(Xt_redist redist, int num_arrays, const void **src_data, void **dst_data, Xt_request *request)
void xt_redist_s_exchange(Xt_redist redist, int num_arrays, const void **src_data, void **dst_data)
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)