|
Packit Service |
c5cf8c |
! -*- Mode: Fortran; -*-
|
|
Packit Service |
c5cf8c |
!
|
|
Packit Service |
c5cf8c |
! (C) 2014 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_f08
|
|
Packit Service |
c5cf8c |
integer ierr, errs
|
|
Packit Service |
c5cf8c |
type(MPI_File) fh
|
|
Packit Service |
c5cf8c |
type(MPI_Info) info1, info2
|
|
Packit Service |
c5cf8c |
integer rank
|
|
Packit Service |
c5cf8c |
logical flag
|
|
Packit Service |
c5cf8c |
character*(50) filename
|
|
Packit Service |
c5cf8c |
character*(MPI_MAX_INFO_KEY) mykey
|
|
Packit Service |
c5cf8c |
character*(MPI_MAX_INFO_VAL) myvalue
|
|
Packit Service |
c5cf8c |
|
|
Packit Service |
c5cf8c |
errs = 0
|
|
Packit Service |
c5cf8c |
call mtest_init( ierr )
|
|
Packit Service |
c5cf8c |
|
|
Packit Service |
c5cf8c |
call mpi_comm_rank( MPI_COMM_WORLD, rank, ierr )
|
|
Packit Service |
c5cf8c |
!
|
|
Packit Service |
c5cf8c |
! Open a simple file
|
|
Packit Service |
c5cf8c |
ierr = -1
|
|
Packit Service |
c5cf8c |
filename = "iotest.txt"
|
|
Packit Service |
c5cf8c |
call mpi_file_open( MPI_COMM_WORLD, 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 |
call MTestPrintError( ierr )
|
|
Packit Service |
c5cf8c |
endif
|
|
Packit Service |
c5cf8c |
!
|
|
Packit Service |
c5cf8c |
! Try to set one of the available info hints
|
|
Packit Service |
c5cf8c |
call mpi_info_create( info1, ierr )
|
|
Packit Service |
c5cf8c |
call mpi_info_set( info1, "access_style", &
|
|
Packit Service |
c5cf8c |
& "read_once,write_once", ierr )
|
|
Packit Service |
c5cf8c |
ierr = -1
|
|
Packit Service |
c5cf8c |
call mpi_file_set_info( fh, info1, ierr )
|
|
Packit Service |
c5cf8c |
if (ierr .ne. MPI_SUCCESS) then
|
|
Packit Service |
c5cf8c |
errs = errs + 1
|
|
Packit Service |
c5cf8c |
call MTestPrintError( ierr )
|
|
Packit Service |
c5cf8c |
endif
|
|
Packit Service |
c5cf8c |
call mpi_info_free( info1, ierr )
|
|
Packit Service |
c5cf8c |
|
|
Packit Service |
c5cf8c |
ierr = -1
|
|
Packit Service |
c5cf8c |
call mpi_file_get_info( fh, info2, ierr )
|
|
Packit Service |
c5cf8c |
if (ierr .ne. MPI_SUCCESS) then
|
|
Packit Service |
c5cf8c |
errs = errs + 1
|
|
Packit Service |
c5cf8c |
call MTestPrintError( ierr )
|
|
Packit Service |
c5cf8c |
endif
|
|
Packit Service |
c5cf8c |
call mpi_info_get( info2, "filename", MPI_MAX_INFO_VAL, &
|
|
Packit Service |
c5cf8c |
& myvalue, flag, ierr )
|
|
Packit Service |
c5cf8c |
!
|
|
Packit Service |
c5cf8c |
! An implementation isn't required to provide the filename (though
|
|
Packit Service |
c5cf8c |
! a high-quality implementation should)
|
|
Packit Service |
c5cf8c |
if (flag) then
|
|
Packit Service |
c5cf8c |
! If we find it, we must have the correct name
|
|
Packit Service |
c5cf8c |
if (myvalue(1:10) .ne. filename(1:10) .or. &
|
|
Packit Service |
c5cf8c |
& myvalue(11:11) .ne. ' ') then
|
|
Packit Service |
c5cf8c |
errs = errs + 1
|
|
Packit Service |
c5cf8c |
print *, ' Returned wrong value for the filename'
|
|
Packit Service |
c5cf8c |
endif
|
|
Packit Service |
c5cf8c |
endif
|
|
Packit Service |
c5cf8c |
call mpi_info_free( info2, ierr )
|
|
Packit Service |
c5cf8c |
!
|
|
Packit Service |
c5cf8c |
call mpi_file_close( fh, ierr )
|
|
Packit Service |
c5cf8c |
call mpi_barrier( MPI_COMM_WORLD, ierr )
|
|
Packit Service |
c5cf8c |
if (rank .eq. 0) then
|
|
Packit Service |
c5cf8c |
call mpi_file_delete( filename, MPI_INFO_NULL, ierr )
|
|
Packit Service |
c5cf8c |
endif
|
|
Packit Service |
c5cf8c |
|
|
Packit Service |
c5cf8c |
call mtest_finalize( errs )
|
|
Packit Service |
c5cf8c |
|
|
Packit Service |
c5cf8c |
end
|