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 ReportWarmupConvergence
! SUBROUTINE INFORMATION:
! AUTHOR Linda Lawrie
! DATE WRITTEN October 2011
! MODIFIED na
! RE-ENGINEERED na
! PURPOSE OF THIS SUBROUTINE:
! na
! METHODOLOGY EMPLOYED:
! na
! REFERENCES:
! na
! USE STATEMENTS:
USE General, ONLY: RoundSigDigits
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 :: ZoneNum
LOGICAL,SAVE :: FirstWarmupWrite=.true.
REAL(r64) :: AverageZoneTemp
REAL(r64) :: AverageZoneLoad
REAL(r64) :: StdDevZoneTemp
REAL(r64) :: StdDevZoneLoad
CHARACTER(len=15) :: EnvHeader
INTEGER :: Num ! loop control
IF (.not. WarmupFlag) THEN ! Report out average/std dev
! Write Warmup Convervence Information to the initialization output file
IF (FirstWarmupWrite .and. NumOfZones > 0) THEN
Write(OutputFileInits,730)
FirstWarmupWrite=.false.
ENDIF
TempZoneRptStdDev=0.0d0
LoadZoneRptStdDev=0.0d0
IF (RunPeriodEnvironment) THEN
EnvHeader='RunPeriod:'
ELSE
EnvHeader='SizingPeriod:'
ENDIF
DO ZoneNum=1,NumofZones
AverageZoneTemp=SUM(TempZoneRpt(1:CountWarmupDayPoints,ZoneNum))/REAL(CountWarmupDayPoints,r64)
DO Num=1,CountWarmupDayPoints
IF (MaxLoadZoneRpt(Num,ZoneNum) > 1.d-4) THEN
LoadZoneRpt(Num,ZoneNum)=LoadZoneRpt(Num,ZoneNum)/MaxLoadZoneRpt(Num,ZoneNum)
ELSE
LoadZoneRpt(Num,ZoneNum)=0.0d0
ENDIF
ENDDO
AverageZoneLoad=SUM(LoadZoneRpt(1:CountWarmupDayPoints,ZoneNum))/REAL(CountWarmupDayPoints,r64)
StdDevZoneTemp=0.0d0
StdDevZoneLoad=0.0d0
DO Num=1,CountWarmupDayPoints
TempZoneRptStdDev(Num)=(TempZoneRpt(Num,ZoneNum)-AverageZoneTemp)**2
LoadZoneRptStdDev(Num)=(LoadZoneRpt(Num,ZoneNum)-AverageZoneLoad)**2
ENDDO
StdDevZoneTemp=SQRT(SUM(TempZoneRptStdDev(1:CountWarmupDayPoints))/REAL(CountWarmupDayPoints,r64))
StdDevZoneLoad=SQRT(SUM(LoadZoneRptStdDev(1:CountWarmupDayPoints))/REAL(CountWarmupDayPoints,r64))
Write(OutputFileInits,731) TRIM(Zone(ZoneNum)%Name), &
trim(EnvHeader)//' '//trim(EnvironmentName), &
trim(RoundSigDigits(AverageZoneTemp,10)), &
trim(RoundSigDigits(StdDevZoneTemp,10)), &
trim(PassFail(WarmupConvergenceValues(ZoneNum)%PassFlag(1))), &
trim(PassFail(WarmupConvergenceValues(ZoneNum)%PassFlag(2))), &
trim(RoundSigDigits(AverageZoneLoad,10)), &
trim(RoundSigDigits(StdDevZoneLoad,10)), &
trim(PassFail(WarmupConvergenceValues(ZoneNum)%PassFlag(3))), &
trim(PassFail(WarmupConvergenceValues(ZoneNum)%PassFlag(4)))
ENDDO
END IF
RETURN
730 Format('! <Warmup Convergence Information>,Zone Name,Environment Type/Name,', &
'Average Warmup Temperature Difference {deltaC},', &
'Std Dev Warmup Temperature Difference {deltaC},Max Temperature Pass/Fail Convergence,', &
'Min Temperature Pass/Fail Convergence,Average Warmup Load Difference {W},Std Dev Warmup Load Difference {W},', &
'Heating Load Pass/Fail Convergence,Cooling Load Pass/Fail Convergence')
731 Format(' Warmup Convergence Information',10(',',A))
END SUBROUTINE ReportWarmupConvergence