updated the RSB routine calls according to the RSB interface at revision 1320.
psblas3-type-indexed
Michele Martone 14 years ago
parent 66cefd1e41
commit a68e558a81

@ -198,7 +198,7 @@ subroutine psb_d_rsb_csmv(alpha,a,x,beta,y,info,trans)
else else
trans_ = 'N' trans_ = 'N'
end if end if
info=d_rsb_to_psb_info(rsb_spmv(a%rsbmptr,x,y,alpha,beta,1,1,rsb_psblas_trans_to_rsb_trans(trans_))) 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_d_rsb_csmv end subroutine psb_d_rsb_csmv
subroutine psb_d_rsb_csmv_nt(alpha,a,x1,x2,beta,y1,y2,info) subroutine psb_d_rsb_csmv_nt(alpha,a,x1,x2,beta,y1,y2,info)
@ -209,13 +209,9 @@ subroutine psb_d_rsb_csmv_nt(alpha,a,x1,x2,beta,y1,y2,info)
real(psb_dpk_), intent(in) :: alpha, beta, x1(:), x2(:) real(psb_dpk_), intent(in) :: alpha, beta, x1(:), x2(:)
real(psb_dpk_), intent(inout) :: y1(:), y2(:) real(psb_dpk_), intent(inout) :: y1(:), y2(:)
integer, intent(out) :: info integer, intent(out) :: info
character, parameter :: transn='N',transt='T'
! PSBRSB_DEBUG('') ! PSBRSB_DEBUG('')
info = psb_success_ info = psb_success_
info=d_rsb_to_psb_info(rsb_spmv(a%rsbmptr,x1,y1,alpha,beta,1,1,rsb_psblas_trans_to_rsb_trans(transn))) info=d_rsb_to_psb_info(rsb_spmv_nt(alpha,a%rsbmptr,x1,x2,1,beta,y1,y2,1))
if(info.ne.psb_success_) goto 9999
info=d_rsb_to_psb_info(rsb_spmv(a%rsbmptr,x2,y2,alpha,beta,1,1,rsb_psblas_trans_to_rsb_trans(transt)))
9999 continue
return return
end subroutine psb_d_rsb_csmv_nt end subroutine psb_d_rsb_csmv_nt
@ -244,7 +240,7 @@ subroutine psb_d_rsb_cssv(alpha,a,x,beta,y,info,trans)
else else
trans_ = 'N' trans_ = 'N'
end if end if
info=d_rsb_to_psb_info(rsb_spsv(a%rsbmptr,x,y,alpha,1,1,rsb_psblas_trans_to_rsb_trans(trans_))) 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 if (info /= 0) then
i = info i = info
info = psb_err_from_subroutine_ai_ info = psb_err_from_subroutine_ai_
@ -383,7 +379,7 @@ subroutine psb_d_rsb_csmm(alpha,a,x,beta,y,info,trans)
ldx=size(x,1); ldy=size(y,1) ldx=size(x,1); ldy=size(y,1)
nc=min(size(x,2),size(y,2) ) nc=min(size(x,2),size(y,2) )
info=-1 info=-1
info=d_rsb_to_psb_info(rsb_spmm(a%rsbmptr,x,y,ldx,ldy,nc,rsb_psblas_trans_to_rsb_trans(trans_),alpha,beta,c_f_order)) 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_d_rsb_csmm end subroutine psb_d_rsb_csmm
subroutine psb_d_rsb_cssm(alpha,a,x,beta,y,info,trans) subroutine psb_d_rsb_cssm(alpha,a,x,beta,y,info,trans)
@ -406,7 +402,7 @@ subroutine psb_d_rsb_cssm(alpha,a,x,beta,y,info,trans)
ldx=size(x,1); ldy=size(y,1) ldx=size(x,1); ldy=size(y,1)
nc=min(size(x,2),size(y,2) ) nc=min(size(x,2),size(y,2) )
info=-1 info=-1
info=d_rsb_to_psb_info(rsb_spsm(a%rsbmptr,y,ldy,nc,rsb_psblas_trans_to_rsb_trans(trans_),alpha,beta,c_f_order)) info=d_rsb_to_psb_info(rsb_spsm(rsb_psblas_trans_to_rsb_trans(trans_),alpha,a%rsbmptr,nc,c_f_order,beta,y,ldy))
end subroutine end subroutine
subroutine psb_d_rsb_rowsum(d,a) subroutine psb_d_rsb_rowsum(d,a)

@ -172,34 +172,34 @@ end interface
interface interface
integer(c_int) function & integer(c_int) function &
&rsb_spmv& &rsb_spmv&
&(matrix,x,y,alphap,betap,incx,incy,transa)& &(transa,alphap,matrix,x,incx,betap,y,incy)&
&bind(c,name='rsb_spmv') &bind(c,name='rsb_spmv')
use iso_c_binding use iso_c_binding
integer(c_int), value :: transa
real(c_double) :: alphap
type(c_ptr), value :: matrix type(c_ptr), value :: matrix
real(c_double) :: x(*) real(c_double) :: x(*)
real(c_double) :: y(*)
real(c_double) :: alphap
real(c_double) :: betap
integer(c_int), value :: incx integer(c_int), value :: incx
real(c_double) :: betap
real(c_double) :: y(*)
integer(c_int), value :: incy integer(c_int), value :: incy
integer(c_int), value :: transa
end function rsb_spmv end function rsb_spmv
end interface end interface
interface interface
integer(c_int) function & integer(c_int) function &
&rsb_spmv_nt& &rsb_spmv_nt&
&(matrix,x1,x2,y1,y2,alphap,betap,incx,incy)& &(alphap,matrix,x1,x2,incx,betap,y1,y2,incy)&
&bind(c,name='rsb_spmv_nt') &bind(c,name='rsb_spmv_nt')
use iso_c_binding use iso_c_binding
type(c_ptr), value :: matrix
type(c_ptr), value :: x1
type(c_ptr), value :: x2
type(c_ptr), value :: y1
type(c_ptr), value :: y2
real(c_double) :: alphap real(c_double) :: alphap
real(c_double) :: betap type(c_ptr), value :: matrix
real(c_double) :: x1(*)
real(c_double) :: x2(*)
integer(c_int), value :: incx integer(c_int), value :: incx
real(c_double) :: betap
real(c_double) :: y1(*)
real(c_double) :: y2(*)
integer(c_int), value :: incy integer(c_int), value :: incy
end function rsb_spmv_nt end function rsb_spmv_nt
end interface end interface
@ -207,15 +207,15 @@ end interface
interface interface
integer(c_int) function & integer(c_int) function &
&rsb_spmv_ata& &rsb_spmv_ata&
&(matrix,x,y,alphap,betap,incx,incy)& &(alphap,matrix,x,incx,betap,y,incy)&
&bind(c,name='rsb_spmv_ata') &bind(c,name='rsb_spmv_ata')
use iso_c_binding use iso_c_binding
real(c_double) :: alphap
type(c_ptr), value :: matrix type(c_ptr), value :: matrix
real(c_double) :: x(*) real(c_double) :: x(*)
real(c_double) :: y(*)
real(c_double) :: alphap
real(c_double) :: betap
integer(c_int), value :: incx integer(c_int), value :: incx
real(c_double) :: betap
real(c_double) :: y(*)
integer(c_int), value :: incy integer(c_int), value :: incy
end function rsb_spmv_ata end function rsb_spmv_ata
end interface end interface
@ -223,38 +223,71 @@ end interface
interface interface
integer(c_int) function & integer(c_int) function &
&rsb_spmv_power& &rsb_spmv_power&
&(matrix,x,y,alphap,betap,incx,incy,transa,exp)& &(transa,alphap,matrix,exp,x,incx,betap,y,incy)&
&bind(c,name='rsb_spmv_power') &bind(c,name='rsb_spmv_power')
use iso_c_binding use iso_c_binding
integer(c_int), value :: transa
real(c_double) :: alphap
type(c_ptr), value :: matrix type(c_ptr), value :: matrix
integer(c_int), value :: exp
real(c_double) :: x(*) real(c_double) :: x(*)
real(c_double) :: y(*)
real(c_double) :: alphap
real(c_double) :: betap
integer(c_int), value :: incx integer(c_int), value :: incx
real(c_double) :: betap
real(c_double) :: y(*)
integer(c_int), value :: incy integer(c_int), value :: incy
integer(c_int), value :: transa
integer(c_int), value :: exp
end function rsb_spmv_power end function rsb_spmv_power
end interface end interface
interface interface
integer(c_int) function & integer(c_int) function &
&rsb_spmm& &rsb_spmm&
&(matrix,b,c,ldb,ldc,nrhs,transa,alphap,betap,order)& &(transa,alphap,matrix,nrhs,order,b,ldb,betap,c,ldc)&
&bind(c,name='rsb_spmm') &bind(c,name='rsb_spmm')
use iso_c_binding use iso_c_binding
integer(c_int), value :: transa
real(c_double) :: alphap
type(c_ptr), value :: matrix type(c_ptr), value :: matrix
integer(c_int), value :: nrhs
integer(c_int), value :: order
real(c_double) :: b(*) real(c_double) :: b(*)
real(c_double) :: c(*)
integer(c_int), value :: ldb integer(c_int), value :: ldb
real(c_double) :: betap
real(c_double) :: c(*)
integer(c_int), value :: ldc integer(c_int), value :: ldc
integer(c_int), value :: nrhs end function rsb_spmm
integer(c_int), value :: transa end interface
interface
integer(c_int) function &
&rsb_spsv&
&(transl,alphap,matrix,x,incx,y,incy)&
&bind(c,name='rsb_spsv')
use iso_c_binding
integer(c_int), value :: transl
real(c_double) :: alphap real(c_double) :: alphap
real(c_double) :: betap type(c_ptr), value :: matrix
real(c_double) :: x(*)
integer(c_int), value :: incx
real(c_double) :: y(*)
integer(c_int), value :: incy
end function rsb_spsv
end interface
interface
integer(c_int) function &
&rsb_spsm&
&(transt,alphap,matrix,nrhs,order,betap,b,ldb)&
&bind(c,name='rsb_spsm')
use iso_c_binding
integer(c_int), value :: transt
real(c_double) :: alphap
type(c_ptr), value :: matrix
integer(c_int), value :: nrhs
integer(c_int), value :: order integer(c_int), value :: order
end function rsb_spmm real(c_double) :: betap
real(c_double) :: b(*)
integer(c_int), value :: ldb
end function rsb_spsm
end interface end interface
interface interface
@ -327,52 +360,51 @@ end interface
interface interface
integer(c_int) function & integer(c_int) function &
&rsb_spsv& &rsb_matrix_add_to_dense&
&(matrix,x,y,alphap,incx,incy,transl)& &(matrixa,alphap,transa,matrixb,ldb,nr,nc,rowmajor)&
&bind(c,name='rsb_spsv') &bind(c,name='rsb_matrix_add_to_dense')
use iso_c_binding use iso_c_binding
type(c_ptr), value :: matrix type(c_ptr), value :: matrixa
real(c_double) :: x(*)
real(c_double) :: y(*)
real(c_double) :: alphap real(c_double) :: alphap
integer(c_int), value :: incx integer(c_int), value :: transa
integer(c_int), value :: incy type(c_ptr), value :: matrixb
integer(c_int), value :: transl integer(c_int), value :: ldb
end function rsb_spsv integer(c_int), value :: nr
integer(c_int), value :: nc
integer(c_int), value :: rowmajor
end function rsb_matrix_add_to_dense
end interface end interface
interface interface
integer(c_int) function & type(c_ptr) function &
&rsb_spsm& &rsb_matrix_sum&
&(matrix,b,ldb,nrhs,transt,alphap,betap,order)& &(transa,alphap,matrixa,transb,betap,matrixb,errvalp)&
&bind(c,name='rsb_spsm') &bind(c,name='rsb_matrix_sum')
use iso_c_binding use iso_c_binding
type(c_ptr), value :: matrix integer(c_int), value :: transa
real(c_double) :: b(*)
integer(c_int), value :: ldb
integer(c_int), value :: nrhs
integer(c_int), value :: transt
real(c_double) :: alphap real(c_double) :: alphap
type(c_ptr), value :: matrixa
integer(c_int), value :: transb
real(c_double) :: betap real(c_double) :: betap
integer(c_int), value :: order type(c_ptr), value :: matrixb
end function rsb_spsm integer(c_int) :: errvalp
end function rsb_matrix_sum
end interface end interface
interface interface
integer(c_int) function & type(c_ptr) function &
&rsb_matrix_add_to_dense& &rsb_matrix_mul&
&(matrixa,alphap,transa,matrixb,ldb,nr,nc,rowmajor)& &(transa,alphap,matrixa,transb,betap,matrixb,errvalp)&
&bind(c,name='rsb_matrix_add_to_dense') &bind(c,name='rsb_matrix_mul')
use iso_c_binding use iso_c_binding
type(c_ptr), value :: matrixa
real(c_double) :: alphap
integer(c_int), value :: transa integer(c_int), value :: transa
real(c_double) :: alphap
type(c_ptr), value :: matrixa
integer(c_int), value :: transb
real(c_double) :: betap
type(c_ptr), value :: matrixb type(c_ptr), value :: matrixb
integer(c_int), value :: ldb integer(c_int) :: errvalp
integer(c_int), value :: nr end function rsb_matrix_mul
integer(c_int), value :: nc
integer(c_int), value :: rowmajor
end function rsb_matrix_add_to_dense
end interface end interface
interface interface
@ -754,38 +786,6 @@ use iso_c_binding
end function rsb_update_elements end function rsb_update_elements
end interface end interface
interface
type(c_ptr) function &
&rsb_matrix_sum&
&(matrixa,alphap,transa,matrixb,betap,transb,errvalp)&
&bind(c,name='rsb_matrix_sum')
use iso_c_binding
type(c_ptr), value :: matrixa
real(c_double) :: alphap
integer(c_int), value :: transa
type(c_ptr), value :: matrixb
real(c_double) :: betap
integer(c_int), value :: transb
integer(c_int) :: errvalp
end function rsb_matrix_sum
end interface
interface
type(c_ptr) function &
&rsb_matrix_mul&
&(matrixa,alphap,transa,matrixb,betap,transb,errvalp)&
&bind(c,name='rsb_matrix_mul')
use iso_c_binding
type(c_ptr), value :: matrixa
real(c_double) :: alphap
integer(c_int), value :: transa
type(c_ptr), value :: matrixb
real(c_double) :: betap
integer(c_int), value :: transb
integer(c_int) :: errvalp
end function rsb_matrix_mul
end interface
interface interface
integer(c_int) function & integer(c_int) function &
&rsb_negation& &rsb_negation&

@ -139,10 +139,10 @@ program ppde
goto 9999 goto 9999
end if end if
fname=''! added by martone !fname=''! added by martone
call a%cscnv(bm,info,type='CSR') call a%cscnv(bm,info,type='CSR')
write(fname,'(a,i2.2,a,i2.2,a)') 'mat',iam,'-',np,'.mtx' !write(fname,'(a,i2.2,a,i2.2,a)') 'mat',iam,'-',np,'.mtx'
call bm%print(fname,head='%Test sparse gen RSB') !call bm%print(fname,head='%Test sparse gen RSB')
if (iam == psb_root_) write(psb_out_unit,'("Overall matrix creation time : ",es12.5)')t2 if (iam == psb_root_) write(psb_out_unit,'("Overall matrix creation time : ",es12.5)')t2
if (iam == psb_root_) write(psb_out_unit,'(" ")') if (iam == psb_root_) write(psb_out_unit,'(" ")')
! !

Loading…
Cancel
Save