fdurastante/psblas3
1
0
Fork 0
mirror of https://github.com/sfilippone/psblas3.git synced 2026-10-20 12:52:14 +00:00
Code Issues Packages Projects Releases Wiki Activity

psblas3: implementing a first cp_from_fmt for rsb.

Browse Source
This commit is contained in:
Michele Martone
2010-11-07 13:24:48 +00:00
parent 9120b460e1
commit 869e57c379
2 changed files with 126 additions and 11 deletions
Download Patch File Download Diff File Expand all files Collapse all files
test/serial/psb_d_rsb_mat_mod.F03
+120 -6
View File
@@ -42,7 +42,7 @@ module psb_d_rsb_mat_mod
procedure, pass(a) :: cp_to_coo => psb_d_cp_rsb_to_coo
procedure, pass(a) :: cp_from_coo => psb_d_cp_rsb_from_coo
procedure, pass(a) :: cp_to_fmt => psb_d_cp_rsb_to_fmt
! procedure, pass(a) :: cp_from_fmt => psb_d_cp_rsb_from_fmt
procedure, pass(a) :: cp_from_fmt => psb_d_cp_rsb_from_fmt
! procedure, pass(a) :: mv_to_coo => psb_d_mv_rsb_to_coo
! procedure, pass(a) :: mv_from_coo => psb_d_mv_rsb_from_coo
! procedure, pass(a) :: mv_to_fmt => psb_d_mv_rsb_to_fmt
@@ -323,9 +323,9 @@ end subroutine psb_d_rsb_reinit
integer :: res
integer :: info
res=0
res=rsb_get_rows_nnz(a%rsbmptr,idx-1,idx-1,info)
res=rsb_get_rows_nnz(a%rsbmptr,idx,idx,c_f_index,info)
info=d_rsb_to_psb_info(info)
if(info.ne.0.0)res=0
if(info.ne.0)res=0
end function d_rsb_get_nz_row
subroutine psb_d_cp_rsb_to_coo(a,b,info)
@@ -338,7 +338,6 @@ subroutine psb_d_cp_rsb_to_coo(a,b,info)
!locals
logical :: rwshr_
Integer :: nza, nr, nc,i,j,irw, idl,err_act
Integer, Parameter :: maxtry=8
integer :: debug_level, debug_unit
character(len=20) :: name
info = psb_success_
@@ -364,7 +363,6 @@ subroutine psb_d_cp_rsb_to_fmt(a,b,info)
type(psb_d_coo_sparse_mat) :: tmp
logical :: rwshr_
Integer :: nza, nr, i,j,irw, idl,err_act, nc
Integer, Parameter :: maxtry=8
integer :: debug_level, debug_unit
character(len=20) :: name
@@ -398,7 +396,6 @@ subroutine psb_d_cp_rsb_from_coo(a,b,info)
!locals
logical :: rwshr_
Integer :: nza, nr, i,j,irw, idl,err_act, nc
Integer, Parameter :: maxtry=8
integer :: debug_level, debug_unit
character(len=20) :: name
@@ -412,7 +409,124 @@ subroutine psb_d_cp_rsb_from_coo(a,b,info)
! FIXME: should destroy tmp ?
end subroutine psb_d_cp_rsb_from_coo
subroutine psb_d_cp_rsb_from_fmt(a,b,info)
use psb_sparse_mod
implicit none
class(psb_d_rsb_sparse_mat), intent(inout) :: a
class(psb_d_base_sparse_mat), intent(in) :: b
integer, intent(out) :: info
!locals
type(psb_d_coo_sparse_mat) :: tmp
logical :: rwshr_
Integer :: nz, nr, i,j,irw, idl,err_act, nc
integer :: debug_level, debug_unit
character(len=20) :: name
info = psb_success_
select type (b)
type is (psb_d_coo_sparse_mat)
call a%cp_from_coo(b,info)
type is (psb_d_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_d_cp_rsb_from_fmt
subroutine psb_d_rsb_csgetrow(imin,imax,a,nz,ia,ja,val,info,&
& jmin,jmax,iren,append,nzin,rscale,cscale)
use psb_sparse_mod
implicit none
class(psb_d_rsb_sparse_mat), intent(in) :: a
integer, intent(in) :: imin,imax
integer, intent(out) :: nz
integer, allocatable, intent(inout) :: ia(:), ja(:)
real(psb_dpk_), 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
character(len=20) :: name='csget'
logical, parameter :: debug=.false.
! FIXME: MISSING THE HANDLING OF OPTIONS, HERE
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
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
info = psb_err_many_optional_arg_
call psb_errpush(info,name,a_err='iren (rscale.or.cscale)')
goto 9999
end if
nzin_=rsb_get_rows_nnz(a%rsbmptr,imin,imax,c_f_index,info)
! FIXME: unfinished; missing error handling ..
call psb_ensure_size(nzin_,ia,info)
if (info == psb_success_) call psb_ensure_size(nzin_,ja,info)
if (info == psb_success_) call psb_ensure_size(nzin_,val,info)
if (info /= psb_success_) return
info=d_rsb_to_psb_info(rsb_get_rows_sparse(a%rsbmptr,val,imin,imax,ia,ja,nzin_,c_f_index))
! FIXME: unfinished; missing error handling ..
9999 continue
call psb_erractionrestore(err_act)
if (err_act == psb_act_abort_) then
call psb_error()
return
end if
end subroutine psb_d_rsb_csgetrow
#endif
end module psb_d_rsb_mat_mod
test/serial/rsb_mod.f03
+6 -5
View File
@@ -594,12 +594,13 @@ end interface
interface
integer(c_int) function &
&rsb_get_rows_nnz&
&(matrix,fr,lr,errvalp)&
&(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
@@ -607,16 +608,16 @@ end interface
interface
integer(c_int) function &
&rsb_get_rows_sparse&
&(matrix,row,fr,lr,IA,JA,rnz,flags)&
&(matrix,VA,fr,lr,IA,JA,rnz,flags)&
&bind(c,name='rsb_get_rows_sparse')
use iso_c_binding
type(c_ptr), value :: matrix
type(c_ptr), value :: row
real(c_double) :: VA(*)
integer(c_int), value :: fr
integer(c_int), value :: lr
integer(c_int) :: IA(*)
integer(c_int) :: JA(*)
type(c_ptr), value :: rnz
integer(c_int) :: rnz
integer(c_int), value :: flags
end function rsb_get_rows_sparse
end interface
@@ -633,7 +634,7 @@ use iso_c_binding
integer(c_int), value :: lc
integer(c_int) :: IA(*)
integer(c_int) :: JA(*)
type(c_ptr), value :: rnz
integer(c_int) :: rnz
integer(c_int), value :: flags
end function rsb_get_columns_sparse
end interface