SUBROUTINE GetRuntimeLanguageUserInput
! SUBROUTINE INFORMATION:
! AUTHOR Peter Graham Ellis
! DATE WRITTEN June 2006
! MODIFIED Brent Griffith April 2009
! RE-ENGINEERED na
! PURPOSE OF THIS SUBROUTINE:
! Gets the runtime language objects from the input file.
! GetInput is called from other modules that reference runtime language objects.
! The runtime language objects are all loaded in one pass
! METHODOLOGY EMPLOYED:
! The runtime language objects are all loaded in one step, names registered, etc. They are parsed in a second step
! once all the object names are known.
! USE STATEMENTS:
USE DataGlobals, ONLY: MaxNameLength, TimeStepZone
USE DataInterfaces, ONLY: ShowSevereError, ShowWarningError, ShowFatalError, &
SetupOutputVariable, ShowContinueError
USE InputProcessor, ONLY: GetNumObjectsFound, GetObjectItem, VerifyName, GetObjectDefMaxArgs, &
SameString, FindItemInList
USE General, ONLY: TrimSigDigits
USE CurveManager, ONLY: GetCurveIndex, GetCurveType
USE DataHeatBalance,ONLY: Construct, TotConstructs
USE OutputProcessor,ONLY: UnitsStringLength
IMPLICIT NONE ! Enforce explicit typing of all variables in this routine
! SUBROUTINE PARAMETER DEFINITIONS:
CHARACTER(len=*), PARAMETER :: Blank = ' '
CHARACTER(len=*), PARAMETER :: RoutineName = 'GetRuntimeLanguageUserInput: '
! SUBROUTINE LOCAL VARIABLE DECLARATIONS:
INTEGER :: GlobalNum
INTEGER :: StackNum
!unused0909 INTEGER :: NumPrograms
!unused0909 INTEGER :: NumFunctions
INTEGER :: ErrorNum
INTEGER :: NumAlphas ! Number of elements in the alpha array
INTEGER :: NumNums ! Number of elements in the numeric array
INTEGER :: IOStat ! IO Status when calling get input subroutine
LOGICAL :: IsNotOK ! Flag to verify name
LOGICAL :: IsBlank ! Flag for blank name
LOGICAL :: ErrorsFound = .FALSE.
INTEGER :: VariableNum ! temporary
INTEGER :: RuntimeReportVarNum
!unused0909 INTEGER :: Pos
!unused0909 CHARACTER(len=MaxNameLength) :: VariableName
LOGICAL :: Found
CHARACTER(len=MaxNameLength) :: FreqString = ' ' ! temporary
CHARACTER(len=MaxNameLength) :: VarTypeString = ' ' ! temporary
CHARACTER(len=MaxNameLength) :: ResourceTypeString = ' '
CHARACTER(len=MaxNameLength) :: GroupTypeString = ' '
CHARACTER(len=MaxNameLength) :: EndUseTypeString = ' '
CHARACTER(len=MaxNameLength) :: EndUseSubCatString = ' '
INTEGER :: TrendNum
INTEGER :: NumTrendSteps
INTEGER :: loop
INTEGER :: ErlVarLoop
INTEGER :: CurveIndexNum
INTEGER :: MaxNumAlphas = 0 !argument for call to GetObjectDefMaxArgs
INTEGER :: MaxNumNumbers = 0 !argument for call to GetObjectDefMaxArgs
INTEGER :: TotalArgs = 0 !argument for call to GetObjectDefMaxArgs
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 :: ConstructNum
LOGICAL :: errFlag
INTEGER :: lbracket
CHARACTER(len=UnitsStringLength) :: UnitsA
CHARACTER(len=UnitsStringLength) :: UnitsB
INTEGER :: ptr
! FLOW:
IF (GetInput) THEN ! GetInput check is redundant with the InitializeRuntimeLanguage routine
GetInput = .FALSE.
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)
cCurrentModuleObject = 'EnergyManagementSystem:CurveOrTableIndexVariable'
CALL GetObjectDefMaxArgs(cCurrentModuleObject,TotalArgs,NumAlphas,NumNums)
MaxNumNumbers=MAX(MaxNumNumbers,NumNums)
MaxNumAlphas=MAX(MaxNumAlphas,NumAlphas)
cCurrentModuleObject = 'EnergyManagementSystem:ConstructionIndexVariable'
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:GlobalVariable'
IF (NumUserGlobalVariables + NumExternalInterfaceGlobalVariables > 0) THEN
DO GlobalNum = 1, NumUserGlobalVariables + NumExternalInterfaceGlobalVariables
! If we process the ExternalInterface actuators, all we need to do is to change the
! name of the module object, and add an offset for the variable number
! This is done in the following IF/THEN section.
IF ( GlobalNum <= NumUserGlobalVariables ) THEN
CALL GetObjectItem(cCurrentModuleObject, GlobalNum, cAlphaArgs, NumAlphas, rNumericArgs, &
NumNums, IOSTAT, AlphaBlank=lAlphaFieldBlanks, NumBlank=lNumericFieldBlanks, &
AlphaFieldnames=cAlphaFieldNames,NumericFieldNames=cNumericFieldNames)
ELSE
cCurrentModuleObject = 'ExternalInterface:Variable'
CALL GetObjectItem(cCurrentModuleObject, GlobalNum-NumUserGlobalVariables, cAlphaArgs, NumAlphas, rNumericArgs,&
NumNums, IOSTAT, AlphaBlank=lAlphaFieldBlanks, NumBlank=lNumericFieldBlanks, &
AlphaFieldnames=cAlphaFieldNames,NumericFieldNames=cNumericFieldNames)
END IF
! loop over each alpha and register variable named as global Erl variable
DO ErlVarLoop = 1, NumAlphas
CALL ValidateEMSVariableName(cCurrentModuleObject,cAlphaArgs(ErlVarLoop),cAlphaFieldNames(ErlVarLoop), &
errFlag,ErrorsFound)
IF (lAlphaFieldBlanks(ErlVarLoop)) THEN
CALL ShowWarningError(RoutineName//trim(cCurrentModuleObject))
CALL ShowContinueError('Blank '//TRIM(cAlphaFieldNames(1)))
CALL ShowContinueError('Blank entry will be skipped, and the simulation continues')
ELSEIF (.not. errFlag) THEN
VariableNum = FindEMSVariable(cAlphaArgs(ErlVarLoop), 0)
! Still need to check for conflicts with program and function names too
IF (VariableNum > 0) THEN
CALL ShowSevereError(RoutineName//trim(cCurrentModuleObject)//', invalid entry.')
CALL ShowContinueError('Invalid '//TRIM(cAlphaFieldNames(ErlVarLoop))//'='//TRIM(cAlphaArgs(ErlVarLoop)))
CALL ShowContinueError('Name conflicts with an existing global variable name')
ErrorsFound = .TRUE.
ELSE
VariableNum = NewEMSVariable(cAlphaArgs(ErlVarLoop), 0)
IF ( GlobalNum > NumUserGlobalVariables ) THEN
! Initialize variables for the ExternalInterface variables.
! This object requires an initial value.
CALL ExternalInterfaceInitializeErlVariable( VariableNum, &
SetErlValueNumber(rNumericArgs(1)), .false. )
END IF
END IF
END IF
ENDDO
END DO
END IF
cCurrentModuleObject = 'EnergyManagementSystem:CurveOrTableIndexVariable'
NumEMSCurveIndices = GetNumObjectsFound(cCurrentModuleObject)
IF (NumEMSCurveIndices > 0) THEN
ALLOCATE(CurveIndexVariableNums(NumEMSCurveIndices))
CurveIndexVariableNums = 0
DO Loop =1, NumEMSCurveIndices
CALL GetObjectItem(cCurrentModuleObject, Loop, cAlphaArgs, NumAlphas, rNumericArgs, &
NumNums, IOSTAT, AlphaBlank=lAlphaFieldBlanks, NumBlank=lNumericFieldBlanks, &
AlphaFieldnames=cAlphaFieldNames,NumericFieldNames=cNumericFieldNames)
! check if variable name is unique and well formed
CALL ValidateEMSVariableName(cCurrentModuleObject,cAlphaArgs(1),cAlphaFieldNames(1), &
errFlag,ErrorsFound)
IF (lAlphaFieldBlanks(1)) THEN
CALL ShowSevereError(RoutineName//trim(cCurrentModuleObject))
CALL ShowContinueError('Blank '//TRIM(cAlphaFieldNames(1)))
CALL ShowContinueError('Blank entry for Erl variable name is not allowed')
ErrorsFound = .TRUE.
ELSEIF (.not. errFlag) THEN
VariableNum = FindEMSVariable(cAlphaArgs(1), 0)
IF (VariableNum > 0) THEN
CALL ShowSevereError(RoutineName//trim(cCurrentModuleObject)//'="'//trim(cAlphaArgs(1))//' invalid field.')
CALL ShowContinueError('Invalid '//TRIM(cAlphaFieldNames(1)))
CALL ShowContinueError('Name conflicts with an existing variable name')
ErrorsFound = .TRUE.
ELSE
! create new EMS variable
VariableNum = NewEMSVariable(cAlphaArgs(1), 0)
! store variable num
CurveIndexVariableNums(Loop) = VariableNum
ENDIF
ENDIF
CurveIndexNum = GetCurveIndex(cAlphaArgs(2)) ! curve name
IF (CurveIndexNum == 0) THEN
IF (lAlphaFieldBlanks(2)) THEN
CALL ShowSevereError(RoutineName//trim(cCurrentModuleObject)//'="'//trim(cAlphaArgs(1))//' blank field.')
CALL ShowContinueError('Blank '//TRIM(cAlphaFieldNames(2)))
CALL ShowContinueError('Blank entry for curve or table name is not allowed')
ELSE
CALL ShowSevereError(RoutineName//trim(cCurrentModuleObject)//'="'//trim(cAlphaArgs(1))//' invalid field.')
CALL ShowContinueError('Invalid '//TRIM(cAlphaFieldNames(2))//'='//TRIM(cAlphaArgs(2)))
CALL ShowContinueError('Curve or table was not found.')
ENDIF
ErrorsFound = .TRUE.
ELSE
! fill Erl variable with curve index
ErlVariable(VariableNum)%Value = SetErlValueNumber(REAL(CurveIndexNum, r64))
ENDIF
ENDDO
ENDIF ! NumEMSCurveIndices > 0
cCurrentModuleObject = 'EnergyManagementSystem:ConstructionIndexVariable'
NumEMSConstructionIndices = GetNumObjectsFound(cCurrentModuleObject)
IF (NumEMSConstructionIndices > 0) THEN
ALLOCATE(ConstructionIndexVariableNums(NumEMSConstructionIndices))
ConstructionIndexVariableNums = 0
DO Loop =1, NumEMSConstructionIndices
CALL GetObjectItem(cCurrentModuleObject, Loop, cAlphaArgs, NumAlphas, rNumericArgs, &
NumNums, IOSTAT, AlphaBlank=lAlphaFieldBlanks, NumBlank=lNumericFieldBlanks, &
AlphaFieldnames=cAlphaFieldNames,NumericFieldNames=cNumericFieldNames)
! check if variable name is unique and well formed
CALL ValidateEMSVariableName(cCurrentModuleObject,cAlphaArgs(1),cAlphaFieldNames(1), &
errFlag,ErrorsFound)
IF (lAlphaFieldBlanks(1)) THEN
CALL ShowSevereError(RoutineName//trim(cCurrentModuleObject))
CALL ShowContinueError('Blank '//TRIM(cAlphaFieldNames(1)))
CALL ShowContinueError('Blank entry for Erl variable name is not allowed')
ErrorsFound = .TRUE.
ELSEIF (.not. errFlag) THEN
VariableNum = FindEMSVariable(cAlphaArgs(1), 0)
IF (VariableNum > 0) THEN
CALL ShowSevereError(RoutineName//trim(cCurrentModuleObject)//'="'//trim(cAlphaArgs(1))//' invalid field.')
CALL ShowContinueError('Invalid '//TRIM(cAlphaFieldNames(1)))
CALL ShowContinueError('Name conflicts with an existing variable name')
ErrorsFound = .TRUE.
ELSE
! create new EMS variable
VariableNum = NewEMSVariable(cAlphaArgs(1), 0)
! store variable num
ConstructionIndexVariableNums(Loop) = VariableNum
ENDIF
ELSE
CYCLE
ENDIF
ConstructNum = FindItemInList(cAlphaArgs(2), Construct%Name, TotConstructs)
IF (ConstructNum == 0) THEN
IF (lAlphaFieldBlanks(2)) THEN
CALL ShowSevereError(RoutineName//trim(cCurrentModuleObject)//'="'//trim(cAlphaArgs(1))//' blank field.')
CALL ShowContinueError('Blank '//TRIM(cAlphaFieldNames(2)))
CALL ShowContinueError('Blank entry for construction name is not allowed')
ELSE
CALL ShowSevereError(RoutineName//trim(cCurrentModuleObject)//'="'//trim(cAlphaArgs(1))//' invalid field.')
CALL ShowContinueError('Invalid '//TRIM(cAlphaFieldNames(2))//'='//TRIM(cAlphaArgs(2)))
CALL ShowContinueError('Construction was not found.')
ENDIF
ErrorsFound = .TRUE.
ELSE
! fill Erl variable with curve index
ErlVariable(VariableNum)%Value = SetErlValueNumber(REAL(ConstructNum, r64))
ENDIF
ENDDO
ENDIF ! NumEMSConstructionIndices > 0
NumErlStacks = NumErlPrograms + NumErlSubroutines
ALLOCATE(ErlStack(NumErlStacks))
IF (NumErlPrograms > 0) THEN
cCurrentModuleObject = 'EnergyManagementSystem:Program'
DO StackNum = 1, NumErlPrograms
CALL GetObjectItem(cCurrentModuleObject, StackNum, cAlphaArgs, NumAlphas, rNumericArgs, &
NumNums, IOSTAT, AlphaBlank=lAlphaFieldBlanks, NumBlank=lNumericFieldBlanks, &
AlphaFieldnames=cAlphaFieldNames,NumericFieldNames=cNumericFieldNames)
IsNotOK = .FALSE.
IsBlank = .FALSE.
CALL VerifyName(cAlphaArgs(1), ErlStack%Name, StackNum - 1, IsNotOK, IsBlank, TRIM(cCurrentModuleObject)//' Name')
IF (IsNotOK) THEN
ErrorsFound = .TRUE.
IF (IsBlank) cAlphaArgs(1) = 'xxxxx'
END IF
CALL ValidateEMSProgramName(cCurrentModuleObject,cAlphaArgs(1),cAlphaFieldNames(1), &
'Programs',errFlag,ErrorsFound)
IF (.not. errFlag) THEN
ErlStack(StackNum)%Name = cAlphaArgs(1)
END IF
IF (NumAlphas > 1) THEN
ALLOCATE(ErlStack(StackNum)%Line(NumAlphas - 1))
ErlStack(StackNum)%NumLines = NumAlphas - 1
ErlStack(StackNum)%Line(1:NumAlphas - 1) = cAlphaArgs(2:NumAlphas) ! note array assignment
END IF
END DO ! ProgramNum
END IF
IF (NumErlSubroutines > 0) THEN
cCurrentModuleObject = 'EnergyManagementSystem:Subroutine'
DO StackNum = NumErlPrograms + 1, NumErlStacks
CALL GetObjectItem(cCurrentModuleObject, StackNum - NumErlPrograms, cAlphaArgs, NumAlphas, rNumericArgs, &
NumNums, IOSTAT, AlphaBlank=lAlphaFieldBlanks, NumBlank=lNumericFieldBlanks, &
AlphaFieldnames=cAlphaFieldNames,NumericFieldNames=cNumericFieldNames)
IsNotOK = .FALSE.
IsBlank = .FALSE.
CALL VerifyName(cAlphaArgs(1), ErlStack%Name, StackNum - 1, IsNotOK, IsBlank, TRIM(cCurrentModuleObject)//' Name')
IF (IsNotOK) THEN
ErrorsFound = .TRUE.
IF (IsBlank) cAlphaArgs(1) = 'xxxxx'
END IF
CALL ValidateEMSProgramName(cCurrentModuleObject,cAlphaArgs(1),cAlphaFieldNames(1), &
'Subroutines',errFlag,ErrorsFound)
IF (.not. errFlag) THEN
ErlStack(StackNum)%Name = cAlphaArgs(1)
END IF
IF (NumAlphas > 1) THEN
ALLOCATE(ErlStack(StackNum)%Line(NumAlphas - 1))
ErlStack(StackNum)%NumLines = NumAlphas - 1
ErlStack(StackNum)%Line(1:NumAlphas - 1) = cAlphaArgs(2:NumAlphas) ! note array assignment
END IF
END DO !
END IF
cCurrentModuleObject = 'EnergyManagementSystem:TrendVariable'
NumErlTrendVariables = GetNumObjectsFound(cCurrentModuleObject)
IF (NumErlTrendVariables > 0) THEN
ALLOCATE (TrendVariable(NumErlTrendVariables))
DO TrendNum = 1, NumErlTrendVariables
CALL GetObjectItem(cCurrentModuleObject, TrendNum, cAlphaArgs, NumAlphas, rNumericArgs, &
NumNums, IOSTAT, AlphaBlank=lAlphaFieldBlanks, NumBlank=lNumericFieldBlanks, &
AlphaFieldnames=cAlphaFieldNames,NumericFieldNames=cNumericFieldNames)
IsNotOK = .FALSE.
IsBlank = .FALSE.
CALL VerifyName(cAlphaArgs(1), TrendVariable%Name, TrendNum - 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
TrendVariable(TrendNum)%Name = cAlphaArgs(1)
END IF
VariableNum = FindEMSVariable(cAlphaArgs(2), 0)
! Still need to check for conflicts with program and function names too
IF (VariableNum == 0) THEN !did not find it
CALL ShowSevereError(RoutineName//trim(cCurrentModuleObject)//'="'//trim(cAlphaArgs(1))//' invalid field.')
CALL ShowContinueError('Invalid '//TRIM(cAlphaFieldNames(2))//'='//TRIM(cAlphaArgs(2)))
CALL ShowContinueError('Did not find a match with an EMS variable name')
ErrorsFound = .TRUE.
ELSE ! found it.
TrendVariable(TrendNum)%ErlVariablePointer = VariableNum
! register the trend pointer in ErlVariable.
ErlVariable(VariableNum)%Value%TrendVariable = .TRUE.
ErlVariable(VariableNum)%Value%TrendVarPointer = TrendNum
ENDIF
NumTrendSteps = FLOOR(rNumericArgs(1))
IF (NumTrendSteps > 0) THEN
TrendVariable(TrendNum)%LogDepth = NumTrendSteps
!setup data arrays using NumTrendSteps
ALLOCATE(TrendVariable(TrendNum)%TrendValARR(NumTrendSteps))
TrendVariable(TrendNum)%TrendValARR = 0.0D0 ! array init
ALLOCATE(TrendVariable(TrendNum)%tempTrendARR(NumTrendSteps))
TrendVariable(TrendNum)%tempTrendARR = 0.0D0 ! array init
ALLOCATE(TrendVariable(TrendNum)%TimeARR(NumTrendSteps))
!construct time data array for use with other calculations later
! current time is zero, each value in trend log array is one zone timestep further back in time
! units are hours. all terms negative, getting increasingly negative the further back in time
! further back in time is higher index in array
DO loop = 1, NumTrendSteps
IF (loop == 1) THEN
TrendVariable(TrendNum)%TimeARR(loop) = - TimeStepZone
CYCLE
ELSE
TrendVariable(TrendNum)%TimeARR(loop) = TrendVariable(TrendNum)%TimeARR(loop - 1) &
- TimeStepZone ! fractional hours
ENDIF
ENDDO
ELSE
CALL ShowSevereError(RoutineName//trim(cCurrentModuleObject)//'="'//trim(cAlphaArgs(1))//' invalid field.')
CALL ShowContinueError('Invalid '//Trim(cNumericFieldNames(1))//'='//TRIM(TrimSigDigits(rNumericArgs(1),2)))
CALL ShowContinueError('must be greater than zero')
ErrorsFound = .TRUE.
ENDIF
ENDDO ! trendnum
ENDIF
IF (ErrorsFound) THEN
CALL ShowFatalError('Errors found in getting EMS Runtime Language input. Preceding condition causes termination.')
END IF
! Parse the runtime language code
DO StackNum = 1, NumErlStacks
CALL ParseStack(StackNum)
IF (ErlStack(StackNum)%NumErrors > 0) THEN
CALL ShowSevereError('Errors found parsing EMS Runtime Language program or subroutine = '//TRIM(ErlStack(StackNum)%Name))
DO ErrorNum = 1, ErlStack(StackNum)%NumErrors
CALL ShowContinueError(ErlStack(StackNum)%Error(ErrorNum))
END DO
ErrorsFound = .TRUE.
END IF
END DO ! StackNum
IF (ErrorsFound) THEN
CALL ShowFatalError('Errors found in parsing EMS Runtime Language input. Preceding condition causes termination.')
END IF
IF ((NumEMSOutputVariables > 0) .OR. (NumEMSMeteredOutputVariables > 0)) THEN
ALLOCATE(RuntimeReportVar(NumEMSOutputVariables + NumEMSMeteredOutputVariables))
ENDIF
IF (NumEMSOutputVariables > 0) THEN
cCurrentModuleObject = 'EnergyManagementSystem:OutputVariable'
DO RuntimeReportVarNum = 1, NumEMSOutputVariables
CALL GetObjectItem(cCurrentModuleObject, RuntimeReportVarNum, cAlphaArgs, NumAlphas, rNumericArgs, &
NumNums, IOSTAT, AlphaBlank=lAlphaFieldBlanks, NumBlank=lNumericFieldBlanks, &
AlphaFieldnames=cAlphaFieldNames,NumericFieldNames=cNumericFieldNames)
IsNotOK = .FALSE.
IsBlank = .FALSE.
CALL VerifyName(cAlphaArgs(1), RuntimeReportVar%Name, RuntimeReportVarNum - 1, &
IsNotOK, IsBlank, TRIM(cCurrentModuleObject)//' Name')
IF (IsNotOK) THEN
ErrorsFound = .TRUE.
IF (IsBlank) cAlphaArgs(1) = 'xxxxx'
END IF
lbracket=INDEX(cAlphaArgs(1),'[')
if (lbracket == 0) then
UnitsA=' '
! if (lAlphaFieldBlanks(6)) then
! CALL ShowWarningError(RoutineName//trim(cCurrentModuleObject)//'="'//trim(cAlphaArgs(1))//' no units indicated.')
! CALL ShowContinueError('...no units indicated for this variable. [] is assumed.')
! cAlphaArgs(1)=trim(cAlphaArgs(1))//' []'
! endif
UnitsB=cAlphaArgs(6)
lbracket=INDEX(UnitsB,'[')
ptr=INDEX(UnitsB,']')
if (lbracket /= 0) then
UnitsB(lbracket:lbracket)=' '
if (ptr /= 0) then
UnitsB(ptr:ptr)=' '
endif
UnitsB=adjustl(UnitsB)
endif
else ! units shown on Name field (7.2 and pre versions)
ptr=INDEX(cAlphaArgs(1),']')
if (ptr /= 0) then
UnitsA=cAlphaArgs(1)(lbracket+1:ptr-1)
else
UnitsA=cAlphaArgs(1)(lbracket+1:)
endif
cAlphaArgs(1)(lbracket-1:)=' '
UnitsB=cAlphaArgs(6)
lbracket=INDEX(UnitsB,'[')
ptr=INDEX(UnitsB,']')
if (lbracket /= 0) then
UnitsB(lbracket:lbracket)=' '
if (ptr /= 0) then
UnitsB(ptr:ptr)=' '
endif
UnitsB=adjustl(UnitsB)
endif
if (UnitsA /= ' ' .and. UnitsB /= ' ') then
if (UnitsA /= UnitsB) then
CALL ShowWarningError(RoutineName//trim(cCurrentModuleObject)//'="'//trim(cAlphaArgs(1))// &
' mismatched units.')
CALL ShowContinueError('...Units entered in '//trim(cAlphaFieldNames(1))//' (deprecated use)="'//trim(UnitsA)//'"')
CALL ShowContinueError('...'//trim(cAlphaFieldNames(6))//'="'//trim(UnitsB)//'" (will be used)')
endif
elseif (UnitsB == ' ' .and. UnitsA /= ' ') then
UnitsB=UnitsA
CALL ShowWarningError(RoutineName//trim(cCurrentModuleObject)//'="'//trim(cAlphaArgs(1))// &
' using deprecated units designation.')
CALL ShowContinueError('...Units entered in '//trim(cAlphaFieldNames(1))//' (deprecated use)="'//trim(UnitsA)//'"')
endif
endif
cAlphaArgs(1)=trim(cAlphaArgs(1))//' ['//trim(UnitsB)//']'
RuntimeReportVar(RuntimeReportVarNum)%Name = cAlphaArgs(1)
IF (.not. lAlphaFieldBlanks(5)) THEN
! Lookup the Runtime Language Context, i.e., PROGRAM, FUNCTION, or global
Found = .FALSE.
DO StackNum = 1, NumErlStacks
IF (ErlStack(StackNum)%Name == cAlphaArgs(5)) THEN
Found = .TRUE.
EXIT
END IF
END DO
IF (.NOT. Found) THEN
StackNum = 0
CALL ShowSevereError(RoutineName//trim(cCurrentModuleObject)//'="'//trim(cAlphaArgs(1))//' invalid field.')
CALL ShowContinueError('Invalid '//TRIM(cAlphaFieldNames(5))//'='//TRIM(cAlphaArgs(5)))
CALL ShowContinueError('EMS program or subroutine not found.')
ErrorsFound = .TRUE.
END IF
ELSE
StackNum = 0
END IF
VariableNum = FindEMSVariable(cAlphaArgs(2), StackNum)
IF (VariableNum == 0) THEN
IF (lAlphaFieldBlanks(5)) THEN
CALL ShowSevereError(RoutineName//trim(cCurrentModuleObject)//'="'//trim(cAlphaArgs(1))//' invalid field.')
CALL ShowContinueError('Invalid '//TRIM(cAlphaFieldNames(2))//'='//TRIM(cAlphaArgs(2)))
CALL ShowContinueError('EMS variable not found among global variables.')
ELSE IF (StackNum /= 0) THEN
CALL ShowSevereError(RoutineName//trim(cCurrentModuleObject)//'="'//trim(cAlphaArgs(1))//' invalid field.')
CALL ShowContinueError('Invalid '//TRIM(cAlphaFieldNames(2))//'='//TRIM(cAlphaArgs(2)))
CALL ShowContinueError('EMS variable not found among local variables in '//TRIM(cAlphaArgs(5) ) )
END IF
ErrorsFound = .TRUE.
! ELSEIF (INDEX('0123456789',cAlphaArgs(2)(1:1)) > 0) THEN
! CALL ShowSevereError('Invalid '//TRIM(cAlphaFieldNames(2))//'='//TRIM(cAlphaArgs(2)))
! CALL ShowContinueError('Entered in '//TRIM(cCurrentModuleObject)//'='//TRIM(cAlphaArgs(1)))
! CALL ShowContinueError('Names used as Erl output variables cannot start with numeric characters.')
! ErrorsFound = .TRUE.
ELSE
RuntimeReportVar(RuntimeReportVarNum)%VariableNum = VariableNum
END IF
SELECT CASE (TRIM(cAlphaArgs(3)))
CASE ('AVERAGED')
VarTypeString = 'Average'
CASE ('SUMMED')
VarTypeString = 'Sum'
CASE DEFAULT
CALL ShowSevereError(RoutineName//trim(cCurrentModuleObject)//'="'//trim(cAlphaArgs(1))//' invalid field.')
CALL ShowContinueError('Invalid '//TRIM(cAlphaFieldNames(3))//'='//TRIM(cAlphaArgs(3)))
CALL ShowContinueError('...valid values are Averaged or Summed.')
ErrorsFound = .TRUE.
END SELECT
SELECT CASE (TRIM(cAlphaArgs(4)))
CASE ('ZONETIMESTEP')
FreqString = 'Zone'
CASE ('SYSTEMTIMESTEP')
FreqString = 'System'
CASE DEFAULT
CALL ShowSevereError(RoutineName//trim(cCurrentModuleObject)//'="'//trim(cAlphaArgs(1))//' invalid field.')
CALL ShowContinueError('Invalid '//TRIM(cAlphaFieldNames(4))//'='//TRIM(cAlphaArgs(4)))
CALL ShowContinueError('...valid values are ZoneTimestep or SystemTimestep.')
ErrorsFound = .TRUE.
END SELECT
CALL SetupOutputVariable(TRIM(cAlphaArgs(1)), &
RuntimeReportVar(RuntimeReportVarNum)%Value, &
FreqString,VarTypeString,'EMS')
! Last field is index key, no indexing here so mimic weather output data
END DO ! RuntimeReportVarNum
END IF ! NumEMSOutputVariables > 0
IF (NumEMSMeteredOutputVariables > 0) THEN
cCurrentModuleObject = 'EnergyManagementSystem:MeteredOutputVariable'
DO Loop = 1, NumEMSMeteredOutputVariables
RuntimeReportVarNum = NumEMSOutputVariables + Loop
CALL GetObjectItem(cCurrentModuleObject, Loop, cAlphaArgs, NumAlphas, rNumericArgs, &
NumNums, IOSTAT, AlphaBlank=lAlphaFieldBlanks, NumBlank=lNumericFieldBlanks, &
AlphaFieldnames=cAlphaFieldNames,NumericFieldNames=cNumericFieldNames)
IsNotOK = .FALSE.
IsBlank = .FALSE.
CALL VerifyName(cAlphaArgs(1), RuntimeReportVar%Name, RuntimeReportVarNum - 1, &
IsNotOK, IsBlank, TRIM(cCurrentModuleObject)//' Name')
IF (IsNotOK) THEN
ErrorsFound = .TRUE.
IF (IsBlank) cAlphaArgs(1) = 'xxxxx'
END IF
lbracket=INDEX(cAlphaArgs(1),'[')
if (lbracket == 0) then
UnitsA=' '
! if (lAlphaFieldBlanks(9)) then
! CALL ShowWarningError(RoutineName//trim(cCurrentModuleObject)//'="'//trim(cAlphaArgs(1))//' no units indicated.')
! CALL ShowContinueError('...no units indicated for this variable. [] is assumed.')
! cAlphaArgs(1)=trim(cAlphaArgs(1))//' []'
! endif
UnitsB=cAlphaArgs(9)
lbracket=INDEX(UnitsB,'[')
ptr=INDEX(UnitsB,']')
if (lbracket /= 0) then
UnitsB(lbracket:lbracket)=' '
if (ptr /= 0) then
UnitsB(ptr:ptr)=' '
endif
UnitsB=adjustl(UnitsB)
endif
else ! units shown on Name field (7.2 and pre versions)
ptr=INDEX(cAlphaArgs(1),']')
if (ptr /= 0) then
UnitsA=cAlphaArgs(1)(lbracket+1:ptr-1)
else
UnitsA=cAlphaArgs(1)(lbracket+1:)
endif
cAlphaArgs(1)(lbracket-1:)=' '
UnitsB=cAlphaArgs(9)
lbracket=INDEX(UnitsB,'[')
ptr=INDEX(UnitsB,']')
if (lbracket /= 0) then
UnitsB(lbracket:lbracket)=' '
if (ptr /= 0) then
UnitsB(ptr:ptr)=' '
endif
UnitsB=adjustl(UnitsB)
endif
if (UnitsA /= ' ' .and. UnitsB /= ' ') then
if (UnitsA /= UnitsB) then
CALL ShowWarningError(RoutineName//trim(cCurrentModuleObject)//'="'//trim(cAlphaArgs(1))// &
' mismatched units.')
CALL ShowContinueError('...Units entered in '//trim(cAlphaFieldNames(1))//' (deprecated use)="'//trim(UnitsA)//'"')
CALL ShowContinueError('...'//trim(cAlphaFieldNames(9))//'="'//trim(UnitsB)//'" (will be used)')
endif
elseif (UnitsB == ' ' .and. UnitsA /= ' ') then
UnitsB=UnitsA
CALL ShowWarningError(RoutineName//trim(cCurrentModuleObject)//'="'//trim(cAlphaArgs(1))// &
' using deprecated units designation.')
CALL ShowContinueError('...Units entered in '//trim(cAlphaFieldNames(1))//' (deprecated use)="'//trim(UnitsA)//'"')
endif
endif
cAlphaArgs(1)=trim(cAlphaArgs(1))//' ['//trim(UnitsB)//']'
RuntimeReportVar(RuntimeReportVarNum)%Name = cAlphaArgs(1)
IF (.not. lAlphaFieldBlanks(4)) THEN
! Lookup the Runtime Language Context, i.e., PROGRAM, FUNCTION, or global
Found = .FALSE.
DO StackNum = 1, NumErlStacks
IF (ErlStack(StackNum)%Name == cAlphaArgs(4)) THEN
Found = .TRUE.
EXIT
END IF
END DO
IF (.NOT. Found) THEN
StackNum = 0
CALL ShowSevereError(RoutineName//trim(cCurrentModuleObject)//'="'//trim(cAlphaArgs(1))//' invalid field.')
CALL ShowContinueError('Invalid '//TRIM(cAlphaFieldNames(4))//'='//TRIM(cAlphaArgs(4)))
CALL ShowContinueError('EMS program or subroutine not found.')
ErrorsFound = .TRUE.
END IF
ELSE
StackNum = 0
END IF
VariableNum = FindEMSVariable(cAlphaArgs(2), StackNum)
IF (VariableNum == 0) THEN
IF (lAlphaFieldBlanks(4)) THEN
CALL ShowSevereError(RoutineName//trim(cCurrentModuleObject)//'="'//trim(cAlphaArgs(1))//' invalid field.')
CALL ShowContinueError('Invalid '//TRIM(cAlphaFieldNames(2))//'='//TRIM(cAlphaArgs(2)))
CALL ShowContinueError('EMS variable not found among global variables.')
ELSE IF (StackNum /= 0) THEN
CALL ShowSevereError(RoutineName//trim(cCurrentModuleObject)//'="'//trim(cAlphaArgs(1))//' invalid field.')
CALL ShowContinueError('Invalid '//TRIM(cAlphaFieldNames(2))//'='//TRIM(cAlphaArgs(2)))
CALL ShowContinueError('EMS variable not found among local variables in '//TRIM(cAlphaArgs(5) ) )
END IF
ErrorsFound = .TRUE.
! ELSEIF (INDEX('0123456789',cAlphaArgs(2)(1:1)) > 0) THEN
! CALL ShowSevereError('Invalid '//TRIM(cAlphaFieldNames(2))//'='//TRIM(cAlphaArgs(2)))
! CALL ShowContinueError('Entered in '//TRIM(cCurrentModuleObject)//'='//TRIM(cAlphaArgs(1)))
! CALL ShowContinueError('Names used as Erl output variables cannot start with numeric characters.')
! ErrorsFound = .TRUE.
ELSE
RuntimeReportVar(RuntimeReportVarNum)%VariableNum = VariableNum
END IF
VarTypeString = 'Sum' ! all metered vars are sum type
SELECT CASE (TRIM(cAlphaArgs(3)))
CASE ('ZONETIMESTEP')
FreqString = 'Zone'
CASE ('SYSTEMTIMESTEP')
FreqString = 'System'
CASE DEFAULT
CALL ShowSevereError(RoutineName//trim(cCurrentModuleObject)//'="'//trim(cAlphaArgs(1))//' invalid field.')
CALL ShowContinueError('Invalid '//TRIM(cAlphaFieldNames(4))//'='//TRIM(cAlphaArgs(4)))
CALL ShowContinueError('...valid values are ZoneTimestep or SystemTimestep.')
ErrorsFound = .TRUE.
END SELECT
SELECT CASE (TRIM(cAlphaArgs(5)))
CASE ('ELECTRICITY')
ResourceTypeString = 'Electricity'
CASE ('NATURALGAS')
ResourceTypeString = 'NaturalGas'
CASE ('GASOLINE')
ResourceTypeString = 'Gasoline'
CASE ('DIESEL')
ResourceTypeString = 'Diesel'
CASE ('COAL')
ResourceTypeString = 'Coal'
CASE ('FUELOIL#1')
ResourceTypeString = 'FuelOil#1'
CASE ('FUELOIL#2')
ResourceTypeString = 'FuelOil#2'
CASE ('OTHERFUEL1')
ResourceTypeString = 'OtherFuel1'
CASE ('OTHERFUEL2')
ResourceTypeString = 'OtherFuel2'
CASE ('PROPANE')
ResourceTypeString = 'Propane'
CASE ('WATERUSE')
ResourceTypeString = 'Water'
CASE ('ONSITEWATERPRODUCED')
ResourceTypeString = 'OnSiteWater'
CASE ('MAINSWATERSUPPLY')
ResourceTypeString = 'MainsWater'
CASE ('RAINWATERCOLLECTED')
ResourceTypeString = 'RainWater'
CASE ('WELLWATERDRAWN')
ResourceTypeString = 'WellWater'
CASE ('CONDENSATEWATERCOLLECTED')
ResourceTypeString = 'Condensate'
CASE ('ENERGYTRANSFER')
ResourceTypeString = 'EnergyTransfer'
CASE ('STEAM')
ResourceTypeString = 'Steam'
CASE ('DISTRICTCOOLING')
ResourceTypeString = 'DistrictCooling'
CASE ('DISTRICTHEATING')
ResourceTypeString = 'DistrictHeating'
CASE ('ELECTRICITYPRODUCEDONSITE')
ResourceTypeString = 'ElectricityProduced'
CASE ('SOLARWATERHEATING')
ResourceTypeString = 'SolarWater'
CASE ('SOLARAIRHEATING')
ResourceTypeString = 'SolarAir'
CASE DEFAULT
CALL ShowSevereError(RoutineName//trim(cCurrentModuleObject)//'="'//trim(cAlphaArgs(1))//' invalid field.')
CALL ShowContinueError('Invalid '//TRIM(cAlphaFieldNames(5))//'='//TRIM(cAlphaArgs(5)))
ErrorsFound = .TRUE.
END SELECT
SELECT CASE (TRIM(cAlphaArgs(6)))
CASE ('BUILDING')
GroupTypeString = 'Building'
CASE ('HVAC')
GroupTypeString = 'HVAC'
CASE ('PLANT')
GroupTypeString = 'Plant'
CASE DEFAULT
CALL ShowSevereError(RoutineName//trim(cCurrentModuleObject)//'="'//trim(cAlphaArgs(1))//' invalid field.')
CALL ShowContinueError('Invalid '//TRIM(cAlphaFieldNames(6))//'='//TRIM(cAlphaArgs(6)))
ErrorsFound = .TRUE.
END SELECT
SELECT CASE (TRIM(cAlphaArgs(7)))
CASE ('HEATING')
EndUseTypeString = 'Heating'
CASE ('COOLING')
EndUseTypeString = 'Cooling'
CASE ('INTERIORLIGHTS')
EndUseTypeString = 'InteriorLights'
CASE ('EXTERIORLIGHTS')
EndUseTypeString = 'ExteriorLights'
CASE ('INTERIOREQUIPMENT')
EndUseTypeString = 'InteriorEquipment'
CASE ('EXTERIOREQUIPMENT')
EndUseTypeString = 'ExteriorEquipment'
CASE ('FANS')
EndUseTypeString = 'Fans'
CASE ('PUMPS')
EndUseTypeString = 'Pumps'
CASE ('HEATREJECTION')
EndUseTypeString = 'HeatRejection'
CASE ('HUMIDIFIER')
EndUseTypeString = 'Humidifier'
CASE ('HEATRECOVERY')
EndUseTypeString = 'HeatRecovery'
CASE ('WATERSYSTEMS')
EndUseTypeString = 'WaterSystems'
CASE ('REFRIGERATION')
EndUseTypeString = 'Refrigeration'
CASE ('ONSITEGENERATION')
EndUseTypeString = 'Cogeneration'
CASE DEFAULT
CALL ShowSevereError(RoutineName//trim(cCurrentModuleObject)//'="'//trim(cAlphaArgs(1))//' invalid field.')
CALL ShowContinueError('Invalid '//TRIM(cAlphaFieldNames(7))//'='//TRIM(cAlphaArgs(7)))
ErrorsFound = .TRUE.
END SELECT
IF (.NOT. lAlphaFieldBlanks(8)) THEN
EndUseSubCatString = TRIM(cAlphaArgs(8))
CALL SetupOutputVariable(TRIM(cAlphaArgs(1)), &
RuntimeReportVar(RuntimeReportVarNum)%Value, &
FreqString,VarTypeString,'EMS', &
ResourceTypeKey = ResourceTypeString, &
EndUseKey = EndUseTypeString , &
GroupKey = GroupTypeString , &
EndUseSubKey = EndUseSubCatString)
ELSE ! no subcat
CALL SetupOutputVariable(TRIM(cAlphaArgs(1)), &
RuntimeReportVar(RuntimeReportVarNum)%Value, &
FreqString,VarTypeString,'EMS', &
ResourceTypeKey = ResourceTypeString, &
EndUseKey = EndUseTypeString , &
GroupKey = GroupTypeString )
ENDIF
ENDDO
ENDIF ! NumEMSMeteredOutputVariables > 0
DEALLOCATE(cAlphaFieldNames)
DEALLOCATE(cAlphaArgs)
DEALLOCATE(lAlphaFieldBlanks)
DEALLOCATE(cNumericFieldNames)
DEALLOCATE(rNumericArgs)
DEALLOCATE(lNumericFieldBlanks)
IF (ErrorsFound) THEN
CALL ShowFatalError('Errors found in getting EMS Runtime Language input. Preceding condition causes termination.')
END IF
END IF ! GetInput
RETURN
END SUBROUTINE GetRuntimeLanguageUserInput