teshsuite/smpi/mpich3-test/f77/attr/baseattrf.f

   1 C -*- Mode: Fortran; -*-
   2 C
   3 C  (C) 2003 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 value, commsize
  10       logical flag
  11       integer ierr, errs
  12
  13       errs = 0
  14       call mpi_init( ierr )
  15
  16       call mpi_comm_size( MPI_COMM_WORLD, commsize, ierr )
  17       call mpi_attr_get( MPI_COMM_WORLD, MPI_UNIVERSE_SIZE, value, flag
  18      $     , ierr)
  19       ! MPI_UNIVERSE_SIZE need not be set
  20       if (flag) then
  21          if (value .lt. commsize) then
  22             print *, "MPI_UNIVERSE_SIZE is ", value, " less than world "
  23      $           , commsize
  24             errs = errs + 1
  25          endif
  26       endif
  27
  28       call mpi_attr_get( MPI_COMM_WORLD, MPI_LASTUSEDCODE, value, flag,
  29      $     ierr )
  30       ! Last used code must be defined and >= MPI_ERR_LASTCODE
  31       if (flag) then
  32          if (value .lt. MPI_ERR_LASTCODE) then
  33             errs = errs + 1
  34             print *, "MPI_LASTUSEDCODE points to an integer
  35      $           (", value, ") smaller than MPI_ERR_LASTCODE (",
  36      $           MPI_ERR_LASTCODE, ")"
  37          endif
  38       else
  39          errs = errs + 1
  40          print *, "MPI_LASTUSECODE is not defined"
  41       endif
  42
  43       call mpi_attr_get( MPI_COMM_WORLD, MPI_APPNUM, value, flag, ierr )
  44       ! appnum need not be set
  45       if (flag) then
  46          if (value .lt. 0) then
  47             errs = errs + 1
  48             print *, "MPI_APPNUM is defined as ", value,
  49      $           " but must be nonnegative"
  50          endif
  51       endif
  52
  53       ! Check for errors
  54       if (errs .eq. 0) then
  55          print *, " No Errors"
  56       else
  57          print *, " Found ", errs, " errors"
  58       endif
  59
  60       call MPI_Finalize( ierr )
  61
  62       end
  63