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=MaxNameLength) | :: | CurrentModuleObject | ||||
integer, | intent(in) | :: | NumSchemes | |||
integer, | intent(in) | :: | LoopNum | |||
integer, | intent(in) | :: | SchemeNum | |||
logical, | intent(inout) | :: | ErrorsFound |
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 FindCompSPInput(CurrentModuleObject,NumSchemes,LoopNum,SchemeNum,ErrorsFound)
! SUBROUTINE INFORMATION:
! AUTHOR Dan Fisher
! DATE WRITTEN July 2010
! MODIFIED B. Griffith, check setpoint nodes have setpoint managers on EMS on them.
! RE-ENGINEERED na
! PURPOSE OF THIS SUBROUTINE:
! Load component setpoint based input into PLANTLOOP data structure
! METHODOLOGY EMPLOYED:
! calls the Input Processor to retrieve data from input file.
! The format of the Energy+.idd (the EnergyPlus input data dictionary) for the
! following keywords is reflected exactly in this subroutine:
! PlantEquipmentOperation:ComponentSetPoint
! REFERENCES:
! na
! USE STATEMENTS:
USE InputProcessor, ONLY: GetObjectItem, SameString
USE DataLoopNode
USE NodeInputManager, ONLY: GetOnlySingleNode
USE DataSizing
USE DataIPShortCuts
USE ReportSizingManager, ONLY: ReportSizingOutput
USE DataGlobals, ONLY: AnyEnergyManagementSystemInModel
USE EMSManager , ONLY: CheckIfNodeSetpointManagedByEMS, iTemperatureSetpoint, &
iTemperatureMinSetpoint, iTemperatureMaxSetpoint
IMPLICIT NONE
! SUBROUTINE ARGUMENT DEFINITIONS:
LOGICAL, INTENT(INOUT) :: ErrorsFound ! May be set here and passed on
INTEGER, INTENT(IN) :: LoopNum ! May be set here and passed on
INTEGER, INTENT(IN) :: SchemeNum ! May be set here and passed on
INTEGER, INTENT(IN) :: NumSchemes ! May be set here and passed on
CHARACTER(len=MaxNameLength) :: CurrentModuleObject ! for ease in renaming
CHARACTER(len=MaxNameLength) :: EquipNum
! SUBROUTINE PARAMETER DEFINITIONS:
INTEGER, PARAMETER :: Plant = 1 ! Used to identify whether the current loop is Plant
INTEGER, PARAMETER :: Condenser = 2 ! Used to identify whether the current loop is Condenser
! INTERFACE BLOCK SPECIFICATIONS
! na
! DERIVED TYPE DEFINITIONS
! na
! SUBROUTINE LOCAL VARIABLE DECLARATIONS:
INTEGER :: NumAlphas
INTEGER :: NumNums
INTEGER :: Compnum
INTEGER :: CompInNode
INTEGER :: IOSTAT
REAL(r64):: CompFlowRate
INTEGER :: Num
CHARACTER(len=MaxNameLength) :: LoopOpSchemeObj ! Used to identify the object name for loop equipment operation scheme
LOGICAL :: SchemeNameFound ! Set to FALSE if a match of OpScheme object and OpScheme name is not found
LOGICAL :: NodeEMSSetpointMissing
SchemeNameFound = .TRUE.
IF (PlantLoop(LoopNum)%TypeofLoop == Plant) THEN
LoopOpSchemeObj = 'PlantEquipmentOperationSchemes'
ELSEIF (PlantLoop(LoopNum)%TypeofLoop == Condenser) THEN
LoopOpSchemeObj = 'CondenserEquipmentOperationSchemes'
ENDIF
IF (NumSchemes .GT. 0) THEN
DO Num = 1, NumSchemes
CALL GetObjectItem(CurrentModuleObject,Num, &
cAlphaArgs,NumAlphas,rNumericArgs,NumNums,IOSTAT)
IF(SameString(PlantLoop(LoopNum)%OpScheme(SchemeNum)%Name,cAlphaArgs(1))) EXIT
IF (Num == NumSchemes) THEN
CALL ShowSevereError(TRIM(LoopOpSchemeObj)//' = "'//TRIM(PlantLoop(LoopNum)%OperationScheme)// &
'", could not find '// &
TRIM(CurrentModuleObject)//' = "'//TRIM(PlantLoop(LoopNum)%OpScheme(SchemeNum)%Name)//'".')
ErrorsFound = .true.
SchemeNameFound = .FALSE.
ENDIF
ENDDO
IF (SchemeNameFound) THEN
! why only one equip list assumed here? because component setpoint managers have their own lists contained.
PlantLoop(LoopNum)%OpScheme(SchemeNum)%NumEquipLists = 1
ALLOCATE (PlantLoop(LoopNum)%OpScheme(SchemeNum)%EquipList(1))
PlantLoop(LoopNum)%OpScheme(SchemeNum)%EquipList(1)%NumComps = (NumAlphas - 1)/5
IF (PlantLoop(LoopNum)%OpScheme(SchemeNum)%EquipList(1)%NumComps .GT. 0) THEN
ALLOCATE (PlantLoop(LoopNum)%OpScheme(SchemeNum)%EquipList(1)%Comp &
(PlantLoop(LoopNum)%OpScheme(SchemeNum)%EquipList(1)%NumComps))
DO Compnum = 1, PlantLoop(LoopNum)%OpScheme(SchemeNum)%EquipList(1)%NumComps
PlantLoop(LoopNum)%OpScheme(SchemeNum)%EquipList(1)%Comp(compnum)%Typeof = cAlphaArgs(Compnum*5-3)
PlantLoop(LoopNum)%OpScheme(SchemeNum)%EquipList(1)%Comp(compnum)%Name = cAlphaArgs(Compnum*5-2)
PlantLoop(LoopNum)%OpScheme(SchemeNum)%EquipList(1)%Comp(compnum)%DemandNodeName = cAlphaArgs(Compnum*5-1)
PlantLoop(LoopNum)%OpScheme(SchemeNum)%EquipList(1)%Comp(compnum)%DemandNodeNum = &
GetOnlySingleNode(cAlphaArgs(Compnum*5-1),ErrorsFound, TRIM(CurrentModuleObject),cAlphaArgs(1), &
NodeType_Water,NodeConnectionType_Sensor, 1, ObjectIsNotParent)
PlantLoop(LoopNum)%OpScheme(SchemeNum)%EquipList(1)%Comp(compnum)%SetpointNodeName = cAlphaArgs(Compnum*5)
PlantLoop(LoopNum)%OpScheme(SchemeNum)%EquipList(1)%Comp(compnum)%SetpointNodeNum = &
GetOnlySingleNode(cAlphaArgs(Compnum*5),ErrorsFound,TRIM(CurrentModuleObject),cAlphaArgs(1), &
NodeType_Water,NodeConnectionType_Sensor, 1, ObjectIsNotParent)
PlantLoop(LoopNum)%OpScheme(SchemeNum)%EquipList(1)%Comp(compnum)%SetpointFlowRate = rNumericArgs(Compnum)
IF(rNumericArgs(Compnum) == AutoSize) THEN
DO Num = 1, SaveNumPlantComps
CompInNode = CompDesWaterFlow(Num)%SupNode
CompFlowRate = CompDesWaterFlow(Num)%DesVolFlowRate
IF(CompInNode == PlantLoop(LoopNum)%OpScheme(SchemeNum)%EquipList(1)%Comp(compnum)%DemandNodeNum) THEN
PlantLoop(LoopNum)%OpScheme(SchemeNum)%EquipList(1)%Comp(compnum)%SetpointFlowRate = CompFlowRate
ELSE
!call error...Demand node must be component inlet node for autosizing
END IF
END DO
Write(EquipNum,*) Num
CALL ReportSizingOutput(TRIM(CurrentModuleObject), PlantLoop(LoopNum)%OpScheme(SchemeNum)%Name, &
'Design Water Flow Rate [m3/s] Equipment # '//Trim(AdjustL(EquipNum)),CompFlowRate)
END IF
SELECT CASE(cAlphaArgs(compnum*5 + 1))
CASE ('COOLING')
PlantLoop(LoopNum)%OpScheme(SchemeNum)%EquipList(1)%Comp(compnum)%CtrlTypeNum = CoolingOp
CASE ('HEATING')
PlantLoop(LoopNum)%OpScheme(SchemeNum)%EquipList(1)%Comp(compnum)%CtrlTypeNum = HeatingOp
CASE ('DUAL')
PlantLoop(LoopNum)%OpScheme(SchemeNum)%EquipList(1)%Comp(compnum)%CtrlTypeNum = DualOp
END SELECT
IF((TRIM(cAlphaArgs(5 + 1)) .NE. 'COOLING') .AND. (TRIM(cAlphaArgs(5 + 1)) .NE. 'HEATING') &
.AND. (TRIM(cAlphaArgs(5 + 1)) .NE. 'DUAL')) THEN
Call ShowSevereError('Equipment Operation Mode should be either HEATING or COOLING or DUAL mode, for '// &
TRIM(CurrentModuleObject)//'='//TRIM(cAlphaArgs(1)))
END IF
!check that setpoint node has valid setpoint managers or EMS
SELECT CASE (PlantLoop(LoopNum)%LoopDemandCalcScheme)
CASE (SingleSetpoint)
IF (Node(PlantLoop(LoopNum)%OpScheme(SchemeNum)%EquipList(1)%Comp(compnum)%SetpointNodeNum)%TempSetPoint &
== SensedNodeFlagValue) THEN
IF (.NOT. AnyEnergyManagementSystemInModel) THEN
CALL ShowSevereError('Missing temperature setpoint for '//TRIM(CurrentModuleObject) &
//' named '//TRIM(cAlphaArgs(1)) )
CALL ShowContinueError('A temperature setpoint is needed at the node named '// &
TRIM(PlantLoop(LoopNum)%OpScheme(SchemeNum)%EquipList(1)%Comp(compnum)%SetpointNodeName) )
IF (PlantLoop(LoopNum)%TypeofLoop == Plant) THEN
CALL ShowContinueError('PlantLoop="'//trim(PlantLoop(LoopNum)%Name)// &
'", Plant Loop Demand Calculation Scheme=SingleSetpoint')
ELSEIF (PlantLoop(LoopNum)%TypeofLoop == Condenser) THEN ! not applicable to Condenser loops
ENDIF
CALL ShowContinueError(' Use a setpoint manager to place a single temperature setpoint on the node')
ErrorsFound=.true.
ELSE
! need call to EMS to check node
NodeEMSSetpointMissing = .FALSE.
CALL CheckIfNodeSetpointManagedByEMS( &
PlantLoop(LoopNum)%OpScheme(SchemeNum)%EquipList(1)%Comp(compnum)%SetpointNodeNum, &
iTemperatureSetpoint, NodeEMSSetpointMissing)
IF (NodeEMSSetpointMissing) THEN
CALL ShowSevereError('Missing temperature setpoint for '//TRIM(CurrentModuleObject) &
//' named '//TRIM(cAlphaArgs(1)) )
CALL ShowContinueError('A temperature setpoint is needed at the node named '// &
TRIM(PlantLoop(LoopNum)%OpScheme(SchemeNum)%EquipList(1)%Comp(compnum)%SetpointNodeName))
IF (PlantLoop(LoopNum)%TypeofLoop == Plant) THEN
CALL ShowContinueError('PlantLoop="'//trim(PlantLoop(LoopNum)%Name)// &
'", Plant Loop Demand Calculation Scheme=SingleSetpoint')
ELSEIF (PlantLoop(LoopNum)%TypeofLoop == Condenser) THEN ! not applicable to Condenser loops
ENDIF
CALL ShowContinueError(' Use a setpoint manager or EMS actuator to place a single temperature setpoint on node')
ErrorsFound=.true.
ENDIF
ENDIF
ENDIF
CASE (DualSetpointDeadband)
IF (PlantLoop(LoopNum)%OpScheme(SchemeNum)%EquipList(1)%Comp(compnum)%CtrlTypeNum == CoolingOp) THEN
IF (Node(PlantLoop(LoopNum)%OpScheme(SchemeNum)%EquipList(1)%Comp(compnum)%SetpointNodeNum)%TempSetPointHI &
== SensedNodeFlagValue) THEN
IF (.NOT. AnyEnergyManagementSystemInModel) THEN
CALL ShowSevereError('Missing temperature high setpoint for '//TRIM(CurrentModuleObject) &
//' named '//TRIM(cAlphaArgs(1)) )
CALL ShowContinueError('A temperature high setpoint is needed at the node named '// &
TRIM(PlantLoop(LoopNum)%OpScheme(SchemeNum)%EquipList(1)%Comp(compnum)%SetpointNodeName) )
IF (PlantLoop(LoopNum)%TypeofLoop == Plant) THEN
CALL ShowContinueError('PlantLoop="'//trim(PlantLoop(LoopNum)%Name)// &
'", Plant Loop Demand Calculation Scheme=DualSetpointDeadband')
ELSEIF (PlantLoop(LoopNum)%TypeofLoop == Condenser) THEN ! not applicable to Condenser loops
ENDIF
CALL ShowContinueError(' Use a setpoint manager to place a dual temperature setpoint on the node')
ErrorsFound=.true.
ELSE
! need call to EMS to check node
NodeEMSSetpointMissing = .FALSE.
CALL CheckIfNodeSetpointManagedByEMS( &
PlantLoop(LoopNum)%OpScheme(SchemeNum)%EquipList(1)%Comp(compnum)%SetpointNodeNum,&
iTemperatureMaxSetpoint, NodeEMSSetpointMissing)
IF (NodeEMSSetpointMissing) THEN
CALL ShowSevereError('Missing high temperature setpoint for '//TRIM(CurrentModuleObject) &
//' named '//TRIM(cAlphaArgs(1)) )
CALL ShowContinueError('A high temperature setpoint is needed at the node named '// &
TRIM(PlantLoop(LoopNum)%OpScheme(SchemeNum)%EquipList(1)%Comp(compnum)%SetpointNodeName))
IF (PlantLoop(LoopNum)%TypeofLoop == Plant) THEN
CALL ShowContinueError('PlantLoop="'//trim(PlantLoop(LoopNum)%Name)// &
'", Plant Loop Demand Calculation Scheme=DualSetpointDeadband')
ELSEIF (PlantLoop(LoopNum)%TypeofLoop == Condenser) THEN ! not applicable to Condenser loops
ENDIF
CALL ShowContinueError(' Use a setpoint manager or EMS actuator to place a dual or high temperature' &
//' setpoint on node')
ErrorsFound=.true.
ENDIF
ENDIF
ENDIF
ELSEIF (PlantLoop(LoopNum)%OpScheme(SchemeNum)%EquipList(1)%Comp(compnum)%CtrlTypeNum == HeatingOp) THEN
IF (Node(PlantLoop(LoopNum)%OpScheme(SchemeNum)%EquipList(1)%Comp(compnum)%SetpointNodeNum)%TempSetPointLo &
== SensedNodeFlagValue) THEN
IF (.NOT. AnyEnergyManagementSystemInModel) THEN
CALL ShowSevereError('Missing temperature low setpoint for '//TRIM(CurrentModuleObject) &
//' named '//TRIM(cAlphaArgs(1)) )
CALL ShowContinueError('A temperature low setpoint is needed at the node named '// &
TRIM(PlantLoop(LoopNum)%OpScheme(SchemeNum)%EquipList(1)%Comp(compnum)%SetpointNodeName) )
IF (PlantLoop(LoopNum)%TypeofLoop == Plant) THEN
CALL ShowContinueError('PlantLoop="'//trim(PlantLoop(LoopNum)%Name)// &
'", Plant Loop Demand Calculation Scheme=DualSetpointDeadband')
ELSEIF (PlantLoop(LoopNum)%TypeofLoop == Condenser) THEN ! not applicable to Condenser loops
ENDIF
CALL ShowContinueError(' Use a setpoint manager to place a dual temperature setpoint on the node')
ErrorsFound=.true.
ELSE
! need call to EMS to check node
NodeEMSSetpointMissing = .FALSE.
CALL CheckIfNodeSetpointManagedByEMS( &
PlantLoop(LoopNum)%OpScheme(SchemeNum)%EquipList(1)%Comp(compnum)%SetpointNodeNum, &
iTemperatureMinSetpoint, NodeEMSSetpointMissing)
CALL CheckIfNodeSetpointManagedByEMS( &
PlantLoop(LoopNum)%OpScheme(SchemeNum)%EquipList(1)%Comp(compnum)%SetpointNodeNum, &
iTemperatureMaxSetpoint, NodeEMSSetpointMissing)
IF (NodeEMSSetpointMissing) THEN
CALL ShowSevereError('Missing low temperature setpoint for '//TRIM(CurrentModuleObject) &
//' named '//TRIM(cAlphaArgs(1)) )
CALL ShowContinueError('A low temperature setpoint is needed at the node named '// &
TRIM(PlantLoop(LoopNum)%OpScheme(SchemeNum)%EquipList(1)%Comp(compnum)%SetpointNodeName))
IF (PlantLoop(LoopNum)%TypeofLoop == Plant) THEN
CALL ShowContinueError('PlantLoop="'//trim(PlantLoop(LoopNum)%Name)// &
'", Plant Loop Demand Calculation Scheme=DualSetpointDeadband')
ELSEIF (PlantLoop(LoopNum)%TypeofLoop == Condenser) THEN ! not applicable to Condenser loops
ENDIF
CALL ShowContinueError(' Use a setpoint manager or EMS actuator to place a dual or low temperature' &
//' setpoint on node')
ErrorsFound=.true.
ENDIF
ENDIF
END IF
ELSEIF (PlantLoop(LoopNum)%OpScheme(SchemeNum)%EquipList(1)%Comp(compnum)%CtrlTypeNum == DualOP) THEN
IF ((Node(PlantLoop(LoopNum)%OpScheme(SchemeNum)%EquipList(1)%Comp(compnum)%SetpointNodeNum)%TempSetPointHI &
== SensedNodeFlagValue) .OR. &
(Node(PlantLoop(LoopNum)%OpScheme(SchemeNum)%EquipList(1)%Comp(compnum)%SetpointNodeNum)%TempSetPointLo &
== SensedNodeFlagValue) ) THEN
IF (.NOT. AnyEnergyManagementSystemInModel) THEN
CALL ShowSevereError('Missing temperature dual setpoints for '//TRIM(CurrentModuleObject) &
//' named '//TRIM(cAlphaArgs(1)) )
CALL ShowContinueError('A dual temperaturesetpoint is needed at the node named '// &
TRIM(PlantLoop(LoopNum)%OpScheme(SchemeNum)%EquipList(1)%Comp(compnum)%SetpointNodeName) )
IF (PlantLoop(LoopNum)%TypeofLoop == Plant) THEN
CALL ShowContinueError('PlantLoop="'//trim(PlantLoop(LoopNum)%Name)// &
'", Plant Loop Demand Calculation Scheme=DualSetpointDeadband')
ELSEIF (PlantLoop(LoopNum)%TypeofLoop == Condenser) THEN ! not applicable to Condenser loops
ENDIF
CALL ShowContinueError(' Use a setpoint manager to place a dual temperature setpoint on the node')
ErrorsFound=.true.
ELSE
! need call to EMS to check node
NodeEMSSetpointMissing = .FALSE.
CALL CheckIfNodeSetpointManagedByEMS( &
PlantLoop(LoopNum)%OpScheme(SchemeNum)%EquipList(1)%Comp(compnum)%SetpointNodeNum, &
iTemperatureMinSetpoint, NodeEMSSetpointMissing)
IF (NodeEMSSetpointMissing) THEN
CALL ShowSevereError('Missing dual temperature setpoint for '//TRIM(CurrentModuleObject) &
//' named '//TRIM(cAlphaArgs(1)) )
CALL ShowContinueError('A dual temperature setpoint is needed at the node named '// &
TRIM(PlantLoop(LoopNum)%OpScheme(SchemeNum)%EquipList(1)%Comp(compnum)%SetpointNodeName))
IF (PlantLoop(LoopNum)%TypeofLoop == Plant) THEN
CALL ShowContinueError('PlantLoop="'//trim(PlantLoop(LoopNum)%Name)// &
'", Plant Loop Demand Calculation Scheme=DualSetpointDeadband')
ELSEIF (PlantLoop(LoopNum)%TypeofLoop == Condenser) THEN ! not applicable to Condenser loops
ENDIF
CALL ShowContinueError(' Use a setpoint manager or EMS actuator to place a dual temperature' &
//' setpoint on node')
ErrorsFound=.true.
ENDIF
ENDIF
ENDIF
ENDIF
END SELECT
END DO
ELSE
CALL ShowSevereError(TRIM(CurrentModuleObject)//' = "'//TRIM(cAlphaArgs(1))//&
'", specified without any machines.')
ErrorsFound=.true.
ENDIF
ENDIF
ELSE
CALL ShowSevereError(TRIM(LoopOpSchemeObj)//' = "'//TRIM(PlantLoop(LoopNum)%OperationScheme)// &
'", could not find '// &
TRIM(CurrentModuleObject)//' = "'//TRIM(PlantLoop(LoopNum)%OpScheme(SchemeNum)%Name)//'".')
ErrorsFound=.true.
ENDIF
RETURN
END SUBROUTINE FindCompSPInput