psblas3-trunk:
updating the rsb interface code with S (single precision floating point) and C (single precision complex) BLAS types, by modifying the code cloning code in the Makefile (and versioning).psblas3-type-indexed
Michele Martone
14 years ago
parent
5de0060ec9
commit
eb44238091
@ -0,0 +1,962 @@
|
||||
!
|
||||
!
|
||||
! FIXME/TODO:
|
||||
! * some RSB constants are used in their value form, and with no explanation
|
||||
! * error handling
|
||||
! * PSBLAS interface adherence
|
||||
! * should test and fix all the problems that for sure will occur
|
||||
! * duplicate handling is not defined
|
||||
! * the printing function is not complete
|
||||
! * should substitute -1 with another valid PSBLAS error code
|
||||
! * ..
|
||||
!
|
||||
module psb_c_rsb_mat_mod
|
||||
use psb_c_base_mat_mod
|
||||
use rsb_c_mod
|
||||
#ifdef HAVE_LIBRSB
|
||||
use iso_c_binding
|
||||
#endif
|
||||
#if 0
|
||||
#define PSBRSB_DEBUG(MSG) write(*,*) __FILE__,':',__LINE__,':',MSG
|
||||
#define PSBRSB_ERROR(MSG) write(*,*) __FILE__,':',__LINE__,':'," ERROR: ",MSG
|
||||
#define PSBRSB_WARNING(MSG) write(*,*) __FILE__,':',__LINE__,':'," WARNING: ",MSG
|
||||
#else
|
||||
#define PSBRSB_DEBUG(MSG)
|
||||
#define PSBRSB_ERROR(MSG)
|
||||
#define PSBRSB_WARNING(MSG)
|
||||
#endif
|
||||
integer, parameter :: c_d_typecode=68 ! FIXME: this is only valid for 'double'
|
||||
integer, parameter :: c_for_flags=1 ! : here should use RSB_FLAG_FORTRAN_INDICES_INTERFACE
|
||||
integer, parameter :: c_srt_flags =4 ! flags if rsb input is row major sorted ..
|
||||
!integer, parameter :: c_own_flags =-1 ! flags if rsb input shall not be freed by rsb
|
||||
integer, parameter :: c_tri_flags =8 ! flags for specifying a triangle
|
||||
integer, parameter :: c_low_flags =16 ! flags for specifying a lower triangle/symmetry
|
||||
integer, parameter :: c_upp_flags =32 ! flags for specifying a lower triangle/symmetry
|
||||
integer, parameter :: c_idi_flags =64 ! flags for specifying diagonal implicit
|
||||
integer, parameter :: c_def_flags =c_for_flags ! FIXME: here should use ..
|
||||
integer :: c_f_order=c_for_flags ! FIXME: here should use RSB_FLAG_WANT_COLUMN_MAJOR_ORDER
|
||||
integer, parameter :: c_upd_flags =c_for_flags ! flags for when updating the assembled rsb matrix
|
||||
integer, parameter :: c_psbrsb_err_ =psb_err_internal_error_
|
||||
type, extends(psb_c_base_sparse_mat) :: psb_c_rsb_sparse_mat
|
||||
#ifdef HAVE_LIBRSB
|
||||
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
|
||||
procedure, pass(a) :: get_ncols => d_rsb_get_ncols
|
||||
procedure, pass(a) :: get_nrows => d_rsb_get_nrows
|
||||
procedure, nopass :: get_fmt => d_rsb_get_fmt
|
||||
procedure, pass(a) :: sizeof => d_rsb_sizeof
|
||||
procedure, pass(a) :: d_csmm => psb_c_rsb_csmm
|
||||
!procedure, pass(a) :: d_csmv_nt => psb_c_rsb_csmv_nt ! FIXME: a placeholder for future memory
|
||||
procedure, pass(a) :: d_csmv => psb_c_rsb_csmv
|
||||
procedure, pass(a) :: d_inner_cssm => psb_c_rsb_cssm
|
||||
procedure, pass(a) :: d_inner_cssv => psb_c_rsb_cssv
|
||||
procedure, pass(a) :: d_scals => psb_c_rsb_scals
|
||||
procedure, pass(a) :: d_scal => psb_c_rsb_scal
|
||||
procedure, pass(a) :: csnmi => psb_c_rsb_csnmi
|
||||
procedure, pass(a) :: csnm1 => psb_c_rsb_csnm1
|
||||
procedure, pass(a) :: rowsum => psb_c_rsb_rowsum
|
||||
procedure, pass(a) :: arwsum => psb_c_rsb_arwsum
|
||||
procedure, pass(a) :: colsum => psb_c_rsb_colsum
|
||||
procedure, pass(a) :: aclsum => psb_c_rsb_aclsum
|
||||
! procedure, pass(a) :: reallocate_nz => psb_c_rsb_reallocate_nz ! FIXME
|
||||
! procedure, pass(a) :: allocate_mnnz => psb_c_rsb_allocate_mnnz ! FIXME
|
||||
procedure, pass(a) :: cp_to_coo => psb_c_cp_rsb_to_coo
|
||||
procedure, pass(a) :: cp_from_coo => psb_c_cp_rsb_from_coo
|
||||
procedure, pass(a) :: cp_to_fmt => psb_c_cp_rsb_to_fmt
|
||||
procedure, pass(a) :: cp_from_fmt => psb_c_cp_rsb_from_fmt
|
||||
procedure, pass(a) :: mv_to_coo => psb_c_mv_rsb_to_coo
|
||||
procedure, pass(a) :: mv_from_coo => psb_c_mv_rsb_from_coo
|
||||
procedure, pass(a) :: mv_to_fmt => psb_c_mv_rsb_to_fmt
|
||||
procedure, pass(a) :: mv_from_fmt => psb_c_mv_rsb_from_fmt
|
||||
procedure, pass(a) :: csput => psb_c_rsb_csput
|
||||
procedure, pass(a) :: get_diag => psb_c_rsb_get_diag
|
||||
procedure, pass(a) :: csgetptn => psb_c_rsb_csgetptn
|
||||
procedure, pass(a) :: d_csgetrow => psb_c_rsb_csgetrow
|
||||
procedure, pass(a) :: get_nz_row => d_rsb_get_nz_row
|
||||
procedure, pass(a) :: reinit => psb_c_rsb_reinit
|
||||
procedure, pass(a) :: trim => psb_c_rsb_trim ! evil
|
||||
procedure, pass(a) :: print => psb_c_rsb_print
|
||||
procedure, pass(a) :: free => d_rsb_free
|
||||
procedure, pass(a) :: mold => psb_c_rsb_mold
|
||||
procedure, pass(a) :: psb_c_rsb_cp_from
|
||||
generic, public :: cp_from => psb_c_rsb_cp_from
|
||||
procedure, pass(a) :: psb_c_rsb_mv_from
|
||||
generic, public :: mv_from => psb_c_rsb_mv_from
|
||||
|
||||
#endif
|
||||
end type psb_c_rsb_sparse_mat
|
||||
! FIXME: complete the following
|
||||
!private :: d_rsb_get_nzeros, d_rsb_get_fmt
|
||||
private :: d_rsb_to_psb_info
|
||||
#ifdef HAVE_LIBRSB
|
||||
contains
|
||||
|
||||
function psb_rsb_matmod_init() result(res)
|
||||
implicit none
|
||||
integer :: res
|
||||
!PSBRSB_DEBUG('')
|
||||
res=-1 ! FIXME
|
||||
#ifdef HAVE_LIBRSB
|
||||
res=d_rsb_to_psb_info(rsb_init(c_null_ptr))
|
||||
#endif
|
||||
end function psb_rsb_matmod_init
|
||||
|
||||
function psb_rsb_matmod_exit() result(res)
|
||||
implicit none
|
||||
integer :: res
|
||||
!PSBRSB_DEBUG('')
|
||||
res=-1 ! FIXME
|
||||
#ifdef HAVE_LIBRSB
|
||||
res=d_rsb_to_psb_info(rsb_exit())
|
||||
#endif
|
||||
end function psb_rsb_matmod_exit
|
||||
|
||||
function d_rsb_to_psb_info(info) result(res)
|
||||
implicit none
|
||||
integer , intent(in) :: info
|
||||
integer :: res
|
||||
!PSBRSB_DEBUG('')
|
||||
if(info.ne.0)then
|
||||
res=-1
|
||||
else
|
||||
res=psb_success_
|
||||
end if
|
||||
end function d_rsb_to_psb_info
|
||||
|
||||
function d_rsb_get_flags(a) result(flags)
|
||||
implicit none
|
||||
integer :: flags
|
||||
class(psb_c_base_sparse_mat), intent(in) :: a
|
||||
!PSBRSB_DEBUG('')
|
||||
flags=c_def_flags
|
||||
if(a%is_sorted()) flags=flags+c_srt_flags
|
||||
if(a%is_triangle()) flags=flags+c_tri_flags
|
||||
if(a%is_upper()) flags=flags+c_upp_flags
|
||||
if(a%is_unit()) flags=flags+c_idi_flags
|
||||
if(a%is_lower()) flags=flags+c_low_flags
|
||||
end function d_rsb_get_flags
|
||||
|
||||
function d_rsb_get_nzeros(a) result(res)
|
||||
implicit none
|
||||
class(psb_c_rsb_sparse_mat), intent(in) :: a
|
||||
integer :: res
|
||||
!PSBRSB_DEBUG('')
|
||||
res=rsb_get_matrix_nnz(a%rsbmptr)
|
||||
end function d_rsb_get_nzeros
|
||||
|
||||
function d_rsb_get_nrows(a) result(res)
|
||||
implicit none
|
||||
class(psb_c_rsb_sparse_mat), intent(in) :: a
|
||||
integer :: res
|
||||
!PSBRSB_DEBUG('')
|
||||
res=rsb_get_matrix_n_rows(a%rsbmptr)
|
||||
end function d_rsb_get_nrows
|
||||
|
||||
function d_rsb_get_ncols(a) result(res)
|
||||
implicit none
|
||||
class(psb_c_rsb_sparse_mat), intent(in) :: a
|
||||
integer :: res
|
||||
!PSBRSB_DEBUG('')
|
||||
res=rsb_get_matrix_n_columns(a%rsbmptr)
|
||||
end function d_rsb_get_ncols
|
||||
|
||||
function d_rsb_get_fmt() result(res)
|
||||
implicit none
|
||||
character(len=5) :: res
|
||||
!the following printout is harmful, here, if happening during a write :) (causes a deadlock)
|
||||
!PSBRSB_DEBUG('')
|
||||
res = 'RSB'
|
||||
end function d_rsb_get_fmt
|
||||
|
||||
function d_rsb_get_size(a) result(res)
|
||||
implicit none
|
||||
class(psb_c_rsb_sparse_mat), intent(in) :: a
|
||||
integer :: res
|
||||
!PSBRSB_DEBUG('')
|
||||
res = d_rsb_get_nzeros(a)
|
||||
end function d_rsb_get_size
|
||||
|
||||
function d_rsb_sizeof(a) result(res)
|
||||
implicit none
|
||||
class(psb_c_rsb_sparse_mat), intent(in) :: a
|
||||
integer(psb_long_int_k_) :: res
|
||||
!PSBRSB_DEBUG('')
|
||||
res=rsb_sizeof(a%rsbmptr)
|
||||
end function d_rsb_sizeof
|
||||
|
||||
subroutine psb_c_rsb_csmv(alpha,a,x,beta,y,info,trans)
|
||||
implicit none
|
||||
class(psb_c_rsb_sparse_mat), intent(in) :: a
|
||||
complex(psb_spk_), intent(in) :: alpha, beta, x(:)
|
||||
complex(psb_spk_), intent(inout) :: y(:)
|
||||
integer, intent(out) :: info
|
||||
character, optional, intent(in) :: trans
|
||||
character :: trans_
|
||||
! PSBRSB_DEBUG('')
|
||||
info = psb_success_
|
||||
|
||||
if (present(trans)) then
|
||||
trans_ = trans
|
||||
else
|
||||
trans_ = 'N'
|
||||
end if
|
||||
info=d_rsb_to_psb_info(rsb_spmv(rsb_psblas_trans_to_rsb_trans(trans_),alpha,a%rsbmptr,x,1,beta,y,1))
|
||||
end subroutine psb_c_rsb_csmv
|
||||
|
||||
subroutine psb_c_rsb_csmv_nt(alpha,a,x1,x2,beta,y1,y2,info)
|
||||
! FIXME: this routine is here as a placeholder for a specialized implementation of
|
||||
! joint spmv and spmv transposed.
|
||||
implicit none
|
||||
class(psb_c_rsb_sparse_mat), intent(in) :: a
|
||||
complex(psb_spk_), intent(in) :: alpha, beta, x1(:), x2(:)
|
||||
complex(psb_spk_), intent(inout) :: y1(:), y2(:)
|
||||
integer, intent(out) :: info
|
||||
! PSBRSB_DEBUG('')
|
||||
info = psb_success_
|
||||
info=d_rsb_to_psb_info(rsb_spmv_nt(alpha,a%rsbmptr,x1,x2,1,beta,y1,y2,1))
|
||||
return
|
||||
end subroutine psb_c_rsb_csmv_nt
|
||||
|
||||
subroutine psb_c_rsb_cssv(alpha,a,x,beta,y,info,trans)
|
||||
use psb_error_mod
|
||||
! FIXME: and what when x is an alias of y ?
|
||||
! FIXME: ignoring beta
|
||||
implicit none
|
||||
class(psb_c_rsb_sparse_mat), intent(in) :: a
|
||||
complex(psb_spk_), intent(in) :: alpha, beta, x(:)
|
||||
complex(psb_spk_), intent(inout) :: y(:)
|
||||
integer, intent(out) :: info
|
||||
character, optional, intent(in) :: trans
|
||||
character :: trans_
|
||||
Integer :: err_act, i
|
||||
character(len=20) :: name='rsb_cssv'
|
||||
logical, parameter :: debug=.false.
|
||||
|
||||
info = psb_success_
|
||||
call psb_erractionsave(err_act)
|
||||
|
||||
! PSBRSB_DEBUG('')
|
||||
|
||||
if (present(trans)) then
|
||||
trans_ = trans
|
||||
else
|
||||
trans_ = 'N'
|
||||
end if
|
||||
info=d_rsb_to_psb_info(rsb_spsv(rsb_psblas_trans_to_rsb_trans(trans_),alpha,a%rsbmptr,x,1,y,1))
|
||||
if (info /= 0) then
|
||||
i = info
|
||||
info = psb_err_from_subroutine_ai_
|
||||
call psb_errpush(info,name,&
|
||||
& i_err=(/i,0,0,0,0/),a_err="rsb_spsv")
|
||||
goto 9999
|
||||
end if
|
||||
call psb_erractionrestore(err_act)
|
||||
return
|
||||
|
||||
9999 continue
|
||||
call psb_erractionrestore(err_act)
|
||||
|
||||
if (err_act == psb_act_abort_) then
|
||||
PSBRSB_ERROR("!")
|
||||
call psb_error()
|
||||
return
|
||||
end if
|
||||
return
|
||||
|
||||
end subroutine psb_c_rsb_cssv
|
||||
|
||||
subroutine psb_c_rsb_scals(d,a,info)
|
||||
use psb_base_mod
|
||||
implicit none
|
||||
class(psb_c_rsb_sparse_mat), intent(inout) :: a
|
||||
complex(psb_spk_), intent(in) :: d
|
||||
integer, intent(out) :: info
|
||||
PSBRSB_DEBUG('')
|
||||
info=d_rsb_to_psb_info(rsb_elemental_scale(a%rsbmptr,d))
|
||||
end subroutine psb_c_rsb_scals
|
||||
|
||||
subroutine psb_c_rsb_scal(d,a,info)
|
||||
use psb_base_mod
|
||||
implicit none
|
||||
class(psb_c_rsb_sparse_mat), intent(inout) :: a
|
||||
complex(psb_spk_), intent(in) :: d(:)
|
||||
integer, intent(out) :: info
|
||||
PSBRSB_DEBUG('')
|
||||
info=d_rsb_to_psb_info(rsb_scale_rows(a%rsbmptr,d))
|
||||
end subroutine psb_c_rsb_scal
|
||||
|
||||
subroutine d_rsb_free(a)
|
||||
implicit none
|
||||
class(psb_c_rsb_sparse_mat), intent(inout) :: a
|
||||
type(c_ptr) :: dummy
|
||||
!PSBRSB_DEBUG('freeing RSB matrix')
|
||||
dummy=rsb_free_sparse_matrix(a%rsbmptr)
|
||||
end subroutine d_rsb_free
|
||||
|
||||
subroutine psb_c_rsb_trim(a)
|
||||
implicit none
|
||||
class(psb_c_rsb_sparse_mat), intent(inout) :: a
|
||||
!PSBRSB_DEBUG('')
|
||||
! FIXME: this is supposed to remain empty for RSB
|
||||
end subroutine psb_c_rsb_trim
|
||||
|
||||
subroutine psb_c_rsb_print(iout,a,iv,eirs,eics,head,ivr,ivc)
|
||||
integer, intent(in) :: iout
|
||||
class(psb_c_rsb_sparse_mat), intent(in) :: a
|
||||
integer, intent(in), optional :: iv(:)
|
||||
integer, intent(in), optional :: eirs,eics
|
||||
character(len=*), optional :: head
|
||||
integer, intent(in), optional :: ivr(:), ivc(:)
|
||||
integer :: info
|
||||
PSBRSB_DEBUG('')
|
||||
! FIXME: UNFINISHED
|
||||
info=rsb_print_matrix_t(a%rsbmptr)
|
||||
end subroutine psb_c_rsb_print
|
||||
|
||||
subroutine psb_c_rsb_get_diag(a,d,info)
|
||||
class(psb_c_rsb_sparse_mat), intent(in) :: a
|
||||
complex(psb_spk_), intent(out) :: d(:)
|
||||
integer, intent(out) :: info
|
||||
!PSBRSB_DEBUG('')
|
||||
info=rsb_getdiag(a%rsbmptr,d)
|
||||
end subroutine psb_c_rsb_get_diag
|
||||
|
||||
function psb_c_rsb_csnmi(a) result(csnmi_res)
|
||||
implicit none
|
||||
class(psb_c_rsb_sparse_mat), intent(in) :: a
|
||||
real(psb_spk_),target :: csnmi_res ! please DO NOT rename this variable (see the Makefile)
|
||||
complex(psb_spk_) :: resa(1)
|
||||
integer :: info
|
||||
!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'))
|
||||
csnmi_res=resa(1)
|
||||
end function psb_c_rsb_csnmi
|
||||
|
||||
function psb_c_rsb_csnm1(a) result(res)
|
||||
implicit none
|
||||
class(psb_c_rsb_sparse_mat), intent(in) :: a
|
||||
complex(psb_spk_) :: res
|
||||
complex(psb_spk_) :: resa(1)
|
||||
integer :: info
|
||||
PSBRSB_DEBUG('')
|
||||
info=rsb_one_norm(a%rsbmptr,resa,rsb_psblas_trans_to_rsb_trans('N'))
|
||||
!info=rsb_one_norm(a%rsbmptr,res,rsb_psblas_trans_to_rsb_trans('N'))
|
||||
end function psb_c_rsb_csnm1
|
||||
|
||||
subroutine psb_c_rsb_aclsum(d,a)
|
||||
use psb_base_mod
|
||||
class(psb_c_rsb_sparse_mat), intent(in) :: a
|
||||
complex(psb_spk_), intent(out) :: d(:)
|
||||
PSBRSB_DEBUG('')
|
||||
info=rsb_absolute_columns_sums(a%rsbmptr,d)
|
||||
end subroutine psb_c_rsb_aclsum
|
||||
|
||||
subroutine psb_c_rsb_arwsum(d,a)
|
||||
use psb_base_mod
|
||||
class(psb_c_rsb_sparse_mat), intent(in) :: a
|
||||
complex(psb_spk_), intent(out) :: d(:)
|
||||
PSBRSB_DEBUG('')
|
||||
info=rsb_absolute_rows_sums(a%rsbmptr,d)
|
||||
end subroutine psb_c_rsb_arwsum
|
||||
|
||||
subroutine psb_c_rsb_csmm(alpha,a,x,beta,y,info,trans)
|
||||
use psb_base_mod
|
||||
implicit none
|
||||
class(psb_c_rsb_sparse_mat), intent(in) :: a
|
||||
complex(psb_spk_), intent(in) :: alpha, beta, x(:,:)
|
||||
complex(psb_spk_), intent(inout) :: y(:,:)
|
||||
integer, intent(out) :: info
|
||||
character, optional, intent(in) :: trans
|
||||
|
||||
character :: trans_
|
||||
integer :: ldy,ldx,nc
|
||||
PSBRSB_DEBUG('')
|
||||
PSBRSB_DEBUG('ERROR: UNIMPLEMENTED')
|
||||
|
||||
if (present(trans)) then
|
||||
trans_ = trans
|
||||
else
|
||||
trans_ = 'N'
|
||||
end if
|
||||
ldx=size(x,1); ldy=size(y,1)
|
||||
nc=min(size(x,2),size(y,2) )
|
||||
info=-1
|
||||
info=d_rsb_to_psb_info(rsb_spmm(rsb_psblas_trans_to_rsb_trans(trans_),alpha,a%rsbmptr,nc,c_f_order,x,ldx,beta,y,ldy))
|
||||
end subroutine psb_c_rsb_csmm
|
||||
|
||||
subroutine psb_c_rsb_cssm(alpha,a,x,beta,y,info,trans)
|
||||
use psb_base_mod
|
||||
implicit none
|
||||
class(psb_c_rsb_sparse_mat), intent(in) :: a
|
||||
complex(psb_spk_), intent(in) :: alpha, beta, x(:,:)
|
||||
complex(psb_spk_), intent(inout) :: y(:,:)
|
||||
integer, intent(out) :: info
|
||||
character, optional, intent(in) :: trans
|
||||
integer :: ldy,ldx,nc
|
||||
character :: trans_
|
||||
PSBRSB_DEBUG('')
|
||||
PSBRSB_DEBUG('ERROR: UNIMPLEMENTED')
|
||||
if (present(trans)) then
|
||||
trans_ = trans
|
||||
else
|
||||
trans_ = 'N'
|
||||
end if
|
||||
ldx=size(x,1); ldy=size(y,1)
|
||||
nc=min(size(x,2),size(y,2) )
|
||||
info=-1
|
||||
info=d_rsb_to_psb_info(rsb_spsm(rsb_psblas_trans_to_rsb_trans(trans_),alpha,a%rsbmptr,nc,c_f_order,beta,x,ldx,y,ldy))
|
||||
end subroutine
|
||||
|
||||
subroutine psb_c_rsb_rowsum(d,a)
|
||||
use psb_base_mod
|
||||
class(psb_c_rsb_sparse_mat), intent(in) :: a
|
||||
complex(psb_spk_), intent(out) :: d(:)
|
||||
integer :: info
|
||||
PSBRSB_DEBUG('')
|
||||
info=d_rsb_to_psb_info(rsb_rows_sums(a%rsbmptr,d))
|
||||
end subroutine psb_c_rsb_rowsum
|
||||
|
||||
subroutine psb_c_rsb_colsum(d,a)
|
||||
use psb_base_mod
|
||||
class(psb_c_rsb_sparse_mat), intent(in) :: a
|
||||
complex(psb_spk_), intent(out) :: d(:)
|
||||
integer :: info
|
||||
PSBRSB_DEBUG('')
|
||||
info=d_rsb_to_psb_info(rsb_columns_sums(a%rsbmptr,d))
|
||||
end subroutine psb_c_rsb_colsum
|
||||
|
||||
subroutine psb_c_rsb_mold(a,b,info)
|
||||
use psb_base_mod
|
||||
implicit none
|
||||
class(psb_c_rsb_sparse_mat), intent(in) :: a
|
||||
class(psb_c_base_sparse_mat), intent(out), allocatable :: b
|
||||
integer, intent(out) :: info
|
||||
Integer :: err_act
|
||||
character(len=20) :: name='reallocate_nz'
|
||||
logical, parameter :: debug=.false.
|
||||
PSBRSB_DEBUG('')
|
||||
|
||||
call psb_get_erraction(err_act)
|
||||
|
||||
allocate(psb_c_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
|
||||
PSBRSB_ERROR("!")
|
||||
call psb_error()
|
||||
end if
|
||||
return
|
||||
end subroutine psb_c_rsb_mold
|
||||
|
||||
subroutine psb_c_rsb_reinit(a,clear)
|
||||
implicit none
|
||||
class(psb_c_rsb_sparse_mat), intent(inout) :: a
|
||||
logical, intent(in), optional :: clear
|
||||
Integer :: info
|
||||
PSBRSB_DEBUG('')
|
||||
info=d_rsb_to_psb_info(rsb_reinit_matrix(a%rsbmptr))
|
||||
end subroutine psb_c_rsb_reinit
|
||||
|
||||
|
||||
function d_rsb_get_nz_row(idx,a) result(res)
|
||||
implicit none
|
||||
class(psb_c_rsb_sparse_mat), intent(in) :: a
|
||||
integer, intent(in) :: idx
|
||||
integer :: res
|
||||
integer :: info
|
||||
PSBRSB_DEBUG('')
|
||||
res=0
|
||||
res=rsb_get_rows_nnz(a%rsbmptr,idx,idx,c_for_flags,info)
|
||||
info=d_rsb_to_psb_info(info)
|
||||
if(info.ne.0)res=0
|
||||
end function d_rsb_get_nz_row
|
||||
|
||||
subroutine psb_c_cp_rsb_to_coo(a,b,info)
|
||||
implicit none
|
||||
class(psb_c_rsb_sparse_mat), intent(in) :: a
|
||||
class(psb_c_coo_sparse_mat), intent(inout) :: b
|
||||
integer, intent(out) :: info
|
||||
|
||||
integer, allocatable :: itemp(:)
|
||||
!locals
|
||||
logical :: rwshr_
|
||||
Integer :: nza, nr, nc,i,j,irw, idl,err_act
|
||||
integer :: debug_level, debug_unit
|
||||
character(len=20) :: name
|
||||
! PSBRSB_DEBUG('')
|
||||
info = psb_success_
|
||||
nr = a%get_nrows()
|
||||
nc = a%get_ncols()
|
||||
nza = a%get_nzeros()
|
||||
call b%allocate(nr,nc,nza)
|
||||
call b%psb_c_base_sparse_mat%cp_from(a%psb_c_base_sparse_mat)
|
||||
info=d_rsb_to_psb_info(rsb_get_coo(a%rsbmptr,b%val,b%ia,b%ja,c_for_flags))
|
||||
call b%set_nzeros(a%get_nzeros())
|
||||
call b%set_nrows(a%get_nrows())
|
||||
call b%set_ncols(a%get_ncols())
|
||||
call b%fix(info)
|
||||
!write(*,*)b%val
|
||||
!write(*,*)b%ia
|
||||
!write(*,*)b%ja
|
||||
!write(*,*)b%get_nrows()
|
||||
!write(*,*)b%get_ncols()
|
||||
!write(*,*)b%get_nzeros()
|
||||
!write(*,*)a%get_nrows()
|
||||
!write(*,*)a%get_ncols()
|
||||
!write(*,*)a%get_nzeros()
|
||||
end subroutine psb_c_cp_rsb_to_coo
|
||||
|
||||
subroutine psb_c_cp_rsb_to_fmt(a,b,info)
|
||||
use psb_base_mod
|
||||
implicit none
|
||||
|
||||
class(psb_c_rsb_sparse_mat), intent(in) :: a
|
||||
class(psb_c_base_sparse_mat), intent(inout) :: b
|
||||
integer, intent(out) :: info
|
||||
|
||||
!locals
|
||||
type(psb_c_coo_sparse_mat) :: tmp
|
||||
logical :: rwshr_
|
||||
Integer :: nza, nr, i,j,irw, idl,err_act, nc
|
||||
integer :: debug_level, debug_unit
|
||||
character(len=20) :: name
|
||||
PSBRSB_DEBUG('')
|
||||
|
||||
info = psb_success_
|
||||
|
||||
select type (b)
|
||||
type is (psb_c_coo_sparse_mat)
|
||||
call a%cp_to_coo(b,info)
|
||||
|
||||
type is (psb_c_rsb_sparse_mat)
|
||||
call b%psb_c_base_sparse_mat%cp_from(a%psb_c_base_sparse_mat)! FIXME: ?
|
||||
b%rsbmptr=rsb_clone(a%rsbmptr) ! FIXME is thi enough ?
|
||||
! FIXME: error handling needed here
|
||||
|
||||
class default
|
||||
call a%cp_to_coo(tmp,info)
|
||||
if (info == psb_success_) call b%mv_from_coo(tmp,info)
|
||||
end select
|
||||
end subroutine psb_c_cp_rsb_to_fmt
|
||||
|
||||
subroutine psb_c_cp_rsb_from_coo(a,b,info)
|
||||
use psb_base_mod
|
||||
implicit none
|
||||
|
||||
class(psb_c_rsb_sparse_mat), intent(inout) :: a
|
||||
class(psb_c_coo_sparse_mat), intent(in) :: b
|
||||
integer, intent(out) :: info
|
||||
|
||||
integer, allocatable :: itemp(:)
|
||||
!locals
|
||||
logical :: rwshr_
|
||||
Integer :: nza, nr, i,j,irw, idl,err_act, nc
|
||||
integer :: debug_level, debug_unit
|
||||
integer :: flags
|
||||
character(len=20) :: name
|
||||
! PSBRSB_DEBUG('')
|
||||
|
||||
flags=d_rsb_get_flags(b)
|
||||
|
||||
info = psb_success_
|
||||
call a%psb_c_base_sparse_mat%cp_from(b%psb_c_base_sparse_mat)
|
||||
|
||||
!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,flags,info)
|
||||
info=d_rsb_to_psb_info(info)
|
||||
! FIXME: should destroy tmp ?
|
||||
end subroutine psb_c_cp_rsb_from_coo
|
||||
|
||||
subroutine psb_c_cp_rsb_from_fmt(a,b,info)
|
||||
use psb_base_mod
|
||||
implicit none
|
||||
|
||||
class(psb_c_rsb_sparse_mat), intent(inout) :: a
|
||||
class(psb_c_base_sparse_mat), intent(in) :: b
|
||||
integer, intent(out) :: info
|
||||
|
||||
!locals
|
||||
type(psb_c_coo_sparse_mat) :: tmp
|
||||
logical :: rwshr_
|
||||
Integer :: nz, nr, i,j,irw, idl,err_act, nc
|
||||
integer :: debug_level, debug_unit
|
||||
integer :: flags
|
||||
character(len=20) :: name
|
||||
PSBRSB_DEBUG('')
|
||||
|
||||
info = psb_success_
|
||||
flags=d_rsb_get_flags(b)
|
||||
|
||||
select type (b)
|
||||
type is (psb_c_coo_sparse_mat)
|
||||
call a%cp_from_coo(b,info)
|
||||
|
||||
type is (psb_c_csr_sparse_mat)
|
||||
call a%psb_c_base_sparse_mat%cp_from(b%psb_c_base_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,flags,info)
|
||||
info=d_rsb_to_psb_info(info)
|
||||
|
||||
type is (psb_c_rsb_sparse_mat)
|
||||
call b%cp_to_fmt(a,info) ! FIXME
|
||||
! FIXME: missing error handling
|
||||
|
||||
class default
|
||||
call b%cp_to_coo(tmp,info)
|
||||
if (info == psb_success_) call a%mv_from_coo(tmp,info)
|
||||
end select
|
||||
end subroutine psb_c_cp_rsb_from_fmt
|
||||
|
||||
|
||||
subroutine psb_c_rsb_csgetrow(imin,imax,a,nz,ia,ja,val,info,&
|
||||
& jmin,jmax,iren,append,nzin,rscale,cscale)
|
||||
use psb_base_mod
|
||||
implicit none
|
||||
|
||||
class(psb_c_rsb_sparse_mat), intent(in) :: a
|
||||
integer, intent(in) :: imin,imax
|
||||
integer, intent(out) :: nz
|
||||
integer, allocatable, intent(inout) :: ia(:), ja(:)
|
||||
complex(psb_spk_), allocatable, intent(inout) :: val(:)
|
||||
integer,intent(out) :: info
|
||||
logical, intent(in), optional :: append
|
||||
integer, intent(in), optional :: iren(:)
|
||||
integer, intent(in), optional :: jmin,jmax, nzin
|
||||
logical, intent(in), optional :: rscale,cscale
|
||||
|
||||
logical :: append_, rscale_, cscale_
|
||||
integer :: nzin_, jmin_, jmax_, err_act, i, nzrsb
|
||||
character(len=20) :: name='csget'
|
||||
logical, parameter :: debug=.false.
|
||||
! FIXME: MISSING THE HANDLING OF OPTIONS, HERE
|
||||
PSBRSB_DEBUG('')
|
||||
|
||||
call psb_erractionsave(err_act)
|
||||
info = psb_success_
|
||||
|
||||
if (present(jmin)) then
|
||||
jmin_ = jmin
|
||||
else
|
||||
jmin_ = 1
|
||||
endif
|
||||
if (present(jmax)) then
|
||||
jmax_ = jmax
|
||||
else
|
||||
jmax_ = a%get_ncols()
|
||||
endif
|
||||
|
||||
if ((imax<imin).or.(jmax_<jmin_)) then
|
||||
nz = 0
|
||||
!info=c_psbrsb_err_
|
||||
PSBRSB_WARNING("imax < imin ? or jmax < jmin ? !")
|
||||
return
|
||||
end if
|
||||
|
||||
if (present(append)) then
|
||||
append_=append
|
||||
else
|
||||
append_=.false.
|
||||
endif
|
||||
if ((append_).and.(present(nzin))) then
|
||||
nzin_ = nzin
|
||||
else
|
||||
nzin_ = 0
|
||||
endif
|
||||
if (present(rscale)) then
|
||||
rscale_ = rscale
|
||||
else
|
||||
rscale_ = .false.
|
||||
endif
|
||||
if (present(cscale)) then
|
||||
cscale_ = cscale
|
||||
else
|
||||
cscale_ = .false.
|
||||
endif
|
||||
! if ((rscale_.or.cscale_).and.(present(iren))) then
|
||||
! PSBRSB_ERROR("!")
|
||||
! info = psb_err_many_optional_arg_
|
||||
! call psb_errpush(info,name,a_err='iren (rscale.or.cscale)')
|
||||
! goto 9999
|
||||
! end if
|
||||
|
||||
nzrsb = rsb_get_block_nnz(a%rsbmptr,imin,imax,jmin_,jmax_,c_for_flags,info)
|
||||
! FIXME: unfinished; missing error handling ..
|
||||
|
||||
call psb_ensure_size(nzin_+nzrsb,ia,info)
|
||||
if (info == psb_success_) call psb_ensure_size(nzin_+nzrsb,ja,info)
|
||||
if (info == psb_success_) call psb_ensure_size(nzin_+nzrsb,val,info)
|
||||
if (info /= psb_success_)then
|
||||
PSBRSB_ERROR("psb_ensure_size failed !")
|
||||
return
|
||||
endif
|
||||
|
||||
|
||||
info=d_rsb_to_psb_info(rsb_get_block_sparse(a%rsbmptr,&
|
||||
& val(nzin_+1:),imin,imax,jmin_,jmax_,&
|
||||
& ia(nzin_+1:),ja(nzin_+1:),&
|
||||
& c_null_ptr,c_null_ptr,nz,c_for_flags))
|
||||
! FIXME: unfinished; missing error handling ..
|
||||
if (nz /= nzrsb) then
|
||||
info=c_psbrsb_err_
|
||||
PSBRSB_ERROR("Mismatch in output from rsb_getblk")
|
||||
!write(*,*) 'Mismatch in output from rsb_getblk: ',nz,nzrsb
|
||||
end if
|
||||
|
||||
if (rscale_) then
|
||||
do i=nzin_+1, nzin_+nz
|
||||
ia(i) = ia(i) - imin + 1
|
||||
end do
|
||||
end if
|
||||
if (cscale_) then
|
||||
do i=nzin_+1, nzin_+nz
|
||||
ja(i) = ja(i) - jmin_ + 1
|
||||
end do
|
||||
end if
|
||||
|
||||
|
||||
|
||||
9999 continue
|
||||
call psb_erractionrestore(err_act)
|
||||
|
||||
if (err_act == psb_act_abort_) then
|
||||
PSBRSB_ERROR("!")
|
||||
call psb_error()
|
||||
return
|
||||
end if
|
||||
|
||||
end subroutine psb_c_rsb_csgetrow
|
||||
|
||||
subroutine psb_c_rsb_csgetptn(imin,imax,a,nz,ia,ja,info,&
|
||||
& jmin,jmax,iren,append,nzin,rscale,cscale)
|
||||
use psb_base_mod
|
||||
implicit none
|
||||
|
||||
class(psb_c_rsb_sparse_mat), intent(in) :: a
|
||||
integer, intent(in) :: imin,imax
|
||||
integer, intent(out) :: nz
|
||||
integer, allocatable, intent(inout) :: ia(:), ja(:)
|
||||
integer,intent(out) :: info
|
||||
logical, intent(in), optional :: append
|
||||
integer, intent(in), optional :: iren(:)
|
||||
integer, intent(in), optional :: jmin,jmax, nzin
|
||||
logical, intent(in), optional :: rscale,cscale
|
||||
|
||||
logical :: append_, rscale_, cscale_
|
||||
integer :: nzin_, jmin_, jmax_, err_act, i
|
||||
character(len=20) :: name='csget'
|
||||
logical, parameter :: debug=.false.
|
||||
PSBRSB_DEBUG('')
|
||||
|
||||
if (present(iren).or.present(rscale).or.present(cscale)) then
|
||||
! FIXME: error condition
|
||||
PSBRSB_ERROR("unsupported optional arguments!")
|
||||
call psb_error()
|
||||
endif
|
||||
|
||||
if (present(append)) then
|
||||
append_ = append
|
||||
else
|
||||
append_ = .false.
|
||||
endif
|
||||
if (present(append).and.append.and.present(nzin)) then
|
||||
nzin_ = nzin
|
||||
else
|
||||
nzin_ = 0
|
||||
endif
|
||||
|
||||
if (present(jmin)) then
|
||||
jmin_ = jmin
|
||||
else
|
||||
jmin_ = 1
|
||||
endif
|
||||
|
||||
if (present(jmax)) then
|
||||
jmax_ = jmax
|
||||
else
|
||||
jmax_ = a%get_nrows()
|
||||
endif
|
||||
|
||||
if (present(rscale)) then
|
||||
rscale_ = rscale
|
||||
else
|
||||
rscale_ = .false.
|
||||
endif
|
||||
if (present(cscale)) then
|
||||
cscale_ = cscale
|
||||
else
|
||||
cscale_ = .false.
|
||||
endif
|
||||
if ((rscale_.or.cscale_).and.(present(iren))) then
|
||||
info = psb_err_many_optional_arg_
|
||||
call psb_errpush(info,name,a_err='iren (rscale.or.cscale)')
|
||||
goto 9999
|
||||
end if
|
||||
if (present(iren)) then
|
||||
info = c_psbrsb_err_
|
||||
PSBRSB_ERROR("ERROR: the RSB pattern get needs iren support !!")
|
||||
goto 9999
|
||||
end if
|
||||
|
||||
|
||||
!nzt = ..
|
||||
nz = 0
|
||||
|
||||
call psb_ensure_size(nzin_,ia,info)
|
||||
if (info == psb_success_) call psb_ensure_size(nzin_,ja,info)
|
||||
|
||||
if (info /= psb_success_) return
|
||||
nz=rsb_get_block_nnz(a%rsbmptr,imin,imax,jmin_,jmax_,c_for_flags,info)
|
||||
!write(*,*) 'debug:',nzin_,nz,imin,imax,jmin_,jmax_
|
||||
! FIXME: unfinished; missing error handling ..
|
||||
|
||||
call psb_ensure_size(nzin_+nz,ia,info)
|
||||
if (info == psb_success_) call psb_ensure_size(nzin_+nz,ja,info)
|
||||
if (info /= psb_success_)then
|
||||
PSBRSB_ERROR("!")
|
||||
return
|
||||
endif
|
||||
|
||||
info=d_rsb_to_psb_info(rsb_get_block_sparse_pattern&
|
||||
&(a%rsbmptr,imin,imax,jmin_,jmax_,ia,ja,c_null_ptr,c_null_ptr,nzin_,c_for_flags))
|
||||
! FIXME: unfinished; missing error handling ..
|
||||
|
||||
!write(*,*) 'debug:',nzin_,nz,imin,imax,jmin_,jmax_
|
||||
if (rscale_) then
|
||||
do i=nzin_+1, nzin_+nz
|
||||
ia(i) = ia(i) - imin + 1
|
||||
end do
|
||||
end if
|
||||
if (cscale_) then
|
||||
do i=nzin_+1, nzin_+nz
|
||||
ja(i) = ja(i) - jmin_ + 1
|
||||
end do
|
||||
end if
|
||||
|
||||
9999 continue
|
||||
call psb_erractionrestore(err_act)
|
||||
|
||||
if (err_act == psb_act_abort_) then
|
||||
PSBRSB_ERROR("!")
|
||||
call psb_error()
|
||||
return
|
||||
endif
|
||||
|
||||
end subroutine psb_c_rsb_csgetptn
|
||||
|
||||
subroutine psb_c_rsb_csput(nz,ia,ja,val,a,imin,imax,jmin,jmax,info,gtl)
|
||||
use psb_base_mod
|
||||
implicit none
|
||||
|
||||
class(psb_c_rsb_sparse_mat), intent(inout) :: a
|
||||
complex(psb_spk_), intent(in) :: val(:)
|
||||
integer, intent(in) :: nz, ia(:), ja(:), imin,imax,jmin,jmax
|
||||
integer, intent(out) :: info
|
||||
integer, intent(in), optional :: gtl(:)
|
||||
|
||||
|
||||
Integer :: err_act
|
||||
character(len=20) :: name='d_rsb_csput'
|
||||
logical, parameter :: debug=.false.
|
||||
integer :: nza, i,j,k, nzl, isza, int_err(5)
|
||||
PSBRSB_DEBUG('')
|
||||
if(present(gtl))then
|
||||
PSBRSB_ERROR("!")
|
||||
endif
|
||||
info=d_rsb_to_psb_info(rsb_update_elements(a%rsbmptr,val,ia,ja,nz,c_upd_flags))
|
||||
end subroutine psb_c_rsb_csput
|
||||
|
||||
subroutine psb_c_mv_rsb_to_coo(a,b,info)
|
||||
use psb_base_mod
|
||||
implicit none
|
||||
|
||||
class(psb_c_rsb_sparse_mat), intent(inout) :: a
|
||||
class(psb_c_coo_sparse_mat), intent(inout) :: b
|
||||
integer, intent(out) :: info
|
||||
PSBRSB_DEBUG('')
|
||||
! FIXME: use rsb_switch_rsb_matrix_to_coo_sorted !
|
||||
call psb_c_cp_rsb_to_coo(a,b,info)
|
||||
call a%free()
|
||||
end subroutine psb_c_mv_rsb_to_coo
|
||||
|
||||
subroutine psb_c_mv_rsb_to_fmt(a,b,info)
|
||||
class(psb_c_rsb_sparse_mat), intent(inout) :: a
|
||||
class(psb_c_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_c_cp_rsb_to_fmt(a,b,info)
|
||||
call d_rsb_free(a)
|
||||
a%rsbmptr=c_null_ptr
|
||||
end subroutine psb_c_mv_rsb_to_fmt
|
||||
|
||||
subroutine psb_c_mv_rsb_from_fmt(a,b,info)
|
||||
use psb_base_mod
|
||||
implicit none
|
||||
class(psb_c_rsb_sparse_mat), intent(inout) :: a
|
||||
class(psb_c_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_c_coo_sparse_mat) :: tmp
|
||||
! PSBRSB_DEBUG('')
|
||||
info = psb_success_
|
||||
select type (b)
|
||||
class default
|
||||
call b%mv_to_coo(tmp,info)
|
||||
if (info == psb_success_) call a%mv_from_coo(tmp,info)
|
||||
end select
|
||||
end subroutine psb_c_mv_rsb_from_fmt
|
||||
|
||||
subroutine psb_c_mv_rsb_from_coo(a,b,info)
|
||||
use psb_base_mod
|
||||
implicit none
|
||||
class(psb_c_rsb_sparse_mat), intent(inout) :: a
|
||||
class(psb_c_coo_sparse_mat), intent(inout) :: b
|
||||
integer, intent(out) :: info
|
||||
! PSBRSB_DEBUG('')
|
||||
! FIXME: should use rsb_allocate_rsb_sparse_matrix_inplace
|
||||
!if(b%is_sorted()) flags=flags+c_srt_flags
|
||||
!if(b%is_triangle()) flags=flags+c_tri_flags
|
||||
call a%cp_from_coo(b,info)
|
||||
call b%free()
|
||||
end subroutine psb_c_mv_rsb_from_coo
|
||||
|
||||
subroutine psb_c_rsb_cp_from(a,b)
|
||||
use psb_base_mod
|
||||
implicit none
|
||||
class(psb_c_rsb_sparse_mat), intent(inout) :: a
|
||||
type(psb_c_rsb_sparse_mat), intent(in) :: b
|
||||
Integer :: info
|
||||
type(psb_c_coo_sparse_mat) :: tmp
|
||||
PSBRSB_DEBUG('')
|
||||
call b%cp_to_coo(tmp,info)
|
||||
call a%mv_from_coo(tmp,info)
|
||||
call tmp%free()
|
||||
end subroutine psb_c_rsb_cp_from
|
||||
|
||||
subroutine psb_c_rsb_mv_from(a,b)
|
||||
use psb_base_mod
|
||||
implicit none
|
||||
class(psb_c_rsb_sparse_mat), intent(inout) :: a
|
||||
type(psb_c_rsb_sparse_mat), intent(inout) :: b
|
||||
Integer :: info
|
||||
type(psb_c_coo_sparse_mat) :: tmp
|
||||
PSBRSB_DEBUG('')
|
||||
call b%mv_to_coo(tmp,info)
|
||||
call a%mv_from_coo(tmp,info)
|
||||
end subroutine psb_c_rsb_mv_from
|
||||
|
||||
|
||||
#endif
|
||||
end module psb_c_rsb_mat_mod
|
||||
@ -0,0 +1,962 @@
|
||||
!
|
||||
!
|
||||
! FIXME/TODO:
|
||||
! * some RSB constants are used in their value form, and with no explanation
|
||||
! * error handling
|
||||
! * PSBLAS interface adherence
|
||||
! * should test and fix all the problems that for sure will occur
|
||||
! * duplicate handling is not defined
|
||||
! * the printing function is not complete
|
||||
! * should substitute -1 with another valid PSBLAS error code
|
||||
! * ..
|
||||
!
|
||||
module psb_c_rsb_mat_mod
|
||||
use psb_c_base_mat_mod
|
||||
use rsb_c_mod
|
||||
#ifdef HAVE_LIBRSB
|
||||
use iso_c_binding
|
||||
#endif
|
||||
#if 0
|
||||
#define PSBRSB_DEBUG(MSG) write(*,*) __FILE__,':',__LINE__,':',MSG
|
||||
#define PSBRSB_ERROR(MSG) write(*,*) __FILE__,':',__LINE__,':'," ERROR: ",MSG
|
||||
#define PSBRSB_WARNING(MSG) write(*,*) __FILE__,':',__LINE__,':'," WARNING: ",MSG
|
||||
#else
|
||||
#define PSBRSB_DEBUG(MSG)
|
||||
#define PSBRSB_ERROR(MSG)
|
||||
#define PSBRSB_WARNING(MSG)
|
||||
#endif
|
||||
integer, parameter :: c_d_typecode=68 ! FIXME: this is only valid for 'double'
|
||||
integer, parameter :: c_for_flags=1 ! : here should use RSB_FLAG_FORTRAN_INDICES_INTERFACE
|
||||
integer, parameter :: c_srt_flags =4 ! flags if rsb input is row major sorted ..
|
||||
!integer, parameter :: c_own_flags =-1 ! flags if rsb input shall not be freed by rsb
|
||||
integer, parameter :: c_tri_flags =8 ! flags for specifying a triangle
|
||||
integer, parameter :: c_low_flags =16 ! flags for specifying a lower triangle/symmetry
|
||||
integer, parameter :: c_upp_flags =32 ! flags for specifying a lower triangle/symmetry
|
||||
integer, parameter :: c_idi_flags =64 ! flags for specifying diagonal implicit
|
||||
integer, parameter :: c_def_flags =c_for_flags ! FIXME: here should use ..
|
||||
integer :: c_f_order=c_for_flags ! FIXME: here should use RSB_FLAG_WANT_COLUMN_MAJOR_ORDER
|
||||
integer, parameter :: c_upd_flags =c_for_flags ! flags for when updating the assembled rsb matrix
|
||||
integer, parameter :: c_psbrsb_err_ =psb_err_internal_error_
|
||||
type, extends(psb_c_base_sparse_mat) :: psb_c_rsb_sparse_mat
|
||||
#ifdef HAVE_LIBRSB
|
||||
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
|
||||
procedure, pass(a) :: get_ncols => d_rsb_get_ncols
|
||||
procedure, pass(a) :: get_nrows => d_rsb_get_nrows
|
||||
procedure, nopass :: get_fmt => d_rsb_get_fmt
|
||||
procedure, pass(a) :: sizeof => d_rsb_sizeof
|
||||
procedure, pass(a) :: d_csmm => psb_c_rsb_csmm
|
||||
!procedure, pass(a) :: d_csmv_nt => psb_c_rsb_csmv_nt ! FIXME: a placeholder for future memory
|
||||
procedure, pass(a) :: d_csmv => psb_c_rsb_csmv
|
||||
procedure, pass(a) :: d_inner_cssm => psb_c_rsb_cssm
|
||||
procedure, pass(a) :: d_inner_cssv => psb_c_rsb_cssv
|
||||
procedure, pass(a) :: d_scals => psb_c_rsb_scals
|
||||
procedure, pass(a) :: d_scal => psb_c_rsb_scal
|
||||
procedure, pass(a) :: csnmi => psb_c_rsb_csnmi
|
||||
procedure, pass(a) :: csnm1 => psb_c_rsb_csnm1
|
||||
procedure, pass(a) :: rowsum => psb_c_rsb_rowsum
|
||||
procedure, pass(a) :: arwsum => psb_c_rsb_arwsum
|
||||
procedure, pass(a) :: colsum => psb_c_rsb_colsum
|
||||
procedure, pass(a) :: aclsum => psb_c_rsb_aclsum
|
||||
! procedure, pass(a) :: reallocate_nz => psb_c_rsb_reallocate_nz ! FIXME
|
||||
! procedure, pass(a) :: allocate_mnnz => psb_c_rsb_allocate_mnnz ! FIXME
|
||||
procedure, pass(a) :: cp_to_coo => psb_c_cp_rsb_to_coo
|
||||
procedure, pass(a) :: cp_from_coo => psb_c_cp_rsb_from_coo
|
||||
procedure, pass(a) :: cp_to_fmt => psb_c_cp_rsb_to_fmt
|
||||
procedure, pass(a) :: cp_from_fmt => psb_c_cp_rsb_from_fmt
|
||||
procedure, pass(a) :: mv_to_coo => psb_c_mv_rsb_to_coo
|
||||
procedure, pass(a) :: mv_from_coo => psb_c_mv_rsb_from_coo
|
||||
procedure, pass(a) :: mv_to_fmt => psb_c_mv_rsb_to_fmt
|
||||
procedure, pass(a) :: mv_from_fmt => psb_c_mv_rsb_from_fmt
|
||||
procedure, pass(a) :: csput => psb_c_rsb_csput
|
||||
procedure, pass(a) :: get_diag => psb_c_rsb_get_diag
|
||||
procedure, pass(a) :: csgetptn => psb_c_rsb_csgetptn
|
||||
procedure, pass(a) :: d_csgetrow => psb_c_rsb_csgetrow
|
||||
procedure, pass(a) :: get_nz_row => d_rsb_get_nz_row
|
||||
procedure, pass(a) :: reinit => psb_c_rsb_reinit
|
||||
procedure, pass(a) :: trim => psb_c_rsb_trim ! evil
|
||||
procedure, pass(a) :: print => psb_c_rsb_print
|
||||
procedure, pass(a) :: free => d_rsb_free
|
||||
procedure, pass(a) :: mold => psb_c_rsb_mold
|
||||
procedure, pass(a) :: psb_c_rsb_cp_from
|
||||
generic, public :: cp_from => psb_c_rsb_cp_from
|
||||
procedure, pass(a) :: psb_c_rsb_mv_from
|
||||
generic, public :: mv_from => psb_c_rsb_mv_from
|
||||
|
||||
#endif
|
||||
end type psb_c_rsb_sparse_mat
|
||||
! FIXME: complete the following
|
||||
!private :: d_rsb_get_nzeros, d_rsb_get_fmt
|
||||
private :: d_rsb_to_psb_info
|
||||
#ifdef HAVE_LIBRSB
|
||||
contains
|
||||
|
||||
function psb_rsb_matmod_init() result(res)
|
||||
implicit none
|
||||
integer :: res
|
||||
!PSBRSB_DEBUG('')
|
||||
res=-1 ! FIXME
|
||||
#ifdef HAVE_LIBRSB
|
||||
res=d_rsb_to_psb_info(rsb_init(c_null_ptr))
|
||||
#endif
|
||||
end function psb_rsb_matmod_init
|
||||
|
||||
function psb_rsb_matmod_exit() result(res)
|
||||
implicit none
|
||||
integer :: res
|
||||
!PSBRSB_DEBUG('')
|
||||
res=-1 ! FIXME
|
||||
#ifdef HAVE_LIBRSB
|
||||
res=d_rsb_to_psb_info(rsb_exit())
|
||||
#endif
|
||||
end function psb_rsb_matmod_exit
|
||||
|
||||
function d_rsb_to_psb_info(info) result(res)
|
||||
implicit none
|
||||
integer , intent(in) :: info
|
||||
integer :: res
|
||||
!PSBRSB_DEBUG('')
|
||||
if(info.ne.0)then
|
||||
res=-1
|
||||
else
|
||||
res=psb_success_
|
||||
end if
|
||||
end function d_rsb_to_psb_info
|
||||
|
||||
function d_rsb_get_flags(a) result(flags)
|
||||
implicit none
|
||||
integer :: flags
|
||||
class(psb_c_base_sparse_mat), intent(in) :: a
|
||||
!PSBRSB_DEBUG('')
|
||||
flags=c_def_flags
|
||||
if(a%is_sorted()) flags=flags+c_srt_flags
|
||||
if(a%is_triangle()) flags=flags+c_tri_flags
|
||||
if(a%is_upper()) flags=flags+c_upp_flags
|
||||
if(a%is_unit()) flags=flags+c_idi_flags
|
||||
if(a%is_lower()) flags=flags+c_low_flags
|
||||
end function d_rsb_get_flags
|
||||
|
||||
function d_rsb_get_nzeros(a) result(res)
|
||||
implicit none
|
||||
class(psb_c_rsb_sparse_mat), intent(in) :: a
|
||||
integer :: res
|
||||
!PSBRSB_DEBUG('')
|
||||
res=rsb_get_matrix_nnz(a%rsbmptr)
|
||||
end function d_rsb_get_nzeros
|
||||
|
||||
function d_rsb_get_nrows(a) result(res)
|
||||
implicit none
|
||||
class(psb_c_rsb_sparse_mat), intent(in) :: a
|
||||
integer :: res
|
||||
!PSBRSB_DEBUG('')
|
||||
res=rsb_get_matrix_n_rows(a%rsbmptr)
|
||||
end function d_rsb_get_nrows
|
||||
|
||||
function d_rsb_get_ncols(a) result(res)
|
||||
implicit none
|
||||
class(psb_c_rsb_sparse_mat), intent(in) :: a
|
||||
integer :: res
|
||||
!PSBRSB_DEBUG('')
|
||||
res=rsb_get_matrix_n_columns(a%rsbmptr)
|
||||
end function d_rsb_get_ncols
|
||||
|
||||
function d_rsb_get_fmt() result(res)
|
||||
implicit none
|
||||
character(len=5) :: res
|
||||
!the following printout is harmful, here, if happening during a write :) (causes a deadlock)
|
||||
!PSBRSB_DEBUG('')
|
||||
res = 'RSB'
|
||||
end function d_rsb_get_fmt
|
||||
|
||||
function d_rsb_get_size(a) result(res)
|
||||
implicit none
|
||||
class(psb_c_rsb_sparse_mat), intent(in) :: a
|
||||
integer :: res
|
||||
!PSBRSB_DEBUG('')
|
||||
res = d_rsb_get_nzeros(a)
|
||||
end function d_rsb_get_size
|
||||
|
||||
function d_rsb_sizeof(a) result(res)
|
||||
implicit none
|
||||
class(psb_c_rsb_sparse_mat), intent(in) :: a
|
||||
integer(psb_long_int_k_) :: res
|
||||
!PSBRSB_DEBUG('')
|
||||
res=rsb_sizeof(a%rsbmptr)
|
||||
end function d_rsb_sizeof
|
||||
|
||||
subroutine psb_c_rsb_csmv(alpha,a,x,beta,y,info,trans)
|
||||
implicit none
|
||||
class(psb_c_rsb_sparse_mat), intent(in) :: a
|
||||
complex(psb_spk_), intent(in) :: alpha, beta, x(:)
|
||||
complex(psb_spk_), intent(inout) :: y(:)
|
||||
integer, intent(out) :: info
|
||||
character, optional, intent(in) :: trans
|
||||
character :: trans_
|
||||
! PSBRSB_DEBUG('')
|
||||
info = psb_success_
|
||||
|
||||
if (present(trans)) then
|
||||
trans_ = trans
|
||||
else
|
||||
trans_ = 'N'
|
||||
end if
|
||||
info=d_rsb_to_psb_info(rsb_spmv(rsb_psblas_trans_to_rsb_trans(trans_),alpha,a%rsbmptr,x,1,beta,y,1))
|
||||
end subroutine psb_c_rsb_csmv
|
||||
|
||||
subroutine psb_c_rsb_csmv_nt(alpha,a,x1,x2,beta,y1,y2,info)
|
||||
! FIXME: this routine is here as a placeholder for a specialized implementation of
|
||||
! joint spmv and spmv transposed.
|
||||
implicit none
|
||||
class(psb_c_rsb_sparse_mat), intent(in) :: a
|
||||
complex(psb_spk_), intent(in) :: alpha, beta, x1(:), x2(:)
|
||||
complex(psb_spk_), intent(inout) :: y1(:), y2(:)
|
||||
integer, intent(out) :: info
|
||||
! PSBRSB_DEBUG('')
|
||||
info = psb_success_
|
||||
info=d_rsb_to_psb_info(rsb_spmv_nt(alpha,a%rsbmptr,x1,x2,1,beta,y1,y2,1))
|
||||
return
|
||||
end subroutine psb_c_rsb_csmv_nt
|
||||
|
||||
subroutine psb_c_rsb_cssv(alpha,a,x,beta,y,info,trans)
|
||||
use psb_error_mod
|
||||
! FIXME: and what when x is an alias of y ?
|
||||
! FIXME: ignoring beta
|
||||
implicit none
|
||||
class(psb_c_rsb_sparse_mat), intent(in) :: a
|
||||
complex(psb_spk_), intent(in) :: alpha, beta, x(:)
|
||||
complex(psb_spk_), intent(inout) :: y(:)
|
||||
integer, intent(out) :: info
|
||||
character, optional, intent(in) :: trans
|
||||
character :: trans_
|
||||
Integer :: err_act, i
|
||||
character(len=20) :: name='rsb_cssv'
|
||||
logical, parameter :: debug=.false.
|
||||
|
||||
info = psb_success_
|
||||
call psb_erractionsave(err_act)
|
||||
|
||||
! PSBRSB_DEBUG('')
|
||||
|
||||
if (present(trans)) then
|
||||
trans_ = trans
|
||||
else
|
||||
trans_ = 'N'
|
||||
end if
|
||||
info=d_rsb_to_psb_info(rsb_spsv(rsb_psblas_trans_to_rsb_trans(trans_),alpha,a%rsbmptr,x,1,y,1))
|
||||
if (info /= 0) then
|
||||
i = info
|
||||
info = psb_err_from_subroutine_ai_
|
||||
call psb_errpush(info,name,&
|
||||
& i_err=(/i,0,0,0,0/),a_err="rsb_spsv")
|
||||
goto 9999
|
||||
end if
|
||||
call psb_erractionrestore(err_act)
|
||||
return
|
||||
|
||||
9999 continue
|
||||
call psb_erractionrestore(err_act)
|
||||
|
||||
if (err_act == psb_act_abort_) then
|
||||
PSBRSB_ERROR("!")
|
||||
call psb_error()
|
||||
return
|
||||
end if
|
||||
return
|
||||
|
||||
end subroutine psb_c_rsb_cssv
|
||||
|
||||
subroutine psb_c_rsb_scals(d,a,info)
|
||||
use psb_base_mod
|
||||
implicit none
|
||||
class(psb_c_rsb_sparse_mat), intent(inout) :: a
|
||||
complex(psb_spk_), intent(in) :: d
|
||||
integer, intent(out) :: info
|
||||
PSBRSB_DEBUG('')
|
||||
info=d_rsb_to_psb_info(rsb_elemental_scale(a%rsbmptr,d))
|
||||
end subroutine psb_c_rsb_scals
|
||||
|
||||
subroutine psb_c_rsb_scal(d,a,info)
|
||||
use psb_base_mod
|
||||
implicit none
|
||||
class(psb_c_rsb_sparse_mat), intent(inout) :: a
|
||||
complex(psb_spk_), intent(in) :: d(:)
|
||||
integer, intent(out) :: info
|
||||
PSBRSB_DEBUG('')
|
||||
info=d_rsb_to_psb_info(rsb_scale_rows(a%rsbmptr,d))
|
||||
end subroutine psb_c_rsb_scal
|
||||
|
||||
subroutine d_rsb_free(a)
|
||||
implicit none
|
||||
class(psb_c_rsb_sparse_mat), intent(inout) :: a
|
||||
type(c_ptr) :: dummy
|
||||
!PSBRSB_DEBUG('freeing RSB matrix')
|
||||
dummy=rsb_free_sparse_matrix(a%rsbmptr)
|
||||
end subroutine d_rsb_free
|
||||
|
||||
subroutine psb_c_rsb_trim(a)
|
||||
implicit none
|
||||
class(psb_c_rsb_sparse_mat), intent(inout) :: a
|
||||
!PSBRSB_DEBUG('')
|
||||
! FIXME: this is supposed to remain empty for RSB
|
||||
end subroutine psb_c_rsb_trim
|
||||
|
||||
subroutine psb_c_rsb_print(iout,a,iv,eirs,eics,head,ivr,ivc)
|
||||
integer, intent(in) :: iout
|
||||
class(psb_c_rsb_sparse_mat), intent(in) :: a
|
||||
integer, intent(in), optional :: iv(:)
|
||||
integer, intent(in), optional :: eirs,eics
|
||||
character(len=*), optional :: head
|
||||
integer, intent(in), optional :: ivr(:), ivc(:)
|
||||
integer :: info
|
||||
PSBRSB_DEBUG('')
|
||||
! FIXME: UNFINISHED
|
||||
info=rsb_print_matrix_t(a%rsbmptr)
|
||||
end subroutine psb_c_rsb_print
|
||||
|
||||
subroutine psb_c_rsb_get_diag(a,d,info)
|
||||
class(psb_c_rsb_sparse_mat), intent(in) :: a
|
||||
complex(psb_spk_), intent(out) :: d(:)
|
||||
integer, intent(out) :: info
|
||||
!PSBRSB_DEBUG('')
|
||||
info=rsb_getdiag(a%rsbmptr,d)
|
||||
end subroutine psb_c_rsb_get_diag
|
||||
|
||||
function psb_c_rsb_csnmi(a) result(csnmi_res)
|
||||
implicit none
|
||||
class(psb_c_rsb_sparse_mat), intent(in) :: a
|
||||
real(psb_spk_),target :: csnmi_res ! please DO NOT rename this variable (see the Makefile)
|
||||
complex(psb_spk_) :: resa(1)
|
||||
integer :: info
|
||||
!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'))
|
||||
csnmi_res=resa(1)
|
||||
end function psb_c_rsb_csnmi
|
||||
|
||||
function psb_c_rsb_csnm1(a) result(res)
|
||||
implicit none
|
||||
class(psb_c_rsb_sparse_mat), intent(in) :: a
|
||||
complex(psb_spk_) :: res
|
||||
complex(psb_spk_) :: resa(1)
|
||||
integer :: info
|
||||
PSBRSB_DEBUG('')
|
||||
info=rsb_one_norm(a%rsbmptr,resa,rsb_psblas_trans_to_rsb_trans('N'))
|
||||
!info=rsb_one_norm(a%rsbmptr,res,rsb_psblas_trans_to_rsb_trans('N'))
|
||||
end function psb_c_rsb_csnm1
|
||||
|
||||
subroutine psb_c_rsb_aclsum(d,a)
|
||||
use psb_base_mod
|
||||
class(psb_c_rsb_sparse_mat), intent(in) :: a
|
||||
complex(psb_spk_), intent(out) :: d(:)
|
||||
PSBRSB_DEBUG('')
|
||||
info=rsb_absolute_columns_sums(a%rsbmptr,d)
|
||||
end subroutine psb_c_rsb_aclsum
|
||||
|
||||
subroutine psb_c_rsb_arwsum(d,a)
|
||||
use psb_base_mod
|
||||
class(psb_c_rsb_sparse_mat), intent(in) :: a
|
||||
complex(psb_spk_), intent(out) :: d(:)
|
||||
PSBRSB_DEBUG('')
|
||||
info=rsb_absolute_rows_sums(a%rsbmptr,d)
|
||||
end subroutine psb_c_rsb_arwsum
|
||||
|
||||
subroutine psb_c_rsb_csmm(alpha,a,x,beta,y,info,trans)
|
||||
use psb_base_mod
|
||||
implicit none
|
||||
class(psb_c_rsb_sparse_mat), intent(in) :: a
|
||||
complex(psb_spk_), intent(in) :: alpha, beta, x(:,:)
|
||||
complex(psb_spk_), intent(inout) :: y(:,:)
|
||||
integer, intent(out) :: info
|
||||
character, optional, intent(in) :: trans
|
||||
|
||||
character :: trans_
|
||||
integer :: ldy,ldx,nc
|
||||
PSBRSB_DEBUG('')
|
||||
PSBRSB_DEBUG('ERROR: UNIMPLEMENTED')
|
||||
|
||||
if (present(trans)) then
|
||||
trans_ = trans
|
||||
else
|
||||
trans_ = 'N'
|
||||
end if
|
||||
ldx=size(x,1); ldy=size(y,1)
|
||||
nc=min(size(x,2),size(y,2) )
|
||||
info=-1
|
||||
info=d_rsb_to_psb_info(rsb_spmm(rsb_psblas_trans_to_rsb_trans(trans_),alpha,a%rsbmptr,nc,c_f_order,x,ldx,beta,y,ldy))
|
||||
end subroutine psb_c_rsb_csmm
|
||||
|
||||
subroutine psb_c_rsb_cssm(alpha,a,x,beta,y,info,trans)
|
||||
use psb_base_mod
|
||||
implicit none
|
||||
class(psb_c_rsb_sparse_mat), intent(in) :: a
|
||||
complex(psb_spk_), intent(in) :: alpha, beta, x(:,:)
|
||||
complex(psb_spk_), intent(inout) :: y(:,:)
|
||||
integer, intent(out) :: info
|
||||
character, optional, intent(in) :: trans
|
||||
integer :: ldy,ldx,nc
|
||||
character :: trans_
|
||||
PSBRSB_DEBUG('')
|
||||
PSBRSB_DEBUG('ERROR: UNIMPLEMENTED')
|
||||
if (present(trans)) then
|
||||
trans_ = trans
|
||||
else
|
||||
trans_ = 'N'
|
||||
end if
|
||||
ldx=size(x,1); ldy=size(y,1)
|
||||
nc=min(size(x,2),size(y,2) )
|
||||
info=-1
|
||||
info=d_rsb_to_psb_info(rsb_spsm(rsb_psblas_trans_to_rsb_trans(trans_),alpha,a%rsbmptr,nc,c_f_order,beta,x,ldx,y,ldy))
|
||||
end subroutine
|
||||
|
||||
subroutine psb_c_rsb_rowsum(d,a)
|
||||
use psb_base_mod
|
||||
class(psb_c_rsb_sparse_mat), intent(in) :: a
|
||||
complex(psb_spk_), intent(out) :: d(:)
|
||||
integer :: info
|
||||
PSBRSB_DEBUG('')
|
||||
info=d_rsb_to_psb_info(rsb_rows_sums(a%rsbmptr,d))
|
||||
end subroutine psb_c_rsb_rowsum
|
||||
|
||||
subroutine psb_c_rsb_colsum(d,a)
|
||||
use psb_base_mod
|
||||
class(psb_c_rsb_sparse_mat), intent(in) :: a
|
||||
complex(psb_spk_), intent(out) :: d(:)
|
||||
integer :: info
|
||||
PSBRSB_DEBUG('')
|
||||
info=d_rsb_to_psb_info(rsb_columns_sums(a%rsbmptr,d))
|
||||
end subroutine psb_c_rsb_colsum
|
||||
|
||||
subroutine psb_c_rsb_mold(a,b,info)
|
||||
use psb_base_mod
|
||||
implicit none
|
||||
class(psb_c_rsb_sparse_mat), intent(in) :: a
|
||||
class(psb_c_base_sparse_mat), intent(out), allocatable :: b
|
||||
integer, intent(out) :: info
|
||||
Integer :: err_act
|
||||
character(len=20) :: name='reallocate_nz'
|
||||
logical, parameter :: debug=.false.
|
||||
PSBRSB_DEBUG('')
|
||||
|
||||
call psb_get_erraction(err_act)
|
||||
|
||||
allocate(psb_c_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
|
||||
PSBRSB_ERROR("!")
|
||||
call psb_error()
|
||||
end if
|
||||
return
|
||||
end subroutine psb_c_rsb_mold
|
||||
|
||||
subroutine psb_c_rsb_reinit(a,clear)
|
||||
implicit none
|
||||
class(psb_c_rsb_sparse_mat), intent(inout) :: a
|
||||
logical, intent(in), optional :: clear
|
||||
Integer :: info
|
||||
PSBRSB_DEBUG('')
|
||||
info=d_rsb_to_psb_info(rsb_reinit_matrix(a%rsbmptr))
|
||||
end subroutine psb_c_rsb_reinit
|
||||
|
||||
|
||||
function d_rsb_get_nz_row(idx,a) result(res)
|
||||
implicit none
|
||||
class(psb_c_rsb_sparse_mat), intent(in) :: a
|
||||
integer, intent(in) :: idx
|
||||
integer :: res
|
||||
integer :: info
|
||||
PSBRSB_DEBUG('')
|
||||
res=0
|
||||
res=rsb_get_rows_nnz(a%rsbmptr,idx,idx,c_for_flags,info)
|
||||
info=d_rsb_to_psb_info(info)
|
||||
if(info.ne.0)res=0
|
||||
end function d_rsb_get_nz_row
|
||||
|
||||
subroutine psb_c_cp_rsb_to_coo(a,b,info)
|
||||
implicit none
|
||||
class(psb_c_rsb_sparse_mat), intent(in) :: a
|
||||
class(psb_c_coo_sparse_mat), intent(inout) :: b
|
||||
integer, intent(out) :: info
|
||||
|
||||
integer, allocatable :: itemp(:)
|
||||
!locals
|
||||
logical :: rwshr_
|
||||
Integer :: nza, nr, nc,i,j,irw, idl,err_act
|
||||
integer :: debug_level, debug_unit
|
||||
character(len=20) :: name
|
||||
! PSBRSB_DEBUG('')
|
||||
info = psb_success_
|
||||
nr = a%get_nrows()
|
||||
nc = a%get_ncols()
|
||||
nza = a%get_nzeros()
|
||||
call b%allocate(nr,nc,nza)
|
||||
call b%psb_c_base_sparse_mat%cp_from(a%psb_c_base_sparse_mat)
|
||||
info=d_rsb_to_psb_info(rsb_get_coo(a%rsbmptr,b%val,b%ia,b%ja,c_for_flags))
|
||||
call b%set_nzeros(a%get_nzeros())
|
||||
call b%set_nrows(a%get_nrows())
|
||||
call b%set_ncols(a%get_ncols())
|
||||
call b%fix(info)
|
||||
!write(*,*)b%val
|
||||
!write(*,*)b%ia
|
||||
!write(*,*)b%ja
|
||||
!write(*,*)b%get_nrows()
|
||||
!write(*,*)b%get_ncols()
|
||||
!write(*,*)b%get_nzeros()
|
||||
!write(*,*)a%get_nrows()
|
||||
!write(*,*)a%get_ncols()
|
||||
!write(*,*)a%get_nzeros()
|
||||
end subroutine psb_c_cp_rsb_to_coo
|
||||
|
||||
subroutine psb_c_cp_rsb_to_fmt(a,b,info)
|
||||
use psb_base_mod
|
||||
implicit none
|
||||
|
||||
class(psb_c_rsb_sparse_mat), intent(in) :: a
|
||||
class(psb_c_base_sparse_mat), intent(inout) :: b
|
||||
integer, intent(out) :: info
|
||||
|
||||
!locals
|
||||
type(psb_c_coo_sparse_mat) :: tmp
|
||||
logical :: rwshr_
|
||||
Integer :: nza, nr, i,j,irw, idl,err_act, nc
|
||||
integer :: debug_level, debug_unit
|
||||
character(len=20) :: name
|
||||
PSBRSB_DEBUG('')
|
||||
|
||||
info = psb_success_
|
||||
|
||||
select type (b)
|
||||
type is (psb_c_coo_sparse_mat)
|
||||
call a%cp_to_coo(b,info)
|
||||
|
||||
type is (psb_c_rsb_sparse_mat)
|
||||
call b%psb_c_base_sparse_mat%cp_from(a%psb_c_base_sparse_mat)! FIXME: ?
|
||||
b%rsbmptr=rsb_clone(a%rsbmptr) ! FIXME is thi enough ?
|
||||
! FIXME: error handling needed here
|
||||
|
||||
class default
|
||||
call a%cp_to_coo(tmp,info)
|
||||
if (info == psb_success_) call b%mv_from_coo(tmp,info)
|
||||
end select
|
||||
end subroutine psb_c_cp_rsb_to_fmt
|
||||
|
||||
subroutine psb_c_cp_rsb_from_coo(a,b,info)
|
||||
use psb_base_mod
|
||||
implicit none
|
||||
|
||||
class(psb_c_rsb_sparse_mat), intent(inout) :: a
|
||||
class(psb_c_coo_sparse_mat), intent(in) :: b
|
||||
integer, intent(out) :: info
|
||||
|
||||
integer, allocatable :: itemp(:)
|
||||
!locals
|
||||
logical :: rwshr_
|
||||
Integer :: nza, nr, i,j,irw, idl,err_act, nc
|
||||
integer :: debug_level, debug_unit
|
||||
integer :: flags
|
||||
character(len=20) :: name
|
||||
! PSBRSB_DEBUG('')
|
||||
|
||||
flags=d_rsb_get_flags(b)
|
||||
|
||||
info = psb_success_
|
||||
call a%psb_c_base_sparse_mat%cp_from(b%psb_c_base_sparse_mat)
|
||||
|
||||
!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,flags,info)
|
||||
info=d_rsb_to_psb_info(info)
|
||||
! FIXME: should destroy tmp ?
|
||||
end subroutine psb_c_cp_rsb_from_coo
|
||||
|
||||
subroutine psb_c_cp_rsb_from_fmt(a,b,info)
|
||||
use psb_base_mod
|
||||
implicit none
|
||||
|
||||
class(psb_c_rsb_sparse_mat), intent(inout) :: a
|
||||
class(psb_c_base_sparse_mat), intent(in) :: b
|
||||
integer, intent(out) :: info
|
||||
|
||||
!locals
|
||||
type(psb_c_coo_sparse_mat) :: tmp
|
||||
logical :: rwshr_
|
||||
Integer :: nz, nr, i,j,irw, idl,err_act, nc
|
||||
integer :: debug_level, debug_unit
|
||||
integer :: flags
|
||||
character(len=20) :: name
|
||||
PSBRSB_DEBUG('')
|
||||
|
||||
info = psb_success_
|
||||
flags=d_rsb_get_flags(b)
|
||||
|
||||
select type (b)
|
||||
type is (psb_c_coo_sparse_mat)
|
||||
call a%cp_from_coo(b,info)
|
||||
|
||||
type is (psb_c_csr_sparse_mat)
|
||||
call a%psb_c_base_sparse_mat%cp_from(b%psb_c_base_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,flags,info)
|
||||
info=d_rsb_to_psb_info(info)
|
||||
|
||||
type is (psb_c_rsb_sparse_mat)
|
||||
call b%cp_to_fmt(a,info) ! FIXME
|
||||
! FIXME: missing error handling
|
||||
|
||||
class default
|
||||
call b%cp_to_coo(tmp,info)
|
||||
if (info == psb_success_) call a%mv_from_coo(tmp,info)
|
||||
end select
|
||||
end subroutine psb_c_cp_rsb_from_fmt
|
||||
|
||||
|
||||
subroutine psb_c_rsb_csgetrow(imin,imax,a,nz,ia,ja,val,info,&
|
||||
& jmin,jmax,iren,append,nzin,rscale,cscale)
|
||||
use psb_base_mod
|
||||
implicit none
|
||||
|
||||
class(psb_c_rsb_sparse_mat), intent(in) :: a
|
||||
integer, intent(in) :: imin,imax
|
||||
integer, intent(out) :: nz
|
||||
integer, allocatable, intent(inout) :: ia(:), ja(:)
|
||||
complex(psb_spk_), allocatable, intent(inout) :: val(:)
|
||||
integer,intent(out) :: info
|
||||
logical, intent(in), optional :: append
|
||||
integer, intent(in), optional :: iren(:)
|
||||
integer, intent(in), optional :: jmin,jmax, nzin
|
||||
logical, intent(in), optional :: rscale,cscale
|
||||
|
||||
logical :: append_, rscale_, cscale_
|
||||
integer :: nzin_, jmin_, jmax_, err_act, i, nzrsb
|
||||
character(len=20) :: name='csget'
|
||||
logical, parameter :: debug=.false.
|
||||
! FIXME: MISSING THE HANDLING OF OPTIONS, HERE
|
||||
PSBRSB_DEBUG('')
|
||||
|
||||
call psb_erractionsave(err_act)
|
||||
info = psb_success_
|
||||
|
||||
if (present(jmin)) then
|
||||
jmin_ = jmin
|
||||
else
|
||||
jmin_ = 1
|
||||
endif
|
||||
if (present(jmax)) then
|
||||
jmax_ = jmax
|
||||
else
|
||||
jmax_ = a%get_ncols()
|
||||
endif
|
||||
|
||||
if ((imax<imin).or.(jmax_<jmin_)) then
|
||||
nz = 0
|
||||
!info=c_psbrsb_err_
|
||||
PSBRSB_WARNING("imax < imin ? or jmax < jmin ? !")
|
||||
return
|
||||
end if
|
||||
|
||||
if (present(append)) then
|
||||
append_=append
|
||||
else
|
||||
append_=.false.
|
||||
endif
|
||||
if ((append_).and.(present(nzin))) then
|
||||
nzin_ = nzin
|
||||
else
|
||||
nzin_ = 0
|
||||
endif
|
||||
if (present(rscale)) then
|
||||
rscale_ = rscale
|
||||
else
|
||||
rscale_ = .false.
|
||||
endif
|
||||
if (present(cscale)) then
|
||||
cscale_ = cscale
|
||||
else
|
||||
cscale_ = .false.
|
||||
endif
|
||||
! if ((rscale_.or.cscale_).and.(present(iren))) then
|
||||
! PSBRSB_ERROR("!")
|
||||
! info = psb_err_many_optional_arg_
|
||||
! call psb_errpush(info,name,a_err='iren (rscale.or.cscale)')
|
||||
! goto 9999
|
||||
! end if
|
||||
|
||||
nzrsb = rsb_get_block_nnz(a%rsbmptr,imin,imax,jmin_,jmax_,c_for_flags,info)
|
||||
! FIXME: unfinished; missing error handling ..
|
||||
|
||||
call psb_ensure_size(nzin_+nzrsb,ia,info)
|
||||
if (info == psb_success_) call psb_ensure_size(nzin_+nzrsb,ja,info)
|
||||
if (info == psb_success_) call psb_ensure_size(nzin_+nzrsb,val,info)
|
||||
if (info /= psb_success_)then
|
||||
PSBRSB_ERROR("psb_ensure_size failed !")
|
||||
return
|
||||
endif
|
||||
|
||||
|
||||
info=d_rsb_to_psb_info(rsb_get_block_sparse(a%rsbmptr,&
|
||||
& val(nzin_+1:),imin,imax,jmin_,jmax_,&
|
||||
& ia(nzin_+1:),ja(nzin_+1:),&
|
||||
& c_null_ptr,c_null_ptr,nz,c_for_flags))
|
||||
! FIXME: unfinished; missing error handling ..
|
||||
if (nz /= nzrsb) then
|
||||
info=c_psbrsb_err_
|
||||
PSBRSB_ERROR("Mismatch in output from rsb_getblk")
|
||||
!write(*,*) 'Mismatch in output from rsb_getblk: ',nz,nzrsb
|
||||
end if
|
||||
|
||||
if (rscale_) then
|
||||
do i=nzin_+1, nzin_+nz
|
||||
ia(i) = ia(i) - imin + 1
|
||||
end do
|
||||
end if
|
||||
if (cscale_) then
|
||||
do i=nzin_+1, nzin_+nz
|
||||
ja(i) = ja(i) - jmin_ + 1
|
||||
end do
|
||||
end if
|
||||
|
||||
|
||||
|
||||
9999 continue
|
||||
call psb_erractionrestore(err_act)
|
||||
|
||||
if (err_act == psb_act_abort_) then
|
||||
PSBRSB_ERROR("!")
|
||||
call psb_error()
|
||||
return
|
||||
end if
|
||||
|
||||
end subroutine psb_c_rsb_csgetrow
|
||||
|
||||
subroutine psb_c_rsb_csgetptn(imin,imax,a,nz,ia,ja,info,&
|
||||
& jmin,jmax,iren,append,nzin,rscale,cscale)
|
||||
use psb_base_mod
|
||||
implicit none
|
||||
|
||||
class(psb_c_rsb_sparse_mat), intent(in) :: a
|
||||
integer, intent(in) :: imin,imax
|
||||
integer, intent(out) :: nz
|
||||
integer, allocatable, intent(inout) :: ia(:), ja(:)
|
||||
integer,intent(out) :: info
|
||||
logical, intent(in), optional :: append
|
||||
integer, intent(in), optional :: iren(:)
|
||||
integer, intent(in), optional :: jmin,jmax, nzin
|
||||
logical, intent(in), optional :: rscale,cscale
|
||||
|
||||
logical :: append_, rscale_, cscale_
|
||||
integer :: nzin_, jmin_, jmax_, err_act, i
|
||||
character(len=20) :: name='csget'
|
||||
logical, parameter :: debug=.false.
|
||||
PSBRSB_DEBUG('')
|
||||
|
||||
if (present(iren).or.present(rscale).or.present(cscale)) then
|
||||
! FIXME: error condition
|
||||
PSBRSB_ERROR("unsupported optional arguments!")
|
||||
call psb_error()
|
||||
endif
|
||||
|
||||
if (present(append)) then
|
||||
append_ = append
|
||||
else
|
||||
append_ = .false.
|
||||
endif
|
||||
if (present(append).and.append.and.present(nzin)) then
|
||||
nzin_ = nzin
|
||||
else
|
||||
nzin_ = 0
|
||||
endif
|
||||
|
||||
if (present(jmin)) then
|
||||
jmin_ = jmin
|
||||
else
|
||||
jmin_ = 1
|
||||
endif
|
||||
|
||||
if (present(jmax)) then
|
||||
jmax_ = jmax
|
||||
else
|
||||
jmax_ = a%get_nrows()
|
||||
endif
|
||||
|
||||
if (present(rscale)) then
|
||||
rscale_ = rscale
|
||||
else
|
||||
rscale_ = .false.
|
||||
endif
|
||||
if (present(cscale)) then
|
||||
cscale_ = cscale
|
||||
else
|
||||
cscale_ = .false.
|
||||
endif
|
||||
if ((rscale_.or.cscale_).and.(present(iren))) then
|
||||
info = psb_err_many_optional_arg_
|
||||
call psb_errpush(info,name,a_err='iren (rscale.or.cscale)')
|
||||
goto 9999
|
||||
end if
|
||||
if (present(iren)) then
|
||||
info = c_psbrsb_err_
|
||||
PSBRSB_ERROR("ERROR: the RSB pattern get needs iren support !!")
|
||||
goto 9999
|
||||
end if
|
||||
|
||||
|
||||
!nzt = ..
|
||||
nz = 0
|
||||
|
||||
call psb_ensure_size(nzin_,ia,info)
|
||||
if (info == psb_success_) call psb_ensure_size(nzin_,ja,info)
|
||||
|
||||
if (info /= psb_success_) return
|
||||
nz=rsb_get_block_nnz(a%rsbmptr,imin,imax,jmin_,jmax_,c_for_flags,info)
|
||||
!write(*,*) 'debug:',nzin_,nz,imin,imax,jmin_,jmax_
|
||||
! FIXME: unfinished; missing error handling ..
|
||||
|
||||
call psb_ensure_size(nzin_+nz,ia,info)
|
||||
if (info == psb_success_) call psb_ensure_size(nzin_+nz,ja,info)
|
||||
if (info /= psb_success_)then
|
||||
PSBRSB_ERROR("!")
|
||||
return
|
||||
endif
|
||||
|
||||
info=d_rsb_to_psb_info(rsb_get_block_sparse_pattern&
|
||||
&(a%rsbmptr,imin,imax,jmin_,jmax_,ia,ja,c_null_ptr,c_null_ptr,nzin_,c_for_flags))
|
||||
! FIXME: unfinished; missing error handling ..
|
||||
|
||||
!write(*,*) 'debug:',nzin_,nz,imin,imax,jmin_,jmax_
|
||||
if (rscale_) then
|
||||
do i=nzin_+1, nzin_+nz
|
||||
ia(i) = ia(i) - imin + 1
|
||||
end do
|
||||
end if
|
||||
if (cscale_) then
|
||||
do i=nzin_+1, nzin_+nz
|
||||
ja(i) = ja(i) - jmin_ + 1
|
||||
end do
|
||||
end if
|
||||
|
||||
9999 continue
|
||||
call psb_erractionrestore(err_act)
|
||||
|
||||
if (err_act == psb_act_abort_) then
|
||||
PSBRSB_ERROR("!")
|
||||
call psb_error()
|
||||
return
|
||||
endif
|
||||
|
||||
end subroutine psb_c_rsb_csgetptn
|
||||
|
||||
subroutine psb_c_rsb_csput(nz,ia,ja,val,a,imin,imax,jmin,jmax,info,gtl)
|
||||
use psb_base_mod
|
||||
implicit none
|
||||
|
||||
class(psb_c_rsb_sparse_mat), intent(inout) :: a
|
||||
complex(psb_spk_), intent(in) :: val(:)
|
||||
integer, intent(in) :: nz, ia(:), ja(:), imin,imax,jmin,jmax
|
||||
integer, intent(out) :: info
|
||||
integer, intent(in), optional :: gtl(:)
|
||||
|
||||
|
||||
Integer :: err_act
|
||||
character(len=20) :: name='d_rsb_csput'
|
||||
logical, parameter :: debug=.false.
|
||||
integer :: nza, i,j,k, nzl, isza, int_err(5)
|
||||
PSBRSB_DEBUG('')
|
||||
if(present(gtl))then
|
||||
PSBRSB_ERROR("!")
|
||||
endif
|
||||
info=d_rsb_to_psb_info(rsb_update_elements(a%rsbmptr,val,ia,ja,nz,c_upd_flags))
|
||||
end subroutine psb_c_rsb_csput
|
||||
|
||||
subroutine psb_c_mv_rsb_to_coo(a,b,info)
|
||||
use psb_base_mod
|
||||
implicit none
|
||||
|
||||
class(psb_c_rsb_sparse_mat), intent(inout) :: a
|
||||
class(psb_c_coo_sparse_mat), intent(inout) :: b
|
||||
integer, intent(out) :: info
|
||||
PSBRSB_DEBUG('')
|
||||
! FIXME: use rsb_switch_rsb_matrix_to_coo_sorted !
|
||||
call psb_c_cp_rsb_to_coo(a,b,info)
|
||||
call a%free()
|
||||
end subroutine psb_c_mv_rsb_to_coo
|
||||
|
||||
subroutine psb_c_mv_rsb_to_fmt(a,b,info)
|
||||
class(psb_c_rsb_sparse_mat), intent(inout) :: a
|
||||
class(psb_c_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_c_cp_rsb_to_fmt(a,b,info)
|
||||
call d_rsb_free(a)
|
||||
a%rsbmptr=c_null_ptr
|
||||
end subroutine psb_c_mv_rsb_to_fmt
|
||||
|
||||
subroutine psb_c_mv_rsb_from_fmt(a,b,info)
|
||||
use psb_base_mod
|
||||
implicit none
|
||||
class(psb_c_rsb_sparse_mat), intent(inout) :: a
|
||||
class(psb_c_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_c_coo_sparse_mat) :: tmp
|
||||
! PSBRSB_DEBUG('')
|
||||
info = psb_success_
|
||||
select type (b)
|
||||
class default
|
||||
call b%mv_to_coo(tmp,info)
|
||||
if (info == psb_success_) call a%mv_from_coo(tmp,info)
|
||||
end select
|
||||
end subroutine psb_c_mv_rsb_from_fmt
|
||||
|
||||
subroutine psb_c_mv_rsb_from_coo(a,b,info)
|
||||
use psb_base_mod
|
||||
implicit none
|
||||
class(psb_c_rsb_sparse_mat), intent(inout) :: a
|
||||
class(psb_c_coo_sparse_mat), intent(inout) :: b
|
||||
integer, intent(out) :: info
|
||||
! PSBRSB_DEBUG('')
|
||||
! FIXME: should use rsb_allocate_rsb_sparse_matrix_inplace
|
||||
!if(b%is_sorted()) flags=flags+c_srt_flags
|
||||
!if(b%is_triangle()) flags=flags+c_tri_flags
|
||||
call a%cp_from_coo(b,info)
|
||||
call b%free()
|
||||
end subroutine psb_c_mv_rsb_from_coo
|
||||
|
||||
subroutine psb_c_rsb_cp_from(a,b)
|
||||
use psb_base_mod
|
||||
implicit none
|
||||
class(psb_c_rsb_sparse_mat), intent(inout) :: a
|
||||
type(psb_c_rsb_sparse_mat), intent(in) :: b
|
||||
Integer :: info
|
||||
type(psb_c_coo_sparse_mat) :: tmp
|
||||
PSBRSB_DEBUG('')
|
||||
call b%cp_to_coo(tmp,info)
|
||||
call a%mv_from_coo(tmp,info)
|
||||
call tmp%free()
|
||||
end subroutine psb_c_rsb_cp_from
|
||||
|
||||
subroutine psb_c_rsb_mv_from(a,b)
|
||||
use psb_base_mod
|
||||
implicit none
|
||||
class(psb_c_rsb_sparse_mat), intent(inout) :: a
|
||||
type(psb_c_rsb_sparse_mat), intent(inout) :: b
|
||||
Integer :: info
|
||||
type(psb_c_coo_sparse_mat) :: tmp
|
||||
PSBRSB_DEBUG('')
|
||||
call b%mv_to_coo(tmp,info)
|
||||
call a%mv_from_coo(tmp,info)
|
||||
end subroutine psb_c_rsb_mv_from
|
||||
|
||||
|
||||
#endif
|
||||
end module psb_c_rsb_mat_mod
|
||||
@ -0,0 +1,839 @@
|
||||
module rsb_c_mod
|
||||
use iso_c_binding
|
||||
|
||||
! 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&
|
||||
&()&
|
||||
&bind(c,name='rsb_was_initialized')
|
||||
use iso_c_binding
|
||||
end function rsb_was_initialized
|
||||
end interface
|
||||
|
||||
interface
|
||||
integer(c_int) function &
|
||||
&rsb_exit&
|
||||
&()&
|
||||
&bind(c,name='rsb_exit')
|
||||
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&
|
||||
&(VA,IA,JA,nnz,typecode,m,k,Mb,Kb,flags,errvalp)&
|
||||
&bind(c,name='rsb_allocate_rsb_sparse_matrix_from_csr_const')
|
||||
use iso_c_binding
|
||||
complex(c_float) :: 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_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
|
||||
complex(c_float) :: 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&
|
||||
&(VA,IA,JA,nnz,typecode,m,k,Mb,Kb,flags,errvalp)&
|
||||
&bind(c,name='rsb_allocate_rsb_sparse_matrix_const')
|
||||
use iso_c_binding
|
||||
complex(c_float) :: 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_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
|
||||
complex(c_float) :: 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
|
||||
type(c_ptr) function &
|
||||
&rsb_free_sparse_matrix&
|
||||
&(matrix)&
|
||||
&bind(c,name='rsb_free_sparse_matrix')
|
||||
use iso_c_binding
|
||||
type(c_ptr), value :: matrix
|
||||
end function rsb_free_sparse_matrix
|
||||
end interface
|
||||
|
||||
interface
|
||||
type(c_ptr) function &
|
||||
&rsb_clone&
|
||||
&(matrix)&
|
||||
&bind(c,name='rsb_clone')
|
||||
use iso_c_binding
|
||||
type(c_ptr), value :: matrix
|
||||
end function rsb_clone
|
||||
end interface
|
||||
|
||||
interface
|
||||
integer(c_int) function &
|
||||
&rsb_spmv&
|
||||
&(transa,alphap,matrix,x,incx,betap,y,incy)&
|
||||
&bind(c,name='rsb_spmv')
|
||||
use iso_c_binding
|
||||
integer(c_int), value :: transa
|
||||
complex(c_float) :: alphap
|
||||
type(c_ptr), value :: matrix
|
||||
complex(c_float) :: x(*)
|
||||
integer(c_int), value :: incx
|
||||
complex(c_float) :: betap
|
||||
complex(c_float) :: y(*)
|
||||
integer(c_int), value :: incy
|
||||
end function rsb_spmv
|
||||
end interface
|
||||
|
||||
interface
|
||||
integer(c_int) function &
|
||||
&rsb_spmv_nt&
|
||||
&(alphap,matrix,x1,x2,incx,betap,y1,y2,incy)&
|
||||
&bind(c,name='rsb_spmv_nt')
|
||||
use iso_c_binding
|
||||
complex(c_float) :: alphap
|
||||
type(c_ptr), value :: matrix
|
||||
complex(c_float) :: x1(*)
|
||||
complex(c_float) :: x2(*)
|
||||
integer(c_int), value :: incx
|
||||
complex(c_float) :: betap
|
||||
complex(c_float) :: y1(*)
|
||||
complex(c_float) :: y2(*)
|
||||
integer(c_int), value :: incy
|
||||
end function rsb_spmv_nt
|
||||
end interface
|
||||
|
||||
interface
|
||||
integer(c_int) function &
|
||||
&rsb_spmv_ata&
|
||||
&(alphap,matrix,x,incx,betap,y,incy)&
|
||||
&bind(c,name='rsb_spmv_ata')
|
||||
use iso_c_binding
|
||||
complex(c_float) :: alphap
|
||||
type(c_ptr), value :: matrix
|
||||
complex(c_float) :: x(*)
|
||||
integer(c_int), value :: incx
|
||||
complex(c_float) :: betap
|
||||
complex(c_float) :: y(*)
|
||||
integer(c_int), value :: incy
|
||||
end function rsb_spmv_ata
|
||||
end interface
|
||||
|
||||
interface
|
||||
integer(c_int) function &
|
||||
&rsb_spmv_power&
|
||||
&(transa,alphap,matrix,exp,x,incx,betap,y,incy)&
|
||||
&bind(c,name='rsb_spmv_power')
|
||||
use iso_c_binding
|
||||
integer(c_int), value :: transa
|
||||
complex(c_float) :: alphap
|
||||
type(c_ptr), value :: matrix
|
||||
integer(c_int), value :: exp
|
||||
complex(c_float) :: x(*)
|
||||
integer(c_int), value :: incx
|
||||
complex(c_float) :: betap
|
||||
complex(c_float) :: y(*)
|
||||
integer(c_int), value :: incy
|
||||
end function rsb_spmv_power
|
||||
end interface
|
||||
|
||||
interface
|
||||
integer(c_int) function &
|
||||
&rsb_spmm&
|
||||
&(transa,alphap,matrix,nrhs,order,b,ldb,betap,c,ldc)&
|
||||
&bind(c,name='rsb_spmm')
|
||||
use iso_c_binding
|
||||
integer(c_int), value :: transa
|
||||
complex(c_float) :: alphap
|
||||
type(c_ptr), value :: matrix
|
||||
integer(c_int), value :: nrhs
|
||||
integer(c_int), value :: order
|
||||
complex(c_float) :: b(*)
|
||||
integer(c_int), value :: ldb
|
||||
complex(c_float) :: betap
|
||||
complex(c_float) :: c(*)
|
||||
integer(c_int), value :: ldc
|
||||
end function rsb_spmm
|
||||
end interface
|
||||
|
||||
interface
|
||||
integer(c_int) function &
|
||||
&rsb_spsv&
|
||||
&(trans,alphap,matrix,x,incx,y,incy)&
|
||||
&bind(c,name='rsb_spsv')
|
||||
use iso_c_binding
|
||||
integer(c_int), value :: trans
|
||||
complex(c_float) :: alphap
|
||||
type(c_ptr), value :: matrix
|
||||
complex(c_float) :: x(*)
|
||||
integer(c_int), value :: incx
|
||||
complex(c_float) :: y(*)
|
||||
integer(c_int), value :: incy
|
||||
end function rsb_spsv
|
||||
end interface
|
||||
|
||||
interface
|
||||
integer(c_int) function &
|
||||
&rsb_spsm&
|
||||
&(trans,alphap,matrix,nrhs,order,betap,b,ldb,c,ldc)&
|
||||
&bind(c,name='rsb_spsm')
|
||||
use iso_c_binding
|
||||
integer(c_int), value :: trans
|
||||
complex(c_float) :: alphap
|
||||
type(c_ptr), value :: matrix
|
||||
integer(c_int), value :: nrhs
|
||||
integer(c_int), value :: order
|
||||
complex(c_float) :: betap
|
||||
complex(c_float) :: b(*)
|
||||
integer(c_int), value :: ldb
|
||||
complex(c_float) :: c(*)
|
||||
integer(c_int), value :: ldc
|
||||
end function rsb_spsm
|
||||
end interface
|
||||
|
||||
interface
|
||||
integer(c_int) function &
|
||||
&rsb_infinity_norm&
|
||||
&(matrix,infinity_norm,transa)&
|
||||
&bind(c,name='rsb_infinity_norm')
|
||||
use iso_c_binding
|
||||
type(c_ptr), value :: matrix
|
||||
complex(c_float) :: infinity_norm(*)
|
||||
integer(c_int), value :: transa
|
||||
end function rsb_infinity_norm
|
||||
end interface
|
||||
|
||||
interface
|
||||
integer(c_int) function &
|
||||
&rsb_one_norm&
|
||||
&(matrix,one_norm,transa)&
|
||||
&bind(c,name='rsb_one_norm')
|
||||
use iso_c_binding
|
||||
type(c_ptr), value :: matrix
|
||||
complex(c_float) :: one_norm(*)
|
||||
integer(c_int), value :: transa
|
||||
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
|
||||
complex(c_float) :: 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
|
||||
complex(c_float) :: d(*)
|
||||
end function rsb_columns_sums
|
||||
end interface
|
||||
|
||||
interface
|
||||
integer(c_int) function &
|
||||
&rsb_absolute_rows_sums&
|
||||
&(matrix,d)&
|
||||
&bind(c,name='rsb_absolute_rows_sums')
|
||||
use iso_c_binding
|
||||
type(c_ptr), value :: matrix
|
||||
complex(c_float) :: d(*)
|
||||
end function rsb_absolute_rows_sums
|
||||
end interface
|
||||
|
||||
interface
|
||||
integer(c_int) function &
|
||||
&rsb_absolute_columns_sums&
|
||||
&(matrix,d)&
|
||||
&bind(c,name='rsb_absolute_columns_sums')
|
||||
use iso_c_binding
|
||||
type(c_ptr), value :: matrix
|
||||
complex(c_float) :: d(*)
|
||||
end function rsb_absolute_columns_sums
|
||||
end interface
|
||||
|
||||
interface
|
||||
integer(c_int) function &
|
||||
&rsb_matrix_add_to_dense&
|
||||
&(matrixa,alphap,transa,matrixb,ldb,nr,nc,rowmajor)&
|
||||
&bind(c,name='rsb_matrix_add_to_dense')
|
||||
use iso_c_binding
|
||||
type(c_ptr), value :: matrixa
|
||||
complex(c_float) :: alphap
|
||||
integer(c_int), value :: transa
|
||||
type(c_ptr), value :: matrixb
|
||||
integer(c_int), value :: ldb
|
||||
integer(c_int), value :: nr
|
||||
integer(c_int), value :: nc
|
||||
integer(c_int), value :: rowmajor
|
||||
end function rsb_matrix_add_to_dense
|
||||
end interface
|
||||
|
||||
interface
|
||||
type(c_ptr) function &
|
||||
&rsb_matrix_sum&
|
||||
&(transa,alphap,matrixa,transb,betap,matrixb,errvalp)&
|
||||
&bind(c,name='rsb_matrix_sum')
|
||||
use iso_c_binding
|
||||
integer(c_int), value :: transa
|
||||
complex(c_float) :: alphap
|
||||
type(c_ptr), value :: matrixa
|
||||
integer(c_int), value :: transb
|
||||
complex(c_float) :: betap
|
||||
type(c_ptr), value :: matrixb
|
||||
integer(c_int) :: errvalp
|
||||
end function rsb_matrix_sum
|
||||
end interface
|
||||
|
||||
interface
|
||||
type(c_ptr) function &
|
||||
&rsb_matrix_mul&
|
||||
&(transa,alphap,matrixa,transb,betap,matrixb,errvalp)&
|
||||
&bind(c,name='rsb_matrix_mul')
|
||||
use iso_c_binding
|
||||
integer(c_int), value :: transa
|
||||
complex(c_float) :: alphap
|
||||
type(c_ptr), value :: matrixa
|
||||
integer(c_int), value :: transb
|
||||
complex(c_float) :: betap
|
||||
type(c_ptr), value :: matrixb
|
||||
integer(c_int) :: errvalp
|
||||
end function rsb_matrix_mul
|
||||
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
|
||||
complex(c_float) :: 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_column_major&
|
||||
&(VA,IA,JA,nnz,m,k,typecode,flags)&
|
||||
&bind(c,name='rsb_util_sort_column_major')
|
||||
use iso_c_binding
|
||||
complex(c_float) :: 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_column_major
|
||||
end interface
|
||||
|
||||
interface
|
||||
integer(c_int) function &
|
||||
&rsb_switch_rsb_matrix_to_coo_unsorted&
|
||||
&(matrix,VAP,IAP,JAP,flags)&
|
||||
&bind(c,name='rsb_switch_rsb_matrix_to_coo_unsorted')
|
||||
use iso_c_binding
|
||||
type(c_ptr), value :: matrix
|
||||
type(c_ptr), value :: VAP
|
||||
integer(c_int) :: IAP(*)
|
||||
integer(c_int) :: JAP(*)
|
||||
integer(c_int), value :: flags
|
||||
end function rsb_switch_rsb_matrix_to_coo_unsorted
|
||||
end interface
|
||||
|
||||
interface
|
||||
integer(c_int) function &
|
||||
&rsb_switch_rsb_matrix_to_coo_sorted&
|
||||
&(matrix,VAP,IAP,JAP,flags)&
|
||||
&bind(c,name='rsb_switch_rsb_matrix_to_coo_sorted')
|
||||
use iso_c_binding
|
||||
type(c_ptr), value :: matrix
|
||||
type(c_ptr), value :: VAP
|
||||
integer(c_int) :: IAP(*)
|
||||
integer(c_int) :: JAP(*)
|
||||
integer(c_int), value :: flags
|
||||
end function rsb_switch_rsb_matrix_to_coo_sorted
|
||||
end interface
|
||||
|
||||
interface
|
||||
integer(c_int) function &
|
||||
&rsb_switch_rsb_matrix_to_csr_sorted&
|
||||
&(matrix,VAP,IAP,JAP,flags)&
|
||||
&bind(c,name='rsb_switch_rsb_matrix_to_csr_sorted')
|
||||
use iso_c_binding
|
||||
type(c_ptr), value :: matrix
|
||||
type(c_ptr), value :: VAP
|
||||
integer(c_int) :: IAP(*)
|
||||
integer(c_int) :: JAP(*)
|
||||
integer(c_int), value :: flags
|
||||
end function rsb_switch_rsb_matrix_to_csr_sorted
|
||||
end interface
|
||||
|
||||
interface
|
||||
integer(c_int) function &
|
||||
&rsb_get_coo&
|
||||
&(matrix,VA,IA,JA,flags)&
|
||||
&bind(c,name='rsb_get_coo')
|
||||
use iso_c_binding
|
||||
type(c_ptr), value :: matrix
|
||||
complex(c_float) :: VA(*)
|
||||
integer(c_int) :: IA(*)
|
||||
integer(c_int) :: JA(*)
|
||||
integer(c_int), value :: flags
|
||||
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
|
||||
complex(c_float) :: 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_getdiag&
|
||||
&(matrix,diagonal)&
|
||||
&bind(c,name='rsb_getdiag')
|
||||
use iso_c_binding
|
||||
type(c_ptr), value :: matrix
|
||||
complex(c_float) :: diagonal(*)
|
||||
end function rsb_getdiag
|
||||
end interface
|
||||
|
||||
interface
|
||||
integer(c_int) function &
|
||||
&rsb_get_rows_sparse&
|
||||
&(matrix,VA,fr,lr,IA,JA,rnz,alphap,trans,flags)&
|
||||
&bind(c,name='rsb_get_rows_sparse')
|
||||
use iso_c_binding
|
||||
type(c_ptr), value :: matrix
|
||||
complex(c_float) :: VA(*)
|
||||
integer(c_int), value :: fr
|
||||
integer(c_int), value :: lr
|
||||
integer(c_int) :: IA(*)
|
||||
integer(c_int) :: JA(*)
|
||||
integer(c_int) :: rnz
|
||||
complex(c_float) :: alphap
|
||||
integer(c_int), value :: trans
|
||||
integer(c_int), value :: flags
|
||||
end function rsb_get_rows_sparse
|
||||
end interface
|
||||
|
||||
interface
|
||||
integer(c_int) function &
|
||||
&rsb_get_block_sparse_pattern&
|
||||
&(matrix,fr,lr,fc,lc,IA,JA,IREN,JREN,rnz,flags)&
|
||||
&bind(c,name='rsb_get_block_sparse_pattern')
|
||||
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) :: IA(*)
|
||||
integer(c_int) :: JA(*)
|
||||
type(c_ptr), value :: IREN
|
||||
type(c_ptr), value :: JREN
|
||||
integer(c_int) :: rnz
|
||||
integer(c_int), value :: flags
|
||||
end function rsb_get_block_sparse_pattern
|
||||
end interface
|
||||
|
||||
interface
|
||||
integer(c_int) function &
|
||||
&rsb_get_block_sparse&
|
||||
&(matrix,VA,fr,lr,fc,lc,IA,JA,IREN,JREN,rnz,flags)&
|
||||
&bind(c,name='rsb_get_block_sparse')
|
||||
use iso_c_binding
|
||||
type(c_ptr), value :: matrix
|
||||
complex(c_float) :: VA(*)
|
||||
integer(c_int), value :: fr
|
||||
integer(c_int), value :: lr
|
||||
integer(c_int), value :: fc
|
||||
integer(c_int), value :: lc
|
||||
integer(c_int) :: IA(*)
|
||||
integer(c_int) :: JA(*)
|
||||
type(c_ptr), value :: IREN
|
||||
type(c_ptr), value :: JREN
|
||||
integer(c_int) :: rnz
|
||||
integer(c_int), value :: flags
|
||||
end function rsb_get_block_sparse
|
||||
end interface
|
||||
|
||||
interface
|
||||
integer(c_int) function &
|
||||
&rsb_get_columns_sparse&
|
||||
&(matrix,VA,fc,lc,IA,JA,rnz,flags)&
|
||||
&bind(c,name='rsb_get_columns_sparse')
|
||||
use iso_c_binding
|
||||
type(c_ptr), value :: matrix
|
||||
complex(c_float) :: VA(*)
|
||||
integer(c_int), value :: fc
|
||||
integer(c_int), value :: lc
|
||||
integer(c_int) :: IA(*)
|
||||
integer(c_int) :: JA(*)
|
||||
integer(c_int) :: rnz
|
||||
integer(c_int), value :: flags
|
||||
end function rsb_get_columns_sparse
|
||||
end interface
|
||||
|
||||
interface
|
||||
integer(c_int) function &
|
||||
&rsb_get_matrix_nnz&
|
||||
&(matrix)&
|
||||
&bind(c,name='rsb_get_matrix_nnz')
|
||||
use iso_c_binding
|
||||
type(c_ptr), value :: matrix
|
||||
end function rsb_get_matrix_nnz
|
||||
end interface
|
||||
|
||||
interface
|
||||
integer(c_int) function &
|
||||
&rsb_get_matrix_n_rows&
|
||||
&(matrix)&
|
||||
&bind(c,name='rsb_get_matrix_n_rows')
|
||||
use iso_c_binding
|
||||
type(c_ptr), value :: matrix
|
||||
end function rsb_get_matrix_n_rows
|
||||
end interface
|
||||
|
||||
interface
|
||||
integer(c_int) function &
|
||||
&rsb_get_matrix_n_columns&
|
||||
&(matrix)&
|
||||
&bind(c,name='rsb_get_matrix_n_columns')
|
||||
use iso_c_binding
|
||||
type(c_ptr), value :: matrix
|
||||
end function rsb_get_matrix_n_columns
|
||||
end interface
|
||||
|
||||
interface
|
||||
integer(c_int) function &
|
||||
&rsb_sizeof&
|
||||
&(matrix)&
|
||||
&bind(c,name='rsb_sizeof')
|
||||
use iso_c_binding
|
||||
type(c_ptr), value :: matrix
|
||||
end function rsb_sizeof
|
||||
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_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_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
|
||||
integer(c_int) function &
|
||||
&rsb_elemental_scale&
|
||||
&(matrix,alphap)&
|
||||
&bind(c,name='rsb_elemental_scale')
|
||||
use iso_c_binding
|
||||
type(c_ptr), value :: matrix
|
||||
complex(c_float) :: alphap
|
||||
end function rsb_elemental_scale
|
||||
end interface
|
||||
|
||||
interface
|
||||
integer(c_int) function &
|
||||
&rsb_elemental_scale_inv&
|
||||
&(matrix,alphap)&
|
||||
&bind(c,name='rsb_elemental_scale_inv')
|
||||
use iso_c_binding
|
||||
type(c_ptr), value :: matrix
|
||||
complex(c_float) :: alphap
|
||||
end function rsb_elemental_scale_inv
|
||||
end interface
|
||||
|
||||
interface
|
||||
integer(c_int) function &
|
||||
&rsb_elemental_pow&
|
||||
&(matrix,alphap)&
|
||||
&bind(c,name='rsb_elemental_pow')
|
||||
use iso_c_binding
|
||||
type(c_ptr), value :: matrix
|
||||
complex(c_float) :: alphap
|
||||
end function rsb_elemental_pow
|
||||
end interface
|
||||
|
||||
interface
|
||||
integer(c_int) function &
|
||||
&rsb_update_elements&
|
||||
&(matrix,VA,IA,JA,nnz,flags)&
|
||||
&bind(c,name='rsb_update_elements')
|
||||
use iso_c_binding
|
||||
type(c_ptr), value :: matrix
|
||||
complex(c_float) :: 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 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,trans)&
|
||||
&bind(c,name='rsb_scal')
|
||||
use iso_c_binding
|
||||
type(c_ptr), value :: matrix
|
||||
complex(c_float) :: d(*)
|
||||
integer(c_int), value :: trans
|
||||
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
|
||||
complex(c_float) :: 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
|
||||
integer(c_int) function &
|
||||
&rsb_psblas_trans_to_rsb_trans&
|
||||
&(trans)&
|
||||
&bind(c,name='rsb_psblas_trans_to_rsb_trans')
|
||||
use iso_c_binding
|
||||
character(c_char), value :: trans
|
||||
end function rsb_psblas_trans_to_rsb_trans
|
||||
end interface
|
||||
|
||||
interface
|
||||
integer(c_int) function &
|
||||
&rsb_print_matrix_t&
|
||||
&(matrix)&
|
||||
&bind(c,name='rsb_print_matrix_t')
|
||||
use iso_c_binding
|
||||
type(c_ptr), value :: matrix
|
||||
end function rsb_print_matrix_t
|
||||
end interface
|
||||
|
||||
interface
|
||||
integer(c_int) function &
|
||||
&rsb_save_matrix_file_as_matrix_market&
|
||||
&(matrix,filename)&
|
||||
&bind(c,name='rsb_save_matrix_file_as_matrix_market')
|
||||
use iso_c_binding
|
||||
type(c_ptr), value :: matrix
|
||||
type(c_ptr), value :: filename
|
||||
end function rsb_save_matrix_file_as_matrix_market
|
||||
end interface
|
||||
|
||||
interface
|
||||
type(c_ptr) function &
|
||||
&rsb_load_matrix_file_as_matrix_market&
|
||||
&(filename,flags,typecode,errvalp)&
|
||||
&bind(c,name='rsb_load_matrix_file_as_matrix_market')
|
||||
use iso_c_binding
|
||||
type(c_ptr), value :: filename
|
||||
integer(c_int), value :: flags
|
||||
integer(c_int), value :: typecode
|
||||
integer(c_int) :: errvalp
|
||||
end function rsb_load_matrix_file_as_matrix_market
|
||||
end interface
|
||||
end module rsb_c_mod
|
||||
@ -0,0 +1,839 @@
|
||||
module rsb_c_mod
|
||||
use iso_c_binding
|
||||
|
||||
! 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&
|
||||
&()&
|
||||
&bind(c,name='rsb_was_initialized')
|
||||
use iso_c_binding
|
||||
end function rsb_was_initialized
|
||||
end interface
|
||||
|
||||
interface
|
||||
integer(c_int) function &
|
||||
&rsb_exit&
|
||||
&()&
|
||||
&bind(c,name='rsb_exit')
|
||||
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&
|
||||
&(VA,IA,JA,nnz,typecode,m,k,Mb,Kb,flags,errvalp)&
|
||||
&bind(c,name='rsb_allocate_rsb_sparse_matrix_from_csr_const')
|
||||
use iso_c_binding
|
||||
complex(c_float) :: 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_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
|
||||
complex(c_float) :: 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&
|
||||
&(VA,IA,JA,nnz,typecode,m,k,Mb,Kb,flags,errvalp)&
|
||||
&bind(c,name='rsb_allocate_rsb_sparse_matrix_const')
|
||||
use iso_c_binding
|
||||
complex(c_float) :: 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_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
|
||||
complex(c_float) :: 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
|
||||
type(c_ptr) function &
|
||||
&rsb_free_sparse_matrix&
|
||||
&(matrix)&
|
||||
&bind(c,name='rsb_free_sparse_matrix')
|
||||
use iso_c_binding
|
||||
type(c_ptr), value :: matrix
|
||||
end function rsb_free_sparse_matrix
|
||||
end interface
|
||||
|
||||
interface
|
||||
type(c_ptr) function &
|
||||
&rsb_clone&
|
||||
&(matrix)&
|
||||
&bind(c,name='rsb_clone')
|
||||
use iso_c_binding
|
||||
type(c_ptr), value :: matrix
|
||||
end function rsb_clone
|
||||
end interface
|
||||
|
||||
interface
|
||||
integer(c_int) function &
|
||||
&rsb_spmv&
|
||||
&(transa,alphap,matrix,x,incx,betap,y,incy)&
|
||||
&bind(c,name='rsb_spmv')
|
||||
use iso_c_binding
|
||||
integer(c_int), value :: transa
|
||||
complex(c_float) :: alphap
|
||||
type(c_ptr), value :: matrix
|
||||
complex(c_float) :: x(*)
|
||||
integer(c_int), value :: incx
|
||||
complex(c_float) :: betap
|
||||
complex(c_float) :: y(*)
|
||||
integer(c_int), value :: incy
|
||||
end function rsb_spmv
|
||||
end interface
|
||||
|
||||
interface
|
||||
integer(c_int) function &
|
||||
&rsb_spmv_nt&
|
||||
&(alphap,matrix,x1,x2,incx,betap,y1,y2,incy)&
|
||||
&bind(c,name='rsb_spmv_nt')
|
||||
use iso_c_binding
|
||||
complex(c_float) :: alphap
|
||||
type(c_ptr), value :: matrix
|
||||
complex(c_float) :: x1(*)
|
||||
complex(c_float) :: x2(*)
|
||||
integer(c_int), value :: incx
|
||||
complex(c_float) :: betap
|
||||
complex(c_float) :: y1(*)
|
||||
complex(c_float) :: y2(*)
|
||||
integer(c_int), value :: incy
|
||||
end function rsb_spmv_nt
|
||||
end interface
|
||||
|
||||
interface
|
||||
integer(c_int) function &
|
||||
&rsb_spmv_ata&
|
||||
&(alphap,matrix,x,incx,betap,y,incy)&
|
||||
&bind(c,name='rsb_spmv_ata')
|
||||
use iso_c_binding
|
||||
complex(c_float) :: alphap
|
||||
type(c_ptr), value :: matrix
|
||||
complex(c_float) :: x(*)
|
||||
integer(c_int), value :: incx
|
||||
complex(c_float) :: betap
|
||||
complex(c_float) :: y(*)
|
||||
integer(c_int), value :: incy
|
||||
end function rsb_spmv_ata
|
||||
end interface
|
||||
|
||||
interface
|
||||
integer(c_int) function &
|
||||
&rsb_spmv_power&
|
||||
&(transa,alphap,matrix,exp,x,incx,betap,y,incy)&
|
||||
&bind(c,name='rsb_spmv_power')
|
||||
use iso_c_binding
|
||||
integer(c_int), value :: transa
|
||||
complex(c_float) :: alphap
|
||||
type(c_ptr), value :: matrix
|
||||
integer(c_int), value :: exp
|
||||
complex(c_float) :: x(*)
|
||||
integer(c_int), value :: incx
|
||||
complex(c_float) :: betap
|
||||
complex(c_float) :: y(*)
|
||||
integer(c_int), value :: incy
|
||||
end function rsb_spmv_power
|
||||
end interface
|
||||
|
||||
interface
|
||||
integer(c_int) function &
|
||||
&rsb_spmm&
|
||||
&(transa,alphap,matrix,nrhs,order,b,ldb,betap,c,ldc)&
|
||||
&bind(c,name='rsb_spmm')
|
||||
use iso_c_binding
|
||||
integer(c_int), value :: transa
|
||||
complex(c_float) :: alphap
|
||||
type(c_ptr), value :: matrix
|
||||
integer(c_int), value :: nrhs
|
||||
integer(c_int), value :: order
|
||||
complex(c_float) :: b(*)
|
||||
integer(c_int), value :: ldb
|
||||
complex(c_float) :: betap
|
||||
complex(c_float) :: c(*)
|
||||
integer(c_int), value :: ldc
|
||||
end function rsb_spmm
|
||||
end interface
|
||||
|
||||
interface
|
||||
integer(c_int) function &
|
||||
&rsb_spsv&
|
||||
&(trans,alphap,matrix,x,incx,y,incy)&
|
||||
&bind(c,name='rsb_spsv')
|
||||
use iso_c_binding
|
||||
integer(c_int), value :: trans
|
||||
complex(c_float) :: alphap
|
||||
type(c_ptr), value :: matrix
|
||||
complex(c_float) :: x(*)
|
||||
integer(c_int), value :: incx
|
||||
complex(c_float) :: y(*)
|
||||
integer(c_int), value :: incy
|
||||
end function rsb_spsv
|
||||
end interface
|
||||
|
||||
interface
|
||||
integer(c_int) function &
|
||||
&rsb_spsm&
|
||||
&(trans,alphap,matrix,nrhs,order,betap,b,ldb,c,ldc)&
|
||||
&bind(c,name='rsb_spsm')
|
||||
use iso_c_binding
|
||||
integer(c_int), value :: trans
|
||||
complex(c_float) :: alphap
|
||||
type(c_ptr), value :: matrix
|
||||
integer(c_int), value :: nrhs
|
||||
integer(c_int), value :: order
|
||||
complex(c_float) :: betap
|
||||
complex(c_float) :: b(*)
|
||||
integer(c_int), value :: ldb
|
||||
complex(c_float) :: c(*)
|
||||
integer(c_int), value :: ldc
|
||||
end function rsb_spsm
|
||||
end interface
|
||||
|
||||
interface
|
||||
integer(c_int) function &
|
||||
&rsb_infinity_norm&
|
||||
&(matrix,infinity_norm,transa)&
|
||||
&bind(c,name='rsb_infinity_norm')
|
||||
use iso_c_binding
|
||||
type(c_ptr), value :: matrix
|
||||
complex(c_float) :: infinity_norm(*)
|
||||
integer(c_int), value :: transa
|
||||
end function rsb_infinity_norm
|
||||
end interface
|
||||
|
||||
interface
|
||||
integer(c_int) function &
|
||||
&rsb_one_norm&
|
||||
&(matrix,one_norm,transa)&
|
||||
&bind(c,name='rsb_one_norm')
|
||||
use iso_c_binding
|
||||
type(c_ptr), value :: matrix
|
||||
complex(c_float) :: one_norm(*)
|
||||
integer(c_int), value :: transa
|
||||
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
|
||||
complex(c_float) :: 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
|
||||
complex(c_float) :: d(*)
|
||||
end function rsb_columns_sums
|
||||
end interface
|
||||
|
||||
interface
|
||||
integer(c_int) function &
|
||||
&rsb_absolute_rows_sums&
|
||||
&(matrix,d)&
|
||||
&bind(c,name='rsb_absolute_rows_sums')
|
||||
use iso_c_binding
|
||||
type(c_ptr), value :: matrix
|
||||
complex(c_float) :: d(*)
|
||||
end function rsb_absolute_rows_sums
|
||||
end interface
|
||||
|
||||
interface
|
||||
integer(c_int) function &
|
||||
&rsb_absolute_columns_sums&
|
||||
&(matrix,d)&
|
||||
&bind(c,name='rsb_absolute_columns_sums')
|
||||
use iso_c_binding
|
||||
type(c_ptr), value :: matrix
|
||||
complex(c_float) :: d(*)
|
||||
end function rsb_absolute_columns_sums
|
||||
end interface
|
||||
|
||||
interface
|
||||
integer(c_int) function &
|
||||
&rsb_matrix_add_to_dense&
|
||||
&(matrixa,alphap,transa,matrixb,ldb,nr,nc,rowmajor)&
|
||||
&bind(c,name='rsb_matrix_add_to_dense')
|
||||
use iso_c_binding
|
||||
type(c_ptr), value :: matrixa
|
||||
complex(c_float) :: alphap
|
||||
integer(c_int), value :: transa
|
||||
type(c_ptr), value :: matrixb
|
||||
integer(c_int), value :: ldb
|
||||
integer(c_int), value :: nr
|
||||
integer(c_int), value :: nc
|
||||
integer(c_int), value :: rowmajor
|
||||
end function rsb_matrix_add_to_dense
|
||||
end interface
|
||||
|
||||
interface
|
||||
type(c_ptr) function &
|
||||
&rsb_matrix_sum&
|
||||
&(transa,alphap,matrixa,transb,betap,matrixb,errvalp)&
|
||||
&bind(c,name='rsb_matrix_sum')
|
||||
use iso_c_binding
|
||||
integer(c_int), value :: transa
|
||||
complex(c_float) :: alphap
|
||||
type(c_ptr), value :: matrixa
|
||||
integer(c_int), value :: transb
|
||||
complex(c_float) :: betap
|
||||
type(c_ptr), value :: matrixb
|
||||
integer(c_int) :: errvalp
|
||||
end function rsb_matrix_sum
|
||||
end interface
|
||||
|
||||
interface
|
||||
type(c_ptr) function &
|
||||
&rsb_matrix_mul&
|
||||
&(transa,alphap,matrixa,transb,betap,matrixb,errvalp)&
|
||||
&bind(c,name='rsb_matrix_mul')
|
||||
use iso_c_binding
|
||||
integer(c_int), value :: transa
|
||||
complex(c_float) :: alphap
|
||||
type(c_ptr), value :: matrixa
|
||||
integer(c_int), value :: transb
|
||||
complex(c_float) :: betap
|
||||
type(c_ptr), value :: matrixb
|
||||
integer(c_int) :: errvalp
|
||||
end function rsb_matrix_mul
|
||||
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
|
||||
complex(c_float) :: 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_column_major&
|
||||
&(VA,IA,JA,nnz,m,k,typecode,flags)&
|
||||
&bind(c,name='rsb_util_sort_column_major')
|
||||
use iso_c_binding
|
||||
complex(c_float) :: 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_column_major
|
||||
end interface
|
||||
|
||||
interface
|
||||
integer(c_int) function &
|
||||
&rsb_switch_rsb_matrix_to_coo_unsorted&
|
||||
&(matrix,VAP,IAP,JAP,flags)&
|
||||
&bind(c,name='rsb_switch_rsb_matrix_to_coo_unsorted')
|
||||
use iso_c_binding
|
||||
type(c_ptr), value :: matrix
|
||||
type(c_ptr), value :: VAP
|
||||
integer(c_int) :: IAP(*)
|
||||
integer(c_int) :: JAP(*)
|
||||
integer(c_int), value :: flags
|
||||
end function rsb_switch_rsb_matrix_to_coo_unsorted
|
||||
end interface
|
||||
|
||||
interface
|
||||
integer(c_int) function &
|
||||
&rsb_switch_rsb_matrix_to_coo_sorted&
|
||||
&(matrix,VAP,IAP,JAP,flags)&
|
||||
&bind(c,name='rsb_switch_rsb_matrix_to_coo_sorted')
|
||||
use iso_c_binding
|
||||
type(c_ptr), value :: matrix
|
||||
type(c_ptr), value :: VAP
|
||||
integer(c_int) :: IAP(*)
|
||||
integer(c_int) :: JAP(*)
|
||||
integer(c_int), value :: flags
|
||||
end function rsb_switch_rsb_matrix_to_coo_sorted
|
||||
end interface
|
||||
|
||||
interface
|
||||
integer(c_int) function &
|
||||
&rsb_switch_rsb_matrix_to_csr_sorted&
|
||||
&(matrix,VAP,IAP,JAP,flags)&
|
||||
&bind(c,name='rsb_switch_rsb_matrix_to_csr_sorted')
|
||||
use iso_c_binding
|
||||
type(c_ptr), value :: matrix
|
||||
type(c_ptr), value :: VAP
|
||||
integer(c_int) :: IAP(*)
|
||||
integer(c_int) :: JAP(*)
|
||||
integer(c_int), value :: flags
|
||||
end function rsb_switch_rsb_matrix_to_csr_sorted
|
||||
end interface
|
||||
|
||||
interface
|
||||
integer(c_int) function &
|
||||
&rsb_get_coo&
|
||||
&(matrix,VA,IA,JA,flags)&
|
||||
&bind(c,name='rsb_get_coo')
|
||||
use iso_c_binding
|
||||
type(c_ptr), value :: matrix
|
||||
complex(c_float) :: VA(*)
|
||||
integer(c_int) :: IA(*)
|
||||
integer(c_int) :: JA(*)
|
||||
integer(c_int), value :: flags
|
||||
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
|
||||
complex(c_float) :: 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_getdiag&
|
||||
&(matrix,diagonal)&
|
||||
&bind(c,name='rsb_getdiag')
|
||||
use iso_c_binding
|
||||
type(c_ptr), value :: matrix
|
||||
complex(c_float) :: diagonal(*)
|
||||
end function rsb_getdiag
|
||||
end interface
|
||||
|
||||
interface
|
||||
integer(c_int) function &
|
||||
&rsb_get_rows_sparse&
|
||||
&(matrix,VA,fr,lr,IA,JA,rnz,alphap,trans,flags)&
|
||||
&bind(c,name='rsb_get_rows_sparse')
|
||||
use iso_c_binding
|
||||
type(c_ptr), value :: matrix
|
||||
complex(c_float) :: VA(*)
|
||||
integer(c_int), value :: fr
|
||||
integer(c_int), value :: lr
|
||||
integer(c_int) :: IA(*)
|
||||
integer(c_int) :: JA(*)
|
||||
integer(c_int) :: rnz
|
||||
complex(c_float) :: alphap
|
||||
integer(c_int), value :: trans
|
||||
integer(c_int), value :: flags
|
||||
end function rsb_get_rows_sparse
|
||||
end interface
|
||||
|
||||
interface
|
||||
integer(c_int) function &
|
||||
&rsb_get_block_sparse_pattern&
|
||||
&(matrix,fr,lr,fc,lc,IA,JA,IREN,JREN,rnz,flags)&
|
||||
&bind(c,name='rsb_get_block_sparse_pattern')
|
||||
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) :: IA(*)
|
||||
integer(c_int) :: JA(*)
|
||||
type(c_ptr), value :: IREN
|
||||
type(c_ptr), value :: JREN
|
||||
integer(c_int) :: rnz
|
||||
integer(c_int), value :: flags
|
||||
end function rsb_get_block_sparse_pattern
|
||||
end interface
|
||||
|
||||
interface
|
||||
integer(c_int) function &
|
||||
&rsb_get_block_sparse&
|
||||
&(matrix,VA,fr,lr,fc,lc,IA,JA,IREN,JREN,rnz,flags)&
|
||||
&bind(c,name='rsb_get_block_sparse')
|
||||
use iso_c_binding
|
||||
type(c_ptr), value :: matrix
|
||||
complex(c_float) :: VA(*)
|
||||
integer(c_int), value :: fr
|
||||
integer(c_int), value :: lr
|
||||
integer(c_int), value :: fc
|
||||
integer(c_int), value :: lc
|
||||
integer(c_int) :: IA(*)
|
||||
integer(c_int) :: JA(*)
|
||||
type(c_ptr), value :: IREN
|
||||
type(c_ptr), value :: JREN
|
||||
integer(c_int) :: rnz
|
||||
integer(c_int), value :: flags
|
||||
end function rsb_get_block_sparse
|
||||
end interface
|
||||
|
||||
interface
|
||||
integer(c_int) function &
|
||||
&rsb_get_columns_sparse&
|
||||
&(matrix,VA,fc,lc,IA,JA,rnz,flags)&
|
||||
&bind(c,name='rsb_get_columns_sparse')
|
||||
use iso_c_binding
|
||||
type(c_ptr), value :: matrix
|
||||
complex(c_float) :: VA(*)
|
||||
integer(c_int), value :: fc
|
||||
integer(c_int), value :: lc
|
||||
integer(c_int) :: IA(*)
|
||||
integer(c_int) :: JA(*)
|
||||
integer(c_int) :: rnz
|
||||
integer(c_int), value :: flags
|
||||
end function rsb_get_columns_sparse
|
||||
end interface
|
||||
|
||||
interface
|
||||
integer(c_int) function &
|
||||
&rsb_get_matrix_nnz&
|
||||
&(matrix)&
|
||||
&bind(c,name='rsb_get_matrix_nnz')
|
||||
use iso_c_binding
|
||||
type(c_ptr), value :: matrix
|
||||
end function rsb_get_matrix_nnz
|
||||
end interface
|
||||
|
||||
interface
|
||||
integer(c_int) function &
|
||||
&rsb_get_matrix_n_rows&
|
||||
&(matrix)&
|
||||
&bind(c,name='rsb_get_matrix_n_rows')
|
||||
use iso_c_binding
|
||||
type(c_ptr), value :: matrix
|
||||
end function rsb_get_matrix_n_rows
|
||||
end interface
|
||||
|
||||
interface
|
||||
integer(c_int) function &
|
||||
&rsb_get_matrix_n_columns&
|
||||
&(matrix)&
|
||||
&bind(c,name='rsb_get_matrix_n_columns')
|
||||
use iso_c_binding
|
||||
type(c_ptr), value :: matrix
|
||||
end function rsb_get_matrix_n_columns
|
||||
end interface
|
||||
|
||||
interface
|
||||
integer(c_int) function &
|
||||
&rsb_sizeof&
|
||||
&(matrix)&
|
||||
&bind(c,name='rsb_sizeof')
|
||||
use iso_c_binding
|
||||
type(c_ptr), value :: matrix
|
||||
end function rsb_sizeof
|
||||
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_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_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
|
||||
integer(c_int) function &
|
||||
&rsb_elemental_scale&
|
||||
&(matrix,alphap)&
|
||||
&bind(c,name='rsb_elemental_scale')
|
||||
use iso_c_binding
|
||||
type(c_ptr), value :: matrix
|
||||
complex(c_float) :: alphap
|
||||
end function rsb_elemental_scale
|
||||
end interface
|
||||
|
||||
interface
|
||||
integer(c_int) function &
|
||||
&rsb_elemental_scale_inv&
|
||||
&(matrix,alphap)&
|
||||
&bind(c,name='rsb_elemental_scale_inv')
|
||||
use iso_c_binding
|
||||
type(c_ptr), value :: matrix
|
||||
complex(c_float) :: alphap
|
||||
end function rsb_elemental_scale_inv
|
||||
end interface
|
||||
|
||||
interface
|
||||
integer(c_int) function &
|
||||
&rsb_elemental_pow&
|
||||
&(matrix,alphap)&
|
||||
&bind(c,name='rsb_elemental_pow')
|
||||
use iso_c_binding
|
||||
type(c_ptr), value :: matrix
|
||||
complex(c_float) :: alphap
|
||||
end function rsb_elemental_pow
|
||||
end interface
|
||||
|
||||
interface
|
||||
integer(c_int) function &
|
||||
&rsb_update_elements&
|
||||
&(matrix,VA,IA,JA,nnz,flags)&
|
||||
&bind(c,name='rsb_update_elements')
|
||||
use iso_c_binding
|
||||
type(c_ptr), value :: matrix
|
||||
complex(c_float) :: 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 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,trans)&
|
||||
&bind(c,name='rsb_scal')
|
||||
use iso_c_binding
|
||||
type(c_ptr), value :: matrix
|
||||
complex(c_float) :: d(*)
|
||||
integer(c_int), value :: trans
|
||||
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
|
||||
complex(c_float) :: 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
|
||||
integer(c_int) function &
|
||||
&rsb_psblas_trans_to_rsb_trans&
|
||||
&(trans)&
|
||||
&bind(c,name='rsb_psblas_trans_to_rsb_trans')
|
||||
use iso_c_binding
|
||||
character(c_char), value :: trans
|
||||
end function rsb_psblas_trans_to_rsb_trans
|
||||
end interface
|
||||
|
||||
interface
|
||||
integer(c_int) function &
|
||||
&rsb_print_matrix_t&
|
||||
&(matrix)&
|
||||
&bind(c,name='rsb_print_matrix_t')
|
||||
use iso_c_binding
|
||||
type(c_ptr), value :: matrix
|
||||
end function rsb_print_matrix_t
|
||||
end interface
|
||||
|
||||
interface
|
||||
integer(c_int) function &
|
||||
&rsb_save_matrix_file_as_matrix_market&
|
||||
&(matrix,filename)&
|
||||
&bind(c,name='rsb_save_matrix_file_as_matrix_market')
|
||||
use iso_c_binding
|
||||
type(c_ptr), value :: matrix
|
||||
type(c_ptr), value :: filename
|
||||
end function rsb_save_matrix_file_as_matrix_market
|
||||
end interface
|
||||
|
||||
interface
|
||||
type(c_ptr) function &
|
||||
&rsb_load_matrix_file_as_matrix_market&
|
||||
&(filename,flags,typecode,errvalp)&
|
||||
&bind(c,name='rsb_load_matrix_file_as_matrix_market')
|
||||
use iso_c_binding
|
||||
type(c_ptr), value :: filename
|
||||
integer(c_int), value :: flags
|
||||
integer(c_int), value :: typecode
|
||||
integer(c_int) :: errvalp
|
||||
end function rsb_load_matrix_file_as_matrix_market
|
||||
end interface
|
||||
end module rsb_c_mod
|
||||
Loading…
Reference in New Issue