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 | ||
---|---|---|---|---|---|---|
character(len=*), | intent(in) | :: | DXCoilName | |||
character(len=*), | intent(in) | :: | DXCoilType | |||
integer, | intent(in) | :: | DXCoilType_Num | |||
integer, | intent(in) | :: | ns | |||
real(kind=r64), | intent(in) | :: | RatedTotalCapacity(ns) | |||
real(kind=r64), | intent(in) | :: | RatedCOP(ns) | |||
integer, | intent(in) | :: | CapFFlowCurveIndex(ns) | |||
integer, | intent(in) | :: | CapFTempCurveIndex(ns) | |||
integer, | intent(in) | :: | EIRFFlowCurveIndex(ns) | |||
integer, | intent(in) | :: | EIRFTempCurveIndex(ns) | |||
integer, | intent(in) | :: | PLFFPLRCurveIndex(ns) | |||
real(kind=r64), | intent(in) | :: | RatedAirVolFlowRate(ns) | |||
real(kind=r64), | intent(in) | :: | FanPowerPerEvapAirFlowRateFromInput(ns) | |||
integer, | intent(in), | optional | :: | RegionNum | ||
real(kind=r64), | intent(in), | optional | :: | MinOATCompressor | ||
real(kind=r64), | intent(in), | optional | :: | OATempCompressorOn | ||
logical, | intent(in), | optional | :: | OATempCompressorOnOffBlank | ||
integer, | intent(in), | optional | :: | DefrostControl |
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 CalcDXCoilStandardRating(DXCoilName, DXCoilType, DXCoilType_Num, ns, RatedTotalCapacity, RatedCOP, CapFFlowCurveIndex, &
CapFTempCurveIndex, EIRFFlowCurveIndex, EIRFTempCurveIndex, PLFFPLRCurveIndex, &
RatedAirVolFlowRate, FanPowerPerEvapAirFlowRateFromInput, RegionNum, MinOATCompressor, &
OATempCompressorOn, OATempCompressorOnOffBlank, DefrostControl)
! SUBROUTINE INFORMATION:
! AUTHOR Bereket Nigusse, Chandan Sharma FSEC
! DATE WRITTEN February 2010,
! B. Nigusse, May 2010 Added EER and IEER Calculation
! C. Sharma, March 2012 Added HSPF Calculation for single speed HP
! B. Nigusse, August 2012 Added SEER Calculation for Multi-speed HP
! B. Nigusse, November 2012 Added HSPF Calculation for Multi-speed HP
! RE-ENGINEERED na
! PURPOSE OF THIS SUBROUTINE:
! Calculates:
! (1) Standard Rated (net) Cooling Capacity
! (2) Seasonal Energy Efficiency Ratio (SEER)
! (3) Energy Efficiency Ratio (EER),
! (4) Integrated Energy Efficiency Ratio (IEER)
! for Air-to-Air Direct Expansion Air Conditioner and Heat Pumps having a single-speed compressor,
! fixed speed indoor supply air fan, and air-cooled condensers. Writes the result to EIO file.
! (5) Heating Seasonal Performance Factor (HSPF) for Air-Source Direct Expansion Heat Pumps having
! a single-speed compressor, fixed speed indoor supply air fan
! (6) Standard Rated (net) Cooling Capacity; and
! (7) Seasonal Energy Efficiency Ratio (SEER) for Air-to-Air Heat Pumps having multi-speed
! compressor.
! (8) Heating Seasonal Performance Factor (HSPF) for Air-to-Air Heat Pumps having multi-speed
! compressor.
!
! METHODOLOGY EMPLOYED:
! (A) Methodology for calculating standard ratings for DX air conditioners
! (1) Obtains the rated condition parameters:
! Cooling capacity (User specified or Autosized Value)
! Rated Air volume flow rate through the DX Cooling Coil (User specified or autosized value)
!
! (2) Evaluates the total cooling coil capacity at AHRI test conditions 26.7C/19.4C/27.8C. Then net
! cooling capacity is determined from the total cooling capacity of the DX coil at the AHRI test
! conditions and accounting for the INDOOR supply air fan heat.
!
! (3) Calculates the electric power consumed by the DX Coil Unit (compressor + outdoor condenser fan).
! Evaluates the EIR capacity and flow fraction modifiers at 26.7C/19.4C/27.8C. The net electric
! power consumption is determined by adding the indoor fan electric power to the electric power
! consumption by the DX Coil Condenser Fan and Compressor at the AHRI test conditions.
!
! (4) The EER is evaluated from the total net cooling capacity and total electric power
! evaluated at the standard rated test conditions. The IEER is a weighted value of the EER evaluated
! at four different capacities of 100%, 75%, 50% and 25%. The reduced capacity EERs are evaluated
! at different outdoor coil entering air dry-bulb temperatures.
!
! (B) Methodology for calculating standard ratings for DX air air source heat pumps
! (1) Obtains the rated condition parameters:
! heating capacity (User specified or Autosized Value), COP, Rated Air volume flow rate through the
! DX Cooling Coil (User specified or autosized value) and Fan power per rated air flow rate
!
! (2) Evaluates the heating coil capacities for AHRI tests H1, H2 and H3 using the performance cuves and
! input values specified at (1) above. Then net heating capacity is determined from the total heating capacity
! of the DX coil at the AHRI test conditions and accounting for the INDOOR supply air fan heat.
!
! (3) Calculates the electric power consumed by the DX Coil Unit (compressor + outdoor condenser fan).
! The net electric power consumption is determined by adding the indoor fan electric power to the
! electric power consumption by the DX Coil Condenser Fan and Compressor at the AHRI test conditions.
!
! (4) High Temperature Heating Standard (Net) Rating Capacity and Low Temperature Heating Standard (Net)
! Rating Capacity capacity are determined using tests H1 adn H3 per ANSI/AHRI 210/240 2008.
!
! (5) The HSPF is evaluated from the total net heating capacity and total electric power
! evaluated at the standard rated test conditions. For user specified region number, the outdoor temperatures
! are Binned (grouped) and fractioanl bin hours for each bin over the entire heating season are taken
! from AHRI 210/240. Then for each bin, building load, heat pump energy adn resistance space heating enegry are
! calculated. The sum of building load divided by sum of heat pump and resistance space heating over the
! entire heating season gives the HSPF. The detailed calculation algorithms of calculating HSPF
! are described in Engineering Reference.
!
! (C) Methodology for calculating standard ratings for Multi-Speed Heat Pumps
! Net Total Cooling Capacity and SEER
! (1) Obtains the rated condition parameters:
! Cooling capacity (User specified or Autosized Value)
! Rated Air volume flow rate through the DX Cooling Coil (User specified or autosized value)
!
! (2) Evaluates the total cooling coil capacity at AHRI A2 test conditions 26.7C/19.4C/35.0C. Then net
! cooling capacity is determined from the total cooling capacity of the DX coil at the AHRI A2 test
! conditions and accounting for the INDOOR supply air fan effect. The net total cooling capacity
! is reported at the high (maximum) speed only.
!
! (3) Calculates the electric power consumed by the DX Coil Unit (compressor + outdoor condenser fan).
! Evaluates the EIR capacity and flow fraction modifiers at A2, B2, B1, and F1 test coditions per
! AHRI/ANSI Std. 210/240 test procedure for multi-speed compressor. For any inter-
! mediate operating conditions (speed), the successive lower and the higher speed performnace are
! weighed per the standard. Electric Power consumption is determined by adding the indoor fan
! electric power to the electric power consumption by the outdoor DX Coil Fan and Compressor Power
! at the AHRI test conditions. The net total cooling capacity is also corrected for the fan heat
! effect for SEER calculation.
!
! Net Heatingg Capacity and HSPF
! (4) Obtains the rated condition parameters:
! Heating capacity (User specified or Autosized Value)
! Rated Air volume flow rate through the DX Heating Coil (User specified or autosized value)
!
! (5) Evaluates the heating coil capacity at AHRI H12 test conditions 21.1C/15.6C/8.33C. Then net
! heating capacity is determined from the total heating capacity of the DX coil at the AHRI H12
! test conditions and accounting for the supply supply air fan effect. The net heating capacity
! is reported at the high (maximum) speed only.
!
! (6) Calculates the electric power consumed by the DX Coil Unit (compressor + outdoor condenser fan).
! Evaluates the EIR capacity and flow fraction modifiers per AHRI/ANSI Std. 210/240 test procedures
! for two speed compressor (H01, H11, H21, H31, H12, H22, and H32 ). This procedure was modified
! for multispeed heat pumps. For any inter-mediate operating conditions (speed), the successive
! lower and the higher speed performnace are weighed per the standard.
! Electric Power consumption is determined by adding the supply fan electric power to the electric
! power consumption by the outdoor DX Coil Fan and Compressor Power at the AHRI test conditions.
! The net heating capacity is also corrected for the fan heat effect for SEER calculation.
!
! REFERENCES:
! (1) ANSI/AHRI Standard 210/240-2008: Standard for Performance Rating of Unitary Air-Conditioning and
! Air-Source Heat Pumps. Arlington, VA: Air-Conditioning, Heating
! , and Refrigeration Institute.
!
! (2) ANSI/AHRI Standard 340/360-2007: Standard for Performance Rating of Commercial and Industrial
! Unitary Air-Conditioning and Heat Pump Equipment. Arlington,
! VA: Air-Conditioning, Heating, and Refrigeration Institute.
! USE STATEMENTS:
USE DataHVACGlobals, ONLY: CoilDX_CoolingSingleSpeed, CoilDX_HeatingEmpirical,CoilDX_MultiSpeedCooling,CoilDX_MultiSpeedHeating
USE CurveManager, ONLY: CurveValue, GetCurveMinMaxValues, GetCurveType
USE General, ONLY: RoundSigDigits
IMPLICIT NONE ! Enforce explicit typing of all variables in this routine
! SUBROUTINE ARGUMENT DEFINITIONS:
CHARACTER(len=*), INTENT(IN) :: DXCoilName ! Name of DX coil for which HSPF is calculated
CHARACTER(len=*), INTENT(IN) :: DXCoilType ! Type of DX coil for which HSPF is calculated
INTEGER, INTENT(IN) :: DXCoilType_Num ! Integer Type of DX coil - heating or cooling
INTEGER, INTENT(IN) :: ns ! Number of compressor speeds
INTEGER, INTENT(IN) :: CapFTempCurveIndex(ns) ! Index for the capacity as a function of temperature modifier curve
INTEGER, INTENT(IN) :: CapFFlowCurveIndex(ns) ! Index for the capacity as a function of flow fraction modifier curve
INTEGER, INTENT(IN) :: EIRFTempCurveIndex(ns) ! Index for the EIR as a function of temperature modifier curve
INTEGER, INTENT(IN) :: EIRFFlowCurveIndex(ns) ! Index for the EIR as a function of flow fraction modifier curve
INTEGER, INTENT(IN) :: PLFFPLRCurveIndex(ns) ! Index for the PLF vs part-load ratio curve
REAL(r64), INTENT(IN) :: RatedTotalCapacity(ns) ! Reference capacity of DX coil [W]
REAL(r64), INTENT(IN) :: RatedCOP(ns) ! Reference coefficient of performance [W/W]
REAL(r64), INTENT(IN) :: RatedAirVolFlowRate(ns) ! Reference air flow rate of DX coil [m3/s]
REAL(r64), INTENT(IN) :: FanPowerPerEvapAirFlowRateFromInput(ns) ! Reference fan power per evap air flow rate [W/(m3/s)]
INTEGER, OPTIONAL, INTENT(IN) :: RegionNum ! Region number for calculating HSPF of single speed DX heating coil !Objexx:OPTIONAL Used without PRESENT check
INTEGER, OPTIONAL, INTENT(IN) :: DefrostControl ! defrost control; 1=timed, 2=on-demand !Objexx:OPTIONAL Used without PRESENT check
REAL(r64), OPTIONAL, INTENT(IN) :: MinOATCompressor ! Minimum OAT for heat pump compressor operation [C] !Objexx:OPTIONAL Used without PRESENT check
REAL(r64), OPTIONAL, INTENT(IN) :: OATempCompressorOn ! The outdoor temperature when the compressor is automatically turned !Objexx:OPTIONAL Used without PRESENT check
! back on, if applicable, following automatic shut off. This field is
! used only for HSPF calculation. [C]
LOGICAL, OPTIONAL, INTENT(IN) :: OATempCompressorOnOffBlank ! Flag used to determine low temperature cut out factor !Objexx:OPTIONAL Used without PRESENT check
! SUBROUTINE PARAMETER DEFINITIONS:
! INTERFACE BLOCK SPECIFICATIONS
! na
! DERIVED TYPE DEFINITIONS
! na
! SUBROUTINE LOCAL VARIABLE DECLARATIONS:
REAL(r64) :: FanPowerPerEvapAirFlowRate(ns) ! Fan power per air volume flow rate through the evaporator coil [W/(m3/s)]
! Intermediate values calculated from the inputs in the idf file
REAL(r64) :: TotCapTempModFacH0 = 0.0D0 ! Tot capacity modifier (function of entering wetbulb, outside drybulb) at H0 Test [-]
REAL(r64) :: TotCapTempModFacH1 = 0.0D0 ! Tot capacity modifier (function of entering wetbulb, outside drybulb) at H1 Test [-]
REAL(r64) :: TotCapTempModFacH2 = 0.0D0 ! Tot capacity modifier (function of entering wetbulb, outside drybulb) at H2 Test [-]
REAL(r64) :: TotCapTempModFacH3 = 0.0D0 ! Tot capacity modifier (function of entering wetbulb, outside drybulb) at H3 Test [-]
REAL(r64) :: EIRTempModFacH1 = 0.0D0 ! EIR modifier (function of entering wetbulb, outside drybulb) at H1 Test[-]
REAL(r64) :: EIRTempModFacH0 = 0.0D0 ! EIR modifier (function of entering wetbulb, outside drybulb) at H0 Test[-]
REAL(r64) :: EIRTempModFacH2 = 0.0D0 ! EIR modifier (function of entering wetbulb, outside drybulb) at H2 Test[-]
REAL(r64) :: EIRTempModFacH3 = 0.0D0 ! EIR modifier (function of entering wetbulb, outside drybulb) at H3 Test[-]
REAL(r64) :: PartLoadFactor = 0.0D0 ! Part load factor
REAL(r64) :: PartLoadRatio = 0.0d0 ! compressor cycling ratio between successive speeds, [-]
REAL(r64) :: PartLoadFraction = 0.0d0 ! part-load fraction that account for the cyclic degradation, [-]
REAL(r64) :: NetHeatingCapWeighted = 0.0d0 ! net total heating cap weighted by the fraction of the binned cooling hours [W]
REAL(r64) :: TotHeatingElecPowerWeighted = 0.0d0 ! net total heat pump and resistance heating electric Energy input weighted by
! the fraction of the binned cooling hours
REAL(r64) :: BuildingHeatingLoad = 0.0d0 ! Building space heating load corresponding to an outdoor bin temperature [W]
REAL(r64) :: NetTotHeatCapBinned = 0.0d0 ! Net tot heatinging cap corresponding to an outdoor bin temperature [W]
REAL(r64) :: TotHeatElecPowerBinnedHP = 0.0d0 ! Total Heat Pump heating electric power consumption at outdoor bin temp [W]
REAL(r64) :: TotHeatElecPowerBinnedRH = 0.0d0 ! Total Resistance heating electric power consumption at outdoor bin temp [W]
!
INTEGER :: BinNum ! bin number counter
INTEGER :: spnum ! compressor speed number
INTEGER :: StandardDHRNum ! Integer counter for standardized DHRs
! Calculated and reported to the EIO file
REAL(r64) :: SEER = 0.0d0 ! Seasonal Energy Efficiency Ratio in SI [W/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) :: HSPF = 0.0d0 ! Heating Seasonal Performance Factor in SI [W/W]
REAL(r64) :: NetHeatingCapRatedHighTemp = 0.0d0 ! Net Rated heating capacity at high temp [W]
REAL(r64) :: NetHeatingCapRatedLowTemp = 0.0d0 ! Net Rated heating capacity at low temp [W]
REAL(r64) :: NetCoolingCapRated(ns) ! Net Cooling Coil capacity at Rated conditions, accounting for supply fan heat [W]
NetCoolingCapRated = 0.0d0
SELECT CASE(DXCoilType_Num)
CASE (CoilDX_CoolingSingleSpeed) ! Coil:Cooling:DX:SingleSpeed
CALL CheckCurveLimitsForStandardRatings(DXCoilName, DXCoilType, DXCoilType_Num, CapFTempCurveIndex(1), &
CapFFlowCurveIndex(1), EIRFTempCurveIndex(1), EIRFFlowCurveIndex(1), &
PLFFPLRCurveIndex(1))
! Calculated Net Cooling Capacity, SEER, EER, and IEER of single speed DX cooling coils
CALL SingelSpeedDXCoolingCoilStandardRatings(DXCoilName, DXCoilType, CapFTempCurveIndex(1), CapFFlowCurveIndex(1), &
EIRFTempCurveIndex(1), EIRFFlowCurveIndex(1), PLFFPLRCurveIndex(1), &
RatedTotalCapacity(1), RatedCOP(1), RatedAirVolFlowRate(1), &
FanPowerPerEvapAirFlowRateFromInput(1), NetCoolingCapRated(1), SEER, EER, IEER)
! Writes the net rated cooling capacity, SEER, EER and IEER values to the EIO file and standard tabular output tables
CALL ReportDXCoilRating(DXCoilType, DXCoilName, DXCoilType_Num, NetCoolingCapRated(1), &
SEER * ConvFromSIToIP,EER,EER * ConvFromSIToIP,IEER * ConvFromSIToIP, &
NetHeatingCapRatedHighTemp, NetHeatingCapRatedLowTemp, HSPF * ConvFromSIToIP, RegionNum)
CASE (CoilDX_HeatingEmpirical) ! Coil:Heating:DX:SingleSpeed
CALL CheckCurveLimitsForStandardRatings(DXCoilName, DXCoilType, DXCoilType_Num, CapFTempCurveIndex(1), &
CapFFlowCurveIndex(1),EIRFTempCurveIndex(1), EIRFFlowCurveIndex(1), &
PLFFPLRCurveIndex(1))
! Calculate the standard ratings for single speed DX heating coil
CALL SingleSpeedDXHeatingCoilStandardRatings(RatedTotalCapacity(1), RatedCOP(1), CapFFlowCurveIndex(1), &
CapFTempCurveIndex(1), EIRFFlowCurveIndex(1), EIRFTempCurveIndex(1), &
RatedAirVolFlowRate(1), FanPowerPerEvapAirFlowRateFromInput(1), &
RegionNum, MinOATCompressor, OATempCompressorOn, OATempCompressorOnOffBlank, &
DefrostControl, NetHeatingCapRatedHighTemp, NetHeatingCapRatedLowTemp, HSPF)
! Writes the HSPF value to the EIO file and standard tabular output tables
CALL ReportDXCoilRating(DXCoilType, DXCoilName, DXCoilType_Num, NetCoolingCapRated(1), &
SEER * ConvFromSIToIP,EER,EER * ConvFromSIToIP,IEER * ConvFromSIToIP, &
NetHeatingCapRatedHighTemp, NetHeatingCapRatedLowTemp, HSPF * ConvFromSIToIP, RegionNum)
CASE (CoilDX_MultiSpeedCooling) ! Coil:Cooling:DX:MultiSpeed,
DO spnum = 1, ns
CALL CheckCurveLimitsForStandardRatings(DXCoilName, DXCoilType, DXCoilType_Num, &
CapFTempCurveIndex(spnum), CapFFlowCurveIndex(spnum), &
EIRFTempCurveIndex(spnum), EIRFFlowCurveIndex(spnum), &
PLFFPLRCurveIndex(spnum))
END DO
! Calculate the standard ratings for multispeed DX cooling coil
CALL MultiSpeedDXCoolingCoilStandardRatings(DXCoilName, DXCoilType, CapFTempCurveIndex, CapFFlowCurveIndex, &
EIRFTempCurveIndex, EIRFFlowCurveIndex, PLFFPLRCurveIndex, &
RatedTotalCapacity, RatedCOP, RatedAirVolFlowRate, &
FanPowerPerEvapAirFlowRateFromInput, ns, &
NetCoolingCapRated(ns), SEER)
! Writes the SEER value to the EIO file and standard tabular output tables
CALL ReportDXCoilRating(DXCoilType, DXCoilName, DXCoilType_Num, NetCoolingCapRated(ns), &
SEER * ConvFromSIToIP, 0.0d0, 0.0d0, 0.0d0, 0.0d0, 0.0d0, 0.0d0, 0)
CASE (CoilDX_MultiSpeedHeating) ! Coil:Heating:DX:MultiSpeed
DO spnum = 1, ns
CALL CheckCurveLimitsForStandardRatings(DXCoilName, DXCoilType, DXCoilType_Num, &
CapFTempCurveIndex(spnum), CapFFlowCurveIndex(spnum), &
EIRFTempCurveIndex(spnum), EIRFFlowCurveIndex(spnum), &
PLFFPLRCurveIndex(spnum))
END DO
! Calculate Net heatig capacity and HSPF of multispeed DX heating coils
CALL MultiSpeedDXHeatingCoilStandardRatings(DXCoilName, DXCoilType, CapFTempCurveIndex, CapFFlowCurveIndex, &
EIRFTempCurveIndex, EIRFFlowCurveIndex, PLFFPLRCurveIndex, &
RatedTotalCapacity, RatedCOP, RatedAirVolFlowRate, &
FanPowerPerEvapAirFlowRateFromInput, ns, RegionNum, MinOATCompressor, &
OATempCompressorOn, OATempCompressorOnOffBlank, DefrostControl, &
NetHeatingCapRatedHighTemp, NetHeatingCapRatedLowTemp, HSPF)
! Writes the HSPF value to the EIO file and standard tabular output tables
CALL ReportDXCoilRating(DXCoilType, DXCoilName, DXCoilType_Num, NetCoolingCapRated(ns), &
SEER * ConvFromSIToIP,EER,EER * ConvFromSIToIP,IEER * ConvFromSIToIP, &
NetHeatingCapRatedHighTemp, NetHeatingCapRatedLowTemp, HSPF * ConvFromSIToIP, RegionNum)
CASE DEFAULT
!... other DX Coil types will follow here
END SELECT
RETURN
END SUBROUTINE CalcDXCoilStandardRating