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 GetSystemSizingInput
! SUBROUTINE INFORMATION:
! AUTHOR Fred Buhl
! DATE WRITTEN January 2001
! MODIFIED na
! RE-ENGINEERED na
! PURPOSE OF THIS SUBROUTINE:
! Obtains input data for System Sizing objects and stores it in
! appropriate data structures.
! METHODOLOGY EMPLOYED:
! Uses InputProcessor "Get" routines to obtain data.
! REFERENCES:
! na
! USE STATEMENTS:
USE DataIPShortCuts
USE InputProcessor, ONLY: GetNumObjectsFound, GetObjectItem, VerifyName
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 :: SysSizIndex ! loop index
INTEGER :: NumAlphas ! Number of Alphas for each GetObjectItem call
INTEGER :: NumNumbers ! Number of Numbers for each GetObjectItem call
INTEGER :: IOStatus ! Used in GetObjectItem
LOGICAL :: ErrorsFound=.false. ! Set to true if errors in input, fatal at end of routine
LOGICAL :: IsNotOK ! Flag to verify name
LOGICAL :: IsBlank ! Flag for blank name
INTEGER :: NumDesDays ! Number of design days in input
NumAirLoops = GetNumObjectsFound('AirLoopHVAC')
cCurrentModuleObject='Sizing:System'
NumSysSizInput = GetNumObjectsFound(cCurrentModuleObject)
IF (NumSysSizInput > 0) THEN
NumDesDays = GetNumObjectsFound('SizingPeriod:DesignDay') + GetNumObjectsFound('SizingPeriod:WeatherFileDays') + &
GetNumObjectsFound('SizingPeriod:WeatherFileConditionType')
IF (NumDesDays == 0 .AND. (DoSystemSizing .OR. DoPlantSizing) ) THEN
CALL ShowSevereError('System Sizing calculations need SizingPeriod:* input. None found.')
ErrorsFound = .TRUE.
END IF
ALLOCATE(SysSizInput(NumSysSizInput))
END IF
DO SysSizIndex=1,NumSysSizInput
CALL GetObjectItem(cCurrentModuleObject,SysSizIndex,cAlphaArgs,NumAlphas,rNumericArgs,NumNumbers,IOStatus, &
AlphaBlank=lAlphaFieldBlanks,NumBlank=lNumericFieldBlanks, &
AlphaFieldnames=cAlphaFieldNames,NumericFieldNames=cNumericFieldNames)
IsNotOK=.FALSE.
IsBlank=.FALSE.
CALL VerifyName(cAlphaArgs(1),SysSizInput%AirPriLoopName,SysSizIndex-1,IsNotOK,IsBlank,TRIM(cCurrentModuleObject)//' Name')
IF (IsNotOK) THEN
ErrorsFound=.true.
IF (IsBlank) cAlphaArgs(1)='xxxxx'
ENDIF
SysSizInput(SysSizIndex)%AirPriLoopName = cAlphaArgs(1)
SELECT CASE(TRIM(cAlphaArgs(2)))
CASE('SENSIBLE')
SysSizInput(SysSizIndex)%LoadSizeType = Sensible
CASE('LATENT')
SysSizInput(SysSizIndex)%LoadSizeType = Latent
CASE('TOTAL')
SysSizInput(SysSizIndex)%LoadSizeType = Total
CASE('VENTILATIONREQUIREMENT')
SysSizInput(SysSizIndex)%LoadSizeType = Ventilation
CASE DEFAULT
CALL ShowSevereError(TRIM(cCurrentModuleObject)//'="'//trim(cAlphaArgs(1))//'", invalid data.')
CALL ShowContinueError('... incorrect '//TRIM(cAlphaFieldNames(2))//'="'//TRIM(cAlphaArgs(2))//'".')
CALL ShowContinueError('... valid values are Sensible, Latent, Total, or VentilationRequirement.')
ErrorsFound=.true.
END SELECT
SELECT CASE(TRIM(cAlphaArgs(3)))
CASE('COINCIDENT')
SysSizInput(SysSizIndex)%SizingOption = Coincident
CASE('NONCOINCIDENT')
SysSizInput(SysSizIndex)%SizingOption = NonCoincident
CASE DEFAULT
CALL ShowSevereError(TRIM(cCurrentModuleObject)//'="'//trim(cAlphaArgs(1))//'", invalid data.')
CALL ShowContinueError('... incorrect '//TRIM(cAlphaFieldNames(3))//'="'//TRIM(cAlphaArgs(3))//'".')
CALL ShowContinueError('... valid values are Coincident or NonCoincident.')
ErrorsFound=.true.
END SELECT
SELECT CASE(TRIM(cAlphaArgs(4)))
CASE('YES')
SysSizInput(SysSizIndex)%CoolOAOption = 1
CASE('NO')
SysSizInput(SysSizIndex)%CoolOAOption = 2
CASE DEFAULT
CALL ShowSevereError(TRIM(cCurrentModuleObject)//'="'//trim(cAlphaArgs(1))//'", invalid data.')
CALL ShowContinueError('... incorrect '//TRIM(cAlphaFieldNames(4))//'="'//TRIM(cAlphaArgs(4))//'".')
CALL ShowContinueError('... valid values are Yes or No.')
ErrorsFound=.true.
END SELECT
SELECT CASE(TRIM(cAlphaArgs(5)))
CASE('YES')
SysSizInput(SysSizIndex)%HeatOAOption = 1
CASE('NO')
SysSizInput(SysSizIndex)%HeatOAOption = 2
CASE DEFAULT
CALL ShowSevereError(TRIM(cCurrentModuleObject)//'="'//trim(cAlphaArgs(1))//'", invalid data.')
CALL ShowContinueError('... incorrect '//TRIM(cAlphaFieldNames(5))//'="'//TRIM(cAlphaArgs(5))//'".')
CALL ShowContinueError('... valid values are Yes or No.')
ErrorsFound=.true.
END SELECT
! N1, \field Design Outdoor Air Flow Rate
! \type real
! \default autosize
! \minimum 0.0
IF (lNumericFieldBlanks(1)) THEN
SysSizInput(SysSizIndex)%DesOutAirVolFlow = autosize
ELSEIF (rNumericArgs(1) < 0.0d0 .and. rNumericArgs(1) /= autosize) THEN
CALL ShowSevereError(TRIM(cCurrentModuleObject)//'="'//trim(cAlphaArgs(1))//'", invalid data.')
CALL ShowContinueError('... incorrect '//TRIM(cNumericFieldNames(1))//'=['//TRIM(RoundSigDigits(rNumericArgs(1),2))// &
'], value should not be negative.')
ErrorsFound=.true.
ELSE
SysSizInput(SysSizIndex)%DesOutAirVolFlow = rNumericArgs(1)
ENDIF
IF (SysSizInput(SysSizIndex)%DesOutAirVolFlow == autosize) THEN
SysSizInput(SysSizIndex)%OAAutosized = .TRUE.
END IF
! N2, \field Minimum System Air Flow Ratio
! \required-field
! \type real
! \minimum 0.0
! \maximum 1.0
IF (lNumericFieldBlanks(2)) THEN
SysSizInput(SysSizIndex)%SysAirMinFlowRat = 0.0d0
ELSEIF (rNumericArgs(2) < 0.0d0) THEN
CALL ShowSevereError(TRIM(cCurrentModuleObject)//'="'//trim(cAlphaArgs(1))//'", invalid data.')
CALL ShowContinueError('... incorrect '//TRIM(cNumericFieldNames(2))//'=['//TRIM(RoundSigDigits(rNumericArgs(2),2))// &
'], value should not be negative.')
ErrorsFound=.true.
ELSE
SysSizInput(SysSizIndex)%SysAirMinFlowRat = rNumericArgs(2)
ENDIF
SysSizInput(SysSizIndex)%PreheatTemp = rNumericArgs(3)
SysSizInput(SysSizIndex)%PreheatHumRat = rNumericArgs(4)
SysSizInput(SysSizIndex)%PrecoolTemp = rNumericArgs(5)
SysSizInput(SysSizIndex)%PrecoolHumRat = rNumericArgs(6)
SysSizInput(SysSizIndex)%CoolSupTemp = rNumericArgs(7)
SysSizInput(SysSizIndex)%HeatSupTemp = rNumericArgs(8)
SysSizInput(SysSizIndex)%CoolSupHumRat = rNumericArgs(9)
SysSizInput(SysSizIndex)%HeatSupHumRat = rNumericArgs(10)
! N11, \field Cooling Design Air Flow Rate
! \note This input is used if Cooling Design Air Flow Method is Flow/System
! \note This value will *not* be multiplied by any sizing factor or by zone multipliers.
! \note If using zone multipliers, this value must be large enough to serve the multiplied zones.
! \type real
! \units m3/s
! \minimum 0
! \default 0
IF (lNumericFieldBlanks(11)) THEN
SysSizInput(SysSizIndex)%DesCoolAirFlow = 0.0d0
ELSEIF (rNumericArgs(11) < 0.0d0) THEN
CALL ShowSevereError(TRIM(cCurrentModuleObject)//'="'//trim(cAlphaArgs(1))//'", invalid data.')
CALL ShowContinueError('... incorrect '//TRIM(cNumericFieldNames(11))//'=['//TRIM(RoundSigDigits(rNumericArgs(11),2))// &
'], value should not be negative.')
ErrorsFound=.true.
ELSE
SysSizInput(SysSizIndex)%DesCoolAirFlow = rNumericArgs(11)
ENDIF
! N12;\field Heating Design Air Flow Rate
! \note This input is used if Heating Design Air Flow Method is Flow/System
! \note This value will *not* be multiplied by any sizing factor or by zone multipliers.
! \note If using zone multipliers, this value must be large enough to serve the multiplied zones.
! \type real
! \units m3/s
! \minimum 0
! \default 0
IF (lNumericFieldBlanks(12)) THEN
SysSizInput(SysSizIndex)%DesHeatAirFlow = 0.0d0
ELSEIF (rNumericArgs(12) < 0.0d0) THEN
CALL ShowSevereError(TRIM(cCurrentModuleObject)//'="'//trim(cAlphaArgs(1))//'", invalid data.')
CALL ShowContinueError('... incorrect '//TRIM(cNumericFieldNames(12))//'=['//TRIM(RoundSigDigits(rNumericArgs(12),2))// &
'], value should not be negative.')
ErrorsFound=.true.
ELSE
SysSizInput(SysSizIndex)%DesHeatAirFlow = rNumericArgs(12)
ENDIF
! N13;\field Maximum Zone Outdoor Air Fraction
! \type real
! \default 1.0
! \minimum> 0.0
! \units dimensionless
IF (lNumericFieldBlanks(13)) THEN
SysSizInput(SysSizIndex)%MaxZoneOAFraction = 0.0d0
ELSEIF (rNumericArgs(13) < 0.0d0) THEN
CALL ShowSevereError(TRIM(cCurrentModuleObject)//'="'//trim(cAlphaArgs(1))//'", invalid data.')
CALL ShowContinueError('... incorrect '//TRIM(cNumericFieldNames(13))//'=['//TRIM(RoundSigDigits(rNumericArgs(13),2))// &
'], value should not be negative.')
ErrorsFound=.true.
ELSE
SysSizInput(SysSizIndex)%MaxZoneOAFraction = rNumericArgs(13)
ENDIF
SELECT CASE(TRIM(cAlphaArgs(6)))
CASE('DESIGNDAY')
SysSizInput(SysSizIndex)%CoolAirDesMethod = FromDDCalc
CASE('FLOW/SYSTEM')
SysSizInput(SysSizIndex)%CoolAirDesMethod = InpDesAirFlow
CASE DEFAULT
CALL ShowSevereError(TRIM(cCurrentModuleObject)//'="'//trim(cAlphaArgs(1))//'", invalid data.')
CALL ShowContinueError('... incorrect '//TRIM(cAlphaFieldNames(6))//'="'//TRIM(cAlphaArgs(6))//'".')
CALL ShowContinueError('... valid values are DesignDay or Flow/System.')
ErrorsFound=.true.
END SELECT
SELECT CASE(TRIM(cAlphaArgs(7)))
CASE('DESIGNDAY')
SysSizInput(SysSizIndex)%HeatAirDesMethod = FromDDCalc
CASE('FLOW/SYSTEM')
SysSizInput(SysSizIndex)%HeatAirDesMethod = InpDesAirFlow
CASE DEFAULT
CALL ShowSevereError(TRIM(cCurrentModuleObject)//'="'//trim(cAlphaArgs(1))//'", invalid data.')
CALL ShowContinueError('... incorrect '//TRIM(cAlphaFieldNames(7))//'="'//TRIM(cAlphaArgs(7))//'".')
CALL ShowContinueError('... valid values are DesignDay or Flow/System.')
ErrorsFound=.true.
END SELECT
SELECT CASE(TRIM(cAlphaArgs(8)))
CASE('ZONESUM')
SysSizInput(SysSizIndex)%SystemOAMethod = SOAM_ZoneSum
CASE('VENTILATIONRATEPROCEDURE')
SysSizInput(SysSizIndex)%SystemOAMethod = SOAM_VRP
IF(SysSizInput(SysSizIndex)%DesOutAirVolFlow > 0) THEN
CALL ShowSevereError(TRIM(cCurrentModuleObject)//'="'//trim(cAlphaArgs(1))//'", invalid data.')
CALL ShowContinueError('SystemOAMethod is set to VRP and '//TRIM(cNumericFieldNames(1))//' > 0, '// &
' user entry will be ignored.')
END IF
CASE DEFAULT
CALL ShowSevereError(TRIM(cCurrentModuleObject)//'="'//trim(cAlphaArgs(1))//'", invalid data.')
CALL ShowContinueError('... incorrect '//TRIM(cAlphaFieldNames(8))//'="'//TRIM(cAlphaArgs(8))//'".')
CALL ShowContinueError('... valid values are ZoneSum or VentilationRateProcedure.')
ErrorsFound=.true.
END SELECT
END DO
IF (ErrorsFound) THEN
CALL ShowFatalError(TRIM(cCurrentModuleObject)//': Errors found in getting input. Program terminates.')
END IF
RETURN
END SUBROUTINE GetSystemSizingInput