SUBROUTINE CalcElectricChillerModel(ChillNum,MyLoad,EquipFlowCtrl,Runflag)
! 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 Electric model
! METHODOLOGY EMPLOYED:
! curve fit of performance data:
! REFERENCES:
! 1. BLAST Users Manual
! 2. CHILLER User Manual
! USE STATEMENTS:
USE DataPrecisionGlobals
USE DataGlobals, ONLY : BeginEnvrnFlag, SecInHour, outputfiledebug, CurrentTime
USE DataHVACGlobals, ONLY : FirstTimeStepSysFlag, TimeStepSys, SysTimeElapsed
USE General, ONLY : RoundSigDigits, CreateSysTimeIntervalString
USE DataPlant, ONLY : PlantLoop, TypeOf_Chiller_Electric, 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
USE Psychrometrics, ONLY : PsyCpAirFnWTdb, PsyWFnTdbTwbPb
IMPLICIT NONE
! SUBROUTINE ARGUMENT DEFINITIONS:
INTEGER :: ChillNum ! 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:
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) :: TempCondInDesign ! C - (Electric 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) :: RatedCOP ! rated coefficient of performance, from user input
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 calculation
REAL(r64) :: OperPartLoadRat ! Actual Operating PLR
REAL(r64) :: TempLowLimitEout ! C - Evaporator low temp. limit cut off
REAL(r64) :: EvapMassFlowRateMax ! Max Design Evaporator Mass Flow Rate converted from Volume Flow Rate
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) :: FRAC
! LOGICAL,SAVE :: PossibleSubCooling=.false.
INTEGER :: PlantLoopNum
INTEGER :: LoopNum
INTEGER :: LoopSideNum
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 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
Energy = 0.0d0
QCondenser = 0.0d0
QEvaporator = 0.0d0
CondenserEnergy = 0.0d0
EvaporatorEnergy = 0.0d0
QHeatRecovered = 0.0d0
EvapInletNode = ElectricChiller(ChillNum)%Base%EvapInletNodeNum
EvapOutletNode = ElectricChiller(ChillNum)%Base%EvapOutletNodeNum
CondInletNode = ElectricChiller(ChillNum)%Base%CondInletNodeNum
CondOutletNode = ElectricChiller(ChillNum)%Base%CondOutletNodeNum
FRAC = 1.0d0
LoopNum = ElectricChiller(ChillNum)%Base%CWLoopNum
LoopSideNum = ElectricChiller(ChillNum)%Base%CWLoopSideNum
BranchNum = ElectricChiller(ChillNum)%Base%CWBranchNum
CompNum = ElectricChiller(ChillNum)%Base%CWCompNum
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(ElectricChiller(ChillNum)%Base%PrintMessage)THEN
ElectricChiller(ChillNum)%Base%MsgErrorCount = &
ElectricChiller(ChillNum)%Base%MsgErrorCount + 1
! Show single warning and pass additional info to ShowRecurringWarningErrorAtEnd
IF (ElectricChiller(ChillNum)%Base%MsgErrorCount < 2) THEN
CALL ShowWarningError(TRIM(ElectricChiller(ChillNum)%Base%MsgBuffer1)//'.')
CALL ShowContinueError(TRIM(ElectricChiller(ChillNum)%Base%MsgBuffer2))
ELSE
CALL ShowRecurringWarningErrorAtEnd(TRIM(ElectricChiller(ChillNum)%Base%MsgBuffer1)//' error continues.', &
ElectricChiller(ChillNum)%Base%ErrCount1,ReportMaxOf=ElectricChiller(ChillNum)%Base%MsgDataLast, &
ReportMinOf=ElectricChiller(ChillNum)%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 no loop demand or chiller OFF, return
!If Chiller load is 0 or chiller is not running then leave the subroutine.
IF(MyLoad >= 0.d0 .OR. .NOT. RunFlag) THEN
! call for zero flow before leaving
IF(EquipFlowCtrl == ControlType_SeriesActive .OR. PlantLoop(LoopNum)%LoopSide(LoopSideNum)%FlowLock==1) THEN
EvapMassFlowRate = Node(EvapInletNode)%MassFlowrate
ELSE
EvapMassFlowRate = 0.0d0
CALL SetComponentFlowRate( EvapMassFlowRate, &
EvapInletNode , EvapOutletNode , &
ElectricChiller(ChillNum)%Base%CWLoopNum, &
ElectricChiller(ChillNum)%Base%CWLoopSideNum, &
ElectricChiller(ChillNum)%Base%CWBranchNum, &
ElectricChiller(ChillNum)%Base%CWCompNum)
ENDIF
IF (ElectricChiller(ChillNum)%Base%CondenserType == WaterCooled) THEN
IF ( PlantLoop(ElectricChiller(ChillNum)%Base%CDLoopNum)% &
LoopSide(ElectricChiller(ChillNum)%Base%CDLoopSideNum)% &
Branch(ElectricChiller(ChillNum)%Base%CDBranchNum)% &
Comp(ElectricChiller(ChillNum)%Base%CDCompNum)%FlowCtrl == ControlType_SeriesActive) THEN
CondMassFlowRate = Node(CondInletNode)%MassFlowrate
ELSE
CondMassFlowRate = 0.0d0
CALL SetComponentFlowRate(CondMassFlowRate, CondInletNode, CondOutletNode, &
ElectricChiller(ChillNum)%Base%CDLoopNum, &
ElectricChiller(ChillNum)%Base%CDLoopSideNum, &
ElectricChiller(ChillNum)%Base%CDBranchNum, &
ElectricChiller(ChillNum)%Base%CDCompNum)
ENDIF
ENDIF
IF (ElectricChiller(ChillNum)%Base%CondenserType == EvapCooled) THEN
CALL CalcBasinHeaterPower(ElectricChiller(ChillNum)%Base%BasinHeaterPowerFTempDiff,&
ElectricChiller(ChillNum)%Base%BasinHeaterSchedulePtr,&
ElectricChiller(ChillNum)%Base%BasinHeaterSetPointTemp,BasinHeaterPower)
ENDIF
ElectricChiller(ChillNum)%Base%PrintMessage = .FALSE.
RETURN
END IF
! 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 (ElectricChiller(ChillNum)%Base%CondenserType == WaterCooled) THEN
CondMassFlowRate = ElectricChiller(ChillNum)%Base%CondMassFlowRateMax
CALL SetComponentFlowRate(CondMassFlowRate, CondInletNode, CondOutletNode, &
ElectricChiller(ChillNum)%Base%CDLoopNum, &
ElectricChiller(ChillNum)%Base%CDLoopSideNum, &
ElectricChiller(ChillNum)%Base%CDBranchNum, &
ElectricChiller(ChillNum)%Base%CDCompNum)
CALL PullCompInterconnectTrigger(ElectricChiller(ChillNum)%Base%CWLoopNum, &
ElectricChiller(ChillNum)%Base%CWLoopSideNum, &
ElectricChiller(ChillNum)%Base%CWBranchNum, &
ElectricChiller(ChillNum)%Base%CWCompNum, &
ElectricChiller(ChillNum)%Base%CondMassFlowIndex, &
ElectricChiller(ChillNum)%Base%CDLoopNum, &
ElectricChiller(ChillNum)%Base%CDLoopSideNum, &
CriteriaType_MassFlowRate, &
CondMassFlowRate)
IF (CondMassFlowRate < MassFlowTolerance) RETURN
END IF
! LOAD LOCAL VARIABLES FROM DATA STRUCTURE (for code readability)
CapacityRat = ElectricChiller(ChillNum)%CapRatCoef
PowerRat = ElectricChiller(ChillNum)%PowerRatCoef
FullLoadFactor = ElectricChiller(ChillNum)%FullLoadCoef
MinPartLoadRat = ElectricChiller(ChillNum)%MinPartLoadRat
PartLoadRat = MinPartLoadRat
MaxPartLoadRat = ElectricChiller(ChillNum)%MaxPartLoadRat
TempCondInDesign = ElectricChiller(ChillNum)%TempDesCondIn
TempRiseRat = ElectricChiller(ChillNum)%TempRiseCoef
TempEvapOutDesign = ElectricChiller(ChillNum)%TempDesEvapOut
ChillerNomCap = ElectricChiller(ChillNum)%Base%NomCap
RatedCOP = ElectricChiller(ChillNum)%Base%COP
TempEvapOut = Node(ElectricChiller(ChillNum)%Base%EvapOutletNodeNum)%Temp
TempLowLimitEout = ElectricChiller(ChillNum)%TempLowLimitEvapOut
EvapMassFlowRateMax = ElectricChiller(ChillNum)%Base%EvapMassFlowRateMax
PlantLoopNum = ElectricChiller(ChillNum)%Base%CWLoopNum
LoopNum = ElectricChiller(ChillNum)%Base%CWLoopNum
LoopSideNum = ElectricChiller(ChillNum)%Base%CWLoopSideNum
! initialize outlet air humidity ratio of air or evap cooled chillers
CondOutletHumRat = Node(CondInletNode)%HumRat
IF (ElectricChiller(ChillNum)%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
ElectricChiller(ChillNum)%Base%PrintMessage = .TRUE.
WRITE(OutputChar,OutputFormat)Node(CondInletNode)%Temp
ElectricChiller(ChillNum)%Base%MsgBuffer1 = 'CalcElectricChillerModel - Chiller:Electric "' &
//TRIM(ElectricChiller(ChillNum)%Base%Name)// &
'" - Air Cooled Condenser Inlet Temperature below 0C'
ElectricChiller(ChillNum)%Base%MsgBuffer2 = '... Outdoor Dry-bulb Condition = '//TRIM(OutputChar)// &
' C. Occurrence info = '//TRIM(EnvironmentName)//', '//Trim(CurMnDy)//' '&
//TRIM(CreateSysTimeIntervalString())
ElectricChiller(ChillNum)%Base%MsgDataLast = Node(CondInletNode)%Temp
ELSE
ElectricChiller(ChillNum)%Base%PrintMessage = .FALSE.
ENDIF
Else IF (ElectricChiller(ChillNum)%Base%CondenserType == EvapCooled) THEN !Condenser inlet temp = (outdoor wet bulb)
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 10C
IF(Node(CondInletNode)%Temp .LT. 10.0d0 .and. .not. WarmupFlag) THEN
ElectricChiller(ChillNum)%Base%PrintMessage = .TRUE.
WRITE(OutputChar,OutputFormat)Node(CondInletNode)%Temp
ElectricChiller(ChillNum)%Base%MsgBuffer1 = 'CalcElectricChillerModel - Chiller:Electric "' &
//TRIM(ElectricChiller(ChillNum)%Base%Name)// &
'" - Evap Cooled Condenser Inlet Temperature below 10C'
ElectricChiller(ChillNum)%Base%MsgBuffer2 = '... Outdoor Wet-bulb Condition = '//TRIM(OutputChar)// &
' C. Occurrence info = '//TRIM(EnvironmentName)//', '//Trim(CurMnDy)//' '&
//TRIM(CreateSysTimeIntervalString())
ElectricChiller(ChillNum)%Base%MsgDataLast = Node(CondInletNode)%Temp
ELSE
ElectricChiller(ChillNum)%Base%PrintMessage = .FALSE.
ENDIF
ENDIF ! End of the Air Cooled/Evap Cooled Logic block
CondInletTemp = Node(CondInletNode)%Temp
! correct inlet temperature if using heat recovery
IF (ElectricChiller(ChillNum)%HeatRecActive) THEN
IF ((ElectricChillerReport(ChillNum)%QHeatRecovery + &
ElectricChillerReport(ChillNum)%Base%QCond) > 0.d0) THEN
AvgCondSinkTemp = (ElectricChillerReport(ChillNum)%QHeatRecovery &
* ElectricChillerReport(ChillNum)%HeatRecInletTemp &
+ ElectricChillerReport(ChillNum)%Base%QCond &
* ElectricChillerReport(ChillNum)%Base%CondInletTemp) &
/ ( ElectricChillerReport(ChillNum)%QHeatRecovery &
+ ElectricChillerReport(ChillNum)%Base%QCond)
ELSE
AvgCondSinkTemp = CondInletTemp
ENDIF
ELSE
AvgCondSinkTemp = CondInletTemp
ENDIF
!Calculate chiller performance from this set of performance equations.
! from BLAST...Z=(TECONDW-ADJTC(1))/ADJTC(2)-(TLCHLRW-ADJTC(3))
DeltaTemp= (AvgCondSinkTemp - TempCondInDesign) / TempRiseRat &
- (TempEvapOut - TempEvapOutDesign)
! model should have bounds on DeltaTemp and check them (also needs engineering ref content)
! from BLAST...RCAV=RCAVC(1)+RCAVC(2)*Z+RCAVC(3)*Z**2
AvailNomCapRat = CapacityRat(1) &
+ CapacityRat(2) * DeltaTemp &
+ CapacityRat(3) * DeltaTemp ** 2.d0
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.d0
! from BLAST...RCLOAD=AMAX1(MINCHFR(I,IPLCTR),AMIN1(CHLRLOAD(I)/CHLROCAP(I) &
! /RCAV,MAXCHFR(I,IPLCTR)))
!Calculate the PLR. When there is Min PLR and the load is less than Min PLR then the Frac Full load Power
!is calculated at Min PLR, while all other calculations are based on the actual PLR. So in that case once
!FracFullLoadPower is calculated the PLR should be recalculated
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 the PLR is less than Min PLR calculate the actual PLR for calculations. The power will then adjust for
!the cycling.
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(ElectricChiller(ChillNum)%Base%CWLoopNum)%FluidName, &
Node(EvapInletNode)%Temp, &
PlantLoop(ElectricChiller(ChillNum)%Base%CWLoopNum)%FluidIndex, &
'CalcElectricChillerModel')
! 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
!ElectricChiller(ChillNum)%PossibleSubCooling = .FALSE.
!PossibleSubCooling = .NOT. PlantLoop(PlantLoopNum)%TempSetPtCtrl
IF(PlantLoop(PlantLoopNum)%LoopSide(LoopSideNum)%Branch(BranchNum)%Comp(CompNum)%CurOpSchemeType &
== CompSetPtBasedSchemeType)THEN
ElectricChiller(ChillNum)%Base%PossibleSubCooling = .FALSE.
ELSE
ElectricChiller(ChillNum)%Base%PossibleSubCooling = .TRUE.
ENDIF
QEvaporator = AvailChillerCap * OperPartLoadRat
IF (OperPartLoadRat .LT. MinPartLoadRat) THEN
FRAC = MIN(1.0d0,(OperPartLoadRat/MinPartLoadRat))
ELSE
FRAC = 1.0d0
END IF
Power = FracFullLoadPower * FullLoadPowerRat * AvailChillerCap/RatedCOP * FRAC
! Either set the flow to the Constant value or caluclate the flow for the variable volume
IF ( (ElectricChiller(ChillNum)%Base%FlowMode == ConstantFlow) &
.OR. (ElectricChiller(ChillNum)%Base%FlowMode == NotModulated)) THEN
! Start by assuming max (design) flow
EvapMassFlowRate = EvapMassFlowRateMax
! Use SetComponentFlowRate to decide actual flow
CALL SetComponentFlowRate( EvapMassFlowRate, &
EvapInletNode , EvapOutletNode , &
ElectricChiller(ChillNum)%Base%CWLoopNum, &
ElectricChiller(ChillNum)%Base%CWLoopSideNum, &
ElectricChiller(ChillNum)%Base%CWBranchNum, &
ElectricChiller(ChillNum)%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 (ElectricChiller(ChillNum)%Base%FlowMode == LeavingSetpointModulated) THEN
! Calculate the Delta Temp from the inlet temp to the chiller outlet setpoint
SELECT CASE (PlantLoop(ElectricChiller(ChillNum)%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.0d0) THEN
! Calculate desired flow to request based on load
EvapMassFlowRate = ABS(QEvaporator/Cp/EvapDeltaTemp)
!Check to see if the Maximum is exceeded, if so set to maximum
IF((EvapMassFlowRate - EvapMassFlowRateMax) .GT. MassFlowTolerance) &
ElectricChiller(ChillNum)%Base%PossibleSubCooling = .TRUE.
EvapMassFlowRate = MIN(EvapMassFlowRateMax, EvapMassFlowRate)
! Use SetComponentFlowRate to decide actual flow
Call SetComponentFlowRate( EvapMassFlowRate, &
EvapInletNode , EvapOutletNode , &
ElectricChiller(ChillNum)%Base%CWLoopNum, &
ElectricChiller(ChillNum)%Base%CWLoopSideNum, &
ElectricChiller(ChillNum)%Base%CWBranchNum, &
ElectricChiller(ChillNum)%Base%CWCompNum)
SELECT CASE (PlantLoop(ElectricChiller(ChillNum)%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 , &
ElectricChiller(ChillNum)%Base%CWLoopNum, &
ElectricChiller(ChillNum)%Base%CWLoopSideNum, &
ElectricChiller(ChillNum)%Base%CWBranchNum, &
ElectricChiller(ChillNum)%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 , &
ElectricChiller(ChillNum)%Base%CWLoopNum, &
ElectricChiller(ChillNum)%Base%CWLoopSideNum, &
ElectricChiller(ChillNum)%Base%CWBranchNum, &
ElectricChiller(ChillNum)%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 (ElectricChiller(ChillNum)%Base%CondenserType == EvapCooled) THEN
CALL CalcBasinHeaterPower(ElectricChiller(ChillNum)%Base%BasinHeaterPowerFTempDiff,&
ElectricChiller(ChillNum)%Base%BasinHeaterSchedulePtr,&
ElectricChiller(ChillNum)%Base%BasinHeaterSetPointTemp,BasinHeaterPower)
ENDIF
ElectricChiller(ChillNum)%Base%PrintMessage = .FALSE.
RETURN
END IF
!Flow resolver might have given less flow or control scheme have provided more load, which may
!result in subcooling.
IF(ElectricChiller(ChillNum)%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 ((ElectricChiller(ChillNum)%Base%FlowMode == LeavingSetpointModulated ) .OR. &
(PlantLoop(LoopNum)%LoopSide(LoopSideNum)%Branch(BranchNum)%Comp(CompNum)%CurOpSchemeType &
== CompSetPtBasedSchemeType) .OR. &
(Node(EvapOutletNode)%TempSetPoint /= SensedNodeFlagValue) ) THEN
TempEvapOutSetpoint = Node(EvapOutletNode)%TempSetPoint
ELSE
TempEvapOutSetpoint = Node(PlantLoop(LoopNum)%TempSetPointNodeNum)%TempSetPoint
ENDIF
CASE (DualSetpointDeadband)
IF ((ElectricChiller(ChillNum)%Base%FlowMode == LeavingSetpointModulated) .OR. &
(PlantLoop(LoopNum)%LoopSide(LoopSideNum)%Branch(BranchNum)%Comp(CompNum)%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 /RatedCOP * FRAC
IF(EvapMassFlowRate == 0.0d0) THEN
QEvaporator = 0.0d0
EvapOutletTemp = Node(EvapInletNode)%Temp
Power = 0.0d0
ElectricChiller(ChillNum)%Base%PrintMessage = .FALSE.
END IF
IF(QEvaporator == 0.0d0 .AND. ElectricChiller(ChillNum)%Base%CondenserType == EvapCooled) THEN
CALL CalcBasinHeaterPower(ElectricChiller(ChillNum)%Base%BasinHeaterPowerFTempDiff,&
ElectricChiller(ChillNum)%Base%BasinHeaterSchedulePtr,&
ElectricChiller(ChillNum)%Base%BasinHeaterSetPointTemp,BasinHeaterPower)
END IF
END IF !This is the end of the FlowLock Block
!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 (ElectricChiller(ChillNum)%Base%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(ElectricChiller(ChillNum)%HeatRecActive) Call CalcElectricChillerHeatRecovery(ChillNum,QCondenser, &
CondMassFlowRate,CondInletTemp,QHeatRecovered)
CpCond = GetSpecificHeatGlycol(PlantLoop(ElectricChiller(ChillNum)%Base%CDLoopNum)%FluidName, &
CondInletTemp, &
PlantLoop(ElectricChiller(ChillNum)%Base%CDLoopNum)%FluidIndex, &
'CalcElectricChillerModel')
CondOutletTemp = QCondenser/CondMassFlowRate/CpCond + CondInletTemp
ELSE
CALL ShowSevereError('CalcElectricChillerModel: Condenser flow = 0, for ElectricChiller='// &
TRIM(ElectricChiller(ChillNum)%Base%Name))
CALL ShowContinueErrorTimeStamp(' ')
END IF
ELSE !Air Cooled or Evap Cooled
IF(QCondenser > 0.0d0) THEN
CondMassFlowRate = ElectricChiller(ChillNum)%Base%CondMassFlowRateMax * OperPartLoadRat
ELSE
CondMassFlowRate = 0.0d0
END IF
! If Heat Recovery specified for this vapor compression chiller, then Qcondenser will be adjusted by this subroutine
If(ElectricChiller(ChillNum)%HeatRecActive) Call CalcElectricChillerHeatRecovery(ChillNum,QCondenser, &
CondMassFlowRate,CondInletTemp,QHeatRecovered)
IF(CondMassFlowRate .GT. 0.0d0)THEN
CpCond = PsyCpAirFnWTdb(Node(CondInletNode)%HumRat,CondInletTemp,'CalcElectricChillerModel')
CondOutletTemp = CondInletTemp + QCondenser/CondMassFlowRate/CpCond
ELSE
CondOutletTemp = CondInletTemp
END IF
END IF
!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 (ElectricChiller(ChillNum)%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('CalcElectricChillerModel: Condenser loop inlet temperatures over 70.0 C for ElectricChiller='// &
TRIM(ElectricChiller(ChillNum)%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('CalcElectricChillerModel: Capacity ratio below zero for ElectricChiller='// &
TRIM(ElectricChiller(ChillNum)%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 CalcElectricChillerModel