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