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) | :: | reportErrors |
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 ProcessEMSInput(reportErrors)
! SUBROUTINE INFORMATION:
! AUTHOR B. Griffith
! DATE WRITTEN May 2009
! MODIFIED na
! RE-ENGINEERED na
! PURPOSE OF THIS SUBROUTINE:
! contains Some input checks that need to be deferred until later in the simulation
! METHODOLOGY EMPLOYED:
! Loop over objects doing input checks.
! Had to break up get user input into two phases because
! the actuators can't be set up until all the HVAC systems are read in, sized, etc.
! but we also want to allow customizing sizing calcs which occur much earlier in the simulation.
! so here we do a final pass and throw the errors that would usually occur during get input.
! REFERENCES:
! na
! USE STATEMENTS:
! USE DataIPShortcuts, ONLY: cCurrentModuleObject
USE InputProcessor, ONLY: SameString
USE DataInterfaces, ONLY: ShowSevereError, ShowWarningError, ShowContinueError, ShowFatalError
USE RuntimeLanguageProcessor, ONLY: BeginEnvrnInitializeRuntimeLanguage
USE ScheduleManager, ONLY: GetScheduleIndex
IMPLICIT NONE ! Enforce explicit typing of all variables in this routine
! SUBROUTINE ARGUMENT DEFINITIONS:
LOGICAL, INTENT(IN) :: reportErrors !. If true, then report out errors ,otherwise setup what we can
! SUBROUTINE PARAMETER DEFINITIONS:
! na
! INTERFACE BLOCK SPECIFICATIONS:
! na
! DERIVED TYPE DEFINITIONS:
! na
! SUBROUTINE LOCAL VARIABLE DECLARATIONS:
INTEGER :: SensorNum ! local loop
! INTEGER :: VariableNum ! local do loop index
INTEGER :: VarIndex
INTEGER, EXTERNAL :: GetMeterIndex
INTEGER :: VarType
LOGICAL :: ErrorsFound = .FALSE.
INTEGER :: ActuatorNum
LOGICAL :: FoundObjectType
LOGICAL :: FoundObjectName
LOGICAL :: FoundActuatorName
INTEGER :: ActuatorVariableNum
INTEGER :: InternVarNum ! local do loop index
INTEGER :: InternalVarAvailNum ! local do loop index
CHARACTER(len=MaxNameLength) :: cCurrentModuleObject
cCurrentModuleObject = 'EnergyManagementSystem:Sensor'
DO SensorNum = 1, NumSensors
IF (Sensor(SensorNum)%CheckedOkay) Cycle
! try again to process sensor.
VarIndex = GetMeterIndex(Sensor(SensorNum)%OutputVarName)
IF (VarIndex > 0) THEN
Sensor(SensorNum)%Type = 3
Sensor(SensorNum)%Index = VarIndex
ELSE
! Search for variable names
CALL GetVariableTypeAndIndex(Sensor(SensorNum)%OutputVarName, Sensor(SensorNum)%UniqueKeyName, VarType, VarIndex)
IF (VarType == 0) THEN
IF (reportErrors) THEN
CALL ShowSevereError('Invalid Output:Variable or Output:Meter Name ='//TRIM(Sensor(SensorNum)%OutputVarName) )
CALL ShowContinueError('Entered in '//TRIM(cCurrentModuleObject)//'='//TRIM(Sensor(SensorNum)%Name) )
CALL ShowContinueError('Output:Variable Name not found')
ErrorsFound = .TRUE.
ENDIF
ELSE IF (VarIndex == 0) THEN
IF (reportErrors) THEN
CALL ShowSevereError('Invalid Output:Variable or Output:Meter Index Key Name ='//TRIM(Sensor(SensorNum)%UniqueKeyName))
CALL ShowContinueError('For Output:Variable or Output:Meter = '//TRIM(Sensor(SensorNum)%OutputVarName))
CALL ShowContinueError('Entered in '//TRIM(cCurrentModuleObject)//'='//TRIM(Sensor(SensorNum)%Name))
CALL ShowContinueError('Unique Key Name not found.')
ErrorsFound = .TRUE.
ENDIF
ELSE
Sensor(SensorNum)%Type = VarType
Sensor(SensorNum)%Index = VarIndex
Sensor(SensorNum)%CheckedOkay = .TRUE.
! If variable is Schedule Value, then get the schedule id to register it as being used
IF (SameString(Sensor(SensorNum)%OutputVarName, 'Schedule Value')) THEN
Sensor(SensorNum)%SchedNum = GetScheduleIndex(Sensor(SensorNum)%UniqueKeyName)
IF (Sensor(SensorNum)%SchedNum == 0) THEN
Sensor(SensorNum)%CheckedOkay = .FALSE.
IF (reportErrors) THEN
CALL ShowSevereError('Invalid Output:Variable or Output:Meter Index Key Name ='// &
TRIM(Sensor(SensorNum)%UniqueKeyName))
CALL ShowContinueError('For Output:Variable or Output:Meter = '//TRIM(Sensor(SensorNum)%OutputVarName))
CALL ShowContinueError('Entered in '//TRIM(cCurrentModuleObject)//'='//TRIM(Sensor(SensorNum)%Name))
CALL ShowContinueError('Schedule Name not found.')
ErrorsFound = .TRUE.
ENDIF
ENDIF
ENDIF
END IF
END IF
END DO ! SensorNum
! added for FMU
DO ActuatorNum = 1, numActuatorsUsed + NumExternalInterfaceActuatorsUsed &
+ NumExternalInterfaceFunctionalMockupUnitImportActuatorsUsed + NumExternalInterfaceFunctionalMockupUnitExportActuatorsUsed
! If we process the ExternalInterface actuators, all we need to do is to change the
IF ( ActuatorNum <= numActuatorsUsed ) THEN
cCurrentModuleObject = 'EnergyManagementSystem:Actuator'
ELSE IF ( ActuatorNum > numActuatorsUsed .AND. ActuatorNum <= numActuatorsUsed + NumExternalInterfaceActuatorsUsed) THEN
cCurrentModuleObject = 'ExternalInterface:Actuator'
ELSE IF ( ActuatorNum > numActuatorsUsed + NumExternalInterfaceActuatorsUsed .AND. ActuatorNum <= numActuatorsUsed &
+ NumExternalInterfaceActuatorsUsed + NumExternalInterfaceFunctionalMockupUnitImportActuatorsUsed) THEN
cCurrentModuleObject = 'ExternalInterface:FunctionalMockupUnitImport:To:Actuator'
ELSE IF ( ActuatorNum > numActuatorsUsed + NumExternalInterfaceActuatorsUsed + &
NumExternalInterfaceFunctionalMockupUnitImportActuatorsUsed.AND. ActuatorNum <= numActuatorsUsed &
+ NumExternalInterfaceActuatorsUsed + NumExternalInterfaceFunctionalMockupUnitImportActuatorsUsed &
+ NumExternalInterfaceFunctionalMockupUnitExportActuatorsUsed) THEN
cCurrentModuleObject = 'ExternalInterface:FunctionalMockupUnitExport:To:Actuator'
END IF
IF (EMSActuatorUsed(ActuatorNum)%CheckedOkay) CYCLE
FoundObjectType = .FALSE.
FoundObjectName = .FALSE.
FoundActuatorName = .FALSE.
DO ActuatorVariableNum = 1, numEMSActuatorsAvailable
IF (SameString(EMSActuatorAvailable(ActuatorVariableNum)%ComponentTypeName , &
EMSActuatorUsed(ActuatorNum)%ComponentTypeName )) THEN
FoundObjectType = .TRUE.
IF (SameString(EMSActuatorAvailable(ActuatorVariableNum)%UniqueIDName , &
EMSActuatorUsed(ActuatorNum)%UniqueIDName )) THEN
FoundObjectName = .TRUE.
IF (SameString(EMSActuatorAvailable(ActuatorVariableNum)%ControlTypeName , &
EMSActuatorUsed(ActuatorNum)%ControlTypeName )) THEN
FoundActuatorName = .TRUE.
EXIT
END IF
END IF
END IF
END DO
IF (.NOT. FoundObjectType) THEN
IF (reportErrors) THEN
CALL ShowSevereError('Invalid Actuated Component Type ='//TRIM(EMSActuatorUsed(ActuatorNum)%ComponentTypeName))
CALL ShowContinueError('Entered in '//TRIM(cCurrentModuleObject)//'='//TRIM(EMSActuatorUsed(ActuatorNum)%Name))
CALL ShowContinueError('Component Type not found')
IF (OutputEDDFile) THEN
CALL ShowContinueError('Review .edd file for valid component types.')
ELSE
CALL ShowContinueError('Use Output:EnergyManagementSystem object to create .edd file for valid component types.')
ENDIF
ErrorsFound = .TRUE.
ENDIF
END IF
IF (.NOT. FoundObjectName) THEN
IF (reportErrors) THEN
CALL ShowSevereError('Invalid Actuated Component Unique Name ='//TRIM(EMSActuatorUsed(ActuatorNum)%UniqueIDName))
CALL ShowContinueError('Entered in '//TRIM(cCurrentModuleObject)//'='//TRIM(EMSActuatorUsed(ActuatorNum)%Name))
CALL ShowContinueError('Component Unique key name not found ')
IF (OutputEDDFile) THEN
CALL ShowContinueError('Review edd file for valid component names.')
ELSE
CALL ShowContinueError('Use Output:EnergyManagementSystem object to create .edd file for valid component names.')
ENDIF
ErrorsFound = .TRUE.
ENDIF
END IF
IF (.NOT. FoundActuatorName) THEN
IF (reportErrors) THEN
CALL ShowSevereError('Invalid Actuated Component Control Type ='//TRIM(EMSActuatorUsed(ActuatorNum)%ControlTypeName))
CALL ShowContinueError('Entered in '//TRIM(cCurrentModuleObject)//'='//TRIM(EMSActuatorUsed(ActuatorNum)%Name))
CALL ShowContinueError('Control Type not found')
IF (OutputEDDFile) THEN
CALL ShowContinueError('Review edd file for valid component control types.')
ELSE
CALL ShowContinueError('Use Output:EnergyManagementSystem object to create '// &
'.edd file for valid component control types.')
ENDIF
ErrorsFound = .TRUE.
ENDIF
ELSE
EMSActuatorUsed(ActuatorNum)%ActuatorVariableNum = ActuatorVariableNum
EMSActuatorUsed(ActuatorNum)%CheckedOkay = .TRUE.
END IF
END DO ! ActuatorNum
cCurrentModuleObject = 'EnergyManagementSystem:InternalVariable'
DO InternVarNum = 1, NumInternalVariablesUsed
IF (EMSInternalVarsUsed(InternVarNum)%CheckedOkay) CYCLE
FoundObjectType = .FALSE.
FoundObjectName = .FALSE.
DO InternalVarAvailNum = 1, numEMSInternalVarsAvailable
IF (SameString(EMSInternalVarsAvailable(InternalVarAvailNum)%DataTypeName , &
EMSInternalVarsUsed(InternVarNum)%InternalDataTypeName)) THEN
FoundObjectType = .TRUE.
IF (SameString(EMSInternalVarsAvailable(InternalVarAvailNum)%UniqueIDName , &
EMSInternalVarsUsed(InternVarNum)%UniqueIDName)) THEN
FoundObjectName = .TRUE.
EXIT ! InternalVarAvailNum now holds needed index pointer
END IF
END IF
ENDDO
IF (.not. FoundObjectType) THEN
IF (reportErrors) THEN
CALL ShowSevereError('Invalid Internal Data Type ='//TRIM(EMSInternalVarsUsed(InternVarNum)%InternalDataTypeName))
CALL ShowContinueError('Entered in '//TRIM(cCurrentModuleObject)//'='//TRIM(EMSInternalVarsUsed(InternVarNum)%Name))
CALL ShowContinueError('Internal data type name not found')
ErrorsFound = .TRUE.
ENDIF
ENDIF
IF (.NOT. FoundObjectName) THEN
IF (reportErrors) THEN
CALL ShowSevereError('Invalid Internal Data Index Key Name ='//TRIM(EMSInternalVarsUsed(InternVarNum)%UniqueIDName))
CALL ShowContinueError('Entered in '//TRIM(cCurrentModuleObject)//'='//TRIM(EMSInternalVarsUsed(InternVarNum)%Name))
CALL ShowContinueError('Internal data unique identifier not found')
ErrorsFound = .TRUE.
ENDIF
ELSE
EMSInternalVarsUsed(InternVarNum)%InternVarNum = InternalVarAvailNum
EMSInternalVarsUsed(InternVarNum)%CheckedOkay = .TRUE.
ENDIF
ENDDO
IF (reportErrors) THEN
CALL EchoOutActuatorKeyChoices
CALL EchoOutInternalVariableChoices
ENDIF
IF (ErrorsFound) THEN
CALL ShowFatalError('Errors found in processing Energy Management System input. Preceding condition causes termination.')
END IF
IF (reportErrors) THEN
CALL BeginEnvrnInitializeRuntimeLanguage
ENDIF
RETURN
END SUBROUTINE ProcessEMSInput