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) | :: | FurnaceNum | |||
logical, | intent(in) | :: | FirstHVACIteration | |||
real(kind=r64), | intent(in) | :: | QZnReq | |||
real(kind=r64), | intent(in) | :: | QLatReq | |||
real(kind=r64), | intent(inout) | :: | OnOffAirFlowRatio |
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 SimVariableSpeedHP(FurnaceNum,FirstHVACIteration, QZnReq, QLatReq, OnOffAirFlowRatio)
! SUBROUTINE INFORMATION:
! AUTHOR Bo Shen, based on HVACMultiSpeedHeatPump:CalcMSHeatPump
! DATE WRITTEN March, 2012
! MODIFIED na
! RE-ENGINEERED na
! PURPOSE OF THIS SUBROUTINE:
! Simulate a multispeed heat pump; adjust its output to match the
! required system load.
! METHODOLOGY EMPLOYED:
! Calls ControlMSHPOutput to obtain the desired unit output
! REFERENCES:
! na
! USE STATEMENTS:
USE DataZoneEnergyDemands
USE DataHVACGlobals, ONLY: SmallMassFlow, SmallLoad
USE DataZoneEquipment, ONLY: ZoneEquipConfig
USE DataAirLoop, ONLY: AirLoopControlInfo, AirToZoneNodeInfo
USE DataAirSystems, ONLY: PrimaryAirSystem
! USE DataConvergParams, ONLY: HVACFlowRateToler
IMPLICIT NONE ! Enforce explicit typing of all variables in this routine
! SUBROUTINE ARGUMENT DEFINITIONS:
LOGICAL, INTENT (IN) :: FirstHVACIteration ! TRUE if 1st HVAC simulation of system timestep
INTEGER, INTENT (IN) :: FurnaceNum ! number of the current engine driven Heat Pump being simulated
REAL(r64), INTENT (IN) :: QZnReq ! required zone load
REAL(r64), INTENT (IN) :: QLatReq ! required latent load
REAL(r64), INTENT (INOUT) :: OnOffAirFlowRatio ! ratio of compressor ON airflow to AVERAGE airflow over timestep
! SUBROUTINE PARAMETER DEFINITIONS:
! na
! INTERFACE BLOCK SPECIFICATIONS
! na
! DERIVED TYPE DEFINITIONS
! na
! SUBROUTINE LOCAL VARIABLE DECLARATIONS:
REAL(r64) :: PartLoadFrac ! compressor part load fraction
REAL(r64) :: SpeedRatio ! compressor speed ratio
LOGICAL :: UnitOn ! TRUE if unit is on
INTEGER :: OutletNode ! MSHP air outlet node
INTEGER :: InletNode ! MSHP air inlet node
REAL(r64) :: AirMassFlow ! air mass flow rate [kg/s]
INTEGER :: OpMode ! operating mode (fan cycling or continious; DX coil always cycles)
INTEGER :: ZoneNum ! Controlled zone number
REAL(r64) :: QTotUnitOut ! capacity output
INTEGER :: SpeedNum = 1 ! Speed number
REAL(r64) :: SupHeaterLoad = 0.0d0 ! supplement heater load
INTEGER :: CompOp ! compressor operation; 1=on, 0=off
INTEGER :: AirLoopNumber ! Index to air loop
REAL(r64) :: SaveMassFlowRate ! saved inlet air mass flow rate [kg/s]
REAL(r64) :: QSensUnitOut ! sensible capacity output
REAL(r64) :: QLatUnitOut ! latent capacity output
REAL(r64), SAVE :: TotalZoneLatentLoad ! Total ZONE latent load
REAL(r64), SAVE :: TotalZoneSensibleLoad ! Total ZONE sensible load
REAL(r64) :: ActualSensibleOutput ! Actual furnace sensible capacity
REAL(r64) :: ReheatCoilLoad ! reheat coil load due to dehumidification
REAL(r64), SAVE :: SystemSensibleLoad ! Positive value means heating required
REAL(r64) :: QToHeatSetPt ! Load required to meet heating setpoint temp (>0 is a heating load)
REAL(r64) :: NoCompOutput ! output when no active compressor [W]
INTEGER :: TotBranchNum ! total exit branch number
INTEGER :: ZoneSideNodeNum ! zone equip supply node
LOGICAL :: EconoActive ! TRUE if Economizer is active
! to be removed by furnace/unitary system
! zero the fan, DX coils, and supplemental electric heater electricity consumption
FanElecPower = 0.0d0
DXElecHeatingPower = 0.0d0
DXElecCoolingPower = 0.0d0
SaveCompressorPLR = 0.0d0
ElecHeatingCoilPower = 0.0d0
SystemSensibleLoad = QZnReq
TotalZoneSensibleLoad = QZnReq
TotalZoneLatentLoad = QLatReq
! initialize local variables
UnitOn = .TRUE.
OutletNode = Furnace(FurnaceNum)%FurnaceOutletNodeNum
InletNode = Furnace(FurnaceNum)%FurnaceInletNodeNum
AirMassFlow = Furnace(FurnaceNum)%DesignMassFlowRate
OpMode = Furnace(FurnaceNum)%OpMode
ZoneNum = Furnace(FurnaceNum)%ControlZoneNum
CompOp = On
!Set latent load for heating
IF(HeatingLoad)THEN
Furnace(FurnaceNum)%HeatCoolMode = HeatingMode
!Set latent load for cooling and no sensible load condition
ELSE IF(CoolingLoad) THEN
Furnace(FurnaceNum)%HeatCoolMode = CoolingMode
ELSE
Furnace(FurnaceNum)%HeatCoolMode = 0
ENDIF
! set the on/off flags
IF (Furnace(FurnaceNum)%OPMode == CycFanCycCoil) THEN
! cycling unit only runs if there is a cooling or heating load.
IF (ABS(QZnReq) < SmallLoad .OR. AirMassFlow < SmallMassFlow .OR. CurDeadbandOrSetback(ZoneNum)) THEN
UnitOn = .FALSE.
END IF
ELSE IF (Furnace(FurnaceNum)%OPMode == ContFanCycCoil) THEN
! continuous unit: fan runs if scheduled on; coil runs only if there is a cooling or heating load
IF (AirMassFlow.LT.SmallMassFlow) THEN
UnitOn = .FALSE.
END IF
END IF
OnOffFanPartLoadFraction = 1.0d0
AirLoopNumber = ZoneEquipConfig(Furnace(FurnaceNum)%ControlZoneNum)%AirLoopNum
IF(AirLoopNumber /= 0) THEN
EconoActive = AirLoopControlInfo(AirLoopNumber)%EconoActive
ELSE
EconoActive = .FALSE.
END IF
SaveMassFlowRate = Node(InletNode)%MassFlowRate
IF ( .NOT. FirstHVACIteration .AND. Furnace(FurnaceNum)%OPMode == CycFanCycCoil .AND. &
(QZnReq < (-1.d0*SmallLoad) .OR. TotalZoneLatentLoad < (-1.d0*SmallLoad) ) &
.AND. EconoActive) THEN
! for cycling fan, cooling load, check whether furnace can meet load with compressor off
CompOp = Off
CALL ControlVSHPOutput(FurnaceNum,FirstHVACIteration,CompOp,OpMode,TotalZoneSensibleLoad, TotalZoneLatentLoad,ZoneNum, &
SpeedNum,SpeedRatio,PartLoadFrac,OnOffAirFlowRatio,SupHeaterLoad)
TotalZoneSensibleLoad = QZnReq
TotalZoneLatentLoad = QLatReq
IF (SpeedNum .EQ. Furnace(FurnaceNum)%NumOfSpeedCooling .AND. SpeedRatio .EQ. 1.0d0) THEN
! compressor on (reset inlet air mass flow rate to starting value)
Node(InletNode)%MassFlowRate = SaveMassFlowRate
CompOp = On
CALL ControlVSHPOutput(FurnaceNum,FirstHVACIteration,CompOp,OpMode,TotalZoneSensibleLoad,TotalZoneLatentLoad,ZoneNum, &
SpeedNum,SpeedRatio,PartLoadFrac,OnOffAirFlowRatio,SupHeaterLoad)
END IF
ELSE
! compressor on
CompOp = On
! if(QZnReq < -1000.0 .AND. FurnaceNum == 1 ) then
! CompOp = On
! end if
CALL ControlVSHPOutput(FurnaceNum,FirstHVACIteration,CompOp,OpMode,TotalZoneSensibleLoad,TotalZoneLatentLoad,ZoneNum, &
SpeedNum,SpeedRatio,PartLoadFrac,OnOffAirFlowRatio,SupHeaterLoad)
END IF
IF (Furnace(FurnaceNum)%FurnaceType_Num == UnitarySys_HeatCool) THEN
SaveCompressorPLR = PartLoadFrac
ELSE
IF(SpeedNum > 1) THEN
SaveCompressorPLR = 1.0d0
END IF
IF (PartLoadFrac .eq. 1.0d0 .and. SaveCompressorPLR < 1.0d0) then
PartLoadFrac = SaveCompressorPLR
End IF
END IF
ReheatCoilLoad = 0.0d0
TotalZoneSensibleLoad = QZnReq
TotalZoneLatentLoad = QLatReq
! Calculate the reheat coil output
IF((GetCurrentScheduleValue(Furnace(FurnaceNum)%SchedPtr) .gt. 0.0d0 .and. CoolingLoad) .AND. &
(Furnace(FurnaceNum)%Humidistat .AND. &
Furnace(FurnaceNum)%DehumidControlType_Num == DehumidControl_CoolReheat .and. &
(QLatReq.lt.0.0d0))) THEN ! if a Humidistat is installed and dehumdification control type is CoolReheat
CALL CalcVarSpeedHeatPump(FurnaceNum,FirstHVACIteration,CompOp,SpeedNum,SpeedRatio,PartLoadFrac,ActualSensibleOutput, &
QLatUnitOut, TotalZoneSensibleLoad,TotalZoneLatentLoad, OnOffAirFlowRatio,ReheatCoilLoad)
IF (Furnace(FurnaceNum)%ZoneSequenceHeatingNum > 0) THEN
QToHeatSetPt=(ZoneSysEnergyDemand(Furnace(FurnaceNum)%ControlZoneNum)% &
SequencedOutputRequiredToHeatingSP(Furnace(FurnaceNum)%ZoneSequenceHeatingNum) / &
Furnace(FurnaceNum)%ControlZoneMassFlowFrac)
ELSE
QToHeatSetPt=(ZoneSysEnergyDemand(Furnace(FurnaceNum)%ControlZoneNum)%OutputRequiredToHeatingSP / &
Furnace(FurnaceNum)%ControlZoneMassFlowFrac)
ENDIF
! Cooling mode or floating condition and dehumidification is required
IF(QToHeatSetPt .LT. 0.0d0)THEN
! Calculate the reheat coil load wrt the heating setpoint temperature. Reheat coil picks up
! the entire excess sensible cooling (DX cooling coil and impact of outdoor air).
ReheatCoilLoad = MAX(0.0d0,(QToHeatSetPt-ActualSensibleOutput))
Furnace(FurnaceNum)%DehumidInducedHeatingDemandRate = ReheatCoilLoad
! Heating mode and dehumidification is required
ELSEIF(QToHeatSetPt .GE. 0.0d0)THEN
ReheatCoilLoad = MAX(QToHeatSetPt,QToHeatSetPt-ActualSensibleOutput)
Furnace(FurnaceNum)%DehumidInducedHeatingDemandRate = MAX(0.0d0,ActualSensibleOutput*(-1.0d0))
ELSE
ReheatCoilLoad = 0.0d0
END IF
SupHeaterLoad = 0.0d0
CALL CalcVarSpeedHeatPump(FurnaceNum,FirstHVACIteration,CompOp,1,0.0d0,0.0d0,NoCompOutput, QLatUnitOut, &
0.0d0, 0.0d0, OnOffAirFlowRatio,SupHeaterLoad)
IF(NoCompOutput > SystemSensibleLoad .AND. SystemSensibleLoad > 0.0d0 .AND. ReHeatCoilLoad > 0.0d0) THEN
!Reduce reheat coil load if you are controlling high humidity but outside air
! and/or the supply air fan is providing enough heat to meet the system sensible load.
! This will bring the zone temp closer to the heating setpoint temp.
ReHeatCoilLoad = MAX(0.0d0,ReHeatCoilLoad-(NoCompOutput-SystemSensibleLoad))
END IF
ELSE
! No humidistat installed
ReheatCoilLoad = 0.0d0
END IF
TotalZoneSensibleLoad = QZnReq
TotalZoneLatentLoad = QLatReq
IF(ReHeatCoilLoad > 0.0d0) THEN
CALL CalcVarSpeedHeatPump(FurnaceNum,FirstHVACIteration,CompOp,SpeedNum,SpeedRatio,PartLoadFrac,QSensUnitOut, QLatUnitOut, &
TotalZoneSensibleLoad,TotalZoneLatentLoad,OnOffAirFlowRatio,ReHeatCoilLoad)
ELSE
CALL CalcVarSpeedHeatPump(FurnaceNum,FirstHVACIteration,CompOp,SpeedNum,SpeedRatio,PartLoadFrac,QSensUnitOut, QLatUnitOut, &
TotalZoneSensibleLoad,TotalZoneLatentLoad,OnOffAirFlowRatio,SupHeaterLoad)
END IF
! calculate delivered capacity
AirMassFlow = Node(InletNode)%MassFlowRate
Furnace(FurnaceNum)%MdotFurnace = AirMassFlow
QTotUnitOut = AirMassFlow * (Node(OutletNode)%Enthalpy - Node(Furnace(FurnaceNum)%NodeNumofControlledZone)%Enthalpy)
Node(InletNode)%MassFlowRateMaxAvail = AirMassFlow
Node(OutletNode)%MassFlowRateMaxAvail = AirMassFlow
If(.NOT. FirstHVACIteration .AND. AirMassFlow > 0.0d0 .AND. AirLoopNumber > 0 ) THEN
TotBranchNum = PrimaryAirSystem(AirLoopNumber)%NumOutletBranches
IF(TotBranchNum .EQ. 1) THEN
ZoneSideNodeNum = AirToZoneNodeInfo(AirLoopNumber)%ZoneEquipSupplyNodeNum(1)
! THE MASS FLOW PRECISION of the system solver is not enough for some small air flow rate iterations , BY DEBUGGING
! it may cause mass flow rate occilations between airloop and zoneequip
! specify the air flow rate directly for one-to-one system, when the iteration deviation is closing the solver precision level
IF(ABS(AirMassFlow - Node(ZoneSideNodeNum)%MassFlowRate) < 0.02d0) &
! 0.02 is 2 * HVACFlowRateToler, in order to accomodate the system solver precision level
Node(ZoneSideNodeNum)%MassFlowRateMaxAvail = AirMassFlow
Node(ZoneSideNodeNum)%MassFlowRate = AirMassFlow
END IF
! the below might be useful if more divergences occur
! Node(PrimaryAirSystem(AirLoopNumber)%Branch(1)%NodeNumIn)%MassFlowRateMaxAvail = AirMassFlow
! Node(PrimaryAirSystem(AirLoopNumber)%Branch(1)%NodeNumIn)%MassFlowRate = AirMassFlow
END IF
! report variables
Furnace(FurnaceNum)%DehumidInducedHeatingDemandRate = ReheatCoilLoad
IF(QZnReq > SmallLoad ) THEN !HEATING LOAD
Furnace(FurnaceNum)%CoolingCoilSensDemand = 0.0d0
Furnace(FurnaceNum)%HeatingCoilSensDemand = QZnReq
ELSE
Furnace(FurnaceNum)%CoolingCoilSensDemand = ABS(QZnReq)
Furnace(FurnaceNum)%HeatingCoilSensDemand = 0.0d0
END IF
Furnace(FurnaceNum)%CompPartLoadRatio = SaveCompressorPLR
IF (Furnace(FurnaceNum)%OpMode .EQ. CycFanCycCoil) THEN
If (SupHeaterLoad >0.0d0) Then
Furnace(FurnaceNum)%FanPartLoadRatio = 1.0d0
Else
If (SpeedNum .LT. 2) Then
Furnace(FurnaceNum)%FanPartLoadRatio = PartLoadFrac
Else
Furnace(FurnaceNum)%FanPartLoadRatio = 1.0d0
End If
End If
ELSE
IF (UnitOn) THEN
Furnace(FurnaceNum)%FanPartLoadRatio = 1.0d0
ELSE
If (SpeedNum .LT. 2) Then
Furnace(FurnaceNum)%FanPartLoadRatio = PartLoadFrac
Else
Furnace(FurnaceNum)%FanPartLoadRatio = 1.0d0
End If
END IF
END IF
RETURN
END SUBROUTINE SimVariableSpeedHP