diff --git a/base/modules/psb_error_impl.F90 b/base/modules/psb_error_impl.F90 index b85c48e9..f4308816 100644 --- a/base/modules/psb_error_impl.F90 +++ b/base/modules/psb_error_impl.F90 @@ -46,11 +46,14 @@ subroutine psb_par_error_handler(ctxt,err_act) call psb_erractionrestore(err_act) - if (err_act == psb_act_print_) & - & call psb_error(ctxt, abrt=.false.) - if (err_act == psb_act_abort_) & - & call psb_error(ctxt, abrt=.true.) - + 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 diff --git a/base/modules/psb_error_mod.F90 b/base/modules/psb_error_mod.F90 index fe12fca4..9e44b9e9 100644 --- a/base/modules/psb_error_mod.F90 +++ b/base/modules/psb_error_mod.F90 @@ -162,6 +162,7 @@ module psb_error_mod logical, save :: comm_global_checks = .false. contains + subroutine psb_set_global_checks(val) logical, intent(in), optional :: val @@ -182,7 +183,16 @@ contains val = comm_global_checks end function psb_get_global_checks - + + subroutine psb_check_error(ctxt,abrt) + implicit none + type(psb_ctxt_type), intent(in) :: ctxt + logical, optional, intent(in) :: abrt + + if (psb_errstatus_fatal()) then + call psb_error(ctxt,abrt) + end if + end subroutine psb_check_error ! saves action to support error traceback ! also changes error action to "return" diff --git a/cbind/base/psb_c_base.h b/cbind/base/psb_c_base.h index d151428e..69a749ea 100644 --- a/cbind/base/psb_c_base.h +++ b/cbind/base/psb_c_base.h @@ -49,6 +49,7 @@ extern "C" { + void psb_c_check_error(psb_c_ctxt *cctxt); psb_i_t psb_c_error(); psb_i_t psb_c_clean_errstack(); void psb_c_print_errmsg(); diff --git a/cbind/base/psb_cpenv_mod.f90 b/cbind/base/psb_cpenv_mod.f90 index 30133490..cb1d0a14 100644 --- a/cbind/base/psb_cpenv_mod.f90 +++ b/cbind/base/psb_cpenv_mod.f90 @@ -132,6 +132,24 @@ contains return end subroutine psb_c_abort + subroutine psb_c_check_error(cctxt) bind(c) + use psb_base_mod, only : psb_init, psb_ctxt_type + implicit none + + type(psb_c_object_type) :: cctxt + type(psb_ctxt_type), pointer :: ctxt + integer :: info + + if (c_associated(cctxt%item)) then + call c_f_pointer(cctxt%item,ctxt) + deallocate(ctxt,stat=info) + if (info /= 0) return + end if + allocate(ctxt,stat=info) + if (info /= 0) return + call psb_check_error(ctxt,abrt=.true.) + + end subroutine psb_c_check_error subroutine psb_c_info(cctxt,iam,np) bind(c) use psb_base_mod, only : psb_info, psb_ctxt_type