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

Fold LX into X files.

Browse Source
ILmat
Salvatore Filippone 8 years ago
parent 13ded391b4
commit c0e676dab7
14 changed files with 0 additions and 31498 deletions
Show Stats Download Patch File Download Diff File

901
base/modules/serial/psb_lbase_mat_mod.f90
Unescape Escape View File

@ -1,901 +0,0 @@
!
! Parallel Sparse BLAS version 3.5
! (C) Copyright 2006-2018
! Salvatore Filippone
! Alfredo Buttari
!
! Redistribution and use in source and binary forms, with or without
! modification, are permitted provided that the following conditions
! are met:
! 1. Redistributions of source code must retain the above copyright
! notice, this list of conditions and the following disclaimer.
! 2. Redistributions in binary form must reproduce the above copyright
! notice, this list of conditions, and the following disclaimer in the
! documentation and/or other materials provided with the distribution.
! 3. The name of the PSBLAS group or the names of its contributors may
! not be used to endorse or promote products derived from this
! software without specific written permission.
!
! THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS
! ``AS IS'' AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED
! TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR
! PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE PSBLAS GROUP OR ITS CONTRIBUTORS
! BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR
! CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF
! SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS
! INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN
! CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE)
! ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE
! POSSIBILITY OF SUCH DAMAGE.
!
!
!
! package: psb_lbase_mat_mod
!
! This module contains the definition of the very basic object
! psb_lbase_sparse_mat holding some information common to all matrix
! type variants, such as number of rows and columns, whether the
! matrix is supposed to be triangular (upper or lower) and with a unit
! (i.e. assumed) diagonal, together with some state variables. This
! base class is in common among all variants of real/complex,
! short/long precision; as such, it only contains information that is
! inherently integer in nature.
!
! The methods associated to this class can be grouped into three sets:
! 1) Fully implemented methods: some methods such as get_nrows or
! set_nrows can be fully implemented at this level.
! 2) 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).
! 3) 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/f03/psb_lbase_mat_impl.f03 file
!
!
module psb_lbase_mat_mod
use psb_const_mod
use psi_serial_mod
!
!> \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
contains
!
!> 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
end module psb_lbase_mat_mod

1968
base/modules/serial/psb_ld_base_mat_mod.f90
View File

File diff suppressed because it is too large Load Diff

612
base/modules/serial/psb_ld_csc_mat_mod.f90
Unescape Escape View File

@ -1,612 +0,0 @@
!
! Parallel Sparse BLAS version 3.5
! (C) Copyright 2006-2018
! Salvatore Filippone
! Alfredo Buttari
!
! Redistribution and use in source and binary forms, with or without
! modification, are permitted provided that the following conditions
! are met:
! 1. Redistributions of source code must retain the above copyright
! notice, this list of conditions and the following disclaimer.
! 2. Redistributions in binary form must reproduce the above copyright
! notice, this list of conditions, and the following disclaimer in the
! documentation and/or other materials provided with the distribution.
! 3. The name of the PSBLAS group or the names of its contributors may
! not be used to endorse or promote products derived from this
! software without specific written permission.
!
! THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS
! ``AS IS'' AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED
! TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR
! PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE PSBLAS GROUP OR ITS CONTRIBUTORS
! BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR
! CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF
! SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS
! INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN
! CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE)
! ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE
! POSSIBILITY OF SUCH DAMAGE.
!
!
!
! package: psb_ld_csc_mat_mod
!
! This module contains the definition of the psb_ld_csc_sparse_mat type
! which implements an actual storage format (the CSC in this case) for
! a sparse matrix as well as the related methods (those who are
! specific to the type and could not be defined higher in the
! hierarchy). We are at the bottom level of the inheritance chain.
!
! Please refere to psb_ld_base_mat_mod for a detailed description
! of the various methods, and to psb_ld_csc_impl for implementation details.
!
module psb_ld_csc_mat_mod
use psb_ld_base_mat_mod
!> \namespace psb_base_mod \class psb_ld_csc_sparse_mat
!! \extends psb_ld_base_mat_mod::psb_ld_base_sparse_mat
!!
!! psb_ld_csc_sparse_mat type and the related methods.
!!
type, extends(psb_ld_base_sparse_mat) :: psb_ld_csc_sparse_mat
!> Pointers to beginning of cols in IA and VAL.
integer(psb_lpk_), allocatable :: icp(:)
!> Row indices.
integer(psb_lpk_), allocatable :: ia(:)
!> Coefficient values.
real(psb_dpk_), allocatable :: val(:)
contains
procedure, pass(a) :: is_by_cols => ld_csc_is_by_cols
procedure, pass(a) :: get_size => ld_csc_get_size
procedure, pass(a) :: get_nzeros => ld_csc_get_nzeros
procedure, nopass :: get_fmt => ld_csc_get_fmt
procedure, pass(a) :: sizeof => ld_csc_sizeof
procedure, pass(a) :: csmm => psb_ld_csc_csmm
procedure, pass(a) :: csmv => psb_ld_csc_csmv
procedure, pass(a) :: inner_cssm => psb_ld_csc_cssm
procedure, pass(a) :: inner_cssv => psb_ld_csc_cssv
procedure, pass(a) :: scals => psb_ld_csc_scals
procedure, pass(a) :: scalv => psb_ld_csc_scal
procedure, pass(a) :: maxval => psb_ld_csc_maxval
procedure, pass(a) :: spnm1 => psb_ld_csc_csnm1
procedure, pass(a) :: rowsum => psb_ld_csc_rowsum
procedure, pass(a) :: arwsum => psb_ld_csc_arwsum
procedure, pass(a) :: colsum => psb_ld_csc_colsum
procedure, pass(a) :: aclsum => psb_ld_csc_aclsum
procedure, pass(a) :: reallocate_nz => psb_ld_csc_reallocate_nz
procedure, pass(a) :: allocate_mnnz => psb_ld_csc_allocate_mnnz
procedure, pass(a) :: cp_to_coo => psb_ld_cp_csc_to_coo
procedure, pass(a) :: cp_from_coo => psb_ld_cp_csc_from_coo
procedure, pass(a) :: cp_to_fmt => psb_ld_cp_csc_to_fmt
procedure, pass(a) :: cp_from_fmt => psb_ld_cp_csc_from_fmt
procedure, pass(a) :: mv_to_coo => psb_ld_mv_csc_to_coo
procedure, pass(a) :: mv_from_coo => psb_ld_mv_csc_from_coo
procedure, pass(a) :: mv_to_fmt => psb_ld_mv_csc_to_fmt
procedure, pass(a) :: mv_from_fmt => psb_ld_mv_csc_from_fmt
procedure, pass(a) :: csput_a => psb_ld_csc_csput_a
procedure, pass(a) :: get_diag => psb_ld_csc_get_diag
procedure, pass(a) :: csgetptn => psb_ld_csc_csgetptn
procedure, pass(a) :: csgetrow => psb_ld_csc_csgetrow
procedure, pass(a) :: get_nz_col => ld_csc_get_nz_col
procedure, pass(a) :: reinit => psb_ld_csc_reinit
procedure, pass(a) :: trim => psb_ld_csc_trim
procedure, pass(a) :: print => psb_ld_csc_print
procedure, pass(a) :: free => ld_csc_free
procedure, pass(a) :: mold => psb_ld_csc_mold
end type psb_ld_csc_sparse_mat
private :: ld_csc_get_nzeros, ld_csc_free, ld_csc_get_fmt, &
& ld_csc_get_size, ld_csc_sizeof, ld_csc_get_nz_col
!> \memberof psb_ld_csc_sparse_mat
!| \see psb_base_mat_mod::psb_base_reallocate_nz
interface
subroutine psb_ld_csc_reallocate_nz(nz,a)
import
integer(psb_lpk_), intent(in) :: nz
class(psb_ld_csc_sparse_mat), intent(inout) :: a
end subroutine psb_ld_csc_reallocate_nz
end interface
!> \memberof psb_ld_csc_sparse_mat
!| \see psb_base_mat_mod::psb_base_reinit
interface
subroutine psb_ld_csc_reinit(a,clear)
import
class(psb_ld_csc_sparse_mat), intent(inout) :: a
logical, intent(in), optional :: clear
end subroutine psb_ld_csc_reinit
end interface
!> \memberof psb_ld_csc_sparse_mat
!| \see psb_base_mat_mod::psb_base_trim
interface
subroutine psb_ld_csc_trim(a)
import
class(psb_ld_csc_sparse_mat), intent(inout) :: a
end subroutine psb_ld_csc_trim
end interface
!> \memberof psb_ld_csc_sparse_mat
!| \see psb_base_mat_mod::psb_base_mold
interface
subroutine psb_ld_csc_mold(a,b,info)
import
class(psb_ld_csc_sparse_mat), intent(in) :: a
class(psb_ld_base_sparse_mat), intent(inout), allocatable :: b
integer(psb_ipk_), intent(out) :: info
end subroutine psb_ld_csc_mold
end interface
!> \memberof psb_ld_csc_sparse_mat
!| \see psb_base_mat_mod::psb_base_allocate_mnnz
interface
subroutine psb_ld_csc_allocate_mnnz(m,n,a,nz)
import
integer(psb_lpk_), intent(in) :: m,n
class(psb_ld_csc_sparse_mat), intent(inout) :: a
integer(psb_lpk_), intent(in), optional :: nz
end subroutine psb_ld_csc_allocate_mnnz
end interface
!> \memberof psb_ld_csc_sparse_mat
!! \see psb_ld_base_mat_mod::psb_ld_base_print
interface
subroutine psb_ld_csc_print(iout,a,iv,head,ivr,ivc)
import
integer(psb_ipk_), intent(in) :: iout
class(psb_ld_csc_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_ld_csc_print
end interface
!> \memberof psb_ld_csc_sparse_mat
!! \see psb_ld_base_mat_mod::psb_ld_base_cp_to_coo
interface
subroutine psb_ld_cp_csc_to_coo(a,b,info)
import
class(psb_ld_csc_sparse_mat), intent(in) :: a
class(psb_ld_coo_sparse_mat), intent(inout) :: b
integer(psb_ipk_), intent(out) :: info
end subroutine psb_ld_cp_csc_to_coo
end interface
!> \memberof psb_ld_csc_sparse_mat
!! \see psb_ld_base_mat_mod::psb_ld_base_cp_from_coo
interface
subroutine psb_ld_cp_csc_from_coo(a,b,info)
import
class(psb_ld_csc_sparse_mat), intent(inout) :: a
class(psb_ld_coo_sparse_mat), intent(in) :: b
integer(psb_ipk_), intent(out) :: info
end subroutine psb_ld_cp_csc_from_coo
end interface
!> \memberof psb_ld_csc_sparse_mat
!! \see psb_ld_base_mat_mod::psb_ld_base_cp_to_fmt
interface
subroutine psb_ld_cp_csc_to_fmt(a,b,info)
import
class(psb_ld_csc_sparse_mat), intent(in) :: a
class(psb_ld_base_sparse_mat), intent(inout) :: b
integer(psb_ipk_), intent(out) :: info
end subroutine psb_ld_cp_csc_to_fmt
end interface
!> \memberof psb_ld_csc_sparse_mat
!! \see psb_ld_base_mat_mod::psb_ld_base_cp_from_fmt
interface
subroutine psb_ld_cp_csc_from_fmt(a,b,info)
import
class(psb_ld_csc_sparse_mat), intent(inout) :: a
class(psb_ld_base_sparse_mat), intent(in) :: b
integer(psb_ipk_), intent(out) :: info
end subroutine psb_ld_cp_csc_from_fmt
end interface
!> \memberof psb_ld_csc_sparse_mat
!! \see psb_ld_base_mat_mod::psb_ld_base_mv_to_coo
interface
subroutine psb_ld_mv_csc_to_coo(a,b,info)
import
class(psb_ld_csc_sparse_mat), intent(inout) :: a
class(psb_ld_coo_sparse_mat), intent(inout) :: b
integer(psb_ipk_), intent(out) :: info
end subroutine psb_ld_mv_csc_to_coo
end interface
!> \memberof psb_ld_csc_sparse_mat
!! \see psb_ld_base_mat_mod::psb_ld_base_mv_from_coo
interface
subroutine psb_ld_mv_csc_from_coo(a,b,info)
import
class(psb_ld_csc_sparse_mat), intent(inout) :: a
class(psb_ld_coo_sparse_mat), intent(inout) :: b
integer(psb_ipk_), intent(out) :: info
end subroutine psb_ld_mv_csc_from_coo
end interface
!> \memberof psb_ld_csc_sparse_mat
!! \see psb_ld_base_mat_mod::psb_ld_base_mv_to_fmt
interface
subroutine psb_ld_mv_csc_to_fmt(a,b,info)
import
class(psb_ld_csc_sparse_mat), intent(inout) :: a
class(psb_ld_base_sparse_mat), intent(inout) :: b
integer(psb_ipk_), intent(out) :: info
end subroutine psb_ld_mv_csc_to_fmt
end interface
!> \memberof psb_ld_csc_sparse_mat
!! \see psb_ld_base_mat_mod::psb_ld_base_mv_from_fmt
interface
subroutine psb_ld_mv_csc_from_fmt(a,b,info)
import
class(psb_ld_csc_sparse_mat), intent(inout) :: a
class(psb_ld_base_sparse_mat), intent(inout) :: b
integer(psb_ipk_), intent(out) :: info
end subroutine psb_ld_mv_csc_from_fmt
end interface
!> \memberof psb_ld_csc_sparse_mat
!! \see psb_ld_base_mat_mod::psb_ld_base_cp_from
interface
subroutine psb_ld_csc_cp_from(a,b)
import
class(psb_ld_csc_sparse_mat), intent(inout) :: a
type(psb_ld_csc_sparse_mat), intent(in) :: b
end subroutine psb_ld_csc_cp_from
end interface
!> \memberof psb_ld_csc_sparse_mat
!! \see psb_ld_base_mat_mod::psb_ld_base_mv_from
interface
subroutine psb_ld_csc_mv_from(a,b)
import
class(psb_ld_csc_sparse_mat), intent(inout) :: a
type(psb_ld_csc_sparse_mat), intent(inout) :: b
end subroutine psb_ld_csc_mv_from
end interface
!> \memberof psb_ld_csc_sparse_mat
!! \see psb_ld_base_mat_mod::psb_ld_base_csput_a
interface
subroutine psb_ld_csc_csput_a(nz,ia,ja,val,a,imin,imax,jmin,jmax,info,gtl)
import
class(psb_ld_csc_sparse_mat), intent(inout) :: a
real(psb_dpk_), intent(in) :: val(:)
integer(psb_lpk_), intent(in) :: nz,ia(:), ja(:),&
& imin,imax,jmin,jmax
integer(psb_ipk_), intent(out) :: info
integer(psb_lpk_), intent(in), optional :: gtl(:)
end subroutine psb_ld_csc_csput_a
end interface
!> \memberof psb_ld_csc_sparse_mat
!! \see psb_base_mat_mod::psb_base_csgetptn
interface
subroutine psb_ld_csc_csgetptn(imin,imax,a,nz,ia,ja,info,&
& jmin,jmax,iren,append,nzin,rscale,cscale)
import
class(psb_ld_csc_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_ld_csc_csgetptn
end interface
!> \memberof psb_ld_csc_sparse_mat
!! \see psb_ld_base_mat_mod::psb_ld_base_csgetrow
interface
subroutine psb_ld_csc_csgetrow(imin,imax,a,nz,ia,ja,val,info,&
& jmin,jmax,iren,append,nzin,rscale,cscale)
import
class(psb_ld_csc_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(:)
real(psb_dpk_), allocatable, intent(inout) :: val(:)
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_ld_csc_csgetrow
end interface
!> \memberof psb_ld_csc_sparse_mat
!! \see psb_ld_base_mat_mod::psb_ld_base_csgetblk
interface
subroutine psb_ld_csc_csgetblk(imin,imax,a,b,info,&
& jmin,jmax,iren,append,rscale,cscale)
import
class(psb_ld_csc_sparse_mat), intent(in) :: a
class(psb_ld_coo_sparse_mat), intent(inout) :: b
integer(psb_lpk_), intent(in) :: imin,imax
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
logical, intent(in), optional :: rscale,cscale
end subroutine psb_ld_csc_csgetblk
end interface
!> \memberof psb_ld_csc_sparse_mat
!! \see psb_ld_base_mat_mod::psb_ld_base_cssv
interface
subroutine psb_ld_csc_cssv(alpha,a,x,beta,y,info,trans)
import
class(psb_ld_csc_sparse_mat), intent(in) :: a
real(psb_dpk_), intent(in) :: alpha, beta, x(:)
real(psb_dpk_), intent(inout) :: y(:)
integer(psb_ipk_), intent(out) :: info
character, optional, intent(in) :: trans
end subroutine psb_ld_csc_cssv
end interface
!> \memberof psb_ld_csc_sparse_mat
!! \see psb_ld_base_mat_mod::psb_ld_base_cssm
interface
subroutine psb_ld_csc_cssm(alpha,a,x,beta,y,info,trans)
import
class(psb_ld_csc_sparse_mat), intent(in) :: a
real(psb_dpk_), intent(in) :: alpha, beta, x(:,:)
real(psb_dpk_), intent(inout) :: y(:,:)
integer(psb_ipk_), intent(out) :: info
character, optional, intent(in) :: trans
end subroutine psb_ld_csc_cssm
end interface
!> \memberof psb_ld_csc_sparse_mat
!! \see psb_ld_base_mat_mod::psb_ld_base_csmv
interface
subroutine psb_ld_csc_csmv(alpha,a,x,beta,y,info,trans)
import
class(psb_ld_csc_sparse_mat), intent(in) :: a
real(psb_dpk_), intent(in) :: alpha, beta, x(:)
real(psb_dpk_), intent(inout) :: y(:)
integer(psb_ipk_), intent(out) :: info
character, optional, intent(in) :: trans
end subroutine psb_ld_csc_csmv
end interface
!> \memberof psb_ld_csc_sparse_mat
!! \see psb_ld_base_mat_mod::psb_ld_base_csmm
interface
subroutine psb_ld_csc_csmm(alpha,a,x,beta,y,info,trans)
import
class(psb_ld_csc_sparse_mat), intent(in) :: a
real(psb_dpk_), intent(in) :: alpha, beta, x(:,:)
real(psb_dpk_), intent(inout) :: y(:,:)
integer(psb_ipk_), intent(out) :: info
character, optional, intent(in) :: trans
end subroutine psb_ld_csc_csmm
end interface
!> \memberof psb_ld_csc_sparse_mat
!! \see psb_ld_base_mat_mod::psb_ld_base_maxval
interface
function psb_ld_csc_maxval(a) result(res)
import
class(psb_ld_csc_sparse_mat), intent(in) :: a
real(psb_dpk_) :: res
end function psb_ld_csc_maxval
end interface
!> \memberof psb_ld_csc_sparse_mat
!! \see psb_ld_base_mat_mod::psb_ld_base_csnm1
interface
function psb_ld_csc_csnm1(a) result(res)
import
class(psb_ld_csc_sparse_mat), intent(in) :: a
real(psb_dpk_) :: res
end function psb_ld_csc_csnm1
end interface
!> \memberof psb_ld_csc_sparse_mat
!! \see psb_ld_base_mat_mod::psb_ld_base_rowsum
interface
subroutine psb_ld_csc_rowsum(d,a)
import
class(psb_ld_csc_sparse_mat), intent(in) :: a
real(psb_dpk_), intent(out) :: d(:)
end subroutine psb_ld_csc_rowsum
end interface
!> \memberof psb_ld_csc_sparse_mat
!! \see psb_ld_base_mat_mod::psb_ld_base_arwsum
interface
subroutine psb_ld_csc_arwsum(d,a)
import
class(psb_ld_csc_sparse_mat), intent(in) :: a
real(psb_dpk_), intent(out) :: d(:)
end subroutine psb_ld_csc_arwsum
end interface
!> \memberof psb_ld_csc_sparse_mat
!! \see psb_ld_base_mat_mod::psb_ld_base_colsum
interface
subroutine psb_ld_csc_colsum(d,a)
import
class(psb_ld_csc_sparse_mat), intent(in) :: a
real(psb_dpk_), intent(out) :: d(:)
end subroutine psb_ld_csc_colsum
end interface
!> \memberof psb_ld_csc_sparse_mat
!! \see psb_ld_base_mat_mod::psb_ld_base_aclsum
interface
subroutine psb_ld_csc_aclsum(d,a)
import
class(psb_ld_csc_sparse_mat), intent(in) :: a
real(psb_dpk_), intent(out) :: d(:)
end subroutine psb_ld_csc_aclsum
end interface
!> \memberof psb_ld_csc_sparse_mat
!! \see psb_ld_base_mat_mod::psb_ld_base_get_diag
interface
subroutine psb_ld_csc_get_diag(a,d,info)
import
class(psb_ld_csc_sparse_mat), intent(in) :: a
real(psb_dpk_), intent(out) :: d(:)
integer(psb_ipk_), intent(out) :: info
end subroutine psb_ld_csc_get_diag
end interface
!> \memberof psb_ld_csc_sparse_mat
!! \see psb_ld_base_mat_mod::psb_ld_base_scal
interface
subroutine psb_ld_csc_scal(d,a,info,side)
import
class(psb_ld_csc_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_ld_csc_scal
end interface
!> \memberof psb_ld_csc_sparse_mat
!! \see psb_ld_base_mat_mod::psb_ld_base_scals
interface
subroutine psb_ld_csc_scals(d,a,info)
import
class(psb_ld_csc_sparse_mat), intent(inout) :: a
real(psb_dpk_), intent(in) :: d
integer(psb_ipk_), intent(out) :: info
end subroutine psb_ld_csc_scals
end interface
contains
! == ===================================
!
!
!
! Getters
!
!
!
!
!
! == ===================================
function ld_csc_is_by_cols(a) result(res)
implicit none
class(psb_ld_csc_sparse_mat), intent(in) :: a
logical :: res
res = .true.
end function ld_csc_is_by_cols
function ld_csc_sizeof(a) result(res)
implicit none
class(psb_ld_csc_sparse_mat), intent(in) :: a
integer(psb_epk_) :: res
res = 8
res = res + psb_sizeof_dp * psb_size(a%val)
res = res + psb_sizeof_ip * psb_size(a%icp)
res = res + psb_sizeof_ip * psb_size(a%ia)
end function ld_csc_sizeof
function ld_csc_get_fmt() result(res)
implicit none
character(len=5) :: res
res = 'CSC'
end function ld_csc_get_fmt
function ld_csc_get_nzeros(a) result(res)
implicit none
class(psb_ld_csc_sparse_mat), intent(in) :: a
integer(psb_lpk_) :: res
res = a%icp(a%get_ncols()+1)-1
end function ld_csc_get_nzeros
function ld_csc_get_size(a) result(res)
implicit none
class(psb_ld_csc_sparse_mat), intent(in) :: a
integer(psb_lpk_) :: res
res = -1
if (allocated(a%ia)) then
res = size(a%ia)
end if
if (allocated(a%val)) then
if (res >= 0) then
res = min(res,size(a%val))
else
res = size(a%val)
end if
end if
end function ld_csc_get_size
function ld_csc_get_nz_col(idx,a) result(res)
use psb_const_mod
implicit none
class(psb_ld_csc_sparse_mat), intent(in) :: a
integer(psb_lpk_), intent(in) :: idx
integer(psb_lpk_) :: res
res = 0
if ((1<=idx).and.(idx<=a%get_ncols())) then
res = a%icp(idx+1)-a%icp(idx)
end if
end function ld_csc_get_nz_col
! == ===================================
!
!
!
! Data management
!
!
!
!
!
! == ===================================
subroutine ld_csc_free(a)
implicit none
class(psb_ld_csc_sparse_mat), intent(inout) :: a
if (allocated(a%icp)) deallocate(a%icp)
if (allocated(a%ia)) deallocate(a%ia)
if (allocated(a%val)) deallocate(a%val)
call a%set_null()
call a%set_nrows(0_psb_lpk_)
call a%set_ncols(0_psb_lpk_)
return
end subroutine ld_csc_free
end module psb_ld_csc_mat_mod

617
base/modules/serial/psb_ld_csr_mat_mod.f90
Unescape Escape View File

@ -1,617 +0,0 @@
!
! Parallel Sparse BLAS version 3.5
! (C) Copyright 2006-2018
! Salvatore Filippone
! Alfredo Buttari
!
! Redistribution and use in source and binary forms, with or without
! modification, are permitted provided that the following conditions
! are met:
! 1. Redistributions of source code must retain the above copyright
! notice, this list of conditions and the following disclaimer.
! 2. Redistributions in binary form must reproduce the above copyright
! notice, this list of conditions, and the following disclaimer in the
! documentation and/or other materials provided with the distribution.
! 3. The name of the PSBLAS group or the names of its contributors may
! not be used to endorse or promote products derived from this
! software without specific written permission.
!
! THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS
! ``AS IS'' AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED
! TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR
! PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE PSBLAS GROUP OR ITS CONTRIBUTORS
! BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR
! CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF
! SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS
! INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN
! CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE)
! ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE
! POSSIBILITY OF SUCH DAMAGE.
!
!
!
! package: psb_ld_csr_mat_mod
!
! This module contains the definition of the psb_ld_csr_sparse_mat type
! which implements an actual storage format (the CSR in this case) for
! a sparse matrix as well as the related methods (those who are
! specific to the type and could not be defined higher in the
! hierarchy). We are at the bottom level of the inheritance chain.
!
! Please refere to psb_ld_base_mat_mod for a detailed description
! of the various methods, and to psb_ld_csr_impl for implementation details.
!
module psb_ld_csr_mat_mod
use psb_d_base_mat_mod
!> \namespace psb_base_mod \class psb_ld_csr_sparse_mat
!! \extends psb_ld_base_mat_mod::psb_ld_base_sparse_mat
!!
!! psb_ld_csr_sparse_mat type and the related methods.
!! This is a very common storage type, and is the default for assembled
!! matrices in our library
type, extends(psb_ld_base_sparse_mat) :: psb_ld_csr_sparse_mat
!> Pointers to beginning of rows in JA and VAL.
integer(psb_lpk_), allocatable :: irp(:)
!> Column indices.
integer(psb_lpk_), allocatable :: ja(:)
!> Coefficient values.
real(psb_dpk_), allocatable :: val(:)
contains
procedure, pass(a) :: is_by_rows => ld_csr_is_by_rows
procedure, pass(a) :: get_size => ld_csr_get_size
procedure, pass(a) :: get_nzeros => ld_csr_get_nzeros
procedure, nopass :: get_fmt => ld_csr_get_fmt
procedure, pass(a) :: sizeof => ld_csr_sizeof
procedure, pass(a) :: csmm => psb_ld_csr_csmm
procedure, pass(a) :: csmv => psb_ld_csr_csmv
procedure, pass(a) :: inner_cssm => psb_ld_csr_cssm
procedure, pass(a) :: inner_cssv => psb_ld_csr_cssv
procedure, pass(a) :: scals => psb_ld_csr_scals
procedure, pass(a) :: scalv => psb_ld_csr_scal
procedure, pass(a) :: maxval => psb_ld_csr_maxval
procedure, pass(a) :: spnmi => psb_ld_csr_csnmi
procedure, pass(a) :: rowsum => psb_ld_csr_rowsum
procedure, pass(a) :: arwsum => psb_ld_csr_arwsum
procedure, pass(a) :: colsum => psb_ld_csr_colsum
procedure, pass(a) :: aclsum => psb_ld_csr_aclsum
procedure, pass(a) :: reallocate_nz => psb_ld_csr_reallocate_nz
procedure, pass(a) :: allocate_mnnz => psb_ld_csr_allocate_mnnz
procedure, pass(a) :: cp_to_coo => psb_ld_cp_csr_to_coo
procedure, pass(a) :: cp_from_coo => psb_ld_cp_csr_from_coo
procedure, pass(a) :: cp_to_fmt => psb_ld_cp_csr_to_fmt
procedure, pass(a) :: cp_from_fmt => psb_ld_cp_csr_from_fmt
procedure, pass(a) :: mv_to_coo => psb_ld_mv_csr_to_coo
procedure, pass(a) :: mv_from_coo => psb_ld_mv_csr_from_coo
procedure, pass(a) :: mv_to_fmt => psb_ld_mv_csr_to_fmt
procedure, pass(a) :: mv_from_fmt => psb_ld_mv_csr_from_fmt
procedure, pass(a) :: csput_a => psb_ld_csr_csput_a
procedure, pass(a) :: get_diag => psb_ld_csr_get_diag
procedure, pass(a) :: csgetptn => psb_ld_csr_csgetptn
procedure, pass(a) :: csgetrow => psb_ld_csr_csgetrow
procedure, pass(a) :: get_nz_row => ld_csr_get_nz_row
procedure, pass(a) :: reinit => psb_ld_csr_reinit
procedure, pass(a) :: trim => psb_ld_csr_trim
procedure, pass(a) :: print => psb_ld_csr_print
procedure, pass(a) :: free => ld_csr_free
procedure, pass(a) :: mold => psb_ld_csr_mold
end type psb_ld_csr_sparse_mat
private :: ld_csr_get_nzeros, ld_csr_free, ld_csr_get_fmt, &
& ld_csr_get_size, ld_csr_sizeof, ld_csr_get_nz_row, &
& ld_csr_is_by_rows
!> \memberof psb_ld_csr_sparse_mat
!| \see psb_base_mat_mod::psb_base_reallocate_nz
interface
subroutine psb_ld_csr_reallocate_nz(nz,a)
import
integer(psb_lpk_), intent(in) :: nz
class(psb_ld_csr_sparse_mat), intent(inout) :: a
end subroutine psb_ld_csr_reallocate_nz
end interface
!> \memberof psb_ld_csr_sparse_mat
!| \see psb_base_mat_mod::psb_base_reinit
interface
subroutine psb_ld_csr_reinit(a,clear)
import
class(psb_ld_csr_sparse_mat), intent(inout) :: a
logical, intent(in), optional :: clear
end subroutine psb_ld_csr_reinit
end interface
!> \memberof psb_ld_csr_sparse_mat
!| \see psb_base_mat_mod::psb_base_trim
interface
subroutine psb_ld_csr_trim(a)
import
class(psb_ld_csr_sparse_mat), intent(inout) :: a
end subroutine psb_ld_csr_trim
end interface
!> \memberof psb_ld_csr_sparse_mat
!| \see psb_base_mat_mod::psb_base_mold
interface
subroutine psb_ld_csr_mold(a,b,info)
import
class(psb_ld_csr_sparse_mat), intent(in) :: a
class(psb_ld_base_sparse_mat), intent(inout), allocatable :: b
integer(psb_ipk_), intent(out) :: info
end subroutine psb_ld_csr_mold
end interface
!> \memberof psb_ld_csr_sparse_mat
!| \see psb_base_mat_mod::psb_base_allocate_mnnz
interface
subroutine psb_ld_csr_allocate_mnnz(m,n,a,nz)
import
integer(psb_lpk_), intent(in) :: m,n
class(psb_ld_csr_sparse_mat), intent(inout) :: a
integer(psb_lpk_), intent(in), optional :: nz
end subroutine psb_ld_csr_allocate_mnnz
end interface
!> \memberof psb_ld_csr_sparse_mat
!! \see psb_ld_base_mat_mod::psb_ld_base_print
interface
subroutine psb_ld_csr_print(iout,a,iv,head,ivr,ivc)
import
integer(psb_ipk_), intent(in) :: iout
class(psb_ld_csr_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_ld_csr_print
end interface
!> \memberof psb_ld_csr_sparse_mat
!! \see psb_ld_base_mat_mod::psb_ld_base_cp_to_coo
interface
subroutine psb_ld_cp_csr_to_coo(a,b,info)
import
class(psb_ld_csr_sparse_mat), intent(in) :: a
class(psb_ld_coo_sparse_mat), intent(inout) :: b
integer(psb_ipk_), intent(out) :: info
end subroutine psb_ld_cp_csr_to_coo
end interface
!> \memberof psb_ld_csr_sparse_mat
!! \see psb_ld_base_mat_mod::psb_ld_base_cp_from_coo
interface
subroutine psb_ld_cp_csr_from_coo(a,b,info)
import
class(psb_ld_csr_sparse_mat), intent(inout) :: a
class(psb_ld_coo_sparse_mat), intent(in) :: b
integer(psb_ipk_), intent(out) :: info
end subroutine psb_ld_cp_csr_from_coo
end interface
!> \memberof psb_ld_csr_sparse_mat
!! \see psb_ld_base_mat_mod::psb_ld_base_cp_to_fmt
interface
subroutine psb_ld_cp_csr_to_fmt(a,b,info)
import
class(psb_ld_csr_sparse_mat), intent(in) :: a
class(psb_ld_base_sparse_mat), intent(inout) :: b
integer(psb_ipk_), intent(out) :: info
end subroutine psb_ld_cp_csr_to_fmt
end interface
!> \memberof psb_ld_csr_sparse_mat
!! \see psb_ld_base_mat_mod::psb_ld_base_cp_from_fmt
interface
subroutine psb_ld_cp_csr_from_fmt(a,b,info)
import
class(psb_ld_csr_sparse_mat), intent(inout) :: a
class(psb_ld_base_sparse_mat), intent(in) :: b
integer(psb_ipk_), intent(out) :: info
end subroutine psb_ld_cp_csr_from_fmt
end interface
!> \memberof psb_ld_csr_sparse_mat
!! \see psb_ld_base_mat_mod::psb_ld_base_mv_to_coo
interface
subroutine psb_ld_mv_csr_to_coo(a,b,info)
import
class(psb_ld_csr_sparse_mat), intent(inout) :: a
class(psb_ld_coo_sparse_mat), intent(inout) :: b
integer(psb_ipk_), intent(out) :: info
end subroutine psb_ld_mv_csr_to_coo
end interface
!> \memberof psb_ld_csr_sparse_mat
!! \see psb_ld_base_mat_mod::psb_ld_base_mv_from_coo
interface
subroutine psb_ld_mv_csr_from_coo(a,b,info)
import
class(psb_ld_csr_sparse_mat), intent(inout) :: a
class(psb_ld_coo_sparse_mat), intent(inout) :: b
integer(psb_ipk_), intent(out) :: info
end subroutine psb_ld_mv_csr_from_coo
end interface
!> \memberof psb_ld_csr_sparse_mat
!! \see psb_ld_base_mat_mod::psb_ld_base_mv_to_fmt
interface
subroutine psb_ld_mv_csr_to_fmt(a,b,info)
import
class(psb_ld_csr_sparse_mat), intent(inout) :: a
class(psb_ld_base_sparse_mat), intent(inout) :: b
integer(psb_ipk_), intent(out) :: info
end subroutine psb_ld_mv_csr_to_fmt
end interface
!> \memberof psb_ld_csr_sparse_mat
!! \see psb_ld_base_mat_mod::psb_ld_base_mv_from_fmt
interface
subroutine psb_ld_mv_csr_from_fmt(a,b,info)
import
class(psb_ld_csr_sparse_mat), intent(inout) :: a
class(psb_ld_base_sparse_mat), intent(inout) :: b
integer(psb_ipk_), intent(out) :: info
end subroutine psb_ld_mv_csr_from_fmt
end interface
!> \memberof psb_ld_csr_sparse_mat
!! \see psb_ld_base_mat_mod::psb_ld_base_cp_from
interface
subroutine psb_ld_csr_cp_from(a,b)
import
class(psb_ld_csr_sparse_mat), intent(inout) :: a
type(psb_ld_csr_sparse_mat), intent(in) :: b
end subroutine psb_ld_csr_cp_from
end interface
!> \memberof psb_ld_csr_sparse_mat
!! \see psb_ld_base_mat_mod::psb_ld_base_mv_from
interface
subroutine psb_ld_csr_mv_from(a,b)
import
class(psb_ld_csr_sparse_mat), intent(inout) :: a
type(psb_ld_csr_sparse_mat), intent(inout) :: b
end subroutine psb_ld_csr_mv_from
end interface
!> \memberof psb_ld_csr_sparse_mat
!! \see psb_ld_base_mat_mod::psb_ld_base_csput_a
interface
subroutine psb_ld_csr_csput_a(nz,ia,ja,val,a,imin,imax,jmin,jmax,info,gtl)
import
class(psb_ld_csr_sparse_mat), intent(inout) :: a
real(psb_dpk_), intent(in) :: val(:)
integer(psb_lpk_), intent(in) :: nz,ia(:), ja(:),&
& imin,imax,jmin,jmax
integer(psb_ipk_), intent(out) :: info
integer(psb_lpk_), intent(in), optional :: gtl(:)
end subroutine psb_ld_csr_csput_a
end interface
!> \memberof psb_ld_csr_sparse_mat
!! \see psb_base_mat_mod::psb_base_csgetptn
interface
subroutine psb_ld_csr_csgetptn(imin,imax,a,nz,ia,ja,info,&
& jmin,jmax,iren,append,nzin,rscale,cscale)
import
class(psb_ld_csr_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_ld_csr_csgetptn
end interface
!> \memberof psb_ld_csr_sparse_mat
!! \see psb_ld_base_mat_mod::psb_ld_base_csgetrow
interface
subroutine psb_ld_csr_csgetrow(imin,imax,a,nz,ia,ja,val,info,&
& jmin,jmax,iren,append,nzin,rscale,cscale)
import
class(psb_ld_csr_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(:)
real(psb_dpk_), allocatable, intent(inout) :: val(:)
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_ld_csr_csgetrow
end interface
!> \memberof psb_ld_csr_sparse_mat
!! \see psb_ld_base_mat_mod::psb_ld_base_csgetblk
interface
subroutine psb_ld_csr_csgetblk(imin,imax,a,b,info,&
& jmin,jmax,iren,append,rscale,cscale)
import
class(psb_ld_csr_sparse_mat), intent(in) :: a
class(psb_ld_coo_sparse_mat), intent(inout) :: b
integer(psb_lpk_), intent(in) :: imin,imax
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
logical, intent(in), optional :: rscale,cscale
end subroutine psb_ld_csr_csgetblk
end interface
!> \memberof psb_ld_csr_sparse_mat
!! \see psb_ld_base_mat_mod::psb_ld_base_cssv
interface
subroutine psb_ld_csr_cssv(alpha,a,x,beta,y,info,trans)
import
class(psb_ld_csr_sparse_mat), intent(in) :: a
real(psb_dpk_), intent(in) :: alpha, beta, x(:)
real(psb_dpk_), intent(inout) :: y(:)
integer(psb_ipk_), intent(out) :: info
character, optional, intent(in) :: trans
end subroutine psb_ld_csr_cssv
end interface
!> \memberof psb_ld_csr_sparse_mat
!! \see psb_ld_base_mat_mod::psb_ld_base_cssm
interface
subroutine psb_ld_csr_cssm(alpha,a,x,beta,y,info,trans)
import
class(psb_ld_csr_sparse_mat), intent(in) :: a
real(psb_dpk_), intent(in) :: alpha, beta, x(:,:)
real(psb_dpk_), intent(inout) :: y(:,:)
integer(psb_ipk_), intent(out) :: info
character, optional, intent(in) :: trans
end subroutine psb_ld_csr_cssm
end interface
!> \memberof psb_ld_csr_sparse_mat
!! \see psb_ld_base_mat_mod::psb_ld_base_csmv
interface
subroutine psb_ld_csr_csmv(alpha,a,x,beta,y,info,trans)
import
class(psb_ld_csr_sparse_mat), intent(in) :: a
real(psb_dpk_), intent(in) :: alpha, beta, x(:)
real(psb_dpk_), intent(inout) :: y(:)
integer(psb_ipk_), intent(out) :: info
character, optional, intent(in) :: trans
end subroutine psb_ld_csr_csmv
end interface
!> \memberof psb_ld_csr_sparse_mat
!! \see psb_ld_base_mat_mod::psb_ld_base_csmm
interface
subroutine psb_ld_csr_csmm(alpha,a,x,beta,y,info,trans)
import
class(psb_ld_csr_sparse_mat), intent(in) :: a
real(psb_dpk_), intent(in) :: alpha, beta, x(:,:)
real(psb_dpk_), intent(inout) :: y(:,:)
integer(psb_ipk_), intent(out) :: info
character, optional, intent(in) :: trans
end subroutine psb_ld_csr_csmm
end interface
!> \memberof psb_ld_csr_sparse_mat
!! \see psb_ld_base_mat_mod::psb_ld_base_maxval
interface
function psb_ld_csr_maxval(a) result(res)
import
class(psb_ld_csr_sparse_mat), intent(in) :: a
real(psb_dpk_) :: res
end function psb_ld_csr_maxval
end interface
!> \memberof psb_ld_csr_sparse_mat
!! \see psb_ld_base_mat_mod::psb_ld_base_csnmi
interface
function psb_ld_csr_csnmi(a) result(res)
import
class(psb_ld_csr_sparse_mat), intent(in) :: a
real(psb_dpk_) :: res
end function psb_ld_csr_csnmi
end interface
!> \memberof psb_ld_csr_sparse_mat
!! \see psb_ld_base_mat_mod::psb_ld_base_rowsum
interface
subroutine psb_ld_csr_rowsum(d,a)
import
class(psb_ld_csr_sparse_mat), intent(in) :: a
real(psb_dpk_), intent(out) :: d(:)
end subroutine psb_ld_csr_rowsum
end interface
!> \memberof psb_ld_csr_sparse_mat
!! \see psb_ld_base_mat_mod::psb_ld_base_arwsum
interface
subroutine psb_ld_csr_arwsum(d,a)
import
class(psb_ld_csr_sparse_mat), intent(in) :: a
real(psb_dpk_), intent(out) :: d(:)
end subroutine psb_ld_csr_arwsum
end interface
!> \memberof psb_ld_csr_sparse_mat
!! \see psb_ld_base_mat_mod::psb_ld_base_colsum
interface
subroutine psb_ld_csr_colsum(d,a)
import
class(psb_ld_csr_sparse_mat), intent(in) :: a
real(psb_dpk_), intent(out) :: d(:)
end subroutine psb_ld_csr_colsum
end interface
!> \memberof psb_ld_csr_sparse_mat
!! \see psb_ld_base_mat_mod::psb_ld_base_aclsum
interface
subroutine psb_ld_csr_aclsum(d,a)
import
class(psb_ld_csr_sparse_mat), intent(in) :: a
real(psb_dpk_), intent(out) :: d(:)
end subroutine psb_ld_csr_aclsum
end interface
!> \memberof psb_ld_csr_sparse_mat
!! \see psb_ld_base_mat_mod::psb_ld_base_get_diag
interface
subroutine psb_ld_csr_get_diag(a,d,info)
import
class(psb_ld_csr_sparse_mat), intent(in) :: a
real(psb_dpk_), intent(out) :: d(:)
integer(psb_ipk_), intent(out) :: info
end subroutine psb_ld_csr_get_diag
end interface
!> \memberof psb_ld_csr_sparse_mat
!! \see psb_ld_base_mat_mod::psb_ld_base_scal
interface
subroutine psb_ld_csr_scal(d,a,info,side)
import
class(psb_ld_csr_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_ld_csr_scal
end interface
!> \memberof psb_ld_csr_sparse_mat
!! \see psb_ld_base_mat_mod::psb_ld_base_scals
interface
subroutine psb_ld_csr_scals(d,a,info)
import
class(psb_ld_csr_sparse_mat), intent(inout) :: a
real(psb_dpk_), intent(in) :: d
integer(psb_ipk_), intent(out) :: info
end subroutine psb_ld_csr_scals
end interface
contains
! == ===================================
!
!
!
! Getters
!
!
!
!
!
! == ===================================
function ld_csr_is_by_rows(a) result(res)
implicit none
class(psb_ld_csr_sparse_mat), intent(in) :: a
logical :: res
res = .true.
end function ld_csr_is_by_rows
function ld_csr_sizeof(a) result(res)
implicit none
class(psb_ld_csr_sparse_mat), intent(in) :: a
integer(psb_epk_) :: res
res = 2 * psb_sizeof_lp
res = res + psb_sizeof_dp * psb_size(a%val)
res = res + psb_sizeof_lp * psb_size(a%irp)
res = res + psb_sizeof_lp * psb_size(a%ja)
end function ld_csr_sizeof
function ld_csr_get_fmt() result(res)
implicit none
character(len=5) :: res
res = 'CSR'
end function ld_csr_get_fmt
function ld_csr_get_nzeros(a) result(res)
implicit none
class(psb_ld_csr_sparse_mat), intent(in) :: a
integer(psb_lpk_) :: res
res = a%irp(a%get_nrows()+1)-1
end function ld_csr_get_nzeros
function ld_csr_get_size(a) result(res)
implicit none
class(psb_ld_csr_sparse_mat), intent(in) :: a
integer(psb_lpk_) :: res
res = -1
if (allocated(a%ja)) then
res = size(a%ja)
end if
if (allocated(a%val)) then
if (res >= 0) then
res = min(res,size(a%val))
else
res = size(a%val)
end if
end if
end function ld_csr_get_size
function ld_csr_get_nz_row(idx,a) result(res)
implicit none
class(psb_ld_csr_sparse_mat), intent(in) :: a
integer(psb_lpk_), intent(in) :: idx
integer(psb_lpk_) :: res
res = 0
if ((1<=idx).and.(idx<=a%get_nrows())) then
res = a%irp(idx+1)-a%irp(idx)
end if
end function ld_csr_get_nz_row
! == ===================================
!
!
!
! Data management
!
!
!
!
!
! == ===================================
subroutine ld_csr_free(a)
implicit none
class(psb_ld_csr_sparse_mat), intent(inout) :: a
if (allocated(a%irp)) deallocate(a%irp)
if (allocated(a%ja)) deallocate(a%ja)
if (allocated(a%val)) deallocate(a%val)
call a%set_null()
call a%set_nrows(0_psb_lpk_)
call a%set_ncols(0_psb_lpk_)
return
end subroutine ld_csr_free
end module psb_ld_csr_mat_mod

1379
base/modules/serial/psb_ld_mat_mod.F90
View File

File diff suppressed because it is too large Load Diff

233
base/modules/serial/psb_ld_serial_mod.f90
Unescape Escape View File

@ -1,233 +0,0 @@
!
! Parallel Sparse BLAS version 3.5
! (C) Copyright 2006-2018
! Salvatore Filippone
! Alfredo Buttari
!
! Redistribution and use in source and binary forms, with or without
! modification, are permitted provided that the following conditions
! are met:
! 1. Redistributions of source code must retain the above copyright
! notice, this list of conditions and the following disclaimer.
! 2. Redistributions in binary form must reproduce the above copyright
! notice, this list of conditions, and the following disclaimer in the
! documentation and/or other materials provided with the distribution.
! 3. The name of the PSBLAS group or the names of its contributors may
! not be used to endorse or promote products derived from this
! software without specific written permission.
!
! THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS
! ``AS IS'' AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED
! TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR
! PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE PSBLAS GROUP OR ITS CONTRIBUTORS
! BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR
! CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF
! SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS
! INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN
! CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE)
! ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE
! POSSIBILITY OF SUCH DAMAGE.
!
!
module psb_ld_serial_mod
use psb_const_mod
use psb_error_mod
interface psb_amax
function psb_ldamax_s(n, x) result(val)
import :: psb_ipk_, psb_dpk_
integer(psb_ipk_), intent(in) :: n
real(psb_dpk_), intent(in) :: x(:)
real(psb_dpk_) :: val
end function psb_ldamax_s
end interface psb_amax
interface psb_asum
function psb_ldasum_s(n, x) result(val)
import :: psb_ipk_, psb_dpk_
integer(psb_ipk_), intent(in) :: n
real(psb_dpk_), intent(in) :: x(:)
real(psb_dpk_) :: val
end function psb_ldasum_s
end interface psb_asum
interface psb_spspmm
subroutine psb_ldspspmm(a,b,c,info)
use psb_ld_mat_mod, only : psb_ldspmat_type
import :: psb_ipk_
implicit none
type(psb_ldspmat_type), intent(in) :: a,b
type(psb_ldspmat_type), intent(out) :: c
integer(psb_ipk_), intent(out) :: info
end subroutine psb_ldspspmm
subroutine psb_ldcsrspspmm(a,b,c,info)
use psb_ld_mat_mod, only : psb_ld_csr_sparse_mat
import :: psb_ipk_
implicit none
class(psb_ld_csr_sparse_mat), intent(in) :: a,b
type(psb_ld_csr_sparse_mat), intent(out) :: c
integer(psb_ipk_), intent(out) :: info
end subroutine psb_ldcsrspspmm
subroutine psb_ldcscspspmm(a,b,c,info)
use psb_ld_mat_mod, only : psb_ld_csc_sparse_mat
import :: psb_ipk_
implicit none
class(psb_ld_csc_sparse_mat), intent(in) :: a,b
type(psb_ld_csc_sparse_mat), intent(out) :: c
integer(psb_ipk_), intent(out) :: info
end subroutine psb_ldcscspspmm
end interface
interface psb_symbmm
subroutine psb_ldsymbmm(a,b,c,info)
use psb_ld_mat_mod, only : psb_ldspmat_type
import :: psb_ipk_
implicit none
type(psb_ldspmat_type), intent(in) :: a,b
type(psb_ldspmat_type), intent(out) :: c
integer(psb_ipk_), intent(out) :: info
end subroutine psb_ldsymbmm
subroutine psb_ldbase_symbmm(a,b,c,info)
use psb_ld_mat_mod, only : psb_ld_base_sparse_mat, psb_ld_csr_sparse_mat
import :: psb_ipk_
implicit none
class(psb_ld_base_sparse_mat), intent(in) :: a,b
type(psb_ld_csr_sparse_mat), intent(out) :: c
integer(psb_ipk_), intent(out) :: info
end subroutine psb_ldbase_symbmm
end interface psb_symbmm
interface psb_numbmm
subroutine psb_ldnumbmm(a,b,c)
use psb_ld_mat_mod, only : psb_ldspmat_type
import :: psb_ipk_
implicit none
type(psb_ldspmat_type), intent(in) :: a,b
type(psb_ldspmat_type), intent(inout) :: c
end subroutine psb_ldnumbmm
subroutine psb_ldbase_numbmm(a,b,c)
use psb_ld_mat_mod, only : psb_ld_base_sparse_mat, psb_ld_csr_sparse_mat
import :: psb_ipk_
implicit none
class(psb_ld_base_sparse_mat), intent(in) :: a,b
type(psb_ld_csr_sparse_mat), intent(inout) :: c
end subroutine psb_ldbase_numbmm
end interface psb_numbmm
interface psb_rwextd
subroutine psb_ldrwextd(nr,a,info,b,rowscale)
use psb_ld_mat_mod, only : psb_ldspmat_type
import :: psb_ipk_
implicit none
integer(psb_ipk_), intent(in) :: nr
type(psb_ldspmat_type), intent(inout) :: a
integer(psb_ipk_),intent(out) :: info
type(psb_ldspmat_type), intent(in), optional :: b
logical,intent(in), optional :: rowscale
end subroutine psb_ldrwextd
subroutine psb_ldbase_rwextd(nr,a,info,b,rowscale)
use psb_ld_mat_mod, only : psb_ld_base_sparse_mat
import :: psb_ipk_
implicit none
integer(psb_ipk_), intent(in) :: nr
class(psb_ld_base_sparse_mat), intent(inout) :: a
integer(psb_ipk_),intent(out) :: info
class(psb_ld_base_sparse_mat), intent(in), optional :: b
logical,intent(in), optional :: rowscale
end subroutine psb_ldbase_rwextd
end interface psb_rwextd
interface psb_geprt
subroutine psb_ldgeprtn2(fname,a,head)
use psb_const_mod, only : psb_dpk_, psb_ipk_
character(len=*), intent(in) :: fname
real(psb_dpk_), intent(in) :: a(:,:)
character(len=*), optional :: head
end subroutine psb_ldgeprtn2
subroutine psb_ldgeprtn1(fname,a,head)
use psb_const_mod, only : psb_dpk_, psb_ipk_
character(len=*), intent(in) :: fname
real(psb_dpk_), intent(in) :: a(:)
character(len=*), optional :: head
end subroutine psb_ldgeprtn1
subroutine psb_ldgeprt2(iout,a,head)
use psb_const_mod, only : psb_dpk_, psb_ipk_
integer(psb_ipk_), intent(in) :: iout
real(psb_dpk_), intent(in) :: a(:,:)
character(len=*), optional :: head
end subroutine psb_ldgeprt2
subroutine psb_ldgeprt1(iout,a,head)
use psb_const_mod, only : psb_dpk_, psb_ipk_
integer(psb_ipk_), intent(in) :: iout
real(psb_dpk_), intent(in) :: a(:)
character(len=*), optional :: head
end subroutine psb_ldgeprt1
end interface psb_geprt
interface psb_csprt
module procedure psb_ldcsprt, psb_ldcsprtn
end interface psb_csprt
interface psb_spdot_srtd
function psb_ld_spdot_srtd(nv1,iv1,v1,nv2,iv2,v2) result(dot)
use psb_const_mod, only : psb_ipk_, psb_dpk_
integer(psb_ipk_), intent(in) :: nv1,nv2
integer(psb_ipk_), intent(in) :: iv1(*), iv2(*)
real(psb_dpk_), intent(in) :: v1(*),v2(*)
real(psb_dpk_) :: dot
end function psb_ld_spdot_srtd
end interface psb_spdot_srtd
interface psb_spge_dot
function psb_ld_spge_dot(nv1,iv1,v1,v2) result(dot)
use psb_const_mod, only : psb_ipk_, psb_dpk_
integer(psb_ipk_), intent(in) :: nv1
integer(psb_ipk_), intent(in) :: iv1(*)
real(psb_dpk_), intent(in) :: v1(*),v2(*)
real(psb_dpk_) :: dot
end function psb_ld_spge_dot
end interface psb_spge_dot
interface psb_aspxpby
subroutine psb_ld_aspxpby(alpha, nx, ix, x, beta, y, info)
use psb_const_mod, only : psb_ipk_, psb_dpk_
integer(psb_ipk_), intent(in) :: nx
integer(psb_ipk_), intent(in) :: ix(:)
real(psb_dpk_), intent (in) :: x(:)
real(psb_dpk_), intent (inout) :: y(:)
real(psb_dpk_), intent (in) :: alpha, beta
integer(psb_ipk_), intent(out) :: info
end subroutine psb_ld_aspxpby
end interface psb_aspxpby
contains
subroutine psb_ldcsprt(iout,a,iv,head,ivr,ivc)
use psb_ld_mat_mod, only : psb_ldspmat_type
integer(psb_ipk_), intent(in) :: iout
type(psb_ldspmat_type), intent(in) :: a
integer(psb_ipk_), intent(in), optional :: iv(:)
character(len=*), optional :: head
integer(psb_ipk_), intent(in), optional :: ivr(:),ivc(:)
call a%print(iout,iv,head,ivr,ivc)
end subroutine psb_ldcsprt
subroutine psb_ldcsprtn(fname,a,iv,head,ivr,ivc)
use psb_ld_mat_mod, only : psb_ldspmat_type
character(len=*), intent(in) :: fname
type(psb_ldspmat_type), intent(in) :: a
integer(psb_ipk_), intent(in), optional :: iv(:)
character(len=*), optional :: head
integer(psb_ipk_), intent(in), optional :: ivr(:),ivc(:)
call a%print(fname,iv,head,ivr,ivc)
end subroutine psb_ldcsprtn
end module psb_ld_serial_mod

2320
base/serial/impl/psb_c_lbase_mat_impl.F90
View File

File diff suppressed because it is too large Load Diff

4127
base/serial/impl/psb_c_lcoo_impl.f90
View File

File diff suppressed because it is too large Load Diff

2320
base/serial/impl/psb_d_lbase_mat_impl.F90
View File

File diff suppressed because it is too large Load Diff

4127
base/serial/impl/psb_d_lcoo_impl.f90
View File

File diff suppressed because it is too large Load Diff

2320
base/serial/impl/psb_s_lbase_mat_impl.F90
View File

File diff suppressed because it is too large Load Diff

4127
base/serial/impl/psb_s_lcoo_impl.f90
View File

File diff suppressed because it is too large Load Diff

2320
base/serial/impl/psb_z_lbase_mat_impl.F90
View File

File diff suppressed because it is too large Load Diff

4127
base/serial/impl/psb_z_lcoo_impl.f90
View File

File diff suppressed because it is too large Load Diff
Write Preview
Loading…
Cancel
Save