Type | Intent | Optional | Attributes | Name | ||
---|---|---|---|---|---|---|
character(len=*), | intent(in) | :: | Refrigerant | |||
real(kind=r64), | intent(in) | :: | Temperature | |||
real(kind=r64), | intent(in) | :: | Pressure | |||
integer, | intent(inout) | :: | RefrigIndex | |||
character(len=*), | intent(in) | :: | calledfrom |
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.
FUNCTION GetSupHeatEnthalpyRefrig(Refrigerant,Temperature,Pressure,RefrigIndex,calledfrom) RESULT(ReturnValue)
! SUBROUTINE INFORMATION:
! AUTHOR Mike Turner
! DATE WRITTEN 10 December 99
! MODIFIED Rick Strand (April 2000, May 2000)
! MODIFIED Simon Rees (May 2002)
! RE-ENGINEERED N/A
! PURPOSE OF THIS SUBROUTINE:
! Performs linear interpolation between pressures and temperatures and
! returns enthalpy values. Works only in superheated region.
! METHODOLOGY EMPLOYED:
! Double linear interpolation is used with enthalpy values at four
! pressure/temperature input points surrounding the given temperature
! and pressure argument values.
!
! With enthalpy data it is assumed that zero values in the data are in
! the saturated region. Hence, values near the saturation line are
! approximated using the saturation value instead of the zero data value.
! points completely in the saturation region are given the saturation value
! at the given temperature. Points at the upper limits of pressure/temperature
! have the pressure/temperature capped. Warnings are given if the point
! is not clearly in the bounds of the superheated data.
! REFERENCES:
! na
! USE STATEMENTS:
! na
IMPLICIT NONE ! Enforce explicit typing of all variables in this routine
! FUNCTION ARGUMENT DEFINITIONS:
CHARACTER(len=*), INTENT(IN) :: Refrigerant ! carries in substance name
REAL(r64), INTENT(IN) :: Temperature ! actual temperature given as input
REAL(r64), INTENT(IN) :: Pressure ! actual pressure given as input
INTEGER, INTENT(INOUT) :: RefrigIndex ! Index to Refrigerant Properties
character(len=*), intent(in) :: calledfrom ! routine this function was called from (error messages)
REAL(r64) :: ReturnValue
! FUNCTION PARAMETER DEFINITIONS:
CHARACTER(len=*), PARAMETER :: RoutineName='GetSupHeatEnthalpyRefrig: '
! INTERFACE BLOCK SPECIFICATIONS:
! na
! DERIVED TYPE DEFINITIONS:
! na
! SUBROUTINE LOCAL VARIABLE DECLARATIONS:
REAL(r64) :: PressInterpRatio ! Interpolation factor w.r.t pressure
REAL(r64) :: TempInterpRatio ! Interpolation factor w.r.t temperature
REAL(r64) :: EnthalpyHigh ! Enthalpy value at interpolated pressure and high temperature
REAL(r64) :: EnthalpyLow ! Enthalpy value at interpolated pressure and low temperature
REAL(r64) :: LoTempLoEnthalpy ! Enthalpy value at low pressure and low temperature
REAL(r64) :: LoTempHiEnthalpy ! Enthalpy value at high pressure and low temperature
REAL(r64) :: HiTempLoEnthalpy ! Enthalpy value at low pressure and high temperature
REAL(r64) :: HiTempHiEnthalpy ! Enthalpy value at high pressure and high temperature
INTEGER :: HiTempIndex ! high temperature index value
INTEGER :: HiPressIndex ! high pressure index value
INTEGER :: LoPressIndex ! low index value of Pressure from table
INTEGER :: RefrigNum ! index for refrigerant under consideration
INTEGER :: TempIndex ! low index value of Temperature from table
! error counters and dummy string
INTEGER :: ErrCount ! error counter for current call
INTEGER :: CurTempRangeErrCount ! error counter for current call
INTEGER :: CurPresRangeErrCount ! error counter for current call
INTEGER,SAVE :: TempRangeErrCount=0
INTEGER,SAVE :: TempRangeErrIndex=0
INTEGER,SAVE :: PresRangeErrCount=0
INTEGER,SAVE :: PresRangeErrIndex=0
INTEGER,SAVE :: SatErrCount=0
INTEGER,SAVE :: SatErrIndex=0
! see if data is there
IF (GetInput) THEN
CALL GetFluidPropertiesData
GetInput = .FALSE.
END IF
RefrigNum=0
IF (NumOfRefrigerants == 0) THEN
CALL ReportFatalRefrigerantErrors(NumOfRefrigerants,RefrigNum,.true.,Refrigerant, &
'GetSupHeatEnthalpyRefrig','properties',calledfrom)
ENDIF
ErrCount = 0
CurTempRangeErrCount = 0
CurPresRangeErrCount = 0
! Find which refrigerant (index) is being requested and then determine
! where the temperature and pressure are within the temperature and
! pressure arrays, respectively
IF (RefrigIndex > 0) THEN
RefrigNum=RefrigIndex
ELSE
! Find which refrigerant (index) is being requested
RefrigNum = FindRefrigerant(Refrigerant)
IF (RefrigNum == 0) THEN
CALL ReportFatalRefrigerantErrors(NumOfRefrigerants,RefrigNum,.true.,Refrigerant, &
'GetSupHeatEnthalpyRefrig','properties',calledfrom)
ENDIF
RefrigIndex=RefrigNum
ENDIF
TempIndex = FindArrayIndex(Temperature,RefrigData(RefrigNum)%SHTemps,1,RefrigData(RefrigNum)%NumSuperTempPts)
LoPressIndex = FindArrayIndex(Pressure,RefrigData(RefrigNum)%SHPress,1,RefrigData(RefrigNum)%NumSuperPressPts)
! check temperature data range and attempt to cap if necessary
IF((TempIndex > 0) .AND. (TempIndex < RefrigData(RefrigNum)%NumSuperTempPts) )THEN ! in range
HiTempIndex = TempIndex + 1
TempInterpRatio = (Temperature - RefrigData(RefrigNum)%SHTemps(TempIndex)) / &
(RefrigData(RefrigNum)%SHTemps(HiTempIndex) - RefrigData(RefrigNum)%SHTemps(TempIndex))
ELSE IF(TempIndex <1)THEN
CurTempRangeErrCount = CurTempRangeErrCount + 1
ErrCount = ErrCount + 1
TempIndex = 1
HiTempIndex = TempIndex
TempInterpRatio = 0.0d0
ELSE ! out of range
CurTempRangeErrCount = CurTempRangeErrCount + 1
ErrCount = ErrCount + 1
! FindArrayIndex will return upper or lower bound so TempIndex gives upper/lower limit
HiTempIndex = TempIndex
TempInterpRatio = 0.0d0
END IF
! check pressure data range and attempt to cap if necessary
IF((LoPressIndex > 0) .AND. (LoPressIndex < RefrigData(RefrigNum)%NumSuperPressPts) ) THEN ! in range
HiPressIndex = LoPressIndex + 1
PressInterpRatio = (Pressure - RefrigData(RefrigNum)%SHPress(LoPressIndex)) / &
(RefrigData(RefrigNum)%SHPress(HiPressIndex) - RefrigData(RefrigNum)%SHPress(LoPressIndex))
ELSE IF(LoPressIndex < 1)THEN
CurPresRangeErrCount = CurPresRangeErrCount + 1
ErrCount = ErrCount + 1
! FindArrayIndex will return upper or lower bound so TempIndex gives upper/lower limit
LoPressIndex = 1
HiPressIndex = LoPressIndex
PressInterpRatio = 0.0d0
ELSE ! out of range
CurPresRangeErrCount = CurPresRangeErrCount + 1
ErrCount = ErrCount + 1
HiPressIndex = LoPressIndex
PressInterpRatio = 0.0d0
END IF
! get interpolation point values
LoTempLoEnthalpy = RefrigData(RefrigNum)%HshValues(TempIndex,LoPressIndex)
LoTempHiEnthalpy = RefrigData(RefrigNum)%HshValues(TempIndex,HiPressIndex)
HiTempLoEnthalpy = RefrigData(RefrigNum)%HshValues(HiTempIndex,LoPressIndex)
HiTempHiEnthalpy = RefrigData(RefrigNum)%HshValues(HiTempIndex,HiPressIndex)
! to give reasonable interpolation near saturation reset any point with zero value
! in table to saturation value
IF(LoTempLoEnthalpy <= 0.0d0) THEN
LoTempLoEnthalpy = GetSatEnthalpyRefrig(Refrigerant,Temperature, 1.0d0, RefrigNum, 'GetSupHeatEnthalpyRefrig')
END IF
IF(LoTempHiEnthalpy <= 0.0d0) THEN
LoTempHiEnthalpy = GetSatEnthalpyRefrig(Refrigerant,Temperature, 1.0d0, RefrigNum, 'GetSupHeatEnthalpyRefrig')
END IF
IF(HiTempLoEnthalpy <= 0.0d0) THEN
HiTempLoEnthalpy = GetSatEnthalpyRefrig(Refrigerant,Temperature, 1.0d0, RefrigNum, 'GetSupHeatEnthalpyRefrig')
END IF
IF(HiTempHiEnthalpy <= 0.0d0) THEN
HiTempHiEnthalpy = GetSatEnthalpyRefrig(Refrigerant,Temperature, 1.0d0, RefrigNum, 'GetSupHeatEnthalpyRefrig')
END IF
! interpolate w.r.t. pressure
EnthalpyLow = PressInterpRatio*LoTempHiEnthalpy + (1.0d0-PressInterpRatio)*LoTempLoEnthalpy
EnthalpyHigh = PressInterpRatio*HiTempHiEnthalpy + (1.0d0-PressInterpRatio)*HiTempLoEnthalpy
! interpolate w.r.t. temperature
ReturnValue = TempInterpRatio*EnthalpyHigh + (1.0d0-TempInterpRatio)*EnthalpyLow
! Check to see if all data is at zero. In this case we are completely
! inside the saturation dome. Best thing we can do is return saturation value
IF((RefrigData(RefrigNum)%HshValues(TempIndex,LoPressIndex) <= 0.0d0) .AND. &
(RefrigData(RefrigNum)%HshValues(TempIndex,HiPressIndex) <= 0.0d0) .AND. &
(RefrigData(RefrigNum)%HshValues(HiTempIndex,LoPressIndex) <= 0.0d0) .AND. &
(RefrigData(RefrigNum)%HshValues(HiTempIndex,HiPressIndex) <= 0.0d0) ) THEN
SatErrCount = SatErrCount +1
! set return value
ReturnValue = GetSatEnthalpyRefrig(Refrigerant,Temperature, 1.0d0, &
RefrigNum,'GetSupHeatEnthalpyRefrig:'//trim(calledfrom))
! send warning
IF (.not. WarmupFlag) THEN
RefrigErrorTracking(RefrigNum)%SatSupEnthalpyErrCount = RefrigErrorTracking(RefrigNum)%SatSupEnthalpyErrCount + &
SatErrCount
! send warning
IF (RefrigErrorTracking(RefrigNum)%SatTempDensityErrCount <= RefrigerantErrorLimitTest) THEN
CALL ShowSevereMessage(RoutineName//'Refrigerant ['// &
trim(RefrigErrorTracking(RefrigNum)%Name)//'] is saturated at the given conditions, '// &
'saturated enthalpy at given temperature returned. **')
CALL ShowContinueError('...Called From:'//trim(calledfrom))
CALL ShowContinueError('Refrigerant temperature = '//TRIM(RoundSigDigits(Temperature,2)))
CALL ShowContinueError('Refrigerant pressure = '//TRIM(RoundSigDigits(Pressure,0)))
CALL ShowContinueError('Returned Enthalpy value = '//TRIM(RoundSigDigits(ReturnValue,3)))
CALL ShowContinueErrorTimeStamp(' ')
ENDIF
CALL ShowRecurringSevereErrorAtEnd(RoutineName//'Refrigerant ['// &
trim(RefrigErrorTracking(RefrigNum)%Name)//'] saturated at the given conditions **', &
RefrigErrorTracking(RefrigNum)%SatSupEnthalpyErrIndex, &
ReportMaxOf=Temperature,ReportMinOf=Temperature, &
ReportMaxUnits='{C}',ReportMinUnits='{C}')
ENDIF
RETURN
ENDIF
IF (.not. WarmupFlag) THEN
! some checks...
IF(ErrCount > 0)THEN
! send temp range error if flagged
RefrigErrorTracking(RefrigNum)%SatSupEnthalpyTempErrCount = RefrigErrorTracking(RefrigNum)%SatSupEnthalpyTempErrCount + &
CurTempRangeErrCount
IF (CurTempRangeErrCount > 0 .AND. &
RefrigErrorTracking(RefrigNum)%SatSupEnthalpyTempErrCount <= RefrigerantErrorLimitTest) THEN
CALL ShowWarningMessage(RoutineName//'Refrigerant ['//trim(RefrigErrorTracking(RefrigNum)%Name)// &
'] Temperature is out of range for superheated refrigerant enthalpy: values capped **')
CALL ShowContinueError(' Called From:'//trim(calledfrom))
CALL ShowContinueErrorTimeStamp(' ')
ENDIF
IF (CurTempRangeErrCount > 0) THEN
CALL ShowRecurringWarningErrorAtEnd(RoutineName//'Refrigerant ['// &
trim(RefrigErrorTracking(RefrigNum)%Name)// &
'] Temperature is out of range for superheated refrigerant enthalpy: values capped **', &
RefrigErrorTracking(RefrigNum)%SatSupEnthalpyTempErrIndex, &
ReportMaxOf=Temperature,ReportMinOf=Temperature,ReportMaxUnits='{C}',ReportMinUnits='{C}')
ENDIF
! send pressure range error if flagged
RefrigErrorTracking(RefrigNum)%SatSupEnthalpyPresErrCount = RefrigErrorTracking(RefrigNum)%SatSupEnthalpyPresErrCount + &
CurPresRangeErrCount
IF (CurPresRangeErrCount > 0 .AND. &
RefrigErrorTracking(RefrigNum)%SatSupEnthalpyPresErrCount <= RefrigerantErrorLimitTest) THEN
CALL ShowWarningMessage(RoutineName//'Refrigerant ['//trim(RefrigErrorTracking(RefrigNum)%Name)// &
'] Pressure is out of range for superheated refrigerant enthalpy: values capped **')
CALL ShowContinueError(' Called From:'//trim(calledfrom))
CALL ShowContinueErrorTimeStamp(' ')
ENDIF
IF (CurPresRangeErrCount > 0) THEN
CALL ShowRecurringWarningErrorAtEnd(RoutineName//'Refrigerant ['// &
trim(RefrigErrorTracking(RefrigNum)%Name)// &
'] Pressure is out of range for superheated refrigerant enthalpy: values capped **', &
RefrigErrorTracking(RefrigNum)%SatSupEnthalpyPresErrIndex, &
ReportMaxOf=Pressure,ReportMinOf=Pressure,ReportMaxUnits='{Pa}',ReportMinUnits='{Pa}')
ENDIF
END IF ! end error checking
ENDIF
RETURN
END FUNCTION GetSupHeatEnthalpyRefrig