fdurastante
/
psblas3
mirror of https://github.com/sfilippone/psblas3.git
1
0
Fork 0
Code Issues Packages Projects Releases Wiki Activity

psblas3:

Browse Source 
giving substance to the rsb interface.
psblas3-type-indexed
Michele Martone 14 years ago
parent 3beedcad96
commit c21d3a5b62
3 changed files with 149 additions and 53 deletions
Show Stats Download Patch File Download Diff File

2
test/serial/Makefile
Unescape Escape View File

@ -21,6 +21,8 @@ d_coo_matgen: d_coo_matgen.o
/bin/mv d_coo_matgen $(EXEDIR) /bin/mv d_coo_matgen $(EXEDIR)
psb_d_cxx_impl.o d_matgen.o: psb_d_cxx_mat_mod.o 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 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 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 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) $(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)

96
test/serial/psb_d_rsb_mat_mod.F03
Unescape Escape View File

@ -8,13 +8,68 @@ module psb_d_rsb_mat_mod
#ifdef HAVE_LIBRSB #ifdef HAVE_LIBRSB
type(c_ptr) :: rsbmptr type(c_ptr) :: rsbmptr
contains contains
procedure, pass(a) :: get_size => d_rsb_get_size
procedure, pass(a) :: get_nzeros => d_rsb_get_nzeros 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 #endif
end type 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 #ifdef HAVE_LIBRSB
contains 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) function d_rsb_get_nzeros(a) result(res)
implicit none implicit none
class(psb_d_rsb_sparse_mat), intent(in) :: a class(psb_d_rsb_sparse_mat), intent(in) :: a
@ -22,5 +77,44 @@ module psb_d_rsb_mat_mod
res=rsb_get_matrix_nnz(a%rsbmptr) res=rsb_get_matrix_nnz(a%rsbmptr)
end function d_rsb_get_nzeros 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 #endif
end module psb_d_rsb_mat_mod end module psb_d_rsb_mat_mod

102
test/serial/rsb_mod.f03
Unescape Escape View File

@ -35,9 +35,9 @@ type(c_ptr) function &
&(VAc,IAc,JAc,nnz,typecode,m,k,Mb,Kb,flags,errvalp)& &(VAc,IAc,JAc,nnz,typecode,m,k,Mb,Kb,flags,errvalp)&
&bind(c,name='rsb_allocate_rsb_sparse_matrix_const') &bind(c,name='rsb_allocate_rsb_sparse_matrix_const')
use iso_c_binding use iso_c_binding
type(c_ptr), value :: VAc real(c_double) :: VAc(*)
type(c_ptr), value :: IAc integer(c_int) :: IAc(*)
type(c_ptr), value :: JAc integer(c_int) :: JAc(*)
integer(c_int), value :: nnz integer(c_int), value :: nnz
integer(c_int), value :: typecode integer(c_int), value :: typecode
integer(c_int), value :: m integer(c_int), value :: m
@ -104,10 +104,10 @@ integer(c_int) function &
&bind(c,name='rsb_spmv') &bind(c,name='rsb_spmv')
use iso_c_binding use iso_c_binding
type(c_ptr), value :: matrix type(c_ptr), value :: matrix
type(c_ptr), value :: x real(c_double) :: x(*)
type(c_ptr), value :: y real(c_double) :: y(*)
type(c_ptr), value :: alphap real(c_double) :: alphap
type(c_ptr), value :: betap real(c_double) :: betap
integer(c_int), value :: incx integer(c_int), value :: incx
integer(c_int), value :: incy integer(c_int), value :: incy
integer(c_int), value :: transa integer(c_int), value :: transa
@ -121,8 +121,8 @@ integer(c_int) function &
&bind(c,name='rsb_spmv_aa') &bind(c,name='rsb_spmv_aa')
use iso_c_binding use iso_c_binding
type(c_ptr), value :: matrix type(c_ptr), value :: matrix
type(c_ptr), value :: x real(c_double) :: x(*)
type(c_ptr), value :: y real(c_double) :: y(*)
integer(c_int), value :: transa integer(c_int), value :: transa
end function rsb_spmv_aa end function rsb_spmv_aa
end interface end interface
@ -134,9 +134,9 @@ integer(c_int) function &
&bind(c,name='rsb_spmv_sa') &bind(c,name='rsb_spmv_sa')
use iso_c_binding use iso_c_binding
type(c_ptr), value :: matrix type(c_ptr), value :: matrix
type(c_ptr), value :: x real(c_double) :: x(*)
type(c_ptr), value :: y real(c_double) :: y(*)
type(c_ptr), value :: alphap real(c_double) :: alphap
integer(c_int), value :: transa integer(c_int), value :: transa
end function rsb_spmv_sa end function rsb_spmv_sa
end interface end interface
@ -148,8 +148,8 @@ integer(c_int) function &
&bind(c,name='rsb_spmv_na') &bind(c,name='rsb_spmv_na')
use iso_c_binding use iso_c_binding
type(c_ptr), value :: matrix type(c_ptr), value :: matrix
type(c_ptr), value :: x real(c_double) :: x(*)
type(c_ptr), value :: y real(c_double) :: y(*)
integer(c_int), value :: transa integer(c_int), value :: transa
end function rsb_spmv_na end function rsb_spmv_na
end interface end interface
@ -161,8 +161,8 @@ integer(c_int) function &
&bind(c,name='rsb_spmv_az') &bind(c,name='rsb_spmv_az')
use iso_c_binding use iso_c_binding
type(c_ptr), value :: matrix type(c_ptr), value :: matrix
type(c_ptr), value :: x real(c_double) :: x(*)
type(c_ptr), value :: y real(c_double) :: y(*)
integer(c_int), value :: transa integer(c_int), value :: transa
end function rsb_spmv_az end function rsb_spmv_az
end interface end interface
@ -174,10 +174,10 @@ integer(c_int) function &
&bind(c,name='rsb_spmv_xx') &bind(c,name='rsb_spmv_xx')
use iso_c_binding use iso_c_binding
type(c_ptr), value :: matrix type(c_ptr), value :: matrix
type(c_ptr), value :: x real(c_double) :: x(*)
type(c_ptr), value :: y real(c_double) :: y(*)
type(c_ptr), value :: alphap real(c_double) :: alphap
type(c_ptr), value :: betap real(c_double) :: betap
integer(c_int), value :: transa integer(c_int), value :: transa
end function rsb_spmv_xx end function rsb_spmv_xx
end interface end interface
@ -189,10 +189,10 @@ integer(c_int) function &
&bind(c,name='rsb_spmv_sxsx') &bind(c,name='rsb_spmv_sxsx')
use iso_c_binding use iso_c_binding
type(c_ptr), value :: matrix type(c_ptr), value :: matrix
type(c_ptr), value :: x real(c_double) :: x(*)
type(c_ptr), value :: y real(c_double) :: y(*)
type(c_ptr), value :: alphap real(c_double) :: alphap
type(c_ptr), value :: betap real(c_double) :: betap
integer(c_int), value :: transa integer(c_int), value :: transa
integer(c_int), value :: incx integer(c_int), value :: incx
integer(c_int), value :: incy integer(c_int), value :: incy
@ -234,7 +234,7 @@ integer(c_int) function &
&bind(c,name='rsb_spsv_azl') &bind(c,name='rsb_spsv_azl')
use iso_c_binding use iso_c_binding
type(c_ptr), value :: matrix type(c_ptr), value :: matrix
type(c_ptr), value :: y real(c_double) :: y(*)
integer(c_int), value :: transl integer(c_int), value :: transl
end function rsb_spsv_azl end function rsb_spsv_azl
end interface end interface
@ -246,8 +246,8 @@ integer(c_int) function &
&bind(c,name='rsb_spsv_sxsx') &bind(c,name='rsb_spsv_sxsx')
use iso_c_binding use iso_c_binding
type(c_ptr), value :: matrix type(c_ptr), value :: matrix
type(c_ptr), value :: y real(c_double) :: y(*)
type(c_ptr), value :: alphap real(c_double) :: alphap
integer(c_int), value :: incx integer(c_int), value :: incx
integer(c_int), value :: transl integer(c_int), value :: transl
end function rsb_spsv_sxsx end function rsb_spsv_sxsx
@ -260,9 +260,9 @@ integer(c_int) function &
&bind(c,name='rsb_spsv') &bind(c,name='rsb_spsv')
use iso_c_binding use iso_c_binding
type(c_ptr), value :: matrix type(c_ptr), value :: matrix
type(c_ptr), value :: x real(c_double) :: x(*)
type(c_ptr), value :: y real(c_double) :: y(*)
type(c_ptr), value :: alphap real(c_double) :: alphap
integer(c_int), value :: incx integer(c_int), value :: incx
integer(c_int), value :: incy integer(c_int), value :: incy
integer(c_int), value :: transl integer(c_int), value :: transl
@ -282,8 +282,8 @@ use iso_c_binding
integer(c_int), value :: ldc integer(c_int), value :: ldc
integer(c_int), value :: nrhs integer(c_int), value :: nrhs
integer(c_int), value :: transa integer(c_int), value :: transa
type(c_ptr), value :: alphap real(c_double) :: alphap
type(c_ptr), value :: betap real(c_double) :: betap
integer(c_int), value :: order integer(c_int), value :: order
end function rsb_spmm_sxsx end function rsb_spmm_sxsx
end interface end interface
@ -299,8 +299,8 @@ use iso_c_binding
integer(c_int), value :: ldb integer(c_int), value :: ldb
integer(c_int), value :: nrhs integer(c_int), value :: nrhs
integer(c_int), value :: transt integer(c_int), value :: transt
type(c_ptr), value :: alphap real(c_double) :: alphap
type(c_ptr), value :: betap real(c_double) :: betap
integer(c_int), value :: order integer(c_int), value :: order
end function rsb_spsm_sxsx end function rsb_spsm_sxsx
end interface end interface
@ -312,10 +312,10 @@ type(c_ptr) function &
&bind(c,name='rsb_matrix_sum') &bind(c,name='rsb_matrix_sum')
use iso_c_binding use iso_c_binding
type(c_ptr), value :: matrixa type(c_ptr), value :: matrixa
type(c_ptr), value :: alphap real(c_double) :: alphap
integer(c_int), value :: transa integer(c_int), value :: transa
type(c_ptr), value :: matrixb type(c_ptr), value :: matrixb
type(c_ptr), value :: betap real(c_double) :: betap
integer(c_int), value :: transb integer(c_int), value :: transb
type(c_ptr), value :: errvalp type(c_ptr), value :: errvalp
end function rsb_matrix_sum end function rsb_matrix_sum
@ -328,10 +328,10 @@ type(c_ptr) function &
&bind(c,name='rsb_matrix_mul') &bind(c,name='rsb_matrix_mul')
use iso_c_binding use iso_c_binding
type(c_ptr), value :: matrixa type(c_ptr), value :: matrixa
type(c_ptr), value :: alphap real(c_double) :: alphap
integer(c_int), value :: transa integer(c_int), value :: transa
type(c_ptr), value :: matrixb type(c_ptr), value :: matrixb
type(c_ptr), value :: betap real(c_double) :: betap
integer(c_int), value :: transb integer(c_int), value :: transb
type(c_ptr), value :: errvalp type(c_ptr), value :: errvalp
end function rsb_matrix_mul end function rsb_matrix_mul
@ -344,7 +344,7 @@ integer(c_int) function &
&bind(c,name='rsb_matrix_add_to_dense') &bind(c,name='rsb_matrix_add_to_dense')
use iso_c_binding use iso_c_binding
type(c_ptr), value :: matrixa type(c_ptr), value :: matrixa
type(c_ptr), value :: alphap real(c_double) :: alphap
integer(c_int), value :: transa integer(c_int), value :: transa
type(c_ptr), value :: matrixb type(c_ptr), value :: matrixb
integer(c_int), value :: ldb 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)& &(IA,JA,nnz,typecode,m,k,p_r,p_c,M_b,K_b,flags)&
&bind(c,name='rsb_cest') &bind(c,name='rsb_cest')
use iso_c_binding use iso_c_binding
type(c_ptr), value :: IA integer(c_int) :: IA(*)
type(c_ptr), value :: JA integer(c_int) :: JA(*)
integer(c_int), value :: nnz integer(c_int), value :: nnz
integer(c_int), value :: typecode integer(c_int), value :: typecode
integer(c_int), value :: m integer(c_int), value :: m
@ -423,9 +423,9 @@ integer(c_int) function &
&bind(c,name='rsb_get_coo') &bind(c,name='rsb_get_coo')
use iso_c_binding use iso_c_binding
type(c_ptr), value :: matrix type(c_ptr), value :: matrix
type(c_ptr), value :: VA real(c_double) :: VA(*)
type(c_ptr), value :: IA integer(c_int) :: IA(*)
type(c_ptr), value :: JA integer(c_int) :: JA(*)
end function rsb_get_coo end function rsb_get_coo
end interface end interface
@ -509,8 +509,8 @@ use iso_c_binding
type(c_ptr), value :: row type(c_ptr), value :: row
integer(c_int), value :: fr integer(c_int), value :: fr
integer(c_int), value :: lr integer(c_int), value :: lr
type(c_ptr), value :: IA integer(c_int) :: IA(*)
type(c_ptr), value :: JA integer(c_int) :: JA(*)
type(c_ptr), value :: rnz type(c_ptr), value :: rnz
integer(c_int), value :: flags integer(c_int), value :: flags
end function rsb_get_rows_sparse end function rsb_get_rows_sparse
@ -526,8 +526,8 @@ use iso_c_binding
type(c_ptr), value :: columns type(c_ptr), value :: columns
integer(c_int), value :: fc integer(c_int), value :: fc
integer(c_int), value :: lc integer(c_int), value :: lc
type(c_ptr), value :: IA integer(c_int) :: IA(*)
type(c_ptr), value :: JA integer(c_int) :: JA(*)
type(c_ptr), value :: rnz type(c_ptr), value :: rnz
integer(c_int), value :: flags integer(c_int), value :: flags
end function rsb_get_columns_sparse end function rsb_get_columns_sparse
@ -591,7 +591,7 @@ integer(c_int) function &
&bind(c,name='rsb_elemental_scale') &bind(c,name='rsb_elemental_scale')
use iso_c_binding use iso_c_binding
type(c_ptr), value :: matrix type(c_ptr), value :: matrix
type(c_ptr), value :: alphap real(c_double) :: alphap
end function rsb_elemental_scale end function rsb_elemental_scale
end interface end interface
@ -602,7 +602,7 @@ integer(c_int) function &
&bind(c,name='rsb_elemental_scale_inv') &bind(c,name='rsb_elemental_scale_inv')
use iso_c_binding use iso_c_binding
type(c_ptr), value :: matrix type(c_ptr), value :: matrix
type(c_ptr), value :: alphap real(c_double) :: alphap
end function rsb_elemental_scale_inv end function rsb_elemental_scale_inv
end interface end interface
@ -613,7 +613,7 @@ integer(c_int) function &
&bind(c,name='rsb_elemental_pow') &bind(c,name='rsb_elemental_pow')
use iso_c_binding use iso_c_binding
type(c_ptr), value :: matrix type(c_ptr), value :: matrix
type(c_ptr), value :: alphap real(c_double) :: alphap
end function rsb_elemental_pow end function rsb_elemental_pow
end interface end interface

Write Preview
Loading…
Cancel
Save