1 /* -*- Mode: C; c-basic-offset:4 ; indent-tabs-mode:nil ; -*- */
3 * (C) 2013 by Argonne National Laboratory.
4 * See COPYRIGHT in top-level directory.
11 /* Defines INT32_MAX, which is not appropriate for int types. */
20 static void verbose_abort(int errorcode)
23 char errorstring[MPI_MAX_ERROR_STRING];
27 /* We do not check error codes here
28 * because if MPI is in a really sorry state,
29 * all of them might fail. */
30 MPI_Comm_rank(MPI_COMM_WORLD, &rank);
31 MPI_Error_class(errorcode, &errorclass);
32 MPI_Error_string(errorcode, errorstring, &resultlen);
34 memset(errorstring, 0, MPI_MAX_ERROR_STRING); /* optional */
35 fprintf(stderr, "%d: MPI failed (%d: %s) \n", rank, errorclass, errorstring);
36 fflush(stderr); /* almost certainly redundant with the following... */
38 MPI_Abort(MPI_COMM_WORLD, errorclass);
43 #define MPI_ASSERT(rc) \
44 do { if ((rc)!=MPI_SUCCESS) verbose_abort(rc); } while (0)
46 int Type_contiguous_x(MPI_Count count, MPI_Datatype oldtype, MPI_Datatype * newtype);
48 #define BIGMPI_MAX INT_MAX
53 * int Type_contiguous_x(MPI_Count count,
54 * MPI_Datatype oldtype,
55 * MPI_Datatype * newtype)
59 * count replication count (nonnegative integer)
60 * oldtype old datatype (handle)
64 * newtype new datatype (handle)
67 int Type_contiguous_x(MPI_Count count, MPI_Datatype oldtype, MPI_Datatype * newtype)
69 MPI_Count c = count / BIGMPI_MAX;
70 MPI_Count r = count % BIGMPI_MAX;
74 MPI_Datatype remainder;
77 MPI_ASSERT(MPI_Type_contiguous(BIGMPI_MAX, oldtype, &chunk));
78 MPI_ASSERT(MPI_Type_contiguous(c, chunk, &chunks));
79 MPI_ASSERT(MPI_Type_contiguous(r, oldtype, &remainder));
80 MPI_ASSERT(MPI_Type_size(oldtype, &typesize));
83 MPI_Aint remdisp = (MPI_Aint) c * BIGMPI_MAX * typesize; /* must explicit-cast to avoid overflow */
84 int array_of_blocklengths[2] = { 1, 1 };
85 MPI_Aint array_of_displacements[2] = { 0, remdisp };
86 MPI_Datatype array_of_types[2] = { chunks, remainder };
88 MPI_ASSERT(MPI_Type_create_struct
89 (2, array_of_blocklengths, array_of_displacements, array_of_types, newtype));
90 MPI_ASSERT(MPI_Type_commit(newtype));
93 MPI_ASSERT(MPI_Type_free(&chunk));
94 MPI_ASSERT(MPI_Type_free(&chunks));
95 MPI_ASSERT(MPI_Type_free(&remainder));
101 int main(int argc, char *argv[])
108 int logn = (argc > 1) ? atoi(argv[1]) : 32;
109 size_t count = (size_t) 1 << logn; /* explicit cast required */
111 MPI_Datatype bigtype;
113 MPI_Request requests[2];
114 MPI_Status statuses[2];
120 MPI_ASSERT(MPI_Init_thread(&argc, &argv, MPI_THREAD_SINGLE, &provided));
122 MPI_ASSERT(MPI_Comm_rank(MPI_COMM_WORLD, &rank));
123 MPI_ASSERT(MPI_Comm_size(MPI_COMM_WORLD, &size));
125 MPI_ASSERT(Type_contiguous_x((MPI_Count) count, MPI_CHAR, &bigtype));
126 MPI_ASSERT(MPI_Type_commit(&bigtype));
128 if (rank == (size - 1)) {
129 rbuf = malloc(count * sizeof(char));
130 assert(rbuf != NULL);
131 for (i = 0; i < count; i++)
134 MPI_ASSERT(MPI_Irecv(rbuf, 1, bigtype, 0, 0, MPI_COMM_WORLD, &(requests[1])));
137 sbuf = malloc(count * sizeof(char));
138 assert(sbuf != NULL);
139 for (i = 0; i < count; i++)
142 MPI_ASSERT(MPI_Isend(sbuf, 1, bigtype, size - 1, 0, MPI_COMM_WORLD, &(requests[0])));
146 MPI_ASSERT(MPI_Waitall(2, requests, statuses));
147 MPI_ASSERT(MPI_Get_elements_x(&(statuses[1]), MPI_CHAR, &ocount));
150 if (rank == (size - 1)) {
151 MPI_ASSERT(MPI_Wait(&(requests[1]), &(statuses[1])));
152 MPI_ASSERT(MPI_Get_elements_x(&(statuses[1]), MPI_CHAR, &ocount));
154 else if (rank == 0) {
155 MPI_ASSERT(MPI_Wait(&(requests[0]), &(statuses[0])));
156 /* No valid fields in status from a send request (MPI-3 p53,
161 /* correctness check */
162 if (rank == (size - 1)) {
163 MPI_Count j, errors = 0;
164 for (j = 0; j < count; j++)
165 errors += (rbuf[j] != 'z');
166 if (count != ocount) ++errors;
168 printf(" No Errors\n");
171 printf("errors = %lld \n", errors);
180 MPI_ASSERT(MPI_Type_free(&bigtype));
182 MPI_ASSERT(MPI_Finalize());