! -*- Mode: Fortran; -*- ! ! (C) 2011 by Argonne National Laboratory. ! See COPYRIGHT in top-level directory. ! program main use mpi_f08 integer errs, toterrs, ierr integer wrank, wsize type(MPI_Group) wgroup type(MPI_Info) info type(MPI_Request) req integer fsize, frank !integer comm, group, type, op, errh, result type(MPI_Comm) comm type(MPI_Group) group type(MPI_Datatype) type type(MPI_Op) op type(MPI_Errhandler) errh integer result integer c2fcomm, c2fgroup, c2ftype, c2finfo, c2frequest, & & c2ferrhandler, c2fop character value*100 logical flag errs = 0 call mpi_init( ierr ) ! ! Test passing a Fortran MPI object to C call mpi_comm_rank( MPI_COMM_WORLD, wrank, ierr ) errs = errs + c2fcomm( MPI_COMM_WORLD%MPI_VAL) call mpi_comm_group( MPI_COMM_WORLD, wgroup, ierr ) errs = errs + c2fgroup( wgroup%MPI_VAL ) call mpi_group_free( wgroup, ierr ) call mpi_info_create( info, ierr ) call mpi_info_set( info, "host", "myname", ierr ) call mpi_info_set( info, "wdir", "/rdir/foo", ierr ) errs = errs + c2finfo( info%MPI_VAL ) call mpi_info_free( info, ierr ) errs = errs + c2ftype( MPI_INTEGER%MPI_VAL ) call mpi_irecv( 0, 0, MPI_INTEGER, MPI_ANY_SOURCE, MPI_ANY_TAG, & & MPI_COMM_WORLD, req, ierr ) call mpi_cancel( req, ierr ) errs = errs + c2frequest( req%MPI_VAL ) call mpi_wait( req, MPI_STATUS_IGNORE, ierr ) errs = errs + c2ferrhandler( MPI_ERRORS_RETURN%MPI_VAL ) errs = errs + c2fop( MPI_SUM%MPI_VAL ) ! ! Test using a C routine to provide the Fortran handle call mpi_comm_size( MPI_COMM_WORLD, wsize, ierr ) call mpi_comm_rank( MPI_COMM_WORLD, wrank, ierr ) call f2ccomm( comm ) call mpi_comm_size( comm, fsize, ierr ) call mpi_comm_rank( comm, frank, ierr ) if (fsize.ne.wsize .or. frank.ne.wrank) then errs = errs + 1 print *, "Comm(fortran) has wrong size or rank" endif call f2cgroup( group ) call mpi_group_size( group, fsize, ierr ) call mpi_group_rank( group, frank, ierr ) if (fsize.ne.wsize .or. frank.ne.wrank) then errs = errs + 1 print *, "Group(fortran) has wrong size or rank" endif call mpi_group_free( group, ierr ) call f2ctype( type ) if (type .ne. MPI_INTEGER) then errs = errs + 1 print *, "Datatype(fortran) is not MPI_INT" endif call f2cinfo( info ) call mpi_info_get( info, "host", 100, value, flag, ierr ) if (.not. flag) then errs = errs + 1 print *, "Info test for host returned false" else if (value .ne. "myname") then errs = errs + 1 print *, "Info test for host returned ", value endif call mpi_info_get( info, "wdir", 100, value, flag, ierr ) if (.not. flag) then errs = errs + 1 print *, "Info test for wdir returned false" else if (value .ne. "/rdir/foo") then errs = errs + 1 print *, "Info test for wdir returned ", value endif call mpi_info_free( info, ierr ) call f2cop( op ) if (op .ne. MPI_SUM) then errs = errs + 1 print *, "Fortran MPI_SUM not MPI_SUM in C" endif call f2cerrhandler( errh ) if (errh .ne. MPI_ERRORS_RETURN) then errs = errs + 1 print *,"Fortran MPI_ERRORS_RETURN not MPI_ERRORS_RETURN in C" endif ! ! Summarize the errors ! call mtest_finalize( errs ) end