fdurastante/psblas3
1
0
Fork 0
mirror of https://github.com/sfilippone/psblas3.git synced 2026-10-16 19:02:09 +00:00
Code Issues Packages Projects Releases Wiki Activity

Corrected checkmat bugs in compare and get_nnz routines

Browse Source
This commit is contained in:
Cirdans-Home
2020-04-15 12:22:21 +02:00
parent 5c34e3d853
commit 166bd219ef
16 changed files with 136 additions and 256 deletions
Download Patch File Download Diff File Expand all files Collapse all files
base/psblas/psb_ccmp_vect.f90
+13 -39
View File
@@ -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,21 +137,13 @@ subroutine psb_ccmp_spmatval(a,val,tol,desc_a,res,info)
goto 9999
endif
ia = 1
ja = 1
m = desc_a%get_global_rows()
n = desc_a%get_global_cols()
! 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
if (.not.((desc_a%get_local_rows() == a%get_nrows())&
.and.(desc_a%get_local_cols() == a%get_ncols()))) then
res = .false.
else
res = a%spcmp(val,tol,info)
end if
res = a%spcmp(val,tol,info)
call psb_lallreduceand(ictxt,res)
call psb_erractionrestore(err_act)
@@ -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
ja = 1
ib = 1
jb = 1
m = desc_a%get_global_rows()
n = desc_a%get_global_cols()
! 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
if (.not.((desc_a%get_local_rows() == a%get_nrows())&
.and.(desc_a%get_local_rows() == b%get_nrows())&
.and.(desc_a%get_local_cols() == a%get_ncols())&
.and.(desc_a%get_local_cols() == b%get_ncols()))) then
res = .false.
else
res = a%spcmp(b,tol,info)
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)
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
+2 -14
View File
@@ -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
+13 -39
View File
@@ -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,21 +259,13 @@ subroutine psb_dcmp_spmatval(a,val,tol,desc_a,res,info)
goto 9999
endif
ia = 1
ja = 1
m = desc_a%get_global_rows()
n = desc_a%get_global_cols()
! 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
if (.not.((desc_a%get_local_rows() == a%get_nrows())&
.and.(desc_a%get_local_cols() == a%get_ncols()))) then
res = .false.
else
res = a%spcmp(val,tol,info)
end if
res = a%spcmp(val,tol,info)
call psb_lallreduceand(ictxt,res)
call psb_erractionrestore(err_act)
@@ -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
ja = 1
ib = 1
jb = 1
m = desc_a%get_global_rows()
n = desc_a%get_global_cols()
! 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
if (.not.((desc_a%get_local_rows() == a%get_nrows())&
.and.(desc_a%get_local_rows() == b%get_nrows())&
.and.(desc_a%get_local_cols() == a%get_ncols())&
.and.(desc_a%get_local_cols() == b%get_ncols()))) then
res = .false.
else
res = a%spcmp(b,tol,info)
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)
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
+2 -14
View File
@@ -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
+13 -39
View File
@@ -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,21 +259,13 @@ subroutine psb_scmp_spmatval(a,val,tol,desc_a,res,info)
goto 9999
endif
ia = 1
ja = 1
m = desc_a%get_global_rows()
n = desc_a%get_global_cols()
! 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
if (.not.((desc_a%get_local_rows() == a%get_nrows())&
.and.(desc_a%get_local_cols() == a%get_ncols()))) then
res = .false.
else
res = a%spcmp(val,tol,info)
end if
res = a%spcmp(val,tol,info)
call psb_lallreduceand(ictxt,res)
call psb_erractionrestore(err_act)
@@ -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
ja = 1
ib = 1
jb = 1
m = desc_a%get_global_rows()
n = desc_a%get_global_cols()
! 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
if (.not.((desc_a%get_local_rows() == a%get_nrows())&
.and.(desc_a%get_local_rows() == b%get_nrows())&
.and.(desc_a%get_local_cols() == a%get_ncols())&
.and.(desc_a%get_local_cols() == b%get_ncols()))) then
res = .false.
else
res = a%spcmp(b,tol,info)
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)
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
+2 -14
View File
@@ -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
+13 -39
View File
@@ -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,21 +137,13 @@ subroutine psb_zcmp_spmatval(a,val,tol,desc_a,res,info)
goto 9999
endif
ia = 1
ja = 1
m = desc_a%get_global_rows()
n = desc_a%get_global_cols()
! 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
if (.not.((desc_a%get_local_rows() == a%get_nrows())&
.and.(desc_a%get_local_cols() == a%get_ncols()))) then
res = .false.
else
res = a%spcmp(val,tol,info)
end if
res = a%spcmp(val,tol,info)
call psb_lallreduceand(ictxt,res)
call psb_erractionrestore(err_act)
@@ -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
ja = 1
ib = 1
jb = 1
m = desc_a%get_global_rows()
n = desc_a%get_global_cols()
! 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
if (.not.((desc_a%get_local_rows() == a%get_nrows())&
.and.(desc_a%get_local_rows() == b%get_nrows())&
.and.(desc_a%get_local_cols() == a%get_ncols())&
.and.(desc_a%get_local_cols() == b%get_ncols()))) then
res = .false.
else
res = a%spcmp(b,tol,info)
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)
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
+2 -14
View File
@@ -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
+7 -11
View File
@@ -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 ( normval > tol) then
if (any(abs(tcoo%val(1:nzl)) > 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 ( normval > tol) then
if (any(abs(tcoo%val(1:nzl)) > tol)) then
res = .false.
else
res = .true.
base/serial/impl/psb_d_coo_impl.f90
+7 -11
View File
@@ -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 ( normval > tol) then
if (any(abs(tcoo%val(1:nzl)) > 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 ( normval > tol) then
if (any(abs(tcoo%val(1:nzl)) > tol)) then
res = .false.
else
res = .true.
base/serial/impl/psb_s_coo_impl.f90
+7 -11
View File
@@ -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 ( normval > tol) then
if (any(abs(tcoo%val(1:nzl)) > 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 ( normval > tol) then
if (any(abs(tcoo%val(1:nzl)) > tol)) then
res = .false.
else
res = .true.
base/serial/impl/psb_z_coo_impl.f90
+7 -11
View File
@@ -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 ( normval > tol) then
if (any(abs(tcoo%val(1:nzl)) > 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 ( normval > tol) then
if (any(abs(tcoo%val(1:nzl)) > tol)) then
res = .false.
else
res = .true.
cbind/base/psb_c_psblas_cbind_mod.f90
+12
View File
@@ -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
+12
View File
@@ -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
+12
View File
@@ -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
+12
View File
@@ -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