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.
Type | Intent | Optional | Attributes | Name | ||
---|---|---|---|---|---|---|
integer, | intent(in) | :: | ChillNum | |||
logical, | intent(in) | :: | RunFlag |
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 InitGasAbsorber(ChillNum,RunFlag)
! SUBROUTINE INFORMATION:
! AUTHOR Fred Buhl
! DATE WRITTEN June 2003
! MODIFIED na
! RE-ENGINEERED na
! PURPOSE OF THIS SUBROUTINE:
! This subroutine is for initializations of direct fired absorption chiller
! components.
! METHODOLOGY EMPLOYED:
! Uses the status flags to trigger initializations.
! REFERENCES:
! na
! USE STATEMENTS:
USE DataGlobals, ONLY : BeginEnvrnFlag, AnyEnergyManagementSystemInModel
USE DataPlant, ONLY : TypeOf_Chiller_DFAbsorption, ScanPlantLoopsForObject, PlantLoop, &
PlantSizeNotComplete, PlantSizesOkayToFinalize
USE PlantUtilities, ONLY : InterConnectTwoPlantLoopSides, InitComponentNodes, SetComponentFlowRate
USE FluidProperties, ONLY : GetDensityGlycol
USE EMSManager, ONLY : iTemperatureSetpoint, CheckIfNodeSetpointManagedByEMS
USE Psychrometrics, ONLY : RhoH2O
! na
IMPLICIT NONE ! Enforce explicit typing of all variables in this routine
! SUBROUTINE ARGUMENT DEFINITIONS:
INTEGER, INTENT (IN) :: ChillNum ! number of the current engine driven chiller being simulated
LOGICAL, INTENT(IN) :: RunFlag ! TRUE when chiller operating
! used to determine if heating side or cooling
! side of chiller-heater is being called
! SUBROUTINE PARAMETER DEFINITIONS:
! na
! INTERFACE BLOCK SPECIFICATIONS
! na
! DERIVED TYPE DEFINITIONS
! na
! SUBROUTINE LOCAL VARIABLE DECLARATIONS:
LOGICAL,SAVE :: MyOneTimeFlag = .true.
LOGICAL, ALLOCATABLE,Save, DIMENSION(:) :: MyEnvrnFlag
LOGICAL, ALLOCATABLE, DIMENSION(:), SAVE :: MyPlantScanFlag
INTEGER :: CondInletNode ! node number of water inlet node to the condenser
INTEGER :: CondOutletNode ! node number of water outlet node from the condenser
INTEGER :: HeatInletNode ! node number of hot water inlet node
INTEGER :: HeatOutletNode ! node number of hot water outlet node
LOGICAL :: errFlag
REAL(r64) :: rho ! local fluid density
REAL(r64) :: mdot ! lcoal fluid mass flow rate
! Do the one time initializations
IF (MyOneTimeFlag) THEN
ALLOCATE(MyPlantScanFlag(NumGasAbsorbers))
ALLOCATE(MyEnvrnFlag(NumGasAbsorbers))
MyEnvrnFlag = .TRUE.
MyOneTimeFlag = .false.
MyPlantScanFlag = .TRUE.
END IF
! Init more variables
IF (MyPlantScanFlag(ChillNum)) THEN
! Locate the chillers on the plant loops for later usage
errFlag=.false.
CALL ScanPlantLoopsForObject(GasAbsorber(ChillNum)%Name, &
TypeOf_Chiller_DFAbsorption, &
GasAbsorber(ChillNum)%CWLoopNum, &
GasAbsorber(ChillNum)%CWLoopSideNum, &
GasAbsorber(ChillNum)%CWBranchNum, &
GasAbsorber(ChillNum)%CWCompNum, &
LowLimitTemp = GasAbsorber(ChillNum)%CHWLowLimitTemp, &
InletNodeNumber = GasAbsorber(ChillNum)%ChillReturnNodeNum, &
errFlag=errFlag)
IF (errFlag) THEN
CALL ShowFatalError('InitGasAbsorber: Program terminated due to previous condition(s).')
ENDIF
CALL ScanPlantLoopsForObject(GasAbsorber(ChillNum)%Name, &
TypeOf_Chiller_DFAbsorption, &
GasAbsorber(ChillNum)%HWLoopNum, &
GasAbsorber(ChillNum)%HWLoopSideNum, &
GasAbsorber(ChillNum)%HWBranchNum, &
GasAbsorber(ChillNum)%HWCompNum, &
InletNodeNumber = GasAbsorber(ChillNum)%HeatReturnNodeNum, &
errFlag=errFlag)
IF (errFlag) THEN
CALL ShowFatalError('InitGasAbsorber: Program terminated due to previous condition(s).')
ENDIF
IF (GasAbsorber(ChillNum)%isWaterCooled) THEN
CALL ScanPlantLoopsForObject(GasAbsorber(ChillNum)%Name, &
TypeOf_Chiller_DFAbsorption, &
GasAbsorber(ChillNum)%CDLoopNum, &
GasAbsorber(ChillNum)%CDLoopSideNum, &
GasAbsorber(ChillNum)%CDBranchNum, &
GasAbsorber(ChillNum)%CDCompNum, &
InletNodeNumber = GasAbsorber(ChillNum)%CondReturnNodeNum, &
errFlag=errFlag)
IF (errFlag) THEN
CALL ShowFatalError('InitGasAbsorber: Program terminated due to previous condition(s).')
ENDIF
CALL InterConnectTwoPlantLoopSides( GasAbsorber(ChillNum)%CWLoopNum, &
GasAbsorber(ChillNum)%CWLoopSideNum, &
GasAbsorber(ChillNum)%CDLoopNum, &
GasAbsorber(ChillNum)%CDLoopSideNum, &
TypeOf_Chiller_DFAbsorption , .TRUE.)
CALL InterConnectTwoPlantLoopSides( GasAbsorber(ChillNum)%HWLoopNum, &
GasAbsorber(ChillNum)%HWLoopSideNum, &
GasAbsorber(ChillNum)%CDLoopNum, &
GasAbsorber(ChillNum)%CDLoopSideNum, &
TypeOf_Chiller_DFAbsorption , .TRUE. )
ENDIF
CALL InterConnectTwoPlantLoopSides( GasAbsorber(ChillNum)%CWLoopNum, &
GasAbsorber(ChillNum)%CWLoopSideNum, &
GasAbsorber(ChillNum)%HWLoopNum, &
GasAbsorber(ChillNum)%HWLoopSideNum, &
TypeOf_Chiller_DFAbsorption, .TRUE. )
! check if outlet node of chilled water side has a setpoint.
IF ((Node(GasAbsorber(ChillNum)%ChillSupplyNodeNum)%TempSetPoint == SensedNodeFlagValue) .AND. &
(Node(GasAbsorber(ChillNum)%ChillSupplyNodeNum)%TempSetPointHi == SensedNodeFlagValue)) THEN
IF (.NOT. AnyEnergyManagementSystemInModel) THEN
IF (.NOT. GasAbsorber(ChillNum)%ChillSetpointErrDone) THEN
CALL ShowWarningError('Missing temperature setpoint on cool side for chiller heater named ' // &
TRIM(GasAbsorber(ChillNum)%Name) )
CALL ShowContinueError(' A temperature setpoint is needed at the outlet node of this chiller ' // &
', use a SetpointManager')
CALL ShowContinueError(' The overall loop setpoint will be assumed for chiller. The simulation continues ... ')
GasAbsorber(ChillNum)%ChillSetpointErrDone = .TRUE.
ENDIF
ELSE
! need call to EMS to check node
errFlag = .FALSE. ! but not really fatal yet, but should be.
CALL CheckIfNodeSetpointManagedByEMS(GasAbsorber(ChillNum)%ChillSupplyNodeNum,iTemperatureSetpoint, errFlag)
IF (errFlag) THEN
IF (.NOT. GasAbsorber(ChillNum)%ChillSetpointErrDone) THEN
CALL ShowWarningError('Missing temperature setpoint on cool side for chiller heater named ' // &
TRIM(GasAbsorber(ChillNum)%Name) )
CALL ShowContinueError(' A temperature setpoint is needed at the outlet node of this chiller evaporator ')
CALL ShowContinueError(' use a Setpoint Manager to establish a setpoint at the chiller evaporator outlet node ')
CALL ShowContinueError(' or use an EMS actuator to establish a setpoint at the outlet node ')
CALL ShowContinueError(' The overall loop setpoint will be assumed for chiller. The simulation continues ... ')
GasAbsorber(ChillNum)%ChillSetpointErrDone = .TRUE.
ENDIF
ENDIF
ENDIF
GasAbsorber(ChillNum)%ChillSetpointSetToLoop = .TRUE.
Node(GasAbsorber(ChillNum)%ChillSupplyNodeNum)%TempSetPoint = &
Node(PlantLoop(GasAbsorber(ChillNum)%CWLoopNum)%TempSetPointNodeNum)%TempSetPoint
Node(GasAbsorber(ChillNum)%ChillSupplyNodeNum)%TempSetPointHi = &
Node(PlantLoop(GasAbsorber(ChillNum)%CWLoopNum)%TempSetPointNodeNum)%TempSetPointHi
ENDIF
! check if outlet node of hot water side has a setpoint.
IF ((Node(GasAbsorber(ChillNum)%HeatSupplyNodeNum)%TempSetPoint == SensedNodeFlagValue) .AND. &
(Node(GasAbsorber(ChillNum)%HeatSupplyNodeNum)%TempSetPointLo == SensedNodeFlagValue)) THEN
IF (.NOT. AnyEnergyManagementSystemInModel) THEN
IF (.NOT. GasAbsorber(ChillNum)%HeatSetpointErrDone) THEN
CALL ShowWarningError('Missing temperature setpoint on heat side for chiller heater named ' // &
TRIM(GasAbsorber(ChillNum)%Name) )
CALL ShowContinueError(' A temperature setpoint is needed at the outlet node of this chiller ' // &
', use a SetpointManager')
CALL ShowContinueError(' The overall loop setpoint will be assumed for chiller. The simulation continues ... ')
GasAbsorber(ChillNum)%HeatSetpointErrDone = .TRUE.
ENDIF
ELSE
! need call to EMS to check node
errFlag = .FALSE. ! but not really fatal yet, but should be.
CALL CheckIfNodeSetpointManagedByEMS(GasAbsorber(ChillNum)%HeatSupplyNodeNum,iTemperatureSetpoint, errFlag)
IF (errFlag) THEN
IF (.NOT. GasAbsorber(ChillNum)%HeatSetpointErrDone) THEN
CALL ShowWarningError('Missing temperature setpoint on heat side for chiller heater named ' // &
TRIM(GasAbsorber(ChillNum)%Name) )
CALL ShowContinueError(' A temperature setpoint is needed at the outlet node of this chiller heater ')
CALL ShowContinueError(' use a Setpoint Manager to establish a setpoint at the heater side outlet node ')
CALL ShowContinueError(' or use an EMS actuator to establish a setpoint at the outlet node ')
CALL ShowContinueError(' The overall loop setpoint will be assumed for heater side. The simulation continues ... ')
GasAbsorber(ChillNum)%HeatSetpointErrDone = .TRUE.
ENDIF
ENDIF
ENDIF
GasAbsorber(ChillNum)%HeatSetpointSetToLoop = .TRUE.
Node(GasAbsorber(ChillNum)%HeatSupplyNodeNum)%TempSetPoint = &
Node(PlantLoop(GasAbsorber(ChillNum)%HWLoopNum)%TempSetPointNodeNum)%TempSetPoint
Node(GasAbsorber(ChillNum)%HeatSupplyNodeNum)%TempSetPointLo = &
Node(PlantLoop(GasAbsorber(ChillNum)%HWLoopNum)%TempSetPointNodeNum)%TempSetPointLo
ENDIF
MyPlantScanFlag(ChillNum)=.FALSE.
ENDIF
CondInletNode = GasAbsorber(ChillNum)%CondReturnNodeNum
CondOutletNode = GasAbsorber(ChillNum)%CondSupplyNodeNum
HeatInletNode = GasAbsorber(ChillNum)%HeatReturnNodeNum
HeatOutletNode = GasAbsorber(ChillNum)%HeatSupplyNodeNum
IF(MyEnvrnFlag(ChillNum) .and. BeginEnvrnFlag .AND. (PlantSizesOkayToFinalize))THEN
IF (PlantSizeNotComplete) CALL SizeGasAbsorber(ChillNum)
IF (GasAbsorber(ChillNum)%isWaterCooled) THEN
! init max available condenser water flow rate
IF (GasAbsorber(ChillNum)%CDLoopNum > 0) THEN
rho = GetDensityGlycol(PlantLoop(GasAbsorber(ChillNum)%CDLoopNum)%FluidName, &
InitConvTemp, &
PlantLoop(GasAbsorber(ChillNum)%CDLoopNum)%FluidIndex, &
'InitGasAbsorber')
ELSE
rho = RhoH2O(InitConvTemp)
ENDIF
GasAbsorber(ChillNum)%DesCondMassFlowRate = rho * GasAbsorber(ChillNum)%CondVolFlowRate
CALL InitComponentNodes(0.d0, GasAbsorber(ChillNum)%DesCondMassFlowRate, &
CondInletNode, CondOutletNode, &
GasAbsorber(ChillNum)%CDLoopNum, &
GasAbsorber(ChillNum)%CDLoopSideNum, &
GasAbsorber(ChillNum)%CDBranchNum, &
GasAbsorber(ChillNum)%CDCompNum)
ENDIF
IF (GasAbsorber(ChillNum)%HWLoopNum > 0) THEN
rho = GetDensityGlycol(PlantLoop(GasAbsorber(ChillNum)%HWLoopNum)%FluidName, &
InitConvTemp, &
PlantLoop(GasAbsorber(ChillNum)%HWLoopNum)%FluidIndex, &
'InitGasAbsorber')
ELSE
rho = RhoH2O(InitConvTemp)
ENDIF
GasAbsorber(ChillNum)%DesHeatMassFlowRate = rho * GasAbsorber(ChillNum)%HeatVolFlowRate
!init available hot water flow rate
CALL InitComponentNodes(0.d0, GasAbsorber(ChillNum)%DesHeatMassFlowRate, &
HeatInletNode, HeatOutletNode, &
GasAbsorber(ChillNum)%HWLoopNum, &
GasAbsorber(ChillNum)%HWLoopSideNum, &
GasAbsorber(ChillNum)%HWBranchNum, &
GasAbsorber(ChillNum)%HWCompNum)
IF (GasAbsorber(ChillNum)%CWLoopNum > 0) THEN
rho = GetDensityGlycol(PlantLoop(GasAbsorber(ChillNum)%CWLoopNum)%FluidName, &
InitConvTemp, &
PlantLoop(GasAbsorber(ChillNum)%CWLoopNum)%FluidIndex, &
'InitGasAbsorber')
ELSE
rho = RhoH2O(InitConvTemp)
ENDIF
GasAbsorber(ChillNum)%DesEvapMassFlowRate = rho * GasAbsorber(ChillNum)%EvapVolFlowRate
!init available hot water flow rate
CALL InitComponentNodes(0.d0, GasAbsorber(ChillNum)%DesEvapMassFlowRate, &
GasAbsorber(ChillNum)%ChillReturnNodeNum, &
GasAbsorber(ChillNum)%ChillSupplyNodeNum, &
GasAbsorber(ChillNum)%CWLoopNum, &
GasAbsorber(ChillNum)%CWLoopSideNum, &
GasAbsorber(ChillNum)%CWBranchNum, &
GasAbsorber(ChillNum)%CWCompNum)
MyEnvrnFlag(ChillNum) = .FALSE.
END IF
IF(.not. BeginEnvrnFlag)Then
MyEnvrnFlag(ChillNum) = .TRUE.
End IF
!this component model works off setpoints on the leaving node
! fill from plant if needed
IF (GasAbsorber(ChillNum)%ChillSetpointSetToLoop) THEN
Node(GasAbsorber(ChillNum)%ChillSupplyNodeNum)%TempSetPoint = &
Node(PlantLoop(GasAbsorber(ChillNum)%CWLoopNum)%TempSetPointNodeNum)%TempSetPoint
Node(GasAbsorber(ChillNum)%ChillSupplyNodeNum)%TempSetPointHi = &
Node(PlantLoop(GasAbsorber(ChillNum)%CWLoopNum)%TempSetPointNodeNum)%TempSetPointHi
ENDIF
IF ( GasAbsorber(ChillNum)%HeatSetpointSetToLoop ) THEN
Node(GasAbsorber(ChillNum)%HeatSupplyNodeNum)%TempSetPoint = &
Node(PlantLoop(GasAbsorber(ChillNum)%HWLoopNum)%TempSetPointNodeNum)%TempSetPoint
Node(GasAbsorber(ChillNum)%HeatSupplyNodeNum)%TempSetPointLo = &
Node(PlantLoop(GasAbsorber(ChillNum)%HWLoopNum)%TempSetPointNodeNum)%TempSetPointLo
ENDIF
IF ((GasAbsorber(ChillNum)%isWaterCooled) .AND. &
((GasAbsorber(ChillNum)%InHeatingMode) .OR. (GasAbsorber(ChillNum)%InCoolingMode)) &
.AND. (.NOT. MyPlantScanFlag(ChillNum)) ) THEN
mdot = GasAbsorber(ChillNum)%DesCondMassFlowRate
!DSU removed, this has to have been wrong (?) Node(CondInletNode)%Temp = GasAbsorber(ChillNum)%TempDesCondReturn
CALL SetComponentFlowRate(mdot, &
GasAbsorber(ChillNum)%CondReturnNodeNum, &
GasAbsorber(ChillNum)%CondSupplyNodeNum, &
GasAbsorber(ChillNum)%CDLoopNum, &
GasAbsorber(ChillNum)%CDLoopSideNum, &
GasAbsorber(ChillNum)%CDBranchNum, &
GasAbsorber(ChillNum)%CDCompNum)
ELSE
mdot = 0.d0
CALL SetComponentFlowRate(mdot, &
GasAbsorber(ChillNum)%CondReturnNodeNum, &
GasAbsorber(ChillNum)%CondSupplyNodeNum, &
GasAbsorber(ChillNum)%CDLoopNum, &
GasAbsorber(ChillNum)%CDLoopSideNum, &
GasAbsorber(ChillNum)%CDBranchNum, &
GasAbsorber(ChillNum)%CDCompNum)
END IF
RETURN
END SUBROUTINE InitGasAbsorber