mirror of
https://github.com/sfilippone/psblas3.git
synced 2026-10-20 04:42:08 +00:00
psblas3-matasb:
base/modules/psb_base_mat_mod.f90 base/modules/psb_d_base_mat_mod.f90 base/modules/psb_realloc_mod.F90 base/modules/psb_sort_mod.f90 base/serial/impl/psb_d_csr_impl.f90 base/serial/impl/psb_d_mat_impl.F90 base/serial/psb_sort_impl.f90 base/tools/psb_dspasb.f90 base/tools/psb_dspins.f90 Working version of sparse matrices with host/device status.
This commit is contained in:
Salvatore Filippone
@@ -180,12 +180,15 @@ module psb_base_mat_mod
|
||||
! == = =================================
|
||||
procedure, pass(a) :: get_neigh => psb_base_get_neigh
|
||||
procedure, pass(a) :: free => psb_base_free
|
||||
procedure, pass(a) :: asb => psb_base_mat_asb
|
||||
procedure, pass(a) :: trim => psb_base_trim
|
||||
procedure, pass(a) :: reinit => psb_base_reinit
|
||||
procedure, pass(a) :: allocate_mnnz => psb_base_allocate_mnnz
|
||||
procedure, pass(a) :: reallocate_nz => psb_base_reallocate_nz
|
||||
generic, public :: allocate => allocate_mnnz
|
||||
generic, public :: reallocate => reallocate_nz
|
||||
|
||||
|
||||
procedure, pass(a) :: csgetptn => psb_base_csgetptn
|
||||
generic, public :: csget => csgetptn
|
||||
procedure, pass(a) :: print => psb_base_sparse_print
|
||||
@@ -196,6 +199,19 @@ module psb_base_mat_mod
|
||||
procedure, pass(a) :: transc_1mat => psb_base_transc_1mat
|
||||
procedure, pass(a) :: transc_2mat => psb_base_transc_2mat
|
||||
generic, public :: transc => transc_1mat, transc_2mat
|
||||
! Sync: centerpiece of handling of external storage.
|
||||
! Any derived class having extra storage upon sync
|
||||
! will guarantee that both fortran/host side and
|
||||
! external side contain the same data. The base
|
||||
! version is only a placeholder.
|
||||
!
|
||||
procedure, pass(a) :: sync => psb_base_mat_sync
|
||||
procedure, pass(a) :: is_host => psb_base_mat_is_host
|
||||
procedure, pass(a) :: is_dev => psb_base_mat_is_dev
|
||||
procedure, pass(a) :: is_sync => psb_base_mat_is_sync
|
||||
procedure, pass(a) :: set_host => psb_base_mat_set_host
|
||||
procedure, pass(a) :: set_dev => psb_base_mat_set_dev
|
||||
procedure, pass(a) :: set_sync => psb_base_mat_set_sync
|
||||
|
||||
end type psb_base_sparse_mat
|
||||
|
||||
@@ -744,5 +760,113 @@ contains
|
||||
end subroutine psb_base_transc_1mat
|
||||
|
||||
|
||||
|
||||
!
|
||||
!> Function base_asb:
|
||||
!! \memberof psb_base_sparse_mat
|
||||
!! \brief Sync: base version calls sync and the set_asb.
|
||||
!!
|
||||
!
|
||||
subroutine psb_base_mat_asb(a)
|
||||
implicit none
|
||||
class(psb_base_sparse_mat), intent(inout) :: a
|
||||
|
||||
call a%sync()
|
||||
call a%set_asb()
|
||||
end subroutine psb_base_mat_asb
|
||||
!
|
||||
! The base version of SYNC & friends does nothing, it's just
|
||||
! a placeholder.
|
||||
!
|
||||
!
|
||||
!> Function base_sync:
|
||||
!! \memberof psb_base_sparse_mat
|
||||
!! \brief Sync: base version is a no-op.
|
||||
!!
|
||||
!
|
||||
subroutine psb_base_mat_sync(a)
|
||||
implicit none
|
||||
class(psb_base_sparse_mat), intent(inout) :: a
|
||||
|
||||
end subroutine psb_base_mat_sync
|
||||
|
||||
!
|
||||
!> Function base_set_host:
|
||||
!! \memberof psb_base_sparse_mat
|
||||
!! \brief Set_host: base version is a no-op.
|
||||
!!
|
||||
!
|
||||
subroutine psb_base_mat_set_host(a)
|
||||
implicit none
|
||||
class(psb_base_sparse_mat), intent(inout) :: a
|
||||
|
||||
end subroutine psb_base_mat_set_host
|
||||
|
||||
!
|
||||
!> Function base_set_dev:
|
||||
!! \memberof psb_base_sparse_mat
|
||||
!! \brief Set_dev: base version is a no-op.
|
||||
!!
|
||||
!
|
||||
subroutine psb_base_mat_set_dev(a)
|
||||
implicit none
|
||||
class(psb_base_sparse_mat), intent(inout) :: a
|
||||
|
||||
end subroutine psb_base_mat_set_dev
|
||||
|
||||
!
|
||||
!> Function base_set_sync:
|
||||
!! \memberof psb_base_sparse_mat
|
||||
!! \brief Set_sync: base version is a no-op.
|
||||
!!
|
||||
!
|
||||
subroutine psb_base_mat_set_sync(a)
|
||||
implicit none
|
||||
class(psb_base_sparse_mat), intent(inout) :: a
|
||||
|
||||
end subroutine psb_base_mat_set_sync
|
||||
|
||||
!
|
||||
!> Function base_is_dev:
|
||||
!! \memberof psb_base_sparse_mat
|
||||
!! \brief Is matrix on eaternal device .
|
||||
!!
|
||||
!
|
||||
function psb_base_mat_is_dev(a) result(res)
|
||||
implicit none
|
||||
class(psb_base_sparse_mat), intent(in) :: a
|
||||
logical :: res
|
||||
|
||||
res = .false.
|
||||
end function psb_base_mat_is_dev
|
||||
|
||||
!
|
||||
!> Function base_is_host
|
||||
!! \memberof psb_base_sparse_mat
|
||||
!! \brief Is matrix on standard memory .
|
||||
!!
|
||||
!
|
||||
function psb_base_mat_is_host(a) result(res)
|
||||
implicit none
|
||||
class(psb_base_sparse_mat), intent(in) :: a
|
||||
logical :: res
|
||||
|
||||
res = .true.
|
||||
end function psb_base_mat_is_host
|
||||
|
||||
!
|
||||
!> Function base_is_sync
|
||||
!! \memberof psb_base_sparse_mat
|
||||
!! \brief Is matrix on sync .
|
||||
!!
|
||||
!
|
||||
function psb_base_mat_is_sync(a) result(res)
|
||||
implicit none
|
||||
class(psb_base_sparse_mat), intent(in) :: a
|
||||
logical :: res
|
||||
|
||||
res = .true.
|
||||
end function psb_base_mat_is_sync
|
||||
|
||||
end module psb_base_mat_mod
|
||||
|
||||
|
||||
@@ -76,20 +76,6 @@ module psb_d_base_mat_mod
|
||||
procedure, pass(a) :: mold => psb_d_base_mold
|
||||
procedure, pass(a) :: clone => psb_d_base_clone
|
||||
procedure, pass(a) :: make_nonunit => psb_d_base_make_nonunit
|
||||
procedure, pass(a) :: asb => d_base_mat_asb
|
||||
! Sync: centerpiece of handling of external storage.
|
||||
! Any derived class having extra storage upon sync
|
||||
! will guarantee that both fortran/host side and
|
||||
! external side contain the same data. The base
|
||||
! version is only a placeholder.
|
||||
!
|
||||
procedure, pass(a) :: sync => d_base_mat_sync
|
||||
procedure, pass(a) :: is_host => d_base_mat_is_host
|
||||
procedure, pass(a) :: is_dev => d_base_mat_is_dev
|
||||
procedure, pass(a) :: is_sync => d_base_mat_is_sync
|
||||
procedure, pass(a) :: set_host => d_base_mat_set_host
|
||||
procedure, pass(a) :: set_dev => d_base_mat_set_dev
|
||||
procedure, pass(a) :: set_sync => d_base_mat_set_sync
|
||||
|
||||
|
||||
!
|
||||
@@ -1920,113 +1906,6 @@ contains
|
||||
end subroutine d_coo_transc_1mat
|
||||
|
||||
|
||||
!
|
||||
!> Function base_asb:
|
||||
!! \memberof psb_d_base_sparse_mat
|
||||
!! \brief Sync: base version calls sync and the set_asb.
|
||||
!!
|
||||
!
|
||||
subroutine d_base_mat_asb(a)
|
||||
implicit none
|
||||
class(psb_d_base_sparse_mat), intent(inout) :: a
|
||||
|
||||
call a%sync()
|
||||
call a%set_asb()
|
||||
end subroutine d_base_mat_asb
|
||||
!
|
||||
! The base version of SYNC & friends does nothing, it's just
|
||||
! a placeholder.
|
||||
!
|
||||
!
|
||||
!> Function base_sync:
|
||||
!! \memberof psb_d_base_sparse_mat
|
||||
!! \brief Sync: base version is a no-op.
|
||||
!!
|
||||
!
|
||||
subroutine d_base_mat_sync(a)
|
||||
implicit none
|
||||
class(psb_d_base_sparse_mat), intent(inout) :: a
|
||||
|
||||
end subroutine d_base_mat_sync
|
||||
|
||||
!
|
||||
!> Function base_set_host:
|
||||
!! \memberof psb_d_base_sparse_mat
|
||||
!! \brief Set_host: base version is a no-op.
|
||||
!!
|
||||
!
|
||||
subroutine d_base_mat_set_host(a)
|
||||
implicit none
|
||||
class(psb_d_base_sparse_mat), intent(inout) :: a
|
||||
|
||||
end subroutine d_base_mat_set_host
|
||||
|
||||
!
|
||||
!> Function base_set_dev:
|
||||
!! \memberof psb_d_base_sparse_mat
|
||||
!! \brief Set_dev: base version is a no-op.
|
||||
!!
|
||||
!
|
||||
subroutine d_base_mat_set_dev(a)
|
||||
implicit none
|
||||
class(psb_d_base_sparse_mat), intent(inout) :: a
|
||||
|
||||
end subroutine d_base_mat_set_dev
|
||||
|
||||
!
|
||||
!> Function base_set_sync:
|
||||
!! \memberof psb_d_base_sparse_mat
|
||||
!! \brief Set_sync: base version is a no-op.
|
||||
!!
|
||||
!
|
||||
subroutine d_base_mat_set_sync(a)
|
||||
implicit none
|
||||
class(psb_d_base_sparse_mat), intent(inout) :: a
|
||||
|
||||
end subroutine d_base_mat_set_sync
|
||||
|
||||
!
|
||||
!> Function base_is_dev:
|
||||
!! \memberof psb_d_base_sparse_mat
|
||||
!! \brief Is vector on eaternal device .
|
||||
!!
|
||||
!
|
||||
function d_base_mat_is_dev(a) result(res)
|
||||
implicit none
|
||||
class(psb_d_base_sparse_mat), intent(in) :: a
|
||||
logical :: res
|
||||
|
||||
res = .false.
|
||||
end function d_base_mat_is_dev
|
||||
|
||||
!
|
||||
!> Function base_is_host
|
||||
!! \memberof psb_d_base_sparse_mat
|
||||
!! \brief Is vector on standard memory .
|
||||
!!
|
||||
!
|
||||
function d_base_mat_is_host(a) result(res)
|
||||
implicit none
|
||||
class(psb_d_base_sparse_mat), intent(in) :: a
|
||||
logical :: res
|
||||
|
||||
res = .true.
|
||||
end function d_base_mat_is_host
|
||||
|
||||
!
|
||||
!> Function base_is_sync
|
||||
!! \memberof psb_d_base_sparse_mat
|
||||
!! \brief Is vector on sync .
|
||||
!!
|
||||
!
|
||||
function d_base_mat_is_sync(a) result(res)
|
||||
implicit none
|
||||
class(psb_d_base_sparse_mat), intent(in) :: a
|
||||
logical :: res
|
||||
|
||||
res = .true.
|
||||
end function d_base_mat_is_sync
|
||||
|
||||
|
||||
|
||||
end module psb_d_base_mat_mod
|
||||
|
||||
@@ -3820,4 +3820,47 @@ Contains
|
||||
|
||||
#endif
|
||||
|
||||
|
||||
subroutine i_trans(a,at)
|
||||
implicit none
|
||||
integer(psb_ipk_) :: nr,nc
|
||||
integer(psb_ipk_) :: a(:,:)
|
||||
integer(psb_ipk_), allocatable, intent(out) :: at(:,:)
|
||||
integer(psb_ipk_) :: i,j,ib, ii
|
||||
integer(psb_ipk_), parameter :: nb=32
|
||||
|
||||
nr = size(a,1)
|
||||
nc = size(a,2)
|
||||
allocate(at(nc,nr))
|
||||
do i=1,nr,nb
|
||||
ib=min(nb,nr-i+1)
|
||||
do ii=i,i+ib-1
|
||||
do j=1,nc
|
||||
at(j,ii) = a(ii,j)
|
||||
end do
|
||||
end do
|
||||
end do
|
||||
end subroutine i_trans
|
||||
|
||||
subroutine d_trans(a,at)
|
||||
implicit none
|
||||
integer(psb_ipk_) :: nr,nc
|
||||
real(psb_dpk_) :: a(:,:)
|
||||
real(psb_dpk_), allocatable, intent(out) :: at(:,:)
|
||||
integer(psb_ipk_) :: i,j,ib, ii
|
||||
integer(psb_ipk_), parameter :: nb=32
|
||||
|
||||
nr = size(a,1)
|
||||
nc = size(a,2)
|
||||
allocate(at(nc,nr))
|
||||
do i=1,nr,nb
|
||||
ib=min(nb,nr-i+1)
|
||||
do ii=i,i+ib-1
|
||||
do j=1,nc
|
||||
at(j,ii) = a(ii,j)
|
||||
end do
|
||||
end do
|
||||
end do
|
||||
end subroutine d_trans
|
||||
|
||||
end module psb_realloc_mod
|
||||
|
||||
@@ -90,7 +90,7 @@ module psb_sort_mod
|
||||
function psb_iblsrch(key,n,v) result(ipos)
|
||||
import :: psb_ipk_
|
||||
integer(psb_ipk_) :: ipos, key, n
|
||||
integer(psb_ipk_) :: v(n)
|
||||
integer(psb_ipk_) :: v(:)
|
||||
end function psb_iblsrch
|
||||
end interface
|
||||
|
||||
@@ -98,7 +98,7 @@ module psb_sort_mod
|
||||
function psb_ibsrch(key,n,v) result(ipos)
|
||||
import :: psb_ipk_
|
||||
integer(psb_ipk_) :: ipos, key, n
|
||||
integer(psb_ipk_) :: v(n)
|
||||
integer(psb_ipk_) :: v(:)
|
||||
end function psb_ibsrch
|
||||
end interface
|
||||
|
||||
@@ -107,7 +107,7 @@ module psb_sort_mod
|
||||
import :: psb_ipk_
|
||||
implicit none
|
||||
integer(psb_ipk_) :: ipos, key, n
|
||||
integer(psb_ipk_) :: v(n)
|
||||
integer(psb_ipk_) :: v(:)
|
||||
end function psb_issrch
|
||||
end interface
|
||||
|
||||
|
||||
@@ -2459,7 +2459,7 @@ contains
|
||||
debug_level = psb_get_debug_level()
|
||||
|
||||
dupl = a%get_dupl()
|
||||
|
||||
!!$ write(0,*) 'Going through csr_srch_upd'
|
||||
if (.not.a%is_sorted()) then
|
||||
info = -4
|
||||
return
|
||||
|
||||
@@ -1300,57 +1300,57 @@ subroutine psb_d_cscnv_ip(a,info,type,mold,dupl)
|
||||
call psb_errpush(info,name,a_err='TYPE, MOLD')
|
||||
goto 9999
|
||||
end if
|
||||
if (a%is_bld()) then
|
||||
if (present(mold)) then
|
||||
|
||||
if (present(mold)) then
|
||||
|
||||
#if defined(HAVE_MOLD)
|
||||
allocate(altmp, mold=mold,stat=info)
|
||||
allocate(altmp, mold=mold,stat=info)
|
||||
#else
|
||||
call mold%mold(altmp,info)
|
||||
call mold%mold(altmp,info)
|
||||
#endif
|
||||
|
||||
else if (present(type)) then
|
||||
else if (present(type)) then
|
||||
|
||||
select case (psb_toupper(type))
|
||||
case ('CSR')
|
||||
allocate(psb_d_csr_sparse_mat :: altmp, stat=info)
|
||||
case ('COO')
|
||||
allocate(psb_d_coo_sparse_mat :: altmp, stat=info)
|
||||
case ('CSC')
|
||||
allocate(psb_d_csc_sparse_mat :: altmp, stat=info)
|
||||
case default
|
||||
info = psb_err_format_unknown_
|
||||
call psb_errpush(info,name,a_err=type)
|
||||
goto 9999
|
||||
end select
|
||||
else
|
||||
select case (psb_toupper(type))
|
||||
case ('CSR')
|
||||
allocate(psb_d_csr_sparse_mat :: altmp, stat=info)
|
||||
case ('COO')
|
||||
allocate(psb_d_coo_sparse_mat :: altmp, stat=info)
|
||||
case ('CSC')
|
||||
allocate(psb_d_csc_sparse_mat :: altmp, stat=info)
|
||||
case default
|
||||
info = psb_err_format_unknown_
|
||||
call psb_errpush(info,name,a_err=type)
|
||||
goto 9999
|
||||
end select
|
||||
else
|
||||
#if defined(HAVE_MOLD)
|
||||
allocate(altmp, mold=psb_get_mat_default(a),stat=info)
|
||||
allocate(altmp, mold=psb_get_mat_default(a),stat=info)
|
||||
#else
|
||||
mld = psb_get_mat_default(a)
|
||||
call mld%mold(altmp,info)
|
||||
mld = psb_get_mat_default(a)
|
||||
call mld%mold(altmp,info)
|
||||
#endif
|
||||
end if
|
||||
|
||||
if (info /= psb_success_) then
|
||||
info = psb_err_alloc_dealloc_
|
||||
call psb_errpush(info,name)
|
||||
goto 9999
|
||||
end if
|
||||
|
||||
if (debug) write(psb_err_unit,*) 'Converting in-place from ',&
|
||||
& a%get_fmt(),' to ',altmp%get_fmt()
|
||||
|
||||
call altmp%mv_from_fmt(a%a, info)
|
||||
|
||||
if (info /= psb_success_) then
|
||||
info = psb_err_from_subroutine_
|
||||
call psb_errpush(info,name,a_err="mv_from")
|
||||
goto 9999
|
||||
end if
|
||||
|
||||
call move_alloc(altmp,a%a)
|
||||
end if
|
||||
|
||||
if (info /= psb_success_) then
|
||||
info = psb_err_alloc_dealloc_
|
||||
call psb_errpush(info,name)
|
||||
goto 9999
|
||||
end if
|
||||
|
||||
if (debug) write(psb_err_unit,*) 'Converting in-place from ',&
|
||||
& a%get_fmt(),' to ',altmp%get_fmt()
|
||||
|
||||
call altmp%mv_from_fmt(a%a, info)
|
||||
|
||||
if (info /= psb_success_) then
|
||||
info = psb_err_from_subroutine_
|
||||
call psb_errpush(info,name,a_err="mv_from")
|
||||
goto 9999
|
||||
end if
|
||||
|
||||
call move_alloc(altmp,a%a)
|
||||
|
||||
call a%trim()
|
||||
call a%asb()
|
||||
call psb_erractionrestore(err_act)
|
||||
|
||||
@@ -102,7 +102,7 @@ function psb_iblsrch(key,n,v) result(ipos)
|
||||
use psb_sort_mod, psb_protect_name => psb_iblsrch
|
||||
implicit none
|
||||
integer(psb_ipk_) :: ipos, key, n
|
||||
integer(psb_ipk_) :: v(n)
|
||||
integer(psb_ipk_) :: v(:)
|
||||
|
||||
integer(psb_ipk_) :: lb, ub, m
|
||||
|
||||
@@ -144,7 +144,7 @@ function psb_ibsrch(key,n,v) result(ipos)
|
||||
use psb_sort_mod, psb_protect_name => psb_ibsrch
|
||||
implicit none
|
||||
integer(psb_ipk_) :: ipos, key, n
|
||||
integer(psb_ipk_) :: v(n)
|
||||
integer(psb_ipk_) :: v(:)
|
||||
|
||||
integer(psb_ipk_) :: lb, ub, m
|
||||
|
||||
@@ -170,7 +170,7 @@ function psb_issrch(key,n,v) result(ipos)
|
||||
use psb_sort_mod, psb_protect_name => psb_issrch
|
||||
implicit none
|
||||
integer(psb_ipk_) :: ipos, key, n
|
||||
integer(psb_ipk_) :: v(n)
|
||||
integer(psb_ipk_) :: v(:)
|
||||
|
||||
integer(psb_ipk_) :: i
|
||||
|
||||
|
||||
@@ -113,7 +113,16 @@ subroutine psb_dspasb(a,desc_a, info, afmt, upd, dupl, mold)
|
||||
call a%set_ncols(n_col)
|
||||
end if
|
||||
|
||||
call a%cscnv(info,type=afmt,dupl=dupl, mold=mold)
|
||||
if (a%is_bld()) then
|
||||
call a%cscnv(info,type=afmt,dupl=dupl, mold=mold)
|
||||
else if (a%is_upd()) then
|
||||
call a%asb()
|
||||
else
|
||||
info = psb_err_invalid_mat_state_
|
||||
call psb_errpush(info,name)
|
||||
goto 9999
|
||||
|
||||
end if
|
||||
|
||||
|
||||
IF (debug_level >= psb_debug_ext_) then
|
||||
|
||||
@@ -68,6 +68,7 @@ subroutine psb_dspins(nz,ia,ja,val,a,desc_a,info,rebuild,local)
|
||||
integer(psb_ipk_), parameter :: relocsz=200
|
||||
logical :: rebuild_, local_
|
||||
integer(psb_ipk_), allocatable :: ila(:),jla(:)
|
||||
real(psb_dpk_) :: t1,t2,t3,tcnv,tcsput
|
||||
integer(psb_ipk_) :: ierr(5)
|
||||
character(len=20) :: name
|
||||
|
||||
@@ -159,13 +160,17 @@ subroutine psb_dspins(nz,ia,ja,val,a,desc_a,info,rebuild,local)
|
||||
nrow = desc_a%get_local_rows()
|
||||
ncol = desc_a%get_local_cols()
|
||||
if (local_) then
|
||||
call a%csput(nz,ia,ja,val,ione,nrow,ione,ncol,info)
|
||||
t1=psb_wtime()
|
||||
call a%csput(nz,ia,ja,val,ione,nrow,ione,ncol,info)
|
||||
tcsput=psb_wtime() - t1
|
||||
tcnv=0.0
|
||||
if (info /= psb_success_) then
|
||||
info=psb_err_from_subroutine_
|
||||
call psb_errpush(info,name,a_err='a%csput')
|
||||
goto 9999
|
||||
end if
|
||||
else
|
||||
t1=psb_wtime()
|
||||
allocate(ila(nz),jla(nz),stat=info)
|
||||
if (info /= psb_success_) then
|
||||
ierr(1) = info
|
||||
@@ -176,14 +181,18 @@ subroutine psb_dspins(nz,ia,ja,val,a,desc_a,info,rebuild,local)
|
||||
|
||||
call desc_a%indxmap%g2l(ia(1:nz),ila(1:nz),info)
|
||||
call desc_a%indxmap%g2l(ja(1:nz),jla(1:nz),info)
|
||||
|
||||
t2 = psb_Wtime()
|
||||
call a%csput(nz,ila,jla,val,ione,nrow,ione,ncol,info)
|
||||
t3=psb_wtime()
|
||||
tcnv=t2-t1
|
||||
tcsput=t3-t2
|
||||
if (info /= psb_success_) then
|
||||
info=psb_err_from_subroutine_
|
||||
call psb_errpush(info,name,a_err='a%csput')
|
||||
goto 9999
|
||||
end if
|
||||
end if
|
||||
!!$ write(0,*)'SPINS times: ',tcnv,tcsput
|
||||
else
|
||||
info = psb_err_invalid_cd_state_
|
||||
call psb_errpush(info,name)
|
||||
|
||||
Reference in New Issue
Block a user