Question

我用MPI实现了一个简单的一维泊松方程并行求解器，让我熟悉MPI库。我将代码设计为使用未指定数量的处理器（包括只有1个）运行。

在1或2个处理器上运行时，代码运行并产生良好的结果。但是，它会停留在具有4个处理器的mpi_send和mpi_recv调用上。因此，我希望我实施的鬼点交换是错误的。

由于代码太大而不能包含在这里，我只包括雅可比方案和数据交换：

do iter=1,max_iter                                                                                    
    !~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~             
    ! Initial guess, on interior points only                                                          
    Ujacob(min_x+1:max_x-1) = 0._dp                                                                   
    Ujacob_all(0:grid_nx-1) = 0._dp                                                                   

    !~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~             
    ! Store solution vector from last iteration                                                       
    Uold    (:) = Ujacob    (:)                                                                       
    Uold_all(:) = Ujacob_all(:)                                                                       

    !~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~             
    ! Jacobi scheme                                                                                   
    do ii=min_x+1,max_x-1                                                                             
        !Ujacob(ii) = 0.5_dp * (Uold  (ii-1) + Uold  (ii+1) - grid_delta_x**2 * Urhs(ii))             
    end do                                                                                            

    !~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~             
    ! Gather Ujacob vector                                                                            
    call mpi_allgather(Ujacob(0:proc_nx-1), proc_nx, mpi_float,                         &             
                    &  Ujacob_all,          proc_nx, mpi_float, mpi_comm_world, ierror)               

    !~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~             
    ! Compute error and check if less than tolerance value                                            
    error = sqrt((sum(Ujacob_all - Uold_all)**2) / dble(grid_nx))                                     

    if(error < error_tol) return                                                                      
    !~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~             
    ! Exchange data points                                                                            

    ! Interior processors                                                                         
    if(Xsrc /= -1 .AND. Xdes /= -1) then
        call mpi_send(Ujacob(        0), 1, mpi_float, Xsrc, 200, mpi_comm_world, ierror)         
        call mpi_send(Ujacob(proc_nx-1), 1, mpi_float, Xdes, 100, mpi_comm_world, ierror)         

        call mpi_recv(Ujacob(     -1), 1, mpi_float, Xsrc, 100, mpi_comm_world, stat, ierror)     
        call mpi_recv(Ujacob(proc_nx), 1, mpi_float, Xdes, 200, mpi_comm_world, stat, ierror)
    ! First processor                                                                             
    elseif(Xsrc == -1) then                                                                    
        call mpi_send(Ujacob(proc_nx-1), 1, mpi_float, Xdes, 100, mpi_comm_world, ierror)         
        call mpi_recv(Ujacob(proc_nx  ), 1, mpi_float, Xdes, 200, mpi_comm_world, stat, ierror)
    ! Last processor                                                                              
    elseif(Xdes == -1) then                                                                   
        call mpi_send(Ujacob( 0), 1, mpi_float, Xsrc, 200, mpi_comm_world, ierror)                
        call mpi_recv(Ujacob(-1), 1, mpi_float, Xsrc, 100, mpi_comm_world, stat, ierror)          
    end if                                                                                                           
end do

Xsrc和Xdes按以下方式设置：

   !~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ 
    ! Setting the source and destination neighbors of each processor                              
    if(myid == 0) then                                                                            
        Xsrc = -1                                                                                 
        Xdes = myid + 1                                                                           
    elseif(myid == nprocs-1) then                                                                 
        Xsrc = myid -1                                                                            
        Xdes = -1                                                                                 
    else                                                                                          
        Xsrc = myid - 1                                                                           
        Xsrc = myid + 1                                                                           
    end if

另外，我已经检查过处理器等级0和nprocs-1确实对应于左边界和右边界处理器。

我已经检查过标签设置得很好。此外，您可以随意评论您认为可以改进的任何内容。

Answer 1

@Hristo是正确的，你的代码在概念上原则上是有缺陷的。但是，几乎每个MPI实现都会为包含单个实数的消息缓冲MPI_Send（当然这不保证），所以这不是您的代码的问题。

我认为你的标签不匹配 - 边缘情况应该反转标签：

  elseif(Xsrc == -1) then                                                                    
        call mpi_send(Ujacob(proc_nx-1), 1, mpi_float, Xdes, 200, mpi_comm_world, ierror)         
        call mpi_recv(Ujacob(proc_nx  ), 1, mpi_float, Xdes, 100, mpi_comm_world, stat, ierror)
    ! Last processor                                                                              
    elseif(Xdes == -1) then                                                                   
        call mpi_send(Ujacob( 0), 1, mpi_float, Xsrc, 100, mpi_comm_world, ierror)                
        call mpi_recv(Ujacob(-1), 1, mpi_float, Xsrc, 200, mpi_comm_world, stat, ierror)          
    end if

关于代码的一些其他评论：

使用allgather计算错误项非常低效：您应该只对本地元素求和，然后用MPI_Allreduce计算全局错误;
你应该使用MPI_REAL而不是MPI_FLOAT作为Fortran代码;
我没看到我们的代码如何在单个进程上运行 - 这里进程将执行第一个elseif子句，然后尝试发送到不存在的等级。

检查完您的代码后，您应该修复@Hristo指出的问题。

用MPI求解泊松方程时代码卡住了

1 个答案: