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 | ||
|---|---|---|---|---|---|---|
| logical, | intent(in) | :: | FirstHVACIteration | |||
| integer, | intent(in) | :: | LoopSideNum | |||
| integer, | intent(in) | :: | LoopNum | |||
| logical, | intent(inout) | :: | ReSimOtherSideNeeded | 
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 PlantHalfLoopSolver(FirstHVACIteration, LoopSideNum, LoopNum, ReSimOtherSideNeeded)
          ! SUBROUTINE INFORMATION:
          !       AUTHORS:         Dan Fisher, Sankaranarayanan K P, Edwin Lee
          !       DATE WRITTEN:    April 1998
          !       MODIFIED         June 2005(Work in the Plant Super Manager Module)
          !                        July 2006
          !       RE-ENGINEERED    July 2010
          ! PURPOSE OF THIS SUBROUTINE:
          ! SimSupplyFlowSolution is the driver routine for plant loops.  It performs
          !  the following tasks for each half loop (supply or demand side):
          ! 1. Calculate flow request for half loop
          ! 2. Predict Loop Flow
          ! 3. Simulate the inlet branch
          ! 4. Simulate the parallel branches, distributing load if necessary
          ! 5. Set flow rates on parallel branches
          ! 6. Simulate outlet branch and update node and report variables
          ! METHODOLOGY EMPLOYED:
          ! The algorithm operates on a predictor/corrector flow setting method by simulating all available loop components
          ! based on component requested flow rates, then enforcing continuity on all loop branch flows by calling
          ! the flow resolver and locking those flows down.  Available components are then re-simulated using the
          ! corrected flow rates.
          ! USE STATEMENTS:
  USE HVACInterfaceManager,   ONLY: UpdatePlantLoopInterface
  USE PlantCondLoopOperation, ONLY: InitLoadDistribution
  USE PlantPressureSystem,    ONLY: SimPressureDropSystem
  USE DataPlant,              ONLY: DemandSide, SupplySide, TotNumLoops, FlowPumpQuery, &
                                    FlowUnlocked, FlowLocked, PressureCall_Update, PlantLoop, PressureCall_Init
  USE General,                ONLY: RoundSigDigits
  USE DataLoopNode,           ONLY: Node
  USE DataGlobals,            ONLY: BeginTimeStepFlag
  USE PlantUtilities,         ONLY: BoundValueToWithinTwoValues, BoundValueToNodeMinMaxAvail, TightenNodeMinMaxAvails
  IMPLICIT NONE    ! Enforce explicit typing of all variables in this routine
          ! SUBROUTINE ARGUMENT DEFINITIONS:
  INTEGER, INTENT(IN)     :: LoopNum
  INTEGER, INTENT(IN)     :: LoopSideNum
  LOGICAL, INTENT(IN)     :: FirstHVACIteration   ! TRUE if First HVAC iteration of Time step
  LOGICAL, INTENT(IN OUT) :: ReSimOtherSideNeeded
          ! SUBROUTINE LOCAL VARIABLE DECLARATIONS:
  !~ Topology variables
  INTEGER                                   :: ThisSideInletNode  ! Plant loop side loop inlet
  INTEGER                                   :: ThisSide
  INTEGER                                   :: OtherSide
  !~ Initialization and validation flags
  TYPE(m_FlowControlValidator)              :: IsLoopSideValid
  !~ Flags
  LOGICAL                                   :: LoopShutDownFlag
  !~ Other variables
  REAL(r64)                                 :: ThisLoopSideFlow
  REAL(r64)                                 :: TotalPumpMaxAvailFlow
  REAL(r64)                                 :: TotalPumpMinAvailFlow
  ! Initialize variables
  InitialDemandToLoopSetPoint = 0.0d0
  CurrentAlterationsToDemand  = 0.0d0
  UpdatedDemandToLoopSetPoint = 0.0d0
  ThisSide                    = LoopSideNum
  OtherSide                   = 3 - ThisSide !will give us 1 if thisside is 2, or 2 if thisside is 1
  LoopShutDownFlag            = .FALSE.
  ThisSideInletNode           = PlantLoop(LoopNum)%LoopSide(ThisSide)%NodeNumIn
  ! The following block is related to validating the flow control paths of the loop side
  ! Since the control types are scheduled, I think BeginTimeStep should be a decent check frequency
  IF (BeginTimeStepFlag .AND. PlantLoop(LoopNum)%LoopSide(ThisSide)%OncePerTimeStepOperations) THEN
    ! Initialize loop side controls -- could just be done for one loop since this routine inherently
    !  loops over all plant/condenser loops.  Not sure if the penalty is worth investigating.
    CALL InitLoadDistribution(FirstHVACIteration)
    ! Now that the op scheme types are updated, do loopside validation
    IsLoopSideValid = ValidateFlowControlPaths(LoopNum, ThisSide)
    IF (.NOT. IsLoopSideValid%Valid) THEN
      CALL ShowFatalError('ERROR:'//IsLoopSideValid%Reason)
    END IF
    ! Set the flag to false so we won't do these again this time step
    PlantLoop(LoopNum)%LoopSide(ThisSide)%OncePerTimeStepOperations = .FALSE.
  ELSE
    ! Set the flag to true so that it is activated for the next time step
    PlantLoop(LoopNum)%LoopSide(ThisSide)%OncePerTimeStepOperations = .TRUE.
  END IF
  ! Do pressure system initialize if this is the demand side (therefore once per whole loop)
  IF (ThisSide == DemandSide) CALL SimPressureDropSystem(LoopNum, FirstHVACIteration, PressureCall_Init)
  ! First thing is to setup mass flow request information
  CALL SetupLoopFlowRequest(LoopNum, ThisSide, OtherSide, ThisLoopSideFlow)
  ! Now we know what the loop would "like" to run at, let's see the pump
  ! operation range (min/max avail) to see whether it is possible this time around
  IF (ALLOCATED(PlantLoop(LoopNum)%LoopSide(ThisSide)%Pumps)) THEN
    !~ Initialize pump values
    PlantLoop(LoopNum)%LoopSide(ThisSide)%Pumps%CurrentMinAvail = 0.0d0
    PlantLoop(LoopNum)%LoopSide(ThisSide)%Pumps%CurrentMaxAvail = 0.0d0
    PlantLoop(LoopNum)%LoopSide(ThisSide)%FlowLock = FlowPumpQuery
    !~ Simulate pumps
    CALL SimulateAllLoopSidePumps(LoopNum, ThisSide)
    !~ Calculate totals
    TotalPumpMinAvailFlow = SUM(PlantLoop(LoopNum)%LoopSide(ThisSide)%Pumps%CurrentMinAvail)
    TotalPumpMaxAvailFlow = SUM(PlantLoop(LoopNum)%LoopSide(ThisSide)%Pumps%CurrentMaxAvail)
    ! Use the pump min/max avail to attempt to constrain the loop side flow
    ThisLoopSideFlow = BoundValueToWithinTwoValues(ThisLoopSideFlow, TotalPumpMinAvailFlow, TotalPumpMaxAvailFlow)
  END IF
  ! Now we check flow restriction from the other side, both min and max avail.
  ! Doing this last basically means it wins, so the pump should pull down to meet the flow restriction
  ThisLoopSideFlow = BoundValueToNodeMinMaxAvail(ThisLoopSideFlow, ThisSideInletNode)
  ! Final preparation of loop inlet min/max avail if pumps exist
  IF (ALLOCATED(PlantLoop(LoopNum)%LoopSide(ThisSide)%Pumps)) THEN
    ! At this point, the pump limits should have been obeyed unless a flow restriction was encountered from the other side
    ! The pump may, however, have even tighter constraints than the other side
    ! At this point, the inlet node doesn't know anything about those limits
    ! Since we have already honored the other side flow restriction, try to honor the pump limits here
    CALL TightenNodeMinMaxAvails(ThisSideInletNode, TotalPumpMinAvailFlow, TotalPumpMaxAvailFlow)
  END IF
  ! Now reset the entering mass flow rate to the decided-upon flow rate
  Node(ThisSideInletNode)%MassFlowRate = ThisLoopSideFlow
  ! We also need to establish a baseline "other-side-based" loop demand based on this possible flow rate
  InitialDemandToLoopSetPoint = CalcOtherSideDemand(LoopNum, ThisSide)
  UpdatedDemandToLoopSetPoint = InitialDemandToLoopSetPoint
  LoadToLoopSetPointThatWasntMet = 0.0d0
  ! We now have a loop side flow request, along with inlet min/max avails.
  ! We can now make a first pass through the component simulation, requesting flow as necessary.
  ! Normal "supply side" components will set a mass flow rate on their outlet node to request flow,
  ! while "Demand side" components will set a a mass flow request on their inlet node to request flow.
  PlantLoop(LoopNum)%LoopSide(ThisSide)%FlowLock = FlowUnlocked
  CALL SimulateAllLoopSideBranches(LoopNum, ThisSide, ThisLoopSideFlow, FirstHVACIteration, LoopShutDownFlag)
  ! DSU? discussion/comments about loop solver/flow resolver interaction
  ! At this point, the components have been simulated.  They should have either:
  !  - logged a massflowrequest
  !  - or logged a massflowrate
  ! We need to decide what the components are going to do on FlowLock=0.
  ! If we want all control here at the solver level, the components just need to
  !  log their massflowrate on their outlet nodes, or some other mechanism.
  ! Then the loop solver can scan the branch and get the max, and this will be the requested
  !  flow rate for the branch.
  ! The loop solver will then set this as the branch outlet mass flow rate in preparation
  !  for the flow resolver.
  ! The loop solver may need to do something to the inlet/outlet branch, but I'm not sure yet.
  ! The following comment block is what I had already thought of, and it may still make sense.
  ! Now that all the flow requests have been logged, we need to prepare them for the
  !  flow resolver.  This will just take the requests and determine the desired flow
  !  request for that branch according to pump placement, pump type, and other component
  !  conditions.  In many cases, this will just be to simply take the max request from
  !  the branch, which will already be within pumping limits for that flow path.
  ! We can then call the flow resolver to lock down branch inlet flow rates.
  !DSU?
  ! The flow resolver takes information such as requested flows and min/max available flows and
  !  sets the corrected flow on the inlet to each parallel branch
  CALL ResolveParallelFlows(LoopNum, ThisSide, ThisLoopSideFlow, FirstHVACIteration)
!  CALL PropagateResolvedFlow(LoopNum, ThisSide)
  ! Re-Initialize variables for this next pass
  InitialDemandToLoopSetPointSAVED = InitialDemandToLoopSetPoint
  CurrentAlterationsToDemand  = 0.0d0
  UpdatedDemandToLoopSetPoint = InitialDemandToLoopSetPoint
  ! Now that flow rates have been resolved, we just need to set the flow lock status
  !  flag, and resimulate.  During this simulation each component will still use the
  !  SetFlowRequest routine, but this routine will also set the outlet flow rate
  !  equal to the inlet flow rate, accoridng to flowlock logic.
  PlantLoop(LoopNum)%LoopSide(ThisSide)%FlowLock = FlowLocked
  CALL SimulateAllLoopSideBranches(LoopNum, ThisSide, ThisLoopSideFlow, FirstHVACIteration, LoopShutDownFlag)
  ! A couple things are specific to which loopside we are on
  IF (LoopSideNum==DemandSide) THEN
    ! Pass the loop information via the HVAC interface manager
    CALL UpdatePlantLoopInterface(LoopNum, LoopSideNum,PlantLoop(LoopNum)%LoopSide(DemandSide)%NodeNumOut, &
                                   PlantLoop(LoopNum)%LoopSide(SupplySide)%NodeNumIn,  &
                                   ReSimOtherSideNeeded,PlantLoop(LoopNum)%CommonPipeType)
  ELSE !LoopSide == SupplySide
    ! Update pressure drop reporting, calculate total loop pressure drop for use elsewhere
    CALL SimPressureDropSystem(LoopNum, FirstHVACIteration, PressureCall_Update)
    ! Pass the loop information via the HVAC interface manager (only the flow)
    CALL UpdatePlantLoopInterface(LoopNum, LoopSideNum, PlantLoop(LoopNum)%LoopSide(SupplySide)%NodeNumOut, &
                                   PlantLoop(LoopNum)%LoopSide(DemandSide)%NodeNumIn, ReSimOtherSideNeeded, &
                                   PlantLoop(LoopNum)%CommonPipeType)
    ! Update the loop outlet node conditions
    CALL CheckLoopExitNode(LoopNum, FirstHVACIteration)
  END IF
  ! Update some reporting information at Plant half loop level
  CALL UpdateLoopSideReportVars(LoopNum, LoopSideNum, InitialDemandToLoopSetPointSAVED, LoadToLoopSetPointThatWasntMet)
 RETURN
END SUBROUTINE PlantHalfLoopSolver