LCPQ/QCaml
10
1
Fork 0
mirror of https://gitlab.com/scemama/QCaml.git synced 2024-12-26 06:13:39 +01:00
Code Releases Activity

Merge lpqlx139:/home/scemama/QCaml

Browse Source
This commit is contained in:
Anthony Scemama 2018-03-21 22:57:14 +01:00
commit 69b1e10f00
27 changed files with 956 additions and 455 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

14
Basis/AtomicShell.ml
View File

@ -5,7 +5,7 @@ type t = {
expo : float array array; expo : float array array;
coef : float array array; coef : float array array;
center : Coordinate.t; center : Coordinate.t;
totAngMom : AngularMomentum.t; ang_mom : AngularMomentum.t;
norm_coef : float array array; norm_coef : float array array;
norm_coef_scale : float array; norm_coef_scale : float array;
index : int; index : int;
@ -32,10 +32,10 @@ let make ?(index=0) contr =
if not (unique_center (Array.length contr - 1)) then if not (unique_center (Array.length contr - 1)) then
invalid_arg "ContractedAtomicShell.make Coordinate.t differ"; invalid_arg "ContractedAtomicShell.make Coordinate.t differ";
let totAngMom = Cs.totAngMom contr.(0) in let ang_mom = Cs.ang_mom contr.(0) in
let rec unique_angmom = function let rec unique_angmom = function
| 0 -> true | 0 -> true
| i -> if Cs.totAngMom contr.(i) = totAngMom then unique_angmom (i-1) else false | i -> if Cs.ang_mom contr.(i) = ang_mom then unique_angmom (i-1) else false
in in
if not (unique_angmom (Array.length contr - 1)) then if not (unique_angmom (Array.length contr - 1)) then
invalid_arg "ContractedShell.make: AngularMomentum.t differ"; invalid_arg "ContractedShell.make: AngularMomentum.t differ";
@ -45,7 +45,7 @@ let make ?(index=0) contr =
in in
let norm_coef_scale = Cs.norm_scales contr.(0) let norm_coef_scale = Cs.norm_scales contr.(0)
in in
{ index ; expo ; coef ; center ; totAngMom ; norm_coef ; { index ; expo ; coef ; center ; ang_mom ; norm_coef ;
norm_coef_scale ; contr } norm_coef_scale ; contr }
@ -59,7 +59,7 @@ let coefficients x = x.coef
let center x = x.center let center x = x.center
let totAngMom x = x.totAngMom let ang_mom x = x.ang_mom
let size x = Array.length x.contr let size x = Array.length x.contr
@ -83,7 +83,7 @@ let pp_debug ppf x =
fprintf ppf "@[<2>expo =@ %a ;@]@ " pp_float_2darray_size x.expo; fprintf ppf "@[<2>expo =@ %a ;@]@ " pp_float_2darray_size x.expo;
fprintf ppf "@[<2>coef =@ %a ;@]@ " pp_float_2darray_size x.coef; fprintf ppf "@[<2>coef =@ %a ;@]@ " pp_float_2darray_size x.coef;
fprintf ppf "@[<2>center =@ %a ;@]@ " Co.pp_angstrom x.center; fprintf ppf "@[<2>center =@ %a ;@]@ " Co.pp_angstrom x.center;
fprintf ppf "@[<2>totAngMom =@ %a ;@]@ " Am.pp_string x.totAngMom; fprintf ppf "@[<2>ang_mom =@ %a ;@]@ " Am.pp_string x.ang_mom;
fprintf ppf "@[<2>norm_coef =@ %a ;@]@ " pp_float_2darray_size x.norm_coef; fprintf ppf "@[<2>norm_coef =@ %a ;@]@ " pp_float_2darray_size x.norm_coef;
fprintf ppf "@[<2>norm_coef_scale =@ %a ;@]@ " pp_float_array_size x.norm_coef_scale; fprintf ppf "@[<2>norm_coef_scale =@ %a ;@]@ " pp_float_array_size x.norm_coef_scale;
fprintf ppf "@[<2>index =@ %d ;@]@ " x.index; fprintf ppf "@[<2>index =@ %d ;@]@ " x.index;
@ -91,7 +91,7 @@ let pp_debug ppf x =
let pp ppf s = let pp ppf s =
fprintf ppf "@[%3d-%-3d@]" (s.index+1) (s.index+ (size_of_shell s)*(size s)); fprintf ppf "@[%3d-%-3d@]" (s.index+1) (s.index+ (size_of_shell s)*(size s));
fprintf ppf "@[%a@ %a@] @[" Am.pp_string s.totAngMom Co.pp s.center; fprintf ppf "@[%a@ %a@] @[" Am.pp_string s.ang_mom Co.pp s.center;
Array.iter2 (fun e_arr c_arr -> fprintf ppf "@[<v>"; Array.iter2 (fun e_arr c_arr -> fprintf ppf "@[<v>";
Array.iter2 (fun e c -> fprintf ppf "@[%16.8e %16.8e@]@;" e c) Array.iter2 (fun e c -> fprintf ppf "@[%16.8e %16.8e@]@;" e c)
e_arr c_arr; e_arr c_arr;

4
Basis/AtomicShell.mli
View File

@ -42,7 +42,7 @@ val index : t -> int
val center : t -> Coordinate.t val center : t -> Coordinate.t
(** Coordinate of the center {% $\mathbf{A} = (X_A,Y_A,Z_A)$ %}. *) (** Coordinate of the center {% $\mathbf{A} = (X_A,Y_A,Z_A)$ %}. *)
val totAngMom : t -> AngularMomentum.t val ang_mom : t -> AngularMomentum.t
(** Total angular momentum : {% $l = n_x + n_y + n_z$ %}. *) (** Total angular momentum : {% $l = n_x + n_y + n_z$ %}. *)
val size : t -> int val size : t -> int
@ -68,7 +68,7 @@ val normalizations : t -> float array array
val norm_scales : t -> float array val norm_scales : t -> float array
(** Scaling factors {% $f(n_x,n_y,n_z)$ %}, given in the same order as (** Scaling factors {% $f(n_x,n_y,n_z)$ %}, given in the same order as
[AngularMomentum.zkey_array totAngMom]. *) [AngularMomentum.zkey_array ang_mom]. *)
val size_of_shell : t -> int val size_of_shell : t -> int
(** Number of contracted functions in the shell: length of {!norm_coef_scale}. *) (** Number of contracted functions in the shell: length of {!norm_coef_scale}. *)

23
Basis/AtomicShellPair.ml
View File

@ -15,12 +15,11 @@ module Am = AngularMomentum
module As = AtomicShell module As = AtomicShell
module Co = Coordinate module Co = Coordinate
module Cs = ContractedShell module Cs = ContractedShell
module Ps = PrimitiveShell module Csp = ContractedShellPair
module Psp = PrimitiveShellPair
(** Creates an atomic shell pair : an array of pairs of contracted shells. (** Creates an atomic shell pair : an array of pairs of contracted shells.
*) *)
let make ?(cutoff=1.e-32) atomic_shell_a atomic_shell_b = let make ?(cutoff=Constants.epsilon) atomic_shell_a atomic_shell_b =
let l_a = Array.to_list (As.contracted_shells atomic_shell_a) let l_a = Array.to_list (As.contracted_shells atomic_shell_a)
and l_b = Array.to_list (As.contracted_shells atomic_shell_b) and l_b = Array.to_list (As.contracted_shells atomic_shell_b)
@ -32,27 +31,33 @@ let make ?(cutoff=1.e-32) atomic_shell_a atomic_shell_b =
Csp.make ~cutoff s_a s_b Csp.make ~cutoff s_a s_b
) l_b ) l_b
) l_a ) l_a
|> List.concat
|> List.filter (function None -> false | _ -> true)
|> List.map (function None -> assert false | Some x -> x)
in in
match contracted_shell_pairs with
| [] -> None
| _ -> Some { atomic_shell_a ; atomic_shell_b ; contracted_shell_pairs }
let atomic_shell_a x = x.atomic_shell_a let atomic_shell_a x = x.atomic_shell_a
let atomic_shell_b x = x.atomic_shell_b let atomic_shell_b x = x.atomic_shell_b
let contracted_shell_pairs = x.contracted_shell_pairs let contracted_shell_pairs x = x.contracted_shell_pairs
let monocentric x = Csp.monocentric @@ List.hd x.contracted_shell_pairs let monocentric x = Csp.monocentric @@ List.hd x.contracted_shell_pairs
let center_ab x = Csp.center_ab @@ List.hd x.contracted_shell_pairs let a_minus_b x = Csp.a_minus_b @@ List.hd x.contracted_shell_pairs
let totAngMon x = Csp.totAngMon @@ List.hd x.contracted_shell_pairs let a_minus_b_sq x = Csp.a_minus_b_sq @@ List.hd x.contracted_shell_pairs
let ang_mom x = Csp.ang_mom @@ List.hd x.contracted_shell_pairs
let norm_scales x = Csp.norm_scales @@ List.hd x.contracted_shell_pairs let norm_scales x = Csp.norm_scales @@ List.hd x.contracted_shell_pairs
let norm_sq x = Csp.norm_sq @@ List.hd x.contracted_shell_pairs
(** The array of all shell pairs with their correspondance in the list (** The array of all shell pairs with their correspondance in the list
of contracted shells. of contracted shells.
*) *)
let of_atomic_shell_array basis = let of_atomic_shell_array ?(cutoff=Constants.epsilon) basis =
Array.mapi (fun i shell_a -> Array.mapi (fun i shell_a ->
Array.mapi (fun j shell_b -> Array.mapi (fun j shell_b ->
make ~cutoff shell_a shell_b) make ~cutoff shell_a shell_b)

8
Basis/AtomicShellPair.mli
View File

@ -14,7 +14,7 @@ val make : ?cutoff:float -> AtomicShell.t -> AtomicShell.t -> t option
[None]. [None].
*) *)
val of_atomic_shell_array : AtomicShell.t array -> t option list val of_atomic_shell_array : ?cutoff:float -> AtomicShell.t array -> t option array array
(** Creates all possible atomic shell pairs from an array of atomic shells. (** Creates all possible atomic shell pairs from an array of atomic shells.
If an atomic shell pair is not significant, sets the value to [None]. If an atomic shell pair is not significant, sets the value to [None].
*) *)
@ -34,16 +34,16 @@ val contracted_shell_pairs : t -> ContractedShellPair.t list
contracted functions used to build the atomic shell pair. contracted functions used to build the atomic shell pair.
*) *)
val center_ab : t -> Coordinate.t val a_minus_b : t -> Coordinate.t
(* A-B *) (* A-B *)
val norm_sq : t -> float val a_minus_b_sq : t -> float
(* |A-B|^2 *) (* |A-B|^2 *)
val norm_scales : t -> float array val norm_scales : t -> float array
(* norm_coef.(i) / norm_coef.(0) *) (* norm_coef.(i) / norm_coef.(0) *)
val totAngMom : t -> AngularMomentum.t val ang_mom : t -> AngularMomentum.t
(* Total angular Momentum *) (* Total angular Momentum *)
val monocentric : t -> bool val monocentric : t -> bool

72
Basis/AtomicShellPairCouple.ml Normal file
View File

@ -0,0 +1,72 @@
type t =
{
atomic_shell_pair_p: AtomicShellPair.t ;
atomic_shell_pair_q: AtomicShellPair.t ;
atomic_shell_a : AtomicShell.t ;
atomic_shell_b : AtomicShell.t ;
atomic_shell_c : AtomicShell.t ;
atomic_shell_d : AtomicShell.t ;
ang_mom : AngularMomentum.t ;
contracted_shell_pair_couples : ContractedShellPairCouple.t list ;
}
module Am = AngularMomentum
module Co = Coordinate
module As = AtomicShell
module Asp = AtomicShellPair
module Cspc = ContractedShellPairCouple
let make ?(cutoff=Constants.epsilon) atomic_shell_pair_p atomic_shell_pair_q =
let ang_mom =
Am.(Asp.ang_mom atomic_shell_pair_p + Asp.ang_mom atomic_shell_pair_q)
in
let atomic_shell_a = Asp.atomic_shell_a atomic_shell_pair_p
and atomic_shell_b = Asp.atomic_shell_b atomic_shell_pair_p
and atomic_shell_c = Asp.atomic_shell_a atomic_shell_pair_q
and atomic_shell_d = Asp.atomic_shell_b atomic_shell_pair_q
in
let contracted_shell_pair_couples =
List.map (fun ap_ab ->
List.map (fun ap_cd ->
ContractedShellPairCouple.make ~cutoff ap_ab ap_cd
) (Asp.contracted_shell_pairs atomic_shell_pair_q)
) (Asp.contracted_shell_pairs atomic_shell_pair_p)
|> List.concat
|> List.filter (function None -> false | _ -> true)
|> List.map (function None -> assert false | Some x -> x)
in
match contracted_shell_pair_couples with
| [] -> None
| _ -> Some { atomic_shell_pair_p ; atomic_shell_pair_q ; ang_mom ;
atomic_shell_a ; atomic_shell_b ; atomic_shell_c ; atomic_shell_d ;
contracted_shell_pair_couples ;
}
let contracted_shell_pair_couples t = t.contracted_shell_pair_couples
let monocentric t =
Asp.monocentric t.atomic_shell_pair_p && Asp.monocentric t.atomic_shell_pair_q &&
As.center (Asp.atomic_shell_a t.atomic_shell_pair_p) = As.center (Asp.atomic_shell_a t.atomic_shell_pair_q)
let ang_mom t = t.ang_mom
let atomic_shell_pair_p t = t.atomic_shell_pair_p
let atomic_shell_pair_q t = t.atomic_shell_pair_q
let atomic_shell_a t = t.atomic_shell_a
let atomic_shell_b t = t.atomic_shell_b
let atomic_shell_c t = t.atomic_shell_c
let atomic_shell_d t = t.atomic_shell_d
let zkey_array t =
match t.contracted_shell_pair_couples with
| f::_ -> Cspc.zkey_array f
| _ -> invalid_arg "AtomicShellPairCouple.zkey_array"
let norm_scales t =
match t.contracted_shell_pair_couples with
| f::_ -> Cspc.norm_scales f
| _ -> invalid_arg "AtomicShellPairCouple.norm_scales"

61
Basis/AtomicShellPairCouple.mli Normal file
View File

@ -0,0 +1,61 @@
(** Data structure describing a couple of atomic shells pairs.
An atomic shell pair couple is the cartesian product between two sets of functions, one
set over electron one and one set over electron two. Both sets are atomic shell
pairs.
These are usually called {e shell quartets} in the literature, but we prefer to use
{e pair} for two functions with the same electron, and {e couple} for two functions
acting on different electrons, since they will be coupled by a two-electron operator.
*)
type t
val make : ?cutoff:float -> AtomicShellPair.t -> AtomicShellPair.t -> t option
(** Creates an atomic shell pair couple using two atomic shell pairs.
*)
val ang_mom : t -> AngularMomentum.t
(** Total angular momentum of the shell pair couple: sum of the angular momenta of
all the shells. *)
val atomic_shell_a : t -> AtomicShell.t
(** Returns the first atomic shell of the first shell pair. *)
val atomic_shell_b : t -> AtomicShell.t
(** Returns the second atomic shell of the first shell pair. *)
val atomic_shell_c : t -> AtomicShell.t
(** Returns the first atomic shell of the second shell pair. *)
val atomic_shell_d : t -> AtomicShell.t
(** Returns the second atomic shell of the second shell pair. *)
val atomic_shell_pair_p : t -> AtomicShellPair.t
(** Returns the first atomic shell pair that was used to build the shell pair. *)
val atomic_shell_pair_q : t -> AtomicShellPair.t
(** Returns the second atomic shell pair that was used to build the shell pair. *)
val monocentric : t -> bool
(** True if all four atomic shells have the same center. *)
val contracted_shell_pair_couples : t -> ContractedShellPairCouple.t list
(** Returns the list of significant contracted shell pair couples. *)
val zkey_array : t -> Zkey.t array
(** Returns the array of {!Zkey.t} relative to the four shells of the
shell pair couple.
*)
val norm_scales : t -> float array
(** Scaling factors of normalization coefficients inside the shell. The
ordering is the same as {!zkey_array}.
*)

10
Basis/Basis.ml
View File

@ -17,10 +17,10 @@ let of_nuclei_and_general_basis nucl bas =
let contracted_shells = let contracted_shells =
Array.map (fun (e, center) -> Array.map (fun (e, center) ->
List.assoc e bas List.assoc e bas
|> Array.map (fun (totAngMom, shell) -> |> Array.map (fun (ang_mom, shell) ->
let lc = let lc =
Array.map (fun Gb.{exponent ; coefficient} -> Array.map (fun Gb.{exponent ; coefficient} ->
coefficient, Ps.make totAngMom center exponent) shell coefficient, Ps.make ang_mom center exponent) shell
in in
let result = Cs.make ~index:!index_ lc in let result = Cs.make ~index:!index_ lc in
index_ := !index_ + Cs.size_of_shell result; index_ := !index_ + Cs.size_of_shell result;
@ -32,16 +32,16 @@ let of_nuclei_and_general_basis nucl bas =
in in
let atomic_shells = lazy( let atomic_shells = lazy(
let uniq_center_angmom = let uniq_center_angmom =
Array.map (fun x -> Cs.center x, Cs.totAngMom x) contracted_shells Array.map (fun x -> Cs.center x, Cs.ang_mom x) contracted_shells
|> Array.to_list |> Array.to_list
|> List.sort_uniq compare |> List.sort_uniq compare
in in
let csl = let csl =
Array.to_list contracted_shells Array.to_list contracted_shells
in in
List.map (fun (center, totAngMom) -> List.map (fun (center, ang_mom) ->
let a = let a =
List.filter (fun x -> Cs.center x = center && Cs.totAngMom x = totAngMom) csl List.filter (fun x -> Cs.center x = center && Cs.ang_mom x = ang_mom) csl
|> Array.of_list |> Array.of_list
in in
As.make ~index:(Cs.index a.(0)) a As.make ~index:(Cs.index a.(0)) a

16
Basis/ContractedShell.ml
View File

@ -5,7 +5,7 @@ type t = {
expo : float array; expo : float array;
coef : float array; coef : float array;
center : Coordinate.t; center : Coordinate.t;
totAngMom : AngularMomentum.t; ang_mom : AngularMomentum.t;
norm_coef : float array; norm_coef : float array;
norm_coef_scale : float array; norm_coef_scale : float array;
index : int; index : int;
@ -32,10 +32,10 @@ let make ?(index=0) lc =
if not (unique_center (Array.length prim - 1)) then if not (unique_center (Array.length prim - 1)) then
invalid_arg "ContractedShell.make Coordinate.t differ"; invalid_arg "ContractedShell.make Coordinate.t differ";
let totAngMom = Ps.totAngMom prim.(0) in let ang_mom = Ps.ang_mom prim.(0) in
let rec unique_angmom = function let rec unique_angmom = function
| 0 -> true | 0 -> true
| i -> if Ps.totAngMom prim.(i) = totAngMom then unique_angmom (i-1) else false | i -> if Ps.ang_mom prim.(i) = ang_mom then unique_angmom (i-1) else false
in in
if not (unique_angmom (Array.length prim - 1)) then if not (unique_angmom (Array.length prim - 1)) then
invalid_arg "ContractedShell.make: AngularMomentum.t differ"; invalid_arg "ContractedShell.make: AngularMomentum.t differ";
@ -47,7 +47,7 @@ let make ?(index=0) lc =
in in
let norm_coef_scale = Ps.norm_scales prim.(0) let norm_coef_scale = Ps.norm_scales prim.(0)
in in
{ index ; expo ; coef ; center ; totAngMom ; norm_coef ; { index ; expo ; coef ; center ; ang_mom ; norm_coef ;
norm_coef_scale ; prim } norm_coef_scale ; prim }
@ -61,7 +61,7 @@ let coefficients x = x.coef
let center x = x.center let center x = x.center
let totAngMom x = x.totAngMom let ang_mom x = x.ang_mom
let size x = Array.length x.prim let size x = Array.length x.prim
@ -85,18 +85,18 @@ let pp_debug ppf x =
fprintf ppf "@[<2>expo =@ %a ;@]@ " pp_float_array_size x.expo; fprintf ppf "@[<2>expo =@ %a ;@]@ " pp_float_array_size x.expo;
fprintf ppf "@[<2>coef =@ %a ;@]@ " pp_float_array_size x.coef; fprintf ppf "@[<2>coef =@ %a ;@]@ " pp_float_array_size x.coef;
fprintf ppf "@[<2>center =@ %a ;@]@ " Co.pp_angstrom x.center; fprintf ppf "@[<2>center =@ %a ;@]@ " Co.pp_angstrom x.center;
fprintf ppf "@[<2>totAngMom =@ %a ;@]@ " Am.pp_string x.totAngMom; fprintf ppf "@[<2>ang_mom =@ %a ;@]@ " Am.pp_string x.ang_mom;
fprintf ppf "@[<2>norm_coef =@ %a ;@]@ " pp_float_array_size x.norm_coef; fprintf ppf "@[<2>norm_coef =@ %a ;@]@ " pp_float_array_size x.norm_coef;
fprintf ppf "@[<2>norm_coef_scale =@ %a ;@]@ " pp_float_array_size x.norm_coef_scale; fprintf ppf "@[<2>norm_coef_scale =@ %a ;@]@ " pp_float_array_size x.norm_coef_scale;
fprintf ppf "@[<2>index =@ %d ;@]@ " x.index; fprintf ppf "@[<2>index =@ %d ;@]@ " x.index;
fprintf ppf "}@,@]" fprintf ppf "}@,@]"
let pp ppf s = let pp ppf s =
(match s.totAngMom with (match s.ang_mom with
| Am.S -> fprintf ppf "@[%3d@] " (s.index+1) | Am.S -> fprintf ppf "@[%3d@] " (s.index+1)
| _ -> fprintf ppf "@[%3d-%-3d@]" (s.index+1) (s.index+(Array.length s.norm_coef_scale)) | _ -> fprintf ppf "@[%3d-%-3d@]" (s.index+1) (s.index+(Array.length s.norm_coef_scale))
); );
fprintf ppf "@[%a@ %a@]@[" Am.pp_string s.totAngMom Co.pp s.center; fprintf ppf "@[%a@ %a@]@[" Am.pp_string s.ang_mom Co.pp s.center;
Array.iter2 (fun e c -> fprintf ppf "@[%16.8e %16.8e@]@;" e c) s.expo s.coef; Array.iter2 (fun e c -> fprintf ppf "@[%16.8e %16.8e@]@;" e c) s.expo s.coef;
fprintf ppf "@]" fprintf ppf "@]"

4
Basis/ContractedShell.mli
View File

@ -40,7 +40,7 @@ val index : t -> int
val center : t -> Coordinate.t val center : t -> Coordinate.t
(** Coordinate of the center {% $\mathbf{A} = (X_A,Y_A,Z_A)$ %}. *) (** Coordinate of the center {% $\mathbf{A} = (X_A,Y_A,Z_A)$ %}. *)
val totAngMom : t -> AngularMomentum.t val ang_mom : t -> AngularMomentum.t
(** Total angular momentum : {% $l = n_x + n_y + n_z$ %}. *) (** Total angular momentum : {% $l = n_x + n_y + n_z$ %}. *)
val size : t -> int val size : t -> int
@ -60,7 +60,7 @@ val normalizations : t -> float array
val norm_scales : t -> float array val norm_scales : t -> float array
(** Scaling factors {% $f(n_x,n_y,n_z)$ %}, given in the same order as (** Scaling factors {% $f(n_x,n_y,n_z)$ %}, given in the same order as
[AngularMomentum.zkey_array totAngMom]. *) [AngularMomentum.zkey_array ang_mom]. *)
val size_of_shell : t -> int val size_of_shell : t -> int
(** Number of contracted functions in the shell: length of {!norm_coef_scale}. *) (** Number of contracted functions in the shell: length of {!norm_coef_scale}. *)

37
Basis/ContractedShellPair.ml
View File

@ -21,7 +21,7 @@ module Psp = PrimitiveShellPair
A contracted shell with N functions combined with a contracted A contracted shell with N functions combined with a contracted
shell with M functions generates a NxM array of shell pairs. shell with M functions generates a NxM array of shell pairs.
*) *)
let make ?(cutoff=1.e-32) s_a s_b = let make ?(cutoff=Constants.epsilon) s_a s_b =
let make = Psp.create_make_of (Cs.primitives s_a).(0) (Cs.primitives s_b).(0) in let make = Psp.create_make_of (Cs.primitives s_a).(0) (Cs.primitives s_b).(0) in
@ -47,6 +47,7 @@ let make ?(cutoff=1.e-32) s_a s_b =
| coefs_and_shell_pairs -> Some { shell_a = s_a ; shell_b = s_b ; coefs_and_shell_pairs } | coefs_and_shell_pairs -> Some { shell_a = s_a ; shell_b = s_b ; coefs_and_shell_pairs }
let shell_a x = x.shell_a let shell_a x = x.shell_a
let shell_b x = x.shell_b let shell_b x = x.shell_b
let coefs_and_shell_pairs x = x.coefs_and_shell_pairs let coefs_and_shell_pairs x = x.coefs_and_shell_pairs
@ -63,20 +64,20 @@ let exponents_inv x =
List.map (fun (_,sp) -> Psp.exponent_inv sp) x.coefs_and_shell_pairs List.map (fun (_,sp) -> Psp.exponent_inv sp) x.coefs_and_shell_pairs
|> Array.of_list |> Array.of_list
let center_ab x = let a_minus_b x =
match x.coefs_and_shell_pairs with match x.coefs_and_shell_pairs with
| [] -> assert false | [] -> assert false
| (_,sp)::_ -> Psp.a_minus_b sp | (_,sp)::_ -> Psp.a_minus_b sp
let norm_sq x = let a_minus_b_sq x =
match x.coefs_and_shell_pairs with match x.coefs_and_shell_pairs with
| [] -> assert false | [] -> assert false
| (_,sp)::_ -> Psp.a_minus_b_sq sp | (_,sp)::_ -> Psp.a_minus_b_sq sp
let totAngMom x = let ang_mom x =
match x.coefs_and_shell_pairs with match x.coefs_and_shell_pairs with
| [] -> assert false | [] -> assert false
| (_,sp)::_ -> Psp.totAngMom sp | (_,sp)::_ -> Psp.ang_mom sp
let norm_scales x = let norm_scales x =
match x.coefs_and_shell_pairs with match x.coefs_and_shell_pairs with
@ -89,6 +90,7 @@ let monocentric x =
| (_,sp)::_ -> Psp.monocentric sp | (_,sp)::_ -> Psp.monocentric sp
(** Returns an integer characteristic of a contracted shell pair *) (** Returns an integer characteristic of a contracted shell pair *)
let hash a = let hash a =
Array.map Hashtbl.hash a Array.map Hashtbl.hash a
@ -117,10 +119,10 @@ let cmp a b =
(** The array of all shell pairs with their correspondance in the list (** The array of all shell pairs with their correspondance in the list
of contracted shells. of contracted shells.
*) *)
let of_contracted_shell_array basis = let of_contracted_shell_array ?(cutoff=Constants.epsilon) basis =
Array.mapi (fun i shell_a -> Array.mapi (fun i shell_a ->
Array.mapi (fun j shell_b -> Array.mapi (fun j shell_b ->
make shell_a shell_b) make ~cutoff shell_a shell_b)
(Array.sub basis 0 (i+1)) (Array.sub basis 0 (i+1))
) basis ) basis
@ -151,22 +153,9 @@ let unique sp =
aux [] sp aux [] sp
(** A map from a shell pair hash to the list of indices in the array let zkey_array x =
of shell pairs. Am.zkey_array (Am.Doublet
*) Cs.(ang_mom x.shell_a, ang_mom x.shell_b)
let indices sp = )
let map =
Hashtbl.create 129
in
Array.iteri (fun i s ->
Array.iteri (fun j shell_p ->
let key =
hash shell_p
in
Hashtbl.add map key (i,j); ) s
) sp;
map

13
Basis/ContractedShellPair.mli
View File

@ -26,7 +26,8 @@ val make : ?cutoff:float -> ContractedShell.t -> ContractedShell.t -> t option
[None]. [None].
*) *)
val of_contracted_shell_array : ContractedShell.t array -> t option array array
val of_contracted_shell_array : ?cutoff:float -> ContractedShell.t array -> t option array array
(** Creates all possible contracted shell pairs from a list of contracted shells. (** Creates all possible contracted shell pairs from a list of contracted shells.
If a shell pair is not significant, sets the value to [None]: If a shell pair is not significant, sets the value to [None]:
@ -60,21 +61,25 @@ val coefficients : t -> float array
val exponents_inv : t -> float array val exponents_inv : t -> float array
val center_ab : t -> Coordinate.t val a_minus_b : t -> Coordinate.t
(* A-B *) (* A-B *)
val norm_sq : t -> float val a_minus_b_sq : t -> float
(* |A-B|^2 *) (* |A-B|^2 *)
val norm_scales : t -> float array val norm_scales : t -> float array
(* normalizations.(i) / normalizations.(0) *) (* normalizations.(i) / normalizations.(0) *)
val totAngMom : t -> AngularMomentum.t val ang_mom : t -> AngularMomentum.t
(* Total angular Momentum *) (* Total angular Momentum *)
val monocentric : t -> bool val monocentric : t -> bool
(** If true, the two contracted shells have the same center. *) (** If true, the two contracted shells have the same center. *)
val zkey_array : t -> Zkey.t array
(** Returns the array of Zkeys associated with the contracted shell pair. *)
(* (*
val hash : t -> int array val hash : t -> int array
val cmp : t -> t -> int val cmp : t -> t -> int

75
Basis/ContractedShellPairCouple.ml Normal file
View File

@ -0,0 +1,75 @@
type t =
{
shell_pair_p: ContractedShellPair.t ;
shell_pair_q: ContractedShellPair.t ;
shell_a : ContractedShell.t ;
shell_b : ContractedShell.t ;
shell_c : ContractedShell.t ;
shell_d : ContractedShell.t ;
ang_mom : AngularMomentum.t ;
coefs_and_shell_pair_couples : (float * PrimitiveShellPairCouple.t) list ;
}
module Am = AngularMomentum
module Co = Coordinate
module Cs = ContractedShell
module Csp = ContractedShellPair
module Pspc = PrimitiveShellPairCouple
let make ?(cutoff=Constants.epsilon) shell_pair_p shell_pair_q =
let ang_mom =
Am.(Csp.ang_mom shell_pair_p + Csp.ang_mom shell_pair_q)
in
let shell_a = Csp.shell_a shell_pair_p
and shell_b = Csp.shell_b shell_pair_p
and shell_c = Csp.shell_a shell_pair_q
and shell_d = Csp.shell_b shell_pair_q
in
let cutoff = 1.e-3 *. cutoff in
let coefs_and_shell_pair_couples =
List.map (fun (c_ab, sp_ab) ->
List.map (fun (c_cd, sp_cd) ->
let coef_prod = c_ab *. c_cd in
if abs_float coef_prod < cutoff then None
else Some (coef_prod, Pspc.make sp_ab sp_cd)
) (Csp.coefs_and_shell_pairs shell_pair_q)
) (Csp.coefs_and_shell_pairs shell_pair_p)
|> List.concat
|> List.filter (function None -> false | _ -> true)
|> List.map (function None -> assert false | Some x -> x)
in
match coefs_and_shell_pair_couples with
| [] -> None
| _ -> Some { shell_pair_p ; shell_pair_q ; ang_mom ;
shell_a ; shell_b ; shell_c ; shell_d ;
coefs_and_shell_pair_couples ;
}
let coefs_and_shell_pair_couples t = t.coefs_and_shell_pair_couples
let monocentric t =
Csp.monocentric t.shell_pair_p && Csp.monocentric t.shell_pair_q &&
Cs.center (Csp.shell_a t.shell_pair_p) = Cs.center (Csp.shell_a t.shell_pair_q)
let ang_mom t = t.ang_mom
let shell_pair_p t = t.shell_pair_p
let shell_pair_q t = t.shell_pair_q
let shell_a t = t.shell_a
let shell_b t = t.shell_b
let shell_c t = t.shell_c
let shell_d t = t.shell_d
let zkey_array t =
match t.coefs_and_shell_pair_couples with
| (_,f)::_ -> Pspc.zkey_array f
| _ -> invalid_arg "ContractedShellPairCouple.zkey_array"
let norm_scales t =
match t.coefs_and_shell_pair_couples with
| (_,f)::_ -> Pspc.norm_scales f
| _ -> invalid_arg "ContractedShellPairCouple.norm_scales"

61
Basis/ContractedShellPairCouple.mli Normal file
View File

@ -0,0 +1,61 @@
(** Data structure describing a couple of contracted shells pairs.
A contracted shell pair couple is the cartesian product between two sets of functions, one
set over electron one and one set over electron two. Both sets are contracted shell
pairs.
These are usually called {e shell quartets} in the literature, but we prefer to use
{e pair} for two functions with the same electron, and {e couple} for two functions
acting on different electrons, since they will be coupled by a two-electron operator.
*)
type t
val make : ?cutoff:float -> ContractedShellPair.t -> ContractedShellPair.t -> t option
(** Creates a contracted shell pair couple using two contracted shell pairs.
*)
val ang_mom : t -> AngularMomentum.t
(** Total angular momentum of the shell pair couple: sum of the angular momenta of
all the shells. *)
val shell_a : t -> ContractedShell.t
(** Returns the first contracted shell of the first shell pair. *)
val shell_b : t -> ContractedShell.t
(** Returns the second contracted shell of the first shell pair. *)
val shell_c : t -> ContractedShell.t
(** Returns the first contracted shell of the second shell pair. *)
val shell_d : t -> ContractedShell.t
(** Returns the second contracted shell of the second shell pair. *)
val shell_pair_p : t -> ContractedShellPair.t
(** Returns the first contracted shell pair that was used to build the shell pair. *)
val shell_pair_q : t -> ContractedShellPair.t
(** Returns the second contracted shell pair that was used to build the shell pair. *)
val monocentric : t -> bool
(** True if all four contracted shells have the same center. *)
val coefs_and_shell_pair_couples : t -> (float * PrimitiveShellPairCouple.t) list
(** Returns the list of significant shell pair couples. *)
val zkey_array : t -> Zkey.t array
(** Returns the array of {!Zkey.t} relative to the four shells of the
shell pair couple.
*)
val norm_scales : t -> float array
(** Scaling factors of normalization coefficients inside the shell. The
ordering is the same as {!zkey_array}.
*)

14
Basis/ERI.ml
View File

@ -42,12 +42,12 @@ let zero_m ~maxm ~expo_pq_inv ~norm_pq_sq =
(** Compute all the integrals of a contracted class *) (** Compute all the integrals of a contracted class *)
let contracted_class_shell_pairs_vec ?schwartz_p ?schwartz_q shell_p shell_q : float Zmap.t =
TwoElectronRRVectorized.contracted_class_shell_pairs ~zero_m ?schwartz_p ?schwartz_q shell_p shell_q
let contracted_class_shell_pairs ?schwartz_p ?schwartz_q shell_p shell_q : float Zmap.t = let contracted_class_shell_pairs ?schwartz_p ?schwartz_q shell_p shell_q : float Zmap.t =
TwoElectronRR.contracted_class_shell_pairs ~zero_m ?schwartz_p ?schwartz_q shell_p shell_q TwoElectronRR.contracted_class_shell_pairs ~zero_m ?schwartz_p ?schwartz_q shell_p shell_q
let contracted_class_shell_pairs_vec ?schwartz_p ?schwartz_q shell_p shell_q : float Zmap.t =
TwoElectronRRVectorized.contracted_class_shell_pairs ~zero_m ?schwartz_p ?schwartz_q shell_p shell_q
let cutoff2 = cutoff *. cutoff let cutoff2 = cutoff *. cutoff
(* (*
@ -213,10 +213,10 @@ let of_basis basis =
) )
else else
out := !out + 1; out := !out + 1;
) Am.(zkey_array (Singlet (Cs.totAngMom shell.(l)))) ) Am.(zkey_array (Singlet (Cs.ang_mom shell.(l))))
) Am.(zkey_array (Singlet (Cs.totAngMom shell.(k)))) ) Am.(zkey_array (Singlet (Cs.ang_mom shell.(k))))
) Am.(zkey_array (Singlet (Cs.totAngMom shell.(j)))) ) Am.(zkey_array (Singlet (Cs.ang_mom shell.(j))))
) Am.(zkey_array (Singlet (Cs.totAngMom shell.(i)))) ) Am.(zkey_array (Singlet (Cs.ang_mom shell.(i))))
with NullIntegral -> () with NullIntegral -> ()
done; done;
done; done;

17
Basis/ERI_parallel.ml
View File

@ -59,19 +59,24 @@ let zero_m ~maxm ~expo_pq_inv ~norm_pq_sq =
result result
(** Compute all the integrals of a contracted class when shell pairs are not yet available *) (** Compute all the integrals of a contracted class *)
let contracted_class shell_a shell_b shell_c shell_d : float Zmap.t = let contracted_class_shell_pairs ?schwartz_p ?schwartz_q shell_p shell_q : float Zmap.t =
TwoElectronRR.contracted_class ~zero_m shell_a shell_b shell_c shell_d TwoElectronRR.contracted_class_shell_pairs ~zero_m ?schwartz_p ?schwartz_q shell_p shell_q
(** Compute all the integrals of a contracted class *) (** Compute all the integrals of a contracted class *)
let contracted_class_shell_pairs_vec ?schwartz_p ?schwartz_q shell_p shell_q : float Zmap.t = let contracted_class_shell_pairs_vec ?schwartz_p ?schwartz_q shell_p shell_q : float Zmap.t =
TwoElectronRRVectorized.contracted_class_shell_pairs ~zero_m ?schwartz_p ?schwartz_q shell_p shell_q TwoElectronRRVectorized.contracted_class_shell_pairs ~zero_m ?schwartz_p ?schwartz_q shell_p shell_q
(** Compute all the integrals of an atomic shell pair couple *)
let contracted_class_atomic_shell_pairs ?schwartz_p ?schwartz_q shell_p shell_q : float Zmap.t =
TwoElectronRR.contracted_class_atomic_shell_pairs ~zero_m ?schwartz_p ?schwartz_q shell_p shell_q
(** Compute all the integrals of a contracted class *) (** Compute all the integrals of a contracted class *)
let contracted_class_shell_pairs ?schwartz_p ?schwartz_q shell_p shell_q : float Zmap.t = let contracted_class_atomic_shell_pairs_vec ?schwartz_p ?schwartz_q shell_p shell_q : float Zmap.t =
TwoElectronRR.contracted_class_shell_pairs ~zero_m ?schwartz_p ?schwartz_q shell_p shell_q TwoElectronRR.contracted_class_atomic_shell_pairs ~zero_m ?schwartz_p ?schwartz_q shell_p shell_q
(** Creates the input data structure from the basis set. *) (** Creates the input data structure from the basis set. *)

14
Basis/KinInt.ml
View File

@ -28,9 +28,7 @@ let contracted_class shell_a shell_b : float Zmap.t =
| Some shell_p -> | Some shell_p ->
begin begin
(* Pre-computation of integral class indices *) (* Pre-computation of integral class indices *)
let class_indices = let class_indices = Csp.zkey_array shell_p in
Am.zkey_array (Am.Doublet Cs.(totAngMom shell_a, totAngMom shell_b))
in
let contracted_class = let contracted_class =
Array.make (Array.length class_indices) 0. Array.make (Array.length class_indices) 0.
@ -39,8 +37,8 @@ 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 sp = Csp.shell_pairs shell_p in let sp = Csp.shell_pairs shell_p in
let center_ab = let a_minus_b =
Csp.center_ab shell_p Csp.a_minus_b shell_p
in in
let norm_coef_scales = let norm_coef_scales =
Csp.norm_scales shell_p Csp.norm_scales shell_p
@ -78,7 +76,7 @@ let contracted_class shell_a shell_b : float Zmap.t =
let xyz = xyz_of_int k in 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 a_minus_b,
Co.get xyz center_pa) Co.get xyz center_pa)
in in
let f k = let f k =
@ -154,8 +152,8 @@ let of_basis basis =
in in
result.{i_c,j_c} <- value; result.{i_c,j_c} <- value;
result.{j_c,i_c} <- value; result.{j_c,i_c} <- value;
) (Am.zkey_array (Singlet (Cs.totAngMom shell.(i)))) ) (Am.zkey_array (Singlet (Cs.ang_mom shell.(i))))
) (Am.zkey_array (Singlet (Cs.totAngMom shell.(j)))) ) (Am.zkey_array (Singlet (Cs.ang_mom shell.(j))))
done; done;
done; done;
Mat.detri result; Mat.detri result;

4
Basis/NucInt.ml
View File

@ -87,8 +87,8 @@ let of_basis_nuclei basis nuclei =
in in
eni_array.{j_c,i_c} <- value; eni_array.{j_c,i_c} <- value;
eni_array.{i_c,j_c} <- value; eni_array.{i_c,j_c} <- value;
) (Am.zkey_array (Singlet (Cs.totAngMom shell.(j)))) ) (Am.zkey_array (Singlet (Cs.ang_mom shell.(j))))
) (Am.zkey_array (Singlet (Cs.totAngMom shell.(i)))) ) (Am.zkey_array (Singlet (Cs.ang_mom shell.(i))))
done; done;
done; done;
Mat.detri eni_array; Mat.detri eni_array;

13
Basis/OneElectronRR.ml
View File

@ -101,15 +101,10 @@ let contracted_class_shell_pair ~zero_m shell_p geometry : float Zmap.t =
let shell_a = Csp.shell_a shell_p let shell_a = Csp.shell_a shell_p
and shell_b = Csp.shell_b shell_p and shell_b = Csp.shell_b shell_p
in in
let maxm = let maxm = Am.to_int (Csp.ang_mom shell_p) in
Am.(Cs.totAngMom shell_a + Cs.totAngMom shell_b)
|> Am.to_int
in
(* Pre-computation of integral class indices *) (* Pre-computation of integral class indices *)
let class_indices = let class_indices = Csp.zkey_array shell_p in
Am.zkey_array (Am.Doublet Cs.(totAngMom shell_a, totAngMom shell_b))
in
let contracted_class = let contracted_class =
Array.make (Array.length class_indices) 0.; Array.make (Array.length class_indices) 0.;
@ -119,7 +114,7 @@ let contracted_class_shell_pair ~zero_m shell_p geometry : float Zmap.t =
let norm_scales_p = Csp.norm_scales shell_p in let norm_scales_p = Csp.norm_scales shell_p in
let center_ab = Csp.center_ab shell_p in let center_ab = Csp.a_minus_b shell_p in
List.iter (fun (coef_prod, psp) -> List.iter (fun (coef_prod, psp) ->
try try
@ -146,7 +141,7 @@ let contracted_class_shell_pair ~zero_m shell_p geometry : float Zmap.t =
let zero_m_array = let zero_m_array =
zero_m ~maxm ~expo_pq_inv ~norm_pq_sq zero_m ~maxm ~expo_pq_inv ~norm_pq_sq
in in
match Cs.(totAngMom shell_a, totAngMom shell_b) with match Cs.(ang_mom shell_a, ang_mom shell_b) with
| Am.(S,S) -> | Am.(S,S) ->
let integral = zero_m_array.(0) in let integral = zero_m_array.(0) in
contracted_class.(0) <- contracted_class.(0) -. coef_prod *. integral *. charge contracted_class.(0) <- contracted_class.(0) -. coef_prod *. integral *. charge

14
Basis/Overlap.ml
View File

@ -28,16 +28,14 @@ let contracted_class shell_a shell_b : float Zmap.t =
begin begin
(* Pre-computation of integral class indices *) (* Pre-computation of integral class indices *)
let class_indices = let class_indices = Csp.zkey_array shell_p in
Am.zkey_array (Am.Doublet Cs.(totAngMom shell_a, totAngMom shell_b))
in
let contracted_class = let contracted_class =
Array.make (Array.length class_indices) 0. Array.make (Array.length class_indices) 0.
in in
let center_ab = let a_minus_b =
Csp.center_ab shell_p Csp.a_minus_b shell_p
in in
let norm_coef_scales = let norm_coef_scales =
Csp.norm_scales shell_p Csp.norm_scales shell_p
@ -66,7 +64,7 @@ let contracted_class shell_a shell_b : float Zmap.t =
let xyz = xyz_of_int k in let xyz = xyz_of_int k in
Overlap_primitives.hvrr (Po.get xyz angMomA, Po.get xyz angMomB) Overlap_primitives.hvrr (Po.get xyz angMomA, Po.get xyz angMomB)
expo_inv expo_inv
(Co.get xyz center_ab, (Co.get xyz a_minus_b,
Co.get xyz center_pa) Co.get xyz center_pa)
in in
let norm = norm_coef_scales.(i) in let norm = norm_coef_scales.(i) in
@ -120,8 +118,8 @@ let of_basis basis =
in in
result.{i_c,j_c} <- value; result.{i_c,j_c} <- value;
result.{j_c,i_c} <- value; result.{j_c,i_c} <- value;
) (Am.zkey_array (Singlet (Cs.totAngMom shell.(i)))) ) (Am.zkey_array (Singlet (Cs.ang_mom shell.(i))))
) (Am.zkey_array (Singlet (Cs.totAngMom shell.(j)))) ) (Am.zkey_array (Singlet (Cs.ang_mom shell.(j))))
done; done;
done; done;
Mat.detri result; Mat.detri result;

20
Basis/PrimitiveShell.ml
View File

@ -7,15 +7,15 @@ type t = {
normalization : float; normalization : float;
norm_scales : float array lazy_t; norm_scales : float array lazy_t;
center : Coordinate.t; center : Coordinate.t;
totAngMom : AngularMomentum.t; ang_mom : AngularMomentum.t;
} }
module Am = AngularMomentum module Am = AngularMomentum
let compute_norm_coef alpha totAngMom = let compute_norm_coef alpha ang_mom =
let atot = let atot =
Am.to_int totAngMom Am.to_int ang_mom
in in
let factor int_array = let factor int_array =
let dfa = Array.map (fun j -> let dfa = Array.map (fun j ->
@ -37,15 +37,15 @@ let compute_norm_coef alpha totAngMom =
in f in f
let make totAngMom center exponent = let make ang_mom center exponent =
let norm_coef_func = let norm_coef_func =
compute_norm_coef exponent totAngMom compute_norm_coef exponent ang_mom
in in
let norm = let norm =
1. /. norm_coef_func [| Am.to_int totAngMom ; 0 ; 0 |] 1. /. norm_coef_func [| Am.to_int ang_mom ; 0 ; 0 |]
in in
let powers = let powers =
Am.zkey_array (Am.Singlet totAngMom) Am.zkey_array (Am.Singlet ang_mom)
in in
let norm_scales = lazy ( let norm_scales = lazy (
Array.map (fun a -> Array.map (fun a ->
@ -53,12 +53,12 @@ let make totAngMom center exponent =
) powers ) ) powers )
in in
let normalization = 1. /. norm in let normalization = 1. /. norm in
{ exponent ; normalization ; norm_scales ; center ; totAngMom } { exponent ; normalization ; norm_scales ; center ; ang_mom }
let to_string s = let to_string s =
let coord = s.center in let coord = s.center in
Printf.sprintf "%1s %8.3f %8.3f %8.3f %16.8e" (Am.to_string s.totAngMom) Printf.sprintf "%1s %8.3f %8.3f %8.3f %16.8e" (Am.to_string s.ang_mom)
(get X coord) (get Y coord) (get Z coord) s.exponent (get X coord) (get Y coord) (get Z coord) s.exponent
@ -74,7 +74,7 @@ let exponent x = x.exponent
let center x = x.center let center x = x.center
let totAngMom x = x.totAngMom let ang_mom x = x.ang_mom
let norm x = 1. /. x.normalization let norm x = 1. /. x.normalization

4
Basis/PrimitiveShell.mli
View File

@ -33,7 +33,7 @@ val exponent : t -> float
val center : t -> Coordinate.t val center : t -> Coordinate.t
(** Coordinate {% $\mathbf{A}$ %}.of the center. *) (** Coordinate {% $\mathbf{A}$ %}.of the center. *)
val totAngMom : t -> AngularMomentum.t val ang_mom : t -> AngularMomentum.t
(** Total angular momentum : {% $l = n_x + n_y + n_z$ %}. *) (** Total angular momentum : {% $l = n_x + n_y + n_z$ %}. *)
val norm : t -> float val norm : t -> float
@ -54,7 +54,7 @@ val norm_scales : t -> float array
(** Scaling factors {% $f(n_x,n_y,n_z)$ %} adjusting the normalization coefficient (** Scaling factors {% $f(n_x,n_y,n_z)$ %} adjusting the normalization coefficient
for the powers of {% $x,y,z$ %}. The normalization coefficients of the for the powers of {% $x,y,z$ %}. The normalization coefficients of the
functions of the shell are given by {% $\mathcal{N}\times f$ %}. They are functions of the shell are given by {% $\mathcal{N}\times f$ %}. They are
given in the same order as [AngularMomentum.zkey_array totAngMom]: given in the same order as [AngularMomentum.zkey_array ang_mom]:
{% \\[ f(n_x,n_y,n_z) = \frac{|| g_{l,0,0}(\mathbf{r}) ||}{|| g_{n_x,n_y,n_z}(\mathbf{r}) ||} \\] %} {% \\[ f(n_x,n_y,n_z) = \frac{|| g_{l,0,0}(\mathbf{r}) ||}{|| g_{n_x,n_y,n_z}(\mathbf{r}) ||} \\] %}
*) *)

20
Basis/PrimitiveShellPair.ml
View File

@ -12,7 +12,7 @@ type t = {
norm_scales : float array lazy_t; norm_scales : float array lazy_t;
normalization : float; (* norm_coef_a * norm_coef_b * g, with normalization : float; (* norm_coef_a * norm_coef_b * g, with
g = (pi/(alpha+beta))^(3/2) exp (-|A-B|^2 * alpha*beta/(alpha+beta)) *) g = (pi/(alpha+beta))^(3/2) exp (-|A-B|^2 * alpha*beta/(alpha+beta)) *)
totAngMom : AngularMomentum.t; ang_mom : AngularMomentum.t;
shell_a : PrimitiveShell.t; shell_a : PrimitiveShell.t;
shell_b : PrimitiveShell.t; shell_b : PrimitiveShell.t;
} }
@ -30,7 +30,7 @@ let hash a =
let equivalent a b = let equivalent a b =
a.exponent = b.exponent && a.exponent = b.exponent &&
a.totAngMom = b.totAngMom && a.ang_mom = b.ang_mom &&
a.normalization = b.normalization && a.normalization = b.normalization &&
a.center = b.center && a.center = b.center &&
a.center_minus_a = b.center_minus_a && a.center_minus_a = b.center_minus_a &&
@ -59,8 +59,8 @@ let create_make_of p_a p_b =
|> Array.concat |> Array.concat
) in ) in
let totAngMom = let ang_mom =
Am.( Ps.totAngMom p_a + Ps.totAngMom p_b ) Am.( Ps.ang_mom p_a + Ps.ang_mom p_b )
in in
function p_a -> function p_a ->
@ -109,7 +109,7 @@ let create_make_of p_a p_b =
in in
Some { Some {
totAngMom ; ang_mom ;
exponent ; exponent_inv ; center ; center_minus_a ; a_minus_b ; exponent ; exponent_inv ; center ; center_minus_a ; a_minus_b ;
a_minus_b_sq ; normalization ; norm_scales ; shell_a = p_a; a_minus_b_sq ; normalization ; norm_scales ; shell_a = p_a;
shell_b = p_b } shell_b = p_b }
@ -136,7 +136,7 @@ let monocentric x =
Ps.center x.shell_a = Ps.center x.shell_b Ps.center x.shell_a = Ps.center x.shell_b
let totAngMom x = x.totAngMom let ang_mom x = x.ang_mom
let a_minus_b x = x.a_minus_b let a_minus_b x = x.a_minus_b
@ -154,3 +154,11 @@ let shell_a x = x.shell_a
let shell_b x = x.shell_b let shell_b x = x.shell_b
let zkey_array x =
Am.zkey_array (Am.Doublet
Ps.(ang_mom x.shell_a, ang_mom x.shell_b)
)

9
Basis/PrimitiveShellPair.mli
View File

@ -1,7 +1,7 @@
(** Data structure describing a pair of primitive shells. (** Data structure describing a pair of primitive shells.
A primitive shell pair is the cartesian product between two sets of functions, each A primitive shell pair is the cartesian product between two sets of functions, each
set containing all the functions of a primitive shell. set containing all the functions of a primitive shell. These are one-electron functions.
{% \\[ {% \\[
\left\\{ p_{k_x,k_y,k_z}(\mathbf{r}) \right\\} = \left\\{ p_{k_x,k_y,k_z}(\mathbf{r}) \right\\} =
@ -24,7 +24,7 @@ where
{!a_minus_b}, {!a_minus_b_sq} and {!norm_coef_scale} depend only on the {!a_minus_b}, {!a_minus_b_sq} and {!norm_coef_scale} depend only on the
centering of the two shells, and {!totAngMom} only depends on the angular centering of the two shells, and {!ang_mom} only depends on the angular
momenta of the two shells. Hence, these quantities need to be computed only momenta of the two shells. Hence, these quantities need to be computed only
once when a {!ContractedShellPair.t} is built. Hence, there is the once when a {!ContractedShellPair.t} is built. Hence, there is the
{!create_make_of} function which creates a [make] function which is suitable {!create_make_of} function which creates a [make] function which is suitable
@ -52,7 +52,7 @@ val create_make_of : PrimitiveShell.t -> PrimitiveShell.t ->
*) *)
val totAngMom : t -> AngularMomentum.t val ang_mom : t -> AngularMomentum.t
(** Total angular momentum of the shell pair: sum of the angular momenta of (** Total angular momentum of the shell pair: sum of the angular momenta of
the shells. *) the shells. *)
@ -104,3 +104,6 @@ val hash : t -> int
val cmp : t -> t -> int val cmp : t -> t -> int
(** Arbitray comparison function for sorting. *) (** Arbitray comparison function for sorting. *)
val zkey_array : t -> Zkey.t array
(** Returns the array of Zkeys associated with the shell pair. *)

71
Basis/PrimitiveShellPairCouple.ml Normal file
View File

@ -0,0 +1,71 @@
exception NullContribution
type t =
{
shell_pair_p: PrimitiveShellPair.t ;
shell_pair_q: PrimitiveShellPair.t ;
shell_a : PrimitiveShell.t ;
shell_b : PrimitiveShell.t ;
shell_c : PrimitiveShell.t ;
shell_d : PrimitiveShell.t ;
ang_mom : AngularMomentum.t ;
zkey_array : Zkey.t array lazy_t;
}
module Am = AngularMomentum
module Co = Coordinate
module Ps = PrimitiveShell
module Psp = PrimitiveShellPair
let make shell_pair_p shell_pair_q =
let ang_mom =
Am.(Psp.ang_mom shell_pair_p + Psp.ang_mom shell_pair_q)
in
let shell_a = Psp.shell_a shell_pair_p
and shell_b = Psp.shell_b shell_pair_p
and shell_c = Psp.shell_a shell_pair_q
and shell_d = Psp.shell_b shell_pair_q
in
let zkey_array = lazy (
Am.zkey_array (Am.Quartet
Ps.(ang_mom shell_a, ang_mom shell_b,
ang_mom shell_c, ang_mom shell_d)
)
)
in
{ shell_pair_p ; shell_pair_q ; ang_mom ;
shell_a ; shell_b ; shell_c ; shell_d ;
zkey_array ;
}
let monocentric t =
Psp.monocentric t.shell_pair_p && Psp.monocentric t.shell_pair_q &&
Psp.center t.shell_pair_p = Psp.center t.shell_pair_q
let ang_mom t = t.ang_mom
let shell_pair_p t = t.shell_pair_p
let shell_pair_q t = t.shell_pair_q
let shell_a t = t.shell_a
let shell_b t = t.shell_b
let shell_c t = t.shell_c
let shell_d t = t.shell_d
let p_minus_q t =
let p = Psp.center t.shell_pair_p
and q = Psp.center t.shell_pair_q
in Co.(p |- q)
let zkey_array t = Lazy.force t.zkey_array
let norm_scales t =
let norm_coef_scale_p_list = Array.to_list (Psp.norm_scales t.shell_pair_p) in
let norm_coef_scale_q = Psp.norm_scales t.shell_pair_q in
List.map (fun v1 -> Array.map (fun v2 -> v1 *. v2) norm_coef_scale_q)
norm_coef_scale_p_list
|> Array.concat

62
Basis/PrimitiveShellPairCouple.mli Normal file
View File

@ -0,0 +1,62 @@
(** Data structure describing a couple of primitive shells pairs.
A primitive shell pair couple is the cartesian product between two sets of functions, one
set over electron one and one set over electron two. Both sets are primitive shell
pairs.
These are usually called {e shell quartets} in the literature, but we prefer to use
{e pair} for two functions with the same electron, and {e couple} for two functions
acting on different electrons, since they will be coupled by a two-electron operator.
*)
type t
val make : PrimitiveShellPair.t -> PrimitiveShellPair.t -> t
(** Creates a primitive shell pair couple using two primitive shell pairs.
*)
val ang_mom : t -> AngularMomentum.t
(** Total angular momentum of the shell pair couple: sum of the angular momenta of
all the shells. *)
val shell_a : t -> PrimitiveShell.t
(** Returns the first primitive shell of the first shell pair. *)
val shell_b : t -> PrimitiveShell.t
(** Returns the second primitive shell of the first shell pair. *)
val shell_c : t -> PrimitiveShell.t
(** Returns the first primitive shell of the second shell pair. *)
val shell_d : t -> PrimitiveShell.t
(** Returns the second primitive shell of the second shell pair. *)
val shell_pair_p : t -> PrimitiveShellPair.t
(** Returns the first primitive shell pair that was used to build the shell pair. *)
val shell_pair_q : t -> PrimitiveShellPair.t
(** Returns the second primitive shell pair that was used to build the shell pair. *)
val p_minus_q : t -> Coordinate.t
(** {% $\mathbf{P-Q}$ %}. *)
val monocentric : t -> bool
(** True if all four primitive shells have the same center. *)
val zkey_array : t -> Zkey.t array
(** Returns the array of {!Zkey.t} relative to the four shells of the
shell pair couple.
*)
val norm_scales : t -> float array
(** Scaling factors of normalization coefficients inside the shell. The
ordering is the same as {!zkey_array}.
*)

264
Basis/TwoElectronRR.ml
View File

@ -1,15 +1,20 @@
open Util open Util
module Am = AngularMomentum module Am = AngularMomentum
module Co = Coordinate module Asp = AtomicShellPair
module Cs = ContractedShell module Aspc = AtomicShellPairCouple
module Csp = ContractedShellPair module Co = Coordinate
module Po = Powers module Cs = ContractedShell
module Psp = PrimitiveShellPair module Csp = ContractedShellPair
module Ps = PrimitiveShell module Cspc = ContractedShellPairCouple
module Po = Powers
module Psp = PrimitiveShellPair
module Pspc = PrimitiveShellPairCouple
module Ps = PrimitiveShell
let cutoff = Constants.integrals_cutoff let cutoff = Constants.integrals_cutoff
let cutoff2 = cutoff *. cutoff let cutoff2 = cutoff *. cutoff
let empty = Zmap.create 0
exception NullQuartet exception NullQuartet
@ -275,50 +280,39 @@ let rec hvrr_two_e
let contracted_class_shell_pairs ~zero_m ?schwartz_p ?schwartz_q shell_p shell_q : float Zmap.t = let contracted_class_shell_pairs ~zero_m ?schwartz_p ?schwartz_q shell_p shell_q : float Zmap.t =
let shell_a = Csp.shell_a shell_p match Cspc.make ~cutoff shell_p shell_q with
and shell_b = Csp.shell_b shell_p | None -> empty
and shell_c = Csp.shell_a shell_q | Some shell_pair_couple ->
and shell_d = Csp.shell_b shell_q
in
let maxm = Am.(Csp.totAngMom shell_p + Csp.totAngMom shell_q |> to_int) in
(* Pre-computation of integral class indices *) let maxm = Am.to_int (Cspc.ang_mom shell_pair_couple) in
let class_indices =
Am.zkey_array (Am.Quartet
Cs.(totAngMom shell_a, totAngMom shell_b,
totAngMom shell_c, totAngMom shell_d ))
in
let contracted_class = (* Pre-computation of integral class indices *)
Array.make (Array.length class_indices) 0.; let class_indices = Cspc.zkey_array shell_pair_couple in
in
let monocentric = let contracted_class =
Csp.monocentric shell_p && Csp.monocentric shell_q && Array.make (Array.length class_indices) 0.;
Cs.center (Csp.shell_a shell_p) = Cs.center (Csp.shell_a shell_q)
in
(* Compute all integrals in the shell for each pair of significant shell pairs *)
let norm_coef_scale_p_list = Array.to_list (Csp.norm_scales shell_p) in
let norm_coef_scale_q = Csp.norm_scales shell_q in
let center_ab = Csp.center_ab shell_p in
List.iter (fun (c_ab, sp_ab) ->
let expo_b = Ps.exponent (Psp.shell_b sp_ab)
and expo_inv_p = Psp.exponent_inv sp_ab
and center_pa = Psp.center_minus_a sp_ab
in in
List.iter (fun (c_cd, sp_cd) -> let monocentric =
Cspc.monocentric shell_pair_couple
in
let coef_prod = c_ab *. c_cd in (* Compute all integrals in the shell for each pair of significant shell pairs *)
(** Screening on the product of coefficients *) let center_ab = Csp.a_minus_b shell_p
try and center_cd = Csp.a_minus_b shell_q
if (abs_float coef_prod) < 1.e-3 *. cutoff then in
raise NullQuartet;
let norm_scales = Cspc.norm_scales shell_pair_couple in
List.iter (fun (coef_prod, spc) ->
let sp_ab = Pspc.shell_pair_p spc
and sp_cd = Pspc.shell_pair_q spc
in
let expo_inv_p = Psp.exponent_inv sp_ab
in
let center_pq = Co.(Psp.center sp_ab |- Psp.center sp_cd) in let center_pq = Co.(Psp.center sp_ab |- Psp.center sp_cd) in
let norm_pq_sq = Co.dot center_pq center_pq in let norm_pq_sq = Co.dot center_pq center_pq in
@ -330,23 +324,19 @@ let contracted_class_shell_pairs ~zero_m ?schwartz_p ?schwartz_q shell_p shell_q
in in
begin begin
match Cs.(totAngMom shell_a, totAngMom shell_b, match Cspc.ang_mom shell_pair_couple with
totAngMom shell_c, totAngMom shell_d) with | Am.S ->
| Am.(S,S,S,S) -> let integral = zero_m_array.(0) in
let integral =
zero_m_array.(0)
in
contracted_class.(0) <- contracted_class.(0) +. coef_prod *. integral contracted_class.(0) <- contracted_class.(0) +. coef_prod *. integral
| _ -> | _ ->
let expo_d = Ps.exponent (Psp.shell_b sp_cd) in let expo_b = Ps.exponent (Psp.shell_b sp_ab)
let map_1d = Zmap.create (4*maxm) in and expo_d = Ps.exponent (Psp.shell_b sp_cd)
let map_2d = Zmap.create (Array.length class_indices) in and center_pa = Psp.center_minus_a sp_ab
let center_cd = Psp.a_minus_b sp_cd in in
let center_qc = Psp.center_minus_a sp_cd in let map_1d = Zmap.create (4*maxm)
let norm_coef_scale = and map_2d = Zmap.create (Array.length class_indices)
List.map (fun v1 -> Array.map (fun v2 -> v1 *. v2) norm_coef_scale_q) in
norm_coef_scale_p_list let center_qc = Psp.center_minus_a sp_cd
|> Array.concat
in in
(* Compute the integral class from the primitive shell quartet *) (* Compute the integral class from the primitive shell quartet *)
@ -363,7 +353,7 @@ let contracted_class_shell_pairs ~zero_m ?schwartz_p ?schwartz_q shell_p shell_q
if ( ((1 land angMom_a.Po.x + angMom_b.Po.x + angMom_c.Po.x + angMom_d.Po.x)=1) || if ( ((1 land angMom_a.Po.x + angMom_b.Po.x + angMom_c.Po.x + angMom_d.Po.x)=1) ||
((1 land angMom_a.Po.y + angMom_b.Po.y + angMom_c.Po.y + angMom_d.Po.y)=1) || ((1 land angMom_a.Po.y + angMom_b.Po.y + angMom_c.Po.y + angMom_d.Po.y)=1) ||
((1 land angMom_a.Po.z + angMom_b.Po.z + angMom_c.Po.z + angMom_d.Po.z)=1) ((1 land angMom_a.Po.z + angMom_b.Po.z + angMom_c.Po.z + angMom_d.Po.z)=1)
) then ) then
raise NullQuartet raise NullQuartet
end; end;
@ -393,7 +383,7 @@ let contracted_class_shell_pairs ~zero_m ?schwartz_p ?schwartz_q shell_p shell_q
*) *)
let norm = norm_coef_scale.(i) in let norm = norm_scales.(i) in
let coef_prod = coef_prod *. norm in let coef_prod = coef_prod *. norm in
let integral = let integral =
@ -410,14 +400,150 @@ let contracted_class_shell_pairs ~zero_m ?schwartz_p ?schwartz_q shell_p shell_q
with NullQuartet -> () with NullQuartet -> ()
) )
end end
with NullQuartet -> () ) (Cspc.coefs_and_shell_pair_couples shell_pair_couple);
) (Csp.coefs_and_shell_pairs shell_q)
) (Csp.coefs_and_shell_pairs shell_p);
let result = let result =
Zmap.create (Array.length contracted_class) Zmap.create (Array.length contracted_class)
in in
Array.iteri (fun i key -> Zmap.add result key contracted_class.(i)) class_indices; Array.iteri (fun i key -> Zmap.add result key contracted_class.(i)) class_indices;
result result
let contracted_class_atomic_shell_pairs ~zero_m ?schwartz_p ?schwartz_q shell_p shell_q : float Zmap.t =
match Aspc.make shell_p shell_q with
| None -> empty
| Some atomic_shell_pair_couple ->
let maxm = Am.to_int (Aspc.ang_mom atomic_shell_pair_couple) in
(* Pre-computation of integral class indices *)
let class_indices = Aspc.zkey_array atomic_shell_pair_couple in
let contracted_class =
Array.make (Array.length class_indices) 0.;
in
let monocentric =
Aspc.monocentric atomic_shell_pair_couple
in
(* Compute all integrals in the shell for each pair of significant shell pairs *)
let center_ab = Asp.a_minus_b shell_p
and center_cd = Asp.a_minus_b shell_q
in
let norm_scales = Aspc.norm_scales atomic_shell_pair_couple in
List.iter (fun cspc ->
List.iter (fun (coef_prod, spc) ->
let sp_ab = Pspc.shell_pair_p spc
and sp_cd = Pspc.shell_pair_q spc
in
let expo_inv_p = Psp.exponent_inv sp_ab
in
let center_pq = Co.(Psp.center sp_ab |- Psp.center sp_cd) in
let norm_pq_sq = Co.dot center_pq center_pq in
let expo_inv_q = Psp.exponent_inv sp_cd in
let expo_pq_inv = expo_inv_p +. expo_inv_q in
let zero_m_array =
zero_m ~maxm ~expo_pq_inv ~norm_pq_sq
in
begin
match Aspc.ang_mom atomic_shell_pair_couple with
| Am.S ->
let integral = zero_m_array.(0) in
contracted_class.(0) <- contracted_class.(0) +. coef_prod *. integral
| _ ->
let expo_b = Ps.exponent (Psp.shell_b sp_ab)
and expo_d = Ps.exponent (Psp.shell_b sp_cd)
and center_pa = Psp.center_minus_a sp_ab
in
let map_1d = Zmap.create (4*maxm)
and map_2d = Zmap.create (Array.length class_indices)
in
let center_qc = Psp.center_minus_a sp_cd
in
(* Compute the integral class from the primitive shell quartet *)
class_indices
|> Array.iteri (fun i key ->
let (angMom_a,angMom_b,angMom_c,angMom_d) =
match Zkey.to_powers key with
| Zkey.Twelve x -> x
| _ -> assert false
in
try
if monocentric then
begin
if ( ((1 land angMom_a.Po.x + angMom_b.Po.x + angMom_c.Po.x + angMom_d.Po.x)=1) ||
((1 land angMom_a.Po.y + angMom_b.Po.y + angMom_c.Po.y + angMom_d.Po.y)=1) ||
((1 land angMom_a.Po.z + angMom_b.Po.z + angMom_c.Po.z + angMom_d.Po.z)=1)
) then
raise NullQuartet
end;
(* Schwartz screening *)
(*
if (maxm > 8) then
(
let schwartz_p =
let key =
Zkey.of_powers_twelve angMom_a angMom_b angMom_a angMom_b
in
match schwartz_p with
| None -> 1.
| Some schwartz_p -> Zmap.find schwartz_p key
in
if schwartz_p < cutoff then raise NullQuartet;
let schwartz_q =
let key =
Zkey.of_powers_twelve angMom_c angMom_d angMom_c angMom_d
in
match schwartz_q with
| None -> 1.
| Some schwartz_q -> Zmap.find schwartz_q key
in
if schwartz_p *. schwartz_q < cutoff2 then raise NullQuartet;
);
*)
let norm = norm_scales.(i) in
let coef_prod = coef_prod *. norm in
let integral =
hvrr_two_e
angMom_a angMom_b angMom_c angMom_d
zero_m_array
expo_b expo_d
expo_inv_p expo_inv_q
center_ab center_cd center_pq
center_pa center_qc
map_1d map_2d
in
contracted_class.(i) <- contracted_class.(i) +. coef_prod *. integral
with NullQuartet -> ()
)
end
) (Cspc.coefs_and_shell_pair_couples cspc)
) (Aspc.contracted_shell_pair_couples atomic_shell_pair_couple);
let result =
Zmap.create (Array.length contracted_class)
in
Array.iteri (fun i key -> Zmap.add result key contracted_class.(i)) class_indices;
result

487
Basis/TwoElectronRRVectorized.ml
View File

@ -2,19 +2,21 @@ open Util
open Lacaml.D open Lacaml.D
open Bigarray open Bigarray
module Am = AngularMomentum module Am = AngularMomentum
module Co = Coordinate module Co = Coordinate
module Cs = ContractedShell module Cs = ContractedShell
module Csp = ContractedShellPair module Csp = ContractedShellPair
module Po = Powers module Cspc = ContractedShellPairCouple
module Psp = PrimitiveShellPair module Po = Powers
module Ps = PrimitiveShell module Psp = PrimitiveShellPair
module Ps = PrimitiveShell
exception NullQuartet exception NullQuartet
exception Found exception Found
let cutoff = Constants.integrals_cutoff let cutoff = Constants.integrals_cutoff
let cutoff2 = cutoff *. cutoff let cutoff2 = cutoff *. cutoff
let empty = Zmap.create 0
let at_least_one_valid arr = let at_least_one_valid arr =
try try
@ -555,57 +557,10 @@ let hvrr_two_e_vector (angMom_a, angMom_b, angMom_c, angMom_d)
let contracted_class_shell_pairs ~zero_m ?schwartz_p ?schwartz_q shell_p shell_q : float Zmap.t = let contracted_class_shell_pairs ~zero_m ?schwartz_p ?schwartz_q shell_p shell_q : float Zmap.t =
let shell_a = Csp.shell_a shell_p let sp = Csp.shell_pairs shell_p
and shell_b = Csp.shell_b shell_p and sq = Csp.shell_pairs shell_q
and shell_c = Csp.shell_a shell_q and cp = Csp.coefficients shell_p
and shell_d = Csp.shell_b shell_q and cq = Csp.coefficients shell_q
in
let maxm =
Am.(Csp.totAngMom shell_p + Csp.totAngMom shell_q |> to_int)
in
(* Pre-computation of integral class indices *)
let class_indices =
Am.zkey_array (Am.Quartet
Cs.(totAngMom shell_a, totAngMom shell_b,
totAngMom shell_c, totAngMom shell_d))
in
let contracted_class =
Array.make (Array.length class_indices) 0.;
in
let monocentric =
Csp.monocentric shell_p && Csp.monocentric shell_q &&
Cs.center (Csp.shell_a shell_p) =
Cs.center (Csp.shell_a shell_q)
in
(** Screening on the product of coefficients *)
let coef_max_p =
List.fold_left (fun accu (x,_) ->
if (abs_float x) > accu then (abs_float x) else accu)
0. (Csp.coefs_and_shell_pairs shell_p)
and coef_max_q =
List.fold_left (fun accu (x,_) ->
if (abs_float x) > accu then (abs_float x) else accu)
0. (Csp.coefs_and_shell_pairs shell_q)
in
let filter_p =
let cutoff_p = cutoff /. coef_max_p in
Csp.coefs_and_shell_pairs shell_p
|> List.filter (fun (ck,f) -> abs_float ck > cutoff_p)
and filter_q =
let cutoff_q = cutoff /. coef_max_q in
Csp.coefs_and_shell_pairs shell_q
|> List.filter (fun (ck,f) -> abs_float ck > cutoff_q)
in
let sp = List.map snd filter_p |> Array.of_list
and sq = List.map snd filter_q |> Array.of_list
and cp = List.map fst filter_p |> Array.of_list
and cq = List.map fst filter_q |> Array.of_list
in in
let np, nq = let np, nq =
@ -613,207 +568,219 @@ let contracted_class_shell_pairs ~zero_m ?schwartz_p ?schwartz_q shell_p shell_q
Array.length sq Array.length sq
in in
try
match Cspc.make ~cutoff shell_p shell_q with
| None -> raise NullQuartet
| Some shell_pair_couple ->
(* Compute all integrals in the shell for each pair of significant shell pairs *) let shell_a = Cspc.shell_a shell_pair_couple
and shell_c = Cspc.shell_c shell_pair_couple
begin
match Cs.(totAngMom shell_a, totAngMom shell_b,
totAngMom shell_c, totAngMom shell_d) with
| Am.(S,S,S,S) ->
contracted_class.(0) <-
begin
try
let expo_inv_p =
Vec.init np (fun ab -> Psp.exponent_inv sp.(ab-1))
and expo_inv_q =
Vec.init nq (fun cd -> Psp.exponent_inv sq.(cd-1))
in
let coef =
let result = Mat.make0 nq np in
Lacaml.D.ger (Vec.of_array @@ cq) (Vec.of_array @@ cp) result;
result
in
let zm_array = Mat.init_cols np nq (fun i j ->
try
if (abs_float coef.{j,i} ) < 1.e-3*.cutoff then
raise NullQuartet;
let expo_pq_inv =
expo_inv_p.{i} +. expo_inv_q.{j}
in
let center_pq =
Co.(Psp.center sp.(i-1) |- Psp.center sq.(j-1))
in
let norm_pq_sq =
Co.dot center_pq center_pq
in
let zero_m_array =
zero_m ~maxm:0 ~expo_pq_inv ~norm_pq_sq
in
zero_m_array.(0)
with NullQuartet -> 0.
) in
Mat.gemm_trace zm_array coef
with (Invalid_argument _) -> 0.
end
| _ ->
let coef =
Array.init np (fun l -> Array.init nq (fun k -> cq.(k) *. cp.(l)) )
in in
let expo_inv_p = let maxm = Am.to_int (Cspc.ang_mom shell_pair_couple) in
Array.map (fun shell_ab -> Psp.exponent_inv shell_ab) sp
and expo_inv_q =
Array.map (fun shell_cd -> Psp.exponent_inv shell_cd) sq (* Pre-computation of integral class indices *)
let class_indices = Cspc.zkey_array shell_pair_couple in
let contracted_class =
Array.make (Array.length class_indices) 0.;
in in
let expo_b = let monocentric =
Array.map (fun shell_ab -> Ps.exponent (Psp.shell_b shell_ab) ) sp Cspc.monocentric shell_pair_couple
and expo_d =
Array.map (fun shell_cd -> Ps.exponent (Psp.shell_b shell_cd) ) sq
in in
let norm_coef_scale_p = Csp.norm_scales shell_p in
let center_pq = (* Compute all integrals in the shell for each pair of significant shell pairs *)
let result =
Array.init 3 (fun xyz -> begin
Array.init np (fun ab -> match Cspc.ang_mom shell_pair_couple with
let shell_ab = sp.(ab) in | Am.S ->
Array.init nq (fun cd -> contracted_class.(0) <-
let shell_cd = sq.(cd) begin
try
let expo_inv_p =
Vec.init np (fun ab -> Psp.exponent_inv sp.(ab-1))
and expo_inv_q =
Vec.init nq (fun cd -> Psp.exponent_inv sq.(cd-1))
in in
let cpq =
Co.(Psp.center shell_ab |- Psp.center shell_cd) let coef =
let result = Mat.make0 nq np in
Lacaml.D.ger (Vec.of_array @@ cq) (Vec.of_array @@ cp) result;
result
in in
match xyz with let zm_array = Mat.init_cols np nq (fun i j ->
| 0 -> Co.get X cpq; try
| 1 -> Co.get Y cpq; if (abs_float coef.{j,i} ) < 1.e-3*.cutoff then
| _ -> Co.get Z cpq; raise NullQuartet;
)
) let expo_pq_inv =
) expo_inv_p.{i} +. expo_inv_q.{j}
in function
| Co.X -> result.(0)
| Co.Y -> result.(1)
| Co.Z -> result.(2)
in
let center_pa =
let result =
Array.init 3 (fun xyz ->
Array.init np (fun ab ->
let shell_ab = sp.(ab) in
let cpa =
Co.(Psp.center shell_ab |- Cs.center shell_a)
in
match xyz with
| 0 -> Co.(get X cpa);
| 1 -> Co.(get Y cpa);
| _ -> Co.(get Z cpa);
)
)
in function
| Co.X -> result.(0)
| Co.Y -> result.(1)
| Co.Z -> result.(2)
in
let center_qc =
let result =
Array.init 3 (fun xyz ->
Array.init nq (fun cd ->
let shell_cd = sq.(cd) in
let cqc =
Co.(Psp.center shell_cd |- Cs.center shell_c)
in
match xyz with
| 0 -> Co.(get X cqc);
| 1 -> Co.(get Y cqc);
| _ -> Co.(get Z cqc);
)
)
in function
| Co.X -> result.(0)
| Co.Y -> result.(1)
| Co.Z -> result.(2)
in
let zero_m_array =
let result =
Array.init (maxm+1) (fun _ ->
Array.init np (fun _ -> Array.make nq 0. ) )
in
let empty = Array.make (maxm+1) 0. in
Array.iteri (fun ab shell_ab ->
let zero_m_array_tmp =
Array.mapi (fun cd shell_cd ->
if (abs_float coef.(ab).(cd) < cutoff) then
empty
else
let expo_pq_inv =
expo_inv_p.(ab) +. expo_inv_q.(cd)
in
let norm_pq_sq =
let x = (center_pq X).(ab).(cd)
and y = (center_pq Y).(ab).(cd)
and z = (center_pq Z).(ab).(cd)
in in
x *. x +. y *. y +. z *. z
in
zero_m ~maxm ~expo_pq_inv ~norm_pq_sq let center_pq =
) sq Co.(Psp.center sp.(i-1) |- Psp.center sq.(j-1))
in in
(* Transpose result *) let norm_pq_sq =
let coef_ab = coef.(ab) in Co.dot center_pq center_pq
for m=0 to maxm do in
let result_m_ab = result.(m).(ab)
in
for cd=0 to nq-1 do
result_m_ab.(cd) <- zero_m_array_tmp.(cd).(m) *. coef_ab.(cd)
done
done
) sp;
result
in
let norm = let zero_m_array =
let norm_coef_scale_q = zero_m ~maxm:0 ~expo_pq_inv ~norm_pq_sq
Csp.norm_scales shell_q in
zero_m_array.(0)
with NullQuartet -> 0.
) in
Mat.gemm_trace zm_array coef
with (Invalid_argument _) -> 0.
end
| _ ->
let coef =
Array.init np (fun l -> Array.init nq (fun k -> cq.(k) *. cp.(l)) )
in in
Array.to_list norm_coef_scale_p
|> List.map (fun v1 ->
Array.map (fun v2 -> v1 *. v2) norm_coef_scale_q)
|> Array.concat
in
let map_1d = Zmap.create (4*maxm) let norm = Cspc.norm_scales shell_pair_couple in
and map_2d = Array.init (maxm+1) (fun _ -> Zmap.create (Array.length class_indices))
in let expo_inv_p =
(* Compute the integral class from the primitive shell quartet *) Array.map (fun shell_ab -> Psp.exponent_inv shell_ab) sp
Array.iteri (fun i key -> and expo_inv_q =
let (angMom_a,angMom_b,angMom_c,angMom_d) = Array.map (fun shell_cd -> Psp.exponent_inv shell_cd) sq
match Zkey.to_powers key with in
| Zkey.Twelve x -> x
| _ -> assert false let expo_b =
Array.map (fun shell_ab -> Ps.exponent (Psp.shell_b shell_ab) ) sp
and expo_d =
Array.map (fun shell_cd -> Ps.exponent (Psp.shell_b shell_cd) ) sq
in
let center_pq =
let result =
Array.init 3 (fun xyz ->
Array.init np (fun ab ->
let shell_ab = sp.(ab) in
Array.init nq (fun cd ->
let shell_cd = sq.(cd)
in
let cpq =
Co.(Psp.center shell_ab |- Psp.center shell_cd)
in
match xyz with
| 0 -> Co.get X cpq;
| 1 -> Co.get Y cpq;
| _ -> Co.get Z cpq;
)
)
)
in function
| Co.X -> result.(0)
| Co.Y -> result.(1)
| Co.Z -> result.(2)
in
let center_pa =
let result =
Array.init 3 (fun xyz ->
Array.init np (fun ab ->
let shell_ab = sp.(ab) in
let cpa =
Co.(Psp.center shell_ab |- Cs.center shell_a)
in
match xyz with
| 0 -> Co.(get X cpa);
| 1 -> Co.(get Y cpa);
| _ -> Co.(get Z cpa);
)
)
in function
| Co.X -> result.(0)
| Co.Y -> result.(1)
| Co.Z -> result.(2)
in
let center_qc =
let result =
Array.init 3 (fun xyz ->
Array.init nq (fun cd ->
let shell_cd = sq.(cd) in
let cqc =
Co.(Psp.center shell_cd |- Cs.center shell_c)
in
match xyz with
| 0 -> Co.(get X cqc);
| 1 -> Co.(get Y cqc);
| _ -> Co.(get Z cqc);
)
)
in function
| Co.X -> result.(0)
| Co.Y -> result.(1)
| Co.Z -> result.(2)
in
let zero_m_array =
let result =
Array.init (maxm+1) (fun _ ->
Array.init np (fun _ -> Array.make nq 0. ) )
in
let empty = Array.make (maxm+1) 0. in
Array.iteri (fun ab shell_ab ->
let zero_m_array_tmp =
Array.mapi (fun cd shell_cd ->
if (abs_float coef.(ab).(cd) < cutoff) then
empty
else
let expo_pq_inv =
expo_inv_p.(ab) +. expo_inv_q.(cd)
in
let norm_pq_sq =
let x = (center_pq X).(ab).(cd)
and y = (center_pq Y).(ab).(cd)
and z = (center_pq Z).(ab).(cd)
in
x *. x +. y *. y +. z *. z
in
zero_m ~maxm ~expo_pq_inv ~norm_pq_sq
) sq
in in
try (* Transpose result *)
if monocentric then let coef_ab = coef.(ab) in
begin for m=0 to maxm do
let result_m_ab = result.(m).(ab)
in
for cd=0 to nq-1 do
result_m_ab.(cd) <- zero_m_array_tmp.(cd).(m) *. coef_ab.(cd)
done
done
) sp;
result
in
let map_1d = Zmap.create (4*maxm)
and map_2d = Array.init (maxm+1) (fun _ -> Zmap.create (Array.length class_indices))
in
(* 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 key with
| Zkey.Twelve x -> x
| _ -> assert false
in
try
if monocentric then
begin
if ( ((1 land angMom_a.x + angMom_b.x + angMom_c.x + angMom_d.x) =1) || if ( ((1 land angMom_a.x + angMom_b.x + angMom_c.x + angMom_d.x) =1) ||
((1 land angMom_a.y + angMom_b.y + angMom_c.y + angMom_d.y) =1) || ((1 land angMom_a.y + angMom_b.y + angMom_c.y + angMom_d.y) =1) ||
((1 land angMom_a.z + angMom_b.z + angMom_c.z + angMom_d.z) =1) ((1 land angMom_a.z + angMom_b.z + angMom_c.z + angMom_d.z) =1)
) then ) then
raise NullQuartet raise NullQuartet
end; end;
(* Schwartz screening *) (* Schwartz screening *)
if (np+nq> 24) then if (np+nq> 24) then
( (
let schwartz_p = let schwartz_p =
let key = Zkey.of_powers_twelve let key = Zkey.of_powers_twelve
angMom_a angMom_b angMom_a angMom_b angMom_a angMom_b angMom_a angMom_b
in in
match schwartz_p with match schwartz_p with
| None -> 1. | None -> 1.
@ -822,36 +789,36 @@ let contracted_class_shell_pairs ~zero_m ?schwartz_p ?schwartz_q shell_p shell_q
if schwartz_p < cutoff then raise NullQuartet; if schwartz_p < cutoff then raise NullQuartet;
let schwartz_q = let schwartz_q =
let key = Zkey.of_powers_twelve let key = Zkey.of_powers_twelve
angMom_c angMom_d angMom_c angMom_d angMom_c angMom_d angMom_c angMom_d
in in
match schwartz_q with match schwartz_q with
| None -> 1. | None -> 1.
| Some schwartz_q -> Zmap.find schwartz_q key | Some schwartz_q -> Zmap.find schwartz_q key
in in
if schwartz_p *. schwartz_q < cutoff2 then raise NullQuartet; if schwartz_p *. schwartz_q < cutoff2 then raise NullQuartet;
); );
let integral =
hvrr_two_e_vector (angMom_a, angMom_b, angMom_c, angMom_d)
zero_m_array
(expo_b, expo_d)
(expo_inv_p, expo_inv_q)
(Csp.center_ab shell_p,
Csp.center_ab shell_q, center_pq)
(center_pa, center_qc)
map_1d map_2d np nq
in
contracted_class.(i) <- contracted_class.(i) +. integral *. norm.(i)
with NullQuartet -> ()
) class_indices
end; let integral =
hvrr_two_e_vector (angMom_a, angMom_b, angMom_c, angMom_d)
let result = zero_m_array
Zmap.create (Array.length contracted_class) (expo_b, expo_d)
in (expo_inv_p, expo_inv_q)
Array.iteri (fun i key -> Zmap.add result key contracted_class.(i)) class_indices; (Csp.a_minus_b shell_p,
result Csp.a_minus_b shell_q, center_pq)
(center_pa, center_qc)
map_1d map_2d np nq
in
contracted_class.(i) <- contracted_class.(i) +. integral *. norm.(i)
with NullQuartet -> ()
) class_indices
end;
let result =
Zmap.create (Array.length contracted_class)
in
Array.iteri (fun i key -> Zmap.add result key contracted_class.(i)) class_indices;
result
with NullQuartet -> empty