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) | :: | PTUnitNum | |||
integer, | intent(in) | :: | ZoneNum | |||
logical, | intent(in) | :: | FirstHVACIteration | |||
real(kind=r64), | intent(in) | :: | QZnReq | |||
real(kind=r64), | intent(in) | :: | QLatReq | |||
real(kind=r64), | intent(inout) | :: | OnOffAirFlowRatio | |||
integer, | intent(in) | :: | OpMode | |||
logical, | intent(in) | :: | HXUnitOn |
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(PTUnitNum,ZoneNum, FirstHVACIteration, QZnReq, QLatReq, OnOffAirFlowRatio, OpMode, HXUnitOn )
! 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 DataZoneEquipment, ONLY: ZoneEquipConfig
USE DataAirLoop, ONLY: AirLoopControlInfo, AirToZoneNodeInfo
USE DataAirSystems, ONLY: PrimaryAirSystem
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) :: PTUnitNum ! 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
INTEGER, INTENT (IN) :: ZoneNum ! Controlled zone number
REAL(r64), INTENT (INOUT) :: OnOffAirFlowRatio ! ratio of compressor ON airflow to AVERAGE airflow over timestep
INTEGER, INTENT (IN) :: OpMode ! operating mode: CycFanCycCoil | ContFanCycCoil
LOGICAL, INTENT (IN) :: HXUnitOn ! flag to enable heat exchanger
! SUBROUTINE PARAMETER DEFINITIONS:
! na
! INTERFACE BLOCK SPECIFICATIONS
! na
! DERIVED TYPE DEFINITIONS
! na
! SUBROUTINE LOCAL VARIABLE DECLARATIONS:
REAL(r64) :: PartLoadFrac = 0.0d0 ! compressor part load fraction
REAL(r64) :: SpeedRatio = 0.0d0 ! 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]
REAL(r64) :: QTotUnitOut ! capacity output
INTEGER :: SpeedNum = 1 ! Speed number
REAL(r64) :: SupHeaterLoad ! supplement heater load
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
INTEGER :: CompOp ! compressor operation; 1=on, 0=off
REAL(r64), SAVE :: TotalZoneLatentLoad ! Total ZONE heating load (not including outside air)
INTEGER :: TotBranchNum ! total outlet branch number
INTEGER :: ZoneSideNodeNum ! zone equip supply node
LOGICAL :: EconoActive ! TRUE if Economizer is active
! 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
! initialize local variables
UnitOn = .TRUE.
CompOp = 1
OutletNode = PTUnit(PTUnitNum)%AirOutNode
InletNode = PTUnit(PTUnitNum)%AirInNode
AirMassFlow = PTUnit(PTUnitNum)%MaxCoolAirMassFlow
!Set latent load for heating
IF(HeatingLoad)THEN
TotalZoneLatentLoad = 0.0d0
PTUnit(PTUnitNum)%HeatCoolMode = HeatingMode
!Set latent load for cooling and no sensible load condition
ELSE
TotalZoneLatentLoad = QLatReq
PTUnit(PTUnitNum)%HeatCoolMode = CoolingMode
ENDIF
If (HeatingLoad) then
PTUnit(PTUnitNum)%HeatCoolMode = HeatingMode
Else If (CoolingLoad) then
PTUnit(PTUnitNum)%HeatCoolMode = CoolingMode
Else
PTUnit(PTUnitNum)%HeatCoolMode = 0
End If
! set the on/off flags
IF (PTUnit(PTUnitNum)%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 (PTUnit(PTUnitNum)%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(ZoneNum)%AirLoopNum
IF(AirLoopNumber /= 0) THEN
EconoActive = AirLoopControlInfo(AirLoopNumber)%EconoActive
ELSE
EconoActive = .FALSE.
END IF
SaveMassFlowRate = Node(InletNode)%MassFlowRate
IF ( .NOT. FirstHVACIteration .AND. PTUnit(PTUnitNum)%OPMode == CycFanCycCoil .AND. &
(QZnReq < (-1.d0*SmallLoad) .OR. TotalZoneLatentLoad > SmallLoad ) &
.AND. EconoActive ) THEN
! for cycling fan, cooling load, check whether furnace can meet load with compressor off
CompOp = Off
CALL ControlVSHPOutput(PTUnitNum,FirstHVACIteration,CompOp,OpMode,QZnReq, &
TotalZoneLatentLoad,ZoneNum,SpeedNum,SpeedRatio, &
PartLoadFrac,OnOffAirFlowRatio,SupHeaterLoad, HXUnitOn )
IF (SpeedNum .EQ. PTUnit(PTUnitNum)%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(PTUnitNum,FirstHVACIteration,CompOp,OpMode,QZnReq,TotalZoneLatentLoad,&
ZoneNum,SpeedNum,SpeedRatio, &
PartLoadFrac,OnOffAirFlowRatio,SupHeaterLoad, HXUnitOn )
END IF
ELSE
! compressor on
CompOp = On
CALL ControlVSHPOutput(PTUnitNum,FirstHVACIteration,CompOp,OpMode,QZnReq,TotalZoneLatentLoad,&
ZoneNum,SpeedNum,SpeedRatio, &
PartLoadFrac,OnOffAirFlowRatio,SupHeaterLoad, HXUnitOn )
END IF
IF (PTUnit(PTUnitNum)%UnitType_Num .EQ. PTACUnit) 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
CALL CalcVarSpeedHeatPump(PTUnitNum, ZoneNum, FirstHVACIteration,CompOp,SpeedNum,SpeedRatio,PartLoadFrac,&
QSensUnitOut, QLatUnitOut, &
QZnReq,TotalZoneLatentLoad,OnOffAirFlowRatio,SupHeaterLoad, HXUnitOn )
! calculate delivered capacity
AirMassFlow = Node(InletNode)%MassFlowRate
QTotUnitOut = AirMassFlow * (Node(OutletNode)%Enthalpy - Node(InletNode)%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
PTUnit(PTUnitNum)%CompPartLoadRatio = SaveCompressorPLR
IF (PTUnit(PTUnitNum)%OpMode .EQ. CycFanCycCoil) THEN
If (SupHeaterLoad >0.0d0) Then
PTUnit(PTUnitNum)%FanPartLoadRatio = 1.0d0
Else
If (SpeedNum .LT. 2) Then
PTUnit(PTUnitNum)%FanPartLoadRatio = PartLoadFrac
Else
PTUnit(PTUnitNum)%FanPartLoadRatio = 1.0d0
End If
End If
ELSE
IF (UnitOn) THEN
PTUnit(PTUnitNum)%FanPartLoadRatio = 1.0d0
ELSE
If (SpeedNum .LT. 2) Then
PTUnit(PTUnitNum)%FanPartLoadRatio = PartLoadFrac
Else
PTUnit(PTUnitNum)%FanPartLoadRatio = 1.0d0
End If
END IF
END IF
RETURN
END SUBROUTINE SimVariableSpeedHP