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 | ||
---|---|---|---|---|---|---|
logical, | intent(in) | :: | FirstHVACIteration | |||
integer, | intent(in) | :: | LoopSideNum | |||
integer, | intent(in) | :: | LoopNum | |||
logical, | intent(inout) | :: | ReSimOtherSideNeeded |
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 PlantHalfLoopSolver(FirstHVACIteration, LoopSideNum, LoopNum, ReSimOtherSideNeeded)
! SUBROUTINE INFORMATION:
! AUTHORS: Dan Fisher, Sankaranarayanan K P, Edwin Lee
! DATE WRITTEN: April 1998
! MODIFIED June 2005(Work in the Plant Super Manager Module)
! July 2006
! RE-ENGINEERED July 2010
! PURPOSE OF THIS SUBROUTINE:
! SimSupplyFlowSolution is the driver routine for plant loops. It performs
! the following tasks for each half loop (supply or demand side):
! 1. Calculate flow request for half loop
! 2. Predict Loop Flow
! 3. Simulate the inlet branch
! 4. Simulate the parallel branches, distributing load if necessary
! 5. Set flow rates on parallel branches
! 6. Simulate outlet branch and update node and report variables
! METHODOLOGY EMPLOYED:
! The algorithm operates on a predictor/corrector flow setting method by simulating all available loop components
! based on component requested flow rates, then enforcing continuity on all loop branch flows by calling
! the flow resolver and locking those flows down. Available components are then re-simulated using the
! corrected flow rates.
! USE STATEMENTS:
USE HVACInterfaceManager, ONLY: UpdatePlantLoopInterface
USE PlantCondLoopOperation, ONLY: InitLoadDistribution
USE PlantPressureSystem, ONLY: SimPressureDropSystem
USE DataPlant, ONLY: DemandSide, SupplySide, TotNumLoops, FlowPumpQuery, &
FlowUnlocked, FlowLocked, PressureCall_Update, PlantLoop, PressureCall_Init
USE General, ONLY: RoundSigDigits
USE DataLoopNode, ONLY: Node
USE DataGlobals, ONLY: BeginTimeStepFlag
USE PlantUtilities, ONLY: BoundValueToWithinTwoValues, BoundValueToNodeMinMaxAvail, TightenNodeMinMaxAvails
IMPLICIT NONE ! Enforce explicit typing of all variables in this routine
! SUBROUTINE ARGUMENT DEFINITIONS:
INTEGER, INTENT(IN) :: LoopNum
INTEGER, INTENT(IN) :: LoopSideNum
LOGICAL, INTENT(IN) :: FirstHVACIteration ! TRUE if First HVAC iteration of Time step
LOGICAL, INTENT(IN OUT) :: ReSimOtherSideNeeded
! SUBROUTINE LOCAL VARIABLE DECLARATIONS:
!~ Topology variables
INTEGER :: ThisSideInletNode ! Plant loop side loop inlet
INTEGER :: ThisSide
INTEGER :: OtherSide
!~ Initialization and validation flags
TYPE(m_FlowControlValidator) :: IsLoopSideValid
!~ Flags
LOGICAL :: LoopShutDownFlag
!~ Other variables
REAL(r64) :: ThisLoopSideFlow
REAL(r64) :: TotalPumpMaxAvailFlow
REAL(r64) :: TotalPumpMinAvailFlow
! Initialize variables
InitialDemandToLoopSetPoint = 0.0d0
CurrentAlterationsToDemand = 0.0d0
UpdatedDemandToLoopSetPoint = 0.0d0
ThisSide = LoopSideNum
OtherSide = 3 - ThisSide !will give us 1 if thisside is 2, or 2 if thisside is 1
LoopShutDownFlag = .FALSE.
ThisSideInletNode = PlantLoop(LoopNum)%LoopSide(ThisSide)%NodeNumIn
! The following block is related to validating the flow control paths of the loop side
! Since the control types are scheduled, I think BeginTimeStep should be a decent check frequency
IF (BeginTimeStepFlag .AND. PlantLoop(LoopNum)%LoopSide(ThisSide)%OncePerTimeStepOperations) THEN
! Initialize loop side controls -- could just be done for one loop since this routine inherently
! loops over all plant/condenser loops. Not sure if the penalty is worth investigating.
CALL InitLoadDistribution(FirstHVACIteration)
! Now that the op scheme types are updated, do loopside validation
IsLoopSideValid = ValidateFlowControlPaths(LoopNum, ThisSide)
IF (.NOT. IsLoopSideValid%Valid) THEN
CALL ShowFatalError('ERROR:'//IsLoopSideValid%Reason)
END IF
! Set the flag to false so we won't do these again this time step
PlantLoop(LoopNum)%LoopSide(ThisSide)%OncePerTimeStepOperations = .FALSE.
ELSE
! Set the flag to true so that it is activated for the next time step
PlantLoop(LoopNum)%LoopSide(ThisSide)%OncePerTimeStepOperations = .TRUE.
END IF
! Do pressure system initialize if this is the demand side (therefore once per whole loop)
IF (ThisSide == DemandSide) CALL SimPressureDropSystem(LoopNum, FirstHVACIteration, PressureCall_Init)
! First thing is to setup mass flow request information
CALL SetupLoopFlowRequest(LoopNum, ThisSide, OtherSide, ThisLoopSideFlow)
! Now we know what the loop would "like" to run at, let's see the pump
! operation range (min/max avail) to see whether it is possible this time around
IF (ALLOCATED(PlantLoop(LoopNum)%LoopSide(ThisSide)%Pumps)) THEN
!~ Initialize pump values
PlantLoop(LoopNum)%LoopSide(ThisSide)%Pumps%CurrentMinAvail = 0.0d0
PlantLoop(LoopNum)%LoopSide(ThisSide)%Pumps%CurrentMaxAvail = 0.0d0
PlantLoop(LoopNum)%LoopSide(ThisSide)%FlowLock = FlowPumpQuery
!~ Simulate pumps
CALL SimulateAllLoopSidePumps(LoopNum, ThisSide)
!~ Calculate totals
TotalPumpMinAvailFlow = SUM(PlantLoop(LoopNum)%LoopSide(ThisSide)%Pumps%CurrentMinAvail)
TotalPumpMaxAvailFlow = SUM(PlantLoop(LoopNum)%LoopSide(ThisSide)%Pumps%CurrentMaxAvail)
! Use the pump min/max avail to attempt to constrain the loop side flow
ThisLoopSideFlow = BoundValueToWithinTwoValues(ThisLoopSideFlow, TotalPumpMinAvailFlow, TotalPumpMaxAvailFlow)
END IF
! Now we check flow restriction from the other side, both min and max avail.
! Doing this last basically means it wins, so the pump should pull down to meet the flow restriction
ThisLoopSideFlow = BoundValueToNodeMinMaxAvail(ThisLoopSideFlow, ThisSideInletNode)
! Final preparation of loop inlet min/max avail if pumps exist
IF (ALLOCATED(PlantLoop(LoopNum)%LoopSide(ThisSide)%Pumps)) THEN
! At this point, the pump limits should have been obeyed unless a flow restriction was encountered from the other side
! The pump may, however, have even tighter constraints than the other side
! At this point, the inlet node doesn't know anything about those limits
! Since we have already honored the other side flow restriction, try to honor the pump limits here
CALL TightenNodeMinMaxAvails(ThisSideInletNode, TotalPumpMinAvailFlow, TotalPumpMaxAvailFlow)
END IF
! Now reset the entering mass flow rate to the decided-upon flow rate
Node(ThisSideInletNode)%MassFlowRate = ThisLoopSideFlow
! We also need to establish a baseline "other-side-based" loop demand based on this possible flow rate
InitialDemandToLoopSetPoint = CalcOtherSideDemand(LoopNum, ThisSide)
UpdatedDemandToLoopSetPoint = InitialDemandToLoopSetPoint
LoadToLoopSetPointThatWasntMet = 0.0d0
! We now have a loop side flow request, along with inlet min/max avails.
! We can now make a first pass through the component simulation, requesting flow as necessary.
! Normal "supply side" components will set a mass flow rate on their outlet node to request flow,
! while "Demand side" components will set a a mass flow request on their inlet node to request flow.
PlantLoop(LoopNum)%LoopSide(ThisSide)%FlowLock = FlowUnlocked
CALL SimulateAllLoopSideBranches(LoopNum, ThisSide, ThisLoopSideFlow, FirstHVACIteration, LoopShutDownFlag)
! DSU? discussion/comments about loop solver/flow resolver interaction
! At this point, the components have been simulated. They should have either:
! - logged a massflowrequest
! - or logged a massflowrate
! We need to decide what the components are going to do on FlowLock=0.
! If we want all control here at the solver level, the components just need to
! log their massflowrate on their outlet nodes, or some other mechanism.
! Then the loop solver can scan the branch and get the max, and this will be the requested
! flow rate for the branch.
! The loop solver will then set this as the branch outlet mass flow rate in preparation
! for the flow resolver.
! The loop solver may need to do something to the inlet/outlet branch, but I'm not sure yet.
! The following comment block is what I had already thought of, and it may still make sense.
! Now that all the flow requests have been logged, we need to prepare them for the
! flow resolver. This will just take the requests and determine the desired flow
! request for that branch according to pump placement, pump type, and other component
! conditions. In many cases, this will just be to simply take the max request from
! the branch, which will already be within pumping limits for that flow path.
! We can then call the flow resolver to lock down branch inlet flow rates.
!DSU?
! The flow resolver takes information such as requested flows and min/max available flows and
! sets the corrected flow on the inlet to each parallel branch
CALL ResolveParallelFlows(LoopNum, ThisSide, ThisLoopSideFlow, FirstHVACIteration)
! CALL PropagateResolvedFlow(LoopNum, ThisSide)
! Re-Initialize variables for this next pass
InitialDemandToLoopSetPointSAVED = InitialDemandToLoopSetPoint
CurrentAlterationsToDemand = 0.0d0
UpdatedDemandToLoopSetPoint = InitialDemandToLoopSetPoint
! Now that flow rates have been resolved, we just need to set the flow lock status
! flag, and resimulate. During this simulation each component will still use the
! SetFlowRequest routine, but this routine will also set the outlet flow rate
! equal to the inlet flow rate, accoridng to flowlock logic.
PlantLoop(LoopNum)%LoopSide(ThisSide)%FlowLock = FlowLocked
CALL SimulateAllLoopSideBranches(LoopNum, ThisSide, ThisLoopSideFlow, FirstHVACIteration, LoopShutDownFlag)
! A couple things are specific to which loopside we are on
IF (LoopSideNum==DemandSide) THEN
! Pass the loop information via the HVAC interface manager
CALL UpdatePlantLoopInterface(LoopNum, LoopSideNum,PlantLoop(LoopNum)%LoopSide(DemandSide)%NodeNumOut, &
PlantLoop(LoopNum)%LoopSide(SupplySide)%NodeNumIn, &
ReSimOtherSideNeeded,PlantLoop(LoopNum)%CommonPipeType)
ELSE !LoopSide == SupplySide
! Update pressure drop reporting, calculate total loop pressure drop for use elsewhere
CALL SimPressureDropSystem(LoopNum, FirstHVACIteration, PressureCall_Update)
! Pass the loop information via the HVAC interface manager (only the flow)
CALL UpdatePlantLoopInterface(LoopNum, LoopSideNum, PlantLoop(LoopNum)%LoopSide(SupplySide)%NodeNumOut, &
PlantLoop(LoopNum)%LoopSide(DemandSide)%NodeNumIn, ReSimOtherSideNeeded, &
PlantLoop(LoopNum)%CommonPipeType)
! Update the loop outlet node conditions
CALL CheckLoopExitNode(LoopNum, FirstHVACIteration)
END IF
! Update some reporting information at Plant half loop level
CALL UpdateLoopSideReportVars(LoopNum, LoopSideNum, InitialDemandToLoopSetPointSAVED, LoadToLoopSetPointThatWasntMet)
RETURN
END SUBROUTINE PlantHalfLoopSolver