Improved parallel efficiency

This commit is contained in:
Anthony Scemama 2023-06-17 01:06:39 +02:00
parent 39cdbba97e
commit 01ef77bd8c
1 changed files with 21 additions and 11 deletions

View File

@ -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;