mirror of
https://gitlab.com/scemama/QCaml.git
synced 2024-06-26 15:12:05 +02:00
CLeaning Zkey
This commit is contained in:
parent
24d2eb7e47
commit
47a85dec71
|
|
@ -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 ;
|
||||
|
|
|
|||
|
|
@ -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
|
||||
|
|
|
|||
|
|
@ -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
|
||||
|
|
|
|||
|
|
@ -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
|
||||
|
|
|
|||
|
|
@ -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
|
||||
|
|
|
|||
|
|
@ -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
|
||||
|
|
|
|||
|
|
@ -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
|
||||
|
|
|
|||
|
|
@ -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
107
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 ", "
|
||||
|
|
|
|||
Loading…
Reference in New Issue
Block a user