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 | ||
---|---|---|---|---|---|---|
integer, | intent(in) | :: | LoopNum | |||
integer, | intent(in) | :: | LoopSideNum | |||
integer, | intent(in) | :: | SplitNum | |||
integer, | intent(in) | :: | MixNum | |||
logical, | intent(in) | :: | FirstHVACIteration |
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 CheckPlantMixerSplitterConsistency(LoopNum,LoopSideNum,SplitNum, MixNum,FirstHVACIteration)
! SUBROUTINE INFORMATION:
! AUTHOR Brent Griffith
! DATE WRITTEN Oct 2007
! MODIFIED na
! RE-ENGINEERED na
! PURPOSE OF THIS SUBROUTINE:
! Check for plant flow resolver errors
! METHODOLOGY EMPLOYED:
! compare flow rate of splitter inlet to flow rate of mixer outlet
! REFERENCES:
! na
! USE STATEMENTS:
USE DataLoopNode, ONLY : Node
USE DataPlant, ONLY : PlantLoop, SupplySide, DemandSide, CriteriaDelta_MassFlowRate
USE DataBranchAirLoopPlant, ONLY : MassFlowTolerance
USE DataInterfaces, ONLY : ShowFatalError, ShowSevereError, ShowContinueError, ShowContinueErrorTimeStamp
USE DataGlobals, ONLY : WarmupFlag, DoingSizing
USE General, ONLY : RoundSigDigits
IMPLICIT NONE ! Enforce explicit typing of all variables in this routine
! SUBROUTINE ARGUMENT DEFINITIONS:
INTEGER, INTENT(IN) :: LoopNum
INTEGER, INTENT(IN) :: LoopSideNum
INTEGER, INTENT(IN) :: SplitNum
INTEGER, INTENT(IN) :: MixNum
LOGICAL, INTENT(IN) :: FirstHVACIteration
! SUBROUTINE PARAMETER DEFINITIONS:
! na
! INTERFACE BLOCK SPECIFICATIONS:
! na
! DERIVED TYPE DEFINITIONS:
! na
! SUBROUTINE LOCAL VARIABLE DECLARATIONS:
INTEGER :: MixerOutletNode
INTEGER :: SplitterInletNode
REAL(r64) :: AbsDifference
INTEGER :: NumSplitterOutlets
REAL(r64) :: SumOutletFlow
INTEGER :: OutletNum
INTEGER :: BranchNum
INTEGER :: LastNodeOnBranch
IF(.NOT. PlantLoop(LoopNum)%LoopHasConnectionComp) THEN
IF (.not. DoingSizing .and. .not. WarmupFlag .and. PlantLoop(LoopNum)%LoopSide(LoopSideNum)%MixerExists .and. &
.not. FirstHVACIteration) THEN
! Find mixer outlet node number
MixerOutletNode = PlantLoop(LoopNum)%LoopSide(LoopSideNum)%Mixer(MixNum)%NodeNumOut
! Find splitter inlet node number
SplitterInletNode = PlantLoop(LoopNum)%LoopSide(LoopSideNum)%Splitter(SplitNum)%NodeNumIn
AbsDifference=ABS(Node(SplitterInletNode)%MassFlowRate - Node(MixerOutletNode)%MassFlowRate)
IF (AbsDifference > MassFlowTolerance) THEN
IF (PlantLoop(LoopNum)%MFErrIndex1 == 0) THEN
CALL ShowSevereMessage('Plant flows do not resolve -- splitter inlet flow does not match mixer outlet flow ')
CALL ShowContinueErrorTimeStamp(' ')
CALL ShowContinueError('PlantLoop name= '//trim(PlantLoop(LoopNum)%Name) )
CALL ShowContinueError('Plant Connector:Mixer name= '//trim(PlantLoop(LoopNum)%LoopSide(LoopSideNum)%Mixer(MixNum)%Name) )
CALL ShowContinueError('Mixer outlet mass flow rate= '// &
trim(RoundSigDigits(Node(MixerOutletNode)%MassFlowRate,6))//' {kg/s}')
CALL ShowContinueError('Plant Connector:Splitter name= '// &
trim(PlantLoop(LoopNum)%LoopSide(LoopSideNum)%Splitter(SplitNum)%Name) )
CALL ShowContinueError('Splitter inlet mass flow rate= '// &
trim(RoundSigDigits(Node(SplitterInletNode)%MassFlowRate,6))//' {kg/s}')
CALL ShowContinueError('Difference in two mass flow rates= '// &
trim(RoundSigDigits(AbsDifference,6))//' {kg/s}')
ENDIF
CALL ShowRecurringSevereErrorAtEnd('Plant Flows (Loop='//trim(PlantLoop(LoopNum)%Name)// &
') splitter inlet flow not match mixer outlet flow',PlantLoop(LoopNum)%MFErrIndex1, &
ReportMaxOf=AbsDifference,ReportMinOf=AbsDifference,ReportMaxUnits='kg/s',ReportMinUnits='kg/s')
IF (AbsDifference > MassFlowTolerance*10.0d0) THEN
CALL ShowSevereError('Plant flows do not resolve -- splitter inlet flow does not match mixer outlet flow ')
CALL ShowContinueErrorTimeStamp(' ')
CALL ShowContinueError('PlantLoop name= '//trim(PlantLoop(LoopNum)%Name) )
CALL ShowContinueError('Plant Connector:Mixer name= '//trim(PlantLoop(LoopNum)%LoopSide(LoopSideNum)%Mixer(MixNum)%Name) )
CALL ShowContinueError('Mixer outlet mass flow rate= '// &
trim(RoundSigDigits(Node(MixerOutletNode)%MassFlowRate,6))//' {kg/s}')
CALL ShowContinueError('Plant Connector:Splitter name= '// &
trim(PlantLoop(LoopNum)%LoopSide(LoopSideNum)%Splitter(SplitNum)%Name) )
CALL ShowContinueError('Splitter inlet mass flow rate= '// &
trim(RoundSigDigits(Node(SplitterInletNode)%MassFlowRate,6))//' {kg/s}')
CALL ShowContinueError('Difference in two mass flow rates= '// &
trim(RoundSigDigits(AbsDifference,6))//' {kg/s}')
CALL ShowFatalError('CheckPlantMixerSplitterConsistency: '// &
'Simulation terminated because of problems in plant flow resolver')
ENDIF
ENDIF
! now check inside s/m to see if there are problems
! loop across branch outlet nodes and check mass continuity
NumSplitterOutlets = PlantLoop(LoopNum)%LoopSide(LoopSideNum)%Splitter(SplitNum)%TotalOutletNodes
SumOutletFlow = 0.d0
! SumInletFlow = 0.d0
DO OutletNum = 1, NumSplitterOutlets
BranchNum = PlantLoop(LoopNum)%LoopSide(LoopSideNum)%Splitter(SplitNum)%BranchNumOut(OutletNum)
LastNodeOnBranch = PlantLoop(LoopNum)%LoopSide(LoopSideNum)%Branch(branchNum)%NodeNumOut
SumOutletFlow = SumOutletFlow + Node(LastNodeOnBranch)%MassFlowRate
! FirstNodeOnBranch= PlantLoop(LoopNum)%LoopSide(LoopSideNum)%branch(branchNum)%NodeNumIn
! SumInletFlow = SumInletFlow + Node(FirstNodeOnBranch)%MassFlowRate
ENDDO
AbsDifference=ABS(Node(SplitterInletNode)%MassFlowRate - SumOutletFlow)
IF (AbsDifference > CriteriaDelta_MassFlowRate) THEN
IF (PlantLoop(LoopNum)%MFErrIndex2 == 0) THEN
CALL ShowSevereMessage('Plant flows do not resolve -- splitter inlet flow does not match branch outlet flows')
CALL ShowContinueErrorTimeStamp(' ')
CALL ShowContinueError('PlantLoop name= '//trim(PlantLoop(LoopNum)%Name) )
CALL ShowContinueError('Plant Connector:Mixer name= '//trim(PlantLoop(LoopNum)%LoopSide(LoopSideNum)%Mixer(MixNum)%Name) )
CALL ShowContinueError('Sum of Branch outlet mass flow rates= '// &
trim(RoundSigDigits(SumOutletFlow,6))//' {kg/s}')
CALL ShowContinueError('Plant Connector:Splitter name= '// &
trim(PlantLoop(LoopNum)%LoopSide(LoopSideNum)%Splitter(SplitNum)%Name) )
CALL ShowContinueError('Splitter inlet mass flow rate= '// &
trim(RoundSigDigits(Node(SplitterInletNode)%MassFlowRate,6))//' {kg/s}')
CALL ShowContinueError('Difference in two mass flow rates= '// &
trim(RoundSigDigits(AbsDifference,6))//' {kg/s}')
ENDIF
CALL ShowRecurringSevereErrorAtEnd('Plant Flows (Loop='//trim(PlantLoop(LoopNum)%Name)// &
') splitter inlet flow does not match branch outlet flows',PlantLoop(LoopNum)%MFErrIndex2, &
ReportMaxOf=AbsDifference,ReportMinOf=AbsDifference,ReportMaxUnits='kg/s',ReportMinUnits='kg/s')
! IF (AbsDifference > CriteriaDelta_MassFlowRate*10.0d0) THEN
! CALL ShowSevereError('Plant flows do not resolve -- splitter inlet flow does not match branch outlet flows')
! CALL ShowContinueErrorTimeStamp(' ')
! CALL ShowContinueError('PlantLoop name= '//trim(PlantLoop(LoopNum)%Name) )
! CALL ShowContinueError('Plant Connector:Mixer name= '//trim(PlantLoop(LoopNum)%LoopSide(LoopSideNum)%Mixer(MixNum)%Name) )
! CALL ShowContinueError('Sum of Branch outlet mass flow rates= '// &
! trim(RoundSigDigits(SumOutletFlow,6))//' {kg/s}')
! CALL ShowContinueError('Plant Connector:Splitter name= '// &
! trim(PlantLoop(LoopNum)%LoopSide(LoopSideNum)%Splitter(SplitNum)%Name) )
! CALL ShowContinueError('Splitter inlet mass flow rate= '// &
! trim(RoundSigDigits(Node(SplitterInletNode)%MassFlowRate,6))//' {kg/s}')
! CALL ShowContinueError('Difference in two mass flow rates= '// &
! trim(RoundSigDigits(AbsDifference,6))//' {kg/s}')
! CALL ShowFatalError('CheckPlantMixerSplitterConsistency: Simulation terminated because of problems in plant flow resolver')
! ENDIF
ENDIF
ENDIF
END IF
RETURN
END SUBROUTINE CheckPlantMixerSplitterConsistency