! Parallel Sparse BLAS GPU plugin
! (C) Copyright 2013
!
! Salvatore Filippone
! Alessandro Fanfarillo
!
! 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_c_dns_mat_mod
use psb_c_base_mat_mod
type, extends(psb_c_base_sparse_mat) :: psb_c_dns_sparse_mat
!
! DNS format: a very simple dense matrix storage
! psb_spk_ : kind for double precision reals
! psb_ipk_: kind for normal integers.
! psb_sizeof_dp: variable holding size in bytes of
! a double
! psb_sizeof_ip: size in bytes of an integer
!
! psb_realloc(n,v,info) Reallocate: does what it says
! psb_realloc(m,n,a,info) on rank 1 and 2 arrays, may start
! from unallocated
!
!
integer(psb_ipk_) :: nnz
complex(psb_spk_), allocatable :: val(:,:)
contains
procedure, pass(a) :: get_size => c_dns_get_size
procedure, pass(a) :: get_nzeros => c_dns_get_nzeros
procedure, nopass :: get_fmt => c_dns_get_fmt
procedure, pass(a) :: sizeof => c_dns_sizeof
procedure, pass(a) :: csmv => psb_c_dns_csmv
procedure, pass(a) :: csmm => psb_c_dns_csmm
procedure, pass(a) :: csnmi => psb_c_dns_csnmi
procedure, pass(a) :: reallocate_nz => psb_c_dns_reallocate_nz
procedure, pass(a) :: allocate_mnnz => psb_c_dns_allocate_mnnz
procedure, pass(a) :: cp_to_coo => psb_c_cp_dns_to_coo
procedure, pass(a) :: cp_from_coo => psb_c_cp_dns_from_coo
procedure, pass(a) :: mv_to_coo => psb_c_mv_dns_to_coo
procedure, pass(a) :: mv_from_coo => psb_c_mv_dns_from_coo
procedure, pass(a) :: get_diag => psb_c_dns_get_diag
procedure, pass(a) :: csgetrow => psb_c_dns_csgetrow
procedure, pass(a) :: get_nz_row => c_dns_get_nz_row
procedure, pass(a) :: trim => psb_c_dns_trim
procedure, pass(a) :: free => c_dns_free
procedure, pass(a) :: mold => psb_c_dns_mold
end type psb_c_dns_sparse_mat
private :: c_dns_get_nzeros, c_dns_free, c_dns_get_fmt, &
& c_dns_get_size, c_dns_sizeof, c_dns_get_nz_row
!
!
!> Function reallocate_nz
!! \memberof psb_c_dns_sparse_mat
!! \brief One--parameters version of (re)allocate
!!
!! \param nz number of nonzeros to allocate for
!! i.e. makes sure that the internal storage
!! allows for NZ coefficients and their indices.
!
interface
subroutine psb_c_dns_reallocate_nz(nz,a)
import :: psb_c_dns_sparse_mat, psb_ipk_
integer(psb_ipk_), intent(in) :: nz
class(psb_c_dns_sparse_mat), intent(inout) :: a
end subroutine psb_c_dns_reallocate_nz
end interface
!> Function trim
!! \memberof psb_c_dns_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_c_dns_trim(a)
import :: psb_c_dns_sparse_mat
class(psb_c_dns_sparse_mat), intent(inout) :: a
end subroutine psb_c_dns_trim
end interface
!
!> Function mold:
!! \memberof psb_c_dns_sparse_mat
!! \brief Allocate a class(psb_c_dns_sparse_mat) with the
!! same dynamic type as the input.
!! This is equivalent to allocate( mold= ) and is provided
!! for those compilers not yet supporting mold.
!! \param b The output variable
!! \param info return code
!
interface
subroutine psb_c_dns_mold(a,b,info)
import :: psb_c_dns_sparse_mat, psb_c_base_sparse_mat, psb_epk_, psb_ipk_
class(psb_c_dns_sparse_mat), intent(in) :: a
class(psb_c_base_sparse_mat), intent(inout), allocatable :: b
integer(psb_ipk_), intent(out) :: info
end subroutine psb_c_dns_mold
end interface
!
!
!> Function allocate_mnnz
!! \memberof psb_c_dns_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_c_dns_allocate_mnnz(m,n,a,nz)
import :: psb_c_dns_sparse_mat, psb_ipk_
integer(psb_ipk_), intent(in) :: m,n
class(psb_c_dns_sparse_mat), intent(inout) :: a
integer(psb_ipk_), intent(in), optional :: nz
end subroutine psb_c_dns_allocate_mnnz
end interface
!
!> Function cp_to_coo:
!! \memberof psb_c_dns_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_cp_dns_to_coo(a,b,info)
import :: psb_c_coo_sparse_mat, psb_c_dns_sparse_mat, psb_ipk_
class(psb_c_dns_sparse_mat), intent(in) :: a
class(psb_c_coo_sparse_mat), intent(inout) :: b
integer(psb_ipk_), intent(out) :: info
end subroutine psb_c_cp_dns_to_coo
end interface
!
!> Function cp_from_coo:
!! \memberof psb_c_dns_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_cp_dns_from_coo(a,b,info)
import :: psb_c_dns_sparse_mat, psb_c_coo_sparse_mat, psb_ipk_
class(psb_c_dns_sparse_mat), intent(inout) :: a
class(psb_c_coo_sparse_mat), intent(in) :: b
integer(psb_ipk_), intent(out) :: info
end subroutine psb_c_cp_dns_from_coo
end interface
!
!> Function mv_to_coo:
!! \memberof psb_c_dns_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_mv_dns_to_coo(a,b,info)
import :: psb_c_dns_sparse_mat, psb_c_coo_sparse_mat, psb_ipk_
class(psb_c_dns_sparse_mat), intent(inout) :: a
class(psb_c_coo_sparse_mat), intent(inout) :: b
integer(psb_ipk_), intent(out) :: info
end subroutine psb_c_mv_dns_to_coo
end interface
!
!> Function mv_from_coo:
!! \memberof psb_c_dns_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_mv_dns_from_coo(a,b,info)
import :: psb_c_dns_sparse_mat, psb_c_coo_sparse_mat, psb_ipk_
class(psb_c_dns_sparse_mat), intent(inout) :: a
class(psb_c_coo_sparse_mat), intent(inout) :: b
integer(psb_ipk_), intent(out) :: info
end subroutine psb_c_mv_dns_from_coo
end interface
!
!
!> Function csgetrow:
!! \memberof psb_c_dns_sparse_mat
!! \brief Get a (subset of) row(s)
!!
!! getrow is the basic method by which the other (getblk, clip) can
!! be implemented.
!!
!! Returns the set
!! NZ, IA(1:nz), JA(1:nz), VAL(1:NZ)
!! each identifying the position of a nonzero in A
!! i.e.
!! VAL(1:NZ) = A(IA(1:NZ),JA(1:NZ))
!! with IMIN<=IA(:)<=IMAX
!! with JMIN<=JA(:)<=JMAX
!! 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 val(:) the output coefficients
!! \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_c_dns_csgetrow(imin,imax,a,nz,ia,ja,val,info,&
& jmin,jmax,iren,append,nzin,rscale,cscale,chksz)
import :: psb_c_dns_sparse_mat, psb_spk_, psb_ipk_
class(psb_c_dns_sparse_mat), intent(in) :: a
integer(psb_ipk_), intent(in) :: imin,imax
integer(psb_ipk_), intent(out) :: nz
integer(psb_ipk_), allocatable, intent(inout) :: ia(:), ja(:)
complex(psb_spk_), allocatable, intent(inout) :: val(:)
integer(psb_ipk_),intent(out) :: info
logical, intent(in), optional :: append
integer(psb_ipk_), intent(in), optional :: iren(:)
integer(psb_ipk_), intent(in), optional :: jmin,jmax, nzin
logical, intent(in), optional :: rscale,cscale,chksz
end subroutine psb_c_dns_csgetrow
end interface
!> Function csmv:
!! \memberof psb_c_dns_sparse_mat
!! \brief Product by a dense rank 1 array.
!!
!! Compute
!! Y = alpha*op(A)*X + beta*Y
!!
!! \param alpha Scaling factor for Ax
!! \param A the input sparse matrix
!! \param x(:) the input dense X
!! \param beta Scaling factor for y
!! \param y(:) the input/output dense Y
!! \param info return code
!! \param trans [N] Whether to use A (N), its transpose (T)
!! or its conjugate transpose (C)
!!
!
interface
subroutine psb_c_dns_csmv(alpha,a,x,beta,y,info,trans)
import :: psb_c_dns_sparse_mat, psb_spk_, psb_ipk_
class(psb_c_dns_sparse_mat), intent(in) :: a
complex(psb_spk_), intent(in) :: alpha, beta, x(:)
complex(psb_spk_), intent(inout) :: y(:)
integer(psb_ipk_), intent(out) :: info
character, optional, intent(in) :: trans
end subroutine psb_c_dns_csmv
end interface
!> Function csmm:
!! \memberof psb_c_dns_sparse_mat
!! \brief Product by a dense rank 2 array.
!!
!! Compute
!! Y = alpha*op(A)*X + beta*Y
!!
!! \param alpha Scaling factor for Ax
!! \param A the input sparse matrix
!! \param x(:,:) the input dense X
!! \param beta Scaling factor for y
!! \param y(:,:) the input/output dense Y
!! \param info return code
!! \param trans [N] Whether to use A (N), its transpose (T)
!! or its conjugate transpose (C)
!!
!
interface
subroutine psb_c_dns_csmm(alpha,a,x,beta,y,info,trans)
import :: psb_c_dns_sparse_mat, psb_spk_, psb_ipk_
class(psb_c_dns_sparse_mat), intent(in) :: a
complex(psb_spk_), intent(in) :: alpha, beta, x(:,:)
complex(psb_spk_), intent(inout) :: y(:,:)
integer(psb_ipk_), intent(out) :: info
character, optional, intent(in) :: trans
end subroutine psb_c_dns_csmm
end interface
!
!
!> Function csnmi:
!! \memberof psb_c_dns_sparse_mat
!! \brief Operator infinity norm
!! CSNMI = MAXVAL(SUM(ABS(A(:,:)),dim=2))
!!
!
interface
function psb_c_dns_csnmi(a) result(res)
import :: psb_c_dns_sparse_mat, psb_spk_
class(psb_c_dns_sparse_mat), intent(in) :: a
real(psb_spk_) :: res
end function psb_c_dns_csnmi
end interface
!
!> Function get_diag:
!! \memberof psb_c_dns_sparse_mat
!! \brief Extract the diagonal of A.
!!
!! D(i) = A(i:i), i=1:min(nrows,ncols)
!!
!! \param d(:) The output diagonal
!! \param info return code.
!
interface
subroutine psb_c_dns_get_diag(a,d,info)
import :: psb_c_dns_sparse_mat, psb_spk_, psb_ipk_
class(psb_c_dns_sparse_mat), intent(in) :: a
complex(psb_spk_), intent(out) :: d(:)
integer(psb_ipk_), intent(out) :: info
end subroutine psb_c_dns_get_diag
end interface
contains
!
!> Function sizeof
!! \memberof psb_c_dns_sparse_mat
!! \brief Memory occupation in bytes
!
function c_dns_sizeof(a) result(res)
implicit none
class(psb_c_dns_sparse_mat), intent(in) :: a
integer(psb_epk_) :: res
res = psb_sizeof_dp * size(a%val)
res = res + psb_sizeof_ip
end function c_dns_sizeof
!
!> Function get_fmt
!! \memberof psb_c_dns_sparse_mat
!! \brief return a short descriptive name (e.g. COO CSR etc.)
!
function c_dns_get_fmt() result(res)
implicit none
character(len=5) :: res
res = 'DNS'
end function c_dns_get_fmt
!
!> Function get_nzeros
!! \memberof psb_c_dns_sparse_mat
!! \brief Current number of nonzero entries
!
function c_dns_get_nzeros(a) result(res)
implicit none
class(psb_c_dns_sparse_mat), intent(in) :: a
integer(psb_ipk_) :: res
res = a%nnz
end function c_dns_get_nzeros
!
!> Function get_size
!! \memberof psb_c_dns_sparse_mat
!! \brief Maximum number of nonzeros the current structure can hold
! this is fixed once you initialize the matrix, with dense storage
! you can hold up to MxN entries
function c_dns_get_size(a) result(res)
implicit none
class(psb_c_dns_sparse_mat), intent(in) :: a
integer(psb_ipk_) :: res
res = size(a%val)
end function c_dns_get_size
!
!> Function get_nz_row.
!! \memberof psb_c_coo_sparse_mat
!! \brief How many nonzeros in a row?
!!
!! \param idx The row to search.
!!
!
function c_dns_get_nz_row(idx,a) result(res)
implicit none
class(psb_c_dns_sparse_mat), intent(in) :: a
integer(psb_ipk_), intent(in) :: idx
integer(psb_ipk_) :: res
res = 0
if ((1<=idx).and.(idx<=a%get_nrows())) then
res = count(a%val(idx,:) /= dzero)
end if
end function c_dns_get_nz_row
!
!> Function free
!! \memberof psb_c_dns_sparse_mat
!! Name says all
subroutine c_dns_free(a)
implicit none
class(psb_c_dns_sparse_mat), intent(inout) :: a
if (allocated(a%val)) deallocate(a%val)
a%nnz = 0
!
! Mark the object as empty just in case
!
call a%set_null()
call a%set_nrows(izero)
call a%set_ncols(izero)
return
end subroutine c_dns_free
end module psb_c_dns_mat_mod