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) | :: | DXCoilNum | |||
real(kind=r64), | intent(in) | :: | PartLoadRatio | |||
integer, | intent(in) | :: | FanOpMode | |||
real(kind=r64), | intent(in), | optional | :: | OnOffAirFlowRatio | ||
real(kind=r64), | intent(in), | optional | :: | MaxHeatCap |
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 CalcDXHeatingCoil(DXCoilNum,PartLoadRatio, FanOpMode, OnOffAirFlowRatio, MaxHeatCap)
! SUBROUTINE INFORMATION:
! AUTHOR Richard Raustad
! DATE WRITTEN October 2001
! MODIFIED Raustad/Shirey Mar 2004
! Kenneth Tang 2004 (Sensitivity of TotCapTempModFac & EIRTempModFac to indoor dry bulb temp)
! Feb 2005 M. J. Witte, GARD Analytics, Inc.
! Add new coil type COIL:DX:MultiMode:CoolingEmpirical:
! RE-ENGINEERED na
! PURPOSE OF THIS SUBROUTINE:
! Calculates the air-side heating performance and electrical heating energy
! use of a direct-expansion, air-cooled heat pump unit.
! METHODOLOGY EMPLOYED:
! This routine simulates the performance of air-cooled DX heating equipment.
! The routine requires the user to enter the total heating capacity
! and COP for the unit at ARI 210/240 rating conditions (21.11C [70F] dry-bulb,
! 15.55C [60F] wet-bulb air entering the heating coil, 8.33C [47F] dry-bulb,
! 6.11C [43F] wet-bulb air entering the outdoor condenser. Since different
! manufacturer's rate their equipment at different air flow rates, the supply
! air flow rate corresponding to the rated capacities and rated COP must also
! be entered (should be between 300 cfm/ton and 450 cfm/ton). The rated information
! entered by the user should NOT include the thermal or electrical impacts of the
! supply air fan, as this is addressed by another module.
! With the rated performance data entered by the user, the model employs some of the
! DOE-2.1E curve fits to adjust the capacity and efficiency of the unit as a function
! of outdoor air temperatures and supply air flow rate (actual vs rated flow). The
! model does NOT employ the exact same methodology to calculate performance as DOE-2,
! although some of the DOE-2 curve fits are employed by this model.
! REFERENCES:
!
! Winkelmann, F.C., Birdsall, B.E., Buhl W.F., Ellington, K.L., Erdem, A.E. 1993.
! DOE-2 Supplement Version 2.1E. Energy and Environment Division, Larwence Berkely
! Laboratory.
!
! Henderson, H.I. Jr., Y.J. Huang and Danny Parker. 1999. Residential Equipment Part
! Load Curves for Use in DOE-2. Environmental Energy Technologies Division, Ernest
! Orlando Lawrence Berkeley National Laboratory.
! USE STATEMENTS:
USE CurveManager, ONLY: CurveValue
USE General, ONLY: RoundSigDigits
IMPLICIT NONE ! Enforce explicit typing of all variables in this routine
! SUBROUTINE ARGUMENT DEFINITIONS:
INTEGER, INTENT(IN) :: DXCoilNum ! the number of the DX heating coil to be simulated
REAL(r64), INTENT(IN) :: PartLoadRatio ! sensible cooling load / full load sensible cooling capacity
INTEGER, INTENT(IN) :: FanOpMode ! Allows parent object to control fan mode
REAL(r64), INTENT(IN), OPTIONAL :: OnOffAirFlowRatio ! ratio of compressor on airflow to compressor off airflow
REAL(r64), INTENT(IN), OPTIONAL :: MaxHeatCap ! maximum allowed heating capacity
! SUBROUTINE PARAMETER DEFINITIONS:
CHARACTER(len=*), PARAMETER :: RoutineName='CalcDXHeatingCoil'
! 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) :: AirMassFlowRatio ! Ratio of actual air mass flow to rated air mass flow
REAL(r64) :: AirVolumeFlowRate ! Air volume flow rate across the cooling coil [m3/s]
REAL(r64) :: VolFlowperRatedTotCap ! Air volume flow rate divided by rated total cooling capacity [m3/s-W]
REAL(r64) :: TotCap ! gross total cooling capacity at off-rated conditions [W]
REAL(r64) :: TotCapTempModFac ! Total capacity modifier (function of entering drybulb, outside drybulb) depending
! on the type of curve
REAL(r64) :: TotCapFlowModFac ! Total capacity modifier (function of actual supply air flow vs rated flow)
REAL(r64) :: InletAirDryBulbTemp ! inlet air dry bulb temperature [C]
REAL(r64) :: InletAirWetBulbC ! wetbulb temperature of inlet air [C]
REAL(r64) :: InletAirEnthalpy ! inlet air enthalpy [J/kg]
REAL(r64) :: InletAirHumRat ! inlet air humidity ratio [kg/kg]
! Eventually inlet air conditions will be used in DX Coil, these lines are commented out and marked with this comment line
!REAL(r64) :: InletAirPressure ! inlet air pressure [Pa]
REAL(r64) :: FullLoadOutAirEnth ! outlet full load enthalpy [J/kg]
REAL(r64) :: FullLoadOutAirHumRat ! outlet humidity ratio at full load
REAL(r64) :: FullLoadOutAirTemp ! outlet air temperature at full load [C]
REAL(r64) :: FullLoadOutAirRH ! outlet air relative humidity at full load
REAL(r64) :: EIRTempModFac ! EIR modifier (function of entering drybulb, outside drybulb) depending on the
! type of curve
REAL(r64) :: DefrostEIRTempModFac ! EIR modifier for defrost (function of entering wetbulb, outside drybulb)
REAL(r64) :: EIRFlowModFac ! EIR modifier (function of actual supply air flow vs rated flow)
REAL(r64) :: EIR ! EIR at part load and off rated conditions
REAL(r64) :: PLF ! Part load factor, accounts for thermal lag at compressor startup
REAL(r64) :: PLRHeating ! PartLoadRatio in heating
REAL(r64) :: OutdoorCoilT ! Outdoor coil temperature (C)
REAL(r64) :: OutdoorCoildw ! Outdoor coil delta w assuming coil temp of OutdoorCoilT (kg/kg)
REAL(r64) :: FractionalDefrostTime ! Fraction of time step system is in defrost
REAL(r64) :: HeatingCapacityMultiplier ! Multiplier for heating capacity when system is in defrost
REAL(r64) :: InputPowerMultiplier ! Multiplier for power when system is in defrost
REAL(r64) :: LoadDueToDefrost ! Additional load due to defrost
REAL(r64) :: CrankcaseHeatingPower ! power due to crankcase heater
REAL(r64) :: OutdoorDryBulb ! Outdoor dry-bulb temperature at condenser (C)
REAL(r64) :: OutdoorWetBulb ! Outdoor wet-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 :: Mode=1 ! Performance mode for MultiMode DX coil; Always 1 for other coil types
REAL(r64) :: AirFlowRatio ! Ratio of compressor on airflow to average timestep airflow
REAL(r64) :: OutletAirTemp ! Supply air temperature (average value if constant fan, full output if cycling fan)
REAL(r64) :: OutletAirHumRat ! Supply air humidity ratio (average value if constant fan, full output if cycling fan)
REAL(r64) :: OutletAirEnthalpy ! Supply air enthalpy (average value if constant fan, full output if cycling fan)
IF (PRESENT(OnOffAirFlowRatio)) THEN
AirFlowRatio = OnOffAirFlowRatio
ELSE
AirFlowRatio = 1.0d0
END IF
! Get condenser outdoor node info from DX Heating Coil
IF (DXCoil(DXCoilNum)%CondenserInletNodeNum(1) /= 0) THEN
OutdoorDryBulb = Node(DXCoil(DXCoilNum)%CondenserInletNodeNum(1))%Temp
IF (DXCoil(DXCoilNum)%CondenserType(Mode) == WaterCooled)THEN
OutdoorHumRat = OutHumRat
OutdoorPressure = OutBaroPress
OutdoorWetBulb = OutWetBulbTemp
ELSE
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
OutdoorWetBulb = OutWetBulbTemp
ELSE
OutdoorHumRat = Node(DXCoil(DXCoilNum)%CondenserInletNodeNum(1))%HumRat
! this should use Node%WetBulbTemp or a PSYC function, not OAWB
OutdoorWetBulb = Node(DXCoil(DXCoilNum)%CondenserInletNodeNum(1))%OutAirWetBulb
END IF
END IF
ELSE
OutdoorDryBulb = OutDryBulbTemp
OutdoorHumRat = OutHumRat
OutdoorPressure = OutBaroPress
OutdoorWetBulb = OutWetBulbTemp
ENDIF
AirMassFlow = DXCoil(DXCoilNum)%InletAirMassFlowRate
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)
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
IF((AirMassFlow .GT. 0.0d0) .AND. &
(GetCurrentScheduleValue(DXCoil(DXCoilNum)%SchedPtr) .GT. 0.0d0) .AND. &
(PartLoadRatio .GT. 0.0d0) .AND. OutdoorDryBulb .GT. DXCoil(DXCoilNum)%MinOATCompressor) THEN
! for cycling fan, reset mass flow to full on rate
IF (FanOpMode .EQ. CycFanCycCoil) AirMassFlow = AirMassFlow / PartLoadRatio
IF (FanOpMode .EQ. ContFanCycCoil) AirMassFlow = AirMassFlow * AirFlowRatio
!
! Check for valid air volume flow per rated total cooling capacity (200 - 600 cfm/ton)
!
AirVolumeFlowRate = AirMassFlow/PsyRhoAirFnPbTdbW(OutdoorPressure,InletAirDryBulbTemp, InletAirHumRat)
! 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)%RatedTotCap(Mode)
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 '// &
TRIM(RoundSigDigits(VolFlowperRatedTotCap,3))//' m3/s/W.')
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.')
ENDIF
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...',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)%TotCapTempModFacCurveType(Mode) == Biquadratic) THEN
SELECT CASE(DXCoil(DXCoilNum)%HeatingPerformanceOATType)
CASE(DryBulbIndicator)
TotCapTempModFac = CurveValue(DXCoil(DXCoilNum)%CCapFTemp(Mode),InletAirDryBulbTemp,OutdoorDryBulb)
CASE(WetBulbIndicator)
TotCapTempModFac = CurveValue(DXCoil(DXCoilNum)%CCapFTemp(Mode),InletAirDryBulbTemp,OutdoorWetBulb)
CASE DEFAULT
TotCapTempModFac = 1.d0
END SELECT
ELSE
SELECT CASE(DXCoil(DXCoilNum)%HeatingPerformanceOATType)
CASE(DryBulbIndicator)
IF(DXCoil(DXCoilNum)%DXCoilType_Num /= CoilVRF_Heating)THEN
TotCapTempModFac = CurveValue(DXCoil(DXCoilNum)%CCapFTemp(Mode),OutdoorDryBulb)
ELSE
TotCapTempModFac = CurveValue(DXCoil(DXCoilNum)%CCapFTemp(Mode),InletAirDryBulbTemp)
END IF
CASE(WetBulbIndicator)
IF(DXCoil(DXCoilNum)%DXCoilType_Num /= CoilVRF_Heating)THEN
TotCapTempModFac = CurveValue(DXCoil(DXCoilNum)%CCapFTemp(Mode),OutdoorWetBulb)
ELSE
TotCapTempModFac = CurveValue(DXCoil(DXCoilNum)%CCapFTemp(Mode),InletAirDryBulbTemp)
END IF
CASE DEFAULT
TotCapTempModFac = 1.d0
END SELECT
END IF
! Get total capacity modifying factor (function of mass flow) for off-rated conditions
AirMassFlowRatio = AirMassFlow/DXCoil(DXCoilNum)%RatedAirMassFlowRate(Mode)
TotCapFlowModFac = CurveValue(DXCoil(DXCoilNum)%CCapFFlow(Mode),AirMassFlowRatio)
! Calculate total heating capacity for off-rated conditions
TotCap = DXCoil(DXCoilNum)%RatedTotCap(Mode) * 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)))
! 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)%RatedTotCap(Mode)/1.01667d0)
DefrostEIRTempModFac = CurveValue(DXCoil(DXCoilNum)%DefrostEIRFT,&
MAX(15.555d0,InletAirWetbulbC),MAX(15.555d0,OutdoorDryBulb))
DXCoil(DXCoilNum)%DefrostPower = DefrostEIRTempModFac * &
(DXCoil(DXCoilNum)%RatedTotCap(Mode)/1.01667d0) &
* FractionalDefrostTime
ELSE ! Defrost strategy is resistive
DXCoil(DXCoilNum)%DefrostPower = DXCoil(DXCoilNum)%DefrostCapacity &
* FractionalDefrostTime
END IF
ELSE ! Defrost is not active because (FractionalDefrostTime .EQ. 0.0)
DXCoil(DXCoilNum)%DefrostPower = 0.0d0
END IF
END IF
! Modify total heating capacity based on defrost heating capacity multiplier
! MaxHeatCap passed from parent object VRF Condenser and is used to limit capacity of TU's to that available from condenser
IF(PRESENT(MaxHeatCap))THEN
TotCap = MIN(MaxHeatCap,TotCap * HeatingCapacityMultiplier)
ELSE
TotCap = TotCap * HeatingCapacityMultiplier
END IF
! Calculate full load outlet conditions
FullLoadOutAirEnth = InletAirEnthalpy + TotCap/AirMassFlow
FullLoadOutAirHumRat = InletAirHumRat
FullLoadOutAirTemp = PsyTdbFnHW(FullLoadOutAirEnth,FullLoadOutAirHumRat)
FullLoadOutAirRH = PsyRhFnTdbWPb(FullLoadOutAirTemp,FullLoadOutAirHumRat,OutdoorPressure,'CalcDXHeatingCoil: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.0d0) THEN ! Limit to saturated conditions at FullLoadOutAirEnth
FullLoadOutAirTemp = PsyTsatFnHPb(FullLoadOutAirEnth,OutdoorPressure)
! 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)
END IF
! Calculate actual outlet conditions for the input part load ratio
! Actual outlet conditions are "average" for time step
IF (FanOpMode .EQ. ContFanCycCoil) THEN
! continuous fan, cycling compressor
OutletAirEnthalpy = ((PartLoadRatio * AirFlowRatio)*FullLoadOutAirEnth + &
(1.0d0-(PartLoadRatio * AirFlowRatio))*InletAirEnthalpy)
OutletAirHumRat = (PartLoadRatio*FullLoadOutAirHumRat + (1.0d0-PartLoadRatio)*InletAirHumRat)
OutletAirTemp = PsyTdbFnHW(OutletAirEnthalpy,OutletAirHumRat)
ELSE
! default to cycling fan, cycling compressor
OutletAirEnthalpy = FullLoadOutAirEnth
OutletAirHumRat = FullLoadOutAirHumRat
OutletAirTemp = FullLoadOutAirTemp
END IF
! 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)%DXCoilType_Num /= CoilVRF_Heating)THEN
IF ((DXCoil(DXCoilNum)%EIRTempModFacCurveType(1) == Quadratic).OR.(DXCoil(DXCoilNum)%EIRTempModFacCurveType(1) == Cubic)) THEN
EIRTempModFac = CurveValue(DXCoil(DXCoilNum)%EIRFTemp(Mode),OutdoorDryBulb)
ELSEIF (DXCoil(DXCoilNum)%EIRTempModFacCurveType(1) == Biquadratic) THEN
EIRTempModFac = CurveValue(DXCoil(DXCoilNum)%EIRFTemp(Mode),InletAirDryBulbTemp,OutdoorDryBulb)
END IF
EIRFlowModFac = CurveValue(DXCoil(DXCoilNum)%EIRFFlow(Mode), AirMassFlowRatio)
ELSE
EIRTempModFac = 1.0d0
EIRFlowModFac = 1.0d0
END IF
EIR = DXCoil(DXCoilNum)%RatedEIR(Mode) * EIRTempModFac * EIRFlowModFac
! Calculate modified PartLoadRatio due to defrost (reverse-cycle defrost only)
PLRHeating = MIN(1.0d0,(PartLoadRatio + LoadDueToDefrost/TotCap))
IF(DXCoil(DXCoilNum)%DXCoilType_Num /= CoilVRF_Heating)THEN
PLF = CurveValue(DXCoil(DXCoilNum)%PLFFPLR(Mode),PLRHeating) ! Calculate part-load factor
ELSE
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(' ')
ENDIF
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(' ')
ENDIF
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
AirMassFlow = DXCoil(DXCoilNum)%InletAirMassFlowRate
DXCoil(DXCoilNum)%TotalHeatingEnergyRate = AirMassFlow * (OutletAirEnthalpy - InletAirEnthalpy)
! 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
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)%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
DXCoilFanOpMode(DXCoilNum) = FanOpMode
DXCoilPartLoadRatio(DXCoilNum) = PLRHeating
DXCoilTotalHeating(DXCoilNum) = DXCoil(DXCoilNum)%TotalHeatingEnergyRate
DXCoilHeatInletAirDBTemp(DXCoilNum) = InletAirDryBulbTemp
DXCoilHeatInletAirWBTemp(DXCoilNum) = InletAirWetbulbC
RETURN
END SUBROUTINE CalcDXHeatingCoil