From 660f0ccb280e436fae8a0d42305440c281106828 Mon Sep 17 00:00:00 2001 From: Salvatore Filippone Date: Tue, 24 Apr 2018 09:42:29 +0100 Subject: [PATCH] Cleanup usage if i_err. --- Changelog | 4 +++ base/comm/internals/psi_cswapdata.F90 | 32 ++++++++--------------- base/comm/internals/psi_cswapdata_a.F90 | 20 +++++---------- base/comm/internals/psi_cswaptran.F90 | 34 ++++++++----------------- base/comm/internals/psi_cswaptran_a.F90 | 22 +++++----------- base/comm/internals/psi_dswapdata.F90 | 32 ++++++++--------------- base/comm/internals/psi_dswapdata_a.F90 | 20 +++++---------- base/comm/internals/psi_dswaptran.F90 | 34 ++++++++----------------- base/comm/internals/psi_dswaptran_a.F90 | 22 +++++----------- base/comm/internals/psi_eswapdata_a.F90 | 20 +++++---------- base/comm/internals/psi_eswaptran_a.F90 | 22 +++++----------- base/comm/internals/psi_iswapdata.F90 | 32 ++++++++--------------- base/comm/internals/psi_iswaptran.F90 | 34 ++++++++----------------- base/comm/internals/psi_lswapdata.F90 | 32 ++++++++--------------- base/comm/internals/psi_lswaptran.F90 | 34 ++++++++----------------- base/comm/internals/psi_mswapdata_a.F90 | 20 +++++---------- base/comm/internals/psi_mswaptran_a.F90 | 22 +++++----------- base/comm/internals/psi_sswapdata.F90 | 32 ++++++++--------------- base/comm/internals/psi_sswapdata_a.F90 | 20 +++++---------- base/comm/internals/psi_sswaptran.F90 | 34 ++++++++----------------- base/comm/internals/psi_sswaptran_a.F90 | 22 +++++----------- base/comm/internals/psi_zswapdata.F90 | 32 ++++++++--------------- base/comm/internals/psi_zswapdata_a.F90 | 20 +++++---------- base/comm/internals/psi_zswaptran.F90 | 34 ++++++++----------------- base/comm/internals/psi_zswaptran_a.F90 | 22 +++++----------- base/modules/comm/psb_c_linmap_mod.f90 | 4 +-- base/modules/comm/psb_d_linmap_mod.f90 | 4 +-- base/modules/comm/psb_s_linmap_mod.f90 | 4 +-- base/modules/comm/psb_z_linmap_mod.f90 | 4 +-- base/serial/impl/psb_c_csr_impl.f90 | 33 ++++++------------------ base/serial/impl/psb_d_csr_impl.f90 | 33 ++++++------------------ base/serial/impl/psb_s_csr_impl.f90 | 33 ++++++------------------ base/serial/impl/psb_z_csr_impl.f90 | 33 ++++++------------------ base/tools/psb_casb.f90 | 9 +++---- base/tools/psb_casb_a.f90 | 3 +-- base/tools/psb_cspasb.f90 | 2 -- base/tools/psb_cspins.f90 | 27 ++++++-------------- base/tools/psb_csprn.f90 | 5 +--- base/tools/psb_dasb.f90 | 9 +++---- base/tools/psb_dasb_a.f90 | 3 +-- base/tools/psb_dspasb.f90 | 2 -- base/tools/psb_dspins.f90 | 27 ++++++-------------- base/tools/psb_dsprn.f90 | 5 +--- base/tools/psb_easb_a.f90 | 3 +-- base/tools/psb_iasb.f90 | 9 +++---- base/tools/psb_lasb.f90 | 9 +++---- base/tools/psb_masb_a.f90 | 3 +-- base/tools/psb_sasb.f90 | 9 +++---- base/tools/psb_sasb_a.f90 | 3 +-- base/tools/psb_sspasb.f90 | 2 -- base/tools/psb_sspins.f90 | 27 ++++++-------------- base/tools/psb_ssprn.f90 | 5 +--- base/tools/psb_zasb.f90 | 9 +++---- base/tools/psb_zasb_a.f90 | 3 +-- base/tools/psb_zspasb.f90 | 2 -- base/tools/psb_zspins.f90 | 27 ++++++-------------- base/tools/psb_zsprn.f90 | 5 +--- krylov/psb_c_krylov_conv_mod.f90 | 10 +++----- krylov/psb_cbicg.f90 | 4 +-- krylov/psb_ccg.F90 | 2 +- krylov/psb_ccgs.f90 | 2 +- krylov/psb_ccgstabl.f90 | 5 ++-- krylov/psb_cgcr.f90 | 7 ++--- krylov/psb_crgmres.f90 | 8 +++--- krylov/psb_d_krylov_conv_mod.f90 | 10 +++----- krylov/psb_dbicg.f90 | 4 +-- krylov/psb_dcg.F90 | 2 +- krylov/psb_dcgs.f90 | 2 +- krylov/psb_dcgstabl.f90 | 5 ++-- krylov/psb_dgcr.f90 | 7 ++--- krylov/psb_drgmres.f90 | 8 +++--- krylov/psb_s_krylov_conv_mod.f90 | 10 +++----- krylov/psb_sbicg.f90 | 4 +-- krylov/psb_scg.F90 | 2 +- krylov/psb_scgs.f90 | 2 +- krylov/psb_scgstabl.f90 | 5 ++-- krylov/psb_sgcr.f90 | 7 ++--- krylov/psb_srgmres.f90 | 8 +++--- krylov/psb_z_krylov_conv_mod.f90 | 10 +++----- krylov/psb_zbicg.f90 | 4 +-- krylov/psb_zcg.F90 | 2 +- krylov/psb_zcgs.f90 | 2 +- krylov/psb_zcgstabl.f90 | 5 ++-- krylov/psb_zgcr.f90 | 7 ++--- krylov/psb_zrgmres.f90 | 8 +++--- prec/impl/psb_cprecbld.f90 | 3 --- prec/impl/psb_dprecbld.f90 | 3 --- prec/impl/psb_sprecbld.f90 | 3 --- prec/impl/psb_zprecbld.f90 | 3 --- util/psb_c_mat_dist_impl.f90 | 5 ++-- util/psb_d_mat_dist_impl.f90 | 5 ++-- util/psb_s_mat_dist_impl.f90 | 5 ++-- util/psb_z_mat_dist_impl.f90 | 5 ++-- 93 files changed, 356 insertions(+), 836 deletions(-) diff --git a/Changelog b/Changelog index 87a08b55d..c9c769301 100644 --- a/Changelog +++ b/Changelog @@ -1,5 +1,9 @@ Changelog. A lot less detailed than usual, at least for past history. +2018/04/24: Merged changes to error handling internals. +2018/04/23: Change default for CDALL with VL. New GLOBAL argument for + reductions. +2018/04/15: Fixed pargen benchmark programs. Made MOLD mandatory. 2018/01/10: Updated docs. 2017/12/15: Fixed preconditioner build. 2017/10/31: Updated target install directories. diff --git a/base/comm/internals/psi_cswapdata.F90 b/base/comm/internals/psi_cswapdata.F90 index 41bf48a72..4b5e0f617 100644 --- a/base/comm/internals/psi_cswapdata.F90 +++ b/base/comm/internals/psi_cswapdata.F90 @@ -208,7 +208,6 @@ subroutine psi_cswap_vidx_vect(iictxt,iicomm,flag,beta,y,idx, & integer(psb_ipk_) :: nesd, nerv,& & err_act, i, idx_pt, totsnd_, totrcv_,& & snd_pt, rcv_pt, pnti, n - integer(psb_ipk_) :: ierr(5) logical :: swap_mpi, swap_sync, swap_send, swap_recv,& & albf,do_send,do_recv logical, parameter :: usersend=.false., debug=.false. @@ -247,8 +246,7 @@ subroutine psi_cswap_vidx_vect(iictxt,iicomm,flag,beta,y,idx, & ! Unfinished communication? Something is wrong.... ! info=psb_err_mpi_error_ - ierr(1) = -2 - call psb_errpush(info,name,i_err=ierr) + call psb_errpush(info,name,m_err=(/-2/)) goto 9999 end if end if @@ -318,9 +316,8 @@ subroutine psi_cswap_vidx_vect(iictxt,iicomm,flag,beta,y,idx, & end if if(iret /= mpi_success) then - ierr(1) = iret info=psb_err_mpi_error_ - call psb_errpush(info,name,i_err=ierr) + call psb_errpush(info,name,m_err=(/iret/)) goto 9999 end if @@ -335,8 +332,7 @@ subroutine psi_cswap_vidx_vect(iictxt,iicomm,flag,beta,y,idx, & ! No matching send? Something is wrong.... ! info=psb_err_mpi_error_ - ierr(1) = -2 - call psb_errpush(info,name,i_err=ierr) + call psb_errpush(info,name,m_err=(/-2/)) goto 9999 end if call psb_realloc(totxch,prcid,info) @@ -355,18 +351,16 @@ subroutine psi_cswap_vidx_vect(iictxt,iicomm,flag,beta,y,idx, & if (nesd>0) then call mpi_wait(y%comid(i,1),p2pstat,iret) if(iret /= mpi_success) then - ierr(1) = iret info=psb_err_mpi_error_ - call psb_errpush(info,name,i_err=ierr) + call psb_errpush(info,name,m_err=(/iret/)) goto 9999 end if end if if (nerv>0) then call mpi_wait(y%comid(i,2),p2pstat,iret) if(iret /= mpi_success) then - ierr(1) = iret info=psb_err_mpi_error_ - call psb_errpush(info,name,i_err=ierr) + call psb_errpush(info,name,m_err=(/iret/)) goto 9999 end if end if @@ -551,7 +545,6 @@ subroutine psi_cswap_vidx_multivect(iictxt,iicomm,flag,beta,y,idx, & integer(psb_ipk_) :: nesd, nerv,& & err_act, i, idx_pt, totsnd_, totrcv_,& & snd_pt, rcv_pt, pnti, n - integer(psb_ipk_) :: ierr(5) logical :: swap_mpi, swap_sync, swap_send, swap_recv,& & albf,do_send,do_recv logical, parameter :: usersend=.false., debug=.false. @@ -592,8 +585,7 @@ subroutine psi_cswap_vidx_multivect(iictxt,iicomm,flag,beta,y,idx, & ! Unfinished communication? Something is wrong.... ! info=psb_err_mpi_error_ - ierr(1) = -2 - call psb_errpush(info,name,i_err=ierr) + call psb_errpush(info,name,m_err=(/-2/)) goto 9999 end if end if @@ -665,9 +657,8 @@ subroutine psi_cswap_vidx_multivect(iictxt,iicomm,flag,beta,y,idx, & end if if(iret /= mpi_success) then - ierr(1) = iret info=psb_err_mpi_error_ - call psb_errpush(info,name,i_err=ierr) + call psb_errpush(info,name,m_err=(/iret/)) goto 9999 end if rcv_pt = rcv_pt + n*nerv @@ -683,8 +674,7 @@ subroutine psi_cswap_vidx_multivect(iictxt,iicomm,flag,beta,y,idx, & ! No matching send? Something is wrong.... ! info=psb_err_mpi_error_ - ierr(1) = -2 - call psb_errpush(info,name,i_err=ierr) + call psb_errpush(info,name,m_err=(/-2/)) goto 9999 end if call psb_realloc(totxch,prcid,info) @@ -702,18 +692,16 @@ subroutine psi_cswap_vidx_multivect(iictxt,iicomm,flag,beta,y,idx, & if (nesd>0) then call mpi_wait(y%comid(i,1),p2pstat,iret) if(iret /= mpi_success) then - ierr(1) = iret info=psb_err_mpi_error_ - call psb_errpush(info,name,i_err=ierr) + call psb_errpush(info,name,m_err=(/iret/)) goto 9999 end if end if if (nerv>0) then call mpi_wait(y%comid(i,2),p2pstat,iret) if(iret /= mpi_success) then - ierr(1) = iret info=psb_err_mpi_error_ - call psb_errpush(info,name,i_err=ierr) + call psb_errpush(info,name,m_err=(/iret/)) goto 9999 end if end if diff --git a/base/comm/internals/psi_cswapdata_a.F90 b/base/comm/internals/psi_cswapdata_a.F90 index 222d4fb4c..d0b06fa3c 100644 --- a/base/comm/internals/psi_cswapdata_a.F90 +++ b/base/comm/internals/psi_cswapdata_a.F90 @@ -180,7 +180,6 @@ subroutine psi_cswapidxm(iictxt,iicomm,flag,n,beta,y,idx, & integer(psb_ipk_) :: nesd, nerv,& & err_act, i, idx_pt, totsnd_, totrcv_,& & snd_pt, rcv_pt, pnti - integer(psb_ipk_) :: ierr(5) logical :: swap_mpi, swap_sync, swap_send, swap_recv,& & albf,do_send,do_recv logical, parameter :: usersend=.false. @@ -300,9 +299,8 @@ subroutine psi_cswapidxm(iictxt,iicomm,flag,n,beta,y,idx, & & psb_mpi_c_spk_,rcvbuf,rvsz,& & brvidx,psb_mpi_c_spk_,icomm,iret) if(iret /= mpi_success) then - ierr(1) = iret info=psb_err_mpi_error_ - call psb_errpush(info,name,i_err=ierr) + call psb_errpush(info,name,m_err=(/iret/)) goto 9999 end if @@ -388,9 +386,8 @@ subroutine psi_cswapidxm(iictxt,iicomm,flag,n,beta,y,idx, & end if if(iret /= mpi_success) then - ierr(1) = iret info=psb_err_mpi_error_ - call psb_errpush(info,name,i_err=ierr) + call psb_errpush(info,name,m_err=(/iret/)) goto 9999 end if end if @@ -412,9 +409,8 @@ subroutine psi_cswapidxm(iictxt,iicomm,flag,n,beta,y,idx, & if ((proc_to_comm /= me).and.(nerv>0)) then call mpi_wait(rvhd(i),p2pstat,iret) if(iret /= mpi_success) then - ierr(1) = iret info=psb_err_mpi_error_ - call psb_errpush(info,name,i_err=ierr) + call psb_errpush(info,name,m_err=(/iret/)) goto 9999 end if else if (proc_to_comm == me) then @@ -669,7 +665,6 @@ subroutine psi_cswapidxv(iictxt,iicomm,flag,beta,y,idx, & integer(psb_ipk_) :: nesd, nerv,& & err_act, i, idx_pt, totsnd_, totrcv_,& & snd_pt, rcv_pt, pnti, n - integer(psb_ipk_) :: ierr(5) logical :: swap_mpi, swap_sync, swap_send, swap_recv,& & albf,do_send,do_recv logical, parameter :: usersend=.false. @@ -790,9 +785,8 @@ subroutine psi_cswapidxv(iictxt,iicomm,flag,beta,y,idx, & & psb_mpi_c_spk_,rcvbuf,rvsz,& & brvidx,psb_mpi_c_spk_,icomm,iret) if(iret /= mpi_success) then - ierr(1) = iret info=psb_err_mpi_error_ - call psb_errpush(info,name,i_err=ierr) + call psb_errpush(info,name,m_err=(/iret/)) goto 9999 end if @@ -879,9 +873,8 @@ subroutine psi_cswapidxv(iictxt,iicomm,flag,beta,y,idx, & end if if(iret /= mpi_success) then - ierr(1) = iret info=psb_err_mpi_error_ - call psb_errpush(info,name,i_err=ierr) + call psb_errpush(info,name,m_err=(/iret/)) goto 9999 end if end if @@ -901,9 +894,8 @@ subroutine psi_cswapidxv(iictxt,iicomm,flag,beta,y,idx, & if ((proc_to_comm /= me).and.(nerv>0)) then call mpi_wait(rvhd(i),p2pstat,iret) if(iret /= mpi_success) then - ierr(1) = iret info=psb_err_mpi_error_ - call psb_errpush(info,name,i_err=ierr) + call psb_errpush(info,name,m_err=(/iret/)) goto 9999 end if else if (proc_to_comm == me) then diff --git a/base/comm/internals/psi_cswaptran.F90 b/base/comm/internals/psi_cswaptran.F90 index 1c074db48..2953783a7 100644 --- a/base/comm/internals/psi_cswaptran.F90 +++ b/base/comm/internals/psi_cswaptran.F90 @@ -120,7 +120,6 @@ subroutine psi_cswaptran_vect(flag,beta,y,desc_a,work,info,data) ! locals integer(psb_ipk_) :: ictxt, np, me, icomm, idxs, idxr, totxch, err_act, data_ class(psb_i_base_vect_type), pointer :: d_vidx - integer(psb_ipk_) :: ierr(5) character(len=20) :: name info=psb_success_ @@ -212,7 +211,6 @@ subroutine psi_ctran_vidx_vect(iictxt,iicomm,flag,beta,y,idx,& integer(psb_ipk_) :: nesd, nerv,& & err_act, i, idx_pt, totsnd_, totrcv_,& & snd_pt, rcv_pt, pnti, n - integer(psb_ipk_) :: ierr(5) logical :: swap_mpi, swap_sync, swap_send, swap_recv,& & albf,do_send,do_recv logical, parameter :: usersend=.false., debug=.false. @@ -252,8 +250,7 @@ subroutine psi_ctran_vidx_vect(iictxt,iicomm,flag,beta,y,idx,& ! Unfinished communication? Something is wrong.... ! info=psb_err_mpi_error_ - ierr(1) = -2 - call psb_errpush(info,name,i_err=ierr) + call psb_errpush(info,name,m_err=(/-2/)) goto 9999 end if end if @@ -328,9 +325,8 @@ subroutine psi_ctran_vidx_vect(iictxt,iicomm,flag,beta,y,idx,& end if if(iret /= mpi_success) then - ierr(1) = iret info=psb_err_mpi_error_ - call psb_errpush(info,name,i_err=ierr) + call psb_errpush(info,name,m_err=(/iret/)) goto 9999 end if @@ -345,8 +341,7 @@ subroutine psi_ctran_vidx_vect(iictxt,iicomm,flag,beta,y,idx,& ! No matching send? Something is wrong.... ! info=psb_err_mpi_error_ - ierr(1) = -2 - call psb_errpush(info,name,i_err=ierr) + call psb_errpush(info,name,m_err=(/-2/)) goto 9999 end if call psb_realloc(totxch,prcid,info) @@ -365,18 +360,16 @@ subroutine psi_ctran_vidx_vect(iictxt,iicomm,flag,beta,y,idx,& if (nerv>0) then call mpi_wait(y%comid(i,1),p2pstat,iret) if(iret /= mpi_success) then - ierr(1) = iret info=psb_err_mpi_error_ - call psb_errpush(info,name,i_err=ierr) + call psb_errpush(info,name,m_err=(/iret/)) goto 9999 end if end if if (nesd>0) then call mpi_wait(y%comid(i,2),p2pstat,iret) if(iret /= mpi_success) then - ierr(1) = iret info=psb_err_mpi_error_ - call psb_errpush(info,name,i_err=ierr) + call psb_errpush(info,name,m_err=(/iret/)) goto 9999 end if end if @@ -475,7 +468,6 @@ subroutine psi_cswaptran_multivect(flag,beta,y,desc_a,work,info,data) ! locals integer(psb_ipk_) :: ictxt, np, me, icomm, idxs, idxr, totxch, err_act, data_ class(psb_i_base_vect_type), pointer :: d_vidx - integer(psb_ipk_) :: ierr(5) character(len=20) :: name info=psb_success_ @@ -566,7 +558,6 @@ subroutine psi_ctran_vidx_multivect(iictxt,iicomm,flag,beta,y,idx,& integer(psb_ipk_) :: nesd, nerv,& & err_act, i, idx_pt, totsnd_, totrcv_,& & snd_pt, rcv_pt, pnti, n - integer(psb_ipk_) :: ierr(5) logical :: swap_mpi, swap_sync, swap_send, swap_recv,& & albf,do_send,do_recv logical, parameter :: usersend=.false., debug=.false. @@ -607,8 +598,7 @@ subroutine psi_ctran_vidx_multivect(iictxt,iicomm,flag,beta,y,idx,& ! Unfinished communication? Something is wrong.... ! info=psb_err_mpi_error_ - ierr(1) = -2 - call psb_errpush(info,name,i_err=ierr) + call psb_errpush(info,name,m_err=(/-2/)) goto 9999 end if end if @@ -682,9 +672,8 @@ subroutine psi_ctran_vidx_multivect(iictxt,iicomm,flag,beta,y,idx,& end if if(iret /= mpi_success) then - ierr(1) = iret info=psb_err_mpi_error_ - call psb_errpush(info,name,i_err=ierr) + call psb_errpush(info,name,m_err=(/iret/)) goto 9999 end if rcv_pt = rcv_pt + n*nerv @@ -700,8 +689,7 @@ subroutine psi_ctran_vidx_multivect(iictxt,iicomm,flag,beta,y,idx,& ! No matching send? Something is wrong.... ! info=psb_err_mpi_error_ - ierr(1) = -2 - call psb_errpush(info,name,i_err=ierr) + call psb_errpush(info,name,m_err=(/-2/)) goto 9999 end if call psb_realloc(totxch,prcid,info) @@ -719,18 +707,16 @@ subroutine psi_ctran_vidx_multivect(iictxt,iicomm,flag,beta,y,idx,& if (nerv>0) then call mpi_wait(y%comid(i,1),p2pstat,iret) if(iret /= mpi_success) then - ierr(1) = iret info=psb_err_mpi_error_ - call psb_errpush(info,name,i_err=ierr) + call psb_errpush(info,name,m_err=(/iret/)) goto 9999 end if end if if (nesd>0) then call mpi_wait(y%comid(i,2),p2pstat,iret) if(iret /= mpi_success) then - ierr(1) = iret info=psb_err_mpi_error_ - call psb_errpush(info,name,i_err=ierr) + call psb_errpush(info,name,m_err=(/iret/)) goto 9999 end if end if diff --git a/base/comm/internals/psi_cswaptran_a.F90 b/base/comm/internals/psi_cswaptran_a.F90 index a2084573a..4a8b25952 100644 --- a/base/comm/internals/psi_cswaptran_a.F90 +++ b/base/comm/internals/psi_cswaptran_a.F90 @@ -111,7 +111,6 @@ subroutine psi_cswaptranm(flag,n,beta,y,desc_a,work,info,data) ! locals integer(psb_ipk_) :: ictxt, np, me, icomm, idxs, idxr, err_act, totxch, data_ integer(psb_ipk_), pointer :: d_idx(:) - integer(psb_ipk_) :: ierr(5) character(len=20) :: name info=psb_success_ @@ -186,7 +185,6 @@ subroutine psi_ctranidxm(iictxt,iicomm,flag,n,beta,y,idx,& integer(psb_ipk_) :: nesd, nerv,& & err_act, i, idx_pt, totsnd_, totrcv_,& & snd_pt, rcv_pt, pnti - integer(psb_ipk_) :: ierr(5) logical :: swap_mpi, swap_sync, swap_send, swap_recv,& & albf,do_send,do_recv logical, parameter :: usersend=.false. @@ -311,9 +309,8 @@ subroutine psi_ctranidxm(iictxt,iicomm,flag,n,beta,y,idx,& & psb_mpi_c_spk_,& & sndbuf,sdsz,bsdidx,psb_mpi_c_spk_,icomm,iret) if(iret /= mpi_success) then - ierr(1) = iret info=psb_err_mpi_error_ - call psb_errpush(info,name,i_err=ierr) + call psb_errpush(info,name,m_err=(/iret/)) goto 9999 end if @@ -399,9 +396,8 @@ subroutine psi_ctranidxm(iictxt,iicomm,flag,n,beta,y,idx,& end if if(iret /= mpi_success) then - ierr(1) = iret info=psb_err_mpi_error_ - call psb_errpush(info,name,i_err=ierr) + call psb_errpush(info,name,m_err=(/iret/)) goto 9999 end if end if @@ -423,9 +419,8 @@ subroutine psi_ctranidxm(iictxt,iicomm,flag,n,beta,y,idx,& if ((proc_to_comm /= me).and.(nesd>0)) then call mpi_wait(rvhd(i),p2pstat,iret) if(iret /= mpi_success) then - ierr(1) = iret info=psb_err_mpi_error_ - call psb_errpush(info,name,i_err=ierr) + call psb_errpush(info,name,m_err=(/iret/)) goto 9999 end if else if (proc_to_comm == me) then @@ -599,7 +594,6 @@ subroutine psi_cswaptranv(flag,beta,y,desc_a,work,info,data) ! locals integer(psb_ipk_) :: ictxt, np, me, icomm, idxs, idxr, totxch, err_act, data_ integer(psb_ipk_), pointer :: d_idx(:) - integer(psb_ipk_) :: ierr(5) character(len=20) :: name info=psb_success_ @@ -684,7 +678,6 @@ subroutine psi_ctranidxv(iictxt,iicomm,flag,beta,y,idx,& integer(psb_ipk_) :: nesd, nerv,& & err_act, i, idx_pt, totsnd_, totrcv_,& & snd_pt, rcv_pt, pnti, n - integer(psb_ipk_) :: ierr(5) logical :: swap_mpi, swap_sync, swap_send, swap_recv,& & albf,do_send,do_recv logical, parameter :: usersend=.false. @@ -810,9 +803,8 @@ subroutine psi_ctranidxv(iictxt,iicomm,flag,beta,y,idx,& & psb_mpi_c_spk_,& & sndbuf,sdsz,bsdidx,psb_mpi_c_spk_,icomm,iret) if(iret /= mpi_success) then - ierr(1) = iret info=psb_err_mpi_error_ - call psb_errpush(info,name,i_err=ierr) + call psb_errpush(info,name,m_err=(/iret/)) goto 9999 end if @@ -897,9 +889,8 @@ subroutine psi_ctranidxv(iictxt,iicomm,flag,beta,y,idx,& end if if(iret /= mpi_success) then - ierr(1) = iret info=psb_err_mpi_error_ - call psb_errpush(info,name,i_err=ierr) + call psb_errpush(info,name,m_err=(/iret/)) goto 9999 end if end if @@ -919,9 +910,8 @@ subroutine psi_ctranidxv(iictxt,iicomm,flag,beta,y,idx,& if ((proc_to_comm /= me).and.(nesd>0)) then call mpi_wait(rvhd(i),p2pstat,iret) if(iret /= mpi_success) then - ierr(1) = iret info=psb_err_mpi_error_ - call psb_errpush(info,name,i_err=ierr) + call psb_errpush(info,name,m_err=(/iret/)) goto 9999 end if else if (proc_to_comm == me) then diff --git a/base/comm/internals/psi_dswapdata.F90 b/base/comm/internals/psi_dswapdata.F90 index 6c7ae343a..ff0845e66 100644 --- a/base/comm/internals/psi_dswapdata.F90 +++ b/base/comm/internals/psi_dswapdata.F90 @@ -208,7 +208,6 @@ subroutine psi_dswap_vidx_vect(iictxt,iicomm,flag,beta,y,idx, & integer(psb_ipk_) :: nesd, nerv,& & err_act, i, idx_pt, totsnd_, totrcv_,& & snd_pt, rcv_pt, pnti, n - integer(psb_ipk_) :: ierr(5) logical :: swap_mpi, swap_sync, swap_send, swap_recv,& & albf,do_send,do_recv logical, parameter :: usersend=.false., debug=.false. @@ -247,8 +246,7 @@ subroutine psi_dswap_vidx_vect(iictxt,iicomm,flag,beta,y,idx, & ! Unfinished communication? Something is wrong.... ! info=psb_err_mpi_error_ - ierr(1) = -2 - call psb_errpush(info,name,i_err=ierr) + call psb_errpush(info,name,m_err=(/-2/)) goto 9999 end if end if @@ -318,9 +316,8 @@ subroutine psi_dswap_vidx_vect(iictxt,iicomm,flag,beta,y,idx, & end if if(iret /= mpi_success) then - ierr(1) = iret info=psb_err_mpi_error_ - call psb_errpush(info,name,i_err=ierr) + call psb_errpush(info,name,m_err=(/iret/)) goto 9999 end if @@ -335,8 +332,7 @@ subroutine psi_dswap_vidx_vect(iictxt,iicomm,flag,beta,y,idx, & ! No matching send? Something is wrong.... ! info=psb_err_mpi_error_ - ierr(1) = -2 - call psb_errpush(info,name,i_err=ierr) + call psb_errpush(info,name,m_err=(/-2/)) goto 9999 end if call psb_realloc(totxch,prcid,info) @@ -355,18 +351,16 @@ subroutine psi_dswap_vidx_vect(iictxt,iicomm,flag,beta,y,idx, & if (nesd>0) then call mpi_wait(y%comid(i,1),p2pstat,iret) if(iret /= mpi_success) then - ierr(1) = iret info=psb_err_mpi_error_ - call psb_errpush(info,name,i_err=ierr) + call psb_errpush(info,name,m_err=(/iret/)) goto 9999 end if end if if (nerv>0) then call mpi_wait(y%comid(i,2),p2pstat,iret) if(iret /= mpi_success) then - ierr(1) = iret info=psb_err_mpi_error_ - call psb_errpush(info,name,i_err=ierr) + call psb_errpush(info,name,m_err=(/iret/)) goto 9999 end if end if @@ -551,7 +545,6 @@ subroutine psi_dswap_vidx_multivect(iictxt,iicomm,flag,beta,y,idx, & integer(psb_ipk_) :: nesd, nerv,& & err_act, i, idx_pt, totsnd_, totrcv_,& & snd_pt, rcv_pt, pnti, n - integer(psb_ipk_) :: ierr(5) logical :: swap_mpi, swap_sync, swap_send, swap_recv,& & albf,do_send,do_recv logical, parameter :: usersend=.false., debug=.false. @@ -592,8 +585,7 @@ subroutine psi_dswap_vidx_multivect(iictxt,iicomm,flag,beta,y,idx, & ! Unfinished communication? Something is wrong.... ! info=psb_err_mpi_error_ - ierr(1) = -2 - call psb_errpush(info,name,i_err=ierr) + call psb_errpush(info,name,m_err=(/-2/)) goto 9999 end if end if @@ -665,9 +657,8 @@ subroutine psi_dswap_vidx_multivect(iictxt,iicomm,flag,beta,y,idx, & end if if(iret /= mpi_success) then - ierr(1) = iret info=psb_err_mpi_error_ - call psb_errpush(info,name,i_err=ierr) + call psb_errpush(info,name,m_err=(/iret/)) goto 9999 end if rcv_pt = rcv_pt + n*nerv @@ -683,8 +674,7 @@ subroutine psi_dswap_vidx_multivect(iictxt,iicomm,flag,beta,y,idx, & ! No matching send? Something is wrong.... ! info=psb_err_mpi_error_ - ierr(1) = -2 - call psb_errpush(info,name,i_err=ierr) + call psb_errpush(info,name,m_err=(/-2/)) goto 9999 end if call psb_realloc(totxch,prcid,info) @@ -702,18 +692,16 @@ subroutine psi_dswap_vidx_multivect(iictxt,iicomm,flag,beta,y,idx, & if (nesd>0) then call mpi_wait(y%comid(i,1),p2pstat,iret) if(iret /= mpi_success) then - ierr(1) = iret info=psb_err_mpi_error_ - call psb_errpush(info,name,i_err=ierr) + call psb_errpush(info,name,m_err=(/iret/)) goto 9999 end if end if if (nerv>0) then call mpi_wait(y%comid(i,2),p2pstat,iret) if(iret /= mpi_success) then - ierr(1) = iret info=psb_err_mpi_error_ - call psb_errpush(info,name,i_err=ierr) + call psb_errpush(info,name,m_err=(/iret/)) goto 9999 end if end if diff --git a/base/comm/internals/psi_dswapdata_a.F90 b/base/comm/internals/psi_dswapdata_a.F90 index 8ecb60596..ec330ef75 100644 --- a/base/comm/internals/psi_dswapdata_a.F90 +++ b/base/comm/internals/psi_dswapdata_a.F90 @@ -180,7 +180,6 @@ subroutine psi_dswapidxm(iictxt,iicomm,flag,n,beta,y,idx, & integer(psb_ipk_) :: nesd, nerv,& & err_act, i, idx_pt, totsnd_, totrcv_,& & snd_pt, rcv_pt, pnti - integer(psb_ipk_) :: ierr(5) logical :: swap_mpi, swap_sync, swap_send, swap_recv,& & albf,do_send,do_recv logical, parameter :: usersend=.false. @@ -300,9 +299,8 @@ subroutine psi_dswapidxm(iictxt,iicomm,flag,n,beta,y,idx, & & psb_mpi_r_dpk_,rcvbuf,rvsz,& & brvidx,psb_mpi_r_dpk_,icomm,iret) if(iret /= mpi_success) then - ierr(1) = iret info=psb_err_mpi_error_ - call psb_errpush(info,name,i_err=ierr) + call psb_errpush(info,name,m_err=(/iret/)) goto 9999 end if @@ -388,9 +386,8 @@ subroutine psi_dswapidxm(iictxt,iicomm,flag,n,beta,y,idx, & end if if(iret /= mpi_success) then - ierr(1) = iret info=psb_err_mpi_error_ - call psb_errpush(info,name,i_err=ierr) + call psb_errpush(info,name,m_err=(/iret/)) goto 9999 end if end if @@ -412,9 +409,8 @@ subroutine psi_dswapidxm(iictxt,iicomm,flag,n,beta,y,idx, & if ((proc_to_comm /= me).and.(nerv>0)) then call mpi_wait(rvhd(i),p2pstat,iret) if(iret /= mpi_success) then - ierr(1) = iret info=psb_err_mpi_error_ - call psb_errpush(info,name,i_err=ierr) + call psb_errpush(info,name,m_err=(/iret/)) goto 9999 end if else if (proc_to_comm == me) then @@ -669,7 +665,6 @@ subroutine psi_dswapidxv(iictxt,iicomm,flag,beta,y,idx, & integer(psb_ipk_) :: nesd, nerv,& & err_act, i, idx_pt, totsnd_, totrcv_,& & snd_pt, rcv_pt, pnti, n - integer(psb_ipk_) :: ierr(5) logical :: swap_mpi, swap_sync, swap_send, swap_recv,& & albf,do_send,do_recv logical, parameter :: usersend=.false. @@ -790,9 +785,8 @@ subroutine psi_dswapidxv(iictxt,iicomm,flag,beta,y,idx, & & psb_mpi_r_dpk_,rcvbuf,rvsz,& & brvidx,psb_mpi_r_dpk_,icomm,iret) if(iret /= mpi_success) then - ierr(1) = iret info=psb_err_mpi_error_ - call psb_errpush(info,name,i_err=ierr) + call psb_errpush(info,name,m_err=(/iret/)) goto 9999 end if @@ -879,9 +873,8 @@ subroutine psi_dswapidxv(iictxt,iicomm,flag,beta,y,idx, & end if if(iret /= mpi_success) then - ierr(1) = iret info=psb_err_mpi_error_ - call psb_errpush(info,name,i_err=ierr) + call psb_errpush(info,name,m_err=(/iret/)) goto 9999 end if end if @@ -901,9 +894,8 @@ subroutine psi_dswapidxv(iictxt,iicomm,flag,beta,y,idx, & if ((proc_to_comm /= me).and.(nerv>0)) then call mpi_wait(rvhd(i),p2pstat,iret) if(iret /= mpi_success) then - ierr(1) = iret info=psb_err_mpi_error_ - call psb_errpush(info,name,i_err=ierr) + call psb_errpush(info,name,m_err=(/iret/)) goto 9999 end if else if (proc_to_comm == me) then diff --git a/base/comm/internals/psi_dswaptran.F90 b/base/comm/internals/psi_dswaptran.F90 index e0ffb0e33..179e083a2 100644 --- a/base/comm/internals/psi_dswaptran.F90 +++ b/base/comm/internals/psi_dswaptran.F90 @@ -120,7 +120,6 @@ subroutine psi_dswaptran_vect(flag,beta,y,desc_a,work,info,data) ! locals integer(psb_ipk_) :: ictxt, np, me, icomm, idxs, idxr, totxch, err_act, data_ class(psb_i_base_vect_type), pointer :: d_vidx - integer(psb_ipk_) :: ierr(5) character(len=20) :: name info=psb_success_ @@ -212,7 +211,6 @@ subroutine psi_dtran_vidx_vect(iictxt,iicomm,flag,beta,y,idx,& integer(psb_ipk_) :: nesd, nerv,& & err_act, i, idx_pt, totsnd_, totrcv_,& & snd_pt, rcv_pt, pnti, n - integer(psb_ipk_) :: ierr(5) logical :: swap_mpi, swap_sync, swap_send, swap_recv,& & albf,do_send,do_recv logical, parameter :: usersend=.false., debug=.false. @@ -252,8 +250,7 @@ subroutine psi_dtran_vidx_vect(iictxt,iicomm,flag,beta,y,idx,& ! Unfinished communication? Something is wrong.... ! info=psb_err_mpi_error_ - ierr(1) = -2 - call psb_errpush(info,name,i_err=ierr) + call psb_errpush(info,name,m_err=(/-2/)) goto 9999 end if end if @@ -328,9 +325,8 @@ subroutine psi_dtran_vidx_vect(iictxt,iicomm,flag,beta,y,idx,& end if if(iret /= mpi_success) then - ierr(1) = iret info=psb_err_mpi_error_ - call psb_errpush(info,name,i_err=ierr) + call psb_errpush(info,name,m_err=(/iret/)) goto 9999 end if @@ -345,8 +341,7 @@ subroutine psi_dtran_vidx_vect(iictxt,iicomm,flag,beta,y,idx,& ! No matching send? Something is wrong.... ! info=psb_err_mpi_error_ - ierr(1) = -2 - call psb_errpush(info,name,i_err=ierr) + call psb_errpush(info,name,m_err=(/-2/)) goto 9999 end if call psb_realloc(totxch,prcid,info) @@ -365,18 +360,16 @@ subroutine psi_dtran_vidx_vect(iictxt,iicomm,flag,beta,y,idx,& if (nerv>0) then call mpi_wait(y%comid(i,1),p2pstat,iret) if(iret /= mpi_success) then - ierr(1) = iret info=psb_err_mpi_error_ - call psb_errpush(info,name,i_err=ierr) + call psb_errpush(info,name,m_err=(/iret/)) goto 9999 end if end if if (nesd>0) then call mpi_wait(y%comid(i,2),p2pstat,iret) if(iret /= mpi_success) then - ierr(1) = iret info=psb_err_mpi_error_ - call psb_errpush(info,name,i_err=ierr) + call psb_errpush(info,name,m_err=(/iret/)) goto 9999 end if end if @@ -475,7 +468,6 @@ subroutine psi_dswaptran_multivect(flag,beta,y,desc_a,work,info,data) ! locals integer(psb_ipk_) :: ictxt, np, me, icomm, idxs, idxr, totxch, err_act, data_ class(psb_i_base_vect_type), pointer :: d_vidx - integer(psb_ipk_) :: ierr(5) character(len=20) :: name info=psb_success_ @@ -566,7 +558,6 @@ subroutine psi_dtran_vidx_multivect(iictxt,iicomm,flag,beta,y,idx,& integer(psb_ipk_) :: nesd, nerv,& & err_act, i, idx_pt, totsnd_, totrcv_,& & snd_pt, rcv_pt, pnti, n - integer(psb_ipk_) :: ierr(5) logical :: swap_mpi, swap_sync, swap_send, swap_recv,& & albf,do_send,do_recv logical, parameter :: usersend=.false., debug=.false. @@ -607,8 +598,7 @@ subroutine psi_dtran_vidx_multivect(iictxt,iicomm,flag,beta,y,idx,& ! Unfinished communication? Something is wrong.... ! info=psb_err_mpi_error_ - ierr(1) = -2 - call psb_errpush(info,name,i_err=ierr) + call psb_errpush(info,name,m_err=(/-2/)) goto 9999 end if end if @@ -682,9 +672,8 @@ subroutine psi_dtran_vidx_multivect(iictxt,iicomm,flag,beta,y,idx,& end if if(iret /= mpi_success) then - ierr(1) = iret info=psb_err_mpi_error_ - call psb_errpush(info,name,i_err=ierr) + call psb_errpush(info,name,m_err=(/iret/)) goto 9999 end if rcv_pt = rcv_pt + n*nerv @@ -700,8 +689,7 @@ subroutine psi_dtran_vidx_multivect(iictxt,iicomm,flag,beta,y,idx,& ! No matching send? Something is wrong.... ! info=psb_err_mpi_error_ - ierr(1) = -2 - call psb_errpush(info,name,i_err=ierr) + call psb_errpush(info,name,m_err=(/-2/)) goto 9999 end if call psb_realloc(totxch,prcid,info) @@ -719,18 +707,16 @@ subroutine psi_dtran_vidx_multivect(iictxt,iicomm,flag,beta,y,idx,& if (nerv>0) then call mpi_wait(y%comid(i,1),p2pstat,iret) if(iret /= mpi_success) then - ierr(1) = iret info=psb_err_mpi_error_ - call psb_errpush(info,name,i_err=ierr) + call psb_errpush(info,name,m_err=(/iret/)) goto 9999 end if end if if (nesd>0) then call mpi_wait(y%comid(i,2),p2pstat,iret) if(iret /= mpi_success) then - ierr(1) = iret info=psb_err_mpi_error_ - call psb_errpush(info,name,i_err=ierr) + call psb_errpush(info,name,m_err=(/iret/)) goto 9999 end if end if diff --git a/base/comm/internals/psi_dswaptran_a.F90 b/base/comm/internals/psi_dswaptran_a.F90 index 2cf8a506c..ba648a15c 100644 --- a/base/comm/internals/psi_dswaptran_a.F90 +++ b/base/comm/internals/psi_dswaptran_a.F90 @@ -111,7 +111,6 @@ subroutine psi_dswaptranm(flag,n,beta,y,desc_a,work,info,data) ! locals integer(psb_ipk_) :: ictxt, np, me, icomm, idxs, idxr, err_act, totxch, data_ integer(psb_ipk_), pointer :: d_idx(:) - integer(psb_ipk_) :: ierr(5) character(len=20) :: name info=psb_success_ @@ -186,7 +185,6 @@ subroutine psi_dtranidxm(iictxt,iicomm,flag,n,beta,y,idx,& integer(psb_ipk_) :: nesd, nerv,& & err_act, i, idx_pt, totsnd_, totrcv_,& & snd_pt, rcv_pt, pnti - integer(psb_ipk_) :: ierr(5) logical :: swap_mpi, swap_sync, swap_send, swap_recv,& & albf,do_send,do_recv logical, parameter :: usersend=.false. @@ -311,9 +309,8 @@ subroutine psi_dtranidxm(iictxt,iicomm,flag,n,beta,y,idx,& & psb_mpi_r_dpk_,& & sndbuf,sdsz,bsdidx,psb_mpi_r_dpk_,icomm,iret) if(iret /= mpi_success) then - ierr(1) = iret info=psb_err_mpi_error_ - call psb_errpush(info,name,i_err=ierr) + call psb_errpush(info,name,m_err=(/iret/)) goto 9999 end if @@ -399,9 +396,8 @@ subroutine psi_dtranidxm(iictxt,iicomm,flag,n,beta,y,idx,& end if if(iret /= mpi_success) then - ierr(1) = iret info=psb_err_mpi_error_ - call psb_errpush(info,name,i_err=ierr) + call psb_errpush(info,name,m_err=(/iret/)) goto 9999 end if end if @@ -423,9 +419,8 @@ subroutine psi_dtranidxm(iictxt,iicomm,flag,n,beta,y,idx,& if ((proc_to_comm /= me).and.(nesd>0)) then call mpi_wait(rvhd(i),p2pstat,iret) if(iret /= mpi_success) then - ierr(1) = iret info=psb_err_mpi_error_ - call psb_errpush(info,name,i_err=ierr) + call psb_errpush(info,name,m_err=(/iret/)) goto 9999 end if else if (proc_to_comm == me) then @@ -599,7 +594,6 @@ subroutine psi_dswaptranv(flag,beta,y,desc_a,work,info,data) ! locals integer(psb_ipk_) :: ictxt, np, me, icomm, idxs, idxr, totxch, err_act, data_ integer(psb_ipk_), pointer :: d_idx(:) - integer(psb_ipk_) :: ierr(5) character(len=20) :: name info=psb_success_ @@ -684,7 +678,6 @@ subroutine psi_dtranidxv(iictxt,iicomm,flag,beta,y,idx,& integer(psb_ipk_) :: nesd, nerv,& & err_act, i, idx_pt, totsnd_, totrcv_,& & snd_pt, rcv_pt, pnti, n - integer(psb_ipk_) :: ierr(5) logical :: swap_mpi, swap_sync, swap_send, swap_recv,& & albf,do_send,do_recv logical, parameter :: usersend=.false. @@ -810,9 +803,8 @@ subroutine psi_dtranidxv(iictxt,iicomm,flag,beta,y,idx,& & psb_mpi_r_dpk_,& & sndbuf,sdsz,bsdidx,psb_mpi_r_dpk_,icomm,iret) if(iret /= mpi_success) then - ierr(1) = iret info=psb_err_mpi_error_ - call psb_errpush(info,name,i_err=ierr) + call psb_errpush(info,name,m_err=(/iret/)) goto 9999 end if @@ -897,9 +889,8 @@ subroutine psi_dtranidxv(iictxt,iicomm,flag,beta,y,idx,& end if if(iret /= mpi_success) then - ierr(1) = iret info=psb_err_mpi_error_ - call psb_errpush(info,name,i_err=ierr) + call psb_errpush(info,name,m_err=(/iret/)) goto 9999 end if end if @@ -919,9 +910,8 @@ subroutine psi_dtranidxv(iictxt,iicomm,flag,beta,y,idx,& if ((proc_to_comm /= me).and.(nesd>0)) then call mpi_wait(rvhd(i),p2pstat,iret) if(iret /= mpi_success) then - ierr(1) = iret info=psb_err_mpi_error_ - call psb_errpush(info,name,i_err=ierr) + call psb_errpush(info,name,m_err=(/iret/)) goto 9999 end if else if (proc_to_comm == me) then diff --git a/base/comm/internals/psi_eswapdata_a.F90 b/base/comm/internals/psi_eswapdata_a.F90 index 35364a9e6..a697ad914 100644 --- a/base/comm/internals/psi_eswapdata_a.F90 +++ b/base/comm/internals/psi_eswapdata_a.F90 @@ -180,7 +180,6 @@ subroutine psi_eswapidxm(iictxt,iicomm,flag,n,beta,y,idx, & integer(psb_ipk_) :: nesd, nerv,& & err_act, i, idx_pt, totsnd_, totrcv_,& & snd_pt, rcv_pt, pnti - integer(psb_ipk_) :: ierr(5) logical :: swap_mpi, swap_sync, swap_send, swap_recv,& & albf,do_send,do_recv logical, parameter :: usersend=.false. @@ -300,9 +299,8 @@ subroutine psi_eswapidxm(iictxt,iicomm,flag,n,beta,y,idx, & & psb_mpi_epk_,rcvbuf,rvsz,& & brvidx,psb_mpi_epk_,icomm,iret) if(iret /= mpi_success) then - ierr(1) = iret info=psb_err_mpi_error_ - call psb_errpush(info,name,i_err=ierr) + call psb_errpush(info,name,m_err=(/iret/)) goto 9999 end if @@ -388,9 +386,8 @@ subroutine psi_eswapidxm(iictxt,iicomm,flag,n,beta,y,idx, & end if if(iret /= mpi_success) then - ierr(1) = iret info=psb_err_mpi_error_ - call psb_errpush(info,name,i_err=ierr) + call psb_errpush(info,name,m_err=(/iret/)) goto 9999 end if end if @@ -412,9 +409,8 @@ subroutine psi_eswapidxm(iictxt,iicomm,flag,n,beta,y,idx, & if ((proc_to_comm /= me).and.(nerv>0)) then call mpi_wait(rvhd(i),p2pstat,iret) if(iret /= mpi_success) then - ierr(1) = iret info=psb_err_mpi_error_ - call psb_errpush(info,name,i_err=ierr) + call psb_errpush(info,name,m_err=(/iret/)) goto 9999 end if else if (proc_to_comm == me) then @@ -669,7 +665,6 @@ subroutine psi_eswapidxv(iictxt,iicomm,flag,beta,y,idx, & integer(psb_ipk_) :: nesd, nerv,& & err_act, i, idx_pt, totsnd_, totrcv_,& & snd_pt, rcv_pt, pnti, n - integer(psb_ipk_) :: ierr(5) logical :: swap_mpi, swap_sync, swap_send, swap_recv,& & albf,do_send,do_recv logical, parameter :: usersend=.false. @@ -790,9 +785,8 @@ subroutine psi_eswapidxv(iictxt,iicomm,flag,beta,y,idx, & & psb_mpi_epk_,rcvbuf,rvsz,& & brvidx,psb_mpi_epk_,icomm,iret) if(iret /= mpi_success) then - ierr(1) = iret info=psb_err_mpi_error_ - call psb_errpush(info,name,i_err=ierr) + call psb_errpush(info,name,m_err=(/iret/)) goto 9999 end if @@ -879,9 +873,8 @@ subroutine psi_eswapidxv(iictxt,iicomm,flag,beta,y,idx, & end if if(iret /= mpi_success) then - ierr(1) = iret info=psb_err_mpi_error_ - call psb_errpush(info,name,i_err=ierr) + call psb_errpush(info,name,m_err=(/iret/)) goto 9999 end if end if @@ -901,9 +894,8 @@ subroutine psi_eswapidxv(iictxt,iicomm,flag,beta,y,idx, & if ((proc_to_comm /= me).and.(nerv>0)) then call mpi_wait(rvhd(i),p2pstat,iret) if(iret /= mpi_success) then - ierr(1) = iret info=psb_err_mpi_error_ - call psb_errpush(info,name,i_err=ierr) + call psb_errpush(info,name,m_err=(/iret/)) goto 9999 end if else if (proc_to_comm == me) then diff --git a/base/comm/internals/psi_eswaptran_a.F90 b/base/comm/internals/psi_eswaptran_a.F90 index ea6161aa2..dec5932e9 100644 --- a/base/comm/internals/psi_eswaptran_a.F90 +++ b/base/comm/internals/psi_eswaptran_a.F90 @@ -111,7 +111,6 @@ subroutine psi_eswaptranm(flag,n,beta,y,desc_a,work,info,data) ! locals integer(psb_ipk_) :: ictxt, np, me, icomm, idxs, idxr, err_act, totxch, data_ integer(psb_ipk_), pointer :: d_idx(:) - integer(psb_ipk_) :: ierr(5) character(len=20) :: name info=psb_success_ @@ -186,7 +185,6 @@ subroutine psi_etranidxm(iictxt,iicomm,flag,n,beta,y,idx,& integer(psb_ipk_) :: nesd, nerv,& & err_act, i, idx_pt, totsnd_, totrcv_,& & snd_pt, rcv_pt, pnti - integer(psb_ipk_) :: ierr(5) logical :: swap_mpi, swap_sync, swap_send, swap_recv,& & albf,do_send,do_recv logical, parameter :: usersend=.false. @@ -311,9 +309,8 @@ subroutine psi_etranidxm(iictxt,iicomm,flag,n,beta,y,idx,& & psb_mpi_epk_,& & sndbuf,sdsz,bsdidx,psb_mpi_epk_,icomm,iret) if(iret /= mpi_success) then - ierr(1) = iret info=psb_err_mpi_error_ - call psb_errpush(info,name,i_err=ierr) + call psb_errpush(info,name,m_err=(/iret/)) goto 9999 end if @@ -399,9 +396,8 @@ subroutine psi_etranidxm(iictxt,iicomm,flag,n,beta,y,idx,& end if if(iret /= mpi_success) then - ierr(1) = iret info=psb_err_mpi_error_ - call psb_errpush(info,name,i_err=ierr) + call psb_errpush(info,name,m_err=(/iret/)) goto 9999 end if end if @@ -423,9 +419,8 @@ subroutine psi_etranidxm(iictxt,iicomm,flag,n,beta,y,idx,& if ((proc_to_comm /= me).and.(nesd>0)) then call mpi_wait(rvhd(i),p2pstat,iret) if(iret /= mpi_success) then - ierr(1) = iret info=psb_err_mpi_error_ - call psb_errpush(info,name,i_err=ierr) + call psb_errpush(info,name,m_err=(/iret/)) goto 9999 end if else if (proc_to_comm == me) then @@ -599,7 +594,6 @@ subroutine psi_eswaptranv(flag,beta,y,desc_a,work,info,data) ! locals integer(psb_ipk_) :: ictxt, np, me, icomm, idxs, idxr, totxch, err_act, data_ integer(psb_ipk_), pointer :: d_idx(:) - integer(psb_ipk_) :: ierr(5) character(len=20) :: name info=psb_success_ @@ -684,7 +678,6 @@ subroutine psi_etranidxv(iictxt,iicomm,flag,beta,y,idx,& integer(psb_ipk_) :: nesd, nerv,& & err_act, i, idx_pt, totsnd_, totrcv_,& & snd_pt, rcv_pt, pnti, n - integer(psb_ipk_) :: ierr(5) logical :: swap_mpi, swap_sync, swap_send, swap_recv,& & albf,do_send,do_recv logical, parameter :: usersend=.false. @@ -810,9 +803,8 @@ subroutine psi_etranidxv(iictxt,iicomm,flag,beta,y,idx,& & psb_mpi_epk_,& & sndbuf,sdsz,bsdidx,psb_mpi_epk_,icomm,iret) if(iret /= mpi_success) then - ierr(1) = iret info=psb_err_mpi_error_ - call psb_errpush(info,name,i_err=ierr) + call psb_errpush(info,name,m_err=(/iret/)) goto 9999 end if @@ -897,9 +889,8 @@ subroutine psi_etranidxv(iictxt,iicomm,flag,beta,y,idx,& end if if(iret /= mpi_success) then - ierr(1) = iret info=psb_err_mpi_error_ - call psb_errpush(info,name,i_err=ierr) + call psb_errpush(info,name,m_err=(/iret/)) goto 9999 end if end if @@ -919,9 +910,8 @@ subroutine psi_etranidxv(iictxt,iicomm,flag,beta,y,idx,& if ((proc_to_comm /= me).and.(nesd>0)) then call mpi_wait(rvhd(i),p2pstat,iret) if(iret /= mpi_success) then - ierr(1) = iret info=psb_err_mpi_error_ - call psb_errpush(info,name,i_err=ierr) + call psb_errpush(info,name,m_err=(/iret/)) goto 9999 end if else if (proc_to_comm == me) then diff --git a/base/comm/internals/psi_iswapdata.F90 b/base/comm/internals/psi_iswapdata.F90 index 2785985e1..4fa0fffb6 100644 --- a/base/comm/internals/psi_iswapdata.F90 +++ b/base/comm/internals/psi_iswapdata.F90 @@ -208,7 +208,6 @@ subroutine psi_iswap_vidx_vect(iictxt,iicomm,flag,beta,y,idx, & integer(psb_ipk_) :: nesd, nerv,& & err_act, i, idx_pt, totsnd_, totrcv_,& & snd_pt, rcv_pt, pnti, n - integer(psb_ipk_) :: ierr(5) logical :: swap_mpi, swap_sync, swap_send, swap_recv,& & albf,do_send,do_recv logical, parameter :: usersend=.false., debug=.false. @@ -247,8 +246,7 @@ subroutine psi_iswap_vidx_vect(iictxt,iicomm,flag,beta,y,idx, & ! Unfinished communication? Something is wrong.... ! info=psb_err_mpi_error_ - ierr(1) = -2 - call psb_errpush(info,name,i_err=ierr) + call psb_errpush(info,name,m_err=(/-2/)) goto 9999 end if end if @@ -318,9 +316,8 @@ subroutine psi_iswap_vidx_vect(iictxt,iicomm,flag,beta,y,idx, & end if if(iret /= mpi_success) then - ierr(1) = iret info=psb_err_mpi_error_ - call psb_errpush(info,name,i_err=ierr) + call psb_errpush(info,name,m_err=(/iret/)) goto 9999 end if @@ -335,8 +332,7 @@ subroutine psi_iswap_vidx_vect(iictxt,iicomm,flag,beta,y,idx, & ! No matching send? Something is wrong.... ! info=psb_err_mpi_error_ - ierr(1) = -2 - call psb_errpush(info,name,i_err=ierr) + call psb_errpush(info,name,m_err=(/-2/)) goto 9999 end if call psb_realloc(totxch,prcid,info) @@ -355,18 +351,16 @@ subroutine psi_iswap_vidx_vect(iictxt,iicomm,flag,beta,y,idx, & if (nesd>0) then call mpi_wait(y%comid(i,1),p2pstat,iret) if(iret /= mpi_success) then - ierr(1) = iret info=psb_err_mpi_error_ - call psb_errpush(info,name,i_err=ierr) + call psb_errpush(info,name,m_err=(/iret/)) goto 9999 end if end if if (nerv>0) then call mpi_wait(y%comid(i,2),p2pstat,iret) if(iret /= mpi_success) then - ierr(1) = iret info=psb_err_mpi_error_ - call psb_errpush(info,name,i_err=ierr) + call psb_errpush(info,name,m_err=(/iret/)) goto 9999 end if end if @@ -551,7 +545,6 @@ subroutine psi_iswap_vidx_multivect(iictxt,iicomm,flag,beta,y,idx, & integer(psb_ipk_) :: nesd, nerv,& & err_act, i, idx_pt, totsnd_, totrcv_,& & snd_pt, rcv_pt, pnti, n - integer(psb_ipk_) :: ierr(5) logical :: swap_mpi, swap_sync, swap_send, swap_recv,& & albf,do_send,do_recv logical, parameter :: usersend=.false., debug=.false. @@ -592,8 +585,7 @@ subroutine psi_iswap_vidx_multivect(iictxt,iicomm,flag,beta,y,idx, & ! Unfinished communication? Something is wrong.... ! info=psb_err_mpi_error_ - ierr(1) = -2 - call psb_errpush(info,name,i_err=ierr) + call psb_errpush(info,name,m_err=(/-2/)) goto 9999 end if end if @@ -665,9 +657,8 @@ subroutine psi_iswap_vidx_multivect(iictxt,iicomm,flag,beta,y,idx, & end if if(iret /= mpi_success) then - ierr(1) = iret info=psb_err_mpi_error_ - call psb_errpush(info,name,i_err=ierr) + call psb_errpush(info,name,m_err=(/iret/)) goto 9999 end if rcv_pt = rcv_pt + n*nerv @@ -683,8 +674,7 @@ subroutine psi_iswap_vidx_multivect(iictxt,iicomm,flag,beta,y,idx, & ! No matching send? Something is wrong.... ! info=psb_err_mpi_error_ - ierr(1) = -2 - call psb_errpush(info,name,i_err=ierr) + call psb_errpush(info,name,m_err=(/-2/)) goto 9999 end if call psb_realloc(totxch,prcid,info) @@ -702,18 +692,16 @@ subroutine psi_iswap_vidx_multivect(iictxt,iicomm,flag,beta,y,idx, & if (nesd>0) then call mpi_wait(y%comid(i,1),p2pstat,iret) if(iret /= mpi_success) then - ierr(1) = iret info=psb_err_mpi_error_ - call psb_errpush(info,name,i_err=ierr) + call psb_errpush(info,name,m_err=(/iret/)) goto 9999 end if end if if (nerv>0) then call mpi_wait(y%comid(i,2),p2pstat,iret) if(iret /= mpi_success) then - ierr(1) = iret info=psb_err_mpi_error_ - call psb_errpush(info,name,i_err=ierr) + call psb_errpush(info,name,m_err=(/iret/)) goto 9999 end if end if diff --git a/base/comm/internals/psi_iswaptran.F90 b/base/comm/internals/psi_iswaptran.F90 index 0264307db..6985b7c5c 100644 --- a/base/comm/internals/psi_iswaptran.F90 +++ b/base/comm/internals/psi_iswaptran.F90 @@ -120,7 +120,6 @@ subroutine psi_iswaptran_vect(flag,beta,y,desc_a,work,info,data) ! locals integer(psb_ipk_) :: ictxt, np, me, icomm, idxs, idxr, totxch, err_act, data_ class(psb_i_base_vect_type), pointer :: d_vidx - integer(psb_ipk_) :: ierr(5) character(len=20) :: name info=psb_success_ @@ -212,7 +211,6 @@ subroutine psi_itran_vidx_vect(iictxt,iicomm,flag,beta,y,idx,& integer(psb_ipk_) :: nesd, nerv,& & err_act, i, idx_pt, totsnd_, totrcv_,& & snd_pt, rcv_pt, pnti, n - integer(psb_ipk_) :: ierr(5) logical :: swap_mpi, swap_sync, swap_send, swap_recv,& & albf,do_send,do_recv logical, parameter :: usersend=.false., debug=.false. @@ -252,8 +250,7 @@ subroutine psi_itran_vidx_vect(iictxt,iicomm,flag,beta,y,idx,& ! Unfinished communication? Something is wrong.... ! info=psb_err_mpi_error_ - ierr(1) = -2 - call psb_errpush(info,name,i_err=ierr) + call psb_errpush(info,name,m_err=(/-2/)) goto 9999 end if end if @@ -328,9 +325,8 @@ subroutine psi_itran_vidx_vect(iictxt,iicomm,flag,beta,y,idx,& end if if(iret /= mpi_success) then - ierr(1) = iret info=psb_err_mpi_error_ - call psb_errpush(info,name,i_err=ierr) + call psb_errpush(info,name,m_err=(/iret/)) goto 9999 end if @@ -345,8 +341,7 @@ subroutine psi_itran_vidx_vect(iictxt,iicomm,flag,beta,y,idx,& ! No matching send? Something is wrong.... ! info=psb_err_mpi_error_ - ierr(1) = -2 - call psb_errpush(info,name,i_err=ierr) + call psb_errpush(info,name,m_err=(/-2/)) goto 9999 end if call psb_realloc(totxch,prcid,info) @@ -365,18 +360,16 @@ subroutine psi_itran_vidx_vect(iictxt,iicomm,flag,beta,y,idx,& if (nerv>0) then call mpi_wait(y%comid(i,1),p2pstat,iret) if(iret /= mpi_success) then - ierr(1) = iret info=psb_err_mpi_error_ - call psb_errpush(info,name,i_err=ierr) + call psb_errpush(info,name,m_err=(/iret/)) goto 9999 end if end if if (nesd>0) then call mpi_wait(y%comid(i,2),p2pstat,iret) if(iret /= mpi_success) then - ierr(1) = iret info=psb_err_mpi_error_ - call psb_errpush(info,name,i_err=ierr) + call psb_errpush(info,name,m_err=(/iret/)) goto 9999 end if end if @@ -475,7 +468,6 @@ subroutine psi_iswaptran_multivect(flag,beta,y,desc_a,work,info,data) ! locals integer(psb_ipk_) :: ictxt, np, me, icomm, idxs, idxr, totxch, err_act, data_ class(psb_i_base_vect_type), pointer :: d_vidx - integer(psb_ipk_) :: ierr(5) character(len=20) :: name info=psb_success_ @@ -566,7 +558,6 @@ subroutine psi_itran_vidx_multivect(iictxt,iicomm,flag,beta,y,idx,& integer(psb_ipk_) :: nesd, nerv,& & err_act, i, idx_pt, totsnd_, totrcv_,& & snd_pt, rcv_pt, pnti, n - integer(psb_ipk_) :: ierr(5) logical :: swap_mpi, swap_sync, swap_send, swap_recv,& & albf,do_send,do_recv logical, parameter :: usersend=.false., debug=.false. @@ -607,8 +598,7 @@ subroutine psi_itran_vidx_multivect(iictxt,iicomm,flag,beta,y,idx,& ! Unfinished communication? Something is wrong.... ! info=psb_err_mpi_error_ - ierr(1) = -2 - call psb_errpush(info,name,i_err=ierr) + call psb_errpush(info,name,m_err=(/-2/)) goto 9999 end if end if @@ -682,9 +672,8 @@ subroutine psi_itran_vidx_multivect(iictxt,iicomm,flag,beta,y,idx,& end if if(iret /= mpi_success) then - ierr(1) = iret info=psb_err_mpi_error_ - call psb_errpush(info,name,i_err=ierr) + call psb_errpush(info,name,m_err=(/iret/)) goto 9999 end if rcv_pt = rcv_pt + n*nerv @@ -700,8 +689,7 @@ subroutine psi_itran_vidx_multivect(iictxt,iicomm,flag,beta,y,idx,& ! No matching send? Something is wrong.... ! info=psb_err_mpi_error_ - ierr(1) = -2 - call psb_errpush(info,name,i_err=ierr) + call psb_errpush(info,name,m_err=(/-2/)) goto 9999 end if call psb_realloc(totxch,prcid,info) @@ -719,18 +707,16 @@ subroutine psi_itran_vidx_multivect(iictxt,iicomm,flag,beta,y,idx,& if (nerv>0) then call mpi_wait(y%comid(i,1),p2pstat,iret) if(iret /= mpi_success) then - ierr(1) = iret info=psb_err_mpi_error_ - call psb_errpush(info,name,i_err=ierr) + call psb_errpush(info,name,m_err=(/iret/)) goto 9999 end if end if if (nesd>0) then call mpi_wait(y%comid(i,2),p2pstat,iret) if(iret /= mpi_success) then - ierr(1) = iret info=psb_err_mpi_error_ - call psb_errpush(info,name,i_err=ierr) + call psb_errpush(info,name,m_err=(/iret/)) goto 9999 end if end if diff --git a/base/comm/internals/psi_lswapdata.F90 b/base/comm/internals/psi_lswapdata.F90 index 1842b6db4..b409dd405 100644 --- a/base/comm/internals/psi_lswapdata.F90 +++ b/base/comm/internals/psi_lswapdata.F90 @@ -208,7 +208,6 @@ subroutine psi_lswap_vidx_vect(iictxt,iicomm,flag,beta,y,idx, & integer(psb_ipk_) :: nesd, nerv,& & err_act, i, idx_pt, totsnd_, totrcv_,& & snd_pt, rcv_pt, pnti, n - integer(psb_ipk_) :: ierr(5) logical :: swap_mpi, swap_sync, swap_send, swap_recv,& & albf,do_send,do_recv logical, parameter :: usersend=.false., debug=.false. @@ -247,8 +246,7 @@ subroutine psi_lswap_vidx_vect(iictxt,iicomm,flag,beta,y,idx, & ! Unfinished communication? Something is wrong.... ! info=psb_err_mpi_error_ - ierr(1) = -2 - call psb_errpush(info,name,i_err=ierr) + call psb_errpush(info,name,m_err=(/-2/)) goto 9999 end if end if @@ -318,9 +316,8 @@ subroutine psi_lswap_vidx_vect(iictxt,iicomm,flag,beta,y,idx, & end if if(iret /= mpi_success) then - ierr(1) = iret info=psb_err_mpi_error_ - call psb_errpush(info,name,i_err=ierr) + call psb_errpush(info,name,m_err=(/iret/)) goto 9999 end if @@ -335,8 +332,7 @@ subroutine psi_lswap_vidx_vect(iictxt,iicomm,flag,beta,y,idx, & ! No matching send? Something is wrong.... ! info=psb_err_mpi_error_ - ierr(1) = -2 - call psb_errpush(info,name,i_err=ierr) + call psb_errpush(info,name,m_err=(/-2/)) goto 9999 end if call psb_realloc(totxch,prcid,info) @@ -355,18 +351,16 @@ subroutine psi_lswap_vidx_vect(iictxt,iicomm,flag,beta,y,idx, & if (nesd>0) then call mpi_wait(y%comid(i,1),p2pstat,iret) if(iret /= mpi_success) then - ierr(1) = iret info=psb_err_mpi_error_ - call psb_errpush(info,name,i_err=ierr) + call psb_errpush(info,name,m_err=(/iret/)) goto 9999 end if end if if (nerv>0) then call mpi_wait(y%comid(i,2),p2pstat,iret) if(iret /= mpi_success) then - ierr(1) = iret info=psb_err_mpi_error_ - call psb_errpush(info,name,i_err=ierr) + call psb_errpush(info,name,m_err=(/iret/)) goto 9999 end if end if @@ -551,7 +545,6 @@ subroutine psi_lswap_vidx_multivect(iictxt,iicomm,flag,beta,y,idx, & integer(psb_ipk_) :: nesd, nerv,& & err_act, i, idx_pt, totsnd_, totrcv_,& & snd_pt, rcv_pt, pnti, n - integer(psb_ipk_) :: ierr(5) logical :: swap_mpi, swap_sync, swap_send, swap_recv,& & albf,do_send,do_recv logical, parameter :: usersend=.false., debug=.false. @@ -592,8 +585,7 @@ subroutine psi_lswap_vidx_multivect(iictxt,iicomm,flag,beta,y,idx, & ! Unfinished communication? Something is wrong.... ! info=psb_err_mpi_error_ - ierr(1) = -2 - call psb_errpush(info,name,i_err=ierr) + call psb_errpush(info,name,m_err=(/-2/)) goto 9999 end if end if @@ -665,9 +657,8 @@ subroutine psi_lswap_vidx_multivect(iictxt,iicomm,flag,beta,y,idx, & end if if(iret /= mpi_success) then - ierr(1) = iret info=psb_err_mpi_error_ - call psb_errpush(info,name,i_err=ierr) + call psb_errpush(info,name,m_err=(/iret/)) goto 9999 end if rcv_pt = rcv_pt + n*nerv @@ -683,8 +674,7 @@ subroutine psi_lswap_vidx_multivect(iictxt,iicomm,flag,beta,y,idx, & ! No matching send? Something is wrong.... ! info=psb_err_mpi_error_ - ierr(1) = -2 - call psb_errpush(info,name,i_err=ierr) + call psb_errpush(info,name,m_err=(/-2/)) goto 9999 end if call psb_realloc(totxch,prcid,info) @@ -702,18 +692,16 @@ subroutine psi_lswap_vidx_multivect(iictxt,iicomm,flag,beta,y,idx, & if (nesd>0) then call mpi_wait(y%comid(i,1),p2pstat,iret) if(iret /= mpi_success) then - ierr(1) = iret info=psb_err_mpi_error_ - call psb_errpush(info,name,i_err=ierr) + call psb_errpush(info,name,m_err=(/iret/)) goto 9999 end if end if if (nerv>0) then call mpi_wait(y%comid(i,2),p2pstat,iret) if(iret /= mpi_success) then - ierr(1) = iret info=psb_err_mpi_error_ - call psb_errpush(info,name,i_err=ierr) + call psb_errpush(info,name,m_err=(/iret/)) goto 9999 end if end if diff --git a/base/comm/internals/psi_lswaptran.F90 b/base/comm/internals/psi_lswaptran.F90 index 7c6a5780e..89ae0441b 100644 --- a/base/comm/internals/psi_lswaptran.F90 +++ b/base/comm/internals/psi_lswaptran.F90 @@ -120,7 +120,6 @@ subroutine psi_lswaptran_vect(flag,beta,y,desc_a,work,info,data) ! locals integer(psb_ipk_) :: ictxt, np, me, icomm, idxs, idxr, totxch, err_act, data_ class(psb_i_base_vect_type), pointer :: d_vidx - integer(psb_ipk_) :: ierr(5) character(len=20) :: name info=psb_success_ @@ -212,7 +211,6 @@ subroutine psi_ltran_vidx_vect(iictxt,iicomm,flag,beta,y,idx,& integer(psb_ipk_) :: nesd, nerv,& & err_act, i, idx_pt, totsnd_, totrcv_,& & snd_pt, rcv_pt, pnti, n - integer(psb_ipk_) :: ierr(5) logical :: swap_mpi, swap_sync, swap_send, swap_recv,& & albf,do_send,do_recv logical, parameter :: usersend=.false., debug=.false. @@ -252,8 +250,7 @@ subroutine psi_ltran_vidx_vect(iictxt,iicomm,flag,beta,y,idx,& ! Unfinished communication? Something is wrong.... ! info=psb_err_mpi_error_ - ierr(1) = -2 - call psb_errpush(info,name,i_err=ierr) + call psb_errpush(info,name,m_err=(/-2/)) goto 9999 end if end if @@ -328,9 +325,8 @@ subroutine psi_ltran_vidx_vect(iictxt,iicomm,flag,beta,y,idx,& end if if(iret /= mpi_success) then - ierr(1) = iret info=psb_err_mpi_error_ - call psb_errpush(info,name,i_err=ierr) + call psb_errpush(info,name,m_err=(/iret/)) goto 9999 end if @@ -345,8 +341,7 @@ subroutine psi_ltran_vidx_vect(iictxt,iicomm,flag,beta,y,idx,& ! No matching send? Something is wrong.... ! info=psb_err_mpi_error_ - ierr(1) = -2 - call psb_errpush(info,name,i_err=ierr) + call psb_errpush(info,name,m_err=(/-2/)) goto 9999 end if call psb_realloc(totxch,prcid,info) @@ -365,18 +360,16 @@ subroutine psi_ltran_vidx_vect(iictxt,iicomm,flag,beta,y,idx,& if (nerv>0) then call mpi_wait(y%comid(i,1),p2pstat,iret) if(iret /= mpi_success) then - ierr(1) = iret info=psb_err_mpi_error_ - call psb_errpush(info,name,i_err=ierr) + call psb_errpush(info,name,m_err=(/iret/)) goto 9999 end if end if if (nesd>0) then call mpi_wait(y%comid(i,2),p2pstat,iret) if(iret /= mpi_success) then - ierr(1) = iret info=psb_err_mpi_error_ - call psb_errpush(info,name,i_err=ierr) + call psb_errpush(info,name,m_err=(/iret/)) goto 9999 end if end if @@ -475,7 +468,6 @@ subroutine psi_lswaptran_multivect(flag,beta,y,desc_a,work,info,data) ! locals integer(psb_ipk_) :: ictxt, np, me, icomm, idxs, idxr, totxch, err_act, data_ class(psb_i_base_vect_type), pointer :: d_vidx - integer(psb_ipk_) :: ierr(5) character(len=20) :: name info=psb_success_ @@ -566,7 +558,6 @@ subroutine psi_ltran_vidx_multivect(iictxt,iicomm,flag,beta,y,idx,& integer(psb_ipk_) :: nesd, nerv,& & err_act, i, idx_pt, totsnd_, totrcv_,& & snd_pt, rcv_pt, pnti, n - integer(psb_ipk_) :: ierr(5) logical :: swap_mpi, swap_sync, swap_send, swap_recv,& & albf,do_send,do_recv logical, parameter :: usersend=.false., debug=.false. @@ -607,8 +598,7 @@ subroutine psi_ltran_vidx_multivect(iictxt,iicomm,flag,beta,y,idx,& ! Unfinished communication? Something is wrong.... ! info=psb_err_mpi_error_ - ierr(1) = -2 - call psb_errpush(info,name,i_err=ierr) + call psb_errpush(info,name,m_err=(/-2/)) goto 9999 end if end if @@ -682,9 +672,8 @@ subroutine psi_ltran_vidx_multivect(iictxt,iicomm,flag,beta,y,idx,& end if if(iret /= mpi_success) then - ierr(1) = iret info=psb_err_mpi_error_ - call psb_errpush(info,name,i_err=ierr) + call psb_errpush(info,name,m_err=(/iret/)) goto 9999 end if rcv_pt = rcv_pt + n*nerv @@ -700,8 +689,7 @@ subroutine psi_ltran_vidx_multivect(iictxt,iicomm,flag,beta,y,idx,& ! No matching send? Something is wrong.... ! info=psb_err_mpi_error_ - ierr(1) = -2 - call psb_errpush(info,name,i_err=ierr) + call psb_errpush(info,name,m_err=(/-2/)) goto 9999 end if call psb_realloc(totxch,prcid,info) @@ -719,18 +707,16 @@ subroutine psi_ltran_vidx_multivect(iictxt,iicomm,flag,beta,y,idx,& if (nerv>0) then call mpi_wait(y%comid(i,1),p2pstat,iret) if(iret /= mpi_success) then - ierr(1) = iret info=psb_err_mpi_error_ - call psb_errpush(info,name,i_err=ierr) + call psb_errpush(info,name,m_err=(/iret/)) goto 9999 end if end if if (nesd>0) then call mpi_wait(y%comid(i,2),p2pstat,iret) if(iret /= mpi_success) then - ierr(1) = iret info=psb_err_mpi_error_ - call psb_errpush(info,name,i_err=ierr) + call psb_errpush(info,name,m_err=(/iret/)) goto 9999 end if end if diff --git a/base/comm/internals/psi_mswapdata_a.F90 b/base/comm/internals/psi_mswapdata_a.F90 index 3991afa42..e0f5eeb0d 100644 --- a/base/comm/internals/psi_mswapdata_a.F90 +++ b/base/comm/internals/psi_mswapdata_a.F90 @@ -180,7 +180,6 @@ subroutine psi_mswapidxm(iictxt,iicomm,flag,n,beta,y,idx, & integer(psb_ipk_) :: nesd, nerv,& & err_act, i, idx_pt, totsnd_, totrcv_,& & snd_pt, rcv_pt, pnti - integer(psb_ipk_) :: ierr(5) logical :: swap_mpi, swap_sync, swap_send, swap_recv,& & albf,do_send,do_recv logical, parameter :: usersend=.false. @@ -300,9 +299,8 @@ subroutine psi_mswapidxm(iictxt,iicomm,flag,n,beta,y,idx, & & psb_mpi_mpk_,rcvbuf,rvsz,& & brvidx,psb_mpi_mpk_,icomm,iret) if(iret /= mpi_success) then - ierr(1) = iret info=psb_err_mpi_error_ - call psb_errpush(info,name,i_err=ierr) + call psb_errpush(info,name,m_err=(/iret/)) goto 9999 end if @@ -388,9 +386,8 @@ subroutine psi_mswapidxm(iictxt,iicomm,flag,n,beta,y,idx, & end if if(iret /= mpi_success) then - ierr(1) = iret info=psb_err_mpi_error_ - call psb_errpush(info,name,i_err=ierr) + call psb_errpush(info,name,m_err=(/iret/)) goto 9999 end if end if @@ -412,9 +409,8 @@ subroutine psi_mswapidxm(iictxt,iicomm,flag,n,beta,y,idx, & if ((proc_to_comm /= me).and.(nerv>0)) then call mpi_wait(rvhd(i),p2pstat,iret) if(iret /= mpi_success) then - ierr(1) = iret info=psb_err_mpi_error_ - call psb_errpush(info,name,i_err=ierr) + call psb_errpush(info,name,m_err=(/iret/)) goto 9999 end if else if (proc_to_comm == me) then @@ -669,7 +665,6 @@ subroutine psi_mswapidxv(iictxt,iicomm,flag,beta,y,idx, & integer(psb_ipk_) :: nesd, nerv,& & err_act, i, idx_pt, totsnd_, totrcv_,& & snd_pt, rcv_pt, pnti, n - integer(psb_ipk_) :: ierr(5) logical :: swap_mpi, swap_sync, swap_send, swap_recv,& & albf,do_send,do_recv logical, parameter :: usersend=.false. @@ -790,9 +785,8 @@ subroutine psi_mswapidxv(iictxt,iicomm,flag,beta,y,idx, & & psb_mpi_mpk_,rcvbuf,rvsz,& & brvidx,psb_mpi_mpk_,icomm,iret) if(iret /= mpi_success) then - ierr(1) = iret info=psb_err_mpi_error_ - call psb_errpush(info,name,i_err=ierr) + call psb_errpush(info,name,m_err=(/iret/)) goto 9999 end if @@ -879,9 +873,8 @@ subroutine psi_mswapidxv(iictxt,iicomm,flag,beta,y,idx, & end if if(iret /= mpi_success) then - ierr(1) = iret info=psb_err_mpi_error_ - call psb_errpush(info,name,i_err=ierr) + call psb_errpush(info,name,m_err=(/iret/)) goto 9999 end if end if @@ -901,9 +894,8 @@ subroutine psi_mswapidxv(iictxt,iicomm,flag,beta,y,idx, & if ((proc_to_comm /= me).and.(nerv>0)) then call mpi_wait(rvhd(i),p2pstat,iret) if(iret /= mpi_success) then - ierr(1) = iret info=psb_err_mpi_error_ - call psb_errpush(info,name,i_err=ierr) + call psb_errpush(info,name,m_err=(/iret/)) goto 9999 end if else if (proc_to_comm == me) then diff --git a/base/comm/internals/psi_mswaptran_a.F90 b/base/comm/internals/psi_mswaptran_a.F90 index 48dbe045c..2283de0b4 100644 --- a/base/comm/internals/psi_mswaptran_a.F90 +++ b/base/comm/internals/psi_mswaptran_a.F90 @@ -111,7 +111,6 @@ subroutine psi_mswaptranm(flag,n,beta,y,desc_a,work,info,data) ! locals integer(psb_ipk_) :: ictxt, np, me, icomm, idxs, idxr, err_act, totxch, data_ integer(psb_ipk_), pointer :: d_idx(:) - integer(psb_ipk_) :: ierr(5) character(len=20) :: name info=psb_success_ @@ -186,7 +185,6 @@ subroutine psi_mtranidxm(iictxt,iicomm,flag,n,beta,y,idx,& integer(psb_ipk_) :: nesd, nerv,& & err_act, i, idx_pt, totsnd_, totrcv_,& & snd_pt, rcv_pt, pnti - integer(psb_ipk_) :: ierr(5) logical :: swap_mpi, swap_sync, swap_send, swap_recv,& & albf,do_send,do_recv logical, parameter :: usersend=.false. @@ -311,9 +309,8 @@ subroutine psi_mtranidxm(iictxt,iicomm,flag,n,beta,y,idx,& & psb_mpi_mpk_,& & sndbuf,sdsz,bsdidx,psb_mpi_mpk_,icomm,iret) if(iret /= mpi_success) then - ierr(1) = iret info=psb_err_mpi_error_ - call psb_errpush(info,name,i_err=ierr) + call psb_errpush(info,name,m_err=(/iret/)) goto 9999 end if @@ -399,9 +396,8 @@ subroutine psi_mtranidxm(iictxt,iicomm,flag,n,beta,y,idx,& end if if(iret /= mpi_success) then - ierr(1) = iret info=psb_err_mpi_error_ - call psb_errpush(info,name,i_err=ierr) + call psb_errpush(info,name,m_err=(/iret/)) goto 9999 end if end if @@ -423,9 +419,8 @@ subroutine psi_mtranidxm(iictxt,iicomm,flag,n,beta,y,idx,& if ((proc_to_comm /= me).and.(nesd>0)) then call mpi_wait(rvhd(i),p2pstat,iret) if(iret /= mpi_success) then - ierr(1) = iret info=psb_err_mpi_error_ - call psb_errpush(info,name,i_err=ierr) + call psb_errpush(info,name,m_err=(/iret/)) goto 9999 end if else if (proc_to_comm == me) then @@ -599,7 +594,6 @@ subroutine psi_mswaptranv(flag,beta,y,desc_a,work,info,data) ! locals integer(psb_ipk_) :: ictxt, np, me, icomm, idxs, idxr, totxch, err_act, data_ integer(psb_ipk_), pointer :: d_idx(:) - integer(psb_ipk_) :: ierr(5) character(len=20) :: name info=psb_success_ @@ -684,7 +678,6 @@ subroutine psi_mtranidxv(iictxt,iicomm,flag,beta,y,idx,& integer(psb_ipk_) :: nesd, nerv,& & err_act, i, idx_pt, totsnd_, totrcv_,& & snd_pt, rcv_pt, pnti, n - integer(psb_ipk_) :: ierr(5) logical :: swap_mpi, swap_sync, swap_send, swap_recv,& & albf,do_send,do_recv logical, parameter :: usersend=.false. @@ -810,9 +803,8 @@ subroutine psi_mtranidxv(iictxt,iicomm,flag,beta,y,idx,& & psb_mpi_mpk_,& & sndbuf,sdsz,bsdidx,psb_mpi_mpk_,icomm,iret) if(iret /= mpi_success) then - ierr(1) = iret info=psb_err_mpi_error_ - call psb_errpush(info,name,i_err=ierr) + call psb_errpush(info,name,m_err=(/iret/)) goto 9999 end if @@ -897,9 +889,8 @@ subroutine psi_mtranidxv(iictxt,iicomm,flag,beta,y,idx,& end if if(iret /= mpi_success) then - ierr(1) = iret info=psb_err_mpi_error_ - call psb_errpush(info,name,i_err=ierr) + call psb_errpush(info,name,m_err=(/iret/)) goto 9999 end if end if @@ -919,9 +910,8 @@ subroutine psi_mtranidxv(iictxt,iicomm,flag,beta,y,idx,& if ((proc_to_comm /= me).and.(nesd>0)) then call mpi_wait(rvhd(i),p2pstat,iret) if(iret /= mpi_success) then - ierr(1) = iret info=psb_err_mpi_error_ - call psb_errpush(info,name,i_err=ierr) + call psb_errpush(info,name,m_err=(/iret/)) goto 9999 end if else if (proc_to_comm == me) then diff --git a/base/comm/internals/psi_sswapdata.F90 b/base/comm/internals/psi_sswapdata.F90 index 2f847dd32..56face250 100644 --- a/base/comm/internals/psi_sswapdata.F90 +++ b/base/comm/internals/psi_sswapdata.F90 @@ -208,7 +208,6 @@ subroutine psi_sswap_vidx_vect(iictxt,iicomm,flag,beta,y,idx, & integer(psb_ipk_) :: nesd, nerv,& & err_act, i, idx_pt, totsnd_, totrcv_,& & snd_pt, rcv_pt, pnti, n - integer(psb_ipk_) :: ierr(5) logical :: swap_mpi, swap_sync, swap_send, swap_recv,& & albf,do_send,do_recv logical, parameter :: usersend=.false., debug=.false. @@ -247,8 +246,7 @@ subroutine psi_sswap_vidx_vect(iictxt,iicomm,flag,beta,y,idx, & ! Unfinished communication? Something is wrong.... ! info=psb_err_mpi_error_ - ierr(1) = -2 - call psb_errpush(info,name,i_err=ierr) + call psb_errpush(info,name,m_err=(/-2/)) goto 9999 end if end if @@ -318,9 +316,8 @@ subroutine psi_sswap_vidx_vect(iictxt,iicomm,flag,beta,y,idx, & end if if(iret /= mpi_success) then - ierr(1) = iret info=psb_err_mpi_error_ - call psb_errpush(info,name,i_err=ierr) + call psb_errpush(info,name,m_err=(/iret/)) goto 9999 end if @@ -335,8 +332,7 @@ subroutine psi_sswap_vidx_vect(iictxt,iicomm,flag,beta,y,idx, & ! No matching send? Something is wrong.... ! info=psb_err_mpi_error_ - ierr(1) = -2 - call psb_errpush(info,name,i_err=ierr) + call psb_errpush(info,name,m_err=(/-2/)) goto 9999 end if call psb_realloc(totxch,prcid,info) @@ -355,18 +351,16 @@ subroutine psi_sswap_vidx_vect(iictxt,iicomm,flag,beta,y,idx, & if (nesd>0) then call mpi_wait(y%comid(i,1),p2pstat,iret) if(iret /= mpi_success) then - ierr(1) = iret info=psb_err_mpi_error_ - call psb_errpush(info,name,i_err=ierr) + call psb_errpush(info,name,m_err=(/iret/)) goto 9999 end if end if if (nerv>0) then call mpi_wait(y%comid(i,2),p2pstat,iret) if(iret /= mpi_success) then - ierr(1) = iret info=psb_err_mpi_error_ - call psb_errpush(info,name,i_err=ierr) + call psb_errpush(info,name,m_err=(/iret/)) goto 9999 end if end if @@ -551,7 +545,6 @@ subroutine psi_sswap_vidx_multivect(iictxt,iicomm,flag,beta,y,idx, & integer(psb_ipk_) :: nesd, nerv,& & err_act, i, idx_pt, totsnd_, totrcv_,& & snd_pt, rcv_pt, pnti, n - integer(psb_ipk_) :: ierr(5) logical :: swap_mpi, swap_sync, swap_send, swap_recv,& & albf,do_send,do_recv logical, parameter :: usersend=.false., debug=.false. @@ -592,8 +585,7 @@ subroutine psi_sswap_vidx_multivect(iictxt,iicomm,flag,beta,y,idx, & ! Unfinished communication? Something is wrong.... ! info=psb_err_mpi_error_ - ierr(1) = -2 - call psb_errpush(info,name,i_err=ierr) + call psb_errpush(info,name,m_err=(/-2/)) goto 9999 end if end if @@ -665,9 +657,8 @@ subroutine psi_sswap_vidx_multivect(iictxt,iicomm,flag,beta,y,idx, & end if if(iret /= mpi_success) then - ierr(1) = iret info=psb_err_mpi_error_ - call psb_errpush(info,name,i_err=ierr) + call psb_errpush(info,name,m_err=(/iret/)) goto 9999 end if rcv_pt = rcv_pt + n*nerv @@ -683,8 +674,7 @@ subroutine psi_sswap_vidx_multivect(iictxt,iicomm,flag,beta,y,idx, & ! No matching send? Something is wrong.... ! info=psb_err_mpi_error_ - ierr(1) = -2 - call psb_errpush(info,name,i_err=ierr) + call psb_errpush(info,name,m_err=(/-2/)) goto 9999 end if call psb_realloc(totxch,prcid,info) @@ -702,18 +692,16 @@ subroutine psi_sswap_vidx_multivect(iictxt,iicomm,flag,beta,y,idx, & if (nesd>0) then call mpi_wait(y%comid(i,1),p2pstat,iret) if(iret /= mpi_success) then - ierr(1) = iret info=psb_err_mpi_error_ - call psb_errpush(info,name,i_err=ierr) + call psb_errpush(info,name,m_err=(/iret/)) goto 9999 end if end if if (nerv>0) then call mpi_wait(y%comid(i,2),p2pstat,iret) if(iret /= mpi_success) then - ierr(1) = iret info=psb_err_mpi_error_ - call psb_errpush(info,name,i_err=ierr) + call psb_errpush(info,name,m_err=(/iret/)) goto 9999 end if end if diff --git a/base/comm/internals/psi_sswapdata_a.F90 b/base/comm/internals/psi_sswapdata_a.F90 index e529dcb4f..599c4cfd1 100644 --- a/base/comm/internals/psi_sswapdata_a.F90 +++ b/base/comm/internals/psi_sswapdata_a.F90 @@ -180,7 +180,6 @@ subroutine psi_sswapidxm(iictxt,iicomm,flag,n,beta,y,idx, & integer(psb_ipk_) :: nesd, nerv,& & err_act, i, idx_pt, totsnd_, totrcv_,& & snd_pt, rcv_pt, pnti - integer(psb_ipk_) :: ierr(5) logical :: swap_mpi, swap_sync, swap_send, swap_recv,& & albf,do_send,do_recv logical, parameter :: usersend=.false. @@ -300,9 +299,8 @@ subroutine psi_sswapidxm(iictxt,iicomm,flag,n,beta,y,idx, & & psb_mpi_r_spk_,rcvbuf,rvsz,& & brvidx,psb_mpi_r_spk_,icomm,iret) if(iret /= mpi_success) then - ierr(1) = iret info=psb_err_mpi_error_ - call psb_errpush(info,name,i_err=ierr) + call psb_errpush(info,name,m_err=(/iret/)) goto 9999 end if @@ -388,9 +386,8 @@ subroutine psi_sswapidxm(iictxt,iicomm,flag,n,beta,y,idx, & end if if(iret /= mpi_success) then - ierr(1) = iret info=psb_err_mpi_error_ - call psb_errpush(info,name,i_err=ierr) + call psb_errpush(info,name,m_err=(/iret/)) goto 9999 end if end if @@ -412,9 +409,8 @@ subroutine psi_sswapidxm(iictxt,iicomm,flag,n,beta,y,idx, & if ((proc_to_comm /= me).and.(nerv>0)) then call mpi_wait(rvhd(i),p2pstat,iret) if(iret /= mpi_success) then - ierr(1) = iret info=psb_err_mpi_error_ - call psb_errpush(info,name,i_err=ierr) + call psb_errpush(info,name,m_err=(/iret/)) goto 9999 end if else if (proc_to_comm == me) then @@ -669,7 +665,6 @@ subroutine psi_sswapidxv(iictxt,iicomm,flag,beta,y,idx, & integer(psb_ipk_) :: nesd, nerv,& & err_act, i, idx_pt, totsnd_, totrcv_,& & snd_pt, rcv_pt, pnti, n - integer(psb_ipk_) :: ierr(5) logical :: swap_mpi, swap_sync, swap_send, swap_recv,& & albf,do_send,do_recv logical, parameter :: usersend=.false. @@ -790,9 +785,8 @@ subroutine psi_sswapidxv(iictxt,iicomm,flag,beta,y,idx, & & psb_mpi_r_spk_,rcvbuf,rvsz,& & brvidx,psb_mpi_r_spk_,icomm,iret) if(iret /= mpi_success) then - ierr(1) = iret info=psb_err_mpi_error_ - call psb_errpush(info,name,i_err=ierr) + call psb_errpush(info,name,m_err=(/iret/)) goto 9999 end if @@ -879,9 +873,8 @@ subroutine psi_sswapidxv(iictxt,iicomm,flag,beta,y,idx, & end if if(iret /= mpi_success) then - ierr(1) = iret info=psb_err_mpi_error_ - call psb_errpush(info,name,i_err=ierr) + call psb_errpush(info,name,m_err=(/iret/)) goto 9999 end if end if @@ -901,9 +894,8 @@ subroutine psi_sswapidxv(iictxt,iicomm,flag,beta,y,idx, & if ((proc_to_comm /= me).and.(nerv>0)) then call mpi_wait(rvhd(i),p2pstat,iret) if(iret /= mpi_success) then - ierr(1) = iret info=psb_err_mpi_error_ - call psb_errpush(info,name,i_err=ierr) + call psb_errpush(info,name,m_err=(/iret/)) goto 9999 end if else if (proc_to_comm == me) then diff --git a/base/comm/internals/psi_sswaptran.F90 b/base/comm/internals/psi_sswaptran.F90 index 4c82e8eb1..fc9980615 100644 --- a/base/comm/internals/psi_sswaptran.F90 +++ b/base/comm/internals/psi_sswaptran.F90 @@ -120,7 +120,6 @@ subroutine psi_sswaptran_vect(flag,beta,y,desc_a,work,info,data) ! locals integer(psb_ipk_) :: ictxt, np, me, icomm, idxs, idxr, totxch, err_act, data_ class(psb_i_base_vect_type), pointer :: d_vidx - integer(psb_ipk_) :: ierr(5) character(len=20) :: name info=psb_success_ @@ -212,7 +211,6 @@ subroutine psi_stran_vidx_vect(iictxt,iicomm,flag,beta,y,idx,& integer(psb_ipk_) :: nesd, nerv,& & err_act, i, idx_pt, totsnd_, totrcv_,& & snd_pt, rcv_pt, pnti, n - integer(psb_ipk_) :: ierr(5) logical :: swap_mpi, swap_sync, swap_send, swap_recv,& & albf,do_send,do_recv logical, parameter :: usersend=.false., debug=.false. @@ -252,8 +250,7 @@ subroutine psi_stran_vidx_vect(iictxt,iicomm,flag,beta,y,idx,& ! Unfinished communication? Something is wrong.... ! info=psb_err_mpi_error_ - ierr(1) = -2 - call psb_errpush(info,name,i_err=ierr) + call psb_errpush(info,name,m_err=(/-2/)) goto 9999 end if end if @@ -328,9 +325,8 @@ subroutine psi_stran_vidx_vect(iictxt,iicomm,flag,beta,y,idx,& end if if(iret /= mpi_success) then - ierr(1) = iret info=psb_err_mpi_error_ - call psb_errpush(info,name,i_err=ierr) + call psb_errpush(info,name,m_err=(/iret/)) goto 9999 end if @@ -345,8 +341,7 @@ subroutine psi_stran_vidx_vect(iictxt,iicomm,flag,beta,y,idx,& ! No matching send? Something is wrong.... ! info=psb_err_mpi_error_ - ierr(1) = -2 - call psb_errpush(info,name,i_err=ierr) + call psb_errpush(info,name,m_err=(/-2/)) goto 9999 end if call psb_realloc(totxch,prcid,info) @@ -365,18 +360,16 @@ subroutine psi_stran_vidx_vect(iictxt,iicomm,flag,beta,y,idx,& if (nerv>0) then call mpi_wait(y%comid(i,1),p2pstat,iret) if(iret /= mpi_success) then - ierr(1) = iret info=psb_err_mpi_error_ - call psb_errpush(info,name,i_err=ierr) + call psb_errpush(info,name,m_err=(/iret/)) goto 9999 end if end if if (nesd>0) then call mpi_wait(y%comid(i,2),p2pstat,iret) if(iret /= mpi_success) then - ierr(1) = iret info=psb_err_mpi_error_ - call psb_errpush(info,name,i_err=ierr) + call psb_errpush(info,name,m_err=(/iret/)) goto 9999 end if end if @@ -475,7 +468,6 @@ subroutine psi_sswaptran_multivect(flag,beta,y,desc_a,work,info,data) ! locals integer(psb_ipk_) :: ictxt, np, me, icomm, idxs, idxr, totxch, err_act, data_ class(psb_i_base_vect_type), pointer :: d_vidx - integer(psb_ipk_) :: ierr(5) character(len=20) :: name info=psb_success_ @@ -566,7 +558,6 @@ subroutine psi_stran_vidx_multivect(iictxt,iicomm,flag,beta,y,idx,& integer(psb_ipk_) :: nesd, nerv,& & err_act, i, idx_pt, totsnd_, totrcv_,& & snd_pt, rcv_pt, pnti, n - integer(psb_ipk_) :: ierr(5) logical :: swap_mpi, swap_sync, swap_send, swap_recv,& & albf,do_send,do_recv logical, parameter :: usersend=.false., debug=.false. @@ -607,8 +598,7 @@ subroutine psi_stran_vidx_multivect(iictxt,iicomm,flag,beta,y,idx,& ! Unfinished communication? Something is wrong.... ! info=psb_err_mpi_error_ - ierr(1) = -2 - call psb_errpush(info,name,i_err=ierr) + call psb_errpush(info,name,m_err=(/-2/)) goto 9999 end if end if @@ -682,9 +672,8 @@ subroutine psi_stran_vidx_multivect(iictxt,iicomm,flag,beta,y,idx,& end if if(iret /= mpi_success) then - ierr(1) = iret info=psb_err_mpi_error_ - call psb_errpush(info,name,i_err=ierr) + call psb_errpush(info,name,m_err=(/iret/)) goto 9999 end if rcv_pt = rcv_pt + n*nerv @@ -700,8 +689,7 @@ subroutine psi_stran_vidx_multivect(iictxt,iicomm,flag,beta,y,idx,& ! No matching send? Something is wrong.... ! info=psb_err_mpi_error_ - ierr(1) = -2 - call psb_errpush(info,name,i_err=ierr) + call psb_errpush(info,name,m_err=(/-2/)) goto 9999 end if call psb_realloc(totxch,prcid,info) @@ -719,18 +707,16 @@ subroutine psi_stran_vidx_multivect(iictxt,iicomm,flag,beta,y,idx,& if (nerv>0) then call mpi_wait(y%comid(i,1),p2pstat,iret) if(iret /= mpi_success) then - ierr(1) = iret info=psb_err_mpi_error_ - call psb_errpush(info,name,i_err=ierr) + call psb_errpush(info,name,m_err=(/iret/)) goto 9999 end if end if if (nesd>0) then call mpi_wait(y%comid(i,2),p2pstat,iret) if(iret /= mpi_success) then - ierr(1) = iret info=psb_err_mpi_error_ - call psb_errpush(info,name,i_err=ierr) + call psb_errpush(info,name,m_err=(/iret/)) goto 9999 end if end if diff --git a/base/comm/internals/psi_sswaptran_a.F90 b/base/comm/internals/psi_sswaptran_a.F90 index a07f4a999..1eb8d227a 100644 --- a/base/comm/internals/psi_sswaptran_a.F90 +++ b/base/comm/internals/psi_sswaptran_a.F90 @@ -111,7 +111,6 @@ subroutine psi_sswaptranm(flag,n,beta,y,desc_a,work,info,data) ! locals integer(psb_ipk_) :: ictxt, np, me, icomm, idxs, idxr, err_act, totxch, data_ integer(psb_ipk_), pointer :: d_idx(:) - integer(psb_ipk_) :: ierr(5) character(len=20) :: name info=psb_success_ @@ -186,7 +185,6 @@ subroutine psi_stranidxm(iictxt,iicomm,flag,n,beta,y,idx,& integer(psb_ipk_) :: nesd, nerv,& & err_act, i, idx_pt, totsnd_, totrcv_,& & snd_pt, rcv_pt, pnti - integer(psb_ipk_) :: ierr(5) logical :: swap_mpi, swap_sync, swap_send, swap_recv,& & albf,do_send,do_recv logical, parameter :: usersend=.false. @@ -311,9 +309,8 @@ subroutine psi_stranidxm(iictxt,iicomm,flag,n,beta,y,idx,& & psb_mpi_r_spk_,& & sndbuf,sdsz,bsdidx,psb_mpi_r_spk_,icomm,iret) if(iret /= mpi_success) then - ierr(1) = iret info=psb_err_mpi_error_ - call psb_errpush(info,name,i_err=ierr) + call psb_errpush(info,name,m_err=(/iret/)) goto 9999 end if @@ -399,9 +396,8 @@ subroutine psi_stranidxm(iictxt,iicomm,flag,n,beta,y,idx,& end if if(iret /= mpi_success) then - ierr(1) = iret info=psb_err_mpi_error_ - call psb_errpush(info,name,i_err=ierr) + call psb_errpush(info,name,m_err=(/iret/)) goto 9999 end if end if @@ -423,9 +419,8 @@ subroutine psi_stranidxm(iictxt,iicomm,flag,n,beta,y,idx,& if ((proc_to_comm /= me).and.(nesd>0)) then call mpi_wait(rvhd(i),p2pstat,iret) if(iret /= mpi_success) then - ierr(1) = iret info=psb_err_mpi_error_ - call psb_errpush(info,name,i_err=ierr) + call psb_errpush(info,name,m_err=(/iret/)) goto 9999 end if else if (proc_to_comm == me) then @@ -599,7 +594,6 @@ subroutine psi_sswaptranv(flag,beta,y,desc_a,work,info,data) ! locals integer(psb_ipk_) :: ictxt, np, me, icomm, idxs, idxr, totxch, err_act, data_ integer(psb_ipk_), pointer :: d_idx(:) - integer(psb_ipk_) :: ierr(5) character(len=20) :: name info=psb_success_ @@ -684,7 +678,6 @@ subroutine psi_stranidxv(iictxt,iicomm,flag,beta,y,idx,& integer(psb_ipk_) :: nesd, nerv,& & err_act, i, idx_pt, totsnd_, totrcv_,& & snd_pt, rcv_pt, pnti, n - integer(psb_ipk_) :: ierr(5) logical :: swap_mpi, swap_sync, swap_send, swap_recv,& & albf,do_send,do_recv logical, parameter :: usersend=.false. @@ -810,9 +803,8 @@ subroutine psi_stranidxv(iictxt,iicomm,flag,beta,y,idx,& & psb_mpi_r_spk_,& & sndbuf,sdsz,bsdidx,psb_mpi_r_spk_,icomm,iret) if(iret /= mpi_success) then - ierr(1) = iret info=psb_err_mpi_error_ - call psb_errpush(info,name,i_err=ierr) + call psb_errpush(info,name,m_err=(/iret/)) goto 9999 end if @@ -897,9 +889,8 @@ subroutine psi_stranidxv(iictxt,iicomm,flag,beta,y,idx,& end if if(iret /= mpi_success) then - ierr(1) = iret info=psb_err_mpi_error_ - call psb_errpush(info,name,i_err=ierr) + call psb_errpush(info,name,m_err=(/iret/)) goto 9999 end if end if @@ -919,9 +910,8 @@ subroutine psi_stranidxv(iictxt,iicomm,flag,beta,y,idx,& if ((proc_to_comm /= me).and.(nesd>0)) then call mpi_wait(rvhd(i),p2pstat,iret) if(iret /= mpi_success) then - ierr(1) = iret info=psb_err_mpi_error_ - call psb_errpush(info,name,i_err=ierr) + call psb_errpush(info,name,m_err=(/iret/)) goto 9999 end if else if (proc_to_comm == me) then diff --git a/base/comm/internals/psi_zswapdata.F90 b/base/comm/internals/psi_zswapdata.F90 index 506c2c5c1..c3b46b80c 100644 --- a/base/comm/internals/psi_zswapdata.F90 +++ b/base/comm/internals/psi_zswapdata.F90 @@ -208,7 +208,6 @@ subroutine psi_zswap_vidx_vect(iictxt,iicomm,flag,beta,y,idx, & integer(psb_ipk_) :: nesd, nerv,& & err_act, i, idx_pt, totsnd_, totrcv_,& & snd_pt, rcv_pt, pnti, n - integer(psb_ipk_) :: ierr(5) logical :: swap_mpi, swap_sync, swap_send, swap_recv,& & albf,do_send,do_recv logical, parameter :: usersend=.false., debug=.false. @@ -247,8 +246,7 @@ subroutine psi_zswap_vidx_vect(iictxt,iicomm,flag,beta,y,idx, & ! Unfinished communication? Something is wrong.... ! info=psb_err_mpi_error_ - ierr(1) = -2 - call psb_errpush(info,name,i_err=ierr) + call psb_errpush(info,name,m_err=(/-2/)) goto 9999 end if end if @@ -318,9 +316,8 @@ subroutine psi_zswap_vidx_vect(iictxt,iicomm,flag,beta,y,idx, & end if if(iret /= mpi_success) then - ierr(1) = iret info=psb_err_mpi_error_ - call psb_errpush(info,name,i_err=ierr) + call psb_errpush(info,name,m_err=(/iret/)) goto 9999 end if @@ -335,8 +332,7 @@ subroutine psi_zswap_vidx_vect(iictxt,iicomm,flag,beta,y,idx, & ! No matching send? Something is wrong.... ! info=psb_err_mpi_error_ - ierr(1) = -2 - call psb_errpush(info,name,i_err=ierr) + call psb_errpush(info,name,m_err=(/-2/)) goto 9999 end if call psb_realloc(totxch,prcid,info) @@ -355,18 +351,16 @@ subroutine psi_zswap_vidx_vect(iictxt,iicomm,flag,beta,y,idx, & if (nesd>0) then call mpi_wait(y%comid(i,1),p2pstat,iret) if(iret /= mpi_success) then - ierr(1) = iret info=psb_err_mpi_error_ - call psb_errpush(info,name,i_err=ierr) + call psb_errpush(info,name,m_err=(/iret/)) goto 9999 end if end if if (nerv>0) then call mpi_wait(y%comid(i,2),p2pstat,iret) if(iret /= mpi_success) then - ierr(1) = iret info=psb_err_mpi_error_ - call psb_errpush(info,name,i_err=ierr) + call psb_errpush(info,name,m_err=(/iret/)) goto 9999 end if end if @@ -551,7 +545,6 @@ subroutine psi_zswap_vidx_multivect(iictxt,iicomm,flag,beta,y,idx, & integer(psb_ipk_) :: nesd, nerv,& & err_act, i, idx_pt, totsnd_, totrcv_,& & snd_pt, rcv_pt, pnti, n - integer(psb_ipk_) :: ierr(5) logical :: swap_mpi, swap_sync, swap_send, swap_recv,& & albf,do_send,do_recv logical, parameter :: usersend=.false., debug=.false. @@ -592,8 +585,7 @@ subroutine psi_zswap_vidx_multivect(iictxt,iicomm,flag,beta,y,idx, & ! Unfinished communication? Something is wrong.... ! info=psb_err_mpi_error_ - ierr(1) = -2 - call psb_errpush(info,name,i_err=ierr) + call psb_errpush(info,name,m_err=(/-2/)) goto 9999 end if end if @@ -665,9 +657,8 @@ subroutine psi_zswap_vidx_multivect(iictxt,iicomm,flag,beta,y,idx, & end if if(iret /= mpi_success) then - ierr(1) = iret info=psb_err_mpi_error_ - call psb_errpush(info,name,i_err=ierr) + call psb_errpush(info,name,m_err=(/iret/)) goto 9999 end if rcv_pt = rcv_pt + n*nerv @@ -683,8 +674,7 @@ subroutine psi_zswap_vidx_multivect(iictxt,iicomm,flag,beta,y,idx, & ! No matching send? Something is wrong.... ! info=psb_err_mpi_error_ - ierr(1) = -2 - call psb_errpush(info,name,i_err=ierr) + call psb_errpush(info,name,m_err=(/-2/)) goto 9999 end if call psb_realloc(totxch,prcid,info) @@ -702,18 +692,16 @@ subroutine psi_zswap_vidx_multivect(iictxt,iicomm,flag,beta,y,idx, & if (nesd>0) then call mpi_wait(y%comid(i,1),p2pstat,iret) if(iret /= mpi_success) then - ierr(1) = iret info=psb_err_mpi_error_ - call psb_errpush(info,name,i_err=ierr) + call psb_errpush(info,name,m_err=(/iret/)) goto 9999 end if end if if (nerv>0) then call mpi_wait(y%comid(i,2),p2pstat,iret) if(iret /= mpi_success) then - ierr(1) = iret info=psb_err_mpi_error_ - call psb_errpush(info,name,i_err=ierr) + call psb_errpush(info,name,m_err=(/iret/)) goto 9999 end if end if diff --git a/base/comm/internals/psi_zswapdata_a.F90 b/base/comm/internals/psi_zswapdata_a.F90 index 99d162495..1021c9760 100644 --- a/base/comm/internals/psi_zswapdata_a.F90 +++ b/base/comm/internals/psi_zswapdata_a.F90 @@ -180,7 +180,6 @@ subroutine psi_zswapidxm(iictxt,iicomm,flag,n,beta,y,idx, & integer(psb_ipk_) :: nesd, nerv,& & err_act, i, idx_pt, totsnd_, totrcv_,& & snd_pt, rcv_pt, pnti - integer(psb_ipk_) :: ierr(5) logical :: swap_mpi, swap_sync, swap_send, swap_recv,& & albf,do_send,do_recv logical, parameter :: usersend=.false. @@ -300,9 +299,8 @@ subroutine psi_zswapidxm(iictxt,iicomm,flag,n,beta,y,idx, & & psb_mpi_c_dpk_,rcvbuf,rvsz,& & brvidx,psb_mpi_c_dpk_,icomm,iret) if(iret /= mpi_success) then - ierr(1) = iret info=psb_err_mpi_error_ - call psb_errpush(info,name,i_err=ierr) + call psb_errpush(info,name,m_err=(/iret/)) goto 9999 end if @@ -388,9 +386,8 @@ subroutine psi_zswapidxm(iictxt,iicomm,flag,n,beta,y,idx, & end if if(iret /= mpi_success) then - ierr(1) = iret info=psb_err_mpi_error_ - call psb_errpush(info,name,i_err=ierr) + call psb_errpush(info,name,m_err=(/iret/)) goto 9999 end if end if @@ -412,9 +409,8 @@ subroutine psi_zswapidxm(iictxt,iicomm,flag,n,beta,y,idx, & if ((proc_to_comm /= me).and.(nerv>0)) then call mpi_wait(rvhd(i),p2pstat,iret) if(iret /= mpi_success) then - ierr(1) = iret info=psb_err_mpi_error_ - call psb_errpush(info,name,i_err=ierr) + call psb_errpush(info,name,m_err=(/iret/)) goto 9999 end if else if (proc_to_comm == me) then @@ -669,7 +665,6 @@ subroutine psi_zswapidxv(iictxt,iicomm,flag,beta,y,idx, & integer(psb_ipk_) :: nesd, nerv,& & err_act, i, idx_pt, totsnd_, totrcv_,& & snd_pt, rcv_pt, pnti, n - integer(psb_ipk_) :: ierr(5) logical :: swap_mpi, swap_sync, swap_send, swap_recv,& & albf,do_send,do_recv logical, parameter :: usersend=.false. @@ -790,9 +785,8 @@ subroutine psi_zswapidxv(iictxt,iicomm,flag,beta,y,idx, & & psb_mpi_c_dpk_,rcvbuf,rvsz,& & brvidx,psb_mpi_c_dpk_,icomm,iret) if(iret /= mpi_success) then - ierr(1) = iret info=psb_err_mpi_error_ - call psb_errpush(info,name,i_err=ierr) + call psb_errpush(info,name,m_err=(/iret/)) goto 9999 end if @@ -879,9 +873,8 @@ subroutine psi_zswapidxv(iictxt,iicomm,flag,beta,y,idx, & end if if(iret /= mpi_success) then - ierr(1) = iret info=psb_err_mpi_error_ - call psb_errpush(info,name,i_err=ierr) + call psb_errpush(info,name,m_err=(/iret/)) goto 9999 end if end if @@ -901,9 +894,8 @@ subroutine psi_zswapidxv(iictxt,iicomm,flag,beta,y,idx, & if ((proc_to_comm /= me).and.(nerv>0)) then call mpi_wait(rvhd(i),p2pstat,iret) if(iret /= mpi_success) then - ierr(1) = iret info=psb_err_mpi_error_ - call psb_errpush(info,name,i_err=ierr) + call psb_errpush(info,name,m_err=(/iret/)) goto 9999 end if else if (proc_to_comm == me) then diff --git a/base/comm/internals/psi_zswaptran.F90 b/base/comm/internals/psi_zswaptran.F90 index 310998242..9be2722d0 100644 --- a/base/comm/internals/psi_zswaptran.F90 +++ b/base/comm/internals/psi_zswaptran.F90 @@ -120,7 +120,6 @@ subroutine psi_zswaptran_vect(flag,beta,y,desc_a,work,info,data) ! locals integer(psb_ipk_) :: ictxt, np, me, icomm, idxs, idxr, totxch, err_act, data_ class(psb_i_base_vect_type), pointer :: d_vidx - integer(psb_ipk_) :: ierr(5) character(len=20) :: name info=psb_success_ @@ -212,7 +211,6 @@ subroutine psi_ztran_vidx_vect(iictxt,iicomm,flag,beta,y,idx,& integer(psb_ipk_) :: nesd, nerv,& & err_act, i, idx_pt, totsnd_, totrcv_,& & snd_pt, rcv_pt, pnti, n - integer(psb_ipk_) :: ierr(5) logical :: swap_mpi, swap_sync, swap_send, swap_recv,& & albf,do_send,do_recv logical, parameter :: usersend=.false., debug=.false. @@ -252,8 +250,7 @@ subroutine psi_ztran_vidx_vect(iictxt,iicomm,flag,beta,y,idx,& ! Unfinished communication? Something is wrong.... ! info=psb_err_mpi_error_ - ierr(1) = -2 - call psb_errpush(info,name,i_err=ierr) + call psb_errpush(info,name,m_err=(/-2/)) goto 9999 end if end if @@ -328,9 +325,8 @@ subroutine psi_ztran_vidx_vect(iictxt,iicomm,flag,beta,y,idx,& end if if(iret /= mpi_success) then - ierr(1) = iret info=psb_err_mpi_error_ - call psb_errpush(info,name,i_err=ierr) + call psb_errpush(info,name,m_err=(/iret/)) goto 9999 end if @@ -345,8 +341,7 @@ subroutine psi_ztran_vidx_vect(iictxt,iicomm,flag,beta,y,idx,& ! No matching send? Something is wrong.... ! info=psb_err_mpi_error_ - ierr(1) = -2 - call psb_errpush(info,name,i_err=ierr) + call psb_errpush(info,name,m_err=(/-2/)) goto 9999 end if call psb_realloc(totxch,prcid,info) @@ -365,18 +360,16 @@ subroutine psi_ztran_vidx_vect(iictxt,iicomm,flag,beta,y,idx,& if (nerv>0) then call mpi_wait(y%comid(i,1),p2pstat,iret) if(iret /= mpi_success) then - ierr(1) = iret info=psb_err_mpi_error_ - call psb_errpush(info,name,i_err=ierr) + call psb_errpush(info,name,m_err=(/iret/)) goto 9999 end if end if if (nesd>0) then call mpi_wait(y%comid(i,2),p2pstat,iret) if(iret /= mpi_success) then - ierr(1) = iret info=psb_err_mpi_error_ - call psb_errpush(info,name,i_err=ierr) + call psb_errpush(info,name,m_err=(/iret/)) goto 9999 end if end if @@ -475,7 +468,6 @@ subroutine psi_zswaptran_multivect(flag,beta,y,desc_a,work,info,data) ! locals integer(psb_ipk_) :: ictxt, np, me, icomm, idxs, idxr, totxch, err_act, data_ class(psb_i_base_vect_type), pointer :: d_vidx - integer(psb_ipk_) :: ierr(5) character(len=20) :: name info=psb_success_ @@ -566,7 +558,6 @@ subroutine psi_ztran_vidx_multivect(iictxt,iicomm,flag,beta,y,idx,& integer(psb_ipk_) :: nesd, nerv,& & err_act, i, idx_pt, totsnd_, totrcv_,& & snd_pt, rcv_pt, pnti, n - integer(psb_ipk_) :: ierr(5) logical :: swap_mpi, swap_sync, swap_send, swap_recv,& & albf,do_send,do_recv logical, parameter :: usersend=.false., debug=.false. @@ -607,8 +598,7 @@ subroutine psi_ztran_vidx_multivect(iictxt,iicomm,flag,beta,y,idx,& ! Unfinished communication? Something is wrong.... ! info=psb_err_mpi_error_ - ierr(1) = -2 - call psb_errpush(info,name,i_err=ierr) + call psb_errpush(info,name,m_err=(/-2/)) goto 9999 end if end if @@ -682,9 +672,8 @@ subroutine psi_ztran_vidx_multivect(iictxt,iicomm,flag,beta,y,idx,& end if if(iret /= mpi_success) then - ierr(1) = iret info=psb_err_mpi_error_ - call psb_errpush(info,name,i_err=ierr) + call psb_errpush(info,name,m_err=(/iret/)) goto 9999 end if rcv_pt = rcv_pt + n*nerv @@ -700,8 +689,7 @@ subroutine psi_ztran_vidx_multivect(iictxt,iicomm,flag,beta,y,idx,& ! No matching send? Something is wrong.... ! info=psb_err_mpi_error_ - ierr(1) = -2 - call psb_errpush(info,name,i_err=ierr) + call psb_errpush(info,name,m_err=(/-2/)) goto 9999 end if call psb_realloc(totxch,prcid,info) @@ -719,18 +707,16 @@ subroutine psi_ztran_vidx_multivect(iictxt,iicomm,flag,beta,y,idx,& if (nerv>0) then call mpi_wait(y%comid(i,1),p2pstat,iret) if(iret /= mpi_success) then - ierr(1) = iret info=psb_err_mpi_error_ - call psb_errpush(info,name,i_err=ierr) + call psb_errpush(info,name,m_err=(/iret/)) goto 9999 end if end if if (nesd>0) then call mpi_wait(y%comid(i,2),p2pstat,iret) if(iret /= mpi_success) then - ierr(1) = iret info=psb_err_mpi_error_ - call psb_errpush(info,name,i_err=ierr) + call psb_errpush(info,name,m_err=(/iret/)) goto 9999 end if end if diff --git a/base/comm/internals/psi_zswaptran_a.F90 b/base/comm/internals/psi_zswaptran_a.F90 index b1e725471..7388c3b4a 100644 --- a/base/comm/internals/psi_zswaptran_a.F90 +++ b/base/comm/internals/psi_zswaptran_a.F90 @@ -111,7 +111,6 @@ subroutine psi_zswaptranm(flag,n,beta,y,desc_a,work,info,data) ! locals integer(psb_ipk_) :: ictxt, np, me, icomm, idxs, idxr, err_act, totxch, data_ integer(psb_ipk_), pointer :: d_idx(:) - integer(psb_ipk_) :: ierr(5) character(len=20) :: name info=psb_success_ @@ -186,7 +185,6 @@ subroutine psi_ztranidxm(iictxt,iicomm,flag,n,beta,y,idx,& integer(psb_ipk_) :: nesd, nerv,& & err_act, i, idx_pt, totsnd_, totrcv_,& & snd_pt, rcv_pt, pnti - integer(psb_ipk_) :: ierr(5) logical :: swap_mpi, swap_sync, swap_send, swap_recv,& & albf,do_send,do_recv logical, parameter :: usersend=.false. @@ -311,9 +309,8 @@ subroutine psi_ztranidxm(iictxt,iicomm,flag,n,beta,y,idx,& & psb_mpi_c_dpk_,& & sndbuf,sdsz,bsdidx,psb_mpi_c_dpk_,icomm,iret) if(iret /= mpi_success) then - ierr(1) = iret info=psb_err_mpi_error_ - call psb_errpush(info,name,i_err=ierr) + call psb_errpush(info,name,m_err=(/iret/)) goto 9999 end if @@ -399,9 +396,8 @@ subroutine psi_ztranidxm(iictxt,iicomm,flag,n,beta,y,idx,& end if if(iret /= mpi_success) then - ierr(1) = iret info=psb_err_mpi_error_ - call psb_errpush(info,name,i_err=ierr) + call psb_errpush(info,name,m_err=(/iret/)) goto 9999 end if end if @@ -423,9 +419,8 @@ subroutine psi_ztranidxm(iictxt,iicomm,flag,n,beta,y,idx,& if ((proc_to_comm /= me).and.(nesd>0)) then call mpi_wait(rvhd(i),p2pstat,iret) if(iret /= mpi_success) then - ierr(1) = iret info=psb_err_mpi_error_ - call psb_errpush(info,name,i_err=ierr) + call psb_errpush(info,name,m_err=(/iret/)) goto 9999 end if else if (proc_to_comm == me) then @@ -599,7 +594,6 @@ subroutine psi_zswaptranv(flag,beta,y,desc_a,work,info,data) ! locals integer(psb_ipk_) :: ictxt, np, me, icomm, idxs, idxr, totxch, err_act, data_ integer(psb_ipk_), pointer :: d_idx(:) - integer(psb_ipk_) :: ierr(5) character(len=20) :: name info=psb_success_ @@ -684,7 +678,6 @@ subroutine psi_ztranidxv(iictxt,iicomm,flag,beta,y,idx,& integer(psb_ipk_) :: nesd, nerv,& & err_act, i, idx_pt, totsnd_, totrcv_,& & snd_pt, rcv_pt, pnti, n - integer(psb_ipk_) :: ierr(5) logical :: swap_mpi, swap_sync, swap_send, swap_recv,& & albf,do_send,do_recv logical, parameter :: usersend=.false. @@ -810,9 +803,8 @@ subroutine psi_ztranidxv(iictxt,iicomm,flag,beta,y,idx,& & psb_mpi_c_dpk_,& & sndbuf,sdsz,bsdidx,psb_mpi_c_dpk_,icomm,iret) if(iret /= mpi_success) then - ierr(1) = iret info=psb_err_mpi_error_ - call psb_errpush(info,name,i_err=ierr) + call psb_errpush(info,name,m_err=(/iret/)) goto 9999 end if @@ -897,9 +889,8 @@ subroutine psi_ztranidxv(iictxt,iicomm,flag,beta,y,idx,& end if if(iret /= mpi_success) then - ierr(1) = iret info=psb_err_mpi_error_ - call psb_errpush(info,name,i_err=ierr) + call psb_errpush(info,name,m_err=(/iret/)) goto 9999 end if end if @@ -919,9 +910,8 @@ subroutine psi_ztranidxv(iictxt,iicomm,flag,beta,y,idx,& if ((proc_to_comm /= me).and.(nesd>0)) then call mpi_wait(rvhd(i),p2pstat,iret) if(iret /= mpi_success) then - ierr(1) = iret info=psb_err_mpi_error_ - call psb_errpush(info,name,i_err=ierr) + call psb_errpush(info,name,m_err=(/iret/)) goto 9999 end if else if (proc_to_comm == me) then diff --git a/base/modules/comm/psb_c_linmap_mod.f90 b/base/modules/comm/psb_c_linmap_mod.f90 index db4599df2..919f17480 100644 --- a/base/modules/comm/psb_c_linmap_mod.f90 +++ b/base/modules/comm/psb_c_linmap_mod.f90 @@ -233,7 +233,6 @@ contains integer(psb_ipk_) :: info integer(psb_ipk_) :: err_act - integer(psb_ipk_) :: ierr(5) character(len=20) :: name='clone' info = 0 @@ -247,9 +246,8 @@ contains if (info == 0) call map%map_Y2X%clone(mout%map_Y2X,info) class default info = psb_err_invalid_dynamic_type_ - ierr(1) = 2 info = psb_err_missing_override_method_ - call psb_errpush(info,name,i_err=ierr) + call psb_errpush(info,name,m_err=(/2/)) call psb_erractionsave(err_act) call psb_error_handler(err_act) diff --git a/base/modules/comm/psb_d_linmap_mod.f90 b/base/modules/comm/psb_d_linmap_mod.f90 index 194ca3817..0a6e96272 100644 --- a/base/modules/comm/psb_d_linmap_mod.f90 +++ b/base/modules/comm/psb_d_linmap_mod.f90 @@ -233,7 +233,6 @@ contains integer(psb_ipk_) :: info integer(psb_ipk_) :: err_act - integer(psb_ipk_) :: ierr(5) character(len=20) :: name='clone' info = 0 @@ -247,9 +246,8 @@ contains if (info == 0) call map%map_Y2X%clone(mout%map_Y2X,info) class default info = psb_err_invalid_dynamic_type_ - ierr(1) = 2 info = psb_err_missing_override_method_ - call psb_errpush(info,name,i_err=ierr) + call psb_errpush(info,name,m_err=(/2/)) call psb_erractionsave(err_act) call psb_error_handler(err_act) diff --git a/base/modules/comm/psb_s_linmap_mod.f90 b/base/modules/comm/psb_s_linmap_mod.f90 index 4428ba2e7..67e822df6 100644 --- a/base/modules/comm/psb_s_linmap_mod.f90 +++ b/base/modules/comm/psb_s_linmap_mod.f90 @@ -233,7 +233,6 @@ contains integer(psb_ipk_) :: info integer(psb_ipk_) :: err_act - integer(psb_ipk_) :: ierr(5) character(len=20) :: name='clone' info = 0 @@ -247,9 +246,8 @@ contains if (info == 0) call map%map_Y2X%clone(mout%map_Y2X,info) class default info = psb_err_invalid_dynamic_type_ - ierr(1) = 2 info = psb_err_missing_override_method_ - call psb_errpush(info,name,i_err=ierr) + call psb_errpush(info,name,m_err=(/2/)) call psb_erractionsave(err_act) call psb_error_handler(err_act) diff --git a/base/modules/comm/psb_z_linmap_mod.f90 b/base/modules/comm/psb_z_linmap_mod.f90 index 3cbadfada..1aaa22cae 100644 --- a/base/modules/comm/psb_z_linmap_mod.f90 +++ b/base/modules/comm/psb_z_linmap_mod.f90 @@ -233,7 +233,6 @@ contains integer(psb_ipk_) :: info integer(psb_ipk_) :: err_act - integer(psb_ipk_) :: ierr(5) character(len=20) :: name='clone' info = 0 @@ -247,9 +246,8 @@ contains if (info == 0) call map%map_Y2X%clone(mout%map_Y2X,info) class default info = psb_err_invalid_dynamic_type_ - ierr(1) = 2 info = psb_err_missing_override_method_ - call psb_errpush(info,name,i_err=ierr) + call psb_errpush(info,name,m_err=(/2/)) call psb_erractionsave(err_act) call psb_error_handler(err_act) diff --git a/base/serial/impl/psb_c_csr_impl.f90 b/base/serial/impl/psb_c_csr_impl.f90 index 32aecdca7..ab2874d49 100644 --- a/base/serial/impl/psb_c_csr_impl.f90 +++ b/base/serial/impl/psb_c_csr_impl.f90 @@ -1018,7 +1018,6 @@ subroutine psb_c_csr_cssm(alpha,a,x,beta,y,info,trans) complex(psb_spk_), allocatable :: tmp(:,:) logical :: tra, ctra integer(psb_ipk_) :: err_act - integer(psb_ipk_) :: ierr(5) character(len=20) :: name='c_csr_cssm' logical, parameter :: debug=.false. @@ -1270,7 +1269,6 @@ function psb_c_csr_maxval(a) result(res) real(psb_spk_) :: res integer(psb_ipk_) :: i,j,k,m,n, nnz, ir, jc, nc, info - integer(psb_ipk_) :: ierr(5) character(len=20) :: name='c_csr_maxval' logical, parameter :: debug=.false. @@ -1295,7 +1293,6 @@ function psb_c_csr_csnmi(a) result(res) real(psb_spk_) :: acc logical :: tra integer(psb_ipk_) :: err_act - integer(psb_ipk_) :: ierr(5) character(len=20) :: name='c_csnmi' logical, parameter :: debug=.false. @@ -1655,7 +1652,6 @@ subroutine psb_c_csr_scals(d,a,info) integer(psb_ipk_), intent(out) :: info integer(psb_ipk_) :: err_act,mnm, i, j, m - integer(psb_ipk_) :: ierr(5) character(len=20) :: name='scal' logical, parameter :: debug=.false. @@ -1704,7 +1700,6 @@ subroutine psb_c_csr_reallocate_nz(nz,a) integer(psb_ipk_), intent(in) :: nz class(psb_c_csr_sparse_mat), intent(inout) :: a integer(psb_ipk_) :: err_act, info - integer(psb_ipk_) :: ierr(5) character(len=20) :: name='c_csr_reallocate_nz' logical, parameter :: debug=.false. @@ -1736,7 +1731,6 @@ subroutine psb_c_csr_mold(a,b,info) class(psb_c_base_sparse_mat), intent(inout), allocatable :: b integer(psb_ipk_), intent(out) :: info integer(psb_ipk_) :: err_act - integer(psb_ipk_) :: ierr(5) character(len=20) :: name='csr_mold' logical, parameter :: debug=.false. @@ -1846,7 +1840,6 @@ subroutine psb_c_csr_csgetptn(imin,imax,a,nz,ia,ja,info,& logical :: append_, rscale_, cscale_ integer(psb_ipk_) :: nzin_, jmin_, jmax_, err_act, i - integer(psb_ipk_) :: ierr(5) character(len=20) :: name='csget' logical, parameter :: debug=.false. @@ -2021,7 +2014,6 @@ subroutine psb_c_csr_csgetrow(imin,imax,a,nz,ia,ja,val,info,& logical :: append_, rscale_, cscale_ integer(psb_ipk_) :: nzin_, jmin_, jmax_, err_act, i - integer(psb_ipk_) :: ierr(5) character(len=20) :: name='csget' logical, parameter :: debug=.false. @@ -2195,7 +2187,6 @@ subroutine psb_c_csr_csgetblk(imin,imax,a,b,info,& integer(psb_ipk_), intent(in), optional :: jmin,jmax logical, intent(in), optional :: rscale,cscale integer(psb_ipk_) :: err_act, nzin, nzout - integer(psb_ipk_) :: ierr(5) character(len=20) :: name='csget' logical :: append_ logical, parameter :: debug=.false. @@ -2249,7 +2240,6 @@ subroutine psb_c_csr_csput_a(nz,ia,ja,val,a,imin,imax,jmin,jmax,info,gtl) integer(psb_ipk_) :: err_act - integer(psb_ipk_) :: ierr(5) character(len=20) :: name='c_csr_csput_a' logical, parameter :: debug=.false. integer(psb_ipk_) :: nza, i,j,k, nzl, isza, debug_level, debug_unit @@ -2261,28 +2251,24 @@ subroutine psb_c_csr_csput_a(nz,ia,ja,val,a,imin,imax,jmin,jmax,info,gtl) debug_level = psb_get_debug_level() if (nz <= 0) then - info = psb_err_iarg_neg_ - ierr(1)=1 - call psb_errpush(info,name,i_err=ierr) + info = psb_err_iarg_neg_; i=1 + call psb_errpush(info,name,i_err=(/i/)) goto 9999 end if if (size(ia) < nz) then - info = psb_err_input_asize_invalid_i_ - ierr(1)=2 - call psb_errpush(info,name,i_err=ierr) + info = psb_err_input_asize_invalid_i_; i=2 + call psb_errpush(info,name,i_err=(/i/)) goto 9999 end if if (size(ja) < nz) then - info = psb_err_input_asize_invalid_i_ - ierr(1)=3 - call psb_errpush(info,name,i_err=ierr) + info = psb_err_input_asize_invalid_i_; i=3 + call psb_errpush(info,name,i_err=(/i/)) goto 9999 end if if (size(val) < nz) then - info = psb_err_input_asize_invalid_i_ - ierr(1)=4 - call psb_errpush(info,name,i_err=ierr) + info = psb_err_input_asize_invalid_i_; i=4 + call psb_errpush(info,name,i_err=(/i/)) goto 9999 end if @@ -2510,7 +2496,6 @@ subroutine psb_c_csr_reinit(a,clear) logical, intent(in), optional :: clear integer(psb_ipk_) :: err_act, info - integer(psb_ipk_) :: ierr(5) character(len=20) :: name='reinit' logical :: clear_ logical, parameter :: debug=.false. @@ -2555,7 +2540,6 @@ subroutine psb_c_csr_trim(a) implicit none class(psb_c_csr_sparse_mat), intent(inout) :: a integer(psb_ipk_) :: err_act, info, nz, m - integer(psb_ipk_) :: ierr(5) character(len=20) :: name='trim' logical, parameter :: debug=.false. @@ -2590,7 +2574,6 @@ subroutine psb_c_csr_print(iout,a,iv,head,ivr,ivc) integer(psb_ipk_), intent(in), optional :: ivr(:), ivc(:) integer(psb_ipk_) :: err_act - integer(psb_ipk_) :: ierr(5) character(len=20) :: name='c_csr_print' logical, parameter :: debug=.false. character(len=*), parameter :: datatype='complex' diff --git a/base/serial/impl/psb_d_csr_impl.f90 b/base/serial/impl/psb_d_csr_impl.f90 index 8e12adf9b..cb0f1da07 100644 --- a/base/serial/impl/psb_d_csr_impl.f90 +++ b/base/serial/impl/psb_d_csr_impl.f90 @@ -1018,7 +1018,6 @@ subroutine psb_d_csr_cssm(alpha,a,x,beta,y,info,trans) real(psb_dpk_), allocatable :: tmp(:,:) logical :: tra, ctra integer(psb_ipk_) :: err_act - integer(psb_ipk_) :: ierr(5) character(len=20) :: name='d_csr_cssm' logical, parameter :: debug=.false. @@ -1270,7 +1269,6 @@ function psb_d_csr_maxval(a) result(res) real(psb_dpk_) :: res integer(psb_ipk_) :: i,j,k,m,n, nnz, ir, jc, nc, info - integer(psb_ipk_) :: ierr(5) character(len=20) :: name='d_csr_maxval' logical, parameter :: debug=.false. @@ -1295,7 +1293,6 @@ function psb_d_csr_csnmi(a) result(res) real(psb_dpk_) :: acc logical :: tra integer(psb_ipk_) :: err_act - integer(psb_ipk_) :: ierr(5) character(len=20) :: name='d_csnmi' logical, parameter :: debug=.false. @@ -1655,7 +1652,6 @@ subroutine psb_d_csr_scals(d,a,info) integer(psb_ipk_), intent(out) :: info integer(psb_ipk_) :: err_act,mnm, i, j, m - integer(psb_ipk_) :: ierr(5) character(len=20) :: name='scal' logical, parameter :: debug=.false. @@ -1704,7 +1700,6 @@ subroutine psb_d_csr_reallocate_nz(nz,a) integer(psb_ipk_), intent(in) :: nz class(psb_d_csr_sparse_mat), intent(inout) :: a integer(psb_ipk_) :: err_act, info - integer(psb_ipk_) :: ierr(5) character(len=20) :: name='d_csr_reallocate_nz' logical, parameter :: debug=.false. @@ -1736,7 +1731,6 @@ subroutine psb_d_csr_mold(a,b,info) class(psb_d_base_sparse_mat), intent(inout), allocatable :: b integer(psb_ipk_), intent(out) :: info integer(psb_ipk_) :: err_act - integer(psb_ipk_) :: ierr(5) character(len=20) :: name='csr_mold' logical, parameter :: debug=.false. @@ -1846,7 +1840,6 @@ subroutine psb_d_csr_csgetptn(imin,imax,a,nz,ia,ja,info,& logical :: append_, rscale_, cscale_ integer(psb_ipk_) :: nzin_, jmin_, jmax_, err_act, i - integer(psb_ipk_) :: ierr(5) character(len=20) :: name='csget' logical, parameter :: debug=.false. @@ -2021,7 +2014,6 @@ subroutine psb_d_csr_csgetrow(imin,imax,a,nz,ia,ja,val,info,& logical :: append_, rscale_, cscale_ integer(psb_ipk_) :: nzin_, jmin_, jmax_, err_act, i - integer(psb_ipk_) :: ierr(5) character(len=20) :: name='csget' logical, parameter :: debug=.false. @@ -2195,7 +2187,6 @@ subroutine psb_d_csr_csgetblk(imin,imax,a,b,info,& integer(psb_ipk_), intent(in), optional :: jmin,jmax logical, intent(in), optional :: rscale,cscale integer(psb_ipk_) :: err_act, nzin, nzout - integer(psb_ipk_) :: ierr(5) character(len=20) :: name='csget' logical :: append_ logical, parameter :: debug=.false. @@ -2249,7 +2240,6 @@ subroutine psb_d_csr_csput_a(nz,ia,ja,val,a,imin,imax,jmin,jmax,info,gtl) integer(psb_ipk_) :: err_act - integer(psb_ipk_) :: ierr(5) character(len=20) :: name='d_csr_csput_a' logical, parameter :: debug=.false. integer(psb_ipk_) :: nza, i,j,k, nzl, isza, debug_level, debug_unit @@ -2261,28 +2251,24 @@ subroutine psb_d_csr_csput_a(nz,ia,ja,val,a,imin,imax,jmin,jmax,info,gtl) debug_level = psb_get_debug_level() if (nz <= 0) then - info = psb_err_iarg_neg_ - ierr(1)=1 - call psb_errpush(info,name,i_err=ierr) + info = psb_err_iarg_neg_; i=1 + call psb_errpush(info,name,i_err=(/i/)) goto 9999 end if if (size(ia) < nz) then - info = psb_err_input_asize_invalid_i_ - ierr(1)=2 - call psb_errpush(info,name,i_err=ierr) + info = psb_err_input_asize_invalid_i_; i=2 + call psb_errpush(info,name,i_err=(/i/)) goto 9999 end if if (size(ja) < nz) then - info = psb_err_input_asize_invalid_i_ - ierr(1)=3 - call psb_errpush(info,name,i_err=ierr) + info = psb_err_input_asize_invalid_i_; i=3 + call psb_errpush(info,name,i_err=(/i/)) goto 9999 end if if (size(val) < nz) then - info = psb_err_input_asize_invalid_i_ - ierr(1)=4 - call psb_errpush(info,name,i_err=ierr) + info = psb_err_input_asize_invalid_i_; i=4 + call psb_errpush(info,name,i_err=(/i/)) goto 9999 end if @@ -2510,7 +2496,6 @@ subroutine psb_d_csr_reinit(a,clear) logical, intent(in), optional :: clear integer(psb_ipk_) :: err_act, info - integer(psb_ipk_) :: ierr(5) character(len=20) :: name='reinit' logical :: clear_ logical, parameter :: debug=.false. @@ -2555,7 +2540,6 @@ subroutine psb_d_csr_trim(a) implicit none class(psb_d_csr_sparse_mat), intent(inout) :: a integer(psb_ipk_) :: err_act, info, nz, m - integer(psb_ipk_) :: ierr(5) character(len=20) :: name='trim' logical, parameter :: debug=.false. @@ -2590,7 +2574,6 @@ subroutine psb_d_csr_print(iout,a,iv,head,ivr,ivc) integer(psb_ipk_), intent(in), optional :: ivr(:), ivc(:) integer(psb_ipk_) :: err_act - integer(psb_ipk_) :: ierr(5) character(len=20) :: name='d_csr_print' logical, parameter :: debug=.false. character(len=*), parameter :: datatype='real' diff --git a/base/serial/impl/psb_s_csr_impl.f90 b/base/serial/impl/psb_s_csr_impl.f90 index 1248cb3fb..1a3ebb9b8 100644 --- a/base/serial/impl/psb_s_csr_impl.f90 +++ b/base/serial/impl/psb_s_csr_impl.f90 @@ -1018,7 +1018,6 @@ subroutine psb_s_csr_cssm(alpha,a,x,beta,y,info,trans) real(psb_spk_), allocatable :: tmp(:,:) logical :: tra, ctra integer(psb_ipk_) :: err_act - integer(psb_ipk_) :: ierr(5) character(len=20) :: name='s_csr_cssm' logical, parameter :: debug=.false. @@ -1270,7 +1269,6 @@ function psb_s_csr_maxval(a) result(res) real(psb_spk_) :: res integer(psb_ipk_) :: i,j,k,m,n, nnz, ir, jc, nc, info - integer(psb_ipk_) :: ierr(5) character(len=20) :: name='s_csr_maxval' logical, parameter :: debug=.false. @@ -1295,7 +1293,6 @@ function psb_s_csr_csnmi(a) result(res) real(psb_spk_) :: acc logical :: tra integer(psb_ipk_) :: err_act - integer(psb_ipk_) :: ierr(5) character(len=20) :: name='s_csnmi' logical, parameter :: debug=.false. @@ -1655,7 +1652,6 @@ subroutine psb_s_csr_scals(d,a,info) integer(psb_ipk_), intent(out) :: info integer(psb_ipk_) :: err_act,mnm, i, j, m - integer(psb_ipk_) :: ierr(5) character(len=20) :: name='scal' logical, parameter :: debug=.false. @@ -1704,7 +1700,6 @@ subroutine psb_s_csr_reallocate_nz(nz,a) integer(psb_ipk_), intent(in) :: nz class(psb_s_csr_sparse_mat), intent(inout) :: a integer(psb_ipk_) :: err_act, info - integer(psb_ipk_) :: ierr(5) character(len=20) :: name='s_csr_reallocate_nz' logical, parameter :: debug=.false. @@ -1736,7 +1731,6 @@ subroutine psb_s_csr_mold(a,b,info) class(psb_s_base_sparse_mat), intent(inout), allocatable :: b integer(psb_ipk_), intent(out) :: info integer(psb_ipk_) :: err_act - integer(psb_ipk_) :: ierr(5) character(len=20) :: name='csr_mold' logical, parameter :: debug=.false. @@ -1846,7 +1840,6 @@ subroutine psb_s_csr_csgetptn(imin,imax,a,nz,ia,ja,info,& logical :: append_, rscale_, cscale_ integer(psb_ipk_) :: nzin_, jmin_, jmax_, err_act, i - integer(psb_ipk_) :: ierr(5) character(len=20) :: name='csget' logical, parameter :: debug=.false. @@ -2021,7 +2014,6 @@ subroutine psb_s_csr_csgetrow(imin,imax,a,nz,ia,ja,val,info,& logical :: append_, rscale_, cscale_ integer(psb_ipk_) :: nzin_, jmin_, jmax_, err_act, i - integer(psb_ipk_) :: ierr(5) character(len=20) :: name='csget' logical, parameter :: debug=.false. @@ -2195,7 +2187,6 @@ subroutine psb_s_csr_csgetblk(imin,imax,a,b,info,& integer(psb_ipk_), intent(in), optional :: jmin,jmax logical, intent(in), optional :: rscale,cscale integer(psb_ipk_) :: err_act, nzin, nzout - integer(psb_ipk_) :: ierr(5) character(len=20) :: name='csget' logical :: append_ logical, parameter :: debug=.false. @@ -2249,7 +2240,6 @@ subroutine psb_s_csr_csput_a(nz,ia,ja,val,a,imin,imax,jmin,jmax,info,gtl) integer(psb_ipk_) :: err_act - integer(psb_ipk_) :: ierr(5) character(len=20) :: name='s_csr_csput_a' logical, parameter :: debug=.false. integer(psb_ipk_) :: nza, i,j,k, nzl, isza, debug_level, debug_unit @@ -2261,28 +2251,24 @@ subroutine psb_s_csr_csput_a(nz,ia,ja,val,a,imin,imax,jmin,jmax,info,gtl) debug_level = psb_get_debug_level() if (nz <= 0) then - info = psb_err_iarg_neg_ - ierr(1)=1 - call psb_errpush(info,name,i_err=ierr) + info = psb_err_iarg_neg_; i=1 + call psb_errpush(info,name,i_err=(/i/)) goto 9999 end if if (size(ia) < nz) then - info = psb_err_input_asize_invalid_i_ - ierr(1)=2 - call psb_errpush(info,name,i_err=ierr) + info = psb_err_input_asize_invalid_i_; i=2 + call psb_errpush(info,name,i_err=(/i/)) goto 9999 end if if (size(ja) < nz) then - info = psb_err_input_asize_invalid_i_ - ierr(1)=3 - call psb_errpush(info,name,i_err=ierr) + info = psb_err_input_asize_invalid_i_; i=3 + call psb_errpush(info,name,i_err=(/i/)) goto 9999 end if if (size(val) < nz) then - info = psb_err_input_asize_invalid_i_ - ierr(1)=4 - call psb_errpush(info,name,i_err=ierr) + info = psb_err_input_asize_invalid_i_; i=4 + call psb_errpush(info,name,i_err=(/i/)) goto 9999 end if @@ -2510,7 +2496,6 @@ subroutine psb_s_csr_reinit(a,clear) logical, intent(in), optional :: clear integer(psb_ipk_) :: err_act, info - integer(psb_ipk_) :: ierr(5) character(len=20) :: name='reinit' logical :: clear_ logical, parameter :: debug=.false. @@ -2555,7 +2540,6 @@ subroutine psb_s_csr_trim(a) implicit none class(psb_s_csr_sparse_mat), intent(inout) :: a integer(psb_ipk_) :: err_act, info, nz, m - integer(psb_ipk_) :: ierr(5) character(len=20) :: name='trim' logical, parameter :: debug=.false. @@ -2590,7 +2574,6 @@ subroutine psb_s_csr_print(iout,a,iv,head,ivr,ivc) integer(psb_ipk_), intent(in), optional :: ivr(:), ivc(:) integer(psb_ipk_) :: err_act - integer(psb_ipk_) :: ierr(5) character(len=20) :: name='s_csr_print' logical, parameter :: debug=.false. character(len=*), parameter :: datatype='real' diff --git a/base/serial/impl/psb_z_csr_impl.f90 b/base/serial/impl/psb_z_csr_impl.f90 index fa4acd6fc..e9aee0523 100644 --- a/base/serial/impl/psb_z_csr_impl.f90 +++ b/base/serial/impl/psb_z_csr_impl.f90 @@ -1018,7 +1018,6 @@ subroutine psb_z_csr_cssm(alpha,a,x,beta,y,info,trans) complex(psb_dpk_), allocatable :: tmp(:,:) logical :: tra, ctra integer(psb_ipk_) :: err_act - integer(psb_ipk_) :: ierr(5) character(len=20) :: name='z_csr_cssm' logical, parameter :: debug=.false. @@ -1270,7 +1269,6 @@ function psb_z_csr_maxval(a) result(res) real(psb_dpk_) :: res integer(psb_ipk_) :: i,j,k,m,n, nnz, ir, jc, nc, info - integer(psb_ipk_) :: ierr(5) character(len=20) :: name='z_csr_maxval' logical, parameter :: debug=.false. @@ -1295,7 +1293,6 @@ function psb_z_csr_csnmi(a) result(res) real(psb_dpk_) :: acc logical :: tra integer(psb_ipk_) :: err_act - integer(psb_ipk_) :: ierr(5) character(len=20) :: name='z_csnmi' logical, parameter :: debug=.false. @@ -1655,7 +1652,6 @@ subroutine psb_z_csr_scals(d,a,info) integer(psb_ipk_), intent(out) :: info integer(psb_ipk_) :: err_act,mnm, i, j, m - integer(psb_ipk_) :: ierr(5) character(len=20) :: name='scal' logical, parameter :: debug=.false. @@ -1704,7 +1700,6 @@ subroutine psb_z_csr_reallocate_nz(nz,a) integer(psb_ipk_), intent(in) :: nz class(psb_z_csr_sparse_mat), intent(inout) :: a integer(psb_ipk_) :: err_act, info - integer(psb_ipk_) :: ierr(5) character(len=20) :: name='z_csr_reallocate_nz' logical, parameter :: debug=.false. @@ -1736,7 +1731,6 @@ subroutine psb_z_csr_mold(a,b,info) class(psb_z_base_sparse_mat), intent(inout), allocatable :: b integer(psb_ipk_), intent(out) :: info integer(psb_ipk_) :: err_act - integer(psb_ipk_) :: ierr(5) character(len=20) :: name='csr_mold' logical, parameter :: debug=.false. @@ -1846,7 +1840,6 @@ subroutine psb_z_csr_csgetptn(imin,imax,a,nz,ia,ja,info,& logical :: append_, rscale_, cscale_ integer(psb_ipk_) :: nzin_, jmin_, jmax_, err_act, i - integer(psb_ipk_) :: ierr(5) character(len=20) :: name='csget' logical, parameter :: debug=.false. @@ -2021,7 +2014,6 @@ subroutine psb_z_csr_csgetrow(imin,imax,a,nz,ia,ja,val,info,& logical :: append_, rscale_, cscale_ integer(psb_ipk_) :: nzin_, jmin_, jmax_, err_act, i - integer(psb_ipk_) :: ierr(5) character(len=20) :: name='csget' logical, parameter :: debug=.false. @@ -2195,7 +2187,6 @@ subroutine psb_z_csr_csgetblk(imin,imax,a,b,info,& integer(psb_ipk_), intent(in), optional :: jmin,jmax logical, intent(in), optional :: rscale,cscale integer(psb_ipk_) :: err_act, nzin, nzout - integer(psb_ipk_) :: ierr(5) character(len=20) :: name='csget' logical :: append_ logical, parameter :: debug=.false. @@ -2249,7 +2240,6 @@ subroutine psb_z_csr_csput_a(nz,ia,ja,val,a,imin,imax,jmin,jmax,info,gtl) integer(psb_ipk_) :: err_act - integer(psb_ipk_) :: ierr(5) character(len=20) :: name='z_csr_csput_a' logical, parameter :: debug=.false. integer(psb_ipk_) :: nza, i,j,k, nzl, isza, debug_level, debug_unit @@ -2261,28 +2251,24 @@ subroutine psb_z_csr_csput_a(nz,ia,ja,val,a,imin,imax,jmin,jmax,info,gtl) debug_level = psb_get_debug_level() if (nz <= 0) then - info = psb_err_iarg_neg_ - ierr(1)=1 - call psb_errpush(info,name,i_err=ierr) + info = psb_err_iarg_neg_; i=1 + call psb_errpush(info,name,i_err=(/i/)) goto 9999 end if if (size(ia) < nz) then - info = psb_err_input_asize_invalid_i_ - ierr(1)=2 - call psb_errpush(info,name,i_err=ierr) + info = psb_err_input_asize_invalid_i_; i=2 + call psb_errpush(info,name,i_err=(/i/)) goto 9999 end if if (size(ja) < nz) then - info = psb_err_input_asize_invalid_i_ - ierr(1)=3 - call psb_errpush(info,name,i_err=ierr) + info = psb_err_input_asize_invalid_i_; i=3 + call psb_errpush(info,name,i_err=(/i/)) goto 9999 end if if (size(val) < nz) then - info = psb_err_input_asize_invalid_i_ - ierr(1)=4 - call psb_errpush(info,name,i_err=ierr) + info = psb_err_input_asize_invalid_i_; i=4 + call psb_errpush(info,name,i_err=(/i/)) goto 9999 end if @@ -2510,7 +2496,6 @@ subroutine psb_z_csr_reinit(a,clear) logical, intent(in), optional :: clear integer(psb_ipk_) :: err_act, info - integer(psb_ipk_) :: ierr(5) character(len=20) :: name='reinit' logical :: clear_ logical, parameter :: debug=.false. @@ -2555,7 +2540,6 @@ subroutine psb_z_csr_trim(a) implicit none class(psb_z_csr_sparse_mat), intent(inout) :: a integer(psb_ipk_) :: err_act, info, nz, m - integer(psb_ipk_) :: ierr(5) character(len=20) :: name='trim' logical, parameter :: debug=.false. @@ -2590,7 +2574,6 @@ subroutine psb_z_csr_print(iout,a,iv,head,ivr,ivc) integer(psb_ipk_), intent(in), optional :: ivr(:), ivc(:) integer(psb_ipk_) :: err_act - integer(psb_ipk_) :: ierr(5) character(len=20) :: name='z_csr_print' logical, parameter :: debug=.false. character(len=*), parameter :: datatype='complex' diff --git a/base/tools/psb_casb.f90 b/base/tools/psb_casb.f90 index e17a9dd53..5c6b7dc29 100644 --- a/base/tools/psb_casb.f90 +++ b/base/tools/psb_casb.f90 @@ -54,7 +54,7 @@ subroutine psb_casb_vect(x, desc_a, info, mold, scratch) ! local variables integer(psb_ipk_) :: ictxt,np,me - integer(psb_ipk_) :: int_err(5), i1sz,nrow,ncol, err_act + integer(psb_ipk_) :: i1sz,nrow,ncol, err_act logical :: scratch_ integer(psb_ipk_) :: debug_level, debug_unit character(len=20) :: name,ch_err @@ -62,7 +62,6 @@ subroutine psb_casb_vect(x, desc_a, info, mold, scratch) info = psb_success_ if (psb_errstatus_fatal()) return - int_err(1) = 0 name = 'psb_cgeasb_v' ictxt = desc_a%get_context() @@ -128,7 +127,7 @@ subroutine psb_casb_vect_r2(x, desc_a, info, mold, scratch) ! local variables integer(psb_ipk_) :: ictxt,np,me, i, n - integer(psb_ipk_) :: int_err(5), i1sz,nrow,ncol, err_act + integer(psb_ipk_) :: i1sz,nrow,ncol, err_act logical :: scratch_ integer(psb_ipk_) :: debug_level, debug_unit character(len=20) :: name,ch_err @@ -136,7 +135,6 @@ subroutine psb_casb_vect_r2(x, desc_a, info, mold, scratch) info = psb_success_ if (psb_errstatus_fatal()) return - int_err(1) = 0 name = 'psb_cgeasb_v' ictxt = desc_a%get_context() @@ -211,7 +209,7 @@ subroutine psb_casb_multivect(x, desc_a, info, mold, scratch,n) ! local variables integer(psb_ipk_) :: ictxt,np,me - integer(psb_ipk_) :: int_err(5), i1sz,nrow,ncol, err_act, n_ + integer(psb_ipk_) :: i1sz,nrow,ncol, err_act, n_ logical :: scratch_ integer(psb_ipk_) :: debug_level, debug_unit @@ -220,7 +218,6 @@ subroutine psb_casb_multivect(x, desc_a, info, mold, scratch,n) info = psb_success_ if (psb_errstatus_fatal()) return - int_err(1) = 0 name = 'psb_cgeasb' ictxt = desc_a%get_context() diff --git a/base/tools/psb_casb_a.f90 b/base/tools/psb_casb_a.f90 index 35ffe4bf2..c1825eb74 100644 --- a/base/tools/psb_casb_a.f90 +++ b/base/tools/psb_casb_a.f90 @@ -187,13 +187,12 @@ subroutine psb_casbv(x, desc_a, info, scratch) ! local variables integer(psb_ipk_) :: ictxt,np,me - integer(psb_ipk_) :: int_err(5), i1sz,nrow,ncol, err_act + integer(psb_ipk_) :: i1sz,nrow,ncol, err_act integer(psb_ipk_) :: debug_level, debug_unit logical :: scratch_ character(len=20) :: name,ch_err info = psb_success_ - int_err(1) = 0 name = 'psb_cgeasb_v' ictxt = desc_a%get_context() diff --git a/base/tools/psb_cspasb.f90 b/base/tools/psb_cspasb.f90 index 1c783cf41..ae5c0af2c 100644 --- a/base/tools/psb_cspasb.f90 +++ b/base/tools/psb_cspasb.f90 @@ -62,14 +62,12 @@ subroutine psb_cspasb(a,desc_a, info, afmt, upd, dupl, mold) character(len=*), optional, intent(in) :: afmt class(psb_c_base_sparse_mat), intent(in), optional :: mold !....Locals.... - integer(psb_ipk_) :: int_err(5) integer(psb_ipk_) :: ictxt,np,me, err_act integer(psb_ipk_) :: n_row,n_col integer(psb_ipk_) :: debug_level, debug_unit character(len=20) :: name, ch_err info = psb_success_ - int_err(1)=0 name = 'psb_spasb' call psb_erractionsave(err_act) debug_unit = psb_get_debug_unit() diff --git a/base/tools/psb_cspins.f90 b/base/tools/psb_cspins.f90 index bb432adcc..2855bc1ea 100644 --- a/base/tools/psb_cspins.f90 +++ b/base/tools/psb_cspins.f90 @@ -69,7 +69,6 @@ subroutine psb_cspins(nz,ia,ja,val,a,desc_a,info,rebuild,local) integer(psb_ipk_), parameter :: relocsz=200 logical :: rebuild_, local_ integer(psb_ipk_), allocatable :: ila(:),jla(:) - integer(psb_ipk_) :: ierr(5) character(len=20) :: name info = psb_success_ @@ -123,9 +122,8 @@ subroutine psb_cspins(nz,ia,ja,val,a,desc_a,info,rebuild,local) else allocate(ila(nz),jla(nz),stat=info) if (info /= psb_success_) then - ierr(1) = info call psb_errpush(psb_err_from_subroutine_ai_,name,& - & a_err='allocate',i_err=ierr) + & a_err='allocate',i_err=(/info/)) goto 9999 end if @@ -134,9 +132,8 @@ subroutine psb_cspins(nz,ia,ja,val,a,desc_a,info,rebuild,local) & mask=(ila(1:nz)>0)) if (info /= psb_success_) then - ierr(1) = info call psb_errpush(psb_err_from_subroutine_ai_,name,& - & a_err='psb_cdins',i_err=ierr) + & a_err='psb_cdins',i_err=(/info/)) goto 9999 end if nrow = desc_a%get_local_rows() @@ -162,9 +159,8 @@ subroutine psb_cspins(nz,ia,ja,val,a,desc_a,info,rebuild,local) ncol = desc_a%get_local_cols() allocate(ila(nz),jla(nz),stat=info) if (info /= psb_success_) then - ierr(1) = info call psb_errpush(psb_err_from_subroutine_ai_,name,& - & a_err='allocate',i_err=ierr) + & a_err='allocate',i_err=(/info/)) goto 9999 end if if (local_) then @@ -216,7 +212,6 @@ subroutine psb_cspins_2desc(nz,ia,ja,val,a,desc_ar,desc_ac,info) logical, parameter :: debug=.false. integer(psb_ipk_), parameter :: relocsz=200 integer(psb_ipk_), allocatable :: ila(:),jla(:) - integer(psb_ipk_) :: ierr(5) character(len=20) :: name info = psb_success_ @@ -264,9 +259,8 @@ subroutine psb_cspins_2desc(nz,ia,ja,val,a,desc_ar,desc_ac,info) allocate(ila(nz),jla(nz),stat=info) if (info /= psb_success_) then - ierr(1) = info call psb_errpush(psb_err_from_subroutine_ai_,name,& - & a_err='allocate',i_err=ierr) + & a_err='allocate',i_err=(/info/)) goto 9999 end if @@ -275,9 +269,8 @@ subroutine psb_cspins_2desc(nz,ia,ja,val,a,desc_ar,desc_ac,info) & mask=(ila(1:nz)>0)) if (psb_errstatus_fatal()) then - ierr(1) = info call psb_errpush(psb_err_from_subroutine_ai_,name,& - & a_err='psb_cdins',i_err=ierr) + & a_err='psb_cdins',i_err=(/info/)) goto 9999 end if @@ -336,7 +329,6 @@ subroutine psb_cspins_v(nz,ia,ja,val,a,desc_a,info,rebuild,local) logical :: rebuild_, local_ integer(psb_ipk_), allocatable :: ila(:),jla(:) real(psb_dpk_) :: t1,t2,t3,tcnv,tcsput - integer(psb_ipk_) :: ierr(5) character(len=20) :: name info = psb_success_ @@ -390,9 +382,8 @@ subroutine psb_cspins_v(nz,ia,ja,val,a,desc_a,info,rebuild,local) else allocate(ila(nz),jla(nz),stat=info) if (info /= psb_success_) then - ierr(1) = info call psb_errpush(psb_err_from_subroutine_ai_,name,& - & a_err='allocate',i_err=ierr) + & a_err='allocate',i_err=(/info/)) goto 9999 end if if (ia%is_dev()) call ia%sync() @@ -403,9 +394,8 @@ subroutine psb_cspins_v(nz,ia,ja,val,a,desc_a,info,rebuild,local) call desc_a%indxmap%g2l_ins(ja%v%v(1:nz),jla(1:nz),info,mask=(ila(1:nz)>0)) if (info /= psb_success_) then - ierr(1) = info call psb_errpush(psb_err_from_subroutine_ai_,name,& - & a_err='psb_cdins',i_err=ierr) + & a_err='psb_cdins',i_err=(/info/)) goto 9999 end if nrow = desc_a%get_local_rows() @@ -431,9 +421,8 @@ subroutine psb_cspins_v(nz,ia,ja,val,a,desc_a,info,rebuild,local) ncol = desc_a%get_local_cols() allocate(ila(nz),jla(nz),stat=info) if (info /= psb_success_) then - ierr(1) = info call psb_errpush(psb_err_from_subroutine_ai_,name,& - & a_err='allocate',i_err=ierr) + & a_err='allocate',i_err=(/info/)) goto 9999 end if if (ia%is_dev()) call ia%sync() diff --git a/base/tools/psb_csprn.f90 b/base/tools/psb_csprn.f90 index f5f1d0fdd..3912cdae7 100644 --- a/base/tools/psb_csprn.f90 +++ b/base/tools/psb_csprn.f90 @@ -53,15 +53,12 @@ Subroutine psb_csprn(a, desc_a,info,clear) logical, intent(in), optional :: clear !locals - integer(psb_ipk_) :: ictxt,np,me,err,err_act + integer(psb_ipk_) :: ictxt,np,me,err_act integer(psb_ipk_) :: debug_level, debug_unit - integer(psb_ipk_) :: int_err(5) character(len=20) :: name logical :: clear_ info = psb_success_ - err = 0 - int_err(1)=0 name = 'psb_csprn' call psb_erractionsave(err_act) debug_unit = psb_get_debug_unit() diff --git a/base/tools/psb_dasb.f90 b/base/tools/psb_dasb.f90 index 322b5f11a..3a022b1c4 100644 --- a/base/tools/psb_dasb.f90 +++ b/base/tools/psb_dasb.f90 @@ -54,7 +54,7 @@ subroutine psb_dasb_vect(x, desc_a, info, mold, scratch) ! local variables integer(psb_ipk_) :: ictxt,np,me - integer(psb_ipk_) :: int_err(5), i1sz,nrow,ncol, err_act + integer(psb_ipk_) :: i1sz,nrow,ncol, err_act logical :: scratch_ integer(psb_ipk_) :: debug_level, debug_unit character(len=20) :: name,ch_err @@ -62,7 +62,6 @@ subroutine psb_dasb_vect(x, desc_a, info, mold, scratch) info = psb_success_ if (psb_errstatus_fatal()) return - int_err(1) = 0 name = 'psb_dgeasb_v' ictxt = desc_a%get_context() @@ -128,7 +127,7 @@ subroutine psb_dasb_vect_r2(x, desc_a, info, mold, scratch) ! local variables integer(psb_ipk_) :: ictxt,np,me, i, n - integer(psb_ipk_) :: int_err(5), i1sz,nrow,ncol, err_act + integer(psb_ipk_) :: i1sz,nrow,ncol, err_act logical :: scratch_ integer(psb_ipk_) :: debug_level, debug_unit character(len=20) :: name,ch_err @@ -136,7 +135,6 @@ subroutine psb_dasb_vect_r2(x, desc_a, info, mold, scratch) info = psb_success_ if (psb_errstatus_fatal()) return - int_err(1) = 0 name = 'psb_dgeasb_v' ictxt = desc_a%get_context() @@ -211,7 +209,7 @@ subroutine psb_dasb_multivect(x, desc_a, info, mold, scratch,n) ! local variables integer(psb_ipk_) :: ictxt,np,me - integer(psb_ipk_) :: int_err(5), i1sz,nrow,ncol, err_act, n_ + integer(psb_ipk_) :: i1sz,nrow,ncol, err_act, n_ logical :: scratch_ integer(psb_ipk_) :: debug_level, debug_unit @@ -220,7 +218,6 @@ subroutine psb_dasb_multivect(x, desc_a, info, mold, scratch,n) info = psb_success_ if (psb_errstatus_fatal()) return - int_err(1) = 0 name = 'psb_dgeasb' ictxt = desc_a%get_context() diff --git a/base/tools/psb_dasb_a.f90 b/base/tools/psb_dasb_a.f90 index ebb47158f..dcf75960d 100644 --- a/base/tools/psb_dasb_a.f90 +++ b/base/tools/psb_dasb_a.f90 @@ -187,13 +187,12 @@ subroutine psb_dasbv(x, desc_a, info, scratch) ! local variables integer(psb_ipk_) :: ictxt,np,me - integer(psb_ipk_) :: int_err(5), i1sz,nrow,ncol, err_act + integer(psb_ipk_) :: i1sz,nrow,ncol, err_act integer(psb_ipk_) :: debug_level, debug_unit logical :: scratch_ character(len=20) :: name,ch_err info = psb_success_ - int_err(1) = 0 name = 'psb_dgeasb_v' ictxt = desc_a%get_context() diff --git a/base/tools/psb_dspasb.f90 b/base/tools/psb_dspasb.f90 index 60ad8c599..c2434c09c 100644 --- a/base/tools/psb_dspasb.f90 +++ b/base/tools/psb_dspasb.f90 @@ -62,14 +62,12 @@ subroutine psb_dspasb(a,desc_a, info, afmt, upd, dupl, mold) character(len=*), optional, intent(in) :: afmt class(psb_d_base_sparse_mat), intent(in), optional :: mold !....Locals.... - integer(psb_ipk_) :: int_err(5) integer(psb_ipk_) :: ictxt,np,me, err_act integer(psb_ipk_) :: n_row,n_col integer(psb_ipk_) :: debug_level, debug_unit character(len=20) :: name, ch_err info = psb_success_ - int_err(1)=0 name = 'psb_spasb' call psb_erractionsave(err_act) debug_unit = psb_get_debug_unit() diff --git a/base/tools/psb_dspins.f90 b/base/tools/psb_dspins.f90 index 87c08a495..00d6a6af5 100644 --- a/base/tools/psb_dspins.f90 +++ b/base/tools/psb_dspins.f90 @@ -69,7 +69,6 @@ subroutine psb_dspins(nz,ia,ja,val,a,desc_a,info,rebuild,local) integer(psb_ipk_), parameter :: relocsz=200 logical :: rebuild_, local_ integer(psb_ipk_), allocatable :: ila(:),jla(:) - integer(psb_ipk_) :: ierr(5) character(len=20) :: name info = psb_success_ @@ -123,9 +122,8 @@ subroutine psb_dspins(nz,ia,ja,val,a,desc_a,info,rebuild,local) else allocate(ila(nz),jla(nz),stat=info) if (info /= psb_success_) then - ierr(1) = info call psb_errpush(psb_err_from_subroutine_ai_,name,& - & a_err='allocate',i_err=ierr) + & a_err='allocate',i_err=(/info/)) goto 9999 end if @@ -134,9 +132,8 @@ subroutine psb_dspins(nz,ia,ja,val,a,desc_a,info,rebuild,local) & mask=(ila(1:nz)>0)) if (info /= psb_success_) then - ierr(1) = info call psb_errpush(psb_err_from_subroutine_ai_,name,& - & a_err='psb_cdins',i_err=ierr) + & a_err='psb_cdins',i_err=(/info/)) goto 9999 end if nrow = desc_a%get_local_rows() @@ -162,9 +159,8 @@ subroutine psb_dspins(nz,ia,ja,val,a,desc_a,info,rebuild,local) ncol = desc_a%get_local_cols() allocate(ila(nz),jla(nz),stat=info) if (info /= psb_success_) then - ierr(1) = info call psb_errpush(psb_err_from_subroutine_ai_,name,& - & a_err='allocate',i_err=ierr) + & a_err='allocate',i_err=(/info/)) goto 9999 end if if (local_) then @@ -216,7 +212,6 @@ subroutine psb_dspins_2desc(nz,ia,ja,val,a,desc_ar,desc_ac,info) logical, parameter :: debug=.false. integer(psb_ipk_), parameter :: relocsz=200 integer(psb_ipk_), allocatable :: ila(:),jla(:) - integer(psb_ipk_) :: ierr(5) character(len=20) :: name info = psb_success_ @@ -264,9 +259,8 @@ subroutine psb_dspins_2desc(nz,ia,ja,val,a,desc_ar,desc_ac,info) allocate(ila(nz),jla(nz),stat=info) if (info /= psb_success_) then - ierr(1) = info call psb_errpush(psb_err_from_subroutine_ai_,name,& - & a_err='allocate',i_err=ierr) + & a_err='allocate',i_err=(/info/)) goto 9999 end if @@ -275,9 +269,8 @@ subroutine psb_dspins_2desc(nz,ia,ja,val,a,desc_ar,desc_ac,info) & mask=(ila(1:nz)>0)) if (psb_errstatus_fatal()) then - ierr(1) = info call psb_errpush(psb_err_from_subroutine_ai_,name,& - & a_err='psb_cdins',i_err=ierr) + & a_err='psb_cdins',i_err=(/info/)) goto 9999 end if @@ -336,7 +329,6 @@ subroutine psb_dspins_v(nz,ia,ja,val,a,desc_a,info,rebuild,local) logical :: rebuild_, local_ integer(psb_ipk_), allocatable :: ila(:),jla(:) real(psb_dpk_) :: t1,t2,t3,tcnv,tcsput - integer(psb_ipk_) :: ierr(5) character(len=20) :: name info = psb_success_ @@ -390,9 +382,8 @@ subroutine psb_dspins_v(nz,ia,ja,val,a,desc_a,info,rebuild,local) else allocate(ila(nz),jla(nz),stat=info) if (info /= psb_success_) then - ierr(1) = info call psb_errpush(psb_err_from_subroutine_ai_,name,& - & a_err='allocate',i_err=ierr) + & a_err='allocate',i_err=(/info/)) goto 9999 end if if (ia%is_dev()) call ia%sync() @@ -403,9 +394,8 @@ subroutine psb_dspins_v(nz,ia,ja,val,a,desc_a,info,rebuild,local) call desc_a%indxmap%g2l_ins(ja%v%v(1:nz),jla(1:nz),info,mask=(ila(1:nz)>0)) if (info /= psb_success_) then - ierr(1) = info call psb_errpush(psb_err_from_subroutine_ai_,name,& - & a_err='psb_cdins',i_err=ierr) + & a_err='psb_cdins',i_err=(/info/)) goto 9999 end if nrow = desc_a%get_local_rows() @@ -431,9 +421,8 @@ subroutine psb_dspins_v(nz,ia,ja,val,a,desc_a,info,rebuild,local) ncol = desc_a%get_local_cols() allocate(ila(nz),jla(nz),stat=info) if (info /= psb_success_) then - ierr(1) = info call psb_errpush(psb_err_from_subroutine_ai_,name,& - & a_err='allocate',i_err=ierr) + & a_err='allocate',i_err=(/info/)) goto 9999 end if if (ia%is_dev()) call ia%sync() diff --git a/base/tools/psb_dsprn.f90 b/base/tools/psb_dsprn.f90 index f2ed83592..c5f81e488 100644 --- a/base/tools/psb_dsprn.f90 +++ b/base/tools/psb_dsprn.f90 @@ -53,15 +53,12 @@ Subroutine psb_dsprn(a, desc_a,info,clear) logical, intent(in), optional :: clear !locals - integer(psb_ipk_) :: ictxt,np,me,err,err_act + integer(psb_ipk_) :: ictxt,np,me,err_act integer(psb_ipk_) :: debug_level, debug_unit - integer(psb_ipk_) :: int_err(5) character(len=20) :: name logical :: clear_ info = psb_success_ - err = 0 - int_err(1)=0 name = 'psb_dsprn' call psb_erractionsave(err_act) debug_unit = psb_get_debug_unit() diff --git a/base/tools/psb_easb_a.f90 b/base/tools/psb_easb_a.f90 index 340a7c0d7..0945a2c88 100644 --- a/base/tools/psb_easb_a.f90 +++ b/base/tools/psb_easb_a.f90 @@ -187,13 +187,12 @@ subroutine psb_easbv(x, desc_a, info, scratch) ! local variables integer(psb_ipk_) :: ictxt,np,me - integer(psb_ipk_) :: int_err(5), i1sz,nrow,ncol, err_act + integer(psb_ipk_) :: i1sz,nrow,ncol, err_act integer(psb_ipk_) :: debug_level, debug_unit logical :: scratch_ character(len=20) :: name,ch_err info = psb_success_ - int_err(1) = 0 name = 'psb_egeasb_v' ictxt = desc_a%get_context() diff --git a/base/tools/psb_iasb.f90 b/base/tools/psb_iasb.f90 index 8a1d7f86f..11bf80d71 100644 --- a/base/tools/psb_iasb.f90 +++ b/base/tools/psb_iasb.f90 @@ -54,7 +54,7 @@ subroutine psb_iasb_vect(x, desc_a, info, mold, scratch) ! local variables integer(psb_ipk_) :: ictxt,np,me - integer(psb_ipk_) :: int_err(5), i1sz,nrow,ncol, err_act + integer(psb_ipk_) :: i1sz,nrow,ncol, err_act logical :: scratch_ integer(psb_ipk_) :: debug_level, debug_unit character(len=20) :: name,ch_err @@ -62,7 +62,6 @@ subroutine psb_iasb_vect(x, desc_a, info, mold, scratch) info = psb_success_ if (psb_errstatus_fatal()) return - int_err(1) = 0 name = 'psb_igeasb_v' ictxt = desc_a%get_context() @@ -128,7 +127,7 @@ subroutine psb_iasb_vect_r2(x, desc_a, info, mold, scratch) ! local variables integer(psb_ipk_) :: ictxt,np,me, i, n - integer(psb_ipk_) :: int_err(5), i1sz,nrow,ncol, err_act + integer(psb_ipk_) :: i1sz,nrow,ncol, err_act logical :: scratch_ integer(psb_ipk_) :: debug_level, debug_unit character(len=20) :: name,ch_err @@ -136,7 +135,6 @@ subroutine psb_iasb_vect_r2(x, desc_a, info, mold, scratch) info = psb_success_ if (psb_errstatus_fatal()) return - int_err(1) = 0 name = 'psb_igeasb_v' ictxt = desc_a%get_context() @@ -211,7 +209,7 @@ subroutine psb_iasb_multivect(x, desc_a, info, mold, scratch,n) ! local variables integer(psb_ipk_) :: ictxt,np,me - integer(psb_ipk_) :: int_err(5), i1sz,nrow,ncol, err_act, n_ + integer(psb_ipk_) :: i1sz,nrow,ncol, err_act, n_ logical :: scratch_ integer(psb_ipk_) :: debug_level, debug_unit @@ -220,7 +218,6 @@ subroutine psb_iasb_multivect(x, desc_a, info, mold, scratch,n) info = psb_success_ if (psb_errstatus_fatal()) return - int_err(1) = 0 name = 'psb_igeasb' ictxt = desc_a%get_context() diff --git a/base/tools/psb_lasb.f90 b/base/tools/psb_lasb.f90 index 10f52b47e..8d3c7a97e 100644 --- a/base/tools/psb_lasb.f90 +++ b/base/tools/psb_lasb.f90 @@ -54,7 +54,7 @@ subroutine psb_lasb_vect(x, desc_a, info, mold, scratch) ! local variables integer(psb_ipk_) :: ictxt,np,me - integer(psb_ipk_) :: int_err(5), i1sz,nrow,ncol, err_act + integer(psb_ipk_) :: i1sz,nrow,ncol, err_act logical :: scratch_ integer(psb_ipk_) :: debug_level, debug_unit character(len=20) :: name,ch_err @@ -62,7 +62,6 @@ subroutine psb_lasb_vect(x, desc_a, info, mold, scratch) info = psb_success_ if (psb_errstatus_fatal()) return - int_err(1) = 0 name = 'psb_lgeasb_v' ictxt = desc_a%get_context() @@ -128,7 +127,7 @@ subroutine psb_lasb_vect_r2(x, desc_a, info, mold, scratch) ! local variables integer(psb_ipk_) :: ictxt,np,me, i, n - integer(psb_ipk_) :: int_err(5), i1sz,nrow,ncol, err_act + integer(psb_ipk_) :: i1sz,nrow,ncol, err_act logical :: scratch_ integer(psb_ipk_) :: debug_level, debug_unit character(len=20) :: name,ch_err @@ -136,7 +135,6 @@ subroutine psb_lasb_vect_r2(x, desc_a, info, mold, scratch) info = psb_success_ if (psb_errstatus_fatal()) return - int_err(1) = 0 name = 'psb_lgeasb_v' ictxt = desc_a%get_context() @@ -211,7 +209,7 @@ subroutine psb_lasb_multivect(x, desc_a, info, mold, scratch,n) ! local variables integer(psb_ipk_) :: ictxt,np,me - integer(psb_ipk_) :: int_err(5), i1sz,nrow,ncol, err_act, n_ + integer(psb_ipk_) :: i1sz,nrow,ncol, err_act, n_ logical :: scratch_ integer(psb_ipk_) :: debug_level, debug_unit @@ -220,7 +218,6 @@ subroutine psb_lasb_multivect(x, desc_a, info, mold, scratch,n) info = psb_success_ if (psb_errstatus_fatal()) return - int_err(1) = 0 name = 'psb_lgeasb' ictxt = desc_a%get_context() diff --git a/base/tools/psb_masb_a.f90 b/base/tools/psb_masb_a.f90 index 5e78cbdfc..07123dcb8 100644 --- a/base/tools/psb_masb_a.f90 +++ b/base/tools/psb_masb_a.f90 @@ -187,13 +187,12 @@ subroutine psb_masbv(x, desc_a, info, scratch) ! local variables integer(psb_ipk_) :: ictxt,np,me - integer(psb_ipk_) :: int_err(5), i1sz,nrow,ncol, err_act + integer(psb_ipk_) :: i1sz,nrow,ncol, err_act integer(psb_ipk_) :: debug_level, debug_unit logical :: scratch_ character(len=20) :: name,ch_err info = psb_success_ - int_err(1) = 0 name = 'psb_mgeasb_v' ictxt = desc_a%get_context() diff --git a/base/tools/psb_sasb.f90 b/base/tools/psb_sasb.f90 index 0134ae042..b0aa03a50 100644 --- a/base/tools/psb_sasb.f90 +++ b/base/tools/psb_sasb.f90 @@ -54,7 +54,7 @@ subroutine psb_sasb_vect(x, desc_a, info, mold, scratch) ! local variables integer(psb_ipk_) :: ictxt,np,me - integer(psb_ipk_) :: int_err(5), i1sz,nrow,ncol, err_act + integer(psb_ipk_) :: i1sz,nrow,ncol, err_act logical :: scratch_ integer(psb_ipk_) :: debug_level, debug_unit character(len=20) :: name,ch_err @@ -62,7 +62,6 @@ subroutine psb_sasb_vect(x, desc_a, info, mold, scratch) info = psb_success_ if (psb_errstatus_fatal()) return - int_err(1) = 0 name = 'psb_sgeasb_v' ictxt = desc_a%get_context() @@ -128,7 +127,7 @@ subroutine psb_sasb_vect_r2(x, desc_a, info, mold, scratch) ! local variables integer(psb_ipk_) :: ictxt,np,me, i, n - integer(psb_ipk_) :: int_err(5), i1sz,nrow,ncol, err_act + integer(psb_ipk_) :: i1sz,nrow,ncol, err_act logical :: scratch_ integer(psb_ipk_) :: debug_level, debug_unit character(len=20) :: name,ch_err @@ -136,7 +135,6 @@ subroutine psb_sasb_vect_r2(x, desc_a, info, mold, scratch) info = psb_success_ if (psb_errstatus_fatal()) return - int_err(1) = 0 name = 'psb_sgeasb_v' ictxt = desc_a%get_context() @@ -211,7 +209,7 @@ subroutine psb_sasb_multivect(x, desc_a, info, mold, scratch,n) ! local variables integer(psb_ipk_) :: ictxt,np,me - integer(psb_ipk_) :: int_err(5), i1sz,nrow,ncol, err_act, n_ + integer(psb_ipk_) :: i1sz,nrow,ncol, err_act, n_ logical :: scratch_ integer(psb_ipk_) :: debug_level, debug_unit @@ -220,7 +218,6 @@ subroutine psb_sasb_multivect(x, desc_a, info, mold, scratch,n) info = psb_success_ if (psb_errstatus_fatal()) return - int_err(1) = 0 name = 'psb_sgeasb' ictxt = desc_a%get_context() diff --git a/base/tools/psb_sasb_a.f90 b/base/tools/psb_sasb_a.f90 index 9e8c74c6e..bd082573c 100644 --- a/base/tools/psb_sasb_a.f90 +++ b/base/tools/psb_sasb_a.f90 @@ -187,13 +187,12 @@ subroutine psb_sasbv(x, desc_a, info, scratch) ! local variables integer(psb_ipk_) :: ictxt,np,me - integer(psb_ipk_) :: int_err(5), i1sz,nrow,ncol, err_act + integer(psb_ipk_) :: i1sz,nrow,ncol, err_act integer(psb_ipk_) :: debug_level, debug_unit logical :: scratch_ character(len=20) :: name,ch_err info = psb_success_ - int_err(1) = 0 name = 'psb_sgeasb_v' ictxt = desc_a%get_context() diff --git a/base/tools/psb_sspasb.f90 b/base/tools/psb_sspasb.f90 index c8876cdd0..58241a922 100644 --- a/base/tools/psb_sspasb.f90 +++ b/base/tools/psb_sspasb.f90 @@ -62,14 +62,12 @@ subroutine psb_sspasb(a,desc_a, info, afmt, upd, dupl, mold) character(len=*), optional, intent(in) :: afmt class(psb_s_base_sparse_mat), intent(in), optional :: mold !....Locals.... - integer(psb_ipk_) :: int_err(5) integer(psb_ipk_) :: ictxt,np,me, err_act integer(psb_ipk_) :: n_row,n_col integer(psb_ipk_) :: debug_level, debug_unit character(len=20) :: name, ch_err info = psb_success_ - int_err(1)=0 name = 'psb_spasb' call psb_erractionsave(err_act) debug_unit = psb_get_debug_unit() diff --git a/base/tools/psb_sspins.f90 b/base/tools/psb_sspins.f90 index 5d99dce93..eaab4601e 100644 --- a/base/tools/psb_sspins.f90 +++ b/base/tools/psb_sspins.f90 @@ -69,7 +69,6 @@ subroutine psb_sspins(nz,ia,ja,val,a,desc_a,info,rebuild,local) integer(psb_ipk_), parameter :: relocsz=200 logical :: rebuild_, local_ integer(psb_ipk_), allocatable :: ila(:),jla(:) - integer(psb_ipk_) :: ierr(5) character(len=20) :: name info = psb_success_ @@ -123,9 +122,8 @@ subroutine psb_sspins(nz,ia,ja,val,a,desc_a,info,rebuild,local) else allocate(ila(nz),jla(nz),stat=info) if (info /= psb_success_) then - ierr(1) = info call psb_errpush(psb_err_from_subroutine_ai_,name,& - & a_err='allocate',i_err=ierr) + & a_err='allocate',i_err=(/info/)) goto 9999 end if @@ -134,9 +132,8 @@ subroutine psb_sspins(nz,ia,ja,val,a,desc_a,info,rebuild,local) & mask=(ila(1:nz)>0)) if (info /= psb_success_) then - ierr(1) = info call psb_errpush(psb_err_from_subroutine_ai_,name,& - & a_err='psb_cdins',i_err=ierr) + & a_err='psb_cdins',i_err=(/info/)) goto 9999 end if nrow = desc_a%get_local_rows() @@ -162,9 +159,8 @@ subroutine psb_sspins(nz,ia,ja,val,a,desc_a,info,rebuild,local) ncol = desc_a%get_local_cols() allocate(ila(nz),jla(nz),stat=info) if (info /= psb_success_) then - ierr(1) = info call psb_errpush(psb_err_from_subroutine_ai_,name,& - & a_err='allocate',i_err=ierr) + & a_err='allocate',i_err=(/info/)) goto 9999 end if if (local_) then @@ -216,7 +212,6 @@ subroutine psb_sspins_2desc(nz,ia,ja,val,a,desc_ar,desc_ac,info) logical, parameter :: debug=.false. integer(psb_ipk_), parameter :: relocsz=200 integer(psb_ipk_), allocatable :: ila(:),jla(:) - integer(psb_ipk_) :: ierr(5) character(len=20) :: name info = psb_success_ @@ -264,9 +259,8 @@ subroutine psb_sspins_2desc(nz,ia,ja,val,a,desc_ar,desc_ac,info) allocate(ila(nz),jla(nz),stat=info) if (info /= psb_success_) then - ierr(1) = info call psb_errpush(psb_err_from_subroutine_ai_,name,& - & a_err='allocate',i_err=ierr) + & a_err='allocate',i_err=(/info/)) goto 9999 end if @@ -275,9 +269,8 @@ subroutine psb_sspins_2desc(nz,ia,ja,val,a,desc_ar,desc_ac,info) & mask=(ila(1:nz)>0)) if (psb_errstatus_fatal()) then - ierr(1) = info call psb_errpush(psb_err_from_subroutine_ai_,name,& - & a_err='psb_cdins',i_err=ierr) + & a_err='psb_cdins',i_err=(/info/)) goto 9999 end if @@ -336,7 +329,6 @@ subroutine psb_sspins_v(nz,ia,ja,val,a,desc_a,info,rebuild,local) logical :: rebuild_, local_ integer(psb_ipk_), allocatable :: ila(:),jla(:) real(psb_dpk_) :: t1,t2,t3,tcnv,tcsput - integer(psb_ipk_) :: ierr(5) character(len=20) :: name info = psb_success_ @@ -390,9 +382,8 @@ subroutine psb_sspins_v(nz,ia,ja,val,a,desc_a,info,rebuild,local) else allocate(ila(nz),jla(nz),stat=info) if (info /= psb_success_) then - ierr(1) = info call psb_errpush(psb_err_from_subroutine_ai_,name,& - & a_err='allocate',i_err=ierr) + & a_err='allocate',i_err=(/info/)) goto 9999 end if if (ia%is_dev()) call ia%sync() @@ -403,9 +394,8 @@ subroutine psb_sspins_v(nz,ia,ja,val,a,desc_a,info,rebuild,local) call desc_a%indxmap%g2l_ins(ja%v%v(1:nz),jla(1:nz),info,mask=(ila(1:nz)>0)) if (info /= psb_success_) then - ierr(1) = info call psb_errpush(psb_err_from_subroutine_ai_,name,& - & a_err='psb_cdins',i_err=ierr) + & a_err='psb_cdins',i_err=(/info/)) goto 9999 end if nrow = desc_a%get_local_rows() @@ -431,9 +421,8 @@ subroutine psb_sspins_v(nz,ia,ja,val,a,desc_a,info,rebuild,local) ncol = desc_a%get_local_cols() allocate(ila(nz),jla(nz),stat=info) if (info /= psb_success_) then - ierr(1) = info call psb_errpush(psb_err_from_subroutine_ai_,name,& - & a_err='allocate',i_err=ierr) + & a_err='allocate',i_err=(/info/)) goto 9999 end if if (ia%is_dev()) call ia%sync() diff --git a/base/tools/psb_ssprn.f90 b/base/tools/psb_ssprn.f90 index 5b666286c..3a7500335 100644 --- a/base/tools/psb_ssprn.f90 +++ b/base/tools/psb_ssprn.f90 @@ -53,15 +53,12 @@ Subroutine psb_ssprn(a, desc_a,info,clear) logical, intent(in), optional :: clear !locals - integer(psb_ipk_) :: ictxt,np,me,err,err_act + integer(psb_ipk_) :: ictxt,np,me,err_act integer(psb_ipk_) :: debug_level, debug_unit - integer(psb_ipk_) :: int_err(5) character(len=20) :: name logical :: clear_ info = psb_success_ - err = 0 - int_err(1)=0 name = 'psb_ssprn' call psb_erractionsave(err_act) debug_unit = psb_get_debug_unit() diff --git a/base/tools/psb_zasb.f90 b/base/tools/psb_zasb.f90 index bc8d2fc92..5d6127c91 100644 --- a/base/tools/psb_zasb.f90 +++ b/base/tools/psb_zasb.f90 @@ -54,7 +54,7 @@ subroutine psb_zasb_vect(x, desc_a, info, mold, scratch) ! local variables integer(psb_ipk_) :: ictxt,np,me - integer(psb_ipk_) :: int_err(5), i1sz,nrow,ncol, err_act + integer(psb_ipk_) :: i1sz,nrow,ncol, err_act logical :: scratch_ integer(psb_ipk_) :: debug_level, debug_unit character(len=20) :: name,ch_err @@ -62,7 +62,6 @@ subroutine psb_zasb_vect(x, desc_a, info, mold, scratch) info = psb_success_ if (psb_errstatus_fatal()) return - int_err(1) = 0 name = 'psb_zgeasb_v' ictxt = desc_a%get_context() @@ -128,7 +127,7 @@ subroutine psb_zasb_vect_r2(x, desc_a, info, mold, scratch) ! local variables integer(psb_ipk_) :: ictxt,np,me, i, n - integer(psb_ipk_) :: int_err(5), i1sz,nrow,ncol, err_act + integer(psb_ipk_) :: i1sz,nrow,ncol, err_act logical :: scratch_ integer(psb_ipk_) :: debug_level, debug_unit character(len=20) :: name,ch_err @@ -136,7 +135,6 @@ subroutine psb_zasb_vect_r2(x, desc_a, info, mold, scratch) info = psb_success_ if (psb_errstatus_fatal()) return - int_err(1) = 0 name = 'psb_zgeasb_v' ictxt = desc_a%get_context() @@ -211,7 +209,7 @@ subroutine psb_zasb_multivect(x, desc_a, info, mold, scratch,n) ! local variables integer(psb_ipk_) :: ictxt,np,me - integer(psb_ipk_) :: int_err(5), i1sz,nrow,ncol, err_act, n_ + integer(psb_ipk_) :: i1sz,nrow,ncol, err_act, n_ logical :: scratch_ integer(psb_ipk_) :: debug_level, debug_unit @@ -220,7 +218,6 @@ subroutine psb_zasb_multivect(x, desc_a, info, mold, scratch,n) info = psb_success_ if (psb_errstatus_fatal()) return - int_err(1) = 0 name = 'psb_zgeasb' ictxt = desc_a%get_context() diff --git a/base/tools/psb_zasb_a.f90 b/base/tools/psb_zasb_a.f90 index 4cd53968c..a0f3639bf 100644 --- a/base/tools/psb_zasb_a.f90 +++ b/base/tools/psb_zasb_a.f90 @@ -187,13 +187,12 @@ subroutine psb_zasbv(x, desc_a, info, scratch) ! local variables integer(psb_ipk_) :: ictxt,np,me - integer(psb_ipk_) :: int_err(5), i1sz,nrow,ncol, err_act + integer(psb_ipk_) :: i1sz,nrow,ncol, err_act integer(psb_ipk_) :: debug_level, debug_unit logical :: scratch_ character(len=20) :: name,ch_err info = psb_success_ - int_err(1) = 0 name = 'psb_zgeasb_v' ictxt = desc_a%get_context() diff --git a/base/tools/psb_zspasb.f90 b/base/tools/psb_zspasb.f90 index 73a69776e..9db285505 100644 --- a/base/tools/psb_zspasb.f90 +++ b/base/tools/psb_zspasb.f90 @@ -62,14 +62,12 @@ subroutine psb_zspasb(a,desc_a, info, afmt, upd, dupl, mold) character(len=*), optional, intent(in) :: afmt class(psb_z_base_sparse_mat), intent(in), optional :: mold !....Locals.... - integer(psb_ipk_) :: int_err(5) integer(psb_ipk_) :: ictxt,np,me, err_act integer(psb_ipk_) :: n_row,n_col integer(psb_ipk_) :: debug_level, debug_unit character(len=20) :: name, ch_err info = psb_success_ - int_err(1)=0 name = 'psb_spasb' call psb_erractionsave(err_act) debug_unit = psb_get_debug_unit() diff --git a/base/tools/psb_zspins.f90 b/base/tools/psb_zspins.f90 index 615c5fa3a..84fa87a12 100644 --- a/base/tools/psb_zspins.f90 +++ b/base/tools/psb_zspins.f90 @@ -69,7 +69,6 @@ subroutine psb_zspins(nz,ia,ja,val,a,desc_a,info,rebuild,local) integer(psb_ipk_), parameter :: relocsz=200 logical :: rebuild_, local_ integer(psb_ipk_), allocatable :: ila(:),jla(:) - integer(psb_ipk_) :: ierr(5) character(len=20) :: name info = psb_success_ @@ -123,9 +122,8 @@ subroutine psb_zspins(nz,ia,ja,val,a,desc_a,info,rebuild,local) else allocate(ila(nz),jla(nz),stat=info) if (info /= psb_success_) then - ierr(1) = info call psb_errpush(psb_err_from_subroutine_ai_,name,& - & a_err='allocate',i_err=ierr) + & a_err='allocate',i_err=(/info/)) goto 9999 end if @@ -134,9 +132,8 @@ subroutine psb_zspins(nz,ia,ja,val,a,desc_a,info,rebuild,local) & mask=(ila(1:nz)>0)) if (info /= psb_success_) then - ierr(1) = info call psb_errpush(psb_err_from_subroutine_ai_,name,& - & a_err='psb_cdins',i_err=ierr) + & a_err='psb_cdins',i_err=(/info/)) goto 9999 end if nrow = desc_a%get_local_rows() @@ -162,9 +159,8 @@ subroutine psb_zspins(nz,ia,ja,val,a,desc_a,info,rebuild,local) ncol = desc_a%get_local_cols() allocate(ila(nz),jla(nz),stat=info) if (info /= psb_success_) then - ierr(1) = info call psb_errpush(psb_err_from_subroutine_ai_,name,& - & a_err='allocate',i_err=ierr) + & a_err='allocate',i_err=(/info/)) goto 9999 end if if (local_) then @@ -216,7 +212,6 @@ subroutine psb_zspins_2desc(nz,ia,ja,val,a,desc_ar,desc_ac,info) logical, parameter :: debug=.false. integer(psb_ipk_), parameter :: relocsz=200 integer(psb_ipk_), allocatable :: ila(:),jla(:) - integer(psb_ipk_) :: ierr(5) character(len=20) :: name info = psb_success_ @@ -264,9 +259,8 @@ subroutine psb_zspins_2desc(nz,ia,ja,val,a,desc_ar,desc_ac,info) allocate(ila(nz),jla(nz),stat=info) if (info /= psb_success_) then - ierr(1) = info call psb_errpush(psb_err_from_subroutine_ai_,name,& - & a_err='allocate',i_err=ierr) + & a_err='allocate',i_err=(/info/)) goto 9999 end if @@ -275,9 +269,8 @@ subroutine psb_zspins_2desc(nz,ia,ja,val,a,desc_ar,desc_ac,info) & mask=(ila(1:nz)>0)) if (psb_errstatus_fatal()) then - ierr(1) = info call psb_errpush(psb_err_from_subroutine_ai_,name,& - & a_err='psb_cdins',i_err=ierr) + & a_err='psb_cdins',i_err=(/info/)) goto 9999 end if @@ -336,7 +329,6 @@ subroutine psb_zspins_v(nz,ia,ja,val,a,desc_a,info,rebuild,local) logical :: rebuild_, local_ integer(psb_ipk_), allocatable :: ila(:),jla(:) real(psb_dpk_) :: t1,t2,t3,tcnv,tcsput - integer(psb_ipk_) :: ierr(5) character(len=20) :: name info = psb_success_ @@ -390,9 +382,8 @@ subroutine psb_zspins_v(nz,ia,ja,val,a,desc_a,info,rebuild,local) else allocate(ila(nz),jla(nz),stat=info) if (info /= psb_success_) then - ierr(1) = info call psb_errpush(psb_err_from_subroutine_ai_,name,& - & a_err='allocate',i_err=ierr) + & a_err='allocate',i_err=(/info/)) goto 9999 end if if (ia%is_dev()) call ia%sync() @@ -403,9 +394,8 @@ subroutine psb_zspins_v(nz,ia,ja,val,a,desc_a,info,rebuild,local) call desc_a%indxmap%g2l_ins(ja%v%v(1:nz),jla(1:nz),info,mask=(ila(1:nz)>0)) if (info /= psb_success_) then - ierr(1) = info call psb_errpush(psb_err_from_subroutine_ai_,name,& - & a_err='psb_cdins',i_err=ierr) + & a_err='psb_cdins',i_err=(/info/)) goto 9999 end if nrow = desc_a%get_local_rows() @@ -431,9 +421,8 @@ subroutine psb_zspins_v(nz,ia,ja,val,a,desc_a,info,rebuild,local) ncol = desc_a%get_local_cols() allocate(ila(nz),jla(nz),stat=info) if (info /= psb_success_) then - ierr(1) = info call psb_errpush(psb_err_from_subroutine_ai_,name,& - & a_err='allocate',i_err=ierr) + & a_err='allocate',i_err=(/info/)) goto 9999 end if if (ia%is_dev()) call ia%sync() diff --git a/base/tools/psb_zsprn.f90 b/base/tools/psb_zsprn.f90 index 36942b394..aa87a8f07 100644 --- a/base/tools/psb_zsprn.f90 +++ b/base/tools/psb_zsprn.f90 @@ -53,15 +53,12 @@ Subroutine psb_zsprn(a, desc_a,info,clear) logical, intent(in), optional :: clear !locals - integer(psb_ipk_) :: ictxt,np,me,err,err_act + integer(psb_ipk_) :: ictxt,np,me,err_act integer(psb_ipk_) :: debug_level, debug_unit - integer(psb_ipk_) :: int_err(5) character(len=20) :: name logical :: clear_ info = psb_success_ - err = 0 - int_err(1)=0 name = 'psb_zsprn' call psb_erractionsave(err_act) debug_unit = psb_get_debug_unit() diff --git a/krylov/psb_c_krylov_conv_mod.f90 b/krylov/psb_c_krylov_conv_mod.f90 index e3fcac010..0eb44aab7 100644 --- a/krylov/psb_c_krylov_conv_mod.f90 +++ b/krylov/psb_c_krylov_conv_mod.f90 @@ -61,7 +61,7 @@ contains type(psb_itconv_type) :: stopdat integer(psb_ipk_), intent(out) :: info - integer(psb_ipk_) :: ictxt, me, np, err_act, ierr(5) + integer(psb_ipk_) :: ictxt, me, np, err_act character(len=20) :: name complex(psb_spk_), allocatable :: r(:) @@ -98,8 +98,7 @@ contains call psb_gefree(r,desc_a,info) case default info=psb_err_invalid_istop_ - ierr(1) = stopc - call psb_errpush(info,name,i_err=ierr) + call psb_errpush(info,name,i_err=(/stopc/)) goto 9999 end select if (info /= psb_success_) then @@ -213,7 +212,7 @@ contains type(psb_itconv_type) :: stopdat integer(psb_ipk_), intent(out) :: info - integer(psb_ipk_) :: ictxt, me, np, err_act, ierr(5) + integer(psb_ipk_) :: ictxt, me, np, err_act character(len=20) :: name type(psb_c_vect_type) :: r @@ -250,8 +249,7 @@ contains call psb_gefree(r,desc_a,info) case default info=psb_err_invalid_istop_ - ierr(1) = stopc - call psb_errpush(info,name,i_err=ierr) + call psb_errpush(info,name,i_err=(/stopc/)) goto 9999 end select if (info /= psb_success_) then diff --git a/krylov/psb_cbicg.f90 b/krylov/psb_cbicg.f90 index 0a4fd1185..fbcc2d030 100644 --- a/krylov/psb_cbicg.f90 +++ b/krylov/psb_cbicg.f90 @@ -116,7 +116,6 @@ subroutine psb_cbicg_vect(a,prec,b,x,eps,desc_a,info,& type(psb_c_vect_type), allocatable, target :: wwrk(:) type(psb_c_vect_type), pointer :: ww, q, r, p,& & zt, pt, z, rt, qt - integer(psb_ipk_) :: int_err(5) integer(psb_ipk_) :: itmax_, naux, it, itrace_,& & n_row, n_col, istop_, err_act integer(psb_lpk_) :: mglob @@ -169,9 +168,8 @@ subroutine psb_cbicg_vect(a,prec,b,x,eps,desc_a,info,& if ((istop_ < 1 ).or.(istop_ > 2 ) ) then info=psb_err_invalid_istop_ - int_err=istop_ err=info - call psb_errpush(info,name,i_err=int_err) + call psb_errpush(info,name,i_err=(/istop_/)) goto 9999 endif diff --git a/krylov/psb_ccg.F90 b/krylov/psb_ccg.F90 index af970f560..7a448c873 100644 --- a/krylov/psb_ccg.F90 +++ b/krylov/psb_ccg.F90 @@ -119,7 +119,7 @@ subroutine psb_ccg_vect(a,prec,b,x,eps,desc_a,info,& type(psb_c_vect_type), pointer :: q, p, r, z, w complex(psb_spk_) :: alpha, beta, rho, rho_old, sigma,alpha_old,beta_old integer(psb_ipk_) :: itmax_, istop_, naux, it, itx, itrace_,& - & n_col, n_row,err_act, int_err(5), ieg,nspl, istebz + & n_col, n_row,err_act, ieg,nspl, istebz integer(psb_lpk_) :: mglob integer(psb_ipk_) :: debug_level, debug_unit integer(psb_ipk_) :: np, me, ictxt diff --git a/krylov/psb_ccgs.f90 b/krylov/psb_ccgs.f90 index 3043c4c3f..240f98e62 100644 --- a/krylov/psb_ccgs.f90 +++ b/krylov/psb_ccgs.f90 @@ -114,7 +114,7 @@ Subroutine psb_ccgs_vect(a,prec,b,x,eps,desc_a,info,& type(psb_c_vect_type), allocatable, target :: wwrk(:) type(psb_c_vect_type), pointer :: ww, q, r, p, v,& & s, z, f, rt, qt, uv - integer(psb_ipk_) :: itmax_, naux, it, itrace_,int_err(5),& + integer(psb_ipk_) :: itmax_, naux, it, itrace_,& & n_row, n_col,istop_, itx, err_act integer(psb_lpk_) :: mglob integer(psb_ipk_) :: np, me, ictxt diff --git a/krylov/psb_ccgstabl.f90 b/krylov/psb_ccgstabl.f90 index 093785b2a..cbad3d915 100644 --- a/krylov/psb_ccgstabl.f90 +++ b/krylov/psb_ccgstabl.f90 @@ -132,7 +132,7 @@ Subroutine psb_ccgstabl_vect(a,prec,b,x,eps,desc_a,info,& integer(psb_lpk_) :: mglob Logical, Parameter :: exchange=.True., noexchange=.False. integer(psb_ipk_), Parameter :: irmax = 8 - integer(psb_ipk_) :: itx, i, istop_,j, k, int_err(5) + integer(psb_ipk_) :: itx, i, istop_,j, k integer(psb_ipk_) :: debug_level, debug_unit integer(psb_ipk_) :: ictxt, np, me complex(psb_spk_) :: alpha, beta, rho, rho_old, rni, xni, bni, ani,bn2,& @@ -199,9 +199,8 @@ Subroutine psb_ccgstabl_vect(a,prec,b,x,eps,desc_a,info,& endif if (nl <=0 ) then info=psb_err_invalid_istop_ - int_err(1)=nl err=info - call psb_errpush(info,name,i_err=int_err) + call psb_errpush(info,name,i_err=(/nl/)) goto 9999 endif diff --git a/krylov/psb_cgcr.f90 b/krylov/psb_cgcr.f90 index 5eb715938..a59b15a1e 100644 --- a/krylov/psb_cgcr.f90 +++ b/krylov/psb_cgcr.f90 @@ -140,7 +140,6 @@ subroutine psb_cgcr_vect(a,prec,b,x,eps,desc_a,info,& character(len=20) :: name type(psb_itconv_type) :: stopdat character(len=*), parameter :: methdname='GCR' - integer(psb_ipk_) ::int_err(5) info = psb_success_ name = 'psb_cgcr' call psb_erractionsave(err_act) @@ -177,9 +176,8 @@ subroutine psb_cgcr_vect(a,prec,b,x,eps,desc_a,info,& if ((istop_ < 1 ).or.(istop_ > 2 ) ) then info=psb_err_invalid_istop_ - int_err(1)=istop_ err=info - call psb_errpush(info,name,i_err=int_err) + call psb_errpush(info,name,i_err=(/istop_/)) goto 9999 endif @@ -219,9 +217,8 @@ subroutine psb_cgcr_vect(a,prec,b,x,eps,desc_a,info,& if (nl <=0 ) then info=psb_err_invalid_istop_ - int_err(1)=nl err=info - call psb_errpush(info,name,i_err=int_err) + call psb_errpush(info,name,i_err=(/nl/)) goto 9999 endif diff --git a/krylov/psb_crgmres.f90 b/krylov/psb_crgmres.f90 index f32f3d13a..7f81791ef 100644 --- a/krylov/psb_crgmres.f90 +++ b/krylov/psb_crgmres.f90 @@ -131,7 +131,7 @@ subroutine psb_crgmres_vect(a,prec,b,x,eps,desc_a,info,& real(psb_spk_) :: tmp complex(psb_spk_) :: scal, gm, rti, rti1 integer(psb_ipk_) ::litmax, naux, it, k, itrace_,& - & n_row, n_col, nl, int_err(5) + & n_row, n_col, nl integer(psb_lpk_) :: mglob Logical, Parameter :: exchange=.True., noexchange=.False., use_srot=.true. integer(psb_ipk_), Parameter :: irmax = 8 @@ -180,9 +180,8 @@ subroutine psb_crgmres_vect(a,prec,b,x,eps,desc_a,info,& if ((istop_ < 1 ).or.(istop_ > 2 ) ) then info=psb_err_invalid_istop_ - int_err(1)=istop_ err=info - call psb_errpush(info,name,i_err=int_err) + call psb_errpush(info,name,i_err=(/istop_/)) goto 9999 endif @@ -211,9 +210,8 @@ subroutine psb_crgmres_vect(a,prec,b,x,eps,desc_a,info,& endif if (nl <=0 ) then info=psb_err_invalid_istop_ - int_err(1)=nl err=info - call psb_errpush(info,name,i_err=int_err) + call psb_errpush(info,name,i_err=(/nl/)) goto 9999 endif diff --git a/krylov/psb_d_krylov_conv_mod.f90 b/krylov/psb_d_krylov_conv_mod.f90 index d77197a5a..d275bdbca 100644 --- a/krylov/psb_d_krylov_conv_mod.f90 +++ b/krylov/psb_d_krylov_conv_mod.f90 @@ -61,7 +61,7 @@ contains type(psb_itconv_type) :: stopdat integer(psb_ipk_), intent(out) :: info - integer(psb_ipk_) :: ictxt, me, np, err_act, ierr(5) + integer(psb_ipk_) :: ictxt, me, np, err_act character(len=20) :: name real(psb_dpk_), allocatable :: r(:) @@ -98,8 +98,7 @@ contains call psb_gefree(r,desc_a,info) case default info=psb_err_invalid_istop_ - ierr(1) = stopc - call psb_errpush(info,name,i_err=ierr) + call psb_errpush(info,name,i_err=(/stopc/)) goto 9999 end select if (info /= psb_success_) then @@ -213,7 +212,7 @@ contains type(psb_itconv_type) :: stopdat integer(psb_ipk_), intent(out) :: info - integer(psb_ipk_) :: ictxt, me, np, err_act, ierr(5) + integer(psb_ipk_) :: ictxt, me, np, err_act character(len=20) :: name type(psb_d_vect_type) :: r @@ -250,8 +249,7 @@ contains call psb_gefree(r,desc_a,info) case default info=psb_err_invalid_istop_ - ierr(1) = stopc - call psb_errpush(info,name,i_err=ierr) + call psb_errpush(info,name,i_err=(/stopc/)) goto 9999 end select if (info /= psb_success_) then diff --git a/krylov/psb_dbicg.f90 b/krylov/psb_dbicg.f90 index 9a2c109c6..abea8b860 100644 --- a/krylov/psb_dbicg.f90 +++ b/krylov/psb_dbicg.f90 @@ -116,7 +116,6 @@ subroutine psb_dbicg_vect(a,prec,b,x,eps,desc_a,info,& type(psb_d_vect_type), allocatable, target :: wwrk(:) type(psb_d_vect_type), pointer :: ww, q, r, p,& & zt, pt, z, rt, qt - integer(psb_ipk_) :: int_err(5) integer(psb_ipk_) :: itmax_, naux, it, itrace_,& & n_row, n_col, istop_, err_act integer(psb_lpk_) :: mglob @@ -169,9 +168,8 @@ subroutine psb_dbicg_vect(a,prec,b,x,eps,desc_a,info,& if ((istop_ < 1 ).or.(istop_ > 2 ) ) then info=psb_err_invalid_istop_ - int_err=istop_ err=info - call psb_errpush(info,name,i_err=int_err) + call psb_errpush(info,name,i_err=(/istop_/)) goto 9999 endif diff --git a/krylov/psb_dcg.F90 b/krylov/psb_dcg.F90 index 9b55fea87..5ca0b470a 100644 --- a/krylov/psb_dcg.F90 +++ b/krylov/psb_dcg.F90 @@ -119,7 +119,7 @@ subroutine psb_dcg_vect(a,prec,b,x,eps,desc_a,info,& type(psb_d_vect_type), pointer :: q, p, r, z, w real(psb_dpk_) :: alpha, beta, rho, rho_old, sigma,alpha_old,beta_old integer(psb_ipk_) :: itmax_, istop_, naux, it, itx, itrace_,& - & n_col, n_row,err_act, int_err(5), ieg,nspl, istebz + & n_col, n_row,err_act, ieg,nspl, istebz integer(psb_lpk_) :: mglob integer(psb_ipk_) :: debug_level, debug_unit integer(psb_ipk_) :: np, me, ictxt diff --git a/krylov/psb_dcgs.f90 b/krylov/psb_dcgs.f90 index 22bd66710..0545483d5 100644 --- a/krylov/psb_dcgs.f90 +++ b/krylov/psb_dcgs.f90 @@ -114,7 +114,7 @@ Subroutine psb_dcgs_vect(a,prec,b,x,eps,desc_a,info,& type(psb_d_vect_type), allocatable, target :: wwrk(:) type(psb_d_vect_type), pointer :: ww, q, r, p, v,& & s, z, f, rt, qt, uv - integer(psb_ipk_) :: itmax_, naux, it, itrace_,int_err(5),& + integer(psb_ipk_) :: itmax_, naux, it, itrace_,& & n_row, n_col,istop_, itx, err_act integer(psb_lpk_) :: mglob integer(psb_ipk_) :: np, me, ictxt diff --git a/krylov/psb_dcgstabl.f90 b/krylov/psb_dcgstabl.f90 index 1c57cfbeb..ef57df921 100644 --- a/krylov/psb_dcgstabl.f90 +++ b/krylov/psb_dcgstabl.f90 @@ -132,7 +132,7 @@ Subroutine psb_dcgstabl_vect(a,prec,b,x,eps,desc_a,info,& integer(psb_lpk_) :: mglob Logical, Parameter :: exchange=.True., noexchange=.False. integer(psb_ipk_), Parameter :: irmax = 8 - integer(psb_ipk_) :: itx, i, istop_,j, k, int_err(5) + integer(psb_ipk_) :: itx, i, istop_,j, k integer(psb_ipk_) :: debug_level, debug_unit integer(psb_ipk_) :: ictxt, np, me real(psb_dpk_) :: alpha, beta, rho, rho_old, rni, xni, bni, ani,bn2,& @@ -199,9 +199,8 @@ Subroutine psb_dcgstabl_vect(a,prec,b,x,eps,desc_a,info,& endif if (nl <=0 ) then info=psb_err_invalid_istop_ - int_err(1)=nl err=info - call psb_errpush(info,name,i_err=int_err) + call psb_errpush(info,name,i_err=(/nl/)) goto 9999 endif diff --git a/krylov/psb_dgcr.f90 b/krylov/psb_dgcr.f90 index cef088d75..59c5e2431 100644 --- a/krylov/psb_dgcr.f90 +++ b/krylov/psb_dgcr.f90 @@ -140,7 +140,6 @@ subroutine psb_dgcr_vect(a,prec,b,x,eps,desc_a,info,& character(len=20) :: name type(psb_itconv_type) :: stopdat character(len=*), parameter :: methdname='GCR' - integer(psb_ipk_) ::int_err(5) info = psb_success_ name = 'psb_dgcr' call psb_erractionsave(err_act) @@ -177,9 +176,8 @@ subroutine psb_dgcr_vect(a,prec,b,x,eps,desc_a,info,& if ((istop_ < 1 ).or.(istop_ > 2 ) ) then info=psb_err_invalid_istop_ - int_err(1)=istop_ err=info - call psb_errpush(info,name,i_err=int_err) + call psb_errpush(info,name,i_err=(/istop_/)) goto 9999 endif @@ -219,9 +217,8 @@ subroutine psb_dgcr_vect(a,prec,b,x,eps,desc_a,info,& if (nl <=0 ) then info=psb_err_invalid_istop_ - int_err(1)=nl err=info - call psb_errpush(info,name,i_err=int_err) + call psb_errpush(info,name,i_err=(/nl/)) goto 9999 endif diff --git a/krylov/psb_drgmres.f90 b/krylov/psb_drgmres.f90 index 16f58d873..da997427f 100644 --- a/krylov/psb_drgmres.f90 +++ b/krylov/psb_drgmres.f90 @@ -131,7 +131,7 @@ subroutine psb_drgmres_vect(a,prec,b,x,eps,desc_a,info,& real(psb_dpk_) :: tmp real(psb_dpk_) :: scal, gm, rti, rti1 integer(psb_ipk_) ::litmax, naux, it, k, itrace_,& - & n_row, n_col, nl, int_err(5) + & n_row, n_col, nl integer(psb_lpk_) :: mglob Logical, Parameter :: exchange=.True., noexchange=.False., use_srot=.true. integer(psb_ipk_), Parameter :: irmax = 8 @@ -180,9 +180,8 @@ subroutine psb_drgmres_vect(a,prec,b,x,eps,desc_a,info,& if ((istop_ < 1 ).or.(istop_ > 2 ) ) then info=psb_err_invalid_istop_ - int_err(1)=istop_ err=info - call psb_errpush(info,name,i_err=int_err) + call psb_errpush(info,name,i_err=(/istop_/)) goto 9999 endif @@ -211,9 +210,8 @@ subroutine psb_drgmres_vect(a,prec,b,x,eps,desc_a,info,& endif if (nl <=0 ) then info=psb_err_invalid_istop_ - int_err(1)=nl err=info - call psb_errpush(info,name,i_err=int_err) + call psb_errpush(info,name,i_err=(/nl/)) goto 9999 endif diff --git a/krylov/psb_s_krylov_conv_mod.f90 b/krylov/psb_s_krylov_conv_mod.f90 index 4c5b0a07d..ede2eb757 100644 --- a/krylov/psb_s_krylov_conv_mod.f90 +++ b/krylov/psb_s_krylov_conv_mod.f90 @@ -61,7 +61,7 @@ contains type(psb_itconv_type) :: stopdat integer(psb_ipk_), intent(out) :: info - integer(psb_ipk_) :: ictxt, me, np, err_act, ierr(5) + integer(psb_ipk_) :: ictxt, me, np, err_act character(len=20) :: name real(psb_spk_), allocatable :: r(:) @@ -98,8 +98,7 @@ contains call psb_gefree(r,desc_a,info) case default info=psb_err_invalid_istop_ - ierr(1) = stopc - call psb_errpush(info,name,i_err=ierr) + call psb_errpush(info,name,i_err=(/stopc/)) goto 9999 end select if (info /= psb_success_) then @@ -213,7 +212,7 @@ contains type(psb_itconv_type) :: stopdat integer(psb_ipk_), intent(out) :: info - integer(psb_ipk_) :: ictxt, me, np, err_act, ierr(5) + integer(psb_ipk_) :: ictxt, me, np, err_act character(len=20) :: name type(psb_s_vect_type) :: r @@ -250,8 +249,7 @@ contains call psb_gefree(r,desc_a,info) case default info=psb_err_invalid_istop_ - ierr(1) = stopc - call psb_errpush(info,name,i_err=ierr) + call psb_errpush(info,name,i_err=(/stopc/)) goto 9999 end select if (info /= psb_success_) then diff --git a/krylov/psb_sbicg.f90 b/krylov/psb_sbicg.f90 index 5560cfc53..f5f543870 100644 --- a/krylov/psb_sbicg.f90 +++ b/krylov/psb_sbicg.f90 @@ -116,7 +116,6 @@ subroutine psb_sbicg_vect(a,prec,b,x,eps,desc_a,info,& type(psb_s_vect_type), allocatable, target :: wwrk(:) type(psb_s_vect_type), pointer :: ww, q, r, p,& & zt, pt, z, rt, qt - integer(psb_ipk_) :: int_err(5) integer(psb_ipk_) :: itmax_, naux, it, itrace_,& & n_row, n_col, istop_, err_act integer(psb_lpk_) :: mglob @@ -169,9 +168,8 @@ subroutine psb_sbicg_vect(a,prec,b,x,eps,desc_a,info,& if ((istop_ < 1 ).or.(istop_ > 2 ) ) then info=psb_err_invalid_istop_ - int_err=istop_ err=info - call psb_errpush(info,name,i_err=int_err) + call psb_errpush(info,name,i_err=(/istop_/)) goto 9999 endif diff --git a/krylov/psb_scg.F90 b/krylov/psb_scg.F90 index 9d83b0d8e..bc15ce8e6 100644 --- a/krylov/psb_scg.F90 +++ b/krylov/psb_scg.F90 @@ -119,7 +119,7 @@ subroutine psb_scg_vect(a,prec,b,x,eps,desc_a,info,& type(psb_s_vect_type), pointer :: q, p, r, z, w real(psb_spk_) :: alpha, beta, rho, rho_old, sigma,alpha_old,beta_old integer(psb_ipk_) :: itmax_, istop_, naux, it, itx, itrace_,& - & n_col, n_row,err_act, int_err(5), ieg,nspl, istebz + & n_col, n_row,err_act, ieg,nspl, istebz integer(psb_lpk_) :: mglob integer(psb_ipk_) :: debug_level, debug_unit integer(psb_ipk_) :: np, me, ictxt diff --git a/krylov/psb_scgs.f90 b/krylov/psb_scgs.f90 index f2e0cfe97..b45d6b9d4 100644 --- a/krylov/psb_scgs.f90 +++ b/krylov/psb_scgs.f90 @@ -114,7 +114,7 @@ Subroutine psb_scgs_vect(a,prec,b,x,eps,desc_a,info,& type(psb_s_vect_type), allocatable, target :: wwrk(:) type(psb_s_vect_type), pointer :: ww, q, r, p, v,& & s, z, f, rt, qt, uv - integer(psb_ipk_) :: itmax_, naux, it, itrace_,int_err(5),& + integer(psb_ipk_) :: itmax_, naux, it, itrace_,& & n_row, n_col,istop_, itx, err_act integer(psb_lpk_) :: mglob integer(psb_ipk_) :: np, me, ictxt diff --git a/krylov/psb_scgstabl.f90 b/krylov/psb_scgstabl.f90 index bae82d5ee..82cbadc7e 100644 --- a/krylov/psb_scgstabl.f90 +++ b/krylov/psb_scgstabl.f90 @@ -132,7 +132,7 @@ Subroutine psb_scgstabl_vect(a,prec,b,x,eps,desc_a,info,& integer(psb_lpk_) :: mglob Logical, Parameter :: exchange=.True., noexchange=.False. integer(psb_ipk_), Parameter :: irmax = 8 - integer(psb_ipk_) :: itx, i, istop_,j, k, int_err(5) + integer(psb_ipk_) :: itx, i, istop_,j, k integer(psb_ipk_) :: debug_level, debug_unit integer(psb_ipk_) :: ictxt, np, me real(psb_spk_) :: alpha, beta, rho, rho_old, rni, xni, bni, ani,bn2,& @@ -199,9 +199,8 @@ Subroutine psb_scgstabl_vect(a,prec,b,x,eps,desc_a,info,& endif if (nl <=0 ) then info=psb_err_invalid_istop_ - int_err(1)=nl err=info - call psb_errpush(info,name,i_err=int_err) + call psb_errpush(info,name,i_err=(/nl/)) goto 9999 endif diff --git a/krylov/psb_sgcr.f90 b/krylov/psb_sgcr.f90 index 2da4f49a1..ce11c3897 100644 --- a/krylov/psb_sgcr.f90 +++ b/krylov/psb_sgcr.f90 @@ -140,7 +140,6 @@ subroutine psb_sgcr_vect(a,prec,b,x,eps,desc_a,info,& character(len=20) :: name type(psb_itconv_type) :: stopdat character(len=*), parameter :: methdname='GCR' - integer(psb_ipk_) ::int_err(5) info = psb_success_ name = 'psb_sgcr' call psb_erractionsave(err_act) @@ -177,9 +176,8 @@ subroutine psb_sgcr_vect(a,prec,b,x,eps,desc_a,info,& if ((istop_ < 1 ).or.(istop_ > 2 ) ) then info=psb_err_invalid_istop_ - int_err(1)=istop_ err=info - call psb_errpush(info,name,i_err=int_err) + call psb_errpush(info,name,i_err=(/istop_/)) goto 9999 endif @@ -219,9 +217,8 @@ subroutine psb_sgcr_vect(a,prec,b,x,eps,desc_a,info,& if (nl <=0 ) then info=psb_err_invalid_istop_ - int_err(1)=nl err=info - call psb_errpush(info,name,i_err=int_err) + call psb_errpush(info,name,i_err=(/nl/)) goto 9999 endif diff --git a/krylov/psb_srgmres.f90 b/krylov/psb_srgmres.f90 index 261636f23..a2713716e 100644 --- a/krylov/psb_srgmres.f90 +++ b/krylov/psb_srgmres.f90 @@ -131,7 +131,7 @@ subroutine psb_srgmres_vect(a,prec,b,x,eps,desc_a,info,& real(psb_spk_) :: tmp real(psb_spk_) :: scal, gm, rti, rti1 integer(psb_ipk_) ::litmax, naux, it, k, itrace_,& - & n_row, n_col, nl, int_err(5) + & n_row, n_col, nl integer(psb_lpk_) :: mglob Logical, Parameter :: exchange=.True., noexchange=.False., use_srot=.true. integer(psb_ipk_), Parameter :: irmax = 8 @@ -180,9 +180,8 @@ subroutine psb_srgmres_vect(a,prec,b,x,eps,desc_a,info,& if ((istop_ < 1 ).or.(istop_ > 2 ) ) then info=psb_err_invalid_istop_ - int_err(1)=istop_ err=info - call psb_errpush(info,name,i_err=int_err) + call psb_errpush(info,name,i_err=(/istop_/)) goto 9999 endif @@ -211,9 +210,8 @@ subroutine psb_srgmres_vect(a,prec,b,x,eps,desc_a,info,& endif if (nl <=0 ) then info=psb_err_invalid_istop_ - int_err(1)=nl err=info - call psb_errpush(info,name,i_err=int_err) + call psb_errpush(info,name,i_err=(/nl/)) goto 9999 endif diff --git a/krylov/psb_z_krylov_conv_mod.f90 b/krylov/psb_z_krylov_conv_mod.f90 index 5e300cbb6..333dd031b 100644 --- a/krylov/psb_z_krylov_conv_mod.f90 +++ b/krylov/psb_z_krylov_conv_mod.f90 @@ -61,7 +61,7 @@ contains type(psb_itconv_type) :: stopdat integer(psb_ipk_), intent(out) :: info - integer(psb_ipk_) :: ictxt, me, np, err_act, ierr(5) + integer(psb_ipk_) :: ictxt, me, np, err_act character(len=20) :: name complex(psb_dpk_), allocatable :: r(:) @@ -98,8 +98,7 @@ contains call psb_gefree(r,desc_a,info) case default info=psb_err_invalid_istop_ - ierr(1) = stopc - call psb_errpush(info,name,i_err=ierr) + call psb_errpush(info,name,i_err=(/stopc/)) goto 9999 end select if (info /= psb_success_) then @@ -213,7 +212,7 @@ contains type(psb_itconv_type) :: stopdat integer(psb_ipk_), intent(out) :: info - integer(psb_ipk_) :: ictxt, me, np, err_act, ierr(5) + integer(psb_ipk_) :: ictxt, me, np, err_act character(len=20) :: name type(psb_z_vect_type) :: r @@ -250,8 +249,7 @@ contains call psb_gefree(r,desc_a,info) case default info=psb_err_invalid_istop_ - ierr(1) = stopc - call psb_errpush(info,name,i_err=ierr) + call psb_errpush(info,name,i_err=(/stopc/)) goto 9999 end select if (info /= psb_success_) then diff --git a/krylov/psb_zbicg.f90 b/krylov/psb_zbicg.f90 index 520c9c5c4..d216c93c8 100644 --- a/krylov/psb_zbicg.f90 +++ b/krylov/psb_zbicg.f90 @@ -116,7 +116,6 @@ subroutine psb_zbicg_vect(a,prec,b,x,eps,desc_a,info,& type(psb_z_vect_type), allocatable, target :: wwrk(:) type(psb_z_vect_type), pointer :: ww, q, r, p,& & zt, pt, z, rt, qt - integer(psb_ipk_) :: int_err(5) integer(psb_ipk_) :: itmax_, naux, it, itrace_,& & n_row, n_col, istop_, err_act integer(psb_lpk_) :: mglob @@ -169,9 +168,8 @@ subroutine psb_zbicg_vect(a,prec,b,x,eps,desc_a,info,& if ((istop_ < 1 ).or.(istop_ > 2 ) ) then info=psb_err_invalid_istop_ - int_err=istop_ err=info - call psb_errpush(info,name,i_err=int_err) + call psb_errpush(info,name,i_err=(/istop_/)) goto 9999 endif diff --git a/krylov/psb_zcg.F90 b/krylov/psb_zcg.F90 index 379ca0f36..bdc926d09 100644 --- a/krylov/psb_zcg.F90 +++ b/krylov/psb_zcg.F90 @@ -119,7 +119,7 @@ subroutine psb_zcg_vect(a,prec,b,x,eps,desc_a,info,& type(psb_z_vect_type), pointer :: q, p, r, z, w complex(psb_dpk_) :: alpha, beta, rho, rho_old, sigma,alpha_old,beta_old integer(psb_ipk_) :: itmax_, istop_, naux, it, itx, itrace_,& - & n_col, n_row,err_act, int_err(5), ieg,nspl, istebz + & n_col, n_row,err_act, ieg,nspl, istebz integer(psb_lpk_) :: mglob integer(psb_ipk_) :: debug_level, debug_unit integer(psb_ipk_) :: np, me, ictxt diff --git a/krylov/psb_zcgs.f90 b/krylov/psb_zcgs.f90 index 1e83df369..c40914282 100644 --- a/krylov/psb_zcgs.f90 +++ b/krylov/psb_zcgs.f90 @@ -114,7 +114,7 @@ Subroutine psb_zcgs_vect(a,prec,b,x,eps,desc_a,info,& type(psb_z_vect_type), allocatable, target :: wwrk(:) type(psb_z_vect_type), pointer :: ww, q, r, p, v,& & s, z, f, rt, qt, uv - integer(psb_ipk_) :: itmax_, naux, it, itrace_,int_err(5),& + integer(psb_ipk_) :: itmax_, naux, it, itrace_,& & n_row, n_col,istop_, itx, err_act integer(psb_lpk_) :: mglob integer(psb_ipk_) :: np, me, ictxt diff --git a/krylov/psb_zcgstabl.f90 b/krylov/psb_zcgstabl.f90 index 5efb11395..e2519fea2 100644 --- a/krylov/psb_zcgstabl.f90 +++ b/krylov/psb_zcgstabl.f90 @@ -132,7 +132,7 @@ Subroutine psb_zcgstabl_vect(a,prec,b,x,eps,desc_a,info,& integer(psb_lpk_) :: mglob Logical, Parameter :: exchange=.True., noexchange=.False. integer(psb_ipk_), Parameter :: irmax = 8 - integer(psb_ipk_) :: itx, i, istop_,j, k, int_err(5) + integer(psb_ipk_) :: itx, i, istop_,j, k integer(psb_ipk_) :: debug_level, debug_unit integer(psb_ipk_) :: ictxt, np, me complex(psb_dpk_) :: alpha, beta, rho, rho_old, rni, xni, bni, ani,bn2,& @@ -199,9 +199,8 @@ Subroutine psb_zcgstabl_vect(a,prec,b,x,eps,desc_a,info,& endif if (nl <=0 ) then info=psb_err_invalid_istop_ - int_err(1)=nl err=info - call psb_errpush(info,name,i_err=int_err) + call psb_errpush(info,name,i_err=(/nl/)) goto 9999 endif diff --git a/krylov/psb_zgcr.f90 b/krylov/psb_zgcr.f90 index 55ba874c9..c40f21667 100644 --- a/krylov/psb_zgcr.f90 +++ b/krylov/psb_zgcr.f90 @@ -140,7 +140,6 @@ subroutine psb_zgcr_vect(a,prec,b,x,eps,desc_a,info,& character(len=20) :: name type(psb_itconv_type) :: stopdat character(len=*), parameter :: methdname='GCR' - integer(psb_ipk_) ::int_err(5) info = psb_success_ name = 'psb_zgcr' call psb_erractionsave(err_act) @@ -177,9 +176,8 @@ subroutine psb_zgcr_vect(a,prec,b,x,eps,desc_a,info,& if ((istop_ < 1 ).or.(istop_ > 2 ) ) then info=psb_err_invalid_istop_ - int_err(1)=istop_ err=info - call psb_errpush(info,name,i_err=int_err) + call psb_errpush(info,name,i_err=(/istop_/)) goto 9999 endif @@ -219,9 +217,8 @@ subroutine psb_zgcr_vect(a,prec,b,x,eps,desc_a,info,& if (nl <=0 ) then info=psb_err_invalid_istop_ - int_err(1)=nl err=info - call psb_errpush(info,name,i_err=int_err) + call psb_errpush(info,name,i_err=(/nl/)) goto 9999 endif diff --git a/krylov/psb_zrgmres.f90 b/krylov/psb_zrgmres.f90 index 38f02bd91..5ba3ab24d 100644 --- a/krylov/psb_zrgmres.f90 +++ b/krylov/psb_zrgmres.f90 @@ -131,7 +131,7 @@ subroutine psb_zrgmres_vect(a,prec,b,x,eps,desc_a,info,& real(psb_dpk_) :: tmp complex(psb_dpk_) :: scal, gm, rti, rti1 integer(psb_ipk_) ::litmax, naux, it, k, itrace_,& - & n_row, n_col, nl, int_err(5) + & n_row, n_col, nl integer(psb_lpk_) :: mglob Logical, Parameter :: exchange=.True., noexchange=.False., use_srot=.true. integer(psb_ipk_), Parameter :: irmax = 8 @@ -180,9 +180,8 @@ subroutine psb_zrgmres_vect(a,prec,b,x,eps,desc_a,info,& if ((istop_ < 1 ).or.(istop_ > 2 ) ) then info=psb_err_invalid_istop_ - int_err(1)=istop_ err=info - call psb_errpush(info,name,i_err=int_err) + call psb_errpush(info,name,i_err=(/istop_/)) goto 9999 endif @@ -211,9 +210,8 @@ subroutine psb_zrgmres_vect(a,prec,b,x,eps,desc_a,info,& endif if (nl <=0 ) then info=psb_err_invalid_istop_ - int_err(1)=nl err=info - call psb_errpush(info,name,i_err=int_err) + call psb_errpush(info,name,i_err=(/nl/)) goto 9999 endif diff --git a/prec/impl/psb_cprecbld.f90 b/prec/impl/psb_cprecbld.f90 index 4457a1992..034764dd7 100644 --- a/prec/impl/psb_cprecbld.f90 +++ b/prec/impl/psb_cprecbld.f90 @@ -46,8 +46,6 @@ subroutine psb_cprecbld(a,desc_a,p,info,amold,vmold,imold) ! Local scalars integer(psb_ipk_) :: ictxt, me,np integer(psb_ipk_) :: err, n_row, n_col,mglob, err_act - integer(psb_ipk_) :: int_err(5) - integer(psb_ipk_),parameter :: iroot=psb_root_,iout=60,ilout=40 character(len=20) :: name, ch_err @@ -58,7 +56,6 @@ subroutine psb_cprecbld(a,desc_a,p,info,amold,vmold,imold) name = 'psb_precbld' info = psb_success_ - int_err(1) = 0 ictxt = desc_a%get_context() call psb_info(ictxt, me, np) diff --git a/prec/impl/psb_dprecbld.f90 b/prec/impl/psb_dprecbld.f90 index 8027c8daf..3ed5ad636 100644 --- a/prec/impl/psb_dprecbld.f90 +++ b/prec/impl/psb_dprecbld.f90 @@ -46,8 +46,6 @@ subroutine psb_dprecbld(a,desc_a,p,info,amold,vmold,imold) ! Local scalars integer(psb_ipk_) :: ictxt, me,np integer(psb_ipk_) :: err, n_row, n_col,mglob, err_act - integer(psb_ipk_) :: int_err(5) - integer(psb_ipk_),parameter :: iroot=psb_root_,iout=60,ilout=40 character(len=20) :: name, ch_err @@ -58,7 +56,6 @@ subroutine psb_dprecbld(a,desc_a,p,info,amold,vmold,imold) name = 'psb_precbld' info = psb_success_ - int_err(1) = 0 ictxt = desc_a%get_context() call psb_info(ictxt, me, np) diff --git a/prec/impl/psb_sprecbld.f90 b/prec/impl/psb_sprecbld.f90 index 328d9f01e..7f89c8a2e 100644 --- a/prec/impl/psb_sprecbld.f90 +++ b/prec/impl/psb_sprecbld.f90 @@ -46,8 +46,6 @@ subroutine psb_sprecbld(a,desc_a,p,info,amold,vmold,imold) ! Local scalars integer(psb_ipk_) :: ictxt, me,np integer(psb_ipk_) :: err, n_row, n_col,mglob, err_act - integer(psb_ipk_) :: int_err(5) - integer(psb_ipk_),parameter :: iroot=psb_root_,iout=60,ilout=40 character(len=20) :: name, ch_err @@ -58,7 +56,6 @@ subroutine psb_sprecbld(a,desc_a,p,info,amold,vmold,imold) name = 'psb_precbld' info = psb_success_ - int_err(1) = 0 ictxt = desc_a%get_context() call psb_info(ictxt, me, np) diff --git a/prec/impl/psb_zprecbld.f90 b/prec/impl/psb_zprecbld.f90 index 4f6559cf5..0fac25757 100644 --- a/prec/impl/psb_zprecbld.f90 +++ b/prec/impl/psb_zprecbld.f90 @@ -46,8 +46,6 @@ subroutine psb_zprecbld(a,desc_a,p,info,amold,vmold,imold) ! Local scalars integer(psb_ipk_) :: ictxt, me,np integer(psb_ipk_) :: err, n_row, n_col,mglob, err_act - integer(psb_ipk_) :: int_err(5) - integer(psb_ipk_),parameter :: iroot=psb_root_,iout=60,ilout=40 character(len=20) :: name, ch_err @@ -58,7 +56,6 @@ subroutine psb_zprecbld(a,desc_a,p,info,amold,vmold,imold) name = 'psb_precbld' info = psb_success_ - int_err(1) = 0 ictxt = desc_a%get_context() call psb_info(ictxt, me, np) diff --git a/util/psb_c_mat_dist_impl.f90 b/util/psb_c_mat_dist_impl.f90 index 60c34be22..9eeafdbea 100644 --- a/util/psb_c_mat_dist_impl.f90 +++ b/util/psb_c_mat_dist_impl.f90 @@ -89,7 +89,7 @@ subroutine psb_cmatdist(a_glob, a, ictxt, desc_a,& logical :: use_parts, use_v integer(psb_ipk_) :: np, iam, np_sharing integer(psb_ipk_) :: k_count, root, liwork, nnzero, nrhs,& - & i, ll, nz, isize, iproc, nnr, err, err_act, int_err(5) + & i, ll, nz, isize, iproc, nnr, err, err_act integer(psb_lpk_) :: i_count, j_count, nrow, ncol, ig integer(psb_ipk_), allocatable :: iwork(:), iwrk2(:) integer(psb_lpk_), allocatable :: irow(:),icol(:) @@ -140,8 +140,7 @@ subroutine psb_cmatdist(a_glob, a, ictxt, desc_a,& allocate(iwork(liwork), iwrk2(np),stat = info) if (info /= psb_success_) then info=psb_err_alloc_request_ - int_err(1)=liwork - call psb_errpush(info,name,i_err=int_err,a_err='integer') + call psb_errpush(info,name,i_err=(/liwork/),a_err='integer') goto 9999 endif if (iam == root) then diff --git a/util/psb_d_mat_dist_impl.f90 b/util/psb_d_mat_dist_impl.f90 index 90ed94971..73434f9ad 100644 --- a/util/psb_d_mat_dist_impl.f90 +++ b/util/psb_d_mat_dist_impl.f90 @@ -89,7 +89,7 @@ subroutine psb_dmatdist(a_glob, a, ictxt, desc_a,& logical :: use_parts, use_v integer(psb_ipk_) :: np, iam, np_sharing integer(psb_ipk_) :: k_count, root, liwork, nnzero, nrhs,& - & i, ll, nz, isize, iproc, nnr, err, err_act, int_err(5) + & i, ll, nz, isize, iproc, nnr, err, err_act integer(psb_lpk_) :: i_count, j_count, nrow, ncol, ig integer(psb_ipk_), allocatable :: iwork(:), iwrk2(:) integer(psb_lpk_), allocatable :: irow(:),icol(:) @@ -140,8 +140,7 @@ subroutine psb_dmatdist(a_glob, a, ictxt, desc_a,& allocate(iwork(liwork), iwrk2(np),stat = info) if (info /= psb_success_) then info=psb_err_alloc_request_ - int_err(1)=liwork - call psb_errpush(info,name,i_err=int_err,a_err='integer') + call psb_errpush(info,name,i_err=(/liwork/),a_err='integer') goto 9999 endif if (iam == root) then diff --git a/util/psb_s_mat_dist_impl.f90 b/util/psb_s_mat_dist_impl.f90 index 165e7bb8d..c1567270d 100644 --- a/util/psb_s_mat_dist_impl.f90 +++ b/util/psb_s_mat_dist_impl.f90 @@ -89,7 +89,7 @@ subroutine psb_smatdist(a_glob, a, ictxt, desc_a,& logical :: use_parts, use_v integer(psb_ipk_) :: np, iam, np_sharing integer(psb_ipk_) :: k_count, root, liwork, nnzero, nrhs,& - & i, ll, nz, isize, iproc, nnr, err, err_act, int_err(5) + & i, ll, nz, isize, iproc, nnr, err, err_act integer(psb_lpk_) :: i_count, j_count, nrow, ncol, ig integer(psb_ipk_), allocatable :: iwork(:), iwrk2(:) integer(psb_lpk_), allocatable :: irow(:),icol(:) @@ -140,8 +140,7 @@ subroutine psb_smatdist(a_glob, a, ictxt, desc_a,& allocate(iwork(liwork), iwrk2(np),stat = info) if (info /= psb_success_) then info=psb_err_alloc_request_ - int_err(1)=liwork - call psb_errpush(info,name,i_err=int_err,a_err='integer') + call psb_errpush(info,name,i_err=(/liwork/),a_err='integer') goto 9999 endif if (iam == root) then diff --git a/util/psb_z_mat_dist_impl.f90 b/util/psb_z_mat_dist_impl.f90 index 3de2f1559..f894e0620 100644 --- a/util/psb_z_mat_dist_impl.f90 +++ b/util/psb_z_mat_dist_impl.f90 @@ -89,7 +89,7 @@ subroutine psb_zmatdist(a_glob, a, ictxt, desc_a,& logical :: use_parts, use_v integer(psb_ipk_) :: np, iam, np_sharing integer(psb_ipk_) :: k_count, root, liwork, nnzero, nrhs,& - & i, ll, nz, isize, iproc, nnr, err, err_act, int_err(5) + & i, ll, nz, isize, iproc, nnr, err, err_act integer(psb_lpk_) :: i_count, j_count, nrow, ncol, ig integer(psb_ipk_), allocatable :: iwork(:), iwrk2(:) integer(psb_lpk_), allocatable :: irow(:),icol(:) @@ -140,8 +140,7 @@ subroutine psb_zmatdist(a_glob, a, ictxt, desc_a,& allocate(iwork(liwork), iwrk2(np),stat = info) if (info /= psb_success_) then info=psb_err_alloc_request_ - int_err(1)=liwork - call psb_errpush(info,name,i_err=int_err,a_err='integer') + call psb_errpush(info,name,i_err=(/liwork/),a_err='integer') goto 9999 endif if (iam == root) then