decompmodule.f90

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

!
! !DESCRIPTION:
!     Creates a decomposition for a irregular 1-D mesh.  The
!     decomposition is given through the number of points and
!     an array containing the PE which each point is mapped to.
!     This mapping naturally assumes that the local numbering
!     is incrementally increasing as points are mapped to PEs.
!     This assumption is sufficient for most applications, but
!     another irregular mapping routine is available for more
!     complex cases.
!
! !SYSTEM ROUTINES:
!     ALLOCATE
!
! !REVISION HISTORY:
!   98.01.19   Sawyer     Creation, with requirements from Jay Larson
!   98.11.02   Sawyer     Rewritten to requirements for Andrea Molod
!   00.07.07   Sawyer     Removed use of DimSizes(:) array
!   00.11.12   Sawyer     Changed argument order for overloading
!
!EOP
!------------------------------------------------------------------------
!BOC
!
! !LOCAL VARIABLES:
      INTEGER  :: I, PEhold
      INTEGER  :: Counter( NPEs )
!
      CPP_ENTER_PROCEDURE( "DECOMPCREATEIRR" )
!
      CPP_ASSERT_F90( TotalPts .LE. SIZE( PE ) )
      CPP_ASSERT_F90( .NOT. ASSOCIATED( Decomp%Head ) )

!
! The head contains NPEs pointers to the tag lists.
!
      Decomp%GlobalSize = TotalPts
      ALLOCATE( Decomp%NumEntries( NPEs ) )
      ALLOCATE( Decomp%Head( NPEs ) )
!
! Perform over all points in the mapping
!
      PEhold= -1
      Counter = 0
      Decomp%NumEntries = 0
      DO I=1, TotalPts
        CPP_ASSERT_F90( ( PE( I ) .LT. NPEs .AND. PE( I ) .GE. 0 ) )
        IF ( PE( I ) .NE. PEhold ) THEN
          PEhold = PE( I )
          Counter( PEhold+1 ) = Counter( PEhold+1 ) + 1
        ENDIF
        Decomp%NumEntries(PEHold+1) = Decomp%NumEntries(PEHold+1) + 1
      ENDDO
      DO I=1, NPEs
!
! Now the amount of space to allocate is known.  It is acceptable
! to in allocated an array of size 0 (F90 Handbook, Section 6.5.1)
!
        ALLOCATE( Decomp%Head(I)%StartTags(Counter(I)) )
        ALLOCATE( Decomp%Head(I)%EndTags(Counter(I)) )
      ENDDO
!
! Perform over all points in the mapping
!
      PEhold= -1
      Counter = 0
      DO I=1, TotalPts
        IF ( PE( I ) .NE. PEhold ) THEN
!
! If not first entry, close up shop on previous run
!
          IF ( I .GT. 1 ) THEN
            Decomp%Head(PEhold+1)%EndTags(Counter(PEhold+1)) = I-1
          ENDIF
          PEhold = PE( I )
          Counter( PEhold+1 ) = Counter( PEhold+1 ) + 1
          Decomp%Head(PEhold+1)%StartTags(Counter(PEhold+1)) = I
        ENDIF
      ENDDO
!
! Clean up shop for the final run
!
      IF ( TotalPts .GT. 0 ) THEN
        Decomp%Head(PEhold+1)%EndTags(Counter(PEhold+1)) = TotalPts
      ENDIF

      CPP_LEAVE_PROCEDURE( "DECOMPCREATEIRR" )
      RETURN
!EOC
      END SUBROUTINE DecompCreateIrr
!------------------------------------------------------------------------


!------------------------------------------------------------------------
!BOP
! !IROUTINE: DecompCreateTags --- Decomposition from Pe and Tags
!
! !INTERFACE:
      SUBROUTINE DecompCreateTags(Npes, Pe, TotalPts, Tags, Decomp )
! !USES:
      IMPLICIT NONE
!
! !INPUT PARAMETERS:
      INTEGER, INTENT( IN )            :: NPEs     ! Number of PEs
      INTEGER, INTENT( IN )            :: Pe(:)    ! Processor location
      INTEGER, INTENT( IN )            :: TotalPts ! Number of points
      INTEGER, INTENT( IN )            :: Tags(:)  ! Global index
!
! !OUTPUT PARAMETERS:
      TYPE(DecompType), INTENT( OUT )  :: Decomp   ! Decomp information
!
!
! !DESCRIPTION:
!     Creates a decomposition for a irregular mesh from the 
!     Pe ownership and the Tags.  This is a simple extension of 
!     DecompCreateIrr (previously DecompIrregular1D) but is
!     much more dangerous, since the user can define the Tags
!     (global indices) arbitrarily.
!
! !SYSTEM ROUTINES:
!     ALLOCATE
!
! !REVISION HISTORY:
!   00.11.12   Sawyer     Creation from DecompCreateIrr
!
!EOP
!------------------------------------------------------------------------
!BOC
!
! !LOCAL VARIABLES:
      INTEGER  :: I, PEhold, LastTag
      INTEGER  :: Counter( NPEs )
!
      CPP_ENTER_PROCEDURE( "DECOMPCREATETAGS" )
!
      CPP_ASSERT_F90( TotalPts .LE. SIZE( PE ) )
      CPP_ASSERT_F90( TotalPts .LE. SIZE( Tags ) )
      CPP_ASSERT_F90( .NOT. ASSOCIATED( Decomp%Head ) )

!
! The head contains NPEs pointers to the tag lists.
!
      Decomp%GlobalSize = TotalPts
      ALLOCATE( Decomp%NumEntries( NPEs ) )
      ALLOCATE( Decomp%Head( NPEs ) )
!
! Perform over all points in the mapping
!
      PEhold  = -1
      LastTag = -999999999
      Counter = 0
      Decomp%NumEntries = 0
      DO I=1, TotalPts
        CPP_ASSERT_F90( PE( I ) .LT. NPEs .AND. PE( I ) .GE. 0 )
        IF ( LastTag==0 .OR. Tags(I)/=LastTag+1 .OR. PE(I)/=PEhold ) THEN
          PEhold = PE( I )
          Counter( PEhold+1 ) = Counter( PEhold+1 ) + 1
        ENDIF
        Decomp%NumEntries(PEHold+1) = Decomp%NumEntries(PEHold+1) + 1
        LastTag = Tags(I)
      ENDDO

      DO I=1, NPEs
!
! Now the amount of space to allocate is known.  It is acceptable
! to in allocated an array of size 0 (F90 Handbook, Section 6.5.1)
!
        ALLOCATE( Decomp%Head(I)%StartTags(Counter(I)) )
        ALLOCATE( Decomp%Head(I)%EndTags(Counter(I)) )
      ENDDO

!
! Perform over all points in the domain
!
      PEhold  = -1
      LastTag = -999999999
      Counter = 0
      DO I=1, TotalPts
        IF ( LastTag==0 .OR. Tags(I)/=LastTag+1 .OR. PE(I)/=PEhold ) THEN
!
! If not first entry, close up shop on previous run
!
          IF ( I .GT. 1 ) THEN
            Decomp%Head(PEhold+1)%EndTags(Counter(PEhold+1)) = LastTag
          ENDIF
          PEhold = PE( I )
          Counter( PEhold+1 ) = Counter( PEhold+1 ) + 1
          Decomp%Head(PEhold+1)%StartTags(Counter(PEhold+1)) = Tags(I)
        ENDIF
        LastTag = Tags(I)
      ENDDO
!
! Clean up shop for the final run
!
      IF ( TotalPts .GT. 0 ) THEN
        Decomp%Head(PEhold+1)%EndTags(Counter(PEhold+1)) =Tags(TotalPts)
      ENDIF

      CPP_LEAVE_PROCEDURE( "DECOMPCREATETAGS" )
      RETURN
!EOC
      END SUBROUTINE DecompCreateTags
!------------------------------------------------------------------------


!------------------------------------------------------------------------
!BOP
! !IROUTINE: DecompGlobalToLocal --- Map global index to local and PE
!
! !INTERFACE:
      SUBROUTINE DecompGlobalToLocal ( Decomp, Global, Local, Pe )
! !USES:
      IMPLICIT NONE
!
! !INPUT PARAMETERS:
      TYPE(DecompType), INTENT( IN )   :: Decomp  ! Decomp information
      INTEGER, INTENT( IN )            :: Global  ! Global index
!
! !OUTPUT PARAMETERS:

      INTEGER, INTENT( OUT )  :: Local            ! Local index
      INTEGER, INTENT( OUT )  :: Pe               ! Pe location
!
!
! !DESCRIPTION:
!     Given a decomposition and a global index, this routine returns
!     the local index and PE location of that global tag.  If the
!     global index is not found, Local = 0, Pe = -1 is returned.
!
!     Note that this routine is not efficient by any stretch of the 
!     imagination --- only one index can be converted at a time.
!     In addition, a search procedure must be performed, whose 
!     efficiency is inversely proportional to the size of the decomposition
!     (in particular, to the number of "runs").  Conceptually this
!     mapping should be used only once in the program for
!     initialization, and subsequently all calculations should take
!     place using local indices.
!
! !SYSTEM ROUTINES:
!     SIZE
!
! !REVISION HISTORY:
!   98.03.20   Sawyer     Creation
!   01.03.17   Sawyer     Test for Global==0 (undefined element)
!
!EOP
!------------------------------------------------------------------------
!BOC
!
! !LOCAL VARIABLES:
      INTEGER  :: I, J
      LOGICAL  :: Found
!
      CPP_ENTER_PROCEDURE( "DECOMPGLOBALTOLOCAL" )

!
! Search over all the PEs
!
      Pe = -1
      Local = 0
      Found = .FALSE.
      DO WHILE ( .NOT. Found .AND. Global .NE. 0 )
!
! Copy the number of entries on each PE
!
        Pe = Pe + 1
        CPP_ASSERT_F90( ( SIZE(Decomp%Head(Pe+1)%StartTags) .EQ. SIZE(Decomp%Head(Pe+1)%EndTags) ) )
!
! Search through the local data segment
!
        Local = 1
        J = 1
        DO WHILE ( .NOT. Found .AND.                                     &
     &             J .LE. SIZE( Decomp%Head(Pe+1)%StartTags ) )
          IF ( Global .GE. Decomp%Head(Pe+1)%StartTags(J) .AND.          &
     &         Global .LE. Decomp%Head(Pe+1)%EndTags(J) ) THEN
            Local = Local +  Global - Decomp%Head(Pe+1)%StartTags(J)
            Found = .TRUE.
          ELSE
            Local = Local + Decomp%Head(Pe+1)%EndTags(J) -               &
     &                      Decomp%Head(Pe+1)%StartTags(J) + 1
          ENDIF
          J = J+1
        ENDDO
!
! Emergency brake
!
        IF ( Pe .EQ. (SIZE( Decomp%Head )-1) .AND. .NOT. Found ) THEN
          Found = .TRUE.
          Local = 0
          Pe    = -1
        ENDIF
      ENDDO

      CPP_ASSERT_F90( Local .LE. Decomp%NumEntries(Pe+1) ) 

      CPP_LEAVE_PROCEDURE( "DECOMPGLOBALTOLOCAL" )
      RETURN
!
!EOC
      END SUBROUTINE DecompGlobalToLocal
!------------------------------------------------------------------------


!------------------------------------------------------------------------
!BOP
! !IROUTINE: DecompLocalToGlobal --- Map global index to local and PE
!
! !INTERFACE:
      SUBROUTINE DecompLocalToGlobal ( Decomp, Local, Pe, Global )
! !USES:
      IMPLICIT NONE
!
! !INPUT PARAMETERS:
      TYPE(DecompType), INTENT( IN )   :: Decomp  ! Decomp information
      INTEGER, INTENT( IN )            :: Local   ! Local index
      INTEGER, INTENT( IN )            :: Pe      ! Pe location
!
! !OUTPUT PARAMETERS:
      INTEGER, INTENT( OUT )           :: Global  ! Global index
!
!
! !DESCRIPTION:
!     Given a decomposition and a local-pe index pair, this routine 
!     returns  the 2-D global index. If the local index is not found, 
!     0 is returned. 
!
!     Note that this routine is not efficient by any stretch of the 
!     imagination --- only one index can be converted at a time.
!     In addition, a search procedure must be performed, whose 
!     efficiency is inversely proportional to the size of the 
!     decomposition (in particular, to the number of "runs").  
!     Conceptually this mapping should be used only once in the 
!     program for initialization, and subsequently all calculations 
!     should take place using local indices.
!
! !SYSTEM ROUTINES:
!     SIZE
!
! !REVISION HISTORY:
!   98.03.20   Sawyer     Creation
!
!EOP
!------------------------------------------------------------------------
!BOC
!
! !LOCAL VARIABLES:
      INTEGER  :: J, Counter
      LOGICAL  :: Found
!
      CPP_ENTER_PROCEDURE( "DECOMPLOCALTOGLOBAL" )
      CPP_ASSERT_F90( Pe .GE. 0 )
      CPP_ASSERT_F90( Pe .LT. SIZE(Decomp%Head) )
      CPP_ASSERT_F90( Local .GT. 0 )
      CPP_ASSERT_F90( Local .LE. Decomp%NumEntries(Pe+1) )

      Counter = 0
      Found   = .FALSE.
      J = 0
      DO WHILE ( .NOT. Found )
        J = J+1
        Counter = Counter + Decomp%Head(Pe+1)%EndTags(J) -               &
     &                      Decomp%Head(Pe+1)%StartTags(J) + 1
        IF ( Local .LE.  Counter ) THEN
          Found = .TRUE.
!
! The following calculation is not immediately obvious.  Think about it
!
          Global = Local - Counter + Decomp%Head(Pe+1)%EndTags(J)
          Found = .TRUE.
        ELSEIF ( J .GE. SIZE( Decomp%Head(Pe+1)%StartTags ) ) THEN
!
! Emergency brake
!
          Found = .TRUE.
          Global = 0
        ENDIF
      ENDDO

      CPP_LEAVE_PROCEDURE( "DECOMPLOCALTOGLOBAL" )
      RETURN
!
!EOC
      END SUBROUTINE DecompLocalToGlobal
!------------------------------------------------------------------------


!------------------------------------------------------------------------
!BOP
! !IROUTINE: DecompInfo --- Information about decomposition
!
! !INTERFACE:
      SUBROUTINE DecompInfo( Decomp, Npes, TotalPts )
! !USES:
      IMPLICIT NONE

! !INPUT PARAMETERS:
      TYPE(DecompType), INTENT( IN ):: Decomp   ! Decomp information

! !OUTPUT PARAMETERS:
      INTEGER, INTENT( OUT )        :: Npes     ! Npes in decomposition
      INTEGER, INTENT( OUT )        :: TotalPts ! Total points in domain
!
!
! !DESCRIPTION:
!     Return information about the decomposition: the number of
!     PEs over which the domain is decomposed, and the size of
!     the domain.
!
! !REVISION HISTORY:
!   00.11.12   Sawyer     Creation
!
!EOP
!---------------------------------------------------------------------
!BOC
!
!
      CPP_ENTER_PROCEDURE( "DECOMPINFO" )

      Npes = SIZE( Decomp%Head )
      TotalPts = Decomp%GlobalSize

      CPP_LEAVE_PROCEDURE( "DECOMPINFO" )
      RETURN
!EOC
      END SUBROUTINE DecompInfo
!------------------------------------------------------------------------

      END MODULE decompmodule