52 строки
2.1 KiB
Fortran
52 строки
2.1 KiB
Fortran
! -*- f90 -*-
|
|
!
|
|
! Copyright (c) 2009-2012 Cisco Systems, Inc. All rights reserved.
|
|
! Copyright (c) 2009-2012 Los Alamos National Security, LLC.
|
|
! All rights reserved.
|
|
! $COPYRIGHT$
|
|
!
|
|
|
|
! This file implements the mpi_f08_ext bindings. It has no file name
|
|
! conventions and generally implements whatever the extension needs.
|
|
|
|
subroutine OMPI_Progress_f08(count, comm, ierror)
|
|
! mpi_f08_types is an internal Open MPI module (i.e., it isn't part
|
|
! of the MPI-3 specification) that is built as part of OMPI's F08
|
|
! bindings. It contains all the types that we need for MPI stuff.
|
|
! We use the "only" clause just to be a little nice in the scope of
|
|
! things that we grab from that file.
|
|
use :: mpi_f08_types, only : MPI_Comm
|
|
|
|
implicit none
|
|
|
|
! Prototype the back-end function in mpif-h that we'll be invoking
|
|
! at the bottom of this subroutine. This is a little klunky and
|
|
! for demonstration purposes only; real extensions might want to
|
|
! make their own module that is simply used here (e.g., especially
|
|
! if an extension provides multiple interfaces).
|
|
interface
|
|
! Note that we list the back-end C function name in the mpif.h
|
|
! bindings that this interface will invoke. See below.
|
|
subroutine OMPI_Progress_f(count, comm, ierror) &
|
|
BIND(C, name="OMPI_Progress_f")
|
|
implicit none
|
|
INTEGER, INTENT(IN) :: count, comm
|
|
INTEGER, INTENT(OUT) :: ierror
|
|
end subroutine OMPI_Progress_f
|
|
end interface
|
|
|
|
! Types for this subroutine's parameters and local variables.
|
|
TYPE(MPI_Comm), INTENT(IN) :: comm
|
|
INTEGER, OPTIONAL, INTENT(OUT) :: ierror
|
|
integer :: count, c_ierror
|
|
|
|
! Here we call the the back-end C function in the mpif.h bindings,
|
|
! but convert the mpi_f08-style MPI handles to mpif.h-style handles
|
|
! (by taking the MPI_VAL member out of its "struct").
|
|
call OMPI_Progress_f(count, comm%MPI_VAL, c_ierror)
|
|
|
|
! ierror is optional in the mpi_f08 bindings, so keep that
|
|
! convention here, too -- assign to ierror *if it was provided*.
|
|
if (present(ierror)) ierror = c_ierror
|
|
end subroutine OMPI_Progress_f08
|