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

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

44
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 ! methods of the psb_d_mat_mod simply call the methods of the
! encapsulated class. ! encapsulated class.
module psb_d_mat_mod module psb_d_mat_mod
use psb_d_base_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_nzeros => psb_d_get_nzeros
procedure, pass(a) :: get_nz_row => psb_d_get_nz_row procedure, pass(a) :: get_nz_row => psb_d_get_nz_row
procedure, pass(a) :: get_size => psb_d_get_size 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) :: get_dupl => psb_d_get_dupl
procedure, pass(a) :: is_null => psb_d_is_null procedure, pass(a) :: is_null => psb_d_is_null
procedure, pass(a) :: is_bld => psb_d_is_bld 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_nrows => psb_d_set_nrows
procedure, pass(a) :: set_ncols => psb_d_set_ncols procedure, pass(a) :: set_ncols => psb_d_set_ncols
procedure, pass(a) :: set_dupl => psb_d_set_dupl 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_null => psb_d_set_null
procedure, pass(a) :: set_bld => psb_d_set_bld procedure, pass(a) :: set_bld => psb_d_set_bld
procedure, pass(a) :: set_upd => psb_d_set_upd 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_ip => psb_d_cscnv_ip
procedure, pass(a) :: d_cscnv_base => psb_d_cscnv_base procedure, pass(a) :: d_cscnv_base => psb_d_cscnv_base
generic, public :: cscnv => d_cscnv, d_cscnv_ip, 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) :: reinit => psb_d_reinit
procedure, pass(a) :: print_i => psb_d_sparse_print procedure, pass(a) :: print_i => psb_d_sparse_print
procedure, pass(a) :: print_n => psb_d_n_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 procedure, pass(a) :: d_transc_2mat => psb_d_transc_2mat
generic, public :: transc => d_transc_1mat, d_transc_2mat generic, public :: transc => d_transc_1mat, d_transc_2mat
! Computational routines ! Computational routines
procedure, pass(a) :: get_diag => psb_d_get_diag procedure, pass(a) :: get_diag => psb_d_get_diag
procedure, pass(a) :: maxval => psb_d_maxval procedure, pass(a) :: maxval => psb_d_maxval
@ -155,9 +152,9 @@ module psb_d_mat_mod
end type psb_dspmat_type end type psb_dspmat_type
private :: psb_d_get_nrows, psb_d_get_ncols, psb_d_get_nzeros, psb_d_get_size, & 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_get_dupl, psb_d_is_null, psb_d_is_bld, &
& psb_d_is_asb, psb_d_is_sorted, psb_d_is_upper, psb_d_is_lower,& & psb_d_is_upd, psb_d_is_asb, psb_d_is_sorted, psb_d_is_upper, &
& psb_d_is_triangle, psb_d_get_nz_row & psb_d_is_lower, psb_d_is_triangle, psb_d_get_nz_row
interface psb_sizeof interface psb_sizeof
module procedure psb_d_sizeof module procedure psb_d_sizeof
@ -194,14 +191,6 @@ module psb_d_mat_mod
end subroutine psb_d_set_ncols end subroutine psb_d_set_ncols
end interface 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 interface
subroutine psb_d_set_dupl(n,a) subroutine psb_d_set_dupl(n,a)
import :: psb_dspmat_type import :: psb_dspmat_type
@ -278,7 +267,6 @@ module psb_d_mat_mod
end subroutine psb_d_set_upper end subroutine psb_d_set_upper
end interface end interface
interface interface
subroutine psb_d_sparse_print(iout,a,iv,eirs,eics,head,ivr,ivc) subroutine psb_d_sparse_print(iout,a,iv,eirs,eics,head,ivr,ivc)
import :: psb_dspmat_type import :: psb_dspmat_type
@ -494,7 +482,7 @@ module psb_d_mat_mod
subroutine psb_d_cp_from(a,b) subroutine psb_d_cp_from(a,b)
import :: psb_dspmat_type, psb_dpk_, psb_d_base_sparse_mat 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(in) :: b class(psb_d_base_sparse_mat), intent(inout), allocatable :: b
end subroutine psb_d_cp_from end subroutine psb_d_cp_from
end interface end interface
@ -524,12 +512,12 @@ module psb_d_mat_mod
end interface end interface
interface psb_clone interface psb_clone
subroutine psb_dspmat_type_clone(a,b,info) subroutine psb_dspmat_clone(a,b,info)
import :: psb_dspmat_type import :: psb_dspmat_type
class(psb_dspmat_type), intent(in) :: a class(psb_dspmat_type), intent(in) :: a
class(psb_dspmat_type), intent(out) :: b class(psb_dspmat_type), intent(out) :: b
integer, intent(out) :: info integer, intent(out) :: info
end subroutine psb_dspmat_type_clone end subroutine psb_dspmat_clone
end interface end interface
interface interface
@ -580,6 +568,7 @@ module psb_d_mat_mod
end interface end interface
! == =================================== ! == ===================================
! !
! !
@ -769,7 +758,6 @@ contains
end function psb_d_sizeof end function psb_d_sizeof
function psb_d_get_fmt(a) result(res) function psb_d_get_fmt(a) result(res)
implicit none implicit none
class(psb_dspmat_type), intent(in) :: a class(psb_dspmat_type), intent(in) :: a
@ -796,19 +784,6 @@ contains
end if end if
end function psb_d_get_dupl 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) function psb_d_get_nrows(a) result(res)
implicit none implicit none
class(psb_dspmat_type), intent(in) :: a class(psb_dspmat_type), intent(in) :: a
@ -993,4 +968,5 @@ contains
end function psb_d_get_nz_row end function psb_d_get_nz_row
end module psb_d_mat_mod end module psb_d_mat_mod

152
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_nzeros => psb_s_get_nzeros
procedure, pass(a) :: get_nz_row => psb_s_get_nz_row procedure, pass(a) :: get_nz_row => psb_s_get_nz_row
procedure, pass(a) :: get_size => psb_s_get_size 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) :: get_dupl => psb_s_get_dupl
procedure, pass(a) :: is_null => psb_s_is_null procedure, pass(a) :: is_null => psb_s_is_null
procedure, pass(a) :: is_bld => psb_s_is_bld 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_nrows => psb_s_set_nrows
procedure, pass(a) :: set_ncols => psb_s_set_ncols procedure, pass(a) :: set_ncols => psb_s_set_ncols
procedure, pass(a) :: set_dupl => psb_s_set_dupl 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_null => psb_s_set_null
procedure, pass(a) :: set_bld => psb_s_set_bld procedure, pass(a) :: set_bld => psb_s_set_bld
procedure, pass(a) :: set_upd => psb_s_set_upd 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_ip => psb_s_cscnv_ip
procedure, pass(a) :: s_cscnv_base => psb_s_cscnv_base procedure, pass(a) :: s_cscnv_base => psb_s_cscnv_base
generic, public :: cscnv => s_cscnv, s_cscnv_ip, 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) :: reinit => psb_s_reinit
procedure, pass(a) :: print_i => psb_s_sparse_print procedure, pass(a) :: print_i => psb_s_sparse_print
procedure, pass(a) :: print_n => psb_s_n_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 procedure, pass(a) :: s_transc_2mat => psb_s_transc_2mat
generic, public :: transc => s_transc_1mat, s_transc_2mat generic, public :: transc => s_transc_1mat, s_transc_2mat
! Computational routines ! Computational routines
procedure, pass(a) :: get_diag => psb_s_get_diag procedure, pass(a) :: get_diag => psb_s_get_diag
procedure, pass(a) :: maxval => psb_s_maxval procedure, pass(a) :: maxval => psb_s_maxval
@ -156,9 +152,9 @@ module psb_s_mat_mod
end type psb_sspmat_type end type psb_sspmat_type
private :: psb_s_get_nrows, psb_s_get_ncols, psb_s_get_nzeros, psb_s_get_size, & 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_get_dupl, psb_s_is_null, psb_s_is_bld, &
& psb_s_is_asb, psb_s_is_sorted, psb_s_is_upper, psb_s_is_lower, psb_s_is_triangle,& & psb_s_is_upd, psb_s_is_asb, psb_s_is_sorted, psb_s_is_upper, &
& psb_s_get_nz_row & psb_s_is_lower, psb_s_is_triangle, psb_s_get_nz_row
interface psb_sizeof interface psb_sizeof
module procedure psb_s_sizeof module procedure psb_s_sizeof
@ -195,14 +191,6 @@ module psb_s_mat_mod
end subroutine psb_s_set_ncols end subroutine psb_s_set_ncols
end interface 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 interface
subroutine psb_s_set_dupl(n,a) subroutine psb_s_set_dupl(n,a)
import :: psb_sspmat_type import :: psb_sspmat_type
@ -279,7 +267,6 @@ module psb_s_mat_mod
end subroutine psb_s_set_upper end subroutine psb_s_set_upper
end interface end interface
interface interface
subroutine psb_s_sparse_print(iout,a,iv,eirs,eics,head,ivr,ivc) subroutine psb_s_sparse_print(iout,a,iv,eirs,eics,head,ivr,ivc)
import :: psb_sspmat_type import :: psb_sspmat_type
@ -350,9 +337,9 @@ module psb_s_mat_mod
interface interface
subroutine psb_s_csput(nz,ia,ja,val,a,imin,imax,jmin,jmax,info,gtl) 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 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(in) :: nz, ia(:), ja(:), imin,imax,jmin,jmax
integer, intent(out) :: info integer, intent(out) :: info
integer, intent(in), optional :: gtl(:) integer, intent(in), optional :: gtl(:)
@ -362,7 +349,7 @@ module psb_s_mat_mod
interface interface
subroutine psb_s_csgetptn(imin,imax,a,nz,ia,ja,info,& subroutine psb_s_csgetptn(imin,imax,a,nz,ia,ja,info,&
& jmin,jmax,iren,append,nzin,rscale,cscale) & 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 class(psb_sspmat_type), intent(in) :: a
integer, intent(in) :: imin,imax integer, intent(in) :: imin,imax
integer, intent(out) :: nz integer, intent(out) :: nz
@ -378,12 +365,12 @@ module psb_s_mat_mod
interface interface
subroutine psb_s_csgetrow(imin,imax,a,nz,ia,ja,val,info,& subroutine psb_s_csgetrow(imin,imax,a,nz,ia,ja,val,info,&
& jmin,jmax,iren,append,nzin,rscale,cscale) & 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 class(psb_sspmat_type), intent(in) :: a
integer, intent(in) :: imin,imax integer, intent(in) :: imin,imax
integer, intent(out) :: nz integer, intent(out) :: nz
integer, allocatable, intent(inout) :: ia(:), ja(:) integer, allocatable, intent(inout) :: ia(:), ja(:)
real(psb_spk_), allocatable, intent(inout) :: val(:) real(psb_dpk_), allocatable, intent(inout) :: val(:)
integer,intent(out) :: info integer,intent(out) :: info
logical, intent(in), optional :: append logical, intent(in), optional :: append
integer, intent(in), optional :: iren(:) integer, intent(in), optional :: iren(:)
@ -395,7 +382,7 @@ module psb_s_mat_mod
interface interface
subroutine psb_s_csgetblk(imin,imax,a,b,info,& subroutine psb_s_csgetblk(imin,imax,a,b,info,&
& jmin,jmax,iren,append,rscale,cscale) & jmin,jmax,iren,append,rscale,cscale)
import :: psb_sspmat_type, psb_spk_ import :: psb_sspmat_type, psb_dpk_
class(psb_sspmat_type), intent(in) :: a class(psb_sspmat_type), intent(in) :: a
class(psb_sspmat_type), intent(out) :: b class(psb_sspmat_type), intent(out) :: b
integer, intent(in) :: imin,imax integer, intent(in) :: imin,imax
@ -410,7 +397,7 @@ module psb_s_mat_mod
interface interface
subroutine psb_s_csclip(a,b,info,& subroutine psb_s_csclip(a,b,info,&
& imin,imax,jmin,jmax,rscale,cscale) & imin,imax,jmin,jmax,rscale,cscale)
import :: psb_sspmat_type, psb_spk_ import :: psb_sspmat_type, psb_dpk_
class(psb_sspmat_type), intent(in) :: a class(psb_sspmat_type), intent(in) :: a
class(psb_sspmat_type), intent(out) :: b class(psb_sspmat_type), intent(out) :: b
integer,intent(out) :: info integer,intent(out) :: info
@ -422,7 +409,7 @@ module psb_s_mat_mod
interface interface
subroutine psb_s_b_csclip(a,b,info,& subroutine psb_s_b_csclip(a,b,info,&
& imin,imax,jmin,jmax,rscale,cscale) & imin,imax,jmin,jmax,rscale,cscale)
import :: psb_sspmat_type, psb_spk_, psb_s_coo_sparse_mat import :: psb_sspmat_type, psb_dpk_, psb_s_coo_sparse_mat
class(psb_sspmat_type), intent(in) :: a class(psb_sspmat_type), intent(in) :: a
type(psb_s_coo_sparse_mat), intent(out) :: b type(psb_s_coo_sparse_mat), intent(out) :: b
integer,intent(out) :: info integer,intent(out) :: info
@ -433,7 +420,7 @@ module psb_s_mat_mod
interface interface
subroutine psb_s_cscnv(a,b,info,type,mold,upd,dupl) 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(in) :: a
class(psb_sspmat_type), intent(out) :: b class(psb_sspmat_type), intent(out) :: b
integer, intent(out) :: info integer, intent(out) :: info
@ -446,7 +433,7 @@ module psb_s_mat_mod
interface interface
subroutine psb_s_cscnv_ip(a,iinfo,type,mold,dupl) 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 class(psb_sspmat_type), intent(inout) :: a
integer, intent(out) :: iinfo integer, intent(out) :: iinfo
integer,optional, intent(in) :: dupl integer,optional, intent(in) :: dupl
@ -458,7 +445,7 @@ module psb_s_mat_mod
interface interface
subroutine psb_s_cscnv_base(a,b,info,dupl) 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_sspmat_type), intent(in) :: a
class(psb_s_base_sparse_mat), intent(out) :: b class(psb_s_base_sparse_mat), intent(out) :: b
integer, intent(out) :: info integer, intent(out) :: info
@ -485,7 +472,7 @@ module psb_s_mat_mod
interface interface
subroutine psb_s_mv_from(a,b) subroutine psb_s_mv_from(a,b)
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(out) :: a class(psb_sspmat_type), intent(out) :: a
class(psb_s_base_sparse_mat), intent(inout) :: b class(psb_s_base_sparse_mat), intent(inout) :: b
end subroutine psb_s_mv_from end subroutine psb_s_mv_from
@ -493,15 +480,15 @@ module psb_s_mat_mod
interface interface
subroutine psb_s_cp_from(a,b) subroutine psb_s_cp_from(a,b)
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(out) :: a class(psb_sspmat_type), intent(out) :: a
class(psb_s_base_sparse_mat), intent(in) :: b class(psb_s_base_sparse_mat), intent(inout), allocatable :: b
end subroutine psb_s_cp_from end subroutine psb_s_cp_from
end interface end interface
interface interface
subroutine psb_s_mv_to(a,b) subroutine psb_s_mv_to(a,b)
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 class(psb_sspmat_type), intent(inout) :: a
class(psb_s_base_sparse_mat), intent(out) :: b class(psb_s_base_sparse_mat), intent(out) :: b
end subroutine psb_s_mv_to end subroutine psb_s_mv_to
@ -509,7 +496,7 @@ module psb_s_mat_mod
interface interface
subroutine psb_s_cp_to(a,b) subroutine psb_s_cp_to(a,b)
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(in) :: a
class(psb_s_base_sparse_mat), intent(out) :: b class(psb_s_base_sparse_mat), intent(out) :: b
end subroutine psb_s_cp_to end subroutine psb_s_cp_to
@ -522,15 +509,15 @@ module psb_s_mat_mod
class(psb_sspmat_type), intent(out) :: b class(psb_sspmat_type), intent(out) :: b
integer, intent(out) :: info integer, intent(out) :: info
end subroutine psb_sspmat_type_move end subroutine psb_sspmat_type_move
end interface psb_move_alloc end interface
interface psb_clone interface psb_clone
subroutine psb_sspmat_type_clone(a,b,info) subroutine psb_sspmat_clone(a,b,info)
import :: psb_sspmat_type import :: psb_sspmat_type
class(psb_sspmat_type), intent(in) :: a class(psb_sspmat_type), intent(in) :: a
class(psb_sspmat_type), intent(out) :: b class(psb_sspmat_type), intent(out) :: b
integer, intent(out) :: info integer, intent(out) :: info
end subroutine psb_sspmat_type_clone end subroutine psb_sspmat_clone
end interface end interface
interface interface
@ -581,6 +568,7 @@ module psb_s_mat_mod
end interface end interface
! == =================================== ! == ===================================
! !
! !
@ -596,26 +584,26 @@ module psb_s_mat_mod
interface psb_csmm interface psb_csmm
subroutine psb_s_csmm(alpha,a,x,beta,y,info,trans) 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 class(psb_sspmat_type), intent(in) :: a
real(psb_spk_), intent(in) :: alpha, beta, x(:,:) real(psb_dpk_), intent(in) :: alpha, beta, x(:,:)
real(psb_spk_), intent(inout) :: y(:,:) real(psb_dpk_), intent(inout) :: y(:,:)
integer, intent(out) :: info integer, intent(out) :: info
character, optional, intent(in) :: trans character, optional, intent(in) :: trans
end subroutine psb_s_csmm end subroutine psb_s_csmm
subroutine psb_s_csmv(alpha,a,x,beta,y,info,trans) 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 class(psb_sspmat_type), intent(in) :: a
real(psb_spk_), intent(in) :: alpha, beta, x(:) real(psb_dpk_), intent(in) :: alpha, beta, x(:)
real(psb_spk_), intent(inout) :: y(:) real(psb_dpk_), intent(inout) :: y(:)
integer, intent(out) :: info integer, intent(out) :: info
character, optional, intent(in) :: trans character, optional, intent(in) :: trans
end subroutine psb_s_csmv end subroutine psb_s_csmv
subroutine psb_s_csmv_vect(alpha,a,x,beta,y,info,trans) subroutine psb_s_csmv_vect(alpha,a,x,beta,y,info,trans)
use psb_s_vect_mod, only : psb_s_vect_type 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 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) :: x
type(psb_s_vect_type), intent(inout) :: y type(psb_s_vect_type), intent(inout) :: y
integer, intent(out) :: info integer, intent(out) :: info
@ -625,28 +613,28 @@ module psb_s_mat_mod
interface psb_cssm interface psb_cssm
subroutine psb_s_cssm(alpha,a,x,beta,y,info,trans,scale,d) 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 class(psb_sspmat_type), intent(in) :: a
real(psb_spk_), intent(in) :: alpha, beta, x(:,:) real(psb_dpk_), intent(in) :: alpha, beta, x(:,:)
real(psb_spk_), intent(inout) :: y(:,:) real(psb_dpk_), intent(inout) :: y(:,:)
integer, intent(out) :: info integer, intent(out) :: info
character, optional, intent(in) :: trans, scale 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 end subroutine psb_s_cssm
subroutine psb_s_cssv(alpha,a,x,beta,y,info,trans,scale,d) 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 class(psb_sspmat_type), intent(in) :: a
real(psb_spk_), intent(in) :: alpha, beta, x(:) real(psb_dpk_), intent(in) :: alpha, beta, x(:)
real(psb_spk_), intent(inout) :: y(:) real(psb_dpk_), intent(inout) :: y(:)
integer, intent(out) :: info integer, intent(out) :: info
character, optional, intent(in) :: trans, scale 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 end subroutine psb_s_cssv
subroutine psb_s_cssv_vect(alpha,a,x,beta,y,info,trans,scale,d) subroutine psb_s_cssv_vect(alpha,a,x,beta,y,info,trans,scale,d)
use psb_s_vect_mod, only : psb_s_vect_type 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 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) :: x
type(psb_s_vect_type), intent(inout) :: y type(psb_s_vect_type), intent(inout) :: y
integer, intent(out) :: info integer, intent(out) :: info
@ -657,84 +645,85 @@ module psb_s_mat_mod
interface interface
function psb_s_maxval(a) result(res) 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 class(psb_sspmat_type), intent(in) :: a
real(psb_spk_) :: res real(psb_dpk_) :: res
end function psb_s_maxval end function psb_s_maxval
end interface end interface
interface interface
function psb_s_csnmi(a) result(res) 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 class(psb_sspmat_type), intent(in) :: a
real(psb_spk_) :: res real(psb_dpk_) :: res
end function psb_s_csnmi end function psb_s_csnmi
end interface end interface
interface interface
function psb_s_csnm1(a) result(res) 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 class(psb_sspmat_type), intent(in) :: a
real(psb_spk_) :: res real(psb_dpk_) :: res
end function psb_s_csnm1 end function psb_s_csnm1
end interface end interface
interface interface
subroutine psb_s_rowsum(d,a,info) 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 class(psb_sspmat_type), intent(in) :: a
real(psb_spk_), intent(out) :: d(:) real(psb_dpk_), intent(out) :: d(:)
integer, intent(out) :: info integer, intent(out) :: info
end subroutine psb_s_rowsum end subroutine psb_s_rowsum
end interface end interface
interface interface
subroutine psb_s_arwsum(d,a,info) 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 class(psb_sspmat_type), intent(in) :: a
real(psb_spk_), intent(out) :: d(:) real(psb_dpk_), intent(out) :: d(:)
integer, intent(out) :: info integer, intent(out) :: info
end subroutine psb_s_arwsum end subroutine psb_s_arwsum
end interface end interface
interface interface
subroutine psb_s_colsum(d,a,info) 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 class(psb_sspmat_type), intent(in) :: a
real(psb_spk_), intent(out) :: d(:) real(psb_dpk_), intent(out) :: d(:)
integer, intent(out) :: info integer, intent(out) :: info
end subroutine psb_s_colsum end subroutine psb_s_colsum
end interface end interface
interface interface
subroutine psb_s_aclsum(d,a,info) 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 class(psb_sspmat_type), intent(in) :: a
real(psb_spk_), intent(out) :: d(:) real(psb_dpk_), intent(out) :: d(:)
integer, intent(out) :: info integer, intent(out) :: info
end subroutine psb_s_aclsum end subroutine psb_s_aclsum
end interface end interface
interface interface
subroutine psb_s_get_diag(a,d,info) 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 class(psb_sspmat_type), intent(in) :: a
real(psb_spk_), intent(out) :: d(:) real(psb_dpk_), intent(out) :: d(:)
integer, intent(out) :: info integer, intent(out) :: info
end subroutine psb_s_get_diag end subroutine psb_s_get_diag
end interface end interface
interface psb_scal interface psb_scal
subroutine psb_s_scal(d,a,info) 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 class(psb_sspmat_type), intent(inout) :: a
real(psb_spk_), intent(in) :: d(:) real(psb_dpk_), intent(in) :: d(:)
integer, intent(out) :: info integer, intent(out) :: info
end subroutine psb_s_scal end subroutine psb_s_scal
subroutine psb_s_scals(d,a,info) 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 class(psb_sspmat_type), intent(inout) :: a
real(psb_spk_), intent(in) :: d real(psb_dpk_), intent(in) :: d
integer, intent(out) :: info integer, intent(out) :: info
end subroutine psb_s_scals end subroutine psb_s_scals
end interface end interface
@ -769,7 +758,6 @@ contains
end function psb_s_sizeof end function psb_s_sizeof
function psb_s_get_fmt(a) result(res) function psb_s_get_fmt(a) result(res)
implicit none implicit none
class(psb_sspmat_type), intent(in) :: a class(psb_sspmat_type), intent(in) :: a
@ -796,19 +784,6 @@ contains
end if end if
end function psb_s_get_dupl 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) function psb_s_get_nrows(a) result(res)
implicit none implicit none
class(psb_sspmat_type), intent(in) :: a class(psb_sspmat_type), intent(in) :: a
@ -993,4 +968,5 @@ contains
end function psb_s_get_nz_row end function psb_s_get_nz_row
end module psb_s_mat_mod end module psb_s_mat_mod

37
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_nzeros => psb_z_get_nzeros
procedure, pass(a) :: get_nz_row => psb_z_get_nz_row procedure, pass(a) :: get_nz_row => psb_z_get_nz_row
procedure, pass(a) :: get_size => psb_z_get_size 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) :: get_dupl => psb_z_get_dupl
procedure, pass(a) :: is_null => psb_z_is_null procedure, pass(a) :: is_null => psb_z_is_null
procedure, pass(a) :: is_bld => psb_z_is_bld 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_nrows => psb_z_set_nrows
procedure, pass(a) :: set_ncols => psb_z_set_ncols procedure, pass(a) :: set_ncols => psb_z_set_ncols
procedure, pass(a) :: set_dupl => psb_z_set_dupl 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_null => psb_z_set_null
procedure, pass(a) :: set_bld => psb_z_set_bld procedure, pass(a) :: set_bld => psb_z_set_bld
procedure, pass(a) :: set_upd => psb_z_set_upd 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_ip => psb_z_cscnv_ip
procedure, pass(a) :: z_cscnv_base => psb_z_cscnv_base procedure, pass(a) :: z_cscnv_base => psb_z_cscnv_base
generic, public :: cscnv => z_cscnv, z_cscnv_ip, 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) :: reinit => psb_z_reinit
procedure, pass(a) :: print_i => psb_z_sparse_print procedure, pass(a) :: print_i => psb_z_sparse_print
procedure, pass(a) :: print_n => psb_z_n_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 end type psb_zspmat_type
private :: psb_z_get_nrows, psb_z_get_ncols, psb_z_get_nzeros, psb_z_get_size, & 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_get_dupl, psb_z_is_null, psb_z_is_bld, &
& psb_z_is_asb, psb_z_is_sorted, psb_z_is_upper, psb_z_is_lower, psb_z_is_triangle,& & psb_z_is_upd, psb_z_is_asb, psb_z_is_sorted, psb_z_is_upper, &
& psb_z_get_nz_row & psb_z_is_lower, psb_z_is_triangle, psb_z_get_nz_row
interface psb_sizeof interface psb_sizeof
module procedure psb_z_sizeof module procedure psb_z_sizeof
@ -193,14 +191,6 @@ module psb_z_mat_mod
end subroutine psb_z_set_ncols end subroutine psb_z_set_ncols
end interface 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 interface
subroutine psb_z_set_dupl(n,a) subroutine psb_z_set_dupl(n,a)
import :: psb_zspmat_type import :: psb_zspmat_type
@ -492,7 +482,7 @@ module psb_z_mat_mod
subroutine psb_z_cp_from(a,b) subroutine psb_z_cp_from(a,b)
import :: psb_zspmat_type, psb_dpk_, psb_z_base_sparse_mat 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(in) :: b class(psb_z_base_sparse_mat), intent(inout), allocatable :: b
end subroutine psb_z_cp_from end subroutine psb_z_cp_from
end interface end interface
@ -522,12 +512,12 @@ module psb_z_mat_mod
end interface end interface
interface psb_clone interface psb_clone
subroutine psb_zspmat_type_clone(a,b,info) subroutine psb_zspmat_clone(a,b,info)
import :: psb_zspmat_type import :: psb_zspmat_type
class(psb_zspmat_type), intent(in) :: a class(psb_zspmat_type), intent(in) :: a
class(psb_zspmat_type), intent(out) :: b class(psb_zspmat_type), intent(out) :: b
integer, intent(out) :: info integer, intent(out) :: info
end subroutine psb_zspmat_type_clone end subroutine psb_zspmat_clone
end interface end interface
interface interface
@ -794,19 +784,6 @@ contains
end if end if
end function psb_z_get_dupl 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) function psb_z_get_nrows(a) result(res)
implicit none implicit none
class(psb_zspmat_type), intent(in) :: a class(psb_zspmat_type), intent(in) :: a

80
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 ! Valid values for DUPL:
use psb_error_mod ! psb_dupl_ovwrt_
implicit none ! psb_dupl_add_
class(psb_cspmat_type), intent(inout) :: a ! psb_dupl_err_
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
subroutine psb_c_set_dupl(n,a) subroutine psb_c_set_dupl(n,a)
use psb_c_mat_mod, psb_protect_name => psb_c_set_dupl 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 end subroutine psb_c_set_dupl
!
! Set the STATE of the internal matrix object
!
subroutine psb_c_set_null(a) subroutine psb_c_set_null(a)
use psb_c_mat_mod, psb_protect_name => psb_c_set_null use psb_c_mat_mod, psb_protect_name => psb_c_set_null
use psb_error_mod use psb_error_mod
@ -1033,7 +1022,6 @@ subroutine psb_c_cscnv(a,b,info,type,mold,upd,dupl)
call psb_errpush(info,name) call psb_errpush(info,name)
goto 9999 goto 9999
endif endif
if (count( (/present(mold),present(type) /)) > 1) then if (count( (/present(mold),present(type) /)) > 1) then
info = psb_err_many_optional_arg_ info = psb_err_many_optional_arg_
call psb_errpush(info,name,a_err='TYPE, MOLD') call psb_errpush(info,name,a_err='TYPE, MOLD')
@ -1079,6 +1067,7 @@ subroutine psb_c_cscnv(a,b,info,type,mold,upd,dupl)
! Does this make sense at all?? Who knows.. ! Does this make sense at all?? Who knows..
call altmp%set_dupl(psb_dupl_def_) call altmp%set_dupl(psb_dupl_def_)
end if end if
if (debug) write(psb_err_unit,*) 'Converting from ',& if (debug) write(psb_err_unit,*) 'Converting from ',&
& a%get_fmt(),' to ',altmp%get_fmt() & a%get_fmt(),' to ',altmp%get_fmt()
@ -1422,9 +1411,13 @@ subroutine psb_c_cp_from(a,b)
call psb_erractionsave(err_act) call psb_erractionsave(err_act)
info = psb_success_ 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) #if defined(HAVE_MOLD)
allocate(a%a,mold=b,stat=info) allocate(a%a,mold=b,stat=info)
if (info /= psb_success_) info = psb_err_alloc_dealloc_
#else #else
call b%mold(a%a,info) call b%mold(a%a,info)
#endif #endif
@ -1507,10 +1500,10 @@ subroutine psb_cspmat_type_move(a,b,info)
end subroutine psb_cspmat_type_move 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_error_mod
use psb_string_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 implicit none
class(psb_cspmat_type), intent(in) :: a class(psb_cspmat_type), intent(in) :: a
class(psb_cspmat_type), intent(out) :: b class(psb_cspmat_type), intent(out) :: b
@ -1529,7 +1522,6 @@ subroutine psb_cspmat_type_clone(a,b,info)
#else #else
call a%a%mold(b%a,info) call a%a%mold(b%a,info)
#endif #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_) call b%a%cp_from_fmt(a%a, info)
if (info /= psb_success_) goto 9999 if (info /= psb_success_) goto 9999
@ -1544,7 +1536,7 @@ subroutine psb_cspmat_type_clone(a,b,info)
return return
end if 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 end subroutine psb_c_csmv_vect
subroutine psb_c_cssm(alpha,a,x,beta,y,info,trans,scale,d) subroutine psb_c_cssm(alpha,a,x,beta,y,info,trans,scale,d)
use psb_error_mod use psb_error_mod
use psb_c_mat_mod, psb_protect_name => psb_c_cssm 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 end subroutine psb_c_cssv_vect
function psb_c_maxval(a) result(res) function psb_c_maxval(a) result(res)
use psb_c_mat_mod, psb_protect_name => psb_c_maxval use psb_c_mat_mod, psb_protect_name => psb_c_maxval
use psb_error_mod use psb_error_mod
@ -2037,6 +2029,7 @@ function psb_c_maxval(a) result(res)
class(psb_cspmat_type), intent(in) :: a class(psb_cspmat_type), intent(in) :: a
real(psb_spk_) :: res real(psb_spk_) :: res
Integer :: err_act, info Integer :: err_act, info
character(len=20) :: name='maxval' character(len=20) :: name='maxval'
logical, parameter :: debug=.false. logical, parameter :: debug=.false.
@ -2074,8 +2067,8 @@ function psb_c_csnmi(a) result(res)
character(len=20) :: name='csnmi' character(len=20) :: name='csnmi'
logical, parameter :: debug=.false. logical, parameter :: debug=.false.
call psb_get_erraction(err_act)
info = psb_success_ info = psb_success_
call psb_get_erraction(err_act)
if (.not.allocated(a%a)) then if (.not.allocated(a%a)) then
info = psb_err_invalid_mat_state_ info = psb_err_invalid_mat_state_
call psb_errpush(info,name) call psb_errpush(info,name)
@ -2095,6 +2088,7 @@ function psb_c_csnmi(a) result(res)
end function psb_c_csnmi end function psb_c_csnmi
function psb_c_csnm1(a) result(res) function psb_c_csnm1(a) result(res)
use psb_c_mat_mod, psb_protect_name => psb_c_csnm1 use psb_c_mat_mod, psb_protect_name => psb_c_csnm1
use psb_error_mod use psb_error_mod
@ -2295,8 +2289,8 @@ subroutine psb_c_get_diag(a,d,info)
character(len=20) :: name='get_diag' character(len=20) :: name='get_diag'
logical, parameter :: debug=.false. logical, parameter :: debug=.false.
call psb_erractionsave(err_act)
info = psb_success_ info = psb_success_
call psb_erractionsave(err_act)
if (.not.allocated(a%a)) then if (.not.allocated(a%a)) then
info = psb_err_invalid_mat_state_ info = psb_err_invalid_mat_state_
call psb_errpush(info,name) call psb_errpush(info,name)
@ -2334,8 +2328,8 @@ subroutine psb_c_scal(d,a,info)
character(len=20) :: name='scal' character(len=20) :: name='scal'
logical, parameter :: debug=.false. logical, parameter :: debug=.false.
call psb_erractionsave(err_act)
info = psb_success_ info = psb_success_
call psb_erractionsave(err_act)
if (.not.allocated(a%a)) then if (.not.allocated(a%a)) then
info = psb_err_invalid_mat_state_ info = psb_err_invalid_mat_state_
call psb_errpush(info,name) call psb_errpush(info,name)

86
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 ! Valid values for DUPL:
use psb_error_mod ! psb_dupl_ovwrt_
implicit none ! psb_dupl_add_
class(psb_dspmat_type), intent(inout) :: a ! psb_dupl_err_
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
subroutine psb_d_set_dupl(n,a) subroutine psb_d_set_dupl(n,a)
use psb_d_mat_mod, psb_protect_name => psb_d_set_dupl 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 end subroutine psb_d_set_dupl
!
! Set the STATE of the internal matrix object
!
subroutine psb_d_set_null(a) subroutine psb_d_set_null(a)
use psb_d_mat_mod, psb_protect_name => psb_d_set_null use psb_d_mat_mod, psb_protect_name => psb_d_set_null
use psb_error_mod 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 end subroutine psb_d_sparse_print
subroutine psb_d_n_sparse_print(fname,a,iv,eirs,eics,head,ivr,ivc) 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_d_mat_mod, psb_protect_name => psb_d_n_sparse_print
use psb_error_mod 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 end subroutine psb_d_n_sparse_print
subroutine psb_d_get_neigh(a,idx,neigh,n,info,lev) 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_d_mat_mod, psb_protect_name => psb_d_get_neigh
use psb_error_mod use psb_error_mod
@ -1034,8 +1022,6 @@ subroutine psb_d_cscnv(a,b,info,type,mold,upd,dupl)
call psb_errpush(info,name) call psb_errpush(info,name)
goto 9999 goto 9999
endif endif
if (count( (/present(mold),present(type) /)) > 1) then if (count( (/present(mold),present(type) /)) > 1) then
info = psb_err_many_optional_arg_ info = psb_err_many_optional_arg_
call psb_errpush(info,name,a_err='TYPE, MOLD') 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 goto 9999
end if end if
if (present(dupl)) then if (present(dupl)) then
call altmp%set_dupl(dupl) call altmp%set_dupl(dupl)
else if (a%is_bld()) then else if (a%is_bld()) then
! Does this make sense at all?? Who knows.. ! Does this make sense at all?? Who knows..
call altmp%set_dupl(psb_dupl_def_) call altmp%set_dupl(psb_dupl_def_)
end if end if
if (debug) write(psb_err_unit,*) 'Converting from ',& if (debug) write(psb_err_unit,*) 'Converting from ',&
& a%get_fmt(),' to ',altmp%get_fmt() & a%get_fmt(),' to ',altmp%get_fmt()
@ -1423,12 +1411,17 @@ subroutine psb_d_cp_from(a,b)
call psb_erractionsave(err_act) call psb_erractionsave(err_act)
info = psb_success_ 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) #if defined(HAVE_MOLD)
allocate(a%a,mold=b,stat=info) allocate(a%a,mold=b,stat=info)
if (info /= psb_success_) info = psb_err_alloc_dealloc_
#else #else
call b%mold(a%a,info) call b%mold(a%a,info)
#endif #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_) call a%a%cp_from_fmt(b, info)
if (info /= psb_success_) goto 9999 if (info /= psb_success_) goto 9999
@ -1507,10 +1500,10 @@ subroutine psb_dspmat_type_move(a,b,info)
end subroutine psb_dspmat_type_move 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_error_mod
use psb_string_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 implicit none
class(psb_dspmat_type), intent(in) :: a class(psb_dspmat_type), intent(in) :: a
class(psb_dspmat_type), intent(out) :: b class(psb_dspmat_type), intent(out) :: b
@ -1543,7 +1536,7 @@ subroutine psb_dspmat_type_clone(a,b,info)
return return
end if end if
end subroutine psb_dspmat_type_clone end subroutine psb_dspmat_clone
@ -1835,7 +1828,6 @@ subroutine psb_d_csmv(alpha,a,x,beta,y,info,trans)
end subroutine psb_d_csmv end subroutine psb_d_csmv
subroutine psb_d_csmv_vect(alpha,a,x,beta,y,info,trans) subroutine psb_d_csmv_vect(alpha,a,x,beta,y,info,trans)
use psb_error_mod use psb_error_mod
use psb_d_vect_mod use psb_d_vect_mod
@ -1887,6 +1879,7 @@ subroutine psb_d_csmv_vect(alpha,a,x,beta,y,info,trans)
end subroutine psb_d_csmv_vect end subroutine psb_d_csmv_vect
subroutine psb_d_cssm(alpha,a,x,beta,y,info,trans,scale,d) subroutine psb_d_cssm(alpha,a,x,beta,y,info,trans,scale,d)
use psb_error_mod use psb_error_mod
use psb_d_mat_mod, psb_protect_name => psb_d_cssm 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' character(len=20) :: name='csnmi'
logical, parameter :: debug=.false. logical, parameter :: debug=.false.
call psb_get_erraction(err_act)
info = psb_success_ info = psb_success_
call psb_get_erraction(err_act)
if (.not.allocated(a%a)) then if (.not.allocated(a%a)) then
info = psb_err_invalid_mat_state_ info = psb_err_invalid_mat_state_
call psb_errpush(info,name) call psb_errpush(info,name)
@ -2282,6 +2275,7 @@ subroutine psb_d_aclsum(d,a,info)
end subroutine psb_d_aclsum end subroutine psb_d_aclsum
subroutine psb_d_get_diag(a,d,info) subroutine psb_d_get_diag(a,d,info)
use psb_d_mat_mod, psb_protect_name => psb_d_get_diag use psb_d_mat_mod, psb_protect_name => psb_d_get_diag
use psb_error_mod use psb_error_mod
@ -2295,8 +2289,8 @@ subroutine psb_d_get_diag(a,d,info)
character(len=20) :: name='get_diag' character(len=20) :: name='get_diag'
logical, parameter :: debug=.false. logical, parameter :: debug=.false.
call psb_erractionsave(err_act)
info = psb_success_ info = psb_success_
call psb_erractionsave(err_act)
if (.not.allocated(a%a)) then if (.not.allocated(a%a)) then
info = psb_err_invalid_mat_state_ info = psb_err_invalid_mat_state_
call psb_errpush(info,name) call psb_errpush(info,name)
@ -2334,8 +2328,8 @@ subroutine psb_d_scal(d,a,info)
character(len=20) :: name='scal' character(len=20) :: name='scal'
logical, parameter :: debug=.false. logical, parameter :: debug=.false.
call psb_erractionsave(err_act)
info = psb_success_ info = psb_success_
call psb_erractionsave(err_act)
if (.not.allocated(a%a)) then if (.not.allocated(a%a)) then
info = psb_err_invalid_mat_state_ info = psb_err_invalid_mat_state_
call psb_errpush(info,name) call psb_errpush(info,name)
@ -2373,8 +2367,8 @@ subroutine psb_d_scals(d,a,info)
character(len=20) :: name='scal' character(len=20) :: name='scal'
logical, parameter :: debug=.false. logical, parameter :: debug=.false.
call psb_erractionsave(err_act)
info = psb_success_ info = psb_success_
call psb_erractionsave(err_act)
if (.not.allocated(a%a)) then if (.not.allocated(a%a)) then
info = psb_err_invalid_mat_state_ info = psb_err_invalid_mat_state_
call psb_errpush(info,name) call psb_errpush(info,name)

82
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 ! Valid values for DUPL:
use psb_error_mod ! psb_dupl_ovwrt_
implicit none ! psb_dupl_add_
class(psb_sspmat_type), intent(inout) :: a ! psb_dupl_err_
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
subroutine psb_s_set_dupl(n,a) subroutine psb_s_set_dupl(n,a)
use psb_s_mat_mod, psb_protect_name => psb_s_set_dupl 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 end subroutine psb_s_set_dupl
!
! Set the STATE of the internal matrix object
!
subroutine psb_s_set_null(a) subroutine psb_s_set_null(a)
use psb_s_mat_mod, psb_protect_name => psb_s_set_null use psb_s_mat_mod, psb_protect_name => psb_s_set_null
use psb_error_mod 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 end subroutine psb_s_n_sparse_print
subroutine psb_s_get_neigh(a,idx,neigh,n,info,lev) 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_s_mat_mod, psb_protect_name => psb_s_get_neigh
use psb_error_mod use psb_error_mod
@ -1032,7 +1022,6 @@ subroutine psb_s_cscnv(a,b,info,type,mold,upd,dupl)
call psb_errpush(info,name) call psb_errpush(info,name)
goto 9999 goto 9999
endif endif
if (count( (/present(mold),present(type) /)) > 1) then if (count( (/present(mold),present(type) /)) > 1) then
info = psb_err_many_optional_arg_ info = psb_err_many_optional_arg_
call psb_errpush(info,name,a_err='TYPE, MOLD') call psb_errpush(info,name,a_err='TYPE, MOLD')
@ -1078,6 +1067,7 @@ subroutine psb_s_cscnv(a,b,info,type,mold,upd,dupl)
! Does this make sense at all?? Who knows.. ! Does this make sense at all?? Who knows..
call altmp%set_dupl(psb_dupl_def_) call altmp%set_dupl(psb_dupl_def_)
end if end if
if (debug) write(psb_err_unit,*) 'Converting from ',& if (debug) write(psb_err_unit,*) 'Converting from ',&
& a%get_fmt(),' to ',altmp%get_fmt() & a%get_fmt(),' to ',altmp%get_fmt()
@ -1421,12 +1411,17 @@ subroutine psb_s_cp_from(a,b)
call psb_erractionsave(err_act) call psb_erractionsave(err_act)
info = psb_success_ 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) #if defined(HAVE_MOLD)
allocate(a%a,mold=b,stat=info) allocate(a%a,mold=b,stat=info)
if (info /= psb_success_) info = psb_err_alloc_dealloc_
#else #else
call b%mold(a%a,info) call b%mold(a%a,info)
#endif #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_) call a%a%cp_from_fmt(b, info)
if (info /= psb_success_) goto 9999 if (info /= psb_success_) goto 9999
@ -1505,10 +1500,10 @@ subroutine psb_sspmat_type_move(a,b,info)
end subroutine psb_sspmat_type_move 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_error_mod
use psb_string_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 implicit none
class(psb_sspmat_type), intent(in) :: a class(psb_sspmat_type), intent(in) :: a
class(psb_sspmat_type), intent(out) :: b class(psb_sspmat_type), intent(out) :: b
@ -1527,7 +1522,6 @@ subroutine psb_sspmat_type_clone(a,b,info)
#else #else
call a%a%mold(b%a,info) call a%a%mold(b%a,info)
#endif #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_) call b%a%cp_from_fmt(a%a, info)
if (info /= psb_success_) goto 9999 if (info /= psb_success_) goto 9999
@ -1542,7 +1536,7 @@ subroutine psb_sspmat_type_clone(a,b,info)
return return
end if end if
end subroutine psb_sspmat_type_clone end subroutine psb_sspmat_clone
@ -1885,6 +1879,7 @@ subroutine psb_s_csmv_vect(alpha,a,x,beta,y,info,trans)
end subroutine psb_s_csmv_vect end subroutine psb_s_csmv_vect
subroutine psb_s_cssm(alpha,a,x,beta,y,info,trans,scale,d) subroutine psb_s_cssm(alpha,a,x,beta,y,info,trans,scale,d)
use psb_error_mod use psb_error_mod
use psb_s_mat_mod, psb_protect_name => psb_s_cssm 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' character(len=20) :: name='csnmi'
logical, parameter :: debug=.false. logical, parameter :: debug=.false.
call psb_get_erraction(err_act)
info = psb_success_ info = psb_success_
call psb_get_erraction(err_act)
if (.not.allocated(a%a)) then if (.not.allocated(a%a)) then
info = psb_err_invalid_mat_state_ info = psb_err_invalid_mat_state_
call psb_errpush(info,name) call psb_errpush(info,name)
@ -2280,6 +2275,7 @@ subroutine psb_s_aclsum(d,a,info)
end subroutine psb_s_aclsum end subroutine psb_s_aclsum
subroutine psb_s_get_diag(a,d,info) subroutine psb_s_get_diag(a,d,info)
use psb_s_mat_mod, psb_protect_name => psb_s_get_diag use psb_s_mat_mod, psb_protect_name => psb_s_get_diag
use psb_error_mod use psb_error_mod
@ -2293,8 +2289,8 @@ subroutine psb_s_get_diag(a,d,info)
character(len=20) :: name='get_diag' character(len=20) :: name='get_diag'
logical, parameter :: debug=.false. logical, parameter :: debug=.false.
call psb_erractionsave(err_act)
info = psb_success_ info = psb_success_
call psb_erractionsave(err_act)
if (.not.allocated(a%a)) then if (.not.allocated(a%a)) then
info = psb_err_invalid_mat_state_ info = psb_err_invalid_mat_state_
call psb_errpush(info,name) call psb_errpush(info,name)
@ -2332,8 +2328,8 @@ subroutine psb_s_scal(d,a,info)
character(len=20) :: name='scal' character(len=20) :: name='scal'
logical, parameter :: debug=.false. logical, parameter :: debug=.false.
call psb_erractionsave(err_act)
info = psb_success_ info = psb_success_
call psb_erractionsave(err_act)
if (.not.allocated(a%a)) then if (.not.allocated(a%a)) then
info = psb_err_invalid_mat_state_ info = psb_err_invalid_mat_state_
call psb_errpush(info,name) call psb_errpush(info,name)
@ -2371,8 +2367,8 @@ subroutine psb_s_scals(d,a,info)
character(len=20) :: name='scal' character(len=20) :: name='scal'
logical, parameter :: debug=.false. logical, parameter :: debug=.false.
call psb_erractionsave(err_act)
info = psb_success_ info = psb_success_
call psb_erractionsave(err_act)
if (.not.allocated(a%a)) then if (.not.allocated(a%a)) then
info = psb_err_invalid_mat_state_ info = psb_err_invalid_mat_state_
call psb_errpush(info,name) call psb_errpush(info,name)

70
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 ! Valid values for DUPL:
use psb_error_mod ! psb_dupl_ovwrt_
implicit none ! psb_dupl_add_
class(psb_zspmat_type), intent(inout) :: a ! psb_dupl_err_
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
subroutine psb_z_set_dupl(n,a) subroutine psb_z_set_dupl(n,a)
use psb_z_mat_mod, psb_protect_name => psb_z_set_dupl 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 end subroutine psb_z_set_dupl
!
! Set the STATE of the internal matrix object
!
subroutine psb_z_set_null(a) subroutine psb_z_set_null(a)
use psb_z_mat_mod, psb_protect_name => psb_z_set_null use psb_z_mat_mod, psb_protect_name => psb_z_set_null
use psb_error_mod use psb_error_mod
@ -1033,7 +1022,6 @@ subroutine psb_z_cscnv(a,b,info,type,mold,upd,dupl)
call psb_errpush(info,name) call psb_errpush(info,name)
goto 9999 goto 9999
endif endif
if (count( (/present(mold),present(type) /)) > 1) then if (count( (/present(mold),present(type) /)) > 1) then
info = psb_err_many_optional_arg_ info = psb_err_many_optional_arg_
call psb_errpush(info,name,a_err='TYPE, MOLD') 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 goto 9999
end if end if
if (present(dupl)) then if (present(dupl)) then
call altmp%set_dupl(dupl) call altmp%set_dupl(dupl)
else if (a%is_bld()) then else if (a%is_bld()) then
@ -1422,12 +1411,17 @@ subroutine psb_z_cp_from(a,b)
call psb_erractionsave(err_act) call psb_erractionsave(err_act)
info = psb_success_ 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) #if defined(HAVE_MOLD)
allocate(a%a,mold=b,stat=info) allocate(a%a,mold=b,stat=info)
if (info /= psb_success_) info = psb_err_alloc_dealloc_
#else #else
call b%mold(a%a,info) call b%mold(a%a,info)
#endif #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_) call a%a%cp_from_fmt(b, info)
if (info /= psb_success_) goto 9999 if (info /= psb_success_) goto 9999
@ -1506,10 +1500,10 @@ subroutine psb_zspmat_type_move(a,b,info)
end subroutine psb_zspmat_type_move 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_error_mod
use psb_string_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 implicit none
class(psb_zspmat_type), intent(in) :: a class(psb_zspmat_type), intent(in) :: a
class(psb_zspmat_type), intent(out) :: b class(psb_zspmat_type), intent(out) :: b
@ -1542,7 +1536,7 @@ subroutine psb_zspmat_type_clone(a,b,info)
return return
end if end if
end subroutine psb_zspmat_type_clone end subroutine psb_zspmat_clone

Write Preview
Loading…
Cancel
Save