mirror of
https://gitlab.com/scemama/QCaml.git
synced 2024-12-31 08:35:41 +01:00
Improved parallel efficiency
This commit is contained in:
parent
39cdbba97e
commit
01ef77bd8c
@ -90,24 +90,22 @@ module Make(T : Two_ei_structure) = struct
|
|||||||
|
|
||||||
let shell_pairs =
|
let shell_pairs =
|
||||||
Csp.of_contracted_shell_array shell
|
Csp.of_contracted_shell_array shell
|
||||||
|
|> Array.of_list
|
||||||
in
|
in
|
||||||
|
|
||||||
Printf.printf "%d significant shell pairs computed in %f seconds\n"
|
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 t0 = Unix.gettimeofday () in
|
||||||
|
|
||||||
let f shell_p =
|
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 =
|
let sp =
|
||||||
Csp.shell_pairs shell_p
|
Csp.shell_pairs shell_p
|
||||||
in
|
in
|
||||||
|
|
||||||
try
|
try
|
||||||
List.iter (fun shell_q ->
|
Array.iter (fun shell_q ->
|
||||||
let () =
|
let () =
|
||||||
if Cs.index (Csp.shell_a shell_q) >
|
if Cs.index (Csp.shell_a shell_q) >
|
||||||
Cs.index (Csp.shell_a shell_p) then
|
Cs.index (Csp.shell_a shell_p) then
|
||||||
@ -132,15 +130,27 @@ module Make(T : Two_ei_structure) = struct
|
|||||||
with Exit -> ()
|
with Exit -> ()
|
||||||
in
|
in
|
||||||
|
|
||||||
|
|
||||||
|
|
||||||
let pool = Domainslib.Task.setup_pool ~num_domains:Qcaml.num_domains () in
|
let pool = Domainslib.Task.setup_pool ~num_domains:Qcaml.num_domains () in
|
||||||
let _ =
|
let _ =
|
||||||
Domainslib.Task.run pool (fun _ ->
|
Domainslib.Task.run pool (fun _ ->
|
||||||
shell_pairs
|
(*
|
||||||
|> List.map (fun sp ->
|
let n = Array.length shell_pairs in
|
||||||
Domainslib.Task.async pool (fun _ -> f sp) )
|
Domainslib.Task.parallel_for pool ~start:1 ~finish:n
|
||||||
|> List.iter (fun task -> ignore (Domainslib.Task.await pool task) ) ;
|
~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
|
in
|
||||||
Domainslib.Task.teardown_pool pool;
|
Domainslib.Task.teardown_pool pool;
|
||||||
|
Loading…
Reference in New Issue
Block a user