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

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