fdurastante/psblas3
1
0
Fork 0
mirror of https://github.com/sfilippone/psblas3.git synced 2026-10-17 19:32:08 +00:00
Code Issues Packages Projects Releases Wiki Activity

Bunch of changes to take away most instances of unused variables.

Browse Source
This commit is contained in:
Salvatore Filippone
2007-11-13 10:49:42 +00:00
parent c74f235783
commit f46a8b1131
159 changed files with 464 additions and 530 deletions
Download Patch File Download Diff File Expand all files Collapse all files
base/comm/psb_dhalo.f90
+1 -1
View File
@@ -279,7 +279,7 @@ subroutine psb_dhalov(x,desc_a,info,alpha,work,tran,mode,data)
! locals
integer :: ictxt, np, me,&
& err_act, m, n, iix, jjx, ix, ijx, nrow, imode, i,&
& err_act, m, n, iix, jjx, ix, ijx, nrow, imode,&
& err, liwork,data_
real(kind(1.d0)),pointer :: iwork(:)
character :: ltran
base/comm/psb_dscatter.F90
+1 -1
View File
@@ -293,7 +293,7 @@ subroutine psb_dscatterv(globx, locx, desc_a, info, iroot)
! locals
integer :: int_err(5), ictxt, np, me, &
& err_act, m, n, i, j, idx, nrow, iiroot, iglobx, jglobx,&
& err_act, m, n, i, j, idx, nrow, iglobx, jglobx,&
& ilocx, jlocx, lda_locx, lda_globx, root, k, icomm, myrank,&
& rootrank, pos, ilx, jlx
real(kind(1.d0)), allocatable :: scatterv(:)
base/comm/psb_iscatter.F90
+1 -1
View File
@@ -291,7 +291,7 @@ subroutine psb_iscatterv(globx, locx, desc_a, info, iroot)
! locals
integer :: int_err(5), ictxt, np, me, &
& err_act, m, n, i, j, idx, nrow, iiroot, iglobx, jglobx,&
& err_act, m, n, i, j, idx, nrow, iglobx, jglobx,&
& ilocx, jlocx, lda_locx, lda_globx, root, k, icomm, myrank,&
& rootrank, pos, ilx, jlx
integer, allocatable :: scatterv(:)
base/comm/psb_zscatter.F90
+2 -2
View File
@@ -296,9 +296,9 @@ subroutine psb_zscatterv(globx, locx, desc_a, info, iroot)
! locals
integer :: int_err(5), ictxt, np, me, &
& err_act, m, n, i, j, idx, nrow, iiroot, iglobx, jglobx,&
& err_act, m, n, i, j, idx, nrow, iglobx, jglobx,&
& ilocx, jlocx, lda_locx, lda_globx, root, k, icomm, myrank,&
& rootrank, c, pos, ilx, jlx
& rootrank, pos, ilx, jlx
complex(kind(1.d0)), allocatable :: scatterv(:)
integer, allocatable :: displ(:), l_t_g_all(:), all_dim(:)
character(len=20) :: name, ch_err
base/internals/avltree.c
+1 -1
View File
@@ -246,7 +246,7 @@ AVLTreePtr GetAVLTree()
int AVLTreeInit(AVLTreePtr Tree)
{
AVLTVectPtr current;
/* AVLTVectPtr current; */
if (Tree==NULL) {
fprintf(stderr,"Cannot initialize a NULL Tree pointer\n");
return(-1);
base/internals/psi_crea_bnd_elem.f90
+1 -1
View File
@@ -55,7 +55,7 @@ subroutine psi_crea_bnd_elem(bndel,desc_a,info)
integer, intent(out) :: info
integer, allocatable :: work(:)
integer :: i, j, nr, ns, k, irv, err_act
integer :: i, j, nr, ns, k, err_act
character(len=20) :: name
info = 0
base/internals/psi_crea_ovr_elem.f90
+2 -2
View File
@@ -56,12 +56,12 @@ subroutine psi_crea_ovr_elem(desc_overlap,ovr_elem,info)
integer, intent(out) :: info
! ...local scalars...
integer :: i,pnt_new_elem,ret,j,iret
integer :: i,pnt_new_elem,ret,j
integer :: dim_ovr_elem
integer :: pairtree(2)
! ...external function...
integer :: psi_exist_ovr_elem,dim
integer :: psi_exist_ovr_elem
external :: psi_exist_ovr_elem
integer :: nel, ip, ix, iel, insize, err_act
base/internals/psi_desc_index.F90
+1 -2
View File
@@ -123,8 +123,7 @@ subroutine psi_desc_index(desc,index_in,dep_list,&
integer :: j,me,np,i,proc
! ...parameters...
integer :: ictxt
integer :: no_comm,err
parameter (no_comm=-1)
integer, parameter :: no_comm=-1
! ...local arrays..
integer,allocatable :: brvindx(:),rvsz(:),&
& bsdindx(:),sdsz(:), sndbuf(:), rcvbuf(:)
base/internals/psi_dswapdata.F90
+4 -4
View File
@@ -103,9 +103,9 @@ subroutine psi_dswapdatam(flag,n,beta,y,desc_a,work,info,data)
integer, optional :: data
! locals
integer :: ictxt, np, me, point_to_proc, nesd, nerv,&
integer :: ictxt, np, me, nesd, nerv,&
& proc_to_comm, p2ptag, icomm, p2pstat(mpi_status_size),&
& idxs, idxr, iret, err_act, totxch, ixrec, i, idx_pt,&
& idxs, idxr, iret, err_act, totxch, i, idx_pt,&
& snd_pt, rcv_pt, pnti, data_
integer, allocatable, dimension(:) :: bsdidx, brvidx,&
& sdsz, rvsz, prcid, rvhd, sdhd
@@ -577,9 +577,9 @@ subroutine psi_dswapdatav(flag,beta,y,desc_a,work,info,data)
integer, optional :: data
! locals
integer :: ictxt, np, me, point_to_proc, nesd, nerv,&
integer :: ictxt, np, me, nesd, nerv,&
& proc_to_comm, p2ptag, icomm, p2pstat(mpi_status_size),&
& idxs, idxr, iret, err_act, totxch, ixrec, i, &
& idxs, idxr, iret, err_act, totxch, i, &
& idx_pt, snd_pt, rcv_pt, n, pnti, data_
integer, allocatable, dimension(:) :: bsdidx, brvidx,&
base/internals/psi_dswaptran.F90
+4 -4
View File
@@ -106,9 +106,9 @@ subroutine psi_dswaptranm(flag,n,beta,y,desc_a,work,info,data)
integer, optional :: data
! locals
integer :: ictxt, np, me, point_to_proc, nesd, nerv,&
integer :: ictxt, np, me, nesd, nerv,&
& proc_to_comm, p2ptag, icomm, p2pstat(mpi_status_size),&
& idxs, idxr, iret, err_act, totxch, ixrec, i, idx_pt,&
& idxs, idxr, iret, err_act, totxch, i, idx_pt,&
& snd_pt, rcv_pt, pnti
integer, allocatable, dimension(:) :: bsdidx, brvidx,&
& sdsz, rvsz, prcid, rvhd, sdhd
@@ -575,9 +575,9 @@ subroutine psi_dswaptranv(flag,beta,y,desc_a,work,info,data)
integer, optional :: data
! locals
integer :: ictxt, np, me, point_to_proc, nesd, nerv,&
integer :: ictxt, np, me, nesd, nerv,&
& proc_to_comm, p2ptag, icomm, p2pstat(mpi_status_size),&
& idxs, idxr, iret, err_act, totxch, ixrec, i, &
& idxs, idxr, iret, err_act, totxch, i, &
& idx_pt, snd_pt, rcv_pt, n, pnti
integer, allocatable, dimension(:) :: bsdidx, brvidx,&
base/internals/psi_extrct_dl.F90
+1 -2
View File
@@ -137,10 +137,9 @@ subroutine psi_extract_dep_list(desc_data,desc_str,dep_list,&
integer, allocatable :: itmp(:)
! .....local arrays....
integer int_err(5)
double precision real_err(5)
! .....local scalars...
integer i,nprow,npcol,me,mycol,pointer_dep_list,proc,j,err_act
integer i,me,nprow,pointer_dep_list,proc,j,err_act
integer ictxt, err, icomm
logical, parameter :: debug=.false.
character name*20
base/internals/psi_fnd_owner.f90
+2 -2
View File
@@ -62,10 +62,10 @@ subroutine psi_fnd_owner(nv,idx,iprc,desc,info)
integer,allocatable :: hsz(:),hidx(:),helem(:),hproc(:)
integer :: i,j,err,n_row,n_col, err_act,ih,nh,icomm,hsize
integer :: i,n_row,n_col, err_act,ih,icomm,hsize
integer :: ictxt,np,me
logical, parameter :: debug=.false., debugwrt=.false.
character(len=20) :: name,ch_err
character(len=20) :: name
info = 0
name = 'psi_fnd_owner'
base/internals/psi_gthsct_mod.f90
+9 -9
View File
@@ -82,7 +82,7 @@ contains
real(kind(1.d0)) :: x(:), y(:)
! Locals
integer :: i, j
integer :: i
do i=1,n
y(i)=x(idx(i))
@@ -134,11 +134,11 @@ contains
use psb_const_mod
implicit none
integer :: n, k, idx(:)
integer :: n, idx(:)
real(kind(1.d0)) :: beta, x(:), y(:)
! Locals
integer :: i, j, pt
integer :: i
if (beta == dzero) then
do i=1,n
@@ -187,7 +187,7 @@ contains
integer :: x(:), y(:)
! Locals
integer :: i, j
integer :: i
do i=1,n
y(i)=x(idx(i))
@@ -240,11 +240,11 @@ contains
use psb_const_mod
implicit none
integer :: n, k, idx(:)
integer :: n, idx(:)
integer :: beta, x(:), y(:)
! Locals
integer :: i, j, pt
integer :: i
if (beta == izero) then
do i=1,n
@@ -293,7 +293,7 @@ contains
complex(kind(1.d0)) :: x(:), y(:)
! Locals
integer :: i, j
integer :: i
do i=1,n
y(i)=x(idx(i))
@@ -345,11 +345,11 @@ contains
use psb_const_mod
implicit none
integer :: n, k, idx(:)
integer :: n, idx(:)
complex(kind(1.d0)) :: beta, x(:), y(:)
! Locals
integer :: i, j, pt
integer :: i
if (beta == zzero) then
do i=1,n
base/internals/psi_idx_cnv.f90
+9 -10
View File
@@ -57,13 +57,13 @@ subroutine psi_idx_cnv1(nv,idxin,desc,info,mask,owned)
integer, intent(out) :: info
logical, intent(in), optional, target :: mask(:)
logical, intent(in), optional :: owned
integer :: i,ictxt,row,k,mglob, nglob,err
integer :: np, me, isize
integer :: pnt_halo,nrow,ncol, nh, ip, err_act,lip,nxt
integer :: ictxt,mglob, nglob
integer :: np, me
integer :: nrow,ncol, err_act
integer, allocatable :: idxout(:)
logical, parameter :: debug=.false.
integer, parameter :: relocsz=200
character(len=20) :: name,ch_err
character(len=20) :: name
logical, pointer :: mask_(:)
logical :: owned_
@@ -212,12 +212,12 @@ subroutine psi_idx_cnv2(nv,idxin,idxout,desc,info,mask,owned)
integer, intent(out) :: info
logical, intent(in), optional, target :: mask(:)
logical, intent(in), optional :: owned
integer :: i,ictxt,row,k,mglob, nglob,err
integer :: np, me, isize
integer :: pnt_halo,nrow,ncol, nh, ip, err_act,lip,nxt
integer :: i,ictxt,mglob, nglob
integer :: np, me
integer :: nrow,ncol, ip, err_act,lip
logical, parameter :: debug=.false.
integer, parameter :: relocsz=200
character(len=20) :: name,ch_err
character(len=20) :: name
logical, pointer :: mask_(:)
logical :: owned_
@@ -323,8 +323,7 @@ subroutine psi_idx_cnv2(nv,idxin,idxout,desc,info,mask,owned)
if (.not.allocated(desc%hashv)) then
write(0,*) 'Inconsistent input to inner_cnv'
end if
call psi_inner_cnv(nv,idxin,idxout,psb_hash_size,psb_hash_mask,&
& desc%hashv,desc%glb_lc)
call psi_inner_cnv(nv,idxin,idxout,psb_hash_mask,desc%hashv,desc%glb_lc)
end if
else
base/internals/psi_idx_ins_cnv.f90
+6 -6
View File
@@ -60,13 +60,13 @@ subroutine psi_idx_ins_cnv1(nv,idxin,desc,info,mask)
type(psb_desc_type), intent(inout) :: desc
integer, intent(out) :: info
logical, intent(in), optional, target :: mask(:)
integer :: i,ictxt,row,k,mglob, nglob,err
integer :: np, me, isize
integer :: pnt_halo,nrow,ncol, nh, ip, err_act,lip,nxt
integer :: ictxt,mglob, nglob
integer :: np, me
integer :: nrow,ncol, err_act
integer, allocatable :: idxout(:)
logical, parameter :: debug=.false.
integer, parameter :: relocsz=200
character(len=20) :: name,ch_err
character(len=20) :: name
logical, pointer :: mask_(:)
info = 0
@@ -211,9 +211,9 @@ subroutine psi_idx_ins_cnv2(nv,idxin,idxout,desc,info,mask)
type(psb_desc_type), intent(inout) :: desc
integer, intent(out) :: info
logical, intent(in), optional, target :: mask(:)
integer :: i,ictxt,row,k,mglob, nglob,err
integer :: i,ictxt,k,mglob, nglob
integer :: np, me, isize
integer :: pnt_halo,nrow,ncol, nh, ip, err_act,lip,nxt,il1
integer :: pnt_halo,nrow,ncol, nh, ip, err_act,lip,nxt
logical, parameter :: debug=.false.
integer, parameter :: relocsz=200
character(len=20) :: name,ch_err
base/internals/psi_iswapdata.F90
+4 -4
View File
@@ -102,9 +102,9 @@ subroutine psi_iswapdatam(flag,n,beta,y,desc_a,work,info,data)
integer, optional :: data
! locals
integer :: ictxt, np, me, point_to_proc, nesd, nerv,&
integer :: ictxt, np, me, nesd, nerv,&
& proc_to_comm, p2ptag, icomm, p2pstat(mpi_status_size),&
& idxs, idxr, iret, err_act, totxch, ixrec, i, idx_pt,&
& idxs, idxr, iret, err_act, totxch, i, idx_pt,&
& snd_pt, rcv_pt, pnti, data_
integer, allocatable, dimension(:) :: bsdidx, brvidx,&
& sdsz, rvsz, prcid, rvhd, sdhd
@@ -576,9 +576,9 @@ subroutine psi_iswapdatav(flag,beta,y,desc_a,work,info,data)
integer, optional :: data
! locals
integer :: ictxt, np, me, point_to_proc, nesd, nerv,&
integer :: ictxt, np, me, nesd, nerv,&
& proc_to_comm, p2ptag, icomm, p2pstat(mpi_status_size),&
& idxs, idxr, iret, err_act, totxch, ixrec, i, &
& idxs, idxr, iret, err_act, totxch, i, &
& idx_pt, snd_pt, rcv_pt, n, pnti, data_
integer, allocatable, dimension(:) :: bsdidx, brvidx,&
base/internals/psi_iswaptran.F90
+4 -4
View File
@@ -106,9 +106,9 @@ subroutine psi_iswaptranm(flag,n,beta,y,desc_a,work,info,data)
integer, optional :: data
! locals
integer :: ictxt, np, me, point_to_proc, nesd, nerv,&
integer :: ictxt, np, me, nesd, nerv,&
& proc_to_comm, p2ptag, icomm, p2pstat(mpi_status_size),&
& idxs, idxr, iret, err_act, totxch, ixrec, i, idx_pt,&
& idxs, idxr, iret, err_act, totxch, i, idx_pt,&
& snd_pt, rcv_pt, pnti
integer, allocatable, dimension(:) :: bsdidx, brvidx,&
& sdsz, rvsz, prcid, rvhd, sdhd
@@ -574,9 +574,9 @@ subroutine psi_iswaptranv(flag,beta,y,desc_a,work,info,data)
integer, optional :: data
! locals
integer :: ictxt, np, me, point_to_proc, nesd, nerv,&
integer :: ictxt, np, me, nesd, nerv,&
& proc_to_comm, p2ptag, icomm, p2pstat(mpi_status_size),&
& idxs, idxr, iret, err_act, totxch, ixrec, i, &
& idxs, idxr, iret, err_act, totxch, i, &
& idx_pt, snd_pt, rcv_pt, n, pnti
integer, allocatable, dimension(:) :: bsdidx, brvidx,&
base/internals/psi_ldsc_pre_halo.f90
+2 -2
View File
@@ -63,8 +63,8 @@ subroutine psi_ldsc_pre_halo(desc,ext_hv,info)
integer,allocatable :: helem(:),hproc(:)
integer,allocatable :: tmphl(:)
integer :: i,j,err,np,me,lhalo,nhalo,&
& n_col, err_act, key, ih, nh, idx, nk,icomm,hsize
integer :: i,j,np,me,lhalo,nhalo,&
& n_col, err_act, key, ih, nh, idx, nk,icomm
integer :: ictxt,n_row
logical, parameter :: debug=.false., debugwrt=.false.
character(len=20) :: name,ch_err
base/internals/psi_zswapdata.F90
+4 -4
View File
@@ -102,9 +102,9 @@ subroutine psi_zswapdatam(flag,n,beta,y,desc_a,work,info,data)
integer, optional :: data
! locals
integer :: ictxt, np, me, point_to_proc, nesd, nerv,&
integer :: ictxt, np, me, nesd, nerv,&
& proc_to_comm, p2ptag, icomm, p2pstat(mpi_status_size),&
& idxs, idxr, iret, err_act, totxch, ixrec, i, idx_pt,&
& idxs, idxr, iret, err_act, totxch, i, idx_pt,&
& snd_pt, rcv_pt, pnti, data_
integer, allocatable, dimension(:) :: bsdidx, brvidx,&
& sdsz, rvsz, prcid, rvhd, sdhd
@@ -576,9 +576,9 @@ subroutine psi_zswapdatav(flag,beta,y,desc_a,work,info,data)
integer, optional :: data
! locals
integer :: ictxt, np, me, point_to_proc, nesd, nerv,&
integer :: ictxt, np, me, nesd, nerv,&
& proc_to_comm, p2ptag, icomm, p2pstat(mpi_status_size),&
& idxs, idxr, iret, err_act, totxch, ixrec, i, &
& idxs, idxr, iret, err_act, totxch, i, &
& idx_pt, snd_pt, rcv_pt, n, pnti, data_
integer, allocatable, dimension(:) :: bsdidx, brvidx,&
base/internals/psi_zswaptran.F90
+4 -4
View File
@@ -106,9 +106,9 @@ subroutine psi_zswaptranm(flag,n,beta,y,desc_a,work,info,data)
integer, optional :: data
! locals
integer :: ictxt, np, me, point_to_proc, nesd, nerv,&
integer :: ictxt, np, me, nesd, nerv,&
& proc_to_comm, p2ptag, icomm, p2pstat(mpi_status_size),&
& idxs, idxr, iret, err_act, totxch, ixrec, i, idx_pt,&
& idxs, idxr, iret, err_act, totxch, i, idx_pt,&
& snd_pt, rcv_pt, pnti
integer, allocatable, dimension(:) :: bsdidx, brvidx,&
& sdsz, rvsz, prcid, rvhd, sdhd
@@ -574,9 +574,9 @@ subroutine psi_zswaptranv(flag,beta,y,desc_a,work,info,data)
integer, optional :: data
! locals
integer :: ictxt, np, me, point_to_proc, nesd, nerv,&
integer :: ictxt, np, me, nesd, nerv,&
& proc_to_comm, p2ptag, icomm, p2pstat(mpi_status_size),&
& idxs, idxr, iret, err_act, totxch, ixrec, i, &
& idxs, idxr, iret, err_act, totxch, i, &
& idx_pt, snd_pt, rcv_pt, n, pnti
integer, allocatable, dimension(:) :: bsdidx, brvidx,&
base/internals/srcht.c
+7 -6
View File
@@ -329,20 +329,22 @@ void SearchInsKeyVal(fptr *ftree, int *key, int *val, int *res, int *iret)
}
#define USECACHE 0
void SearchKeyVal(fptr *ftree, int *key, int *res, int *iret)
{
PairTreePtr PTree;
KeyPair node;
AVLNodePtr noderes;
KeyPairPtr result;
#if USECACHE
int i,sv[2];
int info;
#endif
*iret = 0;
PTree = (PairTreePtr) *ftree;
#if 0
#if USECACHE
for (i=0; i<CACHESIZE; i++) {
if (PTree->cache[0][i] == *key) {
*res=PTree->cache[1][i];
@@ -365,7 +367,7 @@ void SearchKeyVal(fptr *ftree, int *key, int *res, int *iret)
} else {
result = (KeyPairPtr) noderes->key;
*res = result->val;
#if 0
#if USECACHE
for (i=CACHESIZE-1; i>0; i--) {
PTree->cache[0][i]=PTree->cache[0][i-1];
PTree->cache[0][i]=PTree->cache[1][i-1];
@@ -384,7 +386,7 @@ void SearchKeyVal(fptr *ftree, int *key, int *res, int *iret)
void PairTreeVisit(AVLNodePtr current, PairTreePtr PTree)
{
KeyPairPtr node,inode;
int info,i;
int info;
if (current==NULL) return;
inode = (KeyPairPtr) current->key;
@@ -402,8 +404,7 @@ void PairTreeVisit(AVLNodePtr current, PairTreePtr PTree)
void ClonePairSearchTree(fptr *ftreein, fptr *ftreeout)
{
PairTreePtr PTreein, PTreeout;
int i,j;
AVLNodePtr nodept;
int i;
PTreein = (PairTreePtr) *ftreein;
base/modules/psb_check_mod.f90
+3 -3
View File
@@ -78,7 +78,7 @@ contains
! locals
integer :: err_act, int_err(5)
character(len=20) :: name, ch_err
character(len=20) :: name
if(psb_get_errstatus() /= 0) return
info=0
@@ -203,7 +203,7 @@ contains
! locals
integer :: err_act, int_err(5)
character(len=20) :: name, ch_err
character(len=20) :: name
if(psb_get_errstatus() /= 0) return
info=0
@@ -327,7 +327,7 @@ contains
! locals
integer :: err_act, int_err(5)
character(len=20) :: name, ch_err
character(len=20) :: name
if(psb_get_errstatus() /= 0) return
info=0
base/modules/psb_desc_type.f90
+5 -4
View File
@@ -320,7 +320,7 @@ contains
implicit none
integer, intent(in) :: ictxt,m
!locals
integer :: np,me, isz, err_act,idx,gidx,lidx
integer :: np,me
call psb_info(ictxt, me, np)
!
@@ -335,7 +335,8 @@ contains
subroutine psb_nullify_desc(desc)
type(psb_desc_type), intent(inout) :: desc
! We have nothing left to do here.
! Perhaps we should delete this subroutine?
end subroutine psb_nullify_desc
logical function psb_is_ok_desc(desc)
@@ -488,9 +489,9 @@ contains
type(psb_desc_type), intent(inout) :: desc
integer :: info
!locals
integer :: np,me,ictxt, isz, err_act,idx,gidx,lidx
integer :: np,me,ictxt, err_act,idx,gidx,lidx
logical, parameter :: debug=.false.,debugprt=.false.
character(len=20) :: name, char_err
character(len=20) :: name
if (debug) write(0,*) me,'Entered CDCPY'
if (psb_get_errstatus() /= 0) return
info = 0
base/modules/psb_realloc_mod.F90
+6 -6
View File
@@ -634,7 +634,7 @@ Contains
integer, optional, intent(in) :: lb
! ...Local Variables
Integer,allocatable :: tmp(:)
Integer :: dim, err_act, err,i,lb_, lbi, ub_
Integer :: dim, err_act, err,lb_, lbi, ub_
character(len=20) :: name
logical, parameter :: debug=.false.
@@ -712,7 +712,7 @@ Contains
! ...Local Variables
Real(kind(1.d0)),allocatable :: tmp(:)
Integer :: dim,err_act,err,m, lb_, lbi,ub_
Integer :: dim,err_act,err, lb_, lbi,ub_
character(len=20) :: name
logical, parameter :: debug=.false.
@@ -787,7 +787,7 @@ Contains
! ...Local Variables
complex(kind(1.d0)),allocatable :: tmp(:)
Integer :: dim,err_act,err,i,lb_,ub_,lbi
Integer :: dim,err_act,err,lb_,ub_,lbi
character(len=20) :: name
logical, parameter :: debug=.false.
@@ -862,7 +862,7 @@ Contains
! ...Local Variables
Real(kind(1.d0)),allocatable :: tmp(:,:)
Integer :: dim,err_act,err,i, m, dim2,lb1_, lb2_, ub1_, ub2_,&
Integer :: dim,err_act,err, dim2,lb1_, lb2_, ub1_, ub2_,&
& lbi1, lbi2
character(len=20) :: name
@@ -955,7 +955,7 @@ Contains
! ...Local Variables
complex(kind(1.d0)),allocatable :: tmp(:,:)
Integer :: dim,err_act,err,i, m, dim2,lb1_, lb2_, ub1_, ub2_,&
Integer :: dim,err_act,err,dim2,lb1_, lb2_, ub1_, ub2_,&
& lbi1, lbi2
character(len=20) :: name
@@ -1047,7 +1047,7 @@ Contains
! ...Local Variables
integer,allocatable :: tmp(:,:)
Integer :: dim,err_act,err,i, m, dim2,lb1_, lb2_, ub1_, ub2_,&
Integer :: dim,err_act,err, dim2,lb1_, lb2_, ub1_, ub2_,&
& lbi1, lbi2
character(len=20) :: name
base/modules/psb_sort_mod.f90
+23 -31
View File
@@ -28,6 +28,18 @@
!!$ POSSIBILITY OF SUCH DAMAGE.
!!$
!!$
!
! The merge-sort and quicksort routines are implemented in the
! serial/aux directory
! References:
! D. Knuth
! The Art of Computer Programming, vol. 3
! Addison-Wesley
!
! Aho, Hopcroft, Ullman
! Data Structures and Algorithms
! Addison-Wesley
!
module psb_sort_mod
@@ -292,7 +304,7 @@ contains
integer, intent(out) :: nout
integer, optional, intent(in) :: dir
integer :: dir_, flag_, n, err_act
integer :: dir_, n, err_act
character(len=20) :: name
@@ -958,8 +970,7 @@ contains
integer, intent(in) :: key
type(psb_int_heap), intent(inout) :: heap
integer, intent(out) :: info
integer :: i, i2
integer :: temp
info = 0
if (heap%last < 0) then
write(0,*) 'Invalid last in heap ',heap%last
@@ -986,10 +997,6 @@ contains
type(psb_int_heap), intent(inout) :: heap
integer, intent(out) :: key,info
integer :: i, i2, last,j
integer :: temp
info = 0
call psi_int_heap_get_first(key,heap%last,heap%keys,heap%dir,info)
@@ -1070,8 +1077,7 @@ contains
integer, intent(in) :: index
type(psb_double_idx_heap), intent(inout) :: heap
integer, intent(out) :: info
integer :: i, i2, itemp
real(kind(1.d0)) :: temp
info = 0
if (heap%last < 0) then
write(0,*) 'Invalid last in heap ',heap%last
@@ -1101,10 +1107,6 @@ contains
integer, intent(out) :: index,info
real(kind(1.d0)), intent(out) :: key
integer :: i, i2, last,j,itemp
real(kind(1.d0)) :: temp
info = 0
call psi_double_idx_heap_get_first(key,index,&
@@ -1184,8 +1186,7 @@ contains
integer, intent(in) :: index
type(psb_int_idx_heap), intent(inout) :: heap
integer, intent(out) :: info
integer :: i, i2, itemp
integer :: temp
info = 0
if (heap%last < 0) then
write(0,*) 'Invalid last in heap ',heap%last
@@ -1215,10 +1216,6 @@ contains
integer, intent(out) :: index,info
integer, intent(out) :: key
integer :: i, i2, last,j,itemp
integer :: temp
info = 0
call psi_int_idx_heap_get_first(key,index,&
@@ -1301,8 +1298,7 @@ contains
integer, intent(in) :: index
type(psb_dcomplex_idx_heap), intent(inout) :: heap
integer, intent(out) :: info
integer :: i, i2, itemp
complex(kind(1.d0)) :: temp
info = 0
if (heap%last < 0) then
write(0,*) 'Invalid last in heap ',heap%last
@@ -1331,12 +1327,8 @@ contains
integer, intent(out) :: index,info
complex(kind(1.d0)), intent(out) :: key
integer :: i, i2, last,j,itemp
complex(kind(1.d0)) :: temp
info = 0
call psi_dcomplex_idx_heap_get_first(key,index,&
& heap%last,heap%keys,heap%idxs,heap%dir,info)
@@ -1463,7 +1455,7 @@ contains
integer, intent(inout) :: heap(:)
integer, intent(out) :: info
integer :: i, i2,j
integer :: i, j
integer :: temp
@@ -1693,7 +1685,7 @@ contains
real(kind(1.d0)), intent(inout) :: heap(:)
integer, intent(out) :: info
integer :: i, i2,j
integer :: i, j
real(kind(1.d0)) :: temp
@@ -1923,7 +1915,7 @@ contains
complex(kind(1.d0)), intent(inout) :: heap(:)
integer, intent(out) :: info
integer :: i, i2,j
integer :: i, j
complex(kind(1.d0)) :: temp
@@ -2169,7 +2161,7 @@ contains
integer, intent(in) :: dir
integer, intent(out) :: key
integer :: i, i2, j,itemp
integer :: i, j,itemp
integer :: temp
info = 0
@@ -2426,7 +2418,7 @@ contains
integer, intent(in) :: dir
real(kind(1.d0)), intent(out) :: key
integer :: i, i2, j,itemp
integer :: i, j,itemp
real(kind(1.d0)) :: temp
info = 0
@@ -2684,7 +2676,7 @@ contains
integer, intent(in) :: dir
complex(kind(1.d0)), intent(out) :: key
integer :: i, i2, j, itemp
integer :: i, j, itemp
complex(kind(1.d0)) :: temp
info = 0
base/modules/psb_spmat_type.f90
+4 -7
View File
@@ -696,10 +696,9 @@ contains
!....Parameters...
Type(psb_dspmat_type), intent(inout) :: A
Integer, intent(out) :: info
Integer :: i1, i2, ia
!locals
Integer :: nza
Integer :: i1, i2, ia
logical, parameter :: debug=.false.
info = 0
@@ -717,10 +716,8 @@ contains
!....Parameters...
Type(psb_zspmat_type), intent(inout) :: A
Integer, intent(out) :: info
Integer :: i1, i2, ia
!locals
Integer :: nza
Integer :: i1, i2, ia
logical, parameter :: debug=.false.
info = 0
@@ -1395,7 +1392,7 @@ contains
integer, intent(out) :: ires, info
integer, intent(in), optional :: iaux
integer :: i,j,k,ip,jp,nr,irw,nz, err_act, row, ipx, pia, pja, rb,idx, nc
integer :: j,ip,jp,nr,irw,nz, err_act, row, ipx, pia, pja, rb,idx, nc
integer, pointer :: ia1(:), ia2(:), ia3(:), ja(:)
character(len=20) :: name, ch_err
@@ -1555,7 +1552,7 @@ contains
integer, intent(out) :: ires, info
integer, intent(in), optional :: iaux
integer :: i,j,k,ip,jp,nr,irw,nz, err_act, row, ipx, pia, pja, rb,idx, nc
integer :: j,ip,jp,nr,irw,nz, err_act, row, ipx, pia, pja, rb,idx, nc
integer, pointer :: ia1(:), ia2(:), ia3(:), ja(:)
character(len=20) :: name, ch_err
base/modules/psb_tools_mod.f90
+1 -1
View File
@@ -583,7 +583,7 @@ contains
integer, intent(out) :: info
end subroutine psb_cdrep
end interface
character(len=20) :: name, char_err
character(len=20) :: name
integer :: err_act, n_, flag_, i, me, np, nlp
integer, allocatable :: itmpsz(:)
base/modules/psi_mod.f90
+5 -6
View File
@@ -310,10 +310,9 @@ contains
integer, intent(out) :: info
! ....local scalars....
integer :: i,np,me,proc, max_index
integer :: np,me
integer :: ictxt, err_act,nxch,nsnd,nrcv
! ...local array...
integer :: int_err(5)
integer, allocatable :: idx_out(:)
! ...parameters
@@ -416,8 +415,8 @@ contains
subroutine psi_inner_cnv1(n,x,hashsize,hashmask,hashv,glb_lc)
integer, intent(in) :: n, hashsize,hashmask,hashv(0:),glb_lc(:,:)
subroutine psi_inner_cnv1(n,x,hashmask,hashv,glb_lc)
integer, intent(in) :: n,hashmask,hashv(0:),glb_lc(:,:)
integer, intent(inout) :: x(:)
integer :: i, ih, key, idx,nh,tmp,lb,ub,lm
@@ -462,8 +461,8 @@ contains
end subroutine psi_inner_cnv1
subroutine psi_inner_cnv2(n,x,y,hashsize,hashmask,hashv,glb_lc)
integer, intent(in) :: n, hashsize,hashmask,hashv(0:),glb_lc(:,:)
subroutine psi_inner_cnv2(n,x,y,hashmask,hashv,glb_lc)
integer, intent(in) :: n, hashmask,hashv(0:),glb_lc(:,:)
integer, intent(in) :: x(:)
integer, intent(out) :: y(:)
base/psblas/psb_damax.f90
+5 -5
View File
@@ -59,7 +59,7 @@ function psb_damax (x,desc_a, info, jx)
! locals
integer :: ictxt, np, me,&
& err_act, n, iix, jjx, ix, ijx, m, i, k, imax, idamax
& err_act, iix, jjx, ix, ijx, m, imax, idamax
real(kind(1.d0)) :: amax
character(len=20) :: name, ch_err
@@ -183,8 +183,8 @@ function psb_damaxv (x,desc_a, info)
real(kind(1.d0)) :: psb_damaxv
! locals
integer :: err, ictxt, np, me,&
& err_act, n, iix, jjx, jx, ix, ijx, m, imax, idamax
integer :: ictxt, np, me,&
& err_act, iix, jjx, jx, ix, m, imax, idamax
real(kind(1.d0)) :: amax
character(len=20) :: name, ch_err
@@ -307,7 +307,7 @@ subroutine psb_damaxvs (res,x,desc_a, info)
! locals
integer :: ictxt, np, me,&
& err_act, n, iix, jjx, ix, ijx, m, imax, idamax
& err_act, iix, jjx, ix, ijx, m, imax, idamax
real(kind(1.d0)) :: amax
character(len=20) :: name, ch_err
@@ -429,7 +429,7 @@ subroutine psb_dmamaxs (res,x,desc_a, info,jx)
! locals
integer :: ictxt, np, me,&
& err_act, n, iix, jjx, ix, ijx, m, imax, i, k, idamax
& err_act, iix, jjx, ix, ijx, m, imax, i, k, idamax
real(kind(1.d0)) :: amax
character(len=20) :: name, ch_err
base/psblas/psb_dasum.f90
+3 -3
View File
@@ -59,7 +59,7 @@ function psb_dasum (x,desc_a, info, jx)
real(kind(1.d0)) :: psb_dasum
! locals
integer :: ictxt, np, me, err_act, n, &
integer :: ictxt, np, me, err_act, &
& iix, jjx, ix, ijx, m, i
real(kind(1.d0)) :: asum, dasum
character(len=20) :: name, ch_err
@@ -202,7 +202,7 @@ function psb_dasumv (x,desc_a, info)
real(kind(1.d0)) :: psb_dasumv
! locals
integer :: ictxt, np, me, err_act, n, iix, jjx, jx, ix, ijx, m, i
integer :: ictxt, np, me, err_act, iix, jjx, jx, ix, m, i
real(kind(1.d0)) :: asum, dasum
character(len=20) :: name, ch_err
@@ -340,7 +340,7 @@ subroutine psb_dasumvs (res,x,desc_a, info)
integer, intent(out) :: info
! locals
integer :: ictxt, np, me, err_act, n, iix, jjx, ix, jx, ijx, m, i
integer :: ictxt, np, me, err_act, iix, jjx, ix, jx, m, i
real(kind(1.d0)) :: asum, dasum
character(len=20) :: name, ch_err
base/psblas/psb_daxpby.f90
+1 -2
View File
@@ -67,7 +67,6 @@ subroutine psb_daxpby(alpha, x, beta,y,desc_a,info, n, jx, jy)
! locals
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
name='psb_dgeaxpby'
@@ -219,7 +218,7 @@ subroutine psb_daxpbyv(alpha, x, beta,y,desc_a,info)
! locals
integer :: ictxt, np, me,&
& err_act, n, iix, jjx, ix, iy, ijx, m, iiy, in, jjy
& err_act, iix, jjx, ix, iy, m, iiy, jjy
character(len=20) :: name, ch_err
logical, parameter :: debug=.false.
base/psblas/psb_ddot.f90
+9 -9
View File
@@ -62,7 +62,7 @@ function psb_ddot(x, y,desc_a, info, jx, jy)
! locals
integer :: ictxt, np, me,&
& err_act, n, iix, jjx, ix, ijx, iy, ijy, iiy, jjy, i, m, j, k
& err_act, iix, jjx, ix, ijx, iy, ijy, iiy, jjy, i, m
real(kind(1.D0)) :: dot_local
real(kind(1.d0)) :: ddot
character(len=20) :: name, ch_err
@@ -215,8 +215,8 @@ function psb_ddotv(x, y,desc_a, info)
real(kind(1.D0)) :: psb_ddotv
! locals
integer :: int_err(5), ictxt, np, me,&
& err_act, n, iix, jjx, ix, jx, iy, jy, iiy, jjy, i, m, j, k
integer :: ictxt, np, me,&
& err_act, iix, jjx, ix, jx, iy, jy, iiy, jjy, i, m
real(kind(1.D0)) :: dot_local
real(kind(1.d0)) :: ddot
character(len=20) :: name, ch_err
@@ -353,8 +353,8 @@ subroutine psb_ddotvs(res, x, y,desc_a, info)
integer, intent(out) :: info
! locals
integer :: int_err(5), ictxt, np, me,&
& err_act, n, iix, jjx, ix, ijx, iy, ijy, iiy, jjy, i, m, j, k
integer :: ictxt, np, me,&
& err_act, iix, jjx, ix, iy, iiy, jjy, i, m
real(kind(1.D0)) :: dot_local
real(kind(1.d0)) :: ddot
character(len=20) :: name, ch_err
@@ -494,8 +494,8 @@ subroutine psb_dmdots(res, x, y, desc_a, info)
integer, intent(out) :: info
! locals
integer :: int_err(5), ictxt, np, me,&
& err_act, n, iix, jjx, ix, ijx, iy, ijy, iiy, jjy, i, m, j, k
integer :: ictxt, np, me,&
& err_act, iix, jjx, ix, iy, iiy, jjy, i, m, j, k
real(kind(1.d0)),allocatable :: dot_local(:)
real(kind(1.d0)) :: ddot
character(len=20) :: name, ch_err
@@ -598,8 +598,8 @@ subroutine psb_ddot2v(res, x, y,w,z,desc_a, info)
integer, intent(out) :: info
! locals
integer :: int_err(5), ictxt, np, me,&
& err_act, n, iix, jjx, ix, ijx, iy, ijy, iiy, jjy, i, m, j, k
integer :: ictxt, np, me,&
& err_act, iix, jjx, ix, iy, iiy, jjy, i, m
real(kind(1.D0)) :: dot_local(2)
real(kind(1.d0)) :: ddot
character(len=20) :: name, ch_err
base/psblas/psb_dnrm2.f90
+3 -3
View File
@@ -58,7 +58,7 @@ function psb_dnrm2(x, desc_a, info, jx)
! locals
integer :: ictxt, np, me,&
& err_act, n, iix, jjx, ndim, ix, ijx, i, m, id
& err_act, iix, jjx, ndim, ix, ijx, i, m, id
real(kind(1.d0)) :: nrm2, dnrm2, dd
external dcombnrm2
character(len=20) :: name, ch_err
@@ -195,7 +195,7 @@ function psb_dnrm2v(x, desc_a, info)
! locals
integer :: ictxt, np, me,&
& err_act, n, iix, jjx, ndim, ix, jx, ijx, i, m, id
& err_act, iix, jjx, ndim, ix, jx, i, m, id
real(kind(1.d0)) :: nrm2, dnrm2, dd
external dcombnrm2
character(len=20) :: name, ch_err
@@ -330,7 +330,7 @@ subroutine psb_dnrm2vs(res, x, desc_a, info)
! locals
integer :: ictxt, np, me,&
& err_act, n, iix, jjx, ndim, ix, jx, ijx, i, m, id
& err_act, iix, jjx, ndim, ix, jx, i, m, id
real(kind(1.d0)) :: nrm2, dnrm2, dd
external dcombnrm2
character(len=20) :: name, ch_err
base/psblas/psb_dspmm.f90
+5 -5
View File
@@ -104,7 +104,7 @@ subroutine psb_dspmm(alpha,a,x,beta,y,desc_a,info,&
! locals
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,&
& idoswap, m, nrow, ncol, lldx, lldy, liwork, iiy, jjy,&
& i, ib, ib1
integer, parameter :: nb=4
real(kind(1.d0)),pointer :: xp(:,:), yp(:,:), iwork(:)
@@ -441,11 +441,11 @@ subroutine psb_dspmv(alpha,a,x,beta,y,desc_a,info,&
! locals
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
& err_act, n, iix, jjx, ia, ja, iia, jja, ix, iy, ik, &
& idoswap, m, nrow, ncol, lldx, lldy, liwork, jx, jy, iiy, jjy,&
& ib
integer, parameter :: nb=4
real(kind(1.d0)),pointer :: tmpx(:), iwork(:), xp(:), yp(:)
real(kind(1.d0)),pointer :: iwork(:), xp(:), yp(:)
character :: itrans
character(len=20) :: name, ch_err
logical :: aliw
base/psblas/psb_dspsm.f90
+2 -2
View File
@@ -99,7 +99,7 @@ subroutine psb_dspsm(alpha,a,x,beta,y,desc_a,info,&
! locals
integer :: int_err(5), ictxt, np, me,&
& err_act, n, iix, jjx, ia, ja, iia, jja, lldx,lldy, lchoice,&
& err_act, iix, jjx, ia, ja, iia, jja, lldx,lldy, lchoice,&
& ix, iy, ik, ijx, ijy, i, lld,&
& m, nrow, ncol, liwork, llwork, iiy, jjy
@@ -404,7 +404,7 @@ subroutine psb_dspsv(alpha,a,x,beta,y,desc_a,info,&
! locals
integer :: int_err(5), ictxt, np, me,&
& err_act, n, iix, jjx, ia, ja, iia, jja, lldx,lldy, lchoice,&
& err_act, iix, jjx, ia, ja, iia, jja, lldx,lldy, lchoice,&
& ix, iy, ik, jx, jy, i, lld,&
& m, nrow, ncol, liwork, llwork, iiy, jjy
base/psblas/psb_zamax.f90
+4 -4
View File
@@ -59,7 +59,7 @@ function psb_zamax (x,desc_a, info, jx)
! locals
integer :: ictxt, np, me,&
& err_act, n, iix, jjx, ix, ijx, m, i, k, imax, izamax
& err_act, iix, jjx, ix, ijx, m, imax, izamax
real(kind(1.d0)) :: amax
character(len=20) :: name, ch_err
double complex :: zdum
@@ -187,7 +187,7 @@ function psb_zamaxv (x,desc_a, info)
! locals
integer :: ictxt, np, me,&
& err_act, n, iix, jjx, jx, ix, ijx, m, imax, izamax
& err_act, iix, jjx, jx, ix, m, imax, izamax
real(kind(1.d0)) :: amax
complex(kind(1.d0)) :: cmax
character(len=20) :: name, ch_err
@@ -315,7 +315,7 @@ subroutine psb_zamaxvs (res,x,desc_a, info)
! locals
integer :: ictxt, np, me,&
& err_act, n, iix, jjx, ix, ijx, m, imax, izamax
& err_act, iix, jjx, ix, ijx, m, imax, izamax
real(kind(1.d0)) :: amax
character(len=20) :: name, ch_err
complex(kind(1.d0)) :: cmax
@@ -441,7 +441,7 @@ subroutine psb_zmamaxs (res,x,desc_a, info,jx)
! locals
integer :: ictxt, np, me,&
& err_act, n, iix, jjx, ix, ijx, m, imax, i, k, izamax
& err_act, 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
base/psblas/psb_zasum.f90
+4 -4
View File
@@ -59,8 +59,8 @@ function psb_zasum (x,desc_a, info, jx)
real(kind(1.d0)) :: psb_zasum
! locals
integer :: int_err(5), ictxt, np, npcol, me, mycol,&
& err_act, n, iix, jjx, temp(2), ix, ijx, m, i
integer :: ictxt, np, me, &
& err_act, iix, jjx, ix, ijx, m, i
real(kind(1.d0)) :: asum, dzasum
character(len=20) :: name, ch_err
complex(kind(1.d0)) :: cmax
@@ -208,7 +208,7 @@ function psb_zasumv (x,desc_a, info)
! locals
integer :: ictxt, np, me,&
& err_act, n, iix, jjx, jx, ix, ijx, m, i
& err_act, iix, jjx, jx, ix, m, i
real(kind(1.d0)) :: asum, dzasum
character(len=20) :: name, ch_err
complex(kind(1.d0)) :: cmax
@@ -352,7 +352,7 @@ subroutine psb_zasumvs (res,x,desc_a, info)
! locals
integer :: ictxt, np, me,&
& err_act, n, iix, jjx, ix, jx, ijx, m, i
& err_act, iix, jjx, ix, jx, m, i
real(kind(1.d0)) :: asum, dzasum
character(len=20) :: name, ch_err
complex(kind(1.d0)) :: cmax
base/psblas/psb_zaxpby.f90
+1 -1
View File
@@ -217,7 +217,7 @@ subroutine psb_zaxpbyv(alpha, x, beta,y,desc_a,info)
! locals
integer :: ictxt, np, me,&
& err_act, n, iix, jjx, ix, iy, ijx, m, iiy, in, jjy
& err_act, iix, jjx, ix, iy, m, iiy, jjy
character(len=20) :: name, ch_err
logical, parameter :: debug=.false.
base/psblas/psb_zdot.f90
+4 -4
View File
@@ -62,7 +62,7 @@ function psb_zdot(x, y,desc_a, info, jx, jy)
! locals
integer :: ictxt, np, me,&
& err_act, n, iix, jjx, ix, ijx, iy, ijy, iiy, jjy, i, m, j, k
& err_act, iix, jjx, ix, ijx, iy, ijy, iiy, jjy, i, m
complex(kind(1.D0)) :: dot_local
complex(kind(1.d0)) :: zdotc
character(len=20) :: name, ch_err
@@ -215,7 +215,7 @@ function psb_zdotv(x, y,desc_a, info)
! locals
integer :: ictxt, np, me,&
& err_act, n, iix, jjx, ix, jx, iy, jy, iiy, jjy, i, m, j, k
& err_act, iix, jjx, ix, jx, iy, jy, iiy, jjy, i, m
complex(kind(1.D0)) :: dot_local
complex(kind(1.d0)) :: zdotc
character(len=20) :: name, ch_err
@@ -353,7 +353,7 @@ subroutine psb_zdotvs(res, x, y,desc_a, info)
! locals
integer :: ictxt, np, me,&
& err_act, n, iix, jjx, ix, ijx, iy, ijy, iiy, jjy, i, m, j, k
& err_act, iix, jjx, ix, iy, iiy, jjy, i, m
complex(kind(1.D0)) :: dot_local
complex(kind(1.d0)) :: zdotc
character(len=20) :: name, ch_err
@@ -493,7 +493,7 @@ subroutine psb_zmdots(res, x, y, desc_a, info)
! locals
integer :: ictxt, np, me,&
& err_act, n, iix, jjx, ix, ijx, iy, ijy, iiy, jjy, i, m, j, k
& err_act, iix, jjx, ix, iy, iiy, jjy, i, m, j, k
complex(kind(1.d0)),allocatable :: dot_local(:)
complex(kind(1.d0)) :: zdotc
character(len=20) :: name, ch_err
base/psblas/psb_znrm2.f90
+3 -3
View File
@@ -58,7 +58,7 @@ function psb_znrm2(x, desc_a, info, jx)
! locals
integer :: ictxt, np, me,&
& err_act, n, iix, jjx, ndim, ix, ijx, i, m, id
& err_act, iix, jjx, ndim, ix, ijx, i, m, id
real(kind(1.d0)) :: nrm2, dznrm2, dd
external dcombnrm2
@@ -194,7 +194,7 @@ function psb_znrm2v(x, desc_a, info)
! locals
integer :: ictxt, np, me,&
& err_act, n, iix, jjx, ndim, ix, jx, ijx, i, m, id
& err_act, iix, jjx, ndim, ix, jx, i, m, id
real(kind(1.d0)) :: nrm2, dznrm2, dd
external dcombnrm2
@@ -329,7 +329,7 @@ subroutine psb_znrm2vs(res, x, desc_a, info)
! locals
integer :: ictxt, np, me,&
& err_act, n, iix, jjx, ndim, ix, jx, ijx, i, m, id
& err_act, iix, jjx, ndim, ix, jx, i, m, id
real(kind(1.d0)) :: nrm2, dznrm2, dd
external dcombnrm2
base/psblas/psb_zspmm.f90
+2 -2
View File
@@ -435,9 +435,9 @@ subroutine psb_zspmv(alpha,a,x,beta,y,desc_a,info,&
! locals
integer :: ictxt, np, me,&
& err_act, n, iix, jjx, ia, ja, iia, jja, ix, iy, ik, ijx, ijy,&
& err_act, n, iix, jjx, ia, ja, iia, jja, ix, iy, ik, &
& idoswap, m, nrow, ncol, lldx, lldy, liwork, jx, jy, iiy, jjy,&
& i, ib, ib1
& ib
integer, parameter :: nb=4
complex(kind(1.d0)),pointer :: iwork(:), xp(:), yp(:)
character :: itrans
base/psblas/psb_zspsm.f90
+2 -2
View File
@@ -99,7 +99,7 @@ subroutine psb_zspsm(alpha,a,x,beta,y,desc_a,info,&
! locals
integer :: ictxt, np, me,&
& err_act, n, iix, jjx, ia, ja, iia, jja, lldx,lldy, lchoice,&
& err_act, 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
@@ -407,7 +407,7 @@ subroutine psb_zspsv(alpha,a,x,beta,y,desc_a,info,&
! locals
integer :: ictxt, np, me, &
& err_act, n, iix, jjx, ia, ja, iia, jja, lldx,lldy, lchoice,&
& err_act, 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
base/serial/aux/dasr.f90
+1 -1
View File
@@ -41,7 +41,7 @@ subroutine dasr(n,x,dir)
real(kind(1.d0)) :: x(n)
! ..
! .. Local Scalars ..
real(kind(1.d0)) :: xx, piv, xt, xk
real(kind(1.d0)) :: piv, xt, xk
integer i, j, ilx, iux, istp, lpiv
integer n1, n2
base/serial/aux/dasrx.f90
+2 -2
View File
@@ -41,8 +41,8 @@ subroutine dasrx(n,x,indx,dir,flag)
integer :: indx(n)
! ..
! .. Local Scalars ..
real(kind(1.d0)) :: xx, piv, xt, xk
integer i, j, ii, ilx, iux, istp, lpiv
real(kind(1.d0)) :: piv, xt, xk
integer i, j, ilx, iux, istp, lpiv
integer ixt, n1, n2
integer, parameter :: maxstack=64,nparms=3,ithrs=16
base/serial/aux/dsr.f90
+1 -1
View File
@@ -41,7 +41,7 @@ subroutine dsr(n,x,dir)
real(kind(1.d0)) :: x(n)
! ..
! .. Local Scalars ..
real(kind(1.d0)) :: xx, piv, xt, xk
real(kind(1.d0)) :: piv, xt, xk
integer i, j, ilx, iux, istp, lpiv
integer n1, n2
base/serial/aux/dsrx.f90
+2 -2
View File
@@ -41,8 +41,8 @@ subroutine dsrx(n,x,indx,dir,flag)
integer :: indx(n)
! ..
! .. Local Scalars ..
real(kind(1.d0)) :: xx, piv, xk, xt
integer i, j, ii, ilx, iux, istp, lpiv
real(kind(1.d0)) :: piv, xk, xt
integer i, j, ilx, iux, istp, lpiv
integer ixt, n1, n2
integer, parameter :: maxstack=64,nparms=3,ithrs=16
base/serial/aux/iasr.f90
+1 -1
View File
@@ -41,7 +41,7 @@ subroutine iasr(n,x,dir)
integer :: x(n)
! ..
! .. Local Scalars ..
integer :: xx, piv, xt, xk
integer :: piv, xt, xk
integer i, j, ilx, iux, istp, lpiv
integer n1, n2
base/serial/aux/iasrx.f90
+2 -2
View File
@@ -41,8 +41,8 @@ subroutine iasrx(n,x,indx,dir,flag)
integer :: indx(n)
! ..
! .. Local Scalars ..
integer :: xx, piv, xt, xk
integer i, j, ii, ilx, iux, istp, lpiv
integer :: piv, xt, xk
integer i, j, ilx, iux, istp, lpiv
integer ixt, n1, n2
integer, parameter :: maxstack=64,nparms=3,ithrs=16
base/serial/aux/imsru.f90
+1 -4
View File
@@ -38,10 +38,7 @@ subroutine imsru(n,x,idir,nout)
integer :: x(n)
integer, allocatable :: iaux(:)
integer :: iswap, iret, info, lp, k
integer :: lswap
integer :: k
nout = 0
if (n<0) then
base/serial/aux/isr.f90
+1 -1
View File
@@ -41,7 +41,7 @@ subroutine isr(n,x,dir)
integer :: x(n)
! ..
! .. Local Scalars ..
integer :: xx, xk, piv, xt
integer :: xk, piv, xt
integer i, j, ilx, iux, istp, lpiv
integer n1, n2
base/serial/aux/isrx.f90
+2 -2
View File
@@ -40,8 +40,8 @@ subroutine isrx(n,x,indx,dir,flag)
integer :: x(n), indx(n)
! ..
! .. Local Scalars ..
integer :: xx, piv, xk, xt
integer i, j, ii, ilx, iux, istp, lpiv
integer :: piv, xk, xt
integer i, j, ilx, iux, istp, lpiv
integer ixt, n1, n2
integer, parameter :: maxstack=64,nparms=3,ithrs=16
base/serial/aux/zalsr.f90
+1 -1
View File
@@ -42,7 +42,7 @@ subroutine zalsr(n,x,dir)
complex(kind(1.d0)) :: x(n)
! ..
! .. Local Scalars ..
complex(kind(1.d0)) :: xx, xk, piv, xt
complex(kind(1.d0)) :: xk, piv, xt
integer i, j, ilx, iux, istp, lpiv
integer n1, n2
base/serial/aux/zalsrx.f90
+2 -2
View File
@@ -42,8 +42,8 @@ subroutine zalsrx(n,x,indx,dir,flag)
integer :: indx(n)
! ..
! .. Local Scalars ..
complex(kind(1.d0)) :: xx, piv, xk, xt
integer i, j, ii, ilx, iux, istp, lpiv
complex(kind(1.d0)) :: piv, xk, xt
integer i, j, ilx, iux, istp, lpiv
integer ixt, n1, n2
integer, parameter :: maxstack=64,nparms=3,ithrs=16
base/serial/aux/zasr.f90
+1 -1
View File
@@ -42,7 +42,7 @@ subroutine zasr(n,x,dir)
complex(kind(1.d0)) :: x(n)
! ..
! .. Local Scalars ..
complex(kind(1.d0)) :: xx, xk, piv, xt
complex(kind(1.d0)) :: xk, piv, xt
integer i, j, ilx, iux, istp, lpiv
integer n1, n2
base/serial/aux/zasrx.f90
+2 -2
View File
@@ -42,8 +42,8 @@ subroutine zasrx(n,x,indx,dir,flag)
integer :: indx(n)
! ..
! .. Local Scalars ..
complex(kind(1.d0)) :: xx, piv, xk, xt
integer i, j, ii, ilx, iux, istp, lpiv
complex(kind(1.d0)) :: piv, xk, xt
integer i, j, ilx, iux, istp, lpiv
integer ixt, n1, n2
integer, parameter :: maxstack=64,nparms=3,ithrs=16
base/serial/aux/zlsr.f90
+1 -1
View File
@@ -42,7 +42,7 @@ subroutine zlsr(n,x,dir)
complex(kind(1.d0)) :: x(n)
! ..
! .. Local Scalars ..
complex(kind(1.d0)) :: xx, xk, piv, xt
complex(kind(1.d0)) :: xk, piv, xt
integer i, j, ilx, iux, istp, lpiv
integer n1, n2
base/serial/aux/zlsrx.f90
+2 -2
View File
@@ -42,8 +42,8 @@ subroutine zlsrx(n,x,indx,dir,flag)
integer :: indx(n)
! ..
! .. Local Scalars ..
complex(kind(1.d0)) :: xx, piv, xk, xt
integer i, j, ii, ilx, iux, istp, lpiv
complex(kind(1.d0)) :: piv, xk, xt
integer i, j, ilx, iux, istp, lpiv
integer ixt, n1, n2
integer, parameter :: maxstack=64,nparms=3,ithrs=16
base/serial/dp/dcocr.f
+2 -2
View File
@@ -42,8 +42,8 @@ C
C
C .. Scalar Arguments ..
INTEGER LARN, LAUX, LAUX2, LIAN1, LIAN2, M,
+ N, IUPDUP, IERROR
INTEGER LARN, LAUX, LIAN1, LIAN2, M,
+ N, IERROR
CHARACTER TRANS,UNITD
C .. Array Arguments ..
DOUBLE PRECISION AR(*), ARN(*), D(*)
base/serial/f77/daxpby.f
-1
View File
@@ -36,7 +36,6 @@ C
double precision alpha, beta
integer i, j
integer int_err(5)
double precision real_err(5)
character name*20
name='daxpby'
base/serial/f77/dcsmm.f
+1 -2
View File
@@ -205,9 +205,8 @@ C .. Local Scalars ..
INTEGER LWORKM, LWORKB, LWORKC, LWORKS, P, ERR_ACT
LOGICAL LP, RP
C .. Local Array..
INTEGER INT_VAL(5),iunit
INTEGER INT_VAL(5)
CHARACTER*20 NAME
DOUBLE PRECISION REAL_VAL(5)
CHARACTER*30 STRINGS(2)
C .. External Subroutines ..
EXTERNAL DSWMM, DLPUPD, DSCAL
base/serial/f77/dcsnmi.f
-1
View File
@@ -107,7 +107,6 @@ C .. Local Scalars..
INTEGER ERR_ACT
C .. Local Array..
INTEGER INT_VAL(5)
DOUBLE PRECISION REAL_VAL(5)
C .. External Subroutines ..
DOUBLE PRECISION DCRNRMI, DJDNRMI, DCOONRMI
EXTERNAL DCRNRMI, DJDNRMI, DCOONRMI
base/serial/f77/dcsrws.f
-1
View File
@@ -111,7 +111,6 @@ C .. Array Arguments ..
DOUBLE PRECISION A(*), ROWSUM(*)
C .. Local Array..
INTEGER INT_VAL(5), ERR_ACT
DOUBLE PRECISION REAL_VAL(5)
CHARACTER*30 NAME,STRINGS(2)
C .. Parameters ..
DOUBLE PRECISION ZERO
base/serial/f77/dcssm.f
-1
View File
@@ -210,7 +210,6 @@ C .. Local Scalars ..
LOGICAL LP, RP
C .. Local Array..
INTEGER INT_VAL(5)
DOUBLE PRECISION REAL_VAL(5)
CHARACTER*30 STRINGS(2)
CHARACTER NAME*30
C .. Parameters ..
base/serial/f77/smmp.f
+1 -1
View File
@@ -25,7 +25,7 @@ c
* index(*)
integer, allocatable :: ic(:),jc(:)
integer :: nze, info
integer, save :: iunit=11
c$$$ integer, save :: iunit=11
c
c symbolic matrix multiply c=a*b
c
base/serial/f77/zaxpby.f
-1
View File
@@ -36,7 +36,6 @@ C
complex(kind(1.d0)) alpha, beta
integer i, j
integer int_err(5)
double precision real_err(5)
character name*20
name='zaxpby'
base/serial/f77/zcsmm.f
-1
View File
@@ -176,7 +176,6 @@ C .. Local Scalars ..
LOGICAL LP, RP
C .. Local Array..
INTEGER INT_VAL(5)
COMPLEX*16 Z_VAL(5)
CHARACTER*30 NAME, STRINGS(2)
C .. Parameters ..
COMPLEX*16 ZERO
base/serial/f77/zcsnmi.f
-1
View File
@@ -75,7 +75,6 @@ C .. Array Arguments ..
COMPLEX*16 A(*)
C .. Local Array..
INTEGER INT_VAL(5), ERR_ACT
DOUBLE PRECISION REAL_VAL(5)
CHARACTER*30 NAME, STRINGS(2)
C .. External Subroutines ..
DOUBLE PRECISION ZCRNRMI, ZCOONRMI
base/serial/f77/zcsrws.f
-1
View File
@@ -81,7 +81,6 @@ C .. Array Arguments ..
COMPLEX*16 A(*), ROWSUM(*)
C .. Local Array..
INTEGER INT_VAL(5), ERR_ACT
DOUBLE PRECISION REAL_VAL(5)
CHARACTER*30 NAME,STRINGS(2)
C .. Parameters ..
DOUBLE PRECISION ZERO
base/serial/f77/zcssm.f
-1
View File
@@ -181,7 +181,6 @@ C .. Local Scalars ..
LOGICAL LP, RP
C .. Local Array..
INTEGER INT_VAL(5), ERR_ACT
COMPLEX*16 Z_VAL(5)
CHARACTER*30 NAME, STRINGS(2)
C .. Parameters ..
PARAMETER (ZERO = (0.D0, 0.D0))
base/serial/f77/zswmm.f
-1
View File
@@ -126,7 +126,6 @@ C .. Array Arguments ..
COMPLEX*16 A(*),B(LDB,*),C(LDC,*),WORK(*)
C .. Local Array ..
INTEGER INT_VAL(5), ERR_ACT
COMPLEX*16 Z_VAL(5)
CHARACTER*30 NAME, STRINGS(2)
C .. External Subroutines ..
EXTERNAL ZCSRMM
base/serial/psb_dcoins.f90
+1 -1
View File
@@ -51,7 +51,7 @@ subroutine psb_dcoins(nz,ia,ja,val,a,imin,imax,jmin,jmax,info,gtl,rebuild)
logical, intent(in), optional :: rebuild
character(len=5) :: ufida
integer :: i,j,ir,ic,nr,nc, ng, nza, isza,spstate, nnz,&
integer :: ng, nza, isza,spstate, &
& ip1, nzl, err_act, int_err(5), iupd, irst
logical, parameter :: debug=.false.
logical :: rebuild_
base/serial/psb_dcsrp.f90
+2 -3
View File
@@ -76,10 +76,9 @@ subroutine psb_dcsrp(trans,iperm,a, info)
character, intent(in) :: trans
!....locals....
integer,allocatable :: ipt(:)
integer :: i,np,me, n_col,l_dcsdp, ipsize
integer :: dectype
integer :: i, n_col,l_dcsdp, ipsize
real(kind(1.d0)), allocatable :: work_dcsdp(:)
integer :: ictxt,n_row,err_act, int_err(5)
integer :: n_row,err_act, int_err(5)
character(len=20) :: name, char_err
real(kind(1.d0)) :: time(10)
base/serial/psb_dcssv.f90
+1 -1
View File
@@ -47,7 +47,7 @@ subroutine psb_dcssv(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_dcssv'
info = 0
base/serial/psb_dgelp.f90
+4 -4
View File
@@ -51,9 +51,9 @@ subroutine psb_dgelp(trans,iperm,x,info)
character, intent(in) :: trans
! local variables
integer :: ictxt,np, me,nrow,ncol
integer :: ictxt
real(kind(1.d0)),allocatable :: dtemp(:)
integer :: int_err(5), i1sz, i2sz, dectype, i, err_act
integer :: int_err(5), i1sz, i2sz, err_act
integer, allocatable :: itemp(:)
real(kind(1.d0)),parameter :: one=1
logical, parameter :: debug=.false.
@@ -181,8 +181,8 @@ subroutine psb_dgelpv(trans,iperm,x,info)
character, intent(in) :: trans
! local variables
integer :: ictxt,np,me
integer :: int_err(5), i1sz,nrow,ncol,dectype, err_act
integer :: ictxt
integer :: int_err(5), i1sz, err_act
real(kind(1.d0)),allocatable :: dtemp(:)
integer, allocatable :: itemp(:)
real(kind(1.d0)),parameter :: one=1
base/serial/psb_dipcoo2csc.f90
+1 -1
View File
@@ -49,7 +49,7 @@ subroutine psb_dipcoo2csc(a,info,clshr)
integer, allocatable :: iaux(:), itemp(:)
!locals
logical :: clshr_
Integer :: nza, nr, i,j, idl,err_act,nc,icl
Integer :: nza, i,j, idl,err_act,nc,icl
Integer, Parameter :: maxtry=8
logical, parameter :: debug=.false.
character(len=20) :: name
base/serial/psb_dipcsr2coo.f90
+1 -1
View File
@@ -50,7 +50,7 @@ Subroutine psb_dipcsr2coo(a,info)
integer :: i,j,err_act
logical, parameter :: debug=.false.
integer, allocatable :: iaux(:), itemp(:)
character(len=20) :: name, ch_err
character(len=20) :: name
name='psb_dipcsr2coo'
info = 0
base/serial/psb_dneigh.f90
+17 -7
View File
@@ -47,10 +47,9 @@ subroutine psb_dneigh(a,idx,neigh,n,info,lev)
integer, allocatable :: neigh(:) ! the neighbours
integer, optional :: lev ! level of neighbours to find
integer, allocatable :: tmpn(:)
integer :: lev_, dim, i, j, k, r, c, brow,nl, ifl,ill,&
& elem_pt, ii, n1, col_idx, ne, err_act, nn, nidx,ntl
character(len=20) :: name, ch_err
integer :: lev_, i, nl, ifl,ill,&
& n1, err_act, nn, nidx,ntl
character(len=20) :: name
integer, allocatable :: ia(:), ja(:)
real(kind(1.d0)), allocatable :: val(:)
@@ -67,8 +66,11 @@ subroutine psb_dneigh(a,idx,neigh,n,info,lev)
end if
call psb_sp_getrow(idx,a,n,ia,ja,val,info)
call psb_realloc(n,neigh,info)
if (info == 0) call psb_realloc(n,neigh,info)
if (info /= 0) then
call psb_errpush(4000,name)
goto 9999
end if
neigh(1:n) = ja(1:n)
ifl = 1
ill = n
@@ -77,12 +79,20 @@ subroutine psb_dneigh(a,idx,neigh,n,info,lev)
do nl = 2, lev_
n1 = ill - ifl + 1
call psb_ensure_size(ill+n1*n1,neigh,info)
if (info /= 0) then
call psb_errpush(4000,name)
goto 9999
end if
ntl = 0
do i=ifl,ill
nidx=neigh(i)
if ((nidx.ne.idx).and.(nidx.gt.0).and.(nidx.le.a%m)) then
call psb_sp_getrow(nidx,a,nn,ia,ja,val,info)
call psb_ensure_size(ill+ntl+nn,neigh,info)
if (info==0) call psb_ensure_size(ill+ntl+nn,neigh,info)
if (info /= 0) then
call psb_errpush(4000,name)
goto 9999
end if
neigh(ill+ntl+1:ill+ntl+nn)=ja(1:nn)
ntl = ntl+nn
end if
base/serial/psb_dnumbmm.f90
+1 -2
View File
@@ -83,9 +83,8 @@ contains
real(kind(1.d0)) :: temp(:)
integer, allocatable :: iarw(:), iacl(:),ibrw(:),ibcl(:)
real(kind(1.d0)), allocatable :: aval(:),bval(:)
integer :: maxlmn,i,j,m,n,k,l,istart,length,nazr,nbzr,jj,ii,minlm,minmn,minln
integer :: maxlmn,i,j,m,n,k,l,nazr,nbzr,jj,minlm,minmn,minln
real(kind(1.d0)) :: ajj
type(psb_dspmat_type) :: w
n = a%m
m = a%k
base/serial/psb_dspclip.f90
+2 -2
View File
@@ -47,8 +47,8 @@ subroutine psb_dspclip(a,b,info,imin,imax,jmin,jmax,rscale,cscale)
integer, intent(in), optional :: imin,imax,jmin,jmax
logical, intent(in), optional :: rscale,cscale
integer :: lrw_, ierr(5), err_act
character(len=20) :: name, ch_err
integer :: err_act
character(len=20) :: name
integer :: imin_,imax_,jmin_,jmax_
logical :: rscale_,cscale_
integer :: sizeb, nzb, mb, kb, ifst, ilst, nrt, nzt, i, j
base/serial/psb_dspcnv.f90
+4 -20
View File
@@ -63,8 +63,7 @@ subroutine psb_dspcnv2(a, b,info,afmt,upd,dupl)
type(psb_dspmat_type) :: temp_a
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, i1, i2, ia
integer :: err_act
character :: check_,trans_,unitd_
character(len=5) :: afmt_
Integer, Parameter :: maxtry=8
@@ -389,11 +388,10 @@ subroutine psb_dspcnv1(a, info, afmt, upd, dupl)
integer :: int_err(5)
type(psb_dspmat_type) :: atemp
integer :: np,me,n_col,iout, err_act
integer :: err_act
integer :: spstate
integer :: upd_, dupl_
integer :: ictxt,n_row
logical, parameter :: debug=.false., debugwrt=.false.
logical, parameter :: debug=.false.
character(len=20) :: name, ch_err
info = 0
@@ -471,18 +469,11 @@ subroutine psb_dspcnv1(a, info, afmt, upd, dupl)
! convert to user requested format after the temp copy
end if
if (debugwrt) then
iout = 30+me
open(iout)
call psb_csprt(iout,atemp,head='Input mat')
close(iout)
endif
! Do the real conversion into the requested storage format
! result is put in A
call psb_spcnv(atemp,a,info,afmt=afmt,upd=upd,dupl=dupl)
IF (debug) WRITE (*, *) me,' ASB: From SPCNV',info,' ',A%FIDA
IF (debug) WRITE (*, *) ' ASB: From SPCNV',info,' ',A%FIDA
if (info /= psb_no_err_) then
info=4010
ch_err='psb_csdp'
@@ -490,13 +481,6 @@ subroutine psb_dspcnv1(a, info, afmt, upd, dupl)
goto 9999
endif
if (debugwrt) then
iout = 60+me
open(iout)
call psb_csprt(iout,a,head='Output mat')
close(iout)
endif
call psb_sp_free(atemp,info)
else if (spstate == psb_spmat_upd_) then
base/serial/psb_dspgetrow.f90
+1 -1
View File
@@ -56,7 +56,7 @@ subroutine psb_dspgetrow(irw,a,nz,ia,ja,val,info,iren,lrw,append,nzin)
integer, intent(in), optional :: lrw, nzin
logical :: append_
integer :: i,j,k,ip,jp,nr,idx,iret,nzin_, nza, lrw_, irw_, err_act
integer :: nzin_, lrw_, irw_, err_act
character(len=20) :: name, ch_err
name='psb_spgetrow'
base/serial/psb_dspgtblk.f90
+2 -14
View File
@@ -57,12 +57,11 @@ subroutine psb_dspgtblk(irw,a,b,info,append,iren,lrw,srt)
logical, intent(in), optional :: srt
logical :: append_,srt_
integer :: i,j,k,ip,jp,nr,idx, nz,iret,nzb, nza, lrw_, irw_, err_act
character(len=20) :: name, ch_err
integer :: nz,nzb, lrw_, irw_
character(len=20) :: name
name='psb_spgtblk'
info = 0
!!$ call psb_erractionsave(err_act)
irw_ = irw
if (present(lrw)) then
@@ -111,18 +110,7 @@ subroutine psb_dspgtblk(irw,a,b,info,append,iren,lrw,srt)
b%m = b%m+lrw_-irw+1
b%k = max(b%k,a%k)
if (srt_) call psb_fixcoo(b,info)
!!$ call psb_erractionrestore(err_act)
return
9999 continue
!!$ call psb_erractionrestore(err_act)
call psb_erractionsave(err_act)
if (err_act.eq.psb_act_abort_) then
call psb_error()
return
end if
return
end subroutine psb_dspgtblk
base/serial/psb_dspgtdiag.f90
+2 -2
View File
@@ -50,8 +50,8 @@ subroutine psb_dspgtdiag(a,d,info)
integer, intent(out) :: info
type(psb_dspmat_type) :: tmpa
integer :: i,j,k,nr, nz, err_act, ii, rng, irb, nrb
character(len=20) :: name, ch_err
integer :: i,j, err_act, ii, rng, irb, nrb
character(len=20) :: name, ch_err
name='psb_dspgtdiag'
info = 0
base/serial/psb_dspscal.f90
+1 -1
View File
@@ -48,7 +48,7 @@ subroutine psb_dspscal(a,d,info)
integer, intent(out) :: info
real(kind(1.d0)), intent(in) :: d(:)
integer :: i,j,k,nr, nz,err_act
integer :: i,j,err_act
character(len=20) :: name, ch_err
name='psb_dspscal'
base/serial/psb_dsymbmm.f90
+2 -3
View File
@@ -56,7 +56,7 @@ subroutine psb_dsymbmm(a,b,c,info)
integer, allocatable :: ic(:),jc(:)
end subroutine symbmm
end interface
character(len=20) :: name, ch_err
character(len=20) :: name
integer :: err_act
logical :: csra, csrb
name='psb_symbmm'
@@ -113,8 +113,7 @@ contains
integer :: index(:),info
integer, allocatable :: iarw(:), iacl(:),ibrw(:),ibcl(:)
real(kind(1.d0)), allocatable :: aval(:),bval(:)
integer :: maxlmn,i,j,m,n,k,l,istart,length,nazr,nbzr,jj,ii,minlm,minmn
type(psb_dspmat_type) :: w
integer :: maxlmn,i,j,m,n,k,l,istart,length,nazr,nbzr,jj,minlm,minmn
n = a%m
base/serial/psb_dtransp.f90
+1 -2
View File
@@ -45,9 +45,8 @@ subroutine psb_dtransp(a,b,c,fmt)
character(len=*), optional :: fmt
character(len=5) :: fmt_
integer ::c_, info, nz
integer ::c_, info
integer, allocatable :: itmp(:)
type(psb_dspmat_type) :: tmp
if (present(c)) then
c_=c
base/serial/psb_getrow_mod.f90
+2 -2
View File
@@ -140,7 +140,7 @@ contains
logical, intent(in) :: append
integer :: lrw,info
integer, optional :: iren(:)
integer :: nzin_, nza, idx,ip,jp,i,j,k, nzt
integer :: nzin_, nza, idx,ip,jp,i,k, nzt
logical, parameter :: debug=.false.
nza = a%infoa(psb_nnz_)
@@ -545,7 +545,7 @@ contains
logical, intent(in) :: append
integer :: lrw,info
integer, optional :: iren(:)
integer :: nzin_, nza, idx,ip,jp,i,j,k, nzt
integer :: nzin_, nza, idx,ip,jp,i,k, nzt
logical, parameter :: debug=.false.
nza = a%infoa(psb_nnz_)
base/serial/psb_regen_mod.f90
+12 -12
View File
@@ -22,10 +22,10 @@ contains
type(psb_dspmat_type), intent(inout) :: a
integer :: info
integer :: i,j, k, ip1,ip2,nnz,iflag,ichk,nnzt
integer :: i, ip1,ip2,nnz,iflag,ichk,nnzt
real(kind(1.d0)), allocatable :: work(:)
integer :: err_act
character(len=20) :: name, ch_err
character(len=20) :: name
logical, parameter :: debug=.false.
name='psb_spcnv'
@@ -121,10 +121,10 @@ contains
type(psb_dspmat_type), intent(inout) :: a
integer :: info
integer :: i,j, k, ip1,ip2,nnz,iflag,ichk,nnzt
integer :: i, ip1,ip2,nnz,iflag,ichk,nnzt
real(kind(1.d0)), allocatable :: work(:)
integer :: err_act
character(len=20) :: name, ch_err
character(len=20) :: name
logical, parameter :: debug=.false.
name='psb_spcnv'
@@ -220,10 +220,10 @@ contains
type(psb_dspmat_type), intent(inout) :: a
integer :: info
integer :: i,j, k, ip1,ip2,nnz,iflag,ichk,nnzt
integer :: i, ip1,ip2,nnz,iflag,ichk,nnzt
real(kind(1.d0)), allocatable :: work(:)
integer :: err_act
character(len=20) :: name, ch_err
character(len=20) :: name
logical, parameter :: debug=.false.
name='psb_spcnv'
@@ -321,10 +321,10 @@ contains
type(psb_zspmat_type), intent(inout) :: a
integer :: info
integer :: i,j, k, ip1,ip2,nnz,iflag,ichk,nnzt
integer :: i, ip1,ip2,nnz,iflag,ichk,nnzt
complex(kind(1.d0)), allocatable :: work(:)
integer :: err_act
character(len=20) :: name, ch_err
character(len=20) :: name
logical, parameter :: debug=.false.
name='psb_spcnv'
@@ -420,10 +420,10 @@ contains
type(psb_zspmat_type), intent(inout) :: a
integer :: info
integer :: i,j, k, ip1,ip2,nnz,iflag,ichk,nnzt
integer :: i, ip1,ip2,nnz,iflag,ichk,nnzt
complex(kind(1.d0)), allocatable :: work(:)
integer :: err_act
character(len=20) :: name, ch_err
character(len=20) :: name
logical, parameter :: debug=.false.
name='psb_spcnv'
@@ -519,10 +519,10 @@ contains
type(psb_zspmat_type), intent(inout) :: a
integer :: info
integer :: i,j, k, ip1,ip2,nnz,iflag,ichk,nnzt
integer :: i, ip1,ip2,nnz,iflag,ichk,nnzt
complex(kind(1.d0)), allocatable :: work(:)
integer :: err_act
character(len=20) :: name, ch_err
character(len=20) :: name
logical, parameter :: debug=.false.
name='psb_spcnv'
base/serial/psb_update_mod.f90
+32 -8
View File
@@ -176,7 +176,7 @@ contains
logical, parameter :: debug=.false.
integer :: i,ir,ic, ilr, ilc, ip, &
& i1,i2,nc,lb,ub,m,nnz,dupl
& i1,i2,nc,lb,ub,m,dupl
info = 0
@@ -403,7 +403,7 @@ contains
integer, intent(out) :: info
integer, intent(in), optional :: ng,gtl(*)
integer :: i,ir,ic, ilr, ilc, ip, &
& i1,i2,nc,lb,ub,m,nnz,dupl,isrt
& i1,i2,nc,nnz,dupl
logical, parameter :: debug=.false.
info = 0
@@ -451,6 +451,9 @@ contains
i1 = i1 - 1
end do
ilr = ir
else
i1 = 1
i2 = 1
end if
nc = i2-i1+1
call issrch(ip,ic,nc,a%ia2(i1:i2))
@@ -489,6 +492,9 @@ contains
i1 = i1 - 1
end do
ilr = ir
else
i1 = 1
i2 = 1
end if
nc = i2-i1+1
call issrch(ip,ic,nc,a%ia2(i1:i2))
@@ -535,6 +541,9 @@ contains
i1 = i1 - 1
end do
ilr = ir
else
i1 = 1
i2 = 1
end if
nc = i2-i1+1
call issrch(ip,ic,nc,a%ia2(i1:i2))
@@ -568,6 +577,9 @@ contains
i1 = i1 - 1
end do
ilr = ir
else
i1 = 1
i2 = 1
end if
nc = i2-i1+1
call issrch(ip,ic,nc,a%ia2(i1:i2))
@@ -610,8 +622,8 @@ contains
integer, pointer :: ia1(:), ia2(:), ia3(:),&
& ja_(:), ka_(:)
integer, allocatable :: indices(:), blks(:), rows(:)
integer :: png, pia, pja, ipx, blk, rb, row, k_pt, npg, col, ngr, nzin_,&
& i,j,k,nr,dupl, ii, ir, ic
integer :: png, pia, pja, ipx, blk, rb, row, k_pt, npg, col, ngr,&
& i,j,nr,dupl, ii, ir, ic
info = 0
dupl = psb_sp_getifld(psb_dupl_,a,info)
@@ -846,7 +858,7 @@ contains
integer, intent(in), optional :: ng,gtl(*)
integer :: i,ir,ic, ilr, ilc, ip, &
& i1,i2,nc,lb,ub,m,nnz,dupl
& i1,i2,nc,lb,ub,m,dupl
logical, parameter :: debug=.false.
info = 0
@@ -1066,7 +1078,7 @@ contains
integer, intent(out) :: info
integer, intent(in), optional :: ng,gtl(*)
integer :: i,ir,ic, ilr, ilc, ip, &
& i1,i2,nc,lb,ub,m,nnz,dupl,isrt
& i1,i2,nc,nnz,dupl
logical, parameter :: debug=.false.
info = 0
@@ -1114,6 +1126,9 @@ contains
i1 = i1 - 1
end do
ilr = ir
else
i1 = 1
i2 = 1
end if
nc = i2-i1+1
call issrch(ip,ic,nc,a%ia2(i1:i2))
@@ -1151,6 +1166,9 @@ contains
i1 = i1 - 1
end do
ilr = ir
else
i1 = 1
i2 = 1
end if
nc = i2-i1+1
call issrch(ip,ic,nc,a%ia2(i1:i2))
@@ -1195,6 +1213,9 @@ contains
i1 = i1 - 1
end do
ilr = ir
else
i1 = 1
i2 = 1
end if
nc = i2-i1+1
call issrch(ip,ic,nc,a%ia2(i1:i2))
@@ -1229,6 +1250,9 @@ contains
i1 = i1 - 1
end do
ilr = ir
else
i1 = 1
i2 = 1
end if
nc = i2-i1+1
call issrch(ip,ic,nc,a%ia2(i1:i2))
@@ -1275,8 +1299,8 @@ contains
integer, pointer :: ia1(:), ia2(:), ia3(:),&
& ja_(:), ka_(:)
integer, allocatable :: indices(:), blks(:), rows(:)
integer :: png, pia, pja, ipx, blk, rb, row, k_pt, npg, col, ngr, nzin_,&
& i,j,k,nr,dupl, ii, ir, ic
integer :: png, pia, pja, ipx, blk, rb, row, k_pt, npg, col, ngr,&
& i,j,nr,dupl, ii, ir, ic
info = 0
dupl = psb_sp_getifld(psb_dupl_,a,info)
base/serial/psb_zcoins.f90
+1 -1
View File
@@ -51,7 +51,7 @@ subroutine psb_zcoins(nz,ia,ja,val,a,imin,imax,jmin,jmax,info,gtl,rebuild)
logical, intent(in), optional :: rebuild
character(len=5) :: ufida
integer :: i,j,ir,ic,nr,nc, ng, nza, isza,spstate, nnz,&
integer :: ng, nza, isza,spstate, &
& ip1, nzl, err_act, int_err(5), iupd, irst
logical, parameter :: debug=.false.
logical :: rebuild_
base/serial/psb_zcsmv.f90
+1 -1
View File
@@ -44,7 +44,7 @@ subroutine psb_zcsmv(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_zcsmv'
info = 0
base/serial/psb_zcsrp.f90
+3 -5
View File
@@ -75,12 +75,10 @@ subroutine psb_zcsrp(trans,iperm,a, info)
character, intent(in) :: trans
!....locals....
integer, allocatable :: ipt(:)
integer :: i,np,me, n_col,l_dcsdp, ipsize
integer :: dectype
complex(kind(1.d0)), allocatable :: work_dcsdp(:)
integer :: ictxt,n_row,err_act, int_err(5)
integer :: i, n_col,l_dcsdp, ipsize
complex(kind(1.d0)), allocatable :: work_dcsdp(:)
integer :: n_row,err_act, int_err(5)
character(len=20) :: name, char_err
real(kind(1.d0)) :: time(10)
logical, parameter :: debug=.false.
base/serial/psb_zcsrws.f90
+1 -1
View File
@@ -55,7 +55,7 @@ subroutine psb_zcsrws(rw,a,info,trans)
end interface
character :: trans_
integer :: m,n,k,err_act
integer :: m,k,err_act
character(len=20) :: name
name='psb_zcsrws'
base/serial/psb_zgelp.f90
+4 -4
View File
@@ -51,10 +51,10 @@ subroutine psb_zgelp(trans,iperm,x,info)
character, intent(in) :: trans
! local variables
integer :: ictxt,np,me,nrow,ncol
integer :: ictxt
complex(kind(1.d0)),allocatable :: dtemp(:)
integer, allocatable :: itemp(:)
integer :: int_err(5), i1sz, i2sz, i, err_act
integer :: int_err(5), i1sz, i2sz, err_act
real(kind(1.d0)),parameter :: one=1
logical, parameter :: debug=.false.
@@ -184,8 +184,8 @@ subroutine psb_zgelpv(trans,iperm,x,info)
character, intent(in) :: trans
! local variables
integer :: ictxt,np,me
integer :: int_err(5), i1sz,nrow,ncol, i, err_act
integer :: ictxt
integer :: int_err(5), i1sz, err_act
complex(kind(1.d0)),allocatable :: dtemp(:)
integer, allocatable :: itemp(:)
real(kind(1.d0)),parameter :: one=1
base/serial/psb_zipcoo2csc.f90
+1 -1
View File
@@ -49,7 +49,7 @@ subroutine psb_zipcoo2csc(a,info,clshr)
integer, allocatable :: iaux(:), itemp(:)
!locals
logical :: clshr_
Integer :: nza, nr, i,j, idl,err_act,nc,icl
Integer :: nza, i,j, idl,err_act,nc,icl
Integer, Parameter :: maxtry=8
logical, parameter :: debug=.false.
character(len=20) :: name
base/serial/psb_zipcsr2coo.f90
+1 -1
View File
@@ -50,7 +50,7 @@ Subroutine psb_zipcsr2coo(a,info)
integer :: i,j,err_act
logical, parameter :: debug=.false.
integer, allocatable :: iaux(:), itemp(:)
character(len=20) :: name, ch_err
character(len=20) :: name
name='psb_zipcsr2coo'
info = 0
base/serial/psb_zneigh.f90
+17 -7
View File
@@ -47,10 +47,9 @@ subroutine psb_zneigh(a,idx,neigh,n,info,lev)
integer, allocatable :: neigh(:) ! the neighbours
integer, optional :: lev ! level of neighbours to find
integer, allocatable :: tmpn(:)
integer :: lev_, dim, i, j, k, r, c, brow,nl, ifl,ill,&
& elem_pt, ii, n1, col_idx, ne, err_act, nn, nidx,ntl
character(len=20) :: name, ch_err
integer :: lev_, i, nl, ifl,ill,&
& n1, err_act, nn, nidx,ntl
character(len=20) :: name
integer, allocatable :: ia(:), ja(:)
complex(kind(1.d0)), allocatable :: val(:)
@@ -67,8 +66,11 @@ subroutine psb_zneigh(a,idx,neigh,n,info,lev)
end if
call psb_sp_getrow(idx,a,n,ia,ja,val,info)
call psb_realloc(n,neigh,info)
if (info == 0) call psb_realloc(n,neigh,info)
if (info /= 0) then
call psb_errpush(4000,name)
goto 9999
end if
neigh(1:n) = ja(1:n)
ifl = 1
ill = n
@@ -77,12 +79,20 @@ subroutine psb_zneigh(a,idx,neigh,n,info,lev)
do nl = 2, lev_
n1 = ill - ifl + 1
call psb_ensure_size(ill+n1*n1,neigh,info)
if (info /= 0) then
call psb_errpush(4000,name)
goto 9999
end if
ntl = 0
do i=ifl,ill
nidx=neigh(i)
if ((nidx.ne.idx).and.(nidx.gt.0).and.(nidx.le.a%m)) then
call psb_sp_getrow(nidx,a,nn,ia,ja,val,info)
call psb_ensure_size(ill+ntl+nn,neigh,info)
if (info==0) call psb_ensure_size(ill+ntl+nn,neigh,info)
if (info /= 0) then
call psb_errpush(4000,name)
goto 9999
end if
neigh(ill+ntl+1:ill+ntl+nn)=ja(1:nn)
ntl = ntl+nn
end if
base/serial/psb_znumbmm.f90
+1 -1
View File
@@ -79,7 +79,7 @@ contains
complex(kind(1.d0)) :: temp(:)
integer, allocatable :: iarw(:), iacl(:),ibrw(:),ibcl(:)
complex(kind(1.d0)), allocatable :: aval(:),bval(:)
integer :: maxlmn,i,j,m,n,k,l,istart,length,nazr,nbzr,jj,ii,minlm,minmn,minln
integer :: maxlmn,i,j,m,n,k,l,nazr,nbzr,jj,minlm,minmn,minln
complex(kind(1.d0)) :: ajj
base/serial/psb_zspclip.f90
+2 -2
View File
@@ -47,8 +47,8 @@ subroutine psb_zspclip(a,b,info,imin,imax,jmin,jmax,rscale,cscale)
integer, intent(in), optional :: imin,imax,jmin,jmax
logical, intent(in), optional :: rscale,cscale
integer :: lrw_, ierr(5), err_act
character(len=20) :: name, ch_err
integer :: err_act
character(len=20) :: name
integer :: imin_,imax_,jmin_,jmax_
logical :: rscale_,cscale_
integer :: sizeb, nzb, mb, kb, ifst, ilst, nrt, nzt, i, j
base/serial/psb_zspcnv.f90
+4 -20
View File
@@ -63,8 +63,7 @@ subroutine psb_zspcnv2(a, b,info,afmt,upd,dupl)
type(psb_zspmat_type) :: temp_a
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, i1, i2, ia
integer :: err_act
character :: check_,trans_,unitd_
character(len=5) :: afmt_
Integer, Parameter :: maxtry=8
@@ -389,11 +388,10 @@ subroutine psb_zspcnv1(a, info, afmt, upd, dupl)
integer :: int_err(5)
type(psb_zspmat_type) :: atemp
integer :: np,me,n_col,iout, err_act
integer :: err_act
integer :: spstate
integer :: upd_, dupl_
integer :: ictxt,n_row
logical, parameter :: debug=.false., debugwrt=.false.
logical, parameter :: debug=.false.
character(len=20) :: name, ch_err
info = 0
@@ -471,18 +469,11 @@ subroutine psb_zspcnv1(a, info, afmt, upd, dupl)
! convert to user requested format after the temp copy
end if
if (debugwrt) then
iout = 30+me
open(iout)
call psb_csprt(iout,atemp,head='Input mat')
close(iout)
endif
! Do the real conversion into the requested storage format
! result is put in A
call psb_spcnv(atemp,a,info,afmt=afmt,upd=upd,dupl=dupl)
IF (debug) WRITE (*, *) me,' ASB: From SPCNV',info,' ',A%FIDA
IF (debug) WRITE (*, *) ' ASB: From SPCNV',info,' ',A%FIDA
if (info /= psb_no_err_) then
info=4010
ch_err='psb_csdp'
@@ -490,13 +481,6 @@ subroutine psb_zspcnv1(a, info, afmt, upd, dupl)
goto 9999
endif
if (debugwrt) then
iout = 60+me
open(iout)
call psb_csprt(iout,a,head='Output mat')
close(iout)
endif
call psb_sp_free(atemp,info)
else if (spstate == psb_spmat_upd_) then

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