Blame test/mpi/f90/ext/c2f2cf90.f90

Packit Service c5cf8c
! This file created from f77/ext/c2f2cf.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
      program main
Packit Service c5cf8c
      use mpi
Packit Service c5cf8c
      integer errs, toterrs, ierr
Packit Service c5cf8c
      integer wrank, wsize
Packit Service c5cf8c
      integer wgroup, info, req
Packit Service c5cf8c
      integer fsize, frank
Packit Service c5cf8c
      integer comm, group, type, op, errh, result
Packit Service c5cf8c
      integer c2fcomm, c2fgroup, c2ftype, c2finfo, c2frequest, &
Packit Service c5cf8c
      &     c2ferrhandler, c2fop
Packit Service c5cf8c
      character value*100
Packit Service c5cf8c
      logical   flag
Packit Service c5cf8c
      errs = 0
Packit Service c5cf8c
Packit Service c5cf8c
      call mpi_init( ierr )
Packit Service c5cf8c
Packit Service c5cf8c
!
Packit Service c5cf8c
! Test passing a Fortran MPI object to C
Packit Service c5cf8c
      call mpi_comm_rank( MPI_COMM_WORLD, wrank, ierr )
Packit Service c5cf8c
      errs = errs + c2fcomm( MPI_COMM_WORLD )
Packit Service c5cf8c
      call mpi_comm_group( MPI_COMM_WORLD, wgroup, ierr )
Packit Service c5cf8c
      errs = errs + c2fgroup( wgroup )
Packit Service c5cf8c
      call mpi_group_free( wgroup, ierr )
Packit Service c5cf8c
Packit Service c5cf8c
      call mpi_info_create( info, ierr )
Packit Service c5cf8c
      call mpi_info_set( info, "host", "myname", ierr )
Packit Service c5cf8c
      call mpi_info_set( info, "wdir", "/rdir/foo", ierr )
Packit Service c5cf8c
      errs = errs + c2finfo( info )
Packit Service c5cf8c
      call mpi_info_free( info, ierr )
Packit Service c5cf8c
Packit Service c5cf8c
      errs = errs + c2ftype( MPI_INTEGER )
Packit Service c5cf8c
Packit Service c5cf8c
      call mpi_irecv( 0, 0, MPI_INTEGER, MPI_ANY_SOURCE, MPI_ANY_TAG, &
Packit Service c5cf8c
      &     MPI_COMM_WORLD, req, ierr )
Packit Service c5cf8c
      call mpi_cancel( req, ierr )
Packit Service c5cf8c
      errs = errs + c2frequest( req )
Packit Service c5cf8c
      call mpi_wait( req, MPI_STATUS_IGNORE, ierr )
Packit Service c5cf8c
Packit Service c5cf8c
      errs = errs + c2ferrhandler( MPI_ERRORS_RETURN )
Packit Service c5cf8c
Packit Service c5cf8c
      errs = errs + c2fop( MPI_SUM )
Packit Service c5cf8c
Packit Service c5cf8c
!
Packit Service c5cf8c
! Test using a C routine to provide the Fortran handle
Packit Service c5cf8c
      call mpi_comm_size( MPI_COMM_WORLD, wsize, ierr )
Packit Service c5cf8c
      call mpi_comm_rank( MPI_COMM_WORLD, wrank, ierr )
Packit Service c5cf8c
Packit Service c5cf8c
      call f2ccomm( comm )
Packit Service c5cf8c
      call mpi_comm_size( comm, fsize, ierr )
Packit Service c5cf8c
      call mpi_comm_rank( comm, frank, ierr )
Packit Service c5cf8c
      if (fsize.ne.wsize .or. frank.ne.wrank) then
Packit Service c5cf8c
         errs = errs + 1
Packit Service c5cf8c
         print *, "Comm(fortran) has wrong size or rank"
Packit Service c5cf8c
      endif
Packit Service c5cf8c
      
Packit Service c5cf8c
      call f2cgroup( group )
Packit Service c5cf8c
      call mpi_group_size( group, fsize, ierr )
Packit Service c5cf8c
      call mpi_group_rank( group, frank, ierr )
Packit Service c5cf8c
      if (fsize.ne.wsize .or. frank.ne.wrank) then
Packit Service c5cf8c
         errs = errs + 1
Packit Service c5cf8c
         print *, "Group(fortran) has wrong size or rank"
Packit Service c5cf8c
      endif
Packit Service c5cf8c
      call mpi_group_free( group, ierr )
Packit Service c5cf8c
Packit Service c5cf8c
      call f2ctype( type )
Packit Service c5cf8c
      if (type .ne. MPI_INTEGER) then
Packit Service c5cf8c
         errs = errs + 1
Packit Service c5cf8c
         print *, "Datatype(fortran) is not MPI_INT"
Packit Service c5cf8c
      endif
Packit Service c5cf8c
      
Packit Service c5cf8c
      call f2cinfo( info )
Packit Service c5cf8c
      call mpi_info_get( info, "host", 100, value, flag, ierr )
Packit Service c5cf8c
      if (.not. flag) then
Packit Service c5cf8c
         errs = errs + 1
Packit Service c5cf8c
         print *, "Info test for host returned false"
Packit Service c5cf8c
      else if (value .ne. "myname") then
Packit Service c5cf8c
         errs = errs + 1
Packit Service c5cf8c
         print *, "Info test for host returned ", value
Packit Service c5cf8c
      endif
Packit Service c5cf8c
      call mpi_info_get( info, "wdir", 100, value, flag, ierr )
Packit Service c5cf8c
      if (.not. flag) then
Packit Service c5cf8c
         errs = errs + 1
Packit Service c5cf8c
         print *, "Info test for wdir returned false"
Packit Service c5cf8c
      else if (value .ne. "/rdir/foo") then
Packit Service c5cf8c
         errs = errs + 1
Packit Service c5cf8c
         print *, "Info test for wdir returned ", value
Packit Service c5cf8c
      endif
Packit Service c5cf8c
      call mpi_info_free( info, ierr )
Packit Service c5cf8c
Packit Service c5cf8c
      call f2cop( op )
Packit Service c5cf8c
      if (op .ne. MPI_SUM) then
Packit Service c5cf8c
          errs = errs + 1
Packit Service c5cf8c
          print *, "Fortran MPI_SUM not MPI_SUM in C"
Packit Service c5cf8c
      endif
Packit Service c5cf8c
Packit Service c5cf8c
      call f2cerrhandler( errh )
Packit Service c5cf8c
      if (errh .ne. MPI_ERRORS_RETURN) then
Packit Service c5cf8c
          errs = errs + 1
Packit Service c5cf8c
          print *,"Fortran MPI_ERRORS_RETURN not MPI_ERRORS_RETURN in C"
Packit Service c5cf8c
      endif
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