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) | :: | MSHeatPumpNum | |||
logical, | intent(in) | :: | FirstHVACIteration | |||
real(kind=r64), | intent(inout) | :: | QSensUnitOut | |||
real(kind=r64), | intent(in) | :: | QZnReq | |||
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 SimMSHP(MSHeatPumpNum,FirstHVACIteration, QSensUnitOut, QZnReq, OnOffAirFlowRatio)
! SUBROUTINE INFORMATION:
! AUTHOR Lixing Gu
! DATE WRITTEN June 2007
! MODIFIED na
! RE-ENGINEERED Revised based on SimPTHP
! 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
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) :: MSHeatPumpNum ! number of the current engine driven Heat Pump being simulated
REAL(r64), INTENT (IN) :: QZnReq ! required zone load
REAL(r64), INTENT (INOUT) :: QSensUnitOut ! cooling/heating deliveded to zones [W]
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
INTEGER :: SpeedNum ! Speed number
REAL(r64) :: SupHeaterLoad
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]
! 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.
OutletNode = MSHeatPump(MSHeatPumpNum)%AirOutletNodeNum
InletNode = MSHeatPump(MSHeatPumpNum)%AirInletNodeNum
AirMassFlow = Node(InletNode)%MassFlowRate
OpMode = MSHeatPump(MSHeatPumpNum)%OpMode
ZoneNum = MSHeatPump(MSHeatPumpNum)%ControlZoneNum
CompOp = On
! set the on/off flags
IF (MSHeatPump(MSHeatPumpNum)%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 (MSHeatPump(MSHeatPumpNum)%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(MSHeatPump(MSHeatPumpNum)%ControlZoneNum)%AirLoopNum
SaveMassFlowRate = Node(InletNode)%MassFlowRate
IF ( .NOT. FirstHVACIteration .AND. MSHeatPump(MSHeatPumpNum)%OPMode == CycFanCycCoil .AND. QZnReq < 0.0d0 &
.AND. AirLoopControlInfo(AirLoopNumber)%EconoActive) THEN
! for cycling fan, cooling load, check whether furnace can meet load with compressor off
CompOp = Off
CALL ControlMSHPOutput(MSHeatPumpNum,FirstHVACIteration,CompOp,OpMode,QZnReq,ZoneNum,SpeedNum,SpeedRatio, &
PartLoadFrac,OnOffAirFlowRatio,SupHeaterLoad)
IF (SpeedNum .EQ. MSHeatPump(MSHeatPumpNum)%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 ControlMSHPOutput(MSHeatPumpNum,FirstHVACIteration,CompOp,OpMode,QZnReq,ZoneNum,SpeedNum,SpeedRatio, &
PartLoadFrac,OnOffAirFlowRatio,SupHeaterLoad)
END IF
ELSE
! compressor on
CALL ControlMSHPOutput(MSHeatPumpNum,FirstHVACIteration,CompOp,OpMode,QZnReq,ZoneNum,SpeedNum,SpeedRatio, &
PartLoadFrac,OnOffAirFlowRatio,SupHeaterLoad)
END IF
IF (MSHeatPump(MSHeatPumpNum)%HeatCoilType .NE. MultiSpeedHeatingCoil) THEN
SaveCompressorPLR = PartLoadFrac
ELSE
IF(SpeedNum > 1) THEN
SaveCompressorPLR = 1.0d0
END IF
If (PartLoadFrac .eq. 1.0d0 .and. SaveCompressorPLR < 1.0d0 .AND. (.NOT. MSHeatPump(MSHeatPumpNum)%Staged)) then
PartLoadFrac = SaveCompressorPLR
End If
END IF
CALL CalcMSHeatPump(MSHeatPumpNum,FirstHVACIteration,CompOp,SpeedNum,SpeedRatio,PartLoadFrac,QSensUnitOut, &
QZnReq,OnOffAirFlowRatio,SupHeaterLoad)
! calculate delivered capacity
AirMassFlow = Node(InletNode)%MassFlowRate
QTotUnitOut = AirMassFlow * (Node(OutletNode)%Enthalpy - Node(MSHeatPump(MSHeatPumpNum)%NodeNumofControlledZone)%Enthalpy)
! report variables
MSHeatPump(MSHeatPumpNum)%CompPartLoadRatio = SaveCompressorPLR
IF (MSHeatPump(MSHeatPumpNum)%OpMode .EQ. CycFanCycCoil) THEN
If (SupHeaterLoad >0.0d0) Then
MSHeatPump(MSHeatPumpNum)%FanPartLoadRatio = 1.0d0
Else
If (SpeedNum .LT. 2) Then
MSHeatPump(MSHeatPumpNum)%FanPartLoadRatio = PartLoadFrac
Else
MSHeatPump(MSHeatPumpNum)%FanPartLoadRatio = 1.0d0
End If
End If
ELSE
IF (UnitOn) THEN
MSHeatPump(MSHeatPumpNum)%FanPartLoadRatio = 1.0d0
ELSE
If (SpeedNum .LT. 2) Then
MSHeatPump(MSHeatPumpNum)%FanPartLoadRatio = PartLoadFrac
Else
MSHeatPump(MSHeatPumpNum)%FanPartLoadRatio = 1.0d0
End If
END IF
END IF
If (MSHeatPump(MSHeatPumpNum)%HeatCoolMode == HeatingMode) Then
MSHeatPump(MSHeatPumpNum)%TotHeatEnergyRate = ABS(MAX(0.0d0, QTotUnitOut))
MSHeatPump(MSHeatPumpNum)%SensHeatEnergyRate = ABS(MAX(0.0d0, QSensUnitOut))
MSHeatPump(MSHeatPumpNum)%LatHeatEnergyRate = ABS(MAX(0.0d0, (QTotUnitOut - QSensUnitOut)))
MSHeatPump(MSHeatPumpNum)%TotCoolEnergyRate = 0.0d0
MSHeatPump(MSHeatPumpNum)%SensCoolEnergyRate = 0.0d0
MSHeatPump(MSHeatPumpNum)%LatCoolEnergyRate = 0.0d0
End If
If (MSHeatPump(MSHeatPumpNum)%HeatCoolMode == CoolingMode) Then
MSHeatPump(MSHeatPumpNum)%TotCoolEnergyRate = ABS(MIN(0.0d0, QTotUnitOut))
MSHeatPump(MSHeatPumpNum)%SensCoolEnergyRate = ABS(MIN(0.0d0, QSensUnitOut))
MSHeatPump(MSHeatPumpNum)%LatCoolEnergyRate = ABS(MIN(0.0d0, (QTotUnitOut - QSensUnitOut)))
MSHeatPump(MSHeatPumpNum)%TotHeatEnergyRate = 0.0d0
MSHeatPump(MSHeatPumpNum)%SensHeatEnergyRate = 0.0d0
MSHeatPump(MSHeatPumpNum)%LatHeatEnergyRate = 0.0d0
End If
MSHeatPump(MSHeatPumpNum)%AuxElecPower = MSHeatPump(MSHeatPumpNum)%AuxOnCyclePower*SaveCompressorPLR + &
MSHeatPump(MSHeatPumpNum)%AuxOffCyclePower*(1.0d0-SaveCompressorPLR)
IF (MSHeatPump(MSHeatPumpNum)%HeatCoilType .NE. MultiSpeedHeatingCoil) THEN
SELECT CASE (MSHeatPump(MSHeatPumpNum)%HeatCoilType)
CASE (Coil_HeatingGas_MultiStage, Coil_HeatingElectric_MultiStage)
MSHeatPump(MSHeatPumpNum)%ElecPower = FanElecPower + DXElecCoolingPower + ElecHeatingCoilPower
CASE (Coil_HeatingWater, Coil_HeatingSteam)
MSHeatPump(MSHeatPumpNum)%ElecPower = FanElecPower + DXElecCoolingPower
CASE DEFAULT
END SELECT
ELSE
MSHeatPump(MSHeatPumpNum)%ElecPower = FanElecPower + DXElecCoolingPower + DXElecHeatingPower + ElecHeatingCoilPower + &
MSHeatPump(MSHeatPumpNum)%AuxElecPower
ENDIF
RETURN
END SUBROUTINE SimMSHP