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_collection_static
50 USE mpi
51 USE ftest_common, ONLY: init_mpi, finish_mpi, test_abort
52 USE test_idxlist_utils, ONLY: test_err_count
57 USE test_redist_common, ONLY: build_odd_selection_xmap, check_redist, &
58 redist_exchanger_option
59 IMPLICIT NONE
60 TYPE(xt_config) :: config
61 CHARACTER(len=*), PARAMETER :: &
62 filename = 'test_redist_collection_static_f.f90'
63 CALL init_mpi
65 config = redist_exchanger_option()
66
67 CALL simple_test(mpi_comm_world, config)
68 CALL test_repeated_redist(mpi_comm_world, config)
69
70 IF (test_err_count() /= 0) &
71 CALL test_abort("non-zero error count!", filename, __line__)
74 CALL finish_mpi
75CONTAINS
76 SUBROUTINE simple_test(comm, config)
77
78 INTEGER, INTENT(in) :: comm
79 TYPE(xt_config), INTENT(in) :: config
80
81 TYPE(xt_xmap) :: xmap
82 TYPE(xt_redist) :: redist, redist_coll
83 INTEGER, PARAMETER :: src_slice_len = 5, dst_slice_len = 3
84 DOUBLE PRECISION, PARAMETER :: &
85 src_data(src_slice_len) = (/ 1.0d0, 2.0d0, 3.0d0, 4.0d0, 5.0d0 /), &
86 ref_dst_data(dst_slice_len) = (/ 1.0d0, 3.0d0, 5.0d0 /)
87 DOUBLE PRECISION :: dst_data(dst_slice_len)
88 INTEGER(mpi_address_kind), PARAMETER :: &
89 displacements(1) = 0_mpi_address_kind
90
91 xmap = build_odd_selection_xmap(src_slice_len, comm)
92
94
96
97
99 displacements, displacements, comm, config)
100
102
103
104 CALL check_redist(redist_coll, src_data, dst_data, ref_dst_data)
105
106
108 END SUBROUTINE simple_test
109
110 SUBROUTINE test_repeated_redist_ds1(redist_coll)
111 TYPE(xt_redist), INTENT(in) :: redist_coll
112 INTEGER :: i, j
113 DOUBLE PRECISION, PARAMETER :: src_data(5, 3) &
114 = reshape((/ (dble(i), i = 1, 15)/), (/ 5, 3 /)), &
115 ref_dst_data(3, 3) &
116 = reshape((/ ((dble(i + j), i = 1,5,2), j = 0,10,5) /), (/ 3, 3 /))
117 DOUBLE PRECISION :: dst_data(3, 3)
118
119 CALL check_redist(redist_coll, src_data, dst_data, ref_dst_data)
120 END SUBROUTINE test_repeated_redist_ds1
121
122 SUBROUTINE test_repeated_redist_ds2(redist_coll)
123 TYPE(xt_redist), INTENT(in) :: redist_coll
124 INTEGER :: i, j
125 DOUBLE PRECISION, PARAMETER :: src_data(5, 3) = reshape((/&
126 (dble(i), i = 20, 34)/), (/ 5, 3 /)), &
127 ref_dst_data(3, 3) &
128 = reshape((/ ((dble(i + j), i = 1,5,2), j = 19,33,5) /), (/ 3, 3 /))
129 DOUBLE PRECISION, SAVE :: dst_data(3, 3)
130
131 CALL check_redist(redist_coll, src_data, dst_data, ref_dst_data)
132 END SUBROUTINE test_repeated_redist_ds2
133
134 SUBROUTINE test_repeated_redist(comm, config)
135
136
137 INTEGER, INTENT(in) :: comm
138 TYPE(xt_config), INTENT(in) :: config
139
140 INTEGER, PARAMETER :: num_slice = 3
141 INTEGER, PARAMETER :: src_slice_len = 5
142 TYPE(xt_xmap) :: xmap
143 TYPE(xt_redist) :: redist, redists(num_slice), redist_coll
144 INTEGER(mpi_address_kind) :: src_displacements(num_slice), &
145 dst_displacements(num_slice), src_base, dst_base, temp
146 DOUBLE PRECISION, TARGET :: src_template(5, 3), dst_template(3, 3)
147 INTEGER :: i, ierror
148
149 xmap = build_odd_selection_xmap(src_slice_len, comm)
150
152
154
155
156 redists = redist
157 src_displacements(1) = 0_mpi_address_kind
158 dst_displacements(1) = 0_mpi_address_kind
159 CALL mpi_get_address(src_template(1, 1), src_base, ierror)
160 CALL mpi_get_address(dst_template(1, 1), dst_base, ierror)
161 DO i = 2, num_slice
162 CALL mpi_get_address(src_template(1, i), temp, ierror)
163 src_displacements(i) = temp - src_base
164 CALL mpi_get_address(dst_template(1, i), temp, ierror)
165 dst_displacements(i) = temp - dst_base
166 END DO
167
169 src_displacements, dst_displacements, comm, config)
171
172
173 CALL test_repeated_redist_ds1(redist_coll)
174
175 CALL test_repeated_redist_ds2(redist_coll)
176
177 CALL test_repeated_redist_ds1(redist_coll)
178
180 END SUBROUTINE test_repeated_redist
181
182END PROGRAM test_redist_collection_static
183
184
185
186
187
188
189
190
191
void xt_config_delete(Xt_config config)
void xt_initialize(MPI_Comm default_comm)
void xt_redist_delete(Xt_redist redist)
Xt_redist xt_redist_collection_static_new(Xt_redist *redists, int num_redists, const MPI_Aint src_displacements[num_redists], const MPI_Aint dst_displacements[num_redists], MPI_Comm comm)
Xt_redist xt_redist_p2p_new(Xt_xmap xmap, MPI_Datatype datatype)
void xt_xmap_delete(Xt_xmap xmap)