! -*- Mode: Fortran; -*- ! ! ! (C) 2012 by Argonne National Laboratory. ! See COPYRIGHT in top-level directory. ! ! This is a MPI-2 version of baseattr2f90.f90 which uses COMM_GET_ATTR ! instead of ATTR_GET, using an address-sized integer instead of ! an INTEGER. program main use mpi integer ierr, errs logical flag integer commsize, commrank integer (KIND=MPI_ADDRESS_KIND) value errs = 0 call mtest_init( ierr ) call mpi_comm_size( MPI_COMM_WORLD, commsize, ierr ) call mpi_comm_rank( MPI_COMM_WORLD, commrank, ierr ) call mpi_comm_get_attr( MPI_COMM_WORLD, MPI_TAG_UB, value, & & flag, ierr ) if (.not. flag) then errs = errs + 1 print *, "Could not get TAG_UB" else if (value .lt. 32767) then errs = errs + 1 print *, "Got too-small value (", value, ") for TAG_UB" endif endif call mpi_comm_get_attr( MPI_COMM_WORLD, MPI_HOST, value, flag& &, ierr ) if (.not. flag) then errs = errs + 1 print *, "Could not get HOST" else if ((value .lt. 0 .or. value .ge. commsize) .and. value .ne. & & MPI_PROC_NULL) then errs = errs + 1 print *, "Got invalid value ", value, " for HOST" endif endif call mpi_comm_get_attr( MPI_COMM_WORLD, MPI_IO, value, flag,& & ierr ) if (.not. flag) then errs = errs + 1 print *, "Could not get IO" else if ((value .lt. 0 .or. value .ge. commsize) .and. value .ne. & & MPI_ANY_SOURCE .and. value .ne. MPI_PROC_NULL) then errs = errs + 1 print *, "Got invalid value ", value, " for IO" endif endif call mpi_comm_get_attr( MPI_COMM_WORLD, MPI_WTIME_IS_GLOBAL,& & value, flag, ierr ) if (flag) then ! Wtime need not be set if (value .lt. 0 .or. value .gt. 1) then errs = errs + 1 print *, "Invalid value for WTIME_IS_GLOBAL (got ", value, & & ")" endif endif call mpi_comm_get_attr( MPI_COMM_WORLD, MPI_APPNUM, value,& & flag, ierr ) ! appnum need not be set if (flag) then if (value .lt. 0) then errs = errs + 1 print *, "MPI_APPNUM is defined as ", value, & & " but must be nonnegative" endif endif call mpi_comm_get_attr( MPI_COMM_WORLD, MPI_UNIVERSE_SIZE,& & value, flag, ierr ) ! MPI_UNIVERSE_SIZE need not be set if (flag) then if (value .lt. commsize) then errs = errs + 1 print *, "MPI_UNIVERSE_SIZE = ", value, & & ", less than comm world (", commsize, ")" endif endif call mpi_comm_get_attr( MPI_COMM_WORLD, MPI_LASTUSEDCODE,& & value, flag, ierr ) ! Last used code must be defined and >= MPI_ERR_LASTCODE if (flag) then if (value .lt. MPI_ERR_LASTCODE) then errs = errs + 1 print *, "MPI_LASTUSEDCODE points to an integer (", & & MPI_ERR_LASTCODE, ") smaller than MPI_ERR_LASTCODE (", & & value, ")" endif else errs = errs + 1 print *, "MPI_LASTUSECODE is not defined" endif call MTEST_Finalize( errs ) end