USE decompmodule, ONLY : DecompType, DecompGlobalToLocal, DecompInfo      USE ghostmodule, ONLY : GhostType, GhostInfo      IMPLICIT NONE! !INPUT PARAMETERS:      INTEGER,  INTENT( IN )               :: InComm  ! # of PEs      TYPE(GhostType),   INTENT( IN )      :: GA      ! Source Decomp Desc      TYPE(DecompType),  INTENT( IN )      :: DB      ! Target Decomp Desc! !OUTPUT PARAMETERS:      TYPE(ParPatternType), INTENT( OUT )  :: Pattern ! Comm Pattern!! !DESCRIPTION:!     This routine contructs a communication pattern for a !     transformation from one ghosted decomposition to partitioned!     one, i.e., a so-called "transpose". The resulting communication !     pattern can be used in ParBegin/EndTransfer with the decomposed !     arrays as inputs.  !! !SYSTEM ROUTINES:!! !BUGS:!     Under development!! !REVISION HISTORY:!   02.01.10   Sawyer     Creation from DecompToDecomp!!EOP!-----------------------------------------------------------------------!BOC! !LOCAL VARIABLES:      LOGICAL NewIpe      INTEGER I, J, Tag, Local, Pe, Len, JA, Ipe, Num, Inc, Off      INTEGER NpesA, GlobalSizeA, LocalSizeA, BorderSizeA      INTEGER OldPe, OldLocal, TotalPtsB, NpesB      INTEGER GroupSize, Iam, Ierror      INTEGER Ptr                                ! Pointer type      INTEGER, ALLOCATABLE :: Count(:)           ! # segments for each recv PE      INTEGER, ALLOCATABLE :: CountOut(:)        ! # segments for each send PE      INTEGER, ALLOCATABLE :: DisplacementsA(:)  ! Generic displacements      INTEGER, ALLOCATABLE :: BlockSizesA(:)     ! Generic block sizes      INTEGER, ALLOCATABLE :: GlobalA(:)          ! Generic Local indices      INTEGER, ALLOCATABLE :: PeA(:)             ! Processor element numbers      INTEGER, ALLOCATABLE :: DisplacementsB(:)  ! Displacements for B      INTEGER, ALLOCATABLE :: BlockSizesB(:)     ! Block sizes for B      INTEGER, ALLOCATABLE :: GlobalB(:)          ! Global indices for B      CPP_ENTER_PROCEDURE( "PARPATTERNGHOSTTODECOMP" )      CALL GhostInfo( GA, NpesA, GlobalSizeA, LocalSizeA, BorderSizeA )      CALL DecompInfo( DB, NpesB, TotalPtsB )#if defined( USE_ARENAS )! Communicator is assumed to be over all PEs for now      GroupSize = Gsize      Iam = gid      Pattern%Comm = 0#else      CALL MPI_COMM_SIZE( InComm, GroupSize, Ierror )      CALL MPI_COMM_RANK( InComm, Iam, Ierror )      CALL MPI_COMM_DUP( InComm, Pattern%Comm, Ierror )#endif      Pattern%Size = GroupSize      Pattern%Iam  = Iam!! Allocate the number of entries and list head arrays!      CPP_ASSERT_F90( NpesA .EQ. GroupSize )      CPP_ASSERT_F90( NpesB .EQ. GroupSize )!! Allocate the patterns!      ALLOCATE( Pattern%SendDesc( GroupSize ) )      ALLOCATE( Pattern%RecvDesc( GroupSize ) )!! Local allocations!      ALLOCATE( DisplacementsA( GlobalSizeA ) )   ! Allocate for worst case      ALLOCATE( BlockSizesA( GlobalSizeA ) )      ! Allocate for worst case      ALLOCATE( GlobalA( GlobalSizeA ) )           ! Allocate for worst case      ALLOCATE( PeA( GlobalSizeA ) )              ! Allocate for worst case      ALLOCATE( DisplacementsB( TotalPtsB ) )   ! Allocate for worst case      ALLOCATE( BlockSizesB( TotalPtsB ) )      ! Allocate for worst case      ALLOCATE( GlobalB( TotalPtsB ) )           ! Allocate for worst case      ALLOCATE( Count( GroupSize ) )      ALLOCATE( CountOut( GroupSize ) )      JA        = 0      Count     = 0      Len      = 0      NewIpe = .TRUE.      Num    = 0      Inc    = 0!! Parse through all the tags in the local segment      DO J = 1, SIZE( DB%Head(iam+1)%StartTags )        OldPe     = -1         ! Set PE undefined        OldLocal  = 0          ! Set index value undefined        DO Tag=DB%Head(iam+1)%StartTags(J), DB%Head(iam+1)%EndTags(J)!! Determine the index and PE of this entry on A. This might be inlined later!          CALL DecompGlobalToLocal( GA%Decomp, Tag, Local, Pe )!! If ipe-1 is my id, then this is an entry ipe will receive from Pe!          IF ( Pe /= OldPe  .OR. Local /= OldLocal+1 ) THEN            OldPe   = Pe            IF ( ja > 0 ) THEN              BlockSizesA(ja) = Len              Len = 0            ENDIF            ja = ja+1                     ! increment the segment index            DisplacementsA(ja) = Inc      ! Zero-based offset of local segment            GlobalA(ja) = Tag             ! The global tag of the desired datum            PeA(ja) = Pe                  ! Note the ID of the sender            Count(Pe+1) = Count(Pe+1)+1   ! Increment counter of segments          ENDIF          OldLocal = Local                ! Update old local index          Len = Len+1                     ! Good -- segment is getting longer          Inc = Inc+1                     ! Increment local index        ENDDO      ENDDO!! Clean up!      BlockSizesA(ja) = Len#if defined(DEBUG_PARPATTERNGHOSTTODECOMP)      print *, iam, "BlockSizes", BlockSizesA(1:ja), DisplacementsA(1:ja), PeA(1:ja), Count#endif      CPP_ASSERT_F90( JA .LE. GlobalSizeA )!! Now create the pattern from the displacements and block sizes!      Inc = 0      DO ipe = 1, GroupSize!! Find the segments which are relevant for the sender ipe! Make compact arrays BlockSizes and Displacements !        DO j = 1, ja          IF ( PeA(j) == ipe-1 ) THEN            Inc = Inc + 1            BlockSizesB(Inc) = BlockSizesA(j)            DisplacementsB(Inc) = DisplacementsA(j)            GlobalB(Inc)      = GlobalA(j)          ENDIF        ENDDO      ENDDO!! Create the receiver communication pattern!      Off = 0      DO ipe = 1, GroupSize        Num = Count(ipe)        DO i=1, Num        ENDDO#if defined(DEBUG_PARPATTERNGHOSTTODECOMP)        print *, "Receiver Iam", Iam, "Ipe", Ipe-1, "Num", Num, &                 "Displacements", DisplacementsB(Off+1:Off+Num), &                 "BlockSizes", BlockSizesB(Off+1:Off+Num)#endif#if defined( USE_ARENAS )        ALLOCATE( Pattern%RecvDesc(ipe)%Displacements(Num) )        ALLOCATE( Pattern%RecvDesc(ipe)%BlockSizes(Num) )        DO i=1, Num          Pattern%RecvDesc(ipe)%Displacements(i) = DisplacementsB(i+Off)          Pattern%RecvDesc(ipe)%BlockSizes(i)    = BlockSizesB(i+Off)        ENDDO#else        CALL MPI_TYPE_INDEXED( Num, BlockSizesB(Off+1),DisplacementsB(Off+1), &     &                         CPP_MPI_REAL8, Ptr, Ierror )        Pattern%RecvDesc( ipe ) = Ptr#endif        Off = Off + Num      ENDDO!! Now communicate what the receiver is expecting to the sender!      CALL ParExchangeVectorInt( InComm, Count, GlobalB,                 &     &                           CountOut, GlobalA  )      CALL ParExchangeVectorInt( InComm, Count, BlockSizesB,            &     &                           CountOut, BlockSizesA )!! Sender A: BlockSizes and Displacements can now be stored!      Off = 0      DO ipe=1, GroupSize        Num = CountOut(ipe)        DO i=1, Num          CALL DecompGlobalToLocal( GA%Local, GlobalA(i+Off), Local, Pe )          DisplacementsA(i+Off) = Local-1    ! zero-based displacement        ENDDO#if defined(DEBUG_PARPATTERNGHOSTTODECOMP)        print *, "Sender Iam", Iam, "Ipe", Ipe-1, "Num", Num,  &                 "Displacements", DisplacementsA(Off+1:Off+Num), &                 "BlockSizes", BlockSizesA(Off+1:Off+Num)#endif#if defined( USE_ARENAS )        ALLOCATE( Pattern%SendDesc(ipe)%Displacements(Num) )        ALLOCATE( Pattern%SendDesc(ipe)%BlockSizes(Num) )        DO i=1, Num          Pattern%SendDesc(ipe)%Displacements(i) = DisplacementsA(i+Off)          Pattern%SendDesc(ipe)%BlockSizes(i)    = BlockSizesA(i+Off)        ENDDO#else        CALL MPI_TYPE_INDEXED( Num, BlockSizesA(Off+1),DisplacementsA(Off+1),&     &                         CPP_MPI_REAL8, Ptr, Ierror )        Pattern%SendDesc( ipe ) = Ptr#endif        Off = Off + Num      ENDDO      DEALLOCATE( CountOut )      DEALLOCATE( Count )      DEALLOCATE( PeA )      DEALLOCATE( GlobalA )      DEALLOCATE( BlockSizesA )      DEALLOCATE( DisplacementsA )      DEALLOCATE( GlobalB )      DEALLOCATE( BlockSizesB )      DEALLOCATE( DisplacementsB )      CPP_LEAVE_PROCEDURE( "PARPATTERNGHOSTTODECOMP" )      RETURN!EOC      END SUBROUTINE ParPatternGhostToDecomp!-----------------------------------------------------------------------!-----------------------------------------------------------------------!BOP! !IROUTINE:   ParPatternGhostToGhost --- Create pattern between decomps!! !INTERFACE:      SUBROUTINE ParPatternGhostToGhost( InComm, GA, GB, Pattern )!! !USES:      USE decompmodule, ONLY : DecompGlobalToLocal      USE ghostmodule, ONLY : GhostType, GhostInfo      IMPLICIT NONE! !INPUT PARAMETERS:      INTEGER,  INTENT( IN )               :: InComm  ! # of PEs      TYPE(GhostType),   INTENT( IN )      :: GA      ! Source Ghost Decomp      TYPE(GhostType),   INTENT( IN )      :: GB      ! Target Ghost Decomp! !OUTPUT PARAMETERS:      TYPE(ParPatternType), INTENT( OUT )  :: Pattern ! Comm Pattern!! !DESCRIPTION:!     This routine contructs a communication pattern for a !     transformation from one ghosted decomposition to partitioned!     one, i.e., a so-called "transpose". The resulting communication !     pattern can be used in ParBegin/EndTransfer with the decomposed !     arrays as inputs.  !! !SYSTEM ROUTINES:!! !BUGS:!     Under development!! !REVISION HISTORY:!   02.01.10   Sawyer     Creation from DecompToDecomp!!EOP!-----------------------------------------------------------------------!BOC! !LOCAL VARIABLES:      LOGICAL NewIpe      INTEGER I, J, Tag, Local, Pe, Len, JA, Ipe, Num, Inc, Off      INTEGER NpesA, GlobalSizeA, LocalSizeA, BorderSizeA      INTEGER NpesB, GlobalSizeB, LocalSizeB, BorderSizeB      INTEGER GroupSize, Iam, Ierror, OldPe, OldLocal       INTEGER Ptr                                ! Pointer type      INTEGER, ALLOCATABLE :: Count(:)           ! # segments for each recv PE      INTEGER, ALLOCATABLE :: CountOut(:)        ! # segments for each send PE      INTEGER, ALLOCATABLE :: DisplacementsA(:)  ! Generic displacements      INTEGER, ALLOCATABLE :: BlockSizesA(:)     ! Generic block sizes      INTEGER, ALLOCATABLE :: GlobalA(:)          ! Generic Local indices      INTEGER, ALLOCATABLE :: PeA(:)             ! Processor element numbers      INTEGER, ALLOCATABLE :: DisplacementsB(:)  ! Displacements for B      INTEGER, ALLOCATABLE :: BlockSizesB(:)     ! Block sizes for B      INTEGER, ALLOCATABLE :: GlobalB(:)          ! Global indices for B      CPP_ENTER_PROCEDURE( "PARPATTERNGHOSTTOGHOST" )      CALL GhostInfo( GA, NpesA, GlobalSizeA, LocalSizeA, BorderSizeA )      CALL GhostInfo( GB, NpesB, GlobalSizeB, LocalSizeB, BorderSizeB )#if defined( USE_ARENAS )! Communicator is assumed to be over all PEs for now      GroupSize = Gsize      Iam = gid      Pattern%Comm = 0#else      CALL MPI_COMM_SIZE( InComm, GroupSize, Ierror )      CALL MPI_COMM_RANK( InComm, Iam, Ierror )      CALL MPI_COMM_DUP( InComm, Pattern%Comm, Ierror )#endif      Pattern%Size = GroupSize      Pattern%Iam  = Iam!! Allocate the number of entries and list head arrays!      CPP_ASSERT_F90( NpesA .EQ. GroupSize )      CPP_ASSERT_F90( NpesB .EQ. GroupSize )!! Allocate the patterns!      ALLOCATE( Pattern%SendDesc( GroupSize ) )      ALLOCATE( Pattern%RecvDesc( GroupSize ) )!! Local allocations!      ALLOCATE( DisplacementsA( GlobalSizeA ) )   ! Allocate for worst case      ALLOCATE( BlockSizesA( GlobalSizeA ) )      ! Allocate for worst case      ALLOCATE( GlobalA( GlobalSizeA ) )          ! Allocate for worst case      ALLOCATE( PeA( GlobalSizeB ) )              ! Allocate for worst case      ALLOCATE( DisplacementsB( GlobalSizeB ) )   ! Allocate for worst case      ALLOCATE( BlockSizesB( GlobalSizeB ) )      ! Allocate for worst case      ALLOCATE( GlobalB( GlobalSizeA ) )          ! Allocate for worst case      ALLOCATE( Count( GroupSize ) )      ALLOCATE( CountOut( GroupSize ) )      JA        = 0      Count     = 0      Len      = 0      NewIpe = .TRUE.      Num    = 0      Inc    = 0!! Parse through all the tags in the local segment      DO J = 1, SIZE( GB%Local%Head(iam+1)%StartTags )        OldPe     = -1         ! Set PE undefined        OldLocal  = 0          ! Set index value undefined        DO Tag=GB%Local%Head(iam+1)%StartTags(J), GB%Local%Head(iam+1)%EndTags(J)!! Determine the index and PE of this entry on A. This might be inlined later!          CALL DecompGlobalToLocal( GA%Decomp, Tag, Local, Pe )!! If ipe-1 is my id, then this is an entry ipe will receive from Pe!          IF ( Pe /= OldPe  .OR. Local /= OldLocal+1 ) THEN            OldPe   = Pe            IF ( ja > 0 ) THEN              BlockSizesA(ja) = Len              Len = 0            ENDIF            ja = ja+1                     ! increment the segment index            DisplacementsA(ja) = Inc      ! Zero-based offset of local segment            GlobalA(ja) = Tag             ! The global tag of the desired datum            PeA(ja) = Pe                  ! Note the ID of the sender            Count(Pe+1) = Count(Pe+1)+1   ! Increment counter of segments          ENDIF          OldLocal = Local                ! Update old local index          Len = Len+1                     ! Good -- segment is getting longer          Inc = Inc+1                     ! Increment local index        ENDDO      ENDDO!! Clean up!      BlockSizesA(ja) = Len#if defined(DEBUG_PARPATTERNGHOSTTOGHOST)