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) | :: | LoopSide | |||
real(kind=r64), | intent(in) | :: | TankOutletTemp |
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 ManageTwoWayCommonPipe(LoopNum,LoopSide, TankOutletTemp)
! SUBROUTINE INFORMATION:
! AUTHOR B. Griffith
! DATE WRITTEN June 2011
! MODIFIED na
! RE-ENGINEERED B. Griffith, Oct 2011. rewrite
! PURPOSE OF THIS SUBROUTINE:
! manage two-way common pipe modeling at half-loop interface
! METHODOLOGY EMPLOYED:
! calculate mixed temperatures and various flow rates
! sequential subsitution of system of equations
! REFERENCES:
! reimplementation of CheckTwoWayCommonPipeConditions by Sankaranarayanan K P Jan 2007
! USE STATEMENTS:
USE DataGlobals, ONLY : BeginEnvrnFlag
USE DataPlant, ONLY : PlantLoop, SupplySide, DemandSide, TotNumLoops, DeltaTemptol, PlantReport
USE DataBranchAirLoopPlant, ONLY: MassFlowTolerance
USE DataLoopNode, ONLY : Node
USE PlantUtilities, ONLY : SetActuatedBranchFlowRate
IMPLICIT NONE ! Enforce explicit typing of all variables in this routine
! SUBROUTINE ARGUMENT DEFINITIONS:
INTEGER, INTENT(IN) :: LoopNum
INTEGER, INTENT(IN) :: LoopSide
REAL(r64), INTENT(IN) :: TankOutletTemp
! SUBROUTINE PARAMETER DEFINITIONS:
INTEGER, PARAMETER :: DemandLedPrimaryInletUpdate = 101
INTEGER, PARAMETER :: DemandLedSecondaryInletUpdate = 102
INTEGER, PARAMETER :: SupplyLedPrimaryInletUpdate = 103
INTEGER, PARAMETER :: SupplyLedSecondaryInletUpdate = 104
INTEGER, PARAMETER :: BothLedPrimaryInletUpdate = 105
INTEGER, PARAMETER :: BothLedSecondaryInletUpdate = 106
INTEGER, PARAMETER :: NeedsMoreFlow = 201
INTEGER, PARAMETER :: NeedsLessFlow = 202
INTEGER, PARAMETER :: NeedsSameFlow = 203
REAL(r64), PARAMETER :: MdotPerturbFactor = 0.02D0
! INTERFACE BLOCK SPECIFICATIONS:
! na
! DERIVED TYPE DEFINITIONS:
! na
! SUBROUTINE LOCAL VARIABLE DECLARATIONS:
LOGICAL,SAVE,ALLOCATABLE, DIMENSION(:) :: MyEnvrnFlag
LOGICAL,SAVE :: OneTimeData =.TRUE.
INTEGER :: CurCallingCase ! local temporary
REAL(r64) :: MdotPri = 0.d0 ! flow rate on primary side kg/s
REAL(r64) :: MdotSec = 0.d0 ! flow rate on secondary side kg/s
REAL(r64) :: MdotPriToSec = 0.d0 ! flow rate between primary and secondary side kg/s
REAL(r64) :: MdotPriRCLeg = 0.d0 ! flow rate on primary recirculation common pipe kg/s
REAL(r64) :: MdotSecRCLeg = 0.d0 ! flow rate on secondary recirculation common pipe kg/s
REAL(r64) :: TempSecInlet = 0.d0 ! temperature at secondary inlet deg C
REAL(r64) :: TempPriInlet = 0.d0 ! temperature at primary inlet deg C
REAL(r64) :: TempPriOutTankOut = 0.d0
REAL(r64) :: TempSecOutTankOut = 0.d0
REAL(r64) :: TempCPPrimaryCntrlSetpoint = 0.d0
! REAL(r64) :: TempCPCntrlCurrent = 0.d0
REAL(r64) :: TempCPSecondaryCntrlSetpoint = 0.d0
! REAL(r64) :: TempCPCntrlCurrent = 0.d0
INTEGER :: NodeNumPriOut = 0
INTEGER :: NodeNumSecOut = 0
INTEGER :: NodeNumPriIn = 0
INTEGER :: NodeNumSecIn = 0
INTEGER :: MaxIterLimitCaseA = 8
INTEGER :: MaxIterLimitCaseB = 4
INTEGER :: loop ! interation loop counter
! INTEGER :: loop2
! one time setups
IF (OneTimeData) THEN
IF ( .NOT. CommonPipeSetupFinished ) CALL SetupCommonPipes
ALLOCATE(MyEnvrnFlag(TotNumLoops))
MyEnvrnFlag = .TRUE.
OneTimeData = .FALSE.
END IF
!fill local node indexes
NodeNumPriIn = PlantLoop(LoopNum)%LoopSide(SupplySide)%NodeNumIn
NodeNumPriOut = PlantLoop(LoopNum)%LoopSide(SupplySide)%NodeNumOut
NodeNumSecIn = PlantLoop(LoopNum)%LoopSide(DemandSide)%NodeNumIn
NodeNumSecOut = PlantLoop(LoopNum)%LoopSide(DemandSide)%NodeNumOut
! begin environment inits
IF (MyEnvrnFlag(LoopNum) .and. BeginEnvrnFlag) THEN
PlantCommonPipe(LoopNum)%PriToSecFlow = 0.d0
PlantCommonPipe(LoopNum)%SecToPriFlow = 0.d0
PlantCommonPipe(LoopNum)%PriCPLegFlow = 0.d0
PlantCommonPipe(LoopNum)%SecCPLegFlow = 0.d0
MyEnvrnFlag(LoopNum) = .FALSE.
ENDIF
IF (.NOT. BeginEnvrnFlag) THEN
MyEnvrnFlag(LoopNum)=.TRUE.
END IF
! every time inits
MdotSec = Node(NodeNumSecOut)%MassFlowRate ! assume known and fixed by demand side operation
TempCPPrimaryCntrlSetpoint = Node(NodeNumPriIn)%TempSetpoint
TempCPSecondaryCntrlSetpoint = Node(NodeNumSecIn)%TempSetpoint
! 6 unknowns follow, fill with current values
MdotPriToSec = PlantCommonPipe(LoopNum)%PriToSecFlow
MdotPriRCLeg = PlantCommonPipe(LoopNum)%PriCPLegFlow
MdotSecRCLeg = PlantCommonPipe(LoopNum)%SecCPLegFlow
TempSecInlet = Node(NodeNumSecIn)%Temp
TempPriInlet = Node(NodeNumPriIn)%Temp
MdotPri = Node(NodeNumPriOut)%MassFlowRate !may or may not be an unknown, If variable speed primary side, then unknown
IF (LoopSide == SupplySide) THEN
TempSecOutTankOut = TankOutletTemp
TempPriOutTankOut = PlantLoop(LoopNum)%LoopSide(DemandSide)%LoopSideInlet_TankTemp
ELSE
TempPriOutTankOut = TankOutletTemp
TempSecOutTankOut = PlantLoop(LoopNum)%LoopSide(SupplySide)%LoopSideInlet_TankTemp
ENDIF
! determine current case
! which side is being updated
! commonpipe control point is the inlet of one of the half loops
CurCallingCase=0
IF (LoopSide == SupplySide) THEN !update primary inlet
IF ( PlantLoop(loopnum)%Loopside(SupplySide)%InletNodeSetPt .AND. &
.NOT. PlantLoop(loopnum)%Loopside(DemandSide)%InletNodeSetPt ) THEN
CurCallingCase = SupplyLedPrimaryInletUpdate
ELSEIF (.NOT. PlantLoop(loopnum)%Loopside(SupplySide)%InletNodeSetPt .AND. &
PlantLoop(loopnum)%Loopside(DemandSide)%InletNodeSetPt ) THEN
CurCallingCase = DemandLedPrimaryInletUpdate
ENDIF
ELSE ! update secondary inlet
IF (PlantLoop(loopnum)%Loopside(SupplySide)%InletNodeSetPt .AND. &
.NOT. PlantLoop(loopnum)%Loopside(DemandSide)%InletNodeSetPt ) THEN
CurCallingCase = SupplyLedSecondaryInletUpdate
ELSEIF (.NOT. PlantLoop(loopnum)%Loopside(SupplySide)%InletNodeSetPt .AND. &
PlantLoop(loopnum)%Loopside(DemandSide)%InletNodeSetPt ) THEN
CurCallingCase = DemandLedSecondaryInletUpdate
ENDIF
ENDIF
SELECT CASE (CurCallingCase)
CASE (SupplyLedPrimaryInletUpdate, SupplyLedSecondaryInletUpdate)
! CASE A, Primary/Supply Led
! six equations and six unknowns (although one has a setpoint)
DO loop = 1, MaxIterLimitCaseA
! eq 1
IF (ABS(TempSecOutTankOut - TempCPPrimaryCntrlSetpoint ) > DeltaTemptol) THEN
MdotPriToSec = MdotPriRCLeg * (TempCPPrimaryCntrlSetpoint - TempPriOutTankOut) &
/ ( TempSecOutTankOut - TempCPPrimaryCntrlSetpoint)
IF (MdotPriToSec < MassFlowTolerance) MdotPriToSec = 0.d0
IF (MdotPriToSec > MdotSec) MdotPriToSec = MdotSec
ELSE
MdotPriToSec = MdotSec ! what to do (?)
ENDIF
! eq. 5
MdotPriRCLeg = MdotPri - MdotPriToSec
IF (MdotPriRCLeg < MassFlowTolerance) MdotPriRCLeg = 0.d0
! eq. 4
MdotSecRCLeg = MdotSec - MdotPriToSec
IF (MdotSecRCLeg < MassFlowTolerance) MdotSecRCLeg = 0.d0
! eq 6
IF ((MdotPriToSec + MdotSecRCLeg) > MassFlowTolerance) THEN
TempSecInlet = (MdotPriToSec * TempPriOutTankOut + MdotSecRCLeg * TempSecOutTankOut) &
/ (MdotPriToSec + MdotSecRCLeg)
ELSE
TempSecInlet = TempPriOutTankOut
ENDIF
! eq. 3
IF ((PlantCommonPipe(LoopNum)%SupplySideInletPumpType == VariableFlow) &
.AND. (CurCallingCase == SupplyLedPrimaryInletUpdate) )THEN
! MdotPri is a variable to be calculated and flow request needs to be made
IF (ABS(TempCPPrimaryCntrlSetpoint ) > DeltaTemptol) THEN
! Do loop2 = 1, MaxIterLimitCaseA
! MdotPri = (MdotSec * TempSecInlet + MdotPriRCLeg *TempPriOutTankOut - MdotSecRCLeg * TempSecOutTankOut ) &
! / (TempPriOutTankOut )
MdotPri = (MdotPriRCLeg * TempPriOutTankOut + MdotPriToSec * TempSecOutTankOut) &
/ (TempCPPrimaryCntrlSetpoint)
! ENDDO
IF (MdotPri < MassFlowTolerance) MdotPri = 0.d0
ELSE
MdotPri = MdotSec
ENDIF
CALL SetActuatedBranchFlowRate(MdotPri,NodeNumPriIn,LoopNum,SupplySide, 1, .FALSE.)
ENDIF
! eq. 2
IF ((MdotPriToSec + MdotPriRCLeg) > MassFlowTolerance ) THEN
TempPriInlet = (MdotPriToSec * TempSecOutTankOut + MdotPriRCLeg * TempPriOutTankOut) &
/ (MdotPriToSec + MdotPriRCLeg)
ELSE
TempPriInlet = TempSecOutTankOut
ENDIF
ENDDO
CASE (DemandLedPrimaryInletUpdate, DemandLedSecondaryInletUpdate)
! case B. Secondary/demand led
! six equations and six unknowns (although one has a setpoint)
DO Loop = 1, MaxIterLimitCaseB
! eq 1,
IF (ABS(TempPriOutTankOut - TempSecOutTankOut ) > DeltaTemptol) THEN
MdotPriToSec = MdotSec * (TempCPSecondaryCntrlSetpoint - TempSecOutTankOut ) &
/ (TempPriOutTankOut - TempSecOutTankOut )
IF (MdotPriToSec < MassFlowTolerance) MdotPriToSec = 0.d0
IF (MdotPriToSec > MdotSec) MdotPriToSec = MdotSec
ELSE
MdotPriToSec = MdotSec
ENDIF
! eq. 2,
IF ((MdotPriToSec + MdotPriRCLeg) > MassFlowTolerance ) THEN
TempPriInlet = (MdotPriToSec * TempSecOutTankOut + MdotPriRCLeg * TempPriOutTankOut) &
/ (MdotPriToSec + MdotPriRCLeg)
ELSE
TempPriInlet = TempSecOutTankOut
ENDIF
! eq. 3
IF ((PlantCommonPipe(LoopNum)%SupplySideInletPumpType == VariableFlow) &
.AND. (CurCallingCase == DemandLedPrimaryInletUpdate)) THEN
! MdotPri is a variable to be calculated and flow request made
IF (ABS(TempPriOutTankOut - TempPriInlet ) > DeltaTemptol) THEN
MdotPri = MdotSec * ( TempCPSecondaryCntrlSetpoint - TempSecOutTankOut ) &
/ (TempPriOutTankOut - TempPriInlet )
IF (MdotPri < MassFlowTolerance) MdotPri = 0.d0
ELSE
MdotPri = MdotSec
ENDIF
CALL SetActuatedBranchFlowRate(MdotPri,NodeNumPriIn,LoopNum,SupplySide, 1, .FALSE.)
ENDIF
! eq. 4
MdotSecRCLeg = MdotSec - MdotPriToSec
IF (MdotSecRCLeg < MassFlowTolerance) MdotSecRCLeg = 0.d0
! eq. 5
MdotPriRCLeg = MdotPri - MdotPriToSec
IF (MdotPriRCLeg < MassFlowTolerance) MdotPriRCLeg = 0.d0
! eq 6
IF ((MdotPriToSec + MdotSecRCLeg) > MassFlowTolerance) THEN
TempSecInlet = (MdotPriToSec * TempPriOutTankOut + MdotSecRCLeg * TempSecOutTankOut) &
/ (MdotPriToSec + MdotSecRCLeg)
ELSE
TempSecInlet = TempPriOutTankOut
ENDIF
ENDDO
CASE DEFAULT
!??? CALL ShowFatalError('ManageTwoWayCommonPipe: Calling Case Fall Through')
END SELECT
!update
PlantCommonPipe(LoopNum)%PriToSecFlow = MdotPriToSec
PlantCommonPipe(LoopNum)%SecToPriFlow = MdotPriToSec
PlantCommonPipe(LoopNum)%PriCPLegFlow = MdotPriRCLeg
PlantCommonPipe(LoopNum)%SecCPLegFlow = MdotSecRCLeg
Node(NodeNumSecIn)%Temp = TempSecInlet
Node(NodeNumPriIn)%Temp = TempPriInlet
RETURN
END SUBROUTINE ManageTwoWayCommonPipe