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.
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 GetControllerInput
! SUBROUTINE INFORMATION:
! AUTHOR Richard Liesen
! DATE WRITTEN July 1998
! MODIFIED February 2006, Dimitri Curtil
! - Added processing for air loop controller stats
! RE-ENGINEERED na
! PURPOSE OF THIS SUBROUTINE:
! This subroutine is the main routine to call other input routines and Get routines
! METHODOLOGY EMPLOYED:
! Uses the status flags to trigger events.
! REFERENCES:
! Gets the object:
! Controller:WaterCoil,
! \min-fields 9
! A1 , \field Name
! \type alpha
! \required-field
! \reference AirLoopControllers
! A2 , \field Control Variable
! \type choice
! \key Temperature
! \key HumidityRatio
! \key TemperatureAndHumidityRatio
! \key Flow
! \note TemperatureAndHumidityRatio requires a SetpointManager:SingleZone:Humidity:Maximum object
! A3 , \field Action
! \type choice
! \key Normal
! \key Reverse
! A4 , \field Actuator Variable
! \type choice
! \key Flow
! A5 , \field Sensor Node Name
! \type alpha
! A6 , \field Actuator Node Name
! \type alpha
! N1 , \field Controller Convergence Tolerance
! \units deltaC
! \type real
! \default Autosize
! \autosizable
! N2 , \field Maximum Actuated Flow
! \type real
! \units m3/s
! \autosizable
! N3 ; \field Minimum Actuated Flow
! \type real
! \default 0.0000001
! \units m3/s
! USE STATEMENTS:
USE DataSystemVariables, ONLY : TrackAirLoopEnvFlag, TraceAirLoopEnvFlag, TraceHVACControllerEnvFlag
USE InputProcessor, ONLY : GetNumObjectsFound, GetObjectItem, VerifyName, GetObjectDefMaxArgs, SameString, MakeUPPERCase
USE NodeInputManager, ONLY : GetOnlySingleNode
USE DataHVACGlobals, ONLY : NumPrimaryAirSys
USE DataAirSystems, ONLY : PrimaryAirSystem
USE WaterCoils, ONLY : CheckActuatorNode, CheckForSensorAndSetpointNode
USE MixedAir, ONLY : CheckForControllerWaterCoil
USE SetPointManager, ONLY : NodeHasSPMCtrlVarType, iCtrlVarType_Temp, iCtrlVarType_MaxHumRat
USE EMSManager, ONLY : CheckIfNodeSetpointManagedByEMS, iTemperatureSetpoint, iHumidityRatioMaxSetpoint
IMPLICIT NONE ! Enforce explicit typing of all variables in this routine
! SUBROUTINE ARGUMENT DEFINITIONS:
! na
! SUBROUTINE PARAMETER DEFINITIONS:
CHARACTER(len=*), PARAMETER :: RoutineName='HVACControllers: GetControllerInput: ' ! include trailing blank space
! INTERFACE BLOCK SPECIFICATIONS
! na
! DERIVED TYPE DEFINITIONS
! na
! SUBROUTINE LOCAL VARIABLE DECLARATIONS:
INTEGER :: Num ! The Controller that you are currently loading input into
INTEGER :: NumSimpleControllers
INTEGER :: NumAlphas
INTEGER :: NumNums
INTEGER :: NumArgs
INTEGER :: IOSTAT
INTEGER :: AirLoopNum ! DO index for each air loop
LOGICAL :: ActuatorNodeNotFound ! true if no water coil inlet node match for actuator node
REAL(r64), ALLOCATABLE, DIMENSION(:) :: NumArray
CHARACTER(LEN=MaxNameLength), ALLOCATABLE, DIMENSION(:) :: AlphArray
CHARACTER(len=MaxNameLength), ALLOCATABLE, DIMENSION(:) :: cAlphaFields ! Alpha field names
CHARACTER(len=MaxNameLength), ALLOCATABLE, DIMENSION(:) :: cNumericFields ! Numeric field names
LOGICAL, ALLOCATABLE, DIMENSION(:) :: lAlphaBlanks ! Logical array, alpha field input BLANK = .true.
LOGICAL, ALLOCATABLE, DIMENSION(:) :: lNumericBlanks ! Logical array, numeric field input BLANK = .true.
CHARACTER(LEN=MaxNameLength) :: CurrentModuleObject ! for ease in getting objects
LOGICAL :: IsNotOK ! Flag to verify name
LOGICAL :: IsBlank ! Flag for blank name
LOGICAL :: ErrorsFound=.FALSE.
INTEGER :: iNodeType ! for checking actuator node type
INTEGER :: WaterCoilNum ! water coil index
LOGICAL :: NodeNotFound ! flag true if the sensor node is on the coil air outlet node
LOGICAL :: NotHeatingCoil ! flag true if the water coil is a cooling coil
LOGICAL :: EMSSetpointErrorFlag ! flag true is EMS is used to set node setpoints
! All the controllers are loaded into the same derived type, both the PI and Limit
! These controllers are separate objects and loaded sequentially, but will
! be retrieved by name as they are needed.
CurrentModuleObject = 'Controller:WaterCoil'
NumSimpleControllers = GetNumObjectsFound(CurrentModuleObject)
NumControllers = NumSimpleControllers
! Allocate stats data structure for each air loop and controller if needed
IF ( TrackAirLoopEnvFlag .OR. TraceAirLoopEnvFlag .OR. TraceHVACControllerEnvFlag ) THEN
IF ( NumPrimaryAirSys > 0 ) THEN
NumAirLoopStats = NumPrimaryAirSys
ALLOCATE(AirLoopStats(NumAirLoopStats))
! Allocate controller statistics data for each controller on each air loop
DO AirLoopNum=1,NumPrimaryAirSys
ALLOCATE(AirLoopStats(AirLoopNum)%ControllerStats(PrimaryAirSystem(AirLoopNum)%NumControllers))
END DO
END IF
END IF
IF (NumControllers == 0) RETURN
! Condition of no controllers will be taken care of elsewhere, if necessary
ALLOCATE(ControllerProps(NumControllers))
ALLOCATE(RootFinders(NumControllers))
ALLOCATE(CheckEquipName(NumControllers))
CheckEquipName=.true.
CALL GetObjectDefMaxArgs(CurrentModuleObject,NumArgs,NumAlphas,NumNums)
ALLOCATE(AlphArray(NumAlphas))
AlphArray=' '
ALLOCATE(cAlphaFields(NumAlphas))
cAlphaFields=' '
ALLOCATE(cNumericFields(NumNums))
cNumericFields=' '
ALLOCATE(NumArray(NumNums))
NumArray=0.0d0
ALLOCATE(lAlphaBlanks(NumAlphas))
lAlphaBlanks=.true.
ALLOCATE(lNumericBlanks(NumNums))
lNumericBlanks=.true.
! Now find and load all of the simple controllers.
IF (NumSimpleControllers .GT. 0) THEN
DO Num = 1, NumSimpleControllers
CALL GetObjectItem(CurrentModuleObject,Num,AlphArray,NumAlphas,NumArray,NumNums,IOSTAT, &
NumBlank=lNumericBlanks,AlphaBlank=lAlphaBlanks, &
AlphaFieldNames=cAlphaFields,NumericFieldNames=cNumericFields)
IsNotOK = .FALSE.
IsBlank = .FALSE.
CALL VerifyName(AlphArray(1),ControllerProps%ControllerName,Num-1,IsNotOK,IsBlank,TRIM(CurrentModuleObject)//' Name')
IF (IsNotOK) THEN
ErrorsFound=.TRUE.
IF (IsBlank) AlphArray(1)='xxxxx'
ENDIF
ControllerProps(Num)%ControllerName = AlphArray(1)
ControllerProps(Num)%ControllerType = TRIM(CurrentModuleObject)
SELECT CASE (AlphArray(2))
CASE ('TEMPERATURE')
ControllerProps(Num)%ControlVar = iTemperature
CASE ('HUMIDITYRATIO')
ControllerProps(Num)%ControlVar = iHumidityRatio
CASE ('TEMPERATUREANDHUMIDITYRATIO')
ControllerProps(Num)%ControlVar = iTemperatureAndHumidityRatio
! CASE ('FLOW')
! ControllerProps(Num)%ControlVar = iFlow
CASE DEFAULT
CALL ShowSevereError(RoutineName//TRIM(CurrentModuleObject)//'="'// &
TRIM(AlphArray(1))//'".')
CALL ShowSevereError('...Invalid '//TRIM(cAlphaFields(2))//'="'//TRIM(AlphArray(2))// &
'", must be Temperature, HumidityRatio, or TemperatureAndHumidityRatio.')
ErrorsFound=.true.
END SELECT
IF (SameString(AlphArray(3) , 'Normal')) THEN
ControllerProps(Num)%Action = iNormalAction
ELSEIF (SameString(AlphArray(3) , 'Reverse')) THEN
ControllerProps(Num)%Action = iReverseAction
ELSEIF (lAlphaBlanks(3)) THEN
ControllerProps(Num)%Action = 0
ELSE
CALL ShowSevereError(RoutineName//TRIM(CurrentModuleObject)//'="'// &
TRIM(AlphArray(1))//'".')
CALL ShowSevereError('...Invalid '//TRIM(cAlphaFields(3))//'="'//TRIM(AlphArray(3))// &
'", must be "Normal", "Reverse" or blank.')
ErrorsFound=.true.
ENDIF
IF (AlphArray(4) == 'FLOW') THEN
ControllerProps(Num)%ActuatorVar = iFlow
ELSE
CALL ShowSevereError(RoutineName//TRIM(CurrentModuleObject)//'="'// &
TRIM(AlphArray(1))//'".')
CALL ShowContinueError('...Invalid '//TRIM(cAlphaFields(4))//'="'//TRIM(AlphArray(4))// &
'", only FLOW is allowed.')
ErrorsFound=.true.
ENDIF
ControllerProps(Num)%SensedNode = &
GetOnlySingleNode(AlphArray(5),ErrorsFound,CurrentModuleObject,AlphArray(1), &
NodeType_Unknown,NodeConnectionType_Sensor,1,ObjectIsNotParent)
ControllerProps(Num)%ActuatedNode = &
GetOnlySingleNode(AlphArray(6),ErrorsFound,CurrentModuleObject,AlphArray(1), &
NodeType_Unknown,NodeConnectionType_Actuator,1,ObjectIsNotParent)
ControllerProps(Num)%Offset = NumArray(1)
ControllerProps(Num)%MaxVolFlowActuated = NumArray(2)
ControllerProps(Num)%MinVolFlowActuated = NumArray(3)
IF (.not. CheckForControllerWaterCoil(CurrentModuleObject,AlphArray(1))) THEN
CALL ShowSevereError(RoutineName//TRIM(CurrentModuleObject)//'="'// &
TRIM(AlphArray(1))//'" not found on any AirLoopHVAC:ControllerList.')
ErrorsFound = .TRUE.
ENDIF
IF ( ControllerProps(Num)%SensedNode > 0) THEN
CALL CheckForSensorAndSetpointNode(ControllerProps(Num)%SensedNode,ControllerProps(Num)%ControlVar,NodeNotFound)
IF (NodeNotFound) THEN
! the sensor node is not on the water coil air outlet node
CALL ShowWarningError(RoutineName//TRIM(ControllerProps(Num)%ControllerType)//'="'// &
TRIM(ControllerProps(Num)%ControllerName)//'". ')
CALL ShowContinueError(' ..Sensor node not found on water coil air outlet node.')
CALL ShowContinueError(' ..The sensor node may have been placed on a node downstream of the coil'// &
' or on an airloop outlet node.')
ELSE
! check if the setpoint is also on the same node where the sensor is placed on
EMSSetpointErrorFlag = .FALSE.
SELECT CASE (ControllerProps(Num)%ControlVar)
CASE (iTemperature)
CALL CheckIfNodeSetpointManagedByEMS(ControllerProps(Num)%SensedNode,iTemperatureSetpoint, EMSSetpointErrorFlag)
IF (EMSSetpointErrorFlag) THEN
IF(.NOT. NodeHasSPMCtrlVarType(ControllerProps(Num)%SensedNode, iCtrlVarType_Temp)) THEN
CALL ShowContinueError(' ..Temperature setpoint not found on coil air outlet node.')
CALL ShowContinueError(' ..The setpoint may have been placed on a node downstream of the coil'// &
' or on an airloop outlet node.')
CALL ShowContinueError(' ..Specify the setpoint and the sensor on the coil air outlet node when possible.')
END IF
ENDIF
CASE (iHumidityRatio)
CALL CheckIfNodeSetpointManagedByEMS(ControllerProps(Num)%SensedNode,iHumidityRatioMaxSetpoint, &
EMSSetpointErrorFlag)
IF (EMSSetpointErrorFlag) THEN
IF(.NOT. NodeHasSPMCtrlVarType(ControllerProps(Num)%SensedNode, iCtrlVarType_MaxHumRat)) THEN
CALL ShowContinueError(' ..Humidity ratio setpoint not found on coil air outlet node.')
CALL ShowContinueError(' ..The setpoint may have been placed on a node downstream of the coil'// &
' or on an airloop outlet node.')
CALL ShowContinueError(' ..Specify the setpoint and the sensor on the coil air outlet node when possible.')
END IF
ENDIF
CASE (iTemperatureAndHumidityRatio)
CALL CheckIfNodeSetpointManagedByEMS(ControllerProps(Num)%SensedNode,iTemperatureSetpoint, EMSSetpointErrorFlag)
IF (EMSSetpointErrorFlag) THEN
IF(.NOT. NodeHasSPMCtrlVarType(ControllerProps(Num)%SensedNode, iCtrlVarType_Temp)) THEN
CALL ShowContinueError(' ..Temperature setpoint not found on coil air outlet node.')
CALL ShowContinueError(' ..The setpoint may have been placed on a node downstream of the coil'// &
' or on an airloop outlet node.')
CALL ShowContinueError(' ..Specify the setpoint and the sensor on the coil air outlet node when possible.')
END IF
ENDIF
EMSSetpointErrorFlag = .FALSE.
CALL CheckIfNodeSetpointManagedByEMS(ControllerProps(Num)%SensedNode,iHumidityRatioMaxSetpoint, &
EMSSetpointErrorFlag)
IF (EMSSetpointErrorFlag) THEN
IF(.NOT. NodeHasSPMCtrlVarType(ControllerProps(Num)%SensedNode, iCtrlVarType_MaxHumRat)) THEN
CALL ShowContinueError(' ..Humidity ratio setpoint not found on coil air outlet node.')
CALL ShowContinueError(' ..The setpoint may have been placed on a node downstream of the coil'// &
' or on an airloop outlet node.')
CALL ShowContinueError(' ..Specify the setpoint and the sensor on the coil air outlet node when possible.')
END IF
ENDIF
END SELECT
ENDIF
ENDIF
END DO
END IF
! check that actuator nodes are matched by a water coil inlet node
DO Num = 1, NumSimpleControllers
CALL CheckActuatorNode(ControllerProps(Num)%ActuatedNode, iNodeType, ActuatorNodeNotFound)
IF (ActuatorNodeNotFound) THEN
ErrorsFound=.true.
CALL ShowSevereError(RoutineName//TRIM(CurrentModuleObject)//'="'// &
TRIM(ControllerProps(Num)%ControllerName)//'":')
CALL ShowContinueError('...the actuator node must also be a water inlet node of a water coil')
ELSE ! Node found, check type and action
IF (iNodeType == CoilType_Cooling) THEN
IF (ControllerProps(Num)%Action == 0) THEN
ControllerProps(Num)%Action = iReverseAction
ELSEIF (ControllerProps(Num)%Action == iNormalAction) THEN
CALL ShowWarningError(RoutineName//TRIM(CurrentModuleObject)//'="'// &
TRIM(ControllerProps(Num)%ControllerName)//'":')
CALL ShowContinueError('...Normal action has been specified for a cooling coil - should be Reverse.')
CALL ShowContinueError('...overriding user input action with Reverse Action.')
ControllerProps(Num)%Action = iReverseAction
ENDIF
ELSEIF (iNodeType == CoilType_Heating) THEN
IF (ControllerProps(Num)%Action == 0) THEN
ControllerProps(Num)%Action = iNormalAction
ELSEIF (ControllerProps(Num)%Action == iReverseAction) THEN
CALL ShowWarningError(RoutineName//TRIM(CurrentModuleObject)//'="'// &
TRIM(ControllerProps(Num)%ControllerName)//'":')
CALL ShowContinueError('...Reverse action has been specified for a heating coil - should be Normal.')
CALL ShowContinueError('...overriding user input action with Normal Action.')
ControllerProps(Num)%Action = iNormalAction
ENDIF
END IF
END IF
END DO
DEALLOCATE(AlphArray)
DEALLOCATE(cAlphaFields)
DEALLOCATE(cNumericFields)
DEALLOCATE(NumArray)
DEALLOCATE(lAlphaBlanks)
DEALLOCATE(lNumericBlanks)
!CR 8253 check that the sensed nodes in the controllers are in flow order in controller List
CALL CheckControllerListOrder
IF (ErrorsFound) THEN
CALL ShowFatalError(RoutineName//'Errors found in getting '//TRIM(CurrentModuleObject)//' input.')
ENDIF
RETURN
END SUBROUTINE GetControllerInput