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.
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 CheckPlantOnAbort
! SUBROUTINE INFORMATION:
! AUTHOR Brent Griffith
! DATE WRITTEN Septemeber 2006
! MODIFIED na
! RE-ENGINEERED na
! PURPOSE OF THIS SUBROUTINE:
! Called once E+ is in the process of aborting because of fatal error
! check for plant input problems to help users find problems in input files
! METHODOLOGY EMPLOYED:
! search plant data structures for issues that may help solve problems in input files
! 1. if loop side has a splitter/mixer and one branch in there is control type bypass,
! then another branch in the s/m needs to be active
! other checks could/should be added!
! REFERENCES:
! na
! USE STATEMENTS:
! na
USE DataInterfaces, ONLY: ShowWarningError, ShowContinueError
USE DataErrorTracking, ONLY: AskForPlantCheckOnAbort
IMPLICIT NONE ! Enforce explicit typing of all variables in this routine
! SUBROUTINE ARGUMENT DEFINITIONS:
! na
! SUBROUTINE PARAMETER DEFINITIONS:
! na
! INTERFACE BLOCK SPECIFICATIONS:
! na
! DERIVED TYPE DEFINITIONS:
! na
! SUBROUTINE LOCAL VARIABLE DECLARATIONS:
INTEGER :: LoopNum ! DO loop counter for loops
LOGICAL :: ActiveCntrlfound ! used to search for active control branches in parallel with bypass branches
INTEGER :: ParalBranchNum ! used to search for active control branches in parallel with bypass branches
INTEGER :: ParalBranchNum2 ! used to search for active control branches in parallel with bypass branches
INTEGER :: BranchNum2 ! used to search for active control branches in parallel with bypass branches
INTEGER :: SideNum
INTEGER :: numLoopSides
INTEGER :: SplitNum
INTEGER :: BranchNum ! DO loop counter for branches
INTEGER :: CompNum ! do loop for multiple components on a branch
LOGICAL :: ShouldBeACTIVE
If (.not. (AskForPlantCheckOnAbort)) then
RETURN
endif
If (.not. (TotNumLoops > 0)) return
If (.not.(allocated(PlantLoop))) return
DO LoopNum = 1, TotNumLoops
numLoopSides = 2
Do SideNum = 1, numLoopSides
IF (.not. (PlantLoop(LoopNum)%LoopSide(SideNum)%SplitterExists)) Cycle
DO SplitNum = 1, PlantLoop(LoopNum)%LoopSide(SideNum)%NumSplitters
DO ParalBranchNum=1 , PlantLoop(LoopNum)%LoopSide(SideNum)%Splitter(SplitNum)%TotalOutletNodes
BranchNum = PlantLoop(LoopNum)%LoopSide(SideNum)%Splitter(SplitNum)%BranchNumOut(ParalBranchNum)
If (PlantLoop(LoopNum)%LoopSide(SideNum)%Branch(BranchNum)%IsByPass) then ! we know there is a bypass
! check that there is at least one 'Active' control type in parallel with bypass branch
ActiveCntrlfound = .false.
DO ParalBranchNum2=1, PlantLoop(LoopNum)%LoopSide(SideNum)%Splitter(SplitNum)%TotalOutletNodes
BranchNum2 = PlantLoop(LoopNum)%LoopSide(SideNum)%Splitter(SplitNum)%BranchNumOut(ParalBranchNum2)
If (PlantLoop(LoopNum)%LoopSide(SideNum)%Branch(BranchNum2)%ControlType == ControlType_Active) then
ActiveCntrlfound = .true.
endif
ENDDO
If ( .not. (ActiveCntrlfound)) then
CALL ShowWarningError('Check control types on branches between splitter and mixer in '// &
'PlantLoop='//TRIM(PlantLoop(LoopNum)%Name))
CALL ShowContinueError('Found a BYPASS branch with no ACTIVE branch in parallel with it')
CALL ShowContinueError('In certain (but not all) situations, this can cause problems; please verify your inputs')
CALL ShowContinueError('Bypass branch named: '//trim(PlantLoop(LoopNum)%LoopSide(SideNum)%Branch(BranchNum)%Name))
ENDIF
ENDIF ! bypass present
!check for possible components on demand side that should be ACTIVE but are not
IF (SideNum == DemandSide) THEN
! check for presences of the following components whose branch control type should be active
! WATER HEATER:MIXED
! WATER HEATER:STRATIFIED
! WATER USE CONNECTIONS
! COIL:WATER:COOLING
! COIL:WATER:SIMPLEHEATING
! COIL:STEAM:AIRHEATING
! SOLAR COLLECTOR:FLAT PLATE
! PLANT LOAD PROFILE
Do CompNum = 1, PlantLoop(LoopNum)%LoopSide(SideNum)%Branch(BranchNum)%TotalComponents
ShouldBeACTIVE = .FALSE.
SELECT CASE (PlantLoop(LoopNum)%LoopSide(SideNum)%Branch(BranchNum)%Comp(CompNum)%TypeOf_Num)
Case (TypeOf_WtrHeaterMixed)
ShouldBeACTIVE = .TRUE.
CASE (TypeOf_WtrHeaterStratified)
ShouldBeACTIVE = .TRUE.
CASE (TypeOf_WaterUseConnection)
ShouldBeACTIVE = .TRUE.
CASE (TypeOf_CoilWaterCooling)
ShouldBeACTIVE = .TRUE.
CASE (TypeOf_CoilWaterDetailedFlatCooling)
ShouldBeACTIVE = .TRUE.
CASE (TypeOf_CoilWaterSimpleHeating)
ShouldBeACTIVE = .TRUE.
CASE (TypeOf_CoilSteamAirHeating)
ShouldBeACTIVE = .TRUE.
CASE (TypeOf_SolarCollectorFlatPlate)
ShouldBeACTIVE = .TRUE.
CASE (TypeOf_PlantLoadProfile)
ShouldBeACTIVE = .TRUE.
CASE DEFAULT
! not a demand side component that we know needs to be active, do nothing
END SELECT
If (ShouldBeACTIVE) THEN
SELECT CASE (PlantLoop(LoopNum)%LoopSide(SideNum)%Branch(BranchNum)%ControlType)
CASE (ControlType_Unknown)
CALL ShowWarningError('Found potential problem with Control Type for Branch named: '&
//trim(PlantLoop(LoopNum)%LoopSide(SideNum)%Branch(BranchNum)%Name) )
CALL ShowContinueError('This branch should (probably) be ACTIVE but has control type unknown')
CASE (ControlType_Active)
! do nothing, this is correct control type.
CASE (ControlType_Passive)
CALL ShowWarningError('Found potential problem with Control Type for Branch named: '&
//trim(PlantLoop(LoopNum)%LoopSide(SideNum)%Branch(BranchNum)%Name) )
CALL ShowContinueError('This branch should (probably) be ACTIVE but has control type PASSIVE')
CASE (ControlType_SeriesActive)
! do nothing, should be okay. (? don't really understand SeriesActive though)
CASE (ControlType_Bypass)
CALL ShowWarningError('Found potential problem with Control Type for Branch named: '&
//trim(PlantLoop(LoopNum)%LoopSide(SideNum)%Branch(BranchNum)%Name) )
CALL ShowContinueError('This branch should (probably) be ACTIVE but has control type Bypass')
END SELECT
ENDIF ! should be active
ENDDO !comp num loop
ENDIF ! demand side
ENDDO ! splitter outlet nodes
ENDDO ! splitters
!check to see if bypass exists in demand side. If not warn error of possible flow problems
IF(.NOT. PlantLoop(LoopNum)%LoopSide(SideNum)%ByPassExists) THEN
IF(SideNum == DemandSide) THEN
CALL ShowWarningError('There is no BYPASS component in the demand-side of PlantLoop =' &
//TRIM(PlantLoop(LoopNum)%Name))
CALL ShowContinueError('You may be able to fix the fatal error above by adding a demand-side BYPASS PIPE.')
END IF
END IF
ENDDO ! loop sides
ENDDO ! plant loops
RETURN
END SUBROUTINE CheckPlantOnAbort