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 | ||
---|---|---|---|---|---|---|
real(kind=r64), | intent(inout) | :: | CompFlow | |||
integer, | intent(in) | :: | ActuatedNode | |||
integer, | intent(in) | :: | LoopNum | |||
integer, | intent(in) | :: | LoopSideNum | |||
integer, | intent(in) | :: | BranchNum | |||
logical, | intent(in) | :: | ResetMode |
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 SetActuatedBranchFlowRate(CompFlow,ActuatedNode,LoopNum,LoopSideNum, BranchNum, ResetMode) !DSU3
! SUBROUTINE INFORMATION:
! AUTHOR B. Griffith
! DATE WRITTEN Feb 2010
! MODIFIED na
! RE-ENGINEERED na
! PURPOSE OF THIS SUBROUTINE:
! general purpse worker routine to set plant node variables for node
! and all nodes on the branch. Used by HVAC water coil controller, that do not
! distinguish single component and have no inlet-outlet pair
! only a actuated noded of no clear position. set flow on entire branch
! METHODOLOGY EMPLOYED:
! Set flow on node and branch while honoring constraints on actuated node
! REFERENCES:
! na
! USE STATEMENTS:
! na
USE DataLoopNode, ONLY : Node
USE DataPlant, ONLY : PlantLoop, FlowUnlocked, FlowLocked
USE DataBranchAirLoopPlant, ONLY : MassFlowTolerance
USE DataInterfaces, ONLY : ShowFatalError, ShowSevereError, ShowContinueErrorTimeStamp,&
ShowContinueError
USE DataSizing, ONLY : AutoSize
USE General, ONLY : RoundSigDigits
IMPLICIT NONE ! Enforce explicit typing of all variables in this routine
! SUBROUTINE ARGUMENT DEFINITIONS:
REAL(r64), INTENT(INOUT) :: CompFlow
INTEGER, INTENT(IN) :: ActuatedNode
INTEGER, INTENT(IN) :: LoopNum
INTEGER, INTENT(IN) :: LoopSideNum
INTEGER, INTENT(IN) :: BranchNum
LOGICAL, INTENT(IN) :: ResetMode ! flag to indicate if this is a real flow set, or a reset flow setting.
! SUBROUTINE PARAMETER DEFINITIONS:
! na
! INTERFACE BLOCK SPECIFICATIONS
! na
! DERIVED TYPE DEFINITIONS
! na
! SUBROUTINE LOCAL VARIABLE DECLARATIONS:
INTEGER :: CompNum
INTEGER :: NodeNum
REAL(r64) :: MdotOldRequest
! FLOW:
! store original flow
MdotOldRequest = Node(ActuatedNode)%MassFlowRateRequest
Node(ActuatedNode)%MassFlowRateRequest = CompFlow
IF (LoopNum > 0 .AND. LoopSideNum > 0 .AND. (.NOT. ResetMode)) THEN
IF ((MdotOldRequest > 0.d0) .AND. (CompFlow > 0.d0)) THEN ! sure that not coming back from a no flow reset
IF ( (ABS(MdotOldRequest - Node(ActuatedNode)%MassFlowRateRequest) > MassFlowTolerance) .AND. &
(PlantLoop(LoopNum)%LoopSide(LoopSideNum)%Flowlock == FlowUnlocked)) THEN
PlantLoop(LoopNum)%LoopSide(LoopSideNum)%SimLoopSideNeeded = .TRUE.
ENDIF
ENDIF
ENDIF
!Set loop flow rate
IF (LoopNum > 0 .AND. LoopSideNum > 0 ) THEN
IF (PlantLoop(LoopNum)%LoopSide(LoopSideNum)%Flowlock == FlowUnlocked)THEN
IF (PlantLoop(LoopNum)%MaxVolFlowRate == AutoSize)THEN !still haven't sized the plant loop
Node(ActuatedNode)%MassFlowRate = CompFlow
ELSE !bound the flow by Min/Max available across entire branch
Node(ActuatedNode)%MassFlowRate = MAX(Node(ActuatedNode)%MassFlowRateMinAvail, CompFlow)
Node(ActuatedNode)%MassFlowRate = MAX(Node(ActuatedNode)%MassFlowRateMin , Node(ActuatedNode)%MassFlowRate )
! add MassFlowRateMin hardware constraints
Node(ActuatedNode)%MassFlowRate = MIN(Node(ActuatedNode)%MassFlowRateMaxAvail, Node(ActuatedNode)%MassFlowRate)
Node(ActuatedNode)%MassFlowRate = MIN(Node(ActuatedNode)%MassFlowRateMax, Node(ActuatedNode)%MassFlowRate)
IF (Node(ActuatedNode)%MassFlowRate < MassFlowTolerance) Node(ActuatedNode)%MassFlowRate = 0.d0
CompFlow = Node(ActuatedNode)%MassFlowRate
Do CompNum = 1, PlantLoop(LoopNum)%LoopSide(LoopSideNum)%Branch(BranchNum)%TotalComponents
IF (ActuatedNode == PlantLoop(LoopNum)%LoopSide(LoopSideNum)%Branch(BranchNum)%Comp(CompNum)%NodeNumIn) THEN
! ! found controller set to inlet of a component. now set that component's outlet
NodeNum = PlantLoop(LoopNum)%LoopSide(LoopSideNum)%Branch(BranchNum)%Comp(CompNum)%NodeNumOut
! Node(ActuatedNode)%MassFlowRate = MAX( Node(ActuatedNode)%MassFlowRate , Node(NodeNum)%MassFlowRateMinAvail)
! Node(ActuatedNode)%MassFlowRate = MAX( Node(ActuatedNode)%MassFlowRate , Node(ActuatedNode)%MassFlowRateMin)
! Node(ActuatedNode)%MassFlowRate = MIN( Node(ActuatedNode)%MassFlowRate , Node(NodeNum)%MassFlowRateMaxAvail)
! Node(ActuatedNode)%MassFlowRate = MIN( Node(ActuatedNode)%MassFlowRate , Node(ActuatedNode)%MassFlowRateMax)
!virtual 2-way valve
! Node(NodeNum)%MassFlowRateMinAvail = MAX(Node(ActuatedNode)%MassFlowRateMinAvail ,Node(ActuatedNode)%MassFlowRateMin)
! Node(NodeNum)%MassFlowRateMinAvail = MAX(Node(ActuatedNode)%MassFlowRateMinAvail , CompFlow)
Node(NodeNum)%MassFlowRateMinAvail = MAX(Node(ActuatedNode)%MassFlowRateMinAvail, Node(ActuatedNode)%MassFlowRateMin)
! Node(NodeNum)%MassFlowRateMaxAvail = MIN(Node(ActuatedNode)%MassFlowRateMaxAvail,Node(ActuatedNode)%MassFlowRateMax)
! Node(NodeNum)%MassFlowRateMaxAvail = MIN(Node(ActuatedNode)%MassFlowRateMaxAvail , CompFlow)
Node(NodeNum)%MassFlowRateMaxAvail = MIN(Node(ActuatedNode)%MassFlowRateMaxAvail, Node(ActuatedNode)%MassFlowRateMax)
Node(NodeNum)%MassFlowRate = Node(ActuatedNode)%MassFlowRate
ENDIF
ENDDO
END IF
ELSEIF (PlantLoop(LoopNum)%LoopSide(LoopSideNum)%Flowlock == FlowLocked)THEN
CompFlow = Node(ActuatedNode)%MassFlowRate
! do not change requested flow rate either
Node(ActuatedNode)%MassFlowRateRequest = MdotOldRequest
IF (((CompFlow - Node(ActuatedNode)%MassFlowRateMaxAvail) > MassFlowTolerance) .OR. &
((Node(ActuatedNode)%MassFlowRateMinAvail - CompFlow) > MassFlowTolerance)) THEN
CALL ShowSevereError('SetActuatedBranchFlowRate: Flow rate is out of range') !DEBUG error...should never get here
CALL ShowContinueErrorTimeStamp(' ')
CALL ShowContinueError('Component flow rate [kg/s] = '//TRIM(RoundSigDigits(CompFlow,8)) )
CALL ShowContinueError('Node maximum flow rate available [kg/s] = ' &
//TRIM(RoundSigDigits(Node(ActuatedNode)%MassFlowRateMaxAvail,8)) )
CALL ShowContinueError('Node minimum flow rate available [kg/s] = '&
//TRIM(RoundSigDigits(Node(ActuatedNode)%MassFlowRateMinAvail,8)) )
ENDIF
ELSE
CALL ShowFatalError('SetActuatedBranchFlowRate: Flowlock out of range, value='// &
trim(RoundSigDigits(PlantLoop(LoopNum)%LoopSide(LoopSideNum)%Flowlock))) !DEBUG error...should never get here
ENDIF
Do CompNum = 1, PlantLoop(LoopNum)%LoopSide(LoopSideNum)%Branch(BranchNum)%TotalComponents
NodeNum = PlantLoop(LoopNum)%LoopSide(LoopSideNum)%Branch(BranchNum)%Comp(CompNum)%NodeNumIn
Node(NodeNum)%MassFlowRate = Node(ActuatedNode)%MassFlowRate
Node(NodeNum)%MassFlowRateRequest = Node(ActuatedNode)%MassFlowRateRequest
NodeNum = PlantLoop(LoopNum)%LoopSide(LoopSideNum)%Branch(BranchNum)%Comp(CompNum)%NodeNumOut
Node(NodeNum)%MassFlowRate = Node(ActuatedNode)%MassFlowRate
Node(NodeNum)%MassFlowRateRequest = Node(ActuatedNode)%MassFlowRateRequest
ENDDO
ELSE
! early in simulation before plant loops are setup and found
Node(ActuatedNode)%MassFlowRate = CompFlow
ENDIF
RETURN
END SUBROUTINE SetActuatedBranchFlowRate !DSU3