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