decompmodule.f90

来自「CCSM Research Tools: Community Atmospher」· F90 代码 · 共 1,293 行 · 第 1/3 页

!-------------------------------------------------------------------------
!         NASA/GSFC, Data Assimilation Office, Code 910.3, GEOS/DAS
!-------------------------------------------------------------------------
      MODULE decompmodule
!BOP
!
! !MODULE: decompmodule
!
! !USES:
#include "debug.h"

      IMPLICIT NONE

!
! !DESCRIPTION:
!
!      This module provides the DecompType and its create and destroy 
!      routines.
!      \begin{center}
!      \begin{tabular}{|l|l|} \hline \hline
!         DecompType        & Type to describe a decomposition \\ \hline
!         DecompFree        & Destroy a decomposition \\ \hline
!         DecompCopy        & Copy decomposition to newly created one\\ \hline 
!         DecompPermute     & Permute decomposition \\ \hline 
!         DecompRegular1D   & Create a 1-D decomposition \\ \hline 
!         DecompRegular2D   & Create a 2-D decomposition \\ \hline 
!         DecompRegular3D   & Create a 3-D decomposition \\ \hline 
!         DecompCreateIrr   & Create an irregular 1-D decomposition \\ \hline
!         DecompCreateTags  & Create a decomposition from Pe and Tags \\ \hline
!         DecompGlobalToLocal& Map a global index to a local one \\ \hline
!         DecompLocalToGlobal& Map a local index to a global one \\
!         \hline  \hline
!      \end{tabular}
!      \end{center}
!
!      The decomposition type contains the sizes of the global array,
!      the number of entries on each PE, and for each PE a list
!      of "runs", i.e., the starting and finishing global indices
!      or "tags" whose inclusive array section resides on that PE.
!      Clearly this method of decomposition is only efficient if
!      there are long runs, i.e., long array sections which are 
!      mapped to one PE.  A random decomposition will cause poor
!      results.
!
!      The decomposition is thus very efficient for 1-D, 2-D or 3-D
!      block distributions (particularly for 1-D distributions, where
!      there is one "run" per processor).  Problems may occur for
!      an irregular decomposition (which is by definition 1-D).  If
!      there is little correspondence between the global indices of the 
!      entries and the actual decomposition (e.g., the tags are
!      assigned randomly), then there will be many runs, most
!      containing only one tag, and the resulting instance of
!      DecompType will be very large.  Fortunately, most applications
!      assign tags to entries in some sort of contiguous fashion, 
!      which is then quite appropriate for this data structure.
!
!      All numbering of multi-dimensional arrays is ROW-MAJOR, that
!      is, first in the X direction and then in the Y (and then,
!      if appropriate, in Z).  This is true for both the 2-D and
!      3-D data sets as also the Cartesian description of the PEs.
!
!      There is one glaring feature of DecompType.  It is
!      supposed to be a `one-size-fits-all' description of the
!      decomposition (with the exception of the random indexing
!      mentioned above).  Unfortunately, to describe 2-D and 3-D
!      regions, it is necessary to carry additional dimension
!      information in order have complete information for the 
!      mapping.  This means that 2-D and 3-D decompositions 
!      inherently carry more information than a 1-D decomposition.
!      Thus it {\it is} possible to use a decomposition created
!      with the Regular2D or Regular3D routines to describe the
!      corresponding decomposition when the 2-D or 3-D array is
!      viewed as a 1-D array, but it is clearly {\it not}
!      possible to use a decomposition created with Regular1D
!      to describe the decomposition of a 2-D or 3-D array
!      --- the appropriate information just is not there.
!      
! !REVISION HISTORY:
!   97.07.22   Sawyer     Creation
!   97.09.01   Sawyer     Release date
!   97.11.06   Sawyer     Addition of row and column communicators
!   97.01.24   Sawyer     Added support for non-MPI derived types solution
!   97.01.29   Sawyer     Minor revisions for production service
!   98.01.30   Sawyer     Added DecompCopy
!   98.02.04   Sawyer     Removed Comm, CommRow and CommCol from DecompType
!   98.03.13   Sawyer     Removed DecompTypeOld, brushed up for walkthrough
!   98.03.19   Sawyer     Minor corrections after walkthrough
!   98.05.02   Sawyer     Added DecompPermute
!   98.05.11   Sawyer     Removed Permutation from all but DecompPermute
!   99.01.19   Sawyer     Minor cleaning
!   00.07.07   Sawyer     Removed DimSizes; decomp is now 1D only
!   00.11.12   Sawyer     Added DecompCreateTags and DecompInfo
!   01.02.03   Sawyer     Updated for free format; corrected DecompCreateTags
!   01.03.20   Sawyer     Added DecompRegular3DOrder
!
! !PUBLIC TYPES:
      PUBLIC DecompType, DecompCreate, DecompFree
      PUBLIC DecompCopy, DecompPermute
      PUBLIC DecompGlobalToLocal, DecompLocalToGlobal, DecompInfo

      INTERFACE     DecompCreate
        MODULE PROCEDURE DecompRegular1D
        MODULE PROCEDURE DecompRegular2D
        MODULE PROCEDURE DecompRegular3D
        MODULE PROCEDURE DecompRegular3DOrder
        MODULE PROCEDURE DecompCreateIrr
        MODULE PROCEDURE DecompCreateTags
      END INTERFACE
 
! Decomposition info

       TYPE Lists
         INTEGER, POINTER     :: StartTags(:) ! Start of tag run
         INTEGER, POINTER     :: EndTags(:)   ! Start of tag run
       END TYPE Lists

       TYPE DecompType
         INTEGER              :: GlobalSize   ! Size in each dimension
         INTEGER, POINTER     :: NumEntries(:)! Number of entries per PE
         TYPE(Lists), POINTER :: Head(:)      ! Array of pointers 
       END TYPE DecompType

!EOP
      CONTAINS

!---------------------------------------------------------------------
!BOP
! !IROUTINE: DecompFree --- Free a decomposition
!
! !INTERFACE:
      SUBROUTINE DecompFree ( Decomp )
! !USES:
      IMPLICIT NONE

! !INPUT/OUTPUT PARAMETERS:
      TYPE(DecompType), INTENT( INOUT ):: Decomp  ! Decomp information
!
! !DESCRIPTION:
!     Free the decomposition -- deallocate the data structures.
!
! !SYSTEM ROUTINES:
!     ASSOCIATED, DEALLOCATE
!
! !REVISION HISTORY:
!   98.01.30   Sawyer     Creation
!
!EOP
!------------------------------------------------------------------------
!BOC
!
! !LOCAL VARIABLES:
      INTEGER  :: I, NPEs
!
      CPP_ENTER_PROCEDURE( "DECOMPFREE" )

      IF ( ASSOCIATED( Decomp%NumEntries ) )                             &
     &               DEALLOCATE( Decomp%NumEntries )
      IF ( ASSOCIATED( Decomp%Head ) ) THEN
        NPEs = SIZE( Decomp%Head )
        DO I = 1, NPEs
!
! Copy the number of entries on each PE
!
          IF ( ASSOCIATED( Decomp%Head(I)%StartTags ) )                  &
     &               DEALLOCATE( Decomp%Head(I)%StartTags )
          IF ( ASSOCIATED( Decomp%Head(I)%EndTags ) )                    &
     &               DEALLOCATE( Decomp%Head(I)%EndTags )
        ENDDO
        DEALLOCATE( Decomp%Head )
      ENDIF

      CPP_LEAVE_PROCEDURE( "DECOMPFREE" )
      RETURN
!EOC
      END SUBROUTINE DecompFree
!------------------------------------------------------------------------


!------------------------------------------------------------------------
!BOP
! !IROUTINE: DecompCopy --- Copy one decomposition to another
!
! !INTERFACE:
      SUBROUTINE DecompCopy ( DecompIn, DecompOut )
! !USES:
      IMPLICIT NONE
!
! !INPUT PARAMETERS:
      TYPE(DecompType), INTENT( IN )   :: DecompIn  ! Decomp information
!
! !OUTPUT PARAMETERS:
      TYPE(DecompType), INTENT( OUT )  :: DecompOut ! Decomp information
!
! !DESCRIPTION:
!
!   Creates an output decomposition and copies the DecompIn input values 
!
! !SYSTEM ROUTINES:
!     ALLOCATE
!
! !REVISION HISTORY:
!   98.01.30   Sawyer     Creation
!
!EOP
!------------------------------------------------------------------------
!BOC
!
! !LOCAL VARIABLES:
      INTEGER  :: I, J, NDims, NPEs, NRuns
!
      CPP_ENTER_PROCEDURE( "DECOMPCOPY" )
!
! Copy the size of the global array
!
      DecompOut%GlobalSize = DecompIn%GlobalSize

!
! Allocate the number of entries and list head arrays
!
      NPEs = SIZE( DecompIn%NumEntries )
      CPP_ASSERT_F90( SIZE( DecompIn%Head ) .EQ. NPEs )
      ALLOCATE( DecompOut%NumEntries( NPEs ) )
      ALLOCATE( DecompOut%Head( NPEs ) )

      DO I = 1, NPEs
!
! Copy the number of entries on each PE
!
        DecompOut%NumEntries( I ) = DecompIn%NumEntries( I )
        NRuns = SIZE( DecompIn%Head( I )%StartTags )
        CPP_ASSERT_F90( SIZE( DecompIn%Head( I )%EndTags ) .EQ. NRuns )
!
! Allocate and copy the array of runs
!
        ALLOCATE( DecompOut%Head(I)%StartTags( NRuns ) )
        ALLOCATE( DecompOut%Head(I)%EndTags( NRuns ) )
        DO J = 1, NRuns
          DecompOut%Head(I)%StartTags(J) = DecompIn%Head(I)%StartTags(J)
          DecompOut%Head(I)%EndTags(J) = DecompIn%Head(I)%EndTags(J)
        ENDDO
      ENDDO

      CPP_LEAVE_PROCEDURE( "DECOMPCOPY" )
      RETURN
!EOC
      END SUBROUTINE DecompCopy
!------------------------------------------------------------------------


!------------------------------------------------------------------------
!BOP
! !IROUTINE: DecompPermute --- Permute one decomposition to another
!
! !INTERFACE:
      SUBROUTINE DecompPermute ( Permutation, Decomp )
! !USES:
      IMPLICIT NONE
!
! !INPUT PARAMETERS:
      INTEGER :: Permutation( : )                  ! Permutation

! !INPUT/OUTPUT PARAMETERS:
      TYPE(DecompType), INTENT( INOUT ) :: Decomp  ! Decomp information
!
!
! !DESCRIPTION:
!
!   Permutes the PE assignment of a given decomposition. Confusion will
!   always arise about whether this is a forward or backward
!   transformation.  Picture it this way: draw the array and slice it
!   up as indicated by the distribution.  The resulting boxes are of
!   course indexed by natural numbering 1, 2, 3, 4, ...  (these are
!   the virtual one-based PEs). Now write the true PE numbering
!   (one-based) as you would like it.  The resulting array is Perm.
!
!
! !SYSTEM ROUTINES:
!     ALLOCATE
!
! !REVISION HISTORY:
!   98.05.02   Sawyer     Creation
!
!EOP
!---------------------------------------------------------------------
!BOC
!
! !LOCAL VARIABLES:
      INTEGER, POINTER     :: NumEntries(:)! Number of entries
      TYPE(Lists), POINTER :: Head(:)      ! Array of pointers 
      INTEGER              :: I, J, NPEs, NRuns, TruePE
!
      CPP_ENTER_PROCEDURE( "DECOMPPERMUTE" )
!
! Allocate the number of entries and list head arrays
!
      NPEs = SIZE( Decomp%NumEntries )
      ALLOCATE( NumEntries( NPEs ) )
      DO I = 1, NPEs
        TruePE = Permutation( I )
        NumEntries( TruePE ) = Decomp%NumEntries( I )
      ENDDO
!
! Deallocate old NumEntries and put the new pointer in its place
!
      DEALLOCATE( Decomp%NumEntries )
      Decomp%NumEntries => NumEntries
      NULLIFY( NumEntries )

!
! Allocate and set the permuted Lists called with pointer Head
!
      ALLOCATE( Head( NPEs ) )
      DO I = 1, NPEs
        TruePE = Permutation( I )
        NRuns = SIZE( Decomp%Head(I)%StartTags )
        CPP_ASSERT_F90( SIZE( Decomp%Head(I)%EndTags ) .EQ. NRuns )
!
! Allocate and permute the array of runs
!
        ALLOCATE( Head(TruePE)%StartTags(NRuns) )
        ALLOCATE( Head(TruePE)%EndTags(NRuns) )
        DO J = 1, NRuns
          Head(TruePE)%StartTags(J) = Decomp%Head(I)%StartTags(J)
          Head(TruePE)%EndTags(J)   = Decomp%Head(I)%EndTags(J)
        ENDDO
      ENDDO
!
! Deallocate the arrays of starting and ending tags
!
      DO I = 1, NPEs
        DEALLOCATE( Decomp%Head(I)%StartTags )
        DEALLOCATE( Decomp%Head(I)%EndTags )
      ENDDO
!
! Deallocate the heads to the Lists
!
      DEALLOCATE( Decomp%Head )

!
! Link the new head to that in the decomposition
!
      Decomp%Head => Head
      
      NULLIFY( Head )

      CPP_LEAVE_PROCEDURE( "DECOMPPERMUTE" )
      RETURN
!EOC
      END SUBROUTINE DecompPermute
!------------------------------------------------------------------------


!------------------------------------------------------------------------
!BOP
! !IROUTINE: DecompRegular1D --- Create a decomposition for a 1-D grid
!
! !INTERFACE:
      SUBROUTINE DecompRegular1D ( NPEs, Dist, Decomp )
! !USES:
      IMPLICIT NONE
!
! !INPUT PARAMETERS:
      INTEGER, INTENT( IN )            :: NPEs     ! Number of PEs
      INTEGER, INTENT( IN )            :: Dist(:)  ! Distribution in X
!
! !OUTPUT PARAMETERS:
      TYPE(DecompType), INTENT( OUT )  :: Decomp   ! Decomp information
!
! !DESCRIPTION:
!     Creates a variable block decomposition for a regular 1-D grid
!     (this is also known as a "block-general" distribution).  The
!     decomposition is given through the Dist distribution 
!     which contains the number of entries on each PE.  
!
! !SYSTEM ROUTINES:
!     ALLOCATE
!
! !REVISION HISTORY:
!   98.01.19   Sawyer     Creation
!   98.01.22   Sawyer     Corrections, TESTED
!   98.05.11   Sawyer     Removed Perm from arglist -- see DecompPermute
!   00.07.07   Sawyer     Removed use of DimSizes(:) array
!
!EOP
!------------------------------------------------------------------------
!BOC
!
! !LOCAL VARIABLES:
      INTEGER  :: I, Counter
!
      CPP_ENTER_PROCEDURE( "DECOMPREGULAR1D" )
!
      CPP_ASSERT_F90( NPEs .EQ. SIZE( Dist ) )
!
! The head contains NPEs pointers to the tag lists.
!
      Decomp%GlobalSize = SUM(Dist)
      ALLOCATE( Decomp%NumEntries( NPEs ) )
      ALLOCATE( Decomp%Head( NPEs ) )
      Counter = 0
      DO I = 1, NPEs
        Decomp%NumEntries(I) = Dist(I)
!
! Since this is a regular distribution there is only one run of tags per PE.
!
        NULLIFY( Decomp%Head(I)%StartTags )
        NULLIFY( Decomp%Head(I)%EndTags )
        ALLOCATE( Decomp%Head(I)%StartTags(1) )
        ALLOCATE( Decomp%Head(I)%EndTags(1) )
!
! The starting and ending tags are immediately determined from
! the decomposition arrays  
!
        Decomp%Head(I)%StartTags(1) = Counter+1
        Counter = Counter + Dist(I)
        Decomp%Head(I)%EndTags(1) = Counter
      ENDDO

      CPP_LEAVE_PROCEDURE( "DECOMPREGULAR1D" )
      RETURN
!EOC
      END SUBROUTINE DecompRegular1D
!------------------------------------------------------------------------


!------------------------------------------------------------------------
!BOP
! !IROUTINE: DecompRegular2D --- Create a decomposition for a 2-D grid
!
! !INTERFACE:
      SUBROUTINE DecompRegular2D( NPEsX, NPEsY, Xdist, Ydist, Decomp )