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