LCPQ/QCaml
10
1
Fork 0
mirror of https://gitlab.com/scemama/QCaml.git synced 2024-12-22 04:13:33 +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
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 ;

2
Basis/ERI.ml
View File

@ -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

43
Basis/KinInt.ml
View File

@ -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

2
Basis/NucInt.ml
View File

@ -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

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
|> 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

29
Basis/Overlap.ml
View File

@ -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

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
|> 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

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 *)
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

107
Utils/Zkey.ml
View File

@ -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 ", "