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 GetExteriorEnergyUseInput
! SUBROUTINE INFORMATION:
! AUTHOR Linda Lawrie
! DATE WRITTEN January 2001
! MODIFIED na
! RE-ENGINEERED na
! PURPOSE OF THIS SUBROUTINE:
! This subroutine gets the input for the Exterior Lights and Equipment.
! METHODOLOGY EMPLOYED:
! na
! REFERENCES:
! na
! USE STATEMENTS:
USE DataIPShortCuts
USE InputProcessor, ONLY: GetNumObjectsFound, GetObjectItem, VerifyName, SameString
USE ScheduleManager, ONLY: GetScheduleIndex, GetScheduleMinValue, GetScheduleMaxValue, GetScheduleName
USE General, ONLY: RoundSigDigits
USE OutputReportPredefined
USE DataGlobals, ONLY: AnyEnergyManagementSystemInModel
USE DataInterfaces, ONLY: SetupEMSActuator
IMPLICIT NONE ! Enforce explicit typing of all variables in this routine
! SUBROUTINE ARGUMENT DEFINITIONS:
! na
! SUBROUTINE PARAMETER DEFINITIONS:
CHARACTER(len=*), PARAMETER :: RoutineName='GetExteriorEnergyUseInput: '
CHARACTER(len=*), PARAMETER :: Blank=' '
! INTERFACE BLOCK SPECIFICATIONS:
! na
! DERIVED TYPE DEFINITIONS:
! na
! SUBROUTINE LOCAL VARIABLE DECLARATIONS:
INTEGER :: Item ! Item to be "gotten"
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
INTEGER :: NumFuelEq ! Temporary -- number of ExteriorFuelEquipment statements
INTEGER :: NumWtrEq ! Temporary -- number of ExteriorWaterEquipment statements
CHARACTER(len=20) :: TypeString ! Fuel Type string (returned from Validation)
CHARACTER(len=4) :: ConUnits ! String for Fuel Consumption units (allow Water)
CHARACTER(len=MaxNameLength) :: EndUseSubcategoryName
LOGICAL :: ErrorInName
LOGICAL :: IsBlank
REAL(r64) :: SchMax ! Max value of schedule for item
REAL(r64) :: SchMin ! Min value of schedule for item
REAL(r64) :: sumDesignLevel = 0.0d0 !for predefined report of design level total
NumExteriorLights=GetNumObjectsFound('Exterior:Lights')
ALLOCATE(ExteriorLights(NumExteriorLights))
NumFuelEq=GetNumObjectsFound('Exterior:FuelEquipment')
NumWtrEq=GetNumObjectsFound('Exterior:WaterEquipment')
ALLOCATE(ExteriorEquipment(NumFuelEq+NumWtrEq))
NumExteriorEqs=0
! ================================= Get Exterior Lights
cCurrentModuleObject='Exterior:Lights'
DO Item=1,NumExteriorLights
CALL GetObjectItem(cCurrentModuleObject,Item,cAlphaArgs,NumAlphas,rNumericArgs,NumNumbers,IOStatus, &
AlphaBlank=lAlphaFieldBlanks,NumBlank=lNumericFieldBlanks, &
AlphaFieldnames=cAlphaFieldNames,NumericFieldNames=cNumericFieldNames)
ErrorInName=.false.
IsBlank=.false.
CALL VerifyName(cAlphaArgs(1),ExteriorLights%Name,Item,ErrorInName,IsBlank,TRIM(cCurrentModuleObject)//' Name')
IF (ErrorInName) THEN
ErrorsFound=.true.
CYCLE
ENDIF
ExteriorLights(Item)%Name=cAlphaArgs(1)
ExteriorLights(Item)%SchedPtr = GetScheduleIndex(cAlphaArgs(2))
IF (ExteriorLights(Item)%SchedPtr == 0) THEN
IF (lAlphaFieldBlanks(2)) THEN
CALL ShowSevereError(RoutineName//TRIM(cCurrentModuleObject)//': '//TRIM(cAlphaFieldNames(2))// &
' is required, missing for '//TRIM(cAlphaFieldNames(1))//'='//TRIM(cAlphaArgs(1)))
ELSE
CALL ShowSevereError(RoutineName//TRIM(cCurrentModuleObject)//': invalid '//TRIM(cAlphaFieldNames(2))// &
' entered='//TRIM(cAlphaArgs(2))// &
' for '//TRIM(cAlphaFieldNames(1))//'='//TRIM(cAlphaArgs(1)))
ENDIF
ErrorsFound=.true.
ELSE ! check min/max on schedule
SchMin=GetScheduleMinValue(ExteriorLights(Item)%SchedPtr)
SchMax=GetScheduleMaxValue(ExteriorLights(Item)%SchedPtr)
IF (SchMin < 0.0d0 .or. SchMax < 0.0d0) THEN
IF (SchMin < 0.0d0) THEN
CALL ShowSevereError(RoutineName//TRIM(cCurrentModuleObject)//': invalid '//TRIM(cAlphaFieldNames(2))// &
' minimum, is < 0.0 for '//TRIM(cAlphaFieldNames(1))//'='//TRIM(cAlphaArgs(1)))
CALL ShowContinueError(TRIM(cAlphaArgs(2))// &
'". Minimum is ['//TRIM(RoundSigDigits(SchMin,1))//']. Values must be >= 0.0.')
ErrorsFound=.true.
ENDIF
IF (SchMax < 0.0d0) THEN
CALL ShowSevereError(RoutineName//TRIM(cCurrentModuleObject)//': invalid '//TRIM(cAlphaFieldNames(2))// &
' maximum, is < 0.0 for '//TRIM(cAlphaFieldNames(1))//'='//TRIM(cAlphaArgs(1)))
CALL ShowContinueError(TRIM(cAlphaArgs(2))// &
'". Maximum is ['//TRIM(RoundSigDigits(SchMax,1))//']. Values must be >= 0.0.')
ErrorsFound=.true.
ENDIF
ENDIF
ENDIF
IF (lAlphaFieldBlanks(3)) THEN
ExteriorLights(Item)%ControlMode = ScheduleOnly
ELSEIF (SameString(cAlphaArgs(3), 'ScheduleNameOnly')) THEN
ExteriorLights(Item)%ControlMode = ScheduleOnly
ELSEIF (SameString(cAlphaArgs(3), 'AstronomicalClock')) then
ExteriorLights(Item)%ControlMode = AstroClockOverride
ELSE
CALL ShowSevereError(RoutineName//TRIM(cCurrentModuleObject)//': invalid '//TRIM(cAlphaFieldNames(3))// &
'='//TRIM(cAlphaArgs(3))// &
' for '//TRIM(cAlphaFieldNames(1))//'='//TRIM(cAlphaArgs(1)))
ENDIF
IF (NumAlphas > 3) THEN
EndUseSubcategoryName = cAlphaArgs(4)
ELSE
EndUseSubcategoryName = 'General'
END IF
ExteriorLights(Item)%DesignLevel=rNumericArgs(1)
IF (AnyEnergyManagementSystemInModel) THEN
CALL SetupEMSActuator('ExteriorLights', ExteriorLights(Item)%Name, 'Electric Power', 'W', &
ExteriorLights(Item)%PowerActuatorOn, ExteriorLights(Item)%PowerActuatorValue)
ENDIF
CALL SetupOutputVariable('Exterior Lights Electric Power [W]',ExteriorLights(Item)%Power, &
'Zone','Average',ExteriorLights(Item)%Name)
CALL SetupOutputVariable('Exterior Lights Electric Energy [J]',ExteriorLights(Item)%CurrentUse, &
'Zone','Sum',ExteriorLights(Item)%Name, &
ResourceTypeKey='Electricity',EndUseKey='Exterior Lights',EndUseSubKey=EndUseSubcategoryName)
! entries for predefined tables
CALL PreDefTableEntry(pdchExLtPower,ExteriorLights(Item)%Name,ExteriorLights(Item)%DesignLevel)
sumDesignLevel = sumDesignLevel + ExteriorLights(Item)%DesignLevel
IF (ExteriorLights(Item)%ControlMode .EQ. AstroClockOverride) THEN !photocell/schedule
CALL PreDefTableEntry(pdchExLtClock,ExteriorLights(Item)%Name,'AstronomicalClock')
CALL PreDefTableEntry(pdchExLtSchd,ExteriorLights(Item)%Name,'-')
ELSE
CALL PreDefTableEntry(pdchExLtClock,ExteriorLights(Item)%Name,'Schedule')
CALL PreDefTableEntry(pdchExLtSchd,ExteriorLights(Item)%Name,GetScheduleName(ExteriorLights(Item)%SchedPtr))
END IF
ENDDO
CALL PreDefTableEntry(pdchExLtPower,'Exterior Lighting Total',sumDesignLevel)
! ================================= Get Exterior Fuel Equipment
cCurrentModuleObject='Exterior:FuelEquipment'
DO Item=1,NumFuelEq
CALL GetObjectItem(cCurrentModuleObject,Item,cAlphaArgs,NumAlphas,rNumericArgs,NumNumbers,IOStatus, &
AlphaBlank=lAlphaFieldBlanks,NumBlank=lNumericFieldBlanks, &
AlphaFieldnames=cAlphaFieldNames,NumericFieldNames=cNumericFieldNames)
ErrorInName=.false.
IsBlank=.false.
CALL VerifyName(cAlphaArgs(1),ExteriorEquipment%Name,Item,ErrorInName,IsBlank,TRIM(cCurrentModuleObject)//' Name')
IF (ErrorInName) THEN
ErrorsFound=.true.
CYCLE
ENDIF
NumExteriorEqs=NumExteriorEqs+1
ExteriorEquipment(NumExteriorEqs)%Name=cAlphaArgs(1)
IF (NumAlphas > 3) THEN
EndUseSubcategoryName = cAlphaArgs(4)
ELSE
EndUseSubcategoryName = 'General'
END IF
CALL ValidateFuelType(ExteriorEquipment(NumExteriorEqs)%FuelType,cAlphaArgs(2),TypeString,cCurrentModuleObject, &
cAlphaFieldNames(2),cAlphaArgs(2))
IF (ExteriorEquipment(NumExteriorEqs)%FuelType == 0) THEN
IF (lAlphaFieldBlanks(2)) THEN
CALL ShowSevereError(RoutineName//TRIM(cCurrentModuleObject)//': '//TRIM(cAlphaFieldNames(2))// &
' is required, missing for '//TRIM(cAlphaFieldNames(1))//'='//TRIM(cAlphaArgs(1)))
ELSE
CALL ShowSevereError(RoutineName//TRIM(cCurrentModuleObject)//': invalid '//TRIM(cAlphaFieldNames(2))// &
' entered='//TRIM(cAlphaArgs(2))// &
' for '//TRIM(cAlphaFieldNames(1))//'='//TRIM(cAlphaArgs(1)))
ENDIF
ErrorsFound=.true.
ELSE
IF (ExteriorEquipment(NumExteriorEqs)%FuelType /= WaterUse) THEN
CALL SetupOutputVariable('Exterior Equipment Fuel Rate [W]',ExteriorEquipment(NumExteriorEqs)%Power, &
'Zone','Average',ExteriorEquipment(NumExteriorEqs)%Name)
ConUnits='[J]'
CALL SetupOutputVariable('Exterior Equipment '//TRIM(TypeString)//' Energy '//TRIM(ConUnits), &
ExteriorEquipment(NumExteriorEqs)%CurrentUse, &
'Zone','Sum',ExteriorEquipment(NumExteriorEqs)%Name, &
ResourceTypeKey=TypeString,EndUseKey='ExteriorEquipment',EndUseSubKey=EndUseSubcategoryName)
ELSE
CALL SetupOutputVariable('Exterior Equipment Water Volume Flow Rate [m3/s]',ExteriorEquipment(NumExteriorEqs)%Power, &
'Zone','Average',TRIM(ExteriorEquipment(NumExteriorEqs)%Name))
ConUnits='[m3]'
CALL SetupOutputVariable('Exterior Equipment '//TRIM(TypeString)//' Volume '//TRIM(ConUnits), &
ExteriorEquipment(NumExteriorEqs)%CurrentUse, &
'Zone','Sum',ExteriorEquipment(NumExteriorEqs)%Name, &
ResourceTypeKey=TypeString,EndUseKey='ExteriorEquipment',EndUseSubKey=EndUseSubcategoryName)
ENDIF
ENDIF
ExteriorEquipment(NumExteriorEqs)%SchedPtr = GetScheduleIndex(cAlphaArgs(3))
IF (ExteriorEquipment(NumExteriorEqs)%SchedPtr == 0) THEN
IF (lAlphaFieldBlanks(3)) THEN
CALL ShowSevereError(RoutineName//TRIM(cCurrentModuleObject)//': '//TRIM(cAlphaFieldNames(3))// &
' is required, missing for '//TRIM(cAlphaFieldNames(1))//'='//TRIM(cAlphaArgs(1)))
ELSE
CALL ShowSevereError(RoutineName//TRIM(cCurrentModuleObject)//': invalid '//TRIM(cAlphaFieldNames(3))// &
' entered='//TRIM(cAlphaArgs(3))// &
' for '//TRIM(cAlphaFieldNames(1))//'='//TRIM(cAlphaArgs(1)))
ENDIF
ErrorsFound=.true.
ELSE ! check min/max on schedule
SchMin=GetScheduleMinValue(ExteriorEquipment(NumExteriorEqs)%SchedPtr)
SchMax=GetScheduleMaxValue(ExteriorEquipment(NumExteriorEqs)%SchedPtr)
IF (SchMin < 0.0d0 .or. SchMax < 0.0d0) THEN
IF (SchMin < 0.0d0) THEN
CALL ShowSevereError(RoutineName//TRIM(cCurrentModuleObject)//': invalid '//TRIM(cAlphaFieldNames(3))// &
' minimum, is < 0.0 for '//TRIM(cAlphaFieldNames(1))//'='//TRIM(cAlphaArgs(1)))
CALL ShowContinueError(TRIM(cAlphaArgs(3))// &
'". Minimum is ['//TRIM(RoundSigDigits(SchMin,1))//']. Values must be >= 0.0.')
ErrorsFound=.true.
ENDIF
IF (SchMax < 0.0d0) THEN
CALL ShowSevereError(RoutineName//TRIM(cCurrentModuleObject)//': invalid '//TRIM(cAlphaFieldNames(3))// &
' maximum, is < 0.0 for '//TRIM(cAlphaFieldNames(1))//'='//TRIM(cAlphaArgs(1)))
CALL ShowContinueError(TRIM(cAlphaArgs(3))// &
'". Maximum is ['//TRIM(RoundSigDigits(SchMax,1))//']. Values must be >= 0.0.')
ErrorsFound=.true.
ENDIF
ENDIF
ENDIF
ExteriorEquipment(NumExteriorEqs)%DesignLevel=rNumericArgs(1)
ENDDO
! ================================= Get Exterior Water Equipment
cCurrentModuleObject='Exterior:WaterEquipment'
DO Item=1,NumWtrEq
CALL GetObjectItem(cCurrentModuleObject,Item,cAlphaArgs,NumAlphas,rNumericArgs,NumNumbers,IOStatus, &
AlphaBlank=lAlphaFieldBlanks,NumBlank=lNumericFieldBlanks, &
AlphaFieldnames=cAlphaFieldNames,NumericFieldNames=cNumericFieldNames)
ErrorInName=.false.
IsBlank=.false.
CALL VerifyName(cAlphaArgs(1),ExteriorEquipment%Name,Item,ErrorInName,IsBlank,TRIM(cCurrentModuleObject)//' Name')
IF (ErrorInName) THEN
ErrorsFound=.true.
CYCLE
ENDIF
NumExteriorEqs=NumExteriorEqs+1
ExteriorEquipment(NumExteriorEqs)%Name=cAlphaArgs(1)
ExteriorEquipment(NumExteriorEqs)%FuelType=WaterUse
ExteriorEquipment(NumExteriorEqs)%SchedPtr = GetScheduleIndex(cAlphaArgs(3))
IF (ExteriorEquipment(NumExteriorEqs)%SchedPtr == 0) THEN
IF (lAlphaFieldBlanks(3)) THEN
CALL ShowSevereError(RoutineName//TRIM(cCurrentModuleObject)//': '//TRIM(cAlphaFieldNames(3))// &
' is required, missing for '//TRIM(cAlphaFieldNames(1))//'='//TRIM(cAlphaArgs(1)))
ELSE
CALL ShowSevereError(RoutineName//TRIM(cCurrentModuleObject)//': invalid '//TRIM(cAlphaFieldNames(3))// &
' entered='//TRIM(cAlphaArgs(3))// &
' for '//TRIM(cAlphaFieldNames(1))//'='//TRIM(cAlphaArgs(1)))
ENDIF
ErrorsFound=.true.
ELSE ! check min/max on schedule
SchMin=GetScheduleMinValue(ExteriorEquipment(NumExteriorEqs)%SchedPtr)
SchMax=GetScheduleMaxValue(ExteriorEquipment(NumExteriorEqs)%SchedPtr)
IF (SchMin < 0.0d0 .or. SchMax < 0.0d0) THEN
IF (SchMin < 0.0d0) THEN
CALL ShowSevereError(RoutineName//TRIM(cCurrentModuleObject)//': invalid '//TRIM(cAlphaFieldNames(3))// &
' minimum, is < 0.0 for '//TRIM(cAlphaFieldNames(1))//'='//TRIM(cAlphaArgs(1)))
CALL ShowContinueError(TRIM(cAlphaArgs(3))// &
'". Minimum is ['//TRIM(RoundSigDigits(SchMin,1))//']. Values must be >= 0.0.')
ErrorsFound=.true.
ENDIF
IF (SchMax < 0.0d0) THEN
CALL ShowSevereError(RoutineName//TRIM(cCurrentModuleObject)//': invalid '//TRIM(cAlphaFieldNames(3))// &
' maximum, is < 0.0 for '//TRIM(cAlphaFieldNames(1))//'='//TRIM(cAlphaArgs(1)))
CALL ShowContinueError(TRIM(cAlphaArgs(3))// &
'". Maximum is ['//TRIM(RoundSigDigits(SchMax,1))//']. Values must be >= 0.0.')
ErrorsFound=.true.
ENDIF
ENDIF
ENDIF
IF (NumAlphas > 3) THEN
EndUseSubcategoryName = cAlphaArgs(4)
ELSE
EndUseSubcategoryName = 'General'
END IF
ExteriorEquipment(NumExteriorEqs)%DesignLevel=rNumericArgs(1)
CALL SetupOutputVariable('Exterior Equipment Water Volume Flow Rate [m3/s]',ExteriorEquipment(NumExteriorEqs)%Power, &
'Zone','Average',ExteriorEquipment(NumExteriorEqs)%Name)
CALL SetupOutputVariable('Exterior Equipment Water Volume [m3]', &
ExteriorEquipment(NumExteriorEqs)%CurrentUse, &
'Zone','Sum',ExteriorEquipment(NumExteriorEqs)%Name, &
ResourceTypeKey='Water',EndUseKey='ExteriorEquipment',EndUseSubKey=EndUseSubcategoryName)
CALL SetupOutputVariable('Exterior Equipment Mains Water Volume [m3]', &
ExteriorEquipment(NumExteriorEqs)%CurrentUse, &
'Zone','Sum',ExteriorEquipment(NumExteriorEqs)%Name, &
ResourceTypeKey='MainsWater',EndUseKey='ExteriorEquipment',EndUseSubKey=EndUseSubcategoryName)
ENDDO
IF (ErrorsFound) THEN
CALL ShowFatalError(RoutineName//'Errors found in input. Program terminates.')
ENDIF
RETURN
END SUBROUTINE GetExteriorEnergyUseInput