irsendinit.c

MPICH是MPI的重要研究,提供了一系列的接口函数,为并行计算的实现提供了编程环境.

#include "mpi.h"
#include <stdio.h>
#include <stdlib.h>
#include "dtypes.h"
#include "gcomm.h"

#if defined(NEEDS_STDLIB_PROTOTYPES)
#include "protofix.h"
#endif

int verbose = 0;
/* Nonblocking ready persistent sends 
   
   This is similar to a test in allpair.f, but with an expanded range of
   datatypes and communicators.

   This is like irsend.c, but with multiple starts of the same persistent
   request.
 */

int main( int argc, char **argv )
{
    MPI_Datatype *types;
    void         **inbufs, **outbufs;
    char         **names;
    int          *counts, *bytesize, ntype;
    MPI_Comm     comms[20];
    int          ncomm = 20, rank, np, partner, tag;
    int          i, j, k, err, toterr, world_rank, errloc;
    MPI_Status   status;
    int          flag, index;
    char         *obuf;
    MPI_Request  requests[2];
    int          mcnt;


    MPI_Init( &argc, &argv );

    AllocateForData( &types, &inbufs, &outbufs, &counts, &bytesize, 
		     &names, &ntype );
    GenerateData( types, inbufs, outbufs, counts, bytesize, names, &ntype );

    MPI_Comm_rank( MPI_COMM_WORLD, &world_rank );
    MakeComms( comms, 20, &ncomm, 0 );

/* Test over a wide range of datatypes and communicators */
    err = 0;
    for (i=0; i<ncomm; i++) {
	MPI_Comm_rank( comms[i], &rank );
	MPI_Comm_size( comms[i], &np );
	if (np < 2) continue;
	tag = i;
	for (j=0; j<ntype; j++) {
	    if (world_rank == 0 && verbose) 
		fprintf( stdout, "Testing type %s\n", names[j] );
	    /* This test does an irsend between both partners, with 
	       a sendrecv after the irecv used to guarentee that the
	       irsend has a matching receive
	       */
	    if (rank == 0) {
		partner = np - 1;
#if 0
		MPIR_PrintDatatypePack( stdout, counts[j], types[j], 0, 0 );
#endif
		obuf = outbufs[j];
		for (k=0; k<bytesize[j]; k++) 
		    obuf[k] = 0;
	    
		MPI_Recv_init(outbufs[j], counts[j], types[j], partner, tag, 
			      comms[i], &requests[0] );
		MPI_Rsend_init( inbufs[j], counts[j], types[j], partner, tag, 
				comms[i], &requests[1] );
	    
		for (mcnt=0; mcnt<10; mcnt++) {
		    MPI_Start( &requests[0] );
		    MPI_Sendrecv( MPI_BOTTOM, 0, MPI_INT, partner, ncomm+i, 
				  MPI_BOTTOM, 0, MPI_INT, partner, ncomm+i, 
				  comms[i], &status );
		    MPI_Start( &requests[1] );
		    do {
			MPI_Waitany( 2, requests, &index, &status );
		    } while (index != 0);
		    
		    if ((errloc = CheckData( inbufs[j], outbufs[j], 
					     bytesize[j] ))) {
			char *p1, *p2;
			fprintf( stderr, 
    "Error in data with type %s (type %d on %d) at byte %d in %dth test\n", 
				 names[j], j, world_rank, errloc - 1, mcnt );
			p1 = (char *)inbufs[j];
			p2 = (char *)outbufs[j];
			fprintf( stderr, 
			"Got %x expected %x\n", p1[errloc-1], p2[errloc-1] );
			err++;
#if 0
			MPIR_PrintDatatypeUnpack( stderr, counts[j], types[j], 
						  0, 0 );
#endif
		    }
		    MPI_Waitall(1, &requests[1], &status );
		}
		MPI_Request_free( &requests[0] );
		MPI_Request_free( &requests[1] );
	    }
	    else if (rank == np - 1) {
		partner = 0;
		obuf = outbufs[j];
		for (k=0; k<bytesize[j]; k++) 
		    obuf[k] = 0;
	    
		MPI_Recv_init(outbufs[j], counts[j], types[j], partner, tag, 
			      comms[i], &requests[0] );
		MPI_Rsend_init( inbufs[j], counts[j], types[j], partner, tag, 
				comms[i], &requests[1] );
		for (mcnt=0; mcnt<10; mcnt++) {
		    MPI_Start( &requests[0] );
		    MPI_Sendrecv( MPI_BOTTOM, 0, MPI_INT, partner, ncomm+i, 
				  MPI_BOTTOM, 0, MPI_INT, partner, ncomm+i, 
				  comms[i], &status );
		    MPI_Start( &requests[1] );
		    /* Wait for irecv to complete */
		    do {
			MPI_Test( &requests[0], &flag, &status );
		    } while (!flag);
		    if ((errloc = CheckData( inbufs[j], outbufs[j], 
					     bytesize[j] ))) {
			char *p1, *p2;
			fprintf( stderr, 
		    "Error in data with type %s (type %d on %d) at byte %d\n", 
				 names[j], j, world_rank, errloc - 1 );
			p1 = (char *)inbufs[j];
			p2 = (char *)outbufs[j];
			fprintf( stderr, 
		        "Got %x expected %x\n", p1[errloc-1], p2[errloc-1] );
			err++;
#if 0
			MPIR_PrintDatatypeUnpack( stderr, counts[j], types[j], 
					      0, 0 );
#endif
		    }

		    MPI_Waitall(1, &requests[1], &status );
		}
		MPI_Request_free( &requests[0] );
		MPI_Request_free( &requests[1] );
	    }
	}
    }

    if (err > 0) {
	fprintf( stderr, "%d errors on %d\n", err, rank );
    }
    MPI_Allreduce( &err, &toterr, 1, MPI_INT, MPI_SUM, MPI_COMM_WORLD );
    if (world_rank == 0) {
	if (toterr == 0) {
	    printf( " No Errors\n" );
	}
	else {
	    printf (" Found %d errors\n", toterr );
	}
    }
    FreeDatatypes( types, inbufs, outbufs, counts, bytesize, names, ntype );
    FreeComms( comms, ncomm );
    MPI_Finalize();

    return err;
}