Simple caching for psb_info. Make barrier in errcomm optional, default false.

pull/1/head
Salvatore Filippone 8 years ago
parent 9c989c24e9
commit a0a0e96a96

@ -5,7 +5,7 @@ subroutine psb_errcomm(ictxt, err)
integer(psb_mpik_), intent(in) :: ictxt integer(psb_mpik_), intent(in) :: ictxt
integer(psb_ipk_), intent(inout):: err 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 end subroutine psb_errcomm

@ -63,8 +63,8 @@ module psb_error_mod
& psb_clean_errstack, psb_error_handler, & & psb_clean_errstack, psb_error_handler, &
& psb_ser_error_handler, psb_par_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 & 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 interface psb_error_handler
subroutine psb_ser_error_handler(err_act) 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 :: verbosity_level = 1
integer(psb_ipk_), save :: err_action = psb_act_abort_ integer(psb_ipk_), save :: err_action = psb_act_abort_
integer(psb_ipk_), save :: debug_level = 0, debug_unit, serial_debug_level=0 integer(psb_ipk_), save :: debug_level = 0, debug_unit, serial_debug_level=0
logical, save :: comm_global_checks = .false.
contains 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) #if defined(LONG_INTEGERS)
subroutine psb_errcomm_ipk(ictxt, err) subroutine psb_errcomm_ipk(ictxt, err)
integer(psb_ipk_), intent(in) :: ictxt integer(psb_ipk_), intent(in) :: ictxt

@ -519,6 +519,11 @@ contains
integer(psb_mpik_), intent(in) :: ictxt integer(psb_mpik_), intent(in) :: ictxt
integer(psb_mpik_), intent(out) :: iam, np integer(psb_mpik_), intent(out) :: iam, np
integer(psb_mpik_) :: info 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) #if defined(SERIAL_MPI)
iam = 0 iam = 0
@ -526,11 +531,19 @@ contains
#else #else
iam = -1 iam = -1
np = -1 np = -1
if (ictxt /= mpi_comm_null) then if (ictxt == lctxt) then
call mpi_comm_size(ictxt,np,info) iam = lam
if (info /= mpi_success) np = -1 np = lnp
call mpi_comm_rank(ictxt,iam,info) else
if (info /= mpi_success) iam = -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
end if
lctxt = ictxt
lam = iam
lnp = np
end if end if
#endif #endif

Loading…
Cancel
Save