Question

这就是我想用我的代码做的事情。

我必须在2-d网格上计算大小为nx乘以nz的Fw和Fi。我在所有处理器之间拆分k循环，以便每个处理器计算nx乘以（nz / p），其中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()子例程。你必须传递总数nr。元素应该作为发送缓冲区的一个整数传递，并作为接收缓冲区的另一个整数传递。您为每个整数传递了一个带有两个整数的数组，其中包含沿每个维度的元素数。只需将数组中的数字相乘，然后将结果作为整数传递：

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 模块而不是包含文件。

MPI_Gather从所有处理器收集2-d阵列到FORTRAN的根目录上更大的2-d阵列

1 个答案: