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 | ||
---|---|---|---|---|---|---|
integer, | intent(in) | :: | ControlNum | |||
logical, | intent(in) | :: | FirstHVACIteration | |||
logical, | intent(out) | :: | IsConvergedFlag | |||
logical, | intent(inout) | :: | IsUpToDateFlag | |||
character(len=*), | intent(in) | :: | ControllerName |
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.
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 CalcSimpleController(ControlNum, FirstHVACIteration, IsConvergedFlag, IsUpToDateFlag, ControllerName)
! SUBROUTINE INFORMATION:
! AUTHOR Dimitri Curtil
! DATE WRITTEN May 2006
! MODIFIED Dimitri Curtil (LBNL), May 2006
! - Added IsPointFlagDefinedFlag to control when the setpoiont should be
! computed depending on the control strategy. This was needed to
! trigger the setpoint calculation for the dual temperature and
! humidity ratio control strategy only once the air loop has been
! evaluated with the max actuated flow.
! See the routine InitController() for more details on the setpoint
! calculation.
! MODIFIED Dimitri Curtil (LBNL), March 2006
! - Added IsUpToDateFlag to detect whether or not the air loop
! has been evaluated prior the first iteration, which allows
! to use the current node values as the first iterate for the root
! finder (for COLD RESTART ONLY).
! MODIFIED Dimitri Curtil (LBNL), Feb 2006
! - Added mode detection capability.
! - Now trying min actuated variable first to
! detect min-constrained cases in 1 iteration.
! - Trying max actuated variable second.
! Checks for max-constrained here instead of in
! NormActuatedCalc mode.
! - Checking for inactive mode as soon as min and max
! support points are known instead of in NormActuatedCalc
! mode.
! RE-ENGINEERED na
! PURPOSE OF THIS SUBROUTINE:
! This subroutine needs a description.
! METHODOLOGY EMPLOYED:
! na
! REFERENCES:
! na
! USE STATEMENTS:
USE General, ONLY : TrimSigDigits
USE RootFinder, ONLY : InitializeRootFinder, CheckRootFinderCandidate
IMPLICIT NONE ! Enforce explicit typing of all variables in this routine
! SUBROUTINE ARGUMENT DEFINITIONS:
INTEGER, INTENT(IN) :: ControlNum
LOGICAL, INTENT(IN) :: FirstHVACIteration
! Set to TRUE if current controller is converged; FALSE if more iteration are needed.
! Note that an error in the root finding process can be mapped onto IsConvergedFlag=TRUE
! to avoid continue iterating.
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
CHARACTER(len=*), INTENT(IN) :: ControllerName ! used when errors occur
! SUBROUTINE PARAMETER DEFINITIONS:
! na
! INTERFACE BLOCK SPECIFICATIONS
! na
! DERIVED TYPE DEFINITIONS
! na
! SUBROUTINE LOCAL VARIABLE DECLARATIONS:
INTEGER :: ActuatedNode
INTEGER :: SensedNode
! Increment counter
ControllerProps(ControlNum)%NumCalcCalls = ControllerProps(ControlNum)%NumCalcCalls + 1
! Obtain actuated and sensed nodes
ActuatedNode = ControllerProps(ControlNum)%ActuatedNode
SensedNode = ControllerProps(ControlNum)%SensedNode
! Check to see if the component is running; if not converged and return. This check will be done
! by looking at the component mass flow rate at the sensed node.
IF (Node(SensedNode)%MassFlowRate == 0.0d0) THEN
CALL ExitCalcController( &
ControlNum, &
constant_zero, &
iModeOff, &
IsConvergedFlag, &
IsUpToDateFlag &
)
RETURN
END IF
! Intialize root finder
IF ( ControllerProps(ControlNum)%NumCalcCalls == 1 ) THEN
! Set min/max boundaries for root finder on first iteration
CALL InitializeRootFinder( &
RootFinders(ControlNum), & !
ControllerProps(ControlNum)%MinAvailActuated, & ! XMin
ControllerProps(ControlNum)%MaxAvailActuated & ! XMax
)
ControllerProps(ControlNum)%ReuseIntermediateSolutionFlag = &
! Only allow to reuse initial evaluation if the air loop is up-to-date.
! Set in SolveAirLoopControllers()
IsUpToDateFlag .AND. &
! Only reuse initial evaluation if setpoint is already available for the current controller
!
! Note that in the case of dual temperature and humidity ratio control strategy since the
! setpoint at a later iteration, the initial solution cannot be reused.
ControllerProps(ControlNum)%IsSetPointDefinedFlag .AND. &
! Make sure that the initial candidate value lies within range
CheckRootFinderCandidate( RootFinders(ControlNum), ControllerProps(ControlNum)%ActuatedValue )
IF ( ControllerProps(ControlNum)%ReuseIntermediateSolutionFlag ) THEN
! Reuse intermediate solution obtained with previous controller for the current HVAC step
! and fire root finder to get next root candidate
CALL FindRootSimpleController( ControlNum, FirstHVACIteration, IsConvergedFlag, IsUpToDateFlag, ControllerName)
ELSE
! We need to evaluate the sensed node temperature with the max actuated value before
! we can compute the actual setpoint for the dual humidity ratio / temperature strategy.
SelectController: SELECT CASE ( ControllerProps(ControlNum)%ControlVar )
CASE (iTemperature,iHumidityRatio,iFlow)
! Always start with min point by default for the other control strategies
ControllerProps(ControlNum)%NextActuatedValue = RootFinders(ControlNum)%MinPoint%X
CASE (iTemperatureAndHumidityRatio)
IF ( .NOT.ControllerProps(ControlNum)%IsSetPointDefinedFlag ) THEN
! Always start with max point if setpoint not yet computed. See routine InitController().
ControllerProps(ControlNum)%NextActuatedValue = RootFinders(ControlNum)%MaxPoint%X
ELSE
! If setpoint already exists (i.e., HumRatMax <= 0) then try min point first as in simple
! temperature control case.
ControllerProps(ControlNum)%NextActuatedValue = RootFinders(ControlNum)%MinPoint%X
END IF
CASE DEFAULT
! Should never happen
CALL ShowSevereError('CalcSimpleController: HVAC controller failed at '//TRIM(CreateHVACStepFullString()))
CALL ShowContinueError( &
' Controller name='//TRIM(ControllerProps(ControlNum)%ControllerName) &
)
CALL ShowContinueError( &
' Unrecognized control variable type='// &
TRIM(TrimSigDigits(ControllerProps(ControlNum)%ControlVar)) &
)
CALL ShowFatalError('Preceding error causes program termination.')
END SELECT SelectController
END IF
! Process current iterate and compute next candidate if needed
! We assume that after the first controller iteration:
! - the setpoint is defined
! - the min and max available bounds are defined
!
! NOTE: Not explicitly checked but the air mass flow rate must remain constant across successive
! controller iterations to ensure that the root finder converges.
ELSE
! Check that the setpoint is defined
IF ( .NOT.ControllerProps(ControlNum)%IsSetPointDefinedFlag ) THEN
CALL ShowSevereError('CalcSimpleController: Root finder failed at '//TRIM(CreateHVACStepFullString()))
CALL ShowContinueError( &
' Controller name="'//TRIM(ControllerName)//'"' &
)
CALL ShowContinueError(' Setpoint is not available/defined.')
CALL ShowFatalError('Preceding error causes program termination.')
END IF
! Monitor invariants across successive controller iterations
! - min bound
! - max bound
!
IF ( RootFinders(ControlNum)%MinPoint%X /= ControllerProps(ControlNum)%MinAvailActuated ) THEN
CALL ShowSevereError('CalcSimpleController: Root finder failed at '//TRIM(CreateHVACStepFullString()))
CALL ShowContinueError( &
' Controller name="'//TRIM(ControllerName)//'"' &
)
CALL ShowContinueError(' Minimum bound must remain invariant during successive iterations.')
CALL ShowContinueError(' Minimum root finder point='// &
trim(TrimSigDigits(RootFinders(ControlNum)%MinPoint%X,NumSigDigits)))
CALL ShowContinueError(' Minimum avail actuated='// &
trim(TrimSigDigits(ControllerProps(ControlNum)%MinAvailActuated,NumSigDigits)))
CALL ShowFatalError('Preceding error causes program termination.')
END IF
IF ( RootFinders(ControlNum)%MaxPoint%X /= ControllerProps(ControlNum)%MaxAvailActuated ) THEN
CALL ShowSevereError('CalcSimpleController: Root finder failed at '//TRIM(CreateHVACStepFullString()))
CALL ShowContinueError( &
' Controller name="'//TRIM(ControllerName)//'"' &
)
CALL ShowContinueError(' Maximum bound must remain invariant during successive iterations.')
CALL ShowContinueError(' Maximum root finder point='// &
trim(TrimSigDigits(RootFinders(ControlNum)%MaxPoint%X,NumSigDigits)))
CALL ShowContinueError(' Maximum avail actuated='// &
trim(TrimSigDigits(ControllerProps(ControlNum)%MaxAvailActuated,NumSigDigits)))
CALL ShowFatalError('Preceding error causes program termination.')
END IF
! Updates root finder with current iterate and computes next one if needed
CALL FindRootSimpleController( ControlNum, FirstHVACIteration, IsConvergedFlag, IsUpToDateFlag, ControllerName )
END IF
RETURN
END SUBROUTINE CalcSimpleController