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 |
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 CalcTwoSpeedDXCoilStandardRating(DXCoilNum)
! SUBROUTINE INFORMATION:
! AUTHOR B. Griffith, (Derived from CalcDXCoilStandardRating by Bereket Nigusse & Chandan Sharma)
! DATE WRITTEN July 2012
! MODIFIED na
! RE-ENGINEERED na
! PURPOSE OF THIS SUBROUTINE:
! Calculate the following
! (1) Standard Rated (net) Cooling Capacity
! (2) Energy Efficiency Ratio (EER),
! (3) Integrated Energy Efficiency Ratio (IEER)
! METHODOLOGY EMPLOYED:
! <description>
! REFERENCES:
! ANSI/AHRI Standard 340/360-2007, Peformance Rating of Commercial and Industrial Unitary Air-Conditioning and
! Heat Pump Equipment, Air-Conditioning, Heating, and Refrigeration Institute, Arlingtion VA.
! USE STATEMENTS:
USE CurveManager, ONLY: CurveValue
USE Fans, ONLY: GetFanPower, GetFanInletNode, GetFanOutletNode, SimulateFanComponents
USE DataEnvironment, ONLY: OutBaroPress
USE General, ONLY: SolveRegulaFalsi, RoundSigDigits
USE OutputReportPredefined
IMPLICIT NONE ! Enforce explicit typing of all variables in this routine
! SUBROUTINE ARGUMENT DEFINITIONS:
INTEGER, INTENT(IN) :: DXCoilNum
! SUBROUTINE PARAMETER DEFINITIONS:
! AHRI Standard 340/360-2007 Peformance Rating of Commercial and Industrial Unitary Air-Conditioning and Heat Pump Equipment
REAL(r64), PARAMETER :: CoolingCoilInletAirWetbulbTempRated = 19.4d0 ! 19.44C (67F)
REAL(r64), PARAMETER :: CoolingCoilInletAirDryblubTempRated = 26.7d0 !
REAL(r64), PARAMETER :: OutdoorUnitInletAirDrybulbTempRated = 35.0d0 ! 35.00C (95F)
REAL(r64), PARAMETER, DIMENSION(3) :: OutdoorUnitInletAirDrybulbTempPLTestPoint = &
(/27.5d0, 20.0d0, 18.3d0 /)
REAL(r64), PARAMETER, DIMENSION(3) :: NetCapacityFactorPLTestPoint = &
(/0.75d0, 0.50D0, 0.25D0/)
REAL(r64), PARAMETER :: ConvFromSIToIP = 3.412141633D0 ! Conversion from SI to IP [3.412 Btu/hr-W]
REAL(r64), PARAMETER :: AirMassFlowRatioRated = 1.0d0 ! AHRI test is at the design flow rate
! and hence AirMassFlowRatio is 1.0
REAL(r64), PARAMETER :: DefaultFanPowerPerEvapAirFlowRate = 773.3D0 ! 365 W/1000 scfm or 773.3 W/(m3/s). The AHRI standard
! specifies a nominal/default fan electric power consumption per rated air
! volume flow rate to account for indoor fan electric power consumption
! when the standard tests are conducted on units that do not have an
! indoor air circulting fan. Used if user doesn't enter a specific value.
! INTERFACE BLOCK SPECIFICATIONS:
! na
! DERIVED TYPE DEFINITIONS:
! na
! SUBROUTINE LOCAL VARIABLE DECLARATIONS:
REAL(r64) :: NetCoolingCapRated = 0.0D0 ! Net Cooling Coil capacity at Rated conditions, accounting for supply fan heat [W]
REAL(r64) :: EER = 0.0D0 ! Energy Efficiency Ratio in SI [W/W]
REAL(r64) :: IEER = 0.0D0 ! Integerated Energy Efficiency Ratio in SI [W/W]
REAL(r64) :: TotCapTempModFac = 0.0D0 ! Total capacity modifier (function of entering wetbulb, outside drybulb) [-]
REAL(r64) :: TotCapFlowModFac = 0.0D0 ! Total capacity modifier (function of actual supply air flow vs rated flow) [-]
REAL(r64) :: EIRTempModFac = 0.0D0 ! EIR modifier (function of entering wetbulb, outside drybulb) [-]
REAL(r64) :: EIRFlowModFac = 0.0D0 ! EIR modifier (function of actual supply air flow vs rated flow) [-]
REAL(r64) :: EIR
REAL(r64) :: TotalElecPowerRated
REAL(r64) , DIMENSION(4) :: EER_TestPoint_SI ! 1 = A, 2 = B, 3= C, 4= D
REAL(r64) , DIMENSION(4) :: EER_TestPoint_IP ! 1 = A, 2 = B, 3= C, 4= D
REAL(r64) , DIMENSION(4) :: NetCapacity_TestPoint ! 1 = A, 2 = B, 3= C, 4= D
REAL(r64) , DIMENSION(4) :: NetPower_TestPoint ! 1 = A, 2 = B, 3= C, 4= D
REAL(r64) , DIMENSION(4) :: SupAirMdot_TestPoint ! 1 = A, 2 = B, 3= C, 4= D
REAL(r64) :: TempDryBlub_Leaving_Apoint = 0.d0
REAL(r64) :: HighSpeedNetCoolingCap
REAL(r64) :: LowSpeedNetCoolingCap
REAL(r64) :: PartLoadAirMassFlowRate
REAL(r64) :: AirMassFlowRatio
REAL(r64) :: AccuracyTolerance = 0.2d0 ! tolerance in AHRI 340/360 Table 6 note 1
INTEGER :: MaximumIterations = 500
INTEGER :: SolverFlag
REAL(r64), DIMENSION(12) :: Par ! Parameter array passed to solver
REAL(r64) :: EIR_HighSpeed
REAL(r64) :: EIR_LowSpeed
INTEGER :: FanInletNode
INTEGER :: FanOutletNode
INTEGER :: Iter
REAL(r64) :: ExternalStatic
REAL(r64) :: FanStaticPressureRise
LOGICAL :: ErrorsFound = .FALSE.
REAL(r64) :: FanHeatCorrection
REAL(r64) :: FanPowerCorrection
REAL(r64) :: FanPowerPerEvapAirFlowRate
REAL(r64) :: SpeedRatio
REAL(r64) :: CycRatio
REAL(r64) :: TargetNetCapacity
REAL(r64) :: SupplyAirHumRat
REAL(r64) :: SupplyAirRho
REAL(r64) :: SupplyAirVolFlowRate
REAL(r64) :: HighSpeedTotCoolingCap
REAL(r64) :: LowSpeedTotCoolingCap
REAL(r64) :: TotCoolingCap
REAL(r64) :: NetCoolingCap
REAL(r64) :: PLF
REAL(r64) :: RunTimeFraction
REAL(r64) :: LowerBoundMassFlowRate
LOGICAL, SAVE :: OneTimeEIOHeaderWrite = .TRUE.
INTEGER :: PartLoadTestPoint
INTEGER :: countStaticInputs
INTEGER :: Index
! Get fan index and name if not already available
IF(DXCoil(DXCoilNum)%SupplyFanIndex == 0) &
CALL GetFanIndexForTwoSpeedCoil( DXCoilNum, DXCoil(DXCoilNum)%SupplyFanIndex, DXCoil(DXCoilNum)%SupplyFanName)
IF (DXCoil(DXCoilNum)%SupplyFanIndex == 0) THEN ! didn't find VAV fan, do not rate this coil
DXCoil(DXCoilNum)%RateWithInternalStaticAndFanObject = .FALSE.
CALL ShowWarningError('CalcTwoSpeedDXCoilStandardRating: Did not find a variable air volume fan associated' &
//' with DX coil named = "'//TRIM(DXCoil(DXCoilNum)%Name)//'". Standard Ratings will not be calculated.')
RETURN
ENDIF
! CALL CheckCurveLimitsForStandardRatings(
! Calculate the Indoor fan electric power consumption. The electric power consumption is estimated
! using either user supplied or AHRI default value for fan power per air volume flow rate
IF( DXCoil(DXCoilNum)%RateWithInternalStaticAndFanObject) THEN
TotCapFlowModFac = CurveValue(DXCoil(DXCoilNum)%CCapFFlow(1),AirMassFlowRatioRated)
TotCapTempModFac = CurveValue(DXCoil(DXCoilNum)%CCapFTemp(1),CoolingCoilInletAirWetbulbTempRated, &
OutdoorUnitInletAirDrybulbTempRated)
Do Iter = 1, 4 ! iterative solution in the event that net capacity is near a threshold for external static
!Obtain external static pressure from Table 5 in ANSI/AHRI Std. 340/360-2007
IF (NetCoolingCapRated <= 21000.d0) THEN
ExternalStatic = 50.d0
ELSEIF (21000.d0 < NetCoolingCapRated .AND. NetCoolingCapRated <= 30800.d0) THEN
ExternalStatic = 60.d0
ELSEIF (30800.d0 < NetCoolingCapRated .AND. NetCoolingCapRated <= 39300.d0) THEN
ExternalStatic = 70.d0
ELSEIF (39300.d0 < NetCoolingCapRated .AND. NetCoolingCapRated <= 61500.d0) THEN
ExternalStatic = 90.d0
ELSEIF (61500.d0 < NetCoolingCapRated .AND. NetCoolingCapRated <= 82100.d0) THEN
ExternalStatic = 100.d0
ELSEIF (82100.d0 < NetCoolingCapRated .AND. NetCoolingCapRated <= 103000.d0) THEN
ExternalStatic = 110.d0
ELSEIF (103000.d0 < NetCoolingCapRated .AND. NetCoolingCapRated <= 117000.d0) THEN
ExternalStatic = 140.d0
ELSEIF (117000.d0 < NetCoolingCapRated .AND. NetCoolingCapRated <= 147000.d0) THEN
ExternalStatic = 160.d0
ELSEIF (147000.d0 < NetCoolingCapRated) THEN
ExternalStatic = 190.d0
ENDIF
FanStaticPressureRise = ExternalStatic + DXCoil(DXCoilNum)%InternalStaticPressureDrop
FanInletNode = GetFanInletNode('FAN:VARIABLEVOLUME', DXCoil(DXCoilNum)%SupplyFanName, errorsFound)
FanOutletNode = GetFanOutletNode('FAN:VARIABLEVOLUME', DXCoil(DXCoilNum)%SupplyFanName, errorsFound)
! set node state variables in preparation for fan model.
Node(FanInletNode)%MassFlowRate = DXCoil(DXCoilNum)%RatedAirMassFlowRate(1)
Node(FanOutletNode)%MassFlowRate = DXCoil(DXCoilNum)%RatedAirMassFlowRate(1)
Node(FanInletNode)%Temp = CoolingCoilInletAirDryblubTempRated
Node(FanInletNode)%HumRat = PsyWFnTdbTwbPb(CoolingCoilInletAirDryblubTempRated, CoolingCoilInletAirWetbulbTempRated, &
OutBaroPress , 'CalcTwoSpeedDXCoilStandardRating')
Node(FanInletNode)%Enthalpy = PsyHFnTdbW(CoolingCoilInletAirDryblubTempRated, Node(FanInletNode)%HumRat, &
'CalcTwoSpeedDXCoilStandardRating')
CALL SimulateFanComponents(DXCoil(DXCoilNum)%SupplyFanName,.TRUE.,DXCoil(DXCoilNum)%SupplyFanIndex, &
ZoneCompTurnFansOn = .TRUE. , &
ZoneCompTurnFansOff = .FALSE. , &
PressureRise = FanStaticPressureRise)
FanHeatCorrection = Node(FanOutletNode)%Enthalpy - Node(FanInletNode)%Enthalpy
CALL GetFanPower(DXCoil(DXCoilNum)%SupplyFanIndex, FanPowerCorrection)
NetCoolingCapRated = DXCoil(DXCoilNum)%RatedTotCap(1) * TotCapTempModFac * TotCapFlowModFac &
- FanHeatCorrection
ENDDO
ELSE
FanPowerPerEvapAirFlowRate=DefaultFanPowerPerEvapAirFlowRate
FanPowerCorrection = DefaultFanPowerPerEvapAirFlowRate * DXCoil(DXCoilNum)%RatedAirVolFlowRate(1)
FanHeatCorrection = DefaultFanPowerPerEvapAirFlowRate * DXCoil(DXCoilNum)%RatedAirVolFlowRate(1)
TotCapFlowModFac = CurveValue(DXCoil(DXCoilNum)%CCapFFlow(1),AirMassFlowRatioRated)
TotCapTempModFac = CurveValue(DXCoil(DXCoilNum)%CCapFTemp(1),CoolingCoilInletAirWetbulbTempRated, &
OutdoorUnitInletAirDrybulbTempRated)
NetCoolingCapRated = DXCoil(DXCoilNum)%RatedTotCap(1) * TotCapTempModFac * TotCapFlowModFac &
- FanHeatCorrection
ENDIF
SupAirMdot_TestPoint(1) = DXCoil(DXCoilNum)%RatedAirMassFlowRate(1)
! Calculate Energy Efficiency Ratio (EER) at (19.44C WB and 35.0C DB ), ANSI/AHRI Std. 340/360
EIRTempModFac = CurveValue(DXCoil(DXCoilNum)%EIRFTemp(1),CoolingCoilInletAirWetbulbTempRated, &
OutdoorUnitInletAirDrybulbTempRated)
EIRFlowModFac = CurveValue(DXCoil(DXCoilNum)%EIRFFlow(1),AirMassFlowRatioRated)
IF ( DXCoil(DXCoilNum)%RatedCOP(1) > 0.0D0 ) THEN
! RatedCOP <= 0.0 is trapped in GetInput, but keep this as "safety"
EIR = EIRTempModFac * EIRFlowModFac / DXCoil(DXCoilNum)%RatedCOP(1)
ELSE
EIR = 0.0d0
ENDIF
TotalElecPowerRated = EIR * (DXCoil(DXCoilNum)%RatedTotCap(1) * TotCapTempModFac * TotCapFlowModFac) &
+ FanPowerCorrection
IF ( TotalElecPowerRated > 0.0D0 ) THEN
EER = NetCoolingCapRated / TotalElecPowerRated
ELSE
EER = 0.0d0
ENDIF
! IEER - A point 100 % net capacity
EER_TestPoint_SI(1) = EER
EER_TestPoint_IP(1) = EER * ConvFromSIToIP
! find coil leaving dryblub at point A, with full rated air flow rate.
! init coil
DXCoil(DXCoilNum)%InletAirMassFlowRate = DXCoil(DXCoilNum)%RatedAirMassFlowRate(1)
DXCoil(DXCoilNum)%InletAirMassFlowRateMax = DXCoil(DXCoilNum)%RatedAirMassFlowRate(1)
DXCoil(DXCoilNum)%InletAirTemp = 26.7d0
DXCoil(DXCoilNum)%InletAirHumRat = PsyWFnTdbTwbPb(26.7d0, 19.4d0, OutBaroPress, &
'CalcTwoSpeedDXCoilStandardRating')
DXCoil(DXCoilNum)%InletAirEnthalpy = PsyHFnTdbW(26.7d0, DXCoil(DXCoilNum)%InletAirHumRat, &
'CalcTwoSpeedDXCoilStandardRating')
IF (DXCoil(DXCoilNum)%CondenserInletNodeNum(1) /= 0) THEN
Node(DXCoil(DXCoilNum)%CondenserInletNodeNum(1))%Temp = OutdoorUnitInletAirDrybulbTempRated
ELSE
OutDryBulbTemp = OutdoorUnitInletAirDrybulbTempRated
ENDIF
SpeedRatio = 1.d0
CycRatio = 1.d0
CALL CalcMultiSpeedDXCoil(DXCoilNum, SpeedRatio, CycRatio, ForceOn = .TRUE.)
TempDryBlub_Leaving_Apoint = DXCoilOutletTemp(DXCoilNum) ! store result
! IEER - part load test points ***************************************************
DO PartLoadTestPoint = 1, 3 !
! determine minimum unloading capacity fraction at point B conditions.
IF (DXCoil(DXCoilNum)%CondenserInletNodeNum(1) /= 0) THEN
Node(DXCoil(DXCoilNum)%CondenserInletNodeNum(1))%Temp = OutdoorUnitInletAirDrybulbTempPLTestPoint(PartLoadTestPoint)
ELSE
OutDryBulbTemp = OutdoorUnitInletAirDrybulbTempPLTestPoint(PartLoadTestPoint)
ENDIF
TargetNetCapacity = NetCapacityFactorPLTestPoint(PartLoadTestPoint) * NetCoolingCapRated
Par(1) = REAL(DXCoilNum, r64)
Par(2) = TempDryBlub_Leaving_Apoint
Par(3) = TargetNetCapacity
Par(4) = OutdoorUnitInletAirDrybulbTempPLTestPoint(PartLoadTestPoint)
Par(5) = CoolingCoilInletAirWetbulbTempRated
Par(6) = CoolingCoilInletAirDryblubTempRated
Par(7) = NetCoolingCapRated
IF (DXCoil(DXCoilNum)%RateWithInternalStaticAndFanObject) THEN
Par(8) = 0.0d0
Par(9) = REAL(FanInletNode, r64)
Par(10) = REAL(FanOutletNode, r64)
Par(11) = ExternalStatic
Par(12) = REAL(DXCoil(DXCoilNum)%SupplyFanIndex, r64)
ELSE
Par(8) = FanPowerPerEvapAirFlowRate
Par(9) = 0.0d0
Par(10) = 0.0d0
Par(11) = 0.0d0
Par(12) = 0.0d0
ENDIF
LowerBoundMassFlowRate = 0.01d0 * DXCoil(DXCoilNum)%RatedAirMassFlowRate(1)
CALL SolveRegulaFalsi(AccuracyTolerance, MaximumIterations, SolverFlag, PartLoadAirMassFlowRate, &
CalcTwoSpeedDXCoilIEERResidual, LowerBoundMassFlowRate, &
DXCoil(DXCoilNum)%RatedAirMassFlowRate(1), Par)
IF( SolverFlag == -1) THEN
CALL ShowWarningError('CalcTwoSpeedDXCoilStandardRating: air flow rate solver failed. Iteration limit exceeded ')
SupAirMdot_TestPoint(1 + PartLoadTestPoint) = -999.d0
EER_TestPoint_SI(1+PartLoadTestPoint) = -999.d0
EER_TestPoint_IP(1+PartLoadTestPoint) = -999.d0
NetCapacity_TestPoint(1+PartLoadTestPoint) = -999.d0
NetPower_TestPoint(1+PartLoadTestPoint) = -999.d0
ELSEIF (SolverFlag == -2) THEN
CALL ShowWarningError('CalcTwoSpeedDXCoilStandardRating: air flow rate solver failed. root not bounded ')
SupAirMdot_TestPoint(1 + PartLoadTestPoint) = -999.d0
EER_TestPoint_SI(1+PartLoadTestPoint) = -999.d0
EER_TestPoint_IP(1+PartLoadTestPoint) = -999.d0
NetCapacity_TestPoint(1+PartLoadTestPoint) = -999.d0
NetPower_TestPoint(1+PartLoadTestPoint) = -999.d0
ELSE
! now we have the supply air flow rate
SupAirMdot_TestPoint(1 + PartLoadTestPoint) = PartLoadAirMassFlowRate
AirMassFlowRatio = PartLoadAirMassFlowRate / DXCoil(DXCoilNum)%RatedAirMassFlowRate(1)
SupplyAirHumRat = PsyWFnTdbTwbPb(CoolingCoilInletAirDryblubTempRated, CoolingCoilInletAirWetbulbTempRated, OutBaroPress , &
'CalcTwoSpeedDXCoilStandardRating')
SupplyAirRho = PsyRhoAirFnPbTdbW(OutBaroPress, CoolingCoilInletAirDryblubTempRated, SupplyAirHumRat, &
'CalcTwoSpeedDXCoilStandardRating')
SupplyAirVolFlowRate = PartLoadAirMassFlowRate / SupplyAirRho
IF( DXCoil(DXCoilNum)%RateWithInternalStaticAndFanObject) THEN
FanStaticPressureRise = DXCoil(DXCoilNum)%InternalStaticPressureDrop &
+ (ExternalStatic * (AirMassFlowRatio**2))
Node(FanInletNode)%MassFlowRate = PartLoadAirMassFlowRate
Node(FanInletNode)%Temp = CoolingCoilInletAirDryblubTempRated
Node(FanInletNode)%HumRat = SupplyAirHumRat
Node(FanInletNode)%Enthalpy = PsyHFnTdbW(CoolingCoilInletAirDryblubTempRated, SupplyAirHumRat, &
'CalcTwoSpeedDXCoilStandardRating')
CALL SimulateFanComponents(DXCoil(DXCoilNum)%SupplyFanName,.TRUE.,DXCoil(DXCoilNum)%SupplyFanIndex, &
ZoneCompTurnFansOn = .TRUE. , &
ZoneCompTurnFansOff = .FALSE. , &
PressureRise = FanStaticPressureRise)
FanHeatCorrection = Node(FanOutletNode)%Enthalpy - Node(FanInletNode)%Enthalpy
CALL GetFanPower(DXCoil(DXCoilNum)%SupplyFanIndex, FanPowerCorrection)
ELSE
FanPowerCorrection = FanPowerPerEvapAirFlowRate * PartLoadAirMassFlowRate
FanHeatCorrection = FanPowerPerEvapAirFlowRate * PartLoadAirMassFlowRate
ENDIF
TotCapFlowModFac = CurveValue(DXCoil(DXCoilNum)%CCapFFlow(1),AirMassFlowRatio)
TotCapTempModFac = CurveValue(DXCoil(DXCoilNum)%CCapFTemp(1),CoolingCoilInletAirWetbulbTempRated, &
OutdoorUnitInletAirDrybulbTempPLTestPoint(PartLoadTestPoint))
HighSpeedTotCoolingCap = DXCoil(DXCoilNum)%RatedTotCap(1) * TotCapTempModFac * TotCapFlowModFac
HighSpeedNetCoolingCap = HighSpeedTotCoolingCap - FanHeatCorrection
EIRTempModFac = CurveValue(DXCoil(DXCoilNum)%EIRFTemp(1),CoolingCoilInletAirWetbulbTempRated, &
OutdoorUnitInletAirDrybulbTempPLTestPoint(PartLoadTestPoint))
EIRFlowModFac = CurveValue(DXCoil(DXCoilNum)%EIRFFlow(1),AirMassFlowRatio)
IF ( DXCoil(DXCoilNum)%RatedCOP(1) > 0.0D0 ) THEN
! RatedCOP <= 0.0 is trapped in GetInput, but keep this as "safety"
EIR_HighSpeed = EIRTempModFac * EIRFlowModFac / DXCoil(DXCoilNum)%RatedCOP(1)
ELSE
EIR = 0.0d0
ENDIF
TotCapFlowModFac = CurveValue(DXCoil(DXCoilNum)%CCapFTemp2,AirMassFlowRatio)
TotCapTempModFac = CurveValue(DXCoil(DXCoilNum)%CCapFTemp2,CoolingCoilInletAirWetbulbTempRated, &
OutdoorUnitInletAirDrybulbTempPLTestPoint(PartLoadTestPoint))
LowSpeedTotCoolingCap = DXCoil(DXCoilNum)%RatedTotCap2 * TotCapTempModFac * TotCapFlowModFac
LowSpeedNetCoolingCap = LowSpeedTotCoolingCap - FanHeatCorrection
EIRTempModFac = CurveValue(DXCoil(DXCoilNum)%EIRFTemp2,CoolingCoilInletAirWetbulbTempRated, &
OutdoorUnitInletAirDrybulbTempPLTestPoint(PartLoadTestPoint))
EIRFlowModFac = CurveValue(DXCoil(DXCoilNum)%EIRFFlow(1),AirMassFlowRatio)
IF ( DXCoil(DXCoilNum)%RatedCOP2 > 0.0D0 ) THEN
! RatedCOP <= 0.0 is trapped in GetInput, but keep this as "safety"
EIR_LowSpeed = EIRTempModFac * EIRFlowModFac / DXCoil(DXCoilNum)%RatedCOP2
ELSE
EIR_LowSpeed = 0.0d0
ENDIF
IF (LowSpeedNetCoolingCap <= TargetNetCapacity ) THEN
CycRatio = 1.d0
SpeedRatio = (TargetNetCapacity - LowSpeedNetCoolingCap) &
/( HighSpeedNetCoolingCap - LowSpeedNetCoolingCap )
TotCoolingCap = HighSpeedTotCoolingCap * SpeedRatio + LowSpeedTotCoolingCap *(1.d0-SpeedRatio)
NetCoolingCap = TotCoolingCap - FanHeatCorrection
EIR = EIR_HighSpeed * SpeedRatio + EIR_LowSpeed * (1.d0-SpeedRatio)
TotalElecPowerRated = TotCoolingCap * EIR + FanPowerCorrection
EER_TestPoint_SI(1+PartLoadTestPoint) = NetCoolingCap / TotalElecPowerRated
EER_TestPoint_IP(1+PartLoadTestPoint) = EER_TestPoint_SI(1+PartLoadTestPoint) * ConvFromSIToIP
NetCapacity_TestPoint(1+PartLoadTestPoint) = NetCoolingCap
NetPower_TestPoint(1+PartLoadTestPoint) = TotalElecPowerRated
ELSE ! minimum unloading limit exceeded without cycling, so cycle
SpeedRatio = 0.d0
CycRatio = TargetNetCapacity / LowSpeedNetCoolingCap
PLF = CurveValue(DXCoil(DXCoilNum)%PLFFPLR(1),CycRatio)
IF (PLF < 0.7d0) THEN
PLF = 0.7d0
END IF
RunTimeFraction = CycRatio/ PLF
RunTimeFraction = MIN(RunTimeFraction, 1.d0)
TotCoolingCap = LowSpeedTotCoolingCap * RunTimeFraction
NetCoolingCap = TotCoolingCap - FanHeatCorrection
TotalElecPowerRated = LowSpeedTotCoolingCap * EIR_LowSpeed * RunTimeFraction &
+ FanPowerCorrection
EER_TestPoint_SI(1+PartLoadTestPoint) = NetCoolingCap / TotalElecPowerRated
EER_TestPoint_IP(1+PartLoadTestPoint) = EER_TestPoint_SI(1+PartLoadTestPoint) * ConvFromSIToIP
NetCapacity_TestPoint(1+PartLoadTestPoint) = NetCoolingCap
NetPower_TestPoint(1+PartLoadTestPoint) = TotalElecPowerRated
ENDIF
ENDIF
ENDDO ! loop over 3 part load test points
IEER = (0.02d0*EER_TestPoint_IP(1)) + (0.617d0*EER_TestPoint_IP(2)) + &
(0.238d0*EER_TestPoint_IP(3)) + (0.125d0*EER_TestPoint_IP(4))
! begin output
IF (OneTimeEIOHeaderWrite) THEN
WRITE(OutputFileInits, 890 )
OneTimeEIOHeaderWrite = .FALSE.
pdstVAVDXCoolCoil = newPreDefSubTable(pdrEquip,'VAV DX Cooling Standard Rating Details')
pdchVAVDXCoolCoilType = newPreDefColumn(pdstVAVDXCoolCoil, 'DX Cooling Coil Type')
pdchVAVDXFanName = newPreDefColumn(pdstVAVDXCoolCoil, 'Assocated Fan')
pdchVAVDXCoolCoilNetCapSI = newPreDefColumn(pdstVAVDXCoolCoil, 'Net Cooling Capacity [W]')
pdchVAVDXCoolCoilCOP = newPreDefColumn(pdstVAVDXCoolCoil, 'COP [W/W]')
pdchVAVDXCoolCoilEERIP = newPreDefColumn(pdstVAVDXCoolCoil, 'EER [Btu/W-h]')
pdchVAVDXCoolCoilIEERIP = newPreDefColumn(pdstVAVDXCoolCoil, 'IEER [Btu/W-h]')
pdchVAVDXCoolCoilMdotA = newPreDefColumn(pdstVAVDXCoolCoil, 'Supply Air Flow 100% [kg/s]')
pdchVAVDXCoolCoilCOP_B = newPreDefColumn(pdstVAVDXCoolCoil, 'COP 75% Capacity [W/W]')
pdchVAVDXCoolCoilEER_B_IP = newPreDefColumn(pdstVAVDXCoolCoil, 'EER 75% Capacity [Btu/W-h]')
pdchVAVDXCoolCoilMdotB = newPreDefColumn(pdstVAVDXCoolCoil, 'Supply Air Flow 75% [kg/s]')
pdchVAVDXCoolCoilCOP_C = newPreDefColumn(pdstVAVDXCoolCoil, 'COP 50% Capacity [W/W]')
pdchVAVDXCoolCoilEER_C_IP = newPreDefColumn(pdstVAVDXCoolCoil, 'EER 50% Capacity [Btu/W-h]')
pdchVAVDXCoolCoilMdotC = newPreDefColumn(pdstVAVDXCoolCoil, 'Supply Air Flow 50% [kg/s]')
pdchVAVDXCoolCoilCOP_D = newPreDefColumn(pdstVAVDXCoolCoil, 'COP 25% Capacity [W/W]')
pdchVAVDXCoolCoilEER_D_IP = newPreDefColumn(pdstVAVDXCoolCoil, 'EER 25% Capacity [Btu/W-h]')
pdchVAVDXCoolCoilMdotD = newPreDefColumn(pdstVAVDXCoolCoil, 'Supply Air Flow 25% [kg/s]')
! determine footnote content
countStaticInputs = 0
DO index =1, NumDXCoils
If ( DXCoil(index)%RateWithInternalStaticAndFanObject .AND. DXCoil(index)%DXCoilType_Num == CoilDX_CoolingTwoSpeed) THEN
countStaticInputs =countStaticInputs + 1
ENDIF
ENDDO
IF( countStaticInputs == NumDXMulSpeedCoils) THEN
CALL addFootNoteSubTable(pdstVAVDXCoolCoil, &
'Packaged VAV unit ratings per ANSI/AHRI Standard 340/360-2007 with Addenda 1 and 2')
ELSEIF (countStaticInputs == 0) THEN
CALL addFootNoteSubTable(pdstVAVDXCoolCoil, &
'Indoor-coil-only unit ratings per ANSI/AHRI Standard 340/360-2007 with Addenda 1 and 2,' &
// ' with supply fan specific power at 365 {W/1000cfm} (773.3 {W/(m3/s)})')
ELSE ! both
CALL addFootNoteSubTable(pdstVAVDXCoolCoil, &
'Packaged VAV unit ratings per ANSI/AHRI Standard 340/360-2007 with Addenda 1 and 2,' &
// ' indoor-coil-only units with supply fan specific power at 365 {W/1000cfm} (773.3 {W/(m3/s)})')
ENDIF
ENDIF
IF( DXCoil(DXCoilNum)%RateWithInternalStaticAndFanObject) THEN
WRITE (OutputFileInits, 891) TRIM('Coil:Cooling:DX:TwoSpeed'), TRIM(DXCoil(DXCoilNum)%Name), TRIM('Fan:VariableVolume'), &
TRIM(DXCoil(DXCoilNum)%SupplyFanName), &
TRIM(RoundSigDigits(NetCoolingCapRated, 2)), &
TRIM(RoundSigDigits((NetCoolingCapRated *ConvFromSIToIP), 2)), &
TRIM(RoundSigDigits(IEER, 2)), &
TRIM(RoundSigDigits(EER_TestPoint_SI(1), 2)), &
TRIM(RoundSigDigits(EER_TestPoint_SI(2), 2)),&
TRIM(RoundSigDigits(EER_TestPoint_SI(3), 2)), &
TRIM(RoundSigDigits(EER_TestPoint_SI(4), 2)), &
TRIM(RoundSigDigits(EER_TestPoint_IP(1), 2)), &
TRIM(RoundSigDigits(EER_TestPoint_IP(2), 2)),&
TRIM(RoundSigDigits(EER_TestPoint_IP(3), 2)), &
TRIM(RoundSigDigits(EER_TestPoint_IP(4), 2)), &
TRIM(RoundSigDigits(SupAirMdot_TestPoint(1), 4)), &
TRIM(RoundSigDigits(SupAirMdot_TestPoint(2), 4)), &
TRIM(RoundSigDigits(SupAirMdot_TestPoint(3), 4)), &
TRIM(RoundSigDigits(SupAirMdot_TestPoint(4), 4))
ELSE
WRITE (OutputFileInits, 891) TRIM('Coil:Cooling:DX:TwoSpeed'), TRIM(DXCoil(DXCoilNum)%Name), TRIM('N/A'), &
TRIM('N/A'), &
TRIM(RoundSigDigits(NetCoolingCapRated, 2)), &
TRIM(RoundSigDigits((NetCoolingCapRated *ConvFromSIToIP), 2)), &
TRIM(RoundSigDigits(IEER, 2)), &
TRIM(RoundSigDigits(EER_TestPoint_SI(1), 2)), &
TRIM(RoundSigDigits(EER_TestPoint_SI(2), 2)),&
TRIM(RoundSigDigits(EER_TestPoint_SI(3), 2)), &
TRIM(RoundSigDigits(EER_TestPoint_SI(4), 2)), &
TRIM(RoundSigDigits(EER_TestPoint_IP(1), 2)), &
TRIM(RoundSigDigits(EER_TestPoint_IP(2), 2)),&
TRIM(RoundSigDigits(EER_TestPoint_IP(3), 2)), &
TRIM(RoundSigDigits(EER_TestPoint_IP(4), 2)), &
TRIM(RoundSigDigits(SupAirMdot_TestPoint(1), 4)), &
TRIM(RoundSigDigits(SupAirMdot_TestPoint(2), 4)), &
TRIM(RoundSigDigits(SupAirMdot_TestPoint(3), 4)), &
TRIM(RoundSigDigits(SupAirMdot_TestPoint(4), 4))
ENDIF
890 FORMAT('! <VAV DX Cooling Coil Standard Rating Information>, DX Coil Type, DX Coil Name, Fan Type, Fan Name, ', &
'Standard Net Cooling Capacity {W}, Standard Net Cooling Capacity {Btu/h}, IEER {Btu/W-h}, ', &
'COP 100% Capacity {W/W}, COP 75% Capacity {W/W}, COP 50% Capacity {W/W}, COP 25% Capacity {W/W}, ', &
'EER 100% Capacity {Btu/W-h}, EER 75% Capacity {Btu/W-h}, EER 50% Capacity {Btu/W-h}, EER 25% Capacity {Btu/W-h}, ', &
'Supply Air Flow 100% {kg/s}, Supply Air Flow 75% {kg/s},Supply Air Flow 50% {kg/s},Supply Air Flow 25% {kg/s}' )
891 FORMAT ( ' VAV DX Cooling Coil Standard Rating Information, ',A,',',A,',',A,',',A,',',A,',',A,',',A,',' &
,A,',',A,',',A,',',A,',',A,',',A,',',A,',',A,',',A,',',A,',',A,',',A,',',A)
CALL PreDefTableEntry(pdchDXCoolCoilType, TRIM(DXCoil(DXCoilNum)%Name),TRIM('Coil:Cooling:DX:TwoSpeed'))
CALL PreDefTableEntry(pdchDXCoolCoilNetCapSI,TRIM(DXCoil(DXCoilNum)%Name),TRIM(RoundSigDigits(NetCoolingCapRated,1)))
CALL PreDefTableEntry(pdchDXCoolCoilCOP, TRIM(DXCoil(DXCoilNum)%Name),TRIM(RoundSigDigits(EER_TestPoint_SI(1),2)))
CALL PreDefTableEntry(pdchDXCoolCoilEERIP, TRIM(DXCoil(DXCoilNum)%Name),TRIM(RoundSigDigits(EER_TestPoint_IP(1),2)))
CALL PreDefTableEntry(pdchDXCoolCoilIEERIP, TRIM(DXCoil(DXCoilNum)%Name),TRIM(RoundSigDigits(IEER,2)))
CALL PreDefTableEntry(pdchDXCoolCoilSEERIP, TRIM(DXCoil(DXCoilNum)%Name),TRIM('N/A') )
CALL addFootNoteSubTable(pdstDXCoolCoil, 'ANSI/AHRI ratings include supply fan')
CALL PreDefTableEntry(pdchVAVDXCoolCoilType, TRIM(DXCoil(DXCoilNum)%Name),TRIM('Coil:Cooling:DX:TwoSpeed'))
IF( DXCoil(DXCoilNum)%RateWithInternalStaticAndFanObject) THEN
CALL PreDefTableEntry(pdchVAVDXFanName, TRIM(DXCoil(DXCoilNum)%Name),TRIM(DXCoil(DXCoilNum)%SupplyFanName))
ELSE
CALL PreDefTableEntry(pdchVAVDXFanName, TRIM(DXCoil(DXCoilNum)%Name),TRIM('None'))
ENDIF
CALL PreDefTableEntry(pdchVAVDXCoolCoilNetCapSI, TRIM(DXCoil(DXCoilNum)%Name), TRIM(RoundSigDigits(NetCoolingCapRated, 2)) )
CALL PreDefTableEntry(pdchVAVDXCoolCoilCOP, TRIM(DXCoil(DXCoilNum)%Name), TRIM(RoundSigDigits(EER_TestPoint_SI(1), 2) ))
CALL PreDefTableEntry(pdchVAVDXCoolCoilIEERIP, TRIM(DXCoil(DXCoilNum)%Name), TRIM(RoundSigDigits(IEER, 2)) )
CALL PreDefTableEntry(pdchVAVDXCoolCoilEERIP, TRIM(DXCoil(DXCoilNum)%Name), TRIM(RoundSigDigits(EER_TestPoint_IP(1), 2)))
CALL PreDefTableEntry(pdchVAVDXCoolCoilMdotA, TRIM(DXCoil(DXCoilNum)%Name), TRIM(RoundSigDigits(SupAirMdot_TestPoint(1), 4)))
CALL PreDefTableEntry(pdchVAVDXCoolCoilCOP_B, TRIM(DXCoil(DXCoilNum)%Name), TRIM(RoundSigDigits(EER_TestPoint_SI(2), 2) ))
CALL PreDefTableEntry(pdchVAVDXCoolCoilEER_B_IP, TRIM(DXCoil(DXCoilNum)%Name), TRIM(RoundSigDigits(EER_TestPoint_IP(2), 2)))
CALL PreDefTableEntry(pdchVAVDXCoolCoilMdotB, TRIM(DXCoil(DXCoilNum)%Name), TRIM(RoundSigDigits(SupAirMdot_TestPoint(2), 4)))
CALL PreDefTableEntry(pdchVAVDXCoolCoilCOP_C, TRIM(DXCoil(DXCoilNum)%Name), TRIM(RoundSigDigits(EER_TestPoint_SI(3), 2)))
CALL PreDefTableEntry(pdchVAVDXCoolCoilEER_C_IP, TRIM(DXCoil(DXCoilNum)%Name), TRIM(RoundSigDigits(EER_TestPoint_IP(3), 2)))
CALL PreDefTableEntry(pdchVAVDXCoolCoilMdotC, TRIM(DXCoil(DXCoilNum)%Name), TRIM(RoundSigDigits(SupAirMdot_TestPoint(3), 4)))
CALL PreDefTableEntry(pdchVAVDXCoolCoilCOP_D, TRIM(DXCoil(DXCoilNum)%Name), TRIM(RoundSigDigits(EER_TestPoint_SI(4), 2)))
CALL PreDefTableEntry(pdchVAVDXCoolCoilEER_D_IP, TRIM(DXCoil(DXCoilNum)%Name), TRIM(RoundSigDigits(EER_TestPoint_IP(4), 2)))
CALL PreDefTableEntry(pdchVAVDXCoolCoilMdotD, TRIM(DXCoil(DXCoilNum)%Name), TRIM(RoundSigDigits(SupAirMdot_TestPoint(4), 4)))
RETURN
END SUBROUTINE CalcTwoSpeedDXCoilStandardRating