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 CalcCondEntSetPoint(SetPtMgrNum)
! SUBROUTINE INFORMATION:
! AUTHOR Atefe Makhmalbaf and Heejin Cho, PNNL
! DATE WRITTEN March 2012
! MODIFIED na
! RE-ENGINEERED na
! PURPOSE OF THIS SUBROUTINE:
! Calculate the optimal condenser water temperature set point for a chiller plant
! with one or more chillers. The condenser water leaving the tower should be at this temperature
! for optimal operation of the chiller plant.
! METHODOLOGY EMPLOYED:
! using one curve to determine the optimum condenser entering water temperature for a given timestep
! and two other curves to place boundary conditions on the optimal setpoint value.
! REFERENCES:
! na
! USE STATEMENTS:
Use DataEnvironment, ONLY: CurMnDy, OutDryBulbTemp, OutWetBulbTemp
USE CurveManager, ONLY: CurveValue
USE ScheduleManager, ONLY: GetCurrentScheduleValue
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) :: NormDsnCondFlow = 0.0d0 !Normalized design condenser flow for cooling towers, m3/s per watt
REAL(r64) :: Twr_DesignWB = 0.0d0 !The cooling tower design inlet air wet bulb temperature, C
REAL(r64):: Dsn_EntCondTemp = 0.0d0 !The chiller design entering condenser temp, C; e.g. 29.44C {85F}
REAL(r64):: Dsn_CondMinThisChiller = 0.0d0 !Design Minimum Condenser Entering for current chillers this timestep
REAL(r64):: Dsn_MinCondSetpt = 0.0d0 !The design minimum condenser water temp, C; e.g. 18.33C {65 F}
REAL(r64):: Cur_MinLiftTD = 0.0d0 !Minimum lift (TCond entering - Tevap leaving) TD this timestep
REAL(r64):: temp_MinLiftTD = 0.0d0 !Intermeidate variable associated with lift (TCond entering - Tevap leaving) TD
REAL(r64):: Des_Load = 0.0d0 !array of chiller design loads
REAL(r64):: Act_Load = 0.0d0 !array of chiller actual loads
REAL(r64):: ALW = 0.0d0 !Actual load weighting of each chiller, W
REAL(r64):: DLW = 0.0d0 !Design capacity of each chiller, W
REAL(r64):: Design_Load_Sum = 0.0d0 !the design load of the chillers, W
REAL(r64) :: Actual_Load_Sum = 0.0d0 !the actual load of the chillers, W
REAL(r64) :: Weighted_Actual_Load_Sum = 0.0d0 !Intermediate weighted value of actual load on plant, W
REAL(r64) :: Weighted_Design_Load_Sum = 0.0d0 !Intermediate weighted value of design load on plant, W
REAL(r64) :: Weighted_Ratio = 0.0d0 !Weighted part load ratio of chillers
REAL(r64) :: Min_DesignWB = 0.0d0 !Minimum design twr wet bulb allowed, C
REAL(r64) :: Min_ActualWb = 0.0d0 !Minimum actual oa wet bulb allowed, C
REAL(r64) :: SetPoint = 0.0d0 !Condenser entering water temperature setpoint this timestep, C
REAL(r64) :: Opt_CondEntTemp = 0.0d0 !Optimized Condenser entering water temperature setpoint this timestep, C
REAL(r64) :: CondWaterSetpoint = 0.0d0 !Condenser entering water temperature setpoint this timestep, C
REAL(r64) :: DesignClgCapacity_Watts = 0.0d0
REAL(r64) :: CurrentLoad_Watts = 0.0d0
REAL(r64) :: CondInletTemp = 0.0d0 ! Condenser water inlet temperature (C)
REAL(r64) :: TempDesCondIn = 0.0d0 ! Design condenser inlet temp. C , or 25.d0
REAL(r64) :: EvapOutletTemp = 0.0d0 ! Evaporator water outlet temperature (C)
REAL(r64) :: TempEvapOutDesign = 0.0d0 ! design evaporator outlet temperature, water side
REAL(r64) :: CurLoad = 0.0d0
INTEGER :: ChillerIndexPlantSide = 0
INTEGER :: ChillerIndexDemandSide = 0
INTEGER :: BranchIndexPlantSide = 0
INTEGER :: BranchIndexDemandSide = 0
INTEGER :: LoopIndexPlantSide = 0
INTEGER :: LoopIndexDemandSide = 0
INTEGER :: TypeNum = 0
! Get from tower design values
NormDsnCondFlow = 5.38d-8 !m3/s per watt (typically 3 gpm/ton)=(Volume of condenser fluid)/(ton of heat rejection)
! Grab tower design inlet air wet bulb from setpoint manager
Twr_DesignWB = CondEntSetPtMgr(SetPtMgrNum)%TowerDsnInletAirWetBulb
! Current timestep's condenser water entering setpoint
CondWaterSetpoint = GetCurrentScheduleValue(CondEntSetPtMgr(SetPtMgrNum)%CondEntTempSchedPtr)
LoopIndexPlantSide = CondEntSetPtMgr(SetPtMgrNum)%LoopIndexPlantSide
ChillerIndexPlantSide = CondEntSetPtMgr(SetPtMgrNum)%ChillerIndexPlantSide
BranchIndexPlantSide = CondEntSetPtMgr(SetPtMgrNum)%BranchIndexPlantSide
TypeNum = CondEntSetPtMgr(SetPtMgrNum)%TypeNum
LoopIndexDemandSide = CondEntSetPtMgr(SetPtMgrNum)%LoopIndexDemandSide
ChillerIndexDemandSide = CondEntSetPtMgr(SetPtMgrNum)%ChillerIndexDemandSide
BranchIndexDemandSide = CondEntSetPtMgr(SetPtMgrNum)%BranchIndexDemandSide
! If chiller is on
CurLoad = ABS(PlantLoop(LoopIndexPlantSide)%LoopSide(SupplySide)%Branch(BranchIndexPlantSide)% &
Comp(ChillerIndexPlantSide)%MyLoad)
IF (CurLoad > 0) THEN
IF (TypeNum == TypeOf_Chiller_Absorption .or. TypeNum == TypeOf_Chiller_CombTurbine .or. &
TypeNum == TypeOf_Chiller_Electric .or. TypeNum == TypeOf_Chiller_ElectricReformEIR .or. &
TypeNum == TypeOf_Chiller_EngineDriven) THEN
TempDesCondIn = PlantLoop(LoopIndexPlantSide)%LoopSide(SupplySide)%Branch(BranchIndexPlantSide)% &
Comp(ChillerIndexPlantSide)%TempDesCondIn
CondInletTemp = Node(PlantLoop(LoopIndexDemandSide)%LoopSide(DemandSide)%Branch(BranchIndexDemandSide)% &
Comp(ChillerIndexDemandSide)%NodeNumIn)%temp
EvapOutletTemp = Node(PlantLoop(LoopIndexPlantSide)%LoopSide(SupplySide)%Branch(BranchIndexPlantSide)% &
Comp(ChillerIndexPlantSide)%NodeNumOut)%temp
TempEvapOutDesign = PlantLoop(LoopIndexPlantSide)%LoopSide(SupplySide)%Branch(BranchIndexPlantSide)% &
Comp(ChillerIndexPlantSide)%TempDesEvapOut
DesignClgCapacity_Watts = PlantLoop(LoopIndexPlantSide)%LoopSide(SupplySide)%Branch(BranchIndexPlantSide)% &
Comp(ChillerIndexPlantSide)%MaxLoad
CurrentLoad_Watts = PlantReport(LoopIndexPlantSide)%CoolingDemand
ELSE IF (TypeNum == TypeOf_Chiller_Indirect_Absorption .or. TypeNum == TypeOf_Chiller_DFAbsorption) THEN
TempDesCondIn = PlantLoop(LoopIndexPlantSide)%LoopSide(SupplySide)%Branch(BranchIndexPlantSide)% &
Comp(ChillerIndexPlantSide)%TempDesCondIn
TempEvapOutDesign = 6.666d0
ELSE
TempDesCondIn = 25.0d0
TempEvapOutDesign = 6.666d0
END IF
! for attached chillers (that are running this timestep) find their Dsn_MinCondSetpt and Dsn_EntCondTemp
Dsn_MinCondSetpt = 999.0d0
Dsn_EntCondTemp = 0.0d0
! Design Minimum Condenser Entering as a function of the minimum lift and TEvapLvg
! for chillers operating on current cond loop this timestep
Dsn_CondMinThisChiller = TempEvapOutDesign + (CondEntSetPtMgr(SetPtMgrNum)%MinimumLiftTD)
Dsn_MinCondSetpt = MIN(Dsn_MinCondSetpt, Dsn_CondMinThisChiller)
! Design entering condenser water temperature for chillers operating
! on current cond loop this timestep
Dsn_EntCondTemp = MAX(Dsn_EntCondTemp,TempDesCondIn)
! Load this array with the design capacity and actual load of each chiller this timestep
Des_Load = 0.0d0
Act_Load = 0.0d0
Des_Load = DesignClgCapacity_Watts
Act_Load = CurrentLoad_Watts
! ***** Load Calculations *****
! In this section the sum of the actual load (watts) and design load (watts)
! of the chillers that are on is calculated.
Actual_Load_Sum = Actual_Load_Sum + Act_Load
Design_Load_Sum = Design_Load_Sum + Des_Load
! Exit if the chillers are all off this hour
If (Actual_Load_Sum <= 0) Then
CondWaterSetpoint = Dsn_EntCondTemp
RETURN
End If
! ***** Weighted Ratio Calculation *****
! This section first calculates the actual (ALW) and design (DLW) individual
! weights. Then the weighted actual and design loads are computed. Finally
! the Weighted Ratio is found.
If (Actual_Load_Sum .NE. 0 .AND. Design_Load_Sum .NE. 0) Then
ALW = ((Act_Load/Actual_Load_Sum)*Act_Load)
DLW = ((Des_Load/Design_Load_Sum)*Des_Load)
Else
ALW = 0.0d0
DLW = 0.0d0
End If
Weighted_Actual_Load_Sum = Weighted_Actual_Load_Sum + ALW
Weighted_Design_Load_Sum = Weighted_Design_Load_Sum + DLW
Weighted_Ratio = Weighted_Actual_Load_Sum/Weighted_Design_Load_Sum
! ***** Optimal Temperature Calculation *****
! In this section the optimal temperature is computed along with the minimum
! design wet bulb temp and the mimimum actual wet bulb temp.
! Min_DesignWB = ACoef1 + ACoef2*OaWb + ACoef3*WPLR + ACoef4*TwrDsnWB + ACoef5*NF
Min_DesignWB = CurveValue(CondEntSetPtMgr(SetPtMgrNum)%MinTwrWbCurve,OutWetBulbTemp, &
Weighted_Ratio,Twr_DesignWB,NormDsnCondFlow)
! Min_ActualWb = BCoef1 + BCoef2*MinDsnWB + BCoef3*WPLR + BCoef4*TwrDsnWB + BCoef5*NF
Min_ActualWb = CurveValue(CondEntSetPtMgr(SetPtMgrNum)%MinOaWbCurve,Min_DesignWB, &
Weighted_Ratio,Twr_DesignWB,NormDsnCondFlow)
! Opt_CondEntTemp = CCoef1 + CCoef2*OaWb + CCoef3*WPLR + CCoef4*TwrDsnWB + CCoef5*NF
Opt_CondEntTemp = CurveValue(CondEntSetPtMgr(SetPtMgrNum)%OptCondEntCurve,OutWetBulbTemp, &
Weighted_Ratio,Twr_DesignWB,NormDsnCondFlow)
! ***** Calculate (Cond ent - Evap lvg) Section *****
! In this section we find the worst case of (Cond ent - Evap lvg) for the
! chillers that are running.
Cur_MinLiftTD = 9999.0d0
temp_MinLiftTD = 20.d0/1.8d0
temp_MinLiftTD = CondInletTemp - EvapOutletTemp
Cur_MinLiftTD = MIN(Cur_MinLiftTD, temp_MinLiftTD)
END IF
! ***** Limit conditions Section *****
! Check for limit conditions and control to the proper value.
If ((Weighted_Ratio >= 0.90d0) .AND. (Opt_CondEntTemp >= (Dsn_EntCondTemp + 1.0d0))) Then
! Optimized value exceeds the design condenser entering condition or chillers
! near full load condition; reset condenser entering setpoint to its design value
Setpoint = Dsn_EntCondTemp + 1.0d0
Else
If ((OutWetBulbTemp >= Min_ActualWb) .AND. (Twr_DesignWB >= Min_DesignWB) &
.and. (Cur_MinLiftTD > CondEntSetPtMgr(SetPtMgrNum)%MinimumLiftTD)) Then
! Boundaries are satified; use optimized condenser entering water temp
Setpoint = Opt_CondEntTemp
Else
!Boundaries violated; Reset to scheduled value of condenser water entering setpoint
Setpoint = CondWaterSetpoint
End If
End If
! Do not allow new setpoint to be less than the design condenser minimum entering condition,
! i.e., TCondWaterEnt not allowed to be less than DsnEvapWaterLvg + MinimumLiftTD
CondWaterSetpoint = Max (Setpoint, Dsn_MinCondSetpt)
CondEntSetPtMgr(SetPtMgrNum)%SetPt = CondWaterSetpoint
END SUBROUTINE CalcCondEntSetPoint