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), | intent(in) | :: | QCoilRequested | |||
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 CalcSteamAirCoil(CoilNum,QCoilRequested,QCoilActual,FanOpMode,PartLoadRatio)
! SUBROUTINE INFORMATION:
! AUTHOR Rahul Chillar
! DATE WRITTEN Jan 2005
! MODIFIED Sept. 2012, B. Griffith, add calls to SetComponentFlowRate for plant interactions
! RE-ENGINEERED na
! PURPOSE OF THIS SUBROUTINE:
! Simple Steam to air heat exchanger which,
! serves as an interface for distributing heat from boiler to zones.
! METHODOLOGY EMPLOYED:
! Steam coils are different, All of steam condenses in heat exchanger
! Steam traps allow only water to leave the coil,the degree of subcooling
! desired is input by the user, which is used to calculate water outlet temp.
! Heat exchange is = Latent Heat + Sensible heat,coil effectivness is 1.0
! REFERENCES:
! na
! USE STATEMENTS:
USE DataHVACGlobals, ONLY: TempControlTol
USE PlantUtilities, ONLY: SetComponentFlowRate
IMPLICIT NONE ! Enforce explicit typing of all variables in this routine
! SUBROUTINE ARGUMENT DEFINITIONS:
Integer, Intent(IN) :: CoilNum
REAL(r64), Intent(IN) :: QCoilRequested ! requested coil load
REAL(r64), Intent(OUT):: QCoilActual ! coil load actually delivered
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) :: SteamMassFlowRate =0.0d0
REAL(r64) :: AirMassFlow =0.0d0! [kg/sec]
REAL(r64) :: TempAirIn =0.0d0! [C]
REAL(r64) :: TempAirOut =0.0d0! [C]
REAL(r64) :: Win =0.0d0
REAL(r64) :: TempSteamIn =0.0d0
REAL(r64) :: TempWaterOut =0.0d0
REAL(r64) :: CapacitanceAir =0.0d0
REAL(r64) :: HeatingCoilLoad =0.0d0
REAL(r64) :: CoilPress =0.0d0
REAL(r64) :: EnthSteamInDry =0.0d0
REAL(r64) :: EnthSteamOutWet =0.0d0
REAL(r64) :: LatentHeatSteam =0.0d0
REAL(r64) :: SubCoolDeltaTemp =0.0d0
REAL(r64) :: TempSetPoint =0.0d0
REAL(r64) :: QCoilReq =0.0d0
REAL(r64) :: QCoilCap =0.0d0
REAL(r64) :: QSteamCoilMaxHT =0.0d0
REAL(r64) :: TempWaterAtmPress =0.0d0
REAL(r64) :: TempLoopOutToPump =0.0d0
REAL(r64) :: EnergyLossToEnvironment=0.0d0
REAL(r64) :: EnthCoilOutlet =0.0d0
REAL(r64) :: EnthPumpInlet =0.0d0
REAL(r64) :: EnthAtAtmPress =0.0d0
REAL(r64) :: CpWater =0.0d0
QCoilReq = QCoilRequested
TempAirIn = SteamCoil(CoilNum)%InletAirTemp
Win = SteamCoil(CoilNum)%InletAirHumRat
TempSteamIn = SteamCoil(CoilNum)%InletSteamTemp
CoilPress = SteamCoil(CoilNum)%InletSteamPress
SubCoolDeltaTemp = SteamCoil(CoilNum)%DegOfSubCooling
TempSetPoint = SteamCoil(CoilNum)%DesiredOutletTemp
! adjust mass flow rates for cycling fan cycling coil operation
IF(FanOpMode .EQ. CycFanCycCoil)THEN
IF(PartLoadRatio .GT. 0.0d0)THEN
AirMassFlow = SteamCoil(CoilNum)%InletAirMassFlowRate / PartLoadRatio
SteamMassFlowRate = MIN(SteamCoil(CoilNum)%InletSteamMassFlowRate / PartLoadRatio, &
SteamCoil(CoilNum)%MaxSteamMassFlowRate)
QCoilReq = QCoilReq / PartLoadRatio
ELSE
AirMassFlow = 0.0d0
SteamMassFlowRate = 0.0d0
END IF
ELSE
AirMassFlow = SteamCoil(CoilNum)%InletAirMassFlowRate
SteamMassFlowRate = SteamCoil(CoilNum)%InletSteamMassFlowRate
END IF
IF (AirMassFlow .GT. 0.0d0) THEN ! If the coil is operating
CapacitanceAir=PsyCpAirFnWTdb(Win,TempAirIn)*AirMassFlow
Else
CapacitanceAir=0.0d0
End If
! 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. Load Controlled Coil.
Select Case(SteamCoil(CoilNum)%TypeofCoil )
Case(ZoneloadControl)
IF((CapacitanceAir .GT. 0.0d0) .AND.((SteamCoil(CoilNum)%InletSteamMassFlowRate).GT.0.0d0).AND. &
(GetCurrentScheduleValue(SteamCoil(CoilNum)%SchedPtr).GT. 0.0d0 .OR. MySizeFlag(CoilNum)).and. &
(QCoilReq .gt. 0.0d0)) THEN
! Steam heat exchangers would not have effectivness, since all of the steam is
! converted to water and only then the steam trap allows it to leave the heat
! exchanger, subsequently heat exchange is latent heat + subcooling.
EnthSteamInDry = GetSatEnthalpyRefrig('STEAM',TempSteamIn,1.0d0,SteamCoil(CoilNum)%FluidIndex,'CalcSteamAirCoil')
EnthSteamOutWet= GetSatEnthalpyRefrig('STEAM',TempSteamIn,0.0d0,SteamCoil(CoilNum)%FluidIndex,'CalcSteamAirCoil')
LatentHeatSteam=EnthSteamInDry-EnthSteamOutWet
! CpWater = GetSpecificHeatGlycol('WATER', &
! TempSteamIn, &
! PlantLoop(SteamCoil(CoilNum)%LoopNum)%FluidIndex, &
! 'CalcSteamAirCoil')
CpWater = GetSatSpecificHeatRefrig('STEAM',TempSteamIn,0.0d0,SteamCoil(CoilNum)%FluidIndex,'SizeSteamCoil')
! Max Heat Transfer
QSteamCoilMaxHT= SteamCoil(CoilNum)%MaxSteamMassFlowRate*(LatentHeatSteam+SubCoolDeltaTemp*CpWater)
SteamCoil(CoilNum)%OperatingCapacity = QSteamCoilMaxHT
! Determine the Max coil capacity and check for the same.
IF(QCoilReq > QSteamCoilMaxHT) Then
QCoilCap = QSteamCoilMaxHT
Else
QCoilCap = QCoilReq
End IF
! Steam Mass Flow Rate Required
SteamMassFlowRate=QCoilCap/(LatentHeatSteam+SubCoolDeltaTemp*CpWater)
CALL SetComponentFlowRate( SteamMassFlowRate, &
SteamCoil(CoilNum)%SteamInletNodeNum, &
SteamCoil(CoilNum)%SteamOutletNodeNum, &
SteamCoil(CoilNum)%LoopNum, &
SteamCoil(CoilNum)%LoopSide, &
SteamCoil(CoilNum)%BranchNum, &
SteamCoil(CoilNum)%CompNum )
! recalculate if mass flow rate changed in previous call.
QCoilCap = SteamMassFlowRate*(LatentHeatSteam+SubCoolDeltaTemp*CpWater)
! In practice Sensible & Superheated heat transfer is negligible compared to latent part.
! This is required for outlet water temperature, otherwise it will be saturation temperature.
! Steam Trap drains off all the Water formed.
! Here Degree of Subcooling is used to calculate hot water return temperature.
! Calculating Water outlet temperature
TempWaterOut=TempSteamIn-SubCoolDeltaTemp
! Total Heat Transfer to air
HeatingCoilLoad =QCoilCap
! Temperature of air at outlet
TempAirOut=TempAirIn+QCoilCap/(AirMassFlow*PsyCpAirFnWTdb(Win,TempAirIn))
SteamCoil(CoilNum)%OutletSteamMassFlowRate = SteamMassFlowRate
SteamCoil(CoilNum)%InletSteamMassFlowRate = SteamMassFlowRate
!************************* Loop Losses *****************************
! Loop pressure return considerations included in steam coil since the pipes are
! perfect and do not account for losses.
! Return water is condensate at atmoshperic pressure
! Process is considered constant enthalpy expansion
! No quality function in EnergyPlus hence no option left apart from
! considering saturated state.
! StdBaroPress=101325
TempWaterAtmPress=GetSatTemperatureRefrig('Steam',StdBaroPress,SteamCoil(CoilNum)%FluidIndex,'CalcSteamAirCoil')
! Point 4 at atm - loop delta subcool during return journery back to pump
TempLoopOutToPump=TempWaterAtmPress-SteamCoil(CoilNum)%LoopSubCoolReturn
! Actual Steam Coil Outlet Enthalpy
EnthCoilOutlet=GetSatEnthalpyRefrig('STEAM',TempSteamIn,0.0d0, &
SteamCoil(CoilNum)%FluidIndex,'CalcSteamAirCoil') - CpWater*SubCoolDeltaTemp
! Enthalpy at Point 4
EnthAtAtmPress=GetSatEnthalpyRefrig('STEAM',TempWaterAtmPress,0.0d0,SteamCoil(CoilNum)%FluidIndex,'CalcSteamAirCoil')
! Reported value of coil outlet enthalpy at the node to match the node outlet temperature
CpWater = GetSatSpecificHeatRefrig('STEAM',TempLoopOutToPump,0.0d0,SteamCoil(CoilNum)%FluidIndex,'SizeSteamCoil')
EnthPumpInlet=EnthAtAtmPress-CpWater*SteamCoil(CoilNum)%LoopSubCoolReturn
SteamCoil(CoilNum)%OutletWaterEnthalpy =EnthPumpInlet
! Point 3-Point 5,
EnergyLossToEnvironment=SteamMassFlowRate*(EnthCoilOutlet-EnthPumpInlet)
! Loss to enviornment due to pressure drop
SteamCoil(CoilNum)%LoopLoss=EnergyLossToEnvironment
!************************* Loop Losses *****************************
ELSE ! Coil is not running.
TempAirOut = TempAirIn
TempWaterOut = TempSteamIn
HeatingCoilLoad = 0.0d0
SteamCoil(CoilNum)%OutletWaterEnthalpy = SteamCoil(CoilNum)%InletSteamEnthalpy
SteamCoil(CoilNum)%OutletSteamMassFlowRate = 0.0d0
SteamCoil(CoilNum)%OutletSteamQuality = 0.0d0
SteamCoil(CoilNum)%LoopLoss = 0.0d0
TempLoopOutToPump = TempWaterOut
END IF
Case(TemperatureSetPointControl)
! Control coil output to meet a Setpoint Temperature.
IF((CapacitanceAir .GT. 0.0d0) .AND.((SteamCoil(CoilNum)%InletSteamMassFlowRate).GT.0.0d0).AND. &
(GetCurrentScheduleValue(SteamCoil(CoilNum)%SchedPtr).GT. 0.0d0 .OR. MySizeFlag(CoilNum)).and. &
(ABS(TempSetPoint-TempAirIn) .gt. TempControlTol) ) THEN
! Steam heat exchangers would not have effectivness, since all of the steam is
! converted to water and only then the steam trap allows it to leave the heat
! exchanger, subsequently heat exchange is latent heat + subcooling.
EnthSteamInDry = GetSatEnthalpyRefrig('STEAM',TempSteamIn,1.0d0,SteamCoil(CoilNum)%FluidIndex,'CalcSteamAirCoil')
EnthSteamOutWet= GetSatEnthalpyRefrig('STEAM',TempSteamIn,0.0d0,SteamCoil(CoilNum)%FluidIndex,'CalcSteamAirCoil')
LatentHeatSteam=EnthSteamInDry-EnthSteamOutWet
! CpWater = GetSpecificHeatGlycol('WATER', &
! TempSteamIn, &
! PlantLoop(SteamCoil(CoilNum)%LoopNum)%FluidIndex, &
! 'CalcSteamAirCoil')
CpWater = GetSatSpecificHeatRefrig('STEAM',TempSteamIn,0.0d0,SteamCoil(CoilNum)%FluidIndex,'SizeSteamCoil')
! Max Heat Transfer
QSteamCoilMaxHT= SteamCoil(CoilNum)%MaxSteamMassFlowRate*(LatentHeatSteam+SubCoolDeltaTemp*CpWater)
! Coil Load in case of temperature setpoint
QCoilCap=CapacitanceAir*(TempSetPoint-TempAirIn)
! Check to see if setpoint above enetering temperature. If not, set
! output to zero.
IF(QCoilCap .LE. 0.0d0) THEN
QCoilCap = 0.0d0
TempAirOut = TempAirIn
! Steam Mass Flow Rate Required
SteamMassFlowRate=0.d0
CALL SetComponentFlowRate( SteamMassFlowRate, &
SteamCoil(CoilNum)%SteamInletNodeNum, &
SteamCoil(CoilNum)%SteamOutletNodeNum, &
SteamCoil(CoilNum)%LoopNum, &
SteamCoil(CoilNum)%LoopSide, &
SteamCoil(CoilNum)%BranchNum, &
SteamCoil(CoilNum)%CompNum )
! Inlet equal to outlet when not required to run.
TempWaterOut=TempSteamIn
! Total Heat Transfer to air
HeatingCoilLoad = QCoilCap
!The HeatingCoilLoad is the change in the enthalpy of the water
SteamCoil(CoilNum)%OutletWaterEnthalpy = SteamCoil(CoilNum)%InletSteamEnthalpy
! Outlet flow rate set to inlet
SteamCoil(CoilNum)%OutletSteamMassFlowRate = SteamMassFlowRate
SteamCoil(CoilNum)%InletSteamMassFlowRate = SteamMassFlowRate
ELSEIF (QCoilCap .GT. QSteamCoilMaxHT) Then
! Setting to Maximum Coil Capacity
QCoilCap = QSteamCoilMaxHT
! Temperature of air at outlet
TempAirOut=TempAirIn+QCoilCap/(AirMassFlow*PsyCpAirFnWTdb(Win,TempAirIn))
! In practice Sensible & Superheated heat transfer is negligible compared to latent part.
! This is required for outlet water temperature, otherwise it will be saturation temperature.
! Steam Trap drains off all the Water formed.
! Here Degree of Subcooling is used to calculate hot water return temperature.
! Calculating Water outlet temperature
TempWaterOut=TempSteamIn-SubCoolDeltaTemp
! Steam Mass Flow Rate Required
SteamMassFlowRate=QCoilCap/(LatentHeatSteam+SubCoolDeltaTemp*CpWater)
CALL SetComponentFlowRate( SteamMassFlowRate, &
SteamCoil(CoilNum)%SteamInletNodeNum, &
SteamCoil(CoilNum)%SteamOutletNodeNum, &
SteamCoil(CoilNum)%LoopNum, &
SteamCoil(CoilNum)%LoopSide, &
SteamCoil(CoilNum)%BranchNum, &
SteamCoil(CoilNum)%CompNum )
! recalculate in case previous call changed mass flow rate
QCoilCap = SteamMassFlowRate*(LatentHeatSteam+SubCoolDeltaTemp*CpWater)
TempAirOut=TempAirIn+QCoilCap/(AirMassFlow*PsyCpAirFnWTdb(Win,TempAirIn))
! Total Heat Transfer to air
HeatingCoilLoad = QCoilCap
!The HeatingCoilLoad is the change in the enthalpy of the water
SteamCoil(CoilNum)%OutletWaterEnthalpy = SteamCoil(CoilNum)%InletSteamEnthalpy- &
HeatingCoilLoad/SteamMassFlowRate
SteamCoil(CoilNum)%OutletSteamMassFlowRate = SteamMassFlowRate
SteamCoil(CoilNum)%InletSteamMassFlowRate = SteamMassFlowRate
ELSE
! Temp air out is temperature Setpoint
TempAirOut=TempSetPoint
! In practice Sensible & Superheated heat transfer is negligible compared to latent part.
! This is required for outlet water temperature, otherwise it will be saturation temperature.
! Steam Trap drains off all the Water formed.
! Here Degree of Subcooling is used to calculate hot water return temperature.
! Calculating Water outlet temperature
TempWaterOut=TempSteamIn-SubCoolDeltaTemp
! Steam Mass Flow Rate Required
SteamMassFlowRate=QCoilCap/(LatentHeatSteam+SubCoolDeltaTemp*CpWater)
CALL SetComponentFlowRate( SteamMassFlowRate, &
SteamCoil(CoilNum)%SteamInletNodeNum, &
SteamCoil(CoilNum)%SteamOutletNodeNum, &
SteamCoil(CoilNum)%LoopNum, &
SteamCoil(CoilNum)%LoopSide, &
SteamCoil(CoilNum)%BranchNum, &
SteamCoil(CoilNum)%CompNum )
! recalculate in case previous call changed mass flow rate
QCoilCap = SteamMassFlowRate*(LatentHeatSteam+SubCoolDeltaTemp*CpWater)
TempAirOut=TempAirIn+QCoilCap/(AirMassFlow*PsyCpAirFnWTdb(Win,TempAirIn))
! Total Heat Transfer to air
HeatingCoilLoad = QCoilCap
SteamCoil(CoilNum)%OutletSteamMassFlowRate = SteamMassFlowRate
SteamCoil(CoilNum)%InletSteamMassFlowRate = SteamMassFlowRate
!************************* Loop Losses *****************************
! Loop pressure return considerations included in steam coil since the pipes are
! perfect and do not account for losses.
! Return water is condensate at atmoshperic pressure
! Process is considered constant enthalpy expansion
! No quality function in EnergyPlus hence no option left apart from
! considering saturated state.
! StdBaroPress=101325
TempWaterAtmPress=GetSatTemperatureRefrig('Steam',StdBaroPress,SteamCoil(CoilNum)%FluidIndex,'CalcSteamAirCoil')
! Point 4 at atm - loop delta subcool during return journery back to pump
TempLoopOutToPump=TempWaterAtmPress-SteamCoil(CoilNum)%LoopSubCoolReturn
! Actual Steam Coil Outlet Enthalpy
EnthCoilOutlet=GetSatEnthalpyRefrig('STEAM',TempSteamIn,0.0d0,SteamCoil(CoilNum)%FluidIndex,'CalcSteamAirCoil')-&
CpWater*SubCoolDeltaTemp
! Enthalpy at Point 4
EnthAtAtmPress=GetSatEnthalpyRefrig('STEAM',TempWaterAtmPress,0.0d0,SteamCoil(CoilNum)%FluidIndex,'CalcSteamAirCoil')
CpWater = GetSatSpecificHeatRefrig('STEAM',TempLoopOutToPump,0.0d0,SteamCoil(CoilNum)%FluidIndex,'SizeSteamCoil')
! Reported value of coil outlet enthalpy at the node to match the node outlet temperature
EnthPumpInlet=EnthAtAtmPress-CpWater*SteamCoil(CoilNum)%LoopSubCoolReturn
SteamCoil(CoilNum)%OutletWaterEnthalpy =EnthPumpInlet
! Point 3-Point 5,
EnergyLossToEnvironment=SteamMassFlowRate*(EnthCoilOutlet-EnthPumpInlet)
! Loss to enviornment due to pressure drop
SteamCoil(CoilNum)%LoopLoss=EnergyLossToEnvironment
!************************* Loop Losses *****************************
END IF
ELSE ! If not running Conditions do not change across coil from inlet to outlet
SteamMassFlowRate=0.d0
CALL SetComponentFlowRate( SteamMassFlowRate, &
SteamCoil(CoilNum)%SteamInletNodeNum, &
SteamCoil(CoilNum)%SteamOutletNodeNum, &
SteamCoil(CoilNum)%LoopNum, &
SteamCoil(CoilNum)%LoopSide, &
SteamCoil(CoilNum)%BranchNum, &
SteamCoil(CoilNum)%CompNum )
TempAirOut = TempAirIn
TempWaterOut = TempSteamIn
HeatingCoilLoad = 0.0d0
SteamCoil(CoilNum)%OutletWaterEnthalpy = SteamCoil(CoilNum)%InletSteamEnthalpy
SteamCoil(CoilNum)%OutletSteamMassFlowRate = 0.0d0
SteamCoil(CoilNum)%OutletSteamQuality = 0.0d0
SteamCoil(CoilNum)%LoopLoss = 0.0d0
TempLoopOutToPump = TempWaterOut
ENDIF
END SELECT
IF(FanOpMode .EQ. CycFanCycCoil)THEN
HeatingCoilLoad = HeatingCoilLoad*PartLoadRatio
END IF
! Set the outlet conditions
SteamCoil(CoilNum)%TotSteamHeatingCoilRate = HeatingCoilLoad
SteamCoil(CoilNum)%OutletAirTemp = TempAirOut
SteamCoil(CoilNum)%OutletSteamTemp = TempLoopOutToPump
SteamCoil(CoilNum)%OutletSteamQuality = 0.0d0
QCoilActual = HeatingCoilLoad
! This SteamCoil does not change the moisture or Mass Flow across the component
SteamCoil(CoilNum)%OutletAirHumRat = SteamCoil(CoilNum)%InletAirHumRat
SteamCoil(CoilNum)%OutletAirMassFlowRate = SteamCoil(CoilNum)%InletAirMassFlowRate
!Set the outlet enthalpys for air and water
SteamCoil(CoilNum)%OutletAirEnthalpy = PsyHFnTdbW(SteamCoil(CoilNum)%OutletAirTemp, &
SteamCoil(CoilNum)%OutletAirHumRat)
RETURN
END Subroutine CalcSteamAirCoil