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

psblas3-trunk:

Browse Source 
bugfix: in the previous commit, the S rsb module was identical to the C one.
psblas3-type-indexed
Michele Martone 14 years ago
parent eb44238091
commit a842daac12
3 changed files with 254 additions and 254 deletions
Show Stats Download Patch File Download Diff File

4
opt/Makefile
Unescape Escape View File

@ -59,10 +59,10 @@ rsb_c_mod.f90: rsb_d_mod.f90 Makefile
$(RSBD2C) $< > $@
psb_s_rsb_mat_mod.F90: psb_d_rsb_mat_mod.F90 Makefile
$(RSBD2C) $< > $@
$(RSBD2S) $< > $@
rsb_s_mod.f90: rsb_d_mod.f90 Makefile
$(RSBD2C) $< > $@
$(RSBD2S) $< > $@
clean:

382
opt/psb_s_rsb_mat_mod.F90
Unescape Escape View File

@ -10,9 +10,9 @@
! * 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
module psb_s_rsb_mat_mod
use psb_s_base_mat_mod
use rsb_s_mod
#ifdef HAVE_LIBRSB
use iso_c_binding
#endif
@ -37,7 +37,7 @@ module psb_c_rsb_mat_mod
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
type, extends(psb_s_base_sparse_mat) :: psb_s_rsb_sparse_mat
#ifdef HAVE_LIBRSB
type(c_ptr) :: rsbmptr=c_null_ptr
contains
@ -47,46 +47,46 @@ module psb_c_rsb_mat_mod
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) :: d_csmm => psb_s_rsb_csmm
!procedure, pass(a) :: d_csmv_nt => psb_s_rsb_csmv_nt ! FIXME: a placeholder for future memory
procedure, pass(a) :: d_csmv => psb_s_rsb_csmv
procedure, pass(a) :: d_inner_cssm => psb_s_rsb_cssm
procedure, pass(a) :: d_inner_cssv => psb_s_rsb_cssv
procedure, pass(a) :: d_scals => psb_s_rsb_scals
procedure, pass(a) :: d_scal => psb_s_rsb_scal
procedure, pass(a) :: csnmi => psb_s_rsb_csnmi
procedure, pass(a) :: csnm1 => psb_s_rsb_csnm1
procedure, pass(a) :: rowsum => psb_s_rsb_rowsum
procedure, pass(a) :: arwsum => psb_s_rsb_arwsum
procedure, pass(a) :: colsum => psb_s_rsb_colsum
procedure, pass(a) :: aclsum => psb_s_rsb_aclsum
! procedure, pass(a) :: reallocate_nz => psb_s_rsb_reallocate_nz ! FIXME
! procedure, pass(a) :: allocate_mnnz => psb_s_rsb_allocate_mnnz ! FIXME
procedure, pass(a) :: cp_to_coo => psb_s_cp_rsb_to_coo
procedure, pass(a) :: cp_from_coo => psb_s_cp_rsb_from_coo
procedure, pass(a) :: cp_to_fmt => psb_s_cp_rsb_to_fmt
procedure, pass(a) :: cp_from_fmt => psb_s_cp_rsb_from_fmt
procedure, pass(a) :: mv_to_coo => psb_s_mv_rsb_to_coo
procedure, pass(a) :: mv_from_coo => psb_s_mv_rsb_from_coo
procedure, pass(a) :: mv_to_fmt => psb_s_mv_rsb_to_fmt
procedure, pass(a) :: mv_from_fmt => psb_s_mv_rsb_from_fmt
procedure, pass(a) :: csput => psb_s_rsb_csput
procedure, pass(a) :: get_diag => psb_s_rsb_get_diag
procedure, pass(a) :: csgetptn => psb_s_rsb_csgetptn
procedure, pass(a) :: d_csgetrow => psb_s_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) :: reinit => psb_s_rsb_reinit
procedure, pass(a) :: trim => psb_s_rsb_trim ! evil
procedure, pass(a) :: print => psb_s_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
procedure, pass(a) :: mold => psb_s_rsb_mold
procedure, pass(a) :: psb_s_rsb_cp_from
generic, public :: cp_from => psb_s_rsb_cp_from
procedure, pass(a) :: psb_s_rsb_mv_from
generic, public :: mv_from => psb_s_rsb_mv_from
#endif
end type psb_c_rsb_sparse_mat
end type psb_s_rsb_sparse_mat
! FIXME: complete the following
!private :: d_rsb_get_nzeros, d_rsb_get_fmt
private :: d_rsb_to_psb_info
@ -128,7 +128,7 @@ module psb_c_rsb_mat_mod
function d_rsb_get_flags(a) result(flags)
implicit none
integer :: flags
class(psb_c_base_sparse_mat), intent(in) :: a
class(psb_s_base_sparse_mat), intent(in) :: a
!PSBRSB_DEBUG('')
flags=c_def_flags
if(a%is_sorted()) flags=flags+c_srt_flags
@ -140,7 +140,7 @@ module psb_c_rsb_mat_mod
function d_rsb_get_nzeros(a) result(res)
implicit none
class(psb_c_rsb_sparse_mat), intent(in) :: a
class(psb_s_rsb_sparse_mat), intent(in) :: a
integer :: res
!PSBRSB_DEBUG('')
res=rsb_get_matrix_nnz(a%rsbmptr)
@ -148,7 +148,7 @@ module psb_c_rsb_mat_mod
function d_rsb_get_nrows(a) result(res)
implicit none
class(psb_c_rsb_sparse_mat), intent(in) :: a
class(psb_s_rsb_sparse_mat), intent(in) :: a
integer :: res
!PSBRSB_DEBUG('')
res=rsb_get_matrix_n_rows(a%rsbmptr)
@ -156,7 +156,7 @@ module psb_c_rsb_mat_mod
function d_rsb_get_ncols(a) result(res)
implicit none
class(psb_c_rsb_sparse_mat), intent(in) :: a
class(psb_s_rsb_sparse_mat), intent(in) :: a
integer :: res
!PSBRSB_DEBUG('')
res=rsb_get_matrix_n_columns(a%rsbmptr)
@ -172,7 +172,7 @@ module psb_c_rsb_mat_mod
function d_rsb_get_size(a) result(res)
implicit none
class(psb_c_rsb_sparse_mat), intent(in) :: a
class(psb_s_rsb_sparse_mat), intent(in) :: a
integer :: res
!PSBRSB_DEBUG('')
res = d_rsb_get_nzeros(a)
@ -180,17 +180,17 @@ module psb_c_rsb_mat_mod
function d_rsb_sizeof(a) result(res)
implicit none
class(psb_c_rsb_sparse_mat), intent(in) :: a
class(psb_s_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)
subroutine psb_s_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(:)
class(psb_s_rsb_sparse_mat), intent(in) :: a
real(psb_spk_), intent(in) :: alpha, beta, x(:)
real(psb_spk_), intent(inout) :: y(:)
integer, intent(out) :: info
character, optional, intent(in) :: trans
character :: trans_
@ -203,30 +203,30 @@ subroutine psb_c_rsb_csmv(alpha,a,x,beta,y,info,trans)
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
end subroutine psb_s_rsb_csmv
subroutine psb_c_rsb_csmv_nt(alpha,a,x1,x2,beta,y1,y2,info)
subroutine psb_s_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(:)
class(psb_s_rsb_sparse_mat), intent(in) :: a
real(psb_spk_), intent(in) :: alpha, beta, x1(:), x2(:)
real(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
end subroutine psb_s_rsb_csmv_nt
subroutine psb_c_rsb_cssv(alpha,a,x,beta,y,info,trans)
subroutine psb_s_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(:)
class(psb_s_rsb_sparse_mat), intent(in) :: a
real(psb_spk_), intent(in) :: alpha, beta, x(:)
real(psb_spk_), intent(inout) :: y(:)
integer, intent(out) :: info
character, optional, intent(in) :: trans
character :: trans_
@ -265,46 +265,46 @@ subroutine psb_c_rsb_cssv(alpha,a,x,beta,y,info,trans)
end if
return
end subroutine psb_c_rsb_cssv
end subroutine psb_s_rsb_cssv
subroutine psb_c_rsb_scals(d,a,info)
subroutine psb_s_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
class(psb_s_rsb_sparse_mat), intent(inout) :: a
real(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
end subroutine psb_s_rsb_scals
subroutine psb_c_rsb_scal(d,a,info)
subroutine psb_s_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(:)
class(psb_s_rsb_sparse_mat), intent(inout) :: a
real(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
end subroutine psb_s_rsb_scal
subroutine d_rsb_free(a)
implicit none
class(psb_c_rsb_sparse_mat), intent(inout) :: a
class(psb_s_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)
subroutine psb_s_rsb_trim(a)
implicit none
class(psb_c_rsb_sparse_mat), intent(inout) :: a
class(psb_s_rsb_sparse_mat), intent(inout) :: a
!PSBRSB_DEBUG('')
! FIXME: this is supposed to remain empty for RSB
end subroutine psb_c_rsb_trim
end subroutine psb_s_rsb_trim
subroutine psb_c_rsb_print(iout,a,iv,eirs,eics,head,ivr,ivc)
subroutine psb_s_rsb_print(iout,a,iv,eirs,eics,head,ivr,ivc)
integer, intent(in) :: iout
class(psb_c_rsb_sparse_mat), intent(in) :: a
class(psb_s_rsb_sparse_mat), intent(in) :: a
integer, intent(in), optional :: iv(:)
integer, intent(in), optional :: eirs,eics
character(len=*), optional :: head
@ -313,61 +313,61 @@ end subroutine psb_c_rsb_trim
PSBRSB_DEBUG('')
! FIXME: UNFINISHED
info=rsb_print_matrix_t(a%rsbmptr)
end subroutine psb_c_rsb_print
end subroutine psb_s_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(:)
subroutine psb_s_rsb_get_diag(a,d,info)
class(psb_s_rsb_sparse_mat), intent(in) :: a
real(psb_spk_), intent(out) :: d(:)
integer, intent(out) :: info
!PSBRSB_DEBUG('')
info=rsb_getdiag(a%rsbmptr,d)
end subroutine psb_c_rsb_get_diag
end subroutine psb_s_rsb_get_diag
function psb_c_rsb_csnmi(a) result(csnmi_res)
function psb_s_rsb_csnmi(a) result(csnmi_res)
implicit none
class(psb_c_rsb_sparse_mat), intent(in) :: a
class(psb_s_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)
real(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
end function psb_s_rsb_csnmi
function psb_c_rsb_csnm1(a) result(res)
function psb_s_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)
class(psb_s_rsb_sparse_mat), intent(in) :: a
real(psb_spk_) :: res
real(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
end function psb_s_rsb_csnm1
subroutine psb_c_rsb_aclsum(d,a)
subroutine psb_s_rsb_aclsum(d,a)
use psb_base_mod
class(psb_c_rsb_sparse_mat), intent(in) :: a
complex(psb_spk_), intent(out) :: d(:)
class(psb_s_rsb_sparse_mat), intent(in) :: a
real(psb_spk_), intent(out) :: d(:)
PSBRSB_DEBUG('')
info=rsb_absolute_columns_sums(a%rsbmptr,d)
end subroutine psb_c_rsb_aclsum
end subroutine psb_s_rsb_aclsum
subroutine psb_c_rsb_arwsum(d,a)
subroutine psb_s_rsb_arwsum(d,a)
use psb_base_mod
class(psb_c_rsb_sparse_mat), intent(in) :: a
complex(psb_spk_), intent(out) :: d(:)
class(psb_s_rsb_sparse_mat), intent(in) :: a
real(psb_spk_), intent(out) :: d(:)
PSBRSB_DEBUG('')
info=rsb_absolute_rows_sums(a%rsbmptr,d)
end subroutine psb_c_rsb_arwsum
end subroutine psb_s_rsb_arwsum
subroutine psb_c_rsb_csmm(alpha,a,x,beta,y,info,trans)
subroutine psb_s_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(:,:)
class(psb_s_rsb_sparse_mat), intent(in) :: a
real(psb_spk_), intent(in) :: alpha, beta, x(:,:)
real(psb_spk_), intent(inout) :: y(:,:)
integer, intent(out) :: info
character, optional, intent(in) :: trans
@ -385,14 +385,14 @@ subroutine psb_c_rsb_csmm(alpha,a,x,beta,y,info,trans)
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
end subroutine psb_s_rsb_csmm
subroutine psb_c_rsb_cssm(alpha,a,x,beta,y,info,trans)
subroutine psb_s_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(:,:)
class(psb_s_rsb_sparse_mat), intent(in) :: a
real(psb_spk_), intent(in) :: alpha, beta, x(:,:)
real(psb_spk_), intent(inout) :: y(:,:)
integer, intent(out) :: info
character, optional, intent(in) :: trans
integer :: ldy,ldx,nc
@ -410,29 +410,29 @@ subroutine psb_c_rsb_cssm(alpha,a,x,beta,y,info,trans)
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)
subroutine psb_s_rsb_rowsum(d,a)
use psb_base_mod
class(psb_c_rsb_sparse_mat), intent(in) :: a
complex(psb_spk_), intent(out) :: d(:)
class(psb_s_rsb_sparse_mat), intent(in) :: a
real(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
end subroutine psb_s_rsb_rowsum
subroutine psb_c_rsb_colsum(d,a)
subroutine psb_s_rsb_colsum(d,a)
use psb_base_mod
class(psb_c_rsb_sparse_mat), intent(in) :: a
complex(psb_spk_), intent(out) :: d(:)
class(psb_s_rsb_sparse_mat), intent(in) :: a
real(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
end subroutine psb_s_rsb_colsum
subroutine psb_c_rsb_mold(a,b,info)
subroutine psb_s_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
class(psb_s_rsb_sparse_mat), intent(in) :: a
class(psb_s_base_sparse_mat), intent(out), allocatable :: b
integer, intent(out) :: info
Integer :: err_act
character(len=20) :: name='reallocate_nz'
@ -441,7 +441,7 @@ subroutine psb_c_rsb_mold(a,b,info)
call psb_get_erraction(err_act)
allocate(psb_c_rsb_sparse_mat :: b, stat=info)
allocate(psb_s_rsb_sparse_mat :: b, stat=info)
if (info /= psb_success_) then
info = psb_err_alloc_dealloc_
@ -455,21 +455,21 @@ subroutine psb_c_rsb_mold(a,b,info)
call psb_error()
end if
return
end subroutine psb_c_rsb_mold
end subroutine psb_s_rsb_mold
subroutine psb_c_rsb_reinit(a,clear)
subroutine psb_s_rsb_reinit(a,clear)
implicit none
class(psb_c_rsb_sparse_mat), intent(inout) :: a
class(psb_s_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
end subroutine psb_s_rsb_reinit
function d_rsb_get_nz_row(idx,a) result(res)
implicit none
class(psb_c_rsb_sparse_mat), intent(in) :: a
class(psb_s_rsb_sparse_mat), intent(in) :: a
integer, intent(in) :: idx
integer :: res
integer :: info
@ -480,10 +480,10 @@ end subroutine psb_c_rsb_reinit
if(info.ne.0)res=0
end function d_rsb_get_nz_row
subroutine psb_c_cp_rsb_to_coo(a,b,info)
subroutine psb_s_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
class(psb_s_rsb_sparse_mat), intent(in) :: a
class(psb_s_coo_sparse_mat), intent(inout) :: b
integer, intent(out) :: info
integer, allocatable :: itemp(:)
@ -498,7 +498,7 @@ subroutine psb_c_cp_rsb_to_coo(a,b,info)
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)
call b%psb_s_base_sparse_mat%cp_from(a%psb_s_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())
@ -513,18 +513,18 @@ subroutine psb_c_cp_rsb_to_coo(a,b,info)
!write(*,*)a%get_nrows()
!write(*,*)a%get_ncols()
!write(*,*)a%get_nzeros()
end subroutine psb_c_cp_rsb_to_coo
end subroutine psb_s_cp_rsb_to_coo
subroutine psb_c_cp_rsb_to_fmt(a,b,info)
subroutine psb_s_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
class(psb_s_rsb_sparse_mat), intent(in) :: a
class(psb_s_base_sparse_mat), intent(inout) :: b
integer, intent(out) :: info
!locals
type(psb_c_coo_sparse_mat) :: tmp
type(psb_s_coo_sparse_mat) :: tmp
logical :: rwshr_
Integer :: nza, nr, i,j,irw, idl,err_act, nc
integer :: debug_level, debug_unit
@ -534,11 +534,11 @@ subroutine psb_c_cp_rsb_to_fmt(a,b,info)
info = psb_success_
select type (b)
type is (psb_c_coo_sparse_mat)
type is (psb_s_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: ?
type is (psb_s_rsb_sparse_mat)
call b%psb_s_base_sparse_mat%cp_from(a%psb_s_base_sparse_mat)! FIXME: ?
b%rsbmptr=rsb_clone(a%rsbmptr) ! FIXME is thi enough ?
! FIXME: error handling needed here
@ -546,14 +546,14 @@ subroutine psb_c_cp_rsb_to_fmt(a,b,info)
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
end subroutine psb_s_cp_rsb_to_fmt
subroutine psb_c_cp_rsb_from_coo(a,b,info)
subroutine psb_s_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
class(psb_s_rsb_sparse_mat), intent(inout) :: a
class(psb_s_coo_sparse_mat), intent(in) :: b
integer, intent(out) :: info
integer, allocatable :: itemp(:)
@ -568,7 +568,7 @@ subroutine psb_c_cp_rsb_from_coo(a,b,info)
flags=d_rsb_get_flags(b)
info = psb_success_
call a%psb_c_base_sparse_mat%cp_from(b%psb_c_base_sparse_mat)
call a%psb_s_base_sparse_mat%cp_from(b%psb_s_base_sparse_mat)
!write (*,*) b%val
! FIXME: and if sorted ? the process could be speeded up !
@ -576,18 +576,18 @@ subroutine psb_c_cp_rsb_from_coo(a,b,info)
&(b%val,b%ia,b%ja,b%get_nzeros(),c_d_typecode,b%get_nrows(),b%get_ncols(),1,1,flags,info)
info=d_rsb_to_psb_info(info)
! FIXME: should destroy tmp ?
end subroutine psb_c_cp_rsb_from_coo
end subroutine psb_s_cp_rsb_from_coo
subroutine psb_c_cp_rsb_from_fmt(a,b,info)
subroutine psb_s_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
class(psb_s_rsb_sparse_mat), intent(inout) :: a
class(psb_s_base_sparse_mat), intent(in) :: b
integer, intent(out) :: info
!locals
type(psb_c_coo_sparse_mat) :: tmp
type(psb_s_coo_sparse_mat) :: tmp
logical :: rwshr_
Integer :: nz, nr, i,j,irw, idl,err_act, nc
integer :: debug_level, debug_unit
@ -599,16 +599,16 @@ subroutine psb_c_cp_rsb_from_fmt(a,b,info)
flags=d_rsb_get_flags(b)
select type (b)
type is (psb_c_coo_sparse_mat)
type is (psb_s_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)
type is (psb_s_csr_sparse_mat)
call a%psb_s_base_sparse_mat%cp_from(b%psb_s_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)
type is (psb_s_rsb_sparse_mat)
call b%cp_to_fmt(a,info) ! FIXME
! FIXME: missing error handling
@ -616,19 +616,19 @@ subroutine psb_c_cp_rsb_from_fmt(a,b,info)
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
end subroutine psb_s_cp_rsb_from_fmt
subroutine psb_c_rsb_csgetrow(imin,imax,a,nz,ia,ja,val,info,&
subroutine psb_s_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
class(psb_s_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(:)
real(psb_spk_), allocatable, intent(inout) :: val(:)
integer,intent(out) :: info
logical, intent(in), optional :: append
integer, intent(in), optional :: iren(:)
@ -735,14 +735,14 @@ subroutine psb_c_rsb_csgetrow(imin,imax,a,nz,ia,ja,val,info,&
return
end if
end subroutine psb_c_rsb_csgetrow
end subroutine psb_s_rsb_csgetrow
subroutine psb_c_rsb_csgetptn(imin,imax,a,nz,ia,ja,info,&
subroutine psb_s_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
class(psb_s_rsb_sparse_mat), intent(in) :: a
integer, intent(in) :: imin,imax
integer, intent(out) :: nz
integer, allocatable, intent(inout) :: ia(:), ja(:)
@ -852,14 +852,14 @@ subroutine psb_c_rsb_csgetptn(imin,imax,a,nz,ia,ja,info,&
return
endif
end subroutine psb_c_rsb_csgetptn
end subroutine psb_s_rsb_csgetptn
subroutine psb_c_rsb_csput(nz,ia,ja,val,a,imin,imax,jmin,jmax,info,gtl)
subroutine psb_s_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(:)
class(psb_s_rsb_sparse_mat), intent(inout) :: a
real(psb_spk_), intent(in) :: val(:)
integer, intent(in) :: nz, ia(:), ja(:), imin,imax,jmin,jmax
integer, intent(out) :: info
integer, intent(in), optional :: gtl(:)
@ -874,41 +874,41 @@ subroutine psb_c_rsb_csput(nz,ia,ja,val,a,imin,imax,jmin,jmax,info,gtl)
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
end subroutine psb_s_rsb_csput
subroutine psb_c_mv_rsb_to_coo(a,b,info)
subroutine psb_s_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
class(psb_s_rsb_sparse_mat), intent(inout) :: a
class(psb_s_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 psb_s_cp_rsb_to_coo(a,b,info)
call a%free()
end subroutine psb_c_mv_rsb_to_coo
end subroutine psb_s_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
subroutine psb_s_mv_rsb_to_fmt(a,b,info)
class(psb_s_rsb_sparse_mat), intent(inout) :: a
class(psb_s_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 psb_s_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
end subroutine psb_s_mv_rsb_to_fmt
subroutine psb_c_mv_rsb_from_fmt(a,b,info)
subroutine psb_s_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
class(psb_s_rsb_sparse_mat), intent(inout) :: a
class(psb_s_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
type(psb_s_coo_sparse_mat) :: tmp
! PSBRSB_DEBUG('')
info = psb_success_
select type (b)
@ -916,13 +916,13 @@ subroutine psb_c_mv_rsb_from_fmt(a,b,info)
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
end subroutine psb_s_mv_rsb_from_fmt
subroutine psb_c_mv_rsb_from_coo(a,b,info)
subroutine psb_s_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
class(psb_s_rsb_sparse_mat), intent(inout) :: a
class(psb_s_coo_sparse_mat), intent(inout) :: b
integer, intent(out) :: info
! PSBRSB_DEBUG('')
! FIXME: should use rsb_allocate_rsb_sparse_matrix_inplace
@ -930,33 +930,33 @@ subroutine psb_c_mv_rsb_from_coo(a,b,info)
!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
end subroutine psb_s_mv_rsb_from_coo
subroutine psb_c_rsb_cp_from(a,b)
subroutine psb_s_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
class(psb_s_rsb_sparse_mat), intent(inout) :: a
type(psb_s_rsb_sparse_mat), intent(in) :: b
Integer :: info
type(psb_c_coo_sparse_mat) :: tmp
type(psb_s_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
end subroutine psb_s_rsb_cp_from
subroutine psb_c_rsb_mv_from(a,b)
subroutine psb_s_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
class(psb_s_rsb_sparse_mat), intent(inout) :: a
type(psb_s_rsb_sparse_mat), intent(inout) :: b
Integer :: info
type(psb_c_coo_sparse_mat) :: tmp
type(psb_s_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
end subroutine psb_s_rsb_mv_from
#endif
end module psb_c_rsb_mat_mod
end module psb_s_rsb_mat_mod

122
opt/rsb_s_mod.f90
Unescape Escape View File

@ -1,4 +1,4 @@
module rsb_c_mod
module rsb_s_mod
use iso_c_binding
! module constants:
@ -75,7 +75,7 @@ type(c_ptr) function &
&(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(*)
real(c_float) :: VA(*)
integer(c_int) :: IA(*)
integer(c_int) :: JA(*)
integer(c_int), value :: nnz
@ -95,7 +95,7 @@ type(c_ptr) function &
&(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(*)
real(c_float) :: VA(*)
integer(c_int) :: IA(*)
integer(c_int) :: JA(*)
integer(c_int), value :: nnz
@ -115,7 +115,7 @@ type(c_ptr) function &
&(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(*)
real(c_float) :: VA(*)
integer(c_int) :: IA(*)
integer(c_int) :: JA(*)
integer(c_int), value :: nnz
@ -135,7 +135,7 @@ type(c_ptr) function &
&(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(*)
real(c_float) :: VA(*)
integer(c_int) :: IA(*)
integer(c_int) :: JA(*)
integer(c_int), value :: nnz
@ -176,12 +176,12 @@ integer(c_int) function &
&bind(c,name='rsb_spmv')
use iso_c_binding
integer(c_int), value :: transa
complex(c_float) :: alphap
real(c_float) :: alphap
type(c_ptr), value :: matrix
complex(c_float) :: x(*)
real(c_float) :: x(*)
integer(c_int), value :: incx
complex(c_float) :: betap
complex(c_float) :: y(*)
real(c_float) :: betap
real(c_float) :: y(*)
integer(c_int), value :: incy
end function rsb_spmv
end interface
@ -192,14 +192,14 @@ integer(c_int) function &
&(alphap,matrix,x1,x2,incx,betap,y1,y2,incy)&
&bind(c,name='rsb_spmv_nt')
use iso_c_binding
complex(c_float) :: alphap
real(c_float) :: alphap
type(c_ptr), value :: matrix
complex(c_float) :: x1(*)
complex(c_float) :: x2(*)
real(c_float) :: x1(*)
real(c_float) :: x2(*)
integer(c_int), value :: incx
complex(c_float) :: betap
complex(c_float) :: y1(*)
complex(c_float) :: y2(*)
real(c_float) :: betap
real(c_float) :: y1(*)
real(c_float) :: y2(*)
integer(c_int), value :: incy
end function rsb_spmv_nt
end interface
@ -210,12 +210,12 @@ integer(c_int) function &
&(alphap,matrix,x,incx,betap,y,incy)&
&bind(c,name='rsb_spmv_ata')
use iso_c_binding
complex(c_float) :: alphap
real(c_float) :: alphap
type(c_ptr), value :: matrix
complex(c_float) :: x(*)
real(c_float) :: x(*)
integer(c_int), value :: incx
complex(c_float) :: betap
complex(c_float) :: y(*)
real(c_float) :: betap
real(c_float) :: y(*)
integer(c_int), value :: incy
end function rsb_spmv_ata
end interface
@ -227,13 +227,13 @@ integer(c_int) function &
&bind(c,name='rsb_spmv_power')
use iso_c_binding
integer(c_int), value :: transa
complex(c_float) :: alphap
real(c_float) :: alphap
type(c_ptr), value :: matrix
integer(c_int), value :: exp
complex(c_float) :: x(*)
real(c_float) :: x(*)
integer(c_int), value :: incx
complex(c_float) :: betap
complex(c_float) :: y(*)
real(c_float) :: betap
real(c_float) :: y(*)
integer(c_int), value :: incy
end function rsb_spmv_power
end interface
@ -245,14 +245,14 @@ integer(c_int) function &
&bind(c,name='rsb_spmm')
use iso_c_binding
integer(c_int), value :: transa
complex(c_float) :: alphap
real(c_float) :: alphap
type(c_ptr), value :: matrix
integer(c_int), value :: nrhs
integer(c_int), value :: order
complex(c_float) :: b(*)
real(c_float) :: b(*)
integer(c_int), value :: ldb
complex(c_float) :: betap
complex(c_float) :: c(*)
real(c_float) :: betap
real(c_float) :: c(*)
integer(c_int), value :: ldc
end function rsb_spmm
end interface
@ -264,11 +264,11 @@ integer(c_int) function &
&bind(c,name='rsb_spsv')
use iso_c_binding
integer(c_int), value :: trans
complex(c_float) :: alphap
real(c_float) :: alphap
type(c_ptr), value :: matrix
complex(c_float) :: x(*)
real(c_float) :: x(*)
integer(c_int), value :: incx
complex(c_float) :: y(*)
real(c_float) :: y(*)
integer(c_int), value :: incy
end function rsb_spsv
end interface
@ -280,14 +280,14 @@ integer(c_int) function &
&bind(c,name='rsb_spsm')
use iso_c_binding
integer(c_int), value :: trans
complex(c_float) :: alphap
real(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(*)
real(c_float) :: betap
real(c_float) :: b(*)
integer(c_int), value :: ldb
complex(c_float) :: c(*)
real(c_float) :: c(*)
integer(c_int), value :: ldc
end function rsb_spsm
end interface
@ -299,7 +299,7 @@ integer(c_int) function &
&bind(c,name='rsb_infinity_norm')
use iso_c_binding
type(c_ptr), value :: matrix
complex(c_float) :: infinity_norm(*)
real(c_float) :: infinity_norm(*)
integer(c_int), value :: transa
end function rsb_infinity_norm
end interface
@ -311,7 +311,7 @@ integer(c_int) function &
&bind(c,name='rsb_one_norm')
use iso_c_binding
type(c_ptr), value :: matrix
complex(c_float) :: one_norm(*)
real(c_float) :: one_norm(*)
integer(c_int), value :: transa
end function rsb_one_norm
end interface
@ -323,7 +323,7 @@ integer(c_int) function &
&bind(c,name='rsb_rows_sums')
use iso_c_binding
type(c_ptr), value :: matrix
complex(c_float) :: d(*)
real(c_float) :: d(*)
end function rsb_rows_sums
end interface
@ -334,7 +334,7 @@ integer(c_int) function &
&bind(c,name='rsb_columns_sums')
use iso_c_binding
type(c_ptr), value :: matrix
complex(c_float) :: d(*)
real(c_float) :: d(*)
end function rsb_columns_sums
end interface
@ -345,7 +345,7 @@ integer(c_int) function &
&bind(c,name='rsb_absolute_rows_sums')
use iso_c_binding
type(c_ptr), value :: matrix
complex(c_float) :: d(*)
real(c_float) :: d(*)
end function rsb_absolute_rows_sums
end interface
@ -356,7 +356,7 @@ integer(c_int) function &
&bind(c,name='rsb_absolute_columns_sums')
use iso_c_binding
type(c_ptr), value :: matrix
complex(c_float) :: d(*)
real(c_float) :: d(*)
end function rsb_absolute_columns_sums
end interface
@ -367,7 +367,7 @@ integer(c_int) function &
&bind(c,name='rsb_matrix_add_to_dense')
use iso_c_binding
type(c_ptr), value :: matrixa
complex(c_float) :: alphap
real(c_float) :: alphap
integer(c_int), value :: transa
type(c_ptr), value :: matrixb
integer(c_int), value :: ldb
@ -384,10 +384,10 @@ type(c_ptr) function &
&bind(c,name='rsb_matrix_sum')
use iso_c_binding
integer(c_int), value :: transa
complex(c_float) :: alphap
real(c_float) :: alphap
type(c_ptr), value :: matrixa
integer(c_int), value :: transb
complex(c_float) :: betap
real(c_float) :: betap
type(c_ptr), value :: matrixb
integer(c_int) :: errvalp
end function rsb_matrix_sum
@ -400,10 +400,10 @@ type(c_ptr) function &
&bind(c,name='rsb_matrix_mul')
use iso_c_binding
integer(c_int), value :: transa
complex(c_float) :: alphap
real(c_float) :: alphap
type(c_ptr), value :: matrixa
integer(c_int), value :: transb
complex(c_float) :: betap
real(c_float) :: betap
type(c_ptr), value :: matrixb
integer(c_int) :: errvalp
end function rsb_matrix_mul
@ -415,7 +415,7 @@ integer(c_int) function &
&(VA,IA,JA,nnz,m,k,typecode,flags)&
&bind(c,name='rsb_util_sort_row_major')
use iso_c_binding
complex(c_float) :: VA(*)
real(c_float) :: VA(*)
integer(c_int) :: IA(*)
integer(c_int) :: JA(*)
integer(c_int), value :: nnz
@ -432,7 +432,7 @@ integer(c_int) function &
&(VA,IA,JA,nnz,m,k,typecode,flags)&
&bind(c,name='rsb_util_sort_column_major')
use iso_c_binding
complex(c_float) :: VA(*)
real(c_float) :: VA(*)
integer(c_int) :: IA(*)
integer(c_int) :: JA(*)
integer(c_int), value :: nnz
@ -492,7 +492,7 @@ integer(c_int) function &
&bind(c,name='rsb_get_coo')
use iso_c_binding
type(c_ptr), value :: matrix
complex(c_float) :: VA(*)
real(c_float) :: VA(*)
integer(c_int) :: IA(*)
integer(c_int) :: JA(*)
integer(c_int), value :: flags
@ -506,7 +506,7 @@ integer(c_int) function &
&bind(c,name='rsb_get_csr')
use iso_c_binding
type(c_ptr), value :: matrix
complex(c_float) :: VA(*)
real(c_float) :: VA(*)
type(c_ptr), value :: RP
integer(c_int) :: JA(*)
integer(c_int), value :: flags
@ -520,7 +520,7 @@ integer(c_int) function &
&bind(c,name='rsb_getdiag')
use iso_c_binding
type(c_ptr), value :: matrix
complex(c_float) :: diagonal(*)
real(c_float) :: diagonal(*)
end function rsb_getdiag
end interface
@ -531,13 +531,13 @@ integer(c_int) function &
&bind(c,name='rsb_get_rows_sparse')
use iso_c_binding
type(c_ptr), value :: matrix
complex(c_float) :: VA(*)
real(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
real(c_float) :: alphap
integer(c_int), value :: trans
integer(c_int), value :: flags
end function rsb_get_rows_sparse
@ -570,7 +570,7 @@ integer(c_int) function &
&bind(c,name='rsb_get_block_sparse')
use iso_c_binding
type(c_ptr), value :: matrix
complex(c_float) :: VA(*)
real(c_float) :: VA(*)
integer(c_int), value :: fr
integer(c_int), value :: lr
integer(c_int), value :: fc
@ -591,7 +591,7 @@ integer(c_int) function &
&bind(c,name='rsb_get_columns_sparse')
use iso_c_binding
type(c_ptr), value :: matrix
complex(c_float) :: VA(*)
real(c_float) :: VA(*)
integer(c_int), value :: fc
integer(c_int), value :: lc
integer(c_int) :: IA(*)
@ -709,7 +709,7 @@ integer(c_int) function &
&bind(c,name='rsb_elemental_scale')
use iso_c_binding
type(c_ptr), value :: matrix
complex(c_float) :: alphap
real(c_float) :: alphap
end function rsb_elemental_scale
end interface
@ -720,7 +720,7 @@ integer(c_int) function &
&bind(c,name='rsb_elemental_scale_inv')
use iso_c_binding
type(c_ptr), value :: matrix
complex(c_float) :: alphap
real(c_float) :: alphap
end function rsb_elemental_scale_inv
end interface
@ -731,7 +731,7 @@ integer(c_int) function &
&bind(c,name='rsb_elemental_pow')
use iso_c_binding
type(c_ptr), value :: matrix
complex(c_float) :: alphap
real(c_float) :: alphap
end function rsb_elemental_pow
end interface
@ -742,7 +742,7 @@ integer(c_int) function &
&bind(c,name='rsb_update_elements')
use iso_c_binding
type(c_ptr), value :: matrix
complex(c_float) :: VA(*)
real(c_float) :: VA(*)
integer(c_int) :: IA(*)
integer(c_int) :: JA(*)
integer(c_int), value :: nnz
@ -767,7 +767,7 @@ integer(c_int) function &
&bind(c,name='rsb_scal')
use iso_c_binding
type(c_ptr), value :: matrix
complex(c_float) :: d(*)
real(c_float) :: d(*)
integer(c_int), value :: trans
end function rsb_scal
end interface
@ -779,7 +779,7 @@ integer(c_int) function &
&bind(c,name='rsb_scale_rows')
use iso_c_binding
type(c_ptr), value :: matrix
complex(c_float) :: d(*)
real(c_float) :: d(*)
end function rsb_scale_rows
end interface
@ -836,4 +836,4 @@ use iso_c_binding
integer(c_int) :: errvalp
end function rsb_load_matrix_file_as_matrix_market
end interface
end module rsb_c_mod
end module rsb_s_mod

Write Preview
Loading…
Cancel
Save