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) | :: | AirLoopNum | |||
integer, | intent(in) | :: | BranchNum | |||
integer, | intent(in) | :: | Update |
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 UpdateBranchConnections(AirLoopNum,BranchNum,Update)
! SUBROUTINE INFORMATION
! AUTHOR: Fred Buhl
! DATE WRITTEN: Nov 1999
! MODIFIED:
! RE-ENGINEERED: This is new code, not reengineered
! PURPOSE OF THIS SUBROUTINE:
! This routine passes node data from a branch exit node through a
! splitter.
! METHODOLOGY EMPLOYED:
! Temperature, humidity ratio, and enthalpy are passed through from
! the inlet to the outlets. The mass flow is divided among the outlets
! according to the required mass flows established by the zone equipment
! simulation. The required mass flows are were stored in the node data
! as MassFlowRateSetPoints in the InitAirLoops routine.
! REFERENCES: None
! USE STATEMENTS
USE Psychrometrics, ONlY: PsyTdbFnHW
USE DataContaminantBalance, ONLY: Contaminant
IMPLICIT NONE
! SUBROUTINE ARGUMENTS:
INTEGER, INTENT(IN) :: BranchNum ! branch reference number
INTEGER, INTENT(IN) :: AirLoopNum ! primary air system number
INTEGER, INTENT(IN) :: Update ! 1=BeforeBranchSim; 2=AfterBranchSim
! SUBROUTINE PARAMETER DEFINITIONS: None
! INTERFACE BLOCK DEFINITIONS: None
! DERIVED TYPE DEFINITIONS: None
! SUBROUTINE LOCAL VARIABLE DEFINITIONS
INTEGER :: OutletNum ! splitter outlet DO loop index
INTEGER :: InletNum ! mixer inlet DO loop index
INTEGER :: InletNodeNum ! node number of splitter inlet node
INTEGER :: OutletNodeNum ! node number of a splitter outlet node
INTEGER :: RABNodeNum ! splitter outlet RAB node
INTEGER :: NonRABNodeNum ! splitter outlet nonRAB node
REAL(r64) :: MassFlowRateSetSum ! sum of mass flow rate setpoints for splitter outlet nodes
REAL(r64) :: MassFlowRateOut ! outlet mass flow rate of mixer
REAL(r64) :: MassFlowRateMinAvailOut ! outlet minimum available mass flow rate
REAL(r64) :: OutletHumRat ! outlet humidity ratio of mixer
REAL(r64) :: OutletEnthalpy ! outlet enthalpy of mixer
REAL(r64) :: OutletPress
REAL(r64) :: OutletCO2 ! outlet CO2 of mixer
REAL(r64) :: OutletGC ! outlet generic contaminant of mixer
! FLOW
MassFlowRateSetSum = 0.0d0
MassFlowRateOut = 0.0d0
MassFlowRateMinAvailOut = 0.0d0
OutletHumRat = 0.0d0
OutletEnthalpy = 0.0d0
OutletPress = 0.0d0
RABNodeNum = 0
NonRABNodeNum = 0
OutletCO2 = 0.0d0
OutletGC = 0.0d0
IF (PrimaryAirSystem(AirLoopNum)%Splitter%Exists .AND. Update == AfterBranchSim) THEN
! if we are at an inlet branch, pass data through the splitter
IF (PrimaryAirSystem(AirLoopNum)%Splitter%BranchNumIn.EQ.BranchNum) THEN
InletNodeNum = PrimaryAirSystem(AirLoopNum)%Splitter%NodeNumIn
! Pass node data through the splitter
DO OutletNum=1,PrimaryAirSystem(AirLoopNum)%Splitter%TotalOutletNodes
OutletNodeNum = PrimaryAirSystem(AirLoopNum)%Splitter%NodeNumOut(OutletNum)
Node(OutletNodeNum)%Temp = Node(InletNodeNum)%Temp
Node(OutletNodeNum)%HumRat = Node(InletNodeNum)%HumRat
Node(OutletNodeNum)%Enthalpy = Node(InletNodeNum)%Enthalpy
Node(OutletNodeNum)%Press = Node(InletNodeNum)%Press
MassFlowRateSetSum = MassFlowRateSetSum + MIN(Node(OutletNodeNum)%MassFlowRateSetPoint, &
Node(OutletNodeNum)%MassFlowRateMaxAvail)
IF (Contaminant%CO2Simulation) Then
Node(OutletNodeNum)%CO2 = Node(InletNodeNum)%CO2
End If
IF (Contaminant%GenericContamSimulation) Then
Node(OutletNodeNum)%GenContam = Node(InletNodeNum)%GenContam
End If
END DO
IF (.NOT. PrimaryAirSystem(AirLoopNum)%RABExists) THEN
! set the outlet mass flows
DO OutletNum=1,PrimaryAirSystem(AirLoopNum)%Splitter%TotalOutletNodes
OutletNodeNum = PrimaryAirSystem(AirLoopNum)%Splitter%NodeNumOut(OutletNum)
IF (MassFlowRateSetSum.LT.SmallMassFlow .OR. Node(InletNodeNum)%MassFlowRate.LT.SmallMassFlow) THEN
Node(OutletNodeNum)%MassFlowRate = 0.0d0
ELSE
Node(OutletNodeNum)%MassFlowRate = Node(InletNodeNum)%MassFlowRate * &
(MIN(Node(OutletNodeNum)%MassFlowRateSetPoint, &
Node(OutletNodeNum)%MassFlowRateMaxAvail) &
/ MassFlowRateSetSum)
END IF
Node(OutletNodeNum)%MassFlowRateMaxAvail = Node(InletNodeNum)%MassFlowRateMaxAvail
Node(OutletNodeNum)%MassFlowRateMinAvail = 0.0d0
END DO
ELSE ! set the RAB flow rates
RABNodeNum = PrimaryAirSystem(AirLoopNum)%RABSplitOutNode
NonRABNodeNum = PrimaryAirSystem(AirLoopNum)%OtherSplitOutNode
IF (AirLoopControlInfo(AirLoopNum)%EconoActive) THEN
Node(RABNodeNum)%MassFlowRate = 0.0d0
Node(NonRABNodeNum)%MassFlowRate = Node(InletNodeNum)%MassFlowRate
ELSE
Node(RABNodeNum)%MassFlowRate = Node(RABNodeNum)%MassFlowRateSetPoint
Node(NonRABNodeNum)%MassFlowRate = Node(InletNodeNum)%MassFlowRate - Node(RABNodeNum)%MassFlowRate
IF (Node(NonRABNodeNum)%MassFlowRate <= AirLoopFlow(AirLoopNum)%MinOutAir) THEN
Node(NonRABNodeNum)%MassFlowRate = MIN(AirLoopFlow(AirLoopNum)%MinOutAir,Node(InletNodeNum)%MassFlowRate)
Node(RABNodeNum)%MassFlowRate = Node(InletNodeNum)%MassFlowRate - Node(NonRABNodeNum)%MassFlowRate
END IF
END IF
END IF
END IF
END IF
IF (PrimaryAirSystem(AirLoopNum)%Mixer%Exists .AND. Update == BeforeBranchSim) THEN
! if we are at a mixer outlet branch, calculate the outlet branch conditions
IF (PrimaryAirSystem(AirLoopNum)%Mixer%BranchNumOut.EQ.BranchNum) THEN
OutletNodeNum = PrimaryAirSystem(AirLoopNum)%Mixer%NodeNumOut
! get the outlet mass flow rate and the outlet minavail mass flow rate
DO InletNum=1,PrimaryAirSystem(AirLoopNum)%MIxer%TotalInletNodes
InletNodeNum = PrimaryAirSystem(AirLoopNum)%Mixer%NodeNumIn(InletNum)
MassFlowRateOut = MassFlowRateOut + Node(InletNodeNum)%MassFlowRate
MassFlowRateMinAvailOut = MassFlowRateMinAvailOut + Node(InletNodeNum)%MassFlowRateMinAvail
END DO
! set the outlet mass flow
Node(OutletNodeNum)%MassFlowRate = MassFlowRateOut
Node(OutletNodeNum)%MassFlowRateMinAvail = MassFlowRateMinAvailOut
Node(OutletNodeNum)%MassFlowRateMaxAvail = Node(OutletNodeNum)%MassFlowRateMax
! calculate the outlet humidity ratio and enthalpy and pressure
IF (MassFlowRateOut > 0.0d0) THEN
DO InletNum=1,PrimaryAirSystem(AirLoopNum)%Mixer%TotalInletNodes
InletNodeNum = PrimaryAirSystem(AirLoopNum)%Mixer%NodeNumIn(InletNum)
OutletHumRat = OutletHumRat + (Node(InletNodeNum)%MassFlowRate * Node(InletNodeNum)%HumRat) / MassFlowRateOut
OutletEnthalpy = OutletEnthalpy + (Node(InletNodeNum)%MassFlowRate * Node(InletNodeNum)%Enthalpy) / MassFlowRateOut
OutletPress = OutletPress + (Node(InletNodeNum)%MassFlowRate * Node(InletNodeNum)%Press) / MassFlowRateOut
IF (Contaminant%CO2Simulation) Then
OutletCO2 = OutletCO2 + (Node(InletNodeNum)%MassFlowRate * Node(InletNodeNum)%CO2) / MassFlowRateOut
END IF
IF (Contaminant%GenericContamSimulation) Then
OutletGC = OutletGC + (Node(InletNodeNum)%MassFlowRate * Node(InletNodeNum)%GenContam) / MassFlowRateOut
END IF
END DO
ELSE
InletNodeNum = PrimaryAirSystem(AirLoopNum)%Mixer%NodeNumIn(1)
OutletHumRat = Node(InletNodeNum)%HumRat
OutletEnthalpy = Node(InletNodeNum)%Enthalpy
OutletPress = Node(InletNodeNum)%Press
IF (Contaminant%CO2Simulation) Then
OutletCO2 = Node(InletNodeNum)%CO2
END IF
IF (Contaminant%GenericContamSimulation) Then
OutletGC = Node(InletNodeNum)%GenContam
END IF
END IF
Node(OutletNodeNum)%HumRat = OutletHumRat
Node(OutletNodeNum)%Enthalpy = OutletEnthalpy
Node(OutletNodeNum)%Press = OutletPress
! calculate the outlet temperature
Node(OutletNodeNum)%Temp = PsyTdbFnHW(OutletEnthalpy,OutletHumRat)
IF (Contaminant%CO2Simulation) Then
Node(OutletNodeNum)%CO2 = OutletCO2
END IF
IF (Contaminant%GenericContamSimulation) Then
Node(OutletNodeNum)%GenContam = OutletGC
END IF
END IF
END IF
RETURN
END SUBROUTINE UpdateBranchConnections