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
|
! -*- Mode: Fortran; -*-
!
! (C) 2011 by Argonne National Laboratory.
! See COPYRIGHT in top-level directory.
!
! Test just the MPI-IO FILE object
program main
use mpi_f08
integer errs, toterrs, ierr
integer wrank
type(MPI_Group) wgroup
integer fsize, frank
type(MPI_Comm) comm
type(MPI_File) file
type(MPI_Group) group
integer result
integer c2ffile
errs = 0
call mpi_init( ierr )
call mpi_comm_rank( MPI_COMM_WORLD, wrank, ierr )
call mpi_comm_group( MPI_COMM_WORLD, wgroup, ierr )
call mpi_file_open( MPI_COMM_WORLD, "temp", MPI_MODE_RDWR + &
& MPI_MODE_DELETE_ON_CLOSE + MPI_MODE_CREATE, MPI_INFO_NULL, &
& file, ierr )
if (ierr .ne. 0) then
errs = errs + 1
else
errs = errs + c2ffile( file )
call mpi_file_close( file, ierr )
endif
call f2cfile( file )
! name is temp, in comm world, no info provided
call mpi_file_get_group( file, group, ierr )
call mpi_group_compare( group, wgroup, result, ierr )
if (result .ne. MPI_IDENT) then
errs = errs + 1
print *, "Group of file not the group of comm_world"
endif
call mpi_group_free( group, ierr )
call mpi_group_free( wgroup, ierr )
call mpi_file_close( file, ierr )
!
! Summarize the errors
!
call mpi_allreduce( errs, toterrs, 1, MPI_INTEGER, MPI_SUM, &
& MPI_COMM_WORLD, ierr )
if (wrank .eq. 0) then
if (toterrs .eq. 0) then
print *, ' No Errors'
else
print *, ' Found ', toterrs, ' errors'
endif
endif
end
|
