10
1
mirror of https://gitlab.com/scemama/QCaml.git synced 2024-11-18 12:03:40 +01:00

Fixed norm inefficiency

This commit is contained in:
Anthony Scemama 2018-02-01 17:13:47 +01:00
parent f3d03cd424
commit a586ccc434
5 changed files with 48 additions and 37 deletions

View File

@ -7,7 +7,7 @@ type t = {
totAngMom : Angular_momentum.t; totAngMom : Angular_momentum.t;
size : int; size : int;
norm_coef : float array; norm_coef : float array;
norm_coef_scale : float Zmap.t; norm_coef_scale : float array;
indice : int; indice : int;
powers : Zkey.t array; powers : Zkey.t array;
} }
@ -83,9 +83,10 @@ let create ~indice ~expo ~coef ~center ~totAngMom =
Array.map (fun f -> f [| Angular_momentum.to_int totAngMom ; 0 ; 0 |]) norm_coef_func Array.map (fun f -> f [| Angular_momentum.to_int totAngMom ; 0 ; 0 |]) norm_coef_func
in in
let norm_coef_scale = let norm_coef_scale =
Zmap.create 13 Array.map (fun a ->
(norm_coef_func.(0) (Zkey.to_int_array ~kind:Zkey.Kind_3 a)) /. norm_coef.(0)
) powers
in in
Array.iter (fun a -> Zmap.add norm_coef_scale a ((norm_coef_func.(0) (Zkey.to_int_array ~kind:Zkey.Kind_3 a)) /. norm_coef.(0))) powers;
{ indice ; expo ; coef ; center ; totAngMom ; size=Array.length expo ; norm_coef ; { indice ; expo ; coef ; center ; totAngMom ; size=Array.length expo ; norm_coef ;
norm_coef_scale ; powers } norm_coef_scale ; powers }

View File

@ -93,6 +93,7 @@ let to_file ~filename basis =
let let
shell_p = shell_pairs.(i).(j) shell_p = shell_pairs.(i).(j)
in in
for k=0 to i do for k=0 to i do
for l=0 to k do for l=0 to k do
let schwartz_q, schwartz_q_max = schwartz.(k).(l) in let schwartz_q, schwartz_q_max = schwartz.(k).(l) in
@ -102,6 +103,7 @@ let to_file ~filename basis =
let let
shell_q = shell_pairs.(k).(l) shell_q = shell_pairs.(k).(l)
in in
let swap = let swap =
Array.length shell_q < Array.length shell_p Array.length shell_q < Array.length shell_p
in in
@ -144,6 +146,9 @@ let to_file ~filename basis =
in in
if (abs_float value > cutoff) then if (abs_float value > cutoff) then
(inn := !inn + 1; (inn := !inn + 1;
(*
assert ((i_c, k_c, j_c, l_c) <> (-1,0,0,0));
*)
Printf.fprintf oc "%4d %4d %4d %4d %20.12e\n" Printf.fprintf oc "%4d %4d %4d %4d %20.12e\n"
i_c k_c j_c l_c value i_c k_c j_c l_c value
) )

View File

@ -9,7 +9,7 @@ type t = {
norm_sq : float; norm_sq : float;
norm_coef: float; norm_coef: float;
coef : float; coef : float;
norm_fun : int array -> int array -> float; norm_coef_scale : float array;
i : int; i : int;
j : int; j : int;
shell_a : Contracted_shell.t; shell_a : Contracted_shell.t;
@ -36,16 +36,12 @@ let create_array ?cutoff p_a p_b =
and norm_coef_scale_b = and norm_coef_scale_b =
Contracted_shell.norm_coef_scale p_b Contracted_shell.norm_coef_scale p_b
in in
let norm_fun a b = let norm_coef_scale =
let k1, k2 = Array.map (fun v1 ->
Zkey.of_int_array a ~kind:Kind_3, Array.map (fun v2 -> v1 *. v2) norm_coef_scale_b
Zkey.of_int_array b ~kind:Kind_3 ) norm_coef_scale_a
in |> Array.to_list
let v1 = |> Array.concat
Zmap.find norm_coef_scale_a k1
and v2 =
Zmap.find norm_coef_scale_b k2
in v1 *. v2
in in
Array.init (Contracted_shell.size p_a) (fun i -> Array.init (Contracted_shell.size p_a) (fun i ->
let p_a_expo_center = Coordinate.( let p_a_expo_center = Coordinate.(
@ -89,7 +85,7 @@ let create_array ?cutoff p_a p_b =
let center_a = let center_a =
Coordinate.(center |- Contracted_shell.center p_a) Coordinate.(center |- Contracted_shell.center p_a)
in in
Some { i ; j ; shell_a=p_a ; shell_b=p_b ; norm_coef ; norm_fun ; coef ; expo ; expo_inv ; center ; center_a ; center_ab ; norm_sq } Some { i ; j ; shell_a=p_a ; shell_b=p_b ; norm_coef ; coef ; expo ; expo_inv ; center ; center_a ; center_ab ; norm_sq ; norm_coef_scale }
with with
| Null_contribution -> None | Null_contribution -> None
) )

View File

@ -280,6 +280,7 @@ let contracted_class_shell_pairs ~zero_m ?schwartz_p ?schwartz_q shell_p shell_q
for ab=0 to (Array.length shell_p - 1) do for ab=0 to (Array.length shell_p - 1) do
let cab = shell_p.(ab).Shell_pair.coef in let cab = shell_p.(ab).Shell_pair.coef in
let b = shell_p.(ab).Shell_pair.j in let b = shell_p.(ab).Shell_pair.j in
let norm_coef_scale_p = shell_p.(ab).Shell_pair.norm_coef_scale in
for cd=0 to (Array.length shell_q - 1) do for cd=0 to (Array.length shell_q - 1) do
let coef_prod = let coef_prod =
cab *. shell_q.(cd).Shell_pair.coef cab *. shell_q.(cd).Shell_pair.coef
@ -313,6 +314,14 @@ let contracted_class_shell_pairs ~zero_m ?schwartz_p ?schwartz_q shell_p shell_q
| _ -> | _ ->
let d = shell_q.(cd).Shell_pair.j in let d = shell_q.(cd).Shell_pair.j in
let map = Zmap.create (Array.length class_indices) in let map = Zmap.create (Array.length class_indices) in
let norm_coef_scale_q = shell_q.(cd).Shell_pair.norm_coef_scale in
let norm_coef_scale =
Array.map (fun v1 ->
Array.map (fun v2 -> v1 *. v2) norm_coef_scale_q
) norm_coef_scale_p
|> Array.to_list
|> Array.concat
in
(* Compute the integral class from the primitive shell quartet *) (* Compute the integral class from the primitive shell quartet *)
class_indices class_indices
|> Array.iteri (fun i key -> |> Array.iteri (fun i key ->
@ -355,9 +364,7 @@ let contracted_class_shell_pairs ~zero_m ?schwartz_p ?schwartz_q shell_p shell_q
*) *)
let norm = let norm = norm_coef_scale.(i) in
shell_p.(ab).Shell_pair.norm_fun angMomA angMomB *. shell_q.(cd).Shell_pair.norm_fun angMomC angMomD
in
let integral = chop norm (fun () -> let integral = chop norm (fun () ->
hvrr_two_e (angMomA, angMomB, angMomC, angMomD) hvrr_two_e (angMomA, angMomB, angMomC, angMomD)
(Contracted_shell.totAngMom shell_a, Contracted_shell.totAngMom shell_b, (Contracted_shell.totAngMom shell_a, Contracted_shell.totAngMom shell_b,

View File

@ -328,9 +328,10 @@ let contracted_class_shell_pairs ~zero_m ?schwartz_p ?schwartz_q shell_p shell_q
| _ -> | _ ->
Array.iter (fun shell_ab -> Array.iter (fun shell_ab ->
let norm_coef_scale_p = shell_ab.Shell_pair.norm_coef_scale in
let b = shell_ab.Shell_pair.j in let b = shell_ab.Shell_pair.j in
let common = let common =
Array.mapi (fun idx shell_cd -> Array.map (fun shell_cd ->
let coef_prod = let coef_prod =
shell_ab.Shell_pair.coef *. shell_cd.Shell_pair.coef shell_ab.Shell_pair.coef *. shell_cd.Shell_pair.coef
in in
@ -352,30 +353,36 @@ let contracted_class_shell_pairs ~zero_m ?schwartz_p ?schwartz_q shell_p shell_q
(zero_m_array, shell_cd.Shell_pair.expo_inv, (zero_m_array, shell_cd.Shell_pair.expo_inv,
Contracted_shell.expo shell_d d, shell_cd.Shell_pair.center_ab, Contracted_shell.expo shell_d d, shell_cd.Shell_pair.center_ab,
center_pq,coef_prod,idx) center_pq,coef_prod)
) shell_q ) shell_q
|> Array.to_list |> Array.to_list
|> List.filter (fun (zero_m_array, expo_inv, d, center_cd, |> List.filter (fun (zero_m_array, expo_inv, d, center_cd,
center_pq,coef_prod,idx) -> abs_float coef_prod >= 1.e-4 *. cutoff) center_pq,coef_prod) -> abs_float coef_prod >= 1.e-4 *. cutoff)
|> Array.of_list |> Array.of_list
in in
let zero_m_array = Array.map (fun (zero_m_array, expo_inv, d, center_cd, let zero_m_array = Array.map (fun (zero_m_array, expo_inv, d, center_cd,
center_pq,coef_prod,idx) -> zero_m_array) common center_pq,coef_prod) -> zero_m_array) common
and expo_inv = Array.map (fun (zero_m_array, expo_inv, d, center_cd, and expo_inv = Array.map (fun (zero_m_array, expo_inv, d, center_cd,
center_pq,coef_prod,idx) -> expo_inv ) common center_pq,coef_prod) -> expo_inv ) common
and d = Array.map (fun (zero_m_array, expo_inv, d, center_cd, and d = Array.map (fun (zero_m_array, expo_inv, d, center_cd,
center_pq,coef_prod,idx) -> d) common center_pq,coef_prod) -> d) common
and center_cd = Array.map (fun (zero_m_array, expo_inv, d, center_cd, and center_cd = Array.map (fun (zero_m_array, expo_inv, d, center_cd,
center_pq,coef_prod,idx) -> center_cd) common center_pq,coef_prod) -> center_cd) common
and center_pq = Array.map (fun (zero_m_array, expo_inv, d, center_cd, and center_pq = Array.map (fun (zero_m_array, expo_inv, d, center_cd,
center_pq,coef_prod,idx) -> center_pq) common center_pq,coef_prod) -> center_pq) common
and coef_prod = Array.map (fun (zero_m_array, expo_inv, d, center_cd, and coef_prod = Array.map (fun (zero_m_array, expo_inv, d, center_cd,
center_pq,coef_prod,idx) -> coef_prod) common center_pq,coef_prod) -> coef_prod) common
and idx = Array.map (fun (zero_m_array, expo_inv, d, center_cd,
center_pq,coef_prod,idx) -> idx) common
in in
(* Compute the integral class from the primitive shell quartet *) (* Compute the integral class from the primitive shell quartet *)
let map = Array.init maxm (fun _ -> Zmap.create (Array.length class_indices)) in let map = Array.init maxm (fun _ -> Zmap.create (Array.length class_indices)) in
let norm =
let norm_coef_scale_q = shell_q.(0).Shell_pair.norm_coef_scale in
Array.map (fun v1 ->
Array.map (fun v2 -> v1 *. v2) norm_coef_scale_q
) norm_coef_scale_p
|> Array.to_list
|> Array.concat
in
Array.iteri (fun i key -> Array.iteri (fun i key ->
let a = Zkey.to_int_array Zkey.Kind_12 key in let a = Zkey.to_int_array Zkey.Kind_12 key in
let (angMomA,angMomB,angMomC,angMomD) = let (angMomA,angMomB,angMomC,angMomD) =
@ -384,11 +391,6 @@ let contracted_class_shell_pairs ~zero_m ?schwartz_p ?schwartz_q shell_p shell_q
[| a.(6) ; a.(7) ; a.(8) |], [| a.(6) ; a.(7) ; a.(8) |],
[| a.(9) ; a.(10) ; a.(11) |] ) [| a.(9) ; a.(10) ; a.(11) |] )
in in
let norm =
Array.map (fun shell_cd ->
shell_ab.Shell_pair.norm_fun angMomA angMomB *. shell_cd.Shell_pair.norm_fun angMomC angMomD
) shell_q
in
let integral = let integral =
hvrr_two_e_vector (angMomA, angMomB, angMomC, angMomD) hvrr_two_e_vector (angMomA, angMomB, angMomC, angMomD)
(Contracted_shell.totAngMom shell_a, Contracted_shell.totAngMom shell_b, (Contracted_shell.totAngMom shell_a, Contracted_shell.totAngMom shell_b,
@ -398,7 +400,7 @@ let contracted_class_shell_pairs ~zero_m ?schwartz_p ?schwartz_q shell_p shell_q
(shell_ab.Shell_pair.expo_inv, expo_inv) (shell_ab.Shell_pair.expo_inv, expo_inv)
(shell_ab.Shell_pair.center_ab, center_cd, center_pq) (shell_ab.Shell_pair.center_ab, center_cd, center_pq)
coef_prod map coef_prod map
|> Array.mapi (fun i x -> x *. norm.(idx.(i)) ) |> Array.map (fun x -> x *. norm.(i) )
in in
let x = Array.fold_left (+.) 0. integral in let x = Array.fold_left (+.) 0. integral in
contracted_class.(i) <- contracted_class.(i) +. x contracted_class.(i) <- contracted_class.(i) +. x