diff --git a/test/serial/psb_d_rsb_mat_mod.F03 b/test/serial/psb_d_rsb_mat_mod.F03 index 157fd955..bef99f44 100644 --- a/test/serial/psb_d_rsb_mat_mod.F03 +++ b/test/serial/psb_d_rsb_mat_mod.F03 @@ -19,9 +19,11 @@ module psb_d_rsb_mat_mod #define PSBRSB_DEBUG(MSG) #endif integer :: c_f_order=2 ! FIXME: here should use RSB_FLAG_WANT_COLUMN_MAJOR_ORDER - integer,parameter :: c_f_index=256*16 ! 0x001000 ! FIXME: here should use RSB_FLAG_FORTRAN_INDICES_INTERFACE + integer,parameter :: c_f_index=1 ! 0x001000 ! FIXME: here should use RSB_FLAG_FORTRAN_INDICES_INTERFACE integer,parameter :: c_d_typecode=68 ! FIXME: here should use .. - integer,parameter :: c_def_flags =-2080358268+c_f_index ! FIXME: here should use .. + integer,parameter :: c_def_flags =c_f_index ! FIXME: here should use .. + integer :: c_srt_flags =4 ! FIXME: here should use .. + integer :: c_own_flags =2 ! FIXME: here should use .. integer :: c_upd_flags =0 ! FIXME: here should use .. type, extends(psb_d_base_sparse_mat) :: psb_d_rsb_sparse_mat #ifdef HAVE_LIBRSB @@ -246,7 +248,7 @@ function psb_d_rsb_csnmi(a) result(res) real(psb_dpk_),target :: res real(psb_dpk_) :: resa(1) integer :: info - PSBRSB_DEBUG('') + !PSBRSB_DEBUG('') info=rsb_infinity_norm(a%rsbmptr,resa,rsb_psblas_trans_to_rsb_trans('N')) !info=rsb_infinity_norm(a%rsbmptr,c_loc(res),rsb_psblas_trans_to_rsb_trans('N')) res=resa(1) @@ -479,6 +481,7 @@ subroutine psb_d_cp_rsb_from_coo(a,b,info) info = psb_success_ ! This is to have fix_coo called behind the scenes !write (*,*) b%val + ! FIXME: and if sorted ? the process could be speeded up ! a%rsbmptr=rsb_allocate_rsb_sparse_matrix_const& &(b%val,b%ia,b%ja,b%get_nzeros(),c_d_typecode,b%get_nrows(),b%get_ncols(),1,1,c_def_flags,info) info=d_rsb_to_psb_info(info) @@ -507,6 +510,11 @@ subroutine psb_d_cp_rsb_from_fmt(a,b,info) type is (psb_d_coo_sparse_mat) call a%cp_from_coo(b,info) + type is (psb_d_csr_sparse_mat) + a%rsbmptr=rsb_allocate_rsb_sparse_matrix_from_csr_const& + &(b%val,b%irp,b%ja,b%get_nzeros(),c_d_typecode,b%get_nrows(),b%get_ncols(),1,1,c_def_flags+c_srt_flags,info) + info=d_rsb_to_psb_info(info) + type is (psb_d_rsb_sparse_mat) call b%cp_to_fmt(a,info) ! FIXME ! FIXME: missing error handling @@ -681,6 +689,7 @@ subroutine psb_d_mv_rsb_to_coo(a,b,info) class(psb_d_coo_sparse_mat), intent(inout) :: b integer, intent(out) :: info PSBRSB_DEBUG('') + ! FIXME: use rsb_switch_rsb_matrix_to_coo_sorted ! call psb_d_cp_rsb_to_coo(a,b,info) call a%free() end subroutine psb_d_mv_rsb_to_coo @@ -690,8 +699,10 @@ end subroutine psb_d_mv_rsb_to_coo class(psb_d_base_sparse_mat), intent(inout) :: b integer, intent(out) :: info PSBRSB_DEBUG('') + ! FIXME: could use here rsb_switch_rsb_matrix_to_csr_sorted call psb_d_cp_rsb_to_fmt(a,b,info) call d_rsb_free(a) + a%rsbmptr=c_null_ptr end subroutine psb_d_mv_rsb_to_fmt subroutine psb_d_mv_rsb_from_fmt(a,b,info) @@ -700,6 +711,7 @@ subroutine psb_d_mv_rsb_from_fmt(a,b,info) class(psb_d_rsb_sparse_mat), intent(inout) :: a class(psb_d_base_sparse_mat), intent(inout) :: b integer, intent(out) :: info + ! FIXME: could use here rsb_allocate_rsb_sparse_matrix_from_csr_inplace type(psb_d_coo_sparse_mat) :: tmp PSBRSB_DEBUG('') info = psb_success_ @@ -717,6 +729,7 @@ subroutine psb_d_mv_rsb_from_coo(a,b,info) class(psb_d_coo_sparse_mat), intent(inout) :: b integer, intent(out) :: info PSBRSB_DEBUG('') + ! FIXME: should use rsb_allocate_rsb_sparse_matrix_inplace call a%cp_from_coo(b,info) call b%free() end subroutine psb_d_mv_rsb_from_coo diff --git a/test/serial/rsb_mod.f03 b/test/serial/rsb_mod.f03 index f29751ff..425326c8 100644 --- a/test/serial/rsb_mod.f03 +++ b/test/serial/rsb_mod.f03 @@ -30,6 +30,46 @@ use iso_c_binding end function rsb_exit end interface +interface +type(c_ptr) function & + &rsb_allocate_rsb_sparse_matrix_from_csr_const& + &(VAc,IAc,JAc,nnz,typecode,m,k,Mb,Kb,flags,errvalp)& + &bind(c,name='rsb_allocate_rsb_sparse_matrix_from_csr_const') +use iso_c_binding + 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 + integer(c_int), value :: k + integer(c_int), value :: Mb + integer(c_int), value :: Kb + integer(c_int), value :: flags + integer(c_int) :: errvalp + end function rsb_allocate_rsb_sparse_matrix_from_csr_const +end interface + +interface +type(c_ptr) function & + &rsb_allocate_rsb_sparse_matrix_from_csr_inplace& + &(VA,IA,JA,nnz,typecode,m,k,Mb,Kb,flags,errvalp)& + &bind(c,name='rsb_allocate_rsb_sparse_matrix_from_csr_inplace') +use iso_c_binding + real(c_double) :: VA(*) + integer(c_int) :: IA(*) + integer(c_int) :: JA(*) + integer(c_int), value :: nnz + integer(c_int), value :: typecode + integer(c_int), value :: m + integer(c_int), value :: k + integer(c_int), value :: Mb + integer(c_int), value :: Kb + integer(c_int), value :: flags + integer(c_int) :: errvalp + end function rsb_allocate_rsb_sparse_matrix_from_csr_inplace +end interface + interface type(c_ptr) function & &rsb_allocate_rsb_sparse_matrix_const& @@ -50,6 +90,46 @@ use iso_c_binding end function rsb_allocate_rsb_sparse_matrix_const end interface +interface +type(c_ptr) function & + &rsb_allocate_rsb_sparse_matrix_inplace& + &(VA,IA,JA,nnz,typecode,m,k,Mb,Kb,flags,errvalp)& + &bind(c,name='rsb_allocate_rsb_sparse_matrix_inplace') +use iso_c_binding + real(c_double) :: VA(*) + integer(c_int) :: IA(*) + integer(c_int) :: JA(*) + integer(c_int), value :: nnz + integer(c_int), value :: typecode + integer(c_int), value :: m + integer(c_int), value :: k + integer(c_int), value :: Mb + integer(c_int), value :: Kb + integer(c_int), value :: flags + integer(c_int) :: errvalp + end function rsb_allocate_rsb_sparse_matrix_inplace +end interface + +interface +integer(c_int) function & + &rsb_do_cleanup_nnz& + &(VA,IA,JA,nnz,roff,coff,m,k,onnzp,typecode,flags)& + &bind(c,name='rsb_do_cleanup_nnz') +use iso_c_binding + real(c_double) :: VA(*) + integer(c_int) :: IA(*) + integer(c_int) :: JA(*) + integer(c_int), value :: nnz + integer(c_int), value :: roff + integer(c_int), value :: coff + integer(c_int), value :: m + integer(c_int), value :: k + type(c_ptr), value :: onnzp + integer(c_int), value :: typecode + integer(c_int), value :: flags + end function rsb_do_cleanup_nnz +end interface + interface type(c_ptr) function & &rsb_free_sparse_matrix& @@ -437,6 +517,78 @@ use iso_c_binding end function rsb_scale_rows end interface +interface +integer(c_int) function & + &rsb_util_sort_row_major& + &(VA,IA,JA,nnz,m,k,typecode,flags)& + &bind(c,name='rsb_util_sort_row_major') +use iso_c_binding + real(c_double) :: VA(*) + integer(c_int) :: IA(*) + integer(c_int) :: JA(*) + integer(c_int), value :: nnz + integer(c_int), value :: m + integer(c_int), value :: k + integer(c_int), value :: typecode + integer(c_int), value :: flags + end function rsb_util_sort_row_major +end interface + +interface +integer(c_int) function & + &rsb_util_sort_row_major_buffered& + &(VA,IA,JA,nnz,m,k,typecode,flags,WA,wb)& + &bind(c,name='rsb_util_sort_row_major_buffered') +use iso_c_binding + real(c_double) :: VA(*) + integer(c_int) :: IA(*) + integer(c_int) :: JA(*) + integer(c_int), value :: nnz + integer(c_int), value :: m + integer(c_int), value :: k + integer(c_int), value :: typecode + integer(c_int), value :: flags + type(c_ptr), value :: WA + integer(c_int), value :: wb + end function rsb_util_sort_row_major_buffered +end interface + +interface +integer(c_int) function & + &rsb_util_sort_csc& + &(VA,IA,JA,nnz,m,k,typecode,flags)& + &bind(c,name='rsb_util_sort_csc') +use iso_c_binding + real(c_double) :: VA(*) + integer(c_int) :: IA(*) + integer(c_int) :: JA(*) + integer(c_int), value :: nnz + integer(c_int), value :: m + integer(c_int), value :: k + integer(c_int), value :: typecode + integer(c_int), value :: flags + end function rsb_util_sort_csc +end interface + +interface +integer(c_int) function & + &rsb_util_sortcoo& + &(VA,IA,JA,nnz,typecode,M_b,K_b,rpntr,cpntr,flags)& + &bind(c,name='rsb_util_sortcoo') +use iso_c_binding + real(c_double) :: VA(*) + integer(c_int) :: IA(*) + integer(c_int) :: JA(*) + integer(c_int), value :: nnz + integer(c_int), value :: typecode + integer(c_int), value :: M_b + integer(c_int), value :: K_b + type(c_ptr), value :: rpntr + type(c_ptr), value :: cpntr + integer(c_int), value :: flags + end function rsb_util_sortcoo +end interface + interface integer(c_int) function & &rsb_cest& @@ -491,6 +643,20 @@ use iso_c_binding end function rsb_get_coo end interface +interface +integer(c_int) function & + &rsb_get_csr& + &(matrix,VA,RP,JA,flags)& + &bind(c,name='rsb_get_csr') +use iso_c_binding + type(c_ptr), value :: matrix + real(c_double) :: VA(*) + type(c_ptr), value :: RP + integer(c_int) :: JA(*) + integer(c_int), value :: flags + end function rsb_get_csr +end interface + interface integer(c_int) function & &rsb_reinit& @@ -512,42 +678,6 @@ use iso_c_binding end function rsb_getdiag end interface -interface -integer(c_int) function & - &rsb_get_sub_diag& - &(matrix,diagonal,loffset)& - &bind(c,name='rsb_get_sub_diag') -use iso_c_binding - type(c_ptr), value :: matrix - real(c_double) :: diagonal(*) - integer(c_int), value :: loffset - end function rsb_get_sub_diag -end interface - -interface -integer(c_int) function & - &rsb_get_supra_diag& - &(matrix,diagonal,uoffset)& - &bind(c,name='rsb_get_supra_diag') -use iso_c_binding - type(c_ptr), value :: matrix - real(c_double) :: diagonal(*) - integer(c_int), value :: uoffset - end function rsb_get_supra_diag -end interface - -interface -integer(c_int) function & - &rsb_get_row_dense& - &(matrix,row,i)& - &bind(c,name='rsb_get_row_dense') -use iso_c_binding - type(c_ptr), value :: matrix - type(c_ptr), value :: row - integer(c_int), value :: i - end function rsb_get_row_dense -end interface - interface integer(c_int) function & &rsb_get_rows_nnz& @@ -664,33 +794,23 @@ use iso_c_binding end function rsb_assign end interface -interface -integer(c_int) function & - &rsb_sym_transpose& - &(matrix)& - &bind(c,name='rsb_sym_transpose') -use iso_c_binding - type(c_ptr), value :: matrix - end function rsb_sym_transpose -end interface - interface integer(c_int) function & &rsb_transpose& - &(matrix)& + &(matrixp)& &bind(c,name='rsb_transpose') use iso_c_binding - type(c_ptr), value :: matrix + type(c_ptr), value :: matrixp end function rsb_transpose end interface interface integer(c_int) function & &rsb_htranspose& - &(matrix)& + &(matrixp)& &bind(c,name='rsb_htranspose') use iso_c_binding - type(c_ptr), value :: matrix + type(c_ptr), value :: matrixp end function rsb_htranspose end interface @@ -759,31 +879,45 @@ end interface interface integer(c_int) function & - &rsb_set_elements& - &(matrix,VA,IA,JA,nnz)& - &bind(c,name='rsb_set_elements') + &rsb_update_elements& + &(matrix,VA,IA,JA,nnz,flags)& + &bind(c,name='rsb_update_elements') use iso_c_binding type(c_ptr), value :: matrix real(c_double) :: VA(*) integer(c_int) :: IA(*) integer(c_int) :: JA(*) integer(c_int), value :: nnz - end function rsb_set_elements + integer(c_int), value :: flags + end function rsb_update_elements end interface interface integer(c_int) function & - &rsb_update_elements& - &(matrix,VA,IA,JA,nnz,flags)& - &bind(c,name='rsb_update_elements') + &rsb_switch_rsb_matrix_to_coo_sorted& + &(matrix,VA,IA,JA,flags)& + &bind(c,name='rsb_switch_rsb_matrix_to_coo_sorted') use iso_c_binding type(c_ptr), value :: matrix real(c_double) :: VA(*) integer(c_int) :: IA(*) integer(c_int) :: JA(*) - integer(c_int), value :: nnz integer(c_int), value :: flags - end function rsb_update_elements + end function rsb_switch_rsb_matrix_to_coo_sorted +end interface + +interface +integer(c_int) function & + &rsb_switch_rsb_matrix_to_csr_sorted& + &(matrix,VA,IA,JA,flags)& + &bind(c,name='rsb_switch_rsb_matrix_to_csr_sorted') +use iso_c_binding + type(c_ptr), value :: matrix + real(c_double) :: VA(*) + integer(c_int) :: IA(*) + integer(c_int) :: JA(*) + integer(c_int), value :: flags + end function rsb_switch_rsb_matrix_to_csr_sorted end interface interface