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

Fixed compilation in base/psblas.

Browse Source
ILmat
Salvatore Filippone 8 years ago
parent 783f44d81e
commit f1db209da3
37 changed files with 509 additions and 437 deletions
Show Stats Download Patch File Download Diff File

2
base/modules/psb_check_mod.f90
Unescape Escape View File

@ -313,7 +313,7 @@ contains
use psb_error_mod
implicit none
integer(psb_ipk_), intent(in) :: m,n,ia,ja
integer(psb_lpk_), intent(in) :: m,n,ia,ja
type(psb_desc_type), intent(in) :: desc_dec
integer(psb_ipk_), intent(out) :: info
integer(psb_ipk_), optional :: iia, jja

25
base/psblas/psb_camax.f90
Unescape Escape View File

@ -57,7 +57,8 @@ function psb_camax(x,desc_a, info, jx) result(res)
! locals
integer(psb_ipk_) :: ictxt, np, me,&
& err_act, iix, jjx, ix, ijx, m, ldx
& err_act, iix, jjx, ldx
integer(psb_lpk_) :: ix, ijx, iy, ijy, m
character(len=20) :: name, ch_err
name='psb_camax'
@ -85,7 +86,7 @@ function psb_camax(x,desc_a, info, jx) result(res)
m = desc_a%get_global_rows()
ldx = size(x,1)
call psb_chkvect(m,ione,ldx,ix,ijx,desc_a,info,iix,jjx)
call psb_chkvect(m,lone,ldx,ix,ijx,desc_a,info,iix,jjx)
if(info /= psb_success_) then
info=psb_err_from_subroutine_
ch_err='psb_chkvect'
@ -174,7 +175,8 @@ function psb_camaxv (x,desc_a, info) result(res)
! locals
integer(psb_ipk_) :: ictxt, np, me,&
& err_act, iix, jjx, jx, ix, m, ldx
& err_act, iix, jjx, ldx
integer(psb_lpk_) :: ix, jx, iy, ijy, m
character(len=20) :: name, ch_err
@ -199,7 +201,7 @@ function psb_camaxv (x,desc_a, info) result(res)
m = desc_a%get_global_rows()
ldx = size(x,1)
call psb_chkvect(m,ione,ldx,ix,jx,desc_a,info,iix,jjx)
call psb_chkvect(m,lone,ldx,ix,jx,desc_a,info,iix,jjx)
if(info /= psb_success_) then
info=psb_err_from_subroutine_
ch_err='psb_chkvect'
@ -248,7 +250,8 @@ function psb_camax_vect(x, desc_a, info) result(res)
! locals
integer(psb_ipk_) :: ictxt, np, me,&
& err_act, iix, jjx, jx, ix, m
& err_act, iix, jjx
integer(psb_lpk_) :: ix, jx, iy, ijy, m
character(len=20) :: name, ch_err
name='psb_camaxv'
@ -275,7 +278,7 @@ function psb_camax_vect(x, desc_a, info) result(res)
jx = 1
m = desc_a%get_global_rows()
call psb_chkvect(m,ione,x%get_nrows(),ix,jx,desc_a,info,iix,jjx)
call psb_chkvect(m,lone,x%get_nrows(),ix,jx,desc_a,info,iix,jjx)
if(info /= psb_success_) then
info=psb_err_from_subroutine_
ch_err='psb_chkvect'
@ -367,7 +370,8 @@ subroutine psb_camaxvs(res,x,desc_a, info)
! locals
integer(psb_ipk_) :: ictxt, np, me,&
& err_act, iix, jjx, ix, ijx, m, ldx
& err_act, iix, jjx, ldx
integer(psb_lpk_) :: ix, ijx, iy, ijy, m
character(len=20) :: name, ch_err
name='psb_camaxvs'
@ -390,7 +394,7 @@ subroutine psb_camaxvs(res,x,desc_a, info)
m = desc_a%get_global_rows()
ldx=size(x,1)
call psb_chkvect(m,ione,ldx,ix,ijx,desc_a,info,iix,jjx)
call psb_chkvect(m,lone,ldx,ix,ijx,desc_a,info,iix,jjx)
if(info /= psb_success_) then
info=psb_err_from_subroutine_
ch_err='psb_chkvect'
@ -479,7 +483,8 @@ subroutine psb_cmamaxs(res,x,desc_a, info,jx)
! locals
integer(psb_ipk_) :: ictxt, np, me,&
& err_act, iix, jjx, ix, ijx, m, ldx, i, k
& err_act, iix, jjx, ldx, i, k
integer(psb_lpk_) :: ix, ijx, iy, ijy, m
character(len=20) :: name, ch_err
name='psb_cmamaxs'
@ -506,7 +511,7 @@ subroutine psb_cmamaxs(res,x,desc_a, info,jx)
m = desc_a%get_global_rows()
k = min(size(x,2),size(res,1))
ldx = size(x,1)
call psb_chkvect(m,ione,ldx,ix,ijx,desc_a,info,iix,jjx)
call psb_chkvect(m,lone,ldx,ix,ijx,desc_a,info,iix,jjx)
if(info /= psb_success_) then
info=psb_err_from_subroutine_
ch_err='psb_chkvect'

20
base/psblas/psb_casum.f90
Unescape Escape View File

@ -57,7 +57,8 @@ function psb_casum (x,desc_a, info, jx) result(res)
! locals
integer(psb_ipk_) :: ictxt, np, me, &
& err_act, iix, jjx, ix, ijx, m, i, idx, ndm, ldx
& err_act, iix, jjx, i, idx, ndm, ldx
integer(psb_lpk_) :: ix, ijx, iy, ijy, m
character(len=20) :: name, ch_err
name='psb_casum'
@ -85,7 +86,7 @@ function psb_casum (x,desc_a, info, jx) result(res)
m = desc_a%get_global_rows()
ldx = size(x,1)
! check vector correctness
call psb_chkvect(m,ione,ldx,ix,ijx,desc_a,info,iix,jjx)
call psb_chkvect(m,lone,ldx,ix,ijx,desc_a,info,iix,jjx)
if(info /= psb_success_) then
info=psb_err_from_subroutine_
ch_err='psb_chkvect'
@ -136,7 +137,8 @@ function psb_casum_vect(x, desc_a, info) result(res)
! locals
integer(psb_ipk_) :: ictxt, np, me,&
& err_act, iix, jjx, jx, ix, m, imax
& err_act, iix, jjx, imax
integer(psb_lpk_) :: ix, jx, iy, ijy, m
character(len=20) :: name, ch_err
name='psb_casumv'
@ -165,7 +167,7 @@ function psb_casum_vect(x, desc_a, info) result(res)
jx = 1
m = desc_a%get_global_rows()
call psb_chkvect(m,ione,x%get_nrows(),ix,jx,desc_a,info,iix,jjx)
call psb_chkvect(m,lone,x%get_nrows(),ix,jx,desc_a,info,iix,jjx)
if(info /= psb_success_) then
info=psb_err_from_subroutine_
ch_err='psb_chkvect'
@ -254,7 +256,8 @@ function psb_casumv(x,desc_a, info) result(res)
! locals
integer(psb_ipk_) :: ictxt, np, me,&
& err_act, iix, jjx, jx, ix, m, i, idx, ndm, ldx
& err_act, iix, jjx, i, idx, ndm, ldx
integer(psb_lpk_) :: ix, jx, iy, ijy, m
character(len=20) :: name, ch_err
name='psb_casumv'
@ -277,7 +280,7 @@ function psb_casumv(x,desc_a, info) result(res)
m = desc_a%get_global_rows()
ldx = size(x,1)
! check vector correctness
call psb_chkvect(m,ione,ldx,ix,jx,desc_a,info,iix,jjx)
call psb_chkvect(m,lone,ldx,ix,jx,desc_a,info,iix,jjx)
if(info /= psb_success_) then
info=psb_err_from_subroutine_
ch_err='psb_chkvect'
@ -374,7 +377,8 @@ subroutine psb_casumvs(res,x,desc_a, info)
! locals
integer(psb_ipk_) :: ictxt, np, me,&
& err_act, iix, jjx, ix, jx, m, i, idx, ndm, ldx
& err_act, iix, jjx, i, idx, ndm, ldx
integer(psb_lpk_) :: ix, jx, iy, ijy, m
character(len=20) :: name, ch_err
name='psb_casumvs'
@ -397,7 +401,7 @@ subroutine psb_casumvs(res,x,desc_a, info)
m = desc_a%get_global_rows()
ldx = size(x,1)
! check vector correctness
call psb_chkvect(m,ione,ldx,ix,jx,desc_a,info,iix,jjx)
call psb_chkvect(m,lone,ldx,ix,jx,desc_a,info,iix,jjx)
if(info /= psb_success_) then
info=psb_err_from_subroutine_
ch_err='psb_chkvect'

23
base/psblas/psb_caxpby.f90
Unescape Escape View File

@ -43,7 +43,8 @@ subroutine psb_caxpby_vect(alpha, x, beta, y,&
! locals
integer(psb_ipk_) :: ictxt, np, me,&
& err_act, iix, jjx, ix, iy, m, iiy, jjy
& err_act, iix, jjx, iiy, jjy
integer(psb_lpk_) :: ix, ijx, iy, ijy, m
character(len=20) :: name, ch_err
name='psb_cgeaxpby'
@ -77,14 +78,14 @@ subroutine psb_caxpby_vect(alpha, x, beta, y,&
m = desc_a%get_global_rows()
! check vector correctness
call psb_chkvect(m,ione,x%get_nrows(),ix,ione,desc_a,info,iix,jjx)
call psb_chkvect(m,lone,x%get_nrows(),ix,lone,desc_a,info,iix,jjx)
if(info /= psb_success_) then
info=psb_err_from_subroutine_
ch_err='psb_chkvect 1'
call psb_errpush(info,name,a_err=ch_err)
goto 9999
end if
call psb_chkvect(m,ione,y%get_nrows(),iy,ione,desc_a,info,iiy,jjy)
call psb_chkvect(m,lone,y%get_nrows(),iy,lone,desc_a,info,iiy,jjy)
if(info /= psb_success_) then
info=psb_err_from_subroutine_
ch_err='psb_chkvect 2'
@ -145,8 +146,8 @@ subroutine psb_caxpby(alpha, x, beta,y,desc_a,info, n, jx, jy)
! locals
integer(psb_ipk_) :: ictxt, np, me,&
& err_act, iix, jjx, ix, iy, ijx, ijy, m, iiy, in, jjy, &
& lldx, lldy
& err_act, iix, jjx, iiy, in, jjy, lldx, lldy
integer(psb_lpk_) :: ix, ijx, iy, ijy, m
character(len=20) :: name, ch_err
name='psb_geaxpby'
@ -197,9 +198,9 @@ subroutine psb_caxpby(alpha, x, beta,y,desc_a,info, n, jx, jy)
lldx = size(x,1)
lldy = size(y,1)
! check vector correctness
call psb_chkvect(m,ione,lldx,ix,ijx,desc_a,info,iix,jjx)
call psb_chkvect(m,lone,lldx,ix,ijx,desc_a,info,iix,jjx)
if (info == psb_success_) &
& call psb_chkvect(m,ione,lldy,iy,ijy,desc_a,info,iiy,jjy)
& call psb_chkvect(m,lone,lldy,iy,ijy,desc_a,info,iiy,jjy)
if(info /= psb_success_) then
info=psb_err_from_subroutine_
ch_err='psb_chkvect'
@ -291,8 +292,8 @@ subroutine psb_caxpbyv(alpha, x, beta,y,desc_a,info)
! locals
integer(psb_ipk_) :: ictxt, np, me,&
& err_act, iix, jjx, ix, iy, m, iiy, jjy, &
& lldx, lldy
& err_act, iix, jjx, iiy, jjy, lldx, lldy
integer(psb_lpk_) :: ix, ijx, iy, ijy, m
character(len=20) :: name, ch_err
logical, parameter :: debug=.false.
@ -317,14 +318,14 @@ subroutine psb_caxpbyv(alpha, x, beta,y,desc_a,info)
lldx = size(x,1)
lldy = size(y,1)
! check vector correctness
call psb_chkvect(m,ione,lldx,ix,ione,desc_a,info,iix,jjx)
call psb_chkvect(m,lone,lldx,ix,lone,desc_a,info,iix,jjx)
if(info /= psb_success_) then
info=psb_err_from_subroutine_
ch_err='psb_chkvect 1'
call psb_errpush(info,name,a_err=ch_err)
goto 9999
end if
call psb_chkvect(m,ione,lldy,iy,ione,desc_a,info,iiy,jjy)
call psb_chkvect(m,lone,lldy,iy,lone,desc_a,info,iiy,jjy)
if(info /= psb_success_) then
info=psb_err_from_subroutine_
ch_err='psb_chkvect 2'

39
base/psblas/psb_cdot.f90
Unescape Escape View File

@ -64,7 +64,8 @@ function psb_cdot_vect(x, y, desc_a,info) result(res)
! locals
integer(psb_ipk_) :: ictxt, np, me, idx, ndm,&
& err_act, iix, jjx, ix, ijx, iy, ijy, iiy, jjy, i, m, nr
& err_act, iix, jjx, iiy, jjy, i, nr
integer(psb_lpk_) :: ix, ijx, iy, ijy, m
character(len=20) :: name, ch_err
name='psb_cdot_vect'
@ -101,9 +102,9 @@ function psb_cdot_vect(x, y, desc_a,info) result(res)
m = desc_a%get_global_rows()
! check vector correctness
call psb_chkvect(m,ione,x%get_nrows(),ix,ijx,desc_a,info,iix,jjx)
call psb_chkvect(m,lone,x%get_nrows(),ix,ijx,desc_a,info,iix,jjx)
if (info == psb_success_) &
& call psb_chkvect(m,ione,y%get_nrows(),iy,ijy,desc_a,info,iiy,jjy)
& call psb_chkvect(m,lone,y%get_nrows(),iy,ijy,desc_a,info,iiy,jjy)
if(info /= psb_success_) then
info=psb_err_from_subroutine_
ch_err='psb_chkvect'
@ -155,8 +156,8 @@ function psb_cdot(x, y,desc_a, info, jx, jy) result(res)
! locals
integer(psb_ipk_) :: ictxt, np, me, idx, ndm,&
& err_act, iix, jjx, ix, ijx, iy, ijy, iiy, jjy, i, m, nr, &
& lldx, lldy
& err_act, iix, jjx, iiy, jjy, i, nr, lldx, lldy
integer(psb_lpk_) :: ix, ijx, iy, ijy, m
complex(psb_spk_) :: cdotc
character(len=20) :: name, ch_err
@ -198,9 +199,9 @@ function psb_cdot(x, y,desc_a, info, jx, jy) result(res)
lldy = size(y,1)
! check vector correctness
call psb_chkvect(m,ione,lldx,ix,ijx,desc_a,info,iix,jjx)
call psb_chkvect(m,lone,lldx,ix,ijx,desc_a,info,iix,jjx)
if (info == psb_success_) &
& call psb_chkvect(m,ione,lldy,iy,ijy,desc_a,info,iiy,jjy)
& call psb_chkvect(m,lone,lldy,iy,ijy,desc_a,info,iiy,jjy)
if(info /= psb_success_) then
info=psb_err_from_subroutine_
ch_err='psb_chkvect'
@ -295,8 +296,8 @@ function psb_cdotv(x, y,desc_a, info) result(res)
! locals
integer(psb_ipk_) :: ictxt, np, me, idx, ndm,&
& err_act, iix, jjx, ix, jx, iy, jy, iiy, jjy, i, m, nr, &
& lldx, lldy
& err_act, iix, jjx, iiy, jjy, i, nr, lldx, lldy
integer(psb_lpk_) :: ix, jx, iy, jy, m
complex(psb_spk_) :: cdotc
character(len=20) :: name, ch_err
@ -322,9 +323,9 @@ function psb_cdotv(x, y,desc_a, info) result(res)
lldx = size(x,1)
lldy = size(y,1)
! check vector correctness
call psb_chkvect(m,ione,lldx,ix,jx,desc_a,info,iix,jjx)
call psb_chkvect(m,lone,lldx,ix,jx,desc_a,info,iix,jjx)
if (info == psb_success_)&
& call psb_chkvect(m,ione,lldy,iy,jy,desc_a,info,iiy,jjy)
& call psb_chkvect(m,lone,lldy,iy,jy,desc_a,info,iiy,jjy)
if(info /= psb_success_) then
info=psb_err_from_subroutine_
ch_err='psb_chkvect'
@ -420,8 +421,8 @@ subroutine psb_cdotvs(res, x, y,desc_a, info)
! locals
integer(psb_ipk_) :: ictxt, np, me, idx, ndm,&
& err_act, iix, jjx, ix, iy, iiy, jjy, i, m,nr, &
& lldx, lldy
& err_act, iix, jjx, iiy, jjy, i,nr, lldx, lldy
integer(psb_lpk_) :: ix, jx, iy, jy, m
complex(psb_spk_) :: cdotc
character(len=20) :: name, ch_err
@ -445,9 +446,9 @@ subroutine psb_cdotvs(res, x, y,desc_a, info)
lldx = size(x,1)
lldy = size(y,1)
! check vector correctness
call psb_chkvect(m,ione,lldx,ix,ix,desc_a,info,iix,jjx)
call psb_chkvect(m,lone,lldx,ix,ix,desc_a,info,iix,jjx)
if (info == psb_success_) &
& call psb_chkvect(m,ione,lldy,iy,iy,desc_a,info,iiy,jjy)
& call psb_chkvect(m,lone,lldy,iy,iy,desc_a,info,iiy,jjy)
if(info /= psb_success_) then
info=psb_err_from_subroutine_
ch_err='psb_chkvect'
@ -543,8 +544,8 @@ subroutine psb_cmdots(res, x, y, desc_a, info)
! locals
integer(psb_ipk_) :: ictxt, np, me, idx, ndm,&
& err_act, iix, jjx, ix, iy, iiy, jjy, i, m, j, k, nr, &
& lldx, lldy
& err_act, iix, jjx, iiy, jjy, i, j, k, nr, lldx, lldy
integer(psb_lpk_) :: ix, ijx, iy, ijy, m
complex(psb_spk_) :: cdotc
character(len=20) :: name, ch_err
@ -570,14 +571,14 @@ subroutine psb_cmdots(res, x, y, desc_a, info)
lldy = size(y,1)
! check vector correctness
call psb_chkvect(m,ione,lldx,ix,ix,desc_a,info,iix,jjx)
call psb_chkvect(m,lone,lldx,ix,ix,desc_a,info,iix,jjx)
if(info /= psb_success_) then
info=psb_err_from_subroutine_
ch_err='psb_chkvect'
call psb_errpush(info,name,a_err=ch_err)
goto 9999
end if
call psb_chkvect(m,ione,lldy,iy,iy,desc_a,info,iiy,jjy)
call psb_chkvect(m,lone,lldy,iy,iy,desc_a,info,iiy,jjy)
if(info /= psb_success_) then
info=psb_err_from_subroutine_
ch_err='psb_chkvect'

28
base/psblas/psb_cnrm2.f90
Unescape Escape View File

@ -59,7 +59,8 @@ function psb_cnrm2(x, desc_a, info, jx) result(res)
! locals
integer(psb_ipk_) :: ictxt, np, me,&
& err_act, iix, jjx, ndim, ix, ijx, i, m, id, idx, ndm, ldx
& err_act, iix, jjx, ndim, i, id, idx, ndm, ldx
integer(psb_lpk_) :: ix, ijx, iy, ijy, m
real(psb_spk_) :: scnrm2, dd
character(len=20) :: name, ch_err
@ -86,7 +87,7 @@ function psb_cnrm2(x, desc_a, info, jx) result(res)
m = desc_a%get_global_rows()
ldx = size(x,1)
call psb_chkvect(m,ione,ldx,ix,ijx,desc_a,info,iix,jjx)
call psb_chkvect(m,lone,ldx,ix,ijx,desc_a,info,iix,jjx)
if(info /= psb_success_) then
info=psb_err_from_subroutine_
ch_err='psb_chkvect'
@ -182,10 +183,10 @@ function psb_cnrm2v(x, desc_a, info) result(res)
! locals
integer(psb_ipk_) :: ictxt, np, me,&
& err_act, iix, jjx, ndim, ix, jx, i, m, id, idx, ndm, ldx
& err_act, iix, jjx, ndim, i, id, idx, ndm, ldx
integer(psb_lpk_) :: ix, jx, iy, ijy, m
real(psb_spk_) :: scnrm2, dd
!!$ external scombnrm2
character(len=20) :: name, ch_err
name='psb_cnrm2v'
@ -206,7 +207,7 @@ function psb_cnrm2v(x, desc_a, info) result(res)
jx=1
m = desc_a%get_global_rows()
ldx = size(x,1)
call psb_chkvect(m,ione,ldx,ix,jx,desc_a,info,iix,jjx)
call psb_chkvect(m,lone,ldx,ix,jx,desc_a,info,iix,jjx)
if(info /= psb_success_) then
info=psb_err_from_subroutine_
ch_err='psb_chkvect'
@ -261,9 +262,9 @@ function psb_cnrm2_vect(x, desc_a, info) result(res)
! locals
integer(psb_ipk_) :: ictxt, np, me,&
& err_act, iix, jjx, ndim, ix, jx, i, m, id, idx, ndm, ldx
& err_act, iix, jjx, ndim, i, id, idx, ndm, ldx
integer(psb_lpk_) :: ix, jx, iy, ijy, m
real(psb_spk_) :: snrm2, dd
!!$ external dcombnrm2
character(len=20) :: name, ch_err
name='psb_cnrm2v'
@ -288,10 +289,10 @@ function psb_cnrm2_vect(x, desc_a, info) result(res)
ix = 1
jx=1
m = desc_a%get_global_rows()
jx = 1
m = desc_a%get_global_rows()
ldx = x%get_nrows()
call psb_chkvect(m,ione,ldx,ix,jx,desc_a,info,iix,jjx)
call psb_chkvect(m,lone,ldx,ix,jx,desc_a,info,iix,jjx)
if(info /= psb_success_) then
info=psb_err_from_subroutine_
ch_err='psb_chkvect'
@ -387,10 +388,9 @@ subroutine psb_cnrm2vs(res, x, desc_a, info)
! locals
integer(psb_ipk_) :: ictxt, np, me,&
& err_act, iix, jjx, ndim, ix, jx, i, m, id, idx, ndm, ldx
& err_act, iix, jjx, ndim, i, id, idx, ndm, ldx
integer(psb_lpk_) :: ix, jx, iy, ijy, m
real(psb_spk_) :: nrm2, scnrm2, dd
!!$ external scombnrm2
character(len=20) :: name, ch_err
name='psb_cnrm2'
@ -411,7 +411,7 @@ subroutine psb_cnrm2vs(res, x, desc_a, info)
jx = 1
m = desc_a%get_global_rows()
ldx = size(x,1)
call psb_chkvect(m,ione,ldx,ix,jx,desc_a,info,iix,jjx)
call psb_chkvect(m,lone,ldx,ix,jx,desc_a,info,iix,jjx)
if(info /= psb_success_) then
info=psb_err_from_subroutine_
ch_err='psb_chkvect'

3
base/psblas/psb_cnrmi.f90
Unescape Escape View File

@ -52,7 +52,8 @@ function psb_cnrmi(a,desc_a,info) result(res)
! locals
integer(psb_ipk_) :: ictxt, np, me,&
& err_act, n, iia, jja, ia, ja, mdim, ndim, m
& err_act, iia, jja, mdim, ndim
integer(psb_lpk_) :: m, n, ia, ja
character(len=20) :: name, ch_err
name='psb_cnrmi'

61
base/psblas/psb_cspmm.f90
Unescape Escape View File

@ -81,9 +81,9 @@ subroutine psb_cspmm(alpha,a,x,beta,y,desc_a,info,&
! locals
integer(psb_ipk_) :: ictxt, np, me,&
& err_act, n, iix, jjx, ia, ja, iia, jja, ix, iy, ik, ijx, ijy,&
& m, nrow, ncol, lldx, lldy, liwork, iiy, jjy,&
& i, ib, ib1, ip, idx
& err_act, iix, jjx, iia, jja, nrow, ncol, lldx, lldy, &
& liwork, iiy, jjy, i, ib, ib1, ip, idx, ik
integer(psb_lpk_) :: ix, ijx, iy, ijy, m, n, ia, ja, lik
integer(psb_ipk_), parameter :: nb=4
complex(psb_spk_), pointer :: xp(:,:), yp(:,:), iwork(:)
complex(psb_spk_), allocatable :: xvsave(:,:)
@ -132,10 +132,10 @@ subroutine psb_cspmm(alpha,a,x,beta,y,desc_a,info,&
endif
if (present(k)) then
ik = min(k,size(x,2)-ijx+1)
ik = min(ik,size(y,2)-ijy+1)
lik = min(k,size(x,2)-ijx+1)
lik = min(lik,size(y,2)-ijy+1)
else
ik = min(size(x,2)-ijx+1,size(y,2)-ijy+1)
lik = min(size(x,2)-ijx+1,size(y,2)-ijy+1)
endif
if (present(trans)) then
@ -205,9 +205,9 @@ subroutine psb_cspmm(alpha,a,x,beta,y,desc_a,info,&
end if
! checking for vectors correctness
call psb_chkvect(n,ik,lldx,ix,ijx,desc_a,info,iix,jjx)
call psb_chkvect(n,lik,lldx,ix,ijx,desc_a,info,iix,jjx)
if (info == psb_success_) &
& call psb_chkvect(m,ik,lldy,iy,ijy,desc_a,info,iiy,jjy)
& call psb_chkvect(m,lik,lldy,iy,ijy,desc_a,info,iiy,jjy)
if(info /= psb_success_) then
info=psb_err_from_subroutine_
ch_err='psb_chkvect'
@ -224,16 +224,16 @@ subroutine psb_cspmm(alpha,a,x,beta,y,desc_a,info,&
if (doswap_.and.(np>1)) then
ib1=min(nb,ik)
ib1=min(nb,lik)
xp => x(iix:lldx,jjx:jjx+ib1-1)
if (doswap_)&
& call psi_swapdata(ior(psb_swap_send_,psb_swap_recv_),&
& ib1,czero,xp,desc_a,iwork,info)
blk: do i=1, ik, nb
blk: do i=1, lik, nb
ib=ib1
ib1 = max(0,min(nb,(ik)-(i-1+ib)))
ib1 = max(0,min(nb,(lik)-(i-1+ib)))
xp => x(iix:lldx,jjx+i-1+ib:jjx+i-1+ib+ib1-1)
if ((ib1 > 0).and.(doswap_)) &
& call psi_swapdata(psb_swap_send_,ib1,&
@ -256,8 +256,8 @@ subroutine psb_cspmm(alpha,a,x,beta,y,desc_a,info,&
else
if (doswap_)&
& call psi_swapdata(ior(psb_swap_send_,psb_swap_recv_),&
& ib1,czero,x(:,1:ik),desc_a,iwork,info)
if (info == psb_success_) call psb_csmm(alpha,a,x(:,1:ik),beta,y(:,1:ik),info)
& ib1,czero,x(:,1:lik),desc_a,iwork,info)
if (info == psb_success_) call psb_csmm(alpha,a,x(:,1:lik),beta,y(:,1:lik),info)
end if
if(info /= psb_success_) then
info = psb_err_from_subroutine_non_
@ -277,9 +277,9 @@ subroutine psb_cspmm(alpha,a,x,beta,y,desc_a,info,&
! checking for vectors correctness
call psb_chkvect(m,ik,lldx,ix,ijx,desc_a,info,iix,jjx)
call psb_chkvect(m,lik,lldx,ix,ijx,desc_a,info,iix,jjx)
if (info == psb_success_) &
& call psb_chkvect(n,ik,lldy,iy,ijy,desc_a,info,iiy,jjy)
& call psb_chkvect(n,lik,lldy,iy,ijy,desc_a,info,iiy,jjy)
if(info /= psb_success_) then
info=psb_err_from_subroutine_
ch_err='psb_chkvect'
@ -300,12 +300,12 @@ subroutine psb_cspmm(alpha,a,x,beta,y,desc_a,info,&
! Why the average? because in this way they will contribute
! with a proper scale factor (1/np) to the overall product.
!
call psi_ovrl_save(x(:,1:ik),xvsave,desc_a,info)
call psi_ovrl_save(x(:,1:lik),xvsave,desc_a,info)
if (info == psb_success_) call psi_ovrl_upd(x,desc_a,psb_avg_,info)
y(nrow+1:ncol,1:ik) = czero
y(nrow+1:ncol,1:lik) = czero
if (info == psb_success_) &
& call psb_csmm(alpha,a,x(:,1:ik),beta,y(:,1:ik),info,trans=trans_)
& call psb_csmm(alpha,a,x(:,1:lik),beta,y(:,1:lik),info,trans=trans_)
if (debug_level >= psb_debug_comp_) &
& write(debug_unit,*) me,' ',trim(name),' csmm ', info
if (info /= psb_success_) then
@ -316,7 +316,9 @@ subroutine psb_cspmm(alpha,a,x,beta,y,desc_a,info,&
end if
if (info == psb_success_) call psi_ovrl_restore(x,xvsave,desc_a,info)
if (doswap_)then
if (doswap_)then
ik = lik ! This should not be an issue, we are expecting the values
! to be small, within IPK
call psi_swaptran(ior(psb_swap_send_,psb_swap_recv_),&
& ik,cone,y(:,1:ik),desc_a,iwork,info)
if (info == psb_success_) call psi_swapdata(ior(psb_swap_send_,psb_swap_recv_),&
@ -428,9 +430,9 @@ subroutine psb_cspmv(alpha,a,x,beta,y,desc_a,info,&
! locals
integer(psb_ipk_) :: ictxt, np, me,&
& err_act, n, iix, jjx, ia, ja, iia, jja, ix, iy, ik, &
& m, nrow, ncol, lldx, lldy, liwork, jx, jy, iiy, jjy,&
& ib, ip, idx
& err_act, iix, jjx, iia, jja, nrow, ncol, lldx, lldy, &
& liwork, iiy, jjy, ib, ip, idx, ik
integer(psb_lpk_) :: ix, ijx, iy, ijy, m, n, ia, ja, lik, jx, jy
integer(psb_ipk_), parameter :: nb=4
complex(psb_spk_), pointer :: iwork(:), xp(:), yp(:)
complex(psb_spk_), allocatable :: xvsave(:)
@ -461,6 +463,7 @@ subroutine psb_cspmv(alpha,a,x,beta,y,desc_a,info,&
iy = 1
jy = 1
ik = 1
lik = 1
ib = 1
if (present(doswap)) then
@ -538,9 +541,9 @@ subroutine psb_cspmv(alpha,a,x,beta,y,desc_a,info,&
end if
! checking for vectors correctness
call psb_chkvect(n,ik,lldx,ix,jx,desc_a,info,iix,jjx)
call psb_chkvect(n,lik,lldx,ix,jx,desc_a,info,iix,jjx)
if (info == psb_success_) &
& call psb_chkvect(m,ik,lldy,iy,jy,desc_a,info,iiy,jjy)
& call psb_chkvect(m,lik,lldy,iy,jy,desc_a,info,iiy,jjy)
if(info /= psb_success_) then
info=psb_err_from_subroutine_
ch_err='psb_chkvect'
@ -578,9 +581,9 @@ subroutine psb_cspmv(alpha,a,x,beta,y,desc_a,info,&
end if
! checking for vectors correctness
call psb_chkvect(m,ik,lldx,ix,jx,desc_a,info,iix,jjx)
call psb_chkvect(m,lik,lldx,ix,jx,desc_a,info,iix,jjx)
if (info == psb_success_)&
& call psb_chkvect(n,ik,lldy,iy,jy,desc_a,info,iiy,jjy)
& call psb_chkvect(n,lik,lldy,iy,jy,desc_a,info,iiy,jjy)
if(info /= psb_success_) then
info=psb_err_from_subroutine_
ch_err='psb_chkvect'
@ -684,9 +687,9 @@ subroutine psb_cspmv_vect(alpha,a,x,beta,y,desc_a,info,&
! locals
integer(psb_ipk_) :: ictxt, np, me,&
& err_act, n, iix, jjx, ia, ja, iia, jja, ix, iy, ik, &
& m, nrow, ncol, lldx, lldy, liwork, jx, jy, iiy, jjy,&
& ib, ip, idx
& err_act, iix, jjx, iia, jja, nrow, ncol, lldx, lldy, &
& liwork, iiy, jjy, ib, ip, idx
integer(psb_lpk_) :: ix, ijx, iy, ijy, m, n, ia, ja
integer(psb_ipk_), parameter :: nb=4
complex(psb_spk_), pointer :: iwork(:), xp(:), yp(:)
complex(psb_spk_), allocatable :: xvsave(:)

3
base/psblas/psb_cspnrm1.f90
Unescape Escape View File

@ -52,7 +52,8 @@ function psb_cspnrm1(a,desc_a,info) result(res)
! locals
integer(psb_ipk_) :: ictxt, np, me, nr,nc,&
& err_act, n, iia, jja, ia, ja, mdim, ndim, m
& err_act, iia, jja, mdim, ndim
integer(psb_lpk_) :: ix, ijx, iy, ijy, m, n, ia, ja
character(len=20) :: name, ch_err
real(psb_spk_), allocatable :: v(:)

34
base/psblas/psb_cspsm.f90
Unescape Escape View File

@ -93,10 +93,10 @@ subroutine psb_cspsm(alpha,a,x,beta,y,desc_a,info,&
! locals
integer(psb_ipk_) :: ictxt, np, me,&
& err_act, iix, jjx, ia, ja, iia, jja, lldx,lldy, choice_,&
& ix, iy, ik, ijx, ijy, i, lld,&
& m, nrow, ncol, liwork, llwork, iiy, jjy, idx, ndm
& err_act, iix, jjx, iia, jja, lldx,lldy, choice_,&
& ik, i, lld, nrow, ncol, liwork, llwork, iiy, jjy, idx, ndm
integer(psb_lpk_) :: ix, ijx, iy, ijy, m, n, ia, ja, lik
character :: lscale
integer(psb_ipk_), parameter :: nb=4
complex(psb_spk_),pointer :: iwork(:), xp(:,:), yp(:,:), id(:)
@ -137,10 +137,10 @@ subroutine psb_cspsm(alpha,a,x,beta,y,desc_a,info,&
endif
if (present(k)) then
ik = min(k,size(x,2)-ijx+1)
ik = min(ik,size(y,2)-ijy+1)
lik = min(k,size(x,2)-ijx+1)
lik = min(lik,size(y,2)-ijy+1)
else
ik = min(size(x,2)-ijx+1,size(y,2)-ijy+1)
lik = min(size(x,2)-ijx+1,size(y,2)-ijy+1)
endif
if (present(choice)) then
@ -220,9 +220,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,ik,lldx,ix,ijx,desc_a,info,iix,jjx)
& call psb_chkvect(m,lik,lldx,ix,ijx,desc_a,info,iix,jjx)
if (info == psb_success_) &
& call psb_chkvect(m,ik,lldy,iy,ijy,desc_a,info,iiy,jjy)
& call psb_chkvect(m,lik,lldy,iy,ijy,desc_a,info,iiy,jjy)
if(info /= psb_success_) then
info=psb_err_from_subroutine_
ch_err='psb_chkvect/mat'
@ -245,6 +245,8 @@ subroutine psb_cspsm(alpha,a,x,beta,y,desc_a,info,&
goto 9999
end if
ik = lik ! This should not be a problem.
! We expect ik to be small, well within IPK
! Perform local triangular system solve
xp => x(iix:lldx,jjx:jjx+ik-1)
yp => y(iiy:lldy,jjy:jjy+ik-1)
@ -259,7 +261,6 @@ subroutine psb_cspsm(alpha,a,x,beta,y,desc_a,info,&
! update overlap elements
if (choice_ > 0) then
call psi_swapdata(ior(psb_swap_send_,psb_swap_recv_),ik,&
& cone,yp,desc_a,iwork,info,data=psb_comm_ovr_)
@ -366,9 +367,9 @@ subroutine psb_cspsv(alpha,a,x,beta,y,desc_a,info,&
! locals
integer(psb_ipk_) :: ictxt, np, me, &
& err_act, iix, jjx, ia, ja, iia, jja, lldx,lldy, choice_,&
& ix, iy, ik, jx, jy, i, lld,&
& m, nrow, ncol, liwork, llwork, iiy, jjy, idx, ndm
& err_act, iix, jjx, iia, jja, lldx,lldy, choice_,&
& ik, i, lld, nrow, ncol, liwork, llwork, iiy, jjy, idx, ndm
integer(psb_lpk_) :: ix, ijx, iy, ijy, m, n, ia, ja, lik, jx, jy
character :: lscale
integer(psb_ipk_), parameter :: nb=4
@ -396,9 +397,10 @@ subroutine psb_cspsv(alpha,a,x,beta,y,desc_a,info,&
ja = 1
ix = 1
iy = 1
lik = 1
ik = 1
jx= 1
jy= 1
jx = 1
jy = 1
if (present(choice)) then
choice_ = choice
@ -478,9 +480,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,ik,lldx,ix,jx,desc_a,info,iix,jjx)
& call psb_chkvect(m,lik,lldx,ix,jx,desc_a,info,iix,jjx)
if (info == psb_success_) &
& call psb_chkvect(m,ik,lldy,iy,jy,desc_a,info,iiy,jjy)
& call psb_chkvect(m,lik,lldy,iy,jy,desc_a,info,iiy,jjy)
if(info /= psb_success_) then
info=psb_err_from_subroutine_
ch_err='psb_chkvect/mat'

25
base/psblas/psb_damax.f90
Unescape Escape View File

@ -57,7 +57,8 @@ function psb_damax(x,desc_a, info, jx) result(res)
! locals
integer(psb_ipk_) :: ictxt, np, me,&
& err_act, iix, jjx, ix, ijx, m, ldx
& err_act, iix, jjx, ldx
integer(psb_lpk_) :: ix, ijx, iy, ijy, m
character(len=20) :: name, ch_err
name='psb_damax'
@ -85,7 +86,7 @@ function psb_damax(x,desc_a, info, jx) result(res)
m = desc_a%get_global_rows()
ldx = size(x,1)
call psb_chkvect(m,ione,ldx,ix,ijx,desc_a,info,iix,jjx)
call psb_chkvect(m,lone,ldx,ix,ijx,desc_a,info,iix,jjx)
if(info /= psb_success_) then
info=psb_err_from_subroutine_
ch_err='psb_chkvect'
@ -174,7 +175,8 @@ function psb_damaxv (x,desc_a, info) result(res)
! locals
integer(psb_ipk_) :: ictxt, np, me,&
& err_act, iix, jjx, jx, ix, m, ldx
& err_act, iix, jjx, ldx
integer(psb_lpk_) :: ix, jx, iy, ijy, m
character(len=20) :: name, ch_err
@ -199,7 +201,7 @@ function psb_damaxv (x,desc_a, info) result(res)
m = desc_a%get_global_rows()
ldx = size(x,1)
call psb_chkvect(m,ione,ldx,ix,jx,desc_a,info,iix,jjx)
call psb_chkvect(m,lone,ldx,ix,jx,desc_a,info,iix,jjx)
if(info /= psb_success_) then
info=psb_err_from_subroutine_
ch_err='psb_chkvect'
@ -248,7 +250,8 @@ function psb_damax_vect(x, desc_a, info) result(res)
! locals
integer(psb_ipk_) :: ictxt, np, me,&
& err_act, iix, jjx, jx, ix, m
& err_act, iix, jjx
integer(psb_lpk_) :: ix, jx, iy, ijy, m
character(len=20) :: name, ch_err
name='psb_damaxv'
@ -275,7 +278,7 @@ function psb_damax_vect(x, desc_a, info) result(res)
jx = 1
m = desc_a%get_global_rows()
call psb_chkvect(m,ione,x%get_nrows(),ix,jx,desc_a,info,iix,jjx)
call psb_chkvect(m,lone,x%get_nrows(),ix,jx,desc_a,info,iix,jjx)
if(info /= psb_success_) then
info=psb_err_from_subroutine_
ch_err='psb_chkvect'
@ -367,7 +370,8 @@ subroutine psb_damaxvs(res,x,desc_a, info)
! locals
integer(psb_ipk_) :: ictxt, np, me,&
& err_act, iix, jjx, ix, ijx, m, ldx
& err_act, iix, jjx, ldx
integer(psb_lpk_) :: ix, ijx, iy, ijy, m
character(len=20) :: name, ch_err
name='psb_damaxvs'
@ -390,7 +394,7 @@ subroutine psb_damaxvs(res,x,desc_a, info)
m = desc_a%get_global_rows()
ldx=size(x,1)
call psb_chkvect(m,ione,ldx,ix,ijx,desc_a,info,iix,jjx)
call psb_chkvect(m,lone,ldx,ix,ijx,desc_a,info,iix,jjx)
if(info /= psb_success_) then
info=psb_err_from_subroutine_
ch_err='psb_chkvect'
@ -479,7 +483,8 @@ subroutine psb_dmamaxs(res,x,desc_a, info,jx)
! locals
integer(psb_ipk_) :: ictxt, np, me,&
& err_act, iix, jjx, ix, ijx, m, ldx, i, k
& err_act, iix, jjx, ldx, i, k
integer(psb_lpk_) :: ix, ijx, iy, ijy, m
character(len=20) :: name, ch_err
name='psb_dmamaxs'
@ -506,7 +511,7 @@ subroutine psb_dmamaxs(res,x,desc_a, info,jx)
m = desc_a%get_global_rows()
k = min(size(x,2),size(res,1))
ldx = size(x,1)
call psb_chkvect(m,ione,ldx,ix,ijx,desc_a,info,iix,jjx)
call psb_chkvect(m,lone,ldx,ix,ijx,desc_a,info,iix,jjx)
if(info /= psb_success_) then
info=psb_err_from_subroutine_
ch_err='psb_chkvect'

20
base/psblas/psb_dasum.f90
Unescape Escape View File

@ -57,7 +57,8 @@ function psb_dasum (x,desc_a, info, jx) result(res)
! locals
integer(psb_ipk_) :: ictxt, np, me, &
& err_act, iix, jjx, ix, ijx, m, i, idx, ndm, ldx
& err_act, iix, jjx, i, idx, ndm, ldx
integer(psb_lpk_) :: ix, ijx, iy, ijy, m
character(len=20) :: name, ch_err
name='psb_dasum'
@ -85,7 +86,7 @@ function psb_dasum (x,desc_a, info, jx) result(res)
m = desc_a%get_global_rows()
ldx = size(x,1)
! check vector correctness
call psb_chkvect(m,ione,ldx,ix,ijx,desc_a,info,iix,jjx)
call psb_chkvect(m,lone,ldx,ix,ijx,desc_a,info,iix,jjx)
if(info /= psb_success_) then
info=psb_err_from_subroutine_
ch_err='psb_chkvect'
@ -136,7 +137,8 @@ function psb_dasum_vect(x, desc_a, info) result(res)
! locals
integer(psb_ipk_) :: ictxt, np, me,&
& err_act, iix, jjx, jx, ix, m, imax
& err_act, iix, jjx, imax
integer(psb_lpk_) :: ix, jx, iy, ijy, m
character(len=20) :: name, ch_err
name='psb_dasumv'
@ -165,7 +167,7 @@ function psb_dasum_vect(x, desc_a, info) result(res)
jx = 1
m = desc_a%get_global_rows()
call psb_chkvect(m,ione,x%get_nrows(),ix,jx,desc_a,info,iix,jjx)
call psb_chkvect(m,lone,x%get_nrows(),ix,jx,desc_a,info,iix,jjx)
if(info /= psb_success_) then
info=psb_err_from_subroutine_
ch_err='psb_chkvect'
@ -254,7 +256,8 @@ function psb_dasumv(x,desc_a, info) result(res)
! locals
integer(psb_ipk_) :: ictxt, np, me,&
& err_act, iix, jjx, jx, ix, m, i, idx, ndm, ldx
& err_act, iix, jjx, i, idx, ndm, ldx
integer(psb_lpk_) :: ix, jx, iy, ijy, m
character(len=20) :: name, ch_err
name='psb_dasumv'
@ -277,7 +280,7 @@ function psb_dasumv(x,desc_a, info) result(res)
m = desc_a%get_global_rows()
ldx = size(x,1)
! check vector correctness
call psb_chkvect(m,ione,ldx,ix,jx,desc_a,info,iix,jjx)
call psb_chkvect(m,lone,ldx,ix,jx,desc_a,info,iix,jjx)
if(info /= psb_success_) then
info=psb_err_from_subroutine_
ch_err='psb_chkvect'
@ -374,7 +377,8 @@ subroutine psb_dasumvs(res,x,desc_a, info)
! locals
integer(psb_ipk_) :: ictxt, np, me,&
& err_act, iix, jjx, ix, jx, m, i, idx, ndm, ldx
& err_act, iix, jjx, i, idx, ndm, ldx
integer(psb_lpk_) :: ix, jx, iy, ijy, m
character(len=20) :: name, ch_err
name='psb_dasumvs'
@ -397,7 +401,7 @@ subroutine psb_dasumvs(res,x,desc_a, info)
m = desc_a%get_global_rows()
ldx = size(x,1)
! check vector correctness
call psb_chkvect(m,ione,ldx,ix,jx,desc_a,info,iix,jjx)
call psb_chkvect(m,lone,ldx,ix,jx,desc_a,info,iix,jjx)
if(info /= psb_success_) then
info=psb_err_from_subroutine_
ch_err='psb_chkvect'

23
base/psblas/psb_daxpby.f90
Unescape Escape View File

@ -43,7 +43,8 @@ subroutine psb_daxpby_vect(alpha, x, beta, y,&
! locals
integer(psb_ipk_) :: ictxt, np, me,&
& err_act, iix, jjx, ix, iy, m, iiy, jjy
& err_act, iix, jjx, iiy, jjy
integer(psb_lpk_) :: ix, ijx, iy, ijy, m
character(len=20) :: name, ch_err
name='psb_dgeaxpby'
@ -77,14 +78,14 @@ subroutine psb_daxpby_vect(alpha, x, beta, y,&
m = desc_a%get_global_rows()
! check vector correctness
call psb_chkvect(m,ione,x%get_nrows(),ix,ione,desc_a,info,iix,jjx)
call psb_chkvect(m,lone,x%get_nrows(),ix,lone,desc_a,info,iix,jjx)
if(info /= psb_success_) then
info=psb_err_from_subroutine_
ch_err='psb_chkvect 1'
call psb_errpush(info,name,a_err=ch_err)
goto 9999
end if
call psb_chkvect(m,ione,y%get_nrows(),iy,ione,desc_a,info,iiy,jjy)
call psb_chkvect(m,lone,y%get_nrows(),iy,lone,desc_a,info,iiy,jjy)
if(info /= psb_success_) then
info=psb_err_from_subroutine_
ch_err='psb_chkvect 2'
@ -145,8 +146,8 @@ subroutine psb_daxpby(alpha, x, beta,y,desc_a,info, n, jx, jy)
! locals
integer(psb_ipk_) :: ictxt, np, me,&
& err_act, iix, jjx, ix, iy, ijx, ijy, m, iiy, in, jjy, &
& lldx, lldy
& err_act, iix, jjx, iiy, in, jjy, lldx, lldy
integer(psb_lpk_) :: ix, ijx, iy, ijy, m
character(len=20) :: name, ch_err
name='psb_geaxpby'
@ -197,9 +198,9 @@ subroutine psb_daxpby(alpha, x, beta,y,desc_a,info, n, jx, jy)
lldx = size(x,1)
lldy = size(y,1)
! check vector correctness
call psb_chkvect(m,ione,lldx,ix,ijx,desc_a,info,iix,jjx)
call psb_chkvect(m,lone,lldx,ix,ijx,desc_a,info,iix,jjx)
if (info == psb_success_) &
& call psb_chkvect(m,ione,lldy,iy,ijy,desc_a,info,iiy,jjy)
& call psb_chkvect(m,lone,lldy,iy,ijy,desc_a,info,iiy,jjy)
if(info /= psb_success_) then
info=psb_err_from_subroutine_
ch_err='psb_chkvect'
@ -291,8 +292,8 @@ subroutine psb_daxpbyv(alpha, x, beta,y,desc_a,info)
! locals
integer(psb_ipk_) :: ictxt, np, me,&
& err_act, iix, jjx, ix, iy, m, iiy, jjy, &
& lldx, lldy
& err_act, iix, jjx, iiy, jjy, lldx, lldy
integer(psb_lpk_) :: ix, ijx, iy, ijy, m
character(len=20) :: name, ch_err
logical, parameter :: debug=.false.
@ -317,14 +318,14 @@ subroutine psb_daxpbyv(alpha, x, beta,y,desc_a,info)
lldx = size(x,1)
lldy = size(y,1)
! check vector correctness
call psb_chkvect(m,ione,lldx,ix,ione,desc_a,info,iix,jjx)
call psb_chkvect(m,lone,lldx,ix,lone,desc_a,info,iix,jjx)
if(info /= psb_success_) then
info=psb_err_from_subroutine_
ch_err='psb_chkvect 1'
call psb_errpush(info,name,a_err=ch_err)
goto 9999
end if
call psb_chkvect(m,ione,lldy,iy,ione,desc_a,info,iiy,jjy)
call psb_chkvect(m,lone,lldy,iy,lone,desc_a,info,iiy,jjy)
if(info /= psb_success_) then
info=psb_err_from_subroutine_
ch_err='psb_chkvect 2'

39
base/psblas/psb_ddot.f90
Unescape Escape View File

@ -64,7 +64,8 @@ function psb_ddot_vect(x, y, desc_a,info) result(res)
! locals
integer(psb_ipk_) :: ictxt, np, me, idx, ndm,&
& err_act, iix, jjx, ix, ijx, iy, ijy, iiy, jjy, i, m, nr
& err_act, iix, jjx, iiy, jjy, i, nr
integer(psb_lpk_) :: ix, ijx, iy, ijy, m
character(len=20) :: name, ch_err
name='psb_ddot_vect'
@ -101,9 +102,9 @@ function psb_ddot_vect(x, y, desc_a,info) result(res)
m = desc_a%get_global_rows()
! check vector correctness
call psb_chkvect(m,ione,x%get_nrows(),ix,ijx,desc_a,info,iix,jjx)
call psb_chkvect(m,lone,x%get_nrows(),ix,ijx,desc_a,info,iix,jjx)
if (info == psb_success_) &
& call psb_chkvect(m,ione,y%get_nrows(),iy,ijy,desc_a,info,iiy,jjy)
& call psb_chkvect(m,lone,y%get_nrows(),iy,ijy,desc_a,info,iiy,jjy)
if(info /= psb_success_) then
info=psb_err_from_subroutine_
ch_err='psb_chkvect'
@ -155,8 +156,8 @@ function psb_ddot(x, y,desc_a, info, jx, jy) result(res)
! locals
integer(psb_ipk_) :: ictxt, np, me, idx, ndm,&
& err_act, iix, jjx, ix, ijx, iy, ijy, iiy, jjy, i, m, nr, &
& lldx, lldy
& err_act, iix, jjx, iiy, jjy, i, nr, lldx, lldy
integer(psb_lpk_) :: ix, ijx, iy, ijy, m
real(psb_dpk_) :: ddot
character(len=20) :: name, ch_err
@ -198,9 +199,9 @@ function psb_ddot(x, y,desc_a, info, jx, jy) result(res)
lldy = size(y,1)
! check vector correctness
call psb_chkvect(m,ione,lldx,ix,ijx,desc_a,info,iix,jjx)
call psb_chkvect(m,lone,lldx,ix,ijx,desc_a,info,iix,jjx)
if (info == psb_success_) &
& call psb_chkvect(m,ione,lldy,iy,ijy,desc_a,info,iiy,jjy)
& call psb_chkvect(m,lone,lldy,iy,ijy,desc_a,info,iiy,jjy)
if(info /= psb_success_) then
info=psb_err_from_subroutine_
ch_err='psb_chkvect'
@ -295,8 +296,8 @@ function psb_ddotv(x, y,desc_a, info) result(res)
! locals
integer(psb_ipk_) :: ictxt, np, me, idx, ndm,&
& err_act, iix, jjx, ix, jx, iy, jy, iiy, jjy, i, m, nr, &
& lldx, lldy
& err_act, iix, jjx, iiy, jjy, i, nr, lldx, lldy
integer(psb_lpk_) :: ix, jx, iy, jy, m
real(psb_dpk_) :: ddot
character(len=20) :: name, ch_err
@ -322,9 +323,9 @@ function psb_ddotv(x, y,desc_a, info) result(res)
lldx = size(x,1)
lldy = size(y,1)
! check vector correctness
call psb_chkvect(m,ione,lldx,ix,jx,desc_a,info,iix,jjx)
call psb_chkvect(m,lone,lldx,ix,jx,desc_a,info,iix,jjx)
if (info == psb_success_)&
& call psb_chkvect(m,ione,lldy,iy,jy,desc_a,info,iiy,jjy)
& call psb_chkvect(m,lone,lldy,iy,jy,desc_a,info,iiy,jjy)
if(info /= psb_success_) then
info=psb_err_from_subroutine_
ch_err='psb_chkvect'
@ -420,8 +421,8 @@ subroutine psb_ddotvs(res, x, y,desc_a, info)
! locals
integer(psb_ipk_) :: ictxt, np, me, idx, ndm,&
& err_act, iix, jjx, ix, iy, iiy, jjy, i, m,nr, &
& lldx, lldy
& err_act, iix, jjx, iiy, jjy, i,nr, lldx, lldy
integer(psb_lpk_) :: ix, jx, iy, jy, m
real(psb_dpk_) :: ddot
character(len=20) :: name, ch_err
@ -445,9 +446,9 @@ subroutine psb_ddotvs(res, x, y,desc_a, info)
lldx = size(x,1)
lldy = size(y,1)
! check vector correctness
call psb_chkvect(m,ione,lldx,ix,ix,desc_a,info,iix,jjx)
call psb_chkvect(m,lone,lldx,ix,ix,desc_a,info,iix,jjx)
if (info == psb_success_) &
& call psb_chkvect(m,ione,lldy,iy,iy,desc_a,info,iiy,jjy)
& call psb_chkvect(m,lone,lldy,iy,iy,desc_a,info,iiy,jjy)
if(info /= psb_success_) then
info=psb_err_from_subroutine_
ch_err='psb_chkvect'
@ -543,8 +544,8 @@ subroutine psb_dmdots(res, x, y, desc_a, info)
! locals
integer(psb_ipk_) :: ictxt, np, me, idx, ndm,&
& err_act, iix, jjx, ix, iy, iiy, jjy, i, m, j, k, nr, &
& lldx, lldy
& err_act, iix, jjx, iiy, jjy, i, j, k, nr, lldx, lldy
integer(psb_lpk_) :: ix, ijx, iy, ijy, m
real(psb_dpk_) :: ddot
character(len=20) :: name, ch_err
@ -570,14 +571,14 @@ subroutine psb_dmdots(res, x, y, desc_a, info)
lldy = size(y,1)
! check vector correctness
call psb_chkvect(m,ione,lldx,ix,ix,desc_a,info,iix,jjx)
call psb_chkvect(m,lone,lldx,ix,ix,desc_a,info,iix,jjx)
if(info /= psb_success_) then
info=psb_err_from_subroutine_
ch_err='psb_chkvect'
call psb_errpush(info,name,a_err=ch_err)
goto 9999
end if
call psb_chkvect(m,ione,lldy,iy,iy,desc_a,info,iiy,jjy)
call psb_chkvect(m,lone,lldy,iy,iy,desc_a,info,iiy,jjy)
if(info /= psb_success_) then
info=psb_err_from_subroutine_
ch_err='psb_chkvect'

28
base/psblas/psb_dnrm2.f90
Unescape Escape View File

@ -59,7 +59,8 @@ function psb_dnrm2(x, desc_a, info, jx) result(res)
! locals
integer(psb_ipk_) :: ictxt, np, me,&
& err_act, iix, jjx, ndim, ix, ijx, i, m, id, idx, ndm, ldx
& err_act, iix, jjx, ndim, i, id, idx, ndm, ldx
integer(psb_lpk_) :: ix, ijx, iy, ijy, m
real(psb_dpk_) :: dnrm2, dd
character(len=20) :: name, ch_err
@ -86,7 +87,7 @@ function psb_dnrm2(x, desc_a, info, jx) result(res)
m = desc_a%get_global_rows()
ldx = size(x,1)
call psb_chkvect(m,ione,ldx,ix,ijx,desc_a,info,iix,jjx)
call psb_chkvect(m,lone,ldx,ix,ijx,desc_a,info,iix,jjx)
if(info /= psb_success_) then
info=psb_err_from_subroutine_
ch_err='psb_chkvect'
@ -182,10 +183,10 @@ function psb_dnrm2v(x, desc_a, info) result(res)
! locals
integer(psb_ipk_) :: ictxt, np, me,&
& err_act, iix, jjx, ndim, ix, jx, i, m, id, idx, ndm, ldx
& err_act, iix, jjx, ndim, i, id, idx, ndm, ldx
integer(psb_lpk_) :: ix, jx, iy, ijy, m
real(psb_dpk_) :: dnrm2, dd
!!$ external scombnrm2
character(len=20) :: name, ch_err
name='psb_dnrm2v'
@ -206,7 +207,7 @@ function psb_dnrm2v(x, desc_a, info) result(res)
jx=1
m = desc_a%get_global_rows()
ldx = size(x,1)
call psb_chkvect(m,ione,ldx,ix,jx,desc_a,info,iix,jjx)
call psb_chkvect(m,lone,ldx,ix,jx,desc_a,info,iix,jjx)
if(info /= psb_success_) then
info=psb_err_from_subroutine_
ch_err='psb_chkvect'
@ -261,9 +262,9 @@ function psb_dnrm2_vect(x, desc_a, info) result(res)
! locals
integer(psb_ipk_) :: ictxt, np, me,&
& err_act, iix, jjx, ndim, ix, jx, i, m, id, idx, ndm, ldx
& err_act, iix, jjx, ndim, i, id, idx, ndm, ldx
integer(psb_lpk_) :: ix, jx, iy, ijy, m
real(psb_dpk_) :: snrm2, dd
!!$ external dcombnrm2
character(len=20) :: name, ch_err
name='psb_dnrm2v'
@ -288,10 +289,10 @@ function psb_dnrm2_vect(x, desc_a, info) result(res)
ix = 1
jx=1
m = desc_a%get_global_rows()
jx = 1
m = desc_a%get_global_rows()
ldx = x%get_nrows()
call psb_chkvect(m,ione,ldx,ix,jx,desc_a,info,iix,jjx)
call psb_chkvect(m,lone,ldx,ix,jx,desc_a,info,iix,jjx)
if(info /= psb_success_) then
info=psb_err_from_subroutine_
ch_err='psb_chkvect'
@ -387,10 +388,9 @@ subroutine psb_dnrm2vs(res, x, desc_a, info)
! locals
integer(psb_ipk_) :: ictxt, np, me,&
& err_act, iix, jjx, ndim, ix, jx, i, m, id, idx, ndm, ldx
& err_act, iix, jjx, ndim, i, id, idx, ndm, ldx
integer(psb_lpk_) :: ix, jx, iy, ijy, m
real(psb_dpk_) :: nrm2, dnrm2, dd
!!$ external scombnrm2
character(len=20) :: name, ch_err
name='psb_dnrm2'
@ -411,7 +411,7 @@ subroutine psb_dnrm2vs(res, x, desc_a, info)
jx = 1
m = desc_a%get_global_rows()
ldx = size(x,1)
call psb_chkvect(m,ione,ldx,ix,jx,desc_a,info,iix,jjx)
call psb_chkvect(m,lone,ldx,ix,jx,desc_a,info,iix,jjx)
if(info /= psb_success_) then
info=psb_err_from_subroutine_
ch_err='psb_chkvect'

3
base/psblas/psb_dnrmi.f90
Unescape Escape View File

@ -52,7 +52,8 @@ function psb_dnrmi(a,desc_a,info) result(res)
! locals
integer(psb_ipk_) :: ictxt, np, me,&
& err_act, n, iia, jja, ia, ja, mdim, ndim, m
& err_act, iia, jja, mdim, ndim
integer(psb_lpk_) :: m, n, ia, ja
character(len=20) :: name, ch_err
name='psb_dnrmi'

61
base/psblas/psb_dspmm.f90
Unescape Escape View File

@ -81,9 +81,9 @@ subroutine psb_dspmm(alpha,a,x,beta,y,desc_a,info,&
! locals
integer(psb_ipk_) :: ictxt, np, me,&
& err_act, n, iix, jjx, ia, ja, iia, jja, ix, iy, ik, ijx, ijy,&
& m, nrow, ncol, lldx, lldy, liwork, iiy, jjy,&
& i, ib, ib1, ip, idx
& err_act, iix, jjx, iia, jja, nrow, ncol, lldx, lldy, &
& liwork, iiy, jjy, i, ib, ib1, ip, idx, ik
integer(psb_lpk_) :: ix, ijx, iy, ijy, m, n, ia, ja, lik
integer(psb_ipk_), parameter :: nb=4
real(psb_dpk_), pointer :: xp(:,:), yp(:,:), iwork(:)
real(psb_dpk_), allocatable :: xvsave(:,:)
@ -132,10 +132,10 @@ subroutine psb_dspmm(alpha,a,x,beta,y,desc_a,info,&
endif
if (present(k)) then
ik = min(k,size(x,2)-ijx+1)
ik = min(ik,size(y,2)-ijy+1)
lik = min(k,size(x,2)-ijx+1)
lik = min(lik,size(y,2)-ijy+1)
else
ik = min(size(x,2)-ijx+1,size(y,2)-ijy+1)
lik = min(size(x,2)-ijx+1,size(y,2)-ijy+1)
endif
if (present(trans)) then
@ -205,9 +205,9 @@ subroutine psb_dspmm(alpha,a,x,beta,y,desc_a,info,&
end if
! checking for vectors correctness
call psb_chkvect(n,ik,lldx,ix,ijx,desc_a,info,iix,jjx)
call psb_chkvect(n,lik,lldx,ix,ijx,desc_a,info,iix,jjx)
if (info == psb_success_) &
& call psb_chkvect(m,ik,lldy,iy,ijy,desc_a,info,iiy,jjy)
& call psb_chkvect(m,lik,lldy,iy,ijy,desc_a,info,iiy,jjy)
if(info /= psb_success_) then
info=psb_err_from_subroutine_
ch_err='psb_chkvect'
@ -224,16 +224,16 @@ subroutine psb_dspmm(alpha,a,x,beta,y,desc_a,info,&
if (doswap_.and.(np>1)) then
ib1=min(nb,ik)
ib1=min(nb,lik)
xp => x(iix:lldx,jjx:jjx+ib1-1)
if (doswap_)&
& call psi_swapdata(ior(psb_swap_send_,psb_swap_recv_),&
& ib1,dzero,xp,desc_a,iwork,info)
blk: do i=1, ik, nb
blk: do i=1, lik, nb
ib=ib1
ib1 = max(0,min(nb,(ik)-(i-1+ib)))
ib1 = max(0,min(nb,(lik)-(i-1+ib)))
xp => x(iix:lldx,jjx+i-1+ib:jjx+i-1+ib+ib1-1)
if ((ib1 > 0).and.(doswap_)) &
& call psi_swapdata(psb_swap_send_,ib1,&
@ -256,8 +256,8 @@ subroutine psb_dspmm(alpha,a,x,beta,y,desc_a,info,&
else
if (doswap_)&
& call psi_swapdata(ior(psb_swap_send_,psb_swap_recv_),&
& ib1,dzero,x(:,1:ik),desc_a,iwork,info)
if (info == psb_success_) call psb_csmm(alpha,a,x(:,1:ik),beta,y(:,1:ik),info)
& ib1,dzero,x(:,1:lik),desc_a,iwork,info)
if (info == psb_success_) call psb_csmm(alpha,a,x(:,1:lik),beta,y(:,1:lik),info)
end if
if(info /= psb_success_) then
info = psb_err_from_subroutine_non_
@ -277,9 +277,9 @@ subroutine psb_dspmm(alpha,a,x,beta,y,desc_a,info,&
! checking for vectors correctness
call psb_chkvect(m,ik,lldx,ix,ijx,desc_a,info,iix,jjx)
call psb_chkvect(m,lik,lldx,ix,ijx,desc_a,info,iix,jjx)
if (info == psb_success_) &
& call psb_chkvect(n,ik,lldy,iy,ijy,desc_a,info,iiy,jjy)
& call psb_chkvect(n,lik,lldy,iy,ijy,desc_a,info,iiy,jjy)
if(info /= psb_success_) then
info=psb_err_from_subroutine_
ch_err='psb_chkvect'
@ -300,12 +300,12 @@ subroutine psb_dspmm(alpha,a,x,beta,y,desc_a,info,&
! Why the average? because in this way they will contribute
! with a proper scale factor (1/np) to the overall product.
!
call psi_ovrl_save(x(:,1:ik),xvsave,desc_a,info)
call psi_ovrl_save(x(:,1:lik),xvsave,desc_a,info)
if (info == psb_success_) call psi_ovrl_upd(x,desc_a,psb_avg_,info)
y(nrow+1:ncol,1:ik) = dzero
y(nrow+1:ncol,1:lik) = dzero
if (info == psb_success_) &
& call psb_csmm(alpha,a,x(:,1:ik),beta,y(:,1:ik),info,trans=trans_)
& call psb_csmm(alpha,a,x(:,1:lik),beta,y(:,1:lik),info,trans=trans_)
if (debug_level >= psb_debug_comp_) &
& write(debug_unit,*) me,' ',trim(name),' csmm ', info
if (info /= psb_success_) then
@ -316,7 +316,9 @@ subroutine psb_dspmm(alpha,a,x,beta,y,desc_a,info,&
end if
if (info == psb_success_) call psi_ovrl_restore(x,xvsave,desc_a,info)
if (doswap_)then
if (doswap_)then
ik = lik ! This should not be an issue, we are expecting the values
! to be small, within IPK
call psi_swaptran(ior(psb_swap_send_,psb_swap_recv_),&
& ik,done,y(:,1:ik),desc_a,iwork,info)
if (info == psb_success_) call psi_swapdata(ior(psb_swap_send_,psb_swap_recv_),&
@ -428,9 +430,9 @@ subroutine psb_dspmv(alpha,a,x,beta,y,desc_a,info,&
! locals
integer(psb_ipk_) :: ictxt, np, me,&
& err_act, n, iix, jjx, ia, ja, iia, jja, ix, iy, ik, &
& m, nrow, ncol, lldx, lldy, liwork, jx, jy, iiy, jjy,&
& ib, ip, idx
& err_act, iix, jjx, iia, jja, nrow, ncol, lldx, lldy, &
& liwork, iiy, jjy, ib, ip, idx, ik
integer(psb_lpk_) :: ix, ijx, iy, ijy, m, n, ia, ja, lik, jx, jy
integer(psb_ipk_), parameter :: nb=4
real(psb_dpk_), pointer :: iwork(:), xp(:), yp(:)
real(psb_dpk_), allocatable :: xvsave(:)
@ -461,6 +463,7 @@ subroutine psb_dspmv(alpha,a,x,beta,y,desc_a,info,&
iy = 1
jy = 1
ik = 1
lik = 1
ib = 1
if (present(doswap)) then
@ -538,9 +541,9 @@ subroutine psb_dspmv(alpha,a,x,beta,y,desc_a,info,&
end if
! checking for vectors correctness
call psb_chkvect(n,ik,lldx,ix,jx,desc_a,info,iix,jjx)
call psb_chkvect(n,lik,lldx,ix,jx,desc_a,info,iix,jjx)
if (info == psb_success_) &
& call psb_chkvect(m,ik,lldy,iy,jy,desc_a,info,iiy,jjy)
& call psb_chkvect(m,lik,lldy,iy,jy,desc_a,info,iiy,jjy)
if(info /= psb_success_) then
info=psb_err_from_subroutine_
ch_err='psb_chkvect'
@ -578,9 +581,9 @@ subroutine psb_dspmv(alpha,a,x,beta,y,desc_a,info,&
end if
! checking for vectors correctness
call psb_chkvect(m,ik,lldx,ix,jx,desc_a,info,iix,jjx)
call psb_chkvect(m,lik,lldx,ix,jx,desc_a,info,iix,jjx)
if (info == psb_success_)&
& call psb_chkvect(n,ik,lldy,iy,jy,desc_a,info,iiy,jjy)
& call psb_chkvect(n,lik,lldy,iy,jy,desc_a,info,iiy,jjy)
if(info /= psb_success_) then
info=psb_err_from_subroutine_
ch_err='psb_chkvect'
@ -684,9 +687,9 @@ subroutine psb_dspmv_vect(alpha,a,x,beta,y,desc_a,info,&
! locals
integer(psb_ipk_) :: ictxt, np, me,&
& err_act, n, iix, jjx, ia, ja, iia, jja, ix, iy, ik, &
& m, nrow, ncol, lldx, lldy, liwork, jx, jy, iiy, jjy,&
& ib, ip, idx
& err_act, iix, jjx, iia, jja, nrow, ncol, lldx, lldy, &
& liwork, iiy, jjy, ib, ip, idx
integer(psb_lpk_) :: ix, ijx, iy, ijy, m, n, ia, ja
integer(psb_ipk_), parameter :: nb=4
real(psb_dpk_), pointer :: iwork(:), xp(:), yp(:)
real(psb_dpk_), allocatable :: xvsave(:)

3
base/psblas/psb_dspnrm1.f90
Unescape Escape View File

@ -52,7 +52,8 @@ function psb_dspnrm1(a,desc_a,info) result(res)
! locals
integer(psb_ipk_) :: ictxt, np, me, nr,nc,&
& err_act, n, iia, jja, ia, ja, mdim, ndim, m
& err_act, iia, jja, mdim, ndim
integer(psb_lpk_) :: ix, ijx, iy, ijy, m, n, ia, ja
character(len=20) :: name, ch_err
real(psb_dpk_), allocatable :: v(:)

34
base/psblas/psb_dspsm.f90
Unescape Escape View File

@ -93,10 +93,10 @@ subroutine psb_dspsm(alpha,a,x,beta,y,desc_a,info,&
! locals
integer(psb_ipk_) :: ictxt, np, me,&
& err_act, iix, jjx, ia, ja, iia, jja, lldx,lldy, choice_,&
& ix, iy, ik, ijx, ijy, i, lld,&
& m, nrow, ncol, liwork, llwork, iiy, jjy, idx, ndm
& err_act, iix, jjx, iia, jja, lldx,lldy, choice_,&
& ik, i, lld, nrow, ncol, liwork, llwork, iiy, jjy, idx, ndm
integer(psb_lpk_) :: ix, ijx, iy, ijy, m, n, ia, ja, lik
character :: lscale
integer(psb_ipk_), parameter :: nb=4
real(psb_dpk_),pointer :: iwork(:), xp(:,:), yp(:,:), id(:)
@ -137,10 +137,10 @@ subroutine psb_dspsm(alpha,a,x,beta,y,desc_a,info,&
endif
if (present(k)) then
ik = min(k,size(x,2)-ijx+1)
ik = min(ik,size(y,2)-ijy+1)
lik = min(k,size(x,2)-ijx+1)
lik = min(lik,size(y,2)-ijy+1)
else
ik = min(size(x,2)-ijx+1,size(y,2)-ijy+1)
lik = min(size(x,2)-ijx+1,size(y,2)-ijy+1)
endif
if (present(choice)) then
@ -220,9 +220,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,ik,lldx,ix,ijx,desc_a,info,iix,jjx)
& call psb_chkvect(m,lik,lldx,ix,ijx,desc_a,info,iix,jjx)
if (info == psb_success_) &
& call psb_chkvect(m,ik,lldy,iy,ijy,desc_a,info,iiy,jjy)
& call psb_chkvect(m,lik,lldy,iy,ijy,desc_a,info,iiy,jjy)
if(info /= psb_success_) then
info=psb_err_from_subroutine_
ch_err='psb_chkvect/mat'
@ -245,6 +245,8 @@ subroutine psb_dspsm(alpha,a,x,beta,y,desc_a,info,&
goto 9999
end if
ik = lik ! This should not be a problem.
! We expect ik to be small, well within IPK
! Perform local triangular system solve
xp => x(iix:lldx,jjx:jjx+ik-1)
yp => y(iiy:lldy,jjy:jjy+ik-1)
@ -259,7 +261,6 @@ subroutine psb_dspsm(alpha,a,x,beta,y,desc_a,info,&
! update overlap elements
if (choice_ > 0) then
call psi_swapdata(ior(psb_swap_send_,psb_swap_recv_),ik,&
& done,yp,desc_a,iwork,info,data=psb_comm_ovr_)
@ -366,9 +367,9 @@ subroutine psb_dspsv(alpha,a,x,beta,y,desc_a,info,&
! locals
integer(psb_ipk_) :: ictxt, np, me, &
& err_act, iix, jjx, ia, ja, iia, jja, lldx,lldy, choice_,&
& ix, iy, ik, jx, jy, i, lld,&
& m, nrow, ncol, liwork, llwork, iiy, jjy, idx, ndm
& err_act, iix, jjx, iia, jja, lldx,lldy, choice_,&
& ik, i, lld, nrow, ncol, liwork, llwork, iiy, jjy, idx, ndm
integer(psb_lpk_) :: ix, ijx, iy, ijy, m, n, ia, ja, lik, jx, jy
character :: lscale
integer(psb_ipk_), parameter :: nb=4
@ -396,9 +397,10 @@ subroutine psb_dspsv(alpha,a,x,beta,y,desc_a,info,&
ja = 1
ix = 1
iy = 1
lik = 1
ik = 1
jx= 1
jy= 1
jx = 1
jy = 1
if (present(choice)) then
choice_ = choice
@ -478,9 +480,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,ik,lldx,ix,jx,desc_a,info,iix,jjx)
& call psb_chkvect(m,lik,lldx,ix,jx,desc_a,info,iix,jjx)
if (info == psb_success_) &
& call psb_chkvect(m,ik,lldy,iy,jy,desc_a,info,iiy,jjy)
& call psb_chkvect(m,lik,lldy,iy,jy,desc_a,info,iiy,jjy)
if(info /= psb_success_) then
info=psb_err_from_subroutine_
ch_err='psb_chkvect/mat'

25
base/psblas/psb_samax.f90
Unescape Escape View File

@ -57,7 +57,8 @@ function psb_samax(x,desc_a, info, jx) result(res)
! locals
integer(psb_ipk_) :: ictxt, np, me,&
& err_act, iix, jjx, ix, ijx, m, ldx
& err_act, iix, jjx, ldx
integer(psb_lpk_) :: ix, ijx, iy, ijy, m
character(len=20) :: name, ch_err
name='psb_samax'
@ -85,7 +86,7 @@ function psb_samax(x,desc_a, info, jx) result(res)
m = desc_a%get_global_rows()
ldx = size(x,1)
call psb_chkvect(m,ione,ldx,ix,ijx,desc_a,info,iix,jjx)
call psb_chkvect(m,lone,ldx,ix,ijx,desc_a,info,iix,jjx)
if(info /= psb_success_) then
info=psb_err_from_subroutine_
ch_err='psb_chkvect'
@ -174,7 +175,8 @@ function psb_samaxv (x,desc_a, info) result(res)
! locals
integer(psb_ipk_) :: ictxt, np, me,&
& err_act, iix, jjx, jx, ix, m, ldx
& err_act, iix, jjx, ldx
integer(psb_lpk_) :: ix, jx, iy, ijy, m
character(len=20) :: name, ch_err
@ -199,7 +201,7 @@ function psb_samaxv (x,desc_a, info) result(res)
m = desc_a%get_global_rows()
ldx = size(x,1)
call psb_chkvect(m,ione,ldx,ix,jx,desc_a,info,iix,jjx)
call psb_chkvect(m,lone,ldx,ix,jx,desc_a,info,iix,jjx)
if(info /= psb_success_) then
info=psb_err_from_subroutine_
ch_err='psb_chkvect'
@ -248,7 +250,8 @@ function psb_samax_vect(x, desc_a, info) result(res)
! locals
integer(psb_ipk_) :: ictxt, np, me,&
& err_act, iix, jjx, jx, ix, m
& err_act, iix, jjx
integer(psb_lpk_) :: ix, jx, iy, ijy, m
character(len=20) :: name, ch_err
name='psb_samaxv'
@ -275,7 +278,7 @@ function psb_samax_vect(x, desc_a, info) result(res)
jx = 1
m = desc_a%get_global_rows()
call psb_chkvect(m,ione,x%get_nrows(),ix,jx,desc_a,info,iix,jjx)
call psb_chkvect(m,lone,x%get_nrows(),ix,jx,desc_a,info,iix,jjx)
if(info /= psb_success_) then
info=psb_err_from_subroutine_
ch_err='psb_chkvect'
@ -367,7 +370,8 @@ subroutine psb_samaxvs(res,x,desc_a, info)
! locals
integer(psb_ipk_) :: ictxt, np, me,&
& err_act, iix, jjx, ix, ijx, m, ldx
& err_act, iix, jjx, ldx
integer(psb_lpk_) :: ix, ijx, iy, ijy, m
character(len=20) :: name, ch_err
name='psb_samaxvs'
@ -390,7 +394,7 @@ subroutine psb_samaxvs(res,x,desc_a, info)
m = desc_a%get_global_rows()
ldx=size(x,1)
call psb_chkvect(m,ione,ldx,ix,ijx,desc_a,info,iix,jjx)
call psb_chkvect(m,lone,ldx,ix,ijx,desc_a,info,iix,jjx)
if(info /= psb_success_) then
info=psb_err_from_subroutine_
ch_err='psb_chkvect'
@ -479,7 +483,8 @@ subroutine psb_smamaxs(res,x,desc_a, info,jx)
! locals
integer(psb_ipk_) :: ictxt, np, me,&
& err_act, iix, jjx, ix, ijx, m, ldx, i, k
& err_act, iix, jjx, ldx, i, k
integer(psb_lpk_) :: ix, ijx, iy, ijy, m
character(len=20) :: name, ch_err
name='psb_smamaxs'
@ -506,7 +511,7 @@ subroutine psb_smamaxs(res,x,desc_a, info,jx)
m = desc_a%get_global_rows()
k = min(size(x,2),size(res,1))
ldx = size(x,1)
call psb_chkvect(m,ione,ldx,ix,ijx,desc_a,info,iix,jjx)
call psb_chkvect(m,lone,ldx,ix,ijx,desc_a,info,iix,jjx)
if(info /= psb_success_) then
info=psb_err_from_subroutine_
ch_err='psb_chkvect'

20
base/psblas/psb_sasum.f90
Unescape Escape View File

@ -57,7 +57,8 @@ function psb_sasum (x,desc_a, info, jx) result(res)
! locals
integer(psb_ipk_) :: ictxt, np, me, &
& err_act, iix, jjx, ix, ijx, m, i, idx, ndm, ldx
& err_act, iix, jjx, i, idx, ndm, ldx
integer(psb_lpk_) :: ix, ijx, iy, ijy, m
character(len=20) :: name, ch_err
name='psb_sasum'
@ -85,7 +86,7 @@ function psb_sasum (x,desc_a, info, jx) result(res)
m = desc_a%get_global_rows()
ldx = size(x,1)
! check vector correctness
call psb_chkvect(m,ione,ldx,ix,ijx,desc_a,info,iix,jjx)
call psb_chkvect(m,lone,ldx,ix,ijx,desc_a,info,iix,jjx)
if(info /= psb_success_) then
info=psb_err_from_subroutine_
ch_err='psb_chkvect'
@ -136,7 +137,8 @@ function psb_sasum_vect(x, desc_a, info) result(res)
! locals
integer(psb_ipk_) :: ictxt, np, me,&
& err_act, iix, jjx, jx, ix, m, imax
& err_act, iix, jjx, imax
integer(psb_lpk_) :: ix, jx, iy, ijy, m
character(len=20) :: name, ch_err
name='psb_sasumv'
@ -165,7 +167,7 @@ function psb_sasum_vect(x, desc_a, info) result(res)
jx = 1
m = desc_a%get_global_rows()
call psb_chkvect(m,ione,x%get_nrows(),ix,jx,desc_a,info,iix,jjx)
call psb_chkvect(m,lone,x%get_nrows(),ix,jx,desc_a,info,iix,jjx)
if(info /= psb_success_) then
info=psb_err_from_subroutine_
ch_err='psb_chkvect'
@ -254,7 +256,8 @@ function psb_sasumv(x,desc_a, info) result(res)
! locals
integer(psb_ipk_) :: ictxt, np, me,&
& err_act, iix, jjx, jx, ix, m, i, idx, ndm, ldx
& err_act, iix, jjx, i, idx, ndm, ldx
integer(psb_lpk_) :: ix, jx, iy, ijy, m
character(len=20) :: name, ch_err
name='psb_sasumv'
@ -277,7 +280,7 @@ function psb_sasumv(x,desc_a, info) result(res)
m = desc_a%get_global_rows()
ldx = size(x,1)
! check vector correctness
call psb_chkvect(m,ione,ldx,ix,jx,desc_a,info,iix,jjx)
call psb_chkvect(m,lone,ldx,ix,jx,desc_a,info,iix,jjx)
if(info /= psb_success_) then
info=psb_err_from_subroutine_
ch_err='psb_chkvect'
@ -374,7 +377,8 @@ subroutine psb_sasumvs(res,x,desc_a, info)
! locals
integer(psb_ipk_) :: ictxt, np, me,&
& err_act, iix, jjx, ix, jx, m, i, idx, ndm, ldx
& err_act, iix, jjx, i, idx, ndm, ldx
integer(psb_lpk_) :: ix, jx, iy, ijy, m
character(len=20) :: name, ch_err
name='psb_sasumvs'
@ -397,7 +401,7 @@ subroutine psb_sasumvs(res,x,desc_a, info)
m = desc_a%get_global_rows()
ldx = size(x,1)
! check vector correctness
call psb_chkvect(m,ione,ldx,ix,jx,desc_a,info,iix,jjx)
call psb_chkvect(m,lone,ldx,ix,jx,desc_a,info,iix,jjx)
if(info /= psb_success_) then
info=psb_err_from_subroutine_
ch_err='psb_chkvect'

23
base/psblas/psb_saxpby.f90
Unescape Escape View File

@ -43,7 +43,8 @@ subroutine psb_saxpby_vect(alpha, x, beta, y,&
! locals
integer(psb_ipk_) :: ictxt, np, me,&
& err_act, iix, jjx, ix, iy, m, iiy, jjy
& err_act, iix, jjx, iiy, jjy
integer(psb_lpk_) :: ix, ijx, iy, ijy, m
character(len=20) :: name, ch_err
name='psb_sgeaxpby'
@ -77,14 +78,14 @@ subroutine psb_saxpby_vect(alpha, x, beta, y,&
m = desc_a%get_global_rows()
! check vector correctness
call psb_chkvect(m,ione,x%get_nrows(),ix,ione,desc_a,info,iix,jjx)
call psb_chkvect(m,lone,x%get_nrows(),ix,lone,desc_a,info,iix,jjx)
if(info /= psb_success_) then
info=psb_err_from_subroutine_
ch_err='psb_chkvect 1'
call psb_errpush(info,name,a_err=ch_err)
goto 9999
end if
call psb_chkvect(m,ione,y%get_nrows(),iy,ione,desc_a,info,iiy,jjy)
call psb_chkvect(m,lone,y%get_nrows(),iy,lone,desc_a,info,iiy,jjy)
if(info /= psb_success_) then
info=psb_err_from_subroutine_
ch_err='psb_chkvect 2'
@ -145,8 +146,8 @@ subroutine psb_saxpby(alpha, x, beta,y,desc_a,info, n, jx, jy)
! locals
integer(psb_ipk_) :: ictxt, np, me,&
& err_act, iix, jjx, ix, iy, ijx, ijy, m, iiy, in, jjy, &
& lldx, lldy
& err_act, iix, jjx, iiy, in, jjy, lldx, lldy
integer(psb_lpk_) :: ix, ijx, iy, ijy, m
character(len=20) :: name, ch_err
name='psb_geaxpby'
@ -197,9 +198,9 @@ subroutine psb_saxpby(alpha, x, beta,y,desc_a,info, n, jx, jy)
lldx = size(x,1)
lldy = size(y,1)
! check vector correctness
call psb_chkvect(m,ione,lldx,ix,ijx,desc_a,info,iix,jjx)
call psb_chkvect(m,lone,lldx,ix,ijx,desc_a,info,iix,jjx)
if (info == psb_success_) &
& call psb_chkvect(m,ione,lldy,iy,ijy,desc_a,info,iiy,jjy)
& call psb_chkvect(m,lone,lldy,iy,ijy,desc_a,info,iiy,jjy)
if(info /= psb_success_) then
info=psb_err_from_subroutine_
ch_err='psb_chkvect'
@ -291,8 +292,8 @@ subroutine psb_saxpbyv(alpha, x, beta,y,desc_a,info)
! locals
integer(psb_ipk_) :: ictxt, np, me,&
& err_act, iix, jjx, ix, iy, m, iiy, jjy, &
& lldx, lldy
& err_act, iix, jjx, iiy, jjy, lldx, lldy
integer(psb_lpk_) :: ix, ijx, iy, ijy, m
character(len=20) :: name, ch_err
logical, parameter :: debug=.false.
@ -317,14 +318,14 @@ subroutine psb_saxpbyv(alpha, x, beta,y,desc_a,info)
lldx = size(x,1)
lldy = size(y,1)
! check vector correctness
call psb_chkvect(m,ione,lldx,ix,ione,desc_a,info,iix,jjx)
call psb_chkvect(m,lone,lldx,ix,lone,desc_a,info,iix,jjx)
if(info /= psb_success_) then
info=psb_err_from_subroutine_
ch_err='psb_chkvect 1'
call psb_errpush(info,name,a_err=ch_err)
goto 9999
end if
call psb_chkvect(m,ione,lldy,iy,ione,desc_a,info,iiy,jjy)
call psb_chkvect(m,lone,lldy,iy,lone,desc_a,info,iiy,jjy)
if(info /= psb_success_) then
info=psb_err_from_subroutine_
ch_err='psb_chkvect 2'

39
base/psblas/psb_sdot.f90
Unescape Escape View File

@ -64,7 +64,8 @@ function psb_sdot_vect(x, y, desc_a,info) result(res)
! locals
integer(psb_ipk_) :: ictxt, np, me, idx, ndm,&
& err_act, iix, jjx, ix, ijx, iy, ijy, iiy, jjy, i, m, nr
& err_act, iix, jjx, iiy, jjy, i, nr
integer(psb_lpk_) :: ix, ijx, iy, ijy, m
character(len=20) :: name, ch_err
name='psb_sdot_vect'
@ -101,9 +102,9 @@ function psb_sdot_vect(x, y, desc_a,info) result(res)
m = desc_a%get_global_rows()
! check vector correctness
call psb_chkvect(m,ione,x%get_nrows(),ix,ijx,desc_a,info,iix,jjx)
call psb_chkvect(m,lone,x%get_nrows(),ix,ijx,desc_a,info,iix,jjx)
if (info == psb_success_) &
& call psb_chkvect(m,ione,y%get_nrows(),iy,ijy,desc_a,info,iiy,jjy)
& call psb_chkvect(m,lone,y%get_nrows(),iy,ijy,desc_a,info,iiy,jjy)
if(info /= psb_success_) then
info=psb_err_from_subroutine_
ch_err='psb_chkvect'
@ -155,8 +156,8 @@ function psb_sdot(x, y,desc_a, info, jx, jy) result(res)
! locals
integer(psb_ipk_) :: ictxt, np, me, idx, ndm,&
& err_act, iix, jjx, ix, ijx, iy, ijy, iiy, jjy, i, m, nr, &
& lldx, lldy
& err_act, iix, jjx, iiy, jjy, i, nr, lldx, lldy
integer(psb_lpk_) :: ix, ijx, iy, ijy, m
real(psb_spk_) :: sdot
character(len=20) :: name, ch_err
@ -198,9 +199,9 @@ function psb_sdot(x, y,desc_a, info, jx, jy) result(res)
lldy = size(y,1)
! check vector correctness
call psb_chkvect(m,ione,lldx,ix,ijx,desc_a,info,iix,jjx)
call psb_chkvect(m,lone,lldx,ix,ijx,desc_a,info,iix,jjx)
if (info == psb_success_) &
& call psb_chkvect(m,ione,lldy,iy,ijy,desc_a,info,iiy,jjy)
& call psb_chkvect(m,lone,lldy,iy,ijy,desc_a,info,iiy,jjy)
if(info /= psb_success_) then
info=psb_err_from_subroutine_
ch_err='psb_chkvect'
@ -295,8 +296,8 @@ function psb_sdotv(x, y,desc_a, info) result(res)
! locals
integer(psb_ipk_) :: ictxt, np, me, idx, ndm,&
& err_act, iix, jjx, ix, jx, iy, jy, iiy, jjy, i, m, nr, &
& lldx, lldy
& err_act, iix, jjx, iiy, jjy, i, nr, lldx, lldy
integer(psb_lpk_) :: ix, jx, iy, jy, m
real(psb_spk_) :: sdot
character(len=20) :: name, ch_err
@ -322,9 +323,9 @@ function psb_sdotv(x, y,desc_a, info) result(res)
lldx = size(x,1)
lldy = size(y,1)
! check vector correctness
call psb_chkvect(m,ione,lldx,ix,jx,desc_a,info,iix,jjx)
call psb_chkvect(m,lone,lldx,ix,jx,desc_a,info,iix,jjx)
if (info == psb_success_)&
& call psb_chkvect(m,ione,lldy,iy,jy,desc_a,info,iiy,jjy)
& call psb_chkvect(m,lone,lldy,iy,jy,desc_a,info,iiy,jjy)
if(info /= psb_success_) then
info=psb_err_from_subroutine_
ch_err='psb_chkvect'
@ -420,8 +421,8 @@ subroutine psb_sdotvs(res, x, y,desc_a, info)
! locals
integer(psb_ipk_) :: ictxt, np, me, idx, ndm,&
& err_act, iix, jjx, ix, iy, iiy, jjy, i, m,nr, &
& lldx, lldy
& err_act, iix, jjx, iiy, jjy, i,nr, lldx, lldy
integer(psb_lpk_) :: ix, jx, iy, jy, m
real(psb_spk_) :: sdot
character(len=20) :: name, ch_err
@ -445,9 +446,9 @@ subroutine psb_sdotvs(res, x, y,desc_a, info)
lldx = size(x,1)
lldy = size(y,1)
! check vector correctness
call psb_chkvect(m,ione,lldx,ix,ix,desc_a,info,iix,jjx)
call psb_chkvect(m,lone,lldx,ix,ix,desc_a,info,iix,jjx)
if (info == psb_success_) &
& call psb_chkvect(m,ione,lldy,iy,iy,desc_a,info,iiy,jjy)
& call psb_chkvect(m,lone,lldy,iy,iy,desc_a,info,iiy,jjy)
if(info /= psb_success_) then
info=psb_err_from_subroutine_
ch_err='psb_chkvect'
@ -543,8 +544,8 @@ subroutine psb_smdots(res, x, y, desc_a, info)
! locals
integer(psb_ipk_) :: ictxt, np, me, idx, ndm,&
& err_act, iix, jjx, ix, iy, iiy, jjy, i, m, j, k, nr, &
& lldx, lldy
& err_act, iix, jjx, iiy, jjy, i, j, k, nr, lldx, lldy
integer(psb_lpk_) :: ix, ijx, iy, ijy, m
real(psb_spk_) :: sdot
character(len=20) :: name, ch_err
@ -570,14 +571,14 @@ subroutine psb_smdots(res, x, y, desc_a, info)
lldy = size(y,1)
! check vector correctness
call psb_chkvect(m,ione,lldx,ix,ix,desc_a,info,iix,jjx)
call psb_chkvect(m,lone,lldx,ix,ix,desc_a,info,iix,jjx)
if(info /= psb_success_) then
info=psb_err_from_subroutine_
ch_err='psb_chkvect'
call psb_errpush(info,name,a_err=ch_err)
goto 9999
end if
call psb_chkvect(m,ione,lldy,iy,iy,desc_a,info,iiy,jjy)
call psb_chkvect(m,lone,lldy,iy,iy,desc_a,info,iiy,jjy)
if(info /= psb_success_) then
info=psb_err_from_subroutine_
ch_err='psb_chkvect'

28
base/psblas/psb_snrm2.f90
Unescape Escape View File

@ -59,7 +59,8 @@ function psb_snrm2(x, desc_a, info, jx) result(res)
! locals
integer(psb_ipk_) :: ictxt, np, me,&
& err_act, iix, jjx, ndim, ix, ijx, i, m, id, idx, ndm, ldx
& err_act, iix, jjx, ndim, i, id, idx, ndm, ldx
integer(psb_lpk_) :: ix, ijx, iy, ijy, m
real(psb_spk_) :: snrm2, dd
character(len=20) :: name, ch_err
@ -86,7 +87,7 @@ function psb_snrm2(x, desc_a, info, jx) result(res)
m = desc_a%get_global_rows()
ldx = size(x,1)
call psb_chkvect(m,ione,ldx,ix,ijx,desc_a,info,iix,jjx)
call psb_chkvect(m,lone,ldx,ix,ijx,desc_a,info,iix,jjx)
if(info /= psb_success_) then
info=psb_err_from_subroutine_
ch_err='psb_chkvect'
@ -182,10 +183,10 @@ function psb_snrm2v(x, desc_a, info) result(res)
! locals
integer(psb_ipk_) :: ictxt, np, me,&
& err_act, iix, jjx, ndim, ix, jx, i, m, id, idx, ndm, ldx
& err_act, iix, jjx, ndim, i, id, idx, ndm, ldx
integer(psb_lpk_) :: ix, jx, iy, ijy, m
real(psb_spk_) :: snrm2, dd
!!$ external scombnrm2
character(len=20) :: name, ch_err
name='psb_snrm2v'
@ -206,7 +207,7 @@ function psb_snrm2v(x, desc_a, info) result(res)
jx=1
m = desc_a%get_global_rows()
ldx = size(x,1)
call psb_chkvect(m,ione,ldx,ix,jx,desc_a,info,iix,jjx)
call psb_chkvect(m,lone,ldx,ix,jx,desc_a,info,iix,jjx)
if(info /= psb_success_) then
info=psb_err_from_subroutine_
ch_err='psb_chkvect'
@ -261,9 +262,9 @@ function psb_snrm2_vect(x, desc_a, info) result(res)
! locals
integer(psb_ipk_) :: ictxt, np, me,&
& err_act, iix, jjx, ndim, ix, jx, i, m, id, idx, ndm, ldx
& err_act, iix, jjx, ndim, i, id, idx, ndm, ldx
integer(psb_lpk_) :: ix, jx, iy, ijy, m
real(psb_spk_) :: snrm2, dd
!!$ external dcombnrm2
character(len=20) :: name, ch_err
name='psb_snrm2v'
@ -288,10 +289,10 @@ function psb_snrm2_vect(x, desc_a, info) result(res)
ix = 1
jx=1
m = desc_a%get_global_rows()
jx = 1
m = desc_a%get_global_rows()
ldx = x%get_nrows()
call psb_chkvect(m,ione,ldx,ix,jx,desc_a,info,iix,jjx)
call psb_chkvect(m,lone,ldx,ix,jx,desc_a,info,iix,jjx)
if(info /= psb_success_) then
info=psb_err_from_subroutine_
ch_err='psb_chkvect'
@ -387,10 +388,9 @@ subroutine psb_snrm2vs(res, x, desc_a, info)
! locals
integer(psb_ipk_) :: ictxt, np, me,&
& err_act, iix, jjx, ndim, ix, jx, i, m, id, idx, ndm, ldx
& err_act, iix, jjx, ndim, i, id, idx, ndm, ldx
integer(psb_lpk_) :: ix, jx, iy, ijy, m
real(psb_spk_) :: nrm2, snrm2, dd
!!$ external scombnrm2
character(len=20) :: name, ch_err
name='psb_snrm2'
@ -411,7 +411,7 @@ subroutine psb_snrm2vs(res, x, desc_a, info)
jx = 1
m = desc_a%get_global_rows()
ldx = size(x,1)
call psb_chkvect(m,ione,ldx,ix,jx,desc_a,info,iix,jjx)
call psb_chkvect(m,lone,ldx,ix,jx,desc_a,info,iix,jjx)
if(info /= psb_success_) then
info=psb_err_from_subroutine_
ch_err='psb_chkvect'

3
base/psblas/psb_snrmi.f90
Unescape Escape View File

@ -52,7 +52,8 @@ function psb_snrmi(a,desc_a,info) result(res)
! locals
integer(psb_ipk_) :: ictxt, np, me,&
& err_act, n, iia, jja, ia, ja, mdim, ndim, m
& err_act, iia, jja, mdim, ndim
integer(psb_lpk_) :: m, n, ia, ja
character(len=20) :: name, ch_err
name='psb_snrmi'

61
base/psblas/psb_sspmm.f90
Unescape Escape View File

@ -81,9 +81,9 @@ subroutine psb_sspmm(alpha,a,x,beta,y,desc_a,info,&
! locals
integer(psb_ipk_) :: ictxt, np, me,&
& err_act, n, iix, jjx, ia, ja, iia, jja, ix, iy, ik, ijx, ijy,&
& m, nrow, ncol, lldx, lldy, liwork, iiy, jjy,&
& i, ib, ib1, ip, idx
& err_act, iix, jjx, iia, jja, nrow, ncol, lldx, lldy, &
& liwork, iiy, jjy, i, ib, ib1, ip, idx, ik
integer(psb_lpk_) :: ix, ijx, iy, ijy, m, n, ia, ja, lik
integer(psb_ipk_), parameter :: nb=4
real(psb_spk_), pointer :: xp(:,:), yp(:,:), iwork(:)
real(psb_spk_), allocatable :: xvsave(:,:)
@ -132,10 +132,10 @@ subroutine psb_sspmm(alpha,a,x,beta,y,desc_a,info,&
endif
if (present(k)) then
ik = min(k,size(x,2)-ijx+1)
ik = min(ik,size(y,2)-ijy+1)
lik = min(k,size(x,2)-ijx+1)
lik = min(lik,size(y,2)-ijy+1)
else
ik = min(size(x,2)-ijx+1,size(y,2)-ijy+1)
lik = min(size(x,2)-ijx+1,size(y,2)-ijy+1)
endif
if (present(trans)) then
@ -205,9 +205,9 @@ subroutine psb_sspmm(alpha,a,x,beta,y,desc_a,info,&
end if
! checking for vectors correctness
call psb_chkvect(n,ik,lldx,ix,ijx,desc_a,info,iix,jjx)
call psb_chkvect(n,lik,lldx,ix,ijx,desc_a,info,iix,jjx)
if (info == psb_success_) &
& call psb_chkvect(m,ik,lldy,iy,ijy,desc_a,info,iiy,jjy)
& call psb_chkvect(m,lik,lldy,iy,ijy,desc_a,info,iiy,jjy)
if(info /= psb_success_) then
info=psb_err_from_subroutine_
ch_err='psb_chkvect'
@ -224,16 +224,16 @@ subroutine psb_sspmm(alpha,a,x,beta,y,desc_a,info,&
if (doswap_.and.(np>1)) then
ib1=min(nb,ik)
ib1=min(nb,lik)
xp => x(iix:lldx,jjx:jjx+ib1-1)
if (doswap_)&
& call psi_swapdata(ior(psb_swap_send_,psb_swap_recv_),&
& ib1,szero,xp,desc_a,iwork,info)
blk: do i=1, ik, nb
blk: do i=1, lik, nb
ib=ib1
ib1 = max(0,min(nb,(ik)-(i-1+ib)))
ib1 = max(0,min(nb,(lik)-(i-1+ib)))
xp => x(iix:lldx,jjx+i-1+ib:jjx+i-1+ib+ib1-1)
if ((ib1 > 0).and.(doswap_)) &
& call psi_swapdata(psb_swap_send_,ib1,&
@ -256,8 +256,8 @@ subroutine psb_sspmm(alpha,a,x,beta,y,desc_a,info,&
else
if (doswap_)&
& call psi_swapdata(ior(psb_swap_send_,psb_swap_recv_),&
& ib1,szero,x(:,1:ik),desc_a,iwork,info)
if (info == psb_success_) call psb_csmm(alpha,a,x(:,1:ik),beta,y(:,1:ik),info)
& ib1,szero,x(:,1:lik),desc_a,iwork,info)
if (info == psb_success_) call psb_csmm(alpha,a,x(:,1:lik),beta,y(:,1:lik),info)
end if
if(info /= psb_success_) then
info = psb_err_from_subroutine_non_
@ -277,9 +277,9 @@ subroutine psb_sspmm(alpha,a,x,beta,y,desc_a,info,&
! checking for vectors correctness
call psb_chkvect(m,ik,lldx,ix,ijx,desc_a,info,iix,jjx)
call psb_chkvect(m,lik,lldx,ix,ijx,desc_a,info,iix,jjx)
if (info == psb_success_) &
& call psb_chkvect(n,ik,lldy,iy,ijy,desc_a,info,iiy,jjy)
& call psb_chkvect(n,lik,lldy,iy,ijy,desc_a,info,iiy,jjy)
if(info /= psb_success_) then
info=psb_err_from_subroutine_
ch_err='psb_chkvect'
@ -300,12 +300,12 @@ subroutine psb_sspmm(alpha,a,x,beta,y,desc_a,info,&
! Why the average? because in this way they will contribute
! with a proper scale factor (1/np) to the overall product.
!
call psi_ovrl_save(x(:,1:ik),xvsave,desc_a,info)
call psi_ovrl_save(x(:,1:lik),xvsave,desc_a,info)
if (info == psb_success_) call psi_ovrl_upd(x,desc_a,psb_avg_,info)
y(nrow+1:ncol,1:ik) = szero
y(nrow+1:ncol,1:lik) = szero
if (info == psb_success_) &
& call psb_csmm(alpha,a,x(:,1:ik),beta,y(:,1:ik),info,trans=trans_)
& call psb_csmm(alpha,a,x(:,1:lik),beta,y(:,1:lik),info,trans=trans_)
if (debug_level >= psb_debug_comp_) &
& write(debug_unit,*) me,' ',trim(name),' csmm ', info
if (info /= psb_success_) then
@ -316,7 +316,9 @@ subroutine psb_sspmm(alpha,a,x,beta,y,desc_a,info,&
end if
if (info == psb_success_) call psi_ovrl_restore(x,xvsave,desc_a,info)
if (doswap_)then
if (doswap_)then
ik = lik ! This should not be an issue, we are expecting the values
! to be small, within IPK
call psi_swaptran(ior(psb_swap_send_,psb_swap_recv_),&
& ik,sone,y(:,1:ik),desc_a,iwork,info)
if (info == psb_success_) call psi_swapdata(ior(psb_swap_send_,psb_swap_recv_),&
@ -428,9 +430,9 @@ subroutine psb_sspmv(alpha,a,x,beta,y,desc_a,info,&
! locals
integer(psb_ipk_) :: ictxt, np, me,&
& err_act, n, iix, jjx, ia, ja, iia, jja, ix, iy, ik, &
& m, nrow, ncol, lldx, lldy, liwork, jx, jy, iiy, jjy,&
& ib, ip, idx
& err_act, iix, jjx, iia, jja, nrow, ncol, lldx, lldy, &
& liwork, iiy, jjy, ib, ip, idx, ik
integer(psb_lpk_) :: ix, ijx, iy, ijy, m, n, ia, ja, lik, jx, jy
integer(psb_ipk_), parameter :: nb=4
real(psb_spk_), pointer :: iwork(:), xp(:), yp(:)
real(psb_spk_), allocatable :: xvsave(:)
@ -461,6 +463,7 @@ subroutine psb_sspmv(alpha,a,x,beta,y,desc_a,info,&
iy = 1
jy = 1
ik = 1
lik = 1
ib = 1
if (present(doswap)) then
@ -538,9 +541,9 @@ subroutine psb_sspmv(alpha,a,x,beta,y,desc_a,info,&
end if
! checking for vectors correctness
call psb_chkvect(n,ik,lldx,ix,jx,desc_a,info,iix,jjx)
call psb_chkvect(n,lik,lldx,ix,jx,desc_a,info,iix,jjx)
if (info == psb_success_) &
& call psb_chkvect(m,ik,lldy,iy,jy,desc_a,info,iiy,jjy)
& call psb_chkvect(m,lik,lldy,iy,jy,desc_a,info,iiy,jjy)
if(info /= psb_success_) then
info=psb_err_from_subroutine_
ch_err='psb_chkvect'
@ -578,9 +581,9 @@ subroutine psb_sspmv(alpha,a,x,beta,y,desc_a,info,&
end if
! checking for vectors correctness
call psb_chkvect(m,ik,lldx,ix,jx,desc_a,info,iix,jjx)
call psb_chkvect(m,lik,lldx,ix,jx,desc_a,info,iix,jjx)
if (info == psb_success_)&
& call psb_chkvect(n,ik,lldy,iy,jy,desc_a,info,iiy,jjy)
& call psb_chkvect(n,lik,lldy,iy,jy,desc_a,info,iiy,jjy)
if(info /= psb_success_) then
info=psb_err_from_subroutine_
ch_err='psb_chkvect'
@ -684,9 +687,9 @@ subroutine psb_sspmv_vect(alpha,a,x,beta,y,desc_a,info,&
! locals
integer(psb_ipk_) :: ictxt, np, me,&
& err_act, n, iix, jjx, ia, ja, iia, jja, ix, iy, ik, &
& m, nrow, ncol, lldx, lldy, liwork, jx, jy, iiy, jjy,&
& ib, ip, idx
& err_act, iix, jjx, iia, jja, nrow, ncol, lldx, lldy, &
& liwork, iiy, jjy, ib, ip, idx
integer(psb_lpk_) :: ix, ijx, iy, ijy, m, n, ia, ja
integer(psb_ipk_), parameter :: nb=4
real(psb_spk_), pointer :: iwork(:), xp(:), yp(:)
real(psb_spk_), allocatable :: xvsave(:)

3
base/psblas/psb_sspnrm1.f90
Unescape Escape View File

@ -52,7 +52,8 @@ function psb_sspnrm1(a,desc_a,info) result(res)
! locals
integer(psb_ipk_) :: ictxt, np, me, nr,nc,&
& err_act, n, iia, jja, ia, ja, mdim, ndim, m
& err_act, iia, jja, mdim, ndim
integer(psb_lpk_) :: ix, ijx, iy, ijy, m, n, ia, ja
character(len=20) :: name, ch_err
real(psb_spk_), allocatable :: v(:)

34
base/psblas/psb_sspsm.f90
Unescape Escape View File

@ -93,10 +93,10 @@ subroutine psb_sspsm(alpha,a,x,beta,y,desc_a,info,&
! locals
integer(psb_ipk_) :: ictxt, np, me,&
& err_act, iix, jjx, ia, ja, iia, jja, lldx,lldy, choice_,&
& ix, iy, ik, ijx, ijy, i, lld,&
& m, nrow, ncol, liwork, llwork, iiy, jjy, idx, ndm
& err_act, iix, jjx, iia, jja, lldx,lldy, choice_,&
& ik, i, lld, nrow, ncol, liwork, llwork, iiy, jjy, idx, ndm
integer(psb_lpk_) :: ix, ijx, iy, ijy, m, n, ia, ja, lik
character :: lscale
integer(psb_ipk_), parameter :: nb=4
real(psb_spk_),pointer :: iwork(:), xp(:,:), yp(:,:), id(:)
@ -137,10 +137,10 @@ subroutine psb_sspsm(alpha,a,x,beta,y,desc_a,info,&
endif
if (present(k)) then
ik = min(k,size(x,2)-ijx+1)
ik = min(ik,size(y,2)-ijy+1)
lik = min(k,size(x,2)-ijx+1)
lik = min(lik,size(y,2)-ijy+1)
else
ik = min(size(x,2)-ijx+1,size(y,2)-ijy+1)
lik = min(size(x,2)-ijx+1,size(y,2)-ijy+1)
endif
if (present(choice)) then
@ -220,9 +220,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,ik,lldx,ix,ijx,desc_a,info,iix,jjx)
& call psb_chkvect(m,lik,lldx,ix,ijx,desc_a,info,iix,jjx)
if (info == psb_success_) &
& call psb_chkvect(m,ik,lldy,iy,ijy,desc_a,info,iiy,jjy)
& call psb_chkvect(m,lik,lldy,iy,ijy,desc_a,info,iiy,jjy)
if(info /= psb_success_) then
info=psb_err_from_subroutine_
ch_err='psb_chkvect/mat'
@ -245,6 +245,8 @@ subroutine psb_sspsm(alpha,a,x,beta,y,desc_a,info,&
goto 9999
end if
ik = lik ! This should not be a problem.
! We expect ik to be small, well within IPK
! Perform local triangular system solve
xp => x(iix:lldx,jjx:jjx+ik-1)
yp => y(iiy:lldy,jjy:jjy+ik-1)
@ -259,7 +261,6 @@ subroutine psb_sspsm(alpha,a,x,beta,y,desc_a,info,&
! update overlap elements
if (choice_ > 0) then
call psi_swapdata(ior(psb_swap_send_,psb_swap_recv_),ik,&
& sone,yp,desc_a,iwork,info,data=psb_comm_ovr_)
@ -366,9 +367,9 @@ subroutine psb_sspsv(alpha,a,x,beta,y,desc_a,info,&
! locals
integer(psb_ipk_) :: ictxt, np, me, &
& err_act, iix, jjx, ia, ja, iia, jja, lldx,lldy, choice_,&
& ix, iy, ik, jx, jy, i, lld,&
& m, nrow, ncol, liwork, llwork, iiy, jjy, idx, ndm
& err_act, iix, jjx, iia, jja, lldx,lldy, choice_,&
& ik, i, lld, nrow, ncol, liwork, llwork, iiy, jjy, idx, ndm
integer(psb_lpk_) :: ix, ijx, iy, ijy, m, n, ia, ja, lik, jx, jy
character :: lscale
integer(psb_ipk_), parameter :: nb=4
@ -396,9 +397,10 @@ subroutine psb_sspsv(alpha,a,x,beta,y,desc_a,info,&
ja = 1
ix = 1
iy = 1
lik = 1
ik = 1
jx= 1
jy= 1
jx = 1
jy = 1
if (present(choice)) then
choice_ = choice
@ -478,9 +480,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,ik,lldx,ix,jx,desc_a,info,iix,jjx)
& call psb_chkvect(m,lik,lldx,ix,jx,desc_a,info,iix,jjx)
if (info == psb_success_) &
& call psb_chkvect(m,ik,lldy,iy,jy,desc_a,info,iiy,jjy)
& call psb_chkvect(m,lik,lldy,iy,jy,desc_a,info,iiy,jjy)
if(info /= psb_success_) then
info=psb_err_from_subroutine_
ch_err='psb_chkvect/mat'

25
base/psblas/psb_zamax.f90
Unescape Escape View File

@ -57,7 +57,8 @@ function psb_zamax(x,desc_a, info, jx) result(res)
! locals
integer(psb_ipk_) :: ictxt, np, me,&
& err_act, iix, jjx, ix, ijx, m, ldx
& err_act, iix, jjx, ldx
integer(psb_lpk_) :: ix, ijx, iy, ijy, m
character(len=20) :: name, ch_err
name='psb_zamax'
@ -85,7 +86,7 @@ function psb_zamax(x,desc_a, info, jx) result(res)
m = desc_a%get_global_rows()
ldx = size(x,1)
call psb_chkvect(m,ione,ldx,ix,ijx,desc_a,info,iix,jjx)
call psb_chkvect(m,lone,ldx,ix,ijx,desc_a,info,iix,jjx)
if(info /= psb_success_) then
info=psb_err_from_subroutine_
ch_err='psb_chkvect'
@ -174,7 +175,8 @@ function psb_zamaxv (x,desc_a, info) result(res)
! locals
integer(psb_ipk_) :: ictxt, np, me,&
& err_act, iix, jjx, jx, ix, m, ldx
& err_act, iix, jjx, ldx
integer(psb_lpk_) :: ix, jx, iy, ijy, m
character(len=20) :: name, ch_err
@ -199,7 +201,7 @@ function psb_zamaxv (x,desc_a, info) result(res)
m = desc_a%get_global_rows()
ldx = size(x,1)
call psb_chkvect(m,ione,ldx,ix,jx,desc_a,info,iix,jjx)
call psb_chkvect(m,lone,ldx,ix,jx,desc_a,info,iix,jjx)
if(info /= psb_success_) then
info=psb_err_from_subroutine_
ch_err='psb_chkvect'
@ -248,7 +250,8 @@ function psb_zamax_vect(x, desc_a, info) result(res)
! locals
integer(psb_ipk_) :: ictxt, np, me,&
& err_act, iix, jjx, jx, ix, m
& err_act, iix, jjx
integer(psb_lpk_) :: ix, jx, iy, ijy, m
character(len=20) :: name, ch_err
name='psb_zamaxv'
@ -275,7 +278,7 @@ function psb_zamax_vect(x, desc_a, info) result(res)
jx = 1
m = desc_a%get_global_rows()
call psb_chkvect(m,ione,x%get_nrows(),ix,jx,desc_a,info,iix,jjx)
call psb_chkvect(m,lone,x%get_nrows(),ix,jx,desc_a,info,iix,jjx)
if(info /= psb_success_) then
info=psb_err_from_subroutine_
ch_err='psb_chkvect'
@ -367,7 +370,8 @@ subroutine psb_zamaxvs(res,x,desc_a, info)
! locals
integer(psb_ipk_) :: ictxt, np, me,&
& err_act, iix, jjx, ix, ijx, m, ldx
& err_act, iix, jjx, ldx
integer(psb_lpk_) :: ix, ijx, iy, ijy, m
character(len=20) :: name, ch_err
name='psb_zamaxvs'
@ -390,7 +394,7 @@ subroutine psb_zamaxvs(res,x,desc_a, info)
m = desc_a%get_global_rows()
ldx=size(x,1)
call psb_chkvect(m,ione,ldx,ix,ijx,desc_a,info,iix,jjx)
call psb_chkvect(m,lone,ldx,ix,ijx,desc_a,info,iix,jjx)
if(info /= psb_success_) then
info=psb_err_from_subroutine_
ch_err='psb_chkvect'
@ -479,7 +483,8 @@ subroutine psb_zmamaxs(res,x,desc_a, info,jx)
! locals
integer(psb_ipk_) :: ictxt, np, me,&
& err_act, iix, jjx, ix, ijx, m, ldx, i, k
& err_act, iix, jjx, ldx, i, k
integer(psb_lpk_) :: ix, ijx, iy, ijy, m
character(len=20) :: name, ch_err
name='psb_zmamaxs'
@ -506,7 +511,7 @@ subroutine psb_zmamaxs(res,x,desc_a, info,jx)
m = desc_a%get_global_rows()
k = min(size(x,2),size(res,1))
ldx = size(x,1)
call psb_chkvect(m,ione,ldx,ix,ijx,desc_a,info,iix,jjx)
call psb_chkvect(m,lone,ldx,ix,ijx,desc_a,info,iix,jjx)
if(info /= psb_success_) then
info=psb_err_from_subroutine_
ch_err='psb_chkvect'

20
base/psblas/psb_zasum.f90
Unescape Escape View File

@ -57,7 +57,8 @@ function psb_zasum (x,desc_a, info, jx) result(res)
! locals
integer(psb_ipk_) :: ictxt, np, me, &
& err_act, iix, jjx, ix, ijx, m, i, idx, ndm, ldx
& err_act, iix, jjx, i, idx, ndm, ldx
integer(psb_lpk_) :: ix, ijx, iy, ijy, m
character(len=20) :: name, ch_err
name='psb_zasum'
@ -85,7 +86,7 @@ function psb_zasum (x,desc_a, info, jx) result(res)
m = desc_a%get_global_rows()
ldx = size(x,1)
! check vector correctness
call psb_chkvect(m,ione,ldx,ix,ijx,desc_a,info,iix,jjx)
call psb_chkvect(m,lone,ldx,ix,ijx,desc_a,info,iix,jjx)
if(info /= psb_success_) then
info=psb_err_from_subroutine_
ch_err='psb_chkvect'
@ -136,7 +137,8 @@ function psb_zasum_vect(x, desc_a, info) result(res)
! locals
integer(psb_ipk_) :: ictxt, np, me,&
& err_act, iix, jjx, jx, ix, m, imax
& err_act, iix, jjx, imax
integer(psb_lpk_) :: ix, jx, iy, ijy, m
character(len=20) :: name, ch_err
name='psb_zasumv'
@ -165,7 +167,7 @@ function psb_zasum_vect(x, desc_a, info) result(res)
jx = 1
m = desc_a%get_global_rows()
call psb_chkvect(m,ione,x%get_nrows(),ix,jx,desc_a,info,iix,jjx)
call psb_chkvect(m,lone,x%get_nrows(),ix,jx,desc_a,info,iix,jjx)
if(info /= psb_success_) then
info=psb_err_from_subroutine_
ch_err='psb_chkvect'
@ -254,7 +256,8 @@ function psb_zasumv(x,desc_a, info) result(res)
! locals
integer(psb_ipk_) :: ictxt, np, me,&
& err_act, iix, jjx, jx, ix, m, i, idx, ndm, ldx
& err_act, iix, jjx, i, idx, ndm, ldx
integer(psb_lpk_) :: ix, jx, iy, ijy, m
character(len=20) :: name, ch_err
name='psb_zasumv'
@ -277,7 +280,7 @@ function psb_zasumv(x,desc_a, info) result(res)
m = desc_a%get_global_rows()
ldx = size(x,1)
! check vector correctness
call psb_chkvect(m,ione,ldx,ix,jx,desc_a,info,iix,jjx)
call psb_chkvect(m,lone,ldx,ix,jx,desc_a,info,iix,jjx)
if(info /= psb_success_) then
info=psb_err_from_subroutine_
ch_err='psb_chkvect'
@ -374,7 +377,8 @@ subroutine psb_zasumvs(res,x,desc_a, info)
! locals
integer(psb_ipk_) :: ictxt, np, me,&
& err_act, iix, jjx, ix, jx, m, i, idx, ndm, ldx
& err_act, iix, jjx, i, idx, ndm, ldx
integer(psb_lpk_) :: ix, jx, iy, ijy, m
character(len=20) :: name, ch_err
name='psb_zasumvs'
@ -397,7 +401,7 @@ subroutine psb_zasumvs(res,x,desc_a, info)
m = desc_a%get_global_rows()
ldx = size(x,1)
! check vector correctness
call psb_chkvect(m,ione,ldx,ix,jx,desc_a,info,iix,jjx)
call psb_chkvect(m,lone,ldx,ix,jx,desc_a,info,iix,jjx)
if(info /= psb_success_) then
info=psb_err_from_subroutine_
ch_err='psb_chkvect'

23
base/psblas/psb_zaxpby.f90
Unescape Escape View File

@ -43,7 +43,8 @@ subroutine psb_zaxpby_vect(alpha, x, beta, y,&
! locals
integer(psb_ipk_) :: ictxt, np, me,&
& err_act, iix, jjx, ix, iy, m, iiy, jjy
& err_act, iix, jjx, iiy, jjy
integer(psb_lpk_) :: ix, ijx, iy, ijy, m
character(len=20) :: name, ch_err
name='psb_zgeaxpby'
@ -77,14 +78,14 @@ subroutine psb_zaxpby_vect(alpha, x, beta, y,&
m = desc_a%get_global_rows()
! check vector correctness
call psb_chkvect(m,ione,x%get_nrows(),ix,ione,desc_a,info,iix,jjx)
call psb_chkvect(m,lone,x%get_nrows(),ix,lone,desc_a,info,iix,jjx)
if(info /= psb_success_) then
info=psb_err_from_subroutine_
ch_err='psb_chkvect 1'
call psb_errpush(info,name,a_err=ch_err)
goto 9999
end if
call psb_chkvect(m,ione,y%get_nrows(),iy,ione,desc_a,info,iiy,jjy)
call psb_chkvect(m,lone,y%get_nrows(),iy,lone,desc_a,info,iiy,jjy)
if(info /= psb_success_) then
info=psb_err_from_subroutine_
ch_err='psb_chkvect 2'
@ -145,8 +146,8 @@ subroutine psb_zaxpby(alpha, x, beta,y,desc_a,info, n, jx, jy)
! locals
integer(psb_ipk_) :: ictxt, np, me,&
& err_act, iix, jjx, ix, iy, ijx, ijy, m, iiy, in, jjy, &
& lldx, lldy
& err_act, iix, jjx, iiy, in, jjy, lldx, lldy
integer(psb_lpk_) :: ix, ijx, iy, ijy, m
character(len=20) :: name, ch_err
name='psb_geaxpby'
@ -197,9 +198,9 @@ subroutine psb_zaxpby(alpha, x, beta,y,desc_a,info, n, jx, jy)
lldx = size(x,1)
lldy = size(y,1)
! check vector correctness
call psb_chkvect(m,ione,lldx,ix,ijx,desc_a,info,iix,jjx)
call psb_chkvect(m,lone,lldx,ix,ijx,desc_a,info,iix,jjx)
if (info == psb_success_) &
& call psb_chkvect(m,ione,lldy,iy,ijy,desc_a,info,iiy,jjy)
& call psb_chkvect(m,lone,lldy,iy,ijy,desc_a,info,iiy,jjy)
if(info /= psb_success_) then
info=psb_err_from_subroutine_
ch_err='psb_chkvect'
@ -291,8 +292,8 @@ subroutine psb_zaxpbyv(alpha, x, beta,y,desc_a,info)
! locals
integer(psb_ipk_) :: ictxt, np, me,&
& err_act, iix, jjx, ix, iy, m, iiy, jjy, &
& lldx, lldy
& err_act, iix, jjx, iiy, jjy, lldx, lldy
integer(psb_lpk_) :: ix, ijx, iy, ijy, m
character(len=20) :: name, ch_err
logical, parameter :: debug=.false.
@ -317,14 +318,14 @@ subroutine psb_zaxpbyv(alpha, x, beta,y,desc_a,info)
lldx = size(x,1)
lldy = size(y,1)
! check vector correctness
call psb_chkvect(m,ione,lldx,ix,ione,desc_a,info,iix,jjx)
call psb_chkvect(m,lone,lldx,ix,lone,desc_a,info,iix,jjx)
if(info /= psb_success_) then
info=psb_err_from_subroutine_
ch_err='psb_chkvect 1'
call psb_errpush(info,name,a_err=ch_err)
goto 9999
end if
call psb_chkvect(m,ione,lldy,iy,ione,desc_a,info,iiy,jjy)
call psb_chkvect(m,lone,lldy,iy,lone,desc_a,info,iiy,jjy)
if(info /= psb_success_) then
info=psb_err_from_subroutine_
ch_err='psb_chkvect 2'

39
base/psblas/psb_zdot.f90
Unescape Escape View File

@ -64,7 +64,8 @@ function psb_zdot_vect(x, y, desc_a,info) result(res)
! locals
integer(psb_ipk_) :: ictxt, np, me, idx, ndm,&
& err_act, iix, jjx, ix, ijx, iy, ijy, iiy, jjy, i, m, nr
& err_act, iix, jjx, iiy, jjy, i, nr
integer(psb_lpk_) :: ix, ijx, iy, ijy, m
character(len=20) :: name, ch_err
name='psb_zdot_vect'
@ -101,9 +102,9 @@ function psb_zdot_vect(x, y, desc_a,info) result(res)
m = desc_a%get_global_rows()
! check vector correctness
call psb_chkvect(m,ione,x%get_nrows(),ix,ijx,desc_a,info,iix,jjx)
call psb_chkvect(m,lone,x%get_nrows(),ix,ijx,desc_a,info,iix,jjx)
if (info == psb_success_) &
& call psb_chkvect(m,ione,y%get_nrows(),iy,ijy,desc_a,info,iiy,jjy)
& call psb_chkvect(m,lone,y%get_nrows(),iy,ijy,desc_a,info,iiy,jjy)
if(info /= psb_success_) then
info=psb_err_from_subroutine_
ch_err='psb_chkvect'
@ -155,8 +156,8 @@ function psb_zdot(x, y,desc_a, info, jx, jy) result(res)
! locals
integer(psb_ipk_) :: ictxt, np, me, idx, ndm,&
& err_act, iix, jjx, ix, ijx, iy, ijy, iiy, jjy, i, m, nr, &
& lldx, lldy
& err_act, iix, jjx, iiy, jjy, i, nr, lldx, lldy
integer(psb_lpk_) :: ix, ijx, iy, ijy, m
complex(psb_dpk_) :: zdotc
character(len=20) :: name, ch_err
@ -198,9 +199,9 @@ function psb_zdot(x, y,desc_a, info, jx, jy) result(res)
lldy = size(y,1)
! check vector correctness
call psb_chkvect(m,ione,lldx,ix,ijx,desc_a,info,iix,jjx)
call psb_chkvect(m,lone,lldx,ix,ijx,desc_a,info,iix,jjx)
if (info == psb_success_) &
& call psb_chkvect(m,ione,lldy,iy,ijy,desc_a,info,iiy,jjy)
& call psb_chkvect(m,lone,lldy,iy,ijy,desc_a,info,iiy,jjy)
if(info /= psb_success_) then
info=psb_err_from_subroutine_
ch_err='psb_chkvect'
@ -295,8 +296,8 @@ function psb_zdotv(x, y,desc_a, info) result(res)
! locals
integer(psb_ipk_) :: ictxt, np, me, idx, ndm,&
& err_act, iix, jjx, ix, jx, iy, jy, iiy, jjy, i, m, nr, &
& lldx, lldy
& err_act, iix, jjx, iiy, jjy, i, nr, lldx, lldy
integer(psb_lpk_) :: ix, jx, iy, jy, m
complex(psb_dpk_) :: zdotc
character(len=20) :: name, ch_err
@ -322,9 +323,9 @@ function psb_zdotv(x, y,desc_a, info) result(res)
lldx = size(x,1)
lldy = size(y,1)
! check vector correctness
call psb_chkvect(m,ione,lldx,ix,jx,desc_a,info,iix,jjx)
call psb_chkvect(m,lone,lldx,ix,jx,desc_a,info,iix,jjx)
if (info == psb_success_)&
& call psb_chkvect(m,ione,lldy,iy,jy,desc_a,info,iiy,jjy)
& call psb_chkvect(m,lone,lldy,iy,jy,desc_a,info,iiy,jjy)
if(info /= psb_success_) then
info=psb_err_from_subroutine_
ch_err='psb_chkvect'
@ -420,8 +421,8 @@ subroutine psb_zdotvs(res, x, y,desc_a, info)
! locals
integer(psb_ipk_) :: ictxt, np, me, idx, ndm,&
& err_act, iix, jjx, ix, iy, iiy, jjy, i, m,nr, &
& lldx, lldy
& err_act, iix, jjx, iiy, jjy, i,nr, lldx, lldy
integer(psb_lpk_) :: ix, jx, iy, jy, m
complex(psb_dpk_) :: zdotc
character(len=20) :: name, ch_err
@ -445,9 +446,9 @@ subroutine psb_zdotvs(res, x, y,desc_a, info)
lldx = size(x,1)
lldy = size(y,1)
! check vector correctness
call psb_chkvect(m,ione,lldx,ix,ix,desc_a,info,iix,jjx)
call psb_chkvect(m,lone,lldx,ix,ix,desc_a,info,iix,jjx)
if (info == psb_success_) &
& call psb_chkvect(m,ione,lldy,iy,iy,desc_a,info,iiy,jjy)
& call psb_chkvect(m,lone,lldy,iy,iy,desc_a,info,iiy,jjy)
if(info /= psb_success_) then
info=psb_err_from_subroutine_
ch_err='psb_chkvect'
@ -543,8 +544,8 @@ subroutine psb_zmdots(res, x, y, desc_a, info)
! locals
integer(psb_ipk_) :: ictxt, np, me, idx, ndm,&
& err_act, iix, jjx, ix, iy, iiy, jjy, i, m, j, k, nr, &
& lldx, lldy
& err_act, iix, jjx, iiy, jjy, i, j, k, nr, lldx, lldy
integer(psb_lpk_) :: ix, ijx, iy, ijy, m
complex(psb_dpk_) :: zdotc
character(len=20) :: name, ch_err
@ -570,14 +571,14 @@ subroutine psb_zmdots(res, x, y, desc_a, info)
lldy = size(y,1)
! check vector correctness
call psb_chkvect(m,ione,lldx,ix,ix,desc_a,info,iix,jjx)
call psb_chkvect(m,lone,lldx,ix,ix,desc_a,info,iix,jjx)
if(info /= psb_success_) then
info=psb_err_from_subroutine_
ch_err='psb_chkvect'
call psb_errpush(info,name,a_err=ch_err)
goto 9999
end if
call psb_chkvect(m,ione,lldy,iy,iy,desc_a,info,iiy,jjy)
call psb_chkvect(m,lone,lldy,iy,iy,desc_a,info,iiy,jjy)
if(info /= psb_success_) then
info=psb_err_from_subroutine_
ch_err='psb_chkvect'

28
base/psblas/psb_znrm2.f90
Unescape Escape View File

@ -59,7 +59,8 @@ function psb_znrm2(x, desc_a, info, jx) result(res)
! locals
integer(psb_ipk_) :: ictxt, np, me,&
& err_act, iix, jjx, ndim, ix, ijx, i, m, id, idx, ndm, ldx
& err_act, iix, jjx, ndim, i, id, idx, ndm, ldx
integer(psb_lpk_) :: ix, ijx, iy, ijy, m
real(psb_dpk_) :: dznrm2, dd
character(len=20) :: name, ch_err
@ -86,7 +87,7 @@ function psb_znrm2(x, desc_a, info, jx) result(res)
m = desc_a%get_global_rows()
ldx = size(x,1)
call psb_chkvect(m,ione,ldx,ix,ijx,desc_a,info,iix,jjx)
call psb_chkvect(m,lone,ldx,ix,ijx,desc_a,info,iix,jjx)
if(info /= psb_success_) then
info=psb_err_from_subroutine_
ch_err='psb_chkvect'
@ -182,10 +183,10 @@ function psb_znrm2v(x, desc_a, info) result(res)
! locals
integer(psb_ipk_) :: ictxt, np, me,&
& err_act, iix, jjx, ndim, ix, jx, i, m, id, idx, ndm, ldx
& err_act, iix, jjx, ndim, i, id, idx, ndm, ldx
integer(psb_lpk_) :: ix, jx, iy, ijy, m
real(psb_dpk_) :: dznrm2, dd
!!$ external scombnrm2
character(len=20) :: name, ch_err
name='psb_znrm2v'
@ -206,7 +207,7 @@ function psb_znrm2v(x, desc_a, info) result(res)
jx=1
m = desc_a%get_global_rows()
ldx = size(x,1)
call psb_chkvect(m,ione,ldx,ix,jx,desc_a,info,iix,jjx)
call psb_chkvect(m,lone,ldx,ix,jx,desc_a,info,iix,jjx)
if(info /= psb_success_) then
info=psb_err_from_subroutine_
ch_err='psb_chkvect'
@ -261,9 +262,9 @@ function psb_znrm2_vect(x, desc_a, info) result(res)
! locals
integer(psb_ipk_) :: ictxt, np, me,&
& err_act, iix, jjx, ndim, ix, jx, i, m, id, idx, ndm, ldx
& err_act, iix, jjx, ndim, i, id, idx, ndm, ldx
integer(psb_lpk_) :: ix, jx, iy, ijy, m
real(psb_dpk_) :: snrm2, dd
!!$ external dcombnrm2
character(len=20) :: name, ch_err
name='psb_znrm2v'
@ -288,10 +289,10 @@ function psb_znrm2_vect(x, desc_a, info) result(res)
ix = 1
jx=1
m = desc_a%get_global_rows()
jx = 1
m = desc_a%get_global_rows()
ldx = x%get_nrows()
call psb_chkvect(m,ione,ldx,ix,jx,desc_a,info,iix,jjx)
call psb_chkvect(m,lone,ldx,ix,jx,desc_a,info,iix,jjx)
if(info /= psb_success_) then
info=psb_err_from_subroutine_
ch_err='psb_chkvect'
@ -387,10 +388,9 @@ subroutine psb_znrm2vs(res, x, desc_a, info)
! locals
integer(psb_ipk_) :: ictxt, np, me,&
& err_act, iix, jjx, ndim, ix, jx, i, m, id, idx, ndm, ldx
& err_act, iix, jjx, ndim, i, id, idx, ndm, ldx
integer(psb_lpk_) :: ix, jx, iy, ijy, m
real(psb_dpk_) :: nrm2, dznrm2, dd
!!$ external scombnrm2
character(len=20) :: name, ch_err
name='psb_znrm2'
@ -411,7 +411,7 @@ subroutine psb_znrm2vs(res, x, desc_a, info)
jx = 1
m = desc_a%get_global_rows()
ldx = size(x,1)
call psb_chkvect(m,ione,ldx,ix,jx,desc_a,info,iix,jjx)
call psb_chkvect(m,lone,ldx,ix,jx,desc_a,info,iix,jjx)
if(info /= psb_success_) then
info=psb_err_from_subroutine_
ch_err='psb_chkvect'

3
base/psblas/psb_znrmi.f90
Unescape Escape View File

@ -52,7 +52,8 @@ function psb_znrmi(a,desc_a,info) result(res)
! locals
integer(psb_ipk_) :: ictxt, np, me,&
& err_act, n, iia, jja, ia, ja, mdim, ndim, m
& err_act, iia, jja, mdim, ndim
integer(psb_lpk_) :: m, n, ia, ja
character(len=20) :: name, ch_err
name='psb_znrmi'

61
base/psblas/psb_zspmm.f90
Unescape Escape View File

@ -81,9 +81,9 @@ subroutine psb_zspmm(alpha,a,x,beta,y,desc_a,info,&
! locals
integer(psb_ipk_) :: ictxt, np, me,&
& err_act, n, iix, jjx, ia, ja, iia, jja, ix, iy, ik, ijx, ijy,&
& m, nrow, ncol, lldx, lldy, liwork, iiy, jjy,&
& i, ib, ib1, ip, idx
& err_act, iix, jjx, iia, jja, nrow, ncol, lldx, lldy, &
& liwork, iiy, jjy, i, ib, ib1, ip, idx, ik
integer(psb_lpk_) :: ix, ijx, iy, ijy, m, n, ia, ja, lik
integer(psb_ipk_), parameter :: nb=4
complex(psb_dpk_), pointer :: xp(:,:), yp(:,:), iwork(:)
complex(psb_dpk_), allocatable :: xvsave(:,:)
@ -132,10 +132,10 @@ subroutine psb_zspmm(alpha,a,x,beta,y,desc_a,info,&
endif
if (present(k)) then
ik = min(k,size(x,2)-ijx+1)
ik = min(ik,size(y,2)-ijy+1)
lik = min(k,size(x,2)-ijx+1)
lik = min(lik,size(y,2)-ijy+1)
else
ik = min(size(x,2)-ijx+1,size(y,2)-ijy+1)
lik = min(size(x,2)-ijx+1,size(y,2)-ijy+1)
endif
if (present(trans)) then
@ -205,9 +205,9 @@ subroutine psb_zspmm(alpha,a,x,beta,y,desc_a,info,&
end if
! checking for vectors correctness
call psb_chkvect(n,ik,lldx,ix,ijx,desc_a,info,iix,jjx)
call psb_chkvect(n,lik,lldx,ix,ijx,desc_a,info,iix,jjx)
if (info == psb_success_) &
& call psb_chkvect(m,ik,lldy,iy,ijy,desc_a,info,iiy,jjy)
& call psb_chkvect(m,lik,lldy,iy,ijy,desc_a,info,iiy,jjy)
if(info /= psb_success_) then
info=psb_err_from_subroutine_
ch_err='psb_chkvect'
@ -224,16 +224,16 @@ subroutine psb_zspmm(alpha,a,x,beta,y,desc_a,info,&
if (doswap_.and.(np>1)) then
ib1=min(nb,ik)
ib1=min(nb,lik)
xp => x(iix:lldx,jjx:jjx+ib1-1)
if (doswap_)&
& call psi_swapdata(ior(psb_swap_send_,psb_swap_recv_),&
& ib1,zzero,xp,desc_a,iwork,info)
blk: do i=1, ik, nb
blk: do i=1, lik, nb
ib=ib1
ib1 = max(0,min(nb,(ik)-(i-1+ib)))
ib1 = max(0,min(nb,(lik)-(i-1+ib)))
xp => x(iix:lldx,jjx+i-1+ib:jjx+i-1+ib+ib1-1)
if ((ib1 > 0).and.(doswap_)) &
& call psi_swapdata(psb_swap_send_,ib1,&
@ -256,8 +256,8 @@ subroutine psb_zspmm(alpha,a,x,beta,y,desc_a,info,&
else
if (doswap_)&
& call psi_swapdata(ior(psb_swap_send_,psb_swap_recv_),&
& ib1,zzero,x(:,1:ik),desc_a,iwork,info)
if (info == psb_success_) call psb_csmm(alpha,a,x(:,1:ik),beta,y(:,1:ik),info)
& ib1,zzero,x(:,1:lik),desc_a,iwork,info)
if (info == psb_success_) call psb_csmm(alpha,a,x(:,1:lik),beta,y(:,1:lik),info)
end if
if(info /= psb_success_) then
info = psb_err_from_subroutine_non_
@ -277,9 +277,9 @@ subroutine psb_zspmm(alpha,a,x,beta,y,desc_a,info,&
! checking for vectors correctness
call psb_chkvect(m,ik,lldx,ix,ijx,desc_a,info,iix,jjx)
call psb_chkvect(m,lik,lldx,ix,ijx,desc_a,info,iix,jjx)
if (info == psb_success_) &
& call psb_chkvect(n,ik,lldy,iy,ijy,desc_a,info,iiy,jjy)
& call psb_chkvect(n,lik,lldy,iy,ijy,desc_a,info,iiy,jjy)
if(info /= psb_success_) then
info=psb_err_from_subroutine_
ch_err='psb_chkvect'
@ -300,12 +300,12 @@ subroutine psb_zspmm(alpha,a,x,beta,y,desc_a,info,&
! Why the average? because in this way they will contribute
! with a proper scale factor (1/np) to the overall product.
!
call psi_ovrl_save(x(:,1:ik),xvsave,desc_a,info)
call psi_ovrl_save(x(:,1:lik),xvsave,desc_a,info)
if (info == psb_success_) call psi_ovrl_upd(x,desc_a,psb_avg_,info)
y(nrow+1:ncol,1:ik) = zzero
y(nrow+1:ncol,1:lik) = zzero
if (info == psb_success_) &
& call psb_csmm(alpha,a,x(:,1:ik),beta,y(:,1:ik),info,trans=trans_)
& call psb_csmm(alpha,a,x(:,1:lik),beta,y(:,1:lik),info,trans=trans_)
if (debug_level >= psb_debug_comp_) &
& write(debug_unit,*) me,' ',trim(name),' csmm ', info
if (info /= psb_success_) then
@ -316,7 +316,9 @@ subroutine psb_zspmm(alpha,a,x,beta,y,desc_a,info,&
end if
if (info == psb_success_) call psi_ovrl_restore(x,xvsave,desc_a,info)
if (doswap_)then
if (doswap_)then
ik = lik ! This should not be an issue, we are expecting the values
! to be small, within IPK
call psi_swaptran(ior(psb_swap_send_,psb_swap_recv_),&
& ik,zone,y(:,1:ik),desc_a,iwork,info)
if (info == psb_success_) call psi_swapdata(ior(psb_swap_send_,psb_swap_recv_),&
@ -428,9 +430,9 @@ subroutine psb_zspmv(alpha,a,x,beta,y,desc_a,info,&
! locals
integer(psb_ipk_) :: ictxt, np, me,&
& err_act, n, iix, jjx, ia, ja, iia, jja, ix, iy, ik, &
& m, nrow, ncol, lldx, lldy, liwork, jx, jy, iiy, jjy,&
& ib, ip, idx
& err_act, iix, jjx, iia, jja, nrow, ncol, lldx, lldy, &
& liwork, iiy, jjy, ib, ip, idx, ik
integer(psb_lpk_) :: ix, ijx, iy, ijy, m, n, ia, ja, lik, jx, jy
integer(psb_ipk_), parameter :: nb=4
complex(psb_dpk_), pointer :: iwork(:), xp(:), yp(:)
complex(psb_dpk_), allocatable :: xvsave(:)
@ -461,6 +463,7 @@ subroutine psb_zspmv(alpha,a,x,beta,y,desc_a,info,&
iy = 1
jy = 1
ik = 1
lik = 1
ib = 1
if (present(doswap)) then
@ -538,9 +541,9 @@ subroutine psb_zspmv(alpha,a,x,beta,y,desc_a,info,&
end if
! checking for vectors correctness
call psb_chkvect(n,ik,lldx,ix,jx,desc_a,info,iix,jjx)
call psb_chkvect(n,lik,lldx,ix,jx,desc_a,info,iix,jjx)
if (info == psb_success_) &
& call psb_chkvect(m,ik,lldy,iy,jy,desc_a,info,iiy,jjy)
& call psb_chkvect(m,lik,lldy,iy,jy,desc_a,info,iiy,jjy)
if(info /= psb_success_) then
info=psb_err_from_subroutine_
ch_err='psb_chkvect'
@ -578,9 +581,9 @@ subroutine psb_zspmv(alpha,a,x,beta,y,desc_a,info,&
end if
! checking for vectors correctness
call psb_chkvect(m,ik,lldx,ix,jx,desc_a,info,iix,jjx)
call psb_chkvect(m,lik,lldx,ix,jx,desc_a,info,iix,jjx)
if (info == psb_success_)&
& call psb_chkvect(n,ik,lldy,iy,jy,desc_a,info,iiy,jjy)
& call psb_chkvect(n,lik,lldy,iy,jy,desc_a,info,iiy,jjy)
if(info /= psb_success_) then
info=psb_err_from_subroutine_
ch_err='psb_chkvect'
@ -684,9 +687,9 @@ subroutine psb_zspmv_vect(alpha,a,x,beta,y,desc_a,info,&
! locals
integer(psb_ipk_) :: ictxt, np, me,&
& err_act, n, iix, jjx, ia, ja, iia, jja, ix, iy, ik, &
& m, nrow, ncol, lldx, lldy, liwork, jx, jy, iiy, jjy,&
& ib, ip, idx
& err_act, iix, jjx, iia, jja, nrow, ncol, lldx, lldy, &
& liwork, iiy, jjy, ib, ip, idx
integer(psb_lpk_) :: ix, ijx, iy, ijy, m, n, ia, ja
integer(psb_ipk_), parameter :: nb=4
complex(psb_dpk_), pointer :: iwork(:), xp(:), yp(:)
complex(psb_dpk_), allocatable :: xvsave(:)

3
base/psblas/psb_zspnrm1.f90
Unescape Escape View File

@ -52,7 +52,8 @@ function psb_zspnrm1(a,desc_a,info) result(res)
! locals
integer(psb_ipk_) :: ictxt, np, me, nr,nc,&
& err_act, n, iia, jja, ia, ja, mdim, ndim, m
& err_act, iia, jja, mdim, ndim
integer(psb_lpk_) :: ix, ijx, iy, ijy, m, n, ia, ja
character(len=20) :: name, ch_err
real(psb_dpk_), allocatable :: v(:)

34
base/psblas/psb_zspsm.f90
Unescape Escape View File

@ -93,10 +93,10 @@ subroutine psb_zspsm(alpha,a,x,beta,y,desc_a,info,&
! locals
integer(psb_ipk_) :: ictxt, np, me,&
& err_act, iix, jjx, ia, ja, iia, jja, lldx,lldy, choice_,&
& ix, iy, ik, ijx, ijy, i, lld,&
& m, nrow, ncol, liwork, llwork, iiy, jjy, idx, ndm
& err_act, iix, jjx, iia, jja, lldx,lldy, choice_,&
& ik, i, lld, nrow, ncol, liwork, llwork, iiy, jjy, idx, ndm
integer(psb_lpk_) :: ix, ijx, iy, ijy, m, n, ia, ja, lik
character :: lscale
integer(psb_ipk_), parameter :: nb=4
complex(psb_dpk_),pointer :: iwork(:), xp(:,:), yp(:,:), id(:)
@ -137,10 +137,10 @@ subroutine psb_zspsm(alpha,a,x,beta,y,desc_a,info,&
endif
if (present(k)) then
ik = min(k,size(x,2)-ijx+1)
ik = min(ik,size(y,2)-ijy+1)
lik = min(k,size(x,2)-ijx+1)
lik = min(lik,size(y,2)-ijy+1)
else
ik = min(size(x,2)-ijx+1,size(y,2)-ijy+1)
lik = min(size(x,2)-ijx+1,size(y,2)-ijy+1)
endif
if (present(choice)) then
@ -220,9 +220,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,ik,lldx,ix,ijx,desc_a,info,iix,jjx)
& call psb_chkvect(m,lik,lldx,ix,ijx,desc_a,info,iix,jjx)
if (info == psb_success_) &
& call psb_chkvect(m,ik,lldy,iy,ijy,desc_a,info,iiy,jjy)
& call psb_chkvect(m,lik,lldy,iy,ijy,desc_a,info,iiy,jjy)
if(info /= psb_success_) then
info=psb_err_from_subroutine_
ch_err='psb_chkvect/mat'
@ -245,6 +245,8 @@ subroutine psb_zspsm(alpha,a,x,beta,y,desc_a,info,&
goto 9999
end if
ik = lik ! This should not be a problem.
! We expect ik to be small, well within IPK
! Perform local triangular system solve
xp => x(iix:lldx,jjx:jjx+ik-1)
yp => y(iiy:lldy,jjy:jjy+ik-1)
@ -259,7 +261,6 @@ subroutine psb_zspsm(alpha,a,x,beta,y,desc_a,info,&
! update overlap elements
if (choice_ > 0) then
call psi_swapdata(ior(psb_swap_send_,psb_swap_recv_),ik,&
& zone,yp,desc_a,iwork,info,data=psb_comm_ovr_)
@ -366,9 +367,9 @@ subroutine psb_zspsv(alpha,a,x,beta,y,desc_a,info,&
! locals
integer(psb_ipk_) :: ictxt, np, me, &
& err_act, iix, jjx, ia, ja, iia, jja, lldx,lldy, choice_,&
& ix, iy, ik, jx, jy, i, lld,&
& m, nrow, ncol, liwork, llwork, iiy, jjy, idx, ndm
& err_act, iix, jjx, iia, jja, lldx,lldy, choice_,&
& ik, i, lld, nrow, ncol, liwork, llwork, iiy, jjy, idx, ndm
integer(psb_lpk_) :: ix, ijx, iy, ijy, m, n, ia, ja, lik, jx, jy
character :: lscale
integer(psb_ipk_), parameter :: nb=4
@ -396,9 +397,10 @@ subroutine psb_zspsv(alpha,a,x,beta,y,desc_a,info,&
ja = 1
ix = 1
iy = 1
lik = 1
ik = 1
jx= 1
jy= 1
jx = 1
jy = 1
if (present(choice)) then
choice_ = choice
@ -478,9 +480,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,ik,lldx,ix,jx,desc_a,info,iix,jjx)
& call psb_chkvect(m,lik,lldx,ix,jx,desc_a,info,iix,jjx)
if (info == psb_success_) &
& call psb_chkvect(m,ik,lldy,iy,jy,desc_a,info,iiy,jjy)
& call psb_chkvect(m,lik,lldy,iy,jy,desc_a,info,iiy,jjy)
if(info /= psb_success_) then
info=psb_err_from_subroutine_
ch_err='psb_chkvect/mat'

Write Preview
Loading…
Cancel
Save