teshsuite/smpi/mpich3-test/f77/coll/nonblockingf.f

   1 C -*- Mode: Fortran; -*-
   2 C
   3 C  (C) 2012 by Argonne National Laboratory.
   4 C      See COPYRIGHT in top-level directory.
   5 C
   6       program main
   7       implicit none
   8       include 'mpif.h'
   9       integer NUM_INTS
  10       parameter (NUM_INTS=2)
  11       integer maxSize
  12       parameter (maxSize=128)
  13       integer scounts(maxSize), sdispls(maxSize)
  14       integer rcounts(maxSize), rdispls(maxSize)
  15       integer types(maxSize)
  16       integer sbuf(maxSize), rbuf(maxSize)
  17       integer comm, size, rank, req
  18       integer ierr, errs
  19       integer ii, ans
  20
  21       errs = 0
  22
  23       call mtest_init(ierr)
  24
  25       comm = MPI_COMM_WORLD
  26       call MPI_Comm_size(comm, size, ierr)
  27       call MPI_Comm_rank(comm, rank, ierr)
  28 C
  29       do ii = 1, size
  30          sbuf(2*ii-1) = ii
  31          sbuf(2*ii)   = ii
  32          sbuf(2*ii-1) = ii
  33          sbuf(2*ii)   = ii
  34          scounts(ii)  = NUM_INTS
  35          rcounts(ii)  = NUM_INTS
  36          sdispls(ii)  = (ii-1) * NUM_INTS
  37          rdispls(ii)  = (ii-1) * NUM_INTS
  38          types(ii)    = MPI_INTEGER
  39       enddo
  40
  41       call MPI_Ibarrier(comm, req, ierr)
  42       call MPI_Wait(req, MPI_STATUS_IGNORE, ierr)
  43
  44       call MPI_Ibcast(sbuf, NUM_INTS, MPI_INTEGER, 0, comm, req, ierr)
  45       call MPI_Wait(req, MPI_STATUS_IGNORE, ierr)
  46
  47       call MPI_Igather(sbuf, NUM_INTS, MPI_INTEGER,
  48      .                  rbuf, NUM_INTS, MPI_INTEGER,
  49      .                  0, comm, req, ierr)
  50       call MPI_Wait(req, MPI_STATUS_IGNORE, ierr)
  51
  52       call MPI_Igatherv(sbuf, NUM_INTS, MPI_INTEGER,
  53      .                   rbuf, rcounts, rdispls, MPI_INTEGER,
  54      .                   0, comm, req, ierr)
  55       call MPI_Wait(req, MPI_STATUS_IGNORE, ierr)
  56
  57       call MPI_Ialltoall(sbuf, NUM_INTS, MPI_INTEGER,
  58      .                    rbuf, NUM_INTS, MPI_INTEGER,
  59      .                    comm, req, ierr)
  60       call MPI_Wait(req, MPI_STATUS_IGNORE, ierr)
  61
  62       call MPI_Ialltoallv(sbuf, scounts, sdispls, MPI_INTEGER,
  63      .                     rbuf, rcounts, rdispls, MPI_INTEGER,
  64      .                     comm, req, ierr)
  65       call MPI_Wait(req, MPI_STATUS_IGNORE, ierr)
  66
  67       call MPI_Ialltoallw(sbuf, scounts, sdispls, types,
  68      .                     rbuf, rcounts, rdispls, types,
  69      .                     comm, req, ierr)
  70       call MPI_Wait(req, MPI_STATUS_IGNORE, ierr)
  71
  72       call MPI_Ireduce(sbuf, rbuf, NUM_INTS, MPI_INTEGER,
  73      .                  MPI_SUM, 0, comm, req, ierr)
  74       call MPI_Wait(req, MPI_STATUS_IGNORE, ierr)
  75
  76       call MPI_Iallreduce(sbuf, rbuf, NUM_INTS, MPI_INTEGER,
  77      .                     MPI_SUM, comm, req, ierr)
  78       call MPI_Wait(req, MPI_STATUS_IGNORE, ierr)
  79
  80       call MPI_Ireduce_scatter(sbuf, rbuf, rcounts, MPI_INTEGER,
  81      .                          MPI_SUM, comm, req, ierr)
  82       call MPI_Wait(req, MPI_STATUS_IGNORE, ierr)
  83
  84       call MPI_Ireduce_scatter_block(sbuf, rbuf, NUM_INTS, MPI_INTEGER,
  85      .                                MPI_SUM, comm, req, ierr)
  86       call MPI_Wait(req, MPI_STATUS_IGNORE, ierr)
  87
  88       call MPI_Iscan(sbuf, rbuf, NUM_INTS, MPI_INTEGER,
  89      .                MPI_SUM, comm, req, ierr)
  90       call MPI_Wait(req, MPI_STATUS_IGNORE, ierr)
  91
  92       call MPI_Iexscan(sbuf, rbuf, NUM_INTS, MPI_INTEGER,
  93      .                  MPI_SUM, comm, req, ierr)
  94       call MPI_Wait(req, MPI_STATUS_IGNORE, ierr)
  95
  96       call mtest_finalize( errs )
  97       call MPI_Finalize( ierr )
  98       end