mirror of
https://github.com/sfilippone/psblas3.git
synced 2026-10-16 02:49:03 +00:00
Giant patch: cleanup after -Wunused -Wuninitialized.
This commit is contained in:
@@ -63,9 +63,8 @@ subroutine psb_dgatherm(globx, locx, desc_a, info, iroot,&
|
||||
|
||||
! locals
|
||||
integer :: int_err(5), ictxt, np, me,&
|
||||
& err_act, n, iix, jjx, root, iiroot, ilocx, iglobx, jlocx,&
|
||||
& err_act, n, root, iiroot, ilocx, iglobx, jlocx,&
|
||||
& jglobx, lda_locx, lda_globx, m, lock, globk, maxk, k, jlx, ilx, i, j, idx
|
||||
real(kind(1.d0)),pointer :: tmpx(:)
|
||||
character(len=20) :: name, ch_err
|
||||
|
||||
name='psb_dgatherm'
|
||||
@@ -258,10 +257,10 @@ subroutine psb_dgatherv(globx, locx, desc_a, info, iroot,&
|
||||
|
||||
|
||||
! locals
|
||||
integer :: int_err(5), ictxt, np, me, mycol,&
|
||||
& err_act, n, iix, jjx, root, iiroot, ilocx, iglobx, jlocx,&
|
||||
& jglobx, lda_locx, lda_globx, lock, maxk, globk, m, k, jlx, ilx, i, j, idx
|
||||
real(kind(1.d0)),pointer :: tmpx(:)
|
||||
integer :: int_err(5), ictxt, np, me, &
|
||||
& err_act, n, root, iiroot, ilocx, iglobx, jlocx,&
|
||||
& jglobx, lda_locx, lda_globx, m, k, jlx, ilx, i, idx
|
||||
|
||||
character(len=20) :: name, ch_err
|
||||
|
||||
name='psb_dgatherv'
|
||||
|
||||
@@ -63,9 +63,9 @@ subroutine psb_dhalom(x,desc_a,info,alpha,jx,ik,work,tran,mode)
|
||||
character, intent(in), optional :: tran
|
||||
|
||||
! locals
|
||||
integer :: int_err(5), ictxt, np, me,&
|
||||
integer :: ictxt, np, me,&
|
||||
& err_act, m, n, iix, jjx, ix, ijx, k, maxk, nrow, imode, i,&
|
||||
& err, liwork, ncol
|
||||
& err, liwork
|
||||
real(kind(1.d0)),pointer :: iwork(:), xp(:,:)
|
||||
character :: ltran
|
||||
character(len=20) :: name, ch_err
|
||||
@@ -270,9 +270,9 @@ subroutine psb_dhalov(x,desc_a,info,alpha,work,tran,mode)
|
||||
character, intent(in), optional :: tran
|
||||
|
||||
! locals
|
||||
integer :: int_err(5), ictxt, np, me,&
|
||||
& err_act, m, n, iix, jjx, ix, ijx, k, maxk, nrow, imode, i,&
|
||||
& err, liwork, ncol
|
||||
integer :: ictxt, np, me,&
|
||||
& err_act, m, n, iix, jjx, ix, ijx, nrow, imode, i,&
|
||||
& err, liwork
|
||||
real(kind(1.d0)),pointer :: iwork(:)
|
||||
character :: ltran
|
||||
character(len=20) :: name, ch_err
|
||||
|
||||
@@ -59,8 +59,8 @@ subroutine psb_dovrlm(x,desc_a,info,jx,ik,work,update)
|
||||
integer, intent(in), optional :: update,jx,ik
|
||||
|
||||
! locals
|
||||
integer :: int_err(5), ictxt, np, me, mycol,&
|
||||
& err_act, m, n, iix, jjx, temp(2), ix, ijx, nrow, ncol, k, maxk, iupdate,&
|
||||
integer :: int_err(5), ictxt, np, me, &
|
||||
& err_act, m, n, iix, jjx, ix, ijx, nrow, ncol, k, maxk, iupdate,&
|
||||
& imode, err, liwork, i
|
||||
real(kind(1.d0)),pointer :: iwork(:), xp(:,:)
|
||||
logical :: do_update
|
||||
@@ -272,8 +272,8 @@ subroutine psb_dovrlv(x,desc_a,info,work,update)
|
||||
integer, intent(in), optional :: update
|
||||
|
||||
! locals
|
||||
integer :: int_err(5), ictxt, np, me, mycol,&
|
||||
& err_act, m, n, iix, jjx, temp(2), ix, ijx, nrow, ncol, k, maxk, iupdate,&
|
||||
integer :: int_err(5), ictxt, np, me, &
|
||||
& err_act, m, n, iix, jjx, ix, ijx, nrow, ncol, k, iupdate,&
|
||||
& imode, err, liwork, i
|
||||
real(kind(1.d0)),pointer :: iwork(:)
|
||||
logical :: do_update
|
||||
|
||||
@@ -67,7 +67,7 @@ subroutine psb_dscatterm(globx, locx, desc_a, info, iroot,&
|
||||
|
||||
! locals
|
||||
integer :: int_err(5), ictxt, np, me,&
|
||||
& err_act, m, n, iix, jjx, temp(2), i, j, idx, nrow, iiroot, iglobx, jglobx,&
|
||||
& err_act, m, n, i, j, idx, nrow, iiroot, iglobx, jglobx,&
|
||||
& ilocx, jlocx, lda_locx, lda_globx, lock, globk, icomm, k, maxk, root, ilx,&
|
||||
& jlx, myrank, rootrank, c, pos
|
||||
real(kind(1.d0)),pointer :: scatterv(:)
|
||||
@@ -312,6 +312,7 @@ subroutine psb_dscatterv(globx, locx, desc_a, info, iroot)
|
||||
use psb_check_mod
|
||||
use psb_error_mod
|
||||
use mpi
|
||||
use psb_penv_mod
|
||||
implicit none
|
||||
|
||||
real(kind(1.d0)), intent(out) :: locx(:)
|
||||
@@ -322,10 +323,10 @@ subroutine psb_dscatterv(globx, locx, desc_a, info, iroot)
|
||||
|
||||
|
||||
! locals
|
||||
integer :: int_err(5), ictxt, np, me, mycol,&
|
||||
& err_act, m, n, iix, jjx, temp(2), i, j, idx, nrow, iiroot, iglobx, jglobx,&
|
||||
& ilocx, jlocx, lda_locx, lda_globx, lock, globk, root, k, maxk, icomm, myrank,&
|
||||
& rootrank, c, pos, ilx, jlx
|
||||
integer :: int_err(5), ictxt, np, me, &
|
||||
& err_act, m, n, i, j, idx, nrow, iiroot, iglobx, jglobx,&
|
||||
& ilocx, jlocx, lda_locx, lda_globx, root, k, icomm, myrank,&
|
||||
& rootrank, pos, ilx, jlx
|
||||
real(kind(1.d0)),pointer :: scatterv(:)
|
||||
integer, pointer :: displ(:), l_t_g_all(:), all_dim(:)
|
||||
character(len=20) :: name, ch_err
|
||||
|
||||
@@ -64,8 +64,8 @@ subroutine psb_ihalom(x,desc_a,info,alpha,jx,ik,work,tran,mode)
|
||||
character, intent(in), optional :: tran
|
||||
|
||||
! locals
|
||||
integer :: int_err(5), ictxt, np, me, mycol,&
|
||||
& err_act, m, n, iix, jjx, temp(2), ix, ijx, nrow, ncol, k, maxk, liwork,&
|
||||
integer :: ictxt, np, me, &
|
||||
& err_act, m, n, iix, jjx, ix, ijx, nrow, k, maxk, liwork,&
|
||||
& imode, err
|
||||
integer, pointer :: xp(:,:), iwork(:)
|
||||
character :: ltran
|
||||
@@ -266,8 +266,8 @@ subroutine psb_ihalov(x,desc_a,info,alpha,work,tran,mode)
|
||||
character, intent(in), optional :: tran
|
||||
|
||||
! locals
|
||||
integer :: int_err(5), ictxt, np, me,&
|
||||
& err_act, m, n, iix, jjx, temp(2), ix, ijx, nrow, ncol, k, maxk, imode,&
|
||||
integer :: ictxt, np, me,&
|
||||
& err_act, m, n, iix, jjx, ix, ijx, nrow, imode,&
|
||||
& err, liwork
|
||||
integer,pointer :: iwork(:)
|
||||
character :: ltran
|
||||
|
||||
@@ -62,10 +62,10 @@ subroutine psb_zgatherm(globx, locx, desc_a, info, iroot,&
|
||||
|
||||
|
||||
! locals
|
||||
integer :: int_err(5), ictxt, np, me, mycol,&
|
||||
& err_act, n, iix, jjx, temp(2), root, iiroot, ilocx, iglobx, jlocx,&
|
||||
integer :: int_err(5), ictxt, np, me, &
|
||||
& err_act, n, root, iiroot, ilocx, iglobx, jlocx,&
|
||||
& jglobx, lda_locx, lda_globx, m, lock, globk, maxk, k, jlx, ilx, i, j, idx
|
||||
complex(kind(1.d0)),pointer :: tmpx(:)
|
||||
|
||||
character(len=20) :: name, ch_err
|
||||
|
||||
name='psb_zgatherm'
|
||||
@@ -258,10 +258,10 @@ subroutine psb_zgatherv(globx, locx, desc_a, info, iroot,&
|
||||
|
||||
|
||||
! locals
|
||||
integer :: int_err(5), ictxt, np, me, mycol,&
|
||||
& err_act, n, iix, jjx, temp(2), root, iiroot, ilocx, iglobx, jlocx,&
|
||||
& jglobx, lda_locx, lda_globx, lock, maxk, globk, m, k, jlx, ilx, i, j, idx
|
||||
complex(kind(1.d0)),pointer :: tmpx(:)
|
||||
integer :: int_err(5), ictxt, np, me, &
|
||||
& err_act, n, root, ilocx, iglobx, jlocx,&
|
||||
& jglobx, lda_locx, lda_globx, m, k, jlx, ilx, i, idx
|
||||
|
||||
character(len=20) :: name, ch_err
|
||||
|
||||
name='psb_zgatherv'
|
||||
|
||||
@@ -63,9 +63,9 @@ subroutine psb_zhalom(x,desc_a,info,alpha,jx,ik,work,tran,mode)
|
||||
character, intent(in), optional :: tran
|
||||
|
||||
! locals
|
||||
integer :: int_err(5), ictxt, np, me, mycol,&
|
||||
& err_act, m, n, iix, jjx, temp(2), ix, ijx, k, maxk, nrow, imode, i,&
|
||||
& err, liwork, ncol
|
||||
integer :: ictxt, np, me, &
|
||||
& err_act, m, n, iix, jjx, ix, ijx, k, maxk, nrow, imode, i,&
|
||||
& err, liwork
|
||||
complex(kind(1.d0)),pointer :: iwork(:), xp(:,:)
|
||||
character :: ltran
|
||||
character(len=20) :: name, ch_err
|
||||
@@ -264,9 +264,8 @@ subroutine psb_zhalov(x,desc_a,info,alpha,work,tran,mode)
|
||||
character, intent(in), optional :: tran
|
||||
|
||||
! locals
|
||||
integer :: int_err(5), ictxt, np, me, mycol,&
|
||||
& err_act, m, n, iix, jjx, temp(2), ix, ijx, k, maxk, nrow, imode, i,&
|
||||
& err, liwork, ncol
|
||||
integer :: ictxt, np, me, err_act, &
|
||||
& m, n, iix, jjx, ix, ijx, nrow, imode, err, liwork
|
||||
complex(kind(1.d0)),pointer :: iwork(:)
|
||||
character :: ltran
|
||||
character(len=20) :: name, ch_err
|
||||
|
||||
@@ -59,8 +59,8 @@ subroutine psb_zovrlm(x,desc_a,info,jx,ik,work,update)
|
||||
integer, intent(in), optional :: update,jx,ik
|
||||
|
||||
! locals
|
||||
integer :: int_err(5), ictxt, np, me, mycol,&
|
||||
& err_act, m, n, iix, jjx, temp(2), ix, ijx, nrow, ncol, k, maxk, iupdate,&
|
||||
integer :: int_err(5), ictxt, np, me, &
|
||||
& err_act, m, n, iix, jjx, ix, ijx, nrow, ncol, k, maxk, iupdate,&
|
||||
& imode, err, liwork, i
|
||||
complex(kind(1.d0)),pointer :: iwork(:), xp(:,:)
|
||||
logical :: do_update
|
||||
@@ -272,8 +272,8 @@ subroutine psb_zovrlv(x,desc_a,info,work,update)
|
||||
integer, intent(in), optional :: update
|
||||
|
||||
! locals
|
||||
integer :: int_err(5), ictxt, np, me, mycol,&
|
||||
& err_act, m, n, iix, jjx, temp(2), ix, ijx, nrow, ncol, k, maxk, iupdate,&
|
||||
integer :: int_err(5), ictxt, np, me, &
|
||||
& err_act, m, n, iix, jjx, ix, ijx, nrow, ncol, k, iupdate,&
|
||||
& imode, err, liwork, i
|
||||
complex(kind(1.d0)),pointer :: iwork(:)
|
||||
logical :: do_update
|
||||
|
||||
@@ -66,8 +66,8 @@ subroutine psb_zscatterm(globx, locx, desc_a, info, iroot,&
|
||||
|
||||
|
||||
! locals
|
||||
integer :: int_err(5), ictxt, np, me, mycol,&
|
||||
& err_act, m, n, iix, jjx, temp(2), i, j, idx, nrow, iiroot, iglobx, jglobx,&
|
||||
integer :: int_err(5), ictxt, np, me, &
|
||||
& err_act, m, n, i, j, idx, nrow, iiroot, iglobx, jglobx,&
|
||||
& ilocx, jlocx, lda_locx, lda_globx, lock, globk, icomm, k, maxk, root, ilx,&
|
||||
& jlx, myrank, rootrank, c, pos
|
||||
complex(kind(1.d0)),pointer :: scatterv(:)
|
||||
@@ -311,6 +311,7 @@ subroutine psb_zscatterv(globx, locx, desc_a, info, iroot)
|
||||
use psb_check_mod
|
||||
use psb_error_mod
|
||||
use mpi
|
||||
use psb_penv_mod
|
||||
implicit none
|
||||
|
||||
complex(kind(1.d0)), intent(out) :: locx(:)
|
||||
@@ -321,9 +322,9 @@ subroutine psb_zscatterv(globx, locx, desc_a, info, iroot)
|
||||
|
||||
|
||||
! locals
|
||||
integer :: int_err(5), ictxt, np, me, mycol,&
|
||||
& err_act, m, n, iix, jjx, temp(2), i, j, idx, nrow, iiroot, iglobx, jglobx,&
|
||||
& ilocx, jlocx, lda_locx, lda_globx, lock, globk, root, k, maxk, icomm, myrank,&
|
||||
integer :: int_err(5), ictxt, np, me, &
|
||||
& err_act, m, n, i, j, idx, nrow, iiroot, iglobx, jglobx,&
|
||||
& ilocx, jlocx, lda_locx, lda_globx, root, k, icomm, myrank,&
|
||||
& rootrank, c, pos, ilx, jlx
|
||||
complex(kind(1.d0)),pointer :: scatterv(:)
|
||||
integer, pointer :: displ(:), l_t_g_all(:), all_dim(:)
|
||||
|
||||
@@ -41,9 +41,8 @@ subroutine psi_compute_size(desc_data, index_in, dl_lda, info)
|
||||
integer :: desc_data(:), index_in(:)
|
||||
! ....local scalars....
|
||||
integer :: i,np,me,proc, max_index
|
||||
integer :: ictxt, err, err_act
|
||||
integer :: ictxt, err_act
|
||||
! ...local array...
|
||||
integer :: exch(2)
|
||||
integer :: int_err(5)
|
||||
integer, allocatable :: counter_recv(:), counter_dl(:)
|
||||
|
||||
@@ -118,7 +117,7 @@ subroutine psi_compute_size(desc_data, index_in, dl_lda, info)
|
||||
|
||||
9999 continue
|
||||
call psb_erractionrestore(err_act)
|
||||
if (err_act.eq.act_abort) then
|
||||
if (err_act == act_abort) then
|
||||
call psb_error(ictxt)
|
||||
return
|
||||
end if
|
||||
|
||||
@@ -39,7 +39,7 @@ subroutine psi_crea_bnd_elem(desc_a,info)
|
||||
|
||||
integer, pointer :: work(:)
|
||||
integer :: i, j, nr, ns, k, irv, err_act
|
||||
character(len=20) :: name, ch_err
|
||||
character(len=20) :: name
|
||||
|
||||
info = 0
|
||||
name='psi_crea_bnd_elem'
|
||||
|
||||
@@ -43,14 +43,12 @@ subroutine psi_crea_index(desc_a,index_in,index_out,glob_idx,info)
|
||||
logical :: glob_idx
|
||||
|
||||
! ....local scalars...
|
||||
integer :: me,np,i,j,k,&
|
||||
& mode, int_err(5), err, err_act,&
|
||||
& dl_lda, ictxt, proc, nerv, nesd
|
||||
integer :: ictxt, me, np, mode, err_act, dl_lda
|
||||
! ...parameters...
|
||||
integer, pointer :: dep_list(:,:), length_dl(:)
|
||||
integer,parameter :: root=0,no_comm=-1
|
||||
logical,parameter :: debug=.false.
|
||||
character(len=20) :: name, ch_err
|
||||
character(len=20) :: name
|
||||
|
||||
interface
|
||||
subroutine psi_compute_size(desc_data,&
|
||||
@@ -131,7 +129,7 @@ subroutine psi_crea_index(desc_a,index_in,index_out,glob_idx,info)
|
||||
|
||||
! ....now i can sort dependence list......
|
||||
call psi_sort_dl(dep_list,length_dl,np,info)
|
||||
if(info.ne.0) then
|
||||
if(info /= 0) then
|
||||
call psb_errpush(4010,name,a_err='psi_sort_dl')
|
||||
goto 9999
|
||||
end if
|
||||
@@ -143,7 +141,7 @@ subroutine psi_crea_index(desc_a,index_in,index_out,glob_idx,info)
|
||||
& length_dl(me),desc_a%loc_to_glob,desc_a%glob_to_loc,&
|
||||
& index_out,glob_idx,info)
|
||||
|
||||
if(info.ne.0) then
|
||||
if(info /= 0) then
|
||||
call psb_errpush(4010,name,a_err='psi_desc_index')
|
||||
goto 9999
|
||||
end if
|
||||
@@ -154,7 +152,7 @@ subroutine psi_crea_index(desc_a,index_in,index_out,glob_idx,info)
|
||||
|
||||
9999 continue
|
||||
call psb_erractionrestore(err_act)
|
||||
if (err_act.eq.act_abort) then
|
||||
if (err_act == act_abort) then
|
||||
call psb_error(ictxt)
|
||||
return
|
||||
end if
|
||||
|
||||
@@ -46,21 +46,20 @@ subroutine psi_desc_index(desc_data,index_in,dep_list,&
|
||||
integer :: length_dl, info
|
||||
logical :: isglob_in
|
||||
!c ....local scalars...
|
||||
integer :: j,me,np,i,proc,dim
|
||||
integer :: j,me,np,i,proc
|
||||
!c ...parameters...
|
||||
integer :: ictxt
|
||||
integer :: no_comm,err
|
||||
parameter (no_comm=-1)
|
||||
!c ...local arrays..
|
||||
integer :: int_err(5)
|
||||
integer,pointer :: brvindx(:),rvsz(:),&
|
||||
& bsdindx(:),sdsz(:), sndbuf(:), rcvbuf(:)
|
||||
|
||||
integer :: ihinsz,ntot,k,err_act,&
|
||||
& idxr, idxs, iszs, iszr, nesd, nerv, icomm, iret
|
||||
& idxr, idxs, iszs, iszr, nesd, nerv, icomm
|
||||
|
||||
logical,parameter :: debug=.false., usempi=.true.
|
||||
character(len=20) :: name, ch_err
|
||||
character(len=20) :: name
|
||||
|
||||
info = 0
|
||||
name='psi_desc_index'
|
||||
|
||||
@@ -45,19 +45,17 @@ subroutine psi_dswapdatam(flag,n,beta,y,desc_a,work,info,data)
|
||||
integer, optional :: data
|
||||
|
||||
! locals
|
||||
integer :: ictxt, np, npcol, me,&
|
||||
& mycol, point_to_proc, nesd, nerv,&
|
||||
integer :: ictxt, np, me, point_to_proc, nesd, nerv,&
|
||||
& proc_to_comm, p2ptag, icomm, p2pstat(mpi_status_size),&
|
||||
& idxs, idxr, iret, errlen, ifcomm, rank,&
|
||||
& err_act, totxch, ixrec, i, lw, idx_pt,&
|
||||
& snd_pt, rcv_pt
|
||||
& idxs, idxr, iret, err_act, totxch, ixrec, i, &
|
||||
& idx_pt, snd_pt, rcv_pt
|
||||
integer :: krecvid, ksendid
|
||||
integer, pointer, dimension(:) :: bsdidx, brvidx,&
|
||||
& sdsz, rvsz, prcid, ptp, rvhd, d_idx
|
||||
integer :: int_err(5)
|
||||
logical :: swap_mpi, swap_sync, swap_send, swap_recv, all
|
||||
real(kind(1.d0)), pointer, dimension(:) :: sndbuf, rcvbuf
|
||||
character(len=20) :: name, ch_err
|
||||
character(len=20) :: name
|
||||
|
||||
info = 0
|
||||
name='psi_swap_data'
|
||||
@@ -497,12 +495,10 @@ subroutine psi_dswapdatav(flag,beta,y,desc_a,work,info,data)
|
||||
integer, optional :: data
|
||||
|
||||
! locals
|
||||
integer :: ictxt, np, npcol, me,&
|
||||
& mycol, point_to_proc, nesd, nerv,&
|
||||
integer :: ictxt, np, me, point_to_proc, nesd, nerv,&
|
||||
& proc_to_comm, p2ptag, icomm, p2pstat(mpi_status_size),&
|
||||
& idxs, idxr, iret, errlen, ifcomm, rank,&
|
||||
& err_act, totxch, ixrec, i, lw, idx_pt,&
|
||||
& snd_pt, rcv_pt, n
|
||||
& idxs, idxr, iret, err_act, totxch, ixrec, i, &
|
||||
& idx_pt, snd_pt, rcv_pt, n
|
||||
|
||||
integer, pointer, dimension(:) :: bsdidx, brvidx,&
|
||||
& sdsz, rvsz, prcid, ptp, rvhd, d_idx
|
||||
@@ -510,7 +506,7 @@ subroutine psi_dswapdatav(flag,beta,y,desc_a,work,info,data)
|
||||
integer :: int_err(5)
|
||||
logical :: swap_mpi, swap_sync, swap_send, swap_recv,all
|
||||
real(kind(1.d0)), pointer, dimension(:) :: sndbuf, rcvbuf
|
||||
character(len=20) :: name, ch_err
|
||||
character(len=20) :: name
|
||||
|
||||
info = 0
|
||||
name='psi_dswap_datav'
|
||||
|
||||
@@ -45,11 +45,9 @@ subroutine psi_dswaptranm(flag,n,beta,y,desc_a,work,info,data)
|
||||
integer, optional :: data
|
||||
|
||||
! locals
|
||||
integer :: ictxt, np, npcol, me,&
|
||||
& mycol, point_to_proc, nesd, nerv,&
|
||||
integer :: ictxt, np, me, point_to_proc, nesd, nerv,&
|
||||
& proc_to_comm, p2ptag, icomm, p2pstat(mpi_status_size),&
|
||||
& idxs, idxr, iret, errlen, ifcomm, rank,&
|
||||
& err_act, totxch, ixrec, i, lw, idx_pt,&
|
||||
& idxs, idxr, iret, err_act, totxch, ixrec, i, idx_pt,&
|
||||
& snd_pt, rcv_pt
|
||||
|
||||
integer, pointer, dimension(:) :: bsdidx, brvidx,&
|
||||
@@ -58,7 +56,7 @@ subroutine psi_dswaptranm(flag,n,beta,y,desc_a,work,info,data)
|
||||
integer :: krecvid, ksendid
|
||||
logical :: swap_mpi, swap_sync, swap_send, swap_recv, all
|
||||
real(kind(1.d0)), pointer, dimension(:) :: sndbuf, rcvbuf
|
||||
character(len=20) :: name, ch_err
|
||||
character(len=20) :: name
|
||||
|
||||
info = 0
|
||||
name='psi_dswaptranm'
|
||||
@@ -502,11 +500,9 @@ subroutine psi_dswaptranv(flag,beta,y,desc_a,work,info,data)
|
||||
integer, optional :: data
|
||||
|
||||
! locals
|
||||
integer :: ictxt, np, npcol, me,&
|
||||
& mycol, point_to_proc, nesd, nerv,&
|
||||
integer :: ictxt, np, me, point_to_proc, nesd, nerv,&
|
||||
& proc_to_comm, p2ptag, icomm, p2pstat(mpi_status_size),&
|
||||
& idxs, idxr, iret, errlen, ifcomm, rank,&
|
||||
& err_act, totxch, ixrec, i, lw, idx_pt,&
|
||||
& idxs, idxr, iret, err_act, totxch, ixrec, i, idx_pt,&
|
||||
& snd_pt, rcv_pt, n
|
||||
|
||||
integer, pointer, dimension(:) :: bsdidx, brvidx,&
|
||||
@@ -515,7 +511,7 @@ subroutine psi_dswaptranv(flag,beta,y,desc_a,work,info,data)
|
||||
integer :: krecvid, ksendid
|
||||
logical :: swap_mpi, swap_sync, swap_send, swap_recv, all
|
||||
real(kind(1.d0)), pointer, dimension(:) :: sndbuf, rcvbuf
|
||||
character(len=20) :: name, ch_err
|
||||
character(len=20) :: name
|
||||
|
||||
info = 0
|
||||
name='psi_dswaptranv'
|
||||
|
||||
@@ -45,11 +45,9 @@ subroutine psi_iswapdatam(flag,n,beta,y,desc_a,work,info,data)
|
||||
integer, optional :: data
|
||||
|
||||
! locals
|
||||
integer :: ictxt, np, npcol, me,&
|
||||
& mycol, point_to_proc, nesd, nerv,&
|
||||
integer :: ictxt, np, me, point_to_proc, nesd, nerv,&
|
||||
& proc_to_comm, p2ptag, icomm, p2pstat(mpi_status_size),&
|
||||
& idxs, idxr, iret, errlen, ifcomm, rank,&
|
||||
& err_act, totxch, ixrec, i, lw, idx_pt,&
|
||||
& idxs, idxr, iret, err_act, totxch, ixrec, i, idx_pt,&
|
||||
& snd_pt, rcv_pt
|
||||
integer :: krecvid, ksendid
|
||||
integer, pointer, dimension(:) :: bsdidx, brvidx,&
|
||||
@@ -57,7 +55,7 @@ subroutine psi_iswapdatam(flag,n,beta,y,desc_a,work,info,data)
|
||||
integer :: int_err(5)
|
||||
logical :: swap_mpi, swap_sync, swap_send, swap_recv, all
|
||||
integer, pointer, dimension(:) :: sndbuf, rcvbuf
|
||||
character(len=20) :: name, ch_err
|
||||
character(len=20) :: name
|
||||
|
||||
info = 0
|
||||
name='psi_dswap_data'
|
||||
@@ -497,11 +495,9 @@ subroutine psi_iswapdatav(flag,beta,y,desc_a,work,info,data)
|
||||
integer, optional :: data
|
||||
|
||||
! locals
|
||||
integer :: ictxt, np, npcol, me,&
|
||||
& mycol, point_to_proc, nesd, nerv,&
|
||||
integer :: ictxt, np, me, point_to_proc, nesd, nerv,&
|
||||
& proc_to_comm, p2ptag, icomm, p2pstat(mpi_status_size),&
|
||||
& idxs, idxr, iret, errlen, ifcomm, rank,&
|
||||
& err_act, totxch, ixrec, i, lw, idx_pt,&
|
||||
& idxs, idxr, iret, err_act, totxch, ixrec, i, idx_pt,&
|
||||
& snd_pt, rcv_pt, n
|
||||
|
||||
integer, pointer, dimension(:) :: bsdidx, brvidx,&
|
||||
@@ -510,7 +506,7 @@ subroutine psi_iswapdatav(flag,beta,y,desc_a,work,info,data)
|
||||
integer :: int_err(5)
|
||||
logical :: swap_mpi, swap_sync, swap_send, swap_recv, all
|
||||
integer, pointer, dimension(:) :: sndbuf, rcvbuf
|
||||
character(len=20) :: name, ch_err
|
||||
character(len=20) :: name
|
||||
|
||||
info = 0
|
||||
name='psi_dswap_datav'
|
||||
|
||||
@@ -45,11 +45,9 @@ subroutine psi_iswaptranm(flag,n,beta,y,desc_a,work,info,data)
|
||||
integer, optional :: data
|
||||
|
||||
! locals
|
||||
integer :: ictxt, np, npcol, me,&
|
||||
& mycol, point_to_proc, nesd, nerv,&
|
||||
integer :: ictxt, np, me, point_to_proc, nesd, nerv,&
|
||||
& proc_to_comm, p2ptag, icomm, p2pstat(mpi_status_size),&
|
||||
& idxs, idxr, iret, errlen, ifcomm, rank,&
|
||||
& err_act, totxch, ixrec, i, lw, idx_pt,&
|
||||
& idxs, idxr, iret, err_act, totxch, ixrec, i, idx_pt,&
|
||||
& snd_pt, rcv_pt
|
||||
|
||||
integer, pointer, dimension(:) :: bsdidx, brvidx,&
|
||||
@@ -58,7 +56,7 @@ subroutine psi_iswaptranm(flag,n,beta,y,desc_a,work,info,data)
|
||||
integer :: krecvid, ksendid
|
||||
logical :: swap_mpi, swap_sync, swap_send, swap_recv, all
|
||||
integer, pointer, dimension(:) :: sndbuf, rcvbuf
|
||||
character(len=20) :: name, ch_err
|
||||
character(len=20) :: name
|
||||
|
||||
info = 0
|
||||
name='psi_dswaptranm'
|
||||
@@ -499,11 +497,9 @@ subroutine psi_iswaptranv(flag,beta,y,desc_a,work,info,data)
|
||||
integer, optional :: data
|
||||
|
||||
! locals
|
||||
integer :: ictxt, np, npcol, me,&
|
||||
& mycol, point_to_proc, nesd, nerv,&
|
||||
integer :: ictxt, np, me, point_to_proc, nesd, nerv,&
|
||||
& proc_to_comm, p2ptag, icomm, p2pstat(mpi_status_size),&
|
||||
& idxs, idxr, iret, errlen, ifcomm, rank,&
|
||||
& err_act, totxch, ixrec, i, lw, idx_pt,&
|
||||
& idxs, idxr, iret, err_act, totxch, ixrec, i, idx_pt,&
|
||||
& snd_pt, rcv_pt, n
|
||||
|
||||
integer, pointer, dimension(:) :: bsdidx, brvidx,&
|
||||
@@ -512,7 +508,7 @@ subroutine psi_iswaptranv(flag,beta,y,desc_a,work,info,data)
|
||||
integer :: krecvid, ksendid
|
||||
logical :: swap_mpi, swap_sync, swap_send, swap_recv, all
|
||||
integer, pointer, dimension(:) :: sndbuf, rcvbuf
|
||||
character(len=20) :: name, ch_err
|
||||
character(len=20) :: name
|
||||
|
||||
|
||||
info = 0
|
||||
|
||||
@@ -42,10 +42,10 @@ subroutine psi_sort_dl(dep_list,l_dep_list,np,info)
|
||||
integer :: i, info
|
||||
integer, pointer :: work(:)
|
||||
logical, parameter :: debug=.false.
|
||||
character(len=20) :: name, ch_err
|
||||
character(len=20) :: name
|
||||
|
||||
name='psi_sort_dl'
|
||||
if(psb_get_errstatus().ne.0) return
|
||||
if(psb_get_errstatus() /= 0) return
|
||||
info=0
|
||||
call psb_erractionsave(err_act)
|
||||
|
||||
@@ -69,7 +69,7 @@ subroutine psi_sort_dl(dep_list,l_dep_list,np,info)
|
||||
call srtlist(dep_list,size(dep_list,1),l_dep_list,np,work(idg),&
|
||||
& work(idgp),work(iupd),work(iedges),work(iidx),work(iich),info)
|
||||
|
||||
if (info .ne. 0) then
|
||||
if (info /= 0) then
|
||||
call psb_errpush(4010,name,a_err='srtlist')
|
||||
goto 9999
|
||||
endif
|
||||
@@ -81,7 +81,7 @@ subroutine psi_sort_dl(dep_list,l_dep_list,np,info)
|
||||
9999 continue
|
||||
call psb_erractionrestore(err_act)
|
||||
|
||||
if (err_act.eq.act_abort) then
|
||||
if (err_act == act_abort) then
|
||||
call psb_error()
|
||||
return
|
||||
end if
|
||||
|
||||
@@ -45,11 +45,9 @@ subroutine psi_zswapdatam(flag,n,beta,y,desc_a,work,info,data)
|
||||
integer, optional :: data
|
||||
|
||||
! locals
|
||||
integer :: ictxt, np, npcol, me,&
|
||||
& mycol, point_to_proc, nesd, nerv,&
|
||||
integer :: ictxt, np, me, point_to_proc, nesd, nerv,&
|
||||
& proc_to_comm, p2ptag, icomm, p2pstat(mpi_status_size),&
|
||||
& idxs, idxr, iret, errlen, ifcomm, rank,&
|
||||
& err_act, totxch, ixrec, i, lw, idx_pt,&
|
||||
& idxs, idxr, iret, err_act, totxch, ixrec, i, idx_pt,&
|
||||
& snd_pt, rcv_pt
|
||||
integer :: krecvid, ksendid
|
||||
integer, pointer, dimension(:) :: bsdidx, brvidx,&
|
||||
@@ -57,7 +55,7 @@ subroutine psi_zswapdatam(flag,n,beta,y,desc_a,work,info,data)
|
||||
integer :: int_err(5)
|
||||
logical :: swap_mpi, swap_sync, swap_send, swap_recv, all
|
||||
complex(kind(1.d0)), pointer, dimension(:) :: sndbuf, rcvbuf
|
||||
character(len=20) :: name, ch_err
|
||||
character(len=20) :: name
|
||||
|
||||
info = 0
|
||||
name='psi_zswap_data'
|
||||
@@ -497,11 +495,9 @@ subroutine psi_zswapdatav(flag,beta,y,desc_a,work,info,data)
|
||||
integer, optional :: data
|
||||
|
||||
! locals
|
||||
integer :: ictxt, np, npcol, me,&
|
||||
& mycol, point_to_proc, nesd, nerv,&
|
||||
integer :: ictxt, np, me, point_to_proc, nesd, nerv,&
|
||||
& proc_to_comm, p2ptag, icomm, p2pstat(mpi_status_size),&
|
||||
& idxs, idxr, iret, errlen, ifcomm, rank,&
|
||||
& err_act, totxch, ixrec, i, lw, idx_pt,&
|
||||
& idxs, idxr, iret, err_act, totxch, ixrec, i, idx_pt,&
|
||||
& snd_pt, rcv_pt, n
|
||||
|
||||
integer, pointer, dimension(:) :: bsdidx, brvidx,&
|
||||
@@ -510,7 +506,7 @@ subroutine psi_zswapdatav(flag,beta,y,desc_a,work,info,data)
|
||||
integer :: int_err(5)
|
||||
logical :: swap_mpi, swap_sync, swap_send, swap_recv,all
|
||||
complex(kind(1.d0)), pointer, dimension(:) :: sndbuf, rcvbuf
|
||||
character(len=20) :: name, ch_err
|
||||
character(len=20) :: name
|
||||
|
||||
info = 0
|
||||
name='psi_zswap_datav'
|
||||
|
||||
@@ -45,11 +45,9 @@ subroutine psi_zswaptranm(flag,n,beta,y,desc_a,work,info,data)
|
||||
integer, optional :: data
|
||||
|
||||
! locals
|
||||
integer :: ictxt, np, npcol, me,&
|
||||
& mycol, point_to_proc, nesd, nerv,&
|
||||
integer :: ictxt, np, me, point_to_proc, nesd, nerv,&
|
||||
& proc_to_comm, p2ptag, icomm, p2pstat(mpi_status_size),&
|
||||
& idxs, idxr, iret, errlen, ifcomm, rank,&
|
||||
& err_act, totxch, ixrec, i, lw, idx_pt,&
|
||||
& idxs, idxr, iret, err_act, totxch, ixrec, i, idx_pt,&
|
||||
& snd_pt, rcv_pt
|
||||
|
||||
integer, pointer, dimension(:) :: bsdidx, brvidx,&
|
||||
@@ -58,7 +56,7 @@ subroutine psi_zswaptranm(flag,n,beta,y,desc_a,work,info,data)
|
||||
integer :: krecvid, ksendid
|
||||
logical :: swap_mpi, swap_sync, swap_send, swap_recv, all
|
||||
complex(kind(1.d0)), pointer, dimension(:) :: sndbuf, rcvbuf
|
||||
character(len=20) :: name, ch_err
|
||||
character(len=20) :: name
|
||||
|
||||
info = 0
|
||||
name='psi_zswaptranm'
|
||||
@@ -502,11 +500,9 @@ subroutine psi_zswaptranv(flag,beta,y,desc_a,work,info,data)
|
||||
integer, optional :: data
|
||||
|
||||
! locals
|
||||
integer :: ictxt, np, npcol, me,&
|
||||
& mycol, point_to_proc, nesd, nerv,&
|
||||
integer :: ictxt, np, me, point_to_proc, nesd, nerv,&
|
||||
& proc_to_comm, p2ptag, icomm, p2pstat(mpi_status_size),&
|
||||
& idxs, idxr, iret, errlen, ifcomm, rank,&
|
||||
& err_act, totxch, ixrec, i, lw, idx_pt,&
|
||||
& idxs, idxr, iret, err_act, totxch, ixrec, i, idx_pt,&
|
||||
& snd_pt, rcv_pt, n
|
||||
|
||||
integer, pointer, dimension(:) :: bsdidx, brvidx,&
|
||||
@@ -515,7 +511,7 @@ subroutine psi_zswaptranv(flag,beta,y,desc_a,work,info,data)
|
||||
integer :: krecvid, ksendid
|
||||
logical :: swap_mpi, swap_sync, swap_send, swap_recv, all
|
||||
complex(kind(1.d0)), pointer, dimension(:) :: sndbuf, rcvbuf
|
||||
character(len=20) :: name, ch_err
|
||||
character(len=20) :: name
|
||||
|
||||
info = 0
|
||||
name='psi_zswaptranv'
|
||||
|
||||
@@ -101,7 +101,7 @@ subroutine psb_dbicg(a,prec,b,x,eps,desc_a,info,&
|
||||
real(kind(1.d0)), pointer :: aux(:),wwrk(:,:)
|
||||
real(kind(1.d0)), pointer :: ww(:), q(:),&
|
||||
& r(:), p(:), zt(:), pt(:), z(:), rt(:),qt(:)
|
||||
integer, pointer :: iperm(:), ipnull(:), ipsave(:), int_err(:)
|
||||
integer :: int_err(5)
|
||||
real(kind(1.d0)) ::rerr
|
||||
integer ::litmax, liter, naux, m, mglob, it, itrace_,&
|
||||
& np,me, n_row, n_col, istop_, err_act
|
||||
@@ -109,10 +109,9 @@ subroutine psb_dbicg(a,prec,b,x,eps,desc_a,info,&
|
||||
logical, parameter :: debug = .false.
|
||||
logical, parameter :: exchange=.true., noexchange=.false.
|
||||
integer, parameter :: irmax = 8
|
||||
integer :: itx, i, isvch, ich, ictxt
|
||||
logical :: do_renum_left
|
||||
integer :: itx, i, isvch, ictxt
|
||||
real(kind(1.d0)) :: alpha, beta, rho, rho_old, rni, xni, bni, ani,&
|
||||
& sigma, omega, tau,bn2
|
||||
& sigma,bn2
|
||||
character(len=20) :: name,ch_err
|
||||
|
||||
info = 0
|
||||
|
||||
@@ -105,9 +105,9 @@ Subroutine psb_dcg(a,prec,b,x,eps,desc_a,info,&
|
||||
& sigma
|
||||
integer :: litmax, liter, istop_, naux, m, mglob, it, itx, itrace_,&
|
||||
& np,me, n_col, isvch, ich, ictxt, n_row,err_act, int_err(5)
|
||||
character ::diagl, diagu
|
||||
character :: diagl, diagu
|
||||
logical, parameter :: exchange=.true., noexchange=.false.
|
||||
character(len=20) :: name,ch_err
|
||||
character(len=20) :: name
|
||||
|
||||
info = 0
|
||||
name = 'psb_dcg'
|
||||
|
||||
@@ -98,19 +98,17 @@ Subroutine psb_dcgs(a,prec,b,x,eps,desc_a,info,&
|
||||
!!$ local data
|
||||
Real(Kind(1.d0)), Pointer :: aux(:),wwrk(:,:)
|
||||
Real(Kind(1.d0)), Pointer :: ww(:), q(:),&
|
||||
& r(:), p(:), v(:), s(:), t(:), z(:), f(:), rt(:),qt(:),uv(:)
|
||||
Integer, Pointer :: iperm(:), ipnull(:), ipsave(:)
|
||||
Real(Kind(1.d0)) ::rerr
|
||||
Integer ::litmax, liter, naux, m, mglob, it, itrace_,int_err(5),&
|
||||
& np,me,mecol, n_row, n_col,istop_, err_act
|
||||
& r(:), p(:), v(:), s(:), z(:), f(:), rt(:),qt(:),uv(:)
|
||||
Real(Kind(1.d0)) :: rerr
|
||||
Integer :: litmax, naux, m, mglob, it, itrace_,int_err(5),&
|
||||
& np,me, n_row, n_col,istop_, err_act
|
||||
Character ::diagl, diagu
|
||||
Logical, Parameter :: exchange=.True., noexchange=.False.
|
||||
Integer, Parameter :: irmax = 8
|
||||
Integer :: itx, i, isvch, ich, ictxt
|
||||
Logical :: do_renum_left
|
||||
Logical, Parameter :: debug = .false.
|
||||
Real(Kind(1.d0)) :: alpha, beta, rho, rho_old, rni, xni, bni, ani,bn2,&
|
||||
& sigma, omega, tau
|
||||
& sigma
|
||||
character(len=20) :: name,ch_err
|
||||
|
||||
info = 0
|
||||
|
||||
@@ -99,22 +99,20 @@ Subroutine psb_dcgstab(a,prec,b,x,eps,desc_a,info,&
|
||||
Real(Kind(1.d0)), Pointer :: aux(:),wwrk(:,:)
|
||||
Real(Kind(1.d0)), Pointer :: q(:),&
|
||||
& r(:), p(:), v(:), s(:), t(:), z(:), f(:)
|
||||
Integer, Pointer :: iperm(:), ipnull(:), ipsave(:)
|
||||
Real(Kind(1.d0)) ::rerr
|
||||
Integer ::litmax, liter, naux, m, mglob, it,itrace_,&
|
||||
Real(Kind(1.d0)) :: rerr
|
||||
Integer :: litmax, naux, m, mglob, it,itrace_,&
|
||||
& np,me, n_row, n_col
|
||||
Character ::diagl, diagu
|
||||
Logical, Parameter :: debug = .false.
|
||||
Logical, Parameter :: exchange=.True., noexchange=.False., debug1 = .False.
|
||||
Integer, Parameter :: irmax = 8
|
||||
Integer :: itx, i, isvch, ich, ictxt, err_act, int_err(5),ii
|
||||
Integer :: itx, i, isvch, ictxt, err_act, int_err(5),ii
|
||||
Integer :: istop_
|
||||
Logical :: do_renum_left
|
||||
Real(Kind(1.d0)) :: alpha, beta, rho, rho_old, rni, xni, bni, ani,&
|
||||
& sigma, omega, tau, rn0, bn2
|
||||
!!$ Integer istpb, istpe, ifctb, ifcte, imerr, irank, icomm,immb,imme
|
||||
!!$ Integer mpe_log_get_event_number,mpe_Describe_state,mpe_log_event
|
||||
character(len=20) :: name,ch_err
|
||||
character(len=20) :: name
|
||||
|
||||
info = 0
|
||||
name = 'psb_dcgstab'
|
||||
|
||||
@@ -106,21 +106,19 @@ Subroutine psb_dcgstabl(a,prec,b,x,eps,desc_a,info,&
|
||||
Real(Kind(1.d0)), Pointer :: aux(:),wwrk(:,:)
|
||||
Real(Kind(1.d0)), Pointer :: ww(:), q(:), r(:), rt0(:), p(:), v(:), &
|
||||
& s(:), t(:), z(:), f(:), uh(:,:), rh(:,:), &
|
||||
& gamma(:), gamma1(:), gamma2(:), taum(:,:), sigma(:),&
|
||||
&pv1(:), pv2(:), pm1(:,:), pm2(:,:)
|
||||
Integer, Pointer :: iperm(:), ipnull(:), ipsave(:)
|
||||
Real(Kind(1.d0)) ::rerr
|
||||
Integer ::litmax, liter, naux, m, mglob, it, itrace_,&
|
||||
& gamma(:), gamma1(:), gamma2(:), taum(:,:), sigma(:)
|
||||
|
||||
Real(Kind(1.d0)) :: rerr
|
||||
Integer :: litmax, naux, m, mglob, it, itrace_,&
|
||||
& np,me, n_row, n_col, nl, err_act
|
||||
Character ::diagl, diagu
|
||||
Logical, Parameter :: exchange=.True., noexchange=.False.
|
||||
Integer, Parameter :: irmax = 8
|
||||
Integer :: itx, i, isvch, ich, ictxt,istop_,j, int_err(5)
|
||||
Logical :: do_renum_left
|
||||
Logical, Parameter :: debug = .False.
|
||||
Real(Kind(1.d0)) :: alpha, beta, rho, rho_old, rni, xni, bni, ani,bn2,&
|
||||
& omega, tau
|
||||
character(len=20) :: name,ch_err
|
||||
character(len=20) :: name
|
||||
|
||||
info = 0
|
||||
name = 'psb_dcgstabl'
|
||||
|
||||
@@ -105,25 +105,20 @@ Subroutine psb_dgmresr(a,prec,b,x,eps,desc_a,info,&
|
||||
Integer, Optional, Intent(out) :: iter
|
||||
Real(Kind(1.d0)), Optional, Intent(out) :: err
|
||||
!!$ local data
|
||||
Real(Kind(1.d0)), Pointer :: aux(:),wwrk(:,:)
|
||||
Real(Kind(1.d0)), Pointer :: w(:), q(:), r(:), rt0(:), p(:), v(:,:), &
|
||||
& c(:),s(:), t(:), z(:), f(:), uh(:,:), h(:,:), rs(:),&
|
||||
& gamma(:), gamma1(:), gamma2(:), taum(:,:), sigma(:),&
|
||||
&pv1(:), pv2(:), pm1(:,:), rr(:,:)
|
||||
Integer, Pointer :: iperm(:), ipnull(:), ipsave(:), ierrv(:)
|
||||
Real(Kind(1.d0)), Pointer :: aux(:)
|
||||
Real(Kind(1.d0)), Pointer :: w(:), v(:,:), &
|
||||
& c(:),s(:), h(:,:), rs(:), rr(:,:)
|
||||
Real(Kind(1.d0)) :: rerr, scal, gm
|
||||
Integer ::litmax, liter, naux, m, mglob, it,k, itrace_,&
|
||||
& np,me, n_row, n_col, nl, int_err(5)
|
||||
Character ::diagl, diagu
|
||||
Character :: diagl, diagu
|
||||
Logical, Parameter :: exchange=.True., noexchange=.False.
|
||||
Integer, Parameter :: irmax = 8
|
||||
Integer :: itx, i, isvch, ich, ictxt,istop_, err_act
|
||||
Logical :: do_renum_left,inner_stop
|
||||
Logical, Parameter :: debug = .false.
|
||||
Real(Kind(1.d0)) :: alpha, beta, rho, rho_old, rni, xni, bni, ani,bn2,&
|
||||
& omega, tau
|
||||
Real(Kind(1.d0)) :: rni, xni, bni, ani,bn2
|
||||
real(kind(1.d0)), external :: dnrm2
|
||||
character(len=20) :: name,ch_err
|
||||
character(len=20) :: name
|
||||
|
||||
info = 0
|
||||
name = 'psb_dgmres'
|
||||
|
||||
@@ -98,20 +98,19 @@ Subroutine psb_zcgs(a,prec,b,x,eps,desc_a,info,&
|
||||
!!$ local data
|
||||
Complex(Kind(1.d0)), Pointer :: aux(:),wwrk(:,:)
|
||||
Complex(Kind(1.d0)), Pointer :: ww(:), q(:),&
|
||||
& r(:), p(:), v(:), s(:), t(:), z(:), f(:), rt(:),qt(:),uv(:)
|
||||
Integer, Pointer :: iperm(:), ipnull(:), ipsave(:)
|
||||
Real(Kind(1.d0)) ::rerr
|
||||
Integer ::litmax, liter, naux, m, mglob, it, itrace_,int_err(5),&
|
||||
& r(:), p(:), v(:), s(:), z(:), f(:), rt(:),qt(:),uv(:)
|
||||
Real(Kind(1.d0)) :: rerr
|
||||
Integer :: litmax, naux, m, mglob, it, itrace_,int_err(5),&
|
||||
& np,me, n_row, n_col,istop_, err_act
|
||||
Character ::diagl, diagu
|
||||
Logical, Parameter :: exchange=.True., noexchange=.False.
|
||||
Integer, Parameter :: irmax = 8
|
||||
Integer :: itx, i, isvch, ich, ictxt
|
||||
Integer :: itx, i, isvch, ictxt
|
||||
Logical :: do_renum_left
|
||||
Logical, Parameter :: debug = .false.
|
||||
Real(Kind(1.d0)) :: rni, xni, bni, ani,bn2
|
||||
complex(Kind(1.d0)) :: alpha, beta, rho, rho_old, sigma, omega, tau
|
||||
character(len=20) :: name,ch_err
|
||||
complex(Kind(1.d0)) :: alpha, beta, rho, rho_old, sigma
|
||||
character(len=20) :: name
|
||||
|
||||
info = 0
|
||||
name = 'psb_zcgs'
|
||||
|
||||
@@ -99,9 +99,8 @@ Subroutine psb_zcgstab(a,prec,b,x,eps,desc_a,info,&
|
||||
Complex(Kind(1.d0)), Pointer :: aux(:),wwrk(:,:)
|
||||
Complex(Kind(1.d0)), Pointer :: q(:),&
|
||||
& r(:), p(:), v(:), s(:), t(:), z(:), f(:)
|
||||
Integer, Pointer :: iperm(:), ipnull(:), ipsave(:)
|
||||
Real(Kind(1.d0)) :: rerr
|
||||
Integer :: litmax, liter, naux, m, mglob, it,itrace_,&
|
||||
Integer :: litmax, naux, m, mglob, it,itrace_,&
|
||||
& np,me, n_row, n_col
|
||||
Character ::diagl, diagu
|
||||
Logical, Parameter :: debug = .false.
|
||||
@@ -109,12 +108,11 @@ Subroutine psb_zcgstab(a,prec,b,x,eps,desc_a,info,&
|
||||
Integer, Parameter :: irmax = 8
|
||||
Integer :: itx, i, isvch, ich, ictxt, err_act, int_err(5),ii
|
||||
Integer :: istop_
|
||||
Logical :: do_renum_left
|
||||
complex(Kind(1.d0)) :: alpha, beta, rho, rho_old, sigma, omega, tau
|
||||
Real(Kind(1.d0)) :: rni, xni, bni, ani, rn0, bn2
|
||||
!!$ Integer istpb, istpe, ifctb, ifcte, imerr, irank, icomm,immb,imme
|
||||
!!$ Integer mpe_log_get_event_number,mpe_Describe_state,mpe_log_event
|
||||
character(len=20) :: name,ch_err
|
||||
character(len=20) :: name
|
||||
|
||||
info = 0
|
||||
name = 'psb_zcgstab'
|
||||
|
||||
+144
-145
@@ -37,8 +37,8 @@ module psb_error_mod
|
||||
& psb_get_erraction, psb_set_erraction
|
||||
|
||||
interface psb_error
|
||||
module procedure psb_serror
|
||||
module procedure psb_perror
|
||||
module procedure psb_serror
|
||||
module procedure psb_perror
|
||||
end interface
|
||||
|
||||
!!$ integer, parameter :: act_ret=0, act_abort=1, no_err=0
|
||||
@@ -47,21 +47,21 @@ module psb_error_mod
|
||||
|
||||
type psb_errstack_node
|
||||
|
||||
integer :: err_code=0 ! the error code
|
||||
character(len=20) :: routine='' ! the name of the routine generating the error
|
||||
integer,dimension(5) :: i_err_data=0 ! array of integer data to complete the error msg
|
||||
! real(kind(1.d0))(dim=10) :: r_err_data=0.d0 ! array of real data to complete the error msg
|
||||
! complex(dim=10) :: c_err_data=0.c0 ! array of complex data to complete the error msg
|
||||
character(len=20) :: a_err_data='' ! array of character data to complete the error msg
|
||||
type(psb_errstack_node), pointer :: next ! pointer to the next element in the stack
|
||||
integer :: err_code=0 ! the error code
|
||||
character(len=20) :: routine='' ! the name of the routine generating the error
|
||||
integer,dimension(5) :: i_err_data=0 ! array of integer data to complete the error msg
|
||||
! real(kind(1.d0))(dim=10) :: r_err_data=0.d0 ! array of real data to complete the error msg
|
||||
! complex(dim=10) :: c_err_data=0.c0 ! array of complex data to complete the error msg
|
||||
character(len=20) :: a_err_data='' ! array of character data to complete the error msg
|
||||
type(psb_errstack_node), pointer :: next ! pointer to the next element in the stack
|
||||
|
||||
end type psb_errstack_node
|
||||
|
||||
|
||||
type psb_errstack
|
||||
|
||||
type(psb_errstack_node), pointer :: top => null() ! pointer to the top element of the stack
|
||||
integer :: n_elems=0 ! number of entries in the stack
|
||||
type(psb_errstack_node), pointer :: top => null() ! pointer to the top element of the stack
|
||||
integer :: n_elems=0 ! number of entries in the stack
|
||||
|
||||
end type psb_errstack
|
||||
|
||||
@@ -198,34 +198,34 @@ contains
|
||||
integer :: err_c
|
||||
character(len=20) :: r_name, a_e_d
|
||||
integer :: i_e_d(5)
|
||||
integer :: nprow, npcol, me, mypcol, temp(2)
|
||||
integer :: nprow, npcol, me, mypcol
|
||||
integer, parameter :: ione=1, izero=0
|
||||
|
||||
call blacs_gridinfo(ictxt, nprow, npcol, me, mypcol)
|
||||
|
||||
if(error_status.gt.0) then
|
||||
if(verbosity_level.gt.1) then
|
||||
|
||||
do while (error_stack%n_elems.gt.izero)
|
||||
write(0,'(50("="))')
|
||||
call psb_errpop(err_c, r_name, i_e_d, a_e_d)
|
||||
call psb_errmsg(err_c, r_name, i_e_d, a_e_d,me)
|
||||
! write(0,'(50("="))')
|
||||
end do
|
||||
call blacs_abort(ictxt,-1)
|
||||
else
|
||||
if(verbosity_level.gt.1) then
|
||||
|
||||
do while (error_stack%n_elems.gt.izero)
|
||||
write(0,'(50("="))')
|
||||
call psb_errpop(err_c, r_name, i_e_d, a_e_d)
|
||||
call psb_errmsg(err_c, r_name, i_e_d, a_e_d,me)
|
||||
do while (error_stack%n_elems.gt.0)
|
||||
call psb_errpop(err_c, r_name, i_e_d, a_e_d)
|
||||
end do
|
||||
call blacs_abort(ictxt,-1)
|
||||
end if
|
||||
! write(0,'(50("="))')
|
||||
end do
|
||||
call blacs_abort(ictxt,-1)
|
||||
else
|
||||
|
||||
call psb_errpop(err_c, r_name, i_e_d, a_e_d)
|
||||
call psb_errmsg(err_c, r_name, i_e_d, a_e_d,me)
|
||||
do while (error_stack%n_elems.gt.0)
|
||||
call psb_errpop(err_c, r_name, i_e_d, a_e_d)
|
||||
end do
|
||||
call blacs_abort(ictxt,-1)
|
||||
end if
|
||||
end if
|
||||
|
||||
if(error_status.gt.izero) then
|
||||
call blacs_abort(ictxt,err_c)
|
||||
call blacs_abort(ictxt,err_c)
|
||||
end if
|
||||
|
||||
|
||||
@@ -238,27 +238,26 @@ contains
|
||||
integer :: err_c
|
||||
character(len=20) :: r_name, a_e_d
|
||||
integer :: i_e_d(5)
|
||||
integer :: nprow, npcol, me, mypcol, temp(2)
|
||||
integer, parameter :: ione=1, izero=0
|
||||
|
||||
if(error_status.gt.0) then
|
||||
if(verbosity_level.gt.1) then
|
||||
|
||||
do while (error_stack%n_elems.gt.izero)
|
||||
write(0,'(50("="))')
|
||||
call psb_errpop(err_c, r_name, i_e_d, a_e_d)
|
||||
call psb_errmsg(err_c, r_name, i_e_d, a_e_d)
|
||||
! write(0,'(50("="))')
|
||||
end do
|
||||
|
||||
else
|
||||
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)
|
||||
do while (error_stack%n_elems.gt.0)
|
||||
call psb_errpop(err_c, r_name, i_e_d, a_e_d)
|
||||
end do
|
||||
end if
|
||||
! write(0,'(50("="))')
|
||||
end do
|
||||
|
||||
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)
|
||||
end do
|
||||
end if
|
||||
end if
|
||||
|
||||
end subroutine psb_serror
|
||||
@@ -273,188 +272,188 @@ contains
|
||||
integer, optional :: me
|
||||
|
||||
if(present(me)) then
|
||||
write(0,'("Process: ",i0,". PSBLAS Error (",i0,") in subroutine: ",a20)')me,err_c,r_name
|
||||
write(0,'("Process: ",i0,". PSBLAS Error (",i0,") in subroutine: ",a20)')me,err_c,r_name
|
||||
else
|
||||
write(0,'("PSBLAS Error (",i0,") in subroutine: ",a20)')err_c,r_name
|
||||
write(0,'("PSBLAS Error (",i0,") in subroutine: ",a20)')err_c,r_name
|
||||
end if
|
||||
|
||||
|
||||
select case (err_c)
|
||||
case(:0)
|
||||
write (0,'("error on calling sperror. err_c must be greater than 0")')
|
||||
write (0,'("error on calling sperror. err_c must be greater than 0")')
|
||||
case(2)
|
||||
write (0,'("pivot too small: ",i0,1x,a)')i_e_d(1),a_e_d
|
||||
write (0,'("pivot too small: ",i0,1x,a)')i_e_d(1),a_e_d
|
||||
case(3)
|
||||
write (0,'("Invalid number of ovr:",i0)')i_e_d(1)
|
||||
write (0,'("Invalid number of ovr:",i0)')i_e_d(1)
|
||||
case(5)
|
||||
write (0,'("Invalid input")')
|
||||
write (0,'("Invalid input")')
|
||||
|
||||
case(10)
|
||||
write (0,'("input argument n. ",i0," cannot be less than 0")')i_e_d(1)
|
||||
write (0,'("current value is ",i0)')i_e_d(2)
|
||||
write (0,'("input argument n. ",i0," cannot be less than 0")')i_e_d(1)
|
||||
write (0,'("current value is ",i0)')i_e_d(2)
|
||||
|
||||
case(20)
|
||||
write (0,'("input argument n. ",i0," cannot be greater than 0")')i_e_d(1)
|
||||
write (0,'("current value is ",i0)')i_e_d(2)
|
||||
write (0,'("input argument n. ",i0," cannot be greater than 0")')i_e_d(1)
|
||||
write (0,'("current value is ",i0)')i_e_d(2)
|
||||
case(30)
|
||||
write (0,'("input argument n. ",i0," has an invalid value")')i_e_d(1)
|
||||
write (0,'("current value is ",i0)')i_e_d(2)
|
||||
write (0,'("input argument n. ",i0," has an invalid value")')i_e_d(1)
|
||||
write (0,'("current value is ",i0)')i_e_d(2)
|
||||
case(35)
|
||||
write (0,'("Size of input array argument n. ",i0," is invalid.")')i_e_d(1)
|
||||
write (0,'("Current value is ",i0)')i_e_d(2)
|
||||
write (0,'("Size of input array argument n. ",i0," is invalid.")')i_e_d(1)
|
||||
write (0,'("Current value is ",i0)')i_e_d(2)
|
||||
case(40)
|
||||
write (0,'("input argument n. ",i0," has an invalid value")')i_e_d(1)
|
||||
write (0,'("current value is ",a)')a_e_d(2:2)
|
||||
write (0,'("input argument n. ",i0," has an invalid value")')i_e_d(1)
|
||||
write (0,'("current value is ",a)')a_e_d(2:2)
|
||||
case(50)
|
||||
write (0,'("input argument n. ",i0," must be equal or greater than input argument n. ",i0)') i_e_d(1), i_e_d(3)
|
||||
write (0,'("current values are ",i0," < ",i0)') i_e_d(2),i_e_d(5)
|
||||
write (0,'("input argument n. ",i0," must be equal or greater than input argument n. ",i0)') i_e_d(1), i_e_d(3)
|
||||
write (0,'("current values are ",i0," < ",i0)') i_e_d(2),i_e_d(5)
|
||||
case(60)
|
||||
write (0,'("input argument n. ",i0," must be greater than or equal to ",i0)')i_e_d(1),i_e_d(2)
|
||||
write (0,'("current value is ",i0," < ",i0)')i_e_d(3), i_e_d(2)
|
||||
write (0,'("input argument n. ",i0," must be greater than or equal to ",i0)')i_e_d(1),i_e_d(2)
|
||||
write (0,'("current value is ",i0," < ",i0)')i_e_d(3), i_e_d(2)
|
||||
case(70)
|
||||
write (0,'("input argument n. ",i0," in entry # ",i0," has an invalid value")')i_e_d(1:2)
|
||||
write (0,'("current value is ",a)')a_e_d
|
||||
write (0,'("input argument n. ",i0," in entry # ",i0," has an invalid value")')i_e_d(1:2)
|
||||
write (0,'("current value is ",a)')a_e_d
|
||||
case(71)
|
||||
write (0,'("Impossible error in ASB: nrow>ncol,")')
|
||||
write (0,'("Actual values are ",i0," > ",i0)')i_e_d(1:2)
|
||||
! ... csr format error ...
|
||||
write (0,'("Impossible error in ASB: nrow>ncol,")')
|
||||
write (0,'("Actual values are ",i0," > ",i0)')i_e_d(1:2)
|
||||
! ... csr format error ...
|
||||
case(80)
|
||||
write (0,'("input argument ia2(1) is less than 0")')
|
||||
write (0,'("current value is ",i0)')i_e_d(1)
|
||||
! ... csr format error ...
|
||||
write (0,'("input argument ia2(1) is less than 0")')
|
||||
write (0,'("current value is ",i0)')i_e_d(1)
|
||||
! ... csr format error ...
|
||||
case(90)
|
||||
write (0,'("indices in ia2 array are not in increasing order")')
|
||||
write (0,'("indices in ia2 array are not in increasing order")')
|
||||
case(91)
|
||||
write (0,'("indices in ia1 array are not in increasing order")')
|
||||
! ... csr format error ...
|
||||
write (0,'("indices in ia1 array are not in increasing order")')
|
||||
! ... csr format error ...
|
||||
case(100)
|
||||
write (0,'("indices in ia1 array are not within problem dimension")')
|
||||
write (0,'("problem dimension is ",i0)')i_e_d(1)
|
||||
write (0,'("indices in ia1 array are not within problem dimension")')
|
||||
write (0,'("problem dimension is ",i0)')i_e_d(1)
|
||||
case(110)
|
||||
write (0,'("invalid combination of input arguments")')
|
||||
write (0,'("invalid combination of input arguments")')
|
||||
case(115)
|
||||
write (0,'("Invalid process identifier in input array argument n. ",i0,".")')i_e_d(1)
|
||||
write (0,'("Current value is ",i0)')i_e_d(2)
|
||||
write (0,'("Invalid process identifier in input array argument n. ",i0,".")')i_e_d(1)
|
||||
write (0,'("Current value is ",i0)')i_e_d(2)
|
||||
case(120)
|
||||
write (0,'("input argument n. ",i0," must be greater than input argument n. ",i0)')i_e_d(1:2)
|
||||
write (0,'("current values are ",i0," < ",i0)') i_e_d(3:4)
|
||||
! ... coo format error ...
|
||||
write (0,'("input argument n. ",i0," must be greater than input argument n. ",i0)')i_e_d(1:2)
|
||||
write (0,'("current values are ",i0," < ",i0)') i_e_d(3:4)
|
||||
! ... coo format error ...
|
||||
case(130)
|
||||
write (0,'("there are duplicated elements in coo format")')
|
||||
write (0,'("please set repflag flag to 2 or 3")')
|
||||
write (0,'("there are duplicated elements in coo format")')
|
||||
write (0,'("please set repflag flag to 2 or 3")')
|
||||
case(134)
|
||||
write (0,'("Invalid input format ",a3)')a_e_d(1:3)
|
||||
write (0,'("Invalid input format ",a3)')a_e_d(1:3)
|
||||
case(135)
|
||||
write (0,'("Format ",a3," not yet supported here")')a_e_d(1:3)
|
||||
write (0,'("Format ",a3," not yet supported here")')a_e_d(1:3)
|
||||
case(136)
|
||||
write (0,'("Format ",a3," is unknown")')a_e_d(1:3)
|
||||
write (0,'("Format ",a3," is unknown")')a_e_d(1:3)
|
||||
case(140)
|
||||
write (0,'("indices in input array are not within problem dimension ",2(i0,2x))')i_e_d(1:2)
|
||||
write (0,'("indices in input array are not within problem dimension ",2(i0,2x))')i_e_d(1:2)
|
||||
case(150)
|
||||
write (0,'("indices in input array are not belonging to the calling process ",i0)')i_e_d(1)
|
||||
write (0,'("indices in input array are not belonging to the calling process ",i0)')i_e_d(1)
|
||||
case(290)
|
||||
write (0,'("Is not possible to call this routine without calling before psdalloc on the same matrix")')
|
||||
write (0,'("Is not possible to call this routine without calling before psdalloc on the same matrix")')
|
||||
case(295)
|
||||
write (0,'("Is not possible to call this routine without calling before psdspalloc on the same matrix")')
|
||||
write (0,'("Is not possible to call this routine without calling before psdspalloc on the same matrix")')
|
||||
case(300)
|
||||
write (0,'("Input argument n. ",i0," must be equal to entry n. ",i0," in array input argument n.",i0)') &
|
||||
& i_e_d(1),i_e_d(4),i_e_d(3)
|
||||
write (0,'("Current values are ",i0," != ",i0)')i_e_d(2), i_e_d(5)
|
||||
write (0,'("Input argument n. ",i0," must be equal to entry n. ",i0," in array input argument n.",i0)') &
|
||||
& i_e_d(1),i_e_d(4),i_e_d(3)
|
||||
write (0,'("Current values are ",i0," != ",i0)')i_e_d(2), i_e_d(5)
|
||||
case(400)
|
||||
write (0,'("MPI error:",i0)')i_e_d(1)
|
||||
write (0,'("MPI error:",i0)')i_e_d(1)
|
||||
case(550)
|
||||
write (0,'("Parameter n. ",i0," must be equal on all BLACS processes. ",i0)')i_e_d(1)
|
||||
write (0,'("Parameter n. ",i0," must be equal on all BLACS processes. ",i0)')i_e_d(1)
|
||||
case(570)
|
||||
write (0,'("partition function passed as input argument n. ",i0," returns number of processes")')i_e_d(1)
|
||||
write (0,'("greater than No of grid s processes on global point ",i0,". Actual number of grid s ")')i_e_d(4)
|
||||
write (0,'("processes is ",i0,", number returned is ",i0)')i_e_d(2),i_e_d(3)
|
||||
write (0,'("partition function passed as input argument n. ",i0," returns number of processes")')i_e_d(1)
|
||||
write (0,'("greater than No of grid s processes on global point ",i0,". Actual number of grid s ")')i_e_d(4)
|
||||
write (0,'("processes is ",i0,", number returned is ",i0)')i_e_d(2),i_e_d(3)
|
||||
case(575)
|
||||
write (0,'("partition function passed as input argument n. ",i0," returns number of processes")')i_e_d(1)
|
||||
write (0,'("less or equal to 0 on global point ",i0,". Number returned is ",i0)')i_e_d(3),i_e_d(2)
|
||||
write (0,'("partition function passed as input argument n. ",i0," returns number of processes")')i_e_d(1)
|
||||
write (0,'("less or equal to 0 on global point ",i0,". Number returned is ",i0)')i_e_d(3),i_e_d(2)
|
||||
case(580)
|
||||
write (0,'("partition function passed as input argument n. ",i0," returns wrong processes identifier")')i_e_d(1)
|
||||
write (0,'("on global point ",i0,". Current value returned is : ",i0)')i_e_d(3),i_e_d(2)
|
||||
write (0,'("partition function passed as input argument n. ",i0," returns wrong processes identifier")')i_e_d(1)
|
||||
write (0,'("on global point ",i0,". Current value returned is : ",i0)')i_e_d(3),i_e_d(2)
|
||||
case(600)
|
||||
write (0,'("Sparse Matrix and decsriptors are in an invalid state for this subroutine call: ",i0)')i_e_d(1)
|
||||
write (0,'("Sparse Matrix and decsriptors are in an invalid state for this subroutine call: ",i0)')i_e_d(1)
|
||||
case (1122)
|
||||
write (0,'("Invalid state for DESC_A")')
|
||||
write (0,'("Invalid state for DESC_A")')
|
||||
case (1123)
|
||||
write (0,'("Invalid combined state for A and DESC_A")')
|
||||
write (0,'("Invalid combined state for A and DESC_A")')
|
||||
case(1124:1999)
|
||||
write (0,'("computational error. code: ",i0)')err_c
|
||||
write (0,'("computational error. code: ",i0)')err_c
|
||||
case(2010)
|
||||
write (0,'("BLACS error. Number of processes=-1")')
|
||||
write (0,'("BLACS error. Number of processes=-1")')
|
||||
case(2011)
|
||||
write (0,'("Initialization error: not enough processes available in the parallel environment")')
|
||||
write (0,'("Initialization error: not enough processes available in the parallel environment")')
|
||||
case(2025)
|
||||
write (0,'("Cannot allocate ",i0," bytes")')i_e_d(1)
|
||||
write (0,'("Cannot allocate ",i0," bytes")')i_e_d(1)
|
||||
case(2030)
|
||||
write (0,'("BLACS ERROR: Number of grid columns must be equal to 1\nCurrent value is ",i4," != 1.")')i_e_d(1)
|
||||
write (0,'("BLACS ERROR: Number of grid columns must be equal to 1\nCurrent value is ",i4," != 1.")')i_e_d(1)
|
||||
case(2231)
|
||||
write (0,'("Invalid input state for matrix.")')
|
||||
write (0,'("Invalid input state for matrix.")')
|
||||
case(2232)
|
||||
write (0,'("Input state for matrix is not adequate for regeneration.")')
|
||||
write (0,'("Input state for matrix is not adequate for regeneration.")')
|
||||
case (2233:2999)
|
||||
write(0,'("resource error. code: ",i0)')err_c
|
||||
write(0,'("resource error. code: ",i0)')err_c
|
||||
case(3000:3009)
|
||||
write (0,'("sparse matrix representation ",a3," not yet implemented")')a_e_d(1:3)
|
||||
write (0,'("sparse matrix representation ",a3," not yet implemented")')a_e_d(1:3)
|
||||
case(3010)
|
||||
write (0,'("Case lld not equal matrix_data[N_COL_] is not yet implemented.")')
|
||||
write (0,'("Case lld not equal matrix_data[N_COL_] is not yet implemented.")')
|
||||
case(3015)
|
||||
write (0,'("transpose option for sparse matrix representation ",a3," not implemented")')a_e_d(1:3)
|
||||
write (0,'("transpose option for sparse matrix representation ",a3," not implemented")')a_e_d(1:3)
|
||||
case(3020)
|
||||
write (0,'("Case trans = C is not yet implemented.")')
|
||||
write (0,'("Case trans = C is not yet implemented.")')
|
||||
case(3021)
|
||||
write (0,'("Case trans /= N is not yet implemented.")')
|
||||
write (0,'("Case trans /= N is not yet implemented.")')
|
||||
case(3022)
|
||||
write (0,'("Only unit diagonal so far for triangular matrices. ")')
|
||||
write (0,'("Only unit diagonal so far for triangular matrices. ")')
|
||||
case(3023)
|
||||
write (0,'("Cases DESCRA(1:1)=S DESCRA(1:1)=T not yet implemented. ")')
|
||||
write (0,'("Cases DESCRA(1:1)=S DESCRA(1:1)=T not yet implemented. ")')
|
||||
case(3024)
|
||||
write (0,'("Cases DESCRA(1:1)=G not yet implemented. ")')
|
||||
write (0,'("Cases DESCRA(1:1)=G not yet implemented. ")')
|
||||
case(3030)
|
||||
write (0,'("Case ja/=ix or ia/=iy is not yet implemented.")')
|
||||
write (0,'("Case ja/=ix or ia/=iy is not yet implemented.")')
|
||||
case(3040)
|
||||
write (0,'("Case ix /= 1 or iy /= 1 is not yet implemented.")')
|
||||
write (0,'("Case ix /= 1 or iy /= 1 is not yet implemented.")')
|
||||
case(3050)
|
||||
write (0,'("Case ix /= iy is not yet implemented.")')
|
||||
write (0,'("Case ix /= iy is not yet implemented.")')
|
||||
case(3060)
|
||||
write (0,'("Case ix /= 1 is not yet implemented.")')
|
||||
write (0,'("Case ix /= 1 is not yet implemented.")')
|
||||
case(3070)
|
||||
write (0,'("This operation is only implemented with no overlap.")')
|
||||
write (0,'("This operation is only implemented with no overlap.")')
|
||||
case(3080)
|
||||
write (0,'("Decompostion type ",i0," not yet supported.")')i_e_d(1)
|
||||
write (0,'("Decompostion type ",i0," not yet supported.")')i_e_d(1)
|
||||
case(3090)
|
||||
write (0,'("Insert matrix mode not yet implemented.")')
|
||||
write (0,'("Insert matrix mode not yet implemented.")')
|
||||
case(3100)
|
||||
write (0,'("Error on index. Element has not been inserted")')
|
||||
write (0,'("local index is: ",i0," and global index is:",i0)')i_e_d(1:2)
|
||||
write (0,'("Error on index. Element has not been inserted")')
|
||||
write (0,'("local index is: ",i0," and global index is:",i0)')i_e_d(1:2)
|
||||
case(3110)
|
||||
write (0,'("Before you call this routine, you must assembly sparse matrix")')
|
||||
write (0,'("Before you call this routine, you must assembly sparse matrix")')
|
||||
case(3111:3999)
|
||||
write(0,'("miscellaneus error. code: ",i0)')err_c
|
||||
write(0,'("miscellaneus error. code: ",i0)')err_c
|
||||
case(4000)
|
||||
write(0,'("Allocation/deallocation error")')
|
||||
write(0,'("Allocation/deallocation error")')
|
||||
case(4010)
|
||||
write (0,'("Error from call to subroutine ",a)')a_e_d
|
||||
write (0,'("Error from call to subroutine ",a)')a_e_d
|
||||
case(4011)
|
||||
write (0,'("Error from call to a subroutine ")')
|
||||
write (0,'("Error from call to a subroutine ")')
|
||||
case(4012)
|
||||
write (0,'("Error ",i0," from call to a subroutine ")')i_e_d(1)
|
||||
write (0,'("Error ",i0," from call to a subroutine ")')i_e_d(1)
|
||||
case(4013)
|
||||
write (0,'("Error from call to subroutine ",a," ",i0)')a_e_d,i_e_d(1)
|
||||
write (0,'("Error from call to subroutine ",a," ",i0)')a_e_d,i_e_d(1)
|
||||
case(4110)
|
||||
write (0,'("Error ",i0," from call to an external package in subroutine ",a)')i_e_d(1),a_e_d
|
||||
write (0,'("Error ",i0," from call to an external package in subroutine ",a)')i_e_d(1),a_e_d
|
||||
case (5001)
|
||||
write (0,'("Invalid ISTOP: ",i0)')i_e_d(1)
|
||||
write (0,'("Invalid ISTOP: ",i0)')i_e_d(1)
|
||||
case (5002)
|
||||
write (0,'("Invalid PREC: ",i0)')i_e_d(1)
|
||||
write (0,'("Invalid PREC: ",i0)')i_e_d(1)
|
||||
case (5003)
|
||||
write (0,'("Invalid PREC: ",a3)')a_e_d(1:3)
|
||||
write (0,'("Invalid PREC: ",a3)')a_e_d(1:3)
|
||||
case default
|
||||
write(0,'("unknown error (",i0,") in subroutine ",a)')err_c,r_name
|
||||
write(0,'(5(i0,2x))') i_e_d
|
||||
write(0,'(a)') a_e_d
|
||||
write(0,'("unknown error (",i0,") in subroutine ",a)')err_c,r_name
|
||||
write(0,'(5(i0,2x))') i_e_d
|
||||
write(0,'(a)') a_e_d
|
||||
|
||||
end select
|
||||
|
||||
|
||||
@@ -323,7 +323,8 @@ Contains
|
||||
rrax=>tmp
|
||||
End If
|
||||
else
|
||||
dim = 0
|
||||
dim = 0
|
||||
dim2 = 0
|
||||
Allocate(rrax(len1,len2),stat=info)
|
||||
if (info /= 0) then
|
||||
err=4000
|
||||
@@ -397,7 +398,8 @@ Contains
|
||||
rrax=>tmp
|
||||
End If
|
||||
else
|
||||
dim = 0
|
||||
dim = 0
|
||||
dim2 = 0
|
||||
Allocate(rrax(len1,len2),stat=info)
|
||||
if (info /= 0) then
|
||||
err=4000
|
||||
@@ -471,7 +473,8 @@ Contains
|
||||
rrax=>tmp
|
||||
End If
|
||||
else
|
||||
dim = 0
|
||||
dim = 0
|
||||
dim2 = 0
|
||||
Allocate(rrax(len1,len2),stat=info)
|
||||
if (info /= 0) then
|
||||
err=4000
|
||||
|
||||
@@ -145,7 +145,7 @@ contains
|
||||
!locals
|
||||
logical, parameter :: debug=.false.
|
||||
logical :: clear_
|
||||
character(len=20) :: name, ch_err
|
||||
character(len=20) :: name
|
||||
|
||||
info = 0
|
||||
name = 'psb_sp_reinit'
|
||||
@@ -436,10 +436,9 @@ contains
|
||||
Integer, intent(out) :: info
|
||||
|
||||
!locals
|
||||
Integer :: nza,nz1, nz2, nzl, nzr
|
||||
logical, parameter :: debug=.false.
|
||||
|
||||
INFO = 0
|
||||
info = 0
|
||||
|
||||
if (associated(b%pr)) then
|
||||
deallocate(b%pr,stat=info)
|
||||
@@ -507,7 +506,7 @@ contains
|
||||
Integer, intent(out) :: i1, i2, ia, info
|
||||
|
||||
!locals
|
||||
Integer :: nza,nz1, nz2, nzl, nzr
|
||||
Integer :: nza
|
||||
logical, parameter :: debug=.false.
|
||||
|
||||
info = 0
|
||||
@@ -671,7 +670,7 @@ contains
|
||||
!locals
|
||||
logical, parameter :: debug=.false.
|
||||
logical :: clear_
|
||||
character(len=20) :: name, ch_err
|
||||
character(len=20) :: name
|
||||
|
||||
info = 0
|
||||
name = 'psb_sp_reinit'
|
||||
@@ -957,10 +956,9 @@ contains
|
||||
Integer, intent(out) :: info
|
||||
|
||||
!locals
|
||||
Integer :: nza,nz1, nz2, nzl, nzr
|
||||
logical, parameter :: debug=.false.
|
||||
|
||||
INFO = 0
|
||||
info = 0
|
||||
|
||||
if (associated(b%pr)) then
|
||||
deallocate(b%pr,stat=info)
|
||||
@@ -1029,7 +1027,7 @@ contains
|
||||
Integer, intent(out) :: i1, i2, ia, info
|
||||
|
||||
!locals
|
||||
Integer :: nza,nz1, nz2, nzl, nzr
|
||||
Integer :: nza
|
||||
logical, parameter :: debug=.false.
|
||||
|
||||
info = 0
|
||||
|
||||
@@ -75,13 +75,12 @@ Subroutine psb_dasmatbld(ptype,novr,a,blk,desc_data,upd,desc_p,info,outfmt)
|
||||
|
||||
real(kind(1.d0)) :: t1,t2,t3,mpi_wtime
|
||||
external mpi_wtime
|
||||
integer idscb,idsce,iovrb,iovre, err, irank, icomm
|
||||
integer icomm
|
||||
|
||||
! .. Local Scalars ..
|
||||
Integer :: k, tot_elem,proc,&
|
||||
& point,nprow,npcol, me, mycol, start,m,nnzero,&
|
||||
& ictxt, lovr, n_col, linp,ier,n,int_err(5),&
|
||||
& tot_recv, ircode, n_row, nztot,nhalo, nrow_a,err_act
|
||||
Integer :: k, np,me,m,nnzero,&
|
||||
& ictxt, n_col,ier,n,int_err(5),&
|
||||
& tot_recv, ircode, n_row,nhalo, nrow_a,err_act
|
||||
Logical,Parameter :: debug=.false., debugprt=.false.
|
||||
character(len=20) :: name, ch_err
|
||||
name='psb_dasmatbld'
|
||||
@@ -172,9 +171,9 @@ Subroutine psb_dasmatbld(ptype,novr,a,blk,desc_data,upd,desc_p,info,outfmt)
|
||||
return
|
||||
endif
|
||||
|
||||
call blacs_get(ictxt,10,icomm )
|
||||
call psb_get_mpicomm(ictxt,icomm)
|
||||
|
||||
Call psb_info(ictxt, me, nprow)
|
||||
Call psb_info(ictxt, me, np)
|
||||
If(debug)Write(0,*)'BEGIN dasmatbld',me,upd,novr
|
||||
t1 = mpi_wtime()
|
||||
|
||||
|
||||
@@ -61,7 +61,7 @@ subroutine psb_dbaseprc_aply(prec,x,beta,y,desc_data,trans,work,info)
|
||||
integer :: n_row,n_col, int_err(5)
|
||||
real(kind(1.d0)), pointer :: ww(:), aux(:), tx(:),ty(:)
|
||||
character ::diagl, diagu
|
||||
integer :: ictxt,np,npcol,me,mycol,i, isz, nrg, err_act
|
||||
integer :: ictxt,np,me,i, isz, nrg, err_act
|
||||
real(kind(1.d0)) :: t1, t2, t3, t4, t5, t6, t7, mpi_wtime
|
||||
logical,parameter :: debug=.false., debugprt=.false.
|
||||
external mpi_wtime
|
||||
|
||||
@@ -63,7 +63,7 @@ subroutine psb_dbjac_aply(prec,x,beta,y,desc_data,trans,work,info)
|
||||
integer :: n_row,n_col
|
||||
real(kind(1.d0)), pointer :: ww(:), aux(:), tx(:),ty(:),tb(:)
|
||||
character ::diagl, diagu
|
||||
integer :: ictxt,np,npcol,me,mycol,i, isz, nrg, err_act, int_err(5)
|
||||
integer :: ictxt,np,me,i, nrg, err_act, int_err(5)
|
||||
real(kind(1.d0)) :: t1, t2, t3, t4, t5, t6, t7, mpi_wtime
|
||||
logical,parameter :: debug=.false., debugprt=.false.
|
||||
external mpi_wtime
|
||||
|
||||
@@ -53,7 +53,7 @@ subroutine psb_dbldaggrmat(a,desc_a,ac,p,desc_p,info)
|
||||
integer, intent(out) :: info
|
||||
|
||||
logical, parameter :: aggr_dump=.false.
|
||||
integer ::ictxt,np,npcol,me,mycol, err_act
|
||||
integer ::ictxt,np,me, err_act
|
||||
character(len=20) :: name, ch_err
|
||||
name='psb_dbldaggrmat'
|
||||
if(psb_get_errstatus().ne.0) return
|
||||
@@ -115,8 +115,8 @@ contains
|
||||
type(psb_dspmat_type) :: b, tmp
|
||||
integer, pointer :: nzbr(:), idisp(:)
|
||||
integer :: ictxt, nrow, nglob, ncol, ntaggr, nzbg, ip, ndx,&
|
||||
& naggr, np, me, mypcol, nprows, npcols,nzt,irs,jl,nzl,nlr,&
|
||||
& icomm,naggrm1, mtype, i, j, k, err_act
|
||||
& naggr, np, me, nzt,irs,jl,nzl,nlr,&
|
||||
& icomm,naggrm1, i, j, k, err_act
|
||||
name='raw_aggregate'
|
||||
if(psb_get_errstatus().ne.0) return
|
||||
info=0
|
||||
@@ -391,8 +391,8 @@ contains
|
||||
type(psb_dspmat_type) :: b
|
||||
integer, pointer :: nzbr(:), idisp(:), ivall(:)
|
||||
integer :: ictxt, nrow, nglob, ncol, ntaggr, nzbg, ip, ndx,&
|
||||
& naggr, np, me, mypcol, nprows, npcols,&
|
||||
& icomm, naggrm1,naggrp1,mtype,i,j,err_act,k,nzl
|
||||
& naggr, np, me, &
|
||||
& icomm, naggrm1,naggrp1,i,j,err_act,k,nzl
|
||||
type(psb_dspmat_type), pointer :: am1,am2
|
||||
type(psb_dspmat_type) :: am3,am4
|
||||
logical :: ml_global_nmb
|
||||
@@ -400,7 +400,7 @@ contains
|
||||
logical, parameter :: test_dump=.false.,debug=.false.
|
||||
integer, parameter :: ncmax=16
|
||||
real(kind(1.d0)) :: omega, anorm, tmp, dg
|
||||
character(len=20) :: name, ch_err
|
||||
character(len=20) :: name
|
||||
|
||||
|
||||
name='smooth_aggregate'
|
||||
@@ -555,6 +555,7 @@ contains
|
||||
! This only works with CSR.
|
||||
!
|
||||
anorm = dzero
|
||||
dg = done
|
||||
do i=1,am3%m
|
||||
tmp = dzero
|
||||
do j=am3%ia2(i),am3%ia2(i+1)-1
|
||||
@@ -770,7 +771,7 @@ contains
|
||||
end if
|
||||
|
||||
i = 1
|
||||
do ip=1,nprows
|
||||
do ip=1,np
|
||||
do k=1, p%nlaggr(ip)
|
||||
ivall(i) = ip
|
||||
i = i + 1
|
||||
|
||||
@@ -56,9 +56,8 @@ subroutine psb_ddiagsc_bld(a,desc_a,p,upd,info)
|
||||
|
||||
|
||||
! Local scalars
|
||||
Integer :: err, nnzero, n_row, n_col,I,j,k,ictxt,&
|
||||
& me,mycol,np,npcol,mglob,lw, mtype, nrg, nzg, err_act
|
||||
real(kind(1.d0)) :: temp, real_err(5)
|
||||
Integer :: err, n_row, n_col,I,j,k,ictxt,&
|
||||
& me,np,mglob,lw, err_act
|
||||
real(kind(1.d0)),pointer :: gd(:), work(:)
|
||||
integer :: int_err(5)
|
||||
character :: iupd
|
||||
|
||||
@@ -52,7 +52,7 @@ subroutine psb_dgenaggrmap(aggr_type,a,desc_a,nlaggr,ilaggr,info)
|
||||
|
||||
logical :: recovery
|
||||
logical, parameter :: debug=.false.
|
||||
integer ::ictxt,np,npcol,me,mycol,err_act
|
||||
integer ::ictxt,np,me,err_act
|
||||
integer :: nrow, ncol, n_ne
|
||||
integer, parameter :: one=1, two=2
|
||||
character(len=20) :: name, ch_err
|
||||
|
||||
@@ -75,14 +75,11 @@ subroutine psb_dilu_bld(a,desc_a,p,upd,info)
|
||||
character :: trans, unitd
|
||||
type(psb_dspmat_type) :: blck, atmp
|
||||
real(kind(1.d0)) :: t1,t2,t3,t4,t5,t6,mpi_wtime, t7, t8
|
||||
integer, pointer :: itmp(:), itmp2(:)
|
||||
real(kind(1.d0)), pointer :: rtmp(:)
|
||||
external mpi_wtime
|
||||
logical, parameter :: debugprt=.false., debug=.false., aggr_dump=.false.
|
||||
integer istpb, istpe, ifctb, ifcte, err_act, irank, icomm, nztota, nztotb,&
|
||||
& nztmp, nzl, nnr, ir, mglob, mtype, n_row, nrow_a,n_col, nhalo,lovr, &
|
||||
& ind, iind, pi,nr,ns
|
||||
integer ::ictxt,np,npcol,me,mycol
|
||||
integer nztota, nztotb, nztmp, nzl, nnr, ir, err_act,&
|
||||
& n_row, nrow_a,n_col, nhalo,lovr, ind, iind
|
||||
integer :: ictxt,np,me
|
||||
character(len=20) :: name, ch_err
|
||||
|
||||
interface psb_ilu_fct
|
||||
|
||||
@@ -64,7 +64,7 @@ subroutine psb_dmlprc_aply(baseprecv,x,beta,y,desc_data,trans,work,info)
|
||||
real(kind(1.d0)), allocatable :: tx(:),ty(:),t2l(:),w2l(:),&
|
||||
& x2l(:),b2l(:),tz(:),tty(:)
|
||||
character ::diagl, diagu
|
||||
integer :: ictxt,np,npcol,me,mycol,i, isz, nrg,nr2l,err_act, iptype, int_err(5)
|
||||
integer :: ictxt,np,me,i, isz, nrg,nr2l,err_act, iptype, int_err(5)
|
||||
real(kind(1.d0)) :: omega
|
||||
real(kind(1.d0)) :: t1, t2, t3, t4, t5, t6, t7, mpi_wtime
|
||||
logical, parameter :: debug=.false., debugprt=.false.
|
||||
|
||||
@@ -96,7 +96,7 @@ subroutine psb_dmlprc_bld(a,desc_a,p,info)
|
||||
end subroutine psb_dbldaggrmat
|
||||
end interface
|
||||
|
||||
integer :: ictxt, nprow, npcol, me, mycol
|
||||
integer :: ictxt, np, me
|
||||
|
||||
name='psb_mlprec_bld'
|
||||
if(psb_get_errstatus().ne.0) return
|
||||
|
||||
@@ -55,10 +55,10 @@ subroutine psb_dprc_aply(prec,x,y,desc_data,info,trans, work)
|
||||
! Local variables
|
||||
character :: trans_
|
||||
real(kind(1.d0)), pointer :: work_(:)
|
||||
integer :: ictxt,np,npcol,me,mycol,err_act, int_err(5)
|
||||
logical,parameter :: debug=.false., debugprt=.false.
|
||||
integer :: ictxt,np,me,err_act
|
||||
logical,parameter :: debug=.false., debugprt=.false.
|
||||
external mpi_wtime
|
||||
character(len=20) :: name, ch_err
|
||||
character(len=20) :: name
|
||||
|
||||
interface psb_baseprc_aply
|
||||
subroutine psb_dbaseprc_aply(prec,x,beta,y,desc_data,trans,work,info)
|
||||
@@ -220,9 +220,9 @@ subroutine psb_dprc_aply1(prec,x,desc_data,info,trans)
|
||||
|
||||
! Local variables
|
||||
character :: trans_
|
||||
integer :: ictxt,np,npcol,me,mycol,i, isz, err_act, int_err(5)
|
||||
integer :: ictxt,np,me,i, err_act
|
||||
real(kind(1.d0)), pointer :: WW(:), w1(:)
|
||||
character(len=20) :: name, ch_err
|
||||
character(len=20) :: name
|
||||
name='psb_dprec1'
|
||||
info = 0
|
||||
call psb_erractionsave(err_act)
|
||||
|
||||
@@ -83,9 +83,7 @@ subroutine psb_dprecbld(a,desc_a,p,info,upd)
|
||||
end interface
|
||||
|
||||
! Local scalars
|
||||
Integer :: err, nnzero, I,j,k,ictxt,&
|
||||
& me,mycol,np,npcol,lw, mtype, nrg, nzg, err_act
|
||||
real(kind(1.d0)) :: temp, real_err(5)
|
||||
Integer :: err, I,j,k,ictxt, me,np,lw, err_act
|
||||
integer :: int_err(5)
|
||||
character :: iupd
|
||||
|
||||
|
||||
@@ -49,11 +49,8 @@ subroutine psb_dprecfree(p,info)
|
||||
integer, intent(out) :: info
|
||||
|
||||
!...locals....
|
||||
integer :: int_err(5)
|
||||
integer :: temp(1), me
|
||||
real(kind(1.d0)) :: real_err(5)
|
||||
integer :: ictxt,err_act,i
|
||||
character(len=20) :: name, ch_err
|
||||
integer :: ictxt,me,np,err_act,i
|
||||
character(len=20) :: name
|
||||
|
||||
if(psb_get_errstatus().ne.0) return
|
||||
info=0
|
||||
|
||||
@@ -52,7 +52,7 @@ subroutine psb_dslu_bld(a,desc_a,p,info)
|
||||
type(psb_dspmat_type) :: blck, atmp
|
||||
character(len=5) :: fmt
|
||||
character :: upd='F'
|
||||
integer :: i,j,nza,nzb,nzt,ictxt, me,mycol,np,npcol,err_act
|
||||
integer :: i,j,nza,nzb,nzt,ictxt,me,np,err_act
|
||||
logical, parameter :: debug=.false.
|
||||
character(len=20) :: name, ch_err
|
||||
|
||||
|
||||
@@ -55,10 +55,9 @@ subroutine psb_dsp_renum(a,desc_a,blck,p,atmp,info)
|
||||
|
||||
|
||||
character(len=20) :: name, ch_err
|
||||
integer istpb, istpe, ifctb, ifcte, err_act, irank, icomm, nztota, nztotb,&
|
||||
& nztmp, nzl, nnr, ir, mglob, mtype, n_row, nrow_a,n_col, nhalo,lovr, &
|
||||
& ind, iind, pi,nr,ns,i,j,jj,k,kk
|
||||
integer ::ictxt,np,npcol,me,mycol
|
||||
integer nztota, nztotb, nztmp, nzl, nnr, ir, mglob, mtype, n_row, &
|
||||
& nrow_a,n_col, nhalo,lovr, ind, iind, pi,nr,ns,i,j,jj,k,kk
|
||||
integer ::ictxt,np,me, err_act
|
||||
integer, pointer :: itmp(:), itmp2(:)
|
||||
real(kind(1.d0)), pointer :: rtmp(:)
|
||||
real(kind(1.d0)) :: t1,t2,t3,t4,t5,t6,mpi_wtime, t7, t8
|
||||
@@ -112,7 +111,7 @@ subroutine psb_dsp_renum(a,desc_a,blck,p,atmp,info)
|
||||
t3 = mpi_wtime()
|
||||
|
||||
! Build ATMP with new numbering.
|
||||
|
||||
nztmp=size(atmp%aspk)
|
||||
allocate(itmp(max(8,atmp%m+2,nztmp+2)),rtmp(atmp%m),stat=info)
|
||||
if (info /= 0) then
|
||||
call psb_errpush(4010,name,a_err='Allocate')
|
||||
@@ -204,7 +203,7 @@ subroutine psb_dsp_renum(a,desc_a,blck,p,atmp,info)
|
||||
enddo
|
||||
enddo
|
||||
atmp%ia2(a%m+1) = a%ia2(a%m+1)
|
||||
|
||||
nztota = atmp%ia2(a%m+1) -1
|
||||
if (blck%m>0) then
|
||||
do i=1, blck%m
|
||||
atmp%ia2(a%m+i) = nztota+blck%ia2(i)
|
||||
|
||||
@@ -52,7 +52,7 @@ subroutine psb_dumf_bld(a,desc_a,p,info)
|
||||
type(psb_dspmat_type) :: blck, atmp
|
||||
character(len=5) :: fmt
|
||||
character :: upd='F'
|
||||
integer :: i,j,nza,nzb,nzt,ictxt, me,mycol,np,npcol,err_act
|
||||
integer :: i,j,nza,nzb,nzt,ictxt,me,np,err_act
|
||||
integer :: i_err(5)
|
||||
logical, parameter :: debug=.false.
|
||||
character(len=20) :: name, ch_err
|
||||
|
||||
@@ -75,13 +75,12 @@ Subroutine psb_zasmatbld(ptype,novr,a,blk,desc_data,upd,desc_p,info,outfmt)
|
||||
|
||||
real(kind(1.d0)) :: t1,t2,t3,mpi_wtime
|
||||
external mpi_wtime
|
||||
integer idscb,idsce,iovrb,iovre, err, irank, icomm
|
||||
integer icomm
|
||||
|
||||
! .. Local Scalars ..
|
||||
Integer :: k, tot_elem,proc,&
|
||||
& point,nprow,npcol, me, mycol, start,m,nnzero,&
|
||||
& ictxt, lovr, n_col, linp,ier,n,int_err(5),&
|
||||
& tot_recv, ircode, n_row, nztot,nhalo, nrow_a,err_act
|
||||
Integer :: k, np,me,m,nnzero,&
|
||||
& ictxt, n_col,ier,n,int_err(5),&
|
||||
& tot_recv, ircode, n_row,nhalo, nrow_a,err_act
|
||||
Logical,Parameter :: debug=.false., debugprt=.false.
|
||||
character(len=20) :: name, ch_err
|
||||
name='psb_zasmatbld'
|
||||
@@ -172,9 +171,9 @@ Subroutine psb_zasmatbld(ptype,novr,a,blk,desc_data,upd,desc_p,info,outfmt)
|
||||
return
|
||||
endif
|
||||
|
||||
call blacs_get(ictxt,10,icomm )
|
||||
call psb_get_mpicomm(ictxt,icomm)
|
||||
|
||||
Call psb_info(ictxt, me, nprow)
|
||||
Call psb_info(ictxt, me, np)
|
||||
If(debug)Write(0,*)'BEGIN dasmatbld',me,upd,novr
|
||||
t1 = mpi_wtime()
|
||||
|
||||
@@ -198,9 +197,6 @@ Subroutine psb_zasmatbld(ptype,novr,a,blk,desc_data,upd,desc_p,info,outfmt)
|
||||
t2 = mpi_wtime()
|
||||
|
||||
if (debug) write(0,*) 'Before sphalo ',blk%fida,blk%m,psb_nnz_,blk%infoa(psb_nnz_)
|
||||
!!$ ierr = MPE_Log_event( iovrb, 0, "st OVR" )
|
||||
!!$ blk%m = n_row-nrow_a
|
||||
!!$ blk%k = n_row
|
||||
|
||||
if (present(outfmt)) then
|
||||
if(debug) write(0,*) me,': Calling SPHALO with ',size(blk%ia2)
|
||||
@@ -219,7 +215,6 @@ Subroutine psb_zasmatbld(ptype,novr,a,blk,desc_data,upd,desc_p,info,outfmt)
|
||||
end if
|
||||
|
||||
if (debug) write(0,*) 'After psb_sphalo ',blk%fida,blk%m,psb_nnz_,blk%infoa(psb_nnz_)
|
||||
!!$ ierr = MPE_Log_event( iovre, 0, "ed OVR" )
|
||||
|
||||
t3 = mpi_wtime()
|
||||
if (debugprt) then
|
||||
|
||||
@@ -61,7 +61,7 @@ subroutine psb_zbaseprc_aply(prec,x,beta,y,desc_data,trans,work,info)
|
||||
integer :: n_row,n_col, int_err(5)
|
||||
complex(kind(1.d0)), pointer :: ww(:), aux(:), tx(:),ty(:)
|
||||
character ::diagl, diagu
|
||||
integer :: ictxt,np,npcol,me,mycol,i, isz, nrg, err_act
|
||||
integer :: ictxt,np,me,i, isz, nrg, err_act
|
||||
real(kind(1.d0)) :: t1, t2, t3, t4, t5, t6, t7, mpi_wtime
|
||||
logical,parameter :: debug=.false., debugprt=.false.
|
||||
external mpi_wtime
|
||||
|
||||
@@ -63,7 +63,7 @@ subroutine psb_zbjac_aply(prec,x,beta,y,desc_data,trans,work,info)
|
||||
integer :: n_row,n_col
|
||||
complex(kind(1.d0)), pointer :: ww(:), aux(:), tx(:),ty(:),tb(:)
|
||||
character ::diagl, diagu
|
||||
integer :: ictxt,np,npcol,me,mycol,i, isz, nrg, err_act, int_err(5)
|
||||
integer :: ictxt,np,me,i, isz, nrg, err_act, int_err(5)
|
||||
real(kind(1.d0)) :: t1, t2, t3, t4, t5, t6, t7, mpi_wtime
|
||||
logical,parameter :: debug=.false., debugprt=.false.
|
||||
external mpi_wtime
|
||||
|
||||
@@ -53,7 +53,7 @@ subroutine psb_zbldaggrmat(a,desc_a,ac,p,desc_p,info)
|
||||
integer, intent(out) :: info
|
||||
|
||||
logical, parameter :: aggr_dump=.false.
|
||||
integer ::ictxt,np,npcol,me,mycol, err_act
|
||||
integer ::ictxt,np,me, err_act
|
||||
character(len=20) :: name, ch_err
|
||||
name='psb_zbldaggrmat'
|
||||
if(psb_get_errstatus().ne.0) return
|
||||
@@ -115,8 +115,8 @@ contains
|
||||
type(psb_zspmat_type) :: b, tmp
|
||||
integer, pointer :: nzbr(:), idisp(:)
|
||||
integer :: ictxt, nrow, nglob, ncol, ntaggr, nzbg, ip, ndx,&
|
||||
& naggr, np, me, mypcol, nprows, npcols,nzt,irs,jl,nzl,nlr,&
|
||||
& icomm,naggrm1, mtype, i, j, k, err_act
|
||||
& naggr, np, me, nzt,irs,jl,nzl,nlr,&
|
||||
& icomm,naggrm1, i, j, k, err_act
|
||||
name='raw_aggregate'
|
||||
if(psb_get_errstatus().ne.0) return
|
||||
info=0
|
||||
@@ -391,8 +391,8 @@ contains
|
||||
type(psb_zspmat_type) :: b
|
||||
integer, pointer :: nzbr(:), idisp(:), ivall(:)
|
||||
integer :: ictxt, nrow, nglob, ncol, ntaggr, nzbg, ip, ndx,&
|
||||
& naggr, np, me, mypcol, nprows, npcols,&
|
||||
& icomm, naggrm1,naggrp1,mtype,i,j,err_act,k,nzl
|
||||
& naggr, np, me,&
|
||||
& icomm, naggrm1,naggrp1,i,j,err_act,k,nzl
|
||||
type(psb_zspmat_type), pointer :: am1,am2
|
||||
type(psb_zspmat_type) :: am3,am4
|
||||
logical :: ml_global_nmb
|
||||
@@ -400,7 +400,7 @@ contains
|
||||
logical, parameter :: test_dump=.false., debug=.false.
|
||||
integer, parameter :: ncmax=16
|
||||
real(kind(1.d0)) :: omega, anorm, tmp, dg
|
||||
character(len=20) :: name, ch_err
|
||||
character(len=20) :: name
|
||||
|
||||
|
||||
name='smooth_aggregate'
|
||||
@@ -555,6 +555,7 @@ contains
|
||||
! This only works with CSR.
|
||||
!
|
||||
anorm = dzero
|
||||
dg = done
|
||||
do i=1,am3%m
|
||||
tmp = dzero
|
||||
do j=am3%ia2(i),am3%ia2(i+1)-1
|
||||
@@ -770,7 +771,7 @@ contains
|
||||
end if
|
||||
|
||||
i = 1
|
||||
do ip=1,nprows
|
||||
do ip=1,np
|
||||
do k=1, p%nlaggr(ip)
|
||||
ivall(i) = ip
|
||||
i = i + 1
|
||||
|
||||
@@ -56,9 +56,8 @@ subroutine psb_zdiagsc_bld(a,desc_a,p,upd,info)
|
||||
|
||||
|
||||
! Local scalars
|
||||
Integer :: err, nnzero, n_row, n_col,I,j,k,ictxt,&
|
||||
& me,mycol,np,npcol,mglob,lw, mtype, nrg, nzg, err_act
|
||||
real(kind(1.d0)) :: temp, real_err(5)
|
||||
Integer :: err, n_row, n_col,I,j,k,ictxt,&
|
||||
& me,np,mglob,lw, err_act
|
||||
complex(kind(1.d0)),pointer :: gd(:), work(:)
|
||||
integer :: int_err(5)
|
||||
character :: iupd
|
||||
|
||||
@@ -52,7 +52,7 @@ subroutine psb_zgenaggrmap(aggr_type,a,desc_a,nlaggr,ilaggr,info)
|
||||
|
||||
logical :: recovery
|
||||
logical, parameter :: debug=.false.
|
||||
integer ::ictxt,np,npcol,me,mycol,err_act
|
||||
integer ::ictxt,np,me,err_act
|
||||
integer :: nrow, ncol, n_ne
|
||||
integer, parameter :: one=1, two=2
|
||||
character(len=20) :: name, ch_err
|
||||
|
||||
@@ -75,13 +75,11 @@ subroutine psb_zilu_bld(a,desc_a,p,upd,info)
|
||||
character :: trans, unitd
|
||||
type(psb_zspmat_type) :: blck, atmp
|
||||
real(kind(1.d0)) :: t1,t2,t3,t4,t5,t6,mpi_wtime, t7, t8
|
||||
integer, pointer :: itmp(:), itmp2(:)
|
||||
external mpi_wtime
|
||||
logical, parameter :: debugprt=.false., debug=.false., aggr_dump=.false.
|
||||
integer istpb, istpe, ifctb, ifcte, err_act, irank, icomm, nztota, nztotb,&
|
||||
& nztmp, nzl, nnr, ir, mglob, mtype, n_row, nrow_a,n_col, nhalo,lovr, &
|
||||
& ind, iind, pi,nr,ns
|
||||
integer ::ictxt,np,npcol,me,mycol
|
||||
integer nztota, nztotb, nztmp, nzl, nnr, ir, err_act, &
|
||||
& n_row, nrow_a,n_col, nhalo,lovr, ind, iind
|
||||
integer :: ictxt,np,me
|
||||
character(len=20) :: name, ch_err
|
||||
|
||||
interface psb_ilu_fct
|
||||
|
||||
@@ -64,7 +64,7 @@ subroutine psb_zmlprc_aply(baseprecv,x,beta,y,desc_data,trans,work,info)
|
||||
complex(kind(1.d0)), allocatable :: tx(:),ty(:),t2l(:),w2l(:),&
|
||||
& x2l(:),b2l(:),tz(:),tty(:)
|
||||
character ::diagl, diagu
|
||||
integer :: ictxt,np,npcol,me,mycol,i, isz, nrg,nr2l,err_act, iptype, int_err(5)
|
||||
integer :: ictxt,np,me,i, isz, nrg,nr2l,err_act, iptype, int_err(5)
|
||||
real(kind(1.d0)) :: omega
|
||||
real(kind(1.d0)) :: t1, t2, t3, t4, t5, t6, t7, mpi_wtime
|
||||
logical, parameter :: debug=.false., debugprt=.false.
|
||||
|
||||
@@ -96,7 +96,7 @@ subroutine psb_zmlprc_bld(a,desc_a,p,info)
|
||||
end subroutine psb_zbldaggrmat
|
||||
end interface
|
||||
|
||||
integer :: ictxt, nprow, npcol, me, mycol
|
||||
integer :: ictxt, np, me
|
||||
|
||||
name='psb_mlprec_bld'
|
||||
if(psb_get_errstatus().ne.0) return
|
||||
|
||||
@@ -55,10 +55,10 @@ subroutine psb_zprc_aply(prec,x,y,desc_data,info,trans, work)
|
||||
! Local variables
|
||||
character :: trans_
|
||||
complex(kind(1.d0)), pointer :: work_(:)
|
||||
integer :: ictxt,np,npcol,me,mycol,err_act, int_err(5)
|
||||
integer :: ictxt,np,me,err_act
|
||||
logical,parameter :: debug=.false., debugprt=.false.
|
||||
external mpi_wtime
|
||||
character(len=20) :: name, ch_err
|
||||
character(len=20) :: name
|
||||
|
||||
interface psb_baseprc_aply
|
||||
subroutine psb_zbaseprc_aply(prec,x,beta,y,desc_data,trans,work,info)
|
||||
@@ -220,7 +220,7 @@ subroutine psb_zprc_aply1(prec,x,desc_data,info,trans)
|
||||
|
||||
! Local variables
|
||||
character :: trans_
|
||||
integer :: ictxt,np,npcol,me,mycol,i, isz, err_act, int_err(5)
|
||||
integer :: ictxt,np,me,i, isz, err_act, int_err(5)
|
||||
complex(kind(1.d0)), pointer :: WW(:), w1(:)
|
||||
character(len=20) :: name, ch_err
|
||||
name='psb_zprec1'
|
||||
|
||||
@@ -83,9 +83,7 @@ subroutine psb_zprecbld(a,desc_a,p,info,upd)
|
||||
end interface
|
||||
|
||||
! Local scalars
|
||||
Integer :: err, nnzero, I,j,k,ictxt,&
|
||||
& me,mycol,np,npcol,lw, mtype, nrg, nzg, err_act
|
||||
real(kind(1.d0)) :: temp, real_err(5)
|
||||
Integer :: err,i,j,k,ictxt, me,np,lw, err_act
|
||||
integer :: int_err(5)
|
||||
character :: iupd
|
||||
|
||||
|
||||
@@ -49,11 +49,8 @@ subroutine psb_zprecfree(p,info)
|
||||
integer, intent(out) :: info
|
||||
|
||||
!...locals....
|
||||
integer :: int_err(5)
|
||||
integer :: temp(1), me
|
||||
real(kind(1.d0)) :: real_err(5)
|
||||
integer :: ictxt,err_act,i
|
||||
character(len=20) :: name, ch_err
|
||||
integer :: ictxt,me, np,err_act,i
|
||||
character(len=20) :: name
|
||||
|
||||
if(psb_get_errstatus().ne.0) return
|
||||
info=0
|
||||
|
||||
@@ -52,7 +52,7 @@ subroutine psb_zslu_bld(a,desc_a,p,info)
|
||||
type(psb_zspmat_type) :: blck, atmp
|
||||
character(len=5) :: fmt
|
||||
character :: upd='F'
|
||||
integer :: i,j,nza,nzb,nzt,ictxt, me,mycol,np,npcol,err_act
|
||||
integer :: i,j,nza,nzb,nzt,ictxt, me,np,err_act
|
||||
logical, parameter :: debug=.false.
|
||||
character(len=20) :: name, ch_err
|
||||
|
||||
|
||||
@@ -55,10 +55,9 @@ subroutine psb_zsp_renum(a,desc_a,blck,p,atmp,info)
|
||||
|
||||
|
||||
character(len=20) :: name, ch_err
|
||||
integer istpb, istpe, ifctb, ifcte, err_act, irank, icomm, nztota, nztotb,&
|
||||
& nztmp, nzl, nnr, ir, mglob, mtype, n_row, nrow_a,n_col, nhalo,lovr, &
|
||||
& ind, iind, pi,nr,ns,i,j,jj,k,kk
|
||||
integer ::ictxt,np,npcol,me,mycol
|
||||
integer nztota, nztotb, nztmp, nzl, nnr, ir, mglob, mtype, n_row, &
|
||||
& nrow_a,n_col, nhalo,lovr, ind, iind, pi,nr,ns,i,j,jj,k,kk
|
||||
integer ::ictxt,np,me, err_act
|
||||
integer, pointer :: itmp(:), itmp2(:)
|
||||
complex(kind(1.d0)), pointer :: ztmp(:)
|
||||
real(kind(1.d0)) :: t1,t2,t3,t4,t5,t6,mpi_wtime, t7, t8
|
||||
@@ -112,7 +111,7 @@ subroutine psb_zsp_renum(a,desc_a,blck,p,atmp,info)
|
||||
t3 = mpi_wtime()
|
||||
|
||||
! Build ATMP with new numbering.
|
||||
|
||||
nztmp=size(atmp%aspk)
|
||||
allocate(itmp(max(8,atmp%m+2,nztmp+2)),ztmp(atmp%m),stat=info)
|
||||
if (info /= 0) then
|
||||
call psb_errpush(4010,name,a_err='Allocate')
|
||||
@@ -204,7 +203,7 @@ subroutine psb_zsp_renum(a,desc_a,blck,p,atmp,info)
|
||||
enddo
|
||||
enddo
|
||||
atmp%ia2(a%m+1) = a%ia2(a%m+1)
|
||||
|
||||
nztota = atmp%ia2(a%m+1) -1
|
||||
if (blck%m>0) then
|
||||
do i=1, blck%m
|
||||
atmp%ia2(a%m+i) = nztota+blck%ia2(i)
|
||||
|
||||
@@ -52,7 +52,7 @@ subroutine psb_zumf_bld(a,desc_a,p,info)
|
||||
type(psb_zspmat_type) :: blck, atmp
|
||||
character(len=5) :: fmt
|
||||
character :: upd='F'
|
||||
integer :: i,j,nza,nzb,nzt,ictxt, me,mycol,np,npcol,err_act
|
||||
integer :: i,j,nza,nzb,nzt,ictxt, me,np,err_act
|
||||
integer :: i_err(5)
|
||||
logical, parameter :: debug=.false.
|
||||
character(len=20) :: name, ch_err
|
||||
|
||||
@@ -58,7 +58,7 @@ function psb_damax (x,desc_a, info, jx)
|
||||
real(kind(1.d0)) :: psb_damax
|
||||
|
||||
! locals
|
||||
integer :: int_err(5), ictxt, np, me, mycol,&
|
||||
integer :: ictxt, np, me,&
|
||||
& err_act, n, iix, jjx, ix, ijx, m, i, k, imax, idamax
|
||||
real(kind(1.d0)) :: amax
|
||||
character(len=20) :: name, ch_err
|
||||
@@ -183,7 +183,7 @@ function psb_damaxv (x,desc_a, info)
|
||||
real(kind(1.d0)) :: psb_damaxv
|
||||
|
||||
! locals
|
||||
integer :: int_err(5), err, ictxt, np, me, mycol,&
|
||||
integer :: err, ictxt, np, me,&
|
||||
& err_act, n, iix, jjx, jx, ix, ijx, m, imax, idamax
|
||||
real(kind(1.d0)) :: amax
|
||||
character(len=20) :: name, ch_err
|
||||
@@ -306,7 +306,7 @@ subroutine psb_damaxvs (res,x,desc_a, info)
|
||||
real(kind(1.D0)), intent(out) :: res
|
||||
|
||||
! locals
|
||||
integer :: int_err(5), ictxt, np, me, mycol,&
|
||||
integer :: ictxt, np, me,&
|
||||
& err_act, n, iix, jjx, ix, ijx, m, imax, idamax
|
||||
real(kind(1.d0)) :: amax
|
||||
character(len=20) :: name, ch_err
|
||||
@@ -428,7 +428,7 @@ subroutine psb_dmamaxs (res,x,desc_a, info,jx)
|
||||
real(kind(1.d0)), intent(out) :: res(:)
|
||||
|
||||
! locals
|
||||
integer :: int_err(5), ictxt, np, me, mycol,&
|
||||
integer :: ictxt, np, me,&
|
||||
& err_act, n, iix, jjx, ix, ijx, m, imax, i, k, idamax
|
||||
real(kind(1.d0)) :: amax
|
||||
character(len=20) :: name, ch_err
|
||||
|
||||
@@ -59,10 +59,10 @@ function psb_dasum (x,desc_a, info, jx)
|
||||
real(kind(1.d0)) :: psb_dasum
|
||||
|
||||
! locals
|
||||
integer :: int_err(5), ictxt, np, npcol, me, mycol,&
|
||||
& err_act, n, iix, jjx, temp(2), ix, ijx, m, i
|
||||
real(kind(1.d0)) :: asum, dasum
|
||||
character(len=20) :: name, ch_err
|
||||
integer :: ictxt, np, me, err_act, n, &
|
||||
& iix, jjx, ix, ijx, m, i
|
||||
real(kind(1.d0)) :: asum, dasum
|
||||
character(len=20) :: name, ch_err
|
||||
|
||||
name='psb_dasum'
|
||||
if(psb_get_errstatus().ne.0) return
|
||||
@@ -202,8 +202,7 @@ function psb_dasumv (x,desc_a, info)
|
||||
real(kind(1.d0)) :: psb_dasumv
|
||||
|
||||
! locals
|
||||
integer :: int_err(5), ictxt, np, npcol, me, mycol,&
|
||||
& err_act, n, iix, jjx, temp(2), jx, ix, ijx, m, i
|
||||
integer :: ictxt, np, me, err_act, n, iix, jjx, jx, ix, ijx, m, i
|
||||
real(kind(1.d0)) :: asum, dasum
|
||||
character(len=20) :: name, ch_err
|
||||
|
||||
@@ -341,8 +340,7 @@ subroutine psb_dasumvs (res,x,desc_a, info)
|
||||
integer, intent(out) :: info
|
||||
|
||||
! locals
|
||||
integer :: int_err(5), ictxt, np, npcol, me, mycol,&
|
||||
& err_act, n, iix, jjx, temp(2), ix, jx, ijx, m, i
|
||||
integer :: ictxt, np, me, err_act, n, iix, jjx, ix, jx, ijx, m, i
|
||||
real(kind(1.d0)) :: asum, dasum
|
||||
character(len=20) :: name, ch_err
|
||||
|
||||
|
||||
@@ -65,8 +65,8 @@ subroutine psb_daxpby(alpha, x, beta,y,desc_a,info, n, jx, jy)
|
||||
real(kind(1.D0)), intent(inout) :: y(:,:)
|
||||
|
||||
! locals
|
||||
integer :: int_err(5), ictxt, np, npcol, me, mycol,&
|
||||
& err_act, iix, jjx, temp(2), ix, iy, ijx, ijy, m, iiy, in, jjy
|
||||
integer :: ictxt, np, me,&
|
||||
& err_act, iix, jjx, ix, iy, ijx, ijy, m, iiy, in, jjy
|
||||
real(kind(1.d0)),pointer :: tmpx(:)
|
||||
character(len=20) :: name, ch_err
|
||||
|
||||
@@ -217,8 +217,8 @@ subroutine psb_daxpbyv(alpha, x, beta,y,desc_a,info)
|
||||
real(kind(1.D0)), intent(inout) :: y(:)
|
||||
|
||||
! locals
|
||||
integer :: int_err(5), ictxt, np, npcol, me, mycol,&
|
||||
& err_act, n, iix, jjx, temp(2), ix, iy, ijx, m, iiy, in, jjy
|
||||
integer :: ictxt, np, me,&
|
||||
& err_act, n, iix, jjx, ix, iy, ijx, m, iiy, in, jjy
|
||||
character(len=20) :: name, ch_err
|
||||
logical, parameter :: debug=.false.
|
||||
|
||||
|
||||
@@ -61,8 +61,8 @@ function psb_ddot(x, y,desc_a, info, jx, jy)
|
||||
real(kind(1.D0)) :: psb_ddot
|
||||
|
||||
! locals
|
||||
integer :: int_err(5), ictxt, np, npcol, me, mycol,&
|
||||
& err_act, n, iix, jjx, temp(2), ix, ijx, iy, ijy, iiy, jjy, i, m, j, k
|
||||
integer :: ictxt, np, me,&
|
||||
& err_act, n, iix, jjx, ix, ijx, iy, ijy, iiy, jjy, i, m, j, k
|
||||
real(kind(1.D0)) :: dot_local
|
||||
real(kind(1.d0)) :: ddot
|
||||
character(len=20) :: name, ch_err
|
||||
@@ -214,8 +214,8 @@ function psb_ddotv(x, y,desc_a, info)
|
||||
real(kind(1.D0)) :: psb_ddotv
|
||||
|
||||
! locals
|
||||
integer :: int_err(5), ictxt, np, npcol, me, mycol,&
|
||||
& err_act, n, iix, jjx, temp(2), ix, jx, iy, jy, iiy, jjy, i, m, j, k
|
||||
integer :: int_err(5), ictxt, np, me,&
|
||||
& err_act, n, iix, jjx, ix, jx, iy, jy, iiy, jjy, i, m, j, k
|
||||
real(kind(1.D0)) :: dot_local
|
||||
real(kind(1.d0)) :: ddot
|
||||
character(len=20) :: name, ch_err
|
||||
@@ -351,8 +351,8 @@ subroutine psb_ddotvs(res, x, y,desc_a, info)
|
||||
integer, intent(out) :: info
|
||||
|
||||
! locals
|
||||
integer :: int_err(5), ictxt, np, npcol, me, mycol,&
|
||||
& err_act, n, iix, jjx, temp(2), ix, ijx, iy, ijy, iiy, jjy, i, m, j, k
|
||||
integer :: int_err(5), ictxt, np, me,&
|
||||
& err_act, n, iix, jjx, ix, ijx, iy, ijy, iiy, jjy, i, m, j, k
|
||||
real(kind(1.D0)) :: dot_local
|
||||
real(kind(1.d0)) :: ddot
|
||||
character(len=20) :: name, ch_err
|
||||
@@ -491,8 +491,8 @@ subroutine psb_dmdots(res, x, y, desc_a, info)
|
||||
integer, intent(out) :: info
|
||||
|
||||
! locals
|
||||
integer :: int_err(5), ictxt, np, npcol, me, mycol,&
|
||||
& err_act, n, iix, jjx, temp(2), ix, ijx, iy, ijy, iiy, jjy, i, m, j, k
|
||||
integer :: int_err(5), ictxt, np, me,&
|
||||
& err_act, n, iix, jjx, ix, ijx, iy, ijy, iiy, jjy, i, m, j, k
|
||||
real(kind(1.d0)),allocatable :: dot_local(:)
|
||||
real(kind(1.d0)) :: ddot
|
||||
character(len=20) :: name, ch_err
|
||||
|
||||
@@ -57,8 +57,8 @@ function psb_dnrm2(x, desc_a, info, jx)
|
||||
real(kind(1.D0)) :: psb_dnrm2
|
||||
|
||||
! locals
|
||||
integer :: int_err(5), ictxt, np, npcol, me, mycol,&
|
||||
& err_act, n, iix, jjx, temp(2), ndim, ix, ijx, i, m, id
|
||||
integer :: ictxt, np, me,&
|
||||
& err_act, n, iix, jjx, ndim, ix, ijx, i, m, id
|
||||
real(kind(1.d0)) :: nrm2, dnrm2, dd
|
||||
external dcombnrm2
|
||||
character(len=20) :: name, ch_err
|
||||
@@ -194,8 +194,8 @@ function psb_dnrm2v(x, desc_a, info)
|
||||
real(kind(1.D0)) :: psb_dnrm2v
|
||||
|
||||
! locals
|
||||
integer :: int_err(5), ictxt, np, npcol, me, mycol,&
|
||||
& err_act, n, iix, jjx, temp(2), ndim, ix, jx, ijx, i, m, id
|
||||
integer :: ictxt, np, me,&
|
||||
& err_act, n, iix, jjx, ndim, ix, jx, ijx, i, m, id
|
||||
real(kind(1.d0)) :: nrm2, dnrm2, dd
|
||||
external dcombnrm2
|
||||
character(len=20) :: name, ch_err
|
||||
@@ -330,8 +330,8 @@ subroutine psb_dnrm2vs(res, x, desc_a, info)
|
||||
integer, intent(out) :: info
|
||||
|
||||
! locals
|
||||
integer :: int_err(5), ictxt, np, npcol, me, mycol,&
|
||||
& err_act, n, iix, jjx, temp(2), ndim, ix, jx, ijx, i, m, id
|
||||
integer :: ictxt, np, me,&
|
||||
& err_act, n, iix, jjx, ndim, ix, jx, ijx, i, m, id
|
||||
real(kind(1.d0)) :: nrm2, dnrm2, dd
|
||||
external dcombnrm2
|
||||
character(len=20) :: name, ch_err
|
||||
|
||||
@@ -54,7 +54,7 @@ function psb_dnrmi(a,desc_a,info)
|
||||
real(kind(1.d0)) :: psb_dnrmi
|
||||
|
||||
! locals
|
||||
integer :: int_err(5), ictxt, np, npcol, me, mycol,&
|
||||
integer :: ictxt, np, me,&
|
||||
& err_act, n, iia, jja, ia, ja, mdim, ndim, m
|
||||
real(kind(1.d0)) :: nrmi, dcsnmi
|
||||
character(len=20) :: name, ch_err
|
||||
|
||||
@@ -102,12 +102,12 @@ subroutine psb_dspmm(alpha,a,x,beta,y,desc_a,info,&
|
||||
integer, intent(in), optional :: k, jx, jy,doswap
|
||||
|
||||
! locals
|
||||
integer :: int_err(5), ictxt, np, npcol, me, mycol,&
|
||||
& err_act, n, iix, jjx, ia, ja, iia, jja, temp(2), ix, iy, ik, ijx, ijy,&
|
||||
integer :: ictxt, np, me,&
|
||||
& err_act, n, iix, jjx, ia, ja, iia, jja, ix, iy, ik, ijx, ijy,&
|
||||
& idoswap, m, nrow, ncol, lldx, lldy, liwork, llwork, iiy, jjy,&
|
||||
& i, ib, ib1
|
||||
integer, parameter :: nb=4
|
||||
real(kind(1.d0)),pointer :: tmpx(:), xp(:,:), yp(:,:), iwork(:)
|
||||
real(kind(1.d0)),pointer :: xp(:,:), yp(:,:), iwork(:)
|
||||
character :: itrans
|
||||
character(len=20) :: name, ch_err
|
||||
logical :: aliw
|
||||
@@ -437,8 +437,8 @@ subroutine psb_dspmv(alpha,a,x,beta,y,desc_a,info,&
|
||||
integer, intent(in), optional :: doswap
|
||||
|
||||
! locals
|
||||
integer :: int_err(5), ictxt, np, npcol, me, mycol,&
|
||||
& err_act, n, iix, jjx, ia, ja, iia, jja, temp(2), ix, iy, ik, ijx, ijy,&
|
||||
integer :: ictxt, np, me,&
|
||||
& err_act, n, iix, jjx, ia, ja, iia, jja, ix, iy, ik, ijx, ijy,&
|
||||
& idoswap, m, nrow, ncol, lldx, lldy, liwork, llwork, jx, jy, iiy, jjy,&
|
||||
& i, ib, ib1
|
||||
integer, parameter :: nb=4
|
||||
|
||||
@@ -98,10 +98,10 @@ subroutine psb_dspsm(alpha,a,x,beta,y,desc_a,info,&
|
||||
integer, intent(in), optional :: k, jx, jy
|
||||
|
||||
! locals
|
||||
integer :: int_err(5), ictxt, np, npcol, me, mycol,&
|
||||
& err_act, n, iix, jjx, ia, ja, iia, jja, temp(2), lldx,lldy, lchoice,&
|
||||
integer :: int_err(5), ictxt, np, me,&
|
||||
& err_act, n, iix, jjx, ia, ja, iia, jja, lldx,lldy, lchoice,&
|
||||
& ix, iy, ik, ijx, ijy, i, lld,&
|
||||
& idoswap, m, nrow, ncol, liwork, llwork, iiy, jjy
|
||||
& m, nrow, ncol, liwork, llwork, iiy, jjy
|
||||
|
||||
character :: lunitd
|
||||
integer, parameter :: nb=4
|
||||
@@ -400,10 +400,10 @@ subroutine psb_dspsv(alpha,a,x,beta,y,desc_a,info,&
|
||||
integer, intent(in), optional :: choice
|
||||
|
||||
! locals
|
||||
integer :: int_err(5), ictxt, np, npcol, me, mycol,&
|
||||
& err_act, n, iix, jjx, ia, ja, iia, jja, temp(2), lldx,lldy, lchoice,&
|
||||
integer :: int_err(5), ictxt, np, me,&
|
||||
& err_act, n, iix, jjx, ia, ja, iia, jja, lldx,lldy, lchoice,&
|
||||
& ix, iy, ik, jx, jy, i, lld,&
|
||||
& idoswap, m, nrow, ncol, liwork, llwork, iiy, jjy
|
||||
& m, nrow, ncol, liwork, llwork, iiy, jjy
|
||||
|
||||
character :: lunitd
|
||||
integer, parameter :: nb=4
|
||||
|
||||
@@ -58,8 +58,8 @@ function psb_zamax (x,desc_a, info, jx)
|
||||
real(kind(1.d0)) :: psb_zamax
|
||||
|
||||
! locals
|
||||
integer :: int_err(5), ictxt, np, me, mycol,&
|
||||
& err_act, n, iix, jjx, temp(2), ix, ijx, m, i, k, imax, izamax
|
||||
integer :: ictxt, np, me,&
|
||||
& err_act, n, iix, jjx, ix, ijx, m, i, k, imax, izamax
|
||||
real(kind(1.d0)) :: amax
|
||||
character(len=20) :: name, ch_err
|
||||
double complex :: zdum
|
||||
@@ -186,8 +186,8 @@ function psb_zamaxv (x,desc_a, info)
|
||||
real(kind(1.d0)) :: psb_zamaxv
|
||||
|
||||
! locals
|
||||
integer :: int_err(5), err, ictxt, np, me, mycol,&
|
||||
& err_act, n, iix, jjx, jx, temp(2), ix, ijx, m, imax, izamax
|
||||
integer :: ictxt, np, me,&
|
||||
& err_act, n, iix, jjx, jx, ix, ijx, m, imax, izamax
|
||||
real(kind(1.d0)) :: amax
|
||||
complex(kind(1.d0)) :: cmax
|
||||
character(len=20) :: name, ch_err
|
||||
@@ -314,8 +314,8 @@ subroutine psb_zamaxvs (res,x,desc_a, info)
|
||||
real(kind(1.D0)), intent(out) :: res
|
||||
|
||||
! locals
|
||||
integer :: int_err(5), ictxt, np, me, mycol,&
|
||||
& err_act, n, iix, jjx, temp(2), ix, ijx, m, imax, izamax
|
||||
integer :: ictxt, np, me,&
|
||||
& err_act, n, iix, jjx, ix, ijx, m, imax, izamax
|
||||
real(kind(1.d0)) :: amax
|
||||
character(len=20) :: name, ch_err
|
||||
complex(kind(1.d0)) :: cmax
|
||||
@@ -441,8 +441,8 @@ subroutine psb_zmamaxs (res,x,desc_a, info,jx)
|
||||
real(kind(1.d0)), intent(out) :: res(:)
|
||||
|
||||
! locals
|
||||
integer :: int_err(5), ictxt, np, me, mycol,&
|
||||
& err_act, n, iix, jjx, ix, temp(2), ijx, m, imax, i, k, izamax
|
||||
integer :: ictxt, np, me,&
|
||||
& err_act, n, iix, jjx, ix, ijx, m, imax, i, k, izamax
|
||||
real(kind(1.d0)) :: amax
|
||||
character(len=20) :: name, ch_err
|
||||
complex(kind(1.d0)) :: cmax
|
||||
|
||||
@@ -207,8 +207,8 @@ function psb_zasumv (x,desc_a, info)
|
||||
real(kind(1.d0)) :: psb_zasumv
|
||||
|
||||
! locals
|
||||
integer :: int_err(5), ictxt, np, npcol, me, mycol,&
|
||||
& err_act, n, iix, jjx, temp(2), jx, ix, ijx, m, i
|
||||
integer :: ictxt, np, me,&
|
||||
& err_act, n, iix, jjx, jx, ix, ijx, m, i
|
||||
real(kind(1.d0)) :: asum, dzasum
|
||||
character(len=20) :: name, ch_err
|
||||
complex(kind(1.d0)) :: cmax
|
||||
@@ -351,8 +351,8 @@ subroutine psb_zasumvs (res,x,desc_a, info)
|
||||
integer, intent(out) :: info
|
||||
|
||||
! locals
|
||||
integer :: int_err(5), ictxt, np, npcol, me, mycol,&
|
||||
& err_act, n, iix, jjx, temp(2), ix, jx, ijx, m, i
|
||||
integer :: ictxt, np, me,&
|
||||
& err_act, n, iix, jjx, ix, jx, ijx, m, i
|
||||
real(kind(1.d0)) :: asum, dzasum
|
||||
character(len=20) :: name, ch_err
|
||||
complex(kind(1.d0)) :: cmax
|
||||
@@ -438,6 +438,3 @@ subroutine psb_zasumvs (res,x,desc_a, info)
|
||||
end if
|
||||
return
|
||||
end subroutine psb_zasumvs
|
||||
|
||||
|
||||
|
||||
|
||||
@@ -65,8 +65,8 @@ subroutine psb_zaxpby(alpha, x, beta,y,desc_a,info, n, jx, jy)
|
||||
complex(kind(1.D0)), intent(inout) :: y(:,:)
|
||||
|
||||
! locals
|
||||
integer :: int_err(5), ictxt, np, npcol, me, mycol,&
|
||||
& err_act, iix, jjx, temp(2), ix, iy, ijx, ijy, m, iiy, in, jjy
|
||||
integer :: ictxt, np, me,&
|
||||
& err_act, iix, jjx, ix, iy, ijx, ijy, m, iiy, in, jjy
|
||||
character(len=20) :: name, ch_err
|
||||
|
||||
name='psb_dgeaxpby'
|
||||
@@ -216,8 +216,8 @@ subroutine psb_zaxpbyv(alpha, x, beta,y,desc_a,info)
|
||||
complex(kind(1.D0)), intent(inout) :: y(:)
|
||||
|
||||
! locals
|
||||
integer :: int_err(5), ictxt, np, npcol, me, mycol,&
|
||||
& err_act, n, iix, jjx, temp(2), ix, iy, ijx, m, iiy, in, jjy
|
||||
integer :: ictxt, np, me,&
|
||||
& err_act, n, iix, jjx, ix, iy, ijx, m, iiy, in, jjy
|
||||
character(len=20) :: name, ch_err
|
||||
logical, parameter :: debug=.false.
|
||||
|
||||
|
||||
@@ -61,8 +61,8 @@ function psb_zdot(x, y,desc_a, info, jx, jy)
|
||||
complex(kind(1.D0)) :: psb_zdot
|
||||
|
||||
! locals
|
||||
integer :: int_err(5), ictxt, np, npcol, me, mycol,&
|
||||
& err_act, n, iix, jjx, temp(2), ix, ijx, iy, ijy, iiy, jjy, i, m, j, k
|
||||
integer :: ictxt, np, me,&
|
||||
& err_act, n, iix, jjx, ix, ijx, iy, ijy, iiy, jjy, i, m, j, k
|
||||
complex(kind(1.D0)) :: dot_local
|
||||
complex(kind(1.d0)) :: zdotc
|
||||
character(len=20) :: name, ch_err
|
||||
@@ -214,8 +214,8 @@ function psb_zdotv(x, y,desc_a, info)
|
||||
complex(kind(1.D0)) :: psb_zdotv
|
||||
|
||||
! locals
|
||||
integer :: int_err(5), ictxt, np, npcol, me, mycol,&
|
||||
& err_act, n, iix, jjx, temp(2), ix, jx, iy, jy, iiy, jjy, i, m, j, k
|
||||
integer :: ictxt, np, me,&
|
||||
& err_act, n, iix, jjx, ix, jx, iy, jy, iiy, jjy, i, m, j, k
|
||||
complex(kind(1.D0)) :: dot_local
|
||||
complex(kind(1.d0)) :: zdotc
|
||||
character(len=20) :: name, ch_err
|
||||
@@ -351,8 +351,8 @@ subroutine psb_zdotvs(res, x, y,desc_a, info)
|
||||
integer, intent(out) :: info
|
||||
|
||||
! locals
|
||||
integer :: int_err(5), ictxt, np, npcol, me, mycol,&
|
||||
& err_act, n, iix, jjx, temp(2), ix, ijx, iy, ijy, iiy, jjy, i, m, j, k
|
||||
integer :: ictxt, np, me,&
|
||||
& err_act, n, iix, jjx, ix, ijx, iy, ijy, iiy, jjy, i, m, j, k
|
||||
complex(kind(1.D0)) :: dot_local
|
||||
complex(kind(1.d0)) :: zdotc
|
||||
character(len=20) :: name, ch_err
|
||||
@@ -491,8 +491,8 @@ subroutine psb_zmdots(res, x, y, desc_a, info)
|
||||
integer, intent(out) :: info
|
||||
|
||||
! locals
|
||||
integer :: int_err(5), ictxt, np, npcol, me, mycol,&
|
||||
& err_act, n, iix, jjx, temp(2), ix, ijx, iy, ijy, iiy, jjy, i, m, j, k
|
||||
integer :: ictxt, np, me,&
|
||||
& err_act, n, iix, jjx, ix, ijx, iy, ijy, iiy, jjy, i, m, j, k
|
||||
complex(kind(1.d0)),allocatable :: dot_local(:)
|
||||
complex(kind(1.d0)) :: zdotc
|
||||
character(len=20) :: name, ch_err
|
||||
|
||||
@@ -57,8 +57,8 @@ function psb_znrm2(x, desc_a, info, jx)
|
||||
real(kind(1.D0)) :: psb_znrm2
|
||||
|
||||
! locals
|
||||
integer :: int_err(5), ictxt, np, npcol, me, mycol,&
|
||||
& err_act, n, iix, jjx, temp(2), ndim, ix, ijx, i, m, id
|
||||
integer :: ictxt, np, me,&
|
||||
& err_act, n, iix, jjx, ndim, ix, ijx, i, m, id
|
||||
real(kind(1.d0)) :: nrm2, dznrm2, dd
|
||||
|
||||
external dcombnrm2
|
||||
@@ -194,8 +194,8 @@ function psb_znrm2v(x, desc_a, info)
|
||||
real(kind(1.D0)) :: psb_znrm2v
|
||||
|
||||
! locals
|
||||
integer :: int_err(5), ictxt, np, npcol, me, mycol,&
|
||||
& err_act, n, iix, jjx, temp(2), ndim, ix, jx, ijx, i, m, id
|
||||
integer :: ictxt, np, me,&
|
||||
& err_act, n, iix, jjx, ndim, ix, jx, ijx, i, m, id
|
||||
real(kind(1.d0)) :: nrm2, dznrm2, dd
|
||||
|
||||
external dcombnrm2
|
||||
@@ -330,8 +330,8 @@ subroutine psb_znrm2vs(res, x, desc_a, info)
|
||||
integer, intent(out) :: info
|
||||
|
||||
! locals
|
||||
integer :: int_err(5), ictxt, np, npcol, me, mycol,&
|
||||
& err_act, n, iix, jjx, temp(2), ndim, ix, jx, ijx, i, m, id
|
||||
integer :: ictxt, np, me,&
|
||||
& err_act, n, iix, jjx, ndim, ix, jx, ijx, i, m, id
|
||||
real(kind(1.d0)) :: nrm2, dznrm2, dd
|
||||
|
||||
external dcombnrm2
|
||||
|
||||
@@ -54,7 +54,7 @@ function psb_znrmi(a,desc_a,info)
|
||||
real(kind(1.d0)) :: psb_znrmi
|
||||
|
||||
! locals
|
||||
integer :: int_err(5), ictxt, np, npcol, me, mycol,&
|
||||
integer :: ictxt, np, me,&
|
||||
& err_act, n, iia, jja, ia, ja, mdim, ndim, m
|
||||
real(kind(1.d0)) :: nrmi, zcsnmi
|
||||
character(len=20) :: name, ch_err
|
||||
|
||||
@@ -102,12 +102,12 @@ subroutine psb_zspmm(alpha,a,x,beta,y,desc_a,info,&
|
||||
integer, intent(in), optional :: k, jx, jy,doswap
|
||||
|
||||
! locals
|
||||
integer :: int_err(5), ictxt, np, npcol, me, mycol,&
|
||||
& err_act, n, iix, jjx, ia, ja, iia, jja, temp(2), ix, iy, ik, ijx, ijy,&
|
||||
& idoswap, m, nrow, ncol, lldx, lldy, liwork, llwork, iiy, jjy,&
|
||||
integer :: ictxt, np, me,&
|
||||
& err_act, n, iix, jjx, ia, ja, iia, jja, ix, iy, ik, ijx, ijy,&
|
||||
& idoswap, m, nrow, ncol, lldx, lldy, liwork, iiy, jjy,&
|
||||
& i, ib, ib1
|
||||
integer, parameter :: nb=4
|
||||
complex(kind(1.d0)),pointer :: tmpx(:), xp(:,:), yp(:,:), iwork(:)
|
||||
integer, parameter :: nb=4
|
||||
complex(kind(1.d0)),pointer :: xp(:,:), yp(:,:), iwork(:)
|
||||
character :: itrans
|
||||
character(len=20) :: name, ch_err
|
||||
logical :: aliw
|
||||
@@ -433,12 +433,12 @@ subroutine psb_zspmv(alpha,a,x,beta,y,desc_a,info,&
|
||||
integer, intent(in), optional :: doswap
|
||||
|
||||
! locals
|
||||
integer :: int_err(5), ictxt, np, npcol, me, mycol,&
|
||||
& err_act, n, iix, jjx, ia, ja, iia, jja, temp(2), ix, iy, ik, ijx, ijy,&
|
||||
& idoswap, m, nrow, ncol, lldx, lldy, liwork, llwork, jx, jy, iiy, jjy,&
|
||||
integer :: ictxt, np, me,&
|
||||
& err_act, n, iix, jjx, ia, ja, iia, jja, ix, iy, ik, ijx, ijy,&
|
||||
& idoswap, m, nrow, ncol, lldx, lldy, liwork, jx, jy, iiy, jjy,&
|
||||
& i, ib, ib1
|
||||
integer, parameter :: nb=4
|
||||
complex(kind(1.d0)),pointer :: tmpx(:), iwork(:), xp(:), yp(:)
|
||||
complex(kind(1.d0)),pointer :: iwork(:), xp(:), yp(:)
|
||||
character :: itrans
|
||||
character(len=20) :: name, ch_err
|
||||
logical :: aliw
|
||||
|
||||
@@ -98,10 +98,10 @@ subroutine psb_zspsm(alpha,a,x,beta,y,desc_a,info,&
|
||||
integer, intent(in), optional :: k, jx, jy
|
||||
|
||||
! locals
|
||||
integer :: int_err(5), ictxt, np, npcol, me, mycol,&
|
||||
& err_act, n, iix, jjx, ia, ja, iia, jja, temp(2), lldx,lldy, lchoice,&
|
||||
& ix, iy, ik, ijx, ijy, i, lld,&
|
||||
& idoswap, m, nrow, ncol, liwork, llwork, iiy, jjy
|
||||
integer :: ictxt, np, me,&
|
||||
& err_act, n, iix, jjx, ia, ja, iia, jja, lldx,lldy, lchoice,&
|
||||
& ix, iy, ik, ijx, ijy, i, lld, int_err(5),&
|
||||
& m, nrow, ncol, liwork, llwork, iiy, jjy
|
||||
|
||||
character :: lunitd
|
||||
integer, parameter :: nb=4
|
||||
@@ -404,10 +404,10 @@ subroutine psb_zspsv(alpha,a,x,beta,y,desc_a,info,&
|
||||
integer, intent(in), optional :: choice
|
||||
|
||||
! locals
|
||||
integer :: int_err(5), ictxt, np, npcol, me, mycol,&
|
||||
& err_act, n, iix, jjx, ia, ja, iia, jja, temp(2), lldx,lldy, lchoice,&
|
||||
& ix, iy, ik, jx, jy, i, lld,&
|
||||
& idoswap, m, nrow, ncol, liwork, llwork, iiy, jjy
|
||||
integer :: ictxt, np, me, &
|
||||
& err_act, n, iix, jjx, ia, ja, iia, jja, lldx,lldy, lchoice,&
|
||||
& ix, iy, ik, jx, jy, i, lld, int_err(5),&
|
||||
& m, nrow, ncol, liwork, llwork, iiy, jjy
|
||||
|
||||
character :: lunitd
|
||||
integer, parameter :: nb=4
|
||||
|
||||
@@ -61,11 +61,11 @@ subroutine psb_dcsdp(a, b,info,ifc,check,trans,unitd,upd,dupl)
|
||||
real(kind(1.d0)) :: d(1)
|
||||
real(kind(1.d0)), allocatable :: work(:)
|
||||
type(psb_dspmat_type) :: temp_a
|
||||
Integer :: nzr, ntry, ifc_,ierror, ia1_size,&
|
||||
Integer :: nzr, ntry, ifc_, ia1_size,&
|
||||
& ia2_size, aspk_size,size_req,n_row,n_col,upd_,dupl_
|
||||
integer :: ip1, ip2, nnz, iflag, ichk, nnzt,&
|
||||
& ipc, i, count, err_act, ierrv(5), i1, i2, ia
|
||||
character :: check_,trans_,unitd_, up
|
||||
& ipc, i, count, err_act, i1, i2, ia
|
||||
character :: check_,trans_,unitd_
|
||||
Integer, Parameter :: maxtry=8
|
||||
logical, parameter :: debug=.false.
|
||||
character(len=20) :: name, ch_err
|
||||
|
||||
@@ -44,7 +44,7 @@ subroutine psb_dcsmv(alpha,a,b,beta,c,info,trans)
|
||||
real(kind(1.d0)), allocatable :: work(:)
|
||||
character :: trans_
|
||||
integer :: iwsz,m,n,k,lb,lc, err_act
|
||||
character(len=20) :: name, ch_err
|
||||
character(len=20) :: name
|
||||
|
||||
name='psb_dcsmv'
|
||||
info = 0
|
||||
|
||||
@@ -55,8 +55,8 @@ subroutine psb_dcsrws(rw,a,info,trans)
|
||||
end interface
|
||||
|
||||
character :: trans_
|
||||
integer :: iwsz,m,n,k,lb,lc,err_act
|
||||
character(len=20) :: name, ch_err
|
||||
integer :: m,k,err_act
|
||||
character(len=20) :: name
|
||||
|
||||
name='psb_dcsrws'
|
||||
info = 0
|
||||
|
||||
@@ -47,7 +47,7 @@ subroutine psb_dcssm(alpha,t,b,beta,c,info,trans,unitd,d)
|
||||
real(kind(1.d0)), pointer :: ddl(:)
|
||||
character :: lt, lu
|
||||
integer :: iwsz,m,n,lb,lc,err_act
|
||||
character(len=20) :: name, ch_err
|
||||
character(len=20) :: name
|
||||
|
||||
name='psb_dcssm'
|
||||
info = 0
|
||||
|
||||
@@ -48,10 +48,10 @@ subroutine psb_dipcoo2csc(a,info,clshr)
|
||||
integer, pointer :: iaux(:), itemp(:)
|
||||
!locals
|
||||
logical :: clshr_
|
||||
Integer :: nza, nr, i,j,irw, idl,err_act,nc,icl
|
||||
Integer :: nza, nr, i,j, idl,err_act,nc,icl
|
||||
Integer, Parameter :: maxtry=8
|
||||
logical, parameter :: debug=.false.
|
||||
character(len=20) :: name, ch_err
|
||||
character(len=20) :: name
|
||||
|
||||
name='psb_ipcoo2csc'
|
||||
info = 0
|
||||
|
||||
@@ -51,7 +51,7 @@ subroutine psb_dipcoo2csr(a,info,rwshr)
|
||||
Integer :: nza, nr, i,j,irw, idl,err_act
|
||||
Integer, Parameter :: maxtry=8
|
||||
logical, parameter :: debug=.false.
|
||||
character(len=20) :: name, ch_err
|
||||
character(len=20) :: name
|
||||
|
||||
name='psb_ipcoo2csr'
|
||||
info = 0
|
||||
|
||||
@@ -48,7 +48,7 @@ Subroutine psb_dipcsr2coo(a,info)
|
||||
integer :: i,j,err_act
|
||||
logical, parameter :: debug=.false.
|
||||
integer, pointer :: iaux(:), itemp(:)
|
||||
character(len=20) :: name, ch_err
|
||||
character(len=20) :: name
|
||||
|
||||
name='psb_dipcsr2coo'
|
||||
info = 0
|
||||
|
||||
@@ -47,9 +47,8 @@ subroutine psb_dneigh(a,idx,neigh,n,info,lev)
|
||||
integer, optional :: lev ! level of neighbours to find
|
||||
|
||||
integer, pointer :: tmpn(:)=>null()
|
||||
integer :: level, dim, i, j, k, r, c, brow,&
|
||||
& elem_pt, ii, n1, col_idx, ne, err_act, nn, nidx
|
||||
character(len=20) :: name, ch_err
|
||||
integer :: level, dim, i, j, k, n1, err_act, nn, nidx
|
||||
character(len=20) :: name
|
||||
|
||||
name='psb_dneigh'
|
||||
info = 0
|
||||
|
||||
@@ -150,6 +150,7 @@ contains
|
||||
|
||||
nr = lrw - irw + 1
|
||||
allocate(indices(nr))
|
||||
nz = 0
|
||||
do i=1,nr
|
||||
indices(i)=a%pl(irw+i-1)
|
||||
nz=nz+a%ia2(indices(i)+1)-a%ia2(indices(i))
|
||||
@@ -403,7 +404,6 @@ contains
|
||||
ia2 => a%ia2(pia+1:pja-1:3) ! the array containing a pointer to the pos. in ja to the first jad column
|
||||
ia3 => a%ia2(pia+2:pja-1:3) ! the array containing a pointer to the pos. in ja to the first csr column
|
||||
|
||||
|
||||
if (append) then
|
||||
nzb = b%infoa(psb_nnz_)
|
||||
else
|
||||
|
||||
@@ -175,7 +175,7 @@ contains
|
||||
integer, intent(in), optional :: ng,gtl(*)
|
||||
|
||||
logical, parameter :: debug=.false.
|
||||
integer :: i,ir,ic,check_flag, ilr, ilc, ip, &
|
||||
integer :: i,ir,ic, ilr, ilc, ip, &
|
||||
& i1,i2,nc,lb,ub,m,nnz,dupl
|
||||
|
||||
info = 0
|
||||
@@ -396,7 +396,7 @@ contains
|
||||
real(kind(1.d0)), intent(in) :: val(*)
|
||||
integer, intent(out) :: info
|
||||
integer, intent(in), optional :: ng,gtl(*)
|
||||
integer :: i,ir,ic,check_flag, ilr, ilc, ip, &
|
||||
integer :: i,ir,ic, ilr, ilc, ip, &
|
||||
& i1,i2,nc,lb,ub,m,nnz,dupl,isrt
|
||||
logical, parameter :: debug=.false.
|
||||
|
||||
@@ -596,7 +596,7 @@ contains
|
||||
integer, intent(out) :: info
|
||||
integer, intent(in), optional :: ng,gtl(*)
|
||||
|
||||
integer :: i,ir,ic,check_flag, ilr, ilc, ip, &
|
||||
integer :: i,ir,ic, ilr, ilc, ip, &
|
||||
& i1,i2,nc,lb,ub,m,nnz,dupl
|
||||
|
||||
logical, parameter :: debug=.false.
|
||||
@@ -810,7 +810,7 @@ contains
|
||||
complex(kind(1.d0)), intent(in) :: val(*)
|
||||
integer, intent(out) :: info
|
||||
integer, intent(in), optional :: ng,gtl(*)
|
||||
integer :: i,ir,ic,check_flag, ilr, ilc, ip, &
|
||||
integer :: i,ir,ic, ilr, ilc, ip, &
|
||||
& i1,i2,nc,lb,ub,m,nnz,dupl,isrt
|
||||
logical, parameter :: debug=.false.
|
||||
|
||||
|
||||
@@ -61,11 +61,11 @@ subroutine psb_zcsdp(a, b,info,ifc,check,trans,unitd,upd,dupl)
|
||||
complex(kind(1.d0)) :: d(1)
|
||||
complex(kind(1.d0)), allocatable :: work(:)
|
||||
type(psb_zspmat_type) :: temp_a
|
||||
Integer :: nzr, ntry, ifc_,ierror, ia1_size,&
|
||||
Integer :: nzr, ntry, ifc_, ia1_size,&
|
||||
& ia2_size, aspk_size,size_req,n_row,n_col,upd_,dupl_
|
||||
integer :: ip1, ip2, nnz, iflag, ichk, nnzt,&
|
||||
& ipc, i, count, err_act, ierrv(5), i1, i2, ia
|
||||
character :: check_,trans_,unitd_, up
|
||||
& ipc, i, count, err_act, i1, i2, ia
|
||||
character :: check_,trans_,unitd_
|
||||
Integer, Parameter :: maxtry=8
|
||||
logical, parameter :: debug=.false.
|
||||
character(len=20) :: name, ch_err
|
||||
|
||||
@@ -44,7 +44,7 @@ subroutine psb_zcsmm(alpha,a,b,beta,c,info,trans)
|
||||
complex(kind(1.d0)), allocatable :: work(:)
|
||||
character :: trans_
|
||||
integer :: iwsz,m,n,k,lb,lc,err_act
|
||||
character(len=20) :: name, ch_err
|
||||
character(len=20) :: name
|
||||
|
||||
name='psb_zcsmm'
|
||||
info = 0
|
||||
|
||||
@@ -55,8 +55,8 @@ subroutine psb_zcsrws(rw,a,info,trans)
|
||||
end interface
|
||||
|
||||
character :: trans_
|
||||
integer :: iwsz,m,n,k,lb,lc,err_act
|
||||
character(len=20) :: name, ch_err
|
||||
integer :: m,n,k,err_act
|
||||
character(len=20) :: name
|
||||
|
||||
name='psb_zcsrws'
|
||||
info = 0
|
||||
|
||||
@@ -47,7 +47,7 @@ subroutine psb_zcssm(alpha,t,b,beta,c,info,trans,unitd,d)
|
||||
complex(kind(1.d0)), pointer :: ddl(:)
|
||||
character :: lt, lu
|
||||
integer :: iwsz,m,n,lb,lc,err_act
|
||||
character(len=20) :: name, ch_err
|
||||
character(len=20) :: name
|
||||
|
||||
name='psb_zcssm'
|
||||
info = 0
|
||||
|
||||
@@ -47,7 +47,7 @@ subroutine psb_zcssv(alpha,t,b,beta,c,info,trans,unitd,d)
|
||||
complex(kind(1.d0)), pointer :: ddl(:)
|
||||
character :: lt, lu
|
||||
integer :: iwsz,m,n,lb,lc,err_act
|
||||
character(len=20) :: name, ch_err
|
||||
character(len=20) :: name
|
||||
|
||||
name='psb_zcssv'
|
||||
info = 0
|
||||
|
||||
@@ -48,10 +48,10 @@ subroutine psb_zipcoo2csc(a,info,clshr)
|
||||
integer, pointer :: iaux(:), itemp(:)
|
||||
!locals
|
||||
logical :: clshr_
|
||||
Integer :: nza, nr, i,j,irw, idl,err_act,nc,icl
|
||||
Integer :: nza, i,j,irw, idl,err_act,nc,icl
|
||||
Integer, Parameter :: maxtry=8
|
||||
logical, parameter :: debug=.false.
|
||||
character(len=20) :: name, ch_err
|
||||
character(len=20) :: name
|
||||
|
||||
name='psb_ipcoo2csc'
|
||||
info = 0
|
||||
|
||||
@@ -51,7 +51,7 @@ subroutine psb_zipcoo2csr(a,info,rwshr)
|
||||
Integer :: nza, nr, i,j,irw, idl,err_act
|
||||
Integer, Parameter :: maxtry=8
|
||||
logical, parameter :: debug=.false.
|
||||
character(len=20) :: name, ch_err
|
||||
character(len=20) :: name
|
||||
|
||||
name='psb_ipcoo2csr'
|
||||
info = 0
|
||||
|
||||
@@ -150,6 +150,7 @@ contains
|
||||
|
||||
nr = lrw - irw + 1
|
||||
allocate(indices(nr))
|
||||
nz = 0
|
||||
do i=1,nr
|
||||
indices(i)=a%pl(irw+i-1)
|
||||
nz=nz+a%ia2(indices(i)+1)-a%ia2(indices(i))
|
||||
|
||||
@@ -56,12 +56,10 @@ subroutine psb_cdall(m, n, parts, ictxt, desc_a, info)
|
||||
integer, intent(out) :: info
|
||||
|
||||
!locals
|
||||
Integer :: counter,i,j,np,npcol,me,mycol,&
|
||||
& loc_row,err,loc_col,nprocs,&
|
||||
Integer :: counter,i,j,np,me,loc_row,err,loc_col,nprocs,&
|
||||
& l_ov_ix,l_ov_el,idx, err_act, itmpov, k
|
||||
Integer :: INT_ERR(5),TEMP(1),EXCH(2)
|
||||
Real(Kind(1.d0)) :: REAL_ERR(5)
|
||||
Integer, Pointer :: PRC_V(:), TEMP_OVRLAP(:), OV_IDX(:),OV_EL(:)
|
||||
integer :: int_err(5),exch(2)
|
||||
integer, pointer :: prc_v(:), temp_ovrlap(:), ov_idx(:),ov_el(:)
|
||||
logical, parameter :: debug=.false.
|
||||
character(len=20) :: name, char_err
|
||||
|
||||
|
||||
@@ -55,14 +55,13 @@ subroutine psb_cdalv(m, v, ictxt, desc_a, info, flag)
|
||||
type(psb_desc_type), intent(out) :: desc_a
|
||||
|
||||
!locals
|
||||
Integer :: counter,i,j,np,npcol,me,mycol,&
|
||||
& loc_row,err,loc_col,nprocs,n,itmpov, k,&
|
||||
Integer :: counter,i,j,np,me,loc_row,err,&
|
||||
& loc_col,nprocs,n,itmpov, k,&
|
||||
& l_ov_ix,l_ov_el,idx, flag_, err_act
|
||||
Integer :: INT_ERR(5),TEMP(1),EXCH(2)
|
||||
Real(Kind(1.d0)) :: REAL_ERR(5)
|
||||
integer :: int_err(5),exch(2)
|
||||
Integer, Pointer :: temp_ovrlap(:), ov_idx(:),ov_el(:)
|
||||
logical, parameter :: debug=.false.
|
||||
character(len=20) :: name, ch_err
|
||||
character(len=20) :: name
|
||||
|
||||
if(psb_get_errstatus() /= 0) return
|
||||
info=0
|
||||
@@ -196,7 +195,7 @@ subroutine psb_cdalv(m, v, ictxt, desc_a, info, flag)
|
||||
allocate(ov_idx(l_ov_ix),ov_el(l_ov_el), stat=info)
|
||||
if (info /= 0) then
|
||||
info=2025
|
||||
int_err(1)=loc_col
|
||||
int_err(1)=l_ov_ix
|
||||
call psb_errpush(info,name,i_err=int_err)
|
||||
goto 9999
|
||||
end if
|
||||
|
||||
@@ -54,10 +54,7 @@ subroutine psb_cdcpy(desc_in, desc_out, info)
|
||||
integer, intent(out) :: info
|
||||
|
||||
!locals
|
||||
integer :: np,me,&
|
||||
& ictxt, isz, dectype, err_act, err
|
||||
integer :: int_err(5),temp(1)
|
||||
real(kind(1.d0)) :: real_err(5)
|
||||
integer :: np,me,ictxt, isz, err_act
|
||||
logical, parameter :: debug=.false.,debugprt=.false.
|
||||
character(len=20) :: name, char_err
|
||||
if (debug) write(0,*) me,'Entered CDCPY'
|
||||
|
||||
@@ -115,15 +115,12 @@ subroutine psb_cddec(nloc, ictxt, desc_a, info)
|
||||
Type(psb_desc_type), intent(out) :: desc_a
|
||||
|
||||
!locals
|
||||
Integer :: counter,i,j,np,npcol,me,mypcol,&
|
||||
& loc_row,err,loc_col,nprocs,n,itmpov, k,&
|
||||
& l_ov_ix,l_ov_el,idx, flag_, err_act,m, ip
|
||||
Integer :: INT_ERR(5),TEMP(1),EXCH(2)
|
||||
Real(Kind(1.d0)) :: REAL_ERR(5)
|
||||
Integer, Pointer :: temp_ovrlap(:), ov_idx(:), ov_el(:)
|
||||
Integer :: i,j,np,me,err,n,itmpov, k,&
|
||||
& l_ov_ix,l_ov_el,idx, err_act,m, ip
|
||||
Integer :: INT_ERR(5)
|
||||
integer, allocatable :: nlv(:)
|
||||
logical, parameter :: debug=.false.
|
||||
character(len=20) :: name, ch_err
|
||||
character(len=20) :: name
|
||||
|
||||
if(psb_get_errstatus() /= 0) return
|
||||
info=0
|
||||
|
||||
@@ -47,11 +47,8 @@ subroutine psb_cdfree(desc_a,info)
|
||||
type(psb_desc_type), intent(inout) :: desc_a
|
||||
integer, intent(out) :: info
|
||||
!...locals....
|
||||
integer :: int_err(5)
|
||||
integer :: temp(1)
|
||||
real(kind(1.d0)) :: real_err(5)
|
||||
integer :: ictxt,np,npcol,me,mypcol, err_act
|
||||
character(len=20) :: name, char_err
|
||||
integer :: ictxt,np,me, err_act
|
||||
character(len=20) :: name
|
||||
|
||||
if(psb_get_errstatus() /= 0) return
|
||||
info=0
|
||||
|
||||
Some files were not shown because too many files have changed in this diff Show More
Reference in New Issue
Block a user