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 Rahul Chillar
! DATE WRITTEN Dec 2004
! MODIFIED na
! 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 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 FluidProperties, ONLY: FindRefrigerant
USE GlobalNames, ONLY: VerifyUniqueBoilerName
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 :: IsNotOK ! Flag to verify name
LOGICAL :: IsBlank ! Flag for blank name
INTEGER :: SteamFluidIndex ! Fluid Index for Steam
LOGICAL, SAVE :: ErrorsFound=.false.
LOGICAL :: errflag
CHARACTER(len=MaxNameLength),ALLOCATABLE, DIMENSION(:) :: BoilerFuelTypeForOutputVariable ! used to set up report variables
SteamFluidIndex=0
cCurrentModuleObject = 'Boiler:Steam'
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
! Boiler will have fuel input to it , that is it !
ALLOCATE (Boiler(NumBoilers))
ALLOCATE(CheckEquipName(NumBoilers))
CheckEquipName=.true.
ALLOCATE(BoilerFuelTypeForOutputVariable(NumBoilers))
BoilerFuelTypeForOutputVariable=' '
ALLOCATE (BoilerReport(NumBoilers))
!LOAD ARRAYS WITH CURVE FIT Boiler DATA
DO BoilerNum = 1 , NumBoilers
CALL GetObjectItem(cCurrentModuleObject,BoilerNum,cAlphaArgs,NumAlphas, &
rNumericArgs,NumNums,IOSTAT,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)
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'
ErrorsFound=.true.
END SELECT
! INPUTS from the IDF file
Boiler(BoilerNum)%BoilerMaxOperPress = rNumericArgs(1)
Boiler(BoilerNum)%Effic = rNumericArgs(2)
Boiler(BoilerNum)%TempUpLimitBoilerOut = rNumericArgs(3)
Boiler(BoilerNum)%NomCap = rNumericArgs(4)
Boiler(BoilerNum)%MinPartLoadRat = rNumericArgs(5)
Boiler(BoilerNum)%MaxPartLoadRat = rNumericArgs(6)
Boiler(BoilerNum)%OptPartLoadRat = rNumericArgs(7)
Boiler(BoilerNum)%FullLoadCoef(1) = rNumericArgs(8)
Boiler(BoilerNum)%FullLoadCoef(2) = rNumericArgs(9)
Boiler(BoilerNum)%FullLoadCoef(3) = rNumericArgs(10)
Boiler(BoilerNum)%SizFac = rNumericArgs(11)
IF (Boiler(BoilerNum)%SizFac <= 0.0d0) Boiler(BoilerNum)%SizFac = 1.0d0
IF ((rNumericArgs(8)+rNumericArgs(9)+rNumericArgs(10)) == 0.0D0) THEN
CALL ShowSevereError(RoutineName//TRIM(cCurrentModuleObject)//'="'//TRIM(cAlphaArgs(1))//'",')
CALL ShowContinueError(' Sum of fuel use curve coefficients = 0.0')
ErrorsFound=.true.
ENDIF
IF (rNumericArgs(5) == 0.0D0) THEN
CALL ShowSevereError(RoutineName//TRIM(cCurrentModuleObject)//'="'//TRIM(cAlphaArgs(1))//'",')
CALL ShowContinueError('Invalid '//TRIM(cNumericFieldNames(5))//'='//TRIM(RoundSigDigits(rNumericArgs(5),3)))
ErrorsFound=.true.
ENDIF
IF (rNumericArgs(3) == 0.0D0) THEN
CALL ShowSevereError(RoutineName//TRIM(cCurrentModuleObject)//'="'//TRIM(cAlphaArgs(1))//'",')
CALL ShowContinueError('Invalid '//TRIM(cNumericFieldNames(3))//'='//TRIM(RoundSigDigits(rNumericArgs(3),3)))
ErrorsFound=.true.
ENDIF
Boiler(BoilerNum)%BoilerInletNodeNum= &
GetOnlySingleNode(cAlphaArgs(3),ErrorsFound,TRIM(cCurrentModuleObject),cAlphaArgs(1),NodeType_Steam, &
NodeConnectionType_Inlet, 1, ObjectIsNotParent)
Boiler(BoilerNum)%BoilerOutletNodeNum = &
GetOnlySingleNode(cAlphaArgs(4),ErrorsFound,TRIM(cCurrentModuleObject),cAlphaArgs(1),NodeType_Steam, &
NodeConnectionType_Outlet, 1, ObjectIsNotParent)
CALL TestCompSet(TRIM(cCurrentModuleObject),cAlphaArgs(1),cAlphaArgs(3),cAlphaArgs(4),'Hot Steam Nodes')
IF (SteamFluidIndex == 0 .and. BoilerNum == 1) THEN
SteamFluidIndex=FindRefrigerant('Steam')
IF (SteamFluidIndex == 0) THEN
CALL ShowSevereError(RoutineName//TRIM(cCurrentModuleObject)//'="'//TRIM(cAlphaArgs(1))//'",')
CALL ShowContinueError('Steam Properties not found; '// &
'Steam Fluid Properties must be included in the input file.')
ErrorsFound=.true.
ENDIF
ENDIF
Boiler(BoilerNum)%FluidIndex=SteamFluidIndex
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',GroupKey='Plant')
CALL SetupOutputVariable('Boiler Steam Inlet Temperature [C]', &
BoilerReport(BoilerNum)%BoilerInletTemp,'System','Average',Boiler(BoilerNum)%Name)
CALL SetupOutputVariable('Boiler Steam Outlet Temperature [C]', &
BoilerReport(BoilerNum)%BoilerOutletTemp,'System','Average',Boiler(BoilerNum)%Name)
CALL SetupOutputVariable('Boiler Steam Mass Flow Rate [kg/s]', &
BoilerReport(BoilerNum)%Mdot,'System','Average',Boiler(BoilerNum)%Name)
END DO
DEALLOCATE(BoilerFuelTypeForOutputVariable)
RETURN
END SUBROUTINE GetBoilerInput