From 53ba95c3f2efdc6bcc4535ace86ee618e96cc317 Mon Sep 17 00:00:00 2001 From: Salvatore Filippone Date: Sun, 21 Dec 2014 21:29:24 +0000 Subject: [PATCH] mld2p4-2: mlprec/mld_c_as_smoother.f90 mlprec/mld_c_diag_solver.f90 mlprec/mld_c_ilu_solver.f90 mlprec/mld_c_jac_smoother.f90 mlprec/mld_c_prec_type.f90 mlprec/mld_c_slu_solver.F90 mlprec/mld_c_sludist_solver.F90 mlprec/mld_c_umf_solver.F90 mlprec/mld_d_as_smoother.f90 mlprec/mld_d_diag_solver.f90 mlprec/mld_d_ilu_solver.f90 mlprec/mld_d_jac_smoother.f90 mlprec/mld_d_prec_type.f90 mlprec/mld_d_slu_solver.F90 mlprec/mld_d_sludist_solver.F90 mlprec/mld_d_umf_solver.F90 mlprec/mld_s_as_smoother.f90 mlprec/mld_s_diag_solver.f90 mlprec/mld_s_ilu_solver.f90 mlprec/mld_s_jac_smoother.f90 mlprec/mld_s_prec_type.f90 mlprec/mld_s_slu_solver.F90 mlprec/mld_s_sludist_solver.F90 mlprec/mld_s_umf_solver.F90 mlprec/mld_z_as_smoother.f90 mlprec/mld_z_diag_solver.f90 mlprec/mld_z_ilu_solver.f90 mlprec/mld_z_jac_smoother.f90 mlprec/mld_z_prec_type.f90 mlprec/mld_z_slu_solver.F90 mlprec/mld_z_sludist_solver.F90 mlprec/mld_z_umf_solver.F90 tests/fileread/runs/dfs.inp New error handling. --- mlprec/mld_c_as_smoother.f90 | 8 +--- mlprec/mld_c_diag_solver.f90 | 8 +--- mlprec/mld_c_ilu_solver.f90 | 70 ++++++--------------------------- mlprec/mld_c_jac_smoother.f90 | 20 +++------- mlprec/mld_c_prec_type.f90 | 37 +++-------------- mlprec/mld_c_slu_solver.F90 | 39 ++++-------------- mlprec/mld_c_sludist_solver.F90 | 35 +++-------------- mlprec/mld_c_umf_solver.F90 | 35 +++-------------- mlprec/mld_d_as_smoother.f90 | 8 +--- mlprec/mld_d_diag_solver.f90 | 8 +--- mlprec/mld_d_ilu_solver.f90 | 70 ++++++--------------------------- mlprec/mld_d_jac_smoother.f90 | 20 +++------- mlprec/mld_d_prec_type.f90 | 37 +++-------------- mlprec/mld_d_slu_solver.F90 | 39 ++++-------------- mlprec/mld_d_sludist_solver.F90 | 35 +++-------------- mlprec/mld_d_umf_solver.F90 | 35 +++-------------- mlprec/mld_s_as_smoother.f90 | 8 +--- mlprec/mld_s_diag_solver.f90 | 8 +--- mlprec/mld_s_ilu_solver.f90 | 70 ++++++--------------------------- mlprec/mld_s_jac_smoother.f90 | 20 +++------- mlprec/mld_s_prec_type.f90 | 37 +++-------------- mlprec/mld_s_slu_solver.F90 | 39 ++++-------------- mlprec/mld_s_sludist_solver.F90 | 35 +++-------------- mlprec/mld_s_umf_solver.F90 | 35 +++-------------- mlprec/mld_z_as_smoother.f90 | 8 +--- mlprec/mld_z_diag_solver.f90 | 8 +--- mlprec/mld_z_ilu_solver.f90 | 70 ++++++--------------------------- mlprec/mld_z_jac_smoother.f90 | 20 +++------- mlprec/mld_z_prec_type.f90 | 37 +++-------------- mlprec/mld_z_slu_solver.F90 | 39 ++++-------------- mlprec/mld_z_sludist_solver.F90 | 35 +++-------------- mlprec/mld_z_umf_solver.F90 | 35 +++-------------- tests/fileread/runs/dfs.inp | 10 ++--- 33 files changed, 185 insertions(+), 833 deletions(-) diff --git a/mlprec/mld_c_as_smoother.f90 b/mlprec/mld_c_as_smoother.f90 index 00d2dfad..64f40d1c 100644 --- a/mlprec/mld_c_as_smoother.f90 +++ b/mlprec/mld_c_as_smoother.f90 @@ -366,13 +366,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() - return - end if +9999 call psb_error_handler(err_act) return + end subroutine c_as_smoother_descr function c_as_smoother_get_fmt() result(val) diff --git a/mlprec/mld_c_diag_solver.f90 b/mlprec/mld_c_diag_solver.f90 index 47205ccb..dffeb65b 100644 --- a/mlprec/mld_c_diag_solver.f90 +++ b/mlprec/mld_c_diag_solver.f90 @@ -175,13 +175,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() - return - end if +9999 call psb_error_handler(err_act) return + end subroutine c_diag_solver_free subroutine c_diag_solver_descr(sv,info,iout,coarse) diff --git a/mlprec/mld_c_ilu_solver.f90 b/mlprec/mld_c_ilu_solver.f90 index 271c3d67..073f6fa0 100644 --- a/mlprec/mld_c_ilu_solver.f90 +++ b/mlprec/mld_c_ilu_solver.f90 @@ -233,13 +233,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() - return - end if +9999 call psb_error_handler(err_act) return + end subroutine c_ilu_solver_check @@ -270,12 +266,7 @@ 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 c_ilu_solver_seti @@ -309,12 +300,7 @@ 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 c_ilu_solver_setc @@ -343,12 +329,7 @@ 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 c_ilu_solver_setr @@ -379,12 +360,7 @@ 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 c_ilu_solver_cseti @@ -418,12 +394,7 @@ 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 c_ilu_solver_csetc @@ -452,12 +423,7 @@ 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 c_ilu_solver_csetr @@ -473,7 +439,7 @@ contains call psb_erractionsave(err_act) info = psb_success_ - + if (allocated(sv%d)) then deallocate(sv%d,stat=info) if (info /= psb_success_) then @@ -489,12 +455,7 @@ 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 c_ilu_solver_free @@ -520,9 +481,9 @@ contains else iout_ = 6 endif - + write(iout_,*) ' Incomplete factorization solver: ',& - & fact_names(sv%fact_type) + & fact_names(sv%fact_type) select case(sv%fact_type) case(mld_ilu_n_,mld_milu_n_) write(iout_,*) ' Fill level:',sv%fill_in @@ -534,12 +495,7 @@ 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 c_ilu_solver_descr diff --git a/mlprec/mld_c_jac_smoother.f90 b/mlprec/mld_c_jac_smoother.f90 index c8ad338c..900b1bad 100644 --- a/mlprec/mld_c_jac_smoother.f90 +++ b/mlprec/mld_c_jac_smoother.f90 @@ -165,8 +165,8 @@ contains call psb_erractionsave(err_act) info = psb_success_ - - + + if (allocated(sm%sv)) then call sm%sv%free(info) if (info == psb_success_) deallocate(sm%sv,stat=info) @@ -181,12 +181,7 @@ 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 c_jac_smoother_free @@ -218,7 +213,7 @@ contains else iout_ = 6 endif - + if (.not.coarse_) then write(iout_,*) ' Block Jacobi smoother ' write(iout_,*) ' Local solver:' @@ -230,12 +225,7 @@ 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 c_jac_smoother_descr diff --git a/mlprec/mld_c_prec_type.f90 b/mlprec/mld_c_prec_type.f90 index a7b4ede9..0f337515 100644 --- a/mlprec/mld_c_prec_type.f90 +++ b/mlprec/mld_c_prec_type.f90 @@ -570,12 +570,7 @@ contains call psb_erractionrestore(err_act) return -9999 continue - call psb_erractionrestore(err_act) - if (err_act.eq.psb_act_abort_) then - call psb_error() - return - end if +9999 call psb_error_handler(err_act) return end subroutine mld_c_prec_free @@ -611,12 +606,7 @@ 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 mld_c_apply2_vect @@ -646,12 +636,7 @@ 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 mld_c_apply1_vect @@ -683,12 +668,7 @@ 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 mld_c_apply2v @@ -717,13 +697,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 - return +9999 call psb_error_handler(err_act) + return end subroutine mld_c_apply1v diff --git a/mlprec/mld_c_slu_solver.F90 b/mlprec/mld_c_slu_solver.F90 index 91826127..bca7a34f 100644 --- a/mlprec/mld_c_slu_solver.F90 +++ b/mlprec/mld_c_slu_solver.F90 @@ -193,12 +193,7 @@ 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 c_slu_solver_apply @@ -231,14 +226,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() - return - end if +9999 call psb_error_handler(err_act) return - + end subroutine c_slu_solver_apply_vect subroutine c_slu_solver_bld(a,desc_a,sv,upd,info,b,amold,vmold,imold) @@ -317,12 +307,7 @@ 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 c_slu_solver_bld @@ -348,13 +333,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 - return +9999 call psb_error_handler(err_act) + return end subroutine c_slu_solver_free #if defined(HAVE_FINAL) @@ -404,12 +384,7 @@ 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 c_slu_solver_descr diff --git a/mlprec/mld_c_sludist_solver.F90 b/mlprec/mld_c_sludist_solver.F90 index 03d75921..8e0c3659 100644 --- a/mlprec/mld_c_sludist_solver.F90 +++ b/mlprec/mld_c_sludist_solver.F90 @@ -189,12 +189,7 @@ 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 c_sludist_solver_apply @@ -227,12 +222,7 @@ 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 c_sludist_solver_apply_vect @@ -319,12 +309,7 @@ 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 c_sludist_solver_bld @@ -350,12 +335,7 @@ 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 c_sludist_solver_free @@ -406,12 +386,7 @@ 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 c_sludist_solver_descr diff --git a/mlprec/mld_c_umf_solver.F90 b/mlprec/mld_c_umf_solver.F90 index 065be919..0749f411 100644 --- a/mlprec/mld_c_umf_solver.F90 +++ b/mlprec/mld_c_umf_solver.F90 @@ -197,12 +197,7 @@ 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 c_umf_solver_apply @@ -235,12 +230,7 @@ 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 c_umf_solver_apply_vect @@ -319,12 +309,7 @@ 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 c_umf_solver_bld @@ -352,12 +337,7 @@ 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 c_umf_solver_free @@ -408,12 +388,7 @@ 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 c_umf_solver_descr diff --git a/mlprec/mld_d_as_smoother.f90 b/mlprec/mld_d_as_smoother.f90 index e2c03c84..b9924caa 100644 --- a/mlprec/mld_d_as_smoother.f90 +++ b/mlprec/mld_d_as_smoother.f90 @@ -366,13 +366,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() - return - end if +9999 call psb_error_handler(err_act) return + end subroutine d_as_smoother_descr function d_as_smoother_get_fmt() result(val) diff --git a/mlprec/mld_d_diag_solver.f90 b/mlprec/mld_d_diag_solver.f90 index 19aa31f7..48bfb777 100644 --- a/mlprec/mld_d_diag_solver.f90 +++ b/mlprec/mld_d_diag_solver.f90 @@ -175,13 +175,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() - return - end if +9999 call psb_error_handler(err_act) return + end subroutine d_diag_solver_free subroutine d_diag_solver_descr(sv,info,iout,coarse) diff --git a/mlprec/mld_d_ilu_solver.f90 b/mlprec/mld_d_ilu_solver.f90 index 65769912..9e67d44d 100644 --- a/mlprec/mld_d_ilu_solver.f90 +++ b/mlprec/mld_d_ilu_solver.f90 @@ -233,13 +233,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() - return - end if +9999 call psb_error_handler(err_act) return + end subroutine d_ilu_solver_check @@ -270,12 +266,7 @@ 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 d_ilu_solver_seti @@ -309,12 +300,7 @@ 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 d_ilu_solver_setc @@ -343,12 +329,7 @@ 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 d_ilu_solver_setr @@ -379,12 +360,7 @@ 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 d_ilu_solver_cseti @@ -418,12 +394,7 @@ 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 d_ilu_solver_csetc @@ -452,12 +423,7 @@ 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 d_ilu_solver_csetr @@ -473,7 +439,7 @@ contains call psb_erractionsave(err_act) info = psb_success_ - + if (allocated(sv%d)) then deallocate(sv%d,stat=info) if (info /= psb_success_) then @@ -489,12 +455,7 @@ 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 d_ilu_solver_free @@ -520,9 +481,9 @@ contains else iout_ = 6 endif - + write(iout_,*) ' Incomplete factorization solver: ',& - & fact_names(sv%fact_type) + & fact_names(sv%fact_type) select case(sv%fact_type) case(mld_ilu_n_,mld_milu_n_) write(iout_,*) ' Fill level:',sv%fill_in @@ -534,12 +495,7 @@ 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 d_ilu_solver_descr diff --git a/mlprec/mld_d_jac_smoother.f90 b/mlprec/mld_d_jac_smoother.f90 index 3f52618b..e8db10e3 100644 --- a/mlprec/mld_d_jac_smoother.f90 +++ b/mlprec/mld_d_jac_smoother.f90 @@ -165,8 +165,8 @@ contains call psb_erractionsave(err_act) info = psb_success_ - - + + if (allocated(sm%sv)) then call sm%sv%free(info) if (info == psb_success_) deallocate(sm%sv,stat=info) @@ -181,12 +181,7 @@ 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 d_jac_smoother_free @@ -218,7 +213,7 @@ contains else iout_ = 6 endif - + if (.not.coarse_) then write(iout_,*) ' Block Jacobi smoother ' write(iout_,*) ' Local solver:' @@ -230,12 +225,7 @@ 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 d_jac_smoother_descr diff --git a/mlprec/mld_d_prec_type.f90 b/mlprec/mld_d_prec_type.f90 index 2f724157..b856d5e0 100644 --- a/mlprec/mld_d_prec_type.f90 +++ b/mlprec/mld_d_prec_type.f90 @@ -570,12 +570,7 @@ contains call psb_erractionrestore(err_act) return -9999 continue - call psb_erractionrestore(err_act) - if (err_act.eq.psb_act_abort_) then - call psb_error() - return - end if +9999 call psb_error_handler(err_act) return end subroutine mld_d_prec_free @@ -611,12 +606,7 @@ 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 mld_d_apply2_vect @@ -646,12 +636,7 @@ 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 mld_d_apply1_vect @@ -683,12 +668,7 @@ 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 mld_d_apply2v @@ -717,13 +697,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 - return +9999 call psb_error_handler(err_act) + return end subroutine mld_d_apply1v diff --git a/mlprec/mld_d_slu_solver.F90 b/mlprec/mld_d_slu_solver.F90 index cc615d25..f97a0692 100644 --- a/mlprec/mld_d_slu_solver.F90 +++ b/mlprec/mld_d_slu_solver.F90 @@ -193,12 +193,7 @@ 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 d_slu_solver_apply @@ -231,14 +226,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() - return - end if +9999 call psb_error_handler(err_act) return - + end subroutine d_slu_solver_apply_vect subroutine d_slu_solver_bld(a,desc_a,sv,upd,info,b,amold,vmold,imold) @@ -317,12 +307,7 @@ 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 d_slu_solver_bld @@ -348,13 +333,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 - return +9999 call psb_error_handler(err_act) + return end subroutine d_slu_solver_free #if defined(HAVE_FINAL) @@ -404,12 +384,7 @@ 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 d_slu_solver_descr diff --git a/mlprec/mld_d_sludist_solver.F90 b/mlprec/mld_d_sludist_solver.F90 index f55004bf..f720b7be 100644 --- a/mlprec/mld_d_sludist_solver.F90 +++ b/mlprec/mld_d_sludist_solver.F90 @@ -189,12 +189,7 @@ 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 d_sludist_solver_apply @@ -227,12 +222,7 @@ 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 d_sludist_solver_apply_vect @@ -319,12 +309,7 @@ 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 d_sludist_solver_bld @@ -350,12 +335,7 @@ 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 d_sludist_solver_free @@ -406,12 +386,7 @@ 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 d_sludist_solver_descr diff --git a/mlprec/mld_d_umf_solver.F90 b/mlprec/mld_d_umf_solver.F90 index 70235bd6..066ce0e4 100644 --- a/mlprec/mld_d_umf_solver.F90 +++ b/mlprec/mld_d_umf_solver.F90 @@ -197,12 +197,7 @@ 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 d_umf_solver_apply @@ -235,12 +230,7 @@ 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 d_umf_solver_apply_vect @@ -319,12 +309,7 @@ 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 d_umf_solver_bld @@ -352,12 +337,7 @@ 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 d_umf_solver_free @@ -408,12 +388,7 @@ 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 d_umf_solver_descr diff --git a/mlprec/mld_s_as_smoother.f90 b/mlprec/mld_s_as_smoother.f90 index fd49a067..a5fd4d24 100644 --- a/mlprec/mld_s_as_smoother.f90 +++ b/mlprec/mld_s_as_smoother.f90 @@ -366,13 +366,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() - return - end if +9999 call psb_error_handler(err_act) return + end subroutine s_as_smoother_descr function s_as_smoother_get_fmt() result(val) diff --git a/mlprec/mld_s_diag_solver.f90 b/mlprec/mld_s_diag_solver.f90 index 5dc6ac70..c2ff441d 100644 --- a/mlprec/mld_s_diag_solver.f90 +++ b/mlprec/mld_s_diag_solver.f90 @@ -175,13 +175,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() - return - end if +9999 call psb_error_handler(err_act) return + end subroutine s_diag_solver_free subroutine s_diag_solver_descr(sv,info,iout,coarse) diff --git a/mlprec/mld_s_ilu_solver.f90 b/mlprec/mld_s_ilu_solver.f90 index 84e1090b..998899bb 100644 --- a/mlprec/mld_s_ilu_solver.f90 +++ b/mlprec/mld_s_ilu_solver.f90 @@ -233,13 +233,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() - return - end if +9999 call psb_error_handler(err_act) return + end subroutine s_ilu_solver_check @@ -270,12 +266,7 @@ 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 s_ilu_solver_seti @@ -309,12 +300,7 @@ 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 s_ilu_solver_setc @@ -343,12 +329,7 @@ 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 s_ilu_solver_setr @@ -379,12 +360,7 @@ 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 s_ilu_solver_cseti @@ -418,12 +394,7 @@ 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 s_ilu_solver_csetc @@ -452,12 +423,7 @@ 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 s_ilu_solver_csetr @@ -473,7 +439,7 @@ contains call psb_erractionsave(err_act) info = psb_success_ - + if (allocated(sv%d)) then deallocate(sv%d,stat=info) if (info /= psb_success_) then @@ -489,12 +455,7 @@ 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 s_ilu_solver_free @@ -520,9 +481,9 @@ contains else iout_ = 6 endif - + write(iout_,*) ' Incomplete factorization solver: ',& - & fact_names(sv%fact_type) + & fact_names(sv%fact_type) select case(sv%fact_type) case(mld_ilu_n_,mld_milu_n_) write(iout_,*) ' Fill level:',sv%fill_in @@ -534,12 +495,7 @@ 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 s_ilu_solver_descr diff --git a/mlprec/mld_s_jac_smoother.f90 b/mlprec/mld_s_jac_smoother.f90 index 8f463c9c..c5b0f51d 100644 --- a/mlprec/mld_s_jac_smoother.f90 +++ b/mlprec/mld_s_jac_smoother.f90 @@ -165,8 +165,8 @@ contains call psb_erractionsave(err_act) info = psb_success_ - - + + if (allocated(sm%sv)) then call sm%sv%free(info) if (info == psb_success_) deallocate(sm%sv,stat=info) @@ -181,12 +181,7 @@ 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 s_jac_smoother_free @@ -218,7 +213,7 @@ contains else iout_ = 6 endif - + if (.not.coarse_) then write(iout_,*) ' Block Jacobi smoother ' write(iout_,*) ' Local solver:' @@ -230,12 +225,7 @@ 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 s_jac_smoother_descr diff --git a/mlprec/mld_s_prec_type.f90 b/mlprec/mld_s_prec_type.f90 index 29ca6ce0..790d6814 100644 --- a/mlprec/mld_s_prec_type.f90 +++ b/mlprec/mld_s_prec_type.f90 @@ -570,12 +570,7 @@ contains call psb_erractionrestore(err_act) return -9999 continue - call psb_erractionrestore(err_act) - if (err_act.eq.psb_act_abort_) then - call psb_error() - return - end if +9999 call psb_error_handler(err_act) return end subroutine mld_s_prec_free @@ -611,12 +606,7 @@ 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 mld_s_apply2_vect @@ -646,12 +636,7 @@ 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 mld_s_apply1_vect @@ -683,12 +668,7 @@ 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 mld_s_apply2v @@ -717,13 +697,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 - return +9999 call psb_error_handler(err_act) + return end subroutine mld_s_apply1v diff --git a/mlprec/mld_s_slu_solver.F90 b/mlprec/mld_s_slu_solver.F90 index be116171..b8de68aa 100644 --- a/mlprec/mld_s_slu_solver.F90 +++ b/mlprec/mld_s_slu_solver.F90 @@ -193,12 +193,7 @@ 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 s_slu_solver_apply @@ -231,14 +226,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() - return - end if +9999 call psb_error_handler(err_act) return - + end subroutine s_slu_solver_apply_vect subroutine s_slu_solver_bld(a,desc_a,sv,upd,info,b,amold,vmold,imold) @@ -317,12 +307,7 @@ 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 s_slu_solver_bld @@ -348,13 +333,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 - return +9999 call psb_error_handler(err_act) + return end subroutine s_slu_solver_free #if defined(HAVE_FINAL) @@ -404,12 +384,7 @@ 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 s_slu_solver_descr diff --git a/mlprec/mld_s_sludist_solver.F90 b/mlprec/mld_s_sludist_solver.F90 index 3c6441ea..2aa1fced 100644 --- a/mlprec/mld_s_sludist_solver.F90 +++ b/mlprec/mld_s_sludist_solver.F90 @@ -189,12 +189,7 @@ 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 s_sludist_solver_apply @@ -227,12 +222,7 @@ 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 s_sludist_solver_apply_vect @@ -319,12 +309,7 @@ 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 s_sludist_solver_bld @@ -350,12 +335,7 @@ 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 s_sludist_solver_free @@ -406,12 +386,7 @@ 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 s_sludist_solver_descr diff --git a/mlprec/mld_s_umf_solver.F90 b/mlprec/mld_s_umf_solver.F90 index 7d860fd1..073609fe 100644 --- a/mlprec/mld_s_umf_solver.F90 +++ b/mlprec/mld_s_umf_solver.F90 @@ -197,12 +197,7 @@ 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 s_umf_solver_apply @@ -235,12 +230,7 @@ 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 s_umf_solver_apply_vect @@ -319,12 +309,7 @@ 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 s_umf_solver_bld @@ -352,12 +337,7 @@ 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 s_umf_solver_free @@ -408,12 +388,7 @@ 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 s_umf_solver_descr diff --git a/mlprec/mld_z_as_smoother.f90 b/mlprec/mld_z_as_smoother.f90 index 001a9a57..103d8bee 100644 --- a/mlprec/mld_z_as_smoother.f90 +++ b/mlprec/mld_z_as_smoother.f90 @@ -366,13 +366,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() - return - end if +9999 call psb_error_handler(err_act) return + end subroutine z_as_smoother_descr function z_as_smoother_get_fmt() result(val) diff --git a/mlprec/mld_z_diag_solver.f90 b/mlprec/mld_z_diag_solver.f90 index 413e1287..16fdda6a 100644 --- a/mlprec/mld_z_diag_solver.f90 +++ b/mlprec/mld_z_diag_solver.f90 @@ -175,13 +175,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() - return - end if +9999 call psb_error_handler(err_act) return + end subroutine z_diag_solver_free subroutine z_diag_solver_descr(sv,info,iout,coarse) diff --git a/mlprec/mld_z_ilu_solver.f90 b/mlprec/mld_z_ilu_solver.f90 index e03bef96..3570f2e6 100644 --- a/mlprec/mld_z_ilu_solver.f90 +++ b/mlprec/mld_z_ilu_solver.f90 @@ -233,13 +233,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() - return - end if +9999 call psb_error_handler(err_act) return + end subroutine z_ilu_solver_check @@ -270,12 +266,7 @@ 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 z_ilu_solver_seti @@ -309,12 +300,7 @@ 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 z_ilu_solver_setc @@ -343,12 +329,7 @@ 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 z_ilu_solver_setr @@ -379,12 +360,7 @@ 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 z_ilu_solver_cseti @@ -418,12 +394,7 @@ 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 z_ilu_solver_csetc @@ -452,12 +423,7 @@ 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 z_ilu_solver_csetr @@ -473,7 +439,7 @@ contains call psb_erractionsave(err_act) info = psb_success_ - + if (allocated(sv%d)) then deallocate(sv%d,stat=info) if (info /= psb_success_) then @@ -489,12 +455,7 @@ 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 z_ilu_solver_free @@ -520,9 +481,9 @@ contains else iout_ = 6 endif - + write(iout_,*) ' Incomplete factorization solver: ',& - & fact_names(sv%fact_type) + & fact_names(sv%fact_type) select case(sv%fact_type) case(mld_ilu_n_,mld_milu_n_) write(iout_,*) ' Fill level:',sv%fill_in @@ -534,12 +495,7 @@ 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 z_ilu_solver_descr diff --git a/mlprec/mld_z_jac_smoother.f90 b/mlprec/mld_z_jac_smoother.f90 index 14dd97ae..e4014d33 100644 --- a/mlprec/mld_z_jac_smoother.f90 +++ b/mlprec/mld_z_jac_smoother.f90 @@ -165,8 +165,8 @@ contains call psb_erractionsave(err_act) info = psb_success_ - - + + if (allocated(sm%sv)) then call sm%sv%free(info) if (info == psb_success_) deallocate(sm%sv,stat=info) @@ -181,12 +181,7 @@ 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 z_jac_smoother_free @@ -218,7 +213,7 @@ contains else iout_ = 6 endif - + if (.not.coarse_) then write(iout_,*) ' Block Jacobi smoother ' write(iout_,*) ' Local solver:' @@ -230,12 +225,7 @@ 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 z_jac_smoother_descr diff --git a/mlprec/mld_z_prec_type.f90 b/mlprec/mld_z_prec_type.f90 index 0aa83230..ed7bfb55 100644 --- a/mlprec/mld_z_prec_type.f90 +++ b/mlprec/mld_z_prec_type.f90 @@ -570,12 +570,7 @@ contains call psb_erractionrestore(err_act) return -9999 continue - call psb_erractionrestore(err_act) - if (err_act.eq.psb_act_abort_) then - call psb_error() - return - end if +9999 call psb_error_handler(err_act) return end subroutine mld_z_prec_free @@ -611,12 +606,7 @@ 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 mld_z_apply2_vect @@ -646,12 +636,7 @@ 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 mld_z_apply1_vect @@ -683,12 +668,7 @@ 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 mld_z_apply2v @@ -717,13 +697,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 - return +9999 call psb_error_handler(err_act) + return end subroutine mld_z_apply1v diff --git a/mlprec/mld_z_slu_solver.F90 b/mlprec/mld_z_slu_solver.F90 index f4f5ea84..e7f7957b 100644 --- a/mlprec/mld_z_slu_solver.F90 +++ b/mlprec/mld_z_slu_solver.F90 @@ -193,12 +193,7 @@ 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 z_slu_solver_apply @@ -231,14 +226,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() - return - end if +9999 call psb_error_handler(err_act) return - + end subroutine z_slu_solver_apply_vect subroutine z_slu_solver_bld(a,desc_a,sv,upd,info,b,amold,vmold,imold) @@ -317,12 +307,7 @@ 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 z_slu_solver_bld @@ -348,13 +333,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 - return +9999 call psb_error_handler(err_act) + return end subroutine z_slu_solver_free #if defined(HAVE_FINAL) @@ -404,12 +384,7 @@ 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 z_slu_solver_descr diff --git a/mlprec/mld_z_sludist_solver.F90 b/mlprec/mld_z_sludist_solver.F90 index 462dc32e..cfbcd12e 100644 --- a/mlprec/mld_z_sludist_solver.F90 +++ b/mlprec/mld_z_sludist_solver.F90 @@ -189,12 +189,7 @@ 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 z_sludist_solver_apply @@ -227,12 +222,7 @@ 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 z_sludist_solver_apply_vect @@ -319,12 +309,7 @@ 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 z_sludist_solver_bld @@ -350,12 +335,7 @@ 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 z_sludist_solver_free @@ -406,12 +386,7 @@ 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 z_sludist_solver_descr diff --git a/mlprec/mld_z_umf_solver.F90 b/mlprec/mld_z_umf_solver.F90 index f2ac8aaa..ea9bd127 100644 --- a/mlprec/mld_z_umf_solver.F90 +++ b/mlprec/mld_z_umf_solver.F90 @@ -197,12 +197,7 @@ 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 z_umf_solver_apply @@ -235,12 +230,7 @@ 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 z_umf_solver_apply_vect @@ -319,12 +309,7 @@ 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 z_umf_solver_bld @@ -352,12 +337,7 @@ 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 z_umf_solver_free @@ -408,12 +388,7 @@ 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 z_umf_solver_descr diff --git a/tests/fileread/runs/dfs.inp b/tests/fileread/runs/dfs.inp index e7178352..2f808982 100644 --- a/tests/fileread/runs/dfs.inp +++ b/tests/fileread/runs/dfs.inp @@ -1,4 +1,4 @@ -A_1M_gps.mtx ! This matrix (and others) from: http://math.nist.gov/MatrixMarket/ or +thm_3180k.mtx ! This matrix (and others) from: http://math.nist.gov/MatrixMarket/ or NONE ! rhs | http://www.cise.ufl.edu/research/sparse/matrices/index.html MM ! BICGSTAB ! Iterative method: BiCGSTAB BiCG CGS RGMRES BiCGSTABL CG @@ -8,7 +8,7 @@ CSR ! Storage format: CSR COO JAD 00500 ! ITMAX 02 ! ITRACE 30 ! IRST (restart for RGMRES and BiCGSTABL) -1.d-7 ! EPS +1.d-5 ! EPS 3L-M-RAS-I-D4 ! Longer descriptive name for preconditioner (up to 20 chars) ML ! Preconditioner type: NONE JACOBI BJAC AS ML 0 ! Number of overlap layers for AS preconditioner @@ -17,16 +17,16 @@ NONE ! AS prolongation operator: NONE SUM AVG ILU ! AS subdomain solver: DSCALE ILU MILU ILUT UMF SLU 0 ! Fill level P for ILU(P) and ILU(T,P) 1.d-4 ! Threshold T for ILU(T,P) -4 ! Number of Jacobi sweeps for base smoother +1 ! Number of Jacobi sweeps for base smoother 3 ! Number of levels in a multilevel preconditioner AS ! Smoother type JACOBI BJAC AS ignored for non-ML SMOOTHED ! Type of aggregation: SMOOTHED NONSMOOTHED DEC ! Type of aggregation: DEC MULT ! Type of multilevel correction: ADD MULT TWOSIDE ! Side of correction PRE POST TWOSIDE (ignored for ADD) -REPL ! Coarsest-level matrix distribution: DIST REPL +DIST ! Coarsest-level matrix distribution: DIST REPL BJAC ! Coarsest-level solver: JACOBI BJAC UMF SLU SLUDIST -UMF ! Coarsest-level subsolver: ILU UMF SLU SLUDIST (DSCALE for JACOBI) +ILU ! Coarsest-level subsolver: ILU UMF SLU SLUDIST (DSCALE for JACOBI) 0 ! Coarsest-level fillin P for ILU(P) and ILU(T,P) 1.d-4 ! Coarsest-level threshold T for ILU(T,P) 4 ! Number of Jacobi sweeps for BJAC/PJAC coarsest-level solver