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);
158 MPI_Win_fence(MPI_MODE_NOSUCCEED, win);
159 MPI_Barrier(MPI_COMM_WORLD);
161 for (j = 0; j < nproc; j++) {
162 if ( CMP(res_ptr[j], i*rank) ) {
163 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]); );
169 MPI_Barrier(MPI_COMM_WORLD);
170 MPI_Win_lock(MPI_LOCK_EXCLUSIVE, rank, 0, win);
171 for (i = 0; i < nproc; i++) {
172 if ( CMP(val_ptr[i], ITER*i) ) {
173 SQUELCH( printf("%d->%d -- ALL-TO-ALL (FENCE): expected "TYPE_FMT", got "TYPE_FMT"\n", i, rank, (TYPE_C) ITER*i, val_ptr[i]); );
177 MPI_Win_unlock(rank, win);
179 /* Test all-to-all communication (lock-all) */
181 reset_vars(val_ptr, res_ptr, win);
183 for (i = 0; i < ITER; i++) {
186 MPI_Win_lock_all(0, win);
187 for (j = 0; j < nproc; j++) {
188 TYPE_C rank_cnv = (TYPE_C) rank;
189 MPI_Fetch_and_op(&rank_cnv, &res_ptr[j], TYPE_MPI, j, rank, MPI_SUM, win);
191 MPI_Win_unlock_all(win);
192 MPI_Barrier(MPI_COMM_WORLD);
194 for (j = 0; j < nproc; j++) {
195 if ( CMP(res_ptr[j], i*rank) ) {
196 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]); );
202 MPI_Barrier(MPI_COMM_WORLD);
203 MPI_Win_lock(MPI_LOCK_EXCLUSIVE, rank, 0, win);
204 for (i = 0; i < nproc; i++) {
205 if ( CMP(val_ptr[i], ITER*i) ) {
206 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]); );
210 MPI_Win_unlock(rank, win);
212 /* Test all-to-all communication (lock-all+flush) */
214 reset_vars(val_ptr, res_ptr, win);
216 for (i = 0; i < ITER; i++) {
219 MPI_Win_lock_all(0, win);
220 for (j = 0; j < nproc; j++) {
221 TYPE_C rank_cnv = (TYPE_C) rank;
222 MPI_Fetch_and_op(&rank_cnv, &res_ptr[j], TYPE_MPI, j, rank, MPI_SUM, win);
223 MPI_Win_flush(j, win);
225 MPI_Win_unlock_all(win);
226 MPI_Barrier(MPI_COMM_WORLD);
228 for (j = 0; j < nproc; j++) {
229 if ( CMP(res_ptr[j], i*rank) ) {
230 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]); );
236 MPI_Barrier(MPI_COMM_WORLD);
237 MPI_Win_lock(MPI_LOCK_EXCLUSIVE, rank, 0, win);
238 for (i = 0; i < nproc; i++) {
239 if ( CMP(val_ptr[i], ITER*i) ) {
240 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]); );
244 MPI_Win_unlock(rank, win);
246 /* Test NO_OP (neighbor communication) */
248 MPI_Barrier(MPI_COMM_WORLD);
249 reset_vars(val_ptr, res_ptr, win);
251 MPI_Win_lock(MPI_LOCK_EXCLUSIVE, rank, 0, win);
252 for (i = 0; i < nproc; i++)
253 val_ptr[i] = (TYPE_C) rank;
254 MPI_Win_unlock(rank, win);
255 MPI_Barrier(MPI_COMM_WORLD);
257 for (i = 0; i < ITER; i++) {
258 int target = (rank+1) % nproc;
260 MPI_Win_lock(MPI_LOCK_EXCLUSIVE, target, 0, win);
261 MPI_Fetch_and_op(NULL, res_ptr, TYPE_MPI, target, 0, MPI_NO_OP, win);
262 MPI_Win_unlock(target, win);
264 if (res_ptr[0] != (TYPE_C) target) {
265 SQUELCH( printf("%d->%d -- NOP[%d]: expected "TYPE_FMT", got "TYPE_FMT"\n",
266 target, rank, i, (TYPE_C) target, res_ptr[0]); );
271 /* Test NO_OP (self communication) */
273 MPI_Barrier(MPI_COMM_WORLD);
274 reset_vars(val_ptr, res_ptr, win);
276 MPI_Win_lock(MPI_LOCK_EXCLUSIVE, rank, 0, win);
277 for (i = 0; i < nproc; i++)
278 val_ptr[i] = (TYPE_C) rank;
279 MPI_Win_unlock(rank, win);
280 MPI_Barrier(MPI_COMM_WORLD);
282 for (i = 0; i < ITER; i++) {
285 MPI_Win_lock(MPI_LOCK_EXCLUSIVE, target, 0, win);
286 MPI_Fetch_and_op(NULL, res_ptr, TYPE_MPI, target, 0, MPI_NO_OP, win);
287 MPI_Win_unlock(target, win);
289 if (res_ptr[0] != (TYPE_C) target) {
290 SQUELCH( printf("%d->%d -- NOP_SELF[%d]: expected "TYPE_FMT", got "TYPE_FMT"\n",
291 target, rank, i, (TYPE_C) target, res_ptr[0]); );
298 MPI_Reduce(&errors, &all_errors, 1, MPI_INT, MPI_SUM, 0, MPI_COMM_WORLD);
300 if (rank == 0 && all_errors == 0)
301 printf(" No Errors\n");