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 |
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 UpdatePressureDrop(LoopNum)
! SUBROUTINE INFORMATION:
! AUTHOR Edwin Lee
! DATE WRITTEN August 2009
! MODIFIED na
! RE-ENGINEERED na
! PURPOSE OF THIS SUBROUTINE:
! Evaluate the pressure drop across an entire plant loop and places the value
! on the PlantLoop(:) data structure for the pump to use
! METHODOLOGY EMPLOYED:
! Assumes that the supply inlet is the starting node, which will be set to some standard pressure
! Then we move around the loop backward from this reference point and go until we hit a pump and stop.
! The pressure difference from reference to pump is the new required pump head.
! REFERENCES:
! na
! USE STATEMENTS:
USE DataPlant, ONLY : PlantLoop, DemandSide, SupplySide
USE DataLoopNode, ONLY : Node
IMPLICIT NONE ! Enforce explicit typing of all variables in this routine
! SUBROUTINE ARGUMENT DEFINITIONS:
INTEGER, INTENT(IN) :: LoopNum
! SUBROUTINE PARAMETER DEFINITIONS:
! na
! INTERFACE BLOCK SPECIFICATIONS:
! na
! DERIVED TYPE DEFINITIONS:
! na
! SUBROUTINE LOCAL VARIABLE DECLARATIONS:
INTEGER :: LoopSideNum
INTEGER :: BranchNum
INTEGER :: NumBranches
REAL(r64) :: BranchPressureDrop
REAL(r64) :: LoopSidePressureDrop
REAL(r64) :: LoopPressureDrop
REAL(r64), ALLOCATABLE, DIMENSION(:) :: ParallelBranchPressureDrops
REAL(r64), ALLOCATABLE, DIMENSION(:) :: ParallelBranchInletPressures
INTEGER :: ParallelBranchCounter
REAL(r64) :: SplitterInletPressure
REAL(r64) :: MixerPressure
LOGICAL :: FoundAPumpOnBranch
REAL(r64) :: EffectiveLoopKValue
REAL(r64) :: EffectiveLoopSideKValue
REAL(r64) :: TempVal_SumOfOneByRootK
!Exit if not needed
IF (.NOT. PlantLoop(LoopNum)%HasPressureComponents) RETURN
!Now go through and update the pressure drops as needed
FoundAPumpOnBranch = .FALSE.
LoopPressureDrop = 0.0d0
DO LoopSideNum = DemandSide, SupplySide !Start at demand side outlet
!Loop through all branches on this loop side
LoopSidePressureDrop = 0.0d0
NumBranches = SIZE(PlantLoop(LoopNum)%LoopSide(LoopSideNum)%Branch)
!Split here based on a single branch loop or a splitter/mixer configuration
IF (NumBranches == 1) THEN !Just do the single branch
!***SINGLE BRANCH***!
BranchNum = 1
CALL DistributePressureOnBranch(LoopNum,LoopSideNum,BranchNum,BranchPressureDrop,FoundAPumpOnBranch)
LoopSidePressureDrop = LoopSidePressureDrop + BranchPressureDrop
LoopPressureDrop = LoopPressureDrop + BranchPressureDrop
!*******************!
ELSE IF (NumBranches > 1) THEN !Loop through all branches on this loop side, mixer/splitter configuration
!***OUTLET BRANCH***!
BranchNum = NumBranches
CALL DistributePressureOnBranch(LoopNum,LoopSideNum,BranchNum,BranchPressureDrop,FoundAPumpOnBranch)
LoopSidePressureDrop = LoopSidePressureDrop + BranchPressureDrop
LoopPressureDrop = LoopPressureDrop + BranchPressureDrop
!*******************!
!***MIXER SIMULATION***!
MixerPressure = Node(PlantLoop(LoopNum)%LoopSide(LoopSideNum)%Branch(BranchNum)%NodeNumIn)%Press
CALL PassPressureAcrossMixer(LoopNum,LoopSideNum,MixerPressure,NumBranches)
!**********************!
!***PARALLEL BRANCHES***!
IF (ALLOCATED(ParallelBranchPressureDrops)) DEALLOCATE(ParallelBranchPressureDrops)
ALLOCATE(ParallelBranchPressureDrops(NumBranches-2))
IF (ALLOCATED(ParallelBranchInletPressures)) DEALLOCATE(ParallelBranchInletPressures)
ALLOCATE(ParallelBranchInletPressures(NumBranches-2))
ParallelBranchCounter = 0
DO BranchNum = NumBranches-1, 2, -1 !Working backward (not necessary, but consistent)
ParallelBranchCounter = ParallelBranchCounter + 1
CALL DistributePressureOnBranch(LoopNum,LoopSideNum,BranchNum, &
ParallelBranchPressureDrops(ParallelBranchCounter),FoundAPumpOnBranch)
!Store the branch inlet pressure so we can pass it properly across the splitter
ParallelBranchInletPressures(ParallelBranchCounter) = &
Node(PlantLoop(LoopNum)%LoopSide(LoopSideNum)%Branch(BranchNum)%NodeNumIn)%Press
END DO
!Now take max inlet pressure to pass across splitter and max branch pressure for bookkeeping
SplitterInletPressure = MAXVAL(ParallelBranchInletPressures)
BranchPressureDrop = MAXVAL(ParallelBranchPressureDrops)
LoopSidePressureDrop = LoopSidePressureDrop + BranchPressureDrop
LoopPressureDrop = LoopPressureDrop + BranchPressureDrop
!**********************!
!If we found pumps on the parallel branches then we are done,
! If we are on the demand side, we have a common pipe situation and should issue a warning
IF (FoundAPumpOnBranch) THEN
IF (LoopSideNum == DemandSide) THEN
CALL ShowSevereError('Pressure system information was found in a demand pump (common pipe) simulation')
CALL ShowContinueError('Currently the pressure simulation is not set up to handle common pipe simulations')
CALL ShowContinueError('Either modify simulation to avoid common pipe, or remove pressure curve information')
CALL ShowFatalError('Pressure configuration mismatch causes program termination')
END IF
! If we are on the supply side, we simply hit the branch pump, so we exit the IF statement as
! we don't need to simulate the splitter or inlet branch
! For now, not doing anything will leave the IF block
END IF
!If we haven't found a pump on the parallel branches then we need to go ahead
! and simulate the splitter and inlet branch
!This may all be superfluous, if we just simulate the splitter and inlet branch we may be fine
! even if there were branch pumps found.
IF (.NOT. FoundAPumpOnBranch) THEN
!***SPLITTER SIMULATION***!
CALL PassPressureAcrossSplitter(LoopNum,LoopSideNum,SplitterInletPressure)
!*************************!
!***INLET BRANCH***!
BranchNum = 1
CALL DistributePressureOnBranch(LoopNum,LoopSideNum,BranchNum,BranchPressureDrop,FoundAPumpOnBranch)
LoopSidePressureDrop = LoopSidePressureDrop + BranchPressureDrop
LoopPressureDrop = LoopPressureDrop + BranchPressureDrop
!******************!
!***PLANT INTERFACE***!
IF (LoopSideNum == DemandSide) THEN
CALL PassPressureAcrossInterface(LoopNum)
END IF
!*********************!
END IF
END IF
PlantLoop(LoopNum)%LoopSide(LoopSideNum)%PressureDrop = LoopSidePressureDrop
END DO !LoopSides on this loop
PlantLoop(LoopNum)%PressureDrop = LoopPressureDrop
!Now do effective K value calculations
EffectiveLoopKValue = 0.0d0
DO LoopSideNum = DemandSide, SupplySide
EffectiveLoopSideKValue = 0.0d0
!Always take the first branch K, it may be the only branch on this half loop
EffectiveLoopSideKValue = EffectiveLoopSideKValue + PlantLoop(LoopNum)%LoopSide(LoopSideNum)%Branch(1)%PressureEffectiveK
!If there is only one branch then move to the other loop side
IF (SIZE(PlantLoop(LoopNum)%LoopSide(LoopSideNum)%Branch).EQ.1) CYCLE
!Add parallel branches if necessary by adding them as SUM(1/(sqrt(K_i)))
TempVal_SumOfOneByRootK = 0.0d0
DO BranchNum = 2, SIZE(PlantLoop(LoopNum)%LoopSide(LoopSideNum)%Branch)-1
!Only add this branch if the K value is non-zero
IF (PlantLoop(LoopNum)%LoopSide(LoopSideNum)%Branch(BranchNum)%PressureEffectiveK .GT. 0.0d0) THEN
TempVal_SumOfOneByRootK = TempVal_SumOfOneByRootK &
+ (1.0d0 / SQRT(PlantLoop(LoopNum)%LoopSide(LoopSideNum)%Branch(BranchNum)%PressureEffectiveK))
END IF
END DO
!Add parallel branches if they are greater than zero, by taking the sum and performing (1/(SUM^2))
IF (TempVal_SumOfOneByRootK .GT. 0.0d0) &
EffectiveLoopSideKValue = EffectiveLoopSideKValue + (1.0d0/(TempVal_SumOfOneByRootK ** 2))
!Always take the last branch K, it will be in series
BranchNum = SIZE(PlantLoop(LoopNum)%LoopSide(LoopSideNum)%Branch)
EffectiveLoopSideKValue = EffectiveLoopSideKValue + &
PlantLoop(LoopNum)%LoopSide(LoopSideNum)%Branch(BranchNum)%PressureEffectiveK
!Assign this loop side's K-value
PlantLoop(LoopNum)%LoopSide(LoopSideNum)%PressureEffectiveK = EffectiveLoopSideKValue
!Keep adding the overall loop K-value
EffectiveLoopKValue = EffectiveLoopKValue + EffectiveLoopSideKValue
END DO
!Assign this loop's K-value
PlantLoop(LoopNum)%PressureEffectiveK = EffectiveLoopKValue
RETURN
END SUBROUTINE UpdatePressureDrop