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

Fixed use of L_VECT.

Browse Source
ILmat
Salvatore Filippone 8 years ago
parent 50b71443f4
commit fe9dc49539
11 changed files with 3527 additions and 1204 deletions
Show Stats Download Patch File Download Diff File

7
base/modules/Makefile
Unescape Escape View File

@ -92,7 +92,7 @@ UTIL_MODS = auxil/psb_string_mod.o desc/psb_desc_const_mod.o desc/psb_indx_map_m
auxil/psb_c_hsort_x_mod.o \ auxil/psb_c_hsort_x_mod.o \
auxil/psb_z_hsort_x_mod.o \ auxil/psb_z_hsort_x_mod.o \
psb_check_mod.o desc/psb_hash_mod.o\ psb_check_mod.o desc/psb_hash_mod.o\
serial/psb_base_mat_mod.o serial/psb_lbase_mat_mod.o serial/psb_mat_mod.o\ serial/psb_base_mat_mod.o serial/psb_mat_mod.o\
serial/psb_s_base_mat_mod.o serial/psb_s_csr_mat_mod.o serial/psb_s_csc_mat_mod.o serial/psb_s_mat_mod.o \ serial/psb_s_base_mat_mod.o serial/psb_s_csr_mat_mod.o serial/psb_s_csc_mat_mod.o serial/psb_s_mat_mod.o \
serial/psb_d_base_mat_mod.o serial/psb_d_csr_mat_mod.o serial/psb_d_csc_mat_mod.o serial/psb_d_mat_mod.o \ serial/psb_d_base_mat_mod.o serial/psb_d_csr_mat_mod.o serial/psb_d_csc_mat_mod.o serial/psb_d_mat_mod.o \
serial/psb_c_base_mat_mod.o serial/psb_c_csr_mat_mod.o serial/psb_c_csc_mat_mod.o serial/psb_c_mat_mod.o \ serial/psb_c_base_mat_mod.o serial/psb_c_csr_mat_mod.o serial/psb_c_csc_mat_mod.o serial/psb_c_mat_mod.o \
@ -199,14 +199,15 @@ auxil/psb_ip_reord_mod.o: auxil/psb_m_ip_reord_mod.o auxil/psb_e_ip_reord_mod.o
#serial/psb_ld_csc_mat_mod.o serial/psb_ld_csr_mat_mod.o: serial/psb_ld_base_mat_mod.o #serial/psb_ld_csc_mat_mod.o serial/psb_ld_csr_mat_mod.o: serial/psb_ld_base_mat_mod.o
serial/psb_base_mat_mod.o: auxil/psi_serial_mod.o serial/psb_base_mat_mod.o: auxil/psi_serial_mod.o
serial/psb_s_base_mat_mod.o serial/psb_d_base_mat_mod.o serial/psb_c_base_mat_mod.o serial/psb_z_base_mat_mod.o: serial/psb_base_mat_mod.o serial/psb_lbase_mat_mod.o serial/psb_s_base_mat_mod.o serial/psb_d_base_mat_mod.o serial/psb_c_base_mat_mod.o serial/psb_z_base_mat_mod.o: serial/psb_base_mat_mod.o
#serial/psb_ld_base_mat_mod.o: serial/psb_base_mat_mod.o #serial/psb_ld_base_mat_mod.o: serial/psb_base_mat_mod.o
serial/psb_s_base_mat_mod.o: serial/psb_s_base_vect_mod.o serial/psb_s_base_mat_mod.o: serial/psb_s_base_vect_mod.o
serial/psb_d_base_mat_mod.o: serial/psb_d_base_vect_mod.o serial/psb_d_base_mat_mod.o: serial/psb_d_base_vect_mod.o
#serial/psb_ld_base_mat_mod.o: serial/psb_d_base_vect_mod.o #serial/psb_ld_base_mat_mod.o: serial/psb_d_base_vect_mod.o
serial/psb_c_base_mat_mod.o: serial/psb_c_base_vect_mod.o serial/psb_c_base_mat_mod.o: serial/psb_c_base_vect_mod.o
serial/psb_z_base_mat_mod.o: serial/psb_z_base_vect_mod.o serial/psb_z_base_mat_mod.o: serial/psb_z_base_vect_mod.o
serial/psb_l_base_vect_mod.o serial/psb_c_base_vect_mod.o serial/psb_s_base_vect_mod.o serial/psb_d_base_vect_mod.o serial/psb_z_base_vect_mod.o: serial/psb_i_base_vect_mod.o serial/psb_l_base_vect_mod.o: serial/psb_i_base_vect_mod.o
serial/psb_c_base_vect_mod.o serial/psb_s_base_vect_mod.o serial/psb_d_base_vect_mod.o serial/psb_z_base_vect_mod.o: serial/psb_i_base_vect_mod.o serial/psb_l_base_vect_mod.o
serial/psb_i_base_vect_mod.o serial/psb_l_base_vect_mod.o serial/psb_c_base_vect_mod.o serial/psb_s_base_vect_mod.o serial/psb_d_base_vect_mod.o serial/psb_z_base_vect_mod.o: auxil/psi_serial_mod.o psb_realloc_mod.o serial/psb_i_base_vect_mod.o serial/psb_l_base_vect_mod.o serial/psb_c_base_vect_mod.o serial/psb_s_base_vect_mod.o serial/psb_d_base_vect_mod.o serial/psb_z_base_vect_mod.o: auxil/psi_serial_mod.o psb_realloc_mod.o
serial/psb_s_mat_mod.o: serial/psb_s_base_mat_mod.o serial/psb_s_csr_mat_mod.o serial/psb_s_csc_mat_mod.o serial/psb_s_vect_mod.o serial/psb_s_mat_mod.o: serial/psb_s_base_mat_mod.o serial/psb_s_csr_mat_mod.o serial/psb_s_csc_mat_mod.o serial/psb_s_vect_mod.o
serial/psb_d_mat_mod.o: serial/psb_d_base_mat_mod.o serial/psb_d_csr_mat_mod.o serial/psb_d_csc_mat_mod.o serial/psb_d_vect_mod.o serial/psb_i_vect_mod.o serial/psb_d_mat_mod.o: serial/psb_d_base_mat_mod.o serial/psb_d_csr_mat_mod.o serial/psb_d_csc_mat_mod.o serial/psb_d_vect_mod.o serial/psb_i_vect_mod.o

868
base/modules/serial/psb_base_mat_mod.f90
Unescape Escape View File

@ -434,6 +434,380 @@ module psb_base_mat_mod
end subroutine psb_base_trim end subroutine psb_base_trim
end interface end interface
!
!> \namespace psb_lbase_mod \class psb_lbase_sparse_mat
!! The basic data about your matrix.
!! This class is extended twice, to provide the various
!! data variations S/D/C/Z and to implement the actual
!! storage formats. The grandchild classes are then
!! encapsulated to implement the STATE design pattern.
!! We have an ambiguity in that the inner class has a
!! "state" variable; we hope the context will make it clear.
!!
!!
!! The methods associated to this class can be grouped into three sets:
!! - Fully implemented methods: some methods such as get_nrows or
!! set_nrows can be fully implemented at this level.
!! - Partially implemented methods: Some methods have an
!! implementation that is split between this level and the leaf
!! level. For example, the matrix transposition can be partially
!! done at this level (swapping of the rows and columns dimensions)
!! but it has to be completed by a method defined at the leaf level
!! (for actually transposing the row and column indices).
!! - Other methods: There are a number of methods that are defined
!! (i.e their interface is defined) but not implemented at this
!! level. This methods will be overwritten at the leaf level with
!! an actual implementation. If it is not the case, the method
!! defined at this level will raise an error. These methods are
!! defined in the serial/impl/psb_lbase_mat_impl.f90 file
!!
!
type :: psb_lbase_sparse_mat
!> Row size
integer(psb_lpk_), private :: m
!> Col size
integer(psb_lpk_), private :: n
!> Matrix 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.
!! The transitions among the states are detailed in
!! psb_T_mat_mod.
integer(psb_ipk_), private :: state
!> How to treat duplicate elements when
!! transitioning from the BUILD to the ASSEMBLED state.
!! While many formats would allow for duplicate
!! entries, it is much better to constrain the matrices
!! NOT to have duplicate entries, except while in the
!! BUILD state; in our overall design, only COO matrices
!! can ever be in the BUILD state, hence all other formats
!! cannot have duplicate entries.
integer(psb_ipk_), private :: duplicate
!> Is the matrix triangular? (must also be square)
logical, private :: triangle
!> Is the matrix upper or lower? (only if triangular)
logical, private :: upper
!> Is the matrix diagonal stored or assumed unitary? (only if triangular)
logical, private :: unitd
!> Are the coefficients sorted ?
logical, private :: sorted
logical, private :: repeatable_updates=.false.
contains
! == = =================================
!
! Getters
!
!
! == = =================================
procedure, pass(a) :: get_nrows => psb_lbase_get_nrows
procedure, pass(a) :: get_ncols => psb_lbase_get_ncols
procedure, pass(a) :: get_nzeros => psb_lbase_get_nzeros
procedure, pass(a) :: get_nz_row => psb_lbase_get_nz_row
procedure, pass(a) :: get_size => psb_lbase_get_size
procedure, pass(a) :: get_state => psb_lbase_get_state
procedure, pass(a) :: get_dupl => psb_lbase_get_dupl
procedure, nopass :: get_fmt => psb_lbase_get_fmt
procedure, nopass :: has_update => psb_lbase_has_update
procedure, pass(a) :: is_null => psb_lbase_is_null
procedure, pass(a) :: is_bld => psb_lbase_is_bld
procedure, pass(a) :: is_upd => psb_lbase_is_upd
procedure, pass(a) :: is_asb => psb_lbase_is_asb
procedure, pass(a) :: is_sorted => psb_lbase_is_sorted
procedure, pass(a) :: is_upper => psb_lbase_is_upper
procedure, pass(a) :: is_lower => psb_lbase_is_lower
procedure, pass(a) :: is_triangle => psb_lbase_is_triangle
procedure, pass(a) :: is_unit => psb_lbase_is_unit
procedure, pass(a) :: is_by_rows => psb_lbase_is_by_rows
procedure, pass(a) :: is_by_cols => psb_lbase_is_by_cols
procedure, pass(a) :: is_repeatable_updates => psb_lbase_is_repeatable_updates
! == = =================================
!
! Setters
!
! == = =================================
procedure, pass(a) :: set_nrows => psb_lbase_set_nrows
procedure, pass(a) :: set_ncols => psb_lbase_set_ncols
procedure, pass(a) :: set_dupl => psb_lbase_set_dupl
procedure, pass(a) :: set_state => psb_lbase_set_state
procedure, pass(a) :: set_null => psb_lbase_set_null
procedure, pass(a) :: set_bld => psb_lbase_set_bld
procedure, pass(a) :: set_upd => psb_lbase_set_upd
procedure, pass(a) :: set_asb => psb_lbase_set_asb
procedure, pass(a) :: set_sorted => psb_lbase_set_sorted
procedure, pass(a) :: set_upper => psb_lbase_set_upper
procedure, pass(a) :: set_lower => psb_lbase_set_lower
procedure, pass(a) :: set_triangle => psb_lbase_set_triangle
procedure, pass(a) :: set_unit => psb_lbase_set_unit
procedure, pass(a) :: set_repeatable_updates => psb_lbase_set_repeatable_updates
! == = =================================
!
! Data management
!
! == = =================================
procedure, pass(a) :: get_neigh => psb_lbase_get_neigh
procedure, pass(a) :: free => psb_lbase_free
procedure, pass(a) :: asb => psb_lbase_mat_asb
procedure, pass(a) :: trim => psb_lbase_trim
procedure, pass(a) :: reinit => psb_lbase_reinit
procedure, pass(a) :: allocate_mnnz => psb_lbase_allocate_mnnz
procedure, pass(a) :: reallocate_nz => psb_lbase_reallocate_nz
generic, public :: allocate => allocate_mnnz
generic, public :: reallocate => reallocate_nz
procedure, pass(a) :: csgetptn => psb_lbase_csgetptn
generic, public :: csget => csgetptn
procedure, pass(a) :: print => psb_lbase_sparse_print
procedure, pass(a) :: sizeof => psb_lbase_sizeof
procedure, pass(a) :: transp_1mat => psb_lbase_transp_1mat
procedure, pass(a) :: transp_2mat => psb_lbase_transp_2mat
generic, public :: transp => transp_1mat, transp_2mat
procedure, pass(a) :: transc_1mat => psb_lbase_transc_1mat
procedure, pass(a) :: transc_2mat => psb_lbase_transc_2mat
generic, public :: transc => transc_1mat, transc_2mat
!
! Sync: centerpiece of handling of external storage.
! Any derived class having extra storage upon sync
! will guarantee that both fortran/host side and
! external side contain the same data. The base
! version is only a placeholder.
!
procedure, pass(a) :: sync => psb_lbase_mat_sync
procedure, pass(a) :: is_host => psb_lbase_mat_is_host
procedure, pass(a) :: is_dev => psb_lbase_mat_is_dev
procedure, pass(a) :: is_sync => psb_lbase_mat_is_sync
procedure, pass(a) :: set_host => psb_lbase_mat_set_host
procedure, pass(a) :: set_dev => psb_lbase_mat_set_dev
procedure, pass(a) :: set_sync => psb_lbase_mat_set_sync
end type psb_lbase_sparse_mat
!> Function: psb_lbase_get_nz_row
!! \memberof psb_lbase_sparse_mat
!! Interface for the get_nz_row method. Equivalent to:
!! count(A(idx,:)/=0)
!! \param idx The line we are interested in.
!
interface
function psb_lbase_get_nz_row(idx,a) result(res)
import :: psb_lpk_, psb_epk_, psb_lbase_sparse_mat
integer(psb_lpk_), intent(in) :: idx
class(psb_lbase_sparse_mat), intent(in) :: a
integer(psb_lpk_) :: res
end function psb_lbase_get_nz_row
end interface
!
!> Function: psb_lbase_get_nzeros
!! \memberof psb_lbase_sparse_mat
!! Interface for the get_nzeros method. Equivalent to:
!! count(A(:,:)/=0)
!
interface
function psb_lbase_get_nzeros(a) result(res)
import :: psb_lpk_, psb_epk_, psb_lbase_sparse_mat
class(psb_lbase_sparse_mat), intent(in) :: a
integer(psb_lpk_) :: res
end function psb_lbase_get_nzeros
end interface
!> Function get_size
!! \memberof psb_lbase_sparse_mat
!! how many items can A hold with
!! its current space allocation?
!! (as opposed to how many are
!! currently occupied)
!
interface
function psb_lbase_get_size(a) result(res)
import :: psb_lpk_, psb_epk_, psb_lbase_sparse_mat
class(psb_lbase_sparse_mat), intent(in) :: a
integer(psb_lpk_) :: res
end function psb_lbase_get_size
end interface
!
!> Function reinit: transition state from ASB to UPDATE
!! \memberof psb_lbase_sparse_mat
!! \param clear [true] explicitly zero out coefficients.
!
interface
subroutine psb_lbase_reinit(a,clear)
import :: psb_ipk_, psb_epk_, psb_lbase_sparse_mat
class(psb_lbase_sparse_mat), intent(inout) :: a
logical, intent(in), optional :: clear
end subroutine psb_lbase_reinit
end interface
!
!> Function
!! \memberof psb_lbase_sparse_mat
!! print on file in Matrix Market format.
!! \param iout the output unit
!! \param iv(:) [none] renumber both row and column indices
!! \param head [none] a descriptive header for the matrix data
!! \param ivr(:) [none] renumbering for the rows
!! \param ivc(:) [none] renumbering for the cols
!
interface
subroutine psb_lbase_sparse_print(iout,a,iv,head,ivr,ivc)
import :: psb_ipk_, psb_lpk_, psb_epk_, psb_lbase_sparse_mat
integer(psb_ipk_), intent(in) :: iout
class(psb_lbase_sparse_mat), intent(in) :: a
integer(psb_lpk_), intent(in), optional :: iv(:)
character(len=*), optional :: head
integer(psb_lpk_), intent(in), optional :: ivr(:), ivc(:)
end subroutine psb_lbase_sparse_print
end interface
!
!> Function getptn:
!! \memberof psb_lbase_sparse_mat
!! \brief Get the pattern.
!!
!!
!! Return a list of NZ pairs
!! (IA(i),JA(i))
!! each identifying the position of a nonzero in A
!! between row indices IMIN:IMAX;
!! IA,JA are reallocated as necessary.
!! \param imin the minimum row index we are interested in
!! \param imax the minimum row index we are interested in
!! \param nz the number of output coefficients
!! \param ia(:) the output row indices
!! \param ja(:) the output col indices
!! \param info return code
!! \param jmin [1] minimum col index
!! \param jmax [a\%get_ncols()] maximum col index
!! \param iren(:) [none] an array to return renumbered indices (iren(ia(:)),iren(ja(:))
!! \param rscale [false] map [min(ia(:)):max(ia(:))] onto [1:max(ia(:))-min(ia(:))+1]
!! \param cscale [false] map [min(ja(:)):max(ja(:))] onto [1:max(ja(:))-min(ja(:))+1]
!! ( iren cannot be specified with rscale/cscale)
!! \param append [false] append to ia,ja
!! \param nzin [none] if append, then first new entry should go in entry nzin+1
!
interface
subroutine psb_lbase_csgetptn(imin,imax,a,nz,ia,ja,info,&
& jmin,jmax,iren,append,nzin,rscale,cscale)
import :: psb_ipk_, psb_lpk_, psb_epk_, psb_lbase_sparse_mat
class(psb_lbase_sparse_mat), intent(in) :: a
integer(psb_lpk_), intent(in) :: imin,imax
integer(psb_lpk_), intent(out) :: nz
integer(psb_lpk_), allocatable, intent(inout) :: ia(:), ja(:)
integer(psb_ipk_),intent(out) :: info
logical, intent(in), optional :: append
integer(psb_lpk_), intent(in), optional :: iren(:)
integer(psb_lpk_), intent(in), optional :: jmin,jmax, nzin
logical, intent(in), optional :: rscale,cscale
end subroutine psb_lbase_csgetptn
end interface
!
!> Function get_neigh:
!! \memberof psb_lbase_sparse_mat
!! \brief Get the neighbours.
!!
!!
!! Return a list of N indices of neighbours of index idx,
!! i.e. the indices of the nonzeros in row idx of matrix A
!! \param idx the index we are interested in
!! \param neigh(:) the list of indices, reallocated as necessary
!! \param n the number of indices returned
!! \param info return code
!! \param lev [1] find neighbours recursively for LEV levels,
!! i.e. when lev=2 find neighours of neighbours, etc.
!
interface
subroutine psb_lbase_get_neigh(a,idx,neigh,n,info,lev)
import :: psb_ipk_, psb_lpk_, psb_epk_, psb_lbase_sparse_mat
class(psb_lbase_sparse_mat), intent(in) :: a
integer(psb_lpk_), intent(in) :: idx
integer(psb_lpk_), intent(out) :: n
integer(psb_lpk_), allocatable, intent(out) :: neigh(:)
integer(psb_ipk_), intent(out) :: info
integer(psb_lpk_), optional, intent(in) :: lev
end subroutine psb_lbase_get_neigh
end interface
!
!
!> Function allocate_mnnz
!! \memberof psb_lbase_sparse_mat
!! \brief Three-parameters version of allocate
!!
!! \param m number of rows
!! \param n number of cols
!! \param nz [estimated internally] number of nonzeros to allocate for
!
interface
subroutine psb_lbase_allocate_mnnz(m,n,a,nz)
import :: psb_ipk_, psb_lpk_, psb_epk_, psb_lbase_sparse_mat
integer(psb_lpk_), intent(in) :: m,n
class(psb_lbase_sparse_mat), intent(inout) :: a
integer(psb_lpk_), intent(in), optional :: nz
end subroutine psb_lbase_allocate_mnnz
end interface
!
!
!> Function reallocate_nz
!! \memberof psb_lbase_sparse_mat
!! \brief One--parameter version of (re)allocate
!!
!! \param nz number of nonzeros to allocate for
!
interface
subroutine psb_lbase_reallocate_nz(nz,a)
import :: psb_ipk_, psb_lpk_, psb_epk_, psb_lbase_sparse_mat
integer(psb_lpk_), intent(in) :: nz
class(psb_lbase_sparse_mat), intent(inout) :: a
end subroutine psb_lbase_reallocate_nz
end interface
!
!> Function free
!! \memberof psb_lbase_sparse_mat
!! \brief destructor
!
interface
subroutine psb_lbase_free(a)
import :: psb_ipk_, psb_lpk_, psb_epk_, psb_lbase_sparse_mat
class(psb_lbase_sparse_mat), intent(inout) :: a
end subroutine psb_lbase_free
end interface
!
!> Function trim
!! \memberof psb_lbase_sparse_mat
!! \brief Memory trim
!! Make sure the memory allocation of the sparse matrix is as tight as
!! possible given the actual number of nonzeros it contains.
!
interface
subroutine psb_lbase_trim(a)
import :: psb_ipk_, psb_lpk_, psb_epk_, psb_lbase_sparse_mat
class(psb_lbase_sparse_mat), intent(inout) :: a
end subroutine psb_lbase_trim
end interface
interface assignment(=)
module procedure psb_base_from_lbase, psb_lbase_from_base
end interface assignment(=)
contains contains
@ -897,5 +1271,499 @@ contains
res = .true. res = .true.
end function psb_base_mat_is_sync end function psb_base_mat_is_sync
!
!> Function sizeof
!! \memberof psb_lbase_sparse_mat
!! \brief Memory occupation in byes
!
function psb_lbase_sizeof(a) result(res)
implicit none
class(psb_lbase_sparse_mat), intent(in) :: a
integer(psb_epk_) :: res
res = 8
end function psb_lbase_sizeof
!
!> Function get_fmt
!! \memberof psb_lbase_sparse_mat
!! \brief return a short descriptive name (e.g. COO CSR etc.)
!
function psb_lbase_get_fmt() result(res)
implicit none
character(len=5) :: res
res = 'NULL'
end function psb_lbase_get_fmt
!
!> Function has_update
!! \memberof psb_lbase_sparse_mat
!! \brief Does the forma have the UPDATE functionality?
!
function psb_lbase_has_update() result(res)
implicit none
logical :: res
res = .true.
end function psb_lbase_has_update
!
! Standard getter functions: self-explaining.
!
function psb_lbase_get_dupl(a) result(res)
implicit none
class(psb_lbase_sparse_mat), intent(in) :: a
integer(psb_ipk_) :: res
res = a%duplicate
end function psb_lbase_get_dupl
function psb_lbase_get_state(a) result(res)
implicit none
class(psb_lbase_sparse_mat), intent(in) :: a
integer(psb_ipk_) :: res
res = a%state
end function psb_lbase_get_state
function psb_lbase_get_nrows(a) result(res)
implicit none
class(psb_lbase_sparse_mat), intent(in) :: a
integer(psb_lpk_) :: res
res = a%m
end function psb_lbase_get_nrows
function psb_lbase_get_ncols(a) result(res)
implicit none
class(psb_lbase_sparse_mat), intent(in) :: a
integer(psb_lpk_) :: res
res = a%n
end function psb_lbase_get_ncols
subroutine psb_lbase_set_nrows(m,a)
implicit none
class(psb_lbase_sparse_mat), intent(inout) :: a
integer(psb_lpk_), intent(in) :: m
a%m = m
end subroutine psb_lbase_set_nrows
subroutine psb_lbase_set_ncols(n,a)
implicit none
class(psb_lbase_sparse_mat), intent(inout) :: a
integer(psb_lpk_), intent(in) :: n
a%n = n
end subroutine psb_lbase_set_ncols
subroutine psb_lbase_set_state(n,a)
implicit none
class(psb_lbase_sparse_mat), intent(inout) :: a
integer(psb_lpk_), intent(in) :: n
a%state = n
end subroutine psb_lbase_set_state
subroutine psb_lbase_set_dupl(n,a)
implicit none
class(psb_lbase_sparse_mat), intent(inout) :: a
integer(psb_ipk_), intent(in) :: n
a%duplicate = n
end subroutine psb_lbase_set_dupl
subroutine psb_lbase_set_null(a)
implicit none
class(psb_lbase_sparse_mat), intent(inout) :: a
a%state = psb_spmat_null_
end subroutine psb_lbase_set_null
subroutine psb_lbase_set_bld(a)
implicit none
class(psb_lbase_sparse_mat), intent(inout) :: a
a%state = psb_spmat_bld_
end subroutine psb_lbase_set_bld
subroutine psb_lbase_set_upd(a)
implicit none
class(psb_lbase_sparse_mat), intent(inout) :: a
a%state = psb_spmat_upd_
end subroutine psb_lbase_set_upd
subroutine psb_lbase_set_asb(a)
implicit none
class(psb_lbase_sparse_mat), intent(inout) :: a
a%state = psb_spmat_asb_
end subroutine psb_lbase_set_asb
subroutine psb_lbase_set_sorted(a,val)
implicit none
class(psb_lbase_sparse_mat), intent(inout) :: a
logical, intent(in), optional :: val
if (present(val)) then
a%sorted = val
else
a%sorted = .true.
end if
end subroutine psb_lbase_set_sorted
subroutine psb_lbase_set_triangle(a,val)
implicit none
class(psb_lbase_sparse_mat), intent(inout) :: a
logical, intent(in), optional :: val
if (present(val)) then
a%triangle = val
else
a%triangle = .true.
end if
end subroutine psb_lbase_set_triangle
subroutine psb_lbase_set_unit(a,val)
implicit none
class(psb_lbase_sparse_mat), intent(inout) :: a
logical, intent(in), optional :: val
if (present(val)) then
a%unitd = val
else
a%unitd = .true.
end if
end subroutine psb_lbase_set_unit
subroutine psb_lbase_set_lower(a,val)
implicit none
class(psb_lbase_sparse_mat), intent(inout) :: a
logical, intent(in), optional :: val
if (present(val)) then
a%upper = .not.val
else
a%upper = .false.
end if
end subroutine psb_lbase_set_lower
subroutine psb_lbase_set_upper(a,val)
implicit none
class(psb_lbase_sparse_mat), intent(inout) :: a
logical, intent(in), optional :: val
if (present(val)) then
a%upper = val
else
a%upper = .true.
end if
end subroutine psb_lbase_set_upper
subroutine psb_lbase_set_repeatable_updates(a,val)
implicit none
class(psb_lbase_sparse_mat), intent(inout) :: a
logical, intent(in), optional :: val
if (present(val)) then
a%repeatable_updates = val
else
a%repeatable_updates = .true.
end if
end subroutine psb_lbase_set_repeatable_updates
function psb_lbase_is_triangle(a) result(res)
implicit none
class(psb_lbase_sparse_mat), intent(in) :: a
logical :: res
res = a%triangle
end function psb_lbase_is_triangle
function psb_lbase_is_unit(a) result(res)
implicit none
class(psb_lbase_sparse_mat), intent(in) :: a
logical :: res
res = a%unitd
end function psb_lbase_is_unit
function psb_lbase_is_upper(a) result(res)
implicit none
class(psb_lbase_sparse_mat), intent(in) :: a
logical :: res
res = a%upper
end function psb_lbase_is_upper
function psb_lbase_is_lower(a) result(res)
implicit none
class(psb_lbase_sparse_mat), intent(in) :: a
logical :: res
res = .not.a%upper
end function psb_lbase_is_lower
function psb_lbase_is_null(a) result(res)
implicit none
class(psb_lbase_sparse_mat), intent(in) :: a
logical :: res
res = (a%state == psb_spmat_null_)
end function psb_lbase_is_null
function psb_lbase_is_bld(a) result(res)
implicit none
class(psb_lbase_sparse_mat), intent(in) :: a
logical :: res
res = (a%state == psb_spmat_bld_)
end function psb_lbase_is_bld
function psb_lbase_is_upd(a) result(res)
implicit none
class(psb_lbase_sparse_mat), intent(in) :: a
logical :: res
res = (a%state == psb_spmat_upd_)
end function psb_lbase_is_upd
function psb_lbase_is_asb(a) result(res)
implicit none
class(psb_lbase_sparse_mat), intent(in) :: a
logical :: res
res = (a%state == psb_spmat_asb_)
end function psb_lbase_is_asb
function psb_lbase_is_sorted(a) result(res)
implicit none
class(psb_lbase_sparse_mat), intent(in) :: a
logical :: res
res = a%sorted
end function psb_lbase_is_sorted
function psb_lbase_is_by_rows(a) result(res)
implicit none
class(psb_lbase_sparse_mat), intent(in) :: a
logical :: res
res = .false.
end function psb_lbase_is_by_rows
function psb_lbase_is_by_cols(a) result(res)
implicit none
class(psb_lbase_sparse_mat), intent(in) :: a
logical :: res
res = .false.
end function psb_lbase_is_by_cols
function psb_lbase_is_repeatable_updates(a) result(res)
implicit none
class(psb_lbase_sparse_mat), intent(in) :: a
logical :: res
res = a%repeatable_updates
end function psb_lbase_is_repeatable_updates
!
! TRANSP: note sorted=.false.
! better invoke a fix() too many than
! regret it later...
!
subroutine psb_lbase_transp_2mat(a,b)
implicit none
class(psb_lbase_sparse_mat), intent(in) :: a
class(psb_lbase_sparse_mat), intent(out) :: b
b%m = a%n
b%n = a%m
b%state = a%state
b%duplicate = a%duplicate
b%triangle = a%triangle
b%unitd = a%unitd
b%upper = .not.a%upper
b%sorted = .false.
b%repeatable_updates = .false.
end subroutine psb_lbase_transp_2mat
subroutine psb_lbase_transc_2mat(a,b)
implicit none
class(psb_lbase_sparse_mat), intent(in) :: a
class(psb_lbase_sparse_mat), intent(out) :: b
b%m = a%n
b%n = a%m
b%state = a%state
b%duplicate = a%duplicate
b%triangle = a%triangle
b%unitd = a%unitd
b%upper = .not.a%upper
b%sorted = .false.
b%repeatable_updates = .false.
end subroutine psb_lbase_transc_2mat
subroutine psb_lbase_transp_1mat(a)
implicit none
class(psb_lbase_sparse_mat), intent(inout) :: a
integer(psb_lpk_) :: itmp
itmp = a%m
a%m = a%n
a%n = itmp
a%state = a%state
a%duplicate = a%duplicate
a%triangle = a%triangle
a%unitd = a%unitd
a%upper = .not.a%upper
a%sorted = .false.
a%repeatable_updates = .false.
end subroutine psb_lbase_transp_1mat
subroutine psb_lbase_transc_1mat(a)
implicit none
class(psb_lbase_sparse_mat), intent(inout) :: a
call a%transp()
end subroutine psb_lbase_transc_1mat
!
!> Function base_asb:
!! \memberof psb_lbase_sparse_mat
!! \brief Sync: base version calls sync and the set_asb.
!!
!
subroutine psb_lbase_mat_asb(a)
implicit none
class(psb_lbase_sparse_mat), intent(inout) :: a
call a%sync()
call a%set_asb()
end subroutine psb_lbase_mat_asb
!
! The base version of SYNC & friends does nothing, it's just
! a placeholder.
!
!
!> Function base_sync:
!! \memberof psb_lbase_sparse_mat
!! \brief Sync: base version is a no-op.
!!
!
subroutine psb_lbase_mat_sync(a)
implicit none
class(psb_lbase_sparse_mat), target, intent(in) :: a
end subroutine psb_lbase_mat_sync
!
!> Function base_set_host:
!! \memberof psb_lbase_sparse_mat
!! \brief Set_host: base version is a no-op.
!!
!
subroutine psb_lbase_mat_set_host(a)
implicit none
class(psb_lbase_sparse_mat), intent(inout) :: a
end subroutine psb_lbase_mat_set_host
!
!> Function base_set_dev:
!! \memberof psb_lbase_sparse_mat
!! \brief Set_dev: base version is a no-op.
!!
!
subroutine psb_lbase_mat_set_dev(a)
implicit none
class(psb_lbase_sparse_mat), intent(inout) :: a
end subroutine psb_lbase_mat_set_dev
!
!> Function base_set_sync:
!! \memberof psb_lbase_sparse_mat
!! \brief Set_sync: base version is a no-op.
!!
!
subroutine psb_lbase_mat_set_sync(a)
implicit none
class(psb_lbase_sparse_mat), intent(inout) :: a
end subroutine psb_lbase_mat_set_sync
!
!> Function base_is_dev:
!! \memberof psb_lbase_sparse_mat
!! \brief Is matrix on eaternal device .
!!
!
function psb_lbase_mat_is_dev(a) result(res)
implicit none
class(psb_lbase_sparse_mat), intent(in) :: a
logical :: res
res = .false.
end function psb_lbase_mat_is_dev
!
!> Function base_is_host
!! \memberof psb_lbase_sparse_mat
!! \brief Is matrix on standard memory .
!!
!
function psb_lbase_mat_is_host(a) result(res)
implicit none
class(psb_lbase_sparse_mat), intent(in) :: a
logical :: res
res = .true.
end function psb_lbase_mat_is_host
!
!> Function base_is_sync
!! \memberof psb_lbase_sparse_mat
!! \brief Is matrix on sync .
!!
!
function psb_lbase_mat_is_sync(a) result(res)
implicit none
class(psb_lbase_sparse_mat), intent(in) :: a
logical :: res
res = .true.
end function psb_lbase_mat_is_sync
subroutine psb_lbase_from_base(lb,ib)
type(psb_lbase_sparse_mat), intent(inout) :: lb
type(psb_base_sparse_mat), intent(in) :: ib
lb%m = ib%m
lb%n = ib%n
lb%state = ib%state
lb%duplicate = ib%duplicate
lb%triangle = ib%triangle
lb%unitd = ib%unitd
lb%upper = ib%upper
lb%sorted = ib%sorted
lb%repeatable_updates = ib%repeatable_updates
end subroutine psb_lbase_from_base
subroutine psb_base_from_lbase(ib,lb)
type(psb_base_sparse_mat), intent(inout) :: ib
type(psb_lbase_sparse_mat), intent(in) :: lb
ib%m = lb%m
ib%n = lb%n
ib%state = lb%state
ib%duplicate = lb%duplicate
ib%triangle = lb%triangle
ib%unitd = lb%unitd
ib%upper = lb%upper
ib%sorted = lb%sorted
ib%repeatable_updates = lb%repeatable_updates
end subroutine psb_base_from_lbase
end module psb_base_mat_mod end module psb_base_mat_mod

893
base/modules/serial/psb_c_base_mat_mod.f90
Unescape Escape View File

@ -34,7 +34,6 @@
module psb_c_base_mat_mod module psb_c_base_mat_mod
use psb_base_mat_mod use psb_base_mat_mod
use psb_lbase_mat_mod
use psb_c_base_vect_mod use psb_c_base_vect_mod
@ -80,6 +79,18 @@ module psb_c_base_mat_mod
procedure, pass(a) :: clone => psb_c_base_clone procedure, pass(a) :: clone => psb_c_base_clone
procedure, pass(a) :: make_nonunit => psb_c_base_make_nonunit procedure, pass(a) :: make_nonunit => psb_c_base_make_nonunit
procedure, pass(a) :: clean_zeros => psb_c_base_clean_zeros procedure, pass(a) :: clean_zeros => psb_c_base_clean_zeros
!
! Convert internal indices
!
procedure, pass(a) :: cp_to_lcoo => psb_c_base_cp_to_lcoo
procedure, pass(a) :: cp_from_lcoo => psb_c_base_cp_from_lcoo
procedure, pass(a) :: cp_to_lfmt => psb_c_base_cp_to_lfmt
procedure, pass(a) :: cp_from_lfmt => psb_c_base_cp_from_lfmt
procedure, pass(a) :: mv_to_lcoo => psb_c_base_mv_to_lcoo
procedure, pass(a) :: mv_from_lcoo => psb_c_base_mv_from_lcoo
procedure, pass(a) :: mv_to_lfmt => psb_c_base_mv_to_lfmt
procedure, pass(a) :: mv_from_lfmt => psb_c_base_mv_from_lfmt
! !
! Transpose methods: defined here but not implemented. ! Transpose methods: defined here but not implemented.
@ -159,6 +170,13 @@ module psb_c_base_mat_mod
procedure, pass(a) :: mv_from_coo => psb_c_mv_coo_from_coo procedure, pass(a) :: mv_from_coo => psb_c_mv_coo_from_coo
procedure, pass(a) :: mv_to_fmt => psb_c_mv_coo_to_fmt procedure, pass(a) :: mv_to_fmt => psb_c_mv_coo_to_fmt
procedure, pass(a) :: mv_from_fmt => psb_c_mv_coo_from_fmt procedure, pass(a) :: mv_from_fmt => psb_c_mv_coo_from_fmt
!
! Convert internal indices
!
procedure, pass(a) :: cp_to_lcoo => psb_c_cp_coo_to_lcoo
procedure, pass(a) :: cp_from_lcoo => psb_c_cp_coo_from_lcoo
procedure, pass(a) :: csput_a => psb_c_coo_csput_a procedure, pass(a) :: csput_a => psb_c_coo_csput_a
procedure, pass(a) :: get_diag => psb_c_coo_get_diag procedure, pass(a) :: get_diag => psb_c_coo_get_diag
procedure, pass(a) :: csgetrow => psb_c_coo_csgetrow procedure, pass(a) :: csgetrow => psb_c_coo_csgetrow
@ -216,6 +234,197 @@ module psb_c_base_mat_mod
& c_coo_transp_1mat, c_coo_transc_1mat & c_coo_transp_1mat, c_coo_transc_1mat
!> \namespace psb_base_mod \class psb_lc_base_sparse_mat
!! \extends psb_lbase_mat_mod::psb_lbase_sparse_mat
!! The psb_lc_base_sparse_mat type, extending psb_base_sparse_mat,
!! defines a middle level complex(psb_spk_) sparse matrix object.
!! This class object itself does not have any additional members
!! with respect to those of the base class. Most methods cannot 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.
!!
!! About the method MOLD: this has been defined for those compilers
!! not yet supporting ALLOCATE( ...,MOLD=...); it's otherwise silly to
!! duplicate "by hand" what is specified in the language (in this case F2008)
!!
type, extends(psb_lbase_sparse_mat) :: psb_lc_base_sparse_mat
contains
!
! Data management methods: defined here, but (mostly) not implemented.
!
procedure, pass(a) :: csput_a => psb_lc_base_csput_a
procedure, pass(a) :: csput_v => psb_lc_base_csput_v
generic, public :: csput => csput_a, csput_v
procedure, pass(a) :: csgetrow => psb_lc_base_csgetrow
procedure, pass(a) :: csgetblk => psb_lc_base_csgetblk
procedure, pass(a) :: get_diag => psb_lc_base_get_diag
generic, public :: csget => csgetrow, csgetblk
procedure, pass(a) :: tril => psb_lc_base_tril
procedure, pass(a) :: triu => psb_lc_base_triu
procedure, pass(a) :: csclip => psb_lc_base_csclip
procedure, pass(a) :: cp_to_coo => psb_lc_base_cp_to_coo
procedure, pass(a) :: cp_from_coo => psb_lc_base_cp_from_coo
procedure, pass(a) :: cp_to_fmt => psb_lc_base_cp_to_fmt
procedure, pass(a) :: cp_from_fmt => psb_lc_base_cp_from_fmt
procedure, pass(a) :: mv_to_coo => psb_lc_base_mv_to_coo
procedure, pass(a) :: mv_from_coo => psb_lc_base_mv_from_coo
procedure, pass(a) :: mv_to_fmt => psb_lc_base_mv_to_fmt
procedure, pass(a) :: mv_from_fmt => psb_lc_base_mv_from_fmt
procedure, pass(a) :: mold => psb_lc_base_mold
procedure, pass(a) :: clone => psb_lc_base_clone
procedure, pass(a) :: make_nonunit => psb_lc_base_make_nonunit
procedure, pass(a) :: clean_zeros => psb_lc_base_clean_zeros
!
! Convert internal indices
!
procedure, pass(a) :: cp_to_icoo => psb_lc_base_cp_to_icoo
procedure, pass(a) :: cp_from_icoo => psb_lc_base_cp_from_icoo
procedure, pass(a) :: cp_to_ifmt => psb_lc_base_cp_to_ifmt
procedure, pass(a) :: cp_from_ifmt => psb_lc_base_cp_from_ifmt
procedure, pass(a) :: mv_to_icoo => psb_lc_base_mv_to_icoo
procedure, pass(a) :: mv_from_icoo => psb_lc_base_mv_from_icoo
procedure, pass(a) :: mv_to_ifmt => psb_lc_base_mv_to_ifmt
procedure, pass(a) :: mv_from_ifmt => psb_lc_base_mv_from_ifmt
!
! Transpose methods: defined here but not implemented.
!
procedure, pass(a) :: transp_1mat => psb_lc_base_transp_1mat
procedure, pass(a) :: transp_2mat => psb_lc_base_transp_2mat
procedure, pass(a) :: transc_1mat => psb_lc_base_transc_1mat
procedure, pass(a) :: transc_2mat => psb_lc_base_transc_2mat
!
! Computational methods: defined here but not implemented.
!
procedure, pass(a) :: vect_mv => psb_lc_base_vect_mv
procedure, pass(a) :: csmv => psb_lc_base_csmv
procedure, pass(a) :: csmm => psb_lc_base_csmm
generic, public :: spmm => csmm, csmv, vect_mv
procedure, pass(a) :: in_vect_sv => psb_lc_base_inner_vect_sv
procedure, pass(a) :: inner_cssv => psb_lc_base_inner_cssv
procedure, pass(a) :: inner_cssm => psb_lc_base_inner_cssm
generic, public :: inner_spsm => inner_cssm, inner_cssv, in_vect_sv
procedure, pass(a) :: vect_cssv => psb_lc_base_vect_cssv
procedure, pass(a) :: cssv => psb_lc_base_cssv
procedure, pass(a) :: cssm => psb_lc_base_cssm
generic, public :: spsm => cssm, cssv, vect_cssv
procedure, pass(a) :: scals => psb_lc_base_scals
procedure, pass(a) :: scalv => psb_lc_base_scal
generic, public :: scal => scals, scalv
procedure, pass(a) :: maxval => psb_lc_base_maxval
procedure, pass(a) :: spnmi => psb_lc_base_csnmi
procedure, pass(a) :: spnm1 => psb_lc_base_csnm1
procedure, pass(a) :: rowsum => psb_lc_base_rowsum
procedure, pass(a) :: arwsum => psb_lc_base_arwsum
procedure, pass(a) :: colsum => psb_lc_base_colsum
procedure, pass(a) :: aclsum => psb_lc_base_aclsum
end type psb_lc_base_sparse_mat
private :: lc_base_mat_sync, lc_base_mat_is_host, lc_base_mat_is_dev, &
& lc_base_mat_is_sync, lc_base_mat_set_host, lc_base_mat_set_dev,&
& lc_base_mat_set_sync
!> \namespace psb_base_mod \class psb_lc_coo_sparse_mat
!! \extends psb_lc_base_mat_mod::psb_lc_base_sparse_mat
!!
!! psb_lc_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. It is defined here since all other classes must
!! refer to it per the MEDIATOR design pattern.
!!
type, extends(psb_lc_base_sparse_mat) :: psb_lc_coo_sparse_mat
!> Number of nonzeros.
integer(psb_lpk_) :: nnz
!> Row indices.
integer(psb_lpk_), allocatable :: ia(:)
!> Column indices.
integer(psb_lpk_), allocatable :: ja(:)
!> Coefficient values.
complex(psb_spk_), allocatable :: val(:)
integer, private :: sort_status=psb_unsorted_
contains
!
! Data management methods.
!
procedure, pass(a) :: get_size => lc_coo_get_size
procedure, pass(a) :: get_nzeros => lc_coo_get_nzeros
procedure, nopass :: get_fmt => lc_coo_get_fmt
procedure, pass(a) :: sizeof => lc_coo_sizeof
procedure, pass(a) :: reallocate_nz => psb_lc_coo_reallocate_nz
procedure, pass(a) :: allocate_mnnz => psb_lc_coo_allocate_mnnz
procedure, pass(a) :: cp_to_coo => psb_lc_cp_coo_to_coo
procedure, pass(a) :: cp_from_coo => psb_lc_cp_coo_from_coo
procedure, pass(a) :: cp_to_fmt => psb_lc_cp_coo_to_fmt
procedure, pass(a) :: cp_from_fmt => psb_lc_cp_coo_from_fmt
procedure, pass(a) :: mv_to_coo => psb_lc_mv_coo_to_coo
procedure, pass(a) :: mv_from_coo => psb_lc_mv_coo_from_coo
procedure, pass(a) :: mv_to_fmt => psb_lc_mv_coo_to_fmt
procedure, pass(a) :: mv_from_fmt => psb_lc_mv_coo_from_fmt
procedure, pass(a) :: cp_to_icoo => psb_lc_cp_coo_to_icoo
procedure, pass(a) :: cp_from_icoo => psb_lc_cp_coo_from_icoo
procedure, pass(a) :: csput_a => psb_lc_coo_csput_a
procedure, pass(a) :: get_diag => psb_lc_coo_get_diag
procedure, pass(a) :: csgetrow => psb_lc_coo_csgetrow
procedure, pass(a) :: csgetptn => psb_lc_coo_csgetptn
procedure, pass(a) :: reinit => psb_lc_coo_reinit
procedure, pass(a) :: get_nz_row => psb_lc_coo_get_nz_row
procedure, pass(a) :: fix => psb_lc_fix_coo
procedure, pass(a) :: trim => psb_lc_coo_trim
procedure, pass(a) :: clean_zeros => psb_lc_coo_clean_zeros
procedure, pass(a) :: print => psb_lc_coo_print
procedure, pass(a) :: free => lc_coo_free
procedure, pass(a) :: mold => psb_lc_coo_mold
procedure, pass(a) :: is_sorted => lc_coo_is_sorted
procedure, pass(a) :: is_by_rows => lc_coo_is_by_rows
procedure, pass(a) :: is_by_cols => lc_coo_is_by_cols
procedure, pass(a) :: set_by_rows => lc_coo_set_by_rows
procedure, pass(a) :: set_by_cols => lc_coo_set_by_cols
procedure, pass(a) :: set_sort_status => lc_coo_set_sort_status
procedure, pass(a) :: get_sort_status => lc_coo_get_sort_status
!
! This is COO specific
!
procedure, pass(a) :: set_nzeros => lc_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 => lc_coo_transp_1mat
procedure, pass(a) :: transc_1mat => lc_coo_transc_1mat
!
! Computational methods.
!
procedure, pass(a) :: csmm => psb_lc_coo_csmm
procedure, pass(a) :: csmv => psb_lc_coo_csmv
procedure, pass(a) :: inner_cssm => psb_lc_coo_cssm
procedure, pass(a) :: inner_cssv => psb_lc_coo_cssv
procedure, pass(a) :: scals => psb_lc_coo_scals
procedure, pass(a) :: scalv => psb_lc_coo_scal
procedure, pass(a) :: maxval => psb_lc_coo_maxval
procedure, pass(a) :: spnmi => psb_lc_coo_csnmi
procedure, pass(a) :: spnm1 => psb_lc_coo_csnm1
procedure, pass(a) :: rowsum => psb_lc_coo_rowsum
procedure, pass(a) :: arwsum => psb_lc_coo_arwsum
procedure, pass(a) :: colsum => psb_lc_coo_colsum
procedure, pass(a) :: aclsum => psb_lc_coo_aclsum
end type psb_lc_coo_sparse_mat
private :: lc_coo_get_nzeros, lc_coo_set_nzeros, &
& lc_coo_get_fmt, lc_coo_free, lc_coo_sizeof, &
& lc_coo_transp_1mat, lc_coo_transc_1mat
! == ================= ! == =================
! !
@ -683,12 +892,151 @@ module psb_c_base_mat_mod
!! \param info return code !! \param info return code
! !
interface interface
subroutine psb_c_base_mv_to_fmt(a,b,info) subroutine psb_c_base_mv_to_fmt(a,b,info)
import
class(psb_c_base_sparse_mat), intent(inout) :: a
class(psb_c_base_sparse_mat), intent(inout) :: b
integer(psb_ipk_), intent(out) :: info
end subroutine psb_c_base_mv_to_fmt
end interface
!
!> Function mv_from_fmt:
!! \memberof psb_c_base_sparse_mat
!! \brief Convert from a class(psb_c_base_sparse_mat), freeing the source.
!! Invoked from the target object. Can be implemented by
!! simply invoking b%mv_to_coo(tmp) and then a%mv_from_coo(tmp).
!! \param b The output variable
!! \param info return code
!
interface
subroutine psb_c_base_mv_from_fmt(a,b,info)
import
class(psb_c_base_sparse_mat), intent(inout) :: a
class(psb_c_base_sparse_mat), intent(inout) :: b
integer(psb_ipk_), intent(out) :: info
end subroutine psb_c_base_mv_from_fmt
end interface
!
!> Function cp_to_coo:
!! \memberof psb_c_base_sparse_mat
!! \brief Copy and convert to psb_c_coo_sparse_mat
!! Invoked from the source object.
!! \param b The output variable
!! \param info return code
!
interface
subroutine psb_c_base_cp_to_lcoo(a,b,info)
import
class(psb_c_base_sparse_mat), intent(in) :: a
class(psb_lc_coo_sparse_mat), intent(inout) :: b
integer(psb_ipk_), intent(out) :: info
end subroutine psb_c_base_cp_to_lcoo
end interface
!
!> Function cp_from_coo:
!! \memberof psb_c_base_sparse_mat
!! \brief Copy and convert from psb_c_coo_sparse_mat
!! Invoked from the target object.
!! \param b The input variable
!! \param info return code
!
interface
subroutine psb_c_base_cp_from_lcoo(a,b,info)
import
class(psb_c_base_sparse_mat), intent(inout) :: a
class(psb_lc_coo_sparse_mat), intent(in) :: b
integer(psb_ipk_), intent(out) :: info
end subroutine psb_c_base_cp_from_lcoo
end interface
!
!> Function cp_to_fmt:
!! \memberof psb_c_base_sparse_mat
!! \brief Copy and convert to a class(psb_c_base_sparse_mat)
!! Invoked from the source object. Can be implemented by
!! simply invoking a%cp_to_coo(tmp) and then b%cp_from_coo(tmp).
!! \param b The output variable
!! \param info return code
!
interface
subroutine psb_c_base_cp_to_lfmt(a,b,info)
import
class(psb_c_base_sparse_mat), intent(in) :: a
class(psb_lc_base_sparse_mat), intent(inout) :: b
integer(psb_ipk_), intent(out) :: info
end subroutine psb_c_base_cp_to_lfmt
end interface
!
!> Function cp_from_fmt:
!! \memberof psb_c_base_sparse_mat
!! \brief Copy and convert from a class(psb_c_base_sparse_mat)
!! Invoked from the target object. Can be implemented by
!! simply invoking b%cp_to_coo(tmp) and then a%cp_from_coo(tmp).
!! \param b The output variable
!! \param info return code
!
interface
subroutine psb_c_base_cp_from_lfmt(a,b,info)
import
class(psb_c_base_sparse_mat), intent(inout) :: a
class(psb_lc_base_sparse_mat), intent(in) :: b
integer(psb_ipk_), intent(out) :: info
end subroutine psb_c_base_cp_from_lfmt
end interface
!
!> Function mv_to_coo:
!! \memberof psb_c_base_sparse_mat
!! \brief Convert to psb_c_coo_sparse_mat, freeing the source.
!! Invoked from the source object.
!! \param b The output variable
!! \param info return code
!
interface
subroutine psb_c_base_mv_to_lcoo(a,b,info)
import
class(psb_c_base_sparse_mat), intent(inout) :: a
class(psb_lc_coo_sparse_mat), intent(inout) :: b
integer(psb_ipk_), intent(out) :: info
end subroutine psb_c_base_mv_to_lcoo
end interface
!
!> Function mv_from_coo:
!! \memberof psb_c_base_sparse_mat
!! \brief Convert from psb_c_coo_sparse_mat, freeing the source.
!! Invoked from the target object.
!! \param b The input variable
!! \param info return code
!
interface
subroutine psb_c_base_mv_from_lcoo(a,b,info)
import
class(psb_c_base_sparse_mat), intent(inout) :: a
class(psb_lc_coo_sparse_mat), intent(inout) :: b
integer(psb_ipk_), intent(out) :: info
end subroutine psb_c_base_mv_from_lcoo
end interface
!
!> Function mv_to_fmt:
!! \memberof psb_c_base_sparse_mat
!! \brief Convert to a class(psb_c_base_sparse_mat), freeing the source.
!! Invoked from the source object. Can be implemented by
!! simply invoking a%mv_to_coo(tmp) and then b%mv_from_coo(tmp).
!! \param b The output variable
!! \param info return code
!
interface
subroutine psb_c_base_mv_to_lfmt(a,b,info)
import import
class(psb_c_base_sparse_mat), intent(inout) :: a class(psb_c_base_sparse_mat), intent(inout) :: a
class(psb_c_base_sparse_mat), intent(inout) :: b class(psb_lc_base_sparse_mat), intent(inout) :: b
integer(psb_ipk_), intent(out) :: info integer(psb_ipk_), intent(out) :: info
end subroutine psb_c_base_mv_to_fmt end subroutine psb_c_base_mv_to_lfmt
end interface end interface
! !
@ -701,13 +1049,15 @@ module psb_c_base_mat_mod
!! \param info return code !! \param info return code
! !
interface interface
subroutine psb_c_base_mv_from_fmt(a,b,info) subroutine psb_c_base_mv_from_lfmt(a,b,info)
import import
class(psb_c_base_sparse_mat), intent(inout) :: a class(psb_c_base_sparse_mat), intent(inout) :: a
class(psb_c_base_sparse_mat), intent(inout) :: b class(psb_lc_base_sparse_mat), intent(inout) :: b
integer(psb_ipk_), intent(out) :: info integer(psb_ipk_), intent(out) :: info
end subroutine psb_c_base_mv_from_fmt end subroutine psb_c_base_mv_from_lfmt
end interface end interface
! !
!> !>
!! \memberof psb_c_base_sparse_mat !! \memberof psb_c_base_sparse_mat
@ -1407,6 +1757,29 @@ module psb_c_base_mat_mod
integer(psb_ipk_), intent(out) :: info integer(psb_ipk_), intent(out) :: info
end subroutine psb_c_cp_coo_from_coo end subroutine psb_c_cp_coo_from_coo
end interface end interface
!>
!! \memberof psb_c_coo_sparse_mat
!! \see psb_c_base_mat_mod::psb_c_base_cp_to_coo
interface
subroutine psb_c_cp_coo_to_lcoo(a,b,info)
import
class(psb_c_coo_sparse_mat), intent(in) :: a
class(psb_lc_coo_sparse_mat), intent(inout) :: b
integer(psb_ipk_), intent(out) :: info
end subroutine psb_c_cp_coo_to_lcoo
end interface
!>
!! \memberof psb_c_coo_sparse_mat
!! \see psb_c_base_mat_mod::psb_c_base_cp_from_coo
interface
subroutine psb_c_cp_coo_from_lcoo(a,b,info)
import
class(psb_c_coo_sparse_mat), intent(inout) :: a
class(psb_lc_coo_sparse_mat), intent(in) :: b
integer(psb_ipk_), intent(out) :: info
end subroutine psb_c_cp_coo_from_lcoo
end interface
!> !>
!! \memberof psb_c_coo_sparse_mat !! \memberof psb_c_coo_sparse_mat
@ -1653,266 +2026,87 @@ module psb_c_base_mat_mod
class(psb_c_coo_sparse_mat), intent(in) :: a class(psb_c_coo_sparse_mat), intent(in) :: a
real(psb_spk_) :: res real(psb_spk_) :: res
end function psb_c_coo_csnm1 end function psb_c_coo_csnm1
end interface end interface
!>
!! \memberof psb_c_coo_sparse_mat
!! \see psb_c_base_mat_mod::psb_c_base_rowsum
interface
subroutine psb_c_coo_rowsum(d,a)
import
class(psb_c_coo_sparse_mat), intent(in) :: a
complex(psb_spk_), intent(out) :: d(:)
end subroutine psb_c_coo_rowsum
end interface
!>
!! \memberof psb_c_coo_sparse_mat
!! \see psb_c_base_mat_mod::psb_c_base_arwsum
interface
subroutine psb_c_coo_arwsum(d,a)
import
class(psb_c_coo_sparse_mat), intent(in) :: a
real(psb_spk_), intent(out) :: d(:)
end subroutine psb_c_coo_arwsum
end interface
!>
!! \memberof psb_c_coo_sparse_mat
!! \see psb_c_base_mat_mod::psb_c_base_colsum
interface
subroutine psb_c_coo_colsum(d,a)
import
class(psb_c_coo_sparse_mat), intent(in) :: a
complex(psb_spk_), intent(out) :: d(:)
end subroutine psb_c_coo_colsum
end interface
!>
!! \memberof psb_c_coo_sparse_mat
!! \see psb_c_base_mat_mod::psb_c_base_aclsum
interface
subroutine psb_c_coo_aclsum(d,a)
import
class(psb_c_coo_sparse_mat), intent(in) :: a
real(psb_spk_), intent(out) :: d(:)
end subroutine psb_c_coo_aclsum
end interface
!>
!! \memberof psb_c_coo_sparse_mat
!! \see psb_c_base_mat_mod::psb_c_base_get_diag
interface
subroutine psb_c_coo_get_diag(a,d,info)
import
class(psb_c_coo_sparse_mat), intent(in) :: a
complex(psb_spk_), intent(out) :: d(:)
integer(psb_ipk_), intent(out) :: info
end subroutine psb_c_coo_get_diag
end interface
!>
!! \memberof psb_c_coo_sparse_mat
!! \see psb_c_base_mat_mod::psb_c_base_scal
interface
subroutine psb_c_coo_scal(d,a,info,side)
import
class(psb_c_coo_sparse_mat), intent(inout) :: a
complex(psb_spk_), intent(in) :: d(:)
integer(psb_ipk_), intent(out) :: info
character, intent(in), optional :: side
end subroutine psb_c_coo_scal
end interface
!>
!! \memberof psb_c_coo_sparse_mat
!! \see psb_c_base_mat_mod::psb_c_base_scals
interface
subroutine psb_c_coo_scals(d,a,info)
import
class(psb_c_coo_sparse_mat), intent(inout) :: a
complex(psb_spk_), intent(in) :: d
integer(psb_ipk_), intent(out) :: info
end subroutine psb_c_coo_scals
end interface
!> \namespace psb_base_mod \class psb_lc_base_sparse_mat
!! \extends psb_lbase_mat_mod::psb_lbase_sparse_mat
!! The psb_lc_base_sparse_mat type, extending psb_base_sparse_mat,
!! defines a middle level complex(psb_spk_) sparse matrix object.
!! This class object itself does not have any additional members
!! with respect to those of the base class. Most methods cannot 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.
!!
!! About the method MOLD: this has been defined for those compilers
!! not yet supporting ALLOCATE( ...,MOLD=...); it's otherwise silly to
!! duplicate "by hand" what is specified in the language (in this case F2008)
!!
type, extends(psb_lbase_sparse_mat) :: psb_lc_base_sparse_mat
contains
!
! Data management methods: defined here, but (mostly) not implemented.
!
procedure, pass(a) :: csput_a => psb_lc_base_csput_a
procedure, pass(a) :: csput_v => psb_lc_base_csput_v
generic, public :: csput => csput_a, csput_v
procedure, pass(a) :: csgetrow => psb_lc_base_csgetrow
procedure, pass(a) :: csgetblk => psb_lc_base_csgetblk
procedure, pass(a) :: get_diag => psb_lc_base_get_diag
generic, public :: csget => csgetrow, csgetblk
procedure, pass(a) :: tril => psb_lc_base_tril
procedure, pass(a) :: triu => psb_lc_base_triu
procedure, pass(a) :: csclip => psb_lc_base_csclip
procedure, pass(a) :: cp_to_coo => psb_lc_base_cp_to_coo
procedure, pass(a) :: cp_from_coo => psb_lc_base_cp_from_coo
procedure, pass(a) :: cp_to_fmt => psb_lc_base_cp_to_fmt
procedure, pass(a) :: cp_from_fmt => psb_lc_base_cp_from_fmt
procedure, pass(a) :: mv_to_coo => psb_lc_base_mv_to_coo
procedure, pass(a) :: mv_from_coo => psb_lc_base_mv_from_coo
procedure, pass(a) :: mv_to_fmt => psb_lc_base_mv_to_fmt
procedure, pass(a) :: mv_from_fmt => psb_lc_base_mv_from_fmt
procedure, pass(a) :: mold => psb_lc_base_mold
procedure, pass(a) :: clone => psb_lc_base_clone
procedure, pass(a) :: make_nonunit => psb_lc_base_make_nonunit
procedure, pass(a) :: clean_zeros => psb_lc_base_clean_zeros
!
! Transpose methods: defined here but not implemented.
!
procedure, pass(a) :: transp_1mat => psb_lc_base_transp_1mat
procedure, pass(a) :: transp_2mat => psb_lc_base_transp_2mat
procedure, pass(a) :: transc_1mat => psb_lc_base_transc_1mat
procedure, pass(a) :: transc_2mat => psb_lc_base_transc_2mat
!
! Computational methods: defined here but not implemented.
!
procedure, pass(a) :: vect_mv => psb_lc_base_vect_mv
procedure, pass(a) :: csmv => psb_lc_base_csmv
procedure, pass(a) :: csmm => psb_lc_base_csmm
generic, public :: spmm => csmm, csmv, vect_mv
procedure, pass(a) :: in_vect_sv => psb_lc_base_inner_vect_sv
procedure, pass(a) :: inner_cssv => psb_lc_base_inner_cssv
procedure, pass(a) :: inner_cssm => psb_lc_base_inner_cssm
generic, public :: inner_spsm => inner_cssm, inner_cssv, in_vect_sv
procedure, pass(a) :: vect_cssv => psb_lc_base_vect_cssv
procedure, pass(a) :: cssv => psb_lc_base_cssv
procedure, pass(a) :: cssm => psb_lc_base_cssm
generic, public :: spsm => cssm, cssv, vect_cssv
procedure, pass(a) :: scals => psb_lc_base_scals
procedure, pass(a) :: scalv => psb_lc_base_scal
generic, public :: scal => scals, scalv
procedure, pass(a) :: maxval => psb_lc_base_maxval
procedure, pass(a) :: spnmi => psb_lc_base_csnmi
procedure, pass(a) :: spnm1 => psb_lc_base_csnm1
procedure, pass(a) :: rowsum => psb_lc_base_rowsum
procedure, pass(a) :: arwsum => psb_lc_base_arwsum
procedure, pass(a) :: colsum => psb_lc_base_colsum
procedure, pass(a) :: aclsum => psb_lc_base_aclsum
end type psb_lc_base_sparse_mat
private :: lc_base_mat_sync, lc_base_mat_is_host, lc_base_mat_is_dev, &
& lc_base_mat_is_sync, lc_base_mat_set_host, lc_base_mat_set_dev,&
& lc_base_mat_set_sync
!> \namespace psb_base_mod \class psb_lc_coo_sparse_mat
!! \extends psb_lc_base_mat_mod::psb_lc_base_sparse_mat
!!
!! psb_lc_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. It is defined here since all other classes must
!! refer to it per the MEDIATOR design pattern.
!!
type, extends(psb_lc_base_sparse_mat) :: psb_lc_coo_sparse_mat
!> Number of nonzeros.
integer(psb_lpk_) :: nnz
!> Row indices.
integer(psb_lpk_), allocatable :: ia(:)
!> Column indices.
integer(psb_lpk_), allocatable :: ja(:)
!> Coefficient values.
complex(psb_spk_), allocatable :: val(:)
integer, private :: sort_status=psb_unsorted_
contains
!
! Data management methods.
!
procedure, pass(a) :: get_size => lc_coo_get_size
procedure, pass(a) :: get_nzeros => lc_coo_get_nzeros
procedure, nopass :: get_fmt => lc_coo_get_fmt
procedure, pass(a) :: sizeof => lc_coo_sizeof
procedure, pass(a) :: reallocate_nz => psb_lc_coo_reallocate_nz
procedure, pass(a) :: allocate_mnnz => psb_lc_coo_allocate_mnnz
procedure, pass(a) :: cp_to_coo => psb_lc_cp_coo_to_coo
procedure, pass(a) :: cp_from_coo => psb_lc_cp_coo_from_coo
procedure, pass(a) :: cp_to_fmt => psb_lc_cp_coo_to_fmt
procedure, pass(a) :: cp_from_fmt => psb_lc_cp_coo_from_fmt
procedure, pass(a) :: mv_to_coo => psb_lc_mv_coo_to_coo
procedure, pass(a) :: mv_from_coo => psb_lc_mv_coo_from_coo
procedure, pass(a) :: mv_to_fmt => psb_lc_mv_coo_to_fmt
procedure, pass(a) :: mv_from_fmt => psb_lc_mv_coo_from_fmt
procedure, pass(a) :: csput_a => psb_lc_coo_csput_a
procedure, pass(a) :: get_diag => psb_lc_coo_get_diag
procedure, pass(a) :: csgetrow => psb_lc_coo_csgetrow
procedure, pass(a) :: csgetptn => psb_lc_coo_csgetptn
procedure, pass(a) :: reinit => psb_lc_coo_reinit
procedure, pass(a) :: get_nz_row => psb_lc_coo_get_nz_row
procedure, pass(a) :: fix => psb_lc_fix_coo
procedure, pass(a) :: trim => psb_lc_coo_trim
procedure, pass(a) :: clean_zeros => psb_lc_coo_clean_zeros
procedure, pass(a) :: print => psb_lc_coo_print
procedure, pass(a) :: free => lc_coo_free
procedure, pass(a) :: mold => psb_lc_coo_mold
procedure, pass(a) :: is_sorted => lc_coo_is_sorted
procedure, pass(a) :: is_by_rows => lc_coo_is_by_rows
procedure, pass(a) :: is_by_cols => lc_coo_is_by_cols
procedure, pass(a) :: set_by_rows => lc_coo_set_by_rows
procedure, pass(a) :: set_by_cols => lc_coo_set_by_cols
procedure, pass(a) :: set_sort_status => lc_coo_set_sort_status
procedure, pass(a) :: get_sort_status => lc_coo_get_sort_status
!
! This is COO specific
!
procedure, pass(a) :: set_nzeros => lc_coo_set_nzeros
! !>
! Transpose methods. These are the base of all !! \memberof psb_c_coo_sparse_mat
! indirection in transpose, together with conversions !! \see psb_c_base_mat_mod::psb_c_base_rowsum
! they are sufficient for all cases. interface
! subroutine psb_c_coo_rowsum(d,a)
procedure, pass(a) :: transp_1mat => lc_coo_transp_1mat import
procedure, pass(a) :: transc_1mat => lc_coo_transc_1mat class(psb_c_coo_sparse_mat), intent(in) :: a
complex(psb_spk_), intent(out) :: d(:)
end subroutine psb_c_coo_rowsum
end interface
!>
!! \memberof psb_c_coo_sparse_mat
!! \see psb_c_base_mat_mod::psb_c_base_arwsum
interface
subroutine psb_c_coo_arwsum(d,a)
import
class(psb_c_coo_sparse_mat), intent(in) :: a
real(psb_spk_), intent(out) :: d(:)
end subroutine psb_c_coo_arwsum
end interface
! !>
! Computational methods. !! \memberof psb_c_coo_sparse_mat
! !! \see psb_c_base_mat_mod::psb_c_base_colsum
procedure, pass(a) :: csmm => psb_lc_coo_csmm interface
procedure, pass(a) :: csmv => psb_lc_coo_csmv subroutine psb_c_coo_colsum(d,a)
procedure, pass(a) :: inner_cssm => psb_lc_coo_cssm import
procedure, pass(a) :: inner_cssv => psb_lc_coo_cssv class(psb_c_coo_sparse_mat), intent(in) :: a
procedure, pass(a) :: scals => psb_lc_coo_scals complex(psb_spk_), intent(out) :: d(:)
procedure, pass(a) :: scalv => psb_lc_coo_scal end subroutine psb_c_coo_colsum
procedure, pass(a) :: maxval => psb_lc_coo_maxval end interface
procedure, pass(a) :: spnmi => psb_lc_coo_csnmi
procedure, pass(a) :: spnm1 => psb_lc_coo_csnm1
procedure, pass(a) :: rowsum => psb_lc_coo_rowsum
procedure, pass(a) :: arwsum => psb_lc_coo_arwsum
procedure, pass(a) :: colsum => psb_lc_coo_colsum
procedure, pass(a) :: aclsum => psb_lc_coo_aclsum
end type psb_lc_coo_sparse_mat !>
!! \memberof psb_c_coo_sparse_mat
!! \see psb_c_base_mat_mod::psb_c_base_aclsum
interface
subroutine psb_c_coo_aclsum(d,a)
import
class(psb_c_coo_sparse_mat), intent(in) :: a
real(psb_spk_), intent(out) :: d(:)
end subroutine psb_c_coo_aclsum
end interface
private :: lc_coo_get_nzeros, lc_coo_set_nzeros, & !>
& lc_coo_get_fmt, lc_coo_free, lc_coo_sizeof, & !! \memberof psb_c_coo_sparse_mat
& lc_coo_transp_1mat, lc_coo_transc_1mat !! \see psb_c_base_mat_mod::psb_c_base_get_diag
interface
subroutine psb_c_coo_get_diag(a,d,info)
import
class(psb_c_coo_sparse_mat), intent(in) :: a
complex(psb_spk_), intent(out) :: d(:)
integer(psb_ipk_), intent(out) :: info
end subroutine psb_c_coo_get_diag
end interface
!>
!! \memberof psb_c_coo_sparse_mat
!! \see psb_c_base_mat_mod::psb_c_base_scal
interface
subroutine psb_c_coo_scal(d,a,info,side)
import
class(psb_c_coo_sparse_mat), intent(inout) :: a
complex(psb_spk_), intent(in) :: d(:)
integer(psb_ipk_), intent(out) :: info
character, intent(in), optional :: side
end subroutine psb_c_coo_scal
end interface
!>
!! \memberof psb_c_coo_sparse_mat
!! \see psb_c_base_mat_mod::psb_c_base_scals
interface
subroutine psb_c_coo_scals(d,a,info)
import
class(psb_c_coo_sparse_mat), intent(inout) :: a
complex(psb_spk_), intent(in) :: d
integer(psb_ipk_), intent(out) :: info
end subroutine psb_c_coo_scals
end interface
! == ================= ! == =================
! !
@ -1972,7 +2166,7 @@ module psb_c_base_mat_mod
import import
class(psb_lc_base_sparse_mat), intent(inout) :: a class(psb_lc_base_sparse_mat), intent(inout) :: a
class(psb_c_base_vect_type), intent(inout) :: val class(psb_c_base_vect_type), intent(inout) :: val
class(psb_i_base_vect_type), intent(inout) :: ia, ja class(psb_l_base_vect_type), intent(inout) :: ia, ja
integer(psb_lpk_), intent(in) :: nz, imin, imax,jmin,jmax integer(psb_lpk_), intent(in) :: nz, imin, imax,jmin,jmax
integer(psb_ipk_), intent(out) :: info integer(psb_ipk_), intent(out) :: info
integer(psb_lpk_), intent(in), optional :: gtl(:) integer(psb_lpk_), intent(in), optional :: gtl(:)
@ -2405,6 +2599,150 @@ module psb_c_base_mat_mod
integer(psb_ipk_), intent(out) :: info integer(psb_ipk_), intent(out) :: info
end subroutine psb_lc_base_mv_from_fmt end subroutine psb_lc_base_mv_from_fmt
end interface end interface
!
!> Function cp_to_coo:
!! \memberof psb_lc_base_sparse_mat
!! \brief Copy and convert to psb_lc_coo_sparse_mat
!! Invoked from the source object.
!! \param b The output variable
!! \param info return code
!
interface
subroutine psb_lc_base_cp_to_icoo(a,b,info)
import
class(psb_lc_base_sparse_mat), intent(in) :: a
class(psb_c_coo_sparse_mat), intent(inout) :: b
integer(psb_ipk_), intent(out) :: info
end subroutine psb_lc_base_cp_to_icoo
end interface
!
!> Function cp_from_coo:
!! \memberof psb_lc_base_sparse_mat
!! \brief Copy and convert from psb_lc_coo_sparse_mat
!! Invoked from the target object.
!! \param b The input variable
!! \param info return code
!
interface
subroutine psb_lc_base_cp_from_icoo(a,b,info)
import
class(psb_lc_base_sparse_mat), intent(inout) :: a
class(psb_c_coo_sparse_mat), intent(in) :: b
integer(psb_ipk_), intent(out) :: info
end subroutine psb_lc_base_cp_from_icoo
end interface
!
!> Function cp_to_fmt:
!! \memberof psb_lc_base_sparse_mat
!! \brief Copy and convert to a class(psb_lc_base_sparse_mat)
!! Invoked from the source object. Can be implemented by
!! simply invoking a%cp_to_coo(tmp) and then b%cp_from_coo(tmp).
!! \param b The output variable
!! \param info return code
!
interface
subroutine psb_lc_base_cp_to_ifmt(a,b,info)
import
class(psb_lc_base_sparse_mat), intent(in) :: a
class(psb_c_base_sparse_mat), intent(inout) :: b
integer(psb_ipk_), intent(out) :: info
end subroutine psb_lc_base_cp_to_ifmt
end interface
!
!> Function cp_from_fmt:
!! \memberof psb_lc_base_sparse_mat
!! \brief Copy and convert from a class(psb_lc_base_sparse_mat)
!! Invoked from the target object. Can be implemented by
!! simply invoking b%cp_to_coo(tmp) and then a%cp_from_coo(tmp).
!! \param b The output variable
!! \param info return code
!
interface
subroutine psb_lc_base_cp_from_ifmt(a,b,info)
import
class(psb_lc_base_sparse_mat), intent(inout) :: a
class(psb_c_base_sparse_mat), intent(in) :: b
integer(psb_ipk_), intent(out) :: info
end subroutine psb_lc_base_cp_from_ifmt
end interface
!
!> Function mv_to_coo:
!! \memberof psb_lc_base_sparse_mat
!! \brief Convert to psb_lc_coo_sparse_mat, freeing the source.
!! Invoked from the source object.
!! \param b The output variable
!! \param info return code
!
interface
subroutine psb_lc_base_mv_to_icoo(a,b,info)
import
class(psb_lc_base_sparse_mat), intent(inout) :: a
class(psb_c_coo_sparse_mat), intent(inout) :: b
integer(psb_ipk_), intent(out) :: info
end subroutine psb_lc_base_mv_to_icoo
end interface
!
!> Function mv_from_coo:
!! \memberof psb_lc_base_sparse_mat
!! \brief Convert from psb_lc_coo_sparse_mat, freeing the source.
!! Invoked from the target object.
!! \param b The input variable
!! \param info return code
!
interface
subroutine psb_lc_base_mv_from_icoo(a,b,info)
import
class(psb_lc_base_sparse_mat), intent(inout) :: a
class(psb_c_coo_sparse_mat), intent(inout) :: b
integer(psb_ipk_), intent(out) :: info
end subroutine psb_lc_base_mv_from_icoo
end interface
!
!> Function mv_to_fmt:
!! \memberof psb_lc_base_sparse_mat
!! \brief Convert to a class(psb_lc_base_sparse_mat), freeing the source.
!! Invoked from the source object. Can be implemented by
!! simply invoking a%mv_to_coo(tmp) and then b%mv_from_coo(tmp).
!! \param b The output variable
!! \param info return code
!
interface
subroutine psb_lc_base_mv_to_ifmt(a,b,info)
import
class(psb_lc_base_sparse_mat), intent(inout) :: a
class(psb_c_base_sparse_mat), intent(inout) :: b
integer(psb_ipk_), intent(out) :: info
end subroutine psb_lc_base_mv_to_ifmt
end interface
!
!> Function mv_from_fmt:
!! \memberof psb_lc_base_sparse_mat
!! \brief Convert from a class(psb_lc_base_sparse_mat), freeing the source.
!! Invoked from the target object. Can be implemented by
!! simply invoking b%mv_to_coo(tmp) and then a%mv_from_coo(tmp).
!! \param b The output variable
!! \param info return code
!
interface
subroutine psb_lc_base_mv_from_ifmt(a,b,info)
import
class(psb_lc_base_sparse_mat), intent(inout) :: a
class(psb_c_base_sparse_mat), intent(inout) :: b
integer(psb_ipk_), intent(out) :: info
end subroutine psb_lc_base_mv_from_ifmt
end interface
! !
!> !>
!! \memberof psb_lc_base_sparse_mat !! \memberof psb_lc_base_sparse_mat
@ -3055,7 +3393,8 @@ module psb_c_base_mat_mod
interface interface
subroutine psb_lc_fix_coo_inner(nr,nc,nzin,dupl,ia,ja,val,nzout,info,idir) subroutine psb_lc_fix_coo_inner(nr,nc,nzin,dupl,ia,ja,val,nzout,info,idir)
import import
integer(psb_ipk_), intent(in) :: nr,nc,nzin,dupl integer(psb_lpk_), intent(in) :: nr,nc,nzin
integer(psb_ipk_), intent(in) :: dupl
integer(psb_lpk_), intent(inout) :: ia(:), ja(:) integer(psb_lpk_), intent(inout) :: ia(:), ja(:)
complex(psb_spk_), intent(inout) :: val(:) complex(psb_spk_), intent(inout) :: val(:)
integer(psb_lpk_), intent(out) :: nzout integer(psb_lpk_), intent(out) :: nzout
@ -3105,6 +3444,31 @@ module psb_c_base_mat_mod
end subroutine psb_lc_cp_coo_from_coo end subroutine psb_lc_cp_coo_from_coo
end interface end interface
!>
!! \memberof psb_lc_coo_sparse_mat
!! \see psb_lc_base_mat_mod::psb_lc_base_cp_to_coo
interface
subroutine psb_lc_cp_coo_to_icoo(a,b,info)
import
class(psb_lc_coo_sparse_mat), intent(in) :: a
class(psb_c_coo_sparse_mat), intent(inout) :: b
integer(psb_ipk_), intent(out) :: info
end subroutine psb_lc_cp_coo_to_icoo
end interface
!>
!! \memberof psb_lc_coo_sparse_mat
!! \see psb_lc_base_mat_mod::psb_lc_base_cp_from_coo
interface
subroutine psb_lc_cp_coo_from_icoo(a,b,info)
import
class(psb_lc_coo_sparse_mat), intent(inout) :: a
class(psb_c_coo_sparse_mat), intent(in) :: b
integer(psb_ipk_), intent(out) :: info
end subroutine psb_lc_cp_coo_from_icoo
end interface
!> !>
!! \memberof psb_lc_coo_sparse_mat !! \memberof psb_lc_coo_sparse_mat
!! \see psb_lc_base_mat_mod::psb_lc_base_cp_from_coo !! \see psb_lc_base_mat_mod::psb_lc_base_cp_from_coo
@ -3433,9 +3797,6 @@ module psb_c_base_mat_mod
end interface end interface
contains contains

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

@ -48,6 +48,7 @@ module psb_c_base_vect_mod
use psb_error_mod use psb_error_mod
use psb_realloc_mod use psb_realloc_mod
use psb_i_base_vect_mod use psb_i_base_vect_mod
use psb_l_base_vect_mod
!> \namespace psb_base_mod \class psb_c_base_vect_type !> \namespace psb_base_mod \class psb_c_base_vect_type
!! The psb_c_base_vect_type !! The psb_c_base_vect_type

893
base/modules/serial/psb_d_base_mat_mod.f90
Unescape Escape View File

@ -34,7 +34,6 @@
module psb_d_base_mat_mod module psb_d_base_mat_mod
use psb_base_mat_mod use psb_base_mat_mod
use psb_lbase_mat_mod
use psb_d_base_vect_mod use psb_d_base_vect_mod
@ -80,6 +79,18 @@ module psb_d_base_mat_mod
procedure, pass(a) :: clone => psb_d_base_clone procedure, pass(a) :: clone => psb_d_base_clone
procedure, pass(a) :: make_nonunit => psb_d_base_make_nonunit procedure, pass(a) :: make_nonunit => psb_d_base_make_nonunit
procedure, pass(a) :: clean_zeros => psb_d_base_clean_zeros procedure, pass(a) :: clean_zeros => psb_d_base_clean_zeros
!
! Convert internal indices
!
procedure, pass(a) :: cp_to_lcoo => psb_d_base_cp_to_lcoo
procedure, pass(a) :: cp_from_lcoo => psb_d_base_cp_from_lcoo
procedure, pass(a) :: cp_to_lfmt => psb_d_base_cp_to_lfmt
procedure, pass(a) :: cp_from_lfmt => psb_d_base_cp_from_lfmt
procedure, pass(a) :: mv_to_lcoo => psb_d_base_mv_to_lcoo
procedure, pass(a) :: mv_from_lcoo => psb_d_base_mv_from_lcoo
procedure, pass(a) :: mv_to_lfmt => psb_d_base_mv_to_lfmt
procedure, pass(a) :: mv_from_lfmt => psb_d_base_mv_from_lfmt
! !
! Transpose methods: defined here but not implemented. ! Transpose methods: defined here but not implemented.
@ -159,6 +170,13 @@ module psb_d_base_mat_mod
procedure, pass(a) :: mv_from_coo => psb_d_mv_coo_from_coo procedure, pass(a) :: mv_from_coo => psb_d_mv_coo_from_coo
procedure, pass(a) :: mv_to_fmt => psb_d_mv_coo_to_fmt procedure, pass(a) :: mv_to_fmt => psb_d_mv_coo_to_fmt
procedure, pass(a) :: mv_from_fmt => psb_d_mv_coo_from_fmt procedure, pass(a) :: mv_from_fmt => psb_d_mv_coo_from_fmt
!
! Convert internal indices
!
procedure, pass(a) :: cp_to_lcoo => psb_d_cp_coo_to_lcoo
procedure, pass(a) :: cp_from_lcoo => psb_d_cp_coo_from_lcoo
procedure, pass(a) :: csput_a => psb_d_coo_csput_a procedure, pass(a) :: csput_a => psb_d_coo_csput_a
procedure, pass(a) :: get_diag => psb_d_coo_get_diag procedure, pass(a) :: get_diag => psb_d_coo_get_diag
procedure, pass(a) :: csgetrow => psb_d_coo_csgetrow procedure, pass(a) :: csgetrow => psb_d_coo_csgetrow
@ -216,6 +234,197 @@ module psb_d_base_mat_mod
& d_coo_transp_1mat, d_coo_transc_1mat & d_coo_transp_1mat, d_coo_transc_1mat
!> \namespace psb_base_mod \class psb_ld_base_sparse_mat
!! \extends psb_lbase_mat_mod::psb_lbase_sparse_mat
!! The psb_ld_base_sparse_mat type, extending psb_base_sparse_mat,
!! defines a middle level real(psb_dpk_) sparse matrix object.
!! This class object itself does not have any additional members
!! with respect to those of the base class. Most methods cannot 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.
!!
!! About the method MOLD: this has been defined for those compilers
!! not yet supporting ALLOCATE( ...,MOLD=...); it's otherwise silly to
!! duplicate "by hand" what is specified in the language (in this case F2008)
!!
type, extends(psb_lbase_sparse_mat) :: psb_ld_base_sparse_mat
contains
!
! Data management methods: defined here, but (mostly) not implemented.
!
procedure, pass(a) :: csput_a => psb_ld_base_csput_a
procedure, pass(a) :: csput_v => psb_ld_base_csput_v
generic, public :: csput => csput_a, csput_v
procedure, pass(a) :: csgetrow => psb_ld_base_csgetrow
procedure, pass(a) :: csgetblk => psb_ld_base_csgetblk
procedure, pass(a) :: get_diag => psb_ld_base_get_diag
generic, public :: csget => csgetrow, csgetblk
procedure, pass(a) :: tril => psb_ld_base_tril
procedure, pass(a) :: triu => psb_ld_base_triu
procedure, pass(a) :: csclip => psb_ld_base_csclip
procedure, pass(a) :: cp_to_coo => psb_ld_base_cp_to_coo
procedure, pass(a) :: cp_from_coo => psb_ld_base_cp_from_coo
procedure, pass(a) :: cp_to_fmt => psb_ld_base_cp_to_fmt
procedure, pass(a) :: cp_from_fmt => psb_ld_base_cp_from_fmt
procedure, pass(a) :: mv_to_coo => psb_ld_base_mv_to_coo
procedure, pass(a) :: mv_from_coo => psb_ld_base_mv_from_coo
procedure, pass(a) :: mv_to_fmt => psb_ld_base_mv_to_fmt
procedure, pass(a) :: mv_from_fmt => psb_ld_base_mv_from_fmt
procedure, pass(a) :: mold => psb_ld_base_mold
procedure, pass(a) :: clone => psb_ld_base_clone
procedure, pass(a) :: make_nonunit => psb_ld_base_make_nonunit
procedure, pass(a) :: clean_zeros => psb_ld_base_clean_zeros
!
! Convert internal indices
!
procedure, pass(a) :: cp_to_icoo => psb_ld_base_cp_to_icoo
procedure, pass(a) :: cp_from_icoo => psb_ld_base_cp_from_icoo
procedure, pass(a) :: cp_to_ifmt => psb_ld_base_cp_to_ifmt
procedure, pass(a) :: cp_from_ifmt => psb_ld_base_cp_from_ifmt
procedure, pass(a) :: mv_to_icoo => psb_ld_base_mv_to_icoo
procedure, pass(a) :: mv_from_icoo => psb_ld_base_mv_from_icoo
procedure, pass(a) :: mv_to_ifmt => psb_ld_base_mv_to_ifmt
procedure, pass(a) :: mv_from_ifmt => psb_ld_base_mv_from_ifmt
!
! Transpose methods: defined here but not implemented.
!
procedure, pass(a) :: transp_1mat => psb_ld_base_transp_1mat
procedure, pass(a) :: transp_2mat => psb_ld_base_transp_2mat
procedure, pass(a) :: transc_1mat => psb_ld_base_transc_1mat
procedure, pass(a) :: transc_2mat => psb_ld_base_transc_2mat
!
! Computational methods: defined here but not implemented.
!
procedure, pass(a) :: vect_mv => psb_ld_base_vect_mv
procedure, pass(a) :: csmv => psb_ld_base_csmv
procedure, pass(a) :: csmm => psb_ld_base_csmm
generic, public :: spmm => csmm, csmv, vect_mv
procedure, pass(a) :: in_vect_sv => psb_ld_base_inner_vect_sv
procedure, pass(a) :: inner_cssv => psb_ld_base_inner_cssv
procedure, pass(a) :: inner_cssm => psb_ld_base_inner_cssm
generic, public :: inner_spsm => inner_cssm, inner_cssv, in_vect_sv
procedure, pass(a) :: vect_cssv => psb_ld_base_vect_cssv
procedure, pass(a) :: cssv => psb_ld_base_cssv
procedure, pass(a) :: cssm => psb_ld_base_cssm
generic, public :: spsm => cssm, cssv, vect_cssv
procedure, pass(a) :: scals => psb_ld_base_scals
procedure, pass(a) :: scalv => psb_ld_base_scal
generic, public :: scal => scals, scalv
procedure, pass(a) :: maxval => psb_ld_base_maxval
procedure, pass(a) :: spnmi => psb_ld_base_csnmi
procedure, pass(a) :: spnm1 => psb_ld_base_csnm1
procedure, pass(a) :: rowsum => psb_ld_base_rowsum
procedure, pass(a) :: arwsum => psb_ld_base_arwsum
procedure, pass(a) :: colsum => psb_ld_base_colsum
procedure, pass(a) :: aclsum => psb_ld_base_aclsum
end type psb_ld_base_sparse_mat
private :: ld_base_mat_sync, ld_base_mat_is_host, ld_base_mat_is_dev, &
& ld_base_mat_is_sync, ld_base_mat_set_host, ld_base_mat_set_dev,&
& ld_base_mat_set_sync
!> \namespace psb_base_mod \class psb_ld_coo_sparse_mat
!! \extends psb_ld_base_mat_mod::psb_ld_base_sparse_mat
!!
!! psb_ld_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. It is defined here since all other classes must
!! refer to it per the MEDIATOR design pattern.
!!
type, extends(psb_ld_base_sparse_mat) :: psb_ld_coo_sparse_mat
!> Number of nonzeros.
integer(psb_lpk_) :: nnz
!> Row indices.
integer(psb_lpk_), allocatable :: ia(:)
!> Column indices.
integer(psb_lpk_), allocatable :: ja(:)
!> Coefficient values.
real(psb_dpk_), allocatable :: val(:)
integer, private :: sort_status=psb_unsorted_
contains
!
! Data management methods.
!
procedure, pass(a) :: get_size => ld_coo_get_size
procedure, pass(a) :: get_nzeros => ld_coo_get_nzeros
procedure, nopass :: get_fmt => ld_coo_get_fmt
procedure, pass(a) :: sizeof => ld_coo_sizeof
procedure, pass(a) :: reallocate_nz => psb_ld_coo_reallocate_nz
procedure, pass(a) :: allocate_mnnz => psb_ld_coo_allocate_mnnz
procedure, pass(a) :: cp_to_coo => psb_ld_cp_coo_to_coo
procedure, pass(a) :: cp_from_coo => psb_ld_cp_coo_from_coo
procedure, pass(a) :: cp_to_fmt => psb_ld_cp_coo_to_fmt
procedure, pass(a) :: cp_from_fmt => psb_ld_cp_coo_from_fmt
procedure, pass(a) :: mv_to_coo => psb_ld_mv_coo_to_coo
procedure, pass(a) :: mv_from_coo => psb_ld_mv_coo_from_coo
procedure, pass(a) :: mv_to_fmt => psb_ld_mv_coo_to_fmt
procedure, pass(a) :: mv_from_fmt => psb_ld_mv_coo_from_fmt
procedure, pass(a) :: cp_to_icoo => psb_ld_cp_coo_to_icoo
procedure, pass(a) :: cp_from_icoo => psb_ld_cp_coo_from_icoo
procedure, pass(a) :: csput_a => psb_ld_coo_csput_a
procedure, pass(a) :: get_diag => psb_ld_coo_get_diag
procedure, pass(a) :: csgetrow => psb_ld_coo_csgetrow
procedure, pass(a) :: csgetptn => psb_ld_coo_csgetptn
procedure, pass(a) :: reinit => psb_ld_coo_reinit
procedure, pass(a) :: get_nz_row => psb_ld_coo_get_nz_row
procedure, pass(a) :: fix => psb_ld_fix_coo
procedure, pass(a) :: trim => psb_ld_coo_trim
procedure, pass(a) :: clean_zeros => psb_ld_coo_clean_zeros
procedure, pass(a) :: print => psb_ld_coo_print
procedure, pass(a) :: free => ld_coo_free
procedure, pass(a) :: mold => psb_ld_coo_mold
procedure, pass(a) :: is_sorted => ld_coo_is_sorted
procedure, pass(a) :: is_by_rows => ld_coo_is_by_rows
procedure, pass(a) :: is_by_cols => ld_coo_is_by_cols
procedure, pass(a) :: set_by_rows => ld_coo_set_by_rows
procedure, pass(a) :: set_by_cols => ld_coo_set_by_cols
procedure, pass(a) :: set_sort_status => ld_coo_set_sort_status
procedure, pass(a) :: get_sort_status => ld_coo_get_sort_status
!
! This is COO specific
!
procedure, pass(a) :: set_nzeros => ld_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 => ld_coo_transp_1mat
procedure, pass(a) :: transc_1mat => ld_coo_transc_1mat
!
! Computational methods.
!
procedure, pass(a) :: csmm => psb_ld_coo_csmm
procedure, pass(a) :: csmv => psb_ld_coo_csmv
procedure, pass(a) :: inner_cssm => psb_ld_coo_cssm
procedure, pass(a) :: inner_cssv => psb_ld_coo_cssv
procedure, pass(a) :: scals => psb_ld_coo_scals
procedure, pass(a) :: scalv => psb_ld_coo_scal
procedure, pass(a) :: maxval => psb_ld_coo_maxval
procedure, pass(a) :: spnmi => psb_ld_coo_csnmi
procedure, pass(a) :: spnm1 => psb_ld_coo_csnm1
procedure, pass(a) :: rowsum => psb_ld_coo_rowsum
procedure, pass(a) :: arwsum => psb_ld_coo_arwsum
procedure, pass(a) :: colsum => psb_ld_coo_colsum
procedure, pass(a) :: aclsum => psb_ld_coo_aclsum
end type psb_ld_coo_sparse_mat
private :: ld_coo_get_nzeros, ld_coo_set_nzeros, &
& ld_coo_get_fmt, ld_coo_free, ld_coo_sizeof, &
& ld_coo_transp_1mat, ld_coo_transc_1mat
! == ================= ! == =================
! !
@ -683,12 +892,151 @@ module psb_d_base_mat_mod
!! \param info return code !! \param info return code
! !
interface interface
subroutine psb_d_base_mv_to_fmt(a,b,info) subroutine psb_d_base_mv_to_fmt(a,b,info)
import
class(psb_d_base_sparse_mat), intent(inout) :: a
class(psb_d_base_sparse_mat), intent(inout) :: b
integer(psb_ipk_), intent(out) :: info
end subroutine psb_d_base_mv_to_fmt
end interface
!
!> Function mv_from_fmt:
!! \memberof psb_d_base_sparse_mat
!! \brief Convert from a class(psb_d_base_sparse_mat), freeing the source.
!! Invoked from the target object. Can be implemented by
!! simply invoking b%mv_to_coo(tmp) and then a%mv_from_coo(tmp).
!! \param b The output variable
!! \param info return code
!
interface
subroutine psb_d_base_mv_from_fmt(a,b,info)
import
class(psb_d_base_sparse_mat), intent(inout) :: a
class(psb_d_base_sparse_mat), intent(inout) :: b
integer(psb_ipk_), intent(out) :: info
end subroutine psb_d_base_mv_from_fmt
end interface
!
!> Function cp_to_coo:
!! \memberof psb_d_base_sparse_mat
!! \brief Copy and convert to psb_d_coo_sparse_mat
!! Invoked from the source object.
!! \param b The output variable
!! \param info return code
!
interface
subroutine psb_d_base_cp_to_lcoo(a,b,info)
import
class(psb_d_base_sparse_mat), intent(in) :: a
class(psb_ld_coo_sparse_mat), intent(inout) :: b
integer(psb_ipk_), intent(out) :: info
end subroutine psb_d_base_cp_to_lcoo
end interface
!
!> Function cp_from_coo:
!! \memberof psb_d_base_sparse_mat
!! \brief Copy and convert from psb_d_coo_sparse_mat
!! Invoked from the target object.
!! \param b The input variable
!! \param info return code
!
interface
subroutine psb_d_base_cp_from_lcoo(a,b,info)
import
class(psb_d_base_sparse_mat), intent(inout) :: a
class(psb_ld_coo_sparse_mat), intent(in) :: b
integer(psb_ipk_), intent(out) :: info
end subroutine psb_d_base_cp_from_lcoo
end interface
!
!> Function cp_to_fmt:
!! \memberof psb_d_base_sparse_mat
!! \brief Copy and convert to a class(psb_d_base_sparse_mat)
!! Invoked from the source object. Can be implemented by
!! simply invoking a%cp_to_coo(tmp) and then b%cp_from_coo(tmp).
!! \param b The output variable
!! \param info return code
!
interface
subroutine psb_d_base_cp_to_lfmt(a,b,info)
import
class(psb_d_base_sparse_mat), intent(in) :: a
class(psb_ld_base_sparse_mat), intent(inout) :: b
integer(psb_ipk_), intent(out) :: info
end subroutine psb_d_base_cp_to_lfmt
end interface
!
!> Function cp_from_fmt:
!! \memberof psb_d_base_sparse_mat
!! \brief Copy and convert from a class(psb_d_base_sparse_mat)
!! Invoked from the target object. Can be implemented by
!! simply invoking b%cp_to_coo(tmp) and then a%cp_from_coo(tmp).
!! \param b The output variable
!! \param info return code
!
interface
subroutine psb_d_base_cp_from_lfmt(a,b,info)
import
class(psb_d_base_sparse_mat), intent(inout) :: a
class(psb_ld_base_sparse_mat), intent(in) :: b
integer(psb_ipk_), intent(out) :: info
end subroutine psb_d_base_cp_from_lfmt
end interface
!
!> Function mv_to_coo:
!! \memberof psb_d_base_sparse_mat
!! \brief Convert to psb_d_coo_sparse_mat, freeing the source.
!! Invoked from the source object.
!! \param b The output variable
!! \param info return code
!
interface
subroutine psb_d_base_mv_to_lcoo(a,b,info)
import
class(psb_d_base_sparse_mat), intent(inout) :: a
class(psb_ld_coo_sparse_mat), intent(inout) :: b
integer(psb_ipk_), intent(out) :: info
end subroutine psb_d_base_mv_to_lcoo
end interface
!
!> Function mv_from_coo:
!! \memberof psb_d_base_sparse_mat
!! \brief Convert from psb_d_coo_sparse_mat, freeing the source.
!! Invoked from the target object.
!! \param b The input variable
!! \param info return code
!
interface
subroutine psb_d_base_mv_from_lcoo(a,b,info)
import
class(psb_d_base_sparse_mat), intent(inout) :: a
class(psb_ld_coo_sparse_mat), intent(inout) :: b
integer(psb_ipk_), intent(out) :: info
end subroutine psb_d_base_mv_from_lcoo
end interface
!
!> Function mv_to_fmt:
!! \memberof psb_d_base_sparse_mat
!! \brief Convert to a class(psb_d_base_sparse_mat), freeing the source.
!! Invoked from the source object. Can be implemented by
!! simply invoking a%mv_to_coo(tmp) and then b%mv_from_coo(tmp).
!! \param b The output variable
!! \param info return code
!
interface
subroutine psb_d_base_mv_to_lfmt(a,b,info)
import import
class(psb_d_base_sparse_mat), intent(inout) :: a class(psb_d_base_sparse_mat), intent(inout) :: a
class(psb_d_base_sparse_mat), intent(inout) :: b class(psb_ld_base_sparse_mat), intent(inout) :: b
integer(psb_ipk_), intent(out) :: info integer(psb_ipk_), intent(out) :: info
end subroutine psb_d_base_mv_to_fmt end subroutine psb_d_base_mv_to_lfmt
end interface end interface
! !
@ -701,13 +1049,15 @@ module psb_d_base_mat_mod
!! \param info return code !! \param info return code
! !
interface interface
subroutine psb_d_base_mv_from_fmt(a,b,info) subroutine psb_d_base_mv_from_lfmt(a,b,info)
import import
class(psb_d_base_sparse_mat), intent(inout) :: a class(psb_d_base_sparse_mat), intent(inout) :: a
class(psb_d_base_sparse_mat), intent(inout) :: b class(psb_ld_base_sparse_mat), intent(inout) :: b
integer(psb_ipk_), intent(out) :: info integer(psb_ipk_), intent(out) :: info
end subroutine psb_d_base_mv_from_fmt end subroutine psb_d_base_mv_from_lfmt
end interface end interface
! !
!> !>
!! \memberof psb_d_base_sparse_mat !! \memberof psb_d_base_sparse_mat
@ -1407,6 +1757,29 @@ module psb_d_base_mat_mod
integer(psb_ipk_), intent(out) :: info integer(psb_ipk_), intent(out) :: info
end subroutine psb_d_cp_coo_from_coo end subroutine psb_d_cp_coo_from_coo
end interface end interface
!>
!! \memberof psb_d_coo_sparse_mat
!! \see psb_d_base_mat_mod::psb_d_base_cp_to_coo
interface
subroutine psb_d_cp_coo_to_lcoo(a,b,info)
import
class(psb_d_coo_sparse_mat), intent(in) :: a
class(psb_ld_coo_sparse_mat), intent(inout) :: b
integer(psb_ipk_), intent(out) :: info
end subroutine psb_d_cp_coo_to_lcoo
end interface
!>
!! \memberof psb_d_coo_sparse_mat
!! \see psb_d_base_mat_mod::psb_d_base_cp_from_coo
interface
subroutine psb_d_cp_coo_from_lcoo(a,b,info)
import
class(psb_d_coo_sparse_mat), intent(inout) :: a
class(psb_ld_coo_sparse_mat), intent(in) :: b
integer(psb_ipk_), intent(out) :: info
end subroutine psb_d_cp_coo_from_lcoo
end interface
!> !>
!! \memberof psb_d_coo_sparse_mat !! \memberof psb_d_coo_sparse_mat
@ -1653,266 +2026,87 @@ module psb_d_base_mat_mod
class(psb_d_coo_sparse_mat), intent(in) :: a class(psb_d_coo_sparse_mat), intent(in) :: a
real(psb_dpk_) :: res real(psb_dpk_) :: res
end function psb_d_coo_csnm1 end function psb_d_coo_csnm1
end interface end interface
!>
!! \memberof psb_d_coo_sparse_mat
!! \see psb_d_base_mat_mod::psb_d_base_rowsum
interface
subroutine psb_d_coo_rowsum(d,a)
import
class(psb_d_coo_sparse_mat), intent(in) :: a
real(psb_dpk_), intent(out) :: d(:)
end subroutine psb_d_coo_rowsum
end interface
!>
!! \memberof psb_d_coo_sparse_mat
!! \see psb_d_base_mat_mod::psb_d_base_arwsum
interface
subroutine psb_d_coo_arwsum(d,a)
import
class(psb_d_coo_sparse_mat), intent(in) :: a
real(psb_dpk_), intent(out) :: d(:)
end subroutine psb_d_coo_arwsum
end interface
!>
!! \memberof psb_d_coo_sparse_mat
!! \see psb_d_base_mat_mod::psb_d_base_colsum
interface
subroutine psb_d_coo_colsum(d,a)
import
class(psb_d_coo_sparse_mat), intent(in) :: a
real(psb_dpk_), intent(out) :: d(:)
end subroutine psb_d_coo_colsum
end interface
!>
!! \memberof psb_d_coo_sparse_mat
!! \see psb_d_base_mat_mod::psb_d_base_aclsum
interface
subroutine psb_d_coo_aclsum(d,a)
import
class(psb_d_coo_sparse_mat), intent(in) :: a
real(psb_dpk_), intent(out) :: d(:)
end subroutine psb_d_coo_aclsum
end interface
!>
!! \memberof psb_d_coo_sparse_mat
!! \see psb_d_base_mat_mod::psb_d_base_get_diag
interface
subroutine psb_d_coo_get_diag(a,d,info)
import
class(psb_d_coo_sparse_mat), intent(in) :: a
real(psb_dpk_), intent(out) :: d(:)
integer(psb_ipk_), intent(out) :: info
end subroutine psb_d_coo_get_diag
end interface
!>
!! \memberof psb_d_coo_sparse_mat
!! \see psb_d_base_mat_mod::psb_d_base_scal
interface
subroutine psb_d_coo_scal(d,a,info,side)
import
class(psb_d_coo_sparse_mat), intent(inout) :: a
real(psb_dpk_), intent(in) :: d(:)
integer(psb_ipk_), intent(out) :: info
character, intent(in), optional :: side
end subroutine psb_d_coo_scal
end interface
!>
!! \memberof psb_d_coo_sparse_mat
!! \see psb_d_base_mat_mod::psb_d_base_scals
interface
subroutine psb_d_coo_scals(d,a,info)
import
class(psb_d_coo_sparse_mat), intent(inout) :: a
real(psb_dpk_), intent(in) :: d
integer(psb_ipk_), intent(out) :: info
end subroutine psb_d_coo_scals
end interface
!> \namespace psb_base_mod \class psb_ld_base_sparse_mat
!! \extends psb_lbase_mat_mod::psb_lbase_sparse_mat
!! The psb_ld_base_sparse_mat type, extending psb_base_sparse_mat,
!! defines a middle level real(psb_dpk_) sparse matrix object.
!! This class object itself does not have any additional members
!! with respect to those of the base class. Most methods cannot 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.
!!
!! About the method MOLD: this has been defined for those compilers
!! not yet supporting ALLOCATE( ...,MOLD=...); it's otherwise silly to
!! duplicate "by hand" what is specified in the language (in this case F2008)
!!
type, extends(psb_lbase_sparse_mat) :: psb_ld_base_sparse_mat
contains
!
! Data management methods: defined here, but (mostly) not implemented.
!
procedure, pass(a) :: csput_a => psb_ld_base_csput_a
procedure, pass(a) :: csput_v => psb_ld_base_csput_v
generic, public :: csput => csput_a, csput_v
procedure, pass(a) :: csgetrow => psb_ld_base_csgetrow
procedure, pass(a) :: csgetblk => psb_ld_base_csgetblk
procedure, pass(a) :: get_diag => psb_ld_base_get_diag
generic, public :: csget => csgetrow, csgetblk
procedure, pass(a) :: tril => psb_ld_base_tril
procedure, pass(a) :: triu => psb_ld_base_triu
procedure, pass(a) :: csclip => psb_ld_base_csclip
procedure, pass(a) :: cp_to_coo => psb_ld_base_cp_to_coo
procedure, pass(a) :: cp_from_coo => psb_ld_base_cp_from_coo
procedure, pass(a) :: cp_to_fmt => psb_ld_base_cp_to_fmt
procedure, pass(a) :: cp_from_fmt => psb_ld_base_cp_from_fmt
procedure, pass(a) :: mv_to_coo => psb_ld_base_mv_to_coo
procedure, pass(a) :: mv_from_coo => psb_ld_base_mv_from_coo
procedure, pass(a) :: mv_to_fmt => psb_ld_base_mv_to_fmt
procedure, pass(a) :: mv_from_fmt => psb_ld_base_mv_from_fmt
procedure, pass(a) :: mold => psb_ld_base_mold
procedure, pass(a) :: clone => psb_ld_base_clone
procedure, pass(a) :: make_nonunit => psb_ld_base_make_nonunit
procedure, pass(a) :: clean_zeros => psb_ld_base_clean_zeros
!
! Transpose methods: defined here but not implemented.
!
procedure, pass(a) :: transp_1mat => psb_ld_base_transp_1mat
procedure, pass(a) :: transp_2mat => psb_ld_base_transp_2mat
procedure, pass(a) :: transc_1mat => psb_ld_base_transc_1mat
procedure, pass(a) :: transc_2mat => psb_ld_base_transc_2mat
!
! Computational methods: defined here but not implemented.
!
procedure, pass(a) :: vect_mv => psb_ld_base_vect_mv
procedure, pass(a) :: csmv => psb_ld_base_csmv
procedure, pass(a) :: csmm => psb_ld_base_csmm
generic, public :: spmm => csmm, csmv, vect_mv
procedure, pass(a) :: in_vect_sv => psb_ld_base_inner_vect_sv
procedure, pass(a) :: inner_cssv => psb_ld_base_inner_cssv
procedure, pass(a) :: inner_cssm => psb_ld_base_inner_cssm
generic, public :: inner_spsm => inner_cssm, inner_cssv, in_vect_sv
procedure, pass(a) :: vect_cssv => psb_ld_base_vect_cssv
procedure, pass(a) :: cssv => psb_ld_base_cssv
procedure, pass(a) :: cssm => psb_ld_base_cssm
generic, public :: spsm => cssm, cssv, vect_cssv
procedure, pass(a) :: scals => psb_ld_base_scals
procedure, pass(a) :: scalv => psb_ld_base_scal
generic, public :: scal => scals, scalv
procedure, pass(a) :: maxval => psb_ld_base_maxval
procedure, pass(a) :: spnmi => psb_ld_base_csnmi
procedure, pass(a) :: spnm1 => psb_ld_base_csnm1
procedure, pass(a) :: rowsum => psb_ld_base_rowsum
procedure, pass(a) :: arwsum => psb_ld_base_arwsum
procedure, pass(a) :: colsum => psb_ld_base_colsum
procedure, pass(a) :: aclsum => psb_ld_base_aclsum
end type psb_ld_base_sparse_mat
private :: ld_base_mat_sync, ld_base_mat_is_host, ld_base_mat_is_dev, &
& ld_base_mat_is_sync, ld_base_mat_set_host, ld_base_mat_set_dev,&
& ld_base_mat_set_sync
!> \namespace psb_base_mod \class psb_ld_coo_sparse_mat
!! \extends psb_ld_base_mat_mod::psb_ld_base_sparse_mat
!!
!! psb_ld_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. It is defined here since all other classes must
!! refer to it per the MEDIATOR design pattern.
!!
type, extends(psb_ld_base_sparse_mat) :: psb_ld_coo_sparse_mat
!> Number of nonzeros.
integer(psb_lpk_) :: nnz
!> Row indices.
integer(psb_lpk_), allocatable :: ia(:)
!> Column indices.
integer(psb_lpk_), allocatable :: ja(:)
!> Coefficient values.
real(psb_dpk_), allocatable :: val(:)
integer, private :: sort_status=psb_unsorted_
contains
!
! Data management methods.
!
procedure, pass(a) :: get_size => ld_coo_get_size
procedure, pass(a) :: get_nzeros => ld_coo_get_nzeros
procedure, nopass :: get_fmt => ld_coo_get_fmt
procedure, pass(a) :: sizeof => ld_coo_sizeof
procedure, pass(a) :: reallocate_nz => psb_ld_coo_reallocate_nz
procedure, pass(a) :: allocate_mnnz => psb_ld_coo_allocate_mnnz
procedure, pass(a) :: cp_to_coo => psb_ld_cp_coo_to_coo
procedure, pass(a) :: cp_from_coo => psb_ld_cp_coo_from_coo
procedure, pass(a) :: cp_to_fmt => psb_ld_cp_coo_to_fmt
procedure, pass(a) :: cp_from_fmt => psb_ld_cp_coo_from_fmt
procedure, pass(a) :: mv_to_coo => psb_ld_mv_coo_to_coo
procedure, pass(a) :: mv_from_coo => psb_ld_mv_coo_from_coo
procedure, pass(a) :: mv_to_fmt => psb_ld_mv_coo_to_fmt
procedure, pass(a) :: mv_from_fmt => psb_ld_mv_coo_from_fmt
procedure, pass(a) :: csput_a => psb_ld_coo_csput_a
procedure, pass(a) :: get_diag => psb_ld_coo_get_diag
procedure, pass(a) :: csgetrow => psb_ld_coo_csgetrow
procedure, pass(a) :: csgetptn => psb_ld_coo_csgetptn
procedure, pass(a) :: reinit => psb_ld_coo_reinit
procedure, pass(a) :: get_nz_row => psb_ld_coo_get_nz_row
procedure, pass(a) :: fix => psb_ld_fix_coo
procedure, pass(a) :: trim => psb_ld_coo_trim
procedure, pass(a) :: clean_zeros => psb_ld_coo_clean_zeros
procedure, pass(a) :: print => psb_ld_coo_print
procedure, pass(a) :: free => ld_coo_free
procedure, pass(a) :: mold => psb_ld_coo_mold
procedure, pass(a) :: is_sorted => ld_coo_is_sorted
procedure, pass(a) :: is_by_rows => ld_coo_is_by_rows
procedure, pass(a) :: is_by_cols => ld_coo_is_by_cols
procedure, pass(a) :: set_by_rows => ld_coo_set_by_rows
procedure, pass(a) :: set_by_cols => ld_coo_set_by_cols
procedure, pass(a) :: set_sort_status => ld_coo_set_sort_status
procedure, pass(a) :: get_sort_status => ld_coo_get_sort_status
!
! This is COO specific
!
procedure, pass(a) :: set_nzeros => ld_coo_set_nzeros
! !>
! Transpose methods. These are the base of all !! \memberof psb_d_coo_sparse_mat
! indirection in transpose, together with conversions !! \see psb_d_base_mat_mod::psb_d_base_rowsum
! they are sufficient for all cases. interface
! subroutine psb_d_coo_rowsum(d,a)
procedure, pass(a) :: transp_1mat => ld_coo_transp_1mat import
procedure, pass(a) :: transc_1mat => ld_coo_transc_1mat class(psb_d_coo_sparse_mat), intent(in) :: a
real(psb_dpk_), intent(out) :: d(:)
end subroutine psb_d_coo_rowsum
end interface
!>
!! \memberof psb_d_coo_sparse_mat
!! \see psb_d_base_mat_mod::psb_d_base_arwsum
interface
subroutine psb_d_coo_arwsum(d,a)
import
class(psb_d_coo_sparse_mat), intent(in) :: a
real(psb_dpk_), intent(out) :: d(:)
end subroutine psb_d_coo_arwsum
end interface
! !>
! Computational methods. !! \memberof psb_d_coo_sparse_mat
! !! \see psb_d_base_mat_mod::psb_d_base_colsum
procedure, pass(a) :: csmm => psb_ld_coo_csmm interface
procedure, pass(a) :: csmv => psb_ld_coo_csmv subroutine psb_d_coo_colsum(d,a)
procedure, pass(a) :: inner_cssm => psb_ld_coo_cssm import
procedure, pass(a) :: inner_cssv => psb_ld_coo_cssv class(psb_d_coo_sparse_mat), intent(in) :: a
procedure, pass(a) :: scals => psb_ld_coo_scals real(psb_dpk_), intent(out) :: d(:)
procedure, pass(a) :: scalv => psb_ld_coo_scal end subroutine psb_d_coo_colsum
procedure, pass(a) :: maxval => psb_ld_coo_maxval end interface
procedure, pass(a) :: spnmi => psb_ld_coo_csnmi
procedure, pass(a) :: spnm1 => psb_ld_coo_csnm1
procedure, pass(a) :: rowsum => psb_ld_coo_rowsum
procedure, pass(a) :: arwsum => psb_ld_coo_arwsum
procedure, pass(a) :: colsum => psb_ld_coo_colsum
procedure, pass(a) :: aclsum => psb_ld_coo_aclsum
end type psb_ld_coo_sparse_mat !>
!! \memberof psb_d_coo_sparse_mat
!! \see psb_d_base_mat_mod::psb_d_base_aclsum
interface
subroutine psb_d_coo_aclsum(d,a)
import
class(psb_d_coo_sparse_mat), intent(in) :: a
real(psb_dpk_), intent(out) :: d(:)
end subroutine psb_d_coo_aclsum
end interface
private :: ld_coo_get_nzeros, ld_coo_set_nzeros, & !>
& ld_coo_get_fmt, ld_coo_free, ld_coo_sizeof, & !! \memberof psb_d_coo_sparse_mat
& ld_coo_transp_1mat, ld_coo_transc_1mat !! \see psb_d_base_mat_mod::psb_d_base_get_diag
interface
subroutine psb_d_coo_get_diag(a,d,info)
import
class(psb_d_coo_sparse_mat), intent(in) :: a
real(psb_dpk_), intent(out) :: d(:)
integer(psb_ipk_), intent(out) :: info
end subroutine psb_d_coo_get_diag
end interface
!>
!! \memberof psb_d_coo_sparse_mat
!! \see psb_d_base_mat_mod::psb_d_base_scal
interface
subroutine psb_d_coo_scal(d,a,info,side)
import
class(psb_d_coo_sparse_mat), intent(inout) :: a
real(psb_dpk_), intent(in) :: d(:)
integer(psb_ipk_), intent(out) :: info
character, intent(in), optional :: side
end subroutine psb_d_coo_scal
end interface
!>
!! \memberof psb_d_coo_sparse_mat
!! \see psb_d_base_mat_mod::psb_d_base_scals
interface
subroutine psb_d_coo_scals(d,a,info)
import
class(psb_d_coo_sparse_mat), intent(inout) :: a
real(psb_dpk_), intent(in) :: d
integer(psb_ipk_), intent(out) :: info
end subroutine psb_d_coo_scals
end interface
! == ================= ! == =================
! !
@ -1972,7 +2166,7 @@ module psb_d_base_mat_mod
import import
class(psb_ld_base_sparse_mat), intent(inout) :: a class(psb_ld_base_sparse_mat), intent(inout) :: a
class(psb_d_base_vect_type), intent(inout) :: val class(psb_d_base_vect_type), intent(inout) :: val
class(psb_i_base_vect_type), intent(inout) :: ia, ja class(psb_l_base_vect_type), intent(inout) :: ia, ja
integer(psb_lpk_), intent(in) :: nz, imin, imax,jmin,jmax integer(psb_lpk_), intent(in) :: nz, imin, imax,jmin,jmax
integer(psb_ipk_), intent(out) :: info integer(psb_ipk_), intent(out) :: info
integer(psb_lpk_), intent(in), optional :: gtl(:) integer(psb_lpk_), intent(in), optional :: gtl(:)
@ -2405,6 +2599,150 @@ module psb_d_base_mat_mod
integer(psb_ipk_), intent(out) :: info integer(psb_ipk_), intent(out) :: info
end subroutine psb_ld_base_mv_from_fmt end subroutine psb_ld_base_mv_from_fmt
end interface end interface
!
!> Function cp_to_coo:
!! \memberof psb_ld_base_sparse_mat
!! \brief Copy and convert to psb_ld_coo_sparse_mat
!! Invoked from the source object.
!! \param b The output variable
!! \param info return code
!
interface
subroutine psb_ld_base_cp_to_icoo(a,b,info)
import
class(psb_ld_base_sparse_mat), intent(in) :: a
class(psb_d_coo_sparse_mat), intent(inout) :: b
integer(psb_ipk_), intent(out) :: info
end subroutine psb_ld_base_cp_to_icoo
end interface
!
!> Function cp_from_coo:
!! \memberof psb_ld_base_sparse_mat
!! \brief Copy and convert from psb_ld_coo_sparse_mat
!! Invoked from the target object.
!! \param b The input variable
!! \param info return code
!
interface
subroutine psb_ld_base_cp_from_icoo(a,b,info)
import
class(psb_ld_base_sparse_mat), intent(inout) :: a
class(psb_d_coo_sparse_mat), intent(in) :: b
integer(psb_ipk_), intent(out) :: info
end subroutine psb_ld_base_cp_from_icoo
end interface
!
!> Function cp_to_fmt:
!! \memberof psb_ld_base_sparse_mat
!! \brief Copy and convert to a class(psb_ld_base_sparse_mat)
!! Invoked from the source object. Can be implemented by
!! simply invoking a%cp_to_coo(tmp) and then b%cp_from_coo(tmp).
!! \param b The output variable
!! \param info return code
!
interface
subroutine psb_ld_base_cp_to_ifmt(a,b,info)
import
class(psb_ld_base_sparse_mat), intent(in) :: a
class(psb_d_base_sparse_mat), intent(inout) :: b
integer(psb_ipk_), intent(out) :: info
end subroutine psb_ld_base_cp_to_ifmt
end interface
!
!> Function cp_from_fmt:
!! \memberof psb_ld_base_sparse_mat
!! \brief Copy and convert from a class(psb_ld_base_sparse_mat)
!! Invoked from the target object. Can be implemented by
!! simply invoking b%cp_to_coo(tmp) and then a%cp_from_coo(tmp).
!! \param b The output variable
!! \param info return code
!
interface
subroutine psb_ld_base_cp_from_ifmt(a,b,info)
import
class(psb_ld_base_sparse_mat), intent(inout) :: a
class(psb_d_base_sparse_mat), intent(in) :: b
integer(psb_ipk_), intent(out) :: info
end subroutine psb_ld_base_cp_from_ifmt
end interface
!
!> Function mv_to_coo:
!! \memberof psb_ld_base_sparse_mat
!! \brief Convert to psb_ld_coo_sparse_mat, freeing the source.
!! Invoked from the source object.
!! \param b The output variable
!! \param info return code
!
interface
subroutine psb_ld_base_mv_to_icoo(a,b,info)
import
class(psb_ld_base_sparse_mat), intent(inout) :: a
class(psb_d_coo_sparse_mat), intent(inout) :: b
integer(psb_ipk_), intent(out) :: info
end subroutine psb_ld_base_mv_to_icoo
end interface
!
!> Function mv_from_coo:
!! \memberof psb_ld_base_sparse_mat
!! \brief Convert from psb_ld_coo_sparse_mat, freeing the source.
!! Invoked from the target object.
!! \param b The input variable
!! \param info return code
!
interface
subroutine psb_ld_base_mv_from_icoo(a,b,info)
import
class(psb_ld_base_sparse_mat), intent(inout) :: a
class(psb_d_coo_sparse_mat), intent(inout) :: b
integer(psb_ipk_), intent(out) :: info
end subroutine psb_ld_base_mv_from_icoo
end interface
!
!> Function mv_to_fmt:
!! \memberof psb_ld_base_sparse_mat
!! \brief Convert to a class(psb_ld_base_sparse_mat), freeing the source.
!! Invoked from the source object. Can be implemented by
!! simply invoking a%mv_to_coo(tmp) and then b%mv_from_coo(tmp).
!! \param b The output variable
!! \param info return code
!
interface
subroutine psb_ld_base_mv_to_ifmt(a,b,info)
import
class(psb_ld_base_sparse_mat), intent(inout) :: a
class(psb_d_base_sparse_mat), intent(inout) :: b
integer(psb_ipk_), intent(out) :: info
end subroutine psb_ld_base_mv_to_ifmt
end interface
!
!> Function mv_from_fmt:
!! \memberof psb_ld_base_sparse_mat
!! \brief Convert from a class(psb_ld_base_sparse_mat), freeing the source.
!! Invoked from the target object. Can be implemented by
!! simply invoking b%mv_to_coo(tmp) and then a%mv_from_coo(tmp).
!! \param b The output variable
!! \param info return code
!
interface
subroutine psb_ld_base_mv_from_ifmt(a,b,info)
import
class(psb_ld_base_sparse_mat), intent(inout) :: a
class(psb_d_base_sparse_mat), intent(inout) :: b
integer(psb_ipk_), intent(out) :: info
end subroutine psb_ld_base_mv_from_ifmt
end interface
! !
!> !>
!! \memberof psb_ld_base_sparse_mat !! \memberof psb_ld_base_sparse_mat
@ -3055,7 +3393,8 @@ module psb_d_base_mat_mod
interface interface
subroutine psb_ld_fix_coo_inner(nr,nc,nzin,dupl,ia,ja,val,nzout,info,idir) subroutine psb_ld_fix_coo_inner(nr,nc,nzin,dupl,ia,ja,val,nzout,info,idir)
import import
integer(psb_ipk_), intent(in) :: nr,nc,nzin,dupl integer(psb_lpk_), intent(in) :: nr,nc,nzin
integer(psb_ipk_), intent(in) :: dupl
integer(psb_lpk_), intent(inout) :: ia(:), ja(:) integer(psb_lpk_), intent(inout) :: ia(:), ja(:)
real(psb_dpk_), intent(inout) :: val(:) real(psb_dpk_), intent(inout) :: val(:)
integer(psb_lpk_), intent(out) :: nzout integer(psb_lpk_), intent(out) :: nzout
@ -3105,6 +3444,31 @@ module psb_d_base_mat_mod
end subroutine psb_ld_cp_coo_from_coo end subroutine psb_ld_cp_coo_from_coo
end interface end interface
!>
!! \memberof psb_ld_coo_sparse_mat
!! \see psb_ld_base_mat_mod::psb_ld_base_cp_to_coo
interface
subroutine psb_ld_cp_coo_to_icoo(a,b,info)
import
class(psb_ld_coo_sparse_mat), intent(in) :: a
class(psb_d_coo_sparse_mat), intent(inout) :: b
integer(psb_ipk_), intent(out) :: info
end subroutine psb_ld_cp_coo_to_icoo
end interface
!>
!! \memberof psb_ld_coo_sparse_mat
!! \see psb_ld_base_mat_mod::psb_ld_base_cp_from_coo
interface
subroutine psb_ld_cp_coo_from_icoo(a,b,info)
import
class(psb_ld_coo_sparse_mat), intent(inout) :: a
class(psb_d_coo_sparse_mat), intent(in) :: b
integer(psb_ipk_), intent(out) :: info
end subroutine psb_ld_cp_coo_from_icoo
end interface
!> !>
!! \memberof psb_ld_coo_sparse_mat !! \memberof psb_ld_coo_sparse_mat
!! \see psb_ld_base_mat_mod::psb_ld_base_cp_from_coo !! \see psb_ld_base_mat_mod::psb_ld_base_cp_from_coo
@ -3433,9 +3797,6 @@ module psb_d_base_mat_mod
end interface end interface
contains contains

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

@ -48,6 +48,7 @@ module psb_d_base_vect_mod
use psb_error_mod use psb_error_mod
use psb_realloc_mod use psb_realloc_mod
use psb_i_base_vect_mod use psb_i_base_vect_mod
use psb_l_base_vect_mod
!> \namespace psb_base_mod \class psb_d_base_vect_type !> \namespace psb_base_mod \class psb_d_base_vect_type
!! The psb_d_base_vect_type !! The psb_d_base_vect_type

893
base/modules/serial/psb_s_base_mat_mod.f90
Unescape Escape View File

@ -34,7 +34,6 @@
module psb_s_base_mat_mod module psb_s_base_mat_mod
use psb_base_mat_mod use psb_base_mat_mod
use psb_lbase_mat_mod
use psb_s_base_vect_mod use psb_s_base_vect_mod
@ -80,6 +79,18 @@ module psb_s_base_mat_mod
procedure, pass(a) :: clone => psb_s_base_clone procedure, pass(a) :: clone => psb_s_base_clone
procedure, pass(a) :: make_nonunit => psb_s_base_make_nonunit procedure, pass(a) :: make_nonunit => psb_s_base_make_nonunit
procedure, pass(a) :: clean_zeros => psb_s_base_clean_zeros procedure, pass(a) :: clean_zeros => psb_s_base_clean_zeros
!
! Convert internal indices
!
procedure, pass(a) :: cp_to_lcoo => psb_s_base_cp_to_lcoo
procedure, pass(a) :: cp_from_lcoo => psb_s_base_cp_from_lcoo
procedure, pass(a) :: cp_to_lfmt => psb_s_base_cp_to_lfmt
procedure, pass(a) :: cp_from_lfmt => psb_s_base_cp_from_lfmt
procedure, pass(a) :: mv_to_lcoo => psb_s_base_mv_to_lcoo
procedure, pass(a) :: mv_from_lcoo => psb_s_base_mv_from_lcoo
procedure, pass(a) :: mv_to_lfmt => psb_s_base_mv_to_lfmt
procedure, pass(a) :: mv_from_lfmt => psb_s_base_mv_from_lfmt
! !
! Transpose methods: defined here but not implemented. ! Transpose methods: defined here but not implemented.
@ -159,6 +170,13 @@ module psb_s_base_mat_mod
procedure, pass(a) :: mv_from_coo => psb_s_mv_coo_from_coo procedure, pass(a) :: mv_from_coo => psb_s_mv_coo_from_coo
procedure, pass(a) :: mv_to_fmt => psb_s_mv_coo_to_fmt 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) :: mv_from_fmt => psb_s_mv_coo_from_fmt
!
! Convert internal indices
!
procedure, pass(a) :: cp_to_lcoo => psb_s_cp_coo_to_lcoo
procedure, pass(a) :: cp_from_lcoo => psb_s_cp_coo_from_lcoo
procedure, pass(a) :: csput_a => psb_s_coo_csput_a procedure, pass(a) :: csput_a => psb_s_coo_csput_a
procedure, pass(a) :: get_diag => psb_s_coo_get_diag procedure, pass(a) :: get_diag => psb_s_coo_get_diag
procedure, pass(a) :: csgetrow => psb_s_coo_csgetrow procedure, pass(a) :: csgetrow => psb_s_coo_csgetrow
@ -216,6 +234,197 @@ module psb_s_base_mat_mod
& s_coo_transp_1mat, s_coo_transc_1mat & s_coo_transp_1mat, s_coo_transc_1mat
!> \namespace psb_base_mod \class psb_ls_base_sparse_mat
!! \extends psb_lbase_mat_mod::psb_lbase_sparse_mat
!! The psb_ls_base_sparse_mat type, extending psb_base_sparse_mat,
!! defines a middle level real(psb_spk_) sparse matrix object.
!! This class object itself does not have any additional members
!! with respect to those of the base class. Most methods cannot 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.
!!
!! About the method MOLD: this has been defined for those compilers
!! not yet supporting ALLOCATE( ...,MOLD=...); it's otherwise silly to
!! duplicate "by hand" what is specified in the language (in this case F2008)
!!
type, extends(psb_lbase_sparse_mat) :: psb_ls_base_sparse_mat
contains
!
! Data management methods: defined here, but (mostly) not implemented.
!
procedure, pass(a) :: csput_a => psb_ls_base_csput_a
procedure, pass(a) :: csput_v => psb_ls_base_csput_v
generic, public :: csput => csput_a, csput_v
procedure, pass(a) :: csgetrow => psb_ls_base_csgetrow
procedure, pass(a) :: csgetblk => psb_ls_base_csgetblk
procedure, pass(a) :: get_diag => psb_ls_base_get_diag
generic, public :: csget => csgetrow, csgetblk
procedure, pass(a) :: tril => psb_ls_base_tril
procedure, pass(a) :: triu => psb_ls_base_triu
procedure, pass(a) :: csclip => psb_ls_base_csclip
procedure, pass(a) :: cp_to_coo => psb_ls_base_cp_to_coo
procedure, pass(a) :: cp_from_coo => psb_ls_base_cp_from_coo
procedure, pass(a) :: cp_to_fmt => psb_ls_base_cp_to_fmt
procedure, pass(a) :: cp_from_fmt => psb_ls_base_cp_from_fmt
procedure, pass(a) :: mv_to_coo => psb_ls_base_mv_to_coo
procedure, pass(a) :: mv_from_coo => psb_ls_base_mv_from_coo
procedure, pass(a) :: mv_to_fmt => psb_ls_base_mv_to_fmt
procedure, pass(a) :: mv_from_fmt => psb_ls_base_mv_from_fmt
procedure, pass(a) :: mold => psb_ls_base_mold
procedure, pass(a) :: clone => psb_ls_base_clone
procedure, pass(a) :: make_nonunit => psb_ls_base_make_nonunit
procedure, pass(a) :: clean_zeros => psb_ls_base_clean_zeros
!
! Convert internal indices
!
procedure, pass(a) :: cp_to_icoo => psb_ls_base_cp_to_icoo
procedure, pass(a) :: cp_from_icoo => psb_ls_base_cp_from_icoo
procedure, pass(a) :: cp_to_ifmt => psb_ls_base_cp_to_ifmt
procedure, pass(a) :: cp_from_ifmt => psb_ls_base_cp_from_ifmt
procedure, pass(a) :: mv_to_icoo => psb_ls_base_mv_to_icoo
procedure, pass(a) :: mv_from_icoo => psb_ls_base_mv_from_icoo
procedure, pass(a) :: mv_to_ifmt => psb_ls_base_mv_to_ifmt
procedure, pass(a) :: mv_from_ifmt => psb_ls_base_mv_from_ifmt
!
! Transpose methods: defined here but not implemented.
!
procedure, pass(a) :: transp_1mat => psb_ls_base_transp_1mat
procedure, pass(a) :: transp_2mat => psb_ls_base_transp_2mat
procedure, pass(a) :: transc_1mat => psb_ls_base_transc_1mat
procedure, pass(a) :: transc_2mat => psb_ls_base_transc_2mat
!
! Computational methods: defined here but not implemented.
!
procedure, pass(a) :: vect_mv => psb_ls_base_vect_mv
procedure, pass(a) :: csmv => psb_ls_base_csmv
procedure, pass(a) :: csmm => psb_ls_base_csmm
generic, public :: spmm => csmm, csmv, vect_mv
procedure, pass(a) :: in_vect_sv => psb_ls_base_inner_vect_sv
procedure, pass(a) :: inner_cssv => psb_ls_base_inner_cssv
procedure, pass(a) :: inner_cssm => psb_ls_base_inner_cssm
generic, public :: inner_spsm => inner_cssm, inner_cssv, in_vect_sv
procedure, pass(a) :: vect_cssv => psb_ls_base_vect_cssv
procedure, pass(a) :: cssv => psb_ls_base_cssv
procedure, pass(a) :: cssm => psb_ls_base_cssm
generic, public :: spsm => cssm, cssv, vect_cssv
procedure, pass(a) :: scals => psb_ls_base_scals
procedure, pass(a) :: scalv => psb_ls_base_scal
generic, public :: scal => scals, scalv
procedure, pass(a) :: maxval => psb_ls_base_maxval
procedure, pass(a) :: spnmi => psb_ls_base_csnmi
procedure, pass(a) :: spnm1 => psb_ls_base_csnm1
procedure, pass(a) :: rowsum => psb_ls_base_rowsum
procedure, pass(a) :: arwsum => psb_ls_base_arwsum
procedure, pass(a) :: colsum => psb_ls_base_colsum
procedure, pass(a) :: aclsum => psb_ls_base_aclsum
end type psb_ls_base_sparse_mat
private :: ls_base_mat_sync, ls_base_mat_is_host, ls_base_mat_is_dev, &
& ls_base_mat_is_sync, ls_base_mat_set_host, ls_base_mat_set_dev,&
& ls_base_mat_set_sync
!> \namespace psb_base_mod \class psb_ls_coo_sparse_mat
!! \extends psb_ls_base_mat_mod::psb_ls_base_sparse_mat
!!
!! psb_ls_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. It is defined here since all other classes must
!! refer to it per the MEDIATOR design pattern.
!!
type, extends(psb_ls_base_sparse_mat) :: psb_ls_coo_sparse_mat
!> Number of nonzeros.
integer(psb_lpk_) :: nnz
!> Row indices.
integer(psb_lpk_), allocatable :: ia(:)
!> Column indices.
integer(psb_lpk_), allocatable :: ja(:)
!> Coefficient values.
real(psb_spk_), allocatable :: val(:)
integer, private :: sort_status=psb_unsorted_
contains
!
! Data management methods.
!
procedure, pass(a) :: get_size => ls_coo_get_size
procedure, pass(a) :: get_nzeros => ls_coo_get_nzeros
procedure, nopass :: get_fmt => ls_coo_get_fmt
procedure, pass(a) :: sizeof => ls_coo_sizeof
procedure, pass(a) :: reallocate_nz => psb_ls_coo_reallocate_nz
procedure, pass(a) :: allocate_mnnz => psb_ls_coo_allocate_mnnz
procedure, pass(a) :: cp_to_coo => psb_ls_cp_coo_to_coo
procedure, pass(a) :: cp_from_coo => psb_ls_cp_coo_from_coo
procedure, pass(a) :: cp_to_fmt => psb_ls_cp_coo_to_fmt
procedure, pass(a) :: cp_from_fmt => psb_ls_cp_coo_from_fmt
procedure, pass(a) :: mv_to_coo => psb_ls_mv_coo_to_coo
procedure, pass(a) :: mv_from_coo => psb_ls_mv_coo_from_coo
procedure, pass(a) :: mv_to_fmt => psb_ls_mv_coo_to_fmt
procedure, pass(a) :: mv_from_fmt => psb_ls_mv_coo_from_fmt
procedure, pass(a) :: cp_to_icoo => psb_ls_cp_coo_to_icoo
procedure, pass(a) :: cp_from_icoo => psb_ls_cp_coo_from_icoo
procedure, pass(a) :: csput_a => psb_ls_coo_csput_a
procedure, pass(a) :: get_diag => psb_ls_coo_get_diag
procedure, pass(a) :: csgetrow => psb_ls_coo_csgetrow
procedure, pass(a) :: csgetptn => psb_ls_coo_csgetptn
procedure, pass(a) :: reinit => psb_ls_coo_reinit
procedure, pass(a) :: get_nz_row => psb_ls_coo_get_nz_row
procedure, pass(a) :: fix => psb_ls_fix_coo
procedure, pass(a) :: trim => psb_ls_coo_trim
procedure, pass(a) :: clean_zeros => psb_ls_coo_clean_zeros
procedure, pass(a) :: print => psb_ls_coo_print
procedure, pass(a) :: free => ls_coo_free
procedure, pass(a) :: mold => psb_ls_coo_mold
procedure, pass(a) :: is_sorted => ls_coo_is_sorted
procedure, pass(a) :: is_by_rows => ls_coo_is_by_rows
procedure, pass(a) :: is_by_cols => ls_coo_is_by_cols
procedure, pass(a) :: set_by_rows => ls_coo_set_by_rows
procedure, pass(a) :: set_by_cols => ls_coo_set_by_cols
procedure, pass(a) :: set_sort_status => ls_coo_set_sort_status
procedure, pass(a) :: get_sort_status => ls_coo_get_sort_status
!
! This is COO specific
!
procedure, pass(a) :: set_nzeros => ls_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 => ls_coo_transp_1mat
procedure, pass(a) :: transc_1mat => ls_coo_transc_1mat
!
! Computational methods.
!
procedure, pass(a) :: csmm => psb_ls_coo_csmm
procedure, pass(a) :: csmv => psb_ls_coo_csmv
procedure, pass(a) :: inner_cssm => psb_ls_coo_cssm
procedure, pass(a) :: inner_cssv => psb_ls_coo_cssv
procedure, pass(a) :: scals => psb_ls_coo_scals
procedure, pass(a) :: scalv => psb_ls_coo_scal
procedure, pass(a) :: maxval => psb_ls_coo_maxval
procedure, pass(a) :: spnmi => psb_ls_coo_csnmi
procedure, pass(a) :: spnm1 => psb_ls_coo_csnm1
procedure, pass(a) :: rowsum => psb_ls_coo_rowsum
procedure, pass(a) :: arwsum => psb_ls_coo_arwsum
procedure, pass(a) :: colsum => psb_ls_coo_colsum
procedure, pass(a) :: aclsum => psb_ls_coo_aclsum
end type psb_ls_coo_sparse_mat
private :: ls_coo_get_nzeros, ls_coo_set_nzeros, &
& ls_coo_get_fmt, ls_coo_free, ls_coo_sizeof, &
& ls_coo_transp_1mat, ls_coo_transc_1mat
! == ================= ! == =================
! !
@ -683,12 +892,151 @@ module psb_s_base_mat_mod
!! \param info return code !! \param info return code
! !
interface interface
subroutine psb_s_base_mv_to_fmt(a,b,info) subroutine psb_s_base_mv_to_fmt(a,b,info)
import
class(psb_s_base_sparse_mat), intent(inout) :: a
class(psb_s_base_sparse_mat), intent(inout) :: b
integer(psb_ipk_), intent(out) :: info
end subroutine psb_s_base_mv_to_fmt
end interface
!
!> Function mv_from_fmt:
!! \memberof psb_s_base_sparse_mat
!! \brief Convert from a class(psb_s_base_sparse_mat), freeing the source.
!! Invoked from the target object. Can be implemented by
!! simply invoking b%mv_to_coo(tmp) and then a%mv_from_coo(tmp).
!! \param b The output variable
!! \param info return code
!
interface
subroutine psb_s_base_mv_from_fmt(a,b,info)
import
class(psb_s_base_sparse_mat), intent(inout) :: a
class(psb_s_base_sparse_mat), intent(inout) :: b
integer(psb_ipk_), intent(out) :: info
end subroutine psb_s_base_mv_from_fmt
end interface
!
!> Function cp_to_coo:
!! \memberof psb_s_base_sparse_mat
!! \brief Copy and convert to psb_s_coo_sparse_mat
!! Invoked from the source object.
!! \param b The output variable
!! \param info return code
!
interface
subroutine psb_s_base_cp_to_lcoo(a,b,info)
import
class(psb_s_base_sparse_mat), intent(in) :: a
class(psb_ls_coo_sparse_mat), intent(inout) :: b
integer(psb_ipk_), intent(out) :: info
end subroutine psb_s_base_cp_to_lcoo
end interface
!
!> Function cp_from_coo:
!! \memberof psb_s_base_sparse_mat
!! \brief Copy and convert from psb_s_coo_sparse_mat
!! Invoked from the target object.
!! \param b The input variable
!! \param info return code
!
interface
subroutine psb_s_base_cp_from_lcoo(a,b,info)
import
class(psb_s_base_sparse_mat), intent(inout) :: a
class(psb_ls_coo_sparse_mat), intent(in) :: b
integer(psb_ipk_), intent(out) :: info
end subroutine psb_s_base_cp_from_lcoo
end interface
!
!> Function cp_to_fmt:
!! \memberof psb_s_base_sparse_mat
!! \brief Copy and convert to a class(psb_s_base_sparse_mat)
!! Invoked from the source object. Can be implemented by
!! simply invoking a%cp_to_coo(tmp) and then b%cp_from_coo(tmp).
!! \param b The output variable
!! \param info return code
!
interface
subroutine psb_s_base_cp_to_lfmt(a,b,info)
import
class(psb_s_base_sparse_mat), intent(in) :: a
class(psb_ls_base_sparse_mat), intent(inout) :: b
integer(psb_ipk_), intent(out) :: info
end subroutine psb_s_base_cp_to_lfmt
end interface
!
!> Function cp_from_fmt:
!! \memberof psb_s_base_sparse_mat
!! \brief Copy and convert from a class(psb_s_base_sparse_mat)
!! Invoked from the target object. Can be implemented by
!! simply invoking b%cp_to_coo(tmp) and then a%cp_from_coo(tmp).
!! \param b The output variable
!! \param info return code
!
interface
subroutine psb_s_base_cp_from_lfmt(a,b,info)
import
class(psb_s_base_sparse_mat), intent(inout) :: a
class(psb_ls_base_sparse_mat), intent(in) :: b
integer(psb_ipk_), intent(out) :: info
end subroutine psb_s_base_cp_from_lfmt
end interface
!
!> Function mv_to_coo:
!! \memberof psb_s_base_sparse_mat
!! \brief Convert to psb_s_coo_sparse_mat, freeing the source.
!! Invoked from the source object.
!! \param b The output variable
!! \param info return code
!
interface
subroutine psb_s_base_mv_to_lcoo(a,b,info)
import
class(psb_s_base_sparse_mat), intent(inout) :: a
class(psb_ls_coo_sparse_mat), intent(inout) :: b
integer(psb_ipk_), intent(out) :: info
end subroutine psb_s_base_mv_to_lcoo
end interface
!
!> Function mv_from_coo:
!! \memberof psb_s_base_sparse_mat
!! \brief Convert from psb_s_coo_sparse_mat, freeing the source.
!! Invoked from the target object.
!! \param b The input variable
!! \param info return code
!
interface
subroutine psb_s_base_mv_from_lcoo(a,b,info)
import
class(psb_s_base_sparse_mat), intent(inout) :: a
class(psb_ls_coo_sparse_mat), intent(inout) :: b
integer(psb_ipk_), intent(out) :: info
end subroutine psb_s_base_mv_from_lcoo
end interface
!
!> Function mv_to_fmt:
!! \memberof psb_s_base_sparse_mat
!! \brief Convert to a class(psb_s_base_sparse_mat), freeing the source.
!! Invoked from the source object. Can be implemented by
!! simply invoking a%mv_to_coo(tmp) and then b%mv_from_coo(tmp).
!! \param b The output variable
!! \param info return code
!
interface
subroutine psb_s_base_mv_to_lfmt(a,b,info)
import import
class(psb_s_base_sparse_mat), intent(inout) :: a class(psb_s_base_sparse_mat), intent(inout) :: a
class(psb_s_base_sparse_mat), intent(inout) :: b class(psb_ls_base_sparse_mat), intent(inout) :: b
integer(psb_ipk_), intent(out) :: info integer(psb_ipk_), intent(out) :: info
end subroutine psb_s_base_mv_to_fmt end subroutine psb_s_base_mv_to_lfmt
end interface end interface
! !
@ -701,13 +1049,15 @@ module psb_s_base_mat_mod
!! \param info return code !! \param info return code
! !
interface interface
subroutine psb_s_base_mv_from_fmt(a,b,info) subroutine psb_s_base_mv_from_lfmt(a,b,info)
import import
class(psb_s_base_sparse_mat), intent(inout) :: a class(psb_s_base_sparse_mat), intent(inout) :: a
class(psb_s_base_sparse_mat), intent(inout) :: b class(psb_ls_base_sparse_mat), intent(inout) :: b
integer(psb_ipk_), intent(out) :: info integer(psb_ipk_), intent(out) :: info
end subroutine psb_s_base_mv_from_fmt end subroutine psb_s_base_mv_from_lfmt
end interface end interface
! !
!> !>
!! \memberof psb_s_base_sparse_mat !! \memberof psb_s_base_sparse_mat
@ -1407,6 +1757,29 @@ module psb_s_base_mat_mod
integer(psb_ipk_), intent(out) :: info integer(psb_ipk_), intent(out) :: info
end subroutine psb_s_cp_coo_from_coo end subroutine psb_s_cp_coo_from_coo
end interface end interface
!>
!! \memberof psb_s_coo_sparse_mat
!! \see psb_s_base_mat_mod::psb_s_base_cp_to_coo
interface
subroutine psb_s_cp_coo_to_lcoo(a,b,info)
import
class(psb_s_coo_sparse_mat), intent(in) :: a
class(psb_ls_coo_sparse_mat), intent(inout) :: b
integer(psb_ipk_), intent(out) :: info
end subroutine psb_s_cp_coo_to_lcoo
end interface
!>
!! \memberof psb_s_coo_sparse_mat
!! \see psb_s_base_mat_mod::psb_s_base_cp_from_coo
interface
subroutine psb_s_cp_coo_from_lcoo(a,b,info)
import
class(psb_s_coo_sparse_mat), intent(inout) :: a
class(psb_ls_coo_sparse_mat), intent(in) :: b
integer(psb_ipk_), intent(out) :: info
end subroutine psb_s_cp_coo_from_lcoo
end interface
!> !>
!! \memberof psb_s_coo_sparse_mat !! \memberof psb_s_coo_sparse_mat
@ -1653,266 +2026,87 @@ module psb_s_base_mat_mod
class(psb_s_coo_sparse_mat), intent(in) :: a class(psb_s_coo_sparse_mat), intent(in) :: a
real(psb_spk_) :: res real(psb_spk_) :: res
end function psb_s_coo_csnm1 end function psb_s_coo_csnm1
end interface end interface
!>
!! \memberof psb_s_coo_sparse_mat
!! \see psb_s_base_mat_mod::psb_s_base_rowsum
interface
subroutine psb_s_coo_rowsum(d,a)
import
class(psb_s_coo_sparse_mat), intent(in) :: a
real(psb_spk_), intent(out) :: d(:)
end subroutine psb_s_coo_rowsum
end interface
!>
!! \memberof psb_s_coo_sparse_mat
!! \see psb_s_base_mat_mod::psb_s_base_arwsum
interface
subroutine psb_s_coo_arwsum(d,a)
import
class(psb_s_coo_sparse_mat), intent(in) :: a
real(psb_spk_), intent(out) :: d(:)
end subroutine psb_s_coo_arwsum
end interface
!>
!! \memberof psb_s_coo_sparse_mat
!! \see psb_s_base_mat_mod::psb_s_base_colsum
interface
subroutine psb_s_coo_colsum(d,a)
import
class(psb_s_coo_sparse_mat), intent(in) :: a
real(psb_spk_), intent(out) :: d(:)
end subroutine psb_s_coo_colsum
end interface
!>
!! \memberof psb_s_coo_sparse_mat
!! \see psb_s_base_mat_mod::psb_s_base_aclsum
interface
subroutine psb_s_coo_aclsum(d,a)
import
class(psb_s_coo_sparse_mat), intent(in) :: a
real(psb_spk_), intent(out) :: d(:)
end subroutine psb_s_coo_aclsum
end interface
!>
!! \memberof psb_s_coo_sparse_mat
!! \see psb_s_base_mat_mod::psb_s_base_get_diag
interface
subroutine psb_s_coo_get_diag(a,d,info)
import
class(psb_s_coo_sparse_mat), intent(in) :: a
real(psb_spk_), intent(out) :: d(:)
integer(psb_ipk_), intent(out) :: info
end subroutine psb_s_coo_get_diag
end interface
!>
!! \memberof psb_s_coo_sparse_mat
!! \see psb_s_base_mat_mod::psb_s_base_scal
interface
subroutine psb_s_coo_scal(d,a,info,side)
import
class(psb_s_coo_sparse_mat), intent(inout) :: a
real(psb_spk_), intent(in) :: d(:)
integer(psb_ipk_), intent(out) :: info
character, intent(in), optional :: side
end subroutine psb_s_coo_scal
end interface
!>
!! \memberof psb_s_coo_sparse_mat
!! \see psb_s_base_mat_mod::psb_s_base_scals
interface
subroutine psb_s_coo_scals(d,a,info)
import
class(psb_s_coo_sparse_mat), intent(inout) :: a
real(psb_spk_), intent(in) :: d
integer(psb_ipk_), intent(out) :: info
end subroutine psb_s_coo_scals
end interface
!> \namespace psb_base_mod \class psb_ls_base_sparse_mat
!! \extends psb_lbase_mat_mod::psb_lbase_sparse_mat
!! The psb_ls_base_sparse_mat type, extending psb_base_sparse_mat,
!! defines a middle level real(psb_spk_) sparse matrix object.
!! This class object itself does not have any additional members
!! with respect to those of the base class. Most methods cannot 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.
!!
!! About the method MOLD: this has been defined for those compilers
!! not yet supporting ALLOCATE( ...,MOLD=...); it's otherwise silly to
!! duplicate "by hand" what is specified in the language (in this case F2008)
!!
type, extends(psb_lbase_sparse_mat) :: psb_ls_base_sparse_mat
contains
!
! Data management methods: defined here, but (mostly) not implemented.
!
procedure, pass(a) :: csput_a => psb_ls_base_csput_a
procedure, pass(a) :: csput_v => psb_ls_base_csput_v
generic, public :: csput => csput_a, csput_v
procedure, pass(a) :: csgetrow => psb_ls_base_csgetrow
procedure, pass(a) :: csgetblk => psb_ls_base_csgetblk
procedure, pass(a) :: get_diag => psb_ls_base_get_diag
generic, public :: csget => csgetrow, csgetblk
procedure, pass(a) :: tril => psb_ls_base_tril
procedure, pass(a) :: triu => psb_ls_base_triu
procedure, pass(a) :: csclip => psb_ls_base_csclip
procedure, pass(a) :: cp_to_coo => psb_ls_base_cp_to_coo
procedure, pass(a) :: cp_from_coo => psb_ls_base_cp_from_coo
procedure, pass(a) :: cp_to_fmt => psb_ls_base_cp_to_fmt
procedure, pass(a) :: cp_from_fmt => psb_ls_base_cp_from_fmt
procedure, pass(a) :: mv_to_coo => psb_ls_base_mv_to_coo
procedure, pass(a) :: mv_from_coo => psb_ls_base_mv_from_coo
procedure, pass(a) :: mv_to_fmt => psb_ls_base_mv_to_fmt
procedure, pass(a) :: mv_from_fmt => psb_ls_base_mv_from_fmt
procedure, pass(a) :: mold => psb_ls_base_mold
procedure, pass(a) :: clone => psb_ls_base_clone
procedure, pass(a) :: make_nonunit => psb_ls_base_make_nonunit
procedure, pass(a) :: clean_zeros => psb_ls_base_clean_zeros
!
! Transpose methods: defined here but not implemented.
!
procedure, pass(a) :: transp_1mat => psb_ls_base_transp_1mat
procedure, pass(a) :: transp_2mat => psb_ls_base_transp_2mat
procedure, pass(a) :: transc_1mat => psb_ls_base_transc_1mat
procedure, pass(a) :: transc_2mat => psb_ls_base_transc_2mat
!
! Computational methods: defined here but not implemented.
!
procedure, pass(a) :: vect_mv => psb_ls_base_vect_mv
procedure, pass(a) :: csmv => psb_ls_base_csmv
procedure, pass(a) :: csmm => psb_ls_base_csmm
generic, public :: spmm => csmm, csmv, vect_mv
procedure, pass(a) :: in_vect_sv => psb_ls_base_inner_vect_sv
procedure, pass(a) :: inner_cssv => psb_ls_base_inner_cssv
procedure, pass(a) :: inner_cssm => psb_ls_base_inner_cssm
generic, public :: inner_spsm => inner_cssm, inner_cssv, in_vect_sv
procedure, pass(a) :: vect_cssv => psb_ls_base_vect_cssv
procedure, pass(a) :: cssv => psb_ls_base_cssv
procedure, pass(a) :: cssm => psb_ls_base_cssm
generic, public :: spsm => cssm, cssv, vect_cssv
procedure, pass(a) :: scals => psb_ls_base_scals
procedure, pass(a) :: scalv => psb_ls_base_scal
generic, public :: scal => scals, scalv
procedure, pass(a) :: maxval => psb_ls_base_maxval
procedure, pass(a) :: spnmi => psb_ls_base_csnmi
procedure, pass(a) :: spnm1 => psb_ls_base_csnm1
procedure, pass(a) :: rowsum => psb_ls_base_rowsum
procedure, pass(a) :: arwsum => psb_ls_base_arwsum
procedure, pass(a) :: colsum => psb_ls_base_colsum
procedure, pass(a) :: aclsum => psb_ls_base_aclsum
end type psb_ls_base_sparse_mat
private :: ls_base_mat_sync, ls_base_mat_is_host, ls_base_mat_is_dev, &
& ls_base_mat_is_sync, ls_base_mat_set_host, ls_base_mat_set_dev,&
& ls_base_mat_set_sync
!> \namespace psb_base_mod \class psb_ls_coo_sparse_mat
!! \extends psb_ls_base_mat_mod::psb_ls_base_sparse_mat
!!
!! psb_ls_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. It is defined here since all other classes must
!! refer to it per the MEDIATOR design pattern.
!!
type, extends(psb_ls_base_sparse_mat) :: psb_ls_coo_sparse_mat
!> Number of nonzeros.
integer(psb_lpk_) :: nnz
!> Row indices.
integer(psb_lpk_), allocatable :: ia(:)
!> Column indices.
integer(psb_lpk_), allocatable :: ja(:)
!> Coefficient values.
real(psb_spk_), allocatable :: val(:)
integer, private :: sort_status=psb_unsorted_
contains
!
! Data management methods.
!
procedure, pass(a) :: get_size => ls_coo_get_size
procedure, pass(a) :: get_nzeros => ls_coo_get_nzeros
procedure, nopass :: get_fmt => ls_coo_get_fmt
procedure, pass(a) :: sizeof => ls_coo_sizeof
procedure, pass(a) :: reallocate_nz => psb_ls_coo_reallocate_nz
procedure, pass(a) :: allocate_mnnz => psb_ls_coo_allocate_mnnz
procedure, pass(a) :: cp_to_coo => psb_ls_cp_coo_to_coo
procedure, pass(a) :: cp_from_coo => psb_ls_cp_coo_from_coo
procedure, pass(a) :: cp_to_fmt => psb_ls_cp_coo_to_fmt
procedure, pass(a) :: cp_from_fmt => psb_ls_cp_coo_from_fmt
procedure, pass(a) :: mv_to_coo => psb_ls_mv_coo_to_coo
procedure, pass(a) :: mv_from_coo => psb_ls_mv_coo_from_coo
procedure, pass(a) :: mv_to_fmt => psb_ls_mv_coo_to_fmt
procedure, pass(a) :: mv_from_fmt => psb_ls_mv_coo_from_fmt
procedure, pass(a) :: csput_a => psb_ls_coo_csput_a
procedure, pass(a) :: get_diag => psb_ls_coo_get_diag
procedure, pass(a) :: csgetrow => psb_ls_coo_csgetrow
procedure, pass(a) :: csgetptn => psb_ls_coo_csgetptn
procedure, pass(a) :: reinit => psb_ls_coo_reinit
procedure, pass(a) :: get_nz_row => psb_ls_coo_get_nz_row
procedure, pass(a) :: fix => psb_ls_fix_coo
procedure, pass(a) :: trim => psb_ls_coo_trim
procedure, pass(a) :: clean_zeros => psb_ls_coo_clean_zeros
procedure, pass(a) :: print => psb_ls_coo_print
procedure, pass(a) :: free => ls_coo_free
procedure, pass(a) :: mold => psb_ls_coo_mold
procedure, pass(a) :: is_sorted => ls_coo_is_sorted
procedure, pass(a) :: is_by_rows => ls_coo_is_by_rows
procedure, pass(a) :: is_by_cols => ls_coo_is_by_cols
procedure, pass(a) :: set_by_rows => ls_coo_set_by_rows
procedure, pass(a) :: set_by_cols => ls_coo_set_by_cols
procedure, pass(a) :: set_sort_status => ls_coo_set_sort_status
procedure, pass(a) :: get_sort_status => ls_coo_get_sort_status
!
! This is COO specific
!
procedure, pass(a) :: set_nzeros => ls_coo_set_nzeros
! !>
! Transpose methods. These are the base of all !! \memberof psb_s_coo_sparse_mat
! indirection in transpose, together with conversions !! \see psb_s_base_mat_mod::psb_s_base_rowsum
! they are sufficient for all cases. interface
! subroutine psb_s_coo_rowsum(d,a)
procedure, pass(a) :: transp_1mat => ls_coo_transp_1mat import
procedure, pass(a) :: transc_1mat => ls_coo_transc_1mat class(psb_s_coo_sparse_mat), intent(in) :: a
real(psb_spk_), intent(out) :: d(:)
end subroutine psb_s_coo_rowsum
end interface
!>
!! \memberof psb_s_coo_sparse_mat
!! \see psb_s_base_mat_mod::psb_s_base_arwsum
interface
subroutine psb_s_coo_arwsum(d,a)
import
class(psb_s_coo_sparse_mat), intent(in) :: a
real(psb_spk_), intent(out) :: d(:)
end subroutine psb_s_coo_arwsum
end interface
! !>
! Computational methods. !! \memberof psb_s_coo_sparse_mat
! !! \see psb_s_base_mat_mod::psb_s_base_colsum
procedure, pass(a) :: csmm => psb_ls_coo_csmm interface
procedure, pass(a) :: csmv => psb_ls_coo_csmv subroutine psb_s_coo_colsum(d,a)
procedure, pass(a) :: inner_cssm => psb_ls_coo_cssm import
procedure, pass(a) :: inner_cssv => psb_ls_coo_cssv class(psb_s_coo_sparse_mat), intent(in) :: a
procedure, pass(a) :: scals => psb_ls_coo_scals real(psb_spk_), intent(out) :: d(:)
procedure, pass(a) :: scalv => psb_ls_coo_scal end subroutine psb_s_coo_colsum
procedure, pass(a) :: maxval => psb_ls_coo_maxval end interface
procedure, pass(a) :: spnmi => psb_ls_coo_csnmi
procedure, pass(a) :: spnm1 => psb_ls_coo_csnm1
procedure, pass(a) :: rowsum => psb_ls_coo_rowsum
procedure, pass(a) :: arwsum => psb_ls_coo_arwsum
procedure, pass(a) :: colsum => psb_ls_coo_colsum
procedure, pass(a) :: aclsum => psb_ls_coo_aclsum
end type psb_ls_coo_sparse_mat !>
!! \memberof psb_s_coo_sparse_mat
!! \see psb_s_base_mat_mod::psb_s_base_aclsum
interface
subroutine psb_s_coo_aclsum(d,a)
import
class(psb_s_coo_sparse_mat), intent(in) :: a
real(psb_spk_), intent(out) :: d(:)
end subroutine psb_s_coo_aclsum
end interface
private :: ls_coo_get_nzeros, ls_coo_set_nzeros, & !>
& ls_coo_get_fmt, ls_coo_free, ls_coo_sizeof, & !! \memberof psb_s_coo_sparse_mat
& ls_coo_transp_1mat, ls_coo_transc_1mat !! \see psb_s_base_mat_mod::psb_s_base_get_diag
interface
subroutine psb_s_coo_get_diag(a,d,info)
import
class(psb_s_coo_sparse_mat), intent(in) :: a
real(psb_spk_), intent(out) :: d(:)
integer(psb_ipk_), intent(out) :: info
end subroutine psb_s_coo_get_diag
end interface
!>
!! \memberof psb_s_coo_sparse_mat
!! \see psb_s_base_mat_mod::psb_s_base_scal
interface
subroutine psb_s_coo_scal(d,a,info,side)
import
class(psb_s_coo_sparse_mat), intent(inout) :: a
real(psb_spk_), intent(in) :: d(:)
integer(psb_ipk_), intent(out) :: info
character, intent(in), optional :: side
end subroutine psb_s_coo_scal
end interface
!>
!! \memberof psb_s_coo_sparse_mat
!! \see psb_s_base_mat_mod::psb_s_base_scals
interface
subroutine psb_s_coo_scals(d,a,info)
import
class(psb_s_coo_sparse_mat), intent(inout) :: a
real(psb_spk_), intent(in) :: d
integer(psb_ipk_), intent(out) :: info
end subroutine psb_s_coo_scals
end interface
! == ================= ! == =================
! !
@ -1972,7 +2166,7 @@ module psb_s_base_mat_mod
import import
class(psb_ls_base_sparse_mat), intent(inout) :: a class(psb_ls_base_sparse_mat), intent(inout) :: a
class(psb_s_base_vect_type), intent(inout) :: val class(psb_s_base_vect_type), intent(inout) :: val
class(psb_i_base_vect_type), intent(inout) :: ia, ja class(psb_l_base_vect_type), intent(inout) :: ia, ja
integer(psb_lpk_), intent(in) :: nz, imin, imax,jmin,jmax integer(psb_lpk_), intent(in) :: nz, imin, imax,jmin,jmax
integer(psb_ipk_), intent(out) :: info integer(psb_ipk_), intent(out) :: info
integer(psb_lpk_), intent(in), optional :: gtl(:) integer(psb_lpk_), intent(in), optional :: gtl(:)
@ -2405,6 +2599,150 @@ module psb_s_base_mat_mod
integer(psb_ipk_), intent(out) :: info integer(psb_ipk_), intent(out) :: info
end subroutine psb_ls_base_mv_from_fmt end subroutine psb_ls_base_mv_from_fmt
end interface end interface
!
!> Function cp_to_coo:
!! \memberof psb_ls_base_sparse_mat
!! \brief Copy and convert to psb_ls_coo_sparse_mat
!! Invoked from the source object.
!! \param b The output variable
!! \param info return code
!
interface
subroutine psb_ls_base_cp_to_icoo(a,b,info)
import
class(psb_ls_base_sparse_mat), intent(in) :: a
class(psb_s_coo_sparse_mat), intent(inout) :: b
integer(psb_ipk_), intent(out) :: info
end subroutine psb_ls_base_cp_to_icoo
end interface
!
!> Function cp_from_coo:
!! \memberof psb_ls_base_sparse_mat
!! \brief Copy and convert from psb_ls_coo_sparse_mat
!! Invoked from the target object.
!! \param b The input variable
!! \param info return code
!
interface
subroutine psb_ls_base_cp_from_icoo(a,b,info)
import
class(psb_ls_base_sparse_mat), intent(inout) :: a
class(psb_s_coo_sparse_mat), intent(in) :: b
integer(psb_ipk_), intent(out) :: info
end subroutine psb_ls_base_cp_from_icoo
end interface
!
!> Function cp_to_fmt:
!! \memberof psb_ls_base_sparse_mat
!! \brief Copy and convert to a class(psb_ls_base_sparse_mat)
!! Invoked from the source object. Can be implemented by
!! simply invoking a%cp_to_coo(tmp) and then b%cp_from_coo(tmp).
!! \param b The output variable
!! \param info return code
!
interface
subroutine psb_ls_base_cp_to_ifmt(a,b,info)
import
class(psb_ls_base_sparse_mat), intent(in) :: a
class(psb_s_base_sparse_mat), intent(inout) :: b
integer(psb_ipk_), intent(out) :: info
end subroutine psb_ls_base_cp_to_ifmt
end interface
!
!> Function cp_from_fmt:
!! \memberof psb_ls_base_sparse_mat
!! \brief Copy and convert from a class(psb_ls_base_sparse_mat)
!! Invoked from the target object. Can be implemented by
!! simply invoking b%cp_to_coo(tmp) and then a%cp_from_coo(tmp).
!! \param b The output variable
!! \param info return code
!
interface
subroutine psb_ls_base_cp_from_ifmt(a,b,info)
import
class(psb_ls_base_sparse_mat), intent(inout) :: a
class(psb_s_base_sparse_mat), intent(in) :: b
integer(psb_ipk_), intent(out) :: info
end subroutine psb_ls_base_cp_from_ifmt
end interface
!
!> Function mv_to_coo:
!! \memberof psb_ls_base_sparse_mat
!! \brief Convert to psb_ls_coo_sparse_mat, freeing the source.
!! Invoked from the source object.
!! \param b The output variable
!! \param info return code
!
interface
subroutine psb_ls_base_mv_to_icoo(a,b,info)
import
class(psb_ls_base_sparse_mat), intent(inout) :: a
class(psb_s_coo_sparse_mat), intent(inout) :: b
integer(psb_ipk_), intent(out) :: info
end subroutine psb_ls_base_mv_to_icoo
end interface
!
!> Function mv_from_coo:
!! \memberof psb_ls_base_sparse_mat
!! \brief Convert from psb_ls_coo_sparse_mat, freeing the source.
!! Invoked from the target object.
!! \param b The input variable
!! \param info return code
!
interface
subroutine psb_ls_base_mv_from_icoo(a,b,info)
import
class(psb_ls_base_sparse_mat), intent(inout) :: a
class(psb_s_coo_sparse_mat), intent(inout) :: b
integer(psb_ipk_), intent(out) :: info
end subroutine psb_ls_base_mv_from_icoo
end interface
!
!> Function mv_to_fmt:
!! \memberof psb_ls_base_sparse_mat
!! \brief Convert to a class(psb_ls_base_sparse_mat), freeing the source.
!! Invoked from the source object. Can be implemented by
!! simply invoking a%mv_to_coo(tmp) and then b%mv_from_coo(tmp).
!! \param b The output variable
!! \param info return code
!
interface
subroutine psb_ls_base_mv_to_ifmt(a,b,info)
import
class(psb_ls_base_sparse_mat), intent(inout) :: a
class(psb_s_base_sparse_mat), intent(inout) :: b
integer(psb_ipk_), intent(out) :: info
end subroutine psb_ls_base_mv_to_ifmt
end interface
!
!> Function mv_from_fmt:
!! \memberof psb_ls_base_sparse_mat
!! \brief Convert from a class(psb_ls_base_sparse_mat), freeing the source.
!! Invoked from the target object. Can be implemented by
!! simply invoking b%mv_to_coo(tmp) and then a%mv_from_coo(tmp).
!! \param b The output variable
!! \param info return code
!
interface
subroutine psb_ls_base_mv_from_ifmt(a,b,info)
import
class(psb_ls_base_sparse_mat), intent(inout) :: a
class(psb_s_base_sparse_mat), intent(inout) :: b
integer(psb_ipk_), intent(out) :: info
end subroutine psb_ls_base_mv_from_ifmt
end interface
! !
!> !>
!! \memberof psb_ls_base_sparse_mat !! \memberof psb_ls_base_sparse_mat
@ -3055,7 +3393,8 @@ module psb_s_base_mat_mod
interface interface
subroutine psb_ls_fix_coo_inner(nr,nc,nzin,dupl,ia,ja,val,nzout,info,idir) subroutine psb_ls_fix_coo_inner(nr,nc,nzin,dupl,ia,ja,val,nzout,info,idir)
import import
integer(psb_ipk_), intent(in) :: nr,nc,nzin,dupl integer(psb_lpk_), intent(in) :: nr,nc,nzin
integer(psb_ipk_), intent(in) :: dupl
integer(psb_lpk_), intent(inout) :: ia(:), ja(:) integer(psb_lpk_), intent(inout) :: ia(:), ja(:)
real(psb_spk_), intent(inout) :: val(:) real(psb_spk_), intent(inout) :: val(:)
integer(psb_lpk_), intent(out) :: nzout integer(psb_lpk_), intent(out) :: nzout
@ -3105,6 +3444,31 @@ module psb_s_base_mat_mod
end subroutine psb_ls_cp_coo_from_coo end subroutine psb_ls_cp_coo_from_coo
end interface end interface
!>
!! \memberof psb_ls_coo_sparse_mat
!! \see psb_ls_base_mat_mod::psb_ls_base_cp_to_coo
interface
subroutine psb_ls_cp_coo_to_icoo(a,b,info)
import
class(psb_ls_coo_sparse_mat), intent(in) :: a
class(psb_s_coo_sparse_mat), intent(inout) :: b
integer(psb_ipk_), intent(out) :: info
end subroutine psb_ls_cp_coo_to_icoo
end interface
!>
!! \memberof psb_ls_coo_sparse_mat
!! \see psb_ls_base_mat_mod::psb_ls_base_cp_from_coo
interface
subroutine psb_ls_cp_coo_from_icoo(a,b,info)
import
class(psb_ls_coo_sparse_mat), intent(inout) :: a
class(psb_s_coo_sparse_mat), intent(in) :: b
integer(psb_ipk_), intent(out) :: info
end subroutine psb_ls_cp_coo_from_icoo
end interface
!> !>
!! \memberof psb_ls_coo_sparse_mat !! \memberof psb_ls_coo_sparse_mat
!! \see psb_ls_base_mat_mod::psb_ls_base_cp_from_coo !! \see psb_ls_base_mat_mod::psb_ls_base_cp_from_coo
@ -3433,9 +3797,6 @@ module psb_s_base_mat_mod
end interface end interface
contains contains

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

@ -48,6 +48,7 @@ module psb_s_base_vect_mod
use psb_error_mod use psb_error_mod
use psb_realloc_mod use psb_realloc_mod
use psb_i_base_vect_mod use psb_i_base_vect_mod
use psb_l_base_vect_mod
!> \namespace psb_base_mod \class psb_s_base_vect_type !> \namespace psb_base_mod \class psb_s_base_vect_type
!! The psb_s_base_vect_type !! The psb_s_base_vect_type

893
base/modules/serial/psb_z_base_mat_mod.f90
Unescape Escape View File

@ -34,7 +34,6 @@
module psb_z_base_mat_mod module psb_z_base_mat_mod
use psb_base_mat_mod use psb_base_mat_mod
use psb_lbase_mat_mod
use psb_z_base_vect_mod use psb_z_base_vect_mod
@ -80,6 +79,18 @@ module psb_z_base_mat_mod
procedure, pass(a) :: clone => psb_z_base_clone procedure, pass(a) :: clone => psb_z_base_clone
procedure, pass(a) :: make_nonunit => psb_z_base_make_nonunit procedure, pass(a) :: make_nonunit => psb_z_base_make_nonunit
procedure, pass(a) :: clean_zeros => psb_z_base_clean_zeros procedure, pass(a) :: clean_zeros => psb_z_base_clean_zeros
!
! Convert internal indices
!
procedure, pass(a) :: cp_to_lcoo => psb_z_base_cp_to_lcoo
procedure, pass(a) :: cp_from_lcoo => psb_z_base_cp_from_lcoo
procedure, pass(a) :: cp_to_lfmt => psb_z_base_cp_to_lfmt
procedure, pass(a) :: cp_from_lfmt => psb_z_base_cp_from_lfmt
procedure, pass(a) :: mv_to_lcoo => psb_z_base_mv_to_lcoo
procedure, pass(a) :: mv_from_lcoo => psb_z_base_mv_from_lcoo
procedure, pass(a) :: mv_to_lfmt => psb_z_base_mv_to_lfmt
procedure, pass(a) :: mv_from_lfmt => psb_z_base_mv_from_lfmt
! !
! Transpose methods: defined here but not implemented. ! Transpose methods: defined here but not implemented.
@ -159,6 +170,13 @@ module psb_z_base_mat_mod
procedure, pass(a) :: mv_from_coo => psb_z_mv_coo_from_coo procedure, pass(a) :: mv_from_coo => psb_z_mv_coo_from_coo
procedure, pass(a) :: mv_to_fmt => psb_z_mv_coo_to_fmt procedure, pass(a) :: mv_to_fmt => psb_z_mv_coo_to_fmt
procedure, pass(a) :: mv_from_fmt => psb_z_mv_coo_from_fmt procedure, pass(a) :: mv_from_fmt => psb_z_mv_coo_from_fmt
!
! Convert internal indices
!
procedure, pass(a) :: cp_to_lcoo => psb_z_cp_coo_to_lcoo
procedure, pass(a) :: cp_from_lcoo => psb_z_cp_coo_from_lcoo
procedure, pass(a) :: csput_a => psb_z_coo_csput_a procedure, pass(a) :: csput_a => psb_z_coo_csput_a
procedure, pass(a) :: get_diag => psb_z_coo_get_diag procedure, pass(a) :: get_diag => psb_z_coo_get_diag
procedure, pass(a) :: csgetrow => psb_z_coo_csgetrow procedure, pass(a) :: csgetrow => psb_z_coo_csgetrow
@ -216,6 +234,197 @@ module psb_z_base_mat_mod
& z_coo_transp_1mat, z_coo_transc_1mat & z_coo_transp_1mat, z_coo_transc_1mat
!> \namespace psb_base_mod \class psb_lz_base_sparse_mat
!! \extends psb_lbase_mat_mod::psb_lbase_sparse_mat
!! The psb_lz_base_sparse_mat type, extending psb_base_sparse_mat,
!! defines a middle level complex(psb_dpk_) sparse matrix object.
!! This class object itself does not have any additional members
!! with respect to those of the base class. Most methods cannot 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.
!!
!! About the method MOLD: this has been defined for those compilers
!! not yet supporting ALLOCATE( ...,MOLD=...); it's otherwise silly to
!! duplicate "by hand" what is specified in the language (in this case F2008)
!!
type, extends(psb_lbase_sparse_mat) :: psb_lz_base_sparse_mat
contains
!
! Data management methods: defined here, but (mostly) not implemented.
!
procedure, pass(a) :: csput_a => psb_lz_base_csput_a
procedure, pass(a) :: csput_v => psb_lz_base_csput_v
generic, public :: csput => csput_a, csput_v
procedure, pass(a) :: csgetrow => psb_lz_base_csgetrow
procedure, pass(a) :: csgetblk => psb_lz_base_csgetblk
procedure, pass(a) :: get_diag => psb_lz_base_get_diag
generic, public :: csget => csgetrow, csgetblk
procedure, pass(a) :: tril => psb_lz_base_tril
procedure, pass(a) :: triu => psb_lz_base_triu
procedure, pass(a) :: csclip => psb_lz_base_csclip
procedure, pass(a) :: cp_to_coo => psb_lz_base_cp_to_coo
procedure, pass(a) :: cp_from_coo => psb_lz_base_cp_from_coo
procedure, pass(a) :: cp_to_fmt => psb_lz_base_cp_to_fmt
procedure, pass(a) :: cp_from_fmt => psb_lz_base_cp_from_fmt
procedure, pass(a) :: mv_to_coo => psb_lz_base_mv_to_coo
procedure, pass(a) :: mv_from_coo => psb_lz_base_mv_from_coo
procedure, pass(a) :: mv_to_fmt => psb_lz_base_mv_to_fmt
procedure, pass(a) :: mv_from_fmt => psb_lz_base_mv_from_fmt
procedure, pass(a) :: mold => psb_lz_base_mold
procedure, pass(a) :: clone => psb_lz_base_clone
procedure, pass(a) :: make_nonunit => psb_lz_base_make_nonunit
procedure, pass(a) :: clean_zeros => psb_lz_base_clean_zeros
!
! Convert internal indices
!
procedure, pass(a) :: cp_to_icoo => psb_lz_base_cp_to_icoo
procedure, pass(a) :: cp_from_icoo => psb_lz_base_cp_from_icoo
procedure, pass(a) :: cp_to_ifmt => psb_lz_base_cp_to_ifmt
procedure, pass(a) :: cp_from_ifmt => psb_lz_base_cp_from_ifmt
procedure, pass(a) :: mv_to_icoo => psb_lz_base_mv_to_icoo
procedure, pass(a) :: mv_from_icoo => psb_lz_base_mv_from_icoo
procedure, pass(a) :: mv_to_ifmt => psb_lz_base_mv_to_ifmt
procedure, pass(a) :: mv_from_ifmt => psb_lz_base_mv_from_ifmt
!
! Transpose methods: defined here but not implemented.
!
procedure, pass(a) :: transp_1mat => psb_lz_base_transp_1mat
procedure, pass(a) :: transp_2mat => psb_lz_base_transp_2mat
procedure, pass(a) :: transc_1mat => psb_lz_base_transc_1mat
procedure, pass(a) :: transc_2mat => psb_lz_base_transc_2mat
!
! Computational methods: defined here but not implemented.
!
procedure, pass(a) :: vect_mv => psb_lz_base_vect_mv
procedure, pass(a) :: csmv => psb_lz_base_csmv
procedure, pass(a) :: csmm => psb_lz_base_csmm
generic, public :: spmm => csmm, csmv, vect_mv
procedure, pass(a) :: in_vect_sv => psb_lz_base_inner_vect_sv
procedure, pass(a) :: inner_cssv => psb_lz_base_inner_cssv
procedure, pass(a) :: inner_cssm => psb_lz_base_inner_cssm
generic, public :: inner_spsm => inner_cssm, inner_cssv, in_vect_sv
procedure, pass(a) :: vect_cssv => psb_lz_base_vect_cssv
procedure, pass(a) :: cssv => psb_lz_base_cssv
procedure, pass(a) :: cssm => psb_lz_base_cssm
generic, public :: spsm => cssm, cssv, vect_cssv
procedure, pass(a) :: scals => psb_lz_base_scals
procedure, pass(a) :: scalv => psb_lz_base_scal
generic, public :: scal => scals, scalv
procedure, pass(a) :: maxval => psb_lz_base_maxval
procedure, pass(a) :: spnmi => psb_lz_base_csnmi
procedure, pass(a) :: spnm1 => psb_lz_base_csnm1
procedure, pass(a) :: rowsum => psb_lz_base_rowsum
procedure, pass(a) :: arwsum => psb_lz_base_arwsum
procedure, pass(a) :: colsum => psb_lz_base_colsum
procedure, pass(a) :: aclsum => psb_lz_base_aclsum
end type psb_lz_base_sparse_mat
private :: lz_base_mat_sync, lz_base_mat_is_host, lz_base_mat_is_dev, &
& lz_base_mat_is_sync, lz_base_mat_set_host, lz_base_mat_set_dev,&
& lz_base_mat_set_sync
!> \namespace psb_base_mod \class psb_lz_coo_sparse_mat
!! \extends psb_lz_base_mat_mod::psb_lz_base_sparse_mat
!!
!! psb_lz_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. It is defined here since all other classes must
!! refer to it per the MEDIATOR design pattern.
!!
type, extends(psb_lz_base_sparse_mat) :: psb_lz_coo_sparse_mat
!> Number of nonzeros.
integer(psb_lpk_) :: nnz
!> Row indices.
integer(psb_lpk_), allocatable :: ia(:)
!> Column indices.
integer(psb_lpk_), allocatable :: ja(:)
!> Coefficient values.
complex(psb_dpk_), allocatable :: val(:)
integer, private :: sort_status=psb_unsorted_
contains
!
! Data management methods.
!
procedure, pass(a) :: get_size => lz_coo_get_size
procedure, pass(a) :: get_nzeros => lz_coo_get_nzeros
procedure, nopass :: get_fmt => lz_coo_get_fmt
procedure, pass(a) :: sizeof => lz_coo_sizeof
procedure, pass(a) :: reallocate_nz => psb_lz_coo_reallocate_nz
procedure, pass(a) :: allocate_mnnz => psb_lz_coo_allocate_mnnz
procedure, pass(a) :: cp_to_coo => psb_lz_cp_coo_to_coo
procedure, pass(a) :: cp_from_coo => psb_lz_cp_coo_from_coo
procedure, pass(a) :: cp_to_fmt => psb_lz_cp_coo_to_fmt
procedure, pass(a) :: cp_from_fmt => psb_lz_cp_coo_from_fmt
procedure, pass(a) :: mv_to_coo => psb_lz_mv_coo_to_coo
procedure, pass(a) :: mv_from_coo => psb_lz_mv_coo_from_coo
procedure, pass(a) :: mv_to_fmt => psb_lz_mv_coo_to_fmt
procedure, pass(a) :: mv_from_fmt => psb_lz_mv_coo_from_fmt
procedure, pass(a) :: cp_to_icoo => psb_lz_cp_coo_to_icoo
procedure, pass(a) :: cp_from_icoo => psb_lz_cp_coo_from_icoo
procedure, pass(a) :: csput_a => psb_lz_coo_csput_a
procedure, pass(a) :: get_diag => psb_lz_coo_get_diag
procedure, pass(a) :: csgetrow => psb_lz_coo_csgetrow
procedure, pass(a) :: csgetptn => psb_lz_coo_csgetptn
procedure, pass(a) :: reinit => psb_lz_coo_reinit
procedure, pass(a) :: get_nz_row => psb_lz_coo_get_nz_row
procedure, pass(a) :: fix => psb_lz_fix_coo
procedure, pass(a) :: trim => psb_lz_coo_trim
procedure, pass(a) :: clean_zeros => psb_lz_coo_clean_zeros
procedure, pass(a) :: print => psb_lz_coo_print
procedure, pass(a) :: free => lz_coo_free
procedure, pass(a) :: mold => psb_lz_coo_mold
procedure, pass(a) :: is_sorted => lz_coo_is_sorted
procedure, pass(a) :: is_by_rows => lz_coo_is_by_rows
procedure, pass(a) :: is_by_cols => lz_coo_is_by_cols
procedure, pass(a) :: set_by_rows => lz_coo_set_by_rows
procedure, pass(a) :: set_by_cols => lz_coo_set_by_cols
procedure, pass(a) :: set_sort_status => lz_coo_set_sort_status
procedure, pass(a) :: get_sort_status => lz_coo_get_sort_status
!
! This is COO specific
!
procedure, pass(a) :: set_nzeros => lz_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 => lz_coo_transp_1mat
procedure, pass(a) :: transc_1mat => lz_coo_transc_1mat
!
! Computational methods.
!
procedure, pass(a) :: csmm => psb_lz_coo_csmm
procedure, pass(a) :: csmv => psb_lz_coo_csmv
procedure, pass(a) :: inner_cssm => psb_lz_coo_cssm
procedure, pass(a) :: inner_cssv => psb_lz_coo_cssv
procedure, pass(a) :: scals => psb_lz_coo_scals
procedure, pass(a) :: scalv => psb_lz_coo_scal
procedure, pass(a) :: maxval => psb_lz_coo_maxval
procedure, pass(a) :: spnmi => psb_lz_coo_csnmi
procedure, pass(a) :: spnm1 => psb_lz_coo_csnm1
procedure, pass(a) :: rowsum => psb_lz_coo_rowsum
procedure, pass(a) :: arwsum => psb_lz_coo_arwsum
procedure, pass(a) :: colsum => psb_lz_coo_colsum
procedure, pass(a) :: aclsum => psb_lz_coo_aclsum
end type psb_lz_coo_sparse_mat
private :: lz_coo_get_nzeros, lz_coo_set_nzeros, &
& lz_coo_get_fmt, lz_coo_free, lz_coo_sizeof, &
& lz_coo_transp_1mat, lz_coo_transc_1mat
! == ================= ! == =================
! !
@ -683,12 +892,151 @@ module psb_z_base_mat_mod
!! \param info return code !! \param info return code
! !
interface interface
subroutine psb_z_base_mv_to_fmt(a,b,info) subroutine psb_z_base_mv_to_fmt(a,b,info)
import
class(psb_z_base_sparse_mat), intent(inout) :: a
class(psb_z_base_sparse_mat), intent(inout) :: b
integer(psb_ipk_), intent(out) :: info
end subroutine psb_z_base_mv_to_fmt
end interface
!
!> Function mv_from_fmt:
!! \memberof psb_z_base_sparse_mat
!! \brief Convert from a class(psb_z_base_sparse_mat), freeing the source.
!! Invoked from the target object. Can be implemented by
!! simply invoking b%mv_to_coo(tmp) and then a%mv_from_coo(tmp).
!! \param b The output variable
!! \param info return code
!
interface
subroutine psb_z_base_mv_from_fmt(a,b,info)
import
class(psb_z_base_sparse_mat), intent(inout) :: a
class(psb_z_base_sparse_mat), intent(inout) :: b
integer(psb_ipk_), intent(out) :: info
end subroutine psb_z_base_mv_from_fmt
end interface
!
!> Function cp_to_coo:
!! \memberof psb_z_base_sparse_mat
!! \brief Copy and convert to psb_z_coo_sparse_mat
!! Invoked from the source object.
!! \param b The output variable
!! \param info return code
!
interface
subroutine psb_z_base_cp_to_lcoo(a,b,info)
import
class(psb_z_base_sparse_mat), intent(in) :: a
class(psb_lz_coo_sparse_mat), intent(inout) :: b
integer(psb_ipk_), intent(out) :: info
end subroutine psb_z_base_cp_to_lcoo
end interface
!
!> Function cp_from_coo:
!! \memberof psb_z_base_sparse_mat
!! \brief Copy and convert from psb_z_coo_sparse_mat
!! Invoked from the target object.
!! \param b The input variable
!! \param info return code
!
interface
subroutine psb_z_base_cp_from_lcoo(a,b,info)
import
class(psb_z_base_sparse_mat), intent(inout) :: a
class(psb_lz_coo_sparse_mat), intent(in) :: b
integer(psb_ipk_), intent(out) :: info
end subroutine psb_z_base_cp_from_lcoo
end interface
!
!> Function cp_to_fmt:
!! \memberof psb_z_base_sparse_mat
!! \brief Copy and convert to a class(psb_z_base_sparse_mat)
!! Invoked from the source object. Can be implemented by
!! simply invoking a%cp_to_coo(tmp) and then b%cp_from_coo(tmp).
!! \param b The output variable
!! \param info return code
!
interface
subroutine psb_z_base_cp_to_lfmt(a,b,info)
import
class(psb_z_base_sparse_mat), intent(in) :: a
class(psb_lz_base_sparse_mat), intent(inout) :: b
integer(psb_ipk_), intent(out) :: info
end subroutine psb_z_base_cp_to_lfmt
end interface
!
!> Function cp_from_fmt:
!! \memberof psb_z_base_sparse_mat
!! \brief Copy and convert from a class(psb_z_base_sparse_mat)
!! Invoked from the target object. Can be implemented by
!! simply invoking b%cp_to_coo(tmp) and then a%cp_from_coo(tmp).
!! \param b The output variable
!! \param info return code
!
interface
subroutine psb_z_base_cp_from_lfmt(a,b,info)
import
class(psb_z_base_sparse_mat), intent(inout) :: a
class(psb_lz_base_sparse_mat), intent(in) :: b
integer(psb_ipk_), intent(out) :: info
end subroutine psb_z_base_cp_from_lfmt
end interface
!
!> Function mv_to_coo:
!! \memberof psb_z_base_sparse_mat
!! \brief Convert to psb_z_coo_sparse_mat, freeing the source.
!! Invoked from the source object.
!! \param b The output variable
!! \param info return code
!
interface
subroutine psb_z_base_mv_to_lcoo(a,b,info)
import
class(psb_z_base_sparse_mat), intent(inout) :: a
class(psb_lz_coo_sparse_mat), intent(inout) :: b
integer(psb_ipk_), intent(out) :: info
end subroutine psb_z_base_mv_to_lcoo
end interface
!
!> Function mv_from_coo:
!! \memberof psb_z_base_sparse_mat
!! \brief Convert from psb_z_coo_sparse_mat, freeing the source.
!! Invoked from the target object.
!! \param b The input variable
!! \param info return code
!
interface
subroutine psb_z_base_mv_from_lcoo(a,b,info)
import
class(psb_z_base_sparse_mat), intent(inout) :: a
class(psb_lz_coo_sparse_mat), intent(inout) :: b
integer(psb_ipk_), intent(out) :: info
end subroutine psb_z_base_mv_from_lcoo
end interface
!
!> Function mv_to_fmt:
!! \memberof psb_z_base_sparse_mat
!! \brief Convert to a class(psb_z_base_sparse_mat), freeing the source.
!! Invoked from the source object. Can be implemented by
!! simply invoking a%mv_to_coo(tmp) and then b%mv_from_coo(tmp).
!! \param b The output variable
!! \param info return code
!
interface
subroutine psb_z_base_mv_to_lfmt(a,b,info)
import import
class(psb_z_base_sparse_mat), intent(inout) :: a class(psb_z_base_sparse_mat), intent(inout) :: a
class(psb_z_base_sparse_mat), intent(inout) :: b class(psb_lz_base_sparse_mat), intent(inout) :: b
integer(psb_ipk_), intent(out) :: info integer(psb_ipk_), intent(out) :: info
end subroutine psb_z_base_mv_to_fmt end subroutine psb_z_base_mv_to_lfmt
end interface end interface
! !
@ -701,13 +1049,15 @@ module psb_z_base_mat_mod
!! \param info return code !! \param info return code
! !
interface interface
subroutine psb_z_base_mv_from_fmt(a,b,info) subroutine psb_z_base_mv_from_lfmt(a,b,info)
import import
class(psb_z_base_sparse_mat), intent(inout) :: a class(psb_z_base_sparse_mat), intent(inout) :: a
class(psb_z_base_sparse_mat), intent(inout) :: b class(psb_lz_base_sparse_mat), intent(inout) :: b
integer(psb_ipk_), intent(out) :: info integer(psb_ipk_), intent(out) :: info
end subroutine psb_z_base_mv_from_fmt end subroutine psb_z_base_mv_from_lfmt
end interface end interface
! !
!> !>
!! \memberof psb_z_base_sparse_mat !! \memberof psb_z_base_sparse_mat
@ -1407,6 +1757,29 @@ module psb_z_base_mat_mod
integer(psb_ipk_), intent(out) :: info integer(psb_ipk_), intent(out) :: info
end subroutine psb_z_cp_coo_from_coo end subroutine psb_z_cp_coo_from_coo
end interface end interface
!>
!! \memberof psb_z_coo_sparse_mat
!! \see psb_z_base_mat_mod::psb_z_base_cp_to_coo
interface
subroutine psb_z_cp_coo_to_lcoo(a,b,info)
import
class(psb_z_coo_sparse_mat), intent(in) :: a
class(psb_lz_coo_sparse_mat), intent(inout) :: b
integer(psb_ipk_), intent(out) :: info
end subroutine psb_z_cp_coo_to_lcoo
end interface
!>
!! \memberof psb_z_coo_sparse_mat
!! \see psb_z_base_mat_mod::psb_z_base_cp_from_coo
interface
subroutine psb_z_cp_coo_from_lcoo(a,b,info)
import
class(psb_z_coo_sparse_mat), intent(inout) :: a
class(psb_lz_coo_sparse_mat), intent(in) :: b
integer(psb_ipk_), intent(out) :: info
end subroutine psb_z_cp_coo_from_lcoo
end interface
!> !>
!! \memberof psb_z_coo_sparse_mat !! \memberof psb_z_coo_sparse_mat
@ -1653,266 +2026,87 @@ module psb_z_base_mat_mod
class(psb_z_coo_sparse_mat), intent(in) :: a class(psb_z_coo_sparse_mat), intent(in) :: a
real(psb_dpk_) :: res real(psb_dpk_) :: res
end function psb_z_coo_csnm1 end function psb_z_coo_csnm1
end interface end interface
!>
!! \memberof psb_z_coo_sparse_mat
!! \see psb_z_base_mat_mod::psb_z_base_rowsum
interface
subroutine psb_z_coo_rowsum(d,a)
import
class(psb_z_coo_sparse_mat), intent(in) :: a
complex(psb_dpk_), intent(out) :: d(:)
end subroutine psb_z_coo_rowsum
end interface
!>
!! \memberof psb_z_coo_sparse_mat
!! \see psb_z_base_mat_mod::psb_z_base_arwsum
interface
subroutine psb_z_coo_arwsum(d,a)
import
class(psb_z_coo_sparse_mat), intent(in) :: a
real(psb_dpk_), intent(out) :: d(:)
end subroutine psb_z_coo_arwsum
end interface
!>
!! \memberof psb_z_coo_sparse_mat
!! \see psb_z_base_mat_mod::psb_z_base_colsum
interface
subroutine psb_z_coo_colsum(d,a)
import
class(psb_z_coo_sparse_mat), intent(in) :: a
complex(psb_dpk_), intent(out) :: d(:)
end subroutine psb_z_coo_colsum
end interface
!>
!! \memberof psb_z_coo_sparse_mat
!! \see psb_z_base_mat_mod::psb_z_base_aclsum
interface
subroutine psb_z_coo_aclsum(d,a)
import
class(psb_z_coo_sparse_mat), intent(in) :: a
real(psb_dpk_), intent(out) :: d(:)
end subroutine psb_z_coo_aclsum
end interface
!>
!! \memberof psb_z_coo_sparse_mat
!! \see psb_z_base_mat_mod::psb_z_base_get_diag
interface
subroutine psb_z_coo_get_diag(a,d,info)
import
class(psb_z_coo_sparse_mat), intent(in) :: a
complex(psb_dpk_), intent(out) :: d(:)
integer(psb_ipk_), intent(out) :: info
end subroutine psb_z_coo_get_diag
end interface
!>
!! \memberof psb_z_coo_sparse_mat
!! \see psb_z_base_mat_mod::psb_z_base_scal
interface
subroutine psb_z_coo_scal(d,a,info,side)
import
class(psb_z_coo_sparse_mat), intent(inout) :: a
complex(psb_dpk_), intent(in) :: d(:)
integer(psb_ipk_), intent(out) :: info
character, intent(in), optional :: side
end subroutine psb_z_coo_scal
end interface
!>
!! \memberof psb_z_coo_sparse_mat
!! \see psb_z_base_mat_mod::psb_z_base_scals
interface
subroutine psb_z_coo_scals(d,a,info)
import
class(psb_z_coo_sparse_mat), intent(inout) :: a
complex(psb_dpk_), intent(in) :: d
integer(psb_ipk_), intent(out) :: info
end subroutine psb_z_coo_scals
end interface
!> \namespace psb_base_mod \class psb_lz_base_sparse_mat
!! \extends psb_lbase_mat_mod::psb_lbase_sparse_mat
!! The psb_lz_base_sparse_mat type, extending psb_base_sparse_mat,
!! defines a middle level complex(psb_dpk_) sparse matrix object.
!! This class object itself does not have any additional members
!! with respect to those of the base class. Most methods cannot 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.
!!
!! About the method MOLD: this has been defined for those compilers
!! not yet supporting ALLOCATE( ...,MOLD=...); it's otherwise silly to
!! duplicate "by hand" what is specified in the language (in this case F2008)
!!
type, extends(psb_lbase_sparse_mat) :: psb_lz_base_sparse_mat
contains
!
! Data management methods: defined here, but (mostly) not implemented.
!
procedure, pass(a) :: csput_a => psb_lz_base_csput_a
procedure, pass(a) :: csput_v => psb_lz_base_csput_v
generic, public :: csput => csput_a, csput_v
procedure, pass(a) :: csgetrow => psb_lz_base_csgetrow
procedure, pass(a) :: csgetblk => psb_lz_base_csgetblk
procedure, pass(a) :: get_diag => psb_lz_base_get_diag
generic, public :: csget => csgetrow, csgetblk
procedure, pass(a) :: tril => psb_lz_base_tril
procedure, pass(a) :: triu => psb_lz_base_triu
procedure, pass(a) :: csclip => psb_lz_base_csclip
procedure, pass(a) :: cp_to_coo => psb_lz_base_cp_to_coo
procedure, pass(a) :: cp_from_coo => psb_lz_base_cp_from_coo
procedure, pass(a) :: cp_to_fmt => psb_lz_base_cp_to_fmt
procedure, pass(a) :: cp_from_fmt => psb_lz_base_cp_from_fmt
procedure, pass(a) :: mv_to_coo => psb_lz_base_mv_to_coo
procedure, pass(a) :: mv_from_coo => psb_lz_base_mv_from_coo
procedure, pass(a) :: mv_to_fmt => psb_lz_base_mv_to_fmt
procedure, pass(a) :: mv_from_fmt => psb_lz_base_mv_from_fmt
procedure, pass(a) :: mold => psb_lz_base_mold
procedure, pass(a) :: clone => psb_lz_base_clone
procedure, pass(a) :: make_nonunit => psb_lz_base_make_nonunit
procedure, pass(a) :: clean_zeros => psb_lz_base_clean_zeros
!
! Transpose methods: defined here but not implemented.
!
procedure, pass(a) :: transp_1mat => psb_lz_base_transp_1mat
procedure, pass(a) :: transp_2mat => psb_lz_base_transp_2mat
procedure, pass(a) :: transc_1mat => psb_lz_base_transc_1mat
procedure, pass(a) :: transc_2mat => psb_lz_base_transc_2mat
!
! Computational methods: defined here but not implemented.
!
procedure, pass(a) :: vect_mv => psb_lz_base_vect_mv
procedure, pass(a) :: csmv => psb_lz_base_csmv
procedure, pass(a) :: csmm => psb_lz_base_csmm
generic, public :: spmm => csmm, csmv, vect_mv
procedure, pass(a) :: in_vect_sv => psb_lz_base_inner_vect_sv
procedure, pass(a) :: inner_cssv => psb_lz_base_inner_cssv
procedure, pass(a) :: inner_cssm => psb_lz_base_inner_cssm
generic, public :: inner_spsm => inner_cssm, inner_cssv, in_vect_sv
procedure, pass(a) :: vect_cssv => psb_lz_base_vect_cssv
procedure, pass(a) :: cssv => psb_lz_base_cssv
procedure, pass(a) :: cssm => psb_lz_base_cssm
generic, public :: spsm => cssm, cssv, vect_cssv
procedure, pass(a) :: scals => psb_lz_base_scals
procedure, pass(a) :: scalv => psb_lz_base_scal
generic, public :: scal => scals, scalv
procedure, pass(a) :: maxval => psb_lz_base_maxval
procedure, pass(a) :: spnmi => psb_lz_base_csnmi
procedure, pass(a) :: spnm1 => psb_lz_base_csnm1
procedure, pass(a) :: rowsum => psb_lz_base_rowsum
procedure, pass(a) :: arwsum => psb_lz_base_arwsum
procedure, pass(a) :: colsum => psb_lz_base_colsum
procedure, pass(a) :: aclsum => psb_lz_base_aclsum
end type psb_lz_base_sparse_mat
private :: lz_base_mat_sync, lz_base_mat_is_host, lz_base_mat_is_dev, &
& lz_base_mat_is_sync, lz_base_mat_set_host, lz_base_mat_set_dev,&
& lz_base_mat_set_sync
!> \namespace psb_base_mod \class psb_lz_coo_sparse_mat
!! \extends psb_lz_base_mat_mod::psb_lz_base_sparse_mat
!!
!! psb_lz_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. It is defined here since all other classes must
!! refer to it per the MEDIATOR design pattern.
!!
type, extends(psb_lz_base_sparse_mat) :: psb_lz_coo_sparse_mat
!> Number of nonzeros.
integer(psb_lpk_) :: nnz
!> Row indices.
integer(psb_lpk_), allocatable :: ia(:)
!> Column indices.
integer(psb_lpk_), allocatable :: ja(:)
!> Coefficient values.
complex(psb_dpk_), allocatable :: val(:)
integer, private :: sort_status=psb_unsorted_
contains
!
! Data management methods.
!
procedure, pass(a) :: get_size => lz_coo_get_size
procedure, pass(a) :: get_nzeros => lz_coo_get_nzeros
procedure, nopass :: get_fmt => lz_coo_get_fmt
procedure, pass(a) :: sizeof => lz_coo_sizeof
procedure, pass(a) :: reallocate_nz => psb_lz_coo_reallocate_nz
procedure, pass(a) :: allocate_mnnz => psb_lz_coo_allocate_mnnz
procedure, pass(a) :: cp_to_coo => psb_lz_cp_coo_to_coo
procedure, pass(a) :: cp_from_coo => psb_lz_cp_coo_from_coo
procedure, pass(a) :: cp_to_fmt => psb_lz_cp_coo_to_fmt
procedure, pass(a) :: cp_from_fmt => psb_lz_cp_coo_from_fmt
procedure, pass(a) :: mv_to_coo => psb_lz_mv_coo_to_coo
procedure, pass(a) :: mv_from_coo => psb_lz_mv_coo_from_coo
procedure, pass(a) :: mv_to_fmt => psb_lz_mv_coo_to_fmt
procedure, pass(a) :: mv_from_fmt => psb_lz_mv_coo_from_fmt
procedure, pass(a) :: csput_a => psb_lz_coo_csput_a
procedure, pass(a) :: get_diag => psb_lz_coo_get_diag
procedure, pass(a) :: csgetrow => psb_lz_coo_csgetrow
procedure, pass(a) :: csgetptn => psb_lz_coo_csgetptn
procedure, pass(a) :: reinit => psb_lz_coo_reinit
procedure, pass(a) :: get_nz_row => psb_lz_coo_get_nz_row
procedure, pass(a) :: fix => psb_lz_fix_coo
procedure, pass(a) :: trim => psb_lz_coo_trim
procedure, pass(a) :: clean_zeros => psb_lz_coo_clean_zeros
procedure, pass(a) :: print => psb_lz_coo_print
procedure, pass(a) :: free => lz_coo_free
procedure, pass(a) :: mold => psb_lz_coo_mold
procedure, pass(a) :: is_sorted => lz_coo_is_sorted
procedure, pass(a) :: is_by_rows => lz_coo_is_by_rows
procedure, pass(a) :: is_by_cols => lz_coo_is_by_cols
procedure, pass(a) :: set_by_rows => lz_coo_set_by_rows
procedure, pass(a) :: set_by_cols => lz_coo_set_by_cols
procedure, pass(a) :: set_sort_status => lz_coo_set_sort_status
procedure, pass(a) :: get_sort_status => lz_coo_get_sort_status
!
! This is COO specific
!
procedure, pass(a) :: set_nzeros => lz_coo_set_nzeros
! !>
! Transpose methods. These are the base of all !! \memberof psb_z_coo_sparse_mat
! indirection in transpose, together with conversions !! \see psb_z_base_mat_mod::psb_z_base_rowsum
! they are sufficient for all cases. interface
! subroutine psb_z_coo_rowsum(d,a)
procedure, pass(a) :: transp_1mat => lz_coo_transp_1mat import
procedure, pass(a) :: transc_1mat => lz_coo_transc_1mat class(psb_z_coo_sparse_mat), intent(in) :: a
complex(psb_dpk_), intent(out) :: d(:)
end subroutine psb_z_coo_rowsum
end interface
!>
!! \memberof psb_z_coo_sparse_mat
!! \see psb_z_base_mat_mod::psb_z_base_arwsum
interface
subroutine psb_z_coo_arwsum(d,a)
import
class(psb_z_coo_sparse_mat), intent(in) :: a
real(psb_dpk_), intent(out) :: d(:)
end subroutine psb_z_coo_arwsum
end interface
! !>
! Computational methods. !! \memberof psb_z_coo_sparse_mat
! !! \see psb_z_base_mat_mod::psb_z_base_colsum
procedure, pass(a) :: csmm => psb_lz_coo_csmm interface
procedure, pass(a) :: csmv => psb_lz_coo_csmv subroutine psb_z_coo_colsum(d,a)
procedure, pass(a) :: inner_cssm => psb_lz_coo_cssm import
procedure, pass(a) :: inner_cssv => psb_lz_coo_cssv class(psb_z_coo_sparse_mat), intent(in) :: a
procedure, pass(a) :: scals => psb_lz_coo_scals complex(psb_dpk_), intent(out) :: d(:)
procedure, pass(a) :: scalv => psb_lz_coo_scal end subroutine psb_z_coo_colsum
procedure, pass(a) :: maxval => psb_lz_coo_maxval end interface
procedure, pass(a) :: spnmi => psb_lz_coo_csnmi
procedure, pass(a) :: spnm1 => psb_lz_coo_csnm1
procedure, pass(a) :: rowsum => psb_lz_coo_rowsum
procedure, pass(a) :: arwsum => psb_lz_coo_arwsum
procedure, pass(a) :: colsum => psb_lz_coo_colsum
procedure, pass(a) :: aclsum => psb_lz_coo_aclsum
end type psb_lz_coo_sparse_mat !>
!! \memberof psb_z_coo_sparse_mat
!! \see psb_z_base_mat_mod::psb_z_base_aclsum
interface
subroutine psb_z_coo_aclsum(d,a)
import
class(psb_z_coo_sparse_mat), intent(in) :: a
real(psb_dpk_), intent(out) :: d(:)
end subroutine psb_z_coo_aclsum
end interface
private :: lz_coo_get_nzeros, lz_coo_set_nzeros, & !>
& lz_coo_get_fmt, lz_coo_free, lz_coo_sizeof, & !! \memberof psb_z_coo_sparse_mat
& lz_coo_transp_1mat, lz_coo_transc_1mat !! \see psb_z_base_mat_mod::psb_z_base_get_diag
interface
subroutine psb_z_coo_get_diag(a,d,info)
import
class(psb_z_coo_sparse_mat), intent(in) :: a
complex(psb_dpk_), intent(out) :: d(:)
integer(psb_ipk_), intent(out) :: info
end subroutine psb_z_coo_get_diag
end interface
!>
!! \memberof psb_z_coo_sparse_mat
!! \see psb_z_base_mat_mod::psb_z_base_scal
interface
subroutine psb_z_coo_scal(d,a,info,side)
import
class(psb_z_coo_sparse_mat), intent(inout) :: a
complex(psb_dpk_), intent(in) :: d(:)
integer(psb_ipk_), intent(out) :: info
character, intent(in), optional :: side
end subroutine psb_z_coo_scal
end interface
!>
!! \memberof psb_z_coo_sparse_mat
!! \see psb_z_base_mat_mod::psb_z_base_scals
interface
subroutine psb_z_coo_scals(d,a,info)
import
class(psb_z_coo_sparse_mat), intent(inout) :: a
complex(psb_dpk_), intent(in) :: d
integer(psb_ipk_), intent(out) :: info
end subroutine psb_z_coo_scals
end interface
! == ================= ! == =================
! !
@ -1972,7 +2166,7 @@ module psb_z_base_mat_mod
import import
class(psb_lz_base_sparse_mat), intent(inout) :: a class(psb_lz_base_sparse_mat), intent(inout) :: a
class(psb_z_base_vect_type), intent(inout) :: val class(psb_z_base_vect_type), intent(inout) :: val
class(psb_i_base_vect_type), intent(inout) :: ia, ja class(psb_l_base_vect_type), intent(inout) :: ia, ja
integer(psb_lpk_), intent(in) :: nz, imin, imax,jmin,jmax integer(psb_lpk_), intent(in) :: nz, imin, imax,jmin,jmax
integer(psb_ipk_), intent(out) :: info integer(psb_ipk_), intent(out) :: info
integer(psb_lpk_), intent(in), optional :: gtl(:) integer(psb_lpk_), intent(in), optional :: gtl(:)
@ -2405,6 +2599,150 @@ module psb_z_base_mat_mod
integer(psb_ipk_), intent(out) :: info integer(psb_ipk_), intent(out) :: info
end subroutine psb_lz_base_mv_from_fmt end subroutine psb_lz_base_mv_from_fmt
end interface end interface
!
!> Function cp_to_coo:
!! \memberof psb_lz_base_sparse_mat
!! \brief Copy and convert to psb_lz_coo_sparse_mat
!! Invoked from the source object.
!! \param b The output variable
!! \param info return code
!
interface
subroutine psb_lz_base_cp_to_icoo(a,b,info)
import
class(psb_lz_base_sparse_mat), intent(in) :: a
class(psb_z_coo_sparse_mat), intent(inout) :: b
integer(psb_ipk_), intent(out) :: info
end subroutine psb_lz_base_cp_to_icoo
end interface
!
!> Function cp_from_coo:
!! \memberof psb_lz_base_sparse_mat
!! \brief Copy and convert from psb_lz_coo_sparse_mat
!! Invoked from the target object.
!! \param b The input variable
!! \param info return code
!
interface
subroutine psb_lz_base_cp_from_icoo(a,b,info)
import
class(psb_lz_base_sparse_mat), intent(inout) :: a
class(psb_z_coo_sparse_mat), intent(in) :: b
integer(psb_ipk_), intent(out) :: info
end subroutine psb_lz_base_cp_from_icoo
end interface
!
!> Function cp_to_fmt:
!! \memberof psb_lz_base_sparse_mat
!! \brief Copy and convert to a class(psb_lz_base_sparse_mat)
!! Invoked from the source object. Can be implemented by
!! simply invoking a%cp_to_coo(tmp) and then b%cp_from_coo(tmp).
!! \param b The output variable
!! \param info return code
!
interface
subroutine psb_lz_base_cp_to_ifmt(a,b,info)
import
class(psb_lz_base_sparse_mat), intent(in) :: a
class(psb_z_base_sparse_mat), intent(inout) :: b
integer(psb_ipk_), intent(out) :: info
end subroutine psb_lz_base_cp_to_ifmt
end interface
!
!> Function cp_from_fmt:
!! \memberof psb_lz_base_sparse_mat
!! \brief Copy and convert from a class(psb_lz_base_sparse_mat)
!! Invoked from the target object. Can be implemented by
!! simply invoking b%cp_to_coo(tmp) and then a%cp_from_coo(tmp).
!! \param b The output variable
!! \param info return code
!
interface
subroutine psb_lz_base_cp_from_ifmt(a,b,info)
import
class(psb_lz_base_sparse_mat), intent(inout) :: a
class(psb_z_base_sparse_mat), intent(in) :: b
integer(psb_ipk_), intent(out) :: info
end subroutine psb_lz_base_cp_from_ifmt
end interface
!
!> Function mv_to_coo:
!! \memberof psb_lz_base_sparse_mat
!! \brief Convert to psb_lz_coo_sparse_mat, freeing the source.
!! Invoked from the source object.
!! \param b The output variable
!! \param info return code
!
interface
subroutine psb_lz_base_mv_to_icoo(a,b,info)
import
class(psb_lz_base_sparse_mat), intent(inout) :: a
class(psb_z_coo_sparse_mat), intent(inout) :: b
integer(psb_ipk_), intent(out) :: info
end subroutine psb_lz_base_mv_to_icoo
end interface
!
!> Function mv_from_coo:
!! \memberof psb_lz_base_sparse_mat
!! \brief Convert from psb_lz_coo_sparse_mat, freeing the source.
!! Invoked from the target object.
!! \param b The input variable
!! \param info return code
!
interface
subroutine psb_lz_base_mv_from_icoo(a,b,info)
import
class(psb_lz_base_sparse_mat), intent(inout) :: a
class(psb_z_coo_sparse_mat), intent(inout) :: b
integer(psb_ipk_), intent(out) :: info
end subroutine psb_lz_base_mv_from_icoo
end interface
!
!> Function mv_to_fmt:
!! \memberof psb_lz_base_sparse_mat
!! \brief Convert to a class(psb_lz_base_sparse_mat), freeing the source.
!! Invoked from the source object. Can be implemented by
!! simply invoking a%mv_to_coo(tmp) and then b%mv_from_coo(tmp).
!! \param b The output variable
!! \param info return code
!
interface
subroutine psb_lz_base_mv_to_ifmt(a,b,info)
import
class(psb_lz_base_sparse_mat), intent(inout) :: a
class(psb_z_base_sparse_mat), intent(inout) :: b
integer(psb_ipk_), intent(out) :: info
end subroutine psb_lz_base_mv_to_ifmt
end interface
!
!> Function mv_from_fmt:
!! \memberof psb_lz_base_sparse_mat
!! \brief Convert from a class(psb_lz_base_sparse_mat), freeing the source.
!! Invoked from the target object. Can be implemented by
!! simply invoking b%mv_to_coo(tmp) and then a%mv_from_coo(tmp).
!! \param b The output variable
!! \param info return code
!
interface
subroutine psb_lz_base_mv_from_ifmt(a,b,info)
import
class(psb_lz_base_sparse_mat), intent(inout) :: a
class(psb_z_base_sparse_mat), intent(inout) :: b
integer(psb_ipk_), intent(out) :: info
end subroutine psb_lz_base_mv_from_ifmt
end interface
! !
!> !>
!! \memberof psb_lz_base_sparse_mat !! \memberof psb_lz_base_sparse_mat
@ -3055,7 +3393,8 @@ module psb_z_base_mat_mod
interface interface
subroutine psb_lz_fix_coo_inner(nr,nc,nzin,dupl,ia,ja,val,nzout,info,idir) subroutine psb_lz_fix_coo_inner(nr,nc,nzin,dupl,ia,ja,val,nzout,info,idir)
import import
integer(psb_ipk_), intent(in) :: nr,nc,nzin,dupl integer(psb_lpk_), intent(in) :: nr,nc,nzin
integer(psb_ipk_), intent(in) :: dupl
integer(psb_lpk_), intent(inout) :: ia(:), ja(:) integer(psb_lpk_), intent(inout) :: ia(:), ja(:)
complex(psb_dpk_), intent(inout) :: val(:) complex(psb_dpk_), intent(inout) :: val(:)
integer(psb_lpk_), intent(out) :: nzout integer(psb_lpk_), intent(out) :: nzout
@ -3105,6 +3444,31 @@ module psb_z_base_mat_mod
end subroutine psb_lz_cp_coo_from_coo end subroutine psb_lz_cp_coo_from_coo
end interface end interface
!>
!! \memberof psb_lz_coo_sparse_mat
!! \see psb_lz_base_mat_mod::psb_lz_base_cp_to_coo
interface
subroutine psb_lz_cp_coo_to_icoo(a,b,info)
import
class(psb_lz_coo_sparse_mat), intent(in) :: a
class(psb_z_coo_sparse_mat), intent(inout) :: b
integer(psb_ipk_), intent(out) :: info
end subroutine psb_lz_cp_coo_to_icoo
end interface
!>
!! \memberof psb_lz_coo_sparse_mat
!! \see psb_lz_base_mat_mod::psb_lz_base_cp_from_coo
interface
subroutine psb_lz_cp_coo_from_icoo(a,b,info)
import
class(psb_lz_coo_sparse_mat), intent(inout) :: a
class(psb_z_coo_sparse_mat), intent(in) :: b
integer(psb_ipk_), intent(out) :: info
end subroutine psb_lz_cp_coo_from_icoo
end interface
!> !>
!! \memberof psb_lz_coo_sparse_mat !! \memberof psb_lz_coo_sparse_mat
!! \see psb_lz_base_mat_mod::psb_lz_base_cp_from_coo !! \see psb_lz_base_mat_mod::psb_lz_base_cp_from_coo
@ -3433,9 +3797,6 @@ module psb_z_base_mat_mod
end interface end interface
contains contains

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

@ -48,6 +48,7 @@ module psb_z_base_vect_mod
use psb_error_mod use psb_error_mod
use psb_realloc_mod use psb_realloc_mod
use psb_i_base_vect_mod use psb_i_base_vect_mod
use psb_l_base_vect_mod
!> \namespace psb_base_mod \class psb_z_base_vect_type !> \namespace psb_base_mod \class psb_z_base_vect_type
!! The psb_z_base_vect_type !! The psb_z_base_vect_type

16
base/serial/impl/Makefile
Unescape Escape View File

@ -3,11 +3,17 @@ include ../../../Make.inc
# #
# The object files # The object files
# #
BOBJS=psb_base_mat_impl.o psb_s_base_mat_impl.o psb_d_base_mat_impl.o psb_c_base_mat_impl.o psb_z_base_mat_impl.o BOBJS=psb_base_mat_impl.o \
SOBJS=psb_s_csr_impl.o psb_s_coo_impl.o psb_s_csc_impl.o psb_s_mat_impl.o psb_s_base_mat_impl.o psb_d_base_mat_impl.o psb_c_base_mat_impl.o psb_z_base_mat_impl.o \
DOBJS=psb_d_csr_impl.o psb_d_coo_impl.o psb_d_csc_impl.o psb_d_mat_impl.o psb_s_lbase_mat_impl.o psb_d_lbase_mat_impl.o psb_c_lbase_mat_impl.o psb_z_lbase_mat_impl.o
COBJS=psb_c_csr_impl.o psb_c_coo_impl.o psb_c_csc_impl.o psb_c_mat_impl.o SOBJS=psb_s_csr_impl.o psb_s_coo_impl.o psb_s_csc_impl.o psb_s_mat_impl.o \
ZOBJS=psb_z_csr_impl.o psb_z_coo_impl.o psb_z_csc_impl.o psb_z_mat_impl.o psb_s_lcoo_impl.o
DOBJS=psb_d_csr_impl.o psb_d_coo_impl.o psb_d_csc_impl.o psb_d_mat_impl.o \
psb_d_lcoo_impl.o
COBJS=psb_c_csr_impl.o psb_c_coo_impl.o psb_c_csc_impl.o psb_c_mat_impl.o \
psb_c_lcoo_impl.o
ZOBJS=psb_z_csr_impl.o psb_z_coo_impl.o psb_z_csc_impl.o psb_z_mat_impl.o \
psb_z_lcoo_impl.o
OBJS=$(BOBJS) $(SOBJS) $(DOBJS) $(COBJS) $(ZOBJS) OBJS=$(BOBJS) $(SOBJS) $(DOBJS) $(COBJS) $(ZOBJS)

Write Preview
Loading…
Cancel
Save