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) | :: | CapFTempCurveIndex | |||
integer, | intent(in) | :: | CapFFlowCurveIndex | |||
integer, | intent(in) | :: | EIRFTempCurveIndex | |||
integer, | intent(in) | :: | EIRFFlowCurveIndex | |||
integer, | intent(in) | :: | PLFFPLRCurveIndex | |||
real(kind=r64), | intent(in) | :: | RatedTotalCapacity | |||
real(kind=r64), | intent(in) | :: | RatedCOP | |||
real(kind=r64), | intent(in) | :: | RatedAirVolFlowRate | |||
real(kind=r64), | intent(in) | :: | FanPowerPerEvapAirFlowRateFromInput | |||
real(kind=r64), | intent(out) | :: | NetCoolingCapRated | |||
real(kind=r64), | intent(out) | :: | SEER | |||
real(kind=r64), | intent(out) | :: | EER | |||
real(kind=r64), | intent(out) | :: | IEER |
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 SingelSpeedDXCoolingCoilStandardRatings(DXCoilName, DXCoilType, CapFTempCurveIndex, CapFFlowCurveIndex, &
EIRFTempCurveIndex, EIRFFlowCurveIndex, PLFFPLRCurveIndex, &
RatedTotalCapacity, RatedCOP, RatedAirVolFlowRate, &
FanPowerPerEvapAirFlowRateFromInput, &
NetCoolingCapRated, SEER, EER, IEER)
! SUBROUTINE INFORMATION:
! AUTHOR B. Nigusse, FSEC
! DATE WRITTEN December 2012
! MODIFIED
! RE-ENGINEERED na
! PURPOSE OF THIS SUBROUTINE:
! Calculates the standard ratings net cooling capacity and, SEER, EER and IEER values for single speed
! DX cooling coils at the AHRI standard test condition(s).
! METHODOLOGY EMPLOYED:
! na
! REFERENCES:
! na
! USE STATEMENTS:
USE CurveManager, ONLY: CurveValue
USE DataInterfaces, ONLY: ShowSevereError
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 - heating or cooling
INTEGER, INTENT(IN) :: CapFTempCurveIndex ! Index for the capacity as a function of temperature modifier curve
INTEGER, INTENT(IN) :: CapFFlowCurveIndex ! Index for the capacity as a function of flow fraction modifier curve
INTEGER, INTENT(IN) :: EIRFTempCurveIndex ! Index for the EIR as a function of temperature modifier curve
INTEGER, INTENT(IN) :: EIRFFlowCurveIndex ! Index for the EIR as a function of flow fraction modifier curve
INTEGER, INTENT(IN) :: PLFFPLRCurveIndex ! Index for the EIR vs part-load ratio curve
REAL(r64), INTENT(IN) :: RatedTotalCapacity ! Rated gross total cooling capacity
REAL(r64), INTENT(IN) :: RatedCOP ! Rated gross COP
REAL(r64), INTENT(IN) :: RatedAirVolFlowRate ! air flow rate through the coil at rated condition
REAL(r64), INTENT(IN) :: FanPowerPerEvapAirFlowRateFromInput ! Fan power per air volume flow rate through the evaporator coil
REAL(r64), INTENT(OUT) :: NetCoolingCapRated ! net cooling capacity of single speed DX cooling coil
REAL(r64), INTENT(OUT) :: SEER ! seasonale energy efficiency ratio of single speed DX cooling coil
REAL(r64), INTENT(OUT) :: EER ! energy efficiency ratio of single speed DX cooling coil
REAL(r64), INTENT(OUT) :: IEER ! Integareted energy efficiency ratio of single speed DX cooling coil
! SUBROUTINE PARAMETER DEFINITIONS:
INTEGER, PARAMETER :: NumOfReducedCap = 4 ! Number of reduced capacity test conditions (100%,75%,50%,and 25%)
! INTERFACE BLOCK SPECIFICATIONS
! na
! DERIVED TYPE DEFINITIONS
! na
! SUBROUTINE LOCAL VARIABLE DECLARATIONS:
REAL(r64) :: TotCapFlowModFac = 0.0d0 ! Total capacity modifier f(actual flow vs rated flow) for each speed [-]
REAL(r64) :: EIRFlowModFac = 0.0d0 ! EIR modifier f(actual supply air flow vs rated flow) for each speed [-]
REAL(r64) :: TotCapTempModFac = 0.0D0 ! Total capacity modifier (function of entering wetbulb, outside drybulb) [-]
REAL(r64) :: EIRTempModFac = 0.0D0 ! EIR modifier (function of entering wetbulb, outside drybulb) [-]
REAL(r64) :: TotCoolingCapAHRI = 0.0D0 ! Total Cooling Coil capacity (gross) at AHRI test conditions [W]
REAL(r64) :: NetCoolingCapAHRI = 0.0D0 ! Net Cooling Coil capacity at AHRI TestB conditions, accounting for fan heat [W]
REAL(r64) :: TotalElecPower = 0.0D0 ! Net power consumption (Cond Fan+Compressor+Indoor Fan) at AHRI test conditions [W]
REAL(r64) :: TotalElecPowerRated = 0.0D0 ! Net power consumption (Cond Fan+Compressor+Indoor Fan) at Rated test conditions [W]
REAL(r64) :: EIR = 0.0D0 ! Energy Efficiency Ratio at AHRI test conditions for SEER [-]
REAL(r64) :: PartLoadFactor = 0.0D0 ! Part load factor, accounts for thermal lag at compressor startup [-]
REAL(r64) :: EERReduced = 0.0d0 ! EER at reduced capacity test conditions (100%, 75%, 50%, and 25%)
REAL(r64) :: ElecPowerReducedCap = 0.0D0 ! Net power consumption (Cond Fan+Compressor) at reduced test condition [W]
REAL(r64) :: NetCoolingCapReduced= 0.0D0 ! Net Cooling Coil capacity at reduced conditions, accounting for supply fan heat [W]
REAL(r64) :: LoadFactor = 0.0D0 ! Fractional "on" time for last stage at the desired reduced capacity, (dimensionless)
REAL(r64) :: DegradationCoeff = 0.0D0 ! Degradation coeficient, (dimenssionless)
REAL(r64) :: FanPowerPerEvapAirFlowRate ! Fan power per air volume flow rate through the evaporator coil [W/(m3/s)]
REAL(r64) :: OutdoorUnitInletAirDrybulbTempReduced ! Outdoor unit entering air dry-bulb temperature at reduced capacity [C]
INTEGER :: RedCapNum ! Integer counter for reduced capacity
IF( FanPowerPerEvapAirFlowRateFromInput <= 0.0D0) THEN
FanPowerPerEvapAirFlowRate=DefaultFanPowerPerEvapAirFlowRate
ELSE
FanPowerPerEvapAirFlowRate=FanPowerPerEvapAirFlowRateFromInput
ENDIF
IF (RatedTotalCapacity > 0.0d0) Then
! Standard Rating Cooling (net) Capacity calculations:
TotCapFlowModFac = CurveValue(CapFFlowCurveIndex,AirMassFlowRatioRated)
TotCapTempModFac = CurveValue(CapFTempCurveIndex,CoolingCoilInletAirWetbulbTempRated, &
OutdoorUnitInletAirDrybulbTempRated)
NetCoolingCapRated = RatedTotalCapacity * TotCapTempModFac * TotCapFlowModFac &
- FanPowerPerEvapAirFlowRate * RatedAirVolFlowRate
! SEER calculations:
TotCapTempModFac = CurveValue(CapFTempCurveIndex,CoolingCoilInletAirWetbulbTempRated, &
OutdoorUnitInletAirDrybulbTemp)
TotCoolingCapAHRI = RatedTotalCapacity * TotCapTempModFac * TotCapFlowModFac
EIRTempModFac = CurveValue(EIRFTempCurveIndex,CoolingCoilInletAirWetbulbTempRated, &
OutdoorUnitInletAirDrybulbTemp)
EIRFlowModFac = CurveValue(EIRFFlowCurveIndex,AirMassFlowRatioRated)
IF ( RatedCOP > 0.0D0 ) THEN ! RatedCOP <= 0.0 is trapped in GetInput, but keep this as "safety"
EIR = EIRTempModFac * EIRFlowModFac / RatedCOP
ELSE
EIR = 0.0d0
ENDIF
! Calculate net cooling capacity
NetCoolingCapAHRI = TotCoolingCapAHRI - FanPowerPerEvapAirFlowRate * RatedAirVolFlowRate
TotalElecPower = EIR * TotCoolingCapAHRI + FanPowerPerEvapAirFlowRate * RatedAirVolFlowRate
! Calculate SEER value from the Energy Efficiency Ratio (EER) at the AHRI test conditions and the part load factor.
! First evaluate the Part Load Factor curve at PLR = 0.5 (AHRI Standard 210/240)
PartLoadFactor = CurveValue(PLFFPLRCurveIndex,PLRforSEER)
IF ( TotalElecPower > 0.0D0 ) THEN
SEER = ( NetCoolingCapAHRI / TotalElecPower ) * PartLoadFactor
ELSE
SEER = 0.0d0
ENDIF
! EER calculations:
! Calculate the net cooling capacity at the rated conditions (19.44C WB and 35.0C DB )
TotCapTempModFac = CurveValue(CapFTempCurveIndex,CoolingCoilInletAirWetbulbTempRated, &
OutdoorUnitInletAirDrybulbTempRated)
NetCoolingCapRated = RatedTotalCapacity * TotCapTempModFac * TotCapFlowModFac &
- FanPowerPerEvapAirFlowRate * RatedAirVolFlowRate
! Calculate Energy Efficiency Ratio (EER) at (19.44C WB and 35.0C DB ), ANSI/AHRI Std. 340/360
EIRTempModFac = CurveValue(EIRFTempCurveIndex,CoolingCoilInletAirWetbulbTempRated, &
OutdoorUnitInletAirDrybulbTempRated)
IF ( RatedCOP > 0.0D0 ) THEN
! RatedCOP <= 0.0 is trapped in GetInput, but keep this as "safety"
EIR = EIRTempModFac * EIRFlowModFac / RatedCOP
ELSE
EIR = 0.0d0
ENDIF
TotalElecPowerRated = EIR * (RatedTotalCapacity * TotCapTempModFac * TotCapFlowModFac) &
+ FanPowerPerEvapAirFlowRate * RatedAirVolFlowRate
IF ( TotalElecPowerRated > 0.0D0 ) THEN
EER = NetCoolingCapRated / TotalElecPowerRated
ELSE
EER = 0.0d0
ENDIF
! IEER calculations:
IEER =0.0d0
! Calculate the net cooling capacity at the rated conditions (19.44C WB and 35.0C DB )
TotCapTempModFac = CurveValue(CapFTempCurveIndex,CoolingCoilInletAirWetbulbTempRated, &
OutdoorUnitInletAirDrybulbTempRated)
NetCoolingCapRated = RatedTotalCapacity * TotCapTempModFac * TotCapFlowModFac &
- FanPowerPerEvapAirFlowRate * RatedAirVolFlowRate
DO RedCapNum = 1, NumOfReducedCap
! get the outdoor air dry bulb temperature for the reduced capacity test conditions
IF (ReducedPLR(RedCapNum) > 0.444D0 ) THEN
OutdoorUnitInletAirDrybulbTempReduced = 5.0D0 + 30.0D0 * ReducedPLR(RedCapNum)
ELSE
OutdoorUnitInletAirDrybulbTempReduced = OADBTempLowReducedCapacityTest
ENDIF
TotCapTempModFac = CurveValue(CapFTempCurveIndex,CoolingCoilInletAirWetbulbTempRated, &
OutdoorUnitInletAirDrybulbTempReduced)
NetCoolingCapReduced = RatedTotalCapacity * TotCapTempModFac * TotCapFlowModFac &
- FanPowerPerEvapAirFlowRate * RatedAirVolFlowRate
EIRTempModFac = CurveValue(EIRFTempCurveIndex,CoolingCoilInletAirWetbulbTempRated, &
OutdoorUnitInletAirDrybulbTempReduced)
IF ( RatedCOP > 0.0D0 ) THEN
EIR = EIRTempModFac * EIRFlowModFac / RatedCOP
ELSE
EIR = 0.0d0
ENDIF
IF (NetCoolingCapReduced > 0.0d0) THEN
LoadFactor = ReducedPLR(RedCapNum) * NetCoolingCapRated / NetCoolingCapReduced
ELSE
LoadFactor = 1.0d0
ENDIF
DegradationCoeff = 1.130D0 - 0.130D0 * LoadFactor
ElecPowerReducedCap = DegradationCoeff * EIR * (RatedTotalCapacity &
* TotCapTempModFac * TotCapFlowModFac)
EERReduced = ( LoadFactor * NetCoolingCapReduced ) / ( LoadFactor*ElecPowerReducedCap + &
FanPowerPerEvapAirFlowRate * RatedAirVolFlowRate)
IEER = IEER + IEERWeightingFactor(RedCapNum) * EERReduced
END DO
ELSE
CALL ShowSevereError('Standard Ratings: '//TRIM(DXCoilType)//' '//TRIM(DXCoilName)// &
' has zero rated total cooling capacity. Standard ratings cannot be calculated.')
ENDIF
RETURN
END SUBROUTINE SingelSpeedDXCoolingCoilStandardRatings