c Matrix-vector multiply, with spawning of slaves
      PROGRAM main
      include 'mpif.h'
      integer MAX_ROWS, MAX_COLS
      parameter (MAX_ROWS = 1000, MAX_COLS = 1000)
      double precision a(MAX_ROWS,MAX_COLS), b(MAX_COLS), c(MAX_COLS)
      double precision buffer(MAX_COLS), ans
      integer slavecomm
c    
      integer ierr, stat(MPI_STATUS_SIZE)
      integer i, j, numsent, numrcvd, sender, numslaves
      integer anstype, rows, cols
      integer softinfo
      integer (kind=MPI_ADDRESS_KIND) universe_size
      logical universe_size_flag
      integer numslaves, i, errcodes(10)
c    
      call MPI_INIT(ierr)
c
      call MPI_COMM_GET_ATTR(MPI_COMM_WORLD, MPI_UNIVERSE_SIZE, 
     *     universe_size, universe_size_flag, ierr)
      if (universe_size_flag) then
         call MPI_COMM_SPAWN('slave', MPI_ARGV_NULL, universe_size-1,
     *        MPI_INFO_NULL, 0, MPI_COMM_WORLD,
     *        slavecomm, errcodes, ierr)
      else 
         call MPI_INFO_CREATE(softinfo, ierr)
         call MPI_INFO_SET(softinfo, 'soft', '1:10', ierr)
         call MPI_COMM_SPAWN('slave', MPI_ARGV_NULL, 10, 
     *        softinfo, 0, MPI_COMM_WORLD, 
     *        slavecomm, errcodes, ierr)
         call MPI_INFO_FREE(softinfo, ierr)
      endif
      call MPI_COMM_REMOTE_SIZE(slavecomm, numslaves, ierr)
      do i=1, 10
         if (errcodes(i) .ne. MPI_SUCCESS) then
            print *, 'slave ', i, ' did not start'
         endif
      enddo
      print *, 'number of slaves = ', numslaves
c     master initializes and then dispatches
      rows   = 100
      cols   = 100
c     initialize a and b
      do 20 i = 1,cols
         b(i) = 1
         do 10 j = 1,rows
            a(i,j) = i
 10      continue
 20   continue
      numsent = 0
      numrcvd = 0
c     send b to each slave
      call MPI_BCAST(b, cols, MPI_DOUBLE_PRECISION, MPI_ROOT, 
     *     slavecomm, ierr)

c     send a row to each slave; tag with row number
      do 40 i = 1,numslaves
         do 30 j = 1,cols
            buffer(j) = a(i,j)
 30      continue
         call MPI_SEND(buffer, cols, MPI_DOUBLE_PRECISION, i-1, 
     *        i, slavecomm, ierr)
         numsent = numsent+1
 40   continue
      do 70 i = 1,rows
         call MPI_RECV(ans, 1, MPI_DOUBLE_PRECISION, 
     *        MPI_ANY_SOURCE, MPI_ANY_TAG, 
     *        slavecomm, stat, ierr)
         sender     = stat(MPI_SOURCE)
         anstype    = stat(MPI_TAG)
         c(anstype) = ans
         if (numsent .lt. rows) then
            do 50 j = 1,cols
               buffer(j) = a(numsent+1,j)
 50         continue
            call MPI_SEND(buffer, cols, MPI_DOUBLE_PRECISION, 
     *           sender, numsent+1, slavecomm, ierr)
            numsent = numsent+1
         else
            call MPI_SEND(buffer, 0, MPI_DOUBLE_PRECISION, sender, 
     *           0, slavecomm, ierr)
         endif
 70   continue
c
c     print out the answer
      do 80 i = 1,cols
         print *, "c(", i, ") = ", c(i)
 80   continue
      call MPI_COMM_FREE(slavecomm, ierr)
      call MPI_FINALIZE(ierr)
      END