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

   1 #include "mpi.h"
   2 #include <stdio.h>
   3 #include <stdlib.h>
   4
   5 #if defined(NEEDS_STDLIB_PROTOTYPES)
   6 #include "protofix.h"
   7 #endif
   8
   9 /*
  10  * This example causes the IBM SP2 MPI version to generate the message
  11  * ERROR: 0032-158 Persistent request already active  (2) in MPI_Startall, task 0
  12  * in the SECOND set of MPI_Startall (after the MPI_Request_free).
  13  */
  14 int main( int argc, char **argv )
  15 {
  16     MPI_Request r[4];
  17     MPI_Status  statuses[4];
  18     double sbuf1[10], sbuf2[10];
  19     double rbuf1[10], rbuf2[10];
  20     int size, rank, up_nbr, down_nbr, i;
  21
  22     MPI_Init( &argc, &argv );
  23     MPI_Comm_size( MPI_COMM_WORLD, &size );
  24     MPI_Comm_rank( MPI_COMM_WORLD, &rank );
  25
  26     up_nbr = (rank + 1) % size;
  27     down_nbr = (size + rank - 1) % size;
  28
  29     MPI_Recv_init( rbuf1, 10, MPI_DOUBLE, down_nbr, 0, MPI_COMM_WORLD, &r[0] );
  30     MPI_Recv_init( rbuf2, 10, MPI_DOUBLE, up_nbr, 1, MPI_COMM_WORLD, &r[1] );
  31     MPI_Send_init( sbuf1, 10, MPI_DOUBLE, up_nbr, 0, MPI_COMM_WORLD, &r[2] );
  32     MPI_Send_init( sbuf2, 10, MPI_DOUBLE, down_nbr, 1, MPI_COMM_WORLD, &r[3] );
  33     MPI_Startall( 4, r );
  34     MPI_Waitall( 4, r, statuses );
  35
  36     for (i=0; i<4; i++) {
  37         MPI_Request_free( &r[i] );
  38         }
  39
  40     MPI_Recv_init( rbuf1, 10, MPI_DOUBLE, down_nbr, 0, MPI_COMM_WORLD, &r[0] );
  41     MPI_Recv_init( rbuf2, 10, MPI_DOUBLE, up_nbr, 1, MPI_COMM_WORLD, &r[1] );
  42     MPI_Send_init( sbuf1, 10, MPI_DOUBLE, up_nbr, 0, MPI_COMM_WORLD, &r[2] );
  43     MPI_Send_init( sbuf2, 10, MPI_DOUBLE, down_nbr, 1, MPI_COMM_WORLD, &r[3] );
  44     MPI_Startall( 4, r );
  45     MPI_Waitall( 4, r, statuses );
  46
  47     for (i=0; i<4; i++) {
  48         MPI_Request_free( &r[i] );
  49         }
  50
  51     if (rank == 0) printf( " No Errors\n" );
  52     MPI_Finalize();
  53     return 0;
  54 }