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) | :: | DXSystemNum | |||
logical, | intent(in) | :: | FirstHVACIteration |
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 ControlDXHeatingSystem(DXSystemNum, FirstHVACIteration )
! SUBROUTINE INFORMATION:
! AUTHOR Brent Griffith (derived from ControlDXSystem by Richard Liesen)
! DATE WRITTEN Jan 2012
! MODIFIED Richard Raustad, FSEC Nov 2003
! Feb 2005 M. J. Witte, GARD Analytics, Inc.
! Add dehumidification controls and support for multimode DX coil
! Jan 2008 R. Raustad, FSEC. Added coolreheat to all coil types
! Feb 2013, Bo Shen, Oak Ridge National Lab
! Add Coil:Heating:DX:VariableSpeed
! RE-ENGINEERED na
! PURPOSE OF THIS SUBROUTINE:
! This subroutine updates the System outlet nodes.
! METHODOLOGY EMPLOYED:
! Data is moved from the System data structure to the System outlet nodes.
! REFERENCES:
! na
! USE STATEMENTS:
USE ScheduleManager
USE DataEnvironment, ONLY: OutBaroPress
USE DataHVACGlobals, ONLY: TempControlTol
USE InputProcessor, ONLY: FindItemInList
USE Psychrometrics , ONLY: PsyHFnTdbW, PsyTdpFnWPb
USE General, ONLY: SolveRegulaFalsi, RoundSigDigits
USE DXCoils, ONLY: SimDXCoil, DXCoilOutletTemp
USE VariableSpeedCoils, ONLY: SimVariableSpeedCoils, VarSpeedCoil
IMPLICIT NONE ! Enforce explicit typing of all variables in this routine
! SUBROUTINE ARGUMENT DEFINITIONS:
INTEGER, INTENT(In) :: DXSystemNum ! index to DXSystem
LOGICAL, INTENT(In) :: FirstHVACIteration ! First HVAC iteration flag
! SUBROUTINE PARAMETER DEFINITIONS:
INTEGER, PARAMETER :: MaxIte = 500 ! Maximum number of iterations for solver
REAL(r64), PARAMETER :: Acc = 1.d-3 ! Accuracy of solver result
REAL(r64), PARAMETER :: HumRatAcc = 1.d-6 ! Accuracy of solver result
! INTERFACE BLOCK SPECIFICATIONS
! na
! DERIVED TYPE DEFINITIONS
! na
! SUBROUTINE LOCAL VARIABLE DECLARATIONS:
CHARACTER(len=MaxNameLength) :: CompName ! Name of the DX cooling coil
REAL(r64) :: NoOutput ! Sensible capacity (outlet - inlet) when the compressor is off
REAL(r64) :: FullOutput ! Sensible capacity (outlet - inlet) when the compressor is on
REAL(r64) :: ReqOutput ! Sensible capacity (outlet - inlet) required to meet load or set point temperature
Integer :: InletNode ! Inlet node number of the DX cooling coil
Integer :: OutletNode ! Outlet node number of the DX cooling coil
Integer :: ControlNode ! The node number where a set point is placed to control the DX cooling coil
REAL(r64) :: PartLoadFrac ! The part-load fraction of the compressor
REAL(r64) :: DesOutTemp ! Desired outlet temperature of the DX cooling coil
REAL(r64) :: OutletTempDXCoil ! Actual outlet temperature of the DX cooling coil
INTEGER :: SolFla ! Flag of solver
REAL(r64), DIMENSION(5) :: Par ! Parameter array passed to solver
LOGICAL :: SensibleLoad ! True if there is a sensible cooling load on this system
LOGICAL :: LatentLoad ! True if there is a latent cooling load on this system
INTEGER :: FanOpMode ! Supply air fan operating mode
REAL(r64) :: TempMinPLR ! Used to find latent PLR when max iterations exceeded
REAL(r64) :: TempMaxPLR ! Used to find latent PLR when max iterations exceeded
REAL(r64) :: TempOutletTempDXCoil ! Used to find latent PLR when max iterations exceeded
!added variables to call variable speed DX coils
INTEGER :: SpeedNum !speed number of variable speed DX cooling coil
REAL(r64) :: QZnReq ! Zone load (W), input to variable-speed DX coil
REAL(r64) :: QLatReq ! Zone latent load, input to variable-speed DX coil
REAL(r64) :: MaxONOFFCyclesperHour ! Maximum cycling rate of heat pump [cycles/hr]
REAL(r64) :: HPTimeConstant ! Heat pump time constant [s]
REAL(r64) :: FanDelayTime ! Fan delay time, time delay for the HP's fan to
REAL(r64) :: OnOffAirFlowRatio ! ratio of compressor on flow to average flow over time step
REAL(r64) :: TempSpeedOut ! output at one speed level
REAL(r64) :: TempSpeedReqst ! request capacity at one speed level
INTEGER :: NumOfSpeeds !maximum number of speed
INTEGER :: VSCoilIndex !variable-speed coil index
INTEGER :: I ! interation increment
REAL(r64) :: SpeedRatio ! speed ratio between two neighboring speeds
! Set local variables
! Retrieve the load on the controlled zone
OutletNode = DXHeatPumpSystem(DXSystemNum)%DXHeatPumpCoilOutletNodeNum
InletNode = DXHeatPumpSystem(DXSystemNum)%DXHeatPumpCoilInletNodeNum
ControlNode = DXHeatPumpSystem(DXSystemNum)%DXSystemControlNodeNum
DesOutTemp = DXHeatPumpSystem(DXSystemNum)%DesiredOutletTemp
CompName = DXHeatPumpSystem(DXSystemNum)%HeatPumpCoilName
FanOpMode = DXHeatPumpSystem(DXSystemNum)%FanOpMode
PartLoadFrac = 0.0d0
SensibleLoad = .FALSE.
SpeedNum = 1
QZnReq = 0.0d0
QLatReq = 0.0d0
MaxONOFFCyclesperHour = 4.0d0 !default number
HPTimeConstant= 0.0d0
FanDelayTime = 0.0d0
OnOffAirFlowRatio = 1.0d0
TempSpeedOut = 0.0d0
TempSpeedReqst = 0.0d0
NumOfSpeeds = 0
VSCoilIndex = 0
I = 1
SpeedRatio = 0.0d0
! If DXHeatingSystem is scheduled on and there is flow
If((GetCurrentScheduleValue(DXHeatPumpSystem(DXSystemNum)%SchedPtr) > 0.d0) .AND. &
(Node(InletNode)%MassFlowRate .gt. MinAirMassFlow)) THEN
! Determine if there is a sensible load on this system
IF((Node(InletNode)%Temp < Node(ControlNode)%TempSetPoint) .AND. &
(Node(InletNode)%Temp < DesOutTemp) .AND. &
(ABS(Node(InletNode)%Temp - DesOutTemp) .gt. TempControlTol) ) SensibleLoad = .TRUE.
! If DXHeatingSystem runs with a heating load then set PartLoadFrac on Heating System
IF (SensibleLoad ) THEN
SELECT CASE(DXHeatPumpSystem(DXSystemNum)%HeatPumpCoilType_Num)
CASE (CoilDX_HeatingEmpirical) ! Coil:Heating:DX:SingleSpeed
! Get no load result
PartLoadFrac = 0.0d0
CALL SimDXCoil(CompName,On,FirstHVACIteration,PartLoadFrac,DXHeatPumpSystem(DXSystemNum)%HeatPumpCoilIndex,FanOpMode)
NoOutput = Node(InletNode)%MassFlowRate * &
(PsyHFnTdbW(Node(OutletNode)%Temp,Node(OutletNode)%HumRat) &
- PsyHFnTdbW(Node(InletNode)%Temp,Node(OutletNode)%HumRat))
! Get full load result
PartLoadFrac = 1.0d0
CALL SimDXCoil(CompName,On,FirstHVACIteration,PartLoadFrac,DXHeatPumpSystem(DXSystemNum)%HeatPumpCoilIndex,FanOpMode)
FullOutput = Node(InletNode)%MassFlowRate * &
(PsyHFnTdbW(Node(OutletNode)%Temp,Node(InletNode)%HumRat) &
- PsyHFnTdbW(Node(InletNode)%Temp,Node(InletNode)%HumRat))
ReqOutput = Node(InletNode)%MassFlowRate * &
(PsyHFnTdbW(DXHeatPumpSystem(DXSystemNum)%DesiredOutletTemp,Node(InletNode)%HumRat) - &
PsyHFnTdbW(Node(InletNode)%Temp,Node(InletNode)%HumRat))
! IF NoOutput is higher than (more heating than required) or very near the ReqOutput, do not run the compressor
IF ((NoOutput-ReqOutput) > Acc) THEN
PartLoadFrac = 0.0d0
! If the FullOutput is greater than (insufficient heating) or very near the ReqOutput,
! run the compressor at PartLoadFrac = 1.
ELSE IF ((FullOutput - ReqOutput) < Acc) THEN
PartLoadFrac = 1.0d0
! Else find the PLR to meet the load
ELSE
! OutletTempDXCoil is the full capacity outlet temperature at PartLoadFrac = 1 from the CALL above. If this temp is
! greater than the desired outlet temp, then run the compressor at PartLoadFrac = 1, otherwise find the operating PLR.
OutletTempDXCoil = DXCoilOutletTemp(DXHeatPumpSystem(DXSystemNum)%HeatPumpCoilIndex)
IF (OutletTempDXCoil < DesOutTemp) THEN
PartLoadFrac = 1.0d0
ELSE
Par(1) = REAL(DXHeatPumpSystem(DXSystemNum)%HeatPumpCoilIndex,r64)
Par(2) = DesOutTemp
Par(3) = 1.d0 !OnOffAirFlowFrac assume = 1.0 for continuous fan dx system
Par(5) = REAL(FanOpMode,r64)
CALL SolveRegulaFalsi(Acc, MaxIte, SolFla, PartLoadFrac, DXHeatingCoilResidual, 0.0d0, &
1.0d0, Par)
IF (SolFla == -1) THEN
IF(.NOT. WarmupFlag)THEN
IF(DXHeatPumpSystem(DXSystemNum)%DXCoilSensPLRIter .LT. 1)THEN
DXHeatPumpSystem(DXSystemNum)%DXCoilSensPLRIter = DXHeatPumpSystem(DXSystemNum)%DXCoilSensPLRIter+1
CALL ShowWarningError(TRIM(DXHeatPumpSystem(DXSystemNum)%DXHeatPumpSystemType)// &
' - Iteration limit exceeded calculating DX unit sensible '// &
'part-load ratio for unit = '//TRIM(DXHeatPumpSystem(DXSystemNum)%Name))
CALL ShowContinueError('Estimated part-load ratio = '//RoundSigDigits((ReqOutput/FullOutput),3))
CALL ShowContinueError('Calculated part-load ratio = '//RoundSigDigits(PartLoadFrac,3))
CALL ShowContinueErrorTimeStamp('The calculated part-load ratio will be used and the simulation'// &
' continues. Occurrence info: ')
ELSE
CALL ShowRecurringWarningErrorAtEnd(TRIM(DXHeatPumpSystem(DXSystemNum)%DXHeatPumpSystemType)//' "'&
//TRIM(DXHeatPumpSystem(DXSystemNum)%Name)//'" - Iteration limit exceeded calculating'// &
' sensible part-load ratio error continues. Sensible PLR statistics follow.' &
,DXHeatPumpSystem(DXSystemNum)%DXCoilSensPLRIterIndex,PartLoadFrac,PartLoadFrac)
END IF
END IF
ELSE IF (SolFla == -2) THEN
PartLoadFrac = ReqOutput/FullOutput
IF(.NOT. WarmupFlag)THEN
IF(DXHeatPumpSystem(DXSystemNum)%DXCoilSensPLRFail .LT. 1)THEN
DXHeatPumpSystem(DXSystemNum)%DXCoilSensPLRFail = DXHeatPumpSystem(DXSystemNum)%DXCoilSensPLRFail+1
CALL ShowWarningError(TRIM(DXHeatPumpSystem(DXSystemNum)%DXHeatPumpSystemType)//' - DX unit sensible part-'// &
'load ratio calculation failed: part-load ratio limits exceeded, for unit = '// &
TRIM(DXHeatPumpSystem(DXSystemNum)%Name))
CALL ShowContinueError('Estimated part-load ratio = '//RoundSigDigits(PartLoadFrac,3))
CALL ShowContinueErrorTimeStamp('The estimated part-load ratio will be used and the simulation'// &
' continues. Occurrence info: ')
ELSE
CALL ShowRecurringWarningErrorAtEnd(TRIM(DXHeatPumpSystem(DXSystemNum)%DXHeatPumpSystemType)//' "'&
//TRIM(DXHeatPumpSystem(DXSystemNum)%Name)//'" - DX unit sensible part-load ratio calculation'// &
' failed error continues. Sensible PLR statistics follow.' &
,DXHeatPumpSystem(DXSystemNum)%DXCoilSensPLRFailIndex,PartLoadFrac,PartLoadFrac)
END IF
END IF
END IF
END IF
END IF
IF(PartLoadFrac.GT.1.0d0) THEN
PartLoadFrac = 1.0d0
ELSEIF(PartLoadFrac < 0.0d0) THEN
PartLoadFrac = 0.0d0
END IF
CASE( Coil_HeatingAirToAirVariableSpeed )
!variable-speed air-to-air heating coil, begin -------------------------
! Get no load result
PartLoadFrac = 0.0d0
SpeedNum = 1
QZnReq = 0.0d0
QLatReq = 0.0d0
MaxONOFFCyclesperHour = 4.0d0 !default number
HPTimeConstant= 0.0d0
FanDelayTime = 0.0d0
OnOffAirFlowRatio = 1.0d0
SpeedRatio = 0.0d0
Call SimVariableSpeedCoils(CompName,DXHeatPumpSystem(DXSystemNum)%HeatPumpCoilIndex,&
FanOpMode,MaxONOFFCyclesperHour, &
HPTimeConstant,FanDelayTime,&
On, PartLoadFrac, OnOffAirFlowRatio,SpeedNum, SpeedRatio, QZnReq, QLatReq)
VSCoilIndex = DXHeatPumpSystem(DXSystemNum)%HeatPumpCoilIndex
NumOfSpeeds = VarSpeedCoil(VSCoilIndex)%NumOfSpeeds
NoOutput = Node(InletNode)%MassFlowRate * &
(PsyHFnTdbW(Node(OutletNode)%Temp,Node(OutletNode)%HumRat) &
- PsyHFnTdbW(Node(InletNode)%Temp,Node(OutletNode)%HumRat))
! Get full load result
PartLoadFrac = 1.0d0
SpeedNum = NumOfSpeeds
SpeedRatio = 1.0d0
QZnReq = 0.001d0 !to indicate the coil is running
Call SimVariableSpeedCoils(CompName,VSCoilIndex,&
FanOpMode,MaxONOFFCyclesperHour, &
HPTimeConstant,FanDelayTime,&
On, PartLoadFrac, OnOffAirFlowRatio,SpeedNum, SpeedRatio,QZnReq, QLatReq)
FullOutput = Node(InletNode)%MassFlowRate * &
(PsyHFnTdbW(Node(OutletNode)%Temp,Node(InletNode)%HumRat) &
- PsyHFnTdbW(Node(InletNode)%Temp,Node(InletNode)%HumRat))
ReqOutput = Node(InletNode)%MassFlowRate * &
(PsyHFnTdbW(DXHeatPumpSystem(DXSystemNum)%DesiredOutletTemp,Node(InletNode)%HumRat) - &
PsyHFnTdbW(Node(InletNode)%Temp,Node(InletNode)%HumRat))
! IF NoOutput is higher than (more heating than required) or very near the ReqOutput, do not run the compressor
IF ((NoOutput-ReqOutput) > Acc) THEN
PartLoadFrac = 0.0d0
SpeedNum = 1
SpeedRatio = 0.0d0
! If the FullOutput is greater than (insufficient heating) or very near the ReqOutput,
! run the compressor at PartLoadFrac = 1.
ELSE IF ((FullOutput - ReqOutput) < Acc) THEN
PartLoadFrac = 1.0d0
SpeedNum = NumOfSpeeds
SpeedRatio = 1.0d0
! Else find the PLR to meet the load
ELSE
! OutletTempDXCoil is the full capacity outlet temperature at PartLoadFrac = 1 from the CALL above. If this temp is
! greater than the desired outlet temp, then run the compressor at PartLoadFrac = 1, otherwise find the operating PLR.
OutletTempDXCoil = VarSpeedCoil(VSCoilIndex)%OutletAirDBTemp
IF (OutletTempDXCoil < DesOutTemp) THEN
PartLoadFrac = 1.0d0
SpeedNum = NumOfSpeeds
SpeedRatio = 1.0d0
ELSE
PartLoadFrac = 1.0d0
SpeedNum = 1
SpeedRatio = 1.0d0
QZnReq = 0.001d0 !to indicate the coil is running
Call SimVariableSpeedCoils(CompName,VSCoilIndex,&
FanOpMode,MaxONOFFCyclesperHour, &
HPTimeConstant,FanDelayTime,&
On, PartLoadFrac, OnOffAirFlowRatio,SpeedNum, SpeedRatio,QZnReq, QLatReq)
TempSpeedOut = VarSpeedCoil(VSCoilIndex)%OutletAirDBTemp
IF((TempSpeedOut - DesOutTemp) .LT. Acc) THEN
! Check to see which speed to meet the load
PartLoadFrac = 1.0d0
SpeedRatio = 1.0d0
DO I=2,NumOfSpeeds
SpeedNum = I
Call SimVariableSpeedCoils(CompName,VSCoilIndex,&
FanOpMode,MaxONOFFCyclesperHour, &
HPTimeConstant,FanDelayTime,&
On, PartLoadFrac, OnOffAirFlowRatio,SpeedNum, SpeedRatio,QZnReq, QLatReq)
TempSpeedOut = VarSpeedCoil(VSCoilIndex)%OutletAirDBTemp
IF ((TempSpeedOut - DesOutTemp) .GT. Acc) THEN
SpeedNum = I
Exit
END IF
END DO
Par(1) = REAL(VSCoilIndex,r64)
Par(2) = DesOutTemp
Par(5) = REAL(FanOpMode,r64)
Par(3) = REAL(SpeedNum,r64)
CALL SolveRegulaFalsi(Acc, MaxIte, SolFla, SpeedRatio, VSCoilSpeedResidual, 1.0d-10, 1.0d0, Par)
IF (SolFla == -1) THEN
IF(.NOT. WarmupFlag)THEN
IF(DXHeatPumpSystem(DXSystemNum)%DXCoilSensPLRIter .LT. 1)THEN
DXHeatPumpSystem(DXSystemNum)%DXCoilSensPLRIter = DXHeatPumpSystem(DXSystemNum)%DXCoilSensPLRIter+1
CALL ShowWarningError(TRIM(DXHeatPumpSystem(DXSystemNum)%DXHeatPumpSystemType)// &
' - Iteration limit exceeded calculating DX unit sensible '// &
'part-load ratio for unit = '//TRIM(DXHeatPumpSystem(DXSystemNum)%Name))
CALL ShowContinueError('Estimated part-load ratio = '//RoundSigDigits((ReqOutput/FullOutput),3))
CALL ShowContinueError('Calculated part-load ratio = '//RoundSigDigits(PartLoadFrac,3))
CALL ShowContinueErrorTimeStamp('The calculated part-load ratio will be used and the simulation'// &
' continues. Occurrence info: ')
ELSE
CALL ShowRecurringWarningErrorAtEnd(TRIM(DXHeatPumpSystem(DXSystemNum)%DXHeatPumpSystemType)//' "'&
//TRIM(DXHeatPumpSystem(DXSystemNum)%Name)//'" - Iteration limit exceeded calculating'// &
' sensible part-load ratio error continues. Sensible PLR statistics follow.' &
,DXHeatPumpSystem(DXSystemNum)%DXCoilSensPLRIterIndex,PartLoadFrac,PartLoadFrac)
END IF
END IF
ELSE IF (SolFla == -2) THEN
PartLoadFrac = ReqOutput/FullOutput
IF(.NOT. WarmupFlag)THEN
IF(DXHeatPumpSystem(DXSystemNum)%DXCoilSensPLRFail .LT. 1)THEN
DXHeatPumpSystem(DXSystemNum)%DXCoilSensPLRFail = DXHeatPumpSystem(DXSystemNum)%DXCoilSensPLRFail+1
CALL ShowWarningError(TRIM(DXHeatPumpSystem(DXSystemNum)%DXHeatPumpSystemType)// &
' - DX unit sensible part-'// &
'load ratio calculation failed: part-load ratio limits exceeded, for unit = '// &
TRIM(DXHeatPumpSystem(DXSystemNum)%Name))
CALL ShowContinueError('Estimated part-load ratio = '//RoundSigDigits(PartLoadFrac,3))
CALL ShowContinueErrorTimeStamp('The estimated part-load ratio will be used and the simulation'// &
' continues. Occurrence info: ')
ELSE
CALL ShowRecurringWarningErrorAtEnd(TRIM(DXHeatPumpSystem(DXSystemNum)%DXHeatPumpSystemType)//' "'&
//TRIM(DXHeatPumpSystem(DXSystemNum)%Name)//'" - DX unit sensible part-load ratio calculation'// &
' failed error continues. Sensible PLR statistics follow.' &
,DXHeatPumpSystem(DXSystemNum)%DXCoilSensPLRFailIndex,PartLoadFrac,PartLoadFrac)
END IF
END IF
END IF
ELSE
Par(1) = REAL(VSCoilIndex,r64)
Par(2) = DesOutTemp
Par(5) = REAL(FanOpMode,r64)
CALL SolveRegulaFalsi(Acc, MaxIte, SolFla, PartLoadFrac, VSCoilCyclingResidual, 1.0d-10, &
1.0d0, Par)
IF (SolFla == -1) THEN
IF(.NOT. WarmupFlag)THEN
IF(DXHeatPumpSystem(DXSystemNum)%DXCoilSensPLRIter .LT. 1)THEN
DXHeatPumpSystem(DXSystemNum)%DXCoilSensPLRIter = DXHeatPumpSystem(DXSystemNum)%DXCoilSensPLRIter+1
CALL ShowWarningError(TRIM(DXHeatPumpSystem(DXSystemNum)%DXHeatPumpSystemType)// &
' - Iteration limit exceeded calculating DX unit sensible '// &
'part-load ratio for unit = '//TRIM(DXHeatPumpSystem(DXSystemNum)%Name))
CALL ShowContinueError('Estimated part-load ratio = '//RoundSigDigits((ReqOutput/FullOutput),3))
CALL ShowContinueError('Calculated part-load ratio = '//RoundSigDigits(PartLoadFrac,3))
CALL ShowContinueErrorTimeStamp('The calculated part-load ratio will be used and the simulation'// &
' continues. Occurrence info: ')
ELSE
CALL ShowRecurringWarningErrorAtEnd(TRIM(DXHeatPumpSystem(DXSystemNum)%DXHeatPumpSystemType)//' "'&
//TRIM(DXHeatPumpSystem(DXSystemNum)%Name)//'" - Iteration limit exceeded calculating'// &
' sensible part-load ratio error continues. Sensible PLR statistics follow.' &
,DXHeatPumpSystem(DXSystemNum)%DXCoilSensPLRIterIndex,PartLoadFrac,PartLoadFrac)
END IF
END IF
ELSE IF (SolFla == -2) THEN
PartLoadFrac = ReqOutput/FullOutput
IF(.NOT. WarmupFlag)THEN
IF(DXHeatPumpSystem(DXSystemNum)%DXCoilSensPLRFail .LT. 1)THEN
DXHeatPumpSystem(DXSystemNum)%DXCoilSensPLRFail = DXHeatPumpSystem(DXSystemNum)%DXCoilSensPLRFail+1
CALL ShowWarningError(TRIM(DXHeatPumpSystem(DXSystemNum)%DXHeatPumpSystemType)// &
' - DX unit sensible part-'// &
'load ratio calculation failed: part-load ratio limits exceeded, for unit = '// &
TRIM(DXHeatPumpSystem(DXSystemNum)%Name))
CALL ShowContinueError('Estimated part-load ratio = '//RoundSigDigits(PartLoadFrac,3))
CALL ShowContinueErrorTimeStamp('The estimated part-load ratio will be used and the simulation'// &
' continues. Occurrence info: ')
ELSE
CALL ShowRecurringWarningErrorAtEnd(TRIM(DXHeatPumpSystem(DXSystemNum)%DXHeatPumpSystemType)//' "'&
//TRIM(DXHeatPumpSystem(DXSystemNum)%Name)//'" - DX unit sensible part-load ratio calculation'// &
' failed error continues. Sensible PLR statistics follow.' &
,DXHeatPumpSystem(DXSystemNum)%DXCoilSensPLRFailIndex,PartLoadFrac,PartLoadFrac)
END IF
END IF
END IF
END IF
END IF
END IF
IF(PartLoadFrac.GT.1.0d0) THEN
PartLoadFrac = 1.0d0
ELSEIF(PartLoadFrac < 0.0d0) THEN
PartLoadFrac = 0.0d0
END IF
CASE DEFAULT
CALL ShowFatalError('ControlDXHeatingSystem: Invalid DXHeatPumpSystem coil type = '// &
TRIM(DXHeatPumpSystem(DXSystemNum)%HeatPumpCoilType))
END SELECT
END IF ! End of cooling load type (sensible or latent) if block
END IF ! End of If DXheatingSystem is scheduled on and there is flow
!Set the final results
DXHeatPumpSystem(DXSystemNum)%PartLoadFrac = PartLoadFrac
DXHeatPumpSystem(DXSystemNum)%SpeedRatio = SpeedRatio
DXHeatPumpSystem(DXSystemNum)%SpeedNum = SpeedNum
RETURN
END Subroutine ControlDXHeatingSystem