Blame test/mpi/f90/attr/baseattrf90.f90

Packit 0848f5
! This file created from test/mpi/f77/attr/baseattrf.f with f77tof90
Packit 0848f5
! -*- Mode: Fortran; -*- 
Packit 0848f5
!
Packit 0848f5
!  (C) 2003 by Argonne National Laboratory.
Packit 0848f5
!      See COPYRIGHT in top-level directory.
Packit 0848f5
!
Packit 0848f5
      program main
Packit 0848f5
      use mpi
Packit 0848f5
      integer value, commsize
Packit 0848f5
      logical flag
Packit 0848f5
      integer ierr, errs
Packit 0848f5
Packit 0848f5
      errs = 0
Packit 0848f5
      call mpi_init( ierr )
Packit 0848f5
Packit 0848f5
      call mpi_comm_size( MPI_COMM_WORLD, commsize, ierr )
Packit 0848f5
      call mpi_attr_get( MPI_COMM_WORLD, MPI_UNIVERSE_SIZE, value, flag &
Packit 0848f5
      &     , ierr)
Packit 0848f5
      ! MPI_UNIVERSE_SIZE need not be set
Packit 0848f5
      if (flag) then
Packit 0848f5
         if (value .lt. commsize) then
Packit 0848f5
            print *, "MPI_UNIVERSE_SIZE is ", value, " less than world " &
Packit 0848f5
      &           , commsize
Packit 0848f5
            errs = errs + 1
Packit 0848f5
         endif
Packit 0848f5
      endif
Packit 0848f5
Packit 0848f5
      call mpi_attr_get( MPI_COMM_WORLD, MPI_LASTUSEDCODE, value, flag, &
Packit 0848f5
      &     ierr )
Packit 0848f5
      ! Last used code must be defined and >= MPI_ERR_LASTCODE 
Packit 0848f5
      if (flag) then
Packit 0848f5
         if (value .lt. MPI_ERR_LASTCODE) then
Packit 0848f5
            errs = errs + 1
Packit 0848f5
            print *, "MPI_LASTUSEDCODE points to an integer &
Packit 0848f5
      &           (", value, ") smaller than MPI_ERR_LASTCODE (", &
Packit 0848f5
      &           MPI_ERR_LASTCODE, ")"
Packit 0848f5
         endif
Packit 0848f5
      else 
Packit 0848f5
         errs = errs + 1
Packit 0848f5
         print *, "MPI_LASTUSECODE is not defined"
Packit 0848f5
      endif
Packit 0848f5
Packit 0848f5
      call mpi_attr_get( MPI_COMM_WORLD, MPI_APPNUM, value, flag, ierr )
Packit 0848f5
      ! appnum need not be set
Packit 0848f5
      if (flag) then
Packit 0848f5
         if (value .lt. 0) then
Packit 0848f5
            errs = errs + 1
Packit 0848f5
            print *, "MPI_APPNUM is defined as ", value, &
Packit 0848f5
      &           " but must be nonnegative"
Packit 0848f5
         endif
Packit 0848f5
      endif
Packit 0848f5
Packit 0848f5
      ! Check for errors
Packit 0848f5
      if (errs .eq. 0) then
Packit 0848f5
         print *, " No Errors"
Packit 0848f5
      else
Packit 0848f5
         print *, " Found ", errs, " errors"
Packit 0848f5
      endif
Packit 0848f5
Packit 0848f5
      call MPI_Finalize( ierr )
Packit 0848f5
Packit 0848f5
      end
Packit 0848f5