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)
22 /* We do not check error codes here
23 * because if MPI is in a really sorry state,
24 * all of them might fail. */
27 MPI_Comm_rank(MPI_COMM_WORLD, &rank);
29 char errorstring[MPI_MAX_ERROR_STRING];
30 memset(errorstring, 0, MPI_MAX_ERROR_STRING); /* optional */
33 MPI_Error_class(errorcode, &errorclass);
36 MPI_Error_string(errorcode, errorstring, &resultlen);
38 fprintf(stderr, "%d: MPI failed (%d: %s) \n", rank, errorclass, errorstring);
39 fflush(stderr); /* almost certainly redundant with the following... */
41 MPI_Abort(MPI_COMM_WORLD, errorclass);
45 #define MPI_ASSERT(rc) \
46 do { if ((rc)!=MPI_SUCCESS) verbose_abort(rc); } while (0)
48 int Type_contiguous_x(MPI_Count count, MPI_Datatype oldtype,
49 MPI_Datatype * newtype);
51 #define BIGMPI_MAX INT_MAX
56 * int Type_contiguous_x(MPI_Count count,
57 * MPI_Datatype oldtype,
58 * MPI_Datatype * newtype)
62 * count replication count (nonnegative integer)
63 * oldtype old datatype (handle)
67 * newtype new datatype (handle)
70 int Type_contiguous_x(MPI_Count count, MPI_Datatype oldtype, MPI_Datatype * newtype)
72 MPI_Count c = count/BIGMPI_MAX;
73 MPI_Count r = count%BIGMPI_MAX;
76 MPI_ASSERT(MPI_Type_contiguous(BIGMPI_MAX, oldtype, &chunk));
79 MPI_ASSERT(MPI_Type_contiguous(c, chunk, &chunks));
81 MPI_Datatype remainder;
82 MPI_ASSERT(MPI_Type_contiguous(r, oldtype, &remainder));
85 MPI_ASSERT(MPI_Type_size(oldtype, &typesize));
87 MPI_Aint remdisp = (MPI_Aint)c*BIGMPI_MAX*typesize; /* must explicit-cast to avoid overflow */
88 int array_of_blocklengths[2] = {1,1};
89 MPI_Aint array_of_displacements[2] = {0,remdisp};
90 MPI_Datatype array_of_types[2] = {chunks,remainder};
92 MPI_ASSERT(MPI_Type_create_struct(2, array_of_blocklengths, array_of_displacements, array_of_types, newtype));
93 MPI_ASSERT(MPI_Type_commit(newtype));
95 MPI_ASSERT(MPI_Type_free(&chunk));
96 MPI_ASSERT(MPI_Type_free(&chunks));
97 MPI_ASSERT(MPI_Type_free(&remainder));
103 int main(int argc, char * argv[])
108 MPI_ASSERT(MPI_Init_thread(&argc, &argv, MPI_THREAD_SINGLE, &provided));
111 MPI_ASSERT(MPI_Comm_rank(MPI_COMM_WORLD, &rank));
112 MPI_ASSERT(MPI_Comm_size(MPI_COMM_WORLD, &size));
114 int logn = (argc>1) ? atoi(argv[1]) : 32;
115 size_t count = (size_t)1<<logn; /* explicit cast required */
117 MPI_Datatype bigtype;
118 MPI_ASSERT(Type_contiguous_x( (MPI_Count)count, MPI_CHAR, &bigtype));
119 MPI_ASSERT(MPI_Type_commit(&bigtype));
121 MPI_Request requests[2];
122 MPI_Status statuses[2];
127 if (rank==(size-1)) {
128 rbuf = malloc( count * sizeof(char)); assert(rbuf!=NULL);
129 for (i=0; i<count; i++)
132 MPI_ASSERT(MPI_Irecv(rbuf, 1, bigtype, 0, 0, MPI_COMM_WORLD, &(requests[1]) ));
135 sbuf = malloc( count * sizeof(char)); assert(sbuf!=NULL);
136 for (i=0; i<count; i++)
139 MPI_ASSERT(MPI_Isend(sbuf, 1, bigtype, size-1, 0, MPI_COMM_WORLD, &(requests[0]) ));
145 MPI_ASSERT(MPI_Waitall(2, requests, statuses));
146 MPI_ASSERT(MPI_Get_elements_x( &(statuses[1]), MPI_CHAR, &(ocount[1])));
149 if (rank==(size-1)) {
150 MPI_ASSERT(MPI_Wait( &(requests[1]), &(statuses[1]) ));
151 MPI_ASSERT(MPI_Get_elements_x( &(statuses[1]), MPI_CHAR, &(ocount[1]) ));
152 } else if (rank==0) {
153 MPI_ASSERT(MPI_Wait( &(requests[0]), &(statuses[0]) ));
154 /* No valid fields in status from a send request (MPI-3 p53,
159 /* correctness check */
160 if (rank==(size-1)) {
161 MPI_Count errors = 0;
162 for (j=0; j<count; j++)
163 errors += ( rbuf[j] != 'z' );
165 printf(" No Errors\n");
167 printf("errors = %lld \n", errors);
171 if (rbuf) free(rbuf);
172 if (sbuf) free(sbuf);
174 MPI_ASSERT(MPI_Type_free(&bigtype));
176 MPI_ASSERT(MPI_Finalize());