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

psblas3:

Browse Source 
base/modules/psb_c_mat_mod.f90
 base/modules/psb_d_mat_mod.f90
 base/modules/psb_s_mat_mod.f90
 base/modules/psb_z_mat_mod.f90
 base/serial/impl/psb_c_mat_impl.F90
 base/serial/impl/psb_d_mat_impl.F90
 base/serial/impl/psb_s_mat_impl.F90
 base/serial/impl/psb_z_mat_impl.F90
Various fixes from preprocessing.
Take out GET/SET state from outer matrix shell.
psblas3-type-indexed
Salvatore Filippone 13 years ago
parent 428ed70cd4
commit c804941be6
8 changed files with 460 additions and 577 deletions
Show Stats Download Patch File Download Diff File

156
base/modules/psb_c_mat_mod.f90
Unescape Escape View File

@ -59,7 +59,6 @@ module psb_c_mat_mod
procedure, pass(a) :: get_nzeros => psb_c_get_nzeros
procedure, pass(a) :: get_nz_row => psb_c_get_nz_row
procedure, pass(a) :: get_size => psb_c_get_size
procedure, pass(a) :: get_state => psb_c_get_state
procedure, pass(a) :: get_dupl => psb_c_get_dupl
procedure, pass(a) :: is_null => psb_c_is_null
procedure, pass(a) :: is_bld => psb_c_is_bld
@ -77,7 +76,6 @@ module psb_c_mat_mod
procedure, pass(a) :: set_nrows => psb_c_set_nrows
procedure, pass(a) :: set_ncols => psb_c_set_ncols
procedure, pass(a) :: set_dupl => psb_c_set_dupl
procedure, pass(a) :: set_state => psb_c_set_state
procedure, pass(a) :: set_null => psb_c_set_null
procedure, pass(a) :: set_bld => psb_c_set_bld
procedure, pass(a) :: set_upd => psb_c_set_upd
@ -109,7 +107,7 @@ module psb_c_mat_mod
procedure, pass(a) :: c_cscnv_ip => psb_c_cscnv_ip
procedure, pass(a) :: c_cscnv_base => psb_c_cscnv_base
generic, public :: cscnv => c_cscnv, c_cscnv_ip, c_cscnv_base
procedure, pass(a) :: clone => psb_cspmat_type_clone
procedure, pass(a) :: clone => psb_cspmat_clone
procedure, pass(a) :: reinit => psb_c_reinit
procedure, pass(a) :: print_i => psb_c_sparse_print
procedure, pass(a) :: print_n => psb_c_n_sparse_print
@ -154,9 +152,9 @@ module psb_c_mat_mod
end type psb_cspmat_type
private :: psb_c_get_nrows, psb_c_get_ncols, psb_c_get_nzeros, psb_c_get_size, &
& psb_c_get_state, psb_c_get_dupl, psb_c_is_null, psb_c_is_bld, psb_c_is_upd, &
& psb_c_is_asb, psb_c_is_sorted, psb_c_is_upper, psb_c_is_lower, psb_c_is_triangle,&
& psb_c_get_nz_row
& psb_c_get_dupl, psb_c_is_null, psb_c_is_bld, &
& psb_c_is_upd, psb_c_is_asb, psb_c_is_sorted, psb_c_is_upper, &
& psb_c_is_lower, psb_c_is_triangle, psb_c_get_nz_row
interface psb_sizeof
module procedure psb_c_sizeof
@ -193,14 +191,6 @@ module psb_c_mat_mod
end subroutine psb_c_set_ncols
end interface
interface
subroutine psb_c_set_state(n,a)
import :: psb_cspmat_type
class(psb_cspmat_type), intent(inout) :: a
integer, intent(in) :: n
end subroutine psb_c_set_state
end interface
interface
subroutine psb_c_set_dupl(n,a)
import :: psb_cspmat_type
@ -347,9 +337,9 @@ module psb_c_mat_mod
interface
subroutine psb_c_csput(nz,ia,ja,val,a,imin,imax,jmin,jmax,info,gtl)
import :: psb_cspmat_type, psb_spk_
import :: psb_cspmat_type, psb_dpk_
class(psb_cspmat_type), intent(inout) :: a
complex(psb_spk_), intent(in) :: val(:)
complex(psb_dpk_), intent(in) :: val(:)
integer, intent(in) :: nz, ia(:), ja(:), imin,imax,jmin,jmax
integer, intent(out) :: info
integer, intent(in), optional :: gtl(:)
@ -359,7 +349,7 @@ module psb_c_mat_mod
interface
subroutine psb_c_csgetptn(imin,imax,a,nz,ia,ja,info,&
& jmin,jmax,iren,append,nzin,rscale,cscale)
import :: psb_cspmat_type, psb_spk_
import :: psb_cspmat_type, psb_dpk_
class(psb_cspmat_type), intent(in) :: a
integer, intent(in) :: imin,imax
integer, intent(out) :: nz
@ -375,12 +365,12 @@ module psb_c_mat_mod
interface
subroutine psb_c_csgetrow(imin,imax,a,nz,ia,ja,val,info,&
& jmin,jmax,iren,append,nzin,rscale,cscale)
import :: psb_cspmat_type, psb_spk_
import :: psb_cspmat_type, psb_dpk_
class(psb_cspmat_type), intent(in) :: a
integer, intent(in) :: imin,imax
integer, intent(out) :: nz
integer, allocatable, intent(inout) :: ia(:), ja(:)
complex(psb_spk_), allocatable, intent(inout) :: val(:)
complex(psb_dpk_), allocatable, intent(inout) :: val(:)
integer,intent(out) :: info
logical, intent(in), optional :: append
integer, intent(in), optional :: iren(:)
@ -392,7 +382,7 @@ module psb_c_mat_mod
interface
subroutine psb_c_csgetblk(imin,imax,a,b,info,&
& jmin,jmax,iren,append,rscale,cscale)
import :: psb_cspmat_type, psb_spk_
import :: psb_cspmat_type, psb_dpk_
class(psb_cspmat_type), intent(in) :: a
class(psb_cspmat_type), intent(out) :: b
integer, intent(in) :: imin,imax
@ -407,7 +397,7 @@ module psb_c_mat_mod
interface
subroutine psb_c_csclip(a,b,info,&
& imin,imax,jmin,jmax,rscale,cscale)
import :: psb_cspmat_type, psb_spk_
import :: psb_cspmat_type, psb_dpk_
class(psb_cspmat_type), intent(in) :: a
class(psb_cspmat_type), intent(out) :: b
integer,intent(out) :: info
@ -419,7 +409,7 @@ module psb_c_mat_mod
interface
subroutine psb_c_b_csclip(a,b,info,&
& imin,imax,jmin,jmax,rscale,cscale)
import :: psb_cspmat_type, psb_spk_, psb_c_coo_sparse_mat
import :: psb_cspmat_type, psb_dpk_, psb_c_coo_sparse_mat
class(psb_cspmat_type), intent(in) :: a
type(psb_c_coo_sparse_mat), intent(out) :: b
integer,intent(out) :: info
@ -430,7 +420,7 @@ module psb_c_mat_mod
interface
subroutine psb_c_cscnv(a,b,info,type,mold,upd,dupl)
import :: psb_cspmat_type, psb_spk_, psb_c_base_sparse_mat
import :: psb_cspmat_type, psb_dpk_, psb_c_base_sparse_mat
class(psb_cspmat_type), intent(in) :: a
class(psb_cspmat_type), intent(out) :: b
integer, intent(out) :: info
@ -443,7 +433,7 @@ module psb_c_mat_mod
interface
subroutine psb_c_cscnv_ip(a,iinfo,type,mold,dupl)
import :: psb_cspmat_type, psb_spk_, psb_c_base_sparse_mat
import :: psb_cspmat_type, psb_dpk_, psb_c_base_sparse_mat
class(psb_cspmat_type), intent(inout) :: a
integer, intent(out) :: iinfo
integer,optional, intent(in) :: dupl
@ -455,7 +445,7 @@ module psb_c_mat_mod
interface
subroutine psb_c_cscnv_base(a,b,info,dupl)
import :: psb_cspmat_type, psb_spk_, psb_c_base_sparse_mat
import :: psb_cspmat_type, psb_dpk_, psb_c_base_sparse_mat
class(psb_cspmat_type), intent(in) :: a
class(psb_c_base_sparse_mat), intent(out) :: b
integer, intent(out) :: info
@ -482,32 +472,32 @@ module psb_c_mat_mod
interface
subroutine psb_c_mv_from(a,b)
import :: psb_cspmat_type, psb_spk_, psb_c_base_sparse_mat
class(psb_cspmat_type), intent(out) :: a
import :: psb_cspmat_type, psb_dpk_, psb_c_base_sparse_mat
class(psb_cspmat_type), intent(out) :: a
class(psb_c_base_sparse_mat), intent(inout) :: b
end subroutine psb_c_mv_from
end interface
interface
subroutine psb_c_cp_from(a,b)
import :: psb_cspmat_type, psb_spk_, psb_c_base_sparse_mat
class(psb_cspmat_type), intent(out) :: a
class(psb_c_base_sparse_mat), intent(in) :: b
import :: psb_cspmat_type, psb_dpk_, psb_c_base_sparse_mat
class(psb_cspmat_type), intent(out) :: a
class(psb_c_base_sparse_mat), intent(inout), allocatable :: b
end subroutine psb_c_cp_from
end interface
interface
subroutine psb_c_mv_to(a,b)
import :: psb_cspmat_type, psb_spk_, psb_c_base_sparse_mat
class(psb_cspmat_type), intent(inout) :: a
import :: psb_cspmat_type, psb_dpk_, psb_c_base_sparse_mat
class(psb_cspmat_type), intent(inout) :: a
class(psb_c_base_sparse_mat), intent(out) :: b
end subroutine psb_c_mv_to
end interface
interface
subroutine psb_c_cp_to(a,b)
import :: psb_cspmat_type, psb_spk_, psb_c_base_sparse_mat
class(psb_cspmat_type), intent(in) :: a
import :: psb_cspmat_type, psb_dpk_, psb_c_base_sparse_mat
class(psb_cspmat_type), intent(in) :: a
class(psb_c_base_sparse_mat), intent(out) :: b
end subroutine psb_c_cp_to
end interface
@ -522,12 +512,12 @@ module psb_c_mat_mod
end interface
interface psb_clone
subroutine psb_cspmat_type_clone(a,b,info)
subroutine psb_cspmat_clone(a,b,info)
import :: psb_cspmat_type
class(psb_cspmat_type), intent(in) :: a
class(psb_cspmat_type), intent(out) :: b
integer, intent(out) :: info
end subroutine psb_cspmat_type_clone
end subroutine psb_cspmat_clone
end interface
interface
@ -537,7 +527,7 @@ module psb_c_mat_mod
class(psb_c_base_sparse_mat), allocatable, intent(out) :: b
end subroutine psb_c_mold
end interface
interface
subroutine psb_c_transp_1mat(a)
import :: psb_cspmat_type
@ -594,26 +584,26 @@ module psb_c_mat_mod
interface psb_csmm
subroutine psb_c_csmm(alpha,a,x,beta,y,info,trans)
import :: psb_cspmat_type, psb_spk_
import :: psb_cspmat_type, psb_dpk_
class(psb_cspmat_type), intent(in) :: a
complex(psb_spk_), intent(in) :: alpha, beta, x(:,:)
complex(psb_spk_), intent(inout) :: y(:,:)
complex(psb_dpk_), intent(in) :: alpha, beta, x(:,:)
complex(psb_dpk_), intent(inout) :: y(:,:)
integer, intent(out) :: info
character, optional, intent(in) :: trans
end subroutine psb_c_csmm
subroutine psb_c_csmv(alpha,a,x,beta,y,info,trans)
import :: psb_cspmat_type, psb_spk_
import :: psb_cspmat_type, psb_dpk_
class(psb_cspmat_type), intent(in) :: a
complex(psb_spk_), intent(in) :: alpha, beta, x(:)
complex(psb_spk_), intent(inout) :: y(:)
complex(psb_dpk_), intent(in) :: alpha, beta, x(:)
complex(psb_dpk_), intent(inout) :: y(:)
integer, intent(out) :: info
character, optional, intent(in) :: trans
end subroutine psb_c_csmv
subroutine psb_c_csmv_vect(alpha,a,x,beta,y,info,trans)
use psb_c_vect_mod, only : psb_c_vect_type
import :: psb_cspmat_type, psb_spk_
import :: psb_cspmat_type, psb_dpk_
class(psb_cspmat_type), intent(in) :: a
complex(psb_spk_), intent(in) :: alpha, beta
complex(psb_dpk_), intent(in) :: alpha, beta
type(psb_c_vect_type), intent(inout) :: x
type(psb_c_vect_type), intent(inout) :: y
integer, intent(out) :: info
@ -623,28 +613,28 @@ module psb_c_mat_mod
interface psb_cssm
subroutine psb_c_cssm(alpha,a,x,beta,y,info,trans,scale,d)
import :: psb_cspmat_type, psb_spk_
import :: psb_cspmat_type, psb_dpk_
class(psb_cspmat_type), intent(in) :: a
complex(psb_spk_), intent(in) :: alpha, beta, x(:,:)
complex(psb_spk_), intent(inout) :: y(:,:)
complex(psb_dpk_), intent(in) :: alpha, beta, x(:,:)
complex(psb_dpk_), intent(inout) :: y(:,:)
integer, intent(out) :: info
character, optional, intent(in) :: trans, scale
complex(psb_spk_), intent(in), optional :: d(:)
complex(psb_dpk_), intent(in), optional :: d(:)
end subroutine psb_c_cssm
subroutine psb_c_cssv(alpha,a,x,beta,y,info,trans,scale,d)
import :: psb_cspmat_type, psb_spk_
import :: psb_cspmat_type, psb_dpk_
class(psb_cspmat_type), intent(in) :: a
complex(psb_spk_), intent(in) :: alpha, beta, x(:)
complex(psb_spk_), intent(inout) :: y(:)
complex(psb_dpk_), intent(in) :: alpha, beta, x(:)
complex(psb_dpk_), intent(inout) :: y(:)
integer, intent(out) :: info
character, optional, intent(in) :: trans, scale
complex(psb_spk_), intent(in), optional :: d(:)
complex(psb_dpk_), intent(in), optional :: d(:)
end subroutine psb_c_cssv
subroutine psb_c_cssv_vect(alpha,a,x,beta,y,info,trans,scale,d)
use psb_c_vect_mod, only : psb_c_vect_type
import :: psb_cspmat_type, psb_spk_
import :: psb_cspmat_type, psb_dpk_
class(psb_cspmat_type), intent(in) :: a
complex(psb_spk_), intent(in) :: alpha, beta
complex(psb_dpk_), intent(in) :: alpha, beta
type(psb_c_vect_type), intent(inout) :: x
type(psb_c_vect_type), intent(inout) :: y
integer, intent(out) :: info
@ -655,60 +645,60 @@ module psb_c_mat_mod
interface
function psb_c_maxval(a) result(res)
import :: psb_cspmat_type, psb_spk_
import :: psb_cspmat_type, psb_dpk_
class(psb_cspmat_type), intent(in) :: a
real(psb_spk_) :: res
real(psb_dpk_) :: res
end function psb_c_maxval
end interface
interface
function psb_c_csnmi(a) result(res)
import :: psb_cspmat_type, psb_spk_
import :: psb_cspmat_type, psb_dpk_
class(psb_cspmat_type), intent(in) :: a
real(psb_spk_) :: res
real(psb_dpk_) :: res
end function psb_c_csnmi
end interface
interface
function psb_c_csnm1(a) result(res)
import :: psb_cspmat_type, psb_spk_
import :: psb_cspmat_type, psb_dpk_
class(psb_cspmat_type), intent(in) :: a
real(psb_spk_) :: res
real(psb_dpk_) :: res
end function psb_c_csnm1
end interface
interface
subroutine psb_c_rowsum(d,a,info)
import :: psb_cspmat_type, psb_spk_
import :: psb_cspmat_type, psb_dpk_
class(psb_cspmat_type), intent(in) :: a
complex(psb_spk_), intent(out) :: d(:)
complex(psb_dpk_), intent(out) :: d(:)
integer, intent(out) :: info
end subroutine psb_c_rowsum
end interface
interface
subroutine psb_c_arwsum(d,a,info)
import :: psb_cspmat_type, psb_spk_
import :: psb_cspmat_type, psb_dpk_
class(psb_cspmat_type), intent(in) :: a
real(psb_spk_), intent(out) :: d(:)
real(psb_dpk_), intent(out) :: d(:)
integer, intent(out) :: info
end subroutine psb_c_arwsum
end interface
interface
subroutine psb_c_colsum(d,a,info)
import :: psb_cspmat_type, psb_spk_
import :: psb_cspmat_type, psb_dpk_
class(psb_cspmat_type), intent(in) :: a
complex(psb_spk_), intent(out) :: d(:)
complex(psb_dpk_), intent(out) :: d(:)
integer, intent(out) :: info
end subroutine psb_c_colsum
end interface
interface
subroutine psb_c_aclsum(d,a,info)
import :: psb_cspmat_type, psb_spk_
import :: psb_cspmat_type, psb_dpk_
class(psb_cspmat_type), intent(in) :: a
real(psb_spk_), intent(out) :: d(:)
real(psb_dpk_), intent(out) :: d(:)
integer, intent(out) :: info
end subroutine psb_c_aclsum
end interface
@ -716,24 +706,24 @@ module psb_c_mat_mod
interface
subroutine psb_c_get_diag(a,d,info)
import :: psb_cspmat_type, psb_spk_
import :: psb_cspmat_type, psb_dpk_
class(psb_cspmat_type), intent(in) :: a
complex(psb_spk_), intent(out) :: d(:)
complex(psb_dpk_), intent(out) :: d(:)
integer, intent(out) :: info
end subroutine psb_c_get_diag
end interface
interface psb_scal
subroutine psb_c_scal(d,a,info)
import :: psb_cspmat_type, psb_spk_
import :: psb_cspmat_type, psb_dpk_
class(psb_cspmat_type), intent(inout) :: a
complex(psb_spk_), intent(in) :: d(:)
complex(psb_dpk_), intent(in) :: d(:)
integer, intent(out) :: info
end subroutine psb_c_scal
subroutine psb_c_scals(d,a,info)
import :: psb_cspmat_type, psb_spk_
import :: psb_cspmat_type, psb_dpk_
class(psb_cspmat_type), intent(inout) :: a
complex(psb_spk_), intent(in) :: d
complex(psb_dpk_), intent(in) :: d
integer, intent(out) :: info
end subroutine psb_c_scals
end interface
@ -768,7 +758,6 @@ contains
end function psb_c_sizeof
function psb_c_get_fmt(a) result(res)
implicit none
class(psb_cspmat_type), intent(in) :: a
@ -795,19 +784,6 @@ contains
end if
end function psb_c_get_dupl
function psb_c_get_state(a) result(res)
implicit none
class(psb_cspmat_type), intent(in) :: a
integer :: res
if (allocated(a%a)) then
res = a%a%get_state()
else
res = psb_spmat_null_
end if
end function psb_c_get_state
function psb_c_get_nrows(a) result(res)
implicit none
class(psb_cspmat_type), intent(in) :: a
@ -985,7 +961,7 @@ contains
integer, intent(in) :: idx
class(psb_cspmat_type), intent(in) :: a
integer :: res
res = 0
if (allocated(a%a)) res = a%a%get_nz_row(idx)

186
base/modules/psb_d_mat_mod.f90
Unescape Escape View File

@ -41,6 +41,7 @@
! methods of the psb_d_mat_mod simply call the methods of the
! encapsulated class.
module psb_d_mat_mod
use psb_d_base_mat_mod
@ -58,7 +59,6 @@ module psb_d_mat_mod
procedure, pass(a) :: get_nzeros => psb_d_get_nzeros
procedure, pass(a) :: get_nz_row => psb_d_get_nz_row
procedure, pass(a) :: get_size => psb_d_get_size
procedure, pass(a) :: get_state => psb_d_get_state
procedure, pass(a) :: get_dupl => psb_d_get_dupl
procedure, pass(a) :: is_null => psb_d_is_null
procedure, pass(a) :: is_bld => psb_d_is_bld
@ -76,7 +76,6 @@ module psb_d_mat_mod
procedure, pass(a) :: set_nrows => psb_d_set_nrows
procedure, pass(a) :: set_ncols => psb_d_set_ncols
procedure, pass(a) :: set_dupl => psb_d_set_dupl
procedure, pass(a) :: set_state => psb_d_set_state
procedure, pass(a) :: set_null => psb_d_set_null
procedure, pass(a) :: set_bld => psb_d_set_bld
procedure, pass(a) :: set_upd => psb_d_set_upd
@ -108,7 +107,7 @@ module psb_d_mat_mod
procedure, pass(a) :: d_cscnv_ip => psb_d_cscnv_ip
procedure, pass(a) :: d_cscnv_base => psb_d_cscnv_base
generic, public :: cscnv => d_cscnv, d_cscnv_ip, d_cscnv_base
procedure, pass(a) :: clone => psb_dspmat_type_clone
procedure, pass(a) :: clone => psb_dspmat_clone
procedure, pass(a) :: reinit => psb_d_reinit
procedure, pass(a) :: print_i => psb_d_sparse_print
procedure, pass(a) :: print_n => psb_d_n_sparse_print
@ -129,8 +128,6 @@ module psb_d_mat_mod
procedure, pass(a) :: d_transc_2mat => psb_d_transc_2mat
generic, public :: transc => d_transc_1mat, d_transc_2mat
! Computational routines
procedure, pass(a) :: get_diag => psb_d_get_diag
procedure, pass(a) :: maxval => psb_d_maxval
@ -155,9 +152,9 @@ module psb_d_mat_mod
end type psb_dspmat_type
private :: psb_d_get_nrows, psb_d_get_ncols, psb_d_get_nzeros, psb_d_get_size, &
& psb_d_get_state, psb_d_get_dupl, psb_d_is_null, psb_d_is_bld, psb_d_is_upd, &
& psb_d_is_asb, psb_d_is_sorted, psb_d_is_upper, psb_d_is_lower,&
& psb_d_is_triangle, psb_d_get_nz_row
& psb_d_get_dupl, psb_d_is_null, psb_d_is_bld, &
& psb_d_is_upd, psb_d_is_asb, psb_d_is_sorted, psb_d_is_upper, &
& psb_d_is_lower, psb_d_is_triangle, psb_d_get_nz_row
interface psb_sizeof
module procedure psb_d_sizeof
@ -185,7 +182,7 @@ module psb_d_mat_mod
integer, intent(in) :: m
end subroutine psb_d_set_nrows
end interface
interface
subroutine psb_d_set_ncols(n,a)
import :: psb_dspmat_type
@ -193,15 +190,7 @@ module psb_d_mat_mod
integer, intent(in) :: n
end subroutine psb_d_set_ncols
end interface
interface
subroutine psb_d_set_state(n,a)
import :: psb_dspmat_type
class(psb_dspmat_type), intent(inout) :: a
integer, intent(in) :: n
end subroutine psb_d_set_state
end interface
interface
subroutine psb_d_set_dupl(n,a)
import :: psb_dspmat_type
@ -209,35 +198,35 @@ module psb_d_mat_mod
integer, intent(in) :: n
end subroutine psb_d_set_dupl
end interface
interface
subroutine psb_d_set_null(a)
import :: psb_dspmat_type
class(psb_dspmat_type), intent(inout) :: a
end subroutine psb_d_set_null
end interface
interface
subroutine psb_d_set_bld(a)
import :: psb_dspmat_type
class(psb_dspmat_type), intent(inout) :: a
end subroutine psb_d_set_bld
end interface
interface
subroutine psb_d_set_upd(a)
import :: psb_dspmat_type
class(psb_dspmat_type), intent(inout) :: a
end subroutine psb_d_set_upd
end interface
interface
subroutine psb_d_set_asb(a)
import :: psb_dspmat_type
class(psb_dspmat_type), intent(inout) :: a
end subroutine psb_d_set_asb
end interface
interface
subroutine psb_d_set_sorted(a,val)
import :: psb_dspmat_type
@ -245,7 +234,7 @@ module psb_d_mat_mod
logical, intent(in), optional :: val
end subroutine psb_d_set_sorted
end interface
interface
subroutine psb_d_set_triangle(a,val)
import :: psb_dspmat_type
@ -253,7 +242,7 @@ module psb_d_mat_mod
logical, intent(in), optional :: val
end subroutine psb_d_set_triangle
end interface
interface
subroutine psb_d_set_unit(a,val)
import :: psb_dspmat_type
@ -261,7 +250,7 @@ module psb_d_mat_mod
logical, intent(in), optional :: val
end subroutine psb_d_set_unit
end interface
interface
subroutine psb_d_set_lower(a,val)
import :: psb_dspmat_type
@ -269,7 +258,7 @@ module psb_d_mat_mod
logical, intent(in), optional :: val
end subroutine psb_d_set_lower
end interface
interface
subroutine psb_d_set_upper(a,val)
import :: psb_dspmat_type
@ -277,8 +266,7 @@ module psb_d_mat_mod
logical, intent(in), optional :: val
end subroutine psb_d_set_upper
end interface
interface
subroutine psb_d_sparse_print(iout,a,iv,eirs,eics,head,ivr,ivc)
import :: psb_dspmat_type
@ -302,7 +290,7 @@ module psb_d_mat_mod
integer, intent(in), optional :: ivr(:), ivc(:)
end subroutine psb_d_n_sparse_print
end interface
interface
subroutine psb_d_get_neigh(a,idx,neigh,n,info,lev)
import :: psb_dspmat_type
@ -314,7 +302,7 @@ module psb_d_mat_mod
integer, optional, intent(in) :: lev
end subroutine psb_d_get_neigh
end interface
interface
subroutine psb_d_csall(nr,nc,a,info,nz)
import :: psb_dspmat_type
@ -324,7 +312,7 @@ module psb_d_mat_mod
integer, intent(in), optional :: nz
end subroutine psb_d_csall
end interface
interface
subroutine psb_d_reallocate_nz(nz,a)
import :: psb_dspmat_type
@ -332,21 +320,21 @@ module psb_d_mat_mod
class(psb_dspmat_type), intent(inout) :: a
end subroutine psb_d_reallocate_nz
end interface
interface
subroutine psb_d_free(a)
import :: psb_dspmat_type
class(psb_dspmat_type), intent(inout) :: a
end subroutine psb_d_free
end interface
interface
subroutine psb_d_trim(a)
import :: psb_dspmat_type
class(psb_dspmat_type), intent(inout) :: a
end subroutine psb_d_trim
end interface
interface
subroutine psb_d_csput(nz,ia,ja,val,a,imin,imax,jmin,jmax,info,gtl)
import :: psb_dspmat_type, psb_dpk_
@ -357,10 +345,10 @@ module psb_d_mat_mod
integer, intent(in), optional :: gtl(:)
end subroutine psb_d_csput
end interface
interface
subroutine psb_d_csgetptn(imin,imax,a,nz,ia,ja,info,&
& jmin,jmax,iren,append,nzin,rscale,cscale)
& jmin,jmax,iren,append,nzin,rscale,cscale)
import :: psb_dspmat_type, psb_dpk_
class(psb_dspmat_type), intent(in) :: a
integer, intent(in) :: imin,imax
@ -373,7 +361,7 @@ module psb_d_mat_mod
logical, intent(in), optional :: rscale,cscale
end subroutine psb_d_csgetptn
end interface
interface
subroutine psb_d_csgetrow(imin,imax,a,nz,ia,ja,val,info,&
& jmin,jmax,iren,append,nzin,rscale,cscale)
@ -390,10 +378,10 @@ module psb_d_mat_mod
logical, intent(in), optional :: rscale,cscale
end subroutine psb_d_csgetrow
end interface
interface
subroutine psb_d_csgetblk(imin,imax,a,b,info,&
& jmin,jmax,iren,append,rscale,cscale)
& jmin,jmax,iren,append,rscale,cscale)
import :: psb_dspmat_type, psb_dpk_
class(psb_dspmat_type), intent(in) :: a
class(psb_dspmat_type), intent(out) :: b
@ -405,10 +393,10 @@ module psb_d_mat_mod
logical, intent(in), optional :: rscale,cscale
end subroutine psb_d_csgetblk
end interface
interface
subroutine psb_d_csclip(a,b,info,&
& imin,imax,jmin,jmax,rscale,cscale)
& imin,imax,jmin,jmax,rscale,cscale)
import :: psb_dspmat_type, psb_dpk_
class(psb_dspmat_type), intent(in) :: a
class(psb_dspmat_type), intent(out) :: b
@ -417,10 +405,10 @@ module psb_d_mat_mod
logical, intent(in), optional :: rscale,cscale
end subroutine psb_d_csclip
end interface
interface
subroutine psb_d_b_csclip(a,b,info,&
& imin,imax,jmin,jmax,rscale,cscale)
& imin,imax,jmin,jmax,rscale,cscale)
import :: psb_dspmat_type, psb_dpk_, psb_d_coo_sparse_mat
class(psb_dspmat_type), intent(in) :: a
type(psb_d_coo_sparse_mat), intent(out) :: b
@ -429,7 +417,7 @@ module psb_d_mat_mod
logical, intent(in), optional :: rscale,cscale
end subroutine psb_d_b_csclip
end interface
interface
subroutine psb_d_cscnv(a,b,info,type,mold,upd,dupl)
import :: psb_dspmat_type, psb_dpk_, psb_d_base_sparse_mat
@ -441,7 +429,7 @@ module psb_d_mat_mod
class(psb_d_base_sparse_mat), intent(in), optional :: mold
end subroutine psb_d_cscnv
end interface
interface
subroutine psb_d_cscnv_ip(a,iinfo,type,mold,dupl)
@ -453,7 +441,7 @@ module psb_d_mat_mod
class(psb_d_base_sparse_mat), intent(in), optional :: mold
end subroutine psb_d_cscnv_ip
end interface
interface
subroutine psb_d_cscnv_base(a,b,info,dupl)
@ -464,7 +452,7 @@ module psb_d_mat_mod
integer,optional, intent(in) :: dupl
end subroutine psb_d_cscnv_base
end interface
interface
subroutine psb_d_clip_d(a,b,info)
import :: psb_dspmat_type
@ -473,7 +461,7 @@ module psb_d_mat_mod
integer,intent(out) :: info
end subroutine psb_d_clip_d
end interface
interface
subroutine psb_d_clip_d_ip(a,info)
import :: psb_dspmat_type
@ -481,39 +469,39 @@ module psb_d_mat_mod
integer,intent(out) :: info
end subroutine psb_d_clip_d_ip
end interface
interface
subroutine psb_d_mv_from(a,b)
import :: psb_dspmat_type, psb_dpk_, psb_d_base_sparse_mat
class(psb_dspmat_type), intent(out) :: a
class(psb_dspmat_type), intent(out) :: a
class(psb_d_base_sparse_mat), intent(inout) :: b
end subroutine psb_d_mv_from
end interface
interface
subroutine psb_d_cp_from(a,b)
import :: psb_dspmat_type, psb_dpk_, psb_d_base_sparse_mat
class(psb_dspmat_type), intent(out) :: a
class(psb_d_base_sparse_mat), intent(in) :: b
class(psb_dspmat_type), intent(out) :: a
class(psb_d_base_sparse_mat), intent(inout), allocatable :: b
end subroutine psb_d_cp_from
end interface
interface
subroutine psb_d_mv_to(a,b)
import :: psb_dspmat_type, psb_dpk_, psb_d_base_sparse_mat
class(psb_dspmat_type), intent(inout) :: a
class(psb_dspmat_type), intent(inout) :: a
class(psb_d_base_sparse_mat), intent(out) :: b
end subroutine psb_d_mv_to
end interface
interface
subroutine psb_d_cp_to(a,b)
import :: psb_dspmat_type, psb_dpk_, psb_d_base_sparse_mat
class(psb_dspmat_type), intent(in) :: a
class(psb_dspmat_type), intent(in) :: a
class(psb_d_base_sparse_mat), intent(out) :: b
end subroutine psb_d_cp_to
end interface
interface psb_move_alloc
subroutine psb_dspmat_type_move(a,b,info)
import :: psb_dspmat_type
@ -522,14 +510,14 @@ module psb_d_mat_mod
integer, intent(out) :: info
end subroutine psb_dspmat_type_move
end interface
interface psb_clone
subroutine psb_dspmat_type_clone(a,b,info)
subroutine psb_dspmat_clone(a,b,info)
import :: psb_dspmat_type
class(psb_dspmat_type), intent(in) :: a
class(psb_dspmat_type), intent(out) :: b
integer, intent(out) :: info
end subroutine psb_dspmat_type_clone
end subroutine psb_dspmat_clone
end interface
interface
@ -539,14 +527,14 @@ module psb_d_mat_mod
class(psb_d_base_sparse_mat), allocatable, intent(out) :: b
end subroutine psb_d_mold
end interface
interface
subroutine psb_d_transp_1mat(a)
import :: psb_dspmat_type
class(psb_dspmat_type), intent(inout) :: a
end subroutine psb_d_transp_1mat
end interface
interface
subroutine psb_d_transp_2mat(a,b)
import :: psb_dspmat_type
@ -554,14 +542,14 @@ module psb_d_mat_mod
class(psb_dspmat_type), intent(out) :: b
end subroutine psb_d_transp_2mat
end interface
interface
subroutine psb_d_transc_1mat(a)
import :: psb_dspmat_type
class(psb_dspmat_type), intent(inout) :: a
end subroutine psb_d_transc_1mat
end interface
interface
subroutine psb_d_transc_2mat(a,b)
import :: psb_dspmat_type
@ -569,15 +557,16 @@ module psb_d_mat_mod
class(psb_dspmat_type), intent(out) :: b
end subroutine psb_d_transc_2mat
end interface
interface
subroutine psb_d_reinit(a,clear)
import :: psb_dspmat_type
class(psb_dspmat_type), intent(inout) :: a
logical, intent(in), optional :: clear
end subroutine psb_d_reinit
end interface
! == ===================================
@ -613,15 +602,15 @@ module psb_d_mat_mod
subroutine psb_d_csmv_vect(alpha,a,x,beta,y,info,trans)
use psb_d_vect_mod, only : psb_d_vect_type
import :: psb_dspmat_type, psb_dpk_
class(psb_dspmat_type), intent(in) :: a
real(psb_dpk_), intent(in) :: alpha, beta
type(psb_d_vect_type), intent(inout) :: x
type(psb_d_vect_type), intent(inout) :: y
integer, intent(out) :: info
character, optional, intent(in) :: trans
class(psb_dspmat_type), intent(in) :: a
real(psb_dpk_), intent(in) :: alpha, beta
type(psb_d_vect_type), intent(inout) :: x
type(psb_d_vect_type), intent(inout) :: y
integer, intent(out) :: info
character, optional, intent(in) :: trans
end subroutine psb_d_csmv_vect
end interface
interface psb_cssm
subroutine psb_d_cssm(alpha,a,x,beta,y,info,trans,scale,d)
import :: psb_dspmat_type, psb_dpk_
@ -645,7 +634,7 @@ module psb_d_mat_mod
use psb_d_vect_mod, only : psb_d_vect_type
import :: psb_dspmat_type, psb_dpk_
class(psb_dspmat_type), intent(in) :: a
real(psb_dpk_), intent(in) :: alpha, beta
real(psb_dpk_), intent(in) :: alpha, beta
type(psb_d_vect_type), intent(inout) :: x
type(psb_d_vect_type), intent(inout) :: y
integer, intent(out) :: info
@ -653,7 +642,7 @@ module psb_d_mat_mod
type(psb_d_vect_type), optional, intent(inout) :: d
end subroutine psb_d_cssv_vect
end interface
interface
function psb_d_maxval(a) result(res)
import :: psb_dspmat_type, psb_dpk_
@ -682,8 +671,8 @@ module psb_d_mat_mod
subroutine psb_d_rowsum(d,a,info)
import :: psb_dspmat_type, psb_dpk_
class(psb_dspmat_type), intent(in) :: a
real(psb_dpk_), intent(out) :: d(:)
integer, intent(out) :: info
real(psb_dpk_), intent(out) :: d(:)
integer, intent(out) :: info
end subroutine psb_d_rowsum
end interface
@ -691,8 +680,8 @@ module psb_d_mat_mod
subroutine psb_d_arwsum(d,a,info)
import :: psb_dspmat_type, psb_dpk_
class(psb_dspmat_type), intent(in) :: a
real(psb_dpk_), intent(out) :: d(:)
integer, intent(out) :: info
real(psb_dpk_), intent(out) :: d(:)
integer, intent(out) :: info
end subroutine psb_d_arwsum
end interface
@ -700,8 +689,8 @@ module psb_d_mat_mod
subroutine psb_d_colsum(d,a,info)
import :: psb_dspmat_type, psb_dpk_
class(psb_dspmat_type), intent(in) :: a
real(psb_dpk_), intent(out) :: d(:)
integer, intent(out) :: info
real(psb_dpk_), intent(out) :: d(:)
integer, intent(out) :: info
end subroutine psb_d_colsum
end interface
@ -709,12 +698,12 @@ module psb_d_mat_mod
subroutine psb_d_aclsum(d,a,info)
import :: psb_dspmat_type, psb_dpk_
class(psb_dspmat_type), intent(in) :: a
real(psb_dpk_), intent(out) :: d(:)
integer, intent(out) :: info
real(psb_dpk_), intent(out) :: d(:)
integer, intent(out) :: info
end subroutine psb_d_aclsum
end interface
interface
subroutine psb_d_get_diag(a,d,info)
import :: psb_dspmat_type, psb_dpk_
@ -723,7 +712,7 @@ module psb_d_mat_mod
integer, intent(out) :: info
end subroutine psb_d_get_diag
end interface
interface psb_scal
subroutine psb_d_scal(d,a,info)
import :: psb_dspmat_type, psb_dpk_
@ -755,21 +744,20 @@ contains
!
! == ===================================
function psb_d_sizeof(a) result(res)
implicit none
class(psb_dspmat_type), intent(in) :: a
integer(psb_long_int_k_) :: res
res = 0
if (allocated(a%a)) then
res = a%a%sizeof()
end if
end function psb_d_sizeof
function psb_d_get_fmt(a) result(res)
implicit none
class(psb_dspmat_type), intent(in) :: a
@ -796,19 +784,6 @@ contains
end if
end function psb_d_get_dupl
function psb_d_get_state(a) result(res)
implicit none
class(psb_dspmat_type), intent(in) :: a
integer :: res
if (allocated(a%a)) then
res = a%a%get_state()
else
res = psb_spmat_null_
end if
end function psb_d_get_state
function psb_d_get_nrows(a) result(res)
implicit none
class(psb_dspmat_type), intent(in) :: a
@ -988,9 +963,10 @@ contains
integer :: res
res = 0
if (allocated(a%a)) res = a%a%get_nz_row(idx)
end function psb_d_get_nz_row
end module psb_d_mat_mod

272
base/modules/psb_s_mat_mod.f90
Unescape Escape View File

@ -59,7 +59,6 @@ module psb_s_mat_mod
procedure, pass(a) :: get_nzeros => psb_s_get_nzeros
procedure, pass(a) :: get_nz_row => psb_s_get_nz_row
procedure, pass(a) :: get_size => psb_s_get_size
procedure, pass(a) :: get_state => psb_s_get_state
procedure, pass(a) :: get_dupl => psb_s_get_dupl
procedure, pass(a) :: is_null => psb_s_is_null
procedure, pass(a) :: is_bld => psb_s_is_bld
@ -77,7 +76,6 @@ module psb_s_mat_mod
procedure, pass(a) :: set_nrows => psb_s_set_nrows
procedure, pass(a) :: set_ncols => psb_s_set_ncols
procedure, pass(a) :: set_dupl => psb_s_set_dupl
procedure, pass(a) :: set_state => psb_s_set_state
procedure, pass(a) :: set_null => psb_s_set_null
procedure, pass(a) :: set_bld => psb_s_set_bld
procedure, pass(a) :: set_upd => psb_s_set_upd
@ -109,7 +107,7 @@ module psb_s_mat_mod
procedure, pass(a) :: s_cscnv_ip => psb_s_cscnv_ip
procedure, pass(a) :: s_cscnv_base => psb_s_cscnv_base
generic, public :: cscnv => s_cscnv, s_cscnv_ip, s_cscnv_base
procedure, pass(a) :: clone => psb_sspmat_type_clone
procedure, pass(a) :: clone => psb_sspmat_clone
procedure, pass(a) :: reinit => psb_s_reinit
procedure, pass(a) :: print_i => psb_s_sparse_print
procedure, pass(a) :: print_n => psb_s_n_sparse_print
@ -130,8 +128,6 @@ module psb_s_mat_mod
procedure, pass(a) :: s_transc_2mat => psb_s_transc_2mat
generic, public :: transc => s_transc_1mat, s_transc_2mat
! Computational routines
procedure, pass(a) :: get_diag => psb_s_get_diag
procedure, pass(a) :: maxval => psb_s_maxval
@ -156,9 +152,9 @@ module psb_s_mat_mod
end type psb_sspmat_type
private :: psb_s_get_nrows, psb_s_get_ncols, psb_s_get_nzeros, psb_s_get_size, &
& psb_s_get_state, psb_s_get_dupl, psb_s_is_null, psb_s_is_bld, psb_s_is_upd, &
& psb_s_is_asb, psb_s_is_sorted, psb_s_is_upper, psb_s_is_lower, psb_s_is_triangle,&
& psb_s_get_nz_row
& psb_s_get_dupl, psb_s_is_null, psb_s_is_bld, &
& psb_s_is_upd, psb_s_is_asb, psb_s_is_sorted, psb_s_is_upper, &
& psb_s_is_lower, psb_s_is_triangle, psb_s_get_nz_row
interface psb_sizeof
module procedure psb_s_sizeof
@ -186,7 +182,7 @@ module psb_s_mat_mod
integer, intent(in) :: m
end subroutine psb_s_set_nrows
end interface
interface
subroutine psb_s_set_ncols(n,a)
import :: psb_sspmat_type
@ -194,15 +190,7 @@ module psb_s_mat_mod
integer, intent(in) :: n
end subroutine psb_s_set_ncols
end interface
interface
subroutine psb_s_set_state(n,a)
import :: psb_sspmat_type
class(psb_sspmat_type), intent(inout) :: a
integer, intent(in) :: n
end subroutine psb_s_set_state
end interface
interface
subroutine psb_s_set_dupl(n,a)
import :: psb_sspmat_type
@ -210,35 +198,35 @@ module psb_s_mat_mod
integer, intent(in) :: n
end subroutine psb_s_set_dupl
end interface
interface
subroutine psb_s_set_null(a)
import :: psb_sspmat_type
class(psb_sspmat_type), intent(inout) :: a
end subroutine psb_s_set_null
end interface
interface
subroutine psb_s_set_bld(a)
import :: psb_sspmat_type
class(psb_sspmat_type), intent(inout) :: a
end subroutine psb_s_set_bld
end interface
interface
subroutine psb_s_set_upd(a)
import :: psb_sspmat_type
class(psb_sspmat_type), intent(inout) :: a
end subroutine psb_s_set_upd
end interface
interface
subroutine psb_s_set_asb(a)
import :: psb_sspmat_type
class(psb_sspmat_type), intent(inout) :: a
end subroutine psb_s_set_asb
end interface
interface
subroutine psb_s_set_sorted(a,val)
import :: psb_sspmat_type
@ -246,7 +234,7 @@ module psb_s_mat_mod
logical, intent(in), optional :: val
end subroutine psb_s_set_sorted
end interface
interface
subroutine psb_s_set_triangle(a,val)
import :: psb_sspmat_type
@ -254,7 +242,7 @@ module psb_s_mat_mod
logical, intent(in), optional :: val
end subroutine psb_s_set_triangle
end interface
interface
subroutine psb_s_set_unit(a,val)
import :: psb_sspmat_type
@ -262,7 +250,7 @@ module psb_s_mat_mod
logical, intent(in), optional :: val
end subroutine psb_s_set_unit
end interface
interface
subroutine psb_s_set_lower(a,val)
import :: psb_sspmat_type
@ -270,7 +258,7 @@ module psb_s_mat_mod
logical, intent(in), optional :: val
end subroutine psb_s_set_lower
end interface
interface
subroutine psb_s_set_upper(a,val)
import :: psb_sspmat_type
@ -278,8 +266,7 @@ module psb_s_mat_mod
logical, intent(in), optional :: val
end subroutine psb_s_set_upper
end interface
interface
subroutine psb_s_sparse_print(iout,a,iv,eirs,eics,head,ivr,ivc)
import :: psb_sspmat_type
@ -303,7 +290,7 @@ module psb_s_mat_mod
integer, intent(in), optional :: ivr(:), ivc(:)
end subroutine psb_s_n_sparse_print
end interface
interface
subroutine psb_s_get_neigh(a,idx,neigh,n,info,lev)
import :: psb_sspmat_type
@ -315,7 +302,7 @@ module psb_s_mat_mod
integer, optional, intent(in) :: lev
end subroutine psb_s_get_neigh
end interface
interface
subroutine psb_s_csall(nr,nc,a,info,nz)
import :: psb_sspmat_type
@ -325,7 +312,7 @@ module psb_s_mat_mod
integer, intent(in), optional :: nz
end subroutine psb_s_csall
end interface
interface
subroutine psb_s_reallocate_nz(nz,a)
import :: psb_sspmat_type
@ -333,36 +320,36 @@ module psb_s_mat_mod
class(psb_sspmat_type), intent(inout) :: a
end subroutine psb_s_reallocate_nz
end interface
interface
subroutine psb_s_free(a)
import :: psb_sspmat_type
class(psb_sspmat_type), intent(inout) :: a
end subroutine psb_s_free
end interface
interface
subroutine psb_s_trim(a)
import :: psb_sspmat_type
class(psb_sspmat_type), intent(inout) :: a
end subroutine psb_s_trim
end interface
interface
subroutine psb_s_csput(nz,ia,ja,val,a,imin,imax,jmin,jmax,info,gtl)
import :: psb_sspmat_type, psb_spk_
import :: psb_sspmat_type, psb_dpk_
class(psb_sspmat_type), intent(inout) :: a
real(psb_spk_), intent(in) :: val(:)
real(psb_dpk_), intent(in) :: val(:)
integer, intent(in) :: nz, ia(:), ja(:), imin,imax,jmin,jmax
integer, intent(out) :: info
integer, intent(in), optional :: gtl(:)
end subroutine psb_s_csput
end interface
interface
subroutine psb_s_csgetptn(imin,imax,a,nz,ia,ja,info,&
& jmin,jmax,iren,append,nzin,rscale,cscale)
import :: psb_sspmat_type, psb_spk_
& jmin,jmax,iren,append,nzin,rscale,cscale)
import :: psb_sspmat_type, psb_dpk_
class(psb_sspmat_type), intent(in) :: a
integer, intent(in) :: imin,imax
integer, intent(out) :: nz
@ -374,16 +361,16 @@ module psb_s_mat_mod
logical, intent(in), optional :: rscale,cscale
end subroutine psb_s_csgetptn
end interface
interface
subroutine psb_s_csgetrow(imin,imax,a,nz,ia,ja,val,info,&
& jmin,jmax,iren,append,nzin,rscale,cscale)
import :: psb_sspmat_type, psb_spk_
import :: psb_sspmat_type, psb_dpk_
class(psb_sspmat_type), intent(in) :: a
integer, intent(in) :: imin,imax
integer, intent(out) :: nz
integer, allocatable, intent(inout) :: ia(:), ja(:)
real(psb_spk_), allocatable, intent(inout) :: val(:)
real(psb_dpk_), allocatable, intent(inout) :: val(:)
integer,intent(out) :: info
logical, intent(in), optional :: append
integer, intent(in), optional :: iren(:)
@ -391,11 +378,11 @@ module psb_s_mat_mod
logical, intent(in), optional :: rscale,cscale
end subroutine psb_s_csgetrow
end interface
interface
subroutine psb_s_csgetblk(imin,imax,a,b,info,&
& jmin,jmax,iren,append,rscale,cscale)
import :: psb_sspmat_type, psb_spk_
& jmin,jmax,iren,append,rscale,cscale)
import :: psb_sspmat_type, psb_dpk_
class(psb_sspmat_type), intent(in) :: a
class(psb_sspmat_type), intent(out) :: b
integer, intent(in) :: imin,imax
@ -406,11 +393,11 @@ module psb_s_mat_mod
logical, intent(in), optional :: rscale,cscale
end subroutine psb_s_csgetblk
end interface
interface
subroutine psb_s_csclip(a,b,info,&
& imin,imax,jmin,jmax,rscale,cscale)
import :: psb_sspmat_type, psb_spk_
& imin,imax,jmin,jmax,rscale,cscale)
import :: psb_sspmat_type, psb_dpk_
class(psb_sspmat_type), intent(in) :: a
class(psb_sspmat_type), intent(out) :: b
integer,intent(out) :: info
@ -418,11 +405,11 @@ module psb_s_mat_mod
logical, intent(in), optional :: rscale,cscale
end subroutine psb_s_csclip
end interface
interface
subroutine psb_s_b_csclip(a,b,info,&
& imin,imax,jmin,jmax,rscale,cscale)
import :: psb_sspmat_type, psb_spk_, psb_s_coo_sparse_mat
& imin,imax,jmin,jmax,rscale,cscale)
import :: psb_sspmat_type, psb_dpk_, psb_s_coo_sparse_mat
class(psb_sspmat_type), intent(in) :: a
type(psb_s_coo_sparse_mat), intent(out) :: b
integer,intent(out) :: info
@ -430,10 +417,10 @@ module psb_s_mat_mod
logical, intent(in), optional :: rscale,cscale
end subroutine psb_s_b_csclip
end interface
interface
subroutine psb_s_cscnv(a,b,info,type,mold,upd,dupl)
import :: psb_sspmat_type, psb_spk_, psb_s_base_sparse_mat
import :: psb_sspmat_type, psb_dpk_, psb_s_base_sparse_mat
class(psb_sspmat_type), intent(in) :: a
class(psb_sspmat_type), intent(out) :: b
integer, intent(out) :: info
@ -442,11 +429,11 @@ module psb_s_mat_mod
class(psb_s_base_sparse_mat), intent(in), optional :: mold
end subroutine psb_s_cscnv
end interface
interface
subroutine psb_s_cscnv_ip(a,iinfo,type,mold,dupl)
import :: psb_sspmat_type, psb_spk_, psb_s_base_sparse_mat
import :: psb_sspmat_type, psb_dpk_, psb_s_base_sparse_mat
class(psb_sspmat_type), intent(inout) :: a
integer, intent(out) :: iinfo
integer,optional, intent(in) :: dupl
@ -454,18 +441,18 @@ module psb_s_mat_mod
class(psb_s_base_sparse_mat), intent(in), optional :: mold
end subroutine psb_s_cscnv_ip
end interface
interface
subroutine psb_s_cscnv_base(a,b,info,dupl)
import :: psb_sspmat_type, psb_spk_, psb_s_base_sparse_mat
import :: psb_sspmat_type, psb_dpk_, psb_s_base_sparse_mat
class(psb_sspmat_type), intent(in) :: a
class(psb_s_base_sparse_mat), intent(out) :: b
integer, intent(out) :: info
integer,optional, intent(in) :: dupl
end subroutine psb_s_cscnv_base
end interface
interface
subroutine psb_s_clip_d(a,b,info)
import :: psb_sspmat_type
@ -474,7 +461,7 @@ module psb_s_mat_mod
integer,intent(out) :: info
end subroutine psb_s_clip_d
end interface
interface
subroutine psb_s_clip_d_ip(a,info)
import :: psb_sspmat_type
@ -482,39 +469,39 @@ module psb_s_mat_mod
integer,intent(out) :: info
end subroutine psb_s_clip_d_ip
end interface
interface
subroutine psb_s_mv_from(a,b)
import :: psb_sspmat_type, psb_spk_, psb_s_base_sparse_mat
class(psb_sspmat_type), intent(out) :: a
import :: psb_sspmat_type, psb_dpk_, psb_s_base_sparse_mat
class(psb_sspmat_type), intent(out) :: a
class(psb_s_base_sparse_mat), intent(inout) :: b
end subroutine psb_s_mv_from
end interface
interface
subroutine psb_s_cp_from(a,b)
import :: psb_sspmat_type, psb_spk_, psb_s_base_sparse_mat
class(psb_sspmat_type), intent(out) :: a
class(psb_s_base_sparse_mat), intent(in) :: b
import :: psb_sspmat_type, psb_dpk_, psb_s_base_sparse_mat
class(psb_sspmat_type), intent(out) :: a
class(psb_s_base_sparse_mat), intent(inout), allocatable :: b
end subroutine psb_s_cp_from
end interface
interface
subroutine psb_s_mv_to(a,b)
import :: psb_sspmat_type, psb_spk_, psb_s_base_sparse_mat
class(psb_sspmat_type), intent(inout) :: a
import :: psb_sspmat_type, psb_dpk_, psb_s_base_sparse_mat
class(psb_sspmat_type), intent(inout) :: a
class(psb_s_base_sparse_mat), intent(out) :: b
end subroutine psb_s_mv_to
end interface
interface
subroutine psb_s_cp_to(a,b)
import :: psb_sspmat_type, psb_spk_, psb_s_base_sparse_mat
class(psb_sspmat_type), intent(in) :: a
import :: psb_sspmat_type, psb_dpk_, psb_s_base_sparse_mat
class(psb_sspmat_type), intent(in) :: a
class(psb_s_base_sparse_mat), intent(out) :: b
end subroutine psb_s_cp_to
end interface
interface psb_move_alloc
subroutine psb_sspmat_type_move(a,b,info)
import :: psb_sspmat_type
@ -522,15 +509,15 @@ module psb_s_mat_mod
class(psb_sspmat_type), intent(out) :: b
integer, intent(out) :: info
end subroutine psb_sspmat_type_move
end interface psb_move_alloc
end interface
interface psb_clone
subroutine psb_sspmat_type_clone(a,b,info)
subroutine psb_sspmat_clone(a,b,info)
import :: psb_sspmat_type
class(psb_sspmat_type), intent(in) :: a
class(psb_sspmat_type), intent(out) :: b
integer, intent(out) :: info
end subroutine psb_sspmat_type_clone
end subroutine psb_sspmat_clone
end interface
interface
@ -540,14 +527,14 @@ module psb_s_mat_mod
class(psb_s_base_sparse_mat), allocatable, intent(out) :: b
end subroutine psb_s_mold
end interface
interface
subroutine psb_s_transp_1mat(a)
import :: psb_sspmat_type
class(psb_sspmat_type), intent(inout) :: a
end subroutine psb_s_transp_1mat
end interface
interface
subroutine psb_s_transp_2mat(a,b)
import :: psb_sspmat_type
@ -555,14 +542,14 @@ module psb_s_mat_mod
class(psb_sspmat_type), intent(out) :: b
end subroutine psb_s_transp_2mat
end interface
interface
subroutine psb_s_transc_1mat(a)
import :: psb_sspmat_type
class(psb_sspmat_type), intent(inout) :: a
end subroutine psb_s_transc_1mat
end interface
interface
subroutine psb_s_transc_2mat(a,b)
import :: psb_sspmat_type
@ -570,15 +557,16 @@ module psb_s_mat_mod
class(psb_sspmat_type), intent(out) :: b
end subroutine psb_s_transc_2mat
end interface
interface
subroutine psb_s_reinit(a,clear)
import :: psb_sspmat_type
class(psb_sspmat_type), intent(inout) :: a
logical, intent(in), optional :: clear
end subroutine psb_s_reinit
end interface
! == ===================================
@ -596,57 +584,57 @@ module psb_s_mat_mod
interface psb_csmm
subroutine psb_s_csmm(alpha,a,x,beta,y,info,trans)
import :: psb_sspmat_type, psb_spk_
import :: psb_sspmat_type, psb_dpk_
class(psb_sspmat_type), intent(in) :: a
real(psb_spk_), intent(in) :: alpha, beta, x(:,:)
real(psb_spk_), intent(inout) :: y(:,:)
real(psb_dpk_), intent(in) :: alpha, beta, x(:,:)
real(psb_dpk_), intent(inout) :: y(:,:)
integer, intent(out) :: info
character, optional, intent(in) :: trans
end subroutine psb_s_csmm
subroutine psb_s_csmv(alpha,a,x,beta,y,info,trans)
import :: psb_sspmat_type, psb_spk_
import :: psb_sspmat_type, psb_dpk_
class(psb_sspmat_type), intent(in) :: a
real(psb_spk_), intent(in) :: alpha, beta, x(:)
real(psb_spk_), intent(inout) :: y(:)
real(psb_dpk_), intent(in) :: alpha, beta, x(:)
real(psb_dpk_), intent(inout) :: y(:)
integer, intent(out) :: info
character, optional, intent(in) :: trans
end subroutine psb_s_csmv
subroutine psb_s_csmv_vect(alpha,a,x,beta,y,info,trans)
use psb_s_vect_mod, only : psb_s_vect_type
import :: psb_sspmat_type, psb_spk_
import :: psb_sspmat_type, psb_dpk_
class(psb_sspmat_type), intent(in) :: a
real(psb_spk_), intent(in) :: alpha, beta
real(psb_dpk_), intent(in) :: alpha, beta
type(psb_s_vect_type), intent(inout) :: x
type(psb_s_vect_type), intent(inout) :: y
integer, intent(out) :: info
character, optional, intent(in) :: trans
end subroutine psb_s_csmv_vect
end interface
interface psb_cssm
subroutine psb_s_cssm(alpha,a,x,beta,y,info,trans,scale,d)
import :: psb_sspmat_type, psb_spk_
import :: psb_sspmat_type, psb_dpk_
class(psb_sspmat_type), intent(in) :: a
real(psb_spk_), intent(in) :: alpha, beta, x(:,:)
real(psb_spk_), intent(inout) :: y(:,:)
real(psb_dpk_), intent(in) :: alpha, beta, x(:,:)
real(psb_dpk_), intent(inout) :: y(:,:)
integer, intent(out) :: info
character, optional, intent(in) :: trans, scale
real(psb_spk_), intent(in), optional :: d(:)
real(psb_dpk_), intent(in), optional :: d(:)
end subroutine psb_s_cssm
subroutine psb_s_cssv(alpha,a,x,beta,y,info,trans,scale,d)
import :: psb_sspmat_type, psb_spk_
import :: psb_sspmat_type, psb_dpk_
class(psb_sspmat_type), intent(in) :: a
real(psb_spk_), intent(in) :: alpha, beta, x(:)
real(psb_spk_), intent(inout) :: y(:)
real(psb_dpk_), intent(in) :: alpha, beta, x(:)
real(psb_dpk_), intent(inout) :: y(:)
integer, intent(out) :: info
character, optional, intent(in) :: trans, scale
real(psb_spk_), intent(in), optional :: d(:)
real(psb_dpk_), intent(in), optional :: d(:)
end subroutine psb_s_cssv
subroutine psb_s_cssv_vect(alpha,a,x,beta,y,info,trans,scale,d)
use psb_s_vect_mod, only : psb_s_vect_type
import :: psb_sspmat_type, psb_spk_
import :: psb_sspmat_type, psb_dpk_
class(psb_sspmat_type), intent(in) :: a
real(psb_spk_), intent(in) :: alpha, beta
real(psb_dpk_), intent(in) :: alpha, beta
type(psb_s_vect_type), intent(inout) :: x
type(psb_s_vect_type), intent(inout) :: y
integer, intent(out) :: info
@ -654,87 +642,88 @@ module psb_s_mat_mod
type(psb_s_vect_type), optional, intent(inout) :: d
end subroutine psb_s_cssv_vect
end interface
interface
function psb_s_maxval(a) result(res)
import :: psb_sspmat_type, psb_spk_
import :: psb_sspmat_type, psb_dpk_
class(psb_sspmat_type), intent(in) :: a
real(psb_spk_) :: res
real(psb_dpk_) :: res
end function psb_s_maxval
end interface
interface
function psb_s_csnmi(a) result(res)
import :: psb_sspmat_type, psb_spk_
import :: psb_sspmat_type, psb_dpk_
class(psb_sspmat_type), intent(in) :: a
real(psb_spk_) :: res
real(psb_dpk_) :: res
end function psb_s_csnmi
end interface
interface
function psb_s_csnm1(a) result(res)
import :: psb_sspmat_type, psb_spk_
import :: psb_sspmat_type, psb_dpk_
class(psb_sspmat_type), intent(in) :: a
real(psb_spk_) :: res
real(psb_dpk_) :: res
end function psb_s_csnm1
end interface
interface
subroutine psb_s_rowsum(d,a,info)
import :: psb_sspmat_type, psb_spk_
import :: psb_sspmat_type, psb_dpk_
class(psb_sspmat_type), intent(in) :: a
real(psb_spk_), intent(out) :: d(:)
integer, intent(out) :: info
real(psb_dpk_), intent(out) :: d(:)
integer, intent(out) :: info
end subroutine psb_s_rowsum
end interface
interface
subroutine psb_s_arwsum(d,a,info)
import :: psb_sspmat_type, psb_spk_
import :: psb_sspmat_type, psb_dpk_
class(psb_sspmat_type), intent(in) :: a
real(psb_spk_), intent(out) :: d(:)
integer, intent(out) :: info
real(psb_dpk_), intent(out) :: d(:)
integer, intent(out) :: info
end subroutine psb_s_arwsum
end interface
interface
subroutine psb_s_colsum(d,a,info)
import :: psb_sspmat_type, psb_spk_
import :: psb_sspmat_type, psb_dpk_
class(psb_sspmat_type), intent(in) :: a
real(psb_spk_), intent(out) :: d(:)
integer, intent(out) :: info
real(psb_dpk_), intent(out) :: d(:)
integer, intent(out) :: info
end subroutine psb_s_colsum
end interface
interface
subroutine psb_s_aclsum(d,a,info)
import :: psb_sspmat_type, psb_spk_
import :: psb_sspmat_type, psb_dpk_
class(psb_sspmat_type), intent(in) :: a
real(psb_spk_), intent(out) :: d(:)
integer, intent(out) :: info
real(psb_dpk_), intent(out) :: d(:)
integer, intent(out) :: info
end subroutine psb_s_aclsum
end interface
interface
subroutine psb_s_get_diag(a,d,info)
import :: psb_sspmat_type, psb_spk_
import :: psb_sspmat_type, psb_dpk_
class(psb_sspmat_type), intent(in) :: a
real(psb_spk_), intent(out) :: d(:)
real(psb_dpk_), intent(out) :: d(:)
integer, intent(out) :: info
end subroutine psb_s_get_diag
end interface
interface psb_scal
subroutine psb_s_scal(d,a,info)
import :: psb_sspmat_type, psb_spk_
import :: psb_sspmat_type, psb_dpk_
class(psb_sspmat_type), intent(inout) :: a
real(psb_spk_), intent(in) :: d(:)
real(psb_dpk_), intent(in) :: d(:)
integer, intent(out) :: info
end subroutine psb_s_scal
subroutine psb_s_scals(d,a,info)
import :: psb_sspmat_type, psb_spk_
import :: psb_sspmat_type, psb_dpk_
class(psb_sspmat_type), intent(inout) :: a
real(psb_spk_), intent(in) :: d
real(psb_dpk_), intent(in) :: d
integer, intent(out) :: info
end subroutine psb_s_scals
end interface
@ -755,21 +744,20 @@ contains
!
! == ===================================
function psb_s_sizeof(a) result(res)
implicit none
class(psb_sspmat_type), intent(in) :: a
integer(psb_long_int_k_) :: res
res = 0
if (allocated(a%a)) then
res = a%a%sizeof()
end if
end function psb_s_sizeof
function psb_s_get_fmt(a) result(res)
implicit none
class(psb_sspmat_type), intent(in) :: a
@ -796,19 +784,6 @@ contains
end if
end function psb_s_get_dupl
function psb_s_get_state(a) result(res)
implicit none
class(psb_sspmat_type), intent(in) :: a
integer :: res
if (allocated(a%a)) then
res = a%a%get_state()
else
res = psb_spmat_null_
end if
end function psb_s_get_state
function psb_s_get_nrows(a) result(res)
implicit none
class(psb_sspmat_type), intent(in) :: a
@ -988,9 +963,10 @@ contains
integer :: res
res = 0
if (allocated(a%a)) res = a%a%get_nz_row(idx)
end function psb_s_get_nz_row
end module psb_s_mat_mod

43
base/modules/psb_z_mat_mod.f90
Unescape Escape View File

@ -59,7 +59,6 @@ module psb_z_mat_mod
procedure, pass(a) :: get_nzeros => psb_z_get_nzeros
procedure, pass(a) :: get_nz_row => psb_z_get_nz_row
procedure, pass(a) :: get_size => psb_z_get_size
procedure, pass(a) :: get_state => psb_z_get_state
procedure, pass(a) :: get_dupl => psb_z_get_dupl
procedure, pass(a) :: is_null => psb_z_is_null
procedure, pass(a) :: is_bld => psb_z_is_bld
@ -77,7 +76,6 @@ module psb_z_mat_mod
procedure, pass(a) :: set_nrows => psb_z_set_nrows
procedure, pass(a) :: set_ncols => psb_z_set_ncols
procedure, pass(a) :: set_dupl => psb_z_set_dupl
procedure, pass(a) :: set_state => psb_z_set_state
procedure, pass(a) :: set_null => psb_z_set_null
procedure, pass(a) :: set_bld => psb_z_set_bld
procedure, pass(a) :: set_upd => psb_z_set_upd
@ -109,7 +107,7 @@ module psb_z_mat_mod
procedure, pass(a) :: z_cscnv_ip => psb_z_cscnv_ip
procedure, pass(a) :: z_cscnv_base => psb_z_cscnv_base
generic, public :: cscnv => z_cscnv, z_cscnv_ip, z_cscnv_base
procedure, pass(a) :: clone => psb_zspmat_type_clone
procedure, pass(a) :: clone => psb_zspmat_clone
procedure, pass(a) :: reinit => psb_z_reinit
procedure, pass(a) :: print_i => psb_z_sparse_print
procedure, pass(a) :: print_n => psb_z_n_sparse_print
@ -154,9 +152,9 @@ module psb_z_mat_mod
end type psb_zspmat_type
private :: psb_z_get_nrows, psb_z_get_ncols, psb_z_get_nzeros, psb_z_get_size, &
& psb_z_get_state, psb_z_get_dupl, psb_z_is_null, psb_z_is_bld, psb_z_is_upd, &
& psb_z_is_asb, psb_z_is_sorted, psb_z_is_upper, psb_z_is_lower, psb_z_is_triangle,&
& psb_z_get_nz_row
& psb_z_get_dupl, psb_z_is_null, psb_z_is_bld, &
& psb_z_is_upd, psb_z_is_asb, psb_z_is_sorted, psb_z_is_upper, &
& psb_z_is_lower, psb_z_is_triangle, psb_z_get_nz_row
interface psb_sizeof
module procedure psb_z_sizeof
@ -193,14 +191,6 @@ module psb_z_mat_mod
end subroutine psb_z_set_ncols
end interface
interface
subroutine psb_z_set_state(n,a)
import :: psb_zspmat_type
class(psb_zspmat_type), intent(inout) :: a
integer, intent(in) :: n
end subroutine psb_z_set_state
end interface
interface
subroutine psb_z_set_dupl(n,a)
import :: psb_zspmat_type
@ -483,7 +473,7 @@ module psb_z_mat_mod
interface
subroutine psb_z_mv_from(a,b)
import :: psb_zspmat_type, psb_dpk_, psb_z_base_sparse_mat
class(psb_zspmat_type), intent(out) :: a
class(psb_zspmat_type), intent(out) :: a
class(psb_z_base_sparse_mat), intent(inout) :: b
end subroutine psb_z_mv_from
end interface
@ -491,15 +481,15 @@ module psb_z_mat_mod
interface
subroutine psb_z_cp_from(a,b)
import :: psb_zspmat_type, psb_dpk_, psb_z_base_sparse_mat
class(psb_zspmat_type), intent(out) :: a
class(psb_z_base_sparse_mat), intent(in) :: b
class(psb_zspmat_type), intent(out) :: a
class(psb_z_base_sparse_mat), intent(inout), allocatable :: b
end subroutine psb_z_cp_from
end interface
interface
subroutine psb_z_mv_to(a,b)
import :: psb_zspmat_type, psb_dpk_, psb_z_base_sparse_mat
class(psb_zspmat_type), intent(inout) :: a
class(psb_zspmat_type), intent(inout) :: a
class(psb_z_base_sparse_mat), intent(out) :: b
end subroutine psb_z_mv_to
end interface
@ -522,12 +512,12 @@ module psb_z_mat_mod
end interface
interface psb_clone
subroutine psb_zspmat_type_clone(a,b,info)
subroutine psb_zspmat_clone(a,b,info)
import :: psb_zspmat_type
class(psb_zspmat_type), intent(in) :: a
class(psb_zspmat_type), intent(out) :: b
integer, intent(out) :: info
end subroutine psb_zspmat_type_clone
end subroutine psb_zspmat_clone
end interface
interface
@ -794,19 +784,6 @@ contains
end if
end function psb_z_get_dupl
function psb_z_get_state(a) result(res)
implicit none
class(psb_zspmat_type), intent(in) :: a
integer :: res
if (allocated(a%a)) then
res = a%a%get_state()
else
res = psb_spmat_null_
end if
end function psb_z_get_state
function psb_z_get_nrows(a) result(res)
implicit none
class(psb_zspmat_type), intent(in) :: a

84
base/serial/impl/psb_c_mat_impl.F90
Unescape Escape View File

@ -1,3 +1,15 @@
!
! c_mat_impl:
! implementation of the outer matrix methods.
! Most of the methods rely on the STATE design pattern:
! the inner class(psb_c_base_sparse_mat) is responsbile
! for actually executing the method.
!
!
!
! == ===================================
!
!
@ -80,39 +92,12 @@ end subroutine psb_c_set_ncols
subroutine psb_c_set_state(n,a)
use psb_c_mat_mod, psb_protect_name => psb_c_set_state
use psb_error_mod
implicit none
class(psb_cspmat_type), intent(inout) :: a
integer, intent(in) :: n
Integer :: err_act, info
character(len=20) :: name='get_nzeros'
logical, parameter :: debug=.false.
call psb_erractionsave(err_act)
if (.not.allocated(a%a)) then
info = psb_err_invalid_mat_state_
call psb_errpush(info,name)
goto 9999
endif
call a%a%set_state(n)
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
end subroutine psb_c_set_state
!
! Valid values for DUPL:
! psb_dupl_ovwrt_
! psb_dupl_add_
! psb_dupl_err_
!
subroutine psb_c_set_dupl(n,a)
use psb_c_mat_mod, psb_protect_name => psb_c_set_dupl
@ -148,6 +133,10 @@ subroutine psb_c_set_dupl(n,a)
end subroutine psb_c_set_dupl
!
! Set the STATE of the internal matrix object
!
subroutine psb_c_set_null(a)
use psb_c_mat_mod, psb_protect_name => psb_c_set_null
use psb_error_mod
@ -1033,7 +1022,6 @@ subroutine psb_c_cscnv(a,b,info,type,mold,upd,dupl)
call psb_errpush(info,name)
goto 9999
endif
if (count( (/present(mold),present(type) /)) > 1) then
info = psb_err_many_optional_arg_
call psb_errpush(info,name,a_err='TYPE, MOLD')
@ -1071,14 +1059,15 @@ subroutine psb_c_cscnv(a,b,info,type,mold,upd,dupl)
call psb_errpush(info,name)
goto 9999
end if
if (present(dupl)) then
call altmp%set_dupl(dupl)
else if (a%is_bld()) then
! Does this make sense at all?? Who knows..
call altmp%set_dupl(psb_dupl_def_)
end if
if (debug) write(psb_err_unit,*) 'Converting from ',&
& a%get_fmt(),' to ',altmp%get_fmt()
@ -1421,10 +1410,14 @@ subroutine psb_c_cp_from(a,b)
call psb_erractionsave(err_act)
info = psb_success_
!
! Note: it is tempting to use SOURCE allocation below;
! however this would run the risk of messing up with data
! allocated externally (e.g. GPU-side data).
!
#if defined(HAVE_MOLD)
allocate(a%a,mold=b,stat=info)
if (info /= psb_success_) info = psb_err_alloc_dealloc_
#else
call b%mold(a%a,info)
#endif
@ -1507,10 +1500,10 @@ subroutine psb_cspmat_type_move(a,b,info)
end subroutine psb_cspmat_type_move
subroutine psb_cspmat_type_clone(a,b,info)
subroutine psb_cspmat_clone(a,b,info)
use psb_error_mod
use psb_string_mod
use psb_c_mat_mod, psb_protect_name => psb_cspmat_type_clone
use psb_c_mat_mod, psb_protect_name => psb_cspmat_clone
implicit none
class(psb_cspmat_type), intent(in) :: a
class(psb_cspmat_type), intent(out) :: b
@ -1529,7 +1522,6 @@ subroutine psb_cspmat_type_clone(a,b,info)
#else
call a%a%mold(b%a,info)
#endif
if (info /= psb_success_) info = psb_err_alloc_dealloc_
if (info == psb_success_) call b%a%cp_from_fmt(a%a, info)
if (info /= psb_success_) goto 9999
@ -1544,7 +1536,7 @@ subroutine psb_cspmat_type_clone(a,b,info)
return
end if
end subroutine psb_cspmat_type_clone
end subroutine psb_cspmat_clone
@ -1887,6 +1879,7 @@ subroutine psb_c_csmv_vect(alpha,a,x,beta,y,info,trans)
end subroutine psb_c_csmv_vect
subroutine psb_c_cssm(alpha,a,x,beta,y,info,trans,scale,d)
use psb_error_mod
use psb_c_mat_mod, psb_protect_name => psb_c_cssm
@ -2028,7 +2021,6 @@ subroutine psb_c_cssv_vect(alpha,a,x,beta,y,info,trans,scale,d)
end subroutine psb_c_cssv_vect
function psb_c_maxval(a) result(res)
use psb_c_mat_mod, psb_protect_name => psb_c_maxval
use psb_error_mod
@ -2037,6 +2029,7 @@ function psb_c_maxval(a) result(res)
class(psb_cspmat_type), intent(in) :: a
real(psb_spk_) :: res
Integer :: err_act, info
character(len=20) :: name='maxval'
logical, parameter :: debug=.false.
@ -2074,8 +2067,8 @@ function psb_c_csnmi(a) result(res)
character(len=20) :: name='csnmi'
logical, parameter :: debug=.false.
call psb_get_erraction(err_act)
info = psb_success_
call psb_get_erraction(err_act)
if (.not.allocated(a%a)) then
info = psb_err_invalid_mat_state_
call psb_errpush(info,name)
@ -2095,6 +2088,7 @@ function psb_c_csnmi(a) result(res)
end function psb_c_csnmi
function psb_c_csnm1(a) result(res)
use psb_c_mat_mod, psb_protect_name => psb_c_csnm1
use psb_error_mod
@ -2295,8 +2289,8 @@ subroutine psb_c_get_diag(a,d,info)
character(len=20) :: name='get_diag'
logical, parameter :: debug=.false.
call psb_erractionsave(err_act)
info = psb_success_
call psb_erractionsave(err_act)
if (.not.allocated(a%a)) then
info = psb_err_invalid_mat_state_
call psb_errpush(info,name)
@ -2334,8 +2328,8 @@ subroutine psb_c_scal(d,a,info)
character(len=20) :: name='scal'
logical, parameter :: debug=.false.
call psb_erractionsave(err_act)
info = psb_success_
call psb_erractionsave(err_act)
if (.not.allocated(a%a)) then
info = psb_err_invalid_mat_state_
call psb_errpush(info,name)

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

@ -1,3 +1,15 @@
!
! d_mat_impl:
! implementation of the outer matrix methods.
! Most of the methods rely on the STATE design pattern:
! the inner class(psb_d_base_sparse_mat) is responsbile
! for actually executing the method.
!
!
!
! == ===================================
!
!
@ -80,39 +92,12 @@ end subroutine psb_d_set_ncols
subroutine psb_d_set_state(n,a)
use psb_d_mat_mod, psb_protect_name => psb_d_set_state
use psb_error_mod
implicit none
class(psb_dspmat_type), intent(inout) :: a
integer, intent(in) :: n
Integer :: err_act, info
character(len=20) :: name='get_nzeros'
logical, parameter :: debug=.false.
call psb_erractionsave(err_act)
if (.not.allocated(a%a)) then
info = psb_err_invalid_mat_state_
call psb_errpush(info,name)
goto 9999
endif
call a%a%set_state(n)
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
end subroutine psb_d_set_state
!
! Valid values for DUPL:
! psb_dupl_ovwrt_
! psb_dupl_add_
! psb_dupl_err_
!
subroutine psb_d_set_dupl(n,a)
use psb_d_mat_mod, psb_protect_name => psb_d_set_dupl
@ -148,6 +133,10 @@ subroutine psb_d_set_dupl(n,a)
end subroutine psb_d_set_dupl
!
! Set the STATE of the internal matrix object
!
subroutine psb_d_set_null(a)
use psb_d_mat_mod, psb_protect_name => psb_d_set_null
use psb_error_mod
@ -495,6 +484,7 @@ subroutine psb_d_sparse_print(iout,a,iv,eirs,eics,head,ivr,ivc)
end subroutine psb_d_sparse_print
subroutine psb_d_n_sparse_print(fname,a,iv,eirs,eics,head,ivr,ivc)
use psb_d_mat_mod, psb_protect_name => psb_d_n_sparse_print
use psb_error_mod
@ -551,8 +541,6 @@ subroutine psb_d_n_sparse_print(fname,a,iv,eirs,eics,head,ivr,ivc)
end subroutine psb_d_n_sparse_print
subroutine psb_d_get_neigh(a,idx,neigh,n,info,lev)
use psb_d_mat_mod, psb_protect_name => psb_d_get_neigh
use psb_error_mod
@ -1013,8 +1001,8 @@ subroutine psb_d_cscnv(a,b,info,type,mold,upd,dupl)
use psb_string_mod
use psb_d_mat_mod, psb_protect_name => psb_d_cscnv
implicit none
class(psb_dspmat_type), intent(in) :: a
class(psb_dspmat_type), intent(out) :: b
class(psb_dspmat_type), intent(in) :: a
class(psb_dspmat_type), intent(out) :: b
integer, intent(out) :: info
integer,optional, intent(in) :: dupl, upd
character(len=*), optional, intent(in) :: type
@ -1034,8 +1022,6 @@ subroutine psb_d_cscnv(a,b,info,type,mold,upd,dupl)
call psb_errpush(info,name)
goto 9999
endif
if (count( (/present(mold),present(type) /)) > 1) then
info = psb_err_many_optional_arg_
call psb_errpush(info,name,a_err='TYPE, MOLD')
@ -1074,12 +1060,14 @@ subroutine psb_d_cscnv(a,b,info,type,mold,upd,dupl)
goto 9999
end if
if (present(dupl)) then
call altmp%set_dupl(dupl)
else if (a%is_bld()) then
! Does this make sense at all?? Who knows..
call altmp%set_dupl(psb_dupl_def_)
end if
if (debug) write(psb_err_unit,*) 'Converting from ',&
& a%get_fmt(),' to ',altmp%get_fmt()
@ -1091,7 +1079,7 @@ subroutine psb_d_cscnv(a,b,info,type,mold,upd,dupl)
goto 9999
end if
call move_alloc(altmp,b%a)
call move_alloc(altmp,b%a)
call b%set_asb()
call b%trim()
call psb_erractionrestore(err_act)
@ -1115,7 +1103,7 @@ subroutine psb_d_cscnv_ip(a,info,type,mold,dupl)
use psb_d_mat_mod, psb_protect_name => psb_d_cscnv_ip
implicit none
class(psb_dspmat_type), intent(inout) :: a
class(psb_dspmat_type), intent(inout) :: a
integer, intent(out) :: info
integer,optional, intent(in) :: dupl
character(len=*), optional, intent(in) :: type
@ -1422,13 +1410,18 @@ subroutine psb_d_cp_from(a,b)
call psb_erractionsave(err_act)
info = psb_success_
!
! Note: it is tempting to use SOURCE allocation below;
! however this would run the risk of messing up with data
! allocated externally (e.g. GPU-side data).
!
#if defined(HAVE_MOLD)
allocate(a%a,mold=b,stat=info)
if (info /= psb_success_) info = psb_err_alloc_dealloc_
#else
call b%mold(a%a,info)
#endif
if (info /= psb_success_) info = psb_err_alloc_dealloc_
if (info == psb_success_) call a%a%cp_from_fmt(b, info)
if (info /= psb_success_) goto 9999
@ -1507,10 +1500,10 @@ subroutine psb_dspmat_type_move(a,b,info)
end subroutine psb_dspmat_type_move
subroutine psb_dspmat_type_clone(a,b,info)
subroutine psb_dspmat_clone(a,b,info)
use psb_error_mod
use psb_string_mod
use psb_d_mat_mod, psb_protect_name => psb_dspmat_type_clone
use psb_d_mat_mod, psb_protect_name => psb_dspmat_clone
implicit none
class(psb_dspmat_type), intent(in) :: a
class(psb_dspmat_type), intent(out) :: b
@ -1543,7 +1536,7 @@ subroutine psb_dspmat_type_clone(a,b,info)
return
end if
end subroutine psb_dspmat_type_clone
end subroutine psb_dspmat_clone
@ -1835,18 +1828,17 @@ subroutine psb_d_csmv(alpha,a,x,beta,y,info,trans)
end subroutine psb_d_csmv
subroutine psb_d_csmv_vect(alpha,a,x,beta,y,info,trans)
use psb_error_mod
use psb_d_vect_mod
use psb_d_mat_mod, psb_protect_name => psb_d_csmv_vect
implicit none
class(psb_dspmat_type), intent(in) :: a
real(psb_dpk_), intent(in) :: alpha, beta
class(psb_dspmat_type), intent(in) :: a
real(psb_dpk_), intent(in) :: alpha, beta
type(psb_d_vect_type), intent(inout) :: x
type(psb_d_vect_type), intent(inout) :: y
integer, intent(out) :: info
character, optional, intent(in) :: trans
integer, intent(out) :: info
character, optional, intent(in) :: trans
Integer :: err_act
character(len=20) :: name='psb_csmv'
logical, parameter :: debug=.false.
@ -1887,6 +1879,7 @@ subroutine psb_d_csmv_vect(alpha,a,x,beta,y,info,trans)
end subroutine psb_d_csmv_vect
subroutine psb_d_cssm(alpha,a,x,beta,y,info,trans,scale,d)
use psb_error_mod
use psb_d_mat_mod, psb_protect_name => psb_d_cssm
@ -2074,8 +2067,8 @@ function psb_d_csnmi(a) result(res)
character(len=20) :: name='csnmi'
logical, parameter :: debug=.false.
call psb_get_erraction(err_act)
info = psb_success_
call psb_get_erraction(err_act)
if (.not.allocated(a%a)) then
info = psb_err_invalid_mat_state_
call psb_errpush(info,name)
@ -2136,8 +2129,8 @@ subroutine psb_d_rowsum(d,a,info)
use psb_const_mod
implicit none
class(psb_dspmat_type), intent(in) :: a
real(psb_dpk_), intent(out) :: d(:)
integer, intent(out) :: info
real(psb_dpk_), intent(out) :: d(:)
integer, intent(out) :: info
Integer :: err_act
character(len=20) :: name='rowsum'
@ -2212,8 +2205,8 @@ subroutine psb_d_colsum(d,a,info)
use psb_const_mod
implicit none
class(psb_dspmat_type), intent(in) :: a
real(psb_dpk_), intent(out) :: d(:)
integer, intent(out) :: info
real(psb_dpk_), intent(out) :: d(:)
integer, intent(out) :: info
Integer :: err_act
character(len=20) :: name='colsum'
@ -2250,8 +2243,8 @@ subroutine psb_d_aclsum(d,a,info)
use psb_const_mod
implicit none
class(psb_dspmat_type), intent(in) :: a
real(psb_dpk_), intent(out) :: d(:)
integer, intent(out) :: info
real(psb_dpk_), intent(out) :: d(:)
integer, intent(out) :: info
Integer :: err_act
character(len=20) :: name='aclsum'
@ -2282,6 +2275,7 @@ subroutine psb_d_aclsum(d,a,info)
end subroutine psb_d_aclsum
subroutine psb_d_get_diag(a,d,info)
use psb_d_mat_mod, psb_protect_name => psb_d_get_diag
use psb_error_mod
@ -2295,8 +2289,8 @@ subroutine psb_d_get_diag(a,d,info)
character(len=20) :: name='get_diag'
logical, parameter :: debug=.false.
call psb_erractionsave(err_act)
info = psb_success_
call psb_erractionsave(err_act)
if (.not.allocated(a%a)) then
info = psb_err_invalid_mat_state_
call psb_errpush(info,name)
@ -2334,8 +2328,8 @@ subroutine psb_d_scal(d,a,info)
character(len=20) :: name='scal'
logical, parameter :: debug=.false.
call psb_erractionsave(err_act)
info = psb_success_
call psb_erractionsave(err_act)
if (.not.allocated(a%a)) then
info = psb_err_invalid_mat_state_
call psb_errpush(info,name)
@ -2373,8 +2367,8 @@ subroutine psb_d_scals(d,a,info)
character(len=20) :: name='scal'
logical, parameter :: debug=.false.
call psb_erractionsave(err_act)
info = psb_success_
call psb_erractionsave(err_act)
if (.not.allocated(a%a)) then
info = psb_err_invalid_mat_state_
call psb_errpush(info,name)

108
base/serial/impl/psb_s_mat_impl.F90
Unescape Escape View File

@ -1,3 +1,15 @@
!
! s_mat_impl:
! implementation of the outer matrix methods.
! Most of the methods rely on the STATE design pattern:
! the inner class(psb_s_base_sparse_mat) is responsbile
! for actually executing the method.
!
!
!
! == ===================================
!
!
@ -80,39 +92,12 @@ end subroutine psb_s_set_ncols
subroutine psb_s_set_state(n,a)
use psb_s_mat_mod, psb_protect_name => psb_s_set_state
use psb_error_mod
implicit none
class(psb_sspmat_type), intent(inout) :: a
integer, intent(in) :: n
Integer :: err_act, info
character(len=20) :: name='get_nzeros'
logical, parameter :: debug=.false.
call psb_erractionsave(err_act)
if (.not.allocated(a%a)) then
info = psb_err_invalid_mat_state_
call psb_errpush(info,name)
goto 9999
endif
call a%a%set_state(n)
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
end subroutine psb_s_set_state
!
! Valid values for DUPL:
! psb_dupl_ovwrt_
! psb_dupl_add_
! psb_dupl_err_
!
subroutine psb_s_set_dupl(n,a)
use psb_s_mat_mod, psb_protect_name => psb_s_set_dupl
@ -148,6 +133,10 @@ subroutine psb_s_set_dupl(n,a)
end subroutine psb_s_set_dupl
!
! Set the STATE of the internal matrix object
!
subroutine psb_s_set_null(a)
use psb_s_mat_mod, psb_protect_name => psb_s_set_null
use psb_error_mod
@ -551,6 +540,7 @@ subroutine psb_s_n_sparse_print(fname,a,iv,eirs,eics,head,ivr,ivc)
end subroutine psb_s_n_sparse_print
subroutine psb_s_get_neigh(a,idx,neigh,n,info,lev)
use psb_s_mat_mod, psb_protect_name => psb_s_get_neigh
use psb_error_mod
@ -1032,13 +1022,12 @@ subroutine psb_s_cscnv(a,b,info,type,mold,upd,dupl)
call psb_errpush(info,name)
goto 9999
endif
if (count( (/present(mold),present(type) /)) > 1) then
info = psb_err_many_optional_arg_
call psb_errpush(info,name,a_err='TYPE, MOLD')
goto 9999
end if
if (present(mold)) then
#if defined(HAVE_MOLD)
@ -1071,13 +1060,14 @@ subroutine psb_s_cscnv(a,b,info,type,mold,upd,dupl)
goto 9999
end if
if (present(dupl)) then
call altmp%set_dupl(dupl)
else if (a%is_bld()) then
! Does this make sense at all?? Who knows..
call altmp%set_dupl(psb_dupl_def_)
end if
if (debug) write(psb_err_unit,*) 'Converting from ',&
& a%get_fmt(),' to ',altmp%get_fmt()
@ -1420,13 +1410,18 @@ subroutine psb_s_cp_from(a,b)
call psb_erractionsave(err_act)
info = psb_success_
!
! Note: it is tempting to use SOURCE allocation below;
! however this would run the risk of messing up with data
! allocated externally (e.g. GPU-side data).
!
#if defined(HAVE_MOLD)
allocate(a%a,mold=b,stat=info)
if (info /= psb_success_) info = psb_err_alloc_dealloc_
#else
call b%mold(a%a,info)
#endif
if (info /= psb_success_) info = psb_err_alloc_dealloc_
if (info == psb_success_) call a%a%cp_from_fmt(b, info)
if (info /= psb_success_) goto 9999
@ -1505,10 +1500,10 @@ subroutine psb_sspmat_type_move(a,b,info)
end subroutine psb_sspmat_type_move
subroutine psb_sspmat_type_clone(a,b,info)
subroutine psb_sspmat_clone(a,b,info)
use psb_error_mod
use psb_string_mod
use psb_s_mat_mod, psb_protect_name => psb_sspmat_type_clone
use psb_s_mat_mod, psb_protect_name => psb_sspmat_clone
implicit none
class(psb_sspmat_type), intent(in) :: a
class(psb_sspmat_type), intent(out) :: b
@ -1527,7 +1522,6 @@ subroutine psb_sspmat_type_clone(a,b,info)
#else
call a%a%mold(b%a,info)
#endif
if (info /= psb_success_) info = psb_err_alloc_dealloc_
if (info == psb_success_) call b%a%cp_from_fmt(a%a, info)
if (info /= psb_success_) goto 9999
@ -1542,7 +1536,7 @@ subroutine psb_sspmat_type_clone(a,b,info)
return
end if
end subroutine psb_sspmat_type_clone
end subroutine psb_sspmat_clone
@ -1839,12 +1833,12 @@ subroutine psb_s_csmv_vect(alpha,a,x,beta,y,info,trans)
use psb_s_vect_mod
use psb_s_mat_mod, psb_protect_name => psb_s_csmv_vect
implicit none
class(psb_sspmat_type), intent(in) :: a
real(psb_spk_), intent(in) :: alpha, beta
class(psb_sspmat_type), intent(in) :: a
real(psb_spk_), intent(in) :: alpha, beta
type(psb_s_vect_type), intent(inout) :: x
type(psb_s_vect_type), intent(inout) :: y
integer, intent(out) :: info
character, optional, intent(in) :: trans
integer, intent(out) :: info
character, optional, intent(in) :: trans
Integer :: err_act
character(len=20) :: name='psb_csmv'
logical, parameter :: debug=.false.
@ -1885,6 +1879,7 @@ subroutine psb_s_csmv_vect(alpha,a,x,beta,y,info,trans)
end subroutine psb_s_csmv_vect
subroutine psb_s_cssm(alpha,a,x,beta,y,info,trans,scale,d)
use psb_error_mod
use psb_s_mat_mod, psb_protect_name => psb_s_cssm
@ -2072,8 +2067,8 @@ function psb_s_csnmi(a) result(res)
character(len=20) :: name='csnmi'
logical, parameter :: debug=.false.
call psb_get_erraction(err_act)
info = psb_success_
call psb_get_erraction(err_act)
if (.not.allocated(a%a)) then
info = psb_err_invalid_mat_state_
call psb_errpush(info,name)
@ -2134,8 +2129,8 @@ subroutine psb_s_rowsum(d,a,info)
use psb_const_mod
implicit none
class(psb_sspmat_type), intent(in) :: a
real(psb_spk_), intent(out) :: d(:)
integer, intent(out) :: info
real(psb_spk_), intent(out) :: d(:)
integer, intent(out) :: info
Integer :: err_act
character(len=20) :: name='rowsum'
@ -2210,8 +2205,8 @@ subroutine psb_s_colsum(d,a,info)
use psb_const_mod
implicit none
class(psb_sspmat_type), intent(in) :: a
real(psb_spk_), intent(out) :: d(:)
integer, intent(out) :: info
real(psb_spk_), intent(out) :: d(:)
integer, intent(out) :: info
Integer :: err_act
character(len=20) :: name='colsum'
@ -2248,8 +2243,8 @@ subroutine psb_s_aclsum(d,a,info)
use psb_const_mod
implicit none
class(psb_sspmat_type), intent(in) :: a
real(psb_spk_), intent(out) :: d(:)
integer, intent(out) :: info
real(psb_spk_), intent(out) :: d(:)
integer, intent(out) :: info
Integer :: err_act
character(len=20) :: name='aclsum'
@ -2280,6 +2275,7 @@ subroutine psb_s_aclsum(d,a,info)
end subroutine psb_s_aclsum
subroutine psb_s_get_diag(a,d,info)
use psb_s_mat_mod, psb_protect_name => psb_s_get_diag
use psb_error_mod
@ -2293,8 +2289,8 @@ subroutine psb_s_get_diag(a,d,info)
character(len=20) :: name='get_diag'
logical, parameter :: debug=.false.
call psb_erractionsave(err_act)
info = psb_success_
call psb_erractionsave(err_act)
if (.not.allocated(a%a)) then
info = psb_err_invalid_mat_state_
call psb_errpush(info,name)
@ -2332,8 +2328,8 @@ subroutine psb_s_scal(d,a,info)
character(len=20) :: name='scal'
logical, parameter :: debug=.false.
call psb_erractionsave(err_act)
info = psb_success_
call psb_erractionsave(err_act)
if (.not.allocated(a%a)) then
info = psb_err_invalid_mat_state_
call psb_errpush(info,name)
@ -2371,8 +2367,8 @@ subroutine psb_s_scals(d,a,info)
character(len=20) :: name='scal'
logical, parameter :: debug=.false.
call psb_erractionsave(err_act)
info = psb_success_
call psb_erractionsave(err_act)
if (.not.allocated(a%a)) then
info = psb_err_invalid_mat_state_
call psb_errpush(info,name)

72
base/serial/impl/psb_z_mat_impl.F90
Unescape Escape View File

@ -1,3 +1,15 @@
!
! z_mat_impl:
! implementation of the outer matrix methods.
! Most of the methods rely on the STATE design pattern:
! the inner class(psb_z_base_sparse_mat) is responsbile
! for actually executing the method.
!
!
!
! == ===================================
!
!
@ -80,39 +92,12 @@ end subroutine psb_z_set_ncols
subroutine psb_z_set_state(n,a)
use psb_z_mat_mod, psb_protect_name => psb_z_set_state
use psb_error_mod
implicit none
class(psb_zspmat_type), intent(inout) :: a
integer, intent(in) :: n
Integer :: err_act, info
character(len=20) :: name='get_nzeros'
logical, parameter :: debug=.false.
call psb_erractionsave(err_act)
if (.not.allocated(a%a)) then
info = psb_err_invalid_mat_state_
call psb_errpush(info,name)
goto 9999
endif
call a%a%set_state(n)
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
end subroutine psb_z_set_state
!
! Valid values for DUPL:
! psb_dupl_ovwrt_
! psb_dupl_add_
! psb_dupl_err_
!
subroutine psb_z_set_dupl(n,a)
use psb_z_mat_mod, psb_protect_name => psb_z_set_dupl
@ -148,6 +133,10 @@ subroutine psb_z_set_dupl(n,a)
end subroutine psb_z_set_dupl
!
! Set the STATE of the internal matrix object
!
subroutine psb_z_set_null(a)
use psb_z_mat_mod, psb_protect_name => psb_z_set_null
use psb_error_mod
@ -1033,7 +1022,6 @@ subroutine psb_z_cscnv(a,b,info,type,mold,upd,dupl)
call psb_errpush(info,name)
goto 9999
endif
if (count( (/present(mold),present(type) /)) > 1) then
info = psb_err_many_optional_arg_
call psb_errpush(info,name,a_err='TYPE, MOLD')
@ -1072,6 +1060,7 @@ subroutine psb_z_cscnv(a,b,info,type,mold,upd,dupl)
goto 9999
end if
if (present(dupl)) then
call altmp%set_dupl(dupl)
else if (a%is_bld()) then
@ -1421,13 +1410,18 @@ subroutine psb_z_cp_from(a,b)
call psb_erractionsave(err_act)
info = psb_success_
!
! Note: it is tempting to use SOURCE allocation below;
! however this would run the risk of messing up with data
! allocated externally (e.g. GPU-side data).
!
#if defined(HAVE_MOLD)
allocate(a%a,mold=b,stat=info)
if (info /= psb_success_) info = psb_err_alloc_dealloc_
#else
call b%mold(a%a,info)
#endif
if (info /= psb_success_) info = psb_err_alloc_dealloc_
if (info == psb_success_) call a%a%cp_from_fmt(b, info)
if (info /= psb_success_) goto 9999
@ -1506,10 +1500,10 @@ subroutine psb_zspmat_type_move(a,b,info)
end subroutine psb_zspmat_type_move
subroutine psb_zspmat_type_clone(a,b,info)
subroutine psb_zspmat_clone(a,b,info)
use psb_error_mod
use psb_string_mod
use psb_z_mat_mod, psb_protect_name => psb_zspmat_type_clone
use psb_z_mat_mod, psb_protect_name => psb_zspmat_clone
implicit none
class(psb_zspmat_type), intent(in) :: a
class(psb_zspmat_type), intent(out) :: b
@ -1542,7 +1536,7 @@ subroutine psb_zspmat_type_clone(a,b,info)
return
end if
end subroutine psb_zspmat_type_clone
end subroutine psb_zspmat_clone

Write Preview
Loading…
Cancel
Save