SUBROUTINE CalcVRFCondenser(VRFCond, FirstHVACIteration)
! SUBROUTINE INFORMATION:
! AUTHOR R. Raustad, FSEC
! DATE WRITTEN September 2010
! MODIFIED na
! RE-ENGINEERED na
! PURPOSE OF THIS SUBROUTINE:
! Model the interactions of VRF terminal units with a single variable-speed condenser.
! The terminal units are simulated first, and then the condenser is simulated.
! If terminal units require more capacity than can be delivered by condenser, a limit is set.
! METHODOLOGY EMPLOYED:
! <description>
! REFERENCES:
! na
! USE STATEMENTS:
USE CurveManager, ONLY: CurveValue
USE General, ONLY: TrimSigDigits
USE Psychrometrics, ONLY: RhoH2O
Use DataEnvironment, ONLY: StdBaroPress, EnvironmentName, CurMnDy, OutDryBulbTemp, OutHumRat, OutBaroPress, OutWetBulbTemp
USE DXCoils, ONLY: DXCoilCoolInletAirWBTemp, DXCoilHeatInletAirDBTemp, DXCoilHeatInletAirWBTemp
USE PlantUtilities, ONLY: SetComponentFlowRate
USE FluidProperties, ONLY: GetSpecificHeatGlycol
IMPLICIT NONE ! Enforce explicit typing of all variables in this routine
! SUBROUTINE ARGUMENT DEFINITIONS:
INTEGER, INTENT(IN) :: VRFCond ! index to VRF condenser
LOGICAL, INTENT(IN) :: FirstHVACIteration ! flag for first time through HVAC system simulation
! SUBROUTINE PARAMETER DEFINITIONS:
! na
! INTERFACE BLOCK SPECIFICATIONS:
! na
! DERIVED TYPE DEFINITIONS:
! na
! SUBROUTINE LOCAL VARIABLE DECLARATIONS:
INTEGER :: TUListNum ! index to TU List
INTEGER :: NumTUInList ! number of terminal units is list
INTEGER :: NumTU ! loop counter
INTEGER :: TUIndex ! Index to terminal unit
INTEGER :: CoolCoilIndex ! index to cooling coil in terminal unit
INTEGER :: HeatCoilIndex ! index to heating coil in terminal unit
INTEGER :: NumTUInCoolingMode ! number of terminal units actually cooling
INTEGER :: NumTUInHeatingMode ! number of terminal units actually heating
REAL(r64) :: TUCoolingLoad ! DX cooling coil load to be met by condenser (W)
REAL(r64) :: TUHeatingLoad ! DX heating coil load to be met by condenser (W)
REAL(r64) :: TUParasiticPower ! total terminal unit parasitic power (W)
REAL(r64) :: TUFanPower ! total terminal unit fan power (W)
REAL(r64) :: TotCoolCapTempModFac ! cooling CAPFT curve output
REAL(r64) :: TotHeatCapTempModFac ! heating CAPFT curve output
REAL(r64) :: TotCoolEIRTempModFac ! cooling EIRFT curve output
REAL(r64) :: TotHeatEIRTempModFac ! heating EIRFT curve output
REAL(r64) :: InletAirWetbulbC ! coil inlet air wet-bulb temperature (C)
REAL(r64) :: InletAirDrybulbC ! coil inlet air dry-bulb temperature (C)
REAL(r64) :: CondInletTemp ! condenser inlet air temperature (C)
REAL(r64) :: CondInletHumrat ! condenser inlet air humidity ratio (kg/kg)
REAL(r64) :: OutdoorDryBulb ! outdoor dry-bulb temperature (C)
REAL(r64) :: OutdoorHumRat ! outdoor humidity ratio (kg/kg)
REAL(r64) :: OutdoorPressure ! outdoor pressure (Pa)
REAL(r64) :: OutdoorWetBulb ! outdoor wet-bulb temperature (C)
REAL(r64) :: SumCoolInletWB ! sum of active TU's DX cooling coil inlet air wet-bulb temperature
REAL(r64) :: SumHeatInletDB ! sum of active TU's DX heating coil inlet air dry-bulb temperature
REAL(r64) :: SumHeatInletWB ! sum of active TU's DX heating coil inlet air wet-bulb temperature
REAL(r64) :: CoolOABoundary ! output of cooling boundary curve (outdoor temperature, C)
REAL(r64) :: HeatOABoundary ! output of heating boundary curve (outdoor temperature, C)
REAL(r64) :: TotalTUCoolingCapacity ! sum of TU's cooling capacity (W)
REAL(r64) :: TotalTUHeatingCapacity ! sum of TU's heating capacity (W)
REAL(r64) :: TotalCondCoolingCapacity ! total available condenser cooling capacity (W)
REAL(r64) :: TotalCondHeatingCapacity ! total available condenser heating capacity (W)
REAL(r64) :: CoolingPLR ! condenser cooling PLR
REAL(r64) :: HeatingPLR ! condenser heating PLR
REAL(r64) :: CyclingRatio ! cycling ratio of condenser's compressors
REAL(r64) :: EIRFPLRModFac ! EIRFPLR curve output
INTEGER :: Stage ! used for crankcase heater power calculation
REAL(r64) :: UpperStageCompressorRatio ! used for crankcase heater power calculation
REAL(r64) :: RhoAir ! Density of air [kg/m3]
REAL(r64) :: RhoWater ! Density of water [kg/m3]
REAL(r64) :: CpCond ! Specific Heat of water [J/kg-k]
REAL(r64) :: CondAirMassFlow ! Condenser air mass flow rate [kg/s]
REAL(r64) :: CondWaterMassFlow ! Condenser water mass flow rate [kg/s]
REAL(r64) :: PartLoadFraction ! Part load fraction from PLFFPLR curve
REAL(r64) :: VRFRTF ! VRF runtime fraction when cycling below MINPLR
REAL(r64) :: OutdoorCoilT ! Outdoor coil temperature (C)
REAL(r64) :: OutdoorCoildw ! Outdoor coil delta w assuming coil temp of OutdoorCoilT (kg/kg)
REAL(r64) :: FractionalDefrostTime ! Fraction of time step system is in defrost
REAL(r64) :: HeatingCapacityMultiplier ! Multiplier for heating capacity when system is in defrost
REAL(r64) :: InputPowerMultiplier ! Multiplier for power when system is in defrost
REAL(r64) :: LoadDueToDefrost ! Additional load due to defrost
REAL(r64) :: DefrostEIRTempModFac ! EIR modifier for defrost (function of entering drybulb, outside wetbulb)
INTEGER :: HRCAPFT ! index to heat recovery CAPFTCool curve
REAL(r64) :: HRCAPFTConst ! stead-state capacity fraction
REAL(r64) :: HRInitialCapFrac ! Fractional cooling degradation at the start of heat recovery from cooling mode
REAL(r64) :: HRCapTC ! Time constant used to recover from intial degratation in cooling heat recovery
INTEGER :: HREIRFT ! Index to cool EIR as a function of temperature curve for heat recovery
REAL(r64) :: HREIRFTConst ! stead-state EIR fraction
REAL(r64) :: HRInitialEIRFrac ! Fractional cooling degradation at the start of heat recovery from cooling mode
REAL(r64) :: HREIRTC ! Time constant used to recover from intial degratation in cooling heat recovery
REAL(r64), SAVE :: CurrentEndTime ! end time of current time step
REAL(r64), SAVE :: CurrentEndTimeLast ! end time of last time step
REAL(r64), SAVE :: TimeStepSysLast ! system time step on last time step
REAL(r64) :: SUMultiplier ! multiplier for simulating mode changes
REAL(r64) :: CondPower ! condenser power [W]
REAL(r64) :: CondCapacity ! condenser heat rejection [W]
REAL(r64) :: CondOutletTemp ! Outlet temperature from VRF condenser [C]
REAL(r64) :: QCondTmp ! temporary variable for condenser heat rejection [W]
REAL(r64) :: TotPower ! total condenser power use [W]
LOGICAL :: HRHeatRequestFlag ! flag indicating VRF TU could operate in heating mode
LOGICAL :: HRCoolRequestFlag ! flag indicating VRF TU could operate in cooling mode
! FLOW
! variable initializations
TUListNum = VRF(VRFCond)%ZoneTUListPtr
NumTUInList = TerminalUnitList(TUListNum)%NumTUInList
TUCoolingLoad = 0.0d0
TUHeatingLoad = 0.0d0
TUParasiticPower = 0.0d0
TUFanPower = 0.0d0
CoolingPLR = 0.0d0
HeatingPLR = 0.0d0
CyclingRatio = 1.0d0
SumCoolInletWB = 0.0d0
SumHeatInletDB = 0.0d0
SumHeatInletWB = 0.0d0
TotalCondCoolingCapacity = 0.d0
TotalCondHeatingCapacity = 0.d0
TotalTUCoolingCapacity = 0.d0
TotalTUHeatingCapacity = 0.d0
NumTUInCoolingMode = 0
NumTUInHeatingMode = 0
VRF(VRFCond)%ElecCoolingPower = 0.d0
VRF(VRFCond)%ElecHeatingPower = 0.d0
VRF(VRFCond)%CrankCaseHeaterPower = 0.d0
VRF(VRFCond)%EvapCondPumpElecPower = 0.d0
VRF(VRFCond)%EvapWaterConsumpRate = 0.d0
VRF(VRFCond)%DefrostPower = 0.d0
VRF(VRFCond)%OperatingCoolingCOP = 0.d0
VRF(VRFCond)%OperatingHeatingCOP = 0.d0
VRF(VRFCond)%OperatingCOP = 0.d0
VRF(VRFCond)%BasinHeaterPower = 0.d0
! sum loads on TU coils
DO NumTU = 1, NumTUInList
TUCoolingLoad = TUCoolingLoad + TerminalUnitList(TUListNum)%TotalCoolLoad(NumTU)
TUHeatingLoad = TUHeatingLoad + TerminalUnitList(TUListNum)%TotalHeatLoad(NumTU)
TUParasiticPower = TUParasiticPower + &
VRFTU(TerminalUnitList(TUListNum)%ZoneTUPTR(NumTU))%ParasiticCoolElecPower + &
VRFTU(TerminalUnitList(TUListNum)%ZoneTUPTR(NumTU))%ParasiticHeatElecPower
TUFanPower = TUFanPower + VRFTU(TerminalUnitList(TUListNum)%ZoneTUPTR(NumTU))%FanPower
END DO
VRF(VRFCond)%TUCoolingLoad = TUCoolingLoad
VRF(VRFCond)%TUHeatingLoad = TUHeatingLoad
! loop through TU's and calculate average inlet conditions for active coils
DO NumTU = 1, NumTUInList
TUIndex = TerminalUnitList(TUListNum)%ZoneTUPtr(NumTU)
CoolCoilIndex = VRFTU(TUIndex)%CoolCoilIndex
HeatCoilIndex = VRFTU(TUIndex)%HeatCoilIndex
IF(TerminalUnitList(TUListNum)%TotalCoolLoad(NumTU) .GT. 0.0d0)THEN
SumCoolInletWB = SumCoolInletWB + &
DXCoilCoolInletAirWBTemp(CoolCoilIndex) * TerminalUnitList(TUListNum)%TotalCoolLoad(NumTU)/TUCoolingLoad
NumTUInCoolingMode = NumTUInCoolingMode + 1
END IF
IF(TerminalUnitList(TUListNum)%TotalHeatLoad(NumTU) .GT. 0.0d0)THEN
SumHeatInletDB = SumHeatInletDB + &
DXCoilHeatInletAirDBTemp(HeatCoilIndex) * TerminalUnitList(TUListNum)%TotalHeatLoad(NumTU)/TUHeatingLoad
SumHeatInletWB = SumHeatInletWB + &
DXCoilHeatInletAirWBTemp(HeatCoilIndex) * TerminalUnitList(TUListNum)%TotalHeatLoad(NumTU)/TUHeatingLoad
NumTUInHeatingMode = NumTUInHeatingMode + 1
END IF
END DO
! set condenser entering air conditions
IF (VRF(VRFCond)%CondenserNodeNum /= 0) THEN
OutdoorDryBulb = Node(VRF(VRFCond)%CondenserNodeNum)%Temp
IF(VRF(VRFCond)%CondenserType /= WaterCooled)THEN
OutdoorHumRat = Node(VRF(VRFCond)%CondenserNodeNum)%HumRat
OutdoorPressure = Node(VRF(VRFCond)%CondenserNodeNum)%Press
OutdoorWetBulb = Node(VRF(VRFCond)%CondenserNodeNum)%OutAirWetBulb
ELSE
OutdoorHumRat = OutHumRat
OutdoorPressure = OutBaroPress
OutdoorWetBulb = OutWetBulbTemp
END IF
ELSE
OutdoorDryBulb = OutDryBulbTemp
OutdoorHumRat = OutHumRat
OutdoorPressure = OutBaroPress
OutdoorWetBulb = OutWetBulbTemp
ENDIF
IF (VRF(VRFCond)%CondenserType == AirCooled) THEN
CondInletTemp = OutdoorDryBulb ! Outdoor dry-bulb temp
ELSEIF (VRF(VRFCond)%CondenserType == EvapCooled) THEN
RhoAir = PsyRhoAirFnPbTdbW(OutdoorPressure,OutdoorDryBulb,OutdoorHumRat)
CondAirMassFlow = RhoAir * VRF(VRFCond)%EvapCondAirVolFlowRate
! (Outdoor wet-bulb temp from DataEnvironment) + (1.0-EvapCondEffectiveness) * (drybulb - wetbulb)
CondInletTemp = OutdoorWetBulb + (OutdoorDryBulb-OutdoorWetBulb)*(1.0d0 - VRF(VRFCond)%EvapCondEffectiveness)
CondInletHumrat = PsyWFnTdbTwbPb(CondInletTemp,OutdoorWetBulb,OutdoorPressure)
ELSEIF (VRF(VRFCond)%CondenserType == WaterCooled) THEN
CondInletTemp = OutdoorDryBulb ! node inlet temp from above
CondWaterMassFlow = VRF(VRFCond)%WaterCondenserDesignMassFlow
END IF
VRF(VRFCond)%CondenserInletTemp = CondInletTemp
! calculate capacities and energy use
IF(CoolingLoad(VRFCond) .AND. TerminalUnitList(TUListNum)%CoolingCoilPresent(NumTUInList))THEN
InletAirWetbulbC = SumCoolInletWB
TotCoolCapTempModFac = CurveValue(VRF(VRFCond)%CoolCapFT,InletAirWetbulbC,CondInletTemp)
TotCoolEIRTempModFac = CurveValue(VRF(VRFCond)%CoolEIRFT,InletAirWetbulbC,CondInletTemp)
! recalculate cooling Cap and EIR curve output if using boundary curve along with dual Cap and EIR curves.
IF(VRF(VRFCond)%CoolBoundaryCurvePtr .GT. 0)THEN
CoolOABoundary = CurveValue(VRF(VRFCond)%CoolBoundaryCurvePtr,InletAirWetbulbC)
IF(OutdoorDryBulb .GT. CoolOABoundary)THEN
IF(VRF(VRFCond)%CoolCapFTHi .GT. 0) &
TotCoolCapTempModFac = CurveValue(VRF(VRFCond)%CoolCapFTHi,InletAirWetbulbC,CondInletTemp)
IF(VRF(VRFCond)%CoolEIRFTHi .GT. 0) &
TotCoolEIRTempModFac = CurveValue(VRF(VRFCond)%CoolEIRFTHi,InletAirWetbulbC,CondInletTemp)
END IF
END IF
TotalCondCoolingCapacity = VRF(VRFCond)%CoolingCapacity * CoolCombinationRatio(VRFCond) * TotCoolCapTempModFac
TotalTUCoolingCapacity = TotalCondCoolingCapacity * VRF(VRFCond)%PipingCorrectionCooling
IF(TotalCondCoolingCapacity .GT. 0.0D0)THEN
CoolingPLR = (TUCoolingLoad/VRF(VRFCond)%PipingCorrectionCooling) / TotalCondCoolingCapacity
ELSE
CoolingPLR = 0.0D0
END IF
! Warn user if curve output goes negative
IF(TotCoolEIRTempModFac .LT. 0.d0)THEN
IF(.NOT. Warmupflag .AND. NumTUInCoolingMode .GT. 0)THEN
IF(VRF(VRFCond)%EIRFTempCoolErrorIndex == 0)THEN
CALL ShowSevereMessage(TRIM(cVRFTypes(VRF_HeatPump))//' "'//TRIM(VRF(VRFCond)%Name)//'":')
CALL ShowContinueError(' Cooling Energy Input Ratio Modifier curve (function of temperature) output is negative (' &
//TRIM(TrimSigDigits(TotCoolEIRTempModFac,3))//').')
CALL ShowContinueError(' Negative value occurs using an outdoor air temperature of ' &
//TRIM(TrimSigDigits(CondInletTemp,1))//' C'// &
' and an average indoor air wet-bulb temperature of '//TRIM(TrimSigDigits(InletAirWetbulbC,1))//' C.')
CALL ShowContinueErrorTimeStamp(' Resetting curve output to zero and continuing simulation.')
END IF
CALL ShowRecurringWarningErrorAtEnd(TRIM(ccSimPlantEquipTypes(TypeOf_HeatPumpVRF))//' "'//TRIM(VRF(VRFCond)%Name)//'":'//&
' Cooling Energy Input Ratio Modifier curve (function of temperature) output is negative warning continues...' &
, VRF(VRFCond)%EIRFTempCoolErrorIndex, TotCoolEIRTempModFac, TotCoolEIRTempModFac)
TotCoolEIRTempModFac = 0.d0
END IF
END IF
ELSE IF (HeatingLoad(VRFCond) .AND. TerminalUnitList(TUListNum)%HeatingCoilPresent(NumTUInList))THEN
InletAirDrybulbC = SumHeatInletDB
InletAirWetbulbC = SumHeatInletWB
SELECT CASE(VRF(VRFCond)%HeatingPerformanceOATType)
CASE(DryBulbIndicator)
TotHeatCapTempModFac = CurveValue(VRF(VRFCond)%HeatCapFT,InletAirDrybulbC,CondInletTemp)
TotHeatEIRTempModFac = CurveValue(VRF(VRFCond)%HeatEIRFT,InletAirDrybulbC,CondInletTemp)
CASE(WetBulbIndicator)
TotHeatCapTempModFac = CurveValue(VRF(VRFCond)%HeatCapFT,InletAirDrybulbC,OutdoorWetBulb)
TotHeatEIRTempModFac = CurveValue(VRF(VRFCond)%HeatEIRFT,InletAirDrybulbC,OutdoorWetBulb)
CASE DEFAULT
TotHeatCapTempModFac = 1.d0
TotHeatEIRTempModFac = 1.d0
END SELECT
! recalculate heating Cap and EIR curve output if using boundary curve along with dual Cap and EIR curves.
IF(VRF(VRFCond)%HeatBoundaryCurvePtr .GT. 0)THEN
HeatOABoundary = CurveValue(VRF(VRFCond)%HeatBoundaryCurvePtr,InletAirDrybulbC)
SELECT CASE(VRF(VRFCond)%HeatingPerformanceOATType)
CASE(DryBulbIndicator)
IF(OutdoorDryBulb .GT. HeatOABoundary)THEN
IF(VRF(VRFCond)%HeatCapFTHi .GT. 0) &
TotHeatCapTempModFac = CurveValue(VRF(VRFCond)%HeatCapFTHi,InletAirDrybulbC,CondInletTemp)
END IF
CASE(WetBulbIndicator)
IF(OutdoorWetBulb .GT. HeatOABoundary)THEN
IF(VRF(VRFCond)%HeatCapFTHi .GT. 0) &
TotHeatCapTempModFac = CurveValue(VRF(VRFCond)%HeatCapFTHi,InletAirDrybulbC,OutdoorWetBulb)
END IF
CASE DEFAULT
TotHeatCapTempModFac = 1.d0
END SELECT
END IF
IF(VRF(VRFCond)%EIRHeatBoundaryCurvePtr .GT. 0)THEN
HeatOABoundary = CurveValue(VRF(VRFCond)%EIRHeatBoundaryCurvePtr,InletAirDrybulbC)
SELECT CASE(VRF(VRFCond)%HeatingPerformanceOATType)
CASE(DryBulbIndicator)
IF(OutdoorDryBulb .GT. HeatOABoundary)THEN
IF(VRF(VRFCond)%HeatEIRFTHi .GT. 0) &
TotHeatEIRTempModFac = CurveValue(VRF(VRFCond)%HeatEIRFTHi,InletAirDrybulbC,CondInletTemp)
END IF
CASE(WetBulbIndicator)
IF(OutdoorWetBulb .GT. HeatOABoundary)THEN
IF(VRF(VRFCond)%HeatEIRFTHi .GT. 0) &
TotHeatEIRTempModFac = CurveValue(VRF(VRFCond)%HeatEIRFTHi,InletAirDrybulbC,OutdoorWetBulb)
END IF
CASE DEFAULT
TotHeatEIRTempModFac = 1.d0
END SELECT
END IF
! Initializing defrost adjustment factors
LoadDueToDefrost = 0.0d0
HeatingCapacityMultiplier = 1.d0
FractionalDefrostTime = 0.0d0
InputPowerMultiplier = 1.d0
! Check outdoor temperature to determine of defrost is active
IF (OutdoorDryBulb .LE. VRF(VRFCond)%MaxOATDefrost) THEN
! Calculating adjustment factors for defrost
! Calculate delta w through outdoor coil by assuming a coil temp of 0.82*DBT-9.7(F) per DOE2.1E
OutdoorCoilT = 0.82d0 * OutdoorDryBulb - 8.589d0
OutdoorCoildw = MAX(1.0d-6,(OutdoorHumRat - PsyWFnTdpPb(OutdoorCoilT,OutdoorPressure)))
! Calculate defrost adjustment factors depending on defrost control type
IF (VRF(VRFCond)%DefrostControl .EQ. Timed) THEN
FractionalDefrostTime = VRF(VRFCond)%DefrostFraction
IF(FractionalDefrostTime .GT. 0.d0)THEN
HeatingCapacityMultiplier = 0.909d0 - 107.33d0 * OutdoorCoildw
InputPowerMultiplier = 0.90d0 - 36.45d0*OutdoorCoildw
END IF
ELSE !else defrost control is on-demand
FractionalDefrostTime = 1.0d0 / (1.0d0 + 0.01446d0 / OutdoorCoildw)
HeatingCapacityMultiplier = 0.875d0 * ( 1.0d0 - FractionalDefrostTime)
InputPowerMultiplier = 0.954d0 * ( 1.0d0 - FractionalDefrostTime)
END IF
IF (FractionalDefrostTime .GT. 0.0d0) THEN
! Calculate defrost adjustment factors depending on defrost control strategy
IF (VRF(VRFCond)%DefrostStrategy .EQ. ReverseCycle) THEN
LoadDueToDefrost = (0.01d0 * FractionalDefrostTime) * &
(7.222d0 - OutdoorDryBulb) * &
(VRF(VRFCond)%HeatingCapacity/1.01667d0)
DefrostEIRTempModFac = CurveValue(VRF(VRFCond)%DefrostEIRPtr,&
MAX(15.555d0,InletAirWetbulbC),MAX(15.555d0,OutdoorDryBulb))
! Warn user if curve output goes negative
IF(DefrostEIRTempModFac .LT. 0.0d0)THEN
IF(.NOT. Warmupflag)THEN
IF(VRF(VRFCond)%DefrostHeatErrorIndex == 0)THEN
CALL ShowSevereMessage(TRIM(cVRFTypes(VRF_HeatPump))//' "'//TRIM(VRF(VRFCond)%Name)//'":')
CALL ShowContinueError(' Defrost Energy Input Ratio Modifier curve (function of temperature) output is'// &
' negative ('//TRIM(TrimSigDigits(DefrostEIRTempModFac,3))//').')
CALL ShowContinueError(' Negative value occurs using an outdoor air dry-bulb temperature of ' &
//TRIM(TrimSigDigits(OutdoorDryBulb,1))//' C'// &
' and an average indoor air wet-bulb temperature of '//TRIM(TrimSigDigits(InletAirWetbulbC,1))//' C.')
CALL ShowContinueErrorTimeStamp(' Resetting curve output to zero and continuing simulation.')
END IF
CALL ShowRecurringWarningErrorAtEnd(TRIM(ccSimPlantEquipTypes(TypeOf_HeatPumpVRF))//' "'// &
TRIM(VRF(VRFCond)%Name)//'":'//&
' Defrost Energy Input Ratio Modifier curve (function of temperature) output is negative warning continues...' &
, VRF(VRFCond)%DefrostHeatErrorIndex, DefrostEIRTempModFac, DefrostEIRTempModFac)
DefrostEIRTempModFac = 0.0d0
END IF
END IF
VRF(VRFCond)%DefrostPower = DefrostEIRTempModFac * &
(VRF(VRFCond)%HeatingCapacity/1.01667d0) &
* FractionalDefrostTime
ELSE ! Defrost strategy is resistive
VRF(VRFCond)%DefrostPower = VRF(VRFCond)%DefrostCapacity &
* FractionalDefrostTime
END IF
ELSE ! Defrost is not active because FractionalDefrostTime = 0.0
VRF(VRFCond)%DefrostPower = 0.d0
END IF
END IF
TotalCondHeatingCapacity = VRF(VRFCond)%HeatingCapacity * HeatCombinationRatio(VRFCond) * TotHeatCapTempModFac &
* HeatingCapacityMultiplier
TotalTUHeatingCapacity = TotalCondHeatingCapacity * VRF(VRFCond)%PipingCorrectionHeating
IF(TotalCondHeatingCapacity .GT. 0.0D0)THEN
HeatingPLR = (TUHeatingLoad/VRF(VRFCond)%PipingCorrectionHeating) / TotalCondHeatingCapacity
HeatingPLR = HeatingPLR + LoadDueToDefrost / TotalCondHeatingCapacity
ELSE
HeatingPLR = 0.0D0
END IF
! Warn user if curve output goes negative
IF(TotHeatEIRTempModFac .LT. 0.d0)THEN
IF(.NOT. Warmupflag .AND. NumTUInHeatingMode .GT. 0)THEN
IF(VRF(VRFCond)%EIRFTempHeatErrorIndex == 0)THEN
CALL ShowSevereMessage(TRIM(cVRFTypes(VRF_HeatPump))//' "'//TRIM(VRF(VRFCond)%Name)//'":')
CALL ShowContinueError(' Heating Energy Input Ratio Modifier curve (function of temperature) output is negative (' &
//TRIM(TrimSigDigits(TotHeatEIRTempModFac,3))//').')
SELECT CASE(VRF(VRFCond)%HeatingPerformanceOATType)
CASE(DryBulbIndicator)
CALL ShowContinueError(' Negative value occurs using an outdoor air dry-bulb temperature of ' &
//TRIM(TrimSigDigits(CondInletTemp,1))//' C'// &
' and an average indoor air dry-bulb temperature of '//TRIM(TrimSigDigits(InletAirDrybulbC,1))//' C.')
CASE(WetBulbIndicator)
CALL ShowContinueError(' Negative value occurs using an outdoor air wet-bulb temperature of ' &
//TRIM(TrimSigDigits(OutdoorWetBulb,1))//' C'// &
' and an average indoor air wet-bulb temperature of '//TRIM(TrimSigDigits(InletAirWetbulbC,1))//' C.')
CASE DEFAULT
END SELECT
CALL ShowContinueErrorTimeStamp(' Resetting curve output to zero and continuing simulation.')
END IF
CALL ShowRecurringWarningErrorAtEnd(TRIM(ccSimPlantEquipTypes(TypeOf_HeatPumpVRF))//' "'//TRIM(VRF(VRFCond)%Name)//'":'//&
' Heating Energy Input Ratio Modifier curve (function of temperature) output is negative warning continues...' &
, VRF(VRFCond)%EIRFTempHeatErrorIndex, TotHeatEIRTempModFac, TotHeatEIRTempModFac)
TotHeatEIRTempModFac = 0.d0
END IF
END IF
END IF
VRF(VRFCond)%VRFCondPLR = MAX(CoolingPLR,HeatingPLR)
HRHeatRequestFlag = ANY(TerminalUnitList(TUListNum)%HRHeatRequest)
HRCoolRequestFlag = ANY(TerminalUnitList(TUListNum)%HRCoolRequest)
IF(.NOT. DoingSizing .AND. .NOT. Warmupflag)THEN
IF(HRHeatRequestFlag .AND. HRCoolRequestFlag)THEN
! determine operating mode change
IF(.NOT. VRF(VRFCond)%HRCoolingActive .AND. .NOT. VRF(VRFCond)%HRHeatingActive)THEN
VRF(VRFCond)%ModeChange = .TRUE.
END IF
IF(CoolingLoad(VRFCond))THEN
IF(VRF(VRFCond)%HRHeatingActive .AND. .NOT. VRF(VRFCond)%HRCoolingActive)THEN
VRF(VRFCond)%HRModeChange = .TRUE.
END IF
VRF(VRFCond)%HRCoolingActive = .TRUE.
VRF(VRFCond)%HRHeatingActive = .FALSE.
HRCAPFT = VRF(VRFCond)%HRCAPFTCool ! Index to cool capacity as a function of temperature\PLR curve for heat recovery
IF(HRCAPFT .GT. 0)THEN
! VRF(VRFCond)%HRCAPFTCoolConst = 0.9d0 ! initialized to 0.9
IF(VRF(VRFCond)%HRCAPFTCoolType == BIQUADRATIC)THEN ! Curve type for HRCAPFTCool
VRF(VRFCond)%HRCAPFTCoolConst = CurveValue(HRCAPFT,InletAirWetbulbC,CondInletTemp)
ELSE
VRF(VRFCond)%HRCAPFTCoolConst = CurveValue(HRCAPFT,VRF(VRFCond)%VRFCondPLR)
END IF
END IF
HRCAPFTConst = VRF(VRFCond)%HRCAPFTCoolConst
HRInitialCapFrac = VRF(VRFCond)%HRInitialCoolCapFrac ! Fractional cooling degradation at the start of heat recovery from cooling mode
HRCapTC = VRF(VRFCond)%HRCoolCapTC ! Time constant used to recover from intial degratation in cooling heat recovery
HREIRFT = VRF(VRFCond)%HREIRFTCool ! Index to cool EIR as a function of temperature curve for heat recovery
IF(HREIRFT .GT. 0)THEN
! VRF(VRFCond)%HREIRFTCoolConst = 1.1d0 ! initialized to 1.1
IF(VRF(VRFCond)%HREIRFTCoolType == BIQUADRATIC)THEN ! Curve type for HRCAPFTCool
VRF(VRFCond)%HREIRFTCoolConst = CurveValue(HREIRFT,InletAirWetbulbC,CondInletTemp)
ELSE
VRF(VRFCond)%HREIRFTCoolConst = CurveValue(HREIRFT,VRF(VRFCond)%VRFCondPLR)
END IF
END IF
HREIRFTConst = VRF(VRFCond)%HREIRFTCoolConst
HRInitialEIRFrac = VRF(VRFCond)%HRInitialCoolEIRFrac ! Fractional cooling degradation at the start of heat recovery from cooling mode
HREIRTC = VRF(VRFCond)%HRCoolEIRTC ! Time constant used to recover from intial degratation in cooling heat recovery
ELSE IF(HeatingLoad(VRFCond))THEN
IF(.NOT. VRF(VRFCond)%HRHeatingActive .AND. VRF(VRFCond)%HRCoolingActive)THEN
VRF(VRFCond)%HRModeChange = .TRUE.
END IF
VRF(VRFCond)%HRCoolingActive = .FALSE.
VRF(VRFCond)%HRHeatingActive = .TRUE.
HRCAPFT = VRF(VRFCond)%HRCAPFTHeat ! Index to heat capacity as a function of temperature\PLR curve for heat recovery
IF(HRCAPFT .GT. 0)THEN
! VRF(VRFCond)%HRCAPFTHeatConst = 1.1d0 ! initialized to 1.1
IF(VRF(VRFCond)%HRCAPFTHeatType == BIQUADRATIC)THEN ! Curve type for HRCAPFTCool
SELECT CASE(VRF(VRFCond)%HeatingPerformanceOATType)
CASE(DryBulbIndicator)
VRF(VRFCond)%HRCAPFTHeatConst = CurveValue(HRCAPFT,InletAirDrybulbC,CondInletTemp)
CASE(WetBulbIndicator)
VRF(VRFCond)%HRCAPFTHeatConst = CurveValue(HRCAPFT,InletAirDrybulbC,OutdoorWetBulb)
CASE DEFAULT
VRF(VRFCond)%HRCAPFTHeatConst = 1.d0
END SELECT
ELSE
VRF(VRFCond)%HRCAPFTHeatConst = CurveValue(HRCAPFT,VRF(VRFCond)%VRFCondPLR)
END IF
END IF
HRCAPFTConst = VRF(VRFCond)%HRCAPFTHeatConst
HRInitialCapFrac = VRF(VRFCond)%HRInitialHeatCapFrac ! Fractional heating degradation at the start of heat recovery from cooling mode
HRCapTC = VRF(VRFCond)%HRHeatCapTC ! Time constant used to recover from intial degratation in heating heat recovery
HREIRFT = VRF(VRFCond)%HREIRFTHeat ! Index to cool EIR as a function of temperature curve for heat recovery
IF(HREIRFT .GT. 0)THEN
! VRF(VRFCond)%HREIRFTCoolConst = 1.1d0 ! initialized to 1.1
IF(VRF(VRFCond)%HREIRFTHeatType == BIQUADRATIC)THEN ! Curve type for HRCAPFTHeat
SELECT CASE(VRF(VRFCond)%HeatingPerformanceOATType)
CASE(DryBulbIndicator)
VRF(VRFCond)%HREIRFTHeatConst = CurveValue(HREIRFT,InletAirDrybulbC,CondInletTemp)
CASE(WetBulbIndicator)
VRF(VRFCond)%HREIRFTHeatConst = CurveValue(HREIRFT,InletAirDrybulbC,OutdoorWetBulb)
CASE DEFAULT
VRF(VRFCond)%HREIRFTHeatConst = 1.d0
END SELECT
ELSE
VRF(VRFCond)%HREIRFTHeatConst = CurveValue(HREIRFT,VRF(VRFCond)%VRFCondPLR)
END IF
END IF
HREIRFTConst = VRF(VRFCond)%HRCAPFTHeatConst
HRInitialEIRFrac = VRF(VRFCond)%HRInitialHeatEIRFrac ! Fractional heating degradation at the start of heat recovery from heating mode
HREIRTC = VRF(VRFCond)%HRHeatEIRTC ! Time constant used to recover from intial degratation in heating heat recovery
ELSE
! zone thermostats satisfied, condenser is off. Set values anyway
HRCAPFTConst = 1.d0
HRInitialCapFrac = 1.d0
HRCapTC = 1.d0
HREIRFTConst = 1.d0
HRInitialEIRFrac = 1.d0
HREIRTC = 1.d0
IF(VRF(VRFCond)%HRHeatingActive .OR. VRF(VRFCond)%HRCoolingActive)THEN
VRF(VRFCond)%HRModeChange = .TRUE.
END IF
VRF(VRFCond)%HRCoolingActive = .FALSE.
VRF(VRFCond)%HRHeatingActive = .FALSE.
END IF
ELSE ! IF(HRHeatRequestFlag .AND. HRCoolRequestFlag)THEN -- Heat recovery turned off
HRCAPFTConst = 1.d0
HRInitialCapFrac = 1.d0
HRCapTC = 0.d0
HREIRFTConst = 1.d0
HRInitialEIRFrac = 1.d0
HREIRTC = 0.d0
VRF(VRFCond)%HRModeChange = .FALSE.
VRF(VRFCond)%HRCoolingActive = .FALSE.
VRF(VRFCond)%HRHeatingActive = .FALSE.
END IF
! calculate end time of current time step to determine if max capacity reset is required
CurrentEndTime = REAL(((DayOfSim-1)*24),r64) + CurrentTime - TimeStepZone + SysTimeElapsed
IF(VRF(VRFCond)%ModeChange .OR. VRF(VRFCond)%HRModeChange)THEN
IF(VRF(VRFCond)%HRCoolingActive .AND. VRF(VRFCond)%HRTimer == 0.d0)THEN
VRF(VRFCond)%HRTimer = CurrentEndTimeLast
ELSE IF(VRF(VRFCond)%HRHeatingActive .AND. VRF(VRFCond)%HRTimer == 0.d0)THEN
VRF(VRFCond)%HRTimer = CurrentEndTimeLast
ELSE IF(.NOT. VRF(VRFCond)%HRCoolingActive .AND. .NOT. VRF(VRFCond)%HRHeatingActive)THEN
VRF(VRFCond)%HRTimer = 0.d0
END IF
END IF
VRF(VRFCond)%HRTime = MAX(0.d0,CurrentEndTime - VRF(VRFCond)%HRTimer)
IF(VRF(VRFCond)%HRTime .LT. (HRCapTC * 5.d0))THEN
IF(HRCAPTC .GT. 0.d0)THEN
SUMultiplier = MIN(1.d0, 1.d0 - EXP(-VRF(VRFCond)%HRTime/HRCAPTC))
ELSE
SUMultiplier = 1.d0
END IF
ELSE
SUMultiplier = 1.d0
VRF(VRFCond)%ModeChange = .FALSE.
VRF(VRFCond)%HRModeChange = .FALSE.
END IF
VRF(VRFCond)%SUMultiplier = SUMultiplier
TimeStepSysLast = TimeStepSys
CurrentEndTimeLast = CurrentEndTime
IF(VRF(VRFCond)%HeatRecoveryUsed .AND. VRF(VRFCond)%HRCoolingActive)THEN
TotalCondCoolingCapacity = HRCAPFTConst * TotalCondCoolingCapacity
TotalCondCoolingCapacity = HRInitialCapFrac * TotalCondCoolingCapacity + &
(1.d0 - HRInitialCapFrac) * TotalCondCoolingCapacity * SUMultiplier
TotalTUCoolingCapacity = TotalCondCoolingCapacity * VRF(VRFCond)%PipingCorrectionCooling
IF(TotalCondCoolingCapacity .GT. 0.d0)THEN
CoolingPLR = MIN(1.d0,(TUCoolingLoad/VRF(VRFCond)%PipingCorrectionCooling) / TotalCondCoolingCapacity)
ELSE
CoolingPLR = 0.d0
END IF
ELSE IF(VRF(VRFCond)%HeatRecoveryUsed .AND. VRF(VRFCond)%HRHeatingActive)THEN
TotalCondHeatingCapacity = HRCAPFTConst * TotalCondHeatingCapacity
TotalCondHeatingCapacity = HRInitialCapFrac * TotalCondHeatingCapacity + &
(1.d0 - HRInitialCapFrac) * TotalCondHeatingCapacity * SUMultiplier
TotalTUHeatingCapacity = TotalCondHeatingCapacity * VRF(VRFCond)%PipingCorrectionHeating
IF(TotalCondHeatingCapacity .GT. 0.d0)THEN
HeatingPLR = MIN(1.d0,(TUHeatingLoad/VRF(VRFCond)%PipingCorrectionHeating) / TotalCondHeatingCapacity)
ELSE
HeatingPLR = 0.d0
END IF
END IF
VRF(VRFCond)%VRFCondPLR = MAX(CoolingPLR,HeatingPLR)
END IF
VRF(VRFCond)%TotalCoolingCapacity = TotalCondCoolingCapacity * CoolingPLR
VRF(VRFCond)%TotalHeatingCapacity = TotalCondHeatingCapacity * HeatingPLR
IF(VRF(VRFCond)%MinPLR .GT. 0.0d0)THEN
CyclingRatio = MIN(1.0d0,VRF(VRFCond)%VRFCondPLR/VRF(VRFCond)%MinPLR)
IF(VRF(VRFCond)%VRFCondPLR .LT. VRF(VRFCond)%MinPLR .AND. VRF(VRFCond)%VRFCondPLR .GT. 0.0d0)THEN
VRF(VRFCond)%VRFCondPLR = VRF(VRFCond)%MinPLR
END IF
END IF
VRF(VRFCond)%VRFCondCyclingRatio = CyclingRatio ! report variable for cycling rate
VRF(VRFCond)%OperatingMode = 0 ! report variable for heating or cooling mode
EIRFPLRModFac = 1.d0
VRFRTF = 0.d0
! cooling and heating is optional (only one may exist), if so then performance curve for missing coil are not required
IF(CoolingLoad(VRFCond) .AND. CoolingPLR > 0.d0)THEN
VRF(VRFCond)%OperatingMode = 1
IF(CoolingPLR .GT. 1.d0)THEN
IF(VRF(VRFCond)%CoolEIRFPLR2.GT.0) EIRFPLRModFac=CurveValue(VRF(VRFCond)%CoolEIRFPLR2,MAX(VRF(VRFCond)%MinPLR,CoolingPLR))
ELSE
IF(VRF(VRFCond)%CoolEIRFPLR1.GT.0) EIRFPLRModFac=CurveValue(VRF(VRFCond)%CoolEIRFPLR1,MAX(VRF(VRFCond)%MinPLR,CoolingPLR))
END IF
! find part load fraction to calculate RTF
IF(VRF(VRFCond)%CoolPLFFPLR .GT. 0) THEN
PartLoadFraction = MAX(0.7d0,CurveValue(VRF(VRFCond)%CoolPLFFPLR,CyclingRatio))
ELSE
PartLoadFraction = 1.0d0
END IF
VRFRTF = MIN(1.0d0,(CyclingRatio / PartLoadFraction))
VRF(VRFCond)%ElecCoolingPower = (VRF(VRFCond)%RatedCoolingPower * TotCoolCapTempModFac) &
* TotCoolEIRTempModFac * EIRFPLRModFac * VRFRTF
END IF
IF(HeatingLoad(VRFCond) .AND. HeatingPLR > 0.0d0)THEN
VRF(VRFCond)%OperatingMode = 2
IF(HeatingPLR .GT. 1.d0)THEN
IF(VRF(VRFCond)%HeatEIRFPLR2.GT.0) EIRFPLRModFac=CurveValue(VRF(VRFCond)%HeatEIRFPLR2,MAX(VRF(VRFCond)%MinPLR,HeatingPLR))
ELSE
IF(VRF(VRFCond)%HeatEIRFPLR1.GT.0) EIRFPLRModFac=CurveValue(VRF(VRFCond)%HeatEIRFPLR1,MAX(VRF(VRFCond)%MinPLR,HeatingPLR))
END IF
! find part load fraction to calculate RTF
IF(VRF(VRFCond)%HeatPLFFPLR .GT. 0) THEN
PartLoadFraction = MAX(0.7d0,CurveValue(VRF(VRFCond)%HeatPLFFPLR,CyclingRatio))
ELSE
PartLoadFraction = 1.0d0
END IF
VRFRTF = MIN(1.0d0,(CyclingRatio / PartLoadFraction))
VRF(VRFCond)%ElecHeatingPower = (VRF(VRFCond)%RatedHeatingPower * TotHeatCapTempModFac) &
* TotHeatEIRTempModFac * EIRFPLRModFac * VRFRTF &
* InputPowerMultiplier
END IF
VRF(VRFCond)%VRFCondRTF = VRFRTF
! calculate crankcase heater power
IF(VRF(VRFCond)%MaxOATCCHeater .GT. OutdoorDryBulb)THEN
! calculate crankcase heater power
VRF(VRFCond)%CrankCaseHeaterPower = VRF(VRFCond)%CCHeaterPower * (1.d0 - VRFRTF)
IF(VRF(VRFCond)%NumCompressors .GT. 1)THEN
UpperStageCompressorRatio = (1.d0 - VRF(VRFCond)%CompressorSizeRatio) / (VRF(VRFCond)%NumCompressors - 1)
DO Stage = 1, VRF(VRFCond)%NumCompressors - 2
IF(VRF(VRFCond)%VRFCondPLR .LT. (VRF(VRFCond)%CompressorSizeRatio + Stage * UpperStageCompressorRatio)) THEN
VRF(VRFCond)%CrankCaseHeaterPower = VRF(VRFCond)%CrankCaseHeaterPower + &
VRF(VRFCond)%CCHeaterPower
END IF
END DO
END IF
ELSE
VRF(VRFCond)%CrankCaseHeaterPower = 0.d0
END IF
CondCapacity = MAX(VRF(VRFCond)%TotalCoolingCapacity,VRF(VRFCond)%TotalHeatingCapacity)*VRFRTF
CondPower = MAX(VRF(VRFCond)%ElecCoolingPower,VRF(VRFCond)%ElecHeatingPower)
IF(VRF(VRFCond)%ElecCoolingPower .GT. 0.d0)THEN
VRF(VRFCond)%QCondenser = CondCapacity + CondPower - &
VRF(VRFCond)%TUHeatingLoad/VRF(VRFCond)%PipingCorrectionHeating
ELSE IF(VRF(VRFCond)%ElecHeatingPower .GT. 0.d0)THEN
VRF(VRFCond)%QCondenser = -CondCapacity + CondPower + &
VRF(VRFCond)%TUCoolingLoad/VRF(VRFCond)%PipingCorrectionCooling
ELSE
VRF(VRFCond)%QCondenser = 0.d0
END IF
IF (VRF(VRFCond)%CondenserType == EvapCooled) THEN
! Calculate basin heater power
CALL CalcBasinHeaterPower(VRF(VRFCond)%BasinHeaterPowerFTempDiff,&
VRF(VRFCond)%BasinHeaterSchedulePtr,&
VRF(VRFCond)%BasinHeaterSetPointTemp,VRF(VRFCond)%BasinHeaterPower)
VRF(VRFCond)%BasinHeaterPower = VRF(VRFCond)%BasinHeaterPower * &
(1.d0 - VRFRTF)
! calcualte evaporative condenser pump power and water consumption
IF (CoolingLoad(VRFCond) .AND. CoolingPLR > 0.d0) THEN
!******************
! WATER CONSUMPTION IN m3 OF WATER FOR DIRECT
! H2O [m3/sec] = Delta W[KgH2O/Kg air]*Mass Flow Air[Kg air]
! /RhoWater [kg H2O/m3 H2O]
!******************
RhoWater = RhoH2O(OutdoorDryBulb)
VRF(VRFCond)%EvapWaterConsumpRate = &
(CondInletHumrat - OutdoorHumRat) * &
CondAirMassFlow/RhoWater * VRF(VRFCond)%VRFCondPLR
VRF(VRFCond)%EvapCondPumpElecPower = VRF(VRFCond)%EvapCondPumpPower * VRFRTF
END IF
ELSE IF(VRF(VRFCond)%CondenserType == WaterCooled) THEN
IF(CondCapacity .GT. 0.0d0)THEN
CondenserWaterMassFlowRate = CondWaterMassFlow
ELSE
CondenserWaterMassFlowRate = 0.d0
END IF
Call SetComponentFlowRate(CondenserWaterMassFlowRate, &
VRF(VRFCond)%CondenserNodeNum, VRF(VRFCond)%CondenserOutletNodeNum, &
VRF(VRFCond)%SourceLoopNum, VRF(VRFCond)%SourceLoopSideNum, &
VRF(VRFCond)%SourceBranchNum, VRF(VRFCond)%SourceCompNum)
VRF(VRFCond)%CondenserInletTemp = Node(VRF(VRFCond)%CondenserNodeNum)%Temp
VRF(VRFCond)%WaterCondenserMassFlow = Node(VRF(VRFCond)%CondenserNodeNum)%MassFlowRate
CpCond = GetSpecificHeatGlycol(PlantLoop(VRF(VRFCond)%SourceLoopNum)%FluidName, &
VRF(VRFCond)%CondenserInletTemp, &
PlantLoop(VRF(VRFCond)%SourceLoopNum)%FluidIndex, &
'VRFCondenser')
IF(CondWaterMassFlow .GT. 0.0d0)THEN
CondOutletTemp = VRF(VRFCond)%QCondenser/(CondWaterMassFlow*CpCond) + CondInletTemp
ELSE
CondOutletTemp = CondInletTemp
END IF
QCondTmp = CondWaterMassFlow*CpCond*(CondOutletTemp-CondInletTemp)
VRF(VRFCond)%CondenserSideOutletTemp = CondOutletTemp
END IF
! calculate operating COP
IF(CoolingLoad(VRFCond) .AND. CoolingPLR > 0.d0)THEN
IF(VRF(VRFCond)%ElecCoolingPower .NE. 0.d0)THEN
! this calc should use delivered capacity, not condenser capacity, use VRF(VRFCond)%TUCoolingLoad
VRF(VRFCond)%OperatingCoolingCOP = (VRF(VRFCond)%TotalCoolingCapacity)/ &
(VRF(VRFCond)%ElecCoolingPower + VRF(VRFCond)%CrankCaseHeaterPower + &
VRF(VRFCond)%EvapCondPumpElecPower + VRF(VRFCond)%DefrostPower)
ELSE
VRF(VRFCond)%OperatingCoolingCOP = 0.D0
END IF
END IF
IF(HeatingLoad(VRFCond) .AND. HeatingPLR > 0.0d0)THEN
IF(VRF(VRFCond)%ElecHeatingPower .NE. 0.d0)THEN
! this calc should use deleivered capacity, not condenser capacity, use VRF(VRFCond)%TUHeatingLoad
VRF(VRFCond)%OperatingHeatingCOP = (VRF(VRFCond)%TotalHeatingCapacity)/ &
(VRF(VRFCond)%ElecHeatingPower + VRF(VRFCond)%CrankCaseHeaterPower + &
VRF(VRFCond)%EvapCondPumpElecPower + VRF(VRFCond)%DefrostPower)
ELSE
VRF(VRFCond)%OperatingHeatingCOP = 0.D0
END IF
END IF
TotPower = TUParasiticPower + TUFanPower + VRF(VRFCond)%ElecHeatingPower + VRF(VRFCond)%ElecCoolingPower + &
VRF(VRFCond)%CrankCaseHeaterPower + VRF(VRFCond)%EvapCondPumpElecPower + VRF(VRFCond)%DefrostPower
IF(TotPower .GT. 0.d0) &
VRF(VRFCond)%OperatingCOP = (VRF(VRFCond)%TUCoolingLoad + VRF(VRFCond)%TUHeatingLoad) / TotPower
! limit the TU capacity when the condenser is maxed out on capacity
! I think this next line will make the max cap report variable match the coil objects, will probably change the answer though
! IF(CoolingLoad(VRFCond) .AND. NumTUInCoolingMode .GT. 0 .AND. MaxCoolingCapacity(VRFCond) == MaxCap)THEN
IF(CoolingLoad(VRFCond) .AND. NumTUInCoolingMode .GT. 0)THEN
! IF TU capacity is greater than condenser capacity find maximum allowed TU capacity (i.e., conserve energy)
IF(TUCoolingLoad > TotalTUCoolingCapacity)THEN
CALL LimitTUCapacity(VRFCond,NumTUInList, &
TotalTUCoolingCapacity,TerminalUnitList(TUListNum)%TotalCoolLoad, MaxCoolingCapacity(VRFCond), &
TotalTUHeatingCapacity,TerminalUnitList(TUListNum)%TotalHeatLoad, MaxHeatingCapacity(VRFCond))
END IF
ELSE IF(HeatingLoad(VRFCond) .AND. NumTUInHeatingMode .GT. 0)THEN
! IF TU capacity is greater than condenser capacity
IF(TUHeatingLoad > TotalTUHeatingCapacity)THEN
CALL LimitTUCapacity(VRFCond,NumTUInList, &
TotalTUHeatingCapacity,TerminalUnitList(TUListNum)%TotalHeatLoad, MaxHeatingCapacity(VRFCond), &
TotalTUCoolingCapacity,TerminalUnitList(TUListNum)%TotalCoolLoad, MaxCoolingCapacity(VRFCond))
END IF
ELSE
END IF
RETURN
END SUBROUTINE CalcVRFCondenser