MPI_使用FORTRAN从所有处理器将二维数组转换为较大的二维阵列

Question

以下是我正在尝试使用我的代码执行的操作。

我必须在尺寸nx乘nz的二维网格上计算Fw和Fi。我将所有处理器之间的k循环分开，以便每个处理器通过（nz/p）计算nx，其中p是正在使用的处理器的数量。每个处理器完成后，我想收集所有的块，也就是说，每个nx由nz/p Fw和Fi组成，并将其放入根和Fw和Fi中。我最终想要使用allgather，即收集所有计算的Fw和Fi到所有处理器中。

我附上了下面的代码。

我不确定我是在指定sendcount和recvcount权限还是为什么我的代码是死锁。任何帮助表示赞赏。谢谢！

PROGRAM gridtestpar 
    IMPLICIT NONE 

    INTEGER :: nx, nz, i, k, t 
    INTEGER :: order, mx, mz 
    INTEGER :: count 
    INTEGER :: ierror, comm, p, rank, npr, s, f, np(2) 

    REAL(KIND = 8) :: dx, dz, startx, startz, finishx, finishz 
    REAL(KIND = 8) :: dt 
    REAL(KIND = 8) :: cx, cz 
    REAL(KIND = 8) :: cbx, cbz 
    REAL(KIND = 8), ALLOCATABLE ::X(:), Z(:), Fw(:,:), Fi(:,:) 
    REAL(KIND = 8), ALLOCATABLE :: Fn(:,:), Fnp1(:,:) 



    include 'mpif.h' 

    !---------------------------------------------------------- 
    !Parameters that can be changed 
    !--------------------------------------------------------- 

    !Time step 
    dt = 0.000000001d0 
    !Number of points in x and z direction(i.e. streamwise and 
    !spanwise) directions respectively 
    nx = (400*5) 
    nz = (400*5) 

    !First and last grid point locations in x and z directions 
    startx = 0.d0 
    finishx = 60.d0*5.d0 
    startz = 0.d0 
    finishz = 60.d0*5.d0 
    !Distance between grid points 
    dx = (finishx-startx)/REAL(nx-1) 
    dz = (finishz-startz)/REAL(nz-1) 


    !Allocate 
    ALLOCATE(X(nx), Z(nz)) 
    ALLOCATE(Fw(nx,nz), Fi(nx,nz)) 
    ALLOCATE(Fn(nx,nz), Fnp1(nx,nz)) 


    ! Make Grid 
    !-------------------------------------------------------------- 
    DO i = 1, nx 
    X(i) = (i-1)*dx 
    END DO 

    DO k = 1, nz 
    Z(k) = (k-1)*dx 
    END DO 

    CALL MPI_INIT(ierror) 
    comm = MPI_COMM_WORLD 
    !Get rank 
    CALL MPI_COMM_RANK(comm, rank, ierror) 
    !Get number of processors 
    CALL MPI_COMM_SIZE(comm, p, ierror) 


    !split job between all processors 
    npr = INT((nz-1)/p) 
    DO k = rank*npr+1, (rank+1)*npr 
    DO i = 1, nx 
     cx = 50.d0 
     Fi(i,k) = 0.d0 
     DO mx = 1,30 
      cz = 0.d0; 
      DO mz = 1,13*5 
       Fi(i,k) = Fi(i,k) + EXP(-0.9d0*((X(i)-cx)**2+(Z(k)-cz)**2)) 
       cz = cz + 5.d0 
      END DO 
      cx = cx + 5.d0 
     END DO 
     cbz = 0.d0 
     cbx = 30.d0 
     DO mx = 1,4*5 
      Fw(i,k) = Fw(i,k) + 0.05d0 + 7.d0*EXP(-0.1*((X(i)-cbx)**2 & 
       + (Z(k)-cbz)**2)) + 0.1d0*Fi(i,k) 
      cbz = cbz + 20.d0 
     END DO 
    END DO 
    END DO 


    s = rank*npr+1 
    f = (rank+1)*npr 
    np(1) = nx 
    np(2) = npr 


    CALL MPI_GATHER(Fw(:,s:f), np , MPI_DOUBLE_PRECISION, & 
     Fw,np , MPI_DOUBLE_PRECISION, 0, comm, ierror) 
    CALL MPI_GATHER(Fi(:,s:f), np , MPI_DOUBLE_PRECISION, & 
     Fi,np , MPI_DOUBLE_PRECISION, 0, comm, ierror) 

    Fn(:,:) = Fw(:,:) - Fi(:,:) 
    Fnp1 = Fn 

    WRITE(*,*) "I'm here" 


    IF(rank == 0) THEN 
    !Output initial condition 
    !---------------------------------------------------------------- 
    OPEN(unit = 11, file = "Fiinitial.dat") 
    WRITE(11,*) 'Variables = "X", "Z", "Fi"' 
    WRITE(11,*) 'Zone I = ', nx, 'J = ', nz, 'F = POINT' 
    DO k = 1, nz 
     DO i = 1, nx 
      WRITE(11,*) X(i), Z(k), Fi(i,k) 
     END DO 
    END DO 
    WRITE(11,*) 'Zone I = ', nx, 'J = ', nz, 'F = POINT' 
    DO k = 1, nz 
     DO i = 1, nx 
      WRITE(11,*) X(i), Z(k), Fw(i,k) 
     END DO 
    END DO 
    CLOSE(11) 
    END IF 

    CALL MPI_FINALIZE(ierror) 

END PROGRAM gridtestpar 

Answer 1

您错误地致电mpi_gather()子例程。你必须通过它总数。的元素应该作为发送缓冲区的一个整数传送，并作为接收缓冲区的其他整数传送。你代替每个整数都有两个整数数组，每个整数数组包含每个维上的元素数。只要乘以你的数组中的数字，并将结果传递一个整数，而不是：

program gridtestpar 
    use mpi 
    implicit none 

    integer, parameter :: dp = kind(1.0d0) 
    integer :: nx, nz 
    integer :: ierror, comm, p, rank, npr, s, f, np(2) 
    real(dp), allocatable :: Fw(:,:), Fi(:,:) 

    nx = (400*5) 
    nz = (400*5) 

    allocate(Fw(nx,nz)) 
    allocate(Fi(nx,nz)) 
    Fw(:,:) = 0.0_dp 
    Fi(:,:) = 0.0_dp 

    call mpi_init(ierror) 
    comm = MPI_COMM_WORLD 
    call mpi_comm_rank(comm, rank, ierror) 
    call mpi_comm_size(comm, p, ierror) 

    s = rank * npr + 1 
    f = (rank + 1) * npr 

    call mpi_gather(Fw(:,s:f), nx * (f - s + 1), MPI_DOUBLE_PRECISION, & 
     Fw, nx * npr, MPI_DOUBLE_PRECISION, 0, comm, ierror) 
    call mpi_gather(Fi(:,s:f), nx * (f - s + 1), MPI_DOUBLE_PRECISION, & 
     Fi, nx * npr, MPI_DOUBLE_PRECISION, 0, comm, ierror) 
    write(*,*) "I'm here" 
    call mpi_finalize(ierror) 

end program gridtestpar 

也许一些补充意见：

• 请随时张贴最短的包含代码自我，这演示了这个问题。没有人喜欢花时间阅读并试图理解不相关的代码片段。放弃一切对于再现问题不重要的东西。也许，这样你甚至可以自己找到解决方案。

• 指定精度时请勿使用kind = 8。请参阅last part of this answer以及其中的一些意见。

• 您应该使用mpi 模块而不是包含文件。