Senden und Empfangen von Operationen zwischen Kommunikatoren in MPI

Question

meine vorherige Frage Folgende: Unable to implement MPI_Intercomm_create

Das Problem der MPI_INTERCOMM_CREATE gelöst ist. Aber wenn ich versuche, grundlegende Sendeempfangsoperationen zwischen Prozess 0 von Farbe 0 (global Rang = 0) und Prozess 0 von Farbe 1 (dh global Rang = 2) zu implementieren, legt der Code nach dem Drucken des empfangenen Puffers einfach auf. der Code:

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

Die Kommunikation mit Sprech wird von den meisten Anwendern nicht gut verstanden, und Beispiele sind nicht so viele, wie Beispiele für andere MPI-Operationen. Sie können eine gute Erklärung finden, indem Sie this link folgen.

Nun gibt es zwei Dinge zu erinnern:

1) Kommunikation in einem Inter-Kommunikator geht immer von einer Gruppe in der anderen Gruppe. Beim Senden ist der Rang des Ziels der lokale Rang im Remote-Gruppenkommunikator. Beim Empfang ist der Rang des Absenders der lokale Rang im Remote-Gruppenkommunikator.

2) Punkt-zu-Punkt-Kommunikation (MPI_send und MPI_recv-Familie) ist zwischen einem Sender und einem Empfänger. In Ihrem Fall wird jeder in Farbe 0 senden und jeder in Farbe 1 empfängt jedoch, wenn ich Ihr Problem verstanden habe, möchten Sie den Prozess 0 der Farbe etwas an den Prozess 0 der Farbe senden.

Der Sende Code in etwa so sein sollte:

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

Der Empfang Code soll wie folgt aussehen:

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 

Im Beispielcode gibt es eine neue Variable irank, die ich zur Abfrage verwenden der Rang jedes Prozesses im Interkommunikator; Das ist der Rang des Prozesses in seinem lokalen Kommunikator. Sie haben also zwei Prozesse mit dem Rang 0, einen für jede Gruppe und so weiter.

Es ist wichtig zu betonen, was andere Kommentatoren Ihres Beitrags sagen: Wenn Sie ein Programm in diesen modernen Tagen bauen, verwenden moderne Konstrukte wie use mpi statt include 'mpif.h' siehe Kommentar von Vladimir F. Ein weiterer Hinweis von Ihrer vorherigen Frage war yo Verwendung Rang 0 als Remote-Führer in beiden Fällen. Wenn ich diese zwei Ideen kombinieren, können Sie Ihr Programm wie folgt aussehen:

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