SUBROUTINE CalcMultiSpeedDXCoilHeating(DXCoilNum,SpeedRatio, CycRatio, SpeedNum, FanOpMode)
! SUBROUTINE INFORMATION:
! AUTHOR Lixing Gu, FSEC
! DATE WRITTEN June 2007
! MODIFIED na
! RE-ENGINEERED Revised based on CalcDXHeatingCoil
! PURPOSE OF THIS SUBROUTINE:
! Calculates the air-side performance and electrical energy use of a direct-
! expansion, air-cooled cooling unit with a multispeed compressor.
! METHODOLOGY EMPLOYED:
! Uses the same methodology as the single speed DX heating unit model (SUBROUTINE CalcDXHeatingCoil).
! In addition it assumes that the unit performance is obtained by interpolating between
! the performance at high speed and that at low speed. If the output needed is below
! that produced at low speed, the compressor cycles between off and low speed.
! USE STATEMENTS:
USE CurveManager, ONLY: CurveValue
USE General, ONLY: TrimSigDigits, RoundSigDigits
USE DataWater, ONLY: WaterStorage
USE DataHVACGlobals, ONLY: MSHPMassFlowRateLow, MSHPMassFlowRateHigh, MSHPWasteHeat
IMPLICIT NONE ! Enforce explicit typing of all variables in this routine
! SUBROUTINE ARGUMENT DEFINITIONS:
INTEGER :: DXCoilNum ! the number of the DX heating coil to be simulated
REAL(r64) :: SpeedRatio ! = (CompressorSpeed - CompressorSpeedMin) / (CompressorSpeedMax - CompressorSpeedMin)
! SpeedRatio varies between 1.0 (maximum speed) and 0.0 (minimum speed)
REAL(r64) :: CycRatio ! cycling part load ratio
INTEGER :: SpeedNum ! Speed number
INTEGER :: FanOpMode ! Fan operation mode
! SUBROUTINE PARAMETER DEFINITIONS:
CHARACTER(len=*), PARAMETER :: RoutineName='CalcMultiSpeedDXCoilHeating'
! INTERFACE BLOCK SPECIFICATIONS
! na
! DERIVED TYPE DEFINITIONS
! na
! SUBROUTINE LOCAL VARIABLE DECLARATIONS:
REAL(r64) :: AirMassFlow ! dry air mass flow rate through coil [kg/s]
REAL(r64) :: InletAirWetBulbC ! wetbulb temperature of inlet air [C]
REAL(r64) :: InletAirDryBulbTemp ! inlet air dry bulb temperature [C]
REAL(r64) :: InletAirEnthalpy ! inlet air enthalpy [J/kg]
REAL(r64) :: InletAirHumRat ! inlet air humidity ratio [kg/kg]
REAL(r64) :: OutletAirEnthalpy ! outlet air enthalpy [J/kg]
REAL(r64) :: OutletAirHumRat ! outlet air humidity ratio [kg/kg]
REAL(r64) :: TotCapHS ! total capacity at high speed [W]
REAL(r64) :: TotCapLS ! total capacity at low speed [W]
REAL(r64) :: EIRHS ! EIR at off rated conditions (high speed)
REAL(r64) :: EIRLS ! EIR at off rated conditions (low speed)
REAL(r64) :: TotCap ! total capacity at current speed [W]
REAL(r64) :: EIR ! EIR at current speed
REAL(r64) :: PLF ! Part load factor, accounts for thermal lag at compressor startup, used in
! power calculation
REAL(r64) :: OutdoorDryBulb ! Outdoor dry-bulb temperature at condenser (C)
REAL(r64) :: OutdoorHumRat ! Outdoor humidity ratio at condenser (kg/kg)
REAL(r64) :: OutdoorPressure ! Outdoor barometric pressure at condenser (Pa)
INTEGER :: SpeedNumHS ! High speed number
INTEGER :: SpeedNumLS ! Low speed number
REAL(r64) :: AirMassFlowRatioLS ! airflow ratio at low speed
REAL(r64) :: AirMassFlowRatioHS ! airflow ratio at high speed
REAL(r64) :: AirFlowRatio ! Airflow ratio
REAL(r64) :: PLRHeating ! Part load ratio in heating
REAL(r64) :: CrankcaseHeatingPower ! Power due to crank case heater
REAL(r64) :: AirVolumeFlowRate ! Air volume flow rate across the heating coil
REAL(r64) :: VolFlowperRatedTotCap ! Air volume flow rate divided by rated total heating capacity
REAL(r64) :: TotCapTempModFac ! Total capacity modifier as a function ot temperature
REAL(r64) :: TotCapFlowModFac ! Total capacity modifier as a function of flow ratio
REAL(r64) :: OutdoorCoilT ! Outdoor coil temperature
REAL(r64) :: OutdoorCoildw ! Outdoor coil delta w assuming coil temperature of OutdoorCoilT
REAL(r64) :: LoadDueToDefrost ! Additonal load due to defrost
REAL(r64) :: LoadDueToDefrostLS ! Additonal load due to defrost at low speed
REAL(r64) :: LoadDueToDefrostHS ! Additonal load due to defrost at high speed
REAL(r64) :: HeatingCapacityMultiplier ! Multiplier for heating capacity when system is in defrost
REAL(r64) :: FractionalDefrostTime ! Fraction of time step when system is in defrost
REAL(r64) :: InputPowerMultiplier ! Multiplier for poer when system is in defrost
REAL(r64) :: DefrostEIRTempModFac ! EIR modifier for defrost
REAL(r64) :: FullLoadOutAirEnth ! Outlet full load enthalpy
REAL(r64) :: FullLoadOutAirHumRat ! Outlet humidity ratio at full load
REAL(r64) :: FullLoadOutAirTemp ! Outlet temperature at full load
REAL(r64) :: FullLoadOutAirRH ! Outler relative humidity at full load
REAL(r64) :: OutletAirTemp ! Supply ari temperature
REAL(r64) :: EIRTempModFac ! EIR modifier as a function of temperature
REAL(r64) :: EIRFlowModFac ! EIR modifier as a function of airflow ratio
REAL(r64) :: WasteHeatLS ! Waste heat at low speed
REAL(r64) :: WasteHeatHS ! Waste heat at high speed
REAL(r64) :: LSFullLoadOutAirEnth ! Outlet full load enthalpy at low speed
REAL(r64) :: HSFullLoadOutAirEnth ! Outlet full load enthalpy at high speed
REAL(r64) :: LSElecHeatingPower ! Full load power at low speed
REAL(r64) :: HSElecHeatingPower ! Full load power at high speed
REAL(r64) :: DefrostPowerLS ! Defrost power at low speed [W]
REAL(r64) :: DefrostPowerHS ! Defrost power at high speed [W]
! FLOW
If (SpeedNum > 1) Then
SpeedNumLS = SpeedNum-1
SpeedNumHS = SpeedNum
If (SpeedNum .GT. DXCoil(DXCoilNum)%NumOfSpeeds) Then
SpeedNumLS = DXCoil(DXCoilNum)%NumOfSpeeds-1
SpeedNumHS = DXCoil(DXCoilNum)%NumOfSpeeds
End If
Else
SpeedNumLS = 1
SpeedNumHS = 1
End If
AirMassFlow = DXCoil(DXCoilNum)%InletAirMassFlowRate
AirMassFlowRatioLS = MSHPMassFlowRateLow/DXCoil(DXCoilNum)%MSRatedAirMassFlowRate(SpeedNumLS)
AirMassFlowRatioHS = MSHPMassFlowRateHigh/DXCoil(DXCoilNum)%MSRatedAirMassFlowRate(SpeedNumHS)
AirFlowRatio = 1.0d0
IF(DXCoil(DXCoilNum)%CompanionUpstreamDXCoil .EQ. 0) MSHPWasteHeat = 0.0d0
! Get condenser outdoor node info from DX Heating Coil
IF (DXCoil(DXCoilNum)%CondenserInletNodeNum(1) /= 0) THEN
OutdoorPressure = Node(DXCoil(DXCoilNum)%CondenserInletNodeNum(1))%Press
! If node is not connected to anything, pressure = default, use weather data
IF(OutdoorPressure == DefaultNodeValues%Press)THEN
OutdoorDryBulb = OutDryBulbTemp
OutdoorHumRat = OutHumRat
OutdoorPressure = OutBaroPress
ELSE
OutdoorDryBulb = Node(DXCoil(DXCoilNum)%CondenserInletNodeNum(1))%Temp
OutdoorHumRat = Node(DXCoil(DXCoilNum)%CondenserInletNodeNum(1))%HumRat
END IF
ELSE
OutdoorDryBulb = OutDryBulbTemp
OutdoorHumRat = OutHumRat
OutdoorPressure = OutBaroPress
ENDIF
InletAirDryBulbTemp = DXCoil(DXCoilNum)%InletAirTemp
InletAirEnthalpy = DXCoil(DXCoilNum)%InletAirEnthalpy
InletAirHumRat = DXCoil(DXCoilNum)%InletAirHumRat
! Eventually inlet air conditions will be used in DX Coil, these lines are commented out and marked with this comment line
!InletAirPressure = DXCoil(DXCoilNum)%InletAirPressure
!InletAirWetbulbC = PsyTwbFnTdbWPb(InletAirDryBulbTemp,InletAirHumRat,InletAirPressure)
InletAirWetbulbC = PsyTwbFnTdbWPb(InletAirDryBulbTemp,InletAirHumRat,OutdoorPressure,RoutineName)
PLRHeating = 0.0d0
DXCoil(DXCoilNum)%HeatingCoilRuntimeFraction = 0.0d0
! Initialize crankcase heater, operates below OAT defined in input deck for HP DX heating coil
IF (OutdoorDryBulb .LT. DXCoil(DXCoilNum)%MaxOATCrankcaseHeater)THEN
CrankcaseHeatingPower = DXCoil(DXCoilNum)%CrankcaseHeaterCapacity
ELSE
CrankcaseHeatingPower = 0.0d0
END IF
DXCoil(DXCoilNum)%PartLoadRatio = 0.0d0
HeatReclaimDXCoil(DXCoilNum)%AvailCapacity = 0.0d0
IF((AirMassFlow .GT. 0.0d0) .AND. &
(GetCurrentScheduleValue(DXCoil(DXCoilNum)%SchedPtr) .GT. 0.0d0) .AND. &
((CycRatio .GT. 0.0d0) .OR. (SpeedRatio .GT. 0.0d0)) .AND. OutdoorDryBulb .GT. DXCoil(DXCoilNum)%MinOATCompressor) THEN
If (SpeedNum > 1) Then
! Check for valid air volume flow per rated total cooling capacity (200 - 600 cfm/ton) at low speed
AirVolumeFlowRate = MSHPMassFlowRateLow/PsyRhoAirFnPbTdbW(OutdoorPressure,InletAirDryBulbTemp, InletAirHumRat,RoutineName)
! Eventually inlet air conditions will be used in DX Coil, these lines are commented out and marked with this comment line
! AirVolumeFlowRate = AirMassFlow/PsyRhoAirFnPbTdbW(InletAirPressure,InletAirDryBulbTemp, InletAirHumRat)
VolFlowperRatedTotCap = AirVolumeFlowRate/DXCoil(DXCoilNum)%MSRatedTotCap(SpeedNumLS)
IF ((VolFlowperRatedTotCap.LT.MinOperVolFlowPerRatedTotCap(DXCT)).OR. &
(VolFlowperRatedTotCap.GT.MaxHeatVolFlowPerRatedTotCap(DXCT))) THEN
IF (DXCoil(DXCoilNum)%MSErrIndex(SpeedNumLS) == 0) THEN
CALL ShowWarningMessage(TRIM(DXCoil(DXCoilNum)%DXCoilType)//' "'//TRIM(DXCoil(DXCoilNum)%Name)//&
'" - Air volume flow rate per watt of rated total heating capacity is out of range at speed ' &
//TRIM(TrimSigDigits(SpeedNumLS))//'.')
CALL ShowContinueErrorTimeStamp(' ')
CALL ShowContinueError('Expected range for VolumeFlowPerRatedTotalCapacity=['// &
TRIM(RoundSigDigits(MinOperVolFlowPerRatedTotCap(DXCT),3))//'--'// &
TRIM(RoundSigDigits(MaxHeatVolFlowPerRatedTotCap(DXCT),3))//']')
CALL ShowContinueError('Possible causes include inconsistent air flow rates in system components or')
CALL ShowContinueError('inconsistent supply air fan operation modes in coil and unitary system objects.')
END IF
CALL ShowRecurringWarningErrorAtEnd(TRIM(DXCoil(DXCoilNum)%DXCoilType)//' "'//TRIM(DXCoil(DXCoilNum)%Name)//&
'" - Air volume flow rate per watt of rated total heating capacity is out ' //&
'of range at speed '//TRIM(TrimSigDigits(SpeedNumLS))//'error continues...', &
DXCoil(DXCoilNum)%MSErrIndex(SpeedNumLS),ReportMinOf=VolFlowperRatedTotCap,ReportMaxOf=VolFlowperRatedTotCap)
END IF
! Check for valid air volume flow per rated total cooling capacity (200 - 600 cfm/ton) at high speed
AirVolumeFlowRate = MSHPMassFlowRateHigh/PsyRhoAirFnPbTdbW(OutdoorPressure,InletAirDryBulbTemp, InletAirHumRat,RoutineName)
! Eventually inlet air conditions will be used in DX Coil, these lines are commented out and marked with this comment line
! AirVolumeFlowRate = AirMassFlow/PsyRhoAirFnPbTdbW(InletAirPressure,InletAirDryBulbTemp, InletAirHumRat)
VolFlowperRatedTotCap = AirVolumeFlowRate/DXCoil(DXCoilNum)%MSRatedTotCap(SpeedNumHS)
IF ((VolFlowperRatedTotCap.LT.MinOperVolFlowPerRatedTotCap(DXCT)).OR. &
(VolFlowperRatedTotCap.GT.MaxHeatVolFlowPerRatedTotCap(DXCT))) THEN
IF (DXCoil(DXCoilNum)%MSErrIndex(SpeedNumHS) == 0) THEN
CALL ShowWarningMessage(TRIM(DXCoil(DXCoilNum)%DXCoilType)//' "'//TRIM(DXCoil(DXCoilNum)%Name)//&
'" - Air volume flow rate per watt of rated total heating capacity is out of range at speed ' &
//TRIM(TrimSigDigits(SpeedNumHS))//'.')
CALL ShowContinueErrorTimeStamp(' ')
CALL ShowContinueError('Expected range for VolumeFlowPerRatedTotalCapacity=['// &
TRIM(RoundSigDigits(MinOperVolFlowPerRatedTotCap(DXCT),3))//'--'// &
TRIM(RoundSigDigits(MaxHeatVolFlowPerRatedTotCap(DXCT),3))//']')
CALL ShowContinueError('Possible causes include inconsistent air flow rates in system components or')
CALL ShowContinueError('inconsistent supply air fan operation modes in coil and unitary system objects.')
END IF
CALL ShowRecurringWarningErrorAtEnd(TRIM(DXCoil(DXCoilNum)%DXCoilType)//' "'//TRIM(DXCoil(DXCoilNum)%Name)//&
'" - Air volume flow rate per watt of rated total heating capacity is out ' //&
'of range at speed '//TRIM(TrimSigDigits(SpeedNumHS))//'error continues...', &
DXCoil(DXCoilNum)%MSErrIndex(SpeedNumHS),ReportMinOf=VolFlowperRatedTotCap,ReportMaxOf=VolFlowperRatedTotCap)
END IF
! Get total capacity modifying factor (function of temperature) for off-rated conditions
! Model was extended to accept bi-quadratic curves. This allows sensitivity of the heating capacity
! to the entering dry-bulb temperature as well as the outside dry-bulb temperature. User is
! advised to use the bi-quaratic curve if sufficient manufacturer data is available.
! Low speed
IF ((DXCoil(DXCoilNum)%MSTotCapTempModFacCurveType(SpeedNumLS) == Quadratic).OR. &
(DXCoil(DXCoilNum)%MSTotCapTempModFacCurveType(SpeedNumLS) == Cubic)) THEN
TotCapTempModFac = CurveValue(DXCoil(DXCoilNum)%MSCCapFTemp(SpeedNumLS),OutdoorDryBulb)
ELSEIF (DXCoil(DXCoilNum)%MSTotCapTempModFacCurveType(SpeedNumLS) == Biquadratic) THEN
TotCapTempModFac = CurveValue(DXCoil(DXCoilNum)%MSCCapFTemp(SpeedNumLS),InletAirDryBulbTemp,OutdoorDryBulb)
END IF
! Get total capacity modifying factor (function of mass flow) for off-rated conditions
TotCapFlowModFac = CurveValue(DXCoil(DXCoilNum)%MSCCapFFlow(SpeedNumLS),AirMassFlowRatioLS)
! Calculate total heating capacity for off-rated conditions
TotCapLS = DXCoil(DXCoilNum)%MSRatedTotCap(SpeedNumLS) * TotCapFlowModFac * TotCapTempModFac
! High speed
IF ((DXCoil(DXCoilNum)%MSTotCapTempModFacCurveType(SpeedNumHS) == Quadratic).OR. &
(DXCoil(DXCoilNum)%MSTotCapTempModFacCurveType(SpeedNumHS) == Cubic)) THEN
TotCapTempModFac = CurveValue(DXCoil(DXCoilNum)%MSCCapFTemp(SpeedNumHS),OutdoorDryBulb)
ELSEIF (DXCoil(DXCoilNum)%MSTotCapTempModFacCurveType(SpeedNumHS) == Biquadratic) THEN
TotCapTempModFac = CurveValue(DXCoil(DXCoilNum)%MSCCapFTemp(SpeedNumHS),InletAirDryBulbTemp,OutdoorDryBulb)
END IF
! Get total capacity modifying factor (function of mass flow) for off-rated conditions
TotCapFlowModFac = CurveValue(DXCoil(DXCoilNum)%MSCCapFFlow(SpeedNumHS),AirMassFlowRatioHS)
! Calculate total heating capacity for off-rated conditions
TotCapHS = DXCoil(DXCoilNum)%MSRatedTotCap(SpeedNumHS) * TotCapFlowModFac * TotCapTempModFac
! Calculate electricity consumed. First, get EIR modifying factors for off-rated conditions
! Model was extended to accept bi-quadratic curves. This allows sensitivity of the EIR
! to the entering dry-bulb temperature as well as the outside dry-bulb temperature. User is
! advised to use the bi-quaratic curve if sufficient manufacturer data is available.
! Low Speed
IF ((DXCoil(DXCoilNum)%MSEIRTempModFacCurveType(SpeedNumLS) == Quadratic).OR. &
(DXCoil(DXCoilNum)%MSEIRTempModFacCurveType(SpeedNumLS) == Cubic)) THEN
EIRTempModFac = CurveValue(DXCoil(DXCoilNum)%MSEIRFTemp(SpeedNumLS),OutdoorDryBulb)
ELSEIF (DXCoil(DXCoilNum)%MSEIRTempModFacCurveType(SpeedNumLS) == Biquadratic) THEN
EIRTempModFac = CurveValue(DXCoil(DXCoilNum)%MSEIRFTemp(SpeedNumLS),InletAirDryBulbTemp,OutdoorDryBulb)
END IF
EIRFlowModFac = CurveValue(DXCoil(DXCoilNum)%MSEIRFFlow(SpeedNumLS), AirMassFlowRatioLS)
EIRLS = 1.0d0/DXCoil(DXCoilNum)%MSRatedCOP(SpeedNumLS) * EIRTempModFac * EIRFlowModFac
! High Speed
IF ((DXCoil(DXCoilNum)%MSEIRTempModFacCurveType(SpeedNumHS) == Quadratic).OR. &
(DXCoil(DXCoilNum)%MSEIRTempModFacCurveType(SpeedNumHS) == Cubic)) THEN
EIRTempModFac = CurveValue(DXCoil(DXCoilNum)%MSEIRFTemp(SpeedNumHS),OutdoorDryBulb)
ELSEIF (DXCoil(DXCoilNum)%MSEIRTempModFacCurveType(SpeedNumHS) == Biquadratic) THEN
EIRTempModFac = CurveValue(DXCoil(DXCoilNum)%MSEIRFTemp(SpeedNumHS),InletAirDryBulbTemp,OutdoorDryBulb)
END IF
EIRFlowModFac = CurveValue(DXCoil(DXCoilNum)%MSEIRFFlow(SpeedNumHS), AirMassFlowRatioHS)
EIRHS = 1.0d0/DXCoil(DXCoilNum)%MSRatedCOP(SpeedNumHS) * EIRTempModFac * EIRFlowModFac
! Calculating adjustment factors for defrost
! Calculate delta w through outdoor coil by assuming a coil temp of 0.82*DBT-9.7(F) per DOE2.1E
OutdoorCoilT = 0.82d0 * OutdoorDryBulb - 8.589d0
OutdoorCoildw = MAX(1.0d-6,(OutdoorHumRat - PsyWFnTdpPb(OutdoorCoilT,OutdoorPressure,RoutineName)))
! Initializing defrost adjustment factors
LoadDueToDefrostLS = 0.0d0
LoadDueToDefrostHS = 0.0d0
HeatingCapacityMultiplier = 1.0d0
FractionalDefrostTime = 0.0d0
InputPowerMultiplier = 1.0d0
DefrostPowerLS = 0.0d0
DefrostPowerHS = 0.0d0
! Check outdoor temperature to determine of defrost is active
IF (OutdoorDryBulb .LE. DXCoil(DXCoilNum)%MaxOATDefrost) THEN
! Calculate defrost adjustment factors depending on defrost control type
IF (DXCoil(DXCoilNum)%DefrostControl .EQ. Timed) THEN
FractionalDefrostTime = DXCoil(DXCoilNum)%DefrostTime
IF(FractionalDefrostTime .GT. 0.d0)THEN
HeatingCapacityMultiplier = 0.909d0 - 107.33d0 * OutdoorCoildw
InputPowerMultiplier = 0.90d0 - 36.45d0*OutdoorCoildw
END IF
ELSE !else defrost control is on-demand
FractionalDefrostTime = 1.0d0 / (1.0d0 + 0.01446d0 / OutdoorCoildw)
HeatingCapacityMultiplier = 0.875d0 * ( 1.0d0 - FractionalDefrostTime)
InputPowerMultiplier = 0.954d0 * ( 1.0d0 - FractionalDefrostTime)
END IF
IF (FractionalDefrostTime .GT. 0.0d0) THEN
! Calculate defrost adjustment factors depending on defrost control strategy
IF (DXCoil(DXCoilNum)%DefrostStrategy .EQ. ReverseCycle) THEN
DefrostEIRTempModFac = CurveValue(DXCoil(DXCoilNum)%DefrostEIRFT,&
MAX(15.555d0,InletAirWetbulbC),MAX(15.555d0,OutdoorDryBulb))
LoadDueToDefrostLS = (0.01d0 * FractionalDefrostTime) * (7.222d0 - OutdoorDryBulb) * &
(DXCoil(DXCoilNum)%MSRatedTotCap(SpeedNumLS)/1.01667d0)
DefrostPowerLS = DefrostEIRTempModFac *(DXCoil(DXCoilNum)%MSRatedTotCap(SpeedNumLS)/1.01667d0)* FractionalDefrostTime
LoadDueToDefrostHS = (0.01d0 * FractionalDefrostTime) * (7.222d0 - OutdoorDryBulb) * &
(DXCoil(DXCoilNum)%MSRatedTotCap(SpeedNumHS)/1.01667d0)
DefrostPowerHS = DefrostEIRTempModFac *(DXCoil(DXCoilNum)%MSRatedTotCap(SpeedNumHS)/1.01667d0)* FractionalDefrostTime
ELSE ! Defrost strategy is resistive
DXCoil(DXCoilNum)%DefrostPower = DXCoil(DXCoilNum)%DefrostCapacity &
* FractionalDefrostTime
END IF
ELSE ! Defrost is not active because (OutDryBulbTemp .GT. DXCoil(DXCoilNum)%MaxOATDefrost)
DXCoil(DXCoilNum)%DefrostPower = 0.0d0
END IF
END IF
TotCapLS = TotCapLS*HeatingCapacityMultiplier
TotCapHS = TotCapHS*HeatingCapacityMultiplier
! Calculate modified PartLoadRatio due to defrost (reverse-cycle defrost only)
PLRHeating = MIN(1.0d0,(SpeedRatio + LoadDueToDefrostHS/TotCapHS))
PLF = CurveValue(DXCoil(DXCoilNum)%MSPLFFPLR(SpeedNumHS),PLRHeating) ! Calculate part-load factor
IF (PLF < 0.7d0) THEN
IF (DXCoil(DXCoilNum)%PlrErrIndex == 0) THEN
CALL ShowWarningMessage('The PLF curve value at high speed for DX multispeed heating coil '// &
TRIM(DXCoil(DXCoilNum)%Name)//' ='//TRIM(RoundSigDigits(PLF,2))// &
' for part-load ratio ='//TRIM(RoundSigDigits(PLRHeating,2)))
CALL ShowContinueError('PLF curve values must be >= 0.7. PLF has been reset to 0.7 and simulation is continuing.')
CALL ShowContinueError('Check the IO reference manual for PLF curve guidance [Coil:Heating:DX:MultiSpeed].')
CALL ShowContinueErrorTimeStamp(' ')
END IF
CALL ShowRecurringWarningErrorAtEnd('DX heating coil PLF curve < 0.7 warning continues... ', &
DXCoil(DXCoilNum)%PlrErrIndex,ReportMinOf=PLF,ReportMaxOf=PLF)
PLF = 0.7d0
END IF
DXCoil(DXCoilNum)%HeatingCoilRuntimeFraction = (PLRHeating / PLF)
IF (DXCoil(DXCoilNum)%HeatingCoilRuntimeFraction > 1.0d0 .and. &
ABS(DXCoil(DXCoilNum)%HeatingCoilRuntimeFraction-1.0d0) > .001d0)THEN
IF (DXCoil(DXCoilNum)%ErrIndex4 == 0) THEN
CALL ShowWarningMessage('The runtime fraction at high speed for DX multispeed heating coil '// &
TRIM(DXCoil(DXCoilNum)%Name)//&
' exceeded 1.0. ['//TRIM(RoundSigDigits(DXCoil(DXCoilNum)%HeatingCoilRuntimeFraction,4))//'].')
CALL ShowContinueError('Runtime fraction is set to 1.0 and the simulation continues...')
CALL ShowContinueError('Check the IO reference manual for PLF curve guidance [Coil:Heating:DX:SingleSpeed].')
CALL ShowContinueErrorTimeStamp(' ')
END IF
CALL ShowRecurringWarningErrorAtEnd(TRIM(DXCoil(DXCoilNum)%Name)// &
', DX heating coil runtime fraction > 1.0 warning continues...', &
DXCoil(DXCoilNum)%ErrIndex4,DXCoil(DXCoilNum)%HeatingCoilRuntimeFraction,DXCoil(DXCoilNum)%HeatingCoilRuntimeFraction)
DXCoil(DXCoilNum)%HeatingCoilRuntimeFraction = 1.0d0 ! Reset coil runtime fraction to 1.0
ELSEIF (DXCoil(DXCoilNum)%HeatingCoilRuntimeFraction > 1.0d0) THEN
DXCoil(DXCoilNum)%HeatingCoilRuntimeFraction = 1.0d0 ! Reset coil runtime fraction to 1.0
END IF
! Get full load output and power
LSFullLoadOutAirEnth = InletAirEnthalpy + TotCapLS/MSHPMassFlowRateLow
HSFullLoadOutAirEnth = InletAirEnthalpy + TotCapHS/MSHPMassFlowRateHigh
LSElecHeatingPower = TotCapLS*EIRLS*InputPowerMultiplier
HSElecHeatingPower = TotCapHS*EIRHS*InputPowerMultiplier
OutletAirHumRat = InletAirHumRat
! if cycling fan, send coil part-load fraction to on/off fan via HVACDataGlobals
IF (FanOpMode .EQ. CycFanCycCoil) OnOffFanPartLoadFraction = 1.0d0
! Power calculation
If (.NOT. DXCoil(DXCoilNum)%PLRImpact) Then
DXCoil(DXCoilNum)%ElecHeatingPower = SpeedRatio*HSElecHeatingPower+(1.0d0-SpeedRatio)*LSElecHeatingPower
Else
DXCoil(DXCoilNum)%ElecHeatingPower = DXCoil(DXCoilNum)%HeatingCoilRuntimeFraction*HSElecHeatingPower + &
(1.0d0-DXCoil(DXCoilNum)%HeatingCoilRuntimeFraction)*LSElecHeatingPower
End If
DXCoil(DXCoilNum)%TotalHeatingEnergyRate = MSHPMassFlowRateHigh*(HSFullLoadOutAirEnth-InletAirEnthalpy)*SpeedRatio + &
MSHPMassFlowRateLow*(LSFullLoadOutAirEnth-InletAirEnthalpy)*(1.0d0-SpeedRatio)
OutletAirEnthalpy = InletAirEnthalpy + DXCoil(DXCoilNum)%TotalHeatingEnergyRate/DXCoil(DXCoilNum)%InletAirMassFlowRate
OutletAirTemp = PsyTdbFnHW(OutletAirEnthalpy,OutletAirHumRat,RoutineName)
FullLoadOutAirRH = PsyRhFnTdbWPb(OutletAirTemp,OutletAirHumRat,OutdoorPressure,RoutineName//':Averageload')
IF (FullLoadOutAirRH .gt. 1.d0) THEN ! Limit to saturated conditions at FullLoadOutAirEnth
OutletAirTemp = PsyTsatFnHPb(FullLoadOutAirEnth,OutdoorPressure,RoutineName)
OutletAirHumRat = PsyWFnTdbH(OutletAirTemp,FullLoadOutAirEnth,RoutineName)
END IF
! Waste heat calculation
WasteHeatLS = CurveValue(DXCoil(DXCoilNum)%MSWasteHeat(SpeedNumLS),OutdoorDryBulb,InletAirDryBulbTemp) * &
DXCoil(DXCoilNum)%MSWasteHeatFrac(SpeedNumLS)
WasteHeatHS = CurveValue(DXCoil(DXCoilNum)%MSWasteHeat(SpeedNumHS),OutdoorDryBulb,InletAirDryBulbTemp) * &
DXCoil(DXCoilNum)%MSWasteHeatFrac(SpeedNumHS)
MSHPWasteHeat = (SpeedRatio*WasteHeatHS + (1.0d0-SpeedRatio)*WasteHeatLS)*DXCoil(DXCoilNum)%ElecHeatingPower
If (DXCoil(DXCoilNum)%FuelType .NE. FuelTypeElectricity) Then
DXCoil(DXCoilNum)%FuelUsed = DXCoil(DXCoilNum)%ElecHeatingPower
DXCoil(DXCoilNum)%ElecHeatingPower = 0.0d0
End If
! Adjust defrost power to correct for DOE-2 bug where defrost power is constant regardless of compressor runtime fraction
! Defrosts happen based on compressor run time (frost buildup on outdoor coil), not total elapsed time.
If (DXCoil(DXCoilNum)%DefrostStrategy .EQ. ReverseCycle) Then
If (.NOT. DXCoil(DXCoilNum)%PLRImpact) Then
DXCoil(DXCoilNum)%DefrostPower = DefrostPowerHS * SpeedRatio + DefrostPowerLS * (1.0d0-SpeedRatio)
Else
DXCoil(DXCoilNum)%DefrostPower = DefrostPowerHS * DXCoil(DXCoilNum)%HeatingCoilRuntimeFraction + &
DefrostPowerLS * (1.0d0-DXCoil(DXCoilNum)%HeatingCoilRuntimeFraction)
End If
End If
DXCoil(DXCoilNum)%OutletAirTemp = OutletAirTemp
DXCoil(DXCoilNum)%OutletAirHumRat = OutletAirHumRat
DXCoil(DXCoilNum)%OutletAirEnthalpy = OutletAirEnthalpy
DXCoil(DXCoilNum)%CrankcaseHeaterPower = 0.0d0
! Stage 1
Else If (CycRatio > 0.0d0) Then
! for cycling fan, reset mass flow to full on rate
IF (FanOpMode .EQ. CycFanCycCoil) AirMassFlow = AirMassFlow / CycRatio
IF (FanOpMode .EQ. ContFanCycCoil) AirMassFlow = MSHPMassFlowRateLow
!
! Check for valid air volume flow per rated total cooling capacity (200 - 600 cfm/ton)
!
AirVolumeFlowRate = AirMassFlow/PsyRhoAirFnPbTdbW(OutdoorPressure,InletAirDryBulbTemp, InletAirHumRat,RoutineName)
! Eventually inlet air conditions will be used in DX Coil, these lines are commented out and marked with this comment line
! AirVolumeFlowRate = AirMassFlow/PsyRhoAirFnPbTdbW(InletAirPressure,InletAirDryBulbTemp, InletAirHumRat)
VolFlowperRatedTotCap = AirVolumeFlowRate/DXCoil(DXCoilNum)%MSRatedTotCap(SpeedNumLS)
IF ((VolFlowperRatedTotCap.LT.MinOperVolFlowPerRatedTotCap(DXCT)).OR. &
(VolFlowperRatedTotCap.GT.MaxHeatVolFlowPerRatedTotCap(DXCT))) THEN
IF (DXCoil(DXCoilNum)%ErrIndex1 == 0) THEN
CALL ShowWarningMessage(TRIM(DXCoil(DXCoilNum)%DXCoilType)//' "'//TRIM(DXCoil(DXCoilNum)%Name)//&
'" - Air volume flow rate per watt of rated total heating capacity is out of range at speed 1.')
CALL ShowContinueErrorTimeStamp(' ')
CALL ShowContinueError('Expected range for VolumeFlowPerRatedTotalCapacity=['// &
TRIM(RoundSigDigits(MinOperVolFlowPerRatedTotCap(DXCT),3))//'--'// &
TRIM(RoundSigDigits(MaxHeatVolFlowPerRatedTotCap(DXCT),3))//']')
CALL ShowContinueError('Possible causes include inconsistent air flow rates in system components or')
CALL ShowContinueError('inconsistent supply air fan operation modes in coil and unitary system objects.')
END IF
CALL ShowRecurringWarningErrorAtEnd(TRIM(DXCoil(DXCoilNum)%DXCoilType)//' "'//TRIM(DXCoil(DXCoilNum)%Name)//&
'" - Air volume flow rate per watt of rated total heating capacity is out ' //&
'of range error continues at speed 1...', &
DXCoil(DXCoilNum)%ErrIndex1,ReportMinOf=VolFlowperRatedTotCap,ReportMaxOf=VolFlowperRatedTotCap)
END IF
! Get total capacity modifying factor (function of temperature) for off-rated conditions
! Model was extended to accept bi-quadratic curves. This allows sensitivity of the heating capacity
! to the entering dry-bulb temperature as well as the outside dry-bulb temperature. User is
! advised to use the bi-quaratic curve if sufficient manufacturer data is available.
IF ((DXCoil(DXCoilNum)%MSTotCapTempModFacCurveType(SpeedNumLS) == Quadratic).OR. &
(DXCoil(DXCoilNum)%MSTotCapTempModFacCurveType(SpeedNumLS) == Cubic)) THEN
TotCapTempModFac = CurveValue(DXCoil(DXCoilNum)%MSCCapFTemp(SpeedNumLS),OutdoorDryBulb)
ELSEIF (DXCoil(DXCoilNum)%MSTotCapTempModFacCurveType(SpeedNumLS) == Biquadratic) THEN
TotCapTempModFac = CurveValue(DXCoil(DXCoilNum)%MSCCapFTemp(SpeedNumLS),InletAirDryBulbTemp,OutdoorDryBulb)
END IF
! Get total capacity modifying factor (function of mass flow) for off-rated conditions
! AirMassFlowRatio = AirMassFlow/DXCoil(DXCoilNum)%MSRatedAirMassFlowRate(SpeedNumLS)
! TotCapFlowModFac = CurveValue(DXCoil(DXCoilNum)%MSCCapFFlow(SpeedNumLS),AirMassFlowRatio)
TotCapFlowModFac = CurveValue(DXCoil(DXCoilNum)%MSCCapFFlow(SpeedNumLS),AirMassFlowRatioLS)
! Calculate total heating capacity for off-rated conditions
TotCap = DXCoil(DXCoilNum)%MSRatedTotCap(SpeedNumLS) * TotCapFlowModFac * TotCapTempModFac
! Calculating adjustment factors for defrost
! Calculate delta w through outdoor coil by assuming a coil temp of 0.82*DBT-9.7(F) per DOE2.1E
OutdoorCoilT = 0.82d0 * OutdoorDryBulb - 8.589d0
OutdoorCoildw = MAX(1.0d-6,(OutdoorHumRat - PsyWFnTdpPb(OutdoorCoilT,OutdoorPressure,RoutineName)))
! Initializing defrost adjustment factors
LoadDueToDefrost = 0.0d0
HeatingCapacityMultiplier = 1.0d0
FractionalDefrostTime = 0.0d0
InputPowerMultiplier = 1.0d0
! Check outdoor temperature to determine of defrost is active
IF (OutdoorDryBulb .LE. DXCoil(DXCoilNum)%MaxOATDefrost) THEN
! Calculate defrost adjustment factors depending on defrost control type
IF (DXCoil(DXCoilNum)%DefrostControl .EQ. Timed) THEN
FractionalDefrostTime = DXCoil(DXCoilNum)%DefrostTime
IF(FractionalDefrostTime .GT. 0.d0)THEN
HeatingCapacityMultiplier = 0.909d0 - 107.33d0 * OutdoorCoildw
InputPowerMultiplier = 0.90d0 - 36.45d0*OutdoorCoildw
END IF
ELSE !else defrost control is on-demand
FractionalDefrostTime = 1.0d0 / (1.0d0 + 0.01446d0 / OutdoorCoildw)
HeatingCapacityMultiplier = 0.875d0 * ( 1.0d0 - FractionalDefrostTime)
InputPowerMultiplier = 0.954d0 * ( 1.0d0 - FractionalDefrostTime)
END IF
IF (FractionalDefrostTime .GT. 0.0d0) THEN
! Calculate defrost adjustment factors depending on defrost control strategy
IF (DXCoil(DXCoilNum)%DefrostStrategy .EQ. ReverseCycle) THEN
LoadDueToDefrost = (0.01d0 * FractionalDefrostTime) * &
(7.222d0 - OutdoorDryBulb) * &
(DXCoil(DXCoilNum)%MSRatedTotCap(1)/1.01667d0)
DefrostEIRTempModFac = CurveValue(DXCoil(DXCoilNum)%DefrostEIRFT,&
MAX(15.555d0,InletAirWetbulbC),MAX(15.555d0,OutdoorDryBulb))
DXCoil(DXCoilNum)%DefrostPower = DefrostEIRTempModFac * &
(DXCoil(DXCoilNum)%MSRatedTotCap(1)/1.01667d0) &
* FractionalDefrostTime
ELSE ! Defrost strategy is resistive
DXCoil(DXCoilNum)%DefrostPower = DXCoil(DXCoilNum)%DefrostCapacity &
* FractionalDefrostTime
END IF
ELSE ! Defrost is not active because (OutDryBulbTemp .GT. DXCoil(DXCoilNum)%MaxOATDefrost)
DXCoil(DXCoilNum)%DefrostPower = 0.0d0
END IF
END IF
! Modify total heating capacity based on defrost heating capacity multiplier
TotCap = TotCap * HeatingCapacityMultiplier
! Calculate full load outlet conditions
FullLoadOutAirEnth = InletAirEnthalpy + TotCap/AirMassFlow
FullLoadOutAirHumRat = InletAirHumRat
FullLoadOutAirTemp = PsyTdbFnHW(FullLoadOutAirEnth,FullLoadOutAirHumRat,RoutineName)
FullLoadOutAirRH = PsyRhFnTdbWPb(FullLoadOutAirTemp,FullLoadOutAirHumRat,OutdoorPressure,RoutineName//':fullload')
! Eventually inlet air conditions will be used in DX Coil, these lines are commented out and marked with this comment line
! FullLoadOutAirRH = PsyRhFnTdbWPb(FullLoadOutAirTemp,FullLoadOutAirHumRat,InletAirPressure)
IF (FullLoadOutAirRH .gt. 1.d0) THEN ! Limit to saturated conditions at FullLoadOutAirEnth
FullLoadOutAirTemp = PsyTsatFnHPb(FullLoadOutAirEnth,OutdoorPressure,RoutineName)
! Eventually inlet air conditions will be used in DX Coil, these lines are commented out and marked with this comment line
! FullLoadOutAirTemp = PsyTsatFnHPb(FullLoadOutAirEnth,InletAirPressure)
FullLoadOutAirHumRat = PsyWFnTdbH(FullLoadOutAirTemp,FullLoadOutAirEnth,RoutineName)
END IF
! Set outlet conditions from the full load calculation
OutletAirEnthalpy = FullLoadOutAirEnth
OutletAirHumRat = FullLoadOutAirHumRat
OutletAirTemp = FullLoadOutAirTemp
! Calculate electricity consumed. First, get EIR modifying factors for off-rated conditions
! Model was extended to accept bi-quadratic curves. This allows sensitivity of the EIR
! to the entering dry-bulb temperature as well as the outside dry-bulb temperature. User is
! advised to use the bi-quaratic curve if sufficient manufacturer data is available.
IF ((DXCoil(DXCoilNum)%MSEIRTempModFacCurveType(1) == Quadratic).OR. &
(DXCoil(DXCoilNum)%MSEIRTempModFacCurveType(1) == Cubic)) THEN
EIRTempModFac = CurveValue(DXCoil(DXCoilNum)%MSEIRFTemp(1),OutdoorDryBulb)
ELSEIF (DXCoil(DXCoilNum)%MSEIRTempModFacCurveType(1) == Biquadratic) THEN
EIRTempModFac = CurveValue(DXCoil(DXCoilNum)%MSEIRFTemp(1),InletAirDryBulbTemp,OutdoorDryBulb)
END IF
EIRFlowModFac = CurveValue(DXCoil(DXCoilNum)%MSEIRFFlow(1), AirMassFlowRatioLS)
EIR = 1.0d0/DXCoil(DXCoilNum)%MSRatedCOP(1) * EIRTempModFac * EIRFlowModFac
! Calculate modified PartLoadRatio due to defrost (reverse-cycle defrost only)
PLRHeating = MIN(1.0d0,(CycRatio + LoadDueToDefrost/TotCap))
PLF = CurveValue(DXCoil(DXCoilNum)%MSPLFFPLR(1),PLRHeating) ! Calculate part-load factor
IF (FanOpMode .EQ. CycFanCycCoil .AND. CycRatio .EQ. 1.0d0 .AND. PLF .NE. 1.0d0) Then
IF (DXCoil(DXCoilNum)%PLFErrIndex == 0) THEN
CALL ShowWarningMessage('The PLF curve value for DX heating coil '//TRIM(DXCoil(DXCoilNum)%Name)//&
' ='//TRIM(RoundSigDigits(PLF,2))//' for part-load ratio = 1')
CALL ShowContinueError('PLF curve value must be = 1.0 and has been reset to 1.0. Simulation is continuing.')
CALL ShowContinueErrorTimeStamp(' ')
END IF
CALL ShowRecurringWarningErrorAtEnd(TRIM(DXCoil(DXCoilNum)%Name)//'":'//&
' DX heating coil PLF curve value <> 1.0 warning continues...' &
, DXCoil(DXCoilNum)%PLFErrIndex, PLF, PLF)
PLF = 1.0d0
END IF
IF (PLF < 0.7d0) THEN
IF (DXCoil(DXCoilNum)%PLRErrIndex == 0) THEN
CALL ShowWarningMessage('The PLF curve value for DX heating coil '//TRIM(DXCoil(DXCoilNum)%Name)//&
' ='//TRIM(RoundSigDigits(PLF,2))// &
' for part-load ratio ='//TRIM(RoundSigDigits(PLRHeating,2)))
CALL ShowContinueError('PLF curve values must be >= 0.7. PLF has been reset to 0.7 and simulation is continuing.')
CALL ShowContinueError('Check the IO reference manual for PLF curve guidance [Coil:Heating:DX:SingleSpeed].')
CALL ShowContinueErrorTimeStamp(' ')
END IF
CALL ShowRecurringWarningErrorAtEnd('DX heating coil PLF curve < 0.7 warning continues... ', &
DXCoil(DXCoilNum)%PLRErrIndex,ReportMinOf=PLF,ReportMaxOf=PLF)
PLF = 0.7d0
END IF
DXCoil(DXCoilNum)%HeatingCoilRuntimeFraction = (PLRHeating / PLF)
IF (DXCoil(DXCoilNum)%HeatingCoilRuntimeFraction > 1.0d0 .and. &
ABS(DXCoil(DXCoilNum)%HeatingCoilRuntimeFraction-1.0d0) > .001d0 ) THEN
IF (DXCoil(DXCoilNum)%ErrIndex4 == 0) THEN
CALL ShowWarningMessage('The runtime fraction for DX heating coil '//TRIM(DXCoil(DXCoilNum)%Name)//&
' exceeded 1.0. ['//TRIM(RoundSigDigits(DXCoil(DXCoilNum)%HeatingCoilRuntimeFraction,4))//'].')
CALL ShowContinueError('Runtime fraction is set to 1.0 and the simulation continues...')
CALL ShowContinueError('Check the IO reference manual for PLF curve guidance [Coil:Heating:DX:SingleSpeed].')
CALL ShowContinueErrorTimeStamp(' ')
END IF
CALL ShowRecurringWarningErrorAtEnd(TRIM(DXCoil(DXCoilNum)%Name)// &
', DX heating coil runtime fraction > 1.0 warning continues...', &
DXCoil(DXCoilNum)%ErrIndex4,DXCoil(DXCoilNum)%HeatingCoilRuntimeFraction,DXCoil(DXCoilNum)%HeatingCoilRuntimeFraction)
DXCoil(DXCoilNum)%HeatingCoilRuntimeFraction = 1.0d0 ! Reset coil runtime fraction to 1.0
ELSEIF (DXCoil(DXCoilNum)%HeatingCoilRuntimeFraction > 1.0d0) THEN
DXCoil(DXCoilNum)%HeatingCoilRuntimeFraction = 1.0d0 ! Reset coil runtime fraction to 1.0
END IF
! if cycling fan, send coil part-load fraction to on/off fan via HVACDataGlobals
IF (FanOpMode .EQ. CycFanCycCoil) OnOffFanPartLoadFraction = PLF
DXCoil(DXCoilNum)%ElecHeatingPower = TotCap * EIR * DXCoil(DXCoilNum)%HeatingCoilRuntimeFraction * InputPowerMultiplier
! Calculate crankcase heater power using the runtime fraction for this DX heating coil only if there is no companion DX coil.
! Else use the largest runtime fraction of this DX heating coil and the companion DX cooling coil.
IF(DXCoil(DXCoilNum)%CompanionUpstreamDXCoil .EQ. 0) THEN
DXCoil(DXCoilNum)%CrankcaseHeaterPower = CrankcaseHeatingPower * &
(1.0d0 - DXCoil(DXCoilNum)%HeatingCoilRuntimeFraction)
ELSE
DXCoil(DXCoilNum)%CrankcaseHeaterPower = CrankcaseHeatingPower * &
(1.0d0 - MAX(DXCoil(DXCoilNum)%HeatingCoilRuntimeFraction, &
DXCoil(DXCoil(DXCoilNum)%CompanionUpstreamDXCoil)%CoolingCoilRuntimeFraction))
END IF
DXCoil(DXCoilNum)%TotalHeatingEnergyRate = AirMassFlow * (FullLoadOutAirEnth - InletAirEnthalpy)*CycRatio
IF (FanOpMode .EQ. ContFanCycCoil) THEN
OutletAirEnthalpy = InletAirEnthalpy+DXCoil(DXCoilNum)%TotalHeatingEnergyRate/DXCoil(DXCoilNum)%InletAirMassFlowRate
OutletAirTemp = PsyTdbFnHW(OutletAirEnthalpy,OutletAirHumRat,RoutineName)
END IF
MSHPWasteHeat = CurveValue(DXCoil(DXCoilNum)%MSWasteHeat(SpeedNumLS),OutdoorDryBulb,InletAirDryBulbTemp) * &
DXCoil(DXCoilNum)%MSWasteHeatFrac(SpeedNumLS)*DXCoil(DXCoilNum)%ElecHeatingPower
If (DXCoil(DXCoilNum)%FuelType .NE. FuelTypeElectricity) Then
DXCoil(DXCoilNum)%FuelUsed = DXCoil(DXCoilNum)%ElecHeatingPower
DXCoil(DXCoilNum)%ElecHeatingPower = 0.0d0
End If
! Adjust defrost power to correct for DOE-2 bug where defrost power is constant regardless of compressor runtime fraction
! Defrosts happen based on compressor run time (frost buildup on outdoor coil), not total elapsed time.
DXCoil(DXCoilNum)%DefrostPower = DXCoil(DXCoilNum)%DefrostPower * DXCoil(DXCoilNum)%HeatingCoilRuntimeFraction
DXCoil(DXCoilNum)%OutletAirTemp = OutletAirTemp
DXCoil(DXCoilNum)%OutletAirHumRat = OutletAirHumRat
DXCoil(DXCoilNum)%OutletAirEnthalpy = OutletAirEnthalpy
End If
ELSE
! DX coil is off; just pass through conditions
DXCoil(DXCoilNum)%OutletAirEnthalpy = DXCoil(DXCoilNum)%InletAirEnthalpy
DXCoil(DXCoilNum)%OutletAirHumRat = DXCoil(DXCoilNum)%InletAirHumRat
DXCoil(DXCoilNum)%OutletAirTemp = DXCoil(DXCoilNum)%InletAirTemp
DXCoil(DXCoilNum)%ElecHeatingPower = 0.0d0
DXCoil(DXCoilNum)%FuelUsed = 0.0d0
DXCoil(DXCoilNum)%TotalHeatingEnergyRate = 0.0d0
DXCoil(DXCoilNum)%DefrostPower = 0.0d0
! Calculate crankcase heater power using the runtime fraction for this DX heating coil (here DXHeatingCoilRTF=0) if
! there is no companion DX coil, or the runtime fraction of the companion DX cooling coil (here DXCoolingCoilRTF>=0).
IF(DXCoil(DXCoilNum)%CompanionUpstreamDXCoil .EQ. 0) THEN
DXCoil(DXCoilNum)%CrankcaseHeaterPower = CrankcaseHeatingPower
ELSE
DXCoil(DXCoilNum)%CrankcaseHeaterPower = CrankcaseHeatingPower * &
(1.d0-DXCoil(DXCoil(DXCoilNum)%CompanionUpstreamDXCoil)%CoolingCoilRuntimeFraction)
END IF
END IF ! end of on/off if - else
DXCoilOutletTemp(DXCoilNum) = DXCoil(DXCoilNum)%OutletAirTemp
DXCoilOutletHumRat(DXCoilNum) = DXCoil(DXCoilNum)%OutletAirHumRat
DXCoil(DXCoilNum)%PartLoadRatio = PLRHeating
DXCoilFanOpMode(DXCoilNum) = FanOpMode
DXCoilPartLoadRatio(DXCoilNum) = PLRHeating
RETURN
END SUBROUTINE CalcMultiSpeedDXCoilHeating