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.
see 'Note' under INITIAL CALCULATIONS
Type | Intent | Optional | Attributes | Name | ||
---|---|---|---|---|---|---|
integer, | intent(in) | :: | AirLoopNum | |||
integer, | intent(in) | :: | FurnaceNum | |||
logical, | intent(in) | :: | FirstHVACIteration | |||
integer, | intent(in) | :: | CompOp | |||
real(kind=r64), | intent(in) | :: | ZoneLoad | |||
real(kind=r64), | intent(in) | :: | MoistureLoad |
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 CalcWaterToAirHeatpump(AirLoopNum, FurnaceNum,FirstHVACIteration,CompOp,ZoneLoad,MoistureLoad)
! SUBROUTINE INFORMATION:
! AUTHOR Dan Fisher
! DATE WRITTEN Feb 2004
! MODIFIED R. Raustad (Oct 2006) Revised iteration technique
! RE-ENGINEERED na
! PURPOSE OF THIS SUBROUTINE:
! This subroutine manages the heat pump simulation
! METHODOLOGY EMPLOYED:
! Calculate the part-load ratio required to meet the zone sensible load.
! REFERENCES:
! na
! USE STATEMENTS:
USE HeatingCoils, ONLY: SimulateHeatingCoilComponents
USE InputProcessor, ONLY: FindItemInList
USE DataHeatBalFanSys, ONLY: MAT
USE DataAirLoop, ONLY: AirToOANodeInfo
USE General, ONLY: SolveRegulaFalsi, TrimSigDigits
IMPLICIT NONE ! Enforce explicit typing of all variables in this routine
! SUBROUTINE ARGUMENT DEFINITIONS:
INTEGER, Intent(IN) :: FurnaceNum ! index to Furnace
INTEGER, Intent(IN) :: AirLoopNum ! index to air loop
LOGICAL, Intent(IN) :: FirstHVACIteration ! TRUE on first HVAC iteration
INTEGER, Intent(IN) :: CompOp ! compressor operation flag (1=On, 0=Off)
REAL(r64), Intent(IN) :: ZoneLoad ! the control zone load (watts)
REAL(r64), Intent(IN) :: MoistureLoad ! the control zone latent load (watts)
! SUBROUTINE PARAMETER DEFINITIONS:
INTEGER, PARAMETER :: MaxIter = 600 ! maximum number of iterations
REAL(r64), PARAMETER :: MinPLR = 0.0d0 ! minimum part load ratio allowed
! INTERFACE BLOCK SPECIFICATIONS
! na
! DERIVED TYPE DEFINITIONS
! na
! SUBROUTINE LOCAL VARIABLE DECLARATIONS:
REAL(r64) :: OnOffAirFlowRatio ! Ratio of compressor ON air mass flow to AVERAGE air mass flow over time step
REAL(r64), SAVE :: TotalZoneLatentLoad ! Total ZONE latent load (not including outside air)
! to be removed by furnace/unitary system
REAL(r64), SAVE :: TotalZoneSensLoad ! Total ZONE heating load (not including outside air)
! to be removed by furnace/unitary system
REAL(r64) :: cpair ! Heat capacity of air
REAL(r64) :: ZoneSensLoadMet ! Actual zone sensible load met by heat pump (W)
REAL(r64) :: ZoneLatLoadMet ! Actual zone latent load met by heat pump (W)
REAL(r64) :: ZoneSensLoadMetFanONCompON ! Max Zone sensible load heat pump can meet (W)
REAL(r64) :: ZoneLatLoadMetFanONCompON !Max Zone latentload heat pump can meet (W)
REAL(r64) :: ZoneSensLoadMetFanONCompOFF ! control zone sensible load met using only outside air
! and fan heat (no coil output) (W)
REAL(r64) :: ZoneLatLoadMetFanONCompOFF ! control zone Latent load met using only outside air
! and fan heat (no coil output) (W)
REAL(r64) :: HPCoilSensDemand ! Heat pump sensible demand
REAL(r64) :: HPCoilSensCapacity ! Heat pump sensible capacity
INTEGER :: FurnaceInletNode ! heat pump Inlet node
INTEGER :: FurnaceOutletNode ! heat pump Outlet node
INTEGER :: OASysInletNode ! node number of return air inlet to OA sys
INTEGER :: OASysOutletNode ! node number of mixed air outlet of OA sys
INTEGER :: OpMode ! Mode of Operation (fan cycling = 1 or fan continuous = 2)
REAL(r64),SAVE :: CoolPartLoadRatio ! Part load ratio (greater of sensible or latent part load ratio for cooling)
REAL(r64),SAVE :: HeatPartLoadRatio ! Part load ratio (greater of sensible or latent part load ratio for cooling)
REAL(r64),SAVE :: Dummy=0.0d0 ! Dummy var. for generic calc. furnace output arg. (n/a for heat pump)
LOGICAL :: HumControl ! Logical flag signaling when dehumidification is required
REAL(r64) :: SuppHeatCoilLoad ! Load passed to supplemental heater (W)
REAL(r64) :: CoolErrorToler ! convergence tolerance used in cooling mode
REAL(r64) :: HeatErrorToler ! convergence tolerance used in heating mode
INTEGER :: SolFlag ! flag returned from iteration routine to denote problems
REAL(r64) :: Par(9) ! parameters passed to iteration routine
! Set local variables
Dummy = 0.0d0
OnOffAirFlowRatio = 1.0d0
FurnaceOutletNode = Furnace(FurnaceNum)%FurnaceOutletNodeNum
FurnaceInletNode = Furnace(FurnaceNum)%FurnaceInletNodeNum
IF(AirToOANodeInfo(AirLoopNum)%OASysExists)THEN
OASysOutletNode = AirToOANodeInfo(AirLoopNum)%OASysOutletNodeNum
OASysInletNode = AirToOANodeInfo(AirLoopNum)%OASysInletNodeNum
ENDIF
OpMode = Furnace(FurnaceNum)%OpMode
Furnace(FurnaceNum)%MdotFurnace = Furnace(FurnaceNum)%DesignMassFlowRate
HumControl = .FALSE.
!*********INITIAL CALCULATIONS****************
!Calculate the Cp Air for all conditions
cpair = PsyCpAirFnWTdb(Node(FurnaceInletNode)%HumRat,Node(FurnaceInletNode)%Temp)
!set the fan part load fraction
! Note: OnOffFanPartLoadFraction is passed to the
! fan module by DataHVACGlobals. It should be
! set =1 for all cases except cycling fan/cycling
! coil. For this case it is set to the part load
! factor. In SimOnOffFan, the part load ratio is
! divided by the part load factor (OnOffFanPartLoadFraction)
! in order to match the run time fraction of the cycling
! fan with the run time fraction of the cycling compressor
IF(FirstHVACIteration) OnOffFanPartLoadFraction = 1.0d0
!Calc Zone sensible loads for heating (+) and cooling (-)
TotalZoneSensLoad = ZoneLoad
!Set latent load for heating
IF(HeatingLoad)THEN
TotalZoneLatentLoad = 0.0d0
!Set latent load for cooling and no sensible load condition
ELSE
TotalZoneLatentLoad = MoistureLoad
ENDIF
!*********COOLING CALCULATIONS****************
!IF scheduled on...
IF((GetCurrentScheduleValue(Furnace(FurnaceNum)%SchedPtr) .gt. 0.0d0 .AND. &
!AND air flow rate is greater than zero...
Node(FurnaceInletNode)%MassFlowRate .gt. 0.0d0) .AND. &
!AND the air system has a cooling load and is not set back or in the deadband...
((CoolingLoad) .OR. &
!OR the system is controlled by a humidistat and there is a latent load
(Furnace(FurnaceNum)%Humidistat.AND.Furnace(FurnaceNum)%CoolingCoilLatentDemand.lt.0.0d0))) THEN
!Set the air flow rate to the design flow rate and set the fan operation fraction to 1 (continuous operation)
Node(FurnaceInletNode)%MassFlowRate=Furnace(FurnaceNum)%DesignMassFlowRate
OnOffFanPartLoadFraction = 1.0d0 !see 'Note' under INITIAL CALCULATIONS
! !Set the operation flag to run the fan continuously
! OpMode = ContFanCycCoil
!Set the input parameters for CalcFurnaceOutput
Furnace(FurnaceNum)%HeatingCoilSensDemand = 0.0d0
Furnace(FurnaceNum)%CoolingCoilLatentDemand = 0.0d0
Furnace(FurnaceNum)%CoolingCoilSensDemand = 0.0d0
Furnace(FurnaceNum)%CompPartLoadRatio = 0.0d0 !compressor off
Furnace(FurnaceNum)%InitHeatPump = .TRUE. !initialization call to Calc Furnace
Furnace(FurnaceNum)%WSHPRuntimeFrac = 0.0d0
CoolPartLoadRatio = 0.0d0
!Get no load result in order to calculate the effect of the fan and the mixed air equipment
CALL CalcFurnaceOutput(FurnaceNum,FirstHVACIteration,OpMode,CompOp,CoolPartLoadRatio,HeatPartLoadRatio, &
Dummy, Dummy, ZoneSensLoadMetFanONCompOFF, ZoneLatLoadMetFanONCompOFF, OnOffAirFlowRatio, .FALSE.)
!Set the input parameters for CalcFurnaceOutput
Furnace(FurnaceNum)%CoolingCoilSensDemand = 1.0d0
Furnace(FurnaceNum)%CompPartLoadRatio = 1.0d0 !compressor ON
Furnace(FurnaceNum)%WSHPRuntimeFrac = 1.0d0
CoolPartLoadRatio = 1.0d0
!Get full load result in order to estimate the operating part load ratio for continuous fan operation
CALL CalcFurnaceOutput(FurnaceNum,FirstHVACIteration,OpMode,CompOp,CoolPartLoadRatio,HeatPartLoadRatio, &
Dummy, Dummy, ZoneSensLoadMetFanONCompON, ZoneLatLoadMetFanONCompON, OnOffAirFlowRatio, .FALSE.)
!Calculate the heating coil demand for continuous fan operation as:
! (the zone sensible load - the zone sensible load met by fan heat and mixed air)
!Note; The sensible zone load met by fan heat and mixed air is calculated as:
! mdotsys(control zone inlet enthalpy - control zone outlet enthalpy)
!This accounts for the negative sign in the equation.
HPCoilSensDemand = TotalZoneSensLoad - ZoneSensLoadMetFanONCompOFF
!Calculate the heating coil capacity for continuous fan operation as:
! (the zone sensible load met by fan heat and mixed air and coil
! - the zone sensible load met by fan heat and mixed air)
HPCoilSensCapacity = ZoneSensLoadMetFanONCompON - ZoneSensLoadMetFanONCompOFF
!Calculate the part load ratio for continuous fan operation with cycling coil
IF(HPCoilSensCapacity == 0.0d0) Then
CoolPartLoadRatio = 0.0d0
Else
CoolPartLoadRatio = MAX(MinPLR,MIN(1.0d0,&
ABS(HPCoilSensDemand) / ABS(HPCoilSensCapacity)))
End If
Furnace(FurnaceNum)%InitHeatPump = .FALSE.
! check bounds on sensible output prior to iteration using RegulaFalsi
IF(ZoneSensLoadMetFanONCompON .GT. TotalZoneSensLoad)THEN
CoolPartLoadRatio = 1.0d0
HPCoilSensDemand = ABS(ZoneSensLoadMetFanONCompON - ZoneSensLoadMetFanONCompOFF)
Furnace(FurnaceNum)%CoolingCoilSensDemand = HPCoilSensDemand
ELSEIF(ZoneSensLoadMetFanONCompOFF .LT. TotalZoneSensLoad)THEN
CoolPartLoadRatio = 0.0d0
Furnace(FurnaceNum)%CompPartLoadRatio = 0.0d0 !compressor OFF
Furnace(FurnaceNum)%WSHPRuntimeFrac = 0.0d0
Furnace(FurnaceNum)%CoolingCoilSensDemand = 0.0d0
CALL CalcFurnaceOutput(FurnaceNum,FirstHVACIteration,OpMode,CompOp,CoolPartLoadRatio,HeatPartLoadRatio, &
Dummy, Dummy, ZoneSensLoadMetFanONCompOFF, ZoneLatLoadMetFanONCompOFF, OnOffAirFlowRatio, .FALSE.)
ELSE
! Calculate the sensible part load ratio through iteration
CoolErrorToler = Furnace(FurnaceNum)%CoolingConvergenceTolerance
SolFlag = 0 ! # of iterations if positive, -1 means failed to converge, -2 means bounds are incorrect
Par(1) = REAL(FurnaceNum,r64)
Par(2) = 0.0d0 ! FLAG, if 1.0 then FirstHVACIteration equals TRUE, if 0.0 then FirstHVACIteration equals false
IF(FirstHVACIteration)Par(2)=1.0d0
Par(3) = REAL(OpMode,r64)
Par(4) = REAL(CompOp,r64)
Par(5) = TotalZoneSensLoad
Par(6) = 1.0d0 ! FLAG, 0.0 if heating load, 1.0 if cooling or moisture load
Par(7) = 1.0d0 ! FLAG, 0.0 if latent load, 1.0 if sensible load to be met
Par(8) = ZoneSensLoadMetFanONCompOFF ! Output with fan ON compressor OFF
Par(9) = 0.0d0 ! HX is off for water-to-air HP
! CoolErrorToler is in fraction of load, MaxIter = 600, SolFalg = # of iterations or error as appropriate
CALL SolveRegulaFalsi(CoolErrorToler, MaxIter, SolFlag, CoolPartLoadRatio, CalcWaterToAirResidual, 0.0d0, 1.0d0, Par)
IF (SolFlag == -1 .AND. .NOT. WarmupFlag .AND. .NOT. FirstHVACIteration) THEN
OnOffFanPartLoadFraction = OnOffFanPartLoadFractionSave
CALL CalcFurnaceOutput(FurnaceNum,FirstHVACIteration,OpMode,CompOp,CoolPartLoadRatio, &
0.0d0,0.0d0,0.0d0, ZoneSensLoadMet, ZoneLatLoadMet, OnOffAirFlowRatio, .FALSE.)
IF(ABS(ZoneSensLoadMet - TotalZoneSensLoad)/TotalZoneSensLoad .GT. CoolErrorToler)THEN
IF(Furnace(FurnaceNum)%SensibleMaxIterIndex == 0)THEN
CALL ShowWarningMessage('Cooling coil control failed to converge for ' &
//TRIM(cFurnaceTypes(Furnace(FurnaceNum)%FurnaceType_Num))//':'//TRIM(Furnace(FurnaceNum)%Name))
CALL ShowContinueError(' Iteration limit exceeded in calculating DX cooling coil sensible part-load ratio.')
CALL ShowContinueErrorTimeStamp('Sensible load to be met by DX coil = ' &
//TRIM(TrimSigDigits(TotalZoneSensLoad,2))//' (watts), sensible output of DX coil = ' &
//TRIM(TrimSigDigits(ZoneSensLoadMet,2))//' (watts), and the simulation continues.')
END IF
CALL ShowRecurringWarningErrorAtEnd(TRIM(cFurnaceTypes(Furnace(FurnaceNum)%FurnaceType_Num))//' "'&
//TRIM(Furnace(FurnaceNum)%Name)//'" - Iteration limit exceeded in calculating'// &
' sensible cooling part-load ratio error continues. Sensible load statistics:' &
,Furnace(FurnaceNum)%SensibleMaxIterIndex,TotalZoneSensLoad,TotalZoneSensLoad)
END IF
ELSE IF (SolFlag == -2 .AND. .NOT. WarmupFlag .AND. .NOT. FirstHVACIteration) THEN
CoolPartLoadRatio = MAX(MinPLR,MIN(1.0d0,ABS(HPCoilSensDemand ) / ABS(HPCoilSensCapacity)))
OnOffFanPartLoadFraction = 1.0d0
CALL CalcFurnaceOutput(FurnaceNum,FirstHVACIteration,OpMode,CompOp,CoolPartLoadRatio, &
0.0d0,0.0d0,0.0d0, ZoneSensLoadMet, ZoneLatLoadMet, OnOffAirFlowRatio, .FALSE.)
IF((ZoneSensLoadMet - TotalZoneSensLoad)/TotalZoneSensLoad .GT. CoolErrorToler)THEN
IF(Furnace(FurnaceNum)%SensibleRegulaFalsiFailedIndex == 0)THEN
CALL ShowWarningMessage('Cooling coil control failed for ' &
//TRIM(cFurnaceTypes(Furnace(FurnaceNum)%FurnaceType_Num))//':'//TRIM(Furnace(FurnaceNum)%Name))
CALL ShowContinueError(' Cooling sensible part-load ratio determined to be outside the range of 0-1.')
CALL ShowContinueError(' An estimated part-load ratio = '//TRIM(TrimSigDigits(CoolPartLoadRatio,2))// &
' will be used and the simulation continues.')
CALL ShowContinueError(' The estimated part-load ratio provides a cooling sensible capacity = '// &
TRIM(TrimSigDigits(ZoneSensLoadMet,2)))
CALL ShowContinueErrorTimeStamp(' Cooling sensible load required = ' &
//TRIM(TrimSigDigits(TotalZoneSensLoad,2)))
ENDIF
CALL ShowRecurringWarningErrorAtEnd(TRIM(cFurnaceTypes(Furnace(FurnaceNum)%FurnaceType_Num))//' "'&
//TRIM(Furnace(FurnaceNum)%Name)//'" - Cooling sensible part-load ratio out of range'// &
' error continues. Sensible cooling load statistics:' &
,Furnace(FurnaceNum)%SensibleRegulaFalsiFailedIndex,TotalZoneSensLoad,TotalZoneSensLoad)
END IF
END IF
END IF
IF (OpMode .EQ. CycFanCycCoil) THEN
Furnace(FurnaceNum)%MdotFurnace = Furnace(FurnaceNum)%MdotFurnace * CoolPartLoadRatio
END IF
!*********HEATING CALCULATIONS****************
! If Furnace runs with a heating load then set HeatCoilLoad on Heating Coil and the Mass Flow
ELSEIF((GetCurrentScheduleValue(Furnace(FurnaceNum)%SchedPtr) .gt. 0.0d0) .and. &
(Node(FurnaceInletNode)%MassFlowRate .gt. 0.0d0) .and. &
HeatingLoad) THEN
!Set the air flow rate to the design flow rate and set the fan operation fraction to 1 (continuous operation)
Node(FurnaceInletNode)%MassFlowRate=Furnace(FurnaceNum)%DesignMassFlowRate
OnOffFanPartLoadFraction = 1.0d0 !see 'Note' under INITIAL CALCULATIONS
! !Set the operation flag to run the fan continuously
! OpMode = ContFanCycCoil
!Set the input parameters for CalcFurnaceOutput
Furnace(FurnaceNum)%HeatingCoilSensDemand = 0.0d0
Furnace(FurnaceNum)%CoolingCoilLatentDemand = 0.0d0
Furnace(FurnaceNum)%CoolingCoilSensDemand = 0.0d0
Furnace(FurnaceNum)%CompPartLoadRatio = 0.0d0 !compressor off
Furnace(FurnaceNum)%InitHeatPump = .TRUE. !initialization call to Calc Furnace
Furnace(FurnaceNum)%WSHPRuntimeFrac = 0.0d0
HeatPartLoadRatio = 0.0d0
!Get no load result in order to calculate the effect of the fan and the mixed air equipment
CALL CalcFurnaceOutput(FurnaceNum,FirstHVACIteration,OpMode,CompOp,CoolPartLoadRatio,HeatPartLoadRatio, &
Dummy, Dummy, ZoneSensLoadMetFanONCompOFF, ZoneLatLoadMetFanONCompOFF, OnOffAirFlowRatio, .FALSE.)
!Set the input parameters for CalcFurnaceOutput
Furnace(FurnaceNum)%HeatingCoilSensDemand = 1.0d0
Furnace(FurnaceNum)%CompPartLoadRatio = 1.0d0 !compressor ON
Furnace(FurnaceNum)%WSHPRuntimeFrac = 1.0d0
HeatPartLoadRatio = 1.0d0
!Get full load result in order to estimate the operating part load ratio for continuous fan operation
CALL CalcFurnaceOutput(FurnaceNum,FirstHVACIteration,OpMode,CompOp,CoolPartLoadRatio,HeatPartLoadRatio, &
Dummy, Dummy, ZoneSensLoadMetFanONCompON, ZoneLatLoadMetFanONCompON, OnOffAirFlowRatio, .FALSE.)
!Calculate the heating coil demand for continuous fan operation as:
! (the zone sensible load - the zone sensible load met by fan heat and mixed air)
!Note; The sensible zone load met by fan heat and mixed air is calculated as:
! mdotsys(control zone inlet enthalpy - control zone outlet enthalpy)
!This accounts for the negative sign in the equation.
HPCoilSensDemand = TotalZoneSensLoad - ZoneSensLoadMetFanONCompOFF
!Calculate the heating coil capacity for continuous fan operation as:
! (the zone sensible load met by fan heat and mixed air and coil
! - the zone sensible load met by fan heat and mixed air)
HPCoilSensCapacity = ZoneSensLoadMetFanONCompON - ZoneSensLoadMetFanONCompOFF
!Calculate the part load ratio for continuous fan operation with cycling coil
If(HPCoilSensCapacity == 0.0d0) Then
HeatPartLoadRatio = 0.0d0
Else
HeatPartLoadRatio = MAX(MinPLR,MIN(1.0d0,&
ABS(HPCoilSensDemand) / ABS(HPCoilSensCapacity)))
End If
Furnace(FurnaceNum)%InitHeatPump = .FALSE.
! check bounds on sensible output prior to iteration using RegulaFalsi
IF(ZoneSensLoadMetFanONCompON .LT. TotalZoneSensLoad)THEN
HeatPartLoadRatio = 1.0d0
ZoneSensLoadMet = ZoneSensLoadMetFanONCompON
HPCoilSensDemand = ABS(ZoneSensLoadMetFanONCompON - ZoneSensLoadMetFanONCompOFF)
Furnace(FurnaceNum)%HeatingCoilSensDemand = HPCoilSensDemand
ELSEIF(ZoneSensLoadMetFanONCompOFF .GT. TotalZoneSensLoad)THEN
HeatPartLoadRatio = 0.0d0
ZoneSensLoadMet = ZoneSensLoadMetFanONCompOFF
Furnace(FurnaceNum)%CompPartLoadRatio = 0.0d0 !compressor ON
Furnace(FurnaceNum)%WSHPRuntimeFrac = 0.0d0
CALL CalcFurnaceOutput(FurnaceNum,FirstHVACIteration,OpMode,CompOp,CoolPartLoadRatio,&
HeatPartLoadRatio, Dummy, Dummy, ZoneSensLoadMet,ZoneLatLoadMet, OnOffAirFlowRatio, .FALSE.)
ELSE
! Calculate the sensible part load ratio through iteration
HeatErrorToler = Furnace(FurnaceNum)%HeatingConvergenceTolerance
SolFlag = 0 ! # of iterations if positive, -1 means failed to converge, -2 means bounds are incorrect
Par(1) = REAL(FurnaceNum,r64)
Par(2) = 0.0d0 ! FLAG, if 1.0 then FirstHVACIteration equals TRUE, if 0.0 then FirstHVACIteration equals false
IF(FirstHVACIteration)Par(2)=1.0d0
Par(3) = REAL(OpMode,r64)
Par(4) = REAL(CompOp,r64)
Par(5) = TotalZoneSensLoad
Par(6) = 0.0d0 ! FLAG, 0.0 if heating load, 1.0 if cooling or moisture load
Par(7) = 1.0d0 ! FLAG, 0.0 if latent load, 1.0 if sensible load to be met
Par(8) = ZoneSensLoadMetFanONCompOFF ! Output with fan ON compressor OFF
Par(9) = 0.0d0 ! HX is OFF for water-to-air HP
! HeatErrorToler is in fraction of load, MaxIter = 600, SolFalg = # of iterations or error as appropriate
CALL SolveRegulaFalsi(HeatErrorToler, MaxIter, SolFlag, HeatPartLoadRatio, CalcWaterToAirResidual, 0.0d0, 1.0d0, Par)
OnOffFanPartLoadFraction = OnOffFanPartLoadFractionSave
CALL CalcFurnaceOutput(FurnaceNum,FirstHVACIteration,OpMode,CompOp,CoolPartLoadRatio,HeatPartLoadRatio, &
Dummy, Dummy, ZoneSensLoadMet,ZoneLatLoadMet, OnOffAirFlowRatio, .FALSE.)
IF (SolFlag == -1 .AND. .NOT. WarmupFlag .AND. .NOT. FirstHVACIteration) THEN
IF(ABS(ZoneSensLoadMet - TotalZoneSensLoad)/TotalZoneSensLoad .GT. HeatErrorToler)THEN
IF(Furnace(FurnaceNum)%WSHPHeatMaxIterIndex == 0)THEN
CALL ShowWarningMessage('Heating coil control failed to converge for ' &
//TRIM(cFurnaceTypes(Furnace(FurnaceNum)%FurnaceType_Num))//':'//TRIM(Furnace(FurnaceNum)%Name))
CALL ShowContinueError(' Iteration limit exceeded in calculating DX heating coil sensible part-load ratio.')
CALL ShowContinueErrorTimeStamp('Sensible load to be met by DX coil = ' &
//TRIM(TrimSigDigits(TotalZoneSensLoad,2))//' (watts), sensible output of DX coil = ' &
//TRIM(TrimSigDigits(ZoneSensLoadMet,2))//' (watts), and the simulation continues.')
END IF
CALL ShowRecurringWarningErrorAtEnd(TRIM(cFurnaceTypes(Furnace(FurnaceNum)%FurnaceType_Num))//' "'&
//TRIM(Furnace(FurnaceNum)%Name)//'" - Iteration limit exceeded in calculating'// &
' sensible heating part-load ratio error continues.' &
,Furnace(FurnaceNum)%WSHPHeatMaxIterIndex,TotalZoneSensLoad,TotalZoneSensLoad)
END IF
ELSE IF (SolFlag == -2) THEN
HeatPartLoadRatio = MAX(MinPLR,MIN(1.0d0,ABS(HPCoilSensDemand ) / ABS(HPCoilSensCapacity)))
CALL CalcFurnaceOutput(FurnaceNum,FirstHVACIteration,OpMode,CompOp,0.0d0,HeatPartLoadRatio, &
0.0d0,0.0d0, ZoneSensLoadMet,ZoneLatLoadMet, OnOffAirFlowRatio, .FALSE.)
IF((ZoneSensLoadMet - TotalZoneSensLoad)/TotalZoneSensLoad .GT. HeatErrorToler)THEN
IF(Furnace(FurnaceNum)%WSHPHeatRegulaFalsiFailedIndex == 0)THEN
CALL ShowWarningError('Heating coil control failed for ' &
//TRIM(cFurnaceTypes(Furnace(FurnaceNum)%FurnaceType_Num))//':'//TRIM(Furnace(FurnaceNum)%Name))
CALL ShowContinueError(' Heating sensible part-load ratio determined to be outside the range of 0-1.')
CALL ShowContinueError(' An estimated part-load ratio = '//TRIM(TrimSigDigits(HeatPartLoadRatio,2))// &
' will be used and the simulation continues.')
CALL ShowContinueError(' The estimated part-load ratio provides a heating sensible capacity = '// &
TRIM(TrimSigDigits(ZoneSensLoadMet,2)))
CALL ShowContinueErrorTimeStamp(' Heating sensible load required = '//TRIM(TrimSigDigits(TotalZoneSensLoad,2)))
END IF
CALL ShowRecurringWarningErrorAtEnd(TRIM(cFurnaceTypes(Furnace(FurnaceNum)%FurnaceType_Num))//' "'&
//TRIM(Furnace(FurnaceNum)%Name)//'" - Heating sensible part-load ratio out of range'// &
' error continues.' &
,Furnace(FurnaceNum)%WSHPHeatRegulaFalsiFailedIndex,TotalZoneSensLoad,TotalZoneSensLoad)
END IF
END IF
END IF
! CALL supplemental heater if required
IF((TotalZoneSensLoad - ZoneSensLoadMet) .GT. SmallLoad .AND. HeatPartLoadRatio .GE. 1.0d0)THEN
SuppHeatCoilLoad = TotalZoneSensLoad - ZoneSensLoadMet
CALL CalcFurnaceOutput(FurnaceNum,FirstHVACIteration,OpMode,CompOp,CoolPartLoadRatio,&
HeatPartLoadRatio, SuppHeatCoilLoad, Dummy, ZoneSensLoadMet,ZoneLatLoadMet, OnOffAirFlowRatio, .FALSE.)
END IF
IF (OpMode .EQ. CycFanCycCoil) THEN
Furnace(FurnaceNum)%MdotFurnace = Furnace(FurnaceNum)%MdotFurnace * HeatPartLoadRatio
END IF
!**********HVAC Scheduled ON, but no cooling, dehumidification or heating load*********
ELSEIF(GetCurrentScheduleValue(Furnace(FurnaceNum)%SchedPtr) .gt. 0.0d0) THEN
Furnace(FurnaceNum)%InitHeatPump = .TRUE. !initialization call to Calc Furnace
HeatPartLoadRatio = 0.0d0
CoolPartLoadRatio = 0.0d0
OnOffFanPartLoadFraction = 1.0d0 !!see 'Note' under INITIAL CALCULATIONS
!set report variables
Furnace(FurnaceNum)%CompPartLoadRatio = 0.0d0
Furnace(FurnaceNum)%CoolingCoilSensDemand=0.0d0
Furnace(FurnaceNum)%CoolingCoilLatentDemand=0.0d0
Furnace(FurnaceNum)%HeatingCoilSensDemand=0.0d0
IF(OpMode .EQ. CycFanCycCoil)THEN
Furnace(FurnaceNum)%MdotFurnace = 0.0d0
OnOffFanPartLoadFraction = 1.0d0 !see 'Note' under INITIAL CALCULATIONS
CALL CalcFurnaceOutput(FurnaceNum,FirstHVACIteration,OpMode,CompOp,CoolPartLoadRatio,&
HeatPartLoadRatio, Dummy, Dummy, ZoneSensLoadMet,ZoneLatLoadMet, OnOffAirFlowRatio, .FALSE.)
Furnace(FurnaceNum)%MdotFurnace = 0.0d0
ElSE !continuous fan, cycling coil
CALL CalcFurnaceOutput(FurnaceNum,FirstHVACIteration,OpMode,CompOp,CoolPartLoadRatio,&
HeatPartLoadRatio, Dummy, Dummy, ZoneSensLoadMet,ZoneLatLoadMet, OnOffAirFlowRatio, .FALSE.)
ENDIF
!*********No heating or cooling or dehumidification*********
ELSE
Furnace(FurnaceNum)%InitHeatPump = .TRUE. !initialization call to Calc Furnace
Furnace(FurnaceNum)%MdotFurnace = 0.0d0
HeatPartLoadRatio = 0.0d0
CoolPartLoadRatio = 0.0d0
OnOffFanPartLoadFraction = 1.0d0 !see 'Note' under INITIAL CALCULATIONS
Furnace(FurnaceNum)%CompPartLoadRatio = 0.0d0
Furnace(FurnaceNum)%CoolingCoilSensDemand = 0.0d0
Furnace(FurnaceNum)%CoolingCoilLatentDemand= 0.0d0
Furnace(FurnaceNum)%HeatingCoilSensDemand = 0.0d0
CALL CalcFurnaceOutput(FurnaceNum,FirstHVACIteration,OpMode,CompOp,CoolPartLoadRatio,&
HeatPartLoadRatio, Dummy, Dummy, ZoneSensLoadMet,ZoneLatLoadMet, OnOffAirFlowRatio, .FALSE.)
Furnace(FurnaceNum)%MdotFurnace = 0.0d0
END IF
! Set the fan inlet node flow rates
Node(FurnaceInletNode)%MassFlowRateMaxAvail = Furnace(FurnaceNum)%MdotFurnace
Node(FurnaceInletNode)%MassFlowRate = Furnace(FurnaceNum)%MdotFurnace
RETURN
END SUBROUTINE CalcWaterToAirHeatpump