LCPQ/QCaml
10
1
Fork 0
mirror of https://gitlab.com/scemama/QCaml.git synced 2024-11-19 04:22:21 +01:00
Code Releases Activity

CLeaning Zkey

Browse Source
This commit is contained in:
Anthony Scemama 2018-02-25 01:40:12 +01:00
parent 24d2eb7e47
commit 47a85dec71
9 changed files with 93 additions and 98 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

2
Basis/ContractedShell.ml
View File

@ -67,7 +67,7 @@ let make ~index ~expo ~coef ~center ~totAngMom =
in in
let norm_coef_scale = let norm_coef_scale =
Array.map (fun a -> 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 ) powers
in in
{ index ; expo ; coef ; center ; totAngMom ; size=Array.length expo ; norm_coef ; { index ; expo ; coef ; center ; totAngMom ; size=Array.length expo ; norm_coef ;

2
Basis/ERI.ml
View File

@ -78,7 +78,7 @@ let index i j k l =
let of_basis basis = let of_basis basis =
let to_powers x = let to_powers x =
let open Zkey in let open Zkey in
match to_powers Kind_3 x with match to_powers x with
| Three x -> x | Three x -> x
| _ -> assert false | _ -> assert false
in in

39
Basis/KinInt.ml
View File

@ -7,12 +7,19 @@ module Bs = Basis
module Co = Coordinate module Co = Coordinate
module Cs = ContractedShell module Cs = ContractedShell
module Csp = ContractedShellPair module Csp = ContractedShellPair
module Po = Powers
module Sp = ShellPair module Sp = ShellPair
type t = Mat.t type t = Mat.t
let cutoff = integrals_cutoff 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 *) (** Computes all the kinetic integrals of the contracted shell pair *)
let contracted_class shell_a shell_b : float Zmap.t = 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) sp.(ab).Sp.shell_b.expo.(j)
in in
Array.iteri (fun i key -> let xyz_of_int k =
let (angMomA,angMomB) = match k with
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 ov a b k =
let xyz = match k with
| 0 -> Co.X | 0 -> Co.X
| 1 -> Co.Y | 1 -> Co.Y
| _ -> Co.Z | _ -> Co.Z
in in
Array.iteri (fun i key ->
let (angMomA,angMomB) = to_powers key in
let ov a b k =
let xyz = xyz_of_int k in
Overlap_primitives.hvrr (a, b) Overlap_primitives.hvrr (a, b)
expo_inv expo_inv
(Co.get xyz center_ab, (Co.get xyz center_ab,
Co.get xyz center_pa) Co.get xyz center_pa)
in in
let f k = 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 = and g k =
let s1 = ov (angMomA.(k)-1) (angMomB.(k)-1) k let xyz = xyz_of_int k in
and s2 = ov (angMomA.(k)+1) (angMomB.(k)-1) k let s1 = ov (Po.get xyz angMomA - 1) (Po.get xyz angMomB - 1) k
and s3 = ov (angMomA.(k)-1) (angMomB.(k)+1) k and s2 = ov (Po.get xyz angMomA + 1) (Po.get xyz angMomB - 1) k
and s4 = ov (angMomA.(k)+1) (angMomB.(k)+1) k and s3 = ov (Po.get xyz angMomA - 1) (Po.get xyz angMomB + 1) k
and a = float_of_int angMomA.(k) and s4 = ov (Po.get xyz angMomA + 1) (Po.get xyz angMomB + 1) k
and b = float_of_int angMomB.(k) and a = float_of_int (Po.get xyz angMomA)
and b = float_of_int (Po.get xyz angMomB)
in in
0.5 *. a *. b *. s1 -. expo_a *. b *. s2 -. expo_b *. a *. s3 +. 0.5 *. a *. b *. s1 -. expo_a *. b *. s2 -. expo_b *. a *. s3 +.
2.0 *. expo_a *. expo_b *. s4 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 of_basis basis =
let to_powers x = let to_powers x =
let open Zkey in let open Zkey in
match to_powers Kind_3 x with match to_powers x with
| Three x -> x | Three x -> x
| _ -> assert false | _ -> assert false
in in

2
Basis/NucInt.ml
View File

@ -42,7 +42,7 @@ exception NullIntegral
let of_basis_nuclei basis nuclei = let of_basis_nuclei basis nuclei =
let to_powers x = let to_powers x =
let open Zkey in let open Zkey in
match to_powers Kind_3 x with match to_powers x with
| Three x -> x | Three x -> x
| _ -> assert false | _ -> assert false
in in

2
Basis/OneElectronRR.ml
View File

@ -167,7 +167,7 @@ let contracted_class_shell_pair ~zero_m shell_p geometry : float Zmap.t =
class_indices class_indices
|> Array.iteri (fun i key -> |> Array.iteri (fun i key ->
let (angMomA,angMomB) = let (angMomA,angMomB) =
match Zkey.to_powers ~kind:Zkey.Kind_6 key with match Zkey.to_powers key with
| Zkey.Six x -> x | Zkey.Six x -> x
| _ -> assert false | _ -> assert false
in in

29
Basis/Overlap.ml
View File

@ -9,10 +9,17 @@ module Bs = Basis
module Co = Coordinate module Co = Coordinate
module Cs = ContractedShell module Cs = ContractedShell
module Csp = ContractedShellPair module Csp = ContractedShellPair
module Po = Powers
module Sp = ShellPair module Sp = ShellPair
let cutoff = integrals_cutoff 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 *) (** Computes all the overlap integrals of the contracted shell pair *)
let contracted_class shell_a shell_b : float Zmap.t = 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 *) (* 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) for ab=0 to (Array.length sp - 1)
do do
let coef_prod = let coef_prod =
@ -57,18 +70,10 @@ let contracted_class shell_a shell_b : float Zmap.t =
in in
Array.iteri (fun i key -> Array.iteri (fun i key ->
let (angMomA,angMomB) = let (angMomA,angMomB) = to_powers key in
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 f k = let f k =
let xyz = match k with let xyz = xyz_of_int k in
| 0 -> Co.X Overlap_primitives.hvrr (Po.get xyz angMomA, Po.get xyz angMomB)
| 1 -> Co.Y
| _ -> Co.Z
in
Overlap_primitives.hvrr (angMomA.(k), angMomB.(k))
expo_inv expo_inv
(Co.get xyz center_ab, (Co.get xyz center_ab,
Co.get xyz center_pa) Co.get xyz center_pa)
@ -90,7 +95,7 @@ let contracted_class shell_a shell_b : float Zmap.t =
let of_basis basis = let of_basis basis =
let to_powers x = let to_powers x =
let open Zkey in let open Zkey in
match to_powers Kind_3 x with match to_powers x with
| Three x -> x | Three x -> x
| _ -> assert false | _ -> assert false
in in

2
Basis/TwoElectronRR.ml
View File

@ -355,7 +355,7 @@ let contracted_class_shell_pairs ~zero_m ?schwartz_p ?schwartz_q shell_p shell_q
class_indices class_indices
|> Array.iteri (fun i key -> |> Array.iteri (fun i key ->
let (angMom_a,angMom_b,angMom_c,angMom_d) = 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 | Zkey.Twelve x -> x
| _ -> assert false | _ -> assert false
in in

2
Basis/TwoElectronRRVectorized.ml
View File

@ -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 *) (* Compute the integral class from the primitive shell quartet *)
Array.iteri (fun i key -> Array.iteri (fun i key ->
let (angMom_a,angMom_b,angMom_c,angMom_d) = 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 | Zkey.Twelve x -> x
| _ -> assert false | _ -> assert false
in in

105
Utils/Zkey.ml
View File

@ -1,44 +1,28 @@
open Powers 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 = type t =
{ {
left : int ; mutable left : int ;
right : int ; mutable right : int ;
kind : int ;
} }
let of_int right = let of_int kind right =
{ left = 0 ; right } { left = 0 ; right ; kind }
let (<|) { left ; right } x = let (<|) z x =
{ left=right ; right=x } z.left <- z.right;
z.right <- x;
z
let (<<) { left ; right } x = let (<<) z x =
{ left ; right = (right lsl 10) lor x } z.right <- (z.right lsl 10) lor x ;
z
let (<+) { left ; right } x = let (<+) z x =
{ left ; right = (right lsl 15) lor x } z.right <- (z.right lsl 15) lor x ;
z
(** 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)
type kind = type kind =
@ -47,48 +31,44 @@ type kind =
| Nine of (Powers.t * Powers.t * Powers.t) | Nine of (Powers.t * Powers.t * Powers.t)
| Twelve of (Powers.t * 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 ; _ } = 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 ; _ } 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 ; _ } = { 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 <| g << h << i << j << k << l
let of_powers_nine { x=a ; y=b ; z=c ; _ } { x=d ; y=e ; z=f ; _ } let of_powers_nine { x=a ; y=b ; z=c ; _ } { x=d ; y=e ; z=f ; _ }
{ x=g ; y=h ; z=i ; _ } = { 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 <| g << h << i
let of_powers a = let of_powers a =
match a with match a with
| Three { x=a ; y=b ; z=c ; _ } -> of_int a <+ b <+ c | Three a -> of_powers_three a
| Six ({ x=a ; y=b ; z=c },{ x=d ; y=e ; z=f }) -> | Six (a,b) -> of_powers_six a b
of_int a << b << c << d << e << f | Twelve (a,b,c,d) -> of_powers_twelve a b c d
| 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 }) -> | Nine (a,b,c) -> of_powers_nine a b c
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
let mask10 = 0x3ff let mask10 = 0x3ff
and mask15 = 0x7fff and mask15 = 0x7fff
(** Transform the Zkey into an int array *) (** Transform the Zkey into an int array *)
let to_int_array ~kind { left ; right } = let to_int_array { left ; right ; kind } =
match kind with match kind with
| Kind_3 -> [| | 3 -> [|
mask15 land (right lsr 30) ; mask15 land (right lsr 30) ;
mask15 land (right lsr 15) ; mask15 land (right lsr 15) ;
mask15 land right mask15 land right
|] |]
| Kind_6 -> [| | 6 -> [|
mask10 land (right lsr 50) ; mask10 land (right lsr 50) ;
mask10 land (right lsr 40) ; mask10 land (right lsr 40) ;
mask10 land (right lsr 30) ; mask10 land (right lsr 30) ;
@ -97,7 +77,7 @@ let to_int_array ~kind { left ; right } =
mask10 land right mask10 land right
|] |]
| Kind_12 -> [| | 12 -> [|
mask10 land (left lsr 50) ; mask10 land (left lsr 50) ;
mask10 land (left lsr 40) ; mask10 land (left lsr 40) ;
mask10 land (left lsr 30) ; mask10 land (left lsr 30) ;
@ -112,7 +92,7 @@ let to_int_array ~kind { left ; right } =
mask10 land right mask10 land right
|] |]
| Kind_9 -> [| | 9 -> [|
mask10 land (left lsr 20) ; mask10 land (left lsr 20) ;
mask10 land (left lsr 10) ; mask10 land (left lsr 10) ;
mask10 land left ; mask10 land left ;
@ -123,19 +103,20 @@ let to_int_array ~kind { left ; right } =
mask10 land (right lsr 10) ; mask10 land (right lsr 10) ;
mask10 land right mask10 land right
|] |]
| _ -> invalid_arg (__FILE__^": to_int_array")
(** Transform the Zkey into an int tuple *) (** Transform the Zkey into an int tuple *)
let to_powers ~kind { left ; right } = let to_powers { left ; right ; kind } =
match kind with 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 30) ,
mask15 land (right lsr 15) , mask15 land (right lsr 15) ,
mask15 land right 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 50) ,
mask10 land (right lsr 40) , mask10 land (right lsr 40) ,
mask10 land (right lsr 30)), mask10 land (right lsr 30)),
@ -145,7 +126,7 @@ let to_powers ~kind { left ; right } =
mask10 land right ) 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 50) ,
mask10 land (left lsr 40) , mask10 land (left lsr 40) ,
mask10 land (left lsr 30)), mask10 land (left lsr 30)),
@ -163,7 +144,7 @@ let to_powers ~kind { left ; right } =
mask10 land 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 20) ,
mask10 land (left lsr 10) , mask10 land (left lsr 10) ,
mask10 land left ) , mask10 land left ) ,
@ -176,28 +157,30 @@ let to_powers ~kind { left ; right } =
mask10 land (right lsr 10) , mask10 land (right lsr 10) ,
mask10 land right ) mask10 land right )
) )
| _ -> invalid_arg (__FILE__^": to_powers")
let hash = Hashtbl.hash let hash = Hashtbl.hash
let equal let equal
{ right = r1 ; left = l1 } { right = r1 ; left = l1 ; kind = k1 }
{ right = r2 ; left = l2 } = { right = r2 ; left = l2 ; kind = k2 } =
r1 = r2 && l1 = l2 r1 = r2 && l1 = l2 && k1 = k2
let cmp let cmp
{ right = r1 ; left = l1 } { right = r1 ; left = l1 ; kind = k1 }
{ right = r2 ; left = l2 } = { right = r2 ; left = l2 ; kind = k2 } =
if k1 <> k2 then invalid_arg (__FILE__^": cmp");
if r1 < r2 then -1 if r1 < r2 then -1
else if r1 > r2 then 1 else if r1 > r2 then 1
else if l1 < l2 then -1 else if l1 < l2 then -1
else if l1 > l2 then 1 else if l1 > l2 then 1
else 0 else 0
let to_string ~kind { left ; right } = let to_string { left ; right ; kind } =
"< " ^ string_of_int left ^ string_of_int right ^ " | " ^ ( "< " ^ 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.map string_of_int
|> Array.to_list |> Array.to_list
|> String.concat ", " |> String.concat ", "