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

psblas3-matasb:

Browse Source 
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.
psblas-3.3.1-1
Salvatore Filippone 10 years ago
parent f29189b92c
commit 0f0c071146
9 changed files with 233 additions and 169 deletions
Show Stats Download Patch File Download Diff File

124
base/modules/psb_base_mat_mod.f90
Unescape Escape View File

@ -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

121
base/modules/psb_d_base_mat_mod.f90
Unescape Escape View File

@ -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

43
base/modules/psb_realloc_mod.F90
Unescape Escape View File

@ -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

6
base/modules/psb_sort_mod.f90
Unescape Escape View File

@ -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

2
base/serial/impl/psb_d_csr_impl.f90
Unescape Escape View File

@ -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

76
base/serial/impl/psb_d_mat_impl.F90
Unescape Escape View File

@ -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
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
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
#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
end if
if (debug) write(psb_err_unit,*) 'Converting in-place from ',&
& a%get_fmt(),' to ',altmp%get_fmt()
if (info /= psb_success_) then
info = psb_err_alloc_dealloc_
call psb_errpush(info,name)
goto 9999
end if
call altmp%mv_from_fmt(a%a, info)
if (debug) write(psb_err_unit,*) 'Converting in-place from ',&
& a%get_fmt(),' to ',altmp%get_fmt()
if (info /= psb_success_) then
info = psb_err_from_subroutine_
call psb_errpush(info,name,a_err="mv_from")
goto 9999
end if
call altmp%mv_from_fmt(a%a, info)
call move_alloc(altmp,a%a)
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)

6
base/serial/psb_sort_impl.f90
Unescape Escape View File

@ -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

11
base/tools/psb_dspasb.f90
Unescape Escape View File

@ -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

13
base/tools/psb_dspins.f90
Unescape Escape View File

@ -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)

Write Preview
Loading…
Cancel
Save