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 | :: | LoopNum | ||||
integer | :: | LoopSideNum | ||||
integer | :: | FirstBranchNum | ||||
integer | :: | LastBranchNum | ||||
integer, | DIMENSION(:) | :: | LastComponentSimulated |
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.
FUNCTION EvaluateLoopSetPointLoad(LoopNum, LoopSideNum, FirstBranchNum, LastBranchNum, LastComponentSimulated) &
RESULT (LoadToLoopSetPoint)
! FUNCTION INFORMATION:
! AUTHOR Edwin Lee
! DATE WRITTEN August 2010
! MODIFIED na
! RE-ENGINEERED na
! PURPOSE OF THIS FUNCTION:
! <description>
! METHODOLOGY EMPLOYED:
! <description>
! USE STATEMENTS:
USE DataPlant, ONLY: PlantLoop, LoopDemandTol, SingleSetPoint, DualSetPointDeadBand
USE DataBranchAirLoopPlant, ONLY: MassFlowTolerance
USE DataLoopNode, ONLY: Node, NodeType_Water, NodeType_Steam
USE FluidProperties, ONLY: GetSpecificHeatGlycol, GetSatEnthalpyRefrig
USE General, ONLY: RoundSigDigits
IMPLICIT NONE ! Enforce explicit typing of all variables in this routine
! FUNCTION ARGUMENT DEFINITIONS:
INTEGER :: LoopNum
INTEGER :: LoopSideNum
INTEGER :: FirstBranchNum
INTEGER :: LastBranchNum
INTEGER, DIMENSION(:) :: LastComponentSimulated
REAL(r64) :: LoadToLoopSetPoint !function result
! FUNCTION LOCAL VARIABLE DECLARATIONS:
!~ Indexing variables
INTEGER :: BranchCounter !~ This contains the index for the %Branch(:) structure
INTEGER :: BranchIndex !~ This is a 1 - n value within the current branch group
INTEGER :: StartingComponent !~ The component which "would" be simulated next
!~ General variables
REAL(r64) :: EnteringTemperature
REAL(r64) :: MassFlowRate
REAL(r64) :: SumMdotTimesTemp
REAL(r64) :: SumMdot
REAL(r64) :: WeightedInletTemp
REAL(r64) :: LoopSetPointTemperature
REAL(r64) :: LoopSetPointTemperatureHi
REAL(r64) :: LoopSetPointTemperatureLo
REAL(r64) :: LoadtoHeatingSetPoint
REAL(r64) :: LoadtoCoolingSetPoint
REAL(r64) :: DeltaTemp
INTEGER :: EnteringNodeNum
REAL(r64) :: Cp
REAL(r64) :: EnthalpySteamSatVapor ! Enthalpy of saturated vapor
REAL(r64) :: EnthalpySteamSatLiquid ! Enthalpy of saturated liquid
REAL(r64) :: LatentHeatSteam ! Latent heat of steam
! Initialize
LoadToLoopSetPoint = 0.0d0
! Sweep across flow paths in this group and calculate the deltaT and then the load
BranchIndex = 0
SumMdotTimesTemp = 0.d0
SumMdot = 0.d0
DO BranchCounter = FirstBranchNum, LastBranchNum
BranchIndex = BranchIndex + 1
!~ Always start from the last component we did the last time around + 1 and
!~ try to make it all the way to the end of the loop
StartingComponent = LastComponentSimulated(BranchIndex) + 1
EnteringNodeNum = PlantLoop(LoopNum)%LoopSide(LoopSideNum)%Branch(BranchCounter)%Comp(StartingComponent)%NodeNumIn
EnteringTemperature = Node(EnteringNodeNum)%Temp
MassFlowRate = Node(EnteringNodeNum)%MassFlowRate
SumMdotTimesTemp = SumMdotTimesTemp + (EnteringTemperature * MassFlowRate)
SumMdot = SumMdot + (MassFlowRate)
END DO
IF ( SumMdot .LT. MassFlowTolerance ) THEN
LoadToLoopSetPoint = 0.0d0
RETURN
END IF
WeightedInletTemp = SumMdotTimesTemp / SumMdot
IF (PlantLoop(LoopNum)%FluidType==NodeType_Water) THEN
Cp = GetSpecificHeatGlycol(PlantLoop(LoopNum)%FluidName, WeightedInletTemp, &
PlantLoop(LoopNum)%FluidIndex, 'PlantLoopSolver::EvaluateLoopSetPointLoad')
SELECT CASE (PlantLoop(LoopNum)%LoopDemandCalcScheme)
CASE (SingleSetPoint)
! Pick up the loop setpoint temperature
LoopSetPointTemperature = PlantLoop(LoopNum)%LoopSide(LoopSideNum)%TempSetPoint
! Calculate the delta temperature
DeltaTemp = LoopSetPointTemperature - WeightedInletTemp
! Calculate the demand on the loop
LoadToLoopSetPoint = SumMdot * Cp * DeltaTemp
CASE (DualSetPointDeadBand)
! Get the range of setpoints
LoopSetPointTemperatureHi = Node(PlantLoop(LoopNum)%TempSetPointNodeNum)%TempSetpointHi
LoopSetPointTemperatureLo = Node(PlantLoop(LoopNum)%TempSetPointNodeNum)%TempSetpointLo
!Calculate the demand on the loop
IF (SumMdot > 0.0d0) THEN
LoadtoHeatingSetPoint = SumMdot*Cp*(LoopSetPointTemperatureLo - WeightedInletTemp)
LoadtoCoolingSetPoint = SumMdot*Cp*(LoopSetPointTemperatureHi - WeightedInletTemp)
! Possible combinations:
! 1 LoadToHeatingSetPoint > 0 & LoadToCoolingSetPoint > 0 --> Heating required
! 2 LoadToHeatingSetPoint < 0 & LoadToCoolingSetPoint < 0 --> Cooling Required
! 3 LoadToHeatingSetPoint <=0 & LoadToCoolingSetPoint >=0 --> Dead Band Operation - includes zero load cases
! 4 LoadToHeatingSetPoint > LoadToCoolingSetPoint --> Not Feasible if LoopSetPointHi >= LoopSetPointLo
! First trap bad set-points
IF (LoadToHeatingSetPoint .GT. LoadToCoolingSetPoint ) THEN
CALL ShowSevereError('Plant Loop: the Plant Loop Demand Calculation Scheme is set to DualSetPointDeadBand, '// &
'but the heating-related low setpoint appears to be above the cooling-related high setpoint.')
CALL ShowContinueError('For example, if using SetpointManager:Scheduled:DualSetpoint, then check that the' // &
' low setpoint is below the high setpoint.')
CALL ShowContinueError('Occurs in PlantLoop='//TRIM(PlantLoop(LoopNum)%Name))
CALL ShowContinueError('LoadToHeatingSetPoint='//TRIM(RoundSigDigits(LoadToHeatingSetPoint,3))// &
', LoadToCoolingSetPoint='//TRIM(RoundSigDigits(LoadToCoolingSetPoint,3)))
CALL ShowContinueError('Loop Heating Low Setpoint='//TRIM(RoundSigDigits(LoopSetPointTemperatureLo,2)))
CALL ShowContinueError('Loop Cooling High Setpoint='//TRIM(RoundSigDigits(LoopSetPointTemperatureHi,2)))
CALL ShowFatalError('Program terminates due to above conditions.')
END IF
IF (LoadToHeatingSetPoint .GT. 0.0d0 .AND. LoadToCoolingSetPoint .GT. 0.0d0) THEN
LoadToLoopSetPoint = LoadToHeatingSetPoint
ELSE IF (LoadToHeatingSetPoint .LT. 0.0d0 .AND. LoadToCoolingSetPoint .LT. 0.0d0) THEN
LoadToLoopSetPoint = LoadToCoolingSetPoint
ELSE IF (LoadToHeatingSetPoint .LE. 0.0d0 .AND. LoadToCoolingSetPoint .GE. 0.0d0) THEN ! deadband includes zero loads
LoadToLoopSetPoint = 0.0d0
ELSE
CALL ShowSevereError('DualSetPointWithDeadBand: Unanticipated combination of heating and cooling loads - '// &
'report to EnergyPlus Development Team')
CALL ShowContinueError('occurs in PlantLoop='//TRIM(PlantLoop(LoopNum)%Name))
CALL ShowContinueError('LoadToHeatingSetPoint='//TRIM(RoundSigDigits(LoadToHeatingSetPoint,3))// &
', LoadToCoolingSetPoint='//TRIM(RoundSigDigits(LoadToCoolingSetPoint,3)))
CALL ShowContinueError('Loop Heating Setpoint='//TRIM(RoundSigDigits(LoopSetPointTemperatureLo,2)))
CALL ShowContinueError('Loop Cooling Setpoint='//TRIM(RoundSigDigits(LoopSetPointTemperatureHi,2)))
CALL ShowFatalError('Program terminates due to above conditions.')
END IF
ELSE
LoadToLoopSetPoint = 0.0d0
END IF
END SELECT
ELSEIF (PlantLoop(LoopNum)%FluidType==NodeType_Steam) THEN
Cp = GetSpecificHeatGlycol(PlantLoop(LoopNum)%FluidName, WeightedInletTemp, &
PlantLoop(LoopNum)%FluidIndex, 'PlantLoopSolver::EvaluateLoopSetPointLoad')
SELECT CASE (PlantLoop(LoopNum)%LoopDemandCalcScheme)
CASE (SingleSetPoint)
! Pick up the loop setpoint temperature
LoopSetPointTemperature = PlantLoop(LoopNum)%LoopSide(LoopSideNum)%TempSetPoint
! Calculate the delta temperature
DeltaTemp = LoopSetPointTemperature - WeightedInletTemp
EnthalpySteamSatVapor = GetSatEnthalpyRefrig('STEAM',LoopSetPointTemperature,1.0d0,RefrigIndex, &
'PlantSupplySide:EvaluateLoopSetPointLoad')
EnthalpySteamSatLiquid = GetSatEnthalpyRefrig('STEAM',LoopSetPointTemperature,0.0d0,RefrigIndex, &
'PlantSupplySide:EvaluateLoopSetPointLoad')
LatentHeatSteam = EnthalpySteamSatVapor - EnthalpySteamSatLiquid
! Calculate the demand on the loop
LoadToLoopSetPoint = SumMdot * ( Cp * DeltaTemp + LatentHeatSteam )
END SELECT
ELSE ! only have two types, water serves for glycol.
END IF
! Trim the demand to zero if it is very small
IF(ABS(LoadToLoopSetPoint) < LoopDemandTol) LoadToLoopSetPoint = 0.0d0
RETURN
END FUNCTION EvaluateLoopSetPointLoad