Pretty printers

Basis/ContractedShell.ml

@@ -14,6 +14,7 @@ type t = {
 }
 
 module Am = AngularMomentum
+module Co = Coordinate
 module Ps = PrimitiveShell
 
 
@@ -88,3 +89,19 @@ let index x = x.index
 let size_of_shell x = Array.length x.norm_coef_scale
 
 let prim x = x.prim
+
+
+(** {2 Printers} *)
+
+let pp ppf x =
+  let open Format in
+  fprintf ppf "@[<2>{@ ";
+  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>center =@ %a ;@]@ " Co.pp_angstrom x.center;
+  fprintf ppf "@[<2>totAngMom =@ %a ;@]@ " Am.pp_string x.totAngMom;
+  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>index =@ %d ;@]@ " x.index;
+  fprintf ppf "}@,@]"
+

Basis/ContractedShell.mli

@@ -69,3 +69,8 @@ val index : t -> int
 val size_of_shell : t -> int
 (** Number of contracted functions in the shell. *)
 
+
+(** {2 Printers} *)
+
+val pp : Format.formatter -> t -> unit
+

Basis/ContractedShellPair.ml

@@ -17,87 +17,115 @@ type t =
 }
 
 
-module Am = AngularMomentum
-module Co = Coordinate
-module Cs = ContractedShell
-module Sp = ShellPair
+module Am  = AngularMomentum
+module Co  = Coordinate
+module Cs  = ContractedShell
+module Ps  = PrimitiveShell
+module Psp = PrimitiveShellPair
+module Sp  = ShellPair
 
 (** Creates an contracted shell pair : an array of pairs of primitive shells.
     A contracted shell with N functions combined with a contracted
     shell with M functions generates a NxM array of shell pairs.
 *)
-let create ?cutoff p_a p_b =
-  let cutoff, log_cutoff =
-    match cutoff with
-    | None -> -1., max_float
-    | Some cutoff -> cutoff, -. (log cutoff)
-  in
+let create ?(cutoff=1.e-32) s_a s_b =
+
+(*
+Format.printf "@[<2>shell_a :@ %a@]@;" Cs.pp s_a;
+Format.printf "@[<2>shell_b :@ %a@]@;" Cs.pp s_b;
+*)
+
+  let make = Psp.create_make_of (Cs.prim s_a).(0) (Cs.prim s_b).(0) in
+
+let center_ab = Co.( Cs.center s_a |- Cs.center s_b ) in
+
+(*
+Format.printf "@[center_ab :@ %a@]@;" Coordinate.pp_angstrom center_ab;
+Format.printf "@[a_minus_b :@ %a@]@." Coordinate.pp_angstrom (Psp.a_minus_b (
+    match make 0 (Cs.prim s_a).(0) 0 (Cs.prim s_b).(0) 0.
+  with Some x -> x | _ -> assert false));
+  *)
+
+let norm_sq = Co.dot center_ab center_ab in
+
+let norm_coef_scale_a =
+  Cs.norm_coef_scale s_a
+and norm_coef_scale_b =
+  Cs.norm_coef_scale s_b 
+in
+let norm_coef_scale =
+  Array.map (fun v1 ->
+    Array.map (fun v2 -> v1 *. v2) norm_coef_scale_b
+  ) norm_coef_scale_a
+  |> Array.to_list
+  |> Array.concat
+in
+
+assert (norm_coef_scale =  Psp.norm_coef_scale (
+  match make 0 (Cs.prim s_a).(0) 0 (Cs.prim s_b).(0) 0.
+  with Some x -> x | _ -> assert false));
 
-  let center_ab = Co.( Cs.center p_a |- Cs.center p_b )
-  in
-  let norm_sq =
-    Co.dot center_ab center_ab
-  in
-  let norm_coef_scale_a =
-    Cs. norm_coef_scale p_a
-  and norm_coef_scale_b =
-    Cs. norm_coef_scale p_b 
-  in
-  let norm_coef_scale =
-    Array.map (fun v1 ->
-      Array.map (fun v2 -> v1 *. v2) norm_coef_scale_b
-    ) norm_coef_scale_a
-    |> Array.to_list
-    |> Array.concat
-  in
   let shell_pairs = 
-    Array.init (Cs.size p_a) (fun i ->
-        let p_a_expo_center = Co.( (Cs.expo p_a).(i) |. Cs.center p_a ) in
-        let norm_coef_a = (Cs.norm_coef p_a).(i)  in
+    Array.init (Cs.size s_a) (fun i ->
+let p_a = (Cs.prim s_a).(i) in
+let p_a_expo_center = Co.( (Cs.expo s_a).(i) |. Cs.center s_a ) in
+let norm_coef_a = (Cs.norm_coef s_a).(i)  in
+assert (norm_coef_a = Ps.norm_coef p_a);
+
+        let make = make 0 p_a in
+
+        Array.init (Cs.size s_b) (fun j ->
+let p_b = (Cs.prim s_b).(j) in
 
-        Array.init (Cs.size p_b) (fun j ->
             try
-              let norm_coef_b = (Cs.norm_coef p_b).(j) in
-              let norm_coef   = norm_coef_a *. norm_coef_b
-              in
+              let sp = make 0 p_b cutoff in
+
+let sp_ = match sp with Some x -> x | None -> raise Null_contribution in
+
+              let norm_coef_b = (Cs.norm_coef s_b).(j) in
+assert (norm_coef_b = Ps.norm_coef p_b);
+
+              let norm_coef   = norm_coef_a *. norm_coef_b in
+
               if norm_coef < cutoff  then
                 raise Null_contribution;
-              let p_b_expo_center = Co.( (Cs.expo p_b).(j) |. Cs.center p_b ) in
-              let expo = (Cs.expo p_a).(i) +. (Cs.expo p_b).(j) in
+              let p_b_expo_center = Co.( (Cs.expo s_b).(j) |. Cs.center s_b ) in
+              let expo = (Cs.expo s_a).(i) +. (Cs.expo s_b).(j) in
               let expo_inv = 1. /. expo in
               let center = Co.(expo_inv |. (p_a_expo_center |+ p_b_expo_center ) )
               in
               let argexpo =
-                (Cs.expo p_a).(i) *. (Cs.expo p_b).(j) *. norm_sq *. expo_inv
+                (Cs.expo s_a).(i) *. (Cs.expo s_b).(j) *. norm_sq *. expo_inv
               in
-              if (argexpo > log_cutoff) then
-                raise Null_contribution;
               let g =
                 (pi *. expo_inv)**(1.5) *. exp (-. argexpo)
               in
               let coef =
-                norm_coef *. (Cs.coef p_a).(i) *. (Cs.coef p_b).(j) *. g
+                norm_coef *.  g
               in
               if abs_float coef  < cutoff then
                 raise Null_contribution;
               let center_a =
-                Co.(center |- Cs.center p_a)
+                Co.(center |- Cs.center s_a)
               in
               let monocentric =
-                Cs.(center p_a = center p_b)
+                Cs.(center s_a = center s_b)
               in
               let totAngMomInt = 
-                Am.(Cs.totAngMom p_a + Cs.totAngMom p_b)
+                Am.(Cs.totAngMom s_a + Cs.totAngMom s_b)
                 |> Am.to_int
               in
-              Some {
+assert (expo= Psp.expo sp_ );
+assert (expo_inv= Psp.expo_inv sp_ );
+assert (center= Psp.center sp_ );
+              Some ( (Cs.coef s_a).(i) *. (Cs.coef s_b).(j), {
                 Sp.i ; j ;
-                shell_a=p_a ; shell_b=p_b ;
-                norm_coef ; coef ;
+                shell_a=s_a ; shell_b=s_b ;
+                coef ;
                 expo ; expo_inv ;
                 center ; center_a ; center_ab ;
                 norm_sq ; monocentric ; totAngMomInt
-              }
+              })
             with
             | Null_contribution -> None
           )
@@ -109,11 +137,12 @@ let create ?cutoff p_a p_b =
     |> List.map (function Some x -> x | None -> assert false)
     |> Array.of_list
   in
-  let coef     = Array.map (fun x -> (fun y -> y.Sp.coef) x) shell_pairs
-  and expo_inv = Array.map (fun x -> (fun y -> y.Sp.expo_inv) x) shell_pairs
+  let coef     = Array.map (fun (c,y) -> c *. y.Sp.coef) shell_pairs
+  and expo_inv = Array.map (fun (_,y) -> y.Sp.expo_inv) shell_pairs
   in
+  let shell_pairs = Array.map snd shell_pairs in
   {
-    shell_a = p_a ; shell_b = p_b ; coef ; expo_inv ;
+    shell_a = s_a ; shell_b = s_b ; coef ; expo_inv ;
     shell_pairs ; center_ab=shell_pairs.(0).center_ab;
     norm_coef_scale ; norm_sq=shell_pairs.(0).norm_sq;
     totAngMomInt = shell_pairs.(0).Sp.totAngMomInt;

Basis/PrimitiveShellPair.ml

@@ -0,0 +1,155 @@
+open Util
+open Constants
+
+
+type t = {
+  expo            : float;              (* alpha + beta *)
+  expo_inv        : float;              (* 1/(alpha + beta) *)
+  center          : Coordinate.t;       (* P = (alpha * A + beta B)/(alpha+beta) *)
+  center_minus_a  : Coordinate.t;       (* P - A *)
+  a_minus_b       : Coordinate.t;       (* A - B *)
+  a_minus_b_sq    : float;              (* |A-B|^2 *)
+  norm_coef_scale : float array lazy_t;
+  norm_coef       : float;              (* norm_coef_a * norm_coef_b * g, with
+                     g = (pi/(alpha+beta))^(3/2) exp (-|A-B|^2 * alpha*beta/(alpha+beta)) *)
+  totAngMom       : AngularMomentum.t; 
+  shell_a         : PrimitiveShell.t;
+  shell_b         : PrimitiveShell.t;
+  (*TODO*)
+  i : int; j : int;
+}
+
+exception Null_contribution
+
+module Am = AngularMomentum
+module Co = Coordinate
+module Ps = PrimitiveShell
+
+(** Returns an integer characteristic of a primitive shell pair *)
+let hash a = 
+  Hashtbl.hash a
+
+let equivalent a b =
+  a = b
+(*
+  Hashtbl.hash (a.expo, a.center_a, a.center_ab, a.coef, ContractedShell.totAngMom a.shell_a, ContractedShell.totAngMom a.shell_b) 
+*)
+
+
+(** Comparison function, used for sorting *)
+let cmp a b =
+  hash a - hash b
+
+
+let create_make_of p_a p_b =
+
+  let a_minus_b = 
+    Co.( Ps.center p_a |- Ps.center p_b )
+  in
+
+  let a_minus_b_sq =
+    Co.dot a_minus_b a_minus_b
+  in
+
+  let norm_coef_scale = lazy (
+    Array.map (fun v1 ->
+        Array.map (fun v2 -> v1 *. v2) (Ps.norm_coef_scale p_b)
+      ) (Ps.norm_coef_scale p_a)
+    |> Array.to_list
+    |> Array.concat
+  ) in
+
+  let totAngMom =
+    Am.( Ps.totAngMom p_a + Ps.totAngMom p_b )
+  in
+
+  (* TODO *)
+  function i ->
+  function p_a -> 
+
+      let norm_coef_a =
+        Ps.norm_coef p_a
+      in
+
+      let alpha_a = (* p_a_expo_center *)
+        Co.( Ps.expo p_a |. Ps.center p_a )
+      in
+
+      (*TODO *)
+      function j ->
+      function p_b -> 
+
+          let norm_coef =
+            norm_coef_a *. Ps.norm_coef p_b
+          in
+
+          let expo =
+            Ps.expo p_a +. Ps.expo p_b
+          in
+
+          let expo_inv = 1. /. expo in
+
+          let norm_coef = 
+            let argexpo = 
+              Ps.expo p_a *. Ps.expo p_b *. a_minus_b_sq *. expo_inv
+            in
+            norm_coef *. (pi *. expo_inv)**1.5 *. exp (-. argexpo)
+          in
+
+          function cutoff ->
+
+              if abs_float norm_coef > cutoff then (
+
+                  let beta_b = 
+                    Co.( Ps.expo p_b |. Ps.center p_b )
+                  in
+
+                  let center =
+                    Co.(expo_inv |. (alpha_a |+ beta_b))
+                  in
+
+                  let center_minus_a = 
+                    Co.(center |- Ps.center p_a)
+                  in
+
+                  Some {
+                    i ; j ; totAngMom ; 
+                    expo ; expo_inv ; center ; center_minus_a ; a_minus_b ; 
+                    a_minus_b_sq ; norm_coef ; norm_coef_scale ; shell_a = p_a;
+                    shell_b = p_b }
+
+              )
+              else None
+
+      
+let make p_a p_b =
+  let f =
+    create_make_of p_a p_b
+  in
+  match f 0 p_a 0 p_b 0. with
+  | Some result -> result
+  | None -> assert false
+
+
+let norm_coef_scale x =
+  Lazy.force x.norm_coef_scale
+
+let expo_inv x = x.expo_inv
+
+let monocentric x =
+  Ps.center x.shell_a = Ps.center x.shell_b
+
+
+let totAngMom x = x.totAngMom
+
+let a_minus_b x = x.a_minus_b
+
+let a_minus_b_sq x = x.a_minus_b_sq
+
+let center_minus_a x = x.center_minus_a
+
+let norm_coef x = x.norm_coef
+
+let expo x = x.expo
+
+let center x = x.center

Basis/PrimitiveShellPair.mli

@@ -0,0 +1,113 @@
+(** Data structure describing a pair of primitive shells.
+
+A primitive shell pair is the cartesian product between two sets of functions, each
+set containing all the functions of a primitive shell.
+
+{% \\[
+  \left\\{ p_{k_x,k_y,k_z}(\mathbf{r}) \right\\} =
+      \left\\{ g_{n_x,n_y,n_z}(\mathbf{r}) \right\\} \times
+      \left\\{ g_{m_x,m_y,m_z}'(\mathbf{r}) \right\\}
+\\] %}
+
+where
+      
+{%
+\begin{align*}
+  g_{n_x,n_y,n_z}(\mathbf{r})  & =
+      (x-X_A)^{n_x} (y-Y_A)^{n_y} (z-Z_A)^{n_z} 
+      \exp \left( -\alpha |\mathbf{r}-\mathbf{A}|^2 \right) \\
+  g_{m_x,m_y,m_z}'(\mathbf{r}) & =
+      (x-X_B)^{m_x} (y-Y_B)^{m_y} (z-Z_B)^{m_z}
+      \exp \left( -\beta |\mathbf{r}-\mathbf{B}|^2 \right) 
+\end{align*}
+%}
+
+Following Ref [1], we define three quantities associated with the shells on centers A and B:
+
+{%
+\begin{align*}
+\sigma_P & = \frac{1}{\alpha + \beta} \\
+\mathbf{P} & = \left( \alpha \mathbf{A} + \beta \mathbf{B} \right) \, \sigma_P \\
+U_P & = (\pi\,\sigma_P)^{3/2} \exp \left( \alpha \beta \sigma_P |\mathbf{A}-\mathbf{B}|^2 \right)
+\end{align*}
+%}
+
+
+
+References:
+
+[1] {{:http://dx.doi.org/10.1002/qua.560400604} P.M. Gill, B.G. Johnson, and J.A. Pople, International Journal of Quantum Chemistry 40, 745 (1991)}.
+*)
+
+type t = {
+  expo            : float;              (* alpha + beta *)
+  expo_inv        : float;              (* 1/(alpha + beta) *)
+  center          : Coordinate.t;       (* P = (alpha * A + beta B)/(alpha+beta) *)
+  center_minus_a  : Coordinate.t;       (* P - A *)
+  a_minus_b       : Coordinate.t;       (* A - B *)
+  a_minus_b_sq    : float;              (* |A-B|^2 *)
+  norm_coef_scale : float array lazy_t;
+  norm_coef       : float;              (* norm_coef_a * norm_coef_b * g, with
+                                           g = (pi/(alpha+beta))^(3/2) exp (-|A-B|^2 * alpha*beta/(alpha+beta)) *)
+  totAngMom       : AngularMomentum.t;
+  shell_a         : PrimitiveShell.t;
+  shell_b         : PrimitiveShell.t;
+  i : int; (*TODO remove *)
+  j : int; (*TODO remove *)
+}
+
+
+
+val make : PrimitiveShell.t -> PrimitiveShell.t -> t
+(** Creates a primitive shell pair using two primitive shells. *)
+
+val create_make_of : PrimitiveShell.t -> PrimitiveShell.t ->
+  (int -> PrimitiveShell.t -> int -> PrimitiveShell.t -> float -> t option)
+  (* TODO
+  (PrimitiveShell.t -> PrimitiveShell.t -> float -> t option)
+  *)
+(** Creates a make function [PrimitiveShell.t -> PrimitiveShell.t -> float -> t] in which
+    all the quantities common to the shell and independent of the exponent
+    are pre-computed.
+
+    The result is None if the normalization coefficient of the resulting
+    function is below the cutoff, given as a last argument.
+
+*)
+
+val equivalent : t -> t -> bool
+
+val hash : t -> int
+
+val cmp : t -> t -> int
+
+val monocentric : t -> bool
+
+val center : t -> Coordinate.t
+(** Coordinates of the center {%$\mathbf{P}$%}. *)
+
+val norm_coef_scale : t -> float array
+
+val expo : t -> float
+(** {% \\[ \alpha + \beta \\] %}*)
+
+val expo_inv : t -> float 
+(** {% \\[ \frac{1}{\alpha + \beta} \\] %}*)
+
+val totAngMom : t -> AngularMomentum.t
+(** Total angular momentum of the shell pair: sum of the angular momenta of
+    the shells.
+*)
+
+val a_minus_b : t -> Coordinate.t
+(** {% $\mathbf{A}-\mathbf{B}$ %} *)
+
+val a_minus_b_sq : t -> float
+(** {% $|\mathbf{A}-\mathbf{B}|^2$ %} *)
+
+val center_minus_a : t -> Coordinate.t
+(** {% $\mathbf{P}-\mathbf{A}$ %} *)
+
+val norm_coef : t -> float
+(** Normalization coefficient of the shell pair. *)
+

Basis/ShellPair.ml

@@ -8,7 +8,6 @@ type t = {
   center_a : Coordinate.t;       (* P - A *)
   center_ab: Coordinate.t;       (* A - B *)
   norm_sq  : float;              (* |A-B|^2 *)
-  norm_coef: float;              (* norm_coef_a * norm_coef_b *)
   coef     : float;              (* norm_coef * coef_a * coef_b * g, with
                                     g = (pi/(alpha+beta))^(3/2) exp (-|A-B|^2 * alpha*beta/(alpha+beta)) *)
   totAngMomInt : int ; 

Utils/AngularMomentum.ml

@@ -2,8 +2,9 @@ open Powers
 
 exception AngularMomentumError of string
 
-type t = 
-  | S | P | D | F | G | H | I | J | K | L | M | N | O
+type t =
+   | S | P | D | F | G | H | I | J | K | L | M | N | O 
+   | Int of int
 
 let of_char = function
   | 's' | 'S' -> S      | 'p' | 'P' -> P
@@ -22,7 +23,7 @@ let to_string = function
   | I -> "I"       | J -> "J"
   | K -> "K"       | L -> "L"
   | M -> "M"       | N -> "N"
-  | O -> "O"
+  | O -> "O"       | Int i -> string_of_int i
 
 let to_char = function
   | S -> 'S'       | P -> 'P'
@@ -31,7 +32,7 @@ let to_char = function
   | I -> 'I'       | J -> 'J'
   | K -> 'K'       | L -> 'L'
   | M -> 'M'       | N -> 'N'
-  | O -> 'O'
+  | O -> 'O'       | Int i -> '_'
 
 let to_int = function
   | S -> 0         | P -> 1
@@ -40,7 +41,8 @@ let to_int = function
   | I -> 6         | J -> 7
   | K -> 8         | L -> 9
   | M -> 10        | N -> 11
-  | O -> 12
+  | O -> 12        | Int i -> i
+
 
 let of_int = function
   | 0 -> S         | 1 -> P
@@ -49,8 +51,7 @@ let of_int = function
   | 6 -> I         | 7 -> J
   | 8 -> K         | 9 -> L
   | 10 -> M        | 11 -> N
-  | 12 -> O
-  | c -> raise (AngularMomentumError (string_of_int c))
+  | 12 -> O        | i -> Int i
 
 
 
@@ -151,3 +152,12 @@ let ( + ) a b =
 let ( - ) a b =
   of_int ( (to_int a) - (to_int b) )
 
+
+(** {2 Printers} *)
+
+let pp_string ppf x =
+  Format.fprintf ppf "@[%s@]" (to_string x)
+
+let pp_int ppf x =
+  Format.fprintf ppf "@[%d@]" (to_int x)
+

Utils/AngularMomentum.mli

@@ -1,6 +1,8 @@
 (** Azimuthal quantum number, represented as {% $s,p,d,\dots$ %} *)
 
-type t = S | P | D | F | G | H | I | J | K | L | M | N | O
+type t =
+ | S | P | D | F | G | H | I | J | K | L | M | N | O
+ | Int of int
 
 exception AngularMomentumError of string
 (** Raised when the {!AngularMomentum.t} element can't be created.
@@ -89,3 +91,12 @@ val zkey_array : kind -> Zkey.t array
 val ( + ) : t -> t -> t
 val ( - ) : t -> t -> t
 
+
+(** {2 Printers} *)
+  
+val pp_string : Format.formatter -> t -> unit
+(** Prints as a string S, P, D, ... *)
+
+val pp_int : Format.formatter -> t -> unit
+(** Prints as an integer 0, 1, 2, ... *)
+

Utils/Coordinate.ml

@@ -75,3 +75,13 @@ let get axis { Bohr.x ; y ; z } =
   | X -> x 
   | Y -> y 
   | Z -> z  
+
+
+let pp_bohr ppf c = 
+  let open Bohr in
+  Format.fprintf ppf "@[(@[%10f@], @[%10f@], @[%10f@] Bohr)@]" c.x c.y c.z
+
+let pp_angstrom ppf c = 
+  let c = bohr_to_angstrom c in
+  let open Angstrom in
+  Format.fprintf ppf "@[(@[%10f@], @[%10f@], @[%10f@] Angs)@]" c.x c.y c.z

Utils/Coordinate.mli

@@ -81,3 +81,10 @@ val dot : Bohr.t -> Bohr.t -> float
 val norm : Bohr.t -> float
 (** L{^2} norm of the vector. *)
 
+
+(** {2 Printers} *)
+
+val pp_bohr: Format.formatter -> Bohr.t -> unit
+
+val pp_angstrom : Format.formatter -> Bohr.t -> unit
+

Utils/Util.ml

@@ -173,3 +173,17 @@ let xt_o_x ~o ~x =
   |> gemm ~transa:`T x
 
 
+
+
+(** {2 Printers} *)
+
+let pp_float_array_size ppf a = 
+  Format.fprintf ppf "@[<2>[@ %d: " (Array.length a);
+  Array.iter (fun f -> Format.fprintf ppf "@[%10f@]@ " f) a;
+  Format.fprintf ppf "]@]"
+
+let pp_float_array ppf a = 
+  Format.fprintf ppf "@[<2>[@ ";
+  Array.iter (fun f -> Format.fprintf ppf "@[%10f@]@ " f) a;
+  Format.fprintf ppf "]@]"
+

Utils/Util.mli

@@ -65,3 +65,21 @@ val diagonalize_symm : Lacaml.D.mat -> Lacaml.D.mat * Lacaml.D.vec
 val xt_o_x : o:Lacaml.D.mat -> x:Lacaml.D.mat -> Lacaml.D.mat
 (** Computes X{^T}.O.X *)
 
+
+(** {2 Printers} *)
+val pp_float_array_size : Format.formatter -> float array -> unit
+(** Example:
+{[
+[ 6:   1.000000   1.732051   1.732051   1.000000   1.732051   1.000000
+  ]
+]}
+*)
+
+val pp_float_array : Format.formatter -> float array -> unit
+(** Example:
+{[
+[    1.000000   1.732051   1.732051   1.000000   1.732051   1.000000
+  ]
+]}
+*)
+