Merge branch 'test_dev' into cmake

test/spmm/Makefile

@@ -0,0 +1,42 @@
+INSTALLDIR=../..
+INCDIR=$(INSTALLDIR)/include/
+MODDIR=$(INSTALLDIR)/modules/
+include $(INCDIR)/Make.inc.psblas
+#
+# Libraries used
+#
+LIBDIR = $(INSTALLDIR)/lib/
+PSBLAS_LIB = -L$(LIBDIR) -lpsb_util -lpsb_prec -lpsb_base
+LDLIBS = $(PSBLDLIBS)
+
+FINCLUDES=$(FMFLAG)$(MODDIR) $(FMFLAG).
+
+EXEDIR=./runs
+
+
+GREEN=\033[0;32m
+RED=\033[0;31m
+BLUE=\033[0;34m
+YELLOW=\033[33m 
+END_COLOUR=\033[0m
+
+
+all: runsd psb_spmm_test 
+	@printf "$(GREEN)[INFO]\tCompilation success!$(END_COLOUR)\n" 
+
+runsd: 	
+	@(if test ! -d runs ; then mkdir runs; fi)
+	@printf "$(BLUE)[INFO]\tBuild directory $(EXEDIR) correctly initialized$(END_COLOUR)\n"
+
+
+psb_spmm_test:
+	@$(FLINK) $(LOPT) psb_spmm_test.f90 -o psb_spmm_test -I../../modules/ -I. $(PSBLAS_LIB) $(LDLIBS) 
+	@mv psb_spmm_test $(EXEDIR)
+	@printf "$(BLUE)[INFO]\tTesting files generated correctly$(END_COLOUR)\n" 
+
+clean: 
+	@rm -f $(OBJS)\
+        *$(.mod) $(EXEDIR)/psb_spmm_test 
+
+.PHONY: all runsd clean   
+

test/spmm/README.md

@@ -0,0 +1,45 @@
+# 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_spmm routine.
+
+## Environment
+These tests are developed using a linux environment, in particular Rocky Linux 9.5 (Blue Onyx). 
+
+The compiler used is:
+- gnu 12.2.1
+
+The necessary dependnces are:
+- mpich 4.2.2
+- psblas 3.9
+
+In order to have the exact same environment used for testing compile PSBALS library using cuda 12.5.
+
+
+## Getting started
+Steps to reproduce the tests:
+- make
+- insert the matrix files inside the matrix/ directory (or create one if it doesn't exists; psblas3/test/spmm/matrix/)
+- run ./runs/psb_spmm_test
+- ... 
+
+## Test goal
+Check the correctness of the matrix-vector multiplication $y = Ax$ using the **psb_spmm** routine, checking for all the test suite cases.
+
+## Test Suite
+**A** matrixes are located in the matrix/ directory
+|Matrix|File Name|Type|
+|:-:|:-:|:-:|
+|$A_1$|1138_bus.mtx|Sparse| 
+
+**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|
+|:-:|:-:|:-:|:-:|
+|$x_1$|x1.txt|$x_i> 0, \forall i$|Positive coefficients| 
+|$x_2$|x2.txt|$x_i < 0, \forall i$|Negative coefficients
+|$x_3$|x3.txt|$x_i \ne 0, \forall i$|Random coefficients
+|$x_4$|x4.txt|$x_i = 0, \forall i$|Null coefficients
+
+## Output
+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_m#_x#_y#.mtx, where each # is a number choosen w.r.t. the test instance. (Ex. sol_m1_x1_y1.mtx is the solution computed using the first matrix file, the first x vector file and the first y vector file).
+
+## Notes
+For now only integer multiplication is tested and on a single matrix

test/spmm/psb_spmm_test.f90

@@ -0,0 +1,249 @@
+!> Test program for y = AX spsb_pmm routine
+!! Check the README.md to see all details about the tests.
+!!
+!! Author: Luca Pepé Sciarria, Staccone Simone (Tor Vergata University)
+program psb_spmm_test
+    use psb_base_mod
+    use psb_util_mod
+
+    implicit none 
+
+    ! input parameters
+    character(len=256)              :: mtx_file, file_name, name
+
+    ! Testing parameters
+    character(len=256),dimension(2) :: mtx_files
+
+    ! sparse matrices
+    type(psb_sspmat_type)           :: a
+    type(psb_lsspmat_type)          :: aux_a
+
+    ! vectors
+    type(psb_s_vect_type)           :: x, y
+
+    ! matrix descriptor data structure
+    type(psb_desc_type)             :: desc_a
+
+    ! communication context
+    type(psb_ctxt_type)             :: ctxt
+    integer(psb_ipk_)               :: my_rank, np, info, err_act
+
+    ! matrix parameters
+    integer(psb_ipk_)               :: m, n, nnz
+    integer(psb_ipk_)               :: nr, nt ! In BLOCK ROWS distributin, the number of rows 
+
+
+    real(psb_spk_), allocatable     :: x_global(:), y_global(:)
+    integer(psb_ipk_)               :: i
+
+    name     = "psb_spmm_test"    ! Name of the program to output in case of error
+    info     = psb_success_
+    mtx_file = "matrix/1138_bus.mtx"
+    mtx_files(1) = "matrix/1138_bus.mtx" 
+
+
+    call psb_init(ctxt)
+    call psb_info(ctxt,my_rank,np)
+
+    if (my_rank < 0) then 
+        ! This should not happen, but just in case
+        call psb_error(ctxt) 
+    endif
+
+    if (my_rank == psb_root_) then 
+        write(psb_out_unit,*) 'Welcome to PSBLAS version: ',psb_version_string_
+        write(psb_out_unit,*) 'This is the ',trim(name),' sample program'
+    end if
+
+
+    call mm_mat_read(aux_a,info,filename=mtx_file)
+    if(info /= psb_success_) then
+        write(psb_out_unit,*) "Error while reading matric ", mtx_file
+        goto 9999        
+    end if 
+
+    
+    ! part_block it's a macro defined in psb_blockpart_mod to identify BLOCK ROWS distribution
+    call psb_matdist(aux_a, a, ctxt,desc_a,info,fmt="COO",parts=part_block) 
+     
+
+    m   = aux_a%get_nrows()
+    n   = aux_a%get_ncols()
+    nnz = aux_a%get_nzeros()
+
+    call psb_bcast(ctxt,m)
+    call psb_bcast(ctxt,n)
+    call psb_bcast(ctxt,nnz)
+
+    if(my_rank == psb_root_) then 
+        write(psb_out_unit,*) "Matrix stats"
+        write(psb_out_unit,*) "ROWS:", m
+        write(psb_out_unit,*) "COLS:", n
+        write(psb_out_unit,*) "NNZ: ", nnz
+    end if
+
+    ! Generate random array for b using always the same seed
+    if(my_rank == psb_root_) then
+        allocate(x_global(n))
+        allocate(y_global(n))
+        call generate_vectors(n) ! True for x
+        call mm_array_read(x_global,info,filename="vectors/x1.mtx")
+        call mm_array_read(y_global,info,filename="vectors/y1.mtx")
+    end if
+
+    call psb_geall(x,desc_a,info)
+    if(info /= psb_success_) then
+        write(psb_out_unit,*) "Error allocating x data structure"
+        goto 9999
+    end if
+
+    ! Populate x class using data from x_global vector
+    call psb_scatter(x_global,x,desc_a,info,root=psb_root_)
+    if(info /= psb_success_) then
+        write(psb_out_unit,*) "Error in psb_scatter to populate x data structure"
+        goto 9999
+    end if
+
+    
+    call psb_geall(y,desc_a,info)
+    if(info /= psb_success_) then
+        write(psb_out_unit,*) "Error allocating y data structure"
+        goto 9999
+    end if
+
+    ! Populate y class using data from y_global vector
+    call psb_scatter(y_global,y,desc_a,info,root=psb_root_)
+    if(info /= psb_success_) then
+        write(psb_out_unit,*) "Error in psb_scatter to populate y data structure"
+        goto 9999
+    end if
+
+
+    ! y = alpha * A * x + betha * y
+    call psb_spmm(sone,a,x,sone,y,desc_a,info)
+    if(info /= psb_success_) then
+        write(psb_out_unit,*) "Error in psb_spmm routine"
+        goto 9999
+    end if
+
+    ! Save result to output file
+    call mm_array_write(y,"Result vector",info,filename="sol_m1_x1_y1.mtx")
+    
+    ! Deallocate
+    call psb_gefree(x, desc_a,info)
+    if(info /= psb_success_) then
+        write(psb_out_unit,*) "Error in vector x free routine"
+        goto 9999
+    end if
+
+    call psb_gefree(y, desc_a,info)
+    if(info /= psb_success_) then
+        write(psb_out_unit,*) "Error in vector y free routine"
+        goto 9999
+    end if
+
+    call psb_spfree(a, desc_a,info)
+    if(info /= psb_success_) then
+        write(psb_out_unit,*) "Error in matrix A free routine"
+        goto 9999
+    end if
+    
+    call psb_cdfree(desc_a,info)
+    if(info /= psb_success_) then
+        write(psb_out_unit,*) "Error in matrix descriptor free routine"
+        goto 9999
+    end if
+
+    deallocate(x_global)
+    deallocate(y_global)
+    
+    call psb_exit(ctxt)
+    stop
+
+
+    ! Error handling
+    9999 call psb_error(ctxt)
+    
+    call psb_errpush(info,name)
+    call psb_error_handler(ctxt,err_act)
+    call psb_exit(ctxt)
+    stop
+
+
+contains
+
+    !> @brief Function to randomly generate x and y vectors 
+    !!        and save them on multiple files based on their
+    !!        coefficients values.
+    !!
+    !! @param n     The size of the vector.
+    subroutine generate_vectors(n)
+        use psb_base_mod
+
+        implicit none 
+
+        integer(psb_ipk_), intent(in)               :: n
+        integer(psb_ipk_), allocatable              :: x(:), y(:)
+        real(psb_spk_), allocatable                 :: v(:)
+        integer(psb_ipk_)                           :: i
+
+        allocate(x(n))
+        allocate(y(n))
+        allocate(v(2*n))
+
+        
+        call random_init(repeatable=.true.,image_distinct=.true.) 
+        call random_number(v)
+
+        do i = 1,n 
+            x(i) = int(v(i) * 100)
+        end do
+
+        do i = 1,n
+            y(i) = int(v(i+n) * 100)
+        end do
+
+
+        ! Write only positive in x_1
+        call mm_array_write(x,"Positive vector",info,filename="vectors/x1.mtx")
+        call mm_array_write(y,"Positive vector",info,filename="vectors/y1.mtx")
+
+        ! Write only negative in x_2
+        do i=1,n  
+            x(i) = -x(i)
+            y(i) = -y(i)
+        end do  
+
+        call mm_array_write(x,"Negative vector",info,filename="vectors/x2.mtx")
+        call mm_array_write(y,"Negative vector",info,filename="vectors/y2.mtx")
+
+
+        ! Since numbers are less than one and always positive, we have to generate negative ones subtractiong 50
+        do i=1,n
+            x(i) = -x(i) ! Make the values positive again  
+            x(i) = x(i) - 50
+            y(i) = -y(i) ! Make the values positive again  
+            y(i) = y(i) - 50
+        end do   
+
+        ! Write random in x_3
+        call mm_array_write(x,"Random vector",info,filename="vectors/x3.mtx")
+        call mm_array_write(y,"Random vector",info,filename="vectors/y3.mtx")
+
+        ! Write zero in x_4
+        do i=1,n
+            x(i) = 0
+            y(i) = 0
+        end do   
+
+        call mm_array_write(x,"Null vector",info,filename="vectors/x4.mtx")
+        call mm_array_write(y,"Null vector",info,filename="vectors/y4.mtx")
+
+        deallocate(x)
+        deallocate(y)
+        deallocate(v)
+
+    end subroutine
+
+end program  
+

test/spmm/spmm_checker.c

@@ -0,0 +1,116 @@
+/* Test program for checking if two arrays (output of alpha*A*x + beta*y) are the same
+* Check the README.md to see all details about the tests.
+*
+* Author: Luca Pepé Sciarria, Staccone Simone (Tor Vergata University)
+*/
+
+
+
+
+
+#include <stdio.h>
+#include <stdlib.h>
+#include <string.h>
+
+void compare_files(const char *file1, const char *file2) {
+    FILE *file_s = fopen(file1, "r");
+    FILE *file_p = fopen(file2, "r");
+
+    if (!file_s || !file_p) {
+        perror("Error opening files");
+        exit(EXIT_FAILURE);
+    }
+
+    int n_s, n_p;
+    fscanf(file_s, "%d", &n_s);
+    fscanf(file_p, "%d", &n_p); // Assuming both files have the same number of lines
+
+    if (n_s != n_p) {
+        fprintf(stderr, "Error, differnet file sizes $d, $d", n_s, n_p);
+        exit(EXIT_FAILURE);
+    }
+
+    double value_s, value_p;
+    
+
+    for (int i = 0; i < n_s; i++) {
+        fscanf(file_s, "%lf", &value_s);
+        fscanf(file_p, "%lf", &value_p);
+        
+        if (value_s != value_p) {
+            printf("Index %d: %.2lf != %.2lf\n", i, value_s, value_p);
+        }
+    }
+
+    fclose(file_s);
+    fclose(file_p);
+}
+
+int main(int argc, char *argv[]) {
+    if (argc != 2) {
+        fprintf(stderr, "Usage: %s <partial_filename>\n", argv[0]);
+        return EXIT_FAILURE;
+    }
+
+    char file_s[256], file_p[256];
+    snprintf(file_s, sizeof(file_s), "%s_serial.txt", argv[1]);
+    snprintf(file_p, sizeof(file_p), "%s_parallel.txt", argv[1]);
+
+    compare_files(file_s, file_p);
+
+    return EXIT_SUCCESS;
+}
+
+
+#include <stdio.h>
+#include <stdlib.h>
+#include <string.h>
+
+void compare_files(const char *file1, const char *file2) {
+    FILE *file_s = fopen(file1, "r");
+    FILE *file_p = fopen(file2, "r");
+
+    if (!file_s || !file_p) {
+        perror("Error opening files");
+        exit(EXIT_FAILURE);
+    }
+
+    int n_s, n_p;
+    fscanf(file_s, "%d", &n_s);
+    fscanf(file_p, "%d", &n_p); // Assuming both files have the same number of lines
+
+    if (n_s != n_p) {
+        fprintf(stderr, "Error, differnet file sizes $d, $d", n_s, n_p);
+        exit(EXIT_FAILURE);
+    }
+
+    double value_s, value_p;
+    
+
+    for (int i = 0; i < n_s; i++) {
+        fscanf(file_s, "%lf", &value_s);
+        fscanf(file_p, "%lf", &value_p);
+        
+        if (value_s != value_p) {
+            printf("Index %d: %.2lf != %.2lf\n", i, value_s, value_p);
+        }
+    }
+
+    fclose(file_s);
+    fclose(file_p);
+}
+
+int main(int argc, char *argv[]) {
+    if (argc != 2) {
+        fprintf(stderr, "Usage: %s <partial_filename>\n", argv[0]);
+        return EXIT_FAILURE;
+    }
+
+    char file_s[256], file_p[256];
+    snprintf(file_s, sizeof(file_s), "%s_serial.txt", argv[1]);
+    snprintf(file_p, sizeof(file_p), "%s_parallel.txt", argv[1]);
+
+    compare_files(file_s, file_p);
+
+    return EXIT_SUCCESS;
+}

test/torture/psb_d_mvsv_tester.f90

@@ -22,10 +22,10 @@ contains
     ! 0 0
 
     ! declaration of VA,IA,JA 
-    integer(psb_ipk_) :: nnz=2
-    integer(psb_ipk_) :: m=2
+    integer(psb_ipk_) :: nnz=2 ! non zero
+    integer(psb_ipk_) :: m=2   ! 
     integer(psb_ipk_) :: k=2
-    integer(psb_ipk_) :: IA(2)=(/1, 1/)
+    integer(psb_ipk_) :: IA(2)=(/1, 1/) ! coordinate representation
     integer(psb_ipk_) :: JA(2)=(/1, 2/)
     real*8 :: VA(2)=(/1, 1/)
     real*8 :: x(2)=(/1, 1/)! reference x 
@@ -41,20 +41,20 @@ contains
       goto 9999
     endif
     call psb_barrier(ctxt)
-    call psb_cdall(ctxt,desc_a,info,nl=m)
+    call psb_cdall(ctxt,desc_a,info,nl=m)   ! specify index space m. Init desc_a
     if (info /= psb_success_)goto 9996
-    call psb_spall(a,desc_a,info,nnz=nnz)
+    call psb_spall(a,desc_a,info,nnz=nnz)   ! Init matrix a
     if (info /= psb_success_)goto 9996
     call psb_barrier(ctxt)
-    call psb_spins(nnz,IA,JA,VA,a,desc_a,info)
+    call psb_spins(nnz,IA,JA,VA,a,desc_a,info)  ! insert nnz values VA into matrix a in coordinates (IA, JA). Representation is given by the number of parameters: either COO or CSR. This one is COO
     if (info /= psb_success_)goto 9996
-    call psb_cdasb(desc_a,info)
+    call psb_cdasb(desc_a,info)  ! assemblatore comunicatore
     if (info /= psb_success_)goto 9996
-    call psb_spasb(a,desc_a,info,afmt=afmt)
+    call psb_spasb(a,desc_a,info,afmt=afmt)  ! "broadcast" the generated matrix. After this it can be used. Dovrebbe risolvere problemi di halo. afmt indicated the required format
     if(info.ne.0)print *,"matrix assembly failed"
     if(info.ne.0)goto 9996
 
-    call psb_spmm(alpha,A,x,beta,y,desc_a,info,transa)
+    call psb_spmm(alpha,A,x,beta,y,desc_a,info,transa)  !Sparse Matrix Dense Vectore Multiplication: alphaAx + betay. 
     if(info.ne.0)print *,"psb_spmm failed"
     if(info.ne.0)goto 9996
     do i=1,2