|
|
|
|
! 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
|
|
|
|
|
|
