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 | :: | CoilNum | ||||
real(kind=r64) | :: | SpeedRatio | ||||
real(kind=r64) | :: | CycRatio | ||||
integer | :: | StageNum | ||||
integer | :: | FanOpMode |
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 CalcMultiStageGasHeatingCoil(CoilNum,SpeedRatio, CycRatio, StageNum, FanOpMode)
! SUBROUTINE INFORMATION:
! AUTHOR Chandan Sharma, FSEC
! DATE WRITTEN January 2013
! MODIFIED na
! RE-ENGINEERED na
! PURPOSE OF THIS SUBROUTINE:
! Calculates the air-side performance and energy use of a multi stage gas heating coil.
! METHODOLOGY EMPLOYED:
! Uses the same methodology as the single speed Gas heating unit model (SUBROUTINE CalcGasHeatingCoil).
! In addition it assumes that the unit performance is obtained by interpolating between
! the performance at high stage and that at low stage. If the output needed is below
! that produced at low stage, the coil cycles between off and low stage.
! USE STATEMENTS:
USE CurveManager, ONLY: CurveValue
USE General, ONLY: TrimSigDigits, RoundSigDigits
USE DataHVACGlobals, ONLY: MSHPMassFlowRateLow, MSHPMassFlowRateHigh, ElecHeatingCoilPower
USE Psychrometrics, ONLY: PsyTdbFnHW, PsyRhFnTdbWPb, PsyTsatFnHPb, PsyWFnTdbH
USE DataEnvironment, ONLY: OutBaroPress
IMPLICIT NONE ! Enforce explicit typing of all variables in this routine
! SUBROUTINE ARGUMENT DEFINITIONS:
INTEGER :: CoilNum ! the number of the Gas heating coil to be simulated
REAL(r64) :: SpeedRatio ! SpeedRatio varies between 1.0 (maximum speed) and 0.0 (minimum speed)
REAL(r64) :: CycRatio ! cycling part load ratio
INTEGER :: StageNum ! Speed number
INTEGER :: FanOpMode ! Fan operation mode
! SUBROUTINE PARAMETER DEFINITIONS:
CHARACTER(len=*), PARAMETER :: RoutineName='CalcMultiStageGasHeatingCoil'
! INTERFACE BLOCK SPECIFICATIONS
! na
! DERIVED TYPE DEFINITIONS
! na
! SUBROUTINE LOCAL VARIABLE DECLARATIONS:
REAL(r64) :: AirMassFlow ! dry air mass flow rate through coil [kg/s]
REAL(r64) :: InletAirDryBulbTemp ! inlet air dry bulb temperature [C]
REAL(r64) :: InletAirEnthalpy ! inlet air enthalpy [J/kg]
REAL(r64) :: InletAirHumRat ! inlet air humidity ratio [kg/kg]
REAL(r64) :: OutletAirEnthalpy ! outlet air enthalpy [J/kg]
REAL(r64) :: OutletAirHumRat ! outlet air humidity ratio [kg/kg]
REAL(r64) :: TotCapHS ! total capacity at high stage [W]
REAL(r64) :: TotCapLS ! total capacity at low stage [W]
REAL(r64) :: TotCap ! total capacity at current stage [W]
REAL(r64) :: EffHS ! efficiency at high stage
REAL(r64) :: EffLS ! efficiency at low stage
REAL(r64) :: EffAvg ! average efficiency
REAL(r64) :: OutdoorPressure ! Outdoor barometric pressure at condenser (Pa)
INTEGER :: StageNumHS ! High stage number
INTEGER :: StageNumLS ! Low stage number
REAL(r64) :: FullLoadOutAirEnth ! Outlet full load enthalpy
REAL(r64) :: FullLoadOutAirHumRat ! Outlet humidity ratio at full load
REAL(r64) :: FullLoadOutAirTemp ! Outlet temperature at full load
REAL(r64) :: FullLoadOutAirRH ! Outler relative humidity at full load
REAL(r64) :: OutletAirTemp ! Supply ari temperature
REAL(r64) :: LSFullLoadOutAirEnth ! Outlet full load enthalpy at low stage
REAL(r64) :: HSFullLoadOutAirEnth ! Outlet full load enthalpy at high stage
REAL(r64) :: LSGasHeatingPower ! Full load power at low stage
REAL(r64) :: HSGasHeatingPower ! Full load power at high stage
REAL(r64) :: PartLoadRat ! part load ratio
REAL(r64) :: PLF ! part load factor used to calculate RTF
! FLOW
If (StageNum > 1) Then
StageNumLS = StageNum-1
StageNumHS = StageNum
If (StageNum .GT. HeatingCoil(CoilNum)%NumOfStages) Then
StageNumLS = HeatingCoil(CoilNum)%NumOfStages-1
StageNumHS = HeatingCoil(CoilNum)%NumOfStages
End If
Else
StageNumLS = 1
StageNumHS = 1
End If
AirMassFlow = HeatingCoil(CoilNum)%InletAirMassFlowRate
InletAirDryBulbTemp = HeatingCoil(CoilNum)%InletAirTemp
InletAirEnthalpy = HeatingCoil(CoilNum)%InletAirEnthalpy
InletAirHumRat = HeatingCoil(CoilNum)%InletAirHumRat
OutdoorPressure = OutBaroPress
IF((AirMassFlow .GT. 0.0d0) .AND. &
(GetCurrentScheduleValue(HeatingCoil(CoilNum)%SchedPtr) .GT. 0.0d0) .AND. &
((CycRatio .GT. 0.0d0) .OR. (SpeedRatio .GT. 0.0d0))) THEN
If (StageNum > 1) Then
TotCapLS = HeatingCoil(CoilNum)%MSNominalCapacity(StageNumLS)
TotCapHS = HeatingCoil(CoilNum)%MSNominalCapacity(StageNumHS)
EffLS = HeatingCoil(CoilNum)%MSEfficiency(StageNumLS)
EffHS = HeatingCoil(CoilNum)%MSEfficiency(StageNumHS)
PartLoadRat = MIN(1.0d0,SpeedRatio)
! Get full load output and power
LSFullLoadOutAirEnth = InletAirEnthalpy + TotCapLS/MSHPMassFlowRateLow
HSFullLoadOutAirEnth = InletAirEnthalpy + TotCapHS/MSHPMassFlowRateHigh
LSGasHeatingPower = TotCapLS/ EffLS
HSGasHeatingPower = TotCapHS/EffHS
OutletAirHumRat = InletAirHumRat
! if cycling fan, send coil part-load fraction to on/off fan via HVACDataGlobals
! IF (FanOpMode .EQ. CycFanCycCoil) OnOffFanPartLoadFraction = 1.0d0
! Power calculation. If PartLoadRat (SpeedRatio) = 0, operate at LS the whole time step
HeatingCoil(CoilNum)%ElecUseLoad = PartLoadRat*HeatingCoil(CoilNum)%MSParasiticElecLoad(StageNumHS) + &
(1.0d0-PartLoadRat)*HeatingCoil(CoilNum)%MSParasiticElecLoad(StageNumLS)
ElecHeatingCoilPower = HeatingCoil(CoilNum)%ElecUseLoad
HeatingCoil(CoilNum)%HeatingCoilLoad = MSHPMassFlowRateHigh*(HSFullLoadOutAirEnth-InletAirEnthalpy)*PartLoadRat + &
MSHPMassFlowRateLow*(LSFullLoadOutAirEnth-InletAirEnthalpy)*(1.0d0-PartLoadRat)
EffAvg = (EffHS * PartLoadRat) + (EffLS * (1.0d0 - PartLoadRat))
HeatingCoil(CoilNum)%GasUseLoad = HeatingCoil(CoilNum)%HeatingCoilLoad / EffAvg
HeatingCoil(CoilNum)%ParasiticGasRate = 0.0d0
OutletAirEnthalpy = InletAirEnthalpy + HeatingCoil(CoilNum)%HeatingCoilLoad/HeatingCoil(CoilNum)%InletAirMassFlowRate
OutletAirTemp = PsyTdbFnHW(OutletAirEnthalpy,OutletAirHumRat,RoutineName)
FullLoadOutAirRH = PsyRhFnTdbWPb(OutletAirTemp,OutletAirHumRat,OutdoorPressure,RoutineName//':Averageload')
IF (FullLoadOutAirRH .gt. 1.d0) THEN ! Limit to saturated conditions at FullLoadOutAirEnth
OutletAirTemp = PsyTsatFnHPb(OutletAirEnthalpy,OutdoorPressure,RoutineName)
OutletAirHumRat = PsyWFnTdbH(OutletAirTemp,OutletAirEnthalpy,RoutineName)
END IF
HeatingCoil(CoilNum)%OutletAirTemp = OutletAirTemp
HeatingCoil(CoilNum)%OutletAirHumRat = OutletAirHumRat
HeatingCoil(CoilNum)%OutletAirEnthalpy = OutletAirEnthalpy
HeatingCoil(CoilNum)%OutletAirMassFlowRate = HeatingCoil(CoilNum)%InletAirMassFlowRate
! Stage 1
Else If (CycRatio > 0.0d0) Then
! for cycling fan, reset mass flow to full on rate
IF (FanOpMode .EQ. CycFanCycCoil) AirMassFlow = AirMassFlow / CycRatio
IF (FanOpMode .EQ. ContFanCycCoil) AirMassFlow = MSHPMassFlowRateLow
TotCap = HeatingCoil(CoilNum)%MSNominalCapacity(StageNumLS)
PartLoadRat = MIN(1.0d0,CycRatio)
! Calculate full load outlet conditions
FullLoadOutAirEnth = InletAirEnthalpy + TotCap/AirMassFlow
FullLoadOutAirHumRat = InletAirHumRat
FullLoadOutAirTemp = PsyTdbFnHW(FullLoadOutAirEnth,FullLoadOutAirHumRat,RoutineName)
FullLoadOutAirRH = PsyRhFnTdbWPb(FullLoadOutAirTemp,FullLoadOutAirHumRat,OutdoorPressure,RoutineName//':fullload')
IF (FullLoadOutAirRH .gt. 1.d0) THEN ! Limit to saturated conditions at FullLoadOutAirEnth
FullLoadOutAirTemp = PsyTsatFnHPb(FullLoadOutAirEnth,OutdoorPressure,RoutineName)
! Eventually inlet air conditions will be used in Gas Coil, these lines are commented out and marked with this comment line
! FullLoadOutAirTemp = PsyTsatFnHPb(FullLoadOutAirEnth,InletAirPressure)
FullLoadOutAirHumRat = PsyWFnTdbH(FullLoadOutAirTemp,FullLoadOutAirEnth,RoutineName)
END IF
! Set outlet conditions from the full load calculation
IF (FanOpMode .EQ. CycFanCycCoil) THEN
OutletAirEnthalpy = FullLoadOutAirEnth
OutletAirHumRat = FullLoadOutAirHumRat
OutletAirTemp = FullLoadOutAirTemp
ELSE
OutletAirEnthalpy = PartLoadRat * FullLoadOutAirEnth + (1.0d0-PartLoadRat) * InletAirEnthalpy
OutletAirHumRat = PartLoadRat * FullLoadOutAirHumRat + (1.0d0-PartLoadRat) * InletAirHumRat
OutletAirTemp = PartLoadRat * FullLoadOutAirTemp + (1.0d0-PartLoadRat) * InletAirDryBulbTemp
END IF
EffLS = HeatingCoil(CoilNum)%MSEfficiency(StageNumLS)
! HeatingCoil(CoilNum)%HeatingCoilLoad = TotCap
! This would require a CR to change
HeatingCoil(CoilNum)%HeatingCoilLoad = TotCap * PartLoadRat
HeatingCoil(CoilNum)%GasUseLoad = HeatingCoil(CoilNum)%HeatingCoilLoad / EffLS
! parasitics are calculated when the coil is off (1-PLR)
HeatingCoil(CoilNum)%ElecUseLoad = HeatingCoil(CoilNum)%MSParasiticElecLoad(StageNumLS) * (1.0d0 - PartLoadRat)
HeatingCoil(CoilNum)%ParasiticGasRate = HeatingCoil(CoilNum)%ParasiticGasCapacity * (1.0d0 - PartLoadRat)
ElecHeatingCoilPower = HeatingCoil(CoilNum)%ElecUseLoad
HeatingCoil(CoilNum)%OutletAirTemp = OutletAirTemp
HeatingCoil(CoilNum)%OutletAirHumRat = OutletAirHumRat
HeatingCoil(CoilNum)%OutletAirEnthalpy = OutletAirEnthalpy
HeatingCoil(CoilNum)%OutletAirMassFlowRate = HeatingCoil(CoilNum)%InletAirMassFlowRate
! This seems unecessary (i.e., cycratio or speedratio is > 0) , and would require a CR to change
! ELSE
! ! Gas coil is off; just pass through conditions
! HeatingCoil(CoilNum)%OutletAirEnthalpy = HeatingCoil(CoilNum)%InletAirEnthalpy
! HeatingCoil(CoilNum)%OutletAirHumRat = HeatingCoil(CoilNum)%InletAirHumRat
! HeatingCoil(CoilNum)%OutletAirTemp = HeatingCoil(CoilNum)%InletAirTemp
! HeatingCoil(CoilNum)%OutletAirMassFlowRate = HeatingCoil(CoilNum)%InletAirMassFlowRate
!
! HeatingCoil(CoilNum)%ElecUseLoad = 0.0
! HeatingCoil(CoilNum)%HeatingCoilLoad = 0.0
! ElecHeatingCoilPower = 0.0
End If
! This requires a CR to correct (i.e., calculate outputs when coil is off)
ELSE
! Gas coil is off; just pass through conditions
HeatingCoil(CoilNum)%OutletAirEnthalpy = HeatingCoil(CoilNum)%InletAirEnthalpy
HeatingCoil(CoilNum)%OutletAirHumRat = HeatingCoil(CoilNum)%InletAirHumRat
HeatingCoil(CoilNum)%OutletAirTemp = HeatingCoil(CoilNum)%InletAirTemp
HeatingCoil(CoilNum)%OutletAirMassFlowRate = HeatingCoil(CoilNum)%InletAirMassFlowRate
! some of these are reset in Init, can be removed to speed up code
HeatingCoil(CoilNum)%ElecUseLoad = 0.0d0
HeatingCoil(CoilNum)%HeatingCoilLoad = 0.0d0
HeatingCoil(CoilNum)%GasUseLoad = 0.0d0
HeatingCoil(CoilNum)%ParasiticGasRate = HeatingCoil(CoilNum)%ParasiticGasCapacity
ElecHeatingCoilPower = 0.0d0
PartLoadRat = 0.0d0
END IF ! end of on/off if - else
! If the PLF curve is defined the gas usage needs to be modified.
! The PLF curve is only used when the coil cycles.
If(HeatingCoil(CoilNum)%PLFCurveIndex > 0)Then
IF (PartLoadRat > 0 .AND. StageNum < 2)THEN
PLF = CurveValue(HeatingCoil(CoilNum)%PLFCurveIndex, PartLoadRat)
IF (PLF < 0.7d0) THEN
IF (HeatingCoil(CoilNum)%PLFErrorCount < 1) THEN
HeatingCoil(CoilNum)%PLFErrorCount=HeatingCoil(CoilNum)%PLFErrorCount+1
CALL ShowWarningError('CalcGasHeatingCoil: '//TRIM(cAllCoilTypes(HeatingCoil(CoilNum)%HCoilType_Num))//'="'// &
TRIM(HeatingCoil(CoilNum)%Name)//'", PLF curve values')
CALL ShowContinueError('The PLF curve value = '//TRIM(TrimSigDigits(PLF,5))// &
' for part-load ratio = '//TRIM(TrimSigDigits(PartLoadRat,5)))
CALL ShowContinueError('PLF curve values must be >= 0.7. PLF has been reset to 0.7 and the simulation continues...')
CALL ShowContinueError('Check the IO reference manual for PLF curve guidance [Coil:Heating:Gas].')
ELSE
CALL ShowRecurringWarningErrorAtEnd(TRIM(HeatingCoil(CoilNum)%Name)// &
', Heating coil PLF curve < 0.7 warning continues... ', &
HeatingCoil(CoilNum)%PLFErrorIndex,PLF,PLF)
END IF
PLF = 0.7d0
END IF
! Modify the Gas Coil Consumption and parasitic loads based on PLF curve
HeatingCoil(CoilNum)%RTF = PartLoadRat/PLF
IF (HeatingCoil(CoilNum)%RTF > 1.0d0 .and. ABS(HeatingCoil(CoilNum)%RTF-1.0d0) > .001d0) THEN
IF (HeatingCoil(CoilNum)%RTFErrorCount < 1) THEN
HeatingCoil(CoilNum)%RTFErrorCount=HeatingCoil(CoilNum)%RTFErrorCount+1
CALL ShowWarningError('CalcGasHeatingCoil: '//TRIM(cAllCoilTypes(HeatingCoil(CoilNum)%HCoilType_Num))//'="'// &
TRIM(HeatingCoil(CoilNum)%Name)//'", runtime fraction')
CALL ShowContinueError('The runtime fraction exceeded 1.0. ['//TRIM(TrimSigDigits(HeatingCoil(CoilNum)%RTF,4))//'].')
CALL ShowContinueError('Runtime fraction is set to 1.0 and the simulation continues...')
CALL ShowContinueError('Check the IO reference manual for PLF curve guidance [Coil:Heating:Gas].')
ELSE
CALL ShowRecurringWarningErrorAtEnd(TRIM(HeatingCoil(CoilNum)%Name)// &
', Heating coil runtime fraction > 1.0 warning continues... ', &
HeatingCoil(CoilNum)%RTFErrorIndex,HeatingCoil(CoilNum)%RTF,HeatingCoil(CoilNum)%RTF)
END IF
HeatingCoil(CoilNum)%RTF = 1.0d0 ! Reset coil runtime fraction to 1.0
ELSEIF (HeatingCoil(CoilNum)%RTF > 1.0d0) THEN
HeatingCoil(CoilNum)%RTF = 1.0d0 ! Reset coil runtime fraction to 1.0
END IF
HeatingCoil(CoilNum)%ElecUseLoad = HeatingCoil(CoilNum)%MSParasiticElecLoad(StageNum) * HeatingCoil(CoilNum)%RTF
HeatingCoil(CoilNum)%GasUseLoad = (HeatingCoil(CoilNum)%MSNominalCapacity(StageNum) / EffLS) * HeatingCoil(CoilNum)%RTF
HeatingCoil(CoilNum)%ParasiticGasRate = HeatingCoil(CoilNum)%ParasiticGasCapacity * (1.0d0 - HeatingCoil(CoilNum)%RTF)
! Fan power will also be modified by the heating coil's part load fraction
! OnOffFanPartLoadFraction passed to fan via DataHVACGlobals (cycling fan only)
IF(FanOpMode .EQ. CycFanCycCoil)THEN
OnOffFanPartLoadFraction = PLF
END IF
END IF
! This requires a CR to correct (i.e., if PLFCurveIndex = 0 do this)
! ELSE
! IF(CycRatio > 0.0d0 .AND. StageNum < 2)THEN
! HeatingCoil(CoilNum)%ElecUseLoad = HeatingCoil(CoilNum)%MSParasiticElecLoad(StageNum) * CycRatio
! HeatingCoil(CoilNum)%GasUseLoad = HeatingCoil(CoilNum)%MSNominalCapacity(StageNum) / EffLS * CycRatio
! HeatingCoil(CoilNum)%ParasiticGasRate = HeatingCoil(CoilNum)%ParasiticGasCapacity * (1.0d0 - CycRatio)
! END IF
END IF
RETURN
END SUBROUTINE CalcMultiStageGasHeatingCoil