diff --git a/src/FEQParse.F90 b/src/FEQParse.F90 index 4c8362a..d00749a 100644 --- a/src/FEQParse.F90 +++ b/src/FEQParse.F90 @@ -25,7 +25,7 @@ MODULE FEQParse INTEGER, PARAMETER, PRIVATE :: Error_Message_Length = 256 INTEGER, PARAMETER, PRIVATE :: Max_Equation_Length = 1024 - INTEGER, PARAMETER, PRIVATE :: Max_Function_Length = 6 + !INTEGER, PARAMETER, PRIVATE :: Max_Function_Length = 6 INTEGER, PARAMETER, PRIVATE :: Max_Variable_Length = 12 INTEGER, PARAMETER, PRIVATE :: Stack_Length = 128 @@ -279,7 +279,7 @@ SUBROUTINE Tokenize( parser, tokenized, errorMsg ) parser % inFix % top_index = parser % inFix % top_index + 1 parser % inFix % tokens( parser % inFix % top_index ) % tokenString = '' - j = FindLastFunctionIndex( parser % inFixFormula(i:i+Max_Function_Length-1) ) + j = FindLastFunctionIndex( parser % inFixFormula(i:i+feqparse_function_maxlength-1) ) parser % inFix % tokens( parser % inFix % top_index ) % tokenString = parser % inFixFormula(i:i+j) parser % inFix % tokens( parser % inFix % top_index ) % tokenType = Function_Token @@ -287,7 +287,7 @@ SUBROUTINE Tokenize( parser, tokenized, errorMsg ) ! Check to see if the next string IF( parser % inFixFormula(i:i) /= "(" )THEN - errorMsg = "Missing opening parentheses after token : "//& + errorMsg = "Missing opening parentheses after token : "//& TRIM( parser % inFix % tokens( parser % inFix % top_index ) % tokenString ) RETURN @@ -325,7 +325,6 @@ SUBROUTINE Tokenize( parser, tokenized, errorMsg ) END SUBROUTINE Tokenize - SUBROUTINE ConvertToPostFix( parser ) CLASS( EquationParser ), INTENT(inout) :: parser ! Local @@ -424,7 +423,7 @@ FUNCTION Evaluate_sfp32( parser, x ) RESULT( f ) IF( .NOT.( ALLOCATED( parser % postfix % tokens ) ) )THEN f = 0.0_real32 - + ELSE DO k = 1, parser % postfix % top_index diff --git a/src/FEQParse_Functions.F90 b/src/FEQParse_Functions.F90 index 1e4b366..811cb25 100644 --- a/src/FEQParse_Functions.F90 +++ b/src/FEQParse_Functions.F90 @@ -100,10 +100,9 @@ END FUNCTION IsFunction FUNCTION FindLastFunctionIndex( eqChar ) RESULT( j ) CHARACTER(*) :: eqChar - INTEGER :: i, j + INTEGER :: i, j DO i = 1, LEN(eqChar) - IF( eqChar(i:i) == "(" )THEN j = i-2 EXIT diff --git a/test/CMakeLists.txt b/test/CMakeLists.txt index c737299..c5e562f 100644 --- a/test/CMakeLists.txt +++ b/test/CMakeLists.txt @@ -66,15 +66,51 @@ add_fortran_test_executable ( "sin_r1fp64.f90" "tan_r1fp64.f90" "tanh_r1fp64.f90" + "sech_r1fp64.f90" + "abs_r1fp64.f90" + "sqrt_r1fp64.f90" + "acos_r1fp64.f90" + "asin_r1fp64.f90" + "atan_r1fp64.f90" + "log_r1fp64.f90" + "log10_r1fp64.f90" + "random_r1fp64.f90" "cos_r1fp32.f90" "sin_r1fp32.f90" "tan_r1fp32.f90" "tanh_r1fp32.f90" + "sech_r1fp32.f90" + "abs_r1fp32.f90" + "sqrt_r1fp32.f90" + "acos_r1fp32.f90" + "asin_r1fp32.f90" + "atan_r1fp32.f90" + "log_r1fp32.f90" + "log10_r1fp32.f90" + "random_r1fp32.f90" "cos_sfp64.f90" "sin_sfp64.f90" "tan_sfp64.f90" "tanh_sfp64.f90" + "sech_sfp64.f90" + "abs_sfp64.f90" + "sqrt_sfp64.f90" + "acos_sfp64.f90" + "asin_sfp64.f90" + "atan_sfp64.f90" + "log_sfp64.f90" + "log10_sfp64.f90" + "random_sfp64.f90" "cos_sfp32.f90" "sin_sfp32.f90" "tan_sfp32.f90" - "tanh_sfp32.f90") + "tanh_sfp32.f90" + "sech_sfp32.f90" + "abs_sfp32.f90" + "sqrt_sfp32.f90" + "acos_sfp32.f90" + "asin_sfp32.f90" + "atan_sfp32.f90" + "log_sfp32.f90" + "log10_sfp32.f90" + "random_sfp32.f90") diff --git a/test/abs_r1fp32.f90 b/test/abs_r1fp32.f90 new file mode 100644 index 0000000..30b2b41 --- /dev/null +++ b/test/abs_r1fp32.f90 @@ -0,0 +1,41 @@ + +INTEGER FUNCTION abs_r1fp32() RESULT(r) + USE FEQParse + use iso_fortran_env + IMPLICIT NONE + integer, parameter :: N=1000 + TYPE(EquationParser) :: f + CHARACTER(LEN=1), DIMENSION(1:3) :: independentVars + CHARACTER(LEN=30) :: eqChar + REAL(real32) :: x(1:N,1:3) + REAL(real32) :: feval(1:N) + REAL(real32) :: fexact(1:N) + integer :: i + + ! Specify the independent variables + independentVars = (/ 'x', 'y', 'z' /) + + ! Specify an equation string that we want to evaluate + eqChar = 'f = \abs( x )' + + ! Create the EquationParser object + f = EquationParser(eqChar, independentVars) + + x = 0.0_real32 + do i = 1,N + x(i,1) = -1.0_real32 + (2.0_real32)/REAL(N,real32)*REAL(i-1,real32) + fexact(i) = abs(x(i,1)) + enddo + + ! Evaluate the equation + feval = f % evaluate( x ) + IF( MAXVAL(ABS(feval-fexact)) <= epsilon(1.0_real32) )THEN + r = 0 + ELSE + r = 1 + ENDIF + + ! Clean up memory + CALL f % Destruct() + +END FUNCTION abs_r1fp32 diff --git a/test/abs_r1fp64.f90 b/test/abs_r1fp64.f90 new file mode 100644 index 0000000..ee09456 --- /dev/null +++ b/test/abs_r1fp64.f90 @@ -0,0 +1,41 @@ + +INTEGER FUNCTION abs_r1fp64() RESULT(r) + USE FEQParse + use iso_fortran_env + IMPLICIT NONE + integer, parameter :: N=1000 + TYPE(EquationParser) :: f + CHARACTER(LEN=1), DIMENSION(1:3) :: independentVars + CHARACTER(LEN=30) :: eqChar + REAL(real64) :: x(1:N,1:3) + REAL(real64) :: feval(1:N) + REAL(real64) :: fexact(1:N) + integer :: i + + ! Specify the independent variables + independentVars = (/ 'x', 'y', 'z' /) + + ! Specify an equation string that we want to evaluate + eqChar = 'f = \abs( x )' + + ! Create the EquationParser object + f = EquationParser(eqChar, independentVars) + + x = 0.0_real64 + do i = 1,N + x(i,1) = -1.0_real64 + (2.0_real64)/REAL(N,real64)*REAL(i-1,real64) + fexact(i) = abs(x(i,1)) + enddo + + ! Evaluate the equation + feval = f % evaluate( x ) + IF( MAXVAL(ABS(feval-fexact)) <= epsilon(1.0) )THEN + r = 0 + ELSE + r = 1 + ENDIF + + ! Clean up memory + CALL f % Destruct() + +END FUNCTION abs_r1fp64 diff --git a/test/abs_sfp32.f90 b/test/abs_sfp32.f90 new file mode 100644 index 0000000..2c90602 --- /dev/null +++ b/test/abs_sfp32.f90 @@ -0,0 +1,38 @@ + +INTEGER FUNCTION abs_sfp32() RESULT(r) + USE FEQParse + use iso_fortran_env + IMPLICIT NONE + integer, parameter :: N=1000 + TYPE(EquationParser) :: f + CHARACTER(LEN=1), DIMENSION(1:3) :: independentVars + CHARACTER(LEN=30) :: eqChar + REAL(real32) :: x(1:3) + REAL(real32) :: feval + REAL(real32) :: fexact + integer :: i + + ! Specify the independent variables + independentVars = (/ 'x', 'y', 'z' /) + + ! Specify an equation string that we want to evaluate + eqChar = 'f = \abs( x )' + + ! Create the EquationParser object + f = EquationParser(eqChar, independentVars) + + x = 0.0_real32 + fexact = abs(x(1)) + + ! Evaluate the equation + feval = f % evaluate( x ) + IF( (ABS(feval-fexact)) <= epsilon(1.0_real32) )THEN + r = 0 + ELSE + r = 1 + ENDIF + + ! Clean up memory + CALL f % Destruct() + +END FUNCTION abs_sfp32 diff --git a/test/abs_sfp64.f90 b/test/abs_sfp64.f90 new file mode 100644 index 0000000..3d7dbdc --- /dev/null +++ b/test/abs_sfp64.f90 @@ -0,0 +1,38 @@ + +INTEGER FUNCTION abs_sfp64() RESULT(r) + USE FEQParse + use iso_fortran_env + IMPLICIT NONE + integer, parameter :: N=1000 + TYPE(EquationParser) :: f + CHARACTER(LEN=1), DIMENSION(1:3) :: independentVars + CHARACTER(LEN=30) :: eqChar + REAL(real64) :: x(1:3) + REAL(real64) :: feval + REAL(real64) :: fexact + integer :: i + + ! Specify the independent variables + independentVars = (/ 'x', 'y', 'z' /) + + ! Specify an equation string that we want to evaluate + eqChar = 'f = \abs( x )' + + ! Create the EquationParser object + f = EquationParser(eqChar, independentVars) + + x = 0.0_real64 + fexact = abs(x(1)) + + ! Evaluate the equation + feval = f % evaluate( x ) + IF( (ABS(feval-fexact)) <= epsilon(1.0_real64) )THEN + r = 0 + ELSE + r = 1 + ENDIF + + ! Clean up memory + CALL f % Destruct() + +END FUNCTION abs_sfp64 diff --git a/test/acos_r1fp32.f90 b/test/acos_r1fp32.f90 new file mode 100644 index 0000000..0c2ca57 --- /dev/null +++ b/test/acos_r1fp32.f90 @@ -0,0 +1,41 @@ + +INTEGER FUNCTION acos_r1fp32() RESULT(r) + USE FEQParse + use iso_fortran_env + IMPLICIT NONE + integer, parameter :: N=1000 + TYPE(EquationParser) :: f + CHARACTER(LEN=1), DIMENSION(1:3) :: independentVars + CHARACTER(LEN=30) :: eqChar + REAL(real32) :: x(1:N,1:3) + REAL(real32) :: feval(1:N) + REAL(real32) :: fexact(1:N) + integer :: i + + ! Specify the independent variables + independentVars = (/ 'x', 'y', 'z' /) + + ! Specify an equation string that we want to evaluate + eqChar = 'f = \acos( x )' + + ! Create the EquationParser object + f = EquationParser(eqChar, independentVars) + + x = 0.0_real32 + do i = 1,N + x(i,1) = -1.0_real32 + (2.0_real32)/REAL(N,real32)*REAL(i-1,real32) + fexact(i) = acos(x(i,1)) + enddo + + ! Evaluate the equation + feval = f % evaluate( x ) + IF( MAXVAL(ABS(feval-fexact)) <= epsilon(1.0_real32) )THEN + r = 0 + ELSE + r = 1 + ENDIF + + ! Clean up memory + CALL f % Destruct() + +END FUNCTION acos_r1fp32 diff --git a/test/acos_r1fp64.f90 b/test/acos_r1fp64.f90 new file mode 100644 index 0000000..7b493c7 --- /dev/null +++ b/test/acos_r1fp64.f90 @@ -0,0 +1,41 @@ + +INTEGER FUNCTION acos_r1fp64() RESULT(r) + USE FEQParse + use iso_fortran_env + IMPLICIT NONE + integer, parameter :: N=1000 + TYPE(EquationParser) :: f + CHARACTER(LEN=1), DIMENSION(1:3) :: independentVars + CHARACTER(LEN=30) :: eqChar + REAL(real64) :: x(1:N,1:3) + REAL(real64) :: feval(1:N) + REAL(real64) :: fexact(1:N) + integer :: i + + ! Specify the independent variables + independentVars = (/ 'x', 'y', 'z' /) + + ! Specify an equation string that we want to evaluate + eqChar = 'f = \acos( x )' + + ! Create the EquationParser object + f = EquationParser(eqChar, independentVars) + + x = 0.0_real64 + do i = 1,N + x(i,1) = -1.0_real64 + (2.0_real64)/REAL(N,real64)*REAL(i-1,real64) + fexact(i) = acos(x(i,1)) + enddo + + ! Evaluate the equation + feval = f % evaluate( x ) + IF( MAXVAL(ABS(feval-fexact)) <= epsilon(1.0) )THEN + r = 0 + ELSE + r = 1 + ENDIF + + ! Clean up memory + CALL f % Destruct() + +END FUNCTION acos_r1fp64 diff --git a/test/acos_sfp32.f90 b/test/acos_sfp32.f90 new file mode 100644 index 0000000..0960782 --- /dev/null +++ b/test/acos_sfp32.f90 @@ -0,0 +1,38 @@ + +INTEGER FUNCTION acos_sfp32() RESULT(r) + USE FEQParse + use iso_fortran_env + IMPLICIT NONE + integer, parameter :: N=1000 + TYPE(EquationParser) :: f + CHARACTER(LEN=1), DIMENSION(1:3) :: independentVars + CHARACTER(LEN=30) :: eqChar + REAL(real32) :: x(1:3) + REAL(real32) :: feval + REAL(real32) :: fexact + integer :: i + + ! Specify the independent variables + independentVars = (/ 'x', 'y', 'z' /) + + ! Specify an equation string that we want to evaluate + eqChar = 'f = \acos( x )' + + ! Create the EquationParser object + f = EquationParser(eqChar, independentVars) + + x = 0.0_real32 + fexact = acos(x(1)) + + ! Evaluate the equation + feval = f % evaluate( x ) + IF( (ABS(feval-fexact)) <= epsilon(1.0_real32) )THEN + r = 0 + ELSE + r = 1 + ENDIF + + ! Clean up memory + CALL f % Destruct() + +END FUNCTION acos_sfp32 diff --git a/test/acos_sfp64.f90 b/test/acos_sfp64.f90 new file mode 100644 index 0000000..0050296 --- /dev/null +++ b/test/acos_sfp64.f90 @@ -0,0 +1,39 @@ + +INTEGER FUNCTION acos_sfp64() RESULT(r) + ! WARNING - acos(x) accurate only to single precision with gfortran 11.4.0 + USE FEQParse + use iso_fortran_env + IMPLICIT NONE + integer, parameter :: N=1000 + TYPE(EquationParser) :: f + CHARACTER(LEN=1), DIMENSION(1:3) :: independentVars + CHARACTER(LEN=30) :: eqChar + REAL(real64) :: x(1:3) + REAL(real64) :: feval + REAL(real64) :: fexact + integer :: i + + ! Specify the independent variables + independentVars = (/ 'x', 'y', 'z' /) + + ! Specify an equation string that we want to evaluate + eqChar = 'f = \acos( x )' + + ! Create the EquationParser object + f = EquationParser(eqChar, independentVars) + + x = 0.0_real64 + fexact = acos(x(1)) + + ! Evaluate the equation + feval = f % evaluate( x ) + IF( (ABS(feval-fexact)) <= epsilon(1.0_real32) )THEN + r = 0 + ELSE + r = 1 + ENDIF + + ! Clean up memory + CALL f % Destruct() + +END FUNCTION acos_sfp64 diff --git a/test/asin_r1fp32.f90 b/test/asin_r1fp32.f90 new file mode 100644 index 0000000..af30a95 --- /dev/null +++ b/test/asin_r1fp32.f90 @@ -0,0 +1,41 @@ + +INTEGER FUNCTION asin_r1fp32() RESULT(r) + USE FEQParse + use iso_fortran_env + IMPLICIT NONE + integer, parameter :: N=1000 + TYPE(EquationParser) :: f + CHARACTER(LEN=1), DIMENSION(1:3) :: independentVars + CHARACTER(LEN=30) :: eqChar + REAL(real32) :: x(1:N,1:3) + REAL(real32) :: feval(1:N) + REAL(real32) :: fexact(1:N) + integer :: i + + ! Specify the independent variables + independentVars = (/ 'x', 'y', 'z' /) + + ! Specify an equation string that we want to evaluate + eqChar = 'f = \asin( x )' + + ! Create the EquationParser object + f = EquationParser(eqChar, independentVars) + + x = 0.0_real32 + do i = 1,N + x(i,1) = -1.0_real32 + (2.0_real32)/REAL(N,real32)*REAL(i-1,real32) + fexact(i) = asin(x(i,1)) + enddo + + ! Evaluate the equation + feval = f % evaluate( x ) + IF( MAXVAL(ABS(feval-fexact)) <= epsilon(1.0_real32) )THEN + r = 0 + ELSE + r = 1 + ENDIF + + ! Clean up memory + CALL f % Destruct() + +END FUNCTION asin_r1fp32 diff --git a/test/asin_r1fp64.f90 b/test/asin_r1fp64.f90 new file mode 100644 index 0000000..b8b70d5 --- /dev/null +++ b/test/asin_r1fp64.f90 @@ -0,0 +1,41 @@ + +INTEGER FUNCTION asin_r1fp64() RESULT(r) + USE FEQParse + use iso_fortran_env + IMPLICIT NONE + integer, parameter :: N=1000 + TYPE(EquationParser) :: f + CHARACTER(LEN=1), DIMENSION(1:3) :: independentVars + CHARACTER(LEN=30) :: eqChar + REAL(real64) :: x(1:N,1:3) + REAL(real64) :: feval(1:N) + REAL(real64) :: fexact(1:N) + integer :: i + + ! Specify the independent variables + independentVars = (/ 'x', 'y', 'z' /) + + ! Specify an equation string that we want to evaluate + eqChar = 'f = \asin( x )' + + ! Create the EquationParser object + f = EquationParser(eqChar, independentVars) + + x = 0.0_real64 + do i = 1,N + x(i,1) = -1.0_real64 + (2.0_real64)/REAL(N,real64)*REAL(i-1,real64) + fexact(i) = asin(x(i,1)) + enddo + + ! Evaluate the equation + feval = f % evaluate( x ) + IF( MAXVAL(ABS(feval-fexact)) <= epsilon(1.0) )THEN + r = 0 + ELSE + r = 1 + ENDIF + + ! Clean up memory + CALL f % Destruct() + +END FUNCTION asin_r1fp64 diff --git a/test/asin_sfp32.f90 b/test/asin_sfp32.f90 new file mode 100644 index 0000000..e85067c --- /dev/null +++ b/test/asin_sfp32.f90 @@ -0,0 +1,38 @@ + +INTEGER FUNCTION asin_sfp32() RESULT(r) + USE FEQParse + use iso_fortran_env + IMPLICIT NONE + integer, parameter :: N=1000 + TYPE(EquationParser) :: f + CHARACTER(LEN=1), DIMENSION(1:3) :: independentVars + CHARACTER(LEN=30) :: eqChar + REAL(real32) :: x(1:3) + REAL(real32) :: feval + REAL(real32) :: fexact + integer :: i + + ! Specify the independent variables + independentVars = (/ 'x', 'y', 'z' /) + + ! Specify an equation string that we want to evaluate + eqChar = 'f = \asin( x )' + + ! Create the EquationParser object + f = EquationParser(eqChar, independentVars) + + x = 0.0_real32 + fexact = asin(x(1)) + + ! Evaluate the equation + feval = f % evaluate( x ) + IF( (ABS(feval-fexact)) <= epsilon(1.0_real32) )THEN + r = 0 + ELSE + r = 1 + ENDIF + + ! Clean up memory + CALL f % Destruct() + +END FUNCTION asin_sfp32 diff --git a/test/asin_sfp64.f90 b/test/asin_sfp64.f90 new file mode 100644 index 0000000..a5afd4d --- /dev/null +++ b/test/asin_sfp64.f90 @@ -0,0 +1,38 @@ + +INTEGER FUNCTION asin_sfp64() RESULT(r) + USE FEQParse + use iso_fortran_env + IMPLICIT NONE + integer, parameter :: N=1000 + TYPE(EquationParser) :: f + CHARACTER(LEN=1), DIMENSION(1:3) :: independentVars + CHARACTER(LEN=30) :: eqChar + REAL(real64) :: x(1:3) + REAL(real64) :: feval + REAL(real64) :: fexact + integer :: i + + ! Specify the independent variables + independentVars = (/ 'x', 'y', 'z' /) + + ! Specify an equation string that we want to evaluate + eqChar = 'f = \asin( x )' + + ! Create the EquationParser object + f = EquationParser(eqChar, independentVars) + + x = 0.0_real64 + fexact = asin(x(1)) + + ! Evaluate the equation + feval = f % evaluate( x ) + IF( (ABS(feval-fexact)) <= epsilon(1.0_real64) )THEN + r = 0 + ELSE + r = 1 + ENDIF + + ! Clean up memory + CALL f % Destruct() + +END FUNCTION asin_sfp64 diff --git a/test/atan_r1fp32.f90 b/test/atan_r1fp32.f90 new file mode 100644 index 0000000..910f04d --- /dev/null +++ b/test/atan_r1fp32.f90 @@ -0,0 +1,41 @@ + +INTEGER FUNCTION atan_r1fp32() RESULT(r) + USE FEQParse + use iso_fortran_env + IMPLICIT NONE + integer, parameter :: N=1000 + TYPE(EquationParser) :: f + CHARACTER(LEN=1), DIMENSION(1:3) :: independentVars + CHARACTER(LEN=30) :: eqChar + REAL(real32) :: x(1:N,1:3) + REAL(real32) :: feval(1:N) + REAL(real32) :: fexact(1:N) + integer :: i + + ! Specify the independent variables + independentVars = (/ 'x', 'y', 'z' /) + + ! Specify an equation string that we want to evaluate + eqChar = 'f = \atan( x )' + + ! Create the EquationParser object + f = EquationParser(eqChar, independentVars) + + x = 0.0_real32 + do i = 1,N + x(i,1) = -1.0_real32 + (2.0_real32)/REAL(N,real32)*REAL(i-1,real32) + fexact(i) = atan(x(i,1)) + enddo + + ! Evaluate the equation + feval = f % evaluate( x ) + IF( MAXVAL(ABS(feval-fexact)) <= epsilon(1.0_real32) )THEN + r = 0 + ELSE + r = 1 + ENDIF + + ! Clean up memory + CALL f % Destruct() + +END FUNCTION atan_r1fp32 diff --git a/test/atan_r1fp64.f90 b/test/atan_r1fp64.f90 new file mode 100644 index 0000000..0afc371 --- /dev/null +++ b/test/atan_r1fp64.f90 @@ -0,0 +1,41 @@ + +INTEGER FUNCTION atan_r1fp64() RESULT(r) + USE FEQParse + use iso_fortran_env + IMPLICIT NONE + integer, parameter :: N=1000 + TYPE(EquationParser) :: f + CHARACTER(LEN=1), DIMENSION(1:3) :: independentVars + CHARACTER(LEN=30) :: eqChar + REAL(real64) :: x(1:N,1:3) + REAL(real64) :: feval(1:N) + REAL(real64) :: fexact(1:N) + integer :: i + + ! Specify the independent variables + independentVars = (/ 'x', 'y', 'z' /) + + ! Specify an equation string that we want to evaluate + eqChar = 'f = \atan( x )' + + ! Create the EquationParser object + f = EquationParser(eqChar, independentVars) + + x = 0.0_real64 + do i = 1,N + x(i,1) = -1.0_real64 + (2.0_real64)/REAL(N,real64)*REAL(i-1,real64) + fexact(i) = atan(x(i,1)) + enddo + + ! Evaluate the equation + feval = f % evaluate( x ) + IF( MAXVAL(ABS(feval-fexact)) <= epsilon(1.0) )THEN + r = 0 + ELSE + r = 1 + ENDIF + + ! Clean up memory + CALL f % Destruct() + +END FUNCTION atan_r1fp64 diff --git a/test/atan_sfp32.f90 b/test/atan_sfp32.f90 new file mode 100644 index 0000000..aae37d2 --- /dev/null +++ b/test/atan_sfp32.f90 @@ -0,0 +1,38 @@ + +INTEGER FUNCTION atan_sfp32() RESULT(r) + USE FEQParse + use iso_fortran_env + IMPLICIT NONE + integer, parameter :: N=1000 + TYPE(EquationParser) :: f + CHARACTER(LEN=1), DIMENSION(1:3) :: independentVars + CHARACTER(LEN=30) :: eqChar + REAL(real32) :: x(1:3) + REAL(real32) :: feval + REAL(real32) :: fexact + integer :: i + + ! Specify the independent variables + independentVars = (/ 'x', 'y', 'z' /) + + ! Specify an equation string that we want to evaluate + eqChar = 'f = \atan( x )' + + ! Create the EquationParser object + f = EquationParser(eqChar, independentVars) + + x = 0.0_real32 + fexact = atan(x(1)) + + ! Evaluate the equation + feval = f % evaluate( x ) + IF( (ABS(feval-fexact)) <= epsilon(1.0_real32) )THEN + r = 0 + ELSE + r = 1 + ENDIF + + ! Clean up memory + CALL f % Destruct() + +END FUNCTION atan_sfp32 diff --git a/test/atan_sfp64.f90 b/test/atan_sfp64.f90 new file mode 100644 index 0000000..52b7375 --- /dev/null +++ b/test/atan_sfp64.f90 @@ -0,0 +1,38 @@ + +INTEGER FUNCTION atan_sfp64() RESULT(r) + USE FEQParse + use iso_fortran_env + IMPLICIT NONE + integer, parameter :: N=1000 + TYPE(EquationParser) :: f + CHARACTER(LEN=1), DIMENSION(1:3) :: independentVars + CHARACTER(LEN=30) :: eqChar + REAL(real64) :: x(1:3) + REAL(real64) :: feval + REAL(real64) :: fexact + integer :: i + + ! Specify the independent variables + independentVars = (/ 'x', 'y', 'z' /) + + ! Specify an equation string that we want to evaluate + eqChar = 'f = \atan( x )' + + ! Create the EquationParser object + f = EquationParser(eqChar, independentVars) + + x = 0.0_real64 + fexact = atan(x(1)) + + ! Evaluate the equation + feval = f % evaluate( x ) + IF( (ABS(feval-fexact)) <= epsilon(1.0_real64) )THEN + r = 0 + ELSE + r = 1 + ENDIF + + ! Clean up memory + CALL f % Destruct() + +END FUNCTION atan_sfp64 diff --git a/test/log10_r1fp32.f90 b/test/log10_r1fp32.f90 new file mode 100644 index 0000000..a170eb6 --- /dev/null +++ b/test/log10_r1fp32.f90 @@ -0,0 +1,41 @@ + +INTEGER FUNCTION log10_r1fp32() RESULT(r) + USE FEQParse + use iso_fortran_env + IMPLICIT NONE + integer, parameter :: N=1000 + TYPE(EquationParser) :: f + CHARACTER(LEN=1), DIMENSION(1:3) :: independentVars + CHARACTER(LEN=30) :: eqChar + REAL(real32) :: x(1:N,1:3) + REAL(real32) :: feval(1:N) + REAL(real32) :: fexact(1:N) + integer :: i + + ! Specify the independent variables + independentVars = (/ 'x', 'y', 'z' /) + + ! Specify an equation string that we want to evaluate + eqChar = 'f = \log( x )' + + ! Create the EquationParser object + f = EquationParser(eqChar, independentVars) + + x = 0.0_real32 + do i = 1,N + x(i,1) = 1.0_real32 + (2.0_real32)/REAL(N,real32)*REAL(i-1,real32) + fexact(i) = log10(x(i,1)) + enddo + + ! Evaluate the equation + feval = f % evaluate( x ) + IF( MAXVAL(ABS(feval-fexact)) <= epsilon(1.0_real32) )THEN + r = 0 + ELSE + r = 1 + ENDIF + + ! Clean up memory + CALL f % Destruct() + +END FUNCTION log10_r1fp32 diff --git a/test/log10_r1fp64.f90 b/test/log10_r1fp64.f90 new file mode 100644 index 0000000..d5c8722 --- /dev/null +++ b/test/log10_r1fp64.f90 @@ -0,0 +1,41 @@ + +INTEGER FUNCTION log10_r1fp64() RESULT(r) + USE FEQParse + use iso_fortran_env + IMPLICIT NONE + integer, parameter :: N=1000 + TYPE(EquationParser) :: f + CHARACTER(LEN=1), DIMENSION(1:3) :: independentVars + CHARACTER(LEN=30) :: eqChar + REAL(real64) :: x(1:N,1:3) + REAL(real64) :: feval(1:N) + REAL(real64) :: fexact(1:N) + integer :: i + + ! Specify the independent variables + independentVars = (/ 'x', 'y', 'z' /) + + ! Specify an equation string that we want to evaluate + eqChar = 'f = \log( x )' + + ! Create the EquationParser object + f = EquationParser(eqChar, independentVars) + + x = 0.0_real64 + do i = 1,N + x(i,1) = 1.0_real64 + (2.0_real64)/REAL(N,real64)*REAL(i-1,real64) + fexact(i) = log10(x(i,1)) + enddo + + ! Evaluate the equation + feval = f % evaluate( x ) + IF( MAXVAL(ABS(feval-fexact)) <= epsilon(1.0) )THEN + r = 0 + ELSE + r = 1 + ENDIF + + ! Clean up memory + CALL f % Destruct() + +END FUNCTION log10_r1fp64 diff --git a/test/log10_sfp32.f90 b/test/log10_sfp32.f90 new file mode 100644 index 0000000..0de7576 --- /dev/null +++ b/test/log10_sfp32.f90 @@ -0,0 +1,38 @@ + +INTEGER FUNCTION log10_sfp32() RESULT(r) + USE FEQParse + use iso_fortran_env + IMPLICIT NONE + integer, parameter :: N=1000 + TYPE(EquationParser) :: f + CHARACTER(LEN=1), DIMENSION(1:3) :: independentVars + CHARACTER(LEN=30) :: eqChar + REAL(real32) :: x(1:3) + REAL(real32) :: feval + REAL(real32) :: fexact + integer :: i + + ! Specify the independent variables + independentVars = (/ 'x', 'y', 'z' /) + + ! Specify an equation string that we want to evaluate + eqChar = 'f = \log( x )' + + ! Create the EquationParser object + f = EquationParser(eqChar, independentVars) + + x = 10.0_real32 + fexact = log10(x(1)) + + ! Evaluate the equation + feval = f % evaluate( x ) + IF( (ABS(feval-fexact)) <= epsilon(1.0_real32) )THEN + r = 0 + ELSE + r = 1 + ENDIF + + ! Clean up memory + CALL f % Destruct() + +END FUNCTION log10_sfp32 diff --git a/test/log10_sfp64.f90 b/test/log10_sfp64.f90 new file mode 100644 index 0000000..f31ab21 --- /dev/null +++ b/test/log10_sfp64.f90 @@ -0,0 +1,38 @@ + +INTEGER FUNCTION log10_sfp64() RESULT(r) + USE FEQParse + use iso_fortran_env + IMPLICIT NONE + integer, parameter :: N=1000 + TYPE(EquationParser) :: f + CHARACTER(LEN=1), DIMENSION(1:3) :: independentVars + CHARACTER(LEN=30) :: eqChar + REAL(real64) :: x(1:3) + REAL(real64) :: feval + REAL(real64) :: fexact + integer :: i + + ! Specify the independent variables + independentVars = (/ 'x', 'y', 'z' /) + + ! Specify an equation string that we want to evaluate + eqChar = 'f = \log( x )' + + ! Create the EquationParser object + f = EquationParser(eqChar, independentVars) + + x = 10.0_real64 + fexact = log10(x(1)) + + ! Evaluate the equation + feval = f % evaluate( x ) + IF( (ABS(feval-fexact)) <= epsilon(1.0_real64) )THEN + r = 0 + ELSE + r = 1 + ENDIF + + ! Clean up memory + CALL f % Destruct() + +END FUNCTION log10_sfp64 diff --git a/test/log_r1fp32.f90 b/test/log_r1fp32.f90 new file mode 100644 index 0000000..a332cb9 --- /dev/null +++ b/test/log_r1fp32.f90 @@ -0,0 +1,41 @@ + +INTEGER FUNCTION log_r1fp32() RESULT(r) + USE FEQParse + use iso_fortran_env + IMPLICIT NONE + integer, parameter :: N=1000 + TYPE(EquationParser) :: f + CHARACTER(LEN=1), DIMENSION(1:3) :: independentVars + CHARACTER(LEN=30) :: eqChar + REAL(real32) :: x(1:N,1:3) + REAL(real32) :: feval(1:N) + REAL(real32) :: fexact(1:N) + integer :: i + + ! Specify the independent variables + independentVars = (/ 'x', 'y', 'z' /) + + ! Specify an equation string that we want to evaluate + eqChar = 'f = \ln( x )' + + ! Create the EquationParser object + f = EquationParser(eqChar, independentVars) + + x = 0.0_real32 + do i = 1,N + x(i,1) = 1.0_real32 + (2.0_real32)/REAL(N,real32)*REAL(i-1,real32) + fexact(i) = log(x(i,1)) + enddo + + ! Evaluate the equation + feval = f % evaluate( x ) + IF( MAXVAL(ABS(feval-fexact)) <= epsilon(1.0_real32) )THEN + r = 0 + ELSE + r = 1 + ENDIF + + ! Clean up memory + CALL f % Destruct() + +END FUNCTION log_r1fp32 diff --git a/test/log_r1fp64.f90 b/test/log_r1fp64.f90 new file mode 100644 index 0000000..5d5cc95 --- /dev/null +++ b/test/log_r1fp64.f90 @@ -0,0 +1,41 @@ + +INTEGER FUNCTION log_r1fp64() RESULT(r) + USE FEQParse + use iso_fortran_env + IMPLICIT NONE + integer, parameter :: N=1000 + TYPE(EquationParser) :: f + CHARACTER(LEN=1), DIMENSION(1:3) :: independentVars + CHARACTER(LEN=30) :: eqChar + REAL(real64) :: x(1:N,1:3) + REAL(real64) :: feval(1:N) + REAL(real64) :: fexact(1:N) + integer :: i + + ! Specify the independent variables + independentVars = (/ 'x', 'y', 'z' /) + + ! Specify an equation string that we want to evaluate + eqChar = 'f = \ln( x )' + + ! Create the EquationParser object + f = EquationParser(eqChar, independentVars) + + x = 0.0_real64 + do i = 1,N + x(i,1) = 1.0_real64 + (2.0_real64)/REAL(N,real64)*REAL(i-1,real64) + fexact(i) = log(x(i,1)) + enddo + + ! Evaluate the equation + feval = f % evaluate( x ) + IF( MAXVAL(ABS(feval-fexact)) <= epsilon(1.0) )THEN + r = 0 + ELSE + r = 1 + ENDIF + + ! Clean up memory + CALL f % Destruct() + +END FUNCTION log_r1fp64 diff --git a/test/log_sfp32.f90 b/test/log_sfp32.f90 new file mode 100644 index 0000000..89a040b --- /dev/null +++ b/test/log_sfp32.f90 @@ -0,0 +1,38 @@ + +INTEGER FUNCTION log_sfp32() RESULT(r) + USE FEQParse + use iso_fortran_env + IMPLICIT NONE + integer, parameter :: N=1000 + TYPE(EquationParser) :: f + CHARACTER(LEN=1), DIMENSION(1:3) :: independentVars + CHARACTER(LEN=30) :: eqChar + REAL(real32) :: x(1:3) + REAL(real32) :: feval + REAL(real32) :: fexact + integer :: i + + ! Specify the independent variables + independentVars = (/ 'x', 'y', 'z' /) + + ! Specify an equation string that we want to evaluate + eqChar = 'f = \ln( x )' + + ! Create the EquationParser object + f = EquationParser(eqChar, independentVars) + + x = 1.0_real32 + fexact = log(x(1)) + + ! Evaluate the equation + feval = f % evaluate( x ) + IF( (ABS(feval-fexact)) <= epsilon(1.0_real32) )THEN + r = 0 + ELSE + r = 1 + ENDIF + + ! Clean up memory + CALL f % Destruct() + +END FUNCTION log_sfp32 diff --git a/test/log_sfp64.f90 b/test/log_sfp64.f90 new file mode 100644 index 0000000..140767a --- /dev/null +++ b/test/log_sfp64.f90 @@ -0,0 +1,38 @@ + +INTEGER FUNCTION log_sfp64() RESULT(r) + USE FEQParse + use iso_fortran_env + IMPLICIT NONE + integer, parameter :: N=1000 + TYPE(EquationParser) :: f + CHARACTER(LEN=1), DIMENSION(1:3) :: independentVars + CHARACTER(LEN=30) :: eqChar + REAL(real64) :: x(1:3) + REAL(real64) :: feval + REAL(real64) :: fexact + integer :: i + + ! Specify the independent variables + independentVars = (/ 'x', 'y', 'z' /) + + ! Specify an equation string that we want to evaluate + eqChar = 'f = \ln( x )' + + ! Create the EquationParser object + f = EquationParser(eqChar, independentVars) + + x = 1.0_real64 + fexact = log(x(1)) + + ! Evaluate the equation + feval = f % evaluate( x ) + IF( (ABS(feval-fexact)) <= epsilon(1.0_real64) )THEN + r = 0 + ELSE + r = 1 + ENDIF + + ! Clean up memory + CALL f % Destruct() + +END FUNCTION log_sfp64 diff --git a/test/random_r1fp32.f90 b/test/random_r1fp32.f90 new file mode 100644 index 0000000..26e6474 --- /dev/null +++ b/test/random_r1fp32.f90 @@ -0,0 +1,39 @@ + +INTEGER FUNCTION random_r1fp32() RESULT(r) + USE FEQParse + use iso_fortran_env + IMPLICIT NONE + integer, parameter :: N=1000 + TYPE(EquationParser) :: f + CHARACTER(LEN=1), DIMENSION(1:3) :: independentVars + CHARACTER(LEN=30) :: eqChar + REAL(real32) :: x(1:N,1:3) + REAL(real32) :: feval(1:N) + integer :: i + + ! Specify the independent variables + independentVars = (/ 'x', 'y', 'z' /) + + ! Specify an equation string that we want to evaluate + eqChar = 'f = \random( x )' + + ! Create the EquationParser object + f = EquationParser(eqChar, independentVars) + + x = 0.0_real32 + do i = 1,N + x(i,1) = -1.0_real32 + (2.0_real32)/REAL(N,real32)*REAL(i-1,real32) + enddo + + ! Evaluate the equation + feval = f % evaluate( x ) + IF( MAXVAL(ABS(feval)) <= 1.0_real32 )THEN + r = 0 + ELSE + r = 1 + ENDIF + + ! Clean up memory + CALL f % Destruct() + +END FUNCTION random_r1fp32 diff --git a/test/random_r1fp64.f90 b/test/random_r1fp64.f90 new file mode 100644 index 0000000..b1596c6 --- /dev/null +++ b/test/random_r1fp64.f90 @@ -0,0 +1,39 @@ + +INTEGER FUNCTION random_r1fp64() RESULT(r) + USE FEQParse + use iso_fortran_env + IMPLICIT NONE + integer, parameter :: N=1000 + TYPE(EquationParser) :: f + CHARACTER(LEN=1), DIMENSION(1:3) :: independentVars + CHARACTER(LEN=30) :: eqChar + REAL(real64) :: x(1:N,1:3) + REAL(real64) :: feval(1:N) + integer :: i + + ! Specify the independent variables + independentVars = (/ 'x', 'y', 'z' /) + + ! Specify an equation string that we want to evaluate + eqChar = 'f = \random( x )' + + ! Create the EquationParser object + f = EquationParser(eqChar, independentVars) + + x = 0.0_real64 + do i = 1,N + x(i,1) = -1.0_real64 + (2.0_real64)/REAL(N,real64)*REAL(i-1,real64) + enddo + + ! Evaluate the equation + feval = f % evaluate( x ) + IF( MAXVAL(ABS(feval)) <= 1.0_real64 )THEN + r = 0 + ELSE + r = 1 + ENDIF + + ! Clean up memory + CALL f % Destruct() + +END FUNCTION random_r1fp64 diff --git a/test/random_sfp32.f90 b/test/random_sfp32.f90 new file mode 100644 index 0000000..f48be00 --- /dev/null +++ b/test/random_sfp32.f90 @@ -0,0 +1,36 @@ + +INTEGER FUNCTION random_sfp32() RESULT(r) + USE FEQParse + use iso_fortran_env + IMPLICIT NONE + integer, parameter :: N=1000 + TYPE(EquationParser) :: f + CHARACTER(LEN=1), DIMENSION(1:3) :: independentVars + CHARACTER(LEN=30) :: eqChar + REAL(real32) :: x(1:3) + REAL(real32) :: feval + integer :: i + + ! Specify the independent variables + independentVars = (/ 'x', 'y', 'z' /) + + ! Specify an equation string that we want to evaluate + eqChar = 'f = \random( x )' + + ! Create the EquationParser object + f = EquationParser(eqChar, independentVars) + + x = 0.0_real32 + + ! Evaluate the equation + feval = f % evaluate( x ) + IF( (ABS(feval)) <= 1.0_real32 )THEN + r = 0 + ELSE + r = 1 + ENDIF + + ! Clean up memory + CALL f % Destruct() + +END FUNCTION random_sfp32 diff --git a/test/random_sfp64.f90 b/test/random_sfp64.f90 new file mode 100644 index 0000000..d836552 --- /dev/null +++ b/test/random_sfp64.f90 @@ -0,0 +1,36 @@ + +INTEGER FUNCTION random_sfp64() RESULT(r) + USE FEQParse + use iso_fortran_env + IMPLICIT NONE + integer, parameter :: N=1000 + TYPE(EquationParser) :: f + CHARACTER(LEN=1), DIMENSION(1:3) :: independentVars + CHARACTER(LEN=30) :: eqChar + REAL(real64) :: x(1:3) + REAL(real64) :: feval + integer :: i + + ! Specify the independent variables + independentVars = (/ 'x', 'y', 'z' /) + + ! Specify an equation string that we want to evaluate + eqChar = 'f = \random( x )' + + ! Create the EquationParser object + f = EquationParser(eqChar, independentVars) + + x = 0.0_real64 + + ! Evaluate the equation + feval = f % evaluate( x ) + IF( (ABS(feval)) <= 1.0_real64 )THEN + r = 0 + ELSE + r = 1 + ENDIF + + ! Clean up memory + CALL f % Destruct() + +END FUNCTION random_sfp64 diff --git a/test/sech_r1fp32.f90 b/test/sech_r1fp32.f90 new file mode 100644 index 0000000..b01beba --- /dev/null +++ b/test/sech_r1fp32.f90 @@ -0,0 +1,41 @@ + +INTEGER FUNCTION sech_r1fp32() RESULT(r) + USE FEQParse + use iso_fortran_env + IMPLICIT NONE + integer, parameter :: N=1000 + TYPE(EquationParser) :: f + CHARACTER(LEN=1), DIMENSION(1:3) :: independentVars + CHARACTER(LEN=30) :: eqChar + REAL(real32) :: x(1:N,1:3) + REAL(real32) :: feval(1:N) + REAL(real32) :: fexact(1:N) + integer :: i + + ! Specify the independent variables + independentVars = (/ 'x', 'y', 'z' /) + + ! Specify an equation string that we want to evaluate + eqChar = 'f = \sech( x )' + + ! Create the EquationParser object + f = EquationParser(eqChar, independentVars) + + x = 0.0_real32 + do i = 1,N + x(i,1) = -1.0_real32 + (2.0_real32)/REAL(N,real32)*REAL(i-1,real32) + fexact(i) = 2.0_real32/( exp(x(i,1)) + exp(-x(i,1)) ) + enddo + + ! Evaluate the equation + feval = f % evaluate( x ) + IF( MAXVAL(ABS(feval-fexact)) <= epsilon(1.0_real32) )THEN + r = 0 + ELSE + r = 1 + ENDIF + + ! Clean up memory + CALL f % Destruct() + +END FUNCTION sech_r1fp32 diff --git a/test/sech_r1fp64.f90 b/test/sech_r1fp64.f90 new file mode 100644 index 0000000..151478d --- /dev/null +++ b/test/sech_r1fp64.f90 @@ -0,0 +1,41 @@ + +INTEGER FUNCTION sech_r1fp64() RESULT(r) + USE FEQParse + use iso_fortran_env + IMPLICIT NONE + integer, parameter :: N=1000 + TYPE(EquationParser) :: f + CHARACTER(LEN=1), DIMENSION(1:3) :: independentVars + CHARACTER(LEN=30) :: eqChar + REAL(real64) :: x(1:N,1:3) + REAL(real64) :: feval(1:N) + REAL(real64) :: fexact(1:N) + integer :: i + + ! Specify the independent variables + independentVars = (/ 'x', 'y', 'z' /) + + ! Specify an equation string that we want to evaluate + eqChar = 'f = \sech( x )' + + ! Create the EquationParser object + f = EquationParser(eqChar, independentVars) + + x = 0.0_real64 + do i = 1,N + x(i,1) = -1.0_real64 + (2.0_real64)/REAL(N,real64)*REAL(i-1,real64) + fexact(i) = 2.0_real64/( exp(x(i,1)) + exp(-x(i,1)) ) + enddo + + ! Evaluate the equation + feval = f % evaluate( x ) + IF( MAXVAL(ABS(feval-fexact)) <= epsilon(1.0) )THEN + r = 0 + ELSE + r = 1 + ENDIF + + ! Clean up memory + CALL f % Destruct() + +END FUNCTION sech_r1fp64 diff --git a/test/sech_sfp32.f90 b/test/sech_sfp32.f90 new file mode 100644 index 0000000..cfe1311 --- /dev/null +++ b/test/sech_sfp32.f90 @@ -0,0 +1,38 @@ + +INTEGER FUNCTION sech_sfp32() RESULT(r) + USE FEQParse + use iso_fortran_env + IMPLICIT NONE + integer, parameter :: N=1000 + TYPE(EquationParser) :: f + CHARACTER(LEN=1), DIMENSION(1:3) :: independentVars + CHARACTER(LEN=30) :: eqChar + REAL(real32) :: x(1:3) + REAL(real32) :: feval + REAL(real32) :: fexact + integer :: i + + ! Specify the independent variables + independentVars = (/ 'x', 'y', 'z' /) + + ! Specify an equation string that we want to evaluate + eqChar = 'f = \sech( x )' + + ! Create the EquationParser object + f = EquationParser(eqChar, independentVars) + + x = 0.0_real32 + fexact = 2.0_real32/( exp(x(1)) + exp(-x(1)) ) + + ! Evaluate the equation + feval = f % evaluate( x ) + IF( (ABS(feval-fexact)) <= epsilon(1.0_real32) )THEN + r = 0 + ELSE + r = 1 + ENDIF + + ! Clean up memory + CALL f % Destruct() + +END FUNCTION sech_sfp32 diff --git a/test/sech_sfp64.f90 b/test/sech_sfp64.f90 new file mode 100644 index 0000000..240865f --- /dev/null +++ b/test/sech_sfp64.f90 @@ -0,0 +1,38 @@ + +INTEGER FUNCTION sech_sfp64() RESULT(r) + USE FEQParse + use iso_fortran_env + IMPLICIT NONE + integer, parameter :: N=1000 + TYPE(EquationParser) :: f + CHARACTER(LEN=1), DIMENSION(1:3) :: independentVars + CHARACTER(LEN=30) :: eqChar + REAL(real64) :: x(1:3) + REAL(real64) :: feval + REAL(real64) :: fexact + integer :: i + + ! Specify the independent variables + independentVars = (/ 'x', 'y', 'z' /) + + ! Specify an equation string that we want to evaluate + eqChar = 'f = \sech( x )' + + ! Create the EquationParser object + f = EquationParser(eqChar, independentVars) + + x = 0.0_real64 + fexact = 2.0_real64/( exp(x(1)) + exp(-x(1)) ) + + ! Evaluate the equation + feval = f % evaluate( x ) + IF( (ABS(feval-fexact)) <= epsilon(1.0_real64) )THEN + r = 0 + ELSE + r = 1 + ENDIF + + ! Clean up memory + CALL f % Destruct() + +END FUNCTION sech_sfp64 diff --git a/test/sqrt_r1fp32.f90 b/test/sqrt_r1fp32.f90 new file mode 100644 index 0000000..18ce05c --- /dev/null +++ b/test/sqrt_r1fp32.f90 @@ -0,0 +1,41 @@ + +INTEGER FUNCTION sqrt_r1fp32() RESULT(r) + USE FEQParse + use iso_fortran_env + IMPLICIT NONE + integer, parameter :: N=1000 + TYPE(EquationParser) :: f + CHARACTER(LEN=1), DIMENSION(1:3) :: independentVars + CHARACTER(LEN=30) :: eqChar + REAL(real32) :: x(1:N,1:3) + REAL(real32) :: feval(1:N) + REAL(real32) :: fexact(1:N) + integer :: i + + ! Specify the independent variables + independentVars = (/ 'x', 'y', 'z' /) + + ! Specify an equation string that we want to evaluate + eqChar = 'f = \sqrt( x )' + + ! Create the EquationParser object + f = EquationParser(eqChar, independentVars) + + x = 0.0_real32 + do i = 1,N + x(i,1) = (2.0_real32)/REAL(N,real32)*REAL(i-1,real32) + fexact(i) = sqrt(x(i,1)) + enddo + + ! Evaluate the equation + feval = f % evaluate( x ) + IF( MAXVAL(ABS(feval-fexact)) <= epsilon(1.0_real32) )THEN + r = 0 + ELSE + r = 1 + ENDIF + + ! Clean up memory + CALL f % Destruct() + +END FUNCTION sqrt_r1fp32 diff --git a/test/sqrt_r1fp64.f90 b/test/sqrt_r1fp64.f90 new file mode 100644 index 0000000..bfe3583 --- /dev/null +++ b/test/sqrt_r1fp64.f90 @@ -0,0 +1,41 @@ + +INTEGER FUNCTION sqrt_r1fp64() RESULT(r) + USE FEQParse + use iso_fortran_env + IMPLICIT NONE + integer, parameter :: N=1000 + TYPE(EquationParser) :: f + CHARACTER(LEN=1), DIMENSION(1:3) :: independentVars + CHARACTER(LEN=30) :: eqChar + REAL(real64) :: x(1:N,1:3) + REAL(real64) :: feval(1:N) + REAL(real64) :: fexact(1:N) + integer :: i + + ! Specify the independent variables + independentVars = (/ 'x', 'y', 'z' /) + + ! Specify an equation string that we want to evaluate + eqChar = 'f = \sqrt( x )' + + ! Create the EquationParser object + f = EquationParser(eqChar, independentVars) + + x = 0.0_real64 + do i = 1,N + x(i,1) = (2.0_real64)/REAL(N,real64)*REAL(i-1,real64) + fexact(i) = sqrt(x(i,1)) + enddo + + ! Evaluate the equation + feval = f % evaluate( x ) + IF( MAXVAL(ABS(feval-fexact)) <= epsilon(1.0) )THEN + r = 0 + ELSE + r = 1 + ENDIF + + ! Clean up memory + CALL f % Destruct() + +END FUNCTION sqrt_r1fp64 diff --git a/test/sqrt_sfp32.f90 b/test/sqrt_sfp32.f90 new file mode 100644 index 0000000..5b4975c --- /dev/null +++ b/test/sqrt_sfp32.f90 @@ -0,0 +1,38 @@ + +INTEGER FUNCTION sqrt_sfp32() RESULT(r) + USE FEQParse + use iso_fortran_env + IMPLICIT NONE + integer, parameter :: N=1000 + TYPE(EquationParser) :: f + CHARACTER(LEN=1), DIMENSION(1:3) :: independentVars + CHARACTER(LEN=30) :: eqChar + REAL(real32) :: x(1:3) + REAL(real32) :: feval + REAL(real32) :: fexact + integer :: i + + ! Specify the independent variables + independentVars = (/ 'x', 'y', 'z' /) + + ! Specify an equation string that we want to evaluate + eqChar = 'f = \sqrt( x )' + + ! Create the EquationParser object + f = EquationParser(eqChar, independentVars) + + x = 100.0_real32 + fexact = sqrt(x(1)) + + ! Evaluate the equation + feval = f % evaluate( x ) + IF( (ABS(feval-fexact)) <= epsilon(1.0_real32) )THEN + r = 0 + ELSE + r = 1 + ENDIF + + ! Clean up memory + CALL f % Destruct() + +END FUNCTION sqrt_sfp32 diff --git a/test/sqrt_sfp64.f90 b/test/sqrt_sfp64.f90 new file mode 100644 index 0000000..723af59 --- /dev/null +++ b/test/sqrt_sfp64.f90 @@ -0,0 +1,38 @@ + +INTEGER FUNCTION sqrt_sfp64() RESULT(r) + USE FEQParse + use iso_fortran_env + IMPLICIT NONE + integer, parameter :: N=1000 + TYPE(EquationParser) :: f + CHARACTER(LEN=1), DIMENSION(1:3) :: independentVars + CHARACTER(LEN=30) :: eqChar + REAL(real64) :: x(1:3) + REAL(real64) :: feval + REAL(real64) :: fexact + integer :: i + + ! Specify the independent variables + independentVars = (/ 'x', 'y', 'z' /) + + ! Specify an equation string that we want to evaluate + eqChar = 'f = \sqrt( x )' + + ! Create the EquationParser object + f = EquationParser(eqChar, independentVars) + + x = 100.0_real64 + fexact = sqrt(x(1)) + + ! Evaluate the equation + feval = f % evaluate( x ) + IF( (ABS(feval-fexact)) <= epsilon(1.0_real64) )THEN + r = 0 + ELSE + r = 1 + ENDIF + + ! Clean up memory + CALL f % Destruct() + +END FUNCTION sqrt_sfp64 diff --git a/test/test.f90 b/test/test.f90 index 21f3bda..37a7918 100644 --- a/test/test.f90 +++ b/test/test.f90 @@ -11,34 +11,66 @@ program test contains - include "gaussian3d_sfp32.f90" + include "abs_r1fp64.f90" + include "abs_sfp32.f90" + include "abs_sfp64.f90" + include "acos_r1fp32.f90" + include "acos_r1fp64.f90" + include "acos_sfp32.f90" + include "acos_sfp64.f90" + include "asin_r1fp32.f90" + include "asin_r1fp64.f90" + include "asin_sfp32.f90" + include "asin_sfp64.f90" + include "atan_r1fp32.f90" + include "atan_r1fp64.f90" + include "atan_sfp32.f90" + include "atan_sfp64.f90" + include "cos_r1fp32.f90" + include "cos_r1fp64.f90" include "cos_sfp32.f90" - include "sin_sfp32.f90" - include "tan_sfp32.f90" - include "tanh_sfp32.f90" - - include "gaussian3d_sfp64.f90" include "cos_sfp64.f90" - include "sin_sfp64.f90" - include "tan_sfp64.f90" - include "tanh_sfp64.f90" - + include "gaussian3d_r1fp32.f90" + include "gaussian3d_r1fp64.f90" + include "gaussian3d_sfp32.f90" + include "gaussian3d_sfp64.f90" include "linear_r1fp32.f90" include "linear_r1fp64.f90" - - include "gaussian3d_r1fp32.f90" - include "cos_r1fp32.f90" + include "log10_r1fp32.f90" + include "log10_r1fp64.f90" + include "log10_sfp32.f90" + include "log10_sfp64.f90" + include "log_r1fp32.f90" + include "log_r1fp64.f90" + include "log_sfp32.f90" + include "log_sfp64.f90" + include "random_r1fp32.f90" + include "random_r1fp64.f90" + include "random_sfp32.f90" + include "random_sfp64.f90" + include "sech_r1fp32.f90" + include "sech_r1fp64.f90" + include "sech_sfp32.f90" + include "sech_sfp64.f90" include "sin_r1fp32.f90" - include "tan_r1fp32.f90" - include "tanh_r1fp32.f90" - - include "gaussian3d_r1fp64.f90" - include "cos_r1fp64.f90" include "sin_r1fp64.f90" - include "tan_r1fp64.f90" + include "sin_sfp32.f90" + include "sin_sfp64.f90" + include "sqrt_r1fp32.f90" + include "sqrt_r1fp64.f90" + include "sqrt_sfp32.f90" + include "sqrt_sfp64.f90" + include "tanh_r1fp32.f90" include "tanh_r1fp64.f90" + include "tanh_sfp32.f90" + include "tanh_sfp64.f90" + include "tan_r1fp32.f90" + include "tan_r1fp64.f90" + include "tan_sfp32.f90" + include "tan_sfp64.f90" + -end program test \ No newline at end of file +end program testinclude "abs_r1fp32.f90"