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 GetProjectData
! SUBROUTINE INFORMATION:
! AUTHOR Linda K. Lawrie
! DATE WRITTEN November 1997
! MODIFIED na
! RE-ENGINEERED na
! PURPOSE OF THIS SUBROUTINE:
! This subroutine gets global project data from the input file.
! METHODOLOGY EMPLOYED:
! Use GetObjectItem from the Input Processor
! REFERENCES:
! na
! USE STATEMENTS:
USE InputProcessor
USE DataStringGlobals, ONLY: MatchVersion
USE DataConvergParams
USE DataSystemVariables
USE DataHVACGlobals, ONLY: LimitNumSysSteps,deviationFromSetPtThresholdHtg, &
deviationFromSetPtThresholdClg
USE General, ONLY: RoundSigDigits
USE DataEnvironment, ONLY: DisplayWeatherMissingDataWarnings,IgnoreSolarRadiation,IgnoreBeamRadiation, &
IgnoreDiffuseRadiation
USE DataIPShortCuts
IMPLICIT NONE ! Enforce explicit typing of all variables in this routine
! SUBROUTINE ARGUMENT DEFINITIONS:
! na
! SUBROUTINE PARAMETER DEFINITIONS:
INTEGER, PARAMETER, DIMENSION(12) :: Div60=(/1,2,3,4,5,6,10,12,15,20,30,60/)
CHARACTER(len=*), PARAMETER :: Blank=' '
CHARACTER(len=*), PARAMETER :: fmtA='(A)'
! INTERFACE BLOCK SPECIFICATIONS:
! na
! DERIVED TYPE DEFINITIONS:
! na
! SUBROUTINE LOCAL VARIABLE DECLARATIONS:
CHARACTER(len=MaxNameLength), DIMENSION(5) :: Alphas
REAL(r64), DIMENSION(4) :: Number
INTEGER NumAlpha, NumNumber, IOStat
INTEGER :: NumDebugOut
INTEGER :: MinInt
INTEGER :: Num
INTEGER :: Which
LOGICAL :: ErrorsFound
INTEGER :: Num1
INTEGER :: NumA
INTEGER :: NumRunControl
CHARACTER(len=20) :: VersionID=' '
CHARACTER(len=MaxNameLength) :: CurrentModuleObject
LOGICAL :: CondFDAlgo
INTEGER :: Item
ErrorsFound=.false.
CurrentModuleObject='Version'
Num=GetNumObjectsFound(CurrentModuleObject)
IF (Num == 1) THEN
CALL GetObjectItem(CurrentModuleObject,1,Alphas,NumAlpha,Number,NumNumber,IOStat, &
AlphaBlank=lAlphaFieldBlanks,NumBlank=lNumericFieldBlanks, &
AlphaFieldnames=cAlphaFieldNames,NumericFieldNames=cNumericFieldNames)
Num1=LEN_TRIM(MatchVersion)
IF (MatchVersion(Num1:Num1) == '0') THEN
Which=INDEX(Alphas(1)(1:Num1-2),MatchVersion(1:Num1-2))
ELSE
Which=INDEX(Alphas(1),MatchVersion)
ENDIF
IF (Which /= 1) THEN
CALL ShowWarningError(TRIM(CurrentModuleObject)//': in IDF="'//TRIM(Alphas(1))// &
'" not the same as expected="'//TRIM(MatchVersion)//'"')
ENDIF
VersionID=Alphas(1)
ELSEIF (Num == 0) THEN
CALL ShowWarningError(TRIM(CurrentModuleObject)//': missing in IDF, processing for EnergyPlus version="'// &
TRIM(MatchVersion)//'"')
ELSE
CALL ShowSevereError('Too many '//TRIM(CurrentModuleObject)//' Objects found.')
ErrorsFound=.true.
ENDIF
! Do Mini Gets on HB Algorithm and by-surface overrides
CurrentModuleObject='HeatBalanceAlgorithm'
Num=GetNumObjectsFound(CurrentModuleObject)
CondFDAlgo=.false.
IF (Num > 0) THEN
CALL GetObjectItem(CurrentModuleObject,1,Alphas,NumAlpha,Number,NumNumber,IOStat, &
AlphaBlank=lAlphaFieldBlanks,NumBlank=lNumericFieldBlanks, &
AlphaFieldnames=cAlphaFieldNames,NumericFieldNames=cNumericFieldNames)
SELECT CASE (Alphas(1))
CASE ('CONDUCTIONFINITEDIFFERENCE','CONDFD','CONDUCTIONFINITEDIFFERENCEDETAILED','CONDUCTIONFINITEDIFFERENCESIMPLIFIED')
CondFDAlgo=.true.
CASE DEFAULT
END SELECT
ENDIF
CurrentModuleObject = 'SurfaceProperty:HeatTransferAlgorithm'
Num=GetNumObjectsFound(CurrentModuleObject)
IF (Num > 0) THEN
DO Item = 1, Num
CALL GetObjectItem(CurrentModuleObject,Item,Alphas,NumAlpha,Number,NumNumber,IOStat, &
AlphaBlank=lAlphaFieldBlanks,NumBlank=lNumericFieldBlanks, &
AlphaFieldnames=cAlphaFieldNames,NumericFieldNames=cNumericFieldNames)
SELECT CASE (Alphas(2))
CASE ('CONDUCTIONFINITEDIFFERENCE')
CondFDAlgo=.true.
CASE DEFAULT
END SELECT
ENDDO
ENDIF
CurrentModuleObject = 'SurfaceProperty:HeatTransferAlgorithm:MultipleSurface'
Num=GetNumObjectsFound(CurrentModuleObject)
IF (Num > 0) THEN
DO Item = 1, Num
CALL GetObjectItem(CurrentModuleObject,1,Alphas,NumAlpha,Number,NumNumber,IOStat, &
AlphaBlank=lAlphaFieldBlanks,NumBlank=lNumericFieldBlanks, &
AlphaFieldnames=cAlphaFieldNames,NumericFieldNames=cNumericFieldNames)
SELECT CASE (Alphas(3))
CASE ('CONDUCTIONFINITEDIFFERENCE')
CondFDAlgo=.true.
CASE DEFAULT
END SELECT
ENDDO
ENDIF
CurrentModuleObject = 'SurfaceProperty:HeatTransferAlgorithm:SurfaceList'
Num=GetNumObjectsFound(CurrentModuleObject)
IF (Num > 0) THEN
DO Item = 1, Num
CALL GetObjectItem(CurrentModuleObject,1,cAlphaArgs,NumAlpha,Number,NumNumber,IOStat, &
AlphaBlank=lAlphaFieldBlanks,NumBlank=lNumericFieldBlanks, &
AlphaFieldnames=cAlphaFieldNames,NumericFieldNames=cNumericFieldNames)
SELECT CASE (cAlphaArgs(2))
CASE ('CONDUCTIONFINITEDIFFERENCE')
CondFDAlgo=.true.
CASE DEFAULT
END SELECT
ENDDO
ENDIF
CurrentModuleObject = 'SurfaceProperty:HeatTransferAlgorithm:Construction'
Num=GetNumObjectsFound(CurrentModuleObject)
IF (Num > 0) THEN
DO Item = 1, Num
CALL GetObjectItem(CurrentModuleObject,1,cAlphaArgs,NumAlpha,Number,NumNumber,IOStat, &
AlphaBlank=lAlphaFieldBlanks,NumBlank=lNumericFieldBlanks, &
AlphaFieldnames=cAlphaFieldNames,NumericFieldNames=cNumericFieldNames)
SELECT CASE (cAlphaArgs(2))
CASE ('CONDUCTIONFINITEDIFFERENCE')
CondFDAlgo=.true.
CASE DEFAULT
END SELECT
ENDDO
ENDIF
CurrentModuleObject='Timestep'
Num=GetNumObjectsFound(CurrentModuleObject)
IF (Num == 1) THEN
CALL GetObjectItem(CurrentModuleObject,1,Alphas,NumAlpha,Number,NumNumber,IOStat, &
AlphaBlank=lAlphaFieldBlanks,NumBlank=lNumericFieldBlanks, &
AlphaFieldnames=cAlphaFieldNames,NumericFieldNames=cNumericFieldNames)
NumOfTimeStepInHour=Number(1)
IF (NumOfTimeStepInHour <= 0 .or. NumOfTimeStepInHour > 60) THEN
Alphas(1)=RoundSigDigits(NumOfTimeStepInHour)
CALL ShowWarningError(TRIM(CurrentModuleObject)//': Requested number ('//TRIM(Alphas(1))//') invalid, Defaulted to 4')
NumOfTimeStepInHour=4
ELSEIF (MOD(60,NumOfTimeStepInHour) /= 0) THEN
MinInt=9999
DO Num=1,12
IF (ABS(NumOfTimeStepInHour-Div60(Num)) > MinInt) CYCLE
MinInt=NumOfTimeStepInHour-Div60(Num)
Which=Num
ENDDO
CALL ShowWarningError(TRIM(CurrentModuleObject)//': Requested number ('//TRIM(RoundSigDigits(NumOfTimeStepInHour))// &
') not evenly divisible into 60, '//'defaulted to nearest ('//TRIM(RoundSigDigits(Div60(Which)))//').')
NumOfTimeStepInHour=Div60(Which)
ENDIF
IF (CondFDAlgo .and. NumOfTimeStepInHour < 20) THEN
CALL ShowWarningError(TRIM(CurrentModuleObject)//': Requested number ('//TRIM(RoundSigDigits(NumOfTimeStepInHour))// &
') cannot be used when Conduction Finite Difference algorithm is selected.')
CALL ShowContinueError('...'//trim(CurrentModuleObject)//' is set to 20.')
NumOfTimeStepInHour=20
ENDIF
IF (NumOfTimeStepInHour < 4 .and. GetNumObjectsFound('Zone') > 0) THEN
CALL ShowWarningError(TRIM(CurrentModuleObject)//': Requested number ('//TRIM(RoundSigDigits(NumOfTimeStepInHour))// &
') is less than the suggested minimum of 4.')
CALL ShowContinueError('Please see entry for '//TRIM(CurrentModuleObject)// &
' in Input/Output Reference for discussion of considerations.')
ENDIF
ELSEIF (Num == 0 .and. GetNumObjectsFound('Zone') > 0 .and. .not. CondFDAlgo) THEN
CALL ShowWarningError('No '//TRIM(CurrentModuleObject)//' object found. Number of TimeSteps in Hour defaulted to 4.')
NumOfTimeStepInHour=4
ELSEIF (Num == 0 .and. .not. CondFDAlgo) THEN
NumOfTimeStepInHour=4
ELSEIF (Num == 0 .and. GetNumObjectsFound('Zone') > 0 .and. CondFDAlgo) THEN
CALL ShowWarningError('No '//TRIM(CurrentModuleObject)//' object found. Number of TimeSteps in Hour defaulted to 20.')
CALL ShowContinueError('...Due to presence of Conduction Finite Difference Algorithm selection.')
NumOfTimeStepInHour=20
ELSEIF (Num == 0 .and. CondFDAlgo) THEN
NumOfTimeStepInHour=20
ELSE
CALL ShowSevereError('Too many '//TRIM(CurrentModuleObject)//' Objects found.')
ErrorsFound=.true.
ENDIF
TimeStepZone=1.0d0/REAL(NumOfTimeStepInHour,r64)
MinutesPerTimeStep=TimeStepZone*60
CurrentModuleObject='ConvergenceLimits'
Num=GetNumObjectsFound(CurrentModuleObject)
IF (Num == 1) THEN
CALL GetObjectItem(CurrentModuleObject,1,Alphas,NumAlpha,Number,NumNumber,IOStat, &
AlphaBlank=lAlphaFieldBlanks,NumBlank=lNumericFieldBlanks, &
AlphaFieldnames=cAlphaFieldNames,NumericFieldNames=cNumericFieldNames)
MinInt=INT(Number(1))
IF (MinInt > MinutesPerTimeStep) THEN
MinInt=MinutesPerTimeStep
ENDIF
IF (MinInt < 0 .or. MinInt > 60) THEN
CALL ShowWarningError(TRIM(CurrentModuleObject)//': Requested '//TRIM(cNumericFieldNames(1))// &
' ('//TRIM(RoundSigDigits(MinInt))//') invalid. Set to 1 minute.')
MinTimeStepSys=1.d0/60.d0
ELSEIF (MinInt == 0) THEN ! Set to TimeStepZone
MinTimeStepSys=TimeStepZone
ELSE
MinTimeStepSys=REAL(MinInt,r64)/60.0d0
ENDIF
MaxIter=INT(Number(2))
IF (MaxIter <= 0) THEN
MaxIter=20
ENDIF
IF (.NOT. lNumericFieldBlanks(3)) MinPlantSubIterations = INT(Number(3))
IF (.NOT. lNumericFieldBlanks(4)) MaxPlantSubIterations = INT(Number(4))
! trap bad values
IF (MinPlantSubIterations < 1) MinPlantSubIterations = 1
IF (MaxPlantSubIterations < 3) MaxPlantSubIterations = 3
IF (MinPlantSubIterations > MaxPlantSubIterations) MaxPlantSubIterations = MinPlantSubIterations + 1
ELSEIF (Num == 0) THEN
MinTimeStepSys=1.d0/60.d0
MaxIter=20
MinPlantSubIterations = 2
MaxPlantSubIterations = 8
ELSE
CALL ShowSevereError('Too many '//TRIM(CurrentModuleObject)//' Objects found.')
ErrorsFound=.true.
ENDIF
LimitNumSysSteps = INT(TimeStepZone/MinTimeStepSys)
DebugOutput = .FALSE.
EvenDuringWarmup = .FALSE.
CurrentModuleObject='Output:DebuggingData'
NumDebugOut = GetNumObjectsFound(CurrentModuleObject)
IF (NumDebugOut > 0) THEN
CALL GetObjectItem(CurrentModuleObject,1,Alphas,NumAlpha,Number,NumNumber,IOStat)
IF (INT(Number(1)) == 1) THEN
DebugOutput = .TRUE.
END IF
IF (INT(Number(2)) == 1) THEN
EvenDuringWarmup = .TRUE.
END IF
END IF
CurrentModuleObject='Output:Diagnostics'
Num=GetNumObjectsFound(CurrentModuleObject)
DO Num1=1,Num
CALL GetObjectItem(CurrentModuleObject,Num1,Alphas,NumAlpha,Number,NumNumber,IOStat)
DO NumA=1,NumAlpha
IF (SameString(Alphas(NumA),'DisplayExtraWarnings')) THEN
DisplayExtraWarnings=.true.
ELSEIF (SameString(Alphas(NumA),'DisplayAdvancedReportVariables')) THEN
DisplayAdvancedReportVariables=.true.
ELSEIF (SameString(Alphas(NumA),'DisplayAllWarnings')) THEN
DisplayAllWarnings=.true.
DisplayExtraWarnings=.true.
DisplayUnusedObjects=.true.
DisplayUnusedSchedules=.true.
ELSEIF (SameString(Alphas(NumA),'DisplayUnusedObjects')) THEN
DisplayUnusedObjects=.true.
ELSEIF (SameString(Alphas(NumA),'DisplayUnusedSchedules')) THEN
DisplayUnusedSchedules=.true.
ELSEIF (SameString(Alphas(NumA),'DisplayZoneAirHeatBalanceOffBalance')) THEN
DisplayZoneAirHeatBalanceOffBalance=.true.
ELSEIF (SameString(Alphas(NumA),'DoNotMirrorDetachedShading')) THEN
MakeMirroredDetachedShading=.false.
ELSEIF (SameString(Alphas(NumA),'DoNotMirrorAttachedShading')) THEN
MakeMirroredAttachedShading=.false.
ELSEIF (SameString(Alphas(NumA),'IgnoreInteriorWindowTransmission')) THEN
IgnoreInteriorWindowTransmission=.true.
ELSEIF (SameString(Alphas(NumA),'ReportDuringWarmup')) THEN
ReportDuringWarmup=.true.
ELSEIF (SameString(Alphas(NumA),'DisplayWeatherMissingDataWarnings')) THEN
DisplayWeatherMissingDataWarnings=.true.
ELSEIF (SameString(Alphas(NumA),'IgnoreSolarRadiation')) THEN
IgnoreSolarRadiation=.true.
ELSEIF (SameString(Alphas(NumA),'IgnoreBeamRadiation')) THEN
IgnoreBeamRadiation=.true.
ELSEIF (SameString(Alphas(NumA),'IgnoreDiffuseRadiation')) THEN
IgnoreDiffuseRadiation=.true.
ELSEIF (SameString(Alphas(NumA),'DeveloperFlag')) THEN
DeveloperFlag=.true.
ELSEIF (SameString(Alphas(NumA),'TimingFlag')) THEN
TimingFlag=.true.
ELSEIF (SameString(Alphas(NumA),'ReportDetailedWarmupConvergence')) THEN
ReportDetailedWarmupConvergence=.true.
ELSEIF (SameString(Alphas(NumA),'CreateMinimalSurfaceVariables')) THEN
CYCLE
! CreateMinimalSurfaceVariables=.true.
ELSEIF (SameString(Alphas(NumA),'CreateNormalSurfaceVariables')) THEN
CYCLE
! IF (CreateMinimalSurfaceVariables) THEN
! CALL ShowWarningError('GetProjectData: '//trim(CurrentModuleObject)//'=''// &
! TRIM(Alphas(NumA))//'', prior set=true for this condition reverts to false.')
! ENDIF
! CreateMinimalSurfaceVariables=.false.
ELSEIF (Alphas(NumA) /= Blank) THEN
CALL ShowWarningError('GetProjectData: '//trim(CurrentModuleObject)//'="'// &
TRIM(Alphas(NumA))//'", Invalid value for field, entered value ignored.')
ENDIF
ENDDO
ENDDO
CurrentModuleObject='OutputControl:ReportingTolerances'
Num = GetNumObjectsFound(CurrentModuleObject)
IF (Num > 0) THEN
CALL GetObjectItem(CurrentModuleObject,1,Alphas,NumAlpha,Number,NumNumber,IOStat, &
AlphaBlank=lAlphaFieldBlanks,NumBlank=lNumericFieldBlanks, &
AlphaFieldnames=cAlphaFieldNames,NumericFieldNames=cNumericFieldNames)
IF (.not. lNumericFieldBlanks(1)) THEN
deviationFromSetPtThresholdHtg=-Number(1)
ELSE
deviationFromSetPtThresholdHtg=-.2d0
ENDIF
IF (.not. lNumericFieldBlanks(2)) THEN
deviationFromSetPtThresholdClg=Number(2)
ELSE
deviationFromSetPtThresholdClg=.2d0
ENDIF
END IF
DoZoneSizing = .FALSE.
DoSystemSizing = .FALSE.
DoPlantSizing = .FALSE.
DoDesDaySim = .TRUE.
DoWeathSim = .TRUE.
CurrentModuleObject='SimulationControl'
NumRunControl = GetNumObjectsFound(CurrentModuleObject)
IF (NumRunControl > 0) THEN
RunControlInInput=.true.
CALL GetObjectItem(CurrentModuleObject,1,Alphas,NumAlpha,Number,NumNumber,IOStat, &
AlphaBlank=lAlphaFieldBlanks,NumBlank=lNumericFieldBlanks, &
AlphaFieldnames=cAlphaFieldNames,NumericFieldNames=cNumericFieldNames)
IF (Alphas(1).EQ.'YES') DoZoneSizing = .TRUE.
IF (Alphas(2).EQ.'YES') DoSystemSizing = .TRUE.
IF (Alphas(3).EQ.'YES') DoPlantSizing = .TRUE.
IF (Alphas(4).EQ.'NO') DoDesDaySim = .FALSE.
IF (Alphas(5).EQ.'NO') DoWeathSim = .FALSE.
END IF
IF (DDOnly) THEN
DoDesDaySim=.true.
DoWeathSim=.false.
ENDIF
IF (FullAnnualRun) THEN
DoDesDaySim=.false.
DoWeathSim=.true.
ENDIF
IF (ErrorsFound) THEN
CALL ShowFatalError('Errors found getting Project Input')
ENDIF
Write(OutputFileInits,fmtA) '! <Version>, Version ID'
Write(OutputFileInits,721) TRIM(VersionID)
721 Format(' Version, ',A)
Write(OutputFileInits,fmtA) '! <Timesteps per Hour>, #TimeSteps, Minutes per TimeStep {minutes}'
Write(OutputFileInits,731) NumOfTimeStepInHour,INT(MinutesPerTimeStep)
731 Format(' Timesteps per Hour, ',I2,', ',I2)
Write(OutputFileInits,fmtA) '! <System Convergence Limits>, Minimum System TimeStep {minutes}, Max HVAC Iterations, '// &
' Minimum Plant Iterations, Maximum Plant Iterations'
MinInt=MinTimeStepSys*60.d0
Write(OutputFileInits,733) trim(RoundSigDigits(MinInt)),trim(RoundSigDigits(MaxIter)), &
trim(RoundSigDigits(MinPlantSubIterations)),trim(RoundSigDigits(MaxPlantSubIterations))
733 Format(' System Convergence Limits',4(', ',A))
IF (DoZoneSizing) THEN
Alphas(1)='Yes'
ELSE
Alphas(1)='No'
ENDIF
IF (DoSystemSizing) THEN
Alphas(2)='Yes'
ELSE
Alphas(2)='No'
ENDIF
IF (DoPlantSizing) THEN
Alphas(3)='Yes'
ELSE
Alphas(3)='No'
ENDIF
IF (DoDesDaySim) THEN
Alphas(4)='Yes'
ELSE
Alphas(4)='No'
ENDIF
IF (DoWeathSim) THEN
Alphas(5)='Yes'
ELSE
Alphas(5)='No'
ENDIF
Write(OutputFileInits,fmtA) '! <Simulation Control>, Do Zone Sizing, Do System Sizing, '// &
'Do Plant Sizing, Do Design Days, Do Weather Simulation'
Write(OutputFileInits,741) (TRIM(Alphas(Num)),Num=1,5)
741 Format(' Simulation Control',5(', ',A))
Write(OutputFileInits,fmtA) '! <Output Reporting Tolerances>, Tolerance for Time Heating Setpoint Not Met, '// &
'Tolerance for Zone Cooling Setpoint Not Met Time'
Write(OutputFileInits,751) trim(RoundSigDigits(abs(deviationFromSetPtThresholdHtg),3)), &
trim(RoundSigDigits(deviationFromSetPtThresholdClg,3))
751 Format(' Output Reporting Tolerances',5(', ',A))
! IF (DisplayExtraWarnings) THEN
! Write(OutputFileInits,740)
! Write(OutputFileInits,741) (TRIM(Alphas(Num)),Num=1,5)
!742 Format('! <Display Extra Warnings>, Display Advanced Report Variables, Do Not Mirror Detached Shading')
! IF (DisplayAdvancedReportVariables) THEN
! NumOut1='Yes'
! ELSE
! NumOut2='No'
! ENDIF
! IF (.not. MakeMirroredDetachedShading) THEN
! NumOut1='Yes'
! ELSE
! NumOut2='No'
! ENDIF
!unused0909743 Format(' Display Extra Warnings',2(', ',A))
! ENDIF
RETURN
END SUBROUTINE GetProjectData