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 | |||
logical, | intent(in) | :: | FirstHVACIteration | |||
integer, | intent(in) | :: | FanOpMode | |||
integer, | intent(in) | :: | CompOp | |||
real(kind=r64), | intent(in) | :: | CoolPartLoadRatio | |||
real(kind=r64), | intent(in) | :: | HeatPartLoadRatio | |||
real(kind=r64), | intent(in) | :: | HeatCoilLoad | |||
real(kind=r64), | intent(in) | :: | ReHeatCoilLoad | |||
real(kind=r64), | intent(out) | :: | SensibleLoadMet | |||
real(kind=r64), | intent(out) | :: | LatentLoadMet | |||
real(kind=r64), | intent(inout) | :: | OnOffAirFlowRatio | |||
logical, | intent(in) | :: | HXUnitOn | |||
real(kind=r64), | intent(in), | optional | :: | CoolingHeatingPLRRat |
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 CalcFurnaceOutput(FurnaceNum,FirstHVACIteration,FanOpMode,CompOp,CoolPartLoadRatio,HeatPartLoadRatio, &
HeatCoilLoad, ReHeatCoilLoad, SensibleLoadMet, LatentLoadMet, OnOffAirFlowRatio, HXUnitOn, &
CoolingHeatingPLRRat)
! SUBROUTINE INFORMATION:
! AUTHOR Richard Raustad
! DATE WRITTEN Sept 2001
! MODIFIED Dec 2001
! RE-ENGINEERED na
! PURPOSE OF THIS SUBROUTINE:
! This subroutine calculates to sensible and latent loads met by the DX coils
! specified. Load met is the outlet node with respect to the control zone's
! temperature and humidity ratio.
! METHODOLOGY EMPLOYED:
! Simulate each child object in the correct order for each system type. This routine is used in the
! RegulaFalsi function CALL. Air mass flow rate is set each iteration based on PLR.
! REFERENCES:
! na
! USE STATEMENTS:
USE HeatingCoils, ONLY: SimulateHeatingCoilComponents
USE WatertoAirHeatPump, ONLY: SimWaterToAirHP
USE WatertoAirheatPumpSimple, ONLY: SimWatertoAirHPSimple
USE HVACHXAssistedCoolingCoil, ONLY: SimHXAssistedCoolingCoil
IMPLICIT NONE ! Enforce explicit typing of all variables in this routine
! SUBROUTINE ARGUMENT DEFINITIONS:
INTEGER, Intent(IN) :: FurnaceNum
LOGICAL, Intent(IN) :: FirstHVACIteration
INTEGER, Intent(IN) :: FanOpMode ! Cycling fan or constant fan
INTEGER, Intent(IN) :: CompOp ! Compressor on/off; 1=on, 0=off
REAL(r64), Intent(IN) :: CoolPartLoadRatio ! DX cooling coil part load ratio
REAL(r64), Intent(IN) :: HeatPartLoadRatio ! DX heating coil part load ratio (0 for other heating coil types)
REAL(r64), Intent(IN) :: HeatCoilLoad ! Heating coil load for gas heater
REAL(r64), Intent(IN) :: ReHeatCoilLoad ! Reheating coil load for gas heater
REAL(r64), Intent(OUT) :: SensibleLoadMet ! Sensible cooling load met (furnace outlet with respect to control zone temp)
REAL(r64), Intent(OUT) :: LatentLoadMet ! Latent cooling load met (furnace outlet with respect to control zone humidity ratio)
REAL(r64), Intent(INOUT) :: OnOffAirFlowRatio ! Ratio of compressor ON mass flow rate to AVERAGE
LOGICAL, Intent(IN) :: HXUnitOn ! flag to enable HX based on zone moisture load
REAL(r64), Intent(IN), OPTIONAL :: CoolingHeatingPLRRat ! cooling PLR to heating PLR ratio, used for cycling fan RH control
! SUBROUTINE PARAMETER DEFINITIONS:
! na
! INTERFACE BLOCK SPECIFICATIONS
! na
! DERIVED TYPE DEFINITIONS
! na
! SUBROUTINE LOCAL VARIABLE DECLARATIONS:
INTEGER :: FurnaceInletNode ! Furnace inlet node number
INTEGER :: FurnaceOutletNode ! Furnace outlet node number
REAL(r64) :: AirMassFlow ! Furnace inlet node temperature
REAL(r64) :: WSHPRuntimeFrac ! Compressor runtime fraction
REAL(r64) :: CompPartLoadRatio ! Compressor part load ratio
REAL(r64) :: MinHumRatio ! Minimum humidity ratio for calculating sensible load at a constant humidity ratio
REAL(r64) :: MaxTemp ! Maximum temperature for calculating latent load at a constant temperature
REAL(r64) :: dummy ! dummy variable
REAL(r64) :: Tout ! Temporary variable used when outlet temp > DesignMaxOutletTemp
REAL(r64) :: Wout ! Temporary variable used when outlet temp > DesignMaxOutletTemp
INTEGER :: CoolingCoilType_Num ! Numeric Equivalent for CoolingCoilType
INTEGER :: HeatingCoilType_Num ! Numeric Equivalent for HeatingCoilType
REAL(r64) :: mdot ! hot water or steam heating coil fluid mass flow rates
REAL(r64) :: QCoilReq ! heating coil load
REAL(r64) :: QActual ! heating coil load met or delivered
REAL(r64) :: MinWaterFlow = 0.0d0 ! minimum fluid flow rates
INTEGER :: LoopNumber ! plant loop index for water and steam supplemental heating coil
INTEGER :: LoopSideNumber ! plant loop side index for water and steam supp. heating coil
INTEGER :: BranchNumber ! plant loop branch index for water and steam supp. heating coil
INTEGER :: CompNumber ! plant loop comp. index for water and steam supp. heating coil
LOGICAL :: SuppHeatingCoilFlag ! .true. if supplemental heating coil
FurnaceOutletNode = Furnace(FurnaceNum)%FurnaceOutletNodeNum
FurnaceInletNode = Furnace(FurnaceNum)%FurnaceInletNodeNum
CoolingCoilType_Num = Furnace(FurnaceNum)%CoolingCoilType_Num
HeatingCoilType_Num = Furnace(FurnaceNum)%HeatingCoilType_Num
WSHPRuntimeFrac = Furnace(FurnaceNum)%WSHPRuntimeFrac
CompPartLoadRatio = Furnace(FurnaceNum)%CompPartLoadRatio
ModifiedHeatCoilLoad = 0.0d0
IF (PRESENT(CoolingHeatingPLRRat)) THEN
CoolHeatPLRRat = CoolingHeatingPLRRat
ELSE
CoolHeatPLRRat = 1.0d0
END IF
! Cooling to Heating PLR Ratio (CoolHeatPLRRat) is used to track the air mass flow rate of both the heating
! and cooling coils when RH control is used and the heating coil operates longer than the cooling coil.
! When CoolPartLoadRatio/CoolHeatPLRRat is used, the PLR calculated is acutally the PLR for the heating
! coil (heating PLR is greater than cooling PLR), it is this PLR that determines the air mass flow rate.
!
! When MAX(HeatPartLoadRatio,CoolPartLoadRatio) is used, only one of these values is non-zero.
!
IF (FanOpMode.EQ.CycFanCycCoil) THEN
IF(CoolHeatPLRRat .LT. 1.0d0) THEN
IF(CoolHeatPLRRat .GT. 0.0d0) THEN
Node(FurnaceInletNode)%MassFlowRate = CompOnMassFlow * CoolPartLoadRatio/CoolHeatPLRRat
IF(Furnace(FurnaceNum)%FurnaceType_Num .NE. UnitarySys_HeatPump_WaterToAir)THEN
CALL SetAverageAirFlow(FurnaceNum, CoolPartLoadRatio/CoolHeatPLRRat, OnOffAirFlowRatio)
END IF
ELSE
Node(FurnaceInletNode)%MassFlowRate = CompOnMassFlow * CoolPartLoadRatio
IF(Furnace(FurnaceNum)%FurnaceType_Num .NE. UnitarySys_HeatPump_WaterToAir)THEN
CALL SetAverageAirFlow(FurnaceNum, MAX(HeatPartLoadRatio,CoolPartLoadRatio), OnOffAirFlowRatio)
END IF
END IF
ELSE
Node(FurnaceInletNode)%MassFlowRate = CompOnMassFlow * MAX(HeatPartLoadRatio,CoolPartLoadRatio)
IF(Furnace(FurnaceNum)%FurnaceType_Num .NE. UnitarySys_HeatPump_WaterToAir)THEN
CALL SetAverageAirFlow(FurnaceNum, MAX(HeatPartLoadRatio,CoolPartLoadRatio), OnOffAirFlowRatio)
END IF
END IF
ELSE
IF(Furnace(FurnaceNum)%FurnaceType_Num .NE. UnitarySys_HeatPump_WaterToAir)THEN
CALL SetAverageAirFlow(FurnaceNum, MAX(HeatPartLoadRatio,CoolPartLoadRatio), OnOffAirFlowRatio)
END IF
END IF
AirMassFlow = Node(FurnaceInletNode)%MassFlowRate
Node(FurnaceInletNode)%MassFlowRateMaxAvail = AirMassFlow
! Simulate the air-to-air heat pump
IF(Furnace(FurnaceNum)%FurnaceType_Num == UnitarySys_HeatPump_AirToAir)THEN
! Simulate blow-thru fan and non-linear coils twice to update PLF used by the ONOFF Fan
IF (Furnace(FurnaceNum)%FanPlace .EQ. BlowThru) THEN
CALL SimulateFanComponents(Blank,FirstHVACIteration,Furnace(FurnaceNum)%FanIndex,FanSpeedRatio)
IF (CoolingCoilType_Num == CoilDX_CoolingHXAssisted)THEN
CALL SimHXAssistedCoolingCoil(Blank,FirstHVACIteration,CompOp,CoolPartLoadRatio, &
Furnace(FurnaceNum)%CoolingCoilIndex, FanOpMode, &
HXUnitEnable=HXUnitOn, OnOffAFR = OnOffAirFlowRatio, EconomizerFlag=EconomizerFlag)
ELSE
CALL SimDXCoil(Blank,CompOp,FirstHVACIteration,CoolPartLoadRatio,Furnace(FurnaceNum)%CoolingCoilIndex, &
FanOpMode, OnOffAirFlowRatio)
END IF
CALL SimDXCoil(Blank,CompOp,FirstHVACIteration,HeatPartLoadRatio,Furnace(FurnaceNum)%HeatingCoilIndex, &
FanOpMode, OnOffAirFlowRatio)
CALL SimulateFanComponents(Blank,FirstHVACIteration,Furnace(FurnaceNum)%FanIndex,FanSpeedRatio)
END IF
! Simulate cooling and heating coils
IF (CoolingCoilType_Num == CoilDX_CoolingHXAssisted)THEN
CALL SimHXAssistedCoolingCoil(Blank,FirstHVACIteration,CompOp,CoolPartLoadRatio, &
Furnace(FurnaceNum)%CoolingCoilIndex, FanOpMode, &
HXUnitEnable=HXUnitOn, OnOffAFR = OnOffAirFlowRatio, EconomizerFlag=EconomizerFlag)
ELSE
CALL SimDXCoil(Blank,CompOp,FirstHVACIteration,CoolPartLoadRatio,Furnace(FurnaceNum)%CoolingCoilIndex, &
FanOpMode, OnOffAirFlowRatio)
END IF
CALL SimDXCoil(Blank,CompOp,FirstHVACIteration,HeatPartLoadRatio,Furnace(FurnaceNum)%HeatingCoilIndex, &
FanOpMode, OnOffAirFlowRatio)
! Simulate the draw-thru fan
IF (Furnace(FurnaceNum)%FanPlace .EQ. DrawThru) THEN
CALL SimulateFanComponents(Blank,FirstHVACIteration,Furnace(FurnaceNum)%FanIndex,FanSpeedRatio)
END IF
! Simulate the supplemental heating coil
IF(Furnace(FurnaceNum)%DehumidControlType_Num .EQ. DehumidControl_CoolReheat .AND. ReHeatCoilLoad .GT. 0.0d0)THEN
SuppHeatingCoilFlag = .TRUE.
CALL CalcNonDXHeatingCoils(FurnaceNum,SuppHeatingCoilFlag,FirstHVACIteration,ReHeatCoilLoad,FanOpMode,QActual)
ELSE
! equivalent to QCoilReq=0.0d0 or ReHeatCoilLoad = 0.0d0
SuppHeatingCoilFlag = .TRUE.
CALL CalcNonDXHeatingCoils(FurnaceNum,SuppHeatingCoilFlag,FirstHVACIteration,ReHeatCoilLoad,FanOpMode,QActual)
ENDIF
! Simulate the parameter estimate water-to-air heat pump
ELSEIF (Furnace(FurnaceNum)%FurnaceType_Num == UnitarySys_HeatPump_WaterToAir .AND. &
Furnace(FurnaceNum)%WatertoAirHPType == WatertoAir_Simple) Then
! Simulate blow-thru fan and non-linear coils twice to update PLF used by the ONOFF Fan
IF (Furnace(FurnaceNum)%FanPlace .EQ. BlowThru) THEN
CALL SimulateFanComponents(Blank,FirstHVACIteration,Furnace(FurnaceNum)%FanIndex,FanSpeedRatio)
!COIL:WATERTOAIRHPSIMPLE:COOLING
CALL SimWatertoAirHPSimple(Blank, &
Furnace(FurnaceNum)%CoolingCoilIndex, &
Furnace(FurnaceNum)%CoolingCoilSensDemand, Furnace(FurnaceNum)%CoolingCoilLatentDemand, &
FanOpMode,WSHPRuntimeFrac, Furnace(FurnaceNum)%MaxONOFFCyclesperHour, & !CoolPartLoadRatio
Furnace(FurnaceNum)%HPTimeConstant, Furnace(FurnaceNum)%FanDelayTime, CompOp, &
CoolPartLoadRatio, FirstHVACIteration)
Dummy=0.0d0
!COIL:WATERTOAIRHPSIMPLE:HEATING
CALL SimWatertoAirHPSimple(Blank, &
Furnace(FurnaceNum)%HeatingCoilIndex, &
Furnace(FurnaceNum)%HeatingCoilSensDemand, dummy, &
FanOpMode,WSHPRuntimeFrac, Furnace(FurnaceNum)%MaxONOFFCyclesperHour, & !HeatPartLoadRatio
Furnace(FurnaceNum)%HPTimeConstant, Furnace(FurnaceNum)%FanDelayTime, CompOp, &
HeatPartLoadRatio, FirstHVACIteration)
! Simulate the whole thing a second time so that the correct PLF required by the coils is used by the Fan. *******
CALL SimulateFanComponents(Blank,FirstHVACIteration,Furnace(FurnaceNum)%FanIndex,FanSpeedRatio)
END IF
! Simulate the cooling and heating coils
!COIL:WATERTOAIRHPSIMPLE:COOLING
CALL SimWatertoAirHPSimple(Blank, &
Furnace(FurnaceNum)%CoolingCoilIndex, &
Furnace(FurnaceNum)%CoolingCoilSensDemand, Furnace(FurnaceNum)%CoolingCoilLatentDemand, &
FanOpMode,WSHPRuntimeFrac, Furnace(FurnaceNum)%MaxONOFFCyclesperHour, & !CoolPartLoadRatio
Furnace(FurnaceNum)%HPTimeConstant, Furnace(FurnaceNum)%FanDelayTime, CompOp, &
CoolPartLoadRatio, FirstHVACIteration)
Dummy=0.0d0
!COIL:WATERTOAIRHPSIMPLE:HEATING
CALL SimWatertoAirHPSimple(Blank, &
Furnace(FurnaceNum)%HeatingCoilIndex, &
Furnace(FurnaceNum)%HeatingCoilSensDemand, dummy, &
FanOpMode,WSHPRuntimeFrac, Furnace(FurnaceNum)%MaxONOFFCyclesperHour, & !HeatPartLoadRatio
Furnace(FurnaceNum)%HPTimeConstant, Furnace(FurnaceNum)%FanDelayTime, CompOp, &
HeatPartLoadRatio, FirstHVACIteration)
! Simulate the draw-thru fan
IF (Furnace(FurnaceNum)%FanPlace .EQ. BlowThru) THEN
CALL SimulateFanComponents(Blank,FirstHVACIteration,Furnace(FurnaceNum)%FanIndex,FanSpeedRatio)
END IF
! Simulate the supplemental heating coil
IF(Furnace(FurnaceNum)%DehumidControlType_Num .EQ. DehumidControl_CoolReheat .AND. ReHeatCoilLoad .GT. 0.0d0)THEN
SuppHeatingCoilFlag = .TRUE. ! if true simulates supplemental heating coil
CALL CalcNonDXHeatingCoils(FurnaceNum,SuppHeatingCoilFlag,FirstHVACIteration,ReheatCoilLoad,FanOpMode, QActual)
ELSE
SuppHeatingCoilFlag = .TRUE. ! if true simulates supplemental heating coil
CALL CalcNonDXHeatingCoils(FurnaceNum,SuppHeatingCoilFlag,FirstHVACIteration,HeatCoilLoad,FanOpMode,QActual)
ENDIF
! Simulate the detailed water-to-air heat pump
ELSE IF(Furnace(FurnaceNum)%FurnaceType_Num == UnitarySys_HeatPump_WaterToAir .AND. &
Furnace(FurnaceNum)%WatertoAirHPType == WatertoAir_ParEst) Then
! Simulate the draw-thru fan
IF (Furnace(FurnaceNum)%FanPlace .EQ. BlowThru) THEN
CALL SimulateFanComponents(Blank,FirstHVACIteration,Furnace(FurnaceNum)%FanIndex,FanSpeedRatio)
END IF
! Simulate the cooling and heating coils
CALL SimWatertoAirHP(Blank, &
Furnace(FurnaceNum)%CoolingCoilIndex, &
Furnace(FurnaceNum)%DesignMassFlowRate,FanOpMode,FirstHVACIteration,WSHPRuntimeFrac,&
Furnace(FurnaceNum)%MaxONOFFCyclesperHour, &
Furnace(FurnaceNum)%HPTimeConstant, &
Furnace(FurnaceNum)%FanDelayTime, &
Furnace(FurnaceNum)%InitHeatPump, &
Furnace(FurnaceNum)%CoolingCoilSensDemand, &
Furnace(FurnaceNum)%CoolingCoilLatentDemand,CompOp, CoolPartLoadRatio)
Dummy=0.0d0
CALL SimWatertoAirHP(Blank, &
Furnace(FurnaceNum)%HeatingCoilIndex, &
Furnace(FurnaceNum)%DesignMassFlowRate,FanOpMode,FirstHVACIteration,WSHPRuntimeFrac,&
Furnace(FurnaceNum)%MaxONOFFCyclesperHour, &
Furnace(FurnaceNum)%HPTimeConstant, &
Furnace(FurnaceNum)%FanDelayTime, &
Furnace(FurnaceNum)%InitHeatPump, &
Furnace(FurnaceNum)%HeatingCoilSensDemand, &
Dummy,CompOp,HeatPartLoadRatio)
! Simulate the draw-thru fan
IF (Furnace(FurnaceNum)%FanPlace .EQ. DrawThru) THEN
CALL SimulateFanComponents(Blank,FirstHVACIteration,Furnace(FurnaceNum)%FanIndex,FanSpeedRatio)
END IF
! Simulate the supplemental heating coil
CALL SimulateHeatingCoilComponents(Blank, FirstHVACIteration, QCoilReq=HeatCoilLoad, &
CompIndex=Furnace(FurnaceNum)%SuppHeatCoilIndex, &
SuppHeat=.TRUE., FanOpMode=FanOpMode)
ELSE ! ELSE it's not a heat pump
! Simulate blow-thru fan
IF (Furnace(FurnaceNum)%FanPlace .EQ. BlowThru) THEN
CALL SimulateFanComponents(Blank,FirstHVACIteration,Furnace(FurnaceNum)%FanIndex,FanSpeedRatio)
! For non-linear coils, simulate coil to update PLF used by the ONOFF Fan
IF(Furnace(FurnaceNum)%FanType_Num == FanType_SimpleOnOff)THEN
IF(Furnace(FurnaceNum)%FurnaceType_Num /= UnitarySys_HeatOnly .AND. &
Furnace(FurnaceNum)%FurnaceType_Num /= Furnace_HeatOnly)THEN
IF(.NOT. Furnace(FurnaceNum)%CoolingCoilUpstream)THEN
SuppHeatingCoilFlag = .FALSE. ! if false simulates heating coil
CALL CalcNonDXHeatingCoils(FurnaceNum,SuppHeatingCoilFlag,FirstHVACIteration,HeatCoilLoad,FanOpMode,QActual)
END IF
IF (CoolingCoilType_Num == CoilDX_CoolingHXAssisted)THEN
CALL SimHXAssistedCoolingCoil(Blank,FirstHVACIteration,CompOp,CoolPartLoadRatio, &
Furnace(FurnaceNum)%CoolingCoilIndex, FanOpMode, &
HXUnitEnable=HXUnitOn, OnOffAFR = OnOffAirFlowRatio, EconomizerFlag=EconomizerFlag)
ELSE
CALL SimDXCoil(Blank,CompOp,FirstHVACIteration,CoolPartLoadRatio,Furnace(FurnaceNum)%CoolingCoilIndex, &
FanOpMode, OnOffAirFlowRatio, CoilCoolingHeatingPLRRatio = CoolHeatPLRRat)
END IF
END IF
IF(Furnace(FurnaceNum)%CoolingCoilUpstream)THEN
SuppHeatingCoilFlag = .FALSE. ! if false simulates heating coil
CALL CalcNonDXHeatingCoils(FurnaceNum,SuppHeatingCoilFlag,FirstHVACIteration,HeatCoilLoad,FanOpMode,QActual)
END IF
CALL SimulateFanComponents(Blank,FirstHVACIteration,Furnace(FurnaceNum)%FanIndex,FanSpeedRatio)
END IF ! Simple OnOff fan
END IF ! Blow thru fan
! Simulate the cooling and heating coils
IF(Furnace(FurnaceNum)%FurnaceType_Num /= UnitarySys_HeatOnly .AND. &
Furnace(FurnaceNum)%FurnaceType_Num /= Furnace_HeatOnly)THEN
IF(.NOT. Furnace(FurnaceNum)%CoolingCoilUpstream)THEN
SuppHeatingCoilFlag = .FALSE. ! if false simulates heating coil
CALL CalcNonDXHeatingCoils(FurnaceNum,SuppHeatingCoilFlag,FirstHVACIteration,HeatCoilLoad,FanOpMode,QActual)
END IF
IF (CoolingCoilType_Num == CoilDX_CoolingHXAssisted)THEN
CALL SimHXAssistedCoolingCoil(Blank,FirstHVACIteration,CompOp,CoolPartLoadRatio, &
Furnace(FurnaceNum)%CoolingCoilIndex, FanOpMode, &
HXUnitEnable=HXUnitOn, OnOffAFR = OnOffAirFlowRatio, EconomizerFlag=EconomizerFlag)
ELSE
CALL SimDXCoil(Blank,CompOp,FirstHVACIteration,CoolPartLoadRatio,Furnace(FurnaceNum)%CoolingCoilIndex, &
FanOpMode, OnOffAirFlowRatio, CoilCoolingHeatingPLRRatio = CoolHeatPLRRat)
END IF
END IF
IF(Furnace(FurnaceNum)%CoolingCoilUpstream)THEN
SuppHeatingCoilFlag = .FALSE. ! if false simulates heating coil
CALL CalcNonDXHeatingCoils(FurnaceNum,SuppHeatingCoilFlag,FirstHVACIteration,HeatCoilLoad,FanOpMode,QActual)
END IF
! Simulate the draw-thru fan
IF (Furnace(FurnaceNum)%FanPlace .EQ. DrawThru) THEN
CALL SimulateFanComponents(Blank,FirstHVACIteration,Furnace(FurnaceNum)%FanIndex,FanSpeedRatio)
END IF
IF(Furnace(FurnaceNum)%DehumidControlType_Num .EQ. DehumidControl_CoolReheat .OR. &
Furnace(FurnaceNum)%SuppHeatCoilIndex .GT. 0)THEN
SuppHeatingCoilFlag = .TRUE. ! if truee simulates supplemental heating coil
CALL CalcNonDXHeatingCoils(FurnaceNum,SuppHeatingCoilFlag,FirstHVACIteration,ReheatCoilLoad,FanOpMode,QActual)
END IF
END IF ! IF(Furnace(FurnaceNum)%FurnaceType_Num == UnitarySys_HeatPump_AirToAir)THEN
! check the DesignMaxOutletTemp and reset if necessary (for Coil:Gas:Heating or Coil:Electric:Heating only)
IF(Node(Furnace(FurnaceNum)%FurnaceOutletNodeNum)%Temp .GT. Furnace(FurnaceNum)%DesignMaxOutletTemp)THEN
Wout = Node(FurnaceOutletNode)%HumRat
Tout = Furnace(FurnaceNum)%DesignMaxOutletTemp
ModifiedHeatCoilLoad = HeatCoilLoad - &
(AirMassFlow * PsyCpAirFnWTdb(Wout,Tout) * (Node(FurnaceOutletNode)%Temp-Tout))
Node(FurnaceOutletNode)%Temp = Tout
ENDIF
! If the fan runs continually do not allow coils to set OnOffFanPartLoadRatio.
IF (FanOpMode.EQ.ContFanCycCoil)OnOffFanPartLoadFraction = 1.0d0
! Check delta T (outlet to space), if positive
! use space HumRat (next line), else outlet humrat (IF) so psyc routine gives good result
MinHumRatio = Node(Furnace(FurnaceNum)%NodeNumofControlledZone)%HumRat
IF(Node(FurnaceOutletNode)%Temp .LT. Node(Furnace(FurnaceNum)%NodeNumofControlledZone)%Temp ) &
MinHumRatio = Node(FurnaceOutletNode)%HumRat
! Calculate sensible load met (at constant humidity ratio)
SensibleLoadMet = AirMassFlow * (PsyHFnTdbW(Node(FurnaceOutletNode)%Temp,MinHumRatio) &
- PsyHFnTdbW(Node(Furnace(FurnaceNum)%NodeNumofControlledZone)%Temp,MinHumRatio)) &
- Furnace(FurnaceNum)%SenLoadLoss
Furnace(FurnaceNum)%SensibleLoadMet = SensibleLoadMet
IF(Furnace(FurnaceNum)%Humidistat)THEN
MaxTemp = Node(Furnace(FurnaceNum)%NodeNumofControlledZone)%Temp
! modified, why does switching between furnace outlet and control zone temp
! cause latent load to change when latent capacity is 0 ?
! IF(Node(FurnaceOutletNode)%Temp .GT. Node(Furnace(FurnaceNum)%NodeNumofControlledZone)%Temp ) &
! MaxTemp = Node(FurnaceOutletNode)%Temp
! Calculate latent load met (at constant temperature)
LatentLoadMet = AirMassFlow * (PsyHFnTdbW(MaxTemp,Node(FurnaceOutletNode)%HumRat) &
- PsyHFnTdbW(MaxTemp,Node(Furnace(FurnaceNum)%NodeNumofControlledZone)%HumRat)) &
- Furnace(FurnaceNum)%LatLoadLoss
ELSE
LatentLoadMet = 0.0d0
END IF
Furnace(FurnaceNum)%LatentLoadMet = LatentLoadMet
RETURN
END Subroutine CalcFurnaceOutput