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.
TimeStep Block (Report on Zone TimeStep)
Hour Block Day Block Month Block Sim/Environment Block
Type | Intent | Optional | Attributes | Name | ||
---|---|---|---|---|---|---|
integer, | intent(in) | :: | IndexTypeKey |
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 UpdateDataandReport(IndexTypeKey)
! SUBROUTINE INFORMATION:
! AUTHOR Linda K. Lawrie
! DATE WRITTEN December 1998
! MODIFIED January 2001; Resolution integrated at the Zone TimeStep intervals
! MODIFIED August 2008; Added SQL output capability
! RE-ENGINEERED na
! PURPOSE OF THIS SUBROUTINE:
! This subroutine writes the actual report variable (for user requested
! Report Variables) strings to the standard output file.
! METHODOLOGY EMPLOYED:
! na
! REFERENCES:
! na
! USE STATEMENTS:
USE DataPrecisionGlobals
USE OutputProcessor
USE ScheduleManager, ONLY: GetCurrentScheduleValue
USE DataGlobals, ONLY: HourOfDay, DayOfSimChr, EndHourFlag, EndDayFlag, EndEnvrnFlag
USE DataInterfaces, ONLY: ShowRecurringWarningErrorAtEnd
USE DataEnvironment, ONLY: EndMonthFlag
USE General, ONLY: RemoveTrailingZeros, EncodeMonDayHrMin
USE SQLiteProcedures
IMPLICIT NONE ! Enforce explicit typing of all variables in this routine
! SUBROUTINE ARGUMENT DEFINITIONS:
INTEGER, INTENT(IN) :: IndexTypeKey ! What kind of data to update (Zone, HVAC)
! SUBROUTINE PARAMETER DEFINITIONS:
! na
! INTERFACE BLOCK SPECIFICATIONS:
! na
! DERIVED TYPE DEFINITIONS:
! na
! SUBROUTINE LOCAL VARIABLE DECLARATIONS:
INTEGER :: Loop ! Loop Variable
INTEGER :: IndexType ! Translate Zone=>1, HVAC=>2
REAL(r64) :: CurVal ! Current value for real variables
REAL(r64) :: ICurVal ! Current value for integer variables
INTEGER :: MDHM ! Month,Day,Hour,Minute
LOGICAL :: TimePrint ! True if the time needs to be printed
REAL(r64) :: StartMinute ! StartMinute for UpdateData call
REAL(r64) :: MinuteNow ! What minute it is now
LOGICAL :: ReportNow ! True if this variable should be reported now
INTEGER :: CurDayType ! What kind of day it is (weekday (sunday, etc) or holiday)
INTEGER,SAVE :: LHourP =-1 ! Helps set hours for timestamp output
REAL(r64),SAVE :: LStartMin =-1.0d0 ! Helps set minutes for timestamp output
REAL(r64),SAVE :: LEndMin =-1.0d0 ! Helps set minutes for timestamp output
LOGICAL,SAVE :: EndTimeStepFlag =.false. ! True when it's the end of the Zone Time Step
REAL(r64) :: rxTime ! (MinuteNow-StartMinute)/REAL(MinutesPerTimeStep,r64) - for execution time
IndexType=IndexTypeKey
IF (IndexType /= ZoneTSReporting .and. IndexType /= HVACTSReporting) THEN
CALL ShowFatalError('Invalid reporting requested -- UpdateDataAndReport')
ENDIF
SELECT CASE (IndexType)
CASE(ZoneVar:HVACVar)
! Basic record keeping and report out if "detailed"
StartMinute=TimeValue(IndexType)%CurMinute
TimeValue(IndexType)%CurMinute=TimeValue(IndexType)%CurMinute+TimeValue(IndexType)%TimeStep*60.0d0
IF (IndexType == HVACVar .and. TimeValue(HVACVar)%CurMinute == TimeValue(ZoneVar)%CurMinute) THEN
EndTimeStepFlag=.true.
ELSEIF (IndexType == ZoneVar) THEN
EndTimeStepFlag=.true.
ELSE
EndTimeStepFlag=.false.
ENDIF
MinuteNow=TimeValue(IndexType)%CurMinute
CALL EncodeMonDayHrMin(MDHM,Month,DayOfMonth,HourOfDay,INT(MinuteNow))
TimePrint=.true.
rxTime=(MinuteNow-StartMinute)/REAL(MinutesPerTimeStep,r64)
! Main "Record Keeping" Loops for R and I variables
DO Loop=1,NumOfRVariable
IF (RVariableTypes(Loop)%IndexType /= IndexType) CYCLE
! Act on the RVariables variable using the RVar structure
RVar=>RVariableTypes(Loop)%VarPtr
RVar%Stored=.true.
IF (RVar%StoreType == AveragedVar) THEN
CurVal=RVar%Which*rxTime
! CALL SetMinMax(RVar%Which,MDHM,RVAR%MaxValue,RVar%maxValueDate,RVar%MinValue,RVar%minValueDate)
IF (RVar%Which > RVAR%MaxValue) THEN
RVAR%MaxValue=RVar%Which
RVar%maxValueDate=MDHM
ENDIF
IF (RVar%Which < RVAR%MinValue) THEN
RVAR%MinValue=RVar%Which
RVar%minValueDate=MDHM
ENDIF
RVar%TSValue=RVar%TSValue+CurVal
RVar%EITSValue = RVar%TSValue !CR - 8481 fix - 09/06/2011
ELSE
! CurVal=RVar%Which
IF (RVar%Which > RVAR%MaxValue) THEN
RVAR%MaxValue=RVar%Which
RVar%maxValueDate=MDHM
ENDIF
IF (RVar%Which < RVAR%MinValue) THEN
RVAR%MinValue=RVar%Which
RVar%minValueDate=MDHM
ENDIF
RVar%TSValue=RVar%TSValue+RVar%Which
RVar%EITSValue = RVar%TSValue !CR - 8481 fix - 09/06/2011
ENDIF
! End of "record keeping" Report if applicable
IF (.not. RVar%Report) CYCLE
ReportNow=.true.
IF (RVar%SchedPtr > 0) &
ReportNow=(GetCurrentScheduleValue(RVar%SchedPtr) /= 0.0d0) ! SetReportNow(RVar%SchedPtr)
IF (.not. ReportNow) CYCLE
RVar%tsStored=.true.
if (.not. RVar%thistsStored) then
RVar%thisTScount=RVar%thisTScount+1
RVar%thistsStored=.true.
endif
IF (RVar%ReportFreq == ReportEach) THEN
IF (TimePrint) THEN
IF (LHourP /= HourOfDay .or. ABS(LStartMin-StartMinute) > .001d0 &
.or. ABS(LEndMin-TimeValue(IndexType)%CurMinute) > .001d0) THEN
CurDayType=DayOfWeek
IF (HolidayIndex > 0) THEN
CurDayType=7+HolidayIndex
ENDIF
SQLdbTimeIndex = WriteTimeStampFormatData (OutputFileStandard, ReportEach, &
TimeStepStampReportNbr, TimeStepStampReportChr, DayOfSim, DayOfSimChr, &
Month, DayOfMonth, HourOfDay, &
TimeValue(IndexType)%CurMinute, StartMinute, &
DSTIndicator, DayTypes(CurDayType))
LHourP=HourOfDay
LStartMin=StartMinute
LEndMin=TimeValue(IndexType)%CurMinute
ENDIF
TimePrint=.false.
ENDIF
CALL WriteRealData (RVar%ReportID, RVar%ReportIDChr, SQLdbTimeIndex, RVar%Which)
StdOutputRecordCount=StdOutputRecordCount+1
ENDIF
ENDDO
DO Loop=1,NumOfIVariable
IF (IVariableTypes(Loop)%IndexType /= IndexType) CYCLE
! Act on the IVariables variable using the IVar structure
IVar=>IVariableTypes(Loop)%VarPtr
IVar%Stored=.true.
! ICurVal=IVar%Which
IF (IVar%StoreType == AveragedVar) THEN
ICurVal=IVar%Which*rxTime
IVar%TSValue=IVar%TSValue+ICurVal
IVar%EITSValue = IVar%TSValue !CR - 8481 fix - 09/06/2011
IF (NINT(ICurVal) > IVar%MaxValue) THEN
IVar%MaxValue=NINT(ICurVal) ! Record keeping for date and time go here too
IVar%maxValueDate=MDHM !+ TimeValue(IndexType)%TimeStep
ENDIF
IF (NINT(ICurVal) < IVar%MinValue) THEN
IVar%MinValue=NINT(ICurVal)
IVar%minValueDate=MDHM !+ TimeValue(IndexType)%TimeStep
ENDIF
ELSE
IF (IVar%Which > IVar%MaxValue) THEN
IVar%MaxValue=IVar%Which ! Record keeping for date and time go here too
IVar%maxValueDate=MDHM !+ TimeValue(IndexType)%TimeStep
ENDIF
IF (IVar%Which < IVar%MinValue) THEN
IVar%MinValue=IVar%Which
IVar%minValueDate=MDHM !+ TimeValue(IndexType)%TimeStep
ENDIF
IVar%TSValue=IVar%TSValue+IVar%Which
IVar%EITSValue = IVar%TSValue !CR - 8481 fix - 09/06/2011
ENDIF
IF (.not. IVar%Report) CYCLE
ReportNow=.true.
IF (IVar%SchedPtr > 0) &
ReportNow=(GetCurrentScheduleValue(IVar%SchedPtr) /= 0.0d0) !SetReportNow(IVar%SchedPtr)
IF (.not. ReportNow) CYCLE
IVar%tsStored=.true.
if (.not. IVar%thistsStored) then
IVar%thisTScount=IVar%thisTScount+1
IVar%thistsStored=.true.
endif
IF (IVar%ReportFreq == ReportEach) THEN
IF (TimePrint) THEN
IF (LHourP /= HourOfDay .or. ABS(LStartMin-StartMinute) > .001d0 &
.or. ABS(LEndMin-TimeValue(IndexType)%CurMinute) > .001d0) THEN
CurDayType=DayOfWeek
IF (HolidayIndex > 0) THEN
CurDayType=7+HolidayIndex
ENDIF
SQLdbTimeIndex = WriteTimeStampFormatData (OutputFileStandard, ReportEach, &
TimeStepStampReportNbr, TimeStepStampReportChr, DayOfSim, DayOfSimChr, &
Month, DayOfMonth, HourOfDay, &
TimeValue(IndexType)%CurMinute, StartMinute, &
DSTIndicator, DayTypes(CurDayType))
LHourP=HourOfDay
LStartMin=StartMinute
LEndMin=TimeValue(IndexType)%CurMinute
ENDIF
TimePrint=.false.
ENDIF
! only time integer vars actual report as integer only is "detailed"
CALL WriteIntegerData (IVar%ReportID, IVar%ReportIDChr, SQLdbTimeIndex, IntegerValue=IVar%Which)
StdOutputRecordCount=StdOutputRecordCount+1
ENDIF
ENDDO
CASE DEFAULT
CALL ShowSevereError('Illegal Index passed to Report Variables')
END SELECT
IF (IndexType == HVACVar) RETURN ! All other stuff happens at the "zone" time step call to this routine.
!! TimeStep Block (Report on Zone TimeStep)
IF (EndTimeStepFlag) THEN
DO IndexType = 1,2
DO Loop=1,NumOfRVariable
IF (RVariableTypes(Loop)%IndexType /= IndexType) CYCLE
RVar=>RVariableTypes(Loop)%VarPtr
! Update meters on the TimeStep (Zone)
IF (RVar%MeterArrayPtr /= 0) THEN
IF (VarMeterArrays(RVar%MeterArrayPtr)%NumOnCustomMeters <= 0) THEN
CALL UpdateMeterValues(RVar%TSValue * RVar%ZoneMult * RVar%ZoneListMult, &
VarMeterArrays(RVar%MeterArrayPtr)%NumOnMeters,VarMeterArrays(RVar%MeterArrayPtr)%OnMeters)
ELSE
CALL UpdateMeterValues(RVar%TSValue * RVar%ZoneMult * RVar%ZoneListMult, &
VarMeterArrays(RVar%MeterArrayPtr)%NumOnMeters,VarMeterArrays(RVar%MeterArrayPtr)%OnMeters, &
VarMeterArrays(RVar%MeterArrayPtr)%NumOnCustomMeters,VarMeterArrays(RVar%MeterArrayPtr)%OnCustomMeters)
ENDIF
ENDIF
ReportNow=.true.
IF (RVar%SchedPtr > 0) &
ReportNow=(GetCurrentScheduleValue(RVar%SchedPtr) /= 0.0d0) !SetReportNow(RVar%SchedPtr)
IF (.not. ReportNow .or. .not. RVar%Report) THEN
RVar%TSValue=0.0d0
ENDIF
! IF (RVar%StoreType == AveragedVar) THEN
! RVar%Value=RVar%Value+RVar%TSValue/NumOfTimeStepInHour
! ELSE
RVar%Value=RVar%Value+RVar%TSValue
! ENDIF
IF (.not. ReportNow .or. .not. RVar%Report) CYCLE
IF (RVar%ReportFreq == ReportTimeStep) THEN
IF (TimePrint) THEN
IF (LHourP /= HourOfDay .or. ABS(LStartMin-StartMinute) > .001d0 &
.or. ABS(LEndMin-TimeValue(IndexType)%CurMinute) > .001d0) THEN
CurDayType=DayOfWeek
IF (HolidayIndex > 0) THEN
CurDayType=7+HolidayIndex
ENDIF
SQLdbTimeIndex = WriteTimeStampFormatData (OutputFileStandard, ReportEach, &
TimeStepStampReportNbr, TimeStepStampReportChr, DayOfSim, DayOfSimChr, &
Month, DayOfMonth, HourOfDay, &
TimeValue(IndexType)%CurMinute, StartMinute, &
DSTIndicator, DayTypes(CurDayType))
LHourP=HourOfDay
LStartMin=StartMinute
LEndMin=TimeValue(IndexType)%CurMinute
ENDIF
TimePrint=.false.
ENDIF
CALL WriteRealData (RVar%ReportID, RVar%ReportIDChr, SQLdbTimeIndex, RVar%TSValue)
StdOutputRecordCount=StdOutputRecordCount+1
ENDIF
RVar%TSValue=0.0d0
RVar%thisTSstored=.false.
ENDDO ! Number of R Variables
DO Loop=1,NumOfIVariable
IF (IVariableTypes(Loop)%IndexType /= IndexType) CYCLE
IVar=>IVariableTypes(Loop)%VarPtr
ReportNow=.true.
IF (IVar%SchedPtr > 0) &
ReportNow=(GetCurrentScheduleValue(IVar%SchedPtr) /= 0.0d0) ! SetReportNow(IVar%SchedPtr)
IF (.not. ReportNow) THEN
IVar%TSValue=0.0d0
ENDIF
! IF (IVar%StoreType == AveragedVar) THEN
! IVar%Value=IVar%Value+REAL(IVar%TSValue,r64)/REAL(NumOfTimeStepInHour,r64)
! ELSE
IVar%Value=IVar%Value+IVar%TSValue
! ENDIF
IF (.not. ReportNow .or. .not. IVar%Report) CYCLE
IF (IVar%ReportFreq == ReportTimeStep) THEN
IF (TimePrint) THEN
IF (LHourP /= HourOfDay .or. ABS(LStartMin-StartMinute) > .001d0 &
.or. ABS(LEndMin-TimeValue(IndexType)%CurMinute) > .001d0) THEN
CurDayType=DayOfWeek
IF (HolidayIndex > 0) THEN
CurDayType=7+HolidayIndex
ENDIF
SQLdbTimeIndex = WriteTimeStampFormatData (OutputFileStandard, ReportEach, &
TimeStepStampReportNbr, TimeStepStampReportChr, DayOfSim, DayOfSimChr, &
Month, DayOfMonth, HourOfDay, &
TimeValue(IndexType)%CurMinute, StartMinute, &
DSTIndicator, DayTypes(CurDayType))
LHourP=HourOfDay
LStartMin=StartMinute
LEndMin=TimeValue(IndexType)%CurMinute
ENDIF
TimePrint=.false.
ENDIF
CALL WriteIntegerData (IVar%ReportID, IVar%ReportIDChr, SQLdbTimeIndex, RealValue=IVar%TSValue)
StdOutputRecordCount=StdOutputRecordCount+1
ENDIF
IVar%TSValue=0.0d0
IVar%thisTSstored=.false.
ENDDO ! Number of I Variables
ENDDO ! Index Type (Zone or HVAC)
CALL UpdateMeters(MDHM)
CALL ReportTSMeters(StartMinute,TimeValue(1)%CurMinute,TimePrint)
ENDIF ! TimeStep Block
!! Hour Block
IF (EndHourFlag) THEN
IF (TrackingHourlyVariables) THEN
CurDayType=DayOfWeek
IF (HolidayIndex > 0) THEN
CurDayType=7+HolidayIndex
ENDIF
SQLdbTimeIndex = WriteTimeStampFormatData (OutputFileStandard, ReportHourly, &
TimeStepStampReportNbr, TimeStepStampReportChr, DayOfSim, DayOfSimChr, &
Month, DayOfMonth, HourOfDay, &
DST=DSTIndicator, DayType=DayTypes(CurDayType))
ENDIF
DO IndexType=1,2 ! Zone, HVAC
TimeValue(IndexType)%CurMinute=0.0d0
DO Loop=1,NumOfRVariable
IF (RVariableTypes(Loop)%IndexType /= IndexType) CYCLE
RVar=>RVariableTypes(Loop)%VarPtr
! ReportNow=.true.
! IF (RVar%SchedPtr > 0) &
! ReportNow=(GetCurrentScheduleValue(RVar%SchedPtr) /= 0.0) !SetReportNow(RVar%SchedPtr)
! IF (ReportNow) THEN
IF (RVar%tsStored) THEN
IF (RVar%StoreType == AveragedVar) THEN
RVar%Value=RVar%Value/REAL(RVar%thisTSCount,r64)
ENDIF
IF (RVar%Report .and. RVar%ReportFreq == ReportHourly .and. RVar%Stored) THEN
CALL WriteRealData (RVar%ReportID, RVar%ReportIDChr, SQLdbTimeIndex, RVar%Value)
StdOutputRecordCount=StdOutputRecordCount+1
RVar%Stored=.false.
ENDIF
RVar%StoreValue=RVar%StoreValue+RVar%Value
RVar%NumStored=RVar%NumStored+1.0d0
ENDIF
RVar%tsStored=.false.
RVar%thisTSstored=.false.
RVar%thisTScount=0
RVar%Value=0.0d0
ENDDO ! Number of R Variables
DO Loop=1,NumOfIVariable
IF (IVariableTypes(Loop)%IndexType /= IndexType) CYCLE
IVar=>IVariableTypes(Loop)%VarPtr
! ReportNow=.true.
! IF (IVar%SchedPtr > 0) &
! ReportNow=(GetCurrentScheduleValue(IVar%SchedPtr) /= 0.0) !SetReportNow(IVar%SchedPtr)
! IF (ReportNow) THEN
IF (IVar%tsStored) THEN
IF (IVar%StoreType == AveragedVar) THEN
IVar%Value=IVar%Value/REAL(IVar%thisTSCount,r64)
ENDIF
IF (IVar%Report .and. IVar%ReportFreq == ReportHourly .and. IVar%Stored) THEN
CALL WriteIntegerData (IVar%ReportID, IVar%ReportIDChr, SQLdbTimeIndex, RealValue=IVar%Value)
StdOutputRecordCount=StdOutputRecordCount+1
IVar%Stored=.false.
ENDIF
IVar%StoreValue=IVar%StoreValue+IVar%Value
IVar%NumStored=IVar%NumStored+1.0d0
ENDIF
IVar%tsStored=.false.
IVar%thisTSstored=.false.
IVar%thisTScount=0
IVar%Value=0.0d0
ENDDO ! Number of I Variables
ENDDO ! IndexType (Zone or HVAC)
CALL ReportHRMeters
ENDIF ! Hour Block
IF (.not. EndHourFlag) RETURN
!! Day Block
IF (EndDayFlag) THEN
IF (TrackingDailyVariables) THEN
CurDayType=DayOfWeek
IF (HolidayIndex > 0) THEN
CurDayType=7+HolidayIndex
ENDIF
SQLdbTimeIndex = WriteTimeStampFormatData(OutputFileStandard, ReportDaily, &
DailyStampReportNbr, DailyStampReportChr, DayOfSim, DayOfSimChr, &
Month, DayOfMonth, &
DST=DSTIndicator, DayType=DayTypes(CurDayType))
ENDIF
NumHoursinMonth=NumHoursinMonth+24
DO IndexType=1,2
DO Loop=1,NumOfRVariable
IF (RVariableTypes(Loop)%IndexType == IndexType) THEN
RVar=>RVariableTypes(Loop)%VarPtr
CALL WriteRealVariableOutput (ReportDaily, SQLdbTimeIndex)
END IF
ENDDO ! Number of R Variables
DO Loop=1,NumOfIVariable
IF (IVariableTypes(Loop)%IndexType == IndexType) THEN
IVar=>IVariableTypes(Loop)%VarPtr
CALL WriteIntegerVariableOutput (ReportDaily, SQLdbTimeIndex)
END IF
ENDDO ! Number of I Variables
ENDDO ! Index type (Zone or HVAC)
CALL ReportDYMeters
ENDIF ! Day Block
! Only continue if EndDayFlag is set
IF (.not. EndDayFlag) RETURN
!! Month Block
IF (EndMonthFlag .or. EndEnvrnFlag) THEN
IF (TrackingMonthlyVariables) THEN
SQLdbTimeIndex = WriteTimeStampFormatData (OutputFileStandard, ReportMonthly, &
MonthlyStampReportNbr, MonthlyStampReportChr, DayOfSim, DayOfSimChr, Month)
ENDIF
NumHoursinSim=NumHoursinSim+NumHoursinMonth
EndMonthFlag=.false.
DO IndexType=1,2 ! Zone, HVAC
DO Loop=1,NumOfRVariable
IF (RVariableTypes(Loop)%IndexType == IndexType) THEN
RVar=>RVariableTypes(Loop)%VarPtr
CALL WriteRealVariableOutput (ReportMonthly, SQLdbTimeIndex)
END IF
ENDDO ! Number of R Variables
DO Loop=1,NumOfIVariable
IF (IVariableTypes(Loop)%IndexType == IndexType) THEN
IVar=>IVariableTypes(Loop)%VarPtr
CALL WriteIntegerVariableOutput (ReportMonthly, SQLdbTimeIndex)
END IF
ENDDO ! Number of I Variables
ENDDO ! IndexType (Zone, HVAC)
CALL ReportMNMeters
NumHoursInMonth=0
ENDIF ! Month Block
!! Sim/Environment Block
IF (EndEnvrnFlag) THEN
IF (TrackingRunPeriodVariables) THEN
SQLdbTimeIndex = WriteTimeStampFormatData (OutputFileStandard, ReportSim, &
RunPeriodStampReportNbr, RunPeriodStampReportChr, DayOfSim, DayOfSimChr)
ENDIF
DO IndexType=1,2 ! Zone, HVAC
DO Loop=1,NumOfRVariable
IF (RVariableTypes(Loop)%IndexType == IndexType) THEN
RVar=>RVariableTypes(Loop)%VarPtr
CALL WriteRealVariableOutput (ReportSim, SQLdbTimeIndex)
END IF
ENDDO ! Number of R Variables
DO Loop=1,NumOfIVariable
IF (IVariableTypes(Loop)%IndexType == IndexType) THEN
IVar=>IVariableTypes(Loop)%VarPtr
CALL WriteIntegerVariableOutput (ReportSim, SQLdbTimeIndex)
END IF
ENDDO ! Number of I Variables
ENDDO ! Index Type (Zone, HVAC)
CALL ReportSMMeters
NumHoursInSim=0
ENDIF
RETURN
END SUBROUTINE UpdateDataandReport