fdurastante/psblas3
1
0
Fork 0
mirror of https://github.com/sfilippone/psblas3.git synced 2026-10-24 23:01:48 +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/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.