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 ! locals
integer :: int_err(5), ictxt, np, me,& 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 & 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 character(len=20) :: name, ch_err
name='psb_dgatherm' name='psb_dgatherm'
@ -258,10 +257,10 @@ subroutine psb_dgatherv(globx, locx, desc_a, info, iroot,&
! locals ! locals
integer :: int_err(5), ictxt, np, me, mycol,& 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, lock, maxk, globk, m, k, jlx, ilx, i, j, idx & jglobx, lda_locx, lda_globx, m, k, jlx, ilx, i, idx
real(kind(1.d0)),pointer :: tmpx(:)
character(len=20) :: name, ch_err character(len=20) :: name, ch_err
name='psb_dgatherv' 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 character, intent(in), optional :: tran
! locals ! 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_act, m, n, iix, jjx, ix, ijx, k, maxk, nrow, imode, i,&
& err, liwork, ncol & err, liwork
real(kind(1.d0)),pointer :: iwork(:), xp(:,:) real(kind(1.d0)),pointer :: iwork(:), xp(:,:)
character :: ltran character :: ltran
character(len=20) :: name, ch_err 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 character, intent(in), optional :: tran
! locals ! 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_act, m, n, iix, jjx, ix, ijx, nrow, imode, i,&
& err, liwork, ncol & err, liwork
real(kind(1.d0)),pointer :: iwork(:) real(kind(1.d0)),pointer :: iwork(:)
character :: ltran character :: ltran
character(len=20) :: name, ch_err 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 integer, intent(in), optional :: update,jx,ik
! locals ! locals
integer :: int_err(5), ictxt, np, me, mycol,& integer :: int_err(5), ictxt, np, me, &
& err_act, m, n, iix, jjx, temp(2), ix, ijx, nrow, ncol, k, maxk, iupdate,& & err_act, m, n, iix, jjx, ix, ijx, nrow, ncol, k, maxk, iupdate,&
& imode, err, liwork, i & imode, err, liwork, i
real(kind(1.d0)),pointer :: iwork(:), xp(:,:) real(kind(1.d0)),pointer :: iwork(:), xp(:,:)
logical :: do_update logical :: do_update
@ -272,8 +272,8 @@ subroutine psb_dovrlv(x,desc_a,info,work,update)
integer, intent(in), optional :: update integer, intent(in), optional :: update
! locals ! locals
integer :: int_err(5), ictxt, np, me, mycol,& integer :: int_err(5), ictxt, np, me, &
& err_act, m, n, iix, jjx, temp(2), ix, ijx, nrow, ncol, k, maxk, iupdate,& & err_act, m, n, iix, jjx, ix, ijx, nrow, ncol, k, iupdate,&
& imode, err, liwork, i & imode, err, liwork, i
real(kind(1.d0)),pointer :: iwork(:) real(kind(1.d0)),pointer :: iwork(:)
logical :: do_update logical :: do_update

@ -67,7 +67,7 @@ subroutine psb_dscatterm(globx, locx, desc_a, info, iroot,&
! locals ! locals
integer :: int_err(5), ictxt, np, me,& 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,& & ilocx, jlocx, lda_locx, lda_globx, lock, globk, icomm, k, maxk, root, ilx,&
& jlx, myrank, rootrank, c, pos & jlx, myrank, rootrank, c, pos
real(kind(1.d0)),pointer :: scatterv(:) 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_check_mod
use psb_error_mod use psb_error_mod
use mpi use mpi
use psb_penv_mod
implicit none implicit none
real(kind(1.d0)), intent(out) :: locx(:) real(kind(1.d0)), intent(out) :: locx(:)
@ -322,10 +323,10 @@ subroutine psb_dscatterv(globx, locx, desc_a, info, iroot)
! locals ! locals
integer :: int_err(5), ictxt, np, me, mycol,& 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, root, k, maxk, icomm, myrank,& & ilocx, jlocx, lda_locx, lda_globx, root, k, icomm, myrank,&
& rootrank, c, pos, ilx, jlx & rootrank, pos, ilx, jlx
real(kind(1.d0)),pointer :: scatterv(:) real(kind(1.d0)),pointer :: scatterv(:)
integer, pointer :: displ(:), l_t_g_all(:), all_dim(:) integer, pointer :: displ(:), l_t_g_all(:), all_dim(:)
character(len=20) :: name, ch_err 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 character, intent(in), optional :: tran
! locals ! locals
integer :: int_err(5), ictxt, np, me, mycol,& integer :: ictxt, np, me, &
& err_act, m, n, iix, jjx, temp(2), ix, ijx, nrow, ncol, k, maxk, liwork,& & err_act, m, n, iix, jjx, ix, ijx, nrow, k, maxk, liwork,&
& imode, err & imode, err
integer, pointer :: xp(:,:), iwork(:) integer, pointer :: xp(:,:), iwork(:)
character :: ltran character :: ltran
@ -266,8 +266,8 @@ subroutine psb_ihalov(x,desc_a,info,alpha,work,tran,mode)
character, intent(in), optional :: tran character, intent(in), optional :: tran
! locals ! locals
integer :: int_err(5), ictxt, np, me,& integer :: ictxt, np, me,&
& err_act, m, n, iix, jjx, temp(2), ix, ijx, nrow, ncol, k, maxk, imode,& & err_act, m, n, iix, jjx, ix, ijx, nrow, imode,&
& err, liwork & err, liwork
integer,pointer :: iwork(:) integer,pointer :: iwork(:)
character :: ltran character :: ltran

@ -62,10 +62,10 @@ subroutine psb_zgatherm(globx, locx, desc_a, info, iroot,&
! locals ! locals
integer :: int_err(5), ictxt, np, me, mycol,& integer :: int_err(5), ictxt, np, me, &
& err_act, n, iix, jjx, temp(2), 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 & 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 character(len=20) :: name, ch_err
name='psb_zgatherm' name='psb_zgatherm'
@ -258,10 +258,10 @@ subroutine psb_zgatherv(globx, locx, desc_a, info, iroot,&
! locals ! locals
integer :: int_err(5), ictxt, np, me, mycol,& integer :: int_err(5), ictxt, np, me, &
& err_act, n, iix, jjx, temp(2), root, iiroot, ilocx, iglobx, jlocx,& & err_act, n, root, ilocx, iglobx, jlocx,&
& jglobx, lda_locx, lda_globx, lock, maxk, globk, m, k, jlx, ilx, i, j, idx & jglobx, lda_locx, lda_globx, m, k, jlx, ilx, i, idx
complex(kind(1.d0)),pointer :: tmpx(:)
character(len=20) :: name, ch_err character(len=20) :: name, ch_err
name='psb_zgatherv' 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 character, intent(in), optional :: tran
! locals ! locals
integer :: int_err(5), ictxt, np, me, mycol,& integer :: ictxt, np, me, &
& err_act, m, n, iix, jjx, temp(2), ix, ijx, k, maxk, nrow, imode, i,& & err_act, m, n, iix, jjx, ix, ijx, k, maxk, nrow, imode, i,&
& err, liwork, ncol & err, liwork
complex(kind(1.d0)),pointer :: iwork(:), xp(:,:) complex(kind(1.d0)),pointer :: iwork(:), xp(:,:)
character :: ltran character :: ltran
character(len=20) :: name, ch_err 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 character, intent(in), optional :: tran
! locals ! locals
integer :: int_err(5), ictxt, np, me, mycol,& integer :: ictxt, np, me, err_act, &
& err_act, m, n, iix, jjx, temp(2), ix, ijx, k, maxk, nrow, imode, i,& & m, n, iix, jjx, ix, ijx, nrow, imode, err, liwork
& err, liwork, ncol
complex(kind(1.d0)),pointer :: iwork(:) complex(kind(1.d0)),pointer :: iwork(:)
character :: ltran character :: ltran
character(len=20) :: name, ch_err 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 integer, intent(in), optional :: update,jx,ik
! locals ! locals
integer :: int_err(5), ictxt, np, me, mycol,& integer :: int_err(5), ictxt, np, me, &
& err_act, m, n, iix, jjx, temp(2), ix, ijx, nrow, ncol, k, maxk, iupdate,& & err_act, m, n, iix, jjx, ix, ijx, nrow, ncol, k, maxk, iupdate,&
& imode, err, liwork, i & imode, err, liwork, i
complex(kind(1.d0)),pointer :: iwork(:), xp(:,:) complex(kind(1.d0)),pointer :: iwork(:), xp(:,:)
logical :: do_update logical :: do_update
@ -272,8 +272,8 @@ subroutine psb_zovrlv(x,desc_a,info,work,update)
integer, intent(in), optional :: update integer, intent(in), optional :: update
! locals ! locals
integer :: int_err(5), ictxt, np, me, mycol,& integer :: int_err(5), ictxt, np, me, &
& err_act, m, n, iix, jjx, temp(2), ix, ijx, nrow, ncol, k, maxk, iupdate,& & err_act, m, n, iix, jjx, ix, ijx, nrow, ncol, k, iupdate,&
& imode, err, liwork, i & imode, err, liwork, i
complex(kind(1.d0)),pointer :: iwork(:) complex(kind(1.d0)),pointer :: iwork(:)
logical :: do_update logical :: do_update

@ -66,8 +66,8 @@ subroutine psb_zscatterm(globx, locx, desc_a, info, iroot,&
! locals ! locals
integer :: int_err(5), ictxt, np, me, mycol,& 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,& & ilocx, jlocx, lda_locx, lda_globx, lock, globk, icomm, k, maxk, root, ilx,&
& jlx, myrank, rootrank, c, pos & jlx, myrank, rootrank, c, pos
complex(kind(1.d0)),pointer :: scatterv(:) 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_check_mod
use psb_error_mod use psb_error_mod
use mpi use mpi
use psb_penv_mod
implicit none implicit none
complex(kind(1.d0)), intent(out) :: locx(:) complex(kind(1.d0)), intent(out) :: locx(:)
@ -321,9 +322,9 @@ subroutine psb_zscatterv(globx, locx, desc_a, info, iroot)
! locals ! locals
integer :: int_err(5), ictxt, np, me, mycol,& 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, root, k, maxk, icomm, myrank,& & ilocx, jlocx, lda_locx, lda_globx, root, k, icomm, myrank,&
& rootrank, c, pos, ilx, jlx & rootrank, c, pos, ilx, jlx
complex(kind(1.d0)),pointer :: scatterv(:) complex(kind(1.d0)),pointer :: scatterv(:)
integer, pointer :: displ(:), l_t_g_all(:), all_dim(:) 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(:) integer :: desc_data(:), index_in(:)
! ....local scalars.... ! ....local scalars....
integer :: i,np,me,proc, max_index integer :: i,np,me,proc, max_index
integer :: ictxt, err, err_act integer :: ictxt, err_act
! ...local array... ! ...local array...
integer :: exch(2)
integer :: int_err(5) integer :: int_err(5)
integer, allocatable :: counter_recv(:), counter_dl(:) integer, allocatable :: counter_recv(:), counter_dl(:)
@ -118,7 +117,7 @@ subroutine psi_compute_size(desc_data, index_in, dl_lda, info)
9999 continue 9999 continue
call psb_erractionrestore(err_act) call psb_erractionrestore(err_act)
if (err_act.eq.act_abort) then if (err_act == act_abort) then
call psb_error(ictxt) call psb_error(ictxt)
return return
end if end if

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

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

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

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

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

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

@ -42,10 +42,10 @@ subroutine psi_sort_dl(dep_list,l_dep_list,np,info)
integer :: i, info integer :: i, info
integer, pointer :: work(:) integer, pointer :: work(:)
logical, parameter :: debug=.false. logical, parameter :: debug=.false.
character(len=20) :: name, ch_err character(len=20) :: name
name='psi_sort_dl' name='psi_sort_dl'
if(psb_get_errstatus().ne.0) return if(psb_get_errstatus() /= 0) return
info=0 info=0
call psb_erractionsave(err_act) 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),& 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) & 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') call psb_errpush(4010,name,a_err='srtlist')
goto 9999 goto 9999
endif endif
@ -81,7 +81,7 @@ subroutine psi_sort_dl(dep_list,l_dep_list,np,info)
9999 continue 9999 continue
call psb_erractionrestore(err_act) call psb_erractionrestore(err_act)
if (err_act.eq.act_abort) then if (err_act == act_abort) then
call psb_error() call psb_error()
return return
end if end if

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

@ -45,11 +45,9 @@ subroutine psi_zswaptranm(flag,n,beta,y,desc_a,work,info,data)
integer, optional :: data integer, optional :: data
! locals ! locals
integer :: ictxt, np, npcol, me,& integer :: ictxt, np, me, point_to_proc, nesd, nerv,&
& mycol, point_to_proc, nesd, nerv,&
& proc_to_comm, p2ptag, icomm, p2pstat(mpi_status_size),& & proc_to_comm, p2ptag, icomm, p2pstat(mpi_status_size),&
& idxs, idxr, iret, errlen, ifcomm, rank,& & idxs, idxr, iret, err_act, totxch, ixrec, i, idx_pt,&
& err_act, totxch, ixrec, i, lw, idx_pt,&
& snd_pt, rcv_pt & snd_pt, rcv_pt
integer, pointer, dimension(:) :: bsdidx, brvidx,& integer, pointer, dimension(:) :: bsdidx, brvidx,&
@ -58,7 +56,7 @@ subroutine psi_zswaptranm(flag,n,beta,y,desc_a,work,info,data)
integer :: krecvid, ksendid integer :: krecvid, ksendid
logical :: swap_mpi, swap_sync, swap_send, swap_recv, all logical :: swap_mpi, swap_sync, swap_send, swap_recv, all
complex(kind(1.d0)), pointer, dimension(:) :: sndbuf, rcvbuf complex(kind(1.d0)), pointer, dimension(:) :: sndbuf, rcvbuf
character(len=20) :: name, ch_err character(len=20) :: name
info = 0 info = 0
name='psi_zswaptranm' name='psi_zswaptranm'
@ -502,11 +500,9 @@ subroutine psi_zswaptranv(flag,beta,y,desc_a,work,info,data)
integer, optional :: data integer, optional :: data
! locals ! locals
integer :: ictxt, np, npcol, me,& integer :: ictxt, np, me, point_to_proc, nesd, nerv,&
& mycol, point_to_proc, nesd, nerv,&
& proc_to_comm, p2ptag, icomm, p2pstat(mpi_status_size),& & proc_to_comm, p2ptag, icomm, p2pstat(mpi_status_size),&
& idxs, idxr, iret, errlen, ifcomm, rank,& & idxs, idxr, iret, err_act, totxch, ixrec, i, idx_pt,&
& err_act, totxch, ixrec, i, lw, idx_pt,&
& snd_pt, rcv_pt, n & snd_pt, rcv_pt, n
integer, pointer, dimension(:) :: bsdidx, brvidx,& integer, pointer, dimension(:) :: bsdidx, brvidx,&
@ -515,7 +511,7 @@ subroutine psi_zswaptranv(flag,beta,y,desc_a,work,info,data)
integer :: krecvid, ksendid integer :: krecvid, ksendid
logical :: swap_mpi, swap_sync, swap_send, swap_recv, all logical :: swap_mpi, swap_sync, swap_send, swap_recv, all
complex(kind(1.d0)), pointer, dimension(:) :: sndbuf, rcvbuf complex(kind(1.d0)), pointer, dimension(:) :: sndbuf, rcvbuf
character(len=20) :: name, ch_err character(len=20) :: name
info = 0 info = 0
name='psi_zswaptranv' 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 :: aux(:),wwrk(:,:)
real(kind(1.d0)), pointer :: ww(:), q(:),& real(kind(1.d0)), pointer :: ww(:), q(:),&
& r(:), p(:), zt(:), pt(:), z(:), rt(:),qt(:) & r(:), p(:), zt(:), pt(:), z(:), rt(:),qt(:)
integer, pointer :: iperm(:), ipnull(:), ipsave(:), int_err(:) integer :: int_err(5)
real(kind(1.d0)) ::rerr real(kind(1.d0)) ::rerr
integer ::litmax, liter, naux, m, mglob, it, itrace_,& integer ::litmax, liter, naux, m, mglob, it, itrace_,&
& np,me, n_row, n_col, istop_, err_act & 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 :: debug = .false.
logical, parameter :: exchange=.true., noexchange=.false. logical, parameter :: exchange=.true., noexchange=.false.
integer, parameter :: irmax = 8 integer, parameter :: irmax = 8
integer :: itx, i, isvch, ich, ictxt integer :: itx, i, isvch, ictxt
logical :: do_renum_left
real(kind(1.d0)) :: alpha, beta, rho, rho_old, rni, xni, bni, ani,& 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 character(len=20) :: name,ch_err
info = 0 info = 0

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

@ -98,19 +98,17 @@ Subroutine psb_dcgs(a,prec,b,x,eps,desc_a,info,&
!!$ local data !!$ local data
Real(Kind(1.d0)), Pointer :: aux(:),wwrk(:,:) Real(Kind(1.d0)), Pointer :: aux(:),wwrk(:,:)
Real(Kind(1.d0)), Pointer :: ww(:), q(:),& Real(Kind(1.d0)), Pointer :: ww(:), q(:),&
& r(:), p(:), v(:), s(:), t(:), z(:), f(:), rt(:),qt(:),uv(:) & r(:), p(:), v(:), s(:), z(:), f(:), rt(:),qt(:),uv(:)
Integer, Pointer :: iperm(:), ipnull(:), ipsave(:) Real(Kind(1.d0)) :: rerr
Real(Kind(1.d0)) ::rerr Integer :: litmax, naux, m, mglob, it, itrace_,int_err(5),&
Integer ::litmax, liter, naux, m, mglob, it, itrace_,int_err(5),& & np,me, n_row, n_col,istop_, err_act
& np,me,mecol, n_row, n_col,istop_, err_act
Character ::diagl, diagu Character ::diagl, diagu
Logical, Parameter :: exchange=.True., noexchange=.False. Logical, Parameter :: exchange=.True., noexchange=.False.
Integer, Parameter :: irmax = 8 Integer, Parameter :: irmax = 8
Integer :: itx, i, isvch, ich, ictxt Integer :: itx, i, isvch, ich, ictxt
Logical :: do_renum_left
Logical, Parameter :: debug = .false. Logical, Parameter :: debug = .false.
Real(Kind(1.d0)) :: alpha, beta, rho, rho_old, rni, xni, bni, ani,bn2,& Real(Kind(1.d0)) :: alpha, beta, rho, rho_old, rni, xni, bni, ani,bn2,&
& sigma, omega, tau & sigma
character(len=20) :: name,ch_err character(len=20) :: name,ch_err
info = 0 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 :: aux(:),wwrk(:,:)
Real(Kind(1.d0)), Pointer :: q(:),& Real(Kind(1.d0)), Pointer :: q(:),&
& r(:), p(:), v(:), s(:), t(:), z(:), f(:) & r(:), p(:), v(:), s(:), t(:), z(:), f(:)
Integer, Pointer :: iperm(:), ipnull(:), ipsave(:) Real(Kind(1.d0)) :: rerr
Real(Kind(1.d0)) ::rerr Integer :: litmax, naux, m, mglob, it,itrace_,&
Integer ::litmax, liter, naux, m, mglob, it,itrace_,&
& np,me, n_row, n_col & np,me, n_row, n_col
Character ::diagl, diagu Character ::diagl, diagu
Logical, Parameter :: debug = .false. Logical, Parameter :: debug = .false.
Logical, Parameter :: exchange=.True., noexchange=.False., debug1 = .False. Logical, Parameter :: exchange=.True., noexchange=.False., debug1 = .False.
Integer, Parameter :: irmax = 8 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_ Integer :: istop_
Logical :: do_renum_left
Real(Kind(1.d0)) :: alpha, beta, rho, rho_old, rni, xni, bni, ani,& Real(Kind(1.d0)) :: alpha, beta, rho, rho_old, rni, xni, bni, ani,&
& sigma, omega, tau, rn0, bn2 & sigma, omega, tau, rn0, bn2
!!$ Integer istpb, istpe, ifctb, ifcte, imerr, irank, icomm,immb,imme !!$ Integer istpb, istpe, ifctb, ifcte, imerr, irank, icomm,immb,imme
!!$ Integer mpe_log_get_event_number,mpe_Describe_state,mpe_log_event !!$ Integer mpe_log_get_event_number,mpe_Describe_state,mpe_log_event
character(len=20) :: name,ch_err character(len=20) :: name
info = 0 info = 0
name = 'psb_dcgstab' 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 :: aux(:),wwrk(:,:)
Real(Kind(1.d0)), Pointer :: ww(:), q(:), r(:), rt0(:), p(:), v(:), & Real(Kind(1.d0)), Pointer :: ww(:), q(:), r(:), rt0(:), p(:), v(:), &
& s(:), t(:), z(:), f(:), uh(:,:), rh(:,:), & & s(:), t(:), z(:), f(:), uh(:,:), rh(:,:), &
& gamma(:), gamma1(:), gamma2(:), taum(:,:), sigma(:),& & gamma(:), gamma1(:), gamma2(:), taum(:,:), sigma(:)
&pv1(:), pv2(:), pm1(:,:), pm2(:,:)
Integer, Pointer :: iperm(:), ipnull(:), ipsave(:) Real(Kind(1.d0)) :: rerr
Real(Kind(1.d0)) ::rerr Integer :: litmax, naux, m, mglob, it, itrace_,&
Integer ::litmax, liter, naux, m, mglob, it, itrace_,&
& np,me, n_row, n_col, nl, err_act & np,me, n_row, n_col, nl, err_act
Character ::diagl, diagu Character ::diagl, diagu
Logical, Parameter :: exchange=.True., noexchange=.False. Logical, Parameter :: exchange=.True., noexchange=.False.
Integer, Parameter :: irmax = 8 Integer, Parameter :: irmax = 8
Integer :: itx, i, isvch, ich, ictxt,istop_,j, int_err(5) Integer :: itx, i, isvch, ich, ictxt,istop_,j, int_err(5)
Logical :: do_renum_left
Logical, Parameter :: debug = .False. Logical, Parameter :: debug = .False.
Real(Kind(1.d0)) :: alpha, beta, rho, rho_old, rni, xni, bni, ani,bn2,& Real(Kind(1.d0)) :: alpha, beta, rho, rho_old, rni, xni, bni, ani,bn2,&
& omega, tau & omega, tau
character(len=20) :: name,ch_err character(len=20) :: name
info = 0 info = 0
name = 'psb_dcgstabl' name = 'psb_dcgstabl'

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

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

@ -37,8 +37,8 @@ module psb_error_mod
& psb_get_erraction, psb_set_erraction & psb_get_erraction, psb_set_erraction
interface psb_error interface psb_error
module procedure psb_serror module procedure psb_serror
module procedure psb_perror module procedure psb_perror
end interface end interface
!!$ integer, parameter :: act_ret=0, act_abort=1, no_err=0 !!$ integer, parameter :: act_ret=0, act_abort=1, no_err=0
@ -47,21 +47,21 @@ module psb_error_mod
type psb_errstack_node type psb_errstack_node
integer :: err_code=0 ! the error code integer :: err_code=0 ! the error code
character(len=20) :: routine='' ! the name of the routine generating the error 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 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 ! 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 ! 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 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 type(psb_errstack_node), pointer :: next ! pointer to the next element in the stack
end type psb_errstack_node end type psb_errstack_node
type psb_errstack type psb_errstack
type(psb_errstack_node), pointer :: top => null() ! pointer to the top element of 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 integer :: n_elems=0 ! number of entries in the stack
end type psb_errstack end type psb_errstack
@ -198,34 +198,34 @@ contains
integer :: err_c integer :: err_c
character(len=20) :: r_name, a_e_d character(len=20) :: r_name, a_e_d
integer :: i_e_d(5) integer :: i_e_d(5)
integer :: nprow, npcol, me, mypcol, temp(2) integer :: nprow, npcol, me, mypcol
integer, parameter :: ione=1, izero=0 integer, parameter :: ione=1, izero=0
call blacs_gridinfo(ictxt, nprow, npcol, me, mypcol) call blacs_gridinfo(ictxt, nprow, npcol, me, mypcol)
if(error_status.gt.0) then 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,me)
! write(0,'(50("="))')
end do
call blacs_abort(ictxt,-1)
else
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_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) call psb_errmsg(err_c, r_name, i_e_d, a_e_d,me)
do while (error_stack%n_elems.gt.0) ! write(0,'(50("="))')
call psb_errpop(err_c, r_name, i_e_d, a_e_d) end do
end do call blacs_abort(ictxt,-1)
call blacs_abort(ictxt,-1) else
end if
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 end if
if(error_status.gt.izero) then if(error_status.gt.izero) then
call blacs_abort(ictxt,err_c) call blacs_abort(ictxt,err_c)
end if end if
@ -238,27 +238,26 @@ contains
integer :: err_c integer :: err_c
character(len=20) :: r_name, a_e_d character(len=20) :: r_name, a_e_d
integer :: i_e_d(5) integer :: i_e_d(5)
integer :: nprow, npcol, me, mypcol, temp(2)
integer, parameter :: ione=1, izero=0 integer, parameter :: ione=1, izero=0
if(error_status.gt.0) then 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) do while (error_stack%n_elems.gt.izero)
write(0,'(50("="))') write(0,'(50("="))')
call psb_errpop(err_c, r_name, i_e_d, a_e_d) 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) call psb_errmsg(err_c, r_name, i_e_d, a_e_d)
! write(0,'(50("="))') ! write(0,'(50("="))')
end do 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_errpop(err_c, r_name, i_e_d, a_e_d)
call psb_errmsg(err_c, r_name, i_e_d, a_e_d) end do
do while (error_stack%n_elems.gt.0) end if
call psb_errpop(err_c, r_name, i_e_d, a_e_d)
end do
end if
end if end if
end subroutine psb_serror end subroutine psb_serror
@ -273,188 +272,188 @@ contains
integer, optional :: me integer, optional :: me
if(present(me)) then 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 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 end if
select case (err_c) select case (err_c)
case(:0) 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) 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) 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) case(5)
write (0,'("Invalid input")') write (0,'("Invalid input")')
case(10) case(10)
write (0,'("input argument n. ",i0," cannot be less than 0")')i_e_d(1) 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,'("current value is ",i0)')i_e_d(2)
case(20) case(20)
write (0,'("input argument n. ",i0," cannot be greater than 0")')i_e_d(1) 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,'("current value is ",i0)')i_e_d(2)
case(30) case(30)
write (0,'("input argument n. ",i0," has an invalid value")')i_e_d(1) 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,'("current value is ",i0)')i_e_d(2)
case(35) case(35)
write (0,'("Size of input array argument n. ",i0," is invalid.")')i_e_d(1) 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,'("Current value is ",i0)')i_e_d(2)
case(40) case(40)
write (0,'("input argument n. ",i0," has an invalid value")')i_e_d(1) 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,'("current value is ",a)')a_e_d(2:2)
case(50) 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,'("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,'("current values are ",i0," < ",i0)') i_e_d(2),i_e_d(5)
case(60) 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,'("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,'("current value is ",i0," < ",i0)')i_e_d(3), i_e_d(2)
case(70) case(70)
write (0,'("input argument n. ",i0," in entry # ",i0," has an invalid value")')i_e_d(1:2) 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,'("current value is ",a)')a_e_d
case(71) case(71)
write (0,'("Impossible error in ASB: nrow>ncol,")') write (0,'("Impossible error in ASB: nrow>ncol,")')
write (0,'("Actual values are ",i0," > ",i0)')i_e_d(1:2) write (0,'("Actual values are ",i0," > ",i0)')i_e_d(1:2)
! ... csr format error ... ! ... csr format error ...
case(80) case(80)
write (0,'("input argument ia2(1) is less than 0")') write (0,'("input argument ia2(1) is less than 0")')
write (0,'("current value is ",i0)')i_e_d(1) write (0,'("current value is ",i0)')i_e_d(1)
! ... csr format error ... ! ... csr format error ...
case(90) 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) case(91)
write (0,'("indices in ia1 array are not in increasing order")') write (0,'("indices in ia1 array are not in increasing order")')
! ... csr format error ... ! ... csr format error ...
case(100) case(100)
write (0,'("indices in ia1 array are not within problem dimension")') write (0,'("indices in ia1 array are not within problem dimension")')
write (0,'("problem dimension is ",i0)')i_e_d(1) write (0,'("problem dimension is ",i0)')i_e_d(1)
case(110) case(110)
write (0,'("invalid combination of input arguments")') write (0,'("invalid combination of input arguments")')
case(115) case(115)
write (0,'("Invalid process identifier in input array argument n. ",i0,".")')i_e_d(1) 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,'("Current value is ",i0)')i_e_d(2)
case(120) case(120)
write (0,'("input argument n. ",i0," must be greater than input argument n. ",i0)')i_e_d(1:2) 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) write (0,'("current values are ",i0," < ",i0)') i_e_d(3:4)
! ... coo format error ... ! ... coo format error ...
case(130) case(130)
write (0,'("there are duplicated elements in coo format")') write (0,'("there are duplicated elements in coo format")')
write (0,'("please set repflag flag to 2 or 3")') write (0,'("please set repflag flag to 2 or 3")')
case(134) 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) 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) 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) 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) 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) 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) 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) case(300)
write (0,'("Input argument n. ",i0," must be equal to entry n. ",i0," in array input argument n.",i0)') & 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) & 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,'("Current values are ",i0," != ",i0)')i_e_d(2), i_e_d(5)
case(400) case(400)
write (0,'("MPI error:",i0)')i_e_d(1) write (0,'("MPI error:",i0)')i_e_d(1)
case(550) 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) case(570)
write (0,'("partition function passed as input argument n. ",i0," returns number of processes")')i_e_d(1) 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,'("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,'("processes is ",i0,", number returned is ",i0)')i_e_d(2),i_e_d(3)
case(575) case(575)
write (0,'("partition function passed as input argument n. ",i0," returns number of processes")')i_e_d(1) 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,'("less or equal to 0 on global point ",i0,". Number returned is ",i0)')i_e_d(3),i_e_d(2)
case(580) case(580)
write (0,'("partition function passed as input argument n. ",i0," returns wrong processes identifier")')i_e_d(1) 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,'("on global point ",i0,". Current value returned is : ",i0)')i_e_d(3),i_e_d(2)
case(600) 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) case (1122)
write (0,'("Invalid state for DESC_A")') write (0,'("Invalid state for DESC_A")')
case (1123) 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) case(1124:1999)
write (0,'("computational error. code: ",i0)')err_c write (0,'("computational error. code: ",i0)')err_c
case(2010) case(2010)
write (0,'("BLACS error. Number of processes=-1")') write (0,'("BLACS error. Number of processes=-1")')
case(2011) 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) case(2025)
write (0,'("Cannot allocate ",i0," bytes")')i_e_d(1) write (0,'("Cannot allocate ",i0," bytes")')i_e_d(1)
case(2030) 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) case(2231)
write (0,'("Invalid input state for matrix.")') write (0,'("Invalid input state for matrix.")')
case(2232) 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) case (2233:2999)
write(0,'("resource error. code: ",i0)')err_c write(0,'("resource error. code: ",i0)')err_c
case(3000:3009) 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) 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) 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) case(3020)
write (0,'("Case trans = C is not yet implemented.")') write (0,'("Case trans = C is not yet implemented.")')
case(3021) case(3021)
write (0,'("Case trans /= N is not yet implemented.")') write (0,'("Case trans /= N is not yet implemented.")')
case(3022) case(3022)
write (0,'("Only unit diagonal so far for triangular matrices. ")') write (0,'("Only unit diagonal so far for triangular matrices. ")')
case(3023) 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) case(3024)
write (0,'("Cases DESCRA(1:1)=G not yet implemented. ")') write (0,'("Cases DESCRA(1:1)=G not yet implemented. ")')
case(3030) 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) 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) case(3050)
write (0,'("Case ix /= iy is not yet implemented.")') write (0,'("Case ix /= iy is not yet implemented.")')
case(3060) case(3060)
write (0,'("Case ix /= 1 is not yet implemented.")') write (0,'("Case ix /= 1 is not yet implemented.")')
case(3070) case(3070)
write (0,'("This operation is only implemented with no overlap.")') write (0,'("This operation is only implemented with no overlap.")')
case(3080) 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) case(3090)
write (0,'("Insert matrix mode not yet implemented.")') write (0,'("Insert matrix mode not yet implemented.")')
case(3100) case(3100)
write (0,'("Error on index. Element has not been inserted")') 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,'("local index is: ",i0," and global index is:",i0)')i_e_d(1:2)
case(3110) 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) case(3111:3999)
write(0,'("miscellaneus error. code: ",i0)')err_c write(0,'("miscellaneus error. code: ",i0)')err_c
case(4000) case(4000)
write(0,'("Allocation/deallocation error")') write(0,'("Allocation/deallocation error")')
case(4010) 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) case(4011)
write (0,'("Error from call to a subroutine ")') write (0,'("Error from call to a subroutine ")')
case(4012) 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) 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) 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) case (5001)
write (0,'("Invalid ISTOP: ",i0)')i_e_d(1) write (0,'("Invalid ISTOP: ",i0)')i_e_d(1)
case (5002) case (5002)
write (0,'("Invalid PREC: ",i0)')i_e_d(1) write (0,'("Invalid PREC: ",i0)')i_e_d(1)
case (5003) case (5003)
write (0,'("Invalid PREC: ",a3)')a_e_d(1:3) write (0,'("Invalid PREC: ",a3)')a_e_d(1:3)
case default case default
write(0,'("unknown error (",i0,") in subroutine ",a)')err_c,r_name write(0,'("unknown error (",i0,") in subroutine ",a)')err_c,r_name
write(0,'(5(i0,2x))') i_e_d write(0,'(5(i0,2x))') i_e_d
write(0,'(a)') a_e_d write(0,'(a)') a_e_d
end select end select

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

@ -145,7 +145,7 @@ contains
!locals !locals
logical, parameter :: debug=.false. logical, parameter :: debug=.false.
logical :: clear_ logical :: clear_
character(len=20) :: name, ch_err character(len=20) :: name
info = 0 info = 0
name = 'psb_sp_reinit' name = 'psb_sp_reinit'
@ -436,10 +436,9 @@ contains
Integer, intent(out) :: info Integer, intent(out) :: info
!locals !locals
Integer :: nza,nz1, nz2, nzl, nzr
logical, parameter :: debug=.false. logical, parameter :: debug=.false.
INFO = 0 info = 0
if (associated(b%pr)) then if (associated(b%pr)) then
deallocate(b%pr,stat=info) deallocate(b%pr,stat=info)
@ -507,7 +506,7 @@ contains
Integer, intent(out) :: i1, i2, ia, info Integer, intent(out) :: i1, i2, ia, info
!locals !locals
Integer :: nza,nz1, nz2, nzl, nzr Integer :: nza
logical, parameter :: debug=.false. logical, parameter :: debug=.false.
info = 0 info = 0
@ -671,7 +670,7 @@ contains
!locals !locals
logical, parameter :: debug=.false. logical, parameter :: debug=.false.
logical :: clear_ logical :: clear_
character(len=20) :: name, ch_err character(len=20) :: name
info = 0 info = 0
name = 'psb_sp_reinit' name = 'psb_sp_reinit'
@ -957,10 +956,9 @@ contains
Integer, intent(out) :: info Integer, intent(out) :: info
!locals !locals
Integer :: nza,nz1, nz2, nzl, nzr
logical, parameter :: debug=.false. logical, parameter :: debug=.false.
INFO = 0 info = 0
if (associated(b%pr)) then if (associated(b%pr)) then
deallocate(b%pr,stat=info) deallocate(b%pr,stat=info)
@ -1029,7 +1027,7 @@ contains
Integer, intent(out) :: i1, i2, ia, info Integer, intent(out) :: i1, i2, ia, info
!locals !locals
Integer :: nza,nz1, nz2, nzl, nzr Integer :: nza
logical, parameter :: debug=.false. logical, parameter :: debug=.false.
info = 0 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 real(kind(1.d0)) :: t1,t2,t3,mpi_wtime
external mpi_wtime external mpi_wtime
integer idscb,idsce,iovrb,iovre, err, irank, icomm integer icomm
! .. Local Scalars .. ! .. Local Scalars ..
Integer :: k, tot_elem,proc,& Integer :: k, np,me,m,nnzero,&
& point,nprow,npcol, me, mycol, start,m,nnzero,& & ictxt, n_col,ier,n,int_err(5),&
& ictxt, lovr, n_col, linp,ier,n,int_err(5),& & tot_recv, ircode, n_row,nhalo, nrow_a,err_act
& tot_recv, ircode, n_row, nztot,nhalo, nrow_a,err_act
Logical,Parameter :: debug=.false., debugprt=.false. Logical,Parameter :: debug=.false., debugprt=.false.
character(len=20) :: name, ch_err character(len=20) :: name, ch_err
name='psb_dasmatbld' name='psb_dasmatbld'
@ -172,9 +171,9 @@ Subroutine psb_dasmatbld(ptype,novr,a,blk,desc_data,upd,desc_p,info,outfmt)
return return
endif 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 If(debug)Write(0,*)'BEGIN dasmatbld',me,upd,novr
t1 = mpi_wtime() 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) integer :: n_row,n_col, int_err(5)
real(kind(1.d0)), pointer :: ww(:), aux(:), tx(:),ty(:) real(kind(1.d0)), pointer :: ww(:), aux(:), tx(:),ty(:)
character ::diagl, diagu 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 real(kind(1.d0)) :: t1, t2, t3, t4, t5, t6, t7, mpi_wtime
logical,parameter :: debug=.false., debugprt=.false. logical,parameter :: debug=.false., debugprt=.false.
external mpi_wtime 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 integer :: n_row,n_col
real(kind(1.d0)), pointer :: ww(:), aux(:), tx(:),ty(:),tb(:) real(kind(1.d0)), pointer :: ww(:), aux(:), tx(:),ty(:),tb(:)
character ::diagl, diagu 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 real(kind(1.d0)) :: t1, t2, t3, t4, t5, t6, t7, mpi_wtime
logical,parameter :: debug=.false., debugprt=.false. logical,parameter :: debug=.false., debugprt=.false.
external mpi_wtime external mpi_wtime

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

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

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

@ -75,14 +75,11 @@ subroutine psb_dilu_bld(a,desc_a,p,upd,info)
character :: trans, unitd character :: trans, unitd
type(psb_dspmat_type) :: blck, atmp type(psb_dspmat_type) :: blck, atmp
real(kind(1.d0)) :: t1,t2,t3,t4,t5,t6,mpi_wtime, t7, t8 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 external mpi_wtime
logical, parameter :: debugprt=.false., debug=.false., aggr_dump=.false. logical, parameter :: debugprt=.false., debug=.false., aggr_dump=.false.
integer istpb, istpe, ifctb, ifcte, err_act, irank, icomm, nztota, nztotb,& integer nztota, nztotb, nztmp, nzl, nnr, ir, err_act,&
& nztmp, nzl, nnr, ir, mglob, mtype, n_row, nrow_a,n_col, nhalo,lovr, & & n_row, nrow_a,n_col, nhalo,lovr, ind, iind
& ind, iind, pi,nr,ns integer :: ictxt,np,me
integer ::ictxt,np,npcol,me,mycol
character(len=20) :: name, ch_err character(len=20) :: name, ch_err
interface psb_ilu_fct 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(:),& real(kind(1.d0)), allocatable :: tx(:),ty(:),t2l(:),w2l(:),&
& x2l(:),b2l(:),tz(:),tty(:) & x2l(:),b2l(:),tz(:),tty(:)
character ::diagl, diagu 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)) :: omega
real(kind(1.d0)) :: t1, t2, t3, t4, t5, t6, t7, mpi_wtime real(kind(1.d0)) :: t1, t2, t3, t4, t5, t6, t7, mpi_wtime
logical, parameter :: debug=.false., debugprt=.false. logical, parameter :: debug=.false., debugprt=.false.

@ -96,7 +96,7 @@ subroutine psb_dmlprc_bld(a,desc_a,p,info)
end subroutine psb_dbldaggrmat end subroutine psb_dbldaggrmat
end interface end interface
integer :: ictxt, nprow, npcol, me, mycol integer :: ictxt, np, me
name='psb_mlprec_bld' name='psb_mlprec_bld'
if(psb_get_errstatus().ne.0) return 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 ! Local variables
character :: trans_ character :: trans_
real(kind(1.d0)), pointer :: work_(:) real(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. logical,parameter :: debug=.false., debugprt=.false.
external mpi_wtime external mpi_wtime
character(len=20) :: name, ch_err character(len=20) :: name
interface psb_baseprc_aply interface psb_baseprc_aply
subroutine psb_dbaseprc_aply(prec,x,beta,y,desc_data,trans,work,info) 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 ! Local variables
character :: trans_ 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(:) real(kind(1.d0)), pointer :: WW(:), w1(:)
character(len=20) :: name, ch_err character(len=20) :: name
name='psb_dprec1' name='psb_dprec1'
info = 0 info = 0
call psb_erractionsave(err_act) call psb_erractionsave(err_act)

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

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

@ -52,7 +52,7 @@ subroutine psb_dslu_bld(a,desc_a,p,info)
type(psb_dspmat_type) :: blck, atmp type(psb_dspmat_type) :: blck, atmp
character(len=5) :: fmt character(len=5) :: fmt
character :: upd='F' 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. logical, parameter :: debug=.false.
character(len=20) :: name, ch_err 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 character(len=20) :: name, ch_err
integer istpb, istpe, ifctb, ifcte, err_act, irank, icomm, nztota, nztotb,& integer nztota, nztotb, nztmp, nzl, nnr, ir, mglob, mtype, n_row, &
& nztmp, nzl, nnr, ir, mglob, mtype, n_row, nrow_a,n_col, nhalo,lovr, & & nrow_a,n_col, nhalo,lovr, ind, iind, pi,nr,ns,i,j,jj,k,kk
& ind, iind, pi,nr,ns,i,j,jj,k,kk integer ::ictxt,np,me, err_act
integer ::ictxt,np,npcol,me,mycol
integer, pointer :: itmp(:), itmp2(:) integer, pointer :: itmp(:), itmp2(:)
real(kind(1.d0)), pointer :: rtmp(:) real(kind(1.d0)), pointer :: rtmp(:)
real(kind(1.d0)) :: t1,t2,t3,t4,t5,t6,mpi_wtime, t7, t8 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() t3 = mpi_wtime()
! Build ATMP with new numbering. ! Build ATMP with new numbering.
nztmp=size(atmp%aspk)
allocate(itmp(max(8,atmp%m+2,nztmp+2)),rtmp(atmp%m),stat=info) allocate(itmp(max(8,atmp%m+2,nztmp+2)),rtmp(atmp%m),stat=info)
if (info /= 0) then if (info /= 0) then
call psb_errpush(4010,name,a_err='Allocate') 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
enddo enddo
atmp%ia2(a%m+1) = a%ia2(a%m+1) atmp%ia2(a%m+1) = a%ia2(a%m+1)
nztota = atmp%ia2(a%m+1) -1
if (blck%m>0) then if (blck%m>0) then
do i=1, blck%m do i=1, blck%m
atmp%ia2(a%m+i) = nztota+blck%ia2(i) 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 type(psb_dspmat_type) :: blck, atmp
character(len=5) :: fmt character(len=5) :: fmt
character :: upd='F' 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) integer :: i_err(5)
logical, parameter :: debug=.false. logical, parameter :: debug=.false.
character(len=20) :: name, ch_err 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 real(kind(1.d0)) :: t1,t2,t3,mpi_wtime
external mpi_wtime external mpi_wtime
integer idscb,idsce,iovrb,iovre, err, irank, icomm integer icomm
! .. Local Scalars .. ! .. Local Scalars ..
Integer :: k, tot_elem,proc,& Integer :: k, np,me,m,nnzero,&
& point,nprow,npcol, me, mycol, start,m,nnzero,& & ictxt, n_col,ier,n,int_err(5),&
& ictxt, lovr, n_col, linp,ier,n,int_err(5),& & tot_recv, ircode, n_row,nhalo, nrow_a,err_act
& tot_recv, ircode, n_row, nztot,nhalo, nrow_a,err_act
Logical,Parameter :: debug=.false., debugprt=.false. Logical,Parameter :: debug=.false., debugprt=.false.
character(len=20) :: name, ch_err character(len=20) :: name, ch_err
name='psb_zasmatbld' name='psb_zasmatbld'
@ -172,9 +171,9 @@ Subroutine psb_zasmatbld(ptype,novr,a,blk,desc_data,upd,desc_p,info,outfmt)
return return
endif 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 If(debug)Write(0,*)'BEGIN dasmatbld',me,upd,novr
t1 = mpi_wtime() t1 = mpi_wtime()
@ -198,9 +197,6 @@ Subroutine psb_zasmatbld(ptype,novr,a,blk,desc_data,upd,desc_p,info,outfmt)
t2 = mpi_wtime() t2 = mpi_wtime()
if (debug) write(0,*) 'Before sphalo ',blk%fida,blk%m,psb_nnz_,blk%infoa(psb_nnz_) 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 (present(outfmt)) then
if(debug) write(0,*) me,': Calling SPHALO with ',size(blk%ia2) 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 end if
if (debug) write(0,*) 'After psb_sphalo ',blk%fida,blk%m,psb_nnz_,blk%infoa(psb_nnz_) 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() t3 = mpi_wtime()
if (debugprt) then 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) integer :: n_row,n_col, int_err(5)
complex(kind(1.d0)), pointer :: ww(:), aux(:), tx(:),ty(:) complex(kind(1.d0)), pointer :: ww(:), aux(:), tx(:),ty(:)
character ::diagl, diagu 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 real(kind(1.d0)) :: t1, t2, t3, t4, t5, t6, t7, mpi_wtime
logical,parameter :: debug=.false., debugprt=.false. logical,parameter :: debug=.false., debugprt=.false.
external mpi_wtime 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 integer :: n_row,n_col
complex(kind(1.d0)), pointer :: ww(:), aux(:), tx(:),ty(:),tb(:) complex(kind(1.d0)), pointer :: ww(:), aux(:), tx(:),ty(:),tb(:)
character ::diagl, diagu 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 real(kind(1.d0)) :: t1, t2, t3, t4, t5, t6, t7, mpi_wtime
logical,parameter :: debug=.false., debugprt=.false. logical,parameter :: debug=.false., debugprt=.false.
external mpi_wtime external mpi_wtime

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

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

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

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

@ -96,7 +96,7 @@ subroutine psb_zmlprc_bld(a,desc_a,p,info)
end subroutine psb_zbldaggrmat end subroutine psb_zbldaggrmat
end interface end interface
integer :: ictxt, nprow, npcol, me, mycol integer :: ictxt, np, me
name='psb_mlprec_bld' name='psb_mlprec_bld'
if(psb_get_errstatus().ne.0) return 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 ! Local variables
character :: trans_ character :: trans_
complex(kind(1.d0)), pointer :: work_(:) 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. logical,parameter :: debug=.false., debugprt=.false.
external mpi_wtime external mpi_wtime
character(len=20) :: name, ch_err character(len=20) :: name
interface psb_baseprc_aply interface psb_baseprc_aply
subroutine psb_zbaseprc_aply(prec,x,beta,y,desc_data,trans,work,info) 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 ! Local variables
character :: trans_ 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(:) complex(kind(1.d0)), pointer :: WW(:), w1(:)
character(len=20) :: name, ch_err character(len=20) :: name, ch_err
name='psb_zprec1' name='psb_zprec1'

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

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

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

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

@ -59,10 +59,10 @@ function psb_dasum (x,desc_a, info, jx)
real(kind(1.d0)) :: psb_dasum real(kind(1.d0)) :: psb_dasum
! locals ! locals
integer :: int_err(5), ictxt, np, npcol, me, mycol,& integer :: ictxt, np, me, err_act, n, &
& err_act, n, iix, jjx, temp(2), ix, ijx, m, i & iix, jjx, ix, ijx, m, i
real(kind(1.d0)) :: asum, dasum real(kind(1.d0)) :: asum, dasum
character(len=20) :: name, ch_err character(len=20) :: name, ch_err
name='psb_dasum' name='psb_dasum'
if(psb_get_errstatus().ne.0) return if(psb_get_errstatus().ne.0) return
@ -202,8 +202,7 @@ function psb_dasumv (x,desc_a, info)
real(kind(1.d0)) :: psb_dasumv real(kind(1.d0)) :: psb_dasumv
! locals ! locals
integer :: int_err(5), ictxt, np, npcol, me, mycol,& integer :: ictxt, np, me, err_act, n, iix, jjx, jx, ix, ijx, m, i
& err_act, n, iix, jjx, temp(2), jx, ix, ijx, m, i
real(kind(1.d0)) :: asum, dasum real(kind(1.d0)) :: asum, dasum
character(len=20) :: name, ch_err character(len=20) :: name, ch_err
@ -341,8 +340,7 @@ subroutine psb_dasumvs (res,x,desc_a, info)
integer, intent(out) :: info integer, intent(out) :: info
! locals ! locals
integer :: int_err(5), ictxt, np, npcol, me, mycol,& integer :: ictxt, np, me, err_act, n, iix, jjx, ix, jx, ijx, m, i
& err_act, n, iix, jjx, temp(2), ix, jx, ijx, m, i
real(kind(1.d0)) :: asum, dasum real(kind(1.d0)) :: asum, dasum
character(len=20) :: name, ch_err 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(:,:) real(kind(1.D0)), intent(inout) :: y(:,:)
! locals ! locals
integer :: int_err(5), ictxt, np, npcol, me, mycol,& integer :: ictxt, np, me,&
& err_act, iix, jjx, temp(2), ix, iy, ijx, ijy, m, iiy, in, jjy & err_act, iix, jjx, ix, iy, ijx, ijy, m, iiy, in, jjy
real(kind(1.d0)),pointer :: tmpx(:) real(kind(1.d0)),pointer :: tmpx(:)
character(len=20) :: name, ch_err 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(:) real(kind(1.D0)), intent(inout) :: y(:)
! locals ! locals
integer :: int_err(5), ictxt, np, npcol, me, mycol,& integer :: ictxt, np, me,&
& err_act, n, iix, jjx, temp(2), ix, iy, ijx, m, iiy, in, jjy & err_act, n, iix, jjx, ix, iy, ijx, m, iiy, in, jjy
character(len=20) :: name, ch_err character(len=20) :: name, ch_err
logical, parameter :: debug=.false. logical, parameter :: debug=.false.

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

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

@ -54,7 +54,7 @@ function psb_dnrmi(a,desc_a,info)
real(kind(1.d0)) :: psb_dnrmi real(kind(1.d0)) :: psb_dnrmi
! locals ! locals
integer :: int_err(5), ictxt, np, npcol, me, mycol,& integer :: ictxt, np, me,&
& err_act, n, iia, jja, ia, ja, mdim, ndim, m & err_act, n, iia, jja, ia, ja, mdim, ndim, m
real(kind(1.d0)) :: nrmi, dcsnmi real(kind(1.d0)) :: nrmi, dcsnmi
character(len=20) :: name, ch_err 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 integer, intent(in), optional :: k, jx, jy,doswap
! locals ! locals
integer :: int_err(5), ictxt, np, npcol, me, mycol,& integer :: ictxt, np, me,&
& err_act, n, iix, jjx, ia, ja, iia, jja, temp(2), ix, iy, ik, ijx, ijy,& & err_act, n, iix, jjx, ia, ja, iia, jja, ix, iy, ik, ijx, ijy,&
& idoswap, m, nrow, ncol, lldx, lldy, liwork, llwork, iiy, jjy,& & idoswap, m, nrow, ncol, lldx, lldy, liwork, llwork, iiy, jjy,&
& i, ib, ib1 & i, ib, ib1
integer, parameter :: nb=4 integer, parameter :: nb=4
real(kind(1.d0)),pointer :: tmpx(:), xp(:,:), yp(:,:), iwork(:) real(kind(1.d0)),pointer :: xp(:,:), yp(:,:), iwork(:)
character :: itrans character :: itrans
character(len=20) :: name, ch_err character(len=20) :: name, ch_err
logical :: aliw logical :: aliw
@ -437,8 +437,8 @@ subroutine psb_dspmv(alpha,a,x,beta,y,desc_a,info,&
integer, intent(in), optional :: doswap integer, intent(in), optional :: doswap
! locals ! locals
integer :: int_err(5), ictxt, np, npcol, me, mycol,& integer :: ictxt, np, me,&
& err_act, n, iix, jjx, ia, ja, iia, jja, temp(2), ix, iy, ik, ijx, ijy,& & 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,& & idoswap, m, nrow, ncol, lldx, lldy, liwork, llwork, jx, jy, iiy, jjy,&
& i, ib, ib1 & i, ib, ib1
integer, parameter :: nb=4 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 integer, intent(in), optional :: k, jx, jy
! locals ! locals
integer :: int_err(5), ictxt, np, npcol, me, mycol,& integer :: int_err(5), ictxt, np, me,&
& err_act, n, iix, jjx, ia, ja, iia, jja, temp(2), lldx,lldy, lchoice,& & err_act, n, iix, jjx, ia, ja, iia, jja, lldx,lldy, lchoice,&
& ix, iy, ik, ijx, ijy, i, lld,& & ix, iy, ik, ijx, ijy, i, lld,&
& idoswap, m, nrow, ncol, liwork, llwork, iiy, jjy & m, nrow, ncol, liwork, llwork, iiy, jjy
character :: lunitd character :: lunitd
integer, parameter :: nb=4 integer, parameter :: nb=4
@ -400,10 +400,10 @@ subroutine psb_dspsv(alpha,a,x,beta,y,desc_a,info,&
integer, intent(in), optional :: choice integer, intent(in), optional :: choice
! locals ! locals
integer :: int_err(5), ictxt, np, npcol, me, mycol,& integer :: int_err(5), ictxt, np, me,&
& err_act, n, iix, jjx, ia, ja, iia, jja, temp(2), lldx,lldy, lchoice,& & err_act, n, iix, jjx, ia, ja, iia, jja, lldx,lldy, lchoice,&
& ix, iy, ik, jx, jy, i, lld,& & ix, iy, ik, jx, jy, i, lld,&
& idoswap, m, nrow, ncol, liwork, llwork, iiy, jjy & m, nrow, ncol, liwork, llwork, iiy, jjy
character :: lunitd character :: lunitd
integer, parameter :: nb=4 integer, parameter :: nb=4

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

@ -207,8 +207,8 @@ function psb_zasumv (x,desc_a, info)
real(kind(1.d0)) :: psb_zasumv real(kind(1.d0)) :: psb_zasumv
! locals ! locals
integer :: int_err(5), ictxt, np, npcol, me, mycol,& integer :: ictxt, np, me,&
& err_act, n, iix, jjx, temp(2), jx, ix, ijx, m, i & err_act, n, iix, jjx, jx, ix, ijx, m, i
real(kind(1.d0)) :: asum, dzasum real(kind(1.d0)) :: asum, dzasum
character(len=20) :: name, ch_err character(len=20) :: name, ch_err
complex(kind(1.d0)) :: cmax complex(kind(1.d0)) :: cmax
@ -351,8 +351,8 @@ subroutine psb_zasumvs (res,x,desc_a, info)
integer, intent(out) :: info integer, intent(out) :: info
! locals ! locals
integer :: int_err(5), ictxt, np, npcol, me, mycol,& integer :: ictxt, np, me,&
& err_act, n, iix, jjx, temp(2), ix, jx, ijx, m, i & err_act, n, iix, jjx, ix, jx, ijx, m, i
real(kind(1.d0)) :: asum, dzasum real(kind(1.d0)) :: asum, dzasum
character(len=20) :: name, ch_err character(len=20) :: name, ch_err
complex(kind(1.d0)) :: cmax complex(kind(1.d0)) :: cmax
@ -438,6 +438,3 @@ subroutine psb_zasumvs (res,x,desc_a, info)
end if end if
return return
end subroutine psb_zasumvs 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(:,:) complex(kind(1.D0)), intent(inout) :: y(:,:)
! locals ! locals
integer :: int_err(5), ictxt, np, npcol, me, mycol,& integer :: ictxt, np, me,&
& err_act, iix, jjx, temp(2), ix, iy, ijx, ijy, m, iiy, in, jjy & err_act, iix, jjx, ix, iy, ijx, ijy, m, iiy, in, jjy
character(len=20) :: name, ch_err character(len=20) :: name, ch_err
name='psb_dgeaxpby' name='psb_dgeaxpby'
@ -216,8 +216,8 @@ subroutine psb_zaxpbyv(alpha, x, beta,y,desc_a,info)
complex(kind(1.D0)), intent(inout) :: y(:) complex(kind(1.D0)), intent(inout) :: y(:)
! locals ! locals
integer :: int_err(5), ictxt, np, npcol, me, mycol,& integer :: ictxt, np, me,&
& err_act, n, iix, jjx, temp(2), ix, iy, ijx, m, iiy, in, jjy & err_act, n, iix, jjx, ix, iy, ijx, m, iiy, in, jjy
character(len=20) :: name, ch_err character(len=20) :: name, ch_err
logical, parameter :: debug=.false. logical, parameter :: debug=.false.

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

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

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

@ -98,10 +98,10 @@ subroutine psb_zspsm(alpha,a,x,beta,y,desc_a,info,&
integer, intent(in), optional :: k, jx, jy integer, intent(in), optional :: k, jx, jy
! locals ! locals
integer :: int_err(5), ictxt, np, npcol, me, mycol,& integer :: ictxt, np, me,&
& err_act, n, iix, jjx, ia, ja, iia, jja, temp(2), lldx,lldy, lchoice,& & err_act, n, iix, jjx, ia, ja, iia, jja, lldx,lldy, lchoice,&
& ix, iy, ik, ijx, ijy, i, lld,& & ix, iy, ik, ijx, ijy, i, lld, int_err(5),&
& idoswap, m, nrow, ncol, liwork, llwork, iiy, jjy & m, nrow, ncol, liwork, llwork, iiy, jjy
character :: lunitd character :: lunitd
integer, parameter :: nb=4 integer, parameter :: nb=4
@ -404,10 +404,10 @@ subroutine psb_zspsv(alpha,a,x,beta,y,desc_a,info,&
integer, intent(in), optional :: choice integer, intent(in), optional :: choice
! locals ! locals
integer :: int_err(5), ictxt, np, npcol, me, mycol,& integer :: ictxt, np, me, &
& err_act, n, iix, jjx, ia, ja, iia, jja, temp(2), lldx,lldy, lchoice,& & err_act, n, iix, jjx, ia, ja, iia, jja, lldx,lldy, lchoice,&
& ix, iy, ik, jx, jy, i, lld,& & ix, iy, ik, jx, jy, i, lld, int_err(5),&
& idoswap, m, nrow, ncol, liwork, llwork, iiy, jjy & m, nrow, ncol, liwork, llwork, iiy, jjy
character :: lunitd character :: lunitd
integer, parameter :: nb=4 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)) :: d(1)
real(kind(1.d0)), allocatable :: work(:) real(kind(1.d0)), allocatable :: work(:)
type(psb_dspmat_type) :: temp_a 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_ & ia2_size, aspk_size,size_req,n_row,n_col,upd_,dupl_
integer :: ip1, ip2, nnz, iflag, ichk, nnzt,& integer :: ip1, ip2, nnz, iflag, ichk, nnzt,&
& ipc, i, count, err_act, ierrv(5), i1, i2, ia & ipc, i, count, err_act, i1, i2, ia
character :: check_,trans_,unitd_, up character :: check_,trans_,unitd_
Integer, Parameter :: maxtry=8 Integer, Parameter :: maxtry=8
logical, parameter :: debug=.false. logical, parameter :: debug=.false.
character(len=20) :: name, ch_err 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(:) real(kind(1.d0)), allocatable :: work(:)
character :: trans_ character :: trans_
integer :: iwsz,m,n,k,lb,lc, err_act integer :: iwsz,m,n,k,lb,lc, err_act
character(len=20) :: name, ch_err character(len=20) :: name
name='psb_dcsmv' name='psb_dcsmv'
info = 0 info = 0

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

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

@ -48,10 +48,10 @@ subroutine psb_dipcoo2csc(a,info,clshr)
integer, pointer :: iaux(:), itemp(:) integer, pointer :: iaux(:), itemp(:)
!locals !locals
logical :: clshr_ 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 Integer, Parameter :: maxtry=8
logical, parameter :: debug=.false. logical, parameter :: debug=.false.
character(len=20) :: name, ch_err character(len=20) :: name
name='psb_ipcoo2csc' name='psb_ipcoo2csc'
info = 0 info = 0

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

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

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

@ -150,6 +150,7 @@ contains
nr = lrw - irw + 1 nr = lrw - irw + 1
allocate(indices(nr)) allocate(indices(nr))
nz = 0
do i=1,nr do i=1,nr
indices(i)=a%pl(irw+i-1) indices(i)=a%pl(irw+i-1)
nz=nz+a%ia2(indices(i)+1)-a%ia2(indices(i)) 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 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 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 if (append) then
nzb = b%infoa(psb_nnz_) nzb = b%infoa(psb_nnz_)
else else

@ -175,7 +175,7 @@ contains
integer, intent(in), optional :: ng,gtl(*) integer, intent(in), optional :: ng,gtl(*)
logical, parameter :: debug=.false. 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 & i1,i2,nc,lb,ub,m,nnz,dupl
info = 0 info = 0
@ -396,7 +396,7 @@ contains
real(kind(1.d0)), intent(in) :: val(*) real(kind(1.d0)), intent(in) :: val(*)
integer, intent(out) :: info integer, intent(out) :: info
integer, intent(in), optional :: ng,gtl(*) 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 & i1,i2,nc,lb,ub,m,nnz,dupl,isrt
logical, parameter :: debug=.false. logical, parameter :: debug=.false.
@ -596,7 +596,7 @@ contains
integer, intent(out) :: info integer, intent(out) :: info
integer, intent(in), optional :: ng,gtl(*) 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 & i1,i2,nc,lb,ub,m,nnz,dupl
logical, parameter :: debug=.false. logical, parameter :: debug=.false.
@ -810,7 +810,7 @@ contains
complex(kind(1.d0)), intent(in) :: val(*) complex(kind(1.d0)), intent(in) :: val(*)
integer, intent(out) :: info integer, intent(out) :: info
integer, intent(in), optional :: ng,gtl(*) 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 & i1,i2,nc,lb,ub,m,nnz,dupl,isrt
logical, parameter :: debug=.false. 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)) :: d(1)
complex(kind(1.d0)), allocatable :: work(:) complex(kind(1.d0)), allocatable :: work(:)
type(psb_zspmat_type) :: temp_a 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_ & ia2_size, aspk_size,size_req,n_row,n_col,upd_,dupl_
integer :: ip1, ip2, nnz, iflag, ichk, nnzt,& integer :: ip1, ip2, nnz, iflag, ichk, nnzt,&
& ipc, i, count, err_act, ierrv(5), i1, i2, ia & ipc, i, count, err_act, i1, i2, ia
character :: check_,trans_,unitd_, up character :: check_,trans_,unitd_
Integer, Parameter :: maxtry=8 Integer, Parameter :: maxtry=8
logical, parameter :: debug=.false. logical, parameter :: debug=.false.
character(len=20) :: name, ch_err 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(:) complex(kind(1.d0)), allocatable :: work(:)
character :: trans_ character :: trans_
integer :: iwsz,m,n,k,lb,lc,err_act integer :: iwsz,m,n,k,lb,lc,err_act
character(len=20) :: name, ch_err character(len=20) :: name
name='psb_zcsmm' name='psb_zcsmm'
info = 0 info = 0

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

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

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

@ -48,10 +48,10 @@ subroutine psb_zipcoo2csc(a,info,clshr)
integer, pointer :: iaux(:), itemp(:) integer, pointer :: iaux(:), itemp(:)
!locals !locals
logical :: clshr_ 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 Integer, Parameter :: maxtry=8
logical, parameter :: debug=.false. logical, parameter :: debug=.false.
character(len=20) :: name, ch_err character(len=20) :: name
name='psb_ipcoo2csc' name='psb_ipcoo2csc'
info = 0 info = 0

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

@ -150,6 +150,7 @@ contains
nr = lrw - irw + 1 nr = lrw - irw + 1
allocate(indices(nr)) allocate(indices(nr))
nz = 0
do i=1,nr do i=1,nr
indices(i)=a%pl(irw+i-1) indices(i)=a%pl(irw+i-1)
nz=nz+a%ia2(indices(i)+1)-a%ia2(indices(i)) 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 integer, intent(out) :: info
!locals !locals
Integer :: counter,i,j,np,npcol,me,mycol,& Integer :: counter,i,j,np,me,loc_row,err,loc_col,nprocs,&
& loc_row,err,loc_col,nprocs,&
& l_ov_ix,l_ov_el,idx, err_act, itmpov, k & l_ov_ix,l_ov_el,idx, err_act, itmpov, k
Integer :: INT_ERR(5),TEMP(1),EXCH(2) integer :: int_err(5),exch(2)
Real(Kind(1.d0)) :: REAL_ERR(5) integer, pointer :: prc_v(:), temp_ovrlap(:), ov_idx(:),ov_el(:)
Integer, Pointer :: PRC_V(:), TEMP_OVRLAP(:), OV_IDX(:),OV_EL(:)
logical, parameter :: debug=.false. logical, parameter :: debug=.false.
character(len=20) :: name, char_err 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 type(psb_desc_type), intent(out) :: desc_a
!locals !locals
Integer :: counter,i,j,np,npcol,me,mycol,& Integer :: counter,i,j,np,me,loc_row,err,&
& loc_row,err,loc_col,nprocs,n,itmpov, k,& & loc_col,nprocs,n,itmpov, k,&
& l_ov_ix,l_ov_el,idx, flag_, err_act & l_ov_ix,l_ov_el,idx, flag_, err_act
Integer :: INT_ERR(5),TEMP(1),EXCH(2) integer :: int_err(5),exch(2)
Real(Kind(1.d0)) :: REAL_ERR(5)
Integer, Pointer :: temp_ovrlap(:), ov_idx(:),ov_el(:) Integer, Pointer :: temp_ovrlap(:), ov_idx(:),ov_el(:)
logical, parameter :: debug=.false. logical, parameter :: debug=.false.
character(len=20) :: name, ch_err character(len=20) :: name
if(psb_get_errstatus() /= 0) return if(psb_get_errstatus() /= 0) return
info=0 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) allocate(ov_idx(l_ov_ix),ov_el(l_ov_el), stat=info)
if (info /= 0) then if (info /= 0) then
info=2025 info=2025
int_err(1)=loc_col int_err(1)=l_ov_ix
call psb_errpush(info,name,i_err=int_err) call psb_errpush(info,name,i_err=int_err)
goto 9999 goto 9999
end if end if

@ -54,10 +54,7 @@ subroutine psb_cdcpy(desc_in, desc_out, info)
integer, intent(out) :: info integer, intent(out) :: info
!locals !locals
integer :: np,me,& integer :: np,me,ictxt, isz, err_act
& ictxt, isz, dectype, err_act, err
integer :: int_err(5),temp(1)
real(kind(1.d0)) :: real_err(5)
logical, parameter :: debug=.false.,debugprt=.false. logical, parameter :: debug=.false.,debugprt=.false.
character(len=20) :: name, char_err character(len=20) :: name, char_err
if (debug) write(0,*) me,'Entered CDCPY' 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 Type(psb_desc_type), intent(out) :: desc_a
!locals !locals
Integer :: counter,i,j,np,npcol,me,mypcol,& Integer :: i,j,np,me,err,n,itmpov, k,&
& loc_row,err,loc_col,nprocs,n,itmpov, k,& & l_ov_ix,l_ov_el,idx, err_act,m, ip
& l_ov_ix,l_ov_el,idx, flag_, err_act,m, ip Integer :: INT_ERR(5)
Integer :: INT_ERR(5),TEMP(1),EXCH(2)
Real(Kind(1.d0)) :: REAL_ERR(5)
Integer, Pointer :: temp_ovrlap(:), ov_idx(:), ov_el(:)
integer, allocatable :: nlv(:) integer, allocatable :: nlv(:)
logical, parameter :: debug=.false. logical, parameter :: debug=.false.
character(len=20) :: name, ch_err character(len=20) :: name
if(psb_get_errstatus() /= 0) return if(psb_get_errstatus() /= 0) return
info=0 info=0

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

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

Loading…
Cancel
Save