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从不打印：＆＃34;客户端收到数组。＆＃34;，让我相信我已经搞砸了一些东西/ RECV。

如果不清楚我想要实现什么，我希望父级生成一个子节点，向该子节点发送数组，子节点处理数组，子节点将数组发送回父的。（斜体尚未编写，我希望这个基本通信先工作）

目前，当我跑：mpiexec -np 1 parent.out时，孩子打印：

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

但不是＆＃34;客户收到了数组。＆＃34;

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

在使用MPI_Comm_spawn

1 个答案: