fdurastante
/
psblas3
mirror of https://github.com/sfilippone/psblas3.git
1
0
Fork 0
Code Issues Packages Projects Releases Wiki Activity

Corrected checkmat bugs in compare and get_nnz routines

Browse Source
merge-paraggr-newops
Cirdans-Home 5 years ago
parent 5c34e3d853
commit 166bd219ef
16 changed files with 136 additions and 256 deletions
Show Stats Download Patch File Download Diff File

52
base/psblas/psb_ccmp_vect.f90
Unescape Escape View File

@ -119,8 +119,6 @@ subroutine psb_ccmp_spmatval(a,val,tol,desc_a,res,info)
integer(psb_ipk_) :: err_act integer(psb_ipk_) :: err_act
character(len=20) :: name, ch_err character(len=20) :: name, ch_err
integer(psb_ipk_) :: debug_level, debug_unit integer(psb_ipk_) :: debug_level, debug_unit
integer(psb_lpk_) :: m,n,ia,ja
integer(psb_ipk_) :: iia,jja
name='psb_ccmp_spmatval' name='psb_ccmp_spmatval'
info=psb_success_ info=psb_success_
@ -139,21 +137,13 @@ subroutine psb_ccmp_spmatval(a,val,tol,desc_a,res,info)
goto 9999 goto 9999
endif 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 res = a%spcmp(val,tol,info)
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 end if
res = a%spcmp(val,tol,info)
call psb_lallreduceand(ictxt,res) call psb_lallreduceand(ictxt,res)
call psb_erractionrestore(err_act) 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 integer(psb_ipk_) :: err_act
character(len=20) :: name, ch_err character(len=20) :: name, ch_err
integer(psb_ipk_) :: debug_level, debug_unit 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' name='psb_ccmp_spmatval'
info=psb_success_ info=psb_success_
@ -203,32 +191,18 @@ subroutine psb_ccmp_spmat(a,b,tol,desc_a,res,info)
goto 9999 goto 9999
endif 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 res = a%spcmp(b,tol,info)
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 end if
res = a%spcmp(b,tol,info)
call psb_lallreduceand(ictxt,res) call psb_lallreduceand(ictxt,res)
call psb_erractionrestore(err_act) call psb_erractionrestore(err_act)
if (debug_level >= psb_debug_comp_) then if (debug_level >= psb_debug_comp_) then
call psb_barrier(ictxt) call psb_barrier(ictxt)

16
base/psblas/psb_cgetmatinfo.f90
Unescape Escape View File

@ -49,7 +49,7 @@ function psb_cget_nnz(a,desc_a,info) result(res)
! locals ! locals
integer(psb_ipk_) :: ictxt, np, me,& integer(psb_ipk_) :: ictxt, np, me,&
& err_act, iia, jja & err_act, iia, jja
integer(psb_lpk_) :: m,n,ia,ja,localnnz integer(psb_lpk_) :: localnnz
character(len=20) :: name, ch_err character(len=20) :: name, ch_err
! !
name='psb_cget_nnz' name='psb_cget_nnz'
@ -67,21 +67,9 @@ function psb_cget_nnz(a,desc_a,info) result(res)
goto 9999 goto 9999
endif 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() 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) call psb_erractionrestore(err_act)
return return

52
base/psblas/psb_dcmp_vect.f90
Unescape Escape View File

@ -241,8 +241,6 @@ subroutine psb_dcmp_spmatval(a,val,tol,desc_a,res,info)
integer(psb_ipk_) :: err_act integer(psb_ipk_) :: err_act
character(len=20) :: name, ch_err character(len=20) :: name, ch_err
integer(psb_ipk_) :: debug_level, debug_unit integer(psb_ipk_) :: debug_level, debug_unit
integer(psb_lpk_) :: m,n,ia,ja
integer(psb_ipk_) :: iia,jja
name='psb_dcmp_spmatval' name='psb_dcmp_spmatval'
info=psb_success_ info=psb_success_
@ -261,21 +259,13 @@ subroutine psb_dcmp_spmatval(a,val,tol,desc_a,res,info)
goto 9999 goto 9999
endif 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 res = a%spcmp(val,tol,info)
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 end if
res = a%spcmp(val,tol,info)
call psb_lallreduceand(ictxt,res) call psb_lallreduceand(ictxt,res)
call psb_erractionrestore(err_act) 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 integer(psb_ipk_) :: err_act
character(len=20) :: name, ch_err character(len=20) :: name, ch_err
integer(psb_ipk_) :: debug_level, debug_unit 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' name='psb_dcmp_spmatval'
info=psb_success_ info=psb_success_
@ -325,32 +313,18 @@ subroutine psb_dcmp_spmat(a,b,tol,desc_a,res,info)
goto 9999 goto 9999
endif 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 res = a%spcmp(b,tol,info)
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 end if
res = a%spcmp(b,tol,info)
call psb_lallreduceand(ictxt,res) call psb_lallreduceand(ictxt,res)
call psb_erractionrestore(err_act) call psb_erractionrestore(err_act)
if (debug_level >= psb_debug_comp_) then if (debug_level >= psb_debug_comp_) then
call psb_barrier(ictxt) call psb_barrier(ictxt)

16
base/psblas/psb_dgetmatinfo.f90
Unescape Escape View File

@ -49,7 +49,7 @@ function psb_dget_nnz(a,desc_a,info) result(res)
! locals ! locals
integer(psb_ipk_) :: ictxt, np, me,& integer(psb_ipk_) :: ictxt, np, me,&
& err_act, iia, jja & err_act, iia, jja
integer(psb_lpk_) :: m,n,ia,ja,localnnz integer(psb_lpk_) :: localnnz
character(len=20) :: name, ch_err character(len=20) :: name, ch_err
! !
name='psb_dget_nnz' name='psb_dget_nnz'
@ -67,21 +67,9 @@ function psb_dget_nnz(a,desc_a,info) result(res)
goto 9999 goto 9999
endif 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() 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) call psb_erractionrestore(err_act)
return return

52
base/psblas/psb_scmp_vect.f90
Unescape Escape View File

@ -241,8 +241,6 @@ subroutine psb_scmp_spmatval(a,val,tol,desc_a,res,info)
integer(psb_ipk_) :: err_act integer(psb_ipk_) :: err_act
character(len=20) :: name, ch_err character(len=20) :: name, ch_err
integer(psb_ipk_) :: debug_level, debug_unit integer(psb_ipk_) :: debug_level, debug_unit
integer(psb_lpk_) :: m,n,ia,ja
integer(psb_ipk_) :: iia,jja
name='psb_scmp_spmatval' name='psb_scmp_spmatval'
info=psb_success_ info=psb_success_
@ -261,21 +259,13 @@ subroutine psb_scmp_spmatval(a,val,tol,desc_a,res,info)
goto 9999 goto 9999
endif 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 res = a%spcmp(val,tol,info)
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 end if
res = a%spcmp(val,tol,info)
call psb_lallreduceand(ictxt,res) call psb_lallreduceand(ictxt,res)
call psb_erractionrestore(err_act) 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 integer(psb_ipk_) :: err_act
character(len=20) :: name, ch_err character(len=20) :: name, ch_err
integer(psb_ipk_) :: debug_level, debug_unit 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' name='psb_scmp_spmatval'
info=psb_success_ info=psb_success_
@ -325,32 +313,18 @@ subroutine psb_scmp_spmat(a,b,tol,desc_a,res,info)
goto 9999 goto 9999
endif 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 res = a%spcmp(b,tol,info)
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 end if
res = a%spcmp(b,tol,info)
call psb_lallreduceand(ictxt,res) call psb_lallreduceand(ictxt,res)
call psb_erractionrestore(err_act) call psb_erractionrestore(err_act)
if (debug_level >= psb_debug_comp_) then if (debug_level >= psb_debug_comp_) then
call psb_barrier(ictxt) call psb_barrier(ictxt)

16
base/psblas/psb_sgetmatinfo.f90
Unescape Escape View File

@ -49,7 +49,7 @@ function psb_sget_nnz(a,desc_a,info) result(res)
! locals ! locals
integer(psb_ipk_) :: ictxt, np, me,& integer(psb_ipk_) :: ictxt, np, me,&
& err_act, iia, jja & err_act, iia, jja
integer(psb_lpk_) :: m,n,ia,ja,localnnz integer(psb_lpk_) :: localnnz
character(len=20) :: name, ch_err character(len=20) :: name, ch_err
! !
name='psb_sget_nnz' name='psb_sget_nnz'
@ -67,21 +67,9 @@ function psb_sget_nnz(a,desc_a,info) result(res)
goto 9999 goto 9999
endif 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() 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) call psb_erractionrestore(err_act)
return return

52
base/psblas/psb_zcmp_vect.f90
Unescape Escape View File

@ -119,8 +119,6 @@ subroutine psb_zcmp_spmatval(a,val,tol,desc_a,res,info)
integer(psb_ipk_) :: err_act integer(psb_ipk_) :: err_act
character(len=20) :: name, ch_err character(len=20) :: name, ch_err
integer(psb_ipk_) :: debug_level, debug_unit integer(psb_ipk_) :: debug_level, debug_unit
integer(psb_lpk_) :: m,n,ia,ja
integer(psb_ipk_) :: iia,jja
name='psb_zcmp_spmatval' name='psb_zcmp_spmatval'
info=psb_success_ info=psb_success_
@ -139,21 +137,13 @@ subroutine psb_zcmp_spmatval(a,val,tol,desc_a,res,info)
goto 9999 goto 9999
endif 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 res = a%spcmp(val,tol,info)
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 end if
res = a%spcmp(val,tol,info)
call psb_lallreduceand(ictxt,res) call psb_lallreduceand(ictxt,res)
call psb_erractionrestore(err_act) 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 integer(psb_ipk_) :: err_act
character(len=20) :: name, ch_err character(len=20) :: name, ch_err
integer(psb_ipk_) :: debug_level, debug_unit 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' name='psb_zcmp_spmatval'
info=psb_success_ info=psb_success_
@ -203,32 +191,18 @@ subroutine psb_zcmp_spmat(a,b,tol,desc_a,res,info)
goto 9999 goto 9999
endif 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 res = a%spcmp(b,tol,info)
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 end if
res = a%spcmp(b,tol,info)
call psb_lallreduceand(ictxt,res) call psb_lallreduceand(ictxt,res)
call psb_erractionrestore(err_act) call psb_erractionrestore(err_act)
if (debug_level >= psb_debug_comp_) then if (debug_level >= psb_debug_comp_) then
call psb_barrier(ictxt) call psb_barrier(ictxt)

16
base/psblas/psb_zgetmatinfo.f90
Unescape Escape View File

@ -49,7 +49,7 @@ function psb_zget_nnz(a,desc_a,info) result(res)
! locals ! locals
integer(psb_ipk_) :: ictxt, np, me,& integer(psb_ipk_) :: ictxt, np, me,&
& err_act, iia, jja & err_act, iia, jja
integer(psb_lpk_) :: m,n,ia,ja,localnnz integer(psb_lpk_) :: localnnz
character(len=20) :: name, ch_err character(len=20) :: name, ch_err
! !
name='psb_zget_nnz' name='psb_zget_nnz'
@ -67,21 +67,9 @@ function psb_zget_nnz(a,desc_a,info) result(res)
goto 9999 goto 9999
endif 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() 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) call psb_erractionrestore(err_act)
return return

18
base/serial/impl/psb_c_coo_impl.f90
Unescape Escape View File

@ -328,9 +328,8 @@ function psb_c_coo_cmpmat(a,b,tol,info) result(res)
character(len=20) :: name='cmpmat' character(len=20) :: name='cmpmat'
logical, parameter :: debug=.false. 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 type(psb_c_coo_sparse_mat) :: tcoo, bcoo
real(psb_spk_) :: normval
! Copy (whatever) b format to coo ! Copy (whatever) b format to coo
call b%cp_to_coo(bcoo,info) 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%val(1:nza) = a%val(1:nza)
tcoo%ia(nza+1:nza+nzb) = bcoo%ia(1:nzb) tcoo%ia(nza+1:nza+nzb) = bcoo%ia(1:nzb)
tcoo%ja(nza+1:nza+nzb) = bcoo%ja(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 ! Fix the indexes
call tcoo%fix(info) call tcoo%fix(info)
if (info /= psb_success_) then 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') call psb_errpush(info,name, a_err='fix')
goto 9999 goto 9999
end if 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. res = .false.
else else
res = .true. res = .true.
@ -4832,9 +4830,8 @@ function psb_lc_coo_cmpmat(a,b,tol,info) result(res)
character(len=20) :: name='cmpmat' character(len=20) :: name='cmpmat'
logical, parameter :: debug=.false. 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 type(psb_lc_coo_sparse_mat) :: tcoo, bcoo
real(psb_spk_) :: normval
! Copy (whatever) b format to coo ! Copy (whatever) b format to coo
call b%cp_to_coo(bcoo,info) 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') call psb_errpush(info,name, a_err='fix')
goto 9999 goto 9999
end if end if
nzl = tcoo%get_nzeros()
normval = tcoo%spnmi() if (any(abs(tcoo%val(1:nzl)) > tol)) then
if ( normval > tol) then
res = .false. res = .false.
else else
res = .true. res = .true.

18
base/serial/impl/psb_d_coo_impl.f90
Unescape Escape View File

@ -328,9 +328,8 @@ function psb_d_coo_cmpmat(a,b,tol,info) result(res)
character(len=20) :: name='cmpmat' character(len=20) :: name='cmpmat'
logical, parameter :: debug=.false. 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 type(psb_d_coo_sparse_mat) :: tcoo, bcoo
real(psb_dpk_) :: normval
! Copy (whatever) b format to coo ! Copy (whatever) b format to coo
call b%cp_to_coo(bcoo,info) 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%val(1:nza) = a%val(1:nza)
tcoo%ia(nza+1:nza+nzb) = bcoo%ia(1:nzb) tcoo%ia(nza+1:nza+nzb) = bcoo%ia(1:nzb)
tcoo%ja(nza+1:nza+nzb) = bcoo%ja(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 ! Fix the indexes
call tcoo%fix(info) call tcoo%fix(info)
if (info /= psb_success_) then 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') call psb_errpush(info,name, a_err='fix')
goto 9999 goto 9999
end if 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. res = .false.
else else
res = .true. res = .true.
@ -4832,9 +4830,8 @@ function psb_ld_coo_cmpmat(a,b,tol,info) result(res)
character(len=20) :: name='cmpmat' character(len=20) :: name='cmpmat'
logical, parameter :: debug=.false. 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 type(psb_ld_coo_sparse_mat) :: tcoo, bcoo
real(psb_dpk_) :: normval
! Copy (whatever) b format to coo ! Copy (whatever) b format to coo
call b%cp_to_coo(bcoo,info) 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') call psb_errpush(info,name, a_err='fix')
goto 9999 goto 9999
end if end if
nzl = tcoo%get_nzeros()
normval = tcoo%spnmi() if (any(abs(tcoo%val(1:nzl)) > tol)) then
if ( normval > tol) then
res = .false. res = .false.
else else
res = .true. res = .true.

18
base/serial/impl/psb_s_coo_impl.f90
Unescape Escape View File

@ -328,9 +328,8 @@ function psb_s_coo_cmpmat(a,b,tol,info) result(res)
character(len=20) :: name='cmpmat' character(len=20) :: name='cmpmat'
logical, parameter :: debug=.false. 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 type(psb_s_coo_sparse_mat) :: tcoo, bcoo
real(psb_spk_) :: normval
! Copy (whatever) b format to coo ! Copy (whatever) b format to coo
call b%cp_to_coo(bcoo,info) 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%val(1:nza) = a%val(1:nza)
tcoo%ia(nza+1:nza+nzb) = bcoo%ia(1:nzb) tcoo%ia(nza+1:nza+nzb) = bcoo%ia(1:nzb)
tcoo%ja(nza+1:nza+nzb) = bcoo%ja(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 ! Fix the indexes
call tcoo%fix(info) call tcoo%fix(info)
if (info /= psb_success_) then 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') call psb_errpush(info,name, a_err='fix')
goto 9999 goto 9999
end if 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. res = .false.
else else
res = .true. res = .true.
@ -4832,9 +4830,8 @@ function psb_ls_coo_cmpmat(a,b,tol,info) result(res)
character(len=20) :: name='cmpmat' character(len=20) :: name='cmpmat'
logical, parameter :: debug=.false. 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 type(psb_ls_coo_sparse_mat) :: tcoo, bcoo
real(psb_spk_) :: normval
! Copy (whatever) b format to coo ! Copy (whatever) b format to coo
call b%cp_to_coo(bcoo,info) 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') call psb_errpush(info,name, a_err='fix')
goto 9999 goto 9999
end if end if
nzl = tcoo%get_nzeros()
normval = tcoo%spnmi() if (any(abs(tcoo%val(1:nzl)) > tol)) then
if ( normval > tol) then
res = .false. res = .false.
else else
res = .true. res = .true.

18
base/serial/impl/psb_z_coo_impl.f90
Unescape Escape View File

@ -328,9 +328,8 @@ function psb_z_coo_cmpmat(a,b,tol,info) result(res)
character(len=20) :: name='cmpmat' character(len=20) :: name='cmpmat'
logical, parameter :: debug=.false. 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 type(psb_z_coo_sparse_mat) :: tcoo, bcoo
real(psb_dpk_) :: normval
! Copy (whatever) b format to coo ! Copy (whatever) b format to coo
call b%cp_to_coo(bcoo,info) 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%val(1:nza) = a%val(1:nza)
tcoo%ia(nza+1:nza+nzb) = bcoo%ia(1:nzb) tcoo%ia(nza+1:nza+nzb) = bcoo%ia(1:nzb)
tcoo%ja(nza+1:nza+nzb) = bcoo%ja(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 ! Fix the indexes
call tcoo%fix(info) call tcoo%fix(info)
if (info /= psb_success_) then 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') call psb_errpush(info,name, a_err='fix')
goto 9999 goto 9999
end if 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. res = .false.
else else
res = .true. res = .true.
@ -4832,9 +4830,8 @@ function psb_lz_coo_cmpmat(a,b,tol,info) result(res)
character(len=20) :: name='cmpmat' character(len=20) :: name='cmpmat'
logical, parameter :: debug=.false. 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 type(psb_lz_coo_sparse_mat) :: tcoo, bcoo
real(psb_dpk_) :: normval
! Copy (whatever) b format to coo ! Copy (whatever) b format to coo
call b%cp_to_coo(bcoo,info) 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') call psb_errpush(info,name, a_err='fix')
goto 9999 goto 9999
end if end if
nzl = tcoo%get_nzeros()
normval = tcoo%spnmi() if (any(abs(tcoo%val(1:nzl)) > tol)) then
if ( normval > tol) then
res = .false. res = .false.
else else
res = .true. res = .true.

12
cbind/base/psb_c_psblas_cbind_mod.f90
Unescape Escape View File

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

12
cbind/base/psb_d_psblas_cbind_mod.f90
Unescape Escape View File

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

12
cbind/base/psb_s_psblas_cbind_mod.f90
Unescape Escape View File

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

12
cbind/base/psb_z_psblas_cbind_mod.f90
Unescape Escape View File

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

Write Preview
Loading…
Cancel
Save