From f43491292ad86088958682a0c31d927a0a3d4b22 Mon Sep 17 00:00:00 2001 From: Salvatore Filippone Date: Tue, 26 Jun 2018 18:31:20 +0100 Subject: [PATCH] Further fixes for error handling. --- base/comm/internals/psi_covrl_restr.f90 | 8 ++++++-- base/comm/internals/psi_covrl_restr_a.f90 | 8 ++++++-- base/comm/internals/psi_covrl_save.f90 | 8 ++++++-- base/comm/internals/psi_covrl_save_a.f90 | 8 ++++++-- base/comm/internals/psi_covrl_upd.f90 | 8 ++++++-- base/comm/internals/psi_covrl_upd_a.f90 | 8 ++++++-- base/comm/internals/psi_dovrl_restr.f90 | 8 ++++++-- base/comm/internals/psi_dovrl_restr_a.f90 | 8 ++++++-- base/comm/internals/psi_dovrl_save.f90 | 8 ++++++-- base/comm/internals/psi_dovrl_save_a.f90 | 8 ++++++-- base/comm/internals/psi_dovrl_upd.f90 | 8 ++++++-- base/comm/internals/psi_dovrl_upd_a.f90 | 8 ++++++-- base/comm/internals/psi_eovrl_restr_a.f90 | 8 ++++++-- base/comm/internals/psi_eovrl_save_a.f90 | 8 ++++++-- base/comm/internals/psi_eovrl_upd_a.f90 | 8 ++++++-- base/comm/internals/psi_iovrl_restr.f90 | 8 ++++++-- base/comm/internals/psi_iovrl_save.f90 | 8 ++++++-- base/comm/internals/psi_iovrl_upd.f90 | 8 ++++++-- base/comm/internals/psi_lovrl_restr.f90 | 8 ++++++-- base/comm/internals/psi_lovrl_save.f90 | 8 ++++++-- base/comm/internals/psi_lovrl_upd.f90 | 8 ++++++-- base/comm/internals/psi_movrl_restr_a.f90 | 8 ++++++-- base/comm/internals/psi_movrl_save_a.f90 | 8 ++++++-- base/comm/internals/psi_movrl_upd_a.f90 | 8 ++++++-- base/comm/internals/psi_sovrl_restr.f90 | 8 ++++++-- base/comm/internals/psi_sovrl_restr_a.f90 | 8 ++++++-- base/comm/internals/psi_sovrl_save.f90 | 8 ++++++-- base/comm/internals/psi_sovrl_save_a.f90 | 8 ++++++-- base/comm/internals/psi_sovrl_upd.f90 | 8 ++++++-- base/comm/internals/psi_sovrl_upd_a.f90 | 8 ++++++-- base/comm/internals/psi_zovrl_restr.f90 | 8 ++++++-- base/comm/internals/psi_zovrl_restr_a.f90 | 8 ++++++-- base/comm/internals/psi_zovrl_save.f90 | 8 ++++++-- base/comm/internals/psi_zovrl_save_a.f90 | 8 ++++++-- base/comm/internals/psi_zovrl_upd.f90 | 8 ++++++-- base/comm/internals/psi_zovrl_upd_a.f90 | 8 ++++++-- base/comm/psb_cgather.f90 | 8 ++++++-- base/comm/psb_cgather_a.f90 | 8 ++++++-- base/comm/psb_chalo.f90 | 8 ++++++-- base/comm/psb_chalo_a.f90 | 8 ++++++-- base/comm/psb_covrl.f90 | 8 ++++++-- base/comm/psb_covrl_a.f90 | 8 ++++++-- base/comm/psb_cscatter.F90 | 4 +++- base/comm/psb_cscatter_a.F90 | 8 ++++++-- base/comm/psb_cspgather.F90 | 8 ++++++-- base/comm/psb_dgather.f90 | 8 ++++++-- base/comm/psb_dgather_a.f90 | 8 ++++++-- base/comm/psb_dhalo.f90 | 8 ++++++-- base/comm/psb_dhalo_a.f90 | 8 ++++++-- base/comm/psb_dovrl.f90 | 8 ++++++-- base/comm/psb_dovrl_a.f90 | 8 ++++++-- base/comm/psb_dscatter.F90 | 4 +++- base/comm/psb_dscatter_a.F90 | 8 ++++++-- base/comm/psb_dspgather.F90 | 8 ++++++-- base/comm/psb_egather_a.f90 | 8 ++++++-- base/comm/psb_ehalo_a.f90 | 8 ++++++-- base/comm/psb_eovrl_a.f90 | 8 ++++++-- base/comm/psb_escatter_a.F90 | 8 ++++++-- base/comm/psb_igather.f90 | 8 ++++++-- base/comm/psb_ihalo.f90 | 8 ++++++-- base/comm/psb_iovrl.f90 | 8 ++++++-- base/comm/psb_iscatter.F90 | 4 +++- base/comm/psb_ispgather.F90 | 8 ++++++-- base/comm/psb_lgather.f90 | 8 ++++++-- base/comm/psb_lhalo.f90 | 8 ++++++-- base/comm/psb_lovrl.f90 | 8 ++++++-- base/comm/psb_lscatter.F90 | 4 +++- base/comm/psb_lspgather.F90 | 8 ++++++-- base/comm/psb_mgather_a.f90 | 8 ++++++-- base/comm/psb_mhalo_a.f90 | 8 ++++++-- base/comm/psb_movrl_a.f90 | 8 ++++++-- base/comm/psb_mscatter_a.F90 | 8 ++++++-- base/comm/psb_sgather.f90 | 8 ++++++-- base/comm/psb_sgather_a.f90 | 8 ++++++-- base/comm/psb_shalo.f90 | 8 ++++++-- base/comm/psb_shalo_a.f90 | 8 ++++++-- base/comm/psb_sovrl.f90 | 8 ++++++-- base/comm/psb_sovrl_a.f90 | 8 ++++++-- base/comm/psb_sscatter.F90 | 4 +++- base/comm/psb_sscatter_a.F90 | 8 ++++++-- base/comm/psb_sspgather.F90 | 8 ++++++-- base/comm/psb_zgather.f90 | 8 ++++++-- base/comm/psb_zgather_a.f90 | 8 ++++++-- base/comm/psb_zhalo.f90 | 8 ++++++-- base/comm/psb_zhalo_a.f90 | 8 ++++++-- base/comm/psb_zovrl.f90 | 8 ++++++-- base/comm/psb_zovrl_a.f90 | 8 ++++++-- base/comm/psb_zscatter.F90 | 4 +++- base/comm/psb_zscatter_a.F90 | 8 ++++++-- base/comm/psb_zspgather.F90 | 8 ++++++-- base/modules/auxil/psb_c_realloc_mod.F90 | 16 ++++++++-------- base/modules/auxil/psb_d_realloc_mod.F90 | 16 ++++++++-------- base/modules/auxil/psb_e_realloc_mod.F90 | 16 ++++++++-------- base/modules/auxil/psb_m_realloc_mod.F90 | 16 ++++++++-------- base/modules/auxil/psb_s_realloc_mod.F90 | 16 ++++++++-------- base/modules/auxil/psb_z_realloc_mod.F90 | 16 ++++++++-------- base/psblas/psb_camax.f90 | 20 +++++++++++++++----- base/psblas/psb_casum.f90 | 16 ++++++++++++---- base/psblas/psb_caxpby.f90 | 8 ++++++-- base/psblas/psb_cdot.f90 | 20 +++++++++++++++----- base/psblas/psb_cnrm2.f90 | 16 ++++++++++++---- base/psblas/psb_cnrmi.f90 | 4 +++- base/psblas/psb_cspmm.f90 | 12 +++++++++--- base/psblas/psb_cspsm.f90 | 12 +++++++++--- base/psblas/psb_damax.f90 | 20 +++++++++++++++----- base/psblas/psb_dasum.f90 | 16 ++++++++++++---- base/psblas/psb_daxpby.f90 | 8 ++++++-- base/psblas/psb_ddot.f90 | 20 +++++++++++++++----- base/psblas/psb_dnrm2.f90 | 16 ++++++++++++---- base/psblas/psb_dnrmi.f90 | 4 +++- base/psblas/psb_dspmm.f90 | 12 +++++++++--- base/psblas/psb_dspsm.f90 | 12 +++++++++--- base/psblas/psb_samax.f90 | 20 +++++++++++++++----- base/psblas/psb_sasum.f90 | 16 ++++++++++++---- base/psblas/psb_saxpby.f90 | 8 ++++++-- base/psblas/psb_sdot.f90 | 20 +++++++++++++++----- base/psblas/psb_snrm2.f90 | 16 ++++++++++++---- base/psblas/psb_snrmi.f90 | 4 +++- base/psblas/psb_sspmm.f90 | 12 +++++++++--- base/psblas/psb_sspsm.f90 | 12 +++++++++--- base/psblas/psb_zamax.f90 | 20 +++++++++++++++----- base/psblas/psb_zasum.f90 | 16 ++++++++++++---- base/psblas/psb_zaxpby.f90 | 8 ++++++-- base/psblas/psb_zdot.f90 | 20 +++++++++++++++----- base/psblas/psb_znrm2.f90 | 16 ++++++++++++---- base/psblas/psb_znrmi.f90 | 4 +++- base/psblas/psb_zspmm.f90 | 12 +++++++++--- base/psblas/psb_zspsm.f90 | 12 +++++++++--- base/serial/psi_c_serial_impl.f90 | 8 ++++++-- base/serial/psi_d_serial_impl.f90 | 8 ++++++-- base/serial/psi_e_serial_impl.f90 | 8 ++++++-- base/serial/psi_m_serial_impl.f90 | 8 ++++++-- base/serial/psi_s_serial_impl.f90 | 8 ++++++-- base/serial/psi_z_serial_impl.f90 | 8 ++++++-- base/tools/psb_callc_a.f90 | 8 ++++++-- base/tools/psb_casb_a.f90 | 8 +++++++- base/tools/psb_cfree_a.f90 | 16 +++++++++------- base/tools/psb_cins_a.f90 | 12 ++++++++---- base/tools/psb_cspalloc.f90 | 4 +++- base/tools/psb_cspfree.f90 | 4 +++- base/tools/psb_csphalo.F90 | 4 +++- base/tools/psb_dallc_a.f90 | 8 ++++++-- base/tools/psb_dasb_a.f90 | 8 +++++++- base/tools/psb_dfree_a.f90 | 16 +++++++++------- base/tools/psb_dins_a.f90 | 12 ++++++++---- base/tools/psb_dspalloc.f90 | 4 +++- base/tools/psb_dspfree.f90 | 4 +++- base/tools/psb_dsphalo.F90 | 4 +++- base/tools/psb_eallc_a.f90 | 8 ++++++-- base/tools/psb_easb_a.f90 | 8 +++++++- base/tools/psb_efree_a.f90 | 16 +++++++++------- base/tools/psb_eins_a.f90 | 12 ++++++++---- base/tools/psb_mallc_a.f90 | 8 ++++++-- base/tools/psb_masb_a.f90 | 8 +++++++- base/tools/psb_mfree_a.f90 | 16 +++++++++------- base/tools/psb_mins_a.f90 | 12 ++++++++---- base/tools/psb_sallc_a.f90 | 8 ++++++-- base/tools/psb_sasb_a.f90 | 8 +++++++- base/tools/psb_sfree_a.f90 | 16 +++++++++------- base/tools/psb_sins_a.f90 | 12 ++++++++---- base/tools/psb_sspalloc.f90 | 4 +++- base/tools/psb_sspfree.f90 | 4 +++- base/tools/psb_ssphalo.F90 | 4 +++- base/tools/psb_zallc_a.f90 | 8 ++++++-- base/tools/psb_zasb_a.f90 | 8 +++++++- base/tools/psb_zfree_a.f90 | 16 +++++++++------- base/tools/psb_zins_a.f90 | 12 ++++++++---- base/tools/psb_zspalloc.f90 | 4 +++- base/tools/psb_zspfree.f90 | 4 +++- base/tools/psb_zsphalo.F90 | 4 +++- prec/impl/psb_c_bjacprec_impl.f90 | 4 +++- prec/impl/psb_cprecbld.f90 | 6 ++++-- prec/impl/psb_d_bjacprec_impl.f90 | 4 +++- prec/impl/psb_dprecbld.f90 | 6 ++++-- prec/impl/psb_s_bjacprec_impl.f90 | 4 +++- prec/impl/psb_sprecbld.f90 | 6 ++++-- prec/impl/psb_z_bjacprec_impl.f90 | 4 +++- prec/impl/psb_zprecbld.f90 | 6 ++++-- prec/psb_c_base_prec_mod.f90 | 2 +- prec/psb_c_prec_type.f90 | 8 ++++++-- prec/psb_d_base_prec_mod.f90 | 2 +- prec/psb_d_prec_type.f90 | 8 ++++++-- prec/psb_s_base_prec_mod.f90 | 2 +- prec/psb_s_prec_type.f90 | 8 ++++++-- prec/psb_z_base_prec_mod.f90 | 2 +- prec/psb_z_prec_type.f90 | 8 ++++++-- test/fileread/psb_cf_sample.f90 | 2 +- test/fileread/psb_df_sample.f90 | 2 +- test/fileread/psb_sf_sample.f90 | 2 +- test/fileread/psb_zf_sample.f90 | 2 +- test/pargen/psb_d_pde2d.f90 | 2 +- test/pargen/psb_d_pde3d.f90 | 2 +- test/pargen/psb_s_pde2d.f90 | 2 +- test/pargen/psb_s_pde3d.f90 | 2 +- 194 files changed, 1210 insertions(+), 470 deletions(-) diff --git a/base/comm/internals/psi_covrl_restr.f90 b/base/comm/internals/psi_covrl_restr.f90 index 6b627ba2a..98ecdd8be 100644 --- a/base/comm/internals/psi_covrl_restr.f90 +++ b/base/comm/internals/psi_covrl_restr.f90 @@ -46,9 +46,11 @@ subroutine psi_covrl_restr_vect(x,xs,desc_a,info) character(len=20) :: name, ch_err name='psi_covrl_restr_vect' - if (psb_get_errstatus() /= 0) return info = psb_success_ call psb_erractionsave(err_act) + if (psb_errstatus_fatal()) then + info = psb_err_internal_error_ ; goto 9999 + end if ictxt = desc_a%get_context() call psb_info(ictxt, me, np) if (np == -1) then @@ -86,9 +88,11 @@ subroutine psi_covrl_restr_multivect(x,xs,desc_a,info) character(len=20) :: name, ch_err name='psi_covrl_restr_mv' - if (psb_get_errstatus() /= 0) return info = psb_success_ call psb_erractionsave(err_act) + if (psb_errstatus_fatal()) then + info = psb_err_internal_error_ ; goto 9999 + end if ictxt = desc_a%get_context() call psb_info(ictxt, me, np) if (np == -1) then diff --git a/base/comm/internals/psi_covrl_restr_a.f90 b/base/comm/internals/psi_covrl_restr_a.f90 index e08df7564..46eb05636 100644 --- a/base/comm/internals/psi_covrl_restr_a.f90 +++ b/base/comm/internals/psi_covrl_restr_a.f90 @@ -44,9 +44,11 @@ subroutine psi_covrl_restrr1(x,xs,desc_a,info) character(len=20) :: name, ch_err name='psi_covrl_restrr1' - if (psb_get_errstatus() /= 0) return info = psb_success_ call psb_erractionsave(err_act) + if (psb_errstatus_fatal()) then + info = psb_err_internal_error_ ; goto 9999 + end if ictxt = desc_a%get_context() call psb_info(ictxt, me, np) if (np == -1) then @@ -85,9 +87,11 @@ subroutine psi_covrl_restrr2(x,xs,desc_a,info) character(len=20) :: name, ch_err name='psi_covrl_restrr2' - if (psb_get_errstatus() /= 0) return info = psb_success_ call psb_erractionsave(err_act) + if (psb_errstatus_fatal()) then + info = psb_err_internal_error_ ; goto 9999 + end if ictxt = desc_a%get_context() call psb_info(ictxt, me, np) if (np == -1) then diff --git a/base/comm/internals/psi_covrl_save.f90 b/base/comm/internals/psi_covrl_save.f90 index af52ab6e0..41e659437 100644 --- a/base/comm/internals/psi_covrl_save.f90 +++ b/base/comm/internals/psi_covrl_save.f90 @@ -46,9 +46,11 @@ subroutine psi_covrl_save_vect(x,xs,desc_a,info) character(len=20) :: name, ch_err name='psi_dovrl_saver1' - if (psb_get_errstatus() /= 0) return info = psb_success_ call psb_erractionsave(err_act) + if (psb_errstatus_fatal()) then + info = psb_err_internal_error_ ; goto 9999 + end if ictxt = desc_a%get_context() call psb_info(ictxt, me, np) if (np == -1) then @@ -94,9 +96,11 @@ subroutine psi_covrl_save_multivect(x,xs,desc_a,info) character(len=20) :: name, ch_err name='psi_dovrl_saver1' - if (psb_get_errstatus() /= 0) return info = psb_success_ call psb_erractionsave(err_act) + if (psb_errstatus_fatal()) then + info = psb_err_internal_error_ ; goto 9999 + end if ictxt = desc_a%get_context() call psb_info(ictxt, me, np) if (np == -1) then diff --git a/base/comm/internals/psi_covrl_save_a.f90 b/base/comm/internals/psi_covrl_save_a.f90 index a560a6fd9..d853db8df 100644 --- a/base/comm/internals/psi_covrl_save_a.f90 +++ b/base/comm/internals/psi_covrl_save_a.f90 @@ -47,9 +47,11 @@ subroutine psi_covrl_saver1(x,xs,desc_a,info) character(len=20) :: name, ch_err name='psi_covrl_saver1' - if (psb_get_errstatus() /= 0) return info = psb_success_ call psb_erractionsave(err_act) + if (psb_errstatus_fatal()) then + info = psb_err_internal_error_ ; goto 9999 + end if ictxt = desc_a%get_context() call psb_info(ictxt, me, np) if (np == -1) then @@ -97,9 +99,11 @@ subroutine psi_covrl_saver2(x,xs,desc_a,info) character(len=20) :: name, ch_err name='psi_covrl_saver2' - if (psb_get_errstatus() /= 0) return info = psb_success_ call psb_erractionsave(err_act) + if (psb_errstatus_fatal()) then + info = psb_err_internal_error_ ; goto 9999 + end if ictxt = desc_a%get_context() call psb_info(ictxt, me, np) if (np == -1) then diff --git a/base/comm/internals/psi_covrl_upd.f90 b/base/comm/internals/psi_covrl_upd.f90 index 0da0cba2a..f99cbb664 100644 --- a/base/comm/internals/psi_covrl_upd.f90 +++ b/base/comm/internals/psi_covrl_upd.f90 @@ -50,9 +50,11 @@ subroutine psi_covrl_upd_vect(x,desc_a,update,info) name='psi_covrl_updr1' - if (psb_get_errstatus() /= 0) return info = psb_success_ call psb_erractionsave(err_act) + if (psb_errstatus_fatal()) then + info = psb_err_internal_error_ ; goto 9999 + end if ictxt = desc_a%get_context() call psb_info(ictxt, me, np) if (np == -1) then @@ -129,9 +131,11 @@ subroutine psi_covrl_upd_multivect(x,desc_a,update,info) name='psi_covrl_updr1' - if (psb_get_errstatus() /= 0) return info = psb_success_ call psb_erractionsave(err_act) + if (psb_errstatus_fatal()) then + info = psb_err_internal_error_ ; goto 9999 + end if ictxt = desc_a%get_context() call psb_info(ictxt, me, np) if (np == -1) then diff --git a/base/comm/internals/psi_covrl_upd_a.f90 b/base/comm/internals/psi_covrl_upd_a.f90 index b253ab731..633747e56 100644 --- a/base/comm/internals/psi_covrl_upd_a.f90 +++ b/base/comm/internals/psi_covrl_upd_a.f90 @@ -45,9 +45,11 @@ subroutine psi_covrl_updr1(x,desc_a,update,info) character(len=20) :: name, ch_err name='psi_covrl_updr1' - if (psb_get_errstatus() /= 0) return info = psb_success_ call psb_erractionsave(err_act) + if (psb_errstatus_fatal()) then + info = psb_err_internal_error_ ; goto 9999 + end if ictxt = desc_a%get_context() call psb_info(ictxt, me, np) if (np == -1) then @@ -112,9 +114,11 @@ subroutine psi_covrl_updr2(x,desc_a,update,info) character(len=20) :: name, ch_err name='psi_covrl_updr2' - if (psb_get_errstatus() /= 0) return info = psb_success_ call psb_erractionsave(err_act) + if (psb_errstatus_fatal()) then + info = psb_err_internal_error_ ; goto 9999 + end if ictxt = desc_a%get_context() call psb_info(ictxt, me, np) if (np == -1) then diff --git a/base/comm/internals/psi_dovrl_restr.f90 b/base/comm/internals/psi_dovrl_restr.f90 index 70a43345c..326f32df0 100644 --- a/base/comm/internals/psi_dovrl_restr.f90 +++ b/base/comm/internals/psi_dovrl_restr.f90 @@ -46,9 +46,11 @@ subroutine psi_dovrl_restr_vect(x,xs,desc_a,info) character(len=20) :: name, ch_err name='psi_dovrl_restr_vect' - if (psb_get_errstatus() /= 0) return info = psb_success_ call psb_erractionsave(err_act) + if (psb_errstatus_fatal()) then + info = psb_err_internal_error_ ; goto 9999 + end if ictxt = desc_a%get_context() call psb_info(ictxt, me, np) if (np == -1) then @@ -86,9 +88,11 @@ subroutine psi_dovrl_restr_multivect(x,xs,desc_a,info) character(len=20) :: name, ch_err name='psi_dovrl_restr_mv' - if (psb_get_errstatus() /= 0) return info = psb_success_ call psb_erractionsave(err_act) + if (psb_errstatus_fatal()) then + info = psb_err_internal_error_ ; goto 9999 + end if ictxt = desc_a%get_context() call psb_info(ictxt, me, np) if (np == -1) then diff --git a/base/comm/internals/psi_dovrl_restr_a.f90 b/base/comm/internals/psi_dovrl_restr_a.f90 index e259bd643..2d83c416d 100644 --- a/base/comm/internals/psi_dovrl_restr_a.f90 +++ b/base/comm/internals/psi_dovrl_restr_a.f90 @@ -44,9 +44,11 @@ subroutine psi_dovrl_restrr1(x,xs,desc_a,info) character(len=20) :: name, ch_err name='psi_dovrl_restrr1' - if (psb_get_errstatus() /= 0) return info = psb_success_ call psb_erractionsave(err_act) + if (psb_errstatus_fatal()) then + info = psb_err_internal_error_ ; goto 9999 + end if ictxt = desc_a%get_context() call psb_info(ictxt, me, np) if (np == -1) then @@ -85,9 +87,11 @@ subroutine psi_dovrl_restrr2(x,xs,desc_a,info) character(len=20) :: name, ch_err name='psi_dovrl_restrr2' - if (psb_get_errstatus() /= 0) return info = psb_success_ call psb_erractionsave(err_act) + if (psb_errstatus_fatal()) then + info = psb_err_internal_error_ ; goto 9999 + end if ictxt = desc_a%get_context() call psb_info(ictxt, me, np) if (np == -1) then diff --git a/base/comm/internals/psi_dovrl_save.f90 b/base/comm/internals/psi_dovrl_save.f90 index aca871779..3f8a923b3 100644 --- a/base/comm/internals/psi_dovrl_save.f90 +++ b/base/comm/internals/psi_dovrl_save.f90 @@ -46,9 +46,11 @@ subroutine psi_dovrl_save_vect(x,xs,desc_a,info) character(len=20) :: name, ch_err name='psi_dovrl_saver1' - if (psb_get_errstatus() /= 0) return info = psb_success_ call psb_erractionsave(err_act) + if (psb_errstatus_fatal()) then + info = psb_err_internal_error_ ; goto 9999 + end if ictxt = desc_a%get_context() call psb_info(ictxt, me, np) if (np == -1) then @@ -94,9 +96,11 @@ subroutine psi_dovrl_save_multivect(x,xs,desc_a,info) character(len=20) :: name, ch_err name='psi_dovrl_saver1' - if (psb_get_errstatus() /= 0) return info = psb_success_ call psb_erractionsave(err_act) + if (psb_errstatus_fatal()) then + info = psb_err_internal_error_ ; goto 9999 + end if ictxt = desc_a%get_context() call psb_info(ictxt, me, np) if (np == -1) then diff --git a/base/comm/internals/psi_dovrl_save_a.f90 b/base/comm/internals/psi_dovrl_save_a.f90 index e8ab9c89b..6bf57d87d 100644 --- a/base/comm/internals/psi_dovrl_save_a.f90 +++ b/base/comm/internals/psi_dovrl_save_a.f90 @@ -47,9 +47,11 @@ subroutine psi_dovrl_saver1(x,xs,desc_a,info) character(len=20) :: name, ch_err name='psi_dovrl_saver1' - if (psb_get_errstatus() /= 0) return info = psb_success_ call psb_erractionsave(err_act) + if (psb_errstatus_fatal()) then + info = psb_err_internal_error_ ; goto 9999 + end if ictxt = desc_a%get_context() call psb_info(ictxt, me, np) if (np == -1) then @@ -97,9 +99,11 @@ subroutine psi_dovrl_saver2(x,xs,desc_a,info) character(len=20) :: name, ch_err name='psi_dovrl_saver2' - if (psb_get_errstatus() /= 0) return info = psb_success_ call psb_erractionsave(err_act) + if (psb_errstatus_fatal()) then + info = psb_err_internal_error_ ; goto 9999 + end if ictxt = desc_a%get_context() call psb_info(ictxt, me, np) if (np == -1) then diff --git a/base/comm/internals/psi_dovrl_upd.f90 b/base/comm/internals/psi_dovrl_upd.f90 index e154c2f93..867281ff5 100644 --- a/base/comm/internals/psi_dovrl_upd.f90 +++ b/base/comm/internals/psi_dovrl_upd.f90 @@ -50,9 +50,11 @@ subroutine psi_dovrl_upd_vect(x,desc_a,update,info) name='psi_dovrl_updr1' - if (psb_get_errstatus() /= 0) return info = psb_success_ call psb_erractionsave(err_act) + if (psb_errstatus_fatal()) then + info = psb_err_internal_error_ ; goto 9999 + end if ictxt = desc_a%get_context() call psb_info(ictxt, me, np) if (np == -1) then @@ -129,9 +131,11 @@ subroutine psi_dovrl_upd_multivect(x,desc_a,update,info) name='psi_dovrl_updr1' - if (psb_get_errstatus() /= 0) return info = psb_success_ call psb_erractionsave(err_act) + if (psb_errstatus_fatal()) then + info = psb_err_internal_error_ ; goto 9999 + end if ictxt = desc_a%get_context() call psb_info(ictxt, me, np) if (np == -1) then diff --git a/base/comm/internals/psi_dovrl_upd_a.f90 b/base/comm/internals/psi_dovrl_upd_a.f90 index 00182d4e9..ccdfba895 100644 --- a/base/comm/internals/psi_dovrl_upd_a.f90 +++ b/base/comm/internals/psi_dovrl_upd_a.f90 @@ -45,9 +45,11 @@ subroutine psi_dovrl_updr1(x,desc_a,update,info) character(len=20) :: name, ch_err name='psi_dovrl_updr1' - if (psb_get_errstatus() /= 0) return info = psb_success_ call psb_erractionsave(err_act) + if (psb_errstatus_fatal()) then + info = psb_err_internal_error_ ; goto 9999 + end if ictxt = desc_a%get_context() call psb_info(ictxt, me, np) if (np == -1) then @@ -112,9 +114,11 @@ subroutine psi_dovrl_updr2(x,desc_a,update,info) character(len=20) :: name, ch_err name='psi_dovrl_updr2' - if (psb_get_errstatus() /= 0) return info = psb_success_ call psb_erractionsave(err_act) + if (psb_errstatus_fatal()) then + info = psb_err_internal_error_ ; goto 9999 + end if ictxt = desc_a%get_context() call psb_info(ictxt, me, np) if (np == -1) then diff --git a/base/comm/internals/psi_eovrl_restr_a.f90 b/base/comm/internals/psi_eovrl_restr_a.f90 index fd4afb335..fe981855c 100644 --- a/base/comm/internals/psi_eovrl_restr_a.f90 +++ b/base/comm/internals/psi_eovrl_restr_a.f90 @@ -44,9 +44,11 @@ subroutine psi_eovrl_restrr1(x,xs,desc_a,info) character(len=20) :: name, ch_err name='psi_eovrl_restrr1' - if (psb_get_errstatus() /= 0) return info = psb_success_ call psb_erractionsave(err_act) + if (psb_errstatus_fatal()) then + info = psb_err_internal_error_ ; goto 9999 + end if ictxt = desc_a%get_context() call psb_info(ictxt, me, np) if (np == -1) then @@ -85,9 +87,11 @@ subroutine psi_eovrl_restrr2(x,xs,desc_a,info) character(len=20) :: name, ch_err name='psi_eovrl_restrr2' - if (psb_get_errstatus() /= 0) return info = psb_success_ call psb_erractionsave(err_act) + if (psb_errstatus_fatal()) then + info = psb_err_internal_error_ ; goto 9999 + end if ictxt = desc_a%get_context() call psb_info(ictxt, me, np) if (np == -1) then diff --git a/base/comm/internals/psi_eovrl_save_a.f90 b/base/comm/internals/psi_eovrl_save_a.f90 index cea249558..de6878f09 100644 --- a/base/comm/internals/psi_eovrl_save_a.f90 +++ b/base/comm/internals/psi_eovrl_save_a.f90 @@ -47,9 +47,11 @@ subroutine psi_eovrl_saver1(x,xs,desc_a,info) character(len=20) :: name, ch_err name='psi_eovrl_saver1' - if (psb_get_errstatus() /= 0) return info = psb_success_ call psb_erractionsave(err_act) + if (psb_errstatus_fatal()) then + info = psb_err_internal_error_ ; goto 9999 + end if ictxt = desc_a%get_context() call psb_info(ictxt, me, np) if (np == -1) then @@ -97,9 +99,11 @@ subroutine psi_eovrl_saver2(x,xs,desc_a,info) character(len=20) :: name, ch_err name='psi_eovrl_saver2' - if (psb_get_errstatus() /= 0) return info = psb_success_ call psb_erractionsave(err_act) + if (psb_errstatus_fatal()) then + info = psb_err_internal_error_ ; goto 9999 + end if ictxt = desc_a%get_context() call psb_info(ictxt, me, np) if (np == -1) then diff --git a/base/comm/internals/psi_eovrl_upd_a.f90 b/base/comm/internals/psi_eovrl_upd_a.f90 index 74ed4d30b..f8589e413 100644 --- a/base/comm/internals/psi_eovrl_upd_a.f90 +++ b/base/comm/internals/psi_eovrl_upd_a.f90 @@ -45,9 +45,11 @@ subroutine psi_eovrl_updr1(x,desc_a,update,info) character(len=20) :: name, ch_err name='psi_eovrl_updr1' - if (psb_get_errstatus() /= 0) return info = psb_success_ call psb_erractionsave(err_act) + if (psb_errstatus_fatal()) then + info = psb_err_internal_error_ ; goto 9999 + end if ictxt = desc_a%get_context() call psb_info(ictxt, me, np) if (np == -1) then @@ -112,9 +114,11 @@ subroutine psi_eovrl_updr2(x,desc_a,update,info) character(len=20) :: name, ch_err name='psi_eovrl_updr2' - if (psb_get_errstatus() /= 0) return info = psb_success_ call psb_erractionsave(err_act) + if (psb_errstatus_fatal()) then + info = psb_err_internal_error_ ; goto 9999 + end if ictxt = desc_a%get_context() call psb_info(ictxt, me, np) if (np == -1) then diff --git a/base/comm/internals/psi_iovrl_restr.f90 b/base/comm/internals/psi_iovrl_restr.f90 index 276f6f3a7..89ff5ee08 100644 --- a/base/comm/internals/psi_iovrl_restr.f90 +++ b/base/comm/internals/psi_iovrl_restr.f90 @@ -46,9 +46,11 @@ subroutine psi_iovrl_restr_vect(x,xs,desc_a,info) character(len=20) :: name, ch_err name='psi_iovrl_restr_vect' - if (psb_get_errstatus() /= 0) return info = psb_success_ call psb_erractionsave(err_act) + if (psb_errstatus_fatal()) then + info = psb_err_internal_error_ ; goto 9999 + end if ictxt = desc_a%get_context() call psb_info(ictxt, me, np) if (np == -1) then @@ -86,9 +88,11 @@ subroutine psi_iovrl_restr_multivect(x,xs,desc_a,info) character(len=20) :: name, ch_err name='psi_iovrl_restr_mv' - if (psb_get_errstatus() /= 0) return info = psb_success_ call psb_erractionsave(err_act) + if (psb_errstatus_fatal()) then + info = psb_err_internal_error_ ; goto 9999 + end if ictxt = desc_a%get_context() call psb_info(ictxt, me, np) if (np == -1) then diff --git a/base/comm/internals/psi_iovrl_save.f90 b/base/comm/internals/psi_iovrl_save.f90 index 6d8d66ff4..b48a7dbcf 100644 --- a/base/comm/internals/psi_iovrl_save.f90 +++ b/base/comm/internals/psi_iovrl_save.f90 @@ -46,9 +46,11 @@ subroutine psi_iovrl_save_vect(x,xs,desc_a,info) character(len=20) :: name, ch_err name='psi_dovrl_saver1' - if (psb_get_errstatus() /= 0) return info = psb_success_ call psb_erractionsave(err_act) + if (psb_errstatus_fatal()) then + info = psb_err_internal_error_ ; goto 9999 + end if ictxt = desc_a%get_context() call psb_info(ictxt, me, np) if (np == -1) then @@ -94,9 +96,11 @@ subroutine psi_iovrl_save_multivect(x,xs,desc_a,info) character(len=20) :: name, ch_err name='psi_dovrl_saver1' - if (psb_get_errstatus() /= 0) return info = psb_success_ call psb_erractionsave(err_act) + if (psb_errstatus_fatal()) then + info = psb_err_internal_error_ ; goto 9999 + end if ictxt = desc_a%get_context() call psb_info(ictxt, me, np) if (np == -1) then diff --git a/base/comm/internals/psi_iovrl_upd.f90 b/base/comm/internals/psi_iovrl_upd.f90 index 0b7af82bd..a84a1cc08 100644 --- a/base/comm/internals/psi_iovrl_upd.f90 +++ b/base/comm/internals/psi_iovrl_upd.f90 @@ -50,9 +50,11 @@ subroutine psi_iovrl_upd_vect(x,desc_a,update,info) name='psi_iovrl_updr1' - if (psb_get_errstatus() /= 0) return info = psb_success_ call psb_erractionsave(err_act) + if (psb_errstatus_fatal()) then + info = psb_err_internal_error_ ; goto 9999 + end if ictxt = desc_a%get_context() call psb_info(ictxt, me, np) if (np == -1) then @@ -129,9 +131,11 @@ subroutine psi_iovrl_upd_multivect(x,desc_a,update,info) name='psi_iovrl_updr1' - if (psb_get_errstatus() /= 0) return info = psb_success_ call psb_erractionsave(err_act) + if (psb_errstatus_fatal()) then + info = psb_err_internal_error_ ; goto 9999 + end if ictxt = desc_a%get_context() call psb_info(ictxt, me, np) if (np == -1) then diff --git a/base/comm/internals/psi_lovrl_restr.f90 b/base/comm/internals/psi_lovrl_restr.f90 index dad555dd1..ba96e9c0b 100644 --- a/base/comm/internals/psi_lovrl_restr.f90 +++ b/base/comm/internals/psi_lovrl_restr.f90 @@ -46,9 +46,11 @@ subroutine psi_lovrl_restr_vect(x,xs,desc_a,info) character(len=20) :: name, ch_err name='psi_lovrl_restr_vect' - if (psb_get_errstatus() /= 0) return info = psb_success_ call psb_erractionsave(err_act) + if (psb_errstatus_fatal()) then + info = psb_err_internal_error_ ; goto 9999 + end if ictxt = desc_a%get_context() call psb_info(ictxt, me, np) if (np == -1) then @@ -86,9 +88,11 @@ subroutine psi_lovrl_restr_multivect(x,xs,desc_a,info) character(len=20) :: name, ch_err name='psi_lovrl_restr_mv' - if (psb_get_errstatus() /= 0) return info = psb_success_ call psb_erractionsave(err_act) + if (psb_errstatus_fatal()) then + info = psb_err_internal_error_ ; goto 9999 + end if ictxt = desc_a%get_context() call psb_info(ictxt, me, np) if (np == -1) then diff --git a/base/comm/internals/psi_lovrl_save.f90 b/base/comm/internals/psi_lovrl_save.f90 index 2bce8a1fa..5a06c6973 100644 --- a/base/comm/internals/psi_lovrl_save.f90 +++ b/base/comm/internals/psi_lovrl_save.f90 @@ -46,9 +46,11 @@ subroutine psi_lovrl_save_vect(x,xs,desc_a,info) character(len=20) :: name, ch_err name='psi_dovrl_saver1' - if (psb_get_errstatus() /= 0) return info = psb_success_ call psb_erractionsave(err_act) + if (psb_errstatus_fatal()) then + info = psb_err_internal_error_ ; goto 9999 + end if ictxt = desc_a%get_context() call psb_info(ictxt, me, np) if (np == -1) then @@ -94,9 +96,11 @@ subroutine psi_lovrl_save_multivect(x,xs,desc_a,info) character(len=20) :: name, ch_err name='psi_dovrl_saver1' - if (psb_get_errstatus() /= 0) return info = psb_success_ call psb_erractionsave(err_act) + if (psb_errstatus_fatal()) then + info = psb_err_internal_error_ ; goto 9999 + end if ictxt = desc_a%get_context() call psb_info(ictxt, me, np) if (np == -1) then diff --git a/base/comm/internals/psi_lovrl_upd.f90 b/base/comm/internals/psi_lovrl_upd.f90 index 65991e309..4364ac6f9 100644 --- a/base/comm/internals/psi_lovrl_upd.f90 +++ b/base/comm/internals/psi_lovrl_upd.f90 @@ -50,9 +50,11 @@ subroutine psi_lovrl_upd_vect(x,desc_a,update,info) name='psi_lovrl_updr1' - if (psb_get_errstatus() /= 0) return info = psb_success_ call psb_erractionsave(err_act) + if (psb_errstatus_fatal()) then + info = psb_err_internal_error_ ; goto 9999 + end if ictxt = desc_a%get_context() call psb_info(ictxt, me, np) if (np == -1) then @@ -129,9 +131,11 @@ subroutine psi_lovrl_upd_multivect(x,desc_a,update,info) name='psi_lovrl_updr1' - if (psb_get_errstatus() /= 0) return info = psb_success_ call psb_erractionsave(err_act) + if (psb_errstatus_fatal()) then + info = psb_err_internal_error_ ; goto 9999 + end if ictxt = desc_a%get_context() call psb_info(ictxt, me, np) if (np == -1) then diff --git a/base/comm/internals/psi_movrl_restr_a.f90 b/base/comm/internals/psi_movrl_restr_a.f90 index a3aa35019..a5759f98a 100644 --- a/base/comm/internals/psi_movrl_restr_a.f90 +++ b/base/comm/internals/psi_movrl_restr_a.f90 @@ -44,9 +44,11 @@ subroutine psi_movrl_restrr1(x,xs,desc_a,info) character(len=20) :: name, ch_err name='psi_movrl_restrr1' - if (psb_get_errstatus() /= 0) return info = psb_success_ call psb_erractionsave(err_act) + if (psb_errstatus_fatal()) then + info = psb_err_internal_error_ ; goto 9999 + end if ictxt = desc_a%get_context() call psb_info(ictxt, me, np) if (np == -1) then @@ -85,9 +87,11 @@ subroutine psi_movrl_restrr2(x,xs,desc_a,info) character(len=20) :: name, ch_err name='psi_movrl_restrr2' - if (psb_get_errstatus() /= 0) return info = psb_success_ call psb_erractionsave(err_act) + if (psb_errstatus_fatal()) then + info = psb_err_internal_error_ ; goto 9999 + end if ictxt = desc_a%get_context() call psb_info(ictxt, me, np) if (np == -1) then diff --git a/base/comm/internals/psi_movrl_save_a.f90 b/base/comm/internals/psi_movrl_save_a.f90 index 430a4981a..7935333fa 100644 --- a/base/comm/internals/psi_movrl_save_a.f90 +++ b/base/comm/internals/psi_movrl_save_a.f90 @@ -47,9 +47,11 @@ subroutine psi_movrl_saver1(x,xs,desc_a,info) character(len=20) :: name, ch_err name='psi_movrl_saver1' - if (psb_get_errstatus() /= 0) return info = psb_success_ call psb_erractionsave(err_act) + if (psb_errstatus_fatal()) then + info = psb_err_internal_error_ ; goto 9999 + end if ictxt = desc_a%get_context() call psb_info(ictxt, me, np) if (np == -1) then @@ -97,9 +99,11 @@ subroutine psi_movrl_saver2(x,xs,desc_a,info) character(len=20) :: name, ch_err name='psi_movrl_saver2' - if (psb_get_errstatus() /= 0) return info = psb_success_ call psb_erractionsave(err_act) + if (psb_errstatus_fatal()) then + info = psb_err_internal_error_ ; goto 9999 + end if ictxt = desc_a%get_context() call psb_info(ictxt, me, np) if (np == -1) then diff --git a/base/comm/internals/psi_movrl_upd_a.f90 b/base/comm/internals/psi_movrl_upd_a.f90 index 6223dca64..92bfccce3 100644 --- a/base/comm/internals/psi_movrl_upd_a.f90 +++ b/base/comm/internals/psi_movrl_upd_a.f90 @@ -45,9 +45,11 @@ subroutine psi_movrl_updr1(x,desc_a,update,info) character(len=20) :: name, ch_err name='psi_movrl_updr1' - if (psb_get_errstatus() /= 0) return info = psb_success_ call psb_erractionsave(err_act) + if (psb_errstatus_fatal()) then + info = psb_err_internal_error_ ; goto 9999 + end if ictxt = desc_a%get_context() call psb_info(ictxt, me, np) if (np == -1) then @@ -112,9 +114,11 @@ subroutine psi_movrl_updr2(x,desc_a,update,info) character(len=20) :: name, ch_err name='psi_movrl_updr2' - if (psb_get_errstatus() /= 0) return info = psb_success_ call psb_erractionsave(err_act) + if (psb_errstatus_fatal()) then + info = psb_err_internal_error_ ; goto 9999 + end if ictxt = desc_a%get_context() call psb_info(ictxt, me, np) if (np == -1) then diff --git a/base/comm/internals/psi_sovrl_restr.f90 b/base/comm/internals/psi_sovrl_restr.f90 index b80eb626c..b74c4335c 100644 --- a/base/comm/internals/psi_sovrl_restr.f90 +++ b/base/comm/internals/psi_sovrl_restr.f90 @@ -46,9 +46,11 @@ subroutine psi_sovrl_restr_vect(x,xs,desc_a,info) character(len=20) :: name, ch_err name='psi_sovrl_restr_vect' - if (psb_get_errstatus() /= 0) return info = psb_success_ call psb_erractionsave(err_act) + if (psb_errstatus_fatal()) then + info = psb_err_internal_error_ ; goto 9999 + end if ictxt = desc_a%get_context() call psb_info(ictxt, me, np) if (np == -1) then @@ -86,9 +88,11 @@ subroutine psi_sovrl_restr_multivect(x,xs,desc_a,info) character(len=20) :: name, ch_err name='psi_sovrl_restr_mv' - if (psb_get_errstatus() /= 0) return info = psb_success_ call psb_erractionsave(err_act) + if (psb_errstatus_fatal()) then + info = psb_err_internal_error_ ; goto 9999 + end if ictxt = desc_a%get_context() call psb_info(ictxt, me, np) if (np == -1) then diff --git a/base/comm/internals/psi_sovrl_restr_a.f90 b/base/comm/internals/psi_sovrl_restr_a.f90 index 349987a46..5ff1a9f71 100644 --- a/base/comm/internals/psi_sovrl_restr_a.f90 +++ b/base/comm/internals/psi_sovrl_restr_a.f90 @@ -44,9 +44,11 @@ subroutine psi_sovrl_restrr1(x,xs,desc_a,info) character(len=20) :: name, ch_err name='psi_sovrl_restrr1' - if (psb_get_errstatus() /= 0) return info = psb_success_ call psb_erractionsave(err_act) + if (psb_errstatus_fatal()) then + info = psb_err_internal_error_ ; goto 9999 + end if ictxt = desc_a%get_context() call psb_info(ictxt, me, np) if (np == -1) then @@ -85,9 +87,11 @@ subroutine psi_sovrl_restrr2(x,xs,desc_a,info) character(len=20) :: name, ch_err name='psi_sovrl_restrr2' - if (psb_get_errstatus() /= 0) return info = psb_success_ call psb_erractionsave(err_act) + if (psb_errstatus_fatal()) then + info = psb_err_internal_error_ ; goto 9999 + end if ictxt = desc_a%get_context() call psb_info(ictxt, me, np) if (np == -1) then diff --git a/base/comm/internals/psi_sovrl_save.f90 b/base/comm/internals/psi_sovrl_save.f90 index 4a07f1209..a10ae2180 100644 --- a/base/comm/internals/psi_sovrl_save.f90 +++ b/base/comm/internals/psi_sovrl_save.f90 @@ -46,9 +46,11 @@ subroutine psi_sovrl_save_vect(x,xs,desc_a,info) character(len=20) :: name, ch_err name='psi_dovrl_saver1' - if (psb_get_errstatus() /= 0) return info = psb_success_ call psb_erractionsave(err_act) + if (psb_errstatus_fatal()) then + info = psb_err_internal_error_ ; goto 9999 + end if ictxt = desc_a%get_context() call psb_info(ictxt, me, np) if (np == -1) then @@ -94,9 +96,11 @@ subroutine psi_sovrl_save_multivect(x,xs,desc_a,info) character(len=20) :: name, ch_err name='psi_dovrl_saver1' - if (psb_get_errstatus() /= 0) return info = psb_success_ call psb_erractionsave(err_act) + if (psb_errstatus_fatal()) then + info = psb_err_internal_error_ ; goto 9999 + end if ictxt = desc_a%get_context() call psb_info(ictxt, me, np) if (np == -1) then diff --git a/base/comm/internals/psi_sovrl_save_a.f90 b/base/comm/internals/psi_sovrl_save_a.f90 index 27c07fd97..5766dede8 100644 --- a/base/comm/internals/psi_sovrl_save_a.f90 +++ b/base/comm/internals/psi_sovrl_save_a.f90 @@ -47,9 +47,11 @@ subroutine psi_sovrl_saver1(x,xs,desc_a,info) character(len=20) :: name, ch_err name='psi_sovrl_saver1' - if (psb_get_errstatus() /= 0) return info = psb_success_ call psb_erractionsave(err_act) + if (psb_errstatus_fatal()) then + info = psb_err_internal_error_ ; goto 9999 + end if ictxt = desc_a%get_context() call psb_info(ictxt, me, np) if (np == -1) then @@ -97,9 +99,11 @@ subroutine psi_sovrl_saver2(x,xs,desc_a,info) character(len=20) :: name, ch_err name='psi_sovrl_saver2' - if (psb_get_errstatus() /= 0) return info = psb_success_ call psb_erractionsave(err_act) + if (psb_errstatus_fatal()) then + info = psb_err_internal_error_ ; goto 9999 + end if ictxt = desc_a%get_context() call psb_info(ictxt, me, np) if (np == -1) then diff --git a/base/comm/internals/psi_sovrl_upd.f90 b/base/comm/internals/psi_sovrl_upd.f90 index 6edaa213b..b95a49ba6 100644 --- a/base/comm/internals/psi_sovrl_upd.f90 +++ b/base/comm/internals/psi_sovrl_upd.f90 @@ -50,9 +50,11 @@ subroutine psi_sovrl_upd_vect(x,desc_a,update,info) name='psi_sovrl_updr1' - if (psb_get_errstatus() /= 0) return info = psb_success_ call psb_erractionsave(err_act) + if (psb_errstatus_fatal()) then + info = psb_err_internal_error_ ; goto 9999 + end if ictxt = desc_a%get_context() call psb_info(ictxt, me, np) if (np == -1) then @@ -129,9 +131,11 @@ subroutine psi_sovrl_upd_multivect(x,desc_a,update,info) name='psi_sovrl_updr1' - if (psb_get_errstatus() /= 0) return info = psb_success_ call psb_erractionsave(err_act) + if (psb_errstatus_fatal()) then + info = psb_err_internal_error_ ; goto 9999 + end if ictxt = desc_a%get_context() call psb_info(ictxt, me, np) if (np == -1) then diff --git a/base/comm/internals/psi_sovrl_upd_a.f90 b/base/comm/internals/psi_sovrl_upd_a.f90 index 583263222..d553b5f7e 100644 --- a/base/comm/internals/psi_sovrl_upd_a.f90 +++ b/base/comm/internals/psi_sovrl_upd_a.f90 @@ -45,9 +45,11 @@ subroutine psi_sovrl_updr1(x,desc_a,update,info) character(len=20) :: name, ch_err name='psi_sovrl_updr1' - if (psb_get_errstatus() /= 0) return info = psb_success_ call psb_erractionsave(err_act) + if (psb_errstatus_fatal()) then + info = psb_err_internal_error_ ; goto 9999 + end if ictxt = desc_a%get_context() call psb_info(ictxt, me, np) if (np == -1) then @@ -112,9 +114,11 @@ subroutine psi_sovrl_updr2(x,desc_a,update,info) character(len=20) :: name, ch_err name='psi_sovrl_updr2' - if (psb_get_errstatus() /= 0) return info = psb_success_ call psb_erractionsave(err_act) + if (psb_errstatus_fatal()) then + info = psb_err_internal_error_ ; goto 9999 + end if ictxt = desc_a%get_context() call psb_info(ictxt, me, np) if (np == -1) then diff --git a/base/comm/internals/psi_zovrl_restr.f90 b/base/comm/internals/psi_zovrl_restr.f90 index 6b21c230f..bd83e6186 100644 --- a/base/comm/internals/psi_zovrl_restr.f90 +++ b/base/comm/internals/psi_zovrl_restr.f90 @@ -46,9 +46,11 @@ subroutine psi_zovrl_restr_vect(x,xs,desc_a,info) character(len=20) :: name, ch_err name='psi_zovrl_restr_vect' - if (psb_get_errstatus() /= 0) return info = psb_success_ call psb_erractionsave(err_act) + if (psb_errstatus_fatal()) then + info = psb_err_internal_error_ ; goto 9999 + end if ictxt = desc_a%get_context() call psb_info(ictxt, me, np) if (np == -1) then @@ -86,9 +88,11 @@ subroutine psi_zovrl_restr_multivect(x,xs,desc_a,info) character(len=20) :: name, ch_err name='psi_zovrl_restr_mv' - if (psb_get_errstatus() /= 0) return info = psb_success_ call psb_erractionsave(err_act) + if (psb_errstatus_fatal()) then + info = psb_err_internal_error_ ; goto 9999 + end if ictxt = desc_a%get_context() call psb_info(ictxt, me, np) if (np == -1) then diff --git a/base/comm/internals/psi_zovrl_restr_a.f90 b/base/comm/internals/psi_zovrl_restr_a.f90 index 15d1f27bb..a0a22a315 100644 --- a/base/comm/internals/psi_zovrl_restr_a.f90 +++ b/base/comm/internals/psi_zovrl_restr_a.f90 @@ -44,9 +44,11 @@ subroutine psi_zovrl_restrr1(x,xs,desc_a,info) character(len=20) :: name, ch_err name='psi_zovrl_restrr1' - if (psb_get_errstatus() /= 0) return info = psb_success_ call psb_erractionsave(err_act) + if (psb_errstatus_fatal()) then + info = psb_err_internal_error_ ; goto 9999 + end if ictxt = desc_a%get_context() call psb_info(ictxt, me, np) if (np == -1) then @@ -85,9 +87,11 @@ subroutine psi_zovrl_restrr2(x,xs,desc_a,info) character(len=20) :: name, ch_err name='psi_zovrl_restrr2' - if (psb_get_errstatus() /= 0) return info = psb_success_ call psb_erractionsave(err_act) + if (psb_errstatus_fatal()) then + info = psb_err_internal_error_ ; goto 9999 + end if ictxt = desc_a%get_context() call psb_info(ictxt, me, np) if (np == -1) then diff --git a/base/comm/internals/psi_zovrl_save.f90 b/base/comm/internals/psi_zovrl_save.f90 index 230a6bd58..162385733 100644 --- a/base/comm/internals/psi_zovrl_save.f90 +++ b/base/comm/internals/psi_zovrl_save.f90 @@ -46,9 +46,11 @@ subroutine psi_zovrl_save_vect(x,xs,desc_a,info) character(len=20) :: name, ch_err name='psi_dovrl_saver1' - if (psb_get_errstatus() /= 0) return info = psb_success_ call psb_erractionsave(err_act) + if (psb_errstatus_fatal()) then + info = psb_err_internal_error_ ; goto 9999 + end if ictxt = desc_a%get_context() call psb_info(ictxt, me, np) if (np == -1) then @@ -94,9 +96,11 @@ subroutine psi_zovrl_save_multivect(x,xs,desc_a,info) character(len=20) :: name, ch_err name='psi_dovrl_saver1' - if (psb_get_errstatus() /= 0) return info = psb_success_ call psb_erractionsave(err_act) + if (psb_errstatus_fatal()) then + info = psb_err_internal_error_ ; goto 9999 + end if ictxt = desc_a%get_context() call psb_info(ictxt, me, np) if (np == -1) then diff --git a/base/comm/internals/psi_zovrl_save_a.f90 b/base/comm/internals/psi_zovrl_save_a.f90 index e8061190c..32d5d2125 100644 --- a/base/comm/internals/psi_zovrl_save_a.f90 +++ b/base/comm/internals/psi_zovrl_save_a.f90 @@ -47,9 +47,11 @@ subroutine psi_zovrl_saver1(x,xs,desc_a,info) character(len=20) :: name, ch_err name='psi_zovrl_saver1' - if (psb_get_errstatus() /= 0) return info = psb_success_ call psb_erractionsave(err_act) + if (psb_errstatus_fatal()) then + info = psb_err_internal_error_ ; goto 9999 + end if ictxt = desc_a%get_context() call psb_info(ictxt, me, np) if (np == -1) then @@ -97,9 +99,11 @@ subroutine psi_zovrl_saver2(x,xs,desc_a,info) character(len=20) :: name, ch_err name='psi_zovrl_saver2' - if (psb_get_errstatus() /= 0) return info = psb_success_ call psb_erractionsave(err_act) + if (psb_errstatus_fatal()) then + info = psb_err_internal_error_ ; goto 9999 + end if ictxt = desc_a%get_context() call psb_info(ictxt, me, np) if (np == -1) then diff --git a/base/comm/internals/psi_zovrl_upd.f90 b/base/comm/internals/psi_zovrl_upd.f90 index b73e99b0b..83fcf702d 100644 --- a/base/comm/internals/psi_zovrl_upd.f90 +++ b/base/comm/internals/psi_zovrl_upd.f90 @@ -50,9 +50,11 @@ subroutine psi_zovrl_upd_vect(x,desc_a,update,info) name='psi_zovrl_updr1' - if (psb_get_errstatus() /= 0) return info = psb_success_ call psb_erractionsave(err_act) + if (psb_errstatus_fatal()) then + info = psb_err_internal_error_ ; goto 9999 + end if ictxt = desc_a%get_context() call psb_info(ictxt, me, np) if (np == -1) then @@ -129,9 +131,11 @@ subroutine psi_zovrl_upd_multivect(x,desc_a,update,info) name='psi_zovrl_updr1' - if (psb_get_errstatus() /= 0) return info = psb_success_ call psb_erractionsave(err_act) + if (psb_errstatus_fatal()) then + info = psb_err_internal_error_ ; goto 9999 + end if ictxt = desc_a%get_context() call psb_info(ictxt, me, np) if (np == -1) then diff --git a/base/comm/internals/psi_zovrl_upd_a.f90 b/base/comm/internals/psi_zovrl_upd_a.f90 index f870847ec..b149addbb 100644 --- a/base/comm/internals/psi_zovrl_upd_a.f90 +++ b/base/comm/internals/psi_zovrl_upd_a.f90 @@ -45,9 +45,11 @@ subroutine psi_zovrl_updr1(x,desc_a,update,info) character(len=20) :: name, ch_err name='psi_zovrl_updr1' - if (psb_get_errstatus() /= 0) return info = psb_success_ call psb_erractionsave(err_act) + if (psb_errstatus_fatal()) then + info = psb_err_internal_error_ ; goto 9999 + end if ictxt = desc_a%get_context() call psb_info(ictxt, me, np) if (np == -1) then @@ -112,9 +114,11 @@ subroutine psi_zovrl_updr2(x,desc_a,update,info) character(len=20) :: name, ch_err name='psi_zovrl_updr2' - if (psb_get_errstatus() /= 0) return info = psb_success_ call psb_erractionsave(err_act) + if (psb_errstatus_fatal()) then + info = psb_err_internal_error_ ; goto 9999 + end if ictxt = desc_a%get_context() call psb_info(ictxt, me, np) if (np == -1) then diff --git a/base/comm/psb_cgather.f90 b/base/comm/psb_cgather.f90 index 6f2f6e902..d4e675c29 100644 --- a/base/comm/psb_cgather.f90 +++ b/base/comm/psb_cgather.f90 @@ -64,9 +64,11 @@ subroutine psb_cgather_vect(globx, locx, desc_a, info, iroot) character(len=20) :: name, ch_err name='psb_cgatherv' - if(psb_get_errstatus() /= 0) return info=psb_success_ call psb_erractionsave(err_act) + if (psb_errstatus_fatal()) then + info = psb_err_internal_error_ ; goto 9999 + end if ictxt=desc_a%get_context() @@ -177,9 +179,11 @@ subroutine psb_cgather_multivect(globx, locx, desc_a, info, iroot) character(len=20) :: name, ch_err name='psb_cgatherv' - if(psb_get_errstatus() /= 0) return info=psb_success_ call psb_erractionsave(err_act) + if (psb_errstatus_fatal()) then + info = psb_err_internal_error_ ; goto 9999 + end if ictxt=desc_a%get_context() diff --git a/base/comm/psb_cgather_a.f90 b/base/comm/psb_cgather_a.f90 index fcfd78eda..09e35678e 100644 --- a/base/comm/psb_cgather_a.f90 +++ b/base/comm/psb_cgather_a.f90 @@ -65,9 +65,11 @@ subroutine psb_cgatherm(globx, locx, desc_a, info, iroot) character(len=20) :: name, ch_err name='psb_cgatherm' - if(psb_get_errstatus() /= 0) return info=psb_success_ call psb_erractionsave(err_act) + if (psb_errstatus_fatal()) then + info = psb_err_internal_error_ ; goto 9999 + end if ictxt=desc_a%get_context() ! check on blacs grid @@ -237,9 +239,11 @@ subroutine psb_cgatherv(globx, locx, desc_a, info, iroot) character(len=20) :: name, ch_err name='psb_cgatherv' - if(psb_get_errstatus() /= 0) return info=psb_success_ call psb_erractionsave(err_act) + if (psb_errstatus_fatal()) then + info = psb_err_internal_error_ ; goto 9999 + end if ictxt=desc_a%get_context() diff --git a/base/comm/psb_chalo.f90 b/base/comm/psb_chalo.f90 index 07827aa7a..6bd6ce3d6 100644 --- a/base/comm/psb_chalo.f90 +++ b/base/comm/psb_chalo.f90 @@ -75,9 +75,11 @@ subroutine psb_chalo_vect(x,desc_a,info,work,tran,mode,data) logical :: aliw name='psb_chalov' - if(psb_get_errstatus() /= 0) return info=psb_success_ call psb_erractionsave(err_act) + if (psb_errstatus_fatal()) then + info = psb_err_internal_error_ ; goto 9999 + end if ictxt=desc_a%get_context() @@ -214,9 +216,11 @@ subroutine psb_chalo_multivect(x,desc_a,info,work,tran,mode,data) logical :: aliw name='psb_chalov' - if(psb_get_errstatus() /= 0) return info=psb_success_ call psb_erractionsave(err_act) + if (psb_errstatus_fatal()) then + info = psb_err_internal_error_ ; goto 9999 + end if ictxt=desc_a%get_context() diff --git a/base/comm/psb_chalo_a.f90 b/base/comm/psb_chalo_a.f90 index 3ccfcd378..5deff1b14 100644 --- a/base/comm/psb_chalo_a.f90 +++ b/base/comm/psb_chalo_a.f90 @@ -75,9 +75,11 @@ subroutine psb_chalom(x,desc_a,info,jx,ik,work,tran,mode,data) logical :: aliw name='psb_chalom' - if(psb_get_errstatus() /= 0) return info=psb_success_ call psb_erractionsave(err_act) + if (psb_errstatus_fatal()) then + info = psb_err_internal_error_ ; goto 9999 + end if ictxt=desc_a%get_context() @@ -282,9 +284,11 @@ subroutine psb_chalov(x,desc_a,info,work,tran,mode,data) logical :: aliw name='psb_chalov' - if(psb_get_errstatus() /= 0) return info=psb_success_ call psb_erractionsave(err_act) + if (psb_errstatus_fatal()) then + info = psb_err_internal_error_ ; goto 9999 + end if ictxt=desc_a%get_context() diff --git a/base/comm/psb_covrl.f90 b/base/comm/psb_covrl.f90 index 7a64ab092..ee59ec4df 100644 --- a/base/comm/psb_covrl.f90 +++ b/base/comm/psb_covrl.f90 @@ -84,9 +84,11 @@ subroutine psb_covrl_vect(x,desc_a,info,work,update,mode) logical :: aliw name='psb_covrlv' - if(psb_get_errstatus() /= 0) return info=psb_success_ call psb_erractionsave(err_act) + if (psb_errstatus_fatal()) then + info = psb_err_internal_error_ ; goto 9999 + end if ictxt=desc_a%get_context() @@ -209,9 +211,11 @@ subroutine psb_covrl_multivect(x,desc_a,info,work,update,mode) logical :: aliw name='psb_covrlv' - if(psb_get_errstatus() /= 0) return info=psb_success_ call psb_erractionsave(err_act) + if (psb_errstatus_fatal()) then + info = psb_err_internal_error_ ; goto 9999 + end if ictxt=desc_a%get_context() diff --git a/base/comm/psb_covrl_a.f90 b/base/comm/psb_covrl_a.f90 index b64a3137c..d5bdc6df2 100644 --- a/base/comm/psb_covrl_a.f90 +++ b/base/comm/psb_covrl_a.f90 @@ -86,9 +86,11 @@ subroutine psb_covrlm(x,desc_a,info,jx,ik,work,update,mode) logical :: aliw name='psb_covrlm' - if(psb_get_errstatus() /= 0) return info=psb_success_ call psb_erractionsave(err_act) + if (psb_errstatus_fatal()) then + info = psb_err_internal_error_ ; goto 9999 + end if ictxt=desc_a%get_context() @@ -281,9 +283,11 @@ subroutine psb_covrlv(x,desc_a,info,work,update,mode) logical :: aliw name='psb_covrlv' - if(psb_get_errstatus() /= 0) return info=psb_success_ call psb_erractionsave(err_act) + if (psb_errstatus_fatal()) then + info = psb_err_internal_error_ ; goto 9999 + end if ictxt=desc_a%get_context() diff --git a/base/comm/psb_cscatter.F90 b/base/comm/psb_cscatter.F90 index 50fc1c4b2..77036d041 100644 --- a/base/comm/psb_cscatter.F90 +++ b/base/comm/psb_cscatter.F90 @@ -62,9 +62,11 @@ subroutine psb_cscatter_vect(globx, locx, desc_a, info, root, mold) integer(psb_ipk_) :: debug_level, debug_unit name='psb_scatter_vect' - if (psb_get_errstatus() /= 0) return info=psb_success_ call psb_erractionsave(err_act) + if (psb_errstatus_fatal()) then + info = psb_err_internal_error_ ; goto 9999 + end if ictxt=desc_a%get_context() debug_unit = psb_get_debug_unit() debug_level = psb_get_debug_level() diff --git a/base/comm/psb_cscatter_a.F90 b/base/comm/psb_cscatter_a.F90 index 1eef00af7..3d29dd37f 100644 --- a/base/comm/psb_cscatter_a.F90 +++ b/base/comm/psb_cscatter_a.F90 @@ -73,9 +73,11 @@ subroutine psb_cscatterm(globx, locx, desc_a, info, root) character(len=20) :: name, ch_err name='psb_scatterm' - if(psb_get_errstatus() /= 0) return info=psb_success_ call psb_erractionsave(err_act) + if (psb_errstatus_fatal()) then + info = psb_err_internal_error_ ; goto 9999 + end if ictxt=desc_a%get_context() @@ -315,9 +317,11 @@ subroutine psb_cscatterv(globx, locx, desc_a, info, root) integer(psb_ipk_) :: debug_level, debug_unit name='psb_scatterv' - if (psb_get_errstatus() /= 0) return info=psb_success_ call psb_erractionsave(err_act) + if (psb_errstatus_fatal()) then + info = psb_err_internal_error_ ; goto 9999 + end if ictxt=desc_a%get_context() debug_unit = psb_get_debug_unit() debug_level = psb_get_debug_level() diff --git a/base/comm/psb_cspgather.F90 b/base/comm/psb_cspgather.F90 index 8a4fe680f..02120f88e 100644 --- a/base/comm/psb_cspgather.F90 +++ b/base/comm/psb_cspgather.F90 @@ -64,10 +64,12 @@ subroutine psb_csp_allgather(globa, loca, desc_a, info, root, dupl,keepnum,keep integer(psb_ipk_) :: debug_level, debug_unit name='psb_gather' - if (psb_get_errstatus().ne.0) return info=psb_success_ call psb_erractionsave(err_act) + if (psb_errstatus_fatal()) then + info = psb_err_internal_error_ ; goto 9999 + end if ictxt = desc_a%get_context() icomm = desc_a%get_mpic() call psb_info(ictxt, me, np) @@ -205,10 +207,12 @@ subroutine psb_lcsp_allgather(globa, loca, desc_a, info, root, dupl,keepnum,kee integer(psb_ipk_) :: debug_level, debug_unit name='psb_gather' - if (psb_get_errstatus().ne.0) return info=psb_success_ call psb_erractionsave(err_act) + if (psb_errstatus_fatal()) then + info = psb_err_internal_error_ ; goto 9999 + end if ictxt = desc_a%get_context() icomm = desc_a%get_mpic() call psb_info(ictxt, me, np) diff --git a/base/comm/psb_dgather.f90 b/base/comm/psb_dgather.f90 index f7ec78da5..3659b4874 100644 --- a/base/comm/psb_dgather.f90 +++ b/base/comm/psb_dgather.f90 @@ -64,9 +64,11 @@ subroutine psb_dgather_vect(globx, locx, desc_a, info, iroot) character(len=20) :: name, ch_err name='psb_cgatherv' - if(psb_get_errstatus() /= 0) return info=psb_success_ call psb_erractionsave(err_act) + if (psb_errstatus_fatal()) then + info = psb_err_internal_error_ ; goto 9999 + end if ictxt=desc_a%get_context() @@ -177,9 +179,11 @@ subroutine psb_dgather_multivect(globx, locx, desc_a, info, iroot) character(len=20) :: name, ch_err name='psb_cgatherv' - if(psb_get_errstatus() /= 0) return info=psb_success_ call psb_erractionsave(err_act) + if (psb_errstatus_fatal()) then + info = psb_err_internal_error_ ; goto 9999 + end if ictxt=desc_a%get_context() diff --git a/base/comm/psb_dgather_a.f90 b/base/comm/psb_dgather_a.f90 index 5dd202952..277eb3d04 100644 --- a/base/comm/psb_dgather_a.f90 +++ b/base/comm/psb_dgather_a.f90 @@ -65,9 +65,11 @@ subroutine psb_dgatherm(globx, locx, desc_a, info, iroot) character(len=20) :: name, ch_err name='psb_dgatherm' - if(psb_get_errstatus() /= 0) return info=psb_success_ call psb_erractionsave(err_act) + if (psb_errstatus_fatal()) then + info = psb_err_internal_error_ ; goto 9999 + end if ictxt=desc_a%get_context() ! check on blacs grid @@ -237,9 +239,11 @@ subroutine psb_dgatherv(globx, locx, desc_a, info, iroot) character(len=20) :: name, ch_err name='psb_dgatherv' - if(psb_get_errstatus() /= 0) return info=psb_success_ call psb_erractionsave(err_act) + if (psb_errstatus_fatal()) then + info = psb_err_internal_error_ ; goto 9999 + end if ictxt=desc_a%get_context() diff --git a/base/comm/psb_dhalo.f90 b/base/comm/psb_dhalo.f90 index 4f48007b0..005c59b2f 100644 --- a/base/comm/psb_dhalo.f90 +++ b/base/comm/psb_dhalo.f90 @@ -75,9 +75,11 @@ subroutine psb_dhalo_vect(x,desc_a,info,work,tran,mode,data) logical :: aliw name='psb_dhalov' - if(psb_get_errstatus() /= 0) return info=psb_success_ call psb_erractionsave(err_act) + if (psb_errstatus_fatal()) then + info = psb_err_internal_error_ ; goto 9999 + end if ictxt=desc_a%get_context() @@ -214,9 +216,11 @@ subroutine psb_dhalo_multivect(x,desc_a,info,work,tran,mode,data) logical :: aliw name='psb_dhalov' - if(psb_get_errstatus() /= 0) return info=psb_success_ call psb_erractionsave(err_act) + if (psb_errstatus_fatal()) then + info = psb_err_internal_error_ ; goto 9999 + end if ictxt=desc_a%get_context() diff --git a/base/comm/psb_dhalo_a.f90 b/base/comm/psb_dhalo_a.f90 index 89bde9aea..9f7b9ee19 100644 --- a/base/comm/psb_dhalo_a.f90 +++ b/base/comm/psb_dhalo_a.f90 @@ -75,9 +75,11 @@ subroutine psb_dhalom(x,desc_a,info,jx,ik,work,tran,mode,data) logical :: aliw name='psb_dhalom' - if(psb_get_errstatus() /= 0) return info=psb_success_ call psb_erractionsave(err_act) + if (psb_errstatus_fatal()) then + info = psb_err_internal_error_ ; goto 9999 + end if ictxt=desc_a%get_context() @@ -282,9 +284,11 @@ subroutine psb_dhalov(x,desc_a,info,work,tran,mode,data) logical :: aliw name='psb_dhalov' - if(psb_get_errstatus() /= 0) return info=psb_success_ call psb_erractionsave(err_act) + if (psb_errstatus_fatal()) then + info = psb_err_internal_error_ ; goto 9999 + end if ictxt=desc_a%get_context() diff --git a/base/comm/psb_dovrl.f90 b/base/comm/psb_dovrl.f90 index b255511a8..07b751565 100644 --- a/base/comm/psb_dovrl.f90 +++ b/base/comm/psb_dovrl.f90 @@ -84,9 +84,11 @@ subroutine psb_dovrl_vect(x,desc_a,info,work,update,mode) logical :: aliw name='psb_dovrlv' - if(psb_get_errstatus() /= 0) return info=psb_success_ call psb_erractionsave(err_act) + if (psb_errstatus_fatal()) then + info = psb_err_internal_error_ ; goto 9999 + end if ictxt=desc_a%get_context() @@ -209,9 +211,11 @@ subroutine psb_dovrl_multivect(x,desc_a,info,work,update,mode) logical :: aliw name='psb_dovrlv' - if(psb_get_errstatus() /= 0) return info=psb_success_ call psb_erractionsave(err_act) + if (psb_errstatus_fatal()) then + info = psb_err_internal_error_ ; goto 9999 + end if ictxt=desc_a%get_context() diff --git a/base/comm/psb_dovrl_a.f90 b/base/comm/psb_dovrl_a.f90 index 12732460d..14272ee94 100644 --- a/base/comm/psb_dovrl_a.f90 +++ b/base/comm/psb_dovrl_a.f90 @@ -86,9 +86,11 @@ subroutine psb_dovrlm(x,desc_a,info,jx,ik,work,update,mode) logical :: aliw name='psb_dovrlm' - if(psb_get_errstatus() /= 0) return info=psb_success_ call psb_erractionsave(err_act) + if (psb_errstatus_fatal()) then + info = psb_err_internal_error_ ; goto 9999 + end if ictxt=desc_a%get_context() @@ -281,9 +283,11 @@ subroutine psb_dovrlv(x,desc_a,info,work,update,mode) logical :: aliw name='psb_dovrlv' - if(psb_get_errstatus() /= 0) return info=psb_success_ call psb_erractionsave(err_act) + if (psb_errstatus_fatal()) then + info = psb_err_internal_error_ ; goto 9999 + end if ictxt=desc_a%get_context() diff --git a/base/comm/psb_dscatter.F90 b/base/comm/psb_dscatter.F90 index 8348aa59a..d559fa129 100644 --- a/base/comm/psb_dscatter.F90 +++ b/base/comm/psb_dscatter.F90 @@ -62,9 +62,11 @@ subroutine psb_dscatter_vect(globx, locx, desc_a, info, root, mold) integer(psb_ipk_) :: debug_level, debug_unit name='psb_scatter_vect' - if (psb_get_errstatus() /= 0) return info=psb_success_ call psb_erractionsave(err_act) + if (psb_errstatus_fatal()) then + info = psb_err_internal_error_ ; goto 9999 + end if ictxt=desc_a%get_context() debug_unit = psb_get_debug_unit() debug_level = psb_get_debug_level() diff --git a/base/comm/psb_dscatter_a.F90 b/base/comm/psb_dscatter_a.F90 index 32fd43a3f..e8d53a628 100644 --- a/base/comm/psb_dscatter_a.F90 +++ b/base/comm/psb_dscatter_a.F90 @@ -73,9 +73,11 @@ subroutine psb_dscatterm(globx, locx, desc_a, info, root) character(len=20) :: name, ch_err name='psb_scatterm' - if(psb_get_errstatus() /= 0) return info=psb_success_ call psb_erractionsave(err_act) + if (psb_errstatus_fatal()) then + info = psb_err_internal_error_ ; goto 9999 + end if ictxt=desc_a%get_context() @@ -315,9 +317,11 @@ subroutine psb_dscatterv(globx, locx, desc_a, info, root) integer(psb_ipk_) :: debug_level, debug_unit name='psb_scatterv' - if (psb_get_errstatus() /= 0) return info=psb_success_ call psb_erractionsave(err_act) + if (psb_errstatus_fatal()) then + info = psb_err_internal_error_ ; goto 9999 + end if ictxt=desc_a%get_context() debug_unit = psb_get_debug_unit() debug_level = psb_get_debug_level() diff --git a/base/comm/psb_dspgather.F90 b/base/comm/psb_dspgather.F90 index 83024e104..92a9044ba 100644 --- a/base/comm/psb_dspgather.F90 +++ b/base/comm/psb_dspgather.F90 @@ -64,10 +64,12 @@ subroutine psb_dsp_allgather(globa, loca, desc_a, info, root, dupl,keepnum,keep integer(psb_ipk_) :: debug_level, debug_unit name='psb_gather' - if (psb_get_errstatus().ne.0) return info=psb_success_ call psb_erractionsave(err_act) + if (psb_errstatus_fatal()) then + info = psb_err_internal_error_ ; goto 9999 + end if ictxt = desc_a%get_context() icomm = desc_a%get_mpic() call psb_info(ictxt, me, np) @@ -205,10 +207,12 @@ subroutine psb_ldsp_allgather(globa, loca, desc_a, info, root, dupl,keepnum,kee integer(psb_ipk_) :: debug_level, debug_unit name='psb_gather' - if (psb_get_errstatus().ne.0) return info=psb_success_ call psb_erractionsave(err_act) + if (psb_errstatus_fatal()) then + info = psb_err_internal_error_ ; goto 9999 + end if ictxt = desc_a%get_context() icomm = desc_a%get_mpic() call psb_info(ictxt, me, np) diff --git a/base/comm/psb_egather_a.f90 b/base/comm/psb_egather_a.f90 index 77d76dd27..54b77bc98 100644 --- a/base/comm/psb_egather_a.f90 +++ b/base/comm/psb_egather_a.f90 @@ -65,9 +65,11 @@ subroutine psb_egatherm(globx, locx, desc_a, info, iroot) character(len=20) :: name, ch_err name='psb_egatherm' - if(psb_get_errstatus() /= 0) return info=psb_success_ call psb_erractionsave(err_act) + if (psb_errstatus_fatal()) then + info = psb_err_internal_error_ ; goto 9999 + end if ictxt=desc_a%get_context() ! check on blacs grid @@ -237,9 +239,11 @@ subroutine psb_egatherv(globx, locx, desc_a, info, iroot) character(len=20) :: name, ch_err name='psb_egatherv' - if(psb_get_errstatus() /= 0) return info=psb_success_ call psb_erractionsave(err_act) + if (psb_errstatus_fatal()) then + info = psb_err_internal_error_ ; goto 9999 + end if ictxt=desc_a%get_context() diff --git a/base/comm/psb_ehalo_a.f90 b/base/comm/psb_ehalo_a.f90 index b9921c0db..6aa31a0b0 100644 --- a/base/comm/psb_ehalo_a.f90 +++ b/base/comm/psb_ehalo_a.f90 @@ -75,9 +75,11 @@ subroutine psb_ehalom(x,desc_a,info,jx,ik,work,tran,mode,data) logical :: aliw name='psb_ehalom' - if(psb_get_errstatus() /= 0) return info=psb_success_ call psb_erractionsave(err_act) + if (psb_errstatus_fatal()) then + info = psb_err_internal_error_ ; goto 9999 + end if ictxt=desc_a%get_context() @@ -282,9 +284,11 @@ subroutine psb_ehalov(x,desc_a,info,work,tran,mode,data) logical :: aliw name='psb_ehalov' - if(psb_get_errstatus() /= 0) return info=psb_success_ call psb_erractionsave(err_act) + if (psb_errstatus_fatal()) then + info = psb_err_internal_error_ ; goto 9999 + end if ictxt=desc_a%get_context() diff --git a/base/comm/psb_eovrl_a.f90 b/base/comm/psb_eovrl_a.f90 index 3c5eccc4d..282c0b33e 100644 --- a/base/comm/psb_eovrl_a.f90 +++ b/base/comm/psb_eovrl_a.f90 @@ -86,9 +86,11 @@ subroutine psb_eovrlm(x,desc_a,info,jx,ik,work,update,mode) logical :: aliw name='psb_eovrlm' - if(psb_get_errstatus() /= 0) return info=psb_success_ call psb_erractionsave(err_act) + if (psb_errstatus_fatal()) then + info = psb_err_internal_error_ ; goto 9999 + end if ictxt=desc_a%get_context() @@ -281,9 +283,11 @@ subroutine psb_eovrlv(x,desc_a,info,work,update,mode) logical :: aliw name='psb_eovrlv' - if(psb_get_errstatus() /= 0) return info=psb_success_ call psb_erractionsave(err_act) + if (psb_errstatus_fatal()) then + info = psb_err_internal_error_ ; goto 9999 + end if ictxt=desc_a%get_context() diff --git a/base/comm/psb_escatter_a.F90 b/base/comm/psb_escatter_a.F90 index 028b9e467..62bc5734f 100644 --- a/base/comm/psb_escatter_a.F90 +++ b/base/comm/psb_escatter_a.F90 @@ -73,9 +73,11 @@ subroutine psb_escatterm(globx, locx, desc_a, info, root) character(len=20) :: name, ch_err name='psb_scatterm' - if(psb_get_errstatus() /= 0) return info=psb_success_ call psb_erractionsave(err_act) + if (psb_errstatus_fatal()) then + info = psb_err_internal_error_ ; goto 9999 + end if ictxt=desc_a%get_context() @@ -315,9 +317,11 @@ subroutine psb_escatterv(globx, locx, desc_a, info, root) integer(psb_ipk_) :: debug_level, debug_unit name='psb_scatterv' - if (psb_get_errstatus() /= 0) return info=psb_success_ call psb_erractionsave(err_act) + if (psb_errstatus_fatal()) then + info = psb_err_internal_error_ ; goto 9999 + end if ictxt=desc_a%get_context() debug_unit = psb_get_debug_unit() debug_level = psb_get_debug_level() diff --git a/base/comm/psb_igather.f90 b/base/comm/psb_igather.f90 index 8b13af798..a6e59497f 100644 --- a/base/comm/psb_igather.f90 +++ b/base/comm/psb_igather.f90 @@ -64,9 +64,11 @@ subroutine psb_igather_vect(globx, locx, desc_a, info, iroot) character(len=20) :: name, ch_err name='psb_cgatherv' - if(psb_get_errstatus() /= 0) return info=psb_success_ call psb_erractionsave(err_act) + if (psb_errstatus_fatal()) then + info = psb_err_internal_error_ ; goto 9999 + end if ictxt=desc_a%get_context() @@ -177,9 +179,11 @@ subroutine psb_igather_multivect(globx, locx, desc_a, info, iroot) character(len=20) :: name, ch_err name='psb_cgatherv' - if(psb_get_errstatus() /= 0) return info=psb_success_ call psb_erractionsave(err_act) + if (psb_errstatus_fatal()) then + info = psb_err_internal_error_ ; goto 9999 + end if ictxt=desc_a%get_context() diff --git a/base/comm/psb_ihalo.f90 b/base/comm/psb_ihalo.f90 index ea401ae39..ab1141ea1 100644 --- a/base/comm/psb_ihalo.f90 +++ b/base/comm/psb_ihalo.f90 @@ -75,9 +75,11 @@ subroutine psb_ihalo_vect(x,desc_a,info,work,tran,mode,data) logical :: aliw name='psb_ihalov' - if(psb_get_errstatus() /= 0) return info=psb_success_ call psb_erractionsave(err_act) + if (psb_errstatus_fatal()) then + info = psb_err_internal_error_ ; goto 9999 + end if ictxt=desc_a%get_context() @@ -214,9 +216,11 @@ subroutine psb_ihalo_multivect(x,desc_a,info,work,tran,mode,data) logical :: aliw name='psb_ihalov' - if(psb_get_errstatus() /= 0) return info=psb_success_ call psb_erractionsave(err_act) + if (psb_errstatus_fatal()) then + info = psb_err_internal_error_ ; goto 9999 + end if ictxt=desc_a%get_context() diff --git a/base/comm/psb_iovrl.f90 b/base/comm/psb_iovrl.f90 index dcc97b874..385d5c24a 100644 --- a/base/comm/psb_iovrl.f90 +++ b/base/comm/psb_iovrl.f90 @@ -84,9 +84,11 @@ subroutine psb_iovrl_vect(x,desc_a,info,work,update,mode) logical :: aliw name='psb_iovrlv' - if(psb_get_errstatus() /= 0) return info=psb_success_ call psb_erractionsave(err_act) + if (psb_errstatus_fatal()) then + info = psb_err_internal_error_ ; goto 9999 + end if ictxt=desc_a%get_context() @@ -209,9 +211,11 @@ subroutine psb_iovrl_multivect(x,desc_a,info,work,update,mode) logical :: aliw name='psb_iovrlv' - if(psb_get_errstatus() /= 0) return info=psb_success_ call psb_erractionsave(err_act) + if (psb_errstatus_fatal()) then + info = psb_err_internal_error_ ; goto 9999 + end if ictxt=desc_a%get_context() diff --git a/base/comm/psb_iscatter.F90 b/base/comm/psb_iscatter.F90 index bdc2fdf1d..1a545e9b2 100644 --- a/base/comm/psb_iscatter.F90 +++ b/base/comm/psb_iscatter.F90 @@ -62,9 +62,11 @@ subroutine psb_iscatter_vect(globx, locx, desc_a, info, root, mold) integer(psb_ipk_) :: debug_level, debug_unit name='psb_scatter_vect' - if (psb_get_errstatus() /= 0) return info=psb_success_ call psb_erractionsave(err_act) + if (psb_errstatus_fatal()) then + info = psb_err_internal_error_ ; goto 9999 + end if ictxt=desc_a%get_context() debug_unit = psb_get_debug_unit() debug_level = psb_get_debug_level() diff --git a/base/comm/psb_ispgather.F90 b/base/comm/psb_ispgather.F90 index 3de657b6b..fef966f8d 100644 --- a/base/comm/psb_ispgather.F90 +++ b/base/comm/psb_ispgather.F90 @@ -64,10 +64,12 @@ subroutine psb_isp_allgather(globa, loca, desc_a, info, root, dupl,keepnum,keep integer(psb_ipk_) :: debug_level, debug_unit name='psb_gather' - if (psb_get_errstatus().ne.0) return info=psb_success_ call psb_erractionsave(err_act) + if (psb_errstatus_fatal()) then + info = psb_err_internal_error_ ; goto 9999 + end if ictxt = desc_a%get_context() icomm = desc_a%get_mpic() call psb_info(ictxt, me, np) @@ -205,10 +207,12 @@ subroutine psb_@LX@sp_allgather(globa, loca, desc_a, info, root, dupl,keepnum,k integer(psb_ipk_) :: debug_level, debug_unit name='psb_gather' - if (psb_get_errstatus().ne.0) return info=psb_success_ call psb_erractionsave(err_act) + if (psb_errstatus_fatal()) then + info = psb_err_internal_error_ ; goto 9999 + end if ictxt = desc_a%get_context() icomm = desc_a%get_mpic() call psb_info(ictxt, me, np) diff --git a/base/comm/psb_lgather.f90 b/base/comm/psb_lgather.f90 index 9b6f0fcad..45ea0d945 100644 --- a/base/comm/psb_lgather.f90 +++ b/base/comm/psb_lgather.f90 @@ -64,9 +64,11 @@ subroutine psb_lgather_vect(globx, locx, desc_a, info, iroot) character(len=20) :: name, ch_err name='psb_cgatherv' - if(psb_get_errstatus() /= 0) return info=psb_success_ call psb_erractionsave(err_act) + if (psb_errstatus_fatal()) then + info = psb_err_internal_error_ ; goto 9999 + end if ictxt=desc_a%get_context() @@ -177,9 +179,11 @@ subroutine psb_lgather_multivect(globx, locx, desc_a, info, iroot) character(len=20) :: name, ch_err name='psb_cgatherv' - if(psb_get_errstatus() /= 0) return info=psb_success_ call psb_erractionsave(err_act) + if (psb_errstatus_fatal()) then + info = psb_err_internal_error_ ; goto 9999 + end if ictxt=desc_a%get_context() diff --git a/base/comm/psb_lhalo.f90 b/base/comm/psb_lhalo.f90 index f08bdf704..36e95b349 100644 --- a/base/comm/psb_lhalo.f90 +++ b/base/comm/psb_lhalo.f90 @@ -75,9 +75,11 @@ subroutine psb_lhalo_vect(x,desc_a,info,work,tran,mode,data) logical :: aliw name='psb_lhalov' - if(psb_get_errstatus() /= 0) return info=psb_success_ call psb_erractionsave(err_act) + if (psb_errstatus_fatal()) then + info = psb_err_internal_error_ ; goto 9999 + end if ictxt=desc_a%get_context() @@ -214,9 +216,11 @@ subroutine psb_lhalo_multivect(x,desc_a,info,work,tran,mode,data) logical :: aliw name='psb_lhalov' - if(psb_get_errstatus() /= 0) return info=psb_success_ call psb_erractionsave(err_act) + if (psb_errstatus_fatal()) then + info = psb_err_internal_error_ ; goto 9999 + end if ictxt=desc_a%get_context() diff --git a/base/comm/psb_lovrl.f90 b/base/comm/psb_lovrl.f90 index 94adc24d4..52fe7f699 100644 --- a/base/comm/psb_lovrl.f90 +++ b/base/comm/psb_lovrl.f90 @@ -84,9 +84,11 @@ subroutine psb_lovrl_vect(x,desc_a,info,work,update,mode) logical :: aliw name='psb_lovrlv' - if(psb_get_errstatus() /= 0) return info=psb_success_ call psb_erractionsave(err_act) + if (psb_errstatus_fatal()) then + info = psb_err_internal_error_ ; goto 9999 + end if ictxt=desc_a%get_context() @@ -209,9 +211,11 @@ subroutine psb_lovrl_multivect(x,desc_a,info,work,update,mode) logical :: aliw name='psb_lovrlv' - if(psb_get_errstatus() /= 0) return info=psb_success_ call psb_erractionsave(err_act) + if (psb_errstatus_fatal()) then + info = psb_err_internal_error_ ; goto 9999 + end if ictxt=desc_a%get_context() diff --git a/base/comm/psb_lscatter.F90 b/base/comm/psb_lscatter.F90 index 22081079f..ed4051faf 100644 --- a/base/comm/psb_lscatter.F90 +++ b/base/comm/psb_lscatter.F90 @@ -62,9 +62,11 @@ subroutine psb_lscatter_vect(globx, locx, desc_a, info, root, mold) integer(psb_ipk_) :: debug_level, debug_unit name='psb_scatter_vect' - if (psb_get_errstatus() /= 0) return info=psb_success_ call psb_erractionsave(err_act) + if (psb_errstatus_fatal()) then + info = psb_err_internal_error_ ; goto 9999 + end if ictxt=desc_a%get_context() debug_unit = psb_get_debug_unit() debug_level = psb_get_debug_level() diff --git a/base/comm/psb_lspgather.F90 b/base/comm/psb_lspgather.F90 index 742c89dea..914bcb8cf 100644 --- a/base/comm/psb_lspgather.F90 +++ b/base/comm/psb_lspgather.F90 @@ -64,10 +64,12 @@ subroutine psb_lsp_allgather(globa, loca, desc_a, info, root, dupl,keepnum,keep integer(psb_ipk_) :: debug_level, debug_unit name='psb_gather' - if (psb_get_errstatus().ne.0) return info=psb_success_ call psb_erractionsave(err_act) + if (psb_errstatus_fatal()) then + info = psb_err_internal_error_ ; goto 9999 + end if ictxt = desc_a%get_context() icomm = desc_a%get_mpic() call psb_info(ictxt, me, np) @@ -205,10 +207,12 @@ subroutine psb_@LX@sp_allgather(globa, loca, desc_a, info, root, dupl,keepnum,k integer(psb_ipk_) :: debug_level, debug_unit name='psb_gather' - if (psb_get_errstatus().ne.0) return info=psb_success_ call psb_erractionsave(err_act) + if (psb_errstatus_fatal()) then + info = psb_err_internal_error_ ; goto 9999 + end if ictxt = desc_a%get_context() icomm = desc_a%get_mpic() call psb_info(ictxt, me, np) diff --git a/base/comm/psb_mgather_a.f90 b/base/comm/psb_mgather_a.f90 index 6b9467ff6..1ee8e7f4f 100644 --- a/base/comm/psb_mgather_a.f90 +++ b/base/comm/psb_mgather_a.f90 @@ -65,9 +65,11 @@ subroutine psb_mgatherm(globx, locx, desc_a, info, iroot) character(len=20) :: name, ch_err name='psb_mgatherm' - if(psb_get_errstatus() /= 0) return info=psb_success_ call psb_erractionsave(err_act) + if (psb_errstatus_fatal()) then + info = psb_err_internal_error_ ; goto 9999 + end if ictxt=desc_a%get_context() ! check on blacs grid @@ -237,9 +239,11 @@ subroutine psb_mgatherv(globx, locx, desc_a, info, iroot) character(len=20) :: name, ch_err name='psb_mgatherv' - if(psb_get_errstatus() /= 0) return info=psb_success_ call psb_erractionsave(err_act) + if (psb_errstatus_fatal()) then + info = psb_err_internal_error_ ; goto 9999 + end if ictxt=desc_a%get_context() diff --git a/base/comm/psb_mhalo_a.f90 b/base/comm/psb_mhalo_a.f90 index 6762633af..092d4bd54 100644 --- a/base/comm/psb_mhalo_a.f90 +++ b/base/comm/psb_mhalo_a.f90 @@ -75,9 +75,11 @@ subroutine psb_mhalom(x,desc_a,info,jx,ik,work,tran,mode,data) logical :: aliw name='psb_mhalom' - if(psb_get_errstatus() /= 0) return info=psb_success_ call psb_erractionsave(err_act) + if (psb_errstatus_fatal()) then + info = psb_err_internal_error_ ; goto 9999 + end if ictxt=desc_a%get_context() @@ -282,9 +284,11 @@ subroutine psb_mhalov(x,desc_a,info,work,tran,mode,data) logical :: aliw name='psb_mhalov' - if(psb_get_errstatus() /= 0) return info=psb_success_ call psb_erractionsave(err_act) + if (psb_errstatus_fatal()) then + info = psb_err_internal_error_ ; goto 9999 + end if ictxt=desc_a%get_context() diff --git a/base/comm/psb_movrl_a.f90 b/base/comm/psb_movrl_a.f90 index 95f8f0343..2b1b80542 100644 --- a/base/comm/psb_movrl_a.f90 +++ b/base/comm/psb_movrl_a.f90 @@ -86,9 +86,11 @@ subroutine psb_movrlm(x,desc_a,info,jx,ik,work,update,mode) logical :: aliw name='psb_movrlm' - if(psb_get_errstatus() /= 0) return info=psb_success_ call psb_erractionsave(err_act) + if (psb_errstatus_fatal()) then + info = psb_err_internal_error_ ; goto 9999 + end if ictxt=desc_a%get_context() @@ -281,9 +283,11 @@ subroutine psb_movrlv(x,desc_a,info,work,update,mode) logical :: aliw name='psb_movrlv' - if(psb_get_errstatus() /= 0) return info=psb_success_ call psb_erractionsave(err_act) + if (psb_errstatus_fatal()) then + info = psb_err_internal_error_ ; goto 9999 + end if ictxt=desc_a%get_context() diff --git a/base/comm/psb_mscatter_a.F90 b/base/comm/psb_mscatter_a.F90 index 826ece53a..4778c63f8 100644 --- a/base/comm/psb_mscatter_a.F90 +++ b/base/comm/psb_mscatter_a.F90 @@ -73,9 +73,11 @@ subroutine psb_mscatterm(globx, locx, desc_a, info, root) character(len=20) :: name, ch_err name='psb_scatterm' - if(psb_get_errstatus() /= 0) return info=psb_success_ call psb_erractionsave(err_act) + if (psb_errstatus_fatal()) then + info = psb_err_internal_error_ ; goto 9999 + end if ictxt=desc_a%get_context() @@ -315,9 +317,11 @@ subroutine psb_mscatterv(globx, locx, desc_a, info, root) integer(psb_ipk_) :: debug_level, debug_unit name='psb_scatterv' - if (psb_get_errstatus() /= 0) return info=psb_success_ call psb_erractionsave(err_act) + if (psb_errstatus_fatal()) then + info = psb_err_internal_error_ ; goto 9999 + end if ictxt=desc_a%get_context() debug_unit = psb_get_debug_unit() debug_level = psb_get_debug_level() diff --git a/base/comm/psb_sgather.f90 b/base/comm/psb_sgather.f90 index 13192b99e..10c6b7c2c 100644 --- a/base/comm/psb_sgather.f90 +++ b/base/comm/psb_sgather.f90 @@ -64,9 +64,11 @@ subroutine psb_sgather_vect(globx, locx, desc_a, info, iroot) character(len=20) :: name, ch_err name='psb_cgatherv' - if(psb_get_errstatus() /= 0) return info=psb_success_ call psb_erractionsave(err_act) + if (psb_errstatus_fatal()) then + info = psb_err_internal_error_ ; goto 9999 + end if ictxt=desc_a%get_context() @@ -177,9 +179,11 @@ subroutine psb_sgather_multivect(globx, locx, desc_a, info, iroot) character(len=20) :: name, ch_err name='psb_cgatherv' - if(psb_get_errstatus() /= 0) return info=psb_success_ call psb_erractionsave(err_act) + if (psb_errstatus_fatal()) then + info = psb_err_internal_error_ ; goto 9999 + end if ictxt=desc_a%get_context() diff --git a/base/comm/psb_sgather_a.f90 b/base/comm/psb_sgather_a.f90 index 62146841b..68076959a 100644 --- a/base/comm/psb_sgather_a.f90 +++ b/base/comm/psb_sgather_a.f90 @@ -65,9 +65,11 @@ subroutine psb_sgatherm(globx, locx, desc_a, info, iroot) character(len=20) :: name, ch_err name='psb_sgatherm' - if(psb_get_errstatus() /= 0) return info=psb_success_ call psb_erractionsave(err_act) + if (psb_errstatus_fatal()) then + info = psb_err_internal_error_ ; goto 9999 + end if ictxt=desc_a%get_context() ! check on blacs grid @@ -237,9 +239,11 @@ subroutine psb_sgatherv(globx, locx, desc_a, info, iroot) character(len=20) :: name, ch_err name='psb_sgatherv' - if(psb_get_errstatus() /= 0) return info=psb_success_ call psb_erractionsave(err_act) + if (psb_errstatus_fatal()) then + info = psb_err_internal_error_ ; goto 9999 + end if ictxt=desc_a%get_context() diff --git a/base/comm/psb_shalo.f90 b/base/comm/psb_shalo.f90 index 444c43fe9..c18524143 100644 --- a/base/comm/psb_shalo.f90 +++ b/base/comm/psb_shalo.f90 @@ -75,9 +75,11 @@ subroutine psb_shalo_vect(x,desc_a,info,work,tran,mode,data) logical :: aliw name='psb_shalov' - if(psb_get_errstatus() /= 0) return info=psb_success_ call psb_erractionsave(err_act) + if (psb_errstatus_fatal()) then + info = psb_err_internal_error_ ; goto 9999 + end if ictxt=desc_a%get_context() @@ -214,9 +216,11 @@ subroutine psb_shalo_multivect(x,desc_a,info,work,tran,mode,data) logical :: aliw name='psb_shalov' - if(psb_get_errstatus() /= 0) return info=psb_success_ call psb_erractionsave(err_act) + if (psb_errstatus_fatal()) then + info = psb_err_internal_error_ ; goto 9999 + end if ictxt=desc_a%get_context() diff --git a/base/comm/psb_shalo_a.f90 b/base/comm/psb_shalo_a.f90 index 5e9b83545..14d97025a 100644 --- a/base/comm/psb_shalo_a.f90 +++ b/base/comm/psb_shalo_a.f90 @@ -75,9 +75,11 @@ subroutine psb_shalom(x,desc_a,info,jx,ik,work,tran,mode,data) logical :: aliw name='psb_shalom' - if(psb_get_errstatus() /= 0) return info=psb_success_ call psb_erractionsave(err_act) + if (psb_errstatus_fatal()) then + info = psb_err_internal_error_ ; goto 9999 + end if ictxt=desc_a%get_context() @@ -282,9 +284,11 @@ subroutine psb_shalov(x,desc_a,info,work,tran,mode,data) logical :: aliw name='psb_shalov' - if(psb_get_errstatus() /= 0) return info=psb_success_ call psb_erractionsave(err_act) + if (psb_errstatus_fatal()) then + info = psb_err_internal_error_ ; goto 9999 + end if ictxt=desc_a%get_context() diff --git a/base/comm/psb_sovrl.f90 b/base/comm/psb_sovrl.f90 index 83f9dcc5a..0635a03b9 100644 --- a/base/comm/psb_sovrl.f90 +++ b/base/comm/psb_sovrl.f90 @@ -84,9 +84,11 @@ subroutine psb_sovrl_vect(x,desc_a,info,work,update,mode) logical :: aliw name='psb_sovrlv' - if(psb_get_errstatus() /= 0) return info=psb_success_ call psb_erractionsave(err_act) + if (psb_errstatus_fatal()) then + info = psb_err_internal_error_ ; goto 9999 + end if ictxt=desc_a%get_context() @@ -209,9 +211,11 @@ subroutine psb_sovrl_multivect(x,desc_a,info,work,update,mode) logical :: aliw name='psb_sovrlv' - if(psb_get_errstatus() /= 0) return info=psb_success_ call psb_erractionsave(err_act) + if (psb_errstatus_fatal()) then + info = psb_err_internal_error_ ; goto 9999 + end if ictxt=desc_a%get_context() diff --git a/base/comm/psb_sovrl_a.f90 b/base/comm/psb_sovrl_a.f90 index e12a4c6a2..e38048868 100644 --- a/base/comm/psb_sovrl_a.f90 +++ b/base/comm/psb_sovrl_a.f90 @@ -86,9 +86,11 @@ subroutine psb_sovrlm(x,desc_a,info,jx,ik,work,update,mode) logical :: aliw name='psb_sovrlm' - if(psb_get_errstatus() /= 0) return info=psb_success_ call psb_erractionsave(err_act) + if (psb_errstatus_fatal()) then + info = psb_err_internal_error_ ; goto 9999 + end if ictxt=desc_a%get_context() @@ -281,9 +283,11 @@ subroutine psb_sovrlv(x,desc_a,info,work,update,mode) logical :: aliw name='psb_sovrlv' - if(psb_get_errstatus() /= 0) return info=psb_success_ call psb_erractionsave(err_act) + if (psb_errstatus_fatal()) then + info = psb_err_internal_error_ ; goto 9999 + end if ictxt=desc_a%get_context() diff --git a/base/comm/psb_sscatter.F90 b/base/comm/psb_sscatter.F90 index f8a22a626..60bdd342d 100644 --- a/base/comm/psb_sscatter.F90 +++ b/base/comm/psb_sscatter.F90 @@ -62,9 +62,11 @@ subroutine psb_sscatter_vect(globx, locx, desc_a, info, root, mold) integer(psb_ipk_) :: debug_level, debug_unit name='psb_scatter_vect' - if (psb_get_errstatus() /= 0) return info=psb_success_ call psb_erractionsave(err_act) + if (psb_errstatus_fatal()) then + info = psb_err_internal_error_ ; goto 9999 + end if ictxt=desc_a%get_context() debug_unit = psb_get_debug_unit() debug_level = psb_get_debug_level() diff --git a/base/comm/psb_sscatter_a.F90 b/base/comm/psb_sscatter_a.F90 index 2a07d2974..e908a8239 100644 --- a/base/comm/psb_sscatter_a.F90 +++ b/base/comm/psb_sscatter_a.F90 @@ -73,9 +73,11 @@ subroutine psb_sscatterm(globx, locx, desc_a, info, root) character(len=20) :: name, ch_err name='psb_scatterm' - if(psb_get_errstatus() /= 0) return info=psb_success_ call psb_erractionsave(err_act) + if (psb_errstatus_fatal()) then + info = psb_err_internal_error_ ; goto 9999 + end if ictxt=desc_a%get_context() @@ -315,9 +317,11 @@ subroutine psb_sscatterv(globx, locx, desc_a, info, root) integer(psb_ipk_) :: debug_level, debug_unit name='psb_scatterv' - if (psb_get_errstatus() /= 0) return info=psb_success_ call psb_erractionsave(err_act) + if (psb_errstatus_fatal()) then + info = psb_err_internal_error_ ; goto 9999 + end if ictxt=desc_a%get_context() debug_unit = psb_get_debug_unit() debug_level = psb_get_debug_level() diff --git a/base/comm/psb_sspgather.F90 b/base/comm/psb_sspgather.F90 index d101b3252..0a86a28f1 100644 --- a/base/comm/psb_sspgather.F90 +++ b/base/comm/psb_sspgather.F90 @@ -64,10 +64,12 @@ subroutine psb_ssp_allgather(globa, loca, desc_a, info, root, dupl,keepnum,keep integer(psb_ipk_) :: debug_level, debug_unit name='psb_gather' - if (psb_get_errstatus().ne.0) return info=psb_success_ call psb_erractionsave(err_act) + if (psb_errstatus_fatal()) then + info = psb_err_internal_error_ ; goto 9999 + end if ictxt = desc_a%get_context() icomm = desc_a%get_mpic() call psb_info(ictxt, me, np) @@ -205,10 +207,12 @@ subroutine psb_lssp_allgather(globa, loca, desc_a, info, root, dupl,keepnum,kee integer(psb_ipk_) :: debug_level, debug_unit name='psb_gather' - if (psb_get_errstatus().ne.0) return info=psb_success_ call psb_erractionsave(err_act) + if (psb_errstatus_fatal()) then + info = psb_err_internal_error_ ; goto 9999 + end if ictxt = desc_a%get_context() icomm = desc_a%get_mpic() call psb_info(ictxt, me, np) diff --git a/base/comm/psb_zgather.f90 b/base/comm/psb_zgather.f90 index 59b6df405..d22e6644a 100644 --- a/base/comm/psb_zgather.f90 +++ b/base/comm/psb_zgather.f90 @@ -64,9 +64,11 @@ subroutine psb_zgather_vect(globx, locx, desc_a, info, iroot) character(len=20) :: name, ch_err name='psb_cgatherv' - if(psb_get_errstatus() /= 0) return info=psb_success_ call psb_erractionsave(err_act) + if (psb_errstatus_fatal()) then + info = psb_err_internal_error_ ; goto 9999 + end if ictxt=desc_a%get_context() @@ -177,9 +179,11 @@ subroutine psb_zgather_multivect(globx, locx, desc_a, info, iroot) character(len=20) :: name, ch_err name='psb_cgatherv' - if(psb_get_errstatus() /= 0) return info=psb_success_ call psb_erractionsave(err_act) + if (psb_errstatus_fatal()) then + info = psb_err_internal_error_ ; goto 9999 + end if ictxt=desc_a%get_context() diff --git a/base/comm/psb_zgather_a.f90 b/base/comm/psb_zgather_a.f90 index 014564872..d2c9bd91d 100644 --- a/base/comm/psb_zgather_a.f90 +++ b/base/comm/psb_zgather_a.f90 @@ -65,9 +65,11 @@ subroutine psb_zgatherm(globx, locx, desc_a, info, iroot) character(len=20) :: name, ch_err name='psb_zgatherm' - if(psb_get_errstatus() /= 0) return info=psb_success_ call psb_erractionsave(err_act) + if (psb_errstatus_fatal()) then + info = psb_err_internal_error_ ; goto 9999 + end if ictxt=desc_a%get_context() ! check on blacs grid @@ -237,9 +239,11 @@ subroutine psb_zgatherv(globx, locx, desc_a, info, iroot) character(len=20) :: name, ch_err name='psb_zgatherv' - if(psb_get_errstatus() /= 0) return info=psb_success_ call psb_erractionsave(err_act) + if (psb_errstatus_fatal()) then + info = psb_err_internal_error_ ; goto 9999 + end if ictxt=desc_a%get_context() diff --git a/base/comm/psb_zhalo.f90 b/base/comm/psb_zhalo.f90 index 3d9db06ca..f6c4b45a8 100644 --- a/base/comm/psb_zhalo.f90 +++ b/base/comm/psb_zhalo.f90 @@ -75,9 +75,11 @@ subroutine psb_zhalo_vect(x,desc_a,info,work,tran,mode,data) logical :: aliw name='psb_zhalov' - if(psb_get_errstatus() /= 0) return info=psb_success_ call psb_erractionsave(err_act) + if (psb_errstatus_fatal()) then + info = psb_err_internal_error_ ; goto 9999 + end if ictxt=desc_a%get_context() @@ -214,9 +216,11 @@ subroutine psb_zhalo_multivect(x,desc_a,info,work,tran,mode,data) logical :: aliw name='psb_zhalov' - if(psb_get_errstatus() /= 0) return info=psb_success_ call psb_erractionsave(err_act) + if (psb_errstatus_fatal()) then + info = psb_err_internal_error_ ; goto 9999 + end if ictxt=desc_a%get_context() diff --git a/base/comm/psb_zhalo_a.f90 b/base/comm/psb_zhalo_a.f90 index 6fe5d70af..ed94747b1 100644 --- a/base/comm/psb_zhalo_a.f90 +++ b/base/comm/psb_zhalo_a.f90 @@ -75,9 +75,11 @@ subroutine psb_zhalom(x,desc_a,info,jx,ik,work,tran,mode,data) logical :: aliw name='psb_zhalom' - if(psb_get_errstatus() /= 0) return info=psb_success_ call psb_erractionsave(err_act) + if (psb_errstatus_fatal()) then + info = psb_err_internal_error_ ; goto 9999 + end if ictxt=desc_a%get_context() @@ -282,9 +284,11 @@ subroutine psb_zhalov(x,desc_a,info,work,tran,mode,data) logical :: aliw name='psb_zhalov' - if(psb_get_errstatus() /= 0) return info=psb_success_ call psb_erractionsave(err_act) + if (psb_errstatus_fatal()) then + info = psb_err_internal_error_ ; goto 9999 + end if ictxt=desc_a%get_context() diff --git a/base/comm/psb_zovrl.f90 b/base/comm/psb_zovrl.f90 index 033bd0179..88707d9d4 100644 --- a/base/comm/psb_zovrl.f90 +++ b/base/comm/psb_zovrl.f90 @@ -84,9 +84,11 @@ subroutine psb_zovrl_vect(x,desc_a,info,work,update,mode) logical :: aliw name='psb_zovrlv' - if(psb_get_errstatus() /= 0) return info=psb_success_ call psb_erractionsave(err_act) + if (psb_errstatus_fatal()) then + info = psb_err_internal_error_ ; goto 9999 + end if ictxt=desc_a%get_context() @@ -209,9 +211,11 @@ subroutine psb_zovrl_multivect(x,desc_a,info,work,update,mode) logical :: aliw name='psb_zovrlv' - if(psb_get_errstatus() /= 0) return info=psb_success_ call psb_erractionsave(err_act) + if (psb_errstatus_fatal()) then + info = psb_err_internal_error_ ; goto 9999 + end if ictxt=desc_a%get_context() diff --git a/base/comm/psb_zovrl_a.f90 b/base/comm/psb_zovrl_a.f90 index 00c084a62..b392bc315 100644 --- a/base/comm/psb_zovrl_a.f90 +++ b/base/comm/psb_zovrl_a.f90 @@ -86,9 +86,11 @@ subroutine psb_zovrlm(x,desc_a,info,jx,ik,work,update,mode) logical :: aliw name='psb_zovrlm' - if(psb_get_errstatus() /= 0) return info=psb_success_ call psb_erractionsave(err_act) + if (psb_errstatus_fatal()) then + info = psb_err_internal_error_ ; goto 9999 + end if ictxt=desc_a%get_context() @@ -281,9 +283,11 @@ subroutine psb_zovrlv(x,desc_a,info,work,update,mode) logical :: aliw name='psb_zovrlv' - if(psb_get_errstatus() /= 0) return info=psb_success_ call psb_erractionsave(err_act) + if (psb_errstatus_fatal()) then + info = psb_err_internal_error_ ; goto 9999 + end if ictxt=desc_a%get_context() diff --git a/base/comm/psb_zscatter.F90 b/base/comm/psb_zscatter.F90 index dc0089894..008f80849 100644 --- a/base/comm/psb_zscatter.F90 +++ b/base/comm/psb_zscatter.F90 @@ -62,9 +62,11 @@ subroutine psb_zscatter_vect(globx, locx, desc_a, info, root, mold) integer(psb_ipk_) :: debug_level, debug_unit name='psb_scatter_vect' - if (psb_get_errstatus() /= 0) return info=psb_success_ call psb_erractionsave(err_act) + if (psb_errstatus_fatal()) then + info = psb_err_internal_error_ ; goto 9999 + end if ictxt=desc_a%get_context() debug_unit = psb_get_debug_unit() debug_level = psb_get_debug_level() diff --git a/base/comm/psb_zscatter_a.F90 b/base/comm/psb_zscatter_a.F90 index aa501562a..557166d80 100644 --- a/base/comm/psb_zscatter_a.F90 +++ b/base/comm/psb_zscatter_a.F90 @@ -73,9 +73,11 @@ subroutine psb_zscatterm(globx, locx, desc_a, info, root) character(len=20) :: name, ch_err name='psb_scatterm' - if(psb_get_errstatus() /= 0) return info=psb_success_ call psb_erractionsave(err_act) + if (psb_errstatus_fatal()) then + info = psb_err_internal_error_ ; goto 9999 + end if ictxt=desc_a%get_context() @@ -315,9 +317,11 @@ subroutine psb_zscatterv(globx, locx, desc_a, info, root) integer(psb_ipk_) :: debug_level, debug_unit name='psb_scatterv' - if (psb_get_errstatus() /= 0) return info=psb_success_ call psb_erractionsave(err_act) + if (psb_errstatus_fatal()) then + info = psb_err_internal_error_ ; goto 9999 + end if ictxt=desc_a%get_context() debug_unit = psb_get_debug_unit() debug_level = psb_get_debug_level() diff --git a/base/comm/psb_zspgather.F90 b/base/comm/psb_zspgather.F90 index ba01c9a2b..b8e99dec4 100644 --- a/base/comm/psb_zspgather.F90 +++ b/base/comm/psb_zspgather.F90 @@ -64,10 +64,12 @@ subroutine psb_zsp_allgather(globa, loca, desc_a, info, root, dupl,keepnum,keep integer(psb_ipk_) :: debug_level, debug_unit name='psb_gather' - if (psb_get_errstatus().ne.0) return info=psb_success_ call psb_erractionsave(err_act) + if (psb_errstatus_fatal()) then + info = psb_err_internal_error_ ; goto 9999 + end if ictxt = desc_a%get_context() icomm = desc_a%get_mpic() call psb_info(ictxt, me, np) @@ -205,10 +207,12 @@ subroutine psb_lzsp_allgather(globa, loca, desc_a, info, root, dupl,keepnum,kee integer(psb_ipk_) :: debug_level, debug_unit name='psb_gather' - if (psb_get_errstatus().ne.0) return info=psb_success_ call psb_erractionsave(err_act) + if (psb_errstatus_fatal()) then + info = psb_err_internal_error_ ; goto 9999 + end if ictxt = desc_a%get_context() icomm = desc_a%get_mpic() call psb_info(ictxt, me, np) diff --git a/base/modules/auxil/psb_c_realloc_mod.F90 b/base/modules/auxil/psb_c_realloc_mod.F90 index be460dc64..b9f3642b4 100644 --- a/base/modules/auxil/psb_c_realloc_mod.F90 +++ b/base/modules/auxil/psb_c_realloc_mod.F90 @@ -618,7 +618,7 @@ Contains call psb_erractionsave(err_act) info=psb_success_ - if(psb_get_errstatus() /= 0) then + if(psb_errstatus_fatal()) then info=psb_err_from_subroutine_ goto 9999 end if @@ -659,7 +659,7 @@ Contains call psb_erractionsave(err_act) info=psb_success_ - if(psb_get_errstatus() /= 0) then + if(psb_errstatus_fatal()) then info=psb_err_from_subroutine_ goto 9999 end if @@ -703,7 +703,7 @@ Contains name='psb_ab_cpy_c_rk1' call psb_erractionsave(err_act) info=psb_success_ - if(psb_get_errstatus() /= 0) then + if(psb_errstatus_fatal()) then info=psb_err_from_subroutine_ goto 9999 end if @@ -747,7 +747,7 @@ Contains name='psb_ab_cpy_c_rk2' call psb_erractionsave(err_act) info=psb_success_ - if(psb_get_errstatus() /= 0) then + if(psb_errstatus_fatal()) then info=psb_err_from_subroutine_ goto 9999 end if @@ -794,7 +794,7 @@ Contains name='psb_cpy_c_rk1' call psb_erractionsave(err_act) info=psb_success_ - if(psb_get_errstatus() /= 0) then + if(psb_errstatus_fatal()) then info=psb_err_from_subroutine_ goto 9999 end if @@ -835,7 +835,7 @@ Contains name='psb_safe_cpy' call psb_erractionsave(err_act) info=psb_success_ - if(psb_get_errstatus() /= 0) then + if(psb_errstatus_fatal()) then info=psb_err_from_subroutine_ goto 9999 end if @@ -914,7 +914,7 @@ Contains call psb_erractionsave(err_act) info = psb_success_ - if (psb_get_errstatus() /= 0) then + if (psb_errstatus_fatal()) then info=psb_err_from_subroutine_ goto 9999 end if @@ -967,7 +967,7 @@ Contains call psb_erractionsave(err_act) info = psb_success_ - if (psb_get_errstatus() /= 0) then + if (psb_errstatus_fatal()) then info=psb_err_from_subroutine_ goto 9999 end if diff --git a/base/modules/auxil/psb_d_realloc_mod.F90 b/base/modules/auxil/psb_d_realloc_mod.F90 index 528065064..43ac91254 100644 --- a/base/modules/auxil/psb_d_realloc_mod.F90 +++ b/base/modules/auxil/psb_d_realloc_mod.F90 @@ -618,7 +618,7 @@ Contains call psb_erractionsave(err_act) info=psb_success_ - if(psb_get_errstatus() /= 0) then + if(psb_errstatus_fatal()) then info=psb_err_from_subroutine_ goto 9999 end if @@ -659,7 +659,7 @@ Contains call psb_erractionsave(err_act) info=psb_success_ - if(psb_get_errstatus() /= 0) then + if(psb_errstatus_fatal()) then info=psb_err_from_subroutine_ goto 9999 end if @@ -703,7 +703,7 @@ Contains name='psb_ab_cpy_d_rk1' call psb_erractionsave(err_act) info=psb_success_ - if(psb_get_errstatus() /= 0) then + if(psb_errstatus_fatal()) then info=psb_err_from_subroutine_ goto 9999 end if @@ -747,7 +747,7 @@ Contains name='psb_ab_cpy_d_rk2' call psb_erractionsave(err_act) info=psb_success_ - if(psb_get_errstatus() /= 0) then + if(psb_errstatus_fatal()) then info=psb_err_from_subroutine_ goto 9999 end if @@ -794,7 +794,7 @@ Contains name='psb_cpy_d_rk1' call psb_erractionsave(err_act) info=psb_success_ - if(psb_get_errstatus() /= 0) then + if(psb_errstatus_fatal()) then info=psb_err_from_subroutine_ goto 9999 end if @@ -835,7 +835,7 @@ Contains name='psb_safe_cpy' call psb_erractionsave(err_act) info=psb_success_ - if(psb_get_errstatus() /= 0) then + if(psb_errstatus_fatal()) then info=psb_err_from_subroutine_ goto 9999 end if @@ -914,7 +914,7 @@ Contains call psb_erractionsave(err_act) info = psb_success_ - if (psb_get_errstatus() /= 0) then + if (psb_errstatus_fatal()) then info=psb_err_from_subroutine_ goto 9999 end if @@ -967,7 +967,7 @@ Contains call psb_erractionsave(err_act) info = psb_success_ - if (psb_get_errstatus() /= 0) then + if (psb_errstatus_fatal()) then info=psb_err_from_subroutine_ goto 9999 end if diff --git a/base/modules/auxil/psb_e_realloc_mod.F90 b/base/modules/auxil/psb_e_realloc_mod.F90 index 11e87486e..56e04dfba 100644 --- a/base/modules/auxil/psb_e_realloc_mod.F90 +++ b/base/modules/auxil/psb_e_realloc_mod.F90 @@ -618,7 +618,7 @@ Contains call psb_erractionsave(err_act) info=psb_success_ - if(psb_get_errstatus() /= 0) then + if(psb_errstatus_fatal()) then info=psb_err_from_subroutine_ goto 9999 end if @@ -659,7 +659,7 @@ Contains call psb_erractionsave(err_act) info=psb_success_ - if(psb_get_errstatus() /= 0) then + if(psb_errstatus_fatal()) then info=psb_err_from_subroutine_ goto 9999 end if @@ -703,7 +703,7 @@ Contains name='psb_ab_cpy_e_rk1' call psb_erractionsave(err_act) info=psb_success_ - if(psb_get_errstatus() /= 0) then + if(psb_errstatus_fatal()) then info=psb_err_from_subroutine_ goto 9999 end if @@ -747,7 +747,7 @@ Contains name='psb_ab_cpy_e_rk2' call psb_erractionsave(err_act) info=psb_success_ - if(psb_get_errstatus() /= 0) then + if(psb_errstatus_fatal()) then info=psb_err_from_subroutine_ goto 9999 end if @@ -794,7 +794,7 @@ Contains name='psb_cpy_e_rk1' call psb_erractionsave(err_act) info=psb_success_ - if(psb_get_errstatus() /= 0) then + if(psb_errstatus_fatal()) then info=psb_err_from_subroutine_ goto 9999 end if @@ -835,7 +835,7 @@ Contains name='psb_safe_cpy' call psb_erractionsave(err_act) info=psb_success_ - if(psb_get_errstatus() /= 0) then + if(psb_errstatus_fatal()) then info=psb_err_from_subroutine_ goto 9999 end if @@ -914,7 +914,7 @@ Contains call psb_erractionsave(err_act) info = psb_success_ - if (psb_get_errstatus() /= 0) then + if (psb_errstatus_fatal()) then info=psb_err_from_subroutine_ goto 9999 end if @@ -967,7 +967,7 @@ Contains call psb_erractionsave(err_act) info = psb_success_ - if (psb_get_errstatus() /= 0) then + if (psb_errstatus_fatal()) then info=psb_err_from_subroutine_ goto 9999 end if diff --git a/base/modules/auxil/psb_m_realloc_mod.F90 b/base/modules/auxil/psb_m_realloc_mod.F90 index 29e533adf..993be5713 100644 --- a/base/modules/auxil/psb_m_realloc_mod.F90 +++ b/base/modules/auxil/psb_m_realloc_mod.F90 @@ -618,7 +618,7 @@ Contains call psb_erractionsave(err_act) info=psb_success_ - if(psb_get_errstatus() /= 0) then + if(psb_errstatus_fatal()) then info=psb_err_from_subroutine_ goto 9999 end if @@ -659,7 +659,7 @@ Contains call psb_erractionsave(err_act) info=psb_success_ - if(psb_get_errstatus() /= 0) then + if(psb_errstatus_fatal()) then info=psb_err_from_subroutine_ goto 9999 end if @@ -703,7 +703,7 @@ Contains name='psb_ab_cpy_m_rk1' call psb_erractionsave(err_act) info=psb_success_ - if(psb_get_errstatus() /= 0) then + if(psb_errstatus_fatal()) then info=psb_err_from_subroutine_ goto 9999 end if @@ -747,7 +747,7 @@ Contains name='psb_ab_cpy_m_rk2' call psb_erractionsave(err_act) info=psb_success_ - if(psb_get_errstatus() /= 0) then + if(psb_errstatus_fatal()) then info=psb_err_from_subroutine_ goto 9999 end if @@ -794,7 +794,7 @@ Contains name='psb_cpy_m_rk1' call psb_erractionsave(err_act) info=psb_success_ - if(psb_get_errstatus() /= 0) then + if(psb_errstatus_fatal()) then info=psb_err_from_subroutine_ goto 9999 end if @@ -835,7 +835,7 @@ Contains name='psb_safe_cpy' call psb_erractionsave(err_act) info=psb_success_ - if(psb_get_errstatus() /= 0) then + if(psb_errstatus_fatal()) then info=psb_err_from_subroutine_ goto 9999 end if @@ -914,7 +914,7 @@ Contains call psb_erractionsave(err_act) info = psb_success_ - if (psb_get_errstatus() /= 0) then + if (psb_errstatus_fatal()) then info=psb_err_from_subroutine_ goto 9999 end if @@ -967,7 +967,7 @@ Contains call psb_erractionsave(err_act) info = psb_success_ - if (psb_get_errstatus() /= 0) then + if (psb_errstatus_fatal()) then info=psb_err_from_subroutine_ goto 9999 end if diff --git a/base/modules/auxil/psb_s_realloc_mod.F90 b/base/modules/auxil/psb_s_realloc_mod.F90 index f565f498b..4d29a28a7 100644 --- a/base/modules/auxil/psb_s_realloc_mod.F90 +++ b/base/modules/auxil/psb_s_realloc_mod.F90 @@ -618,7 +618,7 @@ Contains call psb_erractionsave(err_act) info=psb_success_ - if(psb_get_errstatus() /= 0) then + if(psb_errstatus_fatal()) then info=psb_err_from_subroutine_ goto 9999 end if @@ -659,7 +659,7 @@ Contains call psb_erractionsave(err_act) info=psb_success_ - if(psb_get_errstatus() /= 0) then + if(psb_errstatus_fatal()) then info=psb_err_from_subroutine_ goto 9999 end if @@ -703,7 +703,7 @@ Contains name='psb_ab_cpy_s_rk1' call psb_erractionsave(err_act) info=psb_success_ - if(psb_get_errstatus() /= 0) then + if(psb_errstatus_fatal()) then info=psb_err_from_subroutine_ goto 9999 end if @@ -747,7 +747,7 @@ Contains name='psb_ab_cpy_s_rk2' call psb_erractionsave(err_act) info=psb_success_ - if(psb_get_errstatus() /= 0) then + if(psb_errstatus_fatal()) then info=psb_err_from_subroutine_ goto 9999 end if @@ -794,7 +794,7 @@ Contains name='psb_cpy_s_rk1' call psb_erractionsave(err_act) info=psb_success_ - if(psb_get_errstatus() /= 0) then + if(psb_errstatus_fatal()) then info=psb_err_from_subroutine_ goto 9999 end if @@ -835,7 +835,7 @@ Contains name='psb_safe_cpy' call psb_erractionsave(err_act) info=psb_success_ - if(psb_get_errstatus() /= 0) then + if(psb_errstatus_fatal()) then info=psb_err_from_subroutine_ goto 9999 end if @@ -914,7 +914,7 @@ Contains call psb_erractionsave(err_act) info = psb_success_ - if (psb_get_errstatus() /= 0) then + if (psb_errstatus_fatal()) then info=psb_err_from_subroutine_ goto 9999 end if @@ -967,7 +967,7 @@ Contains call psb_erractionsave(err_act) info = psb_success_ - if (psb_get_errstatus() /= 0) then + if (psb_errstatus_fatal()) then info=psb_err_from_subroutine_ goto 9999 end if diff --git a/base/modules/auxil/psb_z_realloc_mod.F90 b/base/modules/auxil/psb_z_realloc_mod.F90 index 2d2403658..bf849a1e3 100644 --- a/base/modules/auxil/psb_z_realloc_mod.F90 +++ b/base/modules/auxil/psb_z_realloc_mod.F90 @@ -618,7 +618,7 @@ Contains call psb_erractionsave(err_act) info=psb_success_ - if(psb_get_errstatus() /= 0) then + if(psb_errstatus_fatal()) then info=psb_err_from_subroutine_ goto 9999 end if @@ -659,7 +659,7 @@ Contains call psb_erractionsave(err_act) info=psb_success_ - if(psb_get_errstatus() /= 0) then + if(psb_errstatus_fatal()) then info=psb_err_from_subroutine_ goto 9999 end if @@ -703,7 +703,7 @@ Contains name='psb_ab_cpy_z_rk1' call psb_erractionsave(err_act) info=psb_success_ - if(psb_get_errstatus() /= 0) then + if(psb_errstatus_fatal()) then info=psb_err_from_subroutine_ goto 9999 end if @@ -747,7 +747,7 @@ Contains name='psb_ab_cpy_z_rk2' call psb_erractionsave(err_act) info=psb_success_ - if(psb_get_errstatus() /= 0) then + if(psb_errstatus_fatal()) then info=psb_err_from_subroutine_ goto 9999 end if @@ -794,7 +794,7 @@ Contains name='psb_cpy_z_rk1' call psb_erractionsave(err_act) info=psb_success_ - if(psb_get_errstatus() /= 0) then + if(psb_errstatus_fatal()) then info=psb_err_from_subroutine_ goto 9999 end if @@ -835,7 +835,7 @@ Contains name='psb_safe_cpy' call psb_erractionsave(err_act) info=psb_success_ - if(psb_get_errstatus() /= 0) then + if(psb_errstatus_fatal()) then info=psb_err_from_subroutine_ goto 9999 end if @@ -914,7 +914,7 @@ Contains call psb_erractionsave(err_act) info = psb_success_ - if (psb_get_errstatus() /= 0) then + if (psb_errstatus_fatal()) then info=psb_err_from_subroutine_ goto 9999 end if @@ -967,7 +967,7 @@ Contains call psb_erractionsave(err_act) info = psb_success_ - if (psb_get_errstatus() /= 0) then + if (psb_errstatus_fatal()) then info=psb_err_from_subroutine_ goto 9999 end if diff --git a/base/psblas/psb_camax.f90 b/base/psblas/psb_camax.f90 index 9add308c4..526c5e40b 100644 --- a/base/psblas/psb_camax.f90 +++ b/base/psblas/psb_camax.f90 @@ -64,9 +64,11 @@ function psb_camax(x,desc_a, info, jx,global) result(res) character(len=20) :: name, ch_err name='psb_camax' - if(psb_get_errstatus() /= 0) return info=psb_success_ call psb_erractionsave(err_act) + if (psb_errstatus_fatal()) then + info = psb_err_internal_error_ ; goto 9999 + end if ictxt = desc_a%get_context() @@ -190,9 +192,11 @@ function psb_camaxv (x,desc_a, info,global) result(res) character(len=20) :: name, ch_err name='psb_camaxv' - if(psb_get_errstatus() /= 0) return info=psb_success_ call psb_erractionsave(err_act) + if (psb_errstatus_fatal()) then + info = psb_err_internal_error_ ; goto 9999 + end if ictxt=desc_a%get_context() @@ -272,9 +276,11 @@ function psb_camax_vect(x, desc_a, info,global) result(res) character(len=20) :: name, ch_err name='psb_camaxv' - if(psb_get_errstatus() /= 0) return info=psb_success_ call psb_erractionsave(err_act) + if (psb_errstatus_fatal()) then + info = psb_err_internal_error_ ; goto 9999 + end if ictxt=desc_a%get_context() @@ -400,9 +406,11 @@ subroutine psb_camaxvs(res,x,desc_a, info,global) character(len=20) :: name, ch_err name='psb_camaxvs' - if(psb_get_errstatus() /= 0) return info=psb_success_ call psb_erractionsave(err_act) + if (psb_errstatus_fatal()) then + info = psb_err_internal_error_ ; goto 9999 + end if ictxt = desc_a%get_context() @@ -521,9 +529,11 @@ subroutine psb_cmamaxs(res,x,desc_a, info,jx,global) character(len=20) :: name, ch_err name='psb_cmamaxs' - if (psb_get_errstatus() /= 0) return info=psb_success_ call psb_erractionsave(err_act) + if (psb_errstatus_fatal()) then + info = psb_err_internal_error_ ; goto 9999 + end if ictxt=desc_a%get_context() diff --git a/base/psblas/psb_casum.f90 b/base/psblas/psb_casum.f90 index 281c66d47..2b0beda58 100644 --- a/base/psblas/psb_casum.f90 +++ b/base/psblas/psb_casum.f90 @@ -64,9 +64,11 @@ function psb_casum (x,desc_a, info, jx,global) result(res) character(len=20) :: name, ch_err name='psb_casum' - if(psb_get_errstatus() /= 0) return info=psb_success_ call psb_erractionsave(err_act) + if (psb_errstatus_fatal()) then + info = psb_err_internal_error_ ; goto 9999 + end if ictxt=desc_a%get_context() @@ -152,7 +154,9 @@ function psb_casum_vect(x, desc_a, info,global) result(res) character(len=20) :: name, ch_err name='psb_casumv' - if (psb_errstatus_fatal()) return + if (psb_errstatus_fatal()) then + info = psb_err_internal_error_ ; goto 9999 + end if info=psb_success_ call psb_erractionsave(err_act) @@ -287,9 +291,11 @@ function psb_casumv(x,desc_a, info,global) result(res) character(len=20) :: name, ch_err name='psb_casumv' - if(psb_get_errstatus() /= 0) return info=psb_success_ call psb_erractionsave(err_act) + if (psb_errstatus_fatal()) then + info = psb_err_internal_error_ ; goto 9999 + end if ictxt=desc_a%get_context() @@ -416,9 +422,11 @@ subroutine psb_casumvs(res,x,desc_a, info,global) character(len=20) :: name, ch_err name='psb_casumvs' - if(psb_get_errstatus() /= 0) return info=psb_success_ call psb_erractionsave(err_act) + if (psb_errstatus_fatal()) then + info = psb_err_internal_error_ ; goto 9999 + end if ictxt=desc_a%get_context() diff --git a/base/psblas/psb_caxpby.f90 b/base/psblas/psb_caxpby.f90 index 622890be5..ab00bd60b 100644 --- a/base/psblas/psb_caxpby.f90 +++ b/base/psblas/psb_caxpby.f90 @@ -151,9 +151,11 @@ subroutine psb_caxpby(alpha, x, beta,y,desc_a,info, n, jx, jy) character(len=20) :: name, ch_err name='psb_geaxpby' - if(psb_get_errstatus() /= 0) return info=psb_success_ call psb_erractionsave(err_act) + if (psb_errstatus_fatal()) then + info = psb_err_internal_error_ ; goto 9999 + end if ictxt=desc_a%get_context() call psb_info(ictxt, me, np) @@ -298,9 +300,11 @@ subroutine psb_caxpbyv(alpha, x, beta,y,desc_a,info) logical, parameter :: debug=.false. name='psb_geaxpby' - if(psb_get_errstatus() /= 0) return info=psb_success_ call psb_erractionsave(err_act) + if (psb_errstatus_fatal()) then + info = psb_err_internal_error_ ; goto 9999 + end if ictxt=desc_a%get_context() diff --git a/base/psblas/psb_cdot.f90 b/base/psblas/psb_cdot.f90 index 243e4489f..39cda4312 100644 --- a/base/psblas/psb_cdot.f90 +++ b/base/psblas/psb_cdot.f90 @@ -72,9 +72,11 @@ function psb_cdot_vect(x, y, desc_a,info,global) result(res) name='psb_cdot_vect' res = czero - if (psb_errstatus_fatal()) return info=psb_success_ call psb_erractionsave(err_act) + if (psb_errstatus_fatal()) then + info = psb_err_internal_error_ ; goto 9999 + end if ictxt=desc_a%get_context() call psb_info(ictxt, me, np) @@ -175,9 +177,11 @@ function psb_cdot(x, y,desc_a, info, jx, jy,global) result(res) character(len=20) :: name, ch_err name='psb_cdot' - if(psb_get_errstatus() /= 0) return info=psb_success_ call psb_erractionsave(err_act) + if (psb_errstatus_fatal()) then + info = psb_err_internal_error_ ; goto 9999 + end if ictxt=desc_a%get_context() call psb_info(ictxt, me, np) @@ -323,9 +327,11 @@ function psb_cdotv(x, y,desc_a, info,global) result(res) character(len=20) :: name, ch_err name='psb_cdot' - if(psb_get_errstatus() /= 0) return info=psb_success_ call psb_erractionsave(err_act) + if (psb_errstatus_fatal()) then + info = psb_err_internal_error_ ; goto 9999 + end if ictxt=desc_a%get_context() @@ -456,9 +462,11 @@ subroutine psb_cdotvs(res, x, y,desc_a, info,global) character(len=20) :: name, ch_err name='psb_cdot' - if(psb_get_errstatus() /= 0) return info=psb_success_ call psb_erractionsave(err_act) + if (psb_errstatus_fatal()) then + info = psb_err_internal_error_ ; goto 9999 + end if ictxt=desc_a%get_context() @@ -587,9 +595,11 @@ subroutine psb_cmdots(res, x, y, desc_a, info,global) character(len=20) :: name, ch_err name='psb_cmdots' - if(psb_get_errstatus() /= 0) return info=psb_success_ call psb_erractionsave(err_act) + if (psb_errstatus_fatal()) then + info = psb_err_internal_error_ ; goto 9999 + end if ictxt=desc_a%get_context() diff --git a/base/psblas/psb_cnrm2.f90 b/base/psblas/psb_cnrm2.f90 index fec70a980..43ab876c8 100644 --- a/base/psblas/psb_cnrm2.f90 +++ b/base/psblas/psb_cnrm2.f90 @@ -67,9 +67,11 @@ function psb_cnrm2(x, desc_a, info, jx,global) result(res) character(len=20) :: name, ch_err name='psb_cnrm2' - if(psb_get_errstatus() /= 0) return info=psb_success_ call psb_erractionsave(err_act) + if (psb_errstatus_fatal()) then + info = psb_err_internal_error_ ; goto 9999 + end if ictxt=desc_a%get_context() @@ -199,9 +201,11 @@ function psb_cnrm2v(x, desc_a, info,global) result(res) character(len=20) :: name, ch_err name='psb_cnrm2v' - if(psb_get_errstatus() /= 0) return info=psb_success_ call psb_erractionsave(err_act) + if (psb_errstatus_fatal()) then + info = psb_err_internal_error_ ; goto 9999 + end if ictxt=desc_a%get_context() @@ -283,7 +287,9 @@ function psb_cnrm2_vect(x, desc_a, info,global) result(res) character(len=20) :: name, ch_err name='psb_cnrm2v' - if (psb_errstatus_fatal()) return + if (psb_errstatus_fatal()) then + info = psb_err_internal_error_ ; goto 9999 + end if info=psb_success_ call psb_erractionsave(err_act) @@ -418,9 +424,11 @@ subroutine psb_cnrm2vs(res, x, desc_a, info,global) character(len=20) :: name, ch_err name='psb_cnrm2' - if(psb_get_errstatus() /= 0) return info=psb_success_ call psb_erractionsave(err_act) + if (psb_errstatus_fatal()) then + info = psb_err_internal_error_ ; goto 9999 + end if ictxt=desc_a%get_context() diff --git a/base/psblas/psb_cnrmi.f90 b/base/psblas/psb_cnrmi.f90 index 07d871d80..0ac0a04bd 100644 --- a/base/psblas/psb_cnrmi.f90 +++ b/base/psblas/psb_cnrmi.f90 @@ -59,9 +59,11 @@ function psb_cnrmi(a,desc_a,info,global) result(res) character(len=20) :: name, ch_err name='psb_cnrmi' - if(psb_get_errstatus() /= 0) return info=psb_success_ call psb_erractionsave(err_act) + if (psb_errstatus_fatal()) then + info = psb_err_internal_error_ ; goto 9999 + end if ictxt=desc_a%get_context() diff --git a/base/psblas/psb_cspmm.f90 b/base/psblas/psb_cspmm.f90 index c72fb48c5..d99909c5d 100644 --- a/base/psblas/psb_cspmm.f90 +++ b/base/psblas/psb_cspmm.f90 @@ -93,9 +93,11 @@ subroutine psb_cspmm(alpha,a,x,beta,y,desc_a,info,& integer(psb_ipk_) :: debug_level, debug_unit name='psb_cspmm' - if(psb_get_errstatus() /= 0) return info=psb_success_ call psb_erractionsave(err_act) + if (psb_errstatus_fatal()) then + info = psb_err_internal_error_ ; goto 9999 + end if debug_unit = psb_get_debug_unit() debug_level = psb_get_debug_level() @@ -442,9 +444,11 @@ subroutine psb_cspmv(alpha,a,x,beta,y,desc_a,info,& integer(psb_ipk_) :: debug_level, debug_unit name='psb_cspmv' - if(psb_get_errstatus() /= 0) return info=psb_success_ call psb_erractionsave(err_act) + if (psb_errstatus_fatal()) then + info = psb_err_internal_error_ ; goto 9999 + end if debug_unit = psb_get_debug_unit() debug_level = psb_get_debug_level() @@ -699,9 +703,11 @@ subroutine psb_cspmv_vect(alpha,a,x,beta,y,desc_a,info,& integer(psb_ipk_) :: debug_level, debug_unit name='psb_cspmv' - if (psb_errstatus_fatal()) return info=psb_success_ call psb_erractionsave(err_act) + if (psb_errstatus_fatal()) then + info = psb_err_internal_error_ ; goto 9999 + end if debug_unit = psb_get_debug_unit() debug_level = psb_get_debug_level() diff --git a/base/psblas/psb_cspsm.f90 b/base/psblas/psb_cspsm.f90 index 725a06177..5d00de899 100644 --- a/base/psblas/psb_cspsm.f90 +++ b/base/psblas/psb_cspsm.f90 @@ -105,9 +105,11 @@ subroutine psb_cspsm(alpha,a,x,beta,y,desc_a,info,& logical :: aliw name='psb_cspsm' - if(psb_get_errstatus() /= 0) return info=psb_success_ call psb_erractionsave(err_act) + if (psb_errstatus_fatal()) then + info = psb_err_internal_error_ ; goto 9999 + end if ictxt=desc_a%get_context() @@ -379,9 +381,11 @@ subroutine psb_cspsv(alpha,a,x,beta,y,desc_a,info,& logical :: aliw name='psb_cspsv' - if(psb_get_errstatus() /= 0) return info=psb_success_ call psb_erractionsave(err_act) + if (psb_errstatus_fatal()) then + info = psb_err_internal_error_ ; goto 9999 + end if ictxt=desc_a%get_context() @@ -573,9 +577,11 @@ subroutine psb_cspsv_vect(alpha,a,x,beta,y,desc_a,info,& logical :: aliw name='psb_sspsv' - if (psb_errstatus_fatal()) return info=psb_success_ call psb_erractionsave(err_act) + if (psb_errstatus_fatal()) then + info = psb_err_internal_error_ ; goto 9999 + end if ictxt=desc_a%get_context() diff --git a/base/psblas/psb_damax.f90 b/base/psblas/psb_damax.f90 index 58f0a17b7..33dd2dc95 100644 --- a/base/psblas/psb_damax.f90 +++ b/base/psblas/psb_damax.f90 @@ -64,9 +64,11 @@ function psb_damax(x,desc_a, info, jx,global) result(res) character(len=20) :: name, ch_err name='psb_damax' - if(psb_get_errstatus() /= 0) return info=psb_success_ call psb_erractionsave(err_act) + if (psb_errstatus_fatal()) then + info = psb_err_internal_error_ ; goto 9999 + end if ictxt = desc_a%get_context() @@ -190,9 +192,11 @@ function psb_damaxv (x,desc_a, info,global) result(res) character(len=20) :: name, ch_err name='psb_damaxv' - if(psb_get_errstatus() /= 0) return info=psb_success_ call psb_erractionsave(err_act) + if (psb_errstatus_fatal()) then + info = psb_err_internal_error_ ; goto 9999 + end if ictxt=desc_a%get_context() @@ -272,9 +276,11 @@ function psb_damax_vect(x, desc_a, info,global) result(res) character(len=20) :: name, ch_err name='psb_damaxv' - if(psb_get_errstatus() /= 0) return info=psb_success_ call psb_erractionsave(err_act) + if (psb_errstatus_fatal()) then + info = psb_err_internal_error_ ; goto 9999 + end if ictxt=desc_a%get_context() @@ -400,9 +406,11 @@ subroutine psb_damaxvs(res,x,desc_a, info,global) character(len=20) :: name, ch_err name='psb_damaxvs' - if(psb_get_errstatus() /= 0) return info=psb_success_ call psb_erractionsave(err_act) + if (psb_errstatus_fatal()) then + info = psb_err_internal_error_ ; goto 9999 + end if ictxt = desc_a%get_context() @@ -521,9 +529,11 @@ subroutine psb_dmamaxs(res,x,desc_a, info,jx,global) character(len=20) :: name, ch_err name='psb_dmamaxs' - if (psb_get_errstatus() /= 0) return info=psb_success_ call psb_erractionsave(err_act) + if (psb_errstatus_fatal()) then + info = psb_err_internal_error_ ; goto 9999 + end if ictxt=desc_a%get_context() diff --git a/base/psblas/psb_dasum.f90 b/base/psblas/psb_dasum.f90 index 704319ec3..cf2d8fe36 100644 --- a/base/psblas/psb_dasum.f90 +++ b/base/psblas/psb_dasum.f90 @@ -64,9 +64,11 @@ function psb_dasum (x,desc_a, info, jx,global) result(res) character(len=20) :: name, ch_err name='psb_dasum' - if(psb_get_errstatus() /= 0) return info=psb_success_ call psb_erractionsave(err_act) + if (psb_errstatus_fatal()) then + info = psb_err_internal_error_ ; goto 9999 + end if ictxt=desc_a%get_context() @@ -152,7 +154,9 @@ function psb_dasum_vect(x, desc_a, info,global) result(res) character(len=20) :: name, ch_err name='psb_dasumv' - if (psb_errstatus_fatal()) return + if (psb_errstatus_fatal()) then + info = psb_err_internal_error_ ; goto 9999 + end if info=psb_success_ call psb_erractionsave(err_act) @@ -287,9 +291,11 @@ function psb_dasumv(x,desc_a, info,global) result(res) character(len=20) :: name, ch_err name='psb_dasumv' - if(psb_get_errstatus() /= 0) return info=psb_success_ call psb_erractionsave(err_act) + if (psb_errstatus_fatal()) then + info = psb_err_internal_error_ ; goto 9999 + end if ictxt=desc_a%get_context() @@ -416,9 +422,11 @@ subroutine psb_dasumvs(res,x,desc_a, info,global) character(len=20) :: name, ch_err name='psb_dasumvs' - if(psb_get_errstatus() /= 0) return info=psb_success_ call psb_erractionsave(err_act) + if (psb_errstatus_fatal()) then + info = psb_err_internal_error_ ; goto 9999 + end if ictxt=desc_a%get_context() diff --git a/base/psblas/psb_daxpby.f90 b/base/psblas/psb_daxpby.f90 index 25099c630..b1c83d3a6 100644 --- a/base/psblas/psb_daxpby.f90 +++ b/base/psblas/psb_daxpby.f90 @@ -151,9 +151,11 @@ subroutine psb_daxpby(alpha, x, beta,y,desc_a,info, n, jx, jy) character(len=20) :: name, ch_err name='psb_geaxpby' - if(psb_get_errstatus() /= 0) return info=psb_success_ call psb_erractionsave(err_act) + if (psb_errstatus_fatal()) then + info = psb_err_internal_error_ ; goto 9999 + end if ictxt=desc_a%get_context() call psb_info(ictxt, me, np) @@ -298,9 +300,11 @@ subroutine psb_daxpbyv(alpha, x, beta,y,desc_a,info) logical, parameter :: debug=.false. name='psb_geaxpby' - if(psb_get_errstatus() /= 0) return info=psb_success_ call psb_erractionsave(err_act) + if (psb_errstatus_fatal()) then + info = psb_err_internal_error_ ; goto 9999 + end if ictxt=desc_a%get_context() diff --git a/base/psblas/psb_ddot.f90 b/base/psblas/psb_ddot.f90 index 24c9f5937..c2231d8ac 100644 --- a/base/psblas/psb_ddot.f90 +++ b/base/psblas/psb_ddot.f90 @@ -72,9 +72,11 @@ function psb_ddot_vect(x, y, desc_a,info,global) result(res) name='psb_ddot_vect' res = dzero - if (psb_errstatus_fatal()) return info=psb_success_ call psb_erractionsave(err_act) + if (psb_errstatus_fatal()) then + info = psb_err_internal_error_ ; goto 9999 + end if ictxt=desc_a%get_context() call psb_info(ictxt, me, np) @@ -175,9 +177,11 @@ function psb_ddot(x, y,desc_a, info, jx, jy,global) result(res) character(len=20) :: name, ch_err name='psb_ddot' - if(psb_get_errstatus() /= 0) return info=psb_success_ call psb_erractionsave(err_act) + if (psb_errstatus_fatal()) then + info = psb_err_internal_error_ ; goto 9999 + end if ictxt=desc_a%get_context() call psb_info(ictxt, me, np) @@ -323,9 +327,11 @@ function psb_ddotv(x, y,desc_a, info,global) result(res) character(len=20) :: name, ch_err name='psb_ddot' - if(psb_get_errstatus() /= 0) return info=psb_success_ call psb_erractionsave(err_act) + if (psb_errstatus_fatal()) then + info = psb_err_internal_error_ ; goto 9999 + end if ictxt=desc_a%get_context() @@ -456,9 +462,11 @@ subroutine psb_ddotvs(res, x, y,desc_a, info,global) character(len=20) :: name, ch_err name='psb_ddot' - if(psb_get_errstatus() /= 0) return info=psb_success_ call psb_erractionsave(err_act) + if (psb_errstatus_fatal()) then + info = psb_err_internal_error_ ; goto 9999 + end if ictxt=desc_a%get_context() @@ -587,9 +595,11 @@ subroutine psb_dmdots(res, x, y, desc_a, info,global) character(len=20) :: name, ch_err name='psb_dmdots' - if(psb_get_errstatus() /= 0) return info=psb_success_ call psb_erractionsave(err_act) + if (psb_errstatus_fatal()) then + info = psb_err_internal_error_ ; goto 9999 + end if ictxt=desc_a%get_context() diff --git a/base/psblas/psb_dnrm2.f90 b/base/psblas/psb_dnrm2.f90 index 045781976..b72a72eea 100644 --- a/base/psblas/psb_dnrm2.f90 +++ b/base/psblas/psb_dnrm2.f90 @@ -67,9 +67,11 @@ function psb_dnrm2(x, desc_a, info, jx,global) result(res) character(len=20) :: name, ch_err name='psb_dnrm2' - if(psb_get_errstatus() /= 0) return info=psb_success_ call psb_erractionsave(err_act) + if (psb_errstatus_fatal()) then + info = psb_err_internal_error_ ; goto 9999 + end if ictxt=desc_a%get_context() @@ -199,9 +201,11 @@ function psb_dnrm2v(x, desc_a, info,global) result(res) character(len=20) :: name, ch_err name='psb_dnrm2v' - if(psb_get_errstatus() /= 0) return info=psb_success_ call psb_erractionsave(err_act) + if (psb_errstatus_fatal()) then + info = psb_err_internal_error_ ; goto 9999 + end if ictxt=desc_a%get_context() @@ -283,7 +287,9 @@ function psb_dnrm2_vect(x, desc_a, info,global) result(res) character(len=20) :: name, ch_err name='psb_dnrm2v' - if (psb_errstatus_fatal()) return + if (psb_errstatus_fatal()) then + info = psb_err_internal_error_ ; goto 9999 + end if info=psb_success_ call psb_erractionsave(err_act) @@ -418,9 +424,11 @@ subroutine psb_dnrm2vs(res, x, desc_a, info,global) character(len=20) :: name, ch_err name='psb_dnrm2' - if(psb_get_errstatus() /= 0) return info=psb_success_ call psb_erractionsave(err_act) + if (psb_errstatus_fatal()) then + info = psb_err_internal_error_ ; goto 9999 + end if ictxt=desc_a%get_context() diff --git a/base/psblas/psb_dnrmi.f90 b/base/psblas/psb_dnrmi.f90 index dedc14a1c..6d585981e 100644 --- a/base/psblas/psb_dnrmi.f90 +++ b/base/psblas/psb_dnrmi.f90 @@ -59,9 +59,11 @@ function psb_dnrmi(a,desc_a,info,global) result(res) character(len=20) :: name, ch_err name='psb_dnrmi' - if(psb_get_errstatus() /= 0) return info=psb_success_ call psb_erractionsave(err_act) + if (psb_errstatus_fatal()) then + info = psb_err_internal_error_ ; goto 9999 + end if ictxt=desc_a%get_context() diff --git a/base/psblas/psb_dspmm.f90 b/base/psblas/psb_dspmm.f90 index 30e793a26..edf4e32e7 100644 --- a/base/psblas/psb_dspmm.f90 +++ b/base/psblas/psb_dspmm.f90 @@ -93,9 +93,11 @@ subroutine psb_dspmm(alpha,a,x,beta,y,desc_a,info,& integer(psb_ipk_) :: debug_level, debug_unit name='psb_dspmm' - if(psb_get_errstatus() /= 0) return info=psb_success_ call psb_erractionsave(err_act) + if (psb_errstatus_fatal()) then + info = psb_err_internal_error_ ; goto 9999 + end if debug_unit = psb_get_debug_unit() debug_level = psb_get_debug_level() @@ -442,9 +444,11 @@ subroutine psb_dspmv(alpha,a,x,beta,y,desc_a,info,& integer(psb_ipk_) :: debug_level, debug_unit name='psb_dspmv' - if(psb_get_errstatus() /= 0) return info=psb_success_ call psb_erractionsave(err_act) + if (psb_errstatus_fatal()) then + info = psb_err_internal_error_ ; goto 9999 + end if debug_unit = psb_get_debug_unit() debug_level = psb_get_debug_level() @@ -699,9 +703,11 @@ subroutine psb_dspmv_vect(alpha,a,x,beta,y,desc_a,info,& integer(psb_ipk_) :: debug_level, debug_unit name='psb_dspmv' - if (psb_errstatus_fatal()) return info=psb_success_ call psb_erractionsave(err_act) + if (psb_errstatus_fatal()) then + info = psb_err_internal_error_ ; goto 9999 + end if debug_unit = psb_get_debug_unit() debug_level = psb_get_debug_level() diff --git a/base/psblas/psb_dspsm.f90 b/base/psblas/psb_dspsm.f90 index d6de2aed0..6782b22b7 100644 --- a/base/psblas/psb_dspsm.f90 +++ b/base/psblas/psb_dspsm.f90 @@ -105,9 +105,11 @@ subroutine psb_dspsm(alpha,a,x,beta,y,desc_a,info,& logical :: aliw name='psb_dspsm' - if(psb_get_errstatus() /= 0) return info=psb_success_ call psb_erractionsave(err_act) + if (psb_errstatus_fatal()) then + info = psb_err_internal_error_ ; goto 9999 + end if ictxt=desc_a%get_context() @@ -379,9 +381,11 @@ subroutine psb_dspsv(alpha,a,x,beta,y,desc_a,info,& logical :: aliw name='psb_dspsv' - if(psb_get_errstatus() /= 0) return info=psb_success_ call psb_erractionsave(err_act) + if (psb_errstatus_fatal()) then + info = psb_err_internal_error_ ; goto 9999 + end if ictxt=desc_a%get_context() @@ -573,9 +577,11 @@ subroutine psb_dspsv_vect(alpha,a,x,beta,y,desc_a,info,& logical :: aliw name='psb_sspsv' - if (psb_errstatus_fatal()) return info=psb_success_ call psb_erractionsave(err_act) + if (psb_errstatus_fatal()) then + info = psb_err_internal_error_ ; goto 9999 + end if ictxt=desc_a%get_context() diff --git a/base/psblas/psb_samax.f90 b/base/psblas/psb_samax.f90 index 3365545e1..ee70314f3 100644 --- a/base/psblas/psb_samax.f90 +++ b/base/psblas/psb_samax.f90 @@ -64,9 +64,11 @@ function psb_samax(x,desc_a, info, jx,global) result(res) character(len=20) :: name, ch_err name='psb_samax' - if(psb_get_errstatus() /= 0) return info=psb_success_ call psb_erractionsave(err_act) + if (psb_errstatus_fatal()) then + info = psb_err_internal_error_ ; goto 9999 + end if ictxt = desc_a%get_context() @@ -190,9 +192,11 @@ function psb_samaxv (x,desc_a, info,global) result(res) character(len=20) :: name, ch_err name='psb_samaxv' - if(psb_get_errstatus() /= 0) return info=psb_success_ call psb_erractionsave(err_act) + if (psb_errstatus_fatal()) then + info = psb_err_internal_error_ ; goto 9999 + end if ictxt=desc_a%get_context() @@ -272,9 +276,11 @@ function psb_samax_vect(x, desc_a, info,global) result(res) character(len=20) :: name, ch_err name='psb_samaxv' - if(psb_get_errstatus() /= 0) return info=psb_success_ call psb_erractionsave(err_act) + if (psb_errstatus_fatal()) then + info = psb_err_internal_error_ ; goto 9999 + end if ictxt=desc_a%get_context() @@ -400,9 +406,11 @@ subroutine psb_samaxvs(res,x,desc_a, info,global) character(len=20) :: name, ch_err name='psb_samaxvs' - if(psb_get_errstatus() /= 0) return info=psb_success_ call psb_erractionsave(err_act) + if (psb_errstatus_fatal()) then + info = psb_err_internal_error_ ; goto 9999 + end if ictxt = desc_a%get_context() @@ -521,9 +529,11 @@ subroutine psb_smamaxs(res,x,desc_a, info,jx,global) character(len=20) :: name, ch_err name='psb_smamaxs' - if (psb_get_errstatus() /= 0) return info=psb_success_ call psb_erractionsave(err_act) + if (psb_errstatus_fatal()) then + info = psb_err_internal_error_ ; goto 9999 + end if ictxt=desc_a%get_context() diff --git a/base/psblas/psb_sasum.f90 b/base/psblas/psb_sasum.f90 index 606b8dc91..2abf254d7 100644 --- a/base/psblas/psb_sasum.f90 +++ b/base/psblas/psb_sasum.f90 @@ -64,9 +64,11 @@ function psb_sasum (x,desc_a, info, jx,global) result(res) character(len=20) :: name, ch_err name='psb_sasum' - if(psb_get_errstatus() /= 0) return info=psb_success_ call psb_erractionsave(err_act) + if (psb_errstatus_fatal()) then + info = psb_err_internal_error_ ; goto 9999 + end if ictxt=desc_a%get_context() @@ -152,7 +154,9 @@ function psb_sasum_vect(x, desc_a, info,global) result(res) character(len=20) :: name, ch_err name='psb_sasumv' - if (psb_errstatus_fatal()) return + if (psb_errstatus_fatal()) then + info = psb_err_internal_error_ ; goto 9999 + end if info=psb_success_ call psb_erractionsave(err_act) @@ -287,9 +291,11 @@ function psb_sasumv(x,desc_a, info,global) result(res) character(len=20) :: name, ch_err name='psb_sasumv' - if(psb_get_errstatus() /= 0) return info=psb_success_ call psb_erractionsave(err_act) + if (psb_errstatus_fatal()) then + info = psb_err_internal_error_ ; goto 9999 + end if ictxt=desc_a%get_context() @@ -416,9 +422,11 @@ subroutine psb_sasumvs(res,x,desc_a, info,global) character(len=20) :: name, ch_err name='psb_sasumvs' - if(psb_get_errstatus() /= 0) return info=psb_success_ call psb_erractionsave(err_act) + if (psb_errstatus_fatal()) then + info = psb_err_internal_error_ ; goto 9999 + end if ictxt=desc_a%get_context() diff --git a/base/psblas/psb_saxpby.f90 b/base/psblas/psb_saxpby.f90 index 4219289d7..26cecd304 100644 --- a/base/psblas/psb_saxpby.f90 +++ b/base/psblas/psb_saxpby.f90 @@ -151,9 +151,11 @@ subroutine psb_saxpby(alpha, x, beta,y,desc_a,info, n, jx, jy) character(len=20) :: name, ch_err name='psb_geaxpby' - if(psb_get_errstatus() /= 0) return info=psb_success_ call psb_erractionsave(err_act) + if (psb_errstatus_fatal()) then + info = psb_err_internal_error_ ; goto 9999 + end if ictxt=desc_a%get_context() call psb_info(ictxt, me, np) @@ -298,9 +300,11 @@ subroutine psb_saxpbyv(alpha, x, beta,y,desc_a,info) logical, parameter :: debug=.false. name='psb_geaxpby' - if(psb_get_errstatus() /= 0) return info=psb_success_ call psb_erractionsave(err_act) + if (psb_errstatus_fatal()) then + info = psb_err_internal_error_ ; goto 9999 + end if ictxt=desc_a%get_context() diff --git a/base/psblas/psb_sdot.f90 b/base/psblas/psb_sdot.f90 index 30a3f76fa..2c8bea516 100644 --- a/base/psblas/psb_sdot.f90 +++ b/base/psblas/psb_sdot.f90 @@ -72,9 +72,11 @@ function psb_sdot_vect(x, y, desc_a,info,global) result(res) name='psb_sdot_vect' res = szero - if (psb_errstatus_fatal()) return info=psb_success_ call psb_erractionsave(err_act) + if (psb_errstatus_fatal()) then + info = psb_err_internal_error_ ; goto 9999 + end if ictxt=desc_a%get_context() call psb_info(ictxt, me, np) @@ -175,9 +177,11 @@ function psb_sdot(x, y,desc_a, info, jx, jy,global) result(res) character(len=20) :: name, ch_err name='psb_sdot' - if(psb_get_errstatus() /= 0) return info=psb_success_ call psb_erractionsave(err_act) + if (psb_errstatus_fatal()) then + info = psb_err_internal_error_ ; goto 9999 + end if ictxt=desc_a%get_context() call psb_info(ictxt, me, np) @@ -323,9 +327,11 @@ function psb_sdotv(x, y,desc_a, info,global) result(res) character(len=20) :: name, ch_err name='psb_sdot' - if(psb_get_errstatus() /= 0) return info=psb_success_ call psb_erractionsave(err_act) + if (psb_errstatus_fatal()) then + info = psb_err_internal_error_ ; goto 9999 + end if ictxt=desc_a%get_context() @@ -456,9 +462,11 @@ subroutine psb_sdotvs(res, x, y,desc_a, info,global) character(len=20) :: name, ch_err name='psb_sdot' - if(psb_get_errstatus() /= 0) return info=psb_success_ call psb_erractionsave(err_act) + if (psb_errstatus_fatal()) then + info = psb_err_internal_error_ ; goto 9999 + end if ictxt=desc_a%get_context() @@ -587,9 +595,11 @@ subroutine psb_smdots(res, x, y, desc_a, info,global) character(len=20) :: name, ch_err name='psb_smdots' - if(psb_get_errstatus() /= 0) return info=psb_success_ call psb_erractionsave(err_act) + if (psb_errstatus_fatal()) then + info = psb_err_internal_error_ ; goto 9999 + end if ictxt=desc_a%get_context() diff --git a/base/psblas/psb_snrm2.f90 b/base/psblas/psb_snrm2.f90 index 5fc8af8c3..d182a2cd3 100644 --- a/base/psblas/psb_snrm2.f90 +++ b/base/psblas/psb_snrm2.f90 @@ -67,9 +67,11 @@ function psb_snrm2(x, desc_a, info, jx,global) result(res) character(len=20) :: name, ch_err name='psb_snrm2' - if(psb_get_errstatus() /= 0) return info=psb_success_ call psb_erractionsave(err_act) + if (psb_errstatus_fatal()) then + info = psb_err_internal_error_ ; goto 9999 + end if ictxt=desc_a%get_context() @@ -199,9 +201,11 @@ function psb_snrm2v(x, desc_a, info,global) result(res) character(len=20) :: name, ch_err name='psb_snrm2v' - if(psb_get_errstatus() /= 0) return info=psb_success_ call psb_erractionsave(err_act) + if (psb_errstatus_fatal()) then + info = psb_err_internal_error_ ; goto 9999 + end if ictxt=desc_a%get_context() @@ -283,7 +287,9 @@ function psb_snrm2_vect(x, desc_a, info,global) result(res) character(len=20) :: name, ch_err name='psb_snrm2v' - if (psb_errstatus_fatal()) return + if (psb_errstatus_fatal()) then + info = psb_err_internal_error_ ; goto 9999 + end if info=psb_success_ call psb_erractionsave(err_act) @@ -418,9 +424,11 @@ subroutine psb_snrm2vs(res, x, desc_a, info,global) character(len=20) :: name, ch_err name='psb_snrm2' - if(psb_get_errstatus() /= 0) return info=psb_success_ call psb_erractionsave(err_act) + if (psb_errstatus_fatal()) then + info = psb_err_internal_error_ ; goto 9999 + end if ictxt=desc_a%get_context() diff --git a/base/psblas/psb_snrmi.f90 b/base/psblas/psb_snrmi.f90 index b723f57a1..07b88de2b 100644 --- a/base/psblas/psb_snrmi.f90 +++ b/base/psblas/psb_snrmi.f90 @@ -59,9 +59,11 @@ function psb_snrmi(a,desc_a,info,global) result(res) character(len=20) :: name, ch_err name='psb_snrmi' - if(psb_get_errstatus() /= 0) return info=psb_success_ call psb_erractionsave(err_act) + if (psb_errstatus_fatal()) then + info = psb_err_internal_error_ ; goto 9999 + end if ictxt=desc_a%get_context() diff --git a/base/psblas/psb_sspmm.f90 b/base/psblas/psb_sspmm.f90 index 1d6cd17d6..9fbb6d786 100644 --- a/base/psblas/psb_sspmm.f90 +++ b/base/psblas/psb_sspmm.f90 @@ -93,9 +93,11 @@ subroutine psb_sspmm(alpha,a,x,beta,y,desc_a,info,& integer(psb_ipk_) :: debug_level, debug_unit name='psb_sspmm' - if(psb_get_errstatus() /= 0) return info=psb_success_ call psb_erractionsave(err_act) + if (psb_errstatus_fatal()) then + info = psb_err_internal_error_ ; goto 9999 + end if debug_unit = psb_get_debug_unit() debug_level = psb_get_debug_level() @@ -442,9 +444,11 @@ subroutine psb_sspmv(alpha,a,x,beta,y,desc_a,info,& integer(psb_ipk_) :: debug_level, debug_unit name='psb_sspmv' - if(psb_get_errstatus() /= 0) return info=psb_success_ call psb_erractionsave(err_act) + if (psb_errstatus_fatal()) then + info = psb_err_internal_error_ ; goto 9999 + end if debug_unit = psb_get_debug_unit() debug_level = psb_get_debug_level() @@ -699,9 +703,11 @@ subroutine psb_sspmv_vect(alpha,a,x,beta,y,desc_a,info,& integer(psb_ipk_) :: debug_level, debug_unit name='psb_sspmv' - if (psb_errstatus_fatal()) return info=psb_success_ call psb_erractionsave(err_act) + if (psb_errstatus_fatal()) then + info = psb_err_internal_error_ ; goto 9999 + end if debug_unit = psb_get_debug_unit() debug_level = psb_get_debug_level() diff --git a/base/psblas/psb_sspsm.f90 b/base/psblas/psb_sspsm.f90 index b91b22578..418b70402 100644 --- a/base/psblas/psb_sspsm.f90 +++ b/base/psblas/psb_sspsm.f90 @@ -105,9 +105,11 @@ subroutine psb_sspsm(alpha,a,x,beta,y,desc_a,info,& logical :: aliw name='psb_sspsm' - if(psb_get_errstatus() /= 0) return info=psb_success_ call psb_erractionsave(err_act) + if (psb_errstatus_fatal()) then + info = psb_err_internal_error_ ; goto 9999 + end if ictxt=desc_a%get_context() @@ -379,9 +381,11 @@ subroutine psb_sspsv(alpha,a,x,beta,y,desc_a,info,& logical :: aliw name='psb_sspsv' - if(psb_get_errstatus() /= 0) return info=psb_success_ call psb_erractionsave(err_act) + if (psb_errstatus_fatal()) then + info = psb_err_internal_error_ ; goto 9999 + end if ictxt=desc_a%get_context() @@ -573,9 +577,11 @@ subroutine psb_sspsv_vect(alpha,a,x,beta,y,desc_a,info,& logical :: aliw name='psb_sspsv' - if (psb_errstatus_fatal()) return info=psb_success_ call psb_erractionsave(err_act) + if (psb_errstatus_fatal()) then + info = psb_err_internal_error_ ; goto 9999 + end if ictxt=desc_a%get_context() diff --git a/base/psblas/psb_zamax.f90 b/base/psblas/psb_zamax.f90 index b3bb88598..21a82b393 100644 --- a/base/psblas/psb_zamax.f90 +++ b/base/psblas/psb_zamax.f90 @@ -64,9 +64,11 @@ function psb_zamax(x,desc_a, info, jx,global) result(res) character(len=20) :: name, ch_err name='psb_zamax' - if(psb_get_errstatus() /= 0) return info=psb_success_ call psb_erractionsave(err_act) + if (psb_errstatus_fatal()) then + info = psb_err_internal_error_ ; goto 9999 + end if ictxt = desc_a%get_context() @@ -190,9 +192,11 @@ function psb_zamaxv (x,desc_a, info,global) result(res) character(len=20) :: name, ch_err name='psb_zamaxv' - if(psb_get_errstatus() /= 0) return info=psb_success_ call psb_erractionsave(err_act) + if (psb_errstatus_fatal()) then + info = psb_err_internal_error_ ; goto 9999 + end if ictxt=desc_a%get_context() @@ -272,9 +276,11 @@ function psb_zamax_vect(x, desc_a, info,global) result(res) character(len=20) :: name, ch_err name='psb_zamaxv' - if(psb_get_errstatus() /= 0) return info=psb_success_ call psb_erractionsave(err_act) + if (psb_errstatus_fatal()) then + info = psb_err_internal_error_ ; goto 9999 + end if ictxt=desc_a%get_context() @@ -400,9 +406,11 @@ subroutine psb_zamaxvs(res,x,desc_a, info,global) character(len=20) :: name, ch_err name='psb_zamaxvs' - if(psb_get_errstatus() /= 0) return info=psb_success_ call psb_erractionsave(err_act) + if (psb_errstatus_fatal()) then + info = psb_err_internal_error_ ; goto 9999 + end if ictxt = desc_a%get_context() @@ -521,9 +529,11 @@ subroutine psb_zmamaxs(res,x,desc_a, info,jx,global) character(len=20) :: name, ch_err name='psb_zmamaxs' - if (psb_get_errstatus() /= 0) return info=psb_success_ call psb_erractionsave(err_act) + if (psb_errstatus_fatal()) then + info = psb_err_internal_error_ ; goto 9999 + end if ictxt=desc_a%get_context() diff --git a/base/psblas/psb_zasum.f90 b/base/psblas/psb_zasum.f90 index e33c8cee2..6bfd01caf 100644 --- a/base/psblas/psb_zasum.f90 +++ b/base/psblas/psb_zasum.f90 @@ -64,9 +64,11 @@ function psb_zasum (x,desc_a, info, jx,global) result(res) character(len=20) :: name, ch_err name='psb_zasum' - if(psb_get_errstatus() /= 0) return info=psb_success_ call psb_erractionsave(err_act) + if (psb_errstatus_fatal()) then + info = psb_err_internal_error_ ; goto 9999 + end if ictxt=desc_a%get_context() @@ -152,7 +154,9 @@ function psb_zasum_vect(x, desc_a, info,global) result(res) character(len=20) :: name, ch_err name='psb_zasumv' - if (psb_errstatus_fatal()) return + if (psb_errstatus_fatal()) then + info = psb_err_internal_error_ ; goto 9999 + end if info=psb_success_ call psb_erractionsave(err_act) @@ -287,9 +291,11 @@ function psb_zasumv(x,desc_a, info,global) result(res) character(len=20) :: name, ch_err name='psb_zasumv' - if(psb_get_errstatus() /= 0) return info=psb_success_ call psb_erractionsave(err_act) + if (psb_errstatus_fatal()) then + info = psb_err_internal_error_ ; goto 9999 + end if ictxt=desc_a%get_context() @@ -416,9 +422,11 @@ subroutine psb_zasumvs(res,x,desc_a, info,global) character(len=20) :: name, ch_err name='psb_zasumvs' - if(psb_get_errstatus() /= 0) return info=psb_success_ call psb_erractionsave(err_act) + if (psb_errstatus_fatal()) then + info = psb_err_internal_error_ ; goto 9999 + end if ictxt=desc_a%get_context() diff --git a/base/psblas/psb_zaxpby.f90 b/base/psblas/psb_zaxpby.f90 index a2e742dff..273aa8823 100644 --- a/base/psblas/psb_zaxpby.f90 +++ b/base/psblas/psb_zaxpby.f90 @@ -151,9 +151,11 @@ subroutine psb_zaxpby(alpha, x, beta,y,desc_a,info, n, jx, jy) character(len=20) :: name, ch_err name='psb_geaxpby' - if(psb_get_errstatus() /= 0) return info=psb_success_ call psb_erractionsave(err_act) + if (psb_errstatus_fatal()) then + info = psb_err_internal_error_ ; goto 9999 + end if ictxt=desc_a%get_context() call psb_info(ictxt, me, np) @@ -298,9 +300,11 @@ subroutine psb_zaxpbyv(alpha, x, beta,y,desc_a,info) logical, parameter :: debug=.false. name='psb_geaxpby' - if(psb_get_errstatus() /= 0) return info=psb_success_ call psb_erractionsave(err_act) + if (psb_errstatus_fatal()) then + info = psb_err_internal_error_ ; goto 9999 + end if ictxt=desc_a%get_context() diff --git a/base/psblas/psb_zdot.f90 b/base/psblas/psb_zdot.f90 index fd33ca1e4..8f673c023 100644 --- a/base/psblas/psb_zdot.f90 +++ b/base/psblas/psb_zdot.f90 @@ -72,9 +72,11 @@ function psb_zdot_vect(x, y, desc_a,info,global) result(res) name='psb_zdot_vect' res = zzero - if (psb_errstatus_fatal()) return info=psb_success_ call psb_erractionsave(err_act) + if (psb_errstatus_fatal()) then + info = psb_err_internal_error_ ; goto 9999 + end if ictxt=desc_a%get_context() call psb_info(ictxt, me, np) @@ -175,9 +177,11 @@ function psb_zdot(x, y,desc_a, info, jx, jy,global) result(res) character(len=20) :: name, ch_err name='psb_zdot' - if(psb_get_errstatus() /= 0) return info=psb_success_ call psb_erractionsave(err_act) + if (psb_errstatus_fatal()) then + info = psb_err_internal_error_ ; goto 9999 + end if ictxt=desc_a%get_context() call psb_info(ictxt, me, np) @@ -323,9 +327,11 @@ function psb_zdotv(x, y,desc_a, info,global) result(res) character(len=20) :: name, ch_err name='psb_zdot' - if(psb_get_errstatus() /= 0) return info=psb_success_ call psb_erractionsave(err_act) + if (psb_errstatus_fatal()) then + info = psb_err_internal_error_ ; goto 9999 + end if ictxt=desc_a%get_context() @@ -456,9 +462,11 @@ subroutine psb_zdotvs(res, x, y,desc_a, info,global) character(len=20) :: name, ch_err name='psb_zdot' - if(psb_get_errstatus() /= 0) return info=psb_success_ call psb_erractionsave(err_act) + if (psb_errstatus_fatal()) then + info = psb_err_internal_error_ ; goto 9999 + end if ictxt=desc_a%get_context() @@ -587,9 +595,11 @@ subroutine psb_zmdots(res, x, y, desc_a, info,global) character(len=20) :: name, ch_err name='psb_zmdots' - if(psb_get_errstatus() /= 0) return info=psb_success_ call psb_erractionsave(err_act) + if (psb_errstatus_fatal()) then + info = psb_err_internal_error_ ; goto 9999 + end if ictxt=desc_a%get_context() diff --git a/base/psblas/psb_znrm2.f90 b/base/psblas/psb_znrm2.f90 index 27aad0b25..1e1cac262 100644 --- a/base/psblas/psb_znrm2.f90 +++ b/base/psblas/psb_znrm2.f90 @@ -67,9 +67,11 @@ function psb_znrm2(x, desc_a, info, jx,global) result(res) character(len=20) :: name, ch_err name='psb_znrm2' - if(psb_get_errstatus() /= 0) return info=psb_success_ call psb_erractionsave(err_act) + if (psb_errstatus_fatal()) then + info = psb_err_internal_error_ ; goto 9999 + end if ictxt=desc_a%get_context() @@ -199,9 +201,11 @@ function psb_znrm2v(x, desc_a, info,global) result(res) character(len=20) :: name, ch_err name='psb_znrm2v' - if(psb_get_errstatus() /= 0) return info=psb_success_ call psb_erractionsave(err_act) + if (psb_errstatus_fatal()) then + info = psb_err_internal_error_ ; goto 9999 + end if ictxt=desc_a%get_context() @@ -283,7 +287,9 @@ function psb_znrm2_vect(x, desc_a, info,global) result(res) character(len=20) :: name, ch_err name='psb_znrm2v' - if (psb_errstatus_fatal()) return + if (psb_errstatus_fatal()) then + info = psb_err_internal_error_ ; goto 9999 + end if info=psb_success_ call psb_erractionsave(err_act) @@ -418,9 +424,11 @@ subroutine psb_znrm2vs(res, x, desc_a, info,global) character(len=20) :: name, ch_err name='psb_znrm2' - if(psb_get_errstatus() /= 0) return info=psb_success_ call psb_erractionsave(err_act) + if (psb_errstatus_fatal()) then + info = psb_err_internal_error_ ; goto 9999 + end if ictxt=desc_a%get_context() diff --git a/base/psblas/psb_znrmi.f90 b/base/psblas/psb_znrmi.f90 index 3342de430..9e0440ffa 100644 --- a/base/psblas/psb_znrmi.f90 +++ b/base/psblas/psb_znrmi.f90 @@ -59,9 +59,11 @@ function psb_znrmi(a,desc_a,info,global) result(res) character(len=20) :: name, ch_err name='psb_znrmi' - if(psb_get_errstatus() /= 0) return info=psb_success_ call psb_erractionsave(err_act) + if (psb_errstatus_fatal()) then + info = psb_err_internal_error_ ; goto 9999 + end if ictxt=desc_a%get_context() diff --git a/base/psblas/psb_zspmm.f90 b/base/psblas/psb_zspmm.f90 index f608b333b..b2470b2b5 100644 --- a/base/psblas/psb_zspmm.f90 +++ b/base/psblas/psb_zspmm.f90 @@ -93,9 +93,11 @@ subroutine psb_zspmm(alpha,a,x,beta,y,desc_a,info,& integer(psb_ipk_) :: debug_level, debug_unit name='psb_zspmm' - if(psb_get_errstatus() /= 0) return info=psb_success_ call psb_erractionsave(err_act) + if (psb_errstatus_fatal()) then + info = psb_err_internal_error_ ; goto 9999 + end if debug_unit = psb_get_debug_unit() debug_level = psb_get_debug_level() @@ -442,9 +444,11 @@ subroutine psb_zspmv(alpha,a,x,beta,y,desc_a,info,& integer(psb_ipk_) :: debug_level, debug_unit name='psb_zspmv' - if(psb_get_errstatus() /= 0) return info=psb_success_ call psb_erractionsave(err_act) + if (psb_errstatus_fatal()) then + info = psb_err_internal_error_ ; goto 9999 + end if debug_unit = psb_get_debug_unit() debug_level = psb_get_debug_level() @@ -699,9 +703,11 @@ subroutine psb_zspmv_vect(alpha,a,x,beta,y,desc_a,info,& integer(psb_ipk_) :: debug_level, debug_unit name='psb_zspmv' - if (psb_errstatus_fatal()) return info=psb_success_ call psb_erractionsave(err_act) + if (psb_errstatus_fatal()) then + info = psb_err_internal_error_ ; goto 9999 + end if debug_unit = psb_get_debug_unit() debug_level = psb_get_debug_level() diff --git a/base/psblas/psb_zspsm.f90 b/base/psblas/psb_zspsm.f90 index 6dad2031a..9e7f10645 100644 --- a/base/psblas/psb_zspsm.f90 +++ b/base/psblas/psb_zspsm.f90 @@ -105,9 +105,11 @@ subroutine psb_zspsm(alpha,a,x,beta,y,desc_a,info,& logical :: aliw name='psb_zspsm' - if(psb_get_errstatus() /= 0) return info=psb_success_ call psb_erractionsave(err_act) + if (psb_errstatus_fatal()) then + info = psb_err_internal_error_ ; goto 9999 + end if ictxt=desc_a%get_context() @@ -379,9 +381,11 @@ subroutine psb_zspsv(alpha,a,x,beta,y,desc_a,info,& logical :: aliw name='psb_zspsv' - if(psb_get_errstatus() /= 0) return info=psb_success_ call psb_erractionsave(err_act) + if (psb_errstatus_fatal()) then + info = psb_err_internal_error_ ; goto 9999 + end if ictxt=desc_a%get_context() @@ -573,9 +577,11 @@ subroutine psb_zspsv_vect(alpha,a,x,beta,y,desc_a,info,& logical :: aliw name='psb_sspsv' - if (psb_errstatus_fatal()) return info=psb_success_ call psb_erractionsave(err_act) + if (psb_errstatus_fatal()) then + info = psb_err_internal_error_ ; goto 9999 + end if ictxt=desc_a%get_context() diff --git a/base/serial/psi_c_serial_impl.f90 b/base/serial/psi_c_serial_impl.f90 index 4794c38e6..77841b762 100644 --- a/base/serial/psi_c_serial_impl.f90 +++ b/base/serial/psi_c_serial_impl.f90 @@ -45,9 +45,11 @@ subroutine psi_caxpby(m,n,alpha, x, beta, y, info) character(len=20) :: name, ch_err name='psb_geaxpby' - if(psb_get_errstatus() /= 0) return info=psb_success_ call psb_erractionsave(err_act) + if (psb_errstatus_fatal()) then + info = psb_err_internal_error_ ; goto 9999 + end if if (m < 0) then info = psb_err_iarg_neg_ @@ -102,9 +104,11 @@ subroutine psi_caxpbyv(m,alpha, x, beta, y, info) character(len=20) :: name, ch_err name='psb_geaxpby' - if(psb_get_errstatus() /= 0) return info=psb_success_ call psb_erractionsave(err_act) + if (psb_errstatus_fatal()) then + info = psb_err_internal_error_ ; goto 9999 + end if if (m < 0) then info = psb_err_iarg_neg_ diff --git a/base/serial/psi_d_serial_impl.f90 b/base/serial/psi_d_serial_impl.f90 index 71f62cd57..0e1904f1e 100644 --- a/base/serial/psi_d_serial_impl.f90 +++ b/base/serial/psi_d_serial_impl.f90 @@ -45,9 +45,11 @@ subroutine psi_daxpby(m,n,alpha, x, beta, y, info) character(len=20) :: name, ch_err name='psb_geaxpby' - if(psb_get_errstatus() /= 0) return info=psb_success_ call psb_erractionsave(err_act) + if (psb_errstatus_fatal()) then + info = psb_err_internal_error_ ; goto 9999 + end if if (m < 0) then info = psb_err_iarg_neg_ @@ -102,9 +104,11 @@ subroutine psi_daxpbyv(m,alpha, x, beta, y, info) character(len=20) :: name, ch_err name='psb_geaxpby' - if(psb_get_errstatus() /= 0) return info=psb_success_ call psb_erractionsave(err_act) + if (psb_errstatus_fatal()) then + info = psb_err_internal_error_ ; goto 9999 + end if if (m < 0) then info = psb_err_iarg_neg_ diff --git a/base/serial/psi_e_serial_impl.f90 b/base/serial/psi_e_serial_impl.f90 index e226e3c62..9f1986511 100644 --- a/base/serial/psi_e_serial_impl.f90 +++ b/base/serial/psi_e_serial_impl.f90 @@ -45,9 +45,11 @@ subroutine psi_eaxpby(m,n,alpha, x, beta, y, info) character(len=20) :: name, ch_err name='psb_geaxpby' - if(psb_get_errstatus() /= 0) return info=psb_success_ call psb_erractionsave(err_act) + if (psb_errstatus_fatal()) then + info = psb_err_internal_error_ ; goto 9999 + end if if (m < 0) then info = psb_err_iarg_neg_ @@ -102,9 +104,11 @@ subroutine psi_eaxpbyv(m,alpha, x, beta, y, info) character(len=20) :: name, ch_err name='psb_geaxpby' - if(psb_get_errstatus() /= 0) return info=psb_success_ call psb_erractionsave(err_act) + if (psb_errstatus_fatal()) then + info = psb_err_internal_error_ ; goto 9999 + end if if (m < 0) then info = psb_err_iarg_neg_ diff --git a/base/serial/psi_m_serial_impl.f90 b/base/serial/psi_m_serial_impl.f90 index a00ef6f53..a885f2bd6 100644 --- a/base/serial/psi_m_serial_impl.f90 +++ b/base/serial/psi_m_serial_impl.f90 @@ -45,9 +45,11 @@ subroutine psi_maxpby(m,n,alpha, x, beta, y, info) character(len=20) :: name, ch_err name='psb_geaxpby' - if(psb_get_errstatus() /= 0) return info=psb_success_ call psb_erractionsave(err_act) + if (psb_errstatus_fatal()) then + info = psb_err_internal_error_ ; goto 9999 + end if if (m < 0) then info = psb_err_iarg_neg_ @@ -102,9 +104,11 @@ subroutine psi_maxpbyv(m,alpha, x, beta, y, info) character(len=20) :: name, ch_err name='psb_geaxpby' - if(psb_get_errstatus() /= 0) return info=psb_success_ call psb_erractionsave(err_act) + if (psb_errstatus_fatal()) then + info = psb_err_internal_error_ ; goto 9999 + end if if (m < 0) then info = psb_err_iarg_neg_ diff --git a/base/serial/psi_s_serial_impl.f90 b/base/serial/psi_s_serial_impl.f90 index cba561283..f9b837279 100644 --- a/base/serial/psi_s_serial_impl.f90 +++ b/base/serial/psi_s_serial_impl.f90 @@ -45,9 +45,11 @@ subroutine psi_saxpby(m,n,alpha, x, beta, y, info) character(len=20) :: name, ch_err name='psb_geaxpby' - if(psb_get_errstatus() /= 0) return info=psb_success_ call psb_erractionsave(err_act) + if (psb_errstatus_fatal()) then + info = psb_err_internal_error_ ; goto 9999 + end if if (m < 0) then info = psb_err_iarg_neg_ @@ -102,9 +104,11 @@ subroutine psi_saxpbyv(m,alpha, x, beta, y, info) character(len=20) :: name, ch_err name='psb_geaxpby' - if(psb_get_errstatus() /= 0) return info=psb_success_ call psb_erractionsave(err_act) + if (psb_errstatus_fatal()) then + info = psb_err_internal_error_ ; goto 9999 + end if if (m < 0) then info = psb_err_iarg_neg_ diff --git a/base/serial/psi_z_serial_impl.f90 b/base/serial/psi_z_serial_impl.f90 index 9444f6c52..8d9454304 100644 --- a/base/serial/psi_z_serial_impl.f90 +++ b/base/serial/psi_z_serial_impl.f90 @@ -45,9 +45,11 @@ subroutine psi_zaxpby(m,n,alpha, x, beta, y, info) character(len=20) :: name, ch_err name='psb_geaxpby' - if(psb_get_errstatus() /= 0) return info=psb_success_ call psb_erractionsave(err_act) + if (psb_errstatus_fatal()) then + info = psb_err_internal_error_ ; goto 9999 + end if if (m < 0) then info = psb_err_iarg_neg_ @@ -102,9 +104,11 @@ subroutine psi_zaxpbyv(m,alpha, x, beta, y, info) character(len=20) :: name, ch_err name='psb_geaxpby' - if(psb_get_errstatus() /= 0) return info=psb_success_ call psb_erractionsave(err_act) + if (psb_errstatus_fatal()) then + info = psb_err_internal_error_ ; goto 9999 + end if if (m < 0) then info = psb_err_iarg_neg_ diff --git a/base/tools/psb_callc_a.f90 b/base/tools/psb_callc_a.f90 index 28a5d39ce..df3a41b18 100644 --- a/base/tools/psb_callc_a.f90 +++ b/base/tools/psb_callc_a.f90 @@ -60,10 +60,12 @@ subroutine psb_calloc(x, desc_a, info, n, lb) character(len=20) :: name name='psb_geall' - if(psb_get_errstatus() /= 0) return info = psb_success_ err = 0 call psb_erractionsave(err_act) + if (psb_errstatus_fatal()) then + info = psb_err_internal_error_ ; goto 9999 + end if ictxt=desc_a%get_context() @@ -185,10 +187,12 @@ subroutine psb_callocv(x, desc_a,info,n) integer(psb_ipk_) :: debug_level, debug_unit character(len=20) :: name - if(psb_get_errstatus() /= 0) return info=psb_success_ name='psb_geall' call psb_erractionsave(err_act) + if (psb_errstatus_fatal()) then + info = psb_err_internal_error_ ; goto 9999 + end if debug_unit = psb_get_debug_unit() debug_level = psb_get_debug_level() diff --git a/base/tools/psb_casb_a.f90 b/base/tools/psb_casb_a.f90 index c1825eb74..5d4e4d6a6 100644 --- a/base/tools/psb_casb_a.f90 +++ b/base/tools/psb_casb_a.f90 @@ -58,10 +58,12 @@ subroutine psb_casb(x, desc_a, info, scratch) logical :: scratch_ character(len=20) :: name, ch_err - if(psb_get_errstatus() /= 0) return info=psb_success_ name='psb_cgeasb_m' call psb_erractionsave(err_act) + if (psb_errstatus_fatal()) then + info = psb_err_internal_error_ ; goto 9999 + end if debug_unit = psb_get_debug_unit() debug_level = psb_get_debug_level() scratch_ = .false. @@ -194,6 +196,10 @@ subroutine psb_casbv(x, desc_a, info, scratch) info = psb_success_ name = 'psb_cgeasb_v' + call psb_erractionsave(err_act) + if (psb_errstatus_fatal()) then + info = psb_err_internal_error_ ; goto 9999 + end if ictxt = desc_a%get_context() debug_unit = psb_get_debug_unit() diff --git a/base/tools/psb_cfree_a.f90 b/base/tools/psb_cfree_a.f90 index 49ab1810e..38621be44 100644 --- a/base/tools/psb_cfree_a.f90 +++ b/base/tools/psb_cfree_a.f90 @@ -51,11 +51,13 @@ subroutine psb_cfree(x, desc_a, info) integer(psb_ipk_) :: ictxt,np,me, err_act character(len=20) :: name - - if(psb_get_errstatus() /= 0) return + name='psb_cfree' info=psb_success_ call psb_erractionsave(err_act) - name='psb_cfree' + if (psb_errstatus_fatal()) then + info = psb_err_internal_error_ ; goto 9999 + end if + if (.not.psb_is_ok_desc(desc_a)) then info=psb_err_forgot_spall_ call psb_errpush(info,name) @@ -117,12 +119,12 @@ subroutine psb_cfreev(x, desc_a, info) integer(psb_ipk_) :: ictxt,np,me, err_act character(len=20) :: name - - if(psb_get_errstatus() /= 0) return + name='psb_cfreev' info=psb_success_ call psb_erractionsave(err_act) - name='psb_cfreev' - + if (psb_errstatus_fatal()) then + info = psb_err_internal_error_ ; goto 9999 + end if if (.not.psb_is_ok_desc(desc_a)) then info=psb_err_forgot_spall_ diff --git a/base/tools/psb_cins_a.f90 b/base/tools/psb_cins_a.f90 index cc2aeb71c..6e67a0e65 100644 --- a/base/tools/psb_cins_a.f90 +++ b/base/tools/psb_cins_a.f90 @@ -73,10 +73,12 @@ subroutine psb_cinsvi(m, irw, val, x, desc_a, info, dupl,local) logical :: local_ character(len=20) :: name - if(psb_get_errstatus() /= 0) return + name = 'psb_cinsvi' info=psb_success_ call psb_erractionsave(err_act) - name = 'psb_cinsvi' + if (psb_errstatus_fatal()) then + info = psb_err_internal_error_ ; goto 9999 + end if if (.not.desc_a%is_ok()) then info = psb_err_invalid_cd_state_ @@ -251,10 +253,12 @@ subroutine psb_cinsi(m, irw, val, x, desc_a, info, dupl,local) logical :: local_ character(len=20) :: name - if(psb_get_errstatus() /= 0) return + name = 'psb_cinsi' info = psb_success_ call psb_erractionsave(err_act) - name = 'psb_cinsi' + if (psb_errstatus_fatal()) then + info = psb_err_internal_error_ ; goto 9999 + end if if (.not.desc_a%is_ok()) then info = psb_err_invalid_cd_state_ diff --git a/base/tools/psb_cspalloc.f90 b/base/tools/psb_cspalloc.f90 index be100ceb5..b67aeede5 100644 --- a/base/tools/psb_cspalloc.f90 +++ b/base/tools/psb_cspalloc.f90 @@ -58,9 +58,11 @@ subroutine psb_cspalloc(a, desc_a, info, nnz) integer(psb_ipk_) :: debug_level, debug_unit character(len=20) :: name - if(psb_get_errstatus() /= 0) return info=psb_success_ call psb_erractionsave(err_act) + if (psb_errstatus_fatal()) then + info = psb_err_internal_error_ ; goto 9999 + end if name = 'psb_cspall' debug_unit = psb_get_debug_unit() debug_level = psb_get_debug_level() diff --git a/base/tools/psb_cspfree.f90 b/base/tools/psb_cspfree.f90 index e501f597b..6defa911e 100644 --- a/base/tools/psb_cspfree.f90 +++ b/base/tools/psb_cspfree.f90 @@ -51,10 +51,12 @@ subroutine psb_cspfree(a, desc_a,info) integer(psb_ipk_) :: ictxt, err_act character(len=20) :: name - if(psb_get_errstatus() /= 0) return info=psb_success_ name = 'psb_cspfree' call psb_erractionsave(err_act) + if (psb_errstatus_fatal()) then + info = psb_err_internal_error_ ; goto 9999 + end if if (.not.psb_is_ok_desc(desc_a)) then info = psb_err_forgot_spall_ diff --git a/base/tools/psb_csphalo.F90 b/base/tools/psb_csphalo.F90 index aeac2a3ec..520f0f662 100644 --- a/base/tools/psb_csphalo.F90 +++ b/base/tools/psb_csphalo.F90 @@ -101,10 +101,12 @@ Subroutine psb_csphalo(a,desc_a,blk,info,rowcnv,colcnv,& integer(psb_ipk_) :: debug_level, debug_unit character(len=20) :: name, ch_err - if(psb_get_errstatus() /= 0) return info=psb_success_ name='psb_csphalo' call psb_erractionsave(err_act) + if (psb_errstatus_fatal()) then + info = psb_err_internal_error_ ; goto 9999 + end if debug_unit = psb_get_debug_unit() debug_level = psb_get_debug_level() diff --git a/base/tools/psb_dallc_a.f90 b/base/tools/psb_dallc_a.f90 index 5be99bf81..b9fcf1147 100644 --- a/base/tools/psb_dallc_a.f90 +++ b/base/tools/psb_dallc_a.f90 @@ -60,10 +60,12 @@ subroutine psb_dalloc(x, desc_a, info, n, lb) character(len=20) :: name name='psb_geall' - if(psb_get_errstatus() /= 0) return info = psb_success_ err = 0 call psb_erractionsave(err_act) + if (psb_errstatus_fatal()) then + info = psb_err_internal_error_ ; goto 9999 + end if ictxt=desc_a%get_context() @@ -185,10 +187,12 @@ subroutine psb_dallocv(x, desc_a,info,n) integer(psb_ipk_) :: debug_level, debug_unit character(len=20) :: name - if(psb_get_errstatus() /= 0) return info=psb_success_ name='psb_geall' call psb_erractionsave(err_act) + if (psb_errstatus_fatal()) then + info = psb_err_internal_error_ ; goto 9999 + end if debug_unit = psb_get_debug_unit() debug_level = psb_get_debug_level() diff --git a/base/tools/psb_dasb_a.f90 b/base/tools/psb_dasb_a.f90 index dcf75960d..42a60fbf1 100644 --- a/base/tools/psb_dasb_a.f90 +++ b/base/tools/psb_dasb_a.f90 @@ -58,10 +58,12 @@ subroutine psb_dasb(x, desc_a, info, scratch) logical :: scratch_ character(len=20) :: name, ch_err - if(psb_get_errstatus() /= 0) return info=psb_success_ name='psb_dgeasb_m' call psb_erractionsave(err_act) + if (psb_errstatus_fatal()) then + info = psb_err_internal_error_ ; goto 9999 + end if debug_unit = psb_get_debug_unit() debug_level = psb_get_debug_level() scratch_ = .false. @@ -194,6 +196,10 @@ subroutine psb_dasbv(x, desc_a, info, scratch) info = psb_success_ name = 'psb_dgeasb_v' + call psb_erractionsave(err_act) + if (psb_errstatus_fatal()) then + info = psb_err_internal_error_ ; goto 9999 + end if ictxt = desc_a%get_context() debug_unit = psb_get_debug_unit() diff --git a/base/tools/psb_dfree_a.f90 b/base/tools/psb_dfree_a.f90 index 9ba912f6b..a33c41be3 100644 --- a/base/tools/psb_dfree_a.f90 +++ b/base/tools/psb_dfree_a.f90 @@ -51,11 +51,13 @@ subroutine psb_dfree(x, desc_a, info) integer(psb_ipk_) :: ictxt,np,me, err_act character(len=20) :: name - - if(psb_get_errstatus() /= 0) return + name='psb_dfree' info=psb_success_ call psb_erractionsave(err_act) - name='psb_dfree' + if (psb_errstatus_fatal()) then + info = psb_err_internal_error_ ; goto 9999 + end if + if (.not.psb_is_ok_desc(desc_a)) then info=psb_err_forgot_spall_ call psb_errpush(info,name) @@ -117,12 +119,12 @@ subroutine psb_dfreev(x, desc_a, info) integer(psb_ipk_) :: ictxt,np,me, err_act character(len=20) :: name - - if(psb_get_errstatus() /= 0) return + name='psb_dfreev' info=psb_success_ call psb_erractionsave(err_act) - name='psb_dfreev' - + if (psb_errstatus_fatal()) then + info = psb_err_internal_error_ ; goto 9999 + end if if (.not.psb_is_ok_desc(desc_a)) then info=psb_err_forgot_spall_ diff --git a/base/tools/psb_dins_a.f90 b/base/tools/psb_dins_a.f90 index f2c5e0eab..9aee33bd8 100644 --- a/base/tools/psb_dins_a.f90 +++ b/base/tools/psb_dins_a.f90 @@ -73,10 +73,12 @@ subroutine psb_dinsvi(m, irw, val, x, desc_a, info, dupl,local) logical :: local_ character(len=20) :: name - if(psb_get_errstatus() /= 0) return + name = 'psb_dinsvi' info=psb_success_ call psb_erractionsave(err_act) - name = 'psb_dinsvi' + if (psb_errstatus_fatal()) then + info = psb_err_internal_error_ ; goto 9999 + end if if (.not.desc_a%is_ok()) then info = psb_err_invalid_cd_state_ @@ -251,10 +253,12 @@ subroutine psb_dinsi(m, irw, val, x, desc_a, info, dupl,local) logical :: local_ character(len=20) :: name - if(psb_get_errstatus() /= 0) return + name = 'psb_dinsi' info = psb_success_ call psb_erractionsave(err_act) - name = 'psb_dinsi' + if (psb_errstatus_fatal()) then + info = psb_err_internal_error_ ; goto 9999 + end if if (.not.desc_a%is_ok()) then info = psb_err_invalid_cd_state_ diff --git a/base/tools/psb_dspalloc.f90 b/base/tools/psb_dspalloc.f90 index e201e2197..9ae4572ac 100644 --- a/base/tools/psb_dspalloc.f90 +++ b/base/tools/psb_dspalloc.f90 @@ -58,9 +58,11 @@ subroutine psb_dspalloc(a, desc_a, info, nnz) integer(psb_ipk_) :: debug_level, debug_unit character(len=20) :: name - if(psb_get_errstatus() /= 0) return info=psb_success_ call psb_erractionsave(err_act) + if (psb_errstatus_fatal()) then + info = psb_err_internal_error_ ; goto 9999 + end if name = 'psb_dspall' debug_unit = psb_get_debug_unit() debug_level = psb_get_debug_level() diff --git a/base/tools/psb_dspfree.f90 b/base/tools/psb_dspfree.f90 index 46740558b..ee8388ce9 100644 --- a/base/tools/psb_dspfree.f90 +++ b/base/tools/psb_dspfree.f90 @@ -51,10 +51,12 @@ subroutine psb_dspfree(a, desc_a,info) integer(psb_ipk_) :: ictxt, err_act character(len=20) :: name - if(psb_get_errstatus() /= 0) return info=psb_success_ name = 'psb_dspfree' call psb_erractionsave(err_act) + if (psb_errstatus_fatal()) then + info = psb_err_internal_error_ ; goto 9999 + end if if (.not.psb_is_ok_desc(desc_a)) then info = psb_err_forgot_spall_ diff --git a/base/tools/psb_dsphalo.F90 b/base/tools/psb_dsphalo.F90 index e82545691..e76d03b3c 100644 --- a/base/tools/psb_dsphalo.F90 +++ b/base/tools/psb_dsphalo.F90 @@ -101,10 +101,12 @@ Subroutine psb_dsphalo(a,desc_a,blk,info,rowcnv,colcnv,& integer(psb_ipk_) :: debug_level, debug_unit character(len=20) :: name, ch_err - if(psb_get_errstatus() /= 0) return info=psb_success_ name='psb_dsphalo' call psb_erractionsave(err_act) + if (psb_errstatus_fatal()) then + info = psb_err_internal_error_ ; goto 9999 + end if debug_unit = psb_get_debug_unit() debug_level = psb_get_debug_level() diff --git a/base/tools/psb_eallc_a.f90 b/base/tools/psb_eallc_a.f90 index 4e36442fc..5f6e3c369 100644 --- a/base/tools/psb_eallc_a.f90 +++ b/base/tools/psb_eallc_a.f90 @@ -60,10 +60,12 @@ subroutine psb_ealloc(x, desc_a, info, n, lb) character(len=20) :: name name='psb_geall' - if(psb_get_errstatus() /= 0) return info = psb_success_ err = 0 call psb_erractionsave(err_act) + if (psb_errstatus_fatal()) then + info = psb_err_internal_error_ ; goto 9999 + end if ictxt=desc_a%get_context() @@ -185,10 +187,12 @@ subroutine psb_eallocv(x, desc_a,info,n) integer(psb_ipk_) :: debug_level, debug_unit character(len=20) :: name - if(psb_get_errstatus() /= 0) return info=psb_success_ name='psb_geall' call psb_erractionsave(err_act) + if (psb_errstatus_fatal()) then + info = psb_err_internal_error_ ; goto 9999 + end if debug_unit = psb_get_debug_unit() debug_level = psb_get_debug_level() diff --git a/base/tools/psb_easb_a.f90 b/base/tools/psb_easb_a.f90 index 0945a2c88..5c62aa59e 100644 --- a/base/tools/psb_easb_a.f90 +++ b/base/tools/psb_easb_a.f90 @@ -58,10 +58,12 @@ subroutine psb_easb(x, desc_a, info, scratch) logical :: scratch_ character(len=20) :: name, ch_err - if(psb_get_errstatus() /= 0) return info=psb_success_ name='psb_egeasb_m' call psb_erractionsave(err_act) + if (psb_errstatus_fatal()) then + info = psb_err_internal_error_ ; goto 9999 + end if debug_unit = psb_get_debug_unit() debug_level = psb_get_debug_level() scratch_ = .false. @@ -194,6 +196,10 @@ subroutine psb_easbv(x, desc_a, info, scratch) info = psb_success_ name = 'psb_egeasb_v' + call psb_erractionsave(err_act) + if (psb_errstatus_fatal()) then + info = psb_err_internal_error_ ; goto 9999 + end if ictxt = desc_a%get_context() debug_unit = psb_get_debug_unit() diff --git a/base/tools/psb_efree_a.f90 b/base/tools/psb_efree_a.f90 index 4047a3b38..c07ee694e 100644 --- a/base/tools/psb_efree_a.f90 +++ b/base/tools/psb_efree_a.f90 @@ -51,11 +51,13 @@ subroutine psb_efree(x, desc_a, info) integer(psb_ipk_) :: ictxt,np,me, err_act character(len=20) :: name - - if(psb_get_errstatus() /= 0) return + name='psb_efree' info=psb_success_ call psb_erractionsave(err_act) - name='psb_efree' + if (psb_errstatus_fatal()) then + info = psb_err_internal_error_ ; goto 9999 + end if + if (.not.psb_is_ok_desc(desc_a)) then info=psb_err_forgot_spall_ call psb_errpush(info,name) @@ -117,12 +119,12 @@ subroutine psb_efreev(x, desc_a, info) integer(psb_ipk_) :: ictxt,np,me, err_act character(len=20) :: name - - if(psb_get_errstatus() /= 0) return + name='psb_efreev' info=psb_success_ call psb_erractionsave(err_act) - name='psb_efreev' - + if (psb_errstatus_fatal()) then + info = psb_err_internal_error_ ; goto 9999 + end if if (.not.psb_is_ok_desc(desc_a)) then info=psb_err_forgot_spall_ diff --git a/base/tools/psb_eins_a.f90 b/base/tools/psb_eins_a.f90 index 634c57995..3923a2654 100644 --- a/base/tools/psb_eins_a.f90 +++ b/base/tools/psb_eins_a.f90 @@ -73,10 +73,12 @@ subroutine psb_einsvi(m, irw, val, x, desc_a, info, dupl,local) logical :: local_ character(len=20) :: name - if(psb_get_errstatus() /= 0) return + name = 'psb_einsvi' info=psb_success_ call psb_erractionsave(err_act) - name = 'psb_einsvi' + if (psb_errstatus_fatal()) then + info = psb_err_internal_error_ ; goto 9999 + end if if (.not.desc_a%is_ok()) then info = psb_err_invalid_cd_state_ @@ -251,10 +253,12 @@ subroutine psb_einsi(m, irw, val, x, desc_a, info, dupl,local) logical :: local_ character(len=20) :: name - if(psb_get_errstatus() /= 0) return + name = 'psb_einsi' info = psb_success_ call psb_erractionsave(err_act) - name = 'psb_einsi' + if (psb_errstatus_fatal()) then + info = psb_err_internal_error_ ; goto 9999 + end if if (.not.desc_a%is_ok()) then info = psb_err_invalid_cd_state_ diff --git a/base/tools/psb_mallc_a.f90 b/base/tools/psb_mallc_a.f90 index 8764fa001..2bcedc5bd 100644 --- a/base/tools/psb_mallc_a.f90 +++ b/base/tools/psb_mallc_a.f90 @@ -60,10 +60,12 @@ subroutine psb_malloc(x, desc_a, info, n, lb) character(len=20) :: name name='psb_geall' - if(psb_get_errstatus() /= 0) return info = psb_success_ err = 0 call psb_erractionsave(err_act) + if (psb_errstatus_fatal()) then + info = psb_err_internal_error_ ; goto 9999 + end if ictxt=desc_a%get_context() @@ -185,10 +187,12 @@ subroutine psb_mallocv(x, desc_a,info,n) integer(psb_ipk_) :: debug_level, debug_unit character(len=20) :: name - if(psb_get_errstatus() /= 0) return info=psb_success_ name='psb_geall' call psb_erractionsave(err_act) + if (psb_errstatus_fatal()) then + info = psb_err_internal_error_ ; goto 9999 + end if debug_unit = psb_get_debug_unit() debug_level = psb_get_debug_level() diff --git a/base/tools/psb_masb_a.f90 b/base/tools/psb_masb_a.f90 index 07123dcb8..47c35d2a6 100644 --- a/base/tools/psb_masb_a.f90 +++ b/base/tools/psb_masb_a.f90 @@ -58,10 +58,12 @@ subroutine psb_masb(x, desc_a, info, scratch) logical :: scratch_ character(len=20) :: name, ch_err - if(psb_get_errstatus() /= 0) return info=psb_success_ name='psb_mgeasb_m' call psb_erractionsave(err_act) + if (psb_errstatus_fatal()) then + info = psb_err_internal_error_ ; goto 9999 + end if debug_unit = psb_get_debug_unit() debug_level = psb_get_debug_level() scratch_ = .false. @@ -194,6 +196,10 @@ subroutine psb_masbv(x, desc_a, info, scratch) info = psb_success_ name = 'psb_mgeasb_v' + call psb_erractionsave(err_act) + if (psb_errstatus_fatal()) then + info = psb_err_internal_error_ ; goto 9999 + end if ictxt = desc_a%get_context() debug_unit = psb_get_debug_unit() diff --git a/base/tools/psb_mfree_a.f90 b/base/tools/psb_mfree_a.f90 index 95acd522b..49f255da9 100644 --- a/base/tools/psb_mfree_a.f90 +++ b/base/tools/psb_mfree_a.f90 @@ -51,11 +51,13 @@ subroutine psb_mfree(x, desc_a, info) integer(psb_ipk_) :: ictxt,np,me, err_act character(len=20) :: name - - if(psb_get_errstatus() /= 0) return + name='psb_mfree' info=psb_success_ call psb_erractionsave(err_act) - name='psb_mfree' + if (psb_errstatus_fatal()) then + info = psb_err_internal_error_ ; goto 9999 + end if + if (.not.psb_is_ok_desc(desc_a)) then info=psb_err_forgot_spall_ call psb_errpush(info,name) @@ -117,12 +119,12 @@ subroutine psb_mfreev(x, desc_a, info) integer(psb_ipk_) :: ictxt,np,me, err_act character(len=20) :: name - - if(psb_get_errstatus() /= 0) return + name='psb_mfreev' info=psb_success_ call psb_erractionsave(err_act) - name='psb_mfreev' - + if (psb_errstatus_fatal()) then + info = psb_err_internal_error_ ; goto 9999 + end if if (.not.psb_is_ok_desc(desc_a)) then info=psb_err_forgot_spall_ diff --git a/base/tools/psb_mins_a.f90 b/base/tools/psb_mins_a.f90 index c5f1360bd..6d83b724e 100644 --- a/base/tools/psb_mins_a.f90 +++ b/base/tools/psb_mins_a.f90 @@ -73,10 +73,12 @@ subroutine psb_minsvi(m, irw, val, x, desc_a, info, dupl,local) logical :: local_ character(len=20) :: name - if(psb_get_errstatus() /= 0) return + name = 'psb_minsvi' info=psb_success_ call psb_erractionsave(err_act) - name = 'psb_minsvi' + if (psb_errstatus_fatal()) then + info = psb_err_internal_error_ ; goto 9999 + end if if (.not.desc_a%is_ok()) then info = psb_err_invalid_cd_state_ @@ -251,10 +253,12 @@ subroutine psb_minsi(m, irw, val, x, desc_a, info, dupl,local) logical :: local_ character(len=20) :: name - if(psb_get_errstatus() /= 0) return + name = 'psb_minsi' info = psb_success_ call psb_erractionsave(err_act) - name = 'psb_minsi' + if (psb_errstatus_fatal()) then + info = psb_err_internal_error_ ; goto 9999 + end if if (.not.desc_a%is_ok()) then info = psb_err_invalid_cd_state_ diff --git a/base/tools/psb_sallc_a.f90 b/base/tools/psb_sallc_a.f90 index 226956e39..815acb616 100644 --- a/base/tools/psb_sallc_a.f90 +++ b/base/tools/psb_sallc_a.f90 @@ -60,10 +60,12 @@ subroutine psb_salloc(x, desc_a, info, n, lb) character(len=20) :: name name='psb_geall' - if(psb_get_errstatus() /= 0) return info = psb_success_ err = 0 call psb_erractionsave(err_act) + if (psb_errstatus_fatal()) then + info = psb_err_internal_error_ ; goto 9999 + end if ictxt=desc_a%get_context() @@ -185,10 +187,12 @@ subroutine psb_sallocv(x, desc_a,info,n) integer(psb_ipk_) :: debug_level, debug_unit character(len=20) :: name - if(psb_get_errstatus() /= 0) return info=psb_success_ name='psb_geall' call psb_erractionsave(err_act) + if (psb_errstatus_fatal()) then + info = psb_err_internal_error_ ; goto 9999 + end if debug_unit = psb_get_debug_unit() debug_level = psb_get_debug_level() diff --git a/base/tools/psb_sasb_a.f90 b/base/tools/psb_sasb_a.f90 index bd082573c..bef96be7d 100644 --- a/base/tools/psb_sasb_a.f90 +++ b/base/tools/psb_sasb_a.f90 @@ -58,10 +58,12 @@ subroutine psb_sasb(x, desc_a, info, scratch) logical :: scratch_ character(len=20) :: name, ch_err - if(psb_get_errstatus() /= 0) return info=psb_success_ name='psb_sgeasb_m' call psb_erractionsave(err_act) + if (psb_errstatus_fatal()) then + info = psb_err_internal_error_ ; goto 9999 + end if debug_unit = psb_get_debug_unit() debug_level = psb_get_debug_level() scratch_ = .false. @@ -194,6 +196,10 @@ subroutine psb_sasbv(x, desc_a, info, scratch) info = psb_success_ name = 'psb_sgeasb_v' + call psb_erractionsave(err_act) + if (psb_errstatus_fatal()) then + info = psb_err_internal_error_ ; goto 9999 + end if ictxt = desc_a%get_context() debug_unit = psb_get_debug_unit() diff --git a/base/tools/psb_sfree_a.f90 b/base/tools/psb_sfree_a.f90 index ccabd82e7..6d7412d0e 100644 --- a/base/tools/psb_sfree_a.f90 +++ b/base/tools/psb_sfree_a.f90 @@ -51,11 +51,13 @@ subroutine psb_sfree(x, desc_a, info) integer(psb_ipk_) :: ictxt,np,me, err_act character(len=20) :: name - - if(psb_get_errstatus() /= 0) return + name='psb_sfree' info=psb_success_ call psb_erractionsave(err_act) - name='psb_sfree' + if (psb_errstatus_fatal()) then + info = psb_err_internal_error_ ; goto 9999 + end if + if (.not.psb_is_ok_desc(desc_a)) then info=psb_err_forgot_spall_ call psb_errpush(info,name) @@ -117,12 +119,12 @@ subroutine psb_sfreev(x, desc_a, info) integer(psb_ipk_) :: ictxt,np,me, err_act character(len=20) :: name - - if(psb_get_errstatus() /= 0) return + name='psb_sfreev' info=psb_success_ call psb_erractionsave(err_act) - name='psb_sfreev' - + if (psb_errstatus_fatal()) then + info = psb_err_internal_error_ ; goto 9999 + end if if (.not.psb_is_ok_desc(desc_a)) then info=psb_err_forgot_spall_ diff --git a/base/tools/psb_sins_a.f90 b/base/tools/psb_sins_a.f90 index 46edc92b0..51bd0bbd1 100644 --- a/base/tools/psb_sins_a.f90 +++ b/base/tools/psb_sins_a.f90 @@ -73,10 +73,12 @@ subroutine psb_sinsvi(m, irw, val, x, desc_a, info, dupl,local) logical :: local_ character(len=20) :: name - if(psb_get_errstatus() /= 0) return + name = 'psb_sinsvi' info=psb_success_ call psb_erractionsave(err_act) - name = 'psb_sinsvi' + if (psb_errstatus_fatal()) then + info = psb_err_internal_error_ ; goto 9999 + end if if (.not.desc_a%is_ok()) then info = psb_err_invalid_cd_state_ @@ -251,10 +253,12 @@ subroutine psb_sinsi(m, irw, val, x, desc_a, info, dupl,local) logical :: local_ character(len=20) :: name - if(psb_get_errstatus() /= 0) return + name = 'psb_sinsi' info = psb_success_ call psb_erractionsave(err_act) - name = 'psb_sinsi' + if (psb_errstatus_fatal()) then + info = psb_err_internal_error_ ; goto 9999 + end if if (.not.desc_a%is_ok()) then info = psb_err_invalid_cd_state_ diff --git a/base/tools/psb_sspalloc.f90 b/base/tools/psb_sspalloc.f90 index 98092ea03..4b092e62f 100644 --- a/base/tools/psb_sspalloc.f90 +++ b/base/tools/psb_sspalloc.f90 @@ -58,9 +58,11 @@ subroutine psb_sspalloc(a, desc_a, info, nnz) integer(psb_ipk_) :: debug_level, debug_unit character(len=20) :: name - if(psb_get_errstatus() /= 0) return info=psb_success_ call psb_erractionsave(err_act) + if (psb_errstatus_fatal()) then + info = psb_err_internal_error_ ; goto 9999 + end if name = 'psb_sspall' debug_unit = psb_get_debug_unit() debug_level = psb_get_debug_level() diff --git a/base/tools/psb_sspfree.f90 b/base/tools/psb_sspfree.f90 index 3c0266231..aa4cea769 100644 --- a/base/tools/psb_sspfree.f90 +++ b/base/tools/psb_sspfree.f90 @@ -51,10 +51,12 @@ subroutine psb_sspfree(a, desc_a,info) integer(psb_ipk_) :: ictxt, err_act character(len=20) :: name - if(psb_get_errstatus() /= 0) return info=psb_success_ name = 'psb_sspfree' call psb_erractionsave(err_act) + if (psb_errstatus_fatal()) then + info = psb_err_internal_error_ ; goto 9999 + end if if (.not.psb_is_ok_desc(desc_a)) then info = psb_err_forgot_spall_ diff --git a/base/tools/psb_ssphalo.F90 b/base/tools/psb_ssphalo.F90 index 1576ff3e7..8053e42ba 100644 --- a/base/tools/psb_ssphalo.F90 +++ b/base/tools/psb_ssphalo.F90 @@ -101,10 +101,12 @@ Subroutine psb_ssphalo(a,desc_a,blk,info,rowcnv,colcnv,& integer(psb_ipk_) :: debug_level, debug_unit character(len=20) :: name, ch_err - if(psb_get_errstatus() /= 0) return info=psb_success_ name='psb_ssphalo' call psb_erractionsave(err_act) + if (psb_errstatus_fatal()) then + info = psb_err_internal_error_ ; goto 9999 + end if debug_unit = psb_get_debug_unit() debug_level = psb_get_debug_level() diff --git a/base/tools/psb_zallc_a.f90 b/base/tools/psb_zallc_a.f90 index 8baec201b..9fa7993c6 100644 --- a/base/tools/psb_zallc_a.f90 +++ b/base/tools/psb_zallc_a.f90 @@ -60,10 +60,12 @@ subroutine psb_zalloc(x, desc_a, info, n, lb) character(len=20) :: name name='psb_geall' - if(psb_get_errstatus() /= 0) return info = psb_success_ err = 0 call psb_erractionsave(err_act) + if (psb_errstatus_fatal()) then + info = psb_err_internal_error_ ; goto 9999 + end if ictxt=desc_a%get_context() @@ -185,10 +187,12 @@ subroutine psb_zallocv(x, desc_a,info,n) integer(psb_ipk_) :: debug_level, debug_unit character(len=20) :: name - if(psb_get_errstatus() /= 0) return info=psb_success_ name='psb_geall' call psb_erractionsave(err_act) + if (psb_errstatus_fatal()) then + info = psb_err_internal_error_ ; goto 9999 + end if debug_unit = psb_get_debug_unit() debug_level = psb_get_debug_level() diff --git a/base/tools/psb_zasb_a.f90 b/base/tools/psb_zasb_a.f90 index a0f3639bf..0492475a6 100644 --- a/base/tools/psb_zasb_a.f90 +++ b/base/tools/psb_zasb_a.f90 @@ -58,10 +58,12 @@ subroutine psb_zasb(x, desc_a, info, scratch) logical :: scratch_ character(len=20) :: name, ch_err - if(psb_get_errstatus() /= 0) return info=psb_success_ name='psb_zgeasb_m' call psb_erractionsave(err_act) + if (psb_errstatus_fatal()) then + info = psb_err_internal_error_ ; goto 9999 + end if debug_unit = psb_get_debug_unit() debug_level = psb_get_debug_level() scratch_ = .false. @@ -194,6 +196,10 @@ subroutine psb_zasbv(x, desc_a, info, scratch) info = psb_success_ name = 'psb_zgeasb_v' + call psb_erractionsave(err_act) + if (psb_errstatus_fatal()) then + info = psb_err_internal_error_ ; goto 9999 + end if ictxt = desc_a%get_context() debug_unit = psb_get_debug_unit() diff --git a/base/tools/psb_zfree_a.f90 b/base/tools/psb_zfree_a.f90 index 9c28fada4..7dc6498e6 100644 --- a/base/tools/psb_zfree_a.f90 +++ b/base/tools/psb_zfree_a.f90 @@ -51,11 +51,13 @@ subroutine psb_zfree(x, desc_a, info) integer(psb_ipk_) :: ictxt,np,me, err_act character(len=20) :: name - - if(psb_get_errstatus() /= 0) return + name='psb_zfree' info=psb_success_ call psb_erractionsave(err_act) - name='psb_zfree' + if (psb_errstatus_fatal()) then + info = psb_err_internal_error_ ; goto 9999 + end if + if (.not.psb_is_ok_desc(desc_a)) then info=psb_err_forgot_spall_ call psb_errpush(info,name) @@ -117,12 +119,12 @@ subroutine psb_zfreev(x, desc_a, info) integer(psb_ipk_) :: ictxt,np,me, err_act character(len=20) :: name - - if(psb_get_errstatus() /= 0) return + name='psb_zfreev' info=psb_success_ call psb_erractionsave(err_act) - name='psb_zfreev' - + if (psb_errstatus_fatal()) then + info = psb_err_internal_error_ ; goto 9999 + end if if (.not.psb_is_ok_desc(desc_a)) then info=psb_err_forgot_spall_ diff --git a/base/tools/psb_zins_a.f90 b/base/tools/psb_zins_a.f90 index 71c4cfc84..7db797f8e 100644 --- a/base/tools/psb_zins_a.f90 +++ b/base/tools/psb_zins_a.f90 @@ -73,10 +73,12 @@ subroutine psb_zinsvi(m, irw, val, x, desc_a, info, dupl,local) logical :: local_ character(len=20) :: name - if(psb_get_errstatus() /= 0) return + name = 'psb_zinsvi' info=psb_success_ call psb_erractionsave(err_act) - name = 'psb_zinsvi' + if (psb_errstatus_fatal()) then + info = psb_err_internal_error_ ; goto 9999 + end if if (.not.desc_a%is_ok()) then info = psb_err_invalid_cd_state_ @@ -251,10 +253,12 @@ subroutine psb_zinsi(m, irw, val, x, desc_a, info, dupl,local) logical :: local_ character(len=20) :: name - if(psb_get_errstatus() /= 0) return + name = 'psb_zinsi' info = psb_success_ call psb_erractionsave(err_act) - name = 'psb_zinsi' + if (psb_errstatus_fatal()) then + info = psb_err_internal_error_ ; goto 9999 + end if if (.not.desc_a%is_ok()) then info = psb_err_invalid_cd_state_ diff --git a/base/tools/psb_zspalloc.f90 b/base/tools/psb_zspalloc.f90 index 777e24edb..81099dcbd 100644 --- a/base/tools/psb_zspalloc.f90 +++ b/base/tools/psb_zspalloc.f90 @@ -58,9 +58,11 @@ subroutine psb_zspalloc(a, desc_a, info, nnz) integer(psb_ipk_) :: debug_level, debug_unit character(len=20) :: name - if(psb_get_errstatus() /= 0) return info=psb_success_ call psb_erractionsave(err_act) + if (psb_errstatus_fatal()) then + info = psb_err_internal_error_ ; goto 9999 + end if name = 'psb_zspall' debug_unit = psb_get_debug_unit() debug_level = psb_get_debug_level() diff --git a/base/tools/psb_zspfree.f90 b/base/tools/psb_zspfree.f90 index 101462326..b002999da 100644 --- a/base/tools/psb_zspfree.f90 +++ b/base/tools/psb_zspfree.f90 @@ -51,10 +51,12 @@ subroutine psb_zspfree(a, desc_a,info) integer(psb_ipk_) :: ictxt, err_act character(len=20) :: name - if(psb_get_errstatus() /= 0) return info=psb_success_ name = 'psb_zspfree' call psb_erractionsave(err_act) + if (psb_errstatus_fatal()) then + info = psb_err_internal_error_ ; goto 9999 + end if if (.not.psb_is_ok_desc(desc_a)) then info = psb_err_forgot_spall_ diff --git a/base/tools/psb_zsphalo.F90 b/base/tools/psb_zsphalo.F90 index f38a76d8e..2dffbe1d0 100644 --- a/base/tools/psb_zsphalo.F90 +++ b/base/tools/psb_zsphalo.F90 @@ -101,10 +101,12 @@ Subroutine psb_zsphalo(a,desc_a,blk,info,rowcnv,colcnv,& integer(psb_ipk_) :: debug_level, debug_unit character(len=20) :: name, ch_err - if(psb_get_errstatus() /= 0) return info=psb_success_ name='psb_zsphalo' call psb_erractionsave(err_act) + if (psb_errstatus_fatal()) then + info = psb_err_internal_error_ ; goto 9999 + end if debug_unit = psb_get_debug_unit() debug_level = psb_get_debug_level() diff --git a/prec/impl/psb_c_bjacprec_impl.f90 b/prec/impl/psb_c_bjacprec_impl.f90 index f8ecdf04c..c1e24f42b 100644 --- a/prec/impl/psb_c_bjacprec_impl.f90 +++ b/prec/impl/psb_c_bjacprec_impl.f90 @@ -434,10 +434,12 @@ subroutine psb_c_bjac_precbld(a,desc_a,prec,info,amold,vmold,imold) character(len=20) :: ch_err - if(psb_get_errstatus() /= 0) return info = psb_success_ call psb_erractionsave(err_act) + if (psb_errstatus_fatal()) then + info = psb_err_internal_error_ ; goto 9999 + end if ictxt=desc_a%get_ctxt() call prec%set_ctxt(ictxt) diff --git a/prec/impl/psb_cprecbld.f90 b/prec/impl/psb_cprecbld.f90 index 034764dd7..588ac84d4 100644 --- a/prec/impl/psb_cprecbld.f90 +++ b/prec/impl/psb_cprecbld.f90 @@ -49,11 +49,13 @@ subroutine psb_cprecbld(a,desc_a,p,info,amold,vmold,imold) integer(psb_ipk_),parameter :: iroot=psb_root_,iout=60,ilout=40 character(len=20) :: name, ch_err - if(psb_get_errstatus() /= 0) return info=psb_success_ err=0 - call psb_erractionsave(err_act) name = 'psb_precbld' + call psb_erractionsave(err_act) + if (psb_errstatus_fatal()) then + info = psb_err_internal_error_ ; goto 9999 + end if info = psb_success_ ictxt = desc_a%get_context() diff --git a/prec/impl/psb_d_bjacprec_impl.f90 b/prec/impl/psb_d_bjacprec_impl.f90 index 6ac52d978..8420da459 100644 --- a/prec/impl/psb_d_bjacprec_impl.f90 +++ b/prec/impl/psb_d_bjacprec_impl.f90 @@ -434,10 +434,12 @@ subroutine psb_d_bjac_precbld(a,desc_a,prec,info,amold,vmold,imold) character(len=20) :: ch_err - if(psb_get_errstatus() /= 0) return info = psb_success_ call psb_erractionsave(err_act) + if (psb_errstatus_fatal()) then + info = psb_err_internal_error_ ; goto 9999 + end if ictxt=desc_a%get_ctxt() call prec%set_ctxt(ictxt) diff --git a/prec/impl/psb_dprecbld.f90 b/prec/impl/psb_dprecbld.f90 index 3ed5ad636..dc3d75859 100644 --- a/prec/impl/psb_dprecbld.f90 +++ b/prec/impl/psb_dprecbld.f90 @@ -49,11 +49,13 @@ subroutine psb_dprecbld(a,desc_a,p,info,amold,vmold,imold) integer(psb_ipk_),parameter :: iroot=psb_root_,iout=60,ilout=40 character(len=20) :: name, ch_err - if(psb_get_errstatus() /= 0) return info=psb_success_ err=0 - call psb_erractionsave(err_act) name = 'psb_precbld' + call psb_erractionsave(err_act) + if (psb_errstatus_fatal()) then + info = psb_err_internal_error_ ; goto 9999 + end if info = psb_success_ ictxt = desc_a%get_context() diff --git a/prec/impl/psb_s_bjacprec_impl.f90 b/prec/impl/psb_s_bjacprec_impl.f90 index 528224c0a..eecf85d14 100644 --- a/prec/impl/psb_s_bjacprec_impl.f90 +++ b/prec/impl/psb_s_bjacprec_impl.f90 @@ -434,10 +434,12 @@ subroutine psb_s_bjac_precbld(a,desc_a,prec,info,amold,vmold,imold) character(len=20) :: ch_err - if(psb_get_errstatus() /= 0) return info = psb_success_ call psb_erractionsave(err_act) + if (psb_errstatus_fatal()) then + info = psb_err_internal_error_ ; goto 9999 + end if ictxt=desc_a%get_ctxt() call prec%set_ctxt(ictxt) diff --git a/prec/impl/psb_sprecbld.f90 b/prec/impl/psb_sprecbld.f90 index 7f89c8a2e..8cc48eaba 100644 --- a/prec/impl/psb_sprecbld.f90 +++ b/prec/impl/psb_sprecbld.f90 @@ -49,11 +49,13 @@ subroutine psb_sprecbld(a,desc_a,p,info,amold,vmold,imold) integer(psb_ipk_),parameter :: iroot=psb_root_,iout=60,ilout=40 character(len=20) :: name, ch_err - if(psb_get_errstatus() /= 0) return info=psb_success_ err=0 - call psb_erractionsave(err_act) name = 'psb_precbld' + call psb_erractionsave(err_act) + if (psb_errstatus_fatal()) then + info = psb_err_internal_error_ ; goto 9999 + end if info = psb_success_ ictxt = desc_a%get_context() diff --git a/prec/impl/psb_z_bjacprec_impl.f90 b/prec/impl/psb_z_bjacprec_impl.f90 index ac55d8622..57825bf4b 100644 --- a/prec/impl/psb_z_bjacprec_impl.f90 +++ b/prec/impl/psb_z_bjacprec_impl.f90 @@ -434,10 +434,12 @@ subroutine psb_z_bjac_precbld(a,desc_a,prec,info,amold,vmold,imold) character(len=20) :: ch_err - if(psb_get_errstatus() /= 0) return info = psb_success_ call psb_erractionsave(err_act) + if (psb_errstatus_fatal()) then + info = psb_err_internal_error_ ; goto 9999 + end if ictxt=desc_a%get_ctxt() call prec%set_ctxt(ictxt) diff --git a/prec/impl/psb_zprecbld.f90 b/prec/impl/psb_zprecbld.f90 index 0fac25757..b99cfe929 100644 --- a/prec/impl/psb_zprecbld.f90 +++ b/prec/impl/psb_zprecbld.f90 @@ -49,11 +49,13 @@ subroutine psb_zprecbld(a,desc_a,p,info,amold,vmold,imold) integer(psb_ipk_),parameter :: iroot=psb_root_,iout=60,ilout=40 character(len=20) :: name, ch_err - if(psb_get_errstatus() /= 0) return info=psb_success_ err=0 - call psb_erractionsave(err_act) name = 'psb_precbld' + call psb_erractionsave(err_act) + if (psb_errstatus_fatal()) then + info = psb_err_internal_error_ ; goto 9999 + end if info = psb_success_ ictxt = desc_a%get_context() diff --git a/prec/psb_c_base_prec_mod.f90 b/prec/psb_c_base_prec_mod.f90 index 88f95a33b..9fe9d8e1d 100644 --- a/prec/psb_c_base_prec_mod.f90 +++ b/prec/psb_c_base_prec_mod.f90 @@ -39,7 +39,7 @@ module psb_c_base_prec_mod use psb_base_mod, only : psb_spk_, psb_ipk_, psb_epk_,& & psb_desc_type, psb_sizeof, psb_free, psb_cdfree, psb_errpush, psb_act_abort_,& & psb_sizeof_ip, psb_sizeof_lp, psb_sizeof_sp, psb_sizeof_dp, & - & psb_erractionsave, psb_erractionrestore, psb_error, psb_get_errstatus, psb_success_,& + & psb_erractionsave, psb_erractionrestore, psb_error, psb_errstatus_fatal, psb_success_,& & psb_c_base_sparse_mat, psb_cspmat_type, psb_c_csr_sparse_mat,& & psb_c_base_vect_type, psb_c_vect_type, psb_i_base_vect_type diff --git a/prec/psb_c_prec_type.f90 b/prec/psb_c_prec_type.f90 index 5a0433fd4..99225d5e0 100644 --- a/prec/psb_c_prec_type.f90 +++ b/prec/psb_c_prec_type.f90 @@ -199,10 +199,12 @@ contains integer(psb_ipk_), intent(out) :: info integer(psb_ipk_) :: me, err_act,i character(len=20) :: name - if(psb_get_errstatus() /= 0) return info=psb_success_ name = 'psb_precfree' call psb_erractionsave(err_act) + if (psb_errstatus_fatal()) then + info = psb_err_internal_error_ ; goto 9999 + end if me=-1 call p%free(info) @@ -224,10 +226,12 @@ contains integer(psb_ipk_), intent(out) :: info integer(psb_ipk_) :: me, err_act,i character(len=20) :: name - if(psb_get_errstatus() /= 0) return info=psb_success_ name = 'psb_precfree' call psb_erractionsave(err_act) + if (psb_errstatus_fatal()) then + info = psb_err_internal_error_ ; goto 9999 + end if me=-1 diff --git a/prec/psb_d_base_prec_mod.f90 b/prec/psb_d_base_prec_mod.f90 index 271416343..738f65737 100644 --- a/prec/psb_d_base_prec_mod.f90 +++ b/prec/psb_d_base_prec_mod.f90 @@ -39,7 +39,7 @@ module psb_d_base_prec_mod use psb_base_mod, only : psb_dpk_, psb_ipk_, psb_epk_,& & psb_desc_type, psb_sizeof, psb_free, psb_cdfree, psb_errpush, psb_act_abort_,& & psb_sizeof_ip, psb_sizeof_lp, psb_sizeof_sp, psb_sizeof_dp, & - & psb_erractionsave, psb_erractionrestore, psb_error, psb_get_errstatus, psb_success_,& + & psb_erractionsave, psb_erractionrestore, psb_error, psb_errstatus_fatal, psb_success_,& & psb_d_base_sparse_mat, psb_dspmat_type, psb_d_csr_sparse_mat,& & psb_d_base_vect_type, psb_d_vect_type, psb_i_base_vect_type diff --git a/prec/psb_d_prec_type.f90 b/prec/psb_d_prec_type.f90 index f0ee4d66e..16afd9586 100644 --- a/prec/psb_d_prec_type.f90 +++ b/prec/psb_d_prec_type.f90 @@ -199,10 +199,12 @@ contains integer(psb_ipk_), intent(out) :: info integer(psb_ipk_) :: me, err_act,i character(len=20) :: name - if(psb_get_errstatus() /= 0) return info=psb_success_ name = 'psb_precfree' call psb_erractionsave(err_act) + if (psb_errstatus_fatal()) then + info = psb_err_internal_error_ ; goto 9999 + end if me=-1 call p%free(info) @@ -224,10 +226,12 @@ contains integer(psb_ipk_), intent(out) :: info integer(psb_ipk_) :: me, err_act,i character(len=20) :: name - if(psb_get_errstatus() /= 0) return info=psb_success_ name = 'psb_precfree' call psb_erractionsave(err_act) + if (psb_errstatus_fatal()) then + info = psb_err_internal_error_ ; goto 9999 + end if me=-1 diff --git a/prec/psb_s_base_prec_mod.f90 b/prec/psb_s_base_prec_mod.f90 index 533bb70e2..eb468301a 100644 --- a/prec/psb_s_base_prec_mod.f90 +++ b/prec/psb_s_base_prec_mod.f90 @@ -39,7 +39,7 @@ module psb_s_base_prec_mod use psb_base_mod, only : psb_spk_, psb_ipk_, psb_epk_,& & psb_desc_type, psb_sizeof, psb_free, psb_cdfree, psb_errpush, psb_act_abort_,& & psb_sizeof_ip, psb_sizeof_lp, psb_sizeof_sp, psb_sizeof_dp, & - & psb_erractionsave, psb_erractionrestore, psb_error, psb_get_errstatus, psb_success_,& + & psb_erractionsave, psb_erractionrestore, psb_error, psb_errstatus_fatal, psb_success_,& & psb_s_base_sparse_mat, psb_sspmat_type, psb_s_csr_sparse_mat,& & psb_s_base_vect_type, psb_s_vect_type, psb_i_base_vect_type diff --git a/prec/psb_s_prec_type.f90 b/prec/psb_s_prec_type.f90 index eb7a95ed6..808eaf03d 100644 --- a/prec/psb_s_prec_type.f90 +++ b/prec/psb_s_prec_type.f90 @@ -199,10 +199,12 @@ contains integer(psb_ipk_), intent(out) :: info integer(psb_ipk_) :: me, err_act,i character(len=20) :: name - if(psb_get_errstatus() /= 0) return info=psb_success_ name = 'psb_precfree' call psb_erractionsave(err_act) + if (psb_errstatus_fatal()) then + info = psb_err_internal_error_ ; goto 9999 + end if me=-1 call p%free(info) @@ -224,10 +226,12 @@ contains integer(psb_ipk_), intent(out) :: info integer(psb_ipk_) :: me, err_act,i character(len=20) :: name - if(psb_get_errstatus() /= 0) return info=psb_success_ name = 'psb_precfree' call psb_erractionsave(err_act) + if (psb_errstatus_fatal()) then + info = psb_err_internal_error_ ; goto 9999 + end if me=-1 diff --git a/prec/psb_z_base_prec_mod.f90 b/prec/psb_z_base_prec_mod.f90 index 17323aaf6..ad9eacc1c 100644 --- a/prec/psb_z_base_prec_mod.f90 +++ b/prec/psb_z_base_prec_mod.f90 @@ -39,7 +39,7 @@ module psb_z_base_prec_mod use psb_base_mod, only : psb_dpk_, psb_ipk_, psb_epk_,& & psb_desc_type, psb_sizeof, psb_free, psb_cdfree, psb_errpush, psb_act_abort_,& & psb_sizeof_ip, psb_sizeof_lp, psb_sizeof_sp, psb_sizeof_dp, & - & psb_erractionsave, psb_erractionrestore, psb_error, psb_get_errstatus, psb_success_,& + & psb_erractionsave, psb_erractionrestore, psb_error, psb_errstatus_fatal, psb_success_,& & psb_z_base_sparse_mat, psb_zspmat_type, psb_z_csr_sparse_mat,& & psb_z_base_vect_type, psb_z_vect_type, psb_i_base_vect_type diff --git a/prec/psb_z_prec_type.f90 b/prec/psb_z_prec_type.f90 index 277c01a19..e4702ef07 100644 --- a/prec/psb_z_prec_type.f90 +++ b/prec/psb_z_prec_type.f90 @@ -199,10 +199,12 @@ contains integer(psb_ipk_), intent(out) :: info integer(psb_ipk_) :: me, err_act,i character(len=20) :: name - if(psb_get_errstatus() /= 0) return info=psb_success_ name = 'psb_precfree' call psb_erractionsave(err_act) + if (psb_errstatus_fatal()) then + info = psb_err_internal_error_ ; goto 9999 + end if me=-1 call p%free(info) @@ -224,10 +226,12 @@ contains integer(psb_ipk_), intent(out) :: info integer(psb_ipk_) :: me, err_act,i character(len=20) :: name - if(psb_get_errstatus() /= 0) return info=psb_success_ name = 'psb_precfree' call psb_erractionsave(err_act) + if (psb_errstatus_fatal()) then + info = psb_err_internal_error_ ; goto 9999 + end if me=-1 diff --git a/test/fileread/psb_cf_sample.f90 b/test/fileread/psb_cf_sample.f90 index 334404334..f96db3a61 100644 --- a/test/fileread/psb_cf_sample.f90 +++ b/test/fileread/psb_cf_sample.f90 @@ -91,7 +91,7 @@ program psb_cf_sample name='psb_cf_sample' - if(psb_get_errstatus() /= 0) goto 9999 + if(psb_errstatus_fatal()) goto 9999 info=psb_success_ call psb_set_errverbosity(itwo) ! diff --git a/test/fileread/psb_df_sample.f90 b/test/fileread/psb_df_sample.f90 index 174491d2f..45f675bc1 100644 --- a/test/fileread/psb_df_sample.f90 +++ b/test/fileread/psb_df_sample.f90 @@ -91,7 +91,7 @@ program psb_df_sample name='psb_df_sample' - if(psb_get_errstatus() /= 0) goto 9999 + if(psb_errstatus_fatal()) goto 9999 info=psb_success_ call psb_set_errverbosity(itwo) ! diff --git a/test/fileread/psb_sf_sample.f90 b/test/fileread/psb_sf_sample.f90 index 3790669b9..35d212aa0 100644 --- a/test/fileread/psb_sf_sample.f90 +++ b/test/fileread/psb_sf_sample.f90 @@ -91,7 +91,7 @@ program psb_sf_sample name='psb_sf_sample' - if(psb_get_errstatus() /= 0) goto 9999 + if(psb_errstatus_fatal()) goto 9999 info=psb_success_ call psb_set_errverbosity(itwo) ! diff --git a/test/fileread/psb_zf_sample.f90 b/test/fileread/psb_zf_sample.f90 index 23b76dee2..36101aa22 100644 --- a/test/fileread/psb_zf_sample.f90 +++ b/test/fileread/psb_zf_sample.f90 @@ -91,7 +91,7 @@ program psb_zf_sample name='psb_zf_sample' - if(psb_get_errstatus() /= 0) goto 9999 + if(psb_errstatus_fatal()) goto 9999 info=psb_success_ call psb_set_errverbosity(itwo) ! diff --git a/test/pargen/psb_d_pde2d.f90 b/test/pargen/psb_d_pde2d.f90 index 693cd3d56..c1f6d93b6 100644 --- a/test/pargen/psb_d_pde2d.f90 +++ b/test/pargen/psb_d_pde2d.f90 @@ -578,7 +578,7 @@ program psb_d_pde2d call psb_exit(ictxt) stop endif - if(psb_get_errstatus() /= 0) goto 9999 + if(psb_errstatus_fatal()) goto 9999 name='pde2d90' call psb_set_errverbosity(itwo) ! diff --git a/test/pargen/psb_d_pde3d.f90 b/test/pargen/psb_d_pde3d.f90 index eea7fa2bc..a78ec3b6d 100644 --- a/test/pargen/psb_d_pde3d.f90 +++ b/test/pargen/psb_d_pde3d.f90 @@ -619,7 +619,7 @@ program psb_d_pde3d call psb_exit(ictxt) stop endif - if(psb_get_errstatus() /= 0) goto 9999 + if(psb_errstatus_fatal()) goto 9999 name='pde3d90' call psb_set_errverbosity(itwo) ! diff --git a/test/pargen/psb_s_pde2d.f90 b/test/pargen/psb_s_pde2d.f90 index 3a7d4877c..571e36c23 100644 --- a/test/pargen/psb_s_pde2d.f90 +++ b/test/pargen/psb_s_pde2d.f90 @@ -578,7 +578,7 @@ program psb_s_pde2d call psb_exit(ictxt) stop endif - if(psb_get_errstatus() /= 0) goto 9999 + if(psb_errstatus_fatal()) goto 9999 name='pde2d90' call psb_set_errverbosity(itwo) ! diff --git a/test/pargen/psb_s_pde3d.f90 b/test/pargen/psb_s_pde3d.f90 index 0c01402a5..2161ae7de 100644 --- a/test/pargen/psb_s_pde3d.f90 +++ b/test/pargen/psb_s_pde3d.f90 @@ -619,7 +619,7 @@ program psb_s_pde3d call psb_exit(ictxt) stop endif - if(psb_get_errstatus() /= 0) goto 9999 + if(psb_errstatus_fatal()) goto 9999 name='pde3d90' call psb_set_errverbosity(itwo) !