1

これが私のコードでやろうとしていることです。

サイズ nx x nz の 2 次元グリッドで Fw と Fi を計算する必要があります。k ループをすべてのプロセッサ間で分割して、各プロセッサが nx by(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
4

1 に答える 1

1

mpi_gather()サブルーチンを正しく呼び出していません。合計番号を渡す必要があります。送信バッファの 1 つの整数として、受信バッファの別の整数として通信する必要がある要素の数。各整数の代わりに、各次元に沿った要素数を含む 2 つの整数を含む配列を渡しました。配列内の数値を乗算し、代わりに整数として結果を渡します。

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 に答える