Type | Intent | Optional | Attributes | Name | ||
---|---|---|---|---|---|---|
character(len=*), | intent(in) | :: | Refrigerant | |||
real(kind=r64), | intent(in) | :: | Temperature | |||
real(kind=r64), | intent(in) | :: | Quality | |||
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 GetSatDensityRefrig(Refrigerant,Temperature,Quality,RefrigIndex,calledfrom) RESULT(ReturnValue)
! SUBROUTINE INFORMATION:
! AUTHOR Mike Turner
! DATE WRITTEN 10 December 99
! MODIFIED Rick Strand (April 2000, May 2000)
! Simon Rees (May 2002); Kenneth Tang (Jan 2004)
! RE-ENGINEERED na
! PURPOSE OF THIS SUBROUTINE:
! This finds density for given temperature and a quality under the vapor dome.
! This function is only called with a valid refrigerant and quality between 0 and 1.
! METHODOLOGY EMPLOYED:
! Calls GetInterpolatedSatProp to linearly interpolate between the saturated
! liquid and vapour densities according to the given quality.
! 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) :: Quality ! actual quality 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='GetSatDensityRefrig: '
! INTERFACE BLOCK SPECIFICATIONS:
! na
! DERIVED TYPE DEFINITIONS:
! na
! FUNCTION LOCAL VARIABLE DECLARATIONS:
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) :: LoSatProp ! Sat. prop. at lower temp & given quality
REAL(r64) :: HiSatProp ! Sat. prop. at higher temp & given quality
REAL(r64) :: TempInterpRatio ! ratio to interpolate in temperature domain
LOGICAL :: ErrorFlag ! error flag for current call
! error counters and dummy string
INTEGER,SAVE :: TempRangeErrCount=0 ! cumulative error counter
INTEGER,SAVE :: TempRangeErrIndex=0 ! cumulative error counter
! FLOW:
IF (GetInput) THEN
CALL GetFluidPropertiesData
GetInput = .FALSE.
END IF
RefrigNum=0
IF (NumOfRefrigerants == 0) THEN
CALL ReportFatalRefrigerantErrors(NumOfRefrigerants,RefrigNum,.true.,Refrigerant, &
'GetSatDensityRefrig','properties',calledfrom)
ENDIF
IF ((Quality < 0.0d0) .OR. (Quality > 1.0d0)) THEN
CALL ShowSevereError(RoutineName//'Refrigerant "'//TRIM(Refrigerant)// &
'", invalid quality, called from '//TRIM(calledfrom))
CALL ShowContinueError('Saturated density quality must be between 0 and 1, entered value=['// &
trim(RoundSigDigits(Quality,4))//'].')
CALL ShowFatalError('Program terminates due to preceding condition.')
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, &
'GetSatDensityRefrig','properties',calledfrom)
ENDIF
RefrigIndex=RefrigNum
ENDIF
ErrorFlag = .False.
LoTempIndex = FindArrayIndex(Temperature, RefrigData(RefrigNum)%RhoTemps, &
RefrigData(RefrigNum)%RhofLowTempIndex,RefrigData(RefrigNum)%RhofHighTempIndex)
HiTempIndex = LoTempIndex + 1
!Error check to make sure the temperature is not out of bounds
IF (LoTempIndex == 0) THEN
!Give the lowest density value if the temperature is below than the minimum
!temperature in the refrigerant table
ReturnValue = 1.0d0/RefrigData(RefrigNum)%RhofValues(RefrigData(RefrigNum)%RhofLowTempIndex) + &
Quality*(1.0d0/RefrigData(RefrigNum)%RhofgValues(RefrigData(RefrigNum)%RhofLowTempIndex) - &
1.0d0/RefrigData(RefrigNum)%RhofValues(RefrigData(RefrigNum)%RhofLowTempIndex))
ReturnValue=1.0d0/ReturnValue
ErrorFlag = .True.
ELSE IF(HiTempIndex > RefrigData(RefrigNum)%RhofHighTempIndex) THEN
!Give the highest density value if the temperature is higher than the maximum
!temperature in the refrigerant table
ReturnValue = 1.0d0/RefrigData(RefrigNum)%RhofValues(RefrigData(RefrigNum)%RhofHighTempIndex) + &
Quality*(1.0d0/RefrigData(RefrigNum)%RhofgValues(RefrigData(RefrigNum)%RhofHighTempIndex) - &
1.0d0/RefrigData(RefrigNum)%RhofValues(RefrigData(RefrigNum)%RhofHighTempIndex))
ReturnValue=1.0d0/ReturnValue
ErrorFlag = .True.
ELSE ! Okay
!Calculate the specific volume for the lower temperature index based on linear
!interpolation of the quality
LoSatProp = 1.0d0/RefrigData(RefrigNum)%RhofValues(LoTempIndex) + &
Quality*(1.0d0/RefrigData(RefrigNum)%RhofgValues(LoTempIndex) - &
1.0d0/RefrigData(RefrigNum)%RhofValues(LoTempIndex))
!Calculate the specific volume for the higher temperature index based on linear
!interpolation of the quality
HiSatProp = 1.0d0/RefrigData(RefrigNum)%RhofValues(HiTempIndex) + &
Quality*(1.0d0/RefrigData(RefrigNum)%RhofgValues(HiTempIndex) - &
1.0d0/RefrigData(RefrigNum)%RhofValues(HiTempIndex))
!Find interpolation ratio in temperature direction
TempInterpRatio = (Temperature - RefrigData(RefrigNum)%RhoTemps(LoTempIndex)) / &
(RefrigData(RefrigNum)%RhoTemps(HiTempIndex) - RefrigData(RefrigNum)%RhoTemps(LoTempIndex))
!Apply final linear interpolation to find the specific volume
ReturnValue = LoSatProp + TempInterpRatio*(HiSatProp - LoSatProp)
!Convert the specific volume to density
ReturnValue = 1.0d0/ReturnValue
ENDIF
IF (.not. WarmupFlag .and. ErrorFlag) THEN
RefrigErrorTracking(RefrigNum)%SatTempDensityErrCount = RefrigErrorTracking(RefrigNum)%SatTempDensityErrCount + 1
! send warning
IF (RefrigErrorTracking(RefrigNum)%SatTempDensityErrCount <= RefrigerantErrorLimitTest) THEN
CALL ShowSevereMessage(RoutineName//'Saturation temperature is out of range for refrigerant ['// &
trim(RefrigErrorTracking(RefrigNum)%Name)//'] supplied data: **')
CALL ShowContinueError('...Called From:'//trim(calledfrom)//', supplied data range=['// &
trim(RoundSigDigits(RefrigData(RefrigNum)%RhoTemps(RefrigData(RefrigNum)%RhofLowTempIndex),2))//','// &
trim(RoundSigDigits(RefrigData(RefrigNum)%RhoTemps(RefrigData(RefrigNum)%RhofHighTempIndex),2))//']')
CALL ShowContinueError('...Supplied Refrigerant Temperature='//TRIM(RoundSigDigits(Temperature,2))// &
' Returned saturated density value ='//TRIM(RoundSigDigits(ReturnValue,2)))
CALL ShowContinueErrorTimeStamp(' ')
ENDIF
CALL ShowRecurringSevereErrorAtEnd(RoutineName//'Saturation temperature is out of range for refrigerant ['// &
trim(RefrigErrorTracking(RefrigNum)%Name)//'] supplied data: **', &
RefrigErrorTracking(RefrigNum)%SatTempDensityErrIndex, &
ReportMaxOf=Temperature,ReportMinOf=Temperature, &
ReportMaxUnits='{C}',ReportMinUnits='{C}')
END IF
RETURN
END FUNCTION GetSatDensityRefrig