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) | :: | CoilNum | |||
real(kind=r64), | intent(in) | :: | QCoilReq | |||
real(kind=r64), | intent(out) | :: | QCoilActual |
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 CalcDesuperheaterHeatingCoil(CoilNum,QCoilReq,QCoilActual)
! SUBROUTINE INFORMATION:
! AUTHOR Richard Raustad
! DATE WRITTEN January 2005
! MODIFIED na
! RE-ENGINEERED na
! PURPOSE OF THIS SUBROUTINE:
! Simulates a simple desuperheater heating coil with a heat reclaim efficiency
! (eff = ratio of condenser waste heat reclaimed to total condenser waste heat rejected)
! METHODOLOGY EMPLOYED:
! The available capacity of the desuperheater heating coil is determined by the
! amount of heat rejected at the heating source condenser multiplied by the
! desuperheater heat reclaim efficiency. This capacity is either applied towards
! a requested load (load based control) or applied to the air stream to meet a
! heating setpoint (temperature based control). This subroutine is similar to
! the electric or gas heating coil except that the NominalCapacity is variable
! and based on the runtime fraction and heat rejection of the heat source object.
! REFERENCES:
! USE STATEMENTS:
USE DataHVACGlobals, ONLY: TempControlTol
USE DXCoils
! SUBROUTINE ARGUMENT DEFINITIONS:
INTEGER, INTENT (IN) :: CoilNum ! index to desuperheater heating coil
REAL(r64), INTENT (IN) :: QCoilReq ! load requested by the simulation for load based control [W]
REAL(r64), INTENT (OUT) :: QCoilActual ! coil load actually delivered
! SUBROUTINE PARAMETER DEFINITIONS:
! na
! INTERFACE BLOCK SPECIFICATIONS
! na
! DERIVED TYPE DEFINITIONS
! na
! SUBROUTINE LOCAL VARIABLE DECLARATIONS:
REAL(r64) AirMassFlow ! air mass flow through the desuperheater heating coil [kg/sec]
REAL(r64) AvailTemp ! Lowest temperature available from desuperheater (~T condensing)[C]
REAL(r64) TempAirIn ! temperature of the air entering the desuperheater heating coil [C]
REAL(r64) TempAirOut ! temperature of the air leaving the desuperheater heating coil [C]
REAL(r64) Win ! humidity ratio of the air entering the desuperheater heating coil [kg/kg]
REAL(r64) Effic ! ratio of condenser waste heat reclaimed to total condenser waste heat rejected
REAL(r64) CapacitanceAir ! MdotCp of air entering the desuperheater heating coil
REAL(r64) HeatingCoilLoad ! actual load delivered by the desuperheater heating coil [W]
REAL(r64) QCoilCap ! available capacity of the desuperheater heating coil [W]
REAL(r64) TempSetPoint ! setpoint temperature to be met when using temperature based control [C]
INTEGER SourceID ! waste heat source id number
Effic = HeatingCoil(CoilNum)%Efficiency
AirMassFlow = HeatingCoil(CoilNum)%InletAirMassFlowRate
TempAirIn = HeatingCoil(CoilNum)%InletAirTemp
Win = HeatingCoil(CoilNum)%InletAirHumRat
CapacitanceAir = PsyCpAirFnWTdb(Win,TempAirIn)*AirMassFlow
TempSetPoint = HeatingCoil(CoilNum)%DesiredOutletTemp
! Access the appropriate structure to find the available heating capacity of the desuperheater heating coil
! The nominal capacity of the desuperheater heating coil varies based on the amount of heat rejected by the source
! Stovall 2011, add comparison to available temperature of heat reclaim source
IF(ValidSourceType(CoilNum))THEN
SourceID = HeatingCoil(CoilNum)%ReclaimHeatingSourceIndexNum
IF(HeatingCoil(CoilNum)%ReclaimHeatingSource .EQ. COMPRESSORRACK_REFRIGERATEDCASE)THEN
!Added last term to available energy equations to avoid double counting reclaimed energy
! because refrigeration systems are solved outside the hvac time step iterations
HeatingCoil(CoilNum)%RTF = 1.0d0
HeatingCoil(CoilNum)%NominalCapacity = HeatReclaimRefrigeratedRack(SourceID)%AvailCapacity * Effic - &
HeatReclaimRefrigeratedRack(SourceID)%UsedWaterHeater
ELSEIF(HeatingCoil(CoilNum)%ReclaimHeatingSource .EQ. CONDENSER_REFRIGERATION)THEN
AvailTemp = HeatReclaimRefrigCondenser(SourceID)%AvailTemperature
HeatingCoil(CoilNum)%RTF = 1.0d0
IF(AvailTemp .LE. TempAirIn)THEN
HeatingCoil(CoilNum)%NominalCapacity = 0.d0
CALL ShowRecurringWarningErrorAtEnd('Coil:Heating:Desuperheater '// &
TRIM(HeatingCoil(CoilNum)%Name) // &
' - Waste heat source temperature was too low to be useful.',&
HeatingCoil(CoilNum)%InsuffTemperatureWarn)
ELSE
HeatingCoil(CoilNum)%NominalCapacity = HeatReclaimRefrigCondenser(SourceID)%AvailCapacity * Effic - &
HeatReclaimRefrigCondenser(SourceID)%UsedWaterHeater
END IF
ELSEIF(HeatingCoil(CoilNum)%ReclaimHeatingSource .EQ. COIL_DX_COOLING .OR. &
HeatingCoil(CoilNum)%ReclaimHeatingSource .EQ. COIL_DX_MULTISPEED .OR. &
HeatingCoil(CoilNum)%ReclaimHeatingSource .EQ. COIL_DX_MULTIMODE) THEN
HeatingCoil(CoilNum)%RTF = DXCoil(SourceID)%CoolingCoilRuntimeFraction
HeatingCoil(CoilNum)%NominalCapacity = HeatReclaimDXCoil(SourceID)%AvailCapacity * Effic
END IF
ELSE
HeatingCoil(CoilNum)%NominalCapacity = 0.0d0
END IF
! Control output to meet load (QCoilReq)
IF((AirMassFlow .GT. 0.0d0) .and. &
(GetCurrentScheduleValue(HeatingCoil(CoilNum)%SchedPtr) .gt. 0.0d0) .and. &
(QCoilReq .gt. 0.0d0)) THEN
!check to see if the Required heating capacity is greater than the available heating capacity.
IF(QCoilReq > HeatingCoil(CoilNum)%NominalCapacity) Then
QCoilCap = HeatingCoil(CoilNum)%NominalCapacity
Else
QCoilCap = QCoilReq
End IF
! report the runtime fraction of the desuperheater heating coil
IF(HeatingCoil(CoilNum)%NominalCapacity .GT. 0.0d0)THEN
HeatingCoil(CoilNum)%RTF = HeatingCoil(CoilNum)%RTF * (QCoilCap / HeatingCoil(CoilNum)%NominalCapacity)
TempAirOut = TempAirIn + QCoilCap/CapacitanceAir
HeatingCoilLoad = QCoilCap
ELSE
HeatingCoil(CoilNum)%RTF = 0.0d0
TempAirOut = TempAirIn
HeatingCoilLoad = 0.0d0
END IF
! Control coil output to meet a setpoint temperature.
Else IF((AirMassFlow .GT. 0.0d0 .AND. HeatingCoil(CoilNum)%NominalCapacity > 0.0d0) .and. &
(GetCurrentScheduleValue(HeatingCoil(CoilNum)%SchedPtr) .gt. 0.0d0) .and. &
(QCoilReq == SensedLoadFlagValue) .and. (ABS(TempSetPoint-TempAirIn) .gt. TempControlTol) ) THEN
QCoilCap = CapacitanceAir*(TempSetPoint - TempAirIn)
! check to see if setpoint is above entering air temperature. If not, set output to zero.
IF(QCoilCap .LE. 0.0d0) THEN
QCoilCap = 0.0d0
TempAirOut = TempAirIn
!check to see if the required heating capacity is greater than the available capacity.
Else IF(QCoilCap > HeatingCoil(CoilNum)%NominalCapacity) Then
QCoilCap = HeatingCoil(CoilNum)%NominalCapacity
TempAirOut = TempAirIn + QCoilCap/CapacitanceAir
Else
TempAirOut = TempSetPoint
End IF
HeatingCoilLoad = QCoilCap
! report the runtime fraction of the desuperheater heating coil
HeatingCoil(CoilNum)%RTF = HeatingCoil(CoilNum)%RTF * (QCoilCap / HeatingCoil(CoilNum)%NominalCapacity)
Else ! If not running, conditions do not change across heating coil from inlet to outlet
TempAirOut = TempAirIn
HeatingCoilLoad = 0.0d0
HeatingCoil(CoilNum)%ElecUseLoad = 0.0d0
HeatingCoil(CoilNum)%RTF = 0.0d0
END IF
! Set the outlet conditions
HeatingCoil(CoilNum)%HeatingCoilLoad = HeatingCoilLoad
HeatingCoil(CoilNum)%OutletAirTemp = TempAirOut
! This HeatingCoil does not change the moisture or Mass Flow across the component
HeatingCoil(CoilNum)%OutletAirHumRat = HeatingCoil(CoilNum)%InletAirHumRat
HeatingCoil(CoilNum)%OutletAirMassFlowRate = HeatingCoil(CoilNum)%InletAirMassFlowRate
!Set the outlet enthalpy
HeatingCoil(CoilNum)%OutletAirEnthalpy = PsyHFnTdbW(HeatingCoil(CoilNum)%OutletAirTemp, &
HeatingCoil(CoilNum)%OutletAirHumRat)
HeatingCoil(CoilNum)%ElecUseLoad = HeatingCoil(CoilNum)%ParasiticElecLoad*HeatingCoil(CoilNum)%RTF
QCoilActual = HeatingCoilLoad
! Update remaining waste heat (just in case multiple users of waste heat use same source)
IF(ValidSourceType(CoilNum))THEN
SourceID = HeatingCoil(CoilNum)%ReclaimHeatingSourceIndexNum
! Refrigerated cases are simulated at the zone time step, do not decrement available capacity
! (the heat reclaim available capacity will not get reinitialized as the air loop iterates)
IF(HeatingCoil(CoilNum)%ReclaimHeatingSource .EQ. COMPRESSORRACK_REFRIGERATEDCASE)THEN
HeatReclaimRefrigeratedRack(SourceID)%UsedHVACCoil=HeatingCoilLoad
ELSEIF(HeatingCoil(CoilNum)%ReclaimHeatingSource .EQ. CONDENSER_REFRIGERATION)THEN
HeatReclaimRefrigCondenser(SourceID)%UsedHVACCoil=HeatingCoilLoad
ELSEIF(HeatingCoil(CoilNum)%ReclaimHeatingSource .EQ. COIL_DX_COOLING .OR. &
HeatingCoil(CoilNum)%ReclaimHeatingSource .EQ. COIL_DX_MULTISPEED .OR. &
HeatingCoil(CoilNum)%ReclaimHeatingSource .EQ. COIL_DX_MULTIMODE) THEN
HeatReclaimDXCoil(SourceID)%AvailCapacity = &
HeatReclaimDXCoil(SourceID)%AvailCapacity - HeatingCoilLoad
END IF
END IF
RETURN
END Subroutine CalcDesuperheaterHeatingCoil