psblas3/opt/psb_d_elg_mat_mod.F90

module psb_d_elg_mat_mod

  use iso_c_binding
  use psb_d_base_mat_mod
  use psb_d_ell_mat_mod

  type, extends(psb_d_ell_sparse_mat) :: psb_d_elg_sparse_mat
    !
    ! ITPACK/ELL format, extended.
    ! We are adding here the routines to create a copy of the data
    ! into the GPU. 
    ! If HAVE_ELL_GPU is undefined this is just
    ! a copy of ELL, indistinguishable.
    ! 
#ifdef HAVE_ELL_GPU
    type(c_ptr) :: deviceMat = c_null_ptr

  contains
    procedure, pass(a) :: get_fmt      => d_elg_get_fmt
    procedure, pass(a) :: sizeof       => d_elg_sizeof
    procedure, pass(a) :: d_csmm       => psb_d_elg_csmm
    procedure, pass(a) :: d_csmv       => psb_d_elg_csmv
    procedure, pass(a) :: d_scals      => psb_d_elg_scals
    procedure, pass(a) :: d_scal       => psb_d_elg_scal
    procedure, pass(a) :: reallocate_nz => psb_d_elg_reallocate_nz
    procedure, pass(a) :: allocate_mnnz => psb_d_elg_allocate_mnnz
    procedure, pass(a) :: cp_from_coo  => psb_d_cp_elg_from_coo
    procedure, pass(a) :: cp_from_fmt  => psb_d_cp_elg_from_fmt
    procedure, pass(a) :: mv_from_coo  => psb_d_mv_elg_from_coo
    procedure, pass(a) :: mv_from_fmt  => psb_d_mv_elg_from_fmt
    procedure, pass(a) :: free         => d_elg_free
    procedure, pass(a) :: mold         => psb_d_elg_mold
    procedure, pass(a) :: psb_d_elg_cp_from
    generic, public    :: cp_from => psb_d_elg_cp_from
    procedure, pass(a) :: psb_d_elg_mv_from
    generic, public    :: mv_from => psb_d_elg_mv_from
#endif
  end type psb_d_elg_sparse_mat

#ifdef HAVE_ELL_GPU
  private :: d_elg_get_nzeros, d_elg_free,  d_elg_get_fmt, &
       & d_elg_get_size, d_elg_sizeof, d_elg_get_nz_row

  interface
    subroutine  psb_d_elg_reallocate_nz(nz,a) 
      import :: psb_d_elg_sparse_mat
      integer, intent(in) :: nz
      class(psb_d_elg_sparse_mat), intent(inout) :: a
    end subroutine psb_d_elg_reallocate_nz
  end interface

  interface
    subroutine  psb_d_elg_allocate_mnnz(m,n,a,nz) 
      import :: psb_d_elg_sparse_mat
      integer, intent(in) :: m,n
      class(psb_d_elg_sparse_mat), intent(inout) :: a
      integer, intent(in), optional :: nz
    end subroutine psb_d_elg_allocate_mnnz
  end interface

  interface 
    subroutine psb_d_elg_mold(a,b,info) 
      import :: psb_d_elg_sparse_mat, psb_d_base_sparse_mat, psb_long_int_k_
      class(psb_d_elg_sparse_mat), intent(in)               :: a
      class(psb_d_base_sparse_mat), intent(out), allocatable :: b
      integer, intent(out)                                 :: info
    end subroutine psb_d_elg_mold
  end interface

  interface 
    subroutine psb_d_cp_elg_from_coo(a,b,info) 
      import :: psb_d_elg_sparse_mat, psb_d_coo_sparse_mat
      class(psb_d_elg_sparse_mat), intent(inout) :: a
      class(psb_d_coo_sparse_mat), intent(in)    :: b
      integer, intent(out)                        :: info
    end subroutine psb_d_cp_elg_from_coo
  end interface
  
  interface 
    subroutine psb_d_cp_elg_from_fmt(a,b,info) 
      import :: psb_d_elg_sparse_mat, psb_d_base_sparse_mat
      class(psb_d_elg_sparse_mat), intent(inout) :: a
      class(psb_d_base_sparse_mat), intent(in)   :: b
      integer, intent(out)                        :: info
    end subroutine psb_d_cp_elg_from_fmt
  end interface
  
  interface 
    subroutine psb_d_mv_elg_from_coo(a,b,info) 
      import :: psb_d_elg_sparse_mat, psb_d_coo_sparse_mat
      class(psb_d_elg_sparse_mat), intent(inout) :: a
      class(psb_d_coo_sparse_mat), intent(inout) :: b
      integer, intent(out)                        :: info
    end subroutine psb_d_mv_elg_from_coo
  end interface
  

  interface 
    subroutine psb_d_mv_elg_from_fmt(a,b,info) 
      import :: psb_d_elg_sparse_mat, psb_d_base_sparse_mat
      class(psb_d_elg_sparse_mat), intent(inout)  :: a
      class(psb_d_base_sparse_mat), intent(inout) :: b
      integer, intent(out)                         :: info
    end subroutine psb_d_mv_elg_from_fmt
  end interface
  
  interface 
    subroutine psb_d_elg_cp_from(a,b)
      import :: psb_d_elg_sparse_mat, psb_dpk_
      class(psb_d_elg_sparse_mat), intent(inout) :: a
      type(psb_d_elg_sparse_mat), intent(in)   :: b
    end subroutine psb_d_elg_cp_from
  end interface
  
  interface 
    subroutine psb_d_elg_mv_from(a,b)
      import :: psb_d_elg_sparse_mat, psb_dpk_
      class(psb_d_elg_sparse_mat), intent(inout)  :: a
      type(psb_d_elg_sparse_mat), intent(inout) :: b
    end subroutine psb_d_elg_mv_from
  end interface
  
  interface 
    subroutine psb_d_elg_csmv(alpha,a,x,beta,y,info,trans) 
      import :: psb_d_elg_sparse_mat, psb_dpk_
      class(psb_d_elg_sparse_mat), intent(in) :: a
      real(psb_dpk_), intent(in)          :: alpha, beta, x(:)
      real(psb_dpk_), intent(inout)       :: y(:)
      integer, intent(out)                :: info
      character, optional, intent(in)     :: trans
    end subroutine psb_d_elg_csmv
  end interface
  interface 
    subroutine psb_d_elg_csmm(alpha,a,x,beta,y,info,trans) 
      import :: psb_d_elg_sparse_mat, psb_dpk_
      class(psb_d_elg_sparse_mat), intent(in) :: a
      real(psb_dpk_), intent(in)          :: alpha, beta, x(:,:)
      real(psb_dpk_), intent(inout)       :: y(:,:)
      integer, intent(out)                :: info
      character, optional, intent(in)     :: trans
    end subroutine psb_d_elg_csmm
  end interface
  
  interface 
    subroutine psb_d_elg_scal(d,a,info) 
      import :: psb_d_elg_sparse_mat, psb_dpk_
      class(psb_d_elg_sparse_mat), intent(inout) :: a
      real(psb_dpk_), intent(in)      :: d(:)
      integer, intent(out)            :: info
    end subroutine psb_d_elg_scal
  end interface
  
  interface
    subroutine psb_d_elg_scals(d,a,info) 
      import :: psb_d_elg_sparse_mat, psb_dpk_
      class(psb_d_elg_sparse_mat), intent(inout) :: a
      real(psb_dpk_), intent(in)      :: d
      integer, intent(out)            :: info
    end subroutine psb_d_elg_scals
  end interface
  

contains 

  ! == ===================================
  !
  !
  !
  ! Getters 
  !
  !
  !
  !
  !
  ! == ===================================

  
  function d_elg_sizeof(a) result(res)
    implicit none 
    class(psb_d_elg_sparse_mat), intent(in) :: a
    integer(psb_long_int_k_) :: res
    res = 8 
    res = res + psb_sizeof_dp  * size(a%val)
    res = res + psb_sizeof_int * size(a%irn)
    res = res + psb_sizeof_int * size(a%idiag)
    res = res + psb_sizeof_int * size(a%ja)
    ! Should we account for the shadow data structure
    ! on the GPU device side? 
    ! res = 2*res
      
  end function d_elg_sizeof

  function d_elg_get_fmt(a) result(res)
    implicit none 
    class(psb_d_elg_sparse_mat), intent(in) :: a
    character(len=5) :: res
    res = 'ELG'
  end function d_elg_get_fmt
  
!!$  function d_elg_get_nzeros(a) result(res)
!!$    implicit none 
!!$    class(psb_d_elg_sparse_mat), intent(in) :: a
!!$    integer :: res
!!$    res = sum(a%irn(1:a%get_nrows()))
!!$  end function d_elg_get_nzeros
!!$
!!$  function d_elg_get_size(a) result(res)
!!$    implicit none 
!!$    class(psb_d_elg_sparse_mat), intent(in) :: a
!!$    integer :: res
!!$
!!$    res = -1
!!$    
!!$    if (allocated(a%ja)) then 
!!$      if (res >= 0) then 
!!$        res = min(res,size(a%ja))
!!$      else 
!!$        res = size(a%ja)
!!$      end if
!!$    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 d_elg_get_size
!!$
!!$
!!$
!!$  function  d_elg_get_nz_row(idx,a) result(res)
!!$
!!$    implicit none
!!$    
!!$    class(psb_d_elg_sparse_mat), intent(in) :: a
!!$    integer, intent(in)                  :: idx
!!$    integer                              :: res
!!$    
!!$    res = 0 
!!$ 
!!$    if ((1<=idx).and.(idx<=a%get_nrows())) then 
!!$      res = a%irn(idx)
!!$    end if
!!$    
!!$  end function d_elg_get_nz_row
!!$


  ! == ===================================
  !
  !
  !
  ! Data management
  !
  !
  !
  !
  !
  ! == ===================================  

  subroutine  d_elg_free(a) 
#ifdef HAVE_ELL_GPU
    use elldev_mod
#endif
    implicit none 
    integer :: info

    class(psb_d_elg_sparse_mat), intent(inout) :: a

    if (allocated(a%idiag)) deallocate(a%idiag)
    if (allocated(a%irn)) deallocate(a%irn)
    if (allocated(a%ja))  deallocate(a%ja)
    if (allocated(a%val)) deallocate(a%val)
    call a%set_null()
    call a%set_nrows(0)
    call a%set_ncols(0)
#ifdef HAVE_ELL_GPU 
    call freeEllDevice(a%deviceMat)
#endif
    
    return

  end subroutine d_elg_free

#endif

end module psb_d_elg_mat_mod