내 앞의 질문에 따라 MPI

Question

에 커뮤니 사이에 작업을 전송 및 수신 : Unable to implement MPI_Intercomm_create

MPI_INTERCOMM_CREATE의 문제가 해결되었습니다. 하지만 컬러 0의 프로세스 0 (전역 순위 = 0)과 색상 1 (즉, 전체 순위 = 2)의 프로세스 0 사이에서 기본 보내기 작업을 구현하려고하면 코드는받은 버퍼를 인쇄 한 후 끊습니다. 코드 :

program hello 
include 'mpif.h' 
implicit none 
integer tag,ierr,rank,numtasks,color,new_comm,inter1,inter2 
integer sendbuf,recvbuf,tag,stat(MPI_STATUS_SIZE) 

tag = 22 
sendbuf = 222 

call MPI_Init(ierr) 
call MPI_COMM_RANK(MPI_COMM_WORLD,rank,ierr) 
call MPI_COMM_SIZE(MPI_COMM_WORLD,numtasks,ierr) 

if (rank < 2) then 
color = 0 
else 
color = 1 
end if 

call MPI_COMM_SPLIT(MPI_COMM_WORLD,color,rank,new_comm,ierr) 

if (color .eq. 0) then 
if (rank == 0) print*,' 0 here' 
call MPI_INTERCOMM_CREATE(new_comm,0,MPI_Comm_world,2,tag,inter1,ierr) 
call mpi_send(sendbuf,1,MPI_INT,2,tag,inter1,ierr) 

!local_comm,local leader,peer_comm,remote leader,tag,new,ierr 

else if(color .eq. 1) then 
if(rank ==2) print*,' 2 here' 
call MPI_INTERCOMM_CREATE(new_comm,2,MPI_COMM_WORLD,0,tag,inter2,ierr) 
call mpi_recv(recvbuf,1,MPI_INT,0,tag,inter2,stat,ierr) 
print*,recvbuf 
end if 
end 

Answer 1

와 상호 통신이 가장 잘 이해되지 사용자, 예를 다른 동작 MPI 예로만큼 아니다된다. this link을 따라하면 좋은 설명을 찾을 수 있습니다. 간 의사 소통에

1) 통신은 항상 한 그룹에서 다른 그룹으로 이동 :

지금, 기억해야 할 두 가지가있다. 전송할 때 대상의 순위는 원격 그룹 통신자의 로컬 순위입니다. 수신하는 경우 발신자의 순위는 원격 그룹 통신자의 로컬 순위입니다.

2) 지점 간 통신 (MPI_send 및 MPI_recv 제품군)은 한 송신자와 수신자 사이에 있습니다. 귀하의 경우, 색상이 0 인 모든 사람이 보내고 있습니다. 색상이 모두 인 경우 문제가 있음을 이해하면 프로세스의 0 색을 1으로 보내주십시오.

보내는 코드는 다음과 같이해야한다 :

call MPI_COMM_RANK(inter1,irank,ierr) 
if(irank==0)then 
    call mpi_send(sendbuf,1,MPI_INT,0,tag,inter1,ierr) 
end if 

수신 코드가 같아야합니다 : 샘플 코드에서

call MPI_COMM_RANK(inter2,irank,ierr) 
if(irank==0)then 
    call mpi_recv(recvbuf,1,MPI_INT,0,tag,inter2,stat,ierr) 
    print*,'rec buff = ', recvbuf 
end if 

, 나는 쿼리하는 데 사용하는 새로운 변수 irank있다 상호 커뮤니케이터의 각 프로세스의 순위 이는 해당 지역 커뮤니케이터의 프로세스 순위입니다. 따라서 순위가 ​​0 인 두 개의 프로세스 (각 그룹에 하나씩)가 있습니다.

게시물의 다른 주석가가 말하는 것을 강조하는 것이 중요합니다. 현대에 프로그램을 만들 때 include 'mpif.h' 대신 use mpi과 같은 현대식 구조를 사용하십시오. Vladimir F.의 의견을 참조하십시오. 이전 질문에서 다른 조언을 받았습니다. 두 경우 모두 원격 리더로 0 등급을 지정하십시오. 더 문제가 발생할 수 있도록

program hello 
use mpi !instead of include 'mpif.h' 
implicit none 

    integer :: tag,ierr,rank,numtasks,color,new_comm,inter1,inter2 
    integer :: sendbuf,recvbuf,stat(MPI_STATUS_SIZE) 
    integer :: irank 
    ! 
    tag = 22 
    sendbuf = 222 
    ! 
    call MPI_Init(ierr) 
    call MPI_COMM_RANK(MPI_COMM_WORLD,rank,ierr) 
    call MPI_COMM_SIZE(MPI_COMM_WORLD,numtasks,ierr) 
    ! 
    if (rank < 2) then 
     color = 0 
    else 
     color = 1 
    end if 
    ! 
    call MPI_COMM_SPLIT(MPI_COMM_WORLD,color,rank,new_comm,ierr) 
    ! 
    if (color .eq. 0) then 
     call MPI_INTERCOMM_CREATE(new_comm,0,MPI_Comm_world,2,tag,inter1,ierr) 
    ! 
    call MPI_COMM_RANK(inter1,irank,ierr) 
    if(irank==0)then 
     call mpi_send(sendbuf,1,MPI_INT,0,tag,inter1,ierr) 
    end if 
    ! 
    else if(color .eq. 1) then 
     call MPI_INTERCOMM_CREATE(new_comm,0,MPI_COMM_WORLD,0,tag,inter2,ierr) 
     call MPI_COMM_RANK(inter2,irank,ierr) 
     if(irank==0)then 
      call mpi_recv(recvbuf,1,MPI_INT,0,tag,inter2,stat,ierr) 
      if(ierr/=MPI_SUCCESS)print*,'Error in rec ' 
      print*,'rec buff = ', recvbuf 
     end if 
    end if 
    ! 
    call MPI_finalize(ierr) 
end program h