1
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#include "fc_feature_defs.inc"
47PROGRAM test_redist_p2p_f
48 USE mpi
57
58
59#ifdef __PGI
61#endif
62 USE ftest_common, ONLY: init_mpi, finish_mpi, test_abort
63 USE test_redist_common, ONLY: check_redist, communicators_are_congruent, &
64 redist_exchanger_option
65 USE test_idxlist_utils, ONLY: test_err_count
66 IMPLICIT NONE
67 CHARACTER(len=*), PARAMETER :: filename = 'test_redist_p2p_f.f90'
68 TYPE(xt_config) :: config
69
70 CALL init_mpi
71
73 config = redist_exchanger_option()
74
75
76
77 CALL test_without_offsets
78 CALL test_with_offsets
79 CALL test_offset_extents
80
81 IF (test_err_count() /= 0) &
82 CALL test_abort("non-zero error count!", filename, __line__)
83
86 CALL finish_mpi
87
88CONTAINS
89
90 SUBROUTINE test_without_offsets
91 INTEGER, PARAMETER :: src_num_indices = 14, dst_num_indices = 13
92 INTEGER(xt_int_kind), PARAMETER :: src_index_list(src_num_indices) &
93 = (/ 5_xi, 67_xi, 4_xi, 5_xi, 13_xi, &
94 & 9_xi, 2_xi, 1_xi, 0_xi, 96_xi, &
95 & 13_xi, 12_xi, 1_xi, 3_xi /), &
96 dst_index_list(dst_num_indices) = &
97 & (/ 5_xi, 4_xi, 3_xi, 96_xi, 1_xi, &
98 & 5_xi, 4_xi, 5_xi, 4_xi, 3_xi, &
99 & 13_xi, 2_xi, 1_xi /)
100 INTEGER :: i
101#ifndef __PGI
102 DOUBLE PRECISION, PARAMETER :: src_data(src_num_indices) = &
103 (/ (dble(i), i=0,src_num_indices-1) /)
104#else
105
106 DOUBLE PRECISION :: src_data(src_num_indices)
107#endif
108 DOUBLE PRECISION, PARAMETER :: ref_dst_data(dst_num_indices) &
109 = (/ 0.0d0, 2.0d0, 13.0d0, 9.0d0, 7.0d0, &
110 & 0.0d0, 2.0d0, 0.0d0, 2.0d0, 13.0d0, &
111 & 4.0d0, 6.0d0, 7.0d0 /)
112 LOGICAL :: src_l(src_num_indices), &
113 dst_l(dst_num_indices), ref_dst_l(dst_num_indices)
114 DOUBLE PRECISION :: dst_data(dst_num_indices)
115 TYPE(xt_idxlist) :: src_idxlist, dst_idxlist
116 TYPE(xt_xmap) :: xmap
117 TYPE(xt_redist) :: redist_dp, redist_copy, redist_l
118
119#ifdef __PGI
120 DO i = 1, src_num_indices
121 src_data(i) = dble(i - 1)
122 END DO
123#endif
124
126
128
129
131
132
134
135
136 IF (.NOT. communicators_are_congruent(xt_redist_get_mpi_comm(redist_dp), &
137 mpi_comm_world)) &
138 CALL test_abort("error in xt_redist_get_mpi_Comm", filename, __line__)
139
140
141 CALL check_redist(redist_dp, src_data, dst_data, ref_dst_data)
142
143
144 src_l = nint(mod(src_data, 2.0d0)) == 1
145 dst_l = .false.
146 ref_dst_l = nint(mod(ref_dst_data, 2.0d0)) == 1
148 IF (.NOT. communicators_are_congruent(xt_redist_get_mpi_comm(redist_l), &
149 mpi_comm_world)) &
150 CALL test_abort("error in xt_redist_get_mpi_Comm", filename, __line__)
152 IF (any(dst_l .NEQV. ref_dst_l)) &
153 CALL test_abort("error in xt_redist_s_exchange for 1D logical array", &
154 filename, __line__)
157 CALL check_redist(redist_copy, src_data, dst_data, ref_dst_data)
158
159
165 END SUBROUTINE test_without_offsets
166
167 SUBROUTINE test_with_offsets
168
169 INTEGER, PARAMETER :: src_num = 14, dst_num = 13
170 INTEGER(xt_int_kind), PARAMETER :: src_index_list(src_num) = &
171 (/ 5_xi, 67_xi, 4_xi, 5_xi, 13_xi, &
172 & 9_xi, 2_xi, 1_xi, 0_xi, 96_xi, &
173 & 13_xi, 12_xi, 1_xi, 3_xi /), &
174 dst_index_list(dst_num) = &
175 (/ 5_xi, 4_xi, 3_xi, 96_xi, 1_xi, &
176 & 5_xi, 4_xi, 5_xi, 4_xi, 3_xi, &
177 & 13_xi, 2_xi, 1_xi /)
178 INTEGER :: i
179 INTEGER, PARAMETER :: src_pos(src_num) = (/ (i, i = 0, src_num - 1) /), &
180 dst_pos(dst_num) = (/ ( dst_num - i, i = 1, dst_num ) /)
181 TYPE(xt_idxlist) :: src_idxlist, dst_idxlist
182 TYPE(xt_xmap) :: xmap
183 TYPE(xt_redist) :: redist, redist_copy
184#ifndef __PGI
185 DOUBLE PRECISION, PARAMETER :: src_data(src_num) = &
186 (/ (dble(i), i=0,src_num-1) /)
187#else
188
189 DOUBLE PRECISION :: src_data(src_num)
190#endif
191 DOUBLE PRECISION :: dst_data(dst_num)
192 DOUBLE PRECISION, PARAMETER :: ref_dst_data(dst_num) = &
193 (/ 0.0d0, 2.0d0, 13.0d0, 9.0d0, 7.0d0, &
194 & 0.0d0, 2.0d0, 0.0d0, 2.0d0, 13.0d0, &
195 & 4.0d0, 6.0d0, 7.0d0 /)
196
197#ifdef __PGI
198 DO i = 1, src_num
199 src_data(i) = dble(i - 1)
200 END DO
201#endif
202
204
206
208
209
211 mpi_double_precision, config)
212
213
214 IF (.NOT. communicators_are_congruent(xt_redist_get_mpi_comm(redist), &
215 mpi_comm_world)) &
216 CALL test_abort("error in xt_redist_get_MPI_Comm", filename, __line__)
217
218
219 CALL check_redist(redist, src_data, dst_data, ref_dst_data(dst_num:1:-1))
220
223 CALL check_redist(redist_copy, src_data, dst_data, &
224 ref_dst_data(dst_num:1:-1))
225
226
231 END SUBROUTINE test_with_offsets
232
233 SUBROUTINE test_offset_extents
234
235 INTEGER, PARAMETER :: src_num = 14, dst_num = 13
236 INTEGER(xt_int_kind), PARAMETER :: src_index_list(src_num) = &
237 (/ 5_xi, 67_xi, 4_xi, 5_xi, 13_xi, &
238 & 9_xi, 2_xi, 1_xi, 0_xi, 96_xi, &
239 & 13_xi, 12_xi, 1_xi, 3_xi /), &
240 dst_index_list(dst_num) = &
241 (/ 5_xi, 4_xi, 3_xi, 96_xi, 1_xi, &
242 & 5_xi, 4_xi, 5_xi, 4_xi, 3_xi, &
243 & 13_xi, 2_xi, 1_xi /)
244#ifdef __G95__
245 INTEGER :: i
246 INTEGER(xt_int_kind), PARAMETER :: src_data(src_num) &
247 = (/ (int(i, xi), i = 0, 13) /)
248#else
249 INTEGER(xt_int_kind) :: i
250 INTEGER(xt_int_kind), PARAMETER :: src_data(src_num) &
251 = (/ (i, i = 0_xi, 13_xi) /)
252#endif
253 INTEGER(xt_int_kind) :: dst_data(dst_num)
254 INTEGER(xt_int_kind), PARAMETER :: ref_dst_data(dst_num) = &
255 (/ 7_xi, 6_xi, 4_xi, 13_xi, 2_xi, &
256 & 0_xi, 2_xi, 0_xi, 7_xi, 9_xi, &
257 & 13_xi, 2_xi, 0_xi /)
258 TYPE(xt_idxlist) :: src_idxlist, dst_idxlist
259 TYPE(xt_xmap) :: xmap
260 TYPE(xt_redist) :: redist, redist_copy
261 TYPE(xt_offset_ext), PARAMETER :: &
264
267
269
270
272
273 IF (.NOT. communicators_are_congruent(xt_redist_get_mpi_comm(redist), &
274 mpi_comm_world)) &
275 CALL test_abort("error in xt_redist_get_MPI_Comm", &
276 filename, __line__)
277
278
279 CALL check_redist(redist, src_data, dst_data, ref_dst_data)
280
283 CALL check_redist(redist_copy, src_data, dst_data, ref_dst_data)
284
285
290 END SUBROUTINE test_offset_extents
291
292END PROGRAM test_redist_p2p_f
293
294
295
296
297
298
299
300
301
void xt_config_delete(Xt_config config)
void xt_initialize(MPI_Comm default_comm)
void xt_idxlist_delete(Xt_idxlist idxlist)
Xt_idxlist xt_idxvec_new(const Xt_int *idxlist, int num_indices)
void xt_redist_delete(Xt_redist redist)
Xt_redist xt_redist_copy(Xt_redist redist)
void xt_redist_s_exchange(Xt_redist redist, int num_arrays, const void *const src_data[], void *const dst_data[])
Xt_redist xt_redist_p2p_new(Xt_xmap xmap, MPI_Datatype datatype)
Xt_redist xt_redist_p2p_off_custom_new(Xt_xmap xmap, const int *src_offsets, const int *dst_offsets, MPI_Datatype datatype, Xt_config config)
Xt_redist xt_redist_p2p_ext_new(Xt_xmap xmap, int num_src_ext, const struct Xt_offset_ext src_extents[], int num_dst_ext, const struct Xt_offset_ext dst_extents[], MPI_Datatype datatype)
void xt_xmap_delete(Xt_xmap xmap)
Xt_xmap xt_xmap_all2all_new(Xt_idxlist src_idxlist, Xt_idxlist dst_idxlist, MPI_Comm comm)