[FIX] Fixed multiprocess comparison in gedot kernel

test_dev
Stack-1 10 months ago
parent 4efcdbcfdf
commit 20bcd553ca

@ -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: <br> x is the global dense matrix x_{:,:} <br> y is the global dense matrix y_{:,:} <br> 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: <br> x is the global dense matrix x_{:,:} <br> y is the global dense matrix y_{:,:} <br> T is the global sparse block triangular submatrix T <br> 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: <br> $x$ is the global dense matrix $x_{:,:}$ <br> y is the global dense matrix $y_{:,:}$ <br> $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: <br> $x$ is the global dense matrix $x_{:,:}$ <br> $y$ is the global dense matrix $y_{:,:}$ <br> $T$ is the global sparse block triangular submatrix <br> 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
<a id="testing">[1].</a> Higham, Nicholas J. Testing linear algebra software. Springer US, 1997

@ -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

@ -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

@ -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

@ -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

@ -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
Loading…
Cancel
Save