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

psblas3: first implementations for psb_d_rsb_csmm, psb_d_rsb_cssm, psb_d_rsb_cssv, psb_d_rsb_scals, psb_d_rsb_scal, psb_d_rsb_csnmi, psb_d_rsb_csnm1, psb_d_rsb_arwsum, psb_d_rsb_aclsum, psb_d_rsb_get_diag, psb_d_rsb_trim, psb_d_rsb_print, d_rsb_free.

Browse Source
psblas3-type-indexed
Michele Martone 14 years ago
parent c21d3a5b62
commit 437966fb4e
2 changed files with 259 additions and 30 deletions
Show Stats Download Patch File Download Diff File

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

@ -12,18 +12,18 @@ module psb_d_rsb_mat_mod
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_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) :: 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) :: arwsum => psb_d_rsb_arwsum
! procedure, pass(a) :: colsum => psb_d_rsb_colsum
! procedure, pass(a) :: aclsum => psb_d_rsb_aclsum
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
@ -35,14 +35,14 @@ module psb_d_rsb_mat_mod
! 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) :: 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) :: 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
@ -63,13 +63,6 @@ module psb_d_rsb_mat_mod
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
@ -113,8 +106,152 @@ subroutine psb_d_rsb_csmv(alpha,a,x,beta,y,info,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_)))
info=d_rsb_to_psb_info(rsb_spmv(a%rsbmptr,x,y,alpha,beta,1,1,rsb_psblas_trans_to_rsb_trans(trans_)))
end subroutine psb_d_rsb_csmv
subroutine psb_d_rsb_cssv(alpha,a,x,beta,y,info,trans)
! FIXME: and what when x is an alias of y ?
! FIXME: ignoring beta
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_spsv(a%rsbmptr,x,y,alpha,1,1,rsb_psblas_trans_to_rsb_trans(trans_)))
end subroutine psb_d_rsb_cssv
subroutine psb_d_rsb_scals(d,a,info)
use psb_sparse_mod
implicit none
class(psb_d_rsb_sparse_mat), intent(inout) :: a
real(psb_dpk_), intent(in) :: d
integer, intent(out) :: info
info=d_rsb_to_psb_info(rsb_elemental_scale(a%rsbmptr,d))
end subroutine psb_d_rsb_scals
subroutine psb_d_rsb_scal(d,a,info)
use psb_sparse_mod
implicit none
class(psb_d_rsb_sparse_mat), intent(inout) :: a
real(psb_dpk_), intent(in) :: d(:)
integer, intent(out) :: info
info=d_rsb_to_psb_info(rsb_scale_rows(a%rsbmptr,d))
end subroutine psb_d_rsb_scal
subroutine d_rsb_free(a)
implicit none
class(psb_d_rsb_sparse_mat), intent(inout) :: a
type(c_ptr) :: dummy
dummy=rsb_free_sparse_matrix(a%rsbmptr)
end subroutine d_rsb_free
subroutine psb_d_rsb_trim(a)
implicit none
class(psb_d_rsb_sparse_mat), intent(inout) :: a
! FIXME: this is supposed to remain empty for RSB
end subroutine psb_d_rsb_trim
subroutine psb_d_rsb_print(iout,a,iv,eirs,eics,head,ivr,ivc)
integer, intent(in) :: iout
class(psb_d_rsb_sparse_mat), intent(in) :: a
integer, intent(in), optional :: iv(:)
integer, intent(in), optional :: eirs,eics
character(len=*), optional :: head
integer, intent(in), optional :: ivr(:), ivc(:)
integer :: info
! FIXME: UNFINISHED
info=rsb_print_matrix_t(a%rsbmptr)
end subroutine psb_d_rsb_print
subroutine psb_d_rsb_get_diag(a,d,info)
class(psb_d_rsb_sparse_mat), intent(in) :: a
real(psb_dpk_), intent(out) :: d(:)
integer, intent(out) :: info
info=rsb_getdiag(a%rsbmptr,d)
end subroutine psb_d_rsb_get_diag
function psb_d_rsb_csnmi(a) result(res)
implicit none
class(psb_d_rsb_sparse_mat), intent(in) :: a
real(psb_dpk_) :: res
integer :: info
info=rsb_infinity_norm(a%rsbmptr,res,rsb_psblas_trans_to_rsb_trans('N'))
end function psb_d_rsb_csnmi
function psb_d_rsb_csnm1(a) result(res)
implicit none
class(psb_d_rsb_sparse_mat), intent(in) :: a
real(psb_dpk_) :: res
integer :: info
info=rsb_one_norm(a%rsbmptr,res,rsb_psblas_trans_to_rsb_trans('N'))
end function psb_d_rsb_csnm1
subroutine psb_d_rsb_aclsum(d,a)
use psb_sparse_mod
class(psb_d_rsb_sparse_mat), intent(in) :: a
real(psb_dpk_), intent(out) :: d(:)
info=rsb_absolute_columns_sums(a%rsbmptr,d)
end subroutine psb_d_rsb_aclsum
subroutine psb_d_rsb_arwsum(d,a)
use psb_sparse_mod
class(psb_d_rsb_sparse_mat), intent(in) :: a
real(psb_dpk_), intent(out) :: d(:)
info=rsb_absolute_rows_sums(a%rsbmptr,d)
end subroutine psb_d_rsb_arwsum
subroutine psb_d_rsb_csmm(alpha,a,x,beta,y,info,trans)
use psb_sparse_mod
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_
integer :: ldy,ldx,nc
integer :: order=2 ! FIXME
if (present(trans)) then
trans_ = trans
else
trans_ = 'N'
end if
ldx=size(x,1); ldy=size(y,1)
nc=min(size(x,2),size(y,2) )
info=d_rsb_to_psb_info(rsb_spmm(a%rsbmptr,x,y,ldx,ldy,nc,rsb_psblas_trans_to_rsb_trans(trans_),alpha,beta,order))
end subroutine psb_d_rsb_csmm
subroutine psb_d_rsb_cssm(alpha,a,x,beta,y,info,trans)
use psb_sparse_mod
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
integer :: order=2 ! FIXME
integer :: ldy,ldx,nc
character :: trans_
if (present(trans)) then
trans_ = trans
else
trans_ = 'N'
end if
ldx=size(x,1); ldy=size(y,1)
nc=min(size(x,2),size(y,2) )
info=d_rsb_to_psb_info(rsb_spsm(a%rsbmptr,y,ldy,nc,rsb_psblas_trans_to_rsb_trans(trans_),alpha,beta,order))
end subroutine
#endif
end module psb_d_rsb_mat_mod

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

@ -1,6 +1,7 @@
module rsb_mod
use iso_c_binding
! module constants:
interface
integer(c_int) function &
@ -35,7 +36,7 @@ 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
real(c_double) :: VAc(*)
type(c_ptr), value :: VAc
integer(c_int) :: IAc(*)
integer(c_int) :: JAc(*)
integer(c_int), value :: nnz
@ -206,11 +207,45 @@ integer(c_int) function &
&bind(c,name='rsb_infinity_norm')
use iso_c_binding
type(c_ptr), value :: matrix
type(c_ptr), value :: infinity_norm
real(c_double) :: infinity_norm
integer(c_int), value :: transa
end function rsb_infinity_norm
end interface
interface
integer(c_int) function &
&rsb_one_norm&
&(matrix,infinity_norm,transa)&
&bind(c,name='rsb_one_norm')
use iso_c_binding
type(c_ptr), value :: matrix
real(c_double) :: infinity_norm
integer(c_int), value :: transa
end function rsb_one_norm
end interface
interface
integer(c_int) function &
&rsb_absolute_rows_sums&
&(matrix,d)&
&bind(c,name='rsb_absolute_rows_sums')
use iso_c_binding
type(c_ptr), value :: matrix
real(c_double) :: d(*)
end function rsb_absolute_rows_sums
end interface
interface
integer(c_int) function &
&rsb_absolute_columns_sums&
&(matrix,d)&
&bind(c,name='rsb_absolute_columns_sums')
use iso_c_binding
type(c_ptr), value :: matrix
real(c_double) :: d(*)
end function rsb_absolute_columns_sums
end interface
interface
integer(c_int) function &
&rsb_spmm_az&
@ -276,8 +311,8 @@ integer(c_int) function &
&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
real(c_double) :: b(*)
real(c_double) :: c(*)
integer(c_int), value :: ldb
integer(c_int), value :: ldc
integer(c_int), value :: nrhs
@ -288,6 +323,42 @@ use iso_c_binding
end function rsb_spmm_sxsx
end interface
interface
integer(c_int) function &
&rsb_spmm&
&(matrix,b,c,ldb,ldc,nrhs,transa,alphap,betap,order)&
&bind(c,name='rsb_spmm')
use iso_c_binding
type(c_ptr), value :: matrix
real(c_double) :: b(*)
real(c_double) :: c(*)
integer(c_int), value :: ldb
integer(c_int), value :: ldc
integer(c_int), value :: nrhs
integer(c_int), value :: transa
real(c_double) :: alphap
real(c_double) :: betap
integer(c_int), value :: order
end function rsb_spmm
end interface
interface
integer(c_int) function &
&rsb_spsm&
&(matrix,b,ldb,nrhs,transt,alphap,betap,order)&
&bind(c,name='rsb_spsm')
use iso_c_binding
type(c_ptr), value :: matrix
real(c_double) :: b(*)
integer(c_int), value :: ldb
integer(c_int), value :: nrhs
integer(c_int), value :: transt
real(c_double) :: alphap
real(c_double) :: betap
integer(c_int), value :: order
end function rsb_spsm
end interface
interface
integer(c_int) function &
&rsb_spsm_sxsx&
@ -295,7 +366,7 @@ integer(c_int) function &
&bind(c,name='rsb_spsm_sxsx')
use iso_c_binding
type(c_ptr), value :: matrix
type(c_ptr), value :: b
real(c_double) :: b(*)
integer(c_int), value :: ldb
integer(c_int), value :: nrhs
integer(c_int), value :: transt
@ -371,11 +442,22 @@ integer(c_int) function &
&bind(c,name='rsb_scal')
use iso_c_binding
type(c_ptr), value :: matrix
type(c_ptr), value :: d
real(c_double) :: d(*)
integer(c_int), value :: transa
end function rsb_scal
end interface
interface
integer(c_int) function &
&rsb_scale_rows&
&(matrix,d)&
&bind(c,name='rsb_scale_rows')
use iso_c_binding
type(c_ptr), value :: matrix
real(c_double) :: d(*)
end function rsb_scale_rows
end interface
interface
integer(c_int) function &
&rsb_cest&
@ -446,7 +528,7 @@ integer(c_int) function &
&bind(c,name='rsb_getdiag')
use iso_c_binding
type(c_ptr), value :: matrix
type(c_ptr), value :: diagonal
real(c_double) :: diagonal(*)
end function rsb_getdiag
end interface
@ -457,7 +539,7 @@ integer(c_int) function &
&bind(c,name='rsb_get_sub_diag')
use iso_c_binding
type(c_ptr), value :: matrix
type(c_ptr), value :: diagonal
real(c_double) :: diagonal(*)
integer(c_int), value :: loffset
end function rsb_get_sub_diag
end interface
@ -469,7 +551,7 @@ integer(c_int) function &
&bind(c,name='rsb_get_supra_diag')
use iso_c_binding
type(c_ptr), value :: matrix
type(c_ptr), value :: diagonal
real(c_double) :: diagonal(*)
integer(c_int), value :: uoffset
end function rsb_get_supra_diag
end interface
@ -617,6 +699,16 @@ use iso_c_binding
end function rsb_elemental_pow
end interface
interface
integer(c_int) function &
&rsb_psblas_trans_to_rsb_trans&
&(trans)&
&bind(c,name='rsb_psblas_trans_to_rsb_trans')
use iso_c_binding
character(c_char), value :: trans
end function rsb_psblas_trans_to_rsb_trans
end interface
interface
integer(c_int) function &
&rsb_print_matrix_t&

Write Preview
Loading…
Cancel
Save