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 |
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 SizeSteamCoil(CoilNum)
! SUBROUTINE INFORMATION:
! AUTHOR Rahul Chillar
! DATE WRITTEN Jan 2005
! MODIFIED na
! RE-ENGINEERED na
! PURPOSE OF THIS SUBROUTINE:
! This subroutine is for sizing Steam Coil Components for which flow rates have not been
! specified in the input.
! METHODOLOGY EMPLOYED:
! Obtains flow rates from the zone or system sizing arrays and plant sizing data.
! REFERENCES:
! na
! USE STATEMENTS:
USE DataSizing
USE PlantUtilities, ONLY: RegisterPlantCompDesignFlow
USE FluidProperties, ONLY: GetSatEnthalpyRefrig,GetSatDensityRefrig
! USE BranchInputManager, ONLY: MyPlantSizingIndex
USE ReportSizingManager, ONLY: ReportSizingOutput
IMPLICIT NONE ! Enforce explicit typing of all variables in this routine
! SUBROUTINE ARGUMENT DEFINITIONS:
Integer, Intent(IN) :: CoilNum
! SUBROUTINE PARAMETER DEFINITIONS:
! na
! INTERFACE BLOCK SPECIFICATIONS
! na
! DERIVED TYPE DEFINITIONS
! na
! SUBROUTINE LOCAL VARIABLE DECLARATIONS:
INTEGER :: PltSizNum ! do loop index for plant sizing
INTEGER :: PltSizSteamNum ! index of plant sizing object for 1st steam loop
LOGICAL :: ErrorsFound ! If errors detected in input
REAL(r64) :: CoilInTemp !
REAL(r64) :: CoilOutTemp !
REAL(r64) :: CoilOutHumRat !
REAL(r64) :: CoilInHumRat !
REAL(r64) :: DesCoilLoad !
REAL(r64) :: DesMassFlow !
REAL(r64) :: DesVolFlow !
REAL(r64) :: MinFlowFrac !
REAL(r64) :: OutAirFrac !
REAL(r64) :: TempSteamIn !
REAL(r64) :: EnthSteamInDry !
REAL(r64) :: EnthSteamOutWet !
REAL(r64) :: LatentHeatSteam !
REAL(r64) :: SteamDensity !
REAL(r64) :: RhoAirStd ! density of air at standard conditions
REAL(r64) :: CpAirStd ! specific heat of air at std conditions
REAL(r64) :: CpWater ! specific heat of water (condensed steam)
ErrorsFound = .FALSE.
PltSizSteamNum = 0
PltSizNum = 0
CoilInTemp = 0.0d0
CoilInHumRat = 0.0d0
CoilOutTemp = 0.0d0
DesCoilLoad = 0.0d0
MinFlowFrac = 0.0d0
DesMassFlow = 0.0d0
CpWater = 0.0d0
RhoAirStd = PsyRhoAirFnPbTdbW(StdBaroPress,20.0d0,0.0d0)
CpAirStd = PsyCpAirFnWTdb(0.0d0,20.0d0)
! If this is a steam coil
! Find the appropriate steam Plant Sizing object
IF (SteamCoil(CoilNum)%MaxSteamVolFlowRate == AutoSize) THEN
PltSizSteamNum = MyPlantSizingIndex("steam heating coil", SteamCoil(CoilNum)%Name, SteamCoil(CoilNum)%SteamInletNodeNum, &
SteamCoil(CoilNum)%SteamOutletNodeNum, ErrorsFound)
ENDIF
IF (PltSizSteamNum > 0) THEN
! If this is a central air system heating coil
IF (CurSysNum > 0) THEN
! If the coil water volume flow rate needs autosizing, then do it
IF (SteamCoil(CoilNum)%MaxSteamVolFlowRate == AutoSize) THEN
CALL CheckSysSizing('Coil:Heating:Steam',SteamCoil(CoilNum)%Name)
! Set the duct flow rate
SELECT CASE(CurDuctType)
CASE(Main)
DesVolFlow = FinalSysSizing(CurSysNum)%SysAirMinFlowRat*FinalSysSizing(CurSysNum)%DesMainVolFlow
CASE(Cooling)
DesVolFlow = FinalSysSizing(CurSysNum)%SysAirMinFlowRat*FinalSysSizing(CurSysNum)%DesCoolVolFlow
CASE(Heating)
DesVolFlow = FinalSysSizing(CurSysNum)%DesHeatVolFlow
CASE(Other)
DesVolFlow = FinalSysSizing(CurSysNum)%DesMainVolFlow
CASE DEFAULT
DesVolFlow = FinalSysSizing(CurSysNum)%DesMainVolFlow
END SELECT
DesMassFlow = RhoAirStd*DesVolFlow
! get the outside air fraction
IF (FinalSysSizing(CurSysNum)%HeatOAOption == MinOA) THEN
IF (DesVolFlow > 0.0d0) THEN
OutAirFrac = FinalSysSizing(CurSysNum)%DesOutAirVolFlow / DesVolFlow
ELSE
OutAirFrac = 1.0d0
END IF
OutAirFrac = MIN(1.0d0,MAX(0.0d0,OutAirFrac))
ELSE
OutAirFrac = 1.0d0
END IF
! mixed air temp
CoilInTemp = OutAirFrac*FinalSysSizing(CurSysNum)%HeatOutTemp + &
(1.0-OutAirFrac)*FinalSysSizing(CurSysNum)%HeatRetTemp
! coil load
DesCoilLoad = CpAirStd*DesMassFlow*(FinalSysSizing(CurSysNum)%HeatSupTemp - CoilInTemp)
!AUTOSTEAMCOIL
IF (DesCoilLoad >= SmallLoad) THEN
!TempSteamIn=SteamCoil(CoilNum)%InletSteamTemp
!TempSteamIn=PlantSizData(PltSizSteamNum)%ExitTemp
TempSteamIn = 100.0d0 ! DSU? Should be from the PlantSizing object (ExitTemp) instead of hardwired to 100?
! RefrigIndex is set during GetInput for this module
EnthSteamInDry = GetSatEnthalpyRefrig('STEAM',TempSteamIn,1.0d0,SteamCoil(CoilNum)%FluidIndex,'SizeSteamCoil')
EnthSteamOutWet= GetSatEnthalpyRefrig('STEAM',TempSteamIn,0.0d0,SteamCoil(CoilNum)%FluidIndex,'SizeSteamCoil')
LatentHeatSteam=EnthSteamInDry-EnthSteamOutWet
SteamDensity=GetSatDensityRefrig('STEAM',TempSteamIn,1.0d0,SteamCoil(CoilNum)%FluidIndex,'SizeSteamCoil')
! SteamCoil(CoilNum)%MaxSteamVolFlowRate = DesCoilLoad/(SteamDensity * LatentHeatSteam)
! CpWater = GetSpecificHeatGlycol('WATER', &
! TempSteamIn, &
! PlantLoop(SteamCoil(CoilNum)%LoopNum)%FluidIndex, &
! 'SizeSteamCoil')
CpWater = GetSatSpecificHeatRefrig('STEAM',TempSteamIn,0.0d0,SteamCoil(CoilNum)%FluidIndex,'SizeSteamCoil')
SteamCoil(CoilNum)%MaxSteamVolFlowRate = DesCoilLoad / (SteamDensity*(LatentHeatSteam + &
SteamCoil(CoilNum)%DegOfSubCooling*CpWater))
! PlantSizData(PltSizSteamNum)%DeltaT*CPHW(PlantSizData(PltSizSteamNum)%ExitTemp)))
ELSE
SteamCoil(CoilNum)%MaxSteamVolFlowRate = 0.0d0
CALL ShowWarningError('The design coil load is zero for COIL:Heating:Steam ' &
//TRIM(SteamCoil(CoilNum)%Name))
!CALL ShowContinueError('The autosize value for max Steam flow rate is zero')
!CALL ShowContinueError('To change this, input a value for UA, change the heating design day, or lower')
!CALL ShowContinueError(' the system heating design supply air temperature')
END IF
CALL ReportSizingOutput('Coil:Heating:Steam',SteamCoil(CoilNum)%Name,&
'Maximum Steam Flow Rate [m3/s]',SteamCoil(CoilNum)%MaxSteamVolFlowRate)
END IF
! if this is a zone coil
ELSE IF (CurZoneEqNum > 0) THEN
CALL CheckZoneSizing('Coil:Heating:Steam',SteamCoil(CoilNum)%Name)
! autosize the coil steam volume flow rate if needed
IF (SteamCoil(CoilNum)%MaxSteamVolFlowRate == AutoSize) THEN
! if coil is part of a terminal unit just use the terminal unit value
IF (TermUnitSingDuct .OR. TermUnitPIU .OR. TermUnitIU) THEN
SteamCoil(CoilNum)%MaxSteamVolFlowRate = TermUnitSizing(CurZoneEqNum)%MaxSTVolFlow
! if coil is part of a zonal unit, calc coil load to get hot Steam flow rate
ELSE
CoilInTemp = FinalZoneSizing(CurZoneEqNum)%DesHeatCoilInTemp
CoilOutTemp = FinalZoneSizing(CurZoneEqNum)%HeatDesTemp
CoilOutHumRat = FinalZoneSizing(CurZoneEqNum)%HeatDesHumRat
DesMassFlow = FinalZoneSizing(CurZoneEqNum)%DesHeatMassFlow
DesCoilLoad = PsyCpAirFnWTdb(CoilOutHumRat, 0.5d0*(CoilInTemp+CoilOutTemp)) &
* DesMassFlow * (CoilOutTemp-CoilInTemp)
IF (DesCoilLoad >= SmallLoad) THEN
TempSteamIn=100.0d0 ! DSU? Should be from the PlantSizing object (ExitTemp) instead of hardwired to 100?
! RefrigIndex is set during GetInput for this module
EnthSteamInDry = GetSatEnthalpyRefrig('STEAM',TempSteamIn,1.0d0,SteamCoil(CoilNum)%FluidIndex,'SizeSteamCoil')
EnthSteamOutWet= GetSatEnthalpyRefrig('STEAM',TempSteamIn,0.0d0,SteamCoil(CoilNum)%FluidIndex,'SizeSteamCoil')
LatentHeatSteam=EnthSteamInDry-EnthSteamOutWet
SteamDensity=GetSatDensityRefrig('STEAM',TempSteamIn,1.0d0,SteamCoil(CoilNum)%FluidIndex,'SizeSteamCoil')
! SteamCoil(CoilNum)%MaxSteamVolFlowRate = DesCoilLoad/(SteamDensity * LatentHeatSteam)
! CpWater = GetSpecificHeatGlycol('WATER', &
! TempSteamIn, &
! PlantLoop(SteamCoil(CoilNum)%LoopNum)%FluidIndex, &
! 'SizeSteamCoil')
CpWater = GetSatSpecificHeatRefrig('STEAM',TempSteamIn,0.0d0,SteamCoil(CoilNum)%FluidIndex,'SizeSteamCoil')
SteamCoil(CoilNum)%MaxSteamVolFlowRate = DesCoilLoad / (SteamDensity*(LatentHeatSteam + &
SteamCoil(CoilNum)%DegOfSubCooling*CpWater))
! PlantSizData(PltSizSteamNum)%DeltaT*CPHW(PlantSizData(PltSizSteamNum)%ExitTemp)))
ELSE
SteamCoil(CoilNum)%MaxSteamVolFlowRate = 0.0d0
END IF
END IF
! issue warning if hw coil has zero flow
IF (SteamCoil(CoilNum)%MaxSteamVolFlowRate == 0.0d0) THEN
CALL ShowWarningError('The design coil load is zero for COIL:Heating:Steam ' &
//TRIM(SteamCoil(CoilNum)%Name))
CALL ShowContinueError('The autosize value for max Steam flow rate is zero')
!CALL ShowContinueError('To change this, input a value for UA, change the heating design day, or lower')
!CALL ShowContinueError(' the system heating design supply air temperature')
END IF
CALL ReportSizingOutput('Coil:Heating:Steam',SteamCoil(CoilNum)%Name,&
'Maximum Steam Flow Rate [m3/s]',SteamCoil(CoilNum)%MaxSteamVolFlowRate)
END IF
END IF ! end zone coil ELSE - IF
ELSE
! if there is no heating Plant Sizing object and autosizng was requested, issue an error message
IF (SteamCoil(CoilNum)%MaxSteamVolFlowRate == AutoSize) THEN
CALL ShowSevereError('Autosizing of Steam coil requires a heating loop Sizing:Plant object')
CALL ShowContinueError('Occurs in Steam coil object= '//TRIM(SteamCoil(CoilNum)%Name))
ErrorsFound = .TRUE.
END IF
END IF ! end of heating Plant Sizing existence IF - ELSE
! save the design Steam volumetric flow rate for use by the Steam loop sizing algorithms
CALL RegisterPlantCompDesignFlow(SteamCoil(CoilNum)%SteamInletNodeNum,SteamCoil(CoilNum)%MaxSteamVolFlowRate)
IF (ErrorsFound) THEN
CALL ShowFatalError('Preceding Steam coil sizing errors cause program termination')
END IF
RETURN
END SUBROUTINE SizeSteamCoil