teshsuite/smpi/mpich-test/pt2pt/irsend.c

   1 #include "mpi.h"
   2 #include <stdio.h>
   3 #include <stdlib.h>
   4 #include "dtypes.h"
   5 #include "gcomm.h"
   6
   7 #if defined(NEEDS_STDLIB_PROTOTYPES)
   8 #include "protofix.h"
   9 #endif
  10
  11 int verbose = 0;
  12 /* Nonblocking ready sends
  13
  14    This is similar to a test in allpair.f, but with an expanded range of
  15    datatypes and communicators.
  16  */
  17
  18 int main( int argc, char **argv )
  19 {
  20     MPI_Datatype *types;
  21     void         **inbufs, **outbufs;
  22     char         **names;
  23     int          *counts, *bytesize, ntype;
  24     MPI_Comm     comms[20];
  25     int          ncomm = 20, rank, np, partner, tag;
  26     int          i, j, k, err, toterr, world_rank, errloc;
  27     MPI_Status   status, statuses[2];
  28     int          flag, index;
  29     char         *obuf;
  30     MPI_Request  requests[2];
  31
  32
  33     MPI_Init( &argc, &argv );
  34
  35     AllocateForData( &types, &inbufs, &outbufs, &counts, &bytesize,
  36                      &names, &ntype );
  37     GenerateData( types, inbufs, outbufs, counts, bytesize, names, &ntype );
  38
  39     MPI_Comm_rank( MPI_COMM_WORLD, &world_rank );
  40     MakeComms( comms, 20, &ncomm, 0 );
  41
  42 /* Test over a wide range of datatypes and communicators */
  43     err = 0;
  44     for (i=0; i<ncomm; i++) {
  45         MPI_Comm_rank( comms[i], &rank );
  46         MPI_Comm_size( comms[i], &np );
  47         if (np < 2) continue;
  48         tag = i;
  49         for (j=0; j<ntype; j++) {
  50             if (world_rank == 0 && verbose)
  51                 fprintf( stdout, "Testing type %s\n", names[j] );
  52             /* This test does an irsend between both partners, with
  53                a sendrecv after the irecv used to guarentee that the
  54                irsend has a matching receive
  55                */
  56             if (rank == 0) {
  57                 partner = np - 1;
  58 #if 0
  59                 MPIR_PrintDatatypePack( stdout, counts[j], types[j], 0, 0 );
  60 #endif
  61                 obuf = outbufs[j];
  62                 for (k=0; k<bytesize[j]; k++)
  63                     obuf[k] = 0;
  64
  65                 MPI_Irecv(outbufs[j], counts[j], types[j], partner, tag,
  66                           comms[i], &requests[0] );
  67
  68                 MPI_Sendrecv( MPI_BOTTOM, 0, MPI_INT, partner, ncomm+i,
  69                               MPI_BOTTOM, 0, MPI_INT, partner, ncomm+i,
  70                               comms[i], &status );
  71
  72                 MPI_Irsend( inbufs[j], counts[j], types[j], partner, tag,
  73                             comms[i], &requests[1] );
  74
  75                 do {
  76                     MPI_Waitany( 2, requests, &index, &status );
  77                 } while (index != 0);
  78
  79                 /* Always the possiblity that the Irsend is still waiting */
  80                 MPI_Waitall( 2, requests, statuses );
  81                 if ((errloc = CheckData( inbufs[j], outbufs[j], bytesize[j] ))) {
  82                     char *p1, *p2;
  83                     fprintf( stderr,
  84                              "Error in data with type %s (type %d on %d) at byte %d\n",
  85                              names[j], j, world_rank, errloc - 1 );
  86                     p1 = (char *)inbufs[j];
  87                     p2 = (char *)outbufs[j];
  88                     fprintf( stderr,
  89                              "Got %x expected %x\n", p1[errloc-1], p2[errloc-1] );
  90                     err++;
  91 #if 0
  92                     MPIR_PrintDatatypeUnpack( stderr, counts[j], types[j],
  93                                               0, 0 );
  94 #endif
  95                 }
  96             }
  97             else if (rank == np - 1) {
  98                 partner = 0;
  99                 obuf = outbufs[j];
 100                 for (k=0; k<bytesize[j]; k++)
 101                     obuf[k] = 0;
 102
 103                 MPI_Irecv(outbufs[j], counts[j], types[j], partner, tag,
 104                           comms[i], &requests[0] );
 105
 106                 MPI_Sendrecv( MPI_BOTTOM, 0, MPI_INT, partner, ncomm+i,
 107                               MPI_BOTTOM, 0, MPI_INT, partner, ncomm+i,
 108                               comms[i], &status );
 109
 110                 /* Wait for irecv to complete */
 111                 do {
 112                     MPI_Test( &requests[0], &flag, &status );
 113                 } while (!flag);
 114                 if ((errloc = CheckData( inbufs[j], outbufs[j], bytesize[j] ))) {
 115                     char *p1, *p2;
 116                     fprintf( stderr,
 117                              "Error in data with type %s (type %d on %d) at byte %d\n",
 118                              names[j], j, world_rank, errloc - 1 );
 119                     p1 = (char *)inbufs[j];
 120                     p2 = (char *)outbufs[j];
 121                     fprintf( stderr,
 122                              "Got %x expected %x\n", p1[errloc-1], p2[errloc-1] );
 123                     err++;
 124 #if 0
 125                     MPIR_PrintDatatypeUnpack( stderr, counts[j], types[j],
 126                                               0, 0 );
 127 #endif
 128                 }
 129
 130                 MPI_Irsend( inbufs[j], counts[j], types[j], partner, tag,
 131                             comms[i], &requests[1] );
 132
 133                 MPI_Waitall(1, &requests[1], &status );
 134             }
 135         }
 136     }
 137
 138     if (err > 0) {
 139         fprintf( stderr, "%d errors on %d\n", err, rank );
 140     }
 141     MPI_Allreduce( &err, &toterr, 1, MPI_INT, MPI_SUM, MPI_COMM_WORLD );
 142     if (world_rank == 0) {
 143         if (toterr == 0) {
 144             printf( " No Errors\n" );
 145         }
 146         else {
 147             printf (" Found %d errors\n", toterr );
 148         }
 149     }
 150     FreeDatatypes( types, inbufs, outbufs, counts, bytesize, names, ntype );
 151     FreeComms( comms, ncomm );
 152     MPI_Finalize();
 153
 154     return err;
 155 }