组间通信错误

时间:2016-07-20 17:03:39

标签: parallel-processing fortran mpi openmpi

我必须实现一个我有2个组的场景。组1仅包含进程0和1.组2包含所有进程。现在,组2中的进程读取一些数据并将其发送到组1(进程0或1,等分)。它应该是这样的:

       Grp1  Grp2
Rank
(grp)
 0      0     0
 1      1     1
 2            2
 3            3
 4            4 and so on..

现在要实现这个,我使用了以下代码(所有变量和其他东西都要小心)

 program mpi
 use mpi

 integer ierr,new_rank1,new_grp1,new_rank2,new_grp2,new_comm1,new_comm2 
 integer numtasks,rank,orig_grp,tag,sendbuf,recvbuf
 integer ranks1(2),ranks2(8),stat(MPI_STATUS_SIZE)
 data ranks1 /0,1/,ranks2 /0,1,2,3,4,5,6,7/


 call mpi_init(ierr)
 call mpi_comm_rank(mpi_comm_world,rank,ierr)
 call mpi_comm_size(mpi_comm_world,numtasks,ierr)

 call MPI_COMM_GROUP(MPI_COMM_WORLD,orig_grp,ierr)
 tag = 342


 call MPI_GROUP_INCL(orig_grp,8,ranks2,new_grp2,ierr)

 call mpi_comm_create_group(mpi_comm_world,new_grp2,112,new_comm2,ierr)

 call mpi_comm_rank(new_comm2,new_rank2,ierr)

 if(new_rank2 == 4) then
    call mpi_send(123,1,MPI_INT,0,tag,new_comm2,ierr) !send a msg from rank 4 of group 2 to rank 0 of group 1
 end if

 if(rank <2) then
   call MPI_GROUP_INCL(orig_grp,2,ranks1,new_grp1,ierr)

 call mpi_comm_create_group(mpi_comm_world,new_grp1,111,new_comm1,ierr)
   call mpi_comm_rank(new_comm1,new_rank1,ierr)

   if(new_rank1 == 0) then
       call mpi_recv(recvbuf,1,MPI_INT,4,tag,new_comm2,stat,ierr)
       print*,recvbuf
     end if
   end if
   call mpi_finalize(ierr)
   end

面对发送和接收数据时的错误。其他的工作正常。如果整个概念都错了,我愿意接受建议。

0 个答案:

没有答案