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

Packit Service c5cf8c
! -*- Mode: Fortran; -*-
Packit Service c5cf8c
!
Packit Service c5cf8c
!  (C) 2011 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_f08
Packit Service c5cf8c
      integer errs, toterrs, ierr
Packit Service c5cf8c
      integer wrank
Packit Service c5cf8c
      type(MPI_Group) wgroup
Packit Service c5cf8c
      integer fsize, frank
Packit Service c5cf8c
      type(MPI_Comm) comm
Packit Service c5cf8c
      type(MPI_File) file
Packit Service c5cf8c
      type(MPI_Group) group
Packit Service c5cf8c
      integer 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 mpi_allreduce( errs, toterrs, 1, MPI_INTEGER, MPI_SUM, &
Packit Service c5cf8c
      &     MPI_COMM_WORLD, ierr )
Packit Service c5cf8c
      if (wrank .eq. 0) then
Packit Service c5cf8c
         if (toterrs .eq. 0) then
Packit Service c5cf8c
            print *, ' No Errors'
Packit Service c5cf8c
         else
Packit Service c5cf8c
            print *, ' Found ', toterrs, ' errors'
Packit Service c5cf8c
         endif
Packit Service c5cf8c
      endif
Packit Service c5cf8c
Packit Service c5cf8c
      end
Packit Service c5cf8c