From c21d3a5b627faa7329b16e5add043f446e09e905 Mon Sep 17 00:00:00 2001 From: Michele Martone Date: Fri, 5 Nov 2010 19:12:39 +0000 Subject: [PATCH] psblas3: giving substance to the rsb interface. --- test/serial/Makefile | 2 + test/serial/psb_d_rsb_mat_mod.F03 | 98 +++++++++++++++++++++++++++- test/serial/rsb_mod.f03 | 102 +++++++++++++++--------------- 3 files changed, 149 insertions(+), 53 deletions(-) diff --git a/test/serial/Makefile b/test/serial/Makefile index 0a47fa3e..edb61382 100644 --- a/test/serial/Makefile +++ b/test/serial/Makefile @@ -21,6 +21,8 @@ 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.o: psb_d_czz_mat_mod.o +psb_d_rsb_mat_mod.o: rsb_mod.o 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) diff --git a/test/serial/psb_d_rsb_mat_mod.F03 b/test/serial/psb_d_rsb_mat_mod.F03 index dca0e814..95d4b468 100644 --- a/test/serial/psb_d_rsb_mat_mod.F03 +++ b/test/serial/psb_d_rsb_mat_mod.F03 @@ -8,19 +8,113 @@ module psb_d_rsb_mat_mod #ifdef HAVE_LIBRSB type(c_ptr) :: rsbmptr contains + procedure, pass(a) :: get_size => d_rsb_get_size procedure, pass(a) :: get_nzeros => d_rsb_get_nzeros + procedure, pass(a) :: get_fmt => d_rsb_get_fmt + procedure, pass(a) :: sizeof => d_rsb_sizeof +! procedure, pass(a) :: d_csmm => psb_d_rsb_csmm + procedure, pass(a) :: d_csmv => psb_d_rsb_csmv +! procedure, pass(a) :: d_inner_cssm => psb_d_rsb_cssm +! procedure, pass(a) :: d_inner_cssv => psb_d_rsb_cssv +! procedure, pass(a) :: d_scals => psb_d_rsb_scals +! procedure, pass(a) :: d_scal => psb_d_rsb_scal +! procedure, pass(a) :: csnmi => psb_d_rsb_csnmi +! procedure, pass(a) :: csnm1 => psb_d_rsb_csnm1 +! procedure, pass(a) :: rowsum => psb_d_rsb_rowsum +! procedure, pass(a) :: arwsum => psb_d_rsb_arwsum +! procedure, pass(a) :: colsum => psb_d_rsb_colsum +! procedure, pass(a) :: aclsum => psb_d_rsb_aclsum +! procedure, pass(a) :: reallocate_nz => psb_d_rsb_reallocate_nz ! FIXME +! procedure, pass(a) :: allocate_mnnz => psb_d_rsb_allocate_mnnz ! FIXME +! procedure, pass(a) :: cp_to_coo => psb_d_cp_rsb_to_coo +! procedure, pass(a) :: cp_from_coo => psb_d_cp_rsb_from_coo +! procedure, pass(a) :: cp_to_fmt => psb_d_cp_rsb_to_fmt +! procedure, pass(a) :: cp_from_fmt => psb_d_cp_rsb_from_fmt +! procedure, pass(a) :: mv_to_coo => psb_d_mv_rsb_to_coo +! procedure, pass(a) :: mv_from_coo => psb_d_mv_rsb_from_coo +! procedure, pass(a) :: mv_to_fmt => psb_d_mv_rsb_to_fmt +! procedure, pass(a) :: mv_from_fmt => psb_d_mv_rsb_from_fmt +! procedure, pass(a) :: csput => psb_d_rsb_csput +! procedure, pass(a) :: get_diag => psb_d_rsb_get_diag +! procedure, pass(a) :: csgetptn => psb_d_rsb_csgetptn +! procedure, pass(a) :: d_csgetrow => psb_d_rsb_csgetrow +! procedure, pass(a) :: get_nz_row => d_rsb_get_nz_row +! procedure, pass(a) :: reinit => psb_d_rsb_reinit +! procedure, pass(a) :: trim => psb_d_rsb_trim +! procedure, pass(a) :: print => psb_d_rsb_print +! procedure, pass(a) :: free => d_rsb_free +! procedure, pass(a) :: mold => psb_d_rsb_mold +! procedure, pass(a) :: psb_d_rsb_cp_from +! generic, public :: cp_from => psb_d_rsb_cp_from +! procedure, pass(a) :: psb_d_rsb_mv_from +! generic, public :: mv_from => psb_d_rsb_mv_from + #endif end type - private :: d_rsb_get_nzeros + ! FIXME: complete the following + !private :: d_rsb_get_nzeros, d_rsb_get_fmt + private :: d_rsb_to_psb_info #ifdef HAVE_LIBRSB contains + function d_rsb_to_psb_info(info) result(res) + implicit none + integer :: res,info + res=info + end function d_rsb_to_psb_info + + function d_psb_to_rsb_trans(trans) result(res) + implicit none + character :: trans + integer :: res + res=0 !FIXME + end function d_psb_to_rsb_trans + 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) + res=rsb_get_matrix_nnz(a%rsbmptr) end function d_rsb_get_nzeros + function d_rsb_get_fmt(a) result(res) + implicit none + class(psb_d_rsb_sparse_mat), intent(in) :: a + character(len=5) :: res + res = 'RSB' + end function d_rsb_get_fmt + + function d_rsb_get_size(a) result(res) + implicit none + class(psb_d_rsb_sparse_mat), intent(in) :: a + integer :: res + res = d_rsb_get_nzeros(a) + end function d_rsb_get_size + + function d_rsb_sizeof(a) result(res) + implicit none + class(psb_d_rsb_sparse_mat), intent(in) :: a + integer(psb_long_int_k_) :: res + res=rsb_sizeof(a%rsbmptr) + end function d_rsb_sizeof + +subroutine psb_d_rsb_csmv(alpha,a,x,beta,y,info,trans) + implicit none + class(psb_d_rsb_sparse_mat), intent(in) :: a + real(psb_dpk_), intent(in) :: alpha, beta, x(:) + real(psb_dpk_), intent(inout) :: y(:) + integer, intent(out) :: info + character, optional, intent(in) :: trans + character :: trans_ + info = psb_success_ + + if (present(trans)) then + trans_ = trans + else + trans_ = 'N' + end if + info=d_rsb_to_psb_info(rsb_spmv(a%rsbmptr,x,y,alpha,beta,1,1,d_psb_to_rsb_trans(trans_))) +end subroutine psb_d_rsb_csmv + #endif end module psb_d_rsb_mat_mod diff --git a/test/serial/rsb_mod.f03 b/test/serial/rsb_mod.f03 index df5c2bf7..fa299134 100644 --- a/test/serial/rsb_mod.f03 +++ b/test/serial/rsb_mod.f03 @@ -35,9 +35,9 @@ type(c_ptr) function & &(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 + real(c_double) :: VAc(*) + integer(c_int) :: IAc(*) + integer(c_int) :: JAc(*) integer(c_int), value :: nnz integer(c_int), value :: typecode integer(c_int), value :: m @@ -104,10 +104,10 @@ integer(c_int) function & &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 + real(c_double) :: x(*) + real(c_double) :: y(*) + real(c_double) :: alphap + real(c_double) :: betap integer(c_int), value :: incx integer(c_int), value :: incy integer(c_int), value :: transa @@ -121,8 +121,8 @@ integer(c_int) function & &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 + real(c_double) :: x(*) + real(c_double) :: y(*) integer(c_int), value :: transa end function rsb_spmv_aa end interface @@ -134,9 +134,9 @@ integer(c_int) function & &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 + real(c_double) :: x(*) + real(c_double) :: y(*) + real(c_double) :: alphap integer(c_int), value :: transa end function rsb_spmv_sa end interface @@ -148,8 +148,8 @@ integer(c_int) function & &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 + real(c_double) :: x(*) + real(c_double) :: y(*) integer(c_int), value :: transa end function rsb_spmv_na end interface @@ -161,8 +161,8 @@ integer(c_int) function & &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 + real(c_double) :: x(*) + real(c_double) :: y(*) integer(c_int), value :: transa end function rsb_spmv_az end interface @@ -174,10 +174,10 @@ integer(c_int) function & &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 + real(c_double) :: x(*) + real(c_double) :: y(*) + real(c_double) :: alphap + real(c_double) :: betap integer(c_int), value :: transa end function rsb_spmv_xx end interface @@ -189,10 +189,10 @@ integer(c_int) function & &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 + real(c_double) :: x(*) + real(c_double) :: y(*) + real(c_double) :: alphap + real(c_double) :: betap integer(c_int), value :: transa integer(c_int), value :: incx integer(c_int), value :: incy @@ -234,7 +234,7 @@ integer(c_int) function & &bind(c,name='rsb_spsv_azl') use iso_c_binding type(c_ptr), value :: matrix - type(c_ptr), value :: y + real(c_double) :: y(*) integer(c_int), value :: transl end function rsb_spsv_azl end interface @@ -246,8 +246,8 @@ integer(c_int) function & &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 + real(c_double) :: y(*) + real(c_double) :: alphap integer(c_int), value :: incx integer(c_int), value :: transl end function rsb_spsv_sxsx @@ -260,9 +260,9 @@ integer(c_int) function & &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 + real(c_double) :: x(*) + real(c_double) :: y(*) + real(c_double) :: alphap integer(c_int), value :: incx integer(c_int), value :: incy integer(c_int), value :: transl @@ -282,8 +282,8 @@ use iso_c_binding 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 + real(c_double) :: alphap + real(c_double) :: betap integer(c_int), value :: order end function rsb_spmm_sxsx end interface @@ -299,8 +299,8 @@ use iso_c_binding 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 + real(c_double) :: alphap + real(c_double) :: betap integer(c_int), value :: order end function rsb_spsm_sxsx end interface @@ -312,10 +312,10 @@ type(c_ptr) function & &bind(c,name='rsb_matrix_sum') use iso_c_binding type(c_ptr), value :: matrixa - type(c_ptr), value :: alphap + real(c_double) :: alphap integer(c_int), value :: transa type(c_ptr), value :: matrixb - type(c_ptr), value :: betap + real(c_double) :: betap integer(c_int), value :: transb type(c_ptr), value :: errvalp end function rsb_matrix_sum @@ -328,10 +328,10 @@ type(c_ptr) function & &bind(c,name='rsb_matrix_mul') use iso_c_binding type(c_ptr), value :: matrixa - type(c_ptr), value :: alphap + real(c_double) :: alphap integer(c_int), value :: transa type(c_ptr), value :: matrixb - type(c_ptr), value :: betap + real(c_double) :: betap integer(c_int), value :: transb type(c_ptr), value :: errvalp end function rsb_matrix_mul @@ -344,7 +344,7 @@ integer(c_int) function & &bind(c,name='rsb_matrix_add_to_dense') use iso_c_binding type(c_ptr), value :: matrixa - type(c_ptr), value :: alphap + real(c_double) :: alphap integer(c_int), value :: transa type(c_ptr), value :: matrixb integer(c_int), value :: ldb @@ -382,8 +382,8 @@ integer(c_int) function & &(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) :: IA(*) + integer(c_int) :: JA(*) integer(c_int), value :: nnz integer(c_int), value :: typecode integer(c_int), value :: m @@ -423,9 +423,9 @@ integer(c_int) function & &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 + real(c_double) :: VA(*) + integer(c_int) :: IA(*) + integer(c_int) :: JA(*) end function rsb_get_coo end interface @@ -509,8 +509,8 @@ use iso_c_binding 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 + integer(c_int) :: IA(*) + integer(c_int) :: JA(*) type(c_ptr), value :: rnz integer(c_int), value :: flags end function rsb_get_rows_sparse @@ -526,8 +526,8 @@ use iso_c_binding 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 + integer(c_int) :: IA(*) + integer(c_int) :: JA(*) type(c_ptr), value :: rnz integer(c_int), value :: flags end function rsb_get_columns_sparse @@ -591,7 +591,7 @@ integer(c_int) function & &bind(c,name='rsb_elemental_scale') use iso_c_binding type(c_ptr), value :: matrix - type(c_ptr), value :: alphap + real(c_double) :: alphap end function rsb_elemental_scale end interface @@ -602,7 +602,7 @@ integer(c_int) function & &bind(c,name='rsb_elemental_scale_inv') use iso_c_binding type(c_ptr), value :: matrix - type(c_ptr), value :: alphap + real(c_double) :: alphap end function rsb_elemental_scale_inv end interface @@ -613,7 +613,7 @@ integer(c_int) function & &bind(c,name='rsb_elemental_pow') use iso_c_binding type(c_ptr), value :: matrix - type(c_ptr), value :: alphap + real(c_double) :: alphap end function rsb_elemental_pow end interface