使用MPI_SEND與MPI_Comm_spawn

Question

我想使用MPI_SEND（）和MPI_RECV（）一個孩子，其父進程，通過使用MPI_Comm_spawn創造之間的溝通創造了父子進程之間MPI_RECV如下面可以看到：

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 

當上面的程序運行時，家長似乎經過精細跑，但孩子從來首席ts：「客戶端收到數組」，導致我相信我已經搞砸了send/recv。

如果不清楚我想實現的目標，我希望父項產生子項，向該子項發送一個數組，子項用於處理數組，子項將數組發送回父項。 （斜體字還沒寫，我想這基本通信第一個工作日）

此刻，當我運行：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