在使用 MPI_Comm_spawn 创建的父进程和子进程之间使用 MPI_Send 和 MPI_Recv

Question

我正在尝试使用 MPI_Send() 和 MPI_Recv() 在子进程与其父进程之间进行通信，通过使用 MPI_Comm_spawn 创建如下所示：

Parent.f90

program master
use mpi
implicit none

    integer :: ierr, num_procs, my_id, intercomm, i, array(10), tag

    CALL MPI_INIT(ierr)

    CALL MPI_COMM_RANK(MPI_COMM_WORLD, my_id, ierr)
    CALL MPI_COMM_SIZE(MPI_COMM_WORLD, num_procs, ierr)

    if (.not. (ierr .eq. 0)) then
        print*, "S.Unable to initilaize!"
        stop
    endif

    if (my_id .eq. 0) then
        call MPI_Comm_spawn("./child.out", MPI_ARGV_NULL, 1, MPI_INFO_NULL, my_id, &
        & MPI_COMM_WORLD, intercomm, MPI_ERRCODES_IGNORE, ierr)

        call MPI_Send(array, 255, MPI_INTEGER, my_id, tag, intercomm, ierr)
    endif

    call MPI_Finalize(ierr)

end program master

Child.f90

program name
use mpi
implicit none

    ! type declaration statements
    integer :: ierr, parent, my_id, n_procs, i, array(10), tag, intercomm
    logical :: flag, high

    ! executable statements
    call MPI_Init(ierr)
    call MPI_Initialized(flag, ierr)
    call MPI_Comm_get_parent(parent, ierr)
    call MPI_Comm_rank(MPI_COMM_WORLD, my_id, ierr)
    call MPI_Comm_size(MPI_COMM_WORLD, n_procs, ierr)

    print *, "Initilaized? ", flag
    print *, "My mommy is: ", parent
    print *, "My rank is:", my_id

    tag = 1

    call MPI_Recv(array, 255, MPI_INTEGER, MPI_ANY_SOURCE, tag, parent, MPI_STATUS_IGNORE, ierr)
    print *, "Client received array."

    call MPI_Finalize(ierr)
end program name

运行上述程序时，Parent 似乎运行良好，但 Child 从不打印：“Client received array.”，让我相信我在发送/接收方面搞砸了。

如果不清楚我想要实现什么，我希望父母产生一个孩子，向该孩子发送一个数组，孩子处理数组，孩子将数组发送回父母。 （斜体还没有写出来，我想先把这个基本的通信搞好）

此刻，当我运行：mpiexec -np 1 parent.out，孩子打印：

Initilaized?  T
My mommy is:            3
My rank is:           0

但不是“客户端收到的数组”。

Answer 1

我能够解决我的问题。下面的代码启动一个父节点，将一个大小为 1000000 的数组发送给它的子节点，子节点将该数组平方并将其发送回其父节点。

Parent.f90

program master
use mpi
implicit none

    integer :: ierr, num_procs, my_id, intercomm, i, array(1000000), s_tag, s_dest, siffra

    CALL MPI_INIT(ierr)

    CALL MPI_COMM_RANK(MPI_COMM_WORLD, my_id, ierr)
    CALL MPI_COMM_SIZE(MPI_COMM_WORLD, num_procs, ierr)

    !print *, "S.Rank =", my_id
    !print *, "S.Size =", num_procs

    if (.not. (ierr .eq. 0)) then
        print*, "S.Unable to initilaize bös!"
        stop
    endif

    do i=1,size(array)
        array(i) = 2
    enddo

    if (my_id .eq. 0) then
        call MPI_Comm_spawn("./client2.out", MPI_ARGV_NULL, 1, MPI_INFO_NULL, my_id, &
        & MPI_COMM_WORLD, intercomm, MPI_ERRCODES_IGNORE, ierr)


        s_dest = 0 !rank of destination (integer)
        s_tag =  1 !message tag (integer)
        call MPI_Send(array(1), 1000000, MPI_INTEGER, s_dest, s_tag, intercomm, ierr)

        call MPI_Recv(array(1), 1000000, MPI_INTEGER, s_dest, s_tag, intercomm, MPI_STATUS_IGNORE, ierr)

        !do i=1,10
        !   print *, "S.Array(",i,"): ", array(i)
        !enddo

    endif

    call MPI_Finalize(ierr)

end program master

Child.f90

program name
use mpi
implicit none

    ! type declaration statements
    integer :: ierr, parent, my_id, n_procs, i, array(1000000), ctag, csource, intercomm, siffra
    logical :: flag

    ! executable statements
    call MPI_Init(ierr)
    call MPI_Initialized(flag, ierr)
    call MPI_Comm_get_parent(parent, ierr)
    call MPI_Comm_rank(MPI_COMM_WORLD, my_id, ierr)
    call MPI_Comm_size(MPI_COMM_WORLD, n_procs, ierr)

    csource = 0 !rank of source
    ctag = 1 !message tag

    call MPI_Recv(array(1), 1000000, MPI_INTEGER, csource, ctag, parent, MPI_STATUS_IGNORE, ierr)

    !do i=1,10
    !    print *, "C.Array(",i,"): ", array(i)
    !enddo

    do i=1,size(array)
        array(i) = array(i)**2
    enddo

    !do i=1,10
    !    print *, "C.Array(",i,"): ", array(i)
    !enddo

    call MPI_Send(array(1), 1000000, MPI_INTEGER, csource, ctag, parent, ierr)

    call MPI_Finalize(ierr)
end program name