Corrected checkmat bugs in compare and get_nnz routines

base/psblas/psb_ccmp_vect.f90

@@ -119,8 +119,6 @@ subroutine psb_ccmp_spmatval(a,val,tol,desc_a,res,info)
   integer(psb_ipk_) :: err_act
   character(len=20) :: name, ch_err
   integer(psb_ipk_) :: debug_level, debug_unit
-  integer(psb_lpk_) :: m,n,ia,ja
-  integer(psb_ipk_) :: iia,jja
 
   name='psb_ccmp_spmatval'
   info=psb_success_
@@ -139,20 +137,12 @@ subroutine psb_ccmp_spmatval(a,val,tol,desc_a,res,info)
     goto 9999
   endif
 
-  ia = 1
+  if (.not.((desc_a%get_local_rows() == a%get_nrows())&
-  ja = 1
+    .and.(desc_a%get_local_cols() == a%get_ncols()))) then
-  m    = desc_a%get_global_rows()
+      res = .false.
-  n    = desc_a%get_global_cols()
+  else
-  ! checking for matrix correctness
-  call psb_chkmat(m,n,ia,ja,desc_a,info,iia,jja)
-  if(info /= psb_success_) then
-    info=psb_err_from_subroutine_
-    ch_err='psb_chkmat'
-    call psb_errpush(info,name,a_err=ch_err)
-    goto 9999
-  end if
-
     res = a%spcmp(val,tol,info)
+  end if
 
   call psb_lallreduceand(ictxt,res)
 
@@ -183,8 +173,6 @@ subroutine psb_ccmp_spmat(a,b,tol,desc_a,res,info)
   integer(psb_ipk_) :: err_act
   character(len=20) :: name, ch_err
   integer(psb_ipk_) :: debug_level, debug_unit
-  integer(psb_lpk_) :: m,n,ia,ja,ib,jb
-  integer(psb_ipk_) :: iia,jja,iib,jjb
 
   name='psb_ccmp_spmatval'
   info=psb_success_
@@ -203,32 +191,18 @@ subroutine psb_ccmp_spmat(a,b,tol,desc_a,res,info)
     goto 9999
   endif
 
-  ia = 1
+  if (.not.((desc_a%get_local_rows() == a%get_nrows())&
-  ja = 1
+    .and.(desc_a%get_local_rows() == b%get_nrows())&
-  ib = 1
+    .and.(desc_a%get_local_cols() == a%get_ncols())&
-  jb = 1
+      .and.(desc_a%get_local_cols() == b%get_ncols()))) then
-  m    = desc_a%get_global_rows()
+      res = .false.
-  n    = desc_a%get_global_cols()
+  else
-  ! checking for matrix correctness
-  call psb_chkmat(m,n,ia,ja,desc_a,info,iia,jja)
-  if(info /= psb_success_) then
-    info=psb_err_from_subroutine_
-    ch_err='psb_chkmat_1'
-    call psb_errpush(info,name,a_err=ch_err)
-    goto 9999
-  end if
-  call psb_chkmat(m,n,ib,jb,desc_a,info,iib,jjb)
-  if(info /= psb_success_) then
-    info=psb_err_from_subroutine_
-    ch_err='psb_chkmat_2'
-    call psb_errpush(info,name,a_err=ch_err)
-    goto 9999
-  end if
-
     res = a%spcmp(b,tol,info)
+  end if
 
   call psb_lallreduceand(ictxt,res)
 
+
   call psb_erractionrestore(err_act)
   if (debug_level >= psb_debug_comp_) then
     call psb_barrier(ictxt)

base/psblas/psb_cgetmatinfo.f90

@@ -49,7 +49,7 @@ function  psb_cget_nnz(a,desc_a,info) result(res)
   ! locals
   integer(psb_ipk_) :: ictxt, np, me,&
        & err_act, iia, jja
-  integer(psb_lpk_) :: m,n,ia,ja,localnnz
+  integer(psb_lpk_) :: localnnz
   character(len=20) :: name, ch_err
   !
   name='psb_cget_nnz'
@@ -67,21 +67,9 @@ function  psb_cget_nnz(a,desc_a,info) result(res)
     goto 9999
   endif
 
-  m    = desc_a%get_global_rows()
-  n    = desc_a%get_global_cols()
-
-  ! Check for matrix correctness
-  call psb_chkmat(m,n,ia,ja,desc_a,info,iia,jja)
-  if(info /= psb_success_) then
-    info=psb_err_from_subroutine_
-    ch_err='psb_chkmat'
-    call psb_errpush(info,name,a_err=ch_err)
-    goto 9999
-  end if
-
   localnnz = a%get_nzeros()
 
-  call MPI_ALLREDUCE(localnnz, res, 1, MPI_LONG, MPI_SUM, ictxt, info)
+  call psb_sum(ictxt,localnnz)
 
   call psb_erractionrestore(err_act)
   return

base/psblas/psb_dcmp_vect.f90

@@ -241,8 +241,6 @@ subroutine psb_dcmp_spmatval(a,val,tol,desc_a,res,info)
   integer(psb_ipk_) :: err_act
   character(len=20) :: name, ch_err
   integer(psb_ipk_) :: debug_level, debug_unit
-  integer(psb_lpk_) :: m,n,ia,ja
-  integer(psb_ipk_) :: iia,jja
 
   name='psb_dcmp_spmatval'
   info=psb_success_
@@ -261,20 +259,12 @@ subroutine psb_dcmp_spmatval(a,val,tol,desc_a,res,info)
     goto 9999
   endif
 
-  ia = 1
+  if (.not.((desc_a%get_local_rows() == a%get_nrows())&
-  ja = 1
+    .and.(desc_a%get_local_cols() == a%get_ncols()))) then
-  m    = desc_a%get_global_rows()
+      res = .false.
-  n    = desc_a%get_global_cols()
+  else
-  ! checking for matrix correctness
-  call psb_chkmat(m,n,ia,ja,desc_a,info,iia,jja)
-  if(info /= psb_success_) then
-    info=psb_err_from_subroutine_
-    ch_err='psb_chkmat'
-    call psb_errpush(info,name,a_err=ch_err)
-    goto 9999
-  end if
-
     res = a%spcmp(val,tol,info)
+  end if
 
   call psb_lallreduceand(ictxt,res)
 
@@ -305,8 +295,6 @@ subroutine psb_dcmp_spmat(a,b,tol,desc_a,res,info)
   integer(psb_ipk_) :: err_act
   character(len=20) :: name, ch_err
   integer(psb_ipk_) :: debug_level, debug_unit
-  integer(psb_lpk_) :: m,n,ia,ja,ib,jb
-  integer(psb_ipk_) :: iia,jja,iib,jjb
 
   name='psb_dcmp_spmatval'
   info=psb_success_
@@ -325,32 +313,18 @@ subroutine psb_dcmp_spmat(a,b,tol,desc_a,res,info)
     goto 9999
   endif
 
-  ia = 1
+  if (.not.((desc_a%get_local_rows() == a%get_nrows())&
-  ja = 1
+    .and.(desc_a%get_local_rows() == b%get_nrows())&
-  ib = 1
+    .and.(desc_a%get_local_cols() == a%get_ncols())&
-  jb = 1
+      .and.(desc_a%get_local_cols() == b%get_ncols()))) then
-  m    = desc_a%get_global_rows()
+      res = .false.
-  n    = desc_a%get_global_cols()
+  else
-  ! checking for matrix correctness
-  call psb_chkmat(m,n,ia,ja,desc_a,info,iia,jja)
-  if(info /= psb_success_) then
-    info=psb_err_from_subroutine_
-    ch_err='psb_chkmat_1'
-    call psb_errpush(info,name,a_err=ch_err)
-    goto 9999
-  end if
-  call psb_chkmat(m,n,ib,jb,desc_a,info,iib,jjb)
-  if(info /= psb_success_) then
-    info=psb_err_from_subroutine_
-    ch_err='psb_chkmat_2'
-    call psb_errpush(info,name,a_err=ch_err)
-    goto 9999
-  end if
-
     res = a%spcmp(b,tol,info)
+  end if
 
   call psb_lallreduceand(ictxt,res)
 
+
   call psb_erractionrestore(err_act)
   if (debug_level >= psb_debug_comp_) then
     call psb_barrier(ictxt)

base/psblas/psb_dgetmatinfo.f90

@@ -49,7 +49,7 @@ function  psb_dget_nnz(a,desc_a,info) result(res)
   ! locals
   integer(psb_ipk_) :: ictxt, np, me,&
        & err_act, iia, jja
-  integer(psb_lpk_) :: m,n,ia,ja,localnnz
+  integer(psb_lpk_) :: localnnz
   character(len=20) :: name, ch_err
   !
   name='psb_dget_nnz'
@@ -67,21 +67,9 @@ function  psb_dget_nnz(a,desc_a,info) result(res)
     goto 9999
   endif
 
-  m    = desc_a%get_global_rows()
-  n    = desc_a%get_global_cols()
-
-  ! Check for matrix correctness
-  call psb_chkmat(m,n,ia,ja,desc_a,info,iia,jja)
-  if(info /= psb_success_) then
-    info=psb_err_from_subroutine_
-    ch_err='psb_chkmat'
-    call psb_errpush(info,name,a_err=ch_err)
-    goto 9999
-  end if
-
   localnnz = a%get_nzeros()
 
-  call MPI_ALLREDUCE(localnnz, res, 1, MPI_LONG, MPI_SUM, ictxt, info)
+  call psb_sum(ictxt,localnnz)
 
   call psb_erractionrestore(err_act)
   return

base/psblas/psb_scmp_vect.f90

@@ -241,8 +241,6 @@ subroutine psb_scmp_spmatval(a,val,tol,desc_a,res,info)
   integer(psb_ipk_) :: err_act
   character(len=20) :: name, ch_err
   integer(psb_ipk_) :: debug_level, debug_unit
-  integer(psb_lpk_) :: m,n,ia,ja
-  integer(psb_ipk_) :: iia,jja
 
   name='psb_scmp_spmatval'
   info=psb_success_
@@ -261,20 +259,12 @@ subroutine psb_scmp_spmatval(a,val,tol,desc_a,res,info)
     goto 9999
   endif
 
-  ia = 1
+  if (.not.((desc_a%get_local_rows() == a%get_nrows())&
-  ja = 1
+    .and.(desc_a%get_local_cols() == a%get_ncols()))) then
-  m    = desc_a%get_global_rows()
+      res = .false.
-  n    = desc_a%get_global_cols()
+  else
-  ! checking for matrix correctness
-  call psb_chkmat(m,n,ia,ja,desc_a,info,iia,jja)
-  if(info /= psb_success_) then
-    info=psb_err_from_subroutine_
-    ch_err='psb_chkmat'
-    call psb_errpush(info,name,a_err=ch_err)
-    goto 9999
-  end if
-
     res = a%spcmp(val,tol,info)
+  end if
 
   call psb_lallreduceand(ictxt,res)
 
@@ -305,8 +295,6 @@ subroutine psb_scmp_spmat(a,b,tol,desc_a,res,info)
   integer(psb_ipk_) :: err_act
   character(len=20) :: name, ch_err
   integer(psb_ipk_) :: debug_level, debug_unit
-  integer(psb_lpk_) :: m,n,ia,ja,ib,jb
-  integer(psb_ipk_) :: iia,jja,iib,jjb
 
   name='psb_scmp_spmatval'
   info=psb_success_
@@ -325,32 +313,18 @@ subroutine psb_scmp_spmat(a,b,tol,desc_a,res,info)
     goto 9999
   endif
 
-  ia = 1
+  if (.not.((desc_a%get_local_rows() == a%get_nrows())&
-  ja = 1
+    .and.(desc_a%get_local_rows() == b%get_nrows())&
-  ib = 1
+    .and.(desc_a%get_local_cols() == a%get_ncols())&
-  jb = 1
+      .and.(desc_a%get_local_cols() == b%get_ncols()))) then
-  m    = desc_a%get_global_rows()
+      res = .false.
-  n    = desc_a%get_global_cols()
+  else
-  ! checking for matrix correctness
-  call psb_chkmat(m,n,ia,ja,desc_a,info,iia,jja)
-  if(info /= psb_success_) then
-    info=psb_err_from_subroutine_
-    ch_err='psb_chkmat_1'
-    call psb_errpush(info,name,a_err=ch_err)
-    goto 9999
-  end if
-  call psb_chkmat(m,n,ib,jb,desc_a,info,iib,jjb)
-  if(info /= psb_success_) then
-    info=psb_err_from_subroutine_
-    ch_err='psb_chkmat_2'
-    call psb_errpush(info,name,a_err=ch_err)
-    goto 9999
-  end if
-
     res = a%spcmp(b,tol,info)
+  end if
 
   call psb_lallreduceand(ictxt,res)
 
+
   call psb_erractionrestore(err_act)
   if (debug_level >= psb_debug_comp_) then
     call psb_barrier(ictxt)

base/psblas/psb_sgetmatinfo.f90

@@ -49,7 +49,7 @@ function  psb_sget_nnz(a,desc_a,info) result(res)
   ! locals
   integer(psb_ipk_) :: ictxt, np, me,&
        & err_act, iia, jja
-  integer(psb_lpk_) :: m,n,ia,ja,localnnz
+  integer(psb_lpk_) :: localnnz
   character(len=20) :: name, ch_err
   !
   name='psb_sget_nnz'
@@ -67,21 +67,9 @@ function  psb_sget_nnz(a,desc_a,info) result(res)
     goto 9999
   endif
 
-  m    = desc_a%get_global_rows()
-  n    = desc_a%get_global_cols()
-
-  ! Check for matrix correctness
-  call psb_chkmat(m,n,ia,ja,desc_a,info,iia,jja)
-  if(info /= psb_success_) then
-    info=psb_err_from_subroutine_
-    ch_err='psb_chkmat'
-    call psb_errpush(info,name,a_err=ch_err)
-    goto 9999
-  end if
-
   localnnz = a%get_nzeros()
 
-  call MPI_ALLREDUCE(localnnz, res, 1, MPI_LONG, MPI_SUM, ictxt, info)
+  call psb_sum(ictxt,localnnz)
 
   call psb_erractionrestore(err_act)
   return

base/psblas/psb_zcmp_vect.f90

@@ -119,8 +119,6 @@ subroutine psb_zcmp_spmatval(a,val,tol,desc_a,res,info)
   integer(psb_ipk_) :: err_act
   character(len=20) :: name, ch_err
   integer(psb_ipk_) :: debug_level, debug_unit
-  integer(psb_lpk_) :: m,n,ia,ja
-  integer(psb_ipk_) :: iia,jja
 
   name='psb_zcmp_spmatval'
   info=psb_success_
@@ -139,20 +137,12 @@ subroutine psb_zcmp_spmatval(a,val,tol,desc_a,res,info)
     goto 9999
   endif
 
-  ia = 1
+  if (.not.((desc_a%get_local_rows() == a%get_nrows())&
-  ja = 1
+    .and.(desc_a%get_local_cols() == a%get_ncols()))) then
-  m    = desc_a%get_global_rows()
+      res = .false.
-  n    = desc_a%get_global_cols()
+  else
-  ! checking for matrix correctness
-  call psb_chkmat(m,n,ia,ja,desc_a,info,iia,jja)
-  if(info /= psb_success_) then
-    info=psb_err_from_subroutine_
-    ch_err='psb_chkmat'
-    call psb_errpush(info,name,a_err=ch_err)
-    goto 9999
-  end if
-
     res = a%spcmp(val,tol,info)
+  end if
 
   call psb_lallreduceand(ictxt,res)
 
@@ -183,8 +173,6 @@ subroutine psb_zcmp_spmat(a,b,tol,desc_a,res,info)
   integer(psb_ipk_) :: err_act
   character(len=20) :: name, ch_err
   integer(psb_ipk_) :: debug_level, debug_unit
-  integer(psb_lpk_) :: m,n,ia,ja,ib,jb
-  integer(psb_ipk_) :: iia,jja,iib,jjb
 
   name='psb_zcmp_spmatval'
   info=psb_success_
@@ -203,32 +191,18 @@ subroutine psb_zcmp_spmat(a,b,tol,desc_a,res,info)
     goto 9999
   endif
 
-  ia = 1
+  if (.not.((desc_a%get_local_rows() == a%get_nrows())&
-  ja = 1
+    .and.(desc_a%get_local_rows() == b%get_nrows())&
-  ib = 1
+    .and.(desc_a%get_local_cols() == a%get_ncols())&
-  jb = 1
+      .and.(desc_a%get_local_cols() == b%get_ncols()))) then
-  m    = desc_a%get_global_rows()
+      res = .false.
-  n    = desc_a%get_global_cols()
+  else
-  ! checking for matrix correctness
-  call psb_chkmat(m,n,ia,ja,desc_a,info,iia,jja)
-  if(info /= psb_success_) then
-    info=psb_err_from_subroutine_
-    ch_err='psb_chkmat_1'
-    call psb_errpush(info,name,a_err=ch_err)
-    goto 9999
-  end if
-  call psb_chkmat(m,n,ib,jb,desc_a,info,iib,jjb)
-  if(info /= psb_success_) then
-    info=psb_err_from_subroutine_
-    ch_err='psb_chkmat_2'
-    call psb_errpush(info,name,a_err=ch_err)
-    goto 9999
-  end if
-
     res = a%spcmp(b,tol,info)
+  end if
 
   call psb_lallreduceand(ictxt,res)
 
+
   call psb_erractionrestore(err_act)
   if (debug_level >= psb_debug_comp_) then
     call psb_barrier(ictxt)

base/psblas/psb_zgetmatinfo.f90

@@ -49,7 +49,7 @@ function  psb_zget_nnz(a,desc_a,info) result(res)
   ! locals
   integer(psb_ipk_) :: ictxt, np, me,&
        & err_act, iia, jja
-  integer(psb_lpk_) :: m,n,ia,ja,localnnz
+  integer(psb_lpk_) :: localnnz
   character(len=20) :: name, ch_err
   !
   name='psb_zget_nnz'
@@ -67,21 +67,9 @@ function  psb_zget_nnz(a,desc_a,info) result(res)
     goto 9999
   endif
 
-  m    = desc_a%get_global_rows()
-  n    = desc_a%get_global_cols()
-
-  ! Check for matrix correctness
-  call psb_chkmat(m,n,ia,ja,desc_a,info,iia,jja)
-  if(info /= psb_success_) then
-    info=psb_err_from_subroutine_
-    ch_err='psb_chkmat'
-    call psb_errpush(info,name,a_err=ch_err)
-    goto 9999
-  end if
-
   localnnz = a%get_nzeros()
 
-  call MPI_ALLREDUCE(localnnz, res, 1, MPI_LONG, MPI_SUM, ictxt, info)
+  call psb_sum(ictxt,localnnz)
 
   call psb_erractionrestore(err_act)
   return

base/serial/impl/psb_c_coo_impl.f90

@@ -328,9 +328,8 @@ function psb_c_coo_cmpmat(a,b,tol,info) result(res)
   character(len=20)            :: name='cmpmat'
   logical, parameter           :: debug=.false.
 
-  integer(psb_ipk_)              :: nza, nzb, M, N
+  integer(psb_ipk_)              :: nza, nzb, nzl, M, N
   type(psb_c_coo_sparse_mat) :: tcoo, bcoo
-  real(psb_spk_)               :: normval
 
   ! Copy (whatever) b format to coo
   call b%cp_to_coo(bcoo,info)
@@ -352,7 +351,7 @@ function psb_c_coo_cmpmat(a,b,tol,info) result(res)
   tcoo%val(1:nza) = a%val(1:nza)
   tcoo%ia(nza+1:nza+nzb) = bcoo%ia(1:nzb)
   tcoo%ja(nza+1:nza+nzb) = bcoo%ja(1:nzb)
-  tcoo%val(nza+1:nza+nzb) = (-1_psb_spk_)*bcoo%val(1:nzb)
+  tcoo%val(nza+1:nza+nzb) = (-sone)*bcoo%val(1:nzb)
   ! Fix the indexes
   call tcoo%fix(info)
   if (info /= psb_success_) then
@@ -360,10 +359,9 @@ function psb_c_coo_cmpmat(a,b,tol,info) result(res)
     call psb_errpush(info,name, a_err='fix')
     goto 9999
   end if
+  nzl = tcoo%get_nzeros()
 
-  normval = maxval(abs(tcoo%val));
+  if (any(abs(tcoo%val(1:nzl)) > tol)) then
-
-  if ( normval > tol) then
     res = .false.
   else
     res = .true.
@@ -4832,9 +4830,8 @@ function psb_lc_coo_cmpmat(a,b,tol,info) result(res)
   character(len=20)            :: name='cmpmat'
   logical, parameter           :: debug=.false.
 
-  integer(psb_lpk_)              :: nza, nzb, M, N
+  integer(psb_lpk_)              :: nza, nzb, nzl, M, N
   type(psb_lc_coo_sparse_mat)  :: tcoo, bcoo
-  real(psb_spk_)               :: normval
 
   ! Copy (whatever) b format to coo
   call b%cp_to_coo(bcoo,info)
@@ -4864,10 +4861,9 @@ function psb_lc_coo_cmpmat(a,b,tol,info) result(res)
     call psb_errpush(info,name, a_err='fix')
     goto 9999
   end if
+  nzl = tcoo%get_nzeros()
 
-  normval = tcoo%spnmi()
+  if (any(abs(tcoo%val(1:nzl)) > tol)) then
-
-  if ( normval > tol) then
     res = .false.
   else
     res = .true.

base/serial/impl/psb_d_coo_impl.f90

@@ -328,9 +328,8 @@ function psb_d_coo_cmpmat(a,b,tol,info) result(res)
   character(len=20)            :: name='cmpmat'
   logical, parameter           :: debug=.false.
 
-  integer(psb_ipk_)              :: nza, nzb, M, N
+  integer(psb_ipk_)              :: nza, nzb, nzl, M, N
   type(psb_d_coo_sparse_mat) :: tcoo, bcoo
-  real(psb_dpk_)               :: normval
 
   ! Copy (whatever) b format to coo
   call b%cp_to_coo(bcoo,info)
@@ -352,7 +351,7 @@ function psb_d_coo_cmpmat(a,b,tol,info) result(res)
   tcoo%val(1:nza) = a%val(1:nza)
   tcoo%ia(nza+1:nza+nzb) = bcoo%ia(1:nzb)
   tcoo%ja(nza+1:nza+nzb) = bcoo%ja(1:nzb)
-  tcoo%val(nza+1:nza+nzb) = (-1_psb_dpk_)*bcoo%val(1:nzb)
+  tcoo%val(nza+1:nza+nzb) = (-done)*bcoo%val(1:nzb)
   ! Fix the indexes
   call tcoo%fix(info)
   if (info /= psb_success_) then
@@ -360,10 +359,9 @@ function psb_d_coo_cmpmat(a,b,tol,info) result(res)
     call psb_errpush(info,name, a_err='fix')
     goto 9999
   end if
+  nzl = tcoo%get_nzeros()
 
-  normval = maxval(abs(tcoo%val));
+  if (any(abs(tcoo%val(1:nzl)) > tol)) then
-
-  if ( normval > tol) then
     res = .false.
   else
     res = .true.
@@ -4832,9 +4830,8 @@ function psb_ld_coo_cmpmat(a,b,tol,info) result(res)
   character(len=20)            :: name='cmpmat'
   logical, parameter           :: debug=.false.
 
-  integer(psb_lpk_)              :: nza, nzb, M, N
+  integer(psb_lpk_)              :: nza, nzb, nzl, M, N
   type(psb_ld_coo_sparse_mat)  :: tcoo, bcoo
-  real(psb_dpk_)               :: normval
 
   ! Copy (whatever) b format to coo
   call b%cp_to_coo(bcoo,info)
@@ -4864,10 +4861,9 @@ function psb_ld_coo_cmpmat(a,b,tol,info) result(res)
     call psb_errpush(info,name, a_err='fix')
     goto 9999
   end if
+  nzl = tcoo%get_nzeros()
 
-  normval = tcoo%spnmi()
+  if (any(abs(tcoo%val(1:nzl)) > tol)) then
-
-  if ( normval > tol) then
     res = .false.
   else
     res = .true.

base/serial/impl/psb_s_coo_impl.f90

@@ -328,9 +328,8 @@ function psb_s_coo_cmpmat(a,b,tol,info) result(res)
   character(len=20)            :: name='cmpmat'
   logical, parameter           :: debug=.false.
 
-  integer(psb_ipk_)              :: nza, nzb, M, N
+  integer(psb_ipk_)              :: nza, nzb, nzl, M, N
   type(psb_s_coo_sparse_mat) :: tcoo, bcoo
-  real(psb_spk_)               :: normval
 
   ! Copy (whatever) b format to coo
   call b%cp_to_coo(bcoo,info)
@@ -352,7 +351,7 @@ function psb_s_coo_cmpmat(a,b,tol,info) result(res)
   tcoo%val(1:nza) = a%val(1:nza)
   tcoo%ia(nza+1:nza+nzb) = bcoo%ia(1:nzb)
   tcoo%ja(nza+1:nza+nzb) = bcoo%ja(1:nzb)
-  tcoo%val(nza+1:nza+nzb) = (-1_psb_spk_)*bcoo%val(1:nzb)
+  tcoo%val(nza+1:nza+nzb) = (-sone)*bcoo%val(1:nzb)
   ! Fix the indexes
   call tcoo%fix(info)
   if (info /= psb_success_) then
@@ -360,10 +359,9 @@ function psb_s_coo_cmpmat(a,b,tol,info) result(res)
     call psb_errpush(info,name, a_err='fix')
     goto 9999
   end if
+  nzl = tcoo%get_nzeros()
 
-  normval = maxval(abs(tcoo%val));
+  if (any(abs(tcoo%val(1:nzl)) > tol)) then
-
-  if ( normval > tol) then
     res = .false.
   else
     res = .true.
@@ -4832,9 +4830,8 @@ function psb_ls_coo_cmpmat(a,b,tol,info) result(res)
   character(len=20)            :: name='cmpmat'
   logical, parameter           :: debug=.false.
 
-  integer(psb_lpk_)              :: nza, nzb, M, N
+  integer(psb_lpk_)              :: nza, nzb, nzl, M, N
   type(psb_ls_coo_sparse_mat)  :: tcoo, bcoo
-  real(psb_spk_)               :: normval
 
   ! Copy (whatever) b format to coo
   call b%cp_to_coo(bcoo,info)
@@ -4864,10 +4861,9 @@ function psb_ls_coo_cmpmat(a,b,tol,info) result(res)
     call psb_errpush(info,name, a_err='fix')
     goto 9999
   end if
+  nzl = tcoo%get_nzeros()
 
-  normval = tcoo%spnmi()
+  if (any(abs(tcoo%val(1:nzl)) > tol)) then
-
-  if ( normval > tol) then
     res = .false.
   else
     res = .true.

base/serial/impl/psb_z_coo_impl.f90

@@ -328,9 +328,8 @@ function psb_z_coo_cmpmat(a,b,tol,info) result(res)
   character(len=20)            :: name='cmpmat'
   logical, parameter           :: debug=.false.
 
-  integer(psb_ipk_)              :: nza, nzb, M, N
+  integer(psb_ipk_)              :: nza, nzb, nzl, M, N
   type(psb_z_coo_sparse_mat) :: tcoo, bcoo
-  real(psb_dpk_)               :: normval
 
   ! Copy (whatever) b format to coo
   call b%cp_to_coo(bcoo,info)
@@ -352,7 +351,7 @@ function psb_z_coo_cmpmat(a,b,tol,info) result(res)
   tcoo%val(1:nza) = a%val(1:nza)
   tcoo%ia(nza+1:nza+nzb) = bcoo%ia(1:nzb)
   tcoo%ja(nza+1:nza+nzb) = bcoo%ja(1:nzb)
-  tcoo%val(nza+1:nza+nzb) = (-1_psb_dpk_)*bcoo%val(1:nzb)
+  tcoo%val(nza+1:nza+nzb) = (-done)*bcoo%val(1:nzb)
   ! Fix the indexes
   call tcoo%fix(info)
   if (info /= psb_success_) then
@@ -360,10 +359,9 @@ function psb_z_coo_cmpmat(a,b,tol,info) result(res)
     call psb_errpush(info,name, a_err='fix')
     goto 9999
   end if
+  nzl = tcoo%get_nzeros()
 
-  normval = maxval(abs(tcoo%val));
+  if (any(abs(tcoo%val(1:nzl)) > tol)) then
-
-  if ( normval > tol) then
     res = .false.
   else
     res = .true.
@@ -4832,9 +4830,8 @@ function psb_lz_coo_cmpmat(a,b,tol,info) result(res)
   character(len=20)            :: name='cmpmat'
   logical, parameter           :: debug=.false.
 
-  integer(psb_lpk_)              :: nza, nzb, M, N
+  integer(psb_lpk_)              :: nza, nzb, nzl, M, N
   type(psb_lz_coo_sparse_mat)  :: tcoo, bcoo
-  real(psb_dpk_)               :: normval
 
   ! Copy (whatever) b format to coo
   call b%cp_to_coo(bcoo,info)
@@ -4864,10 +4861,9 @@ function psb_lz_coo_cmpmat(a,b,tol,info) result(res)
     call psb_errpush(info,name, a_err='fix')
     goto 9999
   end if
+  nzl = tcoo%get_nzeros()
 
-  normval = tcoo%spnmi()
+  if (any(abs(tcoo%val(1:nzl)) > tol)) then
-
-  if ( normval > tol) then
     res = .false.
   else
     res = .true.

cbind/base/psb_c_psblas_cbind_mod.f90

@@ -476,6 +476,8 @@ contains
     real(c_float_complex), value :: tol
     logical                  :: isequal
 
+    res = .false.
+
     if (c_associated(cdh%item)) then
       call c_f_pointer(cdh%item,descp)
     else
@@ -512,6 +514,8 @@ contains
     real(c_float_complex), value :: tol
     logical                  :: isequal
 
+    res = .false.
+
     if (c_associated(cdh%item)) then
       call c_f_pointer(cdh%item,descp)
     else
@@ -948,6 +952,8 @@ contains
     type(psb_cspmat_type), pointer  :: ap
     integer(psb_c_ipk_)               :: info
 
+    res = 0
+
     if (c_associated(cdh%item)) then
       call c_f_pointer(cdh%item,descp)
     else
@@ -974,6 +980,8 @@ contains
     type(psb_cspmat_type), pointer  :: ap
     integer(psb_c_ipk_)               :: info
 
+    res = .false.
+
     if (c_associated(cdh%item)) then
       call c_f_pointer(cdh%item,descp)
     else
@@ -999,6 +1007,8 @@ contains
     type(psb_cspmat_type), pointer  :: ap
     integer(psb_c_ipk_)               :: info
 
+    res = .false.
+
     if (c_associated(cdh%item)) then
       call c_f_pointer(cdh%item,descp)
     else
@@ -1024,6 +1034,8 @@ contains
     type(psb_cspmat_type), pointer  :: ap
     integer(psb_c_ipk_)               :: info
 
+    res = .false.
+
     if (c_associated(cdh%item)) then
       call c_f_pointer(cdh%item,descp)
     else

cbind/base/psb_d_psblas_cbind_mod.f90

@@ -476,6 +476,8 @@ contains
     real(c_double), value :: tol
     logical                  :: isequal
 
+    res = .false.
+
     if (c_associated(cdh%item)) then
       call c_f_pointer(cdh%item,descp)
     else
@@ -512,6 +514,8 @@ contains
     real(c_double), value :: tol
     logical                  :: isequal
 
+    res = .false.
+
     if (c_associated(cdh%item)) then
       call c_f_pointer(cdh%item,descp)
     else
@@ -1049,6 +1053,8 @@ contains
     type(psb_dspmat_type), pointer  :: ap
     integer(psb_c_ipk_)               :: info
 
+    res = 0
+
     if (c_associated(cdh%item)) then
       call c_f_pointer(cdh%item,descp)
     else
@@ -1075,6 +1081,8 @@ contains
     type(psb_dspmat_type), pointer  :: ap
     integer(psb_c_ipk_)               :: info
 
+    res = .false.
+
     if (c_associated(cdh%item)) then
       call c_f_pointer(cdh%item,descp)
     else
@@ -1100,6 +1108,8 @@ contains
     type(psb_dspmat_type), pointer  :: ap
     integer(psb_c_ipk_)               :: info
 
+    res = .false.
+
     if (c_associated(cdh%item)) then
       call c_f_pointer(cdh%item,descp)
     else
@@ -1125,6 +1135,8 @@ contains
     type(psb_dspmat_type), pointer  :: ap
     integer(psb_c_ipk_)               :: info
 
+    res = .false.
+
     if (c_associated(cdh%item)) then
       call c_f_pointer(cdh%item,descp)
     else

cbind/base/psb_s_psblas_cbind_mod.f90

@@ -476,6 +476,8 @@ contains
     real(c_float), value :: tol
     logical                  :: isequal
 
+    res = .false.
+
     if (c_associated(cdh%item)) then
       call c_f_pointer(cdh%item,descp)
     else
@@ -512,6 +514,8 @@ contains
     real(c_float), value :: tol
     logical                  :: isequal
 
+    res = .false.
+
     if (c_associated(cdh%item)) then
       call c_f_pointer(cdh%item,descp)
     else
@@ -1049,6 +1053,8 @@ contains
     type(psb_sspmat_type), pointer  :: ap
     integer(psb_c_ipk_)               :: info
 
+    res = 0
+
     if (c_associated(cdh%item)) then
       call c_f_pointer(cdh%item,descp)
     else
@@ -1075,6 +1081,8 @@ contains
     type(psb_sspmat_type), pointer  :: ap
     integer(psb_c_ipk_)               :: info
 
+    res = .false.
+
     if (c_associated(cdh%item)) then
       call c_f_pointer(cdh%item,descp)
     else
@@ -1100,6 +1108,8 @@ contains
     type(psb_sspmat_type), pointer  :: ap
     integer(psb_c_ipk_)               :: info
 
+    res = .false.
+
     if (c_associated(cdh%item)) then
       call c_f_pointer(cdh%item,descp)
     else
@@ -1125,6 +1135,8 @@ contains
     type(psb_sspmat_type), pointer  :: ap
     integer(psb_c_ipk_)               :: info
 
+    res = .false.
+
     if (c_associated(cdh%item)) then
       call c_f_pointer(cdh%item,descp)
     else

cbind/base/psb_z_psblas_cbind_mod.f90

@@ -476,6 +476,8 @@ contains
     real(c_double_complex), value :: tol
     logical                  :: isequal
 
+    res = .false.
+
     if (c_associated(cdh%item)) then
       call c_f_pointer(cdh%item,descp)
     else
@@ -512,6 +514,8 @@ contains
     real(c_double_complex), value :: tol
     logical                  :: isequal
 
+    res = .false.
+
     if (c_associated(cdh%item)) then
       call c_f_pointer(cdh%item,descp)
     else
@@ -948,6 +952,8 @@ contains
     type(psb_zspmat_type), pointer  :: ap
     integer(psb_c_ipk_)               :: info
 
+    res = 0
+
     if (c_associated(cdh%item)) then
       call c_f_pointer(cdh%item,descp)
     else
@@ -974,6 +980,8 @@ contains
     type(psb_zspmat_type), pointer  :: ap
     integer(psb_c_ipk_)               :: info
 
+    res = .false.
+
     if (c_associated(cdh%item)) then
       call c_f_pointer(cdh%item,descp)
     else
@@ -999,6 +1007,8 @@ contains
     type(psb_zspmat_type), pointer  :: ap
     integer(psb_c_ipk_)               :: info
 
+    res = .false.
+
     if (c_associated(cdh%item)) then
       call c_f_pointer(cdh%item,descp)
     else
@@ -1024,6 +1034,8 @@ contains
     type(psb_zspmat_type), pointer  :: ap
     integer(psb_c_ipk_)               :: info
 
+    res = .false.
+
     if (c_associated(cdh%item)) then
       call c_f_pointer(cdh%item,descp)
     else