From cd0c11e0e76793d6d3106c7624ee8c06b1f3796f Mon Sep 17 00:00:00 2001 From: Salvatore Filippone Date: Tue, 14 May 2019 10:39:50 +0100 Subject: [PATCH] Fix error message. --- prec/impl/psb_c_bjacprec_impl.f90 | 5 +++-- prec/impl/psb_d_bjacprec_impl.f90 | 5 +++-- prec/impl/psb_s_bjacprec_impl.f90 | 5 +++-- prec/impl/psb_z_bjacprec_impl.f90 | 5 +++-- prec/psb_c_prec_type.f90 | 10 +++++++--- prec/psb_d_prec_type.f90 | 10 +++++++--- prec/psb_s_prec_type.f90 | 10 +++++++--- prec/psb_z_prec_type.f90 | 10 +++++++--- 8 files changed, 40 insertions(+), 20 deletions(-) diff --git a/prec/impl/psb_c_bjacprec_impl.f90 b/prec/impl/psb_c_bjacprec_impl.f90 index df34d027..a0e84b3c 100644 --- a/prec/impl/psb_c_bjacprec_impl.f90 +++ b/prec/impl/psb_c_bjacprec_impl.f90 @@ -195,7 +195,6 @@ subroutine psb_c_bjac_apply_vect(alpha,prec,x,beta,y,desc_data,info,trans,work) goto 9999 end if - case default info = psb_err_internal_error_ call psb_errpush(info,name,a_err='Invalid factorization') @@ -438,10 +437,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_d_bjacprec_impl.f90 b/prec/impl/psb_d_bjacprec_impl.f90 index ec955433..f9cbf38b 100644 --- a/prec/impl/psb_d_bjacprec_impl.f90 +++ b/prec/impl/psb_d_bjacprec_impl.f90 @@ -195,7 +195,6 @@ subroutine psb_d_bjac_apply_vect(alpha,prec,x,beta,y,desc_data,info,trans,work) goto 9999 end if - case default info = psb_err_internal_error_ call psb_errpush(info,name,a_err='Invalid factorization') @@ -438,10 +437,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_s_bjacprec_impl.f90 b/prec/impl/psb_s_bjacprec_impl.f90 index 5d4ec674..62f87180 100644 --- a/prec/impl/psb_s_bjacprec_impl.f90 +++ b/prec/impl/psb_s_bjacprec_impl.f90 @@ -195,7 +195,6 @@ subroutine psb_s_bjac_apply_vect(alpha,prec,x,beta,y,desc_data,info,trans,work) goto 9999 end if - case default info = psb_err_internal_error_ call psb_errpush(info,name,a_err='Invalid factorization') @@ -438,10 +437,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_z_bjacprec_impl.f90 b/prec/impl/psb_z_bjacprec_impl.f90 index 106cb128..4fb321fb 100644 --- a/prec/impl/psb_z_bjacprec_impl.f90 +++ b/prec/impl/psb_z_bjacprec_impl.f90 @@ -195,7 +195,6 @@ subroutine psb_z_bjac_apply_vect(alpha,prec,x,beta,y,desc_data,info,trans,work) goto 9999 end if - case default info = psb_err_internal_error_ call psb_errpush(info,name,a_err='Invalid factorization') @@ -438,10 +437,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/psb_c_prec_type.f90 b/prec/psb_c_prec_type.f90 index ac8defff..2a923ce2 100644 --- a/prec/psb_c_prec_type.f90 +++ b/prec/psb_c_prec_type.f90 @@ -218,7 +218,7 @@ contains if (.not.allocated(prec%prec)) then info = -1 - write(psb_err_unit,*) 'Trying to dump a non-built preconditioner' + write(psb_err_unit,*) 'Trying to allocate wrk to a non-built preconditioner' return end if @@ -288,10 +288,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) @@ -313,10 +315,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_prec_type.f90 b/prec/psb_d_prec_type.f90 index c9d25bcc..14a472e8 100644 --- a/prec/psb_d_prec_type.f90 +++ b/prec/psb_d_prec_type.f90 @@ -218,7 +218,7 @@ contains if (.not.allocated(prec%prec)) then info = -1 - write(psb_err_unit,*) 'Trying to dump a non-built preconditioner' + write(psb_err_unit,*) 'Trying to allocate wrk to a non-built preconditioner' return end if @@ -288,10 +288,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) @@ -313,10 +315,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_prec_type.f90 b/prec/psb_s_prec_type.f90 index 8e2485c2..a6aeb420 100644 --- a/prec/psb_s_prec_type.f90 +++ b/prec/psb_s_prec_type.f90 @@ -218,7 +218,7 @@ contains if (.not.allocated(prec%prec)) then info = -1 - write(psb_err_unit,*) 'Trying to dump a non-built preconditioner' + write(psb_err_unit,*) 'Trying to allocate wrk to a non-built preconditioner' return end if @@ -288,10 +288,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) @@ -313,10 +315,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_prec_type.f90 b/prec/psb_z_prec_type.f90 index fe6a008f..4a14d9f4 100644 --- a/prec/psb_z_prec_type.f90 +++ b/prec/psb_z_prec_type.f90 @@ -218,7 +218,7 @@ contains if (.not.allocated(prec%prec)) then info = -1 - write(psb_err_unit,*) 'Trying to dump a non-built preconditioner' + write(psb_err_unit,*) 'Trying to allocate wrk to a non-built preconditioner' return end if @@ -288,10 +288,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) @@ -313,10 +315,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