Resolve failing tests

src/FEQParse.F90

@@ -270,7 +270,7 @@ subroutine Tokenize(parser,tokenized,errorMsg)
 
         i = i + 1
 
-      elseif (parser % func % IsFunction(parser % inFixFormula(i:i))) then
+      elseif (IsFunction(parser % inFixFormula(i:i))) then
 
         parser % inFix % top_index = parser % inFix % top_index + 1
         parser % inFix % tokens(parser % inFix % top_index) % tokenString = ''
@@ -1673,7 +1673,7 @@ integer function Priority(parser,operatorString)
     class(EquationParser) :: parser
     character(*) :: operatorString
 
-    if (parser % func % IsFunction(operatorString)) then
+    if (IsFunction(operatorString)) then
 
       Priority = 4
 
@@ -1696,5 +1696,28 @@ integer function Priority(parser,operatorString)
     end if
 
   end function Priority
+  logical function IsFunction(eqChar)
+  character(*) :: eqChar
+
+  IsFunction = .false.
+  if (eqChar(1:1) == "\") then
+    IsFunction = .true.
+  end if
+
+end function IsFunction
+
+function FindLastFunctionIndex(eqChar) result(j)
+  character(*) :: eqChar
+  integer      :: i,j
+
+  do i = 1,len(eqChar)
+    if (eqChar(i:i) == "(") then
+      j = i - 2
+      exit
+    end if
+
+  end do
+
+end function FindLastFunctionIndex
 
 end module FEQParse

src/FEQParse_Functions.F90

@@ -30,7 +30,7 @@ module FEQParse_Functions
 
   contains
     procedure,public :: Destruct => Destruct_FEQParse_FunctionHandler
-    procedure,public :: IsFunction
+    !procedure,public :: IsFunction
     generic,public :: f_of_x => f_of_x_sfp32, &
       f_of_x_r1fp32, &
       f_of_x_r2fp32, &
@@ -92,37 +92,6 @@ subroutine Destruct_FEQParse_FunctionHandler(functionhandler_obj)
 
   end subroutine Destruct_FEQParse_FunctionHandler
 
-  logical function IsFunction(functionhandler_obj,eqChar)
-    class(FEQParse_FunctionHandler) :: functionhandler_obj
-    character(*) :: eqChar
-    ! Local
-    integer :: i
-
-    IsFunction = .false.
-    do i = 1,functionhandler_obj % nFunctions
-
-      if (eqChar(1:1) == "\") then
-        IsFunction = .true.
-      end if
-
-    end do
-
-  end function IsFunction
-
-  function FindLastFunctionIndex(eqChar) result(j)
-    character(*) :: eqChar
-    integer      :: i,j
-
-    do i = 1,len(eqChar)
-      if (eqChar(i:i) == "(") then
-        j = i - 2
-        exit
-      end if
-
-    end do
-
-  end function FindLastFunctionIndex
-
   subroutine f_of_x_sfp32(functionhandler_obj,func,x,fx)
     !! Evaluates function for scalar fp32 input and output
     class(FEQParse_FunctionHandler) :: functionhandler_obj

test/abs_r3fp32.f90

@@ -27,14 +27,14 @@ integer function abs_r3fp32() result(r)
 
   x = 0.0_real32
   do k = 1,N
-  do j = 1,N
-    do i = 1,N
-      x(i,j,k,1) = -1.0_real32 + (2.0_real32)/real(N,real32)*real(i - 1,real32)
-      x(i,j,k,2) = -1.0_real32 + (2.0_real32)/real(N,real32)*real(j - 1,real32)
-      x(i,j,k,3) = -1.0_real32 + (2.0_real32)/real(N,real32)*real(k - 1,real32)
+    do j = 1,N
+      do i = 1,N
+        x(i,j,k,1) = -1.0_real32 + (2.0_real32)/real(N,real32)*real(i - 1,real32)
+        x(i,j,k,2) = -1.0_real32 + (2.0_real32)/real(N,real32)*real(j - 1,real32)
+        x(i,j,k,3) = -1.0_real32 + (2.0_real32)/real(N,real32)*real(k - 1,real32)
+      end do
     end do
   end do
-  end do
 
   do k = 1,N
     do j = 1,N
@@ -46,7 +46,7 @@ integer function abs_r3fp32() result(r)
 
   ! Evaluate the equation
   feval = f % evaluate(x)
-  if (maxval(abs(feval - fexact)) <= epsilon(1.0_real32)) then
+  if (maxval(abs(feval - fexact)) <= 10.0_real32*epsilon(1.0_real32)) then
     r = 0
   else
     r = 1

test/abs_r3fp64.f90

@@ -46,7 +46,7 @@ integer function abs_r3fp64() result(r)
 
   ! Evaluate the equation
   feval = f % evaluate(x)
-  if (maxval(abs(feval - fexact)) <= epsilon(1.0_real64)) then
+  if (maxval(abs(feval - fexact)) <= 10.0_real64*epsilon(1.0_real64)) then
     r = 0
   else
     r = 1

test/abs_r4fp32.f90

@@ -51,9 +51,10 @@ integer function abs_r4fp32() result(r)
 
   ! Evaluate the equation
   feval = f % evaluate(x)
-  if (maxval(abs(feval - fexact)) <= epsilon(1.0_real32)) then
+  if (maxval(abs(feval - fexact)) <=  maxval(abs(fexact))*epsilon(1.0_real32)) then
     r = 0
   else
+    print*,maxval(abs(feval - fexact))
     r = 1
   end if
 

test/abs_r4fp64.f90

@@ -51,7 +51,7 @@ integer function abs_r4fp64() result(r)
 
   ! Evaluate the equation
   feval = f % evaluate(x)
-  if (maxval(abs(feval - fexact)) <= epsilon(1.0_real64)) then
+  if (maxval(abs(feval - fexact)) <= maxval(abs(fexact))*epsilon(1.0_real64)) then
     r = 0
   else
     r = 1

test/acos_r3fp32.f90

@@ -46,7 +46,7 @@ integer function acos_r3fp32() result(r)
 
   ! Evaluate the equation
   feval = f % evaluate(x)
-  if (maxval(abs(feval - fexact)) <= epsilon(1.0_real32)) then
+  if (maxval(abs(feval - fexact)) <= maxval(abs(fexact))*epsilon(1.0_real32)) then
     r = 0
   else
     r = 1

test/acos_r3fp64.f90

@@ -46,7 +46,7 @@ integer function acos_r3fp64() result(r)
 
   ! Evaluate the equation
   feval = f % evaluate(x)
-  if (maxval(abs(feval - fexact)) <= epsilon(1.0_real64)) then
+  if (maxval(abs(feval - fexact)) <= maxval(abs(fexact))*epsilon(1.0_real64)) then
     r = 0
   else
     r = 1

test/acos_r4fp32.f90

@@ -51,7 +51,7 @@ integer function acos_r4fp32() result(r)
 
   ! Evaluate the equation
   feval = f % evaluate(x)
-  if (maxval(abs(feval - fexact)) <= epsilon(1.0_real32)) then
+  if (maxval(abs(feval - fexact)) <= maxval(abs(fexact))*epsilon(1.0_real32)) then
     r = 0
   else
     r = 1

test/acos_r4fp64.f90

@@ -51,7 +51,7 @@ integer function acos_r4fp64() result(r)
 
   ! Evaluate the equation
   feval = f % evaluate(x)
-  if (maxval(abs(feval - fexact)) <= epsilon(1.0_real64)) then
+  if (maxval(abs(feval - fexact)) <= maxval(abs(fexact))*epsilon(1.0_real64)) then
     r = 0
   else
     r = 1

test/asin_r3fp32.f90

@@ -45,7 +45,7 @@ integer function asin_r3fp32() result(r)
 
   ! Evaluate the equation
   feval = f % evaluate(x)
-  if (maxval(abs(feval - fexact)) <= epsilon(1.0_real32)) then
+  if (maxval(abs(feval - fexact)) <= maxval(abs(fexact))*epsilon(1.0_real32)) then
     r = 0
   else
     r = 1

test/asin_r3fp64.f90

@@ -45,7 +45,7 @@ integer function asin_r3fp64() result(r)
 
   ! Evaluate the equation
   feval = f % evaluate(x)
-  if (maxval(abs(feval - fexact)) <= epsilon(1.0_real64)) then
+  if (maxval(abs(feval - fexact)) <= maxval(abs(fexact))*epsilon(1.0_real64)) then
     r = 0
   else
     r = 1

test/atan_r3fp32.f90

@@ -46,7 +46,7 @@ integer function atan_r3fp32() result(r)
 
   ! Evaluate the equation
   feval = f % evaluate(x)
-  if (maxval(abs(feval - fexact)) <= epsilon(1.0_real32)) then
+  if (maxval(abs(feval - fexact)) <= maxval(abs(fexact))*epsilon(1.0_real32)) then
     r = 0
   else
     r = 1

test/atan_r3fp64.f90

@@ -46,7 +46,7 @@ integer function atan_r3fp64() result(r)
 
   ! Evaluate the equation
   feval = f % evaluate(x)
-  if (maxval(abs(feval - fexact)) <= epsilon(1.0_real64)) then
+  if (maxval(abs(feval - fexact)) <= maxval(abs(fexact))*epsilon(1.0_real64)) then
     r = 0
   else
     r = 1

test/cos_r3fp32.f90

@@ -46,7 +46,7 @@ integer function cos_r3fp32() result(r)
 
   ! Evaluate the equation
   feval = f % evaluate(x)
-  if (maxval(abs(feval - fexact)) <= epsilon(1.0_real32)) then
+  if (maxval(abs(feval - fexact)) <= maxval(abs(fexact))*epsilon(1.0_real32)) then
     r = 0
   else
     r = 1

test/cos_r3fp64.f90

@@ -46,7 +46,7 @@ integer function cos_r3fp64() result(r)
 
   ! Evaluate the equation
   feval = f % evaluate(x)
-  if (maxval(abs(feval - fexact)) <= epsilon(1.0_real64)) then
+  if (maxval(abs(feval - fexact)) <= maxval(abs(fexact))*epsilon(1.0_real64)) then
     r = 0
   else
     r = 1

test/linear_r3fp32.f90

@@ -40,14 +40,14 @@ integer function linear_r3fp32() result(r)
   do k = 1,N
     do j = 1,N
       do i = 1,N
-        fexact(i,j,k) = (x(i,j,k,1)**3 - 1.0_real32)*(x(i,j,k,2)**3 - 1.0_real32)*(x(i,j,k,2)**3 - 1.0_real32)
+        fexact(i,j,k) = (x(i,j,k,1)**3 - 1.0_real32)*(x(i,j,k,2)**3 - 1.0_real32)*(x(i,j,k,3)**3 - 1.0_real32)
       end do
     end do
   end do
 
   ! Evaluate the equation
   feval = f % evaluate(x)
-  if (maxval(abs(feval - fexact)) <= 10.0_real32*epsilon(1.0_real32)) then
+  if (maxval(abs(feval - fexact)) <= maxval(abs(fexact))*epsilon(1.0_real32)*10.0_real32) then
     r = 0
   else
     r = 1

test/linear_r3fp64.f90

@@ -40,14 +40,14 @@ integer function linear_r3fp64() result(r)
   do k = 1,N
     do j = 1,N
       do i = 1,N
-        fexact(i,j,k) = (x(i,j,k,1)**3 - 1.0_real64)*(x(i,j,k,2)**3 - 1.0_real64)*(x(i,j,k,2)**3 - 1.0_real64)
+        fexact(i,j,k) = (x(i,j,k,1)**3 - 1.0_real64)*(x(i,j,k,2)**3 - 1.0_real64)*(x(i,j,k,3)**3 - 1.0_real64)
       end do
     end do
   end do
 
   ! Evaluate the equation
   feval = f % evaluate(x)
-  if (maxval(abs(feval - fexact)) <= 10.0_real64*epsilon(1.0_real64)) then
+  if (maxval(abs(feval - fexact)) <= maxval(abs(fexact))*epsilon(1.0_real64)*10.0_real64) then
     r = 0
   else
     r = 1

test/linear_r4fp32.f90

@@ -44,15 +44,15 @@ integer function linear_r4fp32() result(r)
     do k = 1,N
     do j = 1,N
       do i = 1,N
-        fexact(i,j,k,l) = (x(i,j,k,l,1)**3 - 1.0_real32)*(x(i,j,k,l,2)**3 - 1.0_real32)*(x(i,j,k,l,2)**3 - 1.0_real32)
+        fexact(i,j,k,l) = (x(i,j,k,l,1)**3 - 1.0_real32)*(x(i,j,k,l,2)**3 - 1.0_real32)*(x(i,j,k,l,3)**3 - 1.0_real32)
       end do
     end do
     end do
   end do
 
   ! Evaluate the equation
   feval = f % evaluate(x)
-  if (maxval(abs(feval - fexact)) <= 10.0_real32*epsilon(1.0_real32)) then
+  if (maxval(abs(feval - fexact)) <= maxval(abs(fexact))*epsilon(1.0_real32)*10.0_real32) then
     r = 0
   else
     r = 1

test/linear_r4fp64.f90

@@ -44,15 +44,15 @@ integer function linear_r4fp64() result(r)
     do k = 1,N
     do j = 1,N
       do i = 1,N
-        fexact(i,j,k,l) = (x(i,j,k,l,1)**3 - 1.0_real64)*(x(i,j,k,l,2)**3 - 1.0_real64)*(x(i,j,k,l,2)**3 - 1.0_real64)
+        fexact(i,j,k,l) = (x(i,j,k,l,1)**3 - 1.0_real64)*(x(i,j,k,l,2)**3 - 1.0_real64)*(x(i,j,k,l,3)**3 - 1.0_real64)
       end do
     end do
     end do
   end do
 
   ! Evaluate the equation
   feval = f % evaluate(x)
-  if (maxval(abs(feval - fexact)) <= 10.0_real64*epsilon(1.0_real64)) then
+  if (maxval(abs(feval - fexact)) <= maxval(abs(fexact))*epsilon(1.0_real64)*10.0_real64) then
     r = 0
   else
     r = 1

test/log_r3fp32.f90

@@ -38,14 +38,14 @@ integer function log_r3fp32() result(r)
   do k = 1,N
     do j = 1,N
       do i = 1,N
-        fexact(i,j,k) = log(x(i,j,k,1))*log(x(i,j,k,2))*log(x(i,j,k,2))
+        fexact(i,j,k) = log(x(i,j,k,1))*log(x(i,j,k,2))*log(x(i,j,k,3))
       end do
     end do
   end do
 
   ! Evaluate the equation
   feval = f % evaluate(x)
-  if (maxval(abs(feval - fexact)) <= epsilon(1.0_real32)) then
+  if (maxval(abs(feval - fexact)) <= maxval(abs(fexact))*epsilon(1.0_real32)) then
     r = 0
   else
     r = 1

test/log_r3fp64.f90

@@ -38,14 +38,14 @@ integer function log_r3fp64() result(r)
   do k = 1,N
     do j = 1,N
       do i = 1,N
-        fexact(i,j,k) = log(x(i,j,k,1))*log(x(i,j,k,2))*log(x(i,j,k,2))
+        fexact(i,j,k) = log(x(i,j,k,1))*log(x(i,j,k,2))*log(x(i,j,k,3))
       end do
     end do
   end do
 
   ! Evaluate the equation
   feval = f % evaluate(x)
-  if (maxval(abs(feval - fexact)) <= epsilon(1.0_real64)) then
+  if (maxval(abs(feval - fexact)) <= maxval(abs(fexact))*epsilon(1.0_real64)) then
     r = 0
   else
     r = 1

test/log_r4fp32.f90

@@ -42,15 +42,15 @@ integer function log_r4fp32() result(r)
     do k = 1,N
     do j = 1,N
       do i = 1,N
-        fexact(i,j,k,l) = log(x(i,j,k,l,1))*log(x(i,j,k,l,2))*log(x(i,j,k,l,2))
+        fexact(i,j,k,l) = log(x(i,j,k,l,1))*log(x(i,j,k,l,2))*log(x(i,j,k,l,3))
       end do
     end do
     end do
   end do
 
   ! Evaluate the equation
   feval = f % evaluate(x)
-  if (maxval(abs(feval - fexact)) <= epsilon(1.0_real32)) then
+  if (maxval(abs(feval - fexact)) <= maxval(abs(fexact))*epsilon(1.0_real32)) then
     r = 0
   else
     r = 1

test/log_r4fp64.f90

@@ -42,15 +42,15 @@ integer function log_r4fp64() result(r)
     do k = 1,N
     do j = 1,N
       do i = 1,N
-        fexact(i,j,k,l) = log(x(i,j,k,l,1))*log(x(i,j,k,l,2))*log(x(i,j,k,l,2))
+        fexact(i,j,k,l) = log(x(i,j,k,l,1))*log(x(i,j,k,l,2))*log(x(i,j,k,l,3))
       end do
     end do
     end do
   end do
 
   ! Evaluate the equation
   feval = f % evaluate(x)
-  if (maxval(abs(feval - fexact)) <= epsilon(1.0_real64)) then
+  if (maxval(abs(feval - fexact)) <= maxval(abs(fexact))*epsilon(1.0_real64)) then
     r = 0
   else
     r = 1

test/sqrt_r3fp32.f90

@@ -45,7 +45,7 @@ integer function sqrt_r3fp32() result(r)
 
   ! Evaluate the equation
   feval = f % evaluate(x)
-  if (maxval(abs(feval - fexact)) <= epsilon(1.0_real32)) then
+  if (maxval(abs(feval - fexact)) <= maxval(abs(fexact))*epsilon(1.0_real32)) then
     r = 0
   else
     r = 1