fdurastante/psblas3
1
0
Fork 0
mirror of https://github.com/sfilippone/psblas3.git synced 2026-10-16 02:49:03 +00:00
Code Issues Packages Projects Releases Wiki Activity

Merged MixedI8 in new branch (to be later merged into development)

Browse Source
This commit is contained in:
Salvatore Filippone
2018-12-10 11:42:40 +00:00
parent 5371e39c16
commit 8d489f8ce2
921 changed files with 172036 additions and 57462 deletions
Download Patch File Download Diff File Expand all files Collapse all files
base/modules/psb_error_impl.F90
+39 -25
View File
@@ -1,13 +1,26 @@
! checks wether an error has occurred on one of the porecesses in the execution pool
subroutine psb_errcomm(ictxt, err)
subroutine psb_errcomm_i(ictxt, err)
use psb_error_mod, psb_protect_name => psb_errcomm
use psb_penv_mod
integer(psb_mpik_), intent(in) :: ictxt
integer(psb_ipk_), intent(in) :: ictxt
integer(psb_ipk_), intent(inout):: err
if (psb_get_global_checks()) call psb_amx(ictxt, err)
end subroutine psb_errcomm_i
#if defined(IPK8)
subroutine psb_errcomm_m(ictxt, err)
use psb_error_mod, psb_protect_name => psb_errcomm
use psb_penv_mod
integer(psb_mpk_), intent(in) :: ictxt
integer(psb_ipk_), intent(inout):: err
if (psb_get_global_checks()) call psb_amx(ictxt, err)
end subroutine psb_errcomm
end subroutine psb_errcomm_m
#endif
subroutine psb_ser_error_handler(err_act)
use psb_error_mod, psb_protect_name => psb_ser_error_handler
@@ -30,13 +43,13 @@ subroutine psb_par_error_handler(ictxt,err_act)
implicit none
integer(psb_ipk_), intent(in) :: ictxt
integer(psb_ipk_), intent(in) :: err_act
integer(psb_mpik_) :: iictxt
call psb_erractionrestore(err_act)
iictxt = ictxt
if (err_act == psb_act_print_) &
& call psb_error(iictxt, abrt=.false.)
& call psb_error(ictxt, abrt=.false.)
if (err_act == psb_act_abort_) &
& call psb_error(iictxt, abrt=.true.)
& call psb_error(ictxt, abrt=.true.)
return
@@ -45,7 +58,7 @@ end subroutine psb_par_error_handler
subroutine psb_par_error_print_stack(ictxt)
use psb_error_mod, psb_protect_name => psb_par_error_print_stack
use psb_penv_mod
integer(psb_mpik_), intent(in) :: ictxt
integer(psb_ipk_), intent(in) :: ictxt
call psb_error(ictxt, abrt=.false.)
@@ -68,24 +81,24 @@ subroutine psb_serror()
integer(psb_ipk_) :: err_c
character(len=20) :: r_name
character(len=40) :: a_e_d
integer(psb_ipk_) :: i_e_d(5)
integer(psb_epk_) :: e_e_d(5)
if (psb_errstatus_fatal()) then
if(psb_get_errverbosity() > 1) then
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(psb_err_unit,err_c, r_name, i_e_d, a_e_d)
call psb_errpop(err_c, r_name, e_e_d, a_e_d)
call psb_errmsg(psb_err_unit,err_c, r_name, e_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(psb_err_unit,err_c, r_name, i_e_d, a_e_d)
call psb_errpop(err_c, r_name, e_e_d, a_e_d)
call psb_errmsg(psb_err_unit,err_c, r_name, e_e_d, a_e_d)
do while (psb_get_numerr() > 0)
call psb_errpop(err_c, r_name, i_e_d, a_e_d)
call psb_errpop(err_c, r_name, e_e_d, a_e_d)
end do
end if
end if
@@ -103,47 +116,48 @@ subroutine psb_perror(ictxt,abrt)
use psb_error_mod
use psb_penv_mod
implicit none
integer(psb_mpik_), intent(in) :: ictxt
integer(psb_ipk_), intent(in) :: ictxt
logical, intent(in), optional :: abrt
integer(psb_ipk_) :: err_c
character(len=20) :: r_name
character(len=40) :: a_e_d
integer(psb_ipk_) :: i_e_d(5)
integer(psb_mpik_) :: iam, np
integer(psb_epk_) :: e_e_d(5)
integer(psb_mpk_) :: iictxt, iam, np
logical :: abrt_
abrt_=.true.
if (present(abrt)) abrt_=abrt
call psb_info(ictxt,iam,np)
iictxt = ictxt
call psb_info(iictxt,iam,np)
if (psb_errstatus_fatal()) then
if (psb_get_errverbosity() > 1) then
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(psb_err_unit,err_c, r_name, i_e_d, a_e_d,iam)
call psb_errpop(err_c, r_name, e_e_d, a_e_d)
call psb_errmsg(psb_err_unit,err_c, r_name, e_e_d, a_e_d,iam)
! write(psb_err_unit,'(50("="))')
end do
#if defined(HAVE_FLUSH_STMT)
flush(psb_err_unit)
#endif
if (abrt_) call psb_abort(ictxt,-1)
if (abrt_) call psb_abort(iictxt,-1)
else
call psb_errpop(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,iam)
call psb_errpop(err_c, r_name, e_e_d, a_e_d)
call psb_errmsg(psb_err_unit,err_c, r_name, e_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)
call psb_errpop(err_c, r_name, e_e_d, a_e_d)
end do
#if defined(HAVE_FLUSH_STMT)
flush(psb_err_unit)
#endif
if (abrt_) call psb_abort(ictxt,-1)
if (abrt_) call psb_abort(iictxt,-1)
end if
end if