C -*- Mode: Fortran; -*-

C

C  (C) 2003 by Argonne National Laboratory.

C      See COPYRIGHT in top-level directory.

C

        program main

        implicit none

        include 'mpif.h'

        integer comm, fh, r, s, i

        integer fileintsize

        integer errs, err, ierr

        character *(100) filename

        include 'iooffset.h'

        include 'ioaint.h'

        errs = 0

        call MTest_Init( ierr )

        filename = "iotest.txt"

        comm = MPI_COMM_WORLD

        call mpi_comm_size( comm, s, ierr )

        call mpi_comm_rank( comm, r, ierr )

C Try writing the file, then check it

        call mpi_file_open( comm, filename, MPI_MODE_RDWR + 

     &                      MPI_MODE_CREATE, MPI_INFO_NULL, fh, ierr )

        if (ierr .ne. MPI_SUCCESS) then

           errs = errs + 1

           if (errs .le. 10) then

              call MTestPrintError( ierr )

           endif

        endif

C

C Get the size of an INTEGER in the file

        call mpi_file_get_type_extent( fh, MPI_INTEGER, aint, ierr )

        fileintsize = aint

C

C We let each process write in turn, getting the position after each 

C write

        do i=1, s

           if (i .eq. r + 1) then

              call mpi_file_write_shared( fh, i, 1, MPI_INTEGER, 

     &            MPI_STATUS_IGNORE, ierr )

           if (ierr .ne. MPI_SUCCESS) then

              errs = errs + 1

              if (errs .le. 10) then

                 call MTestPrintError( ierr )

              endif

           endif

           endif

           call mpi_barrier( comm, ierr )

           call mpi_file_get_position_shared( fh, offset, ierr )

           if (offset .ne. fileintsize * i) then

              errs = errs + 1

              print *, r, ' Shared position is ', offset,' should be ',

     &                 fileintsize * i

           endif

           call mpi_barrier( comm, ierr )

        enddo

        call mpi_file_close( fh, ierr )

        if (r .eq. 0) then

            call mpi_file_delete( filename, MPI_INFO_NULL, ierr )

        endif

        if (ierr .ne. MPI_SUCCESS) then

           errs = errs + 1

           if (errs .le. 10) then

              call MTestPrintError( ierr )

           endif

        endif

c

        call MTest_Finalize( errs )

        call mpi_finalize( ierr )

        end