base/modules/parts.f90

@@ -1,8 +0,0 @@
-module psb_parts_mod
-  interface 
-     subroutine psb_parts(glob_index,nrow,np,pv,nv)
-       integer(psb_ipk_), intent (in)  :: glob_index,np,nrow
-       integer(psb_ipk_), intent (out) :: nv, pv(*)
-     end subroutine psb_parts
-  end interface
-end module psb_parts_mod

base/modules/parts.fh

@@ -1,8 +0,0 @@
-interface 
-   !.....user passed subroutine.....
-   subroutine parts(glob_index,nrow,np,pv,nv)
-     import :: psb_ipk_
-     integer(psb_ipk_), intent (in)  :: glob_index,np,nrow
-     integer(psb_ipk_), intent (out) :: nv, pv(*)
-   end subroutine parts
-end interface

base/modules/psb_error_impl.F90

@@ -9,6 +9,57 @@ subroutine psb_errcomm(ictxt, err)
 
 end subroutine psb_errcomm
 
+subroutine psb_ser_error_handler(err_act)
+  use psb_error_mod, psb_protect_name => psb_ser_error_handler
+  use psb_penv_mod
+  implicit none 
+  integer(psb_ipk_), intent(inout) ::  err_act
+  
+  call psb_erractionrestore(err_act)
+  
+  if (err_act /= psb_act_ret_)     &
+       &  call psb_error()
+  if (err_act == psb_act_abort_) stop
+
+  return 
+end subroutine psb_ser_error_handler
+
+subroutine psb_par_error_handler(ictxt,err_act)
+  use psb_error_mod, psb_protect_name => psb_par_error_handler
+  use psb_penv_mod
+  implicit none 
+  integer(psb_mpik_), intent(in) ::  ictxt
+  integer(psb_ipk_), intent(in) ::  err_act
+
+  call psb_erractionrestore(err_act)
+  
+  if (err_act == psb_act_print_)     &
+       &  call psb_error(ictxt, abrt=.false.)
+  if (err_act == psb_act_abort_)      &
+       &  call psb_error(ictxt, abrt=.true.)
+
+  return 
+
+end subroutine psb_par_error_handler
+
+subroutine psb_par_error_print_stack(ictxt)
+  use psb_error_mod, psb_protect_name => psb_par_error_print_stack
+  use psb_penv_mod
+  integer(psb_mpik_), intent(in) ::  ictxt
+
+  call psb_error(ictxt, abrt=.false.)
+  
+end subroutine psb_par_error_print_stack
+
+subroutine psb_ser_error_print_stack()
+  use psb_error_mod, psb_protect_name => psb_ser_error_print_stack
+
+  call psb_error()
+end subroutine psb_ser_error_print_stack
+
+
+
+
 ! handles the occurence of an error in a serial routine
 subroutine psb_serror()
   use psb_const_mod
@@ -39,7 +90,7 @@ subroutine psb_serror()
     end if
   end if
 #if defined(HAVE_FLUSH_STMT)
-  flush(0) 
+  flush(psb_err_unit) 
 #endif
 
 
@@ -47,18 +98,23 @@ end subroutine psb_serror
 
 
 ! handles the occurence of an error in a parallel routine
-subroutine psb_perror(ictxt)
+subroutine psb_perror(ictxt,abrt)
   use psb_const_mod
   use psb_error_mod
   use psb_penv_mod
   implicit none 
-  integer(psb_mpik_), intent(in)     :: ictxt
-  integer(psb_ipk_) :: err_c
-  character(len=20)       :: r_name
-  character(len=40)       :: a_e_d
-  integer(psb_ipk_) :: i_e_d(5)
-  integer(psb_mpik_) :: iam, np
+  integer(psb_mpik_), intent(in) :: ictxt
+  logical, intent(in), optional  :: abrt
 
+  integer(psb_ipk_)  :: err_c
+  character(len=20)  :: r_name
+  character(len=40)  :: a_e_d
+  integer(psb_ipk_)  :: i_e_d(5)
+  integer(psb_mpik_) :: iam, np
+  logical :: abrt_
+
+  abrt_=.true.
+  if (present(abrt)) abrt_=abrt
   call psb_info(ictxt,iam,np)
   
   if (psb_errstatus_fatal()) then
@@ -71,11 +127,11 @@ subroutine psb_perror(ictxt)
         !            write(psb_err_unit,'(50("="))')
       end do
 #if defined(HAVE_FLUSH_STMT)
-      flush(0) 
+      flush(psb_err_unit) 
 #endif
-
-      call psb_abort(ictxt,-1)
-
+      
+      if (abrt_) call psb_abort(ictxt,-1)
+      
     else
 
       call psb_errpop(err_c, r_name, i_e_d, a_e_d)
@@ -84,10 +140,10 @@ subroutine psb_perror(ictxt)
         call psb_errpop(err_c, r_name, i_e_d, a_e_d)
       end do
 #if defined(HAVE_FLUSH_STMT)
-      flush(0) 
+      flush(psb_err_unit) 
 #endif
 
-      call psb_abort(ictxt,-1)
+      if (abrt_) call psb_abort(ictxt,-1)
 
     end if
   end if

test/pargen/runs/ppde.inp

@@ -2,7 +2,7 @@
 BICGSTAB               Iterative method BICGSTAB CGS  BICG BICGSTABL RGMRES
 BJAC                   Preconditioner NONE  DIAG  BJAC 
 CSR                    Storage format for matrix A:  CSR COO JAD 
-160                    Domain size (acutal system is this**3)
+100                    Domain size (acutal system is this**3)
 2                      Stopping criterion
 1000                   MAXIT
 -1                     ITRACE