SUBROUTINE CheckCurveLimitsForStandardRatings(DXCoilName, DXCoilType, DXCoilTypeNum, CapFTempCurveIndex, CapFFlowCurveIndex, &
EIRFTempCurveIndex, EIRFFlowCurveIndex, PLFFPLRCurveIndex)
! SUBROUTINE INFORMATION:
! AUTHOR D. Shirey/B. Nigusse, FSEC
! DATE WRITTEN May 2010
! MODIFIED Chandan Sharma, March 2012
! RE-ENGINEERED na
! PURPOSE OF THIS SUBROUTINE:
! Checks the limits of the various curves used in DXCoil and returns .FALSE. if the limits do not include
! the standard test condition(s).
! METHODOLOGY EMPLOYED:
! na
! REFERENCES:
! na
! USE STATEMENTS:
USE CurveManager, ONLY: CurveValue, GetCurveMinMaxValues, GetCurveIndex, GetCurveType, GetCurveName
USE DataGlobals, ONLY: DisplayExtraWarnings
USE DataHVACGlobals, ONLY: CoilDX_CoolingSingleSpeed, CoilDX_HeatingEmpirical, CoilDX_MultiSpeedCooling, &
CoilDX_MultiSpeedHeating
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) :: DXCoilTypeNum ! Integer 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
! SUBROUTINE PARAMETER DEFINITIONS:
CHARACTER(len=*), PARAMETER :: RoutineName='CheckCurveLimitsForStandardRatings: ' ! Include trailing blank space
! INTERFACE BLOCK SPECIFICATIONS
! na
! DERIVED TYPE DEFINITIONS
! na
! SUBROUTINE LOCAL VARIABLE DECLARATIONS:
! Minimum and Maximum independent variable limits from Total Cooling Capacity Function of Temperature Curve
REAL(r64) :: CapacityWBTempMin= 0.0d0 ! Capacity modifier Min value (wet bulb temperature), from the Curve:Biquadratic object
REAL(r64) :: CapacityWBTempMax= 0.0d0 ! Capacity modifier Max value (wet bulb temperature), from the Curve:Biquadratic object
REAL(r64) :: CapacityDBTempMin= 0.0d0 ! Capacity modifier Min value (dry bulb temperature), from the Curve:Biquadratic object
REAL(r64) :: CapacityDBTempMax= 0.0d0 ! Capacity modifier Max value (dry bulb temperature), from the Curve:Biquadratic object
! Minimum and Maximum independent variable limits from Energy Input Ratio (EIR) Function of Temperature Curve
REAL(r64) :: EIRWBTempMin= 0.0d0 ! EIR modifier Min value (wet bulb temperature), from the Curve:Biquadratic object
REAL(r64) :: EIRWBTempMax= 0.0d0 ! EIR modifier Max value (wet bulb temperature), from the Curve:Biquadratic object
REAL(r64) :: EIRDBTempMin= 0.0d0 ! EIR modifier Min value (dry bulb temperature), from the Curve:Biquadratic object
REAL(r64) :: EIRDBTempMax= 0.0d0 ! EIR modifier Max value (dry bulb temperature), from the Curve:Biquadratic object
! Minimum and Maximum independent variable limits from Part Load Fraction Correlation Curve
REAL(r64) :: PLFFPLRMin = 0.0d0 ! Maximum value for Part Load Ratio, from the corresponding curve object
REAL(r64) :: PLFFPLRMax = 0.0d0 ! Minimum value for Part Load Ratio, from the corresponding curve object
! Minimum and Maximum independent variable limits from Total Cooling Capacity Function of Flow Fraction Curve
REAL(r64) :: CapacityFlowRatioMin = 0.0d0 ! Minimum value for flow fraction, from the corresponding curve object
REAL(r64) :: CapacityFlowRatioMax = 0.0d0 ! Maximum value for flow fraction, from the corresponding curve object
! Minimum and Maximum independent variable limits from Energy Input Ratio Function of Flow Fraction Curve
REAL(r64) :: EIRFlowRatioMin = 0.0d0 ! Minimum value for flow fraction, from the corresponding curve object
REAL(r64) :: EIRFlowRatioMax = 0.0d0 ! Maximum value for flow fraction, from the corresponding curve object
! Minimum and Maximum independent variable limits from Total Cooling Capacity Function of Temperature Curve
REAL(r64) :: HeatingCapODBTempMin= 0.0d0 ! Capacity modifier Min value (outdoor dry bulb temperature)
REAL(r64) :: HeatingCapODBTempMax= 0.0d0 ! Capacity modifier Max value (outdoor dry bulb temperature)
REAL(r64) :: HeatingCapIDBTempMin= 0.0d0 ! Capacity modifier Min value (indoor dry bulb temperature)
REAL(r64) :: HeatingCapIDBTempMax= 0.0d0 ! Capacity modifier Max value (indoor dry bulb temperature)
! Minimum and Maximum independent variable limits from Energy Input Ratio (EIR) Function of Temperature Curve
REAL(r64) :: HeatingEIRODBTempMin= 0.0d0 ! EIR modifier Min value (outdoor dry bulb temperature)
REAL(r64) :: HeatingEIRODBTempMax= 0.0d0 ! EIR modifier Max value (outdoor dry bulb temperature)
REAL(r64) :: HeatingEIRIDBTempMin= 0.0d0 ! EIR modifier Min value (indoor dry bulb temperature)
REAL(r64) :: HeatingEIRIDBTempMax= 0.0d0 ! EIR modifier Max value (indoor dry bulb temperature)
LOGICAL :: CapCurveOATLimitsExceeded = .FALSE. ! Logical for capacity curve OD temp. limits being exceeded (low and High)
LOGICAL :: CapCurveHighOATLimitsExceeded = .FALSE. ! Logical for capacity curve temperature limits being exceeded (high temp)
LOGICAL :: CapCurveFlowLimitsExceeded = .FALSE. ! Logical for capacity curve flow fraction limits being exceeded
LOGICAL :: EIRCurveHighOATLimitsExceeded = .FALSE. ! Logical for EIR curve temperature limits being exceeded (high temp)
LOGICAL :: EIRCurveFlowLimitsExceeded = .FALSE. ! Logical for EIR curve flow fraction limits being exceeded
LOGICAL :: CapCurveMidOATLimitsExceeded = .FALSE. ! Logical for capacity curve temperature limits being exceeded (mid temp)
LOGICAL :: EIRCurveMidOATLimitsExceeded = .FALSE. ! Logical for EIR curve temperature limits being exceeded (mid temp)
LOGICAL :: CapCurveLowOATLimitsExceeded = .FALSE. ! Logical for capacity curve temperature limits being exceeded (low temp)
LOGICAL :: EIRCurveLowOATLimitsExceeded = .FALSE. ! Logical for EIR curve temperature limits being exceeded (Low temp)
LOGICAL :: PLFfPLRforSEERLimitsExceeded = .FALSE. ! Logical for PLF function of PLR limits being exceeded
LOGICAL :: CapCurveIEERLimitsExceeded = .FALSE. ! Logical for capacity curve temperature limits being exceeded (IEER calcs)
LOGICAL :: EIRCurveIEERLimitsExceeded = .FALSE. ! Logical for EIR temperature limits being exceeded (IEER calcs)
LOGICAL :: HeatingCapCurveHSPFLimitsExceeded = .FALSE. ! Logical for capacity curve temperature limits being exceeded
! (HSPF calcs)
LOGICAL :: HeatingEIRCurveHSPFLimitsExceeded = .FALSE. ! Logical for EIR curve temperature limits being exceeded
! (HSPF calcs)
SELECT CASE(DXCoilTypeNum)
CASE (CoilDX_CoolingSingleSpeed)
CALL GetCurveMinMaxValues(CapFTempCurveIndex,CapacityWBTempMin,CapacityWBTempMax,CapacityDBTempMin,CapacityDBTempMax)
CALL GetCurveMinMaxValues(EIRFTempCurveIndex,EIRWBTempMin,EIRWBTempMax,EIRDBTempMin,EIRDBTempMax)
CALL GetCurveMinMaxValues(CapFFlowCurveIndex,CapacityFlowRatioMin,CapacityFlowRatioMax)
CALL GetCurveMinMaxValues(EIRFFlowCurveIndex,EIRFlowRatioMin,EIRFlowRatioMax)
CALL GetCurveMinMaxValues(PLFFPLRCurveIndex,PLFFPLRMin,PLFFPLRMax)
! Checking the limits of capacity modifying curve for temperatures
IF ( CapacityDBTempMax < OutdoorCoilInletAirDrybulbTempRated .OR. &
CapacityDBTempMin > OutdoorCoilInletAirDrybulbTempRated .OR. &
CapacityWBTempMax < CoolingCoilInletAirWetbulbTempRated .OR. &
CapacityWBTempMin > CoolingCoilInletAirWetbulbTempRated ) THEN
CapCurveHighOATLimitsExceeded = .TRUE.
END IF
! Checking the limits of capacity modifying curve for flow fraction
IF ( CapacityFlowRatioMax < AirMassFlowRatioRated .OR. CapacityFlowRatioMin > AirMassFlowRatioRated ) THEN
CapCurveFlowLimitsExceeded = .TRUE.
END IF
! Checking the limits of EIR modifying curve for temperatures
IF ( EIRDBTempMax < OutdoorCoilInletAirDrybulbTempRated .OR. &
EIRDBTempMin > OutdoorCoilInletAirDrybulbTempRated .OR. &
EIRWBTempMax < CoolingCoilInletAirWetbulbTempRated .OR. &
EIRWBTempMin > CoolingCoilInletAirWetbulbTempRated ) THEN
EIRCurveHighOATLimitsExceeded = .TRUE.
END IF
! Checking the limits of EIR modifying curve for flow fraction
IF ( EIRFlowRatioMax < AirMassFlowRatioRated .OR. EIRFlowRatioMin > AirMassFlowRatioRated ) THEN
EIRCurveFlowLimitsExceeded = .TRUE.
END IF
! Checking the limits of capacity modifying curve for temperatures (SEER calculation)
IF ( CapacityDBTempMax < OutdoorCoilInletAirDrybulbTempTestB2 .OR. &
CapacityDBTempMin > OutdoorCoilInletAirDrybulbTempTestB2 .OR. &
CapacityWBTempMax < CoolingCoilInletAirWetbulbTempRated .OR. &
CapacityWBTempMin > CoolingCoilInletAirWetbulbTempRated ) THEN
CapCurveMidOATLimitsExceeded = .TRUE.
END IF
! Checking the limits of EIR modifying curve for temperatures (SEER calculation)
IF ( EIRDBTempMax < OutdoorCoilInletAirDrybulbTempTestB2 .OR. &
EIRDBTempMin > OutdoorCoilInletAirDrybulbTempTestB2 .OR. &
EIRWBTempMax < CoolingCoilInletAirWetbulbTempRated .OR. &
EIRWBTempMin > CoolingCoilInletAirWetbulbTempRated ) THEN
EIRCurveMidOATLimitsExceeded = .TRUE.
END IF
! Checking the limits of Part Load Fraction for PLR (SEER calculation)
IF (PLFFPLRMax < PLRforSEER .OR. PLFFPLRMin > PLRforSEER )THEN
PLFfPLRforSEERLimitsExceeded = .TRUE.
END IF
! Checking the limits of capacity modifying curve for temperatures (IEER high and low test conditions)
IF ( CapacityDBTempMax < OutdoorCoilInletAirDrybulbTempRated .OR. &
CapacityDBTempMin > OADBTempLowReducedCapacityTest .OR. &
CapacityWBTempMax < CoolingCoilInletAirWetbulbTempRated .OR. &
CapacityWBTempMin > CoolingCoilInletAirWetbulbTempRated ) THEN
CapCurveIEERLimitsExceeded = .TRUE.
END IF
! Checking the limits of EIR modifying curve for temperatures (IEER high and low test conditions)
IF ( EIRDBTempMax < OutdoorCoilInletAirDrybulbTempRated .OR. &
EIRDBTempMin > OADBTempLowReducedCapacityTest .OR. &
EIRWBTempMax < CoolingCoilInletAirWetbulbTempRated .OR. &
EIRWBTempMin > CoolingCoilInletAirWetbulbTempRated ) THEN
EIRCurveIEERLimitsExceeded = .TRUE.
END IF
IF ( CapCurveHighOATLimitsExceeded .OR. CapCurveFlowLimitsExceeded .OR. EIRCurveHighOATLimitsExceeded .OR. &
EIRCurveFlowLimitsExceeded .OR. CapCurveMidOATLimitsExceeded .OR. EIRCurveMidOATLimitsExceeded .OR. &
PLFfPLRforSEERLimitsExceeded .OR. CapCurveIEERLimitsExceeded .OR. EIRCurveIEERLimitsExceeded) THEN
CALL ShowWarningError('The Standard Ratings is calculated for '//TRIM(DXCoilType)//' = '// &
TRIM(DXCoilName)//' but not at the AHRI test condition due to curve out of bound.')
CALL ShowContinueError(' Review the Standard Ratings calculations in the Engineering Reference for this coil type.'// &
' Also, use Output:Diagnostics, DisplayExtraWarnings for further guidance.')
IF (DisplayExtraWarnings) THEN
CALL ShowContinueError(RoutineName//'The max and/or min limits specified in the corresponding curve objects')
CALL ShowContinueError(' do not include the AHRI test conditions required to calculate one or more of'// &
' the Standard Rating values.')
END IF
! For Standard Rating Cooling Capacity:
IF (CapCurveHighOATLimitsExceeded .OR. CapCurveFlowLimitsExceeded) THEN
IF (DisplayExtraWarnings) THEN
CALL ShowContinueError(TRIM(DXCoilType)//'='//TRIM(DXCoilName)//': '// &
' Standard Rating Cooling Capacity calculated is not at the AHRI test condition.')
IF (CapCurveHighOATLimitsExceeded) THEN
CALL ShowContinueError(' Check limits in Total Cooling Capacity Function of Temperature Curve, ' &
//'Curve Type = '//TRIM(GetCurveType(CapFTempCurveIndex))//', Curve Name = ' &
//TRIM(GetCurveName(CapFTempCurveIndex)))
END IF
IF (CapCurveFlowLimitsExceeded) THEN
CALL ShowContinueError(' Check limits in Total Cooling Capacity Function of Flow Fraction Curve, ' &
//'Curve Type = '//TRIM(GetCurveType(CapFTempCurveIndex))//', Curve Name = ' &
//TRIM(GetCurveName(CapFFlowCurveIndex)))
END IF
END IF
END IF
! For EER:
IF (CapCurveHighOATLimitsExceeded .OR. CapCurveFlowLimitsExceeded .OR. EIRCurveHighOATLimitsExceeded .OR. &
EIRCurveFlowLimitsExceeded) THEN
IF (DisplayExtraWarnings) THEN
CALL ShowContinueError(TRIM(DXCoilType)//'='//TRIM(DXCoilName)//': '// &
' Energy Efficiency Ratio (EER) calculated is not at the AHRI test condition.')
IF (CapCurveHighOATLimitsExceeded) THEN
CALL ShowContinueError(' Check limits in Total Cooling Capacity Function of Temperature Curve, ' &
//'Curve Type = '//TRIM(GetCurveType(CapFTempCurveIndex))//', Curve Name = ' &
//TRIM(GetCurveName(CapFTempCurveIndex)))
ENDIF
IF (CapCurveFlowLimitsExceeded) THEN
CALL ShowContinueError(' Check limits in Total Cooling Capacity Function of Flow Fraction Curve, ' &
//'Curve Type = '//TRIM(GetCurveType(CapFTempCurveIndex))//', Curve Name = ' &
//TRIM(GetCurveName(CapFFlowCurveIndex)))
END IF
IF (EIRCurveHighOATLimitsExceeded) THEN
CALL ShowContinueError(' Check limits in Energy Input Ratio Function of Temperature Curve, ' &
//'Curve Type = '//TRIM(GetCurveType(EIRFTempCurveIndex)) &
//', Curve Name = '//TRIM(GetCurveName(EIRFTempCurveIndex)))
END IF
IF (EIRCurveFlowLimitsExceeded) THEN
CALL ShowContinueError(' Check limits in Energy Input Ratio Function of Flow Fraction Curve, ' &
//'Curve Type = '//TRIM(GetCurveType(EIRFFlowCurveIndex))//', Curve Name = ' &
//TRIM(GetCurveName(EIRFFlowCurveIndex)))
END IF
END IF
END IF
! For SEER:
IF ( CapCurveMidOATLimitsExceeded .OR. EIRCurveMidOATLimitsExceeded .OR. CapCurveFlowLimitsExceeded &
.OR. EIRCurveFlowLimitsExceeded .OR. PLFfPLRforSEERLimitsExceeded ) THEN
IF (DisplayExtraWarnings) THEN
CALL ShowContinueError(TRIM(DXCoilType)//'='//TRIM(DXCoilName)//': '// &
' Seasonal Energy Efficiency Ratio (SEER) calculated is not at the AHRI test condition.')
IF (CapCurveMidOATLimitsExceeded) THEN
CALL ShowContinueError(' Check limits in Total Cooling Capacity Function of Temperature Curve, ' &
//'Curve Type = '//TRIM(GetCurveType(CapFTempCurveIndex))//', Curve Name = ' &
//TRIM(GetCurveName(CapFTempCurveIndex)))
END IF
IF (CapCurveFlowLimitsExceeded) THEN
CALL ShowContinueError(' Check limits in Total Cooling Capacity Function of Flow Fraction Curve, ' &
//'Curve Type = '//TRIM(GetCurveType(CapFTempCurveIndex))//', Curve Name = ' &
//TRIM(GetCurveName(CapFFlowCurveIndex)))
END IF
IF (EIRCurveMidOATLimitsExceeded) THEN
CALL ShowContinueError(' Check limits in Energy Input Ratio Function of Temperature Curve, ' &
//'Curve Type = '//TRIM(GetCurveType(EIRFTempCurveIndex)) &
//', Curve Name = '//TRIM(GetCurveName(EIRFTempCurveIndex)))
END IF
IF (EIRCurveFlowLimitsExceeded) THEN
CALL ShowContinueError(' Check limits in Energy Input Ratio Function of Flow Fraction Curve, ' &
//'Curve Type = '//TRIM(GetCurveType(EIRFFlowCurveIndex)) &
//', Curve Name = '//TRIM(GetCurveName(EIRFFlowCurveIndex)))
END IF
IF (PLFfPLRforSEERLimitsExceeded) THEN
CALL ShowContinueError(' Check limits in Part Load Fraction Correlation Curve, ' &
//'Curve Type = '//TRIM(GetCurveType(PLFFPLRCurveIndex)) &
//', Curve Name = '//TRIM(GetCurveName(PLFFPLRCurveIndex)))
END IF
END IF
END IF
! For IEER:
IF ( CapCurveIEERLimitsExceeded .OR. CapCurveFlowLimitsExceeded .OR. EIRCurveIEERLimitsExceeded .OR. &
EIRCurveFlowLimitsExceeded) THEN
IF (DisplayExtraWarnings) THEN
CALL ShowContinueError(TRIM(DXCoilType)//'='//TRIM(DXCoilName)//': '//&
' Integrated Energy Efficiency Ratio (IEER) calculated is not at the AHRI test condition.')
IF (CapCurveIEERLimitsExceeded) THEN
CALL ShowContinueError(' Check limits in Total Cooling Capacity Function of Temperature Curve ' &
//', Curve Type = '//TRIM(GetCurveType(CapFTempCurveIndex)) &
//', Curve Name = '//TRIM(GetCurveName(CapFTempCurveIndex)))
END IF
IF (CapCurveFlowLimitsExceeded) THEN
CALL ShowContinueError(' Check limits in Total Cooling Capacity Function of Flow Fraction Curve, ' &
//'Curve Type = '//TRIM(GetCurveType(CapFFlowCurveIndex))//', Curve Name = ' &
//TRIM(GetCurveName(CapFFlowCurveIndex)))
END IF
IF (EIRCurveIEERLimitsExceeded) THEN
CALL ShowContinueError(' Check limits in EIR Function of Temperature Curve, ' &
//'Curve Type = '//TRIM(GetCurveType(EIRFTempCurveIndex))//', Curve Name = ' &
//TRIM(GetCurveName(EIRFTempCurveIndex)))
END IF
IF (EIRCurveFlowLimitsExceeded) THEN
CALL ShowContinueError(' Check limits in Energy Input Ratio Function of Flow Fraction Curve, ' &
//'Curve Type = '//TRIM(GetCurveType(EIRFFlowCurveIndex))//', Curve Name = ' &
//TRIM(GetCurveName(EIRFFlowCurveIndex)))
END IF
END IF
END IF
END IF ! End of curve error messages
CASE (CoilDX_HeatingEmpirical)
SELECT CASE(GetCurveType(CapFTempCurveIndex))
CASE('QUADRATIC', 'CUBIC')
CALL GetCurveMinMaxValues(CapFTempCurveIndex,HeatingCapODBTempMin,HeatingCapODBTempMax)
! Checking the limits of capacity modifying curve for temperatures (IEER high and low test conditions)
IF ( HeatingCapODBTempMax < HeatingOutdoorCoilInletAirDBTempRated .OR. &
HeatingCapODBTempMin > HeatingOutdoorCoilInletAirDBTempH3Test) THEN
HeatingCapCurveHSPFLimitsExceeded = .TRUE.
END IF
CASE('BIQUADRATIC')
CALL GetCurveMinMaxValues(CapFTempCurveIndex,HeatingCapIDBTempMin,HeatingCapIDBTempMax, &
HeatingCapODBTempMin,HeatingCapODBTempMax)
! Checking the limits of capacity modifying curve for temperatures (IEER high and low test conditions)
IF ( HeatingCapODBTempMax < HeatingOutdoorCoilInletAirDBTempRated .OR. &
HeatingCapODBTempMin > HeatingOutdoorCoilInletAirDBTempH3Test .OR. &
HeatingCapIDBTempMax < HeatingIndoorCoilInletAirDBTempRated .OR. &
HeatingCapIDBTempMin > HeatingIndoorCoilInletAirDBTempRated ) THEN
HeatingCapCurveHSPFLimitsExceeded = .TRUE.
END IF
END SELECT
SELECT CASE(GetCurveType(EIRFTempCurveIndex))
CASE('QUADRATIC', 'CUBIC')
CALL GetCurveMinMaxValues(EIRFTempCurveIndex,HeatingEIRODBTempMin,HeatingEIRODBTempMax)
! Checking the limits of EIR modifying curve for temperatures (HSPF high and low test conditions)
IF ( HeatingEIRODBTempMax < HeatingOutdoorCoilInletAirDBTempRated .OR. &
HeatingEIRODBTempMin > HeatingOutdoorCoilInletAirDBTempH3Test) THEN
HeatingEIRCurveHSPFLimitsExceeded = .TRUE.
END IF
CASE('BIQUADRATIC')
CALL GetCurveMinMaxValues(EIRFTempCurveIndex,HeatingEIRIDBTempMin,HeatingEIRIDBTempMax, &
HeatingEIRODBTempMin,HeatingEIRODBTempMax)
! Checking the limits of EIR modifying curve for temperatures (HSPF high and low test conditions)
IF ( HeatingEIRODBTempMax < HeatingOutdoorCoilInletAirDBTempRated .OR. &
HeatingEIRODBTempMin > HeatingOutdoorCoilInletAirDBTempH3Test .OR. &
HeatingEIRIDBTempMax < HeatingIndoorCoilInletAirDBTempRated .OR. &
HeatingEIRIDBTempMin > HeatingIndoorCoilInletAirDBTempRated ) THEN
HeatingEIRCurveHSPFLimitsExceeded = .TRUE.
END IF
END SELECT
IF ( HeatingCapCurveHSPFLimitsExceeded .OR. HeatingEIRCurveHSPFLimitsExceeded) THEN
CALL ShowWarningError('The Standard Ratings is calculated for '//TRIM(DXCoilType)//' = '// &
TRIM(DXCoilName)//' but not at the AHRI test condition due to curve out of bound.')
CALL ShowContinueError(' Review the Standard Ratings calculations in the Engineering Reference for this coil type.'// &
' Also, use Output:Diagnostics, DisplayExtraWarnings for further guidance.')
IF (DisplayExtraWarnings) THEN
CALL ShowContinueError(RoutineName//'The max and/or min limits specified in the corresponding curve objects')
CALL ShowContinueError(' do not include the AHRI test conditions required to calculate one or more of'// &
' the Standard Rating values.')
END IF
IF (DisplayExtraWarnings) THEN
CALL ShowWarningError(TRIM(DXCoilType)//'='//TRIM(DXCoilName)//': '// &
' Heating Seasonal Performance Factor calculated is not at the AHRI test condition.')
CALL ShowContinueError(' Review the Standard Ratings calculations in the Engineering Reference for this coil type.')
IF (HeatingCapCurveHSPFLimitsExceeded) THEN
CALL ShowContinueError(' Check limits in Total Heating Capacity Function of Temperature Curve, ' &
//'Curve Type = '//TRIM(GetCurveType(CapFTempCurveIndex))//', Curve Name = ' &
//TRIM(GetCurveName(CapFTempCurveIndex)))
END IF
IF (HeatingEIRCurveHSPFLimitsExceeded) THEN
CALL ShowContinueError(' Check limits in EIR Function of Temperature Curve, ' &
//'Curve Type = '//TRIM(GetCurveType(EIRFTempCurveIndex))//', Curve Name = ' &
//TRIM(GetCurveName(EIRFTempCurveIndex)))
END IF
ENDIF
ENDIF
! MultiSpeed DX Coil Net Cooling Capacity and SEER:
CASE (CoilDX_MultiSpeedCooling)
CALL GetCurveMinMaxValues(CapFTempCurveIndex,CapacityWBTempMin,CapacityWBTempMax,CapacityDBTempMin,CapacityDBTempMax)
CALL GetCurveMinMaxValues(EIRFTempCurveIndex,EIRWBTempMin,EIRWBTempMax,EIRDBTempMin,EIRDBTempMax)
CALL GetCurveMinMaxValues(CapFFlowCurveIndex,CapacityFlowRatioMin,CapacityFlowRatioMax)
CALL GetCurveMinMaxValues(EIRFFlowCurveIndex,EIRFlowRatioMin,EIRFlowRatioMax)
!CALL GetCurveMinMaxValues(PLFFPLRCurveIndex,PLFFPLRMin,PLFFPLRMax)
! Checking the limits of capacity modifying curve for temperatures
IF ( CapacityDBTempMax < OutdoorCoilInletAirDrybulbTempRated .OR. &
CapacityDBTempMin > OutdoorCoilInletAirDrybulbTempRated .OR. &
CapacityWBTempMax < CoolingCoilInletAirWetbulbTempRated .OR. &
CapacityWBTempMin > CoolingCoilInletAirWetbulbTempRated ) THEN
CapCurveHighOATLimitsExceeded = .TRUE.
END IF
! Checking the limits of capacity modifying curve for flow fraction
IF ( CapacityFlowRatioMax < AirMassFlowRatioRated .OR. CapacityFlowRatioMin > AirMassFlowRatioRated ) THEN
CapCurveFlowLimitsExceeded = .TRUE.
END IF
! Checking the limits of EIR modifying curve for temperatures
IF ( EIRDBTempMax < OutdoorCoilInletAirDrybulbTempRated .OR. &
EIRDBTempMin > OutdoorCoilInletAirDrybulbTempRated .OR. &
EIRWBTempMax < CoolingCoilInletAirWetbulbTempRated .OR. &
EIRWBTempMin > CoolingCoilInletAirWetbulbTempRated ) THEN
EIRCurveHighOATLimitsExceeded = .TRUE.
END IF
! Checking the limits of EIR modifying curve for flow fraction
IF ( EIRFlowRatioMax < AirMassFlowRatioRated .OR. EIRFlowRatioMin > AirMassFlowRatioRated ) THEN
EIRCurveFlowLimitsExceeded = .TRUE.
END IF
! Checking the limits of capacity modifying curve for temperatures (SEER calculation)
IF ( CapacityDBTempMax < OutdoorCoilInletAirDrybulbTempTestF1 .OR. &
CapacityDBTempMin > OutdoorCoilInletAirDrybulbTempTestF1 .OR. &
CapacityWBTempMax < CoolingCoilInletAirWetbulbTempRated .OR. &
CapacityWBTempMin > CoolingCoilInletAirWetbulbTempRated ) THEN
CapCurveLowOATLimitsExceeded = .TRUE.
END IF
! Checking the limits of EIR modifying curve for temperatures (SEER calculation)
IF ( EIRDBTempMax < OutdoorCoilInletAirDrybulbTempTestF1 .OR. &
EIRDBTempMin > OutdoorCoilInletAirDrybulbTempTestF1 .OR. &
EIRWBTempMax < CoolingCoilInletAirWetbulbTempRated .OR. &
EIRWBTempMin > CoolingCoilInletAirWetbulbTempRated ) THEN
EIRCurveLowOATLimitsExceeded = .TRUE.
END IF
IF ( CapCurveHighOATLimitsExceeded .OR. CapCurveFlowLimitsExceeded .OR. EIRCurveHighOATLimitsExceeded .OR. &
EIRCurveFlowLimitsExceeded .OR. CapCurveLowOATLimitsExceeded .OR. EIRCurveLowOATLimitsExceeded ) THEN
CALL ShowWarningError('The Standard Ratings is calculated for '//TRIM(DXCoilType)//' = '// &
TRIM(DXCoilName)//' but not at the AHRI test condition due to curve out of bound.')
CALL ShowContinueError(' Review the Standard Ratings calculations in the Engineering Reference for this coil type.'// &
' Also, use Output:Diagnostics, DisplayExtraWarnings for further guidance.')
IF (DisplayExtraWarnings) THEN
CALL ShowContinueError(RoutineName//'The max and/or min limits specified in the corresponding curve objects')
CALL ShowContinueError(' do not include the AHRI test conditions required to calculate one or more of'// &
' the Standard Rating values.')
END IF
! For Standard Rating Cooling Capacity:
IF (CapCurveHighOATLimitsExceeded .OR. CapCurveFlowLimitsExceeded) THEN
IF (DisplayExtraWarnings) THEN
CALL ShowContinueError(TRIM(DXCoilType)//'='//TRIM(DXCoilName)//': '// &
' The Standard Rating Cooling Capacity calculated is not at the AHRI test condition.')
IF (CapCurveHighOATLimitsExceeded) THEN
CALL ShowContinueError(' Check limits in Total Cooling Capacity Function of Temperature Curve, ' &
//'Curve Type = '//TRIM(GetCurveType(CapFTempCurveIndex))//', Curve Name = ' &
//TRIM(GetCurveName(CapFTempCurveIndex)))
END IF
IF (CapCurveFlowLimitsExceeded) THEN
CALL ShowContinueError(' Check limits in Total Cooling Capacity Function of Flow Fraction Curve, ' &
//'Curve Type = '//TRIM(GetCurveType(CapFTempCurveIndex))//', Curve Name = ' &
//TRIM(GetCurveName(CapFFlowCurveIndex)))
END IF
END IF
END IF
! For MultiSpeed DX Coil SEER:
IF ( CapCurveLowOATLimitsExceeded .OR. EIRCurveLowOATLimitsExceeded .OR. CapCurveFlowLimitsExceeded &
.OR. EIRCurveFlowLimitsExceeded ) THEN
IF (DisplayExtraWarnings) THEN
CALL ShowContinueError(TRIM(DXCoilType)//'='//TRIM(DXCoilName)//': '// &
' The Seasonal Energy Efficiency Ratio (SEER) calculated is not at the AHRI test condition.')
IF (CapCurveLowOATLimitsExceeded) THEN
CALL ShowContinueError(' Check limits in Total Cooling Capacity Function of Temperature Curve, ' &
//'Curve Type = '//TRIM(GetCurveType(CapFTempCurveIndex))//', Curve Name = ' &
//TRIM(GetCurveName(CapFTempCurveIndex)))
END IF
IF (CapCurveFlowLimitsExceeded) THEN
CALL ShowContinueError(' Check limits in Total Cooling Capacity Function of Flow Fraction Curve, ' &
//'Curve Type = '//TRIM(GetCurveType(CapFTempCurveIndex))//', Curve Name = ' &
//TRIM(GetCurveName(CapFFlowCurveIndex)))
END IF
IF (EIRCurveLowOATLimitsExceeded) THEN
CALL ShowContinueError(' Check limits in Energy Input Ratio Function of Temperature Curve, ' &
//'Curve Type = '//TRIM(GetCurveType(EIRFTempCurveIndex)) &
//', Curve Name = '//TRIM(GetCurveName(EIRFTempCurveIndex)))
END IF
IF (EIRCurveFlowLimitsExceeded) THEN
CALL ShowContinueError(' Check limits in Energy Input Ratio Function of Flow Fraction Curve, ' &
//'Curve Type = '//TRIM(GetCurveType(EIRFFlowCurveIndex)) &
//', Curve Name = '//TRIM(GetCurveName(EIRFFlowCurveIndex)))
END IF
END IF
END IF
END IF ! End of curve error messages
CASE (CoilDX_MultiSpeedHeating)
SELECT CASE(GetCurveType(CapFTempCurveIndex))
CASE('QUADRATIC', 'CUBIC')
CALL GetCurveMinMaxValues(CapFTempCurveIndex,HeatingCapODBTempMin,HeatingCapODBTempMax)
IF ( HeatingCapODBTempMax < HeatingOutdoorCoilInletAirDBTempRated .OR. &
HeatingCapODBTempMin > HeatingOutdoorCoilInletAirDBTempH3Test) THEN
CapCurveOATLimitsExceeded = .TRUE.
ENDIF
! Checking the limits of capacity modifying curve for temperatures (HSPF high and low test conditions)
IF ( HeatingCapODBTempMax < HeatingOutdoorCoilInletAirDBTempRated .OR. &
HeatingCapODBTempMin > HeatingOutdoorCoilInletAirDBTempH3Test .OR. &
HeatingCapODBTempMax < HeatingOutdoorCoilInletAirDBTempH0Test) THEN
HeatingCapCurveHSPFLimitsExceeded = .TRUE.
END IF
CASE('BIQUADRATIC')
CALL GetCurveMinMaxValues(CapFTempCurveIndex,HeatingCapIDBTempMin,HeatingCapIDBTempMax, &
HeatingCapODBTempMin,HeatingCapODBTempMax)
! Checking the limits of capacity modifying curve for temperatures (HSPF high and low test conditions)
IF ( HeatingCapODBTempMax < HeatingOutdoorCoilInletAirDBTempRated .OR. &
HeatingCapODBTempMin > HeatingOutdoorCoilInletAirDBTempH3Test .OR. &
HeatingCapIDBTempMax < HeatingIndoorCoilInletAirDBTempRated .OR. &
HeatingCapIDBTempMin > HeatingIndoorCoilInletAirDBTempRated .OR. &
HeatingCapODBTempMax < HeatingOutdoorCoilInletAirDBTempH0Test) THEN
HeatingCapCurveHSPFLimitsExceeded = .TRUE.
END IF
END SELECT
SELECT CASE(GetCurveType(EIRFTempCurveIndex))
CASE('QUADRATIC', 'CUBIC')
CALL GetCurveMinMaxValues(EIRFTempCurveIndex,HeatingEIRODBTempMin,HeatingEIRODBTempMax)
! Checking the limits of EIR modifying curve for temperatures (HSPF high and low test conditions)
IF ( HeatingEIRODBTempMax < HeatingOutdoorCoilInletAirDBTempRated .OR. &
HeatingEIRODBTempMin > HeatingOutdoorCoilInletAirDBTempH3Test .OR. &
HeatingCapODBTempMax < HeatingOutdoorCoilInletAirDBTempH0Test) THEN
HeatingEIRCurveHSPFLimitsExceeded = .TRUE.
END IF
CASE('BIQUADRATIC')
CALL GetCurveMinMaxValues(EIRFTempCurveIndex,HeatingEIRIDBTempMin,HeatingEIRIDBTempMax, &
HeatingEIRODBTempMin,HeatingEIRODBTempMax)
! Checking the limits of EIR modifying curve for temperatures (HSPF high and low test conditions)
IF ( HeatingEIRODBTempMax < HeatingOutdoorCoilInletAirDBTempRated .OR. &
HeatingEIRODBTempMin > HeatingOutdoorCoilInletAirDBTempH3Test .OR. &
HeatingEIRIDBTempMax < HeatingIndoorCoilInletAirDBTempRated .OR. &
HeatingEIRIDBTempMin > HeatingIndoorCoilInletAirDBTempRated .OR. &
HeatingCapODBTempMax < HeatingOutdoorCoilInletAirDBTempH0Test) THEN
HeatingEIRCurveHSPFLimitsExceeded = .TRUE.
END IF
END SELECT
IF ( HeatingCapCurveHSPFLimitsExceeded .OR. HeatingEIRCurveHSPFLimitsExceeded .OR. &
CapCurveOATLimitsExceeded) THEN
CALL ShowWarningError('The Standard Ratings is calculated for '//TRIM(DXCoilType)//' = '// &
TRIM(DXCoilName)//' but not at the AHRI test condition due to curve out of bound.')
CALL ShowContinueError(' Review the Standard Ratings calculations in the Engineering Reference for this coil type.'// &
' Also, use Output:Diagnostics, DisplayExtraWarnings for further guidance.')
IF (DisplayExtraWarnings) THEN
CALL ShowContinueError(RoutineName//'The max and/or min limits specified in the corresponding curve objects')
CALL ShowContinueError(' do not include the AHRI test conditions required to calculate one or'// &
' more of the Standard Rating values.')
END IF
ENDIF
IF ( CapCurveOATLimitsExceeded) THEN
IF (DisplayExtraWarnings) THEN
CALL ShowWarningError(TRIM(DXCoilType)//'='//TRIM(DXCoilName)//': '// &
' The Net Heating Capacity Calculated is not at the AHRI test condition.')
CALL ShowContinueError(' Check limits in Total Heating Capacity Function of Temperature Curve, ' &
//'Curve Type = '//TRIM(GetCurveType(CapFTempCurveIndex))//', Curve Name = ' &
//TRIM(GetCurveName(CapFTempCurveIndex)))
ENDIF
ENDIF
IF ( HeatingCapCurveHSPFLimitsExceeded .OR. HeatingEIRCurveHSPFLimitsExceeded) THEN
IF (DisplayExtraWarnings) THEN
CALL ShowWarningError(TRIM(DXCoilType)//'='//TRIM(DXCoilName)//': '// &
' The Heating Seasonal Performance Factor calculated is not at the AHRI test condition.')
IF (HeatingCapCurveHSPFLimitsExceeded) THEN
CALL ShowContinueError(' Check limits in Total Heating Capacity Function of Temperature Curve, ' &
//'Curve Type = '//TRIM(GetCurveType(CapFTempCurveIndex))//', Curve Name = ' &
//TRIM(GetCurveName(CapFTempCurveIndex)))
END IF
IF (HeatingEIRCurveHSPFLimitsExceeded) THEN
CALL ShowContinueError(' Check limits in EIR Function of Temperature Curve, ' &
//'Curve Type = '//TRIM(GetCurveType(EIRFTempCurveIndex))//', Curve Name = ' &
//TRIM(GetCurveName(EIRFTempCurveIndex)))
END IF
ENDIF
ENDIF
CASE DEFAULT
END SELECT
RETURN
END SUBROUTINE CheckCurveLimitsForStandardRatings