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

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