sendrecv4.c

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

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

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

int verbose = 0;
/*
   This program is from mpich/tsuite/pt2pt and should be changed there only.
   It needs gcomm and dtype from mpich/tsuite, and can be run with 
   any number of processes > 1.

   This version sends and receives EVERYTHING from MPI_BOTTOM, by putting
   the data into a structure.

   This code isn't quite correct, since the MPI_Type_struct that is 
   created for the type may not have the correct extent.  
   One possible change is to make the struct type include the count, and
   send/receive one instance of the data item.  

   The GenerateData call should return extents; when the extent of the 
   created structure doesn't match, we can at least issue an error message.
 */
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, count;
int          i, j, k, err, toterr, world_rank, errloc;
MPI_Status   status;
char         *obuf;
MPI_Datatype offsettype;
int          blen;
MPI_Aint     displ, extent, natural_extent;

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] );
        if (rank == 0) {
	    MPI_Address( inbufs[j], &displ );
	    blen = 1;
	    MPI_Type_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) 
		    fprintf( stdout, 
			"... 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;
#if 0
		MPIR_PrintDatatypePack( stdout, counts[j], offsettype, 
					  0, 0 );
#endif
            MPI_Send( MPI_BOTTOM, counts[j], offsettype, partner, tag, 
		      comms[i] );
	    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_Address( outbufs[j], &displ );
	    blen = 1;
	    MPI_Type_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, comms[i], &status );
            /* Test correct */
            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], names[j] );
                err++;
                }
            if (status.MPI_SOURCE != partner) {
		fprintf( stderr, 
			"Error in source (got %d expected %d) with type %s\n",
			 status.MPI_SOURCE, partner, names[j] );
                err++;
                }
            if ((errloc = CheckData( inbufs[j], outbufs[j], bytesize[j] ))) {
		fprintf( stderr, 
                  "Error in data with type %s (type %d on %d) at byte %d\n", 
			 names[j], 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++;
#if 0
		MPIR_PrintDatatypeUnpack( stdout, counts[j], offsettype, 
					  0, 0 );
#endif
                }
	    MPI_Type_free( &offsettype );
            }
	}
    }
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;
}