Implement clip_diag for LX

base/modules/serial/psb_c_mat_mod.F90

@@ -370,6 +370,9 @@ module psb_c_mat_mod
     generic, public    :: cp_from     => cp_from_b
     procedure, pass(a) :: cp_to_b     => psb_lc_cp_to
     generic, public    :: cp_to       => cp_to_b
+    procedure, pass(a) :: clip_d_ip   => psb_lc_clip_d_ip
+    procedure, pass(a) :: clip_d      => psb_lc_clip_d
+    generic, public    :: clip_diag   => clip_d_ip, clip_d
     procedure, pass(a) :: cscnv_np    => psb_lc_cscnv
     procedure, pass(a) :: cscnv_ip    => psb_lc_cscnv_ip
     procedure, pass(a) :: cscnv_base  => psb_lc_cscnv_base
@@ -1553,6 +1556,28 @@ module psb_c_mat_mod
   end interface
   
   
+  !
+  ! Produce a version of the matrix with diagonal cut
+  ! out; passes through a COO buffer. 
+  !
+  interface 
+    subroutine psb_lc_clip_d(a,b,info)
+      import :: psb_ipk_, psb_lpk_, psb_lcspmat_type
+      class(psb_lcspmat_type), intent(in)    :: a
+      class(psb_lcspmat_type), intent(inout) :: b
+      integer(psb_ipk_),intent(out)                  :: info
+    end subroutine psb_lc_clip_d
+  end interface
+  
+  interface 
+    subroutine psb_lc_clip_d_ip(a,info)
+      import :: psb_ipk_, psb_lpk_, psb_lcspmat_type
+      class(psb_lcspmat_type), intent(inout) :: a
+      integer(psb_ipk_),intent(out)                  :: info
+    end subroutine psb_lc_clip_d_ip
+  end interface
+  
+  
   !
   ! These four interfaces cut through the
   ! encapsulation between spmat_type and base_sparse_mat.

base/modules/serial/psb_d_mat_mod.F90

@@ -370,6 +370,9 @@ module psb_d_mat_mod
     generic, public    :: cp_from     => cp_from_b
     procedure, pass(a) :: cp_to_b     => psb_ld_cp_to
     generic, public    :: cp_to       => cp_to_b
+    procedure, pass(a) :: clip_d_ip   => psb_ld_clip_d_ip
+    procedure, pass(a) :: clip_d      => psb_ld_clip_d
+    generic, public    :: clip_diag   => clip_d_ip, clip_d
     procedure, pass(a) :: cscnv_np    => psb_ld_cscnv
     procedure, pass(a) :: cscnv_ip    => psb_ld_cscnv_ip
     procedure, pass(a) :: cscnv_base  => psb_ld_cscnv_base
@@ -1553,6 +1556,28 @@ module psb_d_mat_mod
   end interface
   
   
+  !
+  ! Produce a version of the matrix with diagonal cut
+  ! out; passes through a COO buffer. 
+  !
+  interface 
+    subroutine psb_ld_clip_d(a,b,info)
+      import :: psb_ipk_, psb_lpk_, psb_ldspmat_type
+      class(psb_ldspmat_type), intent(in)    :: a
+      class(psb_ldspmat_type), intent(inout) :: b
+      integer(psb_ipk_),intent(out)                  :: info
+    end subroutine psb_ld_clip_d
+  end interface
+  
+  interface 
+    subroutine psb_ld_clip_d_ip(a,info)
+      import :: psb_ipk_, psb_lpk_, psb_ldspmat_type
+      class(psb_ldspmat_type), intent(inout) :: a
+      integer(psb_ipk_),intent(out)                  :: info
+    end subroutine psb_ld_clip_d_ip
+  end interface
+  
+  
   !
   ! These four interfaces cut through the
   ! encapsulation between spmat_type and base_sparse_mat.

base/modules/serial/psb_s_mat_mod.F90

@@ -370,6 +370,9 @@ module psb_s_mat_mod
     generic, public    :: cp_from     => cp_from_b
     procedure, pass(a) :: cp_to_b     => psb_ls_cp_to
     generic, public    :: cp_to       => cp_to_b
+    procedure, pass(a) :: clip_d_ip   => psb_ls_clip_d_ip
+    procedure, pass(a) :: clip_d      => psb_ls_clip_d
+    generic, public    :: clip_diag   => clip_d_ip, clip_d
     procedure, pass(a) :: cscnv_np    => psb_ls_cscnv
     procedure, pass(a) :: cscnv_ip    => psb_ls_cscnv_ip
     procedure, pass(a) :: cscnv_base  => psb_ls_cscnv_base
@@ -1553,6 +1556,28 @@ module psb_s_mat_mod
   end interface
   
   
+  !
+  ! Produce a version of the matrix with diagonal cut
+  ! out; passes through a COO buffer. 
+  !
+  interface 
+    subroutine psb_ls_clip_d(a,b,info)
+      import :: psb_ipk_, psb_lpk_, psb_lsspmat_type
+      class(psb_lsspmat_type), intent(in)    :: a
+      class(psb_lsspmat_type), intent(inout) :: b
+      integer(psb_ipk_),intent(out)                  :: info
+    end subroutine psb_ls_clip_d
+  end interface
+  
+  interface 
+    subroutine psb_ls_clip_d_ip(a,info)
+      import :: psb_ipk_, psb_lpk_, psb_lsspmat_type
+      class(psb_lsspmat_type), intent(inout) :: a
+      integer(psb_ipk_),intent(out)                  :: info
+    end subroutine psb_ls_clip_d_ip
+  end interface
+  
+  
   !
   ! These four interfaces cut through the
   ! encapsulation between spmat_type and base_sparse_mat.

base/modules/serial/psb_z_mat_mod.F90

@@ -370,6 +370,9 @@ module psb_z_mat_mod
     generic, public    :: cp_from     => cp_from_b
     procedure, pass(a) :: cp_to_b     => psb_lz_cp_to
     generic, public    :: cp_to       => cp_to_b
+    procedure, pass(a) :: clip_d_ip   => psb_lz_clip_d_ip
+    procedure, pass(a) :: clip_d      => psb_lz_clip_d
+    generic, public    :: clip_diag   => clip_d_ip, clip_d
     procedure, pass(a) :: cscnv_np    => psb_lz_cscnv
     procedure, pass(a) :: cscnv_ip    => psb_lz_cscnv_ip
     procedure, pass(a) :: cscnv_base  => psb_lz_cscnv_base
@@ -1553,6 +1556,28 @@ module psb_z_mat_mod
   end interface
   
   
+  !
+  ! Produce a version of the matrix with diagonal cut
+  ! out; passes through a COO buffer. 
+  !
+  interface 
+    subroutine psb_lz_clip_d(a,b,info)
+      import :: psb_ipk_, psb_lpk_, psb_lzspmat_type
+      class(psb_lzspmat_type), intent(in)    :: a
+      class(psb_lzspmat_type), intent(inout) :: b
+      integer(psb_ipk_),intent(out)                  :: info
+    end subroutine psb_lz_clip_d
+  end interface
+  
+  interface 
+    subroutine psb_lz_clip_d_ip(a,info)
+      import :: psb_ipk_, psb_lpk_, psb_lzspmat_type
+      class(psb_lzspmat_type), intent(inout) :: a
+      integer(psb_ipk_),intent(out)                  :: info
+    end subroutine psb_lz_clip_d_ip
+  end interface
+  
+  
   !
   ! These four interfaces cut through the
   ! encapsulation between spmat_type and base_sparse_mat.

base/serial/impl/psb_c_mat_impl.F90

@@ -3933,123 +3933,123 @@ end subroutine psb_lc_cscnv_base
 
 
 
-!!$subroutine psb_lc_clip_d(a,b,info)
-!!$  ! Output is always in  COO format 
-!!$  use psb_error_mod
-!!$  use psb_const_mod
-!!$  use psb_c_base_mat_mod
-!!$  use psb_c_mat_mod, psb_protect_name => psb_lc_clip_d
-!!$  implicit none
-!!$
-!!$  class(psb_lcspmat_type), intent(in)    :: a
-!!$  class(psb_lcspmat_type), intent(inout) :: b
-!!$  integer(psb_ipk_),intent(out)                  :: info
-!!$
-!!$  integer(psb_ipk_) :: err_act
-!!$  character(len=20)  :: name='clip_diag'
-!!$  logical, parameter :: debug=.false.
-!!$  type(psb_lc_coo_sparse_mat), allocatable  :: acoo
-!!$  integer(psb_lpk_) :: i, j, nz
-!!$
-!!$  info = psb_success_
-!!$  call psb_erractionsave(err_act)
-!!$  if (a%is_null()) then 
-!!$    info = psb_err_invalid_mat_state_
-!!$    call psb_errpush(info,name)
-!!$    goto 9999
-!!$  endif
-!!$
-!!$  allocate(acoo,stat=info)    
-!!$  if (info == psb_success_) call a%a%cp_to_coo(acoo,info)
-!!$  if (info /= psb_success_) then 
-!!$    info = psb_err_alloc_dealloc_
-!!$    call psb_errpush(info,name)
-!!$    goto 9999
-!!$  endif
-!!$
-!!$  nz = acoo%get_nzeros()
-!!$  j = 0
-!!$  do i=1, nz
-!!$    if (acoo%ia(i) /= acoo%ja(i)) then 
-!!$      j = j + 1 
-!!$      acoo%ia(j)  = acoo%ia(i)
-!!$      acoo%ja(j)  = acoo%ja(i)
-!!$      acoo%val(j) = acoo%val(i)
-!!$    end if
-!!$  end do
-!!$  call acoo%set_nzeros(j)
-!!$  call acoo%trim()
-!!$  call b%mv_from(acoo)
-!!$
-!!$  call psb_erractionrestore(err_act)
-!!$  return
-!!$
-!!$
-!!$9999 call psb_error_handler(err_act)
-!!$
-!!$  return
-!!$
-!!$end subroutine psb_lc_clip_d
-!!$
-!!$
-!!$
-!!$subroutine psb_lc_clip_d_ip(a,info)
-!!$  ! Output is always in  COO format 
-!!$  use psb_error_mod
-!!$  use psb_const_mod
-!!$  use psb_c_base_mat_mod
-!!$  use psb_c_mat_mod, psb_protect_name => psb_lc_clip_d_ip
-!!$  implicit none
-!!$
-!!$  class(psb_lcspmat_type), intent(inout) :: a
-!!$  integer(psb_ipk_),intent(out)                  :: info
-!!$
-!!$  integer(psb_ipk_) :: err_act
-!!$  character(len=20)  :: name='clip_diag'
-!!$  logical, parameter :: debug=.false.
-!!$  type(psb_lc_coo_sparse_mat), allocatable  :: acoo
-!!$  integer(psb_lpk_) :: i, j, nz
-!!$
-!!$  info = psb_success_
-!!$  call psb_erractionsave(err_act)
-!!$  if (a%is_null()) then 
-!!$    info = psb_err_invalid_mat_state_
-!!$    call psb_errpush(info,name)
-!!$    goto 9999
-!!$  endif
-!!$
-!!$  allocate(acoo,stat=info)    
-!!$  if (info == psb_success_) call a%a%mv_to_coo(acoo,info)
-!!$  if (info /= psb_success_) then
-!!$    info = psb_err_alloc_dealloc_
-!!$    call psb_errpush(info,name)
-!!$    goto 9999
-!!$  endif
-!!$
-!!$  nz = acoo%get_nzeros()
-!!$  j = 0
-!!$  do i=1, nz
-!!$    if (acoo%ia(i) /= acoo%ja(i)) then 
-!!$      j = j + 1 
-!!$      acoo%ia(j)  = acoo%ia(i)
-!!$      acoo%ja(j)  = acoo%ja(i)
-!!$      acoo%val(j) = acoo%val(i)
-!!$    end if
-!!$  end do
-!!$  call acoo%set_nzeros(j)
-!!$  call acoo%trim()
-!!$  call a%mv_from(acoo)
-!!$
-!!$  call psb_erractionrestore(err_act)
-!!$  return
-!!$
-!!$
-!!$9999 call psb_error_handler(err_act)
-!!$
-!!$  return
-!!$
-!!$end subroutine psb_lc_clip_d_ip
-!!$
+subroutine psb_lc_clip_d(a,b,info)
+  ! Output is always in  COO format 
+  use psb_error_mod
+  use psb_const_mod
+  use psb_c_base_mat_mod
+  use psb_c_mat_mod, psb_protect_name => psb_lc_clip_d
+  implicit none
+
+  class(psb_lcspmat_type), intent(in)    :: a
+  class(psb_lcspmat_type), intent(inout) :: b
+  integer(psb_ipk_),intent(out)                  :: info
+
+  integer(psb_ipk_) :: err_act
+  character(len=20)  :: name='clip_diag'
+  logical, parameter :: debug=.false.
+  type(psb_lc_coo_sparse_mat), allocatable  :: acoo
+  integer(psb_lpk_) :: i, j, nz
+
+  info = psb_success_
+  call psb_erractionsave(err_act)
+  if (a%is_null()) then 
+    info = psb_err_invalid_mat_state_
+    call psb_errpush(info,name)
+    goto 9999
+  endif
+
+  allocate(acoo,stat=info)    
+  if (info == psb_success_) call a%a%cp_to_coo(acoo,info)
+  if (info /= psb_success_) then 
+    info = psb_err_alloc_dealloc_
+    call psb_errpush(info,name)
+    goto 9999
+  endif
+
+  nz = acoo%get_nzeros()
+  j = 0
+  do i=1, nz
+    if (acoo%ia(i) /= acoo%ja(i)) then 
+      j = j + 1 
+      acoo%ia(j)  = acoo%ia(i)
+      acoo%ja(j)  = acoo%ja(i)
+      acoo%val(j) = acoo%val(i)
+    end if
+  end do
+  call acoo%set_nzeros(j)
+  call acoo%trim()
+  call b%mv_from(acoo)
+
+  call psb_erractionrestore(err_act)
+  return
+
+
+9999 call psb_error_handler(err_act)
+
+  return
+
+end subroutine psb_lc_clip_d
+
+
+
+subroutine psb_lc_clip_d_ip(a,info)
+  ! Output is always in  COO format 
+  use psb_error_mod
+  use psb_const_mod
+  use psb_c_base_mat_mod
+  use psb_c_mat_mod, psb_protect_name => psb_lc_clip_d_ip
+  implicit none
+
+  class(psb_lcspmat_type), intent(inout) :: a
+  integer(psb_ipk_),intent(out)                  :: info
+
+  integer(psb_ipk_) :: err_act
+  character(len=20)  :: name='clip_diag'
+  logical, parameter :: debug=.false.
+  type(psb_lc_coo_sparse_mat), allocatable  :: acoo
+  integer(psb_lpk_) :: i, j, nz
+
+  info = psb_success_
+  call psb_erractionsave(err_act)
+  if (a%is_null()) then 
+    info = psb_err_invalid_mat_state_
+    call psb_errpush(info,name)
+    goto 9999
+  endif
+
+  allocate(acoo,stat=info)    
+  if (info == psb_success_) call a%a%mv_to_coo(acoo,info)
+  if (info /= psb_success_) then
+    info = psb_err_alloc_dealloc_
+    call psb_errpush(info,name)
+    goto 9999
+  endif
+
+  nz = acoo%get_nzeros()
+  j = 0
+  do i=1, nz
+    if (acoo%ia(i) /= acoo%ja(i)) then 
+      j = j + 1 
+      acoo%ia(j)  = acoo%ia(i)
+      acoo%ja(j)  = acoo%ja(i)
+      acoo%val(j) = acoo%val(i)
+    end if
+  end do
+  call acoo%set_nzeros(j)
+  call acoo%trim()
+  call a%mv_from(acoo)
+
+  call psb_erractionrestore(err_act)
+  return
+
+
+9999 call psb_error_handler(err_act)
+
+  return
+
+end subroutine psb_lc_clip_d_ip
+
 
 subroutine psb_lc_mv_from(a,b)
   use psb_error_mod

base/serial/impl/psb_d_mat_impl.F90

@@ -3933,123 +3933,123 @@ end subroutine psb_ld_cscnv_base
 
 
 
-!!$subroutine psb_ld_clip_d(a,b,info)
-!!$  ! Output is always in  COO format 
-!!$  use psb_error_mod
-!!$  use psb_const_mod
-!!$  use psb_d_base_mat_mod
-!!$  use psb_d_mat_mod, psb_protect_name => psb_ld_clip_d
-!!$  implicit none
-!!$
-!!$  class(psb_ldspmat_type), intent(in)    :: a
-!!$  class(psb_ldspmat_type), intent(inout) :: b
-!!$  integer(psb_ipk_),intent(out)                  :: info
-!!$
-!!$  integer(psb_ipk_) :: err_act
-!!$  character(len=20)  :: name='clip_diag'
-!!$  logical, parameter :: debug=.false.
-!!$  type(psb_ld_coo_sparse_mat), allocatable  :: acoo
-!!$  integer(psb_lpk_) :: i, j, nz
-!!$
-!!$  info = psb_success_
-!!$  call psb_erractionsave(err_act)
-!!$  if (a%is_null()) then 
-!!$    info = psb_err_invalid_mat_state_
-!!$    call psb_errpush(info,name)
-!!$    goto 9999
-!!$  endif
-!!$
-!!$  allocate(acoo,stat=info)    
-!!$  if (info == psb_success_) call a%a%cp_to_coo(acoo,info)
-!!$  if (info /= psb_success_) then 
-!!$    info = psb_err_alloc_dealloc_
-!!$    call psb_errpush(info,name)
-!!$    goto 9999
-!!$  endif
-!!$
-!!$  nz = acoo%get_nzeros()
-!!$  j = 0
-!!$  do i=1, nz
-!!$    if (acoo%ia(i) /= acoo%ja(i)) then 
-!!$      j = j + 1 
-!!$      acoo%ia(j)  = acoo%ia(i)
-!!$      acoo%ja(j)  = acoo%ja(i)
-!!$      acoo%val(j) = acoo%val(i)
-!!$    end if
-!!$  end do
-!!$  call acoo%set_nzeros(j)
-!!$  call acoo%trim()
-!!$  call b%mv_from(acoo)
-!!$
-!!$  call psb_erractionrestore(err_act)
-!!$  return
-!!$
-!!$
-!!$9999 call psb_error_handler(err_act)
-!!$
-!!$  return
-!!$
-!!$end subroutine psb_ld_clip_d
-!!$
-!!$
-!!$
-!!$subroutine psb_ld_clip_d_ip(a,info)
-!!$  ! Output is always in  COO format 
-!!$  use psb_error_mod
-!!$  use psb_const_mod
-!!$  use psb_d_base_mat_mod
-!!$  use psb_d_mat_mod, psb_protect_name => psb_ld_clip_d_ip
-!!$  implicit none
-!!$
-!!$  class(psb_ldspmat_type), intent(inout) :: a
-!!$  integer(psb_ipk_),intent(out)                  :: info
-!!$
-!!$  integer(psb_ipk_) :: err_act
-!!$  character(len=20)  :: name='clip_diag'
-!!$  logical, parameter :: debug=.false.
-!!$  type(psb_ld_coo_sparse_mat), allocatable  :: acoo
-!!$  integer(psb_lpk_) :: i, j, nz
-!!$
-!!$  info = psb_success_
-!!$  call psb_erractionsave(err_act)
-!!$  if (a%is_null()) then 
-!!$    info = psb_err_invalid_mat_state_
-!!$    call psb_errpush(info,name)
-!!$    goto 9999
-!!$  endif
-!!$
-!!$  allocate(acoo,stat=info)    
-!!$  if (info == psb_success_) call a%a%mv_to_coo(acoo,info)
-!!$  if (info /= psb_success_) then
-!!$    info = psb_err_alloc_dealloc_
-!!$    call psb_errpush(info,name)
-!!$    goto 9999
-!!$  endif
-!!$
-!!$  nz = acoo%get_nzeros()
-!!$  j = 0
-!!$  do i=1, nz
-!!$    if (acoo%ia(i) /= acoo%ja(i)) then 
-!!$      j = j + 1 
-!!$      acoo%ia(j)  = acoo%ia(i)
-!!$      acoo%ja(j)  = acoo%ja(i)
-!!$      acoo%val(j) = acoo%val(i)
-!!$    end if
-!!$  end do
-!!$  call acoo%set_nzeros(j)
-!!$  call acoo%trim()
-!!$  call a%mv_from(acoo)
-!!$
-!!$  call psb_erractionrestore(err_act)
-!!$  return
-!!$
-!!$
-!!$9999 call psb_error_handler(err_act)
-!!$
-!!$  return
-!!$
-!!$end subroutine psb_ld_clip_d_ip
-!!$
+subroutine psb_ld_clip_d(a,b,info)
+  ! Output is always in  COO format 
+  use psb_error_mod
+  use psb_const_mod
+  use psb_d_base_mat_mod
+  use psb_d_mat_mod, psb_protect_name => psb_ld_clip_d
+  implicit none
+
+  class(psb_ldspmat_type), intent(in)    :: a
+  class(psb_ldspmat_type), intent(inout) :: b
+  integer(psb_ipk_),intent(out)                  :: info
+
+  integer(psb_ipk_) :: err_act
+  character(len=20)  :: name='clip_diag'
+  logical, parameter :: debug=.false.
+  type(psb_ld_coo_sparse_mat), allocatable  :: acoo
+  integer(psb_lpk_) :: i, j, nz
+
+  info = psb_success_
+  call psb_erractionsave(err_act)
+  if (a%is_null()) then 
+    info = psb_err_invalid_mat_state_
+    call psb_errpush(info,name)
+    goto 9999
+  endif
+
+  allocate(acoo,stat=info)    
+  if (info == psb_success_) call a%a%cp_to_coo(acoo,info)
+  if (info /= psb_success_) then 
+    info = psb_err_alloc_dealloc_
+    call psb_errpush(info,name)
+    goto 9999
+  endif
+
+  nz = acoo%get_nzeros()
+  j = 0
+  do i=1, nz
+    if (acoo%ia(i) /= acoo%ja(i)) then 
+      j = j + 1 
+      acoo%ia(j)  = acoo%ia(i)
+      acoo%ja(j)  = acoo%ja(i)
+      acoo%val(j) = acoo%val(i)
+    end if
+  end do
+  call acoo%set_nzeros(j)
+  call acoo%trim()
+  call b%mv_from(acoo)
+
+  call psb_erractionrestore(err_act)
+  return
+
+
+9999 call psb_error_handler(err_act)
+
+  return
+
+end subroutine psb_ld_clip_d
+
+
+
+subroutine psb_ld_clip_d_ip(a,info)
+  ! Output is always in  COO format 
+  use psb_error_mod
+  use psb_const_mod
+  use psb_d_base_mat_mod
+  use psb_d_mat_mod, psb_protect_name => psb_ld_clip_d_ip
+  implicit none
+
+  class(psb_ldspmat_type), intent(inout) :: a
+  integer(psb_ipk_),intent(out)                  :: info
+
+  integer(psb_ipk_) :: err_act
+  character(len=20)  :: name='clip_diag'
+  logical, parameter :: debug=.false.
+  type(psb_ld_coo_sparse_mat), allocatable  :: acoo
+  integer(psb_lpk_) :: i, j, nz
+
+  info = psb_success_
+  call psb_erractionsave(err_act)
+  if (a%is_null()) then 
+    info = psb_err_invalid_mat_state_
+    call psb_errpush(info,name)
+    goto 9999
+  endif
+
+  allocate(acoo,stat=info)    
+  if (info == psb_success_) call a%a%mv_to_coo(acoo,info)
+  if (info /= psb_success_) then
+    info = psb_err_alloc_dealloc_
+    call psb_errpush(info,name)
+    goto 9999
+  endif
+
+  nz = acoo%get_nzeros()
+  j = 0
+  do i=1, nz
+    if (acoo%ia(i) /= acoo%ja(i)) then 
+      j = j + 1 
+      acoo%ia(j)  = acoo%ia(i)
+      acoo%ja(j)  = acoo%ja(i)
+      acoo%val(j) = acoo%val(i)
+    end if
+  end do
+  call acoo%set_nzeros(j)
+  call acoo%trim()
+  call a%mv_from(acoo)
+
+  call psb_erractionrestore(err_act)
+  return
+
+
+9999 call psb_error_handler(err_act)
+
+  return
+
+end subroutine psb_ld_clip_d_ip
+
 
 subroutine psb_ld_mv_from(a,b)
   use psb_error_mod

base/serial/impl/psb_s_mat_impl.F90

@@ -3933,123 +3933,123 @@ end subroutine psb_ls_cscnv_base
 
 
 
-!!$subroutine psb_ls_clip_d(a,b,info)
-!!$  ! Output is always in  COO format 
-!!$  use psb_error_mod
-!!$  use psb_const_mod
-!!$  use psb_s_base_mat_mod
-!!$  use psb_s_mat_mod, psb_protect_name => psb_ls_clip_d
-!!$  implicit none
-!!$
-!!$  class(psb_lsspmat_type), intent(in)    :: a
-!!$  class(psb_lsspmat_type), intent(inout) :: b
-!!$  integer(psb_ipk_),intent(out)                  :: info
-!!$
-!!$  integer(psb_ipk_) :: err_act
-!!$  character(len=20)  :: name='clip_diag'
-!!$  logical, parameter :: debug=.false.
-!!$  type(psb_ls_coo_sparse_mat), allocatable  :: acoo
-!!$  integer(psb_lpk_) :: i, j, nz
-!!$
-!!$  info = psb_success_
-!!$  call psb_erractionsave(err_act)
-!!$  if (a%is_null()) then 
-!!$    info = psb_err_invalid_mat_state_
-!!$    call psb_errpush(info,name)
-!!$    goto 9999
-!!$  endif
-!!$
-!!$  allocate(acoo,stat=info)    
-!!$  if (info == psb_success_) call a%a%cp_to_coo(acoo,info)
-!!$  if (info /= psb_success_) then 
-!!$    info = psb_err_alloc_dealloc_
-!!$    call psb_errpush(info,name)
-!!$    goto 9999
-!!$  endif
-!!$
-!!$  nz = acoo%get_nzeros()
-!!$  j = 0
-!!$  do i=1, nz
-!!$    if (acoo%ia(i) /= acoo%ja(i)) then 
-!!$      j = j + 1 
-!!$      acoo%ia(j)  = acoo%ia(i)
-!!$      acoo%ja(j)  = acoo%ja(i)
-!!$      acoo%val(j) = acoo%val(i)
-!!$    end if
-!!$  end do
-!!$  call acoo%set_nzeros(j)
-!!$  call acoo%trim()
-!!$  call b%mv_from(acoo)
-!!$
-!!$  call psb_erractionrestore(err_act)
-!!$  return
-!!$
-!!$
-!!$9999 call psb_error_handler(err_act)
-!!$
-!!$  return
-!!$
-!!$end subroutine psb_ls_clip_d
-!!$
-!!$
-!!$
-!!$subroutine psb_ls_clip_d_ip(a,info)
-!!$  ! Output is always in  COO format 
-!!$  use psb_error_mod
-!!$  use psb_const_mod
-!!$  use psb_s_base_mat_mod
-!!$  use psb_s_mat_mod, psb_protect_name => psb_ls_clip_d_ip
-!!$  implicit none
-!!$
-!!$  class(psb_lsspmat_type), intent(inout) :: a
-!!$  integer(psb_ipk_),intent(out)                  :: info
-!!$
-!!$  integer(psb_ipk_) :: err_act
-!!$  character(len=20)  :: name='clip_diag'
-!!$  logical, parameter :: debug=.false.
-!!$  type(psb_ls_coo_sparse_mat), allocatable  :: acoo
-!!$  integer(psb_lpk_) :: i, j, nz
-!!$
-!!$  info = psb_success_
-!!$  call psb_erractionsave(err_act)
-!!$  if (a%is_null()) then 
-!!$    info = psb_err_invalid_mat_state_
-!!$    call psb_errpush(info,name)
-!!$    goto 9999
-!!$  endif
-!!$
-!!$  allocate(acoo,stat=info)    
-!!$  if (info == psb_success_) call a%a%mv_to_coo(acoo,info)
-!!$  if (info /= psb_success_) then
-!!$    info = psb_err_alloc_dealloc_
-!!$    call psb_errpush(info,name)
-!!$    goto 9999
-!!$  endif
-!!$
-!!$  nz = acoo%get_nzeros()
-!!$  j = 0
-!!$  do i=1, nz
-!!$    if (acoo%ia(i) /= acoo%ja(i)) then 
-!!$      j = j + 1 
-!!$      acoo%ia(j)  = acoo%ia(i)
-!!$      acoo%ja(j)  = acoo%ja(i)
-!!$      acoo%val(j) = acoo%val(i)
-!!$    end if
-!!$  end do
-!!$  call acoo%set_nzeros(j)
-!!$  call acoo%trim()
-!!$  call a%mv_from(acoo)
-!!$
-!!$  call psb_erractionrestore(err_act)
-!!$  return
-!!$
-!!$
-!!$9999 call psb_error_handler(err_act)
-!!$
-!!$  return
-!!$
-!!$end subroutine psb_ls_clip_d_ip
-!!$
+subroutine psb_ls_clip_d(a,b,info)
+  ! Output is always in  COO format 
+  use psb_error_mod
+  use psb_const_mod
+  use psb_s_base_mat_mod
+  use psb_s_mat_mod, psb_protect_name => psb_ls_clip_d
+  implicit none
+
+  class(psb_lsspmat_type), intent(in)    :: a
+  class(psb_lsspmat_type), intent(inout) :: b
+  integer(psb_ipk_),intent(out)                  :: info
+
+  integer(psb_ipk_) :: err_act
+  character(len=20)  :: name='clip_diag'
+  logical, parameter :: debug=.false.
+  type(psb_ls_coo_sparse_mat), allocatable  :: acoo
+  integer(psb_lpk_) :: i, j, nz
+
+  info = psb_success_
+  call psb_erractionsave(err_act)
+  if (a%is_null()) then 
+    info = psb_err_invalid_mat_state_
+    call psb_errpush(info,name)
+    goto 9999
+  endif
+
+  allocate(acoo,stat=info)    
+  if (info == psb_success_) call a%a%cp_to_coo(acoo,info)
+  if (info /= psb_success_) then 
+    info = psb_err_alloc_dealloc_
+    call psb_errpush(info,name)
+    goto 9999
+  endif
+
+  nz = acoo%get_nzeros()
+  j = 0
+  do i=1, nz
+    if (acoo%ia(i) /= acoo%ja(i)) then 
+      j = j + 1 
+      acoo%ia(j)  = acoo%ia(i)
+      acoo%ja(j)  = acoo%ja(i)
+      acoo%val(j) = acoo%val(i)
+    end if
+  end do
+  call acoo%set_nzeros(j)
+  call acoo%trim()
+  call b%mv_from(acoo)
+
+  call psb_erractionrestore(err_act)
+  return
+
+
+9999 call psb_error_handler(err_act)
+
+  return
+
+end subroutine psb_ls_clip_d
+
+
+
+subroutine psb_ls_clip_d_ip(a,info)
+  ! Output is always in  COO format 
+  use psb_error_mod
+  use psb_const_mod
+  use psb_s_base_mat_mod
+  use psb_s_mat_mod, psb_protect_name => psb_ls_clip_d_ip
+  implicit none
+
+  class(psb_lsspmat_type), intent(inout) :: a
+  integer(psb_ipk_),intent(out)                  :: info
+
+  integer(psb_ipk_) :: err_act
+  character(len=20)  :: name='clip_diag'
+  logical, parameter :: debug=.false.
+  type(psb_ls_coo_sparse_mat), allocatable  :: acoo
+  integer(psb_lpk_) :: i, j, nz
+
+  info = psb_success_
+  call psb_erractionsave(err_act)
+  if (a%is_null()) then 
+    info = psb_err_invalid_mat_state_
+    call psb_errpush(info,name)
+    goto 9999
+  endif
+
+  allocate(acoo,stat=info)    
+  if (info == psb_success_) call a%a%mv_to_coo(acoo,info)
+  if (info /= psb_success_) then
+    info = psb_err_alloc_dealloc_
+    call psb_errpush(info,name)
+    goto 9999
+  endif
+
+  nz = acoo%get_nzeros()
+  j = 0
+  do i=1, nz
+    if (acoo%ia(i) /= acoo%ja(i)) then 
+      j = j + 1 
+      acoo%ia(j)  = acoo%ia(i)
+      acoo%ja(j)  = acoo%ja(i)
+      acoo%val(j) = acoo%val(i)
+    end if
+  end do
+  call acoo%set_nzeros(j)
+  call acoo%trim()
+  call a%mv_from(acoo)
+
+  call psb_erractionrestore(err_act)
+  return
+
+
+9999 call psb_error_handler(err_act)
+
+  return
+
+end subroutine psb_ls_clip_d_ip
+
 
 subroutine psb_ls_mv_from(a,b)
   use psb_error_mod

base/serial/impl/psb_z_mat_impl.F90

@@ -3933,123 +3933,123 @@ end subroutine psb_lz_cscnv_base
 
 
 
-!!$subroutine psb_lz_clip_d(a,b,info)
-!!$  ! Output is always in  COO format 
-!!$  use psb_error_mod
-!!$  use psb_const_mod
-!!$  use psb_z_base_mat_mod
-!!$  use psb_z_mat_mod, psb_protect_name => psb_lz_clip_d
-!!$  implicit none
-!!$
-!!$  class(psb_lzspmat_type), intent(in)    :: a
-!!$  class(psb_lzspmat_type), intent(inout) :: b
-!!$  integer(psb_ipk_),intent(out)                  :: info
-!!$
-!!$  integer(psb_ipk_) :: err_act
-!!$  character(len=20)  :: name='clip_diag'
-!!$  logical, parameter :: debug=.false.
-!!$  type(psb_lz_coo_sparse_mat), allocatable  :: acoo
-!!$  integer(psb_lpk_) :: i, j, nz
-!!$
-!!$  info = psb_success_
-!!$  call psb_erractionsave(err_act)
-!!$  if (a%is_null()) then 
-!!$    info = psb_err_invalid_mat_state_
-!!$    call psb_errpush(info,name)
-!!$    goto 9999
-!!$  endif
-!!$
-!!$  allocate(acoo,stat=info)    
-!!$  if (info == psb_success_) call a%a%cp_to_coo(acoo,info)
-!!$  if (info /= psb_success_) then 
-!!$    info = psb_err_alloc_dealloc_
-!!$    call psb_errpush(info,name)
-!!$    goto 9999
-!!$  endif
-!!$
-!!$  nz = acoo%get_nzeros()
-!!$  j = 0
-!!$  do i=1, nz
-!!$    if (acoo%ia(i) /= acoo%ja(i)) then 
-!!$      j = j + 1 
-!!$      acoo%ia(j)  = acoo%ia(i)
-!!$      acoo%ja(j)  = acoo%ja(i)
-!!$      acoo%val(j) = acoo%val(i)
-!!$    end if
-!!$  end do
-!!$  call acoo%set_nzeros(j)
-!!$  call acoo%trim()
-!!$  call b%mv_from(acoo)
-!!$
-!!$  call psb_erractionrestore(err_act)
-!!$  return
-!!$
-!!$
-!!$9999 call psb_error_handler(err_act)
-!!$
-!!$  return
-!!$
-!!$end subroutine psb_lz_clip_d
-!!$
-!!$
-!!$
-!!$subroutine psb_lz_clip_d_ip(a,info)
-!!$  ! Output is always in  COO format 
-!!$  use psb_error_mod
-!!$  use psb_const_mod
-!!$  use psb_z_base_mat_mod
-!!$  use psb_z_mat_mod, psb_protect_name => psb_lz_clip_d_ip
-!!$  implicit none
-!!$
-!!$  class(psb_lzspmat_type), intent(inout) :: a
-!!$  integer(psb_ipk_),intent(out)                  :: info
-!!$
-!!$  integer(psb_ipk_) :: err_act
-!!$  character(len=20)  :: name='clip_diag'
-!!$  logical, parameter :: debug=.false.
-!!$  type(psb_lz_coo_sparse_mat), allocatable  :: acoo
-!!$  integer(psb_lpk_) :: i, j, nz
-!!$
-!!$  info = psb_success_
-!!$  call psb_erractionsave(err_act)
-!!$  if (a%is_null()) then 
-!!$    info = psb_err_invalid_mat_state_
-!!$    call psb_errpush(info,name)
-!!$    goto 9999
-!!$  endif
-!!$
-!!$  allocate(acoo,stat=info)    
-!!$  if (info == psb_success_) call a%a%mv_to_coo(acoo,info)
-!!$  if (info /= psb_success_) then
-!!$    info = psb_err_alloc_dealloc_
-!!$    call psb_errpush(info,name)
-!!$    goto 9999
-!!$  endif
-!!$
-!!$  nz = acoo%get_nzeros()
-!!$  j = 0
-!!$  do i=1, nz
-!!$    if (acoo%ia(i) /= acoo%ja(i)) then 
-!!$      j = j + 1 
-!!$      acoo%ia(j)  = acoo%ia(i)
-!!$      acoo%ja(j)  = acoo%ja(i)
-!!$      acoo%val(j) = acoo%val(i)
-!!$    end if
-!!$  end do
-!!$  call acoo%set_nzeros(j)
-!!$  call acoo%trim()
-!!$  call a%mv_from(acoo)
-!!$
-!!$  call psb_erractionrestore(err_act)
-!!$  return
-!!$
-!!$
-!!$9999 call psb_error_handler(err_act)
-!!$
-!!$  return
-!!$
-!!$end subroutine psb_lz_clip_d_ip
-!!$
+subroutine psb_lz_clip_d(a,b,info)
+  ! Output is always in  COO format 
+  use psb_error_mod
+  use psb_const_mod
+  use psb_z_base_mat_mod
+  use psb_z_mat_mod, psb_protect_name => psb_lz_clip_d
+  implicit none
+
+  class(psb_lzspmat_type), intent(in)    :: a
+  class(psb_lzspmat_type), intent(inout) :: b
+  integer(psb_ipk_),intent(out)                  :: info
+
+  integer(psb_ipk_) :: err_act
+  character(len=20)  :: name='clip_diag'
+  logical, parameter :: debug=.false.
+  type(psb_lz_coo_sparse_mat), allocatable  :: acoo
+  integer(psb_lpk_) :: i, j, nz
+
+  info = psb_success_
+  call psb_erractionsave(err_act)
+  if (a%is_null()) then 
+    info = psb_err_invalid_mat_state_
+    call psb_errpush(info,name)
+    goto 9999
+  endif
+
+  allocate(acoo,stat=info)    
+  if (info == psb_success_) call a%a%cp_to_coo(acoo,info)
+  if (info /= psb_success_) then 
+    info = psb_err_alloc_dealloc_
+    call psb_errpush(info,name)
+    goto 9999
+  endif
+
+  nz = acoo%get_nzeros()
+  j = 0
+  do i=1, nz
+    if (acoo%ia(i) /= acoo%ja(i)) then 
+      j = j + 1 
+      acoo%ia(j)  = acoo%ia(i)
+      acoo%ja(j)  = acoo%ja(i)
+      acoo%val(j) = acoo%val(i)
+    end if
+  end do
+  call acoo%set_nzeros(j)
+  call acoo%trim()
+  call b%mv_from(acoo)
+
+  call psb_erractionrestore(err_act)
+  return
+
+
+9999 call psb_error_handler(err_act)
+
+  return
+
+end subroutine psb_lz_clip_d
+
+
+
+subroutine psb_lz_clip_d_ip(a,info)
+  ! Output is always in  COO format 
+  use psb_error_mod
+  use psb_const_mod
+  use psb_z_base_mat_mod
+  use psb_z_mat_mod, psb_protect_name => psb_lz_clip_d_ip
+  implicit none
+
+  class(psb_lzspmat_type), intent(inout) :: a
+  integer(psb_ipk_),intent(out)                  :: info
+
+  integer(psb_ipk_) :: err_act
+  character(len=20)  :: name='clip_diag'
+  logical, parameter :: debug=.false.
+  type(psb_lz_coo_sparse_mat), allocatable  :: acoo
+  integer(psb_lpk_) :: i, j, nz
+
+  info = psb_success_
+  call psb_erractionsave(err_act)
+  if (a%is_null()) then 
+    info = psb_err_invalid_mat_state_
+    call psb_errpush(info,name)
+    goto 9999
+  endif
+
+  allocate(acoo,stat=info)    
+  if (info == psb_success_) call a%a%mv_to_coo(acoo,info)
+  if (info /= psb_success_) then
+    info = psb_err_alloc_dealloc_
+    call psb_errpush(info,name)
+    goto 9999
+  endif
+
+  nz = acoo%get_nzeros()
+  j = 0
+  do i=1, nz
+    if (acoo%ia(i) /= acoo%ja(i)) then 
+      j = j + 1 
+      acoo%ia(j)  = acoo%ia(i)
+      acoo%ja(j)  = acoo%ja(i)
+      acoo%val(j) = acoo%val(i)
+    end if
+  end do
+  call acoo%set_nzeros(j)
+  call acoo%trim()
+  call a%mv_from(acoo)
+
+  call psb_erractionrestore(err_act)
+  return
+
+
+9999 call psb_error_handler(err_act)
+
+  return
+
+end subroutine psb_lz_clip_d_ip
+
 
 subroutine psb_lz_mv_from(a,b)
   use psb_error_mod