Blame test/mpi/f90/io/c2f2ciof90.f90

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