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

Packit Service c5cf8c
! This file created from f77/attr/baseattr2f.f with f77tof90
Packit Service c5cf8c
! -*- Mode: Fortran; -*-
Packit Service c5cf8c
!
Packit Service c5cf8c
!
Packit Service c5cf8c
! (C) 2001 by Argonne National Laboratory.
Packit Service c5cf8c
!     See COPYRIGHT in top-level directory.
Packit Service c5cf8c
!
Packit Service c5cf8c
        program main
Packit Service c5cf8c
        use mpi
Packit Service c5cf8c
        integer ierr, errs
Packit Service c5cf8c
        logical flag
Packit Service c5cf8c
        integer value, commsize, commrank
Packit Service c5cf8c
Packit Service c5cf8c
        errs = 0
Packit Service c5cf8c
        call mpi_init( ierr )
Packit Service c5cf8c
Packit Service c5cf8c
        call mpi_comm_size( MPI_COMM_WORLD, commsize, ierr )
Packit Service c5cf8c
        call mpi_comm_rank( MPI_COMM_WORLD, commrank, ierr )
Packit Service c5cf8c
Packit Service c5cf8c
        call mpi_attr_get( MPI_COMM_WORLD, MPI_TAG_UB, value, flag, ierr &
Packit Service c5cf8c
      &       ) 
Packit Service c5cf8c
        if (.not. flag) then
Packit Service c5cf8c
           errs = errs + 1
Packit Service c5cf8c
           print *, "Could not get TAG_UB"
Packit Service c5cf8c
        else
Packit Service c5cf8c
           if (value .lt. 32767) then
Packit Service c5cf8c
              errs = errs + 1
Packit Service c5cf8c
              print *, "Got too-small value (", value, ") for TAG_UB" 
Packit Service c5cf8c
           endif
Packit Service c5cf8c
        endif
Packit Service c5cf8c
Packit Service c5cf8c
        call mpi_attr_get( MPI_COMM_WORLD, MPI_HOST, value, flag, ierr )
Packit Service c5cf8c
        if (.not. flag) then
Packit Service c5cf8c
           errs = errs + 1
Packit Service c5cf8c
           print *, "Could not get HOST"
Packit Service c5cf8c
        else 
Packit Service c5cf8c
           if ((value .lt. 0 .or. value .ge. commsize) .and. value .ne. &
Packit Service c5cf8c
      &          MPI_PROC_NULL) then 
Packit Service c5cf8c
              errs = errs + 1
Packit Service c5cf8c
              print *, "Got invalid value ", value, " for HOST"
Packit Service c5cf8c
           endif
Packit Service c5cf8c
        endif   
Packit Service c5cf8c
Packit Service c5cf8c
        call mpi_attr_get( MPI_COMM_WORLD, MPI_IO, value, flag, ierr )
Packit Service c5cf8c
        if (.not. flag) then
Packit Service c5cf8c
           errs = errs + 1
Packit Service c5cf8c
           print *, "Could not get IO"
Packit Service c5cf8c
        else
Packit Service c5cf8c
           if ((value .lt. 0 .or. value .ge. commsize) .and. value .ne. &
Packit Service c5cf8c
      &          MPI_ANY_SOURCE .and. value .ne. MPI_PROC_NULL) then
Packit Service c5cf8c
              errs = errs + 1
Packit Service c5cf8c
              print *, "Got invalid value ", value, " for IO"
Packit Service c5cf8c
           endif
Packit Service c5cf8c
        endif
Packit Service c5cf8c
Packit Service c5cf8c
        call mpi_attr_get( MPI_COMM_WORLD, MPI_WTIME_IS_GLOBAL, value, &
Packit Service c5cf8c
      &       flag, ierr )
Packit Service c5cf8c
        if (flag) then
Packit Service c5cf8c
!          Wtime need not be set
Packit Service c5cf8c
           if (value .lt.  0 .or. value .gt. 1) then 
Packit Service c5cf8c
              errs = errs + 1
Packit Service c5cf8c
              print *, "Invalid value for WTIME_IS_GLOBAL (got ", value, &
Packit Service c5cf8c
      &             ")" 
Packit Service c5cf8c
           endif
Packit Service c5cf8c
        endif
Packit Service c5cf8c
Packit Service c5cf8c
        call mpi_attr_get( MPI_COMM_WORLD, MPI_APPNUM, value, flag, ierr &
Packit Service c5cf8c
      &       )
Packit Service c5cf8c
!     appnum need not be set
Packit Service c5cf8c
        if (flag) then
Packit Service c5cf8c
           if (value .lt. 0) then
Packit Service c5cf8c
              errs = errs + 1
Packit Service c5cf8c
              print *, "MPI_APPNUM is defined as ", value, &
Packit Service c5cf8c
      &             " but must be nonnegative" 
Packit Service c5cf8c
           endif
Packit Service c5cf8c
        endif
Packit Service c5cf8c
Packit Service c5cf8c
        call mpi_attr_get( MPI_COMM_WORLD, MPI_UNIVERSE_SIZE, value, &
Packit Service c5cf8c
      &       flag, ierr )
Packit Service c5cf8c
!     MPI_UNIVERSE_SIZE need not be set
Packit Service c5cf8c
        if (flag) then
Packit Service c5cf8c
           if (value .lt. commsize) then
Packit Service c5cf8c
              errs = errs + 1
Packit Service c5cf8c
              print *, "MPI_UNIVERSE_SIZE = ", value, &
Packit Service c5cf8c
      &             ", less than comm world (", commsize, ")"
Packit Service c5cf8c
           endif
Packit Service c5cf8c
        endif
Packit Service c5cf8c
    
Packit Service c5cf8c
        call mpi_attr_get( MPI_COMM_WORLD, MPI_LASTUSEDCODE, value, flag &
Packit Service c5cf8c
      &       , ierr )
Packit Service c5cf8c
! Last used code must be defined and >= MPI_ERR_LASTCODE
Packit Service c5cf8c
        if (flag) then
Packit Service c5cf8c
           if (value .lt. MPI_ERR_LASTCODE) then
Packit Service c5cf8c
            errs = errs + 1
Packit Service c5cf8c
            print *, "MPI_LASTUSEDCODE points to an integer (", &
Packit Service c5cf8c
      &           MPI_ERR_LASTCODE, ") smaller than MPI_ERR_LASTCODE (", &
Packit Service c5cf8c
      &           value, ")"
Packit Service c5cf8c
            endif
Packit Service c5cf8c
         else 
Packit Service c5cf8c
            errs = errs + 1
Packit Service c5cf8c
            print *, "MPI_LASTUSECODE is not defined"
Packit Service c5cf8c
         endif
Packit Service c5cf8c
Packit Service c5cf8c
!     Check for errors
Packit Service c5cf8c
      if (errs .eq. 0) then
Packit Service c5cf8c
         print *, " No Errors"
Packit Service c5cf8c
      else
Packit Service c5cf8c
         print *, " Found ", errs, " errors"
Packit Service c5cf8c
      endif
Packit Service c5cf8c
Packit Service c5cf8c
      call MPI_Finalize( ierr )
Packit Service c5cf8c
Packit Service c5cf8c
      end