Type | Intent | Optional | Attributes | Name | ||
---|---|---|---|---|---|---|
character(len=*), | intent(in) | :: | Refrigerant | |||
real(kind=r64), | intent(in) | :: | Temperature | |||
real(kind=r64), | intent(in) | :: | Enthalpy | |||
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.
FUNCTION GetSupHeatPressureRefrig(Refrigerant,Temperature,Enthalpy,RefrigIndex,calledfrom) RESULT(ReturnValue)
! SUBROUTINE INFORMATION:
! AUTHOR Rick Strand
! DATE WRITTEN May 2000
! MODIFIED Simon Rees (May 2002)
! RE-ENGINEERED na
! PURPOSE OF THIS SUBROUTINE:
! Performs linear interpolation between enthalpy and temperatures and
! returns pressure values. Works only in superheated region.
! METHODOLOGY EMPLOYED:
! Double linear interpolation is used with pressure values at four
! enthalpy/temperature input points surrounding the given temperature
! and enthalpy argument values.
!
! All enthalpies have to be calculated at the given temperature before a
! search is made for the data adjacent to the given enthalpy. Linear interpolation
! using the enthalpy data is used to interpolate the correspondng pressures.
! Temperatures and enthalpies outside the bounds of the available data are capped
! and warnings given. For enthlpys lower than the saturated vapour value at the
! given temperature result in the saturation pressure being returned (calls to
! GetSatEnthalpy and GetSatPressure are made.)
! 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) :: Enthalpy ! actual enthalpy 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 PARAMETERS:
REAL(r64), PARAMETER :: EnthalpyDiff = 0.01d0 ! Allows a 1% difference in the enthalpy input and
! the enthalpy calculated from the pressure found
CHARACTER(len=*), PARAMETER :: RoutineName='GetSupHeatPressureRefrig: '
! INTERFACE BLOCK SPECIFICATIONS:
! na
! DERIVED TYPE DEFINITIONS:
! na
! SUBROUTINE LOCAL VARIABLE DECLARATIONS:
REAL(r64) :: EnthalpyCheck ! recalculates enthalpy based on calculated pressure
REAL(r64) :: EnthalpyHigh ! Enthalpy value at interpolated pressure and high temperature
REAL(r64) :: EnthalpyLow ! Enthalpy value at interpolated pressure and low temperature
REAL(r64) :: EnthalpyMax ! Enthalpy value at interpolated pressure and high temperature
REAL(r64) :: EnthalpyMin ! Enthalpy value at interpolated pressure and low temperature
REAL(r64) :: SatEnthalpy ! Saturated vapour enthalpy
REAL(r64) :: TempInterpRatio ! Interpolation ratio w.r.t temperature
REAL(r64) :: EnthInterpRatio ! Interpolation ratio w.r.t enthalpy
INTEGER :: finish ! index of high end of enthalpy values
INTEGER :: start ! index of high end of enthalpy values
INTEGER :: Loop ! DO loop counter
INTEGER :: middle ! mid-point for interval halving
INTEGER :: RefrigNum ! index for refrigerant under consideration
INTEGER :: LoTempStart ! lower non-zero index of enthalpy values at lower temp.
INTEGER :: LoTempFinish ! upper non-zero index of enthalpy values at lower temp.
INTEGER :: HiTempStart ! lower non-zero index of enthalpy values at higher temp.
INTEGER :: HiTempFinish ! upper non-zero index of enthalpy values at higher temp.
INTEGER :: TempStart ! corrected lower non-zero index of enthalpy values
INTEGER :: TempFinish ! corrected upper non-zero index of enthalpy values
INTEGER :: LoTempIndex ! Index value of lower temperature from data
INTEGER :: HiTempIndex ! Index value of higher temperature from data
INTEGER :: LoEnthalpyIndex ! Index value of lower enthalpy from data
INTEGER :: HiEnthalpyIndex ! Index value of higher enthalpy from data
! error counters and dummy string
INTEGER,SAVE :: TempRangeErrCount=0
INTEGER,SAVE :: EnthalpyRangeErrCount=0
INTEGER,SAVE :: SatErrCount=0
INTEGER,SAVE :: TempRangeErrIndex=0
INTEGER,SAVE :: EnthalpyRangeErrIndex=0
INTEGER,SAVE :: SatErrIndex=0
INTEGER :: ErrCount ! error counter for current call
INTEGER :: CurTempRangeErrCount ! error counter for current call
INTEGER :: CurEnthalpyRangeErrCount ! error counter for current call
INTEGER :: CurSatErrCount ! error counter for current call
! FLOW:
IF (GetInput) THEN
CALL GetFluidPropertiesData
GetInput = .FALSE.
END IF
RefrigNum=0
IF (NumOfRefrigerants == 0) THEN
CALL ReportFatalRefrigerantErrors(NumOfRefrigerants,RefrigNum,.true.,Refrigerant, &
'GetSupHeatPressureRefrig','properties',calledfrom)
ENDIF
ErrCount = 0
CurTempRangeErrCount = 0
CurEnthalpyRangeErrCount = 0
CurSatErrCount = 0
! Find which refrigerant (index) is being requested and then determine
! where the temperature is within the temperature array
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, &
'GetSupHeatPressureRefrig','properties',calledfrom)
ENDIF
RefrigIndex=RefrigNum
ENDIF
LoTempIndex = FindArrayIndex(Temperature,RefrigData(RefrigNum)%SHTemps,1,RefrigData(RefrigNum)%NumSuperTempPts)
HiTempIndex = LoTempIndex + 1
! check temperature data range and attempt to cap if necessary
IF((LoTempIndex > 0) .AND. (LoTempIndex < RefrigData(RefrigNum)%NumSuperTempPts) )THEN ! in range
HiTempIndex = LoTempIndex + 1
ELSE IF (LoTempIndex<1)THEN ! below lower bound
CurTempRangeErrCount = CurTempRangeErrCount + 1
LoTempIndex = 1
HiTempIndex = LoTempIndex
ELSE ! out of range
CurTempRangeErrCount = CurTempRangeErrCount + 1
HiTempIndex = LoTempIndex
END IF
! check for lowest non-zero value in lower temp data
LoTempStart=RefrigData(RefrigNum)%NumSuperPressPts
DO Loop = 1, RefrigData(RefrigNum)%NumSuperPressPts
IF (RefrigData(RefrigNum)%HshValues(LoTempIndex,Loop) > 0.0d0) THEN
LoTempStart = Loop
EXIT
END IF
END DO
! check for highest non-zero value in lower temp data
LoTempFinish=1
DO Loop = RefrigData(RefrigNum)%NumSuperPressPts, 1, -1
IF (RefrigData(RefrigNum)%HshValues(LoTempIndex,Loop) <= 0.0d0) THEN
LoTempFinish = Loop
!EXIT
END IF
END DO
! check for lowest non-zero value in high temp data
HiTempStart=RefrigData(RefrigNum)%NumSuperPressPts
DO Loop = 1, RefrigData(RefrigNum)%NumSuperPressPts
IF (RefrigData(RefrigNum)%HshValues(HiTempIndex,Loop) > 0.0d0) THEN
HiTempStart = Loop
EXIT
END IF
END DO
! check for highest non-zero value in high temp data
HiTempFinish=1
DO Loop = RefrigData(RefrigNum)%NumSuperPressPts, 1, -1
IF (RefrigData(RefrigNum)%HshValues(HiTempIndex,Loop) <= 0.0d0) THEN
HiTempFinish = Loop
END IF
END DO
! find bounds of both hi and lo temp data
TempStart = MAX(LoTempStart, HiTempStart)
TempFinish = MIN(LoTempFinish, HiTempFinish)
! calculate interpolation ratio w.r.t temperature
! This ratio is used to find enthalpies at the given temperature
TempInterpRatio = (Temperature - RefrigData(RefrigNum)%SHTemps(LoTempIndex))/ &
(RefrigData(RefrigNum)%SHTemps(HiTempIndex) - &
RefrigData(RefrigNum)%SHTemps(LoTempIndex) )
! search for array index by bisection
start = TempStart ! set the bounds
finish = TempFinish
! find the bounds of the enthalpy data available
EnthalpyMax = MAX(RefrigData(RefrigNum)%HshValues(LoTempIndex,TempStart), &
RefrigData(RefrigNum)%HshValues(HiTempIndex,TempStart))
EnthalpyMin = MIN(RefrigData(RefrigNum)%HshValues(LoTempIndex,TempFinish), &
RefrigData(RefrigNum)%HshValues(HiTempIndex,TempFinish))
! get saturated enthalpy for checking
SatEnthalpy = GetSatEnthalpyRefrig(Refrigerant, Temperature, 1.0d0, &
RefrigNum,'GetSupHeatPressureRefrig:'//trim(calledfrom))
! make some checks on the data before interpolating
IF(Enthalpy < SatEnthalpy)THEN
! flag error
CurSatErrCount = CurSatErrCount + 1
ErrCount = ErrCount + 1
! return sat pressure at this temperature
ReturnValue = GetSatPressureRefrig(Refrigerant, Temperature, &
RefrigNum,'GetSupHeatPressureRefrig:'//trim(calledfrom))
ELSE IF (EnthalpyMax < Enthalpy .OR. EnthalpyMin > Enthalpy) THEN
! out of range error
CurEnthalpyRangeErrCount = CurEnthalpyRangeErrCount +1
ErrCount = ErrCount + 1
IF(Enthalpy > EnthalpyMax)THEN
! return min pressure
ReturnValue = RefrigData(RefrigNum)%SHPress(HiTempStart)
ELSE
! return max pressure
ReturnValue = RefrigData(RefrigNum)%SHPress(LoTempFinish)
END IF
ELSE
! go ahead and search
DO WHILE ((finish - start) > 1)
middle = (finish + start) / 2
! calc enthalpy at middle index for given temperature
EnthalpyCheck = RefrigData(RefrigNum)%HshValues(LoTempIndex,middle) + &
TempInterpRatio * (RefrigData(RefrigNum)%HshValues(HiTempIndex,middle) - &
RefrigData(RefrigNum)%HshValues(LoTempIndex,middle) )
IF (Enthalpy < EnthalpyCheck) THEN
start = middle
ELSE
finish = middle
END IF
END DO
LoEnthalpyIndex = start
HiEnthalpyIndex = start + 1
! calculate enthalpies adjacent specified enthalpy at given temperature
EnthalpyLow = RefrigData(RefrigNum)%HshValues(LoTempIndex,LoEnthalpyIndex) + &
TempInterpRatio * (RefrigData(RefrigNum)%HshValues(HiTempIndex,LoEnthalpyIndex) - &
RefrigData(RefrigNum)%HshValues(LoTempIndex,LoEnthalpyIndex) )
EnthalpyHigh = RefrigData(RefrigNum)%HshValues(LoTempIndex,HiEnthalpyIndex) + &
TempInterpRatio * (RefrigData(RefrigNum)%HshValues(HiTempIndex,HiEnthalpyIndex) - &
RefrigData(RefrigNum)%HshValues(LoTempIndex,HiEnthalpyIndex) )
! calculate an interpolation ratio
EnthInterpRatio = (Enthalpy - EnthalpyLow) / (EnthalpyHigh - EnthalpyLow)
! apply this interpolation ratio to find the final pressure
ReturnValue = RefrigData(RefrigNum)%SHPress(LoEnthalpyIndex) + &
EnthInterpRatio * (RefrigData(RefrigNum)%SHPress(HiEnthalpyIndex) - &
RefrigData(RefrigNum)%SHPress(LoEnthalpyIndex))
END IF
IF (.not. WarmupFlag) THEN
! ** make error checks **
IF(ErrCount > 0) THEN
! send near saturation warning if flagged
RefrigErrorTracking(RefrigNum)%SatSupPressureErrCount = RefrigErrorTracking(RefrigNum)%SatSupPressureErrCount + &
CurSatErrCount
! send warning
IF (RefrigErrorTracking(RefrigNum)%SatSupPressureErrCount <= RefrigerantErrorLimitTest) THEN
CALL ShowSevereMessage(RoutineName//'Refrigerant ['// &
trim(RefrigErrorTracking(RefrigNum)%Name)//'] is saturated at the given enthalpy and temperature, '// &
'saturated enthalpy at given temperature returned. **')
CALL ShowContinueError('...Called From:'//trim(calledfrom))
CALL ShowContinueError('Refrigerant temperature = '//TRIM(RoundSigDigits(Temperature,2)))
CALL ShowContinueError('Refrigerant Enthalpy = '//TRIM(RoundSigDigits(Enthalpy,3)))
CALL ShowContinueError('Returned Pressure value = '//TRIM(RoundSigDigits(ReturnValue,0)))
CALL ShowContinueErrorTimeStamp(' ')
ENDIF
IF (CurSatErrCount > 0) THEN
CALL ShowRecurringSevereErrorAtEnd(RoutineName//'Refrigerant ['// &
trim(RefrigErrorTracking(RefrigNum)%Name)//'] saturated at the given enthalpy and temperature **', &
RefrigErrorTracking(RefrigNum)%SatSupPressureErrIndex, &
ReportMaxOf=ReturnValue,ReportMinOf=ReturnValue, &
ReportMaxUnits='{Pa}',ReportMinUnits='{Pa}')
ENDIF
! send temp range error if flagged
RefrigErrorTracking(RefrigNum)%SatSupPressureTempErrCount = RefrigErrorTracking(RefrigNum)%SatSupPressureTempErrCount + &
CurTempRangeErrCount
IF (CurTempRangeErrCount > 0 .AND. &
RefrigErrorTracking(RefrigNum)%SatSupPressureTempErrCount <= RefrigerantErrorLimitTest) THEN
CALL ShowWarningMessage(RoutineName//'Refrigerant ['//trim(RefrigErrorTracking(RefrigNum)%Name)// &
'] Temperature is out of range for superheated refrigerant pressure: 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 pressure: values capped **', &
RefrigErrorTracking(RefrigNum)%SatSupPressureTempErrIndex, &
ReportMaxOf=Temperature,ReportMinOf=Temperature,ReportMaxUnits='{C}',ReportMinUnits='{C}')
ENDIF
! send enthalpy range error if flagged
RefrigErrorTracking(RefrigNum)%SatSupPressureEnthErrCount = RefrigErrorTracking(RefrigNum)%SatSupPressureEnthErrCount + &
CurEnthalpyRangeErrCount
IF (CurEnthalpyRangeErrCount > 0 .AND. &
RefrigErrorTracking(RefrigNum)%SatSupPressureEnthErrCount <= 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 (CurEnthalpyRangeErrCount > 0) THEN
CALL ShowRecurringWarningErrorAtEnd(RoutineName//'Refrigerant ['// &
trim(RefrigErrorTracking(RefrigNum)%Name)// &
'] Pressure is out of range for superheated refrigerant pressure: values capped **', &
RefrigErrorTracking(RefrigNum)%SatSupPressureEnthErrIndex, &
ReportMaxOf=Enthalpy,ReportMinOf=Enthalpy,ReportMaxUnits='{J}',ReportMinUnits='{J}')
ENDIF
END IF ! end error checking
ENDIF
RETURN
END FUNCTION GetSupHeatPressureRefrig