Blame test/mpi/f90/attr/attrmpi1f90.f90

Packit 0848f5
! This file created from test/mpi/f77/attr/attrmpi1f.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, wsize, wrank, extra, mykey
Packit 0848f5
      integer rvalue, svalue, ncomm
Packit 0848f5
      logical flag
Packit 0848f5
      integer ierr, errs
Packit 0848f5
!
Packit 0848f5
      errs = 0
Packit 0848f5
      call mtest_init( ierr )
Packit 0848f5
      call mpi_comm_size( MPI_COMM_WORLD, wsize, ierr )
Packit 0848f5
      call mpi_comm_rank( MPI_COMM_WORLD, wrank, ierr )
Packit 0848f5
!
Packit 0848f5
!     Simple attribute put and get
Packit 0848f5
!
Packit 0848f5
      call mpi_keyval_create( MPI_NULL_COPY_FN, MPI_NULL_DELETE_FN, &
Packit 0848f5
      &     mykey, extra,ierr ) 
Packit 0848f5
      call mpi_attr_get( MPI_COMM_WORLD, mykey, value, flag, ierr )
Packit 0848f5
      if (flag) then
Packit 0848f5
         errs = errs + 1
Packit 0848f5
         print *, &
Packit 0848f5
      &       "Did not get flag==.false. for attribute that was not set"
Packit 0848f5
      endif
Packit 0848f5
!
Packit 0848f5
      value = 1234567
Packit 0848f5
      svalue = value
Packit 0848f5
      call mpi_attr_put( MPI_COMM_WORLD, mykey, value, ierr )
Packit 0848f5
      value = -9876543
Packit 0848f5
      call mpi_attr_get( MPI_COMM_WORLD, mykey, rvalue, flag, ierr )
Packit 0848f5
      if (.not. flag) then
Packit 0848f5
         errs = errs + 1
Packit 0848f5
         print *, "Did not find attribute after set"
Packit 0848f5
      else
Packit 0848f5
         if (rvalue .ne. svalue) then
Packit 0848f5
            errs = errs + 1
Packit 0848f5
            print *, "Attribute value ", rvalue, " should be ", svalue
Packit 0848f5
         endif
Packit 0848f5
      endif
Packit 0848f5
      value = -123456
Packit 0848f5
      svalue = value
Packit 0848f5
      call mpi_attr_put( MPI_COMM_WORLD, mykey, value, ierr )
Packit 0848f5
      value = 987654
Packit 0848f5
      call mpi_attr_get( MPI_COMM_WORLD, mykey, rvalue, flag, ierr )
Packit 0848f5
      if (.not. flag) then
Packit 0848f5
         errs = errs + 1
Packit 0848f5
         print *, "Did not find attribute after set (neg)"
Packit 0848f5
      else
Packit 0848f5
         if (rvalue .ne. svalue) then
Packit 0848f5
            errs = errs + 1
Packit 0848f5
            print *, "Neg Attribute value ", rvalue," should be ",svalue
Packit 0848f5
         endif
Packit 0848f5
      endif
Packit 0848f5
!      
Packit 0848f5
      call mpi_keyval_free( mykey, ierr )
Packit 0848f5
      call mtest_finalize( errs )
Packit 0848f5
      call mpi_finalize( ierr )
Packit 0848f5
      end