From e226bd135ea402046846360030b91a7b728cd8df Mon Sep 17 00:00:00 2001
From: Anthony Scemama <scemama@irsamc.ups-tlse.fr>
Date: Wed, 20 Mar 2019 23:19:52 +0100
Subject: [PATCH] Removed MPI busy waiting

---
 Parallel_mpi/Farm.ml | 8 +++++++-
 1 file changed, 7 insertions(+), 1 deletion(-)

diff --git a/Parallel_mpi/Farm.ml b/Parallel_mpi/Farm.ml
index 7da1fbe..3a8b7f3 100644
--- a/Parallel_mpi/Farm.ml
+++ b/Parallel_mpi/Farm.ml
@@ -48,7 +48,13 @@ let run_parallel_server ~ordered stream =
   let fetch_result () : (task_id * 'a) option * int =
     let (message, rank, _tag) : (task_id * 'a) option * int * int =
       debug "Before receive_status";
-      Mpi.receive_status  Mpi.any_source  Mpi.any_tag  Mpi.comm_world
+      (* Avoid busy receive *)
+      let rec wait_and_receive () = 
+        match Mpi.iprobe Mpi.any_source Mpi.any_tag Mpi.comm_world with
+        | Some _ -> Mpi.receive_status  Mpi.any_source  Mpi.any_tag  Mpi.comm_world
+        | None   -> (Unix.sleepf 0.001 ; wait_and_receive ())
+      in
+      wait_and_receive ()
     in
     debug @@ Printf.sprintf "After receive_status %d %d" rank _tag;
     message, rank