Implementation of CSRD. To be tested.

base/modules/serial/psb_c_csr_mat_mod.f90

@@ -596,8 +596,120 @@ module psb_c_csr_mat_mod
       integer(psb_ipk_), intent(out)            :: info
     end subroutine psb_c_csr_scals
   end interface
+
+  type, extends(psb_c_csr_sparse_mat) :: psb_c_csrd_sparse_mat
+
+    !> Pointers to diagonal entries
+    integer(psb_ipk_), allocatable :: diagp(:)
+
+  contains
+    procedure, nopass  :: get_fmt     => c_csrd_get_fmt
+    procedure, pass(a) :: sizeof      => c_csrd_sizeof
+    procedure, pass(a) :: inner_cssm  => psb_c_csrd_cssm
+    procedure, pass(a) :: inner_cssv  => psb_c_csrd_cssv
+    procedure, pass(a) :: trmv        => psb_c_csrd_trmv
+    !procedure, pass(a) :: reallocate_nz => psb_c_csrd_reallocate_nz
+    !procedure, pass(a) :: allocate_mnnz => psb_c_csrd_allocate_mnnz
+!!$    procedure, pass(a) :: cp_to_coo   => psb_c_cp_csrd_to_coo
+    procedure, pass(a) :: cp_from_coo => psb_c_cp_csrd_from_coo
+!!$    procedure, pass(a) :: cp_to_fmt   => psb_c_cp_csrd_to_fmt
+!!$    procedure, pass(a) :: cp_from_fmt => psb_c_cp_csrd_from_fmt
+!!$    procedure, pass(a) :: mv_to_coo   => psb_c_mv_csrd_to_coo
+!!$    procedure, pass(a) :: mv_from_coo => psb_c_mv_csrd_from_coo
+!!$    procedure, pass(a) :: mv_to_fmt   => psb_c_mv_csrd_to_fmt
+!!$    procedure, pass(a) :: mv_from_fmt => psb_c_mv_csrd_from_fmt
+    procedure, pass(a) :: clean_zeros => psb_c_csrd_clean_zeros
+    procedure, pass(a) :: get_diag    => psb_c_csrd_get_diag
+    !procedure, pass(a) :: reinit      => psb_c_csrd_reinit
+    procedure, pass(a) :: trim        => psb_c_csrd_trim
+    procedure, pass(a) :: free        => c_csrd_free
+    procedure, pass(a) :: mold        => psb_c_csrd_mold
+
+  end type psb_c_csrd_sparse_mat
+
+  interface 
+    subroutine  psb_c_csrd_clean_zeros(a, info)
+      import :: psb_ipk_, psb_c_csrd_sparse_mat, psb_spk_
+      implicit none 
+      class(psb_c_csrd_sparse_mat), intent(inout) :: a
+      integer(psb_ipk_), intent(out)  :: info
+    end subroutine psb_c_csrd_clean_zeros
+  end interface
+
+  interface
+    subroutine psb_c_csrd_get_diag(a,d,info)
+      import :: psb_ipk_, psb_c_csrd_sparse_mat, psb_spk_
+      implicit none 
+      class(psb_c_csrd_sparse_mat), intent(in) :: a
+      complex(psb_spk_), intent(out)     :: d(:)
+      integer(psb_ipk_), intent(out)            :: info
+    end subroutine psb_c_csrd_get_diag
+  end interface
+
+  interface 
+    subroutine psb_c_cp_csrd_from_coo(a,b,info)
+      import :: psb_ipk_, psb_c_csrd_sparse_mat, psb_c_coo_sparse_mat, psb_spk_
+      implicit none 
+      class(psb_c_csrd_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_csrd_from_coo
+  end interface
+
+  interface
+    subroutine  psb_c_csrd_trim(a)
+      import :: psb_ipk_, psb_c_csrd_sparse_mat, psb_spk_
+      implicit none 
+      class(psb_c_csrd_sparse_mat), intent(inout) :: a
+    end subroutine psb_c_csrd_trim
+  end interface
   
+  interface 
+    subroutine psb_c_csrd_mold(a,b,info)
+      import :: psb_ipk_, psb_c_csrd_sparse_mat, psb_c_base_sparse_mat, psb_spk_
+      implicit none 
+      class(psb_c_csrd_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_csrd_mold
+  end interface
+  
+  interface 
+    subroutine psb_c_csrd_trmv(alpha,a,x,beta,y,info,uplo,diag)
+      import :: psb_ipk_, psb_c_csrd_sparse_mat, psb_spk_
+      implicit none 
+      class(psb_c_csrd_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) :: uplo, diag
+    end subroutine psb_c_csrd_trmv
+  end interface
 
+  interface 
+    subroutine psb_c_csrd_cssm(alpha,a,x,beta,y,info,trans)
+      import :: psb_ipk_, psb_c_csrd_sparse_mat, psb_spk_      
+      implicit none 
+      class(psb_c_csrd_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_csrd_cssm
+  end interface
+  
+  interface 
+    subroutine psb_c_csrd_cssv(alpha,a,x,beta,y,info,trans)
+      import :: psb_ipk_, psb_c_csrd_sparse_mat, psb_spk_
+      implicit none 
+      class(psb_c_csrd_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_csrd_cssv
+  end interface
+  
 
 contains 
 
@@ -717,4 +829,48 @@ contains
   end subroutine c_csr_free
 
 
+  ! == ===================================
+  !
+  !
+  !
+  ! CSRD specific versions
+  !
+  !
+  !
+  !
+  !
+  ! == ===================================  
+  
+  function c_csrd_sizeof(a) result(res)
+    implicit none 
+    class(psb_c_csrd_sparse_mat), intent(in) :: a
+    integer(psb_long_int_k_) :: res
+    res = 8 
+    res = res + (2*psb_sizeof_sp)  * psb_size(a%val)
+    res = res + psb_sizeof_int * psb_size(a%irp)
+    res = res + psb_sizeof_int * psb_size(a%ja)
+    res = res + psb_sizeof_int * psb_size(a%diagp)
+      
+  end function c_csrd_sizeof
+
+  function c_csrd_get_fmt() result(res)
+    implicit none 
+    character(len=5) :: res
+    res = 'CSRD'
+  end function c_csrd_get_fmt
+  
+
+  subroutine  c_csrd_free(a) 
+    implicit none 
+
+    class(psb_c_csrd_sparse_mat), intent(inout) :: a
+
+    if (allocated(a%diagp)) deallocate(a%diagp)
+    call a%psb_c_csr_sparse_mat%free()
+    
+    return
+
+  end subroutine c_csrd_free
+
+
 end module psb_c_csr_mat_mod

base/modules/serial/psb_d_csr_mat_mod.f90

@@ -596,8 +596,120 @@ module psb_d_csr_mat_mod
       integer(psb_ipk_), intent(out)            :: info
     end subroutine psb_d_csr_scals
   end interface
+
+  type, extends(psb_d_csr_sparse_mat) :: psb_d_csrd_sparse_mat
+
+    !> Pointers to diagonal entries
+    integer(psb_ipk_), allocatable :: diagp(:)
+
+  contains
+    procedure, nopass  :: get_fmt     => d_csrd_get_fmt
+    procedure, pass(a) :: sizeof      => d_csrd_sizeof
+    procedure, pass(a) :: inner_cssm  => psb_d_csrd_cssm
+    procedure, pass(a) :: inner_cssv  => psb_d_csrd_cssv
+    procedure, pass(a) :: trmv        => psb_d_csrd_trmv
+    !procedure, pass(a) :: reallocate_nz => psb_d_csrd_reallocate_nz
+    !procedure, pass(a) :: allocate_mnnz => psb_d_csrd_allocate_mnnz
+!!$    procedure, pass(a) :: cp_to_coo   => psb_d_cp_csrd_to_coo
+    procedure, pass(a) :: cp_from_coo => psb_d_cp_csrd_from_coo
+!!$    procedure, pass(a) :: cp_to_fmt   => psb_d_cp_csrd_to_fmt
+!!$    procedure, pass(a) :: cp_from_fmt => psb_d_cp_csrd_from_fmt
+!!$    procedure, pass(a) :: mv_to_coo   => psb_d_mv_csrd_to_coo
+!!$    procedure, pass(a) :: mv_from_coo => psb_d_mv_csrd_from_coo
+!!$    procedure, pass(a) :: mv_to_fmt   => psb_d_mv_csrd_to_fmt
+!!$    procedure, pass(a) :: mv_from_fmt => psb_d_mv_csrd_from_fmt
+    procedure, pass(a) :: clean_zeros => psb_d_csrd_clean_zeros
+    procedure, pass(a) :: get_diag    => psb_d_csrd_get_diag
+    !procedure, pass(a) :: reinit      => psb_d_csrd_reinit
+    procedure, pass(a) :: trim        => psb_d_csrd_trim
+    procedure, pass(a) :: free        => d_csrd_free
+    procedure, pass(a) :: mold        => psb_d_csrd_mold
+
+  end type psb_d_csrd_sparse_mat
+
+  interface 
+    subroutine  psb_d_csrd_clean_zeros(a, info)
+      import :: psb_ipk_, psb_d_csrd_sparse_mat, psb_dpk_
+      implicit none 
+      class(psb_d_csrd_sparse_mat), intent(inout) :: a
+      integer(psb_ipk_), intent(out)  :: info
+    end subroutine psb_d_csrd_clean_zeros
+  end interface
+
+  interface
+    subroutine psb_d_csrd_get_diag(a,d,info)
+      import :: psb_ipk_, psb_d_csrd_sparse_mat, psb_dpk_
+      implicit none 
+      class(psb_d_csrd_sparse_mat), intent(in) :: a
+      real(psb_dpk_), intent(out)     :: d(:)
+      integer(psb_ipk_), intent(out)            :: info
+    end subroutine psb_d_csrd_get_diag
+  end interface
+
+  interface 
+    subroutine psb_d_cp_csrd_from_coo(a,b,info)
+      import :: psb_ipk_, psb_d_csrd_sparse_mat, psb_d_coo_sparse_mat, psb_dpk_
+      implicit none 
+      class(psb_d_csrd_sparse_mat), intent(inout) :: a
+      class(psb_d_coo_sparse_mat), intent(in)    :: b
+      integer(psb_ipk_), intent(out)               :: info
+    end subroutine psb_d_cp_csrd_from_coo
+  end interface
+
+  interface
+    subroutine  psb_d_csrd_trim(a)
+      import :: psb_ipk_, psb_d_csrd_sparse_mat, psb_dpk_
+      implicit none 
+      class(psb_d_csrd_sparse_mat), intent(inout) :: a
+    end subroutine psb_d_csrd_trim
+  end interface
   
+  interface 
+    subroutine psb_d_csrd_mold(a,b,info)
+      import :: psb_ipk_, psb_d_csrd_sparse_mat, psb_d_base_sparse_mat, psb_dpk_
+      implicit none 
+      class(psb_d_csrd_sparse_mat), intent(in)                  :: a
+      class(psb_d_base_sparse_mat), intent(inout), allocatable :: b
+      integer(psb_ipk_), intent(out)                    :: info
+    end subroutine psb_d_csrd_mold
+  end interface
+  
+  interface 
+    subroutine psb_d_csrd_trmv(alpha,a,x,beta,y,info,uplo,diag)
+      import :: psb_ipk_, psb_d_csrd_sparse_mat, psb_dpk_
+      implicit none 
+      class(psb_d_csrd_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) :: uplo, diag
+    end subroutine psb_d_csrd_trmv
+  end interface
 
+  interface 
+    subroutine psb_d_csrd_cssm(alpha,a,x,beta,y,info,trans)
+      import :: psb_ipk_, psb_d_csrd_sparse_mat, psb_dpk_      
+      implicit none 
+      class(psb_d_csrd_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_d_csrd_cssm
+  end interface
+  
+  interface 
+    subroutine psb_d_csrd_cssv(alpha,a,x,beta,y,info,trans)
+      import :: psb_ipk_, psb_d_csrd_sparse_mat, psb_dpk_
+      implicit none 
+      class(psb_d_csrd_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_d_csrd_cssv
+  end interface
+  
 
 contains 
 
@@ -717,4 +829,48 @@ contains
   end subroutine d_csr_free
 
 
+  ! == ===================================
+  !
+  !
+  !
+  ! CSRD specific versions
+  !
+  !
+  !
+  !
+  !
+  ! == ===================================  
+  
+  function d_csrd_sizeof(a) result(res)
+    implicit none 
+    class(psb_d_csrd_sparse_mat), intent(in) :: a
+    integer(psb_long_int_k_) :: res
+    res = 8 
+    res = res + psb_sizeof_dp  * psb_size(a%val)
+    res = res + psb_sizeof_int * psb_size(a%irp)
+    res = res + psb_sizeof_int * psb_size(a%ja)
+    res = res + psb_sizeof_int * psb_size(a%diagp)
+      
+  end function d_csrd_sizeof
+
+  function d_csrd_get_fmt() result(res)
+    implicit none 
+    character(len=5) :: res
+    res = 'CSRD'
+  end function d_csrd_get_fmt
+  
+
+  subroutine  d_csrd_free(a) 
+    implicit none 
+
+    class(psb_d_csrd_sparse_mat), intent(inout) :: a
+
+    if (allocated(a%diagp)) deallocate(a%diagp)
+    call a%psb_d_csr_sparse_mat%free()
+    
+    return
+
+  end subroutine d_csrd_free
+
+
 end module psb_d_csr_mat_mod

base/modules/serial/psb_s_csr_mat_mod.f90

@@ -596,8 +596,120 @@ module psb_s_csr_mat_mod
       integer(psb_ipk_), intent(out)            :: info
     end subroutine psb_s_csr_scals
   end interface
+
+  type, extends(psb_s_csr_sparse_mat) :: psb_s_csrd_sparse_mat
+
+    !> Pointers to diagonal entries
+    integer(psb_ipk_), allocatable :: diagp(:)
+
+  contains
+    procedure, nopass  :: get_fmt     => s_csrd_get_fmt
+    procedure, pass(a) :: sizeof      => s_csrd_sizeof
+    procedure, pass(a) :: inner_cssm  => psb_s_csrd_cssm
+    procedure, pass(a) :: inner_cssv  => psb_s_csrd_cssv
+    procedure, pass(a) :: trmv        => psb_s_csrd_trmv
+    !procedure, pass(a) :: reallocate_nz => psb_s_csrd_reallocate_nz
+    !procedure, pass(a) :: allocate_mnnz => psb_s_csrd_allocate_mnnz
+!!$    procedure, pass(a) :: cp_to_coo   => psb_s_cp_csrd_to_coo
+    procedure, pass(a) :: cp_from_coo => psb_s_cp_csrd_from_coo
+!!$    procedure, pass(a) :: cp_to_fmt   => psb_s_cp_csrd_to_fmt
+!!$    procedure, pass(a) :: cp_from_fmt => psb_s_cp_csrd_from_fmt
+!!$    procedure, pass(a) :: mv_to_coo   => psb_s_mv_csrd_to_coo
+!!$    procedure, pass(a) :: mv_from_coo => psb_s_mv_csrd_from_coo
+!!$    procedure, pass(a) :: mv_to_fmt   => psb_s_mv_csrd_to_fmt
+!!$    procedure, pass(a) :: mv_from_fmt => psb_s_mv_csrd_from_fmt
+    procedure, pass(a) :: clean_zeros => psb_s_csrd_clean_zeros
+    procedure, pass(a) :: get_diag    => psb_s_csrd_get_diag
+    !procedure, pass(a) :: reinit      => psb_s_csrd_reinit
+    procedure, pass(a) :: trim        => psb_s_csrd_trim
+    procedure, pass(a) :: free        => s_csrd_free
+    procedure, pass(a) :: mold        => psb_s_csrd_mold
+
+  end type psb_s_csrd_sparse_mat
+
+  interface 
+    subroutine  psb_s_csrd_clean_zeros(a, info)
+      import :: psb_ipk_, psb_s_csrd_sparse_mat, psb_spk_
+      implicit none 
+      class(psb_s_csrd_sparse_mat), intent(inout) :: a
+      integer(psb_ipk_), intent(out)  :: info
+    end subroutine psb_s_csrd_clean_zeros
+  end interface
+
+  interface
+    subroutine psb_s_csrd_get_diag(a,d,info)
+      import :: psb_ipk_, psb_s_csrd_sparse_mat, psb_spk_
+      implicit none 
+      class(psb_s_csrd_sparse_mat), intent(in) :: a
+      real(psb_spk_), intent(out)     :: d(:)
+      integer(psb_ipk_), intent(out)            :: info
+    end subroutine psb_s_csrd_get_diag
+  end interface
+
+  interface 
+    subroutine psb_s_cp_csrd_from_coo(a,b,info)
+      import :: psb_ipk_, psb_s_csrd_sparse_mat, psb_s_coo_sparse_mat, psb_spk_
+      implicit none 
+      class(psb_s_csrd_sparse_mat), intent(inout) :: a
+      class(psb_s_coo_sparse_mat), intent(in)    :: b
+      integer(psb_ipk_), intent(out)               :: info
+    end subroutine psb_s_cp_csrd_from_coo
+  end interface
+
+  interface
+    subroutine  psb_s_csrd_trim(a)
+      import :: psb_ipk_, psb_s_csrd_sparse_mat, psb_spk_
+      implicit none 
+      class(psb_s_csrd_sparse_mat), intent(inout) :: a
+    end subroutine psb_s_csrd_trim
+  end interface
   
+  interface 
+    subroutine psb_s_csrd_mold(a,b,info)
+      import :: psb_ipk_, psb_s_csrd_sparse_mat, psb_s_base_sparse_mat, psb_spk_
+      implicit none 
+      class(psb_s_csrd_sparse_mat), intent(in)                  :: a
+      class(psb_s_base_sparse_mat), intent(inout), allocatable :: b
+      integer(psb_ipk_), intent(out)                    :: info
+    end subroutine psb_s_csrd_mold
+  end interface
+  
+  interface 
+    subroutine psb_s_csrd_trmv(alpha,a,x,beta,y,info,uplo,diag)
+      import :: psb_ipk_, psb_s_csrd_sparse_mat, psb_spk_
+      implicit none 
+      class(psb_s_csrd_sparse_mat), intent(in) :: a
+      real(psb_spk_), intent(in)    :: alpha, beta, x(:)
+      real(psb_spk_), intent(inout) :: y(:)
+      integer(psb_ipk_), intent(out)            :: info
+      character, optional, intent(in) :: uplo, diag
+    end subroutine psb_s_csrd_trmv
+  end interface
 
+  interface 
+    subroutine psb_s_csrd_cssm(alpha,a,x,beta,y,info,trans)
+      import :: psb_ipk_, psb_s_csrd_sparse_mat, psb_spk_      
+      implicit none 
+      class(psb_s_csrd_sparse_mat), intent(in) :: a
+      real(psb_spk_), intent(in)          :: alpha, beta, x(:,:)
+      real(psb_spk_), intent(inout)       :: y(:,:)
+      integer(psb_ipk_), intent(out)                :: info
+      character, optional, intent(in)     :: trans
+    end subroutine psb_s_csrd_cssm
+  end interface
+  
+  interface 
+    subroutine psb_s_csrd_cssv(alpha,a,x,beta,y,info,trans)
+      import :: psb_ipk_, psb_s_csrd_sparse_mat, psb_spk_
+      implicit none 
+      class(psb_s_csrd_sparse_mat), intent(in) :: a
+      real(psb_spk_), intent(in)          :: alpha, beta, x(:)
+      real(psb_spk_), intent(inout)       :: y(:)
+      integer(psb_ipk_), intent(out)                :: info
+      character, optional, intent(in)     :: trans
+    end subroutine psb_s_csrd_cssv
+  end interface
+  
 
 contains 
 
@@ -717,4 +829,48 @@ contains
   end subroutine s_csr_free
 
 
+  ! == ===================================
+  !
+  !
+  !
+  ! CSRD specific versions
+  !
+  !
+  !
+  !
+  !
+  ! == ===================================  
+  
+  function s_csrd_sizeof(a) result(res)
+    implicit none 
+    class(psb_s_csrd_sparse_mat), intent(in) :: a
+    integer(psb_long_int_k_) :: res
+    res = 8 
+    res = res + psb_sizeof_sp  * psb_size(a%val)
+    res = res + psb_sizeof_int * psb_size(a%irp)
+    res = res + psb_sizeof_int * psb_size(a%ja)
+    res = res + psb_sizeof_int * psb_size(a%diagp)
+      
+  end function s_csrd_sizeof
+
+  function s_csrd_get_fmt() result(res)
+    implicit none 
+    character(len=5) :: res
+    res = 'CSRD'
+  end function s_csrd_get_fmt
+  
+
+  subroutine  s_csrd_free(a) 
+    implicit none 
+
+    class(psb_s_csrd_sparse_mat), intent(inout) :: a
+
+    if (allocated(a%diagp)) deallocate(a%diagp)
+    call a%psb_s_csr_sparse_mat%free()
+    
+    return
+
+  end subroutine s_csrd_free
+
+
 end module psb_s_csr_mat_mod

base/modules/serial/psb_z_csr_mat_mod.f90

@@ -596,8 +596,120 @@ module psb_z_csr_mat_mod
       integer(psb_ipk_), intent(out)            :: info
     end subroutine psb_z_csr_scals
   end interface
+
+  type, extends(psb_z_csr_sparse_mat) :: psb_z_csrd_sparse_mat
+
+    !> Pointers to diagonal entries
+    integer(psb_ipk_), allocatable :: diagp(:)
+
+  contains
+    procedure, nopass  :: get_fmt     => z_csrd_get_fmt
+    procedure, pass(a) :: sizeof      => z_csrd_sizeof
+    procedure, pass(a) :: inner_cssm  => psb_z_csrd_cssm
+    procedure, pass(a) :: inner_cssv  => psb_z_csrd_cssv
+    procedure, pass(a) :: trmv        => psb_z_csrd_trmv
+    !procedure, pass(a) :: reallocate_nz => psb_z_csrd_reallocate_nz
+    !procedure, pass(a) :: allocate_mnnz => psb_z_csrd_allocate_mnnz
+!!$    procedure, pass(a) :: cp_to_coo   => psb_z_cp_csrd_to_coo
+    procedure, pass(a) :: cp_from_coo => psb_z_cp_csrd_from_coo
+!!$    procedure, pass(a) :: cp_to_fmt   => psb_z_cp_csrd_to_fmt
+!!$    procedure, pass(a) :: cp_from_fmt => psb_z_cp_csrd_from_fmt
+!!$    procedure, pass(a) :: mv_to_coo   => psb_z_mv_csrd_to_coo
+!!$    procedure, pass(a) :: mv_from_coo => psb_z_mv_csrd_from_coo
+!!$    procedure, pass(a) :: mv_to_fmt   => psb_z_mv_csrd_to_fmt
+!!$    procedure, pass(a) :: mv_from_fmt => psb_z_mv_csrd_from_fmt
+    procedure, pass(a) :: clean_zeros => psb_z_csrd_clean_zeros
+    procedure, pass(a) :: get_diag    => psb_z_csrd_get_diag
+    !procedure, pass(a) :: reinit      => psb_z_csrd_reinit
+    procedure, pass(a) :: trim        => psb_z_csrd_trim
+    procedure, pass(a) :: free        => z_csrd_free
+    procedure, pass(a) :: mold        => psb_z_csrd_mold
+
+  end type psb_z_csrd_sparse_mat
+
+  interface 
+    subroutine  psb_z_csrd_clean_zeros(a, info)
+      import :: psb_ipk_, psb_z_csrd_sparse_mat, psb_dpk_
+      implicit none 
+      class(psb_z_csrd_sparse_mat), intent(inout) :: a
+      integer(psb_ipk_), intent(out)  :: info
+    end subroutine psb_z_csrd_clean_zeros
+  end interface
+
+  interface
+    subroutine psb_z_csrd_get_diag(a,d,info)
+      import :: psb_ipk_, psb_z_csrd_sparse_mat, psb_dpk_
+      implicit none 
+      class(psb_z_csrd_sparse_mat), intent(in) :: a
+      complex(psb_dpk_), intent(out)     :: d(:)
+      integer(psb_ipk_), intent(out)            :: info
+    end subroutine psb_z_csrd_get_diag
+  end interface
+
+  interface 
+    subroutine psb_z_cp_csrd_from_coo(a,b,info)
+      import :: psb_ipk_, psb_z_csrd_sparse_mat, psb_z_coo_sparse_mat, psb_dpk_
+      implicit none 
+      class(psb_z_csrd_sparse_mat), intent(inout) :: a
+      class(psb_z_coo_sparse_mat), intent(in)    :: b
+      integer(psb_ipk_), intent(out)               :: info
+    end subroutine psb_z_cp_csrd_from_coo
+  end interface
+
+  interface
+    subroutine  psb_z_csrd_trim(a)
+      import :: psb_ipk_, psb_z_csrd_sparse_mat, psb_dpk_
+      implicit none 
+      class(psb_z_csrd_sparse_mat), intent(inout) :: a
+    end subroutine psb_z_csrd_trim
+  end interface
   
+  interface 
+    subroutine psb_z_csrd_mold(a,b,info)
+      import :: psb_ipk_, psb_z_csrd_sparse_mat, psb_z_base_sparse_mat, psb_dpk_
+      implicit none 
+      class(psb_z_csrd_sparse_mat), intent(in)                  :: a
+      class(psb_z_base_sparse_mat), intent(inout), allocatable :: b
+      integer(psb_ipk_), intent(out)                    :: info
+    end subroutine psb_z_csrd_mold
+  end interface
+  
+  interface 
+    subroutine psb_z_csrd_trmv(alpha,a,x,beta,y,info,uplo,diag)
+      import :: psb_ipk_, psb_z_csrd_sparse_mat, psb_dpk_
+      implicit none 
+      class(psb_z_csrd_sparse_mat), intent(in) :: a
+      complex(psb_dpk_), intent(in)    :: alpha, beta, x(:)
+      complex(psb_dpk_), intent(inout) :: y(:)
+      integer(psb_ipk_), intent(out)            :: info
+      character, optional, intent(in) :: uplo, diag
+    end subroutine psb_z_csrd_trmv
+  end interface
 
+  interface 
+    subroutine psb_z_csrd_cssm(alpha,a,x,beta,y,info,trans)
+      import :: psb_ipk_, psb_z_csrd_sparse_mat, psb_dpk_      
+      implicit none 
+      class(psb_z_csrd_sparse_mat), intent(in) :: a
+      complex(psb_dpk_), intent(in)          :: alpha, beta, x(:,:)
+      complex(psb_dpk_), intent(inout)       :: y(:,:)
+      integer(psb_ipk_), intent(out)                :: info
+      character, optional, intent(in)     :: trans
+    end subroutine psb_z_csrd_cssm
+  end interface
+  
+  interface 
+    subroutine psb_z_csrd_cssv(alpha,a,x,beta,y,info,trans)
+      import :: psb_ipk_, psb_z_csrd_sparse_mat, psb_dpk_
+      implicit none 
+      class(psb_z_csrd_sparse_mat), intent(in) :: a
+      complex(psb_dpk_), intent(in)          :: alpha, beta, x(:)
+      complex(psb_dpk_), intent(inout)       :: y(:)
+      integer(psb_ipk_), intent(out)                :: info
+      character, optional, intent(in)     :: trans
+    end subroutine psb_z_csrd_cssv
+  end interface
+  
 
 contains 
 
@@ -717,4 +829,48 @@ contains
   end subroutine z_csr_free
 
 
+  ! == ===================================
+  !
+  !
+  !
+  ! CSRD specific versions
+  !
+  !
+  !
+  !
+  !
+  ! == ===================================  
+  
+  function z_csrd_sizeof(a) result(res)
+    implicit none 
+    class(psb_z_csrd_sparse_mat), intent(in) :: a
+    integer(psb_long_int_k_) :: res
+    res = 8 
+    res = res + (2*psb_sizeof_dp)  * psb_size(a%val)
+    res = res + psb_sizeof_int * psb_size(a%irp)
+    res = res + psb_sizeof_int * psb_size(a%ja)
+    res = res + psb_sizeof_int * psb_size(a%diagp)
+      
+  end function z_csrd_sizeof
+
+  function z_csrd_get_fmt() result(res)
+    implicit none 
+    character(len=5) :: res
+    res = 'CSRD'
+  end function z_csrd_get_fmt
+  
+
+  subroutine  z_csrd_free(a) 
+    implicit none 
+
+    class(psb_z_csrd_sparse_mat), intent(inout) :: a
+
+    if (allocated(a%diagp)) deallocate(a%diagp)
+    call a%psb_z_csr_sparse_mat%free()
+    
+    return
+
+  end subroutine z_csrd_free
+
+
 end module psb_z_csr_mat_mod

base/serial/impl/psb_c_base_mat_impl.F90

@@ -1184,17 +1184,28 @@ subroutine psb_c_base_csmm(alpha,a,x,beta,y,info,trans)
 
   integer(psb_ipk_) :: err_act
   integer(psb_ipk_) :: ierr(5)
-  character(len=20)  :: name='c_base_csmm'
+  integer(psb_ipk_) :: j,nc
+  character(len=20)  :: name='c_base_csmm'  
   logical, parameter :: debug=.false.
 
   call psb_erractionsave(err_act)
-  ! This is the base version. If we get here
-  ! it means the derived class is incomplete,
-  ! so we throw an error.
-  info = psb_err_missing_override_method_
-  call psb_errpush(info,name,a_err=a%get_fmt())
+  ! This is the base version. 
+  ! It's a very inefficient implementation,
+  ! but it's only a fallback, if multivectors
+  ! are important you are supposed to implement it
+  ! explicitly in the derived class. 
+  info = psb_success_
+  nc   = min(size(x,2),size(y,2))
+  do j=1,nc
+    call a%spmm(alpha,x(j,:),beta,y(:,j),info,trans)
+    if (info /= psb_success_) goto 9999
+  end do  
 
-  call psb_error_handler(err_act)
+  call psb_erractionrestore(err_act)
+
+  return
+
+9999 call psb_error_handler(err_act)
 
 end subroutine psb_c_base_csmm
 
@@ -1266,17 +1277,29 @@ subroutine psb_c_base_inner_cssm(alpha,a,x,beta,y,info,trans)
 
   integer(psb_ipk_) :: err_act
   integer(psb_ipk_) :: ierr(5)
+  integer(psb_ipk_) :: j, nc 
   character(len=20)  :: name='c_base_inner_cssm'
   logical, parameter :: debug=.false.
 
   call psb_erractionsave(err_act)
-  ! This is the base version. If we get here
-  ! it means the derived class is incomplete,
-  ! so we throw an error.
-  info = psb_err_missing_override_method_
-  call psb_errpush(info,name,a_err=a%get_fmt())
+  ! This is the base version. 
+  ! It's a very inefficient implementation,
+  ! but it's only a fallback, if multivectors
+  ! are important you are supposed to implement it
+  ! explicitly in the derived class. 
+  info = psb_success_
+  nc   = min(size(x,2),size(y,2))
+  do j=1,nc
+    call a%spsm(alpha,x(j,:),beta,y(:,j),info,trans)
+    if (info /= psb_success_) goto 9999
+  end do  
+
+  call psb_erractionrestore(err_act)
+
+  return
+
+9999 call psb_error_handler(err_act)
 
-  call psb_error_handler(err_act)
 
 end subroutine psb_c_base_inner_cssm
 

base/serial/impl/psb_d_base_mat_impl.F90

@@ -1184,17 +1184,28 @@ subroutine psb_d_base_csmm(alpha,a,x,beta,y,info,trans)
 
   integer(psb_ipk_) :: err_act
   integer(psb_ipk_) :: ierr(5)
-  character(len=20)  :: name='d_base_csmm'
+  integer(psb_ipk_) :: j,nc
+  character(len=20)  :: name='d_base_csmm'  
   logical, parameter :: debug=.false.
 
   call psb_erractionsave(err_act)
-  ! This is the base version. If we get here
-  ! it means the derived class is incomplete,
-  ! so we throw an error.
-  info = psb_err_missing_override_method_
-  call psb_errpush(info,name,a_err=a%get_fmt())
+  ! This is the base version. 
+  ! It's a very inefficient implementation,
+  ! but it's only a fallback, if multivectors
+  ! are important you are supposed to implement it
+  ! explicitly in the derived class. 
+  info = psb_success_
+  nc   = min(size(x,2),size(y,2))
+  do j=1,nc
+    call a%spmm(alpha,x(j,:),beta,y(:,j),info,trans)
+    if (info /= psb_success_) goto 9999
+  end do  
 
-  call psb_error_handler(err_act)
+  call psb_erractionrestore(err_act)
+
+  return
+
+9999 call psb_error_handler(err_act)
 
 end subroutine psb_d_base_csmm
 
@@ -1266,17 +1277,29 @@ subroutine psb_d_base_inner_cssm(alpha,a,x,beta,y,info,trans)
 
   integer(psb_ipk_) :: err_act
   integer(psb_ipk_) :: ierr(5)
+  integer(psb_ipk_) :: j, nc 
   character(len=20)  :: name='d_base_inner_cssm'
   logical, parameter :: debug=.false.
 
   call psb_erractionsave(err_act)
-  ! This is the base version. If we get here
-  ! it means the derived class is incomplete,
-  ! so we throw an error.
-  info = psb_err_missing_override_method_
-  call psb_errpush(info,name,a_err=a%get_fmt())
+  ! This is the base version. 
+  ! It's a very inefficient implementation,
+  ! but it's only a fallback, if multivectors
+  ! are important you are supposed to implement it
+  ! explicitly in the derived class. 
+  info = psb_success_
+  nc   = min(size(x,2),size(y,2))
+  do j=1,nc
+    call a%spsm(alpha,x(j,:),beta,y(:,j),info,trans)
+    if (info /= psb_success_) goto 9999
+  end do  
+
+  call psb_erractionrestore(err_act)
+
+  return
+
+9999 call psb_error_handler(err_act)
 
-  call psb_error_handler(err_act)
 
 end subroutine psb_d_base_inner_cssm
 

base/serial/impl/psb_s_base_mat_impl.F90

@@ -1184,17 +1184,28 @@ subroutine psb_s_base_csmm(alpha,a,x,beta,y,info,trans)
 
   integer(psb_ipk_) :: err_act
   integer(psb_ipk_) :: ierr(5)
-  character(len=20)  :: name='s_base_csmm'
+  integer(psb_ipk_) :: j,nc
+  character(len=20)  :: name='s_base_csmm'  
   logical, parameter :: debug=.false.
 
   call psb_erractionsave(err_act)
-  ! This is the base version. If we get here
-  ! it means the derived class is incomplete,
-  ! so we throw an error.
-  info = psb_err_missing_override_method_
-  call psb_errpush(info,name,a_err=a%get_fmt())
+  ! This is the base version. 
+  ! It's a very inefficient implementation,
+  ! but it's only a fallback, if multivectors
+  ! are important you are supposed to implement it
+  ! explicitly in the derived class. 
+  info = psb_success_
+  nc   = min(size(x,2),size(y,2))
+  do j=1,nc
+    call a%spmm(alpha,x(j,:),beta,y(:,j),info,trans)
+    if (info /= psb_success_) goto 9999
+  end do  
 
-  call psb_error_handler(err_act)
+  call psb_erractionrestore(err_act)
+
+  return
+
+9999 call psb_error_handler(err_act)
 
 end subroutine psb_s_base_csmm
 
@@ -1266,17 +1277,29 @@ subroutine psb_s_base_inner_cssm(alpha,a,x,beta,y,info,trans)
 
   integer(psb_ipk_) :: err_act
   integer(psb_ipk_) :: ierr(5)
+  integer(psb_ipk_) :: j, nc 
   character(len=20)  :: name='s_base_inner_cssm'
   logical, parameter :: debug=.false.
 
   call psb_erractionsave(err_act)
-  ! This is the base version. If we get here
-  ! it means the derived class is incomplete,
-  ! so we throw an error.
-  info = psb_err_missing_override_method_
-  call psb_errpush(info,name,a_err=a%get_fmt())
+  ! This is the base version. 
+  ! It's a very inefficient implementation,
+  ! but it's only a fallback, if multivectors
+  ! are important you are supposed to implement it
+  ! explicitly in the derived class. 
+  info = psb_success_
+  nc   = min(size(x,2),size(y,2))
+  do j=1,nc
+    call a%spsm(alpha,x(j,:),beta,y(:,j),info,trans)
+    if (info /= psb_success_) goto 9999
+  end do  
+
+  call psb_erractionrestore(err_act)
+
+  return
+
+9999 call psb_error_handler(err_act)
 
-  call psb_error_handler(err_act)
 
 end subroutine psb_s_base_inner_cssm
 

base/serial/impl/psb_z_base_mat_impl.F90

@@ -1184,17 +1184,28 @@ subroutine psb_z_base_csmm(alpha,a,x,beta,y,info,trans)
 
   integer(psb_ipk_) :: err_act
   integer(psb_ipk_) :: ierr(5)
-  character(len=20)  :: name='z_base_csmm'
+  integer(psb_ipk_) :: j,nc
+  character(len=20)  :: name='z_base_csmm'  
   logical, parameter :: debug=.false.
 
   call psb_erractionsave(err_act)
-  ! This is the base version. If we get here
-  ! it means the derived class is incomplete,
-  ! so we throw an error.
-  info = psb_err_missing_override_method_
-  call psb_errpush(info,name,a_err=a%get_fmt())
+  ! This is the base version. 
+  ! It's a very inefficient implementation,
+  ! but it's only a fallback, if multivectors
+  ! are important you are supposed to implement it
+  ! explicitly in the derived class. 
+  info = psb_success_
+  nc   = min(size(x,2),size(y,2))
+  do j=1,nc
+    call a%spmm(alpha,x(j,:),beta,y(:,j),info,trans)
+    if (info /= psb_success_) goto 9999
+  end do  
 
-  call psb_error_handler(err_act)
+  call psb_erractionrestore(err_act)
+
+  return
+
+9999 call psb_error_handler(err_act)
 
 end subroutine psb_z_base_csmm
 
@@ -1266,17 +1277,29 @@ subroutine psb_z_base_inner_cssm(alpha,a,x,beta,y,info,trans)
 
   integer(psb_ipk_) :: err_act
   integer(psb_ipk_) :: ierr(5)
+  integer(psb_ipk_) :: j, nc 
   character(len=20)  :: name='z_base_inner_cssm'
   logical, parameter :: debug=.false.
 
   call psb_erractionsave(err_act)
-  ! This is the base version. If we get here
-  ! it means the derived class is incomplete,
-  ! so we throw an error.
-  info = psb_err_missing_override_method_
-  call psb_errpush(info,name,a_err=a%get_fmt())
+  ! This is the base version. 
+  ! It's a very inefficient implementation,
+  ! but it's only a fallback, if multivectors
+  ! are important you are supposed to implement it
+  ! explicitly in the derived class. 
+  info = psb_success_
+  nc   = min(size(x,2),size(y,2))
+  do j=1,nc
+    call a%spsm(alpha,x(j,:),beta,y(:,j),info,trans)
+    if (info /= psb_success_) goto 9999
+  end do  
+
+  call psb_erractionrestore(err_act)
+
+  return
+
+9999 call psb_error_handler(err_act)
 
-  call psb_error_handler(err_act)
 
 end subroutine psb_z_base_inner_cssm