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) | :: | 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.
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 SimHWConvective(BaseboardNum, LoadMet)
! SUBROUTINE INFORMATION:
! AUTHOR Russ Taylor
! DATE WRITTEN Nov 1997
! MODIFIED May 2000 Fred Buhl
! RE-ENGINEERED na
! PURPOSE OF THIS SUBROUTINE: This subroutine calculates the heat exchange rate
! in a pure convective baseboard heater. The heater is assumed to be crossflow
! with both fluids unmixed. The air flow is bouyancy driven and a constant air
! flow velocity of 0.5m/s is assumed. The solution is by the effectiveness-NTU
! method found in Icropera and DeWitt, Fundamentals of Heat and Mass Transfer,
! Chapter 11.4, p. 523, eq. 11.33
! METHODOLOGY EMPLOYED:
! na
! REFERENCES:
! Icropera and DeWitt, Fundamentals of Heat and Mass Transfer,
! Chapter 11.4, p. 523, eq. 11.33
! USE STATEMENTS:
USE DataLoopNode, ONLY: Node
USE DataSizing
USE DataZoneEnergyDemands, ONLY: ZoneSysEnergyDemand, CurDeadbandOrSetback
USE PlantUtilities, ONLY: SetActuatedBranchFlowRate
USE DataHVACGlobals, ONLY: SmallLoad
IMPLICIT NONE
! SUBROUTINE ARGUMENT DEFINITIONS:
INTEGER :: BaseboardNum
REAL(r64) :: LoadMet
! SUBROUTINE PARAMETER DEFINITIONS:
! na
! INTERFACE BLOCK SPECIFICATIONS
! na
! DERIVED TYPE DEFINITIONS
! na
! SUBROUTINE LOCAL VARIABLE DECLARATIONS:
INTEGER :: ZoneNum
REAL(r64) :: WaterInletTemp
REAL(r64) :: AirInletTemp
REAL(r64) :: CpAir
REAL(r64) :: CpWater
REAL(r64) :: AirMassFlowRate
REAL(r64) :: WaterMassFlowRate
REAL(r64) :: CapacitanceAir
REAL(r64) :: CapacitanceWater
REAL(r64) :: CapacitanceMax
REAL(r64) :: CapacitanceMin
REAL(r64) :: CapacityRatio
REAL(r64) :: NTU
REAL(r64) :: Effectiveness
REAL(r64) :: WaterOutletTemp
REAL(r64) :: AirOutletTemp
REAL(r64) :: AA
REAL(r64) :: BB
REAL(r64) :: CC
REAL(r64) :: QZnReq
ZoneNum = Baseboard(BaseboardNum)%ZonePtr
QZnReq = ZoneSysEnergyDemand(ZoneNum)%RemainingOutputReqToHeatSP
IF (MySizeFlag(BaseboardNum)) & ! If in sizing, assign design condition
QZnReq = CalcFinalZoneSizing(CurZoneEqNum)%DesHeatLoad * CalcFinalZoneSizing(CurZoneEqNum)%HeatSizingFactor
WaterInletTemp = Baseboard(BaseboardNum)%WaterInletTemp
WaterOutletTemp = WaterInletTemp
AirInletTemp = Baseboard(BaseboardNum)%AirInletTemp
AirOutletTemp = AirInletTemp
CpWater = GetSpecificHeatGlycol(PlantLoop(Baseboard(BaseboardNum)%LoopNum)%FluidName, &
WaterInletTemp, &
PlantLoop(Baseboard(BaseboardNum)%LoopNum)%FluidIndex, &
cCMO_BBRadiator_Water//':SimHWConvective')
CpAir = PsyCpAirFnWTdb(Baseboard(BaseboardNum)%AirInletHumRat,AirInletTemp)
IF (Baseboard(BaseboardNum)%DesAirMassFlowRate > 0.0d0) THEN ! If UA is autosized, assign design condition
AirMassFlowRate = Baseboard(BaseboardNum)%DesAirMassFlowRate
ELSE
AirMassFlowRate = Baseboard(BaseboardNum)%AirMassFlowRate
! pick a mass flow rate that depends on the max water mass flow rate. CR 8842 changed to factor of 2.0
IF (AirMassFlowRate <= 0.0d0) &
AirMassFlowRate = 2.0*Baseboard(BaseboardNum)%WaterMassFlowRateMax
END IF
WaterMassFlowRate = Node(Baseboard(BaseboardNum)%WaterInletNode)%MassFlowRate
CapacitanceAir = CpAir * AirMassFlowRate
IF (QZnReq > SmallLoad &
.AND. (.NOT. CurDeadbandOrSetback(ZoneNum) .OR. MySizeFlag(BaseboardNum)) &
.AND. (GetCurrentScheduleValue(Baseboard(BaseboardNum)%SchedPtr) > 0 .OR. MySizeFlag(BaseboardNum)) &
.AND. (WaterMassFlowRate > 0.0d0) ) THEN
CapacitanceWater = CpWater * WaterMassFlowRate
CapacitanceMax = MAX(CapacitanceAir,CapacitanceWater)
CapacitanceMin = MIN(CapacitanceAir,CapacitanceWater)
CapacityRatio = CapacitanceMin/CapacitanceMax
NTU = Baseboard(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.EXP_LowerLimit) THEN
BB = 0.0d0
ELSE
BB = EXP(AA)
END IF
CC = (1.0d0/CapacityRatio)*(NTU)**0.22d0*(BB-1.0d0)
IF (CC.LT.EXP_LowerLimit) THEN
Effectiveness = 1.0d0
ELSE
Effectiveness = 1.d0 - EXP(CC)
END IF
AirOutletTemp = AirInletTemp + Effectiveness*CapacitanceMin*(WaterInletTemp-AirInletTemp)/CapacitanceAir
WaterOutletTemp = WaterInletTemp - CapacitanceAir*(AirOutletTemp-AirInletTemp)/CapacitanceWater
LoadMet = CapacitanceWater*(WaterInletTemp-WaterOutletTemp)
Baseboard(BaseboardNum)%WaterOutletEnthalpy = Baseboard(BaseboardNum)%WaterInletEnthalpy - &
LoadMet/WaterMassFlowRate
ELSE
CapacitanceWater = 0.0d0
CapacitanceMax = CapacitanceAir
CapacitanceMin = 0.0d0
NTU = 0.0d0
Effectiveness = 0.0d0
AirOutletTemp = AirInletTemp
WaterOutletTemp = WaterInletTemp
LoadMet = 0.0d0
Baseboard(BaseboardNum)%WaterOutletEnthalpy = Baseboard(BaseboardNum)%WaterInletEnthalpy
WaterMassFlowRate = 0.0d0
CALL SetActuatedBranchFlowRate(WaterMassFlowRate,Baseboard(BaseboardNum)%WaterInletNode, &
Baseboard(BaseboardNum)%LoopNum,Baseboard(BaseboardNum)%LoopSideNum, &
Baseboard(BaseboardNum)%BranchNum, .FALSE. )
AirMassFlowRate = 0.0d0
END IF
Baseboard(BaseboardNum)%WaterOutletTemp = WaterOutletTemp
Baseboard(BaseboardNum)%AirOutletTemp = AirOutletTemp
Baseboard(BaseboardNum)%Power = LoadMet
Baseboard(BaseboardNum)%WaterMassFlowRate = WaterMassFlowRate
Baseboard(BaseboardNum)%AirMassFlowRate = AirMassFlowRate
RETURN
END SUBROUTINE SimHWConvective