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 GetBLASTAbsorberInput
! SUBROUTINE INFORMATION:
! AUTHOR: Dan Fisher
! DATE WRITTEN: April 1998
! MODIFIED: R. Raustad May 2008 - added generator nodes
! PURPOSE OF THIS SUBROUTINE:
! This routine will get the input
! required by the BLAST Absorption chiller models as shown below:
! METHODOLOGY EMPLOYED:
! EnergyPlus input processor
! REFERENCES: na
! USE STATEMENTS:
USE InputProcessor, ONLY : GetNumObjectsFound, GetObjectItem, VerifyName, SameString, GetObjectDefMaxArgs
USE DataIPShortCuts ! Data for field names, blank numerics
USE BranchNodeConnections, ONLY: TestCompSet
USE NodeInputManager, ONLY: GetOnlySingleNode
USE GlobalNames, ONLY: VerifyUniqueChillerName
USE OutputReportPredefined
USE FluidProperties, ONLY: FindRefrigerant
USE General, ONLY: RoundSigDigits
USE DataGlobals, ONLY: AnyEnergyManagementSystemInModel
IMPLICIT NONE !
! SUBROUTINE PARAMETER DEFINITIONS:
CHARACTER(len=*), PARAMETER :: Blank = ' '
CHARACTER(len=*), PARAMETER :: RoutineName='GetBLASTAbsorberInput: ' ! include trailing blank space
!LOCAL VARIABLES
INTEGER :: AbsorberNum !Absorber counter
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, ALLOCATABLE, DIMENSION(:) :: GenInputOutputNodesUsed ! Used for SetupOutputVariable
LOGICAL, SAVE :: ErrorsFound=.false.
LOGICAL :: IsNotOK ! Flag to verify name
LOGICAL :: IsBlank ! Flag for blank name
LOGICAL :: errflag
! CHARACTER(len=MaxNameLength) :: CurrentModuleObject ! for ease in renaming.
!FLOW
cCurrentModuleObject = 'Chiller:Absorption'
NumBLASTAbsorbers = GetNumObjectsFound(cCurrentModuleObject)
IF (NumBLASTAbsorbers <= 0) THEN
CALL ShowSevereError('No '//TRIM(cCurrentModuleObject)//' equipment specified in input file')
!See if load distribution manager has already gotten the input
ErrorsFound=.true.
ENDIF
IF (ALLOCATED(BLASTAbsorber))RETURN
!ALLOCATE ARRAYS
ALLOCATE (BLASTAbsorber(NumBLASTAbsorbers))
ALLOCATE(CheckEquipName(NumBLASTAbsorbers))
CheckEquipName=.TRUE.
ALLOCATE(GenInputOutputNodesUsed(NumBLASTAbsorbers))
GenInputOutputNodesUsed=.FALSE.
ALLOCATE (BLASTAbsorberReport(NumBLASTAbsorbers))
!LOAD ARRAYS WITH BLAST CURVE FIT Absorber DATA
DO AbsorberNum = 1 , NumBLASTAbsorbers
CALL GetObjectItem(cCurrentModuleObject,AbsorberNum,cAlphaArgs,NumAlphas, &
rNumericArgs,NumNums,IOSTAT,AlphaBlank=lAlphaFieldBlanks, &
AlphaFieldnames=cAlphaFieldNames,NumericFieldNames=cNumericFieldNames)
IsNotOK=.false.
IsBlank=.false.
CALL VerifyName(cAlphaArgs(1),BLASTAbsorber%Name,AbsorberNum-1,IsNotOK,IsBlank,TRIM(cCurrentModuleObject)//' Name')
IF (IsNotOK) THEN
ErrorsFound=.true.
IF (IsBlank) cAlphaArgs(1)='xxxxx'
ENDIF
CALL VerifyUniqueChillerName(TRIM(cCurrentModuleObject),cAlphaArgs(1),errflag,TRIM(cCurrentModuleObject)//' Name')
IF (errflag) THEN
ErrorsFound=.true.
ENDIF
BLASTAbsorber(AbsorberNum)%Name = cAlphaArgs(1)
BLASTAbsorber(AbsorberNum)%NomCap = rNumericArgs(1)
BLASTAbsorber(AbsorberNum)%NomPumpPower = rNumericArgs(2)
IF (rNumericArgs(1) == 0.0d0) THEN
CALL ShowSevereError('Invalid '//TRIM(cNumericFieldNames(1))//'='//TRIM(RoundSigDigits(rNumericArgs(1),2)))
CALL ShowContinueError('Entered in '//TRIM(cCurrentModuleObject)//'='//TRIM(cAlphaArgs(1)))
ErrorsFound=.true.
ENDIF
! Assign Node Numbers to specified nodes
BLASTAbsorber(AbsorberNum)%EvapInletNodeNum = &
GetOnlySingleNode(cAlphaArgs(2),ErrorsFound,TRIM(cCurrentModuleObject),cAlphaArgs(1), &
NodeType_Water,NodeConnectionType_Inlet,1,ObjectIsNotParent)
BLASTAbsorber(AbsorberNum)%EvapOutletNodeNum = &
GetOnlySingleNode(cAlphaArgs(3),ErrorsFound,TRIM(cCurrentModuleObject),cAlphaArgs(1), &
NodeType_Water,NodeConnectionType_Outlet,1,ObjectIsNotParent)
CALL TestCompSet(TRIM(cCurrentModuleObject),cAlphaArgs(1),cAlphaArgs(2),cAlphaArgs(3),'Chilled Water Nodes')
BLASTAbsorber(AbsorberNum)%CondInletNodeNum = &
GetOnlySingleNode(cAlphaArgs(4),ErrorsFound,TRIM(cCurrentModuleObject),cAlphaArgs(1), &
NodeType_Water,NodeConnectionType_Inlet,2,ObjectIsNotParent)
BLASTAbsorber(AbsorberNum)%CondOutletNodeNum = &
GetOnlySingleNode(cAlphaArgs(5),ErrorsFound,TRIM(cCurrentModuleObject),cAlphaArgs(1), &
NodeType_Water,NodeConnectionType_Outlet,2,ObjectIsNotParent)
CALL TestCompSet(TRIM(cCurrentModuleObject),cAlphaArgs(1),cAlphaArgs(4),cAlphaArgs(5),'Condenser (not tested) Nodes')
IF(NumAlphas .GT. 8)THEN
IF(SameString(cAlphaArgs(9),'HotWater') .OR. SameString(cAlphaArgs(9),'HotWater'))THEN
BLASTAbsorber(AbsorberNum)%GenHeatSourceType = NodeType_Water
ELSE IF(SameString(cAlphaArgs(9),'Steam') .OR. SameString(cAlphaArgs(9),Blank))THEN
BLASTAbsorber(AbsorberNum)%GenHeatSourceType = NodeType_Steam
ELSE
CALL ShowSevereError('Invalid '//TRIM(cAlphaFieldNames(9))//'='//TRIM(cAlphaArgs(9)))
CALL ShowContinueError('Entered in '//TRIM(cCurrentModuleObject)//'='//TRIM(cAlphaArgs(1)))
CALL ShowContinueError('...Generator heat source type must be Steam or Hot Water.')
ErrorsFound=.true.
END IF
ELSE
BLASTAbsorber(AbsorberNum)%GenHeatSourceType = NodeType_Steam
END IF
IF(.NOT. lAlphaFieldBlanks(6) .AND. .NOT. lAlphaFieldBlanks(7) )THEN
GenInputOutputNodesUsed(AbsorberNum) = .TRUE.
IF(BLASTAbsorber(AbsorberNum)%GenHeatSourceType == NodeType_Water)THEN
BLASTAbsorber(AbsorberNum)%GeneratorInletNodeNum = &
GetOnlySingleNode(cAlphaArgs(6),ErrorsFound,TRIM(cCurrentModuleObject),cAlphaArgs(1), &
NodeType_Water,NodeConnectionType_Inlet,3,ObjectIsNotParent)
BLASTAbsorber(AbsorberNum)%GeneratorOutletNodeNum = &
GetOnlySingleNode(cAlphaArgs(7),ErrorsFound,TRIM(cCurrentModuleObject),cAlphaArgs(1), &
NodeType_Water,NodeConnectionType_Outlet,3,ObjectIsNotParent)
CALL TestCompSet(TRIM(cCurrentModuleObject),cAlphaArgs(1),cAlphaArgs(6),cAlphaArgs(7),'Hot Water Nodes')
ELSE
BLASTAbsorber(AbsorberNum)%SteamFluidIndex=FindRefrigerant('STEAM')
BLASTAbsorber(AbsorberNum)%GeneratorInletNodeNum = &
GetOnlySingleNode(cAlphaArgs(6),ErrorsFound,TRIM(cCurrentModuleObject),cAlphaArgs(1), &
NodeType_Steam,NodeConnectionType_Inlet,3,ObjectIsNotParent)
BLASTAbsorber(AbsorberNum)%GeneratorOutletNodeNum = &
GetOnlySingleNode(cAlphaArgs(7),ErrorsFound,TRIM(cCurrentModuleObject),cAlphaArgs(1), &
NodeType_Steam,NodeConnectionType_Outlet,3,ObjectIsNotParent)
CALL TestCompSet(TRIM(cCurrentModuleObject),cAlphaArgs(1),cAlphaArgs(6),cAlphaArgs(7),'Steam Nodes')
END IF
ELSE IF( (lAlphaFieldBlanks(6) .AND. .NOT. lAlphaFieldBlanks(7)) .OR. &
(.NOT. lAlphaFieldBlanks(6) .AND. lAlphaFieldBlanks(7)))THEN
CALL ShowSevereError(TRIM(cCurrentModuleObject)//', Name='//TRIM(cAlphaArgs(1)))
CALL ShowContinueError('...Generator fluid nodes must both be entered (or both left blank).')
CALL ShowContinueError('...'//TRIM(cAlphaFieldNames(6))//' = '//TRIM(cAlphaArgs(6)))
CALL ShowContinueError('...'//TRIM(cAlphaFieldNames(7))//' = '//TRIM(cAlphaArgs(7)))
ErrorsFound=.true.
ELSE
IF(BLASTAbsorber(AbsorberNum)%GenHeatSourceType .EQ. NodeType_Water)THEN
CALL ShowWarningError(TRIM(cCurrentModuleObject)//', Name='//TRIM(cAlphaArgs(1)))
CALL ShowContinueError('...Generator fluid type must be Steam if generator inlet/outlet nodes are blank.')
CALL ShowContinueError('...Generator fluid type is set to Steam and the simulation continues.')
BLASTAbsorber(AbsorberNum)%GenHeatSourceType = NodeType_Steam
END IF
END IF
! Get remaining data
BLASTAbsorber(AbsorberNum)%MinPartLoadRat = rNumericArgs(3)
BLASTAbsorber(AbsorberNum)%MaxPartLoadRat = rNumericArgs(4)
BLASTAbsorber(AbsorberNum)%OptPartLoadRat = rNumericArgs(5)
BLASTAbsorber(AbsorberNum)%TempDesCondIn = rNumericArgs(6)
BLASTAbsorber(AbsorberNum)%EvapVolFlowRate = rNumericArgs(7)
BLASTAbsorber(AbsorberNum)%CondVolFlowRate = rNumericArgs(8)
BLASTAbsorber(AbsorberNum)%SteamLoadCoef(1) = rNumericArgs(9)
BLASTAbsorber(AbsorberNum)%SteamLoadCoef(2) = rNumericArgs(10)
BLASTAbsorber(AbsorberNum)%SteamLoadCoef(3) = rNumericArgs(11)
BLASTAbsorber(AbsorberNum)%PumpPowerCoef(1) = rNumericArgs(12)
BLASTAbsorber(AbsorberNum)%PumpPowerCoef(2) = rNumericArgs(13)
BLASTAbsorber(AbsorberNum)%PumpPowerCoef(3) = rNumericArgs(14)
BLASTAbsorber(AbsorberNum)%TempLowLimitEvapOut = rNumericArgs(15)
SELECT CASE (TRIM(cAlphaArgs(8)))
CASE ( 'CONSTANTFLOW' )
BLASTAbsorber(AbsorberNum)%FlowMode = ConstantFlow
CASE ( 'VARIABLEFLOW' )
BLASTAbsorber(AbsorberNum)%FlowMode = LeavingSetpointModulated
CALL ShowWarningError(RoutineName//TRIM(cCurrentModuleObject)//'="'//TRIM(cAlphaArgs(1))//'",')
CALL ShowContinueError('Invalid '//TRIM(cAlphaFieldNames(8))//'='//TRIM(cAlphaArgs(8)))
CALL ShowContinueError('Key choice is now called "LeavingSetpointModulated" and the simulation continues')
CASE ('LEAVINGSETPOINTMODULATED')
BLASTAbsorber(AbsorberNum)%FlowMode = LeavingSetpointModulated
CASE ('NOTMODULATED')
BLASTAbsorber(AbsorberNum)%FlowMode = NotModulated
CASE DEFAULT
CALL ShowSevereError(RoutineName//TRIM(cCurrentModuleObject)//'="'//TRIM(cAlphaArgs(1))//'",')
CALL ShowContinueError('Invalid '//TRIM(cAlphaFieldNames(8))//'='//TRIM(cAlphaArgs(8)))
CALL ShowContinueError('Available choices are ConstantFlow, NotModulated, or LeavingSetpointModulated')
CALL ShowContinueError('Flow mode NotModulated is assumed and the simulation continues.')
BLASTAbsorber(AbsorberNum)%FlowMode = NotModulated
END SELECT
IF(NumNums .GT. 15)THEN
BLASTAbsorber(AbsorberNum)%GeneratorVolFlowRate = rNumericArgs(16)
END IF
IF(BLASTAbsorber(AbsorberNum)%GeneratorVolFlowRate == 0.0d0 .AND. &
BLASTAbsorber(AbsorberNum)%GenHeatSourceType == NodeType_Water)THEN
CALL ShowSevereError('Invalid '//TRIM(cNumericFieldNames(16))//'='//TRIM(RoundSigDigits(rNumericArgs(16),2)))
CALL ShowContinueError('Entered in '//TRIM(cCurrentModuleObject)//'='//TRIM(cAlphaArgs(1)))
CALL ShowContinueError('...Generator water flow rate must be greater than 0'// &
' when absorber generator fluid type is hot water.')
ErrorsFound=.true.
END IF
IF(NumNums .GT. 16)THEN
BLASTAbsorber(AbsorberNum)%GeneratorSubCool = rNumericArgs(17)
ELSE
BLASTAbsorber(AbsorberNum)%GeneratorSubCool = 1.0d0
END IF
IF(NumNums .GT. 17)THEN
BLASTAbsorber(AbsorberNum)%SizFac = rNumericArgs(18)
ELSE
BLASTAbsorber(AbsorberNum)%SizFac = 1.0d0
END IF
END DO
IF (ErrorsFound) THEN
CALL ShowFatalError('Errors found in processing input for '// TRIM(cCurrentModuleObject) )
ENDIF
DO AbsorberNum = 1, NumBLASTAbsorbers
CALL SetupOutputVariable('Chiller Electric Power [W]', &
BLASTAbsorberReport(AbsorberNum)%PumpingPower,'System','Average',BLASTAbsorber(AbsorberNum)%Name)
CALL SetupOutputVariable('Chiller Electric Energy [J]', &
BLASTAbsorberReport(AbsorberNum)%PumpingEnergy,'System','Sum',BLASTAbsorber(AbsorberNum)%Name, &
ResourceTypeKey='ELECTRICITY',EndUseKey='Cooling',GroupKey='Plant')
CALL SetupOutputVariable('Chiller Evaporator Cooling Rate [W]', &
BLASTAbsorberReport(AbsorberNum)%QEvap,'System','Average',BLASTAbsorber(AbsorberNum)%Name)
CALL SetupOutputVariable('Chiller Evaporator Cooling Energy [J]', &
BLASTAbsorberReport(AbsorberNum)%EvapEnergy,'System','Sum',BLASTAbsorber(AbsorberNum)%Name, &
ResourceTypeKey='ENERGYTRANSFER',EndUseKey='CHILLERS',GroupKey='Plant')
CALL SetupOutputVariable('Chiller Evaporator Inlet Temperature [C]', &
BLASTAbsorberReport(AbsorberNum)%EvapInletTemp,'System','Average',BLASTAbsorber(AbsorberNum)%Name)
CALL SetupOutputVariable('Chiller Evaporator Outlet Temperature [C]', &
BLASTAbsorberReport(AbsorberNum)%EvapOutletTemp,'System','Average',BLASTAbsorber(AbsorberNum)%Name)
CALL SetupOutputVariable('Chiller Evaporator Mass Flow Rate [kg/s]', &
BLASTAbsorberReport(AbsorberNum)%Evapmdot,'System','Average',BLASTAbsorber(AbsorberNum)%Name)
CALL SetupOutputVariable('Chiller Condenser Heat Transfer Rate [W]', &
BLASTAbsorberReport(AbsorberNum)%QCond,'System','Average',BLASTAbsorber(AbsorberNum)%Name)
CALL SetupOutputVariable('Chiller Condenser Heat Transfer Energy [J]', &
BLASTAbsorberReport(AbsorberNum)%CondEnergy,'System','Sum',BLASTAbsorber(AbsorberNum)%Name, &
ResourceTypeKey='ENERGYTRANSFER',EndUseKey='HEATREJECTION',GroupKey='Plant')
CALL SetupOutputVariable('Chiller Condenser Inlet Temperature [C]', &
BLASTAbsorberReport(AbsorberNum)%CondInletTemp,'System','Average',BLASTAbsorber(AbsorberNum)%Name)
CALL SetupOutputVariable('Chiller Condenser Outlet Temperature [C]', &
BLASTAbsorberReport(AbsorberNum)%CondOutletTemp,'System','Average',BLASTAbsorber(AbsorberNum)%Name)
CALL SetupOutputVariable('Chiller Condenser Mass Flow Rate [kg/s]', &
BLASTAbsorberReport(AbsorberNum)%Condmdot,'System','Average',BLASTAbsorber(AbsorberNum)%Name)
IF(BLASTAbsorber(AbsorberNum)%GenHeatSourceType == NodeType_Water)THEN
CALL SetupOutputVariable('Chiller Hot Water Consumption Rate [W]', &
BLASTAbsorberReport(AbsorberNum)%QGenerator,'System','Average',BLASTAbsorber(AbsorberNum)%Name)
CALL SetupOutputVariable('Chiller Source Hot Water Energy [J]', &
BLASTAbsorberReport(AbsorberNum)%GeneratorEnergy,'System','Sum',BLASTAbsorber(AbsorberNum)%Name, &
ResourceTypeKey='PLANTLOOPHEATINGDEMAND',EndUseKey='CHILLERS',GroupKey='Plant')
ELSE
IF(GenInputOutputNodesUsed(AbsorberNum))THEN
CALL SetupOutputVariable('Chiller Source Steam Rate [W]', &
BLASTAbsorberReport(AbsorberNum)%QGenerator,'System','Average',BLASTAbsorber(AbsorberNum)%Name)
CALL SetupOutputVariable('Chiller Source Steam Energy [J]', &
BLASTAbsorberReport(AbsorberNum)%GeneratorEnergy,'System','Sum',BLASTAbsorber(AbsorberNum)%Name, &
ResourceTypeKey='PLANTLOOPHEATINGDEMAND',EndUseKey='CHILLERS',GroupKey='Plant')
ELSE
CALL SetupOutputVariable('Chiller Source Steam Rate [W]', &
BLASTAbsorberReport(AbsorberNum)%QGenerator,'System','Average',BLASTAbsorber(AbsorberNum)%Name)
CALL SetupOutputVariable('Chiller Source Steam Energy [J]', &
BLASTAbsorberReport(AbsorberNum)%GeneratorEnergy,'System','Sum',BLASTAbsorber(AbsorberNum)%Name, &
ResourceTypeKey='Steam',EndUseKey='Cooling',GroupKey='Plant')
END IF
END IF
CALL SetupOutputVariable('Chiller COP [W/W]', &
BLASTAbsorberReport(AbsorberNum)%ActualCOP,'System','Average',BLASTAbsorber(AbsorberNum)%Name)
IF (AnyEnergyManagementSystemInModel) THEN
CALL SetupEMSInternalVariable('Chiller Nominal Capacity', BLASTAbsorber(AbsorberNum)%Name, '[W]', &
BLASTAbsorber(AbsorberNum)%NomCap )
ENDIF
END DO
IF(ALLOCATED(GenInputOutputNodesUsed)) DEALLOCATE(GenInputOutputNodesUsed)
RETURN
END SUBROUTINE GetBLASTAbsorberInput