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_d_base_mat_mod.f90
 base/modules/psb_d_csc_mat_mod.f90
 base/modules/psb_d_csr_mat_mod.f90
 base/serial/impl/psb_d_base_mat_impl.F90
 base/serial/impl/psb_d_coo_impl.f90
 base/serial/impl/psb_d_csc_impl.f90
 base/serial/impl/psb_d_csr_impl.f90

Define csput to be a generic with two specifics, one of them with
encapsulated vectors so that it can be overloaded in the GPU.
psblas-3.3.1-1
Salvatore Filippone 11 years ago
parent 0f0c071146
commit 8b61ae96b3
7 changed files with 105 additions and 41 deletions
Show Stats Download Patch File Download Diff File

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

@ -57,7 +57,9 @@ module psb_d_base_mat_mod
!
! Data management methods: defined here, but (mostly) not implemented.
!
procedure, pass(a) :: csput => psb_d_base_csput
procedure, pass(a) :: csput_a => psb_d_base_csput_a
procedure, pass(a) :: csput_v => psb_d_base_csput_v
generic, public :: csput => csput_a, csput_v
procedure, pass(a) :: csgetrow => psb_d_base_csgetrow
procedure, pass(a) :: csgetblk => psb_d_base_csgetblk
procedure, pass(a) :: get_diag => psb_d_base_get_diag
@ -156,7 +158,7 @@ module psb_d_base_mat_mod
procedure, pass(a) :: mv_from_coo => psb_d_mv_coo_from_coo
procedure, pass(a) :: mv_to_fmt => psb_d_mv_coo_to_fmt
procedure, pass(a) :: mv_from_fmt => psb_d_mv_coo_from_fmt
procedure, pass(a) :: csput => psb_d_coo_csput
procedure, pass(a) :: csput_a => psb_d_coo_csput_a
procedure, pass(a) :: get_diag => psb_d_coo_get_diag
procedure, pass(a) :: csgetrow => psb_d_coo_csgetrow
procedure, pass(a) :: csgetptn => psb_d_coo_csgetptn
@ -255,14 +257,27 @@ module psb_d_base_mat_mod
!!
!
interface
subroutine psb_d_base_csput(nz,ia,ja,val,a,imin,imax,jmin,jmax,info,gtl)
subroutine psb_d_base_csput_a(nz,ia,ja,val,a,imin,imax,jmin,jmax,info,gtl)
import :: psb_ipk_, psb_d_base_sparse_mat, psb_dpk_
class(psb_d_base_sparse_mat), intent(inout) :: a
real(psb_dpk_), intent(in) :: val(:)
integer(psb_ipk_), intent(in) :: nz, ia(:), ja(:), imin,imax,jmin,jmax
integer(psb_ipk_), intent(out) :: info
integer(psb_ipk_), intent(in), optional :: gtl(:)
end subroutine psb_d_base_csput
end subroutine psb_d_base_csput_a
end interface
interface
subroutine psb_d_base_csput_v(nz,ia,ja,val,a,imin,imax,jmin,jmax,info,gtl)
import :: psb_ipk_, psb_d_base_sparse_mat, psb_dpk_, psb_d_base_vect_type,&
& psb_i_base_vect_type
class(psb_d_base_sparse_mat), intent(inout) :: a
class(psb_d_base_vect_type), intent(inout) :: val
class(psb_i_base_vect_type), intent(inout) :: ia, ja
integer(psb_ipk_), intent(in) :: nz, imin,imax,jmin,jmax
integer(psb_ipk_), intent(out) :: info
integer(psb_ipk_), intent(in), optional :: gtl(:)
end subroutine psb_d_base_csput_v
end interface
!
@ -1469,7 +1484,7 @@ module psb_d_base_mat_mod
!!
!
interface
subroutine psb_d_coo_csput(nz,ia,ja,val,a,imin,imax,jmin,jmax,info,gtl)
subroutine psb_d_coo_csput_a(nz,ia,ja,val,a,imin,imax,jmin,jmax,info,gtl)
import :: psb_ipk_, psb_d_coo_sparse_mat, psb_dpk_
class(psb_d_coo_sparse_mat), intent(inout) :: a
real(psb_dpk_), intent(in) :: val(:)
@ -1477,7 +1492,7 @@ module psb_d_base_mat_mod
& imin,imax,jmin,jmax
integer(psb_ipk_), intent(out) :: info
integer(psb_ipk_), intent(in), optional :: gtl(:)
end subroutine psb_d_coo_csput
end subroutine psb_d_coo_csput_a
end interface
!>

8
base/modules/psb_d_csc_mat_mod.f90
Unescape Escape View File

@ -88,7 +88,7 @@ module psb_d_csc_mat_mod
procedure, pass(a) :: mv_from_coo => psb_d_mv_csc_from_coo
procedure, pass(a) :: mv_to_fmt => psb_d_mv_csc_to_fmt
procedure, pass(a) :: mv_from_fmt => psb_d_mv_csc_from_fmt
procedure, pass(a) :: csput => psb_d_csc_csput
procedure, pass(a) :: csput_a => psb_d_csc_csput_a
procedure, pass(a) :: get_diag => psb_d_csc_get_diag
procedure, pass(a) :: csgetptn => psb_d_csc_csgetptn
procedure, pass(a) :: csgetrow => psb_d_csc_csgetrow
@ -279,9 +279,9 @@ module psb_d_csc_mat_mod
!> \memberof psb_d_csc_sparse_mat
!! \see psb_d_base_mat_mod::psb_d_base_csput
!! \see psb_d_base_mat_mod::psb_d_base_csput_a
interface
subroutine psb_d_csc_csput(nz,ia,ja,val,a,imin,imax,jmin,jmax,info,gtl)
subroutine psb_d_csc_csput_a(nz,ia,ja,val,a,imin,imax,jmin,jmax,info,gtl)
import :: psb_ipk_, psb_d_csc_sparse_mat, psb_dpk_
class(psb_d_csc_sparse_mat), intent(inout) :: a
real(psb_dpk_), intent(in) :: val(:)
@ -289,7 +289,7 @@ module psb_d_csc_mat_mod
& imin,imax,jmin,jmax
integer(psb_ipk_), intent(out) :: info
integer(psb_ipk_), intent(in), optional :: gtl(:)
end subroutine psb_d_csc_csput
end subroutine psb_d_csc_csput_a
end interface
!> \memberof psb_d_csc_sparse_mat

8
base/modules/psb_d_csr_mat_mod.f90
Unescape Escape View File

@ -89,7 +89,7 @@ module psb_d_csr_mat_mod
procedure, pass(a) :: mv_from_coo => psb_d_mv_csr_from_coo
procedure, pass(a) :: mv_to_fmt => psb_d_mv_csr_to_fmt
procedure, pass(a) :: mv_from_fmt => psb_d_mv_csr_from_fmt
procedure, pass(a) :: csput => psb_d_csr_csput
procedure, pass(a) :: csput_a => psb_d_csr_csput_a
procedure, pass(a) :: get_diag => psb_d_csr_get_diag
procedure, pass(a) :: csgetptn => psb_d_csr_csgetptn
procedure, pass(a) :: csgetrow => psb_d_csr_csgetrow
@ -282,9 +282,9 @@ module psb_d_csr_mat_mod
!> \memberof psb_d_csr_sparse_mat
!! \see psb_d_base_mat_mod::psb_d_base_csput
!! \see psb_d_base_mat_mod::psb_d_base_csput_a
interface
subroutine psb_d_csr_csput(nz,ia,ja,val,a,imin,imax,jmin,jmax,info,gtl)
subroutine psb_d_csr_csput_a(nz,ia,ja,val,a,imin,imax,jmin,jmax,info,gtl)
import :: psb_ipk_, psb_d_csr_sparse_mat, psb_dpk_
class(psb_d_csr_sparse_mat), intent(inout) :: a
real(psb_dpk_), intent(in) :: val(:)
@ -292,7 +292,7 @@ module psb_d_csr_mat_mod
& imin,imax,jmin,jmax
integer(psb_ipk_), intent(out) :: info
integer(psb_ipk_), intent(in), optional :: gtl(:)
end subroutine psb_d_csr_csput
end subroutine psb_d_csr_csput_a
end interface
!> \memberof psb_d_csr_sparse_mat

79
base/serial/impl/psb_d_base_mat_impl.F90
Unescape Escape View File

@ -327,9 +327,9 @@ subroutine psb_d_base_mv_from_fmt(a,b,info)
end subroutine psb_d_base_mv_from_fmt
subroutine psb_d_base_csput(nz,ia,ja,val,a,imin,imax,jmin,jmax,info,gtl)
subroutine psb_d_base_csput_a(nz,ia,ja,val,a,imin,imax,jmin,jmax,info,gtl)
use psb_error_mod
use psb_d_base_mat_mod, psb_protect_name => psb_d_base_csput
use psb_d_base_mat_mod, psb_protect_name => psb_d_base_csput_a
implicit none
class(psb_d_base_sparse_mat), intent(inout) :: a
real(psb_dpk_), intent(in) :: val(:)
@ -354,7 +354,56 @@ subroutine psb_d_base_csput(nz,ia,ja,val,a,imin,imax,jmin,jmax,info,gtl)
end if
return
end subroutine psb_d_base_csput
end subroutine psb_d_base_csput_a
subroutine psb_d_base_csput_v(nz,ia,ja,val,a,imin,imax,jmin,jmax,info,gtl)
use psb_error_mod
use psb_d_base_mat_mod, psb_protect_name => psb_d_base_csput_v
use psb_d_base_vect_mod
implicit none
class(psb_d_base_sparse_mat), intent(inout) :: a
class(psb_d_base_vect_type), intent(inout) :: val
class(psb_i_base_vect_type), intent(inout) :: ia, ja
integer(psb_ipk_), intent(in) :: nz, imin,imax,jmin,jmax
integer(psb_ipk_), intent(out) :: info
integer(psb_ipk_), intent(in), optional :: gtl(:)
integer(psb_ipk_) :: err_act, nzin, nzout
integer(psb_ipk_) :: ierr(5)
character(len=20) :: name='csput_v'
integer :: jmin_, jmax_
logical :: append_, rscale_, cscale_
logical, parameter :: debug=.false.
call psb_erractionsave(err_act)
info = psb_success_
if (allocated(val%v).and.allocated(ia%v).and.allocated(ja%v)) then
call a%csput(nz,ia%v,ja%v,val%v,imin,imax,jmin,jmax,info,gtl)
else
info = psb_err_invalid_mat_state_
endif
if (info /= 0) then
call psb_errpush(info,name)
goto 9999
end if
call psb_erractionrestore(err_act)
return
9999 continue
call psb_erractionrestore(err_act)
if (err_act == psb_act_abort_) then
call psb_error()
return
end if
return
end subroutine psb_d_base_csput_v
subroutine psb_d_base_csgetrow(imin,imax,a,nz,ia,ja,val,info,&
& jmin,jmax,iren,append,nzin,rscale,cscale)
@ -456,7 +505,7 @@ subroutine psb_d_base_csgetblk(imin,imax,a,b,info,&
else
jmax_ = a%get_ncols()
endif
if (append_.and.(rscale_.or.cscale_)) then
write(psb_err_unit,*) &
& 'd_csgetblk: WARNING: dubious input: append_ and rscale_|cscale_'
@ -682,7 +731,7 @@ subroutine psb_d_base_tril(a,b,info,&
& b%ia(1:nzout) = b%ia(1:nzout) - imin_ + 1
if (cscale_) &
& b%ja(1:nzout) = b%ja(1:nzout) - jmin_ + 1
if ((diag_ <= 0).and.(imin_ == jmin_)) then
call b%set_triangle(.true.)
call b%set_lower(.true.)
@ -792,7 +841,7 @@ subroutine psb_d_base_triu(a,b,info,&
& b%ia(1:nzout) = b%ia(1:nzout) - imin_ + 1
if (cscale_) &
& b%ja(1:nzout) = b%ja(1:nzout) - jmin_ + 1
if ((diag_ >= 0).and.(imin_ == jmin_)) then
call b%set_triangle(.true.)
call b%set_upper(.true.)
@ -820,7 +869,7 @@ subroutine psb_d_base_clone(a,b,info)
use psb_d_base_mat_mod, psb_protect_name => psb_d_base_clone
use psb_error_mod
implicit none
class(psb_d_base_sparse_mat), intent(inout) :: a
class(psb_d_base_sparse_mat), allocatable, intent(inout) :: b
integer(psb_ipk_), intent(out) :: info
@ -843,7 +892,7 @@ subroutine psb_d_base_clone(a,b,info)
call a%mold(b,info)
#endif
if (info == psb_success_) call b%cp_from_fmt(a, info)
end subroutine psb_d_base_clone
subroutine psb_d_base_make_nonunit(a)
@ -852,7 +901,7 @@ subroutine psb_d_base_make_nonunit(a)
implicit none
class(psb_d_base_sparse_mat), intent(inout) :: a
type(psb_d_coo_sparse_mat) :: tmp
integer(psb_ipk_) :: i, j, m, n, nz, mnm, info
if (a%is_unit()) then
@ -920,11 +969,11 @@ subroutine psb_d_base_transp_2mat(a,b)
info = psb_success_
select type(b)
class is (psb_d_base_sparse_mat)
class is (psb_d_base_sparse_mat)
call a%cp_to_coo(tmp,info)
if (info == psb_success_) call tmp%transp()
if (info == psb_success_) call b%mv_from_coo(tmp,info)
class default
class default
info = psb_err_invalid_dynamic_type_
end select
if (info /= psb_success_) then
@ -960,11 +1009,11 @@ subroutine psb_d_base_transc_2mat(a,b)
info = psb_success_
select type(b)
class is (psb_d_base_sparse_mat)
class is (psb_d_base_sparse_mat)
call a%cp_to_coo(tmp,info)
if (info == psb_success_) call tmp%transc()
if (info == psb_success_) call b%mv_from_coo(tmp,info)
class default
class default
info = psb_err_invalid_dynamic_type_
end select
if (info /= psb_success_) then
@ -1271,7 +1320,7 @@ subroutine psb_d_base_cssm(alpha,a,x,beta,y,info,trans,scale,d)
if (size(d,1) < nar) then
info = psb_err_input_asize_small_i_
ierr(1) = 9; ierr(2) = nar;
ierr(1) = 9; ierr(2) = nar;
call psb_errpush(info,name,i_err=ierr)
goto 9999
end if
@ -1407,7 +1456,7 @@ subroutine psb_d_base_cssv(alpha,a,x,beta,y,info,trans,scale,d)
else if (psb_toupper(scale_) == 'L') then
if (size(d,1) < nar) then
info = psb_err_input_asize_small_i_
ierr(1) = 9; ierr(2) = nar;
ierr(1) = 9; ierr(2) = nar;
call psb_errpush(info,name,i_err=ierr)
goto 9999
end if

8
base/serial/impl/psb_d_coo_impl.f90
Unescape Escape View File

@ -2573,11 +2573,11 @@ contains
end subroutine psb_d_coo_csgetrow
subroutine psb_d_coo_csput(nz,ia,ja,val,a,imin,imax,jmin,jmax,info,gtl)
subroutine psb_d_coo_csput_a(nz,ia,ja,val,a,imin,imax,jmin,jmax,info,gtl)
use psb_error_mod
use psb_realloc_mod
use psb_sort_mod
use psb_d_base_mat_mod, psb_protect_name => psb_d_coo_csput
use psb_d_base_mat_mod, psb_protect_name => psb_d_coo_csput_a
implicit none
class(psb_d_coo_sparse_mat), intent(inout) :: a
@ -2589,7 +2589,7 @@ subroutine psb_d_coo_csput(nz,ia,ja,val,a,imin,imax,jmin,jmax,info,gtl)
integer(psb_ipk_) :: err_act
integer(psb_ipk_) :: ierr(5)
character(len=20) :: name='d_coo_csput_impl'
character(len=20) :: name='d_coo_csput_a_impl'
logical, parameter :: debug=.false.
integer(psb_ipk_) :: nza, i,j,k, nzl, isza, debug_level, debug_unit
@ -2953,7 +2953,7 @@ contains
end subroutine d_coo_srch_upd
end subroutine psb_d_coo_csput
end subroutine psb_d_coo_csput_a
subroutine psb_d_cp_coo_to_coo(a,b,info)

8
base/serial/impl/psb_d_csc_impl.f90
Unescape Escape View File

@ -1965,10 +1965,10 @@ end subroutine psb_d_csc_csgetrow
subroutine psb_d_csc_csput(nz,ia,ja,val,a,imin,imax,jmin,jmax,info,gtl)
subroutine psb_d_csc_csput_a(nz,ia,ja,val,a,imin,imax,jmin,jmax,info,gtl)
use psb_error_mod
use psb_realloc_mod
use psb_d_csc_mat_mod, psb_protect_name => psb_d_csc_csput
use psb_d_csc_mat_mod, psb_protect_name => psb_d_csc_csput_a
implicit none
class(psb_d_csc_sparse_mat), intent(inout) :: a
@ -1980,7 +1980,7 @@ subroutine psb_d_csc_csput(nz,ia,ja,val,a,imin,imax,jmin,jmax,info,gtl)
integer(psb_ipk_) :: err_act
integer(psb_ipk_) :: ierr(5)
character(len=20) :: name='d_csc_csput'
character(len=20) :: name='d_csc_csput_a'
logical, parameter :: debug=.false.
integer(psb_ipk_) :: nza, i,j,k, nzl, isza, debug_level, debug_unit
@ -2232,7 +2232,7 @@ contains
end subroutine psb_d_csc_srch_upd
end subroutine psb_d_csc_csput
end subroutine psb_d_csc_csput_a

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

@ -2338,10 +2338,10 @@ end subroutine psb_d_csr_csgetblk
subroutine psb_d_csr_csput(nz,ia,ja,val,a,imin,imax,jmin,jmax,info,gtl)
subroutine psb_d_csr_csput_a(nz,ia,ja,val,a,imin,imax,jmin,jmax,info,gtl)
use psb_error_mod
use psb_realloc_mod
use psb_d_csr_mat_mod, psb_protect_name => psb_d_csr_csput
use psb_d_csr_mat_mod, psb_protect_name => psb_d_csr_csput_a
implicit none
class(psb_d_csr_sparse_mat), intent(inout) :: a
@ -2353,7 +2353,7 @@ subroutine psb_d_csr_csput(nz,ia,ja,val,a,imin,imax,jmin,jmax,info,gtl)
integer(psb_ipk_) :: err_act
integer(psb_ipk_) :: ierr(5)
character(len=20) :: name='d_csr_csput'
character(len=20) :: name='d_csr_csput_a'
logical, parameter :: debug=.false.
integer(psb_ipk_) :: nza, i,j,k, nzl, isza, debug_level, debug_unit
@ -2604,7 +2604,7 @@ contains
end subroutine psb_d_csr_srch_upd
end subroutine psb_d_csr_csput
end subroutine psb_d_csr_csput_a
subroutine psb_d_csr_reinit(a,clear)

Write Preview
Loading…
Cancel
Save