teshsuite/smpi/mpich3-test/coll/scatterv.c

   1 /* -*- Mode: C; c-basic-offset:4 ; indent-tabs-mode:nil ; -*- */
   2 /*
   3  *  (C) 2001 by Argonne National Laboratory.
   4  *      See COPYRIGHT in top-level directory.
   5  */
   6 #include "mpi.h"
   7 #include <stdlib.h>
   8 #include <stdio.h>
   9
  10 /* Prototypes for picky compilers */
  11 void SetData ( double *, double *, int, int, int, int, int, int );
  12 int CheckData ( double *, int, int, int, int, int, int );
  13 /*
  14    This is an example of using scatterv to send a matrix from one
  15    process to all others, with the matrix stored in Fortran order.
  16    Note the use of an explicit UB to enable the sources to overlap.
  17
  18    This tests scatterv to make sure that it uses the datatype size
  19    and extent correctly.  It requires number of processors that
  20    can be split with MPI_Dims_create.
  21
  22  */
  23
  24 void SetData( double *sendbuf, double *recvbuf, int nx, int ny,
  25               int myrow, int mycol, int nrow, int ncol )
  26 {
  27     int coldim, i, j, m, k;
  28     double *p;
  29
  30     if (myrow == 0 && mycol == 0) {
  31         coldim = nx * nrow;
  32         for (j=0; j<ncol; j++) {
  33             for (i=0; i<nrow; i++) {
  34                 p = sendbuf + i * nx + j * (ny * coldim);
  35                 for (m=0; m<ny; m++) {
  36                     for (k=0; k<nx; k++) {
  37                         p[k] = 1000 * j + 100 * i + m * nx + k;
  38                     }
  39                     p += coldim;
  40                 }
  41             }
  42         }
  43     }
  44     for (i=0; i<nx*ny; i++)
  45         recvbuf[i] = -1.0;
  46 }
  47
  48 int CheckData( double *recvbuf,
  49                int nx, int ny, int myrow, int mycol, int nrow,
  50                int expect_no_value )
  51 {
  52     int coldim, m, k;
  53     double *p, val;
  54     int errs = 0;
  55
  56     coldim = nx;
  57     p      = recvbuf;
  58     for (m=0; m<ny; m++) {
  59         for (k=0; k<nx; k++) {
  60             /* If expect_no_value is true then we assume that the pre-scatterv
  61              * value should remain in the recvbuf for our portion of the array.
  62              * This is the case for the root process when using MPI_IN_PLACE. */
  63             if (expect_no_value)
  64                 val = -1.0;
  65             else
  66                 val = 1000 * mycol + 100 * myrow + m * nx + k;
  67
  68             if (p[k] != val) {
  69                 errs++;
  70                 if (errs < 10) {
  71                     printf("Error in (%d,%d) [%d,%d] location, got %f expected %f\n",
  72                             m, k, myrow, mycol, p[k], val );
  73                 }
  74                 else if (errs == 10) {
  75                     printf( "Too many errors; suppressing printing\n" );
  76                 }
  77             }
  78         }
  79         p += coldim;
  80     }
  81     return errs;
  82 }
  83
  84 int main( int argc, char **argv )
  85 {
  86     int rank, size, myrow, mycol, nx, ny, stride, cnt, i, j, errs, errs_in_place, tot_errs;
  87     double    *sendbuf, *recvbuf;
  88     MPI_Datatype vec, block, types[2];
  89     MPI_Aint displs[2];
  90     int      *scdispls;
  91     int      blens[2];
  92     MPI_Comm comm2d;
  93     int dims[2], periods[2], coords[2], lcoords[2];
  94     int *sendcounts;
  95
  96
  97     MPI_Init( &argc, &argv );
  98     MPI_Comm_rank( MPI_COMM_WORLD, &rank );
  99     MPI_Comm_size( MPI_COMM_WORLD, &size );
 100
 101     /* Get a 2-d decomposition of the processes */
 102     dims[0] = 0; dims[1] = 0;
 103     MPI_Dims_create( size, 2, dims );
 104     periods[0] = 0; periods[1] = 0;
 105     MPI_Cart_create( MPI_COMM_WORLD, 2, dims, periods, 0, &comm2d );
 106     MPI_Cart_get( comm2d, 2, dims, periods, coords );
 107     myrow = coords[0];
 108     mycol = coords[1];
 109 /*
 110     if (rank == 0)
 111         printf( "Decomposition is [%d x %d]\n", dims[0], dims[1] );
 112 */
 113
 114     /* Get the size of the matrix */
 115     nx = 10;
 116     ny = 8;
 117     stride = nx * dims[0];
 118
 119     recvbuf = (double *)malloc( nx * ny * sizeof(double) );
 120     if (!recvbuf) {
 121         MPI_Abort( MPI_COMM_WORLD, 1 );
 122         exit(1);
 123     }
 124     sendbuf = 0;
 125     if (myrow == 0 && mycol == 0) {
 126         sendbuf = (double *)malloc( nx * ny * size * sizeof(double) );
 127         if (!sendbuf) {
 128             MPI_Abort( MPI_COMM_WORLD, 1 );
 129             exit(1);
 130         }
 131     }
 132     sendcounts = (int *) malloc( size * sizeof(int) );
 133     scdispls   = (int *)malloc( size * sizeof(int) );
 134
 135     MPI_Type_vector( ny, nx, stride, MPI_DOUBLE, &vec );
 136     blens[0]  = 1;   blens[1] = 1;
 137     types[0]  = vec; types[1] = MPI_UB;
 138     displs[0] = 0;   displs[1] = nx * sizeof(double);
 139
 140     MPI_Type_struct( 2, blens, displs, types, &block );
 141     MPI_Type_free( &vec );
 142     MPI_Type_commit( &block );
 143
 144     /* Set up the transfer */
 145     cnt     = 0;
 146     for (i=0; i<dims[1]; i++) {
 147         for (j=0; j<dims[0]; j++) {
 148             sendcounts[cnt] = 1;
 149             /* Using Cart_coords makes sure that ranks (used by
 150                sendrecv) matches the cartesian coordinates (used to
 151                set data in the matrix) */
 152             MPI_Cart_coords( comm2d, cnt, 2, lcoords );
 153             scdispls[cnt++] = lcoords[0] + lcoords[1] * (dims[0] * ny);
 154         }
 155     }
 156
 157     SetData( sendbuf, recvbuf, nx, ny, myrow, mycol, dims[0], dims[1] );
 158     MPI_Scatterv( sendbuf, sendcounts, scdispls, block,
 159                   recvbuf, nx * ny, MPI_DOUBLE, 0, comm2d );
 160     if((errs = CheckData( recvbuf, nx, ny, myrow, mycol, dims[0], 0 ))) {
 161         fprintf( stdout, "Failed to transfer data\n" );
 162     }
 163
 164     /* once more, but this time passing MPI_IN_PLACE for the root */
 165     SetData( sendbuf, recvbuf, nx, ny, myrow, mycol, dims[0], dims[1] );
 166     MPI_Scatterv( sendbuf, sendcounts, scdispls, block,
 167                   (rank == 0 ? MPI_IN_PLACE : recvbuf), nx * ny, MPI_DOUBLE, 0, comm2d );
 168     errs_in_place = CheckData( recvbuf, nx, ny, myrow, mycol, dims[0], (rank == 0) );
 169     if(errs_in_place) {
 170         fprintf( stdout, "Failed to transfer data (MPI_IN_PLACE)\n" );
 171     }
 172
 173     errs += errs_in_place;
 174     MPI_Allreduce( &errs, &tot_errs, 1, MPI_INT, MPI_SUM, MPI_COMM_WORLD );
 175     if (rank == 0) {
 176         if (tot_errs == 0)
 177             printf( " No Errors\n" );
 178         else
 179             printf( "%d errors in use of MPI_SCATTERV\n", tot_errs );
 180     }
 181
 182     if (sendbuf) free( sendbuf );
 183     free( recvbuf );
 184     free( sendcounts );
 185     free( scdispls );
 186     MPI_Type_free( &block );
 187     MPI_Comm_free( &comm2d );
 188     MPI_Finalize();
 189     return errs;
 190 }
 191
 192