1 /* -*- Mode: C; c-basic-offset:4 ; indent-tabs-mode:nil ; -*- */
4 * (C) 2012 by Argonne National Laboratory.
5 * See COPYRIGHT in top-level directory.
17 #if defined (FOP_TYPE_CHAR)
19 # define TYPE_MPI MPI_CHAR
20 # define TYPE_FMT "%d"
21 #elif defined (FOP_TYPE_SHORT)
23 # define TYPE_MPI MPI_SHORT
24 # define TYPE_FMT "%d"
25 #elif defined (FOP_TYPE_LONG)
27 # define TYPE_MPI MPI_LONG
28 # define TYPE_FMT "%ld"
29 #elif defined (FOP_TYPE_DOUBLE)
30 # define TYPE_C double
31 # define TYPE_MPI MPI_DOUBLE
32 # define TYPE_FMT "%f"
33 #elif defined (FOP_TYPE_LONG_DOUBLE)
34 # define TYPE_C long double
35 # define TYPE_MPI MPI_LONG_DOUBLE
36 # define TYPE_FMT "%Lf"
39 # define TYPE_MPI MPI_INT
40 # define TYPE_FMT "%d"
43 #define CMP(x, y) ((x - ((TYPE_C) (y))) > 1.0e-9)
45 void reset_vars(TYPE_C *val_ptr, TYPE_C *res_ptr, MPI_Win win) {
48 MPI_Comm_rank(MPI_COMM_WORLD, &rank);
49 MPI_Comm_size(MPI_COMM_WORLD, &nproc);
51 MPI_Win_lock(MPI_LOCK_EXCLUSIVE, rank, 0, win);
52 for (i = 0; i < nproc; i++) {
56 MPI_Win_unlock(rank, win);
58 MPI_Barrier(MPI_COMM_WORLD);
61 int main(int argc, char **argv) {
62 int i, rank, nproc, mpi_type_size;
63 int errors = 0, all_errors = 0;
64 TYPE_C *val_ptr, *res_ptr;
67 MPI_Init(&argc, &argv);
69 MPI_Comm_rank(MPI_COMM_WORLD, &rank);
70 MPI_Comm_size(MPI_COMM_WORLD, &nproc);
72 MPI_Type_size(TYPE_MPI, &mpi_type_size);
73 assert(mpi_type_size == sizeof(TYPE_C));
75 val_ptr = malloc(sizeof(TYPE_C)*nproc);
76 res_ptr = malloc(sizeof(TYPE_C)*nproc);
78 MPI_Win_create(val_ptr, sizeof(TYPE_C)*nproc, sizeof(TYPE_C), MPI_INFO_NULL, MPI_COMM_WORLD, &win);
80 /* Test self communication */
82 reset_vars(val_ptr, res_ptr, win);
84 for (i = 0; i < ITER; i++) {
85 TYPE_C one = 1, result = -1;
86 MPI_Win_lock(MPI_LOCK_EXCLUSIVE, rank, 0, win);
87 MPI_Fetch_and_op(&one, &result, TYPE_MPI, rank, 0, MPI_SUM, win);
88 MPI_Win_unlock(rank, win);
91 MPI_Win_lock(MPI_LOCK_EXCLUSIVE, rank, 0, win);
92 if ( CMP(val_ptr[0], ITER) ) {
93 SQUELCH( printf("%d->%d -- SELF: expected "TYPE_FMT", got "TYPE_FMT"\n", rank, rank, (TYPE_C) ITER, val_ptr[0]); );
96 MPI_Win_unlock(rank, win);
98 /* Test neighbor communication */
100 reset_vars(val_ptr, res_ptr, win);
102 for (i = 0; i < ITER; i++) {
103 TYPE_C one = 1, result = -1;
104 MPI_Win_lock(MPI_LOCK_EXCLUSIVE, (rank+1)%nproc, 0, win);
105 MPI_Fetch_and_op(&one, &result, TYPE_MPI, (rank+1)%nproc, 0, MPI_SUM, win);
106 MPI_Win_unlock((rank+1)%nproc, win);
107 if ( CMP(result, i) ) {
108 SQUELCH( printf("%d->%d -- NEIGHBOR[%d]: expected result "TYPE_FMT", got "TYPE_FMT"\n", (rank+1)%nproc, rank, i, (TYPE_C) i, result); );
113 MPI_Barrier(MPI_COMM_WORLD);
115 MPI_Win_lock(MPI_LOCK_EXCLUSIVE, rank, 0, win);
116 if ( CMP(val_ptr[0], ITER) ) {
117 SQUELCH( printf("%d->%d -- NEIGHBOR: expected "TYPE_FMT", got "TYPE_FMT"\n", (rank+1)%nproc, rank, (TYPE_C) ITER, val_ptr[0]); );
120 MPI_Win_unlock(rank, win);
122 /* Test contention */
124 reset_vars(val_ptr, res_ptr, win);
127 for (i = 0; i < ITER; i++) {
128 TYPE_C one = 1, result;
129 MPI_Win_lock(MPI_LOCK_EXCLUSIVE, 0, 0, win);
130 MPI_Fetch_and_op(&one, &result, TYPE_MPI, 0, 0, MPI_SUM, win);
131 MPI_Win_unlock(0, win);
135 MPI_Barrier(MPI_COMM_WORLD);
137 MPI_Win_lock(MPI_LOCK_EXCLUSIVE, rank, 0, win);
138 if (rank == 0 && nproc > 1) {
139 if ( CMP(val_ptr[0], ITER*(nproc-1)) ) {
140 SQUELCH( printf("*->%d - CONTENTION: expected="TYPE_FMT" val="TYPE_FMT"\n", rank, (TYPE_C) ITER*(nproc-1), val_ptr[0]); );
144 MPI_Win_unlock(rank, win);
146 /* Test all-to-all communication (fence) */
148 reset_vars(val_ptr, res_ptr, win);
150 for (i = 0; i < ITER; i++) {
153 MPI_Win_fence(MPI_MODE_NOPRECEDE, win);
154 for (j = 0; j < nproc; j++) {
155 TYPE_C rank_cnv = (TYPE_C) rank;
156 MPI_Fetch_and_op(&rank_cnv, &res_ptr[j], TYPE_MPI, j, rank, MPI_SUM, win);
159 MPI_Win_fence(MPI_MODE_NOSUCCEED, win);
160 MPI_Barrier(MPI_COMM_WORLD);
162 for (j = 0; j < nproc; j++) {
163 if ( CMP(res_ptr[j], i*rank) ) {
164 SQUELCH( printf("%d->%d -- ALL-TO-ALL (FENCE) [%d]: expected result "TYPE_FMT", got "TYPE_FMT"\n", rank, j, i, (TYPE_C) i*rank, res_ptr[j]); );
170 MPI_Barrier(MPI_COMM_WORLD);
171 MPI_Win_lock(MPI_LOCK_EXCLUSIVE, rank, 0, win);
172 for (i = 0; i < nproc; i++) {
173 if ( CMP(val_ptr[i], ITER*i) ) {
174 SQUELCH( printf("%d->%d -- ALL-TO-ALL (FENCE): expected "TYPE_FMT", got "TYPE_FMT"\n", i, rank, (TYPE_C) ITER*i, val_ptr[i]); );
178 MPI_Win_unlock(rank, win);
180 /* Test all-to-all communication (lock-all) */
182 reset_vars(val_ptr, res_ptr, win);
184 for (i = 0; i < ITER; i++) {
187 MPI_Win_lock_all(0, win);
188 for (j = 0; j < nproc; j++) {
189 TYPE_C rank_cnv = (TYPE_C) rank;
190 MPI_Fetch_and_op(&rank_cnv, &res_ptr[j], TYPE_MPI, j, rank, MPI_SUM, win);
193 MPI_Win_unlock_all(win);
194 MPI_Barrier(MPI_COMM_WORLD);
196 for (j = 0; j < nproc; j++) {
197 if ( CMP(res_ptr[j], i*rank) ) {
198 SQUELCH( printf("%d->%d -- ALL-TO-ALL (LOCK-ALL) [%d]: expected result "TYPE_FMT", got "TYPE_FMT"\n", rank, j, i, (TYPE_C) i*rank, res_ptr[j]); );
204 MPI_Barrier(MPI_COMM_WORLD);
205 MPI_Win_lock(MPI_LOCK_EXCLUSIVE, rank, 0, win);
206 for (i = 0; i < nproc; i++) {
207 if ( CMP(val_ptr[i], ITER*i) ) {
208 SQUELCH( printf("%d->%d -- ALL-TO-ALL (LOCK-ALL): expected "TYPE_FMT", got "TYPE_FMT"\n", i, rank, (TYPE_C) ITER*i, val_ptr[i]); );
212 MPI_Win_unlock(rank, win);
214 /* Test all-to-all communication (lock-all+flush) */
216 reset_vars(val_ptr, res_ptr, win);
218 for (i = 0; i < ITER; i++) {
221 MPI_Win_lock_all(0, win);
222 for (j = 0; j < nproc; j++) {
223 TYPE_C rank_cnv = (TYPE_C) rank;
224 MPI_Fetch_and_op(&rank_cnv, &res_ptr[j], TYPE_MPI, j, rank, MPI_SUM, win);
226 MPI_Win_flush(j, win);
228 MPI_Win_unlock_all(win);
229 MPI_Barrier(MPI_COMM_WORLD);
231 for (j = 0; j < nproc; j++) {
232 if ( CMP(res_ptr[j], i*rank) ) {
233 SQUELCH( printf("%d->%d -- ALL-TO-ALL (LOCK-ALL+FLUSH) [%d]: expected result "TYPE_FMT", got "TYPE_FMT"\n", rank, j, i, (TYPE_C) i*rank, res_ptr[j]); );
239 MPI_Barrier(MPI_COMM_WORLD);
240 MPI_Win_lock(MPI_LOCK_EXCLUSIVE, rank, 0, win);
241 for (i = 0; i < nproc; i++) {
242 if ( CMP(val_ptr[i], ITER*i) ) {
243 SQUELCH( printf("%d->%d -- ALL-TO-ALL (LOCK-ALL+FLUSH): expected "TYPE_FMT", got "TYPE_FMT"\n", i, rank, (TYPE_C) ITER*i, val_ptr[i]); );
247 MPI_Win_unlock(rank, win);
249 /* Test NO_OP (neighbor communication) */
251 MPI_Barrier(MPI_COMM_WORLD);
252 reset_vars(val_ptr, res_ptr, win);
254 MPI_Win_lock(MPI_LOCK_EXCLUSIVE, rank, 0, win);
255 for (i = 0; i < nproc; i++)
256 val_ptr[i] = (TYPE_C) rank;
257 MPI_Win_unlock(rank, win);
258 MPI_Barrier(MPI_COMM_WORLD);
260 for (i = 0; i < ITER; i++) {
261 int target = (rank+1) % nproc;
263 MPI_Win_lock(MPI_LOCK_EXCLUSIVE, target, 0, win);
264 MPI_Fetch_and_op(NULL, res_ptr, TYPE_MPI, target, 0, MPI_NO_OP, win);
265 MPI_Win_unlock(target, win);
267 if (res_ptr[0] != (TYPE_C) target) {
268 SQUELCH( printf("%d->%d -- NOP[%d]: expected "TYPE_FMT", got "TYPE_FMT"\n",
269 target, rank, i, (TYPE_C) target, res_ptr[0]); );
274 /* Test NO_OP (self communication) */
276 MPI_Barrier(MPI_COMM_WORLD);
277 reset_vars(val_ptr, res_ptr, win);
279 MPI_Win_lock(MPI_LOCK_EXCLUSIVE, rank, 0, win);
280 for (i = 0; i < nproc; i++)
281 val_ptr[i] = (TYPE_C) rank;
282 MPI_Win_unlock(rank, win);
283 MPI_Barrier(MPI_COMM_WORLD);
285 for (i = 0; i < ITER; i++) {
288 MPI_Win_lock(MPI_LOCK_EXCLUSIVE, target, 0, win);
289 MPI_Fetch_and_op(NULL, res_ptr, TYPE_MPI, target, 0, MPI_NO_OP, win);
290 MPI_Win_unlock(target, win);
292 if (res_ptr[0] != (TYPE_C) target) {
293 SQUELCH( printf("%d->%d -- NOP_SELF[%d]: expected "TYPE_FMT", got "TYPE_FMT"\n",
294 target, rank, i, (TYPE_C) target, res_ptr[0]); );
301 MPI_Reduce(&errors, &all_errors, 1, MPI_INT, MPI_SUM, 0, MPI_COMM_WORLD);
303 if (rank == 0 && all_errors == 0)
304 printf(" No Errors\n");