Type | Intent | Optional | Attributes | Name | ||
---|---|---|---|---|---|---|
integer, | intent(in) | :: | NumOfConcs | |||
integer, | intent(in) | :: | NumOfTemps | |||
real(kind=r64), | intent(in), | DIMENSION(:) | :: | RawConcData | ||
real(kind=r64), | intent(in), | DIMENSION(:,:) | :: | RawPropData | ||
real(kind=r64), | intent(in) | :: | Concentration | |||
real(kind=r64), | intent(out), | DIMENSION(:) | :: | InterpData |
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 InterpDefValuesForGlycolConc(NumOfConcs,NumOfTemps,RawConcData,RawPropData,Concentration,InterpData)
! SUBROUTINE INFORMATION:
! AUTHOR Rick Strand
! DATE WRITTEN June 2004
! MODIFIED na
! RE-ENGINEERED na
! PURPOSE OF THIS SUBROUTINE:
! The purpose of this subroutine is to find the values for the property
! data at a particular concentration from default data that is at "generic"
! concentrations. This is then returned to the main get routine and
! then used later in the program to find values at various temperatures.
! The ultimate purpose of this is to avoid double interpolation during
! the simulation. Since concentration does not change during the simulation,
! there is no reason to do a double interpolation every time a property
! value is needed.
! METHODOLOGY EMPLOYED:
! Fairly straight forward--find the two concentrations between which
! the actual concentration falls and then interpolate the property
! data using standard linear interpolation. Note that data is stored
! in the format: 2dArray(Concentration,Temperature)
! REFERENCES:
! na
! USE STATEMENTS:
! na
IMPLICIT NONE ! Enforce explicit typing of all variables in this routine
! FUNCTION ARGUMENT DEFINITIONS:
INTEGER, INTENT(IN) :: NumOfConcs ! number of concentrations (dimension of raw data)
INTEGER, INTENT(IN) :: NumOfTemps ! number of temperatures (dimension of raw data)
REAL(r64), DIMENSION(:), INTENT(IN) :: RawConcData ! concentrations for raw data
REAL(r64), DIMENSION(:,:), INTENT(IN) :: RawPropData ! raw property data (concentration, temperature)
REAL(r64), INTENT(IN) :: Concentration ! concentration of actual fluid mix
REAL(r64), DIMENSION(:), INTENT(OUT) :: InterpData ! interpolated output data at proper concentration
! INTERFACE BLOCK SPECIFICATIONS:
! na
! DERIVED TYPE DEFINITIONS:
! na
! SUBROUTINE PARAMETER DEFINITIONS:
REAL(r64), PARAMETER :: ConcToler = 0.0001d0 ! Some reasonable value for comparisons
CHARACTER(len=*), PARAMETER :: RoutineName='InterpDefValuesForGlycolConc: '
! SUBROUTINE LOCAL VARIABLE DECLARATIONS:
INTEGER :: HiIndex ! index on the high side of the concentration
REAL(r64) :: InterpFrac ! intermediate value for interpolations
INTEGER :: LoopC ! loop counter for concentration
INTEGER :: LoopT ! loop counter for temperature
! FLOW:
! First, find where the actual concentration falls between the concentration data.
! Then, interpolate if necessary.
IF (Concentration < RawConcData(1)) THEN ! Concentration too low
CALL ShowWarningError(RoutineName//'Glycol concentration out of range for data (too low), concentration = '// &
TRIM(RoundSigDigits(Concentration,3)))
CALL ShowContinueError('Check your data or the definition of your glycols in the GlycolConcentrations input')
CALL ShowContinueError('Property data set to data for lowest concentration entered')
InterpData = RawPropData(1,:)
ELSE IF (Concentration > RawConcData(NumOfConcs)) THEN ! Concentration too high
CALL ShowWarningError(RoutineName//'Glycol concentration out of range for data (too high), concentration = '// &
TRIM(RoundSigDigits(Concentration,3)))
CALL ShowContinueError('Check your data or the definition of your glycols in the GlycolConcentrations input')
CALL ShowContinueError('Property data set to data for highest concentration entered')
InterpData = RawPropData(NumOfConcs,:)
ELSE ! Concentration somewhere between lowest and highest point--interpolate
HiIndex = NumOfConcs ! Default to highest concentration
DO LoopC = 2, NumOfConcs-1
IF (Concentration <= RawConcData(LoopC)) THEN
HiIndex = LoopC
EXIT ! LoopC DO loop
END IF
END DO
IF ( ABS(RawConcData(HiIndex)-RawConcData(HiIndex-1)) >= ConcToler ) THEN
InterpFrac = ( RawConcData(HiIndex) - Concentration ) / ( RawConcData(HiIndex) - RawConcData(HiIndex-1) )
DO LoopT = 1, NumOfTemps
IF ( (RawPropData(HiIndex,LoopT) < ConcToler) .OR. (RawPropData(HiIndex-1,LoopT) < ConcToler) ) THEN
! One of the two values is zero--so we cannot interpolate for this point (assign to zero)
InterpData(LoopT) = 0.0d0
ELSE
InterpData(LoopT) = RawPropData(HiIndex,LoopT) &
-( InterpFrac * (RawPropData(HiIndex,LoopT)-RawPropData(HiIndex-1,LoopT)) )
END IF
END DO
ELSE ! user has input data for concentrations that are too close or repeated, this must be fixed
CALL ShowFatalError(RoutineName//'concentration values too close or data repeated, ' &
//'check your fluid property input data')
END IF
END IF
RETURN
END SUBROUTINE InterpDefValuesForGlycolConc