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) | :: | ChillNum | |||
real(kind=r64), | intent(inout) | :: | QCond | |||
real(kind=r64), | intent(in) | :: | CondMassFlow | |||
real(kind=r64), | intent(in) | :: | CondInletTemp | |||
real(kind=r64), | intent(out) | :: | QHeatRec |
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 CalcElectricChillerHeatRecovery(ChillNum,QCond,CondMassFlow,CondInletTemp,QHeatRec)
! SUBROUTINE INFORMATION:
! AUTHOR: Richard Liesen
! DATE WRITTEN: January 2004
! PURPOSE OF THIS SUBROUTINE:
! Calculate the heat recovered from the chiller condenser
! METHODOLOGY EMPLOYED: na
! REFERENCES: na
! USE STATEMENTS:
USE Psychrometrics, ONLY: PsyCpAirFnWTdb
USE FluidProperties, ONLY: GetSpecificHeatGlycol
USE DataPlant, ONLY: PlantLoop, SingleSetpoint, DualSetPointDeadBand
USE ScheduleManager, ONLY: GetCurrentScheduleValue
IMPLICIT NONE
! SUBROUTINE ARGUMENT DEFINITIONS:
INTEGER, INTENT (IN) :: ChillNum ! number of the current electric chiller being simulated
REAL(r64),INTENT(INOut) :: QCond ! current condenser load
REAL(r64),INTENT(Out) :: QHeatRec ! amount of heat recovered
REAL(r64),INTENT(IN) :: CondMassFlow ! current condenser Mass Flow
REAL(r64),INTENT(IN) :: CondInletTemp ! current condenser Inlet Temp
! SUBROUTINE PARAMETER DEFINITIONS:
! na
! DERIVED TYPE DEFINITIONS
! na
! SUBROUTINE LOCAL VARIABLE DECLARATIONS:
INTEGER :: CondInletNode ! condenser inlet node number, water side
INTEGER :: CondOutletNode ! condenser outlet node number, water side
INTEGER :: HeatRecInNode
INTEGER :: HeatRecOutNode
REAL(r64) :: QTotal
REAL(r64) :: QCondTmp
REAL(r64) :: HeatRecInletTemp
REAL(r64) :: HeatRecMassFlowRate
REAL(r64) :: FracHeatRec
REAL(r64) :: TAvgIn
REAL(r64) :: TAvgOut
REAL(r64) :: CpHeatRec
REAL(r64) :: CpCond
REAL(r64) :: THeatRecSetpoint
REAL(r64) :: QHeatRecToSetpoint
REAL(r64) :: HeatRecHighInletLimit
! Begin routine
HeatRecInNode = ElectricChiller(ChillNum)%HeatRecInletNodeNum
HeatRecOutNode = ElectricChiller(ChillNum)%HeatRecOutletNodeNum
CondInletNode = ElectricChiller(ChillNum)%Base%CondInletNodeNum
CondOutletNode = ElectricChiller(ChillNum)%Base%CondOutletNodeNum
HeatRecInletTemp = Node(HeatRecInNode)%Temp
HeatRecMassFlowRate = Node(HeatRecInNode)%MassFlowRate
CpHeatRec = GetSpecificHeatGlycol(PlantLoop(ElectricChiller(ChillNum)%HRLoopNum)%FluidName, &
HeatRecInletTemp, &
PlantLoop(ElectricChiller(ChillNum)%HRLoopNum)%FluidIndex, &
'ChillerHeatRecovery')
IF(ElectricChiller(ChillNum)%Base%CondenserType == WaterCooled) THEN
CpCond = GetSpecificHeatGlycol(PlantLoop(ElectricChiller(ChillNum)%Base%CDLoopNum)%FluidName, &
CondInletTemp, &
PlantLoop(ElectricChiller(ChillNum)%Base%CDLoopNum)%FluidIndex, &
'ChillerHeatRecovery')
ELSE
CpCond = PsyCpAirFnWTdb(Node(CondInletNode)%HumRat,CondInletTemp,'ElecChillerHeatRecovery')
END IF
! Before we modify the QCondenser, the total or original value is transferred to QTot
QTotal = QCond
IF (ElectricChiller(ChillNum)%HeatRecSetpointNodeNum == 0) THEN ! use original algorithm that blends temps
TAvgIn = (HeatRecMassFlowRate*CpHeatRec*HeatRecInletTemp + CondMassFlow*CpCond*CondInletTemp)/ &
(HeatRecMassFlowRate*CpHeatRec + CondMassFlow*CpCond)
TAvgOut = QTotal/(HeatRecMassFlowRate*CpHeatRec + CondMassFlow*CpCond) + TAvgIn
QHeatRec = HeatRecMassFlowRate * CpHeatRec * (TAvgOut - HeatRecInletTemp)
QHeatRec = MAX(QHeatRec, 0.d0) ! ensure non negative
!check if heat flow too large for physical size of bundle
QHeatRec = MIN(QHeatRec, ElectricChiller(ChillNum)%HeatRecMaxCapacityLimit)
ELSE ! use new algorithm to meet setpoint
SELECT CASE (PlantLoop(ElectricChiller(ChillNum)%HRLoopNum)%LoopDemandCalcScheme)
CASE (SingleSetPoint)
THeatRecSetpoint = Node(ElectricChiller(ChillNum)%HeatRecSetpointNodeNum)%TempSetPoint
CASE (DualSetPointDeadBand)
THeatRecSetpoint = Node(ElectricChiller(ChillNum)%HeatRecSetpointNodeNum)%TempSetPointHi
END SELECT
QHeatRecToSetpoint = HeatRecMassFlowRate * CpHeatRec * (THeatRecSetpoint - HeatRecInletTemp)
QHeatRecToSetpoint = MAX(QHeatRecToSetpoint, 0.d0)
QHeatRec = MIN(QTotal,QHeatRecToSetpoint)
!check if heat flow too large for physical size of bundle
QHeatRec = MIN(QHeatRec, ElectricChiller(ChillNum)%HeatRecMaxCapacityLimit)
ENDIF
! check if limit on inlet is present and exceeded.
IF (ElectricChiller(ChillNum)%HeatRecInletLimitSchedNum > 0) THEN
HeatRecHighInletLimit = GetCurrentScheduleValue(ElectricChiller(ChillNum)%HeatRecInletLimitSchedNum)
IF ( HeatRecInletTemp > HeatRecHighInletLimit) THEN ! shut down heat recovery
QHeatRec = 0.d0
ENDIF
ENDIF
QCond = QTotal - QHeatRec
! Calculate a new Heat Recovery Coil Outlet Temp
IF (HeatRecMassFlowRate > 0.0d0) THEN
HeatRecOutletTemp = QHeatRec/(HeatRecMassFlowRate*CpHeatRec) + HeatRecInletTemp
Else
HeatRecOutletTemp = HeatRecInletTemp
End If
RETURN
END SUBROUTINE CalcElectricChillerHeatRecovery