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.
!LKL Discrepancy with > 0
Type | Intent | Optional | Attributes | Name | ||
---|---|---|---|---|---|---|
integer, | intent(in) | :: | MSHeatPumpNum | |||
real(kind=r64), | intent(in) | :: | PartLoadRatio | |||
real(kind=r64), | intent(inout) | :: | OnOffAirFlowRatio | |||
integer, | intent(in), | optional | :: | SpeedNum | ||
real(kind=r64), | intent(in), | optional | :: | SpeedRatio |
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 SetAverageAirFlow(MSHeatPumpNum,PartLoadRatio,OnOffAirFlowRatio,SpeedNum,SpeedRatio)
! SUBROUTINE INFORMATION:
! AUTHOR Lixing
! DATE WRITTEN June 2007
! MODIFIED na
! RE-ENGINEERED Resived to meet requirements of multispeed heat pump based on the same subroutine
! in PTHP module
! PURPOSE OF THIS SUBROUTINE:
! Set the average air mass flow rates using the part load fraction of the heat pump for this time step
! Set OnOffAirFlowRatio to be used by DX coils
! METHODOLOGY EMPLOYED:
! na
! REFERENCES:
! na
! USE STATEMENTS:
USE DataZoneEnergyDemands, ONLY: CurDeadBandOrSetback
USE DataHVACGlobals, ONLY: MSHPMassFlowRateLow, MSHPMassFlowRateHigh
IMPLICIT NONE ! Enforce explicit typing of all variables in this routine
! SUBROUTINE ARGUMENT DEFINITIONS:
INTEGER, INTENT (IN) :: MSHeatPumpNum ! Unit index
REAL(r64) , INTENT (IN) :: PartLoadRatio ! unit part load ratio
REAL(r64) , INTENT (INOUT) :: OnOffAirFlowRatio ! ratio of compressor ON airflow to average airflow over timestep
INTEGER, INTENT (IN),OPTIONAL :: SpeedNum ! Speed number
REAL(r64), INTENT (IN),OPTIONAL :: SpeedRatio ! Speed ratio
! SUBROUTINE PARAMETER DEFINITIONS:
! na
! INTERFACE BLOCK SPECIFICATIONS
! na
! DERIVMS TYPE DEFINITIONS
! na
! SUBROUTINE LOCAL VARIABLE DECLARATIONS:
INTEGER :: InletNode ! inlet node number for PTHPNum
REAL(r64) :: AverageUnitMassFlow ! average supply air mass flow rate over time step
MSHPMassFlowRateLow = 0.0d0 ! Mass flow rate at low speed
MSHPMassFlowRateHigh = 0.0d0 ! Mass flow rate at high speed
If (.NOT. CurDeadbandOrSetback(MSHeatPump(MSHeatPumpNum)%ControlZoneNum) .AND. Present(SpeedNum) ) Then
If (MSHeatPump(MSHeatPumpNum)%HeatCoolMode == HeatingMode) Then
If (SpeedNum .eq. 1) Then
CompOnMassFlow = MSHeatPump(MSHeatPumpNum)%HeatMassFlowRate(SpeedNum)
CompOnFlowRatio = MSHeatPump(MSHeatPumpNum)%HeatingSpeedRatio(SpeedNum)
MSHPMassFlowRateLow = MSHeatPump(MSHeatPumpNum)%HeatMassFlowRate(1)
MSHPMassFlowRateHigh = MSHeatPump(MSHeatPumpNum)%HeatMassFlowRate(1)
Else If (SpeedNum .GT. 1) Then
CompOnMassFlow = SpeedRatio*MSHeatPump(MSHeatPumpNum)%HeatMassFlowRate(SpeedNum) + &
(1.0d0-SpeedRatio)*MSHeatPump(MSHeatPumpNum)%HeatMassFlowRate(SpeedNum-1)
CompOnFlowRatio = SpeedRatio*MSHeatPump(MSHeatPumpNum)%HeatingSpeedRatio(SpeedNum) + &
(1.0d0-SpeedRatio)*MSHeatPump(MSHeatPumpNum)%HeatingSpeedRatio(SpeedNum-1)
MSHPMassFlowRateLow = MSHeatPump(MSHeatPumpNum)%HeatMassFlowRate(SpeedNum-1)
MSHPMassFlowRateHigh = MSHeatPump(MSHeatPumpNum)%HeatMassFlowRate(SpeedNum)
End If
Else If (MSHeatPump(MSHeatPumpNum)%HeatCoolMode == CoolingMode) Then
If (SpeedNum .eq. 1) Then
CompOnMassFlow = MSHeatPump(MSHeatPumpNum)%CoolMassFlowRate(SpeedNum)
CompOnFlowRatio = MSHeatPump(MSHeatPumpNum)%CoolingSpeedRatio(SpeedNum)
MSHPMassFlowRateLow = MSHeatPump(MSHeatPumpNum)%CoolMassFlowRate(1)
MSHPMassFlowRateHigh = MSHeatPump(MSHeatPumpNum)%CoolMassFlowRate(1)
Else If (SpeedNum .GT. 1) Then
CompOnMassFlow = SpeedRatio*MSHeatPump(MSHeatPumpNum)%CoolMassFlowRate(SpeedNum) + &
(1.0d0-SpeedRatio)*MSHeatPump(MSHeatPumpNum)%CoolMassFlowRate(SpeedNum-1)
CompOnFlowRatio = SpeedRatio*MSHeatPump(MSHeatPumpNum)%CoolingSpeedRatio(SpeedNum) + &
(1.0d0-SpeedRatio)*MSHeatPump(MSHeatPumpNum)%CoolingSpeedRatio(SpeedNum-1)
MSHPMassFlowRateLow = MSHeatPump(MSHeatPumpNum)%CoolMassFlowRate(SpeedNum-1)
MSHPMassFlowRateHigh = MSHeatPump(MSHeatPumpNum)%CoolMassFlowRate(SpeedNum)
End If
End If
End If
InletNode = MSHeatPump(MSHeatPumpNum)%AirInletNodeNum
! Set up fan flow rate during compressor off time
If (MSHeatPump(MSHeatPumpNum)%OpMode .EQ. ContFanCycCoil .AND. Present(SpeedNum)) Then
IF (MSHeatPump(MSHeatPumpNum)%AirFlowControl .EQ. UseCompressorOnFlow .AND. CompOnMassFlow > 0.0d0) THEN
IF (MSHeatPump(MSHeatPumpNum)%LastMode .EQ. HeatingMode) THEN
CompOffMassFlow = MSHeatPump(MSHeatPumpNum)%HeatMassFlowRate(SpeedNum)
CompOffFlowRatio = MSHeatPump(MSHeatPumpNum)%HeatingSpeedRatio(SpeedNum)
ELSE
CompOffMassFlow = MSHeatPump(MSHeatPumpNum)%CoolMassFlowRate(SpeedNum)
CompOffFlowRatio = MSHeatPump(MSHeatPumpNum)%CoolingSpeedRatio(SpeedNum)
END IF
END IF
End If
If (Present(SpeedNum)) Then
If (SpeedNum > 1) Then
AverageUnitMassFlow = CompOnMassFlow
FanSpeedRatio = CompOnFlowRatio
Else
AverageUnitMassFlow = (PartLoadRatio * CompOnMassFlow) + ((1-PartLoadRatio) * CompOffMassFlow)
IF(CompOffFlowRatio .GT. 0.0d0)THEN
FanSpeedRatio = (PartLoadRatio * CompOnFlowRatio) + ((1-PartLoadRatio) * CompOffFlowRatio)
ELSE
FanSpeedRatio = CompOnFlowRatio
END IF
End If
Else
AverageUnitMassFlow = (PartLoadRatio * CompOnMassFlow) + ((1-PartLoadRatio) * CompOffMassFlow)
IF(CompOffFlowRatio .GT. 0.0d0)THEN
FanSpeedRatio = (PartLoadRatio * CompOnFlowRatio) + ((1-PartLoadRatio) * CompOffFlowRatio)
ELSE
FanSpeedRatio = CompOnFlowRatio
END IF
End If
!!!LKL Discrepancy with > 0
IF (GetCurrentScheduleValue(MSHeatPump(MSHeatPumpNum)%AvaiSchedPtr) .EQ. 0.0d0) THEN
Node(InletNode)%MassFlowRate = 0.0d0
OnOffAirFlowRatio = 0.0d0
ELSE
Node(InletNode)%MassFlowRate = AverageUnitMassFlow
Node(InletNode)%MassFlowRateMaxAvail = AverageUnitMassFlow
IF (AverageUnitMassFlow .GT. 0.0d0) THEN
OnOffAirFlowRatio = CompOnMassFlow / AverageUnitMassFlow
ELSE
OnOffAirFlowRatio = 0.0d0
END IF
END IF
RETURN
END SUBROUTINE SetAverageAirFlow