Nodes of different colours represent the following:
Solid arrows point from a parent (sub)module to the submodule which is descended from it. Dashed arrows point from a module being used to the module or program unit using it. Where possible, edges connecting nodes are given different colours to make them easier to distinguish in large graphs.
Type | Intent | Optional | Attributes | Name | ||
---|---|---|---|---|---|---|
integer, | intent(in) | :: | CurveIndex | |||
real(kind=r64), | intent(in) | :: | Var1 | |||
real(kind=r64), | intent(in), | optional | :: | Var2 | ||
real(kind=r64), | intent(in), | optional | :: | Var3 | ||
real(kind=r64), | intent(in), | optional | :: | Var4 | ||
real(kind=r64), | intent(in), | optional | :: | Var5 |
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.
REAL(r64) FUNCTION TableLookupObject(CurveIndex,Var1,Var2,Var3,Var4,Var5) RESULT(TableValue)
! FUNCTION INFORMATION:
! AUTHOR Richard Raustad, FSEC
! DATE WRITTEN May 2010
! MODIFIED na
! RE-ENGINEERED na
! PURPOSE OF THIS FUNCTION:
! Given the curve index and the values of 1 or 2 independent variables,
! returns the value of an equipment performance table lookup.
! METHODOLOGY EMPLOYED:
! na
! REFERENCES:
! na
! USE STATEMENTS:
USE DataInterfaces, ONLY:ShowFatalError, ShowSevereError, ShowContinueError
IMPLICIT NONE ! Enforce explicit typing of all variables in this routine
! FUNCTION ARGUMENT DEFINITIONS:
INTEGER, INTENT (IN) :: CurveIndex ! index of curve in curve array
REAL(r64), INTENT (IN) :: Var1 ! 1st independent variable
REAL(r64), INTENT (IN), OPTIONAL :: Var2 ! 2nd independent variable
REAL(r64), INTENT (IN), OPTIONAL :: Var3 ! 3rd independent variable
REAL(r64), INTENT (IN), OPTIONAL :: Var4 ! 4th independent variable
REAL(r64), INTENT (IN), OPTIONAL :: Var5 ! 5th independent variable
! FUNCTION PARAMETER DEFINITIONS:
! na
! INTERFACE BLOCK SPECIFICATIONS
! na
! DERIVED TYPE DEFINITIONS
! na
! FUNCTION LOCAL VARIABLE DECLARATIONS:
REAL(r64) :: V1 ! 1st independent variable after limits imposed
REAL(r64) :: V2 ! 2nd independent variable after limits imposed
REAL(r64) :: V3 ! 3rd independent variable after limits imposed
REAL(r64) :: V4 ! 4th independent variable after limits imposed
REAL(r64) :: V5 ! 5th independent variable after limits imposed
INTEGER :: NX, NY, NV3, NV4, NV5
INTEGER :: TableIndex
!REAL(r64), ALLOCATABLE, DIMENSION(:) :: ONEDVALS
REAL(r64), ALLOCATABLE, DIMENSION(:,:) :: TWODVALS
REAL(r64), ALLOCATABLE, DIMENSION(:,:,:) :: THREEDVALS
REAL(r64), ALLOCATABLE, DIMENSION(:) :: VALSX, VALSY, VALSV3, VALSV4, VALSV5
!REAL(r64), ALLOCATABLE, DIMENSION(:,:,:) :: HPVAL
!REAL(r64), ALLOCATABLE, DIMENSION(:,:,:,:) :: HPVALS
!REAL(r64), ALLOCATABLE, DIMENSION(:,:,:,:,:) :: DVLTRN
!REAL(r64), ALLOCATABLE, DIMENSION(:,:,:,:,:) :: FiveDArray
!REAL(r64), ALLOCATABLE, DIMENSION(:,:,:,:) :: FourDArray
!REAL(r64), ALLOCATABLE, DIMENSION(:,:,:) :: ThreeDArray
!REAL(r64), ALLOCATABLE, DIMENSION(:,:) :: TwoDArray
!REAL(r64), ALLOCATABLE, DIMENSION(:) :: OneDArray
INTEGER :: IV3, IV4, IV5, IEXTX, IEXTY, IEXTV3, IEXTV4, IEXTV5, NUMPT
TableIndex = PerfCurve(CurveIndex)%TableIndex
V1 = MAX(MIN(Var1,PerfCurve(CurveIndex)%Var1Max),PerfCurve(CurveIndex)%Var1Min)
IF (PRESENT(Var2)) THEN
V2 = MAX(MIN(Var2,PerfCurve(CurveIndex)%Var2Max),PerfCurve(CurveIndex)%Var2Min)
IF(TableLookup(TableIndex)%NumIndependentVars .LT. 2)THEN
IF(PerfCurve(CurveIndex)%NumIVHighErrorIndex == 0)THEN
CALL ShowSevereError('TableLookupObject: '//TRIM(cCurveTypes(PerfCurve(CurveIndex)%ObjectType))// &
'" '//TRIM(PerfCurve(CurveIndex)%Name)//'"')
CALL ShowContinueError('...Excess number of independent variables (2) passed to subroutine '// &
'when only 1 is required.')
END IF
CALL ShowRecurringWarningErrorAtEnd(TRIM(cCurveTypes(PerfCurve(CurveIndex)%ObjectType))// &
' "'//TRIM(PerfCurve(CurveIndex)%Name)//'":'//&
' Excess number of independent variables warning continues...' &
, PerfCurve(CurveIndex)%NumIVHighErrorIndex, 2.0D0, 2.0D0)
END IF
ELSE
IF(TableLookup(TableIndex)%NumIndependentVars .GT. 1)THEN
IF(PerfCurve(CurveIndex)%NumIVLowErrorIndex == 0)THEN
CALL ShowSevereError('TableLookupObject: '//TRIM(cCurveTypes(PerfCurve(CurveIndex)%ObjectType))// &
'" '//TRIM(PerfCurve(CurveIndex)%Name)//'"')
CALL ShowContinueError('...Insufficient number of independent variables (1) passed to subroutine '// &
'when at least 2 are required.')
END IF
CALL ShowRecurringWarningErrorAtEnd(TRIM(cCurveTypes(PerfCurve(CurveIndex)%ObjectType))// &
' "'//TRIM(PerfCurve(CurveIndex)%Name)//'":'//&
' Insufficient number of independent variables warning continues...' &
, PerfCurve(CurveIndex)%NumIVLowErrorIndex, 1.0D0, 1.0D0)
END IF
V2 = 0.0d0
END IF
IF (PRESENT(Var3)) THEN
V3 = MAX(MIN(Var3,PerfCurve(CurveIndex)%Var3Max),PerfCurve(CurveIndex)%Var3Min)
IF(TableLookup(TableIndex)%NumIndependentVars .LT. 3)THEN
IF(PerfCurve(CurveIndex)%NumIVHighErrorIndex == 0)THEN
CALL ShowSevereError('TableLookupObject: '//TRIM(cCurveTypes(PerfCurve(CurveIndex)%ObjectType))// &
'" '//TRIM(PerfCurve(CurveIndex)%Name)//'"')
CALL ShowContinueError('...Excess number of independent variables (3) passed to subroutine '// &
'when 2 or less are required.')
END IF
CALL ShowRecurringWarningErrorAtEnd(TRIM(cCurveTypes(PerfCurve(CurveIndex)%ObjectType))// &
' "'//TRIM(PerfCurve(CurveIndex)%Name)//'":'//&
' Excess number of independent variables warning continues...' &
, PerfCurve(CurveIndex)%NumIVHighErrorIndex, 3.0D0, 3.0D0)
END IF
ELSE
IF(TableLookup(TableIndex)%NumIndependentVars .GT. 2)THEN
IF(PerfCurve(CurveIndex)%NumIVLowErrorIndex == 0)THEN
CALL ShowSevereError('TableLookupObject: '//TRIM(cCurveTypes(PerfCurve(CurveIndex)%ObjectType))// &
'" '//TRIM(PerfCurve(CurveIndex)%Name)//'"')
CALL ShowContinueError('...Insufficient number of independent variables (2) passed to subroutine '// &
'when at least 3 are required.')
END IF
CALL ShowRecurringWarningErrorAtEnd(TRIM(cCurveTypes(PerfCurve(CurveIndex)%ObjectType))// &
' "'//TRIM(PerfCurve(CurveIndex)%Name)//'":'//&
' Insufficient number of independent variables warning continues...' &
, PerfCurve(CurveIndex)%NumIVLowErrorIndex, 2.0D0, 2.0D0)
END IF
V3 = 0.0d0
END IF
IF (PRESENT(Var4)) THEN
V4 = MAX(MIN(Var4,PerfCurve(CurveIndex)%Var4Max),PerfCurve(CurveIndex)%Var4Min)
IF(TableLookup(TableIndex)%NumIndependentVars .LT. 4)THEN
IF(PerfCurve(CurveIndex)%NumIVHighErrorIndex == 0)THEN
CALL ShowSevereError('TableLookupObject: '//TRIM(cCurveTypes(PerfCurve(CurveIndex)%ObjectType))// &
'" '//TRIM(PerfCurve(CurveIndex)%Name)//'"')
CALL ShowContinueError('...Excess number of independent variables (4) passed to subroutine '// &
'when 3 or less are required.')
END IF
CALL ShowRecurringWarningErrorAtEnd(TRIM(cCurveTypes(PerfCurve(CurveIndex)%ObjectType))// &
' "'//TRIM(PerfCurve(CurveIndex)%Name)//'":'//&
' Excess number of independent variables warning continues...' &
, PerfCurve(CurveIndex)%NumIVHighErrorIndex, 4.0D0, 4.0D0)
END IF
ELSE
IF(TableLookup(TableIndex)%NumIndependentVars .GT. 3)THEN
IF(PerfCurve(CurveIndex)%NumIVLowErrorIndex == 0)THEN
CALL ShowSevereError('TableLookupObject: '//TRIM(cCurveTypes(PerfCurve(CurveIndex)%ObjectType))// &
'" '//TRIM(PerfCurve(CurveIndex)%Name)//'"')
CALL ShowContinueError('...Insufficient number of independent variables (3) passed to subroutine '// &
'when at least 4 are required.')
END IF
CALL ShowRecurringWarningErrorAtEnd(TRIM(cCurveTypes(PerfCurve(CurveIndex)%ObjectType))// &
' "'//TRIM(PerfCurve(CurveIndex)%Name)//'":'//&
' Insufficient number of independent variables warning continues...' &
, PerfCurve(CurveIndex)%NumIVLowErrorIndex, 3.0D0, 3.0D0)
END IF
V4 = 0.0d0
END IF
IF (PRESENT(Var5)) THEN
V5 = MAX(MIN(Var5,PerfCurve(CurveIndex)%Var5Max),PerfCurve(CurveIndex)%Var5Min)
IF(TableLookup(TableIndex)%NumIndependentVars .LT. 5)THEN
IF(PerfCurve(CurveIndex)%NumIVHighErrorIndex == 0)THEN
CALL ShowSevereError('TableLookupObject: '//TRIM(cCurveTypes(PerfCurve(CurveIndex)%ObjectType))// &
'" '//TRIM(PerfCurve(CurveIndex)%Name)//'"')
CALL ShowContinueError('...Excess number of independent variables (5) passed to subroutine '// &
'when 4 or less are required.')
END IF
CALL ShowRecurringWarningErrorAtEnd(TRIM(cCurveTypes(PerfCurve(CurveIndex)%ObjectType))// &
' "'//TRIM(PerfCurve(CurveIndex)%Name)//'":'//&
' Excess number of independent variables warning continues...' &
, PerfCurve(CurveIndex)%NumIVHighErrorIndex, 5.0D0, 5.0D0)
END IF
ELSE
IF(TableLookup(TableIndex)%NumIndependentVars .GT. 4)THEN
IF(PerfCurve(CurveIndex)%NumIVLowErrorIndex == 0)THEN
CALL ShowSevereError('TableLookupObject: '//TRIM(cCurveTypes(PerfCurve(CurveIndex)%ObjectType))// &
'" '//TRIM(PerfCurve(CurveIndex)%Name)//'"')
CALL ShowContinueError('...Insufficient number of independent variables (4) passed to subroutine '// &
'when at least 5 are required.')
END IF
CALL ShowRecurringWarningErrorAtEnd(TRIM(cCurveTypes(PerfCurve(CurveIndex)%ObjectType))// &
' "'//TRIM(PerfCurve(CurveIndex)%Name)//'":'//&
' Insufficient number of independent variables warning continues...' &
, PerfCurve(CurveIndex)%NumIVLowErrorIndex, 4.0D0, 4.0D0)
END IF
V5 = 0.0d0
END IF
SELECT CASE(TableLookup(TableIndex)%NumIndependentVars)
CASE(1)
NX=TableLookup(TableIndex)%NumX1Vars
NY=1
NUMPT=TableLookup(TableIndex)%InterpolationOrder
ALLOCATE(VALSX(NX))
VALSX = TableLookup(TableIndex)%X1Var
TableValue = DLAG(V1,VALSX(1),VALSX,VALSX, &
TableLookup(TableIndex)%TableLookupZData(:,:,1,1,1),NX,NY,NUMPT,IEXTX,IEXTY)
DEALLOCATE(VALSX)
CASE(2)
NX=TableLookup(TableIndex)%NumX1Vars
NY=TableLookup(TableIndex)%NumX2Vars
NUMPT=TableLookup(TableIndex)%InterpolationOrder
ALLOCATE(VALSX(NX))
VALSX = TableLookup(TableIndex)%X1Var
ALLOCATE(VALSY(NY))
VALSY = TableLookup(TableIndex)%X2Var
TableValue = DLAG(V1,V2,VALSX,VALSY, &
TableLookup(TableIndex)%TableLookupZData(:,:,1,1,1),NX,NY,NUMPT,IEXTX,IEXTY)
DEALLOCATE(VALSX)
DEALLOCATE(VALSY)
CASE(3)
NX=TableLookup(TableIndex)%NumX1Vars
NY=TableLookup(TableIndex)%NumX2Vars
NV3=TableLookup(TableIndex)%NumX3Vars
NUMPT=TableLookup(TableIndex)%InterpolationOrder
ALLOCATE(VALSX(NX))
VALSX = TableLookup(TableIndex)%X1Var
ALLOCATE(VALSY(NY))
VALSY = TableLookup(TableIndex)%X2Var
ALLOCATE(VALSV3(NV3))
VALSV3 = TableLookup(TableIndex)%X3Var
ALLOCATE(TWODVALS(NV3,1))
! perform 2-D interpolation of X (V1) and Y (V2) and save in 2-D array
DO IV3=1,NV3
TWODVALS(IV3,1) = DLAG(V1,V2,VALSX,VALSY, &
TableLookup(TableIndex)%TableLookupZData(:,:,IV3,1,1),NX,NY,NUMPT,IEXTX,IEXTY)
END DO
IF(NV3 .EQ. 1)THEN
TableValue = TWODVALS(1,1)
ELSE
TableValue = DLAG(V3,1.0D0,VALSV3,VALSV3,TWODVALS,NV3,1,NUMPT,IEXTV3,IEXTV4)
END IF
DEALLOCATE(TWODVALS)
DEALLOCATE(VALSX)
DEALLOCATE(VALSY)
DEALLOCATE(VALSV3)
CASE(4)
NX=TableLookup(TableIndex)%NumX1Vars
NY=TableLookup(TableIndex)%NumX2Vars
NV3=TableLookup(TableIndex)%NumX3Vars
NV4=TableLookup(TableIndex)%NumX4Vars
NUMPT=TableLookup(TableIndex)%InterpolationOrder
ALLOCATE(VALSX(NX))
VALSX = TableLookup(TableIndex)%X1Var
ALLOCATE(VALSY(NY))
VALSY = TableLookup(TableIndex)%X2Var
ALLOCATE(VALSV3(NV3))
VALSV3 = TableLookup(TableIndex)%X3Var
ALLOCATE(VALSV4(NV4))
VALSV4 = TableLookup(TableIndex)%X4Var
ALLOCATE(TWODVALS(NV3,NV4))
! perform 2-D interpolation of X (V1) and Y (V2) and save in 2-D array
DO IV4=1,NV4
DO IV3=1,NV3
TWODVALS(IV3,IV4) = DLAG(V1,V2,VALSX,VALSY, &
TableLookup(TableIndex)%TableLookupZData(:,:,IV3,IV4,1),NX,NY,NUMPT,IEXTX,IEXTY)
END DO
END DO
! final interpolation of 2-D array in V3 and V4
TableValue = DLAG(V3,V4,VALSV3,VALSV4,TWODVALS,NV3,NV4,NUMPT,IEXTV3,IEXTV4)
DEALLOCATE(TWODVALS)
DEALLOCATE(VALSX)
DEALLOCATE(VALSY)
DEALLOCATE(VALSV3)
DEALLOCATE(VALSV4)
CASE(5)
NX=TableLookup(TableIndex)%NumX1Vars
NY=TableLookup(TableIndex)%NumX2Vars
NV3=TableLookup(TableIndex)%NumX3Vars
NV4=TableLookup(TableIndex)%NumX4Vars
NV5=TableLookup(TableIndex)%NumX5Vars
NUMPT=TableLookup(TableIndex)%InterpolationOrder
ALLOCATE(VALSX(NX))
VALSX = TableLookup(TableIndex)%X1Var
ALLOCATE(VALSY(NY))
VALSY = TableLookup(TableIndex)%X2Var
ALLOCATE(VALSV3(NV3))
VALSV3 = TableLookup(TableIndex)%X3Var
ALLOCATE(VALSV4(NV4))
VALSV4 = TableLookup(TableIndex)%X4Var
ALLOCATE(VALSV5(NV5))
VALSV5 = TableLookup(TableIndex)%X5Var
ALLOCATE(THREEDVALS(NV3,NV4,NV5))
DO IV5=1,NV5
DO IV4=1,NV4
DO IV3=1,NV3
THREEDVALS(IV3,IV4,IV5) = DLAG(V1,V2,VALSX,VALSY, &
TableLookup(TableIndex)%TableLookupZData(:,:,IV3,IV4,IV5),NX,NY,NUMPT,IEXTX,IEXTY)
END DO
END DO
END DO
ALLOCATE(TWODVALS(NV5,1))
DO IV5=1,NV5
TWODVALS(IV5,1) = DLAG(V3,V4,VALSV3,VALSV4,THREEDVALS(:,:,IV5),NV3,NV4,NUMPT,IEXTX,IEXTY)
END DO
IF(NV5 .EQ. 1)THEN
TableValue = TWODVALS(1,1)
ELSE
TableValue = DLAG(V5,1.0D0,VALSV5,VALSV5,TWODVALS,NV5,1,NUMPT,IEXTV5,IEXTV4)
END IF
DEALLOCATE(TWODVALS)
DEALLOCATE(THREEDVALS)
DEALLOCATE(VALSX)
DEALLOCATE(VALSY)
DEALLOCATE(VALSV3)
DEALLOCATE(VALSV4)
DEALLOCATE(VALSV5)
CASE DEFAULT
TableValue = 0.0D0
CALL ShowSevereError('Errors found in table output calculation for '//TRIM(PerfCurve(CurveIndex)%Name))
CALL ShowContinueError('...Possible causes are selection of Interpolation Method or Type or Number' // &
' of Independent Variables or Points.')
CALL ShowFatalError('PerformanceTableObject: Previous error causes program termination.')
END SELECT
IF(PerfCurve(CurveIndex)%CurveMinPresent) TableValue = MAX(TableValue , PerfCurve(CurveIndex)%CurveMin)
IF(PerfCurve(CurveIndex)%CurveMaxPresent) TableValue = MIN(TableValue , PerfCurve(CurveIndex)%CurveMax)
RETURN
END FUNCTION TableLookupObject