SUBROUTINE CalcEngineDrivenChillerModel(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 EngineDriven 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 CurveManager, ONLY : CurveValue
USE General, ONLY : RoundSigDigits, CreateSysTimeIntervalString
USE DataPlant, ONLY : PlantLoop, TypeOf_Chiller_EngineDriven, CompSetPtBasedSchemeType, &
CriteriaType_MassFlowRate, SingleSetpoint, DualSetpointDeadband
USE DataBranchAirLoopPlant, ONLY : ControlType_SeriesActive, MassFlowTolerance
USE DataEnvironment, ONLY : 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) :: FlowLock ! TRUE when flow resolver has calculated branch flow
INTEGER, INTENT(IN) :: EquipFlowCtrl ! Flow control mode for the equipment
! SUBROUTINE PARAMETER DEFINITIONS:
REAL(r64), PARAMETER :: ExhaustCP = 1.047d0 !Exhaust Gas Specific Heat (J/kg-K)
REAL(r64), PARAMETER :: ReferenceTemp = 25.0d0 !Reference temperature by which lower heating
! value is reported. This should be subtracted
! off of when calculated exhaust energies.
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 - (EngineDriven ADJTC(1)The design secondary loop fluid
REAL(r64) :: TempCondInDesign ! C - (EngineDriven 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
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) :: EvapMassFlowRateMax ! Max Design Evaporator Mass Flow Rate converted from Volume Flow Rate
REAL(r64) :: TempLowLimitEout ! C - Evaporator low temp. limit cut off
REAL(r64) :: FRAC
INTEGER :: LoopNum
INTEGER :: LoopSideNum
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
REAL(r64) :: Cp ! local for fluid specif heat, for evaporator
REAL(r64) :: CpCond ! local for fluid specif heat, for condenser
! Special variables for EngineDriven Chiller
REAL(r64) :: MaxExhaustperPowerOutput !curve fit parameter
REAL(r64) :: ClngLoadFuelRat !(RELDC) Ratio of Shaft Power to Fuel Energy Input
REAL(r64) :: RecJacHeattoFuelRat !(RJACDC) Ratio of Recoverable Jacket Heat to Fuel Energy Input
REAL(r64) :: RecLubeHeattoFuelRat !(RLUBDC) Ratio of Recoverable Lube Oil Heat to Fuel Energy Input
REAL(r64) :: TotExhausttoFuelRat !(REXDC) Total Exhaust Energy Input to Fuel Energy Input
REAL(r64) :: TotalExhaustEnergy
REAL(r64) :: ExhaustTemp !(TEX) Exhaust Gas Temp
REAL(r64) :: ExhaustGasFlow !exhaust gas mass flow rate
REAL(r64) :: DesignMinExitGasTemp
REAL(r64) :: UA !(UACDC) exhaust gas Heat Exchanger UA
REAL(r64) :: HeatRecCp !Specific Heat of the Heat Recovery Fluid (J/kg-K)
REAL(r64) :: EngineDrivenFuelEnergy
REAL(r64) :: HeatRecRatio !When Max Temp is reached the amount of recovered heat has to be reduced.
! LOGICAL,SAVE :: PossibleSubCooling=.FALSE.
!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
HeatRecCp = 0.0d0
HeatRecMdotActual = 0.0d0
QTotalHeatRecovered = 0.0d0
QJacketRecovered = 0.0d0
QLubeOilRecovered = 0.0d0
QExhaustRecovered = 0.0d0
EngineDrivenFuelEnergy = 0.0d0
FuelEnergyUseRate = 0.0d0
TotalHeatEnergyRec = 0.0d0
JacketEnergyRec = 0.0d0
LubeOilEnergyRec = 0.0d0
ExhaustEnergyRec = 0.0d0
FuelEnergy = 0.0d0
FuelMdot = 0.0d0
ExhaustStackTemp = 0.0d0
FRAC = 1.0d0
IF (EngineDrivenChiller(ChillerNum)%HeatRecActive) THEN
HeatRecInletTemp = Node(EngineDrivenChiller(ChillerNum)%HeatRecInletNodeNum)%Temp
HeatRecOutletTemp = Node(EngineDrivenChiller(ChillerNum)%HeatRecInletNodeNum)%Temp
HeatRecMdotDesign = EngineDrivenChiller(ChillerNum)%DesignHeatRecMassFlowRate
ENDIF
EvapInletNode = EngineDrivenChiller(ChillerNum)%Base%EvapInletNodeNum
EvapOutletNode = EngineDrivenChiller(ChillerNum)%Base%EvapOutletNodeNum
CondInletNode = EngineDrivenChiller(ChillerNum)%Base%CondInletNodeNum
CondOutletNode = EngineDrivenChiller(ChillerNum)%Base%CondOutletNodeNum
LoopNum = EngineDrivenChiller(ChillerNum)%Base%CWLoopNum
LoopSideNum = EngineDrivenChiller(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(EngineDrivenChiller(ChillerNum)%Base%PrintMessage)THEN
EngineDrivenChiller(ChillerNum)%Base%MsgErrorCount = &
EngineDrivenChiller(ChillerNum)%Base%MsgErrorCount + 1
! Show single warning and pass additional info to ShowRecurringWarningErrorAtEnd
IF (EngineDrivenChiller(ChillerNum)%Base%MsgErrorCount < 2) THEN
CALL ShowWarningError(TRIM(EngineDrivenChiller(ChillerNum)%Base%MsgBuffer1)//'.')
CALL ShowContinueError(TRIM(EngineDrivenChiller(ChillerNum)%Base%MsgBuffer2))
ELSE
CALL ShowRecurringWarningErrorAtEnd(TRIM(EngineDrivenChiller(ChillerNum)%Base%MsgBuffer1)//' error continues.', &
EngineDrivenChiller(ChillerNum)%Base%ErrCount1,ReportMaxOf=EngineDrivenChiller(ChillerNum)%Base%MsgDataLast, &
ReportMinOf=EngineDrivenChiller(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.
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 , &
EngineDrivenChiller(ChillerNum)%Base%CWLoopNum, &
EngineDrivenChiller(ChillerNum)%Base%CWLoopSideNum, &
EngineDrivenChiller(ChillerNum)%Base%CWBranchNum, &
EngineDrivenChiller(ChillerNum)%Base%CWCompNum)
ENDIF
IF (EngineDrivenChiller(ChillerNum)%Base%CondenserType == WaterCooled) THEN
IF ( PlantLoop(EngineDrivenChiller(ChillerNum)%Base%CDLoopNum)% &
LoopSide(EngineDrivenChiller(ChillerNum)%Base%CDLoopSideNum)% &
Branch(EngineDrivenChiller(ChillerNum)%Base%CDBranchNum)% &
Comp(EngineDrivenChiller(ChillerNum)%Base%CDCompNum)%FlowCtrl == ControlType_SeriesActive) THEN
CondMassFlowRate = Node(CondInletNode)%MassFlowrate
ELSE
CondMassFlowRate = 0.d0
CALL SetComponentFlowRate(CondMassFlowRate, CondInletNode, CondOutletNode, &
EngineDrivenChiller(ChillerNum)%Base%CDLoopNum, &
EngineDrivenChiller(ChillerNum)%Base%CDLoopSideNum, &
EngineDrivenChiller(ChillerNum)%Base%CDBranchNum, &
EngineDrivenChiller(ChillerNum)%Base%CDCompNum)
ENDIF
ENDIF
IF (EngineDrivenChiller(ChillerNum)%Base%CondenserType == EvapCooled) THEN
CALL CalcBasinHeaterPower(EngineDrivenChiller(ChillerNum)%Base%BasinHeaterPowerFTempDiff,&
EngineDrivenChiller(ChillerNum)%Base%BasinHeaterSchedulePtr,&
EngineDrivenChiller(ChillerNum)%Base%BasinHeaterSetPointTemp,BasinHeaterPower)
ENDIF
EngineDrivenChiller(ChillerNum)%Base%PrintMessage = .FALSE.
RETURN
END IF
IF (EngineDrivenChiller(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
EngineDrivenChiller(ChillerNum)%Base%PrintMessage = .TRUE.
WRITE(OutputChar,OutputFormat)Node(CondInletNode)%Temp
EngineDrivenChiller(ChillerNum)%Base%MsgBuffer1 = 'CalcEngineDrivenChillerModel - Chiller:EngineDriven "' &
//TRIM(EngineDrivenChiller(ChillerNum)%Base%Name)// &
'" - Air Cooled Condenser Inlet Temperature below 0C'
EngineDrivenChiller(ChillerNum)%Base%MsgBuffer2 = '... Outdoor Dry-bulb Condition = '//TRIM(OutputChar)// &
' C. Occurrence info = '//TRIM(EnvironmentName)//', '//Trim(CurMnDy)//' '&
//TRIM(CreateSysTimeIntervalString())
EngineDrivenChiller(ChillerNum)%Base%MsgDataLast = Node(CondInletNode)%Temp
ELSE
EngineDrivenChiller(ChillerNum)%Base%PrintMessage = .FALSE.
ENDIF
Else IF (EngineDrivenChiller(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
EngineDrivenChiller(ChillerNum)%Base%PrintMessage = .TRUE.
WRITE(OutputChar,OutputFormat)Node(CondInletNode)%Temp
EngineDrivenChiller(ChillerNum)%Base%MsgBuffer1 = 'CalcEngineDrivenChillerModel - Chiller:EngineDriven "' &
//TRIM(EngineDrivenChiller(ChillerNum)%Base%Name)// &
'" - Evap Cooled Condenser Inlet Temperature below 10C'
EngineDrivenChiller(ChillerNum)%Base%MsgBuffer2 = '... Outdoor Wet-bulb Condition = '//TRIM(OutputChar)// &
' C. Occurrence info = '//TRIM(EnvironmentName)//', '//Trim(CurMnDy)//' '&
//TRIM(CreateSysTimeIntervalString())
EngineDrivenChiller(ChillerNum)%Base%MsgDataLast = Node(CondInletNode)%Temp
ELSE
EngineDrivenChiller(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 (EngineDrivenChiller(ChillerNum)%Base%CondenserType == WaterCooled) THEN
CondMassFlowRate = EngineDrivenChiller(ChillerNum)%Base%CondMassFlowRateMax
CALL SetComponentFlowRate(CondMassFlowRate, CondInletNode, CondOutletNode, &
EngineDrivenChiller(ChillerNum)%Base%CDLoopNum, &
EngineDrivenChiller(ChillerNum)%Base%CDLoopSideNum, &
EngineDrivenChiller(ChillerNum)%Base%CDBranchNum, &
EngineDrivenChiller(ChillerNum)%Base%CDCompNum)
CALL PullCompInterconnectTrigger(EngineDrivenChiller(ChillerNum)%Base%CWLoopNum, &
EngineDrivenChiller(ChillerNum)%Base%CWLoopSideNum, &
EngineDrivenChiller(ChillerNum)%Base%CWBranchNum, &
EngineDrivenChiller(ChillerNum)%Base%CWCompNum, &
EngineDrivenChiller(ChillerNum)%Base%CondMassFlowIndex, &
EngineDrivenChiller(ChillerNum)%Base%CDLoopNum, &
EngineDrivenChiller(ChillerNum)%Base%CDLoopSideNum, &
CriteriaType_MassFlowRate, &
CondMassFlowRate)
IF (CondMassFlowRate < MassFlowTolerance) RETURN
END IF
! LOAD LOCAL VARIABLES FROM DATA STRUCTURE (for code readability)
CapacityRat = EngineDrivenChiller(ChillerNum)%CapRatCoef
PowerRat = EngineDrivenChiller(ChillerNum)%PowerRatCoef
FullLoadFactor = EngineDrivenChiller(ChillerNum)%FullLoadCoef
MinPartLoadRat = EngineDrivenChiller(ChillerNum)%MinPartLoadRat
MaxPartLoadRat = EngineDrivenChiller(ChillerNum)%MaxPartLoadRat
TempCondInDesign = EngineDrivenChiller(ChillerNum)%TempDesCondIn
TempRiseRat = EngineDrivenChiller(ChillerNum)%TempRiseCoef
TempEvapOutDesign = EngineDrivenChiller(ChillerNum)%TempDesEvapOut
ChillerNomCap = EngineDrivenChiller(ChillerNum)%Base%NomCap
COP = EngineDrivenChiller(ChillerNum)%Base%COP
TempCondIn = Node(EngineDrivenChiller(ChillerNum)%Base%CondInletNodeNum)%Temp
TempEvapOut = Node(EngineDrivenChiller(ChillerNum)%Base%EvapOutletNodeNum)%Temp
TempLowLimitEout = EngineDrivenChiller(ChillerNum)%TempLowLimitEvapOut
MaxExhaustperPowerOutput = EngineDrivenChiller(ChillerNum)%MaxExhaustperPowerOutput
LoopNum = EngineDrivenChiller(ChillerNum)%Base%CWLoopNum
LoopSideNum = EngineDrivenChiller(ChillerNum)%Base%CWLoopSideNum
EvapMassFlowRateMax = EngineDrivenChiller(ChillerNum)%Base%EvapMassFlowRateMax
!*********************************
!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(EngineDrivenChiller(ChillerNum)%Base%CWLoopNum)%FluidName, &
Node(EvapInletNode)%Temp, &
PlantLoop(EngineDrivenChiller(ChillerNum)%Base%CWLoopNum)%FluidIndex, &
'CalcEngineDrivenChillerModel')
! 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
EngineDrivenChiller(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 ((EngineDrivenChiller(ChillerNum)%Base%FlowMode == ConstantFlow) &
.OR. (EngineDrivenChiller(ChillerNum)%Base%FlowMode == NotModulated)) THEN
! Start by assuming max (design) flow
EvapMassFlowRate = EvapMassFlowRateMax
! Use SetComponentFlowRate to decide actual flow
Call SetComponentFlowRate( EvapMassFlowRate, &
EvapInletNode , EvapOutletNode , &
EngineDrivenChiller(ChillerNum)%Base%CWLoopNum, &
EngineDrivenChiller(ChillerNum)%Base%CWLoopSideNum, &
EngineDrivenChiller(ChillerNum)%Base%CWBranchNum, &
EngineDrivenChiller(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 (EngineDrivenChiller(ChillerNum)%Base%FlowMode == LeavingSetpointModulated ) THEN
! Calculate the Delta Temp from the inlet temp to the chiller outlet setpoint
SELECT CASE (PlantLoop(EngineDrivenChiller(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
EvapMassFlowRate = ABS(QEvaporator/Cp/EvapDeltaTemp)
IF((EvapMassFlowRate - EvapMassFlowRateMax) .GT. MassFlowTolerance) &
EngineDrivenChiller(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 , &
EngineDrivenChiller(ChillerNum)%Base%CWLoopNum, &
EngineDrivenChiller(ChillerNum)%Base%CWLoopSideNum, &
EngineDrivenChiller(ChillerNum)%Base%CWBranchNum, &
EngineDrivenChiller(ChillerNum)%Base%CWCompNum)
SELECT CASE (PlantLoop(EngineDrivenChiller(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 , &
EngineDrivenChiller(ChillerNum)%Base%CWLoopNum, &
EngineDrivenChiller(ChillerNum)%Base%CWLoopSideNum, &
EngineDrivenChiller(ChillerNum)%Base%CWBranchNum, &
EngineDrivenChiller(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 , &
EngineDrivenChiller(ChillerNum)%Base%CWLoopNum, &
EngineDrivenChiller(ChillerNum)%Base%CWLoopSideNum, &
EngineDrivenChiller(ChillerNum)%Base%CWBranchNum, &
EngineDrivenChiller(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 (EngineDrivenChiller(ChillerNum)%Base%CondenserType == EvapCooled) THEN
CALL CalcBasinHeaterPower(EngineDrivenChiller(ChillerNum)%Base%BasinHeaterPowerFTempDiff,&
EngineDrivenChiller(ChillerNum)%Base%BasinHeaterSchedulePtr,&
EngineDrivenChiller(ChillerNum)%Base%BasinHeaterSetPointTemp,BasinHeaterPower)
ENDIF
EngineDrivenChiller(ChillerNum)%Base%PrintMessage = .FALSE.
RETURN
END IF
IF(EngineDrivenChiller(ChillerNum)%Base%PossibleSubCooling) THEN
QEvaporator = ABS(MyLoad)
EvapDeltaTemp = QEvaporator/EvapMassFlowRate/Cp
EvapOutletTemp = Node(EvapInletNode)%Temp - EvapDeltaTemp
IF(EvapOutletTemp .LT. Node(EvapOutletNode)%TempMin) THEN
EvapOutletTemp = Node(EvapOutletNode)%TempMin
EvapDeltaTemp = Node(EvapInletNode)%Temp - EvapOutletTemp
QEvaporator = ABS(EvapMassFlowRate*Cp*EvapDeltaTemp)
END IF
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 ((EngineDrivenChiller(ChillerNum)%Base%FlowMode == LeavingSetpointModulated) .OR. &
(PlantLoop(LoopNum)%LoopSide(LoopSideNum)%Branch(EngineDrivenChiller(ChillerNum)%Base%CWBranchNum) &
%Comp(EngineDrivenChiller(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 ((EngineDrivenChiller(ChillerNum)%Base%FlowMode == LeavingSetpointModulated) .OR. &
(PlantLoop(LoopNum)%LoopSide(LoopSideNum)%Branch(EngineDrivenChiller(ChillerNum)%Base%CWBranchNum) &
%Comp(EngineDrivenChiller(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 * OperPartLoadRat
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
EngineDrivenChiller(ChillerNum)%Base%PrintMessage = .FALSE.
END IF
IF(QEvaporator == 0.0d0 .AND. EngineDrivenChiller(ChillerNum)%Base%CondenserType == EvapCooled) THEN
CALL CalcBasinHeaterPower(EngineDrivenChiller(ChillerNum)%Base%BasinHeaterPowerFTempDiff,&
EngineDrivenChiller(ChillerNum)%Base%BasinHeaterSchedulePtr,&
EngineDrivenChiller(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 (EngineDrivenChiller(ChillerNum)%Base%CondenserType == WaterCooled) THEN
IF (CondMassFlowRate > MassFlowTolerance) THEN
CpCond = GetSpecificHeatGlycol(PlantLoop(EngineDrivenChiller(ChillerNum)%Base%CDLoopNum)%FluidName, &
CondInletTemp, &
PlantLoop(EngineDrivenChiller(ChillerNum)%Base%CDLoopNum)%FluidIndex, &
'CalcEngineDrivenChillerModel')
CondOutletTemp = QCondenser/CondMassFlowRate/CpCond + CondInletTemp
ELSE
CALL ShowSevereError('CalcEngineDrivenChillerModel: Condenser flow = 0, for EngineDrivenChiller='// &
TRIM(EngineDrivenChiller(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
CondOutletTemp = CondInletTemp
END IF
! EngineDriven Portion of the Engine Driven Chiller:
!DETERMINE FUEL CONSUMED AND AVAILABLE WASTE HEAT
!Use Curve fit to determine Fuel Energy Input. For electric power generated in Watts, the fuel
!energy input is calculated in J/s. The PLBasedFuelInputCurve selects ratio of fuel flow (J/s)/cooling load (J/s).
IF (PartLoadRat == 0)THEN
EngineDrivenFuelEnergy = 0.0d0
ELSE
PartLoadRat = MAX(MinPartLoadRat,PartLoadRat)
ClngLoadFuelRat = CurveValue(EngineDrivenChiller(ChillerNum)%ClngLoadtoFuelCurve, PartLoadRat)
EngineDrivenFuelEnergy = QEvaporator / ClngLoadFuelRat
END IF
!Use Curve fit to determine energy recovered in the water jacket. This curve calculates the water jacket energy recovered (J/s) by
!multiplying the total fuel input (J/s) by the fraction of that power that could be recovered in the water jacket at that
!particular part load.
RecJacHeattoFuelRat = CurveValue(EngineDrivenChiller(ChillerNum)%RecJacHeattoFuelCurve, PartLoadRat)
QJacketRecovered = EngineDrivenFuelEnergy * RecJacHeattoFuelRat
!Use Curve fit to determine Heat Recovered Lubricant Energy. This curve calculates the lube energy recovered (J/s) by
!multiplying the total fuel input (J/s) by the fraction of that power that could be recovered in the lube oil at that
!particular part load.
RecLubeHeattoFuelRat = CurveValue(EngineDrivenChiller(ChillerNum)%RecLubeHeattoFuelCurve, PartLoadRat)
QLubeOilRecovered = EngineDrivenFuelEnergy * RecLubeHeattoFuelRat
!Use Curve fit to determine Heat Recovered from the exhaust. This curve calculates the energy recovered (J/s) by
!multiplying the total fuel input (J/s) by the fraction of that power that could be recovered in the exhaust at that
!particular part load.
TotExhausttoFuelRat = CurveValue(EngineDrivenChiller(ChillerNum)%TotExhausttoFuelCurve, PartLoadRat)
TotalExhaustEnergy = EngineDrivenFuelEnergy * TotExhausttoFuelRat
!Use Curve fit to determine Exhaust Temperature in C. The temperature is simply a curve fit
!of the exhaust temperature in C to the part load ratio.
IF (PartLoadRat /= 0)THEN
ExhaustTemp = CurveValue(EngineDrivenChiller(ChillerNum)%ExhaustTempCurve, PartLoadRat)
ExhaustGasFlow = TotalExhaustEnergy / (ExhaustCP*(ExhaustTemp-ReferenceTemp))
!Use Curve fit to determine stack temp after heat recovery
UA = EngineDrivenChiller(ChillerNum)%UACoef(1) * ChillerNomCap ** &
EngineDrivenChiller(ChillerNum)%UACoef(2)
DesignMinExitGasTemp = EngineDrivenChiller(ChillerNum)%DesignMinExitGasTemp
ExhaustStackTemp = DesignMinExitGasTemp + (ExhaustTemp - DesignMinExitGasTemp) / &
EXP(UA/(MAX(ExhaustGasFlow, MaxExhaustperPowerOutput * ChillerNomCap) * ExhaustCP))
QExhaustRecovered = MAX(ExhaustGasFlow*ExhaustCP*(ExhaustTemp-ExhaustStackTemp),0.0d0)
ELSE
QExhaustRecovered = 0.0d0
END IF
QTotalHeatRecovered = QExhaustRecovered + QLubeOilRecovered + QJacketRecovered
!Update Heat Recovery temperatures
IF (EngineDrivenChiller(ChillerNum)%HeatRecActive) THEN
CALL CalcEngineChillerHeatRec(ChillerNum,QTotalHeatRecovered,HeatRecRatio)
QExhaustRecovered = QExhaustRecovered*HeatRecRatio
QLubeOilRecovered = QLubeOilRecovered*HeatRecRatio
QJacketRecovered = QJacketRecovered*HeatRecRatio
ENDIF
!Calculate Energy
CondenserEnergy = QCondenser*TimeStepSys*SecInHour
Energy = Power*TimeStepSys*SecInHour
EvaporatorEnergy = QEvaporator*TimeStepSys*SecInHour
FuelEnergyUseRate = EngineDrivenFuelEnergy
FuelEnergy = FuelEnergyUseRate*TimeStepSys*SecInHour
JacketEnergyRec = QJacketRecovered*TimeStepSys*SecInHour
LubeOilEnergyRec = QLubeOilRecovered*TimeStepSys*SecInHour
ExhaustEnergyRec = QExhaustRecovered*TimeStepSys*SecInHour
QTotalHeatRecovered = QExhaustRecovered + QLubeOilRecovered + QJacketRecovered
TotalHeatEnergyRec = ExhaustEnergyRec + LubeOilEnergyRec + JacketEnergyRec
FuelEnergyUseRate = ABS(FuelEnergyUseRate)
FuelEnergy = ABS(FuelEnergy)
FuelMdot = ABS(FuelEnergyUseRate)/(EngineDrivenChiller(ChillerNum)%FuelHeatingValue * KJtoJ)
!check for problems BG 9/12/06 (deal with observed negative energy results)
IF (Energy < 0.0d0) then ! there is a serious problem
IF (EngineDrivenChiller(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('CalcEngineDrivenChillerModel: Condenser loop inlet temperatures '// &
'> 70.0 C for EngineDrivenChiller='// &
TRIM(EngineDrivenChiller(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('CalcEngineDrivenChillerModel: Capacity ratio below zero for EngineDrivenChiller='// &
TRIM(EngineDrivenChiller(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 CalcEngineDrivenChillerModel