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 | |||
logical, | intent(in) | :: | FirstHVACIteration |
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.
Type | Attributes | Name | Initial | |||
---|---|---|---|---|---|---|
real | :: | PipeErrorEncountered = .TRUE. |
SUBROUTINE InitPressureDrop(LoopNum, FirstHVACIteration)
! SUBROUTINE INFORMATION:
! AUTHOR Edwin Lee
! DATE WRITTEN August 2009
! MODIFIED na
! RE-ENGINEERED na
! PURPOSE OF THIS SUBROUTINE:
! Initializes output variables and data structure
! On FirstHVAC, updates the demand inlet node pressure
! METHODOLOGY EMPLOYED:
! General EnergyPlus Methodology
! REFERENCES:
! na
! USE STATEMENTS:
USE DataPlant, ONLY : PlantLoop, DemandSide, SupplySide, Press_NoPressure, CommonPipe_No
USE DataEnvironment, ONLY : StdBaroPress
USE DataLoopNode, ONLY : Node
IMPLICIT NONE ! Enforce explicit typing of all variables in this routine
! SUBROUTINE ARGUMENT DEFINITIONS:
INTEGER, INTENT(IN) :: LoopNum
LOGICAL, INTENT(IN) :: FirstHVACIteration
! SUBROUTINE PARAMETER DEFINITIONS:
INTEGER, PARAMETER :: LoopType_Plant = 1
INTEGER, PARAMETER :: LoopType_Condenser = 2
! INTERFACE BLOCK SPECIFICATIONS:
! na
! DERIVED TYPE DEFINITIONS:
! na
! SUBROUTINE LOCAL VARIABLE DECLARATIONS:
!Initialization Variables
LOGICAL, SAVE :: OneTimeInit = .TRUE.
LOGICAL, SAVE, ALLOCATABLE, DIMENSION(:) :: LoopInit
!Simulation Variables
LOGICAL :: ErrorsFound
INTEGER :: LoopSideNum
INTEGER :: CompNum
INTEGER :: BranchNum
INTEGER :: NumBranches
INTEGER :: BranchPressureTally
LOGICAL :: SeriesPressureComponentFound
LOGICAL, DIMENSION(2) :: FullParallelBranchSetFound
LOGICAL, SAVE :: CommonPipeErrorEncountered = .FALSE.
IF (OneTimeInit) THEN
!First allocate the initialization array to each plant loop
ALLOCATE(LoopInit(SIZE(PlantLoop)))
LoopInit = .TRUE.
OneTimeInit = .FALSE.
END IF
! CurrentModuleObject='Curve:Functional:PressureDrop'
IF (LoopInit(LoopNum)) THEN
!Initialize
ErrorsFound = .FALSE.
FullParallelBranchSetFound = .FALSE.
SeriesPressureComponentFound = .FALSE.
!Need to go along plant loop and set up component pressure drop data structure!
DO LoopSideNum = DemandSide, SupplySide
!Loop through all branches on this loop side
DO BranchNum = 1, SIZE(PlantLoop(LoopNum)%LoopSide(LoopSideNum)%Branch)
!If this branch has valid pressure drop data
IF (PlantLoop(LoopNum)%LoopSide(LoopSideNum)%Branch(BranchNum)%PressureCurveIndex .GT. 0) THEN
!Update flags for higher level structure
PlantLoop(LoopNum)%LoopSide(LoopSideNum)%Branch(BranchNum)%HasPressureComponents = .TRUE.
PlantLoop(LoopNum)%LoopSide(LoopSideNum)%HasPressureComponents = .TRUE.
PlantLoop(LoopNum)%HasPressureComponents = .TRUE.
!Setup output variable
CALL SetupOutputVariable('Plant Branch Pressure Difference [Pa]', &
PlantLoop(LoopNum)%LoopSide(LoopSideNum)%Branch(BranchNum)%PressureDrop &
,'Plant','Average', PlantLoop(LoopNum)%LoopSide(LoopSideNum)%Branch(BranchNum)%Name)
END IF
END DO
!Set up loopside level variables if applicable
IF (PlantLoop(LoopNum)%LoopSide(LoopSideNum)%HasPressureComponents) THEN
IF (LoopSideNum==DemandSide) THEN
CALL SetupOutputVariable('Plant Demand Side Loop Pressure Difference [Pa]', &
PlantLoop(LoopNum)%LoopSide(LoopSideNum)%PressureDrop &
,'Plant','Average', PlantLoop(LoopNum)%Name)
ELSE IF (LoopSideNum==SupplySide) THEN
CALL SetupOutputVariable('Plant Supply Side Loop Pressure Difference [Pa]', &
PlantLoop(LoopNum)%LoopSide(LoopSideNum)%PressureDrop &
,'Plant','Average', PlantLoop(LoopNum)%Name)
END IF
END IF
END DO
IF (PlantLoop(LoopNum)%HasPressureComponents) THEN
!Set up loop level variables if applicable
CALL SetupOutputVariable('Plant Loop Pressure Difference [Pa]', &
PlantLoop(LoopNum)%PressureDrop &
,'Plant','Average', PlantLoop(LoopNum)%Name)
!Check for illegal configurations on this plant loop
DO LoopSideNum = DemandSide, SupplySide
!Check for illegal parallel branch setups
BranchPressureTally = 0
NumBranches = SIZE(PlantLoop(LoopNum)%LoopSide(LoopSideNum)%Branch)
IF (NumBranches.GT.2) THEN
DO BranchNum = 2, NumBranches-1
IF (PlantLoop(LoopNum)%LoopSide(LoopSideNum)%Branch(BranchNum)%HasPressureComponents) THEN
PlantLoop(LoopNum)%LoopSide(LoopSideNum)%HasParallelPressComps = .TRUE.
BranchPressureTally = BranchPressureTally + 1
END IF
END DO
END IF
IF (BranchPressureTally == 0) THEN
!no parallel branches, ok for this check
ELSE IF (BranchPressureTally == SIZE(PlantLoop(LoopNum)%LoopSide(LoopSideNum)%Branch)-2) THEN
!all parallel branches have pressure components
FullParallelBranchSetFound(LoopSideNum) = .TRUE.
ELSE
!we aren't ok
CALL ShowSevereError('Pressure drop component configuration error detected on loop: '//PlantLoop(LoopNum)%Name)
CALL ShowContinueError('Pressure drop components must be on ALL or NONE of the parallel branches.')
CALL ShowContinueError('Partial distribution is not allowed.')
ErrorsFound = .TRUE.
END IF
IF (PlantLoop(LoopNum)%LoopSide(LoopSideNum)%Branch(1)%HasPressureComponents .OR. &
PlantLoop(LoopNum)%LoopSide(LoopSideNum)%Branch(NumBranches)%HasPressureComponents) THEN
!we have a series component pressure branch (whether a single branch half loop or mixer/splitter setup
SeriesPressureComponentFound = .TRUE.
END IF
END DO
!Check for full path pressure data
IF(ANY(FullParallelBranchSetFound) .OR. (SeriesPressureComponentFound))THEN
!we are fine, either way we will always have a path with at least one pressure component hit
ELSE
CALL ShowSevereError('Pressure drop component configuration error detected on loop: '//PlantLoop(LoopNum)%Name)
CALL ShowContinueError('The loop has at least one fluid path which does not encounter a pressure component.')
CALL ShowContinueError('Either use at least one serial component for pressure drop OR all possible parallel paths')
CALL ShowContinueError('must be pressure drop components.')
ErrorsFound = .TRUE.
END IF !valid pressure path
END IF !Has pressure components
IF (ErrorsFound) Call ShowFatalError('Preceding errors cause program termination')
!Also issue one time warning if there is a mismatch between plant loop simulation type and whether objects were entered
IF (PlantLoop(LoopNum)%HasPressureComponents .AND. (PlantLoop(LoopNum)%PressureSimType == Press_NoPressure)) THEN
!Then we found pressure components on the branches, but the plant loop said it didn't want to do pressure simulation
CALL ShowWarningError('Error for pressure simulation on plant loop: '//PlantLoop(LoopNum)%Name)
CALL ShowContinueError('Plant loop contains pressure simulation components on the branches,')
CALL ShowContinueError(' yet in the PlantLoop object, there is no pressure simulation specified.')
CALL ShowContinueError('Simulation continues, ignoring pressure simulation data.')
ELSE IF ((.NOT. PlantLoop(LoopNum)%HasPressureComponents) .AND. (PlantLoop(LoopNum)%PressureSimType .NE. Press_NoPressure)) THEN
!Then we don't have any pressure components on the branches, yet the plant loop wants to do some sort of pressure simulation
CALL ShowWarningError('Error for pressure simulation on plant loop: '//PlantLoop(LoopNum)%Name)
CALL ShowContinueError('Plant loop is requesting a pressure simulation,')
CALL ShowContinueError(' yet there are no pressure simulation components detected on any of the branches in that loop.')
CALL ShowContinueError('Simulation continues, ignoring pressure simulation data.')
END IF
LoopInit(LoopNum) = .FALSE.
END IF !LoopInit = TRUE
!Initialize the entire plant loop to the outdoor pressure if that loop has data
!This value at the demand side outlet node will be used as a starting reference point
! for pressure calcs
!The value is smeared across the loop, however, so that any nodes before a pump will
! have a proper value for pressure
IF (PlantLoop(LoopNum)%HasPressureComponents .AND. FirstHVACIteration) THEN
DO LoopSideNum = DemandSide, SupplySide
DO BranchNum = 1, SIZE(PlantLoop(LoopNum)%LoopSide(LoopSideNum)%Branch)
DO CompNum = 1, SIZE(PlantLoop(LoopNum)%LoopSide(LoopSideNum)%Branch(BranchNum)%Comp)
Node(PlantLoop(LoopNum)%LoopSide(LoopSideNum)%Branch(BranchNum)%Comp(CompNum)%NodeNumIn)%Press=StdBaroPress
Node(PlantLoop(LoopNum)%LoopSide(LoopSideNum)%Branch(BranchNum)%Comp(CompNum)%NodeNumOut)%Press=StdBaroPress
END DO
END DO
END DO
END IF
!Now tell the pump routine whether or not to use the pressure data to calculate power
IF (PlantLoop(LoopNum)%HasPressureComponents) THEN
IF (FirstHVACIteration) THEN
PlantLoop(LoopNum)%UsePressureForPumpCalcs = .FALSE.
ELSE
PlantLoop(LoopNum)%UsePressureForPumpCalcs = .TRUE.
END IF
ELSE !No Pressure Components
PlantLoop(LoopNum)%UsePressureForPumpCalcs = .FALSE.
END IF
!Before we leave, override any settings in case we are doing common pipe simulation
IF (PlantLoop(LoopNum)%HasPressureComponents) THEN
!We need to make sure we aren't doing an invalid configuration here
IF (PlantLoop(LoopNum)%CommonPipeType .NE. CommonPipe_No) THEN
!There is a common pipe!
IF (.NOT. CommonPipeErrorEncountered) THEN
CALL ShowSevereError('Invalid pressure simulation configuration for Plant Loop='//TRIM(PlantLoop(LoopNum)%Name))
CALL ShowContinueError('Currently pressure simulations cannot be performed for loops with common pipes.')
CALL ShowContinueError('To repair, either remove the common pipe simulation, or remove the pressure simulation.')
CALL ShowContinueError('The simulation will continue, but the pump power is not updated with pressure drop data.')
CALL ShowContinueError('Check all results including node pressures to ensure proper simulation.')
CALL ShowContinueError('This message is reported once, but may have been encountered in multiple loops.')
CommonPipeErrorEncountered = .TRUE.
END IF
PlantLoop(LoopNum)%UsePressureForPumpCalcs = .FALSE.
END IF
END IF
END SUBROUTINE InitPressureDrop