Nodes of different colours represent the following:
Solid arrows point from a parent (sub)module to the submodule which is descended from it. Dashed arrows point from a module being used to the module or program unit using it. Where possible, edges connecting nodes are given different colours to make them easier to distinguish in large graphs.
Type | Intent | Optional | Attributes | Name | ||
---|---|---|---|---|---|---|
integer, | intent(in) | :: | DXCoilNum | |||
real(kind=r64), | intent(in) | :: | SpeedRatio | |||
real(kind=r64), | intent(in) | :: | CycRatio | |||
logical, | intent(in), | optional | :: | ForceOn |
Nodes of different colours represent the following:
Solid arrows point from a procedure to one which it calls. Dashed arrows point from an interface to procedures which implement that interface. This could include the module procedures in a generic interface or the implementation in a submodule of an interface in a parent module. Where possible, edges connecting nodes are given different colours to make them easier to distinguish in large graphs.
Nodes of different colours represent the following:
Solid arrows point from a procedure to one which it calls. Dashed arrows point from an interface to procedures which implement that interface. This could include the module procedures in a generic interface or the implementation in a submodule of an interface in a parent module. Where possible, edges connecting nodes are given different colours to make them easier to distinguish in large graphs.
SUBROUTINE CalcMultiSpeedDXCoil(DXCoilNum,SpeedRatio, CycRatio, ForceOn)
! SUBROUTINE INFORMATION:
! AUTHOR Fred Buhl
! DATE WRITTEN September 2002
! MODIFIED Raustad/Shirey, Feb 2004
! Feb 2005 M. J. Witte, GARD Analytics, Inc.
! Add new coil type COIL:DX:MultiMode:CoolingEmpirical:
! April 2010, Chandan sharma, FSEC, added basin heater
! RE-ENGINEERED na
! PURPOSE OF THIS SUBROUTINE:
! Calculates the air-side performance and electrical energy use of a direct-
! expansion, air-cooled cooling unit with a 2 speed or variable speed compressor.
! METHODOLOGY EMPLOYED:
! Uses the same methodology as the single speed DX unit model (SUBROUTINE CalcDoe2DXCoil).
! In addition it assumes that the unit performance is obtained by interpolating between
! the performance at high speed and that at low speed. If the output needed is below
! that produced at low speed, the compressor cycles between off and low speed.
! USE STATEMENTS:
USE CurveManager, ONLY: CurveValue
USE DataWater, ONLY: WaterStorage
!USE ScheduleManager, ONLY: GetCurrentScheduleValue
IMPLICIT NONE ! Enforce explicit typing of all variables in this routine
! SUBROUTINE ARGUMENT DEFINITIONS:
INTEGER, INTENT(IN) :: DXCoilNum ! the number of the DX heating coil to be simulated
REAL(r64), INTENT(IN) :: SpeedRatio ! = (CompressorSpeed - CompressorSpeedMin) / (CompressorSpeedMax - CompressorSpeedMin)
! SpeedRatio varies between 1.0 (maximum speed) and 0.0 (minimum speed)
REAL(r64), INTENT(IN) :: CycRatio ! cycling part load ratio
LOGICAL, INTENT(IN), OPTIONAL :: ForceOn
! SUBROUTINE PARAMETER DEFINITIONS:
CHARACTER(len=*), PARAMETER :: RoutineName='CalcMultiSpeedDXCoil'
! INTERFACE BLOCK SPECIFICATIONS
! na
! DERIVED TYPE DEFINITIONS
! na
! SUBROUTINE LOCAL VARIABLE DECLARATIONS:
REAL(r64) :: AirMassFlow ! dry air mass flow rate through coil [kg/s]
REAL(r64) :: AirMassFlowRatio ! Ratio of max air mass flow to rated air mass flow
REAL(r64) :: InletAirWetBulbC ! wetbulb temperature of inlet air [C]
REAL(r64) :: InletAirDryBulbTemp ! inlet air dry bulb temperature [C]
REAL(r64) :: InletAirEnthalpy ! inlet air enthalpy [J/kg]
REAL(r64) :: InletAirHumRat ! inlet air humidity ratio [kg/kg]
! Eventually inlet air conditions will be used in DX Coil, these lines are commented out and marked with this comment line
!REAL(r64) :: InletAirPressure ! inlet air pressure [Pa]
REAL(r64) :: OutletAirDryBulbTemp ! outlet air dry bulb temperature [C]
REAL(r64) :: OutletAirEnthalpy ! outlet air enthalpy [J/kg]
REAL(r64) :: OutletAirHumRat ! outlet air humidity ratio [kg/kg]
! REAL(r64) :: OutletAirRH ! outlet air relative humudity [fraction]
REAL(r64) :: OutletAirDryBulbTempSat ! outlet air dry bulb temp at saturation at the outlet enthalpy [C]
REAL(r64) :: LSOutletAirDryBulbTemp ! low speed outlet air dry bulb temperature [C]
REAL(r64) :: LSOutletAirEnthalpy ! low speed outlet air enthalpy [J/kg]
REAL(r64) :: LSOutletAirHumRat ! low speed outlet air humidity ratio [kg/kg]
REAL(r64) :: LSOutletAirRH ! low speed outlet air relative humudity [fraction]
REAL(r64) :: hDelta ! Change in air enthalpy across the cooling coil [J/kg]
REAL(r64) :: hTinwout ! Enthalpy at inlet dry-bulb and outlet humidity ratio [J/kg]
REAL(r64) :: hADP ! Apparatus dew point enthalpy [J/kg]
REAL(r64) :: tADP ! Apparatus dew point temperature [C]
REAL(r64) :: wADP ! Apparatus dew point humidity ratio [kg/kg]
REAL(r64) :: hTinwADP ! Enthalpy at inlet dry-bulb and wADP [J/kg]
REAL(r64) :: RatedCBFHS ! coil bypass factor at rated conditions (high speed)
REAL(r64) :: CBFHS ! coil bypass factor at max flow (high speed)
REAL(r64) :: TotCapHS ! total capacity at high speed [W]
REAL(r64) :: SHRHS ! sensible heat ratio at high speed
REAL(r64) :: TotCapLS ! total capacity at low speed [W]
REAL(r64) :: SHRLS ! sensible heat ratio at low speed
REAL(r64) :: EIRTempModFacHS ! EIR modifier (function of entering wetbulb, outside drybulb) (high speed)
REAL(r64) :: EIRFlowModFacHS ! EIR modifier (function of actual supply air flow vs rated flow) (high speed)
REAL(r64) :: EIRHS ! EIR at off rated conditions (high speed)
REAL(r64) :: EIRTempModFacLS ! EIR modifier (function of entering wetbulb, outside drybulb) (low speed)
REAL(r64) :: EIRLS ! EIR at off rated conditions (low speed)
REAL(r64) :: TotCap ! total capacity at current speed [W]
REAL(r64) :: SHR ! sensible heat ratio at current speed
REAL(r64) :: EIR ! EIR at current speed
REAL(r64) :: AirMassFlowNom ! speed ratio weighted average of high and low speed air mass flow rates [kg/s]
REAL(r64) :: CBFNom ! coil bypass factor corresponding to AirMassFlowNom and SpeedRatio
REAL(r64) :: CBF ! CBFNom adjusted for actual air mass flow rate
REAL(r64) :: PLF ! Part load factor, accounts for thermal lag at compressor startup, used in
! power calculation
REAL(r64) :: CondInletTemp ! Condenser inlet temperature (C). Outdoor dry-bulb temp for air-cooled condenser.
! Outdoor Wetbulb +(1 - effectiveness)*(outdoor drybulb - outdoor wetbulb) for evap condenser.
REAL(r64) :: CondInletHumrat ! Condenser inlet humidity ratio (kg/kg). Zero for air-cooled condenser.
! For evap condenser, its the humidity ratio of the air leaving the evap cooling pads.
REAL(r64) :: RhoAir ! Density of air [kg/m3]
REAL(r64) :: RhoWater ! Density of water [kg/m3]
REAL(r64) :: CondAirMassFlow ! Condenser air mass flow rate [kg/s]
REAL(r64) :: EvapCondPumpElecPower ! Evaporative condenser electric pump power [W]
REAL(r64) :: MinAirHumRat = 0.0d0 ! minimum of the inlet air humidity ratio and the outlet air humidity ratio
INTEGER,SAVE :: Mode=1 ! Performance mode for MultiMode DX coil; Always 1 for other coil types
REAL(r64) :: OutdoorDryBulb ! Outdoor dry-bulb temperature at condenser (C)
REAL(r64) :: OutdoorWetBulb ! Outdoor wet-bulb temperature at condenser (C)
REAL(r64) :: OutdoorHumRat ! Outdoor humidity ratio at condenser (kg/kg)
REAL(r64) :: OutdoorPressure ! Outdoor barometric pressure at condenser (Pa)
LOGICAL :: LocalForceOn
REAL(r64) :: AirMassFlowRatio2 ! Ratio of low speed air mass flow to rated air mass flow
IF (PRESENT(ForceOn)) THEN
LocalForceOn = .TRUE.
ELSE
LocalForceOn = .FALSE.
ENDIF
IF (DXCoil(DXCoilNum)%CondenserInletNodeNum(Mode) /= 0) THEN
OutdoorPressure = Node(DXCoil(DXCoilNum)%CondenserInletNodeNum(Mode))%Press
! If node is not connected to anything, pressure = default, use weather data
IF(OutdoorPressure == DefaultNodeValues%Press)THEN
OutdoorDryBulb = OutDryBulbTemp
OutdoorHumRat = OutHumRat
OutdoorPressure = OutBaroPress
OutdoorWetBulb = OutWetBulbTemp
ELSE
OutdoorDryBulb = Node(DXCoil(DXCoilNum)%CondenserInletNodeNum(Mode))%Temp
OutdoorHumRat = Node(DXCoil(DXCoilNum)%CondenserInletNodeNum(Mode))%HumRat
OutdoorWetBulb = PsyTwbFnTdbWPb(OutdoorDryBulb,OutdoorHumRat,OutdoorPressure)
END IF
ELSE
OutdoorDryBulb = OutDryBulbTemp
OutdoorHumRat = OutHumRat
OutdoorPressure = OutBaroPress
OutdoorWetBulb = OutWetBulbTemp
ENDIF
AirMassFlow = DXCoil(DXCoilNum)%InletAirMassFlowRate
AirMassFlowRatio = DXCoil(DXCoilNum)%InletAirMassFlowRateMax / DXCoil(DXCoilNum)%RatedAirMassFlowRate(Mode)
DXCoil(DXCoilNum)%CoolingCoilRuntimeFraction = 0.0d0
InletAirDryBulbTemp = DXCoil(DXCoilNum)%InletAirTemp
InletAirEnthalpy = DXCoil(DXCoilNum)%InletAirEnthalpy
InletAirHumRat = DXCoil(DXCoilNum)%InletAirHumRat
AirMassFlowRatio2 = 1.0d0 ! DXCoil(DXCoilNum)%RatedAirMassFlowRate2 / DXCoil(DXCoilNum)%RatedAirMassFlowRate(Mode)
! Eventually inlet air conditions will be used in DX Coil, these lines are commented out and marked with this comment line
!InletAirPressure = DXCoil(DXCoilNum)%InletAirPressure
!InletAirWetbulbC = PsyTwbFnTdbWPb(InletAirDryBulbTemp,InletAirHumRat,InletAirPressure)
InletAirWetbulbC = PsyTwbFnTdbWPb(InletAirDryBulbTemp,InletAirHumRat,OutdoorPressure)
IF (DXCoil(DXCoilNum)%CondenserType(Mode) == AirCooled) THEN
CondInletTemp = OutdoorDryBulb ! Outdoor dry-bulb temp
ELSEIF (DXCoil(DXCoilNum)%CondenserType(Mode) == EvapCooled) THEN
! Outdoor wet-bulb temp from DataEnvironment + (1.0-EvapCondEffectiveness) * (drybulb - wetbulb)
CondInletTemp = OutdoorWetBulb + (OutdoorDryBulb-OutdoorWetBulb)*(1.0d0 - DXCoil(DXCoilNum)%EvapCondEffect(Mode))
CondInletHumrat = PsyWFnTdbTwbPb(CondInletTemp,OutdoorWetBulb,OutdoorPressure)
END IF
IF((AirMassFlow .GT. 0.0d0) .AND. &
((GetCurrentScheduleValue(DXCoil(DXCoilNum)%SchedPtr) .GT. 0.0d0) .OR. (LocalForceOn))&
.AND. (SpeedRatio > 0.0d0 .OR. CycRatio > 0.0d0) ) THEN
RhoAir = PsyRhoAirFnPbTdbW(OutdoorPressure,OutdoorDryBulb,OutdoorHumRat)
IF (SpeedRatio > 0.0d0) THEN
! Adjust high speed coil bypass factor for actual maximum air flow rate.
RatedCBFHS = DXCoil(DXCoilNum)%RatedCBF(Mode)
CBFHS = AdjustCBF(RatedCBFHS,DXCoil(DXCoilNum)%RatedAirMassFlowRate(Mode),DXCoil(DXCoilNum)%InletAirMassFlowRateMax)
! get high speed total capacity and SHR at current conditions
CALL CalcTotCapSHR(InletAirDryBulbTemp,InletAirHumRat,InletAirEnthalpy,InletAirWetbulbC,AirMassFlowRatio, &
DXCoil(DXCoilNum)%InletAirMassFlowRateMax,DXCoil(DXCoilNum)%RatedTotCap(Mode), &
CBFHS,DXCoil(DXCoilNum)%CCapFTemp(Mode),DXCoil(DXCoilNum)%CCapFFlow(Mode),TotCapHS,SHRHS, &
CondInletTemp, OutdoorPressure)
! Eventually inlet air conditions will be used in DX Coil, these lines are commented out and marked with this comment line
! CondInletTemp, Node(DXCoil(DXCoilNum)%AirInNode)%Press)
! get the high speed SHR from user specified SHR modifier curves
IF (DXCoil(DXCoilNum)%UserSHRCurveExists) THEN
SHRHS = CalcSHRUserDefinedCurves(InletAirDryBulbTemp,InletAirWetbulbC,AirMassFlowRatio, &
DXCoil(DXCoilNum)%SHRFTemp(Mode),DXCoil(DXCoilNum)%SHRFFlow(Mode), &
DXCoil(DXCoilNum)%RatedSHR(Mode))
ENDIF
! get low speed total capacity and SHR at current conditions
CALL CalcTotCapSHR(InletAirDryBulbTemp,InletAirHumRat,InletAirEnthalpy,InletAirWetbulbC,1.0d0, &
DXCoil(DXCoilNum)%RatedAirMassFlowRate2,DXCoil(DXCoilNum)%RatedTotCap2, &
DXCoil(DXCoilNum)%RatedCBF2,DXCoil(DXCoilNum)%CCapFTemp2, &
DXCoil(DXCoilNum)%CCapFFlow(Mode),TotCapLS,SHRLS,CondInletTemp, &
OutdoorPressure)
! Eventually inlet air conditions will be used in DX Coil, these lines are commented out and marked with this comment line
! Node(DXCoil(DXCoilNum)%AirInNode)%Press)
! get the low speed SHR from user specified SHR modifier curves
IF (DXCoil(DXCoilNum)%UserSHRCurveExists) THEN
SHRLS = CalcSHRUserDefinedCurves(InletAirDryBulbTemp,InletAirWetbulbC,AirMassFlowRatio2, &
DXCoil(DXCoilNum)%SHRFTemp2,DXCoil(DXCoilNum)%SHRFFlow2, &
DXCoil(DXCoilNum)%RatedSHR2)
ENDIF
! get high speed EIR at current conditions
EIRTempModFacHS = CurveValue(DXCoil(DXCoilNum)%EIRFTemp(Mode),InletAirWetbulbC,CondInletTemp)
EIRFlowModFacHS = CurveValue(DXCoil(DXCoilNum)%EIRFFlow(Mode),AirMassFlowRatio)
EIRHS = DXCoil(DXCoilNum)%RatedEIR(Mode) * EIRFlowModFacHS * EIRTempModFacHS
! get low speed EIR at current conditions
! EIRTempModFacLS = CurveValue(DXCoil(DXCoilNum)%EIRFTemp(Mode),InletAirWetbulbC,CondInletTemp)
! CR7307 changed EIRTempModFacLS calculation to that shown below.
EIRTempModFacLS = CurveValue(DXCoil(DXCoilNum)%EIRFTemp2,InletAirWetbulbC,CondInletTemp)
EIRLS = DXCoil(DXCoilNum)%RatedEIR2 * EIRTempModFacLS
! get current total capacity, SHR, EIR
IF (SpeedRatio >= 1.0d0) THEN
TotCap = TotCapHS
SHR = SHRHS
EIR = EIRHS
CBFNom = CBFHS
AirMassFlowNom = DXCoil(DXCoilNum)%InletAirMassFlowRateMax
CondAirMassFlow = RhoAir * DXCoil(DXCoilNum)%EvapCondAirFlow(Mode)
EvapCondPumpElecPower = DXCoil(DXCoilNum)%EvapCondPumpElecNomPower(Mode)
ELSE
TotCap = SpeedRatio*TotCapHS + (1.0d0-SpeedRatio)*TotCapLS
EIR = SpeedRatio*EIRHS + (1.0d0-SpeedRatio)*EIRLS
CBFNom = SpeedRatio*CBFHS + (1.0d0-SpeedRatio)*DXCoil(DXCoilNum)%RatedCBF2
AirMassFlowNom = SpeedRatio*DXCoil(DXCoilNum)%InletAirMassFlowRateMax + (1.0d0-SpeedRatio)* &
DXCoil(DXCoilNum)%RatedAirMassFlowRate2
CondAirMassFlow = RhoAir * (SpeedRatio * DXCoil(DXCoilNum)%EvapCondAirFlow(Mode) + (1.0d0-SpeedRatio)* &
DXCoil(DXCoilNum)%EvapCondAirFlow2)
EvapCondPumpElecPower = SpeedRatio * DXCoil(DXCoilNum)%EvapCondPumpElecNomPower(Mode) + (1.0d0-SpeedRatio)* &
DXCoil(DXCoilNum)%EvapCondPumpElecNomPower2
END IF
hDelta = TotCap / AirMassFlow
IF (DXCoil(DXCoilNum)%UserSHRCurveExists) THEN
IF (SpeedRatio >= 1.0d0) THEN
SHR = SHRHS
ELSE
SHR = MIN(SpeedRatio*SHRHS + (1.0d0-SpeedRatio)*SHRLS, 1.0d0)
ENDIF
OutletAirEnthalpy = InletAirEnthalpy - hDelta
IF (SHR < 1.0d0) THEN
hTinwout = InletAirEnthalpy - (1.0d0-SHR)*hDelta
OutletAirHumRat = PsyWFnTdbH(InletAirDryBulbTemp,hTinwout)
IF (OutletAirHumRat <= 0.0d0) THEN
OutletAirHumRat = MIN(DryCoilOutletHumRatioMin, InletAirHumRat)
ENDIF
ELSE
SHR = 1.0d0
OutletAirHumRat = InletAirHumRat
ENDIF
OutletAirDryBulbTemp = PsyTdbFnHW(OutletAirEnthalpy,OutletAirHumRat,'CalcMultiSpeedDXCoil:highspeedoutlet')
OutletAirDryBulbTempSat = PsyTdpFnWPb(OutletAirHumRat,OutdoorPressure,'CalcMultiSpeedDXCoil:highspeedoutlet')
IF(OutletAirDryBulbTempSat > OutletAirDryBulbTemp) THEN
OutletAirDryBulbTemp = OutletAirDryBulbTempSat
OutletAirHumRat = PsyWFnTdbH(OutletAirDryBulbTemp,OutletAirEnthalpy,'CalcMultiSpeedDXCoil:highspeedoutlet')
ENDIF
!LSOutletAirRH = PsyRhFnTdbWPb(OutletAirDryBulbTemp,OutletAirHumRat,OutdoorPressure,'CalcMultiSpeedDXCoil:highspeedoutlet')
ELSE
! Adjust CBF for off-nominal flow
CBF = AdjustCBF(CBFNom,AirMassFlowNom,AirMassFlow)
! Calculate new apparatus dew point conditions
hADP = InletAirEnthalpy - hDelta/(1.d0-CBF)
tADP = PsyTsatFnHPb(hADP,OutdoorPressure)
! Eventually inlet air conditions will be used in DX Coil, these lines are commented out and marked with this comment line
! tADP = PsyTsatFnHPb(hADP,InletAirPressure)
wADP = PsyWFnTdbH(tADP,hADP)
hTinwADP = PsyHFnTdbW(InletAirDryBulbTemp,wADP)
! get corresponding SHR
IF ((InletAirEnthalpy-hADP) > 1.d-10) THEN
SHR = MIN((hTinwADP-hADP)/(InletAirEnthalpy-hADP),1.d0)
ELSE
SHR=1.0d0
ENDIF
!cr8918 SHR = MIN((hTinwADP-hADP)/(InletAirEnthalpy-hADP),1.d0)
OutletAirEnthalpy = InletAirEnthalpy - hDelta
! get outlet conditions
hTinwout = InletAirEnthalpy - (1.0d0-SHR)*hDelta
OutletAirHumRat = PsyWFnTdbH(InletAirDryBulbTemp,hTinwout)
OutletAirDryBulbTemp = PsyTdbFnHW(OutletAirEnthalpy,OutletAirHumRat)
! OutletAirRH = PsyRhFnTdbWPb(OutletAirDryBulbTemp,OutletAirHumRat,OutBaroPress)
! IF (OutletAirRH >= 1.) THEN ! Limit to saturated conditions at OutletAirEnthalpy
! OutletAirDryBulbTemp = PsyTsatFnHPb(OutletAirEnthalpy,OutBaroPress)
! OutletAirHumRat = PsyWFnTdbH(OutletAirDryBulbTemp,OutletAirEnthalpy)
! END IF
OutletAirDryBulbTempSat = PsyTsatFnHPb(OutletAirEnthalpy,OutdoorPressure)
! Eventually inlet air conditions will be used in DX Coil, these lines are commented out and marked with this comment line
! OutletAirDryBulbTempSat = PsyTsatFnHPb(OutletAirEnthalpy,InletAirPressure)
IF (OutletAirDryBulbTemp < OutletAirDryBulbTempSat) THEN ! Limit to saturated conditions at OutletAirEnthalpy
OutletAirDryBulbTemp = OutletAirDryBulbTempSat
OutletAirHumRat = PsyWFnTdbH(OutletAirDryBulbTemp,OutletAirEnthalpy)
END IF
ENDIF
! calculate cooling rate and electrical power
DXCoil(DXCoilNum)%TotalCoolingEnergyRate = AirMassFlow * (InletAirEnthalpy - OutletAirEnthalpy)
MinAirHumRat = MIN(InletAirHumRat,OutletAirHumRat)
DXCoil(DXCoilNum)%SensCoolingEnergyRate = AirMassFlow * (PsyHFnTdbW(InletAirDryBulbTemp,MinAirHumRat) - &
PsyHFnTdbW(OutletAirDryBulbTemp,MinAirHumRat))
! Don't let sensible capacity be greater than total capacity
IF (DXCoil(DXCoilNum)%SensCoolingEnergyRate > DXCoil(DXCoilNum)%TotalCoolingEnergyRate) THEN
DXCoil(DXCoilNum)%SensCoolingEnergyRate = DXCoil(DXCoilNum)%TotalCoolingEnergyRate
END IF
DXCoil(DXCoilNum)%LatCoolingEnergyRate = DXCoil(DXCoilNum)%TotalCoolingEnergyRate - &
DXCoil(DXCoilNum)%SensCoolingEnergyRate
DXCoil(DXCoilNum)%ElecCoolingPower = TotCap * EIR
! Calculation for heat reclaim needs to be corrected to use compressor power (not including condenser fan power)
HeatReclaimDXCoil(DXCoilNum)%AvailCapacity = DXCoil(DXCoilNum)%TotalCoolingEnergyRate + DXCoil(DXCoilNum)%ElecCoolingPower
DXCoil(DXCoilNum)%PartLoadRatio = 1.0d0
DXCoil(DXCoilNum)%CoolingCoilRuntimeFraction = 1.0d0
DXCoil(DXCoilNum)%OutletAirEnthalpy = OutletAirEnthalpy
DXCoil(DXCoilNum)%OutletAirHumRat = OutletAirHumRat
DXCoil(DXCoilNum)%OutletAirTemp = OutletAirDryBulbTemp
ELSE IF (CycRatio > 0.0d0) THEN
IF (DXCoil(DXCoilNum)%CondenserType(Mode) == EvapCooled) THEN
! Outdoor wet-bulb temp from DataEnvironment + (1.0-EvapCondEffectiveness) * (drybulb - wetbulb)
CondInletTemp = OutdoorWetBulb + (OutdoorDryBulb-OutdoorWetBulb)*(1.0d0 - DXCoil(DXCoilNum)%EvapCondEffect2)
CondInletHumrat = PsyWFnTdbTwbPb(CondInletTemp,OutdoorWetBulb,OutdoorPressure)
END IF
! Adjust low speed coil bypass factor for actual flow rate.
! CBF = AdjustCBF(DXCoil(DXCoilNum)%RatedCBF2,DXCoil(DXCoilNum)%RatedAirMassFlowRate2,AirMassFlow)
! get low speed total capacity and SHR at current conditions
CALL CalcTotCapSHR(InletAirDryBulbTemp,InletAirHumRat,InletAirEnthalpy,InletAirWetbulbC,1.0d0, &
DXCoil(DXCoilNum)%RatedAirMassFlowRate2,DXCoil(DXCoilNum)%RatedTotCap2, &
DXCoil(DXCoilNum)%RatedCBF2,DXCoil(DXCoilNum)%CCapFTemp2, &
DXCoil(DXCoilNum)%CCapFFlow(Mode),TotCapLS,SHRLS,CondInletTemp, &
OutdoorPressure)
! get the low speed SHR from user specified SHR modifier curves
IF (DXCoil(DXCoilNum)%UserSHRCurveExists) THEN
SHRLS = CalcSHRUserDefinedCurves(InletAirDryBulbTemp,InletAirWetbulbC,1.0d0, &
DXCoil(DXCoilNum)%SHRFTemp2,DXCoil(DXCoilNum)%SHRFFlow2, &
DXCoil(DXCoilNum)%RatedSHR2)
ENDIF
! Eventually inlet air conditions will be used in DX Coil, these lines are commented out and marked with this comment line
! Node(DXCoil(DXCoilNum)%AirInNode)%Press)
hDelta = TotCapLS / AirMassFlow
IF (DXCoil(DXCoilNum)%UserSHRCurveExists) THEN
SHR = SHRLS
LSOutletAirEnthalpy = InletAirEnthalpy - hDelta
IF (SHR < 1.0d0) THEN
hTinwout = InletAirEnthalpy - (1.0d0-SHR)*hDelta
LSOutletAirHumRat = PsyWFnTdbH(InletAirDryBulbTemp,hTinwout)
IF (LSOutletAirHumRat <= 0.0d0) THEN
LSOutletAirHumRat = MIN(DryCoilOutletHumRatioMin, InletAirHumRat)
ENDIF
ELSE
SHR=1.0d0
LSOutletAirHumRat = InletAirHumRat
ENDIF
LSOutletAirDryBulbTemp = PsyTdbFnHW(LSOutletAirEnthalpy,LSOutletAirHumRat,'CalcMultiSpeedDXCoil:lowspeedoutlet')
OutletAirDryBulbTempSat = PsyTdpFnWPb(LSOutletAirHumRat,OutdoorPressure,'CalcMultiSpeedDXCoil:lowspeedoutlet')
IF(OutletAirDryBulbTempSat > LSOutletAirDryBulbTemp) THEN
LSOutletAirDryBulbTemp = OutletAirDryBulbTempSat
LSOutletAirHumRat = PsyWFnTdbH(LSOutletAirDryBulbTemp,LSOutletAirEnthalpy,'CalcMultiSpeedDXCoil:lowspeedoutlet')
ENDIF
LSOutletAirRH = PsyRhFnTdbWPb(LSOutletAirDryBulbTemp,LSOutletAirHumRat,OutdoorPressure, &
'CalcMultiSpeedDXCoil:lowspeedoutlet')
ELSE
! Adjust CBF for off-nominal flow
CBF = AdjustCBF(DXCoil(DXCoilNum)%RatedCBF2,DXCoil(DXCoilNum)%RatedAirMassFlowRate2,AirMassFlow)
! Calculate new apparatus dew point conditions
hADP = InletAirEnthalpy - hDelta/(1.d0-CBF)
tADP = PsyTsatFnHPb(hADP,OutdoorPressure,'CalcMultiSpeedDXCoil:newdewpointconditions')
! Eventually inlet air conditions will be used in DX Coil, these lines are commented out and marked with this comment line
! tADP = PsyTsatFnHPb(hADP,InletAirPressure)
wADP = PsyWFnTdbH(tADP,hADP,'CalcMultiSpeedDXCoil:newdewpointconditions')
hTinwADP = PsyHFnTdbW(InletAirDryBulbTemp,wADP,'CalcMultiSpeedDXCoil:newdewpointconditions')
! get corresponding SHR
IF ((InletAirEnthalpy-hADP) > 1.d-10) THEN
SHR = MIN((hTinwADP-hADP)/(InletAirEnthalpy-hADP),1.d0)
ELSE
SHR=1.0d0
ENDIF
!cr8918 SHR = MIN((hTinwADP-hADP)/(InletAirEnthalpy-hADP),1.d0)
! get low speed outlet conditions
LSOutletAirEnthalpy = InletAirEnthalpy - hDelta
hTinwout = InletAirEnthalpy - (1.0d0-SHR)*hDelta
LSOutletAirHumRat = PsyWFnTdbH(InletAirDryBulbTemp,hTinwout)
LSOutletAirDryBulbTemp = PsyTdbFnHW(LSOutletAirEnthalpy,LSOutletAirHumRat,'CalcMultiSpeedDXCoil:lowspeedoutlet')
LSOutletAirRH = PsyRhFnTdbWPb(LSOutletAirDryBulbTemp,LSOutletAirHumRat,OutdoorPressure, &
'CalcMultiSpeedDXCoil:lowspeedoutlet')
OutletAirDryBulbTempSat = PsyTsatFnHPb(LSOutletAirEnthalpy,OutdoorPressure,'CalcMultiSpeedDXCoil:lowspeedoutlet')
! Eventually inlet air conditions will be used in DX Coil, these lines are commented out and marked with this comment line
! LSOutletAirRH = PsyRhFnTdbWPb(LSOutletAirDryBulbTemp,LSOutletAirHumRat,InletAirPressure)
! OutletAirDryBulbTempSat = PsyTsatFnHPb(LSOutletAirEnthalpy,InletAirPressure)
IF (LSOutletAirDryBulbTemp < OutletAirDryBulbTempSat) THEN ! Limit to saturated conditions at OutletAirEnthalpy
LSOutletAirDryBulbTemp = OutletAirDryBulbTempSat
LSOutletAirHumRat = PsyWFnTdbH(LSOutletAirDryBulbTemp,LSOutletAirEnthalpy,'CalcMultiSpeedDXCoil:lowspeedoutlet')
END IF
ENDIF
! outlet conditions are average of inlet and low speed weighted by CycRatio
OutletAirEnthalpy = CycRatio*LSOutletAirEnthalpy + (1.d0-CycRatio)*InletAirEnthalpy
OutletAirHumRat = CycRatio*LSOutletAirHumRat + (1.d0-CycRatio)*InletAirHumRat
OutletAirDryBulbTemp = PsyTdbFnHW(OutletAirEnthalpy,OutletAirHumRat)
! get low speed EIR at current conditions
! EIRTempModFacLS = CurveValue(DXCoil(DXCoilNum)%EIRFTemp(Mode),InletAirWetbulbC,CondInletTemp)
! CR7307 changed EIRTempModFacLS calculation to that shown below.
EIRTempModFacLS = CurveValue(DXCoil(DXCoilNum)%EIRFTemp2,InletAirWetbulbC,CondInletTemp)
EIRLS = DXCoil(DXCoilNum)%RatedEIR2 * EIRTempModFacLS
! get the part load factor that will account for cycling losses
PLF = CurveValue(DXCoil(DXCoilNum)%PLFFPLR(Mode),CycRatio)
IF (PLF < 0.7d0) THEN
PLF = 0.7d0
END IF
! calculate the run time fraction
DXCoil(DXCoilNum)%CoolingCoilRuntimeFraction = CycRatio / PLF
DXCoil(DXCoilNum)%PartLoadRatio = CycRatio
IF ( DXCoil(DXCoilNum)%CoolingCoilRuntimeFraction > 1.d0 ) THEN
DXCoil(DXCoilNum)%CoolingCoilRuntimeFraction = 1.0d0 ! Reset coil runtime fraction to 1.0
END IF
! get the eletrical power consumption
DXCoil(DXCoilNum)%ElecCoolingPower = TotCapLS * EIRLS * DXCoil(DXCoilNum)%CoolingCoilRuntimeFraction
! calculate cooling output power
DXCoil(DXCoilNum)%TotalCoolingEnergyRate = AirMassFlow * (InletAirEnthalpy - OutletAirEnthalpy)
! Calculation for heat reclaim needs to be corrected to use compressor power (not including condenser fan power)
HeatReclaimDXCoil(DXCoilNum)%AvailCapacity = DXCoil(DXCoilNum)%TotalCoolingEnergyRate + DXCoil(DXCoilNum)%ElecCoolingPower
MinAirHumRat = MIN(InletAirHumRat,OutletAirHumRat)
DXCoil(DXCoilNum)%SensCoolingEnergyRate = AirMassFlow * (PsyHFnTdbW(InletAirDryBulbTemp,MinAirHumRat) - &
PsyHFnTdbW(OutletAirDryBulbTemp,MinAirHumRat))
! Don't let sensible capacity be greater than total capacity
IF (DXCoil(DXCoilNum)%SensCoolingEnergyRate > DXCoil(DXCoilNum)%TotalCoolingEnergyRate) THEN
DXCoil(DXCoilNum)%SensCoolingEnergyRate = DXCoil(DXCoilNum)%TotalCoolingEnergyRate
END IF
DXCoil(DXCoilNum)%LatCoolingEnergyRate = DXCoil(DXCoilNum)%TotalCoolingEnergyRate - &
DXCoil(DXCoilNum)%SensCoolingEnergyRate
DXCoil(DXCoilNum)%OutletAirEnthalpy = OutletAirEnthalpy
DXCoil(DXCoilNum)%OutletAirHumRat = OutletAirHumRat
DXCoil(DXCoilNum)%OutletAirTemp = OutletAirDryBulbTemp
CondAirMassFlow = RhoAir * DXCoil(DXCoilNum)%EvapCondAirFlow2 * DXCoil(DXCoilNum)%CoolingCoilRuntimeFraction
EvapCondPumpElecPower = DXCoil(DXCoilNum)%EvapCondPumpElecNomPower2 * DXCoil(DXCoilNum)%CoolingCoilRuntimeFraction
END IF
IF (DXCoil(DXCoilNum)%CondenserType(Mode) == EvapCooled) 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)
DXCoil(DXCoilNum)%EvapWaterConsumpRate = (CondInletHumrat - OutdoorHumRat) * CondAirMassFlow/RhoWater
DXCoil(DXCoilNum)%EvapCondPumpElecPower = EvapCondPumpElecPower
!set water system demand request (if needed)
IF ( DXCoil(DxCoilNum)%EvapWaterSupplyMode == WaterSupplyFromTank) THEN
WaterStorage(DXCoil(DXCoilNum)%EvapWaterSupTankID)%VdotRequestDemand(DXCoil(DXCoilNum)%EvapWaterTankDemandARRID) &
= DXCoil(DXCoilNum)%EvapWaterConsumpRate
ENDIF
! Calculate basin heater power
CALL CalcBasinHeaterPower(DXCoil(DXCoilNum)%BasinHeaterPowerFTempDiff,&
DXCoil(DXCoilNum)%BasinHeaterSchedulePtr,&
DXCoil(DXCoilNum)%BasinHeaterSetPointTemp,DXCoil(DXCoilNum)%BasinHeaterPower)
DXCoil(DXCoilNum)%BasinHeaterPower = DXCoil(DXCoilNum)%BasinHeaterPower * &
(1.d0 - DXCoil(DXCoilNum)%CoolingCoilRuntimeFraction)
ENDIF
ELSE
! DX coil is off; just pass through conditions
DXCoil(DXCoilNum)%OutletAirEnthalpy = DXCoil(DXCoilNum)%InletAirEnthalpy
DXCoil(DXCoilNum)%OutletAirHumRat = DXCoil(DXCoilNum)%InletAirHumRat
DXCoil(DXCoilNum)%OutletAirTemp = DXCoil(DXCoilNum)%InletAirTemp
DXCoil(DXCoilNum)%ElecCoolingPower = 0.0d0
DXCoil(DXCoilNum)%TotalCoolingEnergyRate = 0.0d0
DXCoil(DXCoilNum)%SensCoolingEnergyRate = 0.0d0
DXCoil(DXCoilNum)%LatCoolingEnergyRate = 0.0d0
DXCoil(DXCoilNum)%EvapCondPumpElecPower = 0.0d0
DXCoil(DXCoilNum)%EvapWaterConsumpRate = 0.0d0
! Calculate basin heater power
IF (DXCoil(DXCoilNum)%CondenserType(Mode) == EvapCooled) THEN
CALL CalcBasinHeaterPower(DXCoil(DXCoilNum)%BasinHeaterPowerFTempDiff,&
DXCoil(DXCoilNum)%BasinHeaterSchedulePtr,&
DXCoil(DXCoilNum)%BasinHeaterSetPointTemp,DXCoil(DXCoilNum)%BasinHeaterPower)
ENDIF
END IF
DXCoilOutletTemp(DXCoilNum) = DXCoil(DXCoilNum)%OutletAirTemp
DXCoilOutletHumRat(DXCoilNum) = DXCoil(DXCoilNum)%OutletAirHumRat
DXCoil(DXCoilNum)%CondInletTemp = CondInletTemp ! Save condenser inlet temp in the data structure
RETURN
END SUBROUTINE CalcMultiSpeedDXCoil