diff --git a/krylov/psb_c_krylov_conv_mod.f90 b/krylov/psb_c_krylov_conv_mod.f90 index a02c3eda..6d306953 100644 --- a/krylov/psb_c_krylov_conv_mod.f90 +++ b/krylov/psb_c_krylov_conv_mod.f90 @@ -109,12 +109,9 @@ contains call psb_erractionrestore(err_act) return -9999 continue - call psb_erractionrestore(err_act) - if (err_act == psb_act_abort_) then - call psb_error(ictxt) - return - end if +9999 call psb_error_handler(ictxt,err_act) + + return end subroutine psb_c_init_conv @@ -184,12 +181,9 @@ contains call psb_erractionrestore(err_act) return -9999 continue - call psb_erractionrestore(err_act) - if (err_act == psb_act_abort_) then - call psb_error(ictxt) - return - end if +9999 call psb_error_handler(ictxt,err_act) + + return end function psb_c_check_conv @@ -255,12 +249,9 @@ contains call psb_erractionrestore(err_act) return -9999 continue - call psb_erractionrestore(err_act) - if (err_act == psb_act_abort_) then - call psb_error(ictxt) - return - end if +9999 call psb_error_handler(ictxt,err_act) + + return end subroutine psb_c_init_conv_vect @@ -331,12 +322,9 @@ contains call psb_erractionrestore(err_act) return -9999 continue - call psb_erractionrestore(err_act) - if (err_act == psb_act_abort_) then - call psb_error(ictxt) - return - end if +9999 call psb_error_handler(ictxt,err_act) + + return end function psb_c_check_conv_vect diff --git a/krylov/psb_cbicg.f90 b/krylov/psb_cbicg.f90 index 1664d737..ee2ac866 100644 --- a/krylov/psb_cbicg.f90 +++ b/krylov/psb_cbicg.f90 @@ -328,12 +328,7 @@ subroutine psb_cbicg_vect(a,prec,b,x,eps,desc_a,info,& call psb_erractionrestore(err_act) return -9999 continue - call psb_erractionrestore(err_act) - if (err_act == psb_act_abort_) then - call psb_error() - return - end if +9999 call psb_error_handler(err_act) return end subroutine psb_cbicg_vect diff --git a/krylov/psb_ccg.f90 b/krylov/psb_ccg.f90 index 55d3f4e7..9a49fc47 100644 --- a/krylov/psb_ccg.f90 +++ b/krylov/psb_ccg.f90 @@ -281,12 +281,7 @@ subroutine psb_ccg_vect(a,prec,b,x,eps,desc_a,info,& call psb_erractionrestore(err_act) return -9999 continue - call psb_erractionrestore(err_act) - if (err_act == psb_act_abort_) then - call psb_error() - return - end if +9999 call psb_error_handler(err_act) return end subroutine psb_ccg_vect diff --git a/krylov/psb_ccgs.f90 b/krylov/psb_ccgs.f90 index e62dd376..92ee521a 100644 --- a/krylov/psb_ccgs.f90 +++ b/krylov/psb_ccgs.f90 @@ -319,12 +319,7 @@ Subroutine psb_ccgs_vect(a,prec,b,x,eps,desc_a,info,& call psb_erractionrestore(err_act) return -9999 continue - call psb_erractionrestore(err_act) - if (err_act == psb_act_abort_) then - call psb_error() - return - end if +9999 call psb_error_handler(err_act) return End Subroutine psb_ccgs_vect diff --git a/krylov/psb_ccgstab.f90 b/krylov/psb_ccgstab.f90 index 6b1440f3..b1bea0da 100644 --- a/krylov/psb_ccgstab.f90 +++ b/krylov/psb_ccgstab.f90 @@ -385,12 +385,7 @@ Subroutine psb_ccgstab_vect(a,prec,b,x,eps,desc_a,info,itmax,iter,err,itrace,ist call psb_erractionrestore(err_act) return -9999 continue - call psb_erractionrestore(err_act) - if (err_act == psb_act_abort_) then - call psb_error(ictxt) - return - end if +9999 call psb_error_handler(err_act) return End Subroutine psb_ccgstab_vect diff --git a/krylov/psb_ccgstabl.f90 b/krylov/psb_ccgstabl.f90 index 0281e4b0..f011c2c3 100644 --- a/krylov/psb_ccgstabl.f90 +++ b/krylov/psb_ccgstabl.f90 @@ -411,12 +411,7 @@ Subroutine psb_ccgstabl_vect(a,prec,b,x,eps,desc_a,info,& call psb_erractionrestore(err_act) return -9999 continue - call psb_erractionrestore(err_act) - if (err_act == psb_act_abort_) then - call psb_error() - return - end if +9999 call psb_error_handler(err_act) return End Subroutine psb_ccgstabl_vect diff --git a/krylov/psb_ckrylov.f90 b/krylov/psb_ckrylov.f90 index 009c1ba3..035d1143 100644 --- a/krylov/psb_ckrylov.f90 +++ b/krylov/psb_ckrylov.f90 @@ -235,12 +235,9 @@ Subroutine psb_ckrylov_vect(method,a,prec,b,x,eps,desc_a,info,& call psb_erractionrestore(err_act) return -9999 continue - call psb_erractionrestore(err_act) - if (err_act == psb_act_abort_) then - call psb_error(ictxt) - return - end if +9999 call psb_error_handler(ictxt,err_act) + + return end subroutine psb_ckrylov_vect diff --git a/krylov/psb_crgmres.f90 b/krylov/psb_crgmres.f90 index 191847ed..52f02dbf 100644 --- a/krylov/psb_crgmres.f90 +++ b/krylov/psb_crgmres.f90 @@ -469,12 +469,7 @@ subroutine psb_crgmres_vect(a,prec,b,x,eps,desc_a,info,& call psb_erractionrestore(err_act) return -9999 continue - call psb_erractionrestore(err_act) - if (err_act == psb_act_abort_) then - call psb_error() - return - end if +9999 call psb_error_handler(err_act) return end subroutine psb_crgmres_vect diff --git a/krylov/psb_d_krylov_conv_mod.f90 b/krylov/psb_d_krylov_conv_mod.f90 index f507d7fd..bde024a2 100644 --- a/krylov/psb_d_krylov_conv_mod.f90 +++ b/krylov/psb_d_krylov_conv_mod.f90 @@ -109,12 +109,9 @@ contains call psb_erractionrestore(err_act) return -9999 continue - call psb_erractionrestore(err_act) - if (err_act == psb_act_abort_) then - call psb_error(ictxt) - return - end if +9999 call psb_error_handler(ictxt,err_act) + + return end subroutine psb_d_init_conv @@ -184,12 +181,9 @@ contains call psb_erractionrestore(err_act) return -9999 continue - call psb_erractionrestore(err_act) - if (err_act == psb_act_abort_) then - call psb_error(ictxt) - return - end if +9999 call psb_error_handler(ictxt,err_act) + + return end function psb_d_check_conv @@ -255,12 +249,9 @@ contains call psb_erractionrestore(err_act) return -9999 continue - call psb_erractionrestore(err_act) - if (err_act == psb_act_abort_) then - call psb_error(ictxt) - return - end if +9999 call psb_error_handler(ictxt,err_act) + + return end subroutine psb_d_init_conv_vect @@ -331,12 +322,9 @@ contains call psb_erractionrestore(err_act) return -9999 continue - call psb_erractionrestore(err_act) - if (err_act == psb_act_abort_) then - call psb_error(ictxt) - return - end if +9999 call psb_error_handler(ictxt,err_act) + + return end function psb_d_check_conv_vect diff --git a/krylov/psb_dbicg.f90 b/krylov/psb_dbicg.f90 index 049f4caf..5563b067 100644 --- a/krylov/psb_dbicg.f90 +++ b/krylov/psb_dbicg.f90 @@ -328,12 +328,7 @@ subroutine psb_dbicg_vect(a,prec,b,x,eps,desc_a,info,& call psb_erractionrestore(err_act) return -9999 continue - call psb_erractionrestore(err_act) - if (err_act == psb_act_abort_) then - call psb_error() - return - end if +9999 call psb_error_handler(err_act) return end subroutine psb_dbicg_vect diff --git a/krylov/psb_dcg.f90 b/krylov/psb_dcg.f90 index 4040045b..016bfef8 100644 --- a/krylov/psb_dcg.f90 +++ b/krylov/psb_dcg.f90 @@ -281,12 +281,7 @@ subroutine psb_dcg_vect(a,prec,b,x,eps,desc_a,info,& call psb_erractionrestore(err_act) return -9999 continue - call psb_erractionrestore(err_act) - if (err_act == psb_act_abort_) then - call psb_error() - return - end if +9999 call psb_error_handler(err_act) return end subroutine psb_dcg_vect diff --git a/krylov/psb_dcgs.f90 b/krylov/psb_dcgs.f90 index 7bc5e49d..8ba177ee 100644 --- a/krylov/psb_dcgs.f90 +++ b/krylov/psb_dcgs.f90 @@ -319,12 +319,7 @@ Subroutine psb_dcgs_vect(a,prec,b,x,eps,desc_a,info,& call psb_erractionrestore(err_act) return -9999 continue - call psb_erractionrestore(err_act) - if (err_act == psb_act_abort_) then - call psb_error() - return - end if +9999 call psb_error_handler(err_act) return End Subroutine psb_dcgs_vect diff --git a/krylov/psb_dcgstab.f90 b/krylov/psb_dcgstab.f90 index 03bc8c50..4d3909ef 100644 --- a/krylov/psb_dcgstab.f90 +++ b/krylov/psb_dcgstab.f90 @@ -385,12 +385,7 @@ Subroutine psb_dcgstab_vect(a,prec,b,x,eps,desc_a,info,itmax,iter,err,itrace,ist call psb_erractionrestore(err_act) return -9999 continue - call psb_erractionrestore(err_act) - if (err_act == psb_act_abort_) then - call psb_error(ictxt) - return - end if +9999 call psb_error_handler(err_act) return End Subroutine psb_dcgstab_vect diff --git a/krylov/psb_dcgstabl.f90 b/krylov/psb_dcgstabl.f90 index 4be26a89..7d241904 100644 --- a/krylov/psb_dcgstabl.f90 +++ b/krylov/psb_dcgstabl.f90 @@ -411,12 +411,7 @@ Subroutine psb_dcgstabl_vect(a,prec,b,x,eps,desc_a,info,& call psb_erractionrestore(err_act) return -9999 continue - call psb_erractionrestore(err_act) - if (err_act == psb_act_abort_) then - call psb_error() - return - end if +9999 call psb_error_handler(err_act) return End Subroutine psb_dcgstabl_vect diff --git a/krylov/psb_dkrylov.f90 b/krylov/psb_dkrylov.f90 index 5e75d9a3..e68c38d0 100644 --- a/krylov/psb_dkrylov.f90 +++ b/krylov/psb_dkrylov.f90 @@ -235,12 +235,9 @@ Subroutine psb_dkrylov_vect(method,a,prec,b,x,eps,desc_a,info,& call psb_erractionrestore(err_act) return -9999 continue - call psb_erractionrestore(err_act) - if (err_act == psb_act_abort_) then - call psb_error(ictxt) - return - end if +9999 call psb_error_handler(ictxt,err_act) + + return end subroutine psb_dkrylov_vect diff --git a/krylov/psb_drgmres.f90 b/krylov/psb_drgmres.f90 index 984e9338..333eadaa 100644 --- a/krylov/psb_drgmres.f90 +++ b/krylov/psb_drgmres.f90 @@ -469,12 +469,7 @@ subroutine psb_drgmres_vect(a,prec,b,x,eps,desc_a,info,& call psb_erractionrestore(err_act) return -9999 continue - call psb_erractionrestore(err_act) - if (err_act == psb_act_abort_) then - call psb_error() - return - end if +9999 call psb_error_handler(err_act) return end subroutine psb_drgmres_vect diff --git a/krylov/psb_s_krylov_conv_mod.f90 b/krylov/psb_s_krylov_conv_mod.f90 index 8462f262..4416dd5b 100644 --- a/krylov/psb_s_krylov_conv_mod.f90 +++ b/krylov/psb_s_krylov_conv_mod.f90 @@ -109,12 +109,9 @@ contains call psb_erractionrestore(err_act) return -9999 continue - call psb_erractionrestore(err_act) - if (err_act == psb_act_abort_) then - call psb_error(ictxt) - return - end if +9999 call psb_error_handler(ictxt,err_act) + + return end subroutine psb_s_init_conv @@ -184,12 +181,9 @@ contains call psb_erractionrestore(err_act) return -9999 continue - call psb_erractionrestore(err_act) - if (err_act == psb_act_abort_) then - call psb_error(ictxt) - return - end if +9999 call psb_error_handler(ictxt,err_act) + + return end function psb_s_check_conv @@ -255,12 +249,9 @@ contains call psb_erractionrestore(err_act) return -9999 continue - call psb_erractionrestore(err_act) - if (err_act == psb_act_abort_) then - call psb_error(ictxt) - return - end if +9999 call psb_error_handler(ictxt,err_act) + + return end subroutine psb_s_init_conv_vect @@ -331,12 +322,9 @@ contains call psb_erractionrestore(err_act) return -9999 continue - call psb_erractionrestore(err_act) - if (err_act == psb_act_abort_) then - call psb_error(ictxt) - return - end if +9999 call psb_error_handler(ictxt,err_act) + + return end function psb_s_check_conv_vect diff --git a/krylov/psb_sbicg.f90 b/krylov/psb_sbicg.f90 index 0ad932a4..367494f5 100644 --- a/krylov/psb_sbicg.f90 +++ b/krylov/psb_sbicg.f90 @@ -328,12 +328,7 @@ subroutine psb_sbicg_vect(a,prec,b,x,eps,desc_a,info,& call psb_erractionrestore(err_act) return -9999 continue - call psb_erractionrestore(err_act) - if (err_act == psb_act_abort_) then - call psb_error() - return - end if +9999 call psb_error_handler(err_act) return end subroutine psb_sbicg_vect diff --git a/krylov/psb_scg.f90 b/krylov/psb_scg.f90 index 212bc4d0..f43b5e78 100644 --- a/krylov/psb_scg.f90 +++ b/krylov/psb_scg.f90 @@ -281,12 +281,7 @@ subroutine psb_scg_vect(a,prec,b,x,eps,desc_a,info,& call psb_erractionrestore(err_act) return -9999 continue - call psb_erractionrestore(err_act) - if (err_act == psb_act_abort_) then - call psb_error() - return - end if +9999 call psb_error_handler(err_act) return end subroutine psb_scg_vect diff --git a/krylov/psb_scgs.f90 b/krylov/psb_scgs.f90 index 1e8c7f47..46a33604 100644 --- a/krylov/psb_scgs.f90 +++ b/krylov/psb_scgs.f90 @@ -319,12 +319,7 @@ Subroutine psb_scgs_vect(a,prec,b,x,eps,desc_a,info,& call psb_erractionrestore(err_act) return -9999 continue - call psb_erractionrestore(err_act) - if (err_act == psb_act_abort_) then - call psb_error() - return - end if +9999 call psb_error_handler(err_act) return End Subroutine psb_scgs_vect diff --git a/krylov/psb_scgstab.f90 b/krylov/psb_scgstab.f90 index 266b9c22..7fdcb8b4 100644 --- a/krylov/psb_scgstab.f90 +++ b/krylov/psb_scgstab.f90 @@ -385,12 +385,7 @@ Subroutine psb_scgstab_vect(a,prec,b,x,eps,desc_a,info,itmax,iter,err,itrace,ist call psb_erractionrestore(err_act) return -9999 continue - call psb_erractionrestore(err_act) - if (err_act == psb_act_abort_) then - call psb_error(ictxt) - return - end if +9999 call psb_error_handler(err_act) return End Subroutine psb_scgstab_vect diff --git a/krylov/psb_scgstabl.f90 b/krylov/psb_scgstabl.f90 index 89b19390..ec05e89c 100644 --- a/krylov/psb_scgstabl.f90 +++ b/krylov/psb_scgstabl.f90 @@ -411,12 +411,7 @@ Subroutine psb_scgstabl_vect(a,prec,b,x,eps,desc_a,info,& call psb_erractionrestore(err_act) return -9999 continue - call psb_erractionrestore(err_act) - if (err_act == psb_act_abort_) then - call psb_error() - return - end if +9999 call psb_error_handler(err_act) return End Subroutine psb_scgstabl_vect diff --git a/krylov/psb_skrylov.f90 b/krylov/psb_skrylov.f90 index d7d6c369..99c811b9 100644 --- a/krylov/psb_skrylov.f90 +++ b/krylov/psb_skrylov.f90 @@ -235,12 +235,9 @@ Subroutine psb_skrylov_vect(method,a,prec,b,x,eps,desc_a,info,& call psb_erractionrestore(err_act) return -9999 continue - call psb_erractionrestore(err_act) - if (err_act == psb_act_abort_) then - call psb_error(ictxt) - return - end if +9999 call psb_error_handler(ictxt,err_act) + + return end subroutine psb_skrylov_vect diff --git a/krylov/psb_srgmres.f90 b/krylov/psb_srgmres.f90 index 8968d92c..09db00ab 100644 --- a/krylov/psb_srgmres.f90 +++ b/krylov/psb_srgmres.f90 @@ -469,12 +469,7 @@ subroutine psb_srgmres_vect(a,prec,b,x,eps,desc_a,info,& call psb_erractionrestore(err_act) return -9999 continue - call psb_erractionrestore(err_act) - if (err_act == psb_act_abort_) then - call psb_error() - return - end if +9999 call psb_error_handler(err_act) return end subroutine psb_srgmres_vect diff --git a/krylov/psb_z_krylov_conv_mod.f90 b/krylov/psb_z_krylov_conv_mod.f90 index 85e6aa4b..ea0b40be 100644 --- a/krylov/psb_z_krylov_conv_mod.f90 +++ b/krylov/psb_z_krylov_conv_mod.f90 @@ -109,12 +109,9 @@ contains call psb_erractionrestore(err_act) return -9999 continue - call psb_erractionrestore(err_act) - if (err_act == psb_act_abort_) then - call psb_error(ictxt) - return - end if +9999 call psb_error_handler(ictxt,err_act) + + return end subroutine psb_z_init_conv @@ -184,12 +181,9 @@ contains call psb_erractionrestore(err_act) return -9999 continue - call psb_erractionrestore(err_act) - if (err_act == psb_act_abort_) then - call psb_error(ictxt) - return - end if +9999 call psb_error_handler(ictxt,err_act) + + return end function psb_z_check_conv @@ -255,12 +249,9 @@ contains call psb_erractionrestore(err_act) return -9999 continue - call psb_erractionrestore(err_act) - if (err_act == psb_act_abort_) then - call psb_error(ictxt) - return - end if +9999 call psb_error_handler(ictxt,err_act) + + return end subroutine psb_z_init_conv_vect @@ -331,12 +322,9 @@ contains call psb_erractionrestore(err_act) return -9999 continue - call psb_erractionrestore(err_act) - if (err_act == psb_act_abort_) then - call psb_error(ictxt) - return - end if +9999 call psb_error_handler(ictxt,err_act) + + return end function psb_z_check_conv_vect diff --git a/krylov/psb_zbicg.f90 b/krylov/psb_zbicg.f90 index b83ff1e5..725c8b2b 100644 --- a/krylov/psb_zbicg.f90 +++ b/krylov/psb_zbicg.f90 @@ -328,12 +328,7 @@ subroutine psb_zbicg_vect(a,prec,b,x,eps,desc_a,info,& call psb_erractionrestore(err_act) return -9999 continue - call psb_erractionrestore(err_act) - if (err_act == psb_act_abort_) then - call psb_error() - return - end if +9999 call psb_error_handler(err_act) return end subroutine psb_zbicg_vect diff --git a/krylov/psb_zcg.f90 b/krylov/psb_zcg.f90 index 9ac6e70a..dcca57c0 100644 --- a/krylov/psb_zcg.f90 +++ b/krylov/psb_zcg.f90 @@ -281,12 +281,7 @@ subroutine psb_zcg_vect(a,prec,b,x,eps,desc_a,info,& call psb_erractionrestore(err_act) return -9999 continue - call psb_erractionrestore(err_act) - if (err_act == psb_act_abort_) then - call psb_error() - return - end if +9999 call psb_error_handler(err_act) return end subroutine psb_zcg_vect diff --git a/krylov/psb_zcgs.f90 b/krylov/psb_zcgs.f90 index 622d0e1a..335bfd61 100644 --- a/krylov/psb_zcgs.f90 +++ b/krylov/psb_zcgs.f90 @@ -319,12 +319,7 @@ Subroutine psb_zcgs_vect(a,prec,b,x,eps,desc_a,info,& call psb_erractionrestore(err_act) return -9999 continue - call psb_erractionrestore(err_act) - if (err_act == psb_act_abort_) then - call psb_error() - return - end if +9999 call psb_error_handler(err_act) return End Subroutine psb_zcgs_vect diff --git a/krylov/psb_zcgstab.f90 b/krylov/psb_zcgstab.f90 index d9cb80eb..336863be 100644 --- a/krylov/psb_zcgstab.f90 +++ b/krylov/psb_zcgstab.f90 @@ -385,12 +385,7 @@ Subroutine psb_zcgstab_vect(a,prec,b,x,eps,desc_a,info,itmax,iter,err,itrace,ist call psb_erractionrestore(err_act) return -9999 continue - call psb_erractionrestore(err_act) - if (err_act == psb_act_abort_) then - call psb_error(ictxt) - return - end if +9999 call psb_error_handler(err_act) return End Subroutine psb_zcgstab_vect diff --git a/krylov/psb_zcgstabl.f90 b/krylov/psb_zcgstabl.f90 index d7ab18dc..575d8739 100644 --- a/krylov/psb_zcgstabl.f90 +++ b/krylov/psb_zcgstabl.f90 @@ -411,12 +411,7 @@ Subroutine psb_zcgstabl_vect(a,prec,b,x,eps,desc_a,info,& call psb_erractionrestore(err_act) return -9999 continue - call psb_erractionrestore(err_act) - if (err_act == psb_act_abort_) then - call psb_error() - return - end if +9999 call psb_error_handler(err_act) return End Subroutine psb_zcgstabl_vect diff --git a/krylov/psb_zkrylov.f90 b/krylov/psb_zkrylov.f90 index cfe10daf..daa905c4 100644 --- a/krylov/psb_zkrylov.f90 +++ b/krylov/psb_zkrylov.f90 @@ -235,12 +235,9 @@ Subroutine psb_zkrylov_vect(method,a,prec,b,x,eps,desc_a,info,& call psb_erractionrestore(err_act) return -9999 continue - call psb_erractionrestore(err_act) - if (err_act == psb_act_abort_) then - call psb_error(ictxt) - return - end if +9999 call psb_error_handler(ictxt,err_act) + + return end subroutine psb_zkrylov_vect diff --git a/krylov/psb_zrgmres.f90 b/krylov/psb_zrgmres.f90 index 124831ef..0342eebb 100644 --- a/krylov/psb_zrgmres.f90 +++ b/krylov/psb_zrgmres.f90 @@ -469,12 +469,7 @@ subroutine psb_zrgmres_vect(a,prec,b,x,eps,desc_a,info,& call psb_erractionrestore(err_act) return -9999 continue - call psb_erractionrestore(err_act) - if (err_act == psb_act_abort_) then - call psb_error() - return - end if +9999 call psb_error_handler(err_act) return end subroutine psb_zrgmres_vect diff --git a/prec/impl/psb_c_bjacprec_impl.f90 b/prec/impl/psb_c_bjacprec_impl.f90 index 643cbef3..a85d2847 100644 --- a/prec/impl/psb_c_bjacprec_impl.f90 +++ b/prec/impl/psb_c_bjacprec_impl.f90 @@ -218,14 +218,9 @@ subroutine psb_c_bjac_apply_vect(alpha,prec,x,beta,y,desc_data,info,trans,work) 9999 continue call psb_errpush(info,name,i_err=ierr,a_err=ch_err) - call psb_erractionrestore(err_act) - if (err_act == psb_act_abort_) then - call psb_error() - return - end if + call psb_error_handler(err_act) return - end subroutine psb_c_bjac_apply_vect subroutine psb_c_bjac_apply(alpha,prec,x,beta,y,desc_data,info,trans,work) @@ -372,14 +367,9 @@ subroutine psb_c_bjac_apply(alpha,prec,x,beta,y,desc_data,info,trans,work) 9999 continue call psb_errpush(info,name,i_err=ierr,a_err=ch_err) - call psb_erractionrestore(err_act) - if (err_act == psb_act_abort_) then - call psb_error() - return - end if + call psb_error_handler(err_act) return - end subroutine psb_c_bjac_apply subroutine psb_c_bjac_precinit(prec,info) @@ -411,13 +401,9 @@ subroutine psb_c_bjac_precinit(prec,info) call psb_erractionrestore(err_act) return -9999 continue - call psb_erractionrestore(err_act) - if (err_act == psb_act_abort_) then - call psb_error() - return - end if +9999 call psb_error_handler(err_act) return + end subroutine psb_c_bjac_precinit @@ -566,14 +552,8 @@ subroutine psb_c_bjac_precbld(a,desc_a,prec,info,upd,amold,afmt,vmold) call psb_erractionrestore(err_act) return -9999 continue - call psb_erractionrestore(err_act) - if (err_act == psb_act_abort_) then - call psb_error() - return - end if +9999 call psb_error_handler(err_act) return - end subroutine psb_c_bjac_precbld subroutine psb_c_bjac_precseti(prec,what,val,info) @@ -626,11 +606,6 @@ subroutine psb_c_bjac_precseti(prec,what,val,info) call psb_erractionrestore(err_act) return -9999 continue - call psb_erractionrestore(err_act) - if (err_act == psb_act_abort_) then - call psb_error() - return - end if +9999 call psb_error_handler(err_act) return end subroutine psb_c_bjac_precseti diff --git a/prec/impl/psb_c_diagprec_impl.f90 b/prec/impl/psb_c_diagprec_impl.f90 index 00abde62..0fab3cf3 100644 --- a/prec/impl/psb_c_diagprec_impl.f90 +++ b/prec/impl/psb_c_diagprec_impl.f90 @@ -123,12 +123,7 @@ subroutine psb_c_diag_apply_vect(alpha,prec,x,beta,y,desc_data,info,trans,work) call psb_erractionrestore(err_act) return -9999 continue - call psb_erractionrestore(err_act) - if (err_act == psb_act_abort_) then - call psb_error() - return - end if +9999 call psb_error_handler(err_act) return end subroutine psb_c_diag_apply_vect @@ -224,12 +219,7 @@ subroutine psb_c_diag_apply(alpha,prec,x,beta,y,desc_data,info,trans,work) call psb_erractionrestore(err_act) return -9999 continue - call psb_erractionrestore(err_act) - if (err_act == psb_act_abort_) then - call psb_error() - return - end if +9999 call psb_error_handler(err_act) return end subroutine psb_c_diag_apply @@ -290,12 +280,7 @@ subroutine psb_c_diag_precbld(a,desc_a,prec,info,upd,amold,afmt,vmold) call psb_erractionrestore(err_act) return -9999 continue - call psb_erractionrestore(err_act) - if (err_act == psb_act_abort_) then - call psb_error() - return - end if +9999 call psb_error_handler(err_act) return end subroutine psb_c_diag_precbld diff --git a/prec/impl/psb_c_nullprec_impl.f90 b/prec/impl/psb_c_nullprec_impl.f90 index 7a66f95b..692b88c3 100644 --- a/prec/impl/psb_c_nullprec_impl.f90 +++ b/prec/impl/psb_c_nullprec_impl.f90 @@ -74,12 +74,7 @@ subroutine psb_c_null_apply_vect(alpha,prec,x,beta,y,desc_data,info,trans,work) call psb_erractionrestore(err_act) return -9999 continue - call psb_erractionrestore(err_act) - if (err_act == psb_act_abort_) then - call psb_error() - return - end if +9999 call psb_error_handler(err_act) return end subroutine psb_c_null_apply_vect @@ -127,12 +122,7 @@ subroutine psb_c_null_apply(alpha,prec,x,beta,y,desc_data,info,trans,work) call psb_erractionrestore(err_act) return -9999 continue - call psb_erractionrestore(err_act) - if (err_act == psb_act_abort_) then - call psb_error() - return - end if +9999 call psb_error_handler(err_act) return end subroutine psb_c_null_apply diff --git a/prec/impl/psb_c_prec_type_impl.f90 b/prec/impl/psb_c_prec_type_impl.f90 index 5d8cf110..e5130533 100644 --- a/prec/impl/psb_c_prec_type_impl.f90 +++ b/prec/impl/psb_c_prec_type_impl.f90 @@ -127,12 +127,7 @@ subroutine psb_c_apply2_vect(prec,x,y,desc_data,info,trans,work) call psb_erractionrestore(err_act) return -9999 continue - call psb_erractionrestore(err_act) - if (err_act == psb_act_abort_) then - call psb_error() - return - end if +9999 call psb_error_handler(err_act) return end subroutine psb_c_apply2_vect @@ -204,12 +199,7 @@ subroutine psb_c_apply1_vect(prec,x,desc_data,info,trans,work) call psb_erractionrestore(err_act) return -9999 continue - call psb_erractionrestore(err_act) - if (err_act == psb_act_abort_) then - call psb_error() - return - end if +9999 call psb_error_handler(err_act) return end subroutine psb_c_apply1_vect @@ -276,12 +266,7 @@ subroutine psb_c_apply2v(prec,x,y,desc_data,info,trans,work) call psb_erractionrestore(err_act) return -9999 continue - call psb_erractionrestore(err_act) - if (err_act == psb_act_abort_) then - call psb_error() - return - end if +9999 call psb_error_handler(err_act) return end subroutine psb_c_apply2v @@ -342,11 +327,7 @@ subroutine psb_c_apply1v(prec,x,desc_data,info,trans) 9999 continue call psb_errpush(info,name) - call psb_erractionrestore(err_act) - if (err_act == psb_act_abort_) then - call psb_error() - return - end if + call psb_error_handler(err_act) return end subroutine psb_c_apply1v diff --git a/prec/impl/psb_cprecbld.f90 b/prec/impl/psb_cprecbld.f90 index 904d0af9..c71d04a4 100644 --- a/prec/impl/psb_cprecbld.f90 +++ b/prec/impl/psb_cprecbld.f90 @@ -88,14 +88,8 @@ subroutine psb_cprecbld(a,desc_a,p,info,upd,amold,afmt,vmold) call psb_erractionrestore(err_act) return -9999 continue - call psb_erractionrestore(err_act) - if (err_act == psb_act_abort_) then - call psb_error() - return - end if +9999 call psb_error_handler(err_act) return - end subroutine psb_cprecbld diff --git a/prec/impl/psb_d_bjacprec_impl.f90 b/prec/impl/psb_d_bjacprec_impl.f90 index 485fdc0b..ec256b12 100644 --- a/prec/impl/psb_d_bjacprec_impl.f90 +++ b/prec/impl/psb_d_bjacprec_impl.f90 @@ -218,14 +218,9 @@ subroutine psb_d_bjac_apply_vect(alpha,prec,x,beta,y,desc_data,info,trans,work) 9999 continue call psb_errpush(info,name,i_err=ierr,a_err=ch_err) - call psb_erractionrestore(err_act) - if (err_act == psb_act_abort_) then - call psb_error() - return - end if + call psb_error_handler(err_act) return - end subroutine psb_d_bjac_apply_vect subroutine psb_d_bjac_apply(alpha,prec,x,beta,y,desc_data,info,trans,work) @@ -372,14 +367,9 @@ subroutine psb_d_bjac_apply(alpha,prec,x,beta,y,desc_data,info,trans,work) 9999 continue call psb_errpush(info,name,i_err=ierr,a_err=ch_err) - call psb_erractionrestore(err_act) - if (err_act == psb_act_abort_) then - call psb_error() - return - end if + call psb_error_handler(err_act) return - end subroutine psb_d_bjac_apply subroutine psb_d_bjac_precinit(prec,info) @@ -411,13 +401,9 @@ subroutine psb_d_bjac_precinit(prec,info) call psb_erractionrestore(err_act) return -9999 continue - call psb_erractionrestore(err_act) - if (err_act == psb_act_abort_) then - call psb_error() - return - end if +9999 call psb_error_handler(err_act) return + end subroutine psb_d_bjac_precinit @@ -566,14 +552,8 @@ subroutine psb_d_bjac_precbld(a,desc_a,prec,info,upd,amold,afmt,vmold) call psb_erractionrestore(err_act) return -9999 continue - call psb_erractionrestore(err_act) - if (err_act == psb_act_abort_) then - call psb_error() - return - end if +9999 call psb_error_handler(err_act) return - end subroutine psb_d_bjac_precbld subroutine psb_d_bjac_precseti(prec,what,val,info) @@ -626,11 +606,6 @@ subroutine psb_d_bjac_precseti(prec,what,val,info) call psb_erractionrestore(err_act) return -9999 continue - call psb_erractionrestore(err_act) - if (err_act == psb_act_abort_) then - call psb_error() - return - end if +9999 call psb_error_handler(err_act) return end subroutine psb_d_bjac_precseti diff --git a/prec/impl/psb_d_diagprec_impl.f90 b/prec/impl/psb_d_diagprec_impl.f90 index 9e0e2ca8..e0814b8f 100644 --- a/prec/impl/psb_d_diagprec_impl.f90 +++ b/prec/impl/psb_d_diagprec_impl.f90 @@ -123,12 +123,7 @@ subroutine psb_d_diag_apply_vect(alpha,prec,x,beta,y,desc_data,info,trans,work) call psb_erractionrestore(err_act) return -9999 continue - call psb_erractionrestore(err_act) - if (err_act == psb_act_abort_) then - call psb_error() - return - end if +9999 call psb_error_handler(err_act) return end subroutine psb_d_diag_apply_vect @@ -224,12 +219,7 @@ subroutine psb_d_diag_apply(alpha,prec,x,beta,y,desc_data,info,trans,work) call psb_erractionrestore(err_act) return -9999 continue - call psb_erractionrestore(err_act) - if (err_act == psb_act_abort_) then - call psb_error() - return - end if +9999 call psb_error_handler(err_act) return end subroutine psb_d_diag_apply @@ -290,12 +280,7 @@ subroutine psb_d_diag_precbld(a,desc_a,prec,info,upd,amold,afmt,vmold) call psb_erractionrestore(err_act) return -9999 continue - call psb_erractionrestore(err_act) - if (err_act == psb_act_abort_) then - call psb_error() - return - end if +9999 call psb_error_handler(err_act) return end subroutine psb_d_diag_precbld diff --git a/prec/impl/psb_d_nullprec_impl.f90 b/prec/impl/psb_d_nullprec_impl.f90 index bc467097..47996477 100644 --- a/prec/impl/psb_d_nullprec_impl.f90 +++ b/prec/impl/psb_d_nullprec_impl.f90 @@ -74,12 +74,7 @@ subroutine psb_d_null_apply_vect(alpha,prec,x,beta,y,desc_data,info,trans,work) call psb_erractionrestore(err_act) return -9999 continue - call psb_erractionrestore(err_act) - if (err_act == psb_act_abort_) then - call psb_error() - return - end if +9999 call psb_error_handler(err_act) return end subroutine psb_d_null_apply_vect @@ -127,12 +122,7 @@ subroutine psb_d_null_apply(alpha,prec,x,beta,y,desc_data,info,trans,work) call psb_erractionrestore(err_act) return -9999 continue - call psb_erractionrestore(err_act) - if (err_act == psb_act_abort_) then - call psb_error() - return - end if +9999 call psb_error_handler(err_act) return end subroutine psb_d_null_apply diff --git a/prec/impl/psb_d_prec_type_impl.f90 b/prec/impl/psb_d_prec_type_impl.f90 index 8c398e51..fd0ec4ae 100644 --- a/prec/impl/psb_d_prec_type_impl.f90 +++ b/prec/impl/psb_d_prec_type_impl.f90 @@ -127,12 +127,7 @@ subroutine psb_d_apply2_vect(prec,x,y,desc_data,info,trans,work) call psb_erractionrestore(err_act) return -9999 continue - call psb_erractionrestore(err_act) - if (err_act == psb_act_abort_) then - call psb_error() - return - end if +9999 call psb_error_handler(err_act) return end subroutine psb_d_apply2_vect @@ -204,12 +199,7 @@ subroutine psb_d_apply1_vect(prec,x,desc_data,info,trans,work) call psb_erractionrestore(err_act) return -9999 continue - call psb_erractionrestore(err_act) - if (err_act == psb_act_abort_) then - call psb_error() - return - end if +9999 call psb_error_handler(err_act) return end subroutine psb_d_apply1_vect @@ -276,12 +266,7 @@ subroutine psb_d_apply2v(prec,x,y,desc_data,info,trans,work) call psb_erractionrestore(err_act) return -9999 continue - call psb_erractionrestore(err_act) - if (err_act == psb_act_abort_) then - call psb_error() - return - end if +9999 call psb_error_handler(err_act) return end subroutine psb_d_apply2v @@ -342,11 +327,7 @@ subroutine psb_d_apply1v(prec,x,desc_data,info,trans) 9999 continue call psb_errpush(info,name) - call psb_erractionrestore(err_act) - if (err_act == psb_act_abort_) then - call psb_error() - return - end if + call psb_error_handler(err_act) return end subroutine psb_d_apply1v diff --git a/prec/impl/psb_dprecbld.f90 b/prec/impl/psb_dprecbld.f90 index 721fca84..578ee21c 100644 --- a/prec/impl/psb_dprecbld.f90 +++ b/prec/impl/psb_dprecbld.f90 @@ -88,14 +88,8 @@ subroutine psb_dprecbld(a,desc_a,p,info,upd,amold,afmt,vmold) call psb_erractionrestore(err_act) return -9999 continue - call psb_erractionrestore(err_act) - if (err_act == psb_act_abort_) then - call psb_error() - return - end if +9999 call psb_error_handler(err_act) return - end subroutine psb_dprecbld diff --git a/prec/impl/psb_s_bjacprec_impl.f90 b/prec/impl/psb_s_bjacprec_impl.f90 index 074fa001..824775d3 100644 --- a/prec/impl/psb_s_bjacprec_impl.f90 +++ b/prec/impl/psb_s_bjacprec_impl.f90 @@ -218,14 +218,9 @@ subroutine psb_s_bjac_apply_vect(alpha,prec,x,beta,y,desc_data,info,trans,work) 9999 continue call psb_errpush(info,name,i_err=ierr,a_err=ch_err) - call psb_erractionrestore(err_act) - if (err_act == psb_act_abort_) then - call psb_error() - return - end if + call psb_error_handler(err_act) return - end subroutine psb_s_bjac_apply_vect subroutine psb_s_bjac_apply(alpha,prec,x,beta,y,desc_data,info,trans,work) @@ -372,14 +367,9 @@ subroutine psb_s_bjac_apply(alpha,prec,x,beta,y,desc_data,info,trans,work) 9999 continue call psb_errpush(info,name,i_err=ierr,a_err=ch_err) - call psb_erractionrestore(err_act) - if (err_act == psb_act_abort_) then - call psb_error() - return - end if + call psb_error_handler(err_act) return - end subroutine psb_s_bjac_apply subroutine psb_s_bjac_precinit(prec,info) @@ -411,13 +401,9 @@ subroutine psb_s_bjac_precinit(prec,info) call psb_erractionrestore(err_act) return -9999 continue - call psb_erractionrestore(err_act) - if (err_act == psb_act_abort_) then - call psb_error() - return - end if +9999 call psb_error_handler(err_act) return + end subroutine psb_s_bjac_precinit @@ -566,14 +552,8 @@ subroutine psb_s_bjac_precbld(a,desc_a,prec,info,upd,amold,afmt,vmold) call psb_erractionrestore(err_act) return -9999 continue - call psb_erractionrestore(err_act) - if (err_act == psb_act_abort_) then - call psb_error() - return - end if +9999 call psb_error_handler(err_act) return - end subroutine psb_s_bjac_precbld subroutine psb_s_bjac_precseti(prec,what,val,info) @@ -626,11 +606,6 @@ subroutine psb_s_bjac_precseti(prec,what,val,info) call psb_erractionrestore(err_act) return -9999 continue - call psb_erractionrestore(err_act) - if (err_act == psb_act_abort_) then - call psb_error() - return - end if +9999 call psb_error_handler(err_act) return end subroutine psb_s_bjac_precseti diff --git a/prec/impl/psb_s_diagprec_impl.f90 b/prec/impl/psb_s_diagprec_impl.f90 index a7e35326..bf3364a2 100644 --- a/prec/impl/psb_s_diagprec_impl.f90 +++ b/prec/impl/psb_s_diagprec_impl.f90 @@ -123,12 +123,7 @@ subroutine psb_s_diag_apply_vect(alpha,prec,x,beta,y,desc_data,info,trans,work) call psb_erractionrestore(err_act) return -9999 continue - call psb_erractionrestore(err_act) - if (err_act == psb_act_abort_) then - call psb_error() - return - end if +9999 call psb_error_handler(err_act) return end subroutine psb_s_diag_apply_vect @@ -224,12 +219,7 @@ subroutine psb_s_diag_apply(alpha,prec,x,beta,y,desc_data,info,trans,work) call psb_erractionrestore(err_act) return -9999 continue - call psb_erractionrestore(err_act) - if (err_act == psb_act_abort_) then - call psb_error() - return - end if +9999 call psb_error_handler(err_act) return end subroutine psb_s_diag_apply @@ -290,12 +280,7 @@ subroutine psb_s_diag_precbld(a,desc_a,prec,info,upd,amold,afmt,vmold) call psb_erractionrestore(err_act) return -9999 continue - call psb_erractionrestore(err_act) - if (err_act == psb_act_abort_) then - call psb_error() - return - end if +9999 call psb_error_handler(err_act) return end subroutine psb_s_diag_precbld diff --git a/prec/impl/psb_s_nullprec_impl.f90 b/prec/impl/psb_s_nullprec_impl.f90 index b28fa45a..0d31cbf2 100644 --- a/prec/impl/psb_s_nullprec_impl.f90 +++ b/prec/impl/psb_s_nullprec_impl.f90 @@ -74,12 +74,7 @@ subroutine psb_s_null_apply_vect(alpha,prec,x,beta,y,desc_data,info,trans,work) call psb_erractionrestore(err_act) return -9999 continue - call psb_erractionrestore(err_act) - if (err_act == psb_act_abort_) then - call psb_error() - return - end if +9999 call psb_error_handler(err_act) return end subroutine psb_s_null_apply_vect @@ -127,12 +122,7 @@ subroutine psb_s_null_apply(alpha,prec,x,beta,y,desc_data,info,trans,work) call psb_erractionrestore(err_act) return -9999 continue - call psb_erractionrestore(err_act) - if (err_act == psb_act_abort_) then - call psb_error() - return - end if +9999 call psb_error_handler(err_act) return end subroutine psb_s_null_apply diff --git a/prec/impl/psb_s_prec_type_impl.f90 b/prec/impl/psb_s_prec_type_impl.f90 index cace6af6..225c05ff 100644 --- a/prec/impl/psb_s_prec_type_impl.f90 +++ b/prec/impl/psb_s_prec_type_impl.f90 @@ -127,12 +127,7 @@ subroutine psb_s_apply2_vect(prec,x,y,desc_data,info,trans,work) call psb_erractionrestore(err_act) return -9999 continue - call psb_erractionrestore(err_act) - if (err_act == psb_act_abort_) then - call psb_error() - return - end if +9999 call psb_error_handler(err_act) return end subroutine psb_s_apply2_vect @@ -204,12 +199,7 @@ subroutine psb_s_apply1_vect(prec,x,desc_data,info,trans,work) call psb_erractionrestore(err_act) return -9999 continue - call psb_erractionrestore(err_act) - if (err_act == psb_act_abort_) then - call psb_error() - return - end if +9999 call psb_error_handler(err_act) return end subroutine psb_s_apply1_vect @@ -276,12 +266,7 @@ subroutine psb_s_apply2v(prec,x,y,desc_data,info,trans,work) call psb_erractionrestore(err_act) return -9999 continue - call psb_erractionrestore(err_act) - if (err_act == psb_act_abort_) then - call psb_error() - return - end if +9999 call psb_error_handler(err_act) return end subroutine psb_s_apply2v @@ -342,11 +327,7 @@ subroutine psb_s_apply1v(prec,x,desc_data,info,trans) 9999 continue call psb_errpush(info,name) - call psb_erractionrestore(err_act) - if (err_act == psb_act_abort_) then - call psb_error() - return - end if + call psb_error_handler(err_act) return end subroutine psb_s_apply1v diff --git a/prec/impl/psb_sprecbld.f90 b/prec/impl/psb_sprecbld.f90 index eda8a541..187059db 100644 --- a/prec/impl/psb_sprecbld.f90 +++ b/prec/impl/psb_sprecbld.f90 @@ -88,14 +88,8 @@ subroutine psb_sprecbld(a,desc_a,p,info,upd,amold,afmt,vmold) call psb_erractionrestore(err_act) return -9999 continue - call psb_erractionrestore(err_act) - if (err_act == psb_act_abort_) then - call psb_error() - return - end if +9999 call psb_error_handler(err_act) return - end subroutine psb_sprecbld diff --git a/prec/impl/psb_z_bjacprec_impl.f90 b/prec/impl/psb_z_bjacprec_impl.f90 index 82ca8bf7..2484ce46 100644 --- a/prec/impl/psb_z_bjacprec_impl.f90 +++ b/prec/impl/psb_z_bjacprec_impl.f90 @@ -218,14 +218,9 @@ subroutine psb_z_bjac_apply_vect(alpha,prec,x,beta,y,desc_data,info,trans,work) 9999 continue call psb_errpush(info,name,i_err=ierr,a_err=ch_err) - call psb_erractionrestore(err_act) - if (err_act == psb_act_abort_) then - call psb_error() - return - end if + call psb_error_handler(err_act) return - end subroutine psb_z_bjac_apply_vect subroutine psb_z_bjac_apply(alpha,prec,x,beta,y,desc_data,info,trans,work) @@ -372,14 +367,9 @@ subroutine psb_z_bjac_apply(alpha,prec,x,beta,y,desc_data,info,trans,work) 9999 continue call psb_errpush(info,name,i_err=ierr,a_err=ch_err) - call psb_erractionrestore(err_act) - if (err_act == psb_act_abort_) then - call psb_error() - return - end if + call psb_error_handler(err_act) return - end subroutine psb_z_bjac_apply subroutine psb_z_bjac_precinit(prec,info) @@ -411,13 +401,9 @@ subroutine psb_z_bjac_precinit(prec,info) call psb_erractionrestore(err_act) return -9999 continue - call psb_erractionrestore(err_act) - if (err_act == psb_act_abort_) then - call psb_error() - return - end if +9999 call psb_error_handler(err_act) return + end subroutine psb_z_bjac_precinit @@ -566,14 +552,8 @@ subroutine psb_z_bjac_precbld(a,desc_a,prec,info,upd,amold,afmt,vmold) call psb_erractionrestore(err_act) return -9999 continue - call psb_erractionrestore(err_act) - if (err_act == psb_act_abort_) then - call psb_error() - return - end if +9999 call psb_error_handler(err_act) return - end subroutine psb_z_bjac_precbld subroutine psb_z_bjac_precseti(prec,what,val,info) @@ -626,11 +606,6 @@ subroutine psb_z_bjac_precseti(prec,what,val,info) call psb_erractionrestore(err_act) return -9999 continue - call psb_erractionrestore(err_act) - if (err_act == psb_act_abort_) then - call psb_error() - return - end if +9999 call psb_error_handler(err_act) return end subroutine psb_z_bjac_precseti diff --git a/prec/impl/psb_z_diagprec_impl.f90 b/prec/impl/psb_z_diagprec_impl.f90 index 9c0bf05d..822ee296 100644 --- a/prec/impl/psb_z_diagprec_impl.f90 +++ b/prec/impl/psb_z_diagprec_impl.f90 @@ -123,12 +123,7 @@ subroutine psb_z_diag_apply_vect(alpha,prec,x,beta,y,desc_data,info,trans,work) call psb_erractionrestore(err_act) return -9999 continue - call psb_erractionrestore(err_act) - if (err_act == psb_act_abort_) then - call psb_error() - return - end if +9999 call psb_error_handler(err_act) return end subroutine psb_z_diag_apply_vect @@ -224,12 +219,7 @@ subroutine psb_z_diag_apply(alpha,prec,x,beta,y,desc_data,info,trans,work) call psb_erractionrestore(err_act) return -9999 continue - call psb_erractionrestore(err_act) - if (err_act == psb_act_abort_) then - call psb_error() - return - end if +9999 call psb_error_handler(err_act) return end subroutine psb_z_diag_apply @@ -290,12 +280,7 @@ subroutine psb_z_diag_precbld(a,desc_a,prec,info,upd,amold,afmt,vmold) call psb_erractionrestore(err_act) return -9999 continue - call psb_erractionrestore(err_act) - if (err_act == psb_act_abort_) then - call psb_error() - return - end if +9999 call psb_error_handler(err_act) return end subroutine psb_z_diag_precbld diff --git a/prec/impl/psb_z_nullprec_impl.f90 b/prec/impl/psb_z_nullprec_impl.f90 index 291db62c..45b84bb7 100644 --- a/prec/impl/psb_z_nullprec_impl.f90 +++ b/prec/impl/psb_z_nullprec_impl.f90 @@ -74,12 +74,7 @@ subroutine psb_z_null_apply_vect(alpha,prec,x,beta,y,desc_data,info,trans,work) call psb_erractionrestore(err_act) return -9999 continue - call psb_erractionrestore(err_act) - if (err_act == psb_act_abort_) then - call psb_error() - return - end if +9999 call psb_error_handler(err_act) return end subroutine psb_z_null_apply_vect @@ -127,12 +122,7 @@ subroutine psb_z_null_apply(alpha,prec,x,beta,y,desc_data,info,trans,work) call psb_erractionrestore(err_act) return -9999 continue - call psb_erractionrestore(err_act) - if (err_act == psb_act_abort_) then - call psb_error() - return - end if +9999 call psb_error_handler(err_act) return end subroutine psb_z_null_apply diff --git a/prec/impl/psb_z_prec_type_impl.f90 b/prec/impl/psb_z_prec_type_impl.f90 index ff6d5c63..8bd805d4 100644 --- a/prec/impl/psb_z_prec_type_impl.f90 +++ b/prec/impl/psb_z_prec_type_impl.f90 @@ -127,12 +127,7 @@ subroutine psb_z_apply2_vect(prec,x,y,desc_data,info,trans,work) call psb_erractionrestore(err_act) return -9999 continue - call psb_erractionrestore(err_act) - if (err_act == psb_act_abort_) then - call psb_error() - return - end if +9999 call psb_error_handler(err_act) return end subroutine psb_z_apply2_vect @@ -204,12 +199,7 @@ subroutine psb_z_apply1_vect(prec,x,desc_data,info,trans,work) call psb_erractionrestore(err_act) return -9999 continue - call psb_erractionrestore(err_act) - if (err_act == psb_act_abort_) then - call psb_error() - return - end if +9999 call psb_error_handler(err_act) return end subroutine psb_z_apply1_vect @@ -276,12 +266,7 @@ subroutine psb_z_apply2v(prec,x,y,desc_data,info,trans,work) call psb_erractionrestore(err_act) return -9999 continue - call psb_erractionrestore(err_act) - if (err_act == psb_act_abort_) then - call psb_error() - return - end if +9999 call psb_error_handler(err_act) return end subroutine psb_z_apply2v @@ -342,11 +327,7 @@ subroutine psb_z_apply1v(prec,x,desc_data,info,trans) 9999 continue call psb_errpush(info,name) - call psb_erractionrestore(err_act) - if (err_act == psb_act_abort_) then - call psb_error() - return - end if + call psb_error_handler(err_act) return end subroutine psb_z_apply1v diff --git a/prec/impl/psb_zprecbld.f90 b/prec/impl/psb_zprecbld.f90 index 59fad326..29671042 100644 --- a/prec/impl/psb_zprecbld.f90 +++ b/prec/impl/psb_zprecbld.f90 @@ -88,14 +88,8 @@ subroutine psb_zprecbld(a,desc_a,p,info,upd,amold,afmt,vmold) call psb_erractionrestore(err_act) return -9999 continue - call psb_erractionrestore(err_act) - if (err_act == psb_act_abort_) then - call psb_error() - return - end if +9999 call psb_error_handler(err_act) return - end subroutine psb_zprecbld diff --git a/prec/psb_c_bjacprec.f90 b/prec/psb_c_bjacprec.f90 index b29e0ca2..6dbb7ff3 100644 --- a/prec/psb_c_bjacprec.f90 +++ b/prec/psb_c_bjacprec.f90 @@ -134,8 +134,8 @@ module psb_c_bjacprec contains subroutine psb_c_bjac_precdescr(prec,iout) - - Implicit None + use psb_error_mod + implicit none class(psb_c_bjac_prec_type), intent(in) :: prec integer(psb_ipk_), intent(in), optional :: iout @@ -166,12 +166,8 @@ contains call psb_erractionrestore(err_act) return -9999 continue - call psb_erractionrestore(err_act) - if (err_act == psb_act_abort_) then - call psb_error() - return - end if +9999 call psb_error_handler(err_act) + return end subroutine psb_c_bjac_precdescr @@ -239,12 +235,8 @@ contains call psb_erractionrestore(err_act) return -9999 continue - call psb_erractionrestore(err_act) - if (err_act == psb_act_abort_) then - call psb_error() - return - end if +9999 call psb_error_handler(err_act) + return end subroutine psb_c_bjac_precfree @@ -270,7 +262,7 @@ contains if (info == psb_success_) deallocate(precout, stat=info) end if if (info == psb_success_) & - & allocate(psb_c_bjac_prec_type :: precout, stat=info) + & allocate(psb_c_bjac_prec_type :: precout, stat=info) if (info /= 0) goto 9999 select type(pout => precout) type is (psb_c_bjac_prec_type) @@ -289,7 +281,7 @@ contains allocate(pout%dv,stat=info) if (info == 0) call prec%dv%clone(pout%dv,info) end if - class default + class default info = psb_err_internal_error_ end select if (info /= 0) goto 9999 @@ -297,12 +289,8 @@ contains call psb_erractionrestore(err_act) return -9999 continue - call psb_erractionrestore(err_act) - if (err_act == psb_act_abort_) then - call psb_error() - return - end if +9999 call psb_error_handler(err_act) + return end subroutine psb_c_bjac_clone diff --git a/prec/psb_c_diagprec.f90 b/prec/psb_c_diagprec.f90 index 1919b245..c2cc325c 100644 --- a/prec/psb_c_diagprec.f90 +++ b/prec/psb_c_diagprec.f90 @@ -114,7 +114,7 @@ contains subroutine psb_c_diag_precinit(prec,info) Implicit None - + class(psb_c_diag_prec_type),intent(inout) :: prec integer(psb_ipk_), intent(out) :: info integer(psb_ipk_) :: err_act, nrow @@ -124,47 +124,39 @@ contains info = psb_success_ - + call psb_erractionrestore(err_act) return -9999 continue - call psb_erractionrestore(err_act) - if (err_act == psb_act_abort_) then - call psb_error() - return - end if +9999 call psb_error_handler(err_act) + return end subroutine psb_c_diag_precinit subroutine psb_c_diag_precfree(prec,info) - + Implicit None class(psb_c_diag_prec_type), intent(inout) :: prec integer(psb_ipk_), intent(out) :: info - + integer(psb_ipk_) :: err_act, nrow character(len=20) :: name='c_diag_precset' - + call psb_erractionsave(err_act) - + info = psb_success_ if (allocated(prec%dv)) call prec%dv%free(info) - + call psb_erractionrestore(err_act) return -9999 continue - call psb_erractionrestore(err_act) - if (err_act == psb_act_abort_) then - call psb_error() - return - end if +9999 call psb_error_handler(err_act) + return - + end subroutine psb_c_diag_precfree @@ -182,7 +174,7 @@ contains call psb_erractionsave(err_act) info = psb_success_ - + if (present(iout)) then iout_ = iout else @@ -194,18 +186,14 @@ contains call psb_erractionsave(err_act) info = psb_success_ - + call psb_erractionrestore(err_act) return -9999 continue - call psb_erractionrestore(err_act) - if (err_act == psb_act_abort_) then - call psb_error() - return - end if +9999 call psb_error_handler(err_act) + return - + end subroutine psb_c_diag_precdescr function psb_c_diag_sizeof(prec) result(val) @@ -247,7 +235,7 @@ contains if (info == psb_success_) deallocate(precout, stat=info) end if if (info == psb_success_) & - & allocate(psb_c_diag_prec_type :: precout, stat=info) + & allocate(psb_c_diag_prec_type :: precout, stat=info) if (info /= 0) goto 9999 select type(pout => precout) type is (psb_c_diag_prec_type) @@ -258,7 +246,7 @@ contains if (info == 0) call prec%dv%clone(pout%dv,info) end if if (info == 0) call psb_safe_ab_cpy(prec%d,pout%d,info) - class default + class default info = psb_err_internal_error_ end select if (info /= 0) goto 9999 @@ -266,12 +254,8 @@ contains call psb_erractionrestore(err_act) return -9999 continue - call psb_erractionrestore(err_act) - if (err_act == psb_act_abort_) then - call psb_error() - return - end if +9999 call psb_error_handler(err_act) + return end subroutine psb_c_diag_clone diff --git a/prec/psb_c_nullprec.f90 b/prec/psb_c_nullprec.f90 index ba8c6b41..db58d2c4 100644 --- a/prec/psb_c_nullprec.f90 +++ b/prec/psb_c_nullprec.f90 @@ -99,12 +99,8 @@ contains call psb_erractionrestore(err_act) return -9999 continue - call psb_erractionrestore(err_act) - if (err_act == psb_act_abort_) then - call psb_error() - return - end if +9999 call psb_error_handler(err_act) + return end subroutine psb_c_null_precinit @@ -131,12 +127,8 @@ contains call psb_erractionrestore(err_act) return -9999 continue - call psb_erractionrestore(err_act) - if (err_act == psb_act_abort_) then - call psb_error() - return - end if +9999 call psb_error_handler(err_act) + return end subroutine psb_c_null_precbld @@ -157,12 +149,8 @@ contains call psb_erractionrestore(err_act) return -9999 continue - call psb_erractionrestore(err_act) - if (err_act == psb_act_abort_) then - call psb_error() - return - end if +9999 call psb_error_handler(err_act) + return end subroutine psb_c_null_precfree @@ -194,12 +182,8 @@ contains call psb_erractionrestore(err_act) return -9999 continue - call psb_erractionrestore(err_act) - if (err_act == psb_act_abort_) then - call psb_error() - return - end if +9999 call psb_error_handler(err_act) + return end subroutine psb_c_null_precdescr @@ -295,12 +279,8 @@ contains call psb_erractionrestore(err_act) return -9999 continue - call psb_erractionrestore(err_act) - if (err_act == psb_act_abort_) then - call psb_error() - return - end if +9999 call psb_error_handler(err_act) + return end subroutine psb_c_null_clone diff --git a/prec/psb_c_prec_type.f90 b/prec/psb_c_prec_type.f90 index 0d44beb8..0734fe41 100644 --- a/prec/psb_c_prec_type.f90 +++ b/prec/psb_c_prec_type.f90 @@ -121,6 +121,8 @@ module psb_c_prec_type contains subroutine psb_cfile_prec_descr(p,iout) + use psb_base_mod + implicit none type(psb_cprec_type), intent(in) :: p integer(psb_ipk_), intent(in), optional :: iout integer(psb_ipk_) :: iout_,info @@ -162,6 +164,8 @@ contains subroutine psb_c_precfree(p,info) + use psb_base_mod + implicit none type(psb_cprec_type), intent(inout) :: p integer(psb_ipk_), intent(out) :: info integer(psb_ipk_) :: me, err_act,i @@ -178,16 +182,15 @@ contains call psb_erractionrestore(err_act) return -9999 continue - call psb_erractionrestore(err_act) - if (err_act == psb_act_abort_) then - call psb_error() - return - end if +9999 call psb_error_handler(err_act) + return + end subroutine psb_c_precfree subroutine psb_c_prec_free(prec,info) + use psb_base_mod + implicit none class(psb_cprec_type), intent(inout) :: prec integer(psb_ipk_), intent(out) :: info integer(psb_ipk_) :: me, err_act,i @@ -208,13 +211,10 @@ contains call psb_erractionrestore(err_act) return -9999 continue - call psb_erractionrestore(err_act) - if (err_act == psb_act_abort_) then - call psb_error() - return - end if +9999 call psb_error_handler(err_act) + return + end subroutine psb_c_prec_free function psb_cprec_sizeof(prec) result(val) diff --git a/prec/psb_d_bjacprec.f90 b/prec/psb_d_bjacprec.f90 index 43d8921c..a432eec5 100644 --- a/prec/psb_d_bjacprec.f90 +++ b/prec/psb_d_bjacprec.f90 @@ -134,8 +134,8 @@ module psb_d_bjacprec contains subroutine psb_d_bjac_precdescr(prec,iout) - - Implicit None + use psb_error_mod + implicit none class(psb_d_bjac_prec_type), intent(in) :: prec integer(psb_ipk_), intent(in), optional :: iout @@ -166,12 +166,8 @@ contains call psb_erractionrestore(err_act) return -9999 continue - call psb_erractionrestore(err_act) - if (err_act == psb_act_abort_) then - call psb_error() - return - end if +9999 call psb_error_handler(err_act) + return end subroutine psb_d_bjac_precdescr @@ -239,12 +235,8 @@ contains call psb_erractionrestore(err_act) return -9999 continue - call psb_erractionrestore(err_act) - if (err_act == psb_act_abort_) then - call psb_error() - return - end if +9999 call psb_error_handler(err_act) + return end subroutine psb_d_bjac_precfree @@ -270,7 +262,7 @@ contains if (info == psb_success_) deallocate(precout, stat=info) end if if (info == psb_success_) & - & allocate(psb_d_bjac_prec_type :: precout, stat=info) + & allocate(psb_d_bjac_prec_type :: precout, stat=info) if (info /= 0) goto 9999 select type(pout => precout) type is (psb_d_bjac_prec_type) @@ -289,7 +281,7 @@ contains allocate(pout%dv,stat=info) if (info == 0) call prec%dv%clone(pout%dv,info) end if - class default + class default info = psb_err_internal_error_ end select if (info /= 0) goto 9999 @@ -297,12 +289,8 @@ contains call psb_erractionrestore(err_act) return -9999 continue - call psb_erractionrestore(err_act) - if (err_act == psb_act_abort_) then - call psb_error() - return - end if +9999 call psb_error_handler(err_act) + return end subroutine psb_d_bjac_clone diff --git a/prec/psb_d_diagprec.f90 b/prec/psb_d_diagprec.f90 index 614db633..b57dcbb2 100644 --- a/prec/psb_d_diagprec.f90 +++ b/prec/psb_d_diagprec.f90 @@ -114,7 +114,7 @@ contains subroutine psb_d_diag_precinit(prec,info) Implicit None - + class(psb_d_diag_prec_type),intent(inout) :: prec integer(psb_ipk_), intent(out) :: info integer(psb_ipk_) :: err_act, nrow @@ -124,47 +124,39 @@ contains info = psb_success_ - + call psb_erractionrestore(err_act) return -9999 continue - call psb_erractionrestore(err_act) - if (err_act == psb_act_abort_) then - call psb_error() - return - end if +9999 call psb_error_handler(err_act) + return end subroutine psb_d_diag_precinit subroutine psb_d_diag_precfree(prec,info) - + Implicit None class(psb_d_diag_prec_type), intent(inout) :: prec integer(psb_ipk_), intent(out) :: info - + integer(psb_ipk_) :: err_act, nrow character(len=20) :: name='d_diag_precset' - + call psb_erractionsave(err_act) - + info = psb_success_ if (allocated(prec%dv)) call prec%dv%free(info) - + call psb_erractionrestore(err_act) return -9999 continue - call psb_erractionrestore(err_act) - if (err_act == psb_act_abort_) then - call psb_error() - return - end if +9999 call psb_error_handler(err_act) + return - + end subroutine psb_d_diag_precfree @@ -182,7 +174,7 @@ contains call psb_erractionsave(err_act) info = psb_success_ - + if (present(iout)) then iout_ = iout else @@ -194,18 +186,14 @@ contains call psb_erractionsave(err_act) info = psb_success_ - + call psb_erractionrestore(err_act) return -9999 continue - call psb_erractionrestore(err_act) - if (err_act == psb_act_abort_) then - call psb_error() - return - end if +9999 call psb_error_handler(err_act) + return - + end subroutine psb_d_diag_precdescr function psb_d_diag_sizeof(prec) result(val) @@ -247,7 +235,7 @@ contains if (info == psb_success_) deallocate(precout, stat=info) end if if (info == psb_success_) & - & allocate(psb_d_diag_prec_type :: precout, stat=info) + & allocate(psb_d_diag_prec_type :: precout, stat=info) if (info /= 0) goto 9999 select type(pout => precout) type is (psb_d_diag_prec_type) @@ -258,7 +246,7 @@ contains if (info == 0) call prec%dv%clone(pout%dv,info) end if if (info == 0) call psb_safe_ab_cpy(prec%d,pout%d,info) - class default + class default info = psb_err_internal_error_ end select if (info /= 0) goto 9999 @@ -266,12 +254,8 @@ contains call psb_erractionrestore(err_act) return -9999 continue - call psb_erractionrestore(err_act) - if (err_act == psb_act_abort_) then - call psb_error() - return - end if +9999 call psb_error_handler(err_act) + return end subroutine psb_d_diag_clone diff --git a/prec/psb_d_nullprec.f90 b/prec/psb_d_nullprec.f90 index 7fabd1e4..7b8cbb32 100644 --- a/prec/psb_d_nullprec.f90 +++ b/prec/psb_d_nullprec.f90 @@ -99,12 +99,8 @@ contains call psb_erractionrestore(err_act) return -9999 continue - call psb_erractionrestore(err_act) - if (err_act == psb_act_abort_) then - call psb_error() - return - end if +9999 call psb_error_handler(err_act) + return end subroutine psb_d_null_precinit @@ -131,12 +127,8 @@ contains call psb_erractionrestore(err_act) return -9999 continue - call psb_erractionrestore(err_act) - if (err_act == psb_act_abort_) then - call psb_error() - return - end if +9999 call psb_error_handler(err_act) + return end subroutine psb_d_null_precbld @@ -157,12 +149,8 @@ contains call psb_erractionrestore(err_act) return -9999 continue - call psb_erractionrestore(err_act) - if (err_act == psb_act_abort_) then - call psb_error() - return - end if +9999 call psb_error_handler(err_act) + return end subroutine psb_d_null_precfree @@ -194,12 +182,8 @@ contains call psb_erractionrestore(err_act) return -9999 continue - call psb_erractionrestore(err_act) - if (err_act == psb_act_abort_) then - call psb_error() - return - end if +9999 call psb_error_handler(err_act) + return end subroutine psb_d_null_precdescr @@ -295,12 +279,8 @@ contains call psb_erractionrestore(err_act) return -9999 continue - call psb_erractionrestore(err_act) - if (err_act == psb_act_abort_) then - call psb_error() - return - end if +9999 call psb_error_handler(err_act) + return end subroutine psb_d_null_clone diff --git a/prec/psb_d_prec_type.f90 b/prec/psb_d_prec_type.f90 index eda3c9a4..7da7c3ee 100644 --- a/prec/psb_d_prec_type.f90 +++ b/prec/psb_d_prec_type.f90 @@ -121,6 +121,8 @@ module psb_d_prec_type contains subroutine psb_dfile_prec_descr(p,iout) + use psb_base_mod + implicit none type(psb_dprec_type), intent(in) :: p integer(psb_ipk_), intent(in), optional :: iout integer(psb_ipk_) :: iout_,info @@ -162,6 +164,8 @@ contains subroutine psb_d_precfree(p,info) + use psb_base_mod + implicit none type(psb_dprec_type), intent(inout) :: p integer(psb_ipk_), intent(out) :: info integer(psb_ipk_) :: me, err_act,i @@ -178,16 +182,15 @@ contains call psb_erractionrestore(err_act) return -9999 continue - call psb_erractionrestore(err_act) - if (err_act == psb_act_abort_) then - call psb_error() - return - end if +9999 call psb_error_handler(err_act) + return + end subroutine psb_d_precfree subroutine psb_d_prec_free(prec,info) + use psb_base_mod + implicit none class(psb_dprec_type), intent(inout) :: prec integer(psb_ipk_), intent(out) :: info integer(psb_ipk_) :: me, err_act,i @@ -208,13 +211,10 @@ contains call psb_erractionrestore(err_act) return -9999 continue - call psb_erractionrestore(err_act) - if (err_act == psb_act_abort_) then - call psb_error() - return - end if +9999 call psb_error_handler(err_act) + return + end subroutine psb_d_prec_free function psb_dprec_sizeof(prec) result(val) diff --git a/prec/psb_s_bjacprec.f90 b/prec/psb_s_bjacprec.f90 index fb7793ec..dd2e7dfa 100644 --- a/prec/psb_s_bjacprec.f90 +++ b/prec/psb_s_bjacprec.f90 @@ -134,8 +134,8 @@ module psb_s_bjacprec contains subroutine psb_s_bjac_precdescr(prec,iout) - - Implicit None + use psb_error_mod + implicit none class(psb_s_bjac_prec_type), intent(in) :: prec integer(psb_ipk_), intent(in), optional :: iout @@ -166,12 +166,8 @@ contains call psb_erractionrestore(err_act) return -9999 continue - call psb_erractionrestore(err_act) - if (err_act == psb_act_abort_) then - call psb_error() - return - end if +9999 call psb_error_handler(err_act) + return end subroutine psb_s_bjac_precdescr @@ -239,12 +235,8 @@ contains call psb_erractionrestore(err_act) return -9999 continue - call psb_erractionrestore(err_act) - if (err_act == psb_act_abort_) then - call psb_error() - return - end if +9999 call psb_error_handler(err_act) + return end subroutine psb_s_bjac_precfree @@ -270,7 +262,7 @@ contains if (info == psb_success_) deallocate(precout, stat=info) end if if (info == psb_success_) & - & allocate(psb_s_bjac_prec_type :: precout, stat=info) + & allocate(psb_s_bjac_prec_type :: precout, stat=info) if (info /= 0) goto 9999 select type(pout => precout) type is (psb_s_bjac_prec_type) @@ -289,7 +281,7 @@ contains allocate(pout%dv,stat=info) if (info == 0) call prec%dv%clone(pout%dv,info) end if - class default + class default info = psb_err_internal_error_ end select if (info /= 0) goto 9999 @@ -297,12 +289,8 @@ contains call psb_erractionrestore(err_act) return -9999 continue - call psb_erractionrestore(err_act) - if (err_act == psb_act_abort_) then - call psb_error() - return - end if +9999 call psb_error_handler(err_act) + return end subroutine psb_s_bjac_clone diff --git a/prec/psb_s_diagprec.f90 b/prec/psb_s_diagprec.f90 index 2dfa401f..7bffea02 100644 --- a/prec/psb_s_diagprec.f90 +++ b/prec/psb_s_diagprec.f90 @@ -114,7 +114,7 @@ contains subroutine psb_s_diag_precinit(prec,info) Implicit None - + class(psb_s_diag_prec_type),intent(inout) :: prec integer(psb_ipk_), intent(out) :: info integer(psb_ipk_) :: err_act, nrow @@ -124,47 +124,39 @@ contains info = psb_success_ - + call psb_erractionrestore(err_act) return -9999 continue - call psb_erractionrestore(err_act) - if (err_act == psb_act_abort_) then - call psb_error() - return - end if +9999 call psb_error_handler(err_act) + return end subroutine psb_s_diag_precinit subroutine psb_s_diag_precfree(prec,info) - + Implicit None class(psb_s_diag_prec_type), intent(inout) :: prec integer(psb_ipk_), intent(out) :: info - + integer(psb_ipk_) :: err_act, nrow character(len=20) :: name='s_diag_precset' - + call psb_erractionsave(err_act) - + info = psb_success_ if (allocated(prec%dv)) call prec%dv%free(info) - + call psb_erractionrestore(err_act) return -9999 continue - call psb_erractionrestore(err_act) - if (err_act == psb_act_abort_) then - call psb_error() - return - end if +9999 call psb_error_handler(err_act) + return - + end subroutine psb_s_diag_precfree @@ -182,7 +174,7 @@ contains call psb_erractionsave(err_act) info = psb_success_ - + if (present(iout)) then iout_ = iout else @@ -194,18 +186,14 @@ contains call psb_erractionsave(err_act) info = psb_success_ - + call psb_erractionrestore(err_act) return -9999 continue - call psb_erractionrestore(err_act) - if (err_act == psb_act_abort_) then - call psb_error() - return - end if +9999 call psb_error_handler(err_act) + return - + end subroutine psb_s_diag_precdescr function psb_s_diag_sizeof(prec) result(val) @@ -247,7 +235,7 @@ contains if (info == psb_success_) deallocate(precout, stat=info) end if if (info == psb_success_) & - & allocate(psb_s_diag_prec_type :: precout, stat=info) + & allocate(psb_s_diag_prec_type :: precout, stat=info) if (info /= 0) goto 9999 select type(pout => precout) type is (psb_s_diag_prec_type) @@ -258,7 +246,7 @@ contains if (info == 0) call prec%dv%clone(pout%dv,info) end if if (info == 0) call psb_safe_ab_cpy(prec%d,pout%d,info) - class default + class default info = psb_err_internal_error_ end select if (info /= 0) goto 9999 @@ -266,12 +254,8 @@ contains call psb_erractionrestore(err_act) return -9999 continue - call psb_erractionrestore(err_act) - if (err_act == psb_act_abort_) then - call psb_error() - return - end if +9999 call psb_error_handler(err_act) + return end subroutine psb_s_diag_clone diff --git a/prec/psb_s_nullprec.f90 b/prec/psb_s_nullprec.f90 index 17f71797..af5da86e 100644 --- a/prec/psb_s_nullprec.f90 +++ b/prec/psb_s_nullprec.f90 @@ -99,12 +99,8 @@ contains call psb_erractionrestore(err_act) return -9999 continue - call psb_erractionrestore(err_act) - if (err_act == psb_act_abort_) then - call psb_error() - return - end if +9999 call psb_error_handler(err_act) + return end subroutine psb_s_null_precinit @@ -131,12 +127,8 @@ contains call psb_erractionrestore(err_act) return -9999 continue - call psb_erractionrestore(err_act) - if (err_act == psb_act_abort_) then - call psb_error() - return - end if +9999 call psb_error_handler(err_act) + return end subroutine psb_s_null_precbld @@ -157,12 +149,8 @@ contains call psb_erractionrestore(err_act) return -9999 continue - call psb_erractionrestore(err_act) - if (err_act == psb_act_abort_) then - call psb_error() - return - end if +9999 call psb_error_handler(err_act) + return end subroutine psb_s_null_precfree @@ -194,12 +182,8 @@ contains call psb_erractionrestore(err_act) return -9999 continue - call psb_erractionrestore(err_act) - if (err_act == psb_act_abort_) then - call psb_error() - return - end if +9999 call psb_error_handler(err_act) + return end subroutine psb_s_null_precdescr @@ -295,12 +279,8 @@ contains call psb_erractionrestore(err_act) return -9999 continue - call psb_erractionrestore(err_act) - if (err_act == psb_act_abort_) then - call psb_error() - return - end if +9999 call psb_error_handler(err_act) + return end subroutine psb_s_null_clone diff --git a/prec/psb_s_prec_type.f90 b/prec/psb_s_prec_type.f90 index 149faed0..2d58e464 100644 --- a/prec/psb_s_prec_type.f90 +++ b/prec/psb_s_prec_type.f90 @@ -121,6 +121,8 @@ module psb_s_prec_type contains subroutine psb_sfile_prec_descr(p,iout) + use psb_base_mod + implicit none type(psb_sprec_type), intent(in) :: p integer(psb_ipk_), intent(in), optional :: iout integer(psb_ipk_) :: iout_,info @@ -162,6 +164,8 @@ contains subroutine psb_s_precfree(p,info) + use psb_base_mod + implicit none type(psb_sprec_type), intent(inout) :: p integer(psb_ipk_), intent(out) :: info integer(psb_ipk_) :: me, err_act,i @@ -178,16 +182,15 @@ contains call psb_erractionrestore(err_act) return -9999 continue - call psb_erractionrestore(err_act) - if (err_act == psb_act_abort_) then - call psb_error() - return - end if +9999 call psb_error_handler(err_act) + return + end subroutine psb_s_precfree subroutine psb_s_prec_free(prec,info) + use psb_base_mod + implicit none class(psb_sprec_type), intent(inout) :: prec integer(psb_ipk_), intent(out) :: info integer(psb_ipk_) :: me, err_act,i @@ -208,13 +211,10 @@ contains call psb_erractionrestore(err_act) return -9999 continue - call psb_erractionrestore(err_act) - if (err_act == psb_act_abort_) then - call psb_error() - return - end if +9999 call psb_error_handler(err_act) + return + end subroutine psb_s_prec_free function psb_sprec_sizeof(prec) result(val) diff --git a/prec/psb_z_bjacprec.f90 b/prec/psb_z_bjacprec.f90 index 01a8b06e..7ef25152 100644 --- a/prec/psb_z_bjacprec.f90 +++ b/prec/psb_z_bjacprec.f90 @@ -134,8 +134,8 @@ module psb_z_bjacprec contains subroutine psb_z_bjac_precdescr(prec,iout) - - Implicit None + use psb_error_mod + implicit none class(psb_z_bjac_prec_type), intent(in) :: prec integer(psb_ipk_), intent(in), optional :: iout @@ -166,12 +166,8 @@ contains call psb_erractionrestore(err_act) return -9999 continue - call psb_erractionrestore(err_act) - if (err_act == psb_act_abort_) then - call psb_error() - return - end if +9999 call psb_error_handler(err_act) + return end subroutine psb_z_bjac_precdescr @@ -239,12 +235,8 @@ contains call psb_erractionrestore(err_act) return -9999 continue - call psb_erractionrestore(err_act) - if (err_act == psb_act_abort_) then - call psb_error() - return - end if +9999 call psb_error_handler(err_act) + return end subroutine psb_z_bjac_precfree @@ -270,7 +262,7 @@ contains if (info == psb_success_) deallocate(precout, stat=info) end if if (info == psb_success_) & - & allocate(psb_z_bjac_prec_type :: precout, stat=info) + & allocate(psb_z_bjac_prec_type :: precout, stat=info) if (info /= 0) goto 9999 select type(pout => precout) type is (psb_z_bjac_prec_type) @@ -289,7 +281,7 @@ contains allocate(pout%dv,stat=info) if (info == 0) call prec%dv%clone(pout%dv,info) end if - class default + class default info = psb_err_internal_error_ end select if (info /= 0) goto 9999 @@ -297,12 +289,8 @@ contains call psb_erractionrestore(err_act) return -9999 continue - call psb_erractionrestore(err_act) - if (err_act == psb_act_abort_) then - call psb_error() - return - end if +9999 call psb_error_handler(err_act) + return end subroutine psb_z_bjac_clone diff --git a/prec/psb_z_diagprec.f90 b/prec/psb_z_diagprec.f90 index dc562aec..13732fa3 100644 --- a/prec/psb_z_diagprec.f90 +++ b/prec/psb_z_diagprec.f90 @@ -114,7 +114,7 @@ contains subroutine psb_z_diag_precinit(prec,info) Implicit None - + class(psb_z_diag_prec_type),intent(inout) :: prec integer(psb_ipk_), intent(out) :: info integer(psb_ipk_) :: err_act, nrow @@ -124,47 +124,39 @@ contains info = psb_success_ - + call psb_erractionrestore(err_act) return -9999 continue - call psb_erractionrestore(err_act) - if (err_act == psb_act_abort_) then - call psb_error() - return - end if +9999 call psb_error_handler(err_act) + return end subroutine psb_z_diag_precinit subroutine psb_z_diag_precfree(prec,info) - + Implicit None class(psb_z_diag_prec_type), intent(inout) :: prec integer(psb_ipk_), intent(out) :: info - + integer(psb_ipk_) :: err_act, nrow character(len=20) :: name='z_diag_precset' - + call psb_erractionsave(err_act) - + info = psb_success_ if (allocated(prec%dv)) call prec%dv%free(info) - + call psb_erractionrestore(err_act) return -9999 continue - call psb_erractionrestore(err_act) - if (err_act == psb_act_abort_) then - call psb_error() - return - end if +9999 call psb_error_handler(err_act) + return - + end subroutine psb_z_diag_precfree @@ -182,7 +174,7 @@ contains call psb_erractionsave(err_act) info = psb_success_ - + if (present(iout)) then iout_ = iout else @@ -194,18 +186,14 @@ contains call psb_erractionsave(err_act) info = psb_success_ - + call psb_erractionrestore(err_act) return -9999 continue - call psb_erractionrestore(err_act) - if (err_act == psb_act_abort_) then - call psb_error() - return - end if +9999 call psb_error_handler(err_act) + return - + end subroutine psb_z_diag_precdescr function psb_z_diag_sizeof(prec) result(val) @@ -247,7 +235,7 @@ contains if (info == psb_success_) deallocate(precout, stat=info) end if if (info == psb_success_) & - & allocate(psb_z_diag_prec_type :: precout, stat=info) + & allocate(psb_z_diag_prec_type :: precout, stat=info) if (info /= 0) goto 9999 select type(pout => precout) type is (psb_z_diag_prec_type) @@ -258,7 +246,7 @@ contains if (info == 0) call prec%dv%clone(pout%dv,info) end if if (info == 0) call psb_safe_ab_cpy(prec%d,pout%d,info) - class default + class default info = psb_err_internal_error_ end select if (info /= 0) goto 9999 @@ -266,12 +254,8 @@ contains call psb_erractionrestore(err_act) return -9999 continue - call psb_erractionrestore(err_act) - if (err_act == psb_act_abort_) then - call psb_error() - return - end if +9999 call psb_error_handler(err_act) + return end subroutine psb_z_diag_clone diff --git a/prec/psb_z_nullprec.f90 b/prec/psb_z_nullprec.f90 index 6ba730b9..43ec0ecf 100644 --- a/prec/psb_z_nullprec.f90 +++ b/prec/psb_z_nullprec.f90 @@ -99,12 +99,8 @@ contains call psb_erractionrestore(err_act) return -9999 continue - call psb_erractionrestore(err_act) - if (err_act == psb_act_abort_) then - call psb_error() - return - end if +9999 call psb_error_handler(err_act) + return end subroutine psb_z_null_precinit @@ -131,12 +127,8 @@ contains call psb_erractionrestore(err_act) return -9999 continue - call psb_erractionrestore(err_act) - if (err_act == psb_act_abort_) then - call psb_error() - return - end if +9999 call psb_error_handler(err_act) + return end subroutine psb_z_null_precbld @@ -157,12 +149,8 @@ contains call psb_erractionrestore(err_act) return -9999 continue - call psb_erractionrestore(err_act) - if (err_act == psb_act_abort_) then - call psb_error() - return - end if +9999 call psb_error_handler(err_act) + return end subroutine psb_z_null_precfree @@ -194,12 +182,8 @@ contains call psb_erractionrestore(err_act) return -9999 continue - call psb_erractionrestore(err_act) - if (err_act == psb_act_abort_) then - call psb_error() - return - end if +9999 call psb_error_handler(err_act) + return end subroutine psb_z_null_precdescr @@ -295,12 +279,8 @@ contains call psb_erractionrestore(err_act) return -9999 continue - call psb_erractionrestore(err_act) - if (err_act == psb_act_abort_) then - call psb_error() - return - end if +9999 call psb_error_handler(err_act) + return end subroutine psb_z_null_clone diff --git a/prec/psb_z_prec_type.f90 b/prec/psb_z_prec_type.f90 index 1199b159..37eb1ffa 100644 --- a/prec/psb_z_prec_type.f90 +++ b/prec/psb_z_prec_type.f90 @@ -121,6 +121,8 @@ module psb_z_prec_type contains subroutine psb_zfile_prec_descr(p,iout) + use psb_base_mod + implicit none type(psb_zprec_type), intent(in) :: p integer(psb_ipk_), intent(in), optional :: iout integer(psb_ipk_) :: iout_,info @@ -162,6 +164,8 @@ contains subroutine psb_z_precfree(p,info) + use psb_base_mod + implicit none type(psb_zprec_type), intent(inout) :: p integer(psb_ipk_), intent(out) :: info integer(psb_ipk_) :: me, err_act,i @@ -178,16 +182,15 @@ contains call psb_erractionrestore(err_act) return -9999 continue - call psb_erractionrestore(err_act) - if (err_act == psb_act_abort_) then - call psb_error() - return - end if +9999 call psb_error_handler(err_act) + return + end subroutine psb_z_precfree subroutine psb_z_prec_free(prec,info) + use psb_base_mod + implicit none class(psb_zprec_type), intent(inout) :: prec integer(psb_ipk_), intent(out) :: info integer(psb_ipk_) :: me, err_act,i @@ -208,13 +211,10 @@ contains call psb_erractionrestore(err_act) return -9999 continue - call psb_erractionrestore(err_act) - if (err_act == psb_act_abort_) then - call psb_error() - return - end if +9999 call psb_error_handler(err_act) + return + end subroutine psb_z_prec_free function psb_zprec_sizeof(prec) result(val)