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) | :: | LoopNum | |||
integer, | intent(in) | :: | ThisLoopSideNum | |||
integer, | intent(in) | :: | ThisLoopSideOutletNode | |||
integer, | intent(in) | :: | OtherLoopSideInletNode | |||
logical, | intent(inout) | :: | OutOfToleranceFlag | |||
integer, | intent(in), | optional | :: | CommonPipeType |
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 UpdatePlantLoopInterface(LoopNum,ThisLoopSideNum,ThisLoopSideOutletNode,OtherLoopSideInletNode, &
OutOfToleranceFlag,CommonPipeType)
! SUBROUTINE INFORMATION:
! AUTHOR Rick Strand
! DATE WRITTEN October 1998
! MODIFIED na
! RE-ENGINEERED Brent Griffith, Sept. 2010
! RE-ENGINEERED Dan Fisher, Sept. 2010
! PURPOSE OF THIS SUBROUTINE:
! This subroutine manages any generic HVAC loop interface.
! METHODOLOGY EMPLOYED:
! This is a simple "forward" interface where all of the properties
! from the outlet of one side of the loop get transfered
! to the inlet node of the corresponding other side of the loop.
! Temperatures are 'lagged' by loop capacitance (i.e. a 'tank')
! between the outlet and inlet nodes.
! the update from the demand side to the supply side always triggers
! resimulation of the supply side if any state variable (or energy) is
! out of tolerance. Remsimulation of the demand side is only triggered if
! flow or energy are out of tolerance. This in effect checks flow and
! ~.25C temperature difference.
! REFERENCES:
! na
! USE STATEMENTS:
USE DataLoopNode, ONLY : Node
USE DataConvergParams
USE DataPlant, ONLY : PlantLoop, SupplySide,DemandSide
USE FluidProperties, ONLY : GetSpecificHeatGlycol
IMPLICIT NONE ! Enforce explicit typing of all variables in this routine
! SUBROUTINE ARGUMENT DEFINITIONS:
INTEGER, INTENT(IN) :: OtherLoopSideInletNode ! Node number for the outlet of the side of the loop just simulated
INTEGER, INTENT(IN) :: ThisLoopSideOutletNode ! Node number for the inlet of the side that needs the outlet node data
LOGICAL, INTENT(INOUT) :: OutOfToleranceFlag ! True when the other side of the loop need to be (re)simulated
INTEGER, INTENT(IN) :: LoopNum ! The 'inlet/outlet node' loop number
INTEGER, INTENT(IN) :: ThisLoopSideNum ! The 'outlet node' loopside number
INTEGER, OPTIONAL, INTENT(IN) :: CommonPipeType
! SUBROUTINE PARAMETER DEFINITIONS:
! na
! INTERFACE BLOCK SPECIFICATIONS:
! na
! DERIVED TYPE DEFINITIONS:
! na
! SUBROUTINE LOCAL VARIABLE DECLARATIONS:
REAL(r64) :: DeltaEnergy
REAL(r64) :: OldTankOutletTemp
REAL(r64) :: OldOtherLoopSideInletMdot
REAL(r64) :: TankOutletTemp
REAL(r64) :: Cp
REAL(r64) :: MixedOutletTemp
INTEGER :: ThisLoopSideInletNode
REAL(r64), DIMENSION(ConvergLogStackDepth) :: TmpRealARR
INTEGER :: ZoneInSysIndex
! FLOW:
!reset out of tolerance flags
PlantConvergence(LoopNum)%PlantMassFlowNotConverged = .FALSE.
PlantConvergence(LoopNum)%PlantTempNotConverged = .FALSE.
!set the loopside inlet node
ThisLoopSideInletNode = PlantLoop(LoopNum)%LoopSide(ThisLoopSideNum)%NodeNumIn
!save the inlet node temp for DeltaEnergy check
OldOtherLoopSideInletMdot = Node(OtherLoopSideInletNode)%MassFlowRate
OldTankOutletTemp = Node(OtherLoopSideInletNode)%Temp
!calculate the specific heat
Cp = GetSpecificHeatGlycol(PlantLoop(loopNum)%FluidName,OldTankOutletTemp, &
PlantLoop(loopNum)%FluidIndex,'UpdatePlantLoopInterface')
!update the enthalpy
Node(OtherLoopSideInletNode)%Enthalpy = Cp * Node(OtherLoopSideInletNode)%Temp
!update the temperatures and flow rates
IF(CommonPipeType == 1 .OR. CommonPipeType ==2)THEN
!update the temperature
CALL UpdateCommonPipe(LoopNum, ThisLoopSideNum, CommonPipeType, MixedOutletTemp)
Node(OtherLoopSideInletNode)%Temp = MixedOutletTemp
TankOutletTemp = MixedOutletTemp
IF (ThisLoopSideNum == DemandSide) THEN
TmpRealARR = PlantConvergence(LoopNum)%PlantFlowDemandToSupplyTolValue
PlantConvergence(LoopNum)%PlantFlowDemandToSupplyTolValue(1) = &
ABS(OldOtherLoopSideInletMdot-Node(OtherLoopSideInletNode)%MassFlowRate)
PlantConvergence(LoopNum)%PlantFlowDemandToSupplyTolValue(2:ConvergLogStackDepth) = TmpRealARR(1:ConvergLogStackDepth-1)
IF (PlantConvergence(LoopNum)%PlantFlowDemandToSupplyTolValue(1) > PlantFlowRateToler) THEN
PlantConvergence(LoopNum)%PlantMassFlowNotConverged = .TRUE.
ENDIF
ELSE
TmpRealARR = PlantConvergence(LoopNum)%PlantFlowSupplyToDemandTolValue
PlantConvergence(LoopNum)%PlantFlowSupplyToDemandTolValue(1) = &
ABS(OldOtherLoopSideInletMdot-Node(OtherLoopSideInletNode)%MassFlowRate)
PlantConvergence(LoopNum)%PlantFlowSupplyToDemandTolValue(2:ConvergLogStackDepth) = TmpRealARR(1:ConvergLogStackDepth-1)
IF (PlantConvergence(LoopNum)%PlantFlowSupplyToDemandTolValue(1) > PlantFlowRateToler) THEN
PlantConvergence(LoopNum)%PlantMassFlowNotConverged = .TRUE.
ENDIF
ENDIF
!Set the flow rate. Continuity requires that the flow rates at the half loop inlet and outlet match
Node(ThisLoopSideInletNode)%MassFlowRate = Node(ThisLoopSideOutletNode)%MassFlowRate
!Update this loopside inlet node Min/MaxAvail to this loopside outlet node Min/MaxAvail
Node(ThisLoopSideInletNode)%MassFlowRateMinAvail = Node(ThisLoopSideOutletNode)%MassFlowRateMinAvail
Node(ThisLoopSideInletNode)%MassFlowRateMaxAvail = Node(ThisLoopSideOutletNode)%MassFlowRateMaxAvail
ELSE !no common pipe
CALL UpdateHalfLoopInletTemp(LoopNum, ThisLoopSideNum,TankOutletTemp)
!update the temperature
Node(OtherLoopSideInletNode)%Temp = TankOutletTemp
!Set the flow tolerance array
IF (ThisLoopSideNum == DemandSide) THEN
TmpRealARR = PlantConvergence(LoopNum)%PlantFlowDemandToSupplyTolValue
PlantConvergence(LoopNum)%PlantFlowDemandToSupplyTolValue(1) = &
ABS(Node(ThisLoopSideOutletNode)%MassFlowRate-Node(OtherLoopSideInletNode)%MassFlowRate)
PlantConvergence(LoopNum)%PlantFlowDemandToSupplyTolValue(2:ConvergLogStackDepth) = TmpRealARR(1:ConvergLogStackDepth-1)
IF (PlantConvergence(LoopNum)%PlantFlowDemandToSupplyTolValue(1) > PlantFlowRateToler) THEN
PlantConvergence(LoopNum)%PlantMassFlowNotConverged = .TRUE.
ENDIF
ELSE
TmpRealARR = PlantConvergence(LoopNum)%PlantFlowSupplyToDemandTolValue
PlantConvergence(LoopNum)%PlantFlowSupplyToDemandTolValue(1) = &
ABS(Node(ThisLoopSideOutletNode)%MassFlowRate-Node(OtherLoopSideInletNode)%MassFlowRate)
PlantConvergence(LoopNum)%PlantFlowSupplyToDemandTolValue(2:ConvergLogStackDepth) = TmpRealARR(1:ConvergLogStackDepth-1)
IF (PlantConvergence(LoopNum)%PlantFlowSupplyToDemandTolValue(1) > PlantFlowRateToler) THEN
PlantConvergence(LoopNum)%PlantMassFlowNotConverged = .TRUE.
ENDIF
ENDIF
! PlantFlowTolValue(PlantQuePtr) = ABS(Node(ThisLoopSideOutletNode)%MassFlowRate-Node(OtherLoopSideInletNode)%MassFlowRate)
!Set the flow rate
Node(OtherLoopSideInletNode)%MassFlowRate = Node(ThisLoopSideOutletNode)%MassFlowRate
!update the MIN/MAX available flow rates
Node(OtherLoopSideInletNode)%MassFlowRateMinAvail = Node(ThisLoopSideOutletNode)%MassFlowRateMinAvail
Node(OtherLoopSideInletNode)%MassFlowRateMaxAvail = Node(ThisLoopSideOutletNode)%MassFlowRateMaxAvail
!update Quality. DSU? Note: This update assumes that STEAM cannot be used with common pipes.
Node(OtherLoopSideInletNode)%Quality = Node(ThisLoopSideOutletNode)%Quality
!pressure update DSU? Note: This update assumes that PRESSURE SIMULATION cannot be used with common pipes.
IF (PlantLoop(LoopNum)%HasPressureComponents) THEN
!Don't update pressure, let the pressure simulation handle pressures
ELSE
!Do update pressure!
Node(OtherLoopSideInletNode)%Press = Node(ThisLoopSideOutletNode)%Press
END IF
ENDIF
!temperature
IF (ThisLoopSideNum == DemandSide) THEN
TmpRealARR = PlantConvergence(LoopNum)%PlantTempDemandToSupplyTolValue
PlantConvergence(LoopNum)%PlantTempDemandToSupplyTolValue(1) = &
ABS(OldTankOutletTemp-Node(OtherLoopSideInletNode)%Temp)
PlantConvergence(LoopNum)%PlantTempDemandToSupplyTolValue(2:ConvergLogStackDepth) = TmpRealARR(1:ConvergLogStackDepth-1)
IF (PlantConvergence(LoopNum)%PlantTempDemandToSupplyTolValue(1) > PlantTemperatureToler) THEN
PlantConvergence(LoopNum)%PlantTempNotConverged = .TRUE.
ENDIF
ELSE
TmpRealARR = PlantConvergence(LoopNum)%PlantTempSupplyToDemandTolValue
PlantConvergence(LoopNum)%PlantTempSupplyToDemandTolValue(1) = &
ABS(OldTankOutletTemp-Node(OtherLoopSideInletNode)%Temp)
PlantConvergence(LoopNum)%PlantTempSupplyToDemandTolValue(2:ConvergLogStackDepth) = TmpRealARR(1:ConvergLogStackDepth-1)
IF (PlantConvergence(LoopNum)%PlantTempSupplyToDemandTolValue(1) > PlantTemperatureToler) THEN
PlantConvergence(LoopNum)%PlantTempNotConverged = .TRUE.
ENDIF
ENDIF
!Set out of tolerance flags
IF (ThisLoopSideNum == DemandSide) THEN
IF (PlantConvergence(LoopNum)%PlantMassFlowNotConverged .OR. PlantConvergence(LoopNum)%PlantTempNotConverged) THEN
OutOfToleranceFlag = .TRUE.
ENDIF
ELSE
IF (PlantConvergence(LoopNum)%PlantMassFlowNotConverged) THEN
OutOfToleranceFlag = .TRUE.
ENDIF
ENDIF
RETURN
END SUBROUTINE UpdatePlantLoopInterface