Giant patch: cleanup after -Wunused -Wuninitialized.

psblas3-type-indexed
Salvatore Filippone 19 years ago
parent 73aec9514d
commit 0aa6ea63f7

@ -63,9 +63,8 @@ subroutine psb_dgatherm(globx, locx, desc_a, info, iroot,&
! locals
integer :: int_err(5), ictxt, np, me,&
& err_act, n, iix, jjx, root, iiroot, ilocx, iglobx, jlocx,&
& err_act, n, root, iiroot, ilocx, iglobx, jlocx,&
& jglobx, lda_locx, lda_globx, m, lock, globk, maxk, k, jlx, ilx, i, j, idx
real(kind(1.d0)),pointer :: tmpx(:)
character(len=20) :: name, ch_err
name='psb_dgatherm'
@ -258,10 +257,10 @@ subroutine psb_dgatherv(globx, locx, desc_a, info, iroot,&
! locals
integer :: int_err(5), ictxt, np, me, mycol,&
& err_act, n, iix, jjx, root, iiroot, ilocx, iglobx, jlocx,&
& jglobx, lda_locx, lda_globx, lock, maxk, globk, m, k, jlx, ilx, i, j, idx
real(kind(1.d0)),pointer :: tmpx(:)
integer :: int_err(5), ictxt, np, me, &
& err_act, n, root, iiroot, ilocx, iglobx, jlocx,&
& jglobx, lda_locx, lda_globx, m, k, jlx, ilx, i, idx
character(len=20) :: name, ch_err
name='psb_dgatherv'

@ -63,9 +63,9 @@ subroutine psb_dhalom(x,desc_a,info,alpha,jx,ik,work,tran,mode)
character, intent(in), optional :: tran
! locals
integer :: int_err(5), ictxt, np, me,&
integer :: ictxt, np, me,&
& err_act, m, n, iix, jjx, ix, ijx, k, maxk, nrow, imode, i,&
& err, liwork, ncol
& err, liwork
real(kind(1.d0)),pointer :: iwork(:), xp(:,:)
character :: ltran
character(len=20) :: name, ch_err
@ -270,9 +270,9 @@ subroutine psb_dhalov(x,desc_a,info,alpha,work,tran,mode)
character, intent(in), optional :: tran
! locals
integer :: int_err(5), ictxt, np, me,&
& err_act, m, n, iix, jjx, ix, ijx, k, maxk, nrow, imode, i,&
& err, liwork, ncol
integer :: ictxt, np, me,&
& err_act, m, n, iix, jjx, ix, ijx, nrow, imode, i,&
& err, liwork
real(kind(1.d0)),pointer :: iwork(:)
character :: ltran
character(len=20) :: name, ch_err

@ -59,8 +59,8 @@ subroutine psb_dovrlm(x,desc_a,info,jx,ik,work,update)
integer, intent(in), optional :: update,jx,ik
! locals
integer :: int_err(5), ictxt, np, me, mycol,&
& err_act, m, n, iix, jjx, temp(2), ix, ijx, nrow, ncol, k, maxk, iupdate,&
integer :: int_err(5), ictxt, np, me, &
& err_act, m, n, iix, jjx, ix, ijx, nrow, ncol, k, maxk, iupdate,&
& imode, err, liwork, i
real(kind(1.d0)),pointer :: iwork(:), xp(:,:)
logical :: do_update
@ -272,8 +272,8 @@ subroutine psb_dovrlv(x,desc_a,info,work,update)
integer, intent(in), optional :: update
! locals
integer :: int_err(5), ictxt, np, me, mycol,&
& err_act, m, n, iix, jjx, temp(2), ix, ijx, nrow, ncol, k, maxk, iupdate,&
integer :: int_err(5), ictxt, np, me, &
& err_act, m, n, iix, jjx, ix, ijx, nrow, ncol, k, iupdate,&
& imode, err, liwork, i
real(kind(1.d0)),pointer :: iwork(:)
logical :: do_update

@ -67,7 +67,7 @@ subroutine psb_dscatterm(globx, locx, desc_a, info, iroot,&
! locals
integer :: int_err(5), ictxt, np, me,&
& err_act, m, n, iix, jjx, temp(2), i, j, idx, nrow, iiroot, iglobx, jglobx,&
& err_act, m, n, i, j, idx, nrow, iiroot, iglobx, jglobx,&
& ilocx, jlocx, lda_locx, lda_globx, lock, globk, icomm, k, maxk, root, ilx,&
& jlx, myrank, rootrank, c, pos
real(kind(1.d0)),pointer :: scatterv(:)
@ -312,6 +312,7 @@ subroutine psb_dscatterv(globx, locx, desc_a, info, iroot)
use psb_check_mod
use psb_error_mod
use mpi
use psb_penv_mod
implicit none
real(kind(1.d0)), intent(out) :: locx(:)
@ -322,10 +323,10 @@ subroutine psb_dscatterv(globx, locx, desc_a, info, iroot)
! locals
integer :: int_err(5), ictxt, np, me, mycol,&
& err_act, m, n, iix, jjx, temp(2), i, j, idx, nrow, iiroot, iglobx, jglobx,&
& ilocx, jlocx, lda_locx, lda_globx, lock, globk, root, k, maxk, icomm, myrank,&
& rootrank, c, pos, ilx, jlx
integer :: int_err(5), ictxt, np, me, &
& err_act, m, n, i, j, idx, nrow, iiroot, iglobx, jglobx,&
& ilocx, jlocx, lda_locx, lda_globx, root, k, icomm, myrank,&
& rootrank, pos, ilx, jlx
real(kind(1.d0)),pointer :: scatterv(:)
integer, pointer :: displ(:), l_t_g_all(:), all_dim(:)
character(len=20) :: name, ch_err

@ -64,8 +64,8 @@ subroutine psb_ihalom(x,desc_a,info,alpha,jx,ik,work,tran,mode)
character, intent(in), optional :: tran
! locals
integer :: int_err(5), ictxt, np, me, mycol,&
& err_act, m, n, iix, jjx, temp(2), ix, ijx, nrow, ncol, k, maxk, liwork,&
integer :: ictxt, np, me, &
& err_act, m, n, iix, jjx, ix, ijx, nrow, k, maxk, liwork,&
& imode, err
integer, pointer :: xp(:,:), iwork(:)
character :: ltran
@ -266,8 +266,8 @@ subroutine psb_ihalov(x,desc_a,info,alpha,work,tran,mode)
character, intent(in), optional :: tran
! locals
integer :: int_err(5), ictxt, np, me,&
& err_act, m, n, iix, jjx, temp(2), ix, ijx, nrow, ncol, k, maxk, imode,&
integer :: ictxt, np, me,&
& err_act, m, n, iix, jjx, ix, ijx, nrow, imode,&
& err, liwork
integer,pointer :: iwork(:)
character :: ltran

@ -62,10 +62,10 @@ subroutine psb_zgatherm(globx, locx, desc_a, info, iroot,&
! locals
integer :: int_err(5), ictxt, np, me, mycol,&
& err_act, n, iix, jjx, temp(2), root, iiroot, ilocx, iglobx, jlocx,&
integer :: int_err(5), ictxt, np, me, &
& err_act, n, root, iiroot, ilocx, iglobx, jlocx,&
& jglobx, lda_locx, lda_globx, m, lock, globk, maxk, k, jlx, ilx, i, j, idx
complex(kind(1.d0)),pointer :: tmpx(:)
character(len=20) :: name, ch_err
name='psb_zgatherm'
@ -258,10 +258,10 @@ subroutine psb_zgatherv(globx, locx, desc_a, info, iroot,&
! locals
integer :: int_err(5), ictxt, np, me, mycol,&
& err_act, n, iix, jjx, temp(2), root, iiroot, ilocx, iglobx, jlocx,&
& jglobx, lda_locx, lda_globx, lock, maxk, globk, m, k, jlx, ilx, i, j, idx
complex(kind(1.d0)),pointer :: tmpx(:)
integer :: int_err(5), ictxt, np, me, &
& err_act, n, root, ilocx, iglobx, jlocx,&
& jglobx, lda_locx, lda_globx, m, k, jlx, ilx, i, idx
character(len=20) :: name, ch_err
name='psb_zgatherv'

@ -63,9 +63,9 @@ subroutine psb_zhalom(x,desc_a,info,alpha,jx,ik,work,tran,mode)
character, intent(in), optional :: tran
! locals
integer :: int_err(5), ictxt, np, me, mycol,&
& err_act, m, n, iix, jjx, temp(2), ix, ijx, k, maxk, nrow, imode, i,&
& err, liwork, ncol
integer :: ictxt, np, me, &
& err_act, m, n, iix, jjx, ix, ijx, k, maxk, nrow, imode, i,&
& err, liwork
complex(kind(1.d0)),pointer :: iwork(:), xp(:,:)
character :: ltran
character(len=20) :: name, ch_err
@ -264,9 +264,8 @@ subroutine psb_zhalov(x,desc_a,info,alpha,work,tran,mode)
character, intent(in), optional :: tran
! locals
integer :: int_err(5), ictxt, np, me, mycol,&
& err_act, m, n, iix, jjx, temp(2), ix, ijx, k, maxk, nrow, imode, i,&
& err, liwork, ncol
integer :: ictxt, np, me, err_act, &
& m, n, iix, jjx, ix, ijx, nrow, imode, err, liwork
complex(kind(1.d0)),pointer :: iwork(:)
character :: ltran
character(len=20) :: name, ch_err

@ -59,8 +59,8 @@ subroutine psb_zovrlm(x,desc_a,info,jx,ik,work,update)
integer, intent(in), optional :: update,jx,ik
! locals
integer :: int_err(5), ictxt, np, me, mycol,&
& err_act, m, n, iix, jjx, temp(2), ix, ijx, nrow, ncol, k, maxk, iupdate,&
integer :: int_err(5), ictxt, np, me, &
& err_act, m, n, iix, jjx, ix, ijx, nrow, ncol, k, maxk, iupdate,&
& imode, err, liwork, i
complex(kind(1.d0)),pointer :: iwork(:), xp(:,:)
logical :: do_update
@ -272,8 +272,8 @@ subroutine psb_zovrlv(x,desc_a,info,work,update)
integer, intent(in), optional :: update
! locals
integer :: int_err(5), ictxt, np, me, mycol,&
& err_act, m, n, iix, jjx, temp(2), ix, ijx, nrow, ncol, k, maxk, iupdate,&
integer :: int_err(5), ictxt, np, me, &
& err_act, m, n, iix, jjx, ix, ijx, nrow, ncol, k, iupdate,&
& imode, err, liwork, i
complex(kind(1.d0)),pointer :: iwork(:)
logical :: do_update

@ -66,8 +66,8 @@ subroutine psb_zscatterm(globx, locx, desc_a, info, iroot,&
! locals
integer :: int_err(5), ictxt, np, me, mycol,&
& err_act, m, n, iix, jjx, temp(2), i, j, idx, nrow, iiroot, iglobx, jglobx,&
integer :: int_err(5), ictxt, np, me, &
& err_act, m, n, i, j, idx, nrow, iiroot, iglobx, jglobx,&
& ilocx, jlocx, lda_locx, lda_globx, lock, globk, icomm, k, maxk, root, ilx,&
& jlx, myrank, rootrank, c, pos
complex(kind(1.d0)),pointer :: scatterv(:)
@ -311,6 +311,7 @@ subroutine psb_zscatterv(globx, locx, desc_a, info, iroot)
use psb_check_mod
use psb_error_mod
use mpi
use psb_penv_mod
implicit none
complex(kind(1.d0)), intent(out) :: locx(:)
@ -321,9 +322,9 @@ subroutine psb_zscatterv(globx, locx, desc_a, info, iroot)
! locals
integer :: int_err(5), ictxt, np, me, mycol,&
& err_act, m, n, iix, jjx, temp(2), i, j, idx, nrow, iiroot, iglobx, jglobx,&
& ilocx, jlocx, lda_locx, lda_globx, lock, globk, root, k, maxk, icomm, myrank,&
integer :: int_err(5), ictxt, np, me, &
& err_act, m, n, i, j, idx, nrow, iiroot, iglobx, jglobx,&
& ilocx, jlocx, lda_locx, lda_globx, root, k, icomm, myrank,&
& rootrank, c, pos, ilx, jlx
complex(kind(1.d0)),pointer :: scatterv(:)
integer, pointer :: displ(:), l_t_g_all(:), all_dim(:)

@ -41,9 +41,8 @@ subroutine psi_compute_size(desc_data, index_in, dl_lda, info)
integer :: desc_data(:), index_in(:)
! ....local scalars....
integer :: i,np,me,proc, max_index
integer :: ictxt, err, err_act
integer :: ictxt, err_act
! ...local array...
integer :: exch(2)
integer :: int_err(5)
integer, allocatable :: counter_recv(:), counter_dl(:)
@ -118,7 +117,7 @@ subroutine psi_compute_size(desc_data, index_in, dl_lda, info)
9999 continue
call psb_erractionrestore(err_act)
if (err_act.eq.act_abort) then
if (err_act == act_abort) then
call psb_error(ictxt)
return
end if

@ -39,7 +39,7 @@ subroutine psi_crea_bnd_elem(desc_a,info)
integer, pointer :: work(:)
integer :: i, j, nr, ns, k, irv, err_act
character(len=20) :: name, ch_err
character(len=20) :: name
info = 0
name='psi_crea_bnd_elem'

@ -43,14 +43,12 @@ subroutine psi_crea_index(desc_a,index_in,index_out,glob_idx,info)
logical :: glob_idx
! ....local scalars...
integer :: me,np,i,j,k,&
& mode, int_err(5), err, err_act,&
& dl_lda, ictxt, proc, nerv, nesd
integer :: ictxt, me, np, mode, err_act, dl_lda
! ...parameters...
integer, pointer :: dep_list(:,:), length_dl(:)
integer,parameter :: root=0,no_comm=-1
logical,parameter :: debug=.false.
character(len=20) :: name, ch_err
character(len=20) :: name
interface
subroutine psi_compute_size(desc_data,&
@ -131,7 +129,7 @@ subroutine psi_crea_index(desc_a,index_in,index_out,glob_idx,info)
! ....now i can sort dependence list......
call psi_sort_dl(dep_list,length_dl,np,info)
if(info.ne.0) then
if(info /= 0) then
call psb_errpush(4010,name,a_err='psi_sort_dl')
goto 9999
end if
@ -143,7 +141,7 @@ subroutine psi_crea_index(desc_a,index_in,index_out,glob_idx,info)
& length_dl(me),desc_a%loc_to_glob,desc_a%glob_to_loc,&
& index_out,glob_idx,info)
if(info.ne.0) then
if(info /= 0) then
call psb_errpush(4010,name,a_err='psi_desc_index')
goto 9999
end if
@ -154,7 +152,7 @@ subroutine psi_crea_index(desc_a,index_in,index_out,glob_idx,info)
9999 continue
call psb_erractionrestore(err_act)
if (err_act.eq.act_abort) then
if (err_act == act_abort) then
call psb_error(ictxt)
return
end if

@ -46,21 +46,20 @@ subroutine psi_desc_index(desc_data,index_in,dep_list,&
integer :: length_dl, info
logical :: isglob_in
!c ....local scalars...
integer :: j,me,np,i,proc,dim
integer :: j,me,np,i,proc
!c ...parameters...
integer :: ictxt
integer :: no_comm,err
parameter (no_comm=-1)
!c ...local arrays..
integer :: int_err(5)
integer,pointer :: brvindx(:),rvsz(:),&
& bsdindx(:),sdsz(:), sndbuf(:), rcvbuf(:)
integer :: ihinsz,ntot,k,err_act,&
& idxr, idxs, iszs, iszr, nesd, nerv, icomm, iret
& idxr, idxs, iszs, iszr, nesd, nerv, icomm
logical,parameter :: debug=.false., usempi=.true.
character(len=20) :: name, ch_err
character(len=20) :: name
info = 0
name='psi_desc_index'

@ -45,19 +45,17 @@ subroutine psi_dswapdatam(flag,n,beta,y,desc_a,work,info,data)
integer, optional :: data
! locals
integer :: ictxt, np, npcol, me,&
& mycol, point_to_proc, nesd, nerv,&
integer :: ictxt, np, me, point_to_proc, nesd, nerv,&
& proc_to_comm, p2ptag, icomm, p2pstat(mpi_status_size),&
& idxs, idxr, iret, errlen, ifcomm, rank,&
& err_act, totxch, ixrec, i, lw, idx_pt,&
& snd_pt, rcv_pt
& idxs, idxr, iret, err_act, totxch, ixrec, i, &
& idx_pt, snd_pt, rcv_pt
integer :: krecvid, ksendid
integer, pointer, dimension(:) :: bsdidx, brvidx,&
& sdsz, rvsz, prcid, ptp, rvhd, d_idx
integer :: int_err(5)
logical :: swap_mpi, swap_sync, swap_send, swap_recv, all
real(kind(1.d0)), pointer, dimension(:) :: sndbuf, rcvbuf
character(len=20) :: name, ch_err
character(len=20) :: name
info = 0
name='psi_swap_data'
@ -497,12 +495,10 @@ subroutine psi_dswapdatav(flag,beta,y,desc_a,work,info,data)
integer, optional :: data
! locals
integer :: ictxt, np, npcol, me,&
& mycol, point_to_proc, nesd, nerv,&
integer :: ictxt, np, me, point_to_proc, nesd, nerv,&
& proc_to_comm, p2ptag, icomm, p2pstat(mpi_status_size),&
& idxs, idxr, iret, errlen, ifcomm, rank,&
& err_act, totxch, ixrec, i, lw, idx_pt,&
& snd_pt, rcv_pt, n
& idxs, idxr, iret, err_act, totxch, ixrec, i, &
& idx_pt, snd_pt, rcv_pt, n
integer, pointer, dimension(:) :: bsdidx, brvidx,&
& sdsz, rvsz, prcid, ptp, rvhd, d_idx
@ -510,7 +506,7 @@ subroutine psi_dswapdatav(flag,beta,y,desc_a,work,info,data)
integer :: int_err(5)
logical :: swap_mpi, swap_sync, swap_send, swap_recv,all
real(kind(1.d0)), pointer, dimension(:) :: sndbuf, rcvbuf
character(len=20) :: name, ch_err
character(len=20) :: name
info = 0
name='psi_dswap_datav'

@ -45,11 +45,9 @@ subroutine psi_dswaptranm(flag,n,beta,y,desc_a,work,info,data)
integer, optional :: data
! locals
integer :: ictxt, np, npcol, me,&
& mycol, point_to_proc, nesd, nerv,&
integer :: ictxt, np, me, point_to_proc, nesd, nerv,&
& proc_to_comm, p2ptag, icomm, p2pstat(mpi_status_size),&
& idxs, idxr, iret, errlen, ifcomm, rank,&
& err_act, totxch, ixrec, i, lw, idx_pt,&
& idxs, idxr, iret, err_act, totxch, ixrec, i, idx_pt,&
& snd_pt, rcv_pt
integer, pointer, dimension(:) :: bsdidx, brvidx,&
@ -58,7 +56,7 @@ subroutine psi_dswaptranm(flag,n,beta,y,desc_a,work,info,data)
integer :: krecvid, ksendid
logical :: swap_mpi, swap_sync, swap_send, swap_recv, all
real(kind(1.d0)), pointer, dimension(:) :: sndbuf, rcvbuf
character(len=20) :: name, ch_err
character(len=20) :: name
info = 0
name='psi_dswaptranm'
@ -502,11 +500,9 @@ subroutine psi_dswaptranv(flag,beta,y,desc_a,work,info,data)
integer, optional :: data
! locals
integer :: ictxt, np, npcol, me,&
& mycol, point_to_proc, nesd, nerv,&
integer :: ictxt, np, me, point_to_proc, nesd, nerv,&
& proc_to_comm, p2ptag, icomm, p2pstat(mpi_status_size),&
& idxs, idxr, iret, errlen, ifcomm, rank,&
& err_act, totxch, ixrec, i, lw, idx_pt,&
& idxs, idxr, iret, err_act, totxch, ixrec, i, idx_pt,&
& snd_pt, rcv_pt, n
integer, pointer, dimension(:) :: bsdidx, brvidx,&
@ -515,7 +511,7 @@ subroutine psi_dswaptranv(flag,beta,y,desc_a,work,info,data)
integer :: krecvid, ksendid
logical :: swap_mpi, swap_sync, swap_send, swap_recv, all
real(kind(1.d0)), pointer, dimension(:) :: sndbuf, rcvbuf
character(len=20) :: name, ch_err
character(len=20) :: name
info = 0
name='psi_dswaptranv'

@ -45,11 +45,9 @@ subroutine psi_iswapdatam(flag,n,beta,y,desc_a,work,info,data)
integer, optional :: data
! locals
integer :: ictxt, np, npcol, me,&
& mycol, point_to_proc, nesd, nerv,&
integer :: ictxt, np, me, point_to_proc, nesd, nerv,&
& proc_to_comm, p2ptag, icomm, p2pstat(mpi_status_size),&
& idxs, idxr, iret, errlen, ifcomm, rank,&
& err_act, totxch, ixrec, i, lw, idx_pt,&
& idxs, idxr, iret, err_act, totxch, ixrec, i, idx_pt,&
& snd_pt, rcv_pt
integer :: krecvid, ksendid
integer, pointer, dimension(:) :: bsdidx, brvidx,&
@ -57,7 +55,7 @@ subroutine psi_iswapdatam(flag,n,beta,y,desc_a,work,info,data)
integer :: int_err(5)
logical :: swap_mpi, swap_sync, swap_send, swap_recv, all
integer, pointer, dimension(:) :: sndbuf, rcvbuf
character(len=20) :: name, ch_err
character(len=20) :: name
info = 0
name='psi_dswap_data'
@ -497,11 +495,9 @@ subroutine psi_iswapdatav(flag,beta,y,desc_a,work,info,data)
integer, optional :: data
! locals
integer :: ictxt, np, npcol, me,&
& mycol, point_to_proc, nesd, nerv,&
integer :: ictxt, np, me, point_to_proc, nesd, nerv,&
& proc_to_comm, p2ptag, icomm, p2pstat(mpi_status_size),&
& idxs, idxr, iret, errlen, ifcomm, rank,&
& err_act, totxch, ixrec, i, lw, idx_pt,&
& idxs, idxr, iret, err_act, totxch, ixrec, i, idx_pt,&
& snd_pt, rcv_pt, n
integer, pointer, dimension(:) :: bsdidx, brvidx,&
@ -510,7 +506,7 @@ subroutine psi_iswapdatav(flag,beta,y,desc_a,work,info,data)
integer :: int_err(5)
logical :: swap_mpi, swap_sync, swap_send, swap_recv, all
integer, pointer, dimension(:) :: sndbuf, rcvbuf
character(len=20) :: name, ch_err
character(len=20) :: name
info = 0
name='psi_dswap_datav'

@ -45,11 +45,9 @@ subroutine psi_iswaptranm(flag,n,beta,y,desc_a,work,info,data)
integer, optional :: data
! locals
integer :: ictxt, np, npcol, me,&
& mycol, point_to_proc, nesd, nerv,&
integer :: ictxt, np, me, point_to_proc, nesd, nerv,&
& proc_to_comm, p2ptag, icomm, p2pstat(mpi_status_size),&
& idxs, idxr, iret, errlen, ifcomm, rank,&
& err_act, totxch, ixrec, i, lw, idx_pt,&
& idxs, idxr, iret, err_act, totxch, ixrec, i, idx_pt,&
& snd_pt, rcv_pt
integer, pointer, dimension(:) :: bsdidx, brvidx,&
@ -58,7 +56,7 @@ subroutine psi_iswaptranm(flag,n,beta,y,desc_a,work,info,data)
integer :: krecvid, ksendid
logical :: swap_mpi, swap_sync, swap_send, swap_recv, all
integer, pointer, dimension(:) :: sndbuf, rcvbuf
character(len=20) :: name, ch_err
character(len=20) :: name
info = 0
name='psi_dswaptranm'
@ -499,11 +497,9 @@ subroutine psi_iswaptranv(flag,beta,y,desc_a,work,info,data)
integer, optional :: data
! locals
integer :: ictxt, np, npcol, me,&
& mycol, point_to_proc, nesd, nerv,&
integer :: ictxt, np, me, point_to_proc, nesd, nerv,&
& proc_to_comm, p2ptag, icomm, p2pstat(mpi_status_size),&
& idxs, idxr, iret, errlen, ifcomm, rank,&
& err_act, totxch, ixrec, i, lw, idx_pt,&
& idxs, idxr, iret, err_act, totxch, ixrec, i, idx_pt,&
& snd_pt, rcv_pt, n
integer, pointer, dimension(:) :: bsdidx, brvidx,&
@ -512,7 +508,7 @@ subroutine psi_iswaptranv(flag,beta,y,desc_a,work,info,data)
integer :: krecvid, ksendid
logical :: swap_mpi, swap_sync, swap_send, swap_recv, all
integer, pointer, dimension(:) :: sndbuf, rcvbuf
character(len=20) :: name, ch_err
character(len=20) :: name
info = 0

@ -42,10 +42,10 @@ subroutine psi_sort_dl(dep_list,l_dep_list,np,info)
integer :: i, info
integer, pointer :: work(:)
logical, parameter :: debug=.false.
character(len=20) :: name, ch_err
character(len=20) :: name
name='psi_sort_dl'
if(psb_get_errstatus().ne.0) return
if(psb_get_errstatus() /= 0) return
info=0
call psb_erractionsave(err_act)
@ -69,7 +69,7 @@ subroutine psi_sort_dl(dep_list,l_dep_list,np,info)
call srtlist(dep_list,size(dep_list,1),l_dep_list,np,work(idg),&
& work(idgp),work(iupd),work(iedges),work(iidx),work(iich),info)
if (info .ne. 0) then
if (info /= 0) then
call psb_errpush(4010,name,a_err='srtlist')
goto 9999
endif
@ -81,7 +81,7 @@ subroutine psi_sort_dl(dep_list,l_dep_list,np,info)
9999 continue
call psb_erractionrestore(err_act)
if (err_act.eq.act_abort) then
if (err_act == act_abort) then
call psb_error()
return
end if

@ -45,11 +45,9 @@ subroutine psi_zswapdatam(flag,n,beta,y,desc_a,work,info,data)
integer, optional :: data
! locals
integer :: ictxt, np, npcol, me,&
& mycol, point_to_proc, nesd, nerv,&
integer :: ictxt, np, me, point_to_proc, nesd, nerv,&
& proc_to_comm, p2ptag, icomm, p2pstat(mpi_status_size),&
& idxs, idxr, iret, errlen, ifcomm, rank,&
& err_act, totxch, ixrec, i, lw, idx_pt,&
& idxs, idxr, iret, err_act, totxch, ixrec, i, idx_pt,&
& snd_pt, rcv_pt
integer :: krecvid, ksendid
integer, pointer, dimension(:) :: bsdidx, brvidx,&
@ -57,7 +55,7 @@ subroutine psi_zswapdatam(flag,n,beta,y,desc_a,work,info,data)
integer :: int_err(5)
logical :: swap_mpi, swap_sync, swap_send, swap_recv, all
complex(kind(1.d0)), pointer, dimension(:) :: sndbuf, rcvbuf
character(len=20) :: name, ch_err
character(len=20) :: name
info = 0
name='psi_zswap_data'
@ -497,11 +495,9 @@ subroutine psi_zswapdatav(flag,beta,y,desc_a,work,info,data)
integer, optional :: data
! locals
integer :: ictxt, np, npcol, me,&
& mycol, point_to_proc, nesd, nerv,&
integer :: ictxt, np, me, point_to_proc, nesd, nerv,&
& proc_to_comm, p2ptag, icomm, p2pstat(mpi_status_size),&
& idxs, idxr, iret, errlen, ifcomm, rank,&
& err_act, totxch, ixrec, i, lw, idx_pt,&
& idxs, idxr, iret, err_act, totxch, ixrec, i, idx_pt,&
& snd_pt, rcv_pt, n
integer, pointer, dimension(:) :: bsdidx, brvidx,&
@ -510,7 +506,7 @@ subroutine psi_zswapdatav(flag,beta,y,desc_a,work,info,data)
integer :: int_err(5)
logical :: swap_mpi, swap_sync, swap_send, swap_recv,all
complex(kind(1.d0)), pointer, dimension(:) :: sndbuf, rcvbuf
character(len=20) :: name, ch_err
character(len=20) :: name
info = 0
name='psi_zswap_datav'

@ -45,11 +45,9 @@ subroutine psi_zswaptranm(flag,n,beta,y,desc_a,work,info,data)
integer, optional :: data
! locals
integer :: ictxt, np, npcol, me,&
& mycol, point_to_proc, nesd, nerv,&
integer :: ictxt, np, me, point_to_proc, nesd, nerv,&
& proc_to_comm, p2ptag, icomm, p2pstat(mpi_status_size),&
& idxs, idxr, iret, errlen, ifcomm, rank,&
& err_act, totxch, ixrec, i, lw, idx_pt,&
& idxs, idxr, iret, err_act, totxch, ixrec, i, idx_pt,&
& snd_pt, rcv_pt
integer, pointer, dimension(:) :: bsdidx, brvidx,&
@ -58,7 +56,7 @@ subroutine psi_zswaptranm(flag,n,beta,y,desc_a,work,info,data)
integer :: krecvid, ksendid
logical :: swap_mpi, swap_sync, swap_send, swap_recv, all
complex(kind(1.d0)), pointer, dimension(:) :: sndbuf, rcvbuf
character(len=20) :: name, ch_err
character(len=20) :: name
info = 0
name='psi_zswaptranm'
@ -502,11 +500,9 @@ subroutine psi_zswaptranv(flag,beta,y,desc_a,work,info,data)
integer, optional :: data
! locals
integer :: ictxt, np, npcol, me,&
& mycol, point_to_proc, nesd, nerv,&
integer :: ictxt, np, me, point_to_proc, nesd, nerv,&
& proc_to_comm, p2ptag, icomm, p2pstat(mpi_status_size),&
& idxs, idxr, iret, errlen, ifcomm, rank,&
& err_act, totxch, ixrec, i, lw, idx_pt,&
& idxs, idxr, iret, err_act, totxch, ixrec, i, idx_pt,&
& snd_pt, rcv_pt, n
integer, pointer, dimension(:) :: bsdidx, brvidx,&
@ -515,7 +511,7 @@ subroutine psi_zswaptranv(flag,beta,y,desc_a,work,info,data)
integer :: krecvid, ksendid
logical :: swap_mpi, swap_sync, swap_send, swap_recv, all
complex(kind(1.d0)), pointer, dimension(:) :: sndbuf, rcvbuf
character(len=20) :: name, ch_err
character(len=20) :: name
info = 0
name='psi_zswaptranv'

@ -101,7 +101,7 @@ subroutine psb_dbicg(a,prec,b,x,eps,desc_a,info,&
real(kind(1.d0)), pointer :: aux(:),wwrk(:,:)
real(kind(1.d0)), pointer :: ww(:), q(:),&
& r(:), p(:), zt(:), pt(:), z(:), rt(:),qt(:)
integer, pointer :: iperm(:), ipnull(:), ipsave(:), int_err(:)
integer :: int_err(5)
real(kind(1.d0)) ::rerr
integer ::litmax, liter, naux, m, mglob, it, itrace_,&
& np,me, n_row, n_col, istop_, err_act
@ -109,10 +109,9 @@ subroutine psb_dbicg(a,prec,b,x,eps,desc_a,info,&
logical, parameter :: debug = .false.
logical, parameter :: exchange=.true., noexchange=.false.
integer, parameter :: irmax = 8
integer :: itx, i, isvch, ich, ictxt
logical :: do_renum_left
integer :: itx, i, isvch, ictxt
real(kind(1.d0)) :: alpha, beta, rho, rho_old, rni, xni, bni, ani,&
& sigma, omega, tau,bn2
& sigma,bn2
character(len=20) :: name,ch_err
info = 0

@ -105,9 +105,9 @@ Subroutine psb_dcg(a,prec,b,x,eps,desc_a,info,&
& sigma
integer :: litmax, liter, istop_, naux, m, mglob, it, itx, itrace_,&
& np,me, n_col, isvch, ich, ictxt, n_row,err_act, int_err(5)
character ::diagl, diagu
character :: diagl, diagu
logical, parameter :: exchange=.true., noexchange=.false.
character(len=20) :: name,ch_err
character(len=20) :: name
info = 0
name = 'psb_dcg'

@ -98,19 +98,17 @@ Subroutine psb_dcgs(a,prec,b,x,eps,desc_a,info,&
!!$ local data
Real(Kind(1.d0)), Pointer :: aux(:),wwrk(:,:)
Real(Kind(1.d0)), Pointer :: ww(:), q(:),&
& r(:), p(:), v(:), s(:), t(:), z(:), f(:), rt(:),qt(:),uv(:)
Integer, Pointer :: iperm(:), ipnull(:), ipsave(:)
Real(Kind(1.d0)) ::rerr
Integer ::litmax, liter, naux, m, mglob, it, itrace_,int_err(5),&
& np,me,mecol, n_row, n_col,istop_, err_act
& r(:), p(:), v(:), s(:), z(:), f(:), rt(:),qt(:),uv(:)
Real(Kind(1.d0)) :: rerr
Integer :: litmax, naux, m, mglob, it, itrace_,int_err(5),&
& np,me, n_row, n_col,istop_, err_act
Character ::diagl, diagu
Logical, Parameter :: exchange=.True., noexchange=.False.
Integer, Parameter :: irmax = 8
Integer :: itx, i, isvch, ich, ictxt
Logical :: do_renum_left
Logical, Parameter :: debug = .false.
Real(Kind(1.d0)) :: alpha, beta, rho, rho_old, rni, xni, bni, ani,bn2,&
& sigma, omega, tau
& sigma
character(len=20) :: name,ch_err
info = 0

@ -99,22 +99,20 @@ Subroutine psb_dcgstab(a,prec,b,x,eps,desc_a,info,&
Real(Kind(1.d0)), Pointer :: aux(:),wwrk(:,:)
Real(Kind(1.d0)), Pointer :: q(:),&
& r(:), p(:), v(:), s(:), t(:), z(:), f(:)
Integer, Pointer :: iperm(:), ipnull(:), ipsave(:)
Real(Kind(1.d0)) ::rerr
Integer ::litmax, liter, naux, m, mglob, it,itrace_,&
Real(Kind(1.d0)) :: rerr
Integer :: litmax, naux, m, mglob, it,itrace_,&
& np,me, n_row, n_col
Character ::diagl, diagu
Logical, Parameter :: debug = .false.
Logical, Parameter :: exchange=.True., noexchange=.False., debug1 = .False.
Integer, Parameter :: irmax = 8
Integer :: itx, i, isvch, ich, ictxt, err_act, int_err(5),ii
Integer :: itx, i, isvch, ictxt, err_act, int_err(5),ii
Integer :: istop_
Logical :: do_renum_left
Real(Kind(1.d0)) :: alpha, beta, rho, rho_old, rni, xni, bni, ani,&
& sigma, omega, tau, rn0, bn2
!!$ Integer istpb, istpe, ifctb, ifcte, imerr, irank, icomm,immb,imme
!!$ Integer mpe_log_get_event_number,mpe_Describe_state,mpe_log_event
character(len=20) :: name,ch_err
character(len=20) :: name
info = 0
name = 'psb_dcgstab'

@ -106,21 +106,19 @@ Subroutine psb_dcgstabl(a,prec,b,x,eps,desc_a,info,&
Real(Kind(1.d0)), Pointer :: aux(:),wwrk(:,:)
Real(Kind(1.d0)), Pointer :: ww(:), q(:), r(:), rt0(:), p(:), v(:), &
& s(:), t(:), z(:), f(:), uh(:,:), rh(:,:), &
& gamma(:), gamma1(:), gamma2(:), taum(:,:), sigma(:),&
&pv1(:), pv2(:), pm1(:,:), pm2(:,:)
Integer, Pointer :: iperm(:), ipnull(:), ipsave(:)
Real(Kind(1.d0)) ::rerr
Integer ::litmax, liter, naux, m, mglob, it, itrace_,&
& gamma(:), gamma1(:), gamma2(:), taum(:,:), sigma(:)
Real(Kind(1.d0)) :: rerr
Integer :: litmax, naux, m, mglob, it, itrace_,&
& np,me, n_row, n_col, nl, err_act
Character ::diagl, diagu
Logical, Parameter :: exchange=.True., noexchange=.False.
Integer, Parameter :: irmax = 8
Integer :: itx, i, isvch, ich, ictxt,istop_,j, int_err(5)
Logical :: do_renum_left
Logical, Parameter :: debug = .False.
Real(Kind(1.d0)) :: alpha, beta, rho, rho_old, rni, xni, bni, ani,bn2,&
& omega, tau
character(len=20) :: name,ch_err
character(len=20) :: name
info = 0
name = 'psb_dcgstabl'

@ -105,25 +105,20 @@ Subroutine psb_dgmresr(a,prec,b,x,eps,desc_a,info,&
Integer, Optional, Intent(out) :: iter
Real(Kind(1.d0)), Optional, Intent(out) :: err
!!$ local data
Real(Kind(1.d0)), Pointer :: aux(:),wwrk(:,:)
Real(Kind(1.d0)), Pointer :: w(:), q(:), r(:), rt0(:), p(:), v(:,:), &
& c(:),s(:), t(:), z(:), f(:), uh(:,:), h(:,:), rs(:),&
& gamma(:), gamma1(:), gamma2(:), taum(:,:), sigma(:),&
&pv1(:), pv2(:), pm1(:,:), rr(:,:)
Integer, Pointer :: iperm(:), ipnull(:), ipsave(:), ierrv(:)
Real(Kind(1.d0)), Pointer :: aux(:)
Real(Kind(1.d0)), Pointer :: w(:), v(:,:), &
& c(:),s(:), h(:,:), rs(:), rr(:,:)
Real(Kind(1.d0)) :: rerr, scal, gm
Integer ::litmax, liter, naux, m, mglob, it,k, itrace_,&
& np,me, n_row, n_col, nl, int_err(5)
Character ::diagl, diagu
Character :: diagl, diagu
Logical, Parameter :: exchange=.True., noexchange=.False.
Integer, Parameter :: irmax = 8
Integer :: itx, i, isvch, ich, ictxt,istop_, err_act
Logical :: do_renum_left,inner_stop
Logical, Parameter :: debug = .false.
Real(Kind(1.d0)) :: alpha, beta, rho, rho_old, rni, xni, bni, ani,bn2,&
& omega, tau
Real(Kind(1.d0)) :: rni, xni, bni, ani,bn2
real(kind(1.d0)), external :: dnrm2
character(len=20) :: name,ch_err
character(len=20) :: name
info = 0
name = 'psb_dgmres'

@ -98,20 +98,19 @@ Subroutine psb_zcgs(a,prec,b,x,eps,desc_a,info,&
!!$ local data
Complex(Kind(1.d0)), Pointer :: aux(:),wwrk(:,:)
Complex(Kind(1.d0)), Pointer :: ww(:), q(:),&
& r(:), p(:), v(:), s(:), t(:), z(:), f(:), rt(:),qt(:),uv(:)
Integer, Pointer :: iperm(:), ipnull(:), ipsave(:)
Real(Kind(1.d0)) ::rerr
Integer ::litmax, liter, naux, m, mglob, it, itrace_,int_err(5),&
& r(:), p(:), v(:), s(:), z(:), f(:), rt(:),qt(:),uv(:)
Real(Kind(1.d0)) :: rerr
Integer :: litmax, naux, m, mglob, it, itrace_,int_err(5),&
& np,me, n_row, n_col,istop_, err_act
Character ::diagl, diagu
Logical, Parameter :: exchange=.True., noexchange=.False.
Integer, Parameter :: irmax = 8
Integer :: itx, i, isvch, ich, ictxt
Integer :: itx, i, isvch, ictxt
Logical :: do_renum_left
Logical, Parameter :: debug = .false.
Real(Kind(1.d0)) :: rni, xni, bni, ani,bn2
complex(Kind(1.d0)) :: alpha, beta, rho, rho_old, sigma, omega, tau
character(len=20) :: name,ch_err
complex(Kind(1.d0)) :: alpha, beta, rho, rho_old, sigma
character(len=20) :: name
info = 0
name = 'psb_zcgs'

@ -99,9 +99,8 @@ Subroutine psb_zcgstab(a,prec,b,x,eps,desc_a,info,&
Complex(Kind(1.d0)), Pointer :: aux(:),wwrk(:,:)
Complex(Kind(1.d0)), Pointer :: q(:),&
& r(:), p(:), v(:), s(:), t(:), z(:), f(:)
Integer, Pointer :: iperm(:), ipnull(:), ipsave(:)
Real(Kind(1.d0)) :: rerr
Integer :: litmax, liter, naux, m, mglob, it,itrace_,&
Integer :: litmax, naux, m, mglob, it,itrace_,&
& np,me, n_row, n_col
Character ::diagl, diagu
Logical, Parameter :: debug = .false.
@ -109,12 +108,11 @@ Subroutine psb_zcgstab(a,prec,b,x,eps,desc_a,info,&
Integer, Parameter :: irmax = 8
Integer :: itx, i, isvch, ich, ictxt, err_act, int_err(5),ii
Integer :: istop_
Logical :: do_renum_left
complex(Kind(1.d0)) :: alpha, beta, rho, rho_old, sigma, omega, tau
Real(Kind(1.d0)) :: rni, xni, bni, ani, rn0, bn2
!!$ Integer istpb, istpe, ifctb, ifcte, imerr, irank, icomm,immb,imme
!!$ Integer mpe_log_get_event_number,mpe_Describe_state,mpe_log_event
character(len=20) :: name,ch_err
character(len=20) :: name
info = 0
name = 'psb_zcgstab'

@ -37,8 +37,8 @@ module psb_error_mod
& psb_get_erraction, psb_set_erraction
interface psb_error
module procedure psb_serror
module procedure psb_perror
module procedure psb_serror
module procedure psb_perror
end interface
!!$ integer, parameter :: act_ret=0, act_abort=1, no_err=0
@ -47,21 +47,21 @@ module psb_error_mod
type psb_errstack_node
integer :: err_code=0 ! the error code
character(len=20) :: routine='' ! the name of the routine generating the error
integer,dimension(5) :: i_err_data=0 ! array of integer data to complete the error msg
! real(kind(1.d0))(dim=10) :: r_err_data=0.d0 ! array of real data to complete the error msg
! complex(dim=10) :: c_err_data=0.c0 ! array of complex data to complete the error msg
character(len=20) :: a_err_data='' ! array of character data to complete the error msg
type(psb_errstack_node), pointer :: next ! pointer to the next element in the stack
integer :: err_code=0 ! the error code
character(len=20) :: routine='' ! the name of the routine generating the error
integer,dimension(5) :: i_err_data=0 ! array of integer data to complete the error msg
! real(kind(1.d0))(dim=10) :: r_err_data=0.d0 ! array of real data to complete the error msg
! complex(dim=10) :: c_err_data=0.c0 ! array of complex data to complete the error msg
character(len=20) :: a_err_data='' ! array of character data to complete the error msg
type(psb_errstack_node), pointer :: next ! pointer to the next element in the stack
end type psb_errstack_node
type psb_errstack
type(psb_errstack_node), pointer :: top => null() ! pointer to the top element of the stack
integer :: n_elems=0 ! number of entries in the stack
type(psb_errstack_node), pointer :: top => null() ! pointer to the top element of the stack
integer :: n_elems=0 ! number of entries in the stack
end type psb_errstack
@ -198,34 +198,34 @@ contains
integer :: err_c
character(len=20) :: r_name, a_e_d
integer :: i_e_d(5)
integer :: nprow, npcol, me, mypcol, temp(2)
integer :: nprow, npcol, me, mypcol
integer, parameter :: ione=1, izero=0
call blacs_gridinfo(ictxt, nprow, npcol, me, mypcol)
if(error_status.gt.0) then
if(verbosity_level.gt.1) then
do while (error_stack%n_elems.gt.izero)
write(0,'(50("="))')
call psb_errpop(err_c, r_name, i_e_d, a_e_d)
call psb_errmsg(err_c, r_name, i_e_d, a_e_d,me)
! write(0,'(50("="))')
end do
call blacs_abort(ictxt,-1)
else
if(verbosity_level.gt.1) then
do while (error_stack%n_elems.gt.izero)
write(0,'(50("="))')
call psb_errpop(err_c, r_name, i_e_d, a_e_d)
call psb_errmsg(err_c, r_name, i_e_d, a_e_d,me)
do while (error_stack%n_elems.gt.0)
call psb_errpop(err_c, r_name, i_e_d, a_e_d)
end do
call blacs_abort(ictxt,-1)
end if
! write(0,'(50("="))')
end do
call blacs_abort(ictxt,-1)
else
call psb_errpop(err_c, r_name, i_e_d, a_e_d)
call psb_errmsg(err_c, r_name, i_e_d, a_e_d,me)
do while (error_stack%n_elems.gt.0)
call psb_errpop(err_c, r_name, i_e_d, a_e_d)
end do
call blacs_abort(ictxt,-1)
end if
end if
if(error_status.gt.izero) then
call blacs_abort(ictxt,err_c)
call blacs_abort(ictxt,err_c)
end if
@ -238,27 +238,26 @@ contains
integer :: err_c
character(len=20) :: r_name, a_e_d
integer :: i_e_d(5)
integer :: nprow, npcol, me, mypcol, temp(2)
integer, parameter :: ione=1, izero=0
if(error_status.gt.0) then
if(verbosity_level.gt.1) then
if(verbosity_level.gt.1) then
do while (error_stack%n_elems.gt.izero)
write(0,'(50("="))')
call psb_errpop(err_c, r_name, i_e_d, a_e_d)
call psb_errmsg(err_c, r_name, i_e_d, a_e_d)
! write(0,'(50("="))')
end do
do while (error_stack%n_elems.gt.izero)
write(0,'(50("="))')
call psb_errpop(err_c, r_name, i_e_d, a_e_d)
call psb_errmsg(err_c, r_name, i_e_d, a_e_d)
! write(0,'(50("="))')
end do
else
else
call psb_errpop(err_c, r_name, i_e_d, a_e_d)
call psb_errmsg(err_c, r_name, i_e_d, a_e_d)
do while (error_stack%n_elems.gt.0)
call psb_errpop(err_c, r_name, i_e_d, a_e_d)
call psb_errmsg(err_c, r_name, i_e_d, a_e_d)
do while (error_stack%n_elems.gt.0)
call psb_errpop(err_c, r_name, i_e_d, a_e_d)
end do
end if
end do
end if
end if
end subroutine psb_serror
@ -273,188 +272,188 @@ contains
integer, optional :: me
if(present(me)) then
write(0,'("Process: ",i0,". PSBLAS Error (",i0,") in subroutine: ",a20)')me,err_c,r_name
write(0,'("Process: ",i0,". PSBLAS Error (",i0,") in subroutine: ",a20)')me,err_c,r_name
else
write(0,'("PSBLAS Error (",i0,") in subroutine: ",a20)')err_c,r_name
write(0,'("PSBLAS Error (",i0,") in subroutine: ",a20)')err_c,r_name
end if
select case (err_c)
case(:0)
write (0,'("error on calling sperror. err_c must be greater than 0")')
write (0,'("error on calling sperror. err_c must be greater than 0")')
case(2)
write (0,'("pivot too small: ",i0,1x,a)')i_e_d(1),a_e_d
write (0,'("pivot too small: ",i0,1x,a)')i_e_d(1),a_e_d
case(3)
write (0,'("Invalid number of ovr:",i0)')i_e_d(1)
write (0,'("Invalid number of ovr:",i0)')i_e_d(1)
case(5)
write (0,'("Invalid input")')
write (0,'("Invalid input")')
case(10)
write (0,'("input argument n. ",i0," cannot be less than 0")')i_e_d(1)
write (0,'("current value is ",i0)')i_e_d(2)
write (0,'("input argument n. ",i0," cannot be less than 0")')i_e_d(1)
write (0,'("current value is ",i0)')i_e_d(2)
case(20)
write (0,'("input argument n. ",i0," cannot be greater than 0")')i_e_d(1)
write (0,'("current value is ",i0)')i_e_d(2)
write (0,'("input argument n. ",i0," cannot be greater than 0")')i_e_d(1)
write (0,'("current value is ",i0)')i_e_d(2)
case(30)
write (0,'("input argument n. ",i0," has an invalid value")')i_e_d(1)
write (0,'("current value is ",i0)')i_e_d(2)
write (0,'("input argument n. ",i0," has an invalid value")')i_e_d(1)
write (0,'("current value is ",i0)')i_e_d(2)
case(35)
write (0,'("Size of input array argument n. ",i0," is invalid.")')i_e_d(1)
write (0,'("Current value is ",i0)')i_e_d(2)
write (0,'("Size of input array argument n. ",i0," is invalid.")')i_e_d(1)
write (0,'("Current value is ",i0)')i_e_d(2)
case(40)
write (0,'("input argument n. ",i0," has an invalid value")')i_e_d(1)
write (0,'("current value is ",a)')a_e_d(2:2)
write (0,'("input argument n. ",i0," has an invalid value")')i_e_d(1)
write (0,'("current value is ",a)')a_e_d(2:2)
case(50)
write (0,'("input argument n. ",i0," must be equal or greater than input argument n. ",i0)') i_e_d(1), i_e_d(3)
write (0,'("current values are ",i0," < ",i0)') i_e_d(2),i_e_d(5)
write (0,'("input argument n. ",i0," must be equal or greater than input argument n. ",i0)') i_e_d(1), i_e_d(3)
write (0,'("current values are ",i0," < ",i0)') i_e_d(2),i_e_d(5)
case(60)
write (0,'("input argument n. ",i0," must be greater than or equal to ",i0)')i_e_d(1),i_e_d(2)
write (0,'("current value is ",i0," < ",i0)')i_e_d(3), i_e_d(2)
write (0,'("input argument n. ",i0," must be greater than or equal to ",i0)')i_e_d(1),i_e_d(2)
write (0,'("current value is ",i0," < ",i0)')i_e_d(3), i_e_d(2)
case(70)
write (0,'("input argument n. ",i0," in entry # ",i0," has an invalid value")')i_e_d(1:2)
write (0,'("current value is ",a)')a_e_d
write (0,'("input argument n. ",i0," in entry # ",i0," has an invalid value")')i_e_d(1:2)
write (0,'("current value is ",a)')a_e_d
case(71)
write (0,'("Impossible error in ASB: nrow>ncol,")')
write (0,'("Actual values are ",i0," > ",i0)')i_e_d(1:2)
! ... csr format error ...
write (0,'("Impossible error in ASB: nrow>ncol,")')
write (0,'("Actual values are ",i0," > ",i0)')i_e_d(1:2)
! ... csr format error ...
case(80)
write (0,'("input argument ia2(1) is less than 0")')
write (0,'("current value is ",i0)')i_e_d(1)
! ... csr format error ...
write (0,'("input argument ia2(1) is less than 0")')
write (0,'("current value is ",i0)')i_e_d(1)
! ... csr format error ...
case(90)
write (0,'("indices in ia2 array are not in increasing order")')
write (0,'("indices in ia2 array are not in increasing order")')
case(91)
write (0,'("indices in ia1 array are not in increasing order")')
! ... csr format error ...
write (0,'("indices in ia1 array are not in increasing order")')
! ... csr format error ...
case(100)
write (0,'("indices in ia1 array are not within problem dimension")')
write (0,'("problem dimension is ",i0)')i_e_d(1)
write (0,'("indices in ia1 array are not within problem dimension")')
write (0,'("problem dimension is ",i0)')i_e_d(1)
case(110)
write (0,'("invalid combination of input arguments")')
write (0,'("invalid combination of input arguments")')
case(115)
write (0,'("Invalid process identifier in input array argument n. ",i0,".")')i_e_d(1)
write (0,'("Current value is ",i0)')i_e_d(2)
write (0,'("Invalid process identifier in input array argument n. ",i0,".")')i_e_d(1)
write (0,'("Current value is ",i0)')i_e_d(2)
case(120)
write (0,'("input argument n. ",i0," must be greater than input argument n. ",i0)')i_e_d(1:2)
write (0,'("current values are ",i0," < ",i0)') i_e_d(3:4)
! ... coo format error ...
write (0,'("input argument n. ",i0," must be greater than input argument n. ",i0)')i_e_d(1:2)
write (0,'("current values are ",i0," < ",i0)') i_e_d(3:4)
! ... coo format error ...
case(130)
write (0,'("there are duplicated elements in coo format")')
write (0,'("please set repflag flag to 2 or 3")')
write (0,'("there are duplicated elements in coo format")')
write (0,'("please set repflag flag to 2 or 3")')
case(134)
write (0,'("Invalid input format ",a3)')a_e_d(1:3)
write (0,'("Invalid input format ",a3)')a_e_d(1:3)
case(135)
write (0,'("Format ",a3," not yet supported here")')a_e_d(1:3)
write (0,'("Format ",a3," not yet supported here")')a_e_d(1:3)
case(136)
write (0,'("Format ",a3," is unknown")')a_e_d(1:3)
write (0,'("Format ",a3," is unknown")')a_e_d(1:3)
case(140)
write (0,'("indices in input array are not within problem dimension ",2(i0,2x))')i_e_d(1:2)
write (0,'("indices in input array are not within problem dimension ",2(i0,2x))')i_e_d(1:2)
case(150)
write (0,'("indices in input array are not belonging to the calling process ",i0)')i_e_d(1)
write (0,'("indices in input array are not belonging to the calling process ",i0)')i_e_d(1)
case(290)
write (0,'("Is not possible to call this routine without calling before psdalloc on the same matrix")')
write (0,'("Is not possible to call this routine without calling before psdalloc on the same matrix")')
case(295)
write (0,'("Is not possible to call this routine without calling before psdspalloc on the same matrix")')
write (0,'("Is not possible to call this routine without calling before psdspalloc on the same matrix")')
case(300)
write (0,'("Input argument n. ",i0," must be equal to entry n. ",i0," in array input argument n.",i0)') &
& i_e_d(1),i_e_d(4),i_e_d(3)
write (0,'("Current values are ",i0," != ",i0)')i_e_d(2), i_e_d(5)
write (0,'("Input argument n. ",i0," must be equal to entry n. ",i0," in array input argument n.",i0)') &
& i_e_d(1),i_e_d(4),i_e_d(3)
write (0,'("Current values are ",i0," != ",i0)')i_e_d(2), i_e_d(5)
case(400)
write (0,'("MPI error:",i0)')i_e_d(1)
write (0,'("MPI error:",i0)')i_e_d(1)
case(550)
write (0,'("Parameter n. ",i0," must be equal on all BLACS processes. ",i0)')i_e_d(1)
write (0,'("Parameter n. ",i0," must be equal on all BLACS processes. ",i0)')i_e_d(1)
case(570)
write (0,'("partition function passed as input argument n. ",i0," returns number of processes")')i_e_d(1)
write (0,'("greater than No of grid s processes on global point ",i0,". Actual number of grid s ")')i_e_d(4)
write (0,'("processes is ",i0,", number returned is ",i0)')i_e_d(2),i_e_d(3)
write (0,'("partition function passed as input argument n. ",i0," returns number of processes")')i_e_d(1)
write (0,'("greater than No of grid s processes on global point ",i0,". Actual number of grid s ")')i_e_d(4)
write (0,'("processes is ",i0,", number returned is ",i0)')i_e_d(2),i_e_d(3)
case(575)
write (0,'("partition function passed as input argument n. ",i0," returns number of processes")')i_e_d(1)
write (0,'("less or equal to 0 on global point ",i0,". Number returned is ",i0)')i_e_d(3),i_e_d(2)
write (0,'("partition function passed as input argument n. ",i0," returns number of processes")')i_e_d(1)
write (0,'("less or equal to 0 on global point ",i0,". Number returned is ",i0)')i_e_d(3),i_e_d(2)
case(580)
write (0,'("partition function passed as input argument n. ",i0," returns wrong processes identifier")')i_e_d(1)
write (0,'("on global point ",i0,". Current value returned is : ",i0)')i_e_d(3),i_e_d(2)
write (0,'("partition function passed as input argument n. ",i0," returns wrong processes identifier")')i_e_d(1)
write (0,'("on global point ",i0,". Current value returned is : ",i0)')i_e_d(3),i_e_d(2)
case(600)
write (0,'("Sparse Matrix and decsriptors are in an invalid state for this subroutine call: ",i0)')i_e_d(1)
write (0,'("Sparse Matrix and decsriptors are in an invalid state for this subroutine call: ",i0)')i_e_d(1)
case (1122)
write (0,'("Invalid state for DESC_A")')
write (0,'("Invalid state for DESC_A")')
case (1123)
write (0,'("Invalid combined state for A and DESC_A")')
write (0,'("Invalid combined state for A and DESC_A")')
case(1124:1999)
write (0,'("computational error. code: ",i0)')err_c
write (0,'("computational error. code: ",i0)')err_c
case(2010)
write (0,'("BLACS error. Number of processes=-1")')
write (0,'("BLACS error. Number of processes=-1")')
case(2011)
write (0,'("Initialization error: not enough processes available in the parallel environment")')
write (0,'("Initialization error: not enough processes available in the parallel environment")')
case(2025)
write (0,'("Cannot allocate ",i0," bytes")')i_e_d(1)
write (0,'("Cannot allocate ",i0," bytes")')i_e_d(1)
case(2030)
write (0,'("BLACS ERROR: Number of grid columns must be equal to 1\nCurrent value is ",i4," != 1.")')i_e_d(1)
write (0,'("BLACS ERROR: Number of grid columns must be equal to 1\nCurrent value is ",i4," != 1.")')i_e_d(1)
case(2231)
write (0,'("Invalid input state for matrix.")')
write (0,'("Invalid input state for matrix.")')
case(2232)
write (0,'("Input state for matrix is not adequate for regeneration.")')
write (0,'("Input state for matrix is not adequate for regeneration.")')
case (2233:2999)
write(0,'("resource error. code: ",i0)')err_c
write(0,'("resource error. code: ",i0)')err_c
case(3000:3009)
write (0,'("sparse matrix representation ",a3," not yet implemented")')a_e_d(1:3)
write (0,'("sparse matrix representation ",a3," not yet implemented")')a_e_d(1:3)
case(3010)
write (0,'("Case lld not equal matrix_data[N_COL_] is not yet implemented.")')
write (0,'("Case lld not equal matrix_data[N_COL_] is not yet implemented.")')
case(3015)
write (0,'("transpose option for sparse matrix representation ",a3," not implemented")')a_e_d(1:3)
write (0,'("transpose option for sparse matrix representation ",a3," not implemented")')a_e_d(1:3)
case(3020)
write (0,'("Case trans = C is not yet implemented.")')
write (0,'("Case trans = C is not yet implemented.")')
case(3021)
write (0,'("Case trans /= N is not yet implemented.")')
write (0,'("Case trans /= N is not yet implemented.")')
case(3022)
write (0,'("Only unit diagonal so far for triangular matrices. ")')
write (0,'("Only unit diagonal so far for triangular matrices. ")')
case(3023)
write (0,'("Cases DESCRA(1:1)=S DESCRA(1:1)=T not yet implemented. ")')
write (0,'("Cases DESCRA(1:1)=S DESCRA(1:1)=T not yet implemented. ")')
case(3024)
write (0,'("Cases DESCRA(1:1)=G not yet implemented. ")')
write (0,'("Cases DESCRA(1:1)=G not yet implemented. ")')
case(3030)
write (0,'("Case ja/=ix or ia/=iy is not yet implemented.")')
write (0,'("Case ja/=ix or ia/=iy is not yet implemented.")')
case(3040)
write (0,'("Case ix /= 1 or iy /= 1 is not yet implemented.")')
write (0,'("Case ix /= 1 or iy /= 1 is not yet implemented.")')
case(3050)
write (0,'("Case ix /= iy is not yet implemented.")')
write (0,'("Case ix /= iy is not yet implemented.")')
case(3060)
write (0,'("Case ix /= 1 is not yet implemented.")')
write (0,'("Case ix /= 1 is not yet implemented.")')
case(3070)
write (0,'("This operation is only implemented with no overlap.")')
write (0,'("This operation is only implemented with no overlap.")')
case(3080)
write (0,'("Decompostion type ",i0," not yet supported.")')i_e_d(1)
write (0,'("Decompostion type ",i0," not yet supported.")')i_e_d(1)
case(3090)
write (0,'("Insert matrix mode not yet implemented.")')
write (0,'("Insert matrix mode not yet implemented.")')
case(3100)
write (0,'("Error on index. Element has not been inserted")')
write (0,'("local index is: ",i0," and global index is:",i0)')i_e_d(1:2)
write (0,'("Error on index. Element has not been inserted")')
write (0,'("local index is: ",i0," and global index is:",i0)')i_e_d(1:2)
case(3110)
write (0,'("Before you call this routine, you must assembly sparse matrix")')
write (0,'("Before you call this routine, you must assembly sparse matrix")')
case(3111:3999)
write(0,'("miscellaneus error. code: ",i0)')err_c
write(0,'("miscellaneus error. code: ",i0)')err_c
case(4000)
write(0,'("Allocation/deallocation error")')
write(0,'("Allocation/deallocation error")')
case(4010)
write (0,'("Error from call to subroutine ",a)')a_e_d
write (0,'("Error from call to subroutine ",a)')a_e_d
case(4011)
write (0,'("Error from call to a subroutine ")')
write (0,'("Error from call to a subroutine ")')
case(4012)
write (0,'("Error ",i0," from call to a subroutine ")')i_e_d(1)
write (0,'("Error ",i0," from call to a subroutine ")')i_e_d(1)
case(4013)
write (0,'("Error from call to subroutine ",a," ",i0)')a_e_d,i_e_d(1)
write (0,'("Error from call to subroutine ",a," ",i0)')a_e_d,i_e_d(1)
case(4110)
write (0,'("Error ",i0," from call to an external package in subroutine ",a)')i_e_d(1),a_e_d
write (0,'("Error ",i0," from call to an external package in subroutine ",a)')i_e_d(1),a_e_d
case (5001)
write (0,'("Invalid ISTOP: ",i0)')i_e_d(1)
write (0,'("Invalid ISTOP: ",i0)')i_e_d(1)
case (5002)
write (0,'("Invalid PREC: ",i0)')i_e_d(1)
write (0,'("Invalid PREC: ",i0)')i_e_d(1)
case (5003)
write (0,'("Invalid PREC: ",a3)')a_e_d(1:3)
write (0,'("Invalid PREC: ",a3)')a_e_d(1:3)
case default
write(0,'("unknown error (",i0,") in subroutine ",a)')err_c,r_name
write(0,'(5(i0,2x))') i_e_d
write(0,'(a)') a_e_d
write(0,'("unknown error (",i0,") in subroutine ",a)')err_c,r_name
write(0,'(5(i0,2x))') i_e_d
write(0,'(a)') a_e_d
end select

@ -323,7 +323,8 @@ Contains
rrax=>tmp
End If
else
dim = 0
dim = 0
dim2 = 0
Allocate(rrax(len1,len2),stat=info)
if (info /= 0) then
err=4000
@ -397,7 +398,8 @@ Contains
rrax=>tmp
End If
else
dim = 0
dim = 0
dim2 = 0
Allocate(rrax(len1,len2),stat=info)
if (info /= 0) then
err=4000
@ -471,7 +473,8 @@ Contains
rrax=>tmp
End If
else
dim = 0
dim = 0
dim2 = 0
Allocate(rrax(len1,len2),stat=info)
if (info /= 0) then
err=4000

@ -145,7 +145,7 @@ contains
!locals
logical, parameter :: debug=.false.
logical :: clear_
character(len=20) :: name, ch_err
character(len=20) :: name
info = 0
name = 'psb_sp_reinit'
@ -436,10 +436,9 @@ contains
Integer, intent(out) :: info
!locals
Integer :: nza,nz1, nz2, nzl, nzr
logical, parameter :: debug=.false.
INFO = 0
info = 0
if (associated(b%pr)) then
deallocate(b%pr,stat=info)
@ -507,7 +506,7 @@ contains
Integer, intent(out) :: i1, i2, ia, info
!locals
Integer :: nza,nz1, nz2, nzl, nzr
Integer :: nza
logical, parameter :: debug=.false.
info = 0
@ -671,7 +670,7 @@ contains
!locals
logical, parameter :: debug=.false.
logical :: clear_
character(len=20) :: name, ch_err
character(len=20) :: name
info = 0
name = 'psb_sp_reinit'
@ -957,10 +956,9 @@ contains
Integer, intent(out) :: info
!locals
Integer :: nza,nz1, nz2, nzl, nzr
logical, parameter :: debug=.false.
INFO = 0
info = 0
if (associated(b%pr)) then
deallocate(b%pr,stat=info)
@ -1029,7 +1027,7 @@ contains
Integer, intent(out) :: i1, i2, ia, info
!locals
Integer :: nza,nz1, nz2, nzl, nzr
Integer :: nza
logical, parameter :: debug=.false.
info = 0

@ -75,13 +75,12 @@ Subroutine psb_dasmatbld(ptype,novr,a,blk,desc_data,upd,desc_p,info,outfmt)
real(kind(1.d0)) :: t1,t2,t3,mpi_wtime
external mpi_wtime
integer idscb,idsce,iovrb,iovre, err, irank, icomm
integer icomm
! .. Local Scalars ..
Integer :: k, tot_elem,proc,&
& point,nprow,npcol, me, mycol, start,m,nnzero,&
& ictxt, lovr, n_col, linp,ier,n,int_err(5),&
& tot_recv, ircode, n_row, nztot,nhalo, nrow_a,err_act
Integer :: k, np,me,m,nnzero,&
& ictxt, n_col,ier,n,int_err(5),&
& tot_recv, ircode, n_row,nhalo, nrow_a,err_act
Logical,Parameter :: debug=.false., debugprt=.false.
character(len=20) :: name, ch_err
name='psb_dasmatbld'
@ -172,9 +171,9 @@ Subroutine psb_dasmatbld(ptype,novr,a,blk,desc_data,upd,desc_p,info,outfmt)
return
endif
call blacs_get(ictxt,10,icomm )
call psb_get_mpicomm(ictxt,icomm)
Call psb_info(ictxt, me, nprow)
Call psb_info(ictxt, me, np)
If(debug)Write(0,*)'BEGIN dasmatbld',me,upd,novr
t1 = mpi_wtime()

@ -61,7 +61,7 @@ subroutine psb_dbaseprc_aply(prec,x,beta,y,desc_data,trans,work,info)
integer :: n_row,n_col, int_err(5)
real(kind(1.d0)), pointer :: ww(:), aux(:), tx(:),ty(:)
character ::diagl, diagu
integer :: ictxt,np,npcol,me,mycol,i, isz, nrg, err_act
integer :: ictxt,np,me,i, isz, nrg, err_act
real(kind(1.d0)) :: t1, t2, t3, t4, t5, t6, t7, mpi_wtime
logical,parameter :: debug=.false., debugprt=.false.
external mpi_wtime

@ -63,7 +63,7 @@ subroutine psb_dbjac_aply(prec,x,beta,y,desc_data,trans,work,info)
integer :: n_row,n_col
real(kind(1.d0)), pointer :: ww(:), aux(:), tx(:),ty(:),tb(:)
character ::diagl, diagu
integer :: ictxt,np,npcol,me,mycol,i, isz, nrg, err_act, int_err(5)
integer :: ictxt,np,me,i, nrg, err_act, int_err(5)
real(kind(1.d0)) :: t1, t2, t3, t4, t5, t6, t7, mpi_wtime
logical,parameter :: debug=.false., debugprt=.false.
external mpi_wtime

@ -53,7 +53,7 @@ subroutine psb_dbldaggrmat(a,desc_a,ac,p,desc_p,info)
integer, intent(out) :: info
logical, parameter :: aggr_dump=.false.
integer ::ictxt,np,npcol,me,mycol, err_act
integer ::ictxt,np,me, err_act
character(len=20) :: name, ch_err
name='psb_dbldaggrmat'
if(psb_get_errstatus().ne.0) return
@ -115,8 +115,8 @@ contains
type(psb_dspmat_type) :: b, tmp
integer, pointer :: nzbr(:), idisp(:)
integer :: ictxt, nrow, nglob, ncol, ntaggr, nzbg, ip, ndx,&
& naggr, np, me, mypcol, nprows, npcols,nzt,irs,jl,nzl,nlr,&
& icomm,naggrm1, mtype, i, j, k, err_act
& naggr, np, me, nzt,irs,jl,nzl,nlr,&
& icomm,naggrm1, i, j, k, err_act
name='raw_aggregate'
if(psb_get_errstatus().ne.0) return
info=0
@ -391,8 +391,8 @@ contains
type(psb_dspmat_type) :: b
integer, pointer :: nzbr(:), idisp(:), ivall(:)
integer :: ictxt, nrow, nglob, ncol, ntaggr, nzbg, ip, ndx,&
& naggr, np, me, mypcol, nprows, npcols,&
& icomm, naggrm1,naggrp1,mtype,i,j,err_act,k,nzl
& naggr, np, me, &
& icomm, naggrm1,naggrp1,i,j,err_act,k,nzl
type(psb_dspmat_type), pointer :: am1,am2
type(psb_dspmat_type) :: am3,am4
logical :: ml_global_nmb
@ -400,7 +400,7 @@ contains
logical, parameter :: test_dump=.false.,debug=.false.
integer, parameter :: ncmax=16
real(kind(1.d0)) :: omega, anorm, tmp, dg
character(len=20) :: name, ch_err
character(len=20) :: name
name='smooth_aggregate'
@ -555,6 +555,7 @@ contains
! This only works with CSR.
!
anorm = dzero
dg = done
do i=1,am3%m
tmp = dzero
do j=am3%ia2(i),am3%ia2(i+1)-1
@ -770,7 +771,7 @@ contains
end if
i = 1
do ip=1,nprows
do ip=1,np
do k=1, p%nlaggr(ip)
ivall(i) = ip
i = i + 1

@ -56,9 +56,8 @@ subroutine psb_ddiagsc_bld(a,desc_a,p,upd,info)
! Local scalars
Integer :: err, nnzero, n_row, n_col,I,j,k,ictxt,&
& me,mycol,np,npcol,mglob,lw, mtype, nrg, nzg, err_act
real(kind(1.d0)) :: temp, real_err(5)
Integer :: err, n_row, n_col,I,j,k,ictxt,&
& me,np,mglob,lw, err_act
real(kind(1.d0)),pointer :: gd(:), work(:)
integer :: int_err(5)
character :: iupd

@ -52,7 +52,7 @@ subroutine psb_dgenaggrmap(aggr_type,a,desc_a,nlaggr,ilaggr,info)
logical :: recovery
logical, parameter :: debug=.false.
integer ::ictxt,np,npcol,me,mycol,err_act
integer ::ictxt,np,me,err_act
integer :: nrow, ncol, n_ne
integer, parameter :: one=1, two=2
character(len=20) :: name, ch_err

@ -75,14 +75,11 @@ subroutine psb_dilu_bld(a,desc_a,p,upd,info)
character :: trans, unitd
type(psb_dspmat_type) :: blck, atmp
real(kind(1.d0)) :: t1,t2,t3,t4,t5,t6,mpi_wtime, t7, t8
integer, pointer :: itmp(:), itmp2(:)
real(kind(1.d0)), pointer :: rtmp(:)
external mpi_wtime
logical, parameter :: debugprt=.false., debug=.false., aggr_dump=.false.
integer istpb, istpe, ifctb, ifcte, err_act, irank, icomm, nztota, nztotb,&
& nztmp, nzl, nnr, ir, mglob, mtype, n_row, nrow_a,n_col, nhalo,lovr, &
& ind, iind, pi,nr,ns
integer ::ictxt,np,npcol,me,mycol
integer nztota, nztotb, nztmp, nzl, nnr, ir, err_act,&
& n_row, nrow_a,n_col, nhalo,lovr, ind, iind
integer :: ictxt,np,me
character(len=20) :: name, ch_err
interface psb_ilu_fct

@ -64,7 +64,7 @@ subroutine psb_dmlprc_aply(baseprecv,x,beta,y,desc_data,trans,work,info)
real(kind(1.d0)), allocatable :: tx(:),ty(:),t2l(:),w2l(:),&
& x2l(:),b2l(:),tz(:),tty(:)
character ::diagl, diagu
integer :: ictxt,np,npcol,me,mycol,i, isz, nrg,nr2l,err_act, iptype, int_err(5)
integer :: ictxt,np,me,i, isz, nrg,nr2l,err_act, iptype, int_err(5)
real(kind(1.d0)) :: omega
real(kind(1.d0)) :: t1, t2, t3, t4, t5, t6, t7, mpi_wtime
logical, parameter :: debug=.false., debugprt=.false.

@ -96,7 +96,7 @@ subroutine psb_dmlprc_bld(a,desc_a,p,info)
end subroutine psb_dbldaggrmat
end interface
integer :: ictxt, nprow, npcol, me, mycol
integer :: ictxt, np, me
name='psb_mlprec_bld'
if(psb_get_errstatus().ne.0) return

@ -55,10 +55,10 @@ subroutine psb_dprc_aply(prec,x,y,desc_data,info,trans, work)
! Local variables
character :: trans_
real(kind(1.d0)), pointer :: work_(:)
integer :: ictxt,np,npcol,me,mycol,err_act, int_err(5)
logical,parameter :: debug=.false., debugprt=.false.
integer :: ictxt,np,me,err_act
logical,parameter :: debug=.false., debugprt=.false.
external mpi_wtime
character(len=20) :: name, ch_err
character(len=20) :: name
interface psb_baseprc_aply
subroutine psb_dbaseprc_aply(prec,x,beta,y,desc_data,trans,work,info)
@ -220,9 +220,9 @@ subroutine psb_dprc_aply1(prec,x,desc_data,info,trans)
! Local variables
character :: trans_
integer :: ictxt,np,npcol,me,mycol,i, isz, err_act, int_err(5)
integer :: ictxt,np,me,i, err_act
real(kind(1.d0)), pointer :: WW(:), w1(:)
character(len=20) :: name, ch_err
character(len=20) :: name
name='psb_dprec1'
info = 0
call psb_erractionsave(err_act)

@ -83,9 +83,7 @@ subroutine psb_dprecbld(a,desc_a,p,info,upd)
end interface
! Local scalars
Integer :: err, nnzero, I,j,k,ictxt,&
& me,mycol,np,npcol,lw, mtype, nrg, nzg, err_act
real(kind(1.d0)) :: temp, real_err(5)
Integer :: err, I,j,k,ictxt, me,np,lw, err_act
integer :: int_err(5)
character :: iupd

@ -49,11 +49,8 @@ subroutine psb_dprecfree(p,info)
integer, intent(out) :: info
!...locals....
integer :: int_err(5)
integer :: temp(1), me
real(kind(1.d0)) :: real_err(5)
integer :: ictxt,err_act,i
character(len=20) :: name, ch_err
integer :: ictxt,me,np,err_act,i
character(len=20) :: name
if(psb_get_errstatus().ne.0) return
info=0

@ -52,7 +52,7 @@ subroutine psb_dslu_bld(a,desc_a,p,info)
type(psb_dspmat_type) :: blck, atmp
character(len=5) :: fmt
character :: upd='F'
integer :: i,j,nza,nzb,nzt,ictxt, me,mycol,np,npcol,err_act
integer :: i,j,nza,nzb,nzt,ictxt,me,np,err_act
logical, parameter :: debug=.false.
character(len=20) :: name, ch_err

@ -55,10 +55,9 @@ subroutine psb_dsp_renum(a,desc_a,blck,p,atmp,info)
character(len=20) :: name, ch_err
integer istpb, istpe, ifctb, ifcte, err_act, irank, icomm, nztota, nztotb,&
& nztmp, nzl, nnr, ir, mglob, mtype, n_row, nrow_a,n_col, nhalo,lovr, &
& ind, iind, pi,nr,ns,i,j,jj,k,kk
integer ::ictxt,np,npcol,me,mycol
integer nztota, nztotb, nztmp, nzl, nnr, ir, mglob, mtype, n_row, &
& nrow_a,n_col, nhalo,lovr, ind, iind, pi,nr,ns,i,j,jj,k,kk
integer ::ictxt,np,me, err_act
integer, pointer :: itmp(:), itmp2(:)
real(kind(1.d0)), pointer :: rtmp(:)
real(kind(1.d0)) :: t1,t2,t3,t4,t5,t6,mpi_wtime, t7, t8
@ -112,7 +111,7 @@ subroutine psb_dsp_renum(a,desc_a,blck,p,atmp,info)
t3 = mpi_wtime()
! Build ATMP with new numbering.
nztmp=size(atmp%aspk)
allocate(itmp(max(8,atmp%m+2,nztmp+2)),rtmp(atmp%m),stat=info)
if (info /= 0) then
call psb_errpush(4010,name,a_err='Allocate')
@ -204,7 +203,7 @@ subroutine psb_dsp_renum(a,desc_a,blck,p,atmp,info)
enddo
enddo
atmp%ia2(a%m+1) = a%ia2(a%m+1)
nztota = atmp%ia2(a%m+1) -1
if (blck%m>0) then
do i=1, blck%m
atmp%ia2(a%m+i) = nztota+blck%ia2(i)

@ -52,7 +52,7 @@ subroutine psb_dumf_bld(a,desc_a,p,info)
type(psb_dspmat_type) :: blck, atmp
character(len=5) :: fmt
character :: upd='F'
integer :: i,j,nza,nzb,nzt,ictxt, me,mycol,np,npcol,err_act
integer :: i,j,nza,nzb,nzt,ictxt,me,np,err_act
integer :: i_err(5)
logical, parameter :: debug=.false.
character(len=20) :: name, ch_err

@ -75,13 +75,12 @@ Subroutine psb_zasmatbld(ptype,novr,a,blk,desc_data,upd,desc_p,info,outfmt)
real(kind(1.d0)) :: t1,t2,t3,mpi_wtime
external mpi_wtime
integer idscb,idsce,iovrb,iovre, err, irank, icomm
integer icomm
! .. Local Scalars ..
Integer :: k, tot_elem,proc,&
& point,nprow,npcol, me, mycol, start,m,nnzero,&
& ictxt, lovr, n_col, linp,ier,n,int_err(5),&
& tot_recv, ircode, n_row, nztot,nhalo, nrow_a,err_act
Integer :: k, np,me,m,nnzero,&
& ictxt, n_col,ier,n,int_err(5),&
& tot_recv, ircode, n_row,nhalo, nrow_a,err_act
Logical,Parameter :: debug=.false., debugprt=.false.
character(len=20) :: name, ch_err
name='psb_zasmatbld'
@ -172,9 +171,9 @@ Subroutine psb_zasmatbld(ptype,novr,a,blk,desc_data,upd,desc_p,info,outfmt)
return
endif
call blacs_get(ictxt,10,icomm )
call psb_get_mpicomm(ictxt,icomm)
Call psb_info(ictxt, me, nprow)
Call psb_info(ictxt, me, np)
If(debug)Write(0,*)'BEGIN dasmatbld',me,upd,novr
t1 = mpi_wtime()
@ -198,9 +197,6 @@ Subroutine psb_zasmatbld(ptype,novr,a,blk,desc_data,upd,desc_p,info,outfmt)
t2 = mpi_wtime()
if (debug) write(0,*) 'Before sphalo ',blk%fida,blk%m,psb_nnz_,blk%infoa(psb_nnz_)
!!$ ierr = MPE_Log_event( iovrb, 0, "st OVR" )
!!$ blk%m = n_row-nrow_a
!!$ blk%k = n_row
if (present(outfmt)) then
if(debug) write(0,*) me,': Calling SPHALO with ',size(blk%ia2)
@ -219,7 +215,6 @@ Subroutine psb_zasmatbld(ptype,novr,a,blk,desc_data,upd,desc_p,info,outfmt)
end if
if (debug) write(0,*) 'After psb_sphalo ',blk%fida,blk%m,psb_nnz_,blk%infoa(psb_nnz_)
!!$ ierr = MPE_Log_event( iovre, 0, "ed OVR" )
t3 = mpi_wtime()
if (debugprt) then

@ -61,7 +61,7 @@ subroutine psb_zbaseprc_aply(prec,x,beta,y,desc_data,trans,work,info)
integer :: n_row,n_col, int_err(5)
complex(kind(1.d0)), pointer :: ww(:), aux(:), tx(:),ty(:)
character ::diagl, diagu
integer :: ictxt,np,npcol,me,mycol,i, isz, nrg, err_act
integer :: ictxt,np,me,i, isz, nrg, err_act
real(kind(1.d0)) :: t1, t2, t3, t4, t5, t6, t7, mpi_wtime
logical,parameter :: debug=.false., debugprt=.false.
external mpi_wtime

@ -63,7 +63,7 @@ subroutine psb_zbjac_aply(prec,x,beta,y,desc_data,trans,work,info)
integer :: n_row,n_col
complex(kind(1.d0)), pointer :: ww(:), aux(:), tx(:),ty(:),tb(:)
character ::diagl, diagu
integer :: ictxt,np,npcol,me,mycol,i, isz, nrg, err_act, int_err(5)
integer :: ictxt,np,me,i, isz, nrg, err_act, int_err(5)
real(kind(1.d0)) :: t1, t2, t3, t4, t5, t6, t7, mpi_wtime
logical,parameter :: debug=.false., debugprt=.false.
external mpi_wtime

@ -53,7 +53,7 @@ subroutine psb_zbldaggrmat(a,desc_a,ac,p,desc_p,info)
integer, intent(out) :: info
logical, parameter :: aggr_dump=.false.
integer ::ictxt,np,npcol,me,mycol, err_act
integer ::ictxt,np,me, err_act
character(len=20) :: name, ch_err
name='psb_zbldaggrmat'
if(psb_get_errstatus().ne.0) return
@ -115,8 +115,8 @@ contains
type(psb_zspmat_type) :: b, tmp
integer, pointer :: nzbr(:), idisp(:)
integer :: ictxt, nrow, nglob, ncol, ntaggr, nzbg, ip, ndx,&
& naggr, np, me, mypcol, nprows, npcols,nzt,irs,jl,nzl,nlr,&
& icomm,naggrm1, mtype, i, j, k, err_act
& naggr, np, me, nzt,irs,jl,nzl,nlr,&
& icomm,naggrm1, i, j, k, err_act
name='raw_aggregate'
if(psb_get_errstatus().ne.0) return
info=0
@ -391,8 +391,8 @@ contains
type(psb_zspmat_type) :: b
integer, pointer :: nzbr(:), idisp(:), ivall(:)
integer :: ictxt, nrow, nglob, ncol, ntaggr, nzbg, ip, ndx,&
& naggr, np, me, mypcol, nprows, npcols,&
& icomm, naggrm1,naggrp1,mtype,i,j,err_act,k,nzl
& naggr, np, me,&
& icomm, naggrm1,naggrp1,i,j,err_act,k,nzl
type(psb_zspmat_type), pointer :: am1,am2
type(psb_zspmat_type) :: am3,am4
logical :: ml_global_nmb
@ -400,7 +400,7 @@ contains
logical, parameter :: test_dump=.false., debug=.false.
integer, parameter :: ncmax=16
real(kind(1.d0)) :: omega, anorm, tmp, dg
character(len=20) :: name, ch_err
character(len=20) :: name
name='smooth_aggregate'
@ -555,6 +555,7 @@ contains
! This only works with CSR.
!
anorm = dzero
dg = done
do i=1,am3%m
tmp = dzero
do j=am3%ia2(i),am3%ia2(i+1)-1
@ -770,7 +771,7 @@ contains
end if
i = 1
do ip=1,nprows
do ip=1,np
do k=1, p%nlaggr(ip)
ivall(i) = ip
i = i + 1

@ -56,9 +56,8 @@ subroutine psb_zdiagsc_bld(a,desc_a,p,upd,info)
! Local scalars
Integer :: err, nnzero, n_row, n_col,I,j,k,ictxt,&
& me,mycol,np,npcol,mglob,lw, mtype, nrg, nzg, err_act
real(kind(1.d0)) :: temp, real_err(5)
Integer :: err, n_row, n_col,I,j,k,ictxt,&
& me,np,mglob,lw, err_act
complex(kind(1.d0)),pointer :: gd(:), work(:)
integer :: int_err(5)
character :: iupd

@ -52,7 +52,7 @@ subroutine psb_zgenaggrmap(aggr_type,a,desc_a,nlaggr,ilaggr,info)
logical :: recovery
logical, parameter :: debug=.false.
integer ::ictxt,np,npcol,me,mycol,err_act
integer ::ictxt,np,me,err_act
integer :: nrow, ncol, n_ne
integer, parameter :: one=1, two=2
character(len=20) :: name, ch_err

@ -75,13 +75,11 @@ subroutine psb_zilu_bld(a,desc_a,p,upd,info)
character :: trans, unitd
type(psb_zspmat_type) :: blck, atmp
real(kind(1.d0)) :: t1,t2,t3,t4,t5,t6,mpi_wtime, t7, t8
integer, pointer :: itmp(:), itmp2(:)
external mpi_wtime
logical, parameter :: debugprt=.false., debug=.false., aggr_dump=.false.
integer istpb, istpe, ifctb, ifcte, err_act, irank, icomm, nztota, nztotb,&
& nztmp, nzl, nnr, ir, mglob, mtype, n_row, nrow_a,n_col, nhalo,lovr, &
& ind, iind, pi,nr,ns
integer ::ictxt,np,npcol,me,mycol
integer nztota, nztotb, nztmp, nzl, nnr, ir, err_act, &
& n_row, nrow_a,n_col, nhalo,lovr, ind, iind
integer :: ictxt,np,me
character(len=20) :: name, ch_err
interface psb_ilu_fct

@ -64,7 +64,7 @@ subroutine psb_zmlprc_aply(baseprecv,x,beta,y,desc_data,trans,work,info)
complex(kind(1.d0)), allocatable :: tx(:),ty(:),t2l(:),w2l(:),&
& x2l(:),b2l(:),tz(:),tty(:)
character ::diagl, diagu
integer :: ictxt,np,npcol,me,mycol,i, isz, nrg,nr2l,err_act, iptype, int_err(5)
integer :: ictxt,np,me,i, isz, nrg,nr2l,err_act, iptype, int_err(5)
real(kind(1.d0)) :: omega
real(kind(1.d0)) :: t1, t2, t3, t4, t5, t6, t7, mpi_wtime
logical, parameter :: debug=.false., debugprt=.false.

@ -96,7 +96,7 @@ subroutine psb_zmlprc_bld(a,desc_a,p,info)
end subroutine psb_zbldaggrmat
end interface
integer :: ictxt, nprow, npcol, me, mycol
integer :: ictxt, np, me
name='psb_mlprec_bld'
if(psb_get_errstatus().ne.0) return

@ -55,10 +55,10 @@ subroutine psb_zprc_aply(prec,x,y,desc_data,info,trans, work)
! Local variables
character :: trans_
complex(kind(1.d0)), pointer :: work_(:)
integer :: ictxt,np,npcol,me,mycol,err_act, int_err(5)
integer :: ictxt,np,me,err_act
logical,parameter :: debug=.false., debugprt=.false.
external mpi_wtime
character(len=20) :: name, ch_err
character(len=20) :: name
interface psb_baseprc_aply
subroutine psb_zbaseprc_aply(prec,x,beta,y,desc_data,trans,work,info)
@ -220,7 +220,7 @@ subroutine psb_zprc_aply1(prec,x,desc_data,info,trans)
! Local variables
character :: trans_
integer :: ictxt,np,npcol,me,mycol,i, isz, err_act, int_err(5)
integer :: ictxt,np,me,i, isz, err_act, int_err(5)
complex(kind(1.d0)), pointer :: WW(:), w1(:)
character(len=20) :: name, ch_err
name='psb_zprec1'

@ -83,9 +83,7 @@ subroutine psb_zprecbld(a,desc_a,p,info,upd)
end interface
! Local scalars
Integer :: err, nnzero, I,j,k,ictxt,&
& me,mycol,np,npcol,lw, mtype, nrg, nzg, err_act
real(kind(1.d0)) :: temp, real_err(5)
Integer :: err,i,j,k,ictxt, me,np,lw, err_act
integer :: int_err(5)
character :: iupd

@ -49,11 +49,8 @@ subroutine psb_zprecfree(p,info)
integer, intent(out) :: info
!...locals....
integer :: int_err(5)
integer :: temp(1), me
real(kind(1.d0)) :: real_err(5)
integer :: ictxt,err_act,i
character(len=20) :: name, ch_err
integer :: ictxt,me, np,err_act,i
character(len=20) :: name
if(psb_get_errstatus().ne.0) return
info=0

@ -52,7 +52,7 @@ subroutine psb_zslu_bld(a,desc_a,p,info)
type(psb_zspmat_type) :: blck, atmp
character(len=5) :: fmt
character :: upd='F'
integer :: i,j,nza,nzb,nzt,ictxt, me,mycol,np,npcol,err_act
integer :: i,j,nza,nzb,nzt,ictxt, me,np,err_act
logical, parameter :: debug=.false.
character(len=20) :: name, ch_err

@ -55,10 +55,9 @@ subroutine psb_zsp_renum(a,desc_a,blck,p,atmp,info)
character(len=20) :: name, ch_err
integer istpb, istpe, ifctb, ifcte, err_act, irank, icomm, nztota, nztotb,&
& nztmp, nzl, nnr, ir, mglob, mtype, n_row, nrow_a,n_col, nhalo,lovr, &
& ind, iind, pi,nr,ns,i,j,jj,k,kk
integer ::ictxt,np,npcol,me,mycol
integer nztota, nztotb, nztmp, nzl, nnr, ir, mglob, mtype, n_row, &
& nrow_a,n_col, nhalo,lovr, ind, iind, pi,nr,ns,i,j,jj,k,kk
integer ::ictxt,np,me, err_act
integer, pointer :: itmp(:), itmp2(:)
complex(kind(1.d0)), pointer :: ztmp(:)
real(kind(1.d0)) :: t1,t2,t3,t4,t5,t6,mpi_wtime, t7, t8
@ -112,7 +111,7 @@ subroutine psb_zsp_renum(a,desc_a,blck,p,atmp,info)
t3 = mpi_wtime()
! Build ATMP with new numbering.
nztmp=size(atmp%aspk)
allocate(itmp(max(8,atmp%m+2,nztmp+2)),ztmp(atmp%m),stat=info)
if (info /= 0) then
call psb_errpush(4010,name,a_err='Allocate')
@ -204,7 +203,7 @@ subroutine psb_zsp_renum(a,desc_a,blck,p,atmp,info)
enddo
enddo
atmp%ia2(a%m+1) = a%ia2(a%m+1)
nztota = atmp%ia2(a%m+1) -1
if (blck%m>0) then
do i=1, blck%m
atmp%ia2(a%m+i) = nztota+blck%ia2(i)

@ -52,7 +52,7 @@ subroutine psb_zumf_bld(a,desc_a,p,info)
type(psb_zspmat_type) :: blck, atmp
character(len=5) :: fmt
character :: upd='F'
integer :: i,j,nza,nzb,nzt,ictxt, me,mycol,np,npcol,err_act
integer :: i,j,nza,nzb,nzt,ictxt, me,np,err_act
integer :: i_err(5)
logical, parameter :: debug=.false.
character(len=20) :: name, ch_err

@ -58,7 +58,7 @@ function psb_damax (x,desc_a, info, jx)
real(kind(1.d0)) :: psb_damax
! locals
integer :: int_err(5), ictxt, np, me, mycol,&
integer :: ictxt, np, me,&
& err_act, n, iix, jjx, ix, ijx, m, i, k, imax, idamax
real(kind(1.d0)) :: amax
character(len=20) :: name, ch_err
@ -183,7 +183,7 @@ function psb_damaxv (x,desc_a, info)
real(kind(1.d0)) :: psb_damaxv
! locals
integer :: int_err(5), err, ictxt, np, me, mycol,&
integer :: err, ictxt, np, me,&
& err_act, n, iix, jjx, jx, ix, ijx, m, imax, idamax
real(kind(1.d0)) :: amax
character(len=20) :: name, ch_err
@ -306,7 +306,7 @@ subroutine psb_damaxvs (res,x,desc_a, info)
real(kind(1.D0)), intent(out) :: res
! locals
integer :: int_err(5), ictxt, np, me, mycol,&
integer :: ictxt, np, me,&
& err_act, n, iix, jjx, ix, ijx, m, imax, idamax
real(kind(1.d0)) :: amax
character(len=20) :: name, ch_err
@ -428,7 +428,7 @@ subroutine psb_dmamaxs (res,x,desc_a, info,jx)
real(kind(1.d0)), intent(out) :: res(:)
! locals
integer :: int_err(5), ictxt, np, me, mycol,&
integer :: ictxt, np, me,&
& err_act, n, iix, jjx, ix, ijx, m, imax, i, k, idamax
real(kind(1.d0)) :: amax
character(len=20) :: name, ch_err

@ -59,10 +59,10 @@ function psb_dasum (x,desc_a, info, jx)
real(kind(1.d0)) :: psb_dasum
! locals
integer :: int_err(5), ictxt, np, npcol, me, mycol,&
& err_act, n, iix, jjx, temp(2), ix, ijx, m, i
real(kind(1.d0)) :: asum, dasum
character(len=20) :: name, ch_err
integer :: ictxt, np, me, err_act, n, &
& iix, jjx, ix, ijx, m, i
real(kind(1.d0)) :: asum, dasum
character(len=20) :: name, ch_err
name='psb_dasum'
if(psb_get_errstatus().ne.0) return
@ -202,8 +202,7 @@ function psb_dasumv (x,desc_a, info)
real(kind(1.d0)) :: psb_dasumv
! locals
integer :: int_err(5), ictxt, np, npcol, me, mycol,&
& err_act, n, iix, jjx, temp(2), jx, ix, ijx, m, i
integer :: ictxt, np, me, err_act, n, iix, jjx, jx, ix, ijx, m, i
real(kind(1.d0)) :: asum, dasum
character(len=20) :: name, ch_err
@ -341,8 +340,7 @@ subroutine psb_dasumvs (res,x,desc_a, info)
integer, intent(out) :: info
! locals
integer :: int_err(5), ictxt, np, npcol, me, mycol,&
& err_act, n, iix, jjx, temp(2), ix, jx, ijx, m, i
integer :: ictxt, np, me, err_act, n, iix, jjx, ix, jx, ijx, m, i
real(kind(1.d0)) :: asum, dasum
character(len=20) :: name, ch_err

@ -65,8 +65,8 @@ subroutine psb_daxpby(alpha, x, beta,y,desc_a,info, n, jx, jy)
real(kind(1.D0)), intent(inout) :: y(:,:)
! locals
integer :: int_err(5), ictxt, np, npcol, me, mycol,&
& err_act, iix, jjx, temp(2), ix, iy, ijx, ijy, m, iiy, in, jjy
integer :: ictxt, np, me,&
& err_act, iix, jjx, ix, iy, ijx, ijy, m, iiy, in, jjy
real(kind(1.d0)),pointer :: tmpx(:)
character(len=20) :: name, ch_err
@ -217,8 +217,8 @@ subroutine psb_daxpbyv(alpha, x, beta,y,desc_a,info)
real(kind(1.D0)), intent(inout) :: y(:)
! locals
integer :: int_err(5), ictxt, np, npcol, me, mycol,&
& err_act, n, iix, jjx, temp(2), ix, iy, ijx, m, iiy, in, jjy
integer :: ictxt, np, me,&
& err_act, n, iix, jjx, ix, iy, ijx, m, iiy, in, jjy
character(len=20) :: name, ch_err
logical, parameter :: debug=.false.

@ -61,8 +61,8 @@ function psb_ddot(x, y,desc_a, info, jx, jy)
real(kind(1.D0)) :: psb_ddot
! locals
integer :: int_err(5), ictxt, np, npcol, me, mycol,&
& err_act, n, iix, jjx, temp(2), ix, ijx, iy, ijy, iiy, jjy, i, m, j, k
integer :: ictxt, np, me,&
& err_act, n, iix, jjx, ix, ijx, iy, ijy, iiy, jjy, i, m, j, k
real(kind(1.D0)) :: dot_local
real(kind(1.d0)) :: ddot
character(len=20) :: name, ch_err
@ -214,8 +214,8 @@ function psb_ddotv(x, y,desc_a, info)
real(kind(1.D0)) :: psb_ddotv
! locals
integer :: int_err(5), ictxt, np, npcol, me, mycol,&
& err_act, n, iix, jjx, temp(2), ix, jx, iy, jy, iiy, jjy, i, m, j, k
integer :: int_err(5), ictxt, np, me,&
& err_act, n, iix, jjx, ix, jx, iy, jy, iiy, jjy, i, m, j, k
real(kind(1.D0)) :: dot_local
real(kind(1.d0)) :: ddot
character(len=20) :: name, ch_err
@ -351,8 +351,8 @@ subroutine psb_ddotvs(res, x, y,desc_a, info)
integer, intent(out) :: info
! locals
integer :: int_err(5), ictxt, np, npcol, me, mycol,&
& err_act, n, iix, jjx, temp(2), ix, ijx, iy, ijy, iiy, jjy, i, m, j, k
integer :: int_err(5), ictxt, np, me,&
& err_act, n, iix, jjx, ix, ijx, iy, ijy, iiy, jjy, i, m, j, k
real(kind(1.D0)) :: dot_local
real(kind(1.d0)) :: ddot
character(len=20) :: name, ch_err
@ -491,8 +491,8 @@ subroutine psb_dmdots(res, x, y, desc_a, info)
integer, intent(out) :: info
! locals
integer :: int_err(5), ictxt, np, npcol, me, mycol,&
& err_act, n, iix, jjx, temp(2), ix, ijx, iy, ijy, iiy, jjy, i, m, j, k
integer :: int_err(5), ictxt, np, me,&
& err_act, n, iix, jjx, ix, ijx, iy, ijy, iiy, jjy, i, m, j, k
real(kind(1.d0)),allocatable :: dot_local(:)
real(kind(1.d0)) :: ddot
character(len=20) :: name, ch_err

@ -57,8 +57,8 @@ function psb_dnrm2(x, desc_a, info, jx)
real(kind(1.D0)) :: psb_dnrm2
! locals
integer :: int_err(5), ictxt, np, npcol, me, mycol,&
& err_act, n, iix, jjx, temp(2), ndim, ix, ijx, i, m, id
integer :: ictxt, np, me,&
& err_act, n, iix, jjx, ndim, ix, ijx, i, m, id
real(kind(1.d0)) :: nrm2, dnrm2, dd
external dcombnrm2
character(len=20) :: name, ch_err
@ -194,8 +194,8 @@ function psb_dnrm2v(x, desc_a, info)
real(kind(1.D0)) :: psb_dnrm2v
! locals
integer :: int_err(5), ictxt, np, npcol, me, mycol,&
& err_act, n, iix, jjx, temp(2), ndim, ix, jx, ijx, i, m, id
integer :: ictxt, np, me,&
& err_act, n, iix, jjx, ndim, ix, jx, ijx, i, m, id
real(kind(1.d0)) :: nrm2, dnrm2, dd
external dcombnrm2
character(len=20) :: name, ch_err
@ -330,8 +330,8 @@ subroutine psb_dnrm2vs(res, x, desc_a, info)
integer, intent(out) :: info
! locals
integer :: int_err(5), ictxt, np, npcol, me, mycol,&
& err_act, n, iix, jjx, temp(2), ndim, ix, jx, ijx, i, m, id
integer :: ictxt, np, me,&
& err_act, n, iix, jjx, ndim, ix, jx, ijx, i, m, id
real(kind(1.d0)) :: nrm2, dnrm2, dd
external dcombnrm2
character(len=20) :: name, ch_err

@ -54,7 +54,7 @@ function psb_dnrmi(a,desc_a,info)
real(kind(1.d0)) :: psb_dnrmi
! locals
integer :: int_err(5), ictxt, np, npcol, me, mycol,&
integer :: ictxt, np, me,&
& err_act, n, iia, jja, ia, ja, mdim, ndim, m
real(kind(1.d0)) :: nrmi, dcsnmi
character(len=20) :: name, ch_err

@ -102,12 +102,12 @@ subroutine psb_dspmm(alpha,a,x,beta,y,desc_a,info,&
integer, intent(in), optional :: k, jx, jy,doswap
! locals
integer :: int_err(5), ictxt, np, npcol, me, mycol,&
& err_act, n, iix, jjx, ia, ja, iia, jja, temp(2), ix, iy, ik, ijx, ijy,&
integer :: ictxt, np, me,&
& err_act, n, iix, jjx, ia, ja, iia, jja, ix, iy, ik, ijx, ijy,&
& idoswap, m, nrow, ncol, lldx, lldy, liwork, llwork, iiy, jjy,&
& i, ib, ib1
integer, parameter :: nb=4
real(kind(1.d0)),pointer :: tmpx(:), xp(:,:), yp(:,:), iwork(:)
real(kind(1.d0)),pointer :: xp(:,:), yp(:,:), iwork(:)
character :: itrans
character(len=20) :: name, ch_err
logical :: aliw
@ -437,8 +437,8 @@ subroutine psb_dspmv(alpha,a,x,beta,y,desc_a,info,&
integer, intent(in), optional :: doswap
! locals
integer :: int_err(5), ictxt, np, npcol, me, mycol,&
& err_act, n, iix, jjx, ia, ja, iia, jja, temp(2), ix, iy, ik, ijx, ijy,&
integer :: ictxt, np, me,&
& err_act, n, iix, jjx, ia, ja, iia, jja, ix, iy, ik, ijx, ijy,&
& idoswap, m, nrow, ncol, lldx, lldy, liwork, llwork, jx, jy, iiy, jjy,&
& i, ib, ib1
integer, parameter :: nb=4

@ -98,10 +98,10 @@ subroutine psb_dspsm(alpha,a,x,beta,y,desc_a,info,&
integer, intent(in), optional :: k, jx, jy
! locals
integer :: int_err(5), ictxt, np, npcol, me, mycol,&
& err_act, n, iix, jjx, ia, ja, iia, jja, temp(2), lldx,lldy, lchoice,&
integer :: int_err(5), ictxt, np, me,&
& err_act, n, iix, jjx, ia, ja, iia, jja, lldx,lldy, lchoice,&
& ix, iy, ik, ijx, ijy, i, lld,&
& idoswap, m, nrow, ncol, liwork, llwork, iiy, jjy
& m, nrow, ncol, liwork, llwork, iiy, jjy
character :: lunitd
integer, parameter :: nb=4
@ -400,10 +400,10 @@ subroutine psb_dspsv(alpha,a,x,beta,y,desc_a,info,&
integer, intent(in), optional :: choice
! locals
integer :: int_err(5), ictxt, np, npcol, me, mycol,&
& err_act, n, iix, jjx, ia, ja, iia, jja, temp(2), lldx,lldy, lchoice,&
integer :: int_err(5), ictxt, np, me,&
& err_act, n, iix, jjx, ia, ja, iia, jja, lldx,lldy, lchoice,&
& ix, iy, ik, jx, jy, i, lld,&
& idoswap, m, nrow, ncol, liwork, llwork, iiy, jjy
& m, nrow, ncol, liwork, llwork, iiy, jjy
character :: lunitd
integer, parameter :: nb=4

@ -58,8 +58,8 @@ function psb_zamax (x,desc_a, info, jx)
real(kind(1.d0)) :: psb_zamax
! locals
integer :: int_err(5), ictxt, np, me, mycol,&
& err_act, n, iix, jjx, temp(2), ix, ijx, m, i, k, imax, izamax
integer :: ictxt, np, me,&
& err_act, n, iix, jjx, ix, ijx, m, i, k, imax, izamax
real(kind(1.d0)) :: amax
character(len=20) :: name, ch_err
double complex :: zdum
@ -186,8 +186,8 @@ function psb_zamaxv (x,desc_a, info)
real(kind(1.d0)) :: psb_zamaxv
! locals
integer :: int_err(5), err, ictxt, np, me, mycol,&
& err_act, n, iix, jjx, jx, temp(2), ix, ijx, m, imax, izamax
integer :: ictxt, np, me,&
& err_act, n, iix, jjx, jx, ix, ijx, m, imax, izamax
real(kind(1.d0)) :: amax
complex(kind(1.d0)) :: cmax
character(len=20) :: name, ch_err
@ -314,8 +314,8 @@ subroutine psb_zamaxvs (res,x,desc_a, info)
real(kind(1.D0)), intent(out) :: res
! locals
integer :: int_err(5), ictxt, np, me, mycol,&
& err_act, n, iix, jjx, temp(2), ix, ijx, m, imax, izamax
integer :: ictxt, np, me,&
& err_act, n, iix, jjx, ix, ijx, m, imax, izamax
real(kind(1.d0)) :: amax
character(len=20) :: name, ch_err
complex(kind(1.d0)) :: cmax
@ -441,8 +441,8 @@ subroutine psb_zmamaxs (res,x,desc_a, info,jx)
real(kind(1.d0)), intent(out) :: res(:)
! locals
integer :: int_err(5), ictxt, np, me, mycol,&
& err_act, n, iix, jjx, ix, temp(2), ijx, m, imax, i, k, izamax
integer :: ictxt, np, me,&
& err_act, n, iix, jjx, ix, ijx, m, imax, i, k, izamax
real(kind(1.d0)) :: amax
character(len=20) :: name, ch_err
complex(kind(1.d0)) :: cmax

@ -207,8 +207,8 @@ function psb_zasumv (x,desc_a, info)
real(kind(1.d0)) :: psb_zasumv
! locals
integer :: int_err(5), ictxt, np, npcol, me, mycol,&
& err_act, n, iix, jjx, temp(2), jx, ix, ijx, m, i
integer :: ictxt, np, me,&
& err_act, n, iix, jjx, jx, ix, ijx, m, i
real(kind(1.d0)) :: asum, dzasum
character(len=20) :: name, ch_err
complex(kind(1.d0)) :: cmax
@ -351,8 +351,8 @@ subroutine psb_zasumvs (res,x,desc_a, info)
integer, intent(out) :: info
! locals
integer :: int_err(5), ictxt, np, npcol, me, mycol,&
& err_act, n, iix, jjx, temp(2), ix, jx, ijx, m, i
integer :: ictxt, np, me,&
& err_act, n, iix, jjx, ix, jx, ijx, m, i
real(kind(1.d0)) :: asum, dzasum
character(len=20) :: name, ch_err
complex(kind(1.d0)) :: cmax
@ -438,6 +438,3 @@ subroutine psb_zasumvs (res,x,desc_a, info)
end if
return
end subroutine psb_zasumvs

@ -65,8 +65,8 @@ subroutine psb_zaxpby(alpha, x, beta,y,desc_a,info, n, jx, jy)
complex(kind(1.D0)), intent(inout) :: y(:,:)
! locals
integer :: int_err(5), ictxt, np, npcol, me, mycol,&
& err_act, iix, jjx, temp(2), ix, iy, ijx, ijy, m, iiy, in, jjy
integer :: ictxt, np, me,&
& err_act, iix, jjx, ix, iy, ijx, ijy, m, iiy, in, jjy
character(len=20) :: name, ch_err
name='psb_dgeaxpby'
@ -216,8 +216,8 @@ subroutine psb_zaxpbyv(alpha, x, beta,y,desc_a,info)
complex(kind(1.D0)), intent(inout) :: y(:)
! locals
integer :: int_err(5), ictxt, np, npcol, me, mycol,&
& err_act, n, iix, jjx, temp(2), ix, iy, ijx, m, iiy, in, jjy
integer :: ictxt, np, me,&
& err_act, n, iix, jjx, ix, iy, ijx, m, iiy, in, jjy
character(len=20) :: name, ch_err
logical, parameter :: debug=.false.

@ -61,8 +61,8 @@ function psb_zdot(x, y,desc_a, info, jx, jy)
complex(kind(1.D0)) :: psb_zdot
! locals
integer :: int_err(5), ictxt, np, npcol, me, mycol,&
& err_act, n, iix, jjx, temp(2), ix, ijx, iy, ijy, iiy, jjy, i, m, j, k
integer :: ictxt, np, me,&
& err_act, n, iix, jjx, ix, ijx, iy, ijy, iiy, jjy, i, m, j, k
complex(kind(1.D0)) :: dot_local
complex(kind(1.d0)) :: zdotc
character(len=20) :: name, ch_err
@ -214,8 +214,8 @@ function psb_zdotv(x, y,desc_a, info)
complex(kind(1.D0)) :: psb_zdotv
! locals
integer :: int_err(5), ictxt, np, npcol, me, mycol,&
& err_act, n, iix, jjx, temp(2), ix, jx, iy, jy, iiy, jjy, i, m, j, k
integer :: ictxt, np, me,&
& err_act, n, iix, jjx, ix, jx, iy, jy, iiy, jjy, i, m, j, k
complex(kind(1.D0)) :: dot_local
complex(kind(1.d0)) :: zdotc
character(len=20) :: name, ch_err
@ -351,8 +351,8 @@ subroutine psb_zdotvs(res, x, y,desc_a, info)
integer, intent(out) :: info
! locals
integer :: int_err(5), ictxt, np, npcol, me, mycol,&
& err_act, n, iix, jjx, temp(2), ix, ijx, iy, ijy, iiy, jjy, i, m, j, k
integer :: ictxt, np, me,&
& err_act, n, iix, jjx, ix, ijx, iy, ijy, iiy, jjy, i, m, j, k
complex(kind(1.D0)) :: dot_local
complex(kind(1.d0)) :: zdotc
character(len=20) :: name, ch_err
@ -491,8 +491,8 @@ subroutine psb_zmdots(res, x, y, desc_a, info)
integer, intent(out) :: info
! locals
integer :: int_err(5), ictxt, np, npcol, me, mycol,&
& err_act, n, iix, jjx, temp(2), ix, ijx, iy, ijy, iiy, jjy, i, m, j, k
integer :: ictxt, np, me,&
& err_act, n, iix, jjx, ix, ijx, iy, ijy, iiy, jjy, i, m, j, k
complex(kind(1.d0)),allocatable :: dot_local(:)
complex(kind(1.d0)) :: zdotc
character(len=20) :: name, ch_err

@ -57,8 +57,8 @@ function psb_znrm2(x, desc_a, info, jx)
real(kind(1.D0)) :: psb_znrm2
! locals
integer :: int_err(5), ictxt, np, npcol, me, mycol,&
& err_act, n, iix, jjx, temp(2), ndim, ix, ijx, i, m, id
integer :: ictxt, np, me,&
& err_act, n, iix, jjx, ndim, ix, ijx, i, m, id
real(kind(1.d0)) :: nrm2, dznrm2, dd
external dcombnrm2
@ -194,8 +194,8 @@ function psb_znrm2v(x, desc_a, info)
real(kind(1.D0)) :: psb_znrm2v
! locals
integer :: int_err(5), ictxt, np, npcol, me, mycol,&
& err_act, n, iix, jjx, temp(2), ndim, ix, jx, ijx, i, m, id
integer :: ictxt, np, me,&
& err_act, n, iix, jjx, ndim, ix, jx, ijx, i, m, id
real(kind(1.d0)) :: nrm2, dznrm2, dd
external dcombnrm2
@ -330,8 +330,8 @@ subroutine psb_znrm2vs(res, x, desc_a, info)
integer, intent(out) :: info
! locals
integer :: int_err(5), ictxt, np, npcol, me, mycol,&
& err_act, n, iix, jjx, temp(2), ndim, ix, jx, ijx, i, m, id
integer :: ictxt, np, me,&
& err_act, n, iix, jjx, ndim, ix, jx, ijx, i, m, id
real(kind(1.d0)) :: nrm2, dznrm2, dd
external dcombnrm2

@ -54,7 +54,7 @@ function psb_znrmi(a,desc_a,info)
real(kind(1.d0)) :: psb_znrmi
! locals
integer :: int_err(5), ictxt, np, npcol, me, mycol,&
integer :: ictxt, np, me,&
& err_act, n, iia, jja, ia, ja, mdim, ndim, m
real(kind(1.d0)) :: nrmi, zcsnmi
character(len=20) :: name, ch_err

@ -102,12 +102,12 @@ subroutine psb_zspmm(alpha,a,x,beta,y,desc_a,info,&
integer, intent(in), optional :: k, jx, jy,doswap
! locals
integer :: int_err(5), ictxt, np, npcol, me, mycol,&
& err_act, n, iix, jjx, ia, ja, iia, jja, temp(2), ix, iy, ik, ijx, ijy,&
& idoswap, m, nrow, ncol, lldx, lldy, liwork, llwork, iiy, jjy,&
integer :: ictxt, np, me,&
& err_act, n, iix, jjx, ia, ja, iia, jja, ix, iy, ik, ijx, ijy,&
& idoswap, m, nrow, ncol, lldx, lldy, liwork, iiy, jjy,&
& i, ib, ib1
integer, parameter :: nb=4
complex(kind(1.d0)),pointer :: tmpx(:), xp(:,:), yp(:,:), iwork(:)
integer, parameter :: nb=4
complex(kind(1.d0)),pointer :: xp(:,:), yp(:,:), iwork(:)
character :: itrans
character(len=20) :: name, ch_err
logical :: aliw
@ -433,12 +433,12 @@ subroutine psb_zspmv(alpha,a,x,beta,y,desc_a,info,&
integer, intent(in), optional :: doswap
! locals
integer :: int_err(5), ictxt, np, npcol, me, mycol,&
& err_act, n, iix, jjx, ia, ja, iia, jja, temp(2), ix, iy, ik, ijx, ijy,&
& idoswap, m, nrow, ncol, lldx, lldy, liwork, llwork, jx, jy, iiy, jjy,&
integer :: ictxt, np, me,&
& err_act, n, iix, jjx, ia, ja, iia, jja, ix, iy, ik, ijx, ijy,&
& idoswap, m, nrow, ncol, lldx, lldy, liwork, jx, jy, iiy, jjy,&
& i, ib, ib1
integer, parameter :: nb=4
complex(kind(1.d0)),pointer :: tmpx(:), iwork(:), xp(:), yp(:)
complex(kind(1.d0)),pointer :: iwork(:), xp(:), yp(:)
character :: itrans
character(len=20) :: name, ch_err
logical :: aliw

@ -98,10 +98,10 @@ subroutine psb_zspsm(alpha,a,x,beta,y,desc_a,info,&
integer, intent(in), optional :: k, jx, jy
! locals
integer :: int_err(5), ictxt, np, npcol, me, mycol,&
& err_act, n, iix, jjx, ia, ja, iia, jja, temp(2), lldx,lldy, lchoice,&
& ix, iy, ik, ijx, ijy, i, lld,&
& idoswap, m, nrow, ncol, liwork, llwork, iiy, jjy
integer :: ictxt, np, me,&
& err_act, n, iix, jjx, ia, ja, iia, jja, lldx,lldy, lchoice,&
& ix, iy, ik, ijx, ijy, i, lld, int_err(5),&
& m, nrow, ncol, liwork, llwork, iiy, jjy
character :: lunitd
integer, parameter :: nb=4
@ -404,10 +404,10 @@ subroutine psb_zspsv(alpha,a,x,beta,y,desc_a,info,&
integer, intent(in), optional :: choice
! locals
integer :: int_err(5), ictxt, np, npcol, me, mycol,&
& err_act, n, iix, jjx, ia, ja, iia, jja, temp(2), lldx,lldy, lchoice,&
& ix, iy, ik, jx, jy, i, lld,&
& idoswap, m, nrow, ncol, liwork, llwork, iiy, jjy
integer :: ictxt, np, me, &
& err_act, n, iix, jjx, ia, ja, iia, jja, lldx,lldy, lchoice,&
& ix, iy, ik, jx, jy, i, lld, int_err(5),&
& m, nrow, ncol, liwork, llwork, iiy, jjy
character :: lunitd
integer, parameter :: nb=4

@ -61,11 +61,11 @@ subroutine psb_dcsdp(a, b,info,ifc,check,trans,unitd,upd,dupl)
real(kind(1.d0)) :: d(1)
real(kind(1.d0)), allocatable :: work(:)
type(psb_dspmat_type) :: temp_a
Integer :: nzr, ntry, ifc_,ierror, ia1_size,&
Integer :: nzr, ntry, ifc_, ia1_size,&
& ia2_size, aspk_size,size_req,n_row,n_col,upd_,dupl_
integer :: ip1, ip2, nnz, iflag, ichk, nnzt,&
& ipc, i, count, err_act, ierrv(5), i1, i2, ia
character :: check_,trans_,unitd_, up
& ipc, i, count, err_act, i1, i2, ia
character :: check_,trans_,unitd_
Integer, Parameter :: maxtry=8
logical, parameter :: debug=.false.
character(len=20) :: name, ch_err

@ -44,7 +44,7 @@ subroutine psb_dcsmv(alpha,a,b,beta,c,info,trans)
real(kind(1.d0)), allocatable :: work(:)
character :: trans_
integer :: iwsz,m,n,k,lb,lc, err_act
character(len=20) :: name, ch_err
character(len=20) :: name
name='psb_dcsmv'
info = 0

@ -55,8 +55,8 @@ subroutine psb_dcsrws(rw,a,info,trans)
end interface
character :: trans_
integer :: iwsz,m,n,k,lb,lc,err_act
character(len=20) :: name, ch_err
integer :: m,k,err_act
character(len=20) :: name
name='psb_dcsrws'
info = 0

@ -47,7 +47,7 @@ subroutine psb_dcssm(alpha,t,b,beta,c,info,trans,unitd,d)
real(kind(1.d0)), pointer :: ddl(:)
character :: lt, lu
integer :: iwsz,m,n,lb,lc,err_act
character(len=20) :: name, ch_err
character(len=20) :: name
name='psb_dcssm'
info = 0

@ -48,10 +48,10 @@ subroutine psb_dipcoo2csc(a,info,clshr)
integer, pointer :: iaux(:), itemp(:)
!locals
logical :: clshr_
Integer :: nza, nr, i,j,irw, idl,err_act,nc,icl
Integer :: nza, nr, i,j, idl,err_act,nc,icl
Integer, Parameter :: maxtry=8
logical, parameter :: debug=.false.
character(len=20) :: name, ch_err
character(len=20) :: name
name='psb_ipcoo2csc'
info = 0

@ -51,7 +51,7 @@ subroutine psb_dipcoo2csr(a,info,rwshr)
Integer :: nza, nr, i,j,irw, idl,err_act
Integer, Parameter :: maxtry=8
logical, parameter :: debug=.false.
character(len=20) :: name, ch_err
character(len=20) :: name
name='psb_ipcoo2csr'
info = 0

@ -48,7 +48,7 @@ Subroutine psb_dipcsr2coo(a,info)
integer :: i,j,err_act
logical, parameter :: debug=.false.
integer, pointer :: iaux(:), itemp(:)
character(len=20) :: name, ch_err
character(len=20) :: name
name='psb_dipcsr2coo'
info = 0

@ -47,9 +47,8 @@ subroutine psb_dneigh(a,idx,neigh,n,info,lev)
integer, optional :: lev ! level of neighbours to find
integer, pointer :: tmpn(:)=>null()
integer :: level, dim, i, j, k, r, c, brow,&
& elem_pt, ii, n1, col_idx, ne, err_act, nn, nidx
character(len=20) :: name, ch_err
integer :: level, dim, i, j, k, n1, err_act, nn, nidx
character(len=20) :: name
name='psb_dneigh'
info = 0

@ -150,6 +150,7 @@ contains
nr = lrw - irw + 1
allocate(indices(nr))
nz = 0
do i=1,nr
indices(i)=a%pl(irw+i-1)
nz=nz+a%ia2(indices(i)+1)-a%ia2(indices(i))
@ -403,7 +404,6 @@ contains
ia2 => a%ia2(pia+1:pja-1:3) ! the array containing a pointer to the pos. in ja to the first jad column
ia3 => a%ia2(pia+2:pja-1:3) ! the array containing a pointer to the pos. in ja to the first csr column
if (append) then
nzb = b%infoa(psb_nnz_)
else

@ -175,7 +175,7 @@ contains
integer, intent(in), optional :: ng,gtl(*)
logical, parameter :: debug=.false.
integer :: i,ir,ic,check_flag, ilr, ilc, ip, &
integer :: i,ir,ic, ilr, ilc, ip, &
& i1,i2,nc,lb,ub,m,nnz,dupl
info = 0
@ -396,7 +396,7 @@ contains
real(kind(1.d0)), intent(in) :: val(*)
integer, intent(out) :: info
integer, intent(in), optional :: ng,gtl(*)
integer :: i,ir,ic,check_flag, ilr, ilc, ip, &
integer :: i,ir,ic, ilr, ilc, ip, &
& i1,i2,nc,lb,ub,m,nnz,dupl,isrt
logical, parameter :: debug=.false.
@ -596,7 +596,7 @@ contains
integer, intent(out) :: info
integer, intent(in), optional :: ng,gtl(*)
integer :: i,ir,ic,check_flag, ilr, ilc, ip, &
integer :: i,ir,ic, ilr, ilc, ip, &
& i1,i2,nc,lb,ub,m,nnz,dupl
logical, parameter :: debug=.false.
@ -810,7 +810,7 @@ contains
complex(kind(1.d0)), intent(in) :: val(*)
integer, intent(out) :: info
integer, intent(in), optional :: ng,gtl(*)
integer :: i,ir,ic,check_flag, ilr, ilc, ip, &
integer :: i,ir,ic, ilr, ilc, ip, &
& i1,i2,nc,lb,ub,m,nnz,dupl,isrt
logical, parameter :: debug=.false.

@ -61,11 +61,11 @@ subroutine psb_zcsdp(a, b,info,ifc,check,trans,unitd,upd,dupl)
complex(kind(1.d0)) :: d(1)
complex(kind(1.d0)), allocatable :: work(:)
type(psb_zspmat_type) :: temp_a
Integer :: nzr, ntry, ifc_,ierror, ia1_size,&
Integer :: nzr, ntry, ifc_, ia1_size,&
& ia2_size, aspk_size,size_req,n_row,n_col,upd_,dupl_
integer :: ip1, ip2, nnz, iflag, ichk, nnzt,&
& ipc, i, count, err_act, ierrv(5), i1, i2, ia
character :: check_,trans_,unitd_, up
& ipc, i, count, err_act, i1, i2, ia
character :: check_,trans_,unitd_
Integer, Parameter :: maxtry=8
logical, parameter :: debug=.false.
character(len=20) :: name, ch_err

@ -44,7 +44,7 @@ subroutine psb_zcsmm(alpha,a,b,beta,c,info,trans)
complex(kind(1.d0)), allocatable :: work(:)
character :: trans_
integer :: iwsz,m,n,k,lb,lc,err_act
character(len=20) :: name, ch_err
character(len=20) :: name
name='psb_zcsmm'
info = 0

@ -55,8 +55,8 @@ subroutine psb_zcsrws(rw,a,info,trans)
end interface
character :: trans_
integer :: iwsz,m,n,k,lb,lc,err_act
character(len=20) :: name, ch_err
integer :: m,n,k,err_act
character(len=20) :: name
name='psb_zcsrws'
info = 0

@ -47,7 +47,7 @@ subroutine psb_zcssm(alpha,t,b,beta,c,info,trans,unitd,d)
complex(kind(1.d0)), pointer :: ddl(:)
character :: lt, lu
integer :: iwsz,m,n,lb,lc,err_act
character(len=20) :: name, ch_err
character(len=20) :: name
name='psb_zcssm'
info = 0

@ -47,7 +47,7 @@ subroutine psb_zcssv(alpha,t,b,beta,c,info,trans,unitd,d)
complex(kind(1.d0)), pointer :: ddl(:)
character :: lt, lu
integer :: iwsz,m,n,lb,lc,err_act
character(len=20) :: name, ch_err
character(len=20) :: name
name='psb_zcssv'
info = 0

@ -48,10 +48,10 @@ subroutine psb_zipcoo2csc(a,info,clshr)
integer, pointer :: iaux(:), itemp(:)
!locals
logical :: clshr_
Integer :: nza, nr, i,j,irw, idl,err_act,nc,icl
Integer :: nza, i,j,irw, idl,err_act,nc,icl
Integer, Parameter :: maxtry=8
logical, parameter :: debug=.false.
character(len=20) :: name, ch_err
character(len=20) :: name
name='psb_ipcoo2csc'
info = 0

@ -51,7 +51,7 @@ subroutine psb_zipcoo2csr(a,info,rwshr)
Integer :: nza, nr, i,j,irw, idl,err_act
Integer, Parameter :: maxtry=8
logical, parameter :: debug=.false.
character(len=20) :: name, ch_err
character(len=20) :: name
name='psb_ipcoo2csr'
info = 0

@ -150,6 +150,7 @@ contains
nr = lrw - irw + 1
allocate(indices(nr))
nz = 0
do i=1,nr
indices(i)=a%pl(irw+i-1)
nz=nz+a%ia2(indices(i)+1)-a%ia2(indices(i))

@ -56,12 +56,10 @@ subroutine psb_cdall(m, n, parts, ictxt, desc_a, info)
integer, intent(out) :: info
!locals
Integer :: counter,i,j,np,npcol,me,mycol,&
& loc_row,err,loc_col,nprocs,&
Integer :: counter,i,j,np,me,loc_row,err,loc_col,nprocs,&
& l_ov_ix,l_ov_el,idx, err_act, itmpov, k
Integer :: INT_ERR(5),TEMP(1),EXCH(2)
Real(Kind(1.d0)) :: REAL_ERR(5)
Integer, Pointer :: PRC_V(:), TEMP_OVRLAP(:), OV_IDX(:),OV_EL(:)
integer :: int_err(5),exch(2)
integer, pointer :: prc_v(:), temp_ovrlap(:), ov_idx(:),ov_el(:)
logical, parameter :: debug=.false.
character(len=20) :: name, char_err

@ -55,14 +55,13 @@ subroutine psb_cdalv(m, v, ictxt, desc_a, info, flag)
type(psb_desc_type), intent(out) :: desc_a
!locals
Integer :: counter,i,j,np,npcol,me,mycol,&
& loc_row,err,loc_col,nprocs,n,itmpov, k,&
Integer :: counter,i,j,np,me,loc_row,err,&
& loc_col,nprocs,n,itmpov, k,&
& l_ov_ix,l_ov_el,idx, flag_, err_act
Integer :: INT_ERR(5),TEMP(1),EXCH(2)
Real(Kind(1.d0)) :: REAL_ERR(5)
integer :: int_err(5),exch(2)
Integer, Pointer :: temp_ovrlap(:), ov_idx(:),ov_el(:)
logical, parameter :: debug=.false.
character(len=20) :: name, ch_err
character(len=20) :: name
if(psb_get_errstatus() /= 0) return
info=0
@ -196,7 +195,7 @@ subroutine psb_cdalv(m, v, ictxt, desc_a, info, flag)
allocate(ov_idx(l_ov_ix),ov_el(l_ov_el), stat=info)
if (info /= 0) then
info=2025
int_err(1)=loc_col
int_err(1)=l_ov_ix
call psb_errpush(info,name,i_err=int_err)
goto 9999
end if

@ -54,10 +54,7 @@ subroutine psb_cdcpy(desc_in, desc_out, info)
integer, intent(out) :: info
!locals
integer :: np,me,&
& ictxt, isz, dectype, err_act, err
integer :: int_err(5),temp(1)
real(kind(1.d0)) :: real_err(5)
integer :: np,me,ictxt, isz, err_act
logical, parameter :: debug=.false.,debugprt=.false.
character(len=20) :: name, char_err
if (debug) write(0,*) me,'Entered CDCPY'

@ -115,15 +115,12 @@ subroutine psb_cddec(nloc, ictxt, desc_a, info)
Type(psb_desc_type), intent(out) :: desc_a
!locals
Integer :: counter,i,j,np,npcol,me,mypcol,&
& loc_row,err,loc_col,nprocs,n,itmpov, k,&
& l_ov_ix,l_ov_el,idx, flag_, err_act,m, ip
Integer :: INT_ERR(5),TEMP(1),EXCH(2)
Real(Kind(1.d0)) :: REAL_ERR(5)
Integer, Pointer :: temp_ovrlap(:), ov_idx(:), ov_el(:)
Integer :: i,j,np,me,err,n,itmpov, k,&
& l_ov_ix,l_ov_el,idx, err_act,m, ip
Integer :: INT_ERR(5)
integer, allocatable :: nlv(:)
logical, parameter :: debug=.false.
character(len=20) :: name, ch_err
character(len=20) :: name
if(psb_get_errstatus() /= 0) return
info=0

@ -47,11 +47,8 @@ subroutine psb_cdfree(desc_a,info)
type(psb_desc_type), intent(inout) :: desc_a
integer, intent(out) :: info
!...locals....
integer :: int_err(5)
integer :: temp(1)
real(kind(1.d0)) :: real_err(5)
integer :: ictxt,np,npcol,me,mypcol, err_act
character(len=20) :: name, char_err
integer :: ictxt,np,me, err_act
character(len=20) :: name
if(psb_get_errstatus() /= 0) return
info=0

Some files were not shown because too many files have changed in this diff Show More

Loading…
Cancel
Save