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 GetQualityRefrig(Refrigerant,Temperature,Enthalpy,RefrigIndex,calledfrom) RESULT(ReturnValue)
! FUNCTION INFORMATION:
! AUTHOR Rick Strand
! DATE WRITTEN May 2000
! MODIFIED Simon Rees (May 2002)
! RE-ENGINEERED na
! PURPOSE OF THIS FUNCTION:
! This function determines the quality of a refrigerant in the saturate
! region based on its temperature and enthalpy
! METHODOLOGY EMPLOYED:
! Just checks to see whether or not the refrigerant name coming in can
! be found in the refrigerant derived type. If so, the "reverse" of the
! GetSatEnthalpyRefrig function is performed.
! 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
! INTERFACE BLOCK SPECIFICATIONS:
! na
! DERIVED TYPE DEFINITIONS:
! na
! FUNCTION LOCAL VARIABLE DECLARATIONS:
REAL(r64) :: SatVapEnthalpy ! value of enthalpy at hi index value for given Quality
REAL(r64) :: SatLiqEnthalpy ! value of enthalpy at TempIndex index value for given Quality
INTEGER :: RefrigNum ! index for refrigerant under consideration
INTEGER :: HiTempIndex ! array index for temp above input temp
INTEGER :: LoTempIndex ! array index for temp below input temp
REAL(r64) :: TempInterpRatio ! ratio to interpolate in temperature domain
INTEGER,SAVE :: TempLoRangeErrIndex=0
INTEGER,SAVE :: TempHiRangeErrIndex=0
! FLOW:
IF (GetInput) THEN
CALL GetFluidPropertiesData
GetInput = .FALSE.
END IF
RefrigNum=0
IF (NumOfRefrigerants == 0) THEN
CALL ReportFatalRefrigerantErrors(NumOfRefrigerants,RefrigNum,.true.,Refrigerant,'GetQualityRefrig','enthalpy',calledfrom)
ENDIF
! 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,'GetQualityRefrig','enthalpy',calledfrom)
ENDIF
RefrigIndex=RefrigNum
ENDIF
LoTempIndex = FindArrayIndex(Temperature,RefrigData(RefrigNum)%HTemps, &
RefrigData(RefrigNum)%HfLowTempIndex,RefrigData(RefrigNum)%HfHighTempIndex)
HiTempIndex = LoTempIndex + 1
! check on the data bounds and adjust indices to give clamped return value
IF (LoTempIndex == 0) THEN
SatLiqEnthalpy = RefrigData(RefrigNum)%HfValues(RefrigData(RefrigNum)%HfLowTempIndex)
SatVapEnthalpy = RefrigData(RefrigNum)%HfgValues(RefrigData(RefrigNum)%HfLowTempIndex)
IF (.not. WarmupFlag) &
! Temperature supplied is out of bounds--produce an error message...
CALL ShowRecurringWarningErrorAtEnd( &
'GetQualityRefrig: ** Temperature for requested quality is below the range of data supplied **',TempLoRangeErrIndex, &
ReportMinOf=Temperature,ReportMaxOf=Temperature,ReportMinUnits='{C}',ReportMaxUnits='{C}')
ELSE IF(HiTempIndex > RefrigData(RefrigNum)%NumHPoints) THEN
SatLiqEnthalpy = RefrigData(RefrigNum)%HfValues(RefrigData(RefrigNum)%HfHighTempIndex)
SatVapEnthalpy = RefrigData(RefrigNum)%HfgValues(RefrigData(RefrigNum)%HfHighTempIndex)
IF (.not. WarmupFlag) &
! Temperature supplied is out of bounds--produce an error message...
CALL ShowRecurringWarningErrorAtEnd( &
'GetQualityRefrig: ** Temperature requested quality is above the range of data supplied **',TempHiRangeErrIndex, &
ReportMinOf=Temperature,ReportMaxOf=Temperature,ReportMinUnits='{C}',ReportMaxUnits='{C}')
ELSE ! in normal range work out interpolated liq and gas enthalpies
TempInterpRatio = (Temperature - RefrigData(RefrigNum)%HTemps(LoTempIndex)) &
/(RefrigData(RefrigNum)%HTemps(HiTempIndex) - RefrigData(RefrigNum)%HTemps(LoTempIndex))
SatLiqEnthalpy = TempInterpRatio*RefrigData(RefrigNum)%HfValues(HiTempIndex) &
+(1.0d0-TempInterpRatio)*RefrigData(RefrigNum)%HfValues(LoTempIndex)
SatVapEnthalpy = TempInterpRatio*RefrigData(RefrigNum)%HfgValues(HiTempIndex) &
+(1.0d0-TempInterpRatio)*RefrigData(RefrigNum)%HfgValues(LoTempIndex)
END IF
! calculate final quality value from enthalpy ratio
ReturnValue = (Enthalpy-SatLiqEnthalpy)/(SatVapEnthalpy - SatLiqEnthalpy)
! final check to bound returned quality value
IF (ReturnValue < 0.0d0) THEN
! CALL ShowRecurringWarningErrorAtEnd('GetQualityRefrig: ** '// &
! 'Quality is less than zero in GetQualityRefrig; Quality reset to 0.0 **')
ReturnValue = 0.0d0
ELSE IF (ReturnValue > 1.0d0) THEN
! CALL ShowRecurringWarningErrorAtEnd('GetQualityRefrig: ** '// &
! 'Quality is greater than one in GetQualityRefrig; refrigerant is superheated **')
ReturnValue = 2.0d0
END IF
RETURN
END FUNCTION GetQualityRefrig