! -*- Mode: Fortran; -*-

!

!  (C) 2014 by Argonne National Laboratory.

!      See COPYRIGHT in top-level directory.

!

      program main

      use mpi_f08

      integer (kind=MPI_OFFSET_KIND) offset

      integer errs, ierr, size, rank

      type(MPI_File) fh

      type(MPI_Comm) comm

      type(MPI_Status) status

      integer buf(1024)

      errs = 0

      call MTest_Init( ierr )

!    This test reads a header then sets the view to every "size" int,

!    using set view and current displacement.  The file is first written

!    using a combination of collective and ordered writes

      comm = MPI_COMM_WORLD

      call MPI_File_open( comm, "test.ord", MPI_MODE_WRONLY + &

      &     MPI_MODE_CREATE, MPI_INFO_NULL, fh, ierr )

      if (ierr .ne. MPI_SUCCESS) then

         errs = errs + 1

         call MTestPrintErrorMsg( "Open(1)", ierr )

      endif

      call MPI_Comm_size( comm, size, ierr )

      call MPI_Comm_rank( comm, rank, ierr )

      if (size .gt. 1024) then

         if (rank .eq. 0) then

            print *,  &

      &"This program must be run with no more than 1024 processes"

            call MPI_Abort( MPI_COMM_WORLD, 1, ierr )

         endif

      endif

      buf(1) = size

      call MPI_File_write_all( fh, buf, 1, MPI_INTEGER, status, ierr )

      if (ierr .ne. MPI_SUCCESS) then

         errs = errs + 1

         call MTestPrintErrorMsg( "Write_all", ierr )

      endif

      call MPI_File_get_position( fh, offset, ierr )

      if (ierr .ne. MPI_SUCCESS) then

         errs = errs + 1

         call MTestPrintErrorMsg( "Get_position", ierr )

      endif

      call MPI_File_seek_shared( fh, offset, MPI_SEEK_SET, ierr )

      if (ierr .ne. MPI_SUCCESS) then

         errs = errs + 1

         call MTestPrintErrorMsg( "Seek_shared", ierr )

      endif

      buf(1) = rank

      call MPI_File_write_ordered( fh, buf, 1, MPI_INTEGER, status,ierr)

      if (ierr .ne. MPI_SUCCESS) then

         errs = errs + 1

         call MTestPrintErrorMsg( "Write_ordered", ierr )

      endif

      call MPI_File_close( fh, ierr )

      if (ierr .ne. MPI_SUCCESS) then

         errs = errs + 1

         call MTestPrintErrorMsg( "Close(1)", ierr )

      endif

! Reopen the file as sequential

      call MPI_File_open( comm, "test.ord", MPI_MODE_RDONLY + &

      &     MPI_MODE_SEQUENTIAL + MPI_MODE_DELETE_ON_CLOSE, &

      &     MPI_INFO_NULL, fh, ierr )

      if (ierr .ne. MPI_SUCCESS) then

         errs = errs + 1

         call MTestPrintErrorMsg( "Open(Read)", ierr )

      endif

      if (rank .eq. 0) then

         call MPI_File_read_shared( fh, buf, 1, MPI_INTEGER, status, &

      &        ierr )

         if (ierr .ne. MPI_SUCCESS) then

            errs = errs + 1

            call MTestPrintErrorMsg( "Read_all", ierr )

         endif

         if (buf(1) .ne. size) then

           errs = errs + 1

           print *, "Unexpected value for the header = ", buf(1), &

      &          ", should be ", size

        endif

      endif

      call MPI_Barrier( comm, ierr  )

!   All processes must provide the same file view for MODE_SEQUENTIAL

      call MPI_File_set_view( fh, MPI_DISPLACEMENT_CURRENT, MPI_INTEGER &

      &     ,MPI_INTEGER, "native", MPI_INFO_NULL, ierr )

      if (ierr .ne. MPI_SUCCESS) then

         errs = errs + 1

         call MTestPrintErrorMsg( "Set_view", ierr )

      endif

      buf(1) = -1

      call MPI_File_read_ordered( fh, buf, 1, MPI_INTEGER, status, ierr &

      &     )

      if (ierr .ne. MPI_SUCCESS) then

         errs = errs + 1

         call MTestPrintErrorMsg( "Read_all", ierr )

      endif

      if (buf(1) .ne. rank) then

         errs = errs + 1

         print *, rank, ": buf(1) = ", buf(1)

      endif

      call MPI_File_close( fh, ierr )

      if (ierr .ne. MPI_SUCCESS) then

         errs = errs + 1

         call MTestPrintErrorMsg( "Close(2)", ierr )

      endif

      call MTest_Finalize( errs )

      end