10
1
mirror of https://gitlab.com/scemama/QCaml.git synced 2024-12-22 20:33:36 +01:00

Improved parallel integrals

This commit is contained in:
Anthony Scemama 2023-06-17 02:07:35 +02:00
parent 01ef77bd8c
commit d5a71707c8
2 changed files with 37 additions and 36 deletions

View File

@ -131,8 +131,7 @@ let make p_a p_b =
let norm_scales x = let norm_scales x =
try try
Lazy.force x.norm_scales Lazy.force x.norm_scales
with Lazy.Undefined -> (Printf.printf "UNDEFINED\n%!" ; compute_norm_scales x.shell_a x.shell_b with Lazy.Undefined -> compute_norm_scales x.shell_a x.shell_b
)
let exponent_inv x = x.exponent_inv let exponent_inv x = x.exponent_inv

View File

@ -45,30 +45,40 @@ module Make(T : Two_ei_structure) = struct
and shell_q = Cspc.shell_pair_q contracted_shell_pair_couple and shell_q = Cspc.shell_pair_q contracted_shell_pair_couple
in in
Array.iteri (fun i_c powers_i -> let expand i_c powers_i shell = (
let i_c = Cs.index (Csp.shell_a shell_p) + i_c + 1 in Cs.index shell + i_c + 1,
let xi = to_powers powers_i in to_powers powers_i)
Array.iteri (fun j_c powers_j -> in
let j_c = Cs.index (Csp.shell_b shell_p) + j_c + 1 in
let xj = to_powers powers_j in let l1 =
Array.iteri (fun k_c powers_k -> Array.mapi (fun i x -> expand i x (Csp.shell_a shell_p))
let k_c = Cs.index (Csp.shell_a shell_q) + k_c + 1 in (Cs.zkey_array (Csp.shell_a shell_p))
let xk = to_powers powers_k in in
Array.iteri (fun l_c powers_l -> let l2 =
let l_c = Cs.index (Csp.shell_b shell_q) + l_c + 1 in Array.mapi (fun i x -> expand i x (Csp.shell_b shell_p))
let xl = to_powers powers_l in (Cs.zkey_array (Csp.shell_b shell_p))
let key = Zkey.of_powers_twelve xi xj xk xl in in
let l3 =
Array.mapi (fun i x -> expand i x (Csp.shell_a shell_q))
(Cs.zkey_array (Csp.shell_a shell_q))
in
let l4 =
Array.mapi (fun i x -> expand i x (Csp.shell_b shell_q))
(Cs.zkey_array (Csp.shell_b shell_q))
in
Array.iter (fun (l_c,xl) ->
Array.iter (fun (k_c,xk) ->
Array.iter (fun (j_c,xj) ->
Array.iter (fun (i_c,xi) ->
let key = Zkey.of_powers_twelve xi xj xk xl in
let value = Zmap.find cls key in let value = Zmap.find cls key in
if abs_float value > cutoff then if abs_float value > cutoff then
set_chem data i_c j_c k_c l_c value set_chem data i_c j_c k_c l_c value
) (Cs.zkey_array (Csp.shell_b shell_q)) ) l1
) (Cs.zkey_array (Csp.shell_a shell_q)) ) l2
) (Cs.zkey_array (Csp.shell_b shell_p)) ) l3
) (Cs.zkey_array (Csp.shell_a shell_p)) ) l4
@ -126,31 +136,23 @@ module Make(T : Two_ei_structure) = struct
in in
store_class ~cutoff eri_array cspc cls store_class ~cutoff eri_array cspc cls
| None -> () | None -> ()
) shell_pairs; ) shell_pairs;
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 _ ->
(*
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 n = Array.length shell_pairs in
let i_prev = ref 0 in let i_prev = ref 0 in
shell_pairs shell_pairs
|> Array.map (fun sp -> |> Array.map (fun sp -> Domainslib.Task.async pool (fun _ -> f sp) )
Domainslib.Task.async pool (fun _ -> f sp) )
|> Array.iteri (fun i task -> |> Array.iteri (fun i task ->
let i = ((10 * i+1)/n) in let i = ((10 * i+1)/n) in
if !i_prev <> i then ( if !i_prev <> i then (
i_prev := i; i_prev := i;
Printf.printf "%3d %%\n%!" (i*10) Printf.printf "%3d %%\n%!" (i*10) );
); ignore (Domainslib.Task.await pool task))
ignore (Domainslib.Task.await pool task) ) ;
) )
in in
Domainslib.Task.teardown_pool pool; Domainslib.Task.teardown_pool pool;