fdurastante
/
psblas3
mirror of https://github.com/sfilippone/psblas3.git
1
0
Fork 0
Code Issues Packages Projects Releases Wiki Activity

psblas3:

Browse Source 
changing flags and interface to rsb revision 1282; now using smarter constructors.
psblas3-type-indexed
Michele Martone 14 years ago
parent 66bbb878d7
commit 46da91cdc7
2 changed files with 209 additions and 62 deletions
Show Stats Download Patch File Download Diff File

19
test/serial/psb_d_rsb_mat_mod.F03
Unescape Escape View File

@ -19,9 +19,11 @@ module psb_d_rsb_mat_mod
#define PSBRSB_DEBUG(MSG) #define PSBRSB_DEBUG(MSG)
#endif #endif
integer :: c_f_order=2 ! FIXME: here should use RSB_FLAG_WANT_COLUMN_MAJOR_ORDER 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_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 .. integer :: c_upd_flags =0 ! FIXME: here should use ..
type, extends(psb_d_base_sparse_mat) :: psb_d_rsb_sparse_mat type, extends(psb_d_base_sparse_mat) :: psb_d_rsb_sparse_mat
#ifdef HAVE_LIBRSB #ifdef HAVE_LIBRSB
@ -246,7 +248,7 @@ function psb_d_rsb_csnmi(a) result(res)
real(psb_dpk_),target :: res real(psb_dpk_),target :: res
real(psb_dpk_) :: resa(1) real(psb_dpk_) :: resa(1)
integer :: info 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,resa,rsb_psblas_trans_to_rsb_trans('N'))
!info=rsb_infinity_norm(a%rsbmptr,c_loc(res),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) res=resa(1)
@ -479,6 +481,7 @@ subroutine psb_d_cp_rsb_from_coo(a,b,info)
info = psb_success_ info = psb_success_
! This is to have fix_coo called behind the scenes ! This is to have fix_coo called behind the scenes
!write (*,*) b%val !write (*,*) b%val
! FIXME: and if sorted ? the process could be speeded up !
a%rsbmptr=rsb_allocate_rsb_sparse_matrix_const& 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,c_def_flags,info)
info=d_rsb_to_psb_info(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) type is (psb_d_coo_sparse_mat)
call a%cp_from_coo(b,info) 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) type is (psb_d_rsb_sparse_mat)
call b%cp_to_fmt(a,info) ! FIXME call b%cp_to_fmt(a,info) ! FIXME
! FIXME: missing error handling ! 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 class(psb_d_coo_sparse_mat), intent(inout) :: b
integer, intent(out) :: info integer, intent(out) :: info
PSBRSB_DEBUG('') PSBRSB_DEBUG('')
! FIXME: use rsb_switch_rsb_matrix_to_coo_sorted !
call psb_d_cp_rsb_to_coo(a,b,info) call psb_d_cp_rsb_to_coo(a,b,info)
call a%free() call a%free()
end subroutine psb_d_mv_rsb_to_coo 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 class(psb_d_base_sparse_mat), intent(inout) :: b
integer, intent(out) :: info integer, intent(out) :: info
PSBRSB_DEBUG('') PSBRSB_DEBUG('')
! FIXME: could use here rsb_switch_rsb_matrix_to_csr_sorted
call psb_d_cp_rsb_to_fmt(a,b,info) call psb_d_cp_rsb_to_fmt(a,b,info)
call d_rsb_free(a) call d_rsb_free(a)
a%rsbmptr=c_null_ptr
end subroutine psb_d_mv_rsb_to_fmt end subroutine psb_d_mv_rsb_to_fmt
subroutine psb_d_mv_rsb_from_fmt(a,b,info) 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_rsb_sparse_mat), intent(inout) :: a
class(psb_d_base_sparse_mat), intent(inout) :: b class(psb_d_base_sparse_mat), intent(inout) :: b
integer, intent(out) :: info integer, intent(out) :: info
! FIXME: could use here rsb_allocate_rsb_sparse_matrix_from_csr_inplace
type(psb_d_coo_sparse_mat) :: tmp type(psb_d_coo_sparse_mat) :: tmp
PSBRSB_DEBUG('') PSBRSB_DEBUG('')
info = psb_success_ 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 class(psb_d_coo_sparse_mat), intent(inout) :: b
integer, intent(out) :: info integer, intent(out) :: info
PSBRSB_DEBUG('') PSBRSB_DEBUG('')
! FIXME: should use rsb_allocate_rsb_sparse_matrix_inplace
call a%cp_from_coo(b,info) call a%cp_from_coo(b,info)
call b%free() call b%free()
end subroutine psb_d_mv_rsb_from_coo end subroutine psb_d_mv_rsb_from_coo

252
test/serial/rsb_mod.f03
Unescape Escape View File

@ -30,6 +30,46 @@ use iso_c_binding
end function rsb_exit end function rsb_exit
end interface 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 interface
type(c_ptr) function & type(c_ptr) function &
&rsb_allocate_rsb_sparse_matrix_const& &rsb_allocate_rsb_sparse_matrix_const&
@ -50,6 +90,46 @@ use iso_c_binding
end function rsb_allocate_rsb_sparse_matrix_const end function rsb_allocate_rsb_sparse_matrix_const
end interface 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 interface
type(c_ptr) function & type(c_ptr) function &
&rsb_free_sparse_matrix& &rsb_free_sparse_matrix&
@ -437,6 +517,78 @@ use iso_c_binding
end function rsb_scale_rows end function rsb_scale_rows
end interface 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 interface
integer(c_int) function & integer(c_int) function &
&rsb_cest& &rsb_cest&
@ -491,6 +643,20 @@ use iso_c_binding
end function rsb_get_coo end function rsb_get_coo
end interface 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 interface
integer(c_int) function & integer(c_int) function &
&rsb_reinit& &rsb_reinit&
@ -512,42 +678,6 @@ use iso_c_binding
end function rsb_getdiag end function rsb_getdiag
end interface 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 interface
integer(c_int) function & integer(c_int) function &
&rsb_get_rows_nnz& &rsb_get_rows_nnz&
@ -664,33 +794,23 @@ use iso_c_binding
end function rsb_assign end function rsb_assign
end interface 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 interface
integer(c_int) function & integer(c_int) function &
&rsb_transpose& &rsb_transpose&
&(matrix)& &(matrixp)&
&bind(c,name='rsb_transpose') &bind(c,name='rsb_transpose')
use iso_c_binding use iso_c_binding
type(c_ptr), value :: matrix type(c_ptr), value :: matrixp
end function rsb_transpose end function rsb_transpose
end interface end interface
interface interface
integer(c_int) function & integer(c_int) function &
&rsb_htranspose& &rsb_htranspose&
&(matrix)& &(matrixp)&
&bind(c,name='rsb_htranspose') &bind(c,name='rsb_htranspose')
use iso_c_binding use iso_c_binding
type(c_ptr), value :: matrix type(c_ptr), value :: matrixp
end function rsb_htranspose end function rsb_htranspose
end interface end interface
@ -759,31 +879,45 @@ end interface
interface interface
integer(c_int) function & integer(c_int) function &
&rsb_set_elements& &rsb_update_elements&
&(matrix,VA,IA,JA,nnz)& &(matrix,VA,IA,JA,nnz,flags)&
&bind(c,name='rsb_set_elements') &bind(c,name='rsb_update_elements')
use iso_c_binding use iso_c_binding
type(c_ptr), value :: matrix type(c_ptr), value :: matrix
real(c_double) :: VA(*) real(c_double) :: VA(*)
integer(c_int) :: IA(*) integer(c_int) :: IA(*)
integer(c_int) :: JA(*) integer(c_int) :: JA(*)
integer(c_int), value :: nnz integer(c_int), value :: nnz
end function rsb_set_elements integer(c_int), value :: flags
end function rsb_update_elements
end interface end interface
interface interface
integer(c_int) function & integer(c_int) function &
&rsb_update_elements& &rsb_switch_rsb_matrix_to_coo_sorted&
&(matrix,VA,IA,JA,nnz,flags)& &(matrix,VA,IA,JA,flags)&
&bind(c,name='rsb_update_elements') &bind(c,name='rsb_switch_rsb_matrix_to_coo_sorted')
use iso_c_binding use iso_c_binding
type(c_ptr), value :: matrix type(c_ptr), value :: matrix
real(c_double) :: VA(*) real(c_double) :: VA(*)
integer(c_int) :: IA(*) integer(c_int) :: IA(*)
integer(c_int) :: JA(*) integer(c_int) :: JA(*)
integer(c_int), value :: nnz
integer(c_int), value :: flags 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 end interface
interface interface

Write Preview
Loading…
Cancel
Save