diff --git a/base/modules/psb_error_impl.F90 b/base/modules/psb_error_impl.F90 index c461e5b3..b1ed0735 100644 --- a/base/modules/psb_error_impl.F90 +++ b/base/modules/psb_error_impl.F90 @@ -76,14 +76,14 @@ subroutine psb_serror() do while (psb_get_numerr() > izero) write(psb_err_unit,'(50("="))') call psb_errpop(err_c, r_name, i_e_d, a_e_d) - call psb_errmsg(err_c, r_name, i_e_d, a_e_d) + call psb_errmsg(psb_err_unit,err_c, r_name, i_e_d, a_e_d) ! write(psb_err_unit,'(50("="))') end do else call psb_errpop(err_c, r_name, i_e_d, a_e_d) - call psb_errmsg(err_c, r_name, i_e_d, a_e_d) + call psb_errmsg(psb_err_unit,err_c, r_name, i_e_d, a_e_d) do while (psb_get_numerr() > 0) call psb_errpop(err_c, r_name, i_e_d, a_e_d) end do @@ -123,7 +123,7 @@ subroutine psb_perror(ictxt,abrt) do while (psb_get_numerr() > izero) write(psb_err_unit,'(50("="))') call psb_errpop(err_c, r_name, i_e_d, a_e_d) - call psb_errmsg(err_c, r_name, i_e_d, a_e_d,iam) + call psb_errmsg(psb_err_unit,err_c, r_name, i_e_d, a_e_d,iam) ! write(psb_err_unit,'(50("="))') end do #if defined(HAVE_FLUSH_STMT) @@ -135,7 +135,7 @@ subroutine psb_perror(ictxt,abrt) else call psb_errpop(err_c, r_name, i_e_d, a_e_d) - call psb_errmsg(err_c, r_name, i_e_d, a_e_d,iam) + call psb_errmsg(psb_err_unit,err_c, r_name, i_e_d, a_e_d,iam) do while (psb_get_numerr() > 0) call psb_errpop(err_c, r_name, i_e_d, a_e_d) end do diff --git a/base/modules/psb_error_mod.F90 b/base/modules/psb_error_mod.F90 index 039bc8fb..11f63a0b 100644 --- a/base/modules/psb_error_mod.F90 +++ b/base/modules/psb_error_mod.F90 @@ -51,7 +51,7 @@ module psb_error_mod public psb_errpush, psb_error, psb_get_errstatus,& & psb_errstatus_fatal, psb_errstatus_warning,& & psb_errstatus_ok, psb_warning_push,& - & psb_errpop, psb_errmsg, psb_errcomm, psb_get_numerr, & + & psb_errpop, psb_errcomm, psb_get_numerr, & & psb_get_errverbosity, psb_set_errverbosity, & & psb_erractionsave, psb_erractionrestore, & & psb_get_erraction, psb_set_erraction, & @@ -62,7 +62,8 @@ module psb_error_mod & psb_get_serial_debug_level, psb_set_serial_debug_level,& & psb_clean_errstack, psb_error_handler, & & psb_ser_error_handler, psb_par_error_handler, & - & psb_ser_error_print_stack, psb_par_error_print_stack + & psb_ser_error_print_stack, psb_par_error_print_stack,& + & psb_error_print_stack, psb_errmsg, psb_ach_errmsg interface psb_error_handler @@ -108,6 +109,7 @@ module psb_error_mod interface psb_errpop module procedure psb_errpop, psb_ach_errpop end interface + interface psb_errmsg module procedure psb_errmsg, psb_ach_errmsg end interface @@ -1022,13 +1024,13 @@ contains ! prints the error msg associated to a specific error code - subroutine psb_errmsg(err_c, r_name, i_e_d, a_e_d,me) - - integer(psb_ipk_), intent(in) :: err_c - character(len=20), intent(in) :: r_name - character(len=40), intent(in) :: a_e_d - integer(psb_ipk_), intent(in) :: i_e_d(5) - integer(psb_mpik_), optional :: me + subroutine psb_errmsg(iunit, err_c, r_name, i_e_d, a_e_d,me) + integer(psb_ipk_), intent(in) :: iunit + integer(psb_ipk_), intent(in) :: err_c + character(len=20), intent(in) :: r_name + character(len=40), intent(in) :: a_e_d + integer(psb_ipk_), intent(in) :: i_e_d(5) + integer(psb_mpik_), optional :: me integer(psb_ipk_) :: i character(len=psb_max_errmsg_len_), allocatable :: achmsg(:) @@ -1036,7 +1038,7 @@ contains call psb_ach_errmsg(achmsg,err_c, r_name, i_e_d, a_e_d,me) do i=1,size(achmsg) - write(psb_err_unit,'(a)'),trim(achmsg(i)) + write(iunit,'(a)'),trim(achmsg(i)) end do end subroutine psb_errmsg diff --git a/base/serial/impl/psb_base_mat_impl.f90 b/base/serial/impl/psb_base_mat_impl.f90 index 7ac4153a..6cc9ff16 100644 --- a/base/serial/impl/psb_base_mat_impl.f90 +++ b/base/serial/impl/psb_base_mat_impl.f90 @@ -17,11 +17,7 @@ function psb_base_get_nz_row(idx,a) result(res) ! so we throw an error. call psb_errpush(psb_err_missing_override_method_,name,a_err=a%get_fmt()) - if (err_act /= psb_act_ret_) then - call psb_error() - end if - return - + call psb_error_handler(err_act) end function psb_base_get_nz_row function psb_base_get_nzeros(a) result(res) @@ -42,11 +38,7 @@ function psb_base_get_nzeros(a) result(res) ! so we throw an error. call psb_errpush(psb_err_missing_override_method_,name,a_err=a%get_fmt()) - if (err_act /= psb_act_ret_) then - call psb_error() - end if - return - + call psb_error_handler(err_act) end function psb_base_get_nzeros function psb_base_get_size(a) result(res) @@ -67,11 +59,7 @@ function psb_base_get_size(a) result(res) ! so we throw an error. call psb_errpush(psb_err_missing_override_method_,name,a_err=a%get_fmt()) - if (err_act /= psb_act_ret_) then - call psb_error() - end if - return - + call psb_error_handler(err_act) end function psb_base_get_size subroutine psb_base_reinit(a,clear) @@ -93,11 +81,7 @@ subroutine psb_base_reinit(a,clear) ! so we throw an error. call psb_errpush(psb_err_missing_override_method_,name,a_err=a%get_fmt()) - if (err_act /= psb_act_ret_) then - call psb_error() - end if - return - + call psb_error_handler(err_act) end subroutine psb_base_reinit subroutine psb_base_sparse_print(iout,a,iv,head,ivr,ivc) @@ -122,11 +106,7 @@ subroutine psb_base_sparse_print(iout,a,iv,head,ivr,ivc) ! so we throw an error. call psb_errpush(psb_err_missing_override_method_,name,a_err=a%get_fmt()) - if (err_act /= psb_act_ret_) then - call psb_error() - end if - return - + call psb_error_handler(err_act) end subroutine psb_base_sparse_print subroutine psb_base_csgetptn(imin,imax,a,nz,ia,ja,info,& @@ -157,11 +137,7 @@ subroutine psb_base_csgetptn(imin,imax,a,nz,ia,ja,info,& info = psb_err_missing_override_method_ call psb_errpush(info,name,a_err=a%get_fmt()) - if (err_act /= psb_act_ret_) then - call psb_error() - end if - return - + call psb_error_handler(err_act) end subroutine psb_base_csgetptn subroutine psb_base_get_neigh(a,idx,neigh,n,info,lev) @@ -234,11 +210,8 @@ subroutine psb_base_get_neigh(a,idx,neigh,n,info,lev) call psb_erractionrestore(err_act) return -9999 continue +9999 call psb_error_handler(err_act) - if (err_act /= psb_act_ret_) then - call psb_error() - end if return end subroutine psb_base_get_neigh @@ -260,11 +233,7 @@ subroutine psb_base_allocate_mnnz(m,n,a,nz) ! so we throw an error. call psb_errpush(psb_err_missing_override_method_,name,a_err=a%get_fmt()) - if (err_act /= psb_act_ret_) then - call psb_error() - end if - return - + call psb_error_handler(err_act) end subroutine psb_base_allocate_mnnz subroutine psb_base_reallocate_nz(nz,a) @@ -283,11 +252,7 @@ subroutine psb_base_reallocate_nz(nz,a) ! so we throw an error. call psb_errpush(psb_err_missing_override_method_,name,a_err=a%get_fmt()) - if (err_act /= psb_act_ret_) then - call psb_error() - end if - return - + call psb_error_handler(err_act) end subroutine psb_base_reallocate_nz subroutine psb_base_free(a) @@ -305,11 +270,7 @@ subroutine psb_base_free(a) ! so we throw an error. call psb_errpush(psb_err_missing_override_method_,name,a_err=a%get_fmt()) - if (err_act /= psb_act_ret_) then - call psb_error() - end if - return - + call psb_error_handler(err_act) end subroutine psb_base_free subroutine psb_base_trim(a) diff --git a/base/serial/impl/psb_c_base_mat_impl.F90 b/base/serial/impl/psb_c_base_mat_impl.F90 index 40a953ca..a35f5241 100644 --- a/base/serial/impl/psb_c_base_mat_impl.F90 +++ b/base/serial/impl/psb_c_base_mat_impl.F90 @@ -1640,7 +1640,7 @@ function psb_c_base_csnmi(a) result(res) integer(psb_ipk_) :: err_act, info integer(psb_ipk_) :: ierr(5) - character(len=20) :: name='csnm1' + character(len=20) :: name='csnmi' real(psb_spk_), allocatable :: vt(:) logical, parameter :: debug=.false. diff --git a/base/serial/impl/psb_c_coo_impl.f90 b/base/serial/impl/psb_c_coo_impl.f90 index 5a6c27c3..37bbf080 100644 --- a/base/serial/impl/psb_c_coo_impl.f90 +++ b/base/serial/impl/psb_c_coo_impl.f90 @@ -69,12 +69,8 @@ subroutine psb_c_coo_get_diag(a,d,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_coo_get_diag @@ -143,12 +139,8 @@ subroutine psb_c_coo_scal(d,a,info,side) 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_coo_scal @@ -182,12 +174,8 @@ subroutine psb_c_coo_scals(d,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_c_coo_scals @@ -217,13 +205,8 @@ subroutine psb_c_coo_reallocate_nz(nz,a) call psb_erractionrestore(err_act) return -9999 continue - call psb_erractionrestore(err_act) +9999 call psb_error_handler(err_act) - if (err_act == psb_act_abort_) then - call psb_error() - return - end if return end subroutine psb_c_coo_reallocate_nz @@ -255,10 +238,9 @@ subroutine psb_c_coo_mold(a,b,info) goto 9999 end if return -9999 continue - if (err_act /= psb_act_ret_) then - call psb_error() - end if + +9999 call psb_error_handler(err_act) + return end subroutine psb_c_coo_mold @@ -302,13 +284,8 @@ subroutine psb_c_coo_reinit(a,clear) call psb_erractionrestore(err_act) return -9999 continue - call psb_erractionrestore(err_act) +9999 call psb_error_handler(err_act) - if (err_act == psb_act_abort_) then - call psb_error() - return - end if return end subroutine psb_c_coo_reinit @@ -337,13 +314,8 @@ subroutine psb_c_coo_trim(a) call psb_erractionrestore(err_act) return -9999 continue - call psb_erractionrestore(err_act) +9999 call psb_error_handler(err_act) - if (err_act == psb_act_abort_) then - call psb_error() - return - end if return end subroutine psb_c_coo_trim @@ -405,13 +377,8 @@ subroutine psb_c_coo_allocate_mnnz(m,n,a,nz) call psb_erractionrestore(err_act) return -9999 continue - call psb_erractionrestore(err_act) +9999 call psb_error_handler(err_act) - if (err_act == psb_act_abort_) then - call psb_error() - return - end if return end subroutine psb_c_coo_allocate_mnnz @@ -645,13 +612,8 @@ subroutine psb_c_coo_cssm(alpha,a,x,beta,y,info,trans) return -9999 continue - call psb_erractionrestore(err_act) +9999 call psb_error_handler(err_act) - if (err_act == psb_act_abort_) then - call psb_error() - return - end if return @@ -1004,13 +966,8 @@ subroutine psb_c_coo_cssv(alpha,a,x,beta,y,info,trans) call psb_erractionrestore(err_act) return -9999 continue - call psb_erractionrestore(err_act) +9999 call psb_error_handler(err_act) - if (err_act == psb_act_abort_) then - call psb_error() - return - end if return contains @@ -1435,13 +1392,8 @@ subroutine psb_c_coo_csmv(alpha,a,x,beta,y,info,trans) call psb_erractionrestore(err_act) return -9999 continue - call psb_erractionrestore(err_act) +9999 call psb_error_handler(err_act) - if (err_act == psb_act_abort_) then - call psb_error() - return - end if return end subroutine psb_c_coo_csmv @@ -1646,13 +1598,8 @@ subroutine psb_c_coo_csmm(alpha,a,x,beta,y,info,trans) call psb_erractionrestore(err_act) return -9999 continue - call psb_erractionrestore(err_act) +9999 call psb_error_handler(err_act) - if (err_act == psb_act_abort_) then - call psb_error() - return - end if return end subroutine psb_c_coo_csmm @@ -1824,13 +1771,8 @@ subroutine psb_c_coo_rowsum(d,a) call psb_erractionrestore(err_act) return -9999 continue - call psb_erractionrestore(err_act) +9999 call psb_error_handler(err_act) - if (err_act == psb_act_abort_) then - call psb_error() - return - end if return end subroutine psb_c_coo_rowsum @@ -1876,13 +1818,8 @@ subroutine psb_c_coo_arwsum(d,a) call psb_erractionrestore(err_act) return -9999 continue - call psb_erractionrestore(err_act) +9999 call psb_error_handler(err_act) - if (err_act == psb_act_abort_) then - call psb_error() - return - end if return end subroutine psb_c_coo_arwsum @@ -1929,13 +1866,8 @@ subroutine psb_c_coo_colsum(d,a) call psb_erractionrestore(err_act) return -9999 continue - call psb_erractionrestore(err_act) +9999 call psb_error_handler(err_act) - if (err_act == psb_act_abort_) then - call psb_error() - return - end if return end subroutine psb_c_coo_colsum @@ -1982,13 +1914,8 @@ subroutine psb_c_coo_aclsum(d,a) call psb_erractionrestore(err_act) return -9999 continue - call psb_erractionrestore(err_act) +9999 call psb_error_handler(err_act) - if (err_act == psb_act_abort_) then - call psb_error() - return - end if return end subroutine psb_c_coo_aclsum @@ -2096,13 +2023,8 @@ subroutine psb_c_coo_csgetptn(imin,imax,a,nz,ia,ja,info,& call psb_erractionrestore(err_act) return -9999 continue - call psb_erractionrestore(err_act) +9999 call psb_error_handler(err_act) - if (err_act == psb_act_abort_) then - call psb_error() - return - end if return contains @@ -2374,13 +2296,8 @@ subroutine psb_c_coo_csgetrow(imin,imax,a,nz,ia,ja,val,info,& call psb_erractionrestore(err_act) return -9999 continue - call psb_erractionrestore(err_act) +9999 call psb_error_handler(err_act) - if (err_act == psb_act_abort_) then - call psb_error() - return - end if return contains @@ -2671,16 +2588,10 @@ subroutine psb_c_coo_csput_a(nz,ia,ja,val,a,imin,imax,jmin,jmax,info,gtl) call psb_erractionrestore(err_act) return -9999 continue - call psb_erractionrestore(err_act) +9999 call psb_error_handler(err_act) - if (err_act == psb_act_abort_) then - call psb_error() - return - end if return - contains subroutine psb_inner_ins(nz,ia,ja,val,nza,ia1,ia2,aspk,maxsz,& @@ -2990,14 +2901,8 @@ subroutine psb_c_cp_coo_to_coo(a,b,info) call psb_erractionrestore(err_act) return -9999 continue - call psb_erractionrestore(err_act) +9999 call psb_error_handler(err_act) - call psb_errpush(info,name) - - if (err_act /= psb_act_ret_) then - call psb_error() - end if return end subroutine psb_c_cp_coo_to_coo @@ -3037,13 +2942,10 @@ subroutine psb_c_cp_coo_from_coo(a,b,info) return 9999 continue - call psb_erractionrestore(err_act) - call psb_errpush(info,name) - if (err_act /= psb_act_ret_) then - call psb_error() - end if + call psb_error_handler(err_act) + return end subroutine psb_c_cp_coo_from_coo @@ -3074,13 +2976,10 @@ subroutine psb_c_cp_coo_to_fmt(a,b,info) return 9999 continue - call psb_erractionrestore(err_act) - call psb_errpush(info,name) - if (err_act /= psb_act_ret_) then - call psb_error() - end if + call psb_error_handler(err_act) + return end subroutine psb_c_cp_coo_to_fmt @@ -3111,13 +3010,10 @@ subroutine psb_c_cp_coo_from_fmt(a,b,info) return 9999 continue - call psb_erractionrestore(err_act) - call psb_errpush(info,name) - if (err_act /= psb_act_ret_) then - call psb_error() - end if + call psb_error_handler(err_act) + return end subroutine psb_c_cp_coo_from_fmt @@ -3155,13 +3051,10 @@ subroutine psb_c_mv_coo_to_coo(a,b,info) return 9999 continue - call psb_erractionrestore(err_act) - call psb_errpush(info,name) - if (err_act /= psb_act_ret_) then - call psb_error() - end if + call psb_error_handler(err_act) + return end subroutine psb_c_mv_coo_to_coo @@ -3198,13 +3091,10 @@ subroutine psb_c_mv_coo_from_coo(a,b,info) return 9999 continue - call psb_erractionrestore(err_act) - call psb_errpush(info,name) - if (err_act /= psb_act_ret_) then - call psb_error() - end if + call psb_error_handler(err_act) + return end subroutine psb_c_mv_coo_from_coo @@ -3235,13 +3125,10 @@ subroutine psb_c_mv_coo_to_fmt(a,b,info) return 9999 continue - call psb_erractionrestore(err_act) - call psb_errpush(info,name) - if (err_act /= psb_act_ret_) then - call psb_error() - end if + call psb_error_handler(err_act) + return end subroutine psb_c_mv_coo_to_fmt @@ -3272,13 +3159,10 @@ subroutine psb_c_mv_coo_from_fmt(a,b,info) return 9999 continue - call psb_erractionrestore(err_act) - call psb_errpush(info,name) - if (err_act /= psb_act_ret_) then - call psb_error() - end if + call psb_error_handler(err_act) + return end subroutine psb_c_mv_coo_from_fmt @@ -3306,13 +3190,10 @@ subroutine psb_c_coo_cp_from(a,b) return 9999 continue - call psb_erractionrestore(err_act) - call psb_errpush(info,name) - if (err_act /= psb_act_ret_) then - call psb_error() - end if + call psb_error_handler(err_act) + return end subroutine psb_c_coo_cp_from @@ -3340,13 +3221,10 @@ subroutine psb_c_coo_mv_from(a,b) return 9999 continue - call psb_erractionrestore(err_act) - call psb_errpush(info,name) - if (err_act /= psb_act_ret_) then - call psb_error() - end if + call psb_error_handler(err_act) + return end subroutine psb_c_coo_mv_from @@ -3403,12 +3281,8 @@ subroutine psb_c_fix_coo(a,info,idir) 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_fix_coo @@ -4120,12 +3994,8 @@ subroutine psb_c_fix_coo_inner(nr,nc,nzin,dupl,ia,ja,val,nzout,info,idir) 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_fix_coo_inner diff --git a/base/serial/impl/psb_c_csc_impl.f90 b/base/serial/impl/psb_c_csc_impl.f90 index 7dc7195c..a30508ca 100644 --- a/base/serial/impl/psb_c_csc_impl.f90 +++ b/base/serial/impl/psb_c_csc_impl.f90 @@ -312,13 +312,9 @@ subroutine psb_c_csc_csmv(alpha,a,x,beta,y,info,trans) 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_csc_csmv @@ -598,13 +594,9 @@ subroutine psb_c_csc_csmm(alpha,a,x,beta,y,info,trans) 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_csc_csmm @@ -712,13 +704,8 @@ subroutine psb_c_csc_cssv(alpha,a,x,beta,y,info,trans) call psb_erractionrestore(err_act) return -9999 continue - call psb_erractionrestore(err_act) +9999 call psb_error_handler(err_act) - if (err_act == psb_act_abort_) then - call psb_error() - return - end if return contains @@ -940,13 +927,8 @@ subroutine psb_c_csc_cssm(alpha,a,x,beta,y,info,trans) return -9999 continue - call psb_erractionrestore(err_act) +9999 call psb_error_handler(err_act) - if (err_act == psb_act_abort_) then - call psb_error() - return - end if return @@ -1174,13 +1156,8 @@ subroutine psb_c_csc_colsum(d,a) call psb_erractionrestore(err_act) return -9999 continue - call psb_erractionrestore(err_act) +9999 call psb_error_handler(err_act) - if (err_act == psb_act_abort_) then - call psb_error() - return - end if return end subroutine psb_c_csc_colsum @@ -1233,13 +1210,8 @@ subroutine psb_c_csc_aclsum(d,a) call psb_erractionrestore(err_act) return -9999 continue - call psb_erractionrestore(err_act) +9999 call psb_error_handler(err_act) - if (err_act == psb_act_abort_) then - call psb_error() - return - end if return end subroutine psb_c_csc_aclsum @@ -1287,13 +1259,8 @@ subroutine psb_c_csc_rowsum(d,a) call psb_erractionrestore(err_act) return -9999 continue - call psb_erractionrestore(err_act) +9999 call psb_error_handler(err_act) - if (err_act == psb_act_abort_) then - call psb_error() - return - end if return end subroutine psb_c_csc_rowsum @@ -1341,13 +1308,8 @@ subroutine psb_c_csc_arwsum(d,a) call psb_erractionrestore(err_act) return -9999 continue - call psb_erractionrestore(err_act) +9999 call psb_error_handler(err_act) - if (err_act == psb_act_abort_) then - call psb_error() - return - end if return end subroutine psb_c_csc_arwsum @@ -1398,12 +1360,8 @@ subroutine psb_c_csc_get_diag(a,d,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_csc_get_diag @@ -1472,12 +1430,8 @@ subroutine psb_c_csc_scal(d,a,info,side) 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_csc_scal @@ -1511,12 +1465,8 @@ subroutine psb_c_csc_scals(d,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_c_csc_scals @@ -1621,13 +1571,8 @@ subroutine psb_c_csc_csgetptn(imin,imax,a,nz,ia,ja,info,& call psb_erractionrestore(err_act) return -9999 continue - call psb_erractionrestore(err_act) +9999 call psb_error_handler(err_act) - if (err_act == psb_act_abort_) then - call psb_error() - return - end if return contains @@ -1815,13 +1760,8 @@ subroutine psb_c_csc_csgetrow(imin,imax,a,nz,ia,ja,val,info,& call psb_erractionrestore(err_act) return -9999 continue - call psb_erractionrestore(err_act) +9999 call psb_error_handler(err_act) - if (err_act == psb_act_abort_) then - call psb_error() - return - end if return contains @@ -2007,13 +1947,8 @@ subroutine psb_c_csc_csput_a(nz,ia,ja,val,a,imin,imax,jmin,jmax,info,gtl) call psb_erractionrestore(err_act) return -9999 continue - call psb_erractionrestore(err_act) +9999 call psb_error_handler(err_act) - if (err_act == psb_act_abort_) then - call psb_error() - return - end if return @@ -2595,10 +2530,9 @@ subroutine psb_c_csc_mold(a,b,info) goto 9999 end if return -9999 continue - if (err_act /= psb_act_ret_) then - call psb_error() - end if + +9999 call psb_error_handler(err_act) + return end subroutine psb_c_csc_mold @@ -2628,13 +2562,8 @@ subroutine psb_c_csc_reallocate_nz(nz,a) call psb_erractionrestore(err_act) return -9999 continue - call psb_erractionrestore(err_act) +9999 call psb_error_handler(err_act) - if (err_act == psb_act_abort_) then - call psb_error() - return - end if return end subroutine psb_c_csc_reallocate_nz @@ -2690,13 +2619,8 @@ subroutine psb_c_csc_csgetblk(imin,imax,a,b,info,& call psb_erractionrestore(err_act) return -9999 continue - call psb_erractionrestore(err_act) +9999 call psb_error_handler(err_act) - if (err_act == psb_act_abort_) then - call psb_error() - return - end if return end subroutine psb_c_csc_csgetblk @@ -2740,13 +2664,8 @@ subroutine psb_c_csc_reinit(a,clear) call psb_erractionrestore(err_act) return -9999 continue - call psb_erractionrestore(err_act) +9999 call psb_error_handler(err_act) - if (err_act == psb_act_abort_) then - call psb_error() - return - end if return end subroutine psb_c_csc_reinit @@ -2774,13 +2693,8 @@ subroutine psb_c_csc_trim(a) call psb_erractionrestore(err_act) return -9999 continue - call psb_erractionrestore(err_act) +9999 call psb_error_handler(err_act) - if (err_act == psb_act_abort_) then - call psb_error() - return - end if return end subroutine psb_c_csc_trim @@ -2840,13 +2754,8 @@ subroutine psb_c_csc_allocate_mnnz(m,n,a,nz) call psb_erractionrestore(err_act) return -9999 continue - call psb_erractionrestore(err_act) +9999 call psb_error_handler(err_act) - if (err_act == psb_act_abort_) then - call psb_error() - return - end if return end subroutine psb_c_csc_allocate_mnnz @@ -2968,12 +2877,8 @@ subroutine psb_ccscspspmm(a,b,c,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 contains diff --git a/base/serial/impl/psb_c_csr_impl.f90 b/base/serial/impl/psb_c_csr_impl.f90 index b124adbd..54ffd6e3 100644 --- a/base/serial/impl/psb_c_csr_impl.f90 +++ b/base/serial/impl/psb_c_csr_impl.f90 @@ -112,13 +112,8 @@ subroutine psb_c_csr_csmv(alpha,a,x,beta,y,info,trans) call psb_erractionrestore(err_act) return -9999 continue - call psb_erractionrestore(err_act) +9999 call psb_error_handler(err_act) - if (err_act == psb_act_abort_) then - call psb_error() - return - end if return contains @@ -467,13 +462,9 @@ subroutine psb_c_csr_csmm(alpha,a,x,beta,y,info,trans) 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 contains @@ -846,13 +837,8 @@ subroutine psb_c_csr_cssv(alpha,a,x,beta,y,info,trans) call psb_erractionrestore(err_act) return -9999 continue - call psb_erractionrestore(err_act) +9999 call psb_error_handler(err_act) - if (err_act == psb_act_abort_) then - call psb_error() - return - end if return contains @@ -1105,13 +1091,8 @@ subroutine psb_c_csr_cssm(alpha,a,x,beta,y,info,trans) return -9999 continue - call psb_erractionrestore(err_act) +9999 call psb_error_handler(err_act) - if (err_act == psb_act_abort_) then - call psb_error() - return - end if return @@ -1369,13 +1350,8 @@ subroutine psb_c_csr_rowsum(d,a) call psb_erractionrestore(err_act) return -9999 continue - call psb_erractionrestore(err_act) +9999 call psb_error_handler(err_act) - if (err_act == psb_act_abort_) then - call psb_error() - return - end if return end subroutine psb_c_csr_rowsum @@ -1423,13 +1399,8 @@ subroutine psb_c_csr_arwsum(d,a) call psb_erractionrestore(err_act) return -9999 continue - call psb_erractionrestore(err_act) +9999 call psb_error_handler(err_act) - if (err_act == psb_act_abort_) then - call psb_error() - return - end if return end subroutine psb_c_csr_arwsum @@ -1480,13 +1451,8 @@ subroutine psb_c_csr_colsum(d,a) call psb_erractionrestore(err_act) return -9999 continue - call psb_erractionrestore(err_act) +9999 call psb_error_handler(err_act) - if (err_act == psb_act_abort_) then - call psb_error() - return - end if return end subroutine psb_c_csr_colsum @@ -1537,13 +1503,8 @@ subroutine psb_c_csr_aclsum(d,a) call psb_erractionrestore(err_act) return -9999 continue - call psb_erractionrestore(err_act) +9999 call psb_error_handler(err_act) - if (err_act == psb_act_abort_) then - call psb_error() - return - end if return end subroutine psb_c_csr_aclsum @@ -1762,13 +1723,8 @@ subroutine psb_c_csr_reallocate_nz(nz,a) call psb_erractionrestore(err_act) return -9999 continue - call psb_erractionrestore(err_act) +9999 call psb_error_handler(err_act) - if (err_act == psb_act_abort_) then - call psb_error() - return - end if return end subroutine psb_c_csr_reallocate_nz @@ -1863,13 +1819,8 @@ subroutine psb_c_csr_allocate_mnnz(m,n,a,nz) call psb_erractionrestore(err_act) return -9999 continue - call psb_erractionrestore(err_act) +9999 call psb_error_handler(err_act) - if (err_act == psb_act_abort_) then - call psb_error() - return - end if return end subroutine psb_c_csr_allocate_mnnz @@ -1962,13 +1913,8 @@ subroutine psb_c_csr_csgetptn(imin,imax,a,nz,ia,ja,info,& call psb_erractionrestore(err_act) return -9999 continue - call psb_erractionrestore(err_act) +9999 call psb_error_handler(err_act) - if (err_act == psb_act_abort_) then - call psb_error() - return - end if return contains @@ -2142,13 +2088,8 @@ subroutine psb_c_csr_csgetrow(imin,imax,a,nz,ia,ja,val,info,& call psb_erractionrestore(err_act) return -9999 continue - call psb_erractionrestore(err_act) +9999 call psb_error_handler(err_act) - if (err_act == psb_act_abort_) then - call psb_error() - return - end if return contains @@ -2286,13 +2227,8 @@ subroutine psb_c_csr_csgetblk(imin,imax,a,b,info,& call psb_erractionrestore(err_act) return -9999 continue - call psb_erractionrestore(err_act) +9999 call psb_error_handler(err_act) - if (err_act == psb_act_abort_) then - call psb_error() - return - end if return end subroutine psb_c_csr_csgetblk @@ -2383,13 +2319,8 @@ subroutine psb_c_csr_csput_a(nz,ia,ja,val,a,imin,imax,jmin,jmax,info,gtl) call psb_erractionrestore(err_act) return -9999 continue - call psb_erractionrestore(err_act) +9999 call psb_error_handler(err_act) - if (err_act == psb_act_abort_) then - call psb_error() - return - end if return @@ -2607,13 +2538,8 @@ subroutine psb_c_csr_reinit(a,clear) call psb_erractionrestore(err_act) return -9999 continue - call psb_erractionrestore(err_act) +9999 call psb_error_handler(err_act) - if (err_act == psb_act_abort_) then - call psb_error() - return - end if return end subroutine psb_c_csr_reinit @@ -2642,13 +2568,8 @@ subroutine psb_c_csr_trim(a) call psb_erractionrestore(err_act) return -9999 continue - call psb_erractionrestore(err_act) +9999 call psb_error_handler(err_act) - if (err_act == psb_act_abort_) then - call psb_error() - return - end if return end subroutine psb_c_csr_trim @@ -3220,12 +3141,8 @@ subroutine psb_ccsrspspmm(a,b,c,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 contains diff --git a/base/serial/impl/psb_c_mat_impl.F90 b/base/serial/impl/psb_c_mat_impl.F90 index 0db47146..4a610c06 100644 --- a/base/serial/impl/psb_c_mat_impl.F90 +++ b/base/serial/impl/psb_c_mat_impl.F90 @@ -77,14 +77,9 @@ subroutine psb_c_set_nrows(m,a) 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_set_nrows @@ -110,14 +105,9 @@ subroutine psb_c_set_ncols(n,a) 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_set_ncols @@ -152,14 +142,9 @@ subroutine psb_c_set_dupl(n,a) 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_set_dupl @@ -189,14 +174,9 @@ subroutine psb_c_set_null(a) 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_set_null @@ -222,13 +202,10 @@ subroutine psb_c_set_bld(a) 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_set_bld @@ -254,13 +231,10 @@ subroutine psb_c_set_upd(a) 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_set_upd @@ -287,13 +261,10 @@ subroutine psb_c_set_asb(a) 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_set_asb @@ -320,13 +291,10 @@ subroutine psb_c_set_sorted(a,val) 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_set_sorted @@ -353,13 +321,10 @@ subroutine psb_c_set_triangle(a,val) 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_set_triangle @@ -386,13 +351,10 @@ subroutine psb_c_set_unit(a,val) 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_set_unit @@ -419,13 +381,10 @@ subroutine psb_c_set_lower(a,val) 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_set_lower @@ -452,13 +411,10 @@ subroutine psb_c_set_upper(a,val) 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_set_upper @@ -504,12 +460,8 @@ subroutine psb_c_sparse_print(iout,a,iv,head,ivr,ivc) return -9999 continue +9999 call psb_error_handler(err_act) - if (err_act == psb_act_abort_) then - call psb_error() - return - end if return end subroutine psb_c_sparse_print @@ -559,12 +511,8 @@ subroutine psb_c_n_sparse_print(fname,a,iv,head,ivr,ivc) return -9999 continue +9999 call psb_error_handler(err_act) - if (err_act == psb_act_abort_) then - call psb_error() - return - end if return end subroutine psb_c_n_sparse_print @@ -600,13 +548,8 @@ subroutine psb_c_get_neigh(a,idx,neigh,n,info,lev) call psb_erractionrestore(err_act) return -9999 continue - call psb_erractionrestore(err_act) +9999 call psb_error_handler(err_act) - if (err_act == psb_act_abort_) then - call psb_error() - return - end if return end subroutine psb_c_get_neigh @@ -643,12 +586,8 @@ subroutine psb_c_csall(nr,nc,a,info,nz) return -9999 continue +9999 call psb_error_handler(err_act) - if (err_act == psb_act_abort_) then - call psb_error() - return - end if return end subroutine psb_c_csall @@ -675,13 +614,8 @@ subroutine psb_c_reallocate_nz(nz,a) return -9999 continue - call psb_erractionrestore(err_act) +9999 call psb_error_handler(err_act) - if (err_act == psb_act_abort_) then - call psb_error() - return - end if return end subroutine psb_c_reallocate_nz @@ -721,12 +655,8 @@ subroutine psb_c_trim(a) return -9999 continue +9999 call psb_error_handler(err_act) - if (err_act == psb_act_abort_) then - call psb_error() - return - end if return end subroutine psb_c_trim @@ -763,13 +693,10 @@ subroutine psb_c_csput_a(nz,ia,ja,val,a,imin,imax,jmin,jmax,info,gtl) 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_csput_a @@ -810,13 +737,10 @@ subroutine psb_c_csput_v(nz,ia,ja,val,a,imin,imax,jmin,jmax,info,gtl) 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_csput_v @@ -860,13 +784,10 @@ subroutine psb_c_csgetptn(imin,imax,a,nz,ia,ja,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_csgetptn @@ -911,13 +832,10 @@ subroutine psb_c_csgetrow(imin,imax,a,nz,ia,ja,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_csgetrow @@ -980,13 +898,10 @@ subroutine psb_c_csgetblk(imin,imax,a,b,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_csgetblk @@ -1033,13 +948,10 @@ subroutine psb_c_tril(a,b,info,diag,imin,imax,& 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_tril @@ -1087,13 +999,10 @@ subroutine psb_c_triu(a,b,info,diag,imin,imax,& 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_triu @@ -1142,13 +1051,10 @@ subroutine psb_c_csclip(a,b,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_csclip @@ -1187,13 +1093,10 @@ subroutine psb_c_b_csclip(a,b,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_b_csclip @@ -1296,13 +1199,10 @@ subroutine psb_c_cscnv(a,b,info,type,mold,upd,dupl) 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_cscnv @@ -1402,13 +1302,10 @@ subroutine psb_c_cscnv_ip(a,info,type,mold,dupl) 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_cscnv_ip @@ -1457,13 +1354,10 @@ subroutine psb_c_cscnv_base(a,b,info,dupl) 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_cscnv_base @@ -1520,13 +1414,10 @@ subroutine psb_c_clip_d(a,b,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_clip_d @@ -1582,13 +1473,10 @@ subroutine psb_c_clip_d_ip(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_c_clip_d_ip @@ -1647,13 +1535,10 @@ subroutine psb_c_cp_from(a,b) 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_cp_from @@ -1744,13 +1629,10 @@ subroutine psb_cspmat_clone(a,b,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_cspmat_clone @@ -1779,13 +1661,10 @@ subroutine psb_c_transp_1mat(a) 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_transp_1mat @@ -1825,13 +1704,10 @@ subroutine psb_c_transp_2mat(a,b) 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_transp_2mat @@ -1860,13 +1736,10 @@ subroutine psb_c_transc_1mat(a) 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_transc_1mat @@ -1906,13 +1779,10 @@ subroutine psb_c_transc_2mat(a,b) 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_transc_2mat @@ -1949,13 +1819,10 @@ subroutine psb_c_asb(a,mold) 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_asb @@ -1987,13 +1854,10 @@ subroutine psb_c_reinit(a,clear) 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_reinit @@ -2040,13 +1904,8 @@ subroutine psb_c_csmm(alpha,a,x,beta,y,info,trans) call psb_erractionrestore(err_act) return -9999 continue - call psb_erractionrestore(err_act) +9999 call psb_error_handler(err_act) - if (err_act == psb_act_abort_) then - call psb_error() - return - end if return end subroutine psb_c_csmm @@ -2078,13 +1937,8 @@ subroutine psb_c_csmv(alpha,a,x,beta,y,info,trans) call psb_erractionrestore(err_act) return -9999 continue - call psb_erractionrestore(err_act) +9999 call psb_error_handler(err_act) - if (err_act == psb_act_abort_) then - call psb_error() - return - end if return end subroutine psb_c_csmv @@ -2128,13 +1982,8 @@ subroutine psb_c_csmv_vect(alpha,a,x,beta,y,info,trans) call psb_erractionrestore(err_act) return -9999 continue - call psb_erractionrestore(err_act) +9999 call psb_error_handler(err_act) - if (err_act == psb_act_abort_) then - call psb_error() - return - end if return end subroutine psb_c_csmv_vect @@ -2169,13 +2018,8 @@ subroutine psb_c_cssm(alpha,a,x,beta,y,info,trans,scale,d) call psb_erractionrestore(err_act) return -9999 continue - call psb_erractionrestore(err_act) +9999 call psb_error_handler(err_act) - if (err_act == psb_act_abort_) then - call psb_error() - return - end if return end subroutine psb_c_cssm @@ -2210,13 +2054,8 @@ subroutine psb_c_cssv(alpha,a,x,beta,y,info,trans,scale,d) call psb_erractionrestore(err_act) return -9999 continue - call psb_erractionrestore(err_act) +9999 call psb_error_handler(err_act) - if (err_act == psb_act_abort_) then - call psb_error() - return - end if return end subroutine psb_c_cssv @@ -2271,13 +2110,8 @@ subroutine psb_c_cssv_vect(alpha,a,x,beta,y,info,trans,scale,d) call psb_erractionrestore(err_act) return -9999 continue - call psb_erractionrestore(err_act) +9999 call psb_error_handler(err_act) - if (err_act == psb_act_abort_) then - call psb_error() - return - end if return end subroutine psb_c_cssv_vect @@ -2306,12 +2140,9 @@ function psb_c_maxval(a) result(res) res = a%a%maxval() return -9999 continue - if (err_act == psb_act_abort_) then - call psb_error() - return - end if +9999 call psb_error_handler(err_act) + return end function psb_c_maxval @@ -2339,12 +2170,9 @@ function psb_c_csnmi(a) result(res) res = a%a%spnmi() return -9999 continue - if (err_act == psb_act_abort_) then - call psb_error() - return - end if +9999 call psb_error_handler(err_act) + return end function psb_c_csnmi @@ -2373,12 +2201,9 @@ function psb_c_csnm1(a) result(res) res = a%a%spnm1() return -9999 continue - if (err_act == psb_act_abort_) then - call psb_error() - return - end if +9999 call psb_error_handler(err_act) + return end function psb_c_csnm1 @@ -2411,13 +2236,8 @@ function psb_c_rowsum(a,info) result(d) call psb_erractionrestore(err_act) return -9999 continue - call psb_erractionrestore(err_act) +9999 call psb_error_handler(err_act) - if (err_act == psb_act_abort_) then - call psb_error() - return - end if return end function psb_c_rowsum @@ -2450,13 +2270,8 @@ function psb_c_arwsum(a,info) result(d) call psb_erractionrestore(err_act) return -9999 continue - call psb_erractionrestore(err_act) +9999 call psb_error_handler(err_act) - if (err_act == psb_act_abort_) then - call psb_error() - return - end if return end function psb_c_arwsum @@ -2489,13 +2304,8 @@ function psb_c_colsum(a,info) result(d) call psb_erractionrestore(err_act) return -9999 continue - call psb_erractionrestore(err_act) +9999 call psb_error_handler(err_act) - if (err_act == psb_act_abort_) then - call psb_error() - return - end if return end function psb_c_colsum @@ -2528,13 +2338,8 @@ function psb_c_aclsum(a,info) result(d) call psb_erractionrestore(err_act) return -9999 continue - call psb_erractionrestore(err_act) +9999 call psb_error_handler(err_act) - if (err_act == psb_act_abort_) then - call psb_error() - return - end if return end function psb_c_aclsum @@ -2572,13 +2377,8 @@ function psb_c_get_diag(a,info) result(d) call psb_erractionrestore(err_act) return -9999 continue - call psb_erractionrestore(err_act) +9999 call psb_error_handler(err_act) - if (err_act == psb_act_abort_) then - call psb_error() - return - end if return end function psb_c_get_diag @@ -2612,13 +2412,8 @@ subroutine psb_c_scal(d,a,info,side) call psb_erractionrestore(err_act) return -9999 continue - call psb_erractionrestore(err_act) +9999 call psb_error_handler(err_act) - if (err_act == psb_act_abort_) then - call psb_error() - return - end if return end subroutine psb_c_scal @@ -2651,13 +2446,8 @@ subroutine psb_c_scals(d,a,info) call psb_erractionrestore(err_act) return -9999 continue - call psb_erractionrestore(err_act) +9999 call psb_error_handler(err_act) - if (err_act == psb_act_abort_) then - call psb_error() - return - end if return end subroutine psb_c_scals diff --git a/base/serial/impl/psb_d_base_mat_impl.F90 b/base/serial/impl/psb_d_base_mat_impl.F90 index e6e87217..e4be86d7 100644 --- a/base/serial/impl/psb_d_base_mat_impl.F90 +++ b/base/serial/impl/psb_d_base_mat_impl.F90 @@ -1640,7 +1640,7 @@ function psb_d_base_csnmi(a) result(res) integer(psb_ipk_) :: err_act, info integer(psb_ipk_) :: ierr(5) - character(len=20) :: name='csnm1' + character(len=20) :: name='csnmi' real(psb_dpk_), allocatable :: vt(:) logical, parameter :: debug=.false. diff --git a/base/serial/impl/psb_d_coo_impl.f90 b/base/serial/impl/psb_d_coo_impl.f90 index f768927b..897c919f 100644 --- a/base/serial/impl/psb_d_coo_impl.f90 +++ b/base/serial/impl/psb_d_coo_impl.f90 @@ -69,12 +69,8 @@ subroutine psb_d_coo_get_diag(a,d,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_coo_get_diag @@ -143,12 +139,8 @@ subroutine psb_d_coo_scal(d,a,info,side) 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_coo_scal @@ -182,12 +174,8 @@ subroutine psb_d_coo_scals(d,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_d_coo_scals @@ -217,13 +205,8 @@ subroutine psb_d_coo_reallocate_nz(nz,a) call psb_erractionrestore(err_act) return -9999 continue - call psb_erractionrestore(err_act) +9999 call psb_error_handler(err_act) - if (err_act == psb_act_abort_) then - call psb_error() - return - end if return end subroutine psb_d_coo_reallocate_nz @@ -255,10 +238,9 @@ subroutine psb_d_coo_mold(a,b,info) goto 9999 end if return -9999 continue - if (err_act /= psb_act_ret_) then - call psb_error() - end if + +9999 call psb_error_handler(err_act) + return end subroutine psb_d_coo_mold @@ -302,13 +284,8 @@ subroutine psb_d_coo_reinit(a,clear) call psb_erractionrestore(err_act) return -9999 continue - call psb_erractionrestore(err_act) +9999 call psb_error_handler(err_act) - if (err_act == psb_act_abort_) then - call psb_error() - return - end if return end subroutine psb_d_coo_reinit @@ -337,13 +314,8 @@ subroutine psb_d_coo_trim(a) call psb_erractionrestore(err_act) return -9999 continue - call psb_erractionrestore(err_act) +9999 call psb_error_handler(err_act) - if (err_act == psb_act_abort_) then - call psb_error() - return - end if return end subroutine psb_d_coo_trim @@ -405,13 +377,8 @@ subroutine psb_d_coo_allocate_mnnz(m,n,a,nz) call psb_erractionrestore(err_act) return -9999 continue - call psb_erractionrestore(err_act) +9999 call psb_error_handler(err_act) - if (err_act == psb_act_abort_) then - call psb_error() - return - end if return end subroutine psb_d_coo_allocate_mnnz @@ -645,13 +612,8 @@ subroutine psb_d_coo_cssm(alpha,a,x,beta,y,info,trans) return -9999 continue - call psb_erractionrestore(err_act) +9999 call psb_error_handler(err_act) - if (err_act == psb_act_abort_) then - call psb_error() - return - end if return @@ -1004,13 +966,8 @@ subroutine psb_d_coo_cssv(alpha,a,x,beta,y,info,trans) call psb_erractionrestore(err_act) return -9999 continue - call psb_erractionrestore(err_act) +9999 call psb_error_handler(err_act) - if (err_act == psb_act_abort_) then - call psb_error() - return - end if return contains @@ -1435,13 +1392,8 @@ subroutine psb_d_coo_csmv(alpha,a,x,beta,y,info,trans) call psb_erractionrestore(err_act) return -9999 continue - call psb_erractionrestore(err_act) +9999 call psb_error_handler(err_act) - if (err_act == psb_act_abort_) then - call psb_error() - return - end if return end subroutine psb_d_coo_csmv @@ -1646,13 +1598,8 @@ subroutine psb_d_coo_csmm(alpha,a,x,beta,y,info,trans) call psb_erractionrestore(err_act) return -9999 continue - call psb_erractionrestore(err_act) +9999 call psb_error_handler(err_act) - if (err_act == psb_act_abort_) then - call psb_error() - return - end if return end subroutine psb_d_coo_csmm @@ -1824,13 +1771,8 @@ subroutine psb_d_coo_rowsum(d,a) call psb_erractionrestore(err_act) return -9999 continue - call psb_erractionrestore(err_act) +9999 call psb_error_handler(err_act) - if (err_act == psb_act_abort_) then - call psb_error() - return - end if return end subroutine psb_d_coo_rowsum @@ -1876,13 +1818,8 @@ subroutine psb_d_coo_arwsum(d,a) call psb_erractionrestore(err_act) return -9999 continue - call psb_erractionrestore(err_act) +9999 call psb_error_handler(err_act) - if (err_act == psb_act_abort_) then - call psb_error() - return - end if return end subroutine psb_d_coo_arwsum @@ -1929,13 +1866,8 @@ subroutine psb_d_coo_colsum(d,a) call psb_erractionrestore(err_act) return -9999 continue - call psb_erractionrestore(err_act) +9999 call psb_error_handler(err_act) - if (err_act == psb_act_abort_) then - call psb_error() - return - end if return end subroutine psb_d_coo_colsum @@ -1982,13 +1914,8 @@ subroutine psb_d_coo_aclsum(d,a) call psb_erractionrestore(err_act) return -9999 continue - call psb_erractionrestore(err_act) +9999 call psb_error_handler(err_act) - if (err_act == psb_act_abort_) then - call psb_error() - return - end if return end subroutine psb_d_coo_aclsum @@ -2096,13 +2023,8 @@ subroutine psb_d_coo_csgetptn(imin,imax,a,nz,ia,ja,info,& call psb_erractionrestore(err_act) return -9999 continue - call psb_erractionrestore(err_act) +9999 call psb_error_handler(err_act) - if (err_act == psb_act_abort_) then - call psb_error() - return - end if return contains @@ -2374,13 +2296,8 @@ subroutine psb_d_coo_csgetrow(imin,imax,a,nz,ia,ja,val,info,& call psb_erractionrestore(err_act) return -9999 continue - call psb_erractionrestore(err_act) +9999 call psb_error_handler(err_act) - if (err_act == psb_act_abort_) then - call psb_error() - return - end if return contains @@ -2671,16 +2588,10 @@ subroutine psb_d_coo_csput_a(nz,ia,ja,val,a,imin,imax,jmin,jmax,info,gtl) call psb_erractionrestore(err_act) return -9999 continue - call psb_erractionrestore(err_act) +9999 call psb_error_handler(err_act) - if (err_act == psb_act_abort_) then - call psb_error() - return - end if return - contains subroutine psb_inner_ins(nz,ia,ja,val,nza,ia1,ia2,aspk,maxsz,& @@ -2990,14 +2901,8 @@ subroutine psb_d_cp_coo_to_coo(a,b,info) call psb_erractionrestore(err_act) return -9999 continue - call psb_erractionrestore(err_act) +9999 call psb_error_handler(err_act) - call psb_errpush(info,name) - - if (err_act /= psb_act_ret_) then - call psb_error() - end if return end subroutine psb_d_cp_coo_to_coo @@ -3037,13 +2942,10 @@ subroutine psb_d_cp_coo_from_coo(a,b,info) return 9999 continue - call psb_erractionrestore(err_act) - call psb_errpush(info,name) - if (err_act /= psb_act_ret_) then - call psb_error() - end if + call psb_error_handler(err_act) + return end subroutine psb_d_cp_coo_from_coo @@ -3074,13 +2976,10 @@ subroutine psb_d_cp_coo_to_fmt(a,b,info) return 9999 continue - call psb_erractionrestore(err_act) - call psb_errpush(info,name) - if (err_act /= psb_act_ret_) then - call psb_error() - end if + call psb_error_handler(err_act) + return end subroutine psb_d_cp_coo_to_fmt @@ -3111,13 +3010,10 @@ subroutine psb_d_cp_coo_from_fmt(a,b,info) return 9999 continue - call psb_erractionrestore(err_act) - call psb_errpush(info,name) - if (err_act /= psb_act_ret_) then - call psb_error() - end if + call psb_error_handler(err_act) + return end subroutine psb_d_cp_coo_from_fmt @@ -3155,13 +3051,10 @@ subroutine psb_d_mv_coo_to_coo(a,b,info) return 9999 continue - call psb_erractionrestore(err_act) - call psb_errpush(info,name) - if (err_act /= psb_act_ret_) then - call psb_error() - end if + call psb_error_handler(err_act) + return end subroutine psb_d_mv_coo_to_coo @@ -3198,13 +3091,10 @@ subroutine psb_d_mv_coo_from_coo(a,b,info) return 9999 continue - call psb_erractionrestore(err_act) - call psb_errpush(info,name) - if (err_act /= psb_act_ret_) then - call psb_error() - end if + call psb_error_handler(err_act) + return end subroutine psb_d_mv_coo_from_coo @@ -3235,13 +3125,10 @@ subroutine psb_d_mv_coo_to_fmt(a,b,info) return 9999 continue - call psb_erractionrestore(err_act) - call psb_errpush(info,name) - if (err_act /= psb_act_ret_) then - call psb_error() - end if + call psb_error_handler(err_act) + return end subroutine psb_d_mv_coo_to_fmt @@ -3272,13 +3159,10 @@ subroutine psb_d_mv_coo_from_fmt(a,b,info) return 9999 continue - call psb_erractionrestore(err_act) - call psb_errpush(info,name) - if (err_act /= psb_act_ret_) then - call psb_error() - end if + call psb_error_handler(err_act) + return end subroutine psb_d_mv_coo_from_fmt @@ -3306,13 +3190,10 @@ subroutine psb_d_coo_cp_from(a,b) return 9999 continue - call psb_erractionrestore(err_act) - call psb_errpush(info,name) - if (err_act /= psb_act_ret_) then - call psb_error() - end if + call psb_error_handler(err_act) + return end subroutine psb_d_coo_cp_from @@ -3340,13 +3221,10 @@ subroutine psb_d_coo_mv_from(a,b) return 9999 continue - call psb_erractionrestore(err_act) - call psb_errpush(info,name) - if (err_act /= psb_act_ret_) then - call psb_error() - end if + call psb_error_handler(err_act) + return end subroutine psb_d_coo_mv_from @@ -3403,12 +3281,8 @@ subroutine psb_d_fix_coo(a,info,idir) 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_fix_coo @@ -4120,12 +3994,8 @@ subroutine psb_d_fix_coo_inner(nr,nc,nzin,dupl,ia,ja,val,nzout,info,idir) 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_fix_coo_inner diff --git a/base/serial/impl/psb_d_csc_impl.f90 b/base/serial/impl/psb_d_csc_impl.f90 index c065eec4..c07b5b1b 100644 --- a/base/serial/impl/psb_d_csc_impl.f90 +++ b/base/serial/impl/psb_d_csc_impl.f90 @@ -312,13 +312,9 @@ subroutine psb_d_csc_csmv(alpha,a,x,beta,y,info,trans) 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_csc_csmv @@ -598,13 +594,9 @@ subroutine psb_d_csc_csmm(alpha,a,x,beta,y,info,trans) 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_csc_csmm @@ -712,13 +704,8 @@ subroutine psb_d_csc_cssv(alpha,a,x,beta,y,info,trans) call psb_erractionrestore(err_act) return -9999 continue - call psb_erractionrestore(err_act) +9999 call psb_error_handler(err_act) - if (err_act == psb_act_abort_) then - call psb_error() - return - end if return contains @@ -940,13 +927,8 @@ subroutine psb_d_csc_cssm(alpha,a,x,beta,y,info,trans) return -9999 continue - call psb_erractionrestore(err_act) +9999 call psb_error_handler(err_act) - if (err_act == psb_act_abort_) then - call psb_error() - return - end if return @@ -1174,13 +1156,8 @@ subroutine psb_d_csc_colsum(d,a) call psb_erractionrestore(err_act) return -9999 continue - call psb_erractionrestore(err_act) +9999 call psb_error_handler(err_act) - if (err_act == psb_act_abort_) then - call psb_error() - return - end if return end subroutine psb_d_csc_colsum @@ -1233,13 +1210,8 @@ subroutine psb_d_csc_aclsum(d,a) call psb_erractionrestore(err_act) return -9999 continue - call psb_erractionrestore(err_act) +9999 call psb_error_handler(err_act) - if (err_act == psb_act_abort_) then - call psb_error() - return - end if return end subroutine psb_d_csc_aclsum @@ -1287,13 +1259,8 @@ subroutine psb_d_csc_rowsum(d,a) call psb_erractionrestore(err_act) return -9999 continue - call psb_erractionrestore(err_act) +9999 call psb_error_handler(err_act) - if (err_act == psb_act_abort_) then - call psb_error() - return - end if return end subroutine psb_d_csc_rowsum @@ -1341,13 +1308,8 @@ subroutine psb_d_csc_arwsum(d,a) call psb_erractionrestore(err_act) return -9999 continue - call psb_erractionrestore(err_act) +9999 call psb_error_handler(err_act) - if (err_act == psb_act_abort_) then - call psb_error() - return - end if return end subroutine psb_d_csc_arwsum @@ -1398,12 +1360,8 @@ subroutine psb_d_csc_get_diag(a,d,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_csc_get_diag @@ -1472,12 +1430,8 @@ subroutine psb_d_csc_scal(d,a,info,side) 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_csc_scal @@ -1511,12 +1465,8 @@ subroutine psb_d_csc_scals(d,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_d_csc_scals @@ -1621,13 +1571,8 @@ subroutine psb_d_csc_csgetptn(imin,imax,a,nz,ia,ja,info,& call psb_erractionrestore(err_act) return -9999 continue - call psb_erractionrestore(err_act) +9999 call psb_error_handler(err_act) - if (err_act == psb_act_abort_) then - call psb_error() - return - end if return contains @@ -1815,13 +1760,8 @@ subroutine psb_d_csc_csgetrow(imin,imax,a,nz,ia,ja,val,info,& call psb_erractionrestore(err_act) return -9999 continue - call psb_erractionrestore(err_act) +9999 call psb_error_handler(err_act) - if (err_act == psb_act_abort_) then - call psb_error() - return - end if return contains @@ -2007,13 +1947,8 @@ subroutine psb_d_csc_csput_a(nz,ia,ja,val,a,imin,imax,jmin,jmax,info,gtl) call psb_erractionrestore(err_act) return -9999 continue - call psb_erractionrestore(err_act) +9999 call psb_error_handler(err_act) - if (err_act == psb_act_abort_) then - call psb_error() - return - end if return @@ -2595,10 +2530,9 @@ subroutine psb_d_csc_mold(a,b,info) goto 9999 end if return -9999 continue - if (err_act /= psb_act_ret_) then - call psb_error() - end if + +9999 call psb_error_handler(err_act) + return end subroutine psb_d_csc_mold @@ -2628,13 +2562,8 @@ subroutine psb_d_csc_reallocate_nz(nz,a) call psb_erractionrestore(err_act) return -9999 continue - call psb_erractionrestore(err_act) +9999 call psb_error_handler(err_act) - if (err_act == psb_act_abort_) then - call psb_error() - return - end if return end subroutine psb_d_csc_reallocate_nz @@ -2690,13 +2619,8 @@ subroutine psb_d_csc_csgetblk(imin,imax,a,b,info,& call psb_erractionrestore(err_act) return -9999 continue - call psb_erractionrestore(err_act) +9999 call psb_error_handler(err_act) - if (err_act == psb_act_abort_) then - call psb_error() - return - end if return end subroutine psb_d_csc_csgetblk @@ -2740,13 +2664,8 @@ subroutine psb_d_csc_reinit(a,clear) call psb_erractionrestore(err_act) return -9999 continue - call psb_erractionrestore(err_act) +9999 call psb_error_handler(err_act) - if (err_act == psb_act_abort_) then - call psb_error() - return - end if return end subroutine psb_d_csc_reinit @@ -2774,13 +2693,8 @@ subroutine psb_d_csc_trim(a) call psb_erractionrestore(err_act) return -9999 continue - call psb_erractionrestore(err_act) +9999 call psb_error_handler(err_act) - if (err_act == psb_act_abort_) then - call psb_error() - return - end if return end subroutine psb_d_csc_trim @@ -2840,13 +2754,8 @@ subroutine psb_d_csc_allocate_mnnz(m,n,a,nz) call psb_erractionrestore(err_act) return -9999 continue - call psb_erractionrestore(err_act) +9999 call psb_error_handler(err_act) - if (err_act == psb_act_abort_) then - call psb_error() - return - end if return end subroutine psb_d_csc_allocate_mnnz @@ -2968,12 +2877,8 @@ subroutine psb_dcscspspmm(a,b,c,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 contains diff --git a/base/serial/impl/psb_d_csr_impl.f90 b/base/serial/impl/psb_d_csr_impl.f90 index 628d42d4..544c153a 100644 --- a/base/serial/impl/psb_d_csr_impl.f90 +++ b/base/serial/impl/psb_d_csr_impl.f90 @@ -112,13 +112,8 @@ subroutine psb_d_csr_csmv(alpha,a,x,beta,y,info,trans) call psb_erractionrestore(err_act) return -9999 continue - call psb_erractionrestore(err_act) +9999 call psb_error_handler(err_act) - if (err_act == psb_act_abort_) then - call psb_error() - return - end if return contains @@ -467,13 +462,9 @@ subroutine psb_d_csr_csmm(alpha,a,x,beta,y,info,trans) 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 contains @@ -846,13 +837,8 @@ subroutine psb_d_csr_cssv(alpha,a,x,beta,y,info,trans) call psb_erractionrestore(err_act) return -9999 continue - call psb_erractionrestore(err_act) +9999 call psb_error_handler(err_act) - if (err_act == psb_act_abort_) then - call psb_error() - return - end if return contains @@ -1105,13 +1091,8 @@ subroutine psb_d_csr_cssm(alpha,a,x,beta,y,info,trans) return -9999 continue - call psb_erractionrestore(err_act) +9999 call psb_error_handler(err_act) - if (err_act == psb_act_abort_) then - call psb_error() - return - end if return @@ -1369,13 +1350,8 @@ subroutine psb_d_csr_rowsum(d,a) call psb_erractionrestore(err_act) return -9999 continue - call psb_erractionrestore(err_act) +9999 call psb_error_handler(err_act) - if (err_act == psb_act_abort_) then - call psb_error() - return - end if return end subroutine psb_d_csr_rowsum @@ -1423,13 +1399,8 @@ subroutine psb_d_csr_arwsum(d,a) call psb_erractionrestore(err_act) return -9999 continue - call psb_erractionrestore(err_act) +9999 call psb_error_handler(err_act) - if (err_act == psb_act_abort_) then - call psb_error() - return - end if return end subroutine psb_d_csr_arwsum @@ -1480,13 +1451,8 @@ subroutine psb_d_csr_colsum(d,a) call psb_erractionrestore(err_act) return -9999 continue - call psb_erractionrestore(err_act) +9999 call psb_error_handler(err_act) - if (err_act == psb_act_abort_) then - call psb_error() - return - end if return end subroutine psb_d_csr_colsum @@ -1537,13 +1503,8 @@ subroutine psb_d_csr_aclsum(d,a) call psb_erractionrestore(err_act) return -9999 continue - call psb_erractionrestore(err_act) +9999 call psb_error_handler(err_act) - if (err_act == psb_act_abort_) then - call psb_error() - return - end if return end subroutine psb_d_csr_aclsum @@ -1762,13 +1723,8 @@ subroutine psb_d_csr_reallocate_nz(nz,a) call psb_erractionrestore(err_act) return -9999 continue - call psb_erractionrestore(err_act) +9999 call psb_error_handler(err_act) - if (err_act == psb_act_abort_) then - call psb_error() - return - end if return end subroutine psb_d_csr_reallocate_nz @@ -1863,13 +1819,8 @@ subroutine psb_d_csr_allocate_mnnz(m,n,a,nz) call psb_erractionrestore(err_act) return -9999 continue - call psb_erractionrestore(err_act) +9999 call psb_error_handler(err_act) - if (err_act == psb_act_abort_) then - call psb_error() - return - end if return end subroutine psb_d_csr_allocate_mnnz @@ -1962,13 +1913,8 @@ subroutine psb_d_csr_csgetptn(imin,imax,a,nz,ia,ja,info,& call psb_erractionrestore(err_act) return -9999 continue - call psb_erractionrestore(err_act) +9999 call psb_error_handler(err_act) - if (err_act == psb_act_abort_) then - call psb_error() - return - end if return contains @@ -2142,13 +2088,8 @@ subroutine psb_d_csr_csgetrow(imin,imax,a,nz,ia,ja,val,info,& call psb_erractionrestore(err_act) return -9999 continue - call psb_erractionrestore(err_act) +9999 call psb_error_handler(err_act) - if (err_act == psb_act_abort_) then - call psb_error() - return - end if return contains @@ -2286,13 +2227,8 @@ subroutine psb_d_csr_csgetblk(imin,imax,a,b,info,& call psb_erractionrestore(err_act) return -9999 continue - call psb_erractionrestore(err_act) +9999 call psb_error_handler(err_act) - if (err_act == psb_act_abort_) then - call psb_error() - return - end if return end subroutine psb_d_csr_csgetblk @@ -2383,13 +2319,8 @@ subroutine psb_d_csr_csput_a(nz,ia,ja,val,a,imin,imax,jmin,jmax,info,gtl) call psb_erractionrestore(err_act) return -9999 continue - call psb_erractionrestore(err_act) +9999 call psb_error_handler(err_act) - if (err_act == psb_act_abort_) then - call psb_error() - return - end if return @@ -2607,13 +2538,8 @@ subroutine psb_d_csr_reinit(a,clear) call psb_erractionrestore(err_act) return -9999 continue - call psb_erractionrestore(err_act) +9999 call psb_error_handler(err_act) - if (err_act == psb_act_abort_) then - call psb_error() - return - end if return end subroutine psb_d_csr_reinit @@ -2642,13 +2568,8 @@ subroutine psb_d_csr_trim(a) call psb_erractionrestore(err_act) return -9999 continue - call psb_erractionrestore(err_act) +9999 call psb_error_handler(err_act) - if (err_act == psb_act_abort_) then - call psb_error() - return - end if return end subroutine psb_d_csr_trim @@ -3220,12 +3141,8 @@ subroutine psb_dcsrspspmm(a,b,c,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 contains diff --git a/base/serial/impl/psb_d_mat_impl.F90 b/base/serial/impl/psb_d_mat_impl.F90 index 29d1d32a..c6a6c356 100644 --- a/base/serial/impl/psb_d_mat_impl.F90 +++ b/base/serial/impl/psb_d_mat_impl.F90 @@ -77,14 +77,9 @@ subroutine psb_d_set_nrows(m,a) 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_set_nrows @@ -110,14 +105,9 @@ subroutine psb_d_set_ncols(n,a) 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_set_ncols @@ -152,14 +142,9 @@ subroutine psb_d_set_dupl(n,a) 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_set_dupl @@ -189,14 +174,9 @@ subroutine psb_d_set_null(a) 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_set_null @@ -222,13 +202,10 @@ subroutine psb_d_set_bld(a) 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_set_bld @@ -254,13 +231,10 @@ subroutine psb_d_set_upd(a) 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_set_upd @@ -287,13 +261,10 @@ subroutine psb_d_set_asb(a) 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_set_asb @@ -320,13 +291,10 @@ subroutine psb_d_set_sorted(a,val) 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_set_sorted @@ -353,13 +321,10 @@ subroutine psb_d_set_triangle(a,val) 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_set_triangle @@ -386,13 +351,10 @@ subroutine psb_d_set_unit(a,val) 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_set_unit @@ -419,13 +381,10 @@ subroutine psb_d_set_lower(a,val) 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_set_lower @@ -452,13 +411,10 @@ subroutine psb_d_set_upper(a,val) 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_set_upper @@ -504,12 +460,8 @@ subroutine psb_d_sparse_print(iout,a,iv,head,ivr,ivc) return -9999 continue +9999 call psb_error_handler(err_act) - if (err_act == psb_act_abort_) then - call psb_error() - return - end if return end subroutine psb_d_sparse_print @@ -559,12 +511,8 @@ subroutine psb_d_n_sparse_print(fname,a,iv,head,ivr,ivc) return -9999 continue +9999 call psb_error_handler(err_act) - if (err_act == psb_act_abort_) then - call psb_error() - return - end if return end subroutine psb_d_n_sparse_print @@ -600,13 +548,8 @@ subroutine psb_d_get_neigh(a,idx,neigh,n,info,lev) call psb_erractionrestore(err_act) return -9999 continue - call psb_erractionrestore(err_act) +9999 call psb_error_handler(err_act) - if (err_act == psb_act_abort_) then - call psb_error() - return - end if return end subroutine psb_d_get_neigh @@ -643,12 +586,8 @@ subroutine psb_d_csall(nr,nc,a,info,nz) return -9999 continue +9999 call psb_error_handler(err_act) - if (err_act == psb_act_abort_) then - call psb_error() - return - end if return end subroutine psb_d_csall @@ -675,13 +614,8 @@ subroutine psb_d_reallocate_nz(nz,a) return -9999 continue - call psb_erractionrestore(err_act) +9999 call psb_error_handler(err_act) - if (err_act == psb_act_abort_) then - call psb_error() - return - end if return end subroutine psb_d_reallocate_nz @@ -721,12 +655,8 @@ subroutine psb_d_trim(a) return -9999 continue +9999 call psb_error_handler(err_act) - if (err_act == psb_act_abort_) then - call psb_error() - return - end if return end subroutine psb_d_trim @@ -763,13 +693,10 @@ subroutine psb_d_csput_a(nz,ia,ja,val,a,imin,imax,jmin,jmax,info,gtl) 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_csput_a @@ -810,13 +737,10 @@ subroutine psb_d_csput_v(nz,ia,ja,val,a,imin,imax,jmin,jmax,info,gtl) 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_csput_v @@ -860,13 +784,10 @@ subroutine psb_d_csgetptn(imin,imax,a,nz,ia,ja,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_csgetptn @@ -911,13 +832,10 @@ subroutine psb_d_csgetrow(imin,imax,a,nz,ia,ja,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_csgetrow @@ -980,13 +898,10 @@ subroutine psb_d_csgetblk(imin,imax,a,b,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_csgetblk @@ -1033,13 +948,10 @@ subroutine psb_d_tril(a,b,info,diag,imin,imax,& 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_tril @@ -1087,13 +999,10 @@ subroutine psb_d_triu(a,b,info,diag,imin,imax,& 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_triu @@ -1142,13 +1051,10 @@ subroutine psb_d_csclip(a,b,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_csclip @@ -1187,13 +1093,10 @@ subroutine psb_d_b_csclip(a,b,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_b_csclip @@ -1296,13 +1199,10 @@ subroutine psb_d_cscnv(a,b,info,type,mold,upd,dupl) 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_cscnv @@ -1402,13 +1302,10 @@ subroutine psb_d_cscnv_ip(a,info,type,mold,dupl) 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_cscnv_ip @@ -1457,13 +1354,10 @@ subroutine psb_d_cscnv_base(a,b,info,dupl) 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_cscnv_base @@ -1520,13 +1414,10 @@ subroutine psb_d_clip_d(a,b,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_clip_d @@ -1582,13 +1473,10 @@ subroutine psb_d_clip_d_ip(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_d_clip_d_ip @@ -1647,13 +1535,10 @@ subroutine psb_d_cp_from(a,b) 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_cp_from @@ -1744,13 +1629,10 @@ subroutine psb_dspmat_clone(a,b,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_dspmat_clone @@ -1779,13 +1661,10 @@ subroutine psb_d_transp_1mat(a) 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_transp_1mat @@ -1825,13 +1704,10 @@ subroutine psb_d_transp_2mat(a,b) 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_transp_2mat @@ -1860,13 +1736,10 @@ subroutine psb_d_transc_1mat(a) 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_transc_1mat @@ -1906,13 +1779,10 @@ subroutine psb_d_transc_2mat(a,b) 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_transc_2mat @@ -1949,13 +1819,10 @@ subroutine psb_d_asb(a,mold) 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_asb @@ -1987,13 +1854,10 @@ subroutine psb_d_reinit(a,clear) 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_reinit @@ -2040,13 +1904,8 @@ subroutine psb_d_csmm(alpha,a,x,beta,y,info,trans) call psb_erractionrestore(err_act) return -9999 continue - call psb_erractionrestore(err_act) +9999 call psb_error_handler(err_act) - if (err_act == psb_act_abort_) then - call psb_error() - return - end if return end subroutine psb_d_csmm @@ -2078,13 +1937,8 @@ subroutine psb_d_csmv(alpha,a,x,beta,y,info,trans) call psb_erractionrestore(err_act) return -9999 continue - call psb_erractionrestore(err_act) +9999 call psb_error_handler(err_act) - if (err_act == psb_act_abort_) then - call psb_error() - return - end if return end subroutine psb_d_csmv @@ -2128,13 +1982,8 @@ subroutine psb_d_csmv_vect(alpha,a,x,beta,y,info,trans) call psb_erractionrestore(err_act) return -9999 continue - call psb_erractionrestore(err_act) +9999 call psb_error_handler(err_act) - if (err_act == psb_act_abort_) then - call psb_error() - return - end if return end subroutine psb_d_csmv_vect @@ -2169,13 +2018,8 @@ subroutine psb_d_cssm(alpha,a,x,beta,y,info,trans,scale,d) call psb_erractionrestore(err_act) return -9999 continue - call psb_erractionrestore(err_act) +9999 call psb_error_handler(err_act) - if (err_act == psb_act_abort_) then - call psb_error() - return - end if return end subroutine psb_d_cssm @@ -2210,13 +2054,8 @@ subroutine psb_d_cssv(alpha,a,x,beta,y,info,trans,scale,d) call psb_erractionrestore(err_act) return -9999 continue - call psb_erractionrestore(err_act) +9999 call psb_error_handler(err_act) - if (err_act == psb_act_abort_) then - call psb_error() - return - end if return end subroutine psb_d_cssv @@ -2271,13 +2110,8 @@ subroutine psb_d_cssv_vect(alpha,a,x,beta,y,info,trans,scale,d) call psb_erractionrestore(err_act) return -9999 continue - call psb_erractionrestore(err_act) +9999 call psb_error_handler(err_act) - if (err_act == psb_act_abort_) then - call psb_error() - return - end if return end subroutine psb_d_cssv_vect @@ -2306,12 +2140,9 @@ function psb_d_maxval(a) result(res) res = a%a%maxval() return -9999 continue - if (err_act == psb_act_abort_) then - call psb_error() - return - end if +9999 call psb_error_handler(err_act) + return end function psb_d_maxval @@ -2339,12 +2170,9 @@ function psb_d_csnmi(a) result(res) res = a%a%spnmi() return -9999 continue - if (err_act == psb_act_abort_) then - call psb_error() - return - end if +9999 call psb_error_handler(err_act) + return end function psb_d_csnmi @@ -2373,12 +2201,9 @@ function psb_d_csnm1(a) result(res) res = a%a%spnm1() return -9999 continue - if (err_act == psb_act_abort_) then - call psb_error() - return - end if +9999 call psb_error_handler(err_act) + return end function psb_d_csnm1 @@ -2411,13 +2236,8 @@ function psb_d_rowsum(a,info) result(d) call psb_erractionrestore(err_act) return -9999 continue - call psb_erractionrestore(err_act) +9999 call psb_error_handler(err_act) - if (err_act == psb_act_abort_) then - call psb_error() - return - end if return end function psb_d_rowsum @@ -2450,13 +2270,8 @@ function psb_d_arwsum(a,info) result(d) call psb_erractionrestore(err_act) return -9999 continue - call psb_erractionrestore(err_act) +9999 call psb_error_handler(err_act) - if (err_act == psb_act_abort_) then - call psb_error() - return - end if return end function psb_d_arwsum @@ -2489,13 +2304,8 @@ function psb_d_colsum(a,info) result(d) call psb_erractionrestore(err_act) return -9999 continue - call psb_erractionrestore(err_act) +9999 call psb_error_handler(err_act) - if (err_act == psb_act_abort_) then - call psb_error() - return - end if return end function psb_d_colsum @@ -2528,13 +2338,8 @@ function psb_d_aclsum(a,info) result(d) call psb_erractionrestore(err_act) return -9999 continue - call psb_erractionrestore(err_act) +9999 call psb_error_handler(err_act) - if (err_act == psb_act_abort_) then - call psb_error() - return - end if return end function psb_d_aclsum @@ -2572,13 +2377,8 @@ function psb_d_get_diag(a,info) result(d) call psb_erractionrestore(err_act) return -9999 continue - call psb_erractionrestore(err_act) +9999 call psb_error_handler(err_act) - if (err_act == psb_act_abort_) then - call psb_error() - return - end if return end function psb_d_get_diag @@ -2612,13 +2412,8 @@ subroutine psb_d_scal(d,a,info,side) call psb_erractionrestore(err_act) return -9999 continue - call psb_erractionrestore(err_act) +9999 call psb_error_handler(err_act) - if (err_act == psb_act_abort_) then - call psb_error() - return - end if return end subroutine psb_d_scal @@ -2651,13 +2446,8 @@ subroutine psb_d_scals(d,a,info) call psb_erractionrestore(err_act) return -9999 continue - call psb_erractionrestore(err_act) +9999 call psb_error_handler(err_act) - if (err_act == psb_act_abort_) then - call psb_error() - return - end if return end subroutine psb_d_scals diff --git a/base/serial/impl/psb_s_base_mat_impl.F90 b/base/serial/impl/psb_s_base_mat_impl.F90 index cea210bb..1b37a541 100644 --- a/base/serial/impl/psb_s_base_mat_impl.F90 +++ b/base/serial/impl/psb_s_base_mat_impl.F90 @@ -1640,7 +1640,7 @@ function psb_s_base_csnmi(a) result(res) integer(psb_ipk_) :: err_act, info integer(psb_ipk_) :: ierr(5) - character(len=20) :: name='csnm1' + character(len=20) :: name='csnmi' real(psb_spk_), allocatable :: vt(:) logical, parameter :: debug=.false. diff --git a/base/serial/impl/psb_s_coo_impl.f90 b/base/serial/impl/psb_s_coo_impl.f90 index 9d5753c5..f1436e0f 100644 --- a/base/serial/impl/psb_s_coo_impl.f90 +++ b/base/serial/impl/psb_s_coo_impl.f90 @@ -69,12 +69,8 @@ subroutine psb_s_coo_get_diag(a,d,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_coo_get_diag @@ -143,12 +139,8 @@ subroutine psb_s_coo_scal(d,a,info,side) 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_coo_scal @@ -182,12 +174,8 @@ subroutine psb_s_coo_scals(d,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_s_coo_scals @@ -217,13 +205,8 @@ subroutine psb_s_coo_reallocate_nz(nz,a) call psb_erractionrestore(err_act) return -9999 continue - call psb_erractionrestore(err_act) +9999 call psb_error_handler(err_act) - if (err_act == psb_act_abort_) then - call psb_error() - return - end if return end subroutine psb_s_coo_reallocate_nz @@ -255,10 +238,9 @@ subroutine psb_s_coo_mold(a,b,info) goto 9999 end if return -9999 continue - if (err_act /= psb_act_ret_) then - call psb_error() - end if + +9999 call psb_error_handler(err_act) + return end subroutine psb_s_coo_mold @@ -302,13 +284,8 @@ subroutine psb_s_coo_reinit(a,clear) call psb_erractionrestore(err_act) return -9999 continue - call psb_erractionrestore(err_act) +9999 call psb_error_handler(err_act) - if (err_act == psb_act_abort_) then - call psb_error() - return - end if return end subroutine psb_s_coo_reinit @@ -337,13 +314,8 @@ subroutine psb_s_coo_trim(a) call psb_erractionrestore(err_act) return -9999 continue - call psb_erractionrestore(err_act) +9999 call psb_error_handler(err_act) - if (err_act == psb_act_abort_) then - call psb_error() - return - end if return end subroutine psb_s_coo_trim @@ -405,13 +377,8 @@ subroutine psb_s_coo_allocate_mnnz(m,n,a,nz) call psb_erractionrestore(err_act) return -9999 continue - call psb_erractionrestore(err_act) +9999 call psb_error_handler(err_act) - if (err_act == psb_act_abort_) then - call psb_error() - return - end if return end subroutine psb_s_coo_allocate_mnnz @@ -645,13 +612,8 @@ subroutine psb_s_coo_cssm(alpha,a,x,beta,y,info,trans) return -9999 continue - call psb_erractionrestore(err_act) +9999 call psb_error_handler(err_act) - if (err_act == psb_act_abort_) then - call psb_error() - return - end if return @@ -1004,13 +966,8 @@ subroutine psb_s_coo_cssv(alpha,a,x,beta,y,info,trans) call psb_erractionrestore(err_act) return -9999 continue - call psb_erractionrestore(err_act) +9999 call psb_error_handler(err_act) - if (err_act == psb_act_abort_) then - call psb_error() - return - end if return contains @@ -1435,13 +1392,8 @@ subroutine psb_s_coo_csmv(alpha,a,x,beta,y,info,trans) call psb_erractionrestore(err_act) return -9999 continue - call psb_erractionrestore(err_act) +9999 call psb_error_handler(err_act) - if (err_act == psb_act_abort_) then - call psb_error() - return - end if return end subroutine psb_s_coo_csmv @@ -1646,13 +1598,8 @@ subroutine psb_s_coo_csmm(alpha,a,x,beta,y,info,trans) call psb_erractionrestore(err_act) return -9999 continue - call psb_erractionrestore(err_act) +9999 call psb_error_handler(err_act) - if (err_act == psb_act_abort_) then - call psb_error() - return - end if return end subroutine psb_s_coo_csmm @@ -1824,13 +1771,8 @@ subroutine psb_s_coo_rowsum(d,a) call psb_erractionrestore(err_act) return -9999 continue - call psb_erractionrestore(err_act) +9999 call psb_error_handler(err_act) - if (err_act == psb_act_abort_) then - call psb_error() - return - end if return end subroutine psb_s_coo_rowsum @@ -1876,13 +1818,8 @@ subroutine psb_s_coo_arwsum(d,a) call psb_erractionrestore(err_act) return -9999 continue - call psb_erractionrestore(err_act) +9999 call psb_error_handler(err_act) - if (err_act == psb_act_abort_) then - call psb_error() - return - end if return end subroutine psb_s_coo_arwsum @@ -1929,13 +1866,8 @@ subroutine psb_s_coo_colsum(d,a) call psb_erractionrestore(err_act) return -9999 continue - call psb_erractionrestore(err_act) +9999 call psb_error_handler(err_act) - if (err_act == psb_act_abort_) then - call psb_error() - return - end if return end subroutine psb_s_coo_colsum @@ -1982,13 +1914,8 @@ subroutine psb_s_coo_aclsum(d,a) call psb_erractionrestore(err_act) return -9999 continue - call psb_erractionrestore(err_act) +9999 call psb_error_handler(err_act) - if (err_act == psb_act_abort_) then - call psb_error() - return - end if return end subroutine psb_s_coo_aclsum @@ -2096,13 +2023,8 @@ subroutine psb_s_coo_csgetptn(imin,imax,a,nz,ia,ja,info,& call psb_erractionrestore(err_act) return -9999 continue - call psb_erractionrestore(err_act) +9999 call psb_error_handler(err_act) - if (err_act == psb_act_abort_) then - call psb_error() - return - end if return contains @@ -2374,13 +2296,8 @@ subroutine psb_s_coo_csgetrow(imin,imax,a,nz,ia,ja,val,info,& call psb_erractionrestore(err_act) return -9999 continue - call psb_erractionrestore(err_act) +9999 call psb_error_handler(err_act) - if (err_act == psb_act_abort_) then - call psb_error() - return - end if return contains @@ -2671,16 +2588,10 @@ subroutine psb_s_coo_csput_a(nz,ia,ja,val,a,imin,imax,jmin,jmax,info,gtl) call psb_erractionrestore(err_act) return -9999 continue - call psb_erractionrestore(err_act) +9999 call psb_error_handler(err_act) - if (err_act == psb_act_abort_) then - call psb_error() - return - end if return - contains subroutine psb_inner_ins(nz,ia,ja,val,nza,ia1,ia2,aspk,maxsz,& @@ -2990,14 +2901,8 @@ subroutine psb_s_cp_coo_to_coo(a,b,info) call psb_erractionrestore(err_act) return -9999 continue - call psb_erractionrestore(err_act) +9999 call psb_error_handler(err_act) - call psb_errpush(info,name) - - if (err_act /= psb_act_ret_) then - call psb_error() - end if return end subroutine psb_s_cp_coo_to_coo @@ -3037,13 +2942,10 @@ subroutine psb_s_cp_coo_from_coo(a,b,info) return 9999 continue - call psb_erractionrestore(err_act) - call psb_errpush(info,name) - if (err_act /= psb_act_ret_) then - call psb_error() - end if + call psb_error_handler(err_act) + return end subroutine psb_s_cp_coo_from_coo @@ -3074,13 +2976,10 @@ subroutine psb_s_cp_coo_to_fmt(a,b,info) return 9999 continue - call psb_erractionrestore(err_act) - call psb_errpush(info,name) - if (err_act /= psb_act_ret_) then - call psb_error() - end if + call psb_error_handler(err_act) + return end subroutine psb_s_cp_coo_to_fmt @@ -3111,13 +3010,10 @@ subroutine psb_s_cp_coo_from_fmt(a,b,info) return 9999 continue - call psb_erractionrestore(err_act) - call psb_errpush(info,name) - if (err_act /= psb_act_ret_) then - call psb_error() - end if + call psb_error_handler(err_act) + return end subroutine psb_s_cp_coo_from_fmt @@ -3155,13 +3051,10 @@ subroutine psb_s_mv_coo_to_coo(a,b,info) return 9999 continue - call psb_erractionrestore(err_act) - call psb_errpush(info,name) - if (err_act /= psb_act_ret_) then - call psb_error() - end if + call psb_error_handler(err_act) + return end subroutine psb_s_mv_coo_to_coo @@ -3198,13 +3091,10 @@ subroutine psb_s_mv_coo_from_coo(a,b,info) return 9999 continue - call psb_erractionrestore(err_act) - call psb_errpush(info,name) - if (err_act /= psb_act_ret_) then - call psb_error() - end if + call psb_error_handler(err_act) + return end subroutine psb_s_mv_coo_from_coo @@ -3235,13 +3125,10 @@ subroutine psb_s_mv_coo_to_fmt(a,b,info) return 9999 continue - call psb_erractionrestore(err_act) - call psb_errpush(info,name) - if (err_act /= psb_act_ret_) then - call psb_error() - end if + call psb_error_handler(err_act) + return end subroutine psb_s_mv_coo_to_fmt @@ -3272,13 +3159,10 @@ subroutine psb_s_mv_coo_from_fmt(a,b,info) return 9999 continue - call psb_erractionrestore(err_act) - call psb_errpush(info,name) - if (err_act /= psb_act_ret_) then - call psb_error() - end if + call psb_error_handler(err_act) + return end subroutine psb_s_mv_coo_from_fmt @@ -3306,13 +3190,10 @@ subroutine psb_s_coo_cp_from(a,b) return 9999 continue - call psb_erractionrestore(err_act) - call psb_errpush(info,name) - if (err_act /= psb_act_ret_) then - call psb_error() - end if + call psb_error_handler(err_act) + return end subroutine psb_s_coo_cp_from @@ -3340,13 +3221,10 @@ subroutine psb_s_coo_mv_from(a,b) return 9999 continue - call psb_erractionrestore(err_act) - call psb_errpush(info,name) - if (err_act /= psb_act_ret_) then - call psb_error() - end if + call psb_error_handler(err_act) + return end subroutine psb_s_coo_mv_from @@ -3403,12 +3281,8 @@ subroutine psb_s_fix_coo(a,info,idir) 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_fix_coo @@ -4120,12 +3994,8 @@ subroutine psb_s_fix_coo_inner(nr,nc,nzin,dupl,ia,ja,val,nzout,info,idir) 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_fix_coo_inner diff --git a/base/serial/impl/psb_s_csc_impl.f90 b/base/serial/impl/psb_s_csc_impl.f90 index c925defa..d13020ed 100644 --- a/base/serial/impl/psb_s_csc_impl.f90 +++ b/base/serial/impl/psb_s_csc_impl.f90 @@ -312,13 +312,9 @@ subroutine psb_s_csc_csmv(alpha,a,x,beta,y,info,trans) 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_csc_csmv @@ -598,13 +594,9 @@ subroutine psb_s_csc_csmm(alpha,a,x,beta,y,info,trans) 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_csc_csmm @@ -712,13 +704,8 @@ subroutine psb_s_csc_cssv(alpha,a,x,beta,y,info,trans) call psb_erractionrestore(err_act) return -9999 continue - call psb_erractionrestore(err_act) +9999 call psb_error_handler(err_act) - if (err_act == psb_act_abort_) then - call psb_error() - return - end if return contains @@ -940,13 +927,8 @@ subroutine psb_s_csc_cssm(alpha,a,x,beta,y,info,trans) return -9999 continue - call psb_erractionrestore(err_act) +9999 call psb_error_handler(err_act) - if (err_act == psb_act_abort_) then - call psb_error() - return - end if return @@ -1174,13 +1156,8 @@ subroutine psb_s_csc_colsum(d,a) call psb_erractionrestore(err_act) return -9999 continue - call psb_erractionrestore(err_act) +9999 call psb_error_handler(err_act) - if (err_act == psb_act_abort_) then - call psb_error() - return - end if return end subroutine psb_s_csc_colsum @@ -1233,13 +1210,8 @@ subroutine psb_s_csc_aclsum(d,a) call psb_erractionrestore(err_act) return -9999 continue - call psb_erractionrestore(err_act) +9999 call psb_error_handler(err_act) - if (err_act == psb_act_abort_) then - call psb_error() - return - end if return end subroutine psb_s_csc_aclsum @@ -1287,13 +1259,8 @@ subroutine psb_s_csc_rowsum(d,a) call psb_erractionrestore(err_act) return -9999 continue - call psb_erractionrestore(err_act) +9999 call psb_error_handler(err_act) - if (err_act == psb_act_abort_) then - call psb_error() - return - end if return end subroutine psb_s_csc_rowsum @@ -1341,13 +1308,8 @@ subroutine psb_s_csc_arwsum(d,a) call psb_erractionrestore(err_act) return -9999 continue - call psb_erractionrestore(err_act) +9999 call psb_error_handler(err_act) - if (err_act == psb_act_abort_) then - call psb_error() - return - end if return end subroutine psb_s_csc_arwsum @@ -1398,12 +1360,8 @@ subroutine psb_s_csc_get_diag(a,d,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_csc_get_diag @@ -1472,12 +1430,8 @@ subroutine psb_s_csc_scal(d,a,info,side) 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_csc_scal @@ -1511,12 +1465,8 @@ subroutine psb_s_csc_scals(d,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_s_csc_scals @@ -1621,13 +1571,8 @@ subroutine psb_s_csc_csgetptn(imin,imax,a,nz,ia,ja,info,& call psb_erractionrestore(err_act) return -9999 continue - call psb_erractionrestore(err_act) +9999 call psb_error_handler(err_act) - if (err_act == psb_act_abort_) then - call psb_error() - return - end if return contains @@ -1815,13 +1760,8 @@ subroutine psb_s_csc_csgetrow(imin,imax,a,nz,ia,ja,val,info,& call psb_erractionrestore(err_act) return -9999 continue - call psb_erractionrestore(err_act) +9999 call psb_error_handler(err_act) - if (err_act == psb_act_abort_) then - call psb_error() - return - end if return contains @@ -2007,13 +1947,8 @@ subroutine psb_s_csc_csput_a(nz,ia,ja,val,a,imin,imax,jmin,jmax,info,gtl) call psb_erractionrestore(err_act) return -9999 continue - call psb_erractionrestore(err_act) +9999 call psb_error_handler(err_act) - if (err_act == psb_act_abort_) then - call psb_error() - return - end if return @@ -2595,10 +2530,9 @@ subroutine psb_s_csc_mold(a,b,info) goto 9999 end if return -9999 continue - if (err_act /= psb_act_ret_) then - call psb_error() - end if + +9999 call psb_error_handler(err_act) + return end subroutine psb_s_csc_mold @@ -2628,13 +2562,8 @@ subroutine psb_s_csc_reallocate_nz(nz,a) call psb_erractionrestore(err_act) return -9999 continue - call psb_erractionrestore(err_act) +9999 call psb_error_handler(err_act) - if (err_act == psb_act_abort_) then - call psb_error() - return - end if return end subroutine psb_s_csc_reallocate_nz @@ -2690,13 +2619,8 @@ subroutine psb_s_csc_csgetblk(imin,imax,a,b,info,& call psb_erractionrestore(err_act) return -9999 continue - call psb_erractionrestore(err_act) +9999 call psb_error_handler(err_act) - if (err_act == psb_act_abort_) then - call psb_error() - return - end if return end subroutine psb_s_csc_csgetblk @@ -2740,13 +2664,8 @@ subroutine psb_s_csc_reinit(a,clear) call psb_erractionrestore(err_act) return -9999 continue - call psb_erractionrestore(err_act) +9999 call psb_error_handler(err_act) - if (err_act == psb_act_abort_) then - call psb_error() - return - end if return end subroutine psb_s_csc_reinit @@ -2774,13 +2693,8 @@ subroutine psb_s_csc_trim(a) call psb_erractionrestore(err_act) return -9999 continue - call psb_erractionrestore(err_act) +9999 call psb_error_handler(err_act) - if (err_act == psb_act_abort_) then - call psb_error() - return - end if return end subroutine psb_s_csc_trim @@ -2840,13 +2754,8 @@ subroutine psb_s_csc_allocate_mnnz(m,n,a,nz) call psb_erractionrestore(err_act) return -9999 continue - call psb_erractionrestore(err_act) +9999 call psb_error_handler(err_act) - if (err_act == psb_act_abort_) then - call psb_error() - return - end if return end subroutine psb_s_csc_allocate_mnnz @@ -2968,12 +2877,8 @@ subroutine psb_scscspspmm(a,b,c,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 contains diff --git a/base/serial/impl/psb_s_csr_impl.f90 b/base/serial/impl/psb_s_csr_impl.f90 index 338b57a6..c91b16e3 100644 --- a/base/serial/impl/psb_s_csr_impl.f90 +++ b/base/serial/impl/psb_s_csr_impl.f90 @@ -112,13 +112,8 @@ subroutine psb_s_csr_csmv(alpha,a,x,beta,y,info,trans) call psb_erractionrestore(err_act) return -9999 continue - call psb_erractionrestore(err_act) +9999 call psb_error_handler(err_act) - if (err_act == psb_act_abort_) then - call psb_error() - return - end if return contains @@ -467,13 +462,9 @@ subroutine psb_s_csr_csmm(alpha,a,x,beta,y,info,trans) 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 contains @@ -846,13 +837,8 @@ subroutine psb_s_csr_cssv(alpha,a,x,beta,y,info,trans) call psb_erractionrestore(err_act) return -9999 continue - call psb_erractionrestore(err_act) +9999 call psb_error_handler(err_act) - if (err_act == psb_act_abort_) then - call psb_error() - return - end if return contains @@ -1105,13 +1091,8 @@ subroutine psb_s_csr_cssm(alpha,a,x,beta,y,info,trans) return -9999 continue - call psb_erractionrestore(err_act) +9999 call psb_error_handler(err_act) - if (err_act == psb_act_abort_) then - call psb_error() - return - end if return @@ -1369,13 +1350,8 @@ subroutine psb_s_csr_rowsum(d,a) call psb_erractionrestore(err_act) return -9999 continue - call psb_erractionrestore(err_act) +9999 call psb_error_handler(err_act) - if (err_act == psb_act_abort_) then - call psb_error() - return - end if return end subroutine psb_s_csr_rowsum @@ -1423,13 +1399,8 @@ subroutine psb_s_csr_arwsum(d,a) call psb_erractionrestore(err_act) return -9999 continue - call psb_erractionrestore(err_act) +9999 call psb_error_handler(err_act) - if (err_act == psb_act_abort_) then - call psb_error() - return - end if return end subroutine psb_s_csr_arwsum @@ -1480,13 +1451,8 @@ subroutine psb_s_csr_colsum(d,a) call psb_erractionrestore(err_act) return -9999 continue - call psb_erractionrestore(err_act) +9999 call psb_error_handler(err_act) - if (err_act == psb_act_abort_) then - call psb_error() - return - end if return end subroutine psb_s_csr_colsum @@ -1537,13 +1503,8 @@ subroutine psb_s_csr_aclsum(d,a) call psb_erractionrestore(err_act) return -9999 continue - call psb_erractionrestore(err_act) +9999 call psb_error_handler(err_act) - if (err_act == psb_act_abort_) then - call psb_error() - return - end if return end subroutine psb_s_csr_aclsum @@ -1762,13 +1723,8 @@ subroutine psb_s_csr_reallocate_nz(nz,a) call psb_erractionrestore(err_act) return -9999 continue - call psb_erractionrestore(err_act) +9999 call psb_error_handler(err_act) - if (err_act == psb_act_abort_) then - call psb_error() - return - end if return end subroutine psb_s_csr_reallocate_nz @@ -1863,13 +1819,8 @@ subroutine psb_s_csr_allocate_mnnz(m,n,a,nz) call psb_erractionrestore(err_act) return -9999 continue - call psb_erractionrestore(err_act) +9999 call psb_error_handler(err_act) - if (err_act == psb_act_abort_) then - call psb_error() - return - end if return end subroutine psb_s_csr_allocate_mnnz @@ -1962,13 +1913,8 @@ subroutine psb_s_csr_csgetptn(imin,imax,a,nz,ia,ja,info,& call psb_erractionrestore(err_act) return -9999 continue - call psb_erractionrestore(err_act) +9999 call psb_error_handler(err_act) - if (err_act == psb_act_abort_) then - call psb_error() - return - end if return contains @@ -2142,13 +2088,8 @@ subroutine psb_s_csr_csgetrow(imin,imax,a,nz,ia,ja,val,info,& call psb_erractionrestore(err_act) return -9999 continue - call psb_erractionrestore(err_act) +9999 call psb_error_handler(err_act) - if (err_act == psb_act_abort_) then - call psb_error() - return - end if return contains @@ -2286,13 +2227,8 @@ subroutine psb_s_csr_csgetblk(imin,imax,a,b,info,& call psb_erractionrestore(err_act) return -9999 continue - call psb_erractionrestore(err_act) +9999 call psb_error_handler(err_act) - if (err_act == psb_act_abort_) then - call psb_error() - return - end if return end subroutine psb_s_csr_csgetblk @@ -2383,13 +2319,8 @@ subroutine psb_s_csr_csput_a(nz,ia,ja,val,a,imin,imax,jmin,jmax,info,gtl) call psb_erractionrestore(err_act) return -9999 continue - call psb_erractionrestore(err_act) +9999 call psb_error_handler(err_act) - if (err_act == psb_act_abort_) then - call psb_error() - return - end if return @@ -2607,13 +2538,8 @@ subroutine psb_s_csr_reinit(a,clear) call psb_erractionrestore(err_act) return -9999 continue - call psb_erractionrestore(err_act) +9999 call psb_error_handler(err_act) - if (err_act == psb_act_abort_) then - call psb_error() - return - end if return end subroutine psb_s_csr_reinit @@ -2642,13 +2568,8 @@ subroutine psb_s_csr_trim(a) call psb_erractionrestore(err_act) return -9999 continue - call psb_erractionrestore(err_act) +9999 call psb_error_handler(err_act) - if (err_act == psb_act_abort_) then - call psb_error() - return - end if return end subroutine psb_s_csr_trim @@ -3220,12 +3141,8 @@ subroutine psb_scsrspspmm(a,b,c,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 contains diff --git a/base/serial/impl/psb_s_mat_impl.F90 b/base/serial/impl/psb_s_mat_impl.F90 index 694d8163..11029af0 100644 --- a/base/serial/impl/psb_s_mat_impl.F90 +++ b/base/serial/impl/psb_s_mat_impl.F90 @@ -77,14 +77,9 @@ subroutine psb_s_set_nrows(m,a) 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_set_nrows @@ -110,14 +105,9 @@ subroutine psb_s_set_ncols(n,a) 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_set_ncols @@ -152,14 +142,9 @@ subroutine psb_s_set_dupl(n,a) 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_set_dupl @@ -189,14 +174,9 @@ subroutine psb_s_set_null(a) 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_set_null @@ -222,13 +202,10 @@ subroutine psb_s_set_bld(a) 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_set_bld @@ -254,13 +231,10 @@ subroutine psb_s_set_upd(a) 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_set_upd @@ -287,13 +261,10 @@ subroutine psb_s_set_asb(a) 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_set_asb @@ -320,13 +291,10 @@ subroutine psb_s_set_sorted(a,val) 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_set_sorted @@ -353,13 +321,10 @@ subroutine psb_s_set_triangle(a,val) 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_set_triangle @@ -386,13 +351,10 @@ subroutine psb_s_set_unit(a,val) 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_set_unit @@ -419,13 +381,10 @@ subroutine psb_s_set_lower(a,val) 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_set_lower @@ -452,13 +411,10 @@ subroutine psb_s_set_upper(a,val) 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_set_upper @@ -504,12 +460,8 @@ subroutine psb_s_sparse_print(iout,a,iv,head,ivr,ivc) return -9999 continue +9999 call psb_error_handler(err_act) - if (err_act == psb_act_abort_) then - call psb_error() - return - end if return end subroutine psb_s_sparse_print @@ -559,12 +511,8 @@ subroutine psb_s_n_sparse_print(fname,a,iv,head,ivr,ivc) return -9999 continue +9999 call psb_error_handler(err_act) - if (err_act == psb_act_abort_) then - call psb_error() - return - end if return end subroutine psb_s_n_sparse_print @@ -600,13 +548,8 @@ subroutine psb_s_get_neigh(a,idx,neigh,n,info,lev) call psb_erractionrestore(err_act) return -9999 continue - call psb_erractionrestore(err_act) +9999 call psb_error_handler(err_act) - if (err_act == psb_act_abort_) then - call psb_error() - return - end if return end subroutine psb_s_get_neigh @@ -643,12 +586,8 @@ subroutine psb_s_csall(nr,nc,a,info,nz) return -9999 continue +9999 call psb_error_handler(err_act) - if (err_act == psb_act_abort_) then - call psb_error() - return - end if return end subroutine psb_s_csall @@ -675,13 +614,8 @@ subroutine psb_s_reallocate_nz(nz,a) return -9999 continue - call psb_erractionrestore(err_act) +9999 call psb_error_handler(err_act) - if (err_act == psb_act_abort_) then - call psb_error() - return - end if return end subroutine psb_s_reallocate_nz @@ -721,12 +655,8 @@ subroutine psb_s_trim(a) return -9999 continue +9999 call psb_error_handler(err_act) - if (err_act == psb_act_abort_) then - call psb_error() - return - end if return end subroutine psb_s_trim @@ -763,13 +693,10 @@ subroutine psb_s_csput_a(nz,ia,ja,val,a,imin,imax,jmin,jmax,info,gtl) 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_csput_a @@ -810,13 +737,10 @@ subroutine psb_s_csput_v(nz,ia,ja,val,a,imin,imax,jmin,jmax,info,gtl) 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_csput_v @@ -860,13 +784,10 @@ subroutine psb_s_csgetptn(imin,imax,a,nz,ia,ja,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_csgetptn @@ -911,13 +832,10 @@ subroutine psb_s_csgetrow(imin,imax,a,nz,ia,ja,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_csgetrow @@ -980,13 +898,10 @@ subroutine psb_s_csgetblk(imin,imax,a,b,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_csgetblk @@ -1033,13 +948,10 @@ subroutine psb_s_tril(a,b,info,diag,imin,imax,& 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_tril @@ -1087,13 +999,10 @@ subroutine psb_s_triu(a,b,info,diag,imin,imax,& 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_triu @@ -1142,13 +1051,10 @@ subroutine psb_s_csclip(a,b,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_csclip @@ -1187,13 +1093,10 @@ subroutine psb_s_b_csclip(a,b,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_b_csclip @@ -1296,13 +1199,10 @@ subroutine psb_s_cscnv(a,b,info,type,mold,upd,dupl) 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_cscnv @@ -1402,13 +1302,10 @@ subroutine psb_s_cscnv_ip(a,info,type,mold,dupl) 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_cscnv_ip @@ -1457,13 +1354,10 @@ subroutine psb_s_cscnv_base(a,b,info,dupl) 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_cscnv_base @@ -1520,13 +1414,10 @@ subroutine psb_s_clip_d(a,b,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_clip_d @@ -1582,13 +1473,10 @@ subroutine psb_s_clip_d_ip(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_s_clip_d_ip @@ -1647,13 +1535,10 @@ subroutine psb_s_cp_from(a,b) 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_cp_from @@ -1744,13 +1629,10 @@ subroutine psb_sspmat_clone(a,b,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_sspmat_clone @@ -1779,13 +1661,10 @@ subroutine psb_s_transp_1mat(a) 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_transp_1mat @@ -1825,13 +1704,10 @@ subroutine psb_s_transp_2mat(a,b) 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_transp_2mat @@ -1860,13 +1736,10 @@ subroutine psb_s_transc_1mat(a) 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_transc_1mat @@ -1906,13 +1779,10 @@ subroutine psb_s_transc_2mat(a,b) 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_transc_2mat @@ -1949,13 +1819,10 @@ subroutine psb_s_asb(a,mold) 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_asb @@ -1987,13 +1854,10 @@ subroutine psb_s_reinit(a,clear) 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_reinit @@ -2040,13 +1904,8 @@ subroutine psb_s_csmm(alpha,a,x,beta,y,info,trans) call psb_erractionrestore(err_act) return -9999 continue - call psb_erractionrestore(err_act) +9999 call psb_error_handler(err_act) - if (err_act == psb_act_abort_) then - call psb_error() - return - end if return end subroutine psb_s_csmm @@ -2078,13 +1937,8 @@ subroutine psb_s_csmv(alpha,a,x,beta,y,info,trans) call psb_erractionrestore(err_act) return -9999 continue - call psb_erractionrestore(err_act) +9999 call psb_error_handler(err_act) - if (err_act == psb_act_abort_) then - call psb_error() - return - end if return end subroutine psb_s_csmv @@ -2128,13 +1982,8 @@ subroutine psb_s_csmv_vect(alpha,a,x,beta,y,info,trans) call psb_erractionrestore(err_act) return -9999 continue - call psb_erractionrestore(err_act) +9999 call psb_error_handler(err_act) - if (err_act == psb_act_abort_) then - call psb_error() - return - end if return end subroutine psb_s_csmv_vect @@ -2169,13 +2018,8 @@ subroutine psb_s_cssm(alpha,a,x,beta,y,info,trans,scale,d) call psb_erractionrestore(err_act) return -9999 continue - call psb_erractionrestore(err_act) +9999 call psb_error_handler(err_act) - if (err_act == psb_act_abort_) then - call psb_error() - return - end if return end subroutine psb_s_cssm @@ -2210,13 +2054,8 @@ subroutine psb_s_cssv(alpha,a,x,beta,y,info,trans,scale,d) call psb_erractionrestore(err_act) return -9999 continue - call psb_erractionrestore(err_act) +9999 call psb_error_handler(err_act) - if (err_act == psb_act_abort_) then - call psb_error() - return - end if return end subroutine psb_s_cssv @@ -2271,13 +2110,8 @@ subroutine psb_s_cssv_vect(alpha,a,x,beta,y,info,trans,scale,d) call psb_erractionrestore(err_act) return -9999 continue - call psb_erractionrestore(err_act) +9999 call psb_error_handler(err_act) - if (err_act == psb_act_abort_) then - call psb_error() - return - end if return end subroutine psb_s_cssv_vect @@ -2306,12 +2140,9 @@ function psb_s_maxval(a) result(res) res = a%a%maxval() return -9999 continue - if (err_act == psb_act_abort_) then - call psb_error() - return - end if +9999 call psb_error_handler(err_act) + return end function psb_s_maxval @@ -2339,12 +2170,9 @@ function psb_s_csnmi(a) result(res) res = a%a%spnmi() return -9999 continue - if (err_act == psb_act_abort_) then - call psb_error() - return - end if +9999 call psb_error_handler(err_act) + return end function psb_s_csnmi @@ -2373,12 +2201,9 @@ function psb_s_csnm1(a) result(res) res = a%a%spnm1() return -9999 continue - if (err_act == psb_act_abort_) then - call psb_error() - return - end if +9999 call psb_error_handler(err_act) + return end function psb_s_csnm1 @@ -2411,13 +2236,8 @@ function psb_s_rowsum(a,info) result(d) call psb_erractionrestore(err_act) return -9999 continue - call psb_erractionrestore(err_act) +9999 call psb_error_handler(err_act) - if (err_act == psb_act_abort_) then - call psb_error() - return - end if return end function psb_s_rowsum @@ -2450,13 +2270,8 @@ function psb_s_arwsum(a,info) result(d) call psb_erractionrestore(err_act) return -9999 continue - call psb_erractionrestore(err_act) +9999 call psb_error_handler(err_act) - if (err_act == psb_act_abort_) then - call psb_error() - return - end if return end function psb_s_arwsum @@ -2489,13 +2304,8 @@ function psb_s_colsum(a,info) result(d) call psb_erractionrestore(err_act) return -9999 continue - call psb_erractionrestore(err_act) +9999 call psb_error_handler(err_act) - if (err_act == psb_act_abort_) then - call psb_error() - return - end if return end function psb_s_colsum @@ -2528,13 +2338,8 @@ function psb_s_aclsum(a,info) result(d) call psb_erractionrestore(err_act) return -9999 continue - call psb_erractionrestore(err_act) +9999 call psb_error_handler(err_act) - if (err_act == psb_act_abort_) then - call psb_error() - return - end if return end function psb_s_aclsum @@ -2572,13 +2377,8 @@ function psb_s_get_diag(a,info) result(d) call psb_erractionrestore(err_act) return -9999 continue - call psb_erractionrestore(err_act) +9999 call psb_error_handler(err_act) - if (err_act == psb_act_abort_) then - call psb_error() - return - end if return end function psb_s_get_diag @@ -2612,13 +2412,8 @@ subroutine psb_s_scal(d,a,info,side) call psb_erractionrestore(err_act) return -9999 continue - call psb_erractionrestore(err_act) +9999 call psb_error_handler(err_act) - if (err_act == psb_act_abort_) then - call psb_error() - return - end if return end subroutine psb_s_scal @@ -2651,13 +2446,8 @@ subroutine psb_s_scals(d,a,info) call psb_erractionrestore(err_act) return -9999 continue - call psb_erractionrestore(err_act) +9999 call psb_error_handler(err_act) - if (err_act == psb_act_abort_) then - call psb_error() - return - end if return end subroutine psb_s_scals diff --git a/base/serial/impl/psb_z_base_mat_impl.F90 b/base/serial/impl/psb_z_base_mat_impl.F90 index a26ee37f..727b3e0a 100644 --- a/base/serial/impl/psb_z_base_mat_impl.F90 +++ b/base/serial/impl/psb_z_base_mat_impl.F90 @@ -1640,7 +1640,7 @@ function psb_z_base_csnmi(a) result(res) integer(psb_ipk_) :: err_act, info integer(psb_ipk_) :: ierr(5) - character(len=20) :: name='csnm1' + character(len=20) :: name='csnmi' real(psb_dpk_), allocatable :: vt(:) logical, parameter :: debug=.false. diff --git a/base/serial/impl/psb_z_coo_impl.f90 b/base/serial/impl/psb_z_coo_impl.f90 index 22c6565c..a894eb64 100644 --- a/base/serial/impl/psb_z_coo_impl.f90 +++ b/base/serial/impl/psb_z_coo_impl.f90 @@ -69,12 +69,8 @@ subroutine psb_z_coo_get_diag(a,d,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_coo_get_diag @@ -143,12 +139,8 @@ subroutine psb_z_coo_scal(d,a,info,side) 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_coo_scal @@ -182,12 +174,8 @@ subroutine psb_z_coo_scals(d,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_z_coo_scals @@ -217,13 +205,8 @@ subroutine psb_z_coo_reallocate_nz(nz,a) call psb_erractionrestore(err_act) return -9999 continue - call psb_erractionrestore(err_act) +9999 call psb_error_handler(err_act) - if (err_act == psb_act_abort_) then - call psb_error() - return - end if return end subroutine psb_z_coo_reallocate_nz @@ -255,10 +238,9 @@ subroutine psb_z_coo_mold(a,b,info) goto 9999 end if return -9999 continue - if (err_act /= psb_act_ret_) then - call psb_error() - end if + +9999 call psb_error_handler(err_act) + return end subroutine psb_z_coo_mold @@ -302,13 +284,8 @@ subroutine psb_z_coo_reinit(a,clear) call psb_erractionrestore(err_act) return -9999 continue - call psb_erractionrestore(err_act) +9999 call psb_error_handler(err_act) - if (err_act == psb_act_abort_) then - call psb_error() - return - end if return end subroutine psb_z_coo_reinit @@ -337,13 +314,8 @@ subroutine psb_z_coo_trim(a) call psb_erractionrestore(err_act) return -9999 continue - call psb_erractionrestore(err_act) +9999 call psb_error_handler(err_act) - if (err_act == psb_act_abort_) then - call psb_error() - return - end if return end subroutine psb_z_coo_trim @@ -405,13 +377,8 @@ subroutine psb_z_coo_allocate_mnnz(m,n,a,nz) call psb_erractionrestore(err_act) return -9999 continue - call psb_erractionrestore(err_act) +9999 call psb_error_handler(err_act) - if (err_act == psb_act_abort_) then - call psb_error() - return - end if return end subroutine psb_z_coo_allocate_mnnz @@ -645,13 +612,8 @@ subroutine psb_z_coo_cssm(alpha,a,x,beta,y,info,trans) return -9999 continue - call psb_erractionrestore(err_act) +9999 call psb_error_handler(err_act) - if (err_act == psb_act_abort_) then - call psb_error() - return - end if return @@ -1004,13 +966,8 @@ subroutine psb_z_coo_cssv(alpha,a,x,beta,y,info,trans) call psb_erractionrestore(err_act) return -9999 continue - call psb_erractionrestore(err_act) +9999 call psb_error_handler(err_act) - if (err_act == psb_act_abort_) then - call psb_error() - return - end if return contains @@ -1435,13 +1392,8 @@ subroutine psb_z_coo_csmv(alpha,a,x,beta,y,info,trans) call psb_erractionrestore(err_act) return -9999 continue - call psb_erractionrestore(err_act) +9999 call psb_error_handler(err_act) - if (err_act == psb_act_abort_) then - call psb_error() - return - end if return end subroutine psb_z_coo_csmv @@ -1646,13 +1598,8 @@ subroutine psb_z_coo_csmm(alpha,a,x,beta,y,info,trans) call psb_erractionrestore(err_act) return -9999 continue - call psb_erractionrestore(err_act) +9999 call psb_error_handler(err_act) - if (err_act == psb_act_abort_) then - call psb_error() - return - end if return end subroutine psb_z_coo_csmm @@ -1824,13 +1771,8 @@ subroutine psb_z_coo_rowsum(d,a) call psb_erractionrestore(err_act) return -9999 continue - call psb_erractionrestore(err_act) +9999 call psb_error_handler(err_act) - if (err_act == psb_act_abort_) then - call psb_error() - return - end if return end subroutine psb_z_coo_rowsum @@ -1876,13 +1818,8 @@ subroutine psb_z_coo_arwsum(d,a) call psb_erractionrestore(err_act) return -9999 continue - call psb_erractionrestore(err_act) +9999 call psb_error_handler(err_act) - if (err_act == psb_act_abort_) then - call psb_error() - return - end if return end subroutine psb_z_coo_arwsum @@ -1929,13 +1866,8 @@ subroutine psb_z_coo_colsum(d,a) call psb_erractionrestore(err_act) return -9999 continue - call psb_erractionrestore(err_act) +9999 call psb_error_handler(err_act) - if (err_act == psb_act_abort_) then - call psb_error() - return - end if return end subroutine psb_z_coo_colsum @@ -1982,13 +1914,8 @@ subroutine psb_z_coo_aclsum(d,a) call psb_erractionrestore(err_act) return -9999 continue - call psb_erractionrestore(err_act) +9999 call psb_error_handler(err_act) - if (err_act == psb_act_abort_) then - call psb_error() - return - end if return end subroutine psb_z_coo_aclsum @@ -2096,13 +2023,8 @@ subroutine psb_z_coo_csgetptn(imin,imax,a,nz,ia,ja,info,& call psb_erractionrestore(err_act) return -9999 continue - call psb_erractionrestore(err_act) +9999 call psb_error_handler(err_act) - if (err_act == psb_act_abort_) then - call psb_error() - return - end if return contains @@ -2374,13 +2296,8 @@ subroutine psb_z_coo_csgetrow(imin,imax,a,nz,ia,ja,val,info,& call psb_erractionrestore(err_act) return -9999 continue - call psb_erractionrestore(err_act) +9999 call psb_error_handler(err_act) - if (err_act == psb_act_abort_) then - call psb_error() - return - end if return contains @@ -2671,16 +2588,10 @@ subroutine psb_z_coo_csput_a(nz,ia,ja,val,a,imin,imax,jmin,jmax,info,gtl) call psb_erractionrestore(err_act) return -9999 continue - call psb_erractionrestore(err_act) +9999 call psb_error_handler(err_act) - if (err_act == psb_act_abort_) then - call psb_error() - return - end if return - contains subroutine psb_inner_ins(nz,ia,ja,val,nza,ia1,ia2,aspk,maxsz,& @@ -2990,14 +2901,8 @@ subroutine psb_z_cp_coo_to_coo(a,b,info) call psb_erractionrestore(err_act) return -9999 continue - call psb_erractionrestore(err_act) +9999 call psb_error_handler(err_act) - call psb_errpush(info,name) - - if (err_act /= psb_act_ret_) then - call psb_error() - end if return end subroutine psb_z_cp_coo_to_coo @@ -3037,13 +2942,10 @@ subroutine psb_z_cp_coo_from_coo(a,b,info) return 9999 continue - call psb_erractionrestore(err_act) - call psb_errpush(info,name) - if (err_act /= psb_act_ret_) then - call psb_error() - end if + call psb_error_handler(err_act) + return end subroutine psb_z_cp_coo_from_coo @@ -3074,13 +2976,10 @@ subroutine psb_z_cp_coo_to_fmt(a,b,info) return 9999 continue - call psb_erractionrestore(err_act) - call psb_errpush(info,name) - if (err_act /= psb_act_ret_) then - call psb_error() - end if + call psb_error_handler(err_act) + return end subroutine psb_z_cp_coo_to_fmt @@ -3111,13 +3010,10 @@ subroutine psb_z_cp_coo_from_fmt(a,b,info) return 9999 continue - call psb_erractionrestore(err_act) - call psb_errpush(info,name) - if (err_act /= psb_act_ret_) then - call psb_error() - end if + call psb_error_handler(err_act) + return end subroutine psb_z_cp_coo_from_fmt @@ -3155,13 +3051,10 @@ subroutine psb_z_mv_coo_to_coo(a,b,info) return 9999 continue - call psb_erractionrestore(err_act) - call psb_errpush(info,name) - if (err_act /= psb_act_ret_) then - call psb_error() - end if + call psb_error_handler(err_act) + return end subroutine psb_z_mv_coo_to_coo @@ -3198,13 +3091,10 @@ subroutine psb_z_mv_coo_from_coo(a,b,info) return 9999 continue - call psb_erractionrestore(err_act) - call psb_errpush(info,name) - if (err_act /= psb_act_ret_) then - call psb_error() - end if + call psb_error_handler(err_act) + return end subroutine psb_z_mv_coo_from_coo @@ -3235,13 +3125,10 @@ subroutine psb_z_mv_coo_to_fmt(a,b,info) return 9999 continue - call psb_erractionrestore(err_act) - call psb_errpush(info,name) - if (err_act /= psb_act_ret_) then - call psb_error() - end if + call psb_error_handler(err_act) + return end subroutine psb_z_mv_coo_to_fmt @@ -3272,13 +3159,10 @@ subroutine psb_z_mv_coo_from_fmt(a,b,info) return 9999 continue - call psb_erractionrestore(err_act) - call psb_errpush(info,name) - if (err_act /= psb_act_ret_) then - call psb_error() - end if + call psb_error_handler(err_act) + return end subroutine psb_z_mv_coo_from_fmt @@ -3306,13 +3190,10 @@ subroutine psb_z_coo_cp_from(a,b) return 9999 continue - call psb_erractionrestore(err_act) - call psb_errpush(info,name) - if (err_act /= psb_act_ret_) then - call psb_error() - end if + call psb_error_handler(err_act) + return end subroutine psb_z_coo_cp_from @@ -3340,13 +3221,10 @@ subroutine psb_z_coo_mv_from(a,b) return 9999 continue - call psb_erractionrestore(err_act) - call psb_errpush(info,name) - if (err_act /= psb_act_ret_) then - call psb_error() - end if + call psb_error_handler(err_act) + return end subroutine psb_z_coo_mv_from @@ -3403,12 +3281,8 @@ subroutine psb_z_fix_coo(a,info,idir) 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_fix_coo @@ -4120,12 +3994,8 @@ subroutine psb_z_fix_coo_inner(nr,nc,nzin,dupl,ia,ja,val,nzout,info,idir) 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_fix_coo_inner diff --git a/base/serial/impl/psb_z_csc_impl.f90 b/base/serial/impl/psb_z_csc_impl.f90 index 802fc9b6..8dc1c8a2 100644 --- a/base/serial/impl/psb_z_csc_impl.f90 +++ b/base/serial/impl/psb_z_csc_impl.f90 @@ -312,13 +312,9 @@ subroutine psb_z_csc_csmv(alpha,a,x,beta,y,info,trans) 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_csc_csmv @@ -598,13 +594,9 @@ subroutine psb_z_csc_csmm(alpha,a,x,beta,y,info,trans) 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_csc_csmm @@ -712,13 +704,8 @@ subroutine psb_z_csc_cssv(alpha,a,x,beta,y,info,trans) call psb_erractionrestore(err_act) return -9999 continue - call psb_erractionrestore(err_act) +9999 call psb_error_handler(err_act) - if (err_act == psb_act_abort_) then - call psb_error() - return - end if return contains @@ -940,13 +927,8 @@ subroutine psb_z_csc_cssm(alpha,a,x,beta,y,info,trans) return -9999 continue - call psb_erractionrestore(err_act) +9999 call psb_error_handler(err_act) - if (err_act == psb_act_abort_) then - call psb_error() - return - end if return @@ -1174,13 +1156,8 @@ subroutine psb_z_csc_colsum(d,a) call psb_erractionrestore(err_act) return -9999 continue - call psb_erractionrestore(err_act) +9999 call psb_error_handler(err_act) - if (err_act == psb_act_abort_) then - call psb_error() - return - end if return end subroutine psb_z_csc_colsum @@ -1233,13 +1210,8 @@ subroutine psb_z_csc_aclsum(d,a) call psb_erractionrestore(err_act) return -9999 continue - call psb_erractionrestore(err_act) +9999 call psb_error_handler(err_act) - if (err_act == psb_act_abort_) then - call psb_error() - return - end if return end subroutine psb_z_csc_aclsum @@ -1287,13 +1259,8 @@ subroutine psb_z_csc_rowsum(d,a) call psb_erractionrestore(err_act) return -9999 continue - call psb_erractionrestore(err_act) +9999 call psb_error_handler(err_act) - if (err_act == psb_act_abort_) then - call psb_error() - return - end if return end subroutine psb_z_csc_rowsum @@ -1341,13 +1308,8 @@ subroutine psb_z_csc_arwsum(d,a) call psb_erractionrestore(err_act) return -9999 continue - call psb_erractionrestore(err_act) +9999 call psb_error_handler(err_act) - if (err_act == psb_act_abort_) then - call psb_error() - return - end if return end subroutine psb_z_csc_arwsum @@ -1398,12 +1360,8 @@ subroutine psb_z_csc_get_diag(a,d,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_csc_get_diag @@ -1472,12 +1430,8 @@ subroutine psb_z_csc_scal(d,a,info,side) 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_csc_scal @@ -1511,12 +1465,8 @@ subroutine psb_z_csc_scals(d,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_z_csc_scals @@ -1621,13 +1571,8 @@ subroutine psb_z_csc_csgetptn(imin,imax,a,nz,ia,ja,info,& call psb_erractionrestore(err_act) return -9999 continue - call psb_erractionrestore(err_act) +9999 call psb_error_handler(err_act) - if (err_act == psb_act_abort_) then - call psb_error() - return - end if return contains @@ -1815,13 +1760,8 @@ subroutine psb_z_csc_csgetrow(imin,imax,a,nz,ia,ja,val,info,& call psb_erractionrestore(err_act) return -9999 continue - call psb_erractionrestore(err_act) +9999 call psb_error_handler(err_act) - if (err_act == psb_act_abort_) then - call psb_error() - return - end if return contains @@ -2007,13 +1947,8 @@ subroutine psb_z_csc_csput_a(nz,ia,ja,val,a,imin,imax,jmin,jmax,info,gtl) call psb_erractionrestore(err_act) return -9999 continue - call psb_erractionrestore(err_act) +9999 call psb_error_handler(err_act) - if (err_act == psb_act_abort_) then - call psb_error() - return - end if return @@ -2595,10 +2530,9 @@ subroutine psb_z_csc_mold(a,b,info) goto 9999 end if return -9999 continue - if (err_act /= psb_act_ret_) then - call psb_error() - end if + +9999 call psb_error_handler(err_act) + return end subroutine psb_z_csc_mold @@ -2628,13 +2562,8 @@ subroutine psb_z_csc_reallocate_nz(nz,a) call psb_erractionrestore(err_act) return -9999 continue - call psb_erractionrestore(err_act) +9999 call psb_error_handler(err_act) - if (err_act == psb_act_abort_) then - call psb_error() - return - end if return end subroutine psb_z_csc_reallocate_nz @@ -2690,13 +2619,8 @@ subroutine psb_z_csc_csgetblk(imin,imax,a,b,info,& call psb_erractionrestore(err_act) return -9999 continue - call psb_erractionrestore(err_act) +9999 call psb_error_handler(err_act) - if (err_act == psb_act_abort_) then - call psb_error() - return - end if return end subroutine psb_z_csc_csgetblk @@ -2740,13 +2664,8 @@ subroutine psb_z_csc_reinit(a,clear) call psb_erractionrestore(err_act) return -9999 continue - call psb_erractionrestore(err_act) +9999 call psb_error_handler(err_act) - if (err_act == psb_act_abort_) then - call psb_error() - return - end if return end subroutine psb_z_csc_reinit @@ -2774,13 +2693,8 @@ subroutine psb_z_csc_trim(a) call psb_erractionrestore(err_act) return -9999 continue - call psb_erractionrestore(err_act) +9999 call psb_error_handler(err_act) - if (err_act == psb_act_abort_) then - call psb_error() - return - end if return end subroutine psb_z_csc_trim @@ -2840,13 +2754,8 @@ subroutine psb_z_csc_allocate_mnnz(m,n,a,nz) call psb_erractionrestore(err_act) return -9999 continue - call psb_erractionrestore(err_act) +9999 call psb_error_handler(err_act) - if (err_act == psb_act_abort_) then - call psb_error() - return - end if return end subroutine psb_z_csc_allocate_mnnz @@ -2968,12 +2877,8 @@ subroutine psb_zcscspspmm(a,b,c,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 contains diff --git a/base/serial/impl/psb_z_csr_impl.f90 b/base/serial/impl/psb_z_csr_impl.f90 index bf0027ad..a9a8571a 100644 --- a/base/serial/impl/psb_z_csr_impl.f90 +++ b/base/serial/impl/psb_z_csr_impl.f90 @@ -112,13 +112,8 @@ subroutine psb_z_csr_csmv(alpha,a,x,beta,y,info,trans) call psb_erractionrestore(err_act) return -9999 continue - call psb_erractionrestore(err_act) +9999 call psb_error_handler(err_act) - if (err_act == psb_act_abort_) then - call psb_error() - return - end if return contains @@ -467,13 +462,9 @@ subroutine psb_z_csr_csmm(alpha,a,x,beta,y,info,trans) 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 contains @@ -846,13 +837,8 @@ subroutine psb_z_csr_cssv(alpha,a,x,beta,y,info,trans) call psb_erractionrestore(err_act) return -9999 continue - call psb_erractionrestore(err_act) +9999 call psb_error_handler(err_act) - if (err_act == psb_act_abort_) then - call psb_error() - return - end if return contains @@ -1105,13 +1091,8 @@ subroutine psb_z_csr_cssm(alpha,a,x,beta,y,info,trans) return -9999 continue - call psb_erractionrestore(err_act) +9999 call psb_error_handler(err_act) - if (err_act == psb_act_abort_) then - call psb_error() - return - end if return @@ -1369,13 +1350,8 @@ subroutine psb_z_csr_rowsum(d,a) call psb_erractionrestore(err_act) return -9999 continue - call psb_erractionrestore(err_act) +9999 call psb_error_handler(err_act) - if (err_act == psb_act_abort_) then - call psb_error() - return - end if return end subroutine psb_z_csr_rowsum @@ -1423,13 +1399,8 @@ subroutine psb_z_csr_arwsum(d,a) call psb_erractionrestore(err_act) return -9999 continue - call psb_erractionrestore(err_act) +9999 call psb_error_handler(err_act) - if (err_act == psb_act_abort_) then - call psb_error() - return - end if return end subroutine psb_z_csr_arwsum @@ -1480,13 +1451,8 @@ subroutine psb_z_csr_colsum(d,a) call psb_erractionrestore(err_act) return -9999 continue - call psb_erractionrestore(err_act) +9999 call psb_error_handler(err_act) - if (err_act == psb_act_abort_) then - call psb_error() - return - end if return end subroutine psb_z_csr_colsum @@ -1537,13 +1503,8 @@ subroutine psb_z_csr_aclsum(d,a) call psb_erractionrestore(err_act) return -9999 continue - call psb_erractionrestore(err_act) +9999 call psb_error_handler(err_act) - if (err_act == psb_act_abort_) then - call psb_error() - return - end if return end subroutine psb_z_csr_aclsum @@ -1762,13 +1723,8 @@ subroutine psb_z_csr_reallocate_nz(nz,a) call psb_erractionrestore(err_act) return -9999 continue - call psb_erractionrestore(err_act) +9999 call psb_error_handler(err_act) - if (err_act == psb_act_abort_) then - call psb_error() - return - end if return end subroutine psb_z_csr_reallocate_nz @@ -1863,13 +1819,8 @@ subroutine psb_z_csr_allocate_mnnz(m,n,a,nz) call psb_erractionrestore(err_act) return -9999 continue - call psb_erractionrestore(err_act) +9999 call psb_error_handler(err_act) - if (err_act == psb_act_abort_) then - call psb_error() - return - end if return end subroutine psb_z_csr_allocate_mnnz @@ -1962,13 +1913,8 @@ subroutine psb_z_csr_csgetptn(imin,imax,a,nz,ia,ja,info,& call psb_erractionrestore(err_act) return -9999 continue - call psb_erractionrestore(err_act) +9999 call psb_error_handler(err_act) - if (err_act == psb_act_abort_) then - call psb_error() - return - end if return contains @@ -2142,13 +2088,8 @@ subroutine psb_z_csr_csgetrow(imin,imax,a,nz,ia,ja,val,info,& call psb_erractionrestore(err_act) return -9999 continue - call psb_erractionrestore(err_act) +9999 call psb_error_handler(err_act) - if (err_act == psb_act_abort_) then - call psb_error() - return - end if return contains @@ -2286,13 +2227,8 @@ subroutine psb_z_csr_csgetblk(imin,imax,a,b,info,& call psb_erractionrestore(err_act) return -9999 continue - call psb_erractionrestore(err_act) +9999 call psb_error_handler(err_act) - if (err_act == psb_act_abort_) then - call psb_error() - return - end if return end subroutine psb_z_csr_csgetblk @@ -2383,13 +2319,8 @@ subroutine psb_z_csr_csput_a(nz,ia,ja,val,a,imin,imax,jmin,jmax,info,gtl) call psb_erractionrestore(err_act) return -9999 continue - call psb_erractionrestore(err_act) +9999 call psb_error_handler(err_act) - if (err_act == psb_act_abort_) then - call psb_error() - return - end if return @@ -2607,13 +2538,8 @@ subroutine psb_z_csr_reinit(a,clear) call psb_erractionrestore(err_act) return -9999 continue - call psb_erractionrestore(err_act) +9999 call psb_error_handler(err_act) - if (err_act == psb_act_abort_) then - call psb_error() - return - end if return end subroutine psb_z_csr_reinit @@ -2642,13 +2568,8 @@ subroutine psb_z_csr_trim(a) call psb_erractionrestore(err_act) return -9999 continue - call psb_erractionrestore(err_act) +9999 call psb_error_handler(err_act) - if (err_act == psb_act_abort_) then - call psb_error() - return - end if return end subroutine psb_z_csr_trim @@ -3220,12 +3141,8 @@ subroutine psb_zcsrspspmm(a,b,c,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 contains diff --git a/base/serial/impl/psb_z_mat_impl.F90 b/base/serial/impl/psb_z_mat_impl.F90 index dc1bfb3e..c8554b8a 100644 --- a/base/serial/impl/psb_z_mat_impl.F90 +++ b/base/serial/impl/psb_z_mat_impl.F90 @@ -77,14 +77,9 @@ subroutine psb_z_set_nrows(m,a) 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_set_nrows @@ -110,14 +105,9 @@ subroutine psb_z_set_ncols(n,a) 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_set_ncols @@ -152,14 +142,9 @@ subroutine psb_z_set_dupl(n,a) 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_set_dupl @@ -189,14 +174,9 @@ subroutine psb_z_set_null(a) 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_set_null @@ -222,13 +202,10 @@ subroutine psb_z_set_bld(a) 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_set_bld @@ -254,13 +231,10 @@ subroutine psb_z_set_upd(a) 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_set_upd @@ -287,13 +261,10 @@ subroutine psb_z_set_asb(a) 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_set_asb @@ -320,13 +291,10 @@ subroutine psb_z_set_sorted(a,val) 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_set_sorted @@ -353,13 +321,10 @@ subroutine psb_z_set_triangle(a,val) 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_set_triangle @@ -386,13 +351,10 @@ subroutine psb_z_set_unit(a,val) 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_set_unit @@ -419,13 +381,10 @@ subroutine psb_z_set_lower(a,val) 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_set_lower @@ -452,13 +411,10 @@ subroutine psb_z_set_upper(a,val) 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_set_upper @@ -504,12 +460,8 @@ subroutine psb_z_sparse_print(iout,a,iv,head,ivr,ivc) return -9999 continue +9999 call psb_error_handler(err_act) - if (err_act == psb_act_abort_) then - call psb_error() - return - end if return end subroutine psb_z_sparse_print @@ -559,12 +511,8 @@ subroutine psb_z_n_sparse_print(fname,a,iv,head,ivr,ivc) return -9999 continue +9999 call psb_error_handler(err_act) - if (err_act == psb_act_abort_) then - call psb_error() - return - end if return end subroutine psb_z_n_sparse_print @@ -600,13 +548,8 @@ subroutine psb_z_get_neigh(a,idx,neigh,n,info,lev) call psb_erractionrestore(err_act) return -9999 continue - call psb_erractionrestore(err_act) +9999 call psb_error_handler(err_act) - if (err_act == psb_act_abort_) then - call psb_error() - return - end if return end subroutine psb_z_get_neigh @@ -643,12 +586,8 @@ subroutine psb_z_csall(nr,nc,a,info,nz) return -9999 continue +9999 call psb_error_handler(err_act) - if (err_act == psb_act_abort_) then - call psb_error() - return - end if return end subroutine psb_z_csall @@ -675,13 +614,8 @@ subroutine psb_z_reallocate_nz(nz,a) return -9999 continue - call psb_erractionrestore(err_act) +9999 call psb_error_handler(err_act) - if (err_act == psb_act_abort_) then - call psb_error() - return - end if return end subroutine psb_z_reallocate_nz @@ -721,12 +655,8 @@ subroutine psb_z_trim(a) return -9999 continue +9999 call psb_error_handler(err_act) - if (err_act == psb_act_abort_) then - call psb_error() - return - end if return end subroutine psb_z_trim @@ -763,13 +693,10 @@ subroutine psb_z_csput_a(nz,ia,ja,val,a,imin,imax,jmin,jmax,info,gtl) 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_csput_a @@ -810,13 +737,10 @@ subroutine psb_z_csput_v(nz,ia,ja,val,a,imin,imax,jmin,jmax,info,gtl) 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_csput_v @@ -860,13 +784,10 @@ subroutine psb_z_csgetptn(imin,imax,a,nz,ia,ja,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_csgetptn @@ -911,13 +832,10 @@ subroutine psb_z_csgetrow(imin,imax,a,nz,ia,ja,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_csgetrow @@ -980,13 +898,10 @@ subroutine psb_z_csgetblk(imin,imax,a,b,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_csgetblk @@ -1033,13 +948,10 @@ subroutine psb_z_tril(a,b,info,diag,imin,imax,& 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_tril @@ -1087,13 +999,10 @@ subroutine psb_z_triu(a,b,info,diag,imin,imax,& 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_triu @@ -1142,13 +1051,10 @@ subroutine psb_z_csclip(a,b,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_csclip @@ -1187,13 +1093,10 @@ subroutine psb_z_b_csclip(a,b,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_b_csclip @@ -1296,13 +1199,10 @@ subroutine psb_z_cscnv(a,b,info,type,mold,upd,dupl) 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_cscnv @@ -1402,13 +1302,10 @@ subroutine psb_z_cscnv_ip(a,info,type,mold,dupl) 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_cscnv_ip @@ -1457,13 +1354,10 @@ subroutine psb_z_cscnv_base(a,b,info,dupl) 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_cscnv_base @@ -1520,13 +1414,10 @@ subroutine psb_z_clip_d(a,b,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_clip_d @@ -1582,13 +1473,10 @@ subroutine psb_z_clip_d_ip(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_z_clip_d_ip @@ -1647,13 +1535,10 @@ subroutine psb_z_cp_from(a,b) 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_cp_from @@ -1744,13 +1629,10 @@ subroutine psb_zspmat_clone(a,b,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_zspmat_clone @@ -1779,13 +1661,10 @@ subroutine psb_z_transp_1mat(a) 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_transp_1mat @@ -1825,13 +1704,10 @@ subroutine psb_z_transp_2mat(a,b) 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_transp_2mat @@ -1860,13 +1736,10 @@ subroutine psb_z_transc_1mat(a) 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_transc_1mat @@ -1906,13 +1779,10 @@ subroutine psb_z_transc_2mat(a,b) 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_transc_2mat @@ -1949,13 +1819,10 @@ subroutine psb_z_asb(a,mold) 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_asb @@ -1987,13 +1854,10 @@ subroutine psb_z_reinit(a,clear) 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_reinit @@ -2040,13 +1904,8 @@ subroutine psb_z_csmm(alpha,a,x,beta,y,info,trans) call psb_erractionrestore(err_act) return -9999 continue - call psb_erractionrestore(err_act) +9999 call psb_error_handler(err_act) - if (err_act == psb_act_abort_) then - call psb_error() - return - end if return end subroutine psb_z_csmm @@ -2078,13 +1937,8 @@ subroutine psb_z_csmv(alpha,a,x,beta,y,info,trans) call psb_erractionrestore(err_act) return -9999 continue - call psb_erractionrestore(err_act) +9999 call psb_error_handler(err_act) - if (err_act == psb_act_abort_) then - call psb_error() - return - end if return end subroutine psb_z_csmv @@ -2128,13 +1982,8 @@ subroutine psb_z_csmv_vect(alpha,a,x,beta,y,info,trans) call psb_erractionrestore(err_act) return -9999 continue - call psb_erractionrestore(err_act) +9999 call psb_error_handler(err_act) - if (err_act == psb_act_abort_) then - call psb_error() - return - end if return end subroutine psb_z_csmv_vect @@ -2169,13 +2018,8 @@ subroutine psb_z_cssm(alpha,a,x,beta,y,info,trans,scale,d) call psb_erractionrestore(err_act) return -9999 continue - call psb_erractionrestore(err_act) +9999 call psb_error_handler(err_act) - if (err_act == psb_act_abort_) then - call psb_error() - return - end if return end subroutine psb_z_cssm @@ -2210,13 +2054,8 @@ subroutine psb_z_cssv(alpha,a,x,beta,y,info,trans,scale,d) call psb_erractionrestore(err_act) return -9999 continue - call psb_erractionrestore(err_act) +9999 call psb_error_handler(err_act) - if (err_act == psb_act_abort_) then - call psb_error() - return - end if return end subroutine psb_z_cssv @@ -2271,13 +2110,8 @@ subroutine psb_z_cssv_vect(alpha,a,x,beta,y,info,trans,scale,d) call psb_erractionrestore(err_act) return -9999 continue - call psb_erractionrestore(err_act) +9999 call psb_error_handler(err_act) - if (err_act == psb_act_abort_) then - call psb_error() - return - end if return end subroutine psb_z_cssv_vect @@ -2306,12 +2140,9 @@ function psb_z_maxval(a) result(res) res = a%a%maxval() return -9999 continue - if (err_act == psb_act_abort_) then - call psb_error() - return - end if +9999 call psb_error_handler(err_act) + return end function psb_z_maxval @@ -2339,12 +2170,9 @@ function psb_z_csnmi(a) result(res) res = a%a%spnmi() return -9999 continue - if (err_act == psb_act_abort_) then - call psb_error() - return - end if +9999 call psb_error_handler(err_act) + return end function psb_z_csnmi @@ -2373,12 +2201,9 @@ function psb_z_csnm1(a) result(res) res = a%a%spnm1() return -9999 continue - if (err_act == psb_act_abort_) then - call psb_error() - return - end if +9999 call psb_error_handler(err_act) + return end function psb_z_csnm1 @@ -2411,13 +2236,8 @@ function psb_z_rowsum(a,info) result(d) call psb_erractionrestore(err_act) return -9999 continue - call psb_erractionrestore(err_act) +9999 call psb_error_handler(err_act) - if (err_act == psb_act_abort_) then - call psb_error() - return - end if return end function psb_z_rowsum @@ -2450,13 +2270,8 @@ function psb_z_arwsum(a,info) result(d) call psb_erractionrestore(err_act) return -9999 continue - call psb_erractionrestore(err_act) +9999 call psb_error_handler(err_act) - if (err_act == psb_act_abort_) then - call psb_error() - return - end if return end function psb_z_arwsum @@ -2489,13 +2304,8 @@ function psb_z_colsum(a,info) result(d) call psb_erractionrestore(err_act) return -9999 continue - call psb_erractionrestore(err_act) +9999 call psb_error_handler(err_act) - if (err_act == psb_act_abort_) then - call psb_error() - return - end if return end function psb_z_colsum @@ -2528,13 +2338,8 @@ function psb_z_aclsum(a,info) result(d) call psb_erractionrestore(err_act) return -9999 continue - call psb_erractionrestore(err_act) +9999 call psb_error_handler(err_act) - if (err_act == psb_act_abort_) then - call psb_error() - return - end if return end function psb_z_aclsum @@ -2572,13 +2377,8 @@ function psb_z_get_diag(a,info) result(d) call psb_erractionrestore(err_act) return -9999 continue - call psb_erractionrestore(err_act) +9999 call psb_error_handler(err_act) - if (err_act == psb_act_abort_) then - call psb_error() - return - end if return end function psb_z_get_diag @@ -2612,13 +2412,8 @@ subroutine psb_z_scal(d,a,info,side) call psb_erractionrestore(err_act) return -9999 continue - call psb_erractionrestore(err_act) +9999 call psb_error_handler(err_act) - if (err_act == psb_act_abort_) then - call psb_error() - return - end if return end subroutine psb_z_scal @@ -2651,13 +2446,8 @@ subroutine psb_z_scals(d,a,info) call psb_erractionrestore(err_act) return -9999 continue - call psb_erractionrestore(err_act) +9999 call psb_error_handler(err_act) - if (err_act == psb_act_abort_) then - call psb_error() - return - end if return end subroutine psb_z_scals