1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
|
! This file created from f77/io/fileinfof.f with f77tof90
!
! Copyright (C) by Argonne National Laboratory
! See COPYRIGHT in top-level directory
!
program main
use mpi
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 )
!
! 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
!
! 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 )
!
! An implementation isn't required to provide the filename (though
! a high-quality implementation should)
if (flag) then
! 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 )
!
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 )
end
|
