added error check on subroutine entry point

src/internals/psi_desc_index.f90

@@ -17,7 +17,6 @@ subroutine psi_desc_index(desc_data,index_in,dep_list,&
   !c     ....local scalars...        
   integer :: j,me,np,npcol,mycol,i,proc,dim
   !c     ...parameters...
-  integer, parameter :: ione=1
   integer :: icontxt
   integer :: no_comm,err
   parameter (no_comm=-1)

src/internals/psi_sort_dl.f90

@@ -14,6 +14,7 @@ subroutine psi_sort_dl(dep_list,l_dep_list,np,info)
   character(len=20)        :: name, ch_err
   
   name='psi_sort_dl'
+  if(psb_get_errstatus().ne.0) return 
   info=0
   call psb_erractionsave(err_act)
   

src/methd/psb_dbicg.f90

@@ -77,7 +77,6 @@ subroutine psb_dbicg(a,prec,b,x,eps,desc_a,info,&
   character     ::diagl, diagu
   logical, parameter :: debug = .false.
   logical, parameter :: exchange=.true., noexchange=.false.  
-  integer, parameter :: ione=1
   integer, parameter :: irmax = 8
   integer            :: itx, i, isvch, ich, icontxt
   logical            :: do_renum_left

src/methd/psb_dcg.f90

@@ -76,7 +76,6 @@ Subroutine psb_dcg(a,prec,b,x,eps,desc_a,info,&
        & nprows,npcols,me,mecol, n_col, isvch, ich, icontxt, n_row,err_act, int_err(5)
   character          ::diagl, diagu
   logical, parameter :: exchange=.true., noexchange=.false.  
-  integer, parameter :: ione=1
   real(kind(1.d0)), parameter :: one=1.d0, zero=0.d0, epstol=1.d-35
   character(len=20)             :: name,ch_err
 

src/methd/psb_dcgs.f90

@@ -74,7 +74,6 @@ Subroutine psb_dcgs(a,prec,b,x,eps,desc_a,info,&
        & nprows,npcols,me,mecol, n_row, n_col,listop, err_act
   Character     ::diagl, diagu
   Logical, Parameter :: exchange=.True., noexchange=.False.  
-  Integer, Parameter :: ione=1
   Integer, Parameter :: irmax = 8
   Integer            :: itx, i, isvch, ich, icontxt
   Logical            :: do_renum_left

src/methd/psb_dcgstab.f90

@@ -75,7 +75,6 @@ Subroutine psb_dcgstab(a,prec,b,x,eps,desc_a,info,&
   Character     ::diagl, diagu
   Logical, Parameter :: debug = .false.
   Logical, Parameter :: exchange=.True., noexchange=.False., debug1 = .False.
-  Integer, Parameter :: ione=1
   Integer, Parameter :: irmax = 8
   Integer            :: itx, i, isvch, ich, icontxt, err_act, int_err(5),ii
   Integer            :: listop

src/methd/psb_dcgstabl.f90

@@ -83,7 +83,6 @@ Subroutine psb_dcgstabl(a,prec,b,x,eps,desc_a,info,&
        & nprows,npcols,me,mecol, n_row, n_col, nl, err_act
   Character     ::diagl, diagu
   Logical, Parameter :: exchange=.True., noexchange=.False.  
-  Integer, Parameter :: ione=1
   Integer, Parameter :: irmax = 8
   Integer            :: itx, i, isvch, ich, icontxt,listop,j, int_err(5)
   Logical            :: do_renum_left

src/methd/psb_dgmresr.f90

@@ -85,7 +85,6 @@ Subroutine psb_dgmresr(a,prec,b,x,eps,desc_a,info,&
        & nprows,npcols,me,mecol, n_row, n_col, nl, int_err(5)
   Character     ::diagl, diagu
   Logical, Parameter :: exchange=.True., noexchange=.False.  
-  Integer, Parameter :: ione=1
   Integer, Parameter :: irmax = 8
   Integer            :: itx, i, isvch, ich, icontxt,listop, err_act
   Logical            :: do_renum_left,inner_stop

src/prec/psb_dbldaggrmat.f90

@@ -17,6 +17,7 @@ subroutine psb_dbldaggrmat(a,desc_a,p,info)
   integer ::icontxt,nprow,npcol,me,mycol, err_act
   character(len=20) :: name, ch_err
   name='psb_dbldaggrmat'
+  if(psb_get_errstatus().ne.0) return 
   info=0
   call psb_erractionsave(err_act)
 
@@ -77,6 +78,7 @@ contains
          & naggr, np, myprow, mypcol, nprows, npcols,nzt,irs,jl,nzl,nlr,&
          & icomm,naggrm1, mtype, i, j, err_act
     name='raw_aggregate'
+    if(psb_get_errstatus().ne.0) return 
   info=0
     call psb_erractionsave(err_act)
 
@@ -314,6 +316,7 @@ contains
 
 
     name='smooth_aggregate'
+    if(psb_get_errstatus().ne.0) return 
   info=0
     call psb_erractionsave(err_act)
 

src/prec/psb_dcslu.f90

@@ -76,6 +76,7 @@ subroutine psb_dcslu(a,desc_a,p,upd,info)
     end Subroutine psb_dcsrsetup
  end interface
 
+  if(psb_get_errstatus().ne.0) return 
   info=0
   name='psb_dcslu'
   call psb_erractionsave(err_act)
@@ -317,6 +318,7 @@ contains
     integer, intent(out)   :: info
     character(len=20)      :: name, ch_err
 
+    if(psb_get_errstatus().ne.0) return 
   info=0
     name='apply_renum'
     call psb_erractionsave(err_act)
@@ -615,6 +617,7 @@ contains
 
     character(len=20)      :: name, ch_err
 
+    if(psb_get_errstatus().ne.0) return 
   info=0
     name='gps_reduction'
     call psb_erractionsave(err_act)

src/prec/psb_dcsrsetup.f90

@@ -48,6 +48,7 @@ Subroutine psb_dcsrsetup(ptype,novr,a,blk,desc_data,upd,desc_p,info,outfmt)
   Logical,Parameter :: debug=.false., debugprt=.false.
   character(len=20) :: name, ch_err
   name='psb_dcsrsetup'
+  if(psb_get_errstatus().ne.0) return 
   info=0
   call psb_erractionsave(err_act)
 

src/prec/psb_dgenaggrmap.f90

@@ -20,6 +20,7 @@ subroutine psb_dgenaggrmap(aggr_type,a,desc_a,nlaggr,ilaggr,info)
   integer, parameter :: one=1, two=2
   character(len=20)   :: name, ch_err
 
+  if(psb_get_errstatus().ne.0) return 
   info=0
   name = 'psb_bldaggrmat'
   call psb_erractionsave(err_act)

src/prec/psb_dprec.f90

@@ -255,8 +255,7 @@ subroutine psb_dbaseprcaply(prec,x,beta,y,desc_data,trans,work,info)
     end if
 
     if (prec%iprcparm(iren_)>0) then 
-!!$      call psb_dgelp('N',n_row,1,prec%perm,tx,isz,ww,isz,info)
+      call dgelp('N',n_row,1,prec%perm,tx,isz,ww,isz,info)
-      info = -1
       if(info /=0) then
          info=4010
          ch_err='psb_dgelp'
@@ -267,8 +266,7 @@ subroutine psb_dbaseprcaply(prec,x,beta,y,desc_data,trans,work,info)
     call psb_dbjacaply(prec,tx,zero,ty,prec%desc_data,trans,aux,info)
 
     if (prec%iprcparm(iren_)>0) then 
-!!$      call psb_dgelp('N',n_row,1,prec%invperm,ty,isz,ww,isz,info)
+      call dgelp('N',n_row,1,prec%invperm,ty,isz,ww,isz,info)
-      info = -1 
       if(info /=0) then
          info=4010
          ch_err='psb_dgelp'

src/prec/psb_dprecbld.f90

@@ -4,6 +4,7 @@ subroutine psb_dprecbld(a,p,desc_a,info,upd)
   Use psb_spmat_type
   use psb_descriptor_type
   use psb_prec_type
+  use psb_tools_mod
   use psb_comm_mod
   use psb_const_mod
   use psb_psblas_mod
@@ -70,6 +71,7 @@ subroutine psb_dprecbld(a,p,desc_a,info,upd)
   integer,parameter  :: iroot=0,iout=60,ilout=40
   character(len=20)   :: name, ch_err
 
+  if(psb_get_errstatus().ne.0) return 
   info=0
   err=0
   call psb_erractionsave(err_act)
@@ -307,6 +309,7 @@ subroutine psb_splu_bld(a,desc_a,p,info)
   use psb_serial_mod
   use psb_descriptor_type
   use psb_prec_type
+  use psb_tools_mod
   use psb_const_mod
   implicit none 
 
@@ -339,6 +342,7 @@ subroutine psb_splu_bld(a,desc_a,p,info)
     end Subroutine psb_dcsrsetup
  end interface
 
+  if(psb_get_errstatus().ne.0) return 
   info=0
   name='psb_splu_bld'
   call psb_erractionsave(err_act)
@@ -663,6 +667,7 @@ end subroutine psb_umf_bld
 subroutine psb_mlprec_bld(a,desc_a,p,info)
 
   use psb_serial_mod
+  use psb_tools_mod
   use psb_descriptor_type
   use psb_prec_type
   use psb_const_mod
@@ -716,6 +721,7 @@ subroutine psb_mlprec_bld(a,desc_a,p,info)
   integer :: icontxt, nprow, npcol, me, mycol
   
   name='psb_mlprec_bld'
+  if(psb_get_errstatus().ne.0) return 
   info=0
   call psb_erractionsave(err_act)
 

src/prec/psb_dprecfree.f90

@@ -17,9 +17,9 @@ subroutine psb_dprecfree(p,info)
   integer             :: temp(1), me
   real(kind(1.d0))    :: real_err(5)
   integer             :: icontxt,err_act,i
-  integer,parameter   :: ione=1
   character(len=20)   :: name, ch_err
 
+  if(psb_get_errstatus().ne.0) return 
   info=0
   name = 'psdprecfree'
   call psb_erractionsave(err_act)

src/prec/psb_dsplu.f90

@@ -108,6 +108,7 @@ contains
     character(len=20)   :: name, ch_err
 
     name='psb_dspluint'
+    if(psb_get_errstatus().ne.0) return 
   info=0
     call psb_erractionsave(err_act)
 

src/psblas/psb_chkglobvect.f90

@@ -30,6 +30,7 @@ subroutine psb_chkglobvect( m, n, lldx, ix, jx, desc_dec, info)
   integer           :: err_act, int_err(5)
   character(len=20) :: name, ch_err
 
+  if(psb_get_errstatus().ne.0) return 
   info=0
   name='psb_chkglobvect'
   call psb_erractionsave(err_act)

src/psblas/psb_chkmat.f90

@@ -35,6 +35,7 @@ subroutine psb_chkmat( m, n, ia, ja, desc_dec, info, iia, jja)
   integer           :: err_act, int_err(5)
   character(len=20) :: name, ch_err
 
+  if(psb_get_errstatus().ne.0) return 
   info=0
   name='psb_chkmat'
   call psb_erractionsave(err_act)

src/psblas/psb_chkvect.f90

@@ -34,6 +34,7 @@ subroutine psb_chkvect( m, n, lldx, ix, jx, desc_dec, info, iix, jjx)
   integer           :: err_act, int_err(5)
   character(len=20) :: name, ch_err
 
+  if(psb_get_errstatus().ne.0) return 
   info=0
   name='psb_chkvect'
   call psb_erractionsave(err_act)

src/psblas/psb_damax.f90

@@ -35,6 +35,7 @@ function psb_damax (x,desc_a, info, jx)
   character(len=20)        :: name, ch_err
 
   name='psb_damax'
+  if(psb_get_errstatus().ne.0) return 
   info=0
   call psb_erractionsave(err_act)
 
@@ -137,6 +138,7 @@ function psb_damaxv (x,desc_a, info)
   character(len=20)        :: name, ch_err
 
   name='psb_damaxv'
+  if(psb_get_errstatus().ne.0) return 
   info=0
   call psb_erractionsave(err_act)
 
@@ -236,6 +238,7 @@ subroutine psb_damaxvs (res,x,desc_a, info)
   character(len=20)        :: name, ch_err
 
   name='psb_damaxvs'
+  if(psb_get_errstatus().ne.0) return 
   info=0
   call psb_erractionsave(err_act)
 
@@ -336,6 +339,7 @@ subroutine psb_dmamaxs (res,x,desc_a, info,jx)
   character(len=20)        :: name, ch_err
 
   name='psb_dmamaxs'
+  if(psb_get_errstatus().ne.0) return 
   info=0
   call psb_erractionsave(err_act)
 

src/psblas/psb_dasum.f90

@@ -35,6 +35,7 @@ function psb_dasum (x,desc_a, info, jx)
   character(len=20)        :: name, ch_err
 
   name='psb_dasum'
+  if(psb_get_errstatus().ne.0) return 
   info=0
   call psb_erractionsave(err_act)
 
@@ -155,6 +156,7 @@ function psb_dasumv (x,desc_a, info)
   character(len=20)        :: name, ch_err
 
   name='psb_dasumv'
+  if(psb_get_errstatus().ne.0) return 
   info=0
   call psb_erractionsave(err_act)
 
@@ -271,6 +273,7 @@ subroutine psb_dasumvs (res,x,desc_a, info)
   character(len=20)        :: name, ch_err
 
   name='psb_dasumvs'
+  if(psb_get_errstatus().ne.0) return 
   info=0
   call psb_erractionsave(err_act)
 

src/psblas/psb_daxpby.f90

@@ -40,6 +40,7 @@ subroutine  psb_daxpby(alpha, x, beta,y,desc_a,info, n, jx, jy)
   character(len=20)        :: name, ch_err
 
   name='psb_daxpby'
+  if(psb_get_errstatus().ne.0) return 
   info=0
   call psb_erractionsave(err_act)
 
@@ -165,6 +166,7 @@ subroutine  psb_daxpbyv(alpha, x, beta,y,desc_a,info)
   character(len=20)        :: name, ch_err
 
   name='psb_daxpby'
+  if(psb_get_errstatus().ne.0) return 
   info=0
   call psb_erractionsave(err_act)
 

src/psblas/psb_ddot.f90

@@ -38,6 +38,7 @@ function psb_ddot(x, y,desc_a, info, jx, jy)
   character(len=20)        :: name, ch_err
 
   name='psb_ddot'
+  if(psb_get_errstatus().ne.0) return 
   info=0
   call psb_erractionsave(err_act)
 
@@ -167,6 +168,7 @@ function psb_ddotv(x, y,desc_a, info)
   character(len=20)        :: name, ch_err
 
   name='psb_ddot'
+  if(psb_get_errstatus().ne.0) return 
   info=0
   call psb_erractionsave(err_act)
 
@@ -280,6 +282,7 @@ subroutine psb_ddotvs(res, x, y,desc_a, info)
   character(len=20)        :: name, ch_err
 
   name='psb_ddot'
+  if(psb_get_errstatus().ne.0) return 
   info=0
   call psb_erractionsave(err_act)
 
@@ -395,6 +398,7 @@ subroutine psb_dmdots(res, x, y, desc_a, info)
   character(len=20)        :: name, ch_err
 
   name='psb_dmdots'
+  if(psb_get_errstatus().ne.0) return 
   info=0
   call psb_erractionsave(err_act)
 

src/psblas/psb_dnrm2.f90

@@ -34,6 +34,7 @@ function psb_dnrm2(x, desc_a, info, jx)
   character(len=20)        :: name, ch_err
 
   name='psb_dnrm2'
+  if(psb_get_errstatus().ne.0) return 
   info=0
   call psb_erractionsave(err_act)
 
@@ -146,6 +147,7 @@ function psb_dnrm2v(x, desc_a, info)
   character(len=20)        :: name, ch_err
 
   name='psb_dnrm2v'
+  if(psb_get_errstatus().ne.0) return 
   info=0
   call psb_erractionsave(err_act)
 
@@ -257,6 +259,7 @@ subroutine psb_dnrm2vs(res, x, desc_a, info)
   character(len=20)        :: name, ch_err
 
   name='psb_dnrm2'
+  if(psb_get_errstatus().ne.0) return 
   info=0
   call psb_erractionsave(err_act)
 

src/psblas/psb_dnrmi.f90

@@ -29,6 +29,7 @@ function psb_dnrmi(a,desc_a,info)
   character(len=20)        :: name, ch_err
 
   name='psb_dnrmi'
+  if(psb_get_errstatus().ne.0) return 
   info=0
   call psb_erractionsave(err_act)
 

src/psblas/psb_dspmm.f90

@@ -80,6 +80,7 @@ subroutine  psb_dspmm(alpha,a,x,beta,y,desc_a,info,&
   character(len=20)        :: name, ch_err
 
   name='psb_dspmm'
+  if(psb_get_errstatus().ne.0) return 
   info=0
   call psb_erractionsave(err_act)
 
@@ -396,6 +397,7 @@ subroutine  psb_dspmv(alpha,a,x,beta,y,desc_a,info,&
   character(len=20)        :: name, ch_err
 
   name='psb_dspmv'
+  if(psb_get_errstatus().ne.0) return 
   info=0
   call psb_erractionsave(err_act)
 

src/psblas/psb_dspsm.f90

@@ -78,6 +78,7 @@ subroutine  psb_dspsm(alpha,a,x,beta,y,desc_a,info,&
   character(len=20)        :: name, ch_err
 
   name='psb_dspsm'
+  if(psb_get_errstatus().ne.0) return 
   info=0
   call psb_erractionsave(err_act)
 
@@ -353,6 +354,7 @@ subroutine  psb_dspsv(alpha,a,x,beta,y,desc_a,info,&
   character(len=20)        :: name, ch_err
 
   name='psb_dspsv'
+  if(psb_get_errstatus().ne.0) return 
   info=0
   call psb_erractionsave(err_act)
 

src/serial/psb_dtransp.f90

@@ -4,6 +4,7 @@
 
 subroutine psb_dtransp(a,b,c,fmt)
   use psb_spmat_type
+  use psb_tools_mod
   use psb_serial_mod, only : psb_ipcoo2csr, psb_ipcsr2coo, psb_fixcoo
   implicit none
 

src/tools/psb_dallc.f90

@@ -35,6 +35,7 @@ subroutine psb_dalloc(m, n, x, desc_a, info, js)
   character(len=20)   :: name, ch_err
 
   name='psb_dallc'
+  if(psb_get_errstatus().ne.0) return 
   info=0
   err=0
   int_err(1)=0
@@ -193,6 +194,7 @@ subroutine psb_dallocv(m, x, desc_a,info)
   logical, parameter  :: debug=.false. 
   character(len=20)   :: name, ch_err
 
+  if(psb_get_errstatus().ne.0) return 
   info=0
   name='psb_dallcv'
   call psb_erractionsave(err_act)

src/tools/psb_dasb.f90

@@ -24,11 +24,11 @@ subroutine psb_dasb(x, desc_a, info)
   real(kind(1.d0)),pointer ::  dtemp(:,:)
   integer :: int_err(5), i1sz, i2sz, dectype, i,j
   double precision :: real_err(5)
-  integer, parameter  :: ione=1
   real(kind(1.d0)),parameter    :: one=1
   logical, parameter :: debug=.false.
   character(len=20)   :: name, ch_err
 
+  if(psb_get_errstatus().ne.0) return 
   info=0
   name='psb_dasb'
   call psb_erractionsave(err_act)
@@ -140,7 +140,6 @@ subroutine psb_dasbv(x, desc_a, info)
   integer :: int_err(5), i1sz,nrow,ncol, dectype, i, err_act
   real(kind(1.d0)),pointer ::  dtemp(:)
   double precision :: real_err(5)
-  integer, parameter  :: ione=1  
   real(kind(1.d0)),parameter    :: one=1
   logical, parameter :: debug=.false.
   character(len=20)             :: name,ch_err

src/tools/psb_dcsrovr.f90

@@ -21,7 +21,7 @@ Subroutine psb_dcsrovr(a,desc_a,blk,info,rwcnv,clcnv,outfmt)
   use psb_descriptor_type
   Use psb_prec_type
   use psb_realloc_mod
-  use psb_tools_mod, only : psb_glob_to_loc, psb_loc_to_glob
+  use psb_tools_mod, only : psb_glob_to_loc, psb_loc_to_glob, psb_spfree
   use psb_error_mod
 
   Implicit None
@@ -48,6 +48,7 @@ Subroutine psb_dcsrovr(a,desc_a,blk,info,rwcnv,clcnv,outfmt)
   real(kind(1.d0)) :: t1,t2,t3,t4,t5,t6,t7,t8,t9
   character(len=20)   :: name, ch_err
 
+  if(psb_get_errstatus().ne.0) return 
   info=0
   name='psb_dcsrovr'
   call psb_erractionsave(err_act)

src/tools/psb_dcsrp.f90

@@ -66,6 +66,7 @@ subroutine psb_dcsrp(trans,iperm,a, desc_a, info)
   n_row = desc_a%matrix_data(psb_n_row_)
   n_col = desc_a%matrix_data(psb_n_col_)
      
+  if(psb_get_errstatus().ne.0) return 
   info=0
   call psb_erractionsave(err_act)
   name = 'psd_csrp'
@@ -84,7 +85,7 @@ subroutine psb_dcsrp(trans,iperm,a, desc_a, info)
   endif
 
 
-  if (.not.is_asb_dec(dectype)) then 
+  if (.not.psb_is_asb_dec(dectype)) then 
     info = 600
     int_err(1) = dectype
     call psb_errpush(info,name,int_err)

src/tools/psb_descasb.f90

@@ -22,7 +22,7 @@ Subroutine psb_descasb(n_ovr,desc_p,desc_a,a,&
   use psb_serial_mod
   Use psi_mod
   use psb_realloc_mod
-  use psb_tools_mod, only : psb_descprt
+  use psb_tools_mod, only : psb_descprt, psb_spfree
   use psb_error_mod
   use psb_const_mod
   Implicit None
@@ -57,6 +57,7 @@ Subroutine psb_descasb(n_ovr,desc_p,desc_a,a,&
   real(kind(1.d0)) :: t1,t2,t3,t4,t5,t6,t7, tl, tch
   character(len=20)   :: name, ch_err
 
+  if(psb_get_errstatus().ne.0) return 
   info=0
   name='psb_descasb'
   call psb_erractionsave(err_act)
@@ -622,7 +623,8 @@ Subroutine psb_descasb(n_ovr,desc_p,desc_a,a,&
   end if
 
   ! Ok, register into MATRIX_DATA &  free temporary work areas
-  desc_a%matrix_data(psb_dec_type_) = psb_desc_asb_
+  write(0,*)'!!! verify this !!!'
+  desc_p%matrix_data(psb_dec_type_) = psb_desc_asb_
 
   allocate(desc_p%lprm(1))
   desc_p%lprm(1) = 0

src/tools/psb_dfree.f90

@@ -22,10 +22,10 @@ subroutine psb_dfree(x, desc_a, info)
   !...locals....
   integer             :: int_err(5)
   integer             :: icontxt,nprow,npcol,me,mypcol,err, err_act
-  integer,parameter   :: ione=1
   character(len=20)   :: name
 
 
+  if(psb_get_errstatus().ne.0) return 
   info=0
   call psb_erractionsave(err_act)
   name='psb_dfree'
@@ -107,10 +107,10 @@ subroutine psb_dfreev(x, desc_a, info)
   !...locals....
   integer             :: int_err(5)
   integer             :: icontxt,nprow,npcol,me,mypcol,err, err_act
-  integer,parameter   :: ione=1
   character(len=20)   :: name
 
 
+  if(psb_get_errstatus().ne.0) return 
   info=0
   call psb_erractionsave(err_act)
   name='psb_dfreev'

src/tools/psb_dgelp.f90

@@ -28,7 +28,6 @@ subroutine psb_dgelp(trans,iperm,x,desc_a,info)
   real(kind(1.d0)),pointer ::  dtemp(:)
   integer                  :: int_err(5), i1sz, i2sz, dectype, i, err_act
   character(len=20)         :: itrans
-  integer, parameter  :: ione=1
   real(kind(1.d0)),parameter    :: one=1
   logical, parameter :: debug=.false.
 
@@ -53,6 +52,7 @@ subroutine psb_dgelp(trans,iperm,x,desc_a,info)
   character(len=20)   :: name, ch_err
   name = 'psb_dgelp'
 
+  if(psb_get_errstatus().ne.0) return 
   info=0
   call psb_erractionsave(err_act)
 
@@ -148,7 +148,6 @@ subroutine psb_dgelpv(trans,iperm,x,desc_a,info)
   real(kind(1.d0)),pointer ::  dtemp(:)
   double precision :: real_err(5)
   character :: itrans
-  integer, parameter  :: ione=1  
   real(kind(1.d0)),parameter    :: one=1
   logical, parameter :: debug=.false.
 
@@ -173,6 +172,7 @@ subroutine psb_dgelpv(trans,iperm,x,desc_a,info)
   character(len=20)   :: name, ch_err
   name = 'psb_dgelpv'
 
+  if(psb_get_errstatus().ne.0) return 
   info=0
   call psb_erractionsave(err_act)
 

src/tools/psb_dins.f90

@@ -40,6 +40,7 @@ subroutine psb_dins(m, n, x, ix, jx, blck, desc_a, info,&
   character              :: temp_descra*11,temp_fida*5
   character(len=20)   :: name, char_err
 
+  if(psb_get_errstatus().ne.0) return 
   info=0
   call psb_erractionsave(err_act)
   name = 'psb_dins'
@@ -210,6 +211,7 @@ subroutine psb_dinsvm(m, x, ix, jx, blck, desc_a,info,&
   integer                :: nprow,npcol, me ,mypcol, iblock
   character(len=20)   :: name, char_err
 
+  if(psb_get_errstatus().ne.0) return 
   info=0
   call psb_erractionsave(err_act)
   name = 'psb_dinsvm'
@@ -365,6 +367,7 @@ subroutine psb_dinsvv(m, x, ix, blck, desc_a, info,&
   integer                :: nprow,npcol, me ,mypcol
   character(len=20)   :: name, char_err
 
+  if(psb_get_errstatus().ne.0) return 
   info=0
   call psb_erractionsave(err_act)
   name = 'psb_dinsvv'

src/tools/psb_dscall.f90

@@ -34,6 +34,7 @@ subroutine psb_dscall(m, n, parts, icontxt, desc_a, info)
   logical, parameter  :: debug=.false.
   character(len=20)   :: name, char_err
 
+  if(psb_get_errstatus().ne.0) return 
   info=0
   err=0
   name = 'psb_dscall'

src/tools/psb_dscalv.f90

@@ -33,6 +33,7 @@ subroutine psb_dscalv(m, v, icontxt, desc_a, info, flag)
   logical, parameter  :: debug=.false.
   character(len=20)   :: name, ch_err
 
+  if(psb_get_errstatus().ne.0) return 
   info=0
   err=0
   name = 'psb_dscalv'

src/tools/psb_dsccpy.f90

@@ -27,10 +27,10 @@ subroutine psb_dsccpy(desc_out, desc_a, info)
        & icontxt, isz, dectype, err_act, err
   integer             :: int_err(5),temp(1)
   real(kind(1.d0))    :: real_err(5)
-  integer, parameter  :: ione=1, itwo=2,root=0
   logical, parameter  :: debug=.false.
   character(len=20)   :: name, char_err
 
+  if(psb_get_errstatus().ne.0) return 
   info=0
   call psb_erractionsave(err_act)
   name = 'psb_dsccpy'

src/tools/psb_dscdec.f90

@@ -95,12 +95,12 @@ subroutine psb_dscdec(nloc, icontxt, desc_a, info)
        & 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, Parameter   :: IONE=1, ITWO=2,ROOT=0
   Integer, Pointer     :: temp_ovrlap(:), ov_idx(:), ov_el(:)
   integer, allocatable :: nlv(:)
   logical, parameter   :: debug=.false.
   character(len=20)    :: name, ch_err
 
+  if(psb_get_errstatus().ne.0) return 
   info=0
   err=0
   name = 'psb_dscdec'

src/tools/psb_dscfree.f90

@@ -20,9 +20,9 @@ subroutine psb_dscfree(desc_a,info)
   integer             :: temp(1)
   real(kind(1.d0))    :: real_err(5)
   integer             :: icontxt,nprow,npcol,me,mypcol, err_act
-  integer,parameter   :: ione=1
   character(len=20)   :: name, char_err
 
+  if(psb_get_errstatus().ne.0) return 
   info=0
   call psb_erractionsave(err_act)
   name = 'psb_dscfree'

src/tools/psb_dscren.f90

@@ -36,6 +36,7 @@ subroutine psb_dscren(trans,iperm,desc_a,info)
   logical, parameter            :: debug=.false.
   character(len=20)             :: name, char_err
 
+  if(psb_get_errstatus().ne.0) return 
   info=0
   call psb_erractionsave(err_act)
   name = 'psb_dcren'

src/tools/psb_dscrep.f90

@@ -99,6 +99,7 @@ subroutine psb_dscrep(m, icontxt, desc_a, info)
   logical, parameter  :: debug=.false.
   character(len=20)   :: name, ch_err
 
+  if(psb_get_errstatus().ne.0) return 
   info=0
   err=0
   name = 'psb_dscrep'

src/tools/psb_dspalloc.f90

@@ -30,10 +30,10 @@ subroutine psb_dspalloc(a, desc_a, info, nnz)
        &  length_ia1,length_ia2,err,nprocs, err_act,m,n
   integer             :: int_err(5),temp(1)
   real(kind(1.d0))    :: real_err(5)
-  integer, parameter  :: ione=1, itwo=2,root=0
   logical, parameter  :: debug=.false.
   character(len=20)   :: name, ch_err
 
+  if(psb_get_errstatus().ne.0) return 
   info=0
   call psb_erractionsave(err_act)
   name = 'psb_dspalloc'

src/tools/psb_dspasb.f90

@@ -31,6 +31,21 @@ subroutine psb_dspasb(a,desc_a, info, afmt, up, dup)
      end subroutine psb_cest
   end interface
 
+  interface psb_spfree
+     subroutine psb_dspfree(a, desc_a,info)
+       use psb_descriptor_type
+       use psb_spmat_type
+       type(psb_desc_type), intent(in) :: desc_a
+       type(psb_dspmat_type), intent(inout)       ::a
+       integer, intent(out)        :: info
+     end subroutine psb_dspfree
+     subroutine psb_dspfrees(a,info)
+       use psb_spmat_type
+       type(psb_dspmat_type), intent(inout)       ::a
+       integer, intent(out)        :: info
+     end subroutine psb_dspfrees
+  end interface
+
   !...Parameters....
   type(psb_dspmat_type), intent (inout)   :: a
   type(psb_desc_type), intent(in)         :: desc_a

src/tools/psb_dspcnv.f90

@@ -77,13 +77,13 @@ subroutine psb_dspcnv(a,b,desc_a,info)
   integer                       ::  lwork_dcsdp,dectype
   integer                       ::  icontxt,temp(1),n_row
   character                     ::  check*1, trans*1, unitd*1
-  integer, parameter            ::  ione=1
 
   real(kind(1.d0))              :: time(10), mpi_wtime
   external mpi_wtime
   logical, parameter :: debug=.false.
   character(len=20)   :: name, ch_err
 
+  if(psb_get_errstatus().ne.0) return 
   info=0
   name = 'psb_dspcnv'
   call psb_erractionsave(err_act)

src/tools/psb_dspfree.f90

@@ -26,9 +26,9 @@ subroutine psb_dspfree(a, desc_a,info)
   integer             :: temp(1)
   real(kind(1.d0))    :: real_err(5)
   integer             :: icontxt,nprow,npcol,me,mypcol,err, err_act
-  integer,parameter   :: ione=1
   character(len=20)   :: name, ch_err
 
+  if(psb_get_errstatus().ne.0) return 
   info=0
   name = 'psb_dspfree'
   call psb_erractionsave(err_act)
@@ -95,78 +95,78 @@ end subroutine psb_dspfree
 
 
 
-!!$subroutine psb_dspfrees(a, info)
+subroutine psb_dspfrees(a, info)
-!!$  !...free sparse matrix structure...
+  !...free sparse matrix structure...
-!!$  use psb_descriptor_type
+  use psb_descriptor_type
-!!$  use psb_spmat_type
+  use psb_spmat_type
-!!$  use psb_serial_mod
+  use psb_serial_mod
-!!$  use psb_const_mod
+  use psb_const_mod
-!!$  use psb_error_mod
+  use psb_error_mod
-!!$  implicit none
+  implicit none
-!!$
+
-!!$  !....parameters...
+  !....parameters...
-!!$  type(psb_dspmat_type), intent(inout)       ::a
+  type(psb_dspmat_type), intent(inout)       ::a
-!!$  integer, intent(out)        :: info
+  integer, intent(out)        :: info
-!!$  !...locals....
+  !...locals....
-!!$  integer             :: int_err(5)
+  integer             :: int_err(5)
-!!$  integer             :: temp(1)
+  integer             :: temp(1)
-!!$  real(kind(1.d0))    :: real_err(5)
+  real(kind(1.d0))    :: real_err(5)
-!!$  integer             :: icontxt,nprow,npcol,me,mypcol,err, err_act
+  integer             :: icontxt,nprow,npcol,me,mypcol,err, err_act
-!!$  integer,parameter   :: ione=1
+  character(len=20)   :: name, ch_err
-!!$  character(len=20)   :: name, ch_err
+
-!!$
+  if(psb_get_errstatus().ne.0) return 
-!!$  info=0
+  info=0
-!!$  name = 'psb_dspfrees'
+  name = 'psb_dspfrees'
-!!$  call psb_erractionsave(err_act)
+  call psb_erractionsave(err_act)
-!!$
+
-!!$  !...deallocate a....
+  !...deallocate a....
-!!$
+
-!!$  if ((info.eq.0).and.(.not.associated(a%pr))) info=2951
+  if ((info.eq.0).and.(.not.associated(a%pr))) info=2951
-!!$  if (info.eq.0) then
+  if (info.eq.0) then
-!!$     !deallocate pr field
+     !deallocate pr field
-!!$     deallocate(a%pr,stat=info)
+     deallocate(a%pr,stat=info)
-!!$     if (info.ne.0) info=2045
+     if (info.ne.0) info=2045
-!!$  end if
+  end if
-!!$  if ((info.eq.0).and.(.not.associated(a%pl))) info=2952
+  if ((info.eq.0).and.(.not.associated(a%pl))) info=2952
-!!$  !deallocate pl  field
+  !deallocate pl  field
-!!$  if (info.eq.0) then 
+  if (info.eq.0) then 
-!!$     deallocate(a%pl,stat=info)
+     deallocate(a%pl,stat=info)
-!!$     if (info.ne.0) info=2046
+     if (info.ne.0) info=2046
-!!$  end if
+  end if
-!!$  if ((info.eq.0).and.(.not.associated(a%ia2))) info=2953
+  if ((info.eq.0).and.(.not.associated(a%ia2))) info=2953
-!!$  if (info.eq.0) then
+  if (info.eq.0) then
-!!$     !deallocate ia2 field
+     !deallocate ia2 field
-!!$     deallocate(a%ia2,stat=info)
+     deallocate(a%ia2,stat=info)
-!!$     if (info.ne.0) info=2047
+     if (info.ne.0) info=2047
-!!$  end if
+  end if
-!!$  if ((info.eq.0).and.(.not.associated(a%ia1))) info=2954
+  if ((info.eq.0).and.(.not.associated(a%ia1))) info=2954
-!!$  if (info.eq.0) then
+  if (info.eq.0) then
-!!$     !deallocate ia1  field
+     !deallocate ia1  field
-!!$     deallocate(a%ia1,stat=info)
+     deallocate(a%ia1,stat=info)
-!!$     if (info.ne.0) info=2048
+     if (info.ne.0) info=2048
-!!$  endif
+  endif
-!!$  if ((info.eq.0).and.(.not.associated(a%aspk))) info=2955
+  if ((info.eq.0).and.(.not.associated(a%aspk))) info=2955
-!!$  if (info.eq.0) then
+  if (info.eq.0) then
-!!$     !deallocate aspk field
+     !deallocate aspk field
-!!$     deallocate(a%aspk,stat=info)
+     deallocate(a%aspk,stat=info)
-!!$     if (info.ne.0) info=2049
+     if (info.ne.0) info=2049
-!!$  endif
+  endif
-!!$  if (info.eq.0) call psb_nullify_sp(a)
+  if (info.eq.0) call psb_nullify_sp(a)
-!!$
+
-!!$  if(info.ne.0) then
+  if(info.ne.0) then
-!!$     call psb_errpush(info,name)
+     call psb_errpush(info,name)
-!!$     goto 9999
+     goto 9999
-!!$  end if
+  end if
-!!$
+
-!!$  call psb_erractionrestore(err_act)
+  call psb_erractionrestore(err_act)
-!!$  return
+  return
-!!$
+
-!!$9999 continue
+9999 continue
-!!$  call psb_erractionrestore(err_act)
+  call psb_erractionrestore(err_act)
-!!$  if (err_act.eq.act_abort) then
+  if (err_act.eq.act_abort) then
-!!$     call psb_error()
+     call psb_error()
-!!$     return
+     return
-!!$  end if
+  end if
-!!$  return
+  return
-!!$
+
-!!$end subroutine psb_dspfrees
+end subroutine psb_dspfrees

src/tools/psb_dspupdate.f90

@@ -61,6 +61,7 @@ subroutine psb_dspupdate(a, ia, ja, blck, desc_a,info,ix,jx,updflag)
   integer,pointer        ::  iworkaux(:)    
   character(len=20)   :: name, ch_err
 
+  if(psb_get_errstatus().ne.0) return 
   info=0
   name='psb_dspupdate'
   call psb_erractionsave(err_act)

src/tools/psb_glob_to_loc.f90

@@ -31,6 +31,7 @@ subroutine psb_glob_to_loc2(x,y,desc_a,info,iact)
   integer, parameter                 ::  zero=0
   character(len=20)   :: name, char_err
 
+  if(psb_get_errstatus().ne.0) return 
   info=0
   name = 'glob_to_loc'
   call psb_erractionsave(err_act)
@@ -133,6 +134,7 @@ subroutine psb_glob_to_loc(x,desc_a,info,iact)
   integer, parameter                 ::  zero=0
   character(len=20)   :: name, char_err
 
+  if(psb_get_errstatus().ne.0) return 
   info=0
   name = 'glob_to_loc'
   call psb_erractionsave(err_act)

src/tools/psb_ialloc.f90

@@ -32,6 +32,7 @@ subroutine psb_ialloc(m, n, x, desc_a, info,js)
   real(kind(1.d0))    :: real_err(5)
   character(len=20)   :: name, char_err
 
+  if(psb_get_errstatus().ne.0) return 
   info=0
   name='psb_ialloc'
   call psb_erractionsave(err_act)
@@ -180,6 +181,7 @@ subroutine psb_iallocv(m, x, desc_a, info)
   logical, parameter  :: debug=.false. 
   character(len=20)   :: name, char_err
 
+  if(psb_get_errstatus().ne.0) return 
   info=0
   name='psb_iallocv'
   call psb_erractionsave(err_act)

src/tools/psb_iasb.f90

@@ -24,11 +24,10 @@ subroutine psb_iasb(x, desc_a, info)
   integer, pointer ::  itemp(:,:)
   integer :: int_err(5), i1sz, i2sz, dectype, i
   real(kind(1.d0)) :: real_err(5)
-  integer, parameter  :: ione=1
-  real(kind(1.d0)),parameter    :: one=1
   logical, parameter :: debug=.false.
   character(len=20)   :: name, char_err
 
+  if(psb_get_errstatus().ne.0) return 
   info=0
   name='psb_iasb'
   call psb_erractionsave(err_act)
@@ -76,7 +75,7 @@ subroutine psb_iasb(x, desc_a, info)
   endif
   
   ! ..update halo elements..
-  call psb_halo(x,desc_a,info,alpha=one)
+  call psb_halo(x,desc_a,info,alpha=done)
 
   call psb_erractionrestore(err_act)
   return
@@ -117,11 +116,10 @@ subroutine psb_iasbv(x, desc_a, info)
   integer :: int_err(5), i1sz,nrow,ncol, dectype, i
   integer, pointer ::  itemp(:)
   real(kind(1.d0)) :: real_err(5)
-  integer, parameter  :: ione=1  
-  real(kind(1.d0)),parameter    :: one=1
   logical, parameter :: debug=.false.
   character(len=20)   :: name, ch_err
 
+  if(psb_get_errstatus().ne.0) return 
   info=0
   call psb_erractionsave(err_act)
   name = 'psb_iasbv'
@@ -162,7 +160,7 @@ subroutine psb_iasbv(x, desc_a, info)
   endif  
   
   ! ..update halo elements..
-  call psb_halo(x,desc_a,info,alpha=one)
+  call psb_halo(x,desc_a,info,alpha=done)
 
   call psb_erractionrestore(err_act)
   return

src/tools/psb_ifree.f90

@@ -24,9 +24,9 @@ subroutine psb_ifree(x, desc_a, info)
   integer             :: temp(1)
   real(kind(1.d0))    :: real_err(5)
   integer             :: icontxt,nprow,npcol,me,mypcol,err_act
-  integer,parameter   :: ione=1
   character(len=20)   :: name, ch_err
 
+  if(psb_get_errstatus().ne.0) return 
   info=0
   call psb_erractionsave(err_act)
   name = 'psb_ifree'
@@ -104,9 +104,9 @@ subroutine psb_ifreev(x, desc_a,info)
   integer             :: temp(1)
   real(kind(1.d0))    :: real_err(5)
   integer             :: icontxt,nprow,npcol,me,mypcol,err_act
-  integer,parameter   :: ione=1
   character(len=20)   :: name, ch_err
 
+  if(psb_get_errstatus().ne.0) return 
   info=0
   call psb_erractionsave(err_act)
   name = 'psb_ifreev'

src/tools/psb_iins.f90

@@ -38,6 +38,7 @@ subroutine psb_iins(m, n, x, ix, jx, blck, desc_a, info,&
   integer                :: nprow,npcol, myrow ,mycol, int_err(5),err_act
   character(len=20)   :: name, ch_err
 
+  if(psb_get_errstatus().ne.0) return 
   info=0
   call psb_erractionsave(err_act)
   name = 'psb_iins'
@@ -209,6 +210,7 @@ subroutine psb_iinsvm(m, x, ix, jx, blck, desc_a, info,&
   integer                :: nprow,npcol, myrow ,mycol
   character(len=20)   :: name, ch_err
 
+  if(psb_get_errstatus().ne.0) return 
   info=0
   name = 'psb_iinsvm'
   call psb_erractionsave(err_act)
@@ -294,6 +296,7 @@ subroutine psb_iinsvv(m, x, ix, blck, desc_a, info,&
   integer                :: nprow,npcol, myrow ,mycol
   character(len=20)   :: name, ch_err
 
+  if(psb_get_errstatus().ne.0) return 
   info=0
   name = 'psb_iinsvv'
   call psb_erractionsave(err_act)

src/tools/psb_loc_to_glob.f90

@@ -32,6 +32,7 @@ subroutine psb_loc_to_glob2(x,y,desc_a,info,iact)
   integer, parameter                 ::  zero=0
   character(len=20)   :: name, char_err
 
+  if(psb_get_errstatus().ne.0) return 
   info=0
   name='psb_loc_to_glob2'
   call psb_erractionsave(err_act)
@@ -124,6 +125,7 @@ subroutine psb_loc_to_glob(x,desc_a,info,iact)
   integer, parameter                 ::  zero=0
   character(len=20)   :: name, char_err
 
+  if(psb_get_errstatus().ne.0) return 
   info=0
   name='psb_loc_to_glob'
   call psb_erractionsave(err_act)

test/Fileread/RUNS/rtst.inp

@@ -1,13 +1,13 @@
 11                  Number of inputs
-bcsstk35.mtx      This (and others) from: http://math.nist.gov/MatrixMarket/ 
+kivap001.mtx      This (and others) from: http://math.nist.gov/MatrixMarket/ 
 NONE
-CGS        
+BICGSTAB   
 ILU                 !!!! Actually, it's IPREC below. Should take this line out.
 CSR
-2                   IPART: Partition method
+1                   IPART: Partition method
 1                   ISTOPC
 00800               ITMAX
 6                   ITRACE
-7                   IPREC       0:NONE  1:DIAGSC  2:ILU  3: AS 4: RAS 5,6: variants
+4                   IPREC       0:NONE  1:DIAGSC  2:ILU  3: AS 4: RAS 5,6: variants
 1                   ML
-1.d-6               EPS
+1.d-7               EPS

test/Fileread/df_sample.f90

@@ -81,6 +81,7 @@ program df_sample
   amroot = (myprow==0).and.(mypcol==0)
 
   name='df_sample'
+  if(psb_get_errstatus().ne.0) return 
   info=0
   call psb_set_errverbosity(2)
   call psb_set_erraction(0)
@@ -272,8 +273,8 @@ program df_sample
   call dgamx2d(ictxt,'a',' ',ione, ione,t2,ione,t1,t1,-1,-1,-1)
   call psb_axpby(1.d0,b_col,0.d0,r_col,desc_a,info)
   call psb_spmm(-1.d0,a,x_col,1.d0,r_col,desc_a,info)
-  call psb_nrm2(resmx,r_col,desc_a,info)
+  call psb_nrm2s(resmx,r_col,desc_a,info)
-  call psb_amax(resmxp,r_col,desc_a,info)
+  call psb_amaxs(resmxp,r_col,desc_a,info)
 
 !!$  iter=iparm(5)
 !!$  err = rparm(2)
@@ -281,7 +282,7 @@ program df_sample
 !    call psb_prec_descr(6,pre)
     write(*,'("Matrix: ",a)')mtrx_file
     write(*,'("Computed solution on ",i4," processors")')nprow
-    write(*,'("Iterations to convergence: ",i)')iter
+    write(*,'("Iterations to convergence: ",i6)')iter
     write(*,'("Error indicator on exit: ",f7.2)')err
     write(*,'("Time to buil prec.   : ",es10.4)')tprec
     write(*,'("Time to solve matrix : ",es10.4)')t2

test/Fileread/getp.f90

@@ -98,12 +98,12 @@ CONTAINS
         CALL IGEBS2D(ICONTXT,'ALL',' ',6,1,INPARMS,6)
         CALL DGEBS2D(ICONTXT,'ALL',' ',1,1,EPS,1)
 
-          write(*,'("Solving matrix       : ",a)')mtrx_file      
+          write(*,'("Solving matrix       : ",a20)')mtrx_file      
-          write(*,'("Number of processors : ",i)')nprow
+          write(*,'("Number of processors : ",i3)')nprow
           write(*,'("Data distribution    : ",i2)')ipart
-          write(*,'("Preconditioner       : ",i)')iprec
+          write(*,'("Preconditioner       : ",i2)')iprec
-          if(iprec.gt.2) write(*,'("Overlapping levels   : ",i)')novr
+          if(iprec.gt.2) write(*,'("Overlapping levels   : ",i2)')novr
-          write(*,'("Iterative method     : ",a)')cmethd
+          write(*,'("Iterative method     : ",a20)')cmethd
           write(*,'("Storage format       : ",a3)')afmt(1:3)
           write(*,'(" ")')
       else