SUBROUTINE CalcGTChillerModel(ChillerNum,MyLoad,Runflag,EquipFlowCtrl)
! SUBROUTINE INFORMATION:
! AUTHOR Dan Fisher / Brandon Anderson
! DATE WRITTEN Sept. 2000
! MODIFIED Chandan Sharma, FSEC, February 2010, Added basin heater
! RE-ENGINEERED na
! PURPOSE OF THIS SUBROUTINE:
! simulate a vapor compression chiller using the GT model
! METHODOLOGY EMPLOYED:
! curve fit of performance data:
! REFERENCES:
! 1. BLAST Users Manual
! 2. CHILLER User Manual
! USE STATEMENTS:
USE DataGlobals, ONLY : BeginEnvrnFlag, SecInHour, CurrentTime
USE DataHVACGlobals, ONLY : FirstTimeStepSysFlag, TimeStepSys, SysTimeElapsed
USE General, ONLY : RoundSigDigits, CreateSysTimeIntervalString
USE DataPlant, ONLY : PlantLoop, TypeOf_Chiller_CombTurbine, CompSetPtBasedSchemeType, &
CriteriaType_MassFlowRate, SingleSetpoint, DualSetpointDeadband
USE DataBranchAirLoopPlant, ONLY : ControlType_SeriesActive, MassFlowTolerance
USE DataEnvironment, ONLY : OutDryBulbTemp, EnvironmentName, CurMnDy
USE FluidProperties, ONLY : GetSpecificHeatGlycol
USE PlantUtilities, ONLY : SetComponentFlowRate, PullCompInterconnectTrigger
IMPLICIT NONE
! SUBROUTINE ARGUMENT DEFINITIONS:
INTEGER :: ChillerNum ! chiller number
REAL(r64) :: MyLoad ! operating load
LOGICAL, INTENT(IN) :: RunFlag ! TRUE when chiller operating
INTEGER, INTENT(IN) :: EquipFlowCtrl ! Flow control mode for the equipment
! SUBROUTINE PARAMETER DEFINITIONS:
REAL(r64), PARAMETER :: ExhaustCP = 1.047d0 !Exhaust Gas Specific Heat
CHARACTER(len=*), PARAMETER :: OutputFormat ='(F6.2)'
! INTERFACE BLOCK SPECIFICATIONS
! na
! DERIVED TYPE DEFINITIONS
! na
! SUBROUTINE LOCAL VARIABLE DECLARATIONS:
REAL(r64), DIMENSION(3) :: CapacityRat ! intermediate result: capacity ratio
REAL(r64), DIMENSION(3) :: PowerRat ! intermediate result: power ratio
REAL(r64), DIMENSION(3) :: FullLoadFactor ! intermediate result: full load factor
REAL(r64) :: MinPartLoadRat ! min allowed operating frac full load
REAL(r64) :: MaxPartLoadRat ! max allowed operating frac full load
REAL(r64) :: TempCondIn ! C - (GT ADJTC(1)The design secondary loop fluid
REAL(r64) :: TempCondInDesign ! C - (GT ADJTC(1)The design secondary loop fluid
REAL(r64) :: TempRiseRat ! intermediate result: temperature rise ratio
REAL(r64) :: EvapInletTemp ! C - evaporator inlet temperature, water side
REAL(r64) :: CondInletTemp ! C - condenser inlet temperature, water side
REAL(r64) :: TempEvapOut ! C - evaporator outlet temperature, water side
REAL(r64) :: TempEvapOutSetpoint ! C - evaporator outlet temperature setpoint
REAL(r64) :: TempEvapOutDesign ! design evaporator outlet temperature, water side
REAL(r64) :: ChillerNomCap ! chiller nominal capacity
REAL(r64) :: AvailChillerCap ! chiller available capacity
REAL(r64) :: COP ! coefficient of performance
REAL(r64) :: FracFullLoadPower ! fraction of full load power
REAL(r64) :: EvapDeltaTemp ! C - evaporator temperature difference, water side
REAL(r64) :: DeltaTemp ! C - intermediate result: condenser/evaporator temp diff
REAL(r64) :: AvailNomCapRat ! intermediate result: available nominal capacity ratio
REAL(r64) :: FullLoadPowerRat ! intermediate result: full load power ratio
REAL(r64) :: PartLoadRat ! part load ratio for efficiency calculations
REAL(r64) :: OperPartLoadRat ! Actual Operating PLR
INTEGER :: EvapInletNode ! evaporator inlet node number, water side
INTEGER :: EvapOutletNode ! evaporator outlet node number, water side
INTEGER :: CondInletNode ! condenser inlet node number, water side
INTEGER :: CondOutletNode ! condenser outlet node number, water side
REAL(r64), SAVE :: EvapMassFlowRateMax=0.0d0 ! Max Design Evaporator Mass Flow Rate converted from Volume Flow Rate
REAL(r64) :: TempLowLimitEout ! C - Evaporator low temp. limit cut off
! Special variables for GT Chiller
REAL(r64) :: RPLoad
REAL(r64) :: PLoad
REAL(r64) :: GTEngineCapacity ! Capacity of GT Unit attached to Chiller
REAL(r64) :: MaxExhaustperGTPower ! Maximum Exhaust Flow per KW Power Out
REAL(r64) :: RL
REAL(r64) :: RL2
REAL(r64) :: FuelEnergyIn !(EFUEL) Amount of Fuel Energy Required to run gas turbine
REAL(r64) :: ExhaustFlow !(FEX) Exhaust Gas Flow Rate cubic meters per second
REAL(r64) :: ExhaustTemp !(TEX) Exhaust Gas Temperature in C
REAL(r64) :: QHeatRecLube !(ELUBE) Recoverable Lube Oil Energy (W)
REAL(r64) :: UAtoCapRat !(UACGC) Heat Exchanger UA to Capacity
REAL(r64) :: AmbientDeltaT !(ATAIR) Difference between ambient actual and ambient design temperatures
REAL(r64) :: DesignSteamSatTemp !Saturization Temperature of Steam in Stack
REAL(r64) :: ExhaustStackTemp !Temperature of Exhaust Gases
REAL(r64),SAVE :: TimeStepSysLast=0.0d0 ! last system time step (used to check for downshifting)
REAL(r64) :: CurrentEndTime ! end time of time step for current simulation time step
REAL(r64),SAVE :: CurrentEndTimeLast=0.0d0 ! end time of time step for last simulation time step
CHARACTER(len=6):: OutputChar = ' ' ! character string for warning messages
INTEGER :: HeatRecInNode !Heat Recovery Fluid Inlet Node Num
INTEGER :: HeatRecOutNode !Heat Recovery Fluid Outlet Node Num
REAL(r64) :: HeatRecInTemp !Heat Recovery Fluid Inlet Temperature
REAL(r64) :: HeatRecOutTemp !Heat Recovery Fluid Outlet Temperature
REAL(r64) :: HeatRecMdot !Heat Recovery Fluid Mass FlowRate
REAL(r64) :: HeatRecCp !Specific Heat of the Heat Recovery Fluid
REAL(r64) :: FuelHeatingValue !Heating Value of Fuel in kJ/kg
REAL(r64) :: MinHeatRecMdot !Mass Flow rate that keeps from exceeding max temp
REAL(r64) :: HeatRecRatio !Reduced ratio to multiply recovered heat terms by
REAL(r64) :: FRAC
! LOGICAL,SAVE :: PossibleSubCooling=.FALSE.
INTEGER :: LoopNum
INTEGER :: LoopSideNum
REAL(r64) :: Cp ! local for fluid specif heat, for evaporator
REAL(r64) :: CpCond ! local for fluid specif heat, for condenser
!set module level inlet and outlet nodes
EvapMassFlowRate = 0.0d0
CondMassFlowRate = 0.0d0
Power = 0.0d0
QCondenser = 0.0d0
QEvaporator = 0.0d0
Energy = 0.0d0
CondenserEnergy = 0.0d0
EvaporatorEnergy = 0.0d0
EvapInletNode = GTChiller(ChillerNum)%Base%EvapInletNodeNum
EvapOutletNode = GTChiller(ChillerNum)%Base%EvapOutletNodeNum
CondInletNode = GTChiller(ChillerNum)%Base%CondInletNodeNum
CondOutletNode = GTChiller(ChillerNum)%Base%CondOutletNodeNum
HeatRecInNode = GTChiller(ChillerNum)%HeatRecInletNodeNum
HeatRecOutNode = GTChiller(ChillerNum)%HeatRecOutletNodeNum
QHeatRecLube = 0.0d0
FRAC = 1.0d0
LoopNum = GTChiller(ChillerNum)%Base%CWLoopNum
LoopSideNum = GTChiller(ChillerNum)%Base%CWLoopSideNum
EvapInletTemp = Node(EvapInletNode)%Temp
! calculate end time of current time step
CurrentEndTime = CurrentTime + SysTimeElapsed
! Print warning messages only when valid and only for the first ocurrance. Let summary provide statistics.
! Wait for next time step to print warnings. If simulation iterates, print out
! the warning for the last iteration only. Must wait for next time step to accomplish this.
! If a warning occurs and the simulation down shifts, the warning is not valid.
IF(CurrentEndTime .GT. CurrentEndTimeLast .AND. TimeStepSys .GE. TimeStepSysLast)THEN
IF(GTChiller(ChillerNum)%Base%PrintMessage)THEN
GTChiller(ChillerNum)%Base%MsgErrorCount = &
GTChiller(ChillerNum)%Base%MsgErrorCount + 1
! Show single warning and pass additional info to ShowRecurringWarningErrorAtEnd
IF (GTChiller(ChillerNum)%Base%MsgErrorCount < 2) THEN
CALL ShowWarningError(TRIM(GTChiller(ChillerNum)%Base%MsgBuffer1)//'.')
CALL ShowContinueError(TRIM(GTChiller(ChillerNum)%Base%MsgBuffer2))
ELSE
CALL ShowRecurringWarningErrorAtEnd(TRIM(GTChiller(ChillerNum)%Base%MsgBuffer1)//' error continues.', &
GTChiller(ChillerNum)%Base%ErrCount1,ReportMaxOf=GTChiller(ChillerNum)%Base%MsgDataLast, &
ReportMinOf=GTChiller(ChillerNum)%Base%MsgDataLast,ReportMaxUnits='[C]',ReportMinUnits='[C]')
END IF
END IF
END IF
! save last system time step and last end time of current time step (used to determine if warning is valid)
TimeStepSysLast = TimeStepSys
CurrentEndTimeLast = CurrentEndTime
! If Chiller load is 0 or chiller is not running then leave the subroutine.Before leaving
! if the component control is SERIESACTIVE we set the component flow to inlet flow so that
! flow resolver will not shut down the branch
IF(MyLoad >= 0.d0 .OR. .NOT. RunFlag) THEN
IF(EquipFlowCtrl == ControlType_SeriesActive .OR. PlantLoop(LoopNum)%LoopSide(LoopSideNum)%FlowLock==1) THEN
EvapMassFlowRate = Node(EvapInletNode)%MassFlowrate
ELSE
EvapMassFlowRate = 0.d0
CALL SetComponentFlowRate( EvapMassFlowRate, &
EvapInletNode , EvapOutletNode , &
GTChiller(ChillerNum)%Base%CWLoopNum, &
GTChiller(ChillerNum)%Base%CWLoopSideNum, &
GTChiller(ChillerNum)%Base%CWBranchNum, &
GTChiller(ChillerNum)%Base%CWCompNum)
ENDIF
IF (GTChiller(ChillerNum)%Base%CondenserType == WaterCooled) THEN
IF ( PlantLoop(GTChiller(ChillerNum)%Base%CDLoopNum)% &
LoopSide(GTChiller(ChillerNum)%Base%CDLoopSideNum)% &
Branch(GTChiller(ChillerNum)%Base%CDBranchNum)% &
Comp(GTChiller(ChillerNum)%Base%CDCompNum)%FlowCtrl == ControlType_SeriesActive) THEN
CondMassFlowRate = Node(CondInletNode)%MassFlowrate
ELSE
CondMassFlowRate = 0.d0
CALL SetComponentFlowRate(CondMassFlowRate, CondInletNode, CondOutletNode, &
GTChiller(ChillerNum)%Base%CDLoopNum, &
GTChiller(ChillerNum)%Base%CDLoopSideNum, &
GTChiller(ChillerNum)%Base%CDBranchNum, &
GTChiller(ChillerNum)%Base%CDCompNum)
ENDIF
ENDIF
IF (GTChiller(ChillerNum)%Base%CondenserType == EvapCooled) THEN
CALL CalcBasinHeaterPower(GTChiller(ChillerNum)%Base%BasinHeaterPowerFTempDiff,&
GTChiller(ChillerNum)%Base%BasinHeaterSchedulePtr,&
GTChiller(ChillerNum)%Base%BasinHeaterSetPointTemp,BasinHeaterPower)
ENDIF
GTChiller(ChillerNum)%Base%PrintMessage = .FALSE.
RETURN
END IF
IF (GTChiller(ChillerNum)%Base%CondenserType == AirCooled) THEN !Condenser inlet temp = outdoor temp
Node(CondInletNode)%Temp = Node(CondInletNode)%OutAirDryBulb
! Warn user if entering condenser temperature falls below 0C
IF(Node(CondInletNode)%Temp .LT. 0.0d0 .and. .not. WarmupFlag) THEN
GTChiller(ChillerNum)%Base%PrintMessage = .TRUE.
WRITE(OutputChar,OutputFormat)Node(CondInletNode)%Temp
GTChiller(ChillerNum)%Base%MsgBuffer1 = 'CalcGasTurbineChillerModel - Chiller:CombustionTurbine "' &
//TRIM(GTChiller(ChillerNum)%Base%Name)// &
'" - Air Cooled Condenser Inlet Temperature below 0C'
GTChiller(ChillerNum)%Base%MsgBuffer2 = '... Outdoor Dry-bulb Condition = '//TRIM(OutputChar)// &
' C. Occurrence info = '//TRIM(EnvironmentName)//', '//Trim(CurMnDy)//' '&
//TRIM(CreateSysTimeIntervalString())
GTChiller(ChillerNum)%Base%MsgDataLast = Node(CondInletNode)%Temp
ELSE
GTChiller(ChillerNum)%Base%PrintMessage = .FALSE.
ENDIF
Else IF (GTChiller(ChillerNum)%Base%CondenserType == EvapCooled) THEN !Condenser inlet temp = (outdoor wet bulb)
Node(CondInletNode)%Temp = Node(CondInletNode)%OutAirWetBulb
! Warn user if evap condenser wet bulb temperature falls below 10C
IF(Node(CondInletNode)%Temp .LT. 10.0d0 .and. .not. WarmupFlag) THEN
GTChiller(ChillerNum)%Base%PrintMessage = .TRUE.
WRITE(OutputChar,OutputFormat)Node(CondInletNode)%Temp
GTChiller(ChillerNum)%Base%MsgBuffer1 = 'CalcGasTurbineChillerModel - Chiller:CombustionTurbine "' &
//TRIM(GTChiller(ChillerNum)%Base%Name)// &
'" - Evap Cooled Condenser Inlet Temperature below 10C'
GTChiller(ChillerNum)%Base%MsgBuffer2 = '... Outdoor Wet-bulb Condition = '//TRIM(OutputChar)// &
' C. Occurrence info = '//TRIM(EnvironmentName)//', '//Trim(CurMnDy)//' '&
//TRIM(CreateSysTimeIntervalString())
GTChiller(ChillerNum)%Base%MsgDataLast = Node(CondInletNode)%Temp
ELSE
GTChiller(ChillerNum)%Base%PrintMessage = .FALSE.
ENDIF
ENDIF ! End of the Air Cooled/Evap Cooled Logic block
! If not air or evap cooled then set to the condenser node that is attached to a cooling tower
CondInletTemp = Node(CondInletNode)%Temp
!Set mass flow rates
IF (GTChiller(ChillerNum)%Base%CondenserType == WaterCooled) THEN
CondMassFlowRate = GTChiller(ChillerNum)%Base%CondMassFlowRateMax
CALL SetComponentFlowRate(CondMassFlowRate, CondInletNode, CondOutletNode, &
GTChiller(ChillerNum)%Base%CDLoopNum, &
GTChiller(ChillerNum)%Base%CDLoopSideNum, &
GTChiller(ChillerNum)%Base%CDBranchNum, &
GTChiller(ChillerNum)%Base%CDCompNum)
CALL PullCompInterconnectTrigger(GTChiller(ChillerNum)%Base%CWLoopNum, &
GTChiller(ChillerNum)%Base%CWLoopSideNum, &
GTChiller(ChillerNum)%Base%CWBranchNum, &
GTChiller(ChillerNum)%Base%CWCompNum, &
GTChiller(ChillerNum)%Base%CondMassFlowIndex, &
GTChiller(ChillerNum)%Base%CDLoopNum, &
GTChiller(ChillerNum)%Base%CDLoopSideNum, &
CriteriaType_MassFlowRate, &
CondMassFlowRate)
IF (CondMassFlowRate < MassFlowTolerance) RETURN
END IF
! LOAD LOCAL VARIABLES FROM DATA STRUCTURE (for code readability)
CapacityRat = GTChiller(ChillerNum)%CapRatCoef
PowerRat = GTChiller(ChillerNum)%PowerRatCoef
FullLoadFactor = GTChiller(ChillerNum)%FullLoadCoef
MinPartLoadRat = GTChiller(ChillerNum)%MinPartLoadRat
MaxPartLoadRat = GTChiller(ChillerNum)%MaxPartLoadRat
TempCondInDesign = GTChiller(ChillerNum)%TempDesCondIn
TempRiseRat = GTChiller(ChillerNum)%TempRiseCoef
TempEvapOutDesign = GTChiller(ChillerNum)%TempDesEvapOut
ChillerNomCap = GTChiller(ChillerNum)%Base%NomCap
COP = GTChiller(ChillerNum)%Base%COP
TempCondIn = Node(GTChiller(ChillerNum)%Base%CondInletNodeNum)%Temp
TempEvapOut = Node(GTChiller(ChillerNum)%Base%EvapOutletNodeNum)%Temp
TempLowLimitEout = GTChiller(ChillerNum)%TempLowLimitEvapOut
EvapMassFlowRateMax = GTChiller(ChillerNum)%Base%EvapMassFlowRateMax
LoopNum = GTChiller(ChillerNum)%Base%CWLoopNum
LoopSideNum = GTChiller(ChillerNum)%Base%CWLoopSideNum
!*********************************
!Calculate chiller performance from this set of performance equations.
! from BLAST...Z=(TECONDW-ADJTC(1))/ADJTC(2)-(TLCHLRW-ADJTC(3))
DeltaTemp= (TempCondIn - TempCondInDesign) / TempRiseRat &
- (TempEvapOut - TempEvapOutDesign)
! from BLAST...RCAV=RCAVC(1)+RCAVC(2)*Z+RCAVC(3)*Z**2
AvailNomCapRat = CapacityRat(1) &
+ CapacityRat(2) * DeltaTemp &
+ CapacityRat(3) * DeltaTemp ** 2
AvailChillerCap = ChillerNomCap*AvailNomCapRat
! from BLAST...G=ADJEC(1)+ADJEC(2)*RCAV+ADJEC(3)*RCAV**2.
FullLoadPowerRat= PowerRat(1) &
+ PowerRat(2) * AvailNomCapRat &
+ PowerRat(3) * AvailNomCapRat ** 2
! from BLAST...RCLOAD=AMAX1(MINCHFR(I,IPLCTR),AMIN1(CHLRLOAD(I)/CHLROCAP(I) &
! /RCAV,MAXCHFR(I,IPLCTR)))
IF (AvailChillerCap > 0.0d0) THEN
PartLoadRat = MAX(MinPartLoadRat, MIN(ABS(MyLoad)/AvailChillerCap,MaxPartLoadRat))
ENDIF
! from BLAST...RPOWER=RPWRC(1)+RPWRC(2)*RCLOAD+RPWRC(3)*RCLOAD**2
FracFullLoadPower = FullLoadFactor(1) &
+ FullLoadFactor(2) * PartLoadRat &
+ FullLoadFactor(3) * PartLoadRat ** 2
IF (AvailChillerCap > 0.0d0) THEN
IF(ABS(MyLoad)/AvailChillerCap .LT. MinPartLoadRat) THEN
OperPartLoadRat = ABS(MyLoad)/AvailChillerCap
ELSE
OperPartLoadRat = PartLoadRat
END IF
ELSE
OperPartLoadRat = 0.0d0
ENDIF
!*********************************
Cp = GetSpecificHeatGlycol(PlantLoop(GTChiller(ChillerNum)%Base%CWLoopNum)%FluidName, &
Node(EvapInletNode)%Temp, &
PlantLoop(GTChiller(ChillerNum)%Base%CWLoopNum)%FluidIndex, &
'CalcGTChillerModel')
! If FlowLock is True, the new resolved mdot is used to update Power, QEvap, Qcond, and
! condenser side outlet temperature.
IF (PlantLoop(LoopNum)%LoopSide(LoopSideNum)%FlowLock==0) THEN
GTChiller(ChillerNum)%Base%PossibleSubCooling =.FALSE.
QEvaporator = AvailChillerCap * OperPartLoadRat
IF (OperPartLoadRat .LT. MinPartLoadRat) THEN
FRAC = MIN(1.0d0,(OperPartLoadRat/MinPartLoadRat))
ELSE
FRAC = 1.0d0
END IF
Power = FracFullLoadPower * FullLoadPowerRat * AvailChillerCap/COP * FRAC
! Either set the flow to the Constant value or caluclate the flow for the variable volume
IF ((GTChiller(ChillerNum)%Base%FlowMode == ConstantFlow) &
.OR. (GTChiller(ChillerNum)%Base%FlowMode == NotModulated )) THEN
! Start by assuming max (design) flow
EvapMassFlowRate = EvapMassFlowRateMax
! Use SetComponentFlowRate to decide actual flow
Call SetComponentFlowRate( EvapMassFlowRate, &
EvapInletNode , EvapOutletNode , &
GTChiller(ChillerNum)%Base%CWLoopNum, &
GTChiller(ChillerNum)%Base%CWLoopSideNum, &
GTChiller(ChillerNum)%Base%CWBranchNum, &
GTChiller(ChillerNum)%Base%CWCompNum)
! Evaluate delta temp based on actual flow rate
IF (EvapMassFlowRate /= 0.0D0) THEN
EvapDeltaTemp = QEvaporator/EvapMassFlowRate/Cp
ELSE
EvapDeltaTemp = 0.0D0
ENDIF
! Evaluate outlet temp based on delta
EvapOutletTemp = Node(EvapInletNode)%Temp - EvapDeltaTemp
ELSE IF (GTChiller(ChillerNum)%Base%FlowMode == LeavingSetpointModulated) THEN
! Calculate the Delta Temp from the inlet temp to the chiller outlet setpoint
SELECT CASE (PlantLoop(GTChiller(ChillerNum)%Base%CWLoopNum)%LoopDemandCalcScheme)
CASE (SingleSetpoint)
EvapDeltaTemp = Node(EvapInletNode)%Temp - Node(EvapOutletNode)%TempSetPoint
CASE (DualSetpointDeadband)
EvapDeltaTemp = Node(EvapInletNode)%Temp - Node(EvapOutletNode)%TempSetPointHi
END SELECT
IF (EvapDeltaTemp /= 0) THEN
! Calculate desired flow to request based on load
EvapMassFlowRate = ABS(QEvaporator/Cp/EvapDeltaTemp)
IF((EvapMassFlowRate - EvapMassFlowRateMax) .GT. MassFlowTolerance) &
GTChiller(ChillerNum)%Base%PossibleSubCooling = .TRUE.
!Check to see if the Maximum is exceeded, if so set to maximum
EvapMassFlowRate = MIN(EvapMassFlowRateMax, EvapMassFlowRate)
! Use SetComponentFlowRate to decide actual flow
Call SetComponentFlowRate( EvapMassFlowRate, &
EvapInletNode , EvapOutletNode , &
GTChiller(ChillerNum)%Base%CWLoopNum, &
GTChiller(ChillerNum)%Base%CWLoopSideNum, &
GTChiller(ChillerNum)%Base%CWBranchNum, &
GTChiller(ChillerNum)%Base%CWCompNum)
SELECT CASE (PlantLoop(GTChiller(ChillerNum)%Base%CWLoopNum)%LoopDemandCalcScheme)
CASE (SingleSetpoint)
EvapOutletTemp = Node(EvapOutletNode)%TempSetPoint
CASE (DualSetpointDeadband)
EvapOutletTemp = Node(EvapOutletNode)%TempSetPointHi
END SELECT
ELSE
! Try to request zero flow
EvapMassFlowRate=0.0d0
! Use SetComponentFlowRate to decide actual flow
Call SetComponentFlowRate( EvapMassFlowRate, &
EvapInletNode , EvapOutletNode , &
GTChiller(ChillerNum)%Base%CWLoopNum, &
GTChiller(ChillerNum)%Base%CWLoopSideNum, &
GTChiller(ChillerNum)%Base%CWBranchNum, &
GTChiller(ChillerNum)%Base%CWCompNum)
! No deltaT since component is not running
EvapOutletTemp = Node(EvapInletNode)%Temp
END IF
End If !End of Constant Variable Flow If Block
ELSE ! If FlowLock is True
EvapMassFlowRate = Node(EvapInletNode)%MassFlowRate
Call SetComponentFlowRate( EvapMassFlowRate, &
EvapInletNode , EvapOutletNode , &
GTChiller(ChillerNum)%Base%CWLoopNum, &
GTChiller(ChillerNum)%Base%CWLoopSideNum, &
GTChiller(ChillerNum)%Base%CWBranchNum, &
GTChiller(ChillerNum)%Base%CWCompNum)
! Some other component set the flow to 0. No reason to continue with calculations.
IF(EvapMassFlowRate == 0.0d0)THEN
MyLoad = 0.0d0
IF (GTChiller(ChillerNum)%Base%CondenserType == EvapCooled) THEN
CALL CalcBasinHeaterPower(GTChiller(ChillerNum)%Base%BasinHeaterPowerFTempDiff,&
GTChiller(ChillerNum)%Base%BasinHeaterSchedulePtr,&
GTChiller(ChillerNum)%Base%BasinHeaterSetPointTemp,BasinHeaterPower)
ENDIF
GTChiller(ChillerNum)%Base%PrintMessage = .FALSE.
RETURN
END IF
IF(GTChiller(ChillerNum)%Base%PossibleSubCooling) THEN
QEvaporator = ABS(MyLoad)
EvapDeltaTemp = QEvaporator/EvapMassFlowRate/Cp
EvapOutletTemp = Node(EvapInletNode)%Temp - EvapDeltaTemp
ELSE !No subcooling in this case.No recalculation required.Still need to check chiller low temp limit
SELECT CASE (PlantLoop(LoopNum)%LoopDemandCalcScheme)
CASE (SingleSetpoint)
IF ((GTChiller(ChillerNum)%Base%FlowMode == LeavingSetpointModulated) .OR. &
(PlantLoop(LoopNum)%LoopSide(LoopSideNum)%Branch(GTChiller(ChillerNum)%Base%CWBranchNum) &
%Comp(GTChiller(ChillerNum)%Base%CWCompNum)%CurOpSchemeType &
== CompSetPtBasedSchemeType) .OR. &
(Node(EvapOutletNode)%TempSetPoint /= SensedNodeFlagValue) ) THEN
TempEvapOutSetpoint = Node(EvapOutletNode)%TempSetPoint
ELSE
TempEvapOutSetpoint = Node(PlantLoop(LoopNum)%TempSetPointNodeNum)%TempSetPoint
ENDIF
CASE (DualSetpointDeadband)
IF ((GTChiller(ChillerNum)%Base%FlowMode == LeavingSetpointModulated) .OR. &
(PlantLoop(LoopNum)%LoopSide(LoopSideNum)%Branch(GTChiller(ChillerNum)%Base%CWBranchNum) &
%Comp(GTChiller(ChillerNum)%Base%CWCompNum)%CurOpSchemeType &
== CompSetPtBasedSchemeType) .OR. &
(Node(EvapOutletNode)%TempSetPointHi /= SensedNodeFlagValue) ) THEN
TempEvapOutSetpoint = Node(EvapOutletNode)%TempSetPointHi
ELSE
TempEvapOutSetpoint = Node(PlantLoop(LoopNum)%TempSetPointNodeNum)%TempSetPointHi
ENDIF
END SELECT
EvapDeltaTemp = Node(EvapInletNode)%Temp - TempEvapOutSetpoint
QEvaporator = ABS(EvapMassFlowRate*Cp*EvapDeltaTemp)
EvapOutletTemp = TempEvapOutSetpoint
END IF
!Check that the Evap outlet temp honors both plant loop temp low limit and also the chiller low limit
IF(EvapOutletTemp .LT. TempLowLimitEout) THEN
IF((Node(EvapInletNode)%Temp - TempLowLimitEout) .GT. DeltaTempTol) THEN
EvapOutletTemp = TempLowLimitEout
EvapDeltaTemp = Node(EvapInletNode)%Temp - EvapOutletTemp
QEvaporator = EvapMassFlowRate*Cp*EvapDeltaTemp
ELSE
EvapOutletTemp = Node(EvapInletNode)%Temp
EvapDeltaTemp = Node(EvapInletNode)%Temp - EvapOutletTemp
QEvaporator = EvapMassFlowRate*Cp*EvapDeltaTemp
END IF
END IF
IF(EvapOutletTemp .LT. Node(EvapOutletNode)%TempMin) THEN
IF((Node(EvapInletNode)%Temp - Node(EvapOutletNode)%TempMin) .GT. DeltaTempTol) THEN
EvapOutletTemp = Node(EvapOutletNode)%TempMin
EvapDeltaTemp = Node(EvapInletNode)%Temp - EvapOutletTemp
QEvaporator = EvapMassFlowRate*Cp*EvapDeltaTemp
ELSE
EvapOutletTemp = Node(EvapInletNode)%Temp
EvapDeltaTemp = Node(EvapInletNode)%Temp - EvapOutletTemp
QEvaporator = EvapMassFlowRate*Cp*EvapDeltaTemp
END IF
END IF
! If load exceeds the distributed load set to the distributed load
If(QEvaporator > ABS(MyLoad)) Then
If(EvapMassFlowRate > MassFlowTolerance) THEN
QEvaporator = ABS(MyLoad)
EvapDeltaTemp = QEvaporator/EvapMassFlowRate/Cp
EvapOutletTemp = Node(EvapInletNode)%Temp - EvapDeltaTemp
Else
QEvaporator = 0.0d0
EvapOutletTemp = Node(EvapInletNode)%Temp
End If
End IF
! Checks QEvaporator on the basis of the machine limits.
If(QEvaporator > (AvailChillerCap * MaxPartLoadRat))Then
If(EvapMassFlowRate > MassFlowTolerance) THEN
QEvaporator = AvailChillerCap * PartLoadRat
EvapDeltaTemp = QEvaporator/EvapMassFlowRate/Cp
EvapOutletTemp = Node(EvapInletNode)%Temp - EvapDeltaTemp
Else
QEvaporator = 0.0d0
EvapOutletTemp = Node(EvapInletNode)%Temp
End If
End If
IF (OperPartLoadRat .LT. MinPartLoadRat) THEN
FRAC = MIN(1.0d0,(OperPartLoadRat/MinPartLoadRat))
ELSE
FRAC = 1.0d0
END IF
! set the module level variable used for reporting FRAC
ChillerCyclingRatio = FRAC
! Chiller is false loading below PLR = minimum unloading ratio, find PLR used for energy calculation
Power = FracFullLoadPower * FullLoadPowerRat * AvailChillerCap /COP * FRAC
IF(EvapMassFlowRate == 0.0d0) THEN
QEvaporator = 0.0d0
EvapOutletTemp = Node(EvapInletNode)%Temp
Power = 0.0d0
GTChiller(ChillerNum)%Base%PrintMessage = .FALSE.
END IF
IF(QEvaporator == 0.0d0 .AND. GTChiller(ChillerNum)%Base%CondenserType == EvapCooled) THEN
CALL CalcBasinHeaterPower(GTChiller(ChillerNum)%Base%BasinHeaterPowerFTempDiff,&
GTChiller(ChillerNum)%Base%BasinHeaterSchedulePtr,&
GTChiller(ChillerNum)%Base%BasinHeaterSetPointTemp,BasinHeaterPower)
END IF
END IF !This is the end of the FlowLock Block
!Now determine Cooling
!QCondenser is calculated the same for each type, but the power consumption should be different
! depending on the performance coefficients used for the chiller model.
QCondenser = Power + QEvaporator
IF (GTChiller(ChillerNum)%Base%CondenserType == WaterCooled) THEN
IF (CondMassFlowRate > MassFlowTolerance) THEN
CpCond = GetSpecificHeatGlycol(PlantLoop(GTChiller(ChillerNum)%Base%CDLoopNum)%FluidName, &
CondInletTemp, &
PlantLoop(GTChiller(ChillerNum)%Base%CDLoopNum)%FluidIndex, &
'CalcGTChillerModel')
CondOutletTemp = QCondenser/CondMassFlowRate/CpCond + CondInletTemp
ELSE
CALL ShowSevereError('CalcGasTurbineChillerModel: Condenser flow = 0, for GasTurbineChiller='// &
TRIM(GTChiller(ChillerNum)%Base%Name))
CALL ShowContinueErrorTimeStamp(' ')
END IF
ELSE !Air Cooled or Evap Cooled
!don't care about outlet temp for Air-Cooled or Evap Cooled and there is no CondMassFlowRate and would divide by zero
CondOutletTemp = CondInletTemp
END IF
!Special GT Chiller Variables
! Gas Turbine Driven Portion of the Chiller:
GTEngineCapacity = GTChiller(ChillerNum)%GTEngineCapacity
MaxExhaustperGTPower = GTChiller(ChillerNum)%MaxExhaustperGTPower
!Note: All Old Blast Code comments begin at left.
!D COMPUTE TOWER CLOAD
! ETOWER(TypeIndex) = PREQD + CHLRLOAD(TypeIndex)
! RPLOAD = PREQD/CHLROCAP(TypeIndex)
!
! IF (RFLAGS(81)) WRITE (OUTPUT,703) PREQD,ETOWER(TypeIndex),RPLOAD
! IF (PREQD .GT. 0.0d0) THEN
IF (AvailChillerCap >0)THEN
RPLoad = Power / AvailChillerCap
ELSE
RPLoad = 0.0d0
END IF
IF (Power > 0) THEN
!D$ FOR EACH CHILLER OPERATING
! MAXSZ = NUMCHSIZ(TypeIndex,IPLCTR)
! DO IS = 1,MAXSZ
!
! NUMOPR = CHLRIOPR(IS,TypeIndex)
! IF (NUMOPR.GT.0) THEN
!
! PLOAD = CHNOMCAP(IS,TypeIndex,IPLCTR) * RPLOAD
PLoad = ChillerNomCap * RPLoad
!
!D$ COMPUTE FUEL AND WASTE HEAT
!
! TEX IS CALCULATED USING COEFFICIENTS TEX2GC( ) TO RESULT IN TEMP.
! DEGREES ACTUAL, HENCE THE NECESSARY CONVERSION ?-273.?
!
! RLOAD=AMAX1(PLOAD/CHLROCAP(TypeIndex),MINCHFR(TypeIndex,IPLCTR))
! RLD2 = RLOAD**2
! RL = MAX(PLoad/GTEngineCapacity, MinPartLoadRat * ChillerNomCap)
RL = MAX(PLoad/ChillerNomCap, MinPartLoadRat)
RL2 = RL**2
! ATAIR = DELTA TEMPERATURE. ACTUAL - 25 DEG.C (77 DEG.F)
! RATING POINT
! ATAIR = ODB - 25.
! TAR2=ATAIR**2
! ??? Not sure about this Ambient Actual Temp - also do we need to have design ambient as input?
IF (GTChiller(ChillerNum)%Base%CondenserType == WaterCooled) THEN
AmbientDeltaT = OutDryBulbTemp - 25.d0
ELSE ! air or evap cooled
AmbientDeltaT = Node(CondInletNode)%OutAirDryBulb - 25.d0
ENDIF
! EFUEL=PLOAD*(FUL1GC(1,IPLCTR)+FUL1GC(2,IPLCTR)* &
! RLOAD+FUL1GC(3,IPLCTR)*RLD2)* &
! (FUL2GC(1,IPLCTR)+FUL2GC(2,IPLCTR)*ATAIR+ &
! FUL2GC(3,IPLCTR)*TAR2)
FuelEnergyIn = PLoad * (GTChiller(ChillerNum)%PLBasedFuelInputCoef(1) + &
GTChiller(ChillerNum)%PLBasedFuelInputCoef(2)*RL + &
GTChiller(ChillerNum)%PLBasedFuelInputCoef(3)*RL2) &
* (GTChiller(ChillerNum)%TempBasedFuelInputCoef(1) + &
GTChiller(ChillerNum)%TempBasedFuelInputCoef(2)*AmbientDeltaT + &
GTChiller(ChillerNum)%TempBasedFuelInputCoef(3)*AmbientDeltaT**2)
! FEX=GTDSLCAP(IS,TypeIndex,IPLCTR)*(FEXGC(1,IPLCTR)+ &
! FEXGC(2,IPLCTR)*ATAIR+FEXGC(3,IPLCTR)*TAR2)
ExhaustFlow = GTEngineCapacity * (GTChiller(ChillerNum)%ExhaustFlowCoef(1) + &
GTChiller(ChillerNum)%ExhaustFlowCoef(2) * AmbientDeltaT + &
GTChiller(ChillerNum)%ExhaustFlowCoef(3) * AmbientDeltaT**2)
! TEX=(TEX1GC(1,IPLCTR)+TEX1GC(2,IPLCTR)*RLOAD+ &
! TEX1GC(3,IPLCTR)*RLD2)*(TEX2GC(1,IPLCTR)+ &
! TEX2GC(2,IPLCTR)*ATAIR+TEX2GC(3,IPLCTR)* &
! TAR2)-273.
ExhaustTemp = (GTChiller(ChillerNum)%PLBasedExhaustTempCoef(1) + &
GTChiller(ChillerNum)%PLBasedExhaustTempCoef(2)*RL + &
GTChiller(ChillerNum)%PLBasedExhaustTempCoef(3)*RL2) &
* (GTChiller(ChillerNum)%TempBasedExhaustTempCoef(1) + &
GTChiller(ChillerNum)%TempBasedExhaustTempCoef(2)*AmbientDeltaT + &
GTChiller(ChillerNum)%TempBasedExhaustTempCoef(3)*AmbientDeltaT**2) - 273
! UAG=UACGC(1,IPLCTR)*GTDSLCAP(IS,TypeIndex,IPLCTR)** &
! UACGC(2,IPLCTR)
IF (PLoad /= 0.0d0)THEN
UAtoCapRat = GTChiller(ChillerNum)%UAtoCapCoef(1) * GTEngineCapacity ** &
GTChiller(ChillerNum)%UAtoCapCoef(2)
! TSTACK = EXHAUST STACK TEMPERATURE, C.
!
! TSTACK=TSATUR(IPLCTR)+(TEX-TSATUR(IPLCTR))/ &
! EXP(UAG/(AMAX1(FEX,RMXKGC(IPLCTR)* &
! GTDSLCAP(IS,TypeIndex,IPLCTR)) * 1.047))
DesignSteamSatTemp = GTChiller(ChillerNum)%DesignSteamSatTemp
ExhaustStackTemp = DesignSteamSatTemp + (ExhaustTemp - DesignSteamSatTemp) / &
EXP(UAtoCapRat/(MAX(ExhaustFlow, MaxExhaustperGTPower * GTEngineCapacity) * ExhaustCP))
! EEX = AMAX1 ( FEX*1.047*(TEX-TSTACK),0.0d0)
! ELUBE=PLOAD*(ELUBEGC(1,IPLCTR)+ELUBEGC(2,IPLCTR) &
! *RLOAD+ELUBEGC(3,IPLCTR)*RLD2 )
END IF
IF (GTChiller(ChillerNum)%HeatRecActive) THEN
QHeatRecLube = PLoad * (GTChiller(ChillerNum)%HeatRecLubeEnergyCoef(1) + &
GTChiller(ChillerNum)%HeatRecLubeEnergyCoef(2)*RL + &
GTChiller(ChillerNum)%HeatRecLubeEnergyCoef(3)*RL2)
ELSE
QHeatRecLube = 0.0d0
End If
! CHLRFUEL(TypeIndex) = CHLRFUEL(TypeIndex) + EFUEL * NUMOPR
! EEXGC = EEXGC + EEX * NUMOPR
! ELBEGC = ELBEGC + ELUBE * NUMOPR
!
!Heat Recovery Loop - lube recovered heat
! If lube is not present, then the energy should be 0 at this point
! Thigh = Energy / (Mdot*Cp) + Tlow
!Need to set the HeatRecRatio to 1.0 if it is not modified
HeatRecRatio= 1.0d0
IF (GTChiller(ChillerNum)%HeatRecActive) THEN
!This mdot is input specified mdot "Desired Flowrate", already set at node in init routine
HeatRecMdot = Node(HeatRecInNode)%MassFlowRate
HeatRecInTemp = Node(HeatRecInNode)%Temp
HeatRecCp = GetSpecificHeatGlycol(PlantLoop(GTChiller(ChillerNum)%HRLoopNum)%FluidName, &
HeatRecInTemp, &
PlantLoop(GTChiller(ChillerNum)%HRLoopNum)%FluidIndex, &
'ChillerHeatRecovery')
!Don't divide by zero
IF ((HeatRecMdot .GT. 0) .AND. (HeatRecCp .GT. 0)) THEN
HeatRecOutTemp = (QHeatRecLube)/(HeatRecMdot * HeatRecCp) + HeatRecInTemp
ELSE
HeatRecOutTemp = HeatRecInTemp
END IF
!Now verify that the design flowrate was large enough to prevent phase change
IF(HeatRecOutTemp > GTChiller(ChillerNum)%HeatRecMaxTemp) THEN
IF(GTChiller(ChillerNum)%HeatRecMaxTemp /= HeatRecInTemp)THEN
MinHeatRecMdot = (QHeatRecLube)/(HeatRecCp * (GTChiller(ChillerNum)%HeatRecMaxTemp - HeatRecInTemp))
If(MinHeatRecMdot < 0.0d0) MinHeatRecMdot = 0.0d0
END IF
!Recalculate Outlet Temperature, with adjusted flowrate
IF ((MinHeatRecMdot .GT. 0.0d0) .AND. (HeatRecCp .GT. 0.0d0)) THEN
HeatRecOutTemp = (QHeatRecLube)/(MinHeatRecMdot * HeatRecCp) + HeatRecInTemp
HeatRecRatio = HeatRecMdot/MinHeatRecMdot
ELSE
HeatRecOutTemp = HeatRecInTemp
HeatRecRatio = 0.0d0
END IF
End If
QHeatRecLube = QHeatRecLube*HeatRecRatio
ELSE
HeatRecInTemp=0.0d0
HeatRecMDot=0.0d0
HeatRecCp=0.0d0
HeatRecOutTemp=0.0d0
ENDIF
END IF
GTChiller(ChillerNum)%HeatRecInletTemp = HeatRecInTemp
GTChiller(ChillerNum)%HeatRecOutletTemp = HeatRecOutTemp
GTChiller(ChillerNum)%HeatRecMdot = HeatRecMdot
GTChiller(ChillerNum)%HeatRecLubeEnergy = QHeatRecLube*(TimeStepSys*SecInHour)
GTChiller(ChillerNum)%HeatRecLubeRate = QHeatRecLube
GTChiller(ChillerNum)%FuelEnergyIn = ABS(FuelEnergyIn)
FuelHeatingValue = GTChiller(ChillerNum)%FuelHeatingValue
GTChillerReport(ChillerNum)%FuelMassUsedRate = ABS(FuelEnergyIn)/(FuelHeatingValue * KJtoJ)
GTChiller(ChillerNum)%ExhaustStackTemp = ExhaustStackTemp
!Calculate Energy
CondenserEnergy = QCondenser*TimeStepSys*SecInHour
Energy = Power*TimeStepSys*SecInHour
EvaporatorEnergy = QEvaporator*TimeStepSys*SecInHour
!check for problems BG 9/12/06 (deal with observed negative energy results)
IF (Energy < 0.0d0) then ! there is a serious problem
IF (GTChiller(ChillerNum)%Base%CondenserType == WaterCooled) THEN
! first check for run away condenser loop temps (only reason yet to be observed for this?)
IF (CondInletTemp > 70.0d0 ) then
CALL ShowSevereError('CalcGTChillerModel: Condenser loop inlet temperatures over 70.0 C for GTChiller='// &
TRIM(GTChiller(ChillerNum)%Base%Name))
CALL ShowContinueErrorTimeStamp(' ')
CALL ShowContinueError('Condenser loop water temperatures are too high at'//trim(RoundSigDigits(CondInletTemp,2)) )
CALL ShowContinueError('Check input for condenser plant loop, especially cooling tower')
CALL showContinueError('Evaporator inlet temperature: '//trim(RoundSigDigits(Node(EvapInletNode)%Temp,2)) )
CALL ShowFatalError('Program Terminates due to previous error condition')
ENDIF
ENDIF
IF(.NOT.WarmupFlag)THEN
If (AvailNomCapRat < 0.0d0 ) then ! apparently the real reason energy goes negative
CALL ShowSevereError('CalcGTChillerModel: Capacity ratio below zero for GTChiller='// &
TRIM(GTChiller(ChillerNum)%Base%Name))
CALL ShowContinueErrorTimeStamp(' ')
CALL ShowContinueError('Check input for Capacity Ratio Curve')
CALL showContinueError('Condenser inlet temperature: '//trim(RoundSigDigits(CondInletTemp,2)) )
CALL showContinueError('Evaporator inlet temperature: '//trim(RoundSigDigits(Node(EvapInletNode)%Temp,2)) )
CALL ShowFatalError('Program Terminates due to previous error condition')
ENDIF
ENDIF
! If makes it here, set limits, chiller can't have negative energy/power
! proceeding silently for now but may want to throw error here
Power = 0.0d0
Energy = 0.0d0
ENDIF
RETURN
END SUBROUTINE CalcGTChillerModel