mirror of
https://github.com/sfilippone/psblas3.git
synced 2026-10-19 12:22:10 +00:00
New checkvect interface, and use.
This commit is contained in:
+122
-81
@@ -66,7 +66,7 @@ contains
|
||||
! info - integer. Return code
|
||||
! iix - integer(optional). The local rows starting index of the submatrix.
|
||||
! jjx - integer(optional). The local columns starting index of the submatrix.
|
||||
subroutine psb_chkvect( m, n, lldx, ix, jx, desc_dec, info, iix, jjx)
|
||||
subroutine psb_chkvect( m, n, lldx, ix, jx, desc_dec, info, iix, jjx, check_halo)
|
||||
use psb_desc_mod
|
||||
use psb_const_mod
|
||||
use psb_error_mod
|
||||
@@ -77,17 +77,31 @@ contains
|
||||
type(psb_desc_type), intent(in) :: desc_dec
|
||||
integer(psb_ipk_), intent(out) :: info
|
||||
integer(psb_ipk_), optional :: iix, jjx
|
||||
logical, optional :: check_halo
|
||||
|
||||
! locals
|
||||
integer(psb_ipk_) :: err_act, int_err(5)
|
||||
integer(psb_ipk_) :: nrl, ncl
|
||||
integer(psb_lpk_) :: nrg, ncg
|
||||
character(len=20) :: name
|
||||
logical :: check_halo_
|
||||
|
||||
if(psb_get_errstatus() /= 0) return
|
||||
info=psb_success_
|
||||
name='psb_chkvect'
|
||||
call psb_erractionsave(err_act)
|
||||
|
||||
|
||||
if (present(check_halo)) then
|
||||
check_halo_ = check_halo
|
||||
else
|
||||
check_halo_ = .false.
|
||||
end if
|
||||
|
||||
nrl = desc_dec%get_local_rows()
|
||||
ncl = desc_dec%get_local_cols()
|
||||
nrg = desc_dec%get_global_rows()
|
||||
ncg = desc_dec%get_global_cols()
|
||||
|
||||
|
||||
if (m < 0) then
|
||||
info=psb_err_iarg_neg_
|
||||
int_err(1) = 1
|
||||
@@ -101,54 +115,67 @@ contains
|
||||
int_err(1) = 4
|
||||
int_err(2) = ix
|
||||
else if ((jx < 1) .and. (n /= 0)) then
|
||||
info=psb_err_iarg_pos_
|
||||
int_err(1) = 5
|
||||
int_err(2) = jx
|
||||
else if (desc_dec%get_local_cols() < 0) then
|
||||
info=psb_err_iarg_invalid_i_
|
||||
int_err(1) = 6
|
||||
int_err(2) = psb_n_col_
|
||||
int_err(3) = desc_dec%get_local_cols()
|
||||
else if (desc_dec%get_local_rows() < 0) then
|
||||
info=psb_err_iarg_invalid_i_
|
||||
int_err(1) = 6
|
||||
int_err(2) = psb_n_row_
|
||||
int_err(3) = desc_dec%get_local_cols()
|
||||
else if (lldx < desc_dec%get_local_cols()) then
|
||||
info=psb_err_iarg_not_gtia_ii_
|
||||
int_err(1) = 3
|
||||
int_err(2) = lldx
|
||||
int_err(3) = 6
|
||||
int_err(4) = psb_n_col_
|
||||
int_err(5) = desc_dec%get_local_cols()
|
||||
else if (desc_dec%get_global_cols() < m) then
|
||||
info=psb_err_iarg_not_gteia_ii_
|
||||
int_err(1) = 1
|
||||
int_err(2) = m
|
||||
int_err(3) = 6
|
||||
int_err(4) = psb_n_
|
||||
int_err(5) = desc_dec%get_global_cols()
|
||||
else if (desc_dec%get_global_cols() < ix) then
|
||||
info=psb_err_iarg_not_gteia_ii_
|
||||
int_err(1) = 4
|
||||
int_err(2) = ix
|
||||
int_err(3) = 6
|
||||
int_err(4) = psb_n_
|
||||
int_err(5) = desc_dec%get_global_cols()
|
||||
else if (desc_dec%get_global_rows() < jx) then
|
||||
info=psb_err_iarg_not_gteia_ii_
|
||||
int_err(1) = 5
|
||||
int_err(2) = jx
|
||||
int_err(3) = 6
|
||||
int_err(4) = psb_m_
|
||||
int_err(5) = desc_dec%get_global_rows()
|
||||
else if (desc_dec%get_global_cols() < (ix+m-1)) then
|
||||
info=psb_err_iarg2_neg_
|
||||
int_err(1) = 1
|
||||
int_err(2) = m
|
||||
int_err(3) = 4
|
||||
int_err(4) = ix
|
||||
end if
|
||||
info=psb_err_iarg_pos_
|
||||
int_err(1) = 5
|
||||
int_err(2) = jx
|
||||
else if (ncl < 0) then
|
||||
info=psb_err_iarg_invalid_i_
|
||||
int_err(1) = 6
|
||||
int_err(2) = psb_n_col_
|
||||
int_err(3) = ncl
|
||||
else if (nrl < 0) then
|
||||
info=psb_err_iarg_invalid_i_
|
||||
int_err(1) = 6
|
||||
int_err(2) = psb_n_row_
|
||||
int_err(3) = nrl
|
||||
else if (ncg < m) then
|
||||
info=psb_err_iarg_not_gteia_ii_
|
||||
int_err(1) = 1
|
||||
int_err(2) = m
|
||||
int_err(3) = 6
|
||||
int_err(4) = psb_n_
|
||||
int_err(5) = ncg
|
||||
else if (ncg < ix) then
|
||||
info=psb_err_iarg_not_gteia_ii_
|
||||
int_err(1) = 4
|
||||
int_err(2) = ix
|
||||
int_err(3) = 6
|
||||
int_err(4) = psb_n_
|
||||
int_err(5) = ncg
|
||||
else if (nrg < jx) then
|
||||
info=psb_err_iarg_not_gteia_ii_
|
||||
int_err(1) = 5
|
||||
int_err(2) = jx
|
||||
int_err(3) = 6
|
||||
int_err(4) = psb_m_
|
||||
int_err(5) = nrg
|
||||
else if (ncg < (ix+m-1)) then
|
||||
info=psb_err_iarg2_neg_
|
||||
int_err(1) = 1
|
||||
int_err(2) = m
|
||||
int_err(3) = 4
|
||||
int_err(4) = ix
|
||||
else
|
||||
if (check_halo_) then
|
||||
if (lldx < ncl) then
|
||||
info=psb_err_iarg_not_gtia_ii_
|
||||
int_err(1) = 3
|
||||
int_err(2) = lldx
|
||||
int_err(3) = 6
|
||||
int_err(4) = psb_n_col_
|
||||
int_err(5) = ncl
|
||||
end if
|
||||
else
|
||||
if (lldx < nrl) then
|
||||
info=psb_err_iarg_not_gtia_ii_
|
||||
int_err(1) = 3
|
||||
int_err(2) = lldx
|
||||
int_err(3) = 6
|
||||
int_err(4) = psb_n_row_
|
||||
int_err(5) = nrl
|
||||
end if
|
||||
end if
|
||||
end if
|
||||
|
||||
if (info /= psb_success_) then
|
||||
call psb_errpush(info,name,i_err=int_err)
|
||||
@@ -201,6 +228,8 @@ contains
|
||||
|
||||
! locals
|
||||
integer(psb_ipk_) :: err_act, int_err(5)
|
||||
integer(psb_ipk_) :: nrl, ncl
|
||||
integer(psb_lpk_) :: nrg, ncg
|
||||
character(len=20) :: name
|
||||
|
||||
if(psb_get_errstatus() /= 0) return
|
||||
@@ -208,6 +237,11 @@ contains
|
||||
name='psb_chkglobvect'
|
||||
call psb_erractionsave(err_act)
|
||||
|
||||
|
||||
nrl = desc_dec%get_local_rows()
|
||||
ncl = desc_dec%get_local_cols()
|
||||
nrg = desc_dec%get_global_rows()
|
||||
ncg = desc_dec%get_global_cols()
|
||||
|
||||
if (m < 0) then
|
||||
info=psb_err_iarg_neg_
|
||||
@@ -225,45 +259,45 @@ contains
|
||||
info=psb_err_iarg_pos_
|
||||
int_err(1) = 5
|
||||
int_err(2) = jx
|
||||
else if (desc_dec%get_local_cols() < 0) then
|
||||
else if (ncl < 0) then
|
||||
info=psb_err_iarg_invalid_i_
|
||||
int_err(1) = 6
|
||||
int_err(2) = psb_n_col_
|
||||
int_err(3) = desc_dec%get_local_cols()
|
||||
else if (desc_dec%get_local_rows() < 0) then
|
||||
int_err(3) = ncl
|
||||
else if (nrl < 0) then
|
||||
info=psb_err_iarg_invalid_i_
|
||||
int_err(1) = 6
|
||||
int_err(2) = psb_n_row_
|
||||
int_err(3) = desc_dec%get_local_rows()
|
||||
else if (lldx < desc_dec%get_global_rows()) then
|
||||
int_err(3) = nrl
|
||||
else if (lldx < nrg) then
|
||||
info=psb_err_iarg_not_gtia_ii_
|
||||
int_err(1) = 3
|
||||
int_err(2) = lldx
|
||||
int_err(3) = 6
|
||||
int_err(4) = psb_n_col_
|
||||
int_err(5) = desc_dec%get_global_rows()
|
||||
else if (desc_dec%get_global_cols() < m) then
|
||||
int_err(5) = nrg
|
||||
else if (ncg < m) then
|
||||
info=psb_err_iarg_not_gteia_ii_
|
||||
int_err(1) = 1
|
||||
int_err(2) = m
|
||||
int_err(3) = 6
|
||||
int_err(4) = psb_n_
|
||||
int_err(5) = desc_dec%get_global_cols()
|
||||
else if (desc_dec%get_global_cols() < ix) then
|
||||
int_err(5) = ncg
|
||||
else if (ncg < ix) then
|
||||
info=psb_err_iarg_not_gteia_ii_
|
||||
int_err(1) = 4
|
||||
int_err(2) = ix
|
||||
int_err(3) = 6
|
||||
int_err(4) = psb_n_
|
||||
int_err(5) = desc_dec%get_global_cols()
|
||||
else if (desc_dec%get_global_rows() < jx) then
|
||||
int_err(5) = ncg
|
||||
else if (nrg < jx) then
|
||||
info=psb_err_iarg_not_gteia_ii_
|
||||
int_err(1) = 5
|
||||
int_err(2) = jx
|
||||
int_err(3) = 6
|
||||
int_err(4) = psb_m_
|
||||
int_err(5) = desc_dec%get_global_rows()
|
||||
else if (desc_dec%get_global_cols() < (ix+m-1)) then
|
||||
int_err(5) = nrg
|
||||
else if (ncg < (ix+m-1)) then
|
||||
info=psb_err_iarg2_neg_
|
||||
int_err(1) = 1
|
||||
int_err(2) = m
|
||||
@@ -320,12 +354,19 @@ contains
|
||||
|
||||
! locals
|
||||
integer(psb_ipk_) :: err_act, int_err(5)
|
||||
integer(psb_ipk_) :: nrl, ncl
|
||||
integer(psb_lpk_) :: nrg, ncg
|
||||
character(len=20) :: name
|
||||
|
||||
if(psb_get_errstatus() /= 0) return
|
||||
info=psb_success_
|
||||
name='psb_chkmat'
|
||||
call psb_erractionsave(err_act)
|
||||
|
||||
nrl = desc_dec%get_local_rows()
|
||||
ncl = desc_dec%get_local_cols()
|
||||
nrg = desc_dec%get_global_rows()
|
||||
ncg = desc_dec%get_global_cols()
|
||||
|
||||
if (m < 0) then
|
||||
info=psb_err_iarg_neg_
|
||||
@@ -343,51 +384,51 @@ contains
|
||||
info=psb_err_iarg_pos_
|
||||
int_err(1) = 5
|
||||
int_err(2) = ja
|
||||
else if (desc_dec%get_local_cols() < 0) then
|
||||
else if (ncl < 0) then
|
||||
info=psb_err_iarg_invalid_i_
|
||||
int_err(1) = 6
|
||||
int_err(2) = psb_n_col_
|
||||
int_err(3) = desc_dec%get_local_cols()
|
||||
else if (desc_dec%get_local_rows() < 0) then
|
||||
int_err(3) = ncl
|
||||
else if (nrl < 0) then
|
||||
info=psb_err_iarg_invalid_i_
|
||||
int_err(1) = 6
|
||||
int_err(2) = psb_n_row_
|
||||
int_err(3) = desc_dec%get_local_rows()
|
||||
else if (desc_dec%get_global_rows() < m) then
|
||||
int_err(3) = nrl
|
||||
else if (nrg < m) then
|
||||
info=psb_err_iarg_not_gteia_ii_
|
||||
int_err(1) = 1
|
||||
int_err(2) = m
|
||||
int_err(3) = 5
|
||||
int_err(4) = psb_m_
|
||||
int_err(5) = desc_dec%get_global_rows()
|
||||
else if (desc_dec%get_global_rows() < m) then
|
||||
int_err(5) = nrg
|
||||
else if (nrg < m) then
|
||||
info=psb_err_iarg_not_gteia_ii_
|
||||
int_err(1) = 2
|
||||
int_err(2) = n
|
||||
int_err(3) = 5
|
||||
int_err(4) = psb_m_
|
||||
int_err(5) = desc_dec%get_global_rows()
|
||||
else if (desc_dec%get_global_rows() < ia) then
|
||||
int_err(5) = nrg
|
||||
else if (nrg < ia) then
|
||||
info=psb_err_iarg_not_gteia_ii_
|
||||
int_err(1) = 3
|
||||
int_err(2) = ia
|
||||
int_err(3) = 5
|
||||
int_err(4) = psb_m_
|
||||
int_err(5) = desc_dec%get_global_rows()
|
||||
else if (desc_dec%get_global_cols() < ja) then
|
||||
int_err(5) = nrg
|
||||
else if (ncg < ja) then
|
||||
info=psb_err_iarg_not_gteia_ii_
|
||||
int_err(1) = 4
|
||||
int_err(2) = ja
|
||||
int_err(3) = 5
|
||||
int_err(4) = psb_n_
|
||||
int_err(5) = desc_dec%get_global_cols()
|
||||
else if (desc_dec%get_global_rows() < (ia+m-1)) then
|
||||
int_err(5) = ncg
|
||||
else if (nrg < (ia+m-1)) then
|
||||
info=psb_err_iarg2_neg_
|
||||
int_err(1) = 1
|
||||
int_err(2) = m
|
||||
int_err(3) = 3
|
||||
int_err(4) = ia
|
||||
else if (desc_dec%get_global_cols() < (ja+n-1)) then
|
||||
else if (ncg < (ja+n-1)) then
|
||||
info=psb_err_iarg2_neg_
|
||||
int_err(1) = 2
|
||||
int_err(2) = n
|
||||
@@ -403,12 +444,12 @@ contains
|
||||
! Compute local indices for submatrix starting
|
||||
! at global indices ix and jx
|
||||
if(present(iia).and.present(jja)) then
|
||||
if (desc_dec%get_local_rows() > 0) then
|
||||
if (nrl > 0) then
|
||||
iia=1
|
||||
jja=1
|
||||
else
|
||||
iia=desc_dec%get_local_rows()+1
|
||||
jja=desc_dec%get_local_cols()+1
|
||||
iia=nrl+1
|
||||
jja=ncl+1
|
||||
end if
|
||||
end if
|
||||
|
||||
|
||||
@@ -207,7 +207,7 @@ subroutine psb_cspmm(alpha,a,x,beta,y,desc_a,info,&
|
||||
end if
|
||||
|
||||
! checking for vectors correctness
|
||||
call psb_chkvect(n,lik,lldx,ix,ijx,desc_a,info,iix,jjx)
|
||||
call psb_chkvect(n,lik,lldx,ix,ijx,desc_a,info,iix,jjx,check_halo=.true.)
|
||||
if (info == psb_success_) &
|
||||
& call psb_chkvect(m,lik,lldy,iy,ijy,desc_a,info,iiy,jjy)
|
||||
if(info /= psb_success_) then
|
||||
@@ -279,9 +279,9 @@ subroutine psb_cspmm(alpha,a,x,beta,y,desc_a,info,&
|
||||
|
||||
|
||||
! checking for vectors correctness
|
||||
call psb_chkvect(m,lik,lldx,ix,ijx,desc_a,info,iix,jjx)
|
||||
call psb_chkvect(m,lik,lldx,ix,ijx,desc_a,info,iix,jjx,check_halo=.true.)
|
||||
if (info == psb_success_) &
|
||||
& call psb_chkvect(n,lik,lldy,iy,ijy,desc_a,info,iiy,jjy)
|
||||
& call psb_chkvect(n,lik,lldy,iy,ijy,desc_a,info,iiy,jjy,check_halo=.true.)
|
||||
if(info /= psb_success_) then
|
||||
info=psb_err_from_subroutine_
|
||||
ch_err='psb_chkvect'
|
||||
@@ -545,7 +545,7 @@ subroutine psb_cspmv(alpha,a,x,beta,y,desc_a,info,&
|
||||
end if
|
||||
|
||||
! checking for vectors correctness
|
||||
call psb_chkvect(n,lik,lldx,ix,jx,desc_a,info,iix,jjx)
|
||||
call psb_chkvect(n,lik,lldx,ix,jx,desc_a,info,iix,jjx,check_halo=.true.)
|
||||
if (info == psb_success_) &
|
||||
& call psb_chkvect(m,lik,lldy,iy,jy,desc_a,info,iiy,jjy)
|
||||
if(info /= psb_success_) then
|
||||
@@ -585,9 +585,9 @@ subroutine psb_cspmv(alpha,a,x,beta,y,desc_a,info,&
|
||||
end if
|
||||
|
||||
! checking for vectors correctness
|
||||
call psb_chkvect(m,lik,lldx,ix,jx,desc_a,info,iix,jjx)
|
||||
call psb_chkvect(m,lik,lldx,ix,jx,desc_a,info,iix,jjx,check_halo=.true.)
|
||||
if (info == psb_success_)&
|
||||
& call psb_chkvect(n,lik,lldy,iy,jy,desc_a,info,iiy,jjy)
|
||||
& call psb_chkvect(n,lik,lldy,iy,jy,desc_a,info,iiy,jjy,check_halo=.true.)
|
||||
if(info /= psb_success_) then
|
||||
info=psb_err_from_subroutine_
|
||||
ch_err='psb_chkvect'
|
||||
|
||||
@@ -222,9 +222,9 @@ subroutine psb_cspsm(alpha,a,x,beta,y,desc_a,info,&
|
||||
call psb_chkmat(m,m,ia,ja,desc_a,info,iia,jja)
|
||||
! checking for vectors correctness
|
||||
if (info == psb_success_) &
|
||||
& call psb_chkvect(m,lik,lldx,ix,ijx,desc_a,info,iix,jjx)
|
||||
& call psb_chkvect(m,lik,lldx,ix,ijx,desc_a,info,iix,jjx,check_halo=.true.)
|
||||
if (info == psb_success_) &
|
||||
& call psb_chkvect(m,lik,lldy,iy,ijy,desc_a,info,iiy,jjy)
|
||||
& call psb_chkvect(m,lik,lldy,iy,ijy,desc_a,info,iiy,jjy,check_halo=.true.)
|
||||
if(info /= psb_success_) then
|
||||
info=psb_err_from_subroutine_
|
||||
ch_err='psb_chkvect/mat'
|
||||
@@ -484,9 +484,9 @@ subroutine psb_cspsv(alpha,a,x,beta,y,desc_a,info,&
|
||||
call psb_chkmat(m,m,ia,ja,desc_a,info,iia,jja)
|
||||
! checking for vectors correctness
|
||||
if (info == psb_success_) &
|
||||
& call psb_chkvect(m,lik,lldx,ix,jx,desc_a,info,iix,jjx)
|
||||
& call psb_chkvect(m,lik,lldx,ix,jx,desc_a,info,iix,jjx,check_halo=.true.)
|
||||
if (info == psb_success_) &
|
||||
& call psb_chkvect(m,lik,lldy,iy,jy,desc_a,info,iiy,jjy)
|
||||
& call psb_chkvect(m,lik,lldy,iy,jy,desc_a,info,iiy,jjy,check_halo=.true.)
|
||||
if(info /= psb_success_) then
|
||||
info=psb_err_from_subroutine_
|
||||
ch_err='psb_chkvect/mat'
|
||||
|
||||
@@ -207,7 +207,7 @@ subroutine psb_dspmm(alpha,a,x,beta,y,desc_a,info,&
|
||||
end if
|
||||
|
||||
! checking for vectors correctness
|
||||
call psb_chkvect(n,lik,lldx,ix,ijx,desc_a,info,iix,jjx)
|
||||
call psb_chkvect(n,lik,lldx,ix,ijx,desc_a,info,iix,jjx,check_halo=.true.)
|
||||
if (info == psb_success_) &
|
||||
& call psb_chkvect(m,lik,lldy,iy,ijy,desc_a,info,iiy,jjy)
|
||||
if(info /= psb_success_) then
|
||||
@@ -279,9 +279,9 @@ subroutine psb_dspmm(alpha,a,x,beta,y,desc_a,info,&
|
||||
|
||||
|
||||
! checking for vectors correctness
|
||||
call psb_chkvect(m,lik,lldx,ix,ijx,desc_a,info,iix,jjx)
|
||||
call psb_chkvect(m,lik,lldx,ix,ijx,desc_a,info,iix,jjx,check_halo=.true.)
|
||||
if (info == psb_success_) &
|
||||
& call psb_chkvect(n,lik,lldy,iy,ijy,desc_a,info,iiy,jjy)
|
||||
& call psb_chkvect(n,lik,lldy,iy,ijy,desc_a,info,iiy,jjy,check_halo=.true.)
|
||||
if(info /= psb_success_) then
|
||||
info=psb_err_from_subroutine_
|
||||
ch_err='psb_chkvect'
|
||||
@@ -545,7 +545,7 @@ subroutine psb_dspmv(alpha,a,x,beta,y,desc_a,info,&
|
||||
end if
|
||||
|
||||
! checking for vectors correctness
|
||||
call psb_chkvect(n,lik,lldx,ix,jx,desc_a,info,iix,jjx)
|
||||
call psb_chkvect(n,lik,lldx,ix,jx,desc_a,info,iix,jjx,check_halo=.true.)
|
||||
if (info == psb_success_) &
|
||||
& call psb_chkvect(m,lik,lldy,iy,jy,desc_a,info,iiy,jjy)
|
||||
if(info /= psb_success_) then
|
||||
@@ -585,9 +585,9 @@ subroutine psb_dspmv(alpha,a,x,beta,y,desc_a,info,&
|
||||
end if
|
||||
|
||||
! checking for vectors correctness
|
||||
call psb_chkvect(m,lik,lldx,ix,jx,desc_a,info,iix,jjx)
|
||||
call psb_chkvect(m,lik,lldx,ix,jx,desc_a,info,iix,jjx,check_halo=.true.)
|
||||
if (info == psb_success_)&
|
||||
& call psb_chkvect(n,lik,lldy,iy,jy,desc_a,info,iiy,jjy)
|
||||
& call psb_chkvect(n,lik,lldy,iy,jy,desc_a,info,iiy,jjy,check_halo=.true.)
|
||||
if(info /= psb_success_) then
|
||||
info=psb_err_from_subroutine_
|
||||
ch_err='psb_chkvect'
|
||||
|
||||
@@ -222,9 +222,9 @@ subroutine psb_dspsm(alpha,a,x,beta,y,desc_a,info,&
|
||||
call psb_chkmat(m,m,ia,ja,desc_a,info,iia,jja)
|
||||
! checking for vectors correctness
|
||||
if (info == psb_success_) &
|
||||
& call psb_chkvect(m,lik,lldx,ix,ijx,desc_a,info,iix,jjx)
|
||||
& call psb_chkvect(m,lik,lldx,ix,ijx,desc_a,info,iix,jjx,check_halo=.true.)
|
||||
if (info == psb_success_) &
|
||||
& call psb_chkvect(m,lik,lldy,iy,ijy,desc_a,info,iiy,jjy)
|
||||
& call psb_chkvect(m,lik,lldy,iy,ijy,desc_a,info,iiy,jjy,check_halo=.true.)
|
||||
if(info /= psb_success_) then
|
||||
info=psb_err_from_subroutine_
|
||||
ch_err='psb_chkvect/mat'
|
||||
@@ -484,9 +484,9 @@ subroutine psb_dspsv(alpha,a,x,beta,y,desc_a,info,&
|
||||
call psb_chkmat(m,m,ia,ja,desc_a,info,iia,jja)
|
||||
! checking for vectors correctness
|
||||
if (info == psb_success_) &
|
||||
& call psb_chkvect(m,lik,lldx,ix,jx,desc_a,info,iix,jjx)
|
||||
& call psb_chkvect(m,lik,lldx,ix,jx,desc_a,info,iix,jjx,check_halo=.true.)
|
||||
if (info == psb_success_) &
|
||||
& call psb_chkvect(m,lik,lldy,iy,jy,desc_a,info,iiy,jjy)
|
||||
& call psb_chkvect(m,lik,lldy,iy,jy,desc_a,info,iiy,jjy,check_halo=.true.)
|
||||
if(info /= psb_success_) then
|
||||
info=psb_err_from_subroutine_
|
||||
ch_err='psb_chkvect/mat'
|
||||
|
||||
@@ -207,7 +207,7 @@ subroutine psb_sspmm(alpha,a,x,beta,y,desc_a,info,&
|
||||
end if
|
||||
|
||||
! checking for vectors correctness
|
||||
call psb_chkvect(n,lik,lldx,ix,ijx,desc_a,info,iix,jjx)
|
||||
call psb_chkvect(n,lik,lldx,ix,ijx,desc_a,info,iix,jjx,check_halo=.true.)
|
||||
if (info == psb_success_) &
|
||||
& call psb_chkvect(m,lik,lldy,iy,ijy,desc_a,info,iiy,jjy)
|
||||
if(info /= psb_success_) then
|
||||
@@ -279,9 +279,9 @@ subroutine psb_sspmm(alpha,a,x,beta,y,desc_a,info,&
|
||||
|
||||
|
||||
! checking for vectors correctness
|
||||
call psb_chkvect(m,lik,lldx,ix,ijx,desc_a,info,iix,jjx)
|
||||
call psb_chkvect(m,lik,lldx,ix,ijx,desc_a,info,iix,jjx,check_halo=.true.)
|
||||
if (info == psb_success_) &
|
||||
& call psb_chkvect(n,lik,lldy,iy,ijy,desc_a,info,iiy,jjy)
|
||||
& call psb_chkvect(n,lik,lldy,iy,ijy,desc_a,info,iiy,jjy,check_halo=.true.)
|
||||
if(info /= psb_success_) then
|
||||
info=psb_err_from_subroutine_
|
||||
ch_err='psb_chkvect'
|
||||
@@ -545,7 +545,7 @@ subroutine psb_sspmv(alpha,a,x,beta,y,desc_a,info,&
|
||||
end if
|
||||
|
||||
! checking for vectors correctness
|
||||
call psb_chkvect(n,lik,lldx,ix,jx,desc_a,info,iix,jjx)
|
||||
call psb_chkvect(n,lik,lldx,ix,jx,desc_a,info,iix,jjx,check_halo=.true.)
|
||||
if (info == psb_success_) &
|
||||
& call psb_chkvect(m,lik,lldy,iy,jy,desc_a,info,iiy,jjy)
|
||||
if(info /= psb_success_) then
|
||||
@@ -585,9 +585,9 @@ subroutine psb_sspmv(alpha,a,x,beta,y,desc_a,info,&
|
||||
end if
|
||||
|
||||
! checking for vectors correctness
|
||||
call psb_chkvect(m,lik,lldx,ix,jx,desc_a,info,iix,jjx)
|
||||
call psb_chkvect(m,lik,lldx,ix,jx,desc_a,info,iix,jjx,check_halo=.true.)
|
||||
if (info == psb_success_)&
|
||||
& call psb_chkvect(n,lik,lldy,iy,jy,desc_a,info,iiy,jjy)
|
||||
& call psb_chkvect(n,lik,lldy,iy,jy,desc_a,info,iiy,jjy,check_halo=.true.)
|
||||
if(info /= psb_success_) then
|
||||
info=psb_err_from_subroutine_
|
||||
ch_err='psb_chkvect'
|
||||
|
||||
@@ -222,9 +222,9 @@ subroutine psb_sspsm(alpha,a,x,beta,y,desc_a,info,&
|
||||
call psb_chkmat(m,m,ia,ja,desc_a,info,iia,jja)
|
||||
! checking for vectors correctness
|
||||
if (info == psb_success_) &
|
||||
& call psb_chkvect(m,lik,lldx,ix,ijx,desc_a,info,iix,jjx)
|
||||
& call psb_chkvect(m,lik,lldx,ix,ijx,desc_a,info,iix,jjx,check_halo=.true.)
|
||||
if (info == psb_success_) &
|
||||
& call psb_chkvect(m,lik,lldy,iy,ijy,desc_a,info,iiy,jjy)
|
||||
& call psb_chkvect(m,lik,lldy,iy,ijy,desc_a,info,iiy,jjy,check_halo=.true.)
|
||||
if(info /= psb_success_) then
|
||||
info=psb_err_from_subroutine_
|
||||
ch_err='psb_chkvect/mat'
|
||||
@@ -484,9 +484,9 @@ subroutine psb_sspsv(alpha,a,x,beta,y,desc_a,info,&
|
||||
call psb_chkmat(m,m,ia,ja,desc_a,info,iia,jja)
|
||||
! checking for vectors correctness
|
||||
if (info == psb_success_) &
|
||||
& call psb_chkvect(m,lik,lldx,ix,jx,desc_a,info,iix,jjx)
|
||||
& call psb_chkvect(m,lik,lldx,ix,jx,desc_a,info,iix,jjx,check_halo=.true.)
|
||||
if (info == psb_success_) &
|
||||
& call psb_chkvect(m,lik,lldy,iy,jy,desc_a,info,iiy,jjy)
|
||||
& call psb_chkvect(m,lik,lldy,iy,jy,desc_a,info,iiy,jjy,check_halo=.true.)
|
||||
if(info /= psb_success_) then
|
||||
info=psb_err_from_subroutine_
|
||||
ch_err='psb_chkvect/mat'
|
||||
|
||||
@@ -207,7 +207,7 @@ subroutine psb_zspmm(alpha,a,x,beta,y,desc_a,info,&
|
||||
end if
|
||||
|
||||
! checking for vectors correctness
|
||||
call psb_chkvect(n,lik,lldx,ix,ijx,desc_a,info,iix,jjx)
|
||||
call psb_chkvect(n,lik,lldx,ix,ijx,desc_a,info,iix,jjx,check_halo=.true.)
|
||||
if (info == psb_success_) &
|
||||
& call psb_chkvect(m,lik,lldy,iy,ijy,desc_a,info,iiy,jjy)
|
||||
if(info /= psb_success_) then
|
||||
@@ -279,9 +279,9 @@ subroutine psb_zspmm(alpha,a,x,beta,y,desc_a,info,&
|
||||
|
||||
|
||||
! checking for vectors correctness
|
||||
call psb_chkvect(m,lik,lldx,ix,ijx,desc_a,info,iix,jjx)
|
||||
call psb_chkvect(m,lik,lldx,ix,ijx,desc_a,info,iix,jjx,check_halo=.true.)
|
||||
if (info == psb_success_) &
|
||||
& call psb_chkvect(n,lik,lldy,iy,ijy,desc_a,info,iiy,jjy)
|
||||
& call psb_chkvect(n,lik,lldy,iy,ijy,desc_a,info,iiy,jjy,check_halo=.true.)
|
||||
if(info /= psb_success_) then
|
||||
info=psb_err_from_subroutine_
|
||||
ch_err='psb_chkvect'
|
||||
@@ -545,7 +545,7 @@ subroutine psb_zspmv(alpha,a,x,beta,y,desc_a,info,&
|
||||
end if
|
||||
|
||||
! checking for vectors correctness
|
||||
call psb_chkvect(n,lik,lldx,ix,jx,desc_a,info,iix,jjx)
|
||||
call psb_chkvect(n,lik,lldx,ix,jx,desc_a,info,iix,jjx,check_halo=.true.)
|
||||
if (info == psb_success_) &
|
||||
& call psb_chkvect(m,lik,lldy,iy,jy,desc_a,info,iiy,jjy)
|
||||
if(info /= psb_success_) then
|
||||
@@ -585,9 +585,9 @@ subroutine psb_zspmv(alpha,a,x,beta,y,desc_a,info,&
|
||||
end if
|
||||
|
||||
! checking for vectors correctness
|
||||
call psb_chkvect(m,lik,lldx,ix,jx,desc_a,info,iix,jjx)
|
||||
call psb_chkvect(m,lik,lldx,ix,jx,desc_a,info,iix,jjx,check_halo=.true.)
|
||||
if (info == psb_success_)&
|
||||
& call psb_chkvect(n,lik,lldy,iy,jy,desc_a,info,iiy,jjy)
|
||||
& call psb_chkvect(n,lik,lldy,iy,jy,desc_a,info,iiy,jjy,check_halo=.true.)
|
||||
if(info /= psb_success_) then
|
||||
info=psb_err_from_subroutine_
|
||||
ch_err='psb_chkvect'
|
||||
|
||||
@@ -222,9 +222,9 @@ subroutine psb_zspsm(alpha,a,x,beta,y,desc_a,info,&
|
||||
call psb_chkmat(m,m,ia,ja,desc_a,info,iia,jja)
|
||||
! checking for vectors correctness
|
||||
if (info == psb_success_) &
|
||||
& call psb_chkvect(m,lik,lldx,ix,ijx,desc_a,info,iix,jjx)
|
||||
& call psb_chkvect(m,lik,lldx,ix,ijx,desc_a,info,iix,jjx,check_halo=.true.)
|
||||
if (info == psb_success_) &
|
||||
& call psb_chkvect(m,lik,lldy,iy,ijy,desc_a,info,iiy,jjy)
|
||||
& call psb_chkvect(m,lik,lldy,iy,ijy,desc_a,info,iiy,jjy,check_halo=.true.)
|
||||
if(info /= psb_success_) then
|
||||
info=psb_err_from_subroutine_
|
||||
ch_err='psb_chkvect/mat'
|
||||
@@ -484,9 +484,9 @@ subroutine psb_zspsv(alpha,a,x,beta,y,desc_a,info,&
|
||||
call psb_chkmat(m,m,ia,ja,desc_a,info,iia,jja)
|
||||
! checking for vectors correctness
|
||||
if (info == psb_success_) &
|
||||
& call psb_chkvect(m,lik,lldx,ix,jx,desc_a,info,iix,jjx)
|
||||
& call psb_chkvect(m,lik,lldx,ix,jx,desc_a,info,iix,jjx,check_halo=.true.)
|
||||
if (info == psb_success_) &
|
||||
& call psb_chkvect(m,lik,lldy,iy,jy,desc_a,info,iiy,jjy)
|
||||
& call psb_chkvect(m,lik,lldy,iy,jy,desc_a,info,iiy,jjy,check_halo=.true.)
|
||||
if(info /= psb_success_) then
|
||||
info=psb_err_from_subroutine_
|
||||
ch_err='psb_chkvect/mat'
|
||||
|
||||
Reference in New Issue
Block a user