|
Packit Service |
c5cf8c |
! This file created from f77/io/shpositionf.f with f77tof90
|
|
Packit Service |
c5cf8c |
! -*- Mode: Fortran; -*-
|
|
Packit Service |
c5cf8c |
!
|
|
Packit Service |
c5cf8c |
! (C) 2003 by Argonne National Laboratory.
|
|
Packit Service |
c5cf8c |
! See COPYRIGHT in top-level directory.
|
|
Packit Service |
c5cf8c |
!
|
|
Packit Service |
c5cf8c |
program main
|
|
Packit Service |
c5cf8c |
use mpi
|
|
Packit Service |
c5cf8c |
integer comm, fh, r, s, i
|
|
Packit Service |
c5cf8c |
integer fileintsize
|
|
Packit Service |
c5cf8c |
integer errs, err, ierr
|
|
Packit Service |
c5cf8c |
character *(100) filename
|
|
Packit Service |
c5cf8c |
integer (kind=MPI_OFFSET_KIND) offset
|
|
Packit Service |
c5cf8c |
|
|
Packit Service |
c5cf8c |
integer (kind=MPI_ADDRESS_KIND) aint
|
|
Packit Service |
c5cf8c |
|
|
Packit Service |
c5cf8c |
|
|
Packit Service |
c5cf8c |
errs = 0
|
|
Packit Service |
c5cf8c |
call MTest_Init( ierr )
|
|
Packit Service |
c5cf8c |
|
|
Packit Service |
c5cf8c |
filename = "iotest.txt"
|
|
Packit Service |
c5cf8c |
comm = MPI_COMM_WORLD
|
|
Packit Service |
c5cf8c |
call mpi_comm_size( comm, s, ierr )
|
|
Packit Service |
c5cf8c |
call mpi_comm_rank( comm, r, ierr )
|
|
Packit Service |
c5cf8c |
! Try writing the file, then check it
|
|
Packit Service |
c5cf8c |
call mpi_file_open( comm, filename, MPI_MODE_RDWR + &
|
|
Packit Service |
c5cf8c |
& MPI_MODE_CREATE, MPI_INFO_NULL, fh, ierr )
|
|
Packit Service |
c5cf8c |
if (ierr .ne. MPI_SUCCESS) then
|
|
Packit Service |
c5cf8c |
errs = errs + 1
|
|
Packit Service |
c5cf8c |
if (errs .le. 10) then
|
|
Packit Service |
c5cf8c |
call MTestPrintError( ierr )
|
|
Packit Service |
c5cf8c |
endif
|
|
Packit Service |
c5cf8c |
endif
|
|
Packit Service |
c5cf8c |
!
|
|
Packit Service |
c5cf8c |
! Get the size of an INTEGER in the file
|
|
Packit Service |
c5cf8c |
call mpi_file_get_type_extent( fh, MPI_INTEGER, aint, ierr )
|
|
Packit Service |
c5cf8c |
fileintsize = aint
|
|
Packit Service |
c5cf8c |
!
|
|
Packit Service |
c5cf8c |
! We let each process write in turn, getting the position after each
|
|
Packit Service |
c5cf8c |
! write
|
|
Packit Service |
c5cf8c |
do i=1, s
|
|
Packit Service |
c5cf8c |
if (i .eq. r + 1) then
|
|
Packit Service |
c5cf8c |
call mpi_file_write_shared( fh, i, 1, MPI_INTEGER, &
|
|
Packit Service |
c5cf8c |
& MPI_STATUS_IGNORE, ierr )
|
|
Packit Service |
c5cf8c |
if (ierr .ne. MPI_SUCCESS) then
|
|
Packit Service |
c5cf8c |
errs = errs + 1
|
|
Packit Service |
c5cf8c |
if (errs .le. 10) then
|
|
Packit Service |
c5cf8c |
call MTestPrintError( ierr )
|
|
Packit Service |
c5cf8c |
endif
|
|
Packit Service |
c5cf8c |
endif
|
|
Packit Service |
c5cf8c |
endif
|
|
Packit Service |
c5cf8c |
call mpi_barrier( comm, ierr )
|
|
Packit Service |
c5cf8c |
call mpi_file_get_position_shared( fh, offset, ierr )
|
|
Packit Service |
c5cf8c |
if (offset .ne. fileintsize * i) then
|
|
Packit Service |
c5cf8c |
errs = errs + 1
|
|
Packit Service |
c5cf8c |
print *, r, ' Shared position is ', offset,' should be ', &
|
|
Packit Service |
c5cf8c |
& fileintsize * i
|
|
Packit Service |
c5cf8c |
endif
|
|
Packit Service |
c5cf8c |
call mpi_barrier( comm, ierr )
|
|
Packit Service |
c5cf8c |
enddo
|
|
Packit Service |
c5cf8c |
call mpi_file_close( fh, ierr )
|
|
Packit Service |
c5cf8c |
if (r .eq. 0) then
|
|
Packit Service |
c5cf8c |
call mpi_file_delete( filename, MPI_INFO_NULL, ierr )
|
|
Packit Service |
c5cf8c |
endif
|
|
Packit Service |
c5cf8c |
if (ierr .ne. MPI_SUCCESS) then
|
|
Packit Service |
c5cf8c |
errs = errs + 1
|
|
Packit Service |
c5cf8c |
if (errs .le. 10) then
|
|
Packit Service |
c5cf8c |
call MTestPrintError( ierr )
|
|
Packit Service |
c5cf8c |
endif
|
|
Packit Service |
c5cf8c |
endif
|
|
Packit Service |
c5cf8c |
!
|
|
Packit Service |
c5cf8c |
call MTest_Finalize( errs )
|
|
Packit Service |
c5cf8c |
end
|