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 InitGTChiller(ChillNum,RunFlag, MyLoad)
! SUBROUTINE INFORMATION:
! AUTHOR Fred Buhl
! DATE WRITTEN November 2003
! MODIFIED na
! RE-ENGINEERED na
! PURPOSE OF THIS SUBROUTINE:
! This subroutine is for initializations of the Gas Turbine 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_CombTurbine, ScanPlantLoopsForObject, &
PlantSizeNotComplete, PlantSizesOkayToFinalize, 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='InitGTChiller'
! 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 ! node number of water outlet node from the condenser
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
INTEGER :: InletNode
INTEGER :: OutletNode
INTEGER :: LoopNum
INTEGER :: LoopSideNum
INTEGER :: BranchIndex
INTEGER :: CompIndex
LOGICAL :: FatalError
LOGICAL :: errFlag
! FLOW:
! Do the one time initializations
IF (MyOneTimeFlag) THEN
ALLOCATE(MyFlag(NumGTChillers))
ALLOCATE(MyEnvrnFlag(NumGTChillers))
MyFlag = .TRUE.
MyEnvrnFlag = .TRUE.
MyOneTimeFlag = .false.
END IF
CondInletNode = GTChiller(ChillNum)%Base%CondInletNodeNum
CondOutletNode = GTChiller(ChillNum)%Base%CondOutletNodeNum
EvapInletNode = GTChiller(ChillNum)%Base%EvapInletNodeNum
EvapOutletNode = GTChiller(ChillNum)%Base%EvapOutletNodeNum
IF (GTChiller(ChillNum)%HeatRecActive) THEN
HeatRecInNode = GTChiller(ChillNum)%HeatRecInletNodeNum
HeatRecOutNode = GTChiller(ChillNum)%HeatRecOutletNodeNum
ENDIF
! Init more variables
IF (MyFlag(ChillNum)) THEN
! Locate the chillers on the plant loops for later usage
errFlag=.false.
CALL ScanPlantLoopsForObject(GTChiller(ChillNum)%Base%Name, &
TypeOf_Chiller_CombTurbine, &
GTChiller(ChillNum)%Base%CWLoopNum, &
GTChiller(ChillNum)%Base%CWLoopSideNum, &
GTChiller(ChillNum)%Base%CWBranchNum, &
GTChiller(ChillNum)%Base%CWCompNum, &
LowLimitTemp = GTChiller(ChillNum)%TempLowLimitEvapOut , &
InletNodeNumber = GTChiller(ChillNum)%Base%EvapInletNodeNum, &
errFlag=errFlag)
IF (GTChiller(ChillNum)%Base%CondenserType /= AirCooled .AND. &
GTChiller(ChillNum)%Base%CondenserType /= EvapCooled) THEN
CALL ScanPlantLoopsForObject(GTChiller(ChillNum)%Base%Name, &
TypeOf_Chiller_CombTurbine, &
GTChiller(ChillNum)%Base%CDLoopNum, &
GTChiller(ChillNum)%Base%CDLoopSideNum, &
GTChiller(ChillNum)%Base%CDBranchNum, &
GTChiller(ChillNum)%Base%CDCompNum, &
InletNodeNumber = GTChiller(ChillNum)%Base%CondInletNodeNum, &
errFlag=errFlag)
CALL InterConnectTwoPlantLoopSides( GTChiller(ChillNum)%Base%CWLoopNum, &
GTChiller(ChillNum)%Base%CWLoopSideNum, &
GTChiller(ChillNum)%Base%CDLoopNum, &
GTChiller(ChillNum)%Base%CDLoopSideNum, &
TypeOf_Chiller_CombTurbine, .TRUE. )
ENDIF
IF (GTChiller(ChillNum)%HeatRecActive) THEN
CALL ScanPlantLoopsForObject(GTChiller(ChillNum)%Base%Name, &
TypeOf_Chiller_CombTurbine, &
GTChiller(ChillNum)%HRLoopNum, &
GTChiller(ChillNum)%HRLoopSideNum, &
GTChiller(ChillNum)%HRBranchNum, &
GTChiller(ChillNum)%HRCompNum, &
InletNodeNumber = GTChiller(ChillNum)%HeatRecInletNodeNum, &
errFlag=errFlag)
CALL InterConnectTwoPlantLoopSides( GTChiller(ChillNum)%Base%CWLoopNum, &
GTChiller(ChillNum)%Base%CWLoopSideNum, &
GTChiller(ChillNum)%HRLoopNum, &
GTChiller(ChillNum)%HRLoopSideNum, &
TypeOf_Chiller_CombTurbine , .TRUE. )
ENDIF
IF (GTChiller(ChillNum)%Base%CondenserType /= AirCooled .AND. &
GTChiller(ChillNum)%Base%CondenserType /= EvapCooled .AND. &
GTChiller(ChillNum)%HeatRecActive) THEN
CALL InterConnectTwoPlantLoopSides( GTChiller(ChillNum)%Base%CDLoopNum, &
GTChiller(ChillNum)%Base%CDLoopSideNum, &
GTChiller(ChillNum)%HRLoopNum, &
GTChiller(ChillNum)%HRLoopSideNum, &
TypeOf_Chiller_CombTurbine, .FALSE. )
ENDIF
IF (errFlag) THEN
CALL ShowFatalError('InitGTChiller: Program terminated due to previous condition(s).')
ENDIF
IF (GTChiller(ChillNum)%Base%FlowMode == ConstantFlow) THEN
! reset flow priority
PlantLoop(GTChiller(ChillNum)%Base%CWLoopNum)%LoopSide(GTChiller(ChillNum)%Base%CWLoopSideNum)% &
Branch(GTChiller(ChillNum)%Base%CWBranchNum)%Comp(GTChiller(ChillNum)%Base%CWCompNum)%FlowPriority &
= LoopFlowStatus_NeedyIfLoopOn
ENDIF
IF (GTChiller(ChillNum)%Base%FlowMode == LeavingSetpointModulated) THEN
! reset flow priority
PlantLoop(GTChiller(ChillNum)%Base%CWLoopNum)%LoopSide(GTChiller(ChillNum)%Base%CWLoopSideNum)% &
Branch(GTChiller(ChillNum)%Base%CWBranchNum)%Comp(GTChiller(ChillNum)%Base%CWCompNum)%FlowPriority &
= LoopFlowStatus_NeedyIfLoopOn
! check if setpoint on outlet node
IF ((Node(GTChiller(ChillNum)%Base%EvapOutletNodeNum)%TempSetPoint == SensedNodeFlagValue) .AND. &
(Node(GTChiller(ChillNum)%Base%EvapOutletNodeNum)%TempSetPointHi == SensedNodeFlagValue)) THEN
IF (.NOT. AnyEnergyManagementSystemInModel) THEN
IF (.NOT. GTChiller(ChillNum)%Base%ModulatedFlowErrDone) THEN
CALL ShowWarningError('Missing temperature setpoint for LeavingSetpointModulated mode chiller named ' // &
TRIM(GTChiller(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 ... ')
GTChiller(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(GTChiller(ChillNum)%Base%EvapOutletNodeNum,iTemperatureSetpoint, FatalError)
IF (FatalError) THEN
IF (.NOT. GTChiller(ChillNum)%Base%ModulatedFlowErrDone) THEN
CALL ShowWarningError('Missing temperature setpoint for LeavingSetpointModulated mode chiller named ' // &
TRIM(GTChiller(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 ... ')
GTChiller(ChillNum)%Base%ModulatedFlowErrDone = .TRUE.
ENDIF
ENDIF
ENDIF
GTChiller(ChillNum)%Base%ModulatedFlowSetToLoop = .TRUE.
Node(GTChiller(ChillNum)%Base%EvapOutletNodeNum)%TempSetPoint = &
Node(PlantLoop(GTChiller(ChillNum)%Base%CWLoopNum)%TempSetPointNodeNum)%TempSetPoint
Node(GTChiller(ChillNum)%Base%EvapOutletNodeNum)%TempSetPointHi = &
Node(PlantLoop(GTChiller(ChillNum)%Base%CWLoopNum)%TempSetPointNodeNum)%TempSetPointHi
ENDIF
ENDIF
MyFlag(ChillNum)=.FALSE.
ENDIF
IF(MyEnvrnFlag(ChillNum) .and. BeginEnvrnFlag .AND. (PlantSizesOkayToFinalize)) THEN
IF (PlantSizeNotComplete) CALL SizeGTChiller(ChillNum)
rho = GetDensityGlycol(PlantLoop(GTChiller(ChillNum)%Base%CWLoopNum)%FluidName, &
InitConvTemp, &
PlantLoop(GTChiller(ChillNum)%Base%CWLoopNum)%FluidIndex,&
RoutineName)
GTChiller(ChillNum)%Base%EvapMassFlowRateMax = rho * GTChiller(ChillNum)%Base%EvapVolFlowRate
CALL InitComponentNodes(0.0D0,GTChiller(ChillNum)%Base%EvapMassFlowRateMax, &
EvapInletNode, &
EvapOutletNode, &
GTChiller(ChillNum)%Base%CWLoopNum, &
GTChiller(ChillNum)%Base%CWLoopSideNum, &
GTChiller(ChillNum)%Base%CWBranchNum, &
GTChiller(ChillNum)%Base%CWCompNum)
!init maximum available condenser flow rate
IF (GTChiller(ChillNum)%Base%CondenserType == WaterCooled) THEN
Node(CondInletNode)%Temp = GTChiller(ChillNum)%TempDesCondIn
rho = GetDensityGlycol(PlantLoop(GTChiller(ChillNum)%Base%CDLoopNum)%FluidName, &
InitConvTemp, &
PlantLoop(GTChiller(ChillNum)%Base%CDLoopNum)%FluidIndex,&
RoutineName)
GTChiller(ChillNum)%Base%CondMassFlowRateMax = rho * GTChiller(ChillNum)%Base%CondVolFlowRate
CALL InitComponentNodes(0.0D0, GTChiller(ChillNum)%Base%CondMassFlowRateMax, &
CondInletNode, &
CondOutletNode, &
GTChiller(ChillNum)%Base%CDLoopNum, &
GTChiller(ChillNum)%Base%CDLoopSideNum, &
GTChiller(ChillNum)%Base%CDBranchNum, &
GTChiller(ChillNum)%Base%CDCompNum)
ELSE ! air or evap-air
Node(CondInletNode)%MassFlowRate = GTChiller(ChillNum)%Base%CondVolFlowRate * &
PsyRhoAirFnPbTdbW(StdBaroPress,GTChiller(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 (GTChiller(ChillNum)%HeatRecActive) THEN
rho = GetDensityGlycol(PlantLoop(GTChiller(ChillNum)%HRLoopNum)%FluidName, &
InitConvTemp, &
PlantLoop(GTChiller(ChillNum)%HRLoopNum)%FluidIndex,&
RoutineName)
GTChiller(ChillNum)%DesignHeatRecMassFlowRate = rho * &
GTChiller(ChillNum)%DesignHeatRecVolFlowRate
CALL InitComponentNodes(0.0D0, GTChiller(ChillNum)%DesignHeatRecMassFlowRate , &
GTChiller(ChillNum)%HeatRecInletNodeNum, &
GTChiller(ChillNum)%HeatRecOutletNodeNum, &
GTChiller(ChillNum)%HRLoopNum, &
GTChiller(ChillNum)%HRLoopSideNum, &
GTChiller(ChillNum)%HRBranchNum, &
GTChiller(ChillNum)%HRCompNum)
ENDIF
MyEnvrnFlag(ChillNum) = .FALSE.
END IF
IF (.not. BeginEnvrnFlag) THEN
MyEnvrnFlag(ChillNum)=.true.
ENDIF
IF ( (GTChiller(ChillNum)%Base%FlowMode == LeavingSetpointModulated) &
.AND. (GTChiller(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(GTChiller(ChillNum)%Base%EvapOutletNodeNum)%TempSetPoint = &
Node(PlantLoop(GTChiller(ChillNum)%Base%CWLoopNum)%TempSetPointNodeNum)%TempSetPoint
Node(GTChiller(ChillNum)%Base%EvapOutletNodeNum)%TempSetPointHi = &
Node(PlantLoop(GTChiller(ChillNum)%Base%CWLoopNum)%TempSetPointNodeNum)%TempSetPointHi
ENDIF
IF ((ABS(MyLoad) > 0.d0) .AND. RunFlag) THEN
mdot = GTChiller(ChillNum)%Base%EvapMassFlowRateMax
mdotCond = GTChiller(ChillNum)%Base%CondMassFlowRateMax
ELSE
mdot = 0.d0
mdotCond = 0.d0
ENDIF
CALL SetComponentFlowRate( mdot, EvapInletNode, EvapOutletNode, &
GTChiller(ChillNum)%Base%CWLoopNum, &
GTChiller(ChillNum)%Base%CWLoopSideNum, &
GTChiller(ChillNum)%Base%CWBranchNum, &
GTChiller(ChillNum)%Base%CWCompNum)
IF (GTChiller(ChillNum)%Base%CondenserType == WaterCooled) THEN
CALL SetComponentFlowRate( mdotCond, CondInletNode, CondOutletNode, &
GTChiller(ChillNum)%Base%CDLoopNum, &
GTChiller(ChillNum)%Base%CDLoopSideNum, &
GTChiller(ChillNum)%Base%CDBranchNum, &
GTChiller(ChillNum)%Base%CDCompNum)
ENDIF
! Initialize heat recovery flow rates at node
IF (GTChiller(ChillNum)%HeatRecActive ) THEN
InletNode = GTChiller(ChillNum)%HeatRecInletNodeNum
OutletNode = GTChiller(ChillNum)%HeatRecOutletNodeNum
LoopNum = GTChiller(ChillNum)%HRLoopNum
LoopSideNum = GTChiller(ChillNum)%HRLoopSideNum
BranchIndex = GTChiller(ChillNum)%HRBranchNum
CompIndex = GTChiller(ChillNum)%HRCompNum
IF ( RunFlag ) THEN
mdot = GTChiller(ChillNum)%DesignHeatRecMassFlowRate
ELSE
mdot = 0.d0
ENDIF
CALL SetComponentFlowRate(mdot,InletNode,OutletNode,LoopNum,LoopSideNum,BranchIndex,CompIndex)
END IF
IF (GTChiller(ChillNum)%Base%CondenserType == EvapCooled) THEN
BasinHeaterPower = 0.0d0
ENDIF
RETURN
END SUBROUTINE InitGTChiller