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 | ||
|---|---|---|---|---|---|---|
| character(len=*), | intent(in) | :: | ControllerName | |||
| integer, | intent(inout) | :: | ControllerIndex | |||
| logical, | intent(in) | :: | FirstHVACIteration | |||
| integer, | intent(in) | :: | AirLoopNum | |||
| integer, | intent(in) | :: | AirLoopPass | |||
| integer, | intent(in) | :: | Operation | |||
| logical, | intent(out) | :: | IsConvergedFlag | |||
| logical, | intent(inout) | :: | IsUpToDateFlag | |||
| logical, | intent(out), | optional | :: | AllowWarmRestartFlag | 
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 ManageControllers( &
    ControllerName, ControllerIndex, &
    FirstHVACIteration, AirLoopNum, AirLoopPass, &
    Operation, IsConvergedFlag, IsUpToDateFlag, AllowWarmRestartFlag )
          ! SUBROUTINE INFORMATION:
          !       AUTHOR         Richard Liesen
          !       DATE WRITTEN   July 1998
          !       MODIFIED       Dimitri Curtil, February 2006
          !                      - Added air loop information
          !                      - Added tracing to csv files
          !                      - Added primitive operations to replace mixed
          !                        bag of ResetController, FirstCallConvergenceTest, ...
          !       RE-ENGINEERED  na
          ! PURPOSE OF THIS SUBROUTINE:
          ! This subroutine manages Controller component simulation.
          ! METHODOLOGY EMPLOYED:
          ! na
          ! REFERENCES:
          ! na
          ! USE STATEMENTS:
  USE DataSystemVariables
  USE InputProcessor, ONLY: FindItemInList
  USE General,        ONLY: TrimSigDigits
  USE DataPlant,      ONLY: PlantLoop, FlowLocked
  IMPLICIT NONE    ! Enforce explicit typing of all variables in this routine
          ! SUBROUTINE ARGUMENT DEFINITIONS:
  CHARACTER(LEN=*), INTENT(IN)    :: ControllerName
  INTEGER, INTENT(INOUT)          :: ControllerIndex
  ! TRUE if first full HVAC iteration in an HVAC time step
  LOGICAL, INTENT(IN)             :: FirstHVACIteration
  ! Current air loop num 1...NumPrimaryAirSys
  INTEGER, INTENT(IN)             :: AirLoopNum !unused1208
  ! Current pass counter in SimAirLoop()
  INTEGER, INTENT(IN)             :: AirLoopPass
  ! Operation to execute
  INTEGER, INTENT(IN)             :: Operation
  ! TRUE if controller is converged
  LOGICAL, INTENT(OUT)            :: IsConvergedFlag
  ! TRUE if air loop is up-to-date meaning that the current node values are consistent (air loop evaluated)
  ! Only used within the Calc routines
  LOGICAL, INTENT(INOUT)          :: IsUpToDateFlag
  ! TRUE if speculative warm restart is supported by this controller
  LOGICAL, INTENT(OUT), OPTIONAL  :: AllowWarmRestartFlag
          ! SUBROUTINE PARAMETER DEFINITIONS:
          ! na
          ! INTERFACE BLOCK SPECIFICATIONS
          ! na
          ! DERIVED TYPE DEFINITIONS
          ! na
          ! SUBROUTINE LOCAL VARIABLE DECLARATIONS:
  ! The Controller that you are currently loading input into
  INTEGER                      :: ControlNum
  INTEGER                      :: ControllerType
          ! FLOW:
  ! Obtains and Allocates Controller related parameters from input file
  IF (GetControllerInputFlag) THEN  !First time subroutine has been entered
    CALL GetControllerInput
    GetControllerInputFlag = .FALSE.
  END IF
  IF (ControllerIndex == 0) THEN
    ControlNum = FindItemInList(ControllerName, ControllerProps%ControllerName, NumControllers)
    IF (ControlNum == 0) THEN
      CALL ShowFatalError( &
        'ManageControllers: Invalid controller='//TRIM(ControllerName)// &
        '. The only valid controller type'//  &
        ' for an AirLoopHVAC is Controller:WaterCoil.' &
      )
    ENDIF
    ControllerIndex = ControlNum
  ELSE
    ControlNum = ControllerIndex
    IF (ControlNum > NumControllers .OR. ControlNum < 1) THEN
      CALL ShowFatalError( &
        'ManageControllers: Invalid ControllerIndex passed='// &
        TRIM(TrimSigDigits(ControlNum))// &
        ', Number of controllers='//TRIM(TrimSigDigits(NumControllers))//  &
        ', Controller name='//TRIM(ControllerName) &
      )
    ENDIF
    IF (CheckEquipName(ControlNum)) THEN
      IF (ControllerName /= ControllerProps(ControlNum)%ControllerName) THEN
        CALL ShowFatalError( &
          'ManageControllers: Invalid ControllerIndex passed='// &
          TRIM(TrimSigDigits(ControlNum))// &
          ', Controller name='//TRIM(ControllerName)// &
          ', stored Controller Name for that index='//  &
          TRIM(ControllerProps(ControlNum)%ControllerName) &
        )
      ENDIF
      CheckEquipName(ControlNum)=.false.
    ENDIF
  ENDIF
  ! Find the correct ControllerNumber with the AirLoop & CompNum from AirLoop Derived Type
  !ControlNum = AirLoopEquip(AirLoopNum)%ComponentOfTypeNum(CompNum)
  ! detect if plant is locked and flow cannot change
  IF (ControllerProps(ControlNum)%ActuatedNodePlantLoopNum > 0) THEN
    IF (PlantLoop(ControllerProps(ControlNum)%ActuatedNodePlantLoopNum)% &
       LoopSide(ControllerProps(ControlNum)%ActuatedNodePlantLoopSide)%Flowlock == FlowLocked) THEN
    ! plant is rigid so controller cannot change anything.
           ! Update the current Controller to the outlet nodes
      CALL UpdateController(ControlNum)
      IsConvergedFlag = .TRUE.
      RETURN
    ENDIF
  ENDIF
  ! Detect if speculative warm restart is supported by this computer
  IF ( PRESENT(AllowWarmRestartFlag) ) THEN
    ! NOTE: Never allow speculative warm restart with dual humidity ratio and temperature control
    !       because the actual setpoint depends on the current temperature and max hum ratio at
    !       the sensed node, and therefore might not be known until after one air loop simulation.
    IF ( ControllerProps(ControlNum)%ControlVar == iTemperatureAndHumidityRatio ) THEN
      AllowWarmRestartFlag = .FALSE.
    ELSE
      AllowWarmRestartFlag = .TRUE.
    END IF
  END IF
  IF(ControllerProps(ControlNum)%InitFirstPass)THEN
    ! Coil must first be sized to:
    ! Initialize ControllerProps(ControlNum)%MinActuated and ControllerProps(ControlNum)%MaxActuated
    CALL InitController(ControlNum, FirstHVACIteration, IsConvergedFlag)
    ControllerProps(ControlNum)%InitFirstPass = .FALSE.
  END IF
  ! Perform requested operation
  ! Note that InitController() is not called upon START/RESTART ops in order to avoid
  ! side-effects on the calculation of Node(ActuatedNode)%MassFlowRateMaxAvail used to
  ! determine ControllerProps(ControlNum)%MaxAvailActuated.
  ! Plant upgrades for V7 added init to these cases because MassFlowRateMaxAvail is better controlled
  ControllerOp : SELECT CASE (Operation)
    CASE (iControllerOpColdStart)
      ! If a iControllerOpColdStart call, reset the actuator inlet flows
      CALL ResetController(ControlNum, FirstHVACIteration, .FALSE., IsConvergedFlag)
  !    CALL InitController(ControlNum, FirstHVACIteration, IsConvergedFlag)
      ! Update the current Controller to the outlet nodes
      CALL UpdateController(ControlNum)
      ! Report the current Controller
      CALL ReportController(ControlNum)
    CASE (iControllerOpWarmRestart)
      ! If a iControllerOpWarmRestart call, set the actuator inlet flows to previous solution
      CALL ResetController(ControlNum, FirstHVACIteration,.TRUE., IsConvergedFlag)
   !   CALL InitController(ControlNum, FirstHVACIteration, IsConvergedFlag)
      ! Update the current Controller to the outlet nodes
      CALL UpdateController(ControlNum)
      ! Report the current Controller
      CALL ReportController(ControlNum)
    CASE (iControllerOpIterate)
      ! With the correct ControlNum Initialize all Controller related parameters
      CALL InitController(ControlNum, FirstHVACIteration, IsConvergedFlag)
      ! No initialization needed: should have been done before
      ! Simulate the correct Controller with the current ControlNum
      ControllerType = ControllerProps(ControlNum)%ControllerType_Num
      ControllerCalc: SELECT CASE (ControllerType)
      CASE (ControllerSimple_Type)  ! 'Controller:WaterCoil'
          CALL CalcSimpleController(ControlNum, FirstHVACIteration, IsConvergedFlag, IsUpToDateFlag, ControllerName)
        CASE DEFAULT
          CALL ShowFatalError( &
            'Invalid controller type in ManageControllers='// &
            TRIM(ControllerProps(ControlNum)%ControllerType) &
          )
      END SELECT ControllerCalc
      ! Update the current Controller to the outlet nodes
      CALL UpdateController(ControlNum)
      ! Report the current Controller
      CALL ReportController(ControlNum)
    CASE (iControllerOpEnd)
      ! With the correct ControlNum Initialize all Controller related parameters
      CALL InitController(ControlNum, FirstHVACIteration, IsConvergedFlag)
      ! No initialization needed: should have been done before
      ! Check convergence for the correct Controller with the current ControlNum
      ControllerType = ControllerProps(ControlNum)%ControllerType_Num
      ControllerCheck: SELECT CASE (ControllerType)
        CASE (ControllerSimple_Type)  ! 'Controller:WaterCoil'
          CALL CheckSimpleController(ControlNum, IsConvergedFlag)
          CALL SaveSimpleController(ControlNum, FirstHVACIteration, IsConvergedFlag)
        CASE DEFAULT
          CALL ShowFatalError( &
            'Invalid controller type in ManageControllers='// &
            TRIM(ControllerProps(ControlNum)%ControllerType) &
          )
      END SELECT ControllerCheck
      ! Report the current Controller
      CALL ReportController(ControlNum)
    CASE DEFAULT
      CALL ShowFatalError( &
        'ManageControllers: Invalid Operation passed='//TRIM(TrimSigDigits(Operation))// &
        ', Controller name='//TRIM(ControllerName) &
      )
  END SELECT ControllerOp
  ! Write detailed diagnostic for individual controller
  !
  ! To enable generating an individual, detailed trace file for each controller on each air loop,
  ! define the environment variable TRACE_CONTROLLER=YES or TRACE_CONTROLLER=Y
  IF ( TraceHVACControllerEnvFlag ) THEN
    CALL TraceIndividualController( &
      ControlNum, &
      FirstHVACIteration, &
      AirLoopPass, &
      Operation, &
      IsConvergedFlag )
  END IF
  RETURN
END SUBROUTINE ManageControllers