mirror of
https://github.com/sfilippone/psblas3.git
synced 2026-10-06 22:55:08 +00:00
Simple caching for psb_info. Make barrier in errcomm optional, default false.
This commit is contained in:
@@ -5,7 +5,7 @@ subroutine psb_errcomm(ictxt, err)
|
||||
integer(psb_mpik_), intent(in) :: ictxt
|
||||
integer(psb_ipk_), intent(inout):: err
|
||||
|
||||
call psb_amx(ictxt, err)
|
||||
if (psb_get_global_checks()) call psb_amx(ictxt, err)
|
||||
|
||||
end subroutine psb_errcomm
|
||||
|
||||
|
||||
@@ -63,8 +63,8 @@ module psb_error_mod
|
||||
& 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_error_print_stack, psb_errmsg, psb_ach_errmsg
|
||||
|
||||
& psb_error_print_stack, psb_errmsg, psb_ach_errmsg, &
|
||||
& psb_set_global_checks, psb_clear_global_checks, psb_get_global_checks
|
||||
|
||||
interface psb_error_handler
|
||||
subroutine psb_ser_error_handler(err_act)
|
||||
@@ -161,9 +161,31 @@ module psb_error_mod
|
||||
integer(psb_ipk_), save :: verbosity_level = 1
|
||||
integer(psb_ipk_), save :: err_action = psb_act_abort_
|
||||
integer(psb_ipk_), save :: debug_level = 0, debug_unit, serial_debug_level=0
|
||||
logical, save :: comm_global_checks = .false.
|
||||
|
||||
contains
|
||||
subroutine psb_set_global_checks(val)
|
||||
logical, intent(in), optional :: val
|
||||
|
||||
if (present(val)) then
|
||||
comm_global_checks = val
|
||||
else
|
||||
comm_global_checks = .true.
|
||||
end if
|
||||
end subroutine psb_set_global_checks
|
||||
subroutine psb_clear_global_checks()
|
||||
|
||||
comm_global_checks = .false.
|
||||
|
||||
end subroutine psb_clear_global_checks
|
||||
|
||||
function psb_get_global_checks() result(val)
|
||||
logical :: val
|
||||
|
||||
val = comm_global_checks
|
||||
end function psb_get_global_checks
|
||||
|
||||
|
||||
#if defined(LONG_INTEGERS)
|
||||
subroutine psb_errcomm_ipk(ictxt, err)
|
||||
integer(psb_ipk_), intent(in) :: ictxt
|
||||
|
||||
@@ -519,6 +519,11 @@ contains
|
||||
integer(psb_mpik_), intent(in) :: ictxt
|
||||
integer(psb_mpik_), intent(out) :: iam, np
|
||||
integer(psb_mpik_) :: info
|
||||
!
|
||||
! Simple caching scheme, keep track
|
||||
! of the last CTXT encountered.
|
||||
!
|
||||
integer(psb_mpik_), save :: lctxt=-1, lam, lnp
|
||||
|
||||
#if defined(SERIAL_MPI)
|
||||
iam = 0
|
||||
@@ -526,11 +531,19 @@ contains
|
||||
#else
|
||||
iam = -1
|
||||
np = -1
|
||||
if (ictxt /= mpi_comm_null) then
|
||||
call mpi_comm_size(ictxt,np,info)
|
||||
if (info /= mpi_success) np = -1
|
||||
call mpi_comm_rank(ictxt,iam,info)
|
||||
if (info /= mpi_success) iam = -1
|
||||
if (ictxt == lctxt) then
|
||||
iam = lam
|
||||
np = lnp
|
||||
else
|
||||
if (ictxt /= mpi_comm_null) then
|
||||
call mpi_comm_size(ictxt,np,info)
|
||||
if (info /= mpi_success) np = -1
|
||||
call mpi_comm_rank(ictxt,iam,info)
|
||||
if (info /= mpi_success) iam = -1
|
||||
end if
|
||||
lctxt = ictxt
|
||||
lam = iam
|
||||
lnp = np
|
||||
end if
|
||||
#endif
|
||||
|
||||
|
||||
Reference in New Issue
Block a user