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

Cleanup usage if i_err.

Browse Source
ILmat
Salvatore Filippone 8 years ago
parent 987d9db99d
commit 660f0ccb28
93 changed files with 356 additions and 836 deletions
Show Stats Download Patch File Download Diff File

4
Changelog
Unescape Escape View File

@ -1,5 +1,9 @@
Changelog. A lot less detailed than usual, at least for past Changelog. A lot less detailed than usual, at least for past
history. 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. 2018/01/10: Updated docs.
2017/12/15: Fixed preconditioner build. 2017/12/15: Fixed preconditioner build.
2017/10/31: Updated target install directories. 2017/10/31: Updated target install directories.

32
base/comm/internals/psi_cswapdata.F90
Unescape Escape View File

@ -208,7 +208,6 @@ subroutine psi_cswap_vidx_vect(iictxt,iicomm,flag,beta,y,idx, &
integer(psb_ipk_) :: nesd, nerv,& integer(psb_ipk_) :: nesd, nerv,&
& err_act, i, idx_pt, totsnd_, totrcv_,& & err_act, i, idx_pt, totsnd_, totrcv_,&
& snd_pt, rcv_pt, pnti, n & snd_pt, rcv_pt, pnti, n
integer(psb_ipk_) :: ierr(5)
logical :: swap_mpi, swap_sync, swap_send, swap_recv,& logical :: swap_mpi, swap_sync, swap_send, swap_recv,&
& albf,do_send,do_recv & albf,do_send,do_recv
logical, parameter :: usersend=.false., debug=.false. 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.... ! Unfinished communication? Something is wrong....
! !
info=psb_err_mpi_error_ info=psb_err_mpi_error_
ierr(1) = -2 call psb_errpush(info,name,m_err=(/-2/))
call psb_errpush(info,name,i_err=ierr)
goto 9999 goto 9999
end if end if
end if end if
@ -318,9 +316,8 @@ subroutine psi_cswap_vidx_vect(iictxt,iicomm,flag,beta,y,idx, &
end if end if
if(iret /= mpi_success) then if(iret /= mpi_success) then
ierr(1) = iret
info=psb_err_mpi_error_ info=psb_err_mpi_error_
call psb_errpush(info,name,i_err=ierr) call psb_errpush(info,name,m_err=(/iret/))
goto 9999 goto 9999
end if end if
@ -335,8 +332,7 @@ subroutine psi_cswap_vidx_vect(iictxt,iicomm,flag,beta,y,idx, &
! No matching send? Something is wrong.... ! No matching send? Something is wrong....
! !
info=psb_err_mpi_error_ info=psb_err_mpi_error_
ierr(1) = -2 call psb_errpush(info,name,m_err=(/-2/))
call psb_errpush(info,name,i_err=ierr)
goto 9999 goto 9999
end if end if
call psb_realloc(totxch,prcid,info) 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 if (nesd>0) then
call mpi_wait(y%comid(i,1),p2pstat,iret) call mpi_wait(y%comid(i,1),p2pstat,iret)
if(iret /= mpi_success) then if(iret /= mpi_success) then
ierr(1) = iret
info=psb_err_mpi_error_ info=psb_err_mpi_error_
call psb_errpush(info,name,i_err=ierr) call psb_errpush(info,name,m_err=(/iret/))
goto 9999 goto 9999
end if end if
end if end if
if (nerv>0) then if (nerv>0) then
call mpi_wait(y%comid(i,2),p2pstat,iret) call mpi_wait(y%comid(i,2),p2pstat,iret)
if(iret /= mpi_success) then if(iret /= mpi_success) then
ierr(1) = iret
info=psb_err_mpi_error_ info=psb_err_mpi_error_
call psb_errpush(info,name,i_err=ierr) call psb_errpush(info,name,m_err=(/iret/))
goto 9999 goto 9999
end if end if
end if end if
@ -551,7 +545,6 @@ subroutine psi_cswap_vidx_multivect(iictxt,iicomm,flag,beta,y,idx, &
integer(psb_ipk_) :: nesd, nerv,& integer(psb_ipk_) :: nesd, nerv,&
& err_act, i, idx_pt, totsnd_, totrcv_,& & err_act, i, idx_pt, totsnd_, totrcv_,&
& snd_pt, rcv_pt, pnti, n & snd_pt, rcv_pt, pnti, n
integer(psb_ipk_) :: ierr(5)
logical :: swap_mpi, swap_sync, swap_send, swap_recv,& logical :: swap_mpi, swap_sync, swap_send, swap_recv,&
& albf,do_send,do_recv & albf,do_send,do_recv
logical, parameter :: usersend=.false., debug=.false. 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.... ! Unfinished communication? Something is wrong....
! !
info=psb_err_mpi_error_ info=psb_err_mpi_error_
ierr(1) = -2 call psb_errpush(info,name,m_err=(/-2/))
call psb_errpush(info,name,i_err=ierr)
goto 9999 goto 9999
end if end if
end if end if
@ -665,9 +657,8 @@ subroutine psi_cswap_vidx_multivect(iictxt,iicomm,flag,beta,y,idx, &
end if end if
if(iret /= mpi_success) then if(iret /= mpi_success) then
ierr(1) = iret
info=psb_err_mpi_error_ info=psb_err_mpi_error_
call psb_errpush(info,name,i_err=ierr) call psb_errpush(info,name,m_err=(/iret/))
goto 9999 goto 9999
end if end if
rcv_pt = rcv_pt + n*nerv 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.... ! No matching send? Something is wrong....
! !
info=psb_err_mpi_error_ info=psb_err_mpi_error_
ierr(1) = -2 call psb_errpush(info,name,m_err=(/-2/))
call psb_errpush(info,name,i_err=ierr)
goto 9999 goto 9999
end if end if
call psb_realloc(totxch,prcid,info) 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 if (nesd>0) then
call mpi_wait(y%comid(i,1),p2pstat,iret) call mpi_wait(y%comid(i,1),p2pstat,iret)
if(iret /= mpi_success) then if(iret /= mpi_success) then
ierr(1) = iret
info=psb_err_mpi_error_ info=psb_err_mpi_error_
call psb_errpush(info,name,i_err=ierr) call psb_errpush(info,name,m_err=(/iret/))
goto 9999 goto 9999
end if end if
end if end if
if (nerv>0) then if (nerv>0) then
call mpi_wait(y%comid(i,2),p2pstat,iret) call mpi_wait(y%comid(i,2),p2pstat,iret)
if(iret /= mpi_success) then if(iret /= mpi_success) then
ierr(1) = iret
info=psb_err_mpi_error_ info=psb_err_mpi_error_
call psb_errpush(info,name,i_err=ierr) call psb_errpush(info,name,m_err=(/iret/))
goto 9999 goto 9999
end if end if
end if end if

20
base/comm/internals/psi_cswapdata_a.F90
Unescape Escape View File

@ -180,7 +180,6 @@ subroutine psi_cswapidxm(iictxt,iicomm,flag,n,beta,y,idx, &
integer(psb_ipk_) :: nesd, nerv,& integer(psb_ipk_) :: nesd, nerv,&
& err_act, i, idx_pt, totsnd_, totrcv_,& & err_act, i, idx_pt, totsnd_, totrcv_,&
& snd_pt, rcv_pt, pnti & snd_pt, rcv_pt, pnti
integer(psb_ipk_) :: ierr(5)
logical :: swap_mpi, swap_sync, swap_send, swap_recv,& logical :: swap_mpi, swap_sync, swap_send, swap_recv,&
& albf,do_send,do_recv & albf,do_send,do_recv
logical, parameter :: usersend=.false. logical, parameter :: usersend=.false.
@ -300,9 +299,8 @@ subroutine psi_cswapidxm(iictxt,iicomm,flag,n,beta,y,idx, &
& psb_mpi_c_spk_,rcvbuf,rvsz,& & psb_mpi_c_spk_,rcvbuf,rvsz,&
& brvidx,psb_mpi_c_spk_,icomm,iret) & brvidx,psb_mpi_c_spk_,icomm,iret)
if(iret /= mpi_success) then if(iret /= mpi_success) then
ierr(1) = iret
info=psb_err_mpi_error_ info=psb_err_mpi_error_
call psb_errpush(info,name,i_err=ierr) call psb_errpush(info,name,m_err=(/iret/))
goto 9999 goto 9999
end if end if
@ -388,9 +386,8 @@ subroutine psi_cswapidxm(iictxt,iicomm,flag,n,beta,y,idx, &
end if end if
if(iret /= mpi_success) then if(iret /= mpi_success) then
ierr(1) = iret
info=psb_err_mpi_error_ info=psb_err_mpi_error_
call psb_errpush(info,name,i_err=ierr) call psb_errpush(info,name,m_err=(/iret/))
goto 9999 goto 9999
end if end if
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 if ((proc_to_comm /= me).and.(nerv>0)) then
call mpi_wait(rvhd(i),p2pstat,iret) call mpi_wait(rvhd(i),p2pstat,iret)
if(iret /= mpi_success) then if(iret /= mpi_success) then
ierr(1) = iret
info=psb_err_mpi_error_ info=psb_err_mpi_error_
call psb_errpush(info,name,i_err=ierr) call psb_errpush(info,name,m_err=(/iret/))
goto 9999 goto 9999
end if end if
else if (proc_to_comm == me) then 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,& integer(psb_ipk_) :: nesd, nerv,&
& err_act, i, idx_pt, totsnd_, totrcv_,& & err_act, i, idx_pt, totsnd_, totrcv_,&
& snd_pt, rcv_pt, pnti, n & snd_pt, rcv_pt, pnti, n
integer(psb_ipk_) :: ierr(5)
logical :: swap_mpi, swap_sync, swap_send, swap_recv,& logical :: swap_mpi, swap_sync, swap_send, swap_recv,&
& albf,do_send,do_recv & albf,do_send,do_recv
logical, parameter :: usersend=.false. logical, parameter :: usersend=.false.
@ -790,9 +785,8 @@ subroutine psi_cswapidxv(iictxt,iicomm,flag,beta,y,idx, &
& psb_mpi_c_spk_,rcvbuf,rvsz,& & psb_mpi_c_spk_,rcvbuf,rvsz,&
& brvidx,psb_mpi_c_spk_,icomm,iret) & brvidx,psb_mpi_c_spk_,icomm,iret)
if(iret /= mpi_success) then if(iret /= mpi_success) then
ierr(1) = iret
info=psb_err_mpi_error_ info=psb_err_mpi_error_
call psb_errpush(info,name,i_err=ierr) call psb_errpush(info,name,m_err=(/iret/))
goto 9999 goto 9999
end if end if
@ -879,9 +873,8 @@ subroutine psi_cswapidxv(iictxt,iicomm,flag,beta,y,idx, &
end if end if
if(iret /= mpi_success) then if(iret /= mpi_success) then
ierr(1) = iret
info=psb_err_mpi_error_ info=psb_err_mpi_error_
call psb_errpush(info,name,i_err=ierr) call psb_errpush(info,name,m_err=(/iret/))
goto 9999 goto 9999
end if end if
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 if ((proc_to_comm /= me).and.(nerv>0)) then
call mpi_wait(rvhd(i),p2pstat,iret) call mpi_wait(rvhd(i),p2pstat,iret)
if(iret /= mpi_success) then if(iret /= mpi_success) then
ierr(1) = iret
info=psb_err_mpi_error_ info=psb_err_mpi_error_
call psb_errpush(info,name,i_err=ierr) call psb_errpush(info,name,m_err=(/iret/))
goto 9999 goto 9999
end if end if
else if (proc_to_comm == me) then else if (proc_to_comm == me) then

34
base/comm/internals/psi_cswaptran.F90
Unescape Escape View File

@ -120,7 +120,6 @@ subroutine psi_cswaptran_vect(flag,beta,y,desc_a,work,info,data)
! locals ! locals
integer(psb_ipk_) :: ictxt, np, me, icomm, idxs, idxr, totxch, err_act, data_ integer(psb_ipk_) :: ictxt, np, me, icomm, idxs, idxr, totxch, err_act, data_
class(psb_i_base_vect_type), pointer :: d_vidx class(psb_i_base_vect_type), pointer :: d_vidx
integer(psb_ipk_) :: ierr(5)
character(len=20) :: name character(len=20) :: name
info=psb_success_ info=psb_success_
@ -212,7 +211,6 @@ subroutine psi_ctran_vidx_vect(iictxt,iicomm,flag,beta,y,idx,&
integer(psb_ipk_) :: nesd, nerv,& integer(psb_ipk_) :: nesd, nerv,&
& err_act, i, idx_pt, totsnd_, totrcv_,& & err_act, i, idx_pt, totsnd_, totrcv_,&
& snd_pt, rcv_pt, pnti, n & snd_pt, rcv_pt, pnti, n
integer(psb_ipk_) :: ierr(5)
logical :: swap_mpi, swap_sync, swap_send, swap_recv,& logical :: swap_mpi, swap_sync, swap_send, swap_recv,&
& albf,do_send,do_recv & albf,do_send,do_recv
logical, parameter :: usersend=.false., debug=.false. 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.... ! Unfinished communication? Something is wrong....
! !
info=psb_err_mpi_error_ info=psb_err_mpi_error_
ierr(1) = -2 call psb_errpush(info,name,m_err=(/-2/))
call psb_errpush(info,name,i_err=ierr)
goto 9999 goto 9999
end if end if
end if end if
@ -328,9 +325,8 @@ subroutine psi_ctran_vidx_vect(iictxt,iicomm,flag,beta,y,idx,&
end if end if
if(iret /= mpi_success) then if(iret /= mpi_success) then
ierr(1) = iret
info=psb_err_mpi_error_ info=psb_err_mpi_error_
call psb_errpush(info,name,i_err=ierr) call psb_errpush(info,name,m_err=(/iret/))
goto 9999 goto 9999
end if end if
@ -345,8 +341,7 @@ subroutine psi_ctran_vidx_vect(iictxt,iicomm,flag,beta,y,idx,&
! No matching send? Something is wrong.... ! No matching send? Something is wrong....
! !
info=psb_err_mpi_error_ info=psb_err_mpi_error_
ierr(1) = -2 call psb_errpush(info,name,m_err=(/-2/))
call psb_errpush(info,name,i_err=ierr)
goto 9999 goto 9999
end if end if
call psb_realloc(totxch,prcid,info) 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 if (nerv>0) then
call mpi_wait(y%comid(i,1),p2pstat,iret) call mpi_wait(y%comid(i,1),p2pstat,iret)
if(iret /= mpi_success) then if(iret /= mpi_success) then
ierr(1) = iret
info=psb_err_mpi_error_ info=psb_err_mpi_error_
call psb_errpush(info,name,i_err=ierr) call psb_errpush(info,name,m_err=(/iret/))
goto 9999 goto 9999
end if end if
end if end if
if (nesd>0) then if (nesd>0) then
call mpi_wait(y%comid(i,2),p2pstat,iret) call mpi_wait(y%comid(i,2),p2pstat,iret)
if(iret /= mpi_success) then if(iret /= mpi_success) then
ierr(1) = iret
info=psb_err_mpi_error_ info=psb_err_mpi_error_
call psb_errpush(info,name,i_err=ierr) call psb_errpush(info,name,m_err=(/iret/))
goto 9999 goto 9999
end if end if
end if end if
@ -475,7 +468,6 @@ subroutine psi_cswaptran_multivect(flag,beta,y,desc_a,work,info,data)
! locals ! locals
integer(psb_ipk_) :: ictxt, np, me, icomm, idxs, idxr, totxch, err_act, data_ integer(psb_ipk_) :: ictxt, np, me, icomm, idxs, idxr, totxch, err_act, data_
class(psb_i_base_vect_type), pointer :: d_vidx class(psb_i_base_vect_type), pointer :: d_vidx
integer(psb_ipk_) :: ierr(5)
character(len=20) :: name character(len=20) :: name
info=psb_success_ info=psb_success_
@ -566,7 +558,6 @@ subroutine psi_ctran_vidx_multivect(iictxt,iicomm,flag,beta,y,idx,&
integer(psb_ipk_) :: nesd, nerv,& integer(psb_ipk_) :: nesd, nerv,&
& err_act, i, idx_pt, totsnd_, totrcv_,& & err_act, i, idx_pt, totsnd_, totrcv_,&
& snd_pt, rcv_pt, pnti, n & snd_pt, rcv_pt, pnti, n
integer(psb_ipk_) :: ierr(5)
logical :: swap_mpi, swap_sync, swap_send, swap_recv,& logical :: swap_mpi, swap_sync, swap_send, swap_recv,&
& albf,do_send,do_recv & albf,do_send,do_recv
logical, parameter :: usersend=.false., debug=.false. 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.... ! Unfinished communication? Something is wrong....
! !
info=psb_err_mpi_error_ info=psb_err_mpi_error_
ierr(1) = -2 call psb_errpush(info,name,m_err=(/-2/))
call psb_errpush(info,name,i_err=ierr)
goto 9999 goto 9999
end if end if
end if end if
@ -682,9 +672,8 @@ subroutine psi_ctran_vidx_multivect(iictxt,iicomm,flag,beta,y,idx,&
end if end if
if(iret /= mpi_success) then if(iret /= mpi_success) then
ierr(1) = iret
info=psb_err_mpi_error_ info=psb_err_mpi_error_
call psb_errpush(info,name,i_err=ierr) call psb_errpush(info,name,m_err=(/iret/))
goto 9999 goto 9999
end if end if
rcv_pt = rcv_pt + n*nerv 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.... ! No matching send? Something is wrong....
! !
info=psb_err_mpi_error_ info=psb_err_mpi_error_
ierr(1) = -2 call psb_errpush(info,name,m_err=(/-2/))
call psb_errpush(info,name,i_err=ierr)
goto 9999 goto 9999
end if end if
call psb_realloc(totxch,prcid,info) 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 if (nerv>0) then
call mpi_wait(y%comid(i,1),p2pstat,iret) call mpi_wait(y%comid(i,1),p2pstat,iret)
if(iret /= mpi_success) then if(iret /= mpi_success) then
ierr(1) = iret
info=psb_err_mpi_error_ info=psb_err_mpi_error_
call psb_errpush(info,name,i_err=ierr) call psb_errpush(info,name,m_err=(/iret/))
goto 9999 goto 9999
end if end if
end if end if
if (nesd>0) then if (nesd>0) then
call mpi_wait(y%comid(i,2),p2pstat,iret) call mpi_wait(y%comid(i,2),p2pstat,iret)
if(iret /= mpi_success) then if(iret /= mpi_success) then
ierr(1) = iret
info=psb_err_mpi_error_ info=psb_err_mpi_error_
call psb_errpush(info,name,i_err=ierr) call psb_errpush(info,name,m_err=(/iret/))
goto 9999 goto 9999
end if end if
end if end if

22
base/comm/internals/psi_cswaptran_a.F90
Unescape Escape View File

@ -111,7 +111,6 @@ subroutine psi_cswaptranm(flag,n,beta,y,desc_a,work,info,data)
! locals ! locals
integer(psb_ipk_) :: ictxt, np, me, icomm, idxs, idxr, err_act, totxch, data_ integer(psb_ipk_) :: ictxt, np, me, icomm, idxs, idxr, err_act, totxch, data_
integer(psb_ipk_), pointer :: d_idx(:) integer(psb_ipk_), pointer :: d_idx(:)
integer(psb_ipk_) :: ierr(5)
character(len=20) :: name character(len=20) :: name
info=psb_success_ info=psb_success_
@ -186,7 +185,6 @@ subroutine psi_ctranidxm(iictxt,iicomm,flag,n,beta,y,idx,&
integer(psb_ipk_) :: nesd, nerv,& integer(psb_ipk_) :: nesd, nerv,&
& err_act, i, idx_pt, totsnd_, totrcv_,& & err_act, i, idx_pt, totsnd_, totrcv_,&
& snd_pt, rcv_pt, pnti & snd_pt, rcv_pt, pnti
integer(psb_ipk_) :: ierr(5)
logical :: swap_mpi, swap_sync, swap_send, swap_recv,& logical :: swap_mpi, swap_sync, swap_send, swap_recv,&
& albf,do_send,do_recv & albf,do_send,do_recv
logical, parameter :: usersend=.false. logical, parameter :: usersend=.false.
@ -311,9 +309,8 @@ subroutine psi_ctranidxm(iictxt,iicomm,flag,n,beta,y,idx,&
& psb_mpi_c_spk_,& & psb_mpi_c_spk_,&
& sndbuf,sdsz,bsdidx,psb_mpi_c_spk_,icomm,iret) & sndbuf,sdsz,bsdidx,psb_mpi_c_spk_,icomm,iret)
if(iret /= mpi_success) then if(iret /= mpi_success) then
ierr(1) = iret
info=psb_err_mpi_error_ info=psb_err_mpi_error_
call psb_errpush(info,name,i_err=ierr) call psb_errpush(info,name,m_err=(/iret/))
goto 9999 goto 9999
end if end if
@ -399,9 +396,8 @@ subroutine psi_ctranidxm(iictxt,iicomm,flag,n,beta,y,idx,&
end if end if
if(iret /= mpi_success) then if(iret /= mpi_success) then
ierr(1) = iret
info=psb_err_mpi_error_ info=psb_err_mpi_error_
call psb_errpush(info,name,i_err=ierr) call psb_errpush(info,name,m_err=(/iret/))
goto 9999 goto 9999
end if end if
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 if ((proc_to_comm /= me).and.(nesd>0)) then
call mpi_wait(rvhd(i),p2pstat,iret) call mpi_wait(rvhd(i),p2pstat,iret)
if(iret /= mpi_success) then if(iret /= mpi_success) then
ierr(1) = iret
info=psb_err_mpi_error_ info=psb_err_mpi_error_
call psb_errpush(info,name,i_err=ierr) call psb_errpush(info,name,m_err=(/iret/))
goto 9999 goto 9999
end if end if
else if (proc_to_comm == me) then else if (proc_to_comm == me) then
@ -599,7 +594,6 @@ subroutine psi_cswaptranv(flag,beta,y,desc_a,work,info,data)
! locals ! locals
integer(psb_ipk_) :: ictxt, np, me, icomm, idxs, idxr, totxch, err_act, data_ integer(psb_ipk_) :: ictxt, np, me, icomm, idxs, idxr, totxch, err_act, data_
integer(psb_ipk_), pointer :: d_idx(:) integer(psb_ipk_), pointer :: d_idx(:)
integer(psb_ipk_) :: ierr(5)
character(len=20) :: name character(len=20) :: name
info=psb_success_ info=psb_success_
@ -684,7 +678,6 @@ subroutine psi_ctranidxv(iictxt,iicomm,flag,beta,y,idx,&
integer(psb_ipk_) :: nesd, nerv,& integer(psb_ipk_) :: nesd, nerv,&
& err_act, i, idx_pt, totsnd_, totrcv_,& & err_act, i, idx_pt, totsnd_, totrcv_,&
& snd_pt, rcv_pt, pnti, n & snd_pt, rcv_pt, pnti, n
integer(psb_ipk_) :: ierr(5)
logical :: swap_mpi, swap_sync, swap_send, swap_recv,& logical :: swap_mpi, swap_sync, swap_send, swap_recv,&
& albf,do_send,do_recv & albf,do_send,do_recv
logical, parameter :: usersend=.false. logical, parameter :: usersend=.false.
@ -810,9 +803,8 @@ subroutine psi_ctranidxv(iictxt,iicomm,flag,beta,y,idx,&
& psb_mpi_c_spk_,& & psb_mpi_c_spk_,&
& sndbuf,sdsz,bsdidx,psb_mpi_c_spk_,icomm,iret) & sndbuf,sdsz,bsdidx,psb_mpi_c_spk_,icomm,iret)
if(iret /= mpi_success) then if(iret /= mpi_success) then
ierr(1) = iret
info=psb_err_mpi_error_ info=psb_err_mpi_error_
call psb_errpush(info,name,i_err=ierr) call psb_errpush(info,name,m_err=(/iret/))
goto 9999 goto 9999
end if end if
@ -897,9 +889,8 @@ subroutine psi_ctranidxv(iictxt,iicomm,flag,beta,y,idx,&
end if end if
if(iret /= mpi_success) then if(iret /= mpi_success) then
ierr(1) = iret
info=psb_err_mpi_error_ info=psb_err_mpi_error_
call psb_errpush(info,name,i_err=ierr) call psb_errpush(info,name,m_err=(/iret/))
goto 9999 goto 9999
end if end if
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 if ((proc_to_comm /= me).and.(nesd>0)) then
call mpi_wait(rvhd(i),p2pstat,iret) call mpi_wait(rvhd(i),p2pstat,iret)
if(iret /= mpi_success) then if(iret /= mpi_success) then
ierr(1) = iret
info=psb_err_mpi_error_ info=psb_err_mpi_error_
call psb_errpush(info,name,i_err=ierr) call psb_errpush(info,name,m_err=(/iret/))
goto 9999 goto 9999
end if end if
else if (proc_to_comm == me) then else if (proc_to_comm == me) then

32
base/comm/internals/psi_dswapdata.F90
Unescape Escape View File

@ -208,7 +208,6 @@ subroutine psi_dswap_vidx_vect(iictxt,iicomm,flag,beta,y,idx, &
integer(psb_ipk_) :: nesd, nerv,& integer(psb_ipk_) :: nesd, nerv,&
& err_act, i, idx_pt, totsnd_, totrcv_,& & err_act, i, idx_pt, totsnd_, totrcv_,&
& snd_pt, rcv_pt, pnti, n & snd_pt, rcv_pt, pnti, n
integer(psb_ipk_) :: ierr(5)
logical :: swap_mpi, swap_sync, swap_send, swap_recv,& logical :: swap_mpi, swap_sync, swap_send, swap_recv,&
& albf,do_send,do_recv & albf,do_send,do_recv
logical, parameter :: usersend=.false., debug=.false. 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.... ! Unfinished communication? Something is wrong....
! !
info=psb_err_mpi_error_ info=psb_err_mpi_error_
ierr(1) = -2 call psb_errpush(info,name,m_err=(/-2/))
call psb_errpush(info,name,i_err=ierr)
goto 9999 goto 9999
end if end if
end if end if
@ -318,9 +316,8 @@ subroutine psi_dswap_vidx_vect(iictxt,iicomm,flag,beta,y,idx, &
end if end if
if(iret /= mpi_success) then if(iret /= mpi_success) then
ierr(1) = iret
info=psb_err_mpi_error_ info=psb_err_mpi_error_
call psb_errpush(info,name,i_err=ierr) call psb_errpush(info,name,m_err=(/iret/))
goto 9999 goto 9999
end if end if
@ -335,8 +332,7 @@ subroutine psi_dswap_vidx_vect(iictxt,iicomm,flag,beta,y,idx, &
! No matching send? Something is wrong.... ! No matching send? Something is wrong....
! !
info=psb_err_mpi_error_ info=psb_err_mpi_error_
ierr(1) = -2 call psb_errpush(info,name,m_err=(/-2/))
call psb_errpush(info,name,i_err=ierr)
goto 9999 goto 9999
end if end if
call psb_realloc(totxch,prcid,info) 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 if (nesd>0) then
call mpi_wait(y%comid(i,1),p2pstat,iret) call mpi_wait(y%comid(i,1),p2pstat,iret)
if(iret /= mpi_success) then if(iret /= mpi_success) then
ierr(1) = iret
info=psb_err_mpi_error_ info=psb_err_mpi_error_
call psb_errpush(info,name,i_err=ierr) call psb_errpush(info,name,m_err=(/iret/))
goto 9999 goto 9999
end if end if
end if end if
if (nerv>0) then if (nerv>0) then
call mpi_wait(y%comid(i,2),p2pstat,iret) call mpi_wait(y%comid(i,2),p2pstat,iret)
if(iret /= mpi_success) then if(iret /= mpi_success) then
ierr(1) = iret
info=psb_err_mpi_error_ info=psb_err_mpi_error_
call psb_errpush(info,name,i_err=ierr) call psb_errpush(info,name,m_err=(/iret/))
goto 9999 goto 9999
end if end if
end if end if
@ -551,7 +545,6 @@ subroutine psi_dswap_vidx_multivect(iictxt,iicomm,flag,beta,y,idx, &
integer(psb_ipk_) :: nesd, nerv,& integer(psb_ipk_) :: nesd, nerv,&
& err_act, i, idx_pt, totsnd_, totrcv_,& & err_act, i, idx_pt, totsnd_, totrcv_,&
& snd_pt, rcv_pt, pnti, n & snd_pt, rcv_pt, pnti, n
integer(psb_ipk_) :: ierr(5)
logical :: swap_mpi, swap_sync, swap_send, swap_recv,& logical :: swap_mpi, swap_sync, swap_send, swap_recv,&
& albf,do_send,do_recv & albf,do_send,do_recv
logical, parameter :: usersend=.false., debug=.false. 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.... ! Unfinished communication? Something is wrong....
! !
info=psb_err_mpi_error_ info=psb_err_mpi_error_
ierr(1) = -2 call psb_errpush(info,name,m_err=(/-2/))
call psb_errpush(info,name,i_err=ierr)
goto 9999 goto 9999
end if end if
end if end if
@ -665,9 +657,8 @@ subroutine psi_dswap_vidx_multivect(iictxt,iicomm,flag,beta,y,idx, &
end if end if
if(iret /= mpi_success) then if(iret /= mpi_success) then
ierr(1) = iret
info=psb_err_mpi_error_ info=psb_err_mpi_error_
call psb_errpush(info,name,i_err=ierr) call psb_errpush(info,name,m_err=(/iret/))
goto 9999 goto 9999
end if end if
rcv_pt = rcv_pt + n*nerv 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.... ! No matching send? Something is wrong....
! !
info=psb_err_mpi_error_ info=psb_err_mpi_error_
ierr(1) = -2 call psb_errpush(info,name,m_err=(/-2/))
call psb_errpush(info,name,i_err=ierr)
goto 9999 goto 9999
end if end if
call psb_realloc(totxch,prcid,info) 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 if (nesd>0) then
call mpi_wait(y%comid(i,1),p2pstat,iret) call mpi_wait(y%comid(i,1),p2pstat,iret)
if(iret /= mpi_success) then if(iret /= mpi_success) then
ierr(1) = iret
info=psb_err_mpi_error_ info=psb_err_mpi_error_
call psb_errpush(info,name,i_err=ierr) call psb_errpush(info,name,m_err=(/iret/))
goto 9999 goto 9999
end if end if
end if end if
if (nerv>0) then if (nerv>0) then
call mpi_wait(y%comid(i,2),p2pstat,iret) call mpi_wait(y%comid(i,2),p2pstat,iret)
if(iret /= mpi_success) then if(iret /= mpi_success) then
ierr(1) = iret
info=psb_err_mpi_error_ info=psb_err_mpi_error_
call psb_errpush(info,name,i_err=ierr) call psb_errpush(info,name,m_err=(/iret/))
goto 9999 goto 9999
end if end if
end if end if

20
base/comm/internals/psi_dswapdata_a.F90
Unescape Escape View File

@ -180,7 +180,6 @@ subroutine psi_dswapidxm(iictxt,iicomm,flag,n,beta,y,idx, &
integer(psb_ipk_) :: nesd, nerv,& integer(psb_ipk_) :: nesd, nerv,&
& err_act, i, idx_pt, totsnd_, totrcv_,& & err_act, i, idx_pt, totsnd_, totrcv_,&
& snd_pt, rcv_pt, pnti & snd_pt, rcv_pt, pnti
integer(psb_ipk_) :: ierr(5)
logical :: swap_mpi, swap_sync, swap_send, swap_recv,& logical :: swap_mpi, swap_sync, swap_send, swap_recv,&
& albf,do_send,do_recv & albf,do_send,do_recv
logical, parameter :: usersend=.false. logical, parameter :: usersend=.false.
@ -300,9 +299,8 @@ subroutine psi_dswapidxm(iictxt,iicomm,flag,n,beta,y,idx, &
& psb_mpi_r_dpk_,rcvbuf,rvsz,& & psb_mpi_r_dpk_,rcvbuf,rvsz,&
& brvidx,psb_mpi_r_dpk_,icomm,iret) & brvidx,psb_mpi_r_dpk_,icomm,iret)
if(iret /= mpi_success) then if(iret /= mpi_success) then
ierr(1) = iret
info=psb_err_mpi_error_ info=psb_err_mpi_error_
call psb_errpush(info,name,i_err=ierr) call psb_errpush(info,name,m_err=(/iret/))
goto 9999 goto 9999
end if end if
@ -388,9 +386,8 @@ subroutine psi_dswapidxm(iictxt,iicomm,flag,n,beta,y,idx, &
end if end if
if(iret /= mpi_success) then if(iret /= mpi_success) then
ierr(1) = iret
info=psb_err_mpi_error_ info=psb_err_mpi_error_
call psb_errpush(info,name,i_err=ierr) call psb_errpush(info,name,m_err=(/iret/))
goto 9999 goto 9999
end if end if
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 if ((proc_to_comm /= me).and.(nerv>0)) then
call mpi_wait(rvhd(i),p2pstat,iret) call mpi_wait(rvhd(i),p2pstat,iret)
if(iret /= mpi_success) then if(iret /= mpi_success) then
ierr(1) = iret
info=psb_err_mpi_error_ info=psb_err_mpi_error_
call psb_errpush(info,name,i_err=ierr) call psb_errpush(info,name,m_err=(/iret/))
goto 9999 goto 9999
end if end if
else if (proc_to_comm == me) then 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,& integer(psb_ipk_) :: nesd, nerv,&
& err_act, i, idx_pt, totsnd_, totrcv_,& & err_act, i, idx_pt, totsnd_, totrcv_,&
& snd_pt, rcv_pt, pnti, n & snd_pt, rcv_pt, pnti, n
integer(psb_ipk_) :: ierr(5)
logical :: swap_mpi, swap_sync, swap_send, swap_recv,& logical :: swap_mpi, swap_sync, swap_send, swap_recv,&
& albf,do_send,do_recv & albf,do_send,do_recv
logical, parameter :: usersend=.false. logical, parameter :: usersend=.false.
@ -790,9 +785,8 @@ subroutine psi_dswapidxv(iictxt,iicomm,flag,beta,y,idx, &
& psb_mpi_r_dpk_,rcvbuf,rvsz,& & psb_mpi_r_dpk_,rcvbuf,rvsz,&
& brvidx,psb_mpi_r_dpk_,icomm,iret) & brvidx,psb_mpi_r_dpk_,icomm,iret)
if(iret /= mpi_success) then if(iret /= mpi_success) then
ierr(1) = iret
info=psb_err_mpi_error_ info=psb_err_mpi_error_
call psb_errpush(info,name,i_err=ierr) call psb_errpush(info,name,m_err=(/iret/))
goto 9999 goto 9999
end if end if
@ -879,9 +873,8 @@ subroutine psi_dswapidxv(iictxt,iicomm,flag,beta,y,idx, &
end if end if
if(iret /= mpi_success) then if(iret /= mpi_success) then
ierr(1) = iret
info=psb_err_mpi_error_ info=psb_err_mpi_error_
call psb_errpush(info,name,i_err=ierr) call psb_errpush(info,name,m_err=(/iret/))
goto 9999 goto 9999
end if end if
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 if ((proc_to_comm /= me).and.(nerv>0)) then
call mpi_wait(rvhd(i),p2pstat,iret) call mpi_wait(rvhd(i),p2pstat,iret)
if(iret /= mpi_success) then if(iret /= mpi_success) then
ierr(1) = iret
info=psb_err_mpi_error_ info=psb_err_mpi_error_
call psb_errpush(info,name,i_err=ierr) call psb_errpush(info,name,m_err=(/iret/))
goto 9999 goto 9999
end if end if
else if (proc_to_comm == me) then else if (proc_to_comm == me) then

34
base/comm/internals/psi_dswaptran.F90
Unescape Escape View File

@ -120,7 +120,6 @@ subroutine psi_dswaptran_vect(flag,beta,y,desc_a,work,info,data)
! locals ! locals
integer(psb_ipk_) :: ictxt, np, me, icomm, idxs, idxr, totxch, err_act, data_ integer(psb_ipk_) :: ictxt, np, me, icomm, idxs, idxr, totxch, err_act, data_
class(psb_i_base_vect_type), pointer :: d_vidx class(psb_i_base_vect_type), pointer :: d_vidx
integer(psb_ipk_) :: ierr(5)
character(len=20) :: name character(len=20) :: name
info=psb_success_ info=psb_success_
@ -212,7 +211,6 @@ subroutine psi_dtran_vidx_vect(iictxt,iicomm,flag,beta,y,idx,&
integer(psb_ipk_) :: nesd, nerv,& integer(psb_ipk_) :: nesd, nerv,&
& err_act, i, idx_pt, totsnd_, totrcv_,& & err_act, i, idx_pt, totsnd_, totrcv_,&
& snd_pt, rcv_pt, pnti, n & snd_pt, rcv_pt, pnti, n
integer(psb_ipk_) :: ierr(5)
logical :: swap_mpi, swap_sync, swap_send, swap_recv,& logical :: swap_mpi, swap_sync, swap_send, swap_recv,&
& albf,do_send,do_recv & albf,do_send,do_recv
logical, parameter :: usersend=.false., debug=.false. 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.... ! Unfinished communication? Something is wrong....
! !
info=psb_err_mpi_error_ info=psb_err_mpi_error_
ierr(1) = -2 call psb_errpush(info,name,m_err=(/-2/))
call psb_errpush(info,name,i_err=ierr)
goto 9999 goto 9999
end if end if
end if end if
@ -328,9 +325,8 @@ subroutine psi_dtran_vidx_vect(iictxt,iicomm,flag,beta,y,idx,&
end if end if
if(iret /= mpi_success) then if(iret /= mpi_success) then
ierr(1) = iret
info=psb_err_mpi_error_ info=psb_err_mpi_error_
call psb_errpush(info,name,i_err=ierr) call psb_errpush(info,name,m_err=(/iret/))
goto 9999 goto 9999
end if end if
@ -345,8 +341,7 @@ subroutine psi_dtran_vidx_vect(iictxt,iicomm,flag,beta,y,idx,&
! No matching send? Something is wrong.... ! No matching send? Something is wrong....
! !
info=psb_err_mpi_error_ info=psb_err_mpi_error_
ierr(1) = -2 call psb_errpush(info,name,m_err=(/-2/))
call psb_errpush(info,name,i_err=ierr)
goto 9999 goto 9999
end if end if
call psb_realloc(totxch,prcid,info) 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 if (nerv>0) then
call mpi_wait(y%comid(i,1),p2pstat,iret) call mpi_wait(y%comid(i,1),p2pstat,iret)
if(iret /= mpi_success) then if(iret /= mpi_success) then
ierr(1) = iret
info=psb_err_mpi_error_ info=psb_err_mpi_error_
call psb_errpush(info,name,i_err=ierr) call psb_errpush(info,name,m_err=(/iret/))
goto 9999 goto 9999
end if end if
end if end if
if (nesd>0) then if (nesd>0) then
call mpi_wait(y%comid(i,2),p2pstat,iret) call mpi_wait(y%comid(i,2),p2pstat,iret)
if(iret /= mpi_success) then if(iret /= mpi_success) then
ierr(1) = iret
info=psb_err_mpi_error_ info=psb_err_mpi_error_
call psb_errpush(info,name,i_err=ierr) call psb_errpush(info,name,m_err=(/iret/))
goto 9999 goto 9999
end if end if
end if end if
@ -475,7 +468,6 @@ subroutine psi_dswaptran_multivect(flag,beta,y,desc_a,work,info,data)
! locals ! locals
integer(psb_ipk_) :: ictxt, np, me, icomm, idxs, idxr, totxch, err_act, data_ integer(psb_ipk_) :: ictxt, np, me, icomm, idxs, idxr, totxch, err_act, data_
class(psb_i_base_vect_type), pointer :: d_vidx class(psb_i_base_vect_type), pointer :: d_vidx
integer(psb_ipk_) :: ierr(5)
character(len=20) :: name character(len=20) :: name
info=psb_success_ info=psb_success_
@ -566,7 +558,6 @@ subroutine psi_dtran_vidx_multivect(iictxt,iicomm,flag,beta,y,idx,&
integer(psb_ipk_) :: nesd, nerv,& integer(psb_ipk_) :: nesd, nerv,&
& err_act, i, idx_pt, totsnd_, totrcv_,& & err_act, i, idx_pt, totsnd_, totrcv_,&
& snd_pt, rcv_pt, pnti, n & snd_pt, rcv_pt, pnti, n
integer(psb_ipk_) :: ierr(5)
logical :: swap_mpi, swap_sync, swap_send, swap_recv,& logical :: swap_mpi, swap_sync, swap_send, swap_recv,&
& albf,do_send,do_recv & albf,do_send,do_recv
logical, parameter :: usersend=.false., debug=.false. 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.... ! Unfinished communication? Something is wrong....
! !
info=psb_err_mpi_error_ info=psb_err_mpi_error_
ierr(1) = -2 call psb_errpush(info,name,m_err=(/-2/))
call psb_errpush(info,name,i_err=ierr)
goto 9999 goto 9999
end if end if
end if end if
@ -682,9 +672,8 @@ subroutine psi_dtran_vidx_multivect(iictxt,iicomm,flag,beta,y,idx,&
end if end if
if(iret /= mpi_success) then if(iret /= mpi_success) then
ierr(1) = iret
info=psb_err_mpi_error_ info=psb_err_mpi_error_
call psb_errpush(info,name,i_err=ierr) call psb_errpush(info,name,m_err=(/iret/))
goto 9999 goto 9999
end if end if
rcv_pt = rcv_pt + n*nerv 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.... ! No matching send? Something is wrong....
! !
info=psb_err_mpi_error_ info=psb_err_mpi_error_
ierr(1) = -2 call psb_errpush(info,name,m_err=(/-2/))
call psb_errpush(info,name,i_err=ierr)
goto 9999 goto 9999
end if end if
call psb_realloc(totxch,prcid,info) 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 if (nerv>0) then
call mpi_wait(y%comid(i,1),p2pstat,iret) call mpi_wait(y%comid(i,1),p2pstat,iret)
if(iret /= mpi_success) then if(iret /= mpi_success) then
ierr(1) = iret
info=psb_err_mpi_error_ info=psb_err_mpi_error_
call psb_errpush(info,name,i_err=ierr) call psb_errpush(info,name,m_err=(/iret/))
goto 9999 goto 9999
end if end if
end if end if
if (nesd>0) then if (nesd>0) then
call mpi_wait(y%comid(i,2),p2pstat,iret) call mpi_wait(y%comid(i,2),p2pstat,iret)
if(iret /= mpi_success) then if(iret /= mpi_success) then
ierr(1) = iret
info=psb_err_mpi_error_ info=psb_err_mpi_error_
call psb_errpush(info,name,i_err=ierr) call psb_errpush(info,name,m_err=(/iret/))
goto 9999 goto 9999
end if end if
end if end if

22
base/comm/internals/psi_dswaptran_a.F90
Unescape Escape View File

@ -111,7 +111,6 @@ subroutine psi_dswaptranm(flag,n,beta,y,desc_a,work,info,data)
! locals ! locals
integer(psb_ipk_) :: ictxt, np, me, icomm, idxs, idxr, err_act, totxch, data_ integer(psb_ipk_) :: ictxt, np, me, icomm, idxs, idxr, err_act, totxch, data_
integer(psb_ipk_), pointer :: d_idx(:) integer(psb_ipk_), pointer :: d_idx(:)
integer(psb_ipk_) :: ierr(5)
character(len=20) :: name character(len=20) :: name
info=psb_success_ info=psb_success_
@ -186,7 +185,6 @@ subroutine psi_dtranidxm(iictxt,iicomm,flag,n,beta,y,idx,&
integer(psb_ipk_) :: nesd, nerv,& integer(psb_ipk_) :: nesd, nerv,&
& err_act, i, idx_pt, totsnd_, totrcv_,& & err_act, i, idx_pt, totsnd_, totrcv_,&
& snd_pt, rcv_pt, pnti & snd_pt, rcv_pt, pnti
integer(psb_ipk_) :: ierr(5)
logical :: swap_mpi, swap_sync, swap_send, swap_recv,& logical :: swap_mpi, swap_sync, swap_send, swap_recv,&
& albf,do_send,do_recv & albf,do_send,do_recv
logical, parameter :: usersend=.false. logical, parameter :: usersend=.false.
@ -311,9 +309,8 @@ subroutine psi_dtranidxm(iictxt,iicomm,flag,n,beta,y,idx,&
& psb_mpi_r_dpk_,& & psb_mpi_r_dpk_,&
& sndbuf,sdsz,bsdidx,psb_mpi_r_dpk_,icomm,iret) & sndbuf,sdsz,bsdidx,psb_mpi_r_dpk_,icomm,iret)
if(iret /= mpi_success) then if(iret /= mpi_success) then
ierr(1) = iret
info=psb_err_mpi_error_ info=psb_err_mpi_error_
call psb_errpush(info,name,i_err=ierr) call psb_errpush(info,name,m_err=(/iret/))
goto 9999 goto 9999
end if end if
@ -399,9 +396,8 @@ subroutine psi_dtranidxm(iictxt,iicomm,flag,n,beta,y,idx,&
end if end if
if(iret /= mpi_success) then if(iret /= mpi_success) then
ierr(1) = iret
info=psb_err_mpi_error_ info=psb_err_mpi_error_
call psb_errpush(info,name,i_err=ierr) call psb_errpush(info,name,m_err=(/iret/))
goto 9999 goto 9999
end if end if
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 if ((proc_to_comm /= me).and.(nesd>0)) then
call mpi_wait(rvhd(i),p2pstat,iret) call mpi_wait(rvhd(i),p2pstat,iret)
if(iret /= mpi_success) then if(iret /= mpi_success) then
ierr(1) = iret
info=psb_err_mpi_error_ info=psb_err_mpi_error_
call psb_errpush(info,name,i_err=ierr) call psb_errpush(info,name,m_err=(/iret/))
goto 9999 goto 9999
end if end if
else if (proc_to_comm == me) then else if (proc_to_comm == me) then
@ -599,7 +594,6 @@ subroutine psi_dswaptranv(flag,beta,y,desc_a,work,info,data)
! locals ! locals
integer(psb_ipk_) :: ictxt, np, me, icomm, idxs, idxr, totxch, err_act, data_ integer(psb_ipk_) :: ictxt, np, me, icomm, idxs, idxr, totxch, err_act, data_
integer(psb_ipk_), pointer :: d_idx(:) integer(psb_ipk_), pointer :: d_idx(:)
integer(psb_ipk_) :: ierr(5)
character(len=20) :: name character(len=20) :: name
info=psb_success_ info=psb_success_
@ -684,7 +678,6 @@ subroutine psi_dtranidxv(iictxt,iicomm,flag,beta,y,idx,&
integer(psb_ipk_) :: nesd, nerv,& integer(psb_ipk_) :: nesd, nerv,&
& err_act, i, idx_pt, totsnd_, totrcv_,& & err_act, i, idx_pt, totsnd_, totrcv_,&
& snd_pt, rcv_pt, pnti, n & snd_pt, rcv_pt, pnti, n
integer(psb_ipk_) :: ierr(5)
logical :: swap_mpi, swap_sync, swap_send, swap_recv,& logical :: swap_mpi, swap_sync, swap_send, swap_recv,&
& albf,do_send,do_recv & albf,do_send,do_recv
logical, parameter :: usersend=.false. logical, parameter :: usersend=.false.
@ -810,9 +803,8 @@ subroutine psi_dtranidxv(iictxt,iicomm,flag,beta,y,idx,&
& psb_mpi_r_dpk_,& & psb_mpi_r_dpk_,&
& sndbuf,sdsz,bsdidx,psb_mpi_r_dpk_,icomm,iret) & sndbuf,sdsz,bsdidx,psb_mpi_r_dpk_,icomm,iret)
if(iret /= mpi_success) then if(iret /= mpi_success) then
ierr(1) = iret
info=psb_err_mpi_error_ info=psb_err_mpi_error_
call psb_errpush(info,name,i_err=ierr) call psb_errpush(info,name,m_err=(/iret/))
goto 9999 goto 9999
end if end if
@ -897,9 +889,8 @@ subroutine psi_dtranidxv(iictxt,iicomm,flag,beta,y,idx,&
end if end if
if(iret /= mpi_success) then if(iret /= mpi_success) then
ierr(1) = iret
info=psb_err_mpi_error_ info=psb_err_mpi_error_
call psb_errpush(info,name,i_err=ierr) call psb_errpush(info,name,m_err=(/iret/))
goto 9999 goto 9999
end if end if
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 if ((proc_to_comm /= me).and.(nesd>0)) then
call mpi_wait(rvhd(i),p2pstat,iret) call mpi_wait(rvhd(i),p2pstat,iret)
if(iret /= mpi_success) then if(iret /= mpi_success) then
ierr(1) = iret
info=psb_err_mpi_error_ info=psb_err_mpi_error_
call psb_errpush(info,name,i_err=ierr) call psb_errpush(info,name,m_err=(/iret/))
goto 9999 goto 9999
end if end if
else if (proc_to_comm == me) then else if (proc_to_comm == me) then

20
base/comm/internals/psi_eswapdata_a.F90
Unescape Escape View File

@ -180,7 +180,6 @@ subroutine psi_eswapidxm(iictxt,iicomm,flag,n,beta,y,idx, &
integer(psb_ipk_) :: nesd, nerv,& integer(psb_ipk_) :: nesd, nerv,&
& err_act, i, idx_pt, totsnd_, totrcv_,& & err_act, i, idx_pt, totsnd_, totrcv_,&
& snd_pt, rcv_pt, pnti & snd_pt, rcv_pt, pnti
integer(psb_ipk_) :: ierr(5)
logical :: swap_mpi, swap_sync, swap_send, swap_recv,& logical :: swap_mpi, swap_sync, swap_send, swap_recv,&
& albf,do_send,do_recv & albf,do_send,do_recv
logical, parameter :: usersend=.false. logical, parameter :: usersend=.false.
@ -300,9 +299,8 @@ subroutine psi_eswapidxm(iictxt,iicomm,flag,n,beta,y,idx, &
& psb_mpi_epk_,rcvbuf,rvsz,& & psb_mpi_epk_,rcvbuf,rvsz,&
& brvidx,psb_mpi_epk_,icomm,iret) & brvidx,psb_mpi_epk_,icomm,iret)
if(iret /= mpi_success) then if(iret /= mpi_success) then
ierr(1) = iret
info=psb_err_mpi_error_ info=psb_err_mpi_error_
call psb_errpush(info,name,i_err=ierr) call psb_errpush(info,name,m_err=(/iret/))
goto 9999 goto 9999
end if end if
@ -388,9 +386,8 @@ subroutine psi_eswapidxm(iictxt,iicomm,flag,n,beta,y,idx, &
end if end if
if(iret /= mpi_success) then if(iret /= mpi_success) then
ierr(1) = iret
info=psb_err_mpi_error_ info=psb_err_mpi_error_
call psb_errpush(info,name,i_err=ierr) call psb_errpush(info,name,m_err=(/iret/))
goto 9999 goto 9999
end if end if
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 if ((proc_to_comm /= me).and.(nerv>0)) then
call mpi_wait(rvhd(i),p2pstat,iret) call mpi_wait(rvhd(i),p2pstat,iret)
if(iret /= mpi_success) then if(iret /= mpi_success) then
ierr(1) = iret
info=psb_err_mpi_error_ info=psb_err_mpi_error_
call psb_errpush(info,name,i_err=ierr) call psb_errpush(info,name,m_err=(/iret/))
goto 9999 goto 9999
end if end if
else if (proc_to_comm == me) then 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,& integer(psb_ipk_) :: nesd, nerv,&
& err_act, i, idx_pt, totsnd_, totrcv_,& & err_act, i, idx_pt, totsnd_, totrcv_,&
& snd_pt, rcv_pt, pnti, n & snd_pt, rcv_pt, pnti, n
integer(psb_ipk_) :: ierr(5)
logical :: swap_mpi, swap_sync, swap_send, swap_recv,& logical :: swap_mpi, swap_sync, swap_send, swap_recv,&
& albf,do_send,do_recv & albf,do_send,do_recv
logical, parameter :: usersend=.false. logical, parameter :: usersend=.false.
@ -790,9 +785,8 @@ subroutine psi_eswapidxv(iictxt,iicomm,flag,beta,y,idx, &
& psb_mpi_epk_,rcvbuf,rvsz,& & psb_mpi_epk_,rcvbuf,rvsz,&
& brvidx,psb_mpi_epk_,icomm,iret) & brvidx,psb_mpi_epk_,icomm,iret)
if(iret /= mpi_success) then if(iret /= mpi_success) then
ierr(1) = iret
info=psb_err_mpi_error_ info=psb_err_mpi_error_
call psb_errpush(info,name,i_err=ierr) call psb_errpush(info,name,m_err=(/iret/))
goto 9999 goto 9999
end if end if
@ -879,9 +873,8 @@ subroutine psi_eswapidxv(iictxt,iicomm,flag,beta,y,idx, &
end if end if
if(iret /= mpi_success) then if(iret /= mpi_success) then
ierr(1) = iret
info=psb_err_mpi_error_ info=psb_err_mpi_error_
call psb_errpush(info,name,i_err=ierr) call psb_errpush(info,name,m_err=(/iret/))
goto 9999 goto 9999
end if end if
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 if ((proc_to_comm /= me).and.(nerv>0)) then
call mpi_wait(rvhd(i),p2pstat,iret) call mpi_wait(rvhd(i),p2pstat,iret)
if(iret /= mpi_success) then if(iret /= mpi_success) then
ierr(1) = iret
info=psb_err_mpi_error_ info=psb_err_mpi_error_
call psb_errpush(info,name,i_err=ierr) call psb_errpush(info,name,m_err=(/iret/))
goto 9999 goto 9999
end if end if
else if (proc_to_comm == me) then else if (proc_to_comm == me) then

22
base/comm/internals/psi_eswaptran_a.F90
Unescape Escape View File

@ -111,7 +111,6 @@ subroutine psi_eswaptranm(flag,n,beta,y,desc_a,work,info,data)
! locals ! locals
integer(psb_ipk_) :: ictxt, np, me, icomm, idxs, idxr, err_act, totxch, data_ integer(psb_ipk_) :: ictxt, np, me, icomm, idxs, idxr, err_act, totxch, data_
integer(psb_ipk_), pointer :: d_idx(:) integer(psb_ipk_), pointer :: d_idx(:)
integer(psb_ipk_) :: ierr(5)
character(len=20) :: name character(len=20) :: name
info=psb_success_ info=psb_success_
@ -186,7 +185,6 @@ subroutine psi_etranidxm(iictxt,iicomm,flag,n,beta,y,idx,&
integer(psb_ipk_) :: nesd, nerv,& integer(psb_ipk_) :: nesd, nerv,&
& err_act, i, idx_pt, totsnd_, totrcv_,& & err_act, i, idx_pt, totsnd_, totrcv_,&
& snd_pt, rcv_pt, pnti & snd_pt, rcv_pt, pnti
integer(psb_ipk_) :: ierr(5)
logical :: swap_mpi, swap_sync, swap_send, swap_recv,& logical :: swap_mpi, swap_sync, swap_send, swap_recv,&
& albf,do_send,do_recv & albf,do_send,do_recv
logical, parameter :: usersend=.false. logical, parameter :: usersend=.false.
@ -311,9 +309,8 @@ subroutine psi_etranidxm(iictxt,iicomm,flag,n,beta,y,idx,&
& psb_mpi_epk_,& & psb_mpi_epk_,&
& sndbuf,sdsz,bsdidx,psb_mpi_epk_,icomm,iret) & sndbuf,sdsz,bsdidx,psb_mpi_epk_,icomm,iret)
if(iret /= mpi_success) then if(iret /= mpi_success) then
ierr(1) = iret
info=psb_err_mpi_error_ info=psb_err_mpi_error_
call psb_errpush(info,name,i_err=ierr) call psb_errpush(info,name,m_err=(/iret/))
goto 9999 goto 9999
end if end if
@ -399,9 +396,8 @@ subroutine psi_etranidxm(iictxt,iicomm,flag,n,beta,y,idx,&
end if end if
if(iret /= mpi_success) then if(iret /= mpi_success) then
ierr(1) = iret
info=psb_err_mpi_error_ info=psb_err_mpi_error_
call psb_errpush(info,name,i_err=ierr) call psb_errpush(info,name,m_err=(/iret/))
goto 9999 goto 9999
end if end if
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 if ((proc_to_comm /= me).and.(nesd>0)) then
call mpi_wait(rvhd(i),p2pstat,iret) call mpi_wait(rvhd(i),p2pstat,iret)
if(iret /= mpi_success) then if(iret /= mpi_success) then
ierr(1) = iret
info=psb_err_mpi_error_ info=psb_err_mpi_error_
call psb_errpush(info,name,i_err=ierr) call psb_errpush(info,name,m_err=(/iret/))
goto 9999 goto 9999
end if end if
else if (proc_to_comm == me) then else if (proc_to_comm == me) then
@ -599,7 +594,6 @@ subroutine psi_eswaptranv(flag,beta,y,desc_a,work,info,data)
! locals ! locals
integer(psb_ipk_) :: ictxt, np, me, icomm, idxs, idxr, totxch, err_act, data_ integer(psb_ipk_) :: ictxt, np, me, icomm, idxs, idxr, totxch, err_act, data_
integer(psb_ipk_), pointer :: d_idx(:) integer(psb_ipk_), pointer :: d_idx(:)
integer(psb_ipk_) :: ierr(5)
character(len=20) :: name character(len=20) :: name
info=psb_success_ info=psb_success_
@ -684,7 +678,6 @@ subroutine psi_etranidxv(iictxt,iicomm,flag,beta,y,idx,&
integer(psb_ipk_) :: nesd, nerv,& integer(psb_ipk_) :: nesd, nerv,&
& err_act, i, idx_pt, totsnd_, totrcv_,& & err_act, i, idx_pt, totsnd_, totrcv_,&
& snd_pt, rcv_pt, pnti, n & snd_pt, rcv_pt, pnti, n
integer(psb_ipk_) :: ierr(5)
logical :: swap_mpi, swap_sync, swap_send, swap_recv,& logical :: swap_mpi, swap_sync, swap_send, swap_recv,&
& albf,do_send,do_recv & albf,do_send,do_recv
logical, parameter :: usersend=.false. logical, parameter :: usersend=.false.
@ -810,9 +803,8 @@ subroutine psi_etranidxv(iictxt,iicomm,flag,beta,y,idx,&
& psb_mpi_epk_,& & psb_mpi_epk_,&
& sndbuf,sdsz,bsdidx,psb_mpi_epk_,icomm,iret) & sndbuf,sdsz,bsdidx,psb_mpi_epk_,icomm,iret)
if(iret /= mpi_success) then if(iret /= mpi_success) then
ierr(1) = iret
info=psb_err_mpi_error_ info=psb_err_mpi_error_
call psb_errpush(info,name,i_err=ierr) call psb_errpush(info,name,m_err=(/iret/))
goto 9999 goto 9999
end if end if
@ -897,9 +889,8 @@ subroutine psi_etranidxv(iictxt,iicomm,flag,beta,y,idx,&
end if end if
if(iret /= mpi_success) then if(iret /= mpi_success) then
ierr(1) = iret
info=psb_err_mpi_error_ info=psb_err_mpi_error_
call psb_errpush(info,name,i_err=ierr) call psb_errpush(info,name,m_err=(/iret/))
goto 9999 goto 9999
end if end if
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 if ((proc_to_comm /= me).and.(nesd>0)) then
call mpi_wait(rvhd(i),p2pstat,iret) call mpi_wait(rvhd(i),p2pstat,iret)
if(iret /= mpi_success) then if(iret /= mpi_success) then
ierr(1) = iret
info=psb_err_mpi_error_ info=psb_err_mpi_error_
call psb_errpush(info,name,i_err=ierr) call psb_errpush(info,name,m_err=(/iret/))
goto 9999 goto 9999
end if end if
else if (proc_to_comm == me) then else if (proc_to_comm == me) then

32
base/comm/internals/psi_iswapdata.F90
Unescape Escape View File

@ -208,7 +208,6 @@ subroutine psi_iswap_vidx_vect(iictxt,iicomm,flag,beta,y,idx, &
integer(psb_ipk_) :: nesd, nerv,& integer(psb_ipk_) :: nesd, nerv,&
& err_act, i, idx_pt, totsnd_, totrcv_,& & err_act, i, idx_pt, totsnd_, totrcv_,&
& snd_pt, rcv_pt, pnti, n & snd_pt, rcv_pt, pnti, n
integer(psb_ipk_) :: ierr(5)
logical :: swap_mpi, swap_sync, swap_send, swap_recv,& logical :: swap_mpi, swap_sync, swap_send, swap_recv,&
& albf,do_send,do_recv & albf,do_send,do_recv
logical, parameter :: usersend=.false., debug=.false. 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.... ! Unfinished communication? Something is wrong....
! !
info=psb_err_mpi_error_ info=psb_err_mpi_error_
ierr(1) = -2 call psb_errpush(info,name,m_err=(/-2/))
call psb_errpush(info,name,i_err=ierr)
goto 9999 goto 9999
end if end if
end if end if
@ -318,9 +316,8 @@ subroutine psi_iswap_vidx_vect(iictxt,iicomm,flag,beta,y,idx, &
end if end if
if(iret /= mpi_success) then if(iret /= mpi_success) then
ierr(1) = iret
info=psb_err_mpi_error_ info=psb_err_mpi_error_
call psb_errpush(info,name,i_err=ierr) call psb_errpush(info,name,m_err=(/iret/))
goto 9999 goto 9999
end if end if
@ -335,8 +332,7 @@ subroutine psi_iswap_vidx_vect(iictxt,iicomm,flag,beta,y,idx, &
! No matching send? Something is wrong.... ! No matching send? Something is wrong....
! !
info=psb_err_mpi_error_ info=psb_err_mpi_error_
ierr(1) = -2 call psb_errpush(info,name,m_err=(/-2/))
call psb_errpush(info,name,i_err=ierr)
goto 9999 goto 9999
end if end if
call psb_realloc(totxch,prcid,info) 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 if (nesd>0) then
call mpi_wait(y%comid(i,1),p2pstat,iret) call mpi_wait(y%comid(i,1),p2pstat,iret)
if(iret /= mpi_success) then if(iret /= mpi_success) then
ierr(1) = iret
info=psb_err_mpi_error_ info=psb_err_mpi_error_
call psb_errpush(info,name,i_err=ierr) call psb_errpush(info,name,m_err=(/iret/))
goto 9999 goto 9999
end if end if
end if end if
if (nerv>0) then if (nerv>0) then
call mpi_wait(y%comid(i,2),p2pstat,iret) call mpi_wait(y%comid(i,2),p2pstat,iret)
if(iret /= mpi_success) then if(iret /= mpi_success) then
ierr(1) = iret
info=psb_err_mpi_error_ info=psb_err_mpi_error_
call psb_errpush(info,name,i_err=ierr) call psb_errpush(info,name,m_err=(/iret/))
goto 9999 goto 9999
end if end if
end if end if
@ -551,7 +545,6 @@ subroutine psi_iswap_vidx_multivect(iictxt,iicomm,flag,beta,y,idx, &
integer(psb_ipk_) :: nesd, nerv,& integer(psb_ipk_) :: nesd, nerv,&
& err_act, i, idx_pt, totsnd_, totrcv_,& & err_act, i, idx_pt, totsnd_, totrcv_,&
& snd_pt, rcv_pt, pnti, n & snd_pt, rcv_pt, pnti, n
integer(psb_ipk_) :: ierr(5)
logical :: swap_mpi, swap_sync, swap_send, swap_recv,& logical :: swap_mpi, swap_sync, swap_send, swap_recv,&
& albf,do_send,do_recv & albf,do_send,do_recv
logical, parameter :: usersend=.false., debug=.false. 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.... ! Unfinished communication? Something is wrong....
! !
info=psb_err_mpi_error_ info=psb_err_mpi_error_
ierr(1) = -2 call psb_errpush(info,name,m_err=(/-2/))
call psb_errpush(info,name,i_err=ierr)
goto 9999 goto 9999
end if end if
end if end if
@ -665,9 +657,8 @@ subroutine psi_iswap_vidx_multivect(iictxt,iicomm,flag,beta,y,idx, &
end if end if
if(iret /= mpi_success) then if(iret /= mpi_success) then
ierr(1) = iret
info=psb_err_mpi_error_ info=psb_err_mpi_error_
call psb_errpush(info,name,i_err=ierr) call psb_errpush(info,name,m_err=(/iret/))
goto 9999 goto 9999
end if end if
rcv_pt = rcv_pt + n*nerv 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.... ! No matching send? Something is wrong....
! !
info=psb_err_mpi_error_ info=psb_err_mpi_error_
ierr(1) = -2 call psb_errpush(info,name,m_err=(/-2/))
call psb_errpush(info,name,i_err=ierr)
goto 9999 goto 9999
end if end if
call psb_realloc(totxch,prcid,info) 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 if (nesd>0) then
call mpi_wait(y%comid(i,1),p2pstat,iret) call mpi_wait(y%comid(i,1),p2pstat,iret)
if(iret /= mpi_success) then if(iret /= mpi_success) then
ierr(1) = iret
info=psb_err_mpi_error_ info=psb_err_mpi_error_
call psb_errpush(info,name,i_err=ierr) call psb_errpush(info,name,m_err=(/iret/))
goto 9999 goto 9999
end if end if
end if end if
if (nerv>0) then if (nerv>0) then
call mpi_wait(y%comid(i,2),p2pstat,iret) call mpi_wait(y%comid(i,2),p2pstat,iret)
if(iret /= mpi_success) then if(iret /= mpi_success) then
ierr(1) = iret
info=psb_err_mpi_error_ info=psb_err_mpi_error_
call psb_errpush(info,name,i_err=ierr) call psb_errpush(info,name,m_err=(/iret/))
goto 9999 goto 9999
end if end if
end if end if

34
base/comm/internals/psi_iswaptran.F90
Unescape Escape View File

@ -120,7 +120,6 @@ subroutine psi_iswaptran_vect(flag,beta,y,desc_a,work,info,data)
! locals ! locals
integer(psb_ipk_) :: ictxt, np, me, icomm, idxs, idxr, totxch, err_act, data_ integer(psb_ipk_) :: ictxt, np, me, icomm, idxs, idxr, totxch, err_act, data_
class(psb_i_base_vect_type), pointer :: d_vidx class(psb_i_base_vect_type), pointer :: d_vidx
integer(psb_ipk_) :: ierr(5)
character(len=20) :: name character(len=20) :: name
info=psb_success_ info=psb_success_
@ -212,7 +211,6 @@ subroutine psi_itran_vidx_vect(iictxt,iicomm,flag,beta,y,idx,&
integer(psb_ipk_) :: nesd, nerv,& integer(psb_ipk_) :: nesd, nerv,&
& err_act, i, idx_pt, totsnd_, totrcv_,& & err_act, i, idx_pt, totsnd_, totrcv_,&
& snd_pt, rcv_pt, pnti, n & snd_pt, rcv_pt, pnti, n
integer(psb_ipk_) :: ierr(5)
logical :: swap_mpi, swap_sync, swap_send, swap_recv,& logical :: swap_mpi, swap_sync, swap_send, swap_recv,&
& albf,do_send,do_recv & albf,do_send,do_recv
logical, parameter :: usersend=.false., debug=.false. 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.... ! Unfinished communication? Something is wrong....
! !
info=psb_err_mpi_error_ info=psb_err_mpi_error_
ierr(1) = -2 call psb_errpush(info,name,m_err=(/-2/))
call psb_errpush(info,name,i_err=ierr)
goto 9999 goto 9999
end if end if
end if end if
@ -328,9 +325,8 @@ subroutine psi_itran_vidx_vect(iictxt,iicomm,flag,beta,y,idx,&
end if end if
if(iret /= mpi_success) then if(iret /= mpi_success) then
ierr(1) = iret
info=psb_err_mpi_error_ info=psb_err_mpi_error_
call psb_errpush(info,name,i_err=ierr) call psb_errpush(info,name,m_err=(/iret/))
goto 9999 goto 9999
end if end if
@ -345,8 +341,7 @@ subroutine psi_itran_vidx_vect(iictxt,iicomm,flag,beta,y,idx,&
! No matching send? Something is wrong.... ! No matching send? Something is wrong....
! !
info=psb_err_mpi_error_ info=psb_err_mpi_error_
ierr(1) = -2 call psb_errpush(info,name,m_err=(/-2/))
call psb_errpush(info,name,i_err=ierr)
goto 9999 goto 9999
end if end if
call psb_realloc(totxch,prcid,info) 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 if (nerv>0) then
call mpi_wait(y%comid(i,1),p2pstat,iret) call mpi_wait(y%comid(i,1),p2pstat,iret)
if(iret /= mpi_success) then if(iret /= mpi_success) then
ierr(1) = iret
info=psb_err_mpi_error_ info=psb_err_mpi_error_
call psb_errpush(info,name,i_err=ierr) call psb_errpush(info,name,m_err=(/iret/))
goto 9999 goto 9999
end if end if
end if end if
if (nesd>0) then if (nesd>0) then
call mpi_wait(y%comid(i,2),p2pstat,iret) call mpi_wait(y%comid(i,2),p2pstat,iret)
if(iret /= mpi_success) then if(iret /= mpi_success) then
ierr(1) = iret
info=psb_err_mpi_error_ info=psb_err_mpi_error_
call psb_errpush(info,name,i_err=ierr) call psb_errpush(info,name,m_err=(/iret/))
goto 9999 goto 9999
end if end if
end if end if
@ -475,7 +468,6 @@ subroutine psi_iswaptran_multivect(flag,beta,y,desc_a,work,info,data)
! locals ! locals
integer(psb_ipk_) :: ictxt, np, me, icomm, idxs, idxr, totxch, err_act, data_ integer(psb_ipk_) :: ictxt, np, me, icomm, idxs, idxr, totxch, err_act, data_
class(psb_i_base_vect_type), pointer :: d_vidx class(psb_i_base_vect_type), pointer :: d_vidx
integer(psb_ipk_) :: ierr(5)
character(len=20) :: name character(len=20) :: name
info=psb_success_ info=psb_success_
@ -566,7 +558,6 @@ subroutine psi_itran_vidx_multivect(iictxt,iicomm,flag,beta,y,idx,&
integer(psb_ipk_) :: nesd, nerv,& integer(psb_ipk_) :: nesd, nerv,&
& err_act, i, idx_pt, totsnd_, totrcv_,& & err_act, i, idx_pt, totsnd_, totrcv_,&
& snd_pt, rcv_pt, pnti, n & snd_pt, rcv_pt, pnti, n
integer(psb_ipk_) :: ierr(5)
logical :: swap_mpi, swap_sync, swap_send, swap_recv,& logical :: swap_mpi, swap_sync, swap_send, swap_recv,&
& albf,do_send,do_recv & albf,do_send,do_recv
logical, parameter :: usersend=.false., debug=.false. 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.... ! Unfinished communication? Something is wrong....
! !
info=psb_err_mpi_error_ info=psb_err_mpi_error_
ierr(1) = -2 call psb_errpush(info,name,m_err=(/-2/))
call psb_errpush(info,name,i_err=ierr)
goto 9999 goto 9999
end if end if
end if end if
@ -682,9 +672,8 @@ subroutine psi_itran_vidx_multivect(iictxt,iicomm,flag,beta,y,idx,&
end if end if
if(iret /= mpi_success) then if(iret /= mpi_success) then
ierr(1) = iret
info=psb_err_mpi_error_ info=psb_err_mpi_error_
call psb_errpush(info,name,i_err=ierr) call psb_errpush(info,name,m_err=(/iret/))
goto 9999 goto 9999
end if end if
rcv_pt = rcv_pt + n*nerv 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.... ! No matching send? Something is wrong....
! !
info=psb_err_mpi_error_ info=psb_err_mpi_error_
ierr(1) = -2 call psb_errpush(info,name,m_err=(/-2/))
call psb_errpush(info,name,i_err=ierr)
goto 9999 goto 9999
end if end if
call psb_realloc(totxch,prcid,info) 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 if (nerv>0) then
call mpi_wait(y%comid(i,1),p2pstat,iret) call mpi_wait(y%comid(i,1),p2pstat,iret)
if(iret /= mpi_success) then if(iret /= mpi_success) then
ierr(1) = iret
info=psb_err_mpi_error_ info=psb_err_mpi_error_
call psb_errpush(info,name,i_err=ierr) call psb_errpush(info,name,m_err=(/iret/))
goto 9999 goto 9999
end if end if
end if end if
if (nesd>0) then if (nesd>0) then
call mpi_wait(y%comid(i,2),p2pstat,iret) call mpi_wait(y%comid(i,2),p2pstat,iret)
if(iret /= mpi_success) then if(iret /= mpi_success) then
ierr(1) = iret
info=psb_err_mpi_error_ info=psb_err_mpi_error_
call psb_errpush(info,name,i_err=ierr) call psb_errpush(info,name,m_err=(/iret/))
goto 9999 goto 9999
end if end if
end if end if

32
base/comm/internals/psi_lswapdata.F90
Unescape Escape View File

@ -208,7 +208,6 @@ subroutine psi_lswap_vidx_vect(iictxt,iicomm,flag,beta,y,idx, &
integer(psb_ipk_) :: nesd, nerv,& integer(psb_ipk_) :: nesd, nerv,&
& err_act, i, idx_pt, totsnd_, totrcv_,& & err_act, i, idx_pt, totsnd_, totrcv_,&
& snd_pt, rcv_pt, pnti, n & snd_pt, rcv_pt, pnti, n
integer(psb_ipk_) :: ierr(5)
logical :: swap_mpi, swap_sync, swap_send, swap_recv,& logical :: swap_mpi, swap_sync, swap_send, swap_recv,&
& albf,do_send,do_recv & albf,do_send,do_recv
logical, parameter :: usersend=.false., debug=.false. 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.... ! Unfinished communication? Something is wrong....
! !
info=psb_err_mpi_error_ info=psb_err_mpi_error_
ierr(1) = -2 call psb_errpush(info,name,m_err=(/-2/))
call psb_errpush(info,name,i_err=ierr)
goto 9999 goto 9999
end if end if
end if end if
@ -318,9 +316,8 @@ subroutine psi_lswap_vidx_vect(iictxt,iicomm,flag,beta,y,idx, &
end if end if
if(iret /= mpi_success) then if(iret /= mpi_success) then
ierr(1) = iret
info=psb_err_mpi_error_ info=psb_err_mpi_error_
call psb_errpush(info,name,i_err=ierr) call psb_errpush(info,name,m_err=(/iret/))
goto 9999 goto 9999
end if end if
@ -335,8 +332,7 @@ subroutine psi_lswap_vidx_vect(iictxt,iicomm,flag,beta,y,idx, &
! No matching send? Something is wrong.... ! No matching send? Something is wrong....
! !
info=psb_err_mpi_error_ info=psb_err_mpi_error_
ierr(1) = -2 call psb_errpush(info,name,m_err=(/-2/))
call psb_errpush(info,name,i_err=ierr)
goto 9999 goto 9999
end if end if
call psb_realloc(totxch,prcid,info) 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 if (nesd>0) then
call mpi_wait(y%comid(i,1),p2pstat,iret) call mpi_wait(y%comid(i,1),p2pstat,iret)
if(iret /= mpi_success) then if(iret /= mpi_success) then
ierr(1) = iret
info=psb_err_mpi_error_ info=psb_err_mpi_error_
call psb_errpush(info,name,i_err=ierr) call psb_errpush(info,name,m_err=(/iret/))
goto 9999 goto 9999
end if end if
end if end if
if (nerv>0) then if (nerv>0) then
call mpi_wait(y%comid(i,2),p2pstat,iret) call mpi_wait(y%comid(i,2),p2pstat,iret)
if(iret /= mpi_success) then if(iret /= mpi_success) then
ierr(1) = iret
info=psb_err_mpi_error_ info=psb_err_mpi_error_
call psb_errpush(info,name,i_err=ierr) call psb_errpush(info,name,m_err=(/iret/))
goto 9999 goto 9999
end if end if
end if end if
@ -551,7 +545,6 @@ subroutine psi_lswap_vidx_multivect(iictxt,iicomm,flag,beta,y,idx, &
integer(psb_ipk_) :: nesd, nerv,& integer(psb_ipk_) :: nesd, nerv,&
& err_act, i, idx_pt, totsnd_, totrcv_,& & err_act, i, idx_pt, totsnd_, totrcv_,&
& snd_pt, rcv_pt, pnti, n & snd_pt, rcv_pt, pnti, n
integer(psb_ipk_) :: ierr(5)
logical :: swap_mpi, swap_sync, swap_send, swap_recv,& logical :: swap_mpi, swap_sync, swap_send, swap_recv,&
& albf,do_send,do_recv & albf,do_send,do_recv
logical, parameter :: usersend=.false., debug=.false. 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.... ! Unfinished communication? Something is wrong....
! !
info=psb_err_mpi_error_ info=psb_err_mpi_error_
ierr(1) = -2 call psb_errpush(info,name,m_err=(/-2/))
call psb_errpush(info,name,i_err=ierr)
goto 9999 goto 9999
end if end if
end if end if
@ -665,9 +657,8 @@ subroutine psi_lswap_vidx_multivect(iictxt,iicomm,flag,beta,y,idx, &
end if end if
if(iret /= mpi_success) then if(iret /= mpi_success) then
ierr(1) = iret
info=psb_err_mpi_error_ info=psb_err_mpi_error_
call psb_errpush(info,name,i_err=ierr) call psb_errpush(info,name,m_err=(/iret/))
goto 9999 goto 9999
end if end if
rcv_pt = rcv_pt + n*nerv 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.... ! No matching send? Something is wrong....
! !
info=psb_err_mpi_error_ info=psb_err_mpi_error_
ierr(1) = -2 call psb_errpush(info,name,m_err=(/-2/))
call psb_errpush(info,name,i_err=ierr)
goto 9999 goto 9999
end if end if
call psb_realloc(totxch,prcid,info) 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 if (nesd>0) then
call mpi_wait(y%comid(i,1),p2pstat,iret) call mpi_wait(y%comid(i,1),p2pstat,iret)
if(iret /= mpi_success) then if(iret /= mpi_success) then
ierr(1) = iret
info=psb_err_mpi_error_ info=psb_err_mpi_error_
call psb_errpush(info,name,i_err=ierr) call psb_errpush(info,name,m_err=(/iret/))
goto 9999 goto 9999
end if end if
end if end if
if (nerv>0) then if (nerv>0) then
call mpi_wait(y%comid(i,2),p2pstat,iret) call mpi_wait(y%comid(i,2),p2pstat,iret)
if(iret /= mpi_success) then if(iret /= mpi_success) then
ierr(1) = iret
info=psb_err_mpi_error_ info=psb_err_mpi_error_
call psb_errpush(info,name,i_err=ierr) call psb_errpush(info,name,m_err=(/iret/))
goto 9999 goto 9999
end if end if
end if end if

34
base/comm/internals/psi_lswaptran.F90
Unescape Escape View File

@ -120,7 +120,6 @@ subroutine psi_lswaptran_vect(flag,beta,y,desc_a,work,info,data)
! locals ! locals
integer(psb_ipk_) :: ictxt, np, me, icomm, idxs, idxr, totxch, err_act, data_ integer(psb_ipk_) :: ictxt, np, me, icomm, idxs, idxr, totxch, err_act, data_
class(psb_i_base_vect_type), pointer :: d_vidx class(psb_i_base_vect_type), pointer :: d_vidx
integer(psb_ipk_) :: ierr(5)
character(len=20) :: name character(len=20) :: name
info=psb_success_ info=psb_success_
@ -212,7 +211,6 @@ subroutine psi_ltran_vidx_vect(iictxt,iicomm,flag,beta,y,idx,&
integer(psb_ipk_) :: nesd, nerv,& integer(psb_ipk_) :: nesd, nerv,&
& err_act, i, idx_pt, totsnd_, totrcv_,& & err_act, i, idx_pt, totsnd_, totrcv_,&
& snd_pt, rcv_pt, pnti, n & snd_pt, rcv_pt, pnti, n
integer(psb_ipk_) :: ierr(5)
logical :: swap_mpi, swap_sync, swap_send, swap_recv,& logical :: swap_mpi, swap_sync, swap_send, swap_recv,&
& albf,do_send,do_recv & albf,do_send,do_recv
logical, parameter :: usersend=.false., debug=.false. 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.... ! Unfinished communication? Something is wrong....
! !
info=psb_err_mpi_error_ info=psb_err_mpi_error_
ierr(1) = -2 call psb_errpush(info,name,m_err=(/-2/))
call psb_errpush(info,name,i_err=ierr)
goto 9999 goto 9999
end if end if
end if end if
@ -328,9 +325,8 @@ subroutine psi_ltran_vidx_vect(iictxt,iicomm,flag,beta,y,idx,&
end if end if
if(iret /= mpi_success) then if(iret /= mpi_success) then
ierr(1) = iret
info=psb_err_mpi_error_ info=psb_err_mpi_error_
call psb_errpush(info,name,i_err=ierr) call psb_errpush(info,name,m_err=(/iret/))
goto 9999 goto 9999
end if end if
@ -345,8 +341,7 @@ subroutine psi_ltran_vidx_vect(iictxt,iicomm,flag,beta,y,idx,&
! No matching send? Something is wrong.... ! No matching send? Something is wrong....
! !
info=psb_err_mpi_error_ info=psb_err_mpi_error_
ierr(1) = -2 call psb_errpush(info,name,m_err=(/-2/))
call psb_errpush(info,name,i_err=ierr)
goto 9999 goto 9999
end if end if
call psb_realloc(totxch,prcid,info) 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 if (nerv>0) then
call mpi_wait(y%comid(i,1),p2pstat,iret) call mpi_wait(y%comid(i,1),p2pstat,iret)
if(iret /= mpi_success) then if(iret /= mpi_success) then
ierr(1) = iret
info=psb_err_mpi_error_ info=psb_err_mpi_error_
call psb_errpush(info,name,i_err=ierr) call psb_errpush(info,name,m_err=(/iret/))
goto 9999 goto 9999
end if end if
end if end if
if (nesd>0) then if (nesd>0) then
call mpi_wait(y%comid(i,2),p2pstat,iret) call mpi_wait(y%comid(i,2),p2pstat,iret)
if(iret /= mpi_success) then if(iret /= mpi_success) then
ierr(1) = iret
info=psb_err_mpi_error_ info=psb_err_mpi_error_
call psb_errpush(info,name,i_err=ierr) call psb_errpush(info,name,m_err=(/iret/))
goto 9999 goto 9999
end if end if
end if end if
@ -475,7 +468,6 @@ subroutine psi_lswaptran_multivect(flag,beta,y,desc_a,work,info,data)
! locals ! locals
integer(psb_ipk_) :: ictxt, np, me, icomm, idxs, idxr, totxch, err_act, data_ integer(psb_ipk_) :: ictxt, np, me, icomm, idxs, idxr, totxch, err_act, data_
class(psb_i_base_vect_type), pointer :: d_vidx class(psb_i_base_vect_type), pointer :: d_vidx
integer(psb_ipk_) :: ierr(5)
character(len=20) :: name character(len=20) :: name
info=psb_success_ info=psb_success_
@ -566,7 +558,6 @@ subroutine psi_ltran_vidx_multivect(iictxt,iicomm,flag,beta,y,idx,&
integer(psb_ipk_) :: nesd, nerv,& integer(psb_ipk_) :: nesd, nerv,&
& err_act, i, idx_pt, totsnd_, totrcv_,& & err_act, i, idx_pt, totsnd_, totrcv_,&
& snd_pt, rcv_pt, pnti, n & snd_pt, rcv_pt, pnti, n
integer(psb_ipk_) :: ierr(5)
logical :: swap_mpi, swap_sync, swap_send, swap_recv,& logical :: swap_mpi, swap_sync, swap_send, swap_recv,&
& albf,do_send,do_recv & albf,do_send,do_recv
logical, parameter :: usersend=.false., debug=.false. 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.... ! Unfinished communication? Something is wrong....
! !
info=psb_err_mpi_error_ info=psb_err_mpi_error_
ierr(1) = -2 call psb_errpush(info,name,m_err=(/-2/))
call psb_errpush(info,name,i_err=ierr)
goto 9999 goto 9999
end if end if
end if end if
@ -682,9 +672,8 @@ subroutine psi_ltran_vidx_multivect(iictxt,iicomm,flag,beta,y,idx,&
end if end if
if(iret /= mpi_success) then if(iret /= mpi_success) then
ierr(1) = iret
info=psb_err_mpi_error_ info=psb_err_mpi_error_
call psb_errpush(info,name,i_err=ierr) call psb_errpush(info,name,m_err=(/iret/))
goto 9999 goto 9999
end if end if
rcv_pt = rcv_pt + n*nerv 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.... ! No matching send? Something is wrong....
! !
info=psb_err_mpi_error_ info=psb_err_mpi_error_
ierr(1) = -2 call psb_errpush(info,name,m_err=(/-2/))
call psb_errpush(info,name,i_err=ierr)
goto 9999 goto 9999
end if end if
call psb_realloc(totxch,prcid,info) 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 if (nerv>0) then
call mpi_wait(y%comid(i,1),p2pstat,iret) call mpi_wait(y%comid(i,1),p2pstat,iret)
if(iret /= mpi_success) then if(iret /= mpi_success) then
ierr(1) = iret
info=psb_err_mpi_error_ info=psb_err_mpi_error_
call psb_errpush(info,name,i_err=ierr) call psb_errpush(info,name,m_err=(/iret/))
goto 9999 goto 9999
end if end if
end if end if
if (nesd>0) then if (nesd>0) then
call mpi_wait(y%comid(i,2),p2pstat,iret) call mpi_wait(y%comid(i,2),p2pstat,iret)
if(iret /= mpi_success) then if(iret /= mpi_success) then
ierr(1) = iret
info=psb_err_mpi_error_ info=psb_err_mpi_error_
call psb_errpush(info,name,i_err=ierr) call psb_errpush(info,name,m_err=(/iret/))
goto 9999 goto 9999
end if end if
end if end if

20
base/comm/internals/psi_mswapdata_a.F90
Unescape Escape View File

@ -180,7 +180,6 @@ subroutine psi_mswapidxm(iictxt,iicomm,flag,n,beta,y,idx, &
integer(psb_ipk_) :: nesd, nerv,& integer(psb_ipk_) :: nesd, nerv,&
& err_act, i, idx_pt, totsnd_, totrcv_,& & err_act, i, idx_pt, totsnd_, totrcv_,&
& snd_pt, rcv_pt, pnti & snd_pt, rcv_pt, pnti
integer(psb_ipk_) :: ierr(5)
logical :: swap_mpi, swap_sync, swap_send, swap_recv,& logical :: swap_mpi, swap_sync, swap_send, swap_recv,&
& albf,do_send,do_recv & albf,do_send,do_recv
logical, parameter :: usersend=.false. logical, parameter :: usersend=.false.
@ -300,9 +299,8 @@ subroutine psi_mswapidxm(iictxt,iicomm,flag,n,beta,y,idx, &
& psb_mpi_mpk_,rcvbuf,rvsz,& & psb_mpi_mpk_,rcvbuf,rvsz,&
& brvidx,psb_mpi_mpk_,icomm,iret) & brvidx,psb_mpi_mpk_,icomm,iret)
if(iret /= mpi_success) then if(iret /= mpi_success) then
ierr(1) = iret
info=psb_err_mpi_error_ info=psb_err_mpi_error_
call psb_errpush(info,name,i_err=ierr) call psb_errpush(info,name,m_err=(/iret/))
goto 9999 goto 9999
end if end if
@ -388,9 +386,8 @@ subroutine psi_mswapidxm(iictxt,iicomm,flag,n,beta,y,idx, &
end if end if
if(iret /= mpi_success) then if(iret /= mpi_success) then
ierr(1) = iret
info=psb_err_mpi_error_ info=psb_err_mpi_error_
call psb_errpush(info,name,i_err=ierr) call psb_errpush(info,name,m_err=(/iret/))
goto 9999 goto 9999
end if end if
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 if ((proc_to_comm /= me).and.(nerv>0)) then
call mpi_wait(rvhd(i),p2pstat,iret) call mpi_wait(rvhd(i),p2pstat,iret)
if(iret /= mpi_success) then if(iret /= mpi_success) then
ierr(1) = iret
info=psb_err_mpi_error_ info=psb_err_mpi_error_
call psb_errpush(info,name,i_err=ierr) call psb_errpush(info,name,m_err=(/iret/))
goto 9999 goto 9999
end if end if
else if (proc_to_comm == me) then 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,& integer(psb_ipk_) :: nesd, nerv,&
& err_act, i, idx_pt, totsnd_, totrcv_,& & err_act, i, idx_pt, totsnd_, totrcv_,&
& snd_pt, rcv_pt, pnti, n & snd_pt, rcv_pt, pnti, n
integer(psb_ipk_) :: ierr(5)
logical :: swap_mpi, swap_sync, swap_send, swap_recv,& logical :: swap_mpi, swap_sync, swap_send, swap_recv,&
& albf,do_send,do_recv & albf,do_send,do_recv
logical, parameter :: usersend=.false. logical, parameter :: usersend=.false.
@ -790,9 +785,8 @@ subroutine psi_mswapidxv(iictxt,iicomm,flag,beta,y,idx, &
& psb_mpi_mpk_,rcvbuf,rvsz,& & psb_mpi_mpk_,rcvbuf,rvsz,&
& brvidx,psb_mpi_mpk_,icomm,iret) & brvidx,psb_mpi_mpk_,icomm,iret)
if(iret /= mpi_success) then if(iret /= mpi_success) then
ierr(1) = iret
info=psb_err_mpi_error_ info=psb_err_mpi_error_
call psb_errpush(info,name,i_err=ierr) call psb_errpush(info,name,m_err=(/iret/))
goto 9999 goto 9999
end if end if
@ -879,9 +873,8 @@ subroutine psi_mswapidxv(iictxt,iicomm,flag,beta,y,idx, &
end if end if
if(iret /= mpi_success) then if(iret /= mpi_success) then
ierr(1) = iret
info=psb_err_mpi_error_ info=psb_err_mpi_error_
call psb_errpush(info,name,i_err=ierr) call psb_errpush(info,name,m_err=(/iret/))
goto 9999 goto 9999
end if end if
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 if ((proc_to_comm /= me).and.(nerv>0)) then
call mpi_wait(rvhd(i),p2pstat,iret) call mpi_wait(rvhd(i),p2pstat,iret)
if(iret /= mpi_success) then if(iret /= mpi_success) then
ierr(1) = iret
info=psb_err_mpi_error_ info=psb_err_mpi_error_
call psb_errpush(info,name,i_err=ierr) call psb_errpush(info,name,m_err=(/iret/))
goto 9999 goto 9999
end if end if
else if (proc_to_comm == me) then else if (proc_to_comm == me) then

22
base/comm/internals/psi_mswaptran_a.F90
Unescape Escape View File

@ -111,7 +111,6 @@ subroutine psi_mswaptranm(flag,n,beta,y,desc_a,work,info,data)
! locals ! locals
integer(psb_ipk_) :: ictxt, np, me, icomm, idxs, idxr, err_act, totxch, data_ integer(psb_ipk_) :: ictxt, np, me, icomm, idxs, idxr, err_act, totxch, data_
integer(psb_ipk_), pointer :: d_idx(:) integer(psb_ipk_), pointer :: d_idx(:)
integer(psb_ipk_) :: ierr(5)
character(len=20) :: name character(len=20) :: name
info=psb_success_ info=psb_success_
@ -186,7 +185,6 @@ subroutine psi_mtranidxm(iictxt,iicomm,flag,n,beta,y,idx,&
integer(psb_ipk_) :: nesd, nerv,& integer(psb_ipk_) :: nesd, nerv,&
& err_act, i, idx_pt, totsnd_, totrcv_,& & err_act, i, idx_pt, totsnd_, totrcv_,&
& snd_pt, rcv_pt, pnti & snd_pt, rcv_pt, pnti
integer(psb_ipk_) :: ierr(5)
logical :: swap_mpi, swap_sync, swap_send, swap_recv,& logical :: swap_mpi, swap_sync, swap_send, swap_recv,&
& albf,do_send,do_recv & albf,do_send,do_recv
logical, parameter :: usersend=.false. logical, parameter :: usersend=.false.
@ -311,9 +309,8 @@ subroutine psi_mtranidxm(iictxt,iicomm,flag,n,beta,y,idx,&
& psb_mpi_mpk_,& & psb_mpi_mpk_,&
& sndbuf,sdsz,bsdidx,psb_mpi_mpk_,icomm,iret) & sndbuf,sdsz,bsdidx,psb_mpi_mpk_,icomm,iret)
if(iret /= mpi_success) then if(iret /= mpi_success) then
ierr(1) = iret
info=psb_err_mpi_error_ info=psb_err_mpi_error_
call psb_errpush(info,name,i_err=ierr) call psb_errpush(info,name,m_err=(/iret/))
goto 9999 goto 9999
end if end if
@ -399,9 +396,8 @@ subroutine psi_mtranidxm(iictxt,iicomm,flag,n,beta,y,idx,&
end if end if
if(iret /= mpi_success) then if(iret /= mpi_success) then
ierr(1) = iret
info=psb_err_mpi_error_ info=psb_err_mpi_error_
call psb_errpush(info,name,i_err=ierr) call psb_errpush(info,name,m_err=(/iret/))
goto 9999 goto 9999
end if end if
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 if ((proc_to_comm /= me).and.(nesd>0)) then
call mpi_wait(rvhd(i),p2pstat,iret) call mpi_wait(rvhd(i),p2pstat,iret)
if(iret /= mpi_success) then if(iret /= mpi_success) then
ierr(1) = iret
info=psb_err_mpi_error_ info=psb_err_mpi_error_
call psb_errpush(info,name,i_err=ierr) call psb_errpush(info,name,m_err=(/iret/))
goto 9999 goto 9999
end if end if
else if (proc_to_comm == me) then else if (proc_to_comm == me) then
@ -599,7 +594,6 @@ subroutine psi_mswaptranv(flag,beta,y,desc_a,work,info,data)
! locals ! locals
integer(psb_ipk_) :: ictxt, np, me, icomm, idxs, idxr, totxch, err_act, data_ integer(psb_ipk_) :: ictxt, np, me, icomm, idxs, idxr, totxch, err_act, data_
integer(psb_ipk_), pointer :: d_idx(:) integer(psb_ipk_), pointer :: d_idx(:)
integer(psb_ipk_) :: ierr(5)
character(len=20) :: name character(len=20) :: name
info=psb_success_ info=psb_success_
@ -684,7 +678,6 @@ subroutine psi_mtranidxv(iictxt,iicomm,flag,beta,y,idx,&
integer(psb_ipk_) :: nesd, nerv,& integer(psb_ipk_) :: nesd, nerv,&
& err_act, i, idx_pt, totsnd_, totrcv_,& & err_act, i, idx_pt, totsnd_, totrcv_,&
& snd_pt, rcv_pt, pnti, n & snd_pt, rcv_pt, pnti, n
integer(psb_ipk_) :: ierr(5)
logical :: swap_mpi, swap_sync, swap_send, swap_recv,& logical :: swap_mpi, swap_sync, swap_send, swap_recv,&
& albf,do_send,do_recv & albf,do_send,do_recv
logical, parameter :: usersend=.false. logical, parameter :: usersend=.false.
@ -810,9 +803,8 @@ subroutine psi_mtranidxv(iictxt,iicomm,flag,beta,y,idx,&
& psb_mpi_mpk_,& & psb_mpi_mpk_,&
& sndbuf,sdsz,bsdidx,psb_mpi_mpk_,icomm,iret) & sndbuf,sdsz,bsdidx,psb_mpi_mpk_,icomm,iret)
if(iret /= mpi_success) then if(iret /= mpi_success) then
ierr(1) = iret
info=psb_err_mpi_error_ info=psb_err_mpi_error_
call psb_errpush(info,name,i_err=ierr) call psb_errpush(info,name,m_err=(/iret/))
goto 9999 goto 9999
end if end if
@ -897,9 +889,8 @@ subroutine psi_mtranidxv(iictxt,iicomm,flag,beta,y,idx,&
end if end if
if(iret /= mpi_success) then if(iret /= mpi_success) then
ierr(1) = iret
info=psb_err_mpi_error_ info=psb_err_mpi_error_
call psb_errpush(info,name,i_err=ierr) call psb_errpush(info,name,m_err=(/iret/))
goto 9999 goto 9999
end if end if
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 if ((proc_to_comm /= me).and.(nesd>0)) then
call mpi_wait(rvhd(i),p2pstat,iret) call mpi_wait(rvhd(i),p2pstat,iret)
if(iret /= mpi_success) then if(iret /= mpi_success) then
ierr(1) = iret
info=psb_err_mpi_error_ info=psb_err_mpi_error_
call psb_errpush(info,name,i_err=ierr) call psb_errpush(info,name,m_err=(/iret/))
goto 9999 goto 9999
end if end if
else if (proc_to_comm == me) then else if (proc_to_comm == me) then

32
base/comm/internals/psi_sswapdata.F90
Unescape Escape View File

@ -208,7 +208,6 @@ subroutine psi_sswap_vidx_vect(iictxt,iicomm,flag,beta,y,idx, &
integer(psb_ipk_) :: nesd, nerv,& integer(psb_ipk_) :: nesd, nerv,&
& err_act, i, idx_pt, totsnd_, totrcv_,& & err_act, i, idx_pt, totsnd_, totrcv_,&
& snd_pt, rcv_pt, pnti, n & snd_pt, rcv_pt, pnti, n
integer(psb_ipk_) :: ierr(5)
logical :: swap_mpi, swap_sync, swap_send, swap_recv,& logical :: swap_mpi, swap_sync, swap_send, swap_recv,&
& albf,do_send,do_recv & albf,do_send,do_recv
logical, parameter :: usersend=.false., debug=.false. 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.... ! Unfinished communication? Something is wrong....
! !
info=psb_err_mpi_error_ info=psb_err_mpi_error_
ierr(1) = -2 call psb_errpush(info,name,m_err=(/-2/))
call psb_errpush(info,name,i_err=ierr)
goto 9999 goto 9999
end if end if
end if end if
@ -318,9 +316,8 @@ subroutine psi_sswap_vidx_vect(iictxt,iicomm,flag,beta,y,idx, &
end if end if
if(iret /= mpi_success) then if(iret /= mpi_success) then
ierr(1) = iret
info=psb_err_mpi_error_ info=psb_err_mpi_error_
call psb_errpush(info,name,i_err=ierr) call psb_errpush(info,name,m_err=(/iret/))
goto 9999 goto 9999
end if end if
@ -335,8 +332,7 @@ subroutine psi_sswap_vidx_vect(iictxt,iicomm,flag,beta,y,idx, &
! No matching send? Something is wrong.... ! No matching send? Something is wrong....
! !
info=psb_err_mpi_error_ info=psb_err_mpi_error_
ierr(1) = -2 call psb_errpush(info,name,m_err=(/-2/))
call psb_errpush(info,name,i_err=ierr)
goto 9999 goto 9999
end if end if
call psb_realloc(totxch,prcid,info) 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 if (nesd>0) then
call mpi_wait(y%comid(i,1),p2pstat,iret) call mpi_wait(y%comid(i,1),p2pstat,iret)
if(iret /= mpi_success) then if(iret /= mpi_success) then
ierr(1) = iret
info=psb_err_mpi_error_ info=psb_err_mpi_error_
call psb_errpush(info,name,i_err=ierr) call psb_errpush(info,name,m_err=(/iret/))
goto 9999 goto 9999
end if end if
end if end if
if (nerv>0) then if (nerv>0) then
call mpi_wait(y%comid(i,2),p2pstat,iret) call mpi_wait(y%comid(i,2),p2pstat,iret)
if(iret /= mpi_success) then if(iret /= mpi_success) then
ierr(1) = iret
info=psb_err_mpi_error_ info=psb_err_mpi_error_
call psb_errpush(info,name,i_err=ierr) call psb_errpush(info,name,m_err=(/iret/))
goto 9999 goto 9999
end if end if
end if end if
@ -551,7 +545,6 @@ subroutine psi_sswap_vidx_multivect(iictxt,iicomm,flag,beta,y,idx, &
integer(psb_ipk_) :: nesd, nerv,& integer(psb_ipk_) :: nesd, nerv,&
& err_act, i, idx_pt, totsnd_, totrcv_,& & err_act, i, idx_pt, totsnd_, totrcv_,&
& snd_pt, rcv_pt, pnti, n & snd_pt, rcv_pt, pnti, n
integer(psb_ipk_) :: ierr(5)
logical :: swap_mpi, swap_sync, swap_send, swap_recv,& logical :: swap_mpi, swap_sync, swap_send, swap_recv,&
& albf,do_send,do_recv & albf,do_send,do_recv
logical, parameter :: usersend=.false., debug=.false. 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.... ! Unfinished communication? Something is wrong....
! !
info=psb_err_mpi_error_ info=psb_err_mpi_error_
ierr(1) = -2 call psb_errpush(info,name,m_err=(/-2/))
call psb_errpush(info,name,i_err=ierr)
goto 9999 goto 9999
end if end if
end if end if
@ -665,9 +657,8 @@ subroutine psi_sswap_vidx_multivect(iictxt,iicomm,flag,beta,y,idx, &
end if end if
if(iret /= mpi_success) then if(iret /= mpi_success) then
ierr(1) = iret
info=psb_err_mpi_error_ info=psb_err_mpi_error_
call psb_errpush(info,name,i_err=ierr) call psb_errpush(info,name,m_err=(/iret/))
goto 9999 goto 9999
end if end if
rcv_pt = rcv_pt + n*nerv 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.... ! No matching send? Something is wrong....
! !
info=psb_err_mpi_error_ info=psb_err_mpi_error_
ierr(1) = -2 call psb_errpush(info,name,m_err=(/-2/))
call psb_errpush(info,name,i_err=ierr)
goto 9999 goto 9999
end if end if
call psb_realloc(totxch,prcid,info) 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 if (nesd>0) then
call mpi_wait(y%comid(i,1),p2pstat,iret) call mpi_wait(y%comid(i,1),p2pstat,iret)
if(iret /= mpi_success) then if(iret /= mpi_success) then
ierr(1) = iret
info=psb_err_mpi_error_ info=psb_err_mpi_error_
call psb_errpush(info,name,i_err=ierr) call psb_errpush(info,name,m_err=(/iret/))
goto 9999 goto 9999
end if end if
end if end if
if (nerv>0) then if (nerv>0) then
call mpi_wait(y%comid(i,2),p2pstat,iret) call mpi_wait(y%comid(i,2),p2pstat,iret)
if(iret /= mpi_success) then if(iret /= mpi_success) then
ierr(1) = iret
info=psb_err_mpi_error_ info=psb_err_mpi_error_
call psb_errpush(info,name,i_err=ierr) call psb_errpush(info,name,m_err=(/iret/))
goto 9999 goto 9999
end if end if
end if end if

20
base/comm/internals/psi_sswapdata_a.F90
Unescape Escape View File

@ -180,7 +180,6 @@ subroutine psi_sswapidxm(iictxt,iicomm,flag,n,beta,y,idx, &
integer(psb_ipk_) :: nesd, nerv,& integer(psb_ipk_) :: nesd, nerv,&
& err_act, i, idx_pt, totsnd_, totrcv_,& & err_act, i, idx_pt, totsnd_, totrcv_,&
& snd_pt, rcv_pt, pnti & snd_pt, rcv_pt, pnti
integer(psb_ipk_) :: ierr(5)
logical :: swap_mpi, swap_sync, swap_send, swap_recv,& logical :: swap_mpi, swap_sync, swap_send, swap_recv,&
& albf,do_send,do_recv & albf,do_send,do_recv
logical, parameter :: usersend=.false. logical, parameter :: usersend=.false.
@ -300,9 +299,8 @@ subroutine psi_sswapidxm(iictxt,iicomm,flag,n,beta,y,idx, &
& psb_mpi_r_spk_,rcvbuf,rvsz,& & psb_mpi_r_spk_,rcvbuf,rvsz,&
& brvidx,psb_mpi_r_spk_,icomm,iret) & brvidx,psb_mpi_r_spk_,icomm,iret)
if(iret /= mpi_success) then if(iret /= mpi_success) then
ierr(1) = iret
info=psb_err_mpi_error_ info=psb_err_mpi_error_
call psb_errpush(info,name,i_err=ierr) call psb_errpush(info,name,m_err=(/iret/))
goto 9999 goto 9999
end if end if
@ -388,9 +386,8 @@ subroutine psi_sswapidxm(iictxt,iicomm,flag,n,beta,y,idx, &
end if end if
if(iret /= mpi_success) then if(iret /= mpi_success) then
ierr(1) = iret
info=psb_err_mpi_error_ info=psb_err_mpi_error_
call psb_errpush(info,name,i_err=ierr) call psb_errpush(info,name,m_err=(/iret/))
goto 9999 goto 9999
end if end if
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 if ((proc_to_comm /= me).and.(nerv>0)) then
call mpi_wait(rvhd(i),p2pstat,iret) call mpi_wait(rvhd(i),p2pstat,iret)
if(iret /= mpi_success) then if(iret /= mpi_success) then
ierr(1) = iret
info=psb_err_mpi_error_ info=psb_err_mpi_error_
call psb_errpush(info,name,i_err=ierr) call psb_errpush(info,name,m_err=(/iret/))
goto 9999 goto 9999
end if end if
else if (proc_to_comm == me) then 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,& integer(psb_ipk_) :: nesd, nerv,&
& err_act, i, idx_pt, totsnd_, totrcv_,& & err_act, i, idx_pt, totsnd_, totrcv_,&
& snd_pt, rcv_pt, pnti, n & snd_pt, rcv_pt, pnti, n
integer(psb_ipk_) :: ierr(5)
logical :: swap_mpi, swap_sync, swap_send, swap_recv,& logical :: swap_mpi, swap_sync, swap_send, swap_recv,&
& albf,do_send,do_recv & albf,do_send,do_recv
logical, parameter :: usersend=.false. logical, parameter :: usersend=.false.
@ -790,9 +785,8 @@ subroutine psi_sswapidxv(iictxt,iicomm,flag,beta,y,idx, &
& psb_mpi_r_spk_,rcvbuf,rvsz,& & psb_mpi_r_spk_,rcvbuf,rvsz,&
& brvidx,psb_mpi_r_spk_,icomm,iret) & brvidx,psb_mpi_r_spk_,icomm,iret)
if(iret /= mpi_success) then if(iret /= mpi_success) then
ierr(1) = iret
info=psb_err_mpi_error_ info=psb_err_mpi_error_
call psb_errpush(info,name,i_err=ierr) call psb_errpush(info,name,m_err=(/iret/))
goto 9999 goto 9999
end if end if
@ -879,9 +873,8 @@ subroutine psi_sswapidxv(iictxt,iicomm,flag,beta,y,idx, &
end if end if
if(iret /= mpi_success) then if(iret /= mpi_success) then
ierr(1) = iret
info=psb_err_mpi_error_ info=psb_err_mpi_error_
call psb_errpush(info,name,i_err=ierr) call psb_errpush(info,name,m_err=(/iret/))
goto 9999 goto 9999
end if end if
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 if ((proc_to_comm /= me).and.(nerv>0)) then
call mpi_wait(rvhd(i),p2pstat,iret) call mpi_wait(rvhd(i),p2pstat,iret)
if(iret /= mpi_success) then if(iret /= mpi_success) then
ierr(1) = iret
info=psb_err_mpi_error_ info=psb_err_mpi_error_
call psb_errpush(info,name,i_err=ierr) call psb_errpush(info,name,m_err=(/iret/))
goto 9999 goto 9999
end if end if
else if (proc_to_comm == me) then else if (proc_to_comm == me) then

34
base/comm/internals/psi_sswaptran.F90
Unescape Escape View File

@ -120,7 +120,6 @@ subroutine psi_sswaptran_vect(flag,beta,y,desc_a,work,info,data)
! locals ! locals
integer(psb_ipk_) :: ictxt, np, me, icomm, idxs, idxr, totxch, err_act, data_ integer(psb_ipk_) :: ictxt, np, me, icomm, idxs, idxr, totxch, err_act, data_
class(psb_i_base_vect_type), pointer :: d_vidx class(psb_i_base_vect_type), pointer :: d_vidx
integer(psb_ipk_) :: ierr(5)
character(len=20) :: name character(len=20) :: name
info=psb_success_ info=psb_success_
@ -212,7 +211,6 @@ subroutine psi_stran_vidx_vect(iictxt,iicomm,flag,beta,y,idx,&
integer(psb_ipk_) :: nesd, nerv,& integer(psb_ipk_) :: nesd, nerv,&
& err_act, i, idx_pt, totsnd_, totrcv_,& & err_act, i, idx_pt, totsnd_, totrcv_,&
& snd_pt, rcv_pt, pnti, n & snd_pt, rcv_pt, pnti, n
integer(psb_ipk_) :: ierr(5)
logical :: swap_mpi, swap_sync, swap_send, swap_recv,& logical :: swap_mpi, swap_sync, swap_send, swap_recv,&
& albf,do_send,do_recv & albf,do_send,do_recv
logical, parameter :: usersend=.false., debug=.false. 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.... ! Unfinished communication? Something is wrong....
! !
info=psb_err_mpi_error_ info=psb_err_mpi_error_
ierr(1) = -2 call psb_errpush(info,name,m_err=(/-2/))
call psb_errpush(info,name,i_err=ierr)
goto 9999 goto 9999
end if end if
end if end if
@ -328,9 +325,8 @@ subroutine psi_stran_vidx_vect(iictxt,iicomm,flag,beta,y,idx,&
end if end if
if(iret /= mpi_success) then if(iret /= mpi_success) then
ierr(1) = iret
info=psb_err_mpi_error_ info=psb_err_mpi_error_
call psb_errpush(info,name,i_err=ierr) call psb_errpush(info,name,m_err=(/iret/))
goto 9999 goto 9999
end if end if
@ -345,8 +341,7 @@ subroutine psi_stran_vidx_vect(iictxt,iicomm,flag,beta,y,idx,&
! No matching send? Something is wrong.... ! No matching send? Something is wrong....
! !
info=psb_err_mpi_error_ info=psb_err_mpi_error_
ierr(1) = -2 call psb_errpush(info,name,m_err=(/-2/))
call psb_errpush(info,name,i_err=ierr)
goto 9999 goto 9999
end if end if
call psb_realloc(totxch,prcid,info) 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 if (nerv>0) then
call mpi_wait(y%comid(i,1),p2pstat,iret) call mpi_wait(y%comid(i,1),p2pstat,iret)
if(iret /= mpi_success) then if(iret /= mpi_success) then
ierr(1) = iret
info=psb_err_mpi_error_ info=psb_err_mpi_error_
call psb_errpush(info,name,i_err=ierr) call psb_errpush(info,name,m_err=(/iret/))
goto 9999 goto 9999
end if end if
end if end if
if (nesd>0) then if (nesd>0) then
call mpi_wait(y%comid(i,2),p2pstat,iret) call mpi_wait(y%comid(i,2),p2pstat,iret)
if(iret /= mpi_success) then if(iret /= mpi_success) then
ierr(1) = iret
info=psb_err_mpi_error_ info=psb_err_mpi_error_
call psb_errpush(info,name,i_err=ierr) call psb_errpush(info,name,m_err=(/iret/))
goto 9999 goto 9999
end if end if
end if end if
@ -475,7 +468,6 @@ subroutine psi_sswaptran_multivect(flag,beta,y,desc_a,work,info,data)
! locals ! locals
integer(psb_ipk_) :: ictxt, np, me, icomm, idxs, idxr, totxch, err_act, data_ integer(psb_ipk_) :: ictxt, np, me, icomm, idxs, idxr, totxch, err_act, data_
class(psb_i_base_vect_type), pointer :: d_vidx class(psb_i_base_vect_type), pointer :: d_vidx
integer(psb_ipk_) :: ierr(5)
character(len=20) :: name character(len=20) :: name
info=psb_success_ info=psb_success_
@ -566,7 +558,6 @@ subroutine psi_stran_vidx_multivect(iictxt,iicomm,flag,beta,y,idx,&
integer(psb_ipk_) :: nesd, nerv,& integer(psb_ipk_) :: nesd, nerv,&
& err_act, i, idx_pt, totsnd_, totrcv_,& & err_act, i, idx_pt, totsnd_, totrcv_,&
& snd_pt, rcv_pt, pnti, n & snd_pt, rcv_pt, pnti, n
integer(psb_ipk_) :: ierr(5)
logical :: swap_mpi, swap_sync, swap_send, swap_recv,& logical :: swap_mpi, swap_sync, swap_send, swap_recv,&
& albf,do_send,do_recv & albf,do_send,do_recv
logical, parameter :: usersend=.false., debug=.false. 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.... ! Unfinished communication? Something is wrong....
! !
info=psb_err_mpi_error_ info=psb_err_mpi_error_
ierr(1) = -2 call psb_errpush(info,name,m_err=(/-2/))
call psb_errpush(info,name,i_err=ierr)
goto 9999 goto 9999
end if end if
end if end if
@ -682,9 +672,8 @@ subroutine psi_stran_vidx_multivect(iictxt,iicomm,flag,beta,y,idx,&
end if end if
if(iret /= mpi_success) then if(iret /= mpi_success) then
ierr(1) = iret
info=psb_err_mpi_error_ info=psb_err_mpi_error_
call psb_errpush(info,name,i_err=ierr) call psb_errpush(info,name,m_err=(/iret/))
goto 9999 goto 9999
end if end if
rcv_pt = rcv_pt + n*nerv 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.... ! No matching send? Something is wrong....
! !
info=psb_err_mpi_error_ info=psb_err_mpi_error_
ierr(1) = -2 call psb_errpush(info,name,m_err=(/-2/))
call psb_errpush(info,name,i_err=ierr)
goto 9999 goto 9999
end if end if
call psb_realloc(totxch,prcid,info) 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 if (nerv>0) then
call mpi_wait(y%comid(i,1),p2pstat,iret) call mpi_wait(y%comid(i,1),p2pstat,iret)
if(iret /= mpi_success) then if(iret /= mpi_success) then
ierr(1) = iret
info=psb_err_mpi_error_ info=psb_err_mpi_error_
call psb_errpush(info,name,i_err=ierr) call psb_errpush(info,name,m_err=(/iret/))
goto 9999 goto 9999
end if end if
end if end if
if (nesd>0) then if (nesd>0) then
call mpi_wait(y%comid(i,2),p2pstat,iret) call mpi_wait(y%comid(i,2),p2pstat,iret)
if(iret /= mpi_success) then if(iret /= mpi_success) then
ierr(1) = iret
info=psb_err_mpi_error_ info=psb_err_mpi_error_
call psb_errpush(info,name,i_err=ierr) call psb_errpush(info,name,m_err=(/iret/))
goto 9999 goto 9999
end if end if
end if end if

22
base/comm/internals/psi_sswaptran_a.F90
Unescape Escape View File

@ -111,7 +111,6 @@ subroutine psi_sswaptranm(flag,n,beta,y,desc_a,work,info,data)
! locals ! locals
integer(psb_ipk_) :: ictxt, np, me, icomm, idxs, idxr, err_act, totxch, data_ integer(psb_ipk_) :: ictxt, np, me, icomm, idxs, idxr, err_act, totxch, data_
integer(psb_ipk_), pointer :: d_idx(:) integer(psb_ipk_), pointer :: d_idx(:)
integer(psb_ipk_) :: ierr(5)
character(len=20) :: name character(len=20) :: name
info=psb_success_ info=psb_success_
@ -186,7 +185,6 @@ subroutine psi_stranidxm(iictxt,iicomm,flag,n,beta,y,idx,&
integer(psb_ipk_) :: nesd, nerv,& integer(psb_ipk_) :: nesd, nerv,&
& err_act, i, idx_pt, totsnd_, totrcv_,& & err_act, i, idx_pt, totsnd_, totrcv_,&
& snd_pt, rcv_pt, pnti & snd_pt, rcv_pt, pnti
integer(psb_ipk_) :: ierr(5)
logical :: swap_mpi, swap_sync, swap_send, swap_recv,& logical :: swap_mpi, swap_sync, swap_send, swap_recv,&
& albf,do_send,do_recv & albf,do_send,do_recv
logical, parameter :: usersend=.false. logical, parameter :: usersend=.false.
@ -311,9 +309,8 @@ subroutine psi_stranidxm(iictxt,iicomm,flag,n,beta,y,idx,&
& psb_mpi_r_spk_,& & psb_mpi_r_spk_,&
& sndbuf,sdsz,bsdidx,psb_mpi_r_spk_,icomm,iret) & sndbuf,sdsz,bsdidx,psb_mpi_r_spk_,icomm,iret)
if(iret /= mpi_success) then if(iret /= mpi_success) then
ierr(1) = iret
info=psb_err_mpi_error_ info=psb_err_mpi_error_
call psb_errpush(info,name,i_err=ierr) call psb_errpush(info,name,m_err=(/iret/))
goto 9999 goto 9999
end if end if
@ -399,9 +396,8 @@ subroutine psi_stranidxm(iictxt,iicomm,flag,n,beta,y,idx,&
end if end if
if(iret /= mpi_success) then if(iret /= mpi_success) then
ierr(1) = iret
info=psb_err_mpi_error_ info=psb_err_mpi_error_
call psb_errpush(info,name,i_err=ierr) call psb_errpush(info,name,m_err=(/iret/))
goto 9999 goto 9999
end if end if
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 if ((proc_to_comm /= me).and.(nesd>0)) then
call mpi_wait(rvhd(i),p2pstat,iret) call mpi_wait(rvhd(i),p2pstat,iret)
if(iret /= mpi_success) then if(iret /= mpi_success) then
ierr(1) = iret
info=psb_err_mpi_error_ info=psb_err_mpi_error_
call psb_errpush(info,name,i_err=ierr) call psb_errpush(info,name,m_err=(/iret/))
goto 9999 goto 9999
end if end if
else if (proc_to_comm == me) then else if (proc_to_comm == me) then
@ -599,7 +594,6 @@ subroutine psi_sswaptranv(flag,beta,y,desc_a,work,info,data)
! locals ! locals
integer(psb_ipk_) :: ictxt, np, me, icomm, idxs, idxr, totxch, err_act, data_ integer(psb_ipk_) :: ictxt, np, me, icomm, idxs, idxr, totxch, err_act, data_
integer(psb_ipk_), pointer :: d_idx(:) integer(psb_ipk_), pointer :: d_idx(:)
integer(psb_ipk_) :: ierr(5)
character(len=20) :: name character(len=20) :: name
info=psb_success_ info=psb_success_
@ -684,7 +678,6 @@ subroutine psi_stranidxv(iictxt,iicomm,flag,beta,y,idx,&
integer(psb_ipk_) :: nesd, nerv,& integer(psb_ipk_) :: nesd, nerv,&
& err_act, i, idx_pt, totsnd_, totrcv_,& & err_act, i, idx_pt, totsnd_, totrcv_,&
& snd_pt, rcv_pt, pnti, n & snd_pt, rcv_pt, pnti, n
integer(psb_ipk_) :: ierr(5)
logical :: swap_mpi, swap_sync, swap_send, swap_recv,& logical :: swap_mpi, swap_sync, swap_send, swap_recv,&
& albf,do_send,do_recv & albf,do_send,do_recv
logical, parameter :: usersend=.false. logical, parameter :: usersend=.false.
@ -810,9 +803,8 @@ subroutine psi_stranidxv(iictxt,iicomm,flag,beta,y,idx,&
& psb_mpi_r_spk_,& & psb_mpi_r_spk_,&
& sndbuf,sdsz,bsdidx,psb_mpi_r_spk_,icomm,iret) & sndbuf,sdsz,bsdidx,psb_mpi_r_spk_,icomm,iret)
if(iret /= mpi_success) then if(iret /= mpi_success) then
ierr(1) = iret
info=psb_err_mpi_error_ info=psb_err_mpi_error_
call psb_errpush(info,name,i_err=ierr) call psb_errpush(info,name,m_err=(/iret/))
goto 9999 goto 9999
end if end if
@ -897,9 +889,8 @@ subroutine psi_stranidxv(iictxt,iicomm,flag,beta,y,idx,&
end if end if
if(iret /= mpi_success) then if(iret /= mpi_success) then
ierr(1) = iret
info=psb_err_mpi_error_ info=psb_err_mpi_error_
call psb_errpush(info,name,i_err=ierr) call psb_errpush(info,name,m_err=(/iret/))
goto 9999 goto 9999
end if end if
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 if ((proc_to_comm /= me).and.(nesd>0)) then
call mpi_wait(rvhd(i),p2pstat,iret) call mpi_wait(rvhd(i),p2pstat,iret)
if(iret /= mpi_success) then if(iret /= mpi_success) then
ierr(1) = iret
info=psb_err_mpi_error_ info=psb_err_mpi_error_
call psb_errpush(info,name,i_err=ierr) call psb_errpush(info,name,m_err=(/iret/))
goto 9999 goto 9999
end if end if
else if (proc_to_comm == me) then else if (proc_to_comm == me) then

32
base/comm/internals/psi_zswapdata.F90
Unescape Escape View File

@ -208,7 +208,6 @@ subroutine psi_zswap_vidx_vect(iictxt,iicomm,flag,beta,y,idx, &
integer(psb_ipk_) :: nesd, nerv,& integer(psb_ipk_) :: nesd, nerv,&
& err_act, i, idx_pt, totsnd_, totrcv_,& & err_act, i, idx_pt, totsnd_, totrcv_,&
& snd_pt, rcv_pt, pnti, n & snd_pt, rcv_pt, pnti, n
integer(psb_ipk_) :: ierr(5)
logical :: swap_mpi, swap_sync, swap_send, swap_recv,& logical :: swap_mpi, swap_sync, swap_send, swap_recv,&
& albf,do_send,do_recv & albf,do_send,do_recv
logical, parameter :: usersend=.false., debug=.false. 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.... ! Unfinished communication? Something is wrong....
! !
info=psb_err_mpi_error_ info=psb_err_mpi_error_
ierr(1) = -2 call psb_errpush(info,name,m_err=(/-2/))
call psb_errpush(info,name,i_err=ierr)
goto 9999 goto 9999
end if end if
end if end if
@ -318,9 +316,8 @@ subroutine psi_zswap_vidx_vect(iictxt,iicomm,flag,beta,y,idx, &
end if end if
if(iret /= mpi_success) then if(iret /= mpi_success) then
ierr(1) = iret
info=psb_err_mpi_error_ info=psb_err_mpi_error_
call psb_errpush(info,name,i_err=ierr) call psb_errpush(info,name,m_err=(/iret/))
goto 9999 goto 9999
end if end if
@ -335,8 +332,7 @@ subroutine psi_zswap_vidx_vect(iictxt,iicomm,flag,beta,y,idx, &
! No matching send? Something is wrong.... ! No matching send? Something is wrong....
! !
info=psb_err_mpi_error_ info=psb_err_mpi_error_
ierr(1) = -2 call psb_errpush(info,name,m_err=(/-2/))
call psb_errpush(info,name,i_err=ierr)
goto 9999 goto 9999
end if end if
call psb_realloc(totxch,prcid,info) 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 if (nesd>0) then
call mpi_wait(y%comid(i,1),p2pstat,iret) call mpi_wait(y%comid(i,1),p2pstat,iret)
if(iret /= mpi_success) then if(iret /= mpi_success) then
ierr(1) = iret
info=psb_err_mpi_error_ info=psb_err_mpi_error_
call psb_errpush(info,name,i_err=ierr) call psb_errpush(info,name,m_err=(/iret/))
goto 9999 goto 9999
end if end if
end if end if
if (nerv>0) then if (nerv>0) then
call mpi_wait(y%comid(i,2),p2pstat,iret) call mpi_wait(y%comid(i,2),p2pstat,iret)
if(iret /= mpi_success) then if(iret /= mpi_success) then
ierr(1) = iret
info=psb_err_mpi_error_ info=psb_err_mpi_error_
call psb_errpush(info,name,i_err=ierr) call psb_errpush(info,name,m_err=(/iret/))
goto 9999 goto 9999
end if end if
end if end if
@ -551,7 +545,6 @@ subroutine psi_zswap_vidx_multivect(iictxt,iicomm,flag,beta,y,idx, &
integer(psb_ipk_) :: nesd, nerv,& integer(psb_ipk_) :: nesd, nerv,&
& err_act, i, idx_pt, totsnd_, totrcv_,& & err_act, i, idx_pt, totsnd_, totrcv_,&
& snd_pt, rcv_pt, pnti, n & snd_pt, rcv_pt, pnti, n
integer(psb_ipk_) :: ierr(5)
logical :: swap_mpi, swap_sync, swap_send, swap_recv,& logical :: swap_mpi, swap_sync, swap_send, swap_recv,&
& albf,do_send,do_recv & albf,do_send,do_recv
logical, parameter :: usersend=.false., debug=.false. 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.... ! Unfinished communication? Something is wrong....
! !
info=psb_err_mpi_error_ info=psb_err_mpi_error_
ierr(1) = -2 call psb_errpush(info,name,m_err=(/-2/))
call psb_errpush(info,name,i_err=ierr)
goto 9999 goto 9999
end if end if
end if end if
@ -665,9 +657,8 @@ subroutine psi_zswap_vidx_multivect(iictxt,iicomm,flag,beta,y,idx, &
end if end if
if(iret /= mpi_success) then if(iret /= mpi_success) then
ierr(1) = iret
info=psb_err_mpi_error_ info=psb_err_mpi_error_
call psb_errpush(info,name,i_err=ierr) call psb_errpush(info,name,m_err=(/iret/))
goto 9999 goto 9999
end if end if
rcv_pt = rcv_pt + n*nerv 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.... ! No matching send? Something is wrong....
! !
info=psb_err_mpi_error_ info=psb_err_mpi_error_
ierr(1) = -2 call psb_errpush(info,name,m_err=(/-2/))
call psb_errpush(info,name,i_err=ierr)
goto 9999 goto 9999
end if end if
call psb_realloc(totxch,prcid,info) 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 if (nesd>0) then
call mpi_wait(y%comid(i,1),p2pstat,iret) call mpi_wait(y%comid(i,1),p2pstat,iret)
if(iret /= mpi_success) then if(iret /= mpi_success) then
ierr(1) = iret
info=psb_err_mpi_error_ info=psb_err_mpi_error_
call psb_errpush(info,name,i_err=ierr) call psb_errpush(info,name,m_err=(/iret/))
goto 9999 goto 9999
end if end if
end if end if
if (nerv>0) then if (nerv>0) then
call mpi_wait(y%comid(i,2),p2pstat,iret) call mpi_wait(y%comid(i,2),p2pstat,iret)
if(iret /= mpi_success) then if(iret /= mpi_success) then
ierr(1) = iret
info=psb_err_mpi_error_ info=psb_err_mpi_error_
call psb_errpush(info,name,i_err=ierr) call psb_errpush(info,name,m_err=(/iret/))
goto 9999 goto 9999
end if end if
end if end if

20
base/comm/internals/psi_zswapdata_a.F90
Unescape Escape View File

@ -180,7 +180,6 @@ subroutine psi_zswapidxm(iictxt,iicomm,flag,n,beta,y,idx, &
integer(psb_ipk_) :: nesd, nerv,& integer(psb_ipk_) :: nesd, nerv,&
& err_act, i, idx_pt, totsnd_, totrcv_,& & err_act, i, idx_pt, totsnd_, totrcv_,&
& snd_pt, rcv_pt, pnti & snd_pt, rcv_pt, pnti
integer(psb_ipk_) :: ierr(5)
logical :: swap_mpi, swap_sync, swap_send, swap_recv,& logical :: swap_mpi, swap_sync, swap_send, swap_recv,&
& albf,do_send,do_recv & albf,do_send,do_recv
logical, parameter :: usersend=.false. logical, parameter :: usersend=.false.
@ -300,9 +299,8 @@ subroutine psi_zswapidxm(iictxt,iicomm,flag,n,beta,y,idx, &
& psb_mpi_c_dpk_,rcvbuf,rvsz,& & psb_mpi_c_dpk_,rcvbuf,rvsz,&
& brvidx,psb_mpi_c_dpk_,icomm,iret) & brvidx,psb_mpi_c_dpk_,icomm,iret)
if(iret /= mpi_success) then if(iret /= mpi_success) then
ierr(1) = iret
info=psb_err_mpi_error_ info=psb_err_mpi_error_
call psb_errpush(info,name,i_err=ierr) call psb_errpush(info,name,m_err=(/iret/))
goto 9999 goto 9999
end if end if
@ -388,9 +386,8 @@ subroutine psi_zswapidxm(iictxt,iicomm,flag,n,beta,y,idx, &
end if end if
if(iret /= mpi_success) then if(iret /= mpi_success) then
ierr(1) = iret
info=psb_err_mpi_error_ info=psb_err_mpi_error_
call psb_errpush(info,name,i_err=ierr) call psb_errpush(info,name,m_err=(/iret/))
goto 9999 goto 9999
end if end if
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 if ((proc_to_comm /= me).and.(nerv>0)) then
call mpi_wait(rvhd(i),p2pstat,iret) call mpi_wait(rvhd(i),p2pstat,iret)
if(iret /= mpi_success) then if(iret /= mpi_success) then
ierr(1) = iret
info=psb_err_mpi_error_ info=psb_err_mpi_error_
call psb_errpush(info,name,i_err=ierr) call psb_errpush(info,name,m_err=(/iret/))
goto 9999 goto 9999
end if end if
else if (proc_to_comm == me) then 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,& integer(psb_ipk_) :: nesd, nerv,&
& err_act, i, idx_pt, totsnd_, totrcv_,& & err_act, i, idx_pt, totsnd_, totrcv_,&
& snd_pt, rcv_pt, pnti, n & snd_pt, rcv_pt, pnti, n
integer(psb_ipk_) :: ierr(5)
logical :: swap_mpi, swap_sync, swap_send, swap_recv,& logical :: swap_mpi, swap_sync, swap_send, swap_recv,&
& albf,do_send,do_recv & albf,do_send,do_recv
logical, parameter :: usersend=.false. logical, parameter :: usersend=.false.
@ -790,9 +785,8 @@ subroutine psi_zswapidxv(iictxt,iicomm,flag,beta,y,idx, &
& psb_mpi_c_dpk_,rcvbuf,rvsz,& & psb_mpi_c_dpk_,rcvbuf,rvsz,&
& brvidx,psb_mpi_c_dpk_,icomm,iret) & brvidx,psb_mpi_c_dpk_,icomm,iret)
if(iret /= mpi_success) then if(iret /= mpi_success) then
ierr(1) = iret
info=psb_err_mpi_error_ info=psb_err_mpi_error_
call psb_errpush(info,name,i_err=ierr) call psb_errpush(info,name,m_err=(/iret/))
goto 9999 goto 9999
end if end if
@ -879,9 +873,8 @@ subroutine psi_zswapidxv(iictxt,iicomm,flag,beta,y,idx, &
end if end if
if(iret /= mpi_success) then if(iret /= mpi_success) then
ierr(1) = iret
info=psb_err_mpi_error_ info=psb_err_mpi_error_
call psb_errpush(info,name,i_err=ierr) call psb_errpush(info,name,m_err=(/iret/))
goto 9999 goto 9999
end if end if
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 if ((proc_to_comm /= me).and.(nerv>0)) then
call mpi_wait(rvhd(i),p2pstat,iret) call mpi_wait(rvhd(i),p2pstat,iret)
if(iret /= mpi_success) then if(iret /= mpi_success) then
ierr(1) = iret
info=psb_err_mpi_error_ info=psb_err_mpi_error_
call psb_errpush(info,name,i_err=ierr) call psb_errpush(info,name,m_err=(/iret/))
goto 9999 goto 9999
end if end if
else if (proc_to_comm == me) then else if (proc_to_comm == me) then

34
base/comm/internals/psi_zswaptran.F90
Unescape Escape View File

@ -120,7 +120,6 @@ subroutine psi_zswaptran_vect(flag,beta,y,desc_a,work,info,data)
! locals ! locals
integer(psb_ipk_) :: ictxt, np, me, icomm, idxs, idxr, totxch, err_act, data_ integer(psb_ipk_) :: ictxt, np, me, icomm, idxs, idxr, totxch, err_act, data_
class(psb_i_base_vect_type), pointer :: d_vidx class(psb_i_base_vect_type), pointer :: d_vidx
integer(psb_ipk_) :: ierr(5)
character(len=20) :: name character(len=20) :: name
info=psb_success_ info=psb_success_
@ -212,7 +211,6 @@ subroutine psi_ztran_vidx_vect(iictxt,iicomm,flag,beta,y,idx,&
integer(psb_ipk_) :: nesd, nerv,& integer(psb_ipk_) :: nesd, nerv,&
& err_act, i, idx_pt, totsnd_, totrcv_,& & err_act, i, idx_pt, totsnd_, totrcv_,&
& snd_pt, rcv_pt, pnti, n & snd_pt, rcv_pt, pnti, n
integer(psb_ipk_) :: ierr(5)
logical :: swap_mpi, swap_sync, swap_send, swap_recv,& logical :: swap_mpi, swap_sync, swap_send, swap_recv,&
& albf,do_send,do_recv & albf,do_send,do_recv
logical, parameter :: usersend=.false., debug=.false. 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.... ! Unfinished communication? Something is wrong....
! !
info=psb_err_mpi_error_ info=psb_err_mpi_error_
ierr(1) = -2 call psb_errpush(info,name,m_err=(/-2/))
call psb_errpush(info,name,i_err=ierr)
goto 9999 goto 9999
end if end if
end if end if
@ -328,9 +325,8 @@ subroutine psi_ztran_vidx_vect(iictxt,iicomm,flag,beta,y,idx,&
end if end if
if(iret /= mpi_success) then if(iret /= mpi_success) then
ierr(1) = iret
info=psb_err_mpi_error_ info=psb_err_mpi_error_
call psb_errpush(info,name,i_err=ierr) call psb_errpush(info,name,m_err=(/iret/))
goto 9999 goto 9999
end if end if
@ -345,8 +341,7 @@ subroutine psi_ztran_vidx_vect(iictxt,iicomm,flag,beta,y,idx,&
! No matching send? Something is wrong.... ! No matching send? Something is wrong....
! !
info=psb_err_mpi_error_ info=psb_err_mpi_error_
ierr(1) = -2 call psb_errpush(info,name,m_err=(/-2/))
call psb_errpush(info,name,i_err=ierr)
goto 9999 goto 9999
end if end if
call psb_realloc(totxch,prcid,info) 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 if (nerv>0) then
call mpi_wait(y%comid(i,1),p2pstat,iret) call mpi_wait(y%comid(i,1),p2pstat,iret)
if(iret /= mpi_success) then if(iret /= mpi_success) then
ierr(1) = iret
info=psb_err_mpi_error_ info=psb_err_mpi_error_
call psb_errpush(info,name,i_err=ierr) call psb_errpush(info,name,m_err=(/iret/))
goto 9999 goto 9999
end if end if
end if end if
if (nesd>0) then if (nesd>0) then
call mpi_wait(y%comid(i,2),p2pstat,iret) call mpi_wait(y%comid(i,2),p2pstat,iret)
if(iret /= mpi_success) then if(iret /= mpi_success) then
ierr(1) = iret
info=psb_err_mpi_error_ info=psb_err_mpi_error_
call psb_errpush(info,name,i_err=ierr) call psb_errpush(info,name,m_err=(/iret/))
goto 9999 goto 9999
end if end if
end if end if
@ -475,7 +468,6 @@ subroutine psi_zswaptran_multivect(flag,beta,y,desc_a,work,info,data)
! locals ! locals
integer(psb_ipk_) :: ictxt, np, me, icomm, idxs, idxr, totxch, err_act, data_ integer(psb_ipk_) :: ictxt, np, me, icomm, idxs, idxr, totxch, err_act, data_
class(psb_i_base_vect_type), pointer :: d_vidx class(psb_i_base_vect_type), pointer :: d_vidx
integer(psb_ipk_) :: ierr(5)
character(len=20) :: name character(len=20) :: name
info=psb_success_ info=psb_success_
@ -566,7 +558,6 @@ subroutine psi_ztran_vidx_multivect(iictxt,iicomm,flag,beta,y,idx,&
integer(psb_ipk_) :: nesd, nerv,& integer(psb_ipk_) :: nesd, nerv,&
& err_act, i, idx_pt, totsnd_, totrcv_,& & err_act, i, idx_pt, totsnd_, totrcv_,&
& snd_pt, rcv_pt, pnti, n & snd_pt, rcv_pt, pnti, n
integer(psb_ipk_) :: ierr(5)
logical :: swap_mpi, swap_sync, swap_send, swap_recv,& logical :: swap_mpi, swap_sync, swap_send, swap_recv,&
& albf,do_send,do_recv & albf,do_send,do_recv
logical, parameter :: usersend=.false., debug=.false. 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.... ! Unfinished communication? Something is wrong....
! !
info=psb_err_mpi_error_ info=psb_err_mpi_error_
ierr(1) = -2 call psb_errpush(info,name,m_err=(/-2/))
call psb_errpush(info,name,i_err=ierr)
goto 9999 goto 9999
end if end if
end if end if
@ -682,9 +672,8 @@ subroutine psi_ztran_vidx_multivect(iictxt,iicomm,flag,beta,y,idx,&
end if end if
if(iret /= mpi_success) then if(iret /= mpi_success) then
ierr(1) = iret
info=psb_err_mpi_error_ info=psb_err_mpi_error_
call psb_errpush(info,name,i_err=ierr) call psb_errpush(info,name,m_err=(/iret/))
goto 9999 goto 9999
end if end if
rcv_pt = rcv_pt + n*nerv 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.... ! No matching send? Something is wrong....
! !
info=psb_err_mpi_error_ info=psb_err_mpi_error_
ierr(1) = -2 call psb_errpush(info,name,m_err=(/-2/))
call psb_errpush(info,name,i_err=ierr)
goto 9999 goto 9999
end if end if
call psb_realloc(totxch,prcid,info) 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 if (nerv>0) then
call mpi_wait(y%comid(i,1),p2pstat,iret) call mpi_wait(y%comid(i,1),p2pstat,iret)
if(iret /= mpi_success) then if(iret /= mpi_success) then
ierr(1) = iret
info=psb_err_mpi_error_ info=psb_err_mpi_error_
call psb_errpush(info,name,i_err=ierr) call psb_errpush(info,name,m_err=(/iret/))
goto 9999 goto 9999
end if end if
end if end if
if (nesd>0) then if (nesd>0) then
call mpi_wait(y%comid(i,2),p2pstat,iret) call mpi_wait(y%comid(i,2),p2pstat,iret)
if(iret /= mpi_success) then if(iret /= mpi_success) then
ierr(1) = iret
info=psb_err_mpi_error_ info=psb_err_mpi_error_
call psb_errpush(info,name,i_err=ierr) call psb_errpush(info,name,m_err=(/iret/))
goto 9999 goto 9999
end if end if
end if end if

22
base/comm/internals/psi_zswaptran_a.F90
Unescape Escape View File

@ -111,7 +111,6 @@ subroutine psi_zswaptranm(flag,n,beta,y,desc_a,work,info,data)
! locals ! locals
integer(psb_ipk_) :: ictxt, np, me, icomm, idxs, idxr, err_act, totxch, data_ integer(psb_ipk_) :: ictxt, np, me, icomm, idxs, idxr, err_act, totxch, data_
integer(psb_ipk_), pointer :: d_idx(:) integer(psb_ipk_), pointer :: d_idx(:)
integer(psb_ipk_) :: ierr(5)
character(len=20) :: name character(len=20) :: name
info=psb_success_ info=psb_success_
@ -186,7 +185,6 @@ subroutine psi_ztranidxm(iictxt,iicomm,flag,n,beta,y,idx,&
integer(psb_ipk_) :: nesd, nerv,& integer(psb_ipk_) :: nesd, nerv,&
& err_act, i, idx_pt, totsnd_, totrcv_,& & err_act, i, idx_pt, totsnd_, totrcv_,&
& snd_pt, rcv_pt, pnti & snd_pt, rcv_pt, pnti
integer(psb_ipk_) :: ierr(5)
logical :: swap_mpi, swap_sync, swap_send, swap_recv,& logical :: swap_mpi, swap_sync, swap_send, swap_recv,&
& albf,do_send,do_recv & albf,do_send,do_recv
logical, parameter :: usersend=.false. logical, parameter :: usersend=.false.
@ -311,9 +309,8 @@ subroutine psi_ztranidxm(iictxt,iicomm,flag,n,beta,y,idx,&
& psb_mpi_c_dpk_,& & psb_mpi_c_dpk_,&
& sndbuf,sdsz,bsdidx,psb_mpi_c_dpk_,icomm,iret) & sndbuf,sdsz,bsdidx,psb_mpi_c_dpk_,icomm,iret)
if(iret /= mpi_success) then if(iret /= mpi_success) then
ierr(1) = iret
info=psb_err_mpi_error_ info=psb_err_mpi_error_
call psb_errpush(info,name,i_err=ierr) call psb_errpush(info,name,m_err=(/iret/))
goto 9999 goto 9999
end if end if
@ -399,9 +396,8 @@ subroutine psi_ztranidxm(iictxt,iicomm,flag,n,beta,y,idx,&
end if end if
if(iret /= mpi_success) then if(iret /= mpi_success) then
ierr(1) = iret
info=psb_err_mpi_error_ info=psb_err_mpi_error_
call psb_errpush(info,name,i_err=ierr) call psb_errpush(info,name,m_err=(/iret/))
goto 9999 goto 9999
end if end if
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 if ((proc_to_comm /= me).and.(nesd>0)) then
call mpi_wait(rvhd(i),p2pstat,iret) call mpi_wait(rvhd(i),p2pstat,iret)
if(iret /= mpi_success) then if(iret /= mpi_success) then
ierr(1) = iret
info=psb_err_mpi_error_ info=psb_err_mpi_error_
call psb_errpush(info,name,i_err=ierr) call psb_errpush(info,name,m_err=(/iret/))
goto 9999 goto 9999
end if end if
else if (proc_to_comm == me) then else if (proc_to_comm == me) then
@ -599,7 +594,6 @@ subroutine psi_zswaptranv(flag,beta,y,desc_a,work,info,data)
! locals ! locals
integer(psb_ipk_) :: ictxt, np, me, icomm, idxs, idxr, totxch, err_act, data_ integer(psb_ipk_) :: ictxt, np, me, icomm, idxs, idxr, totxch, err_act, data_
integer(psb_ipk_), pointer :: d_idx(:) integer(psb_ipk_), pointer :: d_idx(:)
integer(psb_ipk_) :: ierr(5)
character(len=20) :: name character(len=20) :: name
info=psb_success_ info=psb_success_
@ -684,7 +678,6 @@ subroutine psi_ztranidxv(iictxt,iicomm,flag,beta,y,idx,&
integer(psb_ipk_) :: nesd, nerv,& integer(psb_ipk_) :: nesd, nerv,&
& err_act, i, idx_pt, totsnd_, totrcv_,& & err_act, i, idx_pt, totsnd_, totrcv_,&
& snd_pt, rcv_pt, pnti, n & snd_pt, rcv_pt, pnti, n
integer(psb_ipk_) :: ierr(5)
logical :: swap_mpi, swap_sync, swap_send, swap_recv,& logical :: swap_mpi, swap_sync, swap_send, swap_recv,&
& albf,do_send,do_recv & albf,do_send,do_recv
logical, parameter :: usersend=.false. logical, parameter :: usersend=.false.
@ -810,9 +803,8 @@ subroutine psi_ztranidxv(iictxt,iicomm,flag,beta,y,idx,&
& psb_mpi_c_dpk_,& & psb_mpi_c_dpk_,&
& sndbuf,sdsz,bsdidx,psb_mpi_c_dpk_,icomm,iret) & sndbuf,sdsz,bsdidx,psb_mpi_c_dpk_,icomm,iret)
if(iret /= mpi_success) then if(iret /= mpi_success) then
ierr(1) = iret
info=psb_err_mpi_error_ info=psb_err_mpi_error_
call psb_errpush(info,name,i_err=ierr) call psb_errpush(info,name,m_err=(/iret/))
goto 9999 goto 9999
end if end if
@ -897,9 +889,8 @@ subroutine psi_ztranidxv(iictxt,iicomm,flag,beta,y,idx,&
end if end if
if(iret /= mpi_success) then if(iret /= mpi_success) then
ierr(1) = iret
info=psb_err_mpi_error_ info=psb_err_mpi_error_
call psb_errpush(info,name,i_err=ierr) call psb_errpush(info,name,m_err=(/iret/))
goto 9999 goto 9999
end if end if
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 if ((proc_to_comm /= me).and.(nesd>0)) then
call mpi_wait(rvhd(i),p2pstat,iret) call mpi_wait(rvhd(i),p2pstat,iret)
if(iret /= mpi_success) then if(iret /= mpi_success) then
ierr(1) = iret
info=psb_err_mpi_error_ info=psb_err_mpi_error_
call psb_errpush(info,name,i_err=ierr) call psb_errpush(info,name,m_err=(/iret/))
goto 9999 goto 9999
end if end if
else if (proc_to_comm == me) then else if (proc_to_comm == me) then

4
base/modules/comm/psb_c_linmap_mod.f90
Unescape Escape View File

@ -233,7 +233,6 @@ contains
integer(psb_ipk_) :: info integer(psb_ipk_) :: info
integer(psb_ipk_) :: err_act integer(psb_ipk_) :: err_act
integer(psb_ipk_) :: ierr(5)
character(len=20) :: name='clone' character(len=20) :: name='clone'
info = 0 info = 0
@ -247,9 +246,8 @@ contains
if (info == 0) call map%map_Y2X%clone(mout%map_Y2X,info) if (info == 0) call map%map_Y2X%clone(mout%map_Y2X,info)
class default class default
info = psb_err_invalid_dynamic_type_ info = psb_err_invalid_dynamic_type_
ierr(1) = 2
info = psb_err_missing_override_method_ 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_erractionsave(err_act)
call psb_error_handler(err_act) call psb_error_handler(err_act)

4
base/modules/comm/psb_d_linmap_mod.f90
Unescape Escape View File

@ -233,7 +233,6 @@ contains
integer(psb_ipk_) :: info integer(psb_ipk_) :: info
integer(psb_ipk_) :: err_act integer(psb_ipk_) :: err_act
integer(psb_ipk_) :: ierr(5)
character(len=20) :: name='clone' character(len=20) :: name='clone'
info = 0 info = 0
@ -247,9 +246,8 @@ contains
if (info == 0) call map%map_Y2X%clone(mout%map_Y2X,info) if (info == 0) call map%map_Y2X%clone(mout%map_Y2X,info)
class default class default
info = psb_err_invalid_dynamic_type_ info = psb_err_invalid_dynamic_type_
ierr(1) = 2
info = psb_err_missing_override_method_ 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_erractionsave(err_act)
call psb_error_handler(err_act) call psb_error_handler(err_act)

4
base/modules/comm/psb_s_linmap_mod.f90
Unescape Escape View File

@ -233,7 +233,6 @@ contains
integer(psb_ipk_) :: info integer(psb_ipk_) :: info
integer(psb_ipk_) :: err_act integer(psb_ipk_) :: err_act
integer(psb_ipk_) :: ierr(5)
character(len=20) :: name='clone' character(len=20) :: name='clone'
info = 0 info = 0
@ -247,9 +246,8 @@ contains
if (info == 0) call map%map_Y2X%clone(mout%map_Y2X,info) if (info == 0) call map%map_Y2X%clone(mout%map_Y2X,info)
class default class default
info = psb_err_invalid_dynamic_type_ info = psb_err_invalid_dynamic_type_
ierr(1) = 2
info = psb_err_missing_override_method_ 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_erractionsave(err_act)
call psb_error_handler(err_act) call psb_error_handler(err_act)

4
base/modules/comm/psb_z_linmap_mod.f90
Unescape Escape View File

@ -233,7 +233,6 @@ contains
integer(psb_ipk_) :: info integer(psb_ipk_) :: info
integer(psb_ipk_) :: err_act integer(psb_ipk_) :: err_act
integer(psb_ipk_) :: ierr(5)
character(len=20) :: name='clone' character(len=20) :: name='clone'
info = 0 info = 0
@ -247,9 +246,8 @@ contains
if (info == 0) call map%map_Y2X%clone(mout%map_Y2X,info) if (info == 0) call map%map_Y2X%clone(mout%map_Y2X,info)
class default class default
info = psb_err_invalid_dynamic_type_ info = psb_err_invalid_dynamic_type_
ierr(1) = 2
info = psb_err_missing_override_method_ 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_erractionsave(err_act)
call psb_error_handler(err_act) call psb_error_handler(err_act)

33
base/serial/impl/psb_c_csr_impl.f90
Unescape Escape View File

@ -1018,7 +1018,6 @@ subroutine psb_c_csr_cssm(alpha,a,x,beta,y,info,trans)
complex(psb_spk_), allocatable :: tmp(:,:) complex(psb_spk_), allocatable :: tmp(:,:)
logical :: tra, ctra logical :: tra, ctra
integer(psb_ipk_) :: err_act integer(psb_ipk_) :: err_act
integer(psb_ipk_) :: ierr(5)
character(len=20) :: name='c_csr_cssm' character(len=20) :: name='c_csr_cssm'
logical, parameter :: debug=.false. logical, parameter :: debug=.false.
@ -1270,7 +1269,6 @@ function psb_c_csr_maxval(a) result(res)
real(psb_spk_) :: res real(psb_spk_) :: res
integer(psb_ipk_) :: i,j,k,m,n, nnz, ir, jc, nc, info 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' character(len=20) :: name='c_csr_maxval'
logical, parameter :: debug=.false. logical, parameter :: debug=.false.
@ -1295,7 +1293,6 @@ function psb_c_csr_csnmi(a) result(res)
real(psb_spk_) :: acc real(psb_spk_) :: acc
logical :: tra logical :: tra
integer(psb_ipk_) :: err_act integer(psb_ipk_) :: err_act
integer(psb_ipk_) :: ierr(5)
character(len=20) :: name='c_csnmi' character(len=20) :: name='c_csnmi'
logical, parameter :: debug=.false. 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_), intent(out) :: info
integer(psb_ipk_) :: err_act,mnm, i, j, m integer(psb_ipk_) :: err_act,mnm, i, j, m
integer(psb_ipk_) :: ierr(5)
character(len=20) :: name='scal' character(len=20) :: name='scal'
logical, parameter :: debug=.false. logical, parameter :: debug=.false.
@ -1704,7 +1700,6 @@ subroutine psb_c_csr_reallocate_nz(nz,a)
integer(psb_ipk_), intent(in) :: nz integer(psb_ipk_), intent(in) :: nz
class(psb_c_csr_sparse_mat), intent(inout) :: a class(psb_c_csr_sparse_mat), intent(inout) :: a
integer(psb_ipk_) :: err_act, info integer(psb_ipk_) :: err_act, info
integer(psb_ipk_) :: ierr(5)
character(len=20) :: name='c_csr_reallocate_nz' character(len=20) :: name='c_csr_reallocate_nz'
logical, parameter :: debug=.false. 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 class(psb_c_base_sparse_mat), intent(inout), allocatable :: b
integer(psb_ipk_), intent(out) :: info integer(psb_ipk_), intent(out) :: info
integer(psb_ipk_) :: err_act integer(psb_ipk_) :: err_act
integer(psb_ipk_) :: ierr(5)
character(len=20) :: name='csr_mold' character(len=20) :: name='csr_mold'
logical, parameter :: debug=.false. logical, parameter :: debug=.false.
@ -1846,7 +1840,6 @@ subroutine psb_c_csr_csgetptn(imin,imax,a,nz,ia,ja,info,&
logical :: append_, rscale_, cscale_ logical :: append_, rscale_, cscale_
integer(psb_ipk_) :: nzin_, jmin_, jmax_, err_act, i integer(psb_ipk_) :: nzin_, jmin_, jmax_, err_act, i
integer(psb_ipk_) :: ierr(5)
character(len=20) :: name='csget' character(len=20) :: name='csget'
logical, parameter :: debug=.false. 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_ logical :: append_, rscale_, cscale_
integer(psb_ipk_) :: nzin_, jmin_, jmax_, err_act, i integer(psb_ipk_) :: nzin_, jmin_, jmax_, err_act, i
integer(psb_ipk_) :: ierr(5)
character(len=20) :: name='csget' character(len=20) :: name='csget'
logical, parameter :: debug=.false. 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 integer(psb_ipk_), intent(in), optional :: jmin,jmax
logical, intent(in), optional :: rscale,cscale logical, intent(in), optional :: rscale,cscale
integer(psb_ipk_) :: err_act, nzin, nzout integer(psb_ipk_) :: err_act, nzin, nzout
integer(psb_ipk_) :: ierr(5)
character(len=20) :: name='csget' character(len=20) :: name='csget'
logical :: append_ logical :: append_
logical, parameter :: debug=.false. 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_) :: err_act
integer(psb_ipk_) :: ierr(5)
character(len=20) :: name='c_csr_csput_a' character(len=20) :: name='c_csr_csput_a'
logical, parameter :: debug=.false. logical, parameter :: debug=.false.
integer(psb_ipk_) :: nza, i,j,k, nzl, isza, debug_level, debug_unit 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() debug_level = psb_get_debug_level()
if (nz <= 0) then if (nz <= 0) then
info = psb_err_iarg_neg_ info = psb_err_iarg_neg_; i=1
ierr(1)=1 call psb_errpush(info,name,i_err=(/i/))
call psb_errpush(info,name,i_err=ierr)
goto 9999 goto 9999
end if end if
if (size(ia) < nz) then if (size(ia) < nz) then
info = psb_err_input_asize_invalid_i_ info = psb_err_input_asize_invalid_i_; i=2
ierr(1)=2 call psb_errpush(info,name,i_err=(/i/))
call psb_errpush(info,name,i_err=ierr)
goto 9999 goto 9999
end if end if
if (size(ja) < nz) then if (size(ja) < nz) then
info = psb_err_input_asize_invalid_i_ info = psb_err_input_asize_invalid_i_; i=3
ierr(1)=3 call psb_errpush(info,name,i_err=(/i/))
call psb_errpush(info,name,i_err=ierr)
goto 9999 goto 9999
end if end if
if (size(val) < nz) then if (size(val) < nz) then
info = psb_err_input_asize_invalid_i_ info = psb_err_input_asize_invalid_i_; i=4
ierr(1)=4 call psb_errpush(info,name,i_err=(/i/))
call psb_errpush(info,name,i_err=ierr)
goto 9999 goto 9999
end if end if
@ -2510,7 +2496,6 @@ subroutine psb_c_csr_reinit(a,clear)
logical, intent(in), optional :: clear logical, intent(in), optional :: clear
integer(psb_ipk_) :: err_act, info integer(psb_ipk_) :: err_act, info
integer(psb_ipk_) :: ierr(5)
character(len=20) :: name='reinit' character(len=20) :: name='reinit'
logical :: clear_ logical :: clear_
logical, parameter :: debug=.false. logical, parameter :: debug=.false.
@ -2555,7 +2540,6 @@ subroutine psb_c_csr_trim(a)
implicit none implicit none
class(psb_c_csr_sparse_mat), intent(inout) :: a class(psb_c_csr_sparse_mat), intent(inout) :: a
integer(psb_ipk_) :: err_act, info, nz, m integer(psb_ipk_) :: err_act, info, nz, m
integer(psb_ipk_) :: ierr(5)
character(len=20) :: name='trim' character(len=20) :: name='trim'
logical, parameter :: debug=.false. 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_), intent(in), optional :: ivr(:), ivc(:)
integer(psb_ipk_) :: err_act integer(psb_ipk_) :: err_act
integer(psb_ipk_) :: ierr(5)
character(len=20) :: name='c_csr_print' character(len=20) :: name='c_csr_print'
logical, parameter :: debug=.false. logical, parameter :: debug=.false.
character(len=*), parameter :: datatype='complex' character(len=*), parameter :: datatype='complex'

33
base/serial/impl/psb_d_csr_impl.f90
Unescape Escape View File

@ -1018,7 +1018,6 @@ subroutine psb_d_csr_cssm(alpha,a,x,beta,y,info,trans)
real(psb_dpk_), allocatable :: tmp(:,:) real(psb_dpk_), allocatable :: tmp(:,:)
logical :: tra, ctra logical :: tra, ctra
integer(psb_ipk_) :: err_act integer(psb_ipk_) :: err_act
integer(psb_ipk_) :: ierr(5)
character(len=20) :: name='d_csr_cssm' character(len=20) :: name='d_csr_cssm'
logical, parameter :: debug=.false. logical, parameter :: debug=.false.
@ -1270,7 +1269,6 @@ function psb_d_csr_maxval(a) result(res)
real(psb_dpk_) :: res real(psb_dpk_) :: res
integer(psb_ipk_) :: i,j,k,m,n, nnz, ir, jc, nc, info 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' character(len=20) :: name='d_csr_maxval'
logical, parameter :: debug=.false. logical, parameter :: debug=.false.
@ -1295,7 +1293,6 @@ function psb_d_csr_csnmi(a) result(res)
real(psb_dpk_) :: acc real(psb_dpk_) :: acc
logical :: tra logical :: tra
integer(psb_ipk_) :: err_act integer(psb_ipk_) :: err_act
integer(psb_ipk_) :: ierr(5)
character(len=20) :: name='d_csnmi' character(len=20) :: name='d_csnmi'
logical, parameter :: debug=.false. 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_), intent(out) :: info
integer(psb_ipk_) :: err_act,mnm, i, j, m integer(psb_ipk_) :: err_act,mnm, i, j, m
integer(psb_ipk_) :: ierr(5)
character(len=20) :: name='scal' character(len=20) :: name='scal'
logical, parameter :: debug=.false. logical, parameter :: debug=.false.
@ -1704,7 +1700,6 @@ subroutine psb_d_csr_reallocate_nz(nz,a)
integer(psb_ipk_), intent(in) :: nz integer(psb_ipk_), intent(in) :: nz
class(psb_d_csr_sparse_mat), intent(inout) :: a class(psb_d_csr_sparse_mat), intent(inout) :: a
integer(psb_ipk_) :: err_act, info integer(psb_ipk_) :: err_act, info
integer(psb_ipk_) :: ierr(5)
character(len=20) :: name='d_csr_reallocate_nz' character(len=20) :: name='d_csr_reallocate_nz'
logical, parameter :: debug=.false. 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 class(psb_d_base_sparse_mat), intent(inout), allocatable :: b
integer(psb_ipk_), intent(out) :: info integer(psb_ipk_), intent(out) :: info
integer(psb_ipk_) :: err_act integer(psb_ipk_) :: err_act
integer(psb_ipk_) :: ierr(5)
character(len=20) :: name='csr_mold' character(len=20) :: name='csr_mold'
logical, parameter :: debug=.false. logical, parameter :: debug=.false.
@ -1846,7 +1840,6 @@ subroutine psb_d_csr_csgetptn(imin,imax,a,nz,ia,ja,info,&
logical :: append_, rscale_, cscale_ logical :: append_, rscale_, cscale_
integer(psb_ipk_) :: nzin_, jmin_, jmax_, err_act, i integer(psb_ipk_) :: nzin_, jmin_, jmax_, err_act, i
integer(psb_ipk_) :: ierr(5)
character(len=20) :: name='csget' character(len=20) :: name='csget'
logical, parameter :: debug=.false. 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_ logical :: append_, rscale_, cscale_
integer(psb_ipk_) :: nzin_, jmin_, jmax_, err_act, i integer(psb_ipk_) :: nzin_, jmin_, jmax_, err_act, i
integer(psb_ipk_) :: ierr(5)
character(len=20) :: name='csget' character(len=20) :: name='csget'
logical, parameter :: debug=.false. 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 integer(psb_ipk_), intent(in), optional :: jmin,jmax
logical, intent(in), optional :: rscale,cscale logical, intent(in), optional :: rscale,cscale
integer(psb_ipk_) :: err_act, nzin, nzout integer(psb_ipk_) :: err_act, nzin, nzout
integer(psb_ipk_) :: ierr(5)
character(len=20) :: name='csget' character(len=20) :: name='csget'
logical :: append_ logical :: append_
logical, parameter :: debug=.false. 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_) :: err_act
integer(psb_ipk_) :: ierr(5)
character(len=20) :: name='d_csr_csput_a' character(len=20) :: name='d_csr_csput_a'
logical, parameter :: debug=.false. logical, parameter :: debug=.false.
integer(psb_ipk_) :: nza, i,j,k, nzl, isza, debug_level, debug_unit 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() debug_level = psb_get_debug_level()
if (nz <= 0) then if (nz <= 0) then
info = psb_err_iarg_neg_ info = psb_err_iarg_neg_; i=1
ierr(1)=1 call psb_errpush(info,name,i_err=(/i/))
call psb_errpush(info,name,i_err=ierr)
goto 9999 goto 9999
end if end if
if (size(ia) < nz) then if (size(ia) < nz) then
info = psb_err_input_asize_invalid_i_ info = psb_err_input_asize_invalid_i_; i=2
ierr(1)=2 call psb_errpush(info,name,i_err=(/i/))
call psb_errpush(info,name,i_err=ierr)
goto 9999 goto 9999
end if end if
if (size(ja) < nz) then if (size(ja) < nz) then
info = psb_err_input_asize_invalid_i_ info = psb_err_input_asize_invalid_i_; i=3
ierr(1)=3 call psb_errpush(info,name,i_err=(/i/))
call psb_errpush(info,name,i_err=ierr)
goto 9999 goto 9999
end if end if
if (size(val) < nz) then if (size(val) < nz) then
info = psb_err_input_asize_invalid_i_ info = psb_err_input_asize_invalid_i_; i=4
ierr(1)=4 call psb_errpush(info,name,i_err=(/i/))
call psb_errpush(info,name,i_err=ierr)
goto 9999 goto 9999
end if end if
@ -2510,7 +2496,6 @@ subroutine psb_d_csr_reinit(a,clear)
logical, intent(in), optional :: clear logical, intent(in), optional :: clear
integer(psb_ipk_) :: err_act, info integer(psb_ipk_) :: err_act, info
integer(psb_ipk_) :: ierr(5)
character(len=20) :: name='reinit' character(len=20) :: name='reinit'
logical :: clear_ logical :: clear_
logical, parameter :: debug=.false. logical, parameter :: debug=.false.
@ -2555,7 +2540,6 @@ subroutine psb_d_csr_trim(a)
implicit none implicit none
class(psb_d_csr_sparse_mat), intent(inout) :: a class(psb_d_csr_sparse_mat), intent(inout) :: a
integer(psb_ipk_) :: err_act, info, nz, m integer(psb_ipk_) :: err_act, info, nz, m
integer(psb_ipk_) :: ierr(5)
character(len=20) :: name='trim' character(len=20) :: name='trim'
logical, parameter :: debug=.false. 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_), intent(in), optional :: ivr(:), ivc(:)
integer(psb_ipk_) :: err_act integer(psb_ipk_) :: err_act
integer(psb_ipk_) :: ierr(5)
character(len=20) :: name='d_csr_print' character(len=20) :: name='d_csr_print'
logical, parameter :: debug=.false. logical, parameter :: debug=.false.
character(len=*), parameter :: datatype='real' character(len=*), parameter :: datatype='real'

33
base/serial/impl/psb_s_csr_impl.f90
Unescape Escape View File

@ -1018,7 +1018,6 @@ subroutine psb_s_csr_cssm(alpha,a,x,beta,y,info,trans)
real(psb_spk_), allocatable :: tmp(:,:) real(psb_spk_), allocatable :: tmp(:,:)
logical :: tra, ctra logical :: tra, ctra
integer(psb_ipk_) :: err_act integer(psb_ipk_) :: err_act
integer(psb_ipk_) :: ierr(5)
character(len=20) :: name='s_csr_cssm' character(len=20) :: name='s_csr_cssm'
logical, parameter :: debug=.false. logical, parameter :: debug=.false.
@ -1270,7 +1269,6 @@ function psb_s_csr_maxval(a) result(res)
real(psb_spk_) :: res real(psb_spk_) :: res
integer(psb_ipk_) :: i,j,k,m,n, nnz, ir, jc, nc, info 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' character(len=20) :: name='s_csr_maxval'
logical, parameter :: debug=.false. logical, parameter :: debug=.false.
@ -1295,7 +1293,6 @@ function psb_s_csr_csnmi(a) result(res)
real(psb_spk_) :: acc real(psb_spk_) :: acc
logical :: tra logical :: tra
integer(psb_ipk_) :: err_act integer(psb_ipk_) :: err_act
integer(psb_ipk_) :: ierr(5)
character(len=20) :: name='s_csnmi' character(len=20) :: name='s_csnmi'
logical, parameter :: debug=.false. 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_), intent(out) :: info
integer(psb_ipk_) :: err_act,mnm, i, j, m integer(psb_ipk_) :: err_act,mnm, i, j, m
integer(psb_ipk_) :: ierr(5)
character(len=20) :: name='scal' character(len=20) :: name='scal'
logical, parameter :: debug=.false. logical, parameter :: debug=.false.
@ -1704,7 +1700,6 @@ subroutine psb_s_csr_reallocate_nz(nz,a)
integer(psb_ipk_), intent(in) :: nz integer(psb_ipk_), intent(in) :: nz
class(psb_s_csr_sparse_mat), intent(inout) :: a class(psb_s_csr_sparse_mat), intent(inout) :: a
integer(psb_ipk_) :: err_act, info integer(psb_ipk_) :: err_act, info
integer(psb_ipk_) :: ierr(5)
character(len=20) :: name='s_csr_reallocate_nz' character(len=20) :: name='s_csr_reallocate_nz'
logical, parameter :: debug=.false. 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 class(psb_s_base_sparse_mat), intent(inout), allocatable :: b
integer(psb_ipk_), intent(out) :: info integer(psb_ipk_), intent(out) :: info
integer(psb_ipk_) :: err_act integer(psb_ipk_) :: err_act
integer(psb_ipk_) :: ierr(5)
character(len=20) :: name='csr_mold' character(len=20) :: name='csr_mold'
logical, parameter :: debug=.false. logical, parameter :: debug=.false.
@ -1846,7 +1840,6 @@ subroutine psb_s_csr_csgetptn(imin,imax,a,nz,ia,ja,info,&
logical :: append_, rscale_, cscale_ logical :: append_, rscale_, cscale_
integer(psb_ipk_) :: nzin_, jmin_, jmax_, err_act, i integer(psb_ipk_) :: nzin_, jmin_, jmax_, err_act, i
integer(psb_ipk_) :: ierr(5)
character(len=20) :: name='csget' character(len=20) :: name='csget'
logical, parameter :: debug=.false. 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_ logical :: append_, rscale_, cscale_
integer(psb_ipk_) :: nzin_, jmin_, jmax_, err_act, i integer(psb_ipk_) :: nzin_, jmin_, jmax_, err_act, i
integer(psb_ipk_) :: ierr(5)
character(len=20) :: name='csget' character(len=20) :: name='csget'
logical, parameter :: debug=.false. 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 integer(psb_ipk_), intent(in), optional :: jmin,jmax
logical, intent(in), optional :: rscale,cscale logical, intent(in), optional :: rscale,cscale
integer(psb_ipk_) :: err_act, nzin, nzout integer(psb_ipk_) :: err_act, nzin, nzout
integer(psb_ipk_) :: ierr(5)
character(len=20) :: name='csget' character(len=20) :: name='csget'
logical :: append_ logical :: append_
logical, parameter :: debug=.false. 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_) :: err_act
integer(psb_ipk_) :: ierr(5)
character(len=20) :: name='s_csr_csput_a' character(len=20) :: name='s_csr_csput_a'
logical, parameter :: debug=.false. logical, parameter :: debug=.false.
integer(psb_ipk_) :: nza, i,j,k, nzl, isza, debug_level, debug_unit 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() debug_level = psb_get_debug_level()
if (nz <= 0) then if (nz <= 0) then
info = psb_err_iarg_neg_ info = psb_err_iarg_neg_; i=1
ierr(1)=1 call psb_errpush(info,name,i_err=(/i/))
call psb_errpush(info,name,i_err=ierr)
goto 9999 goto 9999
end if end if
if (size(ia) < nz) then if (size(ia) < nz) then
info = psb_err_input_asize_invalid_i_ info = psb_err_input_asize_invalid_i_; i=2
ierr(1)=2 call psb_errpush(info,name,i_err=(/i/))
call psb_errpush(info,name,i_err=ierr)
goto 9999 goto 9999
end if end if
if (size(ja) < nz) then if (size(ja) < nz) then
info = psb_err_input_asize_invalid_i_ info = psb_err_input_asize_invalid_i_; i=3
ierr(1)=3 call psb_errpush(info,name,i_err=(/i/))
call psb_errpush(info,name,i_err=ierr)
goto 9999 goto 9999
end if end if
if (size(val) < nz) then if (size(val) < nz) then
info = psb_err_input_asize_invalid_i_ info = psb_err_input_asize_invalid_i_; i=4
ierr(1)=4 call psb_errpush(info,name,i_err=(/i/))
call psb_errpush(info,name,i_err=ierr)
goto 9999 goto 9999
end if end if
@ -2510,7 +2496,6 @@ subroutine psb_s_csr_reinit(a,clear)
logical, intent(in), optional :: clear logical, intent(in), optional :: clear
integer(psb_ipk_) :: err_act, info integer(psb_ipk_) :: err_act, info
integer(psb_ipk_) :: ierr(5)
character(len=20) :: name='reinit' character(len=20) :: name='reinit'
logical :: clear_ logical :: clear_
logical, parameter :: debug=.false. logical, parameter :: debug=.false.
@ -2555,7 +2540,6 @@ subroutine psb_s_csr_trim(a)
implicit none implicit none
class(psb_s_csr_sparse_mat), intent(inout) :: a class(psb_s_csr_sparse_mat), intent(inout) :: a
integer(psb_ipk_) :: err_act, info, nz, m integer(psb_ipk_) :: err_act, info, nz, m
integer(psb_ipk_) :: ierr(5)
character(len=20) :: name='trim' character(len=20) :: name='trim'
logical, parameter :: debug=.false. 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_), intent(in), optional :: ivr(:), ivc(:)
integer(psb_ipk_) :: err_act integer(psb_ipk_) :: err_act
integer(psb_ipk_) :: ierr(5)
character(len=20) :: name='s_csr_print' character(len=20) :: name='s_csr_print'
logical, parameter :: debug=.false. logical, parameter :: debug=.false.
character(len=*), parameter :: datatype='real' character(len=*), parameter :: datatype='real'

33
base/serial/impl/psb_z_csr_impl.f90
Unescape Escape View File

@ -1018,7 +1018,6 @@ subroutine psb_z_csr_cssm(alpha,a,x,beta,y,info,trans)
complex(psb_dpk_), allocatable :: tmp(:,:) complex(psb_dpk_), allocatable :: tmp(:,:)
logical :: tra, ctra logical :: tra, ctra
integer(psb_ipk_) :: err_act integer(psb_ipk_) :: err_act
integer(psb_ipk_) :: ierr(5)
character(len=20) :: name='z_csr_cssm' character(len=20) :: name='z_csr_cssm'
logical, parameter :: debug=.false. logical, parameter :: debug=.false.
@ -1270,7 +1269,6 @@ function psb_z_csr_maxval(a) result(res)
real(psb_dpk_) :: res real(psb_dpk_) :: res
integer(psb_ipk_) :: i,j,k,m,n, nnz, ir, jc, nc, info 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' character(len=20) :: name='z_csr_maxval'
logical, parameter :: debug=.false. logical, parameter :: debug=.false.
@ -1295,7 +1293,6 @@ function psb_z_csr_csnmi(a) result(res)
real(psb_dpk_) :: acc real(psb_dpk_) :: acc
logical :: tra logical :: tra
integer(psb_ipk_) :: err_act integer(psb_ipk_) :: err_act
integer(psb_ipk_) :: ierr(5)
character(len=20) :: name='z_csnmi' character(len=20) :: name='z_csnmi'
logical, parameter :: debug=.false. 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_), intent(out) :: info
integer(psb_ipk_) :: err_act,mnm, i, j, m integer(psb_ipk_) :: err_act,mnm, i, j, m
integer(psb_ipk_) :: ierr(5)
character(len=20) :: name='scal' character(len=20) :: name='scal'
logical, parameter :: debug=.false. logical, parameter :: debug=.false.
@ -1704,7 +1700,6 @@ subroutine psb_z_csr_reallocate_nz(nz,a)
integer(psb_ipk_), intent(in) :: nz integer(psb_ipk_), intent(in) :: nz
class(psb_z_csr_sparse_mat), intent(inout) :: a class(psb_z_csr_sparse_mat), intent(inout) :: a
integer(psb_ipk_) :: err_act, info integer(psb_ipk_) :: err_act, info
integer(psb_ipk_) :: ierr(5)
character(len=20) :: name='z_csr_reallocate_nz' character(len=20) :: name='z_csr_reallocate_nz'
logical, parameter :: debug=.false. 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 class(psb_z_base_sparse_mat), intent(inout), allocatable :: b
integer(psb_ipk_), intent(out) :: info integer(psb_ipk_), intent(out) :: info
integer(psb_ipk_) :: err_act integer(psb_ipk_) :: err_act
integer(psb_ipk_) :: ierr(5)
character(len=20) :: name='csr_mold' character(len=20) :: name='csr_mold'
logical, parameter :: debug=.false. logical, parameter :: debug=.false.
@ -1846,7 +1840,6 @@ subroutine psb_z_csr_csgetptn(imin,imax,a,nz,ia,ja,info,&
logical :: append_, rscale_, cscale_ logical :: append_, rscale_, cscale_
integer(psb_ipk_) :: nzin_, jmin_, jmax_, err_act, i integer(psb_ipk_) :: nzin_, jmin_, jmax_, err_act, i
integer(psb_ipk_) :: ierr(5)
character(len=20) :: name='csget' character(len=20) :: name='csget'
logical, parameter :: debug=.false. 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_ logical :: append_, rscale_, cscale_
integer(psb_ipk_) :: nzin_, jmin_, jmax_, err_act, i integer(psb_ipk_) :: nzin_, jmin_, jmax_, err_act, i
integer(psb_ipk_) :: ierr(5)
character(len=20) :: name='csget' character(len=20) :: name='csget'
logical, parameter :: debug=.false. 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 integer(psb_ipk_), intent(in), optional :: jmin,jmax
logical, intent(in), optional :: rscale,cscale logical, intent(in), optional :: rscale,cscale
integer(psb_ipk_) :: err_act, nzin, nzout integer(psb_ipk_) :: err_act, nzin, nzout
integer(psb_ipk_) :: ierr(5)
character(len=20) :: name='csget' character(len=20) :: name='csget'
logical :: append_ logical :: append_
logical, parameter :: debug=.false. 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_) :: err_act
integer(psb_ipk_) :: ierr(5)
character(len=20) :: name='z_csr_csput_a' character(len=20) :: name='z_csr_csput_a'
logical, parameter :: debug=.false. logical, parameter :: debug=.false.
integer(psb_ipk_) :: nza, i,j,k, nzl, isza, debug_level, debug_unit 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() debug_level = psb_get_debug_level()
if (nz <= 0) then if (nz <= 0) then
info = psb_err_iarg_neg_ info = psb_err_iarg_neg_; i=1
ierr(1)=1 call psb_errpush(info,name,i_err=(/i/))
call psb_errpush(info,name,i_err=ierr)
goto 9999 goto 9999
end if end if
if (size(ia) < nz) then if (size(ia) < nz) then
info = psb_err_input_asize_invalid_i_ info = psb_err_input_asize_invalid_i_; i=2
ierr(1)=2 call psb_errpush(info,name,i_err=(/i/))
call psb_errpush(info,name,i_err=ierr)
goto 9999 goto 9999
end if end if
if (size(ja) < nz) then if (size(ja) < nz) then
info = psb_err_input_asize_invalid_i_ info = psb_err_input_asize_invalid_i_; i=3
ierr(1)=3 call psb_errpush(info,name,i_err=(/i/))
call psb_errpush(info,name,i_err=ierr)
goto 9999 goto 9999
end if end if
if (size(val) < nz) then if (size(val) < nz) then
info = psb_err_input_asize_invalid_i_ info = psb_err_input_asize_invalid_i_; i=4
ierr(1)=4 call psb_errpush(info,name,i_err=(/i/))
call psb_errpush(info,name,i_err=ierr)
goto 9999 goto 9999
end if end if
@ -2510,7 +2496,6 @@ subroutine psb_z_csr_reinit(a,clear)
logical, intent(in), optional :: clear logical, intent(in), optional :: clear
integer(psb_ipk_) :: err_act, info integer(psb_ipk_) :: err_act, info
integer(psb_ipk_) :: ierr(5)
character(len=20) :: name='reinit' character(len=20) :: name='reinit'
logical :: clear_ logical :: clear_
logical, parameter :: debug=.false. logical, parameter :: debug=.false.
@ -2555,7 +2540,6 @@ subroutine psb_z_csr_trim(a)
implicit none implicit none
class(psb_z_csr_sparse_mat), intent(inout) :: a class(psb_z_csr_sparse_mat), intent(inout) :: a
integer(psb_ipk_) :: err_act, info, nz, m integer(psb_ipk_) :: err_act, info, nz, m
integer(psb_ipk_) :: ierr(5)
character(len=20) :: name='trim' character(len=20) :: name='trim'
logical, parameter :: debug=.false. 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_), intent(in), optional :: ivr(:), ivc(:)
integer(psb_ipk_) :: err_act integer(psb_ipk_) :: err_act
integer(psb_ipk_) :: ierr(5)
character(len=20) :: name='z_csr_print' character(len=20) :: name='z_csr_print'
logical, parameter :: debug=.false. logical, parameter :: debug=.false.
character(len=*), parameter :: datatype='complex' character(len=*), parameter :: datatype='complex'

9
base/tools/psb_casb.f90
Unescape Escape View File

@ -54,7 +54,7 @@ subroutine psb_casb_vect(x, desc_a, info, mold, scratch)
! local variables ! local variables
integer(psb_ipk_) :: ictxt,np,me 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_ logical :: scratch_
integer(psb_ipk_) :: debug_level, debug_unit integer(psb_ipk_) :: debug_level, debug_unit
character(len=20) :: name,ch_err character(len=20) :: name,ch_err
@ -62,7 +62,6 @@ subroutine psb_casb_vect(x, desc_a, info, mold, scratch)
info = psb_success_ info = psb_success_
if (psb_errstatus_fatal()) return if (psb_errstatus_fatal()) return
int_err(1) = 0
name = 'psb_cgeasb_v' name = 'psb_cgeasb_v'
ictxt = desc_a%get_context() ictxt = desc_a%get_context()
@ -128,7 +127,7 @@ subroutine psb_casb_vect_r2(x, desc_a, info, mold, scratch)
! local variables ! local variables
integer(psb_ipk_) :: ictxt,np,me, i, n 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_ logical :: scratch_
integer(psb_ipk_) :: debug_level, debug_unit integer(psb_ipk_) :: debug_level, debug_unit
character(len=20) :: name,ch_err character(len=20) :: name,ch_err
@ -136,7 +135,6 @@ subroutine psb_casb_vect_r2(x, desc_a, info, mold, scratch)
info = psb_success_ info = psb_success_
if (psb_errstatus_fatal()) return if (psb_errstatus_fatal()) return
int_err(1) = 0
name = 'psb_cgeasb_v' name = 'psb_cgeasb_v'
ictxt = desc_a%get_context() ictxt = desc_a%get_context()
@ -211,7 +209,7 @@ subroutine psb_casb_multivect(x, desc_a, info, mold, scratch,n)
! local variables ! local variables
integer(psb_ipk_) :: ictxt,np,me 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_ logical :: scratch_
integer(psb_ipk_) :: debug_level, debug_unit 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_ info = psb_success_
if (psb_errstatus_fatal()) return if (psb_errstatus_fatal()) return
int_err(1) = 0
name = 'psb_cgeasb' name = 'psb_cgeasb'
ictxt = desc_a%get_context() ictxt = desc_a%get_context()

3
base/tools/psb_casb_a.f90
Unescape Escape View File

@ -187,13 +187,12 @@ subroutine psb_casbv(x, desc_a, info, scratch)
! local variables ! local variables
integer(psb_ipk_) :: ictxt,np,me 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 integer(psb_ipk_) :: debug_level, debug_unit
logical :: scratch_ logical :: scratch_
character(len=20) :: name,ch_err character(len=20) :: name,ch_err
info = psb_success_ info = psb_success_
int_err(1) = 0
name = 'psb_cgeasb_v' name = 'psb_cgeasb_v'
ictxt = desc_a%get_context() ictxt = desc_a%get_context()

2
base/tools/psb_cspasb.f90
Unescape Escape View File

@ -62,14 +62,12 @@ subroutine psb_cspasb(a,desc_a, info, afmt, upd, dupl, mold)
character(len=*), optional, intent(in) :: afmt character(len=*), optional, intent(in) :: afmt
class(psb_c_base_sparse_mat), intent(in), optional :: mold class(psb_c_base_sparse_mat), intent(in), optional :: mold
!....Locals.... !....Locals....
integer(psb_ipk_) :: int_err(5)
integer(psb_ipk_) :: ictxt,np,me, err_act integer(psb_ipk_) :: ictxt,np,me, err_act
integer(psb_ipk_) :: n_row,n_col integer(psb_ipk_) :: n_row,n_col
integer(psb_ipk_) :: debug_level, debug_unit integer(psb_ipk_) :: debug_level, debug_unit
character(len=20) :: name, ch_err character(len=20) :: name, ch_err
info = psb_success_ info = psb_success_
int_err(1)=0
name = 'psb_spasb' name = 'psb_spasb'
call psb_erractionsave(err_act) call psb_erractionsave(err_act)
debug_unit = psb_get_debug_unit() debug_unit = psb_get_debug_unit()

27
base/tools/psb_cspins.f90
Unescape Escape View File

@ -69,7 +69,6 @@ subroutine psb_cspins(nz,ia,ja,val,a,desc_a,info,rebuild,local)
integer(psb_ipk_), parameter :: relocsz=200 integer(psb_ipk_), parameter :: relocsz=200
logical :: rebuild_, local_ logical :: rebuild_, local_
integer(psb_ipk_), allocatable :: ila(:),jla(:) integer(psb_ipk_), allocatable :: ila(:),jla(:)
integer(psb_ipk_) :: ierr(5)
character(len=20) :: name character(len=20) :: name
info = psb_success_ info = psb_success_
@ -123,9 +122,8 @@ subroutine psb_cspins(nz,ia,ja,val,a,desc_a,info,rebuild,local)
else else
allocate(ila(nz),jla(nz),stat=info) allocate(ila(nz),jla(nz),stat=info)
if (info /= psb_success_) then if (info /= psb_success_) then
ierr(1) = info
call psb_errpush(psb_err_from_subroutine_ai_,name,& call psb_errpush(psb_err_from_subroutine_ai_,name,&
& a_err='allocate',i_err=ierr) & a_err='allocate',i_err=(/info/))
goto 9999 goto 9999
end if end if
@ -134,9 +132,8 @@ subroutine psb_cspins(nz,ia,ja,val,a,desc_a,info,rebuild,local)
& mask=(ila(1:nz)>0)) & mask=(ila(1:nz)>0))
if (info /= psb_success_) then if (info /= psb_success_) then
ierr(1) = info
call psb_errpush(psb_err_from_subroutine_ai_,name,& 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 goto 9999
end if end if
nrow = desc_a%get_local_rows() 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() ncol = desc_a%get_local_cols()
allocate(ila(nz),jla(nz),stat=info) allocate(ila(nz),jla(nz),stat=info)
if (info /= psb_success_) then if (info /= psb_success_) then
ierr(1) = info
call psb_errpush(psb_err_from_subroutine_ai_,name,& call psb_errpush(psb_err_from_subroutine_ai_,name,&
& a_err='allocate',i_err=ierr) & a_err='allocate',i_err=(/info/))
goto 9999 goto 9999
end if end if
if (local_) then 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. logical, parameter :: debug=.false.
integer(psb_ipk_), parameter :: relocsz=200 integer(psb_ipk_), parameter :: relocsz=200
integer(psb_ipk_), allocatable :: ila(:),jla(:) integer(psb_ipk_), allocatable :: ila(:),jla(:)
integer(psb_ipk_) :: ierr(5)
character(len=20) :: name character(len=20) :: name
info = psb_success_ 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) allocate(ila(nz),jla(nz),stat=info)
if (info /= psb_success_) then if (info /= psb_success_) then
ierr(1) = info
call psb_errpush(psb_err_from_subroutine_ai_,name,& call psb_errpush(psb_err_from_subroutine_ai_,name,&
& a_err='allocate',i_err=ierr) & a_err='allocate',i_err=(/info/))
goto 9999 goto 9999
end if 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)) & mask=(ila(1:nz)>0))
if (psb_errstatus_fatal()) then if (psb_errstatus_fatal()) then
ierr(1) = info
call psb_errpush(psb_err_from_subroutine_ai_,name,& 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 goto 9999
end if end if
@ -336,7 +329,6 @@ subroutine psb_cspins_v(nz,ia,ja,val,a,desc_a,info,rebuild,local)
logical :: rebuild_, local_ logical :: rebuild_, local_
integer(psb_ipk_), allocatable :: ila(:),jla(:) integer(psb_ipk_), allocatable :: ila(:),jla(:)
real(psb_dpk_) :: t1,t2,t3,tcnv,tcsput real(psb_dpk_) :: t1,t2,t3,tcnv,tcsput
integer(psb_ipk_) :: ierr(5)
character(len=20) :: name character(len=20) :: name
info = psb_success_ info = psb_success_
@ -390,9 +382,8 @@ subroutine psb_cspins_v(nz,ia,ja,val,a,desc_a,info,rebuild,local)
else else
allocate(ila(nz),jla(nz),stat=info) allocate(ila(nz),jla(nz),stat=info)
if (info /= psb_success_) then if (info /= psb_success_) then
ierr(1) = info
call psb_errpush(psb_err_from_subroutine_ai_,name,& call psb_errpush(psb_err_from_subroutine_ai_,name,&
& a_err='allocate',i_err=ierr) & a_err='allocate',i_err=(/info/))
goto 9999 goto 9999
end if end if
if (ia%is_dev()) call ia%sync() 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)) 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 if (info /= psb_success_) then
ierr(1) = info
call psb_errpush(psb_err_from_subroutine_ai_,name,& 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 goto 9999
end if end if
nrow = desc_a%get_local_rows() 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() ncol = desc_a%get_local_cols()
allocate(ila(nz),jla(nz),stat=info) allocate(ila(nz),jla(nz),stat=info)
if (info /= psb_success_) then if (info /= psb_success_) then
ierr(1) = info
call psb_errpush(psb_err_from_subroutine_ai_,name,& call psb_errpush(psb_err_from_subroutine_ai_,name,&
& a_err='allocate',i_err=ierr) & a_err='allocate',i_err=(/info/))
goto 9999 goto 9999
end if end if
if (ia%is_dev()) call ia%sync() if (ia%is_dev()) call ia%sync()

5
base/tools/psb_csprn.f90
Unescape Escape View File

@ -53,15 +53,12 @@ Subroutine psb_csprn(a, desc_a,info,clear)
logical, intent(in), optional :: clear logical, intent(in), optional :: clear
!locals !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_) :: debug_level, debug_unit
integer(psb_ipk_) :: int_err(5)
character(len=20) :: name character(len=20) :: name
logical :: clear_ logical :: clear_
info = psb_success_ info = psb_success_
err = 0
int_err(1)=0
name = 'psb_csprn' name = 'psb_csprn'
call psb_erractionsave(err_act) call psb_erractionsave(err_act)
debug_unit = psb_get_debug_unit() debug_unit = psb_get_debug_unit()

9
base/tools/psb_dasb.f90
Unescape Escape View File

@ -54,7 +54,7 @@ subroutine psb_dasb_vect(x, desc_a, info, mold, scratch)
! local variables ! local variables
integer(psb_ipk_) :: ictxt,np,me 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_ logical :: scratch_
integer(psb_ipk_) :: debug_level, debug_unit integer(psb_ipk_) :: debug_level, debug_unit
character(len=20) :: name,ch_err character(len=20) :: name,ch_err
@ -62,7 +62,6 @@ subroutine psb_dasb_vect(x, desc_a, info, mold, scratch)
info = psb_success_ info = psb_success_
if (psb_errstatus_fatal()) return if (psb_errstatus_fatal()) return
int_err(1) = 0
name = 'psb_dgeasb_v' name = 'psb_dgeasb_v'
ictxt = desc_a%get_context() ictxt = desc_a%get_context()
@ -128,7 +127,7 @@ subroutine psb_dasb_vect_r2(x, desc_a, info, mold, scratch)
! local variables ! local variables
integer(psb_ipk_) :: ictxt,np,me, i, n 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_ logical :: scratch_
integer(psb_ipk_) :: debug_level, debug_unit integer(psb_ipk_) :: debug_level, debug_unit
character(len=20) :: name,ch_err character(len=20) :: name,ch_err
@ -136,7 +135,6 @@ subroutine psb_dasb_vect_r2(x, desc_a, info, mold, scratch)
info = psb_success_ info = psb_success_
if (psb_errstatus_fatal()) return if (psb_errstatus_fatal()) return
int_err(1) = 0
name = 'psb_dgeasb_v' name = 'psb_dgeasb_v'
ictxt = desc_a%get_context() ictxt = desc_a%get_context()
@ -211,7 +209,7 @@ subroutine psb_dasb_multivect(x, desc_a, info, mold, scratch,n)
! local variables ! local variables
integer(psb_ipk_) :: ictxt,np,me 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_ logical :: scratch_
integer(psb_ipk_) :: debug_level, debug_unit 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_ info = psb_success_
if (psb_errstatus_fatal()) return if (psb_errstatus_fatal()) return
int_err(1) = 0
name = 'psb_dgeasb' name = 'psb_dgeasb'
ictxt = desc_a%get_context() ictxt = desc_a%get_context()

3
base/tools/psb_dasb_a.f90
Unescape Escape View File

@ -187,13 +187,12 @@ subroutine psb_dasbv(x, desc_a, info, scratch)
! local variables ! local variables
integer(psb_ipk_) :: ictxt,np,me 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 integer(psb_ipk_) :: debug_level, debug_unit
logical :: scratch_ logical :: scratch_
character(len=20) :: name,ch_err character(len=20) :: name,ch_err
info = psb_success_ info = psb_success_
int_err(1) = 0
name = 'psb_dgeasb_v' name = 'psb_dgeasb_v'
ictxt = desc_a%get_context() ictxt = desc_a%get_context()

2
base/tools/psb_dspasb.f90
Unescape Escape View File

@ -62,14 +62,12 @@ subroutine psb_dspasb(a,desc_a, info, afmt, upd, dupl, mold)
character(len=*), optional, intent(in) :: afmt character(len=*), optional, intent(in) :: afmt
class(psb_d_base_sparse_mat), intent(in), optional :: mold class(psb_d_base_sparse_mat), intent(in), optional :: mold
!....Locals.... !....Locals....
integer(psb_ipk_) :: int_err(5)
integer(psb_ipk_) :: ictxt,np,me, err_act integer(psb_ipk_) :: ictxt,np,me, err_act
integer(psb_ipk_) :: n_row,n_col integer(psb_ipk_) :: n_row,n_col
integer(psb_ipk_) :: debug_level, debug_unit integer(psb_ipk_) :: debug_level, debug_unit
character(len=20) :: name, ch_err character(len=20) :: name, ch_err
info = psb_success_ info = psb_success_
int_err(1)=0
name = 'psb_spasb' name = 'psb_spasb'
call psb_erractionsave(err_act) call psb_erractionsave(err_act)
debug_unit = psb_get_debug_unit() debug_unit = psb_get_debug_unit()

27
base/tools/psb_dspins.f90
Unescape Escape View File

@ -69,7 +69,6 @@ subroutine psb_dspins(nz,ia,ja,val,a,desc_a,info,rebuild,local)
integer(psb_ipk_), parameter :: relocsz=200 integer(psb_ipk_), parameter :: relocsz=200
logical :: rebuild_, local_ logical :: rebuild_, local_
integer(psb_ipk_), allocatable :: ila(:),jla(:) integer(psb_ipk_), allocatable :: ila(:),jla(:)
integer(psb_ipk_) :: ierr(5)
character(len=20) :: name character(len=20) :: name
info = psb_success_ info = psb_success_
@ -123,9 +122,8 @@ subroutine psb_dspins(nz,ia,ja,val,a,desc_a,info,rebuild,local)
else else
allocate(ila(nz),jla(nz),stat=info) allocate(ila(nz),jla(nz),stat=info)
if (info /= psb_success_) then if (info /= psb_success_) then
ierr(1) = info
call psb_errpush(psb_err_from_subroutine_ai_,name,& call psb_errpush(psb_err_from_subroutine_ai_,name,&
& a_err='allocate',i_err=ierr) & a_err='allocate',i_err=(/info/))
goto 9999 goto 9999
end if end if
@ -134,9 +132,8 @@ subroutine psb_dspins(nz,ia,ja,val,a,desc_a,info,rebuild,local)
& mask=(ila(1:nz)>0)) & mask=(ila(1:nz)>0))
if (info /= psb_success_) then if (info /= psb_success_) then
ierr(1) = info
call psb_errpush(psb_err_from_subroutine_ai_,name,& 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 goto 9999
end if end if
nrow = desc_a%get_local_rows() 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() ncol = desc_a%get_local_cols()
allocate(ila(nz),jla(nz),stat=info) allocate(ila(nz),jla(nz),stat=info)
if (info /= psb_success_) then if (info /= psb_success_) then
ierr(1) = info
call psb_errpush(psb_err_from_subroutine_ai_,name,& call psb_errpush(psb_err_from_subroutine_ai_,name,&
& a_err='allocate',i_err=ierr) & a_err='allocate',i_err=(/info/))
goto 9999 goto 9999
end if end if
if (local_) then 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. logical, parameter :: debug=.false.
integer(psb_ipk_), parameter :: relocsz=200 integer(psb_ipk_), parameter :: relocsz=200
integer(psb_ipk_), allocatable :: ila(:),jla(:) integer(psb_ipk_), allocatable :: ila(:),jla(:)
integer(psb_ipk_) :: ierr(5)
character(len=20) :: name character(len=20) :: name
info = psb_success_ 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) allocate(ila(nz),jla(nz),stat=info)
if (info /= psb_success_) then if (info /= psb_success_) then
ierr(1) = info
call psb_errpush(psb_err_from_subroutine_ai_,name,& call psb_errpush(psb_err_from_subroutine_ai_,name,&
& a_err='allocate',i_err=ierr) & a_err='allocate',i_err=(/info/))
goto 9999 goto 9999
end if 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)) & mask=(ila(1:nz)>0))
if (psb_errstatus_fatal()) then if (psb_errstatus_fatal()) then
ierr(1) = info
call psb_errpush(psb_err_from_subroutine_ai_,name,& 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 goto 9999
end if end if
@ -336,7 +329,6 @@ subroutine psb_dspins_v(nz,ia,ja,val,a,desc_a,info,rebuild,local)
logical :: rebuild_, local_ logical :: rebuild_, local_
integer(psb_ipk_), allocatable :: ila(:),jla(:) integer(psb_ipk_), allocatable :: ila(:),jla(:)
real(psb_dpk_) :: t1,t2,t3,tcnv,tcsput real(psb_dpk_) :: t1,t2,t3,tcnv,tcsput
integer(psb_ipk_) :: ierr(5)
character(len=20) :: name character(len=20) :: name
info = psb_success_ info = psb_success_
@ -390,9 +382,8 @@ subroutine psb_dspins_v(nz,ia,ja,val,a,desc_a,info,rebuild,local)
else else
allocate(ila(nz),jla(nz),stat=info) allocate(ila(nz),jla(nz),stat=info)
if (info /= psb_success_) then if (info /= psb_success_) then
ierr(1) = info
call psb_errpush(psb_err_from_subroutine_ai_,name,& call psb_errpush(psb_err_from_subroutine_ai_,name,&
& a_err='allocate',i_err=ierr) & a_err='allocate',i_err=(/info/))
goto 9999 goto 9999
end if end if
if (ia%is_dev()) call ia%sync() 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)) 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 if (info /= psb_success_) then
ierr(1) = info
call psb_errpush(psb_err_from_subroutine_ai_,name,& 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 goto 9999
end if end if
nrow = desc_a%get_local_rows() 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() ncol = desc_a%get_local_cols()
allocate(ila(nz),jla(nz),stat=info) allocate(ila(nz),jla(nz),stat=info)
if (info /= psb_success_) then if (info /= psb_success_) then
ierr(1) = info
call psb_errpush(psb_err_from_subroutine_ai_,name,& call psb_errpush(psb_err_from_subroutine_ai_,name,&
& a_err='allocate',i_err=ierr) & a_err='allocate',i_err=(/info/))
goto 9999 goto 9999
end if end if
if (ia%is_dev()) call ia%sync() if (ia%is_dev()) call ia%sync()

5
base/tools/psb_dsprn.f90
Unescape Escape View File

@ -53,15 +53,12 @@ Subroutine psb_dsprn(a, desc_a,info,clear)
logical, intent(in), optional :: clear logical, intent(in), optional :: clear
!locals !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_) :: debug_level, debug_unit
integer(psb_ipk_) :: int_err(5)
character(len=20) :: name character(len=20) :: name
logical :: clear_ logical :: clear_
info = psb_success_ info = psb_success_
err = 0
int_err(1)=0
name = 'psb_dsprn' name = 'psb_dsprn'
call psb_erractionsave(err_act) call psb_erractionsave(err_act)
debug_unit = psb_get_debug_unit() debug_unit = psb_get_debug_unit()

3
base/tools/psb_easb_a.f90
Unescape Escape View File

@ -187,13 +187,12 @@ subroutine psb_easbv(x, desc_a, info, scratch)
! local variables ! local variables
integer(psb_ipk_) :: ictxt,np,me 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 integer(psb_ipk_) :: debug_level, debug_unit
logical :: scratch_ logical :: scratch_
character(len=20) :: name,ch_err character(len=20) :: name,ch_err
info = psb_success_ info = psb_success_
int_err(1) = 0
name = 'psb_egeasb_v' name = 'psb_egeasb_v'
ictxt = desc_a%get_context() ictxt = desc_a%get_context()

9
base/tools/psb_iasb.f90
Unescape Escape View File

@ -54,7 +54,7 @@ subroutine psb_iasb_vect(x, desc_a, info, mold, scratch)
! local variables ! local variables
integer(psb_ipk_) :: ictxt,np,me 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_ logical :: scratch_
integer(psb_ipk_) :: debug_level, debug_unit integer(psb_ipk_) :: debug_level, debug_unit
character(len=20) :: name,ch_err character(len=20) :: name,ch_err
@ -62,7 +62,6 @@ subroutine psb_iasb_vect(x, desc_a, info, mold, scratch)
info = psb_success_ info = psb_success_
if (psb_errstatus_fatal()) return if (psb_errstatus_fatal()) return
int_err(1) = 0
name = 'psb_igeasb_v' name = 'psb_igeasb_v'
ictxt = desc_a%get_context() ictxt = desc_a%get_context()
@ -128,7 +127,7 @@ subroutine psb_iasb_vect_r2(x, desc_a, info, mold, scratch)
! local variables ! local variables
integer(psb_ipk_) :: ictxt,np,me, i, n 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_ logical :: scratch_
integer(psb_ipk_) :: debug_level, debug_unit integer(psb_ipk_) :: debug_level, debug_unit
character(len=20) :: name,ch_err character(len=20) :: name,ch_err
@ -136,7 +135,6 @@ subroutine psb_iasb_vect_r2(x, desc_a, info, mold, scratch)
info = psb_success_ info = psb_success_
if (psb_errstatus_fatal()) return if (psb_errstatus_fatal()) return
int_err(1) = 0
name = 'psb_igeasb_v' name = 'psb_igeasb_v'
ictxt = desc_a%get_context() ictxt = desc_a%get_context()
@ -211,7 +209,7 @@ subroutine psb_iasb_multivect(x, desc_a, info, mold, scratch,n)
! local variables ! local variables
integer(psb_ipk_) :: ictxt,np,me 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_ logical :: scratch_
integer(psb_ipk_) :: debug_level, debug_unit 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_ info = psb_success_
if (psb_errstatus_fatal()) return if (psb_errstatus_fatal()) return
int_err(1) = 0
name = 'psb_igeasb' name = 'psb_igeasb'
ictxt = desc_a%get_context() ictxt = desc_a%get_context()

9
base/tools/psb_lasb.f90
Unescape Escape View File

@ -54,7 +54,7 @@ subroutine psb_lasb_vect(x, desc_a, info, mold, scratch)
! local variables ! local variables
integer(psb_ipk_) :: ictxt,np,me 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_ logical :: scratch_
integer(psb_ipk_) :: debug_level, debug_unit integer(psb_ipk_) :: debug_level, debug_unit
character(len=20) :: name,ch_err character(len=20) :: name,ch_err
@ -62,7 +62,6 @@ subroutine psb_lasb_vect(x, desc_a, info, mold, scratch)
info = psb_success_ info = psb_success_
if (psb_errstatus_fatal()) return if (psb_errstatus_fatal()) return
int_err(1) = 0
name = 'psb_lgeasb_v' name = 'psb_lgeasb_v'
ictxt = desc_a%get_context() ictxt = desc_a%get_context()
@ -128,7 +127,7 @@ subroutine psb_lasb_vect_r2(x, desc_a, info, mold, scratch)
! local variables ! local variables
integer(psb_ipk_) :: ictxt,np,me, i, n 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_ logical :: scratch_
integer(psb_ipk_) :: debug_level, debug_unit integer(psb_ipk_) :: debug_level, debug_unit
character(len=20) :: name,ch_err character(len=20) :: name,ch_err
@ -136,7 +135,6 @@ subroutine psb_lasb_vect_r2(x, desc_a, info, mold, scratch)
info = psb_success_ info = psb_success_
if (psb_errstatus_fatal()) return if (psb_errstatus_fatal()) return
int_err(1) = 0
name = 'psb_lgeasb_v' name = 'psb_lgeasb_v'
ictxt = desc_a%get_context() ictxt = desc_a%get_context()
@ -211,7 +209,7 @@ subroutine psb_lasb_multivect(x, desc_a, info, mold, scratch,n)
! local variables ! local variables
integer(psb_ipk_) :: ictxt,np,me 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_ logical :: scratch_
integer(psb_ipk_) :: debug_level, debug_unit 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_ info = psb_success_
if (psb_errstatus_fatal()) return if (psb_errstatus_fatal()) return
int_err(1) = 0
name = 'psb_lgeasb' name = 'psb_lgeasb'
ictxt = desc_a%get_context() ictxt = desc_a%get_context()

3
base/tools/psb_masb_a.f90
Unescape Escape View File

@ -187,13 +187,12 @@ subroutine psb_masbv(x, desc_a, info, scratch)
! local variables ! local variables
integer(psb_ipk_) :: ictxt,np,me 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 integer(psb_ipk_) :: debug_level, debug_unit
logical :: scratch_ logical :: scratch_
character(len=20) :: name,ch_err character(len=20) :: name,ch_err
info = psb_success_ info = psb_success_
int_err(1) = 0
name = 'psb_mgeasb_v' name = 'psb_mgeasb_v'
ictxt = desc_a%get_context() ictxt = desc_a%get_context()

9
base/tools/psb_sasb.f90
Unescape Escape View File

@ -54,7 +54,7 @@ subroutine psb_sasb_vect(x, desc_a, info, mold, scratch)
! local variables ! local variables
integer(psb_ipk_) :: ictxt,np,me 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_ logical :: scratch_
integer(psb_ipk_) :: debug_level, debug_unit integer(psb_ipk_) :: debug_level, debug_unit
character(len=20) :: name,ch_err character(len=20) :: name,ch_err
@ -62,7 +62,6 @@ subroutine psb_sasb_vect(x, desc_a, info, mold, scratch)
info = psb_success_ info = psb_success_
if (psb_errstatus_fatal()) return if (psb_errstatus_fatal()) return
int_err(1) = 0
name = 'psb_sgeasb_v' name = 'psb_sgeasb_v'
ictxt = desc_a%get_context() ictxt = desc_a%get_context()
@ -128,7 +127,7 @@ subroutine psb_sasb_vect_r2(x, desc_a, info, mold, scratch)
! local variables ! local variables
integer(psb_ipk_) :: ictxt,np,me, i, n 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_ logical :: scratch_
integer(psb_ipk_) :: debug_level, debug_unit integer(psb_ipk_) :: debug_level, debug_unit
character(len=20) :: name,ch_err character(len=20) :: name,ch_err
@ -136,7 +135,6 @@ subroutine psb_sasb_vect_r2(x, desc_a, info, mold, scratch)
info = psb_success_ info = psb_success_
if (psb_errstatus_fatal()) return if (psb_errstatus_fatal()) return
int_err(1) = 0
name = 'psb_sgeasb_v' name = 'psb_sgeasb_v'
ictxt = desc_a%get_context() ictxt = desc_a%get_context()
@ -211,7 +209,7 @@ subroutine psb_sasb_multivect(x, desc_a, info, mold, scratch,n)
! local variables ! local variables
integer(psb_ipk_) :: ictxt,np,me 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_ logical :: scratch_
integer(psb_ipk_) :: debug_level, debug_unit 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_ info = psb_success_
if (psb_errstatus_fatal()) return if (psb_errstatus_fatal()) return
int_err(1) = 0
name = 'psb_sgeasb' name = 'psb_sgeasb'
ictxt = desc_a%get_context() ictxt = desc_a%get_context()

3
base/tools/psb_sasb_a.f90
Unescape Escape View File

@ -187,13 +187,12 @@ subroutine psb_sasbv(x, desc_a, info, scratch)
! local variables ! local variables
integer(psb_ipk_) :: ictxt,np,me 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 integer(psb_ipk_) :: debug_level, debug_unit
logical :: scratch_ logical :: scratch_
character(len=20) :: name,ch_err character(len=20) :: name,ch_err
info = psb_success_ info = psb_success_
int_err(1) = 0
name = 'psb_sgeasb_v' name = 'psb_sgeasb_v'
ictxt = desc_a%get_context() ictxt = desc_a%get_context()

2
base/tools/psb_sspasb.f90
Unescape Escape View File

@ -62,14 +62,12 @@ subroutine psb_sspasb(a,desc_a, info, afmt, upd, dupl, mold)
character(len=*), optional, intent(in) :: afmt character(len=*), optional, intent(in) :: afmt
class(psb_s_base_sparse_mat), intent(in), optional :: mold class(psb_s_base_sparse_mat), intent(in), optional :: mold
!....Locals.... !....Locals....
integer(psb_ipk_) :: int_err(5)
integer(psb_ipk_) :: ictxt,np,me, err_act integer(psb_ipk_) :: ictxt,np,me, err_act
integer(psb_ipk_) :: n_row,n_col integer(psb_ipk_) :: n_row,n_col
integer(psb_ipk_) :: debug_level, debug_unit integer(psb_ipk_) :: debug_level, debug_unit
character(len=20) :: name, ch_err character(len=20) :: name, ch_err
info = psb_success_ info = psb_success_
int_err(1)=0
name = 'psb_spasb' name = 'psb_spasb'
call psb_erractionsave(err_act) call psb_erractionsave(err_act)
debug_unit = psb_get_debug_unit() debug_unit = psb_get_debug_unit()

27
base/tools/psb_sspins.f90
Unescape Escape View File

@ -69,7 +69,6 @@ subroutine psb_sspins(nz,ia,ja,val,a,desc_a,info,rebuild,local)
integer(psb_ipk_), parameter :: relocsz=200 integer(psb_ipk_), parameter :: relocsz=200
logical :: rebuild_, local_ logical :: rebuild_, local_
integer(psb_ipk_), allocatable :: ila(:),jla(:) integer(psb_ipk_), allocatable :: ila(:),jla(:)
integer(psb_ipk_) :: ierr(5)
character(len=20) :: name character(len=20) :: name
info = psb_success_ info = psb_success_
@ -123,9 +122,8 @@ subroutine psb_sspins(nz,ia,ja,val,a,desc_a,info,rebuild,local)
else else
allocate(ila(nz),jla(nz),stat=info) allocate(ila(nz),jla(nz),stat=info)
if (info /= psb_success_) then if (info /= psb_success_) then
ierr(1) = info
call psb_errpush(psb_err_from_subroutine_ai_,name,& call psb_errpush(psb_err_from_subroutine_ai_,name,&
& a_err='allocate',i_err=ierr) & a_err='allocate',i_err=(/info/))
goto 9999 goto 9999
end if end if
@ -134,9 +132,8 @@ subroutine psb_sspins(nz,ia,ja,val,a,desc_a,info,rebuild,local)
& mask=(ila(1:nz)>0)) & mask=(ila(1:nz)>0))
if (info /= psb_success_) then if (info /= psb_success_) then
ierr(1) = info
call psb_errpush(psb_err_from_subroutine_ai_,name,& 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 goto 9999
end if end if
nrow = desc_a%get_local_rows() 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() ncol = desc_a%get_local_cols()
allocate(ila(nz),jla(nz),stat=info) allocate(ila(nz),jla(nz),stat=info)
if (info /= psb_success_) then if (info /= psb_success_) then
ierr(1) = info
call psb_errpush(psb_err_from_subroutine_ai_,name,& call psb_errpush(psb_err_from_subroutine_ai_,name,&
& a_err='allocate',i_err=ierr) & a_err='allocate',i_err=(/info/))
goto 9999 goto 9999
end if end if
if (local_) then 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. logical, parameter :: debug=.false.
integer(psb_ipk_), parameter :: relocsz=200 integer(psb_ipk_), parameter :: relocsz=200
integer(psb_ipk_), allocatable :: ila(:),jla(:) integer(psb_ipk_), allocatable :: ila(:),jla(:)
integer(psb_ipk_) :: ierr(5)
character(len=20) :: name character(len=20) :: name
info = psb_success_ 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) allocate(ila(nz),jla(nz),stat=info)
if (info /= psb_success_) then if (info /= psb_success_) then
ierr(1) = info
call psb_errpush(psb_err_from_subroutine_ai_,name,& call psb_errpush(psb_err_from_subroutine_ai_,name,&
& a_err='allocate',i_err=ierr) & a_err='allocate',i_err=(/info/))
goto 9999 goto 9999
end if 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)) & mask=(ila(1:nz)>0))
if (psb_errstatus_fatal()) then if (psb_errstatus_fatal()) then
ierr(1) = info
call psb_errpush(psb_err_from_subroutine_ai_,name,& 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 goto 9999
end if end if
@ -336,7 +329,6 @@ subroutine psb_sspins_v(nz,ia,ja,val,a,desc_a,info,rebuild,local)
logical :: rebuild_, local_ logical :: rebuild_, local_
integer(psb_ipk_), allocatable :: ila(:),jla(:) integer(psb_ipk_), allocatable :: ila(:),jla(:)
real(psb_dpk_) :: t1,t2,t3,tcnv,tcsput real(psb_dpk_) :: t1,t2,t3,tcnv,tcsput
integer(psb_ipk_) :: ierr(5)
character(len=20) :: name character(len=20) :: name
info = psb_success_ info = psb_success_
@ -390,9 +382,8 @@ subroutine psb_sspins_v(nz,ia,ja,val,a,desc_a,info,rebuild,local)
else else
allocate(ila(nz),jla(nz),stat=info) allocate(ila(nz),jla(nz),stat=info)
if (info /= psb_success_) then if (info /= psb_success_) then
ierr(1) = info
call psb_errpush(psb_err_from_subroutine_ai_,name,& call psb_errpush(psb_err_from_subroutine_ai_,name,&
& a_err='allocate',i_err=ierr) & a_err='allocate',i_err=(/info/))
goto 9999 goto 9999
end if end if
if (ia%is_dev()) call ia%sync() 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)) 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 if (info /= psb_success_) then
ierr(1) = info
call psb_errpush(psb_err_from_subroutine_ai_,name,& 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 goto 9999
end if end if
nrow = desc_a%get_local_rows() 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() ncol = desc_a%get_local_cols()
allocate(ila(nz),jla(nz),stat=info) allocate(ila(nz),jla(nz),stat=info)
if (info /= psb_success_) then if (info /= psb_success_) then
ierr(1) = info
call psb_errpush(psb_err_from_subroutine_ai_,name,& call psb_errpush(psb_err_from_subroutine_ai_,name,&
& a_err='allocate',i_err=ierr) & a_err='allocate',i_err=(/info/))
goto 9999 goto 9999
end if end if
if (ia%is_dev()) call ia%sync() if (ia%is_dev()) call ia%sync()

5
base/tools/psb_ssprn.f90
Unescape Escape View File

@ -53,15 +53,12 @@ Subroutine psb_ssprn(a, desc_a,info,clear)
logical, intent(in), optional :: clear logical, intent(in), optional :: clear
!locals !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_) :: debug_level, debug_unit
integer(psb_ipk_) :: int_err(5)
character(len=20) :: name character(len=20) :: name
logical :: clear_ logical :: clear_
info = psb_success_ info = psb_success_
err = 0
int_err(1)=0
name = 'psb_ssprn' name = 'psb_ssprn'
call psb_erractionsave(err_act) call psb_erractionsave(err_act)
debug_unit = psb_get_debug_unit() debug_unit = psb_get_debug_unit()

9
base/tools/psb_zasb.f90
Unescape Escape View File

@ -54,7 +54,7 @@ subroutine psb_zasb_vect(x, desc_a, info, mold, scratch)
! local variables ! local variables
integer(psb_ipk_) :: ictxt,np,me 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_ logical :: scratch_
integer(psb_ipk_) :: debug_level, debug_unit integer(psb_ipk_) :: debug_level, debug_unit
character(len=20) :: name,ch_err character(len=20) :: name,ch_err
@ -62,7 +62,6 @@ subroutine psb_zasb_vect(x, desc_a, info, mold, scratch)
info = psb_success_ info = psb_success_
if (psb_errstatus_fatal()) return if (psb_errstatus_fatal()) return
int_err(1) = 0
name = 'psb_zgeasb_v' name = 'psb_zgeasb_v'
ictxt = desc_a%get_context() ictxt = desc_a%get_context()
@ -128,7 +127,7 @@ subroutine psb_zasb_vect_r2(x, desc_a, info, mold, scratch)
! local variables ! local variables
integer(psb_ipk_) :: ictxt,np,me, i, n 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_ logical :: scratch_
integer(psb_ipk_) :: debug_level, debug_unit integer(psb_ipk_) :: debug_level, debug_unit
character(len=20) :: name,ch_err character(len=20) :: name,ch_err
@ -136,7 +135,6 @@ subroutine psb_zasb_vect_r2(x, desc_a, info, mold, scratch)
info = psb_success_ info = psb_success_
if (psb_errstatus_fatal()) return if (psb_errstatus_fatal()) return
int_err(1) = 0
name = 'psb_zgeasb_v' name = 'psb_zgeasb_v'
ictxt = desc_a%get_context() ictxt = desc_a%get_context()
@ -211,7 +209,7 @@ subroutine psb_zasb_multivect(x, desc_a, info, mold, scratch,n)
! local variables ! local variables
integer(psb_ipk_) :: ictxt,np,me 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_ logical :: scratch_
integer(psb_ipk_) :: debug_level, debug_unit 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_ info = psb_success_
if (psb_errstatus_fatal()) return if (psb_errstatus_fatal()) return
int_err(1) = 0
name = 'psb_zgeasb' name = 'psb_zgeasb'
ictxt = desc_a%get_context() ictxt = desc_a%get_context()

3
base/tools/psb_zasb_a.f90
Unescape Escape View File

@ -187,13 +187,12 @@ subroutine psb_zasbv(x, desc_a, info, scratch)
! local variables ! local variables
integer(psb_ipk_) :: ictxt,np,me 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 integer(psb_ipk_) :: debug_level, debug_unit
logical :: scratch_ logical :: scratch_
character(len=20) :: name,ch_err character(len=20) :: name,ch_err
info = psb_success_ info = psb_success_
int_err(1) = 0
name = 'psb_zgeasb_v' name = 'psb_zgeasb_v'
ictxt = desc_a%get_context() ictxt = desc_a%get_context()

2
base/tools/psb_zspasb.f90
Unescape Escape View File

@ -62,14 +62,12 @@ subroutine psb_zspasb(a,desc_a, info, afmt, upd, dupl, mold)
character(len=*), optional, intent(in) :: afmt character(len=*), optional, intent(in) :: afmt
class(psb_z_base_sparse_mat), intent(in), optional :: mold class(psb_z_base_sparse_mat), intent(in), optional :: mold
!....Locals.... !....Locals....
integer(psb_ipk_) :: int_err(5)
integer(psb_ipk_) :: ictxt,np,me, err_act integer(psb_ipk_) :: ictxt,np,me, err_act
integer(psb_ipk_) :: n_row,n_col integer(psb_ipk_) :: n_row,n_col
integer(psb_ipk_) :: debug_level, debug_unit integer(psb_ipk_) :: debug_level, debug_unit
character(len=20) :: name, ch_err character(len=20) :: name, ch_err
info = psb_success_ info = psb_success_
int_err(1)=0
name = 'psb_spasb' name = 'psb_spasb'
call psb_erractionsave(err_act) call psb_erractionsave(err_act)
debug_unit = psb_get_debug_unit() debug_unit = psb_get_debug_unit()

27
base/tools/psb_zspins.f90
Unescape Escape View File

@ -69,7 +69,6 @@ subroutine psb_zspins(nz,ia,ja,val,a,desc_a,info,rebuild,local)
integer(psb_ipk_), parameter :: relocsz=200 integer(psb_ipk_), parameter :: relocsz=200
logical :: rebuild_, local_ logical :: rebuild_, local_
integer(psb_ipk_), allocatable :: ila(:),jla(:) integer(psb_ipk_), allocatable :: ila(:),jla(:)
integer(psb_ipk_) :: ierr(5)
character(len=20) :: name character(len=20) :: name
info = psb_success_ info = psb_success_
@ -123,9 +122,8 @@ subroutine psb_zspins(nz,ia,ja,val,a,desc_a,info,rebuild,local)
else else
allocate(ila(nz),jla(nz),stat=info) allocate(ila(nz),jla(nz),stat=info)
if (info /= psb_success_) then if (info /= psb_success_) then
ierr(1) = info
call psb_errpush(psb_err_from_subroutine_ai_,name,& call psb_errpush(psb_err_from_subroutine_ai_,name,&
& a_err='allocate',i_err=ierr) & a_err='allocate',i_err=(/info/))
goto 9999 goto 9999
end if end if
@ -134,9 +132,8 @@ subroutine psb_zspins(nz,ia,ja,val,a,desc_a,info,rebuild,local)
& mask=(ila(1:nz)>0)) & mask=(ila(1:nz)>0))
if (info /= psb_success_) then if (info /= psb_success_) then
ierr(1) = info
call psb_errpush(psb_err_from_subroutine_ai_,name,& 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 goto 9999
end if end if
nrow = desc_a%get_local_rows() 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() ncol = desc_a%get_local_cols()
allocate(ila(nz),jla(nz),stat=info) allocate(ila(nz),jla(nz),stat=info)
if (info /= psb_success_) then if (info /= psb_success_) then
ierr(1) = info
call psb_errpush(psb_err_from_subroutine_ai_,name,& call psb_errpush(psb_err_from_subroutine_ai_,name,&
& a_err='allocate',i_err=ierr) & a_err='allocate',i_err=(/info/))
goto 9999 goto 9999
end if end if
if (local_) then 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. logical, parameter :: debug=.false.
integer(psb_ipk_), parameter :: relocsz=200 integer(psb_ipk_), parameter :: relocsz=200
integer(psb_ipk_), allocatable :: ila(:),jla(:) integer(psb_ipk_), allocatable :: ila(:),jla(:)
integer(psb_ipk_) :: ierr(5)
character(len=20) :: name character(len=20) :: name
info = psb_success_ 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) allocate(ila(nz),jla(nz),stat=info)
if (info /= psb_success_) then if (info /= psb_success_) then
ierr(1) = info
call psb_errpush(psb_err_from_subroutine_ai_,name,& call psb_errpush(psb_err_from_subroutine_ai_,name,&
& a_err='allocate',i_err=ierr) & a_err='allocate',i_err=(/info/))
goto 9999 goto 9999
end if 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)) & mask=(ila(1:nz)>0))
if (psb_errstatus_fatal()) then if (psb_errstatus_fatal()) then
ierr(1) = info
call psb_errpush(psb_err_from_subroutine_ai_,name,& 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 goto 9999
end if end if
@ -336,7 +329,6 @@ subroutine psb_zspins_v(nz,ia,ja,val,a,desc_a,info,rebuild,local)
logical :: rebuild_, local_ logical :: rebuild_, local_
integer(psb_ipk_), allocatable :: ila(:),jla(:) integer(psb_ipk_), allocatable :: ila(:),jla(:)
real(psb_dpk_) :: t1,t2,t3,tcnv,tcsput real(psb_dpk_) :: t1,t2,t3,tcnv,tcsput
integer(psb_ipk_) :: ierr(5)
character(len=20) :: name character(len=20) :: name
info = psb_success_ info = psb_success_
@ -390,9 +382,8 @@ subroutine psb_zspins_v(nz,ia,ja,val,a,desc_a,info,rebuild,local)
else else
allocate(ila(nz),jla(nz),stat=info) allocate(ila(nz),jla(nz),stat=info)
if (info /= psb_success_) then if (info /= psb_success_) then
ierr(1) = info
call psb_errpush(psb_err_from_subroutine_ai_,name,& call psb_errpush(psb_err_from_subroutine_ai_,name,&
& a_err='allocate',i_err=ierr) & a_err='allocate',i_err=(/info/))
goto 9999 goto 9999
end if end if
if (ia%is_dev()) call ia%sync() 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)) 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 if (info /= psb_success_) then
ierr(1) = info
call psb_errpush(psb_err_from_subroutine_ai_,name,& 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 goto 9999
end if end if
nrow = desc_a%get_local_rows() 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() ncol = desc_a%get_local_cols()
allocate(ila(nz),jla(nz),stat=info) allocate(ila(nz),jla(nz),stat=info)
if (info /= psb_success_) then if (info /= psb_success_) then
ierr(1) = info
call psb_errpush(psb_err_from_subroutine_ai_,name,& call psb_errpush(psb_err_from_subroutine_ai_,name,&
& a_err='allocate',i_err=ierr) & a_err='allocate',i_err=(/info/))
goto 9999 goto 9999
end if end if
if (ia%is_dev()) call ia%sync() if (ia%is_dev()) call ia%sync()

5
base/tools/psb_zsprn.f90
Unescape Escape View File

@ -53,15 +53,12 @@ Subroutine psb_zsprn(a, desc_a,info,clear)
logical, intent(in), optional :: clear logical, intent(in), optional :: clear
!locals !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_) :: debug_level, debug_unit
integer(psb_ipk_) :: int_err(5)
character(len=20) :: name character(len=20) :: name
logical :: clear_ logical :: clear_
info = psb_success_ info = psb_success_
err = 0
int_err(1)=0
name = 'psb_zsprn' name = 'psb_zsprn'
call psb_erractionsave(err_act) call psb_erractionsave(err_act)
debug_unit = psb_get_debug_unit() debug_unit = psb_get_debug_unit()

10
krylov/psb_c_krylov_conv_mod.f90
Unescape Escape View File

@ -61,7 +61,7 @@ contains
type(psb_itconv_type) :: stopdat type(psb_itconv_type) :: stopdat
integer(psb_ipk_), intent(out) :: info 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 character(len=20) :: name
complex(psb_spk_), allocatable :: r(:) complex(psb_spk_), allocatable :: r(:)
@ -98,8 +98,7 @@ contains
call psb_gefree(r,desc_a,info) call psb_gefree(r,desc_a,info)
case default case default
info=psb_err_invalid_istop_ info=psb_err_invalid_istop_
ierr(1) = stopc call psb_errpush(info,name,i_err=(/stopc/))
call psb_errpush(info,name,i_err=ierr)
goto 9999 goto 9999
end select end select
if (info /= psb_success_) then if (info /= psb_success_) then
@ -213,7 +212,7 @@ contains
type(psb_itconv_type) :: stopdat type(psb_itconv_type) :: stopdat
integer(psb_ipk_), intent(out) :: info 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 character(len=20) :: name
type(psb_c_vect_type) :: r type(psb_c_vect_type) :: r
@ -250,8 +249,7 @@ contains
call psb_gefree(r,desc_a,info) call psb_gefree(r,desc_a,info)
case default case default
info=psb_err_invalid_istop_ info=psb_err_invalid_istop_
ierr(1) = stopc call psb_errpush(info,name,i_err=(/stopc/))
call psb_errpush(info,name,i_err=ierr)
goto 9999 goto 9999
end select end select
if (info /= psb_success_) then if (info /= psb_success_) then

4
krylov/psb_cbicg.f90
Unescape Escape View File

@ -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), allocatable, target :: wwrk(:)
type(psb_c_vect_type), pointer :: ww, q, r, p,& type(psb_c_vect_type), pointer :: ww, q, r, p,&
& zt, pt, z, rt, qt & zt, pt, z, rt, qt
integer(psb_ipk_) :: int_err(5)
integer(psb_ipk_) :: itmax_, naux, it, itrace_,& integer(psb_ipk_) :: itmax_, naux, it, itrace_,&
& n_row, n_col, istop_, err_act & n_row, n_col, istop_, err_act
integer(psb_lpk_) :: mglob 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 if ((istop_ < 1 ).or.(istop_ > 2 ) ) then
info=psb_err_invalid_istop_ info=psb_err_invalid_istop_
int_err=istop_
err=info err=info
call psb_errpush(info,name,i_err=int_err) call psb_errpush(info,name,i_err=(/istop_/))
goto 9999 goto 9999
endif endif

2
krylov/psb_ccg.F90
Unescape Escape View File

@ -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 type(psb_c_vect_type), pointer :: q, p, r, z, w
complex(psb_spk_) :: alpha, beta, rho, rho_old, sigma,alpha_old,beta_old complex(psb_spk_) :: alpha, beta, rho, rho_old, sigma,alpha_old,beta_old
integer(psb_ipk_) :: itmax_, istop_, naux, it, itx, itrace_,& 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_lpk_) :: mglob
integer(psb_ipk_) :: debug_level, debug_unit integer(psb_ipk_) :: debug_level, debug_unit
integer(psb_ipk_) :: np, me, ictxt integer(psb_ipk_) :: np, me, ictxt

2
krylov/psb_ccgs.f90
Unescape Escape View File

@ -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), allocatable, target :: wwrk(:)
type(psb_c_vect_type), pointer :: ww, q, r, p, v,& type(psb_c_vect_type), pointer :: ww, q, r, p, v,&
& s, z, f, rt, qt, uv & 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 & n_row, n_col,istop_, itx, err_act
integer(psb_lpk_) :: mglob integer(psb_lpk_) :: mglob
integer(psb_ipk_) :: np, me, ictxt integer(psb_ipk_) :: np, me, ictxt

5
krylov/psb_ccgstabl.f90
Unescape Escape View File

@ -132,7 +132,7 @@ Subroutine psb_ccgstabl_vect(a,prec,b,x,eps,desc_a,info,&
integer(psb_lpk_) :: mglob integer(psb_lpk_) :: mglob
Logical, Parameter :: exchange=.True., noexchange=.False. Logical, Parameter :: exchange=.True., noexchange=.False.
integer(psb_ipk_), Parameter :: irmax = 8 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_) :: debug_level, debug_unit
integer(psb_ipk_) :: ictxt, np, me integer(psb_ipk_) :: ictxt, np, me
complex(psb_spk_) :: alpha, beta, rho, rho_old, rni, xni, bni, ani,bn2,& 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 endif
if (nl <=0 ) then if (nl <=0 ) then
info=psb_err_invalid_istop_ info=psb_err_invalid_istop_
int_err(1)=nl
err=info err=info
call psb_errpush(info,name,i_err=int_err) call psb_errpush(info,name,i_err=(/nl/))
goto 9999 goto 9999
endif endif

7
krylov/psb_cgcr.f90
Unescape Escape View File

@ -140,7 +140,6 @@ subroutine psb_cgcr_vect(a,prec,b,x,eps,desc_a,info,&
character(len=20) :: name character(len=20) :: name
type(psb_itconv_type) :: stopdat type(psb_itconv_type) :: stopdat
character(len=*), parameter :: methdname='GCR' character(len=*), parameter :: methdname='GCR'
integer(psb_ipk_) ::int_err(5)
info = psb_success_ info = psb_success_
name = 'psb_cgcr' name = 'psb_cgcr'
call psb_erractionsave(err_act) 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 if ((istop_ < 1 ).or.(istop_ > 2 ) ) then
info=psb_err_invalid_istop_ info=psb_err_invalid_istop_
int_err(1)=istop_
err=info err=info
call psb_errpush(info,name,i_err=int_err) call psb_errpush(info,name,i_err=(/istop_/))
goto 9999 goto 9999
endif endif
@ -219,9 +217,8 @@ subroutine psb_cgcr_vect(a,prec,b,x,eps,desc_a,info,&
if (nl <=0 ) then if (nl <=0 ) then
info=psb_err_invalid_istop_ info=psb_err_invalid_istop_
int_err(1)=nl
err=info err=info
call psb_errpush(info,name,i_err=int_err) call psb_errpush(info,name,i_err=(/nl/))
goto 9999 goto 9999
endif endif

8
krylov/psb_crgmres.f90
Unescape Escape View File

@ -131,7 +131,7 @@ subroutine psb_crgmres_vect(a,prec,b,x,eps,desc_a,info,&
real(psb_spk_) :: tmp real(psb_spk_) :: tmp
complex(psb_spk_) :: scal, gm, rti, rti1 complex(psb_spk_) :: scal, gm, rti, rti1
integer(psb_ipk_) ::litmax, naux, it, k, itrace_,& 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 integer(psb_lpk_) :: mglob
Logical, Parameter :: exchange=.True., noexchange=.False., use_srot=.true. Logical, Parameter :: exchange=.True., noexchange=.False., use_srot=.true.
integer(psb_ipk_), Parameter :: irmax = 8 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 if ((istop_ < 1 ).or.(istop_ > 2 ) ) then
info=psb_err_invalid_istop_ info=psb_err_invalid_istop_
int_err(1)=istop_
err=info err=info
call psb_errpush(info,name,i_err=int_err) call psb_errpush(info,name,i_err=(/istop_/))
goto 9999 goto 9999
endif endif
@ -211,9 +210,8 @@ subroutine psb_crgmres_vect(a,prec,b,x,eps,desc_a,info,&
endif endif
if (nl <=0 ) then if (nl <=0 ) then
info=psb_err_invalid_istop_ info=psb_err_invalid_istop_
int_err(1)=nl
err=info err=info
call psb_errpush(info,name,i_err=int_err) call psb_errpush(info,name,i_err=(/nl/))
goto 9999 goto 9999
endif endif

10
krylov/psb_d_krylov_conv_mod.f90
Unescape Escape View File

@ -61,7 +61,7 @@ contains
type(psb_itconv_type) :: stopdat type(psb_itconv_type) :: stopdat
integer(psb_ipk_), intent(out) :: info 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 character(len=20) :: name
real(psb_dpk_), allocatable :: r(:) real(psb_dpk_), allocatable :: r(:)
@ -98,8 +98,7 @@ contains
call psb_gefree(r,desc_a,info) call psb_gefree(r,desc_a,info)
case default case default
info=psb_err_invalid_istop_ info=psb_err_invalid_istop_
ierr(1) = stopc call psb_errpush(info,name,i_err=(/stopc/))
call psb_errpush(info,name,i_err=ierr)
goto 9999 goto 9999
end select end select
if (info /= psb_success_) then if (info /= psb_success_) then
@ -213,7 +212,7 @@ contains
type(psb_itconv_type) :: stopdat type(psb_itconv_type) :: stopdat
integer(psb_ipk_), intent(out) :: info 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 character(len=20) :: name
type(psb_d_vect_type) :: r type(psb_d_vect_type) :: r
@ -250,8 +249,7 @@ contains
call psb_gefree(r,desc_a,info) call psb_gefree(r,desc_a,info)
case default case default
info=psb_err_invalid_istop_ info=psb_err_invalid_istop_
ierr(1) = stopc call psb_errpush(info,name,i_err=(/stopc/))
call psb_errpush(info,name,i_err=ierr)
goto 9999 goto 9999
end select end select
if (info /= psb_success_) then if (info /= psb_success_) then

4
krylov/psb_dbicg.f90
Unescape Escape View File

@ -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), allocatable, target :: wwrk(:)
type(psb_d_vect_type), pointer :: ww, q, r, p,& type(psb_d_vect_type), pointer :: ww, q, r, p,&
& zt, pt, z, rt, qt & zt, pt, z, rt, qt
integer(psb_ipk_) :: int_err(5)
integer(psb_ipk_) :: itmax_, naux, it, itrace_,& integer(psb_ipk_) :: itmax_, naux, it, itrace_,&
& n_row, n_col, istop_, err_act & n_row, n_col, istop_, err_act
integer(psb_lpk_) :: mglob 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 if ((istop_ < 1 ).or.(istop_ > 2 ) ) then
info=psb_err_invalid_istop_ info=psb_err_invalid_istop_
int_err=istop_
err=info err=info
call psb_errpush(info,name,i_err=int_err) call psb_errpush(info,name,i_err=(/istop_/))
goto 9999 goto 9999
endif endif

2
krylov/psb_dcg.F90
Unescape Escape View File

@ -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 type(psb_d_vect_type), pointer :: q, p, r, z, w
real(psb_dpk_) :: alpha, beta, rho, rho_old, sigma,alpha_old,beta_old real(psb_dpk_) :: alpha, beta, rho, rho_old, sigma,alpha_old,beta_old
integer(psb_ipk_) :: itmax_, istop_, naux, it, itx, itrace_,& 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_lpk_) :: mglob
integer(psb_ipk_) :: debug_level, debug_unit integer(psb_ipk_) :: debug_level, debug_unit
integer(psb_ipk_) :: np, me, ictxt integer(psb_ipk_) :: np, me, ictxt

2
krylov/psb_dcgs.f90
Unescape Escape View File

@ -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), allocatable, target :: wwrk(:)
type(psb_d_vect_type), pointer :: ww, q, r, p, v,& type(psb_d_vect_type), pointer :: ww, q, r, p, v,&
& s, z, f, rt, qt, uv & 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 & n_row, n_col,istop_, itx, err_act
integer(psb_lpk_) :: mglob integer(psb_lpk_) :: mglob
integer(psb_ipk_) :: np, me, ictxt integer(psb_ipk_) :: np, me, ictxt

5
krylov/psb_dcgstabl.f90
Unescape Escape View File

@ -132,7 +132,7 @@ Subroutine psb_dcgstabl_vect(a,prec,b,x,eps,desc_a,info,&
integer(psb_lpk_) :: mglob integer(psb_lpk_) :: mglob
Logical, Parameter :: exchange=.True., noexchange=.False. Logical, Parameter :: exchange=.True., noexchange=.False.
integer(psb_ipk_), Parameter :: irmax = 8 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_) :: debug_level, debug_unit
integer(psb_ipk_) :: ictxt, np, me integer(psb_ipk_) :: ictxt, np, me
real(psb_dpk_) :: alpha, beta, rho, rho_old, rni, xni, bni, ani,bn2,& 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 endif
if (nl <=0 ) then if (nl <=0 ) then
info=psb_err_invalid_istop_ info=psb_err_invalid_istop_
int_err(1)=nl
err=info err=info
call psb_errpush(info,name,i_err=int_err) call psb_errpush(info,name,i_err=(/nl/))
goto 9999 goto 9999
endif endif

7
krylov/psb_dgcr.f90
Unescape Escape View File

@ -140,7 +140,6 @@ subroutine psb_dgcr_vect(a,prec,b,x,eps,desc_a,info,&
character(len=20) :: name character(len=20) :: name
type(psb_itconv_type) :: stopdat type(psb_itconv_type) :: stopdat
character(len=*), parameter :: methdname='GCR' character(len=*), parameter :: methdname='GCR'
integer(psb_ipk_) ::int_err(5)
info = psb_success_ info = psb_success_
name = 'psb_dgcr' name = 'psb_dgcr'
call psb_erractionsave(err_act) 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 if ((istop_ < 1 ).or.(istop_ > 2 ) ) then
info=psb_err_invalid_istop_ info=psb_err_invalid_istop_
int_err(1)=istop_
err=info err=info
call psb_errpush(info,name,i_err=int_err) call psb_errpush(info,name,i_err=(/istop_/))
goto 9999 goto 9999
endif endif
@ -219,9 +217,8 @@ subroutine psb_dgcr_vect(a,prec,b,x,eps,desc_a,info,&
if (nl <=0 ) then if (nl <=0 ) then
info=psb_err_invalid_istop_ info=psb_err_invalid_istop_
int_err(1)=nl
err=info err=info
call psb_errpush(info,name,i_err=int_err) call psb_errpush(info,name,i_err=(/nl/))
goto 9999 goto 9999
endif endif

8
krylov/psb_drgmres.f90
Unescape Escape View File

@ -131,7 +131,7 @@ subroutine psb_drgmres_vect(a,prec,b,x,eps,desc_a,info,&
real(psb_dpk_) :: tmp real(psb_dpk_) :: tmp
real(psb_dpk_) :: scal, gm, rti, rti1 real(psb_dpk_) :: scal, gm, rti, rti1
integer(psb_ipk_) ::litmax, naux, it, k, itrace_,& 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 integer(psb_lpk_) :: mglob
Logical, Parameter :: exchange=.True., noexchange=.False., use_srot=.true. Logical, Parameter :: exchange=.True., noexchange=.False., use_srot=.true.
integer(psb_ipk_), Parameter :: irmax = 8 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 if ((istop_ < 1 ).or.(istop_ > 2 ) ) then
info=psb_err_invalid_istop_ info=psb_err_invalid_istop_
int_err(1)=istop_
err=info err=info
call psb_errpush(info,name,i_err=int_err) call psb_errpush(info,name,i_err=(/istop_/))
goto 9999 goto 9999
endif endif
@ -211,9 +210,8 @@ subroutine psb_drgmres_vect(a,prec,b,x,eps,desc_a,info,&
endif endif
if (nl <=0 ) then if (nl <=0 ) then
info=psb_err_invalid_istop_ info=psb_err_invalid_istop_
int_err(1)=nl
err=info err=info
call psb_errpush(info,name,i_err=int_err) call psb_errpush(info,name,i_err=(/nl/))
goto 9999 goto 9999
endif endif

10
krylov/psb_s_krylov_conv_mod.f90
Unescape Escape View File

@ -61,7 +61,7 @@ contains
type(psb_itconv_type) :: stopdat type(psb_itconv_type) :: stopdat
integer(psb_ipk_), intent(out) :: info 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 character(len=20) :: name
real(psb_spk_), allocatable :: r(:) real(psb_spk_), allocatable :: r(:)
@ -98,8 +98,7 @@ contains
call psb_gefree(r,desc_a,info) call psb_gefree(r,desc_a,info)
case default case default
info=psb_err_invalid_istop_ info=psb_err_invalid_istop_
ierr(1) = stopc call psb_errpush(info,name,i_err=(/stopc/))
call psb_errpush(info,name,i_err=ierr)
goto 9999 goto 9999
end select end select
if (info /= psb_success_) then if (info /= psb_success_) then
@ -213,7 +212,7 @@ contains
type(psb_itconv_type) :: stopdat type(psb_itconv_type) :: stopdat
integer(psb_ipk_), intent(out) :: info 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 character(len=20) :: name
type(psb_s_vect_type) :: r type(psb_s_vect_type) :: r
@ -250,8 +249,7 @@ contains
call psb_gefree(r,desc_a,info) call psb_gefree(r,desc_a,info)
case default case default
info=psb_err_invalid_istop_ info=psb_err_invalid_istop_
ierr(1) = stopc call psb_errpush(info,name,i_err=(/stopc/))
call psb_errpush(info,name,i_err=ierr)
goto 9999 goto 9999
end select end select
if (info /= psb_success_) then if (info /= psb_success_) then

4
krylov/psb_sbicg.f90
Unescape Escape View File

@ -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), allocatable, target :: wwrk(:)
type(psb_s_vect_type), pointer :: ww, q, r, p,& type(psb_s_vect_type), pointer :: ww, q, r, p,&
& zt, pt, z, rt, qt & zt, pt, z, rt, qt
integer(psb_ipk_) :: int_err(5)
integer(psb_ipk_) :: itmax_, naux, it, itrace_,& integer(psb_ipk_) :: itmax_, naux, it, itrace_,&
& n_row, n_col, istop_, err_act & n_row, n_col, istop_, err_act
integer(psb_lpk_) :: mglob 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 if ((istop_ < 1 ).or.(istop_ > 2 ) ) then
info=psb_err_invalid_istop_ info=psb_err_invalid_istop_
int_err=istop_
err=info err=info
call psb_errpush(info,name,i_err=int_err) call psb_errpush(info,name,i_err=(/istop_/))
goto 9999 goto 9999
endif endif

2
krylov/psb_scg.F90
Unescape Escape View File

@ -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 type(psb_s_vect_type), pointer :: q, p, r, z, w
real(psb_spk_) :: alpha, beta, rho, rho_old, sigma,alpha_old,beta_old real(psb_spk_) :: alpha, beta, rho, rho_old, sigma,alpha_old,beta_old
integer(psb_ipk_) :: itmax_, istop_, naux, it, itx, itrace_,& 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_lpk_) :: mglob
integer(psb_ipk_) :: debug_level, debug_unit integer(psb_ipk_) :: debug_level, debug_unit
integer(psb_ipk_) :: np, me, ictxt integer(psb_ipk_) :: np, me, ictxt

2
krylov/psb_scgs.f90
Unescape Escape View File

@ -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), allocatable, target :: wwrk(:)
type(psb_s_vect_type), pointer :: ww, q, r, p, v,& type(psb_s_vect_type), pointer :: ww, q, r, p, v,&
& s, z, f, rt, qt, uv & 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 & n_row, n_col,istop_, itx, err_act
integer(psb_lpk_) :: mglob integer(psb_lpk_) :: mglob
integer(psb_ipk_) :: np, me, ictxt integer(psb_ipk_) :: np, me, ictxt

5
krylov/psb_scgstabl.f90
Unescape Escape View File

@ -132,7 +132,7 @@ Subroutine psb_scgstabl_vect(a,prec,b,x,eps,desc_a,info,&
integer(psb_lpk_) :: mglob integer(psb_lpk_) :: mglob
Logical, Parameter :: exchange=.True., noexchange=.False. Logical, Parameter :: exchange=.True., noexchange=.False.
integer(psb_ipk_), Parameter :: irmax = 8 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_) :: debug_level, debug_unit
integer(psb_ipk_) :: ictxt, np, me integer(psb_ipk_) :: ictxt, np, me
real(psb_spk_) :: alpha, beta, rho, rho_old, rni, xni, bni, ani,bn2,& 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 endif
if (nl <=0 ) then if (nl <=0 ) then
info=psb_err_invalid_istop_ info=psb_err_invalid_istop_
int_err(1)=nl
err=info err=info
call psb_errpush(info,name,i_err=int_err) call psb_errpush(info,name,i_err=(/nl/))
goto 9999 goto 9999
endif endif

7
krylov/psb_sgcr.f90
Unescape Escape View File

@ -140,7 +140,6 @@ subroutine psb_sgcr_vect(a,prec,b,x,eps,desc_a,info,&
character(len=20) :: name character(len=20) :: name
type(psb_itconv_type) :: stopdat type(psb_itconv_type) :: stopdat
character(len=*), parameter :: methdname='GCR' character(len=*), parameter :: methdname='GCR'
integer(psb_ipk_) ::int_err(5)
info = psb_success_ info = psb_success_
name = 'psb_sgcr' name = 'psb_sgcr'
call psb_erractionsave(err_act) 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 if ((istop_ < 1 ).or.(istop_ > 2 ) ) then
info=psb_err_invalid_istop_ info=psb_err_invalid_istop_
int_err(1)=istop_
err=info err=info
call psb_errpush(info,name,i_err=int_err) call psb_errpush(info,name,i_err=(/istop_/))
goto 9999 goto 9999
endif endif
@ -219,9 +217,8 @@ subroutine psb_sgcr_vect(a,prec,b,x,eps,desc_a,info,&
if (nl <=0 ) then if (nl <=0 ) then
info=psb_err_invalid_istop_ info=psb_err_invalid_istop_
int_err(1)=nl
err=info err=info
call psb_errpush(info,name,i_err=int_err) call psb_errpush(info,name,i_err=(/nl/))
goto 9999 goto 9999
endif endif

8
krylov/psb_srgmres.f90
Unescape Escape View File

@ -131,7 +131,7 @@ subroutine psb_srgmres_vect(a,prec,b,x,eps,desc_a,info,&
real(psb_spk_) :: tmp real(psb_spk_) :: tmp
real(psb_spk_) :: scal, gm, rti, rti1 real(psb_spk_) :: scal, gm, rti, rti1
integer(psb_ipk_) ::litmax, naux, it, k, itrace_,& 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 integer(psb_lpk_) :: mglob
Logical, Parameter :: exchange=.True., noexchange=.False., use_srot=.true. Logical, Parameter :: exchange=.True., noexchange=.False., use_srot=.true.
integer(psb_ipk_), Parameter :: irmax = 8 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 if ((istop_ < 1 ).or.(istop_ > 2 ) ) then
info=psb_err_invalid_istop_ info=psb_err_invalid_istop_
int_err(1)=istop_
err=info err=info
call psb_errpush(info,name,i_err=int_err) call psb_errpush(info,name,i_err=(/istop_/))
goto 9999 goto 9999
endif endif
@ -211,9 +210,8 @@ subroutine psb_srgmres_vect(a,prec,b,x,eps,desc_a,info,&
endif endif
if (nl <=0 ) then if (nl <=0 ) then
info=psb_err_invalid_istop_ info=psb_err_invalid_istop_
int_err(1)=nl
err=info err=info
call psb_errpush(info,name,i_err=int_err) call psb_errpush(info,name,i_err=(/nl/))
goto 9999 goto 9999
endif endif

10
krylov/psb_z_krylov_conv_mod.f90
Unescape Escape View File

@ -61,7 +61,7 @@ contains
type(psb_itconv_type) :: stopdat type(psb_itconv_type) :: stopdat
integer(psb_ipk_), intent(out) :: info 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 character(len=20) :: name
complex(psb_dpk_), allocatable :: r(:) complex(psb_dpk_), allocatable :: r(:)
@ -98,8 +98,7 @@ contains
call psb_gefree(r,desc_a,info) call psb_gefree(r,desc_a,info)
case default case default
info=psb_err_invalid_istop_ info=psb_err_invalid_istop_
ierr(1) = stopc call psb_errpush(info,name,i_err=(/stopc/))
call psb_errpush(info,name,i_err=ierr)
goto 9999 goto 9999
end select end select
if (info /= psb_success_) then if (info /= psb_success_) then
@ -213,7 +212,7 @@ contains
type(psb_itconv_type) :: stopdat type(psb_itconv_type) :: stopdat
integer(psb_ipk_), intent(out) :: info 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 character(len=20) :: name
type(psb_z_vect_type) :: r type(psb_z_vect_type) :: r
@ -250,8 +249,7 @@ contains
call psb_gefree(r,desc_a,info) call psb_gefree(r,desc_a,info)
case default case default
info=psb_err_invalid_istop_ info=psb_err_invalid_istop_
ierr(1) = stopc call psb_errpush(info,name,i_err=(/stopc/))
call psb_errpush(info,name,i_err=ierr)
goto 9999 goto 9999
end select end select
if (info /= psb_success_) then if (info /= psb_success_) then

4
krylov/psb_zbicg.f90
Unescape Escape View File

@ -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), allocatable, target :: wwrk(:)
type(psb_z_vect_type), pointer :: ww, q, r, p,& type(psb_z_vect_type), pointer :: ww, q, r, p,&
& zt, pt, z, rt, qt & zt, pt, z, rt, qt
integer(psb_ipk_) :: int_err(5)
integer(psb_ipk_) :: itmax_, naux, it, itrace_,& integer(psb_ipk_) :: itmax_, naux, it, itrace_,&
& n_row, n_col, istop_, err_act & n_row, n_col, istop_, err_act
integer(psb_lpk_) :: mglob 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 if ((istop_ < 1 ).or.(istop_ > 2 ) ) then
info=psb_err_invalid_istop_ info=psb_err_invalid_istop_
int_err=istop_
err=info err=info
call psb_errpush(info,name,i_err=int_err) call psb_errpush(info,name,i_err=(/istop_/))
goto 9999 goto 9999
endif endif

2
krylov/psb_zcg.F90
Unescape Escape View File

@ -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 type(psb_z_vect_type), pointer :: q, p, r, z, w
complex(psb_dpk_) :: alpha, beta, rho, rho_old, sigma,alpha_old,beta_old complex(psb_dpk_) :: alpha, beta, rho, rho_old, sigma,alpha_old,beta_old
integer(psb_ipk_) :: itmax_, istop_, naux, it, itx, itrace_,& 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_lpk_) :: mglob
integer(psb_ipk_) :: debug_level, debug_unit integer(psb_ipk_) :: debug_level, debug_unit
integer(psb_ipk_) :: np, me, ictxt integer(psb_ipk_) :: np, me, ictxt

2
krylov/psb_zcgs.f90
Unescape Escape View File

@ -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), allocatable, target :: wwrk(:)
type(psb_z_vect_type), pointer :: ww, q, r, p, v,& type(psb_z_vect_type), pointer :: ww, q, r, p, v,&
& s, z, f, rt, qt, uv & 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 & n_row, n_col,istop_, itx, err_act
integer(psb_lpk_) :: mglob integer(psb_lpk_) :: mglob
integer(psb_ipk_) :: np, me, ictxt integer(psb_ipk_) :: np, me, ictxt

5
krylov/psb_zcgstabl.f90
Unescape Escape View File

@ -132,7 +132,7 @@ Subroutine psb_zcgstabl_vect(a,prec,b,x,eps,desc_a,info,&
integer(psb_lpk_) :: mglob integer(psb_lpk_) :: mglob
Logical, Parameter :: exchange=.True., noexchange=.False. Logical, Parameter :: exchange=.True., noexchange=.False.
integer(psb_ipk_), Parameter :: irmax = 8 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_) :: debug_level, debug_unit
integer(psb_ipk_) :: ictxt, np, me integer(psb_ipk_) :: ictxt, np, me
complex(psb_dpk_) :: alpha, beta, rho, rho_old, rni, xni, bni, ani,bn2,& 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 endif
if (nl <=0 ) then if (nl <=0 ) then
info=psb_err_invalid_istop_ info=psb_err_invalid_istop_
int_err(1)=nl
err=info err=info
call psb_errpush(info,name,i_err=int_err) call psb_errpush(info,name,i_err=(/nl/))
goto 9999 goto 9999
endif endif

7
krylov/psb_zgcr.f90
Unescape Escape View File

@ -140,7 +140,6 @@ subroutine psb_zgcr_vect(a,prec,b,x,eps,desc_a,info,&
character(len=20) :: name character(len=20) :: name
type(psb_itconv_type) :: stopdat type(psb_itconv_type) :: stopdat
character(len=*), parameter :: methdname='GCR' character(len=*), parameter :: methdname='GCR'
integer(psb_ipk_) ::int_err(5)
info = psb_success_ info = psb_success_
name = 'psb_zgcr' name = 'psb_zgcr'
call psb_erractionsave(err_act) 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 if ((istop_ < 1 ).or.(istop_ > 2 ) ) then
info=psb_err_invalid_istop_ info=psb_err_invalid_istop_
int_err(1)=istop_
err=info err=info
call psb_errpush(info,name,i_err=int_err) call psb_errpush(info,name,i_err=(/istop_/))
goto 9999 goto 9999
endif endif
@ -219,9 +217,8 @@ subroutine psb_zgcr_vect(a,prec,b,x,eps,desc_a,info,&
if (nl <=0 ) then if (nl <=0 ) then
info=psb_err_invalid_istop_ info=psb_err_invalid_istop_
int_err(1)=nl
err=info err=info
call psb_errpush(info,name,i_err=int_err) call psb_errpush(info,name,i_err=(/nl/))
goto 9999 goto 9999
endif endif

8
krylov/psb_zrgmres.f90
Unescape Escape View File

@ -131,7 +131,7 @@ subroutine psb_zrgmres_vect(a,prec,b,x,eps,desc_a,info,&
real(psb_dpk_) :: tmp real(psb_dpk_) :: tmp
complex(psb_dpk_) :: scal, gm, rti, rti1 complex(psb_dpk_) :: scal, gm, rti, rti1
integer(psb_ipk_) ::litmax, naux, it, k, itrace_,& 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 integer(psb_lpk_) :: mglob
Logical, Parameter :: exchange=.True., noexchange=.False., use_srot=.true. Logical, Parameter :: exchange=.True., noexchange=.False., use_srot=.true.
integer(psb_ipk_), Parameter :: irmax = 8 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 if ((istop_ < 1 ).or.(istop_ > 2 ) ) then
info=psb_err_invalid_istop_ info=psb_err_invalid_istop_
int_err(1)=istop_
err=info err=info
call psb_errpush(info,name,i_err=int_err) call psb_errpush(info,name,i_err=(/istop_/))
goto 9999 goto 9999
endif endif
@ -211,9 +210,8 @@ subroutine psb_zrgmres_vect(a,prec,b,x,eps,desc_a,info,&
endif endif
if (nl <=0 ) then if (nl <=0 ) then
info=psb_err_invalid_istop_ info=psb_err_invalid_istop_
int_err(1)=nl
err=info err=info
call psb_errpush(info,name,i_err=int_err) call psb_errpush(info,name,i_err=(/nl/))
goto 9999 goto 9999
endif endif

3
prec/impl/psb_cprecbld.f90
Unescape Escape View File

@ -46,8 +46,6 @@ subroutine psb_cprecbld(a,desc_a,p,info,amold,vmold,imold)
! Local scalars ! Local scalars
integer(psb_ipk_) :: ictxt, me,np integer(psb_ipk_) :: ictxt, me,np
integer(psb_ipk_) :: err, n_row, n_col,mglob, err_act 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 integer(psb_ipk_),parameter :: iroot=psb_root_,iout=60,ilout=40
character(len=20) :: name, ch_err character(len=20) :: name, ch_err
@ -58,7 +56,6 @@ subroutine psb_cprecbld(a,desc_a,p,info,amold,vmold,imold)
name = 'psb_precbld' name = 'psb_precbld'
info = psb_success_ info = psb_success_
int_err(1) = 0
ictxt = desc_a%get_context() ictxt = desc_a%get_context()
call psb_info(ictxt, me, np) call psb_info(ictxt, me, np)

3
prec/impl/psb_dprecbld.f90
Unescape Escape View File

@ -46,8 +46,6 @@ subroutine psb_dprecbld(a,desc_a,p,info,amold,vmold,imold)
! Local scalars ! Local scalars
integer(psb_ipk_) :: ictxt, me,np integer(psb_ipk_) :: ictxt, me,np
integer(psb_ipk_) :: err, n_row, n_col,mglob, err_act 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 integer(psb_ipk_),parameter :: iroot=psb_root_,iout=60,ilout=40
character(len=20) :: name, ch_err character(len=20) :: name, ch_err
@ -58,7 +56,6 @@ subroutine psb_dprecbld(a,desc_a,p,info,amold,vmold,imold)
name = 'psb_precbld' name = 'psb_precbld'
info = psb_success_ info = psb_success_
int_err(1) = 0
ictxt = desc_a%get_context() ictxt = desc_a%get_context()
call psb_info(ictxt, me, np) call psb_info(ictxt, me, np)

3
prec/impl/psb_sprecbld.f90
Unescape Escape View File

@ -46,8 +46,6 @@ subroutine psb_sprecbld(a,desc_a,p,info,amold,vmold,imold)
! Local scalars ! Local scalars
integer(psb_ipk_) :: ictxt, me,np integer(psb_ipk_) :: ictxt, me,np
integer(psb_ipk_) :: err, n_row, n_col,mglob, err_act 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 integer(psb_ipk_),parameter :: iroot=psb_root_,iout=60,ilout=40
character(len=20) :: name, ch_err character(len=20) :: name, ch_err
@ -58,7 +56,6 @@ subroutine psb_sprecbld(a,desc_a,p,info,amold,vmold,imold)
name = 'psb_precbld' name = 'psb_precbld'
info = psb_success_ info = psb_success_
int_err(1) = 0
ictxt = desc_a%get_context() ictxt = desc_a%get_context()
call psb_info(ictxt, me, np) call psb_info(ictxt, me, np)

3
prec/impl/psb_zprecbld.f90
Unescape Escape View File

@ -46,8 +46,6 @@ subroutine psb_zprecbld(a,desc_a,p,info,amold,vmold,imold)
! Local scalars ! Local scalars
integer(psb_ipk_) :: ictxt, me,np integer(psb_ipk_) :: ictxt, me,np
integer(psb_ipk_) :: err, n_row, n_col,mglob, err_act 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 integer(psb_ipk_),parameter :: iroot=psb_root_,iout=60,ilout=40
character(len=20) :: name, ch_err character(len=20) :: name, ch_err
@ -58,7 +56,6 @@ subroutine psb_zprecbld(a,desc_a,p,info,amold,vmold,imold)
name = 'psb_precbld' name = 'psb_precbld'
info = psb_success_ info = psb_success_
int_err(1) = 0
ictxt = desc_a%get_context() ictxt = desc_a%get_context()
call psb_info(ictxt, me, np) call psb_info(ictxt, me, np)

5
util/psb_c_mat_dist_impl.f90
Unescape Escape View File

@ -89,7 +89,7 @@ subroutine psb_cmatdist(a_glob, a, ictxt, desc_a,&
logical :: use_parts, use_v logical :: use_parts, use_v
integer(psb_ipk_) :: np, iam, np_sharing integer(psb_ipk_) :: np, iam, np_sharing
integer(psb_ipk_) :: k_count, root, liwork, nnzero, nrhs,& 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_lpk_) :: i_count, j_count, nrow, ncol, ig
integer(psb_ipk_), allocatable :: iwork(:), iwrk2(:) integer(psb_ipk_), allocatable :: iwork(:), iwrk2(:)
integer(psb_lpk_), allocatable :: irow(:),icol(:) 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) allocate(iwork(liwork), iwrk2(np),stat = info)
if (info /= psb_success_) then if (info /= psb_success_) then
info=psb_err_alloc_request_ info=psb_err_alloc_request_
int_err(1)=liwork call psb_errpush(info,name,i_err=(/liwork/),a_err='integer')
call psb_errpush(info,name,i_err=int_err,a_err='integer')
goto 9999 goto 9999
endif endif
if (iam == root) then if (iam == root) then

5
util/psb_d_mat_dist_impl.f90
Unescape Escape View File

@ -89,7 +89,7 @@ subroutine psb_dmatdist(a_glob, a, ictxt, desc_a,&
logical :: use_parts, use_v logical :: use_parts, use_v
integer(psb_ipk_) :: np, iam, np_sharing integer(psb_ipk_) :: np, iam, np_sharing
integer(psb_ipk_) :: k_count, root, liwork, nnzero, nrhs,& 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_lpk_) :: i_count, j_count, nrow, ncol, ig
integer(psb_ipk_), allocatable :: iwork(:), iwrk2(:) integer(psb_ipk_), allocatable :: iwork(:), iwrk2(:)
integer(psb_lpk_), allocatable :: irow(:),icol(:) 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) allocate(iwork(liwork), iwrk2(np),stat = info)
if (info /= psb_success_) then if (info /= psb_success_) then
info=psb_err_alloc_request_ info=psb_err_alloc_request_
int_err(1)=liwork call psb_errpush(info,name,i_err=(/liwork/),a_err='integer')
call psb_errpush(info,name,i_err=int_err,a_err='integer')
goto 9999 goto 9999
endif endif
if (iam == root) then if (iam == root) then

5
util/psb_s_mat_dist_impl.f90
Unescape Escape View File

@ -89,7 +89,7 @@ subroutine psb_smatdist(a_glob, a, ictxt, desc_a,&
logical :: use_parts, use_v logical :: use_parts, use_v
integer(psb_ipk_) :: np, iam, np_sharing integer(psb_ipk_) :: np, iam, np_sharing
integer(psb_ipk_) :: k_count, root, liwork, nnzero, nrhs,& 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_lpk_) :: i_count, j_count, nrow, ncol, ig
integer(psb_ipk_), allocatable :: iwork(:), iwrk2(:) integer(psb_ipk_), allocatable :: iwork(:), iwrk2(:)
integer(psb_lpk_), allocatable :: irow(:),icol(:) 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) allocate(iwork(liwork), iwrk2(np),stat = info)
if (info /= psb_success_) then if (info /= psb_success_) then
info=psb_err_alloc_request_ info=psb_err_alloc_request_
int_err(1)=liwork call psb_errpush(info,name,i_err=(/liwork/),a_err='integer')
call psb_errpush(info,name,i_err=int_err,a_err='integer')
goto 9999 goto 9999
endif endif
if (iam == root) then if (iam == root) then

5
util/psb_z_mat_dist_impl.f90
Unescape Escape View File

@ -89,7 +89,7 @@ subroutine psb_zmatdist(a_glob, a, ictxt, desc_a,&
logical :: use_parts, use_v logical :: use_parts, use_v
integer(psb_ipk_) :: np, iam, np_sharing integer(psb_ipk_) :: np, iam, np_sharing
integer(psb_ipk_) :: k_count, root, liwork, nnzero, nrhs,& 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_lpk_) :: i_count, j_count, nrow, ncol, ig
integer(psb_ipk_), allocatable :: iwork(:), iwrk2(:) integer(psb_ipk_), allocatable :: iwork(:), iwrk2(:)
integer(psb_lpk_), allocatable :: irow(:),icol(:) 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) allocate(iwork(liwork), iwrk2(np),stat = info)
if (info /= psb_success_) then if (info /= psb_success_) then
info=psb_err_alloc_request_ info=psb_err_alloc_request_
int_err(1)=liwork call psb_errpush(info,name,i_err=(/liwork/),a_err='integer')
call psb_errpush(info,name,i_err=int_err,a_err='integer')
goto 9999 goto 9999
endif endif
if (iam == root) then if (iam == root) then

Write Preview
Loading…
Cancel
Save