SUBROUTINE CalcElectricEIRChillerModel(EIRChillNum,MyLoad,Runflag,FirstIteration,EquipFlowCtrl)
! SUBROUTINE INFORMATION:
! AUTHOR Richard Raustad, FSEC
! DATE WRITTEN July 2004
! MODIFIED Chandan Sharma, FSEC, February 2010, Added basin heater
! RE-ENGINEERED na
! PURPOSE OF THIS SUBROUTINE:
! Simulate a vapor compression chiller using the DOE-2 model
! METHODOLOGY EMPLOYED:
! Use empirical curve fits to model performance at off-reference conditions
! REFERENCES:
! 1. DOE-2 Engineers Manual, Version 2.1A, November 1982, LBL-11353
! USE STATEMENTS:
USE DataGlobals, ONLY : WarmupFlag, CurrentTime
USE DataHVACGlobals, ONLY : SmallLoad, SysTimeElapsed, TimeStepSys
USE General, ONLY : RoundSigDigits, CreateSysTimeIntervalString
USE CurveManager, ONLY : CurveValue
USE DataPlant, ONLY : DeltaTemptol, PlantLoop, SimPlantEquipTypes, TypeOf_Chiller_ElectricEIR, &
CompSetPtBasedSchemeType, CriteriaType_MassFlowRate, SingleSetpoint, DualSetpointDeadband
USE DataBranchAirLoopPlant, ONLY: ControlType_SeriesActive, MassFlowTolerance
USE DataEnvironment, ONLY : EnvironmentName, CurMnDy
USE PlantUtilities, ONLY : SetComponentFlowRate, PullCompInterconnectTrigger
USE Psychrometrics, ONLY : PsyCpAirFnWTdb, PsyWFnTdbTwbPb
IMPLICIT NONE ! Enforce explicit typing of all variables in this routine
! SUBROUTINE ARGUMENT DEFINITIONS:
INTEGER :: EIRChillNum ! Chiller number
REAL(r64) :: MyLoad ! Operating load
LOGICAL :: FirstIteration ! TRUE when first iteration of timestep
LOGICAL, INTENT(IN) :: RunFlag ! TRUE when chiller operating
INTEGER, INTENT(IN) :: EquipFlowCtrl ! Flow control mode for the equipment
! SUBROUTINE PARAMETER DEFINITIONS:
CHARACTER(len=*), PARAMETER :: OutputFormat ='(F6.2)'
! INTERFACE BLOCK SPECIFICATIONS
! na
! DERIVED TYPE DEFINITIONS
! na
! SUBROUTINE LOCAL VARIABLE DECLARATIONS:
REAL(r64) :: FRAC ! Chiller cycling ratio
REAL(r64) :: MinPartLoadRat ! Min allowed operating fraction of full load
REAL(r64) :: MinUnloadRat ! Min allowed unloading fraction of full load
REAL(r64) :: MaxPartLoadRat ! Max allowed operating fraction of full load
REAL(r64) :: EvapInletTemp ! Evaporator inlet temperature [C]
REAL(r64) :: CondInletTemp ! Condenser inlet temperature [C]
REAL(r64) :: EvapOutletTempSetpoint ! Evaporator outlet temperature setpoint [C]
REAL(r64) :: AvailChillerCap ! Chiller available capacity at current operating conditions [W]
REAL(r64) :: ChillerRefCap ! Chiller reference capacity
REAL(r64) :: EvapDeltaTemp ! Evaporator temperature difference [C]
REAL(r64) :: ReferenceCOP ! Reference coefficient of performance, from user input
REAL(r64) :: PartLoadRat ! Operating part load ratio
REAL(r64) :: TempLowLimitEout ! Evaporator low temp. limit cut off [C]
REAL(r64) :: EvapMassFlowRateMax ! Max reference evaporator mass flow rate converted from volume flow rate [kg/s]
INTEGER :: EvapInletNode ! Evaporator inlet node number
INTEGER :: EvapOutletNode ! Evaporator outlet node number
INTEGER :: CondInletNode ! Condenser inlet node number
INTEGER :: CondOutletNode ! Condenser outlet node number
! LOGICAL,SAVE :: PossibleSubCooling
REAL(r64) :: TempLoad ! Actual load to be met by chiller. This value is compared to MyLoad
! and reset when necessary since this chiller can cycle, the load passed
! should be the actual load. Instead the minimum PLR * RefCap is
! passed in. [W]
INTEGER :: PlantLoopNum ! Plant loop which contains the current chiller
INTEGER :: LoopSideNum ! Plant loop side which contains the current chiller (usually supply side)
INTEGER :: BranchNum
INTEGER :: CompNum
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 fluid specific heat
! Set module level inlet and outlet nodes and initialize other local variables
ChillerPartLoadRatio = 0.0d0
ChillerCyclingRatio = 0.0d0
ChillerFalseLoadRate = 0.0d0
EvapMassFlowRate = 0.0d0
CondMassFlowRate = 0.0d0
Power = 0.0d0
QCondenser = 0.0d0
QEvaporator = 0.0d0
QHeatRecovered = 0.0d0
CondenserFanPower = 0.0d0
EvapInletNode = ElectricEIRChiller(EIRChillNum)%EvapInletNodeNum
EvapOutletNode = ElectricEIRChiller(EIRChillNum)%EvapOutletNodeNum
CondInletNode = ElectricEIRChiller(EIRChillNum)%CondInletNodeNum
CondOutletNode = ElectricEIRChiller(EIRChillNum)%CondOutletNodeNum
PlantLoopNum = ElectricEIRChiller(EIRChillNum)%CWLoopNum
LoopSideNum = ElectricEIRChiller(EIRChillNum)%CWLoopSideNum
BranchNum = ElectricEIRChiller(EIRChillNum)%CWBranchNum
CompNum = ElectricEIRChiller(EIRChillNum)%CWCompNum
EvapInletTemp = Node(EvapInletNode)%Temp
FRAC = 1.0d0
! Set performance curve outputs to 0.0 when chiller is off
ChillerCapFT = 0.0d0
ChillerEIRFT = 0.0d0
ChillerEIRFPLR = 0.0d0
! 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(ElectricEIRChiller(EIRChillNum)%PrintMessage)THEN
ElectricEIRChiller(EIRChillNum)%MsgErrorCount = &
ElectricEIRChiller(EIRChillNum)%MsgErrorCount + 1
! Show single warning and pass additional info to ShowRecurringWarningErrorAtEnd
IF (ElectricEIRChiller(EIRChillNum)%MsgErrorCount < 2) THEN
CALL ShowWarningError(TRIM(ElectricEIRChiller(EIRChillNum)%MsgBuffer1)//'.')
CALL ShowContinueError(TRIM(ElectricEIRChiller(EIRChillNum)%MsgBuffer2))
ELSE
CALL ShowRecurringWarningErrorAtEnd(TRIM(ElectricEIRChiller(EIRChillNum)%MsgBuffer1)//' error continues.', &
ElectricEIRChiller(EIRChillNum)%ErrCount1,ReportMaxOf=ElectricEIRChiller(EIRChillNum)%MsgDataLast, &
ReportMinOf=ElectricEIRChiller(EIRChillNum)%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 no loop demand or chiller OFF, return
!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 .OR. .NOT. RunFlag) THEN
IF(EquipFlowCtrl == ControlType_SeriesActive .OR. PlantLoop(PlantLoopNum)%LoopSide(LoopSideNum)%FlowLock==1) THEN
EvapMassFlowRate = Node(EvapInletNode)%MassFlowrate
END IF
IF (ElectricEIRChiller(EIRChillNum)%CondenserType == WaterCooled) THEN
IF (PlantLoop(ElectricEIRChiller(EIRChillNum)%CDLoopNum)% &
LoopSide(ElectricEIRChiller(EIRChillNum)%CDLoopSideNum)% &
Branch(ElectricEIRChiller(EIRChillNum)%CDBranchNum)% &
Comp(ElectricEIRChiller(EIRChillNum)%CDCompNum)%FlowCtrl == ControlType_SeriesActive) THEN
CondMassFlowRate = Node(CondInletNode)%MassFlowrate
ENDIF
ENDIF
IF (ElectricEIRChiller(EIRChillNum)%CondenserType == EvapCooled) THEN
CALL CalcBasinHeaterPower(ElectricEIRChiller(EIRChillNum)%BasinHeaterPowerFTempDiff,&
ElectricEIRChiller(EIRChillNum)%BasinHeaterSchedulePtr,&
ElectricEIRChiller(EIRChillNum)%BasinHeaterSetPointTemp,BasinHeaterPower)
ENDIF
ElectricEIRChiller(EIRChillNum)%PrintMessage = .FALSE.
RETURN
END IF
! initialize outlet air humidity ratio of air or evap cooled chillers
CondOutletHumRat = Node(CondInletNode)%HumRat
IF (ElectricEIRChiller(EIRChillNum)%CondenserType == AirCooled) THEN ! Condenser inlet temp = outdoor temp
! Node(CondInletNode)%Temp = OutDryBulbTemp
Node(CondInletNode)%Temp = Node(CondInletNode)%OutAirDryBulb
! Warn user if entering condenser dry-bulb temperature falls below 0 C
IF(Node(CondInletNode)%Temp .LT. 0.0d0 .AND. ABS(MyLoad) .GT. 0 .AND. RunFlag .AND. .NOT. WarmupFlag) THEN
ElectricEIRChiller(EIRChillNum)%PrintMessage = .TRUE.
WRITE(OutputChar,OutputFormat)Node(CondInletNode)%Temp
ElectricEIRChiller(EIRChillNum)%MsgBuffer1 = 'ElectricEIRChillerModel - CHILLER:ELECTRIC:EIR "' &
//TRIM(ElectricEIRChiller(EIRChillNum)%Name)// &
'" - Air Cooled Condenser Inlet Temperature below 0C'
ElectricEIRChiller(EIRChillNum)%MsgBuffer2 = '... Outdoor Dry-bulb Condition = '//TRIM(OutputChar)// &
' C. Occurrence info = '//TRIM(EnvironmentName)//', '//Trim(CurMnDy)//' '&
//TRIM(CreateSysTimeIntervalString())
ElectricEIRChiller(EIRChillNum)%MsgDataLast = Node(CondInletNode)%Temp
ELSE
ElectricEIRChiller(EIRChillNum)%PrintMessage = .FALSE.
END IF
ELSE IF (ElectricEIRChiller(EIRChillNum)%CondenserType == EvapCooled) THEN ! Condenser inlet temp = (outdoor wet bulb)
! Node(CondInletNode)%Temp = OutWetBulbTemp
Node(CondInletNode)%Temp = Node(CondInletNode)%OutAirWetBulb
! line above assumes evaporation pushes condenser inlet air humidity ratio to saturation
CondOutletHumRat = PsyWFnTdbTwbPb(Node(CondInletNode)%Temp,Node(CondInletNode)%Temp,Node(CondInletNode)%Press)
! Warn user if evap condenser wet-bulb temperature falls below 10 C
IF(Node(CondInletNode)%Temp .LT. 10.0d0 .AND. ABS(MyLoad) .GT. 0 .AND. RunFlag .AND. .NOT. WarmupFlag) THEN
ElectricEIRChiller(EIRChillNum)%PrintMessage = .TRUE.
WRITE(OutputChar,OutputFormat)Node(CondInletNode)%Temp
ElectricEIRChiller(EIRChillNum)%MsgBuffer1 = 'ElectricEIRChillerModel - CHILLER:ELECTRIC:EIR "' &
//TRIM(ElectricEIRChiller(EIRChillNum)%Name)// &
'" - Air Cooled Condenser Inlet Temperature below 10C'
ElectricEIRChiller(EIRChillNum)%MsgBuffer2 = '... Outdoor Wet-bulb Condition = '//TRIM(OutputChar)// &
' C. Occurrence info = '//TRIM(EnvironmentName)//', '//Trim(CurMnDy)//' '&
//TRIM(CreateSysTimeIntervalString())
ElectricEIRChiller(EIRChillNum)%MsgDataLast = Node(CondInletNode)%Temp
ELSE
ElectricEIRChiller(EIRChillNum)%PrintMessage = .FALSE.
END IF
END IF ! 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
! LOAD LOCAL VARIABLES FROM DATA STRUCTURE (for code readability)
MinPartLoadRat = ElectricEIRChiller(EIRChillNum)%MinPartLoadRat
MaxPartLoadRat = ElectricEIRChiller(EIRChillNum)%MaxPartLoadRat
MinUnloadRat = ElectricEIRChiller(EIRChillNum)%MinUnLoadRat
ChillerRefCap = ElectricEIRChiller(EIRChillNum)%RefCap
ReferenceCOP = ElectricEIRChiller(EIRChillNum)%RefCOP
EvapOutletTemp = Node(ElectricEIRChiller(EIRChillNum)%EvapOutletNodeNum)%Temp
TempLowLimitEout = ElectricEIRChiller(EIRChillNum)%TempLowLimitEvapOut
EvapMassFlowRateMax = ElectricEIRChiller(EIRChillNum)%EvapMassFlowRateMax
! Set mass flow rates
IF (ElectricEIRChiller(EIRChillNum)%CondenserType == WaterCooled) THEN
CondMassFlowRate = ElectricEIRChiller(EIRChillNum)%CondMassFlowRateMax
CALL SetComponentFlowRate(CondMassFlowRate, CondInletNode, CondOutletNode, &
ElectricEIRChiller(EIRChillNum)%CDLoopNum, &
ElectricEIRChiller(EIRChillNum)%CDLoopSideNum, &
ElectricEIRChiller(EIRChillNum)%CDBranchNum, &
ElectricEIRChiller(EIRChillNum)%CDCompNum)
CALL PullCompInterconnectTrigger(ElectricEIRChiller(EIRChillNum)%CWLoopNum, &
ElectricEIRChiller(EIRChillNum)%CWLoopSideNum, &
ElectricEIRChiller(EIRChillNum)%CWBranchNum, &
ElectricEIRChiller(EIRChillNum)%CWCompNum, &
ElectricEIRChiller(EIRChillNum)%CondMassFlowIndex, &
ElectricEIRChiller(EIRChillNum)%CDLoopNum, &
ElectricEIRChiller(EIRChillNum)%CDLoopSideNum, &
CriteriaType_MassFlowRate, &
CondMassFlowRate)
IF (CondMassFlowRate < MassFlowTolerance) RETURN
END IF
SELECT CASE (PlantLoop(ElectricEIRChiller(EIRChillNum)%CWLoopNum)%LoopDemandCalcScheme)
CASE (SingleSetpoint)
IF ((ElectricEIRChiller(EIRChillNum)%FlowMode == LeavingSetpointModulated) .OR. &
(PlantLoop(PlantLoopNum)%LoopSide(LoopSideNum)%Branch(BranchNum)%Comp(CompNum)%CurOpSchemeType &
== CompSetPtBasedSchemeType) .OR. &
(Node(ElectricEIRChiller(EIRChillNum)%EvapOutletNodeNum)%TempSetPoint /= SensedNodeFlagValue) ) THEN
! there will be a valid setpoint on outlet
EvapOutletTempSetpoint = Node(EvapOutletNode)%TempSetPoint
ELSE ! use plant loop overall setpoint
EvapOutletTempSetpoint= Node(PlantLoop(PlantLoopNum)%TempSetPointNodeNum)%TempSetPoint
ENDIF
CASE (DualSetpointDeadband)
IF ((ElectricEIRChiller(EIRChillNum)%FlowMode == LeavingSetpointModulated) .OR. &
(PlantLoop(PlantLoopNum)%LoopSide(LoopSideNum)%Branch(BranchNum)%Comp(CompNum)%CurOpSchemeType &
== CompSetPtBasedSchemeType) .OR. &
(Node(ElectricEIRChiller(EIRChillNum)%EvapOutletNodeNum)%TempSetPointHi /= SensedNodeFlagValue) ) THEN
! there will be a valid setpoint on outlet
EvapOutletTempSetpoint = Node(EvapOutletNode)%TempSetPointHi
ELSE ! use plant loop overall setpoint
EvapOutletTempSetpoint= Node(PlantLoop(PlantLoopNum)%TempSetPointNodeNum)%TempSetPointHi
ENDIF
END SELECT
! correct temperature if using heat recovery
! use report values for latest valid calculation, lagged somewhat
IF ( ElectricEIRChiller(EIRChillNum)%HeatRecActive ) THEN
If ( (ElectricEIRChillerReport(EIRChillNum)%QHeatRecovery &
+ ElectricEIRChillerReport(EIRChillNum)%QCond) > 0.d0) THEN ! protect div by zero
AvgCondSinkTemp = (ElectricEIRChillerReport(EIRChillNum)%QHeatRecovery &
* ElectricEIRChillerReport(EIRChillNum)%HeatRecInletTemp &
+ ElectricEIRChillerReport(EIRChillNum)%QCond &
* ElectricEIRChillerReport(EIRChillNum)%CondInletTemp) &
/ (ElectricEIRChillerReport(EIRChillNum)%QHeatRecovery &
+ ElectricEIRChillerReport(EIRChillNum)%QCond)
ELSE
AvgCondSinkTemp = CondInletTemp
ENDIF
ELSE
AvgCondSinkTemp = CondInletTemp
ENDIF
! Get capacity curve info with respect to CW setpoint and entering condenser water temps
ChillerCapFT = CurveValue(ElectricEIRChiller(EIRChillNum)%ChillerCapFT, &
EvapOutletTempSetpoint,AvgCondSinkTemp)
IF(ChillerCapFT .LT. 0)THEN
IF(ElectricEIRChiller(EIRChillNum)%ChillerCapFTError .LT. 1 .AND. &
PlantLoop(PlantLoopNum)%Loopside(LoopSideNum)%FlowLock &
.NE. 0 .AND. .NOT. WarmupFlag)THEN
ElectricEIRChiller(EIRChillNum)%ChillerCapFTError = ElectricEIRChiller(EIRChillNum)%ChillerCapFTError + 1
CALL ShowWarningError('CHILLER:ELECTRIC:EIR "'//TRIM(ElectricEIRChiller(EIRChillNum)%Name)//'":')
CALL ShowContinueError(' Chiller Capacity as a Function of Temperature curve output is negative ('// &
TRIM(RoundSigDigits(ChillerCapFT,3))//').')
CALL ShowContinueError(' Negative value occurs using an Evaporator Outlet Temp of ' &
//TRIM(RoundSigDigits(EvapOutletTempSetpoint,1))// &
' and a Condenser Inlet Temp of '//TRIM(RoundSigDigits(CondInletTemp,1))//'.')
CALL ShowContinueErrorTimeStamp(' Resetting curve output to zero and continuing simulation.')
ELSE IF(PlantLoop(PlantLoopNum)%Loopside(LoopSideNum)%FlowLock &
.NE. 0 .AND. .NOT. WarmupFlag)THEN
ElectricEIRChiller(EIRChillNum)%ChillerCapFTError = ElectricEIRChiller(EIRChillNum)%ChillerCapFTError + 1
CALL ShowRecurringWarningErrorAtEnd('CHILLER:ELECTRIC:EIR "' &
//TRIM(ElectricEIRChiller(EIRChillNum)%Name)//'":'//&
' Chiller Capacity as a Function of Temperature curve output is negative warning continues...' &
, ElectricEIRChiller(EIRChillNum)%ChillerCapFTErrorIndex, ChillerCapFT, ChillerCapFT)
END IF
ChillerCapFT = 0.0d0
END IF
! Available chiller capacity as a function of temperature
AvailChillerCap = ChillerRefCap*ChillerCapFT
!Only perform this check for temperature setpoint control
IF (PlantLoop(PlantLoopNum)%LoopSide(LoopSideNum)%Branch(BranchNum)%Comp(CompNum)%CurOpschemeType == &
CompSetPtBasedSchemeType) THEN
! Calculate water side load
Cp = GetSpecificHeatGlycol(PlantLoop(ElectricEIRChiller(EIRChillNum)%CWLoopNum)%FluidName, &
Node(EvapInletNode)%Temp, &
PlantLoop(ElectricEIRChiller(EIRChillNum)%CWLoopNum)%FluidIndex, &
'CalcElectricEIRChillerModel')
EvapMassFlowRate = Node(EvapInletNode)%MassFlowRate
SELECT CASE (PlantLoop(ElectricEIRChiller(EIRChillNum)%CWLoopNum)%LoopDemandCalcScheme)
CASE (SingleSetpoint)
TempLoad = EvapMassFlowRate * Cp * &
(Node(EvapInletNode)%Temp - Node(EvapOutletNode)%TempSetPoint)
CASE (DualSetpointDeadband)
TempLoad = EvapMassFlowRate * Cp * &
(Node(EvapInletNode)%Temp - Node(EvapOutletNode)%TempSetPointHi)
END SELECT
TempLoad = MAX(0.0d0,TempLoad)
! MyLoad is capped at minimum PLR * RefCap, adjust load to actual water side load because this chiller can cycle
IF (ABS(MyLoad) .GT. TempLoad) THEN
MyLoad = SIGN(TempLoad, MyLoad)
END IF
END IF
! Part load ratio based on load and available chiller capacity, cap at max part load ratio
IF(AvailChillerCap .GT. 0)THEN
PartLoadRat = MAX(0.0d0, MIN(ABS(MyLoad)/AvailChillerCap,MaxPartLoadRat))
ELSE
PartLoadRat = 0.0d0
END IF
Cp = GetSpecificHeatGlycol(PlantLoop(ElectricEIRChiller(EIRChillNum)%CWLoopNum)%FluidName, &
Node(EvapInletNode)%Temp, &
PlantLoop(ElectricEIRChiller(EIRChillNum)%CWLoopNum)%FluidIndex, &
'CalcElectricEIRChillerModel')
IF(PlantLoop(PlantLoopNum)%LoopSide(LoopSideNum)%Branch(BranchNum)%Comp(CompNum)%CurOpSchemeType == &
CompSetPtBasedSchemeType)THEN
ElectricEIRChiller(EIRChillNum)%PossibleSubCooling = .FALSE.
ELSE
ElectricEIRChiller(EIRChillNum)%PossibleSubCooling = .TRUE.
ENDIF
! Set evaporator heat transfer rate
QEvaporator = AvailChillerCap * PartLoadRat
! Either set the flow to the Constant value or caluclate the flow for the variable volume
IF ((ElectricEIRChiller(EIRChillNum)%FlowMode == ConstantFlow) &
.OR. (ElectricEIRChiller(EIRChillNum)%FlowMode == NotModulated )) THEN
! Set the evaporator mass flow rate to design
! Start by assuming max (design) flow
EvapMassFlowRate = EvapMassFlowRateMax
! Use SetComponentFlowRate to decide actual flow
Call SetComponentFlowRate( EvapMassFlowRate, &
EvapInletNode , EvapOutletNode , &
ElectricEIRChiller(EIRChillNum)%CWLoopNum, &
ElectricEIRChiller(EIRChillNum)%CWLoopSideNum, &
ElectricEIRChiller(EIRChillNum)%CWBranchNum, &
ElectricEIRChiller(EIRChillNum)%CWCompNum)
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
ELSEIF(ElectricEIRChiller(EIRChillNum)%FlowMode == LeavingSetpointModulated) THEN
! Calculate the Delta Temp from the inlet temp to the chiller outlet setpoint
SELECT CASE (PlantLoop(ElectricEIRChiller(EIRChillNum)%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) &
ElectricEIRChiller(EIRChillNum)%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 , &
ElectricEIRChiller(EIRChillNum)%CWLoopNum, &
ElectricEIRChiller(EIRChillNum)%CWLoopSideNum, &
ElectricEIRChiller(EIRChillNum)%CWBranchNum, &
ElectricEIRChiller(EIRChillNum)%CWCompNum)
! Should we recalculate this with the corrected setpoint?
SELECT CASE (PlantLoop(ElectricEIRChiller(EIRChillNum)%CWLoopNum)%LoopDemandCalcScheme)
CASE (SingleSetpoint)
EvapOutletTemp = Node(EvapOutletNode)%TempSetPoint
CASE (DualSetpointDeadband)
EvapOutletTemp = Node(EvapOutletNode)%TempSetPointHi
END SELECT
QEvaporator = MAX(0.0d0,(EvapMassFlowRate*Cp*EvapDeltaTemp))
ELSE
! Try to request zero flow
EvapMassFlowRate=0.0d0
! Use SetComponentFlowRate to decide actual flow
Call SetComponentFlowRate( EvapMassFlowRate, &
EvapInletNode , EvapOutletNode , &
ElectricEIRChiller(EIRChillNum)%CWLoopNum, &
ElectricEIRChiller(EIRChillNum)%CWLoopSideNum, &
ElectricEIRChiller(EIRChillNum)%CWBranchNum, &
ElectricEIRChiller(EIRChillNum)%CWCompNum)
! No deltaT since component is not running
EvapOutletTemp = Node(EvapInletNode)%Temp
QEvaporator = 0.0d0
PartLoadRat = 0.0d0
ChillerPartLoadRatio = PartLoadRat
! DSU? so what if the delta T is zero? On FlowLock==0, the inlet temp could = setpoint, right?
IF (ElectricEIRChiller(EIRChillNum)%DeltaTErrCount < 1 .AND. .NOT. WarmupFlag) THEN
ElectricEIRChiller(EIRChillNum)%DeltaTErrCount=ElectricEIRChiller(EIRChillNum)%DeltaTErrCount+1
CALL ShowWarningError('Evaporator DeltaTemp = 0 in mass flow calculation (Tevapin = Tsetpoint).')
CALL ShowContinueErrorTimeStamp(' ')
ELSE IF (.NOT. WarmupFlag) THEN
ElectricEIRChiller(EIRChillNum)%ChillerCapFTError = ElectricEIRChiller(EIRChillNum)%ChillerCapFTError + 1
CALL ShowRecurringWarningErrorAtEnd('CHILLER:ELECTRIC:EIR "' &
//TRIM(ElectricEIRChiller(EIRChillNum)%Name)//'":'//&
' Evaporator DeltaTemp = 0 in mass flow calculation warning continues...' &
, ElectricEIRChiller(EIRChillNum)%DeltaTErrCountIndex, EvapDeltaTemp, EvapDeltaTemp)
END IF
END IF
END IF !End of Constant Variable Flow If Block
IF(EvapMassFlowRate == 0.0d0)THEN
MyLoad = 0.0d0
IF (ElectricEIRChiller(EIRChillNum)%CondenserType == EvapCooled) THEN
CALL CalcBasinHeaterPower(ElectricEIRChiller(EIRChillNum)%BasinHeaterPowerFTempDiff,&
ElectricEIRChiller(EIRChillNum)%BasinHeaterSchedulePtr,&
ElectricEIRChiller(EIRChillNum)%BasinHeaterSetPointTemp,BasinHeaterPower)
ENDIF
ElectricEIRChiller(EIRChillNum)%PrintMessage = .FALSE.
RETURN
END IF
IF(ElectricEIRChiller(EIRChillNum)%PossibleSubCooling) THEN
QEvaporator = ABS(MyLoad)
EvapDeltaTemp = QEvaporator/EvapMassFlowRate/Cp
EvapOutletTemp = Node(EvapInletNode)%Temp - EvapDeltaTemp
ELSE
EvapDeltaTemp = Node(EvapInletNode)%Temp - EvapOutletTempSetpoint
QEvaporator = MAX(0.0d0,(EvapMassFlowRate*Cp*EvapDeltaTemp))
EvapOutletTemp = EvapOutletTempSetpoint
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 * MaxPartLoadRat
EvapDeltaTemp = QEvaporator/EvapMassFlowRate/Cp
! evaporator outlet temperature is allowed to float upwards (recalculate AvailChillerCap? iterate?)
EvapOutletTemp = Node(EvapInletNode)%Temp - EvapDeltaTemp
ELSE
QEvaporator = 0.0d0
EvapOutletTemp = Node(EvapInletNode)%Temp
END IF
END IF
IF(AvailChillerCap .GT. 0.0d0)THEN
PartLoadRat = MAX(0.0d0,MIN((QEvaporator/AvailChillerCap),MaxPartLoadRat))
ELSE
PartLoadRat = 0.0d0
END IF
! Chiller cycles below minimum part load ratio, FRAC = amount of time chiller is ON during this time step
IF (PartLoadRat .LT. MinPartLoadRat) FRAC = MIN(1.0d0,(PartLoadRat/MinPartLoadRat))
! 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
IF(AvailChillerCap .GT. 0.0d0)THEN
PartLoadRat = MAX(PartLoadRat,MinUnLoadRat)
ELSE
PartLoadRat = 0.0d0
END IF
! set the module level variable used for reporting PLR
ChillerPartLoadRatio = PartLoadRat
! calculate the load due to false loading on chiller over and above water side load
ChillerFalseLoadRate = (AvailChillerCap * PartLoadRat * FRAC) - QEvaporator
IF(ChillerFalseLoadRate .LT. SmallLoad) THEN
ChillerFalseLoadRate = 0.0d0
END IF
IF(QEvaporator == 0.0d0 .AND. ElectricEIRChiller(EIRChillNum)%CondenserType == EvapCooled) THEN
CALL CalcBasinHeaterPower(ElectricEIRChiller(EIRChillNum)%BasinHeaterPowerFTempDiff,&
ElectricEIRChiller(EIRChillNum)%BasinHeaterSchedulePtr,&
ElectricEIRChiller(EIRChillNum)%BasinHeaterSetPointTemp,BasinHeaterPower)
END IF
ChillerEIRFT = CurveValue(ElectricEIRChiller(EIRChillNum)%ChillerEIRFT,EvapOutletTemp,AvgCondSinkTemp)
IF(ChillerEIRFT .LT. 0.0d0)THEN
IF(ElectricEIRChiller(EIRChillNum)%ChillerEIRFTError .LT. 1 .AND. PlantLoop(PlantLoopNum)%Loopside(LoopSideNum)%FlowLock &
.NE. 0 .AND. .NOT. WarmupFlag)THEN
ElectricEIRChiller(EIRChillNum)%ChillerEIRFTError = ElectricEIRChiller(EIRChillNum)%ChillerEIRFTError + 1
CALL ShowWarningError('CHILLER:ELECTRIC:EIR "'//TRIM(ElectricEIRChiller(EIRChillNum)%Name)//'":')
CALL ShowContinueError(' Chiller EIR as a Function of Temperature curve output is negative (' &
//TRIM(RoundSigDigits(ChillerEIRFT,3))//').')
CALL ShowContinueError(' Negative value occurs using an Evaporator Outlet Temp of ' &
//TRIM(RoundSigDigits(EvapOutletTemp,1))// &
' and a Condenser Inlet Temp of '//TRIM(RoundSigDigits(CondInletTemp,1))//'.')
CALL ShowContinueErrorTimeStamp(' Resetting curve output to zero and continuing simulation.')
ELSE IF(PlantLoop(PlantLoopNum)%Loopside(LoopSideNum)%FlowLock &
.NE. 0 .AND. .NOT. WarmupFlag)THEN
ElectricEIRChiller(EIRChillNum)%ChillerEIRFTError = ElectricEIRChiller(EIRChillNum)%ChillerEIRFTError + 1
CALL ShowRecurringWarningErrorAtEnd('CHILLER:ELECTRIC:EIR "' &
//TRIM(ElectricEIRChiller(EIRChillNum)%Name)//'":'//&
' Chiller EIR as a Function of Temperature curve output is negative warning continues...' &
, ElectricEIRChiller(EIRChillNum)%ChillerEIRFTErrorIndex, ChillerEIRFT, ChillerEIRFT)
END IF
ChillerEIRFT = 0.0d0
END IF
ChillerEIRFPLR = CurveValue(ElectricEIRChiller(EIRChillNum)%ChillerEIRFPLR,PartLoadRat)
IF(ChillerEIRFPLR .LT. 0.0d0)THEN
IF(ElectricEIRChiller(EIRChillNum)%ChillerEIRFPLRError .LT. 1 .AND. PlantLoop(PlantLoopNum)%Loopside(LoopSideNum)%FlowLock &
.NE. 0 .AND. .NOT. WarmupFlag)THEN
ElectricEIRChiller(EIRChillNum)%ChillerEIRFPLRError = ElectricEIRChiller(EIRChillNum)%ChillerEIRFPLRError + 1
CALL ShowWarningError('CHILLER:ELECTRIC:EIR "'//TRIM(ElectricEIRChiller(EIRChillNum)%Name)//'":')
CALL ShowContinueError(' Chiller EIR as a function of PLR curve output is negative (' &
//TRIM(RoundSigDigits(ChillerEIRFPLR,3))//').')
CALL ShowContinueError(' Negative value occurs using a part-load ratio of '//TRIM(RoundSigDigits(PartLoadRat,3))//'.')
CALL ShowContinueErrorTimeStamp(' Resetting curve output to zero and continuing simulation.')
ELSE IF(PlantLoop(PlantLoopNum)%Loopside(LoopSideNum)%FlowLock &
.NE. 0 .AND. .NOT. WarmupFlag)THEN
ElectricEIRChiller(EIRChillNum)%ChillerEIRFPLRError = ElectricEIRChiller(EIRChillNum)%ChillerEIRFPLRError + 1
CALL ShowRecurringWarningErrorAtEnd('CHILLER:ELECTRIC:EIR "' &
//TRIM(ElectricEIRChiller(EIRChillNum)%Name)//'":'//&
' Chiller EIR as a function of PLR curve output is negative warning continues...' &
, ElectricEIRChiller(EIRChillNum)%ChillerEIRFPLRErrorIndex, ChillerEIRFPLR, ChillerEIRFPLR)
END IF
ChillerEIRFPLR = 0.0d0
END IF
Power = (AvailChillerCap/ReferenceCOP) * ChillerEIRFPLR * ChillerEIRFT * FRAC
QCondenser = Power*ElectricEIRChiller(EIRChillNum)%CompPowerToCondenserFrac + QEvaporator + ChillerFalseLoadRate
IF (ElectricEIRChiller(EIRChillNum)%CondenserType == WaterCooled) THEN
IF (CondMassFlowRate > MassFlowTolerance) THEN
! If Heat Recovery specified for this vapor compression chiller, then Qcondenser will be adjusted by this subroutine
IF(ElectricEIRChiller(EIRChillNum)%HeatRecActive) CALL EIRChillerHeatRecovery(EIRChillNum,QCondenser, &
CondMassFlowRate,CondInletTemp,QHeatRecovered)
Cp = GetSpecificHeatGlycol(PlantLoop(ElectricEIRChiller(EIRChillNum)%CDLoopNum)%FluidName, &
CondInletTemp, &
PlantLoop(ElectricEIRChiller(EIRChillNum)%CDLoopNum)%FluidIndex, &
'CalcElectricEIRChillerModel')
CondOutletTemp = QCondenser/CondMassFlowRate/Cp + CondInletTemp
ELSE
CALL ShowSevereError('CalcElectricEIRChillerModel: Condenser flow = 0, for ElectricEIRChiller='// &
TRIM(ElectricEIRChiller(EIRChillNum)%Name))
CALL ShowContinueErrorTimeStamp(' ')
!DSU? maybe this could be handled earlier, check if this component has a load and an evap flow rate
! then if cond flow is zero, just make a request to the condenser,
! then just say it couldn't run until condenser loop wakes up.
!CALL ShowFatalError('Program Terminates due to previous error condition.')
END IF
ELSE !Air Cooled or Evap Cooled
IF(QCondenser > 0.0d0) THEN
CondMassFlowRate = ElectricEIRChiller(EIRChillNum)%CondMassFlowRateMax * PartLoadRat
ELSE
CondMassFlowRate = 0.0d0
END IF
! If Heat Recovery specified for this vapor compression chiller, then Qcondenser will be adjusted by this subroutine
IF(ElectricEIRChiller(EIRChillNum)%HeatRecActive) CALL EIRChillerHeatRecovery(EIRChillNum,QCondenser, &
CondMassFlowRate,CondInletTemp,QHeatRecovered)
IF(CondMassFlowRate .GT. 0.0d0)THEN
Cp = PsyCpAirFnWTdb(Node(CondInletNode)%HumRat,CondInletTemp,'CalcElectricEIRChillerModel')
CondOutletTemp = CondInletTemp + QCondenser/CondMassFlowRate/Cp
ELSE
CondOutletTemp = CondInletTemp
END IF
END IF
! Calculate condenser fan power
IF(ChillerCapFT .GT. 0.0d0)THEN
CondenserFanPower = ChillerRefCap*ElectricEIRChiller(EIRChillNum)%CondenserFanPowerRatio*FRAC
ELSE
CondenserFanPower = 0.0d0
END IF
RETURN
END SUBROUTINE CalcElectricEIRChillerModel