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) | :: | CBNum |
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 SizeCoolBeam(CBNum)
! SUBROUTINE INFORMATION:
! AUTHOR Fred Buhl
! DATE WRITTEN February 10, 2009
! MODIFIED na
! RE-ENGINEERED na
! PURPOSE OF THIS SUBROUTINE:
! This subroutine is for sizing cooled beam units for which flow rates have not been
! specified in the input
! METHODOLOGY EMPLOYED:
! Accesses zone sizing array for air flow rates and zone and plant sizing arrays to
! calculate coil water flow rates.
! REFERENCES:
! na
! USE STATEMENTS:
USE DataSizing
USE InputProcessor
USE DataGlobals, ONLY: AutoCalculate
USE PlantUtilities, ONLY: RegisterPlantCompDesignFlow
USE ReportSizingManager, ONLY: ReportSizingOutput
! USE BranchInputManager, ONLY: MyPlantSizingIndex
USE FluidProperties, ONLY: GetDensityGlycol, GetSpecificHeatGlycol
USE DataPlant, ONLY: PlantLoop, MyPlantSizingIndex
IMPLICIT NONE ! Enforce explicit typing of all variables in this routine
! SUBROUTINE ARGUMENT DEFINITIONS:
INTEGER, INTENT(IN) :: CBNum
! SUBROUTINE PARAMETER DEFINITIONS:
! na
! INTERFACE BLOCK SPECIFICATIONS:
! na
! DERIVED TYPE DEFINITIONS:
! na
! SUBROUTINE LOCAL VARIABLE DECLARATIONS:
INTEGER :: PltSizCoolNum = 0 ! index of plant sizing object for the cooling loop
INTEGER :: NumBeams = 0 ! number of beams in the zone
INTEGER :: Iter=0 ! beam length iteration index
REAL(r64) :: DesCoilLoad = 0.0d0 ! total cooling capacity of the beams in the zone [W]
REAL(r64) :: DesLoadPerBeam = 0.0d0 ! cooling capacity per individual beam [W]
REAL(r64) :: DesAirVolFlow = 0.0d0 ! design total supply air flow rate [m3/s]
REAL(r64) :: DesAirFlowPerBeam = 0.0d0 ! design supply air volumetric flow per beam [m3/s]
REAL(r64) :: RhoAir = 0.0d0
REAL(r64) :: CpAir = 0.0d0
REAL(r64) :: WaterVel = 0.0d0 ! design water velocity in beam
REAL(r64) :: IndAirFlowPerBeamL = 0.0d0 ! induced volumetric air flow rate per beam length [m3/s-m]
REAL(r64) :: DT = 0.0d0 ! air - water delta T [C]
REAL(r64) :: LengthX = 0.0d0 ! test value for beam length [m]
REAL(r64) :: Length = 0.0d0 ! beam length [m]
REAL(r64) :: ConvFlow = 0.0d0 ! convective and induced air mass flow rate across beam per beam plan area [kg/s-m2]
REAL(r64) :: K = 0.0d0 ! coil (beam) heat transfer coefficient [W/m2-K]
REAL(r64) :: WaterVolFlowPerBeam = 0.0d0 ! Cooling water volumetric flow per beam [m3]
LOGICAL :: ErrorsFound
REAL(r64) :: rho ! local fluid density
REAL(r64) :: Cp ! local fluid specific heat
PltSizCoolNum = 0
DesAirVolFlow = 0.0d0
CpAir = 0.0d0
RhoAir = StdRhoAir
ErrorsFound = .FALSE.
! find the appropriate Plant Sizing object
IF (CoolBeam(CBNum)%MaxAirVolFlow == AutoSize .or. CoolBeam(CBNum)%BeamLength == AutoSize) THEN
PltSizCoolNum = MyPlantSizingIndex("cooled beam unit", CoolBeam(CBNum)%Name, CoolBeam(CBNum)%CWInNode, &
CoolBeam(CBNum)%CWOutNode, ErrorsFound)
ENDIF
IF (CoolBeam(CBNum)%Kin == AutoCalculate) THEN
IF (CoolBeam(CBNum)%CBType_Num == Passive_Cooled_Beam) THEN
CoolBeam(CBNum)%Kin = 0.0d0
ELSE
CoolBeam(CBNum)%Kin = 2.0d0
END IF
CALL ReportSizingOutput(CoolBeam(CBNum)%UnitType, CoolBeam(CBNum)%Name, &
'Coefficient of Induction Kin', CoolBeam(CBNum)%Kin)
END IF
IF (CoolBeam(CBNum)%MaxAirVolFlow == AutoSize) THEN
IF (CurZoneEqNum > 0) THEN
CALL CheckZoneSizing(CoolBeam(CBNum)%UnitType, CoolBeam(CBNum)%Name)
CoolBeam(CBNum)%MaxAirVolFlow = MAX(TermUnitFinalZoneSizing(CurZoneEqNum)%DesCoolVolFlow, &
TermUnitFinalZoneSizing(CurZoneEqNum)%DesHeatVolFlow)
IF (CoolBeam(CBNum)%MaxAirVolFlow < SmallAirVolFlow) THEN
CoolBeam(CBNum)%MaxAirVolFlow = 0.0d0
END IF
CALL ReportSizingOutput(CoolBeam(CBNum)%UnitType, CoolBeam(CBNum)%Name, &
'Supply Air Flow Rate [m3/s]', CoolBeam(CBNum)%MaxAirVolFlow)
END IF
END IF
IF (CoolBeam(CBNum)%MaxCoolWaterVolFlow == AutoSize) THEN
IF (CurZoneEqNum > 0) THEN
CALL CheckZoneSizing(CoolBeam(CBNum)%UnitType, CoolBeam(CBNum)%Name)
IF (PltSizCoolNum > 0) THEN
IF (FinalZoneSizing(CurZoneEqNum)%DesCoolMassFlow >= SmallAirVolFlow) THEN
DesAirVolFlow = CoolBeam(CBNum)%MaxAirVolFlow
CpAir = PsyCpAirFnWTdb(FinalZoneSizing(CurZoneEqNum)%CoolDesHumRat,FinalZoneSizing(CurZoneEqNum)%CoolDesTemp)
! the design cooling coil load is the zone load minus whatever the central system does. Note that
! DesCoolCoilInTempTU is really the primary air inlet temperature for the unit.
IF (FinalZoneSizing(CurZoneEqNum)%ZoneTempAtCoolPeak > 0.0d0) THEN
DesCoilLoad = FinalZoneSizing(CurZoneEqNum)%DesCoolLoad - CpAir*RhoAir*DesAirVolFlow* &
(FinalZoneSizing(CurZoneEqNum)%ZoneTempAtCoolPeak - FinalZoneSizing(CurZoneEqNum)%DesCoolCoilInTempTU)
ELSE
DesCoilLoad = CpAir*RhoAir*DesAirVolFlow*(FinalZoneSizing(CurZoneEqNum)%DesCoolCoilInTempTU &
- ZoneSizThermSetPtHi(CurZoneEqNum))
END IF
rho = GetDensityGlycol(PlantLoop(CoolBeam(CBNum)%CWLoopNum)%FluidName,&
InitConvTemp, &
PlantLoop(CoolBeam(CBNum)%CWLoopNum)%FluidIndex,&
'SizeCoolBeam')
Cp = GetSpecificHeatGlycol( PlantLoop(CoolBeam(CBNum)%CWLoopNum)%FluidName,&
InitConvTemp, &
PlantLoop(CoolBeam(CBNum)%CWLoopNum)%FluidIndex,&
'SizeCoolBeam')
CoolBeam(CBNum)%MaxCoolWaterVolFlow = DesCoilLoad / &
( (CoolBeam(CBNum)%DesOutletWaterTemp - CoolBeam(CBNum)%DesInletWaterTemp) * &
Cp * rho )
CoolBeam(CBNum)%MaxCoolWaterVolFlow = MAX(CoolBeam(CBNum)%MaxCoolWaterVolFlow,0.0d0)
IF (CoolBeam(CBNum)%MaxCoolWaterVolFlow < SmallWaterVolFlow) THEN
CoolBeam(CBNum)%MaxCoolWaterVolFlow = 0.0d0
END IF
ELSE
CoolBeam(CBNum)%MaxCoolWaterVolFlow = 0.0d0
END IF
CALL ReportSizingOutput(CoolBeam(CBNum)%UnitType, CoolBeam(CBNum)%Name, &
'Maximum Total Chilled Water Flow Rate [m3/s]', CoolBeam(CBNum)%MaxCoolWaterVolFlow)
ELSE
CALL ShowSevereError('Autosizing of water flow requires a cooling loop Sizing:Plant object')
CALL ShowContinueError('Occurs in' // TRIM(CoolBeam(CBNum)%UnitType) // ' Object='//TRIM(CoolBeam(CBNum)%Name))
ErrorsFound = .TRUE.
END IF
END IF
END IF
IF (CoolBeam(CBNum)%NumBeams == AutoSize) THEN
rho = GetDensityGlycol(PlantLoop(CoolBeam(CBNum)%CWLoopNum)%FluidName,&
InitConvTemp, &
PlantLoop(CoolBeam(CBNum)%CWLoopNum)%FluidIndex,&
'SizeCoolBeam')
NumBeams = INT( CoolBeam(CBNum)%MaxCoolWaterVolFlow * rho / NomMassFlowPerBeam ) + 1
CoolBeam(CBNum)%NumBeams = REAL(NumBeams,r64)
CALL ReportSizingOutput(CoolBeam(CBNum)%UnitType, CoolBeam(CBNum)%Name, &
'Number of Beams', CoolBeam(CBNum)%NumBeams)
END IF
IF (CoolBeam(CBNum)%BeamLength == AutoSize) THEN
IF (CurZoneEqNum > 0) THEN
CALL CheckZoneSizing(CoolBeam(CBNum)%UnitType, CoolBeam(CBNum)%Name)
IF (PltSizCoolNum > 0) THEN
rho = GetDensityGlycol(PlantLoop(CoolBeam(CBNum)%CWLoopNum)%FluidName,&
InitConvTemp, &
PlantLoop(CoolBeam(CBNum)%CWLoopNum)%FluidIndex,&
'SizeCoolBeam')
Cp = GetSpecificHeatGlycol( PlantLoop(CoolBeam(CBNum)%CWLoopNum)%FluidName,&
InitConvTemp, &
PlantLoop(CoolBeam(CBNum)%CWLoopNum)%FluidIndex,&
'SizeCoolBeam')
DesCoilLoad = CoolBeam(CBNum)%MaxCoolWaterVolFlow * &
(CoolBeam(CBNum)%DesOutletWaterTemp - CoolBeam(CBNum)%DesInletWaterTemp) &
* Cp * rho
IF (DesCoilLoad > 0.0d0) THEN
DesLoadPerBeam = DesCoilLoad / NumBeams
DesAirFlowPerBeam = CoolBeam(CBNum)%MaxAirVolFlow / NumBeams
WaterVolFlowPerBeam = CoolBeam(CBNum)%MaxCoolWaterVolFlow / NumBeams
WaterVel = WaterVolFlowPerBeam / (Pi * (CoolBeam(CBNum)%InDiam)**2 / 4.0d0)
IF (FinalZoneSizing(CurZoneEqNum)%ZoneTempAtCoolPeak > 0.0d0) THEN
DT = FinalZoneSizing(CurZoneEqNum)%ZoneTempAtCoolPeak - 0.5d0* &
(CoolBeam(CBNum)%DesInletWaterTemp + CoolBeam(CBNum)%DesOutletWaterTemp)
IF (DT <= 0.0d0) THEN
DT = 7.8d0
END IF
ELSE
DT = 7.8d0
END IF
LengthX = 1.0d0
DO Iter=1,100
IndAirFlowPerBeamL = CoolBeam(CBNum)%K1 * DT**CoolBeam(CBNum)%n + CoolBeam(CBNum)%Kin * DesAirFlowPerBeam / LengthX
ConvFlow = (IndAirFlowPerBeamL /CoolBeam(CBNum)%a0)*RhoAir
IF (WaterVel > MinWaterVel) THEN
K = CoolBeam(CBNum)%a * DT**CoolBeam(CBNum)%n1 * ConvFlow**CoolBeam(CBNum)%n2 * WaterVel**CoolBeam(CBNum)%n3
ELSE
K = CoolBeam(CBNum)%a * DT**CoolBeam(CBNum)%n1 * ConvFlow**CoolBeam(CBNum)%n2 * MinWaterVel**CoolBeam(CBNum)%n3 &
* (WaterVel/MinWaterVel)
END IF
Length = DesLoadPerBeam / (K * CoolBeam(CBNum)%CoilArea * DT)
IF (CoolBeam(CBNum)%Kin <= 0.0d0) EXIT
! Check for convergence
IF (ABS(Length - LengthX) > 0.01d0) THEN
! New guess for length
LengthX = LengthX + 0.5d0*(Length - LengthX)
ELSE
EXIT ! convergence achieved
END IF
END DO
ELSE
Length = 0.0d0
END IF
CoolBeam(CBNum)%BeamLength = Length
CoolBeam(CBNum)%BeamLength = MAX(CoolBeam(CBNum)%BeamLength,1.0d0)
CALL ReportSizingOutput(CoolBeam(CBNum)%UnitType, CoolBeam(CBNum)%Name, &
'Beam Length [m]', CoolBeam(CBNum)%BeamLength)
ELSE
CALL ShowSevereError('Autosizing of cooled beam length requires a cooling loop Sizing:Plant object')
CALL ShowContinueError('Occurs in' // TRIM(CoolBeam(CBNum)%UnitType) // ' Object='//TRIM(CoolBeam(CBNum)%Name))
ErrorsFound = .TRUE.
END IF
END IF
END IF
! save the design water volumetric flow rate for use by the water loop sizing algorithms
IF (CoolBeam(CBNum)%MaxCoolWaterVolFlow > 0.0d0) THEN
CALL RegisterPlantCompDesignFlow(CoolBeam(CBNum)%CWInNode,CoolBeam(CBNum)%MaxCoolWaterVolFlow)
END IF
IF (ErrorsFound) THEN
CALL ShowFatalError('Preceding cooled beam sizing errors cause program termination')
END IF
RETURN
END SUBROUTINE SizeCoolBeam