Blame test/mpi/f90/attr/baseattr2f90.f90

Packit 0848f5
! This file created from test/mpi/f77/attr/baseattr2f.f with f77tof90
Packit 0848f5
! -*- Mode: Fortran; -*-
Packit 0848f5
!
Packit 0848f5
!
Packit 0848f5
! (C) 2001 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 ierr, errs
Packit 0848f5
        logical flag
Packit 0848f5
        integer value, commsize, commrank
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_comm_rank( MPI_COMM_WORLD, commrank, ierr )
Packit 0848f5
Packit 0848f5
        call mpi_attr_get( MPI_COMM_WORLD, MPI_TAG_UB, value, flag, ierr &
Packit 0848f5
      &       ) 
Packit 0848f5
        if (.not. flag) then
Packit 0848f5
           errs = errs + 1
Packit 0848f5
           print *, "Could not get TAG_UB"
Packit 0848f5
        else
Packit 0848f5
           if (value .lt. 32767) then
Packit 0848f5
              errs = errs + 1
Packit 0848f5
              print *, "Got too-small value (", value, ") for TAG_UB" 
Packit 0848f5
           endif
Packit 0848f5
        endif
Packit 0848f5
Packit 0848f5
        call mpi_attr_get( MPI_COMM_WORLD, MPI_HOST, value, flag, ierr )
Packit 0848f5
        if (.not. flag) then
Packit 0848f5
           errs = errs + 1
Packit 0848f5
           print *, "Could not get HOST"
Packit 0848f5
        else 
Packit 0848f5
           if ((value .lt. 0 .or. value .ge. commsize) .and. value .ne. &
Packit 0848f5
      &          MPI_PROC_NULL) then 
Packit 0848f5
              errs = errs + 1
Packit 0848f5
              print *, "Got invalid value ", value, " for HOST"
Packit 0848f5
           endif
Packit 0848f5
        endif   
Packit 0848f5
Packit 0848f5
        call mpi_attr_get( MPI_COMM_WORLD, MPI_IO, value, flag, ierr )
Packit 0848f5
        if (.not. flag) then
Packit 0848f5
           errs = errs + 1
Packit 0848f5
           print *, "Could not get IO"
Packit 0848f5
        else
Packit 0848f5
           if ((value .lt. 0 .or. value .ge. commsize) .and. value .ne. &
Packit 0848f5
      &          MPI_ANY_SOURCE .and. value .ne. MPI_PROC_NULL) then
Packit 0848f5
              errs = errs + 1
Packit 0848f5
              print *, "Got invalid value ", value, " for IO"
Packit 0848f5
           endif
Packit 0848f5
        endif
Packit 0848f5
Packit 0848f5
        call mpi_attr_get( MPI_COMM_WORLD, MPI_WTIME_IS_GLOBAL, value, &
Packit 0848f5
      &       flag, ierr )
Packit 0848f5
        if (flag) then
Packit 0848f5
!          Wtime need not be set
Packit 0848f5
           if (value .lt.  0 .or. value .gt. 1) then 
Packit 0848f5
              errs = errs + 1
Packit 0848f5
              print *, "Invalid value for WTIME_IS_GLOBAL (got ", value, &
Packit 0848f5
      &             ")" 
Packit 0848f5
           endif
Packit 0848f5
        endif
Packit 0848f5
Packit 0848f5
        call mpi_attr_get( MPI_COMM_WORLD, MPI_APPNUM, value, flag, ierr &
Packit 0848f5
      &       )
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
        call mpi_attr_get( MPI_COMM_WORLD, MPI_UNIVERSE_SIZE, value, &
Packit 0848f5
      &       flag, ierr )
Packit 0848f5
!     MPI_UNIVERSE_SIZE need not be set
Packit 0848f5
        if (flag) then
Packit 0848f5
           if (value .lt. commsize) then
Packit 0848f5
              errs = errs + 1
Packit 0848f5
              print *, "MPI_UNIVERSE_SIZE = ", value, &
Packit 0848f5
      &             ", less than comm world (", commsize, ")"
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
      &           MPI_ERR_LASTCODE, ") smaller than MPI_ERR_LASTCODE (", &
Packit 0848f5
      &           value, ")"
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
!     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