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 | |||
integer, | intent(in) | :: | ZoneNum | |||
integer, | intent(in) | :: | ZoneNodeNum | |||
logical, | intent(in) | :: | FirstHVACIteration | |||
real(kind=r64), | intent(out) | :: | NonAirSysOutput |
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 ControlCoolBeam(CBNum,ZoneNum,ZoneNodeNum,FirstHVACIteration,NonAirSysOutput)
! SUBROUTINE INFORMATION:
! AUTHOR Fred Buhl
! DATE WRITTEN Feb 12, 2009
! MODIFIED na
! RE-ENGINEERED na
! PURPOSE OF THIS SUBROUTINE:
! Simulate a cooled beam unit;
! METHODOLOGY EMPLOYED:
! (1) From the zone load and the Supply air inlet conditions calculate the beam load
! (2) If there is a beam load, vary the water flow rate to match the beam load
! REFERENCES:
! na
! USE STATEMENTS:
USE DataZoneEnergyDemands
USE General, ONLY: SolveRegulaFalsi
USE PlantUtilities, ONLY:SetComponentFlowRate
IMPLICIT NONE ! Enforce explicit typing of all variables in this routine
! SUBROUTINE ARGUMENT DEFINITIONS:
LOGICAL, INTENT (IN) :: FirstHVACIteration ! TRUE if 1st HVAC simulation of system timestep
INTEGER, INTENT (IN) :: CBNum ! number of the current unit being simulated
INTEGER, INTENT (IN) :: ZoneNum ! number of zone being served
INTEGER, INTENT (IN) :: ZoneNodeNum ! zone node number
REAL(r64), INTENT(OUT) :: NonAirSysOutput ! convective cooling by the beam system [W]
! SUBROUTINE PARAMETER DEFINITIONS:
! na
! INTERFACE BLOCK SPECIFICATIONS:
! na
! DERIVED TYPE DEFINITIONS:
! na
! SUBROUTINE LOCAL VARIABLE DECLARATIONS:
REAL(r64) :: QZnReq ! heating or cooling needed by zone [Watts]
REAL(r64) :: QToHeatSetPt ! [W] remaining load to heating setpoint
REAL(r64) :: QToCoolSetPt ! [W] remaining load to cooling setpoint
REAL(r64) :: QMin=0.0d0 ! cooled beam output at minimum water flow [W]
REAL(r64) :: QMax=0.0d0 ! cooled beam output at maximum water flow [W]
REAL(r64) :: QSup=0.0d0 ! heating or cooling by supply air [W]
REAL(r64) :: PowerMet=0.0d0 ! power supplied
REAL(r64) :: CWFlow=0.0d0 ! cold water flow [kg/s]
REAL(r64) :: AirMassFlow=0.0d0 ! air mass flow rate for the cooled beam system [kg/s]
REAL(r64) :: MaxColdWaterFlow=0.0d0 ! max water mass flow rate for the cooled beam system [kg/s]
REAL(r64) :: MinColdWaterFlow=0.0d0 ! min water mass flow rate for the cooled beam system [kg/s]
REAL(r64) :: CpAirZn=0.0d0 ! specific heat of air at zone conditions [J/kg-C]
REAL(r64) :: CpAirSys=0.0d0 ! specific heat of air at supply air conditions [J/kg-C]
REAL(r64) :: TWOut=0.0d0 ! outlet water tamperature [C]
REAL(r64) :: NumBeams=0.0d0 ! number of beams
INTEGER :: ControlNode ! the water inlet node
INTEGER :: InAirNode ! the air inlet node
LOGICAL :: UnitOn ! TRUE if unit is on
REAL(r64), DIMENSION(5) :: Par
INTEGER :: SolFlag
REAL(r64) :: ErrTolerance
UnitOn = .TRUE.
PowerMet = 0.0d0
InAirNode = CoolBeam(CBNum)%AirInNode
ControlNode = CoolBeam(CBNum)%CWInNode
AirMassFlow = Node(InAirNode)%MassFlowRateMaxAvail
QZnReq = ZoneSysEnergyDemand(ZoneNum)%RemainingOutputRequired
QToHeatSetPt=ZoneSysEnergyDemand(ZoneNum)%RemainingOutputReqToHeatSP
QToCoolSetPt=ZoneSysEnergyDemand(ZoneNum)%RemainingOutputReqToCoolSP
CpAirZn = PsyCpAirFnWTdb(Node(ZoneNodeNum)%HumRat,Node(ZoneNodeNum)%Temp)
CpAirSys = PsyCpAirFnWTdb(Node(InAirNode)%HumRat,Node(InAirNode)%Temp)
MaxColdWaterFlow = CoolBeam(CBNum)%MaxCoolWaterMassFlow
CALL SetComponentFlowRate(MaxColdWaterFlow, &
CoolBeam(CBNum)%CWInNode, &
CoolBeam(CBNum)%CWOutNode, &
CoolBeam(CBNum)%CWLoopNum, &
CoolBeam(CBNum)%CWLoopSideNum, &
CoolBeam(CBNum)%CWBranchNum, &
CoolBeam(CBNum)%CWCompNum)
MinColdWaterFlow = 0.d0
CALL SetComponentFlowRate(MinColdWaterFlow, &
CoolBeam(CBNum)%CWInNode, &
CoolBeam(CBNum)%CWOutNode, &
CoolBeam(CBNum)%CWLoopNum, &
CoolBeam(CBNum)%CWLoopSideNum, &
CoolBeam(CBNum)%CWBranchNum, &
CoolBeam(CBNum)%CWCompNum)
IF (GetCurrentScheduleValue(CoolBeam(CBNum)%SchedPtr) .LE. 0.0d0) UnitOn = .FALSE.
IF (MaxColdWaterFlow <= SmallMassFlow) UnitOn = .FALSE.
! Set the unit's air inlet nodes mass flow rates
Node(InAirNode)%MassFlowRate = AirMassFlow
! set the air volumetric flow rate per beam
CoolBeam(CBNum)%BeamFlow = Node(InAirNode)%MassFlowRate / (StdRhoAir*CoolBeam(CBNum)%NumBeams)
! fire the unit at min water flow
CALL CalcCoolBeam(CBNum,ZoneNodeNum,MinColdWaterFlow,QMin,TWOut)
! cooling by supply air
QSup = AirMassFlow * (CpAirSys*Node(InAirNode)%Temp - CpAirZn*Node(ZoneNodeNum)%Temp)
! load on the beams is QToCoolSetPt-QSup
IF (UnitOn) THEN
IF ((QToCoolSetPt-QSup) < - SmallLoad) THEN
! There is a cooling demand on the cooled beam system.
! First, see if the system can meet the load
CALL CalcCoolBeam(CBNum,ZoneNodeNum,MaxColdWaterFlow,QMax,TWOut)
IF ((QMax < QToCoolSetPt - QSup - SmallLoad) .AND. (QMax /= QMin)) THEN
! The cooled beam system can meet the demand.
! Set up the iterative calculation of chilled water flow rate
Par(1) = REAL(CBNum,r64)
Par(2) = REAL(ZoneNodeNum,r64)
Par(3) = QToCoolSetPt-QSup ! load to be met by the beams
Par(4) = QMin
Par(5) = QMax
ErrTolerance = 0.01d0
CALL SolveRegulaFalsi(ErrTolerance, 50, SolFlag, CWFlow, CoolBeamResidual, &
MinColdWaterFlow, MaxColdWaterFlow, Par)
IF (SolFlag == -1) THEN
CALL ShowWarningError('Cold water control failed in cooled beam unit '//TRIM(CoolBeam(CBNum)%Name))
CALL ShowContinueError(' Iteration limit exceeded in calculating cold water mass flow rate')
ELSE IF (SolFlag == -2) THEN
CALL ShowWarningError('Cold water control failed in cooled beam unit '//TRIM(CoolBeam(CBNum)%Name))
CALL ShowContinueError(' Bad cold water flow limits')
END IF
ELSE
! unit maxed out
CWFlow = MaxColdWaterFlow
END IF
ELSE
! unit has no load
CWFlow = MinColdWaterFlow
END IF
ELSE
! unit Off
CWFlow = MinColdWaterFlow
END IF
! Get the cooling output at the chosen water flow rate
CALL CalcCoolBeam(CBNum,ZoneNodeNum,CWFlow,PowerMet,TWOut)
CoolBeam(CBNum)%BeamCoolingRate = -PowerMet
IF (QSup < 0.0d0) THEN
CoolBeam(CBNum)%SupAirCoolingRate = ABS(QSup)
ELSE
CoolBeam(CBNum)%SupAirHeatingRate = QSup
END IF
CoolBeam(CBNum)%CoolWaterMassFlow = Node(ControlNode)%MassFlowRate
CoolBeam(CBNum)%TWOut = TWOut
CoolBeam(CBNum)%EnthWaterOut = Node(ControlNode)%Enthalpy + CoolBeam(CBNum)%BeamCoolingRate
! Node(ControlNode)%MassFlowRate = CWFlow
NonAirSysOutput = PowerMet
RETURN
END SUBROUTINE ControlCoolBeam