diff --git a/Basis/AtomicShellPair.ml b/Basis/AtomicShellPair.ml new file mode 100644 index 0000000..f133eaf --- /dev/null +++ b/Basis/AtomicShellPair.ml @@ -0,0 +1,63 @@ +open Util +open Constants + +exception Null_contribution + +type t = +{ + atomic_shell_a : AtomicShell.t; + atomic_shell_b : AtomicShell.t; + contracted_shell_pairs : ContractedShellPair.t list; +} + + +module Am = AngularMomentum +module As = AtomicShell +module Co = Coordinate +module Cs = ContractedShell +module Ps = PrimitiveShell +module Psp = PrimitiveShellPair + +(** 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 l_a = Array.to_list (As.contracted_shells atomic_shell_a) + and l_b = Array.to_list (As.contracted_shells atomic_shell_b) + in + + let contracted_shell_pairs = + List.map (fun s_a -> + List.map (fun s_b -> + Csp.make ~cutoff s_a s_b + ) l_b + ) l_a + in + + +let atomic_shell_a x = x.atomic_shell_a +let atomic_shell_b x = x.atomic_shell_b +let contracted_shell_pairs = 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 totAngMon x = Csp.totAngMon @@ 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 + of contracted shells. +*) +let of_atomic_shell_array basis = + Array.mapi (fun i shell_a -> + Array.mapi (fun j shell_b -> + make ~cutoff shell_a shell_b) + (Array.sub basis 0 (i+1)) + ) basis + + + diff --git a/Basis/AtomicShellPair.mli b/Basis/AtomicShellPair.mli new file mode 100644 index 0000000..cb3fdcc --- /dev/null +++ b/Basis/AtomicShellPair.mli @@ -0,0 +1,51 @@ +(** A datastructure to represent pairs of atomic shells. +*) + +type t + + +val make : ?cutoff:float -> AtomicShell.t -> AtomicShell.t -> t option +(** Creates an atomic shell pair from two atomic shells. + + The contracted shell pairs contains the only pairs of primitives for which + the norm is greater than [cutoff]. + + If all the contracted shell pairs are not significant, the function returns + [None]. +*) + +val of_atomic_shell_array : AtomicShell.t array -> t option list +(** 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]. +*) + +val atomic_shell_a : t -> AtomicShell.t +(** Returns the first {!AtomicShell.t} which was used to build the atomic + shell pair. +*) + +val atomic_shell_b : t -> AtomicShell.t +(** Returns the second {!AtomicShell.t} which was used to build the atomic + shell pair. +*) + +val contracted_shell_pairs : t -> ContractedShellPair.t list +(** Returns an array of {!ContractedShellPair.t}, containing all the pairs of + contracted functions used to build the atomic shell pair. +*) + +val center_ab : t -> Coordinate.t + (* A-B *) + +val norm_sq : t -> float + (* |A-B|^2 *) + +val norm_scales : t -> float array + (* norm_coef.(i) / norm_coef.(0) *) + +val totAngMom : t -> AngularMomentum.t + (* Total angular Momentum *) + +val monocentric : t -> bool +(** If true, the two atomic shells have the same center. *) + diff --git a/Basis/ContractedShellPair.ml b/Basis/ContractedShellPair.ml index 4e33ee4..586b9a0 100644 --- a/Basis/ContractedShellPair.ml +++ b/Basis/ContractedShellPair.ml @@ -7,7 +7,7 @@ type t = { shell_a : ContractedShell.t; shell_b : ContractedShell.t; - shell_pairs : PrimitiveShellPair.t array; + shell_pairs : PrimitiveShellPair.t list; coefficients : float array; exponents_inv : float array; center_ab : Coordinate.t; (* A-B *) @@ -46,18 +46,17 @@ let make ?(cutoff=1.e-32) s_a s_b = |> Array.to_list |> List.filter (function (_, Some _) -> true | _ -> false) |> List.map (function (c, Some x) -> (c,x) | _ -> assert false) - |> Array.of_list in - let coefficients = Array.map (fun (c,y) -> c *. Psp.normalization y) shell_pairs - and exponents_inv = Array.map (fun (_,y) -> Psp.exponent_inv y) shell_pairs - in - let shell_pairs = Array.map snd shell_pairs in - if Array.length shell_pairs = 0 then - None - else - let root = shell_pairs.(0) in + match shell_pairs with + | [] -> None + | head :: _ -> + let coefficients = List.map (fun (c,y) -> c *. Psp.normalization y) shell_pairs |> Array.of_list + and exponents_inv = List.map (fun (_,y) -> Psp.exponent_inv y) shell_pairs |> Array.of_list + in + let shell_pairs = List.map snd shell_pairs in + let root = snd head in Some { shell_a = s_a ; shell_b = s_b ; coefficients ; exponents_inv ; shell_pairs ; center_ab = Psp.a_minus_b root; @@ -69,7 +68,7 @@ let make ?(cutoff=1.e-32) s_a s_b = let shell_a x = x.shell_a let shell_b x = x.shell_b -let shell_pairs x = x.shell_pairs +let shell_pairs x = Array.of_list x.shell_pairs let coefficients x = x.coefficients let exponents_inv x = x.exponents_inv let center_ab x = x.center_ab @@ -77,7 +76,7 @@ let norm_sq x = x.norm_sq let totAngMom x = x.totAngMom let norm_scales x = x.norm_scales -let monocentric x = Psp.monocentric x.shell_pairs.(0) +let monocentric x = Psp.monocentric (List.hd x.shell_pairs) (** Returns an integer characteristic of a contracted shell pair *) let hash a =