interfaced the following operations: psb_d_rsb_rowsum, psb_d_rsb_colsum, d_rsb_get_nz_row, psb_d_rsb_reinit, psb_d_rsb_mold.
the colsum and rowsum operations were implemented brand new today in rsb.
psblas3-type-indexed
Michele Martone 14 years ago
parent 437966fb4e
commit c1c9273de8

@ -20,9 +20,9 @@ module psb_d_rsb_mat_mod
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) :: rowsum => psb_d_rsb_rowsum
procedure, pass(a) :: arwsum => psb_d_rsb_arwsum
! procedure, pass(a) :: colsum => psb_d_rsb_colsum
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
@ -38,12 +38,12 @@ module psb_d_rsb_mat_mod
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) :: 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) :: 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
@ -253,5 +253,70 @@ subroutine psb_d_rsb_cssm(alpha,a,x,beta,y,info,trans)
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
subroutine psb_d_rsb_rowsum(d,a)
use psb_sparse_mod
class(psb_d_rsb_sparse_mat), intent(in) :: a
real(psb_dpk_), intent(out) :: d(:)
integer :: info
info=d_rsb_to_psb_info(rsb_rows_sums(a%rsbmptr,d))
end subroutine psb_d_rsb_rowsum
subroutine psb_d_rsb_colsum(d,a)
use psb_sparse_mod
class(psb_d_rsb_sparse_mat), intent(in) :: a
real(psb_dpk_), intent(out) :: d(:)
integer :: info
info=d_rsb_to_psb_info(rsb_columns_sums(a%rsbmptr,d))
end subroutine psb_d_rsb_colsum
subroutine psb_d_rsb_mold(a,b,info)
use psb_sparse_mod
implicit none
class(psb_d_rsb_sparse_mat), intent(in) :: a
class(psb_d_base_sparse_mat), intent(out), allocatable :: b
integer, intent(out) :: info
Integer :: err_act
character(len=20) :: name='reallocate_nz'
logical, parameter :: debug=.false.
call psb_get_erraction(err_act)
allocate(psb_d_rsb_sparse_mat :: b, stat=info)
if (info /= psb_success_) then
info = psb_err_alloc_dealloc_
call psb_errpush(info, name)
goto 9999
end if
return
9999 continue
if (err_act /= psb_act_ret_) then
call psb_error()
end if
return
end subroutine psb_d_rsb_mold
subroutine psb_d_rsb_reinit(a,clear)
implicit none
class(psb_d_rsb_sparse_mat), intent(inout) :: a
logical, intent(in), optional :: clear
Integer :: info
info=d_rsb_to_psb_info(rsb_reinit(a%rsbmptr))
end subroutine psb_d_rsb_reinit
function d_rsb_get_nz_row(idx,a) result(res)
implicit none
class(psb_d_rsb_sparse_mat), intent(in) :: a
integer, intent(in) :: idx
integer :: res
integer :: info
res=0
res=rsb_get_rows_nnz(a%rsbmptr,idx-1,idx-1,info)
info=d_rsb_to_psb_info(info)
if(info.ne.0.0)res=0
end function d_rsb_get_nz_row
#endif
end module psb_d_rsb_mat_mod

@ -46,7 +46,7 @@ use iso_c_binding
integer(c_int), value :: Mb
integer(c_int), value :: Kb
integer(c_int), value :: flags
type(c_ptr), value :: errvalp
integer(c_int) :: errvalp
end function rsb_allocate_rsb_sparse_matrix_const
end interface
@ -224,6 +224,28 @@ use iso_c_binding
end function rsb_one_norm
end interface
interface
integer(c_int) function &
&rsb_rows_sums&
&(matrix,d)&
&bind(c,name='rsb_rows_sums')
use iso_c_binding
type(c_ptr), value :: matrix
real(c_double) :: d(*)
end function rsb_rows_sums
end interface
interface
integer(c_int) function &
&rsb_columns_sums&
&(matrix,d)&
&bind(c,name='rsb_columns_sums')
use iso_c_binding
type(c_ptr), value :: matrix
real(c_double) :: d(*)
end function rsb_columns_sums
end interface
interface
integer(c_int) function &
&rsb_absolute_rows_sums&
@ -388,7 +410,7 @@ use iso_c_binding
type(c_ptr), value :: matrixb
real(c_double) :: betap
integer(c_int), value :: transb
type(c_ptr), value :: errvalp
integer(c_int) :: errvalp
end function rsb_matrix_sum
end interface
@ -404,7 +426,7 @@ use iso_c_binding
type(c_ptr), value :: matrixb
real(c_double) :: betap
integer(c_int), value :: transb
type(c_ptr), value :: errvalp
integer(c_int) :: errvalp
end function rsb_matrix_mul
end interface
@ -577,7 +599,7 @@ use iso_c_binding
type(c_ptr), value :: matrix
integer(c_int), value :: fr
integer(c_int), value :: lr
type(c_ptr), value :: errvalp
integer(c_int) :: errvalp
end function rsb_get_rows_nnz
end interface
@ -736,7 +758,7 @@ type(c_ptr) function &
&bind(c,name='rsb_load_matrix_file_as_binary')
use iso_c_binding
type(c_ptr), value :: filename
type(c_ptr), value :: errvalp
integer(c_int) :: errvalp
end function rsb_load_matrix_file_as_binary
end interface
@ -771,7 +793,7 @@ use iso_c_binding
type(c_ptr), value :: filename
integer(c_int), value :: flags
integer(c_int), value :: typecode
type(c_ptr), value :: errvalp
integer(c_int) :: errvalp
end function rsb_load_matrix_file_as_matrix_market
end interface
end module rsb_mod

Loading…
Cancel
Save