1

这是我试图用我的代码做的事情。

我必须在大小为 nx x nz 的二维网格上计算 Fw 和 Fi。我在所有处理器之间拆分 k 循环，以便每个处理器通过 (nz/p) 计算 nx，其中 p 是正在使用的处理器数量。在每个处理器完成后，我想收集所有块，即每个 nx by 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
4

1 回答 1

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指定精度时不要使用。请参阅此答案的最后一部分以及对其的一些评论以获取替代方案。

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

于 2013-03-13T19:36:57.710 回答