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