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) | :: | RadSysNum | |||
integer, | intent(in) | :: | SystemType |
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 SizeLowTempRadiantSystem(RadSysNum,SystemType)
! SUBROUTINE INFORMATION:
! AUTHOR Fred Buhl
! DATE WRITTEN February 2002
! MODIFIED August 2013 Daeho Kang, add component sizing table entries
! RE-ENGINEERED na
! PURPOSE OF THIS SUBROUTINE:
! This subroutine is for sizing low temperature radiant components for which flow rates
! and tube length or max ekectric power have not been specified in the input
! METHODOLOGY EMPLOYED:
! Obtains flow rates from the zone sizing arrays and plant sizing data. Maximum electric
! power is set to the design heat load. Tube length is calculated by rule-of-thumb from
! rge surface area.
! REFERENCES:
! na
! USE STATEMENTS:
USE DataSizing
USE PlantUtilities, ONLY : RegisterPlantCompDesignFlow
USE ReportSizingManager, ONLY: ReportSizingOutput
USE FluidProperties, ONLY : GetDensityGlycol, GetSpecificHeatGlycol
USE DataPlant, ONLY : PlantLoop, MyPlantSizingIndex
USE General, ONLY: RoundSigDigits
IMPLICIT NONE ! Enforce explicit typing of all variables in this routine
! SUBROUTINE ARGUMENT DEFINITIONS:
INTEGER, INTENT(IN) :: RadSysNum ! Index for the low temperature radiant system under consideration within the derived types
INTEGER, INTENT(IN) :: SystemType ! Type of radiant system: hydronic, constant flow, or electric
! 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 :: PltSizHeatNum ! index of plant sizing object for 1st heating loop
INTEGER :: PltSizCoolNum ! index of plant sizing object for 1st cooling loop
INTEGER :: SurfNum ! surface index in radiant system data structure
LOGICAL :: ErrorsFound ! If errors detected in input
REAL(r64) :: rho
REAL(r64) :: Cp
LOGICAL :: IsAutosize ! Indicator to autosize
REAL(r64) :: MaxElecPowerDes ! Design electric power for reproting
REAL(r64) :: MaxElecPowerUser ! User hard-sized electric power for reproting
REAL(r64) :: WaterVolFlowMaxHeatDes ! Design hot water flow for reproting
REAL(r64) :: WaterVolFlowMaxHeatUser ! User hard-sized hot water flow for
REAL(r64) :: WaterVolFlowMaxCoolDes ! Design chilled water flow for reproting
REAL(r64) :: WaterVolFlowMaxCoolUser ! User hard-sized chilled water flow for reproting
REAL(r64) :: TubeLengthDes ! Design tube length for reproting
REAL(r64) :: TubeLengthUser ! User hard-sized tube length for reproting
ErrorsFound = .FALSE.
IsAutosize = .FALSE.
MaxElecPowerDes = 0.0d0
MaxElecPowerDes = 0.0d0
WaterVolFlowMaxHeatDes = 0.0d0
WaterVolFlowMaxHeatUser = 0.0d0
WaterVolFlowMaxCoolDes = 0.0d0
WaterVolFlowMaxCoolUser = 0.0d0
TubeLengthDes = 0.0d0
TubeLengthUser = 0.0d0
IF (SystemType==ElectricSystem) THEN
IF (ElecRadSys(RadSysNum)%MaxElecPower == AutoSize) THEN
IsAutosize = .TRUE.
END IF
IF (CurZoneEqNum > 0) THEN
IF (.NOT. IsAutosize .AND. .NOT. ZoneSizingRunDone) THEN ! simulation should continue
IF (ElecRadSys(RadSysNum)%MaxElecPower > 0.0d0) THEN
CALL ReportSizingOutput('ZoneHVAC:LowTemperatureRadiant:Electric', ElecRadSys(RadSysNum)%Name, &
'User-Specified Maximum Electrical Power to Panel [W]', ElecRadSys(RadSysNum)%MaxElecPower)
END IF
ELSE ! Autosize or hard-size with sizing run
CALL CheckZoneSizing('ZoneHVAC:LowTemperatureRadiant:Electric', ElecRadSys(RadSysNum)%Name)
IF ((CalcFinalZoneSizing(CurZoneEqNum)%DesHeatLoad * CalcFinalZoneSizing(CurZoneEqNum)%HeatSizingFactor) >= SmallLoad) THEN
MaxElecPowerDes = CalcFinalZoneSizing(CurZoneEqNum)%DesHeatLoad * &
CalcFinalZoneSizing(CurZoneEqNum)%HeatSizingFactor
ELSE
MaxElecPowerDes = 0.0d0
END IF
IF (IsAutosize) THEN
ElecRadSys(RadSysNum)%MaxElecPower = MaxElecPowerDes
CALL ReportSizingOutput('ZoneHVAC:LowTemperatureRadiant:Electric', ElecRadSys(RadSysNum)%Name, &
'Design Size Maximum Electrical Power to Panel [W]', MaxElecPowerDes)
ELSE ! Hard-size with sizing data
IF (ElecRadSys(RadSysNum)%MaxElecPower > 0.0d0 .AND. MaxElecPowerDes > 0.0d0) THEN
MaxElecPowerUser = ElecRadSys(RadSysNum)%MaxElecPower
CALL ReportSizingOutput('ZoneHVAC:LowTemperatureRadiant:Electric', ElecRadSys(RadSysNum)%Name, &
'Design Size Maximum Electrical Power to Panel [W]', MaxElecPowerDes, &
'User-Specified Maximum Electrical Power to Panel [W]', MaxElecPowerUser)
IF (DisplayExtraWarnings) THEN
IF ((ABS(MaxElecPowerDes - MaxElecPowerUser)/MaxElecPowerUser) > AutoVsHardSizingThreshold) THEN
CALL ShowMessage('SizeLowTempRadiantSystem: Potential issue with equipment sizing for ' &
// 'ZoneHVAC:LowTemperatureRadiant:Electric = " '// &
TRIM(HydrRadSys(RadSysNum)%Name)//'".')
CALL ShowContinueError('User-Specified Maximum Electrical Power to Panel of '// &
TRIM(RoundSigDigits(MaxElecPowerUser,2))// ' [W]')
CALL ShowContinueError('differs from Design Size Maximum Electrical Power to Panel of ' // &
TRIM(RoundSigDigits(MaxElecPowerDes,2))// ' [W]')
CALL ShowContinueError('This may, or may not, indicate mismatched component sizes.')
CALL ShowContinueError('Verify that the value entered is intended and is consistent with other components.')
END IF
ENDIF
END IF
END IF
END IF
END IF
END IF
IF (SystemType==HydronicSystem) THEN
IF (HydrRadSys(RadSysNum)%WaterVolFlowMaxHeat == AutoSize) THEN
IsAutosize = .TRUE.
END IF
IF (CurZoneEqNum > 0) THEN
IF (.NOT. IsAutosize .AND. .NOT. ZoneSizingRunDone) THEN ! simulation continue
IF (HydrRadSys(RadSysNum)%WaterVolFlowMaxHeat > 0.0d0) THEN
CALL ReportSizingOutput('ZoneHVAC:LowTemperatureRadiant:VariableFlow', HydrRadSys(RadSysNum)%Name, &
'User-Specified Maximum Hot Water Flow [m3/s]', HydrRadSys(RadSysNum)%WaterVolFlowMaxHeat)
END IF
ELSE ! Autosize or hard-size with sizing run
CALL CheckZoneSizing('ZoneHVAC:LowTemperatureRadiant:VariableFlow', HydrRadSys(RadSysNum)%Name)
IF (IsAutosize) THEN
PltSizHeatNum = MyPlantSizingIndex('ZoneHVAC:LowTemperatureRadiant:VariableFlow',HydrRadSys(RadSysNum)%Name,&
HydrRadSys(RadSysNum)%HotWaterInNode,HydrRadSys(RadSysNum)%HotWaterOutNode,ErrorsFound)
IF (PltSizHeatNum > 0) THEN
IF ((CalcFinalZoneSizing(CurZoneEqNum)%DesHeatLoad * &
CalcFinalZoneSizing(CurZoneEqNum)%HeatSizingFactor) >= SmallLoad) THEN
rho = GetDensityGlycol(PlantLoop(HydrRadSys(RadSysNum)%HWLoopNum)%FluidName, &
60.d0, &
PlantLoop(HydrRadSys(RadSysNum)%HWLoopNum)%FluidIndex, &
'SizeLowTempRadiantSystem')
Cp = GetSpecificHeatGlycol(PlantLoop(HydrRadSys(RadSysNum)%HWLoopNum)%FluidName, &
60.d0, &
PlantLoop(HydrRadSys(RadSysNum)%HWLoopNum)%FluidIndex, &
'SizeLowTempRadiantSystem')
WaterVolFlowMaxHeatDes = &
(CalcFinalZoneSizing(CurZoneEqNum)%DesHeatLoad * CalcFinalZoneSizing(CurZoneEqNum)%HeatSizingFactor) / &
( PlantSizData(PltSizHeatNum)%DeltaT * &
Cp * rho )
ELSE
WaterVolFlowMaxHeatDes = 0.0d0
END IF
ELSE
CALL ShowSevereError('Autosizing of water flow requires a heating loop Sizing:Plant object')
CALL ShowContinueError('Occurs in ' // 'ZoneHVAC:LowTemperatureRadiant:VariableFlow' // ' Object=' &
//TRIM(HydrRadSys(RadSysNum)%Name))
ErrorsFound = .TRUE.
END IF
END IF
IF (IsAutosize) THEN
HydrRadSys(RadSysNum)%WaterVolFlowMaxHeat = WaterVolFlowMaxHeatDes
CALL ReportSizingOutput('ZoneHVAC:LowTemperatureRadiant:VariableFlow', HydrRadSys(RadSysNum)%Name, &
'Design Size Maximum Hot Water Flow [m3/s]', WaterVolFlowMaxHeatDes)
ELSE ! hard-size with sizing data
IF (HydrRadSys(RadSysNum)%WaterVolFlowMaxHeat > 0.0d0 .AND. WaterVolFlowMaxHeatDes > 0.0d0) THEN
WaterVolFlowMaxHeatUser = HydrRadSys(RadSysNum)%WaterVolFlowMaxHeat
CALL ReportSizingOutput('ZoneHVAC:LowTemperatureRadiant:VariableFlow', HydrRadSys(RadSysNum)%Name, &
'Design Size Maximum Hot Water Flow [m3/s]', WaterVolFlowMaxHeatDes, &
'User-Specified Maximum Hot Water Flow [m3/s]', WaterVolFlowMaxHeatUser)
IF (DisplayExtraWarnings) THEN
IF ((ABS(WaterVolFlowMaxHeatDes - WaterVolFlowMaxHeatUser)/WaterVolFlowMaxHeatUser) > AutoVsHardSizingThreshold) THEN
CALL ShowMessage('SizeLowTempRadiantSystem: Potential issue with equipment sizing for ' &
// 'ZoneHVAC:LowTemperatureRadiant:Electric = " '// &
TRIM(HydrRadSys(RadSysNum)%Name)//'".')
CALL ShowContinueError('User-Specified Maximum Hot Water Flow of '// &
TRIM(RoundSigDigits(WaterVolFlowMaxHeatUser,5))// ' [m3/s]')
CALL ShowContinueError('differs from Design Size Maximum Hot Water Flow of ' // &
TRIM(RoundSigDigits(WaterVolFlowMaxHeatDes,5))// ' [m3/s]')
CALL ShowContinueError('This may, or may not, indicate mismatched component sizes.')
CALL ShowContinueError('Verify that the value entered is intended and is consistent with other components.')
END IF
ENDIF
END IF
END IF
END IF
END IF
IsAutosize = .FALSE.
IF (HydrRadSys(RadSysNum)%WaterVolFlowMaxCool == AutoSize) THEN
IsAutosize = .TRUE.
END IF
IF (CurZoneEqNum > 0) THEN
IF (.NOT. IsAutosize .AND. .NOT. ZoneSizingRunDone) THEN ! simulation continue
IF (HydrRadSys(RadSysNum)%WaterVolFlowMaxHeat > 0.0d0) THEN
CALL ReportSizingOutput('ZoneHVAC:LowTemperatureRadiant:VariableFlow', HydrRadSys(RadSysNum)%Name, &
'User-Specified Maximum Cold Water Flow [m3/s]', HydrRadSys(RadSysNum)%WaterVolFlowMaxHeat)
END IF
ELSE ! Autosize or hard-size with sizing run
CALL CheckZoneSizing('ZoneHVAC:LowTemperatureRadiant:VariableFlow', HydrRadSys(RadSysNum)%Name)
IF (IsAutosize) THEN
PltSizCoolNum = MyPlantSizingIndex('ZoneHVAC:LowTemperatureRadiant:VariableFlow',HydrRadSys(RadSysNum)%Name,&
HydrRadSys(RadSysNum)%ColdWaterInNode,HydrRadSys(RadSysNum)%ColdWaterOutNode,ErrorsFound)
IF (PltSizCoolNum > 0) THEN
IF ((CalcFinalZoneSizing(CurZoneEqNum)%DesCoolLoad * &
CalcFinalZoneSizing(CurZoneEqNum)%CoolSizingFactor) >= SmallLoad) THEN
rho = GetDensityGlycol(PlantLoop(HydrRadSys(RadSysNum)%CWLoopNum)%FluidName, &
5.d0, &
PlantLoop(HydrRadSys(RadSysNum)%CWLoopNum)%FluidIndex, &
'SizeLowTempRadiantSystem')
Cp = GetSpecificHeatGlycol(PlantLoop(HydrRadSys(RadSysNum)%CWLoopNum)%FluidName, &
5.d0, &
PlantLoop(HydrRadSys(RadSysNum)%CWLoopNum)%FluidIndex, &
'SizeLowTempRadiantSystem')
WaterVolFlowMaxCoolDes = &
(CalcFinalZoneSizing(CurZoneEqNum)%DesCoolLoad * CalcFinalZoneSizing(CurZoneEqNum)%CoolSizingFactor) / &
( PlantSizData(PltSizCoolNum)%DeltaT * &
Cp * rho )
ELSE
WaterVolFlowMaxCoolDes = 0.0d0
END IF
ELSE
CALL ShowSevereError('Autosizing of water flow requires a cooling loop Sizing:Plant object')
CALL ShowContinueError('Occurs in ' // 'ZoneHVAC:LowTemperatureRadiant:VariableFlow' // ' Object=' &
//TRIM(HydrRadSys(RadSysNum)%Name))
ErrorsFound = .TRUE.
END IF
END IF
IF (IsAutosize) THEN
HydrRadSys(RadSysNum)%WaterVolFlowMaxCool = WaterVolFlowMaxCoolDes
CALL ReportSizingOutput('ZoneHVAC:LowTemperatureRadiant:VariableFlow', HydrRadSys(RadSysNum)%Name, &
'Design Size Maximum Cold Water Flow [m3/s]', WaterVolFlowMaxCoolDes)
ELSE ! hard-size with sizing data
IF (HydrRadSys(RadSysNum)%WaterVolFlowMaxCool > 0.0d0 .AND. WaterVolFlowMaxCoolDes > 0.0d0) THEN
WaterVolFlowMaxCoolUser = HydrRadSys(RadSysNum)%WaterVolFlowMaxCool
CALL ReportSizingOutput('ZoneHVAC:LowTemperatureRadiant:VariableFlow', HydrRadSys(RadSysNum)%Name, &
'Design Size Maximum Cold Water Flow [m3/s]', WaterVolFlowMaxCoolDes, &
'User-Specified Maximum Cold Water Flow [m3/s]', WaterVolFlowMaxCoolUser)
IF (DisplayExtraWarnings) THEN
IF ((ABS(WaterVolFlowMaxCoolDes - WaterVolFlowMaxCoolUser)/WaterVolFlowMaxCoolUser) > AutoVsHardSizingThreshold) THEN
CALL ShowMessage('SizeLowTempRadiantSystem: Potential issue with equipment sizing for ' &
//'ZoneHVAC:LowTemperatureRadiant:Electric = " '// &
TRIM(HydrRadSys(RadSysNum)%Name)//'".')
CALL ShowContinueError('User-Specified Maximum Cool Water Flow of '// &
TRIM(RoundSigDigits(WaterVolFlowMaxCoolUser,5))// ' [m3/s]')
CALL ShowContinueError('differs from Design Size Maximum Cool Water Flow of ' // &
TRIM(RoundSigDigits(WaterVolFlowMaxCoolDes,5))// ' [m3/s]')
CALL ShowContinueError('This may, or may not, indicate mismatched component sizes.')
CALL ShowContinueError('Verify that the value entered is intended and is consistent with other components.')
END IF
ENDIF
END IF
END IF
END IF
END IF
IsAutosize = .FALSE.
IF (HydrRadSys(RadSysNum)%TubeLength == AutoSize) THEN
IsAutosize = .TRUE.
END IF
IF (CurZoneEqNum > 0) THEN
IF (.NOT. IsAutosize .AND. .NOT. ZoneSizingRunDone) THEN ! simulation continue
IF (HydrRadSys(RadSysNum)%TubeLength > 0.0d0) THEN
CALL ReportSizingOutput('ZoneHVAC:LowTemperatureRadiant:VariableFlow', HydrRadSys(RadSysNum)%Name, &
'User-Specified Hydronic Tubing Length [m]', HydrRadSys(RadSysNum)%TubeLength)
END IF
ELSE ! Autosize or hard-size with sizing run
! assume tube spacing of 15 cm
CALL CheckZoneSizing('ZoneHVAC:LowTemperatureRadiant:VariableFlow', HydrRadSys(RadSysNum)%Name)
TubeLengthDes = HydrRadSys(RadSysNum)%TotalSurfaceArea / 0.15
IF (IsAutosize) THEN
HydrRadSys(RadSysNum)%TubeLength = TubeLengthDes
CALL ReportSizingOutput('ZoneHVAC:LowTemperatureRadiant:VariableFlow', HydrRadSys(RadSysNum)%Name, &
'Design Size Hydronic Tubing Length [m]', TubeLengthDes)
ELSE ! hard-size with sizing data
IF (HydrRadSys(RadSysNum)%TubeLength > 0.0d0 .AND. TubeLengthDes > 0.0d0) THEN
TubeLengthUser = HydrRadSys(RadSysNum)%TubeLength
CALL ReportSizingOutput('ZoneHVAC:LowTemperatureRadiant:VariableFlow', HydrRadSys(RadSysNum)%Name, &
'Design Size Hydronic Tubing Length [m]', TubeLengthDes, &
'User-Specified Hydronic Tubing Length [m]', TubeLengthUser)
IF (DisplayExtraWarnings) THEN
IF ((ABS(TubeLengthDes - TubeLengthUser)/TubeLengthUser) > AutoVsHardSizingThreshold) THEN
CALL ShowMessage('SizeLowTempRadiantSystem: Potential issue with equipment sizing for ' &
// 'ZoneHVAC:LowTemperatureRadiant:Electric = " '// &
TRIM(HydrRadSys(RadSysNum)%Name)//'".')
CALL ShowContinueError('User-Specified Hydronic Tubing Length of '// &
TRIM(RoundSigDigits(TubeLengthUser,5))// ' [m]')
CALL ShowContinueError('differs from Design Size Hydronic Tubing Length of ' // &
TRIM(RoundSigDigits(TubeLengthDes,5))// ' [m]')
CALL ShowContinueError('This may, or may not, indicate mismatched component sizes.')
CALL ShowContinueError('Verify that the value entered is intended and is consistent with other components.')
END IF
ENDIF
END IF
END IF
END IF
END IF
DO SurfNum = 1, HydrRadSys(RadSysNum)%NumOfSurfaces
IF (HydrRadSys(RadSysNum)%NumCircCalcMethod == CalculateFromLength) THEN
HydrRadSys(RadSysNum)%NumCircuits(SurfNum) = (HydrRadSys(RadSysNum)%SurfaceFlowFrac(SurfNum) * &
HydrRadSys(RadSysNum)%TubeLength) / HydrRadSys(RadSysNum)%CircLength
HydrRadSys(RadSysNum)%NumCircuits(SurfNum) = MAX(HydrRadSys(RadSysNum)%NumCircuits(SurfNum),1.0d0)
ELSE
HydrRadSys(RadSysNum)%NumCircuits(SurfNum) = 1.0d0
END IF
END DO
CALL RegisterPlantCompDesignFlow(HydrRadSys(RadSysNum)%HotWaterInNode,HydrRadSys(RadSysNum)%WaterVolFlowMaxHeat)
CALL RegisterPlantCompDesignFlow(HydrRadSys(RadSysNum)%ColdWaterInNode,HydrRadSys(RadSysNum)%WaterVolFlowMaxCool)
END IF
IF (SystemType==ConstantFlowSystem) THEN
DO SurfNum = 1, CFloRadSys(RadSysNum)%NumOfSurfaces
IF (CFloRadSys(RadSysNum)%NumCircCalcMethod == CalculateFromLength) THEN
CFloRadSys(RadSysNum)%NumCircuits(SurfNum) = (CFloRadSys(RadSysNum)%SurfaceFlowFrac(SurfNum) * &
CFloRadSys(RadSysNum)%TubeLength) / CFloRadSys(RadSysNum)%CircLength
CFloRadSys(RadSysNum)%NumCircuits(SurfNum) = MAX(CFloRadSys(RadSysNum)%NumCircuits(SurfNum),1.0d0)
ELSE
CFloRadSys(RadSysNum)%NumCircuits(SurfNum) = 1.0d0
END IF
END DO
IF (CFloRadSys(RadSysNum)%HotWaterInNode > 0) THEN
CALL RegisterPlantCompDesignFlow(CFloRadSys(RadSysNum)%HotWaterInNode,CFloRadSys(RadSysNum)%WaterVolFlowMax)
END IF
IF (CFloRadSys(RadSysNum)%ColdWaterInNode > 0) THEN
CALL RegisterPlantCompDesignFlow(CFloRadSys(RadSysNum)%ColdWaterInNode,CFloRadSys(RadSysNum)%WaterVolFlowMax)
END IF
END IF
IF (ErrorsFound) THEN
CALL ShowFatalError('Preceding sizing errors cause program termination')
END IF
RETURN
END SUBROUTINE SizeLowTempRadiantSystem