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) | :: | LoopSideNum | |||
integer, | intent(in) | :: | FirstBranchNum | |||
integer, | intent(in) | :: | LastBranchNum | |||
real(kind=r64), | intent(in) | :: | FlowRequest | |||
logical, | intent(in) | :: | FirstHVACIteration | |||
logical, | intent(inout) | :: | LoopShutDownFlag | |||
logical, | intent(in), | optional | :: | StartingNewLoopSidePass |
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 SimulateLoopSideBranchGroup(LoopNum, LoopSideNum, FirstBranchNum, LastBranchNum, FlowRequest, &
FirstHVACIteration, LoopShutDownFlag, StartingNewLoopSidePass)
! SUBROUTINE INFORMATION:
! AUTHOR Edwin Lee
! DATE WRITTEN July 2010
! MODIFIED na
! RE-ENGINEERED na
! PURPOSE OF THIS SUBROUTINE:
! This routine will manage the component simulation on a single set of parallel branches
! This routine also reverts to a single branch simulation if there is "only one parallel" branch
! METHODOLOGY EMPLOYED:
! Loop through all components, and simulate first the non-load range based on each branch.
! When a load-range based (LRB) is encountered, the simulation moves to the next branch to do non-LRB components.
! When all paths are exhausted the simulation begins simulating LRB components. Before each comp, the load distribution
! engine is called to handle the load distribution for this current pass. If load is successfully distributed, this is
! flagged, and not called again. If load is not distributed (i.e. this component isn't ON right now), then the
! load distribution engine will be called again before the next component.
! After all load distribution is done and those components are complete, the simulation moves back to do any
! remaining components that may be downstream.
! USE STATEMENTS:
USE DataPlant, ONLY: PlantLoop, DemandOpSchemeType, PumpOpSchemeType, LoadRangeBasedMin, LoadRangeBasedMax, &
FlowLocked, NoControlOpSchemeType, CompSetPtBasedSchemeType, FreeRejectionOpSchemeType, &
WSEconOpSchemeType, UnknownStatusOpSchemeType, PressureCall_Calc, EMSOpSchemeType, SupplySide
USE DataLoopNode, ONLY: Node
USE PlantCondLoopOperation, ONLY: ManagePlantLoadDistribution
USE PlantLoopEquip, ONLY: SimPlantEquip
USE PlantPressureSystem, ONLY: SimPressureDropSystem
USE General, ONLY: TrimSigDigits
IMPLICIT NONE ! Enforce explicit typing of all variables in this routine
! SUBROUTINE ARGUMENT DEFINITIONS:
INTEGER, INTENT(IN) :: LoopNum
INTEGER, INTENT(IN) :: LoopSideNum
INTEGER, INTENT(IN) :: FirstBranchNum
INTEGER, INTENT(IN) :: LastBranchNum
REAL(r64), INTENT(IN) :: FlowRequest
LOGICAL, INTENT(IN) :: FirstHVACIteration
LOGICAL, INTENT(INOUT) :: LoopShutDownFlag
LOGICAL, INTENT(IN), OPTIONAL :: StartingNewLoopSidePass
! SUBROUTINE LOCAL VARIABLE DECLARATIONS:
!~ History values
INTEGER, SAVE :: LastLoopNum = -1
INTEGER, SAVE :: LastLoopSideNum = -1
INTEGER, SAVE :: LastFirstBranchNum = -1
INTEGER, SAVE :: LastLastBranchNum = -1
!~ Indexing variables
INTEGER :: BranchCounter !~ This contains the index for the %Branch(:) structure
INTEGER :: BranchIndex !~ This is a 1 - n value within the current branch group
INTEGER :: CompCounter !~ This contains the index for the %Comp(:) structure
INTEGER :: StartingComponent
INTEGER :: EndingComponent
INTEGER :: NumBranchesInRegion
!~ Flags
LOGICAL, SAVE :: EncounteredLRBObjDuringPass1
LOGICAL, SAVE :: EncounteredNonLBObjDuringPass2
LOGICAL, SAVE :: EncounteredAnyLRBObjects
LOGICAL :: LoadDistributionWasPerformed
LOGICAL :: DummyInit
LOGICAL, PARAMETER :: DoNotGetCompSizFac = .FALSE.
CHARACTER(len=6), PARAMETER, DIMENSION(2) :: LoopSideNames = (/'Demand','Supply'/)
!~ General variables
TYPE (Location), DIMENSION(:), ALLOCATABLE, SAVE :: AccessibleBranches
INTEGER, DIMENSION(:), ALLOCATABLE, SAVE :: LastComponentSimulated
REAL(r64) :: LoadToLoopSetPoint
TYPE(Location) :: PumpLocation
INTEGER :: curCompOpSchemePtr
INTEGER :: OpSchemePtr
!~ Debug variables
! We only need to reallocate the accessible array and reset the LastComponentSimulated if
! either is currently NOT allocated, or if we are coming into this routine with a
! new simulation region. Otherwise leave it alone and save computation time
IF ( (.NOT. ALLOCATED(AccessibleBranches)) &
.OR. (.NOT. ALLOCATED(LastComponentSimulated)) &
.OR. (LoopNum .NE. LastLoopNum) &
.OR. (LoopSideNum .NE. LastLoopSideNum) &
.OR. (FirstBranchNum .NE. LastFirstBranchNum) &
.OR. (LastBranchNum .NE. LastLastBranchNum) &
.OR. (PRESENT(StartingNewLoopSidePass)) &
) THEN !we need to reallocate the accessible branch array
! How many will we need?
NumBranchesInRegion = LastBranchNum - FirstBranchNum + 1
! Release the memory for the arrays to reset
IF(ALLOCATED(AccessibleBranches)) DEALLOCATE(AccessibleBranches)
IF(ALLOCATED(LastComponentSimulated)) DEALLOCATE(LastComponentSimulated)
! Reallocate for the number of locations we have available
ALLOCATE(AccessibleBranches(NumBranchesInRegion))
ALLOCATE(LastComponentSimulated(NumBranchesInRegion))
LastComponentSimulated = 0
BranchIndex = 0
DO BranchCounter = FirstBranchNum, LastBranchNum
BranchIndex = BranchIndex + 1
AccessibleBranches(BranchIndex)%LoopNum = LoopNum
AccessibleBranches(BranchIndex)%LoopSideNum = LoopSideNum
AccessibleBranches(BranchIndex)%BranchNum = BranchCounter
END DO
END IF
! Store the arguments for the next call
LastLoopNum = LoopNum
LastLoopSideNum = LoopSideNum
LastFirstBranchNum = FirstBranchNum
LastLastBranchNum = LastBranchNum
! Initialize this flag to false every time so we can call other routines
DummyInit = .FALSE.
! If we are starting a new loop side, we need to initialize the encountered object
IF (PRESENT(StartingNewLoopSidePass)) THEN
EncounteredLRBObjDuringPass1 = .FALSE.
EncounteredNonLBObjDuringPass2 = .FALSE.
EncounteredAnyLRBObjects = .FALSE.
END IF
! We now know what plant simulation region is available to us, let's simulate this group
EncounteredLRBObjDuringPass1 = .FALSE.
BranchIndex = 0
DO BranchCounter = FirstBranchNum, LastBranchNum
BranchIndex = BranchIndex + 1
!~ Always start from the last component we did the last time around + 1 and
!~ try to make it all the way to the end of the loop
StartingComponent = LastComponentSimulated(BranchIndex) + 1
EndingComponent = PlantLoop(LoopNum)%LoopSide(LoopSideNum)%Branch(BranchCounter)%TotalComponents
DO CompCounter = StartingComponent, EndingComponent
SELECT CASE (PlantLoop(LoopNum)%LoopSide(LoopSideNum)%Branch(BranchCounter)%Comp(CompCounter)%CurOpSchemeType)
CASE (WSEconOpSchemeType) !~ coils
PlantLoop(LoopNum)%LoopSide(LoopSideNum)%Branch(BranchCounter)%Comp(CompCounter)%MyLoad = UpdatedDemandToLoopSetPoint
CALL SimPlantEquip(LoopNum,LoopSideNum,BranchCounter,CompCounter,FirstHVACIteration,DummyInit,DoNotGetCompSizFac)
CASE (LoadRangeBasedMin:LoadRangeBasedMax) !~ load range based
EncounteredLRBObjDuringPass1 = .TRUE.
EXIT ! don't do any more components on this branch
CASE (PumpOpSchemeType) !~ pump
PumpLocation%LoopNum = LoopNum
PumpLocation%LoopSideNum = LoopSideNum
PumpLocation%BranchNum = BranchCounter
PumpLocation%CompNum = CompCounter
IF (PlantLoop(LoopNum)%LoopSide(LoopSideNum)%BranchPumpsExist) THEN
CALL SimulateAllLoopSidePumps(LoopNum, LoopSideNum, &
SpecificPumpLocation = PumpLocation, &
SpecificPumpFlowRate = &
PlantLoop(LoopNum)%LoopSide(LoopSideNum)%Branch(BranchCounter)%RequestedMassFlow)
ELSE
CALL SimulateAllLoopSidePumps(LoopNum, LoopSideNum, &
SpecificPumpLocation = PumpLocation, &
SpecificPumpFlowRate = FlowRequest)
ENDIF
CASE (CompSetPtBasedSchemeType)
CALL ManagePlantLoadDistribution(LoopNum,LoopSideNum, BranchCounter, CompCounter, LoadToLoopSetPoint, &
LoadToLoopSetPointThatWasntMet, FirstHVACIteration, LoopShutDownFlag, &
LoadDistributionWasPerformed)
CALL SimPlantEquip(LoopNum,LoopSideNum,BranchCounter,CompCounter,FirstHVACIteration,DummyInit,DoNotGetCompSizFac)
CASE ( EMSOpSchemeType )
IF (LoopSideNum == SupplySide) THEN
curCompOpSchemePtr = PlantLoop(LoopNum)%LoopSide(LoopSideNum)%Branch(BranchCounter)%Comp(CompCounter)%CurCompLevelOpNum
OpSchemePtr = PlantLoop(LoopNum)%LoopSide(LoopSideNum)%Branch(BranchCounter)%&
Comp(CompCounter)%OpScheme(curCompOpSchemePtr)%OpSchemePtr
PlantLoop(LoopNum)%OpScheme(OpSchemePtr)%EMSIntVarLoopDemandRate = InitialDemandToLoopSetPoint
ENDIF
CALL ManagePlantLoadDistribution(LoopNum,LoopSideNum, BranchCounter, CompCounter, UpdatedDemandToLoopSetPoint, &
LoadToLoopSetPointThatWasntMet, FirstHVACIteration, LoopShutDownFlag, &
LoadDistributionWasPerformed)
CALL SimPlantEquip(LoopNum,LoopSideNum,BranchCounter,CompCounter,FirstHVACIteration,DummyInit,DoNotGetCompSizFac)
CASE DEFAULT !demand, , etc.
CALL SimPlantEquip(LoopNum,LoopSideNum,BranchCounter,CompCounter,FirstHVACIteration,DummyInit,DoNotGetCompSizFac)
END SELECT
! Update loop demand as needed for changes this component may have made
CALL UpdateAnyLoopDemandAlterations(LoopNum, LoopSideNum, BranchCounter, CompCounter)
!~ If we didn't EXIT early, we must have simulated, so update array
LastComponentSimulated(BranchIndex) = CompCounter
END DO !~ CompCounter
IF (PlantLoop(LoopNum)%LoopSide(LoopSideNum)%FlowLock == FlowLocked) THEN
CALL SimPressureDropSystem(LoopNum, FirstHVACIteration, PressureCall_Calc, LoopSideNum, BranchCounter)
END IF
END DO !~ BranchCounter
! So now we have made one pass through all of the available components on these branches, skipping load based
! If we didn't encounter any load based objects during the first pass, then we must be done!
IF (.NOT. EncounteredLRBObjDuringPass1) RETURN
! If we have load based now, we should go ahead and distribute the load
! If not then this branch group is done, since flow path validation was previously done
LoadToLoopSetPoint = UpdatedDemandToLoopSetPoint
LoadDistributionWasPerformed = .FALSE.
! The way the load distribution is set up, I think I should call this for every load range based component
! encountered until distribution is actually performed. If we don't call for each component then we may
! call for a component that is not on the current equip list and then nothing would come on.
EncounteredNonLBObjDuringPass2 = .FALSE.
BranchIndex = 0
DO BranchCounter = FirstBranchNum, LastBranchNum
BranchIndex = BranchIndex + 1
!~ Always start from the last component we did the last time around + 1 and
!~ try to make it all the way to the end of the loop
StartingComponent = LastComponentSimulated(BranchIndex) + 1
EndingComponent = PlantLoop(LoopNum)%LoopSide(LoopSideNum)%Branch(BranchCounter)%TotalComponents
DO CompCounter = StartingComponent, EndingComponent
SELECT CASE (PlantLoop(LoopNum)%LoopSide(LoopSideNum)%Branch(BranchCounter)%Comp(CompCounter)%CurOpSchemeType)
CASE (NoControlOpSchemeType) !~ pipes, for example
CALL SimPlantEquip(LoopNum,LoopSideNum,BranchCounter,CompCounter,FirstHVACIteration,DummyInit,DoNotGetCompSizFac)
CASE (DemandOpSchemeType, CompSetPtBasedSchemeType, FreeRejectionOpSchemeType) !~ other control types
EncounteredNonLBObjDuringPass2 = .TRUE.
EXIT ! don't do anymore components on this branch
CASE (LoadRangeBasedMin:LoadRangeBasedMax) !~ load range based
EncounteredAnyLRBObjects = .TRUE.
IF (.NOT. LoadDistributionWasPerformed) THEN !~ Still need to distribute load among load range based components
CALL ManagePlantLoadDistribution(LoopNum,LoopSideNum, BranchCounter, CompCounter, LoadToLoopSetPoint, &
LoadToLoopSetPointThatWasntMet, FirstHVACIteration, LoopShutDownFlag, &
LoadDistributionWasPerformed)
END IF
CALL SimPlantEquip(LoopNum,LoopSideNum,BranchCounter,CompCounter,FirstHVACIteration,DummyInit,DoNotGetCompSizFac)
CASE (PumpOpSchemeType) !~ pump
PumpLocation%LoopNum = LoopNum
PumpLocation%LoopSideNum = LoopSideNum
PumpLocation%BranchNum = BranchCounter
PumpLocation%CompNum = CompCounter
IF (PlantLoop(LoopNum)%LoopSide(LoopSideNum)%BranchPumpsExist) THEN
CALL SimulateAllLoopSidePumps(LoopNum, LoopSideNum, &
SpecificPumpLocation = PumpLocation, &
SpecificPumpFlowRate = &
PlantLoop(LoopNum)%LoopSide(LoopSideNum)%Branch(BranchCounter)%RequestedMassFlow)
ELSE
CALL SimulateAllLoopSidePumps(LoopNum, LoopSideNum, &
SpecificPumpLocation = PumpLocation, &
SpecificPumpFlowRate = FlowRequest)
ENDIF
END SELECT
!~ If we didn't EXIT early, we must have simulated, so update array
LastComponentSimulated(BranchIndex) = CompCounter
END DO !~ CompCounter
!~ If we are locked, go ahead and simulate the pressure components on this branch
IF (PlantLoop(LoopNum)%LoopSide(LoopSideNum)%FlowLock == FlowLocked) THEN
CALL SimPressureDropSystem(LoopNum, FirstHVACIteration, PressureCall_Calc, LoopSideNum, BranchCounter)
END IF
END DO !~ BranchCounter
! So now we have made the load range based pass through all the components on each branch
! If we didn't see any other component types, then we are done, go away
IF (.NOT. EncounteredNonLBObjDuringPass2) RETURN
! If we did encounter other objects than we just need to go back through and simulate them
BranchIndex = 0
DO BranchCounter = FirstBranchNum, LastBranchNum
BranchIndex = BranchIndex + 1
!~ Always start from the last component we did the last time around + 1 and
!~ try to make it all the way to the end of the loop
StartingComponent = LastComponentSimulated(BranchIndex) + 1
EndingComponent = PlantLoop(LoopNum)%LoopSide(LoopSideNum)%Branch(BranchCounter)%TotalComponents
DO CompCounter = StartingComponent, EndingComponent
SELECT CASE (PlantLoop(LoopNum)%LoopSide(LoopSideNum)%Branch(BranchCounter)%Comp(CompCounter)%CurOpSchemeType)
CASE (DemandOpSchemeType) !~ coils
CALL SimPlantEquip(LoopNum,LoopSideNum,BranchCounter,CompCounter,FirstHVACIteration,DummyInit,DoNotGetCompSizFac)
CASE (LoadRangeBasedMin:LoadRangeBasedMax) !~ load range based
CALL ShowFatalError('Encountered Load Based Object after other components, invalid.')
CASE (PumpOpSchemeType) !~ pump
PumpLocation%LoopNum = LoopNum
PumpLocation%LoopSideNum = LoopSideNum
PumpLocation%BranchNum = BranchCounter
PumpLocation%CompNum = CompCounter
IF (PlantLoop(LoopNum)%LoopSide(LoopSideNum)%BranchPumpsExist) THEN
CALL SimulateAllLoopSidePumps(LoopNum, LoopSideNum, &
SpecificPumpLocation = PumpLocation, &
SpecificPumpFlowRate = &
PlantLoop(LoopNum)%LoopSide(LoopSideNum)%Branch(BranchCounter)%RequestedMassFlow)
ELSE
CALL SimulateAllLoopSidePumps(LoopNum, LoopSideNum, &
SpecificPumpLocation = PumpLocation, &
SpecificPumpFlowRate = FlowRequest)
ENDIF
CASE DEFAULT !~ Typical control equipment
CALL SimPlantEquip(LoopNum,LoopSideNum,BranchCounter,CompCounter,FirstHVACIteration,DummyInit,DoNotGetCompSizFac)
END SELECT
!~ If we didn't EXIT early, we must have simulated, so update array
LastComponentSimulated(BranchIndex) = CompCounter
END DO !~ CompCounter
IF (PlantLoop(LoopNum)%LoopSide(LoopSideNum)%FlowLock == FlowLocked) THEN
CALL SimPressureDropSystem(LoopNum, FirstHVACIteration, PressureCall_Calc, LoopSideNum, BranchCounter)
END IF
END DO !~ BranchCounter
! I suppose I could do a check on the last component simulated to make sure we actually exhausted all branches
! This would be the "THIRD" check on flow validation, but would be OK
RETURN
END SUBROUTINE SimulateLoopSideBranchGroup