|
|
|
|
@ -3317,20 +3317,18 @@ subroutine psb_d_csr_clean_zeros(a, info)
|
|
|
|
|
call a%set_host()
|
|
|
|
|
end subroutine psb_d_csr_clean_zeros
|
|
|
|
|
|
|
|
|
|
subroutine psb_dcsrspspmm(a,b,c,info, spmm_impl_id)
|
|
|
|
|
subroutine psb_dcsrspspmm(a,b,c,info)
|
|
|
|
|
use psb_d_mat_mod
|
|
|
|
|
use psb_serial_mod, psb_protect_name => psb_dcsrspspmm
|
|
|
|
|
|
|
|
|
|
implicit none
|
|
|
|
|
|
|
|
|
|
class(psb_d_csr_sparse_mat), intent(in) :: a,b
|
|
|
|
|
type(psb_d_csr_sparse_mat), intent(out) :: c
|
|
|
|
|
integer(psb_ipk_), intent(out) :: info
|
|
|
|
|
integer(psb_ipk_), intent(in), optional :: spmm_impl_id
|
|
|
|
|
type(psb_d_csr_sparse_mat), intent(out) :: c
|
|
|
|
|
integer(psb_ipk_), intent(out) :: info
|
|
|
|
|
integer(psb_ipk_) :: ma,na,mb,nb, nzc, nza, nzb
|
|
|
|
|
character(len=20) :: name
|
|
|
|
|
integer(psb_ipk_) :: err_act
|
|
|
|
|
integer(psb_ipk_) :: spmm_impl_id_
|
|
|
|
|
name='psb_csrspspmm'
|
|
|
|
|
call psb_erractionsave(err_act)
|
|
|
|
|
info = psb_success_
|
|
|
|
|
@ -3357,17 +3355,7 @@ subroutine psb_dcsrspspmm(a,b,c,info, spmm_impl_id)
|
|
|
|
|
nzc = 2*(nza+nzb)
|
|
|
|
|
call c%allocate(ma,nb,nzc)
|
|
|
|
|
|
|
|
|
|
! Uses optional argument to choose c
|
|
|
|
|
! implementation of spmm or sets default
|
|
|
|
|
! choice if argument is missing
|
|
|
|
|
if (present(spmm_impl_id)) then
|
|
|
|
|
spmm_impl_id_ = spmm_impl_id
|
|
|
|
|
else
|
|
|
|
|
spmm_impl_id_ = 0
|
|
|
|
|
end if
|
|
|
|
|
|
|
|
|
|
! CSR matrix multiplication
|
|
|
|
|
call csr_spspmm(a,b,c,info,spmm_impl_id_)
|
|
|
|
|
call csr_spspmm(a,b,c,info)
|
|
|
|
|
|
|
|
|
|
call c%set_asb()
|
|
|
|
|
call c%set_host()
|
|
|
|
|
@ -3381,13 +3369,11 @@ subroutine psb_dcsrspspmm(a,b,c,info, spmm_impl_id)
|
|
|
|
|
|
|
|
|
|
contains
|
|
|
|
|
|
|
|
|
|
subroutine csr_spspmm(a,b,c,info,spmm_impl_id)
|
|
|
|
|
subroutine csr_spspmm(a,b,c,info)
|
|
|
|
|
implicit none
|
|
|
|
|
type(psb_d_csr_sparse_mat), intent(in) :: a,b
|
|
|
|
|
type(psb_d_csr_sparse_mat), intent(in) :: a,b
|
|
|
|
|
type(psb_d_csr_sparse_mat), intent(inout) :: c
|
|
|
|
|
! choice of spmm implementation from c code
|
|
|
|
|
integer(psb_ipk_), intent(out) :: info
|
|
|
|
|
integer(psb_ipk_), intent(in) :: spmm_impl_id
|
|
|
|
|
integer(psb_ipk_), intent(out) :: info
|
|
|
|
|
integer(psb_ipk_) :: ma,na,mb,nb
|
|
|
|
|
integer(psb_ipk_), allocatable :: irow(:), idxs(:)
|
|
|
|
|
real(psb_dpk_), allocatable :: row(:)
|
|
|
|
|
@ -3395,13 +3381,14 @@ contains
|
|
|
|
|
& nzc,nnzre, isz, ipb, irwsz, nrc, nze
|
|
|
|
|
real(psb_dpk_) :: cfb
|
|
|
|
|
|
|
|
|
|
info = psb_success_
|
|
|
|
|
ma = a%get_nrows()
|
|
|
|
|
na = a%get_ncols()
|
|
|
|
|
mb = b%get_nrows()
|
|
|
|
|
nb = b%get_ncols()
|
|
|
|
|
|
|
|
|
|
if (.true.) then
|
|
|
|
|
if (.false.) then
|
|
|
|
|
info = psb_success_
|
|
|
|
|
ma = a%get_nrows()
|
|
|
|
|
na = a%get_ncols()
|
|
|
|
|
mb = b%get_nrows()
|
|
|
|
|
nb = b%get_ncols()
|
|
|
|
|
|
|
|
|
|
nze = min(size(c%val),size(c%ja))
|
|
|
|
|
isz = max(ma,na,mb,nb)
|
|
|
|
|
call psb_realloc(isz,row,info)
|
|
|
|
|
@ -3449,20 +3436,13 @@ contains
|
|
|
|
|
|
|
|
|
|
c%irp(ma+1) = nzc
|
|
|
|
|
else
|
|
|
|
|
!! TODO :
|
|
|
|
|
! * convert psb_d_csr_sparse_mat a and b to spmat_t
|
|
|
|
|
! * choice of implementation
|
|
|
|
|
! * code interfaces for sp3mm code
|
|
|
|
|
! * call wanted interface
|
|
|
|
|
! * convert result from spmat_t to psb_d_csr_sparse_mat c
|
|
|
|
|
call dspmm(a,b,c,info,spmm_impl_id_)
|
|
|
|
|
call dspmm(a, b, c, info, 0)
|
|
|
|
|
end if
|
|
|
|
|
|
|
|
|
|
end subroutine csr_spspmm
|
|
|
|
|
|
|
|
|
|
end subroutine psb_dcsrspspmm
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
!
|
|
|
|
|
!
|
|
|
|
|
! ld version
|
|
|
|
|
|