From 01ef77bd8c9bdf64e2db892c11fe64e62a57a49f Mon Sep 17 00:00:00 2001
From: Anthony Scemama <scemama@irsamc.ups-tlse.fr>
Date: Sat, 17 Jun 2023 01:06:39 +0200
Subject: [PATCH] Improved parallel efficiency

---
 .../lib/two_electron_integrals.ml             | 32 ++++++++++++-------
 1 file changed, 21 insertions(+), 11 deletions(-)

diff --git a/gaussian_integrals/lib/two_electron_integrals.ml b/gaussian_integrals/lib/two_electron_integrals.ml
index f4f563c..a4a0bbb 100644
--- a/gaussian_integrals/lib/two_electron_integrals.ml
+++ b/gaussian_integrals/lib/two_electron_integrals.ml
@@ -90,24 +90,22 @@ module Make(T : Two_ei_structure) = struct
 
     let shell_pairs =
       Csp.of_contracted_shell_array shell
+      |> Array.of_list
     in
 
     Printf.printf "%d significant shell pairs computed in %f seconds\n"
-      (List.length shell_pairs) (Unix.gettimeofday () -. t0);
+      (Array.length shell_pairs) (Unix.gettimeofday () -. t0);
 
     let t0 = Unix.gettimeofday () in
 
     let f shell_p =
-      let () =
-          Printf.printf "%3d %3d\n%!" (Cs.index (Csp.shell_a shell_p)) (Cs.index (Csp.shell_b shell_p))
-      in
 
       let sp =
         Csp.shell_pairs shell_p
       in
 
       try
-          List.iter (fun shell_q ->
+          Array.iter (fun shell_q ->
               let () =
                 if  Cs.index (Csp.shell_a shell_q) >
                     Cs.index (Csp.shell_a shell_p) then
@@ -132,15 +130,27 @@ module Make(T : Two_ei_structure) = struct
         with Exit -> ()
     in
 
-
-
     let pool =  Domainslib.Task.setup_pool ~num_domains:Qcaml.num_domains () in
     let _ =
       Domainslib.Task.run pool (fun _ ->
-        shell_pairs
-        |> List.map (fun sp ->
-               Domainslib.Task.async pool (fun _ -> f sp) )
-        |> List.iter (fun task -> ignore (Domainslib.Task.await pool task) ) ;
+              (*
+              let n = Array.length shell_pairs in
+              Domainslib.Task.parallel_for pool ~start:1 ~finish:n
+                ~chunk_size:2
+                ~body:(fun i -> f shell_pairs.(n-i))
+      *)
+      let n = Array.length shell_pairs in
+      let i_prev = ref 0 in
+      shell_pairs
+      |> Array.map (fun sp ->
+             Domainslib.Task.async pool (fun _ -> f sp) )
+      |> Array.iteri (fun i task ->
+                      let i = ((10 * i+1)/n) in
+                      if !i_prev <> i then (
+                         i_prev := i; 
+                         Printf.printf "%3d %%\n%!" (i*10)
+                      );
+                      ignore (Domainslib.Task.await pool task) ) ;
       )
     in
     Domainslib.Task.teardown_pool pool;