diff --git a/test/serial/psb_d_rsb_mat_mod.F03 b/test/serial/psb_d_rsb_mat_mod.F03 index 85d25dc3..bc81c53c 100644 --- a/test/serial/psb_d_rsb_mat_mod.F03 +++ b/test/serial/psb_d_rsb_mat_mod.F03 @@ -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 diff --git a/test/serial/rsb_mod.f03 b/test/serial/rsb_mod.f03 index e6e4e571..1b357d38 100644 --- a/test/serial/rsb_mod.f03 +++ b/test/serial/rsb_mod.f03 @@ -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