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 GetEMSInput
! SUBROUTINE INFORMATION:
! AUTHOR Peter Graham Ellis
! DATE WRITTEN June 2006
! MODIFIED BG April 2009, finishing, renaming, etc.
! RE-ENGINEERED na
! PURPOSE OF THIS SUBROUTINE:
! Gets the EMS input from the input file.
! METHODOLOGY EMPLOYED:
! Standard EnergyPlus methodology.
! USE STATEMENTS:
USE DataGlobals, ONLY: MaxNameLength, AnyEnergyManagementSystemInModel, &
emsCallFromZoneSizing , emsCallFromSystemSizing , emsCallFromBeginNewEvironment, &
emsCallFromBeginNewEvironmentAfterWarmUp , emsCallFromBeginTimestepBeforePredictor, &
emsCallFromBeforeHVACManagers, emsCallFromAfterHVACManagers, emsCallFromHVACIterationLoop, &
emsCallFromEndZoneTimestepBeforeZoneReporting, emsCallFromEndZoneTimestepAfterZoneReporting, &
emsCallFromEndSystemTimestepBeforeHVACReporting, emsCallFromEndSystemTimestepAfterHVACReporting, &
emsCallFromComponentGetInput, emsCallFromUserDefinedComponentModel, emsCallFromUnitarySystemSizing
USE DataInterfaces, ONLY: ShowSevereError, ShowWarningError, ShowFatalError, SetupOutputVariable, ShowContinueError
USE InputProcessor, ONLY: GetNumObjectsFound, GetObjectItem, VerifyName, FindItemInList, MakeUpperCase, SameString, &
GetObjectDefMaxArgs
! USE OutputProcessor, ONLY: GetReportVarPointerForEMS
! USE DataIPShortCuts
USE RuntimeLanguageProcessor, ONLY: InitializeRuntimeLanguage, FindEMSVariable, NewEMSVariable, &
ExternalInterfaceInitializeErlVariable, SetErlValueNumber
IMPLICIT NONE ! Enforce explicit typing of all variables in this routine
! SUBROUTINE PARAMETER DEFINITIONS:
CHARACTER(len=*), PARAMETER :: Blank = ' '
! SUBROUTINE LOCAL VARIABLE DECLARATIONS:
INTEGER :: StackNum
INTEGER :: SensorNum
INTEGER :: ActuatorNum
INTEGER :: ActuatorVariableNum
! INTEGER :: ProgramNum
INTEGER :: VariableNum ! local do loop index
INTEGER :: NumAlphas ! Number of elements in the alpha array
INTEGER :: NumNums ! Number of elements in the numeric array
INTEGER :: AlphaNum
INTEGER :: IOStat ! IO Status when calling get input subroutine
! CHARACTER(len=MaxNameLength), DIMENSION(99) :: AlphArray ! Character string data ! 99 should really be some kind of constant
! REAL(r64), DIMENSION(1) :: NumArray ! Numeric data
LOGICAL :: IsNotOK ! Flag to verify name
LOGICAL :: IsBlank ! Flag for blank name
LOGICAL :: ErrorsFound = .FALSE.
INTEGER, EXTERNAL :: GetMeterIndex
! CHARACTER(len=MaxNameLength) :: objNameMsg = ' '
CHARACTER(len=MaxNameLength+40),ALLOCATABLE, DIMENSION(:) :: cAlphaFieldNames
CHARACTER(len=MaxNameLength+40),ALLOCATABLE, DIMENSION(:) :: cNumericFieldNames
LOGICAL, ALLOCATABLE, DIMENSION(:) :: lNumericFieldBlanks
LOGICAL, ALLOCATABLE, DIMENSION(:) :: lAlphaFieldBlanks
CHARACTER(len=MaxNameLength),ALLOCATABLE, DIMENSION(:) :: cAlphaArgs
REAL(r64),ALLOCATABLE, DIMENSION(:) :: rNumericArgs
CHARACTER(len=MaxNameLength) :: cCurrentModuleObject
INTEGER :: VarType
INTEGER :: VarIndex
LOGICAL :: FoundObjectType
LOGICAL :: FoundObjectName
LOGICAL :: FoundActuatorName
INTEGER :: NumErlProgramsThisManager ! temporary size of Erl programs in EMSProgramCallManager
INTEGER :: ManagerProgramNum ! index counter for Erl programs inside EMSProgramCallManager
INTEGER :: CallManagerNum ! loop counter for EMSProgramCallManager structure
INTEGER :: InternVarNum ! do loop counter for internal variables used (outer)
INTEGER :: InternalVarAvailNum ! do loop counter for internal variables available (inner)
INTEGER :: Loop ! do loop counter
INTEGER :: MaxNumAlphas = 0 !argument for call to GetObjectDefMaxArgs
INTEGER :: MaxNumNumbers = 0 !argument for call to GetObjectDefMaxArgs
INTEGER :: TotalArgs = 0 !argument for call to GetObjectDefMaxArgs
LOGICAL :: errFlag
! FLOW:
cCurrentModuleObject = 'EnergyManagementSystem:Sensor'
CALL GetObjectDefMaxArgs(cCurrentModuleObject,TotalArgs,NumAlphas,NumNums)
MaxNumNumbers=NumNums
MaxNumAlphas=NumAlphas
cCurrentModuleObject = 'EnergyManagementSystem:Actuator'
CALL GetObjectDefMaxArgs(cCurrentModuleObject,TotalArgs,NumAlphas,NumNums)
MaxNumNumbers=MAX(MaxNumNumbers,NumNums)
MaxNumAlphas=MAX(MaxNumAlphas,NumAlphas)
cCurrentModuleObject = 'EnergyManagementSystem:ProgramCallingManager'
CALL GetObjectDefMaxArgs(cCurrentModuleObject,TotalArgs,NumAlphas,NumNums)
MaxNumNumbers=MAX(MaxNumNumbers,NumNums)
MaxNumAlphas=MAX(MaxNumAlphas,NumAlphas)
cCurrentModuleObject = 'EnergyManagementSystem:Program'
CALL GetObjectDefMaxArgs(cCurrentModuleObject,TotalArgs,NumAlphas,NumNums)
MaxNumNumbers=MAX(MaxNumNumbers,NumNums)
MaxNumAlphas=MAX(MaxNumAlphas,NumAlphas)
cCurrentModuleObject = 'EnergyManagementSystem:Subroutine'
CALL GetObjectDefMaxArgs(cCurrentModuleObject,TotalArgs,NumAlphas,NumNums)
MaxNumNumbers=MAX(MaxNumNumbers,NumNums)
MaxNumAlphas=MAX(MaxNumAlphas,NumAlphas)
cCurrentModuleObject = 'EnergyManagementSystem:OutputVariable'
CALL GetObjectDefMaxArgs(cCurrentModuleObject,TotalArgs,NumAlphas,NumNums)
MaxNumNumbers=MAX(MaxNumNumbers,NumNums)
MaxNumAlphas=MAX(MaxNumAlphas,NumAlphas)
cCurrentModuleObject = 'ExternalInterface:Variable'
CALL GetObjectDefMaxArgs(cCurrentModuleObject,TotalArgs,NumAlphas,NumNums)
MaxNumNumbers=MAX(MaxNumNumbers,NumNums)
MaxNumAlphas=MAX(MaxNumAlphas,NumAlphas)
cCurrentModuleObject = 'ExternalInterface:Actuator'
CALL GetObjectDefMaxArgs(cCurrentModuleObject,TotalArgs,NumAlphas,NumNums)
MaxNumNumbers=MAX(MaxNumNumbers,NumNums)
MaxNumAlphas=MAX(MaxNumAlphas,NumAlphas)
! cCurrentModuleObject = 'EnergyManagementSystem:Sensor'
! CALL GetObjectDefMaxArgs(cCurrentModuleObject,TotalArgs,NumAlphas,NumNums)
! MaxNumNumbers=MAX(MaxNumNumbers,NumNums)
! MaxNumAlphas=MAX(MaxNumAlphas,NumAlphas)
cCurrentModuleObject = 'EnergyManagementSystem:GlobalVariable'
CALL GetObjectDefMaxArgs(cCurrentModuleObject,TotalArgs,NumAlphas,NumNums)
MaxNumNumbers=MAX(MaxNumNumbers,NumNums)
MaxNumAlphas=MAX(MaxNumAlphas,NumAlphas)
ALLOCATE(cAlphaFieldNames(MaxNumAlphas))
cAlphaFieldNames=' '
ALLOCATE(cAlphaArgs(MaxNumAlphas))
cAlphaArgs=' '
ALLOCATE(lAlphaFieldBlanks(MaxNumAlphas))
lAlphaFieldBlanks=.false.
ALLOCATE(cNumericFieldNames(MaxNumNumbers))
cNumericFieldNames=' '
ALLOCATE(rNumericArgs(MaxNumNumbers))
rNumericArgs=0.0d0
ALLOCATE(lNumericFieldBlanks(MaxNumNumbers))
lNumericFieldBlanks=.false.
cCurrentModuleObject = 'EnergyManagementSystem:Sensor'
IF (NumSensors > 0) THEN
ALLOCATE(Sensor(NumSensors))
DO SensorNum = 1, NumSensors
CALL GetObjectItem(cCurrentModuleObject, SensorNum, cAlphaArgs, NumAlphas, rNumericArgs, NumNums, IOSTAT ,&
AlphaBlank=lAlphaFieldBlanks, NumBlank=lNumericFieldBlanks, &
AlphaFieldnames=cAlphaFieldNames,NumericFieldNames=cNumericFieldNames)
IsNotOK = .FALSE.
IsBlank = .FALSE.
CALL VerifyName(cAlphaArgs(1), Sensor%Name, SensorNum - 1, IsNotOK, IsBlank, TRIM(cCurrentModuleObject)//' Name')
IF (IsNotOK) THEN
ErrorsFound = .TRUE.
IF (IsBlank) cAlphaArgs(1) = 'xxxxx'
END IF
CALL ValidateEMSVariableName(cCurrentModuleObject,cAlphaArgs(1),cAlphaFieldNames(1),errFlag,ErrorsFound)
IF (.not. errFlag) THEN
Sensor(SensorNum)%Name = Trim(cAlphaArgs(1))
! really needs to check for conflicts with program and function names too...done later
VariableNum = FindEMSVariable(cAlphaArgs(1), 0)
IF (VariableNum > 0) THEN
CALL ShowSevereError('Invalid '//TRIM(cAlphaFieldNames(1))//'='//TRIM(cAlphaArgs(1)))
CALL ShowContinueError('Entered in '//TRIM(cCurrentModuleObject)//'='//TRIM(cAlphaArgs(1)))
CALL ShowContinueError('Object name conflicts with a global variable name in EMS')
ErrorsFound = .TRUE.
ELSE
VariableNum = NewEMSVariable(cAlphaArgs(1), 0)
Sensor(SensorNum)%VariableNum = VariableNum
END IF
END IF
IF (cAlphaArgs(2) == '*') cAlphaArgs(2)=blank
Sensor(SensorNum)%UniqueKeyName = cAlphaArgs(2)
Sensor(SensorNum)%OutputVarName = cAlphaArgs(3)
VarIndex = GetMeterIndex(cAlphaArgs(3))
IF (VarIndex > 0) THEN
IF (.NOT. lAlphaFieldBlanks(2) ) THEN
CALL ShowWarningError('Unused'//TRIM(cAlphaFieldNames(2))//'='//TRIM(cAlphaArgs(2)))
CALL ShowContinueError('Entered in '//TRIM(cCurrentModuleObject)//'='//TRIM(cAlphaArgs(1)))
CALL ShowContinueError('Meter Name found; Key Name will be ignored') ! why meters have no keys..
ELSE
Sensor(SensorNum)%Type = 3
Sensor(SensorNum)%Index = VarIndex
Sensor(SensorNum)%CheckedOkay = .TRUE.
END IF
ELSE
! Search for variable names
CALL GetVariableTypeAndIndex(cAlphaArgs(3), cAlphaArgs(2), VarType, VarIndex)
IF (VarType /= 0) THEN
Sensor(SensorNum)%Type = VarType
IF (VarIndex /= 0) THEN
Sensor(SensorNum)%Index = VarIndex
Sensor(SensorNum)%CheckedOkay = .TRUE.
ENDIF
END IF
END IF
END DO ! SensorNum
END IF
cCurrentModuleObject = 'EnergyManagementSystem:Actuator'
IF (numActuatorsUsed + NumExternalInterfaceActuatorsUsed + NumExternalInterfaceFunctionalMockupUnitImportActuatorsUsed &
+ NumExternalInterfaceFunctionalMockupUnitExportActuatorsUsed> 0) THEN
ALLOCATE(EMSActuatorUsed(numActuatorsUsed + NumExternalInterfaceActuatorsUsed &
+ NumExternalInterfaceFunctionalMockupUnitImportActuatorsUsed &
+ NumExternalInterfaceFunctionalMockupUnitExportActuatorsUsed))
DO ActuatorNum = 1, numActuatorsUsed + NumExternalInterfaceActuatorsUsed &
+ NumExternalInterfaceFunctionalMockupUnitImportActuatorsUsed &
+ NumExternalInterfaceFunctionalMockupUnitExportActuatorsUsed
! If we process the ExternalInterface actuators, all we need to do is to change the
! name of the module object, and shift the ActuatorNum in GetObjectItem
IF ( ActuatorNum <= numActuatorsUsed ) THEN
CALL GetObjectItem(cCurrentModuleObject, ActuatorNum, cAlphaArgs, NumAlphas, rNumericArgs, &
NumNums, IOSTAT, AlphaBlank=lAlphaFieldBlanks, NumBlank=lNumericFieldBlanks, &
AlphaFieldnames=cAlphaFieldNames,NumericFieldNames=cNumericFieldNames)
ELSE IF ( ActuatorNum > numActuatorsUsed .AND. ActuatorNum <= numActuatorsUsed + NumExternalInterfaceActuatorsUsed) THEN
cCurrentModuleObject = 'ExternalInterface:Actuator'
CALL GetObjectItem(cCurrentModuleObject, ActuatorNum-numActuatorsUsed, cAlphaArgs, NumAlphas, rNumericArgs, &
NumNums, IOSTAT, AlphaBlank=lAlphaFieldBlanks, NumBlank=lNumericFieldBlanks, &
AlphaFieldnames=cAlphaFieldNames,NumericFieldNames=cNumericFieldNames)
ELSE IF ( ActuatorNum > numActuatorsUsed + NumExternalInterfaceActuatorsUsed .AND. &
ActuatorNum <= (numActuatorsUsed + NumExternalInterfaceActuatorsUsed + &
NumExternalInterfaceFunctionalMockupUnitImportActuatorsUsed) ) THEN
cCurrentModuleObject = 'ExternalInterface:FunctionalMockupUnitImport:To:Actuator'
CALL GetObjectItem(cCurrentModuleObject, ActuatorNum-numActuatorsUsed-NumExternalInterfaceActuatorsUsed, &
cAlphaArgs, NumAlphas, rNumericArgs, &
NumNums, IOSTAT, AlphaBlank=lAlphaFieldBlanks, NumBlank=lNumericFieldBlanks, &
AlphaFieldnames=cAlphaFieldNames,NumericFieldNames=cNumericFieldNames)
ELSE IF ( ActuatorNum > numActuatorsUsed + NumExternalInterfaceActuatorsUsed &
+ NumExternalInterfaceFunctionalMockupUnitImportActuatorsUsed .AND. ActuatorNum <= numActuatorsUsed &
+ NumExternalInterfaceActuatorsUsed + NumExternalInterfaceFunctionalMockupUnitImportActuatorsUsed &
+ NumExternalInterfaceFunctionalMockupUnitExportActuatorsUsed) THEN
cCurrentModuleObject = 'ExternalInterface:FunctionalMockupUnitExport:To:Actuator'
CALL GetObjectItem(cCurrentModuleObject, ActuatorNum-numActuatorsUsed-NumExternalInterfaceActuatorsUsed &
-NumExternalInterfaceFunctionalMockupUnitImportActuatorsUsed, &
cAlphaArgs, NumAlphas, rNumericArgs, &
NumNums, IOSTAT, AlphaBlank=lAlphaFieldBlanks, NumBlank=lNumericFieldBlanks, &
AlphaFieldnames=cAlphaFieldNames,NumericFieldNames=cNumericFieldNames)
END IF
IsNotOK = .FALSE.
IsBlank = .FALSE.
CALL VerifyName(cAlphaArgs(1), EMSActuatorUsed%Name, ActuatorNum - 1, IsNotOK, IsBlank,TRIM(cCurrentModuleObject)//' Name')
IF (IsNotOK) THEN
ErrorsFound = .TRUE.
IF (IsBlank) cAlphaArgs(1) = 'xxxxx'
END IF
CALL ValidateEMSVariableName(cCurrentModuleObject,cAlphaArgs(1),cAlphaFieldNames(1),errFlag,ErrorsFound)
IF (.not. errFlag) THEN
EMSActuatorUsed(ActuatorNum)%Name = cAlphaArgs(1)
! really needs to check for conflicts with program and function names too...
VariableNum = FindEMSVariable(cAlphaArgs(1), 0)
IF (VariableNum > 0) THEN
CALL ShowSevereError('Invalid '//TRIM(cAlphaFieldNames(1))//'='//TRIM(cAlphaArgs(1)))
CALL ShowContinueError('Entered in '//TRIM(cCurrentModuleObject)//'='//TRIM(cAlphaArgs(1)))
CALL ShowContinueError('Object name conflicts with a global variable name in EMS')
ErrorsFound = .TRUE.
ELSE
VariableNum = NewEMSVariable(cAlphaArgs(1), 0)
EMSActuatorUsed(ActuatorNum)%ErlVariableNum = VariableNum
IF ( ActuatorNum > numActuatorsUsed ) THEN
! Initialize variables for the ExternalInterface variables
CALL ExternalInterfaceInitializeErlVariable( VariableNum, &
SetErlValueNumber(rNumericArgs(1)), lNumericFieldBlanks(1) )
ENDIF
END IF
END IF
! need to store characters to finish processing later (once available Actuators have all been setup)
EMSActuatorUsed(ActuatorNum)%ComponentTypeName = cAlphaArgs(3)
EMSActuatorUsed(ActuatorNum)%UniqueIDName = cAlphaArgs(2)
EMSActuatorUsed(ActuatorNum)%ControlTypeName = cAlphaArgs(4)
FoundObjectType = .FALSE.
FoundObjectName = .FALSE.
FoundActuatorName = .FALSE.
DO ActuatorVariableNum = 1, numEMSActuatorsAvailable
IF (SameString(EMSActuatorAvailable(ActuatorVariableNum)%ComponentTypeName , cAlphaArgs(3))) THEN
FoundObjectType = .TRUE.
IF (SameString(EMSActuatorAvailable(ActuatorVariableNum)%UniqueIDName , cAlphaArgs(2))) THEN
FoundObjectName = .TRUE.
IF (SameString(EMSActuatorAvailable(ActuatorVariableNum)%ControlTypeName , cAlphaArgs(4))) THEN
FoundActuatorName = .TRUE.
EXIT
END IF
END IF
END IF
END DO
IF (FoundActuatorName) THEN
EMSActuatorUsed(ActuatorNum)%ActuatorVariableNum = ActuatorVariableNum
EMSActuatorUsed(ActuatorNum)%CheckedOkay = .TRUE.
END IF
END DO ! ActuatorNum
END IF
cCurrentModuleObject = 'EnergyManagementSystem:InternalVariable'
NumInternalVariablesUsed = GetNumObjectsFound(cCurrentModuleObject)
IF (NumInternalVariablesUsed > 0 ) THEN
ALLOCATE(EMSInternalVarsUsed(NumInternalVariablesUsed))
DO InternVarNum = 1, NumInternalVariablesUsed
CALL GetObjectItem(cCurrentModuleObject, InternVarNum, cAlphaArgs, NumAlphas, rNumericArgs, NumNums, &
IOSTAT, AlphaBlank=lAlphaFieldBlanks, NumBlank=lNumericFieldBlanks, &
AlphaFieldnames=cAlphaFieldNames,NumericFieldNames=cNumericFieldNames)
IsNotOK = .FALSE.
IsBlank = .FALSE.
CALL VerifyName(cAlphaArgs(1), EMSInternalVarsUsed%Name, InternVarNum - 1, IsNotOK, &
IsBlank,TRIM(cCurrentModuleObject)//' Name')
IF (IsNotOK) THEN
ErrorsFound = .TRUE.
IF (IsBlank) cAlphaArgs(1) = 'xxxxx'
END IF
CALL ValidateEMSVariableName(cCurrentModuleObject,cAlphaArgs(1),cAlphaFieldNames(1),errFlag,ErrorsFound)
IF (.not. errFlag) THEN
EMSInternalVarsUsed(InternVarNum)%Name = cAlphaArgs(1)
VariableNum = FindEMSVariable(cAlphaArgs(1), 0)
IF (VariableNum > 0) THEN
CALL ShowSevereError('Invalid '//TRIM(cAlphaFieldNames(1))//'='//TRIM(cAlphaArgs(1)))
CALL ShowContinueError('Entered in '//TRIM(cCurrentModuleObject)//'='//TRIM(cAlphaArgs(1)))
CALL ShowContinueError('Object name conflicts with a global variable name in EMS')
ErrorsFound = .TRUE.
ELSE
VariableNum = NewEMSVariable(cAlphaArgs(1), 0)
EMSInternalVarsUsed(InternVarNum)%ErlVariableNum = VariableNum
END IF
EMSInternalVarsUsed(InternVarNum)%UniqueIDName = cAlphaArgs(2)
EMSInternalVarsUsed(InternVarNum)%InternalDataTypeName = cAlphaArgs(3)
FoundObjectType = .FALSE.
FoundObjectName = .FALSE.
DO InternalVarAvailNum = 1, numEMSInternalVarsAvailable
IF (SameString(EMSInternalVarsAvailable(InternalVarAvailNum)%DataTypeName , cAlphaArgs(3))) THEN
FoundObjectType = .TRUE.
IF (SameString(EMSInternalVarsAvailable(InternalVarAvailNum)%UniqueIDName , cAlphaArgs(2))) THEN
FoundObjectName = .TRUE.
EXIT ! InternalVarAvailNum now holds needed index pointer
END IF
END IF
END DO
IF (FoundObjectName) THEN
EMSInternalVarsUsed(InternVarNum)%InternVarNum = InternalVarAvailNum
EMSInternalVarsUsed(InternVarNum)%CheckedOkay = .TRUE.
ENDIF
ENDIF
ENDDO
ENDIF
CALL InitializeRuntimeLanguage ! Loads built-in globals and functions, then performs GetInput for runtime language objects
IF (NumProgramCallManagers > 0) THEN
cCurrentModuleObject = 'EnergyManagementSystem:ProgramCallingManager'
ALLOCATE(EMSProgramCallManager(NumProgramCallManagers))
DO CallManagerNum = 1, NumProgramCallManagers
CALL GetObjectItem(cCurrentModuleObject, CallManagerNum, cAlphaArgs, NumAlphas, rNumericArgs, NumNums, &
IOSTAT, AlphaBlank=lAlphaFieldBlanks, NumBlank=lNumericFieldBlanks, &
AlphaFieldnames=cAlphaFieldNames,NumericFieldNames=cNumericFieldNames)
IsNotOK = .FALSE.
IsBlank = .FALSE.
CALL VerifyName(cAlphaArgs(1), EMSProgramCallManager%Name, CallManagerNum - 1, &
IsNotOK, IsBlank,TRIM(cCurrentModuleObject)//' Name')
IF (IsNotOK) THEN
ErrorsFound = .TRUE.
IF (IsBlank) cAlphaArgs(1) = 'xxxxx'
END IF
EMSProgramCallManager(CallManagerNum)%Name = cAlphaArgs(1)
SELECT CASE (TRIM(cAlphaArgs(2)))
CASE ('BEGINNEWENVIRONMENT')
EMSProgramCallManager(CallManagerNum)%CallingPoint = emsCallFromBeginNewEvironment
CASE ('AFTERNEWENVIRONMENTWARMUPISCOMPLETE')
EMSProgramCallManager(CallManagerNum)%CallingPoint = emsCallFromBeginNewEvironmentAfterWarmUp
CASE ('BEGINTIMESTEPBEFOREPREDICTOR')
EMSProgramCallManager(CallManagerNum)%CallingPoint = emsCallFromBeginTimestepBeforePredictor
CASE ('AFTERPREDICTORBEFOREHVACMANAGERS')
EMSProgramCallManager(CallManagerNum)%CallingPoint = emsCallFromBeforeHVACManagers
CASE ('AFTERPREDICTORAFTERHVACMANAGERS')
EMSProgramCallManager(CallManagerNum)%CallingPoint = emsCallFromAfterHVACManagers
CASE ('INSIDEHVACSYSTEMITERATIONLOOP')
EMSProgramCallManager(CallManagerNum)%CallingPoint = emsCallFromHVACIterationLoop
CASE ('ENDOFZONETIMESTEPBEFOREZONEREPORTING')
EMSProgramCallManager(CallManagerNum)%CallingPoint = emsCallFromEndZoneTimestepBeforeZoneReporting
CASE ('ENDOFZONETIMESTEPAFTERZONEREPORTING')
EMSProgramCallManager(CallManagerNum)%CallingPoint = emsCallFromEndZoneTimestepAfterZoneReporting
CASE ('ENDOFSYSTEMTIMESTEPBEFOREHVACREPORTING')
EMSProgramCallManager(CallManagerNum)%CallingPoint = emsCallFromEndSystemTimestepBeforeHVACReporting
CASE ('ENDOFSYSTEMTIMESTEPAFTERHVACREPORTING')
EMSProgramCallManager(CallManagerNum)%CallingPoint = emsCallFromEndSystemTimestepAfterHVACReporting
CASE ('ENDOFZONESIZING')
EMSProgramCallManager(CallManagerNum)%CallingPoint = emsCallFromZoneSizing
CASE ('ENDOFSYSTEMSIZING')
EMSProgramCallManager(CallManagerNum)%CallingPoint = emsCallFromSystemSizing
CASE ('AFTERCOMPONENTINPUTREADIN')
EMSProgramCallManager(CallManagerNum)%CallingPoint = emsCallFromComponentGetInput
CASE ('USERDEFINEDCOMPONENTMODEL')
EMSProgramCallManager(CallManagerNum)%CallingPoint = emsCallFromUserDefinedComponentModel
CASE ('UNITARYSYSTEMSIZING')
EMSProgramCallManager(CallManagerNum)%CallingPoint = emsCallFromUnitarySystemSizing
CASE DEFAULT
CALL ShowSevereError('Invalid '//TRIM(cAlphaFieldNames(2))//'='//TRIM(cAlphaArgs(2)))
CALL ShowContinueError('Entered in '//TRIM(cCurrentModuleObject)//'='//TRIM(cAlphaArgs(1)))
ErrorsFound = .TRUE.
END SELECT
NumErlProgramsThisManager = NumAlphas - 2
EMSProgramCallManager(CallManagerNum)%NumErlPrograms = NumErlProgramsThisManager
ALLOCATE(EMSProgramCallManager(CallManagerNum)%ErlProgramARR(NumErlProgramsThisManager) )
ManagerProgramNum = 0
DO AlphaNum = 3, NumAlphas
! find program name in Stack structure
IF (lAlphaFieldBlanks(AlphaNum)) THEN ! throw error
CALL ShowSevereError('Invalid '//TRIM(cAlphaFieldNames(AlphaNum))//'='//TRIM(cAlphaArgs(AlphaNum)))
CALL ShowContinueError('Entered in '//TRIM(cCurrentModuleObject)//'='//TRIM(cAlphaArgs(1)))
CALL ShowContinueError('Program names cannot be blank')
ErrorsFound = .TRUE.
ENDIF
StackNum = FindItemInList(cAlphaArgs(AlphaNum), ErlStack%Name, NumErlStacks)
IF (StackNum > 0) THEN ! found it
! check for duplicate and warn.
DO Loop = 1, ManagerProgramNum
IF (EMSProgramCallManager(CallManagerNum)%ErlProgramARR(Loop) == StackNum) THEN
CALL ShowWarningError('Duplicate '//TRIM(cAlphaFieldNames(AlphaNum))//'='//TRIM(cAlphaArgs(AlphaNum)))
CALL ShowContinueError('Entered in '//TRIM(cCurrentModuleObject)//'='//TRIM(cAlphaArgs(1)))
CALL ShowContinueError('Erl program appears more than once, and the simulation continues.')
END IF
END DO
ManagerProgramNum = ManagerProgramNum + 1
EMSProgramCallManager(CallManagerNum)%ErlProgramARR(ManagerProgramNum) = StackNum
ELSE
CALL ShowSevereError('Invalid '//TRIM(cAlphaFieldNames(AlphaNum))//'='//TRIM(cAlphaArgs(AlphaNum)))
CALL ShowContinueError('Entered in '//TRIM(cCurrentModuleObject)//'='//TRIM(cAlphaArgs(1)))
CALL ShowContinueError('Program Name not found.')
ErrorsFound = .TRUE.
END IF
END DO ! AlphaNum
ENDDO
ELSE ! no program calling manager in input
IF (NumErlPrograms > 0) THEN
cCurrentModuleObject = 'EnergyManagementSystem:ProgramCallingManager'
CALL ShowWarningError('Energy Management System is missing input object '//TRIM(cCurrentModuleObject))
CALL ShowContinueError('EnergyPlus Runtime Language programs need a calling manager to control when they get executed')
ENDIF
END IF
DEALLOCATE(cAlphaFieldNames)
DEALLOCATE(cAlphaArgs)
DEALLOCATE(lAlphaFieldBlanks)
DEALLOCATE(cNumericFieldNames)
DEALLOCATE(rNumericArgs)
DEALLOCATE(lNumericFieldBlanks)
IF (ErrorsFound) THEN
CALL ShowFatalError('Errors found in getting Energy Management System input. Preceding condition causes termination.')
END IF
RETURN
END SUBROUTINE GetEMSInput