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) | :: | SetPtMgrNum |
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 CalcIdealCondEntSetPoint(SetPtMgrNum)
! SUBROUTINE INFORMATION:
! AUTHOR Heejin Cho, PNNL
! DATE WRITTEN March 2012
! MODIFIED na
! RE-ENGINEERED na
! PURPOSE OF THIS SUBROUTINE:
! Calculate the optimal condenser water entering temperature set point for a chiller plant.
! METHODOLOGY EMPLOYED:
! The "ideal" chiller-tower optimization scheme uses a search algorithm to find the ideal optimal setpoint
! at a given timestep. This requires resimulating HVAC systems at each timestep until finding
! an "optimal" condenser water entering setpoint (OptSetpoint) which gives the minimum total chiller,
! cooling tower, chilled water pump and condenser water pump power consumption.
! The OptSetpoint falls between realistic minimum and maximum boundaries, which are set by the user.
! The minimum boundary is determined based on the minimum lift (user input)
! and evaporator leaving water temperature. The maximum boundary is specified by the user.
! It is assumed that a single minimum point exists between these boundaries.
! REFERENCES:
! na
! USE STATEMENTS:
USE DataPlant
USE DataLoopNode, ONLY: Node
IMPLICIT NONE ! Enforce explicit typing of all variables in this routine
! SUBROUTINE ARGUMENT DEFINITIONS:
INTEGER, INTENT (IN) :: SetPtMgrNum !number of the current set point manager being simulated
! SUBROUTINE PARAMETER DEFINITIONS:
! INTERFACE BLOCK SPECIFICATIONS
! DERIVED TYPE DEFINITIONS
! na
! SUBROUTINE LOCAL VARIABLE DECLARATIONS:
REAL(r64) :: CondWaterSetpoint = 0.0d0 ! Condenser entering water temperature setpoint this timestep, C
REAL(r64) :: InitCondWaterSetpoint = 0.0d0 ! Initial condenser entering water temperature setpoint this timestep, C
REAL(r64) :: EvapOutletTemp = 0.0d0 ! Evaporator water outlet temperature (C)
REAL(r64) :: CondTempLimit = 0.0d0 ! Condenser entering water temperature setpoint lower limit
REAL(r64) :: CurLoad = 0.0d0 ! Current cooling load, W
REAL(r64) :: MinLiftTD = 0.0d0 ! Minimum lift (Tcond entering - Tevap leaving) TD this timestep
INTEGER :: ChillerTypeNum = 0 ! Chiller type number
INTEGER :: ChillerLoopNum = 0 ! Chiller loop number
INTEGER :: ChillerBranchNum = 0 ! Chiller branch number
INTEGER :: ChillerNum = 0 ! Chiller number
INTEGER :: TowerLoopNum = 0 ! Tower loop number
INTEGER :: CondLoopNum = 0 ! Condenser loop number
INTEGER :: TowerBranchNum = 0 ! Tower branch number
INTEGER :: TowerNum = 0 ! Tower number
INTEGER :: ChilledPumpBranchNum = 0 ! Chilled water pump branch number
INTEGER :: ChilledPumpNum = 0 ! Chilled water pump number
INTEGER :: CondPumpBranchNum = 0 ! Condenser water pump branch number
INTEGER :: CondPumpNum = 0 ! Condenser pump number
! INTEGER :: VarNum = 0 ! Metered variable number
! INTEGER :: VarType = 0 ! Metered variable type number
! INTEGER :: VarIndex = 0 ! Metered variable index
REAL(r64) :: DeltaTotEnergy = 0.0d0 ! Difference between total energy consumptions at this time step
! and at the previous time step
REAL(r64) :: ChillerEnergy = 0.0d0 ! Chiller energy consumption
REAL(r64) :: ChilledPumpEnergy = 0.0d0 ! Chilled water pump energy consumption
REAL(r64) :: TowerFanEnergy = 0.0d0 ! Colling tower fan energy consumption
REAL(r64) :: CondPumpEnergy = 0.0d0 ! Condenser water pump energy consumption
REAL(r64) :: TotEnergy = 0.0d0 ! Totoal energy consumptions at this time step
REAL(r64) :: TotEnergyPre = 0.0d0 ! Totoal energy consumptions at the previous time step
LOGICAL :: RunSubOptCondEntTemp =.FALSE.
LOGICAL :: RunFinalOptCondEntTemp =.FALSE.
LOGICAL :: FirstTime =.true.
LOGICAL, SAVE, DIMENSION(:), ALLOCATABLE :: SetupIdealCondEntSetPtVars
!! Current timestep's condenser water entering setpoint
IF (FirstTime) THEN
ALLOCATE(SetupIdealCondEntSetPtVars(NumIdealCondEntSetPtMgrs))
SetupIdealCondEntSetPtVars=.true.
FirstTime=.false.
ENDIF
InitCondWaterSetpoint = IdealCondEntSetPtMgr(SetPtMgrNum)%MaxCondEntTemp
MinLiftTD = IdealCondEntSetPtMgr(SetPtMgrNum)%MinimumLiftTD
ChillerTypeNum = IdealCondEntSetPtMgr(SetPtMgrNum)%TypeNum
ChillerLoopNum = IdealCondEntSetPtMgr(SetPtMgrNum)%LoopIndexPlantSide
ChillerBranchNum = IdealCondEntSetPtMgr(SetPtMgrNum)%BranchIndexPlantSide
ChillerNum = IdealCondEntSetPtMgr(SetPtMgrNum)%ChillerIndexPlantSide
TowerLoopNum = IdealCondEntSetPtMgr(SetPtMgrNum)%CondLoopNum
CondLoopNum = IdealCondEntSetPtMgr(SetPtMgrNum)%CondLoopNum
TowerBranchNum = IdealCondEntSetPtMgr(SetPtMgrNum)%CondBranchNum
TowerNum = IdealCondEntSetPtMgr(SetPtMgrNum)%TowerNum
ChilledPumpBranchNum = IdealCondEntSetPtMgr(SetPtMgrNum)%ChilledPumpBranchNum
ChilledPumpNum = IdealCondEntSetPtMgr(SetPtMgrNum)%ChilledPumpNum
CondPumpBranchNum = IdealCondEntSetPtMgr(SetPtMgrNum)%CondPumpBranchNum
CondPumpNum = IdealCondEntSetPtMgr(SetPtMgrNum)%CondPumpNum
IF (MetersHaveBeenInitialized) THEN
! Setup meter vars
IF (SetupIdealCondEntSetPtVars(SetPtMgrNum)) THEN
CALL SetupMeteredVarsForSetPt(SetPtMgrNum)
SetupIdealCondEntSetPtVars(SetPtMgrNum)=.false.
ENDIF
ENDIF
IF (MetersHaveBeenInitialized .and. RunOptCondEntTemp) THEN
! If chiller is on
CurLoad = ABS(PlantLoop(ChillerLoopNum)%LoopSide(SupplySide)%Branch(ChillerBranchNum)%Comp(ChillerNum)%MyLoad)
IF (CurLoad > 0) THEN
! Calculate the minimum condenser inlet temperature boundry for set point
IF (ChillerTypeNum == TypeOf_Chiller_Absorption .or. ChillerTypeNum == TypeOf_Chiller_CombTurbine .or. &
ChillerTypeNum == TypeOf_Chiller_Electric .or. ChillerTypeNum == TypeOf_Chiller_ElectricReformEIR .or. &
ChillerTypeNum == TypeOf_Chiller_EngineDriven) THEN
EvapOutletTemp = Node(PlantLoop(ChillerLoopNum)%LoopSide(SupplySide)%Branch(ChillerBranchNum)% &
Comp(ChillerNum)%NodeNumOut)%temp
ELSE
EvapOutletTemp = 6.666d0
END IF
CondTempLimit = MinLiftTD + EvapOutletTemp
! Energy consumption metered variable number = 1
! Get the chiller energy consumption
ChillerEnergy = GetInternalVariableValue(IdealCondEntSetPtMgr(SetPtMgrNum)%ChllrVarType, &
IdealCondEntSetPtMgr(SetPtMgrNum)%ChllrVarIndex)
! Get the chilled water pump energy consumption
ChilledPumpEnergy = GetInternalVariableValue(IdealCondEntSetPtMgr(SetPtMgrNum)%ChlPumpVarType, &
IdealCondEntSetPtMgr(SetPtMgrNum)%ChlPumpVarIndex)
! Get the cooling tower fan energy consumption
TowerFanEnergy = GetInternalVariableValue(IdealCondEntSetPtMgr(SetPtMgrNum)%ClTowerVarType, &
IdealCondEntSetPtMgr(SetPtMgrNum)%ClTowerVarIndex)
! Get the condenser pump energy consumption
CondPumpEnergy = GetInternalVariableValue(IdealCondEntSetPtMgr(SetPtMgrNum)%CndPumpVarType, &
IdealCondEntSetPtMgr(SetPtMgrNum)%CndPumpVarIndex)
! Calculate the total energy consumption
TotEnergy = ChillerEnergy + ChilledPumpEnergy + TowerFanEnergy + CondPumpEnergy
IF (TotEnergyPre /= 0.0d0) THEN
DeltaTotEnergy = 0.0d0
! Calculate the total energy consumption difference
DeltaTotEnergy = TotEnergyPre - TotEnergy
! Search for the minimum total energy consumption
IF ((DeltaTotEnergy > 0) .and. (CondWaterSetpoint >= CondTempLimit) .and. &
(.not. RunFinalOptCondEntTemp)) THEN
IF (.not. RunSubOptCondEntTemp) THEN
CondWaterSetpoint = CondWaterSetpoint - 1.0d0
RunOptCondEntTemp = .TRUE.
ELSE
CondWaterSetpoint = CondWaterSetpoint - 0.2d0
RunOptCondEntTemp = .TRUE.
END IF
TotEnergyPre = TotEnergy
! Set smaller set point (0.2 degC) decrease
ELSE IF ((DeltaTotEnergy < 0) .and. (.not. RunSubOptCondEntTemp) .and. &
(CondWaterSetpoint > CondTempLimit) .and. (.not. RunFinalOptCondEntTemp)) THEN
CondWaterSetpoint = CondWaterSetpoint + 0.8d0
RunOptCondEntTemp = .TRUE.
RunSubOptCondEntTemp = .TRUE.
ELSE
IF (.not. RunFinalOptCondEntTemp) THEN
CondWaterSetpoint = CondWaterSetpoint + 0.2d0
RunOptCondEntTemp = .TRUE.
RunSubOptCondEntTemp = .FALSE.
RunFinalOptCondEntTemp = .TRUE.
ELSE
CondWaterSetpoint = CondWaterSetpoint
TotEnergyPre = 0.0d0
RunOptCondEntTemp = .FALSE.
RunSubOptCondEntTemp = .FALSE.
RunFinalOptCondEntTemp = .FALSE.
ENDIF
END IF
ELSE
CondWaterSetpoint = InitCondWaterSetpoint - 1.0d0
TotEnergyPre = TotEnergy
RunOptCondEntTemp = .TRUE.
RunSubOptCondEntTemp = .FALSE.
ENDIF
ELSE
CondWaterSetpoint = InitCondWaterSetpoint
TotEnergyPre = 0.0d0
RunOptCondEntTemp = .FALSE.
RunSubOptCondEntTemp = .FALSE.
END IF
ELSE
CondWaterSetpoint = InitCondWaterSetpoint
RunOptCondEntTemp = .FALSE.
RunSubOptCondEntTemp = .FALSE.
END IF
IdealCondEntSetPtMgr(SetPtMgrNum)%SetPt = CondWaterSetpoint
END SUBROUTINE CalcIdealCondEntSetPoint