teshsuite/smpi/mpich3-test/f90/pt2pt/statusesf90.f90

   1 ! This file created from test/mpi/f77/pt2pt/statusesf.f with f77tof90
   2 ! -*- Mode: Fortran; -*-
   3 !
   4 !  (C) 2003 by Argonne National Laboratory.
   5 !      See COPYRIGHT in top-level directory.
   6 !
   7       program main
   8 !     Test support for MPI_STATUS_IGNORE and MPI_STATUSES_IGNORE
   9       use mpi
  10       integer nreqs
  11       parameter (nreqs = 100)
  12       integer reqs(nreqs)
  13       integer ierr, rank, i
  14       integer errs
  15
  16       ierr = -1
  17       errs = 0
  18       call mpi_init( ierr )
  19       if (ierr .ne. MPI_SUCCESS) then
  20          errs = errs + 1
  21          print *, 'Unexpected return from MPI_INIT', ierr
  22       endif
  23
  24       ierr = -1
  25       call mpi_comm_rank( MPI_COMM_WORLD, rank, ierr )
  26       if (ierr .ne. MPI_SUCCESS) then
  27          errs = errs + 1
  28          print *, 'Unexpected return from MPI_COMM_WORLD', ierr
  29       endif
  30       do i=1, nreqs, 2
  31          ierr = -1
  32          call mpi_isend( MPI_BOTTOM, 0, MPI_BYTE, rank, i, &
  33       &        MPI_COMM_WORLD, reqs(i), ierr )
  34          if (ierr .ne. MPI_SUCCESS) then
  35             errs = errs + 1
  36             print *, 'Unexpected return from MPI_ISEND', ierr
  37          endif
  38          ierr = -1
  39          call mpi_irecv( MPI_BOTTOM, 0, MPI_BYTE, rank, i, &
  40       &        MPI_COMM_WORLD, reqs(i+1), ierr )
  41          if (ierr .ne. MPI_SUCCESS) then
  42             errs = errs + 1
  43             print *, 'Unexpected return from MPI_IRECV', ierr
  44          endif
  45       enddo
  46
  47       ierr = -1
  48       call mpi_waitall( nreqs, reqs, MPI_STATUSES_IGNORE, ierr )
  49       if (ierr .ne. MPI_SUCCESS) then
  50          errs = errs + 1
  51          print *, 'Unexpected return from MPI_WAITALL', ierr
  52       endif
  53
  54       call mtest_finalize( errs )
  55       call mpi_finalize( ierr )
  56       end