! checks wether an error has occurred on one of the porecesses in the execution pool
subroutine psb_errcomm_i(ctxt, err)
  use psb_error_mod, psb_protect_name => psb_errcomm
  use psb_penv_mod
  type(psb_ctxt_type), intent(in)  :: ctxt
  integer(psb_ipk_), intent(inout) :: err

  if (psb_get_global_checks()) call psb_amx(ctxt, err)

end subroutine psb_errcomm_i

#if defined(IPK8)

subroutine psb_errcomm_m(ctxt, err)
  use psb_error_mod, psb_protect_name => psb_errcomm
  use psb_penv_mod
  type(psb_ctxt_type), intent(in)  :: ctxt
  integer(psb_ipk_), intent(inout) :: err
  
  if (psb_get_global_checks()) call psb_amx(ctxt, err)

end subroutine psb_errcomm_m
#endif

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(ctxt,err_act)
  use psb_error_mod, psb_protect_name => psb_par_error_handler
  use psb_penv_mod
  implicit none 
  type(psb_ctxt_type), intent(in) ::  ctxt
  integer(psb_ipk_), intent(in)   ::  err_act

  call psb_erractionrestore(err_act)

  if (err_act == psb_act_print_)    then 
    call psb_error(ctxt, abrt=.false.)
  else if (err_act == psb_act_ret_)     then
    ! do nothing 
  else 
    call psb_error(ctxt, abrt=.true.)
  end if
  
  return 

end subroutine psb_par_error_handler

subroutine psb_par_error_print_stack(ctxt)
  use psb_error_mod, psb_protect_name => psb_par_error_print_stack
  use psb_penv_mod
  type(psb_ctxt_type), intent(in) ::  ctxt

  call psb_error(ctxt, 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
  use psb_error_mod
  implicit none 
  integer(psb_ipk_) ::  err_c
  character(len=20) ::  r_name
  character(len=40) ::  a_e_d
  integer(psb_epk_) ::  e_e_d(5)

  if (psb_errstatus_fatal()) then
    if(psb_get_errverbosity() > 1) then

      do while (psb_get_numerr() > izero)
        write(psb_err_unit,'(50("="))')
        call psb_errpop(err_c, r_name, e_e_d, a_e_d)
        call psb_errmsg(psb_err_unit,err_c, r_name, e_e_d, a_e_d)
        !            write(psb_err_unit,'(50("="))')
      end do

    else

      call psb_errpop(err_c, r_name, e_e_d, a_e_d)
      call psb_errmsg(psb_err_unit,err_c, r_name, e_e_d, a_e_d)
      do while (psb_get_numerr() > 0)
        call psb_errpop(err_c, r_name, e_e_d, a_e_d)
      end do
    end if
  end if
#if defined(HAVE_FLUSH_STMT)
  flush(psb_err_unit) 
#endif


end subroutine psb_serror


! handles the occurence of an error in a parallel routine
subroutine psb_perror(ctxt,abrt)
  use psb_const_mod
  use psb_error_mod
  use psb_penv_mod
  implicit none 
  type(psb_ctxt_type), intent(in) :: ctxt
  logical, intent(in), optional   :: abrt

  integer(psb_ipk_) :: err_c
  character(len=20) :: r_name
  character(len=40) :: a_e_d
  integer(psb_epk_) :: e_e_d(5)
  integer(psb_mpk_) :: iam, np
  logical :: abrt_

  abrt_=.true.
  if (present(abrt)) abrt_=abrt
  call psb_info(ctxt,iam,np)
  
  if (psb_errstatus_fatal()) then
    if (psb_get_errverbosity() > 1) then

      do while (psb_get_numerr() > izero)
        write(psb_err_unit,'(50("="))')
        call psb_errpop(err_c, r_name, e_e_d, a_e_d)
        call psb_errmsg(psb_err_unit,err_c, r_name, e_e_d, a_e_d,iam)
        !            write(psb_err_unit,'(50("="))')
      end do
#if defined(HAVE_FLUSH_STMT)
      flush(psb_err_unit) 
#endif
      
      if (abrt_) call psb_abort(ctxt,-1)
      
    else

      call psb_errpop(err_c, r_name, e_e_d, a_e_d)
      call psb_errmsg(psb_err_unit,err_c, r_name, e_e_d, a_e_d,iam)
      do while (psb_get_numerr() > 0)
        call psb_errpop(err_c, r_name, e_e_d, a_e_d)
      end do
#if defined(HAVE_FLUSH_STMT)
      flush(psb_err_unit) 
#endif

      if (abrt_) call psb_abort(ctxt,-1)

    end if
  end if

end subroutine psb_perror