Nodes of different colours represent the following:
Solid arrows point from a parent (sub)module to the submodule which is descended from it. Dashed arrows point from a module being used to the module or program unit using it. Where possible, edges connecting nodes are given different colours to make them easier to distinguish in large graphs.
| Type | Intent | Optional | Attributes | Name | ||
|---|---|---|---|---|---|---|
| character(len=*), | intent(in) | :: | CompName | |||
| integer, | intent(in) | :: | CompType | |||
| integer, | intent(out) | :: | LoopNum | |||
| integer, | intent(out) | :: | LoopSideNum | |||
| integer, | intent(out) | :: | BranchNum | |||
| integer, | intent(out) | :: | CompNum | |||
| real(kind=r64), | intent(in), | optional | :: | LowLimitTemp | ||
| real(kind=r64), | intent(in), | optional | :: | HighLimitTemp | ||
| integer, | intent(out), | optional | :: | CountMatchPlantLoops | ||
| integer, | intent(in), | optional | :: | InletNodeNumber | ||
| logical, | intent(inout), | optional | :: | errFlag | ||
| integer, | intent(in), | optional | :: | SingleLoopSearch | 
Nodes of different colours represent the following:
Solid arrows point from a procedure to one which it calls. Dashed arrows point from an interface to procedures which implement that interface. This could include the module procedures in a generic interface or the implementation in a submodule of an interface in a parent module. Where possible, edges connecting nodes are given different colours to make them easier to distinguish in large graphs.
Nodes of different colours represent the following:
Solid arrows point from a procedure to one which it calls. Dashed arrows point from an interface to procedures which implement that interface. This could include the module procedures in a generic interface or the implementation in a submodule of an interface in a parent module. Where possible, edges connecting nodes are given different colours to make them easier to distinguish in large graphs.
SUBROUTINE ScanPlantLoopsForObject(CompName, CompType, LoopNum, LoopSideNum, BranchNum, CompNum, &
                                   LowLimitTemp, HighLimitTemp, CountMatchPlantLoops, InletNodeNumber, &
                                   errFlag, SingleLoopSearch)
   ! SUBROUTINE INFORMATION:
   !       AUTHOR         Edwin Lee
   !       DATE WRITTEN   November 2009
   !       MODIFIED       B. Griffith, changes to help with single component one multiple plant loops
   !       RE-ENGINEERED  na
   !
   ! PURPOSE OF THIS SUBROUTINE:
   ! This subroutine scans the plant loop structure trying to find the component by type then name.
   ! If there are more than one match, it counts them up and returns count using an optional output arg
   ! If the option input declaring the component inlet's node name, then the matching is more specific.
   ! An optional input, lowlimittemp, can be passed in to be used in the PlantCondLoopOperation routines
   !  when distributing loads to components
   !
   ! METHODOLOGY EMPLOYED:
   ! Standard EnergyPlus methodology.
   !
   ! REFERENCES:
   ! na
   !
   ! USE STATEMENTS:
USE DataGlobals
USE DataInterfaces, ONLY: ShowSevereError, ShowFatalError, ShowContinueError
USE InputProcessor, ONLY : SameString
USE General,        ONLY : RoundSigDigits
USE BranchInputManager, ONLY: AuditBranches
IMPLICIT NONE    ! Enforce explicit typing of all variables in this routine
   ! SUBROUTINE ARGUMENT DEFINITIONS:
CHARACTER(len=*),    INTENT(IN)   :: CompName
INTEGER,             INTENT(IN)   :: CompType
INTEGER,             INTENT(OUT)  :: LoopNum
INTEGER,             INTENT(OUT)  :: LoopSideNum
INTEGER,             INTENT(OUT)  :: BranchNum
INTEGER,             INTENT(OUT)  :: CompNum
REAL(r64), OPTIONAL, INTENT(IN)   :: LowLimitTemp
REAL(r64), OPTIONAL, INTENT(IN)   :: HighLimitTemp
INTEGER,  OPTIONAL,  INTENT(OUT)  :: CountMatchPlantLoops
INTEGER,  OPTIONAL,  INTENT(IN)   :: InletNodeNumber
LOGICAL, OPTIONAL,   INTENT(INOUT):: errFlag
INTEGER,  OPTIONAL,  INTENT(IN)   :: SingleLoopSearch
   ! SUBROUTINE PARAMETER DEFINITIONS:
   ! na
   ! INTERFACE BLOCK SPECIFICATIONS
   ! na
   ! DERIVED TYPE DEFINITIONS
   ! na
   ! SUBROUTINE LOCAL VARIABLE DECLARATIONS:
  INTEGER     :: LoopCtr
  INTEGER     :: LoopSideCtr
  INTEGER     :: BranchCtr
  INTEGER     :: CompCtr
  LOGICAL     :: FoundComponent
  INTEGER     :: FoundCount
  LOGICAL     :: FoundCompName
  INTEGER     :: StartingLoopNum
  INTEGER     :: EndingLoopNum
!  logical :: printsteps
  FoundCount = 0
  FoundComponent = .FALSE.
  FoundCompName  = .false.
  StartingLoopNum = 1
  EndingLoopNum   = TotNumLoops
  IF ( PRESENT ( SingleLoopSearch ) ) THEN
    StartingLoopNum = SingleLoopSearch
    EndingLoopNum   = SingleLoopSearch
  END IF
  PlantLoops: DO LoopCtr = StartingLoopNum, EndingLoopNum
    DO LoopSideCtr = 1, 2
      DO BranchCtr = 1, PlantLoop(LoopCtr)%LoopSide(LoopSideCtr)%TotalBranches
        DO CompCtr = 1, PlantLoop(LoopCtr)%LoopSide(LoopSideCtr)%Branch(BranchCtr)%TotalComponents
          IF(PlantLoop(LoopCtr)%LoopSide(LoopSideCtr)%Branch(BranchCtr)%Comp(CompCtr)%TypeOf_Num == CompType) THEN
            IF(SameString(CompName, PlantLoop(LoopCtr)%LoopSide(LoopSideCtr)%Branch(BranchCtr)%Comp(CompCtr)%Name))THEN
              FoundCompName=.true.
              IF ( PRESENT(InletNodeNumber)) THEN
                IF (InletNodeNumber > 0) THEN
                  ! check if inlet nodes agree
                  IF (InletNodeNumber == PlantLoop(LoopCtr)%LoopSide(LoopSideCtr)%Branch(BranchCtr)%Comp(CompCtr)%NodeNumIn) THEN
                    FoundComponent = .TRUE.
                    FoundCount  = FoundCount + 1
                    LoopNum     = LoopCtr
                    LoopSideNum = LoopSideCtr
                    BranchNum   = BranchCtr
                    CompNum     = CompCtr
                  ENDIF
                ENDIF
              ELSE
                FoundComponent = .TRUE.
                FoundCount  = FoundCount + 1
                LoopNum     = LoopCtr
                LoopSideNum = LoopSideCtr
                BranchNum   = BranchCtr
                CompNum     = CompCtr
              ENDIF
              IF (PRESENT(LowLimitTemp)) THEN
                PlantLoop(LoopCtr)%LoopSide(LoopSideCtr)%Branch(BranchCtr)%Comp(CompCtr)%MinOutletTemp = LowLimitTemp
              END IF
              IF (PRESENT(HighLimitTemp)) THEN
                PlantLoop(LoopCtr)%LoopSide(LoopSideCtr)%Branch(BranchCtr)%Comp(CompCtr)%MaxOutletTemp = HighLimitTemp
              ENDIF
            END IF
          END IF
        END DO
      END DO
    END DO
  END DO PlantLoops
  IF (.NOT. FoundComponent) THEN
    IF (CompType >= 1 .and. CompType <= NumSimPlantEquipTypes) THEN
      IF (.not. PRESENT(SingleLoopSearch)) THEN
        CALL ShowSevereError('Plant Component '//trim(ccSimPlantEquipTypes(CompType))//' called "'//trim(CompName)//  &
         '" was not found on any plant loops.')
        CALL AuditBranches(.true.,ccSimPlantEquipTypes(CompType),CompName)
      ELSE
        CALL ShowSevereError('Plant Component '//trim(ccSimPlantEquipTypes(CompType))//' called "'//trim(CompName)//  &
           '" was not found on plant loop="'//trim(PlantLoop(SingleLoopSearch)%Name)//'".')
      ENDIF
      IF (PRESENT(InletNodeNumber)) THEN
        IF (FoundCompName) THEN
          CALL ShowContinueError('Looking for matching inlet Node="'//trim(NodeID(InletNodeNumber))//'".')
        ENDIF
      ENDIF
      IF (PRESENT(SingleLoopSearch)) THEN
        CALL ShowContinueError('Look at Operation Scheme="'//trim(PlantLoop(SingleLoopSearch)%OperationScheme)//'".')
        CALL ShowContinueError('Look at Branches and Components on the Loop.')
        CALL ShowBranchesOnLoop(SingleLoopSearch)
      ENDIF
      If (PRESENT(errFlag)) errFlag=.true.
    ELSE
      CALL ShowSevereError('ScanPlantLoopsForObject: Invalid CompType passed ['//trim(RoundSigDigits(CompType))//  &
         '], Name='//trim(CompName))
      CALL ShowContinueError('Valid CompTypes are in the range [1 - '//trim(RoundSigDigits(NumSimPlantEquipTypes))//  &
         '].')
      CALL ShowFatalError('Previous error causes program termination')
    ENDIF
  END IF
  IF (PRESENT(CountMatchPlantLoops)) THEN
    CountMatchPlantLoops = FoundCount
  ENDIF
END SUBROUTINE ScanPlantLoopsForObject