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) | :: | ChillerName | |||
integer, | intent(in) | :: | ChillerType | |||
integer, | intent(in) | :: | CondenserType | |||
integer, | intent(in) | :: | CapFTempCurveIndex | |||
integer, | intent(in) | :: | EIRFTempCurveIndex |
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 CheckCurveLimitsForIPLV(ChillerName, ChillerType, CondenserType, CapFTempCurveIndex, EIRFTempCurveIndex)
! SUBROUTINE INFORMATION:
! AUTHOR Chandan Sharma, FSEC
! DATE WRITTEN January 2012
! MODIFIED na
! RE-ENGINEERED na
! PURPOSE OF THIS SUBROUTINE:
! Checks the limits of the various curves used in EIR chiller and returns .FALSE. if the limits do not include
! the standard test condition(s).
! METHODOLOGY EMPLOYED:
! na
! REFERENCES:
! na
! USE STATEMENTS:
USE DataGlobals, ONLY: DisplayExtraWarnings
USE CurveManager, ONLY: GetCurveMinMaxValues, GetCurveType, GetCurveName
USE DataPlant, ONLY: TypeOf_Chiller_ElectricEIR, TypeOf_Chiller_ElectricReformEIR
IMPLICIT NONE ! Enforce explicit typing of all variables in this routine
! SUBROUTINE ARGUMENT DEFINITIONS:
CHARACTER(len=*), INTENT(IN) :: ChillerName ! Name of Chiller
INTEGER, INTENT(IN) :: ChillerType ! Type of Chiller - EIR or ReformulatedEIR
INTEGER, INTENT(IN) :: CondenserType ! Type of Condenser - Air Cooled, Water Cooled or Evap Cooled
INTEGER, INTENT(IN) :: CapFTempCurveIndex ! Index for the total cooling capacity modifier curve
! (function of leaving chilled water temperature and
! entering condenser fluid temperature)
INTEGER, INTENT(IN) :: EIRFTempCurveIndex ! Index for the energy input ratio modifier curve
! (function of leaving chilled water temperature and
! entering condenser fluid temperature)
! SUBROUTINE PARAMETER DEFINITIONS:
INTEGER, PARAMETER :: AirCooled = 1
INTEGER, PARAMETER :: WaterCooled = 2
INTEGER, PARAMETER :: EvapCooled = 3
! Following parameters are taken from AHRI 551/591,2011 Table 3
REAL(r64), PARAMETER :: HighEWTemp = 30.0d0 ! Entering water temp in degrees C at full load capacity (85F)
REAL(r64), PARAMETER :: LowEWTemp = 19.0d0 ! Entering water temp in degrees C at minimum reduced capacity (65F)
REAL(r64), PARAMETER :: OAHighEDBTemp = 35.0d0 ! Outdoor air dry-bulb temp in degrees C at full load capacity (95F)
REAL(r64), PARAMETER :: OALowEDBTemp = 13d0 ! Outdoor air dry-bulb temp in degrees C at minimum reduced capacity (55F)
REAL(r64), PARAMETER :: OAHighEWBTemp = 24.0d0 ! Outdoor air wet-bulb temp in degrees C at full load capacity (75F)
REAL(r64), PARAMETER :: OALowEWBTemp = 13.50d0 ! Outdoor wet dry-bulb temp in degrees C at minimum reduced capacity (56.25F)
REAL(r64), PARAMETER :: LeavingWaterTemp = 6.67d0 ! Evaporator leaving water temperature in degrees C [44 F]
CHARACTER(len=*), PARAMETER :: RoutineName = 'CheckCurveLimitsForIPLV: ' ! 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) :: CapacityLWTempMin = 0.0d0 ! Capacity modifier Min value (leaving water temp), from the Curve:Biquadratic object
REAL(r64) :: CapacityLWTempMax = 0.0d0 ! Capacity modifier Max value (leaving water temp), from the Curve:Biquadratic object
REAL(r64) :: CapacityEnteringCondTempMin = 0.0d0 ! Capacity modifier Min value (entering cond temp),
! from the Curve:Biquadratic object
REAL(r64) :: CapacityEnteringCondTempMax = 0.0d0 ! Capacity modifier Max value (entering cond temp),
! from the Curve:Biquadratic object
! Minimum and Maximum independent variable limits from Energy Input Ratio (EIR) Function of Temperature Curve
REAL(r64) :: EIRLWTempMin = 0.0d0 ! EIR modifier Min value (leaving water temp), from the Curve:Biquadratic object
REAL(r64) :: EIRLWTempMax = 0.0d0 ! EIR modifier Max value (leaving water temp), from the Curve:Biquadratic object
REAL(r64) :: EIREnteringCondTempMin = 0.0d0 ! EIR modifier Min value (entering cond temp),
! from the Curve:Biquadratic object
REAL(r64) :: EIREnteringCondTempMax = 0.0d0 ! EIR modifier Max value (entering cond temp),
! from the Curve:Biquadratic object
REAL(r64) :: HighCondenserEnteringTempLimit = 0.0d0 ! High limit of entering condenser temperature
REAL(r64) :: LowCondenserEnteringTempLimit = 0.0d0 ! Low limit of entering condenser temperature
LOGICAL :: CapCurveIPLVLimitsExceeded = .FALSE. ! Logical for capacity curve temperature limits being exceeded (IPLV calcs)
LOGICAL :: EIRCurveIPLVLimitsExceeded = .FALSE. ! Logical for EIR temperature limits being exceeded (IPLV calcs)
CALL GetCurveMinMaxValues(CapFTempCurveIndex,CapacityLWTempMin,CapacityLWTempMax, &
CapacityEnteringCondTempMin,CapacityEnteringCondTempMax)
CALL GetCurveMinMaxValues(EIRFTempCurveIndex,EIRLWTempMin,EIRLWTempMax, &
EIREnteringCondTempMin,EIREnteringCondTempMax)
IF (CondenserType == WaterCooled) THEN
HighCondenserEnteringTempLimit = HighEWTemp
LowCondenserEnteringTempLimit = LowEWTemp
ELSE IF (CondenserType == AirCooled) THEN
HighCondenserEnteringTempLimit = OAHighEDBTemp
LowCondenserEnteringTempLimit = OAHighEDBTemp
ELSE ! Evaporatively Cooled Condenser
HighCondenserEnteringTempLimit = OAHighEWBTemp
LowCondenserEnteringTempLimit = OAHighEWBTemp
ENDIF
! Checking the limits of capacity modifying curve for temperatures (IPLV high and low test conditions)
IF ( CapacityEnteringCondTempMax < HighCondenserEnteringTempLimit .OR. &
CapacityEnteringCondTempMin > LowCondenserEnteringTempLimit .OR. &
CapacityLWTempMax < LeavingWaterTemp .OR. CapacityLWTempMin > LeavingWaterTemp ) THEN
CapCurveIPLVLimitsExceeded = .TRUE.
END IF
! Checking the limits of EIR modifying curve for temperatures (IPLV high and low test conditions)
IF ( EIREnteringCondTempMax < HighCondenserEnteringTempLimit .OR. &
EIREnteringCondTempMin > LowCondenserEnteringTempLimit .OR. &
EIRLWTempMax < LeavingWaterTemp .OR. EIRLWTempMin > LeavingWaterTemp ) THEN
EIRCurveIPLVLimitsExceeded = .TRUE.
END IF
! For IPLV:
IF ( CapCurveIPLVLimitsExceeded .OR. EIRCurveIPLVLimitsExceeded) THEN
IF (DisplayExtraWarnings) THEN
SELECT CASE (ChillerType)
CASE (TypeOf_Chiller_ElectricEIR)
CALL ShowWarningError('Chiller:Electric:EIR = '// &
TRIM(ChillerName)//': '//&
' Integrated Part Load Value (IPLV) calculated is not at the AHRI test condition.')
CASE (TypeOf_Chiller_ElectricReformEIR)
CALL ShowWarningError('Chiller:Electric:ReformulatedEIR = '// &
TRIM(ChillerName)//': '//&
' Integrated Part Load Value (IPLV) calculated is not at the AHRI test condition.')
END SELECT
IF (CapCurveIPLVLimitsExceeded) THEN
CALL ShowContinueError(' Check limits in Cooling Capacity Function of Temperature Curve, ' &
//'Curve Type = '//TRIM(GetCurveType(CapFTempCurveIndex)) &
//', Curve Name = '//TRIM(GetCurveName(CapFTempCurveIndex)))
END IF
IF (EIRCurveIPLVLimitsExceeded) THEN
CALL ShowContinueError(' Check limits in EIR Function of Temperature Curve, ' &
//'Curve Type = '//TRIM(GetCurveType(EIRFTempCurveIndex)) &
//', Curve Name = '//TRIM(GetCurveName(EIRFTempCurveIndex)))
END IF
END IF
END IF
RETURN
END SUBROUTINE CheckCurveLimitsForIPLV