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 UpdateMeterReporting
! SUBROUTINE INFORMATION:
! AUTHOR Linda Lawrie
! DATE WRITTEN January 2001
! MODIFIED February 2007 -- add cumulative meter reporting
! January 2012 -- add predefined tabular meter reporting
! RE-ENGINEERED na
! PURPOSE OF THIS SUBROUTINE:
! This subroutine is called at the end of the first HVAC iteration and
! sets up the reporting for the Energy Meters. It also may show a fatal error
! if errors occurred during initial SetupOutputVariable processing. It "gets"
! the Report Meter input:
! Report Meter,
! \memo Meters requested here show up on eplusout.eso and eplusout.mtr
! A1 , \field Meter_Name
! \required-field
! \note Form is EnergyUseType:..., e.g. Electricity:* for all Electricity meters
! \note or EndUse:..., e.g. InteriorLights:* for all interior lights
! \note Report MeterFileOnly puts results on the eplusout.mtr file only
! A2 ; \field Reporting_Frequency
! \type choice
! \key timestep
! \note timestep refers to the zone timestep/timestep in hour value
! \note runperiod, environment, and annual are the same
! \key hourly
! \key daily
! \key monthly
! \key runperiod
! \key environment
! \key annual
! \note runperiod, environment, and annual are synonymous
!
! Report MeterFileOnly,
! \memo same reporting as Report Meter -- goes to eplusout.mtr only
! A1 , \field Meter_Name
! \required-field
! \note Form is EnergyUseType:..., e.g. Electricity:* for all Electricity meters
! \note or EndUse:..., e.g. InteriorLights:* for all interior lights
! \note Report MeterFileOnly puts results on the eplusout.mtr file only
! A2 ; \field Reporting_Frequency
! \type choice
! \key timestep
! \note timestep refers to the zone timestep/timestep in hour value
! \note runperiod, environment, and annual are the same
! \key hourly
! \key daily
! \key monthly
! \key runperiod
! \key environment
! \key annual
! \note runperiod, environment, and annual are synonymous
! METHODOLOGY EMPLOYED:
! na
! REFERENCES:
! na
! USE STATEMENTS:
USE DataIPShortCuts
USE DataPrecisionGlobals
USE InputProcessor
USE OutputProcessor
USE General, ONLY: TrimSigDigits
IMPLICIT NONE ! Enforce explicit typing of all variables in this routine
! SUBROUTINE ARGUMENT DEFINITIONS:
! na
! SUBROUTINE PARAMETER DEFINITIONS:
! na
! INTERFACE BLOCK SPECIFICATIONS:
! na
! DERIVED TYPE DEFINITIONS:
! na
! SUBROUTINE LOCAL VARIABLE DECLARATIONS:
INTEGER Loop
CHARACTER(len=MaxNameLength), DIMENSION(2) :: Alphas
REAL(r64), DIMENSION(1) :: Numbers
INTEGER NumAlpha
INTEGER NumNumbers
INTEGER IOStat
INTEGER WildCard
INTEGER TestLen
INTEGER varnameLen
INTEGER NumReqMeters
INTEGER NumReqMeterFOs
INTEGER Meter
INTEGER ReportFreq
LOGICAL NeverFound
LOGICAL :: ErrorsFound = .false. ! If errors detected in input
CALL GetCustomMeterInput(ErrorsFound)
IF (ErrorsFound) THEN
ErrorsLogged=.true.
ENDIF
cCurrentModuleObject='Output:Meter'
NumReqMeters=GetNumObjectsFound(cCurrentModuleObject)
DO Loop=1,NumReqMeters
CALL GetObjectItem(cCurrentModuleObject,Loop,Alphas,NumAlpha,Numbers,NumNumbers,IOStat, &
AlphaBlank=lAlphaFieldBlanks,NumBlank=lNumericFieldBlanks, &
AlphaFieldnames=cAlphaFieldNames,NumericFieldNames=cNumericFieldNames)
varnameLen=INDEX(Alphas(1),'[')
IF (varnameLen /= 0) Alphas(1)=Alphas(1)(1:varnameLen-1)
WildCard=INDEX(Alphas(1),'*')
IF (WildCard /= 0) THEN
TestLen=WildCard-1
ENDIF
CALL DetermineFrequency(Alphas(2),ReportFreq)
IF (WildCard == 0) THEN
Meter=FindItem(Alphas(1),EnergyMeters%Name,NumEnergyMeters)
IF (Meter == 0) THEN
CALL ShowWarningError(TRIM(cCurrentModuleObject)//': invalid '//TRIM(cAlphaFieldNames(1))//'="'// &
TRIM(Alphas(1))//'" - not found.')
CYCLE
ENDIF
CALL SetInitialMeterReportingAndOutputNames(Meter,.false.,ReportFreq,.false.)
ELSE ! Wildcard input
NeverFound=.true.
DO Meter=1,NumEnergyMeters
IF (.not. SameString(EnergyMeters(Meter)%Name(1:TestLen),Alphas(1)(1:TestLen))) CYCLE
NeverFound=.false.
CALL SetInitialMeterReportingAndOutputNames(Meter,.false.,ReportFreq,.false.)
ENDDO
IF (NeverFound) THEN
CALL ShowWarningError(TRIM(cCurrentModuleObject)//': invalid '//TRIM(cAlphaFieldNames(1))//'="'// &
TRIM(Alphas(1))//'" - not found.')
ENDIF
ENDIF
ENDDO
cCurrentModuleObject='Output:Meter:MeterFileOnly'
NumReqMeterFOs=GetNumObjectsFound(cCurrentModuleObject)
DO Loop=1,NumReqMeterFOs
CALL GetObjectItem(cCurrentModuleObject,Loop,Alphas,NumAlpha,Numbers,NumNumbers,IOStat, &
AlphaBlank=lAlphaFieldBlanks,NumBlank=lNumericFieldBlanks, &
AlphaFieldnames=cAlphaFieldNames,NumericFieldNames=cNumericFieldNames)
varnameLen=INDEX(Alphas(1),'[')
IF (varnameLen /= 0) Alphas(1)=Alphas(1)(1:varnameLen-1)
WildCard=INDEX(Alphas(1),'*')
IF (WildCard /= 0) THEN
TestLen=WildCard-1
ENDIF
CALL DetermineFrequency(Alphas(2),ReportFreq)
IF (WildCard == 0) THEN
Meter=FindItem(Alphas(1),EnergyMeters%Name,NumEnergyMeters)
IF (Meter == 0) THEN
CALL ShowWarningError(TRIM(cCurrentModuleObject)//': invalid '//TRIM(cAlphaFieldNames(1))//'="'// &
TRIM(Alphas(1))//'" - not found.')
CYCLE
ENDIF
CALL SetInitialMeterReportingAndOutputNames(Meter,.true.,ReportFreq,.false.)
ELSE ! Wildcard input
NeverFound=.true.
DO Meter=1,NumEnergyMeters
IF (.not. SameString(EnergyMeters(Meter)%Name(1:TestLen),Alphas(1)(1:TestLen))) CYCLE
NeverFound=.false.
CALL SetInitialMeterReportingAndOutputNames(Meter,.true.,ReportFreq,.false.)
ENDDO
IF (NeverFound) THEN
CALL ShowWarningError(TRIM(cCurrentModuleObject)//': invalid '//TRIM(cAlphaFieldNames(1))//'="'// &
TRIM(Alphas(1))//'" - not found.')
ENDIF
ENDIF
ENDDO
cCurrentModuleObject='Output:Meter:Cumulative'
NumReqMeters=GetNumObjectsFound(cCurrentModuleObject)
DO Loop=1,NumReqMeters
CALL GetObjectItem(cCurrentModuleObject,Loop,Alphas,NumAlpha,Numbers,NumNumbers,IOStat, &
AlphaBlank=lAlphaFieldBlanks,NumBlank=lNumericFieldBlanks, &
AlphaFieldnames=cAlphaFieldNames,NumericFieldNames=cNumericFieldNames)
varnameLen=INDEX(Alphas(1),'[')
IF (varnameLen /= 0) Alphas(1)=Alphas(1)(1:varnameLen-1)
WildCard=INDEX(Alphas(1),'*')
IF (WildCard /= 0) THEN
TestLen=WildCard-1
ENDIF
CALL DetermineFrequency(Alphas(2),ReportFreq)
IF (WildCard == 0) THEN
Meter=FindItem(Alphas(1),EnergyMeters%Name,NumEnergyMeters)
IF (Meter == 0) THEN
CALL ShowWarningError(TRIM(cCurrentModuleObject)//': invalid '//TRIM(cAlphaFieldNames(1))//'="'// &
TRIM(Alphas(1))//'" - not found.')
CYCLE
ENDIF
CALL SetInitialMeterReportingAndOutputNames(Meter,.false.,ReportFreq,.true.)
ELSE ! Wildcard input
NeverFound=.true.
DO Meter=1,NumEnergyMeters
IF (.not. SameString(EnergyMeters(Meter)%Name(1:TestLen),Alphas(1)(1:TestLen))) CYCLE
NeverFound=.false.
CALL SetInitialMeterReportingAndOutputNames(Meter,.false.,ReportFreq,.true.)
ENDDO
IF (NeverFound) THEN
CALL ShowWarningError(TRIM(cCurrentModuleObject)//': invalid '//TRIM(cAlphaFieldNames(1))//'="'// &
TRIM(Alphas(1))//'" - not found.')
ENDIF
ENDIF
ENDDO
cCurrentModuleObject='Output:Meter:Cumulative:MeterFileOnly'
NumReqMeterFOs=GetNumObjectsFound(cCurrentModuleObject)
DO Loop=1,NumReqMeterFOs
CALL GetObjectItem(cCurrentModuleObject,Loop,Alphas,NumAlpha,Numbers,NumNumbers,IOStat, &
AlphaBlank=lAlphaFieldBlanks,NumBlank=lNumericFieldBlanks, &
AlphaFieldnames=cAlphaFieldNames,NumericFieldNames=cNumericFieldNames)
varnameLen=INDEX(Alphas(1),'[')
IF (varnameLen /= 0) Alphas(1)=Alphas(1)(1:varnameLen-1)
WildCard=INDEX(Alphas(1),'*')
IF (WildCard /= 0) THEN
TestLen=WildCard-1
ENDIF
CALL DetermineFrequency(Alphas(2),ReportFreq)
IF (WildCard == 0) THEN
Meter=FindItem(Alphas(1),EnergyMeters%Name,NumEnergyMeters)
IF (Meter == 0) THEN
CALL ShowWarningError(TRIM(cCurrentModuleObject)//': invalid '//TRIM(cAlphaFieldNames(1))//'="'// &
TRIM(Alphas(1))//'" - not found.')
CYCLE
ENDIF
CALL SetInitialMeterReportingAndOutputNames(Meter,.true.,ReportFreq,.true.)
ELSE ! Wildcard input
NeverFound=.true.
DO Meter=1,NumEnergyMeters
IF (.not. SameString(EnergyMeters(Meter)%Name(1:TestLen),Alphas(1)(1:TestLen))) CYCLE
NeverFound=.false.
CALL SetInitialMeterReportingAndOutputNames(Meter,.true.,ReportFreq,.true.)
ENDDO
IF (NeverFound) THEN
CALL ShowWarningError(TRIM(cCurrentModuleObject)//': invalid '//TRIM(cAlphaFieldNames(1))//'="'// &
TRIM(Alphas(1))//'" - not found.')
ENDIF
ENDIF
ENDDO
CALL ReportMeterDetails
IF (ErrorsLogged) THEN
CALL ShowFatalError('UpdateMeterReporting: Previous Meter Specification errors cause program termination.')
ENDIF
ALLOCATE(MeterValue(NumEnergyMeters))
MeterValue=0.0d0
RETURN
END SUBROUTINE UpdateMeterReporting