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) | :: | ThisSide | |||
integer, | intent(in) | :: | OtherSide | |||
real(kind=r64), | intent(inout) | :: | LoopFlow |
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 SetupLoopFlowRequest(LoopNum, ThisSide, OtherSide, LoopFlow)
! FUNCTION INFORMATION:
! AUTHOR: Dan Fisher, Edwin Lee
! DATE WRITTEN: August 2010
! MODIFIED: na
! RE-ENGINEERED: na
! PURPOSE OF THIS SUBROUTINE:
! This routine sets up the flow request values and sums them up for each loop side
! Then makes a decision on the desired loop flow based on loop configuration
! METHODOLOGY EMPLOYED:
! Scan through the components on this loop side, and look at the mass flow request
! values on components inlet node.
! Check common pipe/pumping configuration for this loop side and the other loop side
! to determine what the loopside should flow
! USE STATEMENTS:
USE DataPlant, ONLY: PlantLoop, CommonPipe_No, LoadRangeBasedMin, LoadRangeBasedMax, &
LoopFlowStatus_Unknown, LoopFlowStatus_NeedyAndTurnsLoopOn, &
LoopFlowStatus_NeedyIfLoopOn, LoopFlowStatus_TakesWhatGets, TotNumLoops, &
GenEquipTypes_Pump,TypeOf_PumpConstantSpeed,TypeOf_PumpBankConstantSpeed, &
SupplySide, CommonPipe_TwoWay, DemandSide, CommonPipe_Single,TypeOf_PumpVariableSpeed, &
TypeOf_PumpBankVariableSpeed,TypeOf_PumpBankConstantSpeed
USE DataBranchAirLoopPlant, ONLY: MassFlowTolerance
USE DataLoopNode, ONLY: Node
USE Pumps, ONLY: PumpEquip
USE PlantUtilities, ONLY: IntegerIsWithinTwoValues
USE DataHVACGlobals,ONLY: SmallLoad
IMPLICIT NONE ! Enforce explicit typing of all variables in this routine
! SUBROUTINE ARGUMENT DEFINITIONS:
INTEGER, INTENT(IN) :: LoopNum
INTEGER, INTENT(IN) :: ThisSide
INTEGER, INTENT(IN) :: OtherSide
REAL(r64), INTENT(IN OUT) :: LoopFlow ! Once all flow requests are evaluated, this is the desired flow on this side
! SUBROUTINE PARAMETER DEFINITIONS:
INTEGER, PARAMETER :: ThisSideFlowIndex = 1
INTEGER, PARAMETER :: OtherSideFlowIndex = 2
! SUBROUTINE LOCAL VARIABLE DECLARATIONS
INTEGER :: LoopCounter
INTEGER :: LoopSideCounter
INTEGER :: BranchCounter
INTEGER :: CompCounter
INTEGER :: CompIndex
INTEGER :: NumBranchesOnThisLoopSide
INTEGER :: NumCompsOnThisBranch
INTEGER :: NodeToCheckRequest
REAL(r64) :: ThisBranchFlowRequestNeedAndTurnOn
REAL(r64) :: ThisBranchFlowRequestNeedIfOn
REAL(r64) :: InletBranchRequestNeedAndTurnOn
REAL(r64) :: InletBranchRequestNeedIfOn
REAL(r64), DIMENSION(:), ALLOCATABLE, SAVE :: ParallelBranchRequestsNeedAndTurnOn
REAL(r64), DIMENSION(:), ALLOCATABLE, SAVE :: ParallelBranchRequestsNeedIfOn
REAL(r64), DIMENSION(:, :), ALLOCATABLE, SAVE :: LoadedConstantSpeedBranchFlowRateSteps
REAL(r64), DIMENSION(:, :), ALLOCATABLE, SAVE :: NoLoadConstantSpeedBranchFlowRateSteps
INTEGER :: ParallelBranchIndex
REAL(r64) :: OutletBranchRequestNeedAndTurnOn
REAL(r64) :: OutletBranchRequestNeedIfOn
LOGICAL :: ThisSideHasPumps
LOGICAL :: OtherSideHasPumps
LOGICAL :: ThisLoopHasCommonPipe
LOGICAL, DIMENSION(2) :: ThisLoopHasConstantSpeedBranchPumps
REAL(r64), DIMENSION(2) :: EachSideFlowRequestNeedAndTurnOn ! 2 for SupplySide/DemandSide
REAL(r64), DIMENSION(2) :: EachSideFlowRequestNeedIfOn ! 2 for SupplySide/DemandSide
REAL(r64), DIMENSION(2) :: EachSideFlowRequestFinal ! 2 for SupplySide/DemandSide
LOGICAL, SAVE :: AllocatedParallelArray = .FALSE.
INTEGER :: MaxParallelBranchCount
INTEGER :: FlowPriorityStatus
REAL(r64) :: tmpLoopFlow
REAL(r64) :: AccumFlowSteps
REAL(r64) :: MaxBranchPumpLoopSideFlow
!~ One time init for array allocated
IF (.NOT. AllocatedParallelArray) THEN
MaxParallelBranchCount = 0
DO LoopCounter = 1, TotNumLoops
DO LoopSideCounter = 1, 2
MaxParallelBranchCount = MAX(MaxParallelBranchCount, PlantLoop(LoopCounter)%LoopSide(LoopSideCounter)%TotalBranches-2)
END DO
END DO
ALLOCATE(ParallelBranchRequestsNeedAndTurnOn(MaxParallelBranchCount))
ALLOCATE(ParallelBranchRequestsNeedIfOn(MaxParallelBranchCount))
ALLOCATE(LoadedConstantSpeedBranchFlowRateSteps(2, MaxParallelBranchCount))
ALLOCATE(NoLoadConstantSpeedBranchFlowRateSteps(2, MaxParallelBranchCount))
AllocatedParallelArray = .TRUE.
END IF
!~ Initialize
LoopFlow = 0.0d0
ThisLoopHasConstantSpeedBranchPumps = .FALSE.
EachSideFlowRequestNeedAndTurnOn = 0.0d0
EachSideFlowRequestNeedIfOn = 0.0d0
EachSideFlowRequestFinal = 0.0d0
! AtLeastOneNonLRBRequested = .FALSE.
!~ First we need to set up the flow requests on each loopside
DO LoopSideCounter = DemandSide, SupplySide
! Clear things out for this loopside
InletBranchRequestNeedAndTurnOn = 0.0d0
InletBranchRequestNeedIfOn = 0.0d0
IF(AllocatedParallelArray) THEN
ParallelBranchRequestsNeedAndTurnOn = 0.0d0
ParallelBranchRequestsNeedIfOn = 0.0d0
ENDIF
OutletBranchRequestNeedAndTurnOn = 0.0d0
OutletBranchRequestNeedIfOn = 0.0d0
EachSideFlowRequestNeedAndTurnOn(LoopSideCounter) = 0.0d0
EachSideFlowRequestNeedIfOn(LoopSideCounter) = 0.0d0
! Now loop through all the branches on this loopside and get flow requests
NumBranchesOnThisLoopSide = PlantLoop(LoopNum)%LoopSide(LoopSideCounter)%TotalBranches
ParallelBranchIndex = 0
DO BranchCounter = 1, NumBranchesOnThisLoopSide
ThisBranchFlowRequestNeedAndTurnOn = 0.0d0
ThisBranchFlowRequestNeedIfOn = 0.0d0
IF(BranchCounter > 1 .AND. BranchCounter < NumBranchesOnThisLoopSide) ParallelBranchIndex = ParallelBranchIndex + 1
NumCompsOnThisBranch = PlantLoop(LoopNum)%LoopSide(LoopSideCounter)%Branch(BranchCounter)%TotalComponents
DO CompCounter = 1, NumCompsOnThisBranch
NodeToCheckRequest = PlantLoop(LoopNum)%LoopSide(LoopSideCounter)%Branch(BranchCounter)%Comp(CompCounter)%NodeNumIn
FlowPriorityStatus = PlantLoop(LoopNum)%LoopSide(LoopSideCounter)%Branch(BranchCounter)%Comp(CompCounter)%FlowPriority
IF (PlantLoop(LoopNum)%LoopSide(LoopSideCounter)%Branch(BranchCounter)%Comp(CompCounter)%GeneralEquipType &
/= GenEquipTypes_Pump) THEN
SELECT CASE (FlowPriorityStatus)
CASE (LoopFlowStatus_Unknown)
! do nothing
CASE (LoopFlowStatus_NeedyAndTurnsLoopOn)
ThisBranchFlowRequestNeedAndTurnOn = MAX(ThisBranchFlowRequestNeedAndTurnOn,&
Node(NodeToCheckRequest)%MassFlowRateRequest)
ThisBranchFlowRequestNeedIfOn = MAX(ThisBranchFlowRequestNeedIfOn, &
Node(NodeToCheckRequest)%MassFlowRateRequest)
CASE (LoopFlowStatus_NeedyIfLoopOn)
ThisBranchFlowRequestNeedIfOn = MAX(ThisBranchFlowRequestNeedIfOn, &
Node(NodeToCheckRequest)%MassFlowRateRequest)
CASE (LoopFlowStatus_TakesWhatGets)
! do nothing
END SELECT
ELSE ! handle pumps differently
IF ((BranchCounter == 1) .AND. (LoopSideCounter == SupplySide) &
.AND. (PlantLoop(LoopNum)%CommonPipeType == CommonPipe_TwoWay)) THEN
! special primary side flow request for two way common pipe
CompIndex = PlantLoop(LoopNum)%LoopSide(LoopSideCounter)%Branch(BranchCounter)%Comp(CompCounter)%CompNum
SELECT CASE (PlantLoop(LoopNum)%LoopSide(LoopSideCounter)%Branch(BranchCounter)%Comp(CompCounter)%TypeOf_Num)
! remove var speed pumps from this case statement if can set MassFlowRateRequest
CASE (TypeOf_PumpConstantSpeed,TypeOf_PumpVariableSpeed,TypeOf_PumpBankVariableSpeed)
IF (CompIndex > 0) THEN
!
ThisBranchFlowRequestNeedIfOn = MAX(ThisBranchFlowRequestNeedIfOn, PumpEquip(CompIndex)%MassFlowRateMax)
ENDIF
CASE (TypeOf_PumpBankConstantSpeed )
IF (CompIndex > 0) THEN
!
ThisBranchFlowRequestNeedIfOn = MAX(ThisBranchFlowRequestNeedIfOn, &
PumpEquip(CompIndex)%MassFlowRateMax/ PumpEquip(CompIndex)%NumPumpsInBank)
ENDIF
CASE DEFAULT
ThisBranchFlowRequestNeedIfOn = MAX(ThisBranchFlowRequestNeedIfOn, &
Node(NodeToCheckRequest)%MassFlowRateRequest)
END SELECT
ELSEIF ((BranchCounter == 1) .AND. (LoopSideCounter == SupplySide) &
.AND. (PlantLoop(LoopNum)%CommonPipeType == CommonPipe_Single)) THEN
CompIndex = PlantLoop(LoopNum)%LoopSide(LoopSideCounter)%Branch(BranchCounter)%Comp(CompCounter)%CompNum
SELECT CASE (PlantLoop(LoopNum)%LoopSide(LoopSideCounter)%Branch(BranchCounter)%Comp(CompCounter)%TypeOf_Num)
! remove var speed pumps from this case statement if can set MassFlowRateRequest
CASE (TypeOf_PumpConstantSpeed,TypeOf_PumpVariableSpeed,TypeOf_PumpBankVariableSpeed)
IF (CompIndex > 0) THEN
!
ThisBranchFlowRequestNeedIfOn = MAX(ThisBranchFlowRequestNeedIfOn, PumpEquip(CompIndex)%MassFlowRateMax)
ENDIF
CASE (TypeOf_PumpBankConstantSpeed )
IF (CompIndex > 0) THEN
!
ThisBranchFlowRequestNeedIfOn = MAX(ThisBranchFlowRequestNeedIfOn, &
PumpEquip(CompIndex)%MassFlowRateMax/ PumpEquip(CompIndex)%NumPumpsInBank)
ENDIF
CASE DEFAULT
ThisBranchFlowRequestNeedIfOn = MAX(ThisBranchFlowRequestNeedIfOn, &
Node(NodeToCheckRequest)%MassFlowRateRequest)
END SELECT
ELSE
CompIndex = PlantLoop(LoopNum)%LoopSide(LoopSideCounter)%Branch(BranchCounter)%Comp(CompCounter)%CompNum
SELECT CASE (PlantLoop(LoopNum)%LoopSide(LoopSideCounter)%Branch(BranchCounter)%Comp(CompCounter)%TypeOf_Num)
CASE (TypeOf_PumpConstantSpeed)
IF (CompIndex > 0) THEN
IF (ParallelBranchIndex >= 1) THEN ! branch pump
IF (ANY(ABS(PlantLoop(LoopNum)%LoopSide(LoopSideCounter)%Branch(BranchCounter)%Comp%MyLoad) > SmallLoad )) THEN
ThisBranchFlowRequestNeedIfOn = MAX(ThisBranchFlowRequestNeedIfOn, PumpEquip(CompIndex)%MassFlowRateMax)
ELSEIF (PlantLoop(LoopNum)%CommonPipeType /= CommonPipe_No) THEN ! common pipe and constant branch pumps
ThisBranchFlowRequestNeedIfOn = MAX(ThisBranchFlowRequestNeedIfOn, PumpEquip(CompIndex)%MassFlowRateMax)
ENDIF
ThisLoopHasConstantSpeedBranchPumps(LoopSideCounter) = .TRUE.
PlantLoop(LoopNum)%LoopSide(LoopSideCounter)%Branch(BranchCounter)%HasConstantSpeedBranchPump = .TRUE.
PlantLoop(LoopNum)%LoopSide(LoopSideCounter)%Branch(BranchCounter)%ConstantSpeedBranchMassFlow &
= PumpEquip(CompIndex)%MassFlowRateMax
ELSE ! inlet pump
ThisBranchFlowRequestNeedIfOn = MAX(ThisBranchFlowRequestNeedIfOn, PumpEquip(CompIndex)%MassFlowRateMax)
ENDIF
ENDIF
CASE (TypeOf_PumpBankConstantSpeed )
IF (CompIndex > 0) THEN
IF (ParallelBranchIndex >= 1) THEN ! branch pump
IF (ANY(ABS(PlantLoop(LoopNum)%LoopSide(LoopSideCounter)%Branch(BranchCounter)%Comp%MyLoad) > SmallLoad )) THEN
ThisBranchFlowRequestNeedIfOn = MAX(ThisBranchFlowRequestNeedIfOn, &
PumpEquip(CompIndex)%MassFlowRateMax/ PumpEquip(CompIndex)%NumPumpsInBank)
ELSEIF (PlantLoop(LoopNum)%CommonPipeType /= CommonPipe_No) THEN ! common pipe and constant branch pumps
ThisBranchFlowRequestNeedIfOn = MAX(ThisBranchFlowRequestNeedIfOn, &
PumpEquip(CompIndex)%MassFlowRateMax/ PumpEquip(CompIndex)%NumPumpsInBank)
ENDIF
ThisLoopHasConstantSpeedBranchPumps(LoopSideCounter) = .TRUE.
PlantLoop(LoopNum)%LoopSide(LoopSideCounter)%Branch(BranchCounter)%HasConstantSpeedBranchPump = .TRUE.
PlantLoop(LoopNum)%LoopSide(LoopSideCounter)%Branch(BranchCounter)%ConstantSpeedBranchMassFlow &
= PumpEquip(CompIndex)%MassFlowRateMax/ PumpEquip(CompIndex)%NumPumpsInBank
ELSE ! inlet pump
ThisBranchFlowRequestNeedIfOn = MAX(ThisBranchFlowRequestNeedIfOn, &
PumpEquip(CompIndex)%MassFlowRateMax/ PumpEquip(CompIndex)%NumPumpsInBank)
ENDIF
ENDIF
END SELECT
ENDIF
ENDIF
END DO
IF (BranchCounter == 1) THEN ! inlet branch
InletBranchRequestNeedAndTurnOn = ThisBranchFlowRequestNeedAndTurnOn
InletBranchRequestNeedIfOn = ThisBranchFlowRequestNeedIfOn
ELSE IF (BranchCounter < NumBranchesOnThisLoopSide) THEN ! branchcounter = 1 is already caught
ParallelBranchRequestsNeedAndTurnOn(ParallelBranchIndex) = ThisBranchFlowRequestNeedAndTurnOn
ParallelBranchRequestsNeedIfOn(ParallelBranchIndex) = ThisBranchFlowRequestNeedIfOn
ELSE IF (BranchCounter == NumBranchesOnThisLoopSide) THEN ! outlet branch
OutletBranchRequestNeedAndTurnOn = ThisBranchFlowRequestNeedAndTurnOn
OutletBranchRequestNeedIfOn = ThisBranchFlowRequestNeedIfOn
END IF
PlantLoop(LoopNum)%LoopSide(LoopSideCounter)%Branch(BranchCounter)%RequestedMassFlow = &
MAX(ThisBranchFlowRequestNeedIfOn, ThisBranchFlowRequestNeedAndTurnOn)
END DO
EachSideFlowRequestNeedAndTurnOn(LoopSideCounter) &
= MAX(InletBranchRequestNeedAndTurnOn, SUM(ParallelBranchRequestsNeedAndTurnOn), OutletBranchRequestNeedAndTurnOn)
EachSideFlowRequestNeedIfOn(LoopSideCounter) &
= MAX(InletBranchRequestNeedIfOn, SUM(ParallelBranchRequestsNeedIfOn), OutletBranchRequestNeedIfOn)
END DO
!~ Now that we have calculated each sides different status's requests, process to find final
IF (Sum(EachSideFlowRequestNeedAndTurnOn) < MassFlowTolerance ) THEN
EachSideFlowRequestFinal = 0.0d0
ELSE ! some flow is needed and loop should try to run
EachSideFlowRequestFinal(ThisSide) &
= MAX(EachSideFlowRequestNeedAndTurnOn(ThisSide), EachSideFlowRequestNeedIfOn(ThisSide) )
EachSideFlowRequestFinal(OtherSide) &
= MAX(EachSideFlowRequestNeedAndTurnOn(OtherSide), EachSideFlowRequestNeedIfOn(OtherSide) )
ENDIF
! now store final flow requests on each loop side data structure
PlantLoop(LoopNum)%LoopSide(ThisSide)%FlowRequest = EachSideFlowRequestFinal(ThisSide)
PlantLoop(LoopNum)%LoopSide(OtherSide)%FlowRequest = EachSideFlowRequestFinal(OtherSide)
IF (PlantLoop(LoopNum)%CommonPipeType == CommonPipe_No) THEN
!we may or may not have a pump on this side, but the flow request is the larger of the two side's final
IF (.NOT. ANY(ThisLoopHasConstantSpeedBranchPumps)) THEN
LoopFlow = MAXVAL(EachSideFlowRequestFinal)
ELSE ! account for stepped loop flow rates required of branch pumps
! rules for setting flow when there are constant speed branch pumps.
! 1. Check if above routines already selected a loop flow rate based on the constant speed branches, if so then just use it
IF ((ThisLoopHasConstantSpeedBranchPumps(ThisSide)) .AND. &
(EachSideFlowRequestFinal(ThisSide) >= EachSideFlowRequestFinal(OtherSide))) THEN
! okay, just use basic logic
LoopFlow = MAXVAL(EachSideFlowRequestFinal)
ELSEIF ((ThisLoopHasConstantSpeedBranchPumps(OtherSide)) .AND. &
(EachSideFlowRequestFinal(ThisSide) <= EachSideFlowRequestFinal(OtherSide))) THEN
! okay, just use basic logic
LoopFlow = MAXVAL(EachSideFlowRequestFinal)
ELSE ! not okay, we have a case that will likely need special correcting
! 2. determine which loop side has the stepped data
IF ((ThisLoopHasConstantSpeedBranchPumps(ThisSide)) .AND. &
(EachSideFlowRequestFinal(ThisSide) < EachSideFlowRequestFinal(OtherSide))) THEN
LoopSideCounter = ThisSide
ELSEIF ((ThisLoopHasConstantSpeedBranchPumps(OtherSide)) .AND. &
(EachSideFlowRequestFinal(OtherSide) < EachSideFlowRequestFinal(ThisSide))) THEN
LoopSideCounter = OtherSide
ENDIF
! 3. step through and find out needed information
! 3a. search the loop side with branch pumps and find the steps available with non-zero Myloads
! 3b. search the loop side with branch pumps and find the steps available with zero Myloads
LoadedConstantSpeedBranchFlowRateSteps = 0.d0
NoLoadConstantSpeedBranchFlowRateSteps = 0.d0
ParallelBranchIndex = 0
NumBranchesOnThisLoopSide = PlantLoop(LoopNum)%LoopSide(LoopSideCounter)%TotalBranches
DO BranchCounter = 1, NumBranchesOnThisLoopSide
IF(BranchCounter > 1 .AND. BranchCounter < NumBranchesOnThisLoopSide) ParallelBranchIndex = ParallelBranchIndex + 1
IF (PlantLoop(LoopNum)%LoopSide(LoopSideCounter)%Branch(BranchCounter)%HasConstantSpeedBranchPump) THEN
IF (ANY(ABS(PlantLoop(LoopNum)%LoopSide(LoopSideCounter)%Branch(BranchCounter)%Comp%MyLoad) > SmallLoad )) THEN
LoadedConstantSpeedBranchFlowRateSteps(LoopSideCounter, ParallelBranchIndex) = &
PlantLoop(LoopNum)%LoopSide(LoopSideCounter)%Branch(BranchCounter)%ConstantSpeedBranchMassFlow
ELSE
NoLoadConstantSpeedBranchFlowRateSteps(LoopSideCounter, ParallelBranchIndex) = &
PlantLoop(LoopNum)%LoopSide(LoopSideCounter)%Branch(BranchCounter)%ConstantSpeedBranchMassFlow
ENDIF
ENDIF
ENDDO
! 4. allocate which branches to use,
tmpLoopFlow = MAXVAL(EachSideFlowRequestFinal)
AccumFlowSteps = 0.d0
MaxBranchPumpLoopSideFlow = SUM(LoadedConstantSpeedBranchFlowRateSteps) + SUM(NoLoadConstantSpeedBranchFlowRateSteps)
tmpLoopFlow = MIN(tmpLoopFlow, MaxBranchPumpLoopSideFlow)
! 4b. first use all the branches with non-zero MyLoad
IF (tmpLoopFlow <= Sum(LoadedConstantSpeedBranchFlowRateSteps)) THEN
tmpLoopFlow = Sum(LoadedConstantSpeedBranchFlowRateSteps)
ELSE
AccumFlowSteps = Sum(LoadedConstantSpeedBranchFlowRateSteps)
ParallelBranchIndex = 0
DO BranchCounter = 1, NumBranchesOnThisLoopSide
IF(BranchCounter > 1 .AND. BranchCounter < NumBranchesOnThisLoopSide) THEN
ParallelBranchIndex = ParallelBranchIndex + 1
ELSE
CYCLE
ENDIF
IF (NoLoadConstantSpeedBranchFlowRateSteps(LoopSideCounter, ParallelBranchIndex) > 0.d0) THEN
! add in branches with zero MyLoad in branch input order until satisfied
IF ((tmpLoopFlow > AccumFlowSteps) .AND. (tmpLoopFlow <= (AccumFlowSteps + &
NoLoadConstantSpeedBranchFlowRateSteps(LoopSideCounter, ParallelBranchIndex)))) THEN
!found it set requests and exit
tmpLoopFlow = AccumFlowSteps + NoLoadConstantSpeedBranchFlowRateSteps(LoopSideCounter, ParallelBranchIndex)
PlantLoop(LoopNum)%LoopSide(LoopSideCounter)%Branch(BranchCounter)%RequestedMassFlow &
= NoLoadConstantSpeedBranchFlowRateSteps(LoopSideCounter, ParallelBranchIndex)
LoopFlow = tmpLoopFlow
EXIT
ELSEIF ((tmpLoopFlow > AccumFlowSteps) .AND. (tmpLoopFlow > (AccumFlowSteps + &
NoLoadConstantSpeedBranchFlowRateSteps(LoopSideCounter, ParallelBranchIndex)))) THEN
AccumFlowSteps = AccumFlowSteps + NoLoadConstantSpeedBranchFlowRateSteps(LoopSideCounter, ParallelBranchIndex)
PlantLoop(LoopNum)%LoopSide(LoopSideCounter)%Branch(BranchCounter)%RequestedMassFlow &
= NoLoadConstantSpeedBranchFlowRateSteps(LoopSideCounter, ParallelBranchIndex)
ENDIF
ENDIF
ENDDO
ENDIF
ENDIF
ENDIF
ThisLoopHasCommonPipe = .FALSE.
ELSEIF (PlantLoop(LoopNum)%CommonPipeType == CommonPipe_TwoWay) THEN
LoopFlow=EachSideFlowRequestFinal(ThisSide)
ThisLoopHasCommonPipe = .TRUE.
ELSEIF (PlantLoop(LoopNum)%CommonPipeType == CommonPipe_Single) THEN
LoopFlow=EachSideFlowRequestFinal(ThisSide)
ThisLoopHasCommonPipe = .TRUE.
ENDIF
! do some diagnostic that are easy and fast at this point, the rest of this routine could be moved
!? should be caught previously in input~ Check erroneous conditions first before we do the logic below
!~ Check loop configuration, as this will dictate the flow that we request for our loop side
IF ( PlantLoop(LoopNum)%LoopSide(ThisSide)%TotalPumps > 0) THEN
ThisSideHasPumps = .TRUE.
ELSE
ThisSideHasPumps = .FALSE.
ENDIF
IF (PlantLoop(LoopNum)%LoopSide(OtherSide)%TotalPumps > 0) THEN
OtherSideHasPumps = .TRUE.
ELSE
OtherSideHasPumps = .FALSE.
ENDIF
IF (ThisLoopHasCommonPipe .AND. .NOT. ThisSideHasPumps) THEN
CALL ShowSevereError('SetupLoopFlowRequest: Common Pipe must have pumps on both sides of loop')
CALL ShowContinueError('Occurs on plant loop name ="'//trim(PlantLoop(LoopNum)%Name)//'"')
IF (ThisSide == DemandSide) THEN
CALL ShowContinueError('Add a pump to the demand side of the plant loop')
ELSEIF (ThisSide == SupplySide) THEN
CALL ShowContinueError('Add a pump to the supply side of the plant loop')
ENDIF
CALL ShowFatalError('Program terminates due to preceding conditions.')
ELSE IF (.NOT. ThisSideHasPumps .AND. .NOT. OtherSideHasPumps) THEN
CALL ShowSevereError('SetupLoopFlowRequest: Problem in plant topology, no pumps specified on the loop')
CALL ShowContinueError('Occurs on plant loop name ="'//trim(PlantLoop(LoopNum)%Name)//'"')
CALL ShowContinueError('All plant loops require at least one pump')
CALL ShowFatalError('Program terminates due to preceding conditions.')
END IF
RETURN
END SUBROUTINE SetupLoopFlowRequest