mirror of
https://github.com/sfilippone/psblas3.git
synced 2026-10-19 04:12:09 +00:00
psblas3:
giving substance to the rsb interface.
This commit is contained in:
Michele Martone
@@ -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)
|
||||
|
||||
@@ -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
|
||||
|
||||
+51
-51
@@ -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
|
||||
|
||||
|
||||
Reference in New Issue
Block a user