mtest.c

mpi并行计算的c++代码 可用vc或gcc编译通过 可以用来搭建并行计算试验环境

/* -*- Mode: C; c-basic-offset:4 ; -*- */
/*
 *
 *  (C) 2001 by Argonne National Laboratory.
 *      See COPYRIGHT in top-level directory.
 */
#include "mpi.h"
#include "mpitestconf.h"
#include "mpitest.h"
#include <stdio.h>
#include <stdlib.h>
#ifdef HAVE_STDARG_H
#include <stdarg.h>
#endif

/* Here is where we could put the includes and definitions to enable
   memory testing */

static int dbgflag = 0;         /* Flag used for debugging */
static int wrank = -1;          /* World rank */
static int verbose = 0;         /* Message level (0 is none) */
/* 
 * Initialize and Finalize MTest
 */

/*
   Initialize MTest, initializing MPI if necessary.  

 Environment Variables:
+ MPITEST_DEBUG - If set (to any value), turns on debugging output
- MPITEST_VERBOSE - If set to a numeric value, turns on that level of
  verbose output.  This is used by the routine 'MTestPrintfMsg'

*/
void MTest_Init( int *argc, char ***argv )
{
    int flag;
    char *envval = 0;

    MPI_Initialized( &flag );
    if (!flag) {
	MPI_Init( argc, argv );
    }
    /* Check for debugging control */
    if (getenv( "MPITEST_DEBUG" )) {
	dbgflag = 1;
	MPI_Comm_rank( MPI_COMM_WORLD, &wrank );
    }

    /* Check for verbose control */
    envval = getenv( "MPITEST_VERBOSE" );
    if (envval) {
	char *s;
	long val = strtol( envval, &s, 0 );
	if (s == envval) {
	    /* This is the error case for strtol */
	    fprintf( stderr, "Warning: %s not valid for MPITEST_VERBOSE\n", 
		     envval );
	    fflush( stderr );
	}
	else {
	    if (val >= 0) {
		verbose = val;
	    }
	    else {
		fprintf( stderr, "Warning: %s not valid for MPITEST_VERBOSE\n", 
			 envval );
		fflush( stderr );
	    }
	}
    }
}

/*
  Finalize MTest.  errs is the number of errors on the calling process; 
  this routine will write the total number of errors over all of MPI_COMM_WORLD
  to the process with rank zero, or " No Errors".
  It does *not* finalize MPI.
 */
void MTest_Finalize( int errs )
{
    int rank, toterrs;

    MPI_Comm_rank( MPI_COMM_WORLD, &rank );

    MPI_Reduce( &errs, &toterrs, 1, MPI_INT, MPI_SUM, 0, MPI_COMM_WORLD );
    if (rank == 0) {
	if (toterrs) {
	    printf( " Found %d errors\n", toterrs );
	}
	else {
	    printf( " No Errors\n" );
	}
	fflush( stdout );
    }
}

/*
 * Datatypes
 *
 * Eventually, this could read a description of a file.  For now, we hard 
 * code the choices
 *
 */
static int datatype_index = 0;

/* ------------------------------------------------------------------------ */
/* Datatype routines for contiguous datatypes                               */
/* ------------------------------------------------------------------------ */
/* 
 * Setup contiguous buffers of n copies of a datatype.
 */
static void *MTestTypeContigInit( MTestDatatype *mtype )
{
    MPI_Aint size;
    if (mtype->count > 0) {
	signed char *p;
	int  i, totsize;
	MPI_Type_extent( mtype->datatype, &size );
	totsize = size * mtype->count;
	if (!mtype->buf) {
	    mtype->buf = (void *) malloc( totsize );
	}
	p = (signed char *)(mtype->buf);
	if (!p) {
	    /* Error - out of memory */
	    MTestError( "Out of memory in type buffer init" );
	}
	for (i=0; i<totsize; i++) {
	    p[i] = 0xff ^ (i & 0xff);
	}
    }
    else {
	if (mtype->buf) {
	    free( mtype->buf );
	}
	mtype->buf = 0;
    }
    return mtype->buf;
}

/* 
 * Setup contiguous buffers of n copies of a datatype.  Initialize for
 * reception (e.g., set initial data to detect failure)
 */
static void *MTestTypeContigInitRecv( MTestDatatype *mtype )
{
    MPI_Aint size;
    if (mtype->count > 0) {
	signed char *p;
	int  i, totsize;
	MPI_Type_extent( mtype->datatype, &size );
	totsize = size * mtype->count;
	if (!mtype->buf) {
	    mtype->buf = (void *) malloc( totsize );
	}
	p = (signed char *)(mtype->buf);
	if (!p) {
	    /* Error - out of memory */
	    MTestError( "Out of memory in type buffer init" );
	}
	for (i=0; i<totsize; i++) {
	    p[i] = 0xff;
	}
    }
    else {
	if (mtype->buf) {
	    free( mtype->buf );
	}
	mtype->buf = 0;
    }
    return mtype->buf;
}
static void *MTestTypeContigFree( MTestDatatype *mtype )
{
    if (mtype->buf) {
	free( mtype->buf );
	mtype->buf = 0;
    }
    return 0;
}
static int MTestTypeContigCheckbuf( MTestDatatype *mtype )
{
    unsigned char *p;
    unsigned char expected;
    int  i, totsize, err = 0;
    MPI_Aint size;

    p = (unsigned char *)mtype->buf;
    if (p) {
	MPI_Type_extent( mtype->datatype, &size );
	totsize = size * mtype->count;
	for (i=0; i<totsize; i++) {
	    expected = (0xff ^ (i & 0xff));
	    if (p[i] != expected) {
		err++;
		if (mtype->printErrors && err < 10) {
		    printf( "Data expected = %x but got %x for %dth entry\n",
			    expected, p[i], i );
		    fflush( stdout );
		}
	    }
	}
    }
    return err;
}

/* ------------------------------------------------------------------------ */
/* Datatype routines for vector datatypes                                   */
/* ------------------------------------------------------------------------ */

static void *MTestTypeVectorInit( MTestDatatype *mtype )
{
    MPI_Aint size;

    if (mtype->count > 0) {
	unsigned char *p;
	int  i, j, k, nc, totsize;

	MPI_Type_extent( mtype->datatype, &size );
	totsize	   = mtype->count * size;
	if (!mtype->buf) {
	    mtype->buf = (void *) malloc( totsize );
	}
	p	   = (unsigned char *)(mtype->buf);
	if (!p) {
	    /* Error - out of memory */
	    MTestError( "Out of memory in type buffer init" );
	}

	/* First, set to -1 */
	for (i=0; i<totsize; i++) p[i] = 0xff;

	/* Now, set the actual elements to the successive values.
	   To do this, we need to run 3 loops */
	nc = 0;
	/* count is usually one for a vector type */
	for (k=0; k<mtype->count; k++) {
	    /* For each element (block) */
	    for (i=0; i<mtype->nelm; i++) {
		/* For each value */
		for (j=0; j<mtype->blksize; j++) {
		    p[j] = (0xff ^ (nc & 0xff));
		    nc++;
		}
		p += mtype->stride;
	    }
	}
    }
    else {
	mtype->buf = 0;
    }
    return mtype->buf;
}

static void *MTestTypeVectorFree( MTestDatatype *mtype )
{
    if (mtype->buf) {
	free( mtype->buf );
	mtype->buf = 0;
    }
    return 0;
}

# if 0
/* The following is the contig init code */
static void *MTestTypeVectorInitRecv( MTestDatatype *mtype )
{
    MPI_Aint size;
    if (mtype->count > 0) {
	signed char *p;
	int  i, totsize;
	MPI_Type_extent( mtype->datatype, &size );
	totsize = size * mtype->count;
	if (!mtype->buf) {
	    mtype->buf = (void *) malloc( totsize );
	}
	p = (signed char *)(mtype->buf);
	if (!p) {
	    /* Error - out of memory */
	    MTestError( "Out of memory in type buffer init" );
	}
	for (i=0; i<totsize; i++) {
	    p[i] = 0xff;
	}
    }
    else {
	if (mtype->buf) {
	    free( mtype->buf );
	}
	mtype->buf = 0;
    }
    return mtype->buf;
}

static int MTestTypeVectorCheckbuf( MTestDatatype *mtype )
{
    unsigned char *p;
    unsigned char expected;
    int  i, totsize, err = 0;
    MPI_Aint size;

    p = (unsigned char *)mtype->buf;
    if (p) {
	MPI_Type_extent( mtype->datatype, &size );
	totsize = size * mtype->count;

	/* count is usually one for a vector type */
	nc = 0;
	for (k=0; k<mtype->count; k++) {
	    /* For each element (block) */
	    for (i=0; i<mtype->nelm; i++) {
		expected = (0xff ^ (nc & 0xff));
		/* For each value */
		for (j=0; j<mtype->blksize; j++) {
		    if (p[j] != expected) {
			err++;
			if (mtype->printErrors && err < 10) {
			    printf( "Data expected = %x but got %x for %dth entry\n",
				    expected, p[j], j );
			    fflush( stdout );
			}
		    nc++;
		}
		p += mtype->stride;
	    }
	}
    }
    return err;
}
#endif
#if 0
/* ------------------------------------------------------------------------ */
/* Datatype routines for indexed block datatypes                            */
/* ------------------------------------------------------------------------ */
/* 
 * Setup a buffer for one copy of an indexed datatype. 
 */
static void *MTestTypeIndexedInit( MTestDatatype *mtype )
{
    MPI_Aint totsize;
    
    if (mtype->count > 1) {
	MTestError( "This datatype is supported only for a single count" );
    }
    if (mtype->count == 1) {
	signed char *p;
	int  i, k, offset, j;

	/* Allocate the send/recv buffer */
	MPI_Type_extent( mtype->datatype, &totsize );
	if (!mtype->buf) {
	    mtype->buf = (void *) malloc( totsize );
	}
	p = (signed char *)(mtype->buf);
	if (!p) {
	    MTestError( "Out of memory in type buffer init\n" );
	}
	/* Initialize the elements */
	/* First, set to -1 */
	for (i=0; i<totsize; i++) p[i] = 0xff;

	/* Now, set the actual elements to the successive values.
	   We require that the base type is a contiguous type */
	k = 0;
	for (i=0; i<mtype->nelm; i++) {
	    /* Compute the offset: */
	    offset = mtype->displs[i] * mtype->basesize;
	    for (j=0; j<mtype->basesize; j++) {
		p[offset+j] = 0xff ^ (k++ & 0xff);
	    }
	}
    }
    else {
	/* count == 0 */
	if (mtype->buf) {
	    free( mtype->buf );
	}
	mtype->buf = 0;
    }
    return mtype->buf;
}

/* 
 * Setup indexed buffers for 1 copy of a datatype.  Initialize for
 * reception (e.g., set initial data to detect failure)
 */
static void *MTestTypeIndexInitRecv( MTestDatatype *mtype )
{
    MPI_Aint totsize;
    if (mtype->count > 1) {
	MTestError( "This datatype is supported only for a single count" );
    }
    if (mtype->count == 1) {
	signed char *p;
	int  i;
	MPI_Type_extent( mtype->datatype, &totsize );
	if (!mtype->buf) {
	    mtype->buf = (void *) malloc( totsize );
	}
	p = (signed char *)(mtype->buf);
	if (!p) {
	    /* Error - out of memory */
	    MTestError( "Out of memory in type buffer init\n" );
	}
	for (i=0; i<totsize; i++) {
	    p[i] = 0xff;
	}
    }
    else {
	/* count == 0 */
	if (mtype->buf) {
	    free( mtype->buf );
	}
	mtype->buf = 0;
    }
    return mtype->buf;
}

static void *MTestTypeIndexFree( MTestDatatype *mtype )
{
    if (mtype->buf) {
	free( mtype->buf );
	free( mtype->displs );
	mtype->buf    = 0;
	mtype->displs = 0;
    }
    return 0;
}
static int MTestTypeIndexCheckbuf( MTestDatatype *mtype )
{
    unsigned char *p;
    unsigned char expected;
    int  i, err = 0;
    MPI_Aint totsize;

    p = (unsigned char *)mtype->buf;
    if (p) {
	int j, k, offset;
	MPI_Type_extent( mtype->datatype, &totsize );
	
	k = 0;
	for (i=0; i<mtype->nelm; i++) {
	    /* Compute the offset: */
	    offset = mtype->displs[i] * mtype->basesize;
	    for (j=0; j<mtype->basesize; j++) {
		expected = (0xff ^ (k & 0xff));
		if (p[offset+j] != expected) {
		    err++;
		    if (mtype->printErrors && err < 10) {
			printf( "Data expected = %x but got %x for %dth entry\n",
				expected, p[offset+j], k );
			fflush( stdout );
		    }
		}
		k++;
	    }
	}
    }
    return err;
}
#endif /* 0 */
/* ------------------------------------------------------------------------ */
/* Routines to select a datatype and associated buffer create/fill/check    */
/* routines                                                                 */
/* ------------------------------------------------------------------------ */

/* 
   Create a range of datatypes with a given count elements.
   This uses a selection of types, rather than an exhaustive collection.
   It allocates both send and receive types so that they can have the same
   type signature (collection of basic types) but different type maps (layouts
   in memory) 
 */
int MTestGetDatatypes( MTestDatatype *sendtype, MTestDatatype *recvtype,
		       int count )
{
    sendtype->InitBuf	  = 0;
    sendtype->FreeBuf	  = 0;
    sendtype->CheckBuf	  = 0;
    sendtype->datatype	  = 0;
    sendtype->isBasic	  = 0;
    sendtype->printErrors = 0;
    recvtype->InitBuf	  = 0;
    recvtype->FreeBuf	  = 0;
    recvtype->CheckBuf	  = 0;
    recvtype->datatype	  = 0;
    recvtype->isBasic	  = 0;
    recvtype->printErrors = 0;

    sendtype->buf	  = 0;
    recvtype->buf	  = 0;

    /* Set the defaults for the message lengths */
    sendtype->count	  = count;
    recvtype->count	  = count;
    /* Use datatype_index to choose a datatype to use.  If at the end of the
       list, return 0 */
    switch (datatype_index) {
    case 0:
	sendtype->datatype = MPI_INT;
	sendtype->isBasic  = 1;
	recvtype->datatype = MPI_INT;
	recvtype->isBasic  = 1;
	break;
    case 1:
	sendtype->datatype = MPI_DOUBLE;
	sendtype->isBasic  = 1;
	recvtype->datatype = MPI_DOUBLE;
	recvtype->isBasic  = 1;
	break;
    case 2:
	sendtype->datatype = MPI_INT;
	sendtype->isBasic  = 1;
	recvtype->datatype = MPI_BYTE;
	recvtype->isBasic  = 1;
	recvtype->count    *= sizeof(int);
	break;
    case 3:
	sendtype->datatype = MPI_FLOAT_INT;
	sendtype->isBasic  = 1;
	recvtype->datatype = MPI_FLOAT_INT;
	recvtype->isBasic  = 1;
	break;
    case 4:
	MPI_Type_dup( MPI_INT, &sendtype->datatype );
	MPI_Type_set_name( sendtype->datatype, "dup of MPI_INT" );
	MPI_Type_dup( MPI_INT, &recvtype->datatype );
	MPI_Type_set_name( recvtype->datatype, "dup of MPI_INT" );
	/* dup'ed types are already committed if the original type 
	   was committed (MPI-2, section 8.8) */
	break;
    case 5:
	/* vector send type and contiguous receive type */
	/* These sizes are in bytes (see the VectorInit code) */
	sendtype->stride   = 3 * sizeof(int);
	sendtype->blksize  = sizeof(int);
	sendtype->nelm     = recvtype->count;

	MPI_Type_vector( recvtype->count, 1, 3, MPI_INT, 
			 &sendtype->datatype );
        MPI_Type_commit( &sendtype->datatype );
	MPI_Type_set_name( sendtype->datatype, "int-vector" );
	sendtype->count    = 1;
	recvtype->datatype = MPI_INT;
	recvtype->isBasic  = 1;
	sendtype->InitBuf  = MTestTypeVectorInit;
	recvtype->InitBuf  = MTestTypeContigInitRecv;
	sendtype->FreeBuf  = MTestTypeVectorFree;
	recvtype->FreeBuf  = MTestTypeContigFree;
	sendtype->CheckBuf = 0;
	recvtype->CheckBuf = MTestTypeContigCheckbuf;
	break;
#if 0
    case 6:
	/* vector recv type and contiguous send type */
	/* These sizes are in bytes (see the VectorInit code) */
	recvtype->stride   = 4 * sizeof(int);
	recvtype->blksize  = sizeof(int);
	recvtype->nelm     = recvtype->count;

	MPI_Type_vector( sendtype->count, 1, 4, MPI_INT, 
			 &recvtype->datatype );
        MPI_Type_commit( &recvtype->datatype );
	MPI_Type_set_name( recvtype->datatype, "int-vector" );
	recvtype->count    = 1;
	sendtype->datatype = MPI_INT;
	sendtype->isBasic  = 1;