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 | |||
integer, | intent(in) | :: | AirLoopNum | |||
real(kind=r64), | intent(inout) | :: | OnOffAirFlowRatio | |||
integer, | intent(in) | :: | OpMode | |||
real(kind=r64), | intent(in) | :: | ZoneLoad | |||
real(kind=r64), | intent(in) | :: | MoistureLoad | |||
real(kind=r64), | intent(in) | :: | PartLoadRatio |
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 SetOnOffMassFlowRate(FurnaceNum, AirLoopNum, OnOffAirFlowRatio, OpMode, ZoneLoad, MoistureLoad, PartLoadRatio)
! SUBROUTINE INFORMATION:
! AUTHOR Richard Raustad
! DATE WRITTEN Sep 2008
! MODIFIED na
! RE-ENGINEERED na
! PURPOSE OF THIS SUBROUTINE:
! This subroutine is for initializations of the Furnace Components.
! METHODOLOGY EMPLOYED:
! The HeatCool furnace/unitarysystem and air-to-air heat pump may have alternate air flow rates
! in cooling, heating, and when no cooling or heating is needed. Set up the coil (comp) ON and OFF
! air flow rates. Use these flow rates during the Calc routines to set the average mass flow rates
! based on PLR.
! REFERENCES:
! na
! USE STATEMENTS:
USE General, ONLY: RoundSigDigits
IMPLICIT NONE ! Enforce explicit typing of all variables in this routine
! SUBROUTINE ARGUMENT DEFINITIONS:
INTEGER, INTENT(IN) :: FurnaceNum ! index to furnace
INTEGER, INTENT(IN) :: AirLoopNum ! index to air loop !unused1208
REAL(r64), INTENT(INOUT) :: OnOffAirFlowRatio ! ratio of coil on to coil off air flow rate
INTEGER, INTENT(IN) :: OpMode ! fan operating mode
REAL(r64), INTENT(IN) :: ZoneLoad ! sensible load to be met (W) !unused1208
REAL(r64), INTENT(IN) :: MoistureLoad ! moisture load to be met (W)
REAL(r64), INTENT(IN) :: PartLoadRatio ! coil part-load ratio
! SUBROUTINE PARAMETER DEFINITIONS:
! na
! INTERFACE BLOCK SPECIFICATIONS
! na
! DERIVED TYPE DEFINITIONS
! na
! SUBROUTINE LOCAL VARIABLE DECLARATIONS:
! na
! FLOW:
! Check for heat only furnace
IF(Furnace(FurnaceNum)%FurnaceType_Num .NE. Furnace_HeatOnly .AND. &
Furnace(FurnaceNum)%FurnaceType_Num .NE. UnitarySys_HeatOnly)THEN
! Set the system mass flow rates
IF (OpMode .EQ. ContFanCycCoil) THEN
! Set the compressor or coil ON mass flow rate
! constant fan mode
IF ( HeatingLoad ) THEN
! IF a heating and moisture load exists, operate at the cooling mass flow rate ELSE operate at the heating flow rate
IF(MoistureLoad .LT. 0.0d0 .AND. Furnace(FurnaceNum)%Humidistat .AND. &
Furnace(FurnaceNum)%DehumidControlType_Num == DehumidControl_CoolReheat)THEN
CompOnMassFlow = Furnace(FurnaceNum)%MaxCoolAirMassFlow
CompOnFlowRatio = Furnace(FurnaceNum)%CoolingSpeedRatio
ELSE
CompOnMassFlow = Furnace(FurnaceNum)%MaxHeatAirMassFlow
CompOnFlowRatio = Furnace(FurnaceNum)%HeatingSpeedRatio
END IF
Furnace(FurnaceNum)%LastMode = HeatingMode
! IF a cooling load exists, operate at the cooling mass flow rate
ELSE IF ( CoolingLoad ) THEN
CompOnMassFlow = Furnace(FurnaceNum)%MaxCoolAirMassFlow
CompOnFlowRatio = Furnace(FurnaceNum)%CoolingSpeedRatio
Furnace(FurnaceNum)%LastMode = CoolingMode
! If no load exists, set the compressor on mass flow rate.
! Set equal the mass flow rate when no heating or cooling is needed if no moisture load exists.
! If the user has set the off mass flow rate to 0, set according to the last operating mode.
ELSE
IF(MoistureLoad .LT. 0.0d0 .AND. Furnace(FurnaceNum)%Humidistat .AND. &
Furnace(FurnaceNum)%DehumidControlType_Num == DehumidControl_CoolReheat)THEN
CompOnMassFlow = Furnace(FurnaceNum)%MaxCoolAirMassFlow
CompOnFlowRatio = Furnace(FurnaceNum)%CoolingSpeedRatio
ELSE
CompOnMassFlow = Furnace(FurnaceNum)%MaxNoCoolHeatAirMassFlow
CompOnFlowRatio = Furnace(FurnaceNum)%HeatingSpeedRatio
! User may have entered a 0 for MaxNoCoolHeatAirMassFlow
IF(CompOnMassFlow .EQ. 0.0d0)THEN
IF(Furnace(FurnaceNum)%LastMode .EQ. HeatingMode)THEN
CompOnMassFlow = Furnace(FurnaceNum)%MaxHeatAirMassFlow
CompOnFlowRatio = Furnace(FurnaceNum)%HeatingSpeedRatio
ELSE
CompOnMassFlow = Furnace(FurnaceNum)%MaxCoolAirMassFlow
CompOnFlowRatio = Furnace(FurnaceNum)%CoolingSpeedRatio
END IF
END IF
END IF
END IF
! Set the compressor or coil OFF mass flow rate based on LOGICAL flag
! UseCompressorOnFlow is used when the user does not enter a value for no cooling or heating flow rate
IF (Furnace(FurnaceNum)%AirFlowControl .EQ. UseCompressorOnFlow) THEN
IF (Furnace(FurnaceNum)%LastMode .EQ. HeatingMode) THEN
IF(MoistureLoad .LT. 0.0d0 .AND. Furnace(FurnaceNum)%Humidistat .AND. &
Furnace(FurnaceNum)%DehumidControlType_Num == DehumidControl_CoolReheat)THEN
CompOffMassFlow = Furnace(FurnaceNum)%MaxCoolAirMassFlow
CompOffFlowRatio = Furnace(FurnaceNum)%CoolingSpeedRatio
ELSE
CompOffMassFlow = Furnace(FurnaceNum)%MaxHeatAirMassFlow
CompOffFlowRatio = Furnace(FurnaceNum)%HeatingSpeedRatio
END IF
ELSE
CompOffMassFlow = Furnace(FurnaceNum)%MaxCoolAirMassFlow
CompOffFlowRatio = Furnace(FurnaceNum)%CoolingSpeedRatio
END IF
! ELSE use the user specified value
ELSE
CompOffMassFlow = Furnace(FurnaceNum)%MaxNoCoolHeatAirMassFlow
CompOffFlowRatio = Furnace(FurnaceNum)%NoHeatCoolSpeedRatio
END IF
ELSE
! cycling fan mode
IF ( HeatingLoad .OR. &
(Furnace(FurnaceNum)%Humidistat .AND. MoistureLoad .LT. 0.0d0 .AND. &
Furnace(FurnaceNum)%DehumidControlType_Num == DehumidControl_CoolReheat ) ) THEN
IF(Furnace(FurnaceNum)%Humidistat .AND. MoistureLoad .LT. 0.0d0 .AND. &
Furnace(FurnaceNum)%DehumidControlType_Num == DehumidControl_CoolReheat)THEN
CompOnMassFlow = Furnace(FurnaceNum)%MaxCoolAirMassFlow
CompOnFlowRatio = Furnace(FurnaceNum)%CoolingSpeedRatio
Furnace(FurnaceNum)%LastMode = CoolingMode
ELSE
CompOnMassFlow = Furnace(FurnaceNum)%MaxHeatAirMassFlow
CompOnFlowRatio = Furnace(FurnaceNum)%HeatingSpeedRatio
Furnace(FurnaceNum)%LastMode = HeatingMode
END IF
ELSE IF ( CoolingLoad ) THEN
CompOnMassFlow = Furnace(FurnaceNum)%MaxCoolAirMassFlow
CompOnFlowRatio = Furnace(FurnaceNum)%CoolingSpeedRatio
ELSE
CompOnMassFlow = 0.0d0
CompOnFlowRatio = 0.0d0
END IF
CompOffMassFlow = 0.0d0
CompOffFlowRatio = 0.0d0
END IF
ELSE ! Is a HeatOnly furnace
CompOnMassFlow = Furnace(FurnaceNum)%DesignMassFlowRate
CompOnFlowRatio = Furnace(FurnaceNum)%HeatingSpeedRatio
IF(OpMode .EQ. ContFanCycCoil)THEN
CompOffMassFlow = Furnace(FurnaceNum)%MaxNoCoolHeatAirMassFlow
CompOffFlowRatio = Furnace(FurnaceNum)%HeatingSpeedRatio
ELSE
CompOffMassFlow = 0.0d0
CompOffFlowRatio = 0.0d0
END IF
END IF ! End check for heat only furnace or water-to-air heat pump
! Set the system mass flow rates
CALL SetAverageAirFlow(FurnaceNum, PartLoadRatio, OnOffAirFlowRatio)
END SUBROUTINE SetOnOffMassFlowRate