psblas3:

changing flags and interface to rsb revision 1282; now using smarter constructors.

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

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