2016-05-30 4 views
1

xpypzpのプロセスでプログラムが実行されたとします。 プロセスが次元(xp、yp、zp)のグリッドに配置されると考えることができるようにデカルトコミュニケータが使用されます。 このプロセスでは、ルートプロセス(0)は、各プロセス(ルートを含む)によって宣言された3D配列Aで塗りつぶされる3D配列Atotを宣言して割り当てます。異なるサイズのデータ​​型とのMPI通信

INTEGER, DIMENSION(3) :: Ntot 
INTEGER, DIMENSION(3) :: N 
INTEGER, DIMENSION(:,:,:), ALLOCATABLE :: Atot 
INTEGER, DIMENSION(:,:,:), ALLOCATABLE :: A 
: 
! the 3 elements of the array N are determined by dividing the corresponding 
! element of the array Ntot by the number of process in that direction 
! taking into account the reminder of the division. 
: 
IF (myid == 0) THEN ! myid is the process' rank 
    ALLOCATE(Atot(Ntot(1),Ntot(2),Ntot(3)) 
END IF 
ALLOCATE(A(N(1),N(2),N(3)) 
A = myid 

これは、通信を行う最も簡単で効率的な方法はどれですか? 私は約MPI_gatherを考えていた:各プロセスが(MPI_type_vectorが二回再帰的に使用する必要がありますN(1)*N(2)*N(3)MPI_INTEGER Sで構成され、ルートプロセスは、その後、キューブに対応する単一のMPI派生データ型にそれらを受けるべき配列全体Aを送信します、私は正しい?)。 これは可能ですか?

この作品としてもデカルト通信の各方向に沿ったプロセスの数が均等に配列A各工程において同一の寸法を有する場合には、Ntotの対応する要素を分割するとき、それは私には簡単に聞こえます。これは、Ntot = (/9,9,9/)の場合です。

ケースについてはどうですか?Ntot = (/10,10,10/)? mpiから派生したデータ型は、異なるプロセスで異なる次元を持つため、MPI_ghatherを使用することは可能ですか?

EDIT

私はMPI_GATHERVは、ソリューションの一部であり得ることを排除するものではありません。しかし、各プロセスは、異なる量のデータ、つまり異なる数のMPI_INTEGERS(単純な例で)を送信(およびルートプロセス受信)することができます。しかし、私が扱っているケースでは、ルートプロセスは3次元配列Atotのデータを受け取る必要があります。これを行うには、MPI派生データ型を定義すると便利だと思います。名前はsmallcubeとしましょう。この場合、各プロセスは配列A全体を送信しますが、マスタプロセスは各プロセスからsmallcubeタイプのデータを1つ受け取ります。要点は、デカルトグリッド内のその位置に依存して、3次元に沿って異なる長さを有することである(3次元に沿ったプロセスの数によって長さが均等に分割されないと仮定する)。small cube

+1

私が間違っていれば正しかったですが、MPI_GATHERV(Vに注意してください)は、各プロセスからのデータをさまざまに変更できると思います。質問の最後の部分で探しているのでしょうか? – Coriolis

+0

私は質問を編集しました: –

+2

これは 'MPI_ALLTOALLW'を使用して存在しない' MPI_SCATTERW'をエミュレートすることで実現できます。 Jonathan Dursi [here](http://stackoverflow.com/a/29476914/1374437)(これは 'MPI_ALLTOALLW'メソッドも含まれています)のCに対する標準的な答えを持つ別のメソッドがあります。どのように動作するのかを理解し、Fortranに変換してくれることを期待してください(そうするのは比較的簡単なはずです)。それまで他の誰もそれをやることができなければ、私はもう少し自由な時間を取ることができます。 –

答えて

3

コメントに記載されているように、実際にすべてのデータを1つのプロセッサにフェッチしたい場合は、MPI_Type_create_subarrayがこれを行う良い方法です。私はちょうど自分自身のプロジェクトでMPI_Type_create_subarrayを使用したことを考えれば、私は実例の答えを提供しようと考えていました(私はエラーチェックと宣言しているタイプで緩んでいます)。

program subarrayTest 
    use mpi 
    implicit none 
    integer, parameter :: n1 = 10, n2=20, n3=32 
    INTEGER, DIMENSION(3) :: Ntot, N, sizes, subsizes, starts 
    INTEGER, DIMENSION(:,:,:), ALLOCATABLE :: Atot, A 
    integer :: iproc, nproc, sendSubType, ierr 
    integer :: nl1, nl2, nl3 !Local block sizes 
    integer :: l1, l2, l3, u1, u2, u3 !Local upper/lower bounds 
    integer :: ip, sendRequest 
    integer, dimension(:), allocatable :: recvSubTypes, recvRequests 
    integer, dimension(:,:,:), allocatable :: boundsArr 

    !MPI Setup 
    call mpi_init(ierr) 
    call mpi_comm_size(mpi_comm_world, nproc, ierr) 
    call mpi_comm_rank(mpi_comm_world, iproc, ierr) 

    !Set grid sizes 
    Ntot = [n1,n2,n3] 
    !For simplicity I'm assuming we only split the last dimension (and it has nproc as a factor) 
    !although as long as you can specify l* and u* this should work (and hence nl* = 1+u*-l*) 
    if(mod(n3,nproc).ne.0) then 
    print*,"Error: n3 must have nproc as a factor." 
    call mpi_abort(mpi_comm_world,MPI_ERR_UNKNOWN,ierr) 
    endif 
    nl1 = n1 ; l1 = 1 ; u1=l1+nl1-1 
    nl2 = n2 ; l2 = 1 ; u2=l2+nl2-1 
    nl3 = n3/nproc ; l3 = 1+iproc*nl3 ; u3=l3+nl3-1 
    N = [nl1,nl2,nl3] 

    !Very lazy way to ensure proc 0 knows the upper and lower bounds for all procs 
    allocate(boundsArr(2,3,0:nproc-1)) 
    boundsArr=0 
    boundsArr(:,1,iproc) = [l1, u1] 
    boundsArr(:,2,iproc) = [l2, u2] 
    boundsArr(:,3,iproc) = [l3, u3] 
    call mpi_allreduce(MPI_IN_PLACE,boundsArr,size(boundsArr),MPI_INTEGER, & 
     MPI_SUM, mpi_comm_world, ierr) 

    !Allocate and populate local data portion 
    IF (iproc == 0) THEN ! iproc is the process' rank 
    ALLOCATE(Atot(Ntot(1),Ntot(2),Ntot(3))) 
    Atot=-1 !So you can check all elements are set 
    END IF 
    ALLOCATE(A(N(1),N(2),N(3))) 
    A = iproc 

    !Now lets create the sub array types 
    !First do the send type 
    sizes=N !The size of the local array 
    subsizes=1+[u1,u2,u3]-[l1,l2,l3] !The amount of data in each dimension to send -- here it's the full local data array but in general it could be a small subset 

    starts = [0,0,0] !These are the lower bounds in each dimension where the sub array starts -- Note MPI assumes 0 indexing here. 
    call mpi_type_create_subarray(size(sizes),sizes, subsizes, starts, & 
     MPI_ORDER_FORTRAN, MPI_INTEGER, sendSubType, ierr) 
    call mpi_type_commit(sendSubType, ierr) 

    !Now on proc0 setup each receive type 
    if (iproc == 0) then 
    allocate(recvSubTypes(0:nproc-1)) !Use 0 indexing for ease 
    sizes = Ntot !Size of dest array 
    do ip=0,nproc-1 
     subsizes=1+boundsArr(2,:,ip)-boundsArr(1,:,ip) !Size of A being sent from proc ip 
     starts = boundsArr(1,:,ip) -1 
     call mpi_type_create_subarray(size(sizes),sizes, subsizes, starts, & 
      MPI_ORDER_FORTRAN, MPI_INTEGER, recvSubTypes(ip), ierr) 
     call mpi_type_commit(recvSubTypes(ip), ierr) 
    end do 
    end if 

    !Now lets use non-blocking communications to transfer data 
    !First post receives -- tag with source proc id 
    if (iproc == 0) then 
    allocate(recvRequests(0:nproc-1)) 
    do ip=0,nproc-1 
     call mpi_irecv(Atot,1,recvSubTypes(ip),ip,ip,& 
      mpi_comm_world,recvRequests(ip),ierr) 
    end do 
    end if 

    !Now post sends 
    call mpi_isend(A,1,sendSubType,0,iproc,mpi_comm_world,& 
     sendRequest, ierr) 

    !Now wait on receives/sends 
    if(iproc == 0) call mpi_waitall(size(recvRequests),recvRequests,& 
     MPI_STATUSES_IGNORE,ierr) 
    call mpi_wait(sendRequest, MPI_STATUS_IGNORE, ierr) 

    if(iproc == 0) print*,Atot 
    call mpi_barrier(mpi_comm_world, ierr) 

    !Now free resources -- not shown 
    call mpi_finalize(ierr) 
end program subarrayTest 

mpif90でコンパイルできるはずです。あなたは、あなたのケースに適切に地域の境界を設定するためにこれで周りを再生する必要がありますが、うまくいけば、これは有用な出発点を提供します。下限と上限(l*u*)が正しく設定されていれば、ローカルアレイのサイズはプロセッサ間で同じであるとは限りません。上のコードはおそらく、さまざまな方法でベストプラクティスに従わないことに注意してください。

関連する問題