From a0a0e96a962dad0d7861c3feb70006452b6cfa88 Mon Sep 17 00:00:00 2001
From: Salvatore Filippone <salvatore.filippone@cranfield.ac.uk>
Date: Thu, 27 Jul 2017 15:03:30 +0100
Subject: [PATCH] Simple caching for psb_info. Make barrier in errcomm
 optional, default false.

---
 base/modules/psb_error_impl.F90 |  2 +-
 base/modules/psb_error_mod.F90  | 26 ++++++++++++++++++++++++--
 base/modules/psi_penv_mod.F90   | 23 ++++++++++++++++++-----
 3 files changed, 43 insertions(+), 8 deletions(-)

diff --git a/base/modules/psb_error_impl.F90 b/base/modules/psb_error_impl.F90
index 5216a9cc..a6db7796 100644
--- a/base/modules/psb_error_impl.F90
+++ b/base/modules/psb_error_impl.F90
@@ -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
 
diff --git a/base/modules/psb_error_mod.F90 b/base/modules/psb_error_mod.F90
index cdfc2006..5dad978c 100644
--- a/base/modules/psb_error_mod.F90
+++ b/base/modules/psb_error_mod.F90
@@ -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
diff --git a/base/modules/psi_penv_mod.F90 b/base/modules/psi_penv_mod.F90
index 0f3c01ee..01cea461 100644
--- a/base/modules/psi_penv_mod.F90
+++ b/base/modules/psi_penv_mod.F90
@@ -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