! This file created from f77/attr/commattr4f.f with f77tof90
! -*- Mode: Fortran; -*- 
!
!  (C) 2015 by Argonne National Laboratory.
!      See COPYRIGHT in top-level directory.
!
      program main
!
      use mpi

      integer    ierr
      integer    errs
      logical    found
      integer    comm2
      integer    key
      integer (kind=MPI_ADDRESS_KIND) extrastate, valin, valout, val


      errs = 0
!
!  initialize the mpi environment
!
      call mpi_init(ierr)

      call mpi_comm_create_keyval(MPI_COMM_DUP_FN, &
      &     MPI_NULL_DELETE_FN, &
      &     key, &
      &     extrastate, &
      &     ierr)
!
!  set a value for the attribute
!
      valin = huge(valin)
!
!  set attr in comm_world
!
      call mpi_comm_set_attr(MPI_COMM_WORLD, &
      &     key, &
      &     valin, &
      &     ierr)
      call mpi_comm_get_attr(MPI_COMM_WORLD, &
      &     key, &
      &     valout, &
      &     found, &
      &     ierr)
      if (found .neqv. .true.) then
         print *, "mpi_comm_set_attr reported key, but not found on ", &
      &        "mpi_comm_world"
         errs = errs + 1
      else if (valout .ne. valin) then
         print *, "key found, but valin does not match valout"
         print *, valout, " != ", valin
         errs = errs + 1
      end if
!
!  dup the communicator, attribute should follow
!
      call mpi_comm_dup(MPI_COMM_WORLD, &
      &     comm2, &
      &     ierr)
!
!  get the value for the attribute
!
      call mpi_comm_get_attr(comm2, &
      &     key, &
      &     valout, &
      &     found, &
      &     ierr)
      if (found .neqv. .true.) then
         print *, "mpi_comm_set_attr reported key, but not found on ", &
      &        "duped comm"
         errs = errs + 1
      else if (valout .ne. valin) then
         print *, "key found, but value does not match that on ", &
      &        "mpi_comm_world"
         print *, valout, " != ", valin
         errs = errs + 1
      end if
!
!     free the duped communicator
!
      call mpi_comm_free(comm2, ierr)
!
!     free keyval
!
      call mpi_comm_delete_attr(MPI_COMM_WORLD, &
      &     key, ierr)
      call mpi_comm_free_keyval(key, &
      &     ierr)

      call mtest_finalize( errs )

      end