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 | |||
| 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 SetVSHPAirFlow(FurnaceNum,PartLoadRatio,OnOffAirFlowRatio,SpeedNum,SpeedRatio)
          ! SUBROUTINE INFORMATION:
          !       AUTHOR         Bo Shen, based on HVACMultiSpeedHeatPump:SetAverageAirFlow
          !       DATE WRITTEN   March, 2012
          !       MODIFIED       na
          !       RE-ENGINEERED  na
          ! 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)    :: FurnaceNum      ! 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
  INTEGER             :: OutNode                          ! Outlet node number in MSHP loop
  InletNode      = Furnace(FurnaceNum)%FurnaceInletNodeNum
  OutNode = Furnace(FurnaceNum)%FurnaceOutletNodeNum
  MSHPMassFlowRateLow = 0.0d0             ! Mass flow rate at low speed
  MSHPMassFlowRateHigh = 0.0d0            ! Mass flow rate at high speed
  IF (Furnace(FurnaceNum)%OpMode .EQ. ContFanCycCoil) THEN
   CompOffMassFlow = Furnace(FurnaceNum)%IdleMassFlowRate
   CompOffFlowRatio = Furnace(FurnaceNum)%IdleSpeedRatio
  ELSE
   CompOffMassFlow = 0.0d0
   CompOffFlowRatio = 0.0d0
  END IF
  IF (HeatingLoad .AND. (Furnace(FurnaceNum)%FurnaceType_Num == UnitarySys_HeatCool))THEN
      CompOnMassFlow = Furnace(FurnaceNum)%CoolMassFlowRate(Furnace(FurnaceNum)%NumOfSpeedCooling)
      CompOnFlowRatio = Furnace(FurnaceNum)%MSCoolingSpeedRatio(Furnace(FurnaceNum)%NumOfSpeedCooling)
      MSHPMassFlowRateLow = Furnace(FurnaceNum)%CoolMassFlowRate(Furnace(FurnaceNum)%NumOfSpeedCooling)
      MSHPMassFlowRateHigh = Furnace(FurnaceNum)%CoolMassFlowRate(Furnace(FurnaceNum)%NumOfSpeedCooling)
      AverageUnitMassFlow = (PartLoadRatio * CompOnMassFlow) + ((1-PartLoadRatio) * CompOffMassFlow)
      IF(CompOffFlowRatio .GT. 0.0d0)THEN
        FanSpeedRatio = (PartLoadRatio * CompOnFlowRatio) + ((1-PartLoadRatio) * CompOffFlowRatio)
      ELSE
        FanSpeedRatio     = CompOnFlowRatio
      END IF
  ELSE
     If (.NOT. CurDeadbandOrSetback(Furnace(FurnaceNum)%ControlZoneNum) .AND. Present(SpeedNum) ) Then
        If (Furnace(FurnaceNum)%HeatCoolMode == HeatingMode) Then
          If (SpeedNum .eq. 1) Then
            CompOnMassFlow = Furnace(FurnaceNum)%HeatMassFlowRate(SpeedNum)
            CompOnFlowRatio = Furnace(FurnaceNum)%MSHeatingSpeedRatio(SpeedNum)
            MSHPMassFlowRateLow = Furnace(FurnaceNum)%HeatMassFlowRate(1)
            MSHPMassFlowRateHigh = Furnace(FurnaceNum)%HeatMassFlowRate(1)
          Else If (SpeedNum .GT. 1) Then
            CompOnMassFlow = SpeedRatio*Furnace(FurnaceNum)%HeatMassFlowRate(SpeedNum) + &
                             (1.0-SpeedRatio)*Furnace(FurnaceNum)%HeatMassFlowRate(SpeedNum-1)
            CompOnFlowRatio = SpeedRatio*Furnace(FurnaceNum)%MSHeatingSpeedRatio(SpeedNum) + &
                             (1.0-SpeedRatio)*Furnace(FurnaceNum)%MSHeatingSpeedRatio(SpeedNum-1)
            MSHPMassFlowRateLow = Furnace(FurnaceNum)%HeatMassFlowRate(SpeedNum-1)
            MSHPMassFlowRateHigh = Furnace(FurnaceNum)%HeatMassFlowRate(SpeedNum)
          End If
        Else If (Furnace(FurnaceNum)%HeatCoolMode == CoolingMode) Then
          If (SpeedNum .eq. 1) Then
            CompOnMassFlow = Furnace(FurnaceNum)%CoolMassFlowRate(SpeedNum)
            CompOnFlowRatio = Furnace(FurnaceNum)%MSCoolingSpeedRatio(SpeedNum)
            MSHPMassFlowRateLow = Furnace(FurnaceNum)%CoolMassFlowRate(1)
            MSHPMassFlowRateHigh = Furnace(FurnaceNum)%CoolMassFlowRate(1)
          Else If (SpeedNum .GT. 1) Then
            CompOnMassFlow = SpeedRatio*Furnace(FurnaceNum)%CoolMassFlowRate(SpeedNum) + &
                             (1.0-SpeedRatio)*Furnace(FurnaceNum)%CoolMassFlowRate(SpeedNum-1)
            CompOnFlowRatio = SpeedRatio*Furnace(FurnaceNum)%MSCoolingSpeedRatio(SpeedNum) + &
                             (1.0-SpeedRatio)*Furnace(FurnaceNum)%MSCoolingSpeedRatio(SpeedNum-1)
            MSHPMassFlowRateLow = Furnace(FurnaceNum)%CoolMassFlowRate(SpeedNum-1)
            MSHPMassFlowRateHigh = Furnace(FurnaceNum)%CoolMassFlowRate(SpeedNum)
          End If
        End If
      End If
      ! Set up fan flow rate during compressor off time
      If (Furnace(FurnaceNum)%OpMode .EQ. ContFanCycCoil .AND. Present(SpeedNum)) Then
        IF (Furnace(FurnaceNum)%AirFlowControl .EQ. UseCompressorOnFlow .AND. CompOnMassFlow > 0.0d0) THEN
          IF(SpeedNum == 1) THEN  !LOWEST SPEED USE IDLE FLOW
            CompOffMassFlow = Furnace(FurnaceNum)%IdleMassFlowRate
            CompOffFlowRatio = Furnace(FurnaceNum)%IdleSpeedRatio
          ELSE IF (Furnace(FurnaceNum)%LastMode .EQ. HeatingMode) THEN
            CompOffMassFlow = Furnace(FurnaceNum)%HeatMassFlowRate(SpeedNum)
            CompOffFlowRatio = Furnace(FurnaceNum)%MSHeatingSpeedRatio(SpeedNum)
          ELSE
            CompOffMassFlow = Furnace(FurnaceNum)%CoolMassFlowRate(SpeedNum)
            CompOffFlowRatio = Furnace(FurnaceNum)%MSCoolingSpeedRatio(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
  END IF
  IF (GetCurrentScheduleValue(Furnace(FurnaceNum)%SchedPtr) .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
  Node(OutNode)%MassFlowRate  = Node(InletNode)%MassFlowRate
!  IF(abs(Node(OutNode)%MassFlowRate - 0.435)  < 0.001) THEN
!    Node(OutNode)%MassFlowRate  = Node(InletNode)%MassFlowRate
!  END IF
  RETURN
END SUBROUTINE SetVSHPAirFlow