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) | :: | BaseboardNum |
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 SizeBaseboard(BaseboardNum)
! 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 hot water baseboard components for which flow rates and UAs have not been
! specified in the input.
! METHODOLOGY EMPLOYED:
! Obtains flow rates from the zone sizing arrays and plant sizing data. UAs are
! calculated by numerically inverting the baseboard calculation routine.
! REFERENCES:
! na
! USE STATEMENTS:
USE DataSizing
USE General, ONLY: SolveRegulaFalsi, RoundSigDigits
USE PlantUtilities, ONLY: RegisterPlantCompDesignFlow
USE ReportSizingManager, ONLY: ReportSizingOutput
USE DataLoopNode, ONLY: Node
IMPLICIT NONE ! Enforce explicit typing of all variables in this routine
! SUBROUTINE ARGUMENT DEFINITIONS:
Integer, Intent(IN) :: BaseboardNum
! SUBROUTINE PARAMETER DEFINITIONS:
REAL(r64), PARAMETER :: Acc = 0.0001d0 ! Accuracy of result
INTEGER, PARAMETER :: MaxIte = 500 ! Maximum number of iterations
! INTERFACE BLOCK SPECIFICATIONS
! na
! DERIVED TYPE DEFINITIONS
! na
! SUBROUTINE LOCAL VARIABLE DECLARATIONS:
INTEGER :: WaterInletNode
INTEGER :: PltSizNum ! do loop index for plant sizing
INTEGER :: PltSizHeatNum ! index of plant sizing object for 1st heating loop
REAL(r64) :: DesCoilLoad
INTEGER :: SolFla ! Flag of solver
REAL(r64) :: UA0 ! lower bound for UA
REAL(r64) :: UA1 ! upper bound for UA
REAL(r64) :: UA
REAL(r64), DIMENSION(2) :: Par
LOGICAL :: ErrorsFound ! If errors detected in input
REAL(r64) :: rho ! local fluid density
REAL(r64) :: Cp ! local fluid specific heat
REAL(r64) :: tmpWaterVolFlowRateMax ! local design plant fluid flow rate
LOGICAL :: FlowAutosize ! Indicator to autosizing water volume flow
LOGICAL :: UAAutosize ! Indicator to autosizing UA
REAL(r64) :: WaterVolFlowRateMaxDes ! Design water volume flow for reproting
REAL(r64) :: WaterVolFlowRateMaxUser ! User hard-sized volume flow for reporting
REAL(r64) :: UADes ! Design UA value for reproting
REAL(r64) :: UAUser ! User hard-sized value for reporting
PltSizHeatNum = 0
PltSizNum = 0
DesCoilLoad = 0.0d0
ErrorsFound = .FALSE.
FlowAutosize = .FALSE.
UAAutosize = .FALSE.
WaterVolFlowRateMaxDes = 0.0d0
WaterVolFlowRateMaxUser = 0.0d0
UADes = 0.0d0
UAUser = 0.0d0
! find the appropriate heating Plant Sizing object
PltSizHeatNum = PlantLoop(Baseboard(BaseboardNum)%LoopNum)%PlantSizNum
IF (PltSizHeatNum > 0) THEN
IF (CurZoneEqNum > 0) THEN
IF (Baseboard(BaseboardNum)%WaterVolFlowRateMax == AutoSize) THEN
FlowAutosize = .TRUE.
END IF
IF (.NOT. FlowAutosize .AND. .NOT. ZoneSizingRunDone) THEN ! Simulation should continue
IF (Baseboard(BaseboardNum)%WaterVolFlowRateMax > 0.0d0) THEN
CALL ReportSizingOutput(cCMO_BBRadiator_Water,Baseboard(BaseboardNum)%EquipID,&
'User-Specified Maximum Water Flow Rate [m3/s]',Baseboard(BaseboardNum)%WaterVolFlowRateMax)
END IF
ELSE
CALL CheckZoneSizing(cCMO_BBRadiator_Water,Baseboard(BaseboardNum)%EquipID)
DesCoilLoad = CalcFinalZoneSizing(CurZoneEqNum)%DesHeatLoad * CalcFinalZoneSizing(CurZoneEqNum)%HeatSizingFactor
IF (DesCoilLoad >= SmallLoad) THEN
Cp = GetSpecificHeatGlycol(PlantLoop(Baseboard(BaseboardNum)%LoopNum)%FluidName, &
60.0d0, &
PlantLoop(Baseboard(BaseboardNum)%LoopNum)%FluidIndex, &
cCMO_BBRadiator_Water//':SizeBaseboard')
rho = GetDensityGlycol(PlantLoop(Baseboard(BaseboardNum)%LoopNum)%FluidName, &
InitConvTemp, &
PlantLoop(Baseboard(BaseboardNum)%LoopNum)%FluidIndex,&
cCMO_BBRadiator_Water//':SizeBaseboard')
WaterVolFlowRateMaxDes = DesCoilLoad / ( PlantSizData(PltSizHeatNum)%DeltaT * Cp * rho )
ELSE
WaterVolFlowRateMaxDes = 0.0d0
END IF
IF (FlowAutosize) THEN
Baseboard(BaseboardNum)%WaterVolFlowRateMax = WaterVolFlowRateMaxDes
CALL ReportSizingOutput(cCMO_BBRadiator_Water,Baseboard(BaseboardNum)%EquipID,&
'Design Size Maximum Water Flow Rate [m3/s]',WaterVolFlowRateMaxDes)
ELSE ! hard-sized with sizing data
IF (Baseboard(BaseboardNum)%WaterVolFlowRateMax > 0.0d0 .AND. WaterVolFlowRateMaxDes > 0.0d0) THEN
WaterVolFlowRateMaxUser = Baseboard(BaseboardNum)%WaterVolFlowRateMax
CALL ReportSizingOutput(cCMO_BBRadiator_Water,Baseboard(BaseboardNum)%EquipID,&
'Design Size Maximum Water Flow Rate [m3/s]',WaterVolFlowRateMaxDes, &
'User-Specified Maximum Water Flow Rate [m3/s]',WaterVolFlowRateMaxUser)
! Report a warning to note difference between the two
IF (DisplayExtraWarnings) THEN
IF ((ABS(WaterVolFlowRateMaxDes - WaterVolFlowRateMaxUser)/WaterVolFlowRateMaxUser) > AutoVsHardSizingThreshold) THEN
CALL ShowMessage('SizeBaseboard: Potential issue with equipment sizing for ZoneHVAC:Baseboard:Convective:Water="' &
// TRIM(Baseboard(BaseboardNum)%EquipID)//'".')
CALL ShowContinueError('User-Specified Maximum Water Flow Rate of '// &
TRIM(RoundSigDigits(WaterVolFlowRateMaxUser,5))// ' [m3/s]')
CALL ShowContinueError('differs from Design Size Maximum Water Flow Rate of ' // &
TRIM(RoundSigDigits(WaterVolFlowRateMaxDes,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
! UA sizing
! Set hard-sized values to the local variable to correct a false indication aftet SolFla function calculation
IF (Baseboard(BaseboardNum)%UA == Autosize) THEN
UAAutosize = .TRUE.
ELSE
UAUser = Baseboard(BaseboardNum)%UA
END IF
IF (.NOT. UAAutosize .AND. .NOT. ZoneSizingRunDone) THEN ! Simulation should continue
IF (Baseboard(BaseboardNum)%UA >0.0d0) THEN
CALL ReportSizingOutput(cCMO_BBRadiator_Water,Baseboard(BaseboardNum)%EquipID, &
'User-Specified U-Factor Times Area Value [W/K]',Baseboard(BaseboardNum)%UA)
END IF
ELSE
!CALL CheckZoneSizing(cCMO_BBRadiator_Water,Baseboard(BaseboardNum)%EquipID)
Baseboard(BaseboardNum)%WaterInletTemp = PlantSizData(PltSizHeatNum)%ExitTemp
Baseboard(BaseboardNum)%AirInletTemp = FinalZoneSizing(CurZoneEqNum)%ZoneTempAtHeatPeak
Baseboard(BaseboardNum)%AirInletHumRat = FinalZoneSizing(CurZoneEqNum)%ZoneHumRatAtHeatPeak
WaterInletNode = Baseboard(BaseboardNum)%WaterInletNode
rho = GetDensityGlycol(PlantLoop(Baseboard(BaseboardNum)%LoopNum)%FluidName, &
InitConvTemp, &
PlantLoop(Baseboard(BaseboardNum)%LoopNum)%FluidIndex,&
cCMO_BBRadiator_Water//':SizeBaseboard')
Node(WaterInletNode)%MassFlowRate = rho * Baseboard(BaseboardNum)%WaterVolFlowRateMax
DesCoilLoad = CalcFinalZoneSizing(CurZoneEqNum)%DesHeatLoad * CalcFinalZoneSizing(CurZoneEqNum)%HeatSizingFactor
IF (DesCoilLoad >= SmallLoad) THEN
! pick an air mass flow rate that is twice the water mass flow rate (CR8842)
Baseboard(BaseboardNum)%DesAirMassFlowRate = 2.0d0 * rho * Baseboard(BaseboardNum)%WaterVolFlowRateMax
! pass along the coil number and the design load to the residual calculation
Par(1) = DesCoilLoad
Par(2) = BaseboardNum
! set the lower and upper limits on the UA
UA0 = .001d0 * DesCoilLoad
UA1 = DesCoilLoad
! Invert the baseboard model: given the design inlet conditions and the design load,
! find the design UA.
CALL SolveRegulaFalsi(Acc, MaxIte, SolFla, UA, HWBaseboardUAResidual, UA0, UA1, Par)
! if the numerical inversion failed, issue error messages.
IF (SolFla == -1) THEN
CALL ShowSevereError('SizeBaseboard: Autosizing of HW baseboard UA failed for '// &
cCMO_BBRadiator_Water//'="'// &
TRIM(Baseboard(BaseboardNum)%EquipID)//'"')
CALL ShowContinueError('Iteration limit exceeded in calculating coil UA')
IF (UAAutosize) THEN
ErrorsFound = .TRUE.
ELSE
CALL ShowContinueError('Could not calculate design value for comparison to user value, and the simulation continues')
UA = 0.0d0
ENDIF
ELSE IF (SolFla == -2) THEN
CALL ShowSevereError('SizeBaseboard: Autosizing of HW baseboard UA failed for '// &
cCMO_BBRadiator_Water//'="'// &
TRIM(Baseboard(BaseboardNum)%EquipID)//'"')
CALL ShowContinueError('Bad starting values for UA')
IF (UAAutosize) THEN
ErrorsFound = .TRUE.
ELSE
CALL ShowContinueError('Could not calculate design value for comparison to user value, and the simulation continues')
UA = 0.0d0
ENDIF
END IF
UADes = UA !Baseboard(BaseboardNum)%UA = UA
ELSE
UADes = 0.0d0
END IF
IF (UAAutosize) THEN
Baseboard(BaseboardNum)%UA = UADes
CALL ReportSizingOutput(cCMO_BBRadiator_Water,Baseboard(BaseboardNum)%EquipID, &
'Design Size U-Factor Times Area Value [W/K]',UADes)
ELSE ! Hard-sized with sizing data
Baseboard(BaseboardNum)%UA = UAUser ! need to put this back as HWBaseboardUAResidual will have reset it, CR9377
IF (UAUser > 0.0d0 .AND. UADes > 0.0d0) THEN
CALL ReportSizingOutput(cCMO_BBRadiator_Water,Baseboard(BaseboardNum)%EquipID, &
'Design Size U-Factor Times Area Value [W/K]',UADes, &
'User-Specified U-Factor Times Area Value [W/K]',UAUser)
! Report difference between design size and hard-sized values
IF (DisplayExtraWarnings) THEN
IF ((ABS(UADes-UAUser)/UAUser) > AutoVsHardSizingThreshold) THEN
CALL ShowMessage('SizeBaseboard: Potential issue with equipment sizing for ZoneHVAC:Baseboard:Convective:Water="' &
// TRIM(Baseboard(BaseboardNum)%EquipID)//'".')
CALL ShowContinueError('User-Specified U-Factor Times Area Value of '// &
TRIM(RoundSigDigits(UAUser,2))// ' [W/K]')
CALL ShowContinueError('differs from Design Size U-Factor Times Area Value of ' // &
TRIM(RoundSigDigits(UADes,2))// ' [W/K]')
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
ELSE
! if there is no heating Sizing:Plant object and autosizng was requested, issue an error message
IF (FlowAutoSize .OR. UAAutoSize) THEN
CALL ShowSevereError('SizeBaseboard: '//cCMO_BBRadiator_Water//'="'// &
TRIM(Baseboard(BaseboardNum)%EquipID)//'"')
CALL ShowContinueError('...Autosizing of hot water baseboard requires a heating loop Sizing:Plant object')
ErrorsFound = .TRUE.
END IF
END IF
! save the design water flow rate for use by the water loop sizing algorithms
CALL RegisterPlantCompDesignFlow(Baseboard(BaseboardNum)%WaterInletNode,Baseboard(BaseboardNum)%WaterVolFlowRateMax)
IF (ErrorsFound) THEN
CALL ShowFatalError('SizeBaseboard: Preceding sizing errors cause program termination')
END IF
RETURN
END SUBROUTINE SizeBaseboard