Постоянное выделение MPI-коммуникатора для C / C ++ - PullRequest
3 голосов
/ 05 июля 2019

MPI-коммуникатор создается в Фортране и передается в C, который в свою очередь возвращает указатель (c_ptr) на C коммуникатор. Это сделано, чтобы избежать создания C коммуникатора для каждой C функции. Но когда я пытаюсь использовать коммуникатор C в ReuseComm, я получаю ошибку сегментации.

Модуль Fortran

module mymodule

    use mpi
    use, intrinsic :: ISO_C_Binding, only: c_ptr, c_null_ptr

    implicit none
    private

    interface

        subroutine reuse_comm(comm) bind(C, name="reuse_comm")
            import c_ptr
            implicit none
            type(c_ptr), intent(in) :: comm
        end subroutine reuse_comm

        function f_MPI_Comm_f2c(comm) result(optr) bind(C, name="f_MPI_Comm_f2c")
            import c_ptr
            implicit none
            integer, intent(in) :: comm
            type(c_ptr) :: optr
        end function f_MPI_Comm_f2c

    end interface    

    type(c_ptr), save :: ccomm = c_null_ptr

    public :: CreateCcomm, ReuseComm, ccomm

    CONTAINS

        subroutine CreateCcomm(com)
            integer, intent(in) :: com
            ccomm = f_MPI_Comm_f2c(com)
        end subroutine CreateCcomm

        subroutine ReuseComm()
            call reuse_comm(ccomm)
        end subroutine ReuseComm

end module mymodule

Фортран водитель

program main

use mpi
use Tailor_module, only : CreateCcomm, ReuseComm, ccomm
use, intrinsic :: ISO_C_Binding, only: c_ptr
IMPLICIT NONE

integer error 

call MPI_Init(error)
call CreateCcomm(MPI_COMM_WORLD)
call ReuseComm()
call MPI_Finalize (error)

end

C ++

extern "C"
{
    MPI_Comm* f_MPI_Comm_f2c(MPI_Fint* f_handle)
    {
        MPI_Comm* comm;
        comm = (MPI_Comm*)malloc(sizeof(MPI_Comm));
        *comm = MPI_Comm_f2c(*f_handle);
        assert(*comm != MPI_COMM_NULL);

        int sizep = -1;
        MPI_Comm_size(*comm, &sizep);
        std::cout << "sizep: " << sizep << std::endl; // good, prints correct output.

        return comm;
    }

    void reuse_comm(MPI_Comm* comm)
    {
        assert(comm != NULL);
        assert(*comm != MPI_COMM_NULL);

        int sizep = -1;
        MPI_Comm_size(*comm, &sizep); // causes seg fault.
        std::cout << "sizep: " << sizep << std::endl;
    }
}
...