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     }
 123     sendbuf = 0;
 124     if (myrow == 0 && mycol == 0) {
 125         sendbuf = (double *)malloc( nx * ny * size * sizeof(double) );
 126         if (!sendbuf) {
 127             MPI_Abort( MPI_COMM_WORLD, 1 );
 128         }
 129     }
 130     sendcounts = (int *) malloc( size * sizeof(int) );
 131     scdispls   = (int *)malloc( size * sizeof(int) );
 132
 133     MPI_Type_vector( ny, nx, stride, MPI_DOUBLE, &vec );
 134     blens[0]  = 1;   blens[1] = 1;
 135     types[0]  = vec; types[1] = MPI_UB;
 136     displs[0] = 0;   displs[1] = nx * sizeof(double);
 137
 138     MPI_Type_struct( 2, blens, displs, types, &block );
 139     MPI_Type_free( &vec );
 140     MPI_Type_commit( &block );
 141
 142     /* Set up the transfer */
 143     cnt     = 0;
 144     for (i=0; i<dims[1]; i++) {
 145         for (j=0; j<dims[0]; j++) {
 146             sendcounts[cnt] = 1;
 147             /* Using Cart_coords makes sure that ranks (used by
 148                sendrecv) matches the cartesian coordinates (used to
 149                set data in the matrix) */
 150             MPI_Cart_coords( comm2d, cnt, 2, lcoords );
 151             scdispls[cnt++] = lcoords[0] + lcoords[1] * (dims[0] * ny);
 152         }
 153     }
 154
 155     SetData( sendbuf, recvbuf, nx, ny, myrow, mycol, dims[0], dims[1] );
 156     MPI_Scatterv( sendbuf, sendcounts, scdispls, block,
 157                   recvbuf, nx * ny, MPI_DOUBLE, 0, comm2d );
 158     if((errs = CheckData( recvbuf, nx, ny, myrow, mycol, dims[0], 0 ))) {
 159         fprintf( stdout, "Failed to transfer data\n" );
 160     }
 161
 162     /* once more, but this time passing MPI_IN_PLACE for the root */
 163     SetData( sendbuf, recvbuf, nx, ny, myrow, mycol, dims[0], dims[1] );
 164     MPI_Scatterv( sendbuf, sendcounts, scdispls, block,
 165                   (rank == 0 ? MPI_IN_PLACE : recvbuf), nx * ny, MPI_DOUBLE, 0, comm2d );
 166     errs_in_place = CheckData( recvbuf, nx, ny, myrow, mycol, dims[0], (rank == 0) );
 167     if(errs_in_place) {
 168         fprintf( stdout, "Failed to transfer data (MPI_IN_PLACE)\n" );
 169     }
 170
 171     errs += errs_in_place;
 172     MPI_Allreduce( &errs, &tot_errs, 1, MPI_INT, MPI_SUM, MPI_COMM_WORLD );
 173     if (rank == 0) {
 174         if (tot_errs == 0)
 175             printf( " No Errors\n" );
 176         else
 177             printf( "%d errors in use of MPI_SCATTERV\n", tot_errs );
 178     }
 179
 180     if (sendbuf) free( sendbuf );
 181     free( recvbuf );
 182     free( sendcounts );
 183     free( scdispls );
 184     MPI_Type_free( &block );
 185     MPI_Comm_free( &comm2d );
 186     MPI_Finalize();
 187     return errs;
 188 }
 189
 190