psblas3:

base/tools/psb_callc.f90
 base/tools/psb_casb.f90
 base/tools/psb_ccdbldext.F90
 base/tools/psb_cfree.f90
 base/tools/psb_cins.f90
 base/tools/psb_cspalloc.f90
 base/tools/psb_cspasb.f90
 base/tools/psb_cspfree.f90
 base/tools/psb_csphalo.F90
 base/tools/psb_cspins.f90
 base/tools/psb_d_map.f90
 base/tools/psb_dallc.f90
 base/tools/psb_dasb.f90
 base/tools/psb_dcdbldext.F90
 base/tools/psb_dfree.f90
 base/tools/psb_dins.f90
 base/tools/psb_dspalloc.f90
 base/tools/psb_dspasb.f90
 base/tools/psb_dspfree.f90
 base/tools/psb_dsphalo.F90
 base/tools/psb_dspins.f90
 base/tools/psb_sallc.f90
 base/tools/psb_sasb.f90
 base/tools/psb_scdbldext.F90
 base/tools/psb_sfree.f90
 base/tools/psb_sins.f90
 base/tools/psb_sspalloc.f90
 base/tools/psb_sspasb.f90
 base/tools/psb_sspfree.f90
 base/tools/psb_ssphalo.F90
 base/tools/psb_sspins.f90
 base/tools/psb_zallc.f90
 base/tools/psb_zasb.f90
 base/tools/psb_zcdbldext.F90
 base/tools/psb_zfree.f90
 base/tools/psb_zins.f90
 base/tools/psb_zspalloc.f90
 base/tools/psb_zspasb.f90
 base/tools/psb_zspfree.f90
 base/tools/psb_zsphalo.F90
 base/tools/psb_zspins.f90


New error handling

base/tools/psb_callc.f90

@@ -125,12 +125,8 @@ subroutine psb_calloc(x, desc_a, info, n, lb)
   call psb_erractionrestore(err_act)
   return
 
-9999 continue
-  call psb_erractionrestore(err_act)
-  if (err_act == psb_act_abort_) then
-    call psb_error(ictxt)
-    return
-  end if
+9999 call psb_error_handler(ictxt,err_act)
+
   return
 
 end subroutine psb_calloc
@@ -242,16 +238,13 @@ subroutine psb_callocv(x, desc_a,info,n)
   call psb_erractionrestore(err_act)
   return
 
-9999 continue
-  call psb_erractionrestore(err_act)
-  if (err_act == psb_act_abort_) then
-    call psb_error(ictxt)
-    return
-  end if
+9999 call psb_error_handler(ictxt,err_act)
+
   return
 
 end subroutine psb_callocv
 
+
 subroutine psb_calloc_vect(x, desc_a,info,n)
   use psb_base_mod, psb_protect_name => psb_calloc_vect
   use psi_mod
@@ -319,12 +312,8 @@ subroutine psb_calloc_vect(x, desc_a,info,n)
   call psb_erractionrestore(err_act)
   return
 
-9999 continue
-  call psb_erractionrestore(err_act)
-  if (err_act == psb_act_abort_) then
-    call psb_error(ictxt)
-    return
-  end if
+9999 call psb_error_handler(ictxt,err_act)
+
   return
 
 end subroutine psb_calloc_vect
@@ -426,12 +415,8 @@ subroutine psb_calloc_vect_r2(x, desc_a,info,n,lb)
   call psb_erractionrestore(err_act)
   return
 
-9999 continue
-  call psb_erractionrestore(err_act)
-  if (err_act == psb_act_abort_) then
-    call psb_error(ictxt)
-    return
-  end if
+9999 call psb_error_handler(ictxt,err_act)
+
   return
 
 end subroutine psb_calloc_vect_r2

base/tools/psb_casb.f90

@@ -83,8 +83,7 @@ subroutine psb_casb(x, desc_a, info)
     goto 9999
   else if (.not.psb_is_asb_desc(desc_a)) then
     if (debug_level >= psb_debug_ext_) &
-         & write(debug_unit,*) me,' ',trim(name),' error ',&
-         & desc_a%get_dectype()
+         & write(debug_unit,*) me,' ',trim(name),' error '
     info = psb_err_input_matrix_unassembled_
     call psb_errpush(info,name)
     goto 9999
@@ -122,12 +121,8 @@ subroutine psb_casb(x, desc_a, info)
   call psb_erractionrestore(err_act)
   return
 
-9999 continue
-  call psb_erractionrestore(err_act)
-  if (err_act == psb_act_abort_) then
-    call psb_error(ictxt)
-    return
-  end if
+9999 call psb_error_handler(ictxt,err_act)
+
   return
 
 end subroutine psb_casb
@@ -240,16 +235,13 @@ subroutine psb_casbv(x, desc_a, info)
   call psb_erractionrestore(err_act)
   return
 
-9999 continue
-  call psb_erractionrestore(err_act)
-  if (err_act == psb_act_abort_) then
-    call psb_error(ictxt)
-    return
-  end if
+9999 call psb_error_handler(ictxt,err_act)
+
   return
 
 end subroutine psb_casbv
 
+
 subroutine psb_casb_vect(x, desc_a, info, mold, scratch)
   use psb_base_mod, psb_protect_name => psb_casb_vect
   implicit none
@@ -319,12 +311,8 @@ subroutine psb_casb_vect(x, desc_a, info, mold, scratch)
   call psb_erractionrestore(err_act)
   return
 
-9999 continue
-  call psb_erractionrestore(err_act)
-  if (err_act == psb_act_abort_) then
-    call psb_error(ictxt)
-    return
-  end if
+9999 call psb_error_handler(ictxt,err_act)
+
   return
 
 end subroutine psb_casb_vect
@@ -385,7 +373,6 @@ subroutine psb_casb_vect_r2(x, desc_a, info, mold, scratch)
     end do
 
   else
-
     do i=1, n
       call x(i)%asb(ncol,info)
       if (info /= 0) exit
@@ -408,12 +395,8 @@ subroutine psb_casb_vect_r2(x, desc_a, info, mold, scratch)
   call psb_erractionrestore(err_act)
   return
 
-9999 continue
-  call psb_erractionrestore(err_act)
-  if (err_act == psb_act_abort_) then
-    call psb_error(ictxt)
-    return
-  end if
+9999 call psb_error_handler(ictxt,err_act)
+
   return
 
 end subroutine psb_casb_vect_r2

base/tools/psb_ccdbldext.F90

@@ -716,13 +716,9 @@ Subroutine psb_ccdbldext(a,desc_a,novr,desc_ov,info, extype)
   call psb_erractionrestore(err_act)
   return
 
-9999 continue
-  call psb_erractionrestore(err_act)
-  if (err_act == psb_act_abort_) then
-    call psb_error(ictxt)
+9999 call psb_error_handler(ictxt,err_act)
+
   return
-  end if
-  Return
 
 End Subroutine psb_ccdbldext
 

base/tools/psb_cfree.f90

@@ -90,12 +90,8 @@ subroutine psb_cfree(x, desc_a, info)
   call psb_erractionrestore(err_act)
   return
 
-9999 continue
-  call psb_erractionrestore(err_act)
-  if (err_act == psb_act_abort_) then
-     call psb_error(ictxt)
-     return
-  end if
+9999 call psb_error_handler(ictxt,err_act)
+
   return
 
 end subroutine psb_cfree
@@ -159,14 +155,8 @@ subroutine psb_cfreev(x, desc_a, info)
   call psb_erractionrestore(err_act)
   return
 
-9999 continue
-  call psb_erractionrestore(err_act)
+9999 call psb_error_handler(ictxt,err_act)
 
-  if (err_act == psb_act_ret_) then
-     return
-  else
-     call psb_error(ictxt)
-  end if
   return
 
 end subroutine psb_cfreev
@@ -219,12 +209,8 @@ subroutine psb_cfree_vect(x, desc_a, info)
   call psb_erractionrestore(err_act)
   return
 
-9999 continue
-  call psb_erractionrestore(err_act)
-  if (err_act == psb_act_abort_) then
-     call psb_error(ictxt)
-     return
-  end if
+9999 call psb_error_handler(ictxt,err_act)
+
   return
 
 end subroutine psb_cfree_vect
@@ -274,12 +260,8 @@ subroutine psb_cfree_vect_r2(x, desc_a, info)
   call psb_erractionrestore(err_act)
   return
 
-9999 continue
-  call psb_erractionrestore(err_act)
-  if (err_act == psb_act_abort_) then
-     call psb_error(ictxt)
-     return
-  end if
+9999 call psb_error_handler(ictxt,err_act)
+
   return
 
 end subroutine psb_cfree_vect_r2

base/tools/psb_cins.f90

@@ -171,14 +171,8 @@ subroutine psb_cinsvi(m, irw, val, x, desc_a, info, dupl,local)
   call psb_erractionrestore(err_act)
   return
 
-9999 continue
-  call psb_erractionrestore(err_act)
+9999 call psb_error_handler(ictxt,err_act)
 
-  if (err_act == psb_act_ret_) then
-    return
-  else
-    call psb_error(ictxt)
-  end if
   return
 
 end subroutine psb_cinsvi
@@ -292,14 +286,8 @@ subroutine psb_cins_vect(m, irw, val, x, desc_a, info, dupl,local)
   call psb_erractionrestore(err_act)
   return
 
-9999 continue
-  call psb_erractionrestore(err_act)
+9999 call psb_error_handler(ictxt,err_act)
 
-  if (err_act == psb_act_ret_) then
-    return
-  else
-    call psb_error(ictxt)
-  end if
   return
 
 end subroutine psb_cins_vect
@@ -408,14 +396,8 @@ subroutine psb_cins_vect_v(m, irw, val, x, desc_a, info, dupl,local)
   call psb_erractionrestore(err_act)
   return
 
-9999 continue
-  call psb_erractionrestore(err_act)
+9999 call psb_error_handler(ictxt,err_act)
 
-  if (err_act == psb_act_ret_) then
-    return
-  else
-    call psb_error(ictxt)
-  end if
   return
 
 end subroutine psb_cins_vect_v
@@ -533,14 +515,8 @@ subroutine psb_cins_vect_r2(m, irw, val, x, desc_a, info, dupl,local)
   call psb_erractionrestore(err_act)
   return
 
-9999 continue
-  call psb_erractionrestore(err_act)
+9999 call psb_error_handler(ictxt,err_act)
 
-  if (err_act == psb_act_ret_) then
-    return
-  else
-    call psb_error(ictxt)
-  end if
   return
 
 end subroutine psb_cins_vect_r2
@@ -730,14 +706,8 @@ subroutine psb_cinsi(m, irw, val, x, desc_a, info, dupl,local)
   call psb_erractionrestore(err_act)
   return
 
-9999 continue
-  call psb_erractionrestore(err_act)
+9999 call psb_error_handler(ictxt,err_act)
 
-  if (err_act == psb_act_ret_) then
-    return
-  else
-    call psb_error(ictxt)
-  end if
   return
 
 end subroutine psb_cinsi

base/tools/psb_cspalloc.f90

@@ -100,9 +100,8 @@ subroutine psb_cspalloc(a, desc_a, info, nnz)
 
   if (debug_level >= psb_debug_ext_) &
        & write(debug_unit,*) me,' ',trim(name),':allocating size:',length_ia1
-
-  !....allocate aspk, ia1, ia2.....
   call a%free()
+  !....allocate aspk, ia1, ia2.....
   call a%csall(loc_row,loc_col,info,nz=length_ia1)
   if(info /= psb_success_) then
     info=psb_err_from_subroutine_
@@ -120,14 +119,8 @@ subroutine psb_cspalloc(a, desc_a, info, nnz)
   call psb_erractionrestore(err_act)
   return
 
-9999 continue
-  call psb_erractionrestore(err_act)
+9999 call psb_error_handler(ictxt,err_act)
 
-  if (err_act == psb_act_ret_) then
-    return
-  else
-    call psb_error(ictxt)
-  end if
   return
 
 end subroutine psb_cspalloc

base/tools/psb_cspasb.f90

@@ -140,12 +140,8 @@ subroutine psb_cspasb(a,desc_a, info, afmt, upd, dupl, mold)
   call psb_erractionrestore(err_act)
   return
 
-9999 continue
-  call psb_erractionrestore(err_act)
-  if (err_act == psb_act_abort_) then
-    call psb_error(ictxt)
-    return
-  end if
+9999 call psb_error_handler(ictxt,err_act)
+
   return
 
 end subroutine psb_cspasb

base/tools/psb_cspfree.f90

@@ -70,12 +70,8 @@ subroutine psb_cspfree(a, desc_a,info)
   call psb_erractionrestore(err_act)
   return
 
-9999 continue
-  call psb_erractionrestore(err_act)
-  if (err_act == psb_act_abort_) then
-    call psb_error(ictxt)
-    return
-  end if
+9999 call psb_error_handler(ictxt,err_act)
+
   return
 
 end subroutine psb_cspfree

base/tools/psb_csphalo.F90

@@ -366,12 +366,8 @@ Subroutine psb_csphalo(a,desc_a,blk,info,rowcnv,colcnv,&
   call psb_erractionrestore(err_act)
   return
 
-9999 continue
-  call psb_erractionrestore(err_act)
-  if (err_act == psb_act_abort_) then
-    call psb_error(ictxt)
-    return
-  end if
+9999 call psb_error_handler(ictxt,err_act)
+
   return
 
 End Subroutine psb_csphalo

base/tools/psb_cspins.f90

@@ -193,12 +193,8 @@ subroutine psb_cspins(nz,ia,ja,val,a,desc_a,info,rebuild,local)
   call psb_erractionrestore(err_act)
   return
 
-9999 continue
-  call psb_erractionrestore(err_act)
-  if (err_act == psb_act_abort_) then
-    call psb_error(ictxt)
-    return
-  end if
+9999 call psb_error_handler(ictxt,err_act)
+
   return
 
 end subroutine psb_cspins
@@ -313,12 +309,8 @@ subroutine psb_cspins_2desc(nz,ia,ja,val,a,desc_ar,desc_ac,info)
   call psb_erractionrestore(err_act)
   return
 
-9999 continue
-  call psb_erractionrestore(err_act)
-  if (err_act == psb_act_abort_) then
-    call psb_error(ictxt)
-    return
-  end if
+9999 call psb_error_handler(ictxt,err_act)
+
   return
 
 end subroutine psb_cspins_2desc
@@ -472,12 +464,8 @@ subroutine psb_cspins_v(nz,ia,ja,val,a,desc_a,info,rebuild,local)
   call psb_erractionrestore(err_act)
   return
 
-9999 continue
-  call psb_erractionrestore(err_act)
-  if (err_act == psb_act_abort_) then
-    call psb_error(ictxt)
-    return
-  end if
+9999 call psb_error_handler(ictxt,err_act)
+
   return
 
 end subroutine psb_cspins_v

base/tools/psb_d_map.f90

@@ -142,7 +142,6 @@ subroutine psb_d_map_X2Y_vect(alpha,x,beta,y,map,info,work)
     nr2   = map%p_desc_Y%get_global_rows()
     nc2   = map%p_desc_Y%get_local_cols() 
     call yt%bld(nc2,mold=x%v)
-!!$    write(0,*)'From map_aggr_X2Y apply: ',map%p_desc_X%v_halo_index%get_fmt()
     if (info == psb_success_) call psb_halo(x,map%p_desc_X,info,work=work)
     if (info == psb_success_) call psb_csmm(done,map%map_X2Y,x,dzero,yt,info)
     if ((info == psb_success_) .and. map%p_desc_Y%is_repl()) then
@@ -308,7 +307,6 @@ subroutine psb_d_map_Y2X_vect(alpha,x,beta,y,map,info,work)
     nr2   = map%p_desc_X%get_global_rows()
     nc2   = map%p_desc_X%get_local_cols() 
     call yt%bld(nc2,mold=y%v)
-!!$    write(0,*)'From map_aggr_Y2X apply: ',map%p_desc_Y%v_halo_index%get_fmt()
     if (info == psb_success_) call psb_halo(x,map%p_desc_Y,info,work=work)
     if (info == psb_success_) call psb_csmm(done,map%map_Y2X,x,dzero,yt,info)
     if ((info == psb_success_) .and. map%p_desc_X%is_repl()) then

base/tools/psb_dallc.f90

@@ -76,7 +76,7 @@ subroutine psb_dalloc(x, desc_a, info, n, lb)
   endif
 
   !... check m and n parameters....
-  if (.not.desc_a%is_ok()) then 
+  if (.not.psb_is_ok_desc(desc_a)) then 
     info = psb_err_input_matrix_unassembled_
     call psb_errpush(info,name)
     goto 9999
@@ -125,12 +125,8 @@ subroutine psb_dalloc(x, desc_a, info, n, lb)
   call psb_erractionrestore(err_act)
   return
 
-9999 continue
-  call psb_erractionrestore(err_act)
-  if (err_act == psb_act_abort_) then
-    call psb_error(ictxt)
-    return
-  end if
+9999 call psb_error_handler(ictxt,err_act)
+
   return
 
 end subroutine psb_dalloc
@@ -167,9 +163,8 @@ end subroutine psb_dalloc
 !!$ 
 !!$  
 !
-!
 ! Function: psb_dallocv
-!    Allocates dense matrix for PSBLAS routines. 
+!    Allocates dense matrix for PSBLAS routines
 !    The descriptor may be in either the build or assembled state.
 ! 
 ! Arguments: 
@@ -243,16 +238,13 @@ subroutine psb_dallocv(x, desc_a,info,n)
   call psb_erractionrestore(err_act)
   return
 
-9999 continue
-  call psb_erractionrestore(err_act)
-  if (err_act == psb_act_abort_) then
-    call psb_error(ictxt)
-    return
-  end if
+9999 call psb_error_handler(ictxt,err_act)
+
   return
 
 end subroutine psb_dallocv
 
+
 subroutine psb_dalloc_vect(x, desc_a,info,n)
   use psb_base_mod, psb_protect_name => psb_dalloc_vect
   use psi_mod
@@ -312,7 +304,7 @@ subroutine psb_dalloc_vect(x, desc_a,info,n)
   if (psb_errstatus_fatal()) then 
     info=psb_err_alloc_request_
     int_err(1)=nr
-    call psb_errpush(info,name,int_err,a_err='real(psb_dpk_)')
+    call psb_errpush(info,name,int_err,a_err='real(psb_spk_)')
     goto 9999
   endif
   call x%zero()
@@ -320,12 +312,8 @@ subroutine psb_dalloc_vect(x, desc_a,info,n)
   call psb_erractionrestore(err_act)
   return
 
-9999 continue
-  call psb_erractionrestore(err_act)
-  if (err_act == psb_act_abort_) then
-    call psb_error(ictxt)
-    return
-  end if
+9999 call psb_error_handler(ictxt,err_act)
+
   return
 
 end subroutine psb_dalloc_vect
@@ -420,19 +408,15 @@ subroutine psb_dalloc_vect_r2(x, desc_a,info,n,lb)
   if (psb_errstatus_fatal()) then 
     info=psb_err_alloc_request_
     int_err(1)=nr
-    call psb_errpush(info,name,int_err,a_err='real(psb_dpk_)')
+    call psb_errpush(info,name,int_err,a_err='real(psb_spk_)')
     goto 9999
   endif
 
   call psb_erractionrestore(err_act)
   return
 
-9999 continue
-  call psb_erractionrestore(err_act)
-  if (err_act == psb_act_abort_) then
-    call psb_error(ictxt)
-    return
-  end if
+9999 call psb_error_handler(ictxt,err_act)
+
   return
 
 end subroutine psb_dalloc_vect_r2

base/tools/psb_dasb.f90

@@ -32,7 +32,7 @@
 ! File: psb_dasb.f90
 !
 ! Subroutine: psb_dasb
-!    Assembles a dense matrix for PSBLAS routines.
+!    Assembles a dense matrix for PSBLAS routines
 !    Since the allocation may have been called with the desciptor 
 !    in the build state we make sure that X has a number of rows 
 !    allowing for the halo indices, reallocating if necessary. 
@@ -83,8 +83,7 @@ subroutine psb_dasb(x, desc_a, info)
     goto 9999
   else if (.not.psb_is_asb_desc(desc_a)) then
     if (debug_level >= psb_debug_ext_) &
-         & write(debug_unit,*) me,' ',trim(name),' error ',&
-         & desc_a%get_dectype()
+         & write(debug_unit,*) me,' ',trim(name),' error '
     info = psb_err_input_matrix_unassembled_
     call psb_errpush(info,name)
     goto 9999
@@ -122,12 +121,8 @@ subroutine psb_dasb(x, desc_a, info)
   call psb_erractionrestore(err_act)
   return
 
-9999 continue
-  call psb_erractionrestore(err_act)
-  if (err_act == psb_act_abort_) then
-    call psb_error(ictxt)
-    return
-  end if
+9999 call psb_error_handler(ictxt,err_act)
+
   return
 
 end subroutine psb_dasb
@@ -240,16 +235,13 @@ subroutine psb_dasbv(x, desc_a, info)
   call psb_erractionrestore(err_act)
   return
 
-9999 continue
-  call psb_erractionrestore(err_act)
-  if (err_act == psb_act_abort_) then
-    call psb_error(ictxt)
-    return
-  end if
+9999 call psb_error_handler(ictxt,err_act)
+
   return
 
 end subroutine psb_dasbv
 
+
 subroutine psb_dasb_vect(x, desc_a, info, mold, scratch)
   use psb_base_mod, psb_protect_name => psb_dasb_vect
   implicit none
@@ -312,18 +304,15 @@ subroutine psb_dasb_vect(x, desc_a, info, mold,  scratch)
     if (present(mold)) then 
       call x%cnv(mold)
     end if
+  end if
   if (debug_level >= psb_debug_ext_) &
        & write(debug_unit,*) me,' ',trim(name),': end'
-  endif
-  call psb_erractionrestore(err_act)
-  return
 
-9999 continue
   call psb_erractionrestore(err_act)
-  if (err_act == psb_act_abort_) then
-    call psb_error(ictxt)
   return
-  end if
+
+9999 call psb_error_handler(ictxt,err_act)
+
   return
 
 end subroutine psb_dasb_vect
@@ -355,9 +344,9 @@ subroutine psb_dasb_vect_r2(x, desc_a, info, mold, scratch)
   ictxt       = desc_a%get_context()
   debug_unit  = psb_get_debug_unit()
   debug_level = psb_get_debug_level()
+
   scratch_ = .false.
   if (present(scratch)) scratch_ = scratch
-
   call psb_info(ictxt, me, np)
 
   !     ....verify blacs grid correctness..
@@ -406,12 +395,8 @@ subroutine psb_dasb_vect_r2(x, desc_a, info, mold, scratch)
   call psb_erractionrestore(err_act)
   return
 
-9999 continue
-  call psb_erractionrestore(err_act)
-  if (err_act == psb_act_abort_) then
-    call psb_error(ictxt)
-    return
-  end if
+9999 call psb_error_handler(ictxt,err_act)
+
   return
 
 end subroutine psb_dasb_vect_r2

base/tools/psb_dcdbldext.F90

@@ -716,13 +716,9 @@ Subroutine psb_dcdbldext(a,desc_a,novr,desc_ov,info, extype)
   call psb_erractionrestore(err_act)
   return
 
-9999 continue
-  call psb_erractionrestore(err_act)
-  if (err_act == psb_act_abort_) then
-    call psb_error(ictxt)
+9999 call psb_error_handler(ictxt,err_act)
+
   return
-  end if
-  Return
 
 End Subroutine psb_dcdbldext
 

base/tools/psb_dfree.f90

@@ -59,7 +59,7 @@ subroutine psb_dfree(x, desc_a, info)
   if (.not.psb_is_ok_desc(desc_a)) then
     info=psb_err_forgot_spall_
     call psb_errpush(info,name)
-     goto 9999
+    return
   end if
 
   ictxt=desc_a%get_context()
@@ -90,12 +90,8 @@ subroutine psb_dfree(x, desc_a, info)
   call psb_erractionrestore(err_act)
   return
 
-9999 continue
-  call psb_erractionrestore(err_act)
-  if (err_act == psb_act_abort_) then
-     call psb_error(ictxt)
-     return
-  end if
+9999 call psb_error_handler(ictxt,err_act)
+
   return
 
 end subroutine psb_dfree
@@ -116,6 +112,7 @@ subroutine psb_dfreev(x, desc_a, info)
   real(psb_dpk_),allocatable, intent(inout)    :: x(:)
   type(psb_desc_type), intent(in) :: desc_a
   integer(psb_ipk_), intent(out)            :: info
+
   !...locals....
   integer(psb_ipk_) :: ictxt,np,me, err_act
   character(len=20)   :: name
@@ -126,10 +123,11 @@ subroutine psb_dfreev(x, desc_a, info)
   call psb_erractionsave(err_act)
   name='psb_dfreev'
 
+
   if (.not.psb_is_ok_desc(desc_a)) then
     info=psb_err_forgot_spall_
     call psb_errpush(info,name)
-     return
+    goto 9999
   end if
   ictxt=desc_a%get_context()
 
@@ -138,6 +136,7 @@ subroutine psb_dfreev(x, desc_a, info)
     info = psb_err_context_error_
     call psb_errpush(info,name)
     goto 9999
+
   endif
 
   if (.not.allocated(x)) then
@@ -156,12 +155,8 @@ subroutine psb_dfreev(x, desc_a, info)
   call psb_erractionrestore(err_act)
   return
 
-9999 continue
-  call psb_erractionrestore(err_act)
-  if (err_act == psb_act_abort_) then
-     call psb_error(ictxt)
-     return
-  end if
+9999 call psb_error_handler(ictxt,err_act)
+
   return
 
 end subroutine psb_dfreev
@@ -214,12 +209,8 @@ subroutine psb_dfree_vect(x, desc_a, info)
   call psb_erractionrestore(err_act)
   return
 
-9999 continue
-  call psb_erractionrestore(err_act)
-  if (err_act == psb_act_abort_) then
-     call psb_error(ictxt)
-     return
-  end if
+9999 call psb_error_handler(ictxt,err_act)
+
   return
 
 end subroutine psb_dfree_vect
@@ -269,12 +260,8 @@ subroutine psb_dfree_vect_r2(x, desc_a, info)
   call psb_erractionrestore(err_act)
   return
 
-9999 continue
-  call psb_erractionrestore(err_act)
-  if (err_act == psb_act_abort_) then
-     call psb_error(ictxt)
-     return
-  end if
+9999 call psb_error_handler(ictxt,err_act)
+
   return
 
 end subroutine psb_dfree_vect_r2

base/tools/psb_dins.f90

@@ -171,14 +171,8 @@ subroutine psb_dinsvi(m, irw, val, x, desc_a, info, dupl,local)
   call psb_erractionrestore(err_act)
   return
 
-9999 continue
-  call psb_erractionrestore(err_act)
+9999 call psb_error_handler(ictxt,err_act)
 
-  if (err_act == psb_act_ret_) then
-    return
-  else
-    call psb_error(ictxt)
-  end if
   return
 
 end subroutine psb_dinsvi
@@ -292,14 +286,8 @@ subroutine psb_dins_vect(m, irw, val, x, desc_a, info, dupl,local)
   call psb_erractionrestore(err_act)
   return
 
-9999 continue
-  call psb_erractionrestore(err_act)
+9999 call psb_error_handler(ictxt,err_act)
 
-  if (err_act == psb_act_ret_) then
-    return
-  else
-    call psb_error(ictxt)
-  end if
   return
 
 end subroutine psb_dins_vect
@@ -408,14 +396,8 @@ subroutine psb_dins_vect_v(m, irw, val, x, desc_a, info, dupl,local)
   call psb_erractionrestore(err_act)
   return
 
-9999 continue
-  call psb_erractionrestore(err_act)
+9999 call psb_error_handler(ictxt,err_act)
 
-  if (err_act == psb_act_ret_) then
-    return
-  else
-    call psb_error(ictxt)
-  end if
   return
 
 end subroutine psb_dins_vect_v
@@ -533,14 +515,8 @@ subroutine psb_dins_vect_r2(m, irw, val, x, desc_a, info, dupl,local)
   call psb_erractionrestore(err_act)
   return
 
-9999 continue
-  call psb_erractionrestore(err_act)
+9999 call psb_error_handler(ictxt,err_act)
 
-  if (err_act == psb_act_ret_) then
-    return
-  else
-    call psb_error(ictxt)
-  end if
   return
 
 end subroutine psb_dins_vect_r2
@@ -730,14 +706,8 @@ subroutine psb_dinsi(m, irw, val, x, desc_a, info, dupl,local)
   call psb_erractionrestore(err_act)
   return
 
-9999 continue
-  call psb_erractionrestore(err_act)
+9999 call psb_error_handler(ictxt,err_act)
 
-  if (err_act == psb_act_ret_) then
-    return
-  else
-    call psb_error(ictxt)
-  end if
   return
 
 end subroutine psb_dinsi

base/tools/psb_dspalloc.f90

@@ -59,19 +59,13 @@ subroutine psb_dspalloc(a, desc_a, info, nnz)
   integer(psb_ipk_) :: debug_level, debug_unit
   character(len=20)   :: name, ch_err
 
+  if(psb_get_errstatus() /= 0) return 
   info=psb_success_
-  if (psb_errstatus_fatal()) return 
   call psb_erractionsave(err_act)
   name = 'psb_dspall'
   debug_unit  = psb_get_debug_unit()
   debug_level = psb_get_debug_level()
 
-  if (.not.desc_a%is_ok()) then
-    info = psb_err_invalid_cd_state_
-    call psb_errpush(info,name)
-    goto 9999
-  end if
-
   ictxt   = desc_a%get_context()
   dectype = desc_a%get_dectype()
 
@@ -107,11 +101,11 @@ subroutine psb_dspalloc(a, desc_a, info, nnz)
   if (debug_level >= psb_debug_ext_) &
        & write(debug_unit,*) me,' ',trim(name),':allocating size:',length_ia1
   call a%free()
-
   !....allocate aspk, ia1, ia2.....
   call a%csall(loc_row,loc_col,info,nz=length_ia1)
-  if (psb_errstatus_fatal()) then
+  if(info /= psb_success_) then
     info=psb_err_from_subroutine_
+    ch_err='sp_all'
     call psb_errpush(info,name,int_err)
     goto 9999
   end if
@@ -125,14 +119,8 @@ subroutine psb_dspalloc(a, desc_a, info, nnz)
   call psb_erractionrestore(err_act)
   return
 
-9999 continue
-  call psb_erractionrestore(err_act)
+9999 call psb_error_handler(ictxt,err_act)
 
-  if (err_act == psb_act_ret_) then
-    return
-  else
-    call psb_error(ictxt)
-  end if
   return
 
 end subroutine psb_dspalloc

base/tools/psb_dspasb.f90

@@ -140,12 +140,8 @@ subroutine psb_dspasb(a,desc_a, info, afmt, upd, dupl, mold)
   call psb_erractionrestore(err_act)
   return
 
-9999 continue
-  call psb_erractionrestore(err_act)
-  if (err_act == psb_act_abort_) then
-    call psb_error(ictxt)
-    return
-  end if
+9999 call psb_error_handler(ictxt,err_act)
+
   return
 
 end subroutine psb_dspasb

base/tools/psb_dspfree.f90

@@ -56,31 +56,22 @@ subroutine psb_dspfree(a, desc_a,info)
   name = 'psb_dspfree'
   call psb_erractionsave(err_act)
 
-  if (.not.desc_a%is_ok()) then
-    info = psb_err_invalid_cd_state_
+  if (.not.psb_is_ok_desc(desc_a)) then
+    info = psb_err_forgot_spall_
     call psb_errpush(info,name)
-    goto 9999
+    return
   else
     ictxt = desc_a%get_context()
   end if
 
   !...deallocate a....
   call a%free()
-  if (psb_errstatus_fatal()) then 
-    info = psb_err_from_subroutine_
-    call psb_errpush(info,name,a_err='a%free')
-    goto 9999
-  end if
 
   call psb_erractionrestore(err_act)
   return
 
-9999 continue
-  call psb_erractionrestore(err_act)
-  if (err_act == psb_act_abort_) then
-    call psb_error(ictxt)
-    return
-  end if
+9999 call psb_error_handler(ictxt,err_act)
+
   return
 
 end subroutine psb_dspfree

base/tools/psb_dsphalo.F90

@@ -366,12 +366,8 @@ Subroutine psb_dsphalo(a,desc_a,blk,info,rowcnv,colcnv,&
   call psb_erractionrestore(err_act)
   return
 
-9999 continue
-  call psb_erractionrestore(err_act)
-  if (err_act == psb_act_abort_) then
-    call psb_error(ictxt)
-    return
-  end if
+9999 call psb_error_handler(ictxt,err_act)
+
   return
 
 End Subroutine psb_dsphalo

base/tools/psb_dspins.f90

@@ -193,12 +193,8 @@ subroutine psb_dspins(nz,ia,ja,val,a,desc_a,info,rebuild,local)
   call psb_erractionrestore(err_act)
   return
 
-9999 continue
-  call psb_erractionrestore(err_act)
-  if (err_act == psb_act_abort_) then
-    call psb_error(ictxt)
-    return
-  end if
+9999 call psb_error_handler(ictxt,err_act)
+
   return
 
 end subroutine psb_dspins
@@ -313,12 +309,8 @@ subroutine psb_dspins_2desc(nz,ia,ja,val,a,desc_ar,desc_ac,info)
   call psb_erractionrestore(err_act)
   return
 
-9999 continue
-  call psb_erractionrestore(err_act)
-  if (err_act == psb_act_abort_) then
-    call psb_error(ictxt)
-    return
-  end if
+9999 call psb_error_handler(ictxt,err_act)
+
   return
 
 end subroutine psb_dspins_2desc
@@ -472,12 +464,8 @@ subroutine psb_dspins_v(nz,ia,ja,val,a,desc_a,info,rebuild,local)
   call psb_erractionrestore(err_act)
   return
 
-9999 continue
-  call psb_erractionrestore(err_act)
-  if (err_act == psb_act_abort_) then
-    call psb_error(ictxt)
-    return
-  end if
+9999 call psb_error_handler(ictxt,err_act)
+
   return
 
 end subroutine psb_dspins_v

base/tools/psb_sallc.f90

@@ -125,12 +125,8 @@ subroutine psb_salloc(x, desc_a, info, n, lb)
   call psb_erractionrestore(err_act)
   return
 
-9999 continue
-  call psb_erractionrestore(err_act)
-  if (err_act == psb_act_abort_) then
-    call psb_error(ictxt)
-    return
-  end if
+9999 call psb_error_handler(ictxt,err_act)
+
   return
 
 end subroutine psb_salloc
@@ -167,9 +163,8 @@ end subroutine psb_salloc
 !!$ 
 !!$  
 !
-!
 ! Function: psb_sallocv
-!    Allocates dense matrix for PSBLAS routines. 
+!    Allocates dense matrix for PSBLAS routines
 !    The descriptor may be in either the build or assembled state.
 ! 
 ! Arguments: 
@@ -243,16 +238,13 @@ subroutine psb_sallocv(x, desc_a,info,n)
   call psb_erractionrestore(err_act)
   return
 
-9999 continue
-  call psb_erractionrestore(err_act)
-  if (err_act == psb_act_abort_) then
-    call psb_error(ictxt)
-    return
-  end if
+9999 call psb_error_handler(ictxt,err_act)
+
   return
 
 end subroutine psb_sallocv
 
+
 subroutine psb_salloc_vect(x, desc_a,info,n)
   use psb_base_mod, psb_protect_name => psb_salloc_vect
   use psi_mod
@@ -320,12 +312,8 @@ subroutine psb_salloc_vect(x, desc_a,info,n)
   call psb_erractionrestore(err_act)
   return
 
-9999 continue
-  call psb_erractionrestore(err_act)
-  if (err_act == psb_act_abort_) then
-    call psb_error(ictxt)
-    return
-  end if
+9999 call psb_error_handler(ictxt,err_act)
+
   return
 
 end subroutine psb_salloc_vect
@@ -427,12 +415,8 @@ subroutine psb_salloc_vect_r2(x, desc_a,info,n,lb)
   call psb_erractionrestore(err_act)
   return
 
-9999 continue
-  call psb_erractionrestore(err_act)
-  if (err_act == psb_act_abort_) then
-    call psb_error(ictxt)
-    return
-  end if
+9999 call psb_error_handler(ictxt,err_act)
+
   return
 
 end subroutine psb_salloc_vect_r2

base/tools/psb_sasb.f90

@@ -32,7 +32,7 @@
 ! File: psb_sasb.f90
 !
 ! Subroutine: psb_sasb
-!    Assembles a dense matrix for PSBLAS routines.
+!    Assembles a dense matrix for PSBLAS routines
 !    Since the allocation may have been called with the desciptor 
 !    in the build state we make sure that X has a number of rows 
 !    allowing for the halo indices, reallocating if necessary. 
@@ -83,8 +83,7 @@ subroutine psb_sasb(x, desc_a, info)
     goto 9999
   else if (.not.psb_is_asb_desc(desc_a)) then
     if (debug_level >= psb_debug_ext_) &
-         & write(debug_unit,*) me,' ',trim(name),' error ',&
-         & desc_a%get_dectype()
+         & write(debug_unit,*) me,' ',trim(name),' error '
     info = psb_err_input_matrix_unassembled_
     call psb_errpush(info,name)
     goto 9999
@@ -122,12 +121,8 @@ subroutine psb_sasb(x, desc_a, info)
   call psb_erractionrestore(err_act)
   return
 
-9999 continue
-  call psb_erractionrestore(err_act)
-  if (err_act == psb_act_abort_) then
-    call psb_error(ictxt)
-    return
-  end if
+9999 call psb_error_handler(ictxt,err_act)
+
   return
 
 end subroutine psb_sasb
@@ -240,16 +235,13 @@ subroutine psb_sasbv(x, desc_a, info)
   call psb_erractionrestore(err_act)
   return
 
-9999 continue
-  call psb_erractionrestore(err_act)
-  if (err_act == psb_act_abort_) then
-    call psb_error(ictxt)
-    return
-  end if
+9999 call psb_error_handler(ictxt,err_act)
+
   return
 
 end subroutine psb_sasbv
 
+
 subroutine psb_sasb_vect(x, desc_a, info, mold, scratch)
   use psb_base_mod, psb_protect_name => psb_sasb_vect
   implicit none
@@ -319,12 +311,8 @@ subroutine psb_sasb_vect(x, desc_a, info, mold, scratch)
   call psb_erractionrestore(err_act)
   return
 
-9999 continue
-  call psb_erractionrestore(err_act)
-  if (err_act == psb_act_abort_) then
-    call psb_error(ictxt)
-    return
-  end if
+9999 call psb_error_handler(ictxt,err_act)
+
   return
 
 end subroutine psb_sasb_vect
@@ -407,12 +395,8 @@ subroutine psb_sasb_vect_r2(x, desc_a, info, mold, scratch)
   call psb_erractionrestore(err_act)
   return
 
-9999 continue
-  call psb_erractionrestore(err_act)
-  if (err_act == psb_act_abort_) then
-    call psb_error(ictxt)
-    return
-  end if
+9999 call psb_error_handler(ictxt,err_act)
+
   return
 
 end subroutine psb_sasb_vect_r2

base/tools/psb_scdbldext.F90

@@ -716,13 +716,9 @@ Subroutine psb_scdbldext(a,desc_a,novr,desc_ov,info, extype)
   call psb_erractionrestore(err_act)
   return
 
-9999 continue
-  call psb_erractionrestore(err_act)
-  if (err_act == psb_act_abort_) then
-    call psb_error(ictxt)
+9999 call psb_error_handler(ictxt,err_act)
+
   return
-  end if
-  Return
 
 End Subroutine psb_scdbldext
 

base/tools/psb_sfree.f90

@@ -59,7 +59,7 @@ subroutine psb_sfree(x, desc_a, info)
   if (.not.psb_is_ok_desc(desc_a)) then
     info=psb_err_forgot_spall_
     call psb_errpush(info,name)
-    goto 9999
+    return
   end if
 
   ictxt=desc_a%get_context()
@@ -90,12 +90,8 @@ subroutine psb_sfree(x, desc_a, info)
   call psb_erractionrestore(err_act)
   return
 
-9999 continue
-  call psb_erractionrestore(err_act)
-  if (err_act == psb_act_abort_) then
-    call psb_error(ictxt)
-    return
-  end if
+9999 call psb_error_handler(ictxt,err_act)
+
   return
 
 end subroutine psb_sfree
@@ -106,7 +102,7 @@ end subroutine psb_sfree
 !    frees a dense matrix structure
 ! 
 ! Arguments: 
-!    x():)    - real, allocatable              The dense matrix to be freed.
+!    x(:)     - real, allocatable        The dense matrix to be freed.
 !    desc_a   - type(psb_desc_type).      The communication descriptor.
 !    info     - integer.                    Return code
 subroutine psb_sfreev(x, desc_a, info)
@@ -116,6 +112,7 @@ subroutine psb_sfreev(x, desc_a, info)
   real(psb_spk_),allocatable, intent(inout)    :: x(:)
   type(psb_desc_type), intent(in) :: desc_a
   integer(psb_ipk_), intent(out)            :: info
+
   !...locals....
   integer(psb_ipk_) :: ictxt,np,me, err_act
   character(len=20)   :: name
@@ -126,10 +123,11 @@ subroutine psb_sfreev(x, desc_a, info)
   call psb_erractionsave(err_act)
   name='psb_sfreev'
 
+
   if (.not.psb_is_ok_desc(desc_a)) then
     info=psb_err_forgot_spall_
     call psb_errpush(info,name)
-    return
+    goto 9999
   end if
   ictxt=desc_a%get_context()
 
@@ -138,6 +136,7 @@ subroutine psb_sfreev(x, desc_a, info)
     info = psb_err_context_error_
     call psb_errpush(info,name)
     goto 9999
+
   endif
 
   if (.not.allocated(x)) then
@@ -156,12 +155,8 @@ subroutine psb_sfreev(x, desc_a, info)
   call psb_erractionrestore(err_act)
   return
 
-9999 continue
-  call psb_erractionrestore(err_act)
-  if (err_act == psb_act_abort_) then
-    call psb_error(ictxt)
-    return
-  end if
+9999 call psb_error_handler(ictxt,err_act)
+
   return
 
 end subroutine psb_sfreev
@@ -214,12 +209,8 @@ subroutine psb_sfree_vect(x, desc_a, info)
   call psb_erractionrestore(err_act)
   return
 
-9999 continue
-  call psb_erractionrestore(err_act)
-  if (err_act == psb_act_abort_) then
-     call psb_error(ictxt)
-     return
-  end if
+9999 call psb_error_handler(ictxt,err_act)
+
   return
 
 end subroutine psb_sfree_vect
@@ -269,12 +260,8 @@ subroutine psb_sfree_vect_r2(x, desc_a, info)
   call psb_erractionrestore(err_act)
   return
 
-9999 continue
-  call psb_erractionrestore(err_act)
-  if (err_act == psb_act_abort_) then
-     call psb_error(ictxt)
-     return
-  end if
+9999 call psb_error_handler(ictxt,err_act)
+
   return
 
 end subroutine psb_sfree_vect_r2

base/tools/psb_sins.f90

@@ -171,14 +171,8 @@ subroutine psb_sinsvi(m, irw, val, x, desc_a, info, dupl,local)
   call psb_erractionrestore(err_act)
   return
 
-9999 continue
-  call psb_erractionrestore(err_act)
+9999 call psb_error_handler(ictxt,err_act)
 
-  if (err_act == psb_act_ret_) then
-    return
-  else
-    call psb_error(ictxt)
-  end if
   return
 
 end subroutine psb_sinsvi
@@ -292,14 +286,8 @@ subroutine psb_sins_vect(m, irw, val, x, desc_a, info, dupl,local)
   call psb_erractionrestore(err_act)
   return
 
-9999 continue
-  call psb_erractionrestore(err_act)
+9999 call psb_error_handler(ictxt,err_act)
 
-  if (err_act == psb_act_ret_) then
-    return
-  else
-    call psb_error(ictxt)
-  end if
   return
 
 end subroutine psb_sins_vect
@@ -408,14 +396,8 @@ subroutine psb_sins_vect_v(m, irw, val, x, desc_a, info, dupl,local)
   call psb_erractionrestore(err_act)
   return
 
-9999 continue
-  call psb_erractionrestore(err_act)
+9999 call psb_error_handler(ictxt,err_act)
 
-  if (err_act == psb_act_ret_) then
-    return
-  else
-    call psb_error(ictxt)
-  end if
   return
 
 end subroutine psb_sins_vect_v
@@ -533,14 +515,8 @@ subroutine psb_sins_vect_r2(m, irw, val, x, desc_a, info, dupl,local)
   call psb_erractionrestore(err_act)
   return
 
-9999 continue
-  call psb_erractionrestore(err_act)
+9999 call psb_error_handler(ictxt,err_act)
 
-  if (err_act == psb_act_ret_) then
-    return
-  else
-    call psb_error(ictxt)
-  end if
   return
 
 end subroutine psb_sins_vect_r2
@@ -730,14 +706,8 @@ subroutine psb_sinsi(m, irw, val, x, desc_a, info, dupl,local)
   call psb_erractionrestore(err_act)
   return
 
-9999 continue
-  call psb_erractionrestore(err_act)
+9999 call psb_error_handler(ictxt,err_act)
 
-  if (err_act == psb_act_ret_) then
-    return
-  else
-    call psb_error(ictxt)
-  end if
   return
 
 end subroutine psb_sinsi

base/tools/psb_sspalloc.f90

@@ -119,14 +119,8 @@ subroutine psb_sspalloc(a, desc_a, info, nnz)
   call psb_erractionrestore(err_act)
   return
 
-9999 continue
-  call psb_erractionrestore(err_act)
+9999 call psb_error_handler(ictxt,err_act)
 
-  if (err_act == psb_act_ret_) then
-    return
-  else
-    call psb_error(ictxt)
-  end if
   return
 
 end subroutine psb_sspalloc

base/tools/psb_sspasb.f90

@@ -140,12 +140,8 @@ subroutine psb_sspasb(a,desc_a, info, afmt, upd, dupl, mold)
   call psb_erractionrestore(err_act)
   return
 
-9999 continue
-  call psb_erractionrestore(err_act)
-  if (err_act == psb_act_abort_) then
-    call psb_error(ictxt)
-    return
-  end if
+9999 call psb_error_handler(ictxt,err_act)
+
   return
 
 end subroutine psb_sspasb

base/tools/psb_sspfree.f90

@@ -70,12 +70,8 @@ subroutine psb_sspfree(a, desc_a,info)
   call psb_erractionrestore(err_act)
   return
 
-9999 continue
-  call psb_erractionrestore(err_act)
-  if (err_act == psb_act_abort_) then
-    call psb_error(ictxt)
-    return
-  end if
+9999 call psb_error_handler(ictxt,err_act)
+
   return
 
 end subroutine psb_sspfree

base/tools/psb_ssphalo.F90

@@ -366,12 +366,8 @@ Subroutine psb_ssphalo(a,desc_a,blk,info,rowcnv,colcnv,&
   call psb_erractionrestore(err_act)
   return
 
-9999 continue
-  call psb_erractionrestore(err_act)
-  if (err_act == psb_act_abort_) then
-    call psb_error(ictxt)
-    return
-  end if
+9999 call psb_error_handler(ictxt,err_act)
+
   return
 
 End Subroutine psb_ssphalo

base/tools/psb_sspins.f90

@@ -193,12 +193,8 @@ subroutine psb_sspins(nz,ia,ja,val,a,desc_a,info,rebuild,local)
   call psb_erractionrestore(err_act)
   return
 
-9999 continue
-  call psb_erractionrestore(err_act)
-  if (err_act == psb_act_abort_) then
-    call psb_error(ictxt)
-    return
-  end if
+9999 call psb_error_handler(ictxt,err_act)
+
   return
 
 end subroutine psb_sspins
@@ -313,12 +309,8 @@ subroutine psb_sspins_2desc(nz,ia,ja,val,a,desc_ar,desc_ac,info)
   call psb_erractionrestore(err_act)
   return
 
-9999 continue
-  call psb_erractionrestore(err_act)
-  if (err_act == psb_act_abort_) then
-    call psb_error(ictxt)
-    return
-  end if
+9999 call psb_error_handler(ictxt,err_act)
+
   return
 
 end subroutine psb_sspins_2desc
@@ -472,12 +464,8 @@ subroutine psb_sspins_v(nz,ia,ja,val,a,desc_a,info,rebuild,local)
   call psb_erractionrestore(err_act)
   return
 
-9999 continue
-  call psb_erractionrestore(err_act)
-  if (err_act == psb_act_abort_) then
-    call psb_error(ictxt)
-    return
-  end if
+9999 call psb_error_handler(ictxt,err_act)
+
   return
 
 end subroutine psb_sspins_v

base/tools/psb_zallc.f90

@@ -125,12 +125,8 @@ subroutine psb_zalloc(x, desc_a, info, n, lb)
   call psb_erractionrestore(err_act)
   return
 
-9999 continue
-  call psb_erractionrestore(err_act)
-  if (err_act == psb_act_abort_) then
-    call psb_error(ictxt)
-    return
-  end if
+9999 call psb_error_handler(ictxt,err_act)
+
   return
 
 end subroutine psb_zalloc
@@ -242,12 +238,8 @@ subroutine psb_zallocv(x, desc_a,info,n)
   call psb_erractionrestore(err_act)
   return
 
-9999 continue
-  call psb_erractionrestore(err_act)
-  if (err_act == psb_act_abort_) then
-    call psb_error(ictxt)
-    return
-  end if
+9999 call psb_error_handler(ictxt,err_act)
+
   return
 
 end subroutine psb_zallocv
@@ -320,12 +312,8 @@ subroutine psb_zalloc_vect(x, desc_a,info,n)
   call psb_erractionrestore(err_act)
   return
 
-9999 continue
-  call psb_erractionrestore(err_act)
-  if (err_act == psb_act_abort_) then
-    call psb_error(ictxt)
-    return
-  end if
+9999 call psb_error_handler(ictxt,err_act)
+
   return
 
 end subroutine psb_zalloc_vect
@@ -427,12 +415,8 @@ subroutine psb_zalloc_vect_r2(x, desc_a,info,n,lb)
   call psb_erractionrestore(err_act)
   return
 
-9999 continue
-  call psb_erractionrestore(err_act)
-  if (err_act == psb_act_abort_) then
-    call psb_error(ictxt)
-    return
-  end if
+9999 call psb_error_handler(ictxt,err_act)
+
   return
 
 end subroutine psb_zalloc_vect_r2

base/tools/psb_zasb.f90

@@ -121,12 +121,8 @@ subroutine psb_zasb(x, desc_a, info)
   call psb_erractionrestore(err_act)
   return
 
-9999 continue
-  call psb_erractionrestore(err_act)
-  if (err_act == psb_act_abort_) then
-    call psb_error(ictxt)
-    return
-  end if
+9999 call psb_error_handler(ictxt,err_act)
+
   return
 
 end subroutine psb_zasb
@@ -239,12 +235,8 @@ subroutine psb_zasbv(x, desc_a, info)
   call psb_erractionrestore(err_act)
   return
 
-9999 continue
-  call psb_erractionrestore(err_act)
-  if (err_act == psb_act_abort_) then
-    call psb_error(ictxt)
-    return
-  end if
+9999 call psb_error_handler(ictxt,err_act)
+
   return
 
 end subroutine psb_zasbv
@@ -319,12 +311,8 @@ subroutine psb_zasb_vect(x, desc_a, info, mold, scratch)
   call psb_erractionrestore(err_act)
   return
 
-9999 continue
-  call psb_erractionrestore(err_act)
-  if (err_act == psb_act_abort_) then
-    call psb_error(ictxt)
-    return
-  end if
+9999 call psb_error_handler(ictxt,err_act)
+
   return
 
 end subroutine psb_zasb_vect
@@ -407,12 +395,8 @@ subroutine psb_zasb_vect_r2(x, desc_a, info, mold, scratch)
   call psb_erractionrestore(err_act)
   return
 
-9999 continue
-  call psb_erractionrestore(err_act)
-  if (err_act == psb_act_abort_) then
-    call psb_error(ictxt)
-    return
-  end if
+9999 call psb_error_handler(ictxt,err_act)
+
   return
 
 end subroutine psb_zasb_vect_r2

base/tools/psb_zcdbldext.F90

@@ -716,13 +716,9 @@ Subroutine psb_zcdbldext(a,desc_a,novr,desc_ov,info, extype)
   call psb_erractionrestore(err_act)
   return
 
-9999 continue
-  call psb_erractionrestore(err_act)
-  if (err_act == psb_act_abort_) then
-    call psb_error(ictxt)
+9999 call psb_error_handler(ictxt,err_act)
+
   return
-  end if
-  Return
 
 End Subroutine psb_zcdbldext
 

base/tools/psb_zfree.f90

@@ -90,12 +90,8 @@ subroutine psb_zfree(x, desc_a, info)
   call psb_erractionrestore(err_act)
   return
 
-9999 continue
-  call psb_erractionrestore(err_act)
-  if (err_act == psb_act_abort_) then
-    call psb_error(ictxt)
-    return
-  end if
+9999 call psb_error_handler(ictxt,err_act)
+
   return
 
 end subroutine psb_zfree
@@ -159,14 +155,8 @@ subroutine psb_zfreev(x, desc_a, info)
   call psb_erractionrestore(err_act)
   return
 
-9999 continue
-  call psb_erractionrestore(err_act)
+9999 call psb_error_handler(ictxt,err_act)
 
-  if (err_act == psb_act_ret_) then
-    return
-  else
-    call psb_error(ictxt)
-  end if
   return
 
 end subroutine psb_zfreev
@@ -219,12 +209,8 @@ subroutine psb_zfree_vect(x, desc_a, info)
   call psb_erractionrestore(err_act)
   return
 
-9999 continue
-  call psb_erractionrestore(err_act)
-  if (err_act == psb_act_abort_) then
-     call psb_error(ictxt)
-     return
-  end if
+9999 call psb_error_handler(ictxt,err_act)
+
   return
 
 end subroutine psb_zfree_vect
@@ -274,12 +260,8 @@ subroutine psb_zfree_vect_r2(x, desc_a, info)
   call psb_erractionrestore(err_act)
   return
 
-9999 continue
-  call psb_erractionrestore(err_act)
-  if (err_act == psb_act_abort_) then
-     call psb_error(ictxt)
-     return
-  end if
+9999 call psb_error_handler(ictxt,err_act)
+
   return
 
 end subroutine psb_zfree_vect_r2

base/tools/psb_zins.f90

@@ -171,14 +171,8 @@ subroutine psb_zinsvi(m, irw, val, x, desc_a, info, dupl,local)
   call psb_erractionrestore(err_act)
   return
 
-9999 continue
-  call psb_erractionrestore(err_act)
+9999 call psb_error_handler(ictxt,err_act)
 
-  if (err_act == psb_act_ret_) then
-    return
-  else
-    call psb_error(ictxt)
-  end if
   return
 
 end subroutine psb_zinsvi
@@ -292,14 +286,8 @@ subroutine psb_zins_vect(m, irw, val, x, desc_a, info, dupl,local)
   call psb_erractionrestore(err_act)
   return
 
-9999 continue
-  call psb_erractionrestore(err_act)
+9999 call psb_error_handler(ictxt,err_act)
 
-  if (err_act == psb_act_ret_) then
-    return
-  else
-    call psb_error(ictxt)
-  end if
   return
 
 end subroutine psb_zins_vect
@@ -408,14 +396,8 @@ subroutine psb_zins_vect_v(m, irw, val, x, desc_a, info, dupl,local)
   call psb_erractionrestore(err_act)
   return
 
-9999 continue
-  call psb_erractionrestore(err_act)
+9999 call psb_error_handler(ictxt,err_act)
 
-  if (err_act == psb_act_ret_) then
-    return
-  else
-    call psb_error(ictxt)
-  end if
   return
 
 end subroutine psb_zins_vect_v
@@ -533,14 +515,8 @@ subroutine psb_zins_vect_r2(m, irw, val, x, desc_a, info, dupl,local)
   call psb_erractionrestore(err_act)
   return
 
-9999 continue
-  call psb_erractionrestore(err_act)
+9999 call psb_error_handler(ictxt,err_act)
 
-  if (err_act == psb_act_ret_) then
-    return
-  else
-    call psb_error(ictxt)
-  end if
   return
 
 end subroutine psb_zins_vect_r2
@@ -730,14 +706,8 @@ subroutine psb_zinsi(m, irw, val, x, desc_a, info, dupl,local)
   call psb_erractionrestore(err_act)
   return
 
-9999 continue
-  call psb_erractionrestore(err_act)
+9999 call psb_error_handler(ictxt,err_act)
 
-  if (err_act == psb_act_ret_) then
-    return
-  else
-    call psb_error(ictxt)
-  end if
   return
 
 end subroutine psb_zinsi

base/tools/psb_zspalloc.f90

@@ -119,14 +119,8 @@ subroutine psb_zspalloc(a, desc_a, info, nnz)
   call psb_erractionrestore(err_act)
   return
 
-9999 continue
-  call psb_erractionrestore(err_act)
+9999 call psb_error_handler(ictxt,err_act)
 
-  if (err_act == psb_act_ret_) then
-    return
-  else
-    call psb_error(ictxt)
-  end if
   return
 
 end subroutine psb_zspalloc

base/tools/psb_zspasb.f90

@@ -140,12 +140,8 @@ subroutine psb_zspasb(a,desc_a, info, afmt, upd, dupl, mold)
   call psb_erractionrestore(err_act)
   return
 
-9999 continue
-  call psb_erractionrestore(err_act)
-  if (err_act == psb_act_abort_) then
-    call psb_error(ictxt)
-    return
-  end if
+9999 call psb_error_handler(ictxt,err_act)
+
   return
 
 end subroutine psb_zspasb

base/tools/psb_zspfree.f90

@@ -70,12 +70,8 @@ subroutine psb_zspfree(a, desc_a,info)
   call psb_erractionrestore(err_act)
   return
 
-9999 continue
-  call psb_erractionrestore(err_act)
-  if (err_act == psb_act_abort_) then
-    call psb_error(ictxt)
-    return
-  end if
+9999 call psb_error_handler(ictxt,err_act)
+
   return
 
 end subroutine psb_zspfree

base/tools/psb_zsphalo.F90

@@ -366,12 +366,8 @@ Subroutine psb_zsphalo(a,desc_a,blk,info,rowcnv,colcnv,&
   call psb_erractionrestore(err_act)
   return
 
-9999 continue
-  call psb_erractionrestore(err_act)
-  if (err_act == psb_act_abort_) then
-    call psb_error(ictxt)
-    return
-  end if
+9999 call psb_error_handler(ictxt,err_act)
+
   return
 
 End Subroutine psb_zsphalo

base/tools/psb_zspins.f90

@@ -193,12 +193,8 @@ subroutine psb_zspins(nz,ia,ja,val,a,desc_a,info,rebuild,local)
   call psb_erractionrestore(err_act)
   return
 
-9999 continue
-  call psb_erractionrestore(err_act)
-  if (err_act == psb_act_abort_) then
-    call psb_error(ictxt)
-    return
-  end if
+9999 call psb_error_handler(ictxt,err_act)
+
   return
 
 end subroutine psb_zspins
@@ -313,12 +309,8 @@ subroutine psb_zspins_2desc(nz,ia,ja,val,a,desc_ar,desc_ac,info)
   call psb_erractionrestore(err_act)
   return
 
-9999 continue
-  call psb_erractionrestore(err_act)
-  if (err_act == psb_act_abort_) then
-    call psb_error(ictxt)
-    return
-  end if
+9999 call psb_error_handler(ictxt,err_act)
+
   return
 
 end subroutine psb_zspins_2desc
@@ -472,12 +464,8 @@ subroutine psb_zspins_v(nz,ia,ja,val,a,desc_a,info,rebuild,local)
   call psb_erractionrestore(err_act)
   return
 
-9999 continue
-  call psb_erractionrestore(err_act)
-  if (err_act == psb_act_abort_) then
-    call psb_error(ictxt)
-    return
-  end if
+9999 call psb_error_handler(ictxt,err_act)
+
   return
 
 end subroutine psb_zspins_v