From 47a85dec7183b6a6b5969330691e67815f0a851f Mon Sep 17 00:00:00 2001 From: Anthony Scemama Date: Sun, 25 Feb 2018 01:40:12 +0100 Subject: [PATCH] CLeaning Zkey --- Basis/ContractedShell.ml | 2 +- Basis/ERI.ml | 2 +- Basis/KinInt.ml | 43 +++++++------ Basis/NucInt.ml | 2 +- Basis/OneElectronRR.ml | 2 +- Basis/Overlap.ml | 29 +++++---- Basis/TwoElectronRR.ml | 2 +- Basis/TwoElectronRRVectorized.ml | 2 +- Utils/Zkey.ml | 107 +++++++++++++------------------ 9 files changed, 93 insertions(+), 98 deletions(-) diff --git a/Basis/ContractedShell.ml b/Basis/ContractedShell.ml index 47ebe42..83b1dea 100644 --- a/Basis/ContractedShell.ml +++ b/Basis/ContractedShell.ml @@ -67,7 +67,7 @@ let make ~index ~expo ~coef ~center ~totAngMom = in let norm_coef_scale = Array.map (fun a -> - (norm_coef_func.(0) (Zkey.to_int_array ~kind:Zkey.Kind_3 a)) /. norm_coef.(0) + (norm_coef_func.(0) (Zkey.to_int_array a)) /. norm_coef.(0) ) powers in { index ; expo ; coef ; center ; totAngMom ; size=Array.length expo ; norm_coef ; diff --git a/Basis/ERI.ml b/Basis/ERI.ml index a731a74..ccae1b8 100644 --- a/Basis/ERI.ml +++ b/Basis/ERI.ml @@ -78,7 +78,7 @@ let index i j k l = let of_basis basis = let to_powers x = let open Zkey in - match to_powers Kind_3 x with + match to_powers x with | Three x -> x | _ -> assert false in diff --git a/Basis/KinInt.ml b/Basis/KinInt.ml index 76bea22..3105162 100644 --- a/Basis/KinInt.ml +++ b/Basis/KinInt.ml @@ -7,12 +7,19 @@ module Bs = Basis module Co = Coordinate module Cs = ContractedShell module Csp = ContractedShellPair +module Po = Powers module Sp = ShellPair type t = Mat.t let cutoff = integrals_cutoff +let to_powers x = + let open Zkey in + match to_powers x with + | Six x -> x + | _ -> assert false + (** Computes all the kinetic integrals of the contracted shell pair *) let contracted_class shell_a shell_b : float Zmap.t = @@ -62,32 +69,32 @@ let contracted_class shell_a shell_b : float Zmap.t = sp.(ab).Sp.shell_b.expo.(j) in + let xyz_of_int k = + match k with + | 0 -> Co.X + | 1 -> Co.Y + | _ -> Co.Z + in Array.iteri (fun i key -> - let (angMomA,angMomB) = - let a = Zkey.to_int_array Zkey.Kind_6 key in - ( [| a.(0) ; a.(1) ; a.(2) |], - [| a.(3) ; a.(4) ; a.(5) |] ) - in + let (angMomA,angMomB) = to_powers key in let ov a b k = - let xyz = match k with - | 0 -> Co.X - | 1 -> Co.Y - | _ -> Co.Z - in + let xyz = xyz_of_int k in Overlap_primitives.hvrr (a, b) expo_inv (Co.get xyz center_ab, Co.get xyz center_pa) in let f k = - ov angMomA.(k) angMomB.(k) k + let xyz = xyz_of_int k in + ov (Po.get xyz angMomA) (Po.get xyz angMomB) k and g k = - let s1 = ov (angMomA.(k)-1) (angMomB.(k)-1) k - and s2 = ov (angMomA.(k)+1) (angMomB.(k)-1) k - and s3 = ov (angMomA.(k)-1) (angMomB.(k)+1) k - and s4 = ov (angMomA.(k)+1) (angMomB.(k)+1) k - and a = float_of_int angMomA.(k) - and b = float_of_int angMomB.(k) + let xyz = xyz_of_int k in + let s1 = ov (Po.get xyz angMomA - 1) (Po.get xyz angMomB - 1) k + and s2 = ov (Po.get xyz angMomA + 1) (Po.get xyz angMomB - 1) k + and s3 = ov (Po.get xyz angMomA - 1) (Po.get xyz angMomB + 1) k + and s4 = ov (Po.get xyz angMomA + 1) (Po.get xyz angMomB + 1) k + and a = float_of_int (Po.get xyz angMomA) + and b = float_of_int (Po.get xyz angMomB) in 0.5 *. a *. b *. s1 -. expo_a *. b *. s2 -. expo_b *. a *. s3 +. 2.0 *. expo_a *. expo_b *. s4 @@ -116,7 +123,7 @@ let contracted_class shell_a shell_b : float Zmap.t = let of_basis basis = let to_powers x = let open Zkey in - match to_powers Kind_3 x with + match to_powers x with | Three x -> x | _ -> assert false in diff --git a/Basis/NucInt.ml b/Basis/NucInt.ml index 16af6ef..cf3d472 100644 --- a/Basis/NucInt.ml +++ b/Basis/NucInt.ml @@ -42,7 +42,7 @@ exception NullIntegral let of_basis_nuclei basis nuclei = let to_powers x = let open Zkey in - match to_powers Kind_3 x with + match to_powers x with | Three x -> x | _ -> assert false in diff --git a/Basis/OneElectronRR.ml b/Basis/OneElectronRR.ml index 03ac8e7..762242b 100644 --- a/Basis/OneElectronRR.ml +++ b/Basis/OneElectronRR.ml @@ -167,7 +167,7 @@ let contracted_class_shell_pair ~zero_m shell_p geometry : float Zmap.t = class_indices |> Array.iteri (fun i key -> let (angMomA,angMomB) = - match Zkey.to_powers ~kind:Zkey.Kind_6 key with + match Zkey.to_powers key with | Zkey.Six x -> x | _ -> assert false in diff --git a/Basis/Overlap.ml b/Basis/Overlap.ml index e9ea239..bced594 100644 --- a/Basis/Overlap.ml +++ b/Basis/Overlap.ml @@ -9,10 +9,17 @@ module Bs = Basis module Co = Coordinate module Cs = ContractedShell module Csp = ContractedShellPair +module Po = Powers module Sp = ShellPair let cutoff = integrals_cutoff +let to_powers x = + let open Zkey in + match to_powers x with + | Six x -> x + | _ -> assert false + (** Computes all the overlap integrals of the contracted shell pair *) let contracted_class shell_a shell_b : float Zmap.t = @@ -41,6 +48,12 @@ let contracted_class shell_a shell_b : float Zmap.t = (* Compute all integrals in the shell for each pair of significant shell pairs *) + let xyz_of_int k = + match k with + | 0 -> Co.X + | 1 -> Co.Y + | _ -> Co.Z + in for ab=0 to (Array.length sp - 1) do let coef_prod = @@ -57,18 +70,10 @@ let contracted_class shell_a shell_b : float Zmap.t = in Array.iteri (fun i key -> - let (angMomA,angMomB) = - let a = Zkey.to_int_array Zkey.Kind_6 key in - ( [| a.(0) ; a.(1) ; a.(2) |], - [| a.(3) ; a.(4) ; a.(5) |] ) - in + let (angMomA,angMomB) = to_powers key in let f k = - let xyz = match k with - | 0 -> Co.X - | 1 -> Co.Y - | _ -> Co.Z - in - Overlap_primitives.hvrr (angMomA.(k), angMomB.(k)) + let xyz = xyz_of_int k in + Overlap_primitives.hvrr (Po.get xyz angMomA, Po.get xyz angMomB) expo_inv (Co.get xyz center_ab, Co.get xyz center_pa) @@ -90,7 +95,7 @@ let contracted_class shell_a shell_b : float Zmap.t = let of_basis basis = let to_powers x = let open Zkey in - match to_powers Kind_3 x with + match to_powers x with | Three x -> x | _ -> assert false in diff --git a/Basis/TwoElectronRR.ml b/Basis/TwoElectronRR.ml index 99c48bd..68e95b4 100644 --- a/Basis/TwoElectronRR.ml +++ b/Basis/TwoElectronRR.ml @@ -355,7 +355,7 @@ let contracted_class_shell_pairs ~zero_m ?schwartz_p ?schwartz_q shell_p shell_q class_indices |> Array.iteri (fun i key -> let (angMom_a,angMom_b,angMom_c,angMom_d) = - match Zkey.to_powers ~kind:Zkey.Kind_12 key with + match Zkey.to_powers key with | Zkey.Twelve x -> x | _ -> assert false in diff --git a/Basis/TwoElectronRRVectorized.ml b/Basis/TwoElectronRRVectorized.ml index 3e40d37..7bb64f3 100644 --- a/Basis/TwoElectronRRVectorized.ml +++ b/Basis/TwoElectronRRVectorized.ml @@ -803,7 +803,7 @@ let contracted_class_shell_pairs ~zero_m ?schwartz_p ?schwartz_q shell_p shell_q (* Compute the integral class from the primitive shell quartet *) Array.iteri (fun i key -> let (angMom_a,angMom_b,angMom_c,angMom_d) = - match Zkey.to_powers ~kind:Zkey.Kind_12 key with + match Zkey.to_powers key with | Zkey.Twelve x -> x | _ -> assert false in diff --git a/Utils/Zkey.ml b/Utils/Zkey.ml index 5e0c66e..987a011 100644 --- a/Utils/Zkey.ml +++ b/Utils/Zkey.ml @@ -1,44 +1,28 @@ open Powers -(** Key for hastables that contain tuples of integers encoded in small integers *) -type kind_array = -| Kind_3 -| Kind_6 -| Kind_12 -| Kind_9 - type t = { - left : int ; - right : int ; + mutable left : int ; + mutable right : int ; + kind : int ; } -let of_int right = - { left = 0 ; right } +let of_int kind right = + { left = 0 ; right ; kind } -let (<|) { left ; right } x = - { left=right ; right=x } +let (<|) z x = + z.left <- z.right; + z.right <- x; + z -let (<<) { left ; right } x = - { left ; right = (right lsl 10) lor x } +let (<<) z x = + z.right <- (z.right lsl 10) lor x ; + z -let (<+) { left ; right } x = - { left ; right = (right lsl 15) lor x } - - -(** Build a Zkey from an array or 1, 2, 3, 4, 6, 9, or 12 integers *) -let of_int_array ~kind a = - - match kind with - | Kind_3 -> of_int a.(0) <+ a.(1) <+ a.(2) - | Kind_6 -> of_int a.(0) << a.(1) << a.(2) << a.(3) << a.(4) << a.(5) - | Kind_12 -> - of_int a.(0) << a.(1) << a.(2) << a.(3) << a.(4) << a.(5) - <| a.(6) << a.(7) << a.(8) << a.(9) << a.(10) << a.(11) - | Kind_9 -> - of_int a.(0) << a.(1) << a.(2) << a.(3) << a.(4) << a.(5) - <| a.(6) << a.(7) << a.(8) +let (<+) z x = + z.right <- (z.right lsl 15) lor x ; + z type kind = @@ -47,48 +31,44 @@ type kind = | Nine of (Powers.t * Powers.t * Powers.t) | Twelve of (Powers.t * Powers.t * Powers.t * Powers.t) -let of_powers_three { x=a ; y=b ; z=c ; _ } = of_int a <+ b <+ c +let of_powers_three { x=a ; y=b ; z=c ; _ } = of_int 3 a <+ b <+ c let of_powers_six { x=a ; y=b ; z=c ; _ } { x=d ; y=e ; z=f ; _ } = - of_int a << b << c << d << e << f + of_int 6 a << b << c << d << e << f let of_powers_twelve { x=a ; y=b ; z=c ; _ } { x=d ; y=e ; z=f ; _ } { x=g ; y=h ; z=i ; _ } { x=j ; y=k ; z=l ; _ } = - of_int a << b << c << d << e << f + of_int 12 a << b << c << d << e << f <| g << h << i << j << k << l let of_powers_nine { x=a ; y=b ; z=c ; _ } { x=d ; y=e ; z=f ; _ } { x=g ; y=h ; z=i ; _ } = - of_int a << b << c << d << e << f + of_int 9 a << b << c << d << e << f <| g << h << i let of_powers a = match a with - | Three { x=a ; y=b ; z=c ; _ } -> of_int a <+ b <+ c - | Six ({ x=a ; y=b ; z=c },{ x=d ; y=e ; z=f }) -> - of_int a << b << c << d << e << f - | Twelve ({ x=a ; y=b ; z=c },{ x=d ; y=e ; z=f },{ x=g ; y=h ; z=i },{ x=j ; y=k ; z=l }) -> - of_int a << b << c << d << e << f - <| g << h << i << j << k << l - | Nine ({ x=a ; y=b ; z=c },{ x=d ; y=e ; z=f },{ x=g ; y=h ; z=i }) -> - of_int a << b << c << d << e << f - <| g << h << i + | Three a -> of_powers_three a + | Six (a,b) -> of_powers_six a b + | Twelve (a,b,c,d) -> of_powers_twelve a b c d + | Nine (a,b,c) -> of_powers_nine a b c let mask10 = 0x3ff and mask15 = 0x7fff + (** Transform the Zkey into an int array *) -let to_int_array ~kind { left ; right } = +let to_int_array { left ; right ; kind } = match kind with - | Kind_3 -> [| + | 3 -> [| mask15 land (right lsr 30) ; mask15 land (right lsr 15) ; mask15 land right |] - | Kind_6 -> [| + | 6 -> [| mask10 land (right lsr 50) ; mask10 land (right lsr 40) ; mask10 land (right lsr 30) ; @@ -97,7 +77,7 @@ let to_int_array ~kind { left ; right } = mask10 land right |] - | Kind_12 -> [| + | 12 -> [| mask10 land (left lsr 50) ; mask10 land (left lsr 40) ; mask10 land (left lsr 30) ; @@ -112,7 +92,7 @@ let to_int_array ~kind { left ; right } = mask10 land right |] - | Kind_9 -> [| + | 9 -> [| mask10 land (left lsr 20) ; mask10 land (left lsr 10) ; mask10 land left ; @@ -123,29 +103,30 @@ let to_int_array ~kind { left ; right } = mask10 land (right lsr 10) ; mask10 land right |] + | _ -> invalid_arg (__FILE__^": to_int_array") (** Transform the Zkey into an int tuple *) -let to_powers ~kind { left ; right } = +let to_powers { left ; right ; kind } = match kind with - | Kind_3 -> Three (Powers.of_int_tuple ( + | 3 -> Three (Powers.of_int_tuple ( mask15 land (right lsr 30) , mask15 land (right lsr 15) , mask15 land right )) - | Kind_6 -> Six (Powers.of_int_tuple + | 6 -> Six (Powers.of_int_tuple ( mask10 land (right lsr 50) , mask10 land (right lsr 40) , mask10 land (right lsr 30)), - Powers.of_int_tuple + Powers.of_int_tuple ( mask10 land (right lsr 20) , mask10 land (right lsr 10) , mask10 land right ) ) - | Kind_12 -> Twelve (Powers.of_int_tuple + | 12 -> Twelve (Powers.of_int_tuple ( mask10 land (left lsr 50) , mask10 land (left lsr 40) , mask10 land (left lsr 30)), @@ -163,7 +144,7 @@ let to_powers ~kind { left ; right } = mask10 land right ) ) - | Kind_9 -> Nine (Powers.of_int_tuple + | 9 -> Nine (Powers.of_int_tuple ( mask10 land (left lsr 20) , mask10 land (left lsr 10) , mask10 land left ) , @@ -176,28 +157,30 @@ let to_powers ~kind { left ; right } = mask10 land (right lsr 10) , mask10 land right ) ) + | _ -> invalid_arg (__FILE__^": to_powers") let hash = Hashtbl.hash let equal - { right = r1 ; left = l1 } - { right = r2 ; left = l2 } = - r1 = r2 && l1 = l2 + { right = r1 ; left = l1 ; kind = k1 } + { right = r2 ; left = l2 ; kind = k2 } = + r1 = r2 && l1 = l2 && k1 = k2 let cmp - { right = r1 ; left = l1 } - { right = r2 ; left = l2 } = + { right = r1 ; left = l1 ; kind = k1 } + { right = r2 ; left = l2 ; kind = k2 } = + if k1 <> k2 then invalid_arg (__FILE__^": cmp"); if r1 < r2 then -1 else if r1 > r2 then 1 else if l1 < l2 then -1 else if l1 > l2 then 1 else 0 -let to_string ~kind { left ; right } = +let to_string { left ; right ; kind } = "< " ^ string_of_int left ^ string_of_int right ^ " | " ^ ( - to_int_array kind { left ; right } + to_int_array { left ; right ; kind } |> Array.map string_of_int |> Array.to_list |> String.concat ", "