! This file created from errors/f77/io/uerrhandf.f with f77tof90

! -*- Mode: Fortran; -*- 

!

!  (C) 2013 by Argonne National Laboratory.

!      See COPYRIGHT in top-level directory.

!

      program main

      use mpi

      integer (kind=MPI_ADDRESS_KIND) asize

      integer (kind=MPI_OFFSET_KIND) offset

      integer ierr, rank, i

      integer errs

      external comm_errh_fn, win_errh_fn, file_errh_fn

      integer comm_errh, win_errh, file_errh

      integer winbuf(2), winh, wdup, wdsize, sizeofint, id

      integer fh, status(MPI_STATUS_SIZE)

      common /ec/ iseen

      integer iseen(3)

      save /ec/

      iseen(1) = 0

      iseen(2) = 0

      iseen(3) = 0

      ierr = -1

      errs = 0

      call mtest_init( ierr )

      call mpi_type_size( MPI_INTEGER, sizeofint, ierr )

      call mpi_comm_create_errhandler( comm_errh_fn, comm_errh, ierr )

      if (ierr .ne. MPI_SUCCESS) then

         call mtestprinterrormsg( "Comm_create_errhandler:", ierr )

         errs = errs + 1

      endif

      call mpi_win_create_errhandler( win_errh_fn, win_errh, ierr )

      if (ierr .ne. MPI_SUCCESS) then

         call mtestprinterrormsg( "Win_create_errhandler:", ierr )

         errs = errs + 1

      endif

      call mpi_file_create_errhandler( file_errh_fn, file_errh, ierr )

      if (ierr .ne. MPI_SUCCESS) then

         call mtestprinterrormsg( "File_create_errhandler:", ierr )

         errs = errs + 1

      endif

!

      call mpi_comm_dup( MPI_COMM_WORLD, wdup, ierr )

      call mpi_comm_set_errhandler( wdup, comm_errh, ierr )

      call mpi_comm_size( wdup, wdsize, ierr )

      call mpi_send( id, 1, MPI_INTEGER, wdsize, -37, wdup, ierr )

      if (ierr .eq. MPI_SUCCESS) then

         print *, ' Failed to detect error in use of MPI_SEND'

         errs = errs + 1

      else

         if (iseen(1) .ne. 1) then

            errs = errs + 1

            print *, ' Failed to increment comm error counter'

         endif

      endif

      asize = 2*sizeofint

      call mpi_win_create( winbuf, asize, sizeofint, MPI_INFO_NULL &

      &     , wdup, winh, ierr ) 

      if (ierr .ne. MPI_SUCCESS) then

         call mtestprinterrormsg( "Win_create:", ierr )

         errs = errs + 1

      endif

      call mpi_win_set_errhandler( winh, win_errh, ierr )

      asize = 0

      call mpi_put( winbuf, 1, MPI_INT, wdsize, asize, 1, MPI_INT, winh, &

      &     ierr )

      if (ierr .eq. MPI_SUCCESS) then

         print *, ' Failed to detect error in use of MPI_PUT'

         errs = errs + 1

      else

         if (iseen(3) .ne. 1) then

            errs = errs + 1

            print *, ' Failed to increment win error counter'

         endif

      endif

      call mpi_file_open( MPI_COMM_SELF, 'ftest', MPI_MODE_CREATE + &

      &     MPI_MODE_RDWR + MPI_MODE_DELETE_ON_CLOSE, MPI_INFO_NULL, fh, &

      &     ierr ) 

      if (ierr .ne. MPI_SUCCESS) then

         call mtestprinterrormsg( "File_open:", ierr )

         errs = errs + 1

      endif

      call mpi_file_set_errhandler( fh, file_errh, ierr )

      offset = -100

      call mpi_file_read_at( fh, offset, winbuf, 1, MPI_INTEGER, status, &

      &     ierr )

      if (ierr .eq. MPI_SUCCESS) then

         print *, ' Failed to detect error in use of MPI_PUT'

         errs = errs + 1

      else

         if (iseen(2) .ne. 1) then

            errs = errs + 1

            print *, ' Failed to increment file error counter'

         endif

      endif

      call mpi_comm_free( wdup, ierr )

      call mpi_win_free( winh, ierr )

      call mpi_file_close( fh, ierr )

      call mpi_errhandler_free( win_errh, ierr )

      call mpi_errhandler_free( comm_errh, ierr )

      call mpi_errhandler_free( file_errh, ierr )

      call mtest_finalize( errs )

      end

!

      subroutine comm_errh_fn( comm, ec )

      integer comm, ec

      common /ec/ iseen

      integer iseen(3)

      save /ec/

!

      iseen(1) = iseen(1) + 1

!

      end

!

      subroutine win_errh_fn( win, ec )

      integer win, ec

      common /ec/ iseen

      integer iseen(3)

      save /ec/

!

      iseen(3) = iseen(3) + 1

!

      end

      subroutine file_errh_fn( fh, ec )

      integer fh, ec

      common /ec/ iseen

      integer iseen(3)

      save /ec/

!

      iseen(2) = iseen(2) + 1

!

      end