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) | :: | CoilNum | |||
real(kind=r64) | :: | QCoilReq | ||||
real(kind=r64), | intent(out) | :: | QCoilActual | |||
integer, | intent(in) | :: | FanOpMode | |||
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 CalcGasHeatingCoil(CoilNum,QCoilReq,QCoilActual,FanOpMode,PartLoadRatio)
! SUBROUTINE INFORMATION:
! AUTHOR Rich Liesen
! DATE WRITTEN May 2000
! MODIFIED na
! RE-ENGINEERED na
! PURPOSE OF THIS SUBROUTINE:
! Simulates a simple Gas heating coil with a burner efficiency
! METHODOLOGY EMPLOYED:
! REFERENCES:
! USE STATEMENTS:
USE DataHVACGlobals, ONLY: TempControlTol
USE CurveManager, ONLY : CurveValue
USE General, ONLY: TrimSigDigits
USE DataAirLoop, ONLY: LoopHeatingCoilMaxRTF
! SUBROUTINE ARGUMENT DEFINITIONS:
INTEGER, INTENT(IN) :: CoilNum ! index to heating coil
REAL(r64), INTENT(OUT) :: QCoilActual ! coil load actually delivered (W)
INTEGER, INTENT(IN) :: FanOpMode ! fan operating mode
REAL(r64), INTENT(IN) :: PartLoadRatio ! part-load ratio of heating coil
! SUBROUTINE PARAMETER DEFINITIONS:
! na
! INTERFACE BLOCK SPECIFICATIONS
! na
! DERIVED TYPE DEFINITIONS
! na
! SUBROUTINE LOCAL VARIABLE DECLARATIONS:
REAL(r64) AirMassFlow ! [kg/sec]
REAL(r64) TempAirIn ! [C]
REAL(r64) TempAirOut ! [C]
REAL(r64) Win
REAL(r64) Effic
REAL(r64) CapacitanceAir
REAL(r64) HeatingCoilLoad
REAL(r64) QCoilReq
REAL(r64) QCoilCap
REAL(r64) TempSetPoint
Integer Control
REAL(r64) PartLoadRat
REAL(r64) PLF
Effic = HeatingCoil(CoilNum)%Efficiency
TempAirIn = HeatingCoil(CoilNum)%InletAirTemp
Win = HeatingCoil(CoilNum)%InletAirHumRat
Control = HeatingCoil(CoilNum)%Control
TempSetPoint = HeatingCoil(CoilNum)%DesiredOutletTemp
AirMassFlow = HeatingCoil(CoilNum)%InletAirMassFlowRate
CapacitanceAir=PsyCpAirFnWTdb(Win,TempAirIn)*AirMassFlow
! If the coil is operating there should be some heating capacitance
! across the coil, so do the simulation. If not set outlet to inlet and no load.
! Also the coil has to be scheduled to be available.
! Control output to meet load QCoilReq (QCoilReq is passed in if load controlled, otherwise QCoilReq=-999)
IF((AirMassFlow > 0.0d0 .AND. HeatingCoil(CoilNum)%NominalCapacity > 0.0d0) .and. &
(GetCurrentScheduleValue(HeatingCoil(CoilNum)%SchedPtr) .gt. 0.0d0) .and. &
(QCoilReq .gt. 0.0d0)) THEN
!check to see if the Required heating capacity is greater than the user specified capacity.
IF(QCoilReq > HeatingCoil(CoilNum)%NominalCapacity) Then
QCoilCap = HeatingCoil(CoilNum)%NominalCapacity
Else
QCoilCap = QCoilReq
End IF
TempAirOut=TempAirIn + QCoilCap/CapacitanceAir
HeatingCoilLoad = QCoilCap
PartLoadRat = HeatingCoilLoad/HeatingCoil(CoilNum)%NominalCapacity
!The HeatingCoilLoad is the change in the enthalpy of the Heating
HeatingCoil(CoilNum)%GasUseLoad = HeatingCoilLoad/Effic
HeatingCoil(CoilNum)%ElecUseLoad = HeatingCoil(CoilNum)%ParasiticElecLoad*PartLoadRat
HeatingCoil(CoilNum)%ParasiticGasRate = HeatingCoil(CoilNum)%ParasiticGasCapacity * (1.0d0 - PartLoadRat)
! Control coil output to meet a setpoint temperature.
Else IF((AirMassFlow > 0.0d0 .AND. HeatingCoil(CoilNum)%NominalCapacity > 0.0d0) .and. &
(GetCurrentScheduleValue(HeatingCoil(CoilNum)%SchedPtr) .gt. 0.0d0) .and. &
(QCoilReq == SensedLoadFlagValue) .and. &
(ABS(TempSetPoint-TempAirIn) .gt. TempControlTol) ) THEN
QCoilCap = CapacitanceAir*(TempSetPoint - TempAirIn)
! check to see if setpoint above entering temperature. If not, set
! output to zero.
IF(QCoilCap .LE. 0.0d0) THEN
QCoilCap = 0.0d0
TempAirOut = TempAirIn
!check to see if the Required heating capacity is greater than the user
! specified capacity.
Else IF(QCoilCap > HeatingCoil(CoilNum)%NominalCapacity) Then
QCoilCap = HeatingCoil(CoilNum)%NominalCapacity
TempAirOut=TempAirIn + QCoilCap/CapacitanceAir
Else
TempAirOut = TempSetPoint
End IF
HeatingCoilLoad = QCoilCap
PartLoadRat = HeatingCoilLoad/HeatingCoil(CoilNum)%NominalCapacity
!The HeatingCoilLoad is the change in the enthalpy of the Heating
HeatingCoil(CoilNum)%GasUseLoad = HeatingCoilLoad/Effic
HeatingCoil(CoilNum)%ElecUseLoad = HeatingCoil(CoilNum)%ParasiticElecLoad*PartLoadRat
HeatingCoil(CoilNum)%ParasiticGasRate = HeatingCoil(CoilNum)%ParasiticGasCapacity * (1.0d0 - PartLoadRat)
Else ! If not running Conditions do not change across coil from inlet to outlet
TempAirOut=TempAirIn
HeatingCoilLoad=0.0d0
PartLoadRat = 0.0d0
HeatingCoil(CoilNum)%GasUseLoad = 0.0d0
HeatingCoil(CoilNum)%ElecUseLoad = 0.0d0
HeatingCoil(CoilNum)%ParasiticGasRate = HeatingCoil(CoilNum)%ParasiticGasCapacity
END IF
HeatingCoil(CoilNum)%RTF = PartLoadRat
! If the PLF curve is defined the gas usage needs to be modified
If(HeatingCoil(CoilNum)%PLFCurveIndex > 0)Then
IF (PartLoadRat == 0)THEN
HeatingCoil(CoilNum)%GasUseLoad = 0.0d0
ELSE
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)%ParasiticElecLoad * HeatingCoil(CoilNum)%RTF
HeatingCoil(CoilNum)%GasUseLoad = HeatingCoil(CoilNum)%NominalCapacity / Effic * 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
END IF
! Set the outlet conditions
HeatingCoil(CoilNum)%HeatingCoilLoad = HeatingCoilLoad
HeatingCoil(CoilNum)%OutletAirTemp = TempAirOut
! This HeatingCoil does not change the moisture or Mass Flow across the component
HeatingCoil(CoilNum)%OutletAirHumRat = HeatingCoil(CoilNum)%InletAirHumRat
HeatingCoil(CoilNum)%OutletAirMassFlowRate = HeatingCoil(CoilNum)%InletAirMassFlowRate
!Set the outlet enthalpys for air and Heating
HeatingCoil(CoilNum)%OutletAirEnthalpy = PsyHFnTdbW(HeatingCoil(CoilNum)%OutletAirTemp, &
HeatingCoil(CoilNum)%OutletAirHumRat)
QCoilActual = HeatingCoilLoad
LoopHeatingCoilMaxRTF = MAX(LoopHeatingCoilMaxRTF,HeatingCoil(CoilNum)%RTF)
ElecHeatingCoilPower = HeatingCoil(CoilNum)%ElecUseLoad
RETURN
END Subroutine CalcGasHeatingCoil