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_base_mat_mod.f90
 base/modules/psb_c_base_mat_mod.f90
 base/modules/psb_c_base_vect_mod.f90
 base/modules/psb_c_csc_mat_mod.f90
 base/modules/psb_c_csr_mat_mod.f90
 base/modules/psb_c_mat_mod.f90
 base/modules/psb_c_vect_mod.f90
 base/modules/psb_d_base_mat_mod.f90
 base/modules/psb_d_base_vect_mod.f90
 base/modules/psb_d_csc_mat_mod.f90
 base/modules/psb_d_csr_mat_mod.f90
 base/modules/psb_d_mat_mod.f90
 base/modules/psb_d_vect_mod.f90
 base/modules/psb_s_base_mat_mod.f90
 base/modules/psb_s_base_vect_mod.f90
 base/modules/psb_s_csc_mat_mod.f90
 base/modules/psb_s_csr_mat_mod.f90
 base/modules/psb_s_mat_mod.f90
 base/modules/psb_s_vect_mod.f90
 base/modules/psb_z_base_mat_mod.f90
 base/modules/psb_z_base_vect_mod.f90
 base/modules/psb_z_csc_mat_mod.f90
 base/modules/psb_z_csr_mat_mod.f90
 base/modules/psb_z_mat_mod.f90
 base/modules/psb_z_vect_mod.f90
 base/serial/impl/psb_c_base_mat_impl.f90
 base/serial/impl/psb_d_base_mat_impl.f90
 base/serial/impl/psb_s_base_mat_impl.f90
 base/serial/impl/psb_z_base_mat_impl.f90

Description adds from preprocessing.
psblas3-type-indexed
Salvatore Filippone 13 years ago
parent 51eb598553
commit 42b83a54a5
29 changed files with 2222 additions and 1427 deletions
Show Stats Download Patch File Download Diff File

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

@ -64,15 +64,27 @@ module psb_base_mat_mod
use psb_const_mod
use psi_serial_mod
integer, parameter, private :: auxsz=32
!
! type psb_base_sparse_mat: the basic data about your matrix
! M: number of rows
! N: number of columns
! STATE: null: pristine
! build: it's being filled with entries
! assembled: ready to use in computations
! update: accepts coefficients but only
! in already existing entries
! TRIANGLE: is it triangular?
! UPPER: If it is triangular, is it upper (otherwise lower)
! UNITD: If it is triangular, is the diagonal assumed to
! be unitary and not stored explicitly?
! SORTED: are the entries guaranteed to be sorted?
!
!
type :: psb_base_sparse_mat
integer, private :: m, n
integer, private :: state, duplicate
logical, private :: triangle, unitd, upper, sorted
! This is a different animal: it's a kitchen sink for
! any additional parameters that may be needed
! when converting to/from COO.
integer :: aux(auxsz)
logical, private :: triangle, upper, unitd, sorted
contains
! == = =================================
@ -89,7 +101,6 @@ module psb_base_mat_mod
procedure, pass(a) :: get_state => psb_base_get_state
procedure, pass(a) :: get_dupl => psb_base_get_dupl
procedure, nopass :: get_fmt => psb_base_get_fmt
procedure, pass(a) :: get_aux => psb_base_get_aux
procedure, pass(a) :: is_null => psb_base_is_null
procedure, pass(a) :: is_bld => psb_base_is_bld
procedure, pass(a) :: is_upd => psb_base_is_upd
@ -118,7 +129,6 @@ module psb_base_mat_mod
procedure, pass(a) :: set_lower => psb_base_set_lower
procedure, pass(a) :: set_triangle => psb_base_set_triangle
procedure, pass(a) :: set_unit => psb_base_set_unit
procedure, pass(a) :: set_aux => psb_base_set_aux
! == = =================================
@ -301,23 +311,6 @@ contains
res = a%n
end function psb_base_get_ncols
subroutine psb_base_set_aux(v,a)
implicit none
class(psb_base_sparse_mat), intent(inout) :: a
integer, intent(in) :: v(:)
! TBD
!write(psb_err_unit,*) 'SET_AUX is empty right now '
end subroutine psb_base_set_aux
subroutine psb_base_get_aux(v,a)
implicit none
class(psb_base_sparse_mat), intent(in) :: a
integer, intent(out), allocatable :: v(:)
! TBD
!write(psb_err_unit,*) 'GET_AUX is empty right now '
end subroutine psb_base_get_aux
subroutine psb_base_set_nrows(m,a)
implicit none
class(psb_base_sparse_mat), intent(inout) :: a
@ -513,7 +506,6 @@ contains
a%unitd = b%unitd
a%upper = b%upper
a%sorted = b%sorted
a%aux(:) = b%aux(:)
end subroutine psb_base_mv_from
@ -531,7 +523,6 @@ contains
a%unitd = b%unitd
a%upper = b%upper
a%sorted = b%sorted
a%aux(:) = b%aux(:)
end subroutine psb_base_cp_from
@ -549,7 +540,6 @@ contains
b%unitd = a%unitd
b%upper = .not.a%upper
b%sorted = .false.
b%aux(:) = a%aux(:)
end subroutine psb_base_transp_2mat
@ -568,7 +558,6 @@ contains
b%unitd = a%unitd
b%upper = .not.a%upper
b%sorted = .false.
b%aux(:) = a%aux(:)
end subroutine psb_base_transc_2mat

636
base/modules/psb_c_base_mat_mod.f90
Unescape Escape View File

@ -32,28 +32,27 @@
!
! package: psb_c_base_mat_mod
!
! This module contains the implementation of the
! psb_c_base_sparse_mat, derived from the psb_base_sparse_mat to
! define a middle level definition of a complex, single-precision sparse
! matrix object.This class object itself does not have any additional
! members with respect to those of the base class. No methods can be
! fully implemented at this level, but we can define the interface for
! the computational methods requiring the knowledge of the underlying
! This module contains the definition of the psb_c_base_sparse_mat
! type, derived from the psb_base_sparse_mat one to define a middle
! level definition of a complex(psb_spk_) sparse matrix
! object.This class object itself does not have any additional members
! with respect to those of the base class. No methods can be fully
! implemented at this level, but we can define the interface for the
! computational methods requiring the knowledge of the underlying
! field, such as the matrix-vector product; this interface is defined,
! but is supposed to be overridden at the leaf level.
!
! This module also contains the implementation of the
! psb_c_coo_sparse_mat type and the related methods. This is the
! reference type for all the format transitions, copies and mv unless
! methods are implemented that allow the direct transition from one
! format to another. The psb_c_coo_sparse_mat type extends the
! psb_c_base_sparse_mat one.
! format to another. The psb_c_coo_sparse_mat type extends
! psb_c_base_sparse_mat.
!
! About the method MOLD: this has been defined for those compilers
! not yet supporting ALLOCATE( ...MOLD=...); it's otherwise silly to
! not yet supporting ALLOCATE( ...,MOLD=...); it's otherwise silly to
! duplicate "by hand" what is specified in the language (in this case F2008)
!
module psb_c_base_mat_mod
use psb_base_mat_mod
@ -61,6 +60,40 @@ module psb_c_base_mat_mod
type, extends(psb_base_sparse_mat) :: psb_c_base_sparse_mat
contains
!
! Data management methods: defined here, but not implemented.
!
procedure, pass(a) :: csput => psb_c_base_csput
procedure, pass(a) :: c_csgetrow => psb_c_base_csgetrow
procedure, pass(a) :: c_csgetblk => psb_c_base_csgetblk
procedure, pass(a) :: get_diag => psb_c_base_get_diag
generic, public :: csget => c_csgetrow, c_csgetblk
procedure, pass(a) :: csclip => psb_c_base_csclip
procedure, pass(a) :: mold => psb_c_base_mold
procedure, pass(a) :: cp_to_coo => psb_c_base_cp_to_coo
procedure, pass(a) :: cp_from_coo => psb_c_base_cp_from_coo
procedure, pass(a) :: cp_to_fmt => psb_c_base_cp_to_fmt
procedure, pass(a) :: cp_from_fmt => psb_c_base_cp_from_fmt
procedure, pass(a) :: mv_to_coo => psb_c_base_mv_to_coo
procedure, pass(a) :: mv_from_coo => psb_c_base_mv_from_coo
procedure, pass(a) :: mv_to_fmt => psb_c_base_mv_to_fmt
procedure, pass(a) :: mv_from_fmt => psb_c_base_mv_from_fmt
procedure, pass(a) :: c_base_cp_from
generic, public :: cp_from => c_base_cp_from
procedure, pass(a) :: c_base_mv_from
generic, public :: mv_from => c_base_mv_from
!
! Transpose methods: defined here but not implemented.
!
procedure, pass(a) :: transp_1mat => psb_c_base_transp_1mat
procedure, pass(a) :: transp_2mat => psb_c_base_transp_2mat
procedure, pass(a) :: transc_1mat => psb_c_base_transc_1mat
procedure, pass(a) :: transc_2mat => psb_c_base_transc_2mat
!
! Computational methods: defined here but not implemented.
!
procedure, pass(a) :: c_sp_mv => psb_c_base_vect_mv
procedure, pass(a) :: c_csmv => psb_c_base_csmv
procedure, pass(a) :: c_csmm => psb_c_base_csmm
@ -83,32 +116,6 @@ module psb_c_base_mat_mod
procedure, pass(a) :: arwsum => psb_c_base_arwsum
procedure, pass(a) :: colsum => psb_c_base_colsum
procedure, pass(a) :: aclsum => psb_c_base_aclsum
procedure, pass(a) :: get_diag => psb_c_base_get_diag
procedure, pass(a) :: csput => psb_c_base_csput
procedure, pass(a) :: c_csgetrow => psb_c_base_csgetrow
procedure, pass(a) :: c_csgetblk => psb_c_base_csgetblk
generic, public :: csget => c_csgetrow, c_csgetblk
procedure, pass(a) :: csclip => psb_c_base_csclip
procedure, pass(a) :: mold => psb_c_base_mold
procedure, pass(a) :: cp_to_coo => psb_c_base_cp_to_coo
procedure, pass(a) :: cp_from_coo => psb_c_base_cp_from_coo
procedure, pass(a) :: cp_to_fmt => psb_c_base_cp_to_fmt
procedure, pass(a) :: cp_from_fmt => psb_c_base_cp_from_fmt
procedure, pass(a) :: mv_to_coo => psb_c_base_mv_to_coo
procedure, pass(a) :: mv_from_coo => psb_c_base_mv_from_coo
procedure, pass(a) :: mv_to_fmt => psb_c_base_mv_to_fmt
procedure, pass(a) :: mv_from_fmt => psb_c_base_mv_from_fmt
procedure, pass(a) :: c_base_cp_from
generic, public :: cp_from => c_base_cp_from
procedure, pass(a) :: c_base_mv_from
generic, public :: mv_from => c_base_mv_from
procedure, pass(a) :: transp_1mat => psb_c_base_transp_1mat
procedure, pass(a) :: transp_2mat => psb_c_base_transp_2mat
procedure, pass(a) :: transc_1mat => psb_c_base_transc_1mat
procedure, pass(a) :: transc_2mat => psb_c_base_transc_2mat
end type psb_c_base_sparse_mat
private :: c_base_cp_from, c_base_mv_from
@ -121,25 +128,13 @@ module psb_c_base_mat_mod
complex(psb_spk_), allocatable :: val(:)
contains
!
! Data management methods.
!
procedure, pass(a) :: get_size => c_coo_get_size
procedure, pass(a) :: get_nzeros => c_coo_get_nzeros
procedure, pass(a) :: set_nzeros => c_coo_set_nzeros
procedure, nopass :: get_fmt => c_coo_get_fmt
procedure, pass(a) :: sizeof => c_coo_sizeof
procedure, pass(a) :: c_csmm => psb_c_coo_csmm
procedure, pass(a) :: c_csmv => psb_c_coo_csmv
procedure, pass(a) :: c_inner_cssm => psb_c_coo_cssm
procedure, pass(a) :: c_inner_cssv => psb_c_coo_cssv
procedure, pass(a) :: c_scals => psb_c_coo_scals
procedure, pass(a) :: c_scal => psb_c_coo_scal
procedure, pass(a) :: maxval => psb_c_coo_maxval
procedure, pass(a) :: csnmi => psb_c_coo_csnmi
procedure, pass(a) :: csnm1 => psb_c_coo_csnm1
procedure, pass(a) :: rowsum => psb_c_coo_rowsum
procedure, pass(a) :: arwsum => psb_c_coo_arwsum
procedure, pass(a) :: colsum => psb_c_coo_colsum
procedure, pass(a) :: aclsum => psb_c_coo_aclsum
procedure, pass(a) :: reallocate_nz => psb_c_coo_reallocate_nz
procedure, pass(a) :: allocate_mnnz => psb_c_coo_allocate_mnnz
procedure, pass(a) :: cp_to_coo => psb_c_cp_coo_to_coo
@ -154,8 +149,8 @@ module psb_c_base_mat_mod
procedure, pass(a) :: get_diag => psb_c_coo_get_diag
procedure, pass(a) :: c_csgetrow => psb_c_coo_csgetrow
procedure, pass(a) :: csgetptn => psb_c_coo_csgetptn
procedure, pass(a) :: get_nz_row => psb_c_coo_get_nz_row
procedure, pass(a) :: reinit => psb_c_coo_reinit
procedure, pass(a) :: get_nz_row => psb_c_coo_get_nz_row
procedure, pass(a) :: fix => psb_c_fix_coo
procedure, pass(a) :: trim => psb_c_coo_trim
procedure, pass(a) :: print => psb_c_coo_print
@ -165,8 +160,35 @@ module psb_c_base_mat_mod
generic, public :: cp_from => psb_c_coo_cp_from
procedure, pass(a) :: psb_c_coo_mv_from
generic, public :: mv_from => psb_c_coo_mv_from
!
! This is COO specific
!
procedure, pass(a) :: set_nzeros => c_coo_set_nzeros
!
! Transpose methods. These are the base of all
! indirection in transpose, together with conversions
! they are sufficient for all cases.
!
procedure, pass(a) :: transp_1mat => c_coo_transp_1mat
procedure, pass(a) :: transc_1mat => c_coo_transc_1mat
!
! Computational methods.
!
procedure, pass(a) :: c_csmm => psb_c_coo_csmm
procedure, pass(a) :: c_csmv => psb_c_coo_csmv
procedure, pass(a) :: c_inner_cssm => psb_c_coo_cssm
procedure, pass(a) :: c_inner_cssv => psb_c_coo_cssv
procedure, pass(a) :: c_scals => psb_c_coo_scals
procedure, pass(a) :: c_scal => psb_c_coo_scal
procedure, pass(a) :: maxval => psb_c_coo_maxval
procedure, pass(a) :: csnmi => psb_c_coo_csnmi
procedure, pass(a) :: csnm1 => psb_c_coo_csnm1
procedure, pass(a) :: rowsum => psb_c_coo_rowsum
procedure, pass(a) :: arwsum => psb_c_coo_arwsum
procedure, pass(a) :: colsum => psb_c_coo_colsum
procedure, pass(a) :: aclsum => psb_c_coo_aclsum
end type psb_c_coo_sparse_mat
@ -181,8 +203,274 @@ module psb_c_base_mat_mod
! BASE interfaces
!
! == =================
!
! CSPUT: Hand over a set of values to A.
! Simple description:
! A(IA(1:nz),JA(1:nz)) = VAL(1:NZ)
!
! Catches:
! 1. If A is in the BUILD state, then this method
! can only be called for COO matrice, in which case it
! is more like queueing coefficients for later processing.
! 2. If A is in the UPDATE state, then every derived class must
! implement this;
! 3. In the UPDATE state, depending on the value of DUPL flag
! inside A, it will be A=VAL or A = A + VAL
!
!
interface
subroutine psb_c_base_csput(nz,ia,ja,val,a,imin,imax,jmin,jmax,info,gtl)
import :: psb_c_base_sparse_mat, psb_spk_
class(psb_c_base_sparse_mat), intent(inout) :: a
complex(psb_spk_), intent(in) :: val(:)
integer, intent(in) :: nz, ia(:), ja(:), imin,imax,jmin,jmax
integer, intent(out) :: info
integer, intent(in), optional :: gtl(:)
end subroutine psb_c_base_csput
end interface
!
! CSGET methods: getrow, getblk, clip.
! getrow is the basic method, the other two are
! basically convenient wrappers/shorthand.
!
! out(:) = A(imin:imax,:)
!
! The two methods differ on the output format
!
! GETROW returns as the set
! NZ, IA(1:nz), JA(1:nz), VAL(1:NZ)
!
! Optional arguments:
! JMIN,JMAX: get A(IMIN:IMAX,JMIN:JMAX),
! default 1:ncols
! APPEND: append at the end of data, in which case
! # used entries must be in NZ
! RSCALE, CSCALE: scale output indices at base 1.
!
! GETROW must be overridden by all data formats.
!
interface
subroutine psb_c_base_csgetrow(imin,imax,a,nz,ia,ja,val,info,&
& jmin,jmax,iren,append,nzin,rscale,cscale)
import :: psb_c_base_sparse_mat, psb_spk_
class(psb_c_base_sparse_mat), 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(:)
integer,intent(out) :: info
logical, intent(in), optional :: append
integer, intent(in), optional :: iren(:)
integer, intent(in), optional :: jmin,jmax, nzin
logical, intent(in), optional :: rscale,cscale
end subroutine psb_c_base_csgetrow
end interface
!
! CSGET methods: getrow, getblk.
! out(:) = A(imin:imax,:)
!
! GETBLK returns a pbs_c_coo_sparse_mat with
! the same contents.
! Default implementation at base level
! in terms of (derived) GETROW
!
interface
subroutine psb_c_base_csgetblk(imin,imax,a,b,info,&
& jmin,jmax,iren,append,rscale,cscale)
import :: psb_c_base_sparse_mat, psb_c_coo_sparse_mat, psb_spk_
class(psb_c_base_sparse_mat), intent(in) :: a
class(psb_c_coo_sparse_mat), intent(inout) :: b
integer, intent(in) :: imin,imax
integer,intent(out) :: info
logical, intent(in), optional :: append
integer, intent(in), optional :: iren(:)
integer, intent(in), optional :: jmin,jmax
logical, intent(in), optional :: rscale,cscale
end subroutine psb_c_base_csgetblk
end interface
!
! CLIP: extract a subset
! B(:,:) = A(imin:imax,jmin:jmax)
! control: rscale,cscale as in getblk above.
!
! Default implementation at base level in terms of
! GETBLK.
!
interface
subroutine psb_c_base_csclip(a,b,info,&
& imin,imax,jmin,jmax,rscale,cscale)
import :: psb_c_base_sparse_mat, psb_c_coo_sparse_mat, psb_spk_
class(psb_c_base_sparse_mat), intent(in) :: a
class(psb_c_coo_sparse_mat), intent(out) :: b
integer,intent(out) :: info
integer, intent(in), optional :: imin,imax,jmin,jmax
logical, intent(in), optional :: rscale,cscale
end subroutine psb_c_base_csclip
end interface
!
! GET_DIAG method
!
! D(i) = A(i:i), i=1:min(nrows,ncols)
!
interface
subroutine psb_c_base_get_diag(a,d,info)
import :: psb_c_base_sparse_mat, psb_spk_
class(psb_c_base_sparse_mat), intent(in) :: a
complex(psb_spk_), intent(out) :: d(:)
integer, intent(out) :: info
end subroutine psb_c_base_get_diag
end interface
!
! MOLD: make B have the same dinamyc type
! as A.
! For compilers not supporting
! allocate( mold= )
!
interface
subroutine psb_c_base_mold(a,b,info)
import :: psb_c_base_sparse_mat, psb_long_int_k_
class(psb_c_base_sparse_mat), intent(in) :: a
class(psb_c_base_sparse_mat), intent(out), allocatable :: b
integer, intent(out) :: info
end subroutine psb_c_base_mold
end interface
!
! These are the methods implementing the MEDIATOR pattern
! to allow switch between arbitrary.
! Indeed, the TO/FROM FMT can be implemented at the base level
! in terms of the TO/FROM COO per the MEDIATOR design pattern.
! This does not prevent most of the derived classes to
! provide their own versions with shortcuts.
! A%{MV|CP}_{TO|FROM}_{FMT|COO}
! MV|CP: copy versus move, i.e. deallocate
! TO|FROM: invoked from source or target object
!
!
interface
subroutine psb_c_base_cp_to_coo(a,b,info)
import :: psb_c_base_sparse_mat, psb_c_coo_sparse_mat, psb_spk_
class(psb_c_base_sparse_mat), intent(in) :: a
class(psb_c_coo_sparse_mat), intent(inout) :: b
integer, intent(out) :: info
end subroutine psb_c_base_cp_to_coo
end interface
interface
subroutine psb_c_base_cp_from_coo(a,b,info)
import :: psb_c_base_sparse_mat, psb_c_coo_sparse_mat, psb_spk_
class(psb_c_base_sparse_mat), intent(inout) :: a
class(psb_c_coo_sparse_mat), intent(in) :: b
integer, intent(out) :: info
end subroutine psb_c_base_cp_from_coo
end interface
interface
subroutine psb_c_base_cp_to_fmt(a,b,info)
import :: psb_c_base_sparse_mat, psb_spk_
class(psb_c_base_sparse_mat), intent(in) :: a
class(psb_c_base_sparse_mat), intent(inout) :: b
integer, intent(out) :: info
end subroutine psb_c_base_cp_to_fmt
end interface
interface
subroutine psb_c_base_cp_from_fmt(a,b,info)
import :: psb_c_base_sparse_mat, psb_spk_
class(psb_c_base_sparse_mat), intent(inout) :: a
class(psb_c_base_sparse_mat), intent(in) :: b
integer, intent(out) :: info
end subroutine psb_c_base_cp_from_fmt
end interface
interface
subroutine psb_c_base_mv_to_coo(a,b,info)
import :: psb_c_base_sparse_mat, psb_c_coo_sparse_mat, psb_spk_
class(psb_c_base_sparse_mat), intent(inout) :: a
class(psb_c_coo_sparse_mat), intent(inout) :: b
integer, intent(out) :: info
end subroutine psb_c_base_mv_to_coo
end interface
interface
subroutine psb_c_base_mv_from_coo(a,b,info)
import :: psb_c_base_sparse_mat, psb_c_coo_sparse_mat, psb_spk_
class(psb_c_base_sparse_mat), intent(inout) :: a
class(psb_c_coo_sparse_mat), intent(inout) :: b
integer, intent(out) :: info
end subroutine psb_c_base_mv_from_coo
end interface
interface
subroutine psb_c_base_mv_to_fmt(a,b,info)
import :: psb_c_base_sparse_mat, psb_spk_
class(psb_c_base_sparse_mat), intent(inout) :: a
class(psb_c_base_sparse_mat), intent(inout) :: b
integer, intent(out) :: info
end subroutine psb_c_base_mv_to_fmt
end interface
interface
subroutine psb_c_base_mv_from_fmt(a,b,info)
import :: psb_c_base_sparse_mat, psb_spk_
class(psb_c_base_sparse_mat), intent(inout) :: a
class(psb_c_base_sparse_mat), intent(inout) :: b
integer, intent(out) :: info
end subroutine psb_c_base_mv_from_fmt
end interface
!
! Transpose methods.
! You can always default to COO to do the actual
! transpose work.
!
interface
subroutine psb_c_base_transp_2mat(a,b)
import :: psb_c_base_sparse_mat, psb_base_sparse_mat, psb_spk_
class(psb_c_base_sparse_mat), intent(in) :: a
class(psb_base_sparse_mat), intent(out) :: b
end subroutine psb_c_base_transp_2mat
end interface
interface
subroutine psb_c_base_transc_2mat(a,b)
import :: psb_c_base_sparse_mat, psb_base_sparse_mat, psb_spk_
class(psb_c_base_sparse_mat), intent(in) :: a
class(psb_base_sparse_mat), intent(out) :: b
end subroutine psb_c_base_transc_2mat
end interface
interface
subroutine psb_c_base_transp_1mat(a)
import :: psb_c_base_sparse_mat, psb_spk_
class(psb_c_base_sparse_mat), intent(inout) :: a
end subroutine psb_c_base_transp_1mat
end interface
interface
subroutine psb_c_base_transc_1mat(a)
import :: psb_c_base_sparse_mat, psb_spk_
class(psb_c_base_sparse_mat), intent(inout) :: a
end subroutine psb_c_base_transc_1mat
end interface
!
! Matrix-vector products.
! Y = alpha*A*X + beta*Y
!
! vect_mv relies on csmv for those data types
! not specifically using the encapsulation to handle
! foreign data.
!
!
interface
subroutine psb_c_base_csmm(alpha,a,x,beta,y,info,trans)
import :: psb_c_base_sparse_mat, psb_spk_
@ -209,14 +497,20 @@ module psb_c_base_mat_mod
subroutine psb_c_base_vect_mv(alpha,a,x,beta,y,info,trans)
import :: psb_c_base_sparse_mat, psb_spk_, psb_c_base_vect_type
class(psb_c_base_sparse_mat), intent(in) :: a
complex(psb_spk_), intent(in) :: alpha, beta
complex(psb_spk_), intent(in) :: alpha, beta
class(psb_c_base_vect_type), intent(inout) :: x
class(psb_c_base_vect_type), intent(inout) :: y
integer, intent(out) :: info
character, optional, intent(in) :: trans
end subroutine psb_c_base_vect_mv
end interface
!
! Triangular system solve.
! The CSSM/CSSV/VECT_SV outer methods are implemented at the base
! level, and they take care of the SCALE and D control arguments.
! So the derived classes need to override only the INNER_ methods.
!
interface
subroutine psb_c_base_inner_cssm(alpha,a,x,beta,y,info,trans)
import :: psb_c_base_sparse_mat, psb_spk_
@ -243,7 +537,7 @@ module psb_c_base_mat_mod
subroutine psb_c_base_inner_vect_sv(alpha,a,x,beta,y,info,trans)
import :: psb_c_base_sparse_mat, psb_spk_, psb_c_base_vect_type
class(psb_c_base_sparse_mat), intent(in) :: a
complex(psb_spk_), intent(in) :: alpha, beta
complex(psb_spk_), intent(in) :: alpha, beta
class(psb_c_base_vect_type), intent(inout) :: x, y
integer, intent(out) :: info
character, optional, intent(in) :: trans
@ -278,7 +572,7 @@ module psb_c_base_mat_mod
subroutine psb_c_base_vect_cssv(alpha,a,x,beta,y,info,trans,scale,d)
import :: psb_c_base_sparse_mat, psb_spk_,psb_c_base_vect_type
class(psb_c_base_sparse_mat), intent(in) :: a
complex(psb_spk_), intent(in) :: alpha, beta
complex(psb_spk_), intent(in) :: alpha, beta
class(psb_c_base_vect_type), intent(inout) :: x,y
integer, intent(out) :: info
character, optional, intent(in) :: trans, scale
@ -286,6 +580,10 @@ module psb_c_base_mat_mod
end subroutine psb_c_base_vect_cssv
end interface
!
! Scale a matrix by a scalar or by a vector.
! Should we handle scale on the columns??
!
interface
subroutine psb_c_base_scals(d,a,info)
import :: psb_c_base_sparse_mat, psb_spk_
@ -303,8 +601,10 @@ module psb_c_base_mat_mod
integer, intent(out) :: info
end subroutine psb_c_base_scal
end interface
!
! Maximum coefficient absolute value norm
!
interface
function psb_c_base_maxval(a) result(res)
import :: psb_c_base_sparse_mat, psb_spk_
@ -313,6 +613,9 @@ module psb_c_base_mat_mod
end function psb_c_base_maxval
end interface
!
! Operator infinity norm
!
interface
function psb_c_base_csnmi(a) result(res)
import :: psb_c_base_sparse_mat, psb_spk_
@ -320,7 +623,10 @@ module psb_c_base_mat_mod
real(psb_spk_) :: res
end function psb_c_base_csnmi
end interface
!
! Operator 1-norm
!
interface
function psb_c_base_csnm1(a) result(res)
import :: psb_c_base_sparse_mat, psb_spk_
@ -329,6 +635,10 @@ module psb_c_base_mat_mod
end function psb_c_base_csnm1
end interface
!
! Compute sums along the rows, either
! natural or absolute value
!
interface
subroutine psb_c_base_rowsum(d,a)
import :: psb_c_base_sparse_mat, psb_spk_
@ -345,6 +655,10 @@ module psb_c_base_mat_mod
end subroutine psb_c_base_arwsum
end interface
!
! Compute sums along the columns, either
! natural or absolute value
!
interface
subroutine psb_c_base_colsum(d,a)
import :: psb_c_base_sparse_mat, psb_spk_
@ -360,185 +674,7 @@ module psb_c_base_mat_mod
real(psb_spk_), intent(out) :: d(:)
end subroutine psb_c_base_aclsum
end interface
interface
subroutine psb_c_base_get_diag(a,d,info)
import :: psb_c_base_sparse_mat, psb_spk_
class(psb_c_base_sparse_mat), intent(in) :: a
complex(psb_spk_), intent(out) :: d(:)
integer, intent(out) :: info
end subroutine psb_c_base_get_diag
end interface
interface
subroutine psb_c_base_csput(nz,ia,ja,val,a,imin,imax,jmin,jmax,info,gtl)
import :: psb_c_base_sparse_mat, psb_spk_
class(psb_c_base_sparse_mat), intent(inout) :: a
complex(psb_spk_), intent(in) :: val(:)
integer, intent(in) :: nz, ia(:), ja(:), imin,imax,jmin,jmax
integer, intent(out) :: info
integer, intent(in), optional :: gtl(:)
end subroutine psb_c_base_csput
end interface
interface
subroutine psb_c_base_csgetrow(imin,imax,a,nz,ia,ja,val,info,&
& jmin,jmax,iren,append,nzin,rscale,cscale)
import :: psb_c_base_sparse_mat, psb_spk_
class(psb_c_base_sparse_mat), 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(:)
integer,intent(out) :: info
logical, intent(in), optional :: append
integer, intent(in), optional :: iren(:)
integer, intent(in), optional :: jmin,jmax, nzin
logical, intent(in), optional :: rscale,cscale
end subroutine psb_c_base_csgetrow
end interface
interface
subroutine psb_c_base_csgetblk(imin,imax,a,b,info,&
& jmin,jmax,iren,append,rscale,cscale)
import :: psb_c_base_sparse_mat, psb_c_coo_sparse_mat, psb_spk_
class(psb_c_base_sparse_mat), intent(in) :: a
class(psb_c_coo_sparse_mat), intent(inout) :: b
integer, intent(in) :: imin,imax
integer,intent(out) :: info
logical, intent(in), optional :: append
integer, intent(in), optional :: iren(:)
integer, intent(in), optional :: jmin,jmax
logical, intent(in), optional :: rscale,cscale
end subroutine psb_c_base_csgetblk
end interface
interface
subroutine psb_c_base_csclip(a,b,info,&
& imin,imax,jmin,jmax,rscale,cscale)
import :: psb_c_base_sparse_mat, psb_c_coo_sparse_mat, psb_spk_
class(psb_c_base_sparse_mat), intent(in) :: a
class(psb_c_coo_sparse_mat), intent(out) :: b
integer,intent(out) :: info
integer, intent(in), optional :: imin,imax,jmin,jmax
logical, intent(in), optional :: rscale,cscale
end subroutine psb_c_base_csclip
end interface
interface
subroutine psb_c_base_mold(a,b,info)
import :: psb_c_base_sparse_mat, psb_long_int_k_
class(psb_c_base_sparse_mat), intent(in) :: a
class(psb_c_base_sparse_mat), intent(out), allocatable :: b
integer, intent(out) :: info
end subroutine psb_c_base_mold
end interface
interface
subroutine psb_c_base_cp_to_coo(a,b,info)
import :: psb_c_base_sparse_mat, psb_c_coo_sparse_mat, psb_spk_
class(psb_c_base_sparse_mat), intent(in) :: a
class(psb_c_coo_sparse_mat), intent(inout) :: b
integer, intent(out) :: info
end subroutine psb_c_base_cp_to_coo
end interface
interface
subroutine psb_c_base_cp_from_coo(a,b,info)
import :: psb_c_base_sparse_mat, psb_c_coo_sparse_mat, psb_spk_
class(psb_c_base_sparse_mat), intent(inout) :: a
class(psb_c_coo_sparse_mat), intent(in) :: b
integer, intent(out) :: info
end subroutine psb_c_base_cp_from_coo
end interface
interface
subroutine psb_c_base_cp_to_fmt(a,b,info)
import :: psb_c_base_sparse_mat, psb_spk_
class(psb_c_base_sparse_mat), intent(in) :: a
class(psb_c_base_sparse_mat), intent(inout) :: b
integer, intent(out) :: info
end subroutine psb_c_base_cp_to_fmt
end interface
interface
subroutine psb_c_base_cp_from_fmt(a,b,info)
import :: psb_c_base_sparse_mat, psb_spk_
class(psb_c_base_sparse_mat), intent(inout) :: a
class(psb_c_base_sparse_mat), intent(in) :: b
integer, intent(out) :: info
end subroutine psb_c_base_cp_from_fmt
end interface
interface
subroutine psb_c_base_mv_to_coo(a,b,info)
import :: psb_c_base_sparse_mat, psb_c_coo_sparse_mat, psb_spk_
class(psb_c_base_sparse_mat), intent(inout) :: a
class(psb_c_coo_sparse_mat), intent(inout) :: b
integer, intent(out) :: info
end subroutine psb_c_base_mv_to_coo
end interface
interface
subroutine psb_c_base_mv_from_coo(a,b,info)
import :: psb_c_base_sparse_mat, psb_c_coo_sparse_mat, psb_spk_
class(psb_c_base_sparse_mat), intent(inout) :: a
class(psb_c_coo_sparse_mat), intent(inout) :: b
integer, intent(out) :: info
end subroutine psb_c_base_mv_from_coo
end interface
interface
subroutine psb_c_base_mv_to_fmt(a,b,info)
import :: psb_c_base_sparse_mat, psb_spk_
class(psb_c_base_sparse_mat), intent(inout) :: a
class(psb_c_base_sparse_mat), intent(inout) :: b
integer, intent(out) :: info
end subroutine psb_c_base_mv_to_fmt
end interface
interface
subroutine psb_c_base_mv_from_fmt(a,b,info)
import :: psb_c_base_sparse_mat, psb_spk_
class(psb_c_base_sparse_mat), intent(inout) :: a
class(psb_c_base_sparse_mat), intent(inout) :: b
integer, intent(out) :: info
end subroutine psb_c_base_mv_from_fmt
end interface
interface
subroutine psb_c_base_transp_2mat(a,b)
import :: psb_c_base_sparse_mat, psb_base_sparse_mat, psb_spk_
class(psb_c_base_sparse_mat), intent(in) :: a
class(psb_base_sparse_mat), intent(out) :: b
end subroutine psb_c_base_transp_2mat
end interface
interface
subroutine psb_c_base_transc_2mat(a,b)
import :: psb_c_base_sparse_mat, psb_base_sparse_mat, psb_spk_
class(psb_c_base_sparse_mat), intent(in) :: a
class(psb_base_sparse_mat), intent(out) :: b
end subroutine psb_c_base_transc_2mat
end interface
interface
subroutine psb_c_base_transp_1mat(a)
import :: psb_c_base_sparse_mat, psb_spk_
class(psb_c_base_sparse_mat), intent(inout) :: a
end subroutine psb_c_base_transp_1mat
end interface
interface
subroutine psb_c_base_transc_1mat(a)
import :: psb_c_base_sparse_mat, psb_spk_
class(psb_c_base_sparse_mat), intent(inout) :: a
end subroutine psb_c_base_transc_1mat
end interface
! == ===============
!
@ -586,6 +722,7 @@ module psb_c_base_mat_mod
integer, intent(out) :: info
end subroutine psb_c_coo_mold
end interface
interface
subroutine psb_c_coo_print(iout,a,iv,eirs,eics,head,ivr,ivc)
@ -802,6 +939,7 @@ module psb_c_base_mat_mod
end subroutine psb_c_coo_csmm
end interface
interface
function psb_c_coo_maxval(a) result(res)
import :: psb_c_coo_sparse_mat, psb_spk_
@ -830,7 +968,7 @@ module psb_c_base_mat_mod
subroutine psb_c_coo_rowsum(d,a)
import :: psb_c_coo_sparse_mat, psb_spk_
class(psb_c_coo_sparse_mat), intent(in) :: a
complex(psb_spk_), intent(out) :: d(:)
complex(psb_spk_), intent(out) :: d(:)
end subroutine psb_c_coo_rowsum
end interface
@ -838,7 +976,7 @@ module psb_c_base_mat_mod
subroutine psb_c_coo_arwsum(d,a)
import :: psb_c_coo_sparse_mat, psb_spk_
class(psb_c_coo_sparse_mat), intent(in) :: a
real(psb_spk_), intent(out) :: d(:)
real(psb_spk_), intent(out) :: d(:)
end subroutine psb_c_coo_arwsum
end interface
@ -846,7 +984,7 @@ module psb_c_base_mat_mod
subroutine psb_c_coo_colsum(d,a)
import :: psb_c_coo_sparse_mat, psb_spk_
class(psb_c_coo_sparse_mat), intent(in) :: a
complex(psb_spk_), intent(out) :: d(:)
complex(psb_spk_), intent(out) :: d(:)
end subroutine psb_c_coo_colsum
end interface
@ -854,7 +992,7 @@ module psb_c_base_mat_mod
subroutine psb_c_coo_aclsum(d,a)
import :: psb_c_coo_sparse_mat, psb_spk_
class(psb_c_coo_sparse_mat), intent(in) :: a
real(psb_spk_), intent(out) :: d(:)
real(psb_spk_), intent(out) :: d(:)
end subroutine psb_c_coo_aclsum
end interface
@ -938,7 +1076,7 @@ contains
class(psb_c_coo_sparse_mat), intent(in) :: a
integer(psb_long_int_k_) :: res
res = 8 + 1
res = res + 2 * psb_sizeof_sp * size(a%val)
res = res + (2*psb_sizeof_sp) * size(a%val)
res = res + psb_sizeof_int * size(a%ia)
res = res + psb_sizeof_int * size(a%ja)
@ -1018,8 +1156,6 @@ contains
!
! == ==================================
subroutine c_coo_free(a)
implicit none
@ -1071,13 +1207,15 @@ contains
end subroutine c_coo_transp_1mat
subroutine c_coo_transc_1mat(a)
implicit none
class(psb_c_coo_sparse_mat), intent(inout) :: a
call a%transp()
a%val(:) = conjg(a%val)
! This will morph into conjg() for C and Z
! and into a no-op for S and D, so a conditional
! on a constant ought to take it out completely.
if (psb_c_is_complex_) a%val(:) = conjg(a%val(:))
end subroutine c_coo_transc_1mat

1
base/modules/psb_c_base_vect_mod.f90
Unescape Escape View File

@ -738,6 +738,7 @@ contains
!
! Scatter:
! Y(IDX(:)) = beta*Y(IDX(:)) + X(:)
!
subroutine c_base_sctb(n,idx,x,beta,y)
use psi_serial_mod

3
base/modules/psb_c_csc_mat_mod.f90
Unescape Escape View File

@ -37,6 +37,9 @@
! a sparse matrix as well as the related methods (those who are
! specific to the type and could not be defined higher in the
! hierarchy). We are at the bottom level of the inheritance chain.
!
! Please refere to psb_c_base_mat_mod for a detailed description
! of the various methods, and to psb_c_csc_impl for implementation details.
!
module psb_c_csc_mat_mod

5
base/modules/psb_c_csr_mat_mod.f90
Unescape Escape View File

@ -37,7 +37,10 @@
! a sparse matrix as well as the related methods (those who are
! specific to the type and could not be defined higher in the
! hierarchy). We are at the bottom level of the inheritance chain.
!
!
! Please refere to psb_c_base_mat_mod for a detailed description
! of the various methods, and to psb_c_csr_impl for implementation details.
!
module psb_c_csr_mat_mod
use psb_c_base_mat_mod

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

@ -39,7 +39,8 @@
! indirection. This type encapsulates the psb_c_base_sparse_mat class
! inside another class which is the one visible to the user. All the
! methods of the psb_c_mat_mod simply call the methods of the
! encapsulated class.
! encapsulated class, except for cscnv and cp_from/cp_to.
!
module psb_c_mat_mod
@ -98,20 +99,20 @@ module psb_c_mat_mod
procedure, pass(a) :: c_csclip => psb_c_csclip
procedure, pass(a) :: c_b_csclip => psb_c_b_csclip
generic, public :: csclip => c_b_csclip, c_csclip
procedure, pass(a) :: c_clip_d_ip => psb_c_clip_d_ip
procedure, pass(a) :: c_clip_d => psb_c_clip_d
generic, public :: clip_diag => c_clip_d_ip, c_clip_d
procedure, pass(a) :: reall => psb_c_reallocate_nz
procedure, pass(a) :: get_neigh => psb_c_get_neigh
procedure, pass(a) :: c_cscnv => psb_c_cscnv
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_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
generic, public :: print => print_i, print_n
procedure, pass(a) :: mold => psb_c_mold
procedure, pass(a) :: c_transp_1mat => psb_c_transp_1mat
procedure, pass(a) :: c_transp_2mat => psb_c_transp_2mat
generic, public :: transp => c_transp_1mat, c_transp_2mat
procedure, pass(a) :: c_transc_1mat => psb_c_transc_1mat
procedure, pass(a) :: c_transc_2mat => psb_c_transc_2mat
generic, public :: transc => c_transc_1mat, c_transc_2mat
! These are specific to this level of encapsulation.
procedure, pass(a) :: c_mv_from => psb_c_mv_from
generic, public :: mv_from => c_mv_from
procedure, pass(a) :: c_mv_to => psb_c_mv_to
@ -120,13 +121,14 @@ module psb_c_mat_mod
generic, public :: cp_from => c_cp_from
procedure, pass(a) :: c_cp_to => psb_c_cp_to
generic, public :: cp_to => c_cp_to
procedure, pass(a) :: mold => psb_c_mold
procedure, pass(a) :: c_transp_1mat => psb_c_transp_1mat
procedure, pass(a) :: c_transp_2mat => psb_c_transp_2mat
generic, public :: transp => c_transp_1mat, c_transp_2mat
procedure, pass(a) :: c_transc_1mat => psb_c_transc_1mat
procedure, pass(a) :: c_transc_2mat => psb_c_transc_2mat
generic, public :: transc => c_transc_1mat, c_transc_2mat
procedure, pass(a) :: c_clip_d_ip => psb_c_clip_d_ip
procedure, pass(a) :: c_clip_d => psb_c_clip_d
generic, public :: clip_diag => c_clip_d_ip, c_clip_d
procedure, pass(a) :: c_cscnv => psb_c_cscnv
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_clone
! Computational routines
procedure, pass(a) :: get_diag => psb_c_get_diag
@ -418,6 +420,67 @@ module psb_c_mat_mod
end subroutine psb_c_b_csclip
end interface
interface
subroutine psb_c_mold(a,b)
import :: psb_cspmat_type, psb_c_base_sparse_mat
class(psb_cspmat_type), intent(inout) :: a
class(psb_c_base_sparse_mat), allocatable, intent(out) :: b
end subroutine psb_c_mold
end interface
interface
subroutine psb_c_transp_1mat(a)
import :: psb_cspmat_type
class(psb_cspmat_type), intent(inout) :: a
end subroutine psb_c_transp_1mat
end interface
interface
subroutine psb_c_transp_2mat(a,b)
import :: psb_cspmat_type
class(psb_cspmat_type), intent(in) :: a
class(psb_cspmat_type), intent(out) :: b
end subroutine psb_c_transp_2mat
end interface
interface
subroutine psb_c_transc_1mat(a)
import :: psb_cspmat_type
class(psb_cspmat_type), intent(inout) :: a
end subroutine psb_c_transc_1mat
end interface
interface
subroutine psb_c_transc_2mat(a,b)
import :: psb_cspmat_type
class(psb_cspmat_type), intent(in) :: a
class(psb_cspmat_type), intent(out) :: b
end subroutine psb_c_transc_2mat
end interface
interface
subroutine psb_c_reinit(a,clear)
import :: psb_cspmat_type
class(psb_cspmat_type), intent(inout) :: a
logical, intent(in), optional :: clear
end subroutine psb_c_reinit
end interface
!
! These methods are specific to the outer SPMAT_TYPE level, since
! they tamper with the inner BASE_SPARSE_MAT object.
!
!
!
! CSCNV: switches to a different internal derived type.
! 3 versions: copying to target
! copying to a base_sparse_mat object.
! in place
!
!
interface
subroutine psb_c_cscnv(a,b,info,type,mold,upd,dupl)
import :: psb_cspmat_type, psb_spk_, psb_c_base_sparse_mat
@ -453,6 +516,10 @@ module psb_c_mat_mod
end subroutine psb_c_cscnv_base
end interface
!
! Produce a version of the matrix with diagonal cut
! out; passes through a COO buffer.
!
interface
subroutine psb_c_clip_d(a,b,info)
import :: psb_cspmat_type
@ -470,6 +537,10 @@ module psb_c_mat_mod
end subroutine psb_c_clip_d_ip
end interface
!
! These four interfaces cut through the
! encapsulation between spmat_type and base_sparse_mat.
!
interface
subroutine psb_c_mv_from(a,b)
import :: psb_cspmat_type, psb_spk_, psb_c_base_sparse_mat
@ -502,6 +573,9 @@ module psb_c_mat_mod
end subroutine psb_c_cp_to
end interface
!
! Transfer the internal allocation to the target.
!
interface psb_move_alloc
subroutine psb_cspmat_type_move(a,b,info)
import :: psb_cspmat_type
@ -511,7 +585,7 @@ module psb_c_mat_mod
end subroutine psb_cspmat_type_move
end interface
interface psb_clone
interface
subroutine psb_cspmat_clone(a,b,info)
import :: psb_cspmat_type
class(psb_cspmat_type), intent(in) :: a
@ -520,53 +594,7 @@ module psb_c_mat_mod
end subroutine psb_cspmat_clone
end interface
interface
subroutine psb_c_mold(a,b)
import :: psb_cspmat_type, psb_c_base_sparse_mat
class(psb_cspmat_type), intent(inout) :: a
class(psb_c_base_sparse_mat), allocatable, intent(out) :: b
end subroutine psb_c_mold
end interface
interface
subroutine psb_c_transp_1mat(a)
import :: psb_cspmat_type
class(psb_cspmat_type), intent(inout) :: a
end subroutine psb_c_transp_1mat
end interface
interface
subroutine psb_c_transp_2mat(a,b)
import :: psb_cspmat_type
class(psb_cspmat_type), intent(in) :: a
class(psb_cspmat_type), intent(out) :: b
end subroutine psb_c_transp_2mat
end interface
interface
subroutine psb_c_transc_1mat(a)
import :: psb_cspmat_type
class(psb_cspmat_type), intent(inout) :: a
end subroutine psb_c_transc_1mat
end interface
interface
subroutine psb_c_transc_2mat(a,b)
import :: psb_cspmat_type
class(psb_cspmat_type), intent(in) :: a
class(psb_cspmat_type), intent(out) :: b
end subroutine psb_c_transc_2mat
end interface
interface
subroutine psb_c_reinit(a,clear)
import :: psb_cspmat_type
class(psb_cspmat_type), intent(inout) :: a
logical, intent(in), optional :: clear
end subroutine psb_c_reinit
end interface
! == ===================================

52
base/modules/psb_c_vect_mod.f90
Unescape Escape View File

@ -1,3 +1,42 @@
!!$
!!$ Parallel Sparse BLAS version 3.0
!!$ (C) Copyright 2006, 2007, 2008, 2009, 2010
!!$ Salvatore Filippone University of Rome Tor Vergata
!!$ Alfredo Buttari CNRS-IRIT, Toulouse
!!$
!!$ Redistribution and use in source and binary forms, with or without
!!$ modification, are permitted provided that the following conditions
!!$ are met:
!!$ 1. Redistributions of source code must retain the above copyright
!!$ notice, this list of conditions and the following disclaimer.
!!$ 2. Redistributions in binary form must reproduce the above copyright
!!$ notice, this list of conditions, and the following disclaimer in the
!!$ documentation and/or other materials provided with the distribution.
!!$ 3. The name of the PSBLAS group or the names of its contributors may
!!$ not be used to endorse or promote products derived from this
!!$ software without specific written permission.
!!$
!!$ THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS
!!$ ``AS IS'' AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED
!!$ TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR
!!$ PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE PSBLAS GROUP OR ITS CONTRIBUTORS
!!$ BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR
!!$ CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF
!!$ SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS
!!$ INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN
!!$ CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE)
!!$ ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE
!!$ POSSIBILITY OF SUCH DAMAGE.
!!$
!!$
!
! package: psb_c_vect_mod
!
! This module contains the definition of the psb_c_vect type which
! is the outer container for dense vectors.
! Therefore all methods simply invoke the corresponding methods of the
! inner component.
!
module psb_c_vect_mod
use psb_c_base_vect_mod
@ -255,11 +294,11 @@ contains
subroutine c_vect_mlt_a_2(alpha,x,y,beta,z,info)
use psi_serial_mod
implicit none
complex(psb_spk_), intent(in) :: alpha,beta
complex(psb_spk_), intent(in) :: y(:)
complex(psb_spk_), intent(in) :: x(:)
class(psb_c_vect_type), intent(inout) :: z
integer, intent(out) :: info
complex(psb_spk_), intent(in) :: alpha,beta
complex(psb_spk_), intent(in) :: y(:)
complex(psb_spk_), intent(in) :: x(:)
class(psb_c_vect_type), intent(inout) :: z
integer, intent(out) :: info
integer :: i, n
info = 0
@ -271,12 +310,13 @@ contains
subroutine c_vect_mlt_v_2(alpha,x,y,beta,z,info,conjgx,conjgy)
use psi_serial_mod
implicit none
complex(psb_spk_), intent(in) :: alpha,beta
complex(psb_spk_), intent(in) :: alpha,beta
class(psb_c_vect_type), intent(inout) :: x
class(psb_c_vect_type), intent(inout) :: y
class(psb_c_vect_type), intent(inout) :: z
integer, intent(out) :: info
character(len=1), intent(in), optional :: conjgx, conjgy
integer :: i, n
info = 0

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

@ -32,9 +32,9 @@
!
! package: psb_d_base_mat_mod
!
! This module contains the implementation of the psb_d_base_sparse_mat
! This module contains the definition of the psb_d_base_sparse_mat
! type, derived from the psb_base_sparse_mat one to define a middle
! level definition of a real, double-precision sparse matrix
! level definition of a real(psb_dpk_) sparse matrix
! object.This class object itself does not have any additional members
! with respect to those of the base class. No methods can be fully
! implemented at this level, but we can define the interface for the
@ -46,15 +46,13 @@
! psb_d_coo_sparse_mat type and the related methods. This is the
! reference type for all the format transitions, copies and mv unless
! methods are implemented that allow the direct transition from one
! format to another. The psb_d_coo_sparse_mat type extends the
! psb_d_base_sparse_mat one.
! format to another. The psb_d_coo_sparse_mat type extends
! psb_d_base_sparse_mat.
!
! About the method MOLD: this has been defined for those compilers
! not yet supporting ALLOCATE( ...MOLD=...); it's otherwise silly to
! not yet supporting ALLOCATE( ...,MOLD=...); it's otherwise silly to
! duplicate "by hand" what is specified in the language (in this case F2008)
!
module psb_d_base_mat_mod
use psb_base_mat_mod
@ -62,6 +60,40 @@ module psb_d_base_mat_mod
type, extends(psb_base_sparse_mat) :: psb_d_base_sparse_mat
contains
!
! Data management methods: defined here, but not implemented.
!
procedure, pass(a) :: csput => psb_d_base_csput
procedure, pass(a) :: d_csgetrow => psb_d_base_csgetrow
procedure, pass(a) :: d_csgetblk => psb_d_base_csgetblk
procedure, pass(a) :: get_diag => psb_d_base_get_diag
generic, public :: csget => d_csgetrow, d_csgetblk
procedure, pass(a) :: csclip => psb_d_base_csclip
procedure, pass(a) :: mold => psb_d_base_mold
procedure, pass(a) :: cp_to_coo => psb_d_base_cp_to_coo
procedure, pass(a) :: cp_from_coo => psb_d_base_cp_from_coo
procedure, pass(a) :: cp_to_fmt => psb_d_base_cp_to_fmt
procedure, pass(a) :: cp_from_fmt => psb_d_base_cp_from_fmt
procedure, pass(a) :: mv_to_coo => psb_d_base_mv_to_coo
procedure, pass(a) :: mv_from_coo => psb_d_base_mv_from_coo
procedure, pass(a) :: mv_to_fmt => psb_d_base_mv_to_fmt
procedure, pass(a) :: mv_from_fmt => psb_d_base_mv_from_fmt
procedure, pass(a) :: d_base_cp_from
generic, public :: cp_from => d_base_cp_from
procedure, pass(a) :: d_base_mv_from
generic, public :: mv_from => d_base_mv_from
!
! Transpose methods: defined here but not implemented.
!
procedure, pass(a) :: transp_1mat => psb_d_base_transp_1mat
procedure, pass(a) :: transp_2mat => psb_d_base_transp_2mat
procedure, pass(a) :: transc_1mat => psb_d_base_transc_1mat
procedure, pass(a) :: transc_2mat => psb_d_base_transc_2mat
!
! Computational methods: defined here but not implemented.
!
procedure, pass(a) :: d_sp_mv => psb_d_base_vect_mv
procedure, pass(a) :: d_csmv => psb_d_base_csmv
procedure, pass(a) :: d_csmm => psb_d_base_csmm
@ -84,32 +116,6 @@ module psb_d_base_mat_mod
procedure, pass(a) :: arwsum => psb_d_base_arwsum
procedure, pass(a) :: colsum => psb_d_base_colsum
procedure, pass(a) :: aclsum => psb_d_base_aclsum
procedure, pass(a) :: get_diag => psb_d_base_get_diag
procedure, pass(a) :: csput => psb_d_base_csput
procedure, pass(a) :: d_csgetrow => psb_d_base_csgetrow
procedure, pass(a) :: d_csgetblk => psb_d_base_csgetblk
generic, public :: csget => d_csgetrow, d_csgetblk
procedure, pass(a) :: csclip => psb_d_base_csclip
procedure, pass(a) :: mold => psb_d_base_mold
procedure, pass(a) :: cp_to_coo => psb_d_base_cp_to_coo
procedure, pass(a) :: cp_from_coo => psb_d_base_cp_from_coo
procedure, pass(a) :: cp_to_fmt => psb_d_base_cp_to_fmt
procedure, pass(a) :: cp_from_fmt => psb_d_base_cp_from_fmt
procedure, pass(a) :: mv_to_coo => psb_d_base_mv_to_coo
procedure, pass(a) :: mv_from_coo => psb_d_base_mv_from_coo
procedure, pass(a) :: mv_to_fmt => psb_d_base_mv_to_fmt
procedure, pass(a) :: mv_from_fmt => psb_d_base_mv_from_fmt
procedure, pass(a) :: d_base_cp_from
generic, public :: cp_from => d_base_cp_from
procedure, pass(a) :: d_base_mv_from
generic, public :: mv_from => d_base_mv_from
procedure, pass(a) :: transp_1mat => psb_d_base_transp_1mat
procedure, pass(a) :: transp_2mat => psb_d_base_transp_2mat
procedure, pass(a) :: transc_1mat => psb_d_base_transc_1mat
procedure, pass(a) :: transc_2mat => psb_d_base_transc_2mat
end type psb_d_base_sparse_mat
private :: d_base_cp_from, d_base_mv_from
@ -122,18 +128,13 @@ module psb_d_base_mat_mod
real(psb_dpk_), allocatable :: val(:)
contains
!
! Data management methods.
!
procedure, pass(a) :: get_size => d_coo_get_size
procedure, pass(a) :: get_nzeros => d_coo_get_nzeros
procedure, pass(a) :: set_nzeros => d_coo_set_nzeros
procedure, nopass :: get_fmt => d_coo_get_fmt
procedure, pass(a) :: sizeof => d_coo_sizeof
procedure, pass(a) :: d_csmm => psb_d_coo_csmm
procedure, pass(a) :: d_csmv => psb_d_coo_csmv
procedure, pass(a) :: d_inner_cssm => psb_d_coo_cssm
procedure, pass(a) :: d_inner_cssv => psb_d_coo_cssv
procedure, pass(a) :: d_scals => psb_d_coo_scals
procedure, pass(a) :: d_scal => psb_d_coo_scal
procedure, pass(a) :: reallocate_nz => psb_d_coo_reallocate_nz
procedure, pass(a) :: allocate_mnnz => psb_d_coo_allocate_mnnz
procedure, pass(a) :: cp_to_coo => psb_d_cp_coo_to_coo
@ -145,18 +146,11 @@ module psb_d_base_mat_mod
procedure, pass(a) :: mv_to_fmt => psb_d_mv_coo_to_fmt
procedure, pass(a) :: mv_from_fmt => psb_d_mv_coo_from_fmt
procedure, pass(a) :: csput => psb_d_coo_csput
procedure, pass(a) :: maxval => psb_d_coo_maxval
procedure, pass(a) :: csnmi => psb_d_coo_csnmi
procedure, pass(a) :: csnm1 => psb_d_coo_csnm1
procedure, pass(a) :: rowsum => psb_d_coo_rowsum
procedure, pass(a) :: arwsum => psb_d_coo_arwsum
procedure, pass(a) :: colsum => psb_d_coo_colsum
procedure, pass(a) :: aclsum => psb_d_coo_aclsum
procedure, pass(a) :: get_diag => psb_d_coo_get_diag
procedure, pass(a) :: d_csgetrow => psb_d_coo_csgetrow
procedure, pass(a) :: csgetptn => psb_d_coo_csgetptn
procedure, pass(a) :: get_nz_row => psb_d_coo_get_nz_row
procedure, pass(a) :: reinit => psb_d_coo_reinit
procedure, pass(a) :: get_nz_row => psb_d_coo_get_nz_row
procedure, pass(a) :: fix => psb_d_fix_coo
procedure, pass(a) :: trim => psb_d_coo_trim
procedure, pass(a) :: print => psb_d_coo_print
@ -166,8 +160,35 @@ module psb_d_base_mat_mod
generic, public :: cp_from => psb_d_coo_cp_from
procedure, pass(a) :: psb_d_coo_mv_from
generic, public :: mv_from => psb_d_coo_mv_from
!
! This is COO specific
!
procedure, pass(a) :: set_nzeros => d_coo_set_nzeros
!
! Transpose methods. These are the base of all
! indirection in transpose, together with conversions
! they are sufficient for all cases.
!
procedure, pass(a) :: transp_1mat => d_coo_transp_1mat
procedure, pass(a) :: transc_1mat => d_coo_transc_1mat
!
! Computational methods.
!
procedure, pass(a) :: d_csmm => psb_d_coo_csmm
procedure, pass(a) :: d_csmv => psb_d_coo_csmv
procedure, pass(a) :: d_inner_cssm => psb_d_coo_cssm
procedure, pass(a) :: d_inner_cssv => psb_d_coo_cssv
procedure, pass(a) :: d_scals => psb_d_coo_scals
procedure, pass(a) :: d_scal => psb_d_coo_scal
procedure, pass(a) :: maxval => psb_d_coo_maxval
procedure, pass(a) :: csnmi => psb_d_coo_csnmi
procedure, pass(a) :: csnm1 => psb_d_coo_csnm1
procedure, pass(a) :: rowsum => psb_d_coo_rowsum
procedure, pass(a) :: arwsum => psb_d_coo_arwsum
procedure, pass(a) :: colsum => psb_d_coo_colsum
procedure, pass(a) :: aclsum => psb_d_coo_aclsum
end type psb_d_coo_sparse_mat
@ -182,8 +203,274 @@ module psb_d_base_mat_mod
! BASE interfaces
!
! == =================
!
! CSPUT: Hand over a set of values to A.
! Simple description:
! A(IA(1:nz),JA(1:nz)) = VAL(1:NZ)
!
! Catches:
! 1. If A is in the BUILD state, then this method
! can only be called for COO matrice, in which case it
! is more like queueing coefficients for later processing.
! 2. If A is in the UPDATE state, then every derived class must
! implement this;
! 3. In the UPDATE state, depending on the value of DUPL flag
! inside A, it will be A=VAL or A = A + VAL
!
!
interface
subroutine psb_d_base_csput(nz,ia,ja,val,a,imin,imax,jmin,jmax,info,gtl)
import :: psb_d_base_sparse_mat, psb_dpk_
class(psb_d_base_sparse_mat), intent(inout) :: a
real(psb_dpk_), intent(in) :: val(:)
integer, intent(in) :: nz, ia(:), ja(:), imin,imax,jmin,jmax
integer, intent(out) :: info
integer, intent(in), optional :: gtl(:)
end subroutine psb_d_base_csput
end interface
!
! CSGET methods: getrow, getblk, clip.
! getrow is the basic method, the other two are
! basically convenient wrappers/shorthand.
!
! out(:) = A(imin:imax,:)
!
! The two methods differ on the output format
!
! GETROW returns as the set
! NZ, IA(1:nz), JA(1:nz), VAL(1:NZ)
!
! Optional arguments:
! JMIN,JMAX: get A(IMIN:IMAX,JMIN:JMAX),
! default 1:ncols
! APPEND: append at the end of data, in which case
! # used entries must be in NZ
! RSCALE, CSCALE: scale output indices at base 1.
!
! GETROW must be overridden by all data formats.
!
interface
subroutine psb_d_base_csgetrow(imin,imax,a,nz,ia,ja,val,info,&
& jmin,jmax,iren,append,nzin,rscale,cscale)
import :: psb_d_base_sparse_mat, psb_dpk_
class(psb_d_base_sparse_mat), intent(in) :: a
integer, intent(in) :: imin,imax
integer, intent(out) :: nz
integer, allocatable, intent(inout) :: ia(:), ja(:)
real(psb_dpk_), allocatable, intent(inout) :: val(:)
integer,intent(out) :: info
logical, intent(in), optional :: append
integer, intent(in), optional :: iren(:)
integer, intent(in), optional :: jmin,jmax, nzin
logical, intent(in), optional :: rscale,cscale
end subroutine psb_d_base_csgetrow
end interface
!
! CSGET methods: getrow, getblk.
! out(:) = A(imin:imax,:)
!
! GETBLK returns a pbs_d_coo_sparse_mat with
! the same contents.
! Default implementation at base level
! in terms of (derived) GETROW
!
interface
subroutine psb_d_base_csgetblk(imin,imax,a,b,info,&
& jmin,jmax,iren,append,rscale,cscale)
import :: psb_d_base_sparse_mat, psb_d_coo_sparse_mat, psb_dpk_
class(psb_d_base_sparse_mat), intent(in) :: a
class(psb_d_coo_sparse_mat), intent(inout) :: b
integer, intent(in) :: imin,imax
integer,intent(out) :: info
logical, intent(in), optional :: append
integer, intent(in), optional :: iren(:)
integer, intent(in), optional :: jmin,jmax
logical, intent(in), optional :: rscale,cscale
end subroutine psb_d_base_csgetblk
end interface
!
! CLIP: extract a subset
! B(:,:) = A(imin:imax,jmin:jmax)
! control: rscale,cscale as in getblk above.
!
! Default implementation at base level in terms of
! GETBLK.
!
interface
subroutine psb_d_base_csclip(a,b,info,&
& imin,imax,jmin,jmax,rscale,cscale)
import :: psb_d_base_sparse_mat, psb_d_coo_sparse_mat, psb_dpk_
class(psb_d_base_sparse_mat), intent(in) :: a
class(psb_d_coo_sparse_mat), intent(out) :: b
integer,intent(out) :: info
integer, intent(in), optional :: imin,imax,jmin,jmax
logical, intent(in), optional :: rscale,cscale
end subroutine psb_d_base_csclip
end interface
!
! GET_DIAG method
!
! D(i) = A(i:i), i=1:min(nrows,ncols)
!
interface
subroutine psb_d_base_get_diag(a,d,info)
import :: psb_d_base_sparse_mat, psb_dpk_
class(psb_d_base_sparse_mat), intent(in) :: a
real(psb_dpk_), intent(out) :: d(:)
integer, intent(out) :: info
end subroutine psb_d_base_get_diag
end interface
!
! MOLD: make B have the same dinamyc type
! as A.
! For compilers not supporting
! allocate( mold= )
!
interface
subroutine psb_d_base_mold(a,b,info)
import :: psb_d_base_sparse_mat, psb_long_int_k_
class(psb_d_base_sparse_mat), intent(in) :: a
class(psb_d_base_sparse_mat), intent(out), allocatable :: b
integer, intent(out) :: info
end subroutine psb_d_base_mold
end interface
!
! These are the methods implementing the MEDIATOR pattern
! to allow switch between arbitrary.
! Indeed, the TO/FROM FMT can be implemented at the base level
! in terms of the TO/FROM COO per the MEDIATOR design pattern.
! This does not prevent most of the derived classes to
! provide their own versions with shortcuts.
! A%{MV|CP}_{TO|FROM}_{FMT|COO}
! MV|CP: copy versus move, i.e. deallocate
! TO|FROM: invoked from source or target object
!
!
interface
subroutine psb_d_base_cp_to_coo(a,b,info)
import :: psb_d_base_sparse_mat, psb_d_coo_sparse_mat, psb_dpk_
class(psb_d_base_sparse_mat), intent(in) :: a
class(psb_d_coo_sparse_mat), intent(inout) :: b
integer, intent(out) :: info
end subroutine psb_d_base_cp_to_coo
end interface
interface
subroutine psb_d_base_cp_from_coo(a,b,info)
import :: psb_d_base_sparse_mat, psb_d_coo_sparse_mat, psb_dpk_
class(psb_d_base_sparse_mat), intent(inout) :: a
class(psb_d_coo_sparse_mat), intent(in) :: b
integer, intent(out) :: info
end subroutine psb_d_base_cp_from_coo
end interface
interface
subroutine psb_d_base_cp_to_fmt(a,b,info)
import :: psb_d_base_sparse_mat, psb_dpk_
class(psb_d_base_sparse_mat), intent(in) :: a
class(psb_d_base_sparse_mat), intent(inout) :: b
integer, intent(out) :: info
end subroutine psb_d_base_cp_to_fmt
end interface
interface
subroutine psb_d_base_cp_from_fmt(a,b,info)
import :: psb_d_base_sparse_mat, psb_dpk_
class(psb_d_base_sparse_mat), intent(inout) :: a
class(psb_d_base_sparse_mat), intent(in) :: b
integer, intent(out) :: info
end subroutine psb_d_base_cp_from_fmt
end interface
interface
subroutine psb_d_base_mv_to_coo(a,b,info)
import :: psb_d_base_sparse_mat, psb_d_coo_sparse_mat, psb_dpk_
class(psb_d_base_sparse_mat), intent(inout) :: a
class(psb_d_coo_sparse_mat), intent(inout) :: b
integer, intent(out) :: info
end subroutine psb_d_base_mv_to_coo
end interface
interface
subroutine psb_d_base_mv_from_coo(a,b,info)
import :: psb_d_base_sparse_mat, psb_d_coo_sparse_mat, psb_dpk_
class(psb_d_base_sparse_mat), intent(inout) :: a
class(psb_d_coo_sparse_mat), intent(inout) :: b
integer, intent(out) :: info
end subroutine psb_d_base_mv_from_coo
end interface
interface
subroutine psb_d_base_mv_to_fmt(a,b,info)
import :: psb_d_base_sparse_mat, psb_dpk_
class(psb_d_base_sparse_mat), intent(inout) :: a
class(psb_d_base_sparse_mat), intent(inout) :: b
integer, intent(out) :: info
end subroutine psb_d_base_mv_to_fmt
end interface
interface
subroutine psb_d_base_mv_from_fmt(a,b,info)
import :: psb_d_base_sparse_mat, psb_dpk_
class(psb_d_base_sparse_mat), intent(inout) :: a
class(psb_d_base_sparse_mat), intent(inout) :: b
integer, intent(out) :: info
end subroutine psb_d_base_mv_from_fmt
end interface
!
! Transpose methods.
! You can always default to COO to do the actual
! transpose work.
!
interface
subroutine psb_d_base_transp_2mat(a,b)
import :: psb_d_base_sparse_mat, psb_base_sparse_mat, psb_dpk_
class(psb_d_base_sparse_mat), intent(in) :: a
class(psb_base_sparse_mat), intent(out) :: b
end subroutine psb_d_base_transp_2mat
end interface
interface
subroutine psb_d_base_transc_2mat(a,b)
import :: psb_d_base_sparse_mat, psb_base_sparse_mat, psb_dpk_
class(psb_d_base_sparse_mat), intent(in) :: a
class(psb_base_sparse_mat), intent(out) :: b
end subroutine psb_d_base_transc_2mat
end interface
interface
subroutine psb_d_base_transp_1mat(a)
import :: psb_d_base_sparse_mat, psb_dpk_
class(psb_d_base_sparse_mat), intent(inout) :: a
end subroutine psb_d_base_transp_1mat
end interface
interface
subroutine psb_d_base_transc_1mat(a)
import :: psb_d_base_sparse_mat, psb_dpk_
class(psb_d_base_sparse_mat), intent(inout) :: a
end subroutine psb_d_base_transc_1mat
end interface
!
! Matrix-vector products.
! Y = alpha*A*X + beta*Y
!
! vect_mv relies on csmv for those data types
! not specifically using the encapsulation to handle
! foreign data.
!
!
interface
subroutine psb_d_base_csmm(alpha,a,x,beta,y,info,trans)
import :: psb_d_base_sparse_mat, psb_dpk_
@ -218,6 +505,12 @@ module psb_d_base_mat_mod
end subroutine psb_d_base_vect_mv
end interface
!
! Triangular system solve.
! The CSSM/CSSV/VECT_SV outer methods are implemented at the base
! level, and they take care of the SCALE and D control arguments.
! So the derived classes need to override only the INNER_ methods.
!
interface
subroutine psb_d_base_inner_cssm(alpha,a,x,beta,y,info,trans)
import :: psb_d_base_sparse_mat, psb_dpk_
@ -287,6 +580,10 @@ module psb_d_base_mat_mod
end subroutine psb_d_base_vect_cssv
end interface
!
! Scale a matrix by a scalar or by a vector.
! Should we handle scale on the columns??
!
interface
subroutine psb_d_base_scals(d,a,info)
import :: psb_d_base_sparse_mat, psb_dpk_
@ -305,6 +602,9 @@ module psb_d_base_mat_mod
end subroutine psb_d_base_scal
end interface
!
! Maximum coefficient absolute value norm
!
interface
function psb_d_base_maxval(a) result(res)
import :: psb_d_base_sparse_mat, psb_dpk_
@ -313,6 +613,9 @@ module psb_d_base_mat_mod
end function psb_d_base_maxval
end interface
!
! Operator infinity norm
!
interface
function psb_d_base_csnmi(a) result(res)
import :: psb_d_base_sparse_mat, psb_dpk_
@ -321,6 +624,9 @@ module psb_d_base_mat_mod
end function psb_d_base_csnmi
end interface
!
! Operator 1-norm
!
interface
function psb_d_base_csnm1(a) result(res)
import :: psb_d_base_sparse_mat, psb_dpk_
@ -329,6 +635,10 @@ module psb_d_base_mat_mod
end function psb_d_base_csnm1
end interface
!
! Compute sums along the rows, either
! natural or absolute value
!
interface
subroutine psb_d_base_rowsum(d,a)
import :: psb_d_base_sparse_mat, psb_dpk_
@ -345,6 +655,10 @@ module psb_d_base_mat_mod
end subroutine psb_d_base_arwsum
end interface
!
! Compute sums along the columns, either
! natural or absolute value
!
interface
subroutine psb_d_base_colsum(d,a)
import :: psb_d_base_sparse_mat, psb_dpk_
@ -360,186 +674,7 @@ module psb_d_base_mat_mod
real(psb_dpk_), intent(out) :: d(:)
end subroutine psb_d_base_aclsum
end interface
interface
subroutine psb_d_base_get_diag(a,d,info)
import :: psb_d_base_sparse_mat, psb_dpk_
class(psb_d_base_sparse_mat), intent(in) :: a
real(psb_dpk_), intent(out) :: d(:)
integer, intent(out) :: info
end subroutine psb_d_base_get_diag
end interface
interface
subroutine psb_d_base_csput(nz,ia,ja,val,a,imin,imax,jmin,jmax,info,gtl)
import :: psb_d_base_sparse_mat, psb_dpk_
class(psb_d_base_sparse_mat), intent(inout) :: a
real(psb_dpk_), intent(in) :: val(:)
integer, intent(in) :: nz, ia(:), ja(:), imin,imax,jmin,jmax
integer, intent(out) :: info
integer, intent(in), optional :: gtl(:)
end subroutine psb_d_base_csput
end interface
interface
subroutine psb_d_base_csgetrow(imin,imax,a,nz,ia,ja,val,info,&
& jmin,jmax,iren,append,nzin,rscale,cscale)
import :: psb_d_base_sparse_mat, psb_dpk_
class(psb_d_base_sparse_mat), intent(in) :: a
integer, intent(in) :: imin,imax
integer, intent(out) :: nz
integer, allocatable, intent(inout) :: ia(:), ja(:)
real(psb_dpk_), allocatable, intent(inout) :: val(:)
integer,intent(out) :: info
logical, intent(in), optional :: append
integer, intent(in), optional :: iren(:)
integer, intent(in), optional :: jmin,jmax, nzin
logical, intent(in), optional :: rscale,cscale
end subroutine psb_d_base_csgetrow
end interface
interface
subroutine psb_d_base_csgetblk(imin,imax,a,b,info,&
& jmin,jmax,iren,append,rscale,cscale)
import :: psb_d_base_sparse_mat, psb_d_coo_sparse_mat, psb_dpk_
class(psb_d_base_sparse_mat), intent(in) :: a
class(psb_d_coo_sparse_mat), intent(inout) :: b
integer, intent(in) :: imin,imax
integer,intent(out) :: info
logical, intent(in), optional :: append
integer, intent(in), optional :: iren(:)
integer, intent(in), optional :: jmin,jmax
logical, intent(in), optional :: rscale,cscale
end subroutine psb_d_base_csgetblk
end interface
interface
subroutine psb_d_base_csclip(a,b,info,&
& imin,imax,jmin,jmax,rscale,cscale)
import :: psb_d_base_sparse_mat, psb_d_coo_sparse_mat, psb_dpk_
class(psb_d_base_sparse_mat), intent(in) :: a
class(psb_d_coo_sparse_mat), intent(out) :: b
integer,intent(out) :: info
integer, intent(in), optional :: imin,imax,jmin,jmax
logical, intent(in), optional :: rscale,cscale
end subroutine psb_d_base_csclip
end interface
interface
subroutine psb_d_base_mold(a,b,info)
import :: psb_d_base_sparse_mat, psb_long_int_k_
class(psb_d_base_sparse_mat), intent(in) :: a
class(psb_d_base_sparse_mat), intent(out), allocatable :: b
integer, intent(out) :: info
end subroutine psb_d_base_mold
end interface
interface
subroutine psb_d_base_cp_to_coo(a,b,info)
import :: psb_d_base_sparse_mat, psb_d_coo_sparse_mat, psb_dpk_
class(psb_d_base_sparse_mat), intent(in) :: a
class(psb_d_coo_sparse_mat), intent(inout) :: b
integer, intent(out) :: info
end subroutine psb_d_base_cp_to_coo
end interface
interface
subroutine psb_d_base_cp_from_coo(a,b,info)
import :: psb_d_base_sparse_mat, psb_d_coo_sparse_mat, psb_dpk_
class(psb_d_base_sparse_mat), intent(inout) :: a
class(psb_d_coo_sparse_mat), intent(in) :: b
integer, intent(out) :: info
end subroutine psb_d_base_cp_from_coo
end interface
interface
subroutine psb_d_base_cp_to_fmt(a,b,info)
import :: psb_d_base_sparse_mat, psb_dpk_
class(psb_d_base_sparse_mat), intent(in) :: a
class(psb_d_base_sparse_mat), intent(inout) :: b
integer, intent(out) :: info
end subroutine psb_d_base_cp_to_fmt
end interface
interface
subroutine psb_d_base_cp_from_fmt(a,b,info)
import :: psb_d_base_sparse_mat, psb_dpk_
class(psb_d_base_sparse_mat), intent(inout) :: a
class(psb_d_base_sparse_mat), intent(in) :: b
integer, intent(out) :: info
end subroutine psb_d_base_cp_from_fmt
end interface
interface
subroutine psb_d_base_mv_to_coo(a,b,info)
import :: psb_d_base_sparse_mat, psb_d_coo_sparse_mat, psb_dpk_
class(psb_d_base_sparse_mat), intent(inout) :: a
class(psb_d_coo_sparse_mat), intent(inout) :: b
integer, intent(out) :: info
end subroutine psb_d_base_mv_to_coo
end interface
interface
subroutine psb_d_base_mv_from_coo(a,b,info)
import :: psb_d_base_sparse_mat, psb_d_coo_sparse_mat, psb_dpk_
class(psb_d_base_sparse_mat), intent(inout) :: a
class(psb_d_coo_sparse_mat), intent(inout) :: b
integer, intent(out) :: info
end subroutine psb_d_base_mv_from_coo
end interface
interface
subroutine psb_d_base_mv_to_fmt(a,b,info)
import :: psb_d_base_sparse_mat, psb_dpk_
class(psb_d_base_sparse_mat), intent(inout) :: a
class(psb_d_base_sparse_mat), intent(inout) :: b
integer, intent(out) :: info
end subroutine psb_d_base_mv_to_fmt
end interface
interface
subroutine psb_d_base_mv_from_fmt(a,b,info)
import :: psb_d_base_sparse_mat, psb_dpk_
class(psb_d_base_sparse_mat), intent(inout) :: a
class(psb_d_base_sparse_mat), intent(inout) :: b
integer, intent(out) :: info
end subroutine psb_d_base_mv_from_fmt
end interface
interface
subroutine psb_d_base_transp_2mat(a,b)
import :: psb_d_base_sparse_mat, psb_base_sparse_mat, psb_dpk_
class(psb_d_base_sparse_mat), intent(in) :: a
class(psb_base_sparse_mat), intent(out) :: b
end subroutine psb_d_base_transp_2mat
end interface
interface
subroutine psb_d_base_transc_2mat(a,b)
import :: psb_d_base_sparse_mat, psb_base_sparse_mat, psb_dpk_
class(psb_d_base_sparse_mat), intent(in) :: a
class(psb_base_sparse_mat), intent(out) :: b
end subroutine psb_d_base_transc_2mat
end interface
interface
subroutine psb_d_base_transp_1mat(a)
import :: psb_d_base_sparse_mat, psb_dpk_
class(psb_d_base_sparse_mat), intent(inout) :: a
end subroutine psb_d_base_transp_1mat
end interface
interface
subroutine psb_d_base_transc_1mat(a)
import :: psb_d_base_sparse_mat, psb_dpk_
class(psb_d_base_sparse_mat), intent(inout) :: a
end subroutine psb_d_base_transc_1mat
end interface
! == ===============
!
@ -1077,6 +1212,11 @@ contains
class(psb_d_coo_sparse_mat), intent(inout) :: a
call a%transp()
! This will morph into conjg() for C and Z
! and into a no-op for S and D, so a conditional
! on a constant ought to take it out completely.
if (psb_d_is_complex_) a%val(:) = (a%val(:))
end subroutine d_coo_transc_1mat

1
base/modules/psb_d_base_vect_mod.f90
Unescape Escape View File

@ -738,6 +738,7 @@ contains
!
! Scatter:
! Y(IDX(:)) = beta*Y(IDX(:)) + X(:)
!
subroutine d_base_sctb(n,idx,x,beta,y)
use psi_serial_mod

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

@ -37,6 +37,9 @@
! a sparse matrix as well as the related methods (those who are
! specific to the type and could not be defined higher in the
! hierarchy). We are at the bottom level of the inheritance chain.
!
! Please refere to psb_d_base_mat_mod for a detailed description
! of the various methods, and to psb_d_csc_impl for implementation details.
!
module psb_d_csc_mat_mod

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

@ -37,7 +37,10 @@
! a sparse matrix as well as the related methods (those who are
! specific to the type and could not be defined higher in the
! hierarchy). We are at the bottom level of the inheritance chain.
!
!
! Please refere to psb_d_base_mat_mod for a detailed description
! of the various methods, and to psb_d_csr_impl for implementation details.
!
module psb_d_csr_mat_mod
use psb_d_base_mat_mod

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

@ -39,7 +39,8 @@
! indirection. This type encapsulates the psb_d_base_sparse_mat class
! inside another class which is the one visible to the user. All the
! methods of the psb_d_mat_mod simply call the methods of the
! encapsulated class.
! encapsulated class, except for cscnv and cp_from/cp_to.
!
module psb_d_mat_mod
@ -98,20 +99,20 @@ module psb_d_mat_mod
procedure, pass(a) :: d_csclip => psb_d_csclip
procedure, pass(a) :: d_b_csclip => psb_d_b_csclip
generic, public :: csclip => d_b_csclip, d_csclip
procedure, pass(a) :: d_clip_d_ip => psb_d_clip_d_ip
procedure, pass(a) :: d_clip_d => psb_d_clip_d
generic, public :: clip_diag => d_clip_d_ip, d_clip_d
procedure, pass(a) :: reall => psb_d_reallocate_nz
procedure, pass(a) :: get_neigh => psb_d_get_neigh
procedure, pass(a) :: d_cscnv => psb_d_cscnv
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_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
generic, public :: print => print_i, print_n
procedure, pass(a) :: mold => psb_d_mold
procedure, pass(a) :: d_transp_1mat => psb_d_transp_1mat
procedure, pass(a) :: d_transp_2mat => psb_d_transp_2mat
generic, public :: transp => d_transp_1mat, d_transp_2mat
procedure, pass(a) :: d_transc_1mat => psb_d_transc_1mat
procedure, pass(a) :: d_transc_2mat => psb_d_transc_2mat
generic, public :: transc => d_transc_1mat, d_transc_2mat
! These are specific to this level of encapsulation.
procedure, pass(a) :: d_mv_from => psb_d_mv_from
generic, public :: mv_from => d_mv_from
procedure, pass(a) :: d_mv_to => psb_d_mv_to
@ -120,13 +121,14 @@ module psb_d_mat_mod
generic, public :: cp_from => d_cp_from
procedure, pass(a) :: d_cp_to => psb_d_cp_to
generic, public :: cp_to => d_cp_to
procedure, pass(a) :: mold => psb_d_mold
procedure, pass(a) :: d_transp_1mat => psb_d_transp_1mat
procedure, pass(a) :: d_transp_2mat => psb_d_transp_2mat
generic, public :: transp => d_transp_1mat, d_transp_2mat
procedure, pass(a) :: d_transc_1mat => psb_d_transc_1mat
procedure, pass(a) :: d_transc_2mat => psb_d_transc_2mat
generic, public :: transc => d_transc_1mat, d_transc_2mat
procedure, pass(a) :: d_clip_d_ip => psb_d_clip_d_ip
procedure, pass(a) :: d_clip_d => psb_d_clip_d
generic, public :: clip_diag => d_clip_d_ip, d_clip_d
procedure, pass(a) :: d_cscnv => psb_d_cscnv
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_clone
! Computational routines
procedure, pass(a) :: get_diag => psb_d_get_diag
@ -418,6 +420,67 @@ module psb_d_mat_mod
end subroutine psb_d_b_csclip
end interface
interface
subroutine psb_d_mold(a,b)
import :: psb_dspmat_type, psb_d_base_sparse_mat
class(psb_dspmat_type), intent(inout) :: a
class(psb_d_base_sparse_mat), allocatable, intent(out) :: b
end subroutine psb_d_mold
end interface
interface
subroutine psb_d_transp_1mat(a)
import :: psb_dspmat_type
class(psb_dspmat_type), intent(inout) :: a
end subroutine psb_d_transp_1mat
end interface
interface
subroutine psb_d_transp_2mat(a,b)
import :: psb_dspmat_type
class(psb_dspmat_type), intent(in) :: a
class(psb_dspmat_type), intent(out) :: b
end subroutine psb_d_transp_2mat
end interface
interface
subroutine psb_d_transc_1mat(a)
import :: psb_dspmat_type
class(psb_dspmat_type), intent(inout) :: a
end subroutine psb_d_transc_1mat
end interface
interface
subroutine psb_d_transc_2mat(a,b)
import :: psb_dspmat_type
class(psb_dspmat_type), intent(in) :: a
class(psb_dspmat_type), intent(out) :: b
end subroutine psb_d_transc_2mat
end interface
interface
subroutine psb_d_reinit(a,clear)
import :: psb_dspmat_type
class(psb_dspmat_type), intent(inout) :: a
logical, intent(in), optional :: clear
end subroutine psb_d_reinit
end interface
!
! These methods are specific to the outer SPMAT_TYPE level, since
! they tamper with the inner BASE_SPARSE_MAT object.
!
!
!
! CSCNV: switches to a different internal derived type.
! 3 versions: copying to target
! copying to a base_sparse_mat object.
! in place
!
!
interface
subroutine psb_d_cscnv(a,b,info,type,mold,upd,dupl)
import :: psb_dspmat_type, psb_dpk_, psb_d_base_sparse_mat
@ -453,6 +516,10 @@ module psb_d_mat_mod
end subroutine psb_d_cscnv_base
end interface
!
! Produce a version of the matrix with diagonal cut
! out; passes through a COO buffer.
!
interface
subroutine psb_d_clip_d(a,b,info)
import :: psb_dspmat_type
@ -470,6 +537,10 @@ module psb_d_mat_mod
end subroutine psb_d_clip_d_ip
end interface
!
! These four interfaces cut through the
! encapsulation between spmat_type and base_sparse_mat.
!
interface
subroutine psb_d_mv_from(a,b)
import :: psb_dspmat_type, psb_dpk_, psb_d_base_sparse_mat
@ -502,6 +573,9 @@ module psb_d_mat_mod
end subroutine psb_d_cp_to
end interface
!
! Transfer the internal allocation to the target.
!
interface psb_move_alloc
subroutine psb_dspmat_type_move(a,b,info)
import :: psb_dspmat_type
@ -511,7 +585,7 @@ module psb_d_mat_mod
end subroutine psb_dspmat_type_move
end interface
interface psb_clone
interface
subroutine psb_dspmat_clone(a,b,info)
import :: psb_dspmat_type
class(psb_dspmat_type), intent(in) :: a
@ -520,53 +594,7 @@ module psb_d_mat_mod
end subroutine psb_dspmat_clone
end interface
interface
subroutine psb_d_mold(a,b)
import :: psb_dspmat_type, psb_d_base_sparse_mat
class(psb_dspmat_type), intent(inout) :: a
class(psb_d_base_sparse_mat), allocatable, intent(out) :: b
end subroutine psb_d_mold
end interface
interface
subroutine psb_d_transp_1mat(a)
import :: psb_dspmat_type
class(psb_dspmat_type), intent(inout) :: a
end subroutine psb_d_transp_1mat
end interface
interface
subroutine psb_d_transp_2mat(a,b)
import :: psb_dspmat_type
class(psb_dspmat_type), intent(in) :: a
class(psb_dspmat_type), intent(out) :: b
end subroutine psb_d_transp_2mat
end interface
interface
subroutine psb_d_transc_1mat(a)
import :: psb_dspmat_type
class(psb_dspmat_type), intent(inout) :: a
end subroutine psb_d_transc_1mat
end interface
interface
subroutine psb_d_transc_2mat(a,b)
import :: psb_dspmat_type
class(psb_dspmat_type), intent(in) :: a
class(psb_dspmat_type), intent(out) :: b
end subroutine psb_d_transc_2mat
end interface
interface
subroutine psb_d_reinit(a,clear)
import :: psb_dspmat_type
class(psb_dspmat_type), intent(inout) :: a
logical, intent(in), optional :: clear
end subroutine psb_d_reinit
end interface
! == ===================================

71
base/modules/psb_d_vect_mod.f90
Unescape Escape View File

@ -1,3 +1,42 @@
!!$
!!$ Parallel Sparse BLAS version 3.0
!!$ (C) Copyright 2006, 2007, 2008, 2009, 2010
!!$ Salvatore Filippone University of Rome Tor Vergata
!!$ Alfredo Buttari CNRS-IRIT, Toulouse
!!$
!!$ Redistribution and use in source and binary forms, with or without
!!$ modification, are permitted provided that the following conditions
!!$ are met:
!!$ 1. Redistributions of source code must retain the above copyright
!!$ notice, this list of conditions and the following disclaimer.
!!$ 2. Redistributions in binary form must reproduce the above copyright
!!$ notice, this list of conditions, and the following disclaimer in the
!!$ documentation and/or other materials provided with the distribution.
!!$ 3. The name of the PSBLAS group or the names of its contributors may
!!$ not be used to endorse or promote products derived from this
!!$ software without specific written permission.
!!$
!!$ THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS
!!$ ``AS IS'' AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED
!!$ TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR
!!$ PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE PSBLAS GROUP OR ITS CONTRIBUTORS
!!$ BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR
!!$ CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF
!!$ SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS
!!$ INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN
!!$ CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE)
!!$ ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE
!!$ POSSIBILITY OF SUCH DAMAGE.
!!$
!!$
!
! package: psb_d_vect_mod
!
! This module contains the definition of the psb_d_vect type which
! is the outer container for dense vectors.
! Therefore all methods simply invoke the corresponding methods of the
! inner component.
!
module psb_d_vect_mod
use psb_d_base_vect_mod
@ -90,7 +129,7 @@ contains
function d_vect_getCopy(x) result(res)
class(psb_d_vect_type), intent(in) :: x
real(psb_dpk_), allocatable :: res(:)
real(psb_dpk_), allocatable :: res(:)
integer :: info
if (allocated(x%v)) res = x%v%getCopy()
@ -117,7 +156,7 @@ contains
subroutine d_vect_set_vect(x,val)
class(psb_d_vect_type), intent(inout) :: x
real(psb_dpk_), intent(in) :: val(:)
real(psb_dpk_), intent(in) :: val(:)
integer :: info
if (allocated(x%v)) call x%v%set(val)
@ -170,7 +209,6 @@ contains
class(psb_d_vect_type), intent(inout) :: x, y
integer, intent(in) :: n
real(psb_dpk_) :: res
real(psb_dpk_), external :: ddot
res = dzero
if (allocated(x%v).and.allocated(y%v)) &
@ -184,7 +222,6 @@ contains
real(psb_dpk_), intent(in) :: y(:)
integer, intent(in) :: n
real(psb_dpk_) :: res
real(psb_dpk_), external :: ddot
res = dzero
if (allocated(x%v)) &
@ -257,11 +294,11 @@ contains
subroutine d_vect_mlt_a_2(alpha,x,y,beta,z,info)
use psi_serial_mod
implicit none
real(psb_dpk_), intent(in) :: alpha,beta
real(psb_dpk_), intent(in) :: y(:)
real(psb_dpk_), intent(in) :: x(:)
class(psb_d_vect_type), intent(inout) :: z
integer, intent(out) :: info
real(psb_dpk_), intent(in) :: alpha,beta
real(psb_dpk_), intent(in) :: y(:)
real(psb_dpk_), intent(in) :: x(:)
class(psb_d_vect_type), intent(inout) :: z
integer, intent(out) :: info
integer :: i, n
info = 0
@ -270,20 +307,22 @@ contains
end subroutine d_vect_mlt_a_2
subroutine d_vect_mlt_v_2(alpha,x,y,beta,z,info)
subroutine d_vect_mlt_v_2(alpha,x,y,beta,z,info,conjgx,conjgy)
use psi_serial_mod
implicit none
real(psb_dpk_), intent(in) :: alpha,beta
real(psb_dpk_), intent(in) :: alpha,beta
class(psb_d_vect_type), intent(inout) :: x
class(psb_d_vect_type), intent(inout) :: y
class(psb_d_vect_type), intent(inout) :: z
integer, intent(out) :: info
integer, intent(out) :: info
character(len=1), intent(in), optional :: conjgx, conjgy
integer :: i, n
info = 0
if (allocated(x%v).and.allocated(y%v).and.&
& allocated(z%v)) &
& call z%v%mlt(alpha,x%v,y%v,beta,info)
& call z%v%mlt(alpha,x%v,y%v,beta,info,conjgx,conjgy)
end subroutine d_vect_mlt_v_2
@ -496,10 +535,10 @@ contains
subroutine d_vect_cnv(x,mold)
class(psb_d_vect_type), intent(inout) :: x
class(psb_d_base_vect_type), intent(in) :: mold
class(psb_d_vect_type), intent(inout) :: x
class(psb_d_base_vect_type), intent(in) :: mold
class(psb_d_base_vect_type), allocatable :: tmp
real(psb_dpk_), allocatable :: invect(:)
real(psb_dpk_), allocatable :: invect(:)
integer :: info
allocate(tmp,stat=info,mold=mold)

587
base/modules/psb_s_base_mat_mod.f90
Unescape Escape View File

@ -32,7 +32,7 @@
!
! package: psb_s_base_mat_mod
!
! This module contains the implementation of the psb_s_base_sparse_mat
! This module contains the definition of the psb_s_base_sparse_mat
! type, derived from the psb_base_sparse_mat one to define a middle
! level definition of a real(psb_spk_) sparse matrix
! object.This class object itself does not have any additional members
@ -46,8 +46,8 @@
! psb_s_coo_sparse_mat type and the related methods. This is the
! reference type for all the format transitions, copies and mv unless
! methods are implemented that allow the direct transition from one
! format to another. The psb_s_coo_sparse_mat type extends the
! psb_s_base_sparse_mat one.
! format to another. The psb_s_coo_sparse_mat type extends
! psb_s_base_sparse_mat.
!
! About the method MOLD: this has been defined for those compilers
! not yet supporting ALLOCATE( ...,MOLD=...); it's otherwise silly to
@ -60,6 +60,40 @@ module psb_s_base_mat_mod
type, extends(psb_base_sparse_mat) :: psb_s_base_sparse_mat
contains
!
! Data management methods: defined here, but not implemented.
!
procedure, pass(a) :: csput => psb_s_base_csput
procedure, pass(a) :: s_csgetrow => psb_s_base_csgetrow
procedure, pass(a) :: s_csgetblk => psb_s_base_csgetblk
procedure, pass(a) :: get_diag => psb_s_base_get_diag
generic, public :: csget => s_csgetrow, s_csgetblk
procedure, pass(a) :: csclip => psb_s_base_csclip
procedure, pass(a) :: mold => psb_s_base_mold
procedure, pass(a) :: cp_to_coo => psb_s_base_cp_to_coo
procedure, pass(a) :: cp_from_coo => psb_s_base_cp_from_coo
procedure, pass(a) :: cp_to_fmt => psb_s_base_cp_to_fmt
procedure, pass(a) :: cp_from_fmt => psb_s_base_cp_from_fmt
procedure, pass(a) :: mv_to_coo => psb_s_base_mv_to_coo
procedure, pass(a) :: mv_from_coo => psb_s_base_mv_from_coo
procedure, pass(a) :: mv_to_fmt => psb_s_base_mv_to_fmt
procedure, pass(a) :: mv_from_fmt => psb_s_base_mv_from_fmt
procedure, pass(a) :: s_base_cp_from
generic, public :: cp_from => s_base_cp_from
procedure, pass(a) :: s_base_mv_from
generic, public :: mv_from => s_base_mv_from
!
! Transpose methods: defined here but not implemented.
!
procedure, pass(a) :: transp_1mat => psb_s_base_transp_1mat
procedure, pass(a) :: transp_2mat => psb_s_base_transp_2mat
procedure, pass(a) :: transc_1mat => psb_s_base_transc_1mat
procedure, pass(a) :: transc_2mat => psb_s_base_transc_2mat
!
! Computational methods: defined here but not implemented.
!
procedure, pass(a) :: s_sp_mv => psb_s_base_vect_mv
procedure, pass(a) :: s_csmv => psb_s_base_csmv
procedure, pass(a) :: s_csmm => psb_s_base_csmm
@ -82,32 +116,6 @@ module psb_s_base_mat_mod
procedure, pass(a) :: arwsum => psb_s_base_arwsum
procedure, pass(a) :: colsum => psb_s_base_colsum
procedure, pass(a) :: aclsum => psb_s_base_aclsum
procedure, pass(a) :: get_diag => psb_s_base_get_diag
procedure, pass(a) :: csput => psb_s_base_csput
procedure, pass(a) :: s_csgetrow => psb_s_base_csgetrow
procedure, pass(a) :: s_csgetblk => psb_s_base_csgetblk
generic, public :: csget => s_csgetrow, s_csgetblk
procedure, pass(a) :: csclip => psb_s_base_csclip
procedure, pass(a) :: mold => psb_s_base_mold
procedure, pass(a) :: cp_to_coo => psb_s_base_cp_to_coo
procedure, pass(a) :: cp_from_coo => psb_s_base_cp_from_coo
procedure, pass(a) :: cp_to_fmt => psb_s_base_cp_to_fmt
procedure, pass(a) :: cp_from_fmt => psb_s_base_cp_from_fmt
procedure, pass(a) :: mv_to_coo => psb_s_base_mv_to_coo
procedure, pass(a) :: mv_from_coo => psb_s_base_mv_from_coo
procedure, pass(a) :: mv_to_fmt => psb_s_base_mv_to_fmt
procedure, pass(a) :: mv_from_fmt => psb_s_base_mv_from_fmt
procedure, pass(a) :: s_base_cp_from
generic, public :: cp_from => s_base_cp_from
procedure, pass(a) :: s_base_mv_from
generic, public :: mv_from => s_base_mv_from
procedure, pass(a) :: transp_1mat => psb_s_base_transp_1mat
procedure, pass(a) :: transp_2mat => psb_s_base_transp_2mat
procedure, pass(a) :: transc_1mat => psb_s_base_transc_1mat
procedure, pass(a) :: transc_2mat => psb_s_base_transc_2mat
end type psb_s_base_sparse_mat
private :: s_base_cp_from, s_base_mv_from
@ -120,18 +128,13 @@ module psb_s_base_mat_mod
real(psb_spk_), allocatable :: val(:)
contains
!
! Data management methods.
!
procedure, pass(a) :: get_size => s_coo_get_size
procedure, pass(a) :: get_nzeros => s_coo_get_nzeros
procedure, pass(a) :: set_nzeros => s_coo_set_nzeros
procedure, nopass :: get_fmt => s_coo_get_fmt
procedure, pass(a) :: sizeof => s_coo_sizeof
procedure, pass(a) :: s_csmm => psb_s_coo_csmm
procedure, pass(a) :: s_csmv => psb_s_coo_csmv
procedure, pass(a) :: s_inner_cssm => psb_s_coo_cssm
procedure, pass(a) :: s_inner_cssv => psb_s_coo_cssv
procedure, pass(a) :: s_scals => psb_s_coo_scals
procedure, pass(a) :: s_scal => psb_s_coo_scal
procedure, pass(a) :: reallocate_nz => psb_s_coo_reallocate_nz
procedure, pass(a) :: allocate_mnnz => psb_s_coo_allocate_mnnz
procedure, pass(a) :: cp_to_coo => psb_s_cp_coo_to_coo
@ -143,18 +146,11 @@ module psb_s_base_mat_mod
procedure, pass(a) :: mv_to_fmt => psb_s_mv_coo_to_fmt
procedure, pass(a) :: mv_from_fmt => psb_s_mv_coo_from_fmt
procedure, pass(a) :: csput => psb_s_coo_csput
procedure, pass(a) :: maxval => psb_s_coo_maxval
procedure, pass(a) :: csnmi => psb_s_coo_csnmi
procedure, pass(a) :: csnm1 => psb_s_coo_csnm1
procedure, pass(a) :: rowsum => psb_s_coo_rowsum
procedure, pass(a) :: arwsum => psb_s_coo_arwsum
procedure, pass(a) :: colsum => psb_s_coo_colsum
procedure, pass(a) :: aclsum => psb_s_coo_aclsum
procedure, pass(a) :: get_diag => psb_s_coo_get_diag
procedure, pass(a) :: s_csgetrow => psb_s_coo_csgetrow
procedure, pass(a) :: csgetptn => psb_s_coo_csgetptn
procedure, pass(a) :: get_nz_row => psb_s_coo_get_nz_row
procedure, pass(a) :: reinit => psb_s_coo_reinit
procedure, pass(a) :: get_nz_row => psb_s_coo_get_nz_row
procedure, pass(a) :: fix => psb_s_fix_coo
procedure, pass(a) :: trim => psb_s_coo_trim
procedure, pass(a) :: print => psb_s_coo_print
@ -164,8 +160,35 @@ module psb_s_base_mat_mod
generic, public :: cp_from => psb_s_coo_cp_from
procedure, pass(a) :: psb_s_coo_mv_from
generic, public :: mv_from => psb_s_coo_mv_from
!
! This is COO specific
!
procedure, pass(a) :: set_nzeros => s_coo_set_nzeros
!
! Transpose methods. These are the base of all
! indirection in transpose, together with conversions
! they are sufficient for all cases.
!
procedure, pass(a) :: transp_1mat => s_coo_transp_1mat
procedure, pass(a) :: transc_1mat => s_coo_transc_1mat
!
! Computational methods.
!
procedure, pass(a) :: s_csmm => psb_s_coo_csmm
procedure, pass(a) :: s_csmv => psb_s_coo_csmv
procedure, pass(a) :: s_inner_cssm => psb_s_coo_cssm
procedure, pass(a) :: s_inner_cssv => psb_s_coo_cssv
procedure, pass(a) :: s_scals => psb_s_coo_scals
procedure, pass(a) :: s_scal => psb_s_coo_scal
procedure, pass(a) :: maxval => psb_s_coo_maxval
procedure, pass(a) :: csnmi => psb_s_coo_csnmi
procedure, pass(a) :: csnm1 => psb_s_coo_csnm1
procedure, pass(a) :: rowsum => psb_s_coo_rowsum
procedure, pass(a) :: arwsum => psb_s_coo_arwsum
procedure, pass(a) :: colsum => psb_s_coo_colsum
procedure, pass(a) :: aclsum => psb_s_coo_aclsum
end type psb_s_coo_sparse_mat
@ -180,8 +203,274 @@ module psb_s_base_mat_mod
! BASE interfaces
!
! == =================
!
! CSPUT: Hand over a set of values to A.
! Simple description:
! A(IA(1:nz),JA(1:nz)) = VAL(1:NZ)
!
! Catches:
! 1. If A is in the BUILD state, then this method
! can only be called for COO matrice, in which case it
! is more like queueing coefficients for later processing.
! 2. If A is in the UPDATE state, then every derived class must
! implement this;
! 3. In the UPDATE state, depending on the value of DUPL flag
! inside A, it will be A=VAL or A = A + VAL
!
!
interface
subroutine psb_s_base_csput(nz,ia,ja,val,a,imin,imax,jmin,jmax,info,gtl)
import :: psb_s_base_sparse_mat, psb_spk_
class(psb_s_base_sparse_mat), intent(inout) :: a
real(psb_spk_), intent(in) :: val(:)
integer, intent(in) :: nz, ia(:), ja(:), imin,imax,jmin,jmax
integer, intent(out) :: info
integer, intent(in), optional :: gtl(:)
end subroutine psb_s_base_csput
end interface
!
! CSGET methods: getrow, getblk, clip.
! getrow is the basic method, the other two are
! basically convenient wrappers/shorthand.
!
! out(:) = A(imin:imax,:)
!
! The two methods differ on the output format
!
! GETROW returns as the set
! NZ, IA(1:nz), JA(1:nz), VAL(1:NZ)
!
! Optional arguments:
! JMIN,JMAX: get A(IMIN:IMAX,JMIN:JMAX),
! default 1:ncols
! APPEND: append at the end of data, in which case
! # used entries must be in NZ
! RSCALE, CSCALE: scale output indices at base 1.
!
! GETROW must be overridden by all data formats.
!
interface
subroutine psb_s_base_csgetrow(imin,imax,a,nz,ia,ja,val,info,&
& jmin,jmax,iren,append,nzin,rscale,cscale)
import :: psb_s_base_sparse_mat, psb_spk_
class(psb_s_base_sparse_mat), 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(:)
integer,intent(out) :: info
logical, intent(in), optional :: append
integer, intent(in), optional :: iren(:)
integer, intent(in), optional :: jmin,jmax, nzin
logical, intent(in), optional :: rscale,cscale
end subroutine psb_s_base_csgetrow
end interface
!
! CSGET methods: getrow, getblk.
! out(:) = A(imin:imax,:)
!
! GETBLK returns a pbs_s_coo_sparse_mat with
! the same contents.
! Default implementation at base level
! in terms of (derived) GETROW
!
interface
subroutine psb_s_base_csgetblk(imin,imax,a,b,info,&
& jmin,jmax,iren,append,rscale,cscale)
import :: psb_s_base_sparse_mat, psb_s_coo_sparse_mat, psb_spk_
class(psb_s_base_sparse_mat), intent(in) :: a
class(psb_s_coo_sparse_mat), intent(inout) :: b
integer, intent(in) :: imin,imax
integer,intent(out) :: info
logical, intent(in), optional :: append
integer, intent(in), optional :: iren(:)
integer, intent(in), optional :: jmin,jmax
logical, intent(in), optional :: rscale,cscale
end subroutine psb_s_base_csgetblk
end interface
!
! CLIP: extract a subset
! B(:,:) = A(imin:imax,jmin:jmax)
! control: rscale,cscale as in getblk above.
!
! Default implementation at base level in terms of
! GETBLK.
!
interface
subroutine psb_s_base_csclip(a,b,info,&
& imin,imax,jmin,jmax,rscale,cscale)
import :: psb_s_base_sparse_mat, psb_s_coo_sparse_mat, psb_spk_
class(psb_s_base_sparse_mat), intent(in) :: a
class(psb_s_coo_sparse_mat), intent(out) :: b
integer,intent(out) :: info
integer, intent(in), optional :: imin,imax,jmin,jmax
logical, intent(in), optional :: rscale,cscale
end subroutine psb_s_base_csclip
end interface
!
! GET_DIAG method
!
! D(i) = A(i:i), i=1:min(nrows,ncols)
!
interface
subroutine psb_s_base_get_diag(a,d,info)
import :: psb_s_base_sparse_mat, psb_spk_
class(psb_s_base_sparse_mat), intent(in) :: a
real(psb_spk_), intent(out) :: d(:)
integer, intent(out) :: info
end subroutine psb_s_base_get_diag
end interface
!
! MOLD: make B have the same dinamyc type
! as A.
! For compilers not supporting
! allocate( mold= )
!
interface
subroutine psb_s_base_mold(a,b,info)
import :: psb_s_base_sparse_mat, psb_long_int_k_
class(psb_s_base_sparse_mat), intent(in) :: a
class(psb_s_base_sparse_mat), intent(out), allocatable :: b
integer, intent(out) :: info
end subroutine psb_s_base_mold
end interface
!
! These are the methods implementing the MEDIATOR pattern
! to allow switch between arbitrary.
! Indeed, the TO/FROM FMT can be implemented at the base level
! in terms of the TO/FROM COO per the MEDIATOR design pattern.
! This does not prevent most of the derived classes to
! provide their own versions with shortcuts.
! A%{MV|CP}_{TO|FROM}_{FMT|COO}
! MV|CP: copy versus move, i.e. deallocate
! TO|FROM: invoked from source or target object
!
!
interface
subroutine psb_s_base_cp_to_coo(a,b,info)
import :: psb_s_base_sparse_mat, psb_s_coo_sparse_mat, psb_spk_
class(psb_s_base_sparse_mat), intent(in) :: a
class(psb_s_coo_sparse_mat), intent(inout) :: b
integer, intent(out) :: info
end subroutine psb_s_base_cp_to_coo
end interface
interface
subroutine psb_s_base_cp_from_coo(a,b,info)
import :: psb_s_base_sparse_mat, psb_s_coo_sparse_mat, psb_spk_
class(psb_s_base_sparse_mat), intent(inout) :: a
class(psb_s_coo_sparse_mat), intent(in) :: b
integer, intent(out) :: info
end subroutine psb_s_base_cp_from_coo
end interface
interface
subroutine psb_s_base_cp_to_fmt(a,b,info)
import :: psb_s_base_sparse_mat, psb_spk_
class(psb_s_base_sparse_mat), intent(in) :: a
class(psb_s_base_sparse_mat), intent(inout) :: b
integer, intent(out) :: info
end subroutine psb_s_base_cp_to_fmt
end interface
interface
subroutine psb_s_base_cp_from_fmt(a,b,info)
import :: psb_s_base_sparse_mat, psb_spk_
class(psb_s_base_sparse_mat), intent(inout) :: a
class(psb_s_base_sparse_mat), intent(in) :: b
integer, intent(out) :: info
end subroutine psb_s_base_cp_from_fmt
end interface
interface
subroutine psb_s_base_mv_to_coo(a,b,info)
import :: psb_s_base_sparse_mat, psb_s_coo_sparse_mat, psb_spk_
class(psb_s_base_sparse_mat), intent(inout) :: a
class(psb_s_coo_sparse_mat), intent(inout) :: b
integer, intent(out) :: info
end subroutine psb_s_base_mv_to_coo
end interface
interface
subroutine psb_s_base_mv_from_coo(a,b,info)
import :: psb_s_base_sparse_mat, psb_s_coo_sparse_mat, psb_spk_
class(psb_s_base_sparse_mat), intent(inout) :: a
class(psb_s_coo_sparse_mat), intent(inout) :: b
integer, intent(out) :: info
end subroutine psb_s_base_mv_from_coo
end interface
interface
subroutine psb_s_base_mv_to_fmt(a,b,info)
import :: psb_s_base_sparse_mat, psb_spk_
class(psb_s_base_sparse_mat), intent(inout) :: a
class(psb_s_base_sparse_mat), intent(inout) :: b
integer, intent(out) :: info
end subroutine psb_s_base_mv_to_fmt
end interface
interface
subroutine psb_s_base_mv_from_fmt(a,b,info)
import :: psb_s_base_sparse_mat, psb_spk_
class(psb_s_base_sparse_mat), intent(inout) :: a
class(psb_s_base_sparse_mat), intent(inout) :: b
integer, intent(out) :: info
end subroutine psb_s_base_mv_from_fmt
end interface
!
! Transpose methods.
! You can always default to COO to do the actual
! transpose work.
!
interface
subroutine psb_s_base_transp_2mat(a,b)
import :: psb_s_base_sparse_mat, psb_base_sparse_mat, psb_spk_
class(psb_s_base_sparse_mat), intent(in) :: a
class(psb_base_sparse_mat), intent(out) :: b
end subroutine psb_s_base_transp_2mat
end interface
interface
subroutine psb_s_base_transc_2mat(a,b)
import :: psb_s_base_sparse_mat, psb_base_sparse_mat, psb_spk_
class(psb_s_base_sparse_mat), intent(in) :: a
class(psb_base_sparse_mat), intent(out) :: b
end subroutine psb_s_base_transc_2mat
end interface
interface
subroutine psb_s_base_transp_1mat(a)
import :: psb_s_base_sparse_mat, psb_spk_
class(psb_s_base_sparse_mat), intent(inout) :: a
end subroutine psb_s_base_transp_1mat
end interface
interface
subroutine psb_s_base_transc_1mat(a)
import :: psb_s_base_sparse_mat, psb_spk_
class(psb_s_base_sparse_mat), intent(inout) :: a
end subroutine psb_s_base_transc_1mat
end interface
!
! Matrix-vector products.
! Y = alpha*A*X + beta*Y
!
! vect_mv relies on csmv for those data types
! not specifically using the encapsulation to handle
! foreign data.
!
!
interface
subroutine psb_s_base_csmm(alpha,a,x,beta,y,info,trans)
import :: psb_s_base_sparse_mat, psb_spk_
@ -216,6 +505,12 @@ module psb_s_base_mat_mod
end subroutine psb_s_base_vect_mv
end interface
!
! Triangular system solve.
! The CSSM/CSSV/VECT_SV outer methods are implemented at the base
! level, and they take care of the SCALE and D control arguments.
! So the derived classes need to override only the INNER_ methods.
!
interface
subroutine psb_s_base_inner_cssm(alpha,a,x,beta,y,info,trans)
import :: psb_s_base_sparse_mat, psb_spk_
@ -285,6 +580,10 @@ module psb_s_base_mat_mod
end subroutine psb_s_base_vect_cssv
end interface
!
! Scale a matrix by a scalar or by a vector.
! Should we handle scale on the columns??
!
interface
subroutine psb_s_base_scals(d,a,info)
import :: psb_s_base_sparse_mat, psb_spk_
@ -303,6 +602,9 @@ module psb_s_base_mat_mod
end subroutine psb_s_base_scal
end interface
!
! Maximum coefficient absolute value norm
!
interface
function psb_s_base_maxval(a) result(res)
import :: psb_s_base_sparse_mat, psb_spk_
@ -311,6 +613,9 @@ module psb_s_base_mat_mod
end function psb_s_base_maxval
end interface
!
! Operator infinity norm
!
interface
function psb_s_base_csnmi(a) result(res)
import :: psb_s_base_sparse_mat, psb_spk_
@ -319,6 +624,9 @@ module psb_s_base_mat_mod
end function psb_s_base_csnmi
end interface
!
! Operator 1-norm
!
interface
function psb_s_base_csnm1(a) result(res)
import :: psb_s_base_sparse_mat, psb_spk_
@ -327,6 +635,10 @@ module psb_s_base_mat_mod
end function psb_s_base_csnm1
end interface
!
! Compute sums along the rows, either
! natural or absolute value
!
interface
subroutine psb_s_base_rowsum(d,a)
import :: psb_s_base_sparse_mat, psb_spk_
@ -343,6 +655,10 @@ module psb_s_base_mat_mod
end subroutine psb_s_base_arwsum
end interface
!
! Compute sums along the columns, either
! natural or absolute value
!
interface
subroutine psb_s_base_colsum(d,a)
import :: psb_s_base_sparse_mat, psb_spk_
@ -358,186 +674,7 @@ module psb_s_base_mat_mod
real(psb_spk_), intent(out) :: d(:)
end subroutine psb_s_base_aclsum
end interface
interface
subroutine psb_s_base_get_diag(a,d,info)
import :: psb_s_base_sparse_mat, psb_spk_
class(psb_s_base_sparse_mat), intent(in) :: a
real(psb_spk_), intent(out) :: d(:)
integer, intent(out) :: info
end subroutine psb_s_base_get_diag
end interface
interface
subroutine psb_s_base_csput(nz,ia,ja,val,a,imin,imax,jmin,jmax,info,gtl)
import :: psb_s_base_sparse_mat, psb_spk_
class(psb_s_base_sparse_mat), intent(inout) :: a
real(psb_spk_), intent(in) :: val(:)
integer, intent(in) :: nz, ia(:), ja(:), imin,imax,jmin,jmax
integer, intent(out) :: info
integer, intent(in), optional :: gtl(:)
end subroutine psb_s_base_csput
end interface
interface
subroutine psb_s_base_csgetrow(imin,imax,a,nz,ia,ja,val,info,&
& jmin,jmax,iren,append,nzin,rscale,cscale)
import :: psb_s_base_sparse_mat, psb_spk_
class(psb_s_base_sparse_mat), 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(:)
integer,intent(out) :: info
logical, intent(in), optional :: append
integer, intent(in), optional :: iren(:)
integer, intent(in), optional :: jmin,jmax, nzin
logical, intent(in), optional :: rscale,cscale
end subroutine psb_s_base_csgetrow
end interface
interface
subroutine psb_s_base_csgetblk(imin,imax,a,b,info,&
& jmin,jmax,iren,append,rscale,cscale)
import :: psb_s_base_sparse_mat, psb_s_coo_sparse_mat, psb_spk_
class(psb_s_base_sparse_mat), intent(in) :: a
class(psb_s_coo_sparse_mat), intent(inout) :: b
integer, intent(in) :: imin,imax
integer,intent(out) :: info
logical, intent(in), optional :: append
integer, intent(in), optional :: iren(:)
integer, intent(in), optional :: jmin,jmax
logical, intent(in), optional :: rscale,cscale
end subroutine psb_s_base_csgetblk
end interface
interface
subroutine psb_s_base_csclip(a,b,info,&
& imin,imax,jmin,jmax,rscale,cscale)
import :: psb_s_base_sparse_mat, psb_s_coo_sparse_mat, psb_spk_
class(psb_s_base_sparse_mat), intent(in) :: a
class(psb_s_coo_sparse_mat), intent(out) :: b
integer,intent(out) :: info
integer, intent(in), optional :: imin,imax,jmin,jmax
logical, intent(in), optional :: rscale,cscale
end subroutine psb_s_base_csclip
end interface
interface
subroutine psb_s_base_mold(a,b,info)
import :: psb_s_base_sparse_mat, psb_long_int_k_
class(psb_s_base_sparse_mat), intent(in) :: a
class(psb_s_base_sparse_mat), intent(out), allocatable :: b
integer, intent(out) :: info
end subroutine psb_s_base_mold
end interface
interface
subroutine psb_s_base_cp_to_coo(a,b,info)
import :: psb_s_base_sparse_mat, psb_s_coo_sparse_mat, psb_spk_
class(psb_s_base_sparse_mat), intent(in) :: a
class(psb_s_coo_sparse_mat), intent(inout) :: b
integer, intent(out) :: info
end subroutine psb_s_base_cp_to_coo
end interface
interface
subroutine psb_s_base_cp_from_coo(a,b,info)
import :: psb_s_base_sparse_mat, psb_s_coo_sparse_mat, psb_spk_
class(psb_s_base_sparse_mat), intent(inout) :: a
class(psb_s_coo_sparse_mat), intent(in) :: b
integer, intent(out) :: info
end subroutine psb_s_base_cp_from_coo
end interface
interface
subroutine psb_s_base_cp_to_fmt(a,b,info)
import :: psb_s_base_sparse_mat, psb_spk_
class(psb_s_base_sparse_mat), intent(in) :: a
class(psb_s_base_sparse_mat), intent(inout) :: b
integer, intent(out) :: info
end subroutine psb_s_base_cp_to_fmt
end interface
interface
subroutine psb_s_base_cp_from_fmt(a,b,info)
import :: psb_s_base_sparse_mat, psb_spk_
class(psb_s_base_sparse_mat), intent(inout) :: a
class(psb_s_base_sparse_mat), intent(in) :: b
integer, intent(out) :: info
end subroutine psb_s_base_cp_from_fmt
end interface
interface
subroutine psb_s_base_mv_to_coo(a,b,info)
import :: psb_s_base_sparse_mat, psb_s_coo_sparse_mat, psb_spk_
class(psb_s_base_sparse_mat), intent(inout) :: a
class(psb_s_coo_sparse_mat), intent(inout) :: b
integer, intent(out) :: info
end subroutine psb_s_base_mv_to_coo
end interface
interface
subroutine psb_s_base_mv_from_coo(a,b,info)
import :: psb_s_base_sparse_mat, psb_s_coo_sparse_mat, psb_spk_
class(psb_s_base_sparse_mat), intent(inout) :: a
class(psb_s_coo_sparse_mat), intent(inout) :: b
integer, intent(out) :: info
end subroutine psb_s_base_mv_from_coo
end interface
interface
subroutine psb_s_base_mv_to_fmt(a,b,info)
import :: psb_s_base_sparse_mat, psb_spk_
class(psb_s_base_sparse_mat), intent(inout) :: a
class(psb_s_base_sparse_mat), intent(inout) :: b
integer, intent(out) :: info
end subroutine psb_s_base_mv_to_fmt
end interface
interface
subroutine psb_s_base_mv_from_fmt(a,b,info)
import :: psb_s_base_sparse_mat, psb_spk_
class(psb_s_base_sparse_mat), intent(inout) :: a
class(psb_s_base_sparse_mat), intent(inout) :: b
integer, intent(out) :: info
end subroutine psb_s_base_mv_from_fmt
end interface
interface
subroutine psb_s_base_transp_2mat(a,b)
import :: psb_s_base_sparse_mat, psb_base_sparse_mat, psb_spk_
class(psb_s_base_sparse_mat), intent(in) :: a
class(psb_base_sparse_mat), intent(out) :: b
end subroutine psb_s_base_transp_2mat
end interface
interface
subroutine psb_s_base_transc_2mat(a,b)
import :: psb_s_base_sparse_mat, psb_base_sparse_mat, psb_spk_
class(psb_s_base_sparse_mat), intent(in) :: a
class(psb_base_sparse_mat), intent(out) :: b
end subroutine psb_s_base_transc_2mat
end interface
interface
subroutine psb_s_base_transp_1mat(a)
import :: psb_s_base_sparse_mat, psb_spk_
class(psb_s_base_sparse_mat), intent(inout) :: a
end subroutine psb_s_base_transp_1mat
end interface
interface
subroutine psb_s_base_transc_1mat(a)
import :: psb_s_base_sparse_mat, psb_spk_
class(psb_s_base_sparse_mat), intent(inout) :: a
end subroutine psb_s_base_transc_1mat
end interface
! == ===============
!

1
base/modules/psb_s_base_vect_mod.f90
Unescape Escape View File

@ -738,6 +738,7 @@ contains
!
! Scatter:
! Y(IDX(:)) = beta*Y(IDX(:)) + X(:)
!
subroutine s_base_sctb(n,idx,x,beta,y)
use psi_serial_mod

3
base/modules/psb_s_csc_mat_mod.f90
Unescape Escape View File

@ -37,6 +37,9 @@
! a sparse matrix as well as the related methods (those who are
! specific to the type and could not be defined higher in the
! hierarchy). We are at the bottom level of the inheritance chain.
!
! Please refere to psb_s_base_mat_mod for a detailed description
! of the various methods, and to psb_s_csc_impl for implementation details.
!
module psb_s_csc_mat_mod

5
base/modules/psb_s_csr_mat_mod.f90
Unescape Escape View File

@ -37,7 +37,10 @@
! a sparse matrix as well as the related methods (those who are
! specific to the type and could not be defined higher in the
! hierarchy). We are at the bottom level of the inheritance chain.
!
!
! Please refere to psb_s_base_mat_mod for a detailed description
! of the various methods, and to psb_s_csr_impl for implementation details.
!
module psb_s_csr_mat_mod
use psb_s_base_mat_mod

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

@ -39,7 +39,8 @@
! indirection. This type encapsulates the psb_s_base_sparse_mat class
! inside another class which is the one visible to the user. All the
! methods of the psb_s_mat_mod simply call the methods of the
! encapsulated class.
! encapsulated class, except for cscnv and cp_from/cp_to.
!
module psb_s_mat_mod
@ -98,20 +99,20 @@ module psb_s_mat_mod
procedure, pass(a) :: s_csclip => psb_s_csclip
procedure, pass(a) :: s_b_csclip => psb_s_b_csclip
generic, public :: csclip => s_b_csclip, s_csclip
procedure, pass(a) :: s_clip_d_ip => psb_s_clip_d_ip
procedure, pass(a) :: s_clip_d => psb_s_clip_d
generic, public :: clip_diag => s_clip_d_ip, s_clip_d
procedure, pass(a) :: reall => psb_s_reallocate_nz
procedure, pass(a) :: get_neigh => psb_s_get_neigh
procedure, pass(a) :: s_cscnv => psb_s_cscnv
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_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
generic, public :: print => print_i, print_n
procedure, pass(a) :: mold => psb_s_mold
procedure, pass(a) :: s_transp_1mat => psb_s_transp_1mat
procedure, pass(a) :: s_transp_2mat => psb_s_transp_2mat
generic, public :: transp => s_transp_1mat, s_transp_2mat
procedure, pass(a) :: s_transc_1mat => psb_s_transc_1mat
procedure, pass(a) :: s_transc_2mat => psb_s_transc_2mat
generic, public :: transc => s_transc_1mat, s_transc_2mat
! These are specific to this level of encapsulation.
procedure, pass(a) :: s_mv_from => psb_s_mv_from
generic, public :: mv_from => s_mv_from
procedure, pass(a) :: s_mv_to => psb_s_mv_to
@ -120,13 +121,14 @@ module psb_s_mat_mod
generic, public :: cp_from => s_cp_from
procedure, pass(a) :: s_cp_to => psb_s_cp_to
generic, public :: cp_to => s_cp_to
procedure, pass(a) :: mold => psb_s_mold
procedure, pass(a) :: s_transp_1mat => psb_s_transp_1mat
procedure, pass(a) :: s_transp_2mat => psb_s_transp_2mat
generic, public :: transp => s_transp_1mat, s_transp_2mat
procedure, pass(a) :: s_transc_1mat => psb_s_transc_1mat
procedure, pass(a) :: s_transc_2mat => psb_s_transc_2mat
generic, public :: transc => s_transc_1mat, s_transc_2mat
procedure, pass(a) :: s_clip_d_ip => psb_s_clip_d_ip
procedure, pass(a) :: s_clip_d => psb_s_clip_d
generic, public :: clip_diag => s_clip_d_ip, s_clip_d
procedure, pass(a) :: s_cscnv => psb_s_cscnv
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_clone
! Computational routines
procedure, pass(a) :: get_diag => psb_s_get_diag
@ -418,6 +420,67 @@ module psb_s_mat_mod
end subroutine psb_s_b_csclip
end interface
interface
subroutine psb_s_mold(a,b)
import :: psb_sspmat_type, psb_s_base_sparse_mat
class(psb_sspmat_type), intent(inout) :: a
class(psb_s_base_sparse_mat), allocatable, intent(out) :: b
end subroutine psb_s_mold
end interface
interface
subroutine psb_s_transp_1mat(a)
import :: psb_sspmat_type
class(psb_sspmat_type), intent(inout) :: a
end subroutine psb_s_transp_1mat
end interface
interface
subroutine psb_s_transp_2mat(a,b)
import :: psb_sspmat_type
class(psb_sspmat_type), intent(in) :: a
class(psb_sspmat_type), intent(out) :: b
end subroutine psb_s_transp_2mat
end interface
interface
subroutine psb_s_transc_1mat(a)
import :: psb_sspmat_type
class(psb_sspmat_type), intent(inout) :: a
end subroutine psb_s_transc_1mat
end interface
interface
subroutine psb_s_transc_2mat(a,b)
import :: psb_sspmat_type
class(psb_sspmat_type), intent(in) :: a
class(psb_sspmat_type), intent(out) :: b
end subroutine psb_s_transc_2mat
end interface
interface
subroutine psb_s_reinit(a,clear)
import :: psb_sspmat_type
class(psb_sspmat_type), intent(inout) :: a
logical, intent(in), optional :: clear
end subroutine psb_s_reinit
end interface
!
! These methods are specific to the outer SPMAT_TYPE level, since
! they tamper with the inner BASE_SPARSE_MAT object.
!
!
!
! CSCNV: switches to a different internal derived type.
! 3 versions: copying to target
! copying to a base_sparse_mat object.
! in place
!
!
interface
subroutine psb_s_cscnv(a,b,info,type,mold,upd,dupl)
import :: psb_sspmat_type, psb_spk_, psb_s_base_sparse_mat
@ -453,6 +516,10 @@ module psb_s_mat_mod
end subroutine psb_s_cscnv_base
end interface
!
! Produce a version of the matrix with diagonal cut
! out; passes through a COO buffer.
!
interface
subroutine psb_s_clip_d(a,b,info)
import :: psb_sspmat_type
@ -470,6 +537,10 @@ module psb_s_mat_mod
end subroutine psb_s_clip_d_ip
end interface
!
! These four interfaces cut through the
! encapsulation between spmat_type and base_sparse_mat.
!
interface
subroutine psb_s_mv_from(a,b)
import :: psb_sspmat_type, psb_spk_, psb_s_base_sparse_mat
@ -502,6 +573,9 @@ module psb_s_mat_mod
end subroutine psb_s_cp_to
end interface
!
! Transfer the internal allocation to the target.
!
interface psb_move_alloc
subroutine psb_sspmat_type_move(a,b,info)
import :: psb_sspmat_type
@ -511,7 +585,7 @@ module psb_s_mat_mod
end subroutine psb_sspmat_type_move
end interface
interface psb_clone
interface
subroutine psb_sspmat_clone(a,b,info)
import :: psb_sspmat_type
class(psb_sspmat_type), intent(in) :: a
@ -520,53 +594,7 @@ module psb_s_mat_mod
end subroutine psb_sspmat_clone
end interface
interface
subroutine psb_s_mold(a,b)
import :: psb_sspmat_type, psb_s_base_sparse_mat
class(psb_sspmat_type), intent(inout) :: a
class(psb_s_base_sparse_mat), allocatable, intent(out) :: b
end subroutine psb_s_mold
end interface
interface
subroutine psb_s_transp_1mat(a)
import :: psb_sspmat_type
class(psb_sspmat_type), intent(inout) :: a
end subroutine psb_s_transp_1mat
end interface
interface
subroutine psb_s_transp_2mat(a,b)
import :: psb_sspmat_type
class(psb_sspmat_type), intent(in) :: a
class(psb_sspmat_type), intent(out) :: b
end subroutine psb_s_transp_2mat
end interface
interface
subroutine psb_s_transc_1mat(a)
import :: psb_sspmat_type
class(psb_sspmat_type), intent(inout) :: a
end subroutine psb_s_transc_1mat
end interface
interface
subroutine psb_s_transc_2mat(a,b)
import :: psb_sspmat_type
class(psb_sspmat_type), intent(in) :: a
class(psb_sspmat_type), intent(out) :: b
end subroutine psb_s_transc_2mat
end interface
interface
subroutine psb_s_reinit(a,clear)
import :: psb_sspmat_type
class(psb_sspmat_type), intent(inout) :: a
logical, intent(in), optional :: clear
end subroutine psb_s_reinit
end interface
! == ===================================

61
base/modules/psb_s_vect_mod.f90
Unescape Escape View File

@ -1,3 +1,42 @@
!!$
!!$ Parallel Sparse BLAS version 3.0
!!$ (C) Copyright 2006, 2007, 2008, 2009, 2010
!!$ Salvatore Filippone University of Rome Tor Vergata
!!$ Alfredo Buttari CNRS-IRIT, Toulouse
!!$
!!$ Redistribution and use in source and binary forms, with or without
!!$ modification, are permitted provided that the following conditions
!!$ are met:
!!$ 1. Redistributions of source code must retain the above copyright
!!$ notice, this list of conditions and the following disclaimer.
!!$ 2. Redistributions in binary form must reproduce the above copyright
!!$ notice, this list of conditions, and the following disclaimer in the
!!$ documentation and/or other materials provided with the distribution.
!!$ 3. The name of the PSBLAS group or the names of its contributors may
!!$ not be used to endorse or promote products derived from this
!!$ software without specific written permission.
!!$
!!$ THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS
!!$ ``AS IS'' AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED
!!$ TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR
!!$ PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE PSBLAS GROUP OR ITS CONTRIBUTORS
!!$ BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR
!!$ CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF
!!$ SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS
!!$ INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN
!!$ CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE)
!!$ ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE
!!$ POSSIBILITY OF SUCH DAMAGE.
!!$
!!$
!
! package: psb_s_vect_mod
!
! This module contains the definition of the psb_s_vect type which
! is the outer container for dense vectors.
! Therefore all methods simply invoke the corresponding methods of the
! inner component.
!
module psb_s_vect_mod
use psb_s_base_vect_mod
@ -117,7 +156,7 @@ contains
subroutine s_vect_set_vect(x,val)
class(psb_s_vect_type), intent(inout) :: x
real(psb_spk_), intent(in) :: val(:)
real(psb_spk_), intent(in) :: val(:)
integer :: info
if (allocated(x%v)) call x%v%set(val)
@ -255,11 +294,11 @@ contains
subroutine s_vect_mlt_a_2(alpha,x,y,beta,z,info)
use psi_serial_mod
implicit none
real(psb_spk_), intent(in) :: alpha,beta
real(psb_spk_), intent(in) :: y(:)
real(psb_spk_), intent(in) :: x(:)
class(psb_s_vect_type), intent(inout) :: z
integer, intent(out) :: info
real(psb_spk_), intent(in) :: alpha,beta
real(psb_spk_), intent(in) :: y(:)
real(psb_spk_), intent(in) :: x(:)
class(psb_s_vect_type), intent(inout) :: z
integer, intent(out) :: info
integer :: i, n
info = 0
@ -268,20 +307,22 @@ contains
end subroutine s_vect_mlt_a_2
subroutine s_vect_mlt_v_2(alpha,x,y,beta,z,info)
subroutine s_vect_mlt_v_2(alpha,x,y,beta,z,info,conjgx,conjgy)
use psi_serial_mod
implicit none
real(psb_spk_), intent(in) :: alpha,beta
real(psb_spk_), intent(in) :: alpha,beta
class(psb_s_vect_type), intent(inout) :: x
class(psb_s_vect_type), intent(inout) :: y
class(psb_s_vect_type), intent(inout) :: z
integer, intent(out) :: info
integer, intent(out) :: info
character(len=1), intent(in), optional :: conjgx, conjgy
integer :: i, n
info = 0
if (allocated(x%v).and.allocated(y%v).and.&
& allocated(z%v)) &
& call z%v%mlt(alpha,x%v,y%v,beta,info)
& call z%v%mlt(alpha,x%v,y%v,beta,info,conjgx,conjgy)
end subroutine s_vect_mlt_v_2

642
base/modules/psb_z_base_mat_mod.f90
Unescape Escape View File

@ -32,30 +32,27 @@
!
! package: psb_z_base_mat_mod
!
! This module contains the implementation of the
! psb_z_base_sparse_mat, derived from the psb_base_sparse_mat to
! define a middle level definition of a complex, double-precision
! sparse matrix object.This class object itself does not have any
! additional members with respect to those of the base class. No
! methods can be fully implemented at this level, but we can define
! the interface for the computational methods requiring the knowledge
! of the underlying field, such as the matrix-vector product; this
! interface is defined, but is supposed to be overridden at the leaf
! level.
! This module contains the definition of the psb_z_base_sparse_mat
! type, derived from the psb_base_sparse_mat one to define a middle
! level definition of a complex(psb_dpk_) sparse matrix
! object.This class object itself does not have any additional members
! with respect to those of the base class. No methods can be fully
! implemented at this level, but we can define the interface for the
! computational methods requiring the knowledge of the underlying
! field, such as the matrix-vector product; this interface is defined,
! but is supposed to be overridden at the leaf level.
!
! This module also contains the implementation of the
! psb_z_coo_sparse_mat type and the related methods. This is the
! reference type for all the format transitions, copies and mv unless
! methods are implemented that allow the direct transition from one
! format to another. The psb_z_coo_sparse_mat type extends the
! psb_z_base_sparse_mat one.
! format to another. The psb_z_coo_sparse_mat type extends
! psb_z_base_sparse_mat.
!
! About the method MOLD: this has been defined for those compilers
! not yet supporting ALLOCATE( ...MOLD=...); it's otherwise silly to
! not yet supporting ALLOCATE( ...,MOLD=...); it's otherwise silly to
! duplicate "by hand" what is specified in the language (in this case F2008)
!
module psb_z_base_mat_mod
use psb_base_mat_mod
@ -63,6 +60,40 @@ module psb_z_base_mat_mod
type, extends(psb_base_sparse_mat) :: psb_z_base_sparse_mat
contains
!
! Data management methods: defined here, but not implemented.
!
procedure, pass(a) :: csput => psb_z_base_csput
procedure, pass(a) :: z_csgetrow => psb_z_base_csgetrow
procedure, pass(a) :: z_csgetblk => psb_z_base_csgetblk
procedure, pass(a) :: get_diag => psb_z_base_get_diag
generic, public :: csget => z_csgetrow, z_csgetblk
procedure, pass(a) :: csclip => psb_z_base_csclip
procedure, pass(a) :: mold => psb_z_base_mold
procedure, pass(a) :: cp_to_coo => psb_z_base_cp_to_coo
procedure, pass(a) :: cp_from_coo => psb_z_base_cp_from_coo
procedure, pass(a) :: cp_to_fmt => psb_z_base_cp_to_fmt
procedure, pass(a) :: cp_from_fmt => psb_z_base_cp_from_fmt
procedure, pass(a) :: mv_to_coo => psb_z_base_mv_to_coo
procedure, pass(a) :: mv_from_coo => psb_z_base_mv_from_coo
procedure, pass(a) :: mv_to_fmt => psb_z_base_mv_to_fmt
procedure, pass(a) :: mv_from_fmt => psb_z_base_mv_from_fmt
procedure, pass(a) :: z_base_cp_from
generic, public :: cp_from => z_base_cp_from
procedure, pass(a) :: z_base_mv_from
generic, public :: mv_from => z_base_mv_from
!
! Transpose methods: defined here but not implemented.
!
procedure, pass(a) :: transp_1mat => psb_z_base_transp_1mat
procedure, pass(a) :: transp_2mat => psb_z_base_transp_2mat
procedure, pass(a) :: transc_1mat => psb_z_base_transc_1mat
procedure, pass(a) :: transc_2mat => psb_z_base_transc_2mat
!
! Computational methods: defined here but not implemented.
!
procedure, pass(a) :: z_sp_mv => psb_z_base_vect_mv
procedure, pass(a) :: z_csmv => psb_z_base_csmv
procedure, pass(a) :: z_csmm => psb_z_base_csmm
@ -85,32 +116,6 @@ module psb_z_base_mat_mod
procedure, pass(a) :: arwsum => psb_z_base_arwsum
procedure, pass(a) :: colsum => psb_z_base_colsum
procedure, pass(a) :: aclsum => psb_z_base_aclsum
procedure, pass(a) :: get_diag => psb_z_base_get_diag
procedure, pass(a) :: csput => psb_z_base_csput
procedure, pass(a) :: z_csgetrow => psb_z_base_csgetrow
procedure, pass(a) :: z_csgetblk => psb_z_base_csgetblk
generic, public :: csget => z_csgetrow, z_csgetblk
procedure, pass(a) :: csclip => psb_z_base_csclip
procedure, pass(a) :: mold => psb_z_base_mold
procedure, pass(a) :: cp_to_coo => psb_z_base_cp_to_coo
procedure, pass(a) :: cp_from_coo => psb_z_base_cp_from_coo
procedure, pass(a) :: cp_to_fmt => psb_z_base_cp_to_fmt
procedure, pass(a) :: cp_from_fmt => psb_z_base_cp_from_fmt
procedure, pass(a) :: mv_to_coo => psb_z_base_mv_to_coo
procedure, pass(a) :: mv_from_coo => psb_z_base_mv_from_coo
procedure, pass(a) :: mv_to_fmt => psb_z_base_mv_to_fmt
procedure, pass(a) :: mv_from_fmt => psb_z_base_mv_from_fmt
procedure, pass(a) :: z_base_cp_from
generic, public :: cp_from => z_base_cp_from
procedure, pass(a) :: z_base_mv_from
generic, public :: mv_from => z_base_mv_from
procedure, pass(a) :: transp_1mat => psb_z_base_transp_1mat
procedure, pass(a) :: transp_2mat => psb_z_base_transp_2mat
procedure, pass(a) :: transc_1mat => psb_z_base_transc_1mat
procedure, pass(a) :: transc_2mat => psb_z_base_transc_2mat
end type psb_z_base_sparse_mat
private :: z_base_cp_from, z_base_mv_from
@ -123,25 +128,13 @@ module psb_z_base_mat_mod
complex(psb_dpk_), allocatable :: val(:)
contains
!
! Data management methods.
!
procedure, pass(a) :: get_size => z_coo_get_size
procedure, pass(a) :: get_nzeros => z_coo_get_nzeros
procedure, pass(a) :: set_nzeros => z_coo_set_nzeros
procedure, nopass :: get_fmt => z_coo_get_fmt
procedure, pass(a) :: sizeof => z_coo_sizeof
procedure, pass(a) :: z_csmm => psb_z_coo_csmm
procedure, pass(a) :: z_csmv => psb_z_coo_csmv
procedure, pass(a) :: z_inner_cssm => psb_z_coo_cssm
procedure, pass(a) :: z_inner_cssv => psb_z_coo_cssv
procedure, pass(a) :: z_scals => psb_z_coo_scals
procedure, pass(a) :: z_scal => psb_z_coo_scal
procedure, pass(a) :: maxval => psb_z_coo_maxval
procedure, pass(a) :: csnmi => psb_z_coo_csnmi
procedure, pass(a) :: csnm1 => psb_z_coo_csnm1
procedure, pass(a) :: rowsum => psb_z_coo_rowsum
procedure, pass(a) :: arwsum => psb_z_coo_arwsum
procedure, pass(a) :: colsum => psb_z_coo_colsum
procedure, pass(a) :: aclsum => psb_z_coo_aclsum
procedure, pass(a) :: reallocate_nz => psb_z_coo_reallocate_nz
procedure, pass(a) :: allocate_mnnz => psb_z_coo_allocate_mnnz
procedure, pass(a) :: cp_to_coo => psb_z_cp_coo_to_coo
@ -156,8 +149,8 @@ module psb_z_base_mat_mod
procedure, pass(a) :: get_diag => psb_z_coo_get_diag
procedure, pass(a) :: z_csgetrow => psb_z_coo_csgetrow
procedure, pass(a) :: csgetptn => psb_z_coo_csgetptn
procedure, pass(a) :: get_nz_row => psb_z_coo_get_nz_row
procedure, pass(a) :: reinit => psb_z_coo_reinit
procedure, pass(a) :: get_nz_row => psb_z_coo_get_nz_row
procedure, pass(a) :: fix => psb_z_fix_coo
procedure, pass(a) :: trim => psb_z_coo_trim
procedure, pass(a) :: print => psb_z_coo_print
@ -167,8 +160,35 @@ module psb_z_base_mat_mod
generic, public :: cp_from => psb_z_coo_cp_from
procedure, pass(a) :: psb_z_coo_mv_from
generic, public :: mv_from => psb_z_coo_mv_from
!
! This is COO specific
!
procedure, pass(a) :: set_nzeros => z_coo_set_nzeros
!
! Transpose methods. These are the base of all
! indirection in transpose, together with conversions
! they are sufficient for all cases.
!
procedure, pass(a) :: transp_1mat => z_coo_transp_1mat
procedure, pass(a) :: transc_1mat => z_coo_transc_1mat
!
! Computational methods.
!
procedure, pass(a) :: z_csmm => psb_z_coo_csmm
procedure, pass(a) :: z_csmv => psb_z_coo_csmv
procedure, pass(a) :: z_inner_cssm => psb_z_coo_cssm
procedure, pass(a) :: z_inner_cssv => psb_z_coo_cssv
procedure, pass(a) :: z_scals => psb_z_coo_scals
procedure, pass(a) :: z_scal => psb_z_coo_scal
procedure, pass(a) :: maxval => psb_z_coo_maxval
procedure, pass(a) :: csnmi => psb_z_coo_csnmi
procedure, pass(a) :: csnm1 => psb_z_coo_csnm1
procedure, pass(a) :: rowsum => psb_z_coo_rowsum
procedure, pass(a) :: arwsum => psb_z_coo_arwsum
procedure, pass(a) :: colsum => psb_z_coo_colsum
procedure, pass(a) :: aclsum => psb_z_coo_aclsum
end type psb_z_coo_sparse_mat
@ -183,8 +203,274 @@ module psb_z_base_mat_mod
! BASE interfaces
!
! == =================
!
! CSPUT: Hand over a set of values to A.
! Simple description:
! A(IA(1:nz),JA(1:nz)) = VAL(1:NZ)
!
! Catches:
! 1. If A is in the BUILD state, then this method
! can only be called for COO matrice, in which case it
! is more like queueing coefficients for later processing.
! 2. If A is in the UPDATE state, then every derived class must
! implement this;
! 3. In the UPDATE state, depending on the value of DUPL flag
! inside A, it will be A=VAL or A = A + VAL
!
!
interface
subroutine psb_z_base_csput(nz,ia,ja,val,a,imin,imax,jmin,jmax,info,gtl)
import :: psb_z_base_sparse_mat, psb_dpk_
class(psb_z_base_sparse_mat), intent(inout) :: a
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(:)
end subroutine psb_z_base_csput
end interface
!
! CSGET methods: getrow, getblk, clip.
! getrow is the basic method, the other two are
! basically convenient wrappers/shorthand.
!
! out(:) = A(imin:imax,:)
!
! The two methods differ on the output format
!
! GETROW returns as the set
! NZ, IA(1:nz), JA(1:nz), VAL(1:NZ)
!
! Optional arguments:
! JMIN,JMAX: get A(IMIN:IMAX,JMIN:JMAX),
! default 1:ncols
! APPEND: append at the end of data, in which case
! # used entries must be in NZ
! RSCALE, CSCALE: scale output indices at base 1.
!
! GETROW must be overridden by all data formats.
!
interface
subroutine psb_z_base_csgetrow(imin,imax,a,nz,ia,ja,val,info,&
& jmin,jmax,iren,append,nzin,rscale,cscale)
import :: psb_z_base_sparse_mat, psb_dpk_
class(psb_z_base_sparse_mat), intent(in) :: a
integer, intent(in) :: imin,imax
integer, intent(out) :: nz
integer, allocatable, intent(inout) :: ia(:), ja(:)
complex(psb_dpk_), allocatable, intent(inout) :: val(:)
integer,intent(out) :: info
logical, intent(in), optional :: append
integer, intent(in), optional :: iren(:)
integer, intent(in), optional :: jmin,jmax, nzin
logical, intent(in), optional :: rscale,cscale
end subroutine psb_z_base_csgetrow
end interface
!
! CSGET methods: getrow, getblk.
! out(:) = A(imin:imax,:)
!
! GETBLK returns a pbs_z_coo_sparse_mat with
! the same contents.
! Default implementation at base level
! in terms of (derived) GETROW
!
interface
subroutine psb_z_base_csgetblk(imin,imax,a,b,info,&
& jmin,jmax,iren,append,rscale,cscale)
import :: psb_z_base_sparse_mat, psb_z_coo_sparse_mat, psb_dpk_
class(psb_z_base_sparse_mat), intent(in) :: a
class(psb_z_coo_sparse_mat), intent(inout) :: b
integer, intent(in) :: imin,imax
integer,intent(out) :: info
logical, intent(in), optional :: append
integer, intent(in), optional :: iren(:)
integer, intent(in), optional :: jmin,jmax
logical, intent(in), optional :: rscale,cscale
end subroutine psb_z_base_csgetblk
end interface
!
! CLIP: extract a subset
! B(:,:) = A(imin:imax,jmin:jmax)
! control: rscale,cscale as in getblk above.
!
! Default implementation at base level in terms of
! GETBLK.
!
interface
subroutine psb_z_base_csclip(a,b,info,&
& imin,imax,jmin,jmax,rscale,cscale)
import :: psb_z_base_sparse_mat, psb_z_coo_sparse_mat, psb_dpk_
class(psb_z_base_sparse_mat), intent(in) :: a
class(psb_z_coo_sparse_mat), intent(out) :: b
integer,intent(out) :: info
integer, intent(in), optional :: imin,imax,jmin,jmax
logical, intent(in), optional :: rscale,cscale
end subroutine psb_z_base_csclip
end interface
!
! GET_DIAG method
!
! D(i) = A(i:i), i=1:min(nrows,ncols)
!
interface
subroutine psb_z_base_get_diag(a,d,info)
import :: psb_z_base_sparse_mat, psb_dpk_
class(psb_z_base_sparse_mat), intent(in) :: a
complex(psb_dpk_), intent(out) :: d(:)
integer, intent(out) :: info
end subroutine psb_z_base_get_diag
end interface
!
! MOLD: make B have the same dinamyc type
! as A.
! For compilers not supporting
! allocate( mold= )
!
interface
subroutine psb_z_base_mold(a,b,info)
import :: psb_z_base_sparse_mat, psb_long_int_k_
class(psb_z_base_sparse_mat), intent(in) :: a
class(psb_z_base_sparse_mat), intent(out), allocatable :: b
integer, intent(out) :: info
end subroutine psb_z_base_mold
end interface
!
! These are the methods implementing the MEDIATOR pattern
! to allow switch between arbitrary.
! Indeed, the TO/FROM FMT can be implemented at the base level
! in terms of the TO/FROM COO per the MEDIATOR design pattern.
! This does not prevent most of the derived classes to
! provide their own versions with shortcuts.
! A%{MV|CP}_{TO|FROM}_{FMT|COO}
! MV|CP: copy versus move, i.e. deallocate
! TO|FROM: invoked from source or target object
!
!
interface
subroutine psb_z_base_cp_to_coo(a,b,info)
import :: psb_z_base_sparse_mat, psb_z_coo_sparse_mat, psb_dpk_
class(psb_z_base_sparse_mat), intent(in) :: a
class(psb_z_coo_sparse_mat), intent(inout) :: b
integer, intent(out) :: info
end subroutine psb_z_base_cp_to_coo
end interface
interface
subroutine psb_z_base_cp_from_coo(a,b,info)
import :: psb_z_base_sparse_mat, psb_z_coo_sparse_mat, psb_dpk_
class(psb_z_base_sparse_mat), intent(inout) :: a
class(psb_z_coo_sparse_mat), intent(in) :: b
integer, intent(out) :: info
end subroutine psb_z_base_cp_from_coo
end interface
interface
subroutine psb_z_base_cp_to_fmt(a,b,info)
import :: psb_z_base_sparse_mat, psb_dpk_
class(psb_z_base_sparse_mat), intent(in) :: a
class(psb_z_base_sparse_mat), intent(inout) :: b
integer, intent(out) :: info
end subroutine psb_z_base_cp_to_fmt
end interface
interface
subroutine psb_z_base_cp_from_fmt(a,b,info)
import :: psb_z_base_sparse_mat, psb_dpk_
class(psb_z_base_sparse_mat), intent(inout) :: a
class(psb_z_base_sparse_mat), intent(in) :: b
integer, intent(out) :: info
end subroutine psb_z_base_cp_from_fmt
end interface
interface
subroutine psb_z_base_mv_to_coo(a,b,info)
import :: psb_z_base_sparse_mat, psb_z_coo_sparse_mat, psb_dpk_
class(psb_z_base_sparse_mat), intent(inout) :: a
class(psb_z_coo_sparse_mat), intent(inout) :: b
integer, intent(out) :: info
end subroutine psb_z_base_mv_to_coo
end interface
interface
subroutine psb_z_base_mv_from_coo(a,b,info)
import :: psb_z_base_sparse_mat, psb_z_coo_sparse_mat, psb_dpk_
class(psb_z_base_sparse_mat), intent(inout) :: a
class(psb_z_coo_sparse_mat), intent(inout) :: b
integer, intent(out) :: info
end subroutine psb_z_base_mv_from_coo
end interface
interface
subroutine psb_z_base_mv_to_fmt(a,b,info)
import :: psb_z_base_sparse_mat, psb_dpk_
class(psb_z_base_sparse_mat), intent(inout) :: a
class(psb_z_base_sparse_mat), intent(inout) :: b
integer, intent(out) :: info
end subroutine psb_z_base_mv_to_fmt
end interface
interface
subroutine psb_z_base_mv_from_fmt(a,b,info)
import :: psb_z_base_sparse_mat, psb_dpk_
class(psb_z_base_sparse_mat), intent(inout) :: a
class(psb_z_base_sparse_mat), intent(inout) :: b
integer, intent(out) :: info
end subroutine psb_z_base_mv_from_fmt
end interface
!
! Transpose methods.
! You can always default to COO to do the actual
! transpose work.
!
interface
subroutine psb_z_base_transp_2mat(a,b)
import :: psb_z_base_sparse_mat, psb_base_sparse_mat, psb_dpk_
class(psb_z_base_sparse_mat), intent(in) :: a
class(psb_base_sparse_mat), intent(out) :: b
end subroutine psb_z_base_transp_2mat
end interface
interface
subroutine psb_z_base_transc_2mat(a,b)
import :: psb_z_base_sparse_mat, psb_base_sparse_mat, psb_dpk_
class(psb_z_base_sparse_mat), intent(in) :: a
class(psb_base_sparse_mat), intent(out) :: b
end subroutine psb_z_base_transc_2mat
end interface
interface
subroutine psb_z_base_transp_1mat(a)
import :: psb_z_base_sparse_mat, psb_dpk_
class(psb_z_base_sparse_mat), intent(inout) :: a
end subroutine psb_z_base_transp_1mat
end interface
interface
subroutine psb_z_base_transc_1mat(a)
import :: psb_z_base_sparse_mat, psb_dpk_
class(psb_z_base_sparse_mat), intent(inout) :: a
end subroutine psb_z_base_transc_1mat
end interface
!
! Matrix-vector products.
! Y = alpha*A*X + beta*Y
!
! vect_mv relies on csmv for those data types
! not specifically using the encapsulation to handle
! foreign data.
!
!
interface
subroutine psb_z_base_csmm(alpha,a,x,beta,y,info,trans)
import :: psb_z_base_sparse_mat, psb_dpk_
@ -211,14 +497,20 @@ module psb_z_base_mat_mod
subroutine psb_z_base_vect_mv(alpha,a,x,beta,y,info,trans)
import :: psb_z_base_sparse_mat, psb_dpk_, psb_z_base_vect_type
class(psb_z_base_sparse_mat), intent(in) :: a
complex(psb_dpk_), intent(in) :: alpha, beta
complex(psb_dpk_), intent(in) :: alpha, beta
class(psb_z_base_vect_type), intent(inout) :: x
class(psb_z_base_vect_type), intent(inout) :: y
integer, intent(out) :: info
character, optional, intent(in) :: trans
end subroutine psb_z_base_vect_mv
end interface
!
! Triangular system solve.
! The CSSM/CSSV/VECT_SV outer methods are implemented at the base
! level, and they take care of the SCALE and D control arguments.
! So the derived classes need to override only the INNER_ methods.
!
interface
subroutine psb_z_base_inner_cssm(alpha,a,x,beta,y,info,trans)
import :: psb_z_base_sparse_mat, psb_dpk_
@ -245,7 +537,7 @@ module psb_z_base_mat_mod
subroutine psb_z_base_inner_vect_sv(alpha,a,x,beta,y,info,trans)
import :: psb_z_base_sparse_mat, psb_dpk_, psb_z_base_vect_type
class(psb_z_base_sparse_mat), intent(in) :: a
complex(psb_dpk_), intent(in) :: alpha, beta
complex(psb_dpk_), intent(in) :: alpha, beta
class(psb_z_base_vect_type), intent(inout) :: x, y
integer, intent(out) :: info
character, optional, intent(in) :: trans
@ -280,7 +572,7 @@ module psb_z_base_mat_mod
subroutine psb_z_base_vect_cssv(alpha,a,x,beta,y,info,trans,scale,d)
import :: psb_z_base_sparse_mat, psb_dpk_,psb_z_base_vect_type
class(psb_z_base_sparse_mat), intent(in) :: a
complex(psb_dpk_), intent(in) :: alpha, beta
complex(psb_dpk_), intent(in) :: alpha, beta
class(psb_z_base_vect_type), intent(inout) :: x,y
integer, intent(out) :: info
character, optional, intent(in) :: trans, scale
@ -288,6 +580,10 @@ module psb_z_base_mat_mod
end subroutine psb_z_base_vect_cssv
end interface
!
! Scale a matrix by a scalar or by a vector.
! Should we handle scale on the columns??
!
interface
subroutine psb_z_base_scals(d,a,info)
import :: psb_z_base_sparse_mat, psb_dpk_
@ -306,6 +602,9 @@ module psb_z_base_mat_mod
end subroutine psb_z_base_scal
end interface
!
! Maximum coefficient absolute value norm
!
interface
function psb_z_base_maxval(a) result(res)
import :: psb_z_base_sparse_mat, psb_dpk_
@ -314,6 +613,9 @@ module psb_z_base_mat_mod
end function psb_z_base_maxval
end interface
!
! Operator infinity norm
!
interface
function psb_z_base_csnmi(a) result(res)
import :: psb_z_base_sparse_mat, psb_dpk_
@ -321,7 +623,10 @@ module psb_z_base_mat_mod
real(psb_dpk_) :: res
end function psb_z_base_csnmi
end interface
!
! Operator 1-norm
!
interface
function psb_z_base_csnm1(a) result(res)
import :: psb_z_base_sparse_mat, psb_dpk_
@ -330,6 +635,10 @@ module psb_z_base_mat_mod
end function psb_z_base_csnm1
end interface
!
! Compute sums along the rows, either
! natural or absolute value
!
interface
subroutine psb_z_base_rowsum(d,a)
import :: psb_z_base_sparse_mat, psb_dpk_
@ -346,6 +655,10 @@ module psb_z_base_mat_mod
end subroutine psb_z_base_arwsum
end interface
!
! Compute sums along the columns, either
! natural or absolute value
!
interface
subroutine psb_z_base_colsum(d,a)
import :: psb_z_base_sparse_mat, psb_dpk_
@ -361,186 +674,7 @@ module psb_z_base_mat_mod
real(psb_dpk_), intent(out) :: d(:)
end subroutine psb_z_base_aclsum
end interface
interface
subroutine psb_z_base_get_diag(a,d,info)
import :: psb_z_base_sparse_mat, psb_dpk_
class(psb_z_base_sparse_mat), intent(in) :: a
complex(psb_dpk_), intent(out) :: d(:)
integer, intent(out) :: info
end subroutine psb_z_base_get_diag
end interface
interface
subroutine psb_z_base_csput(nz,ia,ja,val,a,imin,imax,jmin,jmax,info,gtl)
import :: psb_z_base_sparse_mat, psb_dpk_
class(psb_z_base_sparse_mat), intent(inout) :: a
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(:)
end subroutine psb_z_base_csput
end interface
interface
subroutine psb_z_base_csgetrow(imin,imax,a,nz,ia,ja,val,info,&
& jmin,jmax,iren,append,nzin,rscale,cscale)
import :: psb_z_base_sparse_mat, psb_dpk_
class(psb_z_base_sparse_mat), intent(in) :: a
integer, intent(in) :: imin,imax
integer, intent(out) :: nz
integer, allocatable, intent(inout) :: ia(:), ja(:)
complex(psb_dpk_), allocatable, intent(inout) :: val(:)
integer,intent(out) :: info
logical, intent(in), optional :: append
integer, intent(in), optional :: iren(:)
integer, intent(in), optional :: jmin,jmax, nzin
logical, intent(in), optional :: rscale,cscale
end subroutine psb_z_base_csgetrow
end interface
interface
subroutine psb_z_base_csgetblk(imin,imax,a,b,info,&
& jmin,jmax,iren,append,rscale,cscale)
import :: psb_z_base_sparse_mat, psb_z_coo_sparse_mat, psb_dpk_
class(psb_z_base_sparse_mat), intent(in) :: a
class(psb_z_coo_sparse_mat), intent(inout) :: b
integer, intent(in) :: imin,imax
integer,intent(out) :: info
logical, intent(in), optional :: append
integer, intent(in), optional :: iren(:)
integer, intent(in), optional :: jmin,jmax
logical, intent(in), optional :: rscale,cscale
end subroutine psb_z_base_csgetblk
end interface
interface
subroutine psb_z_base_csclip(a,b,info,&
& imin,imax,jmin,jmax,rscale,cscale)
import :: psb_z_base_sparse_mat, psb_z_coo_sparse_mat, psb_dpk_
class(psb_z_base_sparse_mat), intent(in) :: a
class(psb_z_coo_sparse_mat), intent(out) :: b
integer,intent(out) :: info
integer, intent(in), optional :: imin,imax,jmin,jmax
logical, intent(in), optional :: rscale,cscale
end subroutine psb_z_base_csclip
end interface
interface
subroutine psb_z_base_mold(a,b,info)
import :: psb_z_base_sparse_mat, psb_long_int_k_
class(psb_z_base_sparse_mat), intent(in) :: a
class(psb_z_base_sparse_mat), intent(out), allocatable :: b
integer, intent(out) :: info
end subroutine psb_z_base_mold
end interface
interface
subroutine psb_z_base_cp_to_coo(a,b,info)
import :: psb_z_base_sparse_mat, psb_z_coo_sparse_mat, psb_dpk_
class(psb_z_base_sparse_mat), intent(in) :: a
class(psb_z_coo_sparse_mat), intent(inout) :: b
integer, intent(out) :: info
end subroutine psb_z_base_cp_to_coo
end interface
interface
subroutine psb_z_base_cp_from_coo(a,b,info)
import :: psb_z_base_sparse_mat, psb_z_coo_sparse_mat, psb_dpk_
class(psb_z_base_sparse_mat), intent(inout) :: a
class(psb_z_coo_sparse_mat), intent(in) :: b
integer, intent(out) :: info
end subroutine psb_z_base_cp_from_coo
end interface
interface
subroutine psb_z_base_cp_to_fmt(a,b,info)
import :: psb_z_base_sparse_mat, psb_dpk_
class(psb_z_base_sparse_mat), intent(in) :: a
class(psb_z_base_sparse_mat), intent(inout) :: b
integer, intent(out) :: info
end subroutine psb_z_base_cp_to_fmt
end interface
interface
subroutine psb_z_base_cp_from_fmt(a,b,info)
import :: psb_z_base_sparse_mat, psb_dpk_
class(psb_z_base_sparse_mat), intent(inout) :: a
class(psb_z_base_sparse_mat), intent(in) :: b
integer, intent(out) :: info
end subroutine psb_z_base_cp_from_fmt
end interface
interface
subroutine psb_z_base_mv_to_coo(a,b,info)
import :: psb_z_base_sparse_mat, psb_z_coo_sparse_mat, psb_dpk_
class(psb_z_base_sparse_mat), intent(inout) :: a
class(psb_z_coo_sparse_mat), intent(inout) :: b
integer, intent(out) :: info
end subroutine psb_z_base_mv_to_coo
end interface
interface
subroutine psb_z_base_mv_from_coo(a,b,info)
import :: psb_z_base_sparse_mat, psb_z_coo_sparse_mat, psb_dpk_
class(psb_z_base_sparse_mat), intent(inout) :: a
class(psb_z_coo_sparse_mat), intent(inout) :: b
integer, intent(out) :: info
end subroutine psb_z_base_mv_from_coo
end interface
interface
subroutine psb_z_base_mv_to_fmt(a,b,info)
import :: psb_z_base_sparse_mat, psb_dpk_
class(psb_z_base_sparse_mat), intent(inout) :: a
class(psb_z_base_sparse_mat), intent(inout) :: b
integer, intent(out) :: info
end subroutine psb_z_base_mv_to_fmt
end interface
interface
subroutine psb_z_base_mv_from_fmt(a,b,info)
import :: psb_z_base_sparse_mat, psb_dpk_
class(psb_z_base_sparse_mat), intent(inout) :: a
class(psb_z_base_sparse_mat), intent(inout) :: b
integer, intent(out) :: info
end subroutine psb_z_base_mv_from_fmt
end interface
interface
subroutine psb_z_base_transp_2mat(a,b)
import :: psb_z_base_sparse_mat, psb_base_sparse_mat, psb_dpk_
class(psb_z_base_sparse_mat), intent(in) :: a
class(psb_base_sparse_mat), intent(out) :: b
end subroutine psb_z_base_transp_2mat
end interface
interface
subroutine psb_z_base_transc_2mat(a,b)
import :: psb_z_base_sparse_mat, psb_base_sparse_mat, psb_dpk_
class(psb_z_base_sparse_mat), intent(in) :: a
class(psb_base_sparse_mat), intent(out) :: b
end subroutine psb_z_base_transc_2mat
end interface
interface
subroutine psb_z_base_transp_1mat(a)
import :: psb_z_base_sparse_mat, psb_dpk_
class(psb_z_base_sparse_mat), intent(inout) :: a
end subroutine psb_z_base_transp_1mat
end interface
interface
subroutine psb_z_base_transc_1mat(a)
import :: psb_z_base_sparse_mat, psb_dpk_
class(psb_z_base_sparse_mat), intent(inout) :: a
end subroutine psb_z_base_transc_1mat
end interface
! == ===============
!
@ -588,6 +722,7 @@ module psb_z_base_mat_mod
integer, intent(out) :: info
end subroutine psb_z_coo_mold
end interface
interface
subroutine psb_z_coo_print(iout,a,iv,eirs,eics,head,ivr,ivc)
@ -803,7 +938,8 @@ module psb_z_base_mat_mod
character, optional, intent(in) :: trans
end subroutine psb_z_coo_csmm
end interface
interface
function psb_z_coo_maxval(a) result(res)
import :: psb_z_coo_sparse_mat, psb_dpk_
@ -811,7 +947,7 @@ module psb_z_base_mat_mod
real(psb_dpk_) :: res
end function psb_z_coo_maxval
end interface
interface
function psb_z_coo_csnmi(a) result(res)
import :: psb_z_coo_sparse_mat, psb_dpk_
@ -832,7 +968,7 @@ module psb_z_base_mat_mod
subroutine psb_z_coo_rowsum(d,a)
import :: psb_z_coo_sparse_mat, psb_dpk_
class(psb_z_coo_sparse_mat), intent(in) :: a
complex(psb_dpk_), intent(out) :: d(:)
complex(psb_dpk_), intent(out) :: d(:)
end subroutine psb_z_coo_rowsum
end interface
@ -840,7 +976,7 @@ module psb_z_base_mat_mod
subroutine psb_z_coo_arwsum(d,a)
import :: psb_z_coo_sparse_mat, psb_dpk_
class(psb_z_coo_sparse_mat), intent(in) :: a
real(psb_dpk_), intent(out) :: d(:)
real(psb_dpk_), intent(out) :: d(:)
end subroutine psb_z_coo_arwsum
end interface
@ -848,7 +984,7 @@ module psb_z_base_mat_mod
subroutine psb_z_coo_colsum(d,a)
import :: psb_z_coo_sparse_mat, psb_dpk_
class(psb_z_coo_sparse_mat), intent(in) :: a
complex(psb_dpk_), intent(out) :: d(:)
complex(psb_dpk_), intent(out) :: d(:)
end subroutine psb_z_coo_colsum
end interface
@ -856,7 +992,7 @@ module psb_z_base_mat_mod
subroutine psb_z_coo_aclsum(d,a)
import :: psb_z_coo_sparse_mat, psb_dpk_
class(psb_z_coo_sparse_mat), intent(in) :: a
real(psb_dpk_), intent(out) :: d(:)
real(psb_dpk_), intent(out) :: d(:)
end subroutine psb_z_coo_aclsum
end interface
@ -940,7 +1076,7 @@ contains
class(psb_z_coo_sparse_mat), intent(in) :: a
integer(psb_long_int_k_) :: res
res = 8 + 1
res = res + 2 * psb_sizeof_dp * size(a%val)
res = res + (2*psb_sizeof_dp) * size(a%val)
res = res + psb_sizeof_int * size(a%ia)
res = res + psb_sizeof_int * size(a%ja)
@ -1020,8 +1156,6 @@ contains
!
! == ==================================
subroutine z_coo_free(a)
implicit none
@ -1073,13 +1207,15 @@ contains
end subroutine z_coo_transp_1mat
subroutine z_coo_transc_1mat(a)
implicit none
class(psb_z_coo_sparse_mat), intent(inout) :: a
call a%transp()
a%val(:) = conjg(a%val)
! This will morph into conjg() for C and Z
! and into a no-op for S and D, so a conditional
! on a constant ought to take it out completely.
if (psb_z_is_complex_) a%val(:) = conjg(a%val(:))
end subroutine z_coo_transc_1mat

1
base/modules/psb_z_base_vect_mod.f90
Unescape Escape View File

@ -738,6 +738,7 @@ contains
!
! Scatter:
! Y(IDX(:)) = beta*Y(IDX(:)) + X(:)
!
subroutine z_base_sctb(n,idx,x,beta,y)
use psi_serial_mod

3
base/modules/psb_z_csc_mat_mod.f90
Unescape Escape View File

@ -37,6 +37,9 @@
! a sparse matrix as well as the related methods (those who are
! specific to the type and could not be defined higher in the
! hierarchy). We are at the bottom level of the inheritance chain.
!
! Please refere to psb_z_base_mat_mod for a detailed description
! of the various methods, and to psb_z_csc_impl for implementation details.
!
module psb_z_csc_mat_mod

5
base/modules/psb_z_csr_mat_mod.f90
Unescape Escape View File

@ -37,7 +37,10 @@
! a sparse matrix as well as the related methods (those who are
! specific to the type and could not be defined higher in the
! hierarchy). We are at the bottom level of the inheritance chain.
!
!
! Please refere to psb_z_base_mat_mod for a detailed description
! of the various methods, and to psb_z_csr_impl for implementation details.
!
module psb_z_csr_mat_mod
use psb_z_base_mat_mod

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

@ -39,7 +39,8 @@
! indirection. This type encapsulates the psb_z_base_sparse_mat class
! inside another class which is the one visible to the user. All the
! methods of the psb_z_mat_mod simply call the methods of the
! encapsulated class.
! encapsulated class, except for cscnv and cp_from/cp_to.
!
module psb_z_mat_mod
@ -98,20 +99,20 @@ module psb_z_mat_mod
procedure, pass(a) :: z_csclip => psb_z_csclip
procedure, pass(a) :: z_b_csclip => psb_z_b_csclip
generic, public :: csclip => z_b_csclip, z_csclip
procedure, pass(a) :: z_clip_d_ip => psb_z_clip_d_ip
procedure, pass(a) :: z_clip_d => psb_z_clip_d
generic, public :: clip_diag => z_clip_d_ip, z_clip_d
procedure, pass(a) :: reall => psb_z_reallocate_nz
procedure, pass(a) :: get_neigh => psb_z_get_neigh
procedure, pass(a) :: z_cscnv => psb_z_cscnv
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_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
generic, public :: print => print_i, print_n
procedure, pass(a) :: mold => psb_z_mold
procedure, pass(a) :: z_transp_1mat => psb_z_transp_1mat
procedure, pass(a) :: z_transp_2mat => psb_z_transp_2mat
generic, public :: transp => z_transp_1mat, z_transp_2mat
procedure, pass(a) :: z_transc_1mat => psb_z_transc_1mat
procedure, pass(a) :: z_transc_2mat => psb_z_transc_2mat
generic, public :: transc => z_transc_1mat, z_transc_2mat
! These are specific to this level of encapsulation.
procedure, pass(a) :: z_mv_from => psb_z_mv_from
generic, public :: mv_from => z_mv_from
procedure, pass(a) :: z_mv_to => psb_z_mv_to
@ -120,13 +121,14 @@ module psb_z_mat_mod
generic, public :: cp_from => z_cp_from
procedure, pass(a) :: z_cp_to => psb_z_cp_to
generic, public :: cp_to => z_cp_to
procedure, pass(a) :: mold => psb_z_mold
procedure, pass(a) :: z_transp_1mat => psb_z_transp_1mat
procedure, pass(a) :: z_transp_2mat => psb_z_transp_2mat
generic, public :: transp => z_transp_1mat, z_transp_2mat
procedure, pass(a) :: z_transc_1mat => psb_z_transc_1mat
procedure, pass(a) :: z_transc_2mat => psb_z_transc_2mat
generic, public :: transc => z_transc_1mat, z_transc_2mat
procedure, pass(a) :: z_clip_d_ip => psb_z_clip_d_ip
procedure, pass(a) :: z_clip_d => psb_z_clip_d
generic, public :: clip_diag => z_clip_d_ip, z_clip_d
procedure, pass(a) :: z_cscnv => psb_z_cscnv
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_clone
! Computational routines
procedure, pass(a) :: get_diag => psb_z_get_diag
@ -418,6 +420,67 @@ module psb_z_mat_mod
end subroutine psb_z_b_csclip
end interface
interface
subroutine psb_z_mold(a,b)
import :: psb_zspmat_type, psb_z_base_sparse_mat
class(psb_zspmat_type), intent(inout) :: a
class(psb_z_base_sparse_mat), allocatable, intent(out) :: b
end subroutine psb_z_mold
end interface
interface
subroutine psb_z_transp_1mat(a)
import :: psb_zspmat_type
class(psb_zspmat_type), intent(inout) :: a
end subroutine psb_z_transp_1mat
end interface
interface
subroutine psb_z_transp_2mat(a,b)
import :: psb_zspmat_type
class(psb_zspmat_type), intent(in) :: a
class(psb_zspmat_type), intent(out) :: b
end subroutine psb_z_transp_2mat
end interface
interface
subroutine psb_z_transc_1mat(a)
import :: psb_zspmat_type
class(psb_zspmat_type), intent(inout) :: a
end subroutine psb_z_transc_1mat
end interface
interface
subroutine psb_z_transc_2mat(a,b)
import :: psb_zspmat_type
class(psb_zspmat_type), intent(in) :: a
class(psb_zspmat_type), intent(out) :: b
end subroutine psb_z_transc_2mat
end interface
interface
subroutine psb_z_reinit(a,clear)
import :: psb_zspmat_type
class(psb_zspmat_type), intent(inout) :: a
logical, intent(in), optional :: clear
end subroutine psb_z_reinit
end interface
!
! These methods are specific to the outer SPMAT_TYPE level, since
! they tamper with the inner BASE_SPARSE_MAT object.
!
!
!
! CSCNV: switches to a different internal derived type.
! 3 versions: copying to target
! copying to a base_sparse_mat object.
! in place
!
!
interface
subroutine psb_z_cscnv(a,b,info,type,mold,upd,dupl)
import :: psb_zspmat_type, psb_dpk_, psb_z_base_sparse_mat
@ -453,6 +516,10 @@ module psb_z_mat_mod
end subroutine psb_z_cscnv_base
end interface
!
! Produce a version of the matrix with diagonal cut
! out; passes through a COO buffer.
!
interface
subroutine psb_z_clip_d(a,b,info)
import :: psb_zspmat_type
@ -470,6 +537,10 @@ module psb_z_mat_mod
end subroutine psb_z_clip_d_ip
end interface
!
! These four interfaces cut through the
! encapsulation between spmat_type and base_sparse_mat.
!
interface
subroutine psb_z_mv_from(a,b)
import :: psb_zspmat_type, psb_dpk_, psb_z_base_sparse_mat
@ -502,6 +573,9 @@ module psb_z_mat_mod
end subroutine psb_z_cp_to
end interface
!
! Transfer the internal allocation to the target.
!
interface psb_move_alloc
subroutine psb_zspmat_type_move(a,b,info)
import :: psb_zspmat_type
@ -511,7 +585,7 @@ module psb_z_mat_mod
end subroutine psb_zspmat_type_move
end interface
interface psb_clone
interface
subroutine psb_zspmat_clone(a,b,info)
import :: psb_zspmat_type
class(psb_zspmat_type), intent(in) :: a
@ -520,53 +594,7 @@ module psb_z_mat_mod
end subroutine psb_zspmat_clone
end interface
interface
subroutine psb_z_mold(a,b)
import :: psb_zspmat_type, psb_z_base_sparse_mat
class(psb_zspmat_type), intent(inout) :: a
class(psb_z_base_sparse_mat), allocatable, intent(out) :: b
end subroutine psb_z_mold
end interface
interface
subroutine psb_z_transp_1mat(a)
import :: psb_zspmat_type
class(psb_zspmat_type), intent(inout) :: a
end subroutine psb_z_transp_1mat
end interface
interface
subroutine psb_z_transp_2mat(a,b)
import :: psb_zspmat_type
class(psb_zspmat_type), intent(in) :: a
class(psb_zspmat_type), intent(out) :: b
end subroutine psb_z_transp_2mat
end interface
interface
subroutine psb_z_transc_1mat(a)
import :: psb_zspmat_type
class(psb_zspmat_type), intent(inout) :: a
end subroutine psb_z_transc_1mat
end interface
interface
subroutine psb_z_transc_2mat(a,b)
import :: psb_zspmat_type
class(psb_zspmat_type), intent(in) :: a
class(psb_zspmat_type), intent(out) :: b
end subroutine psb_z_transc_2mat
end interface
interface
subroutine psb_z_reinit(a,clear)
import :: psb_zspmat_type
class(psb_zspmat_type), intent(inout) :: a
logical, intent(in), optional :: clear
end subroutine psb_z_reinit
end interface
! == ===================================

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

@ -1,3 +1,42 @@
!!$
!!$ Parallel Sparse BLAS version 3.0
!!$ (C) Copyright 2006, 2007, 2008, 2009, 2010
!!$ Salvatore Filippone University of Rome Tor Vergata
!!$ Alfredo Buttari CNRS-IRIT, Toulouse
!!$
!!$ Redistribution and use in source and binary forms, with or without
!!$ modification, are permitted provided that the following conditions
!!$ are met:
!!$ 1. Redistributions of source code must retain the above copyright
!!$ notice, this list of conditions and the following disclaimer.
!!$ 2. Redistributions in binary form must reproduce the above copyright
!!$ notice, this list of conditions, and the following disclaimer in the
!!$ documentation and/or other materials provided with the distribution.
!!$ 3. The name of the PSBLAS group or the names of its contributors may
!!$ not be used to endorse or promote products derived from this
!!$ software without specific written permission.
!!$
!!$ THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS
!!$ ``AS IS'' AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED
!!$ TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR
!!$ PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE PSBLAS GROUP OR ITS CONTRIBUTORS
!!$ BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR
!!$ CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF
!!$ SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS
!!$ INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN
!!$ CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE)
!!$ ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE
!!$ POSSIBILITY OF SUCH DAMAGE.
!!$
!!$
!
! package: psb_z_vect_mod
!
! This module contains the definition of the psb_z_vect type which
! is the outer container for dense vectors.
! Therefore all methods simply invoke the corresponding methods of the
! inner component.
!
module psb_z_vect_mod
use psb_z_base_vect_mod
@ -171,7 +210,7 @@ contains
integer, intent(in) :: n
complex(psb_dpk_) :: res
res = czero
res = zzero
if (allocated(x%v).and.allocated(y%v)) &
& res = x%v%dot(n,y%v)
@ -184,7 +223,7 @@ contains
integer, intent(in) :: n
complex(psb_dpk_) :: res
res = czero
res = zzero
if (allocated(x%v)) &
& res = x%v%dot(n,y)

63
base/serial/impl/psb_c_base_mat_impl.f90
Unescape Escape View File

@ -77,17 +77,14 @@ subroutine psb_c_base_cp_to_fmt(a,b,info)
Integer :: err_act
character(len=20) :: name='to_fmt'
logical, parameter :: debug=.false.
type(psb_c_coo_sparse_mat) :: tmp
!
! Default implementation
!
call a%cp_to_coo(tmp,info)
if (info == psb_success_) call b%mv_from_coo(tmp,info)
call psb_get_erraction(err_act)
! This is the base version. If we get here
! it means the derived class is incomplete,
! so we throw an error.
info = psb_err_missing_override_method_
call psb_errpush(info,name,a_err=a%get_fmt())
if (err_act /= psb_act_ret_) then
call psb_error()
end if
return
end subroutine psb_c_base_cp_to_fmt
@ -104,17 +101,14 @@ subroutine psb_c_base_cp_from_fmt(a,b,info)
Integer :: err_act
character(len=20) :: name='from_fmt'
logical, parameter :: debug=.false.
type(psb_c_coo_sparse_mat) :: tmp
call psb_get_erraction(err_act)
! This is the base version. If we get here
! it means the derived class is incomplete,
! so we throw an error.
info = psb_err_missing_override_method_
call psb_errpush(info,name,a_err=a%get_fmt())
!
! Default implementation
!
call b%cp_to_coo(tmp,info)
if (info == psb_success_) call a%mv_from_coo(tmp,info)
if (err_act /= psb_act_ret_) then
call psb_error()
end if
return
end subroutine psb_c_base_cp_from_fmt
@ -187,17 +181,15 @@ subroutine psb_c_base_mv_to_fmt(a,b,info)
Integer :: err_act
character(len=20) :: name='to_fmt'
logical, parameter :: debug=.false.
type(psb_c_coo_sparse_mat) :: tmp
call psb_get_erraction(err_act)
! This is the base version. If we get here
! it means the derived class is incomplete,
! so we throw an error.
info = psb_err_missing_override_method_
call psb_errpush(info,name,a_err=a%get_fmt())
!
! Default implementation
!
call a%mv_to_coo(tmp,info)
if (info == psb_success_) call b%mv_from_coo(tmp,info)
if (err_act /= psb_act_ret_) then
call psb_error()
end if
return
end subroutine psb_c_base_mv_to_fmt
@ -214,17 +206,14 @@ subroutine psb_c_base_mv_from_fmt(a,b,info)
Integer :: err_act
character(len=20) :: name='from_fmt'
logical, parameter :: debug=.false.
type(psb_c_coo_sparse_mat) :: tmp
call psb_get_erraction(err_act)
! This is the base version. If we get here
! it means the derived class is incomplete,
! so we throw an error.
info = psb_err_missing_override_method_
call psb_errpush(info,name,a_err=a%get_fmt())
!
! Default implementation
!
call b%mv_to_coo(tmp,info)
if (info == psb_success_) call a%mv_from_coo(tmp,info)
if (err_act /= psb_act_ret_) then
call psb_error()
end if
return
end subroutine psb_c_base_mv_from_fmt

63
base/serial/impl/psb_d_base_mat_impl.f90
Unescape Escape View File

@ -77,17 +77,14 @@ subroutine psb_d_base_cp_to_fmt(a,b,info)
Integer :: err_act
character(len=20) :: name='to_fmt'
logical, parameter :: debug=.false.
type(psb_d_coo_sparse_mat) :: tmp
!
! Default implementation
!
call a%cp_to_coo(tmp,info)
if (info == psb_success_) call b%mv_from_coo(tmp,info)
call psb_get_erraction(err_act)
! This is the base version. If we get here
! it means the derived class is incomplete,
! so we throw an error.
info = psb_err_missing_override_method_
call psb_errpush(info,name,a_err=a%get_fmt())
if (err_act /= psb_act_ret_) then
call psb_error()
end if
return
end subroutine psb_d_base_cp_to_fmt
@ -104,17 +101,14 @@ subroutine psb_d_base_cp_from_fmt(a,b,info)
Integer :: err_act
character(len=20) :: name='from_fmt'
logical, parameter :: debug=.false.
type(psb_d_coo_sparse_mat) :: tmp
call psb_get_erraction(err_act)
! This is the base version. If we get here
! it means the derived class is incomplete,
! so we throw an error.
info = psb_err_missing_override_method_
call psb_errpush(info,name,a_err=a%get_fmt())
!
! Default implementation
!
call b%cp_to_coo(tmp,info)
if (info == psb_success_) call a%mv_from_coo(tmp,info)
if (err_act /= psb_act_ret_) then
call psb_error()
end if
return
end subroutine psb_d_base_cp_from_fmt
@ -187,17 +181,15 @@ subroutine psb_d_base_mv_to_fmt(a,b,info)
Integer :: err_act
character(len=20) :: name='to_fmt'
logical, parameter :: debug=.false.
type(psb_d_coo_sparse_mat) :: tmp
call psb_get_erraction(err_act)
! This is the base version. If we get here
! it means the derived class is incomplete,
! so we throw an error.
info = psb_err_missing_override_method_
call psb_errpush(info,name,a_err=a%get_fmt())
!
! Default implementation
!
call a%mv_to_coo(tmp,info)
if (info == psb_success_) call b%mv_from_coo(tmp,info)
if (err_act /= psb_act_ret_) then
call psb_error()
end if
return
end subroutine psb_d_base_mv_to_fmt
@ -214,17 +206,14 @@ subroutine psb_d_base_mv_from_fmt(a,b,info)
Integer :: err_act
character(len=20) :: name='from_fmt'
logical, parameter :: debug=.false.
type(psb_d_coo_sparse_mat) :: tmp
call psb_get_erraction(err_act)
! This is the base version. If we get here
! it means the derived class is incomplete,
! so we throw an error.
info = psb_err_missing_override_method_
call psb_errpush(info,name,a_err=a%get_fmt())
!
! Default implementation
!
call b%mv_to_coo(tmp,info)
if (info == psb_success_) call a%mv_from_coo(tmp,info)
if (err_act /= psb_act_ret_) then
call psb_error()
end if
return
end subroutine psb_d_base_mv_from_fmt

63
base/serial/impl/psb_s_base_mat_impl.f90
Unescape Escape View File

@ -77,17 +77,14 @@ subroutine psb_s_base_cp_to_fmt(a,b,info)
Integer :: err_act
character(len=20) :: name='to_fmt'
logical, parameter :: debug=.false.
type(psb_s_coo_sparse_mat) :: tmp
!
! Default implementation
!
call a%cp_to_coo(tmp,info)
if (info == psb_success_) call b%mv_from_coo(tmp,info)
call psb_get_erraction(err_act)
! This is the base version. If we get here
! it means the derived class is incomplete,
! so we throw an error.
info = psb_err_missing_override_method_
call psb_errpush(info,name,a_err=a%get_fmt())
if (err_act /= psb_act_ret_) then
call psb_error()
end if
return
end subroutine psb_s_base_cp_to_fmt
@ -104,17 +101,14 @@ subroutine psb_s_base_cp_from_fmt(a,b,info)
Integer :: err_act
character(len=20) :: name='from_fmt'
logical, parameter :: debug=.false.
type(psb_s_coo_sparse_mat) :: tmp
call psb_get_erraction(err_act)
! This is the base version. If we get here
! it means the derived class is incomplete,
! so we throw an error.
info = psb_err_missing_override_method_
call psb_errpush(info,name,a_err=a%get_fmt())
!
! Default implementation
!
call b%cp_to_coo(tmp,info)
if (info == psb_success_) call a%mv_from_coo(tmp,info)
if (err_act /= psb_act_ret_) then
call psb_error()
end if
return
end subroutine psb_s_base_cp_from_fmt
@ -187,17 +181,15 @@ subroutine psb_s_base_mv_to_fmt(a,b,info)
Integer :: err_act
character(len=20) :: name='to_fmt'
logical, parameter :: debug=.false.
type(psb_s_coo_sparse_mat) :: tmp
call psb_get_erraction(err_act)
! This is the base version. If we get here
! it means the derived class is incomplete,
! so we throw an error.
info = psb_err_missing_override_method_
call psb_errpush(info,name,a_err=a%get_fmt())
!
! Default implementation
!
call a%mv_to_coo(tmp,info)
if (info == psb_success_) call b%mv_from_coo(tmp,info)
if (err_act /= psb_act_ret_) then
call psb_error()
end if
return
end subroutine psb_s_base_mv_to_fmt
@ -214,17 +206,14 @@ subroutine psb_s_base_mv_from_fmt(a,b,info)
Integer :: err_act
character(len=20) :: name='from_fmt'
logical, parameter :: debug=.false.
type(psb_s_coo_sparse_mat) :: tmp
call psb_get_erraction(err_act)
! This is the base version. If we get here
! it means the derived class is incomplete,
! so we throw an error.
info = psb_err_missing_override_method_
call psb_errpush(info,name,a_err=a%get_fmt())
!
! Default implementation
!
call b%mv_to_coo(tmp,info)
if (info == psb_success_) call a%mv_from_coo(tmp,info)
if (err_act /= psb_act_ret_) then
call psb_error()
end if
return
end subroutine psb_s_base_mv_from_fmt

63
base/serial/impl/psb_z_base_mat_impl.f90
Unescape Escape View File

@ -77,17 +77,14 @@ subroutine psb_z_base_cp_to_fmt(a,b,info)
Integer :: err_act
character(len=20) :: name='to_fmt'
logical, parameter :: debug=.false.
type(psb_z_coo_sparse_mat) :: tmp
!
! Default implementation
!
call a%cp_to_coo(tmp,info)
if (info == psb_success_) call b%mv_from_coo(tmp,info)
call psb_get_erraction(err_act)
! This is the base version. If we get here
! it means the derived class is incomplete,
! so we throw an error.
info = psb_err_missing_override_method_
call psb_errpush(info,name,a_err=a%get_fmt())
if (err_act /= psb_act_ret_) then
call psb_error()
end if
return
end subroutine psb_z_base_cp_to_fmt
@ -104,17 +101,14 @@ subroutine psb_z_base_cp_from_fmt(a,b,info)
Integer :: err_act
character(len=20) :: name='from_fmt'
logical, parameter :: debug=.false.
type(psb_z_coo_sparse_mat) :: tmp
call psb_get_erraction(err_act)
! This is the base version. If we get here
! it means the derived class is incomplete,
! so we throw an error.
info = psb_err_missing_override_method_
call psb_errpush(info,name,a_err=a%get_fmt())
!
! Default implementation
!
call b%cp_to_coo(tmp,info)
if (info == psb_success_) call a%mv_from_coo(tmp,info)
if (err_act /= psb_act_ret_) then
call psb_error()
end if
return
end subroutine psb_z_base_cp_from_fmt
@ -187,17 +181,15 @@ subroutine psb_z_base_mv_to_fmt(a,b,info)
Integer :: err_act
character(len=20) :: name='to_fmt'
logical, parameter :: debug=.false.
type(psb_z_coo_sparse_mat) :: tmp
call psb_get_erraction(err_act)
! This is the base version. If we get here
! it means the derived class is incomplete,
! so we throw an error.
info = psb_err_missing_override_method_
call psb_errpush(info,name,a_err=a%get_fmt())
!
! Default implementation
!
call a%mv_to_coo(tmp,info)
if (info == psb_success_) call b%mv_from_coo(tmp,info)
if (err_act /= psb_act_ret_) then
call psb_error()
end if
return
end subroutine psb_z_base_mv_to_fmt
@ -214,17 +206,14 @@ subroutine psb_z_base_mv_from_fmt(a,b,info)
Integer :: err_act
character(len=20) :: name='from_fmt'
logical, parameter :: debug=.false.
type(psb_z_coo_sparse_mat) :: tmp
call psb_get_erraction(err_act)
! This is the base version. If we get here
! it means the derived class is incomplete,
! so we throw an error.
info = psb_err_missing_override_method_
call psb_errpush(info,name,a_err=a%get_fmt())
!
! Default implementation
!
call b%mv_to_coo(tmp,info)
if (info == psb_success_) call a%mv_from_coo(tmp,info)
if (err_act /= psb_act_ret_) then
call psb_error()
end if
return
end subroutine psb_z_base_mv_from_fmt

Write Preview
Loading…
Cancel
Save