From e0fd8549d15addf48dcf76046dccefec0c67dd3b Mon Sep 17 00:00:00 2001 From: Michele Martone Date: Fri, 5 Nov 2010 16:55:55 +0000 Subject: [PATCH] psblas3: implemented a stub rsb format module. --- test/serial/Makefile | 6 +- test/serial/d_matgen.f03 | 7 +- test/serial/psb_d_rsb_mat_mod.F03 | 26 ++ test/serial/rsb_mod.f03 | 685 ++++++++++++++++++++++++++++++ 4 files changed, 720 insertions(+), 4 deletions(-) create mode 100644 test/serial/psb_d_rsb_mat_mod.F03 create mode 100644 test/serial/rsb_mod.f03 diff --git a/test/serial/Makefile b/test/serial/Makefile index 1d052fba..0a47fa3e 100644 --- a/test/serial/Makefile +++ b/test/serial/Makefile @@ -21,8 +21,9 @@ d_coo_matgen: d_coo_matgen.o /bin/mv d_coo_matgen $(EXEDIR) psb_d_cxx_impl.o d_matgen.o: psb_d_cxx_mat_mod.o psb_d_cyy_impl.o d_matgen.o: psb_d_cyy_mat_mod.o -d_matgen: d_matgen.o psb_d_cxx_mat_mod.o psb_d_cxx_impl.o psb_d_cyy_mat_mod.o psb_d_cyy_impl.o psb_d_czz_mat_mod.o - $(F90LINK) $(LINKOPT) d_matgen.o psb_d_cxx_mat_mod.o psb_d_cxx_impl.o psb_d_cyy_mat_mod.o psb_d_cyy_impl.o psb_d_czz_mat_mod.o -o d_matgen $(PSBLAS_LIB) $(LDLIBS) +psb_d_rsb_impl.o d_matgen.o: psb_d_rsb_mat_mod.o rsb_mod.o +d_matgen: d_matgen.o psb_d_cxx_mat_mod.o psb_d_cxx_impl.o psb_d_cyy_mat_mod.o psb_d_cyy_impl.o psb_d_czz_mat_mod.o psb_d_rsb_mat_mod.o + $(F90LINK) $(LINKOPT) d_matgen.o psb_d_cxx_mat_mod.o psb_d_cxx_impl.o psb_d_cyy_mat_mod.o psb_d_cyy_impl.o psb_d_czz_mat_mod.o psb_d_rsb_mat_mod.o -o d_matgen $(PSBLAS_LIB) $(LDLIBS) /bin/mv d_matgen $(EXEDIR) .f90.o: @@ -32,6 +33,7 @@ d_matgen: d_matgen.o psb_d_cxx_mat_mod.o psb_d_cxx_impl.o psb_d_cyy_mat_mod.o ps clean: /bin/rm -f d_coo_matgen.o d_matgen.o \ psb_d_czz_mat_mod.o \ + psb_d_rsb_mat_mod.o \ psb_d_cyy_mat_mod.o psb_d_cyy_impl.o \ psb_d_cxx_mat_mod.o psb_d_cxx_impl.o *$(.mod) verycleanlib: diff --git a/test/serial/d_matgen.f03 b/test/serial/d_matgen.f03 index 2ec83c2a..a5bfa0f8 100644 --- a/test/serial/d_matgen.f03 +++ b/test/serial/d_matgen.f03 @@ -7,6 +7,7 @@ program d_matgen use psb_d_cxx_mat_mod use psb_d_cyy_mat_mod use psb_d_czz_mat_mod + use psb_d_rsb_mat_mod implicit none ! input parameters @@ -32,8 +33,9 @@ program d_matgen integer :: iter, itmax,itrace, istopc, irst integer(psb_long_int_k_) :: amatsize, precsize, descsize real(psb_dpk_) :: err, eps - !type(psb_d_cyy_sparse_mat) :: acyy - !type(psb_d_czz_sparse_mat) :: aczz + type(psb_d_rsb_sparse_mat) :: arsb + type(psb_d_cyy_sparse_mat) :: acyy + type(psb_d_czz_sparse_mat) :: aczz type(psb_d_cxx_sparse_mat) :: acxx ! other variables @@ -68,6 +70,7 @@ program d_matgen !call create_matrix(idim,a,b,x,desc_a,ictxt,afmt,info,acyy) !call create_matrix(idim,a,b,x,desc_a,ictxt,afmt,info,aczz) call create_matrix(idim,a,b,x,desc_a,ictxt,afmt,info,acxx) + !call create_matrix(idim,a,b,x,desc_a,ictxt,afmt,info,arsb) call psb_barrier(ictxt) t2 = psb_wtime() - t1 if(info /= psb_success_) then diff --git a/test/serial/psb_d_rsb_mat_mod.F03 b/test/serial/psb_d_rsb_mat_mod.F03 new file mode 100644 index 00000000..dca0e814 --- /dev/null +++ b/test/serial/psb_d_rsb_mat_mod.F03 @@ -0,0 +1,26 @@ +module psb_d_rsb_mat_mod + use psb_d_base_mat_mod + use rsb_mod +#ifdef HAVE_LIBRSB + use iso_c_binding +#endif + type, extends(psb_d_base_sparse_mat) :: psb_d_rsb_sparse_mat +#ifdef HAVE_LIBRSB + type(c_ptr) :: rsbmptr + contains + procedure, pass(a) :: get_nzeros => d_rsb_get_nzeros +#endif + end type + private :: d_rsb_get_nzeros +#ifdef HAVE_LIBRSB + contains + + function d_rsb_get_nzeros(a) result(res) + implicit none + class(psb_d_rsb_sparse_mat), intent(in) :: a + integer :: res + res = rsb_get_matrix_nnz(a%rsbmptr) + end function d_rsb_get_nzeros + +#endif +end module psb_d_rsb_mat_mod diff --git a/test/serial/rsb_mod.f03 b/test/serial/rsb_mod.f03 new file mode 100644 index 00000000..df5c2bf7 --- /dev/null +++ b/test/serial/rsb_mod.f03 @@ -0,0 +1,685 @@ +module rsb_mod + use iso_c_binding + + +interface +integer(c_int) function & + &rsb_init& + &()& + &bind(c,name='rsb_init') +use iso_c_binding + end function rsb_init +end interface + +interface +integer(c_int) function & + &rsb_was_initialized& + &()& + &bind(c,name='rsb_was_initialized') +use iso_c_binding + end function rsb_was_initialized +end interface + +interface +integer(c_int) function & + &rsb_exit& + &()& + &bind(c,name='rsb_exit') +use iso_c_binding + end function rsb_exit +end interface + +interface +type(c_ptr) function & + &rsb_allocate_rsb_sparse_matrix_const& + &(VAc,IAc,JAc,nnz,typecode,m,k,Mb,Kb,flags,errvalp)& + &bind(c,name='rsb_allocate_rsb_sparse_matrix_const') +use iso_c_binding + type(c_ptr), value :: VAc + type(c_ptr), value :: IAc + type(c_ptr), value :: JAc + integer(c_int), value :: nnz + integer(c_int), value :: typecode + integer(c_int), value :: m + integer(c_int), value :: k + integer(c_int), value :: Mb + integer(c_int), value :: Kb + integer(c_int), value :: flags + type(c_ptr), value :: errvalp + end function rsb_allocate_rsb_sparse_matrix_const +end interface + +interface +type(c_ptr) function & + &rsb_free_sparse_matrix& + &(matrix)& + &bind(c,name='rsb_free_sparse_matrix') +use iso_c_binding + type(c_ptr), value :: matrix + end function rsb_free_sparse_matrix +end interface + +interface +type(c_ptr) function & + &rsb_clone& + &(matrix)& + &bind(c,name='rsb_clone') +use iso_c_binding + type(c_ptr), value :: matrix + end function rsb_clone +end interface + +interface +integer(c_int) function & + &rsb_mark_matrix_with_type_flags& + &(matrix)& + &bind(c,name='rsb_mark_matrix_with_type_flags') +use iso_c_binding + type(c_ptr), value :: matrix + end function rsb_mark_matrix_with_type_flags +end interface + +interface +integer(c_int) function & + &rsb_meminfo& + &()& + &bind(c,name='rsb_meminfo') +use iso_c_binding + end function rsb_meminfo +end interface + +interface +integer(c_int) function & + &rsb_check_leak& + &()& + &bind(c,name='rsb_check_leak') +use iso_c_binding + end function rsb_check_leak +end interface + +interface +integer(c_int) function & + &rsb_spmv& + &(matrix,x,y,alphap,betap,incx,incy,transa)& + &bind(c,name='rsb_spmv') +use iso_c_binding + type(c_ptr), value :: matrix + type(c_ptr), value :: x + type(c_ptr), value :: y + type(c_ptr), value :: alphap + type(c_ptr), value :: betap + integer(c_int), value :: incx + integer(c_int), value :: incy + integer(c_int), value :: transa + end function rsb_spmv +end interface + +interface +integer(c_int) function & + &rsb_spmv_aa& + &(matrix,x,y,transa)& + &bind(c,name='rsb_spmv_aa') +use iso_c_binding + type(c_ptr), value :: matrix + type(c_ptr), value :: x + type(c_ptr), value :: y + integer(c_int), value :: transa + end function rsb_spmv_aa +end interface + +interface +integer(c_int) function & + &rsb_spmv_sa& + &(matrix,x,y,alphap,transa)& + &bind(c,name='rsb_spmv_sa') +use iso_c_binding + type(c_ptr), value :: matrix + type(c_ptr), value :: x + type(c_ptr), value :: y + type(c_ptr), value :: alphap + integer(c_int), value :: transa + end function rsb_spmv_sa +end interface + +interface +integer(c_int) function & + &rsb_spmv_na& + &(matrix,x,y,transa)& + &bind(c,name='rsb_spmv_na') +use iso_c_binding + type(c_ptr), value :: matrix + type(c_ptr), value :: x + type(c_ptr), value :: y + integer(c_int), value :: transa + end function rsb_spmv_na +end interface + +interface +integer(c_int) function & + &rsb_spmv_az& + &(matrix,x,y,transa)& + &bind(c,name='rsb_spmv_az') +use iso_c_binding + type(c_ptr), value :: matrix + type(c_ptr), value :: x + type(c_ptr), value :: y + integer(c_int), value :: transa + end function rsb_spmv_az +end interface + +interface +integer(c_int) function & + &rsb_spmv_xx& + &(matrix,x,y,alphap,betap,transa)& + &bind(c,name='rsb_spmv_xx') +use iso_c_binding + type(c_ptr), value :: matrix + type(c_ptr), value :: x + type(c_ptr), value :: y + type(c_ptr), value :: alphap + type(c_ptr), value :: betap + integer(c_int), value :: transa + end function rsb_spmv_xx +end interface + +interface +integer(c_int) function & + &rsb_spmv_sxsx& + &(matrix,x,y,alphap,betap,transa,incx,incy)& + &bind(c,name='rsb_spmv_sxsx') +use iso_c_binding + type(c_ptr), value :: matrix + type(c_ptr), value :: x + type(c_ptr), value :: y + type(c_ptr), value :: alphap + type(c_ptr), value :: betap + integer(c_int), value :: transa + integer(c_int), value :: incx + integer(c_int), value :: incy + end function rsb_spmv_sxsx +end interface + +interface +integer(c_int) function & + &rsb_infinity_norm& + &(matrix,infinity_norm,transa)& + &bind(c,name='rsb_infinity_norm') +use iso_c_binding + type(c_ptr), value :: matrix + type(c_ptr), value :: infinity_norm + integer(c_int), value :: transa + end function rsb_infinity_norm +end interface + +interface +integer(c_int) function & + &rsb_spmm_az& + &(matrix,mrhs,mout,bstride,cstride,nrhs,transa)& + &bind(c,name='rsb_spmm_az') +use iso_c_binding + type(c_ptr), value :: matrix + type(c_ptr), value :: mrhs + type(c_ptr), value :: mout + integer(c_int), value :: bstride + integer(c_int), value :: cstride + integer(c_int), value :: nrhs + integer(c_int), value :: transa + end function rsb_spmm_az +end interface + +interface +integer(c_int) function & + &rsb_spsv_azl& + &(matrix,y,transl)& + &bind(c,name='rsb_spsv_azl') +use iso_c_binding + type(c_ptr), value :: matrix + type(c_ptr), value :: y + integer(c_int), value :: transl + end function rsb_spsv_azl +end interface + +interface +integer(c_int) function & + &rsb_spsv_sxsx& + &(matrix,y,alphap,incx,transl)& + &bind(c,name='rsb_spsv_sxsx') +use iso_c_binding + type(c_ptr), value :: matrix + type(c_ptr), value :: y + type(c_ptr), value :: alphap + integer(c_int), value :: incx + integer(c_int), value :: transl + end function rsb_spsv_sxsx +end interface + +interface +integer(c_int) function & + &rsb_spsv& + &(matrix,x,y,alphap,incx,incy,transl)& + &bind(c,name='rsb_spsv') +use iso_c_binding + type(c_ptr), value :: matrix + type(c_ptr), value :: x + type(c_ptr), value :: y + type(c_ptr), value :: alphap + integer(c_int), value :: incx + integer(c_int), value :: incy + integer(c_int), value :: transl + end function rsb_spsv +end interface + +interface +integer(c_int) function & + &rsb_spmm_sxsx& + &(matrix,b,c,ldb,ldc,nrhs,transa,alphap,betap,order)& + &bind(c,name='rsb_spmm_sxsx') +use iso_c_binding + type(c_ptr), value :: matrix + type(c_ptr), value :: b + type(c_ptr), value :: c + integer(c_int), value :: ldb + integer(c_int), value :: ldc + integer(c_int), value :: nrhs + integer(c_int), value :: transa + type(c_ptr), value :: alphap + type(c_ptr), value :: betap + integer(c_int), value :: order + end function rsb_spmm_sxsx +end interface + +interface +integer(c_int) function & + &rsb_spsm_sxsx& + &(matrix,b,ldb,nrhs,transt,alphap,betap,order)& + &bind(c,name='rsb_spsm_sxsx') +use iso_c_binding + type(c_ptr), value :: matrix + type(c_ptr), value :: b + integer(c_int), value :: ldb + integer(c_int), value :: nrhs + integer(c_int), value :: transt + type(c_ptr), value :: alphap + type(c_ptr), value :: betap + integer(c_int), value :: order + end function rsb_spsm_sxsx +end interface + +interface +type(c_ptr) function & + &rsb_matrix_sum& + &(matrixa,alphap,transa,matrixb,betap,transb,errvalp)& + &bind(c,name='rsb_matrix_sum') +use iso_c_binding + type(c_ptr), value :: matrixa + type(c_ptr), value :: alphap + integer(c_int), value :: transa + type(c_ptr), value :: matrixb + type(c_ptr), value :: betap + integer(c_int), value :: transb + type(c_ptr), value :: errvalp + end function rsb_matrix_sum +end interface + +interface +type(c_ptr) function & + &rsb_matrix_mul& + &(matrixa,alphap,transa,matrixb,betap,transb,errvalp)& + &bind(c,name='rsb_matrix_mul') +use iso_c_binding + type(c_ptr), value :: matrixa + type(c_ptr), value :: alphap + integer(c_int), value :: transa + type(c_ptr), value :: matrixb + type(c_ptr), value :: betap + integer(c_int), value :: transb + type(c_ptr), value :: errvalp + end function rsb_matrix_mul +end interface + +interface +integer(c_int) function & + &rsb_matrix_add_to_dense& + &(matrixa,alphap,transa,matrixb,ldb,nr,nc,rowmajor)& + &bind(c,name='rsb_matrix_add_to_dense') +use iso_c_binding + type(c_ptr), value :: matrixa + type(c_ptr), value :: alphap + integer(c_int), value :: transa + type(c_ptr), value :: matrixb + integer(c_int), value :: ldb + integer(c_int), value :: nr + integer(c_int), value :: nc + integer(c_int), value :: rowmajor + end function rsb_matrix_add_to_dense +end interface + +interface +integer(c_int) function & + &rsb_negation& + &(matrix)& + &bind(c,name='rsb_negation') +use iso_c_binding + type(c_ptr), value :: matrix + end function rsb_negation +end interface + +interface +integer(c_int) function & + &rsb_scal& + &(matrix,d,transa)& + &bind(c,name='rsb_scal') +use iso_c_binding + type(c_ptr), value :: matrix + type(c_ptr), value :: d + integer(c_int), value :: transa + end function rsb_scal +end interface + +interface +integer(c_int) function & + &rsb_cest& + &(IA,JA,nnz,typecode,m,k,p_r,p_c,M_b,K_b,flags)& + &bind(c,name='rsb_cest') +use iso_c_binding + type(c_ptr), value :: IA + type(c_ptr), value :: JA + integer(c_int), value :: nnz + integer(c_int), value :: typecode + integer(c_int), value :: m + integer(c_int), value :: k + type(c_ptr), value :: p_r + type(c_ptr), value :: p_c + integer(c_int), value :: M_b + integer(c_int), value :: K_b + integer(c_int), value :: flags + end function rsb_cest +end interface + +interface +integer(c_int) function & + &rsb_perror& + &(errval)& + &bind(c,name='rsb_perror') +use iso_c_binding + integer(c_int), value :: errval + end function rsb_perror +end interface + +interface +integer(c_int) function & + &rsb_sizeof& + &(matrix)& + &bind(c,name='rsb_sizeof') +use iso_c_binding + type(c_ptr), value :: matrix + end function rsb_sizeof +end interface + +interface +integer(c_int) function & + &rsb_get_coo& + &(matrix,VA,IA,JA)& + &bind(c,name='rsb_get_coo') +use iso_c_binding + type(c_ptr), value :: matrix + type(c_ptr), value :: VA + type(c_ptr), value :: IA + type(c_ptr), value :: JA + end function rsb_get_coo +end interface + +interface +integer(c_int) function & + &rsb_reinit& + &(matrix)& + &bind(c,name='rsb_reinit') +use iso_c_binding + type(c_ptr), value :: matrix + end function rsb_reinit +end interface + +interface +integer(c_int) function & + &rsb_getdiag& + &(matrix,diagonal)& + &bind(c,name='rsb_getdiag') +use iso_c_binding + type(c_ptr), value :: matrix + type(c_ptr), value :: diagonal + end function rsb_getdiag +end interface + +interface +integer(c_int) function & + &rsb_get_sub_diag& + &(matrix,diagonal,loffset)& + &bind(c,name='rsb_get_sub_diag') +use iso_c_binding + type(c_ptr), value :: matrix + type(c_ptr), value :: diagonal + integer(c_int), value :: loffset + end function rsb_get_sub_diag +end interface + +interface +integer(c_int) function & + &rsb_get_supra_diag& + &(matrix,diagonal,uoffset)& + &bind(c,name='rsb_get_supra_diag') +use iso_c_binding + type(c_ptr), value :: matrix + type(c_ptr), value :: diagonal + integer(c_int), value :: uoffset + end function rsb_get_supra_diag +end interface + +interface +integer(c_int) function & + &rsb_get_row_dense& + &(matrix,row,i)& + &bind(c,name='rsb_get_row_dense') +use iso_c_binding + type(c_ptr), value :: matrix + type(c_ptr), value :: row + integer(c_int), value :: i + end function rsb_get_row_dense +end interface + +interface +integer(c_int) function & + &rsb_get_rows_nnz& + &(matrix,fr,lr,errvalp)& + &bind(c,name='rsb_get_rows_nnz') +use iso_c_binding + type(c_ptr), value :: matrix + integer(c_int), value :: fr + integer(c_int), value :: lr + type(c_ptr), value :: errvalp + end function rsb_get_rows_nnz +end interface + +interface +integer(c_int) function & + &rsb_get_rows_sparse& + &(matrix,row,fr,lr,IA,JA,rnz,flags)& + &bind(c,name='rsb_get_rows_sparse') +use iso_c_binding + type(c_ptr), value :: matrix + type(c_ptr), value :: row + integer(c_int), value :: fr + integer(c_int), value :: lr + type(c_ptr), value :: IA + type(c_ptr), value :: JA + type(c_ptr), value :: rnz + integer(c_int), value :: flags + end function rsb_get_rows_sparse +end interface + +interface +integer(c_int) function & + &rsb_get_columns_sparse& + &(matrix,columns,fc,lc,IA,JA,rnz,flags)& + &bind(c,name='rsb_get_columns_sparse') +use iso_c_binding + type(c_ptr), value :: matrix + type(c_ptr), value :: columns + integer(c_int), value :: fc + integer(c_int), value :: lc + type(c_ptr), value :: IA + type(c_ptr), value :: JA + type(c_ptr), value :: rnz + integer(c_int), value :: flags + end function rsb_get_columns_sparse +end interface + +interface +integer(c_int) function & + &rsb_assign& + &(new_matrix,matrix)& + &bind(c,name='rsb_assign') +use iso_c_binding + type(c_ptr), value :: new_matrix + type(c_ptr), value :: matrix + end function rsb_assign +end interface + +interface +integer(c_int) function & + &rsb_sym_transpose& + &(matrix)& + &bind(c,name='rsb_sym_transpose') +use iso_c_binding + type(c_ptr), value :: matrix + end function rsb_sym_transpose +end interface + +interface +integer(c_int) function & + &rsb_transpose& + &(matrix)& + &bind(c,name='rsb_transpose') +use iso_c_binding + type(c_ptr), value :: matrix + end function rsb_transpose +end interface + +interface +integer(c_int) function & + &rsb_htranspose& + &(matrix)& + &bind(c,name='rsb_htranspose') +use iso_c_binding + type(c_ptr), value :: matrix + end function rsb_htranspose +end interface + +interface +integer(c_int) function & + &rsb_get_matrix_nnz& + &(matrix)& + &bind(c,name='rsb_get_matrix_nnz') +use iso_c_binding + type(c_ptr), value :: matrix + end function rsb_get_matrix_nnz +end interface + +interface +integer(c_int) function & + &rsb_elemental_scale& + &(matrix,alphap)& + &bind(c,name='rsb_elemental_scale') +use iso_c_binding + type(c_ptr), value :: matrix + type(c_ptr), value :: alphap + end function rsb_elemental_scale +end interface + +interface +integer(c_int) function & + &rsb_elemental_scale_inv& + &(matrix,alphap)& + &bind(c,name='rsb_elemental_scale_inv') +use iso_c_binding + type(c_ptr), value :: matrix + type(c_ptr), value :: alphap + end function rsb_elemental_scale_inv +end interface + +interface +integer(c_int) function & + &rsb_elemental_pow& + &(matrix,alphap)& + &bind(c,name='rsb_elemental_pow') +use iso_c_binding + type(c_ptr), value :: matrix + type(c_ptr), value :: alphap + end function rsb_elemental_pow +end interface + +interface +integer(c_int) function & + &rsb_print_matrix_t& + &(matrix)& + &bind(c,name='rsb_print_matrix_t') +use iso_c_binding + type(c_ptr), value :: matrix + end function rsb_print_matrix_t +end interface + +interface +integer(c_int) function & + &rsb_print_matrix_unsorted_coo& + &(matrix)& + &bind(c,name='rsb_print_matrix_unsorted_coo') +use iso_c_binding + type(c_ptr), value :: matrix + end function rsb_print_matrix_unsorted_coo +end interface + +interface +type(c_ptr) function & + &rsb_load_matrix_file_as_binary& + &(filename,errvalp)& + &bind(c,name='rsb_load_matrix_file_as_binary') +use iso_c_binding + type(c_ptr), value :: filename + type(c_ptr), value :: errvalp + end function rsb_load_matrix_file_as_binary +end interface + +interface +integer(c_int) function & + &rsb_save_matrix_file_as_binary& + &(matrix,filename)& + &bind(c,name='rsb_save_matrix_file_as_binary') +use iso_c_binding + type(c_ptr), value :: matrix + type(c_ptr), value :: filename + end function rsb_save_matrix_file_as_binary +end interface + +interface +integer(c_int) function & + &rsb_save_matrix_file_as_matrix_market& + &(matrix,filename)& + &bind(c,name='rsb_save_matrix_file_as_matrix_market') +use iso_c_binding + type(c_ptr), value :: matrix + type(c_ptr), value :: filename + end function rsb_save_matrix_file_as_matrix_market +end interface + +interface +type(c_ptr) function & + &rsb_load_matrix_file_as_matrix_market& + &(filename,flags,typecode,errvalp)& + &bind(c,name='rsb_load_matrix_file_as_matrix_market') +use iso_c_binding + type(c_ptr), value :: filename + integer(c_int), value :: flags + integer(c_int), value :: typecode + type(c_ptr), value :: errvalp + end function rsb_load_matrix_file_as_matrix_market +end interface +end module rsb_mod