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

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

90
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
@ -194,14 +191,6 @@ module psb_d_mat_mod
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
@ -278,7 +267,6 @@ module psb_d_mat_mod
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
@ -360,7 +348,7 @@ module psb_d_mat_mod
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
@ -393,7 +381,7 @@ module psb_d_mat_mod
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
@ -408,7 +396,7 @@ module psb_d_mat_mod
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
@ -420,7 +408,7 @@ module psb_d_mat_mod
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
@ -485,7 +473,7 @@ module psb_d_mat_mod
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
@ -493,15 +481,15 @@ module psb_d_mat_mod
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
@ -509,7 +497,7 @@ module psb_d_mat_mod
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
@ -524,12 +512,12 @@ module psb_d_mat_mod
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
@ -580,6 +568,7 @@ module psb_d_mat_mod
end interface
! == ===================================
!
!
@ -613,12 +602,12 @@ 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
@ -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
@ -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,8 +698,8 @@ 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
@ -769,7 +758,6 @@ contains
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
@ -993,4 +968,5 @@ contains
end function psb_d_get_nz_row
end module psb_d_mat_mod

176
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
@ -195,14 +191,6 @@ module psb_s_mat_mod
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
@ -279,7 +267,6 @@ module psb_s_mat_mod
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
@ -350,9 +337,9 @@ module psb_s_mat_mod
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(:)
@ -361,8 +348,8 @@ module psb_s_mat_mod
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
@ -378,12 +365,12 @@ module psb_s_mat_mod
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(:)
@ -394,8 +381,8 @@ module psb_s_mat_mod
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
@ -409,8 +396,8 @@ module psb_s_mat_mod
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
@ -421,8 +408,8 @@ module psb_s_mat_mod
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
@ -433,7 +420,7 @@ module psb_s_mat_mod
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
@ -446,7 +433,7 @@ module psb_s_mat_mod
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
@ -458,7 +445,7 @@ module psb_s_mat_mod
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
@ -485,32 +472,32 @@ module psb_s_mat_mod
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
@ -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
@ -581,6 +568,7 @@ module psb_s_mat_mod
end interface
! == ===================================
!
!
@ -596,26 +584,26 @@ 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
@ -625,28 +613,28 @@ module psb_s_mat_mod
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
@ -657,84 +645,85 @@ module psb_s_mat_mod
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
@ -769,7 +758,6 @@ contains
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
@ -993,4 +968,5 @@ contains
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

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
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')
@ -1079,6 +1067,7 @@ subroutine psb_c_cscnv(a,b,info,type,mold,upd,dupl)
! 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()
@ -1422,9 +1411,13 @@ 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)

112
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()
@ -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
@ -1423,12 +1411,17 @@ 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)

102
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,7 +1022,6 @@ 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')
@ -1078,6 +1067,7 @@ subroutine psb_s_cscnv(a,b,info,type,mold,upd,dupl)
! 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,12 +1411,17 @@ 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)

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
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
@ -1422,12 +1411,17 @@ 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