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.
***what else do we do with 'uncontrolled' equipment?
Type | Intent | Optional | Attributes | Name | ||
---|---|---|---|---|---|---|
integer, | intent(in) | :: | LoopNum | |||
integer, | intent(in) | :: | LoopSideNum | |||
integer, | intent(in) | :: | BranchNum | |||
integer, | intent(in) | :: | CompNum | |||
real(kind=r64), | intent(inout) | :: | LoopDemand | |||
real(kind=r64), | intent(inout) | :: | RemLoopDemand | |||
logical, | intent(in) | :: | FirstHVACIteration | |||
logical, | intent(inout) | :: | LoopShutDownFlag | |||
logical, | intent(inout), | optional | :: | LoadDistributionWasPerformed |
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 ManagePlantLoadDistribution(LoopNum,LoopSideNum, BranchNum, CompNum, LoopDemand,RemLoopDemand,FirstHVACIteration, &
LoopShutDownFlag,LoadDistributionWasPerformed)
! SUBROUTINE INFORMATION:
! AUTHOR: Dan Fisher
! DATE WRITTEN: April 1999
! REVISED: March 2001
! July 2001, Rick Strand (revision of pump and loop control code)
! July 2010, Dan Fisher, complete rewrite to component based control
! PURPOSE OF THIS SUBROUTINE:
! ManageLoopOperation is the driver routine
! for plant equipment selection. It calls the general "Get-
! Input" routines, initializes the loop pointers, then calls the
! appropriate type of control algorithm (setpoint, load range based,
! or uncontrolled) for the component
! METHODOLOGY EMPLOYED:
! na
! REFERENCES:
! na
! USE STATEMENTS:
USE DataEnvironment, ONLY: OutWetBulbTemp, OutDryBulbTemp, OutDewPointTemp, OutRelHum ! Current outdoor relative humidity [%]
USE General, ONLY: RoundSigDigits
IMPLICIT NONE ! Enforce explicit typing of all variables in this routine
! SUBROUTINE ARGUMENT DEFINITIONS:
REAL(r64) , INTENT(INOUT) :: LoopDemand
REAL(r64) , INTENT(INOUT) :: RemLoopDemand
INTEGER, INTENT(IN) :: LoopNum ! PlantLoop data structure loop counter
INTEGER, INTENT(IN) :: LoopSideNum ! PlantLoop data structure loopside counter
INTEGER, INTENT(IN) :: BranchNum ! PlantLoop data structure branch counter
INTEGER, INTENT(IN) :: CompNum ! PlantLoop data structure component counter
LOGICAL, INTENT(IN) :: FirstHVACIteration
LOGICAL, INTENT(IN OUT) :: LoopShutDownFlag !EMS flag to tell loop solver to shut down pumps
LOGICAL, INTENT(IN OUT), OPTIONAL :: LoadDistributionWasPerformed
! SUBROUTINE PARAMETER DEFINITIONS:
! na
! INTERFACE BLOCK SPECIFICATIONS
! na
! DERIVED TYPE DEFINITIONS
! na
! SUBROUTINE LOCAL VARIABLE DECLARATIONS:
INTEGER :: ListNum !DO loop index in PlantLoop()%LoopSide()%Branch()%Comp()%Opscheme()%EquipList(ListNum)
INTEGER :: CurListNum !Current list...= ListNum, used for error checking only
!Indices in PlantLoop()%LoopSide()%Branch()%Comp() data structure
INTEGER :: CurCompLevelOpNum !This is set by the init routine at each FirstHVACIteration.
!It tells which scheme for this component is currently scheduled
!and is used to avoid a 'schedule search' on each call
!It is used as the Opscheme index in PL()%LoopSide()%Branch()%Comp()%Opscheme(CurCompLevelOpNum)
!Value of pointers held in PlantLoop()%LoopSide()%Branch()%Comp() data structure
!Used as indices in PlantLoop()%OpScheme() data structure
INTEGER :: CurSchemePtr !set by PL()%LoopSide()%Branch()%Comp()%Opscheme(CurCompLevelOpNum)%OpSchemePtr
!used to locate data in PL()%Opscheme(CurSchemePtr)
INTEGER :: ListPtr !!set by PL()%LoopSide()%Branch()%Comp()%Opscheme(CurCompLevelOpNum)%EquipList(CurListNum)ListPtr
!used to locate data in PL()%Opscheme(CurSchemePtr)%EquipList(ListPtr)
!Local values from the PlantLoop()%OpScheme() data structure
CHARACTER(len=MaxNameLength) :: CurSchemeTypeName !current operation scheme type
CHARACTER(len=MaxNameLength) :: CurSchemeName !current operation scheme name
INTEGER :: CurSchemeType !identifier set in PlantData
REAL(r64) :: RangeVariable !holds the 'loop demand', wetbulb temp, etc.
REAL(r64) :: TestRangeVariable ! abs of RangeVariable for logic tests etc.
REAL(r64) :: RangeHiLimit !upper limit of the range variable
REAL(r64) :: RangeLoLimit !lower limit of the range variable
!Local values from the PlantLoop()%LoopSide()%Branch()%Comp() data structure
INTEGER :: NumEquipLists !number of equipment lists
!Error control flags
LOGICAL :: foundlist !equipment list found
LOGICAL :: UpperLimitTooLow ! error processing
REAL(r64) :: HighestRange ! error processing
INTEGER, SAVE :: TooLowIndex=0 ! error processing
INTEGER, SAVE :: NotTooLowIndex=0 ! error processing
!INTEGER , SAVE :: ErrCount = 0 !number of errors
!CHARACTER(len=20) :: CharErrOut !Error message
INTEGER :: NumCompsOnList
INTEGER :: CompIndex
INTEGER :: EquipBranchNum
INTEGER :: EquipCompNum
!Shut down equipment and return if so instructed by LoopShutdownFlag
IF(LoopShutdownFlag)THEN
CALL TurnOffLoopEquipment(LoopNum)
RETURN
ENDIF
!Return if there are no loop operation schemes available
IF (.NOT. ANY(PlantLoop(LoopNum)%OpScheme%Available)) RETURN
!Implement EMS control commands
CALL ActivateEMSControls(LoopNum,LoopSideNum, BranchNum, CompNum, LoopShutDownFlag)
!Schedules are checked and CurOpScheme updated on FirstHVACIteration in InitLoadDistribution
!Here we just load CurOpScheme to a local variable
CurCompLevelOpNum = PlantLoop(LoopNum)%LoopSide(LoopSideNum)%Branch(BranchNum)%Comp(CompNum)%CurCompLevelOpNum
!If no current operation scheme for component, RETURN
IF(CurCompLevelOpNum == 0)RETURN
!set local variables from data structure
NumEquipLists = &
PlantLoop(LoopNum)%LoopSide(LoopSideNum)%Branch(BranchNum)%Comp(CompNum)%OpScheme(CurCompLevelOpNum)%NumEquipLists
CurSchemePtr = &
PlantLoop(LoopNum)%LoopSide(LoopSideNum)%Branch(BranchNum)%Comp(CompNum)%OpScheme(CurCompLevelOpNum)%OpSchemePtr
CurSchemeType = PlantLoop(LoopNum)%OpScheme(CurSchemePtr)%OpSchemeType
CurSchemeTypeName = PlantLoop(LoopNum)%OpScheme(CurSchemePtr)%TypeOf
CurSchemeName = PlantLoop(LoopNum)%OpScheme(CurSchemePtr)%Name
!Load the 'range variable' according to the type of control scheme specified
SELECT CASE(CurSchemeType)
CASE(UncontrolledOpSchemeType, CompSetPtBasedSchemeType)
CONTINUE !No RangeVariable specified for these types
CASE (EMSOpSchemeType)
CALL InitLoadDistribution(FirstHVACIteration)
CONTINUE !No RangeVariable specified for these types
CASE(HeatingRBOpSchemeType)
! For zero demand, we need to clean things out before we leave
IF (LoopDemand < SmallLoad) THEN
CALL InitLoadDistribution(FirstHVACIteration)
PlantLoop(LoopNum)%LoopSide(LoopSideNum)%Branch(BranchNum)%Comp(CompNum)%Myload = 0.d0
PlantLoop(LoopNum)%LoopSide(LoopSideNum)%Branch(BranchNum)%Comp(CompNum)%On = .FALSE.
RETURN
ENDIF
RangeVariable = LoopDemand
CASE(CoolingRBOpSchemeType)
! For zero demand, we need to clean things out before we leave
IF (LoopDemand > (-1.d0 * SmallLoad)) THEN
CALL InitLoadDistribution(FirstHVACIteration)
PlantLoop(LoopNum)%LoopSide(LoopSideNum)%Branch(BranchNum)%Comp(CompNum)%Myload = 0.d0
PlantLoop(LoopNum)%LoopSide(LoopSideNum)%Branch(BranchNum)%Comp(CompNum)%On = .FALSE.
RETURN
ENDIF
RangeVariable = LoopDemand
CASE(DryBulbRBOpSchemeType)
RangeVariable = OutDryBulbTemp
CASE(WetBulbRBOpSchemeType)
RangeVariable = OutWetBulbTemp
CASE(RelHumRBOpSchemeType)
RangeVariable = OutRelHum
CASE(DewpointRBOpSchemeType)
RangeVariable = OutDewPointTemp
CASE(DrybulbTDBOpSchemeType, WetBulbTDBOpSchemeType, DewpointTDBOpSchemeType)
RangeVariable = FindRangeVariable(LoopNum, CurSchemePtr, CurSchemeType)
CASE DEFAULT
! No controls specified. This is a fatal error
CALL ShowFatalError('Invalid Operation Scheme Type Requested='//TRIM(CurSchemeTypeName)// &
', in ManagePlantLoadDistribution')
END SELECT
!Find the proper list within the specified scheme
foundlist = .false.
IF(CurSchemeType==UncontrolledOpSchemeType)THEN
!!***what else do we do with 'uncontrolled' equipment?
!There's an equipment list...but I think the idea is to just
!Set one component to run in an 'uncontrolled' way (whatever that means!)
ELSEIF(CurSchemeType==CompSetPtBasedSchemeType)THEN
!check for EMS Control
CALL TurnOnPlantLoopPipes(LoopNum,LoopSideNum)
CALL FindCompSPLoad(LoopNum,LoopSideNum,BranchNum,CompNum,CurCompLevelOpNum)
ELSEIF(CurSchemeType==EMSOpSchemeType) THEN
CALL TurnOnPlantLoopPipes(LoopNum,LoopSideNum)
CALL DistributeUserDefinedPlantLoad(LoopNum, LoopSideNum,BranchNum,CompNum,CurCompLevelOpNum,CurSchemePtr, &
LoopDemand,RemLoopDemand )
ELSE !it's a range based control type with multiple equipment lists
CurListNum = 0
DO ListNum = 1,NumEquipLists
!setpointers to 'PlantLoop()%OpScheme()...'structure
ListPtr = PlantLoop(LoopNum)%LoopSide(LoopSideNum)%Branch(BranchNum)%Comp(CompNum)% &
OpScheme(CurCompLevelOpNum)%EquipList(ListNum)%ListPtr
RangeHiLimit=PlantLoop(LoopNum)%OpScheme(CurSchemePtr)%EquipList(ListPtr)%RangeUpperLimit
RangeLoLimit=PlantLoop(LoopNum)%OpScheme(CurSchemePtr)%EquipList(ListPtr)%RangeLowerLimit
!these limits are stored with absolute values, but the LoopDemand can be negative for cooling
TestRangeVariable = ABS(RangeVariable)
!trying to do something where the last stage still runs the equipment but at the hi limit.
IF (TestRangeVariable < RangeLoLimit .OR. TestRangeVariable > RangeHiLimit) THEN
IF ((TestRangeVariable > RangeHiLimit) .AND. &
ListPtr == (PlantLoop(LoopNum)%OpScheme(CurSchemePtr)%EquipListNumForLastStage)) THEN
! let this go thru, later AdjustChangeInLoadForLastStageUpperRangeLimit will cap dispatch to RangeHiLimit
CurListNum = ListNum
EXIT
ELSE
CYCLE
ENDIF
ELSE
CurListNum = ListNum
EXIT
ENDIF
ENDDO
IF (CurListNum > 0)THEN
! there could be equipment on another list that needs to be nulled out, it may have a load from earlier iteration
DO ListNum = 1,NumEquipLists
IF (ListNum == CurListNum ) Cycle ! leave current one alone
NumCompsOnList = PlantLoop(LoopNum)%OpScheme(CurSchemePtr)%EquipList(ListNum)%NumComps
DO CompIndex =1, NumCompsOnList
EquipBranchNum = PlantLoop(LoopNum)%OpScheme(CurSchemePtr)%EquipList(ListNum)%Comp(CompIndex)%BranchNumPtr
EquipCompNum = PlantLoop(LoopNum)%OpScheme(CurSchemePtr)%EquipList(ListNum)%Comp(CompIndex)%CompNumPtr
PlantLoop(LoopNum)%LoopSide(LoopSideNum)%Branch(EquipBranchNum)%Comp(EquipCompNum)%Myload = 0.d0
ENDDO
ENDDO
IF (PlantLoop(LoopNum)%Opscheme(CurSchemePtr)%EquipList(ListPtr)%NumComps .GT. 0) THEN
CALL TurnOnPlantLoopPipes(LoopNum, LoopSideNum)
CALL DistributePlantLoad(LoopNum, LoopSideNum,CurSchemePtr,ListPtr,LoopDemand,RemLoopDemand)
IF(PRESENT(LoadDistributionWasPerformed)) LoadDistributionWasPerformed = .TRUE.
ENDIF
ENDIF
ENDIF !End of range based schemes
RETURN
END SUBROUTINE ManagePlantLoadDistribution