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 GetBoilerInput
! SUBROUTINE INFORMATION:
! AUTHOR: Dan Fisher
! DATE WRITTEN: April 1998
! MODIFIED: R. Raustad - FSEC, June 2008: added boiler efficiency curve object
! RE-ENGINEERED: na
! PURPOSE OF THIS SUBROUTINE:
! get all boiler data from input file
! METHODOLOGY EMPLOYED:
! standard EnergyPlus input retrieval using input Processor
! REFERENCES: na
! USE STATEMENTS:
USE DataGlobals, ONLY: MaxNameLength, AnyEnergyManagementSystemInModel
USE DataGlobalConstants
USE InputProcessor, ONLY: GetNumObjectsFound, GetObjectItem, VerifyName, SameString
USE DataIPShortCuts ! Data for field names, blank numerics
USE BranchNodeConnections, ONLY: TestCompSet
USE NodeInputManager, ONLY: GetOnlySingleNode
USE GlobalNames, ONLY: VerifyUniqueBoilerName
USE CurveManager, ONLY: GetCurveIndex, GetCurveType
USE General, ONLY: RoundSigDigits
IMPLICIT NONE ! Enforce explicit typing of all variables in this routine
! PARAMETERS
CHARACTER(len=*), PARAMETER :: RoutineName='GetBoilerInput: '
!LOCAL VARIABLES
INTEGER :: BoilerNum ! boiler identifier
INTEGER :: NumAlphas ! Number of elements in the alpha array
INTEGER :: NumNums ! Number of elements in the numeric array
INTEGER :: IOStat ! IO Status when calling get input subroutine
LOGICAL, SAVE :: ErrorsFound = .FALSE. ! Flag to show errors were found during GetInput
LOGICAL :: IsNotOK ! Flag to verify name
LOGICAL :: IsBlank ! Flag for blank name
LOGICAL :: errflag ! Flag to show errors were found during function call
CHARACTER(len=MaxNameLength),ALLOCATABLE, DIMENSION(:) :: BoilerFuelTypeForOutputVariable ! used to set up report variables
!GET NUMBER OF ALL EQUIPMENT
cCurrentModuleObject = 'Boiler:HotWater'
NumBoilers = GetNumObjectsFound(cCurrentModuleObject)
IF (NumBoilers<=0) THEN
CALL ShowSevereError('No '//TRIM(cCurrentModuleObject)//' Equipment specified in input file')
ErrorsFound=.TRUE.
END IF
!See if load distribution manager has already gotten the input
IF (ALLOCATED(Boiler))RETURN
ALLOCATE (Boiler(NumBoilers))
ALLOCATE (BoilerReport(NumBoilers))
ALLOCATE (CheckEquipName(NumBoilers))
ALLOCATE (BoilerFuelTypeForOutputVariable(NumBoilers))
CheckEquipName=.true.
BoilerFuelTypeForOutputVariable=' '
!LOAD ARRAYS WITH CURVE FIT Boiler DATA
DO BoilerNum = 1 , NumBoilers
CALL GetObjectItem(cCurrentModuleObject, BoilerNum, cAlphaArgs, NumAlphas, rNumericArgs, NumNums, IOSTAT, &
NumBlank=lNumericFieldBlanks,AlphaBlank=lAlphaFieldBlanks, &
AlphaFieldnames=cAlphaFieldNames,NumericFieldNames=cNumericFieldNames)
IsNotOK = .FALSE.
IsBlank = .FALSE.
CALL VerifyName(cAlphaArgs(1),Boiler%Name,BoilerNum-1,IsNotOK,IsBlank,TRIM(cCurrentModuleObject)//' Name')
IF (IsNotOK) THEN
ErrorsFound=.TRUE.
IF (IsBlank) cAlphaArgs(1)='xxxxx'
ENDIF
CALL VerifyUniqueBoilerName(TRIM(cCurrentModuleObject),cAlphaArgs(1),errflag,TRIM(cCurrentModuleObject)//' Name')
IF (errflag) THEN
ErrorsFound=.TRUE.
ENDIF
Boiler(BoilerNum)%Name = cAlphaArgs(1)
Boiler(BoilerNum)%TypeNum = TypeOf_Boiler_Simple
SELECT CASE (cAlphaArgs(2))
CASE ('ELECTRICITY','ELECTRIC','ELEC')
BoilerFuelTypeForOutputVariable(BoilerNum) = 'Electric'
Boiler(BoilerNum)%FuelType=AssignResourceTypeNum('ELECTRICITY')
CASE ('GAS','NATURALGAS','NATURAL GAS')
BoilerFuelTypeForOutputVariable(BoilerNum) = 'Gas'
Boiler(BoilerNum)%FuelType=AssignResourceTypeNum('NATURALGAS')
CASE ('DIESEL')
BoilerFuelTypeForOutputVariable(BoilerNum) = 'Diesel'
Boiler(BoilerNum)%FuelType=AssignResourceTypeNum('DIESEL')
CASE ('GASOLINE')
BoilerFuelTypeForOutputVariable(BoilerNum) = 'Gasoline'
Boiler(BoilerNum)%FuelType=AssignResourceTypeNum('GASOLINE')
CASE ('COAL')
BoilerFuelTypeForOutputVariable(BoilerNum) = 'Coal'
Boiler(BoilerNum)%FuelType=AssignResourceTypeNum('COAL')
CASE ('FUEL OIL #1','FUELOIL#1','FUEL OIL','DISTILLATE OIL')
BoilerFuelTypeForOutputVariable(BoilerNum) = 'FuelOil#1'
Boiler(BoilerNum)%FuelType=AssignResourceTypeNum('DISTILLATE OIL')
CASE ('FUEL OIL #2','FUELOIL#2','RESIDUAL OIL')
BoilerFuelTypeForOutputVariable(BoilerNum) = 'FuelOil#2'
Boiler(BoilerNum)%FuelType=AssignResourceTypeNum('RESIDUAL OIL')
CASE ('PROPANE','LPG','PROPANEGAS','PROPANE GAS')
BoilerFuelTypeForOutputVariable(BoilerNum) = 'Propane'
Boiler(BoilerNum)%FuelType=AssignResourceTypeNum('PROPANE')
CASE ('OTHERFUEL1')
BoilerFuelTypeForOutputVariable(BoilerNum) = 'OtherFuel1'
Boiler(BoilerNum)%FuelType=AssignResourceTypeNum('OTHERFUEL1')
CASE ('OTHERFUEL2')
BoilerFuelTypeForOutputVariable(BoilerNum) = 'OtherFuel2'
Boiler(BoilerNum)%FuelType=AssignResourceTypeNum('OTHERFUEL2')
CASE DEFAULT
CALL ShowSevereError(RoutineName//TRIM(cCurrentModuleObject)//'="'//TRIM(cAlphaArgs(1))//'",')
CALL ShowContinueError('Invalid '//TRIM(cAlphaFieldNames(2))//'='//TRIM(cAlphaArgs(2)))
! Set to Electric to avoid errors when setting up output variables
BoilerFuelTypeForOutputVariable(BoilerNum) = 'Electric'
Boiler(BoilerNum)%FuelType=AssignResourceTypeNum('ELECTRICITY')
ErrorsFound=.TRUE.
END SELECT
Boiler(BoilerNum)%NomCap = rNumericArgs(1)
IF (rNumericArgs(1) == 0.0d0) THEN
CALL ShowSevereError(RoutineName//TRIM(cCurrentModuleObject)//'="'//TRIM(cAlphaArgs(1))//'",')
CALL ShowContinueError('Invalid '//TRIM(cNumericFieldNames(1))//'='//TRIM(RoundSigDigits(rNumericArgs(1),2)) )
CALL ShowContinueError('...'//TRIM(cNumericFieldNames(1))//' must be greater than 0.0')
ErrorsFound=.TRUE.
ENDIF
Boiler(BoilerNum)%Effic = rNumericArgs(2)
IF (rNumericArgs(2) == 0.0d0) THEN
CALL ShowSevereError(RoutineName//TRIM(cCurrentModuleObject)//'="'//TRIM(cAlphaArgs(1))//'",')
CALL ShowContinueError('Invalid '//TRIM(cNumericFieldNames(2))//'='//TRIM(RoundSigDigits(rNumericArgs(2),3)) )
CALL ShowSevereError('...'//TRIM(cNumericFieldNames(2))//' must be greater than 0.0')
ErrorsFound=.TRUE.
ENDIF
SELECT CASE (cAlphaArgs(3))
CASE ('ENTERINGBOILER')
Boiler(BoilerNum)%CurveTempMode = EnteringBoilerTemp
CASE ('LEAVINGBOILER')
Boiler(BoilerNum)%CurveTempMode = LeavingBoilerTemp
CASE DEFAULT
Boiler(BoilerNum)%CurveTempMode = BoilerTempModeNotSet
END SELECT
Boiler(BoilerNum)%EfficiencyCurvePtr = GetCurveIndex(cAlphaArgs(4))
IF(Boiler(BoilerNum)%EfficiencyCurvePtr .GT. 0)THEN
SELECT CASE(GetCurveType(Boiler(BoilerNum)%EfficiencyCurvePtr))
CASE('LINEAR')
Boiler(BoilerNum)%EfficiencyCurveType = Linear
CASE('QUADRATIC')
Boiler(BoilerNum)%EfficiencyCurveType = Quadratic
CASE('QUADRATICLINEAR')
Boiler(BoilerNum)%EfficiencyCurveType = QuadraticLinear
CASE('CUBIC')
Boiler(BoilerNum)%EfficiencyCurveType = Cubic
CASE('BICUBIC')
Boiler(BoilerNum)%EfficiencyCurveType = Bicubic
CASE('BIQUADRATIC')
Boiler(BoilerNum)%EfficiencyCurveType = Biquadratic
CASE DEFAULT
CALL ShowSevereError(RoutineName//TRIM(cCurrentModuleObject)//'="'//TRIM(cAlphaArgs(1))//'",')
CALL ShowContinueError('Invalid '//TRIM(cAlphaFieldNames(4))//'='//TRIM(cAlphaArgs(4)))
CALL ShowContinueError('...Curve type for '//TRIM(cAlphaFieldNames(4))//' = '// &
TRIM(GetCurveType(Boiler(BoilerNum)%EfficiencyCurvePtr)))
ErrorsFound=.TRUE.
END SELECT
ELSE IF(.NOT. lAlphaFieldBlanks(4))THEN
CALL ShowSevereError(RoutineName//TRIM(cCurrentModuleObject)//'="'//TRIM(cAlphaArgs(1))//'",')
CALL ShowContinueError('Invalid '//TRIM(cAlphaFieldNames(4))//'='//TRIM(cAlphaArgs(4)) )
CALL ShowSevereError('...'//TRIM(cAlphaFieldNames(4))//' not found.')
ErrorsFound=.TRUE.
ENDIF
!if curve uses temperature, make sure water temp mode has been set
SELECT CASE (Boiler(BoilerNum)%EfficiencyCurveType)
CASE (Biquadratic, QuadraticLinear, Bicubic) !curve uses water temperature
IF (Boiler(BoilerNum)%CurveTempMode == BoilerTempModeNotSet) THEN ! throw error
IF (.NOT. lAlphaFieldBlanks(3)) THEN
CALL ShowSevereError(RoutineName//TRIM(cCurrentModuleObject)//'="'//TRIM(cAlphaArgs(1))//'",')
CALL ShowContinueError('Invalid '//TRIM(cAlphaFieldNames(3))//'='//TRIM(cAlphaArgs(3)))
CALL ShowContinueError('Boiler using curve type of '// &
TRIM(GetCurveType(Boiler(BoilerNum)%EfficiencyCurvePtr)) // &
' must specify '//TRIM(cAlphaFieldNames(3)) )
CALL ShowContinueError('Available choices are EnteringBoiler or LeavingBoiler')
ELSE
CALL ShowSevereError(RoutineName//TRIM(cCurrentModuleObject)//'="'//TRIM(cAlphaArgs(1))//'",')
CALL ShowContinueError('Field '//TRIM(cAlphaFieldNames(3))//' is blank')
CALL ShowContinueError('Boiler using curve type of '// &
TRIM(GetCurveType(Boiler(BoilerNum)%EfficiencyCurvePtr)) // &
' must specify either EnteringBoiler or LeavingBoiler')
ENDIF
ErrorsFound=.TRUE.
ENDIF
END SELECT
Boiler(BoilerNum)%TempDesBoilerOut = rNumericArgs(3)
Boiler(BoilerNum)%VolFlowRate = rNumericArgs(4)
Boiler(BoilerNum)%MinPartLoadRat = rNumericArgs(5)
Boiler(BoilerNum)%MaxPartLoadRat = rNumericArgs(6)
Boiler(BoilerNum)%OptPartLoadRat = rNumericArgs(7)
Boiler(BoilerNum)%TempUpLimitBoilerOut = rNumericArgs(8)
! default to 99.9C if upper temperature limit is left blank.
IF(Boiler(BoilerNum)%TempUpLimitBoilerOut .LE. 0.0d0)THEN
Boiler(BoilerNum)%TempUpLimitBoilerOut = 99.9d0
END IF
Boiler(BoilerNum)%ParasiticElecLoad = rNumericArgs(9)
Boiler(BoilerNum)%SizFac = rNumericArgs(10)
IF (Boiler(BoilerNum)%SizFac == 0.0d0) Boiler(BoilerNum)%SizFac = 1.0d0
Boiler(BoilerNum)%BoilerInletNodeNum = &
GetOnlySingleNode(cAlphaArgs(5),ErrorsFound,TRIM(cCurrentModuleObject),cAlphaArgs(1),NodeType_Water, &
NodeConnectionType_Inlet, 1, ObjectIsNotParent)
Boiler(BoilerNum)%BoilerOutletNodeNum = &
GetOnlySingleNode(cAlphaArgs(6),ErrorsFound,TRIM(cCurrentModuleObject),cAlphaArgs(1),NodeType_Water, &
NodeConnectionType_Outlet, 1, ObjectIsNotParent)
CALL TestCompSet(TRIM(cCurrentModuleObject),cAlphaArgs(1),cAlphaArgs(5),cAlphaArgs(6),'Hot Water Nodes')
SELECT CASE (TRIM(cAlphaArgs(7)))
CASE ('CONSTANTFLOW')
Boiler(BoilerNum)%FlowMode = ConstantFlow
CASE ('VARIABLEFLOW') ! backward compatible, clean out eventually
Boiler(BoilerNum)%FlowMode = LeavingSetpointModulated
CALL ShowWarningError(RoutineName//TRIM(cCurrentModuleObject)//'="'//TRIM(cAlphaArgs(1))//'",')
CALL ShowContinueError('Invalid '//TRIM(cAlphaFieldNames(7))//'='//TRIM(cAlphaArgs(7)))
CALL ShowContinueError('Key choice is now called "LeavingSetpointModulated" and the simulation continues')
CASE ('LEAVINGSETPOINTMODULATED')
Boiler(BoilerNum)%FlowMode = LeavingSetpointModulated
CASE ('NOTMODULATED')
Boiler(BoilerNum)%FlowMode = NotModulated
CASE DEFAULT
CALL ShowSevereError(RoutineName//TRIM(cCurrentModuleObject)//'="'//TRIM(cAlphaArgs(1))//'",')
CALL ShowContinueError('Invalid '//TRIM(cAlphaFieldNames(7))//'='//TRIM(cAlphaArgs(7)))
CALL ShowContinueError('Available choices are ConstantFlow, NotModulated, or LeavingSetpointModulated')
CALL ShowContinueError('Flow mode NotModulated is assumed and the simulation continues.')
! We will assume variable flow if not specified
Boiler(BoilerNum)%FlowMode = NotModulated
END SELECT
END DO
IF (ErrorsFound) THEN
CALL ShowFatalError(RoutineName//'Errors found in processing '//TRIM(cCurrentModuleObject)//' input.')
ENDIF
DO BoilerNum = 1, NumBoilers
CALL SetupOutputVariable('Boiler Heating Rate [W]', &
BoilerReport(BoilerNum)%BoilerLoad,'System','Average',Boiler(BoilerNum)%Name)
CALL SetupOutputVariable('Boiler Heating Energy [J]', &
BoilerReport(BoilerNum)%BoilerEnergy,'System','Sum',Boiler(BoilerNum)%Name, &
ResourceTypeKey='ENERGYTRANSFER',EndUseKey='BOILERS',GroupKey='Plant')
IF (SameString(BoilerFuelTypeForOutputVariable(BoilerNum), 'Electric')) THEN
CALL SetupOutputVariable('Boiler ' // TRIM(BoilerFuelTypeForOutputVariable(BoilerNum)) //' Power [W]', &
BoilerReport(BoilerNum)%FuelUsed,'System','Average',Boiler(BoilerNum)%Name)
ELSE
CALL SetupOutputVariable('Boiler ' // TRIM(BoilerFuelTypeForOutputVariable(BoilerNum)) //' Rate [W]', &
BoilerReport(BoilerNum)%FuelUsed,'System','Average',Boiler(BoilerNum)%Name)
ENDIF
CALL SetupOutputVariable('Boiler ' // TRIM(BoilerFuelTypeForOutputVariable(BoilerNum)) //' Energy [J]', &
BoilerReport(BoilerNum)%FuelConsumed,'System','Sum',Boiler(BoilerNum)%Name, &
ResourceTypeKey=TRIM(BoilerFuelTypeForOutputVariable(BoilerNum)),EndUseKey='Heating', &
EndUseSubKey='Boiler', GroupKey='Plant')
CALL SetupOutputVariable('Boiler Inlet Temperature [C]', &
BoilerReport(BoilerNum)%BoilerInletTemp,'System','Average',Boiler(BoilerNum)%Name)
CALL SetupOutputVariable('Boiler Outlet Temperature [C]', &
BoilerReport(BoilerNum)%BoilerOutletTemp,'System','Average',Boiler(BoilerNum)%Name)
CALL SetupOutputVariable('Boiler Mass Flow Rate [kg/s]', &
BoilerReport(BoilerNum)%Mdot,'System','Average',Boiler(BoilerNum)%Name)
CALL SetupOutputVariable('Boiler Ancillary Electric Power [W]', &
BoilerReport(BoilerNum)%ParasiticElecPower,'System','Average',Boiler(BoilerNum)%Name)
CALL SetupOutputVariable('Boiler Ancillary Electric Energy [J]', &
BoilerReport(BoilerNum)%ParasiticElecConsumption,'System','Sum',Boiler(BoilerNum)%Name, &
ResourceTypeKey='ELECTRICITY',EndUseKey='Heating',EndUseSubKey='Boiler Parasitic', &
GroupKey='Plant')
CALL SetupOutputVariable('Boiler Part Load Ratio []', &
BoilerReport(BoilerNum)%BoilerPLR,'System','Average',Boiler(BoilerNum)%Name)
IF (AnyEnergyManagementSystemInModel) THEN
CALL SetupEMSInternalVariable('Boiler Nominal Capacity', Boiler(BoilerNum)%Name, '[W]', &
Boiler(BoilerNum)%NomCap )
ENDIF
END DO
DEALLOCATE(BoilerFuelTypeForOutputVariable)
RETURN
END SUBROUTINE GetBoilerInput