teshsuite/smpi/mpich-test/env/baseattrf.f

   1
   2       program main
   3       integer err, ierr
   4       integer v
   5       logical  flag
   6       integer  rank, size
   7       include 'mpif.h'
   8
   9       err = 0
  10       call MPI_Init( ierr )
  11       call MPI_Comm_size( MPI_COMM_WORLD, size, ierr )
  12       call MPI_Comm_rank( MPI_COMM_WORLD, rank, ierr )
  13       call MPI_Attr_get( MPI_COMM_WORLD, MPI_TAG_UB, v, flag, ierr )
  14       if (.not. flag .or. v .lt. 32767) then
  15          err = err + 1
  16          print *, 'Could not get TAG_UB or got too-small value', v
  17       endif
  18 c
  19       call MPI_Attr_get( MPI_COMM_WORLD, MPI_HOST, v, flag, ierr )
  20       if (.not. flag .or. ((v .lt. 0 .or. v .ge. size) .and.
  21      *                     v .ne. MPI_PROC_NULL)) then
  22          err = err + 1
  23          print *, 'Could not get HOST or got invalid value', v
  24       endif
  25 c
  26       call MPI_Attr_get( MPI_COMM_WORLD, MPI_IO, v, flag, ierr )
  27       if (.not. flag .or. (( v .lt. 0 .or. v .gt. size) .and.
  28      *                       v .ne. MPI_PROC_NULL .and.
  29      *                       v .ne. MPI_ANY_SOURCE)) then
  30          err = err + 1
  31          print *, 'Could not get IO or got invalid value', v
  32       endif
  33       call MPI_Finalize( ierr )
  34
  35       end