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.
Errors are severe and fatal because should only be encountered during development.
Type | Intent | Optional | Attributes | Name | ||
---|---|---|---|---|---|---|
character(len=*), | intent(in) | :: | VariableName | |||
integer, | intent(in), | TARGET | :: | ActualVariable | ||
character(len=*), | intent(in) | :: | IndexTypeKey | |||
character(len=*), | intent(in) | :: | VariableTypeKey | |||
character(len=*), | intent(in) | :: | KeyedValue | |||
character(len=*), | intent(in), | optional | :: | ReportFreq | ||
integer, | intent(in), | optional | :: | indexGroupKey |
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 SetupIntegerOutputVariable(VariableName,ActualVariable,IndexTypeKey,VariableTypeKey,KeyedValue,ReportFreq,indexGroupKey)
! SUBROUTINE INFORMATION:
! AUTHOR Linda K. Lawrie
! DATE WRITTEN December 1998
! MODIFIED August 2008; Added SQL output capability
! RE-ENGINEERED na
! PURPOSE OF THIS SUBROUTINE:
! This subroutine sets up the variable data structure that will be used
! to track values of the output variables of EnergyPlus.
! METHODOLOGY EMPLOYED:
! Pointers (as pointers), pointers (as indices), and lots of other KEWL data stuff.
! REFERENCES:
! na
! USE STATEMENTS:
USE DataPrecisionGlobals
USE OutputProcessor
USE InputProcessor, ONLY: FindItem,MakeUPPERCase,SameString
USE General, ONLY: TrimSigDigits
USE DataOutputs, ONLY: FindItemInVariableList
USE SQLiteProcedures
IMPLICIT NONE ! Enforce explicit typing of all variables in this routine
! SUBROUTINE ARGUMENT DEFINITIONS:
CHARACTER(len=*), INTENT(IN) :: VariableName ! String Name of variable
CHARACTER(len=*), INTENT(IN) :: IndexTypeKey ! Zone, HeatBalance=1, HVAC, System, Plant=2
CHARACTER(len=*), INTENT(IN) :: VariableTypeKey ! State, Average=1, NonState, Sum=2
INTEGER, INTENT(IN), TARGET :: ActualVariable ! Actual Variable, used to set up pointer
CHARACTER(len=*), INTENT(IN) :: KeyedValue ! Associated Key for this variable
CHARACTER(len=*), INTENT(IN), OPTIONAL :: ReportFreq ! Internal use -- causes reporting at this freqency
INTEGER, INTENT(IN), OPTIONAL :: indexGroupKey ! Group identifier for SQL output
! SUBROUTINE PARAMETER DEFINITIONS:
! na
! INTERFACE BLOCK SPECIFICATIONS:
! na
! DERIVED TYPE DEFINITIONS:
! na
! SUBROUTINE LOCAL VARIABLE DECLARATIONS:
INTEGER CV
INTEGER Item
CHARACTER(len=20) IDOut
CHARACTER(len=MaxNameLength) :: VarName ! Variable without units
! CHARACTER(len=MaxNameLength) :: VariableNamewithUnits ! Variable name with units std format
INTEGER :: IndexType ! 1=TimeStepZone, 2=TimeStepSys
INTEGER :: VariableType ! 1=Average, 2=Sum, 3=Min/Max
INTEGER :: localIndexGroupKey
LOGICAL :: ThisOneOnTheList
LOGICAL :: invalidUnits
CHARACTER(len=UnitsStringLength) :: UnitsString =BlankString ! Units for Variable (no brackets)
INTEGER :: Loop
INTEGER :: RepFreq
IF (.not. OutputInitialized) CALL InitializeOutput
!! Errors are severe and fatal because should only be encountered during development.
Item=INDEX(VariableName,'[')
IF (Item /= 0) THEN
UnitsString=GetVariableUnitsString(VariableName)
UnitsString=ADJUSTL(UnitsString)
invalidUnits=.false.
IF (UnitsString(1:1) == '-') invalidUnits=.true.
IF (SameString(UnitsString,'dimensionless')) invalidUnits=.true.
VarName=ADJUSTL(VariableName(1:Item-1))
! VariableNamewithUnits=trim(VarName)//' ['//trim(UnitsString)//']'
! Check name length for variable name
IF (LEN_TRIM(ADJUSTL(VariableName)) > MaxNameLength) THEN
CALL ShowSevereError('Variable Name length (including units) ['// &
trim(TrimSigDigits(LEN_TRIM(ADJUSTL(VariableName))))//'] exceeds maximum='//TRIM(VariableName))
IF (invalidUnits) CALL ShowSevereError('Variable has invalid units in call Variable='//trim(VariableName)// &
', Units='//trim(UnitsString))
CALL ShowFatalError('Program terminates.')
ENDIF
IF (invalidUnits) THEN
CALL ShowSevereError('Variable has invalid units in call Variable='//trim(VariableName)// &
', Units='//trim(UnitsString))
CALL ShowFatalError('Program terminates.')
ENDIF
ELSE
UnitsString=BlankString
VarName=ADJUSTL(VariableName)
! VariableNamewithUnits=trim(VarName)//' ['//trim(UnitsString)//']'
IF (LEN_TRIM(ADJUSTL(VariableName)) > MaxNameLength) THEN
CALL ShowSevereError('Variable Name has no units in call='//TRIM(VariableName))
CALL ShowSevereError('Variable Name length exceeds maximum='//TRIM(VariableName))
CALL ShowFatalError('Program terminates.')
ENDIF
CALL ShowSevereError('Variable Name has no units in call='//TRIM(VariableName))
CALL ShowFatalError('Program terminates.')
ENDIF
! Determine whether to Report or not
CALL CheckReportVariable(KeyedValue,VarName)
IF (NumExtraVars == 0) THEN
NumExtraVars=1
ReportList=-1
ENDIF
! If ReportFreq present, overrides input
IF (PRESENT(ReportFreq)) THEN
CALL DetermineFrequency(ReportFreq,RepFreq)
NumExtraVars=1
ReportList=0
ELSE
RepFreq=ReportHourly
ENDIF
ThisOneOnTheList=FindItemInVariableList(KeyedValue,VarName)
DO Loop=1,NumExtraVars
IF (Loop == 1) NumOfIVariable_Setup=NumOfIVariable_Setup+1
IndexType=ValidateIndexType(IndexTypeKey,'SetupIntegerOutputVariable')
VariableType=ValidateVariableType(VariableTypeKey)
CALL AddToOutputVariableList(VarName,IndexType,VariableType,VarType_Integer,UnitsString)
NumTotalIVariable=NumTotalIVariable+1
IF (.not. ThisOneOnTheList) CYCLE
NumOfIVariable=NumOfIVariable+1
IF (Loop == 1 .and. VariableType == SummedVar) THEN
NumOfIVariable_Sum=NumOfIVariable_Sum+1
ENDIF
IF (NumOfIVariable > MaxIVariable) THEN
CALL ReallocateIVar
ENDIF
CV=NumOfIVariable
IVariableTypes(CV)%IndexType=IndexType
IVariableTypes(CV)%StoreType=VariableType
IVariableTypes(CV)%VarName=TRIM(KeyedValue)//':'//TRIM(VarName)
IVariableTypes(CV)%VarNameOnly=TRIM(VarName)
IVariableTypes(CV)%VarNameUC=MakeUPPERCase(IVariableTypes(CV)%VarName)
IVariableTypes(CV)%UnitsString=UnitsString
CALL AssignReportNumber(CurrentReportNumber)
WRITE(IDOut,*) CurrentReportNumber
IDOut=ADJUSTL(IDOut)
ALLOCATE(IVariable)
IVariable%Value=0.0d0
IVariable%StoreValue=0.0d0
IVariable%TSValue=0.0d0
IVariable%NumStored=0.0d0
! IVariable%LastTSValue=0
IVariable%MaxValue=IMaxSetValue
IVariable%maxValueDate=0
IVariable%MinValue=IMinSetValue
IVariable%minValueDate=0
IVariableTypes(CV)%Varptr=>IVariable
IVariable%Which=>ActualVariable
IVariable%ReportID=CurrentReportNumber
IVariableTypes(CV)%ReportID=CurrentReportNumber
IVariable%ReportIDChr=IDOut(1:15)
IVariable%StoreType=VariableType
IVariable%Stored=.false.
IVariable%Report=.false.
IVariable%ReportFreq=ReportHourly
IVariable%SchedPtr=0
IF (ReportList(Loop) == -1) CYCLE
IVariable%Report=.true.
IF (ReportList(Loop) == 0) THEN
IVariable%ReportFreq=RepFreq
IVariable%SchedPtr=0
ELSE
IVariable%ReportFreq=ReqRepVars(ReportList(Loop))%ReportFreq
IVariable%SchedPtr=ReqRepVars(ReportList(Loop))%SchedPtr
ENDIF
IF (IVariable%Report) THEN
IF (PRESENT(indexGroupKey)) THEN
localIndexGroupKey = indexGroupKey
ELSE
localIndexGroupKey = -999 ! Unknown Group
ENDIF
IF (IVariable%SchedPtr /= 0) THEN
CALL WriteReportVariableDictionaryItem (IVariable%ReportFreq, IVariable%StoreType, &
IVariable%ReportID, localIndexGroupKey, IndexTypeKey, IVariable%ReportIDChr, &
KeyedValue, VarName, IVariableTypes(CV)%IndexType, IVariableTypes(CV)%UnitsString, &
ReqRepVars(ReportList(Loop))%SchedName)
ELSE
CALL WriteReportVariableDictionaryItem (IVariable%ReportFreq, IVariable%StoreType, &
IVariable%ReportID, localIndexGroupKey, IndexTypeKey, IVariable%ReportIDChr, &
KeyedValue, VarName, IVariableTypes(CV)%IndexType, IVariableTypes(CV)%UnitsString)
END IF
ENDIF
ENDDO
RETURN
END SUBROUTINE SetupIntegerOutputVariable