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

Pretty printers

Browse Source
This commit is contained in:
Anthony Scemama 2018-03-15 15:25:49 +01:00
parent 79f45c4aa2
commit cc3ae9b8a3
12 changed files with 447 additions and 59 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

17
Basis/ContractedShell.ml
View File

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

5
Basis/ContractedShell.mli
View File

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

129
Basis/ContractedShellPair.ml
View File

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

155
Basis/PrimitiveShellPair.ml Normal file
View File

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

113
Basis/PrimitiveShellPair.mli Normal file
View File

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

1
Basis/ShellPair.ml
View File

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

24
Utils/AngularMomentum.ml
View File

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

13
Utils/AngularMomentum.mli
View File

@ -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, ... *)

10
Utils/Coordinate.ml
View File

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

7
Utils/Coordinate.mli
View File

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

14
Utils/Util.ml
View File

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

18
Utils/Util.mli
View File

@ -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
]
]}
*)