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 | |||
real(kind=r64), | intent(in) | :: | MyLoad |
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 InitEngineDrivenChiller(ChillNum,RunFlag,MyLoad)
! SUBROUTINE INFORMATION:
! AUTHOR Fred Buhl
! DATE WRITTEN June 2002
! MODIFIED na
! RE-ENGINEERED na
! PURPOSE OF THIS SUBROUTINE:
! This subroutine is for initializations of the Engine Driven Chiller components
! METHODOLOGY EMPLOYED:
! Uses the status flags to trigger initializations.
! REFERENCES:
! na
! USE STATEMENTS:
USE DataGlobals, ONLY : BeginEnvrnFlag, AnyEnergyManagementSystemInModel
USE DataPlant, ONLY : PlantLoop, TypeOf_Chiller_EngineDriven, ScanPlantLoopsForObject, &
PlantSizesOkayToFinalize, PlantSizeNotComplete, LoopFlowStatus_NeedyIfLoopOn
USE DataEnvironment, ONLY : StdBaroPress
USE Psychrometrics, ONLY : PsyRhoAirFnPbTdbW
USE PlantUtilities, ONLY : InterConnectTwoPlantLoopSides, InitComponentNodes, SetComponentFlowRate
USE FluidProperties, ONLY : GetDensityGlycol
USE EMSManager, ONLY : iTemperatureSetpoint, CheckIfNodeSetpointManagedByEMS
USE DataInterfaces, ONLY : ShowFatalError, ShowSevereError, ShowContinueError
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
REAL(r64), INTENT(IN):: MyLoad
! SUBROUTINE PARAMETER DEFINITIONS:
CHARACTER(len=*), PARAMETER :: RoutineName='InitEngineDrivenChiller'
! INTERFACE BLOCK SPECIFICATIONS
! na
! DERIVED TYPE DEFINITIONS
! na
! SUBROUTINE LOCAL VARIABLE DECLARATIONS:
LOGICAL,SAVE :: MyOneTimeFlag = .true.
LOGICAL, ALLOCATABLE,Save, DIMENSION(:) :: MyEnvrnFlag
LOGICAL, ALLOCATABLE,Save, DIMENSION(:) :: MyFlag
INTEGER :: CondInletNode ! node number of water inlet node to the condenser
INTEGER :: CondOutletNode
INTEGER :: EvapInletNode
INTEGER :: EvapOutletNode
INTEGER :: HeatRecInNode
INTEGER :: HeatRecOutNode
REAL(r64) :: rho ! local fluid density
REAL(r64) :: mdot ! local mass flow rate
REAL(r64) :: mdotCond ! local mass flow rate for condenser
LOGICAL :: errFlag
INTEGER :: InletNode
INTEGER :: OutletNode
INTEGER :: LoopNum
INTEGER :: LoopSideNum
INTEGER :: BranchIndex
INTEGER :: CompIndex
LOGICAL :: FatalError
! FLOW:
! Do the one time initializations
IF (MyOneTimeFlag) THEN
ALLOCATE(MyFlag(NumEngineDrivenChillers))
ALLOCATE(MyEnvrnFlag(NumEngineDrivenChillers))
MyFlag = .TRUE.
MyEnvrnFlag = .TRUE.
MyOneTimeFlag = .false.
END IF
!Load inputs to local structure
CondInletNode = EngineDrivenChiller(ChillNum)%Base%CondInletNodeNum
CondOutletNode = EngineDrivenChiller(ChillNum)%Base%CondOutletNodeNum
EvapInletNode = EngineDrivenChiller(ChillNum)%Base%EvapInletNodeNum
EvapOutletNode = EngineDrivenChiller(ChillNum)%Base%EvapOutletNodeNum
IF (EngineDrivenChiller(ChillNum)%HeatRecActive) THEN
HeatRecInNode = EngineDrivenChiller(ChillNum)%HeatRecInletNodeNum
HeatRecOutNode = EngineDrivenChiller(ChillNum)%HeatRecOutletNodeNum
ENDIF
! Init more variables
IF (MyFlag(ChillNum)) THEN
! Locate the chillers on the plant loops for later usage
errFlag=.false.
CALL ScanPlantLoopsForObject(EngineDrivenChiller(ChillNum)%Base%Name, &
TypeOf_Chiller_EngineDriven, &
EngineDrivenChiller(ChillNum)%Base%CWLoopNum, &
EngineDrivenChiller(ChillNum)%Base%CWLoopSideNum, &
EngineDrivenChiller(ChillNum)%Base%CWBranchNum, &
EngineDrivenChiller(ChillNum)%Base%CWCompNum, &
LowLimitTemp = EngineDrivenChiller(ChillNum)%TempLowLimitEvapOut, &
InletNodeNumber = EngineDrivenChiller(ChillNum)%Base%EvapInletNodeNum, &
errFlag=errFlag)
IF (EngineDrivenChiller(ChillNum)%Base%CondenserType /= AirCooled .AND. &
EngineDrivenChiller(ChillNum)%Base%CondenserType /= EvapCooled) THEN
CALL ScanPlantLoopsForObject(EngineDrivenChiller(ChillNum)%Base%Name, &
TypeOf_Chiller_EngineDriven, &
EngineDrivenChiller(ChillNum)%Base%CDLoopNum, &
EngineDrivenChiller(ChillNum)%Base%CDLoopSideNum, &
EngineDrivenChiller(ChillNum)%Base%CDBranchNum, &
EngineDrivenChiller(ChillNum)%Base%CDCompNum, &
InletNodeNumber = EngineDrivenChiller(ChillNum)%Base%CondInletNodeNum, &
errFlag=errFlag)
CALL InterConnectTwoPlantLoopSides( EngineDrivenChiller(ChillNum)%Base%CWLoopNum, &
EngineDrivenChiller(ChillNum)%Base%CWLoopSideNum, &
EngineDrivenChiller(ChillNum)%Base%CDLoopNum, &
EngineDrivenChiller(ChillNum)%Base%CDLoopSideNum, &
TypeOf_Chiller_EngineDriven, .TRUE. )
ENDIF
IF (EngineDrivenChiller(ChillNum)%HeatRecActive ) THEN
CALL ScanPlantLoopsForObject(EngineDrivenChiller(ChillNum)%Base%Name, &
TypeOf_Chiller_EngineDriven, &
EngineDrivenChiller(ChillNum)%HRLoopNum, &
EngineDrivenChiller(ChillNum)%HRLoopSideNum, &
EngineDrivenChiller(ChillNum)%HRBranchNum, &
EngineDrivenChiller(ChillNum)%HRCompNum, &
InletNodeNumber = EngineDrivenChiller(ChillNum)%HeatRecInletNodeNum, &
errFlag=errFlag)
CALL InterConnectTwoPlantLoopSides( EngineDrivenChiller(ChillNum)%Base%CWLoopNum, &
EngineDrivenChiller(ChillNum)%Base%CWLoopSideNum, &
EngineDrivenChiller(ChillNum)%HRLoopNum, &
EngineDrivenChiller(ChillNum)%HRLoopSideNum, &
TypeOf_Chiller_EngineDriven , .TRUE. )
ENDIF
MyFlag(ChillNum)=.FALSE.
IF (EngineDrivenChiller(ChillNum)%Base%CondenserType /= AirCooled .AND. &
EngineDrivenChiller(ChillNum)%Base%CondenserType /= EvapCooled .AND. &
EngineDrivenChiller(ChillNum)%HeatRecActive) THEN
CALL InterConnectTwoPlantLoopSides( EngineDrivenChiller(ChillNum)%Base%CDLoopNum, &
EngineDrivenChiller(ChillNum)%Base%CDLoopSideNum, &
EngineDrivenChiller(ChillNum)%HRLoopNum, &
EngineDrivenChiller(ChillNum)%HRLoopSideNum, &
TypeOf_Chiller_EngineDriven, .FALSE. )
ENDIF
IF (errFlag) THEN
CALL ShowFatalError('InitEngineDrivenChiller: Program terminated due to previous condition(s).')
ENDIF
IF (EngineDrivenChiller(ChillNum)%Base%FlowMode == ConstantFlow) THEN
! reset flow priority
PlantLoop(EngineDrivenChiller(ChillNum)%Base%CWLoopNum)%LoopSide(EngineDrivenChiller(ChillNum)%Base%CWLoopSideNum)% &
Branch(EngineDrivenChiller(ChillNum)%Base%CWBranchNum)%Comp(EngineDrivenChiller(ChillNum)%Base%CWCompNum)%FlowPriority &
= LoopFlowStatus_NeedyIfLoopOn
ENDIF
IF (EngineDrivenChiller(ChillNum)%Base%FlowMode == LeavingSetpointModulated) THEN
! reset flow priority
PlantLoop(EngineDrivenChiller(ChillNum)%Base%CWLoopNum)%LoopSide(EngineDrivenChiller(ChillNum)%Base%CWLoopSideNum)% &
Branch(EngineDrivenChiller(ChillNum)%Base%CWBranchNum)%Comp(EngineDrivenChiller(ChillNum)%Base%CWCompNum)%FlowPriority &
= LoopFlowStatus_NeedyIfLoopOn
! check if setpoint on outlet node
IF ((Node(EngineDrivenChiller(ChillNum)%Base%EvapOutletNodeNum)%TempSetPoint == SensedNodeFlagValue) .AND. &
(Node(EngineDrivenChiller(ChillNum)%Base%EvapOutletNodeNum)%TempSetPointHi == SensedNodeFlagValue)) THEN
IF (.NOT. AnyEnergyManagementSystemInModel) THEN
IF (.NOT. EngineDrivenChiller(ChillNum)%Base%ModulatedFlowErrDone) THEN
CALL ShowWarningError('Missing temperature setpoint for LeavingSetpointModulated mode chiller named ' // &
TRIM(EngineDrivenChiller(ChillNum)%Base%Name) )
CALL ShowContinueError(' A temperature setpoint is needed at the outlet node of a chiller ' // &
'in variable flow mode, use a SetpointManager')
CALL ShowContinueError(' The overall loop setpoint will be assumed for chiller. The simulation continues ... ')
EngineDrivenChiller(ChillNum)%Base%ModulatedFlowErrDone = .TRUE.
ENDIF
ELSE
! need call to EMS to check node
FatalError = .FALSE. ! but not really fatal yet, but should be.
CALL CheckIfNodeSetpointManagedByEMS(EngineDrivenChiller(ChillNum)%Base%EvapOutletNodeNum, &
iTemperatureSetpoint, FatalError)
IF (FatalError) THEN
IF (.NOT. EngineDrivenChiller(ChillNum)%Base%ModulatedFlowErrDone) THEN
CALL ShowWarningError('Missing temperature setpoint for LeavingSetpointModulated mode chiller named ' // &
TRIM(EngineDrivenChiller(ChillNum)%Base%Name) )
CALL ShowContinueError(' A temperature setpoint is needed at the outlet node of a chiller evaporator ' // &
'in variable flow mode')
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 ... ')
EngineDrivenChiller(ChillNum)%Base%ModulatedFlowErrDone = .TRUE.
ENDIF
ENDIF
ENDIF
EngineDrivenChiller(ChillNum)%Base%ModulatedFlowSetToLoop = .TRUE.
Node(EngineDrivenChiller(ChillNum)%Base%EvapOutletNodeNum)%TempSetPoint = &
Node(PlantLoop(EngineDrivenChiller(ChillNum)%Base%CWLoopNum)%TempSetPointNodeNum)%TempSetPoint
Node(EngineDrivenChiller(ChillNum)%Base%EvapOutletNodeNum)%TempSetPointHi = &
Node(PlantLoop(EngineDrivenChiller(ChillNum)%Base%CWLoopNum)%TempSetPointNodeNum)%TempSetPointHi
ENDIF
ENDIF
MyFlag(ChillNum)=.FALSE.
ENDIF
!Initialize critical Demand Side Variables
! IF((MyEnvrnFlag(ChillNum) .and. BeginEnvrnFlag) &
! .OR. (Node(CondInletNode)%MassFlowrate <= 0.0 .AND. RunFlag)) THEN
IF(MyEnvrnFlag(ChillNum) .and. BeginEnvrnFlag .AND. (PlantSizesOkayToFinalize)) THEN
IF (PlantSizeNotComplete) CALL SizeEngineDrivenChiller(ChillNum)
rho = GetDensityGlycol(PlantLoop(EngineDrivenChiller(ChillNum)%Base%CWLoopNum)%FluidName, &
InitConvTemp, &
PlantLoop(EngineDrivenChiller(ChillNum)%Base%CWLoopNum)%FluidIndex,&
RoutineName)
EngineDrivenChiller(ChillNum)%Base%EvapMassFlowRateMax = rho * EngineDrivenChiller(ChillNum)%Base%EvapVolFlowRate
CALL InitComponentNodes(0.0D0,EngineDrivenChiller(ChillNum)%Base%EvapMassFlowRateMax, &
EvapInletNode, &
EvapOutletNode, &
EngineDrivenChiller(ChillNum)%Base%CWLoopNum, &
EngineDrivenChiller(ChillNum)%Base%CWLoopSideNum, &
EngineDrivenChiller(ChillNum)%Base%CWBranchNum, &
EngineDrivenChiller(ChillNum)%Base%CWCompNum)
!init maximum available condenser flow rate
IF (EngineDrivenChiller(ChillNum)%Base%CondenserType == WaterCooled) THEN
Node(CondInletNode)%Temp = EngineDrivenChiller(ChillNum)%TempDesCondIn
rho = GetDensityGlycol(PlantLoop(EngineDrivenChiller(ChillNum)%Base%CDLoopNum)%FluidName, &
InitConvTemp, &
PlantLoop(EngineDrivenChiller(ChillNum)%Base%CDLoopNum)%FluidIndex,&
RoutineName)
EngineDrivenChiller(ChillNum)%Base%CondMassFlowRateMax = rho * EngineDrivenChiller(ChillNum)%Base%CondVolFlowRate
CALL InitComponentNodes(0.0D0, EngineDrivenChiller(ChillNum)%Base%CondMassFlowRateMax, &
CondInletNode, &
CondOutletNode, &
EngineDrivenChiller(ChillNum)%Base%CDLoopNum, &
EngineDrivenChiller(ChillNum)%Base%CDLoopSideNum, &
EngineDrivenChiller(ChillNum)%Base%CDBranchNum, &
EngineDrivenChiller(ChillNum)%Base%CDCompNum)
ELSE ! air or evap-air
Node(CondInletNode)%MassFlowRate = EngineDrivenChiller(ChillNum)%Base%CondVolFlowRate * &
PsyRhoAirFnPbTdbW(StdBaroPress,EngineDrivenChiller(ChillNum)%TempDesCondIn,0.0D0,RoutineName)
Node(CondOutletNode)%MassFlowrate = Node(CondInletNode)%MassFlowrate
Node(CondInletNode)%MassFlowRateMaxAvail = Node(CondInletNode)%MassFlowrate
Node(CondInletNode)%MassFlowRateMax = Node(CondInletNode)%MassFlowrate
Node(CondOutletNode)%MassFlowRateMax = Node(CondInletNode)%MassFlowrate
Node(CondInletNode)%MassFlowRateMinAvail = 0.0d0
Node(CondInletNode)%MassFlowRateMin = 0.0d0
Node(CondOutletNode)%MassFlowRateMinAvail = 0.0d0
Node(CondOutletNode)%MassFlowRateMin = 0.0d0
END IF
IF (EngineDrivenChiller(ChillNum)%HeatRecActive) THEN
rho = GetDensityGlycol(PlantLoop(EngineDrivenChiller(ChillNum)%HRLoopNum)%FluidName, &
InitConvTemp, &
PlantLoop(EngineDrivenChiller(ChillNum)%HRLoopNum)%FluidIndex,&
RoutineName)
EngineDrivenChiller(ChillNum)%DesignHeatRecMassFlowRate = rho * &
EngineDrivenChiller(ChillNum)%DesignHeatRecVolFlowRate
CALL InitComponentNodes(0.0D0, EngineDrivenChiller(ChillNum)%DesignHeatRecMassFlowRate , &
EngineDrivenChiller(ChillNum)%HeatRecInletNodeNum, &
EngineDrivenChiller(ChillNum)%HeatRecOutletNodeNum, &
EngineDrivenChiller(ChillNum)%HRLoopNum, &
EngineDrivenChiller(ChillNum)%HRLoopSideNum, &
EngineDrivenChiller(ChillNum)%HRBranchNum, &
EngineDrivenChiller(ChillNum)%HRCompNum)
ENDIF
MyEnvrnFlag(ChillNum) = .FALSE.
END IF
IF (.not. BeginEnvrnFlag) THEN
MyEnvrnFlag(ChillNum)=.true.
ENDIF
IF ((EngineDrivenChiller(ChillNum)%Base%FlowMode == LeavingSetpointModulated) &
.AND. (EngineDrivenChiller(ChillNum)%Base%ModulatedFlowSetToLoop)) THEN
! fix for clumsy old input that worked because loop setpoint was spread.
! could be removed with transition, testing , model change, period of being obsolete.
Node(EngineDrivenChiller(ChillNum)%Base%EvapOutletNodeNum)%TempSetPoint = &
Node(PlantLoop(EngineDrivenChiller(ChillNum)%Base%CWLoopNum)%TempSetPointNodeNum)%TempSetPoint
Node(EngineDrivenChiller(ChillNum)%Base%EvapOutletNodeNum)%TempSetPointHi = &
Node(PlantLoop(EngineDrivenChiller(ChillNum)%Base%CWLoopNum)%TempSetPointNodeNum)%TempSetPointHi
ENDIF
IF ((ABS(MyLoad) > 0.d0) .AND. RunFlag) THEN
mdot = EngineDrivenChiller(ChillNum)%Base%EvapMassFlowRateMax
mdotCond = EngineDrivenChiller(ChillNum)%Base%CondMassFlowRateMax
ELSE
mdot = 0.d0
mdotCond = 0.d0
ENDIF
CALL SetComponentFlowRate( mdot, EvapInletNode, EvapOutletNode, &
EngineDrivenChiller(ChillNum)%Base%CWLoopNum, &
EngineDrivenChiller(ChillNum)%Base%CWLoopSideNum, &
EngineDrivenChiller(ChillNum)%Base%CWBranchNum, &
EngineDrivenChiller(ChillNum)%Base%CWCompNum)
IF (EngineDrivenChiller(ChillNum)%Base%CondenserType == WaterCooled) THEN
CALL SetComponentFlowRate( mdotCond, CondInletNode, CondOutletNode, &
EngineDrivenChiller(ChillNum)%Base%CDLoopNum, &
EngineDrivenChiller(ChillNum)%Base%CDLoopSideNum, &
EngineDrivenChiller(ChillNum)%Base%CDBranchNum, &
EngineDrivenChiller(ChillNum)%Base%CDCompNum)
ENDIF
! Initialize heat recovery flow rates at node
IF (EngineDrivenChiller(ChillNum)%HeatRecActive ) THEN
InletNode = EngineDrivenChiller(ChillNum)%HeatRecInletNodeNum
OutletNode = EngineDrivenChiller(ChillNum)%HeatRecOutletNodeNum
LoopNum = EngineDrivenChiller(ChillNum)%HRLoopNum
LoopSideNum = EngineDrivenChiller(ChillNum)%HRLoopSideNum
BranchIndex = EngineDrivenChiller(ChillNum)%HRBranchNum
CompIndex = EngineDrivenChiller(ChillNum)%HRCompNum
If ( RunFlag ) Then
mdot = EngineDrivenChiller(ChillNum)%DesignHeatRecMassFlowRate
ELSE
mdot = 0.d0
ENDIF
CALL SetComponentFlowRate(mdot,InletNode,OutletNode,LoopNum,LoopSideNum,BranchIndex,CompIndex)
END IF
IF (EngineDrivenChiller(ChillNum)%Base%CondenserType == EvapCooled) THEN
BasinHeaterPower = 0.0d0
ENDIF
RETURN
END SUBROUTINE InitEngineDrivenChiller