diff --git a/test/computational_routines/README.md b/test/computational_routines/README.md
index 50cc3489..db72c24a 100644
--- a/test/computational_routines/README.md
+++ b/test/computational_routines/README.md
@@ -30,37 +30,30 @@ Each directory has the name of the computational kernel routines described in th
In this test suite were considered only computational routines implemented by PSBLAS, according to the version 3.9 of the documentation. In the following table are reported all the kernels, their implementation and wheter or not they were tested yet.
|**Kernel**| **PSBLAS Subroutine**|**Description**|**Single Process Test**|**Multi-Process Test**|**Complex Test**|**GPU Test**|
| ------------------------------- | :--------------------------: | ---------------------------------------------------------------------- | :---------------: |:---------------: |:---------------: |:---------------: |
-|**General Dense Matrix Sum**| `psb_geaxpby`| This subroutine is an interface to the computational kernel for dense matrix sum: $Y \leftarrow \alpha X + \beta Y$|Work in progress :hammer_and_wrench:|Work in progress :hammer_and_wrench:|No ❌|No ❌|
-| **Dot product**|`psb_gedot`|This function computes dot product between two vectors x and y.$dot \leftarrow x^T y$If x and y are real vectors it computes dot-product as:$dot \leftarrow x^H y$|Yes ✅|Yes ✅|No ❌|No ❌|
+|**General Dense Matrix Sum**| `psb_geaxpby`| This subroutine is an interface to the computational kernel for dense matrix sum: $Y \leftarrow \alpha X + \beta Y$ |Work in progress :hammer_and_wrench:|Work in progress :hammer_and_wrench:|No ❌|No ❌|
+| **Dot product**|`psb_gedot`|This function computes dot product between two vectors x and y. $dot \leftarrow x^T y$ If x and y are real vectors it computes dot-product as: $dot \leftarrow x^H y$ |Yes ✅|Yes ✅|No ❌|No ❌|
| **Generalized Dot Product** |`psb_gedots`|This subroutine computes a series of dot products among the columns of two dense matrices x and y:$res(i) \leftarrow x(:,i)^T y(:,i)$If the matrices are complex, then the usual convention applies, i.e. the conjugate transpose of x is used. If x and y are of rank one, then res is a scalar, else it is a rank one array.|No ❌|No ❌|No ❌|No ❌|
-|**Infinity-Norm of Vector**|`psb_normi`/`psb_geamax`|This function computes the infinity-norm of a vector x. If x is a real vector it computes infinity norm as:$amax \leftarrow max \mid x_i \mid$else if x is a complex vector then it computes the infinity-norm as:$amax \leftarrow max(\mid re(x_i) \mid + \mid im(x_i) \mid)$|No ❌|No ❌|No ❌|No ❌|
-|**Generalized Infinity Norm**|`psb_geamaxs`|This subroutine computes a series of infinity norms on the columns of a dense matrix x:$res(i) \leftarrow max_k \mid x(k,i) \mid$|No ❌|No ❌|No ❌|No ❌|
-| **1-Norm of Vector**| `psb_norm1` / `psb_geasums`|This function computes the 1-norm of a vector x. If x is a real vector it computes 1-norm as:$asum \leftarrow \mid \mid x_i \mid \mid$else if x is a complex vector then it computes 1-norm as:$asum \leftarrow \mid \mid re(x) \mid \mid_1 + \mid \mid im(x) \mid \mid_1$|No ❌|No ❌|No ❌|No ❌|
-|**Generalized 1-Norm of Vector**|`psb_geasums`|This subroutine computes a series of 1-norms on the columns of a dense matrix x:$res(i) \leftarrow max_k \mid x(k,i) \mid$This function computes the 1-norm of a vector x. If x is a real vector it computes 1-norm as:$res(i) \leftarrow \mid \mid x_i \mid \mid$else if x is a complex vector then it computes 1-norm as:$res(i) \leftarrow \mid \mid re(x) \mid \mid_\ + \mid \mid im(x) \mid \mid_1$|No ❌|No ❌|No ❌|No ❌|
-| **2-Norm of Vector**|`psb_norm2` / `psb_genrm2`| This function computes the 2-norm of a vector x. If x is a real vector it computes 2-norm as:$nrm2 \leftarrow \sqrt{x^T x}$else if x is a complex vector then it computes 2-norm as:$nrm2 \leftarrow \sqrt{x^H x}$|No ❌|No ❌|No ❌|No ❌|
-|**Generalized 2-Norm of Vector**|`psb_genrm2s` / `psb_spnrm1` |This subroutine computes a series of 2-norms on the columns of a dense matrix x:$res(i) \leftarrow \mid \mid x(:,i) \mid \mid_2$|No ❌|No ❌|No ❌|No ❌|
-|**1-Norm of Sparse Matrix**|`psb_norm1`|This function computes the 1-norm of a matrix A:$nrm1 \leftarrow \mid \mid A \mid \mid_1$where A represents the global matrix A|No ❌|No ❌|No ❌|No ❌|
-|**Infinity Norm of Sparse Matrix**|`psb_normi` / `psb_spnrmi`|This function computes the infinity-norm of a matrix A:$nrmi \leftarrow \mid \mid A \mid \mid_{\infty}$where: A represents the global matrix A|No ❌|No ❌|No ❌|No ❌|
-|**Sparse Matrix by Dense Matrix Product**| `psb_spmm`|This subroutine computes the Sparse Matrix by Dense Matrix Product:$y \leftarrow \alpha A x + \beta y$$y \leftarrow \alpha A^T x + \beta y$$y \leftarrow \alpha A^H x + \beta y$where:
x is the global dense matrix x_{:,:}
y is the global dense matrix y_{:,:}
A is the global sparse matrix A|Work in progress :hammer_and_wrench:|No ❌|No ❌|No ❌|
-|**Triangular System Solve**|`psb_spsm`|This subroutine computes the Triangular System Solve:$y \leftarrow \alpha T^{-1} x + \beta y$$y \leftarrow \alpha D^{-1} x + \beta y$$y \leftarrow \alpha T^{-1} D x + \beta y$$y \leftarrow \alpha T^{-T} x + \beta y$$y \leftarrow \alpha D T^{-T} x + \beta y$$y \leftarrow \alpha T^{-T} D x + \beta y$$y \leftarrow \alpha T^{-H} x + \beta y$$y \leftarrow \alpha D T^{-H} x + \beta y$$y \leftarrow \alpha T^{-H} D x + \beta y$where:
x is the global dense matrix x_{:,:}
y is the global dense matrix y_{:,:}
T is the global sparse block triangular submatrix T
D is the scaling diagonal matrix|No ❌|No ❌|No ❌|No ❌|
-|**Entrywise Product**|`psb_gemlt`|This function computes the entrywise product between two vectors x and y$dot \leftarrow x(i)y(i)$|No ❌|No ❌|No ❌|No ❌|
-|**Entrywise Division**|`psb_gediv`|This function computes the entrywise division between two vectors x and y$div \leftarrow \frac{x(i)}{y(i)}$|No ❌|No ❌|No ❌|No ❌|
-|**Entrywise Inversion**|`psb_geinv`|This function computes the entrywise inverse of a vector x and puts it into y$inv \leftarrow \frac{1}{x(i)}$|No ❌|No ❌|No ❌|No ❌|
+|**Infinity-Norm of Vector**|`psb_normi`/`psb_geamax`|This function computes the infinity-norm of a vector x. If x is a real vector it computes infinity norm as:$amax \leftarrow max \mid x_i \mid$else if x is a complex vector then it computes the infinity-norm as: $amax \leftarrow max(\mid re(x_i) \mid + \mid im(x_i) \mid)$ |No ❌|No ❌|No ❌|No ❌|
+|**Generalized Infinity Norm**|`psb_geamaxs`|This subroutine computes a series of infinity norms on the columns of a dense matrix x: $res(i) \leftarrow max_k \mid x(k,i) \mid$ |No ❌|No ❌|No ❌|No ❌|
+| **1-Norm of Vector**| `psb_norm1` / `psb_geasums`|This function computes the 1-norm of a vector x. If x is a real vector it computes 1-norm as: $asum \leftarrow \mid \mid x_i \mid \mid$ else if x is a complex vector then it computes 1-norm as: $asum \leftarrow \mid \mid re(x) \mid \mid_1 + \mid \mid im(x) \mid \mid_1$ |No ❌|No ❌|No ❌|No ❌|
+|**Generalized 1-Norm of Vector**|`psb_geasums`|This subroutine computes a series of 1-norms on the columns of a dense matrix x: $res(i) \leftarrow max_k \mid x(k,i) \mid$ This function computes the 1-norm of a vector x. If x is a real vector it computes 1-norm as: $res(i) \leftarrow \mid \mid x_i \mid \mid$else if x is a complex vector then it computes 1-norm as:$res(i) \leftarrow \mid \mid re(x) \mid \mid_\ + \mid \mid im(x) \mid \mid_1$ |No ❌|No ❌|No ❌|No ❌|
+| **2-Norm of Vector**|`psb_norm2` / `psb_genrm2`| This function computes the 2-norm of a vector x. If x is a real vector it computes 2-norm as: $nrm2 \leftarrow \sqrt{x^T x}$ else if x is a complex vector then it computes 2-norm as: $nrm2 \leftarrow \sqrt{x^H x}$ |No ❌|No ❌|No ❌|No ❌|
+|**Generalized 2-Norm of Vector**|`psb_genrm2s` / `psb_spnrm1` |This subroutine computes a series of 2-norms on the columns of a dense matrix x: $res(i) \leftarrow \mid \mid x(:,i) \mid \mid_2$ |No ❌|No ❌|No ❌|No ❌|
+|**1-Norm of Sparse Matrix**|`psb_norm1`|This function computes the 1-norm of a matrix A: $nrm1 \leftarrow \mid \mid A \mid \mid_1$ where A represents the global matrix A|No ❌|No ❌|No ❌|No ❌|
+|**Infinity Norm of Sparse Matrix**|`psb_normi` / `psb_spnrmi`|This function computes the infinity-norm of a matrix A: $nrmi \leftarrow \mid \mid A \mid \mid_{\infty}$ where: $A$ represents the global matrix|No ❌|No ❌|No ❌|No ❌|
+|**Sparse Matrix by Dense Matrix Product**| `psb_spmm`|This subroutine computes the Sparse Matrix by Dense Matrix Product: $y \leftarrow \alpha A x + \beta y$ $y \leftarrow \alpha A^T x + \beta y$ $y \leftarrow \alpha A^H x + \beta y$ where:
$x$ is the global dense matrix $x_{:,:}$
y is the global dense matrix $y_{:,:}$
$A$ is the global sparse matrix |Work in progress :hammer_and_wrench:|No ❌|No ❌|No ❌|
+|**Triangular System Solve**|`psb_spsm`|This subroutine computes the Triangular System Solve: $y \leftarrow \alpha T^{-1} x + \beta y$ $y \leftarrow \alpha D^{-1} x + \beta y$ $y \leftarrow \alpha T^{-1} D x + \beta y$ $y \leftarrow \alpha T^{-T} x + \beta y$ $y \leftarrow \alpha D T^{-T} x + \beta y$ $y \leftarrow \alpha T^{-T} D x + \beta y$ $y \leftarrow \alpha T^{-H} x + \beta y$ $y \leftarrow \alpha D T^{-H} x + \beta y$ $y \leftarrow \alpha T^{-H} D x + \beta y$ where:
$x$ is the global dense matrix $x_{:,:}$
$y$ is the global dense matrix $y_{:,:}$
$T$ is the global sparse block triangular submatrix
D is the scaling diagonal matrix|No ❌|No ❌|No ❌|No ❌|
+|**Entrywise Product**|`psb_gemlt`|This function computes the entrywise product between two vectors $x$ and $y$ $dot \leftarrow x(i)y(i)$ |No ❌|No ❌|No ❌|No ❌|
+|**Entrywise Division**|`psb_gediv`|This function computes the entrywise division between two vectors $x$ and $y$ $div \leftarrow \frac{x(i)}{y(i)}$ |No ❌|No ❌|No ❌|No ❌|
+|**Entrywise Inversion**|`psb_geinv`|This function computes the entrywise inverse of a vector x and puts it into $y$ $inv \leftarrow \frac{1}{x(i)}$ |No ❌|No ❌|No ❌|No ❌|
## Developer Notes
In order to keep compliant the excecution of the bash script used to automate the teest excecution, remember to create a new directory to put new tests and to use the name convention of psb_test_ signature for utilities functions and psb_kernel_test for tests used for new routines.
## TODO
-- Merge all the output logs
- Finish the directories description
- Check memory occupancy of parallel/ serial/ and vectors/ directories (Maybe not the best way for lots of rputines?)
-## Questions
-- Is it correct to use psb_gather even for a single process running?
-- Is it correct to shift in 0,xxxx type of notation to compare with the correct number of significand digits?
-- Does it make sense to compare the parallel solution with the serial one?
-
-
## References
[1]. Higham, Nicholas J. Testing linear algebra software. Springer US, 1997
diff --git a/test/computational_routines/gedot/README.md b/test/computational_routines/gedot/README.md
index 23e6a56b..e72ff67d 100644
--- a/test/computational_routines/gedot/README.md
+++ b/test/computational_routines/gedot/README.md
@@ -1,28 +1,28 @@
# Introduction
-This is a directory developed by Luca Pepè Sciarria and Simone Staccone froma Tor Vergata University to start to create some unit tests for PSBLAS 3.9, in particular for ```psb_gedot``` routine.
+This is a directory developed by Luca Pepè Sciarria and Simone Staccone from Tor Vergata University to start to create some unit tests for PSBLAS 3.9, in particular for ```psb_gedot``` routine.
## Getting started
Steps to reproduce the tests:
+
- Compile the code using ``` make ``` (Optional)
-- Launch the script ./autotest.sh or with source ./autotest.sh if you want to add modules to the .bashrc file permenently.
-- Check the output log file psblas_gedot_test.log to collect results
+- Launch the script ```./autotest.sh``` or with ```source ./autotest.sh``` if you want to add modules to the .bashrc file permanently.
+- Check the output log file ```psb_gedot_test.log``` to collect results and check for errors. In any case a summarization of tests passed should be shown in stdout.
-NOTE: If the code is changed and a new compilation is needed to show the changes, the autotest.sh script isn't aware of this scenario, therefore it is necessary to manually recompile the code.
+NOTE: If the code is changed and a new compilation is needed to show the changes, the ```autotest.sh``` script isn't aware of this scenario, therefore it is necessary to manually recompile the code. Moreover, if you are running manually the script and not launching the main ```test.sh``` script, be careful to use the last compiled version of the utils.
## Test Suite
-### Overall Analysys
-The ```psb_gedot```. The signature of the function is:
+The ```psb_gedot``` is a function that performs the scalar product between two vectors giving a value as result. The signature of the function is:
```fortran
psb_gedot(x, y, desc_a, info [,global])
```
-In the comparison 7 significand digits means having a notation like 0,$d_1 d_2 d_3 ... d_7$*10^7 also.
+The strategy to validate the correctness of the computation is to compare single precision result and double precision result in the test cases in which the test should not give an error. In this way it is possible to have a correctness check of the computation comparing the two results considering a number of significant digits which is tuned on the single precision computation.
### Parameters Values
**x** vectors are located in the vectors/ directory. They are generated randomly using the same seed and then saved on different files based on their characteristics. The size of the vector is choosen accordingly to the size of the matrix column space considered for the single test instance.
-|Vector|File Name|Coefficients|Coefficients Description|
+|Variable|File Name|Coefficients|Coefficients Description|
|:-:|:-:|:-:|:-:|
|$x_1$|x1.txt|$x_i> 0, \forall i$|Positive coefficients|
|$x_2$|x2.txt|$x_i < 0, \forall i$|Negative coefficients
@@ -30,37 +30,23 @@ In the comparison 7 significand digits means having a notation like 0,$d_1 d_2 d
|$x_4$|x4.txt|$x_i = 0, \forall i$|Null coefficients
**y** vectors are located in the vectors/ directory. They are generated randomly using the same seed and then saved on different files based on their characteristics. The size of the vector is choosen accordingly to the size of the matrix rows space considered for the single test instance.
-|Vector|File Name|Coefficients|Coefficients Description|
+|Variable|File Name|Coefficients|Coefficients Description|
|:-:|:-:|:-:|:-:|
|$y_1$|y1.txt|$y_i> 0, \forall i$|Positive coefficients|
|$y_2$|y2.txt|$y_i < 0, \forall i$|Negative coefficients
|$y_3$|y3.txt|$y_i \ne 0, \forall i$|Random coefficients
|$y_4$|y4.txt|$y_i = 0, \forall i$|Null coefficients
-**$\alpha$**
-|$\alpha$|Value|Coefficients Description|
-|:-:|:-:|:-:|
-|$\alpha_1$|1.0|Positive value|
-|$\alpha_2$|-1.0|Negative value|
-|$\alpha_3$|0.0|Null value|
-
-**$\beta$**
-|$\alpha$|Value|Coefficients Description|
+**global** logical value indicating if the computation is global among all processes or it is only local, so that a global reduction is needed afterwards.
+|Variable|Value|Value Description|
|:-:|:-:|:-:|
-|$\beta_1$|1.0|Positive value|
-|$\beta_2$|-1.0|Negative value|
-|$\beta_3$|0.0|Null value|
-
-## Output
-The ouput files generated by the test are automatically compared by the autotest.sh script, but if it is needed to manually run the test here it is the naming convenction used.
-
-The results of the computation will be saved on different files based on the instance of the test considered. In particular the naming conventiona format the output file as sol_x#_y#_a#_b#.mtx, where each # is a number choosen w.r.t. the test instance. (Ex. sol_x1_y1_a1_b1.mtx is the solution computed using the first x vector file , the first y vector file, alpha = 1.0 and beta = 1.0). Moreover, the files will be saved in the serial/ directory if the program is launched using 1 process or in parrallel/ directory if the program is launched with more than one process.
+|$global_1$|True|Global computation is required implicitly|
+|$global_2$|False|Global computation is required explicitly, so only a local computation is done|
## TODO
-- Use also global in different ways
+List of things still to add in the test:
- Add computation with broken descriptor and catch the errore result
- Test using complex data ($dot \leftarrow x^H \cdot y$)
- Test also GPU excecution
-- Try multiple distributions
-- Fix result_check handling, it should not be an entire vector
+- Try multiple distributions
\ No newline at end of file
diff --git a/test/computational_routines/gedot/psb_gedot_test b/test/computational_routines/gedot/psb_gedot_test
index 5366cb1f..95aa39cf 100755
Binary files a/test/computational_routines/gedot/psb_gedot_test and b/test/computational_routines/gedot/psb_gedot_test differ
diff --git a/test/computational_routines/gedot/psb_gedot_test.f90 b/test/computational_routines/gedot/psb_gedot_test.f90
index 6c7b8d23..02320bc8 100644
--- a/test/computational_routines/gedot/psb_gedot_test.f90
+++ b/test/computational_routines/gedot/psb_gedot_test.f90
@@ -123,11 +123,13 @@ program main
!! Initialize test metadata
test_info%total_tests = size(x) * size(y) * size(global)
test_info%threshold_type = GAMMA
- test_info%threshold = 0.0
test_info%kernel_name = "psb_gedot"
call psb_test_init(test_info)
+ test_info%threshold = 1.0D-06
+
+
if(test_info%my_rank == psb_root_) then
psb_out_unit = test_info%output_unit
call psb_test_generate_input_vectors(arr_size)
@@ -148,12 +150,25 @@ program main
if(test_info%my_rank == psb_root_) then
if(global(h) .eqv. .true.) then
global_result_single = result_single
- call psb_test_single_double_check(result_single,result_double,test_info, arr_size)
+
+ if(test_info%np > 1) then
+ ! If the program is being run on multiple processes, we need to
+ ! check the result on the root process with the one computed only using
+ ! a single process
+ call psb_test_process_check(result_single, test_info)
+ else
+ call psb_test_single_double_check(result_single,result_double,test_info, arr_size)
+
+ ! If the program is being run on a single process, we can save the result directly
+ call psb_test_save_result(result_single, test_info)
+ end if
+
else
call psb_test_check_global_local(global_result_single, result_single, test_info)
end if
- test_info%current_test = test_info%current_test + 1
+ test_info%current_test = test_info%current_test + 1
+
end if
call psb_barrier(test_info%ctxt)
end do
@@ -200,7 +215,7 @@ contains
! variables outside PSLBALS data structures
real(psb_spk_), allocatable :: x_single_global(:), y_single_global(:)
real(psb_dpk_), allocatable :: x_double_global(:), y_double_global(:)
- integer(psb_ipk_) :: i
+ integer(psb_ipk_) :: i, nl
! others
logical :: exists
@@ -228,7 +243,9 @@ contains
end if
! Allocate descriptor as if it was a block rows distribution
- call psb_cdall(ctxt, desc_a, info,nl=arr_size/np)
+ nl = (arr_size)/np + mod(arr_size,np)
+
+ call psb_cdall(ctxt, desc_a, info,nl=nl)
if(info /= psb_success_) then
write(psb_out_unit,'(A)') "Error allocating desc_a data structure"
goto 9999
@@ -305,7 +322,6 @@ contains
goto 9999
end if
-
if(global .eqv. .false.) then
! If the result is local, we need to sum the local results
! to get the final result
diff --git a/test/computational_routines/gedot/results/result_1.txt b/test/computational_routines/gedot/results/result_1.txt
new file mode 100644
index 00000000..dc88de05
--- /dev/null
+++ b/test/computational_routines/gedot/results/result_1.txt
@@ -0,0 +1 @@
+ 25018.3417968750
diff --git a/test/computational_routines/gedot/results/result_11.txt b/test/computational_routines/gedot/results/result_11.txt
new file mode 100644
index 00000000..dc88de05
--- /dev/null
+++ b/test/computational_routines/gedot/results/result_11.txt
@@ -0,0 +1 @@
+ 25018.3417968750
diff --git a/test/computational_routines/gedot/results/result_13.txt b/test/computational_routines/gedot/results/result_13.txt
new file mode 100644
index 00000000..76e9693e
--- /dev/null
+++ b/test/computational_routines/gedot/results/result_13.txt
@@ -0,0 +1 @@
+ 13.8227043152
diff --git a/test/computational_routines/gedot/results/result_15.txt b/test/computational_routines/gedot/results/result_15.txt
new file mode 100644
index 00000000..d2ba3db1
--- /dev/null
+++ b/test/computational_routines/gedot/results/result_15.txt
@@ -0,0 +1 @@
+ 0.0000000000
diff --git a/test/computational_routines/gedot/results/result_17.txt b/test/computational_routines/gedot/results/result_17.txt
new file mode 100644
index 00000000..db066453
--- /dev/null
+++ b/test/computational_routines/gedot/results/result_17.txt
@@ -0,0 +1 @@
+ 43.0904617310
diff --git a/test/computational_routines/gedot/results/result_19.txt b/test/computational_routines/gedot/results/result_19.txt
new file mode 100644
index 00000000..4ee66f33
--- /dev/null
+++ b/test/computational_routines/gedot/results/result_19.txt
@@ -0,0 +1 @@
+ -43.0904617310
diff --git a/test/computational_routines/gedot/results/result_21.txt b/test/computational_routines/gedot/results/result_21.txt
new file mode 100644
index 00000000..380d2c47
--- /dev/null
+++ b/test/computational_routines/gedot/results/result_21.txt
@@ -0,0 +1 @@
+ 10.9213161469
diff --git a/test/computational_routines/gedot/results/result_23.txt b/test/computational_routines/gedot/results/result_23.txt
new file mode 100644
index 00000000..d2ba3db1
--- /dev/null
+++ b/test/computational_routines/gedot/results/result_23.txt
@@ -0,0 +1 @@
+ 0.0000000000
diff --git a/test/computational_routines/gedot/results/result_25.txt b/test/computational_routines/gedot/results/result_25.txt
new file mode 100644
index 00000000..d2ba3db1
--- /dev/null
+++ b/test/computational_routines/gedot/results/result_25.txt
@@ -0,0 +1 @@
+ 0.0000000000
diff --git a/test/computational_routines/gedot/results/result_27.txt b/test/computational_routines/gedot/results/result_27.txt
new file mode 100644
index 00000000..d2ba3db1
--- /dev/null
+++ b/test/computational_routines/gedot/results/result_27.txt
@@ -0,0 +1 @@
+ 0.0000000000
diff --git a/test/computational_routines/gedot/results/result_29.txt b/test/computational_routines/gedot/results/result_29.txt
new file mode 100644
index 00000000..d2ba3db1
--- /dev/null
+++ b/test/computational_routines/gedot/results/result_29.txt
@@ -0,0 +1 @@
+ 0.0000000000
diff --git a/test/computational_routines/gedot/results/result_3.txt b/test/computational_routines/gedot/results/result_3.txt
new file mode 100644
index 00000000..259814f5
--- /dev/null
+++ b/test/computational_routines/gedot/results/result_3.txt
@@ -0,0 +1 @@
+ -25018.3417968750
diff --git a/test/computational_routines/gedot/results/result_31.txt b/test/computational_routines/gedot/results/result_31.txt
new file mode 100644
index 00000000..d2ba3db1
--- /dev/null
+++ b/test/computational_routines/gedot/results/result_31.txt
@@ -0,0 +1 @@
+ 0.0000000000
diff --git a/test/computational_routines/gedot/results/result_5.txt b/test/computational_routines/gedot/results/result_5.txt
new file mode 100644
index 00000000..c9ce959e
--- /dev/null
+++ b/test/computational_routines/gedot/results/result_5.txt
@@ -0,0 +1 @@
+ -13.8227043152
diff --git a/test/computational_routines/gedot/results/result_7.txt b/test/computational_routines/gedot/results/result_7.txt
new file mode 100644
index 00000000..d2ba3db1
--- /dev/null
+++ b/test/computational_routines/gedot/results/result_7.txt
@@ -0,0 +1 @@
+ 0.0000000000
diff --git a/test/computational_routines/gedot/results/result_9.txt b/test/computational_routines/gedot/results/result_9.txt
new file mode 100644
index 00000000..259814f5
--- /dev/null
+++ b/test/computational_routines/gedot/results/result_9.txt
@@ -0,0 +1 @@
+ -25018.3417968750
diff --git a/test/computational_routines/utils/psb_test_env.inc b/test/computational_routines/utils/psb_test_env.inc
new file mode 100644
index 00000000..938a6d96
--- /dev/null
+++ b/test/computational_routines/utils/psb_test_env.inc
@@ -0,0 +1,107 @@
+!> @brief Function to initialize the test environment.
+!! It is used to set the output unit and the kernel name.
+!!
+!! @param test_info The test information structure to be initialized.
+!!
+subroutine psb_test_init(test_info)
+ type(psb_test_info), intent(inout) :: test_info
+ integer(psb_ipk_) :: output_unit, info
+ ! MPI variables
+ integer(psb_ipk_) :: my_rank
+
+
+ call psb_init(test_info%ctxt)
+ call psb_info(test_info%ctxt,test_info%my_rank,test_info%np)
+
+ ! Check if the kernel name is set
+ if (trim(test_info%kernel_name) == "default") then
+ write(*, '(A)') "Error: Kernel name is not set. Please set the kernel name before running the test."
+ call psb_exit(test_info%ctxt)
+ end if
+
+ ! Set the output unit to stdout by default
+ if(test_info%np == 1) then
+ open(newunit=output_unit, file=trim(test_info%kernel_name)//'_test.log', &
+ & status='replace', action='write', iostat=info)
+ else
+ open(newunit=output_unit, file=trim(test_info%kernel_name)//'_test.log', &
+ & status='old', action='write', position='append', iostat=info)
+ end if
+
+ ! Check if the file was opened successfully
+ if (info /= 0) then
+ write(*, '(A,I0)') "Error opening log file for kernel ", test_info%kernel_name
+ write(*, '(A,I0)') "I-O Status Code: ", info
+ write(*, '(A)') "Please check if the file is accessible and writable."
+ call psb_test_exit(test_info)
+ end if
+
+ test_info%output_unit = output_unit
+
+ write(test_info%output_unit,'(A,A)') 'Welcome to PSBLAS version: ',psb_version_string_
+ write(test_info%output_unit,'(A)') 'This is the psb_gedot_test sample program'
+ write(test_info%output_unit,'(A,I0)') 'Number of processes used in this computation: ', test_info%np
+ write(test_info%output_unit,'(A)') ''
+
+end subroutine
+
+!> @brief Function to finalize the test environment, it is used to close the output unit
+!! and finalize the PSBLAS context.
+!!
+!! @param test_info The test information structure to be finalized.
+!!
+subroutine psb_test_exit(test_info)
+ type(psb_test_info), intent(inout) :: test_info
+ integer(psb_ipk_) :: info
+
+ ! Finalize test
+ if(test_info%my_rank == psb_root_) then
+ write(test_info%output_unit, *) ""
+
+ ! Check if the kernel name is set to default
+ if(test_info%kernel_name == "default") then
+ write(test_info%output_unit,'(A)') "Warning: Kernel name is not set. Using default kernel name 'default'."
+ else
+ write(test_info%output_unit,'(A)') "Kernel name set to: " // trim(test_info%kernel_name)
+ end if
+
+ ! Check the threshold type and value
+ if(test_info%mat_dist == DEFAULT) then
+ write(test_info%output_unit,'(A)') "Matrix distribution set to default (block row distribution)."
+ else
+ write(test_info%output_unit,'(A,I0)') "Matrix distribution set to: ", test_info%mat_dist
+ end if
+
+ ! Check the threshold type and value
+ if(test_info%threshold_type == DEFAULT) then
+ write(test_info%output_unit,'(A,G20.10)') "Threshold type is set to default&
+ & using single precision IEEE unit roundoff as threshould ", 5.96D-08
+ else if(test_info%threshold_type == VALUE) then
+ write(test_info%output_unit,'(A,G20.10)') "Threshold type is set to VALUE, so absolute error will be checked&
+ & using threshold: ", test_info%threshold
+ else if(test_info%threshold_type == GAMMA) then
+ write(test_info%output_unit,'(A, G20.10)') "Threshold type is set to GAMMA, so relative error will&
+ & be checked using threshold: ", test_info%threshold
+ end if
+ write(test_info%output_unit,'(A)') ''
+
+ write(*,'(A)') "[INFO] Tests completed successfully!"
+ write(*,'(A,I0)') " Passed: ", test_info%success
+ write(*,'(A,I0)') " Failed: ", test_info%failure
+ write(*,'(A,I0)') " Total: ", test_info%total_tests
+ write(*,'(A)') "[INFO] Check " // trim(test_info%kernel_name) // "_test.log for a full description"
+
+ ! Close the output unit
+ if (test_info%output_unit /= 0) then
+ close(test_info%output_unit, iostat=info)
+ if (info /= 0) then
+ write(*, '(A,I0,A,I0)') "[ERROR] Error closing log file for kernel ", &
+ & test_info%kernel_name, " I/O Status Code ", info
+ write(*,'(A)') ''
+ end if
+ end if
+ end if
+
+ ! Finalize PSBLAS context
+ call psb_exit(test_info%ctxt)
+end subroutine
\ No newline at end of file
diff --git a/test/computational_routines/utils/psb_test_log.inc b/test/computational_routines/utils/psb_test_log.inc
index 58fe3ad7..9257e3e2 100644
--- a/test/computational_routines/utils/psb_test_log.inc
+++ b/test/computational_routines/utils/psb_test_log.inc
@@ -10,9 +10,11 @@
!> @brief Subroutine used to foramt correctly the message in the log about a test that has paseed
!!
!! @param test_info is a data structure containing all the metadata usefull for test output
+!! @param out_string is the string to be printed in the log
!!
-subroutine psb_test_log_passed(test_info)
+subroutine psb_test_log_passed(test_info, out_string)
type(psb_test_info), intent(in) :: test_info
+ character(len=*), intent(in) :: out_string
! time stats variables
character(len=8) :: date
character(len=10) :: time
@@ -22,31 +24,33 @@ subroutine psb_test_log_passed(test_info)
call date_and_time(date, time, zones, values)
write(test_info%output_unit,'("[", I4.4,"-",I2.2,"-",I2.2," ",I2.2,":",I2.2,":",I2.2,"] ",&
- & A,A,A,I0,A,I0,T110,A)') &
+ & A,I0,A,I0,T110,A)') &
& values(1), values(2), values(3), values(5), values(6), values(7), &
- & "Generation ", trim(test_info%kernel_name), " single precision ", &
+ & out_string, &
& test_info%current_test , "/", test_info%total_tests, "[OK]"
end subroutine
-!> @brief Subroutine used to foramt correctly the message in the log about a test that has failed
+!> @brief Subroutine used to format correctly the message in the log about a test that has failed
!!
-!! @param test_info is a data structure containing all the metadata usefull for test output
+!! @param test_info is a data structure containing all the metadata useful for test output
+!! @param out_string is a string containing the error message to be printed
!!
-subroutine psb_test_log_failed(test_info)
- type(psb_test_info), intent(in) :: test_info
+subroutine psb_test_log_failed(test_info, out_string)
+ type(psb_test_info), intent(in) :: test_info
+ character(len=*), intent(in) :: out_string
! time stats variables
- character(len=8) :: date
- character(len=10) :: time
- character(len=5) :: zones
- integer(psb_ipk_) :: values(8)
+ character(len=8) :: date
+ character(len=10) :: time
+ character(len=5) :: zones
+ integer(psb_ipk_) :: values(8)
call date_and_time(date, time, zones, values)
write(test_info%output_unit,'("[", I4.4,"-",I2.2,"-",I2.2," ",I2.2,":",I2.2,":",I2.2,"] ",&
- & A,A,A,I0,A,I0,T110,A)') &
+ & A,I0,A,I0,T110,A)') &
& values(1), values(2), values(3), values(5), values(6), values(7), &
- & "Generation ", trim(test_info%kernel_name), " single precision ", &
+ & out_string, &
& test_info%current_test , "/", test_info%total_tests, "[FAIL]"
end subroutine
@@ -57,9 +61,9 @@ end subroutine
!! @param test_info is a data structure containing all the metadata usefull for test output
!!
subroutine psb_test_progress_bar(test_info)
- type(psb_test_info), intent(in) :: test_info
- integer(psb_ipk_) :: percent, bar_width, num_hashes, num_spaces
- character(len=100) :: bar
+ type(psb_test_info), intent(in) :: test_info
+ integer(psb_ipk_) :: percent, bar_width, num_hashes, num_spaces
+ character(len=100) :: bar
bar_width = 40
diff --git a/test/computational_routines/utils/psb_test_utils.f90 b/test/computational_routines/utils/psb_test_utils.f90
index 10243e72..c8280596 100644
--- a/test/computational_routines/utils/psb_test_utils.f90
+++ b/test/computational_routines/utils/psb_test_utils.f90
@@ -35,6 +35,7 @@ module psb_test_utils
real(psb_dpk_) :: threshold = 0.0 !> The threashold value used for acceptance
type(psb_ctxt_type) :: ctxt !> The PSBLAS context (Used for MPI communications)
integer(psb_ipk_) :: my_rank = 0 !> The rank of the current process in the MPI communicator
+ integer(psb_ipk_) :: np = 1 !> The number of processes in the MPI communicator
integer(psb_ipk_) :: mat_dist = DEFAULT !> The distribution of the matrix (default is block row distribution)
end type psb_test_info
@@ -42,170 +43,8 @@ module psb_test_utils
contains
include 'psb_test_log.inc'
-
- !> @brief Function to initialize the test environment.
- !! It is used to set the output unit and the kernel name.
- !!
- !! @param test_info The test information structure to be initialized.
- !!
- subroutine psb_test_init(test_info)
- type(psb_test_info), intent(inout) :: test_info
- integer(psb_ipk_) :: output_unit, info
- ! MPI variables
- integer(psb_ipk_) :: my_rank, np
-
-
- call psb_init(test_info%ctxt)
- call psb_info(test_info%ctxt,test_info%my_rank,np)
-
- ! Check if the kernel name is set
- if (trim(test_info%kernel_name) == "unknown") then
- write(*, '(A)') "Error: Kernel name is not set. Please set the kernel name before running the test."
- call psb_exit(test_info%ctxt)
- end if
-
- ! Set the output unit to stdout by default
- if(np == 1) then
- open(newunit=output_unit, file=trim(test_info%kernel_name)//'_test.log', &
- & status='replace', action='write', iostat=info)
- else
- open(newunit=output_unit, file=trim(test_info%kernel_name)//'_test.log', &
- & status='old', action='write', position='append', iostat=info)
- end if
-
- ! Check if the file was opened successfully
- if (info /= 0) then
- write(*, '(A,I0)') "Error opening log file for kernel ", test_info%kernel_name
- write(*, '(A,I0)') "I/O Status Code:", info
- write(*, '(A)') "Please check if the file is accessible and writable."
- call psb_test_exit(test_info)
- end if
-
- test_info%output_unit = output_unit
-
- write(test_info%output_unit,'(A,A)') 'Welcome to PSBLAS version: ',psb_version_string_
- write(test_info%output_unit,'(A)') 'This is the psb_gedot_test sample program'
- write(test_info%output_unit,'(A,I0)') 'Number of processes used in this computation: ', np
- write(test_info%output_unit,'(A)') ''
-
- ! Check if the kernel name is set to default
- if(test_info%kernel_name == "default") then
- write(test_info%output_unit,'(A)') "Warning: Kernel name is not set. Using default kernel name 'default'."
- else
- write(test_info%output_unit,'(A)') "Kernel name set to: " // trim(test_info%kernel_name)
- end if
-
- ! Check the threshold type and value
- if(test_info%mat_dist == DEFAULT) then
- write(test_info%output_unit,'(A)') "Matrix distribution set to default (block row distribution)."
- else
- write(test_info%output_unit,'(A,I0)') "Matrix distribution set to: ", test_info%mat_dist
- end if
-
- ! Check the threshold type and value
- if(test_info%threshold_type == DEFAULT) then
- write(test_info%output_unit,'(A,F20.10)') "Threshold type is set to default. &
- & using single precision IEEE unit roundoff as threshould ", 5.96D-08
- else if(test_info%threshold_type == VALUE) then
- write(test_info%output_unit,'(A,F20.10)') "Threshold type is set to VALUE, so absolute error will be checked &
- & using threshold: ", test_info%threshold
- else if(test_info%threshold_type == GAMMA) then
- write(test_info%output_unit,'(A)') "Threshold type is set to GAMMA, so relative error will be checked"
- else
- write(test_info%output_unit,'(A,I0)') "Error: Invalid threshold type: ", test_info%threshold_type
- call psb_test_exit(test_info)
- end if
-
-
- write(test_info%output_unit,'(A)') ''
- end subroutine
-
- !> @brief Function to finalize the test environment, it is used to close the output unit
- !! and finalize the PSBLAS context.
- !!
- !! @param test_info The test information structure to be finalized.
- !!
- subroutine psb_test_exit(test_info)
- type(psb_test_info), intent(inout) :: test_info
- integer(psb_ipk_) :: info
-
- ! Finalize test
- if(test_info%my_rank == psb_root_) then
- write(*,'(A)') "[INFO] Tests completed successfully!"
- write(*,'(A,I0)') " Passed: ", test_info%success
- write(*,'(A,I0)') " Failed: ", test_info%failure
- write(*,'(A,I0)') " Total: ", test_info%total_tests
- write(*,'(A)') "[INFO] Check " // trim(test_info%kernel_name) // "_test.log for a full description"
- write(test_info%output_unit, *) ""
-
- ! Close the output unit
- if (test_info%output_unit /= 0) then
- close(test_info%output_unit, iostat=info)
- if (info /= 0) then
- write(*, '(A,I0,A,I0)') "[ERROR] Error closing log file for kernel ", &
- & test_info%kernel_name, " I/O Status Code ", info
- write(*,'(A)') ''
- end if
- end if
- end if
-
- ! Finalize PSBLAS context
- 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(psb_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
+ include "psb_test_env.inc"
+
!> @brief Function to randomly generate x and y vectors
!! and save them on multiple files based on their
@@ -282,6 +121,44 @@ contains
end subroutine
+ !> @brief Subroutine to save the result of a single precision computation
+ !! to a file in the results directory.
+ !!
+ !! @param result_single The single precision result to be saved.
+ !! @param test_info The test information structure containing the current test count.
+ !!
+ subroutine psb_test_save_result(result_single, test_info)
+ type(psb_test_info), intent(inout) :: test_info
+ real(psb_spk_), intent(in) :: result_single
+ integer(psb_ipk_) :: info, unit
+ character(len=32) :: filename
+ logical :: exists
+
+ ! Check if results directory exists
+ inquire(file='results/', exist=exists)
+ if (.not.exists) then
+ call system('mkdir results/')
+ end if
+
+ ! Set the filename based on the test count
+ write(filename, '(A,I0,A)') 'results/result_', test_info%current_test, '.txt'
+
+ ! Open the file for writing
+ open(newunit=unit, file=trim(filename), status='replace', action='write', iostat=info)
+
+ ! Check if the file was opened successfully
+ if (info /= 0) then
+ write(*, '(A,I0)') "Error opening result file: ", info
+ return
+ end if
+
+ ! Write the result to the file
+ write(unit, '(F20.10)') result_single
+
+ ! Close the file
+ close(unit, iostat=info)
+ end subroutine
+
!> @brief Subroutine to shift the decimal point of a single precision number
!! and count the number of digits in the integer part.
!!
@@ -332,6 +209,68 @@ contains
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.
+ !!
+ subroutine psb_test_validate(result_single, result_double, test_info, arr_size, pass)
+ type(psb_test_info), intent(inout) :: test_info
+ real(psb_spk_), intent(inout) :: result_single
+ real(psb_dpk_), intent(inout) :: result_double
+ integer(psb_ipk_), intent(in) :: arr_size
+ logical, intent(inout) :: pass
+ integer(psb_ipk_) :: int_digits, n
+ real(psb_dpk_) :: gamma_n, unit_roundoff, delta, rel_err
+
+ unit_roundoff = 5.96D-08 !! 1.11D-16
+ delta = abs(result_double - real(result_single,psb_dpk_))
+ rel_err = delta / abs(real(result_single,psb_dpk_))
+ n = (arr_size / test_info%np) + (test_info%np - 1)
+
+ !! call shift_decimal_double(delta,int_digits)
+
+ 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
+
+ if(n * unit_roundoff >= 1) then
+ write(test_info%output_unit,'(A)') "Error: Invalid GAMMA computation, n * U is greater than 1"
+ write(*,*)
+ call psb_test_exit(test_info)
+ end if
+
+ gamma_n = (n * unit_roundoff) / (1.0D0 - real(n * unit_roundoff, psb_dpk_) )
+ test_info%threshold = gamma_n
+
+ !! Handle case when result_single is zero
+ if ((ieee_is_nan(rel_err)).and.(result_single == 0.0D0)) then
+ rel_err = 0.0D0
+ 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 subroutine
+
+
!> @brief Subroutine to check the results of a single and double precision computation.
!! It compares the results and logs the outcome.
!!
@@ -340,28 +279,32 @@ contains
!! @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, 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
- type(psb_test_info), intent(inout) :: test_info
+ subroutine psb_test_single_double_check(result_single, result_double, test_info, arr_size)
+ type(psb_test_info), intent(inout) :: test_info
+ real(psb_spk_), intent(inout) :: result_single
+ real(psb_dpk_), intent(inout) :: result_double
+ real(psb_dpk_) :: delta
+ integer(psb_ipk_) :: int_digits, arr_size
+ logical :: pass
+ character(len=64) :: out_string
+
+ out_string = "Double precision check: "
call psb_test_progress_bar(test_info)
+ call psb_test_validate(result_single, result_double, test_info, arr_size, pass)
- if(psb_test_validate(result_single, result_double, test_info, arr_size)) then
- call psb_test_log_passed(test_info)
+ if(pass .eqv. .true.) then
+ call psb_test_log_passed(test_info, out_string)
test_info%success = test_info%success + 1
else
- call psb_test_log_failed(test_info)
- write(psb_out_unit,'(A,F20.10)') "Single precision result: ", result_single
- write(psb_out_unit,'(A,F20.10)') "Double precision result: ", result_double
- write(psb_out_unit,'(A,F20.10)') "Computed delta: ", delta
- write(psb_out_unit,'(A,F20.10)') "Threshold used: ", test_info%threshold
+ call psb_test_log_failed(test_info, out_string)
test_info%failure = test_info%failure + 1
end if
-
+ write(psb_out_unit,'(A,F20.10)') "Single precision result: ", result_single
+ write(psb_out_unit,'(A,F20.10)') "Double precision result: ", result_double
+ write(psb_out_unit,'(A,F20.10)') "Computed delta: ", delta
+ write(psb_out_unit,'(A,F20.10)') "Threshold used: ", test_info%threshold
end subroutine
!> @brief Subroutine to check the global and local results of a single precision computation.
@@ -374,28 +317,85 @@ contains
subroutine psb_test_check_global_local(global_result_single, result_single, test_info)
real(psb_spk_), intent(in) :: global_result_single,result_single
type(psb_test_info) :: test_info
+ character(len=64) :: out_string
+ out_string = "Global vs Local check: "
call psb_test_progress_bar(test_info)
! Check if the global result is equal to the local result
if (global_result_single == result_single) then
- call psb_test_log_passed(test_info)
+ call psb_test_log_passed(test_info, out_string)
test_info%success = test_info%success + 1
else
- call psb_test_log_failed(test_info)
- write(test_info%output_unit,'(A,F20.10)') "Global single precision result: ", global_result_single
- write(test_info%output_unit,'(A,F20.10)') "Local single precision result: ", result_single
+ call psb_test_log_failed(test_info, out_string)
test_info%failure = test_info%failure + 1
end if
+ write(test_info%output_unit,'(A,F20.10)') "Global single precision result: ", global_result_single
+ write(test_info%output_unit,'(A,F20.10)') "Local single precision result: ", result_single
end subroutine
- !! subroutine psb_parallel_check()
- !!
- !! end subroutine
-!!
- !! subroutine psb_threshold_check()
- !!
- !! end subroutine
+
+ !> @brief Subroutine to check the result of a single precision computation
+ !! against a previously saved result from a single process test.
+ !!
+ !! @param result_single The single precision result to be checked.
+ !! @param test_info The test information structure containing the current test count.
+ !!
+ subroutine psb_test_process_check(result_single, test_info)
+ real(psb_spk_), intent(inout) :: result_single
+ type(psb_test_info), intent(inout) :: test_info
+ real(psb_spk_) :: saved_result
+ integer(psb_ipk_) :: unit, info, file_size, int_digits
+ character(len=32) :: filename
+ logical :: exists
+ character(len=64) :: out_string
+
+ out_string = "Multiprocess check: "
+
+ ! Set the filename based on the test count
+ write(filename, '(A,I0,A)') 'results/result_', test_info%current_test, '.txt'
+
+ ! Check if the file exists
+ inquire(file=trim(filename), exist=exists)
+ if (.not.exists) then
+ write(test_info%output_unit, '(A)') "Error: Result file does not exist."
+ write(test_info%output_unit, '(A)') "Please ensure the single process test is run first to generate the result file."
+ call psb_test_exit(test_info)
+ end if
+
+ ! Open the file for reading
+ open(newunit=unit, file=trim(filename), status='old', action='read', iostat=info)
+
+ ! Check if the file was opened successfully
+ if (info /= 0) then
+ write(*, '(A,I0)') "Error opening result file: ", info
+ call psb_test_exit(test_info)
+ end if
+
+ ! Read the saved result
+ read(unit, '(F20.10)') saved_result
+
+ ! Close the file
+ close(unit, iostat=info)
+
+ call shift_decimal_single(saved_result,int_digits)
+ call shift_decimal_single(result_single,int_digits)
+
+ ! Compare the saved result with the new result_single
+ if (abs(saved_result - result_single) <= test_info%threshold) then
+ call psb_test_log_passed(test_info, out_string)
+ test_info%success = test_info%success + 1
+ else
+ call psb_test_log_failed(test_info, out_string)
+ test_info%failure = test_info%failure + 1
+ end if
+ write(test_info%output_unit, '(F20.10,F20.10,A,L,A,L)') &
+ & saved_result - result_single, result_single - saved_result, " ", saved_result - result_single == 0, &
+ & " ", result_single - saved_result == 0
+ write(test_info%output_unit, '(A,F20.10)') "Multi-process result: ", result_single
+ write(test_info%output_unit, '(A,F20.10)') "Single process result: ", saved_result
+
+ end subroutine
end module psb_test_utils
\ No newline at end of file