/* #define VERBOSE 1 */
int main(int argc, char *argv[])
{
int i, rank;
int rc, maxcomm;
int errs = 0;
MPI_Comm comm[MAX_COMMS];
MTest_Init(&argc, &argv);
MPI_Comm_rank(MPI_COMM_WORLD, &rank);
MPI_Errhandler_set(MPI_COMM_WORLD, MPI_ERRORS_RETURN);
maxcomm = -1;
for (i = 0; i < MAX_COMMS; i++) {
#ifdef VERBOSE
if (rank == 0) {
if (i % 20 == 0) {
fprintf(stderr, "\n %d: ", i);
fflush(stdout);
}
else {
fprintf(stderr, ".");
fflush(stdout);
}
}
#endif
rc = MPI_Comm_split(MPI_COMM_WORLD, 1, rank, &comm[i]);
if (rc != MPI_SUCCESS) {
break;
}
maxcomm = i;
}
for (i = 0; i <= maxcomm; i++) {
MPI_Comm_free(&comm[i]);
}
/* If we complete, there are no errors */
MTest_Finalize(errs);
MPI_Finalize();
return 0;
}
int main(int argc, char *argv[])
{
int size, rank;
MPI_Group world_group;
MPI_Comm group_comm, idup_comm;
MPI_Request req;
MTest_Init(&argc, &argv);
MPI_Comm_size(MPI_COMM_WORLD, &size);
MPI_Comm_rank(MPI_COMM_WORLD, &rank);
if (size % 2) {
fprintf(stderr, "this program requires even number of processes\n");
MPI_Abort(MPI_COMM_WORLD, 1);
}
/* Create some groups */
MPI_Comm_group(MPI_COMM_WORLD, &world_group);
if (rank % 2 == 0) {
MPI_Comm_create_group(MPI_COMM_WORLD, world_group, 0, &group_comm);
MPI_Comm_idup(MPI_COMM_WORLD, &idup_comm, &req);
} else {
MPI_Comm_idup(MPI_COMM_WORLD, &idup_comm, &req);
MPI_Comm_create_group(MPI_COMM_WORLD, world_group, 0, &group_comm);
}
MPI_Wait(&req, MPI_STATUSES_IGNORE);
/*Test new comm with a barrier */
MPI_Barrier(idup_comm);
MPI_Barrier(group_comm);
MPI_Group_free(&world_group);
MPI_Comm_free(&idup_comm);
MPI_Comm_free(&group_comm);
MTest_Finalize(0);
return 0;
}
int main(int argc, char *argv[])
{
int rank, size;
MPI_Datatype type;
int errclass, errs = 0, mpi_errno;
MTest_Init(&argc, &argv);
MPI_Comm_size(MPI_COMM_WORLD, &size);
MPI_Comm_rank(MPI_COMM_WORLD, &rank);
MPI_Errhandler_set(MPI_COMM_WORLD, MPI_ERRORS_RETURN);
/* Checking type_extent for NULL variable */
type = MPI_INT;
mpi_errno = MPI_Type_extent(type, NULL);
MPI_Error_class(mpi_errno, &errclass);
if (errclass != MPI_ERR_ARG)
++errs;
MTest_Finalize(errs);
return 0;
}
int main(int argc, char *argv[])
{
int errors = 0;
int elems = 20;
int rank, nproc, dest, i;
float *in_buf, *out_buf;
MPI_Comm comm;
MPI_Request *reqs;
MTest_Init(&argc, &argv);
comm = MPI_COMM_WORLD;
MPI_Comm_rank(comm, &rank);
MPI_Comm_size(comm, &nproc);
reqs = (MPI_Request *) malloc(2 * nproc * sizeof(MPI_Request));
in_buf = (float *) malloc(elems * nproc * sizeof(float));
out_buf = (float *) malloc(elems * nproc * sizeof(float));
MTEST_VG_MEM_INIT(out_buf, elems * nproc * sizeof(float));
for (i = 0; i < nproc; i++) {
MPI_Irecv(&in_buf[elems * i], elems, MPI_FLOAT, i, 0, comm, &reqs[i]);
}
for (i = 0; i < nproc; i++) {
MPI_Isend(&out_buf[elems * i], elems, MPI_FLOAT, i, 0, comm, &reqs[i + nproc]);
}
MPI_Waitall(nproc * 2, reqs, MPI_STATUSES_IGNORE);
free(reqs);
free(in_buf);
free(out_buf);
MTest_Finalize(errors);
MPI_Finalize();
return 0;
}
int main( int argc, char * argv[] )
{
int rank;
int sendMsg = 123;
int recvMsg = 0;
int flag = 0;
int count;
MPI_Status status;
MPI_Request request;
int errs = 0;
MTest_Init( 0, 0 );
MPI_Comm_rank(MPI_COMM_WORLD, &rank);
if(rank == 0)
{
MPI_Isend( &sendMsg, 1, MPI_INT, 0, 0, MPI_COMM_WORLD, &request );
while(!flag)
{
MPI_Iprobe( 0, 0, MPI_COMM_WORLD, &flag, &status );
}
MPI_Get_count( &status, MPI_INT, &count );
if(count != 1)
{
errs++;
}
MPI_Recv( &recvMsg, 1, MPI_INT, 0, 0, MPI_COMM_WORLD, &status );
if(recvMsg != 123)
{
errs++;
}
MPI_Wait( &request, &status );
}
MTest_Finalize( errs );
MPI_Finalize();
return 0;
}
int main (int argc, char **argv)
{
MPI_Comm duped;
int keyval = MPI_KEYVAL_INVALID;
int keyval_copy = MPI_KEYVAL_INVALID;
int errs=0;
MTest_Init( &argc, &argv );
MPI_Comm_dup(MPI_COMM_SELF, &duped);
MPI_Keyval_create(MPI_NULL_COPY_FN, delete_fn, &keyval, NULL);
keyval_copy = keyval;
MPI_Attr_put(MPI_COMM_SELF, keyval, NULL);
MPI_Attr_put(duped, keyval, NULL);
MPI_Comm_free(&duped); /* first MPI_Keyval_free */
MPI_Keyval_free(&keyval); /* second MPI_Keyval_free */
MPI_Keyval_free(&keyval_copy); /* third MPI_Keyval_free */
MTest_Finalize( errs );
MPI_Finalize(); /* fourth MPI_Keyval_free */
return 0;
}
int main(int argc, char **argv)
{
MPI_Group basegroup;
MPI_Group g1;
MPI_Comm comm, newcomm;
int errs = 0, mpi_errno, errclass, rank, size;
int range[1][3];
int worldrank;
MTest_Init(&argc, &argv);
MPI_Comm_rank(MPI_COMM_WORLD, &worldrank);
comm = MPI_COMM_WORLD;
MPI_Comm_group(comm, &basegroup);
MPI_Comm_rank(comm, &rank);
MPI_Comm_size(comm, &size);
MPI_Errhandler_set(MPI_COMM_WORLD, MPI_ERRORS_RETURN);
MPI_Comm_split(comm, 0, size - rank, &newcomm);
MPI_Comm_group(newcomm, &g1);
/* Checking group_range_excl for NULL variable */
range[0][0] = 1;
range[0][1] = size-1;
range[0][2] = 1;
mpi_errno = MPI_Group_range_incl(basegroup, 1, range, NULL);
MPI_Error_class(mpi_errno, &errclass);
if (errclass != MPI_ERR_ARG)
++errs;
MPI_Comm_free(&comm);
MPI_Comm_free(&newcomm);
MPI_Group_free(&basegroup);
MPI_Group_free(&g1);
MTest_Finalize(errs);
MPI_Finalize();
return 0;
}
int main(int argc, char **argv)
{
MPI_Group basegroup;
MPI_Group g1, g2;
MPI_Comm comm, newcomm, dupcomm;
int errs = 0, mpi_errno, rank, size;
int errclass, worldrank;
MTest_Init( &argc, &argv );
MPI_Comm_rank( MPI_COMM_WORLD, &worldrank );
comm = MPI_COMM_WORLD;
MPI_Comm_group( comm, &basegroup );
MPI_Comm_rank( comm, &rank );
MPI_Comm_size( comm, &size );
MPI_Errhandler_set(MPI_COMM_WORLD, MPI_ERRORS_RETURN);
MPI_Comm_split( comm, 0, size - rank, &newcomm );
MPI_Comm_group( newcomm, &g1);
MPI_Comm_dup( comm, &dupcomm );
MPI_Comm_group( dupcomm, &g2 );
/* checking group_union for NULL variable */
mpi_errno = MPI_Group_union( g1, g2, NULL );
MPI_Error_class(mpi_errno, &errclass);
if (errclass != MPI_ERR_ARG)
++errs;
MPI_Comm_free(&comm);
MPI_Comm_free(&newcomm);
MPI_Comm_free(&dupcomm);
MPI_Group_free(&basegroup);
MPI_Group_free(&g1);
MPI_Group_free(&g2);
MTest_Finalize(errs);
MPI_Finalize();
return 0;
}
int main( int argc, char *argv[] )
{
MPI_Status status;
int err, errs = 0, len;
char msg[MPI_MAX_ERROR_STRING];
MTest_Init( &argc, &argv );
MPI_Errhandler_set( MPI_COMM_WORLD, MPI_ERRORS_RETURN );
err = MPI_Probe( -80, 1, MPI_COMM_WORLD, &status );
if (!err) {
errs++;
printf( "Did not detect an erroneous rank in MPI_Probe\n" );
}
else {
/* Check that we can get a message for this error */
/* (This works if it does not SEGV or hang) */
MPI_Error_string( err, msg, &len );
}
MTest_Finalize( errs );
MPI_Finalize( );
return 0;
}
int main(int argc, char *argv[])
{
int rank, nprocs, i, A[SIZE], B[SIZE];
MPI_Comm CommDeuce;
MPI_Win win;
int errs = 0;
MTest_Init(&argc,&argv);
MPI_Comm_size(MPI_COMM_WORLD,&nprocs);
MPI_Comm_rank(MPI_COMM_WORLD, &rank);
if (nprocs < 2) {
printf("Run this program with 2 or more processes\n");
MPI_Abort(MPI_COMM_WORLD, 1);
}
MPI_Comm_split(MPI_COMM_WORLD, (rank < 2), rank, &CommDeuce);
if (rank < 2) {
if (rank == 0) {
for (i=0; i<SIZE; i++)
B[i] = 500 + i;
MPI_Win_create(B, SIZE*sizeof(int), sizeof(int), MPI_INFO_NULL, CommDeuce, &win);
MPI_Win_fence(0, win);
for (i=0; i<SIZE; i++) {
A[i] = i+100;
MPI_Get(&A[i], 1, MPI_INT, 1, i, 1, MPI_INT, win);
}
MPI_Win_fence(0, win);
for (i=0; i<SIZE; i++)
if (A[i] != 1000 + i) {
SQUELCH( printf("Rank 0: A[%d] is %d, should be %d\n", i, A[i], 1000+i); );
errs++;
}
}
int main( int argc, char *argv[] )
{
int errs = 0;
int majversion, subversion;
MTest_Init( &argc, &argv );
MPI_Get_version( &majversion, &subversion );
if (majversion != MPI_VERSION) {
errs++;
printf( "Major version is %d but is %d in the mpi.h file\n",
majversion, MPI_VERSION );
}
if (subversion != MPI_SUBVERSION) {
errs++;
printf( "Minor version is %d but is %d in the mpi.h file\n",
subversion, MPI_SUBVERSION );
}
MTest_Finalize( errs );
MPI_Finalize();
return 0;
}
int main(int argc, char **argv)
{
int rank, size;
int data;
int errors = 0;
int result = -100;
MPI_Op op;
MTest_Init(&argc, &argv);
MPI_Comm_rank(MPI_COMM_WORLD, &rank);
MPI_Comm_size(MPI_COMM_WORLD, &size);
data = rank;
MPI_Op_create((MPI_User_function *) assoc, 0, &op);
MPI_Reduce(&data, &result, 1, MPI_INT, op, size - 1, MPI_COMM_WORLD);
MPI_Bcast(&result, 1, MPI_INT, size - 1, MPI_COMM_WORLD);
MPI_Op_free(&op);
if (result == BAD_ANSWER)
errors++;
MTest_Finalize(errors);
return MTestReturnValue(errors);
}
int main( int argc, char **argv )
{
MPI_Comm comm;
int *sbuf, *rbuf;
int rank, size;
int *sendcounts, *recvcounts, *rdispls, *sdispls;
int i, j, *p, err;
MPI_Datatype *sendtypes, *recvtypes;
MTest_Init( &argc, &argv );
err = 0;
while (MTestGetIntracommGeneral( &comm, 2, 1 )) {
if (comm == MPI_COMM_NULL) continue;
/* Create the buffer */
MPI_Comm_size( comm, &size );
MPI_Comm_rank( comm, &rank );
sbuf = (int *)malloc( size * size * sizeof(int) );
rbuf = (int *)malloc( size * size * sizeof(int) );
if (!sbuf || !rbuf) {
fprintf( stderr, "Could not allocated buffers!\n" );
MPI_Abort( comm, 1 );
}
/* Load up the buffers */
for (i=0; i<size*size; i++) {
sbuf[i] = i + 100*rank;
rbuf[i] = -i;
}
/* Create and load the arguments to alltoallv */
sendcounts = (int *)malloc( size * sizeof(int) );
recvcounts = (int *)malloc( size * sizeof(int) );
rdispls = (int *)malloc( size * sizeof(int) );
sdispls = (int *)malloc( size * sizeof(int) );
sendtypes = (MPI_Datatype *)malloc( size * sizeof(MPI_Datatype) );
recvtypes = (MPI_Datatype *)malloc( size * sizeof(MPI_Datatype) );
if (!sendcounts || !recvcounts || !rdispls || !sdispls || !sendtypes || !recvtypes) {
fprintf( stderr, "Could not allocate arg items!\n" );
MPI_Abort( comm, 1 );
}
/* Note that process 0 sends no data (sendcounts[0] = 0) */
for (i=0; i<size; i++) {
sendcounts[i] = i;
recvcounts[i] = rank;
rdispls[i] = i * rank * sizeof(int);
sdispls[i] = (((i+1) * (i))/2) * sizeof(int);
sendtypes[i] = recvtypes[i] = MPI_INT;
}
MPI_Alltoallw( sbuf, sendcounts, sdispls, sendtypes,
rbuf, recvcounts, rdispls, recvtypes, comm );
/* Check rbuf */
for (i=0; i<size; i++) {
p = rbuf + rdispls[i]/sizeof(int);
for (j=0; j<rank; j++) {
if (p[j] != i * 100 + (rank*(rank+1))/2 + j) {
fprintf( stderr, "[%d] got %d expected %d for %dth\n",
rank, p[j],(i*(i+1))/2 + j, j );
err++;
}
}
}
free(sendtypes);
free(sdispls);
free(sendcounts);
free(sbuf);
#if MTEST_HAVE_MIN_MPI_VERSION(2,2)
/* check MPI_IN_PLACE, added in MPI-2.2 */
free( rbuf );
rbuf = (int *)malloc( size * (2 * size) * sizeof(int) );
if (!rbuf) {
fprintf( stderr, "Could not reallocate rbuf!\n" );
MPI_Abort( comm, 1 );
}
/* Load up the buffers */
for (i = 0; i < size; i++) {
/* alltoallw displs are in bytes, not in type extents */
rdispls[i] = i * (2 * size) * sizeof(int);
recvtypes[i] = MPI_INT;
recvcounts[i] = i + rank;
}
memset(rbuf, -1, size * (2 * size) * sizeof(int));
for (i=0; i < size; i++) {
p = rbuf + (rdispls[i] / sizeof(int));
for (j = 0; j < recvcounts[i]; ++j) {
p[j] = 100 * rank + 10 * i + j;
}
}
MPI_Alltoallw( MPI_IN_PLACE, NULL, NULL, NULL,
rbuf, recvcounts, rdispls, recvtypes, comm );
/* Check rbuf */
for (i=0; i<size; i++) {
p = rbuf + (rdispls[i] / sizeof(int));
for (j=0; j<recvcounts[i]; j++) {
int expected = 100 * i + 10 * rank + j;
if (p[j] != expected) {
fprintf(stderr, "[%d] got %d expected %d for block=%d, element=%dth\n",
rank, p[j], expected, i, j);
++err;
}
}
}
#endif
free(recvtypes);
free(rdispls);
free(recvcounts);
free(rbuf);
MTestFreeComm( &comm );
}
MTest_Finalize( err );
MPI_Finalize();
return 0;
}
int main(int argc, char *argv[])
{
int errs = 0;
int rank, size, rsize;
int np = 3;
MPI_Comm parentcomm, intercomm;
int verbose = 0;
char *env;
int can_spawn;
env = getenv("MPITEST_VERBOSE");
if (env) {
if (*env != '0')
verbose = 1;
}
MTest_Init(&argc, &argv);
errs += MTestSpawnPossible(&can_spawn);
if (can_spawn) {
MPI_Comm_get_parent(&parentcomm);
if (parentcomm == MPI_COMM_NULL) {
IF_VERBOSE(("spawning %d processes\n", np));
/* Create 3 more processes */
MPI_Comm_spawn((char *) "./disconnect", MPI_ARGV_NULL, np,
MPI_INFO_NULL, 0, MPI_COMM_WORLD, &intercomm, MPI_ERRCODES_IGNORE);
} else {
intercomm = parentcomm;
}
/* We now have a valid intercomm */
MPI_Comm_remote_size(intercomm, &rsize);
MPI_Comm_size(intercomm, &size);
MPI_Comm_rank(intercomm, &rank);
if (parentcomm == MPI_COMM_NULL) {
IF_VERBOSE(("parent rank %d alive.\n", rank));
/* Parent */
if (rsize != np) {
errs++;
printf("Did not create %d processes (got %d)\n", np, rsize);
fflush(stdout);
}
IF_VERBOSE(("disconnecting child communicator\n"));
MPI_Comm_disconnect(&intercomm);
/* Errors cannot be sent back to the parent because there is no
* communicator connected to the children
* for (i=0; i<rsize; i++)
* {
* MPI_Recv(&err, 1, MPI_INT, i, 1, intercomm, MPI_STATUS_IGNORE);
* errs += err;
* }
*/
} else {
IF_VERBOSE(("child rank %d alive.\n", rank));
/* Child */
if (size != np) {
errs++;
printf("(Child) Did not create %d processes (got %d)\n", np, size);
fflush(stdout);
}
IF_VERBOSE(("disconnecting communicator\n"));
MPI_Comm_disconnect(&intercomm);
/* Send the errs back to the master process */
/* Errors cannot be sent back to the parent because there is no
* communicator connected to the parent */
/*MPI_Ssend(&errs, 1, MPI_INT, 0, 1, intercomm); */
}
/* Note that the MTest_Finalize get errs only over COMM_WORLD */
/* Note also that both the parent and child will generate "No Errors"
* if both call MTest_Finalize */
if (parentcomm == MPI_COMM_NULL) {
MTest_Finalize(errs);
} else {
MPI_Finalize();
}
} else {
MTest_Finalize(errs);
}
IF_VERBOSE(("calling finalize\n"));
return MTestReturnValue(errs);
}
/*
* This test looks at the handling of logical and for types that are not
* integers or are not required integers (e.g., long long). MPICH2 allows
* these as well. A strict MPI test should not include this test.
*/
int main( int argc, char *argv[] )
{
int errs = 0;
int rank, size, maxsize, result[6] = { 1, 1, 2, 6, 24, 120 };
MPI_Comm comm;
char cinbuf[3], coutbuf[3];
signed char scinbuf[3], scoutbuf[3];
unsigned char ucinbuf[3], ucoutbuf[3];
d_complex dinbuf[3], doutbuf[3];
MTest_Init( &argc, &argv );
comm = MPI_COMM_WORLD;
MPI_Comm_rank( comm, &rank );
MPI_Comm_size( comm, &size );
if (size > 5) maxsize = 5;
else maxsize = size;
/* General forumula: If we multiple the values from 1 to n, the
product is n!. This grows very fast, so we'll only use the first
five (1! = 1, 2! = 2, 3! = 6, 4! = 24, 5! = 120), with n!
stored in the array result[n] */
#ifndef USE_STRICT_MPI
/* char */
MTestPrintfMsg( 10, "Reduce of MPI_CHAR\n" );
cinbuf[0] = (rank < maxsize && rank > 0) ? rank : 1;
cinbuf[1] = 0;
cinbuf[2] = (rank > 1);
coutbuf[0] = 0;
coutbuf[1] = 1;
coutbuf[2] = 1;
MPI_Reduce( cinbuf, coutbuf, 3, MPI_CHAR, MPI_PROD, 0, comm );
if (rank == 0) {
if (coutbuf[0] != (char)result[maxsize-1]) {
errs++;
fprintf( stderr, "char PROD(rank) test failed (%d!=%d)\n",
(int)coutbuf[0], (int)result[maxsize]);
}
if (coutbuf[1]) {
errs++;
fprintf( stderr, "char PROD(0) test failed\n" );
}
if (size > 1 && coutbuf[2]) {
errs++;
fprintf( stderr, "char PROD(>) test failed\n" );
}
}
#endif /* USE_STRICT_MPI */
/* signed char */
MTestPrintfMsg( 10, "Reduce of MPI_SIGNED_CHAR\n" );
scinbuf[0] = (rank < maxsize && rank > 0) ? rank : 1;
scinbuf[1] = 0;
scinbuf[2] = (rank > 1);
scoutbuf[0] = 0;
scoutbuf[1] = 1;
scoutbuf[2] = 1;
MPI_Reduce( scinbuf, scoutbuf, 3, MPI_SIGNED_CHAR, MPI_PROD, 0, comm );
if (rank == 0) {
if (scoutbuf[0] != (signed char)result[maxsize-1]) {
errs++;
fprintf( stderr, "signed char PROD(rank) test failed (%d!=%d)\n",
(int)scoutbuf[0], (int)result[maxsize]);
}
if (scoutbuf[1]) {
errs++;
fprintf( stderr, "signed char PROD(0) test failed\n" );
}
if (size > 1 && scoutbuf[2]) {
errs++;
fprintf( stderr, "signed char PROD(>) test failed\n" );
}
}
/* unsigned char */
MTestPrintfMsg( 10, "Reduce of MPI_UNSIGNED_CHAR\n" );
ucinbuf[0] = (rank < maxsize && rank > 0) ? rank : 1;
ucinbuf[1] = 0;
ucinbuf[2] = (rank > 0);
ucoutbuf[0] = 0;
ucoutbuf[1] = 1;
ucoutbuf[2] = 1;
MPI_Reduce( ucinbuf, ucoutbuf, 3, MPI_UNSIGNED_CHAR, MPI_PROD, 0, comm );
if (rank == 0) {
if (ucoutbuf[0] != (unsigned char)result[maxsize-1]) {
errs++;
fprintf( stderr, "unsigned char PROD(rank) test failed\n" );
}
if (ucoutbuf[1]) {
errs++;
fprintf( stderr, "unsigned char PROD(0) test failed\n" );
}
if (size > 1 && ucoutbuf[2]) {
errs++;
fprintf( stderr, "unsigned char PROD(>) test failed\n" );
}
}
#ifndef USE_STRICT_MPI
/* For some reason, complex is not allowed for sum and prod */
if (MPI_DOUBLE_COMPLEX != MPI_DATATYPE_NULL) {
int dc;
#ifdef HAVE_LONG_DOUBLE
ld_complex ldinbuf[3], ldoutbuf[3];
#endif
/* Must determine which C type matches this Fortran type */
MPI_Type_size( MPI_DOUBLE_COMPLEX, &dc );
if (dc == sizeof(d_complex)) {
/* double complex; may be null if we do not have Fortran support */
dinbuf[0].r = (rank < maxsize && rank > 0) ? rank : 1;
dinbuf[1].r = 0;
dinbuf[2].r = (rank > 0);
dinbuf[0].i = 0;
dinbuf[1].i = 1;
dinbuf[2].i = -(rank > 0);
doutbuf[0].r = 0;
doutbuf[1].r = 1;
doutbuf[2].r = 1;
doutbuf[0].i = 0;
doutbuf[1].i = 1;
doutbuf[2].i = 1;
MPI_Reduce( dinbuf, doutbuf, 3, MPI_DOUBLE_COMPLEX, MPI_PROD, 0, comm );
if (rank == 0) {
double imag, real;
if (doutbuf[0].r != (double)result[maxsize-1] || doutbuf[0].i != 0) {
errs++;
fprintf( stderr, "double complex PROD(rank) test failed\n" );
}
/* Multiplying the imaginary part depends on size mod 4 */
imag = 1.0; real = 0.0; /* Make compiler happy */
switch (size % 4) {
case 1: imag = 1.0; real = 0.0; break;
case 2: imag = 0.0; real = -1.0; break;
case 3: imag =-1.0; real = 0.0; break;
case 0: imag = 0.0; real = 1.0; break;
}
if (doutbuf[1].r != real || doutbuf[1].i != imag) {
errs++;
fprintf( stderr, "double complex PROD(i) test failed (%f,%f)!=(%f,%f)\n",
doutbuf[1].r,doutbuf[1].i,real,imag);
}
if (doutbuf[2].r != 0 || doutbuf[2].i != 0) {
errs++;
fprintf( stderr, "double complex PROD(>) test failed\n" );
}
}
}
#ifdef HAVE_LONG_DOUBLE
else if (dc == sizeof(ld_complex)) {
/* double complex; may be null if we do not have Fortran support */
ldinbuf[0].r = (rank < maxsize && rank > 0) ? rank : 1;
ldinbuf[1].r = 0;
ldinbuf[2].r = (rank > 0);
ldinbuf[0].i = 0;
ldinbuf[1].i = 1;
ldinbuf[2].i = -(rank > 0);
ldoutbuf[0].r = 0;
ldoutbuf[1].r = 1;
ldoutbuf[2].r = 1;
ldoutbuf[0].i = 0;
ldoutbuf[1].i = 1;
ldoutbuf[2].i = 1;
MPI_Reduce( ldinbuf, ldoutbuf, 3, MPI_DOUBLE_COMPLEX, MPI_PROD, 0, comm );
if (rank == 0) {
long double imag, real;
if (ldoutbuf[0].r != (double)result[maxsize-1] || ldoutbuf[0].i != 0) {
errs++;
fprintf( stderr, "double complex PROD(rank) test failed\n" );
}
/* Multiplying the imaginary part depends on size mod 4 */
imag = 1.0; real = 0.0; /* Make compiler happy */
switch (size % 4) {
case 1: imag = 1.0; real = 0.0; break;
case 2: imag = 0.0; real = -1.0; break;
case 3: imag =-1.0; real = 0.0; break;
case 0: imag = 0.0; real = 1.0; break;
}
if (ldoutbuf[1].r != real || ldoutbuf[1].i != imag) {
errs++;
fprintf( stderr, "double complex PROD(i) test failed (%Lf,%Lf)!=(%Lf,%Lf)\n",
ldoutbuf[1].r,ldoutbuf[1].i,real,imag);
}
if (ldoutbuf[2].r != 0 || ldoutbuf[2].i != 0) {
errs++;
fprintf( stderr, "double complex PROD(>) test failed\n" );
}
}
}
#endif /* HAVE_LONG_DOUBLE */
}
#endif /* USE_STRICT_MPI */
#ifdef HAVE_LONG_DOUBLE
{ long double ldinbuf[3], ldoutbuf[3];
/* long double */
ldinbuf[0] = (rank < maxsize && rank > 0) ? rank : 1;
ldinbuf[1] = 0;
ldinbuf[2] = (rank > 0);
ldoutbuf[0] = 0;
ldoutbuf[1] = 1;
ldoutbuf[2] = 1;
if (MPI_LONG_DOUBLE != MPI_DATATYPE_NULL) {
MPI_Reduce( ldinbuf, ldoutbuf, 3, MPI_LONG_DOUBLE, MPI_PROD, 0, comm );
if (rank == 0) {
if (ldoutbuf[0] != (long double)result[maxsize-1]) {
errs++;
fprintf( stderr, "long double PROD(rank) test failed\n" );
}
if (ldoutbuf[1]) {
errs++;
fprintf( stderr, "long double PROD(0) test failed\n" );
}
if (size > 1 && ldoutbuf[2] != 0) {
errs++;
fprintf( stderr, "long double PROD(>) test failed\n" );
}
}
}
}
#endif /* HAVE_LONG_DOUBLE */
#ifdef HAVE_LONG_LONG
{
long long llinbuf[3], lloutbuf[3];
/* long long */
llinbuf[0] = (rank < maxsize && rank > 0) ? rank : 1;
llinbuf[1] = 0;
llinbuf[2] = (rank > 0);
lloutbuf[0] = 0;
lloutbuf[1] = 1;
lloutbuf[2] = 1;
if (MPI_LONG_LONG != MPI_DATATYPE_NULL) {
MPI_Reduce( llinbuf, lloutbuf, 3, MPI_LONG_LONG, MPI_PROD, 0, comm );
if (rank == 0) {
if (lloutbuf[0] != (long long)result[maxsize-1]) {
errs++;
fprintf( stderr, "long long PROD(rank) test failed\n" );
}
if (lloutbuf[1]) {
errs++;
fprintf( stderr, "long long PROD(0) test failed\n" );
}
if (size > 1 && lloutbuf[2]) {
errs++;
fprintf( stderr, "long long PROD(>) test failed\n" );
}
}
}
}
#endif /* HAVE_LONG_LONG */
MTest_Finalize( errs );
MPI_Finalize();
return 0;
}
/*
This program is derived from one in the MPICH-1 test suite
This version sends and receives EVERYTHING from MPI_BOTTOM, by putting
the data into a structure.
*/
int main( int argc, char **argv )
{
MPI_Datatype *types;
void **inbufs, **outbufs;
int *counts, *bytesize, ntype;
MPI_Comm comm;
int ncomm = 20, rank, np, partner, tag, count;
int j, k, err, toterr, world_rank, errloc;
MPI_Status status;
char *obuf;
MPI_Datatype offsettype;
int blen;
MPI_Aint displ, extent, natural_extent;
char myname[MPI_MAX_OBJECT_NAME];
int mynamelen;
MTest_Init( &argc, &argv );
MTestDatatype2Allocate( &types, &inbufs, &outbufs, &counts, &bytesize,
&ntype );
MTestDatatype2Generate( types, inbufs, outbufs, counts, bytesize, &ntype );
MPI_Comm_rank( MPI_COMM_WORLD, &world_rank );
/* Test over a wide range of datatypes and communicators */
err = 0;
tag = 0;
while (MTestGetIntracomm( &comm, 2 )) {
if (comm == MPI_COMM_NULL) continue;
MPI_Comm_rank( comm, &rank );
MPI_Comm_size( comm, &np );
if (np < 2) continue;
tag++;
for (j=0; j<ntype; j++) {
MPI_Type_get_name( types[j], myname, &mynamelen );
if (world_rank == 0)
MTestPrintfMsg( 10, "Testing type %s\n", myname );
if (rank == 0) {
MPI_Get_address( inbufs[j], &displ );
blen = 1;
MPI_Type_create_struct( 1, &blen, &displ, types + j,
&offsettype );
MPI_Type_commit( &offsettype );
/* Warning: if the type has an explicit MPI_UB, then using a
simple shift of the offset won't work. For now, we skip
types whose extents are negative; the correct solution is
to add, where required, an explicit MPI_UB */
MPI_Type_extent( offsettype, &extent );
if (extent < 0) {
if (world_rank == 0)
MTestPrintfMsg( 10,
"... skipping (appears to have explicit MPI_UB\n" );
MPI_Type_free( &offsettype );
continue;
}
MPI_Type_extent( types[j], &natural_extent );
if (natural_extent != extent) {
MPI_Type_free( &offsettype );
continue;
}
partner = np - 1;
MPI_Send( MPI_BOTTOM, counts[j], offsettype, partner, tag,
comm );
MPI_Type_free( &offsettype );
}
else if (rank == np-1) {
partner = 0;
obuf = outbufs[j];
for (k=0; k<bytesize[j]; k++)
obuf[k] = 0;
MPI_Get_address( outbufs[j], &displ );
blen = 1;
MPI_Type_create_struct( 1, &blen, &displ, types + j,
&offsettype );
MPI_Type_commit( &offsettype );
/* Warning: if the type has an explicit MPI_UB, then using a
simple shift of the offset won't work. For now, we skip
types whose extents are negative; the correct solution is
to add, where required, an explicit MPI_UB */
MPI_Type_extent( offsettype, &extent );
if (extent < 0) {
MPI_Type_free( &offsettype );
continue;
}
MPI_Type_extent( types[j], &natural_extent );
if (natural_extent != extent) {
MPI_Type_free( &offsettype );
continue;
}
MPI_Recv( MPI_BOTTOM, counts[j], offsettype,
partner, tag, comm, &status );
/* Test for correctness */
MPI_Get_count( &status, types[j], &count );
if (count != counts[j]) {
fprintf( stderr,
"Error in counts (got %d expected %d) with type %s\n",
count, counts[j], myname );
err++;
}
if (status.MPI_SOURCE != partner) {
fprintf( stderr,
"Error in source (got %d expected %d) with type %s\n",
status.MPI_SOURCE, partner, myname );
err++;
}
if ((errloc = MTestDatatype2Check( inbufs[j], outbufs[j],
bytesize[j] ))) {
fprintf( stderr,
"Error in data with type %s (type %d on %d) at byte %d\n",
myname, j, world_rank, errloc - 1 );
if (err < 10) {
/* Give details on only the first 10 errors */
unsigned char *in_p = (unsigned char *)inbufs[j],
*out_p = (unsigned char *)outbufs[j];
int jj;
jj = errloc - 1;
jj &= 0xfffffffc; /* lop off a few bits */
in_p += jj;
out_p += jj;
fprintf( stderr, "%02x%02x%02x%02x should be %02x%02x%02x%02x\n",
out_p[0], out_p[1], out_p[2], out_p[3],
in_p[0], in_p[1], in_p[2], in_p[3] );
}
err++;
}
MPI_Type_free( &offsettype );
}
}
MTestFreeComm( &comm );
}
MTestDatatype2Free( types, inbufs, outbufs, counts, bytesize, ntype );
MTest_Finalize( err );
MPI_Finalize();
return MTestReturnValue( err );
}
int main(int argc, char **argv)
{
int *buf, i, rank, nints, len;
char *filename, *tmp;
int errs=0;
MPI_File fh;
MPI_Status statuses[NUMOPS];
MPI_Request requests[NUMOPS];
MTest_Init(&argc,&argv);
MPI_Comm_rank(MPI_COMM_WORLD, &rank);
/* process 0 takes the file name as a command-line argument and
broadcasts it to other processes */
if (!rank) {
i = 1;
while ((i < argc) && strcmp("-fname", *argv)) {
i++;
argv++;
}
if (i >= argc) {
/* Use a default filename of testfile */
len = 8;
filename = (char *)malloc(len + 10);
strcpy( filename, "testfile" );
/*
fprintf(stderr, "\n*# Usage: async_any -fname filename\n\n");
MPI_Abort(MPI_COMM_WORLD, 1);
*/
}
else {
argv++;
len = (int)strlen(*argv);
filename = (char *) malloc(len+10);
strcpy(filename, *argv);
}
MPI_Bcast(&len, 1, MPI_INT, 0, MPI_COMM_WORLD);
MPI_Bcast(filename, len+10, MPI_CHAR, 0, MPI_COMM_WORLD);
}
else {
MPI_Bcast(&len, 1, MPI_INT, 0, MPI_COMM_WORLD);
filename = (char *) malloc(len+10);
MPI_Bcast(filename, len+10, MPI_CHAR, 0, MPI_COMM_WORLD);
}
buf = (int *) malloc(SIZE);
nints = SIZE/sizeof(int);
for (i=0; i<nints; i++) buf[i] = rank*100000 + i;
/* each process opens a separate file called filename.'myrank' */
tmp = (char *) malloc(len+10);
strcpy(tmp, filename);
sprintf(filename, "%s.%d", tmp, rank);
MPI_File_open(MPI_COMM_SELF, filename, MPI_MODE_CREATE | MPI_MODE_RDWR,
MPI_INFO_NULL, &fh);
MPI_File_set_view(fh, 0, MPI_INT, MPI_INT, (char*)"native", MPI_INFO_NULL);
for (i=0; i < NUMOPS; i++) {
MPI_File_iwrite(fh, buf, nints, MPI_INT, &(requests[i]));
}
MPI_Waitall(NUMOPS, requests, statuses);
MPI_File_close(&fh);
/* reopen the file and read the data back */
for (i=0; i<nints; i++) buf[i] = 0;
MPI_File_open(MPI_COMM_SELF, filename, MPI_MODE_CREATE | MPI_MODE_RDWR,
MPI_INFO_NULL, &fh);
MPI_File_set_view(fh, 0, MPI_INT, MPI_INT, (char*)"native", MPI_INFO_NULL);
for (i=0; i < NUMOPS; i++) {
MPI_File_iread(fh, buf, nints, MPI_INT, &(requests[i]));
}
MPI_Waitall(NUMOPS, requests, statuses);
MPI_File_close(&fh);
/* check if the data read is correct */
for (i=0; i<nints; i++) {
if (buf[i] != (rank*100000 + i)) {
errs++;
fprintf(stderr, "Process %d: error, read %d, should be %d\n", rank, buf[i], rank*100000+i);
}
}
free(buf);
free(filename);
free(tmp);
MTest_Finalize(errs);
MPI_Finalize();
return 0;
}
/*
* This test looks at the handling of char and types that are not required
* integers (e.g., long long). MPICH allows
* these as well. A strict MPI test should not include this test.
*/
int main(int argc, char *argv[])
{
int errs = 0;
int rank, size;
MPI_Comm comm;
char cinbuf[3], coutbuf[3];
signed char scinbuf[3], scoutbuf[3];
unsigned char ucinbuf[3], ucoutbuf[3];
MTest_Init(&argc, &argv);
comm = MPI_COMM_WORLD;
MPI_Comm_rank(comm, &rank);
MPI_Comm_size(comm, &size);
#ifndef USE_STRICT_MPI
/* char */
MTestPrintfMsg(10, "Reduce of MPI_CHAR\n");
cinbuf[0] = 1;
cinbuf[1] = 0;
cinbuf[2] = rank;
coutbuf[0] = 0;
coutbuf[1] = 1;
coutbuf[2] = 1;
MPI_Reduce(cinbuf, coutbuf, 3, MPI_CHAR, MPI_MAX, 0, comm);
if (rank == 0) {
if (coutbuf[0] != 1) {
errs++;
fprintf(stderr, "char MAX(1) test failed\n");
}
if (coutbuf[1] != 0) {
errs++;
fprintf(stderr, "char MAX(0) test failed\n");
}
if (size < 128 && coutbuf[2] != size - 1) {
errs++;
fprintf(stderr, "char MAX(>) test failed\n");
}
}
#endif /* USE_STRICT_MPI */
/* signed char */
MTestPrintfMsg(10, "Reduce of MPI_SIGNED_CHAR\n");
scinbuf[0] = 1;
scinbuf[1] = 0;
scinbuf[2] = rank;
scoutbuf[0] = 0;
scoutbuf[1] = 1;
scoutbuf[2] = 1;
MPI_Reduce(scinbuf, scoutbuf, 3, MPI_SIGNED_CHAR, MPI_MAX, 0, comm);
if (rank == 0) {
if (scoutbuf[0] != 1) {
errs++;
fprintf(stderr, "signed char MAX(1) test failed\n");
}
if (scoutbuf[1] != 0) {
errs++;
fprintf(stderr, "signed char MAX(0) test failed\n");
}
if (size < 128 && scoutbuf[2] != size - 1) {
errs++;
fprintf(stderr, "signed char MAX(>) test failed\n");
}
}
/* unsigned char */
MTestPrintfMsg(10, "Reduce of MPI_UNSIGNED_CHAR\n");
ucinbuf[0] = 1;
ucinbuf[1] = 0;
ucinbuf[2] = rank;
ucoutbuf[0] = 0;
ucoutbuf[1] = 1;
ucoutbuf[2] = 1;
MPI_Reduce(ucinbuf, ucoutbuf, 3, MPI_UNSIGNED_CHAR, MPI_MAX, 0, comm);
if (rank == 0) {
if (ucoutbuf[0] != 1) {
errs++;
fprintf(stderr, "unsigned char MAX(1) test failed\n");
}
if (ucoutbuf[1]) {
errs++;
fprintf(stderr, "unsigned char MAX(0) test failed\n");
}
if (size < 256 && ucoutbuf[2] != size - 1) {
errs++;
fprintf(stderr, "unsigned char MAX(>) test failed\n");
}
}
#ifdef HAVE_LONG_DOUBLE
{
long double ldinbuf[3], ldoutbuf[3];
/* long double */
ldinbuf[0] = 1;
ldinbuf[1] = 0;
ldinbuf[2] = rank;
ldoutbuf[0] = 0;
ldoutbuf[1] = 1;
ldoutbuf[2] = 1;
if (MPI_LONG_DOUBLE != MPI_DATATYPE_NULL) {
MTestPrintfMsg(10, "Reduce of MPI_LONG_DOUBLE\n");
MPI_Reduce(ldinbuf, ldoutbuf, 3, MPI_LONG_DOUBLE, MPI_MAX, 0, comm);
if (rank == 0) {
if (ldoutbuf[0] != 1) {
errs++;
fprintf(stderr, "long double MAX(1) test failed\n");
}
if (ldoutbuf[1] != 0.0) {
errs++;
fprintf(stderr, "long double MAX(0) test failed\n");
}
if (ldoutbuf[2] != size - 1) {
errs++;
fprintf(stderr, "long double MAX(>) test failed\n");
}
}
}
}
#endif /* HAVE_LONG_DOUBLE */
#ifdef HAVE_LONG_LONG
{
long long llinbuf[3], lloutbuf[3];
/* long long */
llinbuf[0] = 1;
llinbuf[1] = 0;
llinbuf[2] = rank;
lloutbuf[0] = 0;
lloutbuf[1] = 1;
lloutbuf[2] = 1;
if (MPI_LONG_LONG != MPI_DATATYPE_NULL) {
MTestPrintfMsg(10, "Reduce of MPI_LONG_LONG\n");
MPI_Reduce(llinbuf, lloutbuf, 3, MPI_LONG_LONG, MPI_MAX, 0, comm);
if (rank == 0) {
if (lloutbuf[0] != 1) {
errs++;
fprintf(stderr, "long long MAX(1) test failed\n");
}
if (lloutbuf[1] != 0) {
errs++;
fprintf(stderr, "long long MAX(0) test failed\n");
}
if (lloutbuf[2] != size - 1) {
errs++;
fprintf(stderr, "long long MAX(>) test failed\n");
}
}
}
}
#endif /* HAVE_LONG_LONG */
MTest_Finalize(errs);
MPI_Finalize();
return 0;
}
int main(int argc, char *argv[])
{
int rank, nprocs, A[NROWS][NCOLS], i, j, blocklen[2];
MPI_Aint disp[2];
MPI_Win win;
MPI_Datatype column, column1, type[2];
int errs=0;
MTest_Init(&argc,&argv);
MPI_Comm_size(MPI_COMM_WORLD,&nprocs);
MPI_Comm_rank(MPI_COMM_WORLD,&rank);
if (nprocs != 2)
{
printf("Run this program with 2 processes\n");
MPI_Abort(MPI_COMM_WORLD,1);
}
if (rank == 0)
{
for (i=0; i<NROWS; i++)
for (j=0; j<NCOLS; j++)
A[i][j] = i*NCOLS + j;
/* create datatype for one column */
MPI_Type_vector(NROWS, 1, NCOLS, MPI_INT, &column);
/* create datatype for one column, with the extent of one
integer. we could use type_create_resized instead. */
disp[0] = 0;
disp[1] = sizeof(int);
type[0] = column;
type[1] = MPI_UB;
blocklen[0] = 1;
blocklen[1] = 1;
MPI_Type_struct(2, blocklen, disp, type, &column1);
MPI_Type_commit(&column1);
MPI_Win_create(NULL, 0, 1, MPI_INFO_NULL, MPI_COMM_WORLD, &win);
MPI_Win_fence(0, win);
MPI_Put(A, NROWS*NCOLS, MPI_INT, 1, 0, NCOLS, column1, win);
MPI_Type_free(&column);
MPI_Type_free(&column1);
MPI_Win_fence(0, win);
}
else
{ /* rank = 1 */
for (i=0; i<NROWS; i++)
for (j=0; j<NCOLS; j++)
A[i][j] = -1;
MPI_Win_create(A, NROWS*NCOLS*sizeof(int), sizeof(int), MPI_INFO_NULL,
MPI_COMM_WORLD, &win);
MPI_Win_fence(0, win);
MPI_Win_fence(0, win);
for (j=0; j<NCOLS; j++)
{
for (i=0; i<NROWS; i++)
{
if (A[j][i] != i*NCOLS + j)
{
if (errs < 50)
{
printf("Error: A[%d][%d]=%d should be %d\n", j, i,
A[j][i], i*NCOLS + j);
}
errs++;
}
}
}
if (errs >= 50)
{
printf("Total number of errors: %d\n", errs);
}
}
MPI_Win_free(&win);
MTest_Finalize(errs);
MPI_Finalize();
return 0;
}
int main( int argc, char *argv[] )
{
int errs = 0;
int key[3], attrval[3];
int i;
MPI_Comm comm;
MTest_Init( &argc, &argv );
{
comm = MPI_COMM_WORLD;
/* Create key values */
for (i=0; i<3; i++) {
MPI_Comm_create_keyval( MPI_NULL_COPY_FN, MPI_NULL_DELETE_FN,
&key[i], (void *)0 );
attrval[i] = 1024 * i;
}
/* Insert attribute in several orders. Test after put with get,
then delete, then confirm delete with get. */
MPI_Comm_set_attr( comm, key[2], &attrval[2] );
MPI_Comm_set_attr( comm, key[1], &attrval[1] );
MPI_Comm_set_attr( comm, key[0], &attrval[0] );
errs += checkAttrs( comm, 3, key, attrval );
MPI_Comm_delete_attr( comm, key[0] );
MPI_Comm_delete_attr( comm, key[1] );
MPI_Comm_delete_attr( comm, key[2] );
errs += checkNoAttrs( comm, 3, key );
MPI_Comm_set_attr( comm, key[1], &attrval[1] );
MPI_Comm_set_attr( comm, key[2], &attrval[2] );
MPI_Comm_set_attr( comm, key[0], &attrval[0] );
errs += checkAttrs( comm, 3, key, attrval );
MPI_Comm_delete_attr( comm, key[2] );
MPI_Comm_delete_attr( comm, key[1] );
MPI_Comm_delete_attr( comm, key[0] );
errs += checkNoAttrs( comm, 3, key );
MPI_Comm_set_attr( comm, key[0], &attrval[0] );
MPI_Comm_set_attr( comm, key[1], &attrval[1] );
MPI_Comm_set_attr( comm, key[2], &attrval[2] );
errs += checkAttrs( comm, 3, key, attrval );
MPI_Comm_delete_attr( comm, key[1] );
MPI_Comm_delete_attr( comm, key[2] );
MPI_Comm_delete_attr( comm, key[0] );
errs += checkNoAttrs( comm, 3, key );
for (i=0; i<3; i++) {
MPI_Comm_free_keyval( &key[i] );
}
}
MTest_Finalize( errs );
MPI_Finalize();
return 0;
}
int main(int argc, char *argv[])
{
int rank, destrank, nprocs, *A, *B, i;
MPI_Comm CommDeuce;
MPI_Group comm_group, group;
MPI_Win win;
int errs = 0;
MTest_Init(&argc,&argv);
MPI_Comm_size(MPI_COMM_WORLD,&nprocs);
MPI_Comm_rank(MPI_COMM_WORLD,&rank);
if (nprocs < 2) {
printf("Run this program with 2 or more processes\n");
MPI_Abort(MPI_COMM_WORLD, 1);
}
MPI_Comm_split(MPI_COMM_WORLD, (rank < 2), rank, &CommDeuce);
if (rank < 2) {
i = MPI_Alloc_mem(SIZE * sizeof(int), MPI_INFO_NULL, &A);
if (i) {
printf("Can't allocate memory in test program\n");
MPI_Abort(MPI_COMM_WORLD, 1);
}
i = MPI_Alloc_mem(SIZE * sizeof(int), MPI_INFO_NULL, &B);
if (i) {
printf("Can't allocate memory in test program\n");
MPI_Abort(MPI_COMM_WORLD, 1);
}
MPI_Comm_group(CommDeuce, &comm_group);
if (rank == 0) {
for (i=0; i<SIZE; i++) {
A[i] = i;
B[i] = SIZE + i;
}
MPI_Win_create(NULL, 0, 1, MPI_INFO_NULL, CommDeuce, &win);
destrank = 1;
MPI_Group_incl(comm_group, 1, &destrank, &group);
MPI_Win_start(group, 0, win);
MPI_Put(A, SIZE, MPI_INT, 1, 0, SIZE, MPI_INT, win);
MPI_Win_complete(win);
MPI_Send(B, SIZE, MPI_INT, 1, 100, MPI_COMM_WORLD);
}
else { /* rank=1 */
for (i=0; i<SIZE; i++) A[i] = B[i] = (-4)*i;
MPI_Win_create(B, SIZE*sizeof(int), sizeof(int), MPI_INFO_NULL, CommDeuce, &win);
destrank = 0;
MPI_Group_incl(comm_group, 1, &destrank, &group);
MPI_Win_post(group, 0, win);
MPI_Recv(A, SIZE, MPI_INT, 0, 100, MPI_COMM_WORLD, MPI_STATUS_IGNORE);
MPI_Win_wait(win);
for (i=0; i<SIZE; i++) {
if (B[i] != i) {
SQUELCH( printf("Rank 1: Put Error: B[i] is %d, should be %d\n", B[i], i); );
errs++;
}
if (A[i] != SIZE + i) {
SQUELCH( printf("Rank 1: Send/Recv Error: A[i] is %d, should be %d\n", A[i], SIZE+i); );
int main(int argc, char *argv[])
{
MPI_Group gworld, g;
MPI_Comm comm, newcomm[MAX_LOOP];
int wsize, wrank, range[1][3], errs = 0;
double t[MAX_LOG_WSIZE], tf;
int maxi, i, k, ts, gsize[MAX_LOG_WSIZE];
MTest_Init(&argc, &argv);
MPI_Comm_size(MPI_COMM_WORLD, &wsize);
MPI_Comm_rank(MPI_COMM_WORLD, &wrank);
if (wrank == 0)
MTestPrintfMsg(1, "size\ttime\n");
MPI_Comm_group(MPI_COMM_WORLD, &gworld);
ts = 1;
comm = MPI_COMM_WORLD;
for (i = 0; ts <= wsize; i++, ts = ts + ts) {
/* Create some groups with at most ts members */
range[0][0] = ts - 1;
range[0][1] = 0;
range[0][2] = -1;
MPI_Group_range_incl(gworld, 1, range, &g);
MPI_Barrier(MPI_COMM_WORLD);
tf = MPI_Wtime();
for (k = 0; k < MAX_LOOP; k++)
MPI_Comm_create(comm, g, &newcomm[k]);
tf = MPI_Wtime() - tf;
MPI_Allreduce(&tf, &t[i], 1, MPI_DOUBLE, MPI_MAX, MPI_COMM_WORLD);
t[i] = t[i] / MAX_LOOP;
gsize[i] = ts;
if (wrank == 0)
MTestPrintfMsg(1, "%d\t%e\n", ts, t[i]);
MPI_Group_free(&g);
if (newcomm[0] != MPI_COMM_NULL)
for (k = 0; k < MAX_LOOP; k++)
MPI_Comm_free(&newcomm[k]);
}
MPI_Group_free(&gworld);
maxi = i - 1;
/* The cost should be linear or at worst ts*log(ts).
* We can check this in a number of ways.
*/
if (wrank == 0) {
for (i = 4; i <= maxi; i++) {
double rdiff;
if (t[i] > 0) {
rdiff = (t[i] - t[i - 1]) / t[i];
if (rdiff >= 4) {
errs++;
fprintf(stderr,
"Relative difference between group of size %d and %d is %e exceeds 4\n",
gsize[i - 1], gsize[i], rdiff);
}
}
}
}
MTest_Finalize(errs);
MPI_Finalize();
return 0;
}
int main(int argc, char *argv[])
{
int errs = 0;
int rank, size, source, dest;
unsigned char *buf, *bufp;
int minsize = 2;
int i, msgsize, bufsize, outsize;
unsigned char *msg1, *msg2, *msg3;
MPI_Comm comm;
MPI_Status status1, status2, status3;
MTest_Init(&argc, &argv);
/* The following illustrates the use of the routines to
* run through a selection of communicators and datatypes.
* Use subsets of these for tests that do not involve combinations
* of communicators, datatypes, and counts of datatypes */
msgsize = 128 * 1024;
msg1 = (unsigned char *) malloc(3 * msgsize);
msg2 = msg1 + msgsize;
msg3 = msg2 + msgsize;
while (MTestGetIntracommGeneral(&comm, minsize, 1)) {
if (comm == MPI_COMM_NULL)
continue;
/* Determine the sender and receiver */
MPI_Comm_rank(comm, &rank);
MPI_Comm_size(comm, &size);
source = 0;
dest = size - 1;
/* Here is the test: The sender */
if (rank == source) {
/* Get a bsend buffer. Make it large enough that the Bsend
* internals will (probably) not use a eager send for the data.
* Have three such messages */
bufsize = 3 * (MPI_BSEND_OVERHEAD + msgsize);
buf = (unsigned char *) malloc(bufsize);
if (!buf) {
fprintf(stderr, "Unable to allocate a buffer of %d bytes\n", bufsize);
MPI_Abort(MPI_COMM_WORLD, 1);
}
MPI_Buffer_attach(buf, bufsize);
/* Initialize the buffers */
for (i = 0; i < msgsize; i++) {
msg1[i] = 0xff ^ (i & 0xff);
msg2[i] = 0xff ^ (3 * i & 0xff);
msg3[i] = 0xff ^ (5 * i & 0xff);
}
/* Initiate the bsends */
MPI_Bsend(msg1, msgsize, MPI_UNSIGNED_CHAR, dest, 0, comm);
MPI_Bsend(msg2, msgsize, MPI_UNSIGNED_CHAR, dest, 0, comm);
MPI_Bsend(msg3, msgsize, MPI_UNSIGNED_CHAR, dest, 0, comm);
/* Synchronize with our partner */
MPI_Sendrecv(NULL, 0, MPI_UNSIGNED_CHAR, dest, 10,
NULL, 0, MPI_UNSIGNED_CHAR, dest, 10, comm, MPI_STATUS_IGNORE);
/* Detach the buffers. There should be pending operations */
MPI_Buffer_detach(&bufp, &outsize);
if (bufp != buf) {
fprintf(stderr, "Wrong buffer returned\n");
errs++;
}
if (outsize != bufsize) {
fprintf(stderr, "Wrong buffer size returned\n");
errs++;
}
}
else if (rank == dest) {
double tstart;
/* Clear the message buffers */
for (i = 0; i < msgsize; i++) {
msg1[i] = 0;
msg2[i] = 0;
msg3[i] = 0;
}
/* Wait for the synchronize */
MPI_Sendrecv(NULL, 0, MPI_UNSIGNED_CHAR, source, 10,
NULL, 0, MPI_UNSIGNED_CHAR, source, 10, comm, MPI_STATUS_IGNORE);
/* Wait 2 seconds */
tstart = MPI_Wtime();
while (MPI_Wtime() - tstart < 2.0);
/* Now receive the messages */
MPI_Recv(msg1, msgsize, MPI_UNSIGNED_CHAR, source, 0, comm, &status1);
MPI_Recv(msg2, msgsize, MPI_UNSIGNED_CHAR, source, 0, comm, &status2);
MPI_Recv(msg3, msgsize, MPI_UNSIGNED_CHAR, source, 0, comm, &status3);
/* Check that we have the correct data */
for (i = 0; i < msgsize; i++) {
if (msg1[i] != (0xff ^ (i & 0xff))) {
if (errs < 10) {
fprintf(stderr, "msg1[%d] = %d\n", i, msg1[i]);
}
errs++;
}
if (msg2[i] != (0xff ^ (3 * i & 0xff))) {
if (errs < 10) {
fprintf(stderr, "msg2[%d] = %d\n", i, msg2[i]);
}
errs++;
}
if (msg3[i] != (0xff ^ (5 * i & 0xff))) {
if (errs < 10) {
fprintf(stderr, "msg2[%d] = %d\n", i, msg2[i]);
}
errs++;
}
}
}
MTestFreeComm(&comm);
}
free(msg1);
MTest_Finalize(errs);
MPI_Finalize();
return 0;
}
int main( int argc, char *argv[] )
{
int errs = 0, err;
int rank, size, root;
int minsize = 2, count;
MPI_Comm comm;
MTestDatatype sendtype, recvtype;
MTest_Init( &argc, &argv );
/* The following illustrates the use of the routines to
run through a selection of communicators and datatypes.
Use subsets of these for tests that do not involve combinations
of communicators, datatypes, and counts of datatypes */
while (MTestGetIntracommGeneral( &comm, minsize, 1 )) {
if (comm == MPI_COMM_NULL) continue;
/* Determine the sender and receiver */
MPI_Comm_rank( comm, &rank );
MPI_Comm_size( comm, &size );
/* To improve reporting of problems about operations, we
change the error handler to errors return */
MPI_Errhandler_set( comm, MPI_ERRORS_RETURN );
/* The max value of count must be very large to ensure that we
reach the long message algorithms */
for (count = 1; count < 2800; count = count * 4) {
while (MTestGetDatatypes( &sendtype, &recvtype, count )) {
for (root=0; root<size; root++) {
if (rank == root) {
sendtype.InitBuf( &sendtype );
err = MPI_Bcast( sendtype.buf, sendtype.count,
sendtype.datatype, root, comm );
if (err) {
errs++;
MTestPrintError( err );
}
}
else {
recvtype.InitBuf( &recvtype );
err = MPI_Bcast( recvtype.buf, recvtype.count,
recvtype.datatype, root, comm );
if (err) {
errs++;
fprintf( stderr, "Error with communicator %s and datatype %s\n",
MTestGetIntracommName(),
MTestGetDatatypeName( &recvtype ) );
MTestPrintError( err );
}
err = MTestCheckRecv( 0, &recvtype );
if (err) {
errs += errs;
}
}
}
MTestFreeDatatype( &recvtype );
MTestFreeDatatype( &sendtype );
}
}
MTestFreeComm( &comm );
}
MTest_Finalize( errs );
MPI_Finalize();
return 0;
}
int main(int argc, char *argv[])
{
int comm_keyval, win_keyval, type_keyval;
int comm_aval;
int err, errs = 0;
int buf, flag;
MPI_Win win;
void *rval;
MPI_Datatype dtype;
MTest_Init(&argc, &argv);
MPI_Comm_create_keyval(MPI_COMM_NULL_COPY_FN, MPI_COMM_NULL_DELETE_FN, &comm_keyval, 0);
MPI_Win_create_keyval(MPI_WIN_NULL_COPY_FN, MPI_WIN_NULL_DELETE_FN, &win_keyval, 0);
MPI_Type_create_keyval(MPI_TYPE_NULL_COPY_FN, MPI_TYPE_NULL_DELETE_FN, &type_keyval, 0);
MPI_Type_contiguous(4, MPI_DOUBLE, &dtype);
MPI_Win_create(&buf, sizeof(int), sizeof(int), MPI_INFO_NULL, MPI_COMM_WORLD, &win);
MPI_Errhandler_set(MPI_COMM_WORLD, MPI_ERRORS_RETURN);
err = MPI_Comm_set_attr(MPI_COMM_WORLD, win_keyval, &comm_aval);
if (err == MPI_SUCCESS) {
errs++;
fprintf(stderr, "Comm_set_attr accepted win keyval\n");
}
err = MPI_Comm_set_attr(MPI_COMM_WORLD, type_keyval, &comm_aval);
if (err == MPI_SUCCESS) {
errs++;
fprintf(stderr, "Comm_set_attr accepted type keyval\n");
}
err = MPI_Type_set_attr(dtype, win_keyval, &comm_aval);
if (err == MPI_SUCCESS) {
errs++;
fprintf(stderr, "Type_set_attr accepted win keyval\n");
}
err = MPI_Type_set_attr(dtype, comm_keyval, &comm_aval);
if (err == MPI_SUCCESS) {
errs++;
fprintf(stderr, "Comm_set_attr accepted type keyval\n");
}
err = MPI_Win_set_attr(win, comm_keyval, &comm_aval);
if (err == MPI_SUCCESS) {
errs++;
fprintf(stderr, "Win_set_attr accepted comm keyval\n");
}
err = MPI_Win_set_attr(win, type_keyval, &comm_aval);
if (err == MPI_SUCCESS) {
errs++;
fprintf(stderr, "Win_set_attr accepted type keyval\n");
}
err = MPI_Comm_get_attr(MPI_COMM_WORLD, win_keyval, &rval, &flag);
if (err == MPI_SUCCESS) {
errs++;
fprintf(stderr, "Comm_get_attr accepted win keyval\n");
}
err = MPI_Comm_get_attr(MPI_COMM_WORLD, type_keyval, &rval, &flag);
if (err == MPI_SUCCESS) {
errs++;
fprintf(stderr, "Comm_get_attr accepted type keyval\n");
}
err = MPI_Comm_free_keyval(&win_keyval);
if (err == MPI_SUCCESS) {
errs++;
fprintf(stderr, "Comm_free_keyval accepted win keyval\n");
}
err = MPI_Comm_free_keyval(&type_keyval);
if (err == MPI_SUCCESS) {
errs++;
fprintf(stderr, "Comm_free_keyval accepted type keyval\n");
}
if (win_keyval != MPI_KEYVAL_INVALID) {
err = MPI_Type_free_keyval(&win_keyval);
if (err == MPI_SUCCESS) {
errs++;
fprintf(stderr, "Type_free_keyval accepted win keyval\n");
}
}
err = MPI_Type_free_keyval(&comm_keyval);
if (err == MPI_SUCCESS) {
errs++;
fprintf(stderr, "Type_free_keyval accepted comm keyval\n");
}
if (type_keyval != MPI_KEYVAL_INVALID) {
err = MPI_Win_free_keyval(&type_keyval);
if (err == MPI_SUCCESS) {
errs++;
fprintf(stderr, "Win_free_keyval accepted type keyval\n");
}
}
if (comm_keyval != MPI_KEYVAL_INVALID) {
err = MPI_Win_free_keyval(&comm_keyval);
if (err == MPI_SUCCESS) {
errs++;
fprintf(stderr, "Win_free_keyval accepted comm keyval\n");
}
}
/* Now, free for real */
if (comm_keyval != MPI_KEYVAL_INVALID) {
err = MPI_Comm_free_keyval(&comm_keyval);
if (err != MPI_SUCCESS) {
errs++;
fprintf(stderr, "Could not free comm keyval\n");
}
}
if (type_keyval != MPI_KEYVAL_INVALID) {
err = MPI_Type_free_keyval(&type_keyval);
if (err != MPI_SUCCESS) {
errs++;
fprintf(stderr, "Could not free type keyval\n");
}
}
if (win_keyval != MPI_KEYVAL_INVALID) {
err = MPI_Win_free_keyval(&win_keyval);
if (err != MPI_SUCCESS) {
errs++;
fprintf(stderr, "Could not free win keyval\n");
}
}
MPI_Win_free(&win);
MPI_Type_free(&dtype);
MTest_Finalize(errs);
return MTestReturnValue(errs);
}
int main(int argc, char *argv[])
{
int nProc, rank;
int i, j, status;
FILE *pf = 0;
MTest_Init(&argc, &argv);
MPI_Comm_size(MPI_COMM_WORLD, &nProc);
MPI_Comm_rank(MPI_COMM_WORLD, &rank);
for (i = 1; i < argc; i++) {
if (strcmp(argv[i], "-v") == 0 || strcmp(argv[i], "--verbose") == 0)
verbose = 1;
else if (strcmp(argv[i], "-p") == 0 || strcmp(argv[i], "--progress") == 0)
loopProgress = 1;
else {
if (rank == 0) {
fprintf(stderr, "%s: [ -v | --verbose ] [ -p | --progress ]\n", argv[0]);
fflush(stderr);
}
}
}
if (verbose) {
char buf[128];
sprintf(buf, "fast_mpi_%d.dmp", rank);
pf = fopen(buf, "w");
} else if (loopProgress) {
pf = stdout;
}
if (!rank) {
int **psend;
int **precv;
psend = (int **) calloc(nProc, sizeof(int *));
precv = (int **) calloc(nProc, sizeof(int *));
for (i = 0; i < nProc; i++) {
psend[i] = (int *) calloc(DATA_SIZE, sizeof(int));
precv[i] = (int *) calloc(DATA_SIZE, sizeof(int));
}
for (i = 0; i < LOOP_COUNT; i++) {
if (verbose) {
fprintf(pf, "Master : loop %d\n", i);
fflush(pf);
} else if (loopProgress && (i & PROGRESS_COUNT) == 0) {
fprintf(pf, "Master: loop %d\n", i);
fflush(pf);
}
for (j = 1; j < nProc; j++) {
if (verbose) {
fprintf(pf, " read from child %d\n", j);
fflush(pf);
}
status = MPI_Recv(precv[j], DATA_SIZE, MPI_INT, j, MP_TAG,
MPI_COMM_WORLD, MPI_STATUS_IGNORE);
if (verbose) {
fprintf(pf, " read from child %d done, status = %d\n", j, status);
fflush(pf);
}
}
for (j = 1; j < nProc; j++) {
if (verbose) {
fprintf(pf, " send to child %d\n", j);
fflush(pf);
}
status = MPI_Send(psend[j], DATA_SIZE - 1, MPI_INT, j, MP_TAG, MPI_COMM_WORLD);
if (verbose) {
fprintf(pf, " send to child %d done, status = %d\n", j, status);
fflush(pf);
}
}
}
for (i = 0; i < nProc; i++) {
free(psend[i]);
free(precv[i]);
}
free(psend);
free(precv);
} else {
int *psend;
int *precv;
psend = (int *) calloc(DATA_SIZE, sizeof(int));
precv = (int *) calloc(DATA_SIZE, sizeof(int));
for (i = 0; i < LOOP_COUNT; i++) {
if (verbose) {
fprintf(pf, " send to master\n");
fflush(pf);
}
/*
* else if (loopProgress && (i & PROGRESS_COUNT) == 0) {
* fprintf(pf, "Slave: loop %d\n", i); fflush(pf);
* }
*/
status = MPI_Send(psend, DATA_SIZE - 1, MPI_INT, 0, MP_TAG, MPI_COMM_WORLD);
if (verbose) {
fprintf(pf, " send to master done, status = %d\n", status);
fflush(pf);
fprintf(pf, " read from master\n");
fflush(pf);
}
status = MPI_Recv(precv, DATA_SIZE, MPI_INT, 0, MP_TAG,
MPI_COMM_WORLD, MPI_STATUS_IGNORE);
if (verbose) {
fprintf(pf, " read from master done, status = %d\n", status);
fflush(pf);
}
}
free(psend);
free(precv);
}
if (verbose) {
fclose(pf);
}
MTest_Finalize(0);
return 0;
}
int main( int argc, char **argv )
{
MPI_Comm comm;
int *sbuf, *rbuf;
int rank, size;
int *sendcounts, *recvcounts, *rdispls, *sdispls;
int i, j, *p, err;
MTest_Init( &argc, &argv );
err = 0;
while (MTestGetIntracommGeneral( &comm, 2, 1 )) {
if (comm == MPI_COMM_NULL) continue;
/* Create the buffer */
MPI_Comm_size( comm, &size );
MPI_Comm_rank( comm, &rank );
sbuf = (int *)malloc( size * size * sizeof(int) );
rbuf = (int *)malloc( size * size * sizeof(int) );
if (!sbuf || !rbuf) {
fprintf( stderr, "Could not allocated buffers!\n" );
MPI_Abort( comm, 1 );
}
/* Load up the buffers */
for (i=0; i<size*size; i++) {
sbuf[i] = i + 100*rank;
rbuf[i] = -i;
}
/* Create and load the arguments to alltoallv */
sendcounts = (int *)malloc( size * sizeof(int) );
recvcounts = (int *)malloc( size * sizeof(int) );
rdispls = (int *)malloc( size * sizeof(int) );
sdispls = (int *)malloc( size * sizeof(int) );
if (!sendcounts || !recvcounts || !rdispls || !sdispls) {
fprintf( stderr, "Could not allocate arg items!\n" );
MPI_Abort( comm, 1 );
}
for (i=0; i<size; i++) {
sendcounts[i] = i;
recvcounts[i] = rank;
rdispls[i] = i * rank;
sdispls[i] = (i * (i+1))/2;
}
MPI_Alltoallv( sbuf, sendcounts, sdispls, MPI_INT,
rbuf, recvcounts, rdispls, MPI_INT, comm );
/* Check rbuf */
for (i=0; i<size; i++) {
p = rbuf + rdispls[i];
for (j=0; j<rank; j++) {
if (p[j] != i * 100 + (rank*(rank+1))/2 + j) {
fprintf( stderr, "[%d] got %d expected %d for %dth\n",
rank, p[j],(i*(i+1))/2 + j, j );
err++;
}
}
}
free( sdispls );
free( sendcounts );
free( sbuf );
#if MTEST_HAVE_MIN_MPI_VERSION(2,2)
/* check MPI_IN_PLACE, added in MPI-2.2 */
free( rbuf );
rbuf = (int *)malloc( size * (2 * size) * sizeof(int) );
if (!rbuf) {
fprintf( stderr, "Could not reallocate rbuf!\n" );
MPI_Abort( comm, 1 );
}
/* Load up the buffers */
for (i = 0; i < size; i++) {
recvcounts[i] = i + rank;
rdispls[i] = i * (2 * size);
}
memset(rbuf, -1, size * (2 * size) * sizeof(int));
for (i=0; i < size; i++) {
p = rbuf + rdispls[i];
for (j = 0; j < recvcounts[i]; ++j) {
p[j] = 100 * rank + 10 * i + j;
}
}
MPI_Alltoallv( MPI_IN_PLACE, NULL, NULL, MPI_INT,
rbuf, recvcounts, rdispls, MPI_INT, comm );
/* Check rbuf */
for (i=0; i<size; i++) {
p = rbuf + rdispls[i];
for (j=0; j<recvcounts[i]; j++) {
int expected = 100 * i + 10 * rank + j;
if (p[j] != expected) {
fprintf(stderr, "[%d] got %d expected %d for block=%d, element=%dth\n",
rank, p[j], expected, i, j);
++err;
}
}
}
/* Check to make sure that aliasing is disallowed correctly */
MPI_Comm_set_errhandler(MPI_COMM_WORLD, MPI_ERRORS_RETURN);
if (MPI_SUCCESS == MPI_Alltoallv(rbuf, recvcounts, rdispls, MPI_INT,
rbuf, recvcounts, rdispls, MPI_INT, comm))
err++;
#endif
free( rdispls );
free( recvcounts );
free( rbuf );
MTestFreeComm( &comm );
}
MTest_Finalize( err );
MPI_Finalize();
return 0;
}
int main(int argc, char **argv)
{
int errs = 0;
int i;
int rank, size;
int *excl;
int ranges[1][3];
int isLeft, rleader;
MPI_Group world_group, high_group, even_group;
MPI_Comm local_comm, inter_comm, test_comm, outcomm;
MPI_Comm idupcomms[NUM_IDUPS];
MPI_Request reqs[NUM_IDUPS];
MTest_Init(&argc, &argv);
MPI_Comm_rank(MPI_COMM_WORLD, &rank);
MPI_Comm_size(MPI_COMM_WORLD, &size);
MPI_Comm_group(MPI_COMM_WORLD, &world_group);
if (size < 2) {
printf("this test requires at least 2 processes\n");
MPI_Abort(MPI_COMM_WORLD, 1);
}
/* Idup MPI_COMM_WORLD multiple times */
for (i = 0; i < NUM_IDUPS; i++) {
MPI_Comm_idup(MPI_COMM_WORLD, &idupcomms[i], &reqs[i]);
}
/* Overlap pending idups with various comm generation functions */
/* Comm_dup */
MPI_Comm_dup(MPI_COMM_WORLD, &outcomm);
errs += MTestTestComm(outcomm);
MTestFreeComm(&outcomm);
/* Comm_split */
MPI_Comm_split(MPI_COMM_WORLD, rank % 2, size - rank, &outcomm);
errs += MTestTestComm(outcomm);
MTestFreeComm(&outcomm);
/* Comm_create, high half of MPI_COMM_WORLD */
ranges[0][0] = size / 2;
ranges[0][1] = size - 1;
ranges[0][2] = 1;
MPI_Group_range_incl(world_group, 1, ranges, &high_group);
MPI_Comm_create(MPI_COMM_WORLD, high_group, &outcomm);
MPI_Group_free(&high_group);
errs += MTestTestComm(outcomm);
MTestFreeComm(&outcomm);
/* Comm_create_group, even ranks of MPI_COMM_WORLD */
/* exclude the odd ranks */
excl = malloc((size / 2) * sizeof(int));
for (i = 0; i < size / 2; i++)
excl[i] = (2 * i) + 1;
MPI_Group_excl(world_group, size / 2, excl, &even_group);
free(excl);
if (rank % 2 == 0) {
MPI_Comm_create_group(MPI_COMM_WORLD, even_group, 0, &outcomm);
} else {
outcomm = MPI_COMM_NULL;
}
MPI_Group_free(&even_group);
errs += MTestTestComm(outcomm);
MTestFreeComm(&outcomm);
/* Intercomm_create & Intercomm_merge */
MPI_Comm_split(MPI_COMM_WORLD, (rank < size / 2), rank, &local_comm);
if (rank == 0) {
rleader = size / 2;
} else if (rank == size / 2) {
rleader = 0;
} else {
rleader = -1;
}
isLeft = rank < size / 2;
MPI_Intercomm_create(local_comm, 0, MPI_COMM_WORLD, rleader, 99, &inter_comm);
MPI_Intercomm_merge(inter_comm, isLeft, &outcomm);
MPI_Comm_free(&local_comm);
errs += MTestTestComm(inter_comm);
MTestFreeComm(&inter_comm);
errs += MTestTestComm(outcomm);
MTestFreeComm(&outcomm);
MPI_Waitall(NUM_IDUPS, reqs, MPI_STATUSES_IGNORE);
for (i = 0; i < NUM_IDUPS; i++) {
errs += MTestTestComm(idupcomms[i]);
MPI_Comm_free(&idupcomms[i]);
}
MPI_Group_free(&world_group);
MTest_Finalize(errs);
return MTestReturnValue(errs);
}
int main( int argc, char **argv)
{
int errs = 0;
void *v;
int flag;
int vval;
int rank, size;
MTest_Init( &argc, &argv );
MPI_Comm_size( MPI_COMM_WORLD, &size );
MPI_Comm_rank( MPI_COMM_WORLD, &rank );
MPI_Comm_get_attr( MPI_COMM_WORLD, MPI_TAG_UB, &v, &flag );
if (!flag) {
errs++;
fprintf( stderr, "Could not get TAG_UB\n" );
}
else {
vval = *(int*)v;
if (vval < 32767) {
errs++;
fprintf( stderr, "Got too-small value (%d) for TAG_UB\n", vval );
}
}
MPI_Comm_get_attr( MPI_COMM_WORLD, MPI_HOST, &v, &flag );
if (!flag) {
errs++;
fprintf( stderr, "Could not get HOST\n" );
}
else {
vval = *(int*)v;
if ((vval < 0 || vval >= size) && vval != MPI_PROC_NULL) {
errs++;
fprintf( stderr, "Got invalid value %d for HOST\n", vval );
}
}
MPI_Comm_get_attr( MPI_COMM_WORLD, MPI_IO, &v, &flag );
if (!flag) {
errs++;
fprintf( stderr, "Could not get IO\n" );
}
else {
vval = *(int*)v;
if ((vval < 0 || vval >= size) && vval != MPI_ANY_SOURCE &&
vval != MPI_PROC_NULL) {
errs++;
fprintf( stderr, "Got invalid value %d for IO\n", vval );
}
}
MPI_Comm_get_attr( MPI_COMM_WORLD, MPI_WTIME_IS_GLOBAL, &v, &flag );
if (flag) {
/* Wtime need not be set */
vval = *(int*)v;
if (vval < 0 || vval > 1) {
errs++;
fprintf( stderr, "Invalid value for WTIME_IS_GLOBAL (got %d)\n",
vval );
}
}
/* MPI 2.0, section 5.5.3 - MPI_APPNUM should be set if the program is
started with more than one executable name (e.g., in MPMD instead
of SPMD mode). This is independent of the dynamic process routines,
and should be supported even if MPI_COMM_SPAWN and friends are not. */
MPI_Comm_get_attr( MPI_COMM_WORLD, MPI_APPNUM, &v, &flag );
/* appnum need not be set */
if (flag) {
vval = *(int *)v;
if (vval < 0) {
errs++;
fprintf( stderr, "MPI_APPNUM is defined as %d but must be nonnegative\n", vval );
}
}
/* MPI 2.0 section 5.5.1. MPI_UNIVERSE_SIZE need not be set, but
should be present. */
MPI_Comm_get_attr( MPI_COMM_WORLD, MPI_UNIVERSE_SIZE, &v, &flag );
/* MPI_UNIVERSE_SIZE need not be set */
if (flag) {
/* But if it is set, it must be at least the size of comm_world */
vval = *(int *)v;
if (vval < size) {
errs++;
fprintf( stderr, "MPI_UNIVERSE_SIZE = %d, less than comm world (%d)\n", vval, size );
}
}
MPI_Comm_get_attr( MPI_COMM_WORLD, MPI_LASTUSEDCODE, &v, &flag );
/* Last used code must be defined and >= MPI_ERR_LASTCODE */
if (flag) {
vval = *(int*)v;
if (vval < MPI_ERR_LASTCODE) {
errs++;
fprintf( stderr, "MPI_LASTUSEDCODE points to an integer (%d) smaller than MPI_ERR_LASTCODE (%d)\n", vval, MPI_ERR_LASTCODE );
}
}
else {
errs++;
fprintf( stderr, "MPI_LASTUSECODE is not defined\n" );
}
MTest_Finalize( errs );
MPI_Finalize( );
return 0;
}
int main( int argc, char **argv )
{
int err = 0;
int *recvcounts;
int size, rsize, rank, i;
int recvcount, /* Each process receives this much data */
sendcount, /* Each process contributes this much data */
basecount; /* Unit of elements - basecount *rsize is recvcount,
etc. */
int isLeftGroup;
long long *sendbuf, *recvbuf;
long long sumval;
MPI_Comm comm;
MTest_Init( &argc, &argv );
comm = MPI_COMM_WORLD;
basecount = 1024;
while (MTestGetIntercomm( &comm, &isLeftGroup, 2 )) {
if (comm == MPI_COMM_NULL) continue;
MPI_Comm_remote_size( comm, &rsize );
MPI_Comm_size( comm, &size );
MPI_Comm_rank( comm, &rank );
if (0) {
printf( "[%d] %s (%d,%d) remote %d\n", rank,
isLeftGroup ? "L" : "R",
rank, size, rsize );
}
recvcount = basecount * rsize;
sendcount = basecount * rsize * size;
recvcounts = (int *)malloc( size * sizeof(int) );
if (!recvcounts) {
fprintf( stderr, "Could not allocate %d int for recvcounts\n",
size );
MPI_Abort( MPI_COMM_WORLD, 1 );
}
for (i=0; i<size; i++)
recvcounts[i] = recvcount;
sendbuf = (long long *) malloc( sendcount * sizeof(long long) );
if (!sendbuf) {
fprintf( stderr, "Could not allocate %d ints for sendbuf\n",
sendcount );
MPI_Abort( MPI_COMM_WORLD, 1 );
}
for (i=0; i<sendcount; i++) {
sendbuf[i] = (long long)(rank*sendcount + i);
}
recvbuf = (long long *)malloc( recvcount * sizeof(long long) );
if (!recvbuf) {
fprintf( stderr, "Could not allocate %d ints for recvbuf\n",
recvcount );
MPI_Abort( MPI_COMM_WORLD, 1 );
}
for (i=0; i<recvcount; i++) {
recvbuf[i] = (long long)(-i);
}
MPI_Reduce_scatter( sendbuf, recvbuf, recvcounts, MPI_LONG_LONG, MPI_SUM,
comm );
/* Check received data */
for (i=0; i<recvcount; i++) {
sumval = (long long)(sendcount) * (long long)((rsize * (rsize-1))/2) +
(long long)(i + rank * rsize * basecount) * (long long)rsize;
if (recvbuf[i] != sumval) {
err++;
if (err < 4) {
fprintf( stdout, "Did not get expected value for reduce scatter\n" );
fprintf( stdout, "[%d] %s recvbuf[%d] = %lld, expected %lld\n",
rank,
isLeftGroup ? "L" : "R",
i, recvbuf[i], sumval );
}
}
}
free(sendbuf);
free(recvbuf);
free(recvcounts);
MTestFreeComm( &comm );
}
MTest_Finalize( err );
MPI_Finalize( );
return 0;
}
