[ADD] Added support for mutliple validation methods. Now it is both possible to specify a manual threshold or use gamma_n, at least for psb_gedot

.gitignore

@@ -22,6 +22,9 @@ config.status
 docs/src/tmp
 autom4te.cache
 
+build/
+
+
 # the executable from tests
 runs
 

test/computational_routines/gedot/CMakeLists.txt

@@ -1,6 +1,5 @@
 set(PSB_gedot_source_files
   psb_gedot_test.f90
-  gedot.f90
 )
 foreach(file IN LISTS PSB_gedot_source_files)
   list(APPEND gedot_source_files ${CMAKE_CURRENT_LIST_DIR}/${file})

test/computational_routines/gedot/autotest.sh

@@ -37,7 +37,7 @@ echo -e "${BLUE}[INFO]\t  Starting $num_procs processes computation${RESET}"
 mpirun -np $num_procs ./psb_gedot_test
 echo -e "${BLUE}[INFO]\t  Multiple processes computation terminated correctly${RESET}"
 
-echo "" >> ${log_file_name}
+# echo "" >> ${log_file_name}
 
 
 # Iterate through files in the first directory

test/computational_routines/gedot/psb_gedot_test.f90

@@ -123,7 +123,7 @@ program main
 
     !! Initialize test metadata
     test_info%total_tests = size(x) * size(y)
-    test_info%threshold_type = VALUE
+    test_info%threshold_type = GAMMA
     test_info%threshold = 0.0
     test_info%kernel_name = "psb_gedot"
 
@@ -146,7 +146,7 @@ program main
             call psb_gedot_real_kernel(x(i), y(j), arr_size, test_info%ctxt, result_single, result_double)
             
             if(test_info%my_rank == psb_root_) then
-                call psb_test_single_double_check(result_single,result_double,test_info)
+                call psb_test_single_double_check(result_single,result_double,test_info, arr_size)
                 test_info%current_test = test_info%current_test + 1 
             end if
             call psb_barrier(test_info%ctxt)            

test/computational_routines/gedot/psblas_gedot_test.log

@@ -1,4 +0,0 @@
-
-
-
-

test/computational_routines/utils/psb_test_utils.f90

@@ -14,11 +14,13 @@
 module psb_test_utils
     use psb_base_mod
     use psb_util_mod
+    use, intrinsic :: ieee_arithmetic
 
     implicit none
 
     ! Define the enumeration values to represent testing criteria
     integer, parameter :: VALUE = 1
+    integer, parameter :: GAMMA = 2
 
     ! Define test metadata struct
     type :: test_info_
@@ -122,6 +124,60 @@ contains
         call psb_exit(test_info%ctxt)
     end subroutine
 
+
+    !> @brief Function to validate the test information structure.
+    !!        It sets the threshold value based on the threshold type.
+    !!
+    !! @param result_single The single precision result to be validated.
+    !! @param result_double The double precision result to be validated.
+    !! @param test_info The test information structure to be validated.
+    !! @param arr_size The size of the array to be used for validation.
+    !!
+    function psb_test_validate(result_single, result_double, test_info, arr_size) result(pass)
+        type(test_info_)    :: test_info
+        real(psb_spk_)      :: result_single
+        real(psb_dpk_)      :: result_double
+        integer(psb_ipk_)   :: arr_size,int_digits
+        real(psb_dpk_)      :: gamma_n, unit_roundoff, delta, rel_err
+        logical             :: pass   
+
+        unit_roundoff = 5.96D-08 !! 1.11D-16
+
+        call shift_decimal_single(result_single,int_digits)
+        call shift_decimal_double(result_double,int_digits)
+
+        delta = abs(result_double - real(result_single,psb_dpk_))
+
+
+        if(test_info%threshold_type == VALUE) then
+            if(delta < test_info%threshold) then
+                pass = .true.
+            else
+                pass = .false.
+            end if
+        else if(test_info%threshold_type == GAMMA) then
+            gamma_n = (arr_size * unit_roundoff) / (1 - unit_roundoff * arr_size)
+            test_info%threshold = gamma_n
+            rel_err = delta / real(result_single,psb_dpk_)
+
+            !! Handle case when result_single is zero
+            if ((ieee_is_nan(rel_err)).and.(result_single == 0.0)) then
+                rel_err = 0.0
+            end if
+            
+            if( rel_err < gamma_n) then
+                pass = .true.
+            else
+                pass = .false.
+            end if
+        else
+            write(test_info%output_unit,'(A,I0)') "Error: Invalid threshold type: ", test_info%threshold_type
+            write(*,*)
+            call psb_test_exit(test_info)
+        end if
+
+    end function psb_test_validate
+
     !> @brief Function to randomly generate x and y vectors 
     !!        and save them on multiple files based on their
     !!        coefficients values.
@@ -253,9 +309,10 @@ contains
     !! @param result_single The single precision result to be checked.
     !! @param result_double The double precision result to be checked.
     !! @param test_info The test information structure containing the threshold and logging details.
+    !! @param arr_size The size of the array used in the computation.
     !!
-    subroutine psb_test_single_double_check(result_single, result_double, test_info)
-        integer(psb_ipk_)               :: int_digits 
+    subroutine psb_test_single_double_check(result_single, result_double, test_info, arr_size)
+        integer(psb_ipk_)               :: int_digits, arr_size 
         real(psb_spk_), intent(inout)   :: result_single
         real(psb_dpk_), intent(inout)   :: result_double
         real(psb_dpk_)                  :: delta
@@ -264,12 +321,7 @@ contains
 
         call psb_test_progress_bar(test_info)
 
-        call shift_decimal_single(result_single,int_digits)
-        call shift_decimal_double(result_double,int_digits)
-
-        delta = abs(result_double - result_single)
-
-        if(delta < test_info%threshold) then 
+        if(psb_test_validate(result_single, result_double, test_info, arr_size)) then 
             call psb_test_log_passed(test_info)
             test_info%success = test_info%success + 1  
         else