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 | |||
real(kind=r64), | intent(in) | :: | ThisLoopSideFlow | |||
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.
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 ResolveParallelFlows(LoopNum, LoopSideNum, ThisLoopSideFlow, FirstHVACIteration)
! SUBROUTINE INFORMATION:
! AUTHOR Brandon Anderson, Dan Fisher
! DATE WRITTEN October 1999
! MODIFIED May 2005 Sankaranarayanan K P, Rich Liesen
! RE-ENGINEERED Sept 2010 Dan Fisher, Brent Griffith for demand side update
! PURPOSE OF THIS SUBROUTINE:
! This subroutine takes the overall loop side flow and distributes
! it among parallel branches. this is the main implementation of
! flow splitting for plant splitter/mixer
! METHODOLOGY EMPLOYED:
! Flow through the branches is currently determined by
! the active component on the branch, as well as the
! order of the branches following the splitter.
! SimPlantEquipment is run first, and the active components
! request their flow. These flows are compared and a simple
! algorithm balances flow in the branches. The flow in these
! branches is then locked down, via MassFlowRateMaxAvail and MinAvail
! SimPlant Equipment is then run again in order to get correct
! properties. Finally, Max/MinAvail are reset for the next time step.
! USE STATEMENTS:
USE DataPlant, ONLY: PlantLoop, TypeOf_PumpVariableSpeed, TypeOf_PumpBankVariableSpeed
USE DataBranchAirLoopPlant, ONLY: ControlType_Unknown,ControlType_Active, ControlType_Passive, &
ControlType_SeriesActive, ControlType_Bypass, MassFlowTolerance
USE DataLoopNode, ONLY: Node
USE DataInterfaces, ONLY: ShowSevereError, ShowContinueError, ShowContinueErrorTimeStamp
USE General, ONLY: RoundSigDigits
IMPLICIT NONE ! Enforce explicit typing of all variables in this routine
! SUBROUTINE ARGUMENT DEFINITIONS:
INTEGER, INTENT(IN) :: LoopNum !plant loop number that we are balancing flow for
INTEGER, INTENT(IN) :: LoopSideNum !plant loop number that we are balancing flow for
REAL(r64), INTENT(IN) :: ThisLoopSideFlow ! [kg/s] total flow to be split
LOGICAL, INTENT(IN) :: FirstHVACIteration ! TRUE if First HVAC iteration of Time step
! SUBROUTINE PARAMETER DEFINITIONS:
CHARACTER(len=6), DIMENSION(2), PARAMETER :: LoopSideName = (/'Demand','Supply'/)
INTEGER, PARAMETER :: SplitNum = 1 ! Only one splitter/mixer combination is allowed
INTEGER, PARAMETER :: LoopSideSingleBranch = 1 ! For readability
! SUBROUTINE LOCAL VARIABLE DECLARATIONS:
INTEGER :: NumActiveBranches !Active branch counter
REAL(r64) :: ActiveFlowRate !The flow available when cycling through branches
REAL(r64) :: PassiveFlowRate !The flow available when cycling through branches
REAL(r64) :: FracFlow !The flow available when cycling through branches
REAL(r64) :: ThisBranchRequestFrac !The request ratio
REAL(r64) :: totalMax !The flow available when cycling through branches
REAL(r64) :: FlowRemaining !The flow available when cycling through branches
INTEGER :: OutletNum !Splitter outlet
INTEGER :: MixerBranchOut
INTEGER :: SplitterBranchIn !As the name implies
INTEGER :: SplitterBranchOut !As the name implies
INTEGER :: LastNodeOnBranch ! intermediate value used for better readabilty
INTEGER :: FirstNodeOnBranch ! intermediate value used for better readabilty
INTEGER :: BranchNum ! intermediate value used for better readabilty
INTEGER :: iBranch ! DO loop counter for cycling through branches
INTEGER :: NumSplitOutlets !As the name implies
REAL(r64) :: OutletBranchMinAvail
REAL(r64) :: OutletBranchMaxAvail
REAL(r64) :: InletBranchMinAvail
REAL(r64) :: InletBranchMaxAvail
REAL(r64) :: BranchFlowReq
REAL(r64) :: BranchMinAvail
REAL(r64) :: BranchMaxAvail
REAL(r64) :: ParallelBranchMaxAvail
REAL(r64) :: ParallelBranchMinAvail
REAL(r64) :: TotParallelBranchFlowReq
REAL(r64) :: LoopFlowRate
INTEGER :: FirstNodeOnBranchIn
INTEGER :: FirstNodeOnBranchOut
REAL(r64) :: StartingFlowRate
REAL(r64) :: ThisBranchRequest
INTEGER :: CompCounter
INTEGER :: CompInletNode
INTEGER :: CompOutletNode
! Error Messages from the old RequestNetworkFlowAndSolve
!
! IF(PlantLoop(LoopNum)%Loopside(Loopsidenum)%Branch(CurBranch)%ControlType .NE. ControlType_Active .AND. &
! PlantLoop(LoopNum)%Loopside(Loopsidenum)%Branch(CurBranch)%ControlType .NE. ControlType_Passive) THEN
! CALL ShowSevereError ('PlantLoop:An Active component can be in series with active or passive components only')
! CALL ShowContinueError('Occurs in Branch='//TRIM(PlantLoop(LoopNum)%Loopside(Loopsidenum)%Branch(CurBranch)%Name))
! CALL ShowContinueError('Occurs in Plant Loop='//TRIM(PlantLoop(LoopNum)%Name))
! CALL ShowFatalError('Preceding condition causes termination.')
! END IF
!
! CASE (ControlType_Bypass)
!
! IF(CurComp .NE. 1) THEN
! CALL ShowSevereError ('PlantLoop:A Bypass pipe cannot be in series with another component')
! CALL ShowContinueError('Occurs in Branch='//TRIM(PlantLoop(LoopNum)%Loopside(Loopsidenum)%Branch(CurBranch)%Name))
! CALL ShowContinueError('Occurs in Plant Loop='//TRIM(PlantLoop(LoopNum)%Name))
! CALL ShowFatalError('Preceding condition causes termination.')
! END IF !Set Branch ByPass Flag
!
! CASE (ControlType_SeriesActive)
!
! IF(CurComp .NE. 1) THEN
! IF(PlantLoop(LoopNum)%Loopside(Loopsidenum)%Branch(CurBranch)%ControlType .NE. ControlType_SeriesActive) THEN
! CALL ShowSevereError ('PlantLoop:A SeriesActive component can be in series with SeriesActive components only')
! CALL ShowContinueError('Occurs in Branch='//TRIM(PlantLoop(LoopNum)%Loopside(Loopsidenum)%Branch(CurBranch)%Name))
! CALL ShowContinueError('Occurs in Plant Loop='//TRIM(PlantLoop(LoopNum)%Name))
! CALL ShowFatalError('Preceding condition causes termination.')
! END IF
! END IF
!
!
! CASE (ControlType_Passive)
!
! IF(PlantLoop(LoopNum)%Loopside(Loopsidenum)%Branch(CurBranch)%ControlType .NE. ControlType_Active .AND. &
! PlantLoop(LoopNum)%Loopside(Loopsidenum)%Branch(CurBranch)%ControlType .NE. ControlType_Passive) THEN
! CALL ShowSevereError ('PlantLoop:A Passive component can be in series with active or passive components only')
! CALL ShowContinueError('Occurs in Branch='//TRIM(PlantLoop(LoopNum)%Loopside(Loopsidenum)%Branch(CurBranch)%Name))
! CALL ShowContinueError('Occurs in Plant Loop='//TRIM(PlantLoop(LoopNum)%Name))
! CALL ShowFatalError('Preceding condition causes termination.')
! END IF
!
! If there is no splitter then there is no continuity to enforce.
IF (.NOT. PlantLoop(LoopNum)%LoopSide(LoopSideNum)%SplitterExists) THEN
!If there's only one branch, then RETURN
IF(PlantLoop(LoopNum)%Loopside(Loopsidenum)%TotalBranches == 1)THEN
! The branch should just try to meet the request previously calculated. This should be good,
! just need to make sure that during FlowUnlocked, no one constrained Min/Max farther.
! This would have been propogated down the branch, so we can check the outlet node min/max avail for this.
LastNodeOnBranch = PlantLoop(LoopNum)%LoopSide(LoopSideNum)%branch(LoopSideSingleBranch)%NodeNumOut
FirstNodeOnBranch = PlantLoop(LoopNum)%LoopSide(LoopSideNum)%branch(LoopSideSingleBranch)%NodeNumIn
BranchMinAvail = Node(LastNodeOnBranch)%MassFlowRateMinAvail
BranchMaxAvail = Node(LastNodeOnBranch)%MassFlowRateMaxAvail
Node(FirstNodeOnBranch)%MassFlowRate = MIN(MAX(ThisLoopSideFlow, BranchMinAvail), BranchMaxAvail)
! now with flow locked, this single branch will just ran at the specified flow rate, so we are done
RETURN
ELSE
CALL ShowSevereError('Plant topology problem for PlantLoop: '//PlantLoop(LoopNum)%Name//', '// &
LoopSideName(LoopSideNum)//' side.')
CALL ShowContinueError('There are multiple branches, yet no splitter. This is an invalid configuration.')
CALL ShowContinueError('Add a set of connectors, use put components on a single branch.')
CALL ShowFatalError('Invalid plant topology causes program termination.')
RETURN
END IF
END IF
! If a splitter/mixer combination exist on the loop
IF (PlantLoop(LoopNum)%LoopSide(LoopSideNum)%SplitterExists .AND. &
PlantLoop(LoopNum)%LoopSide(LoopSideNum)%MixerExists) THEN
! Zero out local variables
TotParallelBranchFlowReq = 0.0d0
NumSplitOutlets = PlantLoop(LoopNum)%LoopSide(LoopSideNum)%Splitter(SplitNum)%TotalOutletNodes
IF(NumSplitOutlets < 1)THEN
CALL ShowSevereError('Plant topology problem for PlantLoop: '//PlantLoop(LoopNum)%Name//', '// &
LoopSideName(LoopSideNum)//' side.')
CALL ShowContinueError('Diagnostic error in PlantLoopSolver::ResolveParallelFlows.')
CALL ShowContinueError('Splitter improperly specified, no splitter outlets.')
CALL ShowFatalError('Invalid plant topology causes program termination.')
ENDIF
NumActiveBranches = 0
ParallelBranchMaxAvail = 0.0d0
ParallelBranchMinAvail = 0.0d0
DO iBranch = 1, NumSplitOutlets
BranchNum = PlantLoop(LoopNum)%LoopSide(LoopSideNum)%Splitter(SplitNum)%BranchNumOut(iBranch)
SplitterBranchOut = PlantLoop(LoopNum)%LoopSide(LoopSideNum)%Splitter(SplitNum)%BranchNumOut(iBranch)
LastNodeOnBranch = PlantLoop(LoopNum)%LoopSide(LoopSideNum)%branch(branchNum)%NodeNumOut
FirstNodeOnBranch= PlantLoop(LoopNum)%LoopSide(LoopSideNum)%branch(branchNum)%NodeNumIn
BranchFlowReq = DetermineBranchFlowRequest(LoopNum, LoopSideNum, BranchNum)
!now, if we are have branch pumps, here is the situation:
! constant speed pumps lock in a flow request on the inlet node
! variable speed pumps which have other components on the branch do not log a request themselves
! the DetermineBranchFlowRequest routine only looks at the branch inlet node
! for variable speed branch pumps then, this won't work because the branch will be requesting zero
! so let's adjust for this here to make sure these branches get good representation
DO CompCounter = 1, PlantLoop(LoopNum)%LoopSide(LoopSideNum)%Branch(BranchNum)%TotalComponents
!if this isn't a variable speed pump then just keep cycling
IF ( (PlantLoop(LoopNum)%LoopSide(LoopSideNum)%Branch(BranchNum)%Comp(CompCounter)%TypeOf_Num &
.NE. TypeOf_PumpVariableSpeed) .AND. &
(PlantLoop(LoopNum)%LoopSide(LoopSideNum)%Branch(BranchNum)%Comp(CompCounter)%TypeOf_Num &
.NE. TypeOf_PumpBankVariableSpeed) ) THEN
CYCLE
END IF
CompInletNode = PlantLoop(LoopNum)%LoopSide(LoopSideNum)%Branch(BranchNum)%Comp(CompCounter)%NodeNumIn
BranchFlowReq = MAX(BranchFlowReq, Node(CompInletNode)%MassFLowRateRequest)
END DO
BranchMinAvail = Node(LastNodeOnBranch)%MassFlowRateMinAvail
BranchMaxAvail = Node(LastNodeOnBranch)%MassFlowRateMaxAvail
! !sum the branch flow requests to a total parallel branch flow request
IF (PlantLoop(LoopNum)%LoopSide(LoopSideNum)%Branch(SplitterBranchOut)%ControlType == ControlType_Active .OR. &
PlantLoop(LoopNum)%LoopSide(LoopSideNum)%Branch(SplitterBranchOut)%ControlType == ControlType_SeriesActive) THEN
TotParallelBranchFlowReq = TotParallelBranchFlowReq + BranchFlowReq
NumActiveBranches = NumActiveBranches + 1
ENDIF
Node(FirstNodeOnBranch)%MassFlowRate = BranchFlowReq
Node(FirstNodeOnBranch)%MassFlowRateMinAvail = BranchMinAvail
Node(FirstNodeOnBranch)%MassFlowRateMaxAvail = BranchMaxAvail
ParallelBranchMaxAvail = ParallelBranchMaxAvail + BranchMaxAvail
ParallelBranchMinAvail = ParallelBranchMinAvail + BranchMinAvail
END DO
!
! ! Find branch number and flow rates at splitter inlet
SplitterBranchIn = PlantLoop(LoopNum)%LoopSide(LoopSideNum)%Splitter(SplitNum)%BranchNumIn
LastNodeOnBranch = PlantLoop(LoopNum)%LoopSide(LoopSideNum)%branch(SplitterBranchIn)%NodeNumOut
FirstNodeOnBranchIn = PlantLoop(LoopNum)%LoopSide(LoopSideNum)%branch(SplitterBranchIn)%NodeNumIn
InletBranchMinAvail = Node(LastNodeOnBranch)%MassFlowRateMinAvail
InletBranchMaxAvail = Node(LastNodeOnBranch)%MassFlowRateMaxAvail
! ! Find branch number and flow rates at mixer outlet
MixerBranchOut = PlantLoop(LoopNum)%LoopSide(LoopSideNum)%Mixer(SplitNum)%BranchNumOut
LastNodeOnBranch = PlantLoop(LoopNum)%LoopSide(LoopSideNum)%branch(MixerBranchOut)%NodeNumOut
FirstNodeOnBranchOut = PlantLoop(LoopNum)%LoopSide(LoopSideNum)%branch(MixerBranchOut)%NodeNumIn
OutletBranchMinAvail = Node(LastNodeOnBranch)%MassFlowRateMinAvail
OutletBranchMaxAvail = Node(LastNodeOnBranch)%MassFlowRateMaxAvail
LoopFlowRate = ThisLoopSideFlow
!Reset branch inlet node flow rates for the first and last branch on loop
Node(FirstNodeOnBranchIn)%MassFlowRate = ThisLoopSideFlow
Node(FirstNodeOnBranchOut)%MassFlowRate = ThisLoopSideFlow
!Reset branch inlet node Min/MaxAvails for the first and last branch on loop
Node(FirstNodeOnBranchIn)%MassFlowRateMaxAvail = MIN(Node(FirstNodeOnBranchIn)%MassFlowRateMaxAvail, &
ParallelBranchMaxAvail)
Node(FirstNodeOnBranchIn)%MassFlowRateMaxAvail = MIN(Node(FirstNodeOnBranchIn)%MassFlowRateMaxAvail, &
Node(FirstNodeOnBranchOut)%MassFlowRateMaxAvail)
Node(FirstNodeOnBranchIn)%MassFlowRateMinAvail = MAX(Node(FirstNodeOnBranchIn)%MassFlowRateMinAvail, &
ParallelBranchMinAvail)
Node(FirstNodeOnBranchIn)%MassFlowRateMinAvail = MAX(Node(FirstNodeOnBranchIn)%MassFlowRateMinAvail, &
Node(FirstNodeOnBranchOut)%MassFlowRateMinAvail)
Node(FirstNodeOnBranchOut)%MassFlowRateMinAvail = Node(FirstNodeOnBranchIn)%MassFlowRateMinAvail
Node(FirstNodeOnBranchOut)%MassFlowRateMaxAvail = Node(FirstNodeOnBranchIn)%MassFlowRateMaxAvail
!Initialize the remaining flow variable
FlowRemaining = ThisLoopSideFlow
!Initialize flow on passive, bypass and uncontrolled parallel branches to zero. For these branches
!MinAvail is not enforced
DO OutletNum = 1, NumSplitOutlets
SplitterBranchOut = PlantLoop(LoopNum)%LoopSide(LoopSideNum)%Splitter(SplitNum)%BranchNumOut(OutletNum)
FirstNodeOnBranch = PlantLoop(LoopNum)%LoopSide(LoopSideNum)%branch(SplitterBranchOut)%NodeNumIn
IF (PlantLoop(LoopNum)%LoopSide(LoopSideNum)%Branch(SplitterBranchOut)%ControlType /= ControlType_Active .AND. &
PlantLoop(LoopNum)%LoopSide(LoopSideNum)%Branch(SplitterBranchOut)%ControlType /= ControlType_SeriesActive) THEN
Node(FirstNodeOnBranch)%MassFlowRate = 0.0d0
CALL PushBranchFlowCharacteristics(LoopNum, LoopSideNum, SplitterBranchOut, &
Node(FirstNodeOnBranch)%MassFlowRate, FirstHVACIteration)
ENDIF
END DO
!IF SUFFICIENT FLOW TO MEET ALL PARALLEL BRANCH FLOW REQUESTS
IF (FlowRemaining < MassFlowTolerance) THEN ! no flow available at all for splitter
DO OutletNum = 1, NumSplitOutlets
SplitterBranchOut = PlantLoop(LoopNum)%LoopSide(LoopSideNum)%Splitter(SplitNum)%BranchNumOut(OutletNum)
DO CompCounter = 1, PlantLoop(LoopNum)%LoopSide(LoopSideNum)%Branch(SplitterBranchOut)%TotalComponents
FirstNodeOnBranch = PlantLoop(LoopNum)%LoopSide(LoopSideNum)%Branch(SplitterBranchOut)%NodeNumIn
CompInletNode = PlantLoop(LoopNum)%LoopSide(LoopSideNum)%Branch(SplitterBranchOut)%Comp(CompCounter)%NodeNumIn
CompOutletNode = PlantLoop(LoopNum)%LoopSide(LoopSideNum)%Branch(SplitterBranchOut)%Comp(CompCounter)%NodeNumOut
Node(CompInletNode)%MassFlowRate = 0.d0
Node(CompInletNode)%MassFlowRateMaxAvail = 0.d0
Node(CompOutletNode)%MassFlowRate = 0.d0
Node(CompOutletNode)%MassFlowRateMaxAvail = 0.d0
ENDDO
END DO
RETURN
ELSEIF (FlowRemaining .GE. TotParallelBranchFlowReq) THEN
! 1) Satisfy flow demand of ACTIVE splitter outlet branches
DO OutletNum = 1, NumSplitOutlets
SplitterBranchOut = PlantLoop(LoopNum)%LoopSide(LoopSideNum)%Splitter(SplitNum)%BranchNumOut(OutletNum)
FirstNodeOnBranch = PlantLoop(LoopNum)%LoopSide(LoopSideNum)%branch(SplitterBranchOut)%NodeNumIn
IF (PlantLoop(LoopNum)%LoopSide(LoopSideNum)%Branch(SplitterBranchOut)%ControlType == ControlType_Active .OR. &
PlantLoop(LoopNum)%LoopSide(LoopSideNum)%Branch(SplitterBranchOut)%ControlType == ControlType_SeriesActive) THEN
! branch flow is min of requested flow and remaining flow
Node(FirstNodeOnBranch)%MassFlowRate = MIN(Node(FirstNodeOnBranch)%MassFlowRate,FlowRemaining)
IF(Node(FirstNodeOnBranch)%MassFlowRate < MassFlowTolerance) Node(FirstNodeOnBranch)%MassFlowRate = 0.0d0
CALL PushBranchFlowCharacteristics(LoopNum, LoopSideNum, SplitterBranchOut, &
Node(FirstNodeOnBranch)%MassFlowRate, FirstHVACIteration)
FlowRemaining = FlowRemaining - Node(FirstNodeOnBranch)%MassFlowRate
IF(FlowRemaining < MassFlowTolerance) FlowRemaining = 0.0d0
ENDIF
END DO
!IF the active branches take the entire loop flow, return
IF(FlowRemaining == 0.0d0)RETURN
! 2) Distribute remaining flow to PASSIVE branches
totalMax = 0.0d0
DO OutletNum = 1, NumSplitOutlets
SplitterBranchOut = PlantLoop(LoopNum)%LoopSide(LoopSideNum)%Splitter(SplitNum)%BranchNumOut(OutletNum)
FirstNodeOnBranch = PlantLoop(LoopNum)%LoopSide(LoopSideNum)%branch(SplitterBranchOut)%NodeNumIn
IF (PlantLoop(LoopNum)%LoopSide(LoopSideNum)%Branch(SplitterBranchOut)%ControlType == ControlType_Passive) THEN
!Calculate the total max available
totalMax = totalMax + Node(FirstNodeOnBranch)%MassFlowRateMaxAvail
END IF
END DO
IF (totalMax > 0) THEN
DO OutletNum = 1, NumSplitOutlets
SplitterBranchOut = PlantLoop(LoopNum)%LoopSide(LoopSideNum)%Splitter(SplitNum)%BranchNumOut(OutletNum)
FirstNodeOnBranch = PlantLoop(LoopNum)%LoopSide(LoopSideNum)%branch(SplitterBranchOut)%NodeNumIn
IF (PlantLoop(LoopNum)%LoopSide(LoopSideNum)%Branch(SplitterBranchOut)%ControlType == ControlType_Passive) THEN
FracFlow = FlowRemaining / totalMax
IF (FracFlow <= 1.0d0) THEN !the passive branches will take all the flow
PassiveFlowRate = FracFlow * Node(FirstNodeOnBranch)%MassFlowRateMaxAvail
!Check against FlowRemaining
PassiveFlowRate = MIN(FlowRemaining,PassiveFlowRate)
!Allow FlowRequest to be increased to meet minimum on branch
PassiveFlowRate = MAX(PassiveFlowRate,Node(FirstNodeOnBranch)%MassFlowRateMinAvail)
FlowRemaining = MAX((FlowRemaining - PassiveFlowRate),0.0d0)
Node(FirstNodeOnBranch)%MassFlowRate = PassiveFlowRate
ELSE !Each Branch receives maximum flow and BYPASS must be used
Node(FirstNodeOnBranch)%MassFlowRate = MIN(Node(FirstNodeOnBranch)%MassFlowRateMaxAvail, FlowRemaining)
FlowRemaining = FlowRemaining - Node(FirstNodeOnBranch)%MassFlowRate
END IF
CALL PushBranchFlowCharacteristics(LoopNum, LoopSideNum, SplitterBranchOut, &
Node(FirstNodeOnBranch)%MassFlowRate, FirstHVACIteration)
ENDIF
ENDDO
ENDIF !totalMax <=0 and flow should be assigned to active branches
!IF the passive branches take the remaining loop flow, return
IF(FlowRemaining == 0.0d0)RETURN
! 3) Distribute remaining flow to the BYPASS
DO OutletNum = 1, PlantLoop(LoopNum)%LoopSide(LoopSideNum)%Splitter(SplitNum)%TotalOutletNodes
SplitterBranchOut = PlantLoop(LoopNum)%LoopSide(LoopSideNum)%Splitter(SplitNum)%BranchNumOut(OutletNum)
FirstNodeOnBranch = PlantLoop(LoopNum)%LoopSide(LoopSideNum)%branch(SplitterBranchOut)%NodeNumIn
IF (PlantLoop(LoopNum)%LoopSide(LoopSideNum)%Branch(SplitterBranchOut)%ControlType == ControlType_Bypass) THEN
Node(FirstNodeOnBranch)%MassFlowRate = MIN(FlowRemaining,Node(FirstNodeOnBranch)%MassFlowRateMaxAvail)
CALL PushBranchFlowCharacteristics(LoopNum, LoopSideNum, SplitterBranchOut, &
Node(FirstNodeOnBranch)%MassFlowRate, FirstHVACIteration)
FlowRemaining = FlowRemaining - Node(FirstNodeOnBranch)%MassFlowRate
END IF
END DO
!IF the bypass take the remaining loop flow, return
IF(FlowRemaining == 0.0d0)RETURN
! 4) If PASSIVE branches and BYPASS are at max and there's still flow, distribute remaining flow to ACTIVE branches
IF(NumActiveBranches > 0)THEN
ActiveFlowRate = FlowRemaining / NumActiveBranches
DO OutletNum = 1, NumSplitOutlets
SplitterBranchOut = PlantLoop(LoopNum)%LoopSide(LoopSideNum)%Splitter(SplitNum)%BranchNumOut(OutletNum)
FirstNodeOnBranch = PlantLoop(LoopNum)%LoopSide(LoopSideNum)%branch(SplitterBranchOut)%NodeNumIn
IF (PlantLoop(LoopNum)%LoopSide(LoopSideNum)%Branch(SplitterBranchOut)%ControlType == ControlType_Active .OR. &
PlantLoop(LoopNum)%LoopSide(LoopSideNum)%Branch(SplitterBranchOut)%ControlType == ControlType_SeriesActive) THEN
!check Remaining flow (should be correct!)
ActiveFlowRate = MIN(ActiveFlowRate, FlowRemaining)
!set the flow rate to the MIN((MassFlowRate+AvtiveFlowRate), MaxAvail)
StartingFlowRate = Node(FirstNodeOnBranch)%MassFlowRate
Node(FirstNodeOnBranch)%MassFlowRate = MIN((Node(FirstNodeOnBranch)%MassFlowRate + ActiveFlowRate), &
Node(FirstNodeOnBranch)%MassFlowRateMaxAvail)
CALL PushBranchFlowCharacteristics(LoopNum, LoopSideNum, SplitterBranchOut, &
Node(FirstNodeOnBranch)%MassFlowRate, FirstHVACIteration)
!adjust the remaining flow
FlowRemaining = FlowRemaining - (Node(FirstNodeOnBranch)%MassFlowRate - StartingFlowRate)
ENDIF
IF(FlowRemaining == 0)EXIT
END DO
!IF the active branches take the remaining loop flow, return
IF(FlowRemaining == 0.0d0)RETURN
! 5) Step 4) could have left ACTIVE branches < MaxAvail. Check to makes sure all ACTIVE branches are at MaxAvail
DO OutletNum = 1, NumSplitOutlets
SplitterBranchOut = PlantLoop(LoopNum)%LoopSide(LoopSideNum)%Splitter(SplitNum)%BranchNumOut(OutletNum)
FirstNodeOnBranch = PlantLoop(LoopNum)%LoopSide(LoopSideNum)%branch(SplitterBranchOut)%NodeNumIn
IF (PlantLoop(LoopNum)%LoopSide(LoopSideNum)%Branch(SplitterBranchOut)%ControlType == ControlType_Active .OR. &
PlantLoop(LoopNum)%LoopSide(LoopSideNum)%Branch(SplitterBranchOut)%ControlType == ControlType_SeriesActive) THEN
StartingFlowRate = Node(FirstNodeOnBranch)%MassFlowRate
ActiveFlowRate = MIN(FlowRemaining, (Node(FirstNodeOnBranch)%MassFlowRateMaxAvail-StartingFlowRate))
FlowRemaining = FlowRemaining - ActiveFlowRate
Node(FirstNodeOnBranch)%MassFlowRate = StartingFlowRate + ActiveFlowRate
CALL PushBranchFlowCharacteristics(LoopNum, LoopSideNum, SplitterBranchOut, &
Node(FirstNodeOnBranch)%MassFlowRate, FirstHVACIteration)
ENDIF
END DO
ENDIF
!IF the active branches take the remaining loop flow, return
IF(FlowRemaining == 0.0d0)RETURN
! 6) Adjust Inlet branch and outlet branch flow rates to match parallel branch rate
!DSU? do we need this logic? or should we fatal on a diagnostic error
TotParallelBranchFlowReq =0.0d0
DO iBranch = 1, NumSplitOutlets
BranchNum = PlantLoop(LoopNum)%LoopSide(LoopSideNum)%Splitter(SplitNum)%BranchNumOut(iBranch)
FirstNodeOnBranch= PlantLoop(LoopNum)%LoopSide(LoopSideNum)%branch(branchNum)%NodeNumIn
!calculate parallel branch flow rate
TotParallelBranchFlowReq = TotParallelBranchFlowReq + Node(FirstNodeOnBranch)%MassFlowRate
END DO
! Reset the flow on the splitter inlet branch
SplitterBranchIn = PlantLoop(LoopNum)%LoopSide(LoopSideNum)%Splitter(SplitNum)%BranchNumIn
FirstNodeOnBranchIn = PlantLoop(LoopNum)%LoopSide(LoopSideNum)%branch(SplitterBranchIn)%NodeNumIn
Node(FirstNodeOnBranchIn)%MassFlowRate = TotParallelBranchFlowReq
CALL PushBranchFlowCharacteristics(LoopNum, LoopSideNum, SplitterBranchIn, &
Node(FirstNodeOnBranchIn)%MassFlowRate, FirstHVACIteration)
! Reset the flow on the Mixer outlet branch
MixerBranchOut = PlantLoop(LoopNum)%LoopSide(LoopSideNum)%Mixer(SplitNum)%BranchNumOut
FirstNodeOnBranchOut = PlantLoop(LoopNum)%LoopSide(LoopSideNum)%branch(MixerBranchOut)%NodeNumIn
Node(FirstNodeOnBranchOut)%MassFlowRate = TotParallelBranchFlowReq
CALL PushBranchFlowCharacteristics(LoopNum, LoopSideNum, MixerBranchOut, &
Node(FirstNodeOnBranchOut)%MassFlowRate, FirstHVACIteration)
RETURN
!IF INSUFFICIENT FLOW TO MEET ALL PARALLEL BRANCH FLOW REQUESTS
ELSE IF(FlowRemaining < TotParallelBranchFlowReq) THEN
!DSU? didn't take the time to figure out what this should be... SplitterFlowIn = SplitterInletFlow(SplitNum)
! 1) apportion flow based on requested fraction of total
DO OutletNum = 1, NumSplitOutlets
SplitterBranchOut = PlantLoop(LoopNum)%LoopSide(LoopSideNum)%Splitter(SplitNum)%BranchNumOut(OutletNum)
ThisBranchRequest = DetermineBranchFlowRequest(LoopNum, LoopSideNum, SplitterBranchOut)
FirstNodeOnBranch = PlantLoop(LoopNum)%LoopSide(LoopSideNum)%branch(SplitterBranchOut)%NodeNumIn
IF ((PlantLoop(LoopNum)%LoopSide(LoopSideNum)%Branch(SplitterBranchOut)%ControlType == ControlType_Active) .OR. &
(PlantLoop(LoopNum)%LoopSide(LoopSideNum)%Branch(SplitterBranchOut)%ControlType == ControlType_SeriesActive) ) THEN
ThisBranchRequestFrac = ThisBranchRequest / TotParallelBranchFlowReq
! FracFlow = Node(FirstNodeOnBranch)%MassFlowRate/TotParallelBranchFlowReq
! Node(FirstNodeOnBranch)%MassFlowRate = MIN((FracFlow * Node(FirstNodeOnBranch)%MassFlowRate),FlowRemaining)
Node(FirstNodeOnBranch)%MassFlowRate = ThisBranchRequestFrac * ThisLoopSideFlow
CALL PushBranchFlowCharacteristics(LoopNum, LoopSideNum, SplitterBranchOut, &
Node(FirstNodeOnBranch)%MassFlowRate, FirstHVACIteration)
FlowRemaining = FlowRemaining - Node(FirstNodeOnBranch)%MassFlowRate
END IF
END DO
! 1b) check if flow all apportioned
IF(FlowRemaining > MassFlowTolerance)THEN
!Call fatal diagnostic error. !The math should work out!
CALL ShowSevereError('ResolveParallelFlows: Dev note, failed to redistribute restricted flow')
CALL ShowContinueErrorTimeStamp(' ')
CALL ShowContinueError('Loop side flow = '//TRIM(RoundSigDigits(ThisLoopSideFlow,8))//' (kg/s)' )
CALL ShowContinueError('Flow Remaining = '//TRIM(RoundSigDigits(FlowRemaining,8))//' (kg/s)' )
CALL ShowContinueError('Parallel Branch requests = '//TRIM(RoundSigDigits(TotParallelBranchFlowReq,8))//' (kg/s)' )
ENDIF
! 2) ! Reset the flow on the Mixer outlet branch
MixerBranchOut = PlantLoop(LoopNum)%LoopSide(LoopSideNum)%Mixer(SplitNum)%BranchNumOut
FirstNodeOnBranchOut = PlantLoop(LoopNum)%LoopSide(LoopSideNum)%branch(MixerBranchOut)%NodeNumIn
Node(FirstNodeOnBranchOut)%MassFlowRate = TotParallelBranchFlowReq
CALL PushBranchFlowCharacteristics(LoopNum, LoopSideNum, MixerBranchOut, &
Node(FirstNodeOnBranchOut)%MassFlowRate, FirstHVACIteration)
END IF ! Total flow requested >= or < Total parallel request
END IF ! Spittler/Mixer exists
RETURN
END SUBROUTINE ResolveParallelFlows