diff --git a/base/modules/serial/psb_c_base_mat_mod.F90 b/base/modules/serial/psb_c_base_mat_mod.F90 index 63268b54..fc8304fc 100644 --- a/base/modules/serial/psb_c_base_mat_mod.F90 +++ b/base/modules/serial/psb_c_base_mat_mod.F90 @@ -186,6 +186,7 @@ module psb_c_base_mat_mod procedure, pass(a) :: fix => psb_c_fix_coo procedure, pass(a) :: trim => psb_c_coo_trim procedure, pass(a) :: clean_zeros => psb_c_coo_clean_zeros + procedure, pass(a) :: clean_negidx => psb_c_coo_clean_negidx procedure, pass(a) :: print => psb_c_coo_print procedure, pass(a) :: free => c_coo_free procedure, pass(a) :: mold => psb_c_coo_mold @@ -367,6 +368,7 @@ module psb_c_base_mat_mod procedure, pass(a) :: fix => psb_lc_fix_coo procedure, pass(a) :: trim => psb_lc_coo_trim procedure, pass(a) :: clean_zeros => psb_lc_coo_clean_zeros + procedure, pass(a) :: clean_negidx => psb_lc_coo_clean_negidx procedure, pass(a) :: print => psb_lc_coo_print procedure, pass(a) :: free => lc_coo_free procedure, pass(a) :: mold => psb_lc_coo_mold @@ -1613,6 +1615,46 @@ module psb_c_base_mat_mod integer(psb_ipk_), intent(out) :: info end subroutine psb_c_coo_clean_zeros end interface + + ! + !> + !! \memberof psb_c_coo_sparse_mat + !! \brief Take out any entries with negative row or column index + !! May happen when converting local/global numbering + !! \param info return code + !! + ! + interface + subroutine psb_c_coo_clean_negidx(a,info) + import + class(psb_c_coo_sparse_mat), intent(inout) :: a + integer(psb_ipk_), intent(out) :: info + end subroutine psb_c_coo_clean_negidx + end interface + + ! + !> Funtion: coo_clean_negidx_inner + !! \brief Take out any entries with negative row or column index + !! Used internally by coo_clean_negidx + !! \param nzin Number of entries on input to be handled + !! \param ia(:) Row indices + !! \param ja(:) Col indices + !! \param val(:) Coefficients + !! \param nzout Number of entries after sorting/duplicate handling + !! \param info return code + !! + ! + interface psb_coo_clean_negidx_inner + subroutine psb_c_coo_clean_negidx_inner(nzin,ia,ja,val,nzout,info) + import + integer(psb_ipk_), intent(in) :: nzin + integer(psb_ipk_), intent(inout) :: ia(:), ja(:) + complex(psb_spk_), intent(inout) :: val(:) + integer(psb_ipk_), intent(out) :: nzout + integer(psb_ipk_), intent(out) :: info + end subroutine psb_c_coo_clean_negidx_inner + end interface psb_coo_clean_negidx_inner + ! !> @@ -3078,6 +3120,45 @@ module psb_c_base_mat_mod end subroutine psb_lc_coo_clean_zeros end interface + ! + !> + !! \memberof psb_lc_coo_sparse_mat + !! \brief Take out any entries with negative row or column index + !! May happen when converting local/global numbering + !! \param info return code + !! + ! + interface + subroutine psb_lc_coo_clean_negidx(a,info) + import + class(psb_lc_coo_sparse_mat), intent(inout) :: a + integer(psb_ipk_), intent(out) :: info + end subroutine psb_lc_coo_clean_negidx + end interface + + ! + !> Funtion: coo_clean_negidx_inner + !! \brief Take out any entries with negative row or column index + !! Used internally by coo_clean_negidx + !! \param nzin Number of entries on input to be handled + !! \param ia(:) Row indices + !! \param ja(:) Col indices + !! \param val(:) Coefficients + !! \param nzout Number of entries after sorting/duplicate handling + !! \param info return code + !! + ! + interface psb_coo_clean_negidx_inner + subroutine psb_lc_coo_clean_negidx_inner(nzin,ia,ja,val,nzout,info) + import + integer(psb_lpk_), intent(in) :: nzin + integer(psb_lpk_), intent(inout) :: ia(:), ja(:) + complex(psb_spk_), intent(inout) :: val(:) + integer(psb_lpk_), intent(out) :: nzout + integer(psb_ipk_), intent(out) :: info + end subroutine psb_lc_coo_clean_negidx_inner + end interface psb_coo_clean_negidx_inner + ! !> !! \memberof psb_lc_coo_sparse_mat diff --git a/base/modules/serial/psb_d_base_mat_mod.F90 b/base/modules/serial/psb_d_base_mat_mod.F90 index c7c8ab39..a49a7fd3 100644 --- a/base/modules/serial/psb_d_base_mat_mod.F90 +++ b/base/modules/serial/psb_d_base_mat_mod.F90 @@ -186,6 +186,7 @@ module psb_d_base_mat_mod procedure, pass(a) :: fix => psb_d_fix_coo procedure, pass(a) :: trim => psb_d_coo_trim procedure, pass(a) :: clean_zeros => psb_d_coo_clean_zeros + procedure, pass(a) :: clean_negidx => psb_d_coo_clean_negidx procedure, pass(a) :: print => psb_d_coo_print procedure, pass(a) :: free => d_coo_free procedure, pass(a) :: mold => psb_d_coo_mold @@ -367,6 +368,7 @@ module psb_d_base_mat_mod procedure, pass(a) :: fix => psb_ld_fix_coo procedure, pass(a) :: trim => psb_ld_coo_trim procedure, pass(a) :: clean_zeros => psb_ld_coo_clean_zeros + procedure, pass(a) :: clean_negidx => psb_ld_coo_clean_negidx procedure, pass(a) :: print => psb_ld_coo_print procedure, pass(a) :: free => ld_coo_free procedure, pass(a) :: mold => psb_ld_coo_mold @@ -1613,6 +1615,46 @@ module psb_d_base_mat_mod integer(psb_ipk_), intent(out) :: info end subroutine psb_d_coo_clean_zeros end interface + + ! + !> + !! \memberof psb_d_coo_sparse_mat + !! \brief Take out any entries with negative row or column index + !! May happen when converting local/global numbering + !! \param info return code + !! + ! + interface + subroutine psb_d_coo_clean_negidx(a,info) + import + class(psb_d_coo_sparse_mat), intent(inout) :: a + integer(psb_ipk_), intent(out) :: info + end subroutine psb_d_coo_clean_negidx + end interface + + ! + !> Funtion: coo_clean_negidx_inner + !! \brief Take out any entries with negative row or column index + !! Used internally by coo_clean_negidx + !! \param nzin Number of entries on input to be handled + !! \param ia(:) Row indices + !! \param ja(:) Col indices + !! \param val(:) Coefficients + !! \param nzout Number of entries after sorting/duplicate handling + !! \param info return code + !! + ! + interface psb_coo_clean_negidx_inner + subroutine psb_d_coo_clean_negidx_inner(nzin,ia,ja,val,nzout,info) + import + integer(psb_ipk_), intent(in) :: nzin + integer(psb_ipk_), intent(inout) :: ia(:), ja(:) + real(psb_dpk_), intent(inout) :: val(:) + integer(psb_ipk_), intent(out) :: nzout + integer(psb_ipk_), intent(out) :: info + end subroutine psb_d_coo_clean_negidx_inner + end interface psb_coo_clean_negidx_inner + ! !> @@ -3078,6 +3120,45 @@ module psb_d_base_mat_mod end subroutine psb_ld_coo_clean_zeros end interface + ! + !> + !! \memberof psb_ld_coo_sparse_mat + !! \brief Take out any entries with negative row or column index + !! May happen when converting local/global numbering + !! \param info return code + !! + ! + interface + subroutine psb_ld_coo_clean_negidx(a,info) + import + class(psb_ld_coo_sparse_mat), intent(inout) :: a + integer(psb_ipk_), intent(out) :: info + end subroutine psb_ld_coo_clean_negidx + end interface + + ! + !> Funtion: coo_clean_negidx_inner + !! \brief Take out any entries with negative row or column index + !! Used internally by coo_clean_negidx + !! \param nzin Number of entries on input to be handled + !! \param ia(:) Row indices + !! \param ja(:) Col indices + !! \param val(:) Coefficients + !! \param nzout Number of entries after sorting/duplicate handling + !! \param info return code + !! + ! + interface psb_coo_clean_negidx_inner + subroutine psb_ld_coo_clean_negidx_inner(nzin,ia,ja,val,nzout,info) + import + integer(psb_lpk_), intent(in) :: nzin + integer(psb_lpk_), intent(inout) :: ia(:), ja(:) + real(psb_dpk_), intent(inout) :: val(:) + integer(psb_lpk_), intent(out) :: nzout + integer(psb_ipk_), intent(out) :: info + end subroutine psb_ld_coo_clean_negidx_inner + end interface psb_coo_clean_negidx_inner + ! !> !! \memberof psb_ld_coo_sparse_mat diff --git a/base/modules/serial/psb_s_base_mat_mod.F90 b/base/modules/serial/psb_s_base_mat_mod.F90 index d04fa692..195c35c4 100644 --- a/base/modules/serial/psb_s_base_mat_mod.F90 +++ b/base/modules/serial/psb_s_base_mat_mod.F90 @@ -186,6 +186,7 @@ module psb_s_base_mat_mod procedure, pass(a) :: fix => psb_s_fix_coo procedure, pass(a) :: trim => psb_s_coo_trim procedure, pass(a) :: clean_zeros => psb_s_coo_clean_zeros + procedure, pass(a) :: clean_negidx => psb_s_coo_clean_negidx procedure, pass(a) :: print => psb_s_coo_print procedure, pass(a) :: free => s_coo_free procedure, pass(a) :: mold => psb_s_coo_mold @@ -367,6 +368,7 @@ module psb_s_base_mat_mod procedure, pass(a) :: fix => psb_ls_fix_coo procedure, pass(a) :: trim => psb_ls_coo_trim procedure, pass(a) :: clean_zeros => psb_ls_coo_clean_zeros + procedure, pass(a) :: clean_negidx => psb_ls_coo_clean_negidx procedure, pass(a) :: print => psb_ls_coo_print procedure, pass(a) :: free => ls_coo_free procedure, pass(a) :: mold => psb_ls_coo_mold @@ -1613,6 +1615,46 @@ module psb_s_base_mat_mod integer(psb_ipk_), intent(out) :: info end subroutine psb_s_coo_clean_zeros end interface + + ! + !> + !! \memberof psb_s_coo_sparse_mat + !! \brief Take out any entries with negative row or column index + !! May happen when converting local/global numbering + !! \param info return code + !! + ! + interface + subroutine psb_s_coo_clean_negidx(a,info) + import + class(psb_s_coo_sparse_mat), intent(inout) :: a + integer(psb_ipk_), intent(out) :: info + end subroutine psb_s_coo_clean_negidx + end interface + + ! + !> Funtion: coo_clean_negidx_inner + !! \brief Take out any entries with negative row or column index + !! Used internally by coo_clean_negidx + !! \param nzin Number of entries on input to be handled + !! \param ia(:) Row indices + !! \param ja(:) Col indices + !! \param val(:) Coefficients + !! \param nzout Number of entries after sorting/duplicate handling + !! \param info return code + !! + ! + interface psb_coo_clean_negidx_inner + subroutine psb_s_coo_clean_negidx_inner(nzin,ia,ja,val,nzout,info) + import + integer(psb_ipk_), intent(in) :: nzin + integer(psb_ipk_), intent(inout) :: ia(:), ja(:) + real(psb_spk_), intent(inout) :: val(:) + integer(psb_ipk_), intent(out) :: nzout + integer(psb_ipk_), intent(out) :: info + end subroutine psb_s_coo_clean_negidx_inner + end interface psb_coo_clean_negidx_inner + ! !> @@ -3078,6 +3120,45 @@ module psb_s_base_mat_mod end subroutine psb_ls_coo_clean_zeros end interface + ! + !> + !! \memberof psb_ls_coo_sparse_mat + !! \brief Take out any entries with negative row or column index + !! May happen when converting local/global numbering + !! \param info return code + !! + ! + interface + subroutine psb_ls_coo_clean_negidx(a,info) + import + class(psb_ls_coo_sparse_mat), intent(inout) :: a + integer(psb_ipk_), intent(out) :: info + end subroutine psb_ls_coo_clean_negidx + end interface + + ! + !> Funtion: coo_clean_negidx_inner + !! \brief Take out any entries with negative row or column index + !! Used internally by coo_clean_negidx + !! \param nzin Number of entries on input to be handled + !! \param ia(:) Row indices + !! \param ja(:) Col indices + !! \param val(:) Coefficients + !! \param nzout Number of entries after sorting/duplicate handling + !! \param info return code + !! + ! + interface psb_coo_clean_negidx_inner + subroutine psb_ls_coo_clean_negidx_inner(nzin,ia,ja,val,nzout,info) + import + integer(psb_lpk_), intent(in) :: nzin + integer(psb_lpk_), intent(inout) :: ia(:), ja(:) + real(psb_spk_), intent(inout) :: val(:) + integer(psb_lpk_), intent(out) :: nzout + integer(psb_ipk_), intent(out) :: info + end subroutine psb_ls_coo_clean_negidx_inner + end interface psb_coo_clean_negidx_inner + ! !> !! \memberof psb_ls_coo_sparse_mat diff --git a/base/modules/serial/psb_z_base_mat_mod.F90 b/base/modules/serial/psb_z_base_mat_mod.F90 index d1827242..66d5a0b8 100644 --- a/base/modules/serial/psb_z_base_mat_mod.F90 +++ b/base/modules/serial/psb_z_base_mat_mod.F90 @@ -186,6 +186,7 @@ module psb_z_base_mat_mod procedure, pass(a) :: fix => psb_z_fix_coo procedure, pass(a) :: trim => psb_z_coo_trim procedure, pass(a) :: clean_zeros => psb_z_coo_clean_zeros + procedure, pass(a) :: clean_negidx => psb_z_coo_clean_negidx procedure, pass(a) :: print => psb_z_coo_print procedure, pass(a) :: free => z_coo_free procedure, pass(a) :: mold => psb_z_coo_mold @@ -367,6 +368,7 @@ module psb_z_base_mat_mod procedure, pass(a) :: fix => psb_lz_fix_coo procedure, pass(a) :: trim => psb_lz_coo_trim procedure, pass(a) :: clean_zeros => psb_lz_coo_clean_zeros + procedure, pass(a) :: clean_negidx => psb_lz_coo_clean_negidx procedure, pass(a) :: print => psb_lz_coo_print procedure, pass(a) :: free => lz_coo_free procedure, pass(a) :: mold => psb_lz_coo_mold @@ -1613,6 +1615,46 @@ module psb_z_base_mat_mod integer(psb_ipk_), intent(out) :: info end subroutine psb_z_coo_clean_zeros end interface + + ! + !> + !! \memberof psb_z_coo_sparse_mat + !! \brief Take out any entries with negative row or column index + !! May happen when converting local/global numbering + !! \param info return code + !! + ! + interface + subroutine psb_z_coo_clean_negidx(a,info) + import + class(psb_z_coo_sparse_mat), intent(inout) :: a + integer(psb_ipk_), intent(out) :: info + end subroutine psb_z_coo_clean_negidx + end interface + + ! + !> Funtion: coo_clean_negidx_inner + !! \brief Take out any entries with negative row or column index + !! Used internally by coo_clean_negidx + !! \param nzin Number of entries on input to be handled + !! \param ia(:) Row indices + !! \param ja(:) Col indices + !! \param val(:) Coefficients + !! \param nzout Number of entries after sorting/duplicate handling + !! \param info return code + !! + ! + interface psb_coo_clean_negidx_inner + subroutine psb_z_coo_clean_negidx_inner(nzin,ia,ja,val,nzout,info) + import + integer(psb_ipk_), intent(in) :: nzin + integer(psb_ipk_), intent(inout) :: ia(:), ja(:) + complex(psb_dpk_), intent(inout) :: val(:) + integer(psb_ipk_), intent(out) :: nzout + integer(psb_ipk_), intent(out) :: info + end subroutine psb_z_coo_clean_negidx_inner + end interface psb_coo_clean_negidx_inner + ! !> @@ -3078,6 +3120,45 @@ module psb_z_base_mat_mod end subroutine psb_lz_coo_clean_zeros end interface + ! + !> + !! \memberof psb_lz_coo_sparse_mat + !! \brief Take out any entries with negative row or column index + !! May happen when converting local/global numbering + !! \param info return code + !! + ! + interface + subroutine psb_lz_coo_clean_negidx(a,info) + import + class(psb_lz_coo_sparse_mat), intent(inout) :: a + integer(psb_ipk_), intent(out) :: info + end subroutine psb_lz_coo_clean_negidx + end interface + + ! + !> Funtion: coo_clean_negidx_inner + !! \brief Take out any entries with negative row or column index + !! Used internally by coo_clean_negidx + !! \param nzin Number of entries on input to be handled + !! \param ia(:) Row indices + !! \param ja(:) Col indices + !! \param val(:) Coefficients + !! \param nzout Number of entries after sorting/duplicate handling + !! \param info return code + !! + ! + interface psb_coo_clean_negidx_inner + subroutine psb_lz_coo_clean_negidx_inner(nzin,ia,ja,val,nzout,info) + import + integer(psb_lpk_), intent(in) :: nzin + integer(psb_lpk_), intent(inout) :: ia(:), ja(:) + complex(psb_dpk_), intent(inout) :: val(:) + integer(psb_lpk_), intent(out) :: nzout + integer(psb_ipk_), intent(out) :: info + end subroutine psb_lz_coo_clean_negidx_inner + end interface psb_coo_clean_negidx_inner + ! !> !! \memberof psb_lz_coo_sparse_mat diff --git a/base/serial/impl/psb_c_coo_impl.f90 b/base/serial/impl/psb_c_coo_impl.f90 index 6d1d0840..cee06b36 100644 --- a/base/serial/impl/psb_c_coo_impl.f90 +++ b/base/serial/impl/psb_c_coo_impl.f90 @@ -344,7 +344,44 @@ subroutine psb_c_coo_clean_zeros(a, info) call a%trim() end subroutine psb_c_coo_clean_zeros +subroutine psb_c_coo_clean_negidx(a,info) + use psb_error_mod + use psb_c_base_mat_mod, psb_protect_name => psb_c_coo_clean_negidx + implicit none + class(psb_c_coo_sparse_mat), intent(inout) :: a + integer(psb_ipk_), intent(out) :: info + ! + ! + integer(psb_ipk_) :: nz + call psb_coo_clean_negidx_inner(a%get_nzeros(),a%ia,a%ja,a%val,nz,info) + if (info == 0) call a%set_nzeros(nz) + +end subroutine psb_c_coo_clean_negidx +subroutine psb_c_coo_clean_negidx_inner(nzin,ia,ja,val,nzout,info) + use psb_error_mod + use psb_c_base_mat_mod, psb_protect_name => psb_c_coo_clean_negidx_inner + implicit none + integer(psb_ipk_), intent(in) :: nzin + integer(psb_ipk_), intent(inout) :: ia(:), ja(:) + complex(psb_spk_), intent(inout) :: val(:) + integer(psb_ipk_), intent(out) :: nzout + integer(psb_ipk_), intent(out) :: info + ! + ! + integer(psb_ipk_) :: i + info = 0 + nzout = 0 + do i=1, nzin + if ((ia(i)>0).and.(ja(i)>0)) then + nzout = nzout + 1 + val(nzout) = val(i) + ia(nzout) = ia(i) + ja(nzout) = ja(i) + end if + end do + +end subroutine psb_c_coo_clean_negidx_inner subroutine psb_c_coo_allocate_mnnz(m,n,a,nz) use psb_c_base_mat_mod, psb_protect_name => psb_c_coo_allocate_mnnz @@ -4652,7 +4689,44 @@ subroutine psb_lc_coo_clean_zeros(a, info) call a%trim() end subroutine psb_lc_coo_clean_zeros +subroutine psb_lc_coo_clean_negidx(a,info) + use psb_error_mod + use psb_c_base_mat_mod, psb_protect_name => psb_lc_coo_clean_negidx + implicit none + class(psb_lc_coo_sparse_mat), intent(inout) :: a + integer(psb_ipk_), intent(out) :: info + ! + ! + integer(psb_lpk_) :: nz + call psb_coo_clean_negidx_inner(a%get_nzeros(),a%ia,a%ja,a%val,nz,info) + if (info == 0) call a%set_nzeros(nz) + +end subroutine psb_lc_coo_clean_negidx +subroutine psb_lc_coo_clean_negidx_inner(nzin,ia,ja,val,nzout,info) + use psb_error_mod + use psb_c_base_mat_mod, psb_protect_name => psb_lc_coo_clean_negidx_inner + implicit none + integer(psb_lpk_), intent(in) :: nzin + integer(psb_lpk_), intent(inout) :: ia(:), ja(:) + complex(psb_spk_), intent(inout) :: val(:) + integer(psb_lpk_), intent(out) :: nzout + integer(psb_ipk_), intent(out) :: info + ! + ! + integer(psb_lpk_) :: i + info = 0 + nzout = 0 + do i=1, nzin + if ((ia(i)>0).and.(ja(i)>0)) then + nzout = nzout + 1 + val(nzout) = val(i) + ia(nzout) = ia(i) + ja(nzout) = ja(i) + end if + end do + +end subroutine psb_lc_coo_clean_negidx_inner subroutine psb_lc_coo_allocate_mnnz(m,n,a,nz) use psb_c_base_mat_mod, psb_protect_name => psb_lc_coo_allocate_mnnz diff --git a/base/serial/impl/psb_d_coo_impl.f90 b/base/serial/impl/psb_d_coo_impl.f90 index 1cd766e4..ff655f58 100644 --- a/base/serial/impl/psb_d_coo_impl.f90 +++ b/base/serial/impl/psb_d_coo_impl.f90 @@ -344,7 +344,44 @@ subroutine psb_d_coo_clean_zeros(a, info) call a%trim() end subroutine psb_d_coo_clean_zeros +subroutine psb_d_coo_clean_negidx(a,info) + use psb_error_mod + use psb_d_base_mat_mod, psb_protect_name => psb_d_coo_clean_negidx + implicit none + class(psb_d_coo_sparse_mat), intent(inout) :: a + integer(psb_ipk_), intent(out) :: info + ! + ! + integer(psb_ipk_) :: nz + call psb_coo_clean_negidx_inner(a%get_nzeros(),a%ia,a%ja,a%val,nz,info) + if (info == 0) call a%set_nzeros(nz) + +end subroutine psb_d_coo_clean_negidx +subroutine psb_d_coo_clean_negidx_inner(nzin,ia,ja,val,nzout,info) + use psb_error_mod + use psb_d_base_mat_mod, psb_protect_name => psb_d_coo_clean_negidx_inner + implicit none + integer(psb_ipk_), intent(in) :: nzin + integer(psb_ipk_), intent(inout) :: ia(:), ja(:) + real(psb_dpk_), intent(inout) :: val(:) + integer(psb_ipk_), intent(out) :: nzout + integer(psb_ipk_), intent(out) :: info + ! + ! + integer(psb_ipk_) :: i + info = 0 + nzout = 0 + do i=1, nzin + if ((ia(i)>0).and.(ja(i)>0)) then + nzout = nzout + 1 + val(nzout) = val(i) + ia(nzout) = ia(i) + ja(nzout) = ja(i) + end if + end do + +end subroutine psb_d_coo_clean_negidx_inner subroutine psb_d_coo_allocate_mnnz(m,n,a,nz) use psb_d_base_mat_mod, psb_protect_name => psb_d_coo_allocate_mnnz @@ -4652,7 +4689,44 @@ subroutine psb_ld_coo_clean_zeros(a, info) call a%trim() end subroutine psb_ld_coo_clean_zeros +subroutine psb_ld_coo_clean_negidx(a,info) + use psb_error_mod + use psb_d_base_mat_mod, psb_protect_name => psb_ld_coo_clean_negidx + implicit none + class(psb_ld_coo_sparse_mat), intent(inout) :: a + integer(psb_ipk_), intent(out) :: info + ! + ! + integer(psb_lpk_) :: nz + call psb_coo_clean_negidx_inner(a%get_nzeros(),a%ia,a%ja,a%val,nz,info) + if (info == 0) call a%set_nzeros(nz) + +end subroutine psb_ld_coo_clean_negidx +subroutine psb_ld_coo_clean_negidx_inner(nzin,ia,ja,val,nzout,info) + use psb_error_mod + use psb_d_base_mat_mod, psb_protect_name => psb_ld_coo_clean_negidx_inner + implicit none + integer(psb_lpk_), intent(in) :: nzin + integer(psb_lpk_), intent(inout) :: ia(:), ja(:) + real(psb_dpk_), intent(inout) :: val(:) + integer(psb_lpk_), intent(out) :: nzout + integer(psb_ipk_), intent(out) :: info + ! + ! + integer(psb_lpk_) :: i + info = 0 + nzout = 0 + do i=1, nzin + if ((ia(i)>0).and.(ja(i)>0)) then + nzout = nzout + 1 + val(nzout) = val(i) + ia(nzout) = ia(i) + ja(nzout) = ja(i) + end if + end do + +end subroutine psb_ld_coo_clean_negidx_inner subroutine psb_ld_coo_allocate_mnnz(m,n,a,nz) use psb_d_base_mat_mod, psb_protect_name => psb_ld_coo_allocate_mnnz diff --git a/base/serial/impl/psb_s_coo_impl.f90 b/base/serial/impl/psb_s_coo_impl.f90 index dee2d3c2..4b96893f 100644 --- a/base/serial/impl/psb_s_coo_impl.f90 +++ b/base/serial/impl/psb_s_coo_impl.f90 @@ -344,7 +344,44 @@ subroutine psb_s_coo_clean_zeros(a, info) call a%trim() end subroutine psb_s_coo_clean_zeros +subroutine psb_s_coo_clean_negidx(a,info) + use psb_error_mod + use psb_s_base_mat_mod, psb_protect_name => psb_s_coo_clean_negidx + implicit none + class(psb_s_coo_sparse_mat), intent(inout) :: a + integer(psb_ipk_), intent(out) :: info + ! + ! + integer(psb_ipk_) :: nz + call psb_coo_clean_negidx_inner(a%get_nzeros(),a%ia,a%ja,a%val,nz,info) + if (info == 0) call a%set_nzeros(nz) + +end subroutine psb_s_coo_clean_negidx +subroutine psb_s_coo_clean_negidx_inner(nzin,ia,ja,val,nzout,info) + use psb_error_mod + use psb_s_base_mat_mod, psb_protect_name => psb_s_coo_clean_negidx_inner + implicit none + integer(psb_ipk_), intent(in) :: nzin + integer(psb_ipk_), intent(inout) :: ia(:), ja(:) + real(psb_spk_), intent(inout) :: val(:) + integer(psb_ipk_), intent(out) :: nzout + integer(psb_ipk_), intent(out) :: info + ! + ! + integer(psb_ipk_) :: i + info = 0 + nzout = 0 + do i=1, nzin + if ((ia(i)>0).and.(ja(i)>0)) then + nzout = nzout + 1 + val(nzout) = val(i) + ia(nzout) = ia(i) + ja(nzout) = ja(i) + end if + end do + +end subroutine psb_s_coo_clean_negidx_inner subroutine psb_s_coo_allocate_mnnz(m,n,a,nz) use psb_s_base_mat_mod, psb_protect_name => psb_s_coo_allocate_mnnz @@ -4652,7 +4689,44 @@ subroutine psb_ls_coo_clean_zeros(a, info) call a%trim() end subroutine psb_ls_coo_clean_zeros +subroutine psb_ls_coo_clean_negidx(a,info) + use psb_error_mod + use psb_s_base_mat_mod, psb_protect_name => psb_ls_coo_clean_negidx + implicit none + class(psb_ls_coo_sparse_mat), intent(inout) :: a + integer(psb_ipk_), intent(out) :: info + ! + ! + integer(psb_lpk_) :: nz + call psb_coo_clean_negidx_inner(a%get_nzeros(),a%ia,a%ja,a%val,nz,info) + if (info == 0) call a%set_nzeros(nz) + +end subroutine psb_ls_coo_clean_negidx +subroutine psb_ls_coo_clean_negidx_inner(nzin,ia,ja,val,nzout,info) + use psb_error_mod + use psb_s_base_mat_mod, psb_protect_name => psb_ls_coo_clean_negidx_inner + implicit none + integer(psb_lpk_), intent(in) :: nzin + integer(psb_lpk_), intent(inout) :: ia(:), ja(:) + real(psb_spk_), intent(inout) :: val(:) + integer(psb_lpk_), intent(out) :: nzout + integer(psb_ipk_), intent(out) :: info + ! + ! + integer(psb_lpk_) :: i + info = 0 + nzout = 0 + do i=1, nzin + if ((ia(i)>0).and.(ja(i)>0)) then + nzout = nzout + 1 + val(nzout) = val(i) + ia(nzout) = ia(i) + ja(nzout) = ja(i) + end if + end do + +end subroutine psb_ls_coo_clean_negidx_inner subroutine psb_ls_coo_allocate_mnnz(m,n,a,nz) use psb_s_base_mat_mod, psb_protect_name => psb_ls_coo_allocate_mnnz diff --git a/base/serial/impl/psb_z_coo_impl.f90 b/base/serial/impl/psb_z_coo_impl.f90 index 1e50a169..ac3b46da 100644 --- a/base/serial/impl/psb_z_coo_impl.f90 +++ b/base/serial/impl/psb_z_coo_impl.f90 @@ -344,7 +344,44 @@ subroutine psb_z_coo_clean_zeros(a, info) call a%trim() end subroutine psb_z_coo_clean_zeros +subroutine psb_z_coo_clean_negidx(a,info) + use psb_error_mod + use psb_z_base_mat_mod, psb_protect_name => psb_z_coo_clean_negidx + implicit none + class(psb_z_coo_sparse_mat), intent(inout) :: a + integer(psb_ipk_), intent(out) :: info + ! + ! + integer(psb_ipk_) :: nz + call psb_coo_clean_negidx_inner(a%get_nzeros(),a%ia,a%ja,a%val,nz,info) + if (info == 0) call a%set_nzeros(nz) + +end subroutine psb_z_coo_clean_negidx +subroutine psb_z_coo_clean_negidx_inner(nzin,ia,ja,val,nzout,info) + use psb_error_mod + use psb_z_base_mat_mod, psb_protect_name => psb_z_coo_clean_negidx_inner + implicit none + integer(psb_ipk_), intent(in) :: nzin + integer(psb_ipk_), intent(inout) :: ia(:), ja(:) + complex(psb_dpk_), intent(inout) :: val(:) + integer(psb_ipk_), intent(out) :: nzout + integer(psb_ipk_), intent(out) :: info + ! + ! + integer(psb_ipk_) :: i + info = 0 + nzout = 0 + do i=1, nzin + if ((ia(i)>0).and.(ja(i)>0)) then + nzout = nzout + 1 + val(nzout) = val(i) + ia(nzout) = ia(i) + ja(nzout) = ja(i) + end if + end do + +end subroutine psb_z_coo_clean_negidx_inner subroutine psb_z_coo_allocate_mnnz(m,n,a,nz) use psb_z_base_mat_mod, psb_protect_name => psb_z_coo_allocate_mnnz @@ -4652,7 +4689,44 @@ subroutine psb_lz_coo_clean_zeros(a, info) call a%trim() end subroutine psb_lz_coo_clean_zeros +subroutine psb_lz_coo_clean_negidx(a,info) + use psb_error_mod + use psb_z_base_mat_mod, psb_protect_name => psb_lz_coo_clean_negidx + implicit none + class(psb_lz_coo_sparse_mat), intent(inout) :: a + integer(psb_ipk_), intent(out) :: info + ! + ! + integer(psb_lpk_) :: nz + call psb_coo_clean_negidx_inner(a%get_nzeros(),a%ia,a%ja,a%val,nz,info) + if (info == 0) call a%set_nzeros(nz) + +end subroutine psb_lz_coo_clean_negidx +subroutine psb_lz_coo_clean_negidx_inner(nzin,ia,ja,val,nzout,info) + use psb_error_mod + use psb_z_base_mat_mod, psb_protect_name => psb_lz_coo_clean_negidx_inner + implicit none + integer(psb_lpk_), intent(in) :: nzin + integer(psb_lpk_), intent(inout) :: ia(:), ja(:) + complex(psb_dpk_), intent(inout) :: val(:) + integer(psb_lpk_), intent(out) :: nzout + integer(psb_ipk_), intent(out) :: info + ! + ! + integer(psb_lpk_) :: i + info = 0 + nzout = 0 + do i=1, nzin + if ((ia(i)>0).and.(ja(i)>0)) then + nzout = nzout + 1 + val(nzout) = val(i) + ia(nzout) = ia(i) + ja(nzout) = ja(i) + end if + end do + +end subroutine psb_lz_coo_clean_negidx_inner subroutine psb_lz_coo_allocate_mnnz(m,n,a,nz) use psb_z_base_mat_mod, psb_protect_name => psb_lz_coo_allocate_mnnz