From f1db209da386922b145a1d8ca7b6f9e0582c57df Mon Sep 17 00:00:00 2001 From: Salvatore Filippone Date: Tue, 10 Apr 2018 16:48:46 +0100 Subject: [PATCH] Fixed compilation in base/psblas. --- base/modules/psb_check_mod.f90 | 2 +- base/psblas/psb_camax.f90 | 25 ++++++++------ base/psblas/psb_casum.f90 | 20 ++++++----- base/psblas/psb_caxpby.f90 | 23 +++++++------ base/psblas/psb_cdot.f90 | 39 +++++++++++----------- base/psblas/psb_cnrm2.f90 | 28 ++++++++-------- base/psblas/psb_cnrmi.f90 | 3 +- base/psblas/psb_cspmm.f90 | 61 ++++++++++++++++++---------------- base/psblas/psb_cspnrm1.f90 | 3 +- base/psblas/psb_cspsm.f90 | 34 ++++++++++--------- base/psblas/psb_damax.f90 | 25 ++++++++------ base/psblas/psb_dasum.f90 | 20 ++++++----- base/psblas/psb_daxpby.f90 | 23 +++++++------ base/psblas/psb_ddot.f90 | 39 +++++++++++----------- base/psblas/psb_dnrm2.f90 | 28 ++++++++-------- base/psblas/psb_dnrmi.f90 | 3 +- base/psblas/psb_dspmm.f90 | 61 ++++++++++++++++++---------------- base/psblas/psb_dspnrm1.f90 | 3 +- base/psblas/psb_dspsm.f90 | 34 ++++++++++--------- base/psblas/psb_samax.f90 | 25 ++++++++------ base/psblas/psb_sasum.f90 | 20 ++++++----- base/psblas/psb_saxpby.f90 | 23 +++++++------ base/psblas/psb_sdot.f90 | 39 +++++++++++----------- base/psblas/psb_snrm2.f90 | 28 ++++++++-------- base/psblas/psb_snrmi.f90 | 3 +- base/psblas/psb_sspmm.f90 | 61 ++++++++++++++++++---------------- base/psblas/psb_sspnrm1.f90 | 3 +- base/psblas/psb_sspsm.f90 | 34 ++++++++++--------- base/psblas/psb_zamax.f90 | 25 ++++++++------ base/psblas/psb_zasum.f90 | 20 ++++++----- base/psblas/psb_zaxpby.f90 | 23 +++++++------ base/psblas/psb_zdot.f90 | 39 +++++++++++----------- base/psblas/psb_znrm2.f90 | 28 ++++++++-------- base/psblas/psb_znrmi.f90 | 3 +- base/psblas/psb_zspmm.f90 | 61 ++++++++++++++++++---------------- base/psblas/psb_zspnrm1.f90 | 3 +- base/psblas/psb_zspsm.f90 | 34 ++++++++++--------- 37 files changed, 509 insertions(+), 437 deletions(-) diff --git a/base/modules/psb_check_mod.f90 b/base/modules/psb_check_mod.f90 index aa4ff30df..37631d5ff 100644 --- a/base/modules/psb_check_mod.f90 +++ b/base/modules/psb_check_mod.f90 @@ -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 diff --git a/base/psblas/psb_camax.f90 b/base/psblas/psb_camax.f90 index fea7798e3..88ff83a04 100644 --- a/base/psblas/psb_camax.f90 +++ b/base/psblas/psb_camax.f90 @@ -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' diff --git a/base/psblas/psb_casum.f90 b/base/psblas/psb_casum.f90 index bd77453f8..a55f92139 100644 --- a/base/psblas/psb_casum.f90 +++ b/base/psblas/psb_casum.f90 @@ -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' diff --git a/base/psblas/psb_caxpby.f90 b/base/psblas/psb_caxpby.f90 index 66e6512db..622890be5 100644 --- a/base/psblas/psb_caxpby.f90 +++ b/base/psblas/psb_caxpby.f90 @@ -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' diff --git a/base/psblas/psb_cdot.f90 b/base/psblas/psb_cdot.f90 index 7e9edf870..9ad024b24 100644 --- a/base/psblas/psb_cdot.f90 +++ b/base/psblas/psb_cdot.f90 @@ -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' diff --git a/base/psblas/psb_cnrm2.f90 b/base/psblas/psb_cnrm2.f90 index 948507f63..a41a80966 100644 --- a/base/psblas/psb_cnrm2.f90 +++ b/base/psblas/psb_cnrm2.f90 @@ -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' diff --git a/base/psblas/psb_cnrmi.f90 b/base/psblas/psb_cnrmi.f90 index fced0cbd3..b0800a9c2 100644 --- a/base/psblas/psb_cnrmi.f90 +++ b/base/psblas/psb_cnrmi.f90 @@ -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' diff --git a/base/psblas/psb_cspmm.f90 b/base/psblas/psb_cspmm.f90 index 533a771e4..c72fb48c5 100644 --- a/base/psblas/psb_cspmm.f90 +++ b/base/psblas/psb_cspmm.f90 @@ -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(:) diff --git a/base/psblas/psb_cspnrm1.f90 b/base/psblas/psb_cspnrm1.f90 index 02a984240..f5896e35b 100644 --- a/base/psblas/psb_cspnrm1.f90 +++ b/base/psblas/psb_cspnrm1.f90 @@ -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(:) diff --git a/base/psblas/psb_cspsm.f90 b/base/psblas/psb_cspsm.f90 index 034f98e03..725a06177 100644 --- a/base/psblas/psb_cspsm.f90 +++ b/base/psblas/psb_cspsm.f90 @@ -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' diff --git a/base/psblas/psb_damax.f90 b/base/psblas/psb_damax.f90 index b04e96461..9f62e1407 100644 --- a/base/psblas/psb_damax.f90 +++ b/base/psblas/psb_damax.f90 @@ -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' diff --git a/base/psblas/psb_dasum.f90 b/base/psblas/psb_dasum.f90 index 4871c29f5..cbf671fbe 100644 --- a/base/psblas/psb_dasum.f90 +++ b/base/psblas/psb_dasum.f90 @@ -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' diff --git a/base/psblas/psb_daxpby.f90 b/base/psblas/psb_daxpby.f90 index a67e10553..25099c630 100644 --- a/base/psblas/psb_daxpby.f90 +++ b/base/psblas/psb_daxpby.f90 @@ -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' diff --git a/base/psblas/psb_ddot.f90 b/base/psblas/psb_ddot.f90 index afd33aede..78fc060d5 100644 --- a/base/psblas/psb_ddot.f90 +++ b/base/psblas/psb_ddot.f90 @@ -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' diff --git a/base/psblas/psb_dnrm2.f90 b/base/psblas/psb_dnrm2.f90 index f587581bd..01204fb0e 100644 --- a/base/psblas/psb_dnrm2.f90 +++ b/base/psblas/psb_dnrm2.f90 @@ -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' diff --git a/base/psblas/psb_dnrmi.f90 b/base/psblas/psb_dnrmi.f90 index 1dca687de..4c7cfd59d 100644 --- a/base/psblas/psb_dnrmi.f90 +++ b/base/psblas/psb_dnrmi.f90 @@ -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' diff --git a/base/psblas/psb_dspmm.f90 b/base/psblas/psb_dspmm.f90 index 2d5568279..30e793a26 100644 --- a/base/psblas/psb_dspmm.f90 +++ b/base/psblas/psb_dspmm.f90 @@ -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(:) diff --git a/base/psblas/psb_dspnrm1.f90 b/base/psblas/psb_dspnrm1.f90 index 9afab5e99..0cad9fe05 100644 --- a/base/psblas/psb_dspnrm1.f90 +++ b/base/psblas/psb_dspnrm1.f90 @@ -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(:) diff --git a/base/psblas/psb_dspsm.f90 b/base/psblas/psb_dspsm.f90 index 68fa718a1..d6de2aed0 100644 --- a/base/psblas/psb_dspsm.f90 +++ b/base/psblas/psb_dspsm.f90 @@ -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' diff --git a/base/psblas/psb_samax.f90 b/base/psblas/psb_samax.f90 index 456be8c65..0769bb2e6 100644 --- a/base/psblas/psb_samax.f90 +++ b/base/psblas/psb_samax.f90 @@ -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' diff --git a/base/psblas/psb_sasum.f90 b/base/psblas/psb_sasum.f90 index 10a1b9878..280871d1f 100644 --- a/base/psblas/psb_sasum.f90 +++ b/base/psblas/psb_sasum.f90 @@ -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' diff --git a/base/psblas/psb_saxpby.f90 b/base/psblas/psb_saxpby.f90 index 97fd4e7f4..4219289d7 100644 --- a/base/psblas/psb_saxpby.f90 +++ b/base/psblas/psb_saxpby.f90 @@ -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' diff --git a/base/psblas/psb_sdot.f90 b/base/psblas/psb_sdot.f90 index de7394bfc..6a6485c8c 100644 --- a/base/psblas/psb_sdot.f90 +++ b/base/psblas/psb_sdot.f90 @@ -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' diff --git a/base/psblas/psb_snrm2.f90 b/base/psblas/psb_snrm2.f90 index c112a5739..f7e617642 100644 --- a/base/psblas/psb_snrm2.f90 +++ b/base/psblas/psb_snrm2.f90 @@ -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' diff --git a/base/psblas/psb_snrmi.f90 b/base/psblas/psb_snrmi.f90 index eaeaf1273..8cfaebb38 100644 --- a/base/psblas/psb_snrmi.f90 +++ b/base/psblas/psb_snrmi.f90 @@ -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' diff --git a/base/psblas/psb_sspmm.f90 b/base/psblas/psb_sspmm.f90 index bb7d360c1..1d6cd17d6 100644 --- a/base/psblas/psb_sspmm.f90 +++ b/base/psblas/psb_sspmm.f90 @@ -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(:) diff --git a/base/psblas/psb_sspnrm1.f90 b/base/psblas/psb_sspnrm1.f90 index ea7cd6180..0673afa99 100644 --- a/base/psblas/psb_sspnrm1.f90 +++ b/base/psblas/psb_sspnrm1.f90 @@ -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(:) diff --git a/base/psblas/psb_sspsm.f90 b/base/psblas/psb_sspsm.f90 index d708b4aad..b91b22578 100644 --- a/base/psblas/psb_sspsm.f90 +++ b/base/psblas/psb_sspsm.f90 @@ -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' diff --git a/base/psblas/psb_zamax.f90 b/base/psblas/psb_zamax.f90 index b2032264c..caba6f7e9 100644 --- a/base/psblas/psb_zamax.f90 +++ b/base/psblas/psb_zamax.f90 @@ -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' diff --git a/base/psblas/psb_zasum.f90 b/base/psblas/psb_zasum.f90 index 3b4fadeec..732c4cb85 100644 --- a/base/psblas/psb_zasum.f90 +++ b/base/psblas/psb_zasum.f90 @@ -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' diff --git a/base/psblas/psb_zaxpby.f90 b/base/psblas/psb_zaxpby.f90 index 25ca548a2..a2e742dff 100644 --- a/base/psblas/psb_zaxpby.f90 +++ b/base/psblas/psb_zaxpby.f90 @@ -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' diff --git a/base/psblas/psb_zdot.f90 b/base/psblas/psb_zdot.f90 index 58c841c5b..66cf2c985 100644 --- a/base/psblas/psb_zdot.f90 +++ b/base/psblas/psb_zdot.f90 @@ -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' diff --git a/base/psblas/psb_znrm2.f90 b/base/psblas/psb_znrm2.f90 index 14022aee9..ce2b40ff3 100644 --- a/base/psblas/psb_znrm2.f90 +++ b/base/psblas/psb_znrm2.f90 @@ -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' diff --git a/base/psblas/psb_znrmi.f90 b/base/psblas/psb_znrmi.f90 index c917b7847..47b3a16e5 100644 --- a/base/psblas/psb_znrmi.f90 +++ b/base/psblas/psb_znrmi.f90 @@ -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' diff --git a/base/psblas/psb_zspmm.f90 b/base/psblas/psb_zspmm.f90 index a692822e8..f608b333b 100644 --- a/base/psblas/psb_zspmm.f90 +++ b/base/psblas/psb_zspmm.f90 @@ -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(:) diff --git a/base/psblas/psb_zspnrm1.f90 b/base/psblas/psb_zspnrm1.f90 index 19b5164c6..d15184c49 100644 --- a/base/psblas/psb_zspnrm1.f90 +++ b/base/psblas/psb_zspnrm1.f90 @@ -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(:) diff --git a/base/psblas/psb_zspsm.f90 b/base/psblas/psb_zspsm.f90 index 085edc3dc..6dad2031a 100644 --- a/base/psblas/psb_zspsm.f90 +++ b/base/psblas/psb_zspsm.f90 @@ -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'