updated the rsb modules: original for rsb revision 1297 and interface. not sure if this compiles :^)

psblas3-type-indexed
Michele Martone 14 years ago
parent 105cdcc1dd
commit aa1e01c812

@ -22,12 +22,12 @@ module psb_d_rsb_mat_mod
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 =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 ..
integer :: c_srt_flags =4 ! flags if rsb input is row major sorted ..
integer :: c_own_flags =2 ! flags if rsb input shall not be freed by rsb
integer :: c_upd_flags =c_f_index ! flags for when updating the assembled rsb matrix
type, extends(psb_d_base_sparse_mat) :: psb_d_rsb_sparse_mat
#ifdef HAVE_LIBRSB
type(c_ptr) :: rsbmptr
type(c_ptr) :: rsbmptr=c_null_ptr
contains
procedure, pass(a) :: get_size => d_rsb_get_size
procedure, pass(a) :: get_nzeros => d_rsb_get_nzeros
@ -73,7 +73,7 @@ module psb_d_rsb_mat_mod
generic, public :: mv_from => psb_d_rsb_mv_from
#endif
end type
end type psb_d_rsb_sparse_mat
! FIXME: complete the following
!private :: d_rsb_get_nzeros, d_rsb_get_fmt
private :: d_rsb_to_psb_info
@ -377,7 +377,7 @@ subroutine psb_d_rsb_reinit(a,clear)
logical, intent(in), optional :: clear
Integer :: info
PSBRSB_DEBUG('')
info=d_rsb_to_psb_info(rsb_reinit(a%rsbmptr))
info=d_rsb_to_psb_info(rsb_reinit_matrix(a%rsbmptr))
end subroutine psb_d_rsb_reinit
@ -475,15 +475,17 @@ subroutine psb_d_cp_rsb_from_coo(a,b,info)
logical :: rwshr_
Integer :: nza, nr, i,j,irw, idl,err_act, nc
integer :: debug_level, debug_unit
integer :: flags=c_def_flags
character(len=20) :: name
PSBRSB_DEBUG('')
info = psb_success_
! This is to have fix_coo called behind the scenes
if(b%is_sorted()) flags=flags+c_srt_flags
!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)
&(b%val,b%ia,b%ja,b%get_nzeros(),c_d_typecode,b%get_nrows(),b%get_ncols(),1,1,flags,info)
info=d_rsb_to_psb_info(info)
! FIXME: should destroy tmp ?
end subroutine psb_d_cp_rsb_from_coo
@ -712,6 +714,7 @@ subroutine psb_d_mv_rsb_from_fmt(a,b,info)
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
!if(b%is_sorted()) flags=flags+c_srt_flags
type(psb_d_coo_sparse_mat) :: tmp
PSBRSB_DEBUG('')
info = psb_success_
@ -730,6 +733,7 @@ subroutine psb_d_mv_rsb_from_coo(a,b,info)
integer, intent(out) :: info
PSBRSB_DEBUG('')
! FIXME: should use rsb_allocate_rsb_sparse_matrix_inplace
!if(b%is_sorted()) flags=flags+c_srt_flags
call a%cp_from_coo(b,info)
call b%free()
end subroutine psb_d_mv_rsb_from_coo

@ -3,15 +3,36 @@ module rsb_mod
! module constants:
interface
integer(c_int) function &
&rsb_perror&
&(errval)&
&bind(c,name='rsb_perror')
use iso_c_binding
integer(c_int), value :: errval
end function rsb_perror
end interface
interface
integer(c_int) function &
&rsb_init&
&()&
&(io)&
&bind(c,name='rsb_init')
use iso_c_binding
type(c_ptr), value :: io
end function rsb_init
end interface
interface
integer(c_int) function &
&rsb_reinit&
&(io)&
&bind(c,name='rsb_reinit')
use iso_c_binding
type(c_ptr), value :: io
end function rsb_reinit
end interface
interface
integer(c_int) function &
&rsb_was_initialized&
@ -30,6 +51,24 @@ use iso_c_binding
end function rsb_exit
end interface
interface
integer(c_int) function &
&rsb_meminfo&
&()&
&bind(c,name='rsb_meminfo')
use iso_c_binding
end function rsb_meminfo
end interface
interface
integer(c_int) function &
&rsb_check_leak&
&()&
&bind(c,name='rsb_check_leak')
use iso_c_binding
end function rsb_check_leak
end interface
interface
type(c_ptr) function &
&rsb_allocate_rsb_sparse_matrix_from_csr_const&
@ -110,26 +149,6 @@ use iso_c_binding
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&
@ -150,34 +169,6 @@ use iso_c_binding
end function rsb_clone
end interface
interface
integer(c_int) function &
&rsb_mark_matrix_with_type_flags&
&(matrix)&
&bind(c,name='rsb_mark_matrix_with_type_flags')
use iso_c_binding
type(c_ptr), value :: matrix
end function rsb_mark_matrix_with_type_flags
end interface
interface
integer(c_int) function &
&rsb_meminfo&
&()&
&bind(c,name='rsb_meminfo')
use iso_c_binding
end function rsb_meminfo
end interface
interface
integer(c_int) function &
&rsb_check_leak&
&()&
&bind(c,name='rsb_check_leak')
use iso_c_binding
end function rsb_check_leak
end interface
interface
integer(c_int) function &
&rsb_spmv&
@ -195,91 +186,6 @@ use iso_c_binding
end function rsb_spmv
end interface
interface
integer(c_int) function &
&rsb_spmv_aa&
&(matrix,x,y,transa)&
&bind(c,name='rsb_spmv_aa')
use iso_c_binding
type(c_ptr), value :: matrix
real(c_double) :: x(*)
real(c_double) :: y(*)
integer(c_int), value :: transa
end function rsb_spmv_aa
end interface
interface
integer(c_int) function &
&rsb_spmv_sa&
&(matrix,x,y,alphap,transa)&
&bind(c,name='rsb_spmv_sa')
use iso_c_binding
type(c_ptr), value :: matrix
real(c_double) :: x(*)
real(c_double) :: y(*)
real(c_double) :: alphap
integer(c_int), value :: transa
end function rsb_spmv_sa
end interface
interface
integer(c_int) function &
&rsb_spmv_unua&
&(matrix,x,y,transa)&
&bind(c,name='rsb_spmv_unua')
use iso_c_binding
type(c_ptr), value :: matrix
real(c_double) :: x(*)
real(c_double) :: y(*)
integer(c_int), value :: transa
end function rsb_spmv_unua
end interface
interface
integer(c_int) function &
&rsb_spmv_az&
&(matrix,x,y,transa)&
&bind(c,name='rsb_spmv_az')
use iso_c_binding
type(c_ptr), value :: matrix
real(c_double) :: x(*)
real(c_double) :: y(*)
integer(c_int), value :: transa
end function rsb_spmv_az
end interface
interface
integer(c_int) function &
&rsb_spmv_uxux&
&(matrix,x,y,alphap,betap,transa)&
&bind(c,name='rsb_spmv_uxux')
use iso_c_binding
type(c_ptr), value :: matrix
real(c_double) :: x(*)
real(c_double) :: y(*)
real(c_double) :: alphap
real(c_double) :: betap
integer(c_int), value :: transa
end function rsb_spmv_uxux
end interface
interface
integer(c_int) function &
&rsb_spmv_sxsx&
&(matrix,x,y,alphap,betap,transa,incx,incy)&
&bind(c,name='rsb_spmv_sxsx')
use iso_c_binding
type(c_ptr), value :: matrix
real(c_double) :: x(*)
real(c_double) :: y(*)
real(c_double) :: alphap
real(c_double) :: betap
integer(c_int), value :: transa
integer(c_int), value :: incx
integer(c_int), value :: incy
end function rsb_spmv_sxsx
end interface
interface
integer(c_int) function &
&rsb_infinity_norm&
@ -364,60 +270,6 @@ use iso_c_binding
end function rsb_spsv
end interface
interface
integer(c_int) function &
&rsb_spmm_az&
&(matrix,mrhs,mout,bstride,cstride,nrhs,transa)&
&bind(c,name='rsb_spmm_az')
use iso_c_binding
type(c_ptr), value :: matrix
type(c_ptr), value :: mrhs
type(c_ptr), value :: mout
integer(c_int), value :: bstride
integer(c_int), value :: cstride
integer(c_int), value :: nrhs
integer(c_int), value :: transa
end function rsb_spmm_az
end interface
interface
integer(c_int) function &
&rsb_spmm_sxsx&
&(matrix,b,c,ldb,ldc,nrhs,transa,alphap,betap,order)&
&bind(c,name='rsb_spmm_sxsx')
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_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&
@ -435,38 +287,6 @@ use iso_c_binding
end function rsb_spsm
end interface
interface
type(c_ptr) function &
&rsb_matrix_sum&
&(matrixa,alphap,transa,matrixb,betap,transb,errvalp)&
&bind(c,name='rsb_matrix_sum')
use iso_c_binding
type(c_ptr), value :: matrixa
real(c_double) :: alphap
integer(c_int), value :: transa
type(c_ptr), value :: matrixb
real(c_double) :: betap
integer(c_int), value :: transb
integer(c_int) :: errvalp
end function rsb_matrix_sum
end interface
interface
type(c_ptr) function &
&rsb_matrix_mul&
&(matrixa,alphap,transa,matrixb,betap,transb,errvalp)&
&bind(c,name='rsb_matrix_mul')
use iso_c_binding
type(c_ptr), value :: matrixa
real(c_double) :: alphap
integer(c_int), value :: transa
type(c_ptr), value :: matrixb
real(c_double) :: betap
integer(c_int), value :: transb
integer(c_int) :: errvalp
end function rsb_matrix_mul
end interface
interface
integer(c_int) function &
&rsb_matrix_add_to_dense&
@ -484,39 +304,6 @@ use iso_c_binding
end function rsb_matrix_add_to_dense
end interface
interface
integer(c_int) function &
&rsb_negation&
&(matrix)&
&bind(c,name='rsb_negation')
use iso_c_binding
type(c_ptr), value :: matrix
end function rsb_negation
end interface
interface
integer(c_int) function &
&rsb_scal&
&(matrix,d,transa)&
&bind(c,name='rsb_scal')
use iso_c_binding
type(c_ptr), value :: matrix
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_util_sort_row_major&
@ -555,9 +342,9 @@ end interface
interface
integer(c_int) function &
&rsb_util_sort_csc&
&rsb_util_sort_column_major&
&(VA,IA,JA,nnz,m,k,typecode,flags)&
&bind(c,name='rsb_util_sort_csc')
&bind(c,name='rsb_util_sort_column_major')
use iso_c_binding
real(c_double) :: VA(*)
integer(c_int) :: IA(*)
@ -567,7 +354,7 @@ use iso_c_binding
integer(c_int), value :: k
integer(c_int), value :: typecode
integer(c_int), value :: flags
end function rsb_util_sort_csc
end function rsb_util_sort_column_major
end interface
interface
@ -591,42 +378,44 @@ end interface
interface
integer(c_int) function &
&rsb_cest&
&(IA,JA,nnz,typecode,m,k,p_r,p_c,M_b,K_b,flags)&
&bind(c,name='rsb_cest')
&rsb_switch_rsb_matrix_to_coo_unsorted&
&(matrix,VA,IA,JA,flags)&
&bind(c,name='rsb_switch_rsb_matrix_to_coo_unsorted')
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 :: typecode
integer(c_int), value :: m
integer(c_int), value :: k
type(c_ptr), value :: p_r
type(c_ptr), value :: p_c
integer(c_int), value :: M_b
integer(c_int), value :: K_b
integer(c_int), value :: flags
end function rsb_cest
end function rsb_switch_rsb_matrix_to_coo_unsorted
end interface
interface
integer(c_int) function &
&rsb_perror&
&(errval)&
&bind(c,name='rsb_perror')
&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
integer(c_int), value :: errval
end function rsb_perror
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_coo_sorted
end interface
interface
integer(c_int) function &
&rsb_sizeof&
&(matrix)&
&bind(c,name='rsb_sizeof')
&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
end function rsb_sizeof
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
@ -657,16 +446,6 @@ use iso_c_binding
end function rsb_get_csr
end interface
interface
integer(c_int) function &
&rsb_reinit&
&(matrix)&
&bind(c,name='rsb_reinit')
use iso_c_binding
type(c_ptr), value :: matrix
end function rsb_reinit
end interface
interface
integer(c_int) function &
&rsb_getdiag&
@ -678,36 +457,6 @@ use iso_c_binding
end function rsb_getdiag
end interface
interface
integer(c_int) function &
&rsb_get_rows_nnz&
&(matrix,fr,lr,flags,errvalp)&
&bind(c,name='rsb_get_rows_nnz')
use iso_c_binding
type(c_ptr), value :: matrix
integer(c_int), value :: fr
integer(c_int), value :: lr
integer(c_int), value :: flags
integer(c_int) :: errvalp
end function rsb_get_rows_nnz
end interface
interface
integer(c_int) function &
&rsb_get_block_nnz&
&(matrix,fr,lr,fc,lc,flags,errvalp)&
&bind(c,name='rsb_get_block_nnz')
use iso_c_binding
type(c_ptr), value :: matrix
integer(c_int), value :: fr
integer(c_int), value :: lr
integer(c_int), value :: fc
integer(c_int), value :: lc
integer(c_int), value :: flags
integer(c_int) :: errvalp
end function rsb_get_block_nnz
end interface
interface
integer(c_int) function &
&rsb_get_rows_sparse&
@ -785,63 +534,103 @@ end interface
interface
integer(c_int) function &
&rsb_assign&
&(new_matrix,matrix)&
&bind(c,name='rsb_assign')
&rsb_get_matrix_nnz&
&(matrix)&
&bind(c,name='rsb_get_matrix_nnz')
use iso_c_binding
type(c_ptr), value :: new_matrix
type(c_ptr), value :: matrix
end function rsb_assign
end function rsb_get_matrix_nnz
end interface
interface
integer(c_int) function &
&rsb_transpose&
&(matrixp)&
&bind(c,name='rsb_transpose')
&rsb_get_matrix_n_rows&
&(matrix)&
&bind(c,name='rsb_get_matrix_n_rows')
use iso_c_binding
type(c_ptr), value :: matrixp
end function rsb_transpose
type(c_ptr), value :: matrix
end function rsb_get_matrix_n_rows
end interface
interface
integer(c_int) function &
&rsb_htranspose&
&(matrixp)&
&bind(c,name='rsb_htranspose')
&rsb_get_matrix_n_columns&
&(matrix)&
&bind(c,name='rsb_get_matrix_n_columns')
use iso_c_binding
type(c_ptr), value :: matrixp
end function rsb_htranspose
type(c_ptr), value :: matrix
end function rsb_get_matrix_n_columns
end interface
interface
integer(c_int) function &
&rsb_get_matrix_nnz&
&rsb_sizeof&
&(matrix)&
&bind(c,name='rsb_get_matrix_nnz')
&bind(c,name='rsb_sizeof')
use iso_c_binding
type(c_ptr), value :: matrix
end function rsb_get_matrix_nnz
end function rsb_sizeof
end interface
interface
integer(c_int) function &
&rsb_get_matrix_n_rows&
&(matrix)&
&bind(c,name='rsb_get_matrix_n_rows')
&rsb_get_block_nnz&
&(matrix,fr,lr,fc,lc,flags,errvalp)&
&bind(c,name='rsb_get_block_nnz')
use iso_c_binding
type(c_ptr), value :: matrix
end function rsb_get_matrix_n_rows
integer(c_int), value :: fr
integer(c_int), value :: lr
integer(c_int), value :: fc
integer(c_int), value :: lc
integer(c_int), value :: flags
integer(c_int) :: errvalp
end function rsb_get_block_nnz
end interface
interface
integer(c_int) function &
&rsb_get_matrix_n_columns&
&(matrix)&
&bind(c,name='rsb_get_matrix_n_columns')
&rsb_get_rows_nnz&
&(matrix,fr,lr,flags,errvalp)&
&bind(c,name='rsb_get_rows_nnz')
use iso_c_binding
type(c_ptr), value :: matrix
end function rsb_get_matrix_n_columns
integer(c_int), value :: fr
integer(c_int), value :: lr
integer(c_int), value :: flags
integer(c_int) :: errvalp
end function rsb_get_rows_nnz
end interface
interface
integer(c_int) function &
&rsb_assign&
&(new_matrix,matrix)&
&bind(c,name='rsb_assign')
use iso_c_binding
type(c_ptr), value :: new_matrix
type(c_ptr), value :: matrix
end function rsb_assign
end interface
interface
integer(c_int) function &
&rsb_transpose&
&(matrixp)&
&bind(c,name='rsb_transpose')
use iso_c_binding
type(c_ptr), value :: matrixp
end function rsb_transpose
end interface
interface
integer(c_int) function &
&rsb_htranspose&
&(matrixp)&
&bind(c,name='rsb_htranspose')
use iso_c_binding
type(c_ptr), value :: matrixp
end function rsb_htranspose
end interface
interface
@ -892,32 +681,79 @@ use iso_c_binding
end function rsb_update_elements
end interface
interface
type(c_ptr) function &
&rsb_matrix_sum&
&(matrixa,alphap,transa,matrixb,betap,transb,errvalp)&
&bind(c,name='rsb_matrix_sum')
use iso_c_binding
type(c_ptr), value :: matrixa
real(c_double) :: alphap
integer(c_int), value :: transa
type(c_ptr), value :: matrixb
real(c_double) :: betap
integer(c_int), value :: transb
integer(c_int) :: errvalp
end function rsb_matrix_sum
end interface
interface
type(c_ptr) function &
&rsb_matrix_mul&
&(matrixa,alphap,transa,matrixb,betap,transb,errvalp)&
&bind(c,name='rsb_matrix_mul')
use iso_c_binding
type(c_ptr), value :: matrixa
real(c_double) :: alphap
integer(c_int), value :: transa
type(c_ptr), value :: matrixb
real(c_double) :: betap
integer(c_int), value :: transb
integer(c_int) :: errvalp
end function rsb_matrix_mul
end interface
interface
integer(c_int) function &
&rsb_switch_rsb_matrix_to_coo_sorted&
&(matrix,VA,IA,JA,flags)&
&bind(c,name='rsb_switch_rsb_matrix_to_coo_sorted')
&rsb_negation&
&(matrix)&
&bind(c,name='rsb_negation')
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_coo_sorted
end function rsb_negation
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')
&rsb_scal&
&(matrix,d,transa)&
&bind(c,name='rsb_scal')
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
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_reinit_matrix&
&(matrix)&
&bind(c,name='rsb_reinit_matrix')
use iso_c_binding
type(c_ptr), value :: matrix
end function rsb_reinit_matrix
end interface
interface
@ -950,28 +786,6 @@ use iso_c_binding
end function rsb_print_matrix_unsorted_coo
end interface
interface
type(c_ptr) function &
&rsb_load_matrix_file_as_binary&
&(filename,errvalp)&
&bind(c,name='rsb_load_matrix_file_as_binary')
use iso_c_binding
type(c_ptr), value :: filename
integer(c_int) :: errvalp
end function rsb_load_matrix_file_as_binary
end interface
interface
integer(c_int) function &
&rsb_save_matrix_file_as_binary&
&(matrix,filename)&
&bind(c,name='rsb_save_matrix_file_as_binary')
use iso_c_binding
type(c_ptr), value :: matrix
type(c_ptr), value :: filename
end function rsb_save_matrix_file_as_binary
end interface
interface
integer(c_int) function &
&rsb_save_matrix_file_as_matrix_market&

Loading…
Cancel
Save