!******************************************************************************
!    Parallel I/O example:
!
!    This example uses some of the file access routines. A file is created and
!    different file write mehtods are used, one using explicit offsets, one
!    using the shared file pointer, and one using individual file pointers for
!    each process. After each write has been performed the file content is read
!    and dumped to stdout.
!
!    More specifically:
!   --------------------------------
!      - A file is created and opened for both reading and writing.
!      - The file view is set to MPI_INT for all processes.
!      - Set the file's size so that it has room for one MPI_INT per process.
!      - Write to the file using explicit offsets.
!      - Write to the file using the shared file pointer.
!      - Write to the file using individual file pointers.
!      - Close the file and exit.
!   --------------------------------
!
!    Copyright 2003 (c) Critical Software SA
!    . http://www.criticalsoftware.com
!    . http://www.criticalsoftware.com/hpc
!    . csWMPI II@criticalsoftware.com
!
!******************************************************************************

      include "mpi_init.f"
      
!------------------------------------------------------------------------------

!******************************************************************************
!    This function dumps the content of the file using the process' individual
!    file pointer.
!******************************************************************************
      subroutine DumpFileContent(mf_file,n_comm_size,n_comm_rank)
      implicit none
      include 'mpif.h'
      integer mf_file, n_comm_size, n_comm_rank, ierr
      integer  nCounter, nFileData

      call MPI_FILE_SEEK(mf_file, 0, MPI_SEEK_SET, ierr)
      print *,'  - File content: '
      do nCounter = 0,n_comm_size-1
            call MPI_FILE_READ(mf_file, nFileData, 1, MPI_INTEGER,
     +                  MPI_STATUS_IGNORE, ierr)
        print *,' (',nFileData,')'
      end do
      print *,''
      end !subroutine DumpFileContent

!******************************************************************************
!    This function computes an interval for a single process.
!******************************************************************************
      program main
      implicit none
      include 'mpif.h'
      integer nCommSize, nCommRank, ierr

!     The filename to use for the shared file
!     Rank of the process to act as file server
      character*(*) FILENAME,SERVERRANK
      parameter (FILENAME='sharedfile.mpi',SERVERRANK='0')

      integer miInfo,mfFile

!     Initialize csWMPI II II:
      call MPI_INIT(ierr)

!     Determine what the world looks like and our own position in it:
      call MPI_COMM_SIZE(MPI_COMM_WORLD, nCommSize, ierr)
      call MPI_COMM_RANK(MPI_COMM_WORLD, nCommRank, ierr)
      print *,'I am rank',nCommRank,' of ',nCommSize,
     +         ' in MPI_COMM_WORLD'

!     Create an instance of MPI_Info and set the server_rank key,
!     specifying which rank should act as the file server, to SERVER_RANK:
      call MPI_INFO_CREATE(miInfo,ierr)

      call MPI_INFO_SET(miInfo, 'server_rank', SERVERRANK, ierr)

!     Try creating a file (and open it in read/write mode)
      print *,'Opening file: ',FILENAME,' (server_rank=',
     +         SERVERRANK,')..'

      call MPI_FILE_OPEN(MPI_COMM_WORLD,FILENAME,
     +                MPI_MODE_RDWR + MPI_MODE_CREATE,
     +                miInfo, mfFile, ierr)
      print *,'OK!'
      print *,''
      print *,''


!     Free the info object:
      call MPI_INFO_FREE(miInfo, ierr)

!     Set the file view (all use the displacement 0, elementary datatype
!     and filetype MPI_INT). The data representation is set to "native".
!     Hence, we have a file of MPI_INTs viewed identically by all
!     processes:
      call MPI_FILE_SET_VIEW(mfFile, 0, MPI_INTEGER, MPI_INTEGER,
     +                        'native', MPI_INFO_NULL, ierr)


!     Make room in the file for one MPI_INT per process
      call MPI_FILE_SET_SIZE(mfFile, nCommSize, ierr)

!     Use explicit offsets (offset equal to rank) to write one MPI_INT to
!     the file. The result should be a file containing integers ascending
!     from 0 to the size of MPI_COMM_WORLD - 1.
      print *,'Write to file using explicit offsets..........'
      call MPI_FILE_WRITE_AT(mfFile,nCommRank,nCommRank,
     +                        1,MPI_INTEGER, MPI_STATUS_IGNORE, ierr)
      print *,'OK!'
      print *,''

      call MPI_BARRIER(MPI_COMM_WORLD, ierr)
      call DumpFileContent (mfFile, nCommSize, nCommRank)
      call MPI_BARRIER (MPI_COMM_WORLD, ierr)

!     Use a shared file pointer to write to the file. Since there is no
!     synchronization between the processes, the result is
!     non-deterministic, however the file should contain one MPI_INT for
!     every process in MPI_COMM_WORLD.
      print *,'Write to file using the shared file pointer...'
      call MPI_FILE_WRITE_SHARED(mfFile, nCommRank, 1, MPI_INTEGER,
     +                           MPI_STATUS_IGNORE, ierr)
      print *,'OK'
      print *,''
      call MPI_BARRIER(MPI_COMM_WORLD, ierr)
      call DumpFileContent (mfFile, nCommSize, nCommRank)
      call MPI_BARRIER(MPI_COMM_WORLD, ierr)

!     Use individual file pointers to write to the file. First a seek is
!     performed to from the _end_ of the file. Hence the should be a file
!     containing integers descending from size of MPI_COMM_WORLD - 1 to 0.
      print *,'Write to file using individual file pointers..'
      call MPI_FILE_SEEK(mfFile, -(nCommRank+1), MPI_SEEK_END, ierr)

      call MPI_FILE_WRITE(mfFile, nCommRank, 1, MPI_INTEGER,
     +                    MPI_STATUS_IGNORE, ierr)
      print *,'OK!'
      print *,''

      call MPI_BARRIER(MPI_COMM_WORLD, ierr)
      call DumpFileContent (mfFile, nCommSize, nCommRank)
      call MPI_BARRIER(MPI_COMM_WORLD, ierr)

!     Close the file and finalize MPI:
      call MPI_FILE_CLOSE(mfFile, ierr)
      call MPI_FINALIZE(ierr)

!     Pause rank 0 so that the output can be verified:
      if (nCommRank == 0) then
        pause 'Press ENTER to exit...'
      end if

      stop
      end