|
Packit |
0848f5 |
! This file created from test/mpi/f77/io/c2f2ciof.f with f77tof90
|
|
Packit |
0848f5 |
! -*- Mode: Fortran; -*-
|
|
Packit |
0848f5 |
!
|
|
Packit |
0848f5 |
! (C) 2003 by Argonne National Laboratory.
|
|
Packit |
0848f5 |
! See COPYRIGHT in top-level directory.
|
|
Packit |
0848f5 |
!
|
|
Packit |
0848f5 |
! Test just the MPI-IO FILE object
|
|
Packit |
0848f5 |
program main
|
|
Packit |
0848f5 |
use mpi
|
|
Packit |
0848f5 |
integer errs, toterrs, ierr
|
|
Packit |
0848f5 |
integer wrank
|
|
Packit |
0848f5 |
integer wgroup
|
|
Packit |
0848f5 |
integer fsize, frank
|
|
Packit |
0848f5 |
integer comm, file, group, result
|
|
Packit |
0848f5 |
integer c2ffile
|
|
Packit |
0848f5 |
|
|
Packit |
0848f5 |
errs = 0
|
|
Packit |
0848f5 |
|
|
Packit |
0848f5 |
call mpi_init( ierr )
|
|
Packit |
0848f5 |
|
|
Packit |
0848f5 |
call mpi_comm_rank( MPI_COMM_WORLD, wrank, ierr )
|
|
Packit |
0848f5 |
call mpi_comm_group( MPI_COMM_WORLD, wgroup, ierr )
|
|
Packit |
0848f5 |
|
|
Packit |
0848f5 |
call mpi_file_open( MPI_COMM_WORLD, "temp", MPI_MODE_RDWR + &
|
|
Packit |
0848f5 |
& MPI_MODE_DELETE_ON_CLOSE + MPI_MODE_CREATE, MPI_INFO_NULL, &
|
|
Packit |
0848f5 |
& file, ierr )
|
|
Packit |
0848f5 |
if (ierr .ne. 0) then
|
|
Packit |
0848f5 |
errs = errs + 1
|
|
Packit |
0848f5 |
else
|
|
Packit |
0848f5 |
errs = errs + c2ffile( file )
|
|
Packit |
0848f5 |
call mpi_file_close( file, ierr )
|
|
Packit |
0848f5 |
endif
|
|
Packit |
0848f5 |
|
|
Packit |
0848f5 |
call f2cfile( file )
|
|
Packit |
0848f5 |
! name is temp, in comm world, no info provided
|
|
Packit |
0848f5 |
call mpi_file_get_group( file, group, ierr )
|
|
Packit |
0848f5 |
call mpi_group_compare( group, wgroup, result, ierr )
|
|
Packit |
0848f5 |
if (result .ne. MPI_IDENT) then
|
|
Packit |
0848f5 |
errs = errs + 1
|
|
Packit |
0848f5 |
print *, "Group of file not the group of comm_world"
|
|
Packit |
0848f5 |
endif
|
|
Packit |
0848f5 |
call mpi_group_free( group, ierr )
|
|
Packit |
0848f5 |
call mpi_group_free( wgroup, ierr )
|
|
Packit |
0848f5 |
call mpi_file_close( file, ierr )
|
|
Packit |
0848f5 |
!
|
|
Packit |
0848f5 |
! Summarize the errors
|
|
Packit |
0848f5 |
!
|
|
Packit |
0848f5 |
call mpi_allreduce( errs, toterrs, 1, MPI_INTEGER, MPI_SUM, &
|
|
Packit |
0848f5 |
& MPI_COMM_WORLD, ierr )
|
|
Packit |
0848f5 |
if (wrank .eq. 0) then
|
|
Packit |
0848f5 |
if (toterrs .eq. 0) then
|
|
Packit |
0848f5 |
print *, ' No Errors'
|
|
Packit |
0848f5 |
else
|
|
Packit |
0848f5 |
print *, ' Found ', toterrs, ' errors'
|
|
Packit |
0848f5 |
endif
|
|
Packit |
0848f5 |
endif
|
|
Packit |
0848f5 |
|
|
Packit |
0848f5 |
call mpi_finalize( ierr )
|
|
Packit |
0848f5 |
end
|
|
Packit |
0848f5 |
|