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) | :: | ExpressionNum |
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.
RECURSIVE FUNCTION EvaluateExpression(ExpressionNum) RESULT(ReturnValue)
! FUNCTION INFORMATION:
! AUTHOR Peter Graham Ellis
! DATE WRITTEN June 2006
! MODIFIED Brent Griffith, May 2009
! RE-ENGINEERED na
! PURPOSE OF THIS FUNCTION:
! Evaluates an expression.
! METHODOLOGY EMPLOYED:
!USE, INTRINSIC :: IEEE_ARITHMETIC, ONLY : IEEE_IS_NAN ! Use IEEE_IS_NAN when GFortran supports it
USE DataGlobals, ONLY: DegToRadians !unused, TimeStepZone
USE DataInterfaces, ONLY: ShowFatalError, ShowContinueErrorTimeStamp, &
ShowSevereError, ShowWarningError
USE Psychrometrics
USE General, ONLY: TrimSigDigits, RoundSigDigits
USE CurveManager, ONLY: CurveValue
IMPLICIT NONE ! Enforce explicit typing of all variables in this routine
! FUNCTION ARGUMENT DEFINITIONS:
INTEGER, INTENT(IN) :: ExpressionNum
TYPE(ErlValueType) :: ReturnValue
! FUNCTION LOCAL VARIABLE DECLARATIONS:
INTEGER :: thisTrend ! local temporary
INTEGER :: thisIndex ! local temporary
REAL(r64) :: thisAverage ! local temporary
INTEGER :: loop ! local temporary
REAL(r64) :: thisSlope ! local temporary
REAL(r64) :: thisMax ! local temporary
REAL(r64) :: thisMin ! local temporary
INTEGER :: OperandNum
CHARACTER(len = 1) :: SeedElementChar
INTEGER :: SeedElementInt
INTEGER :: SeedN ! number of digits in the number used to seed the generator
CHARACTER(len=MaxNameLength) :: SeedChar ! local temporary for random seed
INTEGER, DIMENSION(:), ALLOCATABLE :: SeedIntARR ! local temporary for random seed
INTEGER :: Pos ! local temporary for string position.
REAL(r64) :: tmpRANDU1 ! local temporary for uniform random number
REAL(r64) :: tmpRANDU2 ! local temporary for uniform random number
REAL(r64) :: tmpRANDG ! local temporary for gaussian random number
REAL(r64) :: UnitCircleTest ! local temporary for Box-Muller algo
REAL(R64) :: TestValue ! local temporary
TYPE(ErlValueType), ALLOCATABLE, DIMENSION(:) :: Operand
! FLOW:
ReturnValue%Type = ValueNumber
ReturnValue%Number = 0.0d0
IF (ExpressionNum > 0) THEN
! is there a way to keep these and not allocate and deallocate all the time?
ALLOCATE(Operand(ErlExpression(ExpressionNum)%NumOperands))
! Reduce operands down to literals
DO OperandNum = 1, ErlExpression(ExpressionNum)%NumOperands
Operand(OperandNum) = ErlExpression(ExpressionNum)%Operand(OperandNum)
IF (Operand(OperandNum)%Type == ValueExpression) THEN
Operand(OperandNum) = EvaluateExpression(Operand(OperandNum)%Expression) !recursive call
ELSE IF (Operand(OperandNum)%Type == ValueVariable) THEN
Operand(OperandNum) = ErlVariable(Operand(OperandNum)%Variable)%Value
END IF
END DO
! Perform the operation
SELECT CASE (ErlExpression(ExpressionNum)%Operator)
CASE (OperatorLiteral)
ReturnValue = Operand(1)
CASE (OperatorNegative) ! unary minus sign. parsing does not work yet
ReturnValue = SetErlValueNumber(-1.0D0 * Operand(1)%Number)
CASE (OperatorDivide)
IF ((Operand(1)%Type == ValueNumber) .AND. (Operand(2)%Type == ValueNumber)) THEN
IF (Operand(2)%Number == 0.0d0) THEN
ReturnValue%Type = ValueError
ReturnValue%Error = 'Divide by zero!'
ELSE
ReturnValue = SetErlValueNumber(Operand(1)%Number / Operand(2)%Number)
END IF
END IF
CASE (OperatorMultiply)
IF ((Operand(1)%Type == ValueNumber) .AND. (Operand(2)%Type == ValueNumber)) THEN
ReturnValue = SetErlValueNumber(Operand(1)%Number * Operand(2)%Number)
END IF
CASE (OperatorSubtract)
IF ((Operand(1)%Type == ValueNumber) .AND. (Operand(2)%Type == ValueNumber)) THEN
ReturnValue = SetErlValueNumber(Operand(1)%Number - Operand(2)%Number)
END IF
CASE (OperatorAdd)
IF ((Operand(1)%Type == ValueNumber) .AND. (Operand(2)%Type == ValueNumber)) THEN
ReturnValue = SetErlValueNumber(Operand(1)%Number + Operand(2)%Number)
END IF
CASE (OperatorEqual)
IF (Operand(1)%Type == Operand(2)%Type) THEN
IF (Operand(1)%Type == ValueNull) THEN
ReturnValue = True
ELSE IF ((Operand(1)%Type == ValueNumber) .AND. (Operand(1)%Number == Operand(2)%Number)) THEN
ReturnValue = True
ELSE
ReturnValue = False
END IF
ELSE
ReturnValue = False
END IF
CASE (OperatorNotEqual)
IF ((Operand(1)%Type == ValueNumber) .AND. (Operand(2)%Type == ValueNumber)) THEN
IF (Operand(1)%Number /= Operand(2)%Number) Then
ReturnValue = True
ELSE
ReturnValue = False
ENDIF
ENDIF
CASE (OperatorLessOrEqual)
IF ((Operand(1)%Type == ValueNumber) .AND. (Operand(2)%Type == ValueNumber)) THEN
IF (Operand(1)%Number <= Operand(2)%Number) Then
ReturnValue = True
ELSE
ReturnValue = False
ENDIF
ENDIF
CASE (OperatorGreaterOrEqual)
IF ((Operand(1)%Type == ValueNumber) .AND. (Operand(2)%Type == ValueNumber)) THEN
IF (Operand(1)%Number >= Operand(2)%Number) Then
ReturnValue = True
ELSE
ReturnValue = False
ENDIF
ENDIF
CASE (OperatorLessThan)
IF ((Operand(1)%Type == ValueNumber) .AND. (Operand(2)%Type == ValueNumber)) THEN
IF (Operand(1)%Number < Operand(2)%Number) Then
ReturnValue = True
ELSE
ReturnValue = False
ENDIF
ENDIF
CASE (OperatorGreaterThan)
IF ((Operand(1)%Type == ValueNumber) .AND. (Operand(2)%Type == ValueNumber)) THEN
IF (Operand(1)%Number > Operand(2)%Number) Then
ReturnValue = True
ELSE
ReturnValue = False
ENDIF
ENDIF
CASE (OperatorRaiseToPower)
IF ((Operand(1)%Type == ValueNumber) .AND. (Operand(2)%Type == ValueNumber)) THEN
TestValue = Operand(1)%Number**Operand(2)%Number
IF (TestValue /= TestValue) THEN ! Use IEEE_IS_NAN when GFortran supports it
! throw Error
ReturnValue%Type = ValueError
ReturnValue%Error = 'Attempted to raise to power with incompatible numbers: ' &
//TRIM(TrimSigDigits(Operand(1)%Number, 6))//' raised to ' &
//TRIM(TrimSigDigits(Operand(2)%Number, 6))
ELSE
ReturnValue = SetErlValueNumber(TestValue)
ENDIF
ENDIF
CASE (OperatorLogicalAND)
IF ((Operand(1)%Type == ValueNumber) .AND. (Operand(2)%Type == ValueNumber)) THEN
IF ((Operand(1)%Number == True%Number) .AND. (Operand(2)%Number == True%Number)) THEN
ReturnValue = True
ELSE
ReturnValue = False
ENDIF
ENDIF
CASE (OperatiorLogicalOR)
IF ((Operand(1)%Type == ValueNumber) .AND. (Operand(2)%Type == ValueNumber)) THEN
IF ((Operand(1)%Number == True%Number) .OR. (Operand(2)%Number == True%Number)) THEN
ReturnValue = True
ELSE
ReturnValue = False
ENDIF
ENDIF
CASE (FuncRound)
ReturnValue = SetErlValueNumber(DNINT(Operand(1)%Number))
CASE (FuncMod)
ReturnValue = SetErlValueNumber(MOD(Operand(1)%Number, Operand(2)%Number))
CASE (FuncSin)
ReturnValue = SetErlValueNumber(SIN(Operand(1)%Number))
CASE (FuncCos)
ReturnValue = SetErlValueNumber(COS(Operand(1)%Number))
CASE (FuncArcSin)
ReturnValue = SetErlValueNumber(ASIN(Operand(1)%Number))
CASE (FuncArcCos)
ReturnValue = SetErlValueNumber(ACOS(Operand(1)%Number))
CASE (FuncDegToRad)
ReturnValue = SetErlValueNumber(Operand(1)%Number * DegToRadians)
CASE (FuncRadToDeg)
ReturnValue = SetErlValueNumber(Operand(1)%Number / DegToRadians)
CASE (FuncExp)
IF (Operand(1)%Number < 700.0D0) THEN
ReturnValue = SetErlValueNumber(EXP(Operand(1)%Number))
ELSE
! throw Error
ReturnValue%Type = ValueError
ReturnValue%Error = 'Attempted to calculate exponential value of too large a number: ' &
//Trim(TrimSigDigits(Operand(1)%Number, 4))
ENDIF
CASE (FuncLn)
IF (Operand(1)%Number > 0.0D0 ) THEN
ReturnValue = SetErlValueNumber(LOG(Operand(1)%Number))
ELSE
! throw error,
ReturnValue%Type = ValueError
ReturnValue%Error = 'Natural Log of zero or less!'
ENDIF
CASE (FuncMax)
ReturnValue = SetErlValueNumber(MAX(Operand(1)%Number, Operand(2)%Number))
CASE (FuncMin)
ReturnValue = SetErlValueNumber(MIN(Operand(1)%Number, Operand(2)%Number))
CASE (FuncABS)
ReturnValue = SetErlValueNumber(ABS(Operand(1)%Number))
CASE (FuncRandU)
CALL RANDOM_NUMBER(tmpRANDU1 )
tmpRANDU1 = Operand(1)%Number + (Operand(2)%Number - Operand(1)%Number) * tmpRANDU1
ReturnValue = SetErlValueNumber(tmpRANDU1)
CASE (FuncRandG)
DO ! Box-Muller algorithm
CALL RANDOM_NUMBER( tmpRANDU1 )
CALL RANDOM_NUMBER( tmpRANDU2 )
tmpRANDU1 = 2.d0*tmpRANDU1 - 1.d0
tmpRANDU2 = 2.d0*tmpRANDU2 - 1.d0
UnitCircleTest = tmpRANDU1**2 + tmpRANDU2**2
IF (UnitCircleTest > 0.d0 .AND. UnitCircleTest < 1.0d0) EXIT
ENDDO
tmpRANDG = SQRT(-2.d0 * LOG(UnitCircleTest)/UnitCircleTest)
tmpRANDG = tmpRANDG * tmpRANDU1 ! standard normal ran
! x = ran * sigma + mean
tmpRANDG = tmpRANDG * Operand(2)%Number + Operand(1)%Number
tmpRANDG = MAX(tmpRANDG, Operand(3)%Number) ! min limit
tmpRANDG = MIN(tmpRANDG, Operand(4)%Number) ! max limit
ReturnValue = SetErlValueNumber(tmpRANDG)
CASE (FuncRandSeed)
! convert arg to an integer array for the seed.
CALL RANDOM_SEED(size = SeedN) ! obtains processor's use size as output
ALLOCATE(SeedIntARR(SeedN))
Do loop = 1, SeedN
IF (loop == 1) THEN
SeedIntARR(loop) = FLOOR(Operand(1)%Number,i64)
ELSE
SeedIntARR(loop) = FLOOR(Operand(1)%Number,i64)*loop
ENDIF
ENDDO
CALL RANDOM_SEED(put = SeedIntARR)
ReturnValue = SetErlValueNumber(REAL(SeedIntARR(1),r64)) !just return first number pass as seed
DEALLOCATE(SeedIntARR)
CASE (FuncRhoAirFnPbTdbW)
ReturnValue = SetErlValueNumber( & ! result => density of moist air (kg/m3)
PsyRhoAirFnPbTdbW(Operand(1)%Number, & ! pressure (Pa)
Operand(2)%Number, & ! drybulb (C)
Operand(3)%Number, & ! Humidity ratio (kg water vapor/kg dry air)
'EMS Built-In Function') ) ! called from
CASE (FuncCpAirFnWTdb)
ReturnValue = SetErlValueNumber( & ! result => heat capacity of air {J/kg-C}
PsyCpAirFnWTdb(Operand(1)%Number, & ! Humidity ratio (kg water vapor/kg dry air)
Operand(2)%Number, & ! drybulb (C)
'EMS Built-In Function') )
CASE (FuncHfgAirFnWTdb)
!BG comment these two psych funct seems confusing (?) is this the enthalpy of water in the air?
ReturnValue = SetErlValueNumber( & ! result => heat of vaporization for moist air {J/kg}
PsyHfgAirFnWTdb(Operand(1)%Number, & ! Humidity ratio (kg water vapor/kg dry air)
Operand(2)%Number, & ! drybulb (C)
'EMS Built-In Function') )
CASE (FuncHgAirFnWTdb)
! confusing ? seems like this is really classical Hfg, heat of vaporization
ReturnValue = SetErlValueNumber( & ! result => enthalpy of the gas {units?}
PsyHgAirFnWTdb(Operand(1)%Number, & ! Humidity ratio (kg water vapor/kg dry air)
Operand(2)%Number, & ! drybulb (C)
'EMS Built-In Function') )
CASE (FuncTdpFnTdbTwbPb)
ReturnValue = SetErlValueNumber( & ! result => dew-point temperature {C}
PsyTdpFnTdbTwbPb(Operand(1)%Number, & ! drybulb (C)
Operand(2)%Number, & ! wetbulb (C)
Operand(3)%Number, & ! pressure (Pa)
'EMS Built-In Function') )
CASE (FuncTdpFnWPb)
ReturnValue = SetErlValueNumber( & ! result => dew-point temperature {C}
PsyTdpFnWPb( Operand(1)%Number, & ! Humidity ratio (kg water vapor/kg dry air)
Operand(2)%Number, & ! pressure (Pa)
'EMS Built-In Function') )
CASE (FuncHFnTdbW)
ReturnValue = SetErlValueNumber( & ! result => enthalpy (J/kg)
PsyHFnTdbW(Operand(1)%Number, & ! drybulb (C)
Operand(2)%Number, & ! Humidity ratio (kg water vapor/kg dry air)
'EMS Built-In Function') )
CASE (FuncHFnTdbRhPb)
ReturnValue = SetErlValueNumber( & ! result => enthalpy (J/kg)
PsyHFnTdbRhPb(Operand(1)%Number, & ! drybulb (C)
Operand(2)%Number, & ! relative humidity value (0.0 - 1.0)
Operand(3)%Number, & ! pressure (Pa)
'EMS Built-In Function') )
CASE (FuncTdbFnHW)
ReturnValue = SetErlValueNumber( & ! result => dry-bulb temperature {C}
PsyTdbFnHW(Operand(1)%Number, & ! enthalpy (J/kg)
Operand(2)%Number, & ! Humidity ratio (kg water vapor/kg dry air)
'EMS Built-In Function') )
CASE (FuncRhovFnTdbRh)
ReturnValue = SetErlValueNumber( & ! result => Vapor density in air (kg/m3)
PsyRhovFnTdbRh(Operand(1)%Number, & ! drybulb (C)
Operand(2)%Number, & ! relative humidity value (0.0 - 1.0)
'EMS Built-In Function') )
CASE (FuncRhovFnTdbRhLBnd0C)
ReturnValue = SetErlValueNumber( & ! result => Vapor density in air (kg/m3)
PsyRhovFnTdbRhLBnd0C(Operand(1)%Number, & ! drybulb (C)
Operand(2)%Number, & ! relative humidity value (0.0 - 1.0)
'EMS Built-In Function') )
CASE (FuncRhovFnTdbWPb)
ReturnValue = SetErlValueNumber( & ! result => Vapor density in air (kg/m3)
PsyRhovFnTdbWPb(Operand(1)%Number, & ! drybulb (C)
Operand(2)%Number, & ! Humidity ratio (kg water vapor/kg dry air)
Operand(3)%Number, & ! pressure (Pa)
'EMS Built-In Function') )
CASE (FuncRhFnTdbRhov)
ReturnValue = SetErlValueNumber( & ! result => relative humidity value (0.0-1.0)
PsyRhFnTdbRhov(Operand(1)%Number, & ! drybulb (C)
Operand(2)%Number, & ! vapor density in air (kg/m3)
'EMS Built-In Function') )
CASE (FuncRhFnTdbRhovLBnd0C)
ReturnValue = SetErlValueNumber( & ! relative humidity value (0.0-1.0)
PsyRhFnTdbRhovLBnd0C(Operand(1)%Number, & ! drybulb (C)
Operand(2)%Number, & ! vapor density in air (kg/m3)
'EMS Built-In Function') )
CASE (FuncRhFnTdbWPb)
ReturnValue = SetErlValueNumber( & ! result => relative humidity value (0.0-1.0)
PsyRhFnTdbWPb(Operand(1)%Number, & ! drybulb (C)
Operand(2)%Number, & ! Humidity ratio (kg water vapor/kg dry air)
Operand(3)%Number, & ! pressure (Pa)
'EMS Built-In Function') )
CASE (FuncTwbFnTdbWPb)
ReturnValue = SetErlValueNumber( & ! result=> Temperature Wet-Bulb {C}
PsyTwbFnTdbWPb(Operand(1)%Number, & ! drybulb (C)
Operand(2)%Number, & ! Humidity ratio (kg water vapor/kg dry air)
Operand(3)%Number, & ! pressure (Pa)
'EMS Built-In Function') )
CASE (FuncVFnTdbWPb)
ReturnValue = SetErlValueNumber( & ! result=> specific volume {m3/kg}
PsyVFnTdbWPb(Operand(1)%Number, & ! drybulb (C)
Operand(2)%Number, & ! Humidity ratio (kg water vapor/kg dry air)
Operand(3)%Number, & ! pressure (Pa)
'EMS Built-In Function') )
CASE (FuncWFnTdpPb)
ReturnValue = SetErlValueNumber( & ! result=> humidity ratio (kg water vapor/kg dry air)
PsyWFnTdpPb(Operand(1)%Number, & ! dew point temperature (C)
Operand(2)%Number, & ! pressure (Pa)
'EMS Built-In Function') )
CASE (FuncWFnTdbH)
ReturnValue = SetErlValueNumber( & ! result=> humidity ratio (kg water vapor/kg dry air)
PsyWFnTdbH(Operand(1)%Number, & ! drybulb (C)
Operand(2)%Number, & ! enthalpy (J/kg)
'EMS Built-In Function') )
CASE (FuncWFnTdbTwbPb)
ReturnValue = SetErlValueNumber( & ! result=> humidity ratio (kg water vapor/kg dry air)
PsyWFnTdbTwbPb(Operand(1)%Number, & ! drybulb (C)
Operand(2)%Number, & ! wet-bulb temperature {C}
Operand(3)%Number, & ! pressure (Pa)
'EMS Built-In Function') )
CASE (FuncWFnTdbRhPb)
ReturnValue = SetErlValueNumber( & ! result=> humidity ratio (kg water vapor/kg dry air)
PsyWFnTdbRhPb(Operand(1)%Number, & ! drybulb (C)
Operand(2)%Number, & ! relative humidity value (0.0-1.0)
Operand(3)%Number, & ! pressure (Pa)
'EMS Built-In Function') )
CASE (FuncPsatFnTemp)
ReturnValue = SetErlValueNumber( & ! result=> saturation pressure {Pascals}
PsyPsatFnTemp(Operand(1)%Number, & ! drybulb (C)
'EMS Built-In Function') )
CASE (FuncTsatFnHPb)
ReturnValue = SetErlValueNumber( & ! result=> saturation temperature {C}
PsyTsatFnHPb(Operand(1)%Number, & ! enthalpy {J/kg}
Operand(2)%Number, & ! pressure (Pa)
'EMS Built-In Function') )
! CASE (FuncTsatFnPb)
! ReturnValue = NumberValue( & ! result=> saturation temperature {C}
! PsyTsatFnPb(Operand(1)%Number, & ! pressure (Pa)
! 'EMS Built-In Function') )
CASE (FuncCpCW)
ReturnValue = SetErlValueNumber( & ! result => specific heat of water (J/kg-K) = 4180.d0
CPCW(Operand(1)%Number, & ! temperature (C) unused
'EMS Built-In Function') )
CASE (FuncCpHW)
ReturnValue = SetErlValueNumber( & ! result => specific heat of water (J/kg-K) = 4180.d0
CPHW(Operand(1)%Number, & ! temperature (C) unused
'EMS Built-In Function') )
CASE (FuncRhoH2O)
ReturnValue = SetErlValueNumber( & ! result => density of water (kg/m3)
RhoH2O(Operand(1)%Number, & ! temperature (C)
'EMS Built-In Function') )
CASE (FuncFatalHaltEp)
CALL ShowSevereError('EMS user program found serious problem and is halting simulation')
CALL ShowContinueErrorTimeStamp(' ')
CALL ShowFatalError('EMS user program halted simulation with error code = ' &
//Trim(TrimSigDigits(Operand(1)%Number,2 ) ) )
ReturnValue = SetErlValueNumber(Operand(1)%Number) ! returns back the error code
CASE (FuncSevereWarnEp)
CALL ShowSevereError('EMS user program issued severe warning with error code = ' &
//Trim(TrimSigDigits(Operand(1)%Number,2 ) ) )
CALL ShowContinueErrorTimeStamp(' ')
ReturnValue = SetErlValueNumber(Operand(1)%Number) ! returns back the error code
CASE (FuncWarnEp)
CALL ShowWarningError('EMS user program issued warning with error code = ' &
//Trim(TrimSigDigits(Operand(1)%Number,2 ) ) )
CALL ShowContinueErrorTimeStamp(' ')
ReturnValue = SetErlValueNumber(Operand(1)%Number) ! returns back the error code
CASE (FuncTrendValue)
! find TrendVariable , first operand is ErlVariable
If (Operand(1)%TrendVariable) THEN
thisTrend = Operand(1)%TrendVarPointer
!second operand is number for index
thisIndex = FLOOR(Operand(2)%Number)
IF (thisIndex >= 1) THEN
IF (thisIndex <= TrendVariable(thisTrend)%LogDepth) THEN
ReturnValue = SetErlValueNumber(TrendVariable(thisTrend)%TrendValARR(thisIndex), Operand(1))
ELSE
ReturnValue%Type = ValueError
ReturnValue%Error = 'Built-in trend function called with index larger than what is being logged'
ENDIF
ELSE
ReturnValue%Type = ValueError
ReturnValue%Error = 'Built-in trend function called with index less than 1'
ENDIF
ELSE !not registered as a trend variable
ReturnValue%Type = ValueError
ReturnValue%Error = 'Variable used with built-in trend function is not associated with a registered trend variable'
ENDIF
CASE (FuncTrendAverage)
! find TrendVariable , first operand is ErlVariable
IF (Operand(1)%TrendVariable) THEN
thisTrend = Operand(1)%TrendVarPointer
thisIndex = FLOOR(Operand(2)%Number)
IF (thisIndex >= 1) THEN
IF (thisIndex <= TrendVariable(thisTrend)%LogDepth) THEN
!calculate average
thisAverage = SUM(TrendVariable(thisTrend)%TrendValARR(1:thisIndex)) &
/ REAL(thisIndex, r64)
ReturnValue = SetErlValueNumber( thisAverage , Operand(1))
ELSE
ReturnValue%Type = ValueError
ReturnValue%Error = 'Built-in trend function called with index larger than what is being logged'
ENDIF
ELSE
ReturnValue%Type = ValueError
ReturnValue%Error = 'Built-in trend function called with index less than 1'
ENDIF
ELSE !not registered as a trend variable
ReturnValue%Type = ValueError
ReturnValue%Error = 'Variable used with built-in trend function is not associated with a registered trend variable'
ENDIF
CASE (FuncTrendMax)
IF (Operand(1)%TrendVariable) THEN
thisTrend = Operand(1)%TrendVarPointer
thisIndex = FLOOR(Operand(2)%Number)
IF (thisIndex >= 1) THEN
IF (thisIndex <= TrendVariable(thisTrend)%LogDepth) THEN
thisMax = 0.0D0
IF (thisIndex == 1) THEN
thisMax = TrendVariable(thisTrend)%TrendValARR(1)
ELSE
DO loop = 2, thisIndex
IF (loop == 2) THen
thisMax = MAX(TrendVariable(thisTrend)%TrendValARR(1), TrendVariable(thisTrend)%TrendValARR(2))
ELSE
thisMax = MAX(thisMax, TrendVariable(thisTrend)%TrendValARR(loop))
ENDIF
ENDDO
ENDIF
ReturnValue = SetErlValueNumber(thisMax, Operand(1))
ELSE
ReturnValue%Type = ValueError
ReturnValue%Error = 'Built-in trend function called with index larger than what is being logged'
ENDIF
ELSE
ReturnValue%Type = ValueError
ReturnValue%Error = 'Built-in trend function called with index less than 1'
ENDIF
ELSE !not registered as a trend variable
ReturnValue%Type = ValueError
ReturnValue%Error = 'Variable used with built-in trend function is not associated with a registered trend variable'
ENDIF
CASE (FuncTrendMin)
IF (Operand(1)%TrendVariable) THEN
thisTrend = Operand(1)%TrendVarPointer
thisIndex = FLOOR(Operand(2)%Number)
IF (thisIndex >= 1) THEN
IF (thisIndex <= TrendVariable(thisTrend)%LogDepth) THEN
thisMin = 0.0D0
IF (thisIndex == 1) THEN
thisMin = TrendVariable(thisTrend)%TrendValARR(1)
ELSE
DO loop = 2, thisIndex
IF (loop == 2) THen
thisMin = MIN(TrendVariable(thisTrend)%TrendValARR(1), TrendVariable(thisTrend)%TrendValARR(2))
ELSE
thisMin = MIN(thisMin, TrendVariable(thisTrend)%TrendValARR(loop))
ENDIF
ENDDO
ENDIF
ReturnValue = SetErlValueNumber(thisMin, Operand(1))
ELSE
ReturnValue%Type = ValueError
ReturnValue%Error = 'Built-in trend function called with index larger than what is being logged'
ENDIF
ELSE
ReturnValue%Type = ValueError
ReturnValue%Error = 'Built-in trend function called with index less than 1'
ENDIF
ELSE !not registered as a trend variable
ReturnValue%Type = ValueError
ReturnValue%Error = 'Variable used with built-in trend function is not associated with a registered trend variable'
ENDIF
CASE (FuncTrendDirection)
IF (Operand(1)%TrendVariable) THEN
! do a linear least squares fit and get slope of line
thisTrend = Operand(1)%TrendVarPointer
thisIndex = FLOOR(Operand(2)%Number)
IF (thisIndex >= 1) THEN
IF (thisIndex <= TrendVariable(thisTrend)%LogDepth) THEN
! closed form solution for slope of linear least squares fit
thisSlope = ( Sum(TrendVariable(thisTrend)%TimeARR(1:thisIndex))&
*Sum(TrendVariable(thisTrend)%TrendValARR(1:thisIndex)) &
- thisIndex * Sum((TrendVariable(thisTrend)%TimeARR(1:thisIndex) &
* TrendVariable(thisTrend)%TrendValARR(1:thisIndex))) ) &
/ ( Sum(TrendVariable(thisTrend)%TimeARR(1:thisIndex))**2 &
- thisIndex*Sum( TrendVariable(thisTrend)%TimeARR(1:thisIndex)**2) )
ReturnValue = SetErlValueNumber( thisSlope , Operand(1)) ! rate of change per hour
ELSE
ReturnValue%Type = ValueError
ReturnValue%Error = 'Built-in trend function called with index larger than what is being logged'
ENDIF
ELSE
ReturnValue%Type = ValueError
ReturnValue%Error = 'Built-in trend function called with index less than 1'
ENDIF
ELSE !not registered as a trend variable
ReturnValue%Type = ValueError
ReturnValue%Error = 'Variable used with built-in trend function is not associated with a registered trend variable'
ENDIF
CASE (FuncTrendSum)
IF (Operand(1)%TrendVariable) THEN
thisTrend = Operand(1)%TrendVarPointer
thisIndex = FLOOR(Operand(2)%Number)
IF (thisIndex >= 1) Then
IF (thisIndex <= TrendVariable(thisTrend)%LogDepth) THEN
ReturnValue = SetErlValueNumber(Sum(TrendVariable(thisTrend)%TrendValARR(1:thisIndex)), Operand(1) )
ELSE
ReturnValue%Type = ValueError
ReturnValue%Error = 'Built-in trend function called with index larger than what is being logged'
ENDIF
ELSE
ReturnValue%Type = ValueError
ReturnValue%Error = 'Built-in trend function called with index less than 1'
ENDIF
ELSE !not registered as a trend variable
ReturnValue%Type = ValueError
ReturnValue%Error = 'Variable used with built-in trend function is not associated with a registered trend variable'
ENDIF
CASE (FuncCurveValue)
ReturnValue = SetErlValueNumber(CurveValue( &
FLOOR(Operand(1)%Number) , & ! curve index
Operand(2)%Number , & ! X value
Var2 = Operand(3)%Number , & ! Y value, 2nd independent
Var3 = Operand(4)%Number , & ! Z Value, 3rd independent
Var4 = Operand(5)%Number , & ! 4th independent
Var5 = Operand(6)%Number ) ) ! 5th independent
CASE DEFAULT
! throw Error!
CALL ShowFatalError('caught unexpected Expression(ExpressionNum)%Operator in EvaluateExpression')
END SELECT
DEALLOCATE(Operand)
END IF
RETURN
END FUNCTION EvaluateExpression