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 | :: | BaseboardNum | ||||
real(kind=r64), | intent(out) | :: | LoadMet |
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 CalcHWBaseboard(BaseboardNum, LoadMet)
! SUBROUTINE INFORMATION:
! AUTHOR Russ Taylor
! DATE WRITTEN Nov 1997
! MODIFIED May 2000 Fred Buhl
! Aug 2007 Daeho Kang (Add the calculation of radiant heat source)
! Sep 2011 LKL/BG - resimulate only zones needing it for Radiant systems
! RE-ENGINEERED na
! PURPOSE OF THIS SUBROUTINE:
! This subroutine calculates both the convective and radiant heat transfer rate
! in a hot water baseboard heater. The heater is assumed to be crossflowwith
! both fluids unmixed. The air flow is bouyancy driven and a constant airflow
! and a constant airflow velocity of 0.5m/s is assumed.
! METHODOLOGY EMPLOYED:
! na
! REFERENCES:
! Incropera and DeWitt, Fundamentals of Heat and Mass Transfer
! Chapter 11.4, p. 523, eq. 11.33
! USE STATEMENTS:
USE DataSizing
USE DataLoopNode, ONLY: Node
USE ScheduleManager, ONLY: GetCurrentScheduleValue
USE DataZoneEnergyDemands, ONLY: ZoneSysEnergyDemand, CurDeadbandOrSetback
USE DataInterfaces, ONLY: CalcHeatBalanceOutsideSurf, CalcHeatBalanceInsideSurf
IMPLICIT NONE
! SUBROUTINE ARGUMENT DEFINITIONS:
INTEGER :: BaseboardNum
REAL(r64), INTENT(OUT) :: LoadMet
! SUBROUTINE PARAMETER DEFINITIONS:
REAL(r64), PARAMETER :: Constant = 0.0062d0 ! Constant of linear equation for air mass flow rate
REAL(r64), PARAMETER :: Coeff = 0.0000275d0 ! Correlation coefficient to capacity
REAL(r64), PARAMETER :: MinFrac = 0.0005d0 ! Minimum fraction that delivers radiant heats to surfaces
! INTERFACE BLOCK SPECIFICATIONS
! na
! DERIVED TYPE DEFINITIONS
! na
! SUBROUTINE LOCAL VARIABLE DECLARATIONS:
INTEGER :: ZoneNum
REAL(r64) :: RadHeat
REAL(r64) :: BBHeat
REAL(r64) :: AirInletTemp
REAL(r64) :: AirOutletTemp
REAL(r64) :: WaterInletTemp
REAL(r64) :: WaterOutletTemp
REAL(r64) :: WaterMassFlowRate
REAL(r64) :: AirMassFlowRate
REAL(r64) :: CapacitanceAir
REAL(r64) :: CapacitanceWater
REAL(r64) :: CapacitanceMax
REAL(r64) :: CapacitanceMin
REAL(r64) :: CapacityRatio
REAL(r64) :: NTU
REAL(r64) :: Effectiveness
REAL(r64) :: AA
REAL(r64) :: BB
REAL(r64) :: CC
REAL(r64) :: QZnReq
REAL(r64) :: Cp
ZoneNum = HWBaseboard(BaseboardNum)%ZonePtr
QZnReq = ZoneSysEnergyDemand(ZoneNum)%RemainingOutputReqToHeatSP
AirInletTemp = HWBaseboard(BaseboardNum)%AirInletTemp
AirOutletTemp = AirInletTemp
WaterInletTemp = HWBaseboard(BaseboardNum)%WaterInletTemp
WaterOutletTemp = WaterInletTemp
WaterMassFlowRate = Node(HWBaseboard(BaseboardNum)%WaterInletNode)%MassFlowRate
IF (QZnReq > SmallLoad &
.AND. .NOT. CurDeadbandOrSetback(ZoneNum) &
.AND. (GetCurrentScheduleValue(HWBaseboard(BaseboardNum)%SchedPtr) > 0) &
.AND. (WaterMassFlowRate > 0.0d0) ) THEN
! Assume the air mass flow rate is twice the water mass flow rate
! Calculate air mass flow rate
AirMassFlowRate = HWBaseboard(BaseboardNum)%AirMassFlowRateStd * &
(WaterMassFlowRate / HWBaseboard(BaseboardNum)%WaterMassFlowRateStd)
CapacitanceAir = PsyCpAirFnWTdb(HWBaseboard(BaseboardNum)%AirInletHumRat,AirInletTemp) * AirMassFlowRate
Cp = GetSpecificHeatGlycol(PlantLoop(HWBaseboard(BaseboardNum)%LoopNum)%FluidName, &
WaterInletTemp, &
PlantLoop(HWBaseboard(BaseboardNum)%LoopNum)%FluidIndex, &
'CalcHWBaseboard')
CapacitanceWater = Cp * WaterMassFlowRate
CapacitanceMax = MAX(CapacitanceAir,CapacitanceWater)
CapacitanceMin = MIN(CapacitanceAir,CapacitanceWater)
CapacityRatio = CapacitanceMin / CapacitanceMax
NTU = HWBaseboard(BaseboardNum)%UA / CapacitanceMin
! The effectiveness is given by the following formula:
! Effectiveness = 1. - EXP((1./CapacityRatio)*(NTU)**0.22*(EXP(-CapacityRatio*(NTU)**0.78)-1.))
! To prevent possible underflows (numbers smaller than the computer can handle) we must break
! the calculation up into steps and check the size of the exponential arguments.
AA = -CapacityRatio*(NTU)**0.78d0
IF (AA.LT.-20.0d0) THEN
BB = 0.0d0
ELSE
BB = EXP(AA)
END IF
CC = (1.d0/ CapacityRatio)*(NTU)**0.22d0 * (BB-1.d0)
IF (CC.LT.-20.d0) THEN
Effectiveness = 1.0d0
ELSE
Effectiveness = 1.0d0 - EXP(CC)
END IF
AirOutletTemp = AirInletTemp + Effectiveness * CapacitanceMin * (WaterInletTemp-AirInletTemp) / CapacitanceAir
WaterOutletTemp = WaterInletTemp - CapacitanceAir * (AirOutletTemp-AirInletTemp) / CapacitanceWater
BBHeat = CapacitanceWater * (WaterInletTemp - WaterOutletTemp)
RadHeat = BBHeat * HWBaseboard(BaseboardNum)%FracRadiant
QBBRadSource(BaseboardNum) = RadHeat
IF (HWBaseboard(BaseboardNum)%FracRadiant <= MinFrac) THEN
LoadMet = BBHeat
ELSE
! Now, distribute the radiant energy of all systems to the appropriate surfaces, to people, and the air
CALL DistributeBBRadGains
! Now "simulate" the system by recalculating the heat balances
CALL CalcHeatBalanceOutsideSurf(ZoneNum)
CALL CalcHeatBalanceInsideSurf(ZoneNum)
! Here an assumption is made regarding radiant heat transfer to people.
! While the radiant heat transfer to people array will be used by the thermal comfort
! routines, the energy transfer to people would get lost from the perspective
! of the heat balance. So, to avoid this net loss of energy which clearly
! gets added to the zones, we must account for it somehow. This assumption
! that all energy radiated to people is converted to convective energy is
! not very precise, but at least it conserves energy. The system impact to heat balance
! should include this.
LoadMet = (SumHATsurf(ZoneNum) - ZeroSourceSumHATsurf(ZoneNum)) &
+ (BBHeat * HWBaseboard(BaseboardNum)%FracConvect) &
+ (RadHeat * HWBaseboard(BaseboardNum)%FracDistribPerson)
END IF
HWBaseboard(BaseboardNum)%WaterOutletEnthalpy = HWBaseboard(BaseboardNum)%WaterInletEnthalpy - BBHeat &
/ WaterMassFlowRate
ELSE
CapacitanceWater = 0.0d0
CapacitanceMax = 0.0d0
CapacitanceMin = 0.0d0
NTU = 0.0d0
Effectiveness = 0.0d0
AirOutletTemp = AirInletTemp
WaterOutletTemp = WaterInletTemp
BBHeat = 0.0d0
LoadMet = 0.0d0
RadHeat = 0.0d0
WaterMassFlowRate = 0.0d0
AirMassFlowRate = 0.0d0
QBBRadSource(BaseboardNum) = 0.0d0
HWBaseboard(BaseboardNum)%WaterOutletEnthalpy = HWBaseboard(BaseboardNum)%WaterInletEnthalpy
END IF
HWBaseboard(BaseboardNum)%WaterOutletTemp = WaterOutletTemp
HWBaseboard(BaseboardNum)%AirOutletTemp = AirOutletTemp
HWBaseboard(BaseboardNum)%WaterMassFlowRate = WaterMassFlowRate
HWBaseboard(BaseboardNum)%AirMassFlowRate = AirMassFlowRate
HWBaseboard(BaseboardNum)%TotPower = LoadMet
HWBaseboard(BaseboardNum)%Power = BBHeat
HWBaseboard(BaseboardNum)%ConvPower = BBHeat - RadHeat
HWBaseboard(BaseboardNum)%RadPower = RadHeat
RETURN
END SUBROUTINE CalcHWBaseboard