mirror of
https://gitlab.com/scemama/QCaml.git
synced 2024-09-12 06:28:31 +02:00
Remove org-mode
This commit is contained in:
parent
d53c0e6ea3
commit
c4b022aeee
@ -12,6 +12,7 @@
|
|||||||
qcaml.gaussian_integrals
|
qcaml.gaussian_integrals
|
||||||
qcaml.operators
|
qcaml.operators
|
||||||
)
|
)
|
||||||
|
(instrumentation (backend landmarks))
|
||||||
(modules_without_implementation ao_dim)
|
(modules_without_implementation ao_dim)
|
||||||
|
|
||||||
)
|
)
|
||||||
|
@ -1,96 +0,0 @@
|
|||||||
#+begin_src elisp tangle: no :results none :exports none
|
|
||||||
(setq pwd (file-name-directory buffer-file-name))
|
|
||||||
(setq name (file-name-nondirectory (substring buffer-file-name 0 -4)))
|
|
||||||
(setq lib (concat pwd "lib/"))
|
|
||||||
(setq testdir (concat pwd "test/"))
|
|
||||||
(setq mli (concat lib name ".mli"))
|
|
||||||
(setq ml (concat lib name ".ml"))
|
|
||||||
(setq test-ml (concat testdir name ".ml"))
|
|
||||||
(org-babel-tangle)
|
|
||||||
#+end_src
|
|
||||||
|
|
||||||
|
|
||||||
* Charge
|
|
||||||
:PROPERTIES:
|
|
||||||
:header-args: :noweb yes :comments both
|
|
||||||
:END:
|
|
||||||
|
|
||||||
** Type
|
|
||||||
|
|
||||||
<<<~Charge.t~>>>
|
|
||||||
#+begin_src ocaml :tangle (eval mli)
|
|
||||||
type t
|
|
||||||
#+end_src
|
|
||||||
|
|
||||||
This type should be used for all charges in the program (electrons, nuclei,...).
|
|
||||||
|
|
||||||
#+begin_src ocaml :tangle (eval ml) :exports none
|
|
||||||
type t = float
|
|
||||||
#+end_src
|
|
||||||
|
|
||||||
** Conversions
|
|
||||||
|
|
||||||
#+begin_src ocaml :tangle (eval mli)
|
|
||||||
val of_float : float -> t
|
|
||||||
val to_float : t -> float
|
|
||||||
|
|
||||||
val of_int : int -> t
|
|
||||||
val to_int : t -> int
|
|
||||||
|
|
||||||
val of_string: string -> t
|
|
||||||
val to_string: t -> string
|
|
||||||
#+end_src
|
|
||||||
|
|
||||||
#+begin_src ocaml :tangle (eval ml) :exports none
|
|
||||||
external of_float : float -> t = "%identity"
|
|
||||||
external to_float : t -> float = "%identity"
|
|
||||||
|
|
||||||
let of_int = float_of_int
|
|
||||||
let to_int = int_of_float
|
|
||||||
|
|
||||||
let of_string = float_of_string
|
|
||||||
|
|
||||||
let to_string x =
|
|
||||||
if x > 0. then
|
|
||||||
Printf.sprintf "+%f" x
|
|
||||||
else if x < 0. then
|
|
||||||
Printf.sprintf "%f" x
|
|
||||||
else
|
|
||||||
"0.0"
|
|
||||||
#+end_src
|
|
||||||
|
|
||||||
** Simple operations
|
|
||||||
|
|
||||||
#+begin_src ocaml :tangle (eval mli)
|
|
||||||
val ( + ) : t -> t -> t
|
|
||||||
val ( - ) : t -> t -> t
|
|
||||||
val ( * ) : t -> float -> t
|
|
||||||
val ( / ) : t -> float -> t
|
|
||||||
val is_null : t -> bool
|
|
||||||
#+end_src
|
|
||||||
|
|
||||||
#+begin_src ocaml :tangle (eval ml) :exports none
|
|
||||||
let gen_op op =
|
|
||||||
fun a b ->
|
|
||||||
op (to_float a) (to_float b)
|
|
||||||
|> of_float
|
|
||||||
|
|
||||||
let ( + ) = gen_op ( +. )
|
|
||||||
let ( - ) = gen_op ( -. )
|
|
||||||
let ( * ) = gen_op ( *. )
|
|
||||||
let ( / ) = gen_op ( /. )
|
|
||||||
|
|
||||||
let is_null t = t == 0.
|
|
||||||
#+end_src
|
|
||||||
|
|
||||||
** Printers
|
|
||||||
|
|
||||||
#+begin_src ocaml :tangle (eval mli)
|
|
||||||
val pp : Format.formatter -> t -> unit
|
|
||||||
#+end_src
|
|
||||||
|
|
||||||
#+begin_src ocaml :tangle (eval ml) :exports none
|
|
||||||
let pp ppf x =
|
|
||||||
Format.fprintf ppf "@[%s@]" (to_string x)
|
|
||||||
#+end_src
|
|
||||||
|
|
@ -1,354 +0,0 @@
|
|||||||
#+begin_src elisp tangle: no :results none :exports none
|
|
||||||
(setq pwd (file-name-directory buffer-file-name))
|
|
||||||
(setq name (file-name-nondirectory (substring buffer-file-name 0 -4)))
|
|
||||||
(setq lib (concat pwd "lib/"))
|
|
||||||
(setq testdir (concat pwd "test/"))
|
|
||||||
(setq mli (concat lib name ".mli"))
|
|
||||||
(setq ml (concat lib name ".ml"))
|
|
||||||
(setq test-ml (concat testdir name ".ml"))
|
|
||||||
(org-babel-tangle)
|
|
||||||
#+end_src
|
|
||||||
|
|
||||||
* Command line
|
|
||||||
:PROPERTIES:
|
|
||||||
:header-args: :noweb yes :comments both
|
|
||||||
:END:
|
|
||||||
|
|
||||||
This module is a wrapper around the ~Getopt~ library and helps to
|
|
||||||
define command-line arguments.
|
|
||||||
|
|
||||||
Here is an example of how to use this module.
|
|
||||||
First, define the specification:
|
|
||||||
#+begin_src ocaml :tangle no
|
|
||||||
let open Command_line in
|
|
||||||
begin
|
|
||||||
set_header_doc (Sys.argv.(0) ^ " - One-line description");
|
|
||||||
set_description_doc "Long description of the command.";
|
|
||||||
set_specs
|
|
||||||
[ { short='c'; long="check"; opt=Optional;
|
|
||||||
doc="Checks the input data";
|
|
||||||
arg=Without_arg; };
|
|
||||||
|
|
||||||
{ short='b' ; long="basis" ; opt=Mandatory;
|
|
||||||
arg=With_arg "<string>";
|
|
||||||
doc="Name of the file containing the basis set"; } ;
|
|
||||||
|
|
||||||
{ short='m' ; long="multiplicity" ; opt=Optional;
|
|
||||||
arg=With_arg "<int>";
|
|
||||||
doc="Spin multiplicity (2S+1). Default is singlet"; } ;
|
|
||||||
]
|
|
||||||
end;
|
|
||||||
#+end_src
|
|
||||||
|
|
||||||
Then, define what to do with the arguments:
|
|
||||||
#+begin_src ocaml :tangle no
|
|
||||||
let c =
|
|
||||||
Command_line.get_bool "check"
|
|
||||||
in
|
|
||||||
|
|
||||||
let basis =
|
|
||||||
match Command_line.get "basis" with
|
|
||||||
| Some x -> x
|
|
||||||
| None -> assert false
|
|
||||||
in
|
|
||||||
|
|
||||||
let multiplicity =
|
|
||||||
match Command_line.get "multiplicity" with
|
|
||||||
| None -> 1
|
|
||||||
| Some n -> int_of_string n
|
|
||||||
in
|
|
||||||
#+end_src
|
|
||||||
|
|
||||||
** Types
|
|
||||||
|
|
||||||
#+NAME:type
|
|
||||||
#+begin_src ocaml :tangle (eval mli)
|
|
||||||
type short_opt = char
|
|
||||||
type long_opt = string
|
|
||||||
type optional = Mandatory | Optional
|
|
||||||
type documentation = string
|
|
||||||
type argument = | With_arg of string
|
|
||||||
| Without_arg
|
|
||||||
| With_opt_arg of string
|
|
||||||
|
|
||||||
type description = {
|
|
||||||
short: short_opt ;
|
|
||||||
long : long_opt ;
|
|
||||||
opt : optional ;
|
|
||||||
doc : documentation ;
|
|
||||||
arg : argument ;
|
|
||||||
}
|
|
||||||
|
|
||||||
#+end_src
|
|
||||||
|
|
||||||
- <<<Short option>>>: in the command line, a dash with a single character
|
|
||||||
(ex: =ls -l=)
|
|
||||||
- <<<Long option>>>: in the command line, two dashes with a word
|
|
||||||
(ex: =ls --directory=)
|
|
||||||
- Command-line options can be ~Mandatory~ or ~Optional~
|
|
||||||
- Documentation of the option is used in the help function
|
|
||||||
- Some options require an argument (~ls --ignore="*.ml"~ ), some
|
|
||||||
don't (~ls -l~) and for some arguments the argument is optional
|
|
||||||
(~git --log[=<n>]~)
|
|
||||||
|
|
||||||
#+begin_src ocaml :tangle (eval ml) :exports none
|
|
||||||
<<type>>
|
|
||||||
#+end_src
|
|
||||||
|
|
||||||
** Mutable attributes
|
|
||||||
|
|
||||||
All the options are stored in the hash table ~dict~ where the key
|
|
||||||
is the long option and the value is a value of type ~description~.
|
|
||||||
|
|
||||||
#+begin_src ocaml :tangle (eval ml) :exports none
|
|
||||||
let header_doc = ref ""
|
|
||||||
let description_doc = ref ""
|
|
||||||
let footer_doc = ref ""
|
|
||||||
let anon_args_ref = ref []
|
|
||||||
let specs = ref []
|
|
||||||
let dict = Hashtbl.create 67
|
|
||||||
#+end_src
|
|
||||||
|
|
||||||
#+begin_src ocaml :tangle (eval mli)
|
|
||||||
val set_header_doc : string -> unit
|
|
||||||
val set_description_doc : string -> unit
|
|
||||||
val set_footer_doc : string -> unit
|
|
||||||
#+end_src
|
|
||||||
|
|
||||||
Functions to set the header, footer and main description of the
|
|
||||||
documentation provided by the ~help~ function:
|
|
||||||
|
|
||||||
#+begin_src ocaml :tangle (eval ml) :exports none
|
|
||||||
let set_header_doc s = header_doc := s
|
|
||||||
let set_description_doc s = description_doc := s
|
|
||||||
let set_footer_doc s = footer_doc := s
|
|
||||||
#+end_src
|
|
||||||
|
|
||||||
|
|
||||||
#+begin_src ocaml :tangle (eval mli)
|
|
||||||
val anonymous : long_opt -> optional -> documentation -> description
|
|
||||||
#+end_src
|
|
||||||
|
|
||||||
Function to create an anonymous argument.
|
|
||||||
|
|
||||||
#+begin_src ocaml :tangle (eval ml) :exports none
|
|
||||||
let anonymous name opt doc =
|
|
||||||
{ short=' ' ; long=name; opt; doc; arg=Without_arg; }
|
|
||||||
#+end_src
|
|
||||||
|
|
||||||
** Text formatting functions :noexport:
|
|
||||||
|
|
||||||
Function to print some text such that it fits on the screen
|
|
||||||
|
|
||||||
#+begin_src ocaml :tangle (eval ml) :exports none
|
|
||||||
let output_text t =
|
|
||||||
Format.printf "@[<v 0>";
|
|
||||||
begin
|
|
||||||
match Str.split (Str.regexp "\n") t with
|
|
||||||
| x :: [] ->
|
|
||||||
Format.printf "@[<hov 0>";
|
|
||||||
Str.split (Str.regexp " ") x
|
|
||||||
|> List.iter (fun y -> Format.printf "@[%s@]@ " y) ;
|
|
||||||
Format.printf "@]"
|
|
||||||
| t ->
|
|
||||||
List.iter (fun x ->
|
|
||||||
Format.printf "@[<hov 0>";
|
|
||||||
Str.split (Str.regexp " ") x
|
|
||||||
|> List.iter (fun y -> Format.printf "@[%s@]@ " y) ;
|
|
||||||
Format.printf "@]@;"
|
|
||||||
) t
|
|
||||||
end;
|
|
||||||
Format.printf "@]"
|
|
||||||
#+end_src
|
|
||||||
|
|
||||||
|
|
||||||
Function to build the short description of the command-line
|
|
||||||
arguments, such as
|
|
||||||
|
|
||||||
Example:
|
|
||||||
#+begin_example
|
|
||||||
my_program -b <string> [-h] [-u <float>] -x <string> [--]
|
|
||||||
#+end_example
|
|
||||||
|
|
||||||
#+begin_src ocaml :tangle (eval ml) :exports none
|
|
||||||
let output_short x =
|
|
||||||
match x.short, x.opt, x.arg with
|
|
||||||
| ' ', Mandatory, _ -> Format.printf "@[%s@]" x.long
|
|
||||||
| ' ', Optional , _ -> Format.printf "@[[%s]@]" x.long
|
|
||||||
| _ , Mandatory, Without_arg -> Format.printf "@[-%c@]" x.short
|
|
||||||
| _ , Optional , Without_arg -> Format.printf "@[[-%c]@]" x.short
|
|
||||||
| _ , Mandatory, With_arg arg -> Format.printf "@[-%c %s@]" x.short arg
|
|
||||||
| _ , Optional , With_arg arg -> Format.printf "@[[-%c %s]@]" x.short arg
|
|
||||||
| _ , Mandatory, With_opt_arg arg -> Format.printf "@[-%c [%s]@]" x.short arg
|
|
||||||
| _ , Optional , With_opt_arg arg -> Format.printf "@[[-%c [%s]]@]" x.short arg
|
|
||||||
#+end_src
|
|
||||||
|
|
||||||
|
|
||||||
Function to build the long description of the command-line
|
|
||||||
arguments, such as
|
|
||||||
|
|
||||||
Example:
|
|
||||||
#+begin_example
|
|
||||||
-x --xyz=<string> Name of the file containing the nuclear
|
|
||||||
coordinates in xyz format
|
|
||||||
#+end_example
|
|
||||||
|
|
||||||
#+begin_src ocaml :tangle (eval ml) :exports none
|
|
||||||
let output_long max_width x =
|
|
||||||
let arg =
|
|
||||||
match x.short, x.arg with
|
|
||||||
| ' ' , _ -> x.long
|
|
||||||
| _ , Without_arg -> x.long
|
|
||||||
| _ , With_arg arg -> Printf.sprintf "%s=%s" x.long arg
|
|
||||||
| _ , With_opt_arg arg -> Printf.sprintf "%s[=%s]" x.long arg
|
|
||||||
in
|
|
||||||
let long =
|
|
||||||
let l = String.length arg in
|
|
||||||
arg^(String.make (max_width-l) ' ')
|
|
||||||
in
|
|
||||||
Format.printf "@[<v 0>";
|
|
||||||
begin
|
|
||||||
match x.short with
|
|
||||||
| ' ' -> Format.printf "@[%s @]" long
|
|
||||||
| short -> Format.printf "@[-%c --%s @]" short long
|
|
||||||
end;
|
|
||||||
Format.printf "@]";
|
|
||||||
output_text x.doc
|
|
||||||
#+end_src
|
|
||||||
|
|
||||||
** Query functions
|
|
||||||
|
|
||||||
#+begin_src ocaml :tangle (eval mli)
|
|
||||||
val get : long_opt -> string option
|
|
||||||
val get_bool : long_opt -> bool
|
|
||||||
val anon_args : unit -> string list
|
|
||||||
#+end_src
|
|
||||||
|
|
||||||
| ~get~ | Returns the argument associated with a long option |
|
|
||||||
| ~get_bool~ | True if the ~Optional~ argument is present in the command-line |
|
|
||||||
| ~anon_args~ | Returns the list of anonymous arguments |
|
|
||||||
|
|
||||||
|
|
||||||
#+begin_src ocaml :tangle (eval ml) :exports none
|
|
||||||
let anon_args () = !anon_args_ref
|
|
||||||
|
|
||||||
let help () =
|
|
||||||
|
|
||||||
(* Print the header *)
|
|
||||||
output_text !header_doc;
|
|
||||||
Format.printf "@.@.";
|
|
||||||
|
|
||||||
(* Find the anonymous arguments *)
|
|
||||||
let anon =
|
|
||||||
List.filter (fun x -> x.short = ' ') !specs
|
|
||||||
in
|
|
||||||
|
|
||||||
(* Find the options *)
|
|
||||||
let options =
|
|
||||||
List.filter (fun x -> x.short <> ' ') !specs
|
|
||||||
|> List.sort (fun x y -> Char.compare x.short y.short)
|
|
||||||
in
|
|
||||||
|
|
||||||
(* Find column lengths *)
|
|
||||||
let max_width =
|
|
||||||
List.map (fun x ->
|
|
||||||
( match x.arg with
|
|
||||||
| Without_arg -> String.length x.long
|
|
||||||
| With_arg arg -> String.length x.long + String.length arg
|
|
||||||
| With_opt_arg arg -> String.length x.long + String.length arg + 2
|
|
||||||
)
|
|
||||||
+ ( if x.opt = Optional then 2 else 0)
|
|
||||||
) !specs
|
|
||||||
|> List.fold_left max 0
|
|
||||||
in
|
|
||||||
|
|
||||||
|
|
||||||
(* Print usage *)
|
|
||||||
Format.printf "@[<v>@[<v 2>Usage:@,@,@[<hov 4>@[%s@]" Sys.argv.(0);
|
|
||||||
List.iter (fun x -> Format.printf "@ "; output_short x) options;
|
|
||||||
Format.printf "@ @[[--]@]";
|
|
||||||
List.iter (fun x -> Format.printf "@ "; output_short x;) anon;
|
|
||||||
Format.printf "@]@,@]@,";
|
|
||||||
|
|
||||||
|
|
||||||
(* Print arguments and doc *)
|
|
||||||
Format.printf "@[<v 2>Arguments:@,";
|
|
||||||
Format.printf "@[<v 0>" ;
|
|
||||||
List.iter (fun x -> Format.printf "@ "; output_long max_width x) anon;
|
|
||||||
Format.printf "@]@,@]@,";
|
|
||||||
|
|
||||||
|
|
||||||
(* Print options and doc *)
|
|
||||||
Format.printf "@[<v 2>Options:@,";
|
|
||||||
|
|
||||||
Format.printf "@[<v 0>" ;
|
|
||||||
List.iter (fun x -> Format.printf "@ "; output_long max_width x) options;
|
|
||||||
Format.printf "@]@,@]@,";
|
|
||||||
|
|
||||||
|
|
||||||
(* Print footer *)
|
|
||||||
if !description_doc <> "" then
|
|
||||||
begin
|
|
||||||
Format.printf "@[<v 2>Description:@,@,";
|
|
||||||
output_text !description_doc;
|
|
||||||
Format.printf "@,"
|
|
||||||
end;
|
|
||||||
|
|
||||||
(* Print footer *)
|
|
||||||
output_text !footer_doc;
|
|
||||||
Format.printf "@."
|
|
||||||
|
|
||||||
|
|
||||||
let get x =
|
|
||||||
try Some (Hashtbl.find dict x)
|
|
||||||
with Not_found -> None
|
|
||||||
|
|
||||||
|
|
||||||
let get_bool x = Hashtbl.mem dict x
|
|
||||||
#+end_src
|
|
||||||
|
|
||||||
** Specification
|
|
||||||
|
|
||||||
#+begin_src ocaml :tangle (eval mli)
|
|
||||||
val set_specs : description list -> unit
|
|
||||||
#+end_src
|
|
||||||
|
|
||||||
Sets the specifications of the current program from a list of
|
|
||||||
~descrption~ variables.
|
|
||||||
|
|
||||||
#+begin_src ocaml :tangle (eval ml) :exports none
|
|
||||||
let set_specs specs_in =
|
|
||||||
specs := { short = 'h' ;
|
|
||||||
long = "help" ;
|
|
||||||
doc = "Prints the help message." ;
|
|
||||||
arg = Without_arg ;
|
|
||||||
opt = Optional ;
|
|
||||||
} :: specs_in;
|
|
||||||
|
|
||||||
let cmd_specs =
|
|
||||||
List.filter (fun x -> x.short != ' ') !specs
|
|
||||||
|> List.map (fun { short ; long ; arg ; _ } ->
|
|
||||||
match arg with
|
|
||||||
| With_arg _ ->
|
|
||||||
(short, long, None, Some (fun x -> Hashtbl.replace dict long x) )
|
|
||||||
| Without_arg ->
|
|
||||||
(short, long, Some (fun () -> Hashtbl.replace dict long ""), None)
|
|
||||||
| With_opt_arg _ ->
|
|
||||||
(short, long, Some (fun () -> Hashtbl.replace dict long ""),
|
|
||||||
Some (fun x -> Hashtbl.replace dict long x) )
|
|
||||||
)
|
|
||||||
in
|
|
||||||
|
|
||||||
Getopt.parse_cmdline cmd_specs (fun x -> anon_args_ref := !anon_args_ref @ [x]);
|
|
||||||
|
|
||||||
if (get_bool "help") then
|
|
||||||
(help () ; exit 0);
|
|
||||||
|
|
||||||
(* Check that all mandatory arguments are set *)
|
|
||||||
List.filter (fun x -> x.short <> ' ' && x.opt = Mandatory) !specs
|
|
||||||
|> List.iter (fun x ->
|
|
||||||
match get x.long with
|
|
||||||
| Some _ -> ()
|
|
||||||
| None -> failwith ("Error: --"^x.long^" option is missing.")
|
|
||||||
)
|
|
||||||
#+end_src
|
|
@ -1,79 +0,0 @@
|
|||||||
#+begin_src elisp tangle: no :results none :exports none
|
|
||||||
(setq pwd (file-name-directory buffer-file-name))
|
|
||||||
(setq name (file-name-nondirectory (substring buffer-file-name 0 -4)))
|
|
||||||
(setq lib (concat pwd "lib/"))
|
|
||||||
(setq testdir (concat pwd "test/"))
|
|
||||||
(setq mli (concat lib name ".mli"))
|
|
||||||
(setq ml (concat lib name ".ml"))
|
|
||||||
(setq test-ml (concat testdir name ".ml"))
|
|
||||||
(org-babel-tangle)
|
|
||||||
#+end_src
|
|
||||||
|
|
||||||
* Constants
|
|
||||||
:PROPERTIES:
|
|
||||||
:header-args: :noweb yes :comments both
|
|
||||||
:END:
|
|
||||||
All constants used in the program.
|
|
||||||
|
|
||||||
** Thresholds
|
|
||||||
|
|
||||||
#+begin_src ocaml :tangle (eval mli)
|
|
||||||
val epsilon : float
|
|
||||||
val integrals_cutoff : float
|
|
||||||
#+end_src
|
|
||||||
|
|
||||||
| ~epsilon~ | Value below which a float is considered null. Default is \epsilon = 2.10^{-15} |
|
|
||||||
| ~integrals_cutoff~ | Cutoff value for integrals. Default is \epsilon |
|
|
||||||
|
|
||||||
#+begin_src ocaml :tangle (eval ml) :exports none
|
|
||||||
let epsilon = 2.e-15
|
|
||||||
let integrals_cutoff = epsilon
|
|
||||||
#+end_src
|
|
||||||
|
|
||||||
** Mathematical constants
|
|
||||||
|
|
||||||
#+begin_src ocaml :tangle (eval mli)
|
|
||||||
val pi : float
|
|
||||||
val two_pi : float
|
|
||||||
val sq_pi : float
|
|
||||||
val sq_pi_over_two : float
|
|
||||||
val pi_inv : float
|
|
||||||
val two_over_sq_pi : float
|
|
||||||
#+end_src
|
|
||||||
|
|
||||||
| ~pi~ | $\pi = 3.141~592~653~589~793~12$ |
|
|
||||||
| ~two_pi~ | $2 \pi$ |
|
|
||||||
| ~sq_pi~ | $\sqrt{\pi}$ |
|
|
||||||
| ~sq_pi_over_two~ | $\sqrt{\pi} / 2$ |
|
|
||||||
| ~pi_inv~ | $1 / \pi$ |
|
|
||||||
| ~two_over_sq_pi~ | $2 / \sqrt{\pi}$ |
|
|
||||||
|
|
||||||
#+begin_src ocaml :tangle (eval ml) :exports none
|
|
||||||
let pi = acos (-1.)
|
|
||||||
let two_pi = 2. *. pi
|
|
||||||
let sq_pi = sqrt pi
|
|
||||||
let sq_pi_over_two = sq_pi *. 0.5
|
|
||||||
let pi_inv = 1. /. pi
|
|
||||||
let two_over_sq_pi = 2. /. sq_pi
|
|
||||||
#+end_src
|
|
||||||
|
|
||||||
** Physical constants
|
|
||||||
|
|
||||||
#+begin_src ocaml :tangle (eval mli)
|
|
||||||
val a0 : float
|
|
||||||
val a0_inv : float
|
|
||||||
val ha_to_ev : float
|
|
||||||
val ev_to_ha : float
|
|
||||||
#+end_src
|
|
||||||
|
|
||||||
| ~a0~ | Bohr's radius : $a_0 = 0.529~177~210~67(23)$ angstrom |
|
|
||||||
| ~a0_inv~ | $1 / a_0$ |
|
|
||||||
| ~ha_to_ev~ | Hartree to eV conversion factor : $27.211~386~02(17)$ |
|
|
||||||
| ~ev_to_ha~ | eV to Hartree conversion factor : 1 / ~ha_to_ev~ |
|
|
||||||
|
|
||||||
#+begin_src ocaml :tangle (eval ml) :exports none
|
|
||||||
let a0 = 0.529_177_210_67
|
|
||||||
let a0_inv = 1. /. a0
|
|
||||||
let ha_to_ev = 27.211_386_02
|
|
||||||
let ev_to_ha = 1. /. ha_to_ev
|
|
||||||
#+end_src
|
|
@ -1,218 +0,0 @@
|
|||||||
#+begin_src elisp tangle: no :results none :exports none
|
|
||||||
(setq pwd (file-name-directory buffer-file-name))
|
|
||||||
(setq name (file-name-nondirectory (substring buffer-file-name 0 -4)))
|
|
||||||
(setq lib (concat pwd "lib/"))
|
|
||||||
(setq testdir (concat pwd "test/"))
|
|
||||||
(setq mli (concat lib name ".mli"))
|
|
||||||
(setq ml (concat lib name ".ml"))
|
|
||||||
(setq test-ml (concat testdir name ".ml"))
|
|
||||||
(org-babel-tangle)
|
|
||||||
#+end_src
|
|
||||||
|
|
||||||
* Coordinate
|
|
||||||
:PROPERTIES:
|
|
||||||
:header-args: :noweb yes :comments both
|
|
||||||
:END:
|
|
||||||
|
|
||||||
Coordinates in 3D space.
|
|
||||||
|
|
||||||
All operations on points are done in atomic units. Therefore,
|
|
||||||
all coordinates are given in bohr and manipulated with this
|
|
||||||
module.
|
|
||||||
|
|
||||||
** Type
|
|
||||||
|
|
||||||
<<<~Coordinate.t~>>>
|
|
||||||
#+NAME: types
|
|
||||||
#+begin_src ocaml :tangle (eval mli)
|
|
||||||
type bohr
|
|
||||||
type angstrom
|
|
||||||
|
|
||||||
type xyz = {
|
|
||||||
x : float ;
|
|
||||||
y : float ;
|
|
||||||
z : float ;
|
|
||||||
}
|
|
||||||
|
|
||||||
type 'a point = xyz
|
|
||||||
|
|
||||||
type t = bohr point
|
|
||||||
|
|
||||||
type axis = X | Y | Z
|
|
||||||
#+end_src
|
|
||||||
|
|
||||||
#+begin_src ocaml :tangle (eval ml) :exports none
|
|
||||||
type bohr
|
|
||||||
type angstrom
|
|
||||||
|
|
||||||
type xyz = {
|
|
||||||
x : float ;
|
|
||||||
y : float ;
|
|
||||||
z : float ;
|
|
||||||
}
|
|
||||||
|
|
||||||
type 'a point = xyz
|
|
||||||
|
|
||||||
type t = bohr point
|
|
||||||
|
|
||||||
type axis = X | Y | Z
|
|
||||||
#+end_src
|
|
||||||
|
|
||||||
** Creation
|
|
||||||
|
|
||||||
#+begin_src ocaml :tangle (eval mli)
|
|
||||||
val make : 'a point -> t
|
|
||||||
val make_angstrom : 'a point -> angstrom point
|
|
||||||
val zero : bohr point
|
|
||||||
#+end_src
|
|
||||||
|
|
||||||
| ~make~ | Creates a point in atomic units |
|
|
||||||
| ~make_angstrom~ | Creates a point in angstrom |
|
|
||||||
| ~zero~ | $(0., 0., 0.)$ |
|
|
||||||
|
|
||||||
#+begin_src ocaml :tangle (eval ml) :exports none
|
|
||||||
external make : 'a point -> t = "%identity"
|
|
||||||
external make_angstrom : 'a point -> angstrom point = "%identity"
|
|
||||||
|
|
||||||
let zero =
|
|
||||||
make { x = 0. ; y = 0. ; z = 0. }
|
|
||||||
#+end_src
|
|
||||||
|
|
||||||
** Conversion
|
|
||||||
|
|
||||||
#+begin_src ocaml :tangle (eval mli)
|
|
||||||
val bohr_to_angstrom : bohr point -> angstrom point
|
|
||||||
val angstrom_to_bohr : angstrom point -> bohr point
|
|
||||||
#+end_src
|
|
||||||
|
|
||||||
| ~bohr_to_angstrom~ | Converts a point in bohr to angstrom |
|
|
||||||
| ~angstrom_to_bohr~ | Converts a point in angstrom to bohr |
|
|
||||||
|
|
||||||
#+begin_src ocaml :tangle (eval ml) :exports none
|
|
||||||
let b_to_a b = Constants.a0 *. b
|
|
||||||
let bohr_to_angstrom { x ; y ; z } =
|
|
||||||
make { x = b_to_a x ;
|
|
||||||
y = b_to_a y ;
|
|
||||||
z = b_to_a z ; }
|
|
||||||
|
|
||||||
|
|
||||||
let a_to_b a = Constants.a0_inv *. a
|
|
||||||
let angstrom_to_bohr { x ; y ; z } =
|
|
||||||
make { x = a_to_b x ;
|
|
||||||
y = a_to_b y ;
|
|
||||||
z = a_to_b z ; }
|
|
||||||
#+end_src
|
|
||||||
|
|
||||||
** Vector operations
|
|
||||||
|
|
||||||
#+begin_src ocaml :tangle (eval mli)
|
|
||||||
val neg : t -> t
|
|
||||||
val get : axis -> bohr point -> float
|
|
||||||
val dot : t -> t -> float
|
|
||||||
val norm : t -> float
|
|
||||||
val ( |. ) : float -> t -> t
|
|
||||||
val ( |+ ) : t -> t -> t
|
|
||||||
val ( |- ) : t -> t -> t
|
|
||||||
#+end_src
|
|
||||||
|
|
||||||
| ~neg~ | Negative of a point |
|
|
||||||
| ~get~ | Extracts the projection of the coordinate on an axis |
|
|
||||||
| ~dot~ | Dot product |
|
|
||||||
| ~norm~ | $\ell{^2}$ norm of the vector |
|
|
||||||
| $\vert .$ | Scales the vector by a constant |
|
|
||||||
| $\vert +$ | Adds two vectors |
|
|
||||||
| $\vert -$ | Subtracts two vectors |
|
|
||||||
|
|
||||||
Example:
|
|
||||||
#+begin_example
|
|
||||||
Coordinate.neg { x=1. ; y=2. ; z=3. } ;;
|
|
||||||
- : Coordinate.t = -1.0000 -2.0000 -3.0000
|
|
||||||
|
|
||||||
Coordinate.(get Y { x=1. ; y=2. ; z=3. }) ;;
|
|
||||||
- : float = 2.
|
|
||||||
|
|
||||||
Coordinate.(
|
|
||||||
2. |. { x=1. ; y=2. ; z=3. }
|
|
||||||
) ;;
|
|
||||||
- : Coordinate.t = 2.0000 4.0000 6.0000
|
|
||||||
|
|
||||||
Coordinate.(
|
|
||||||
{ x=1. ; y=2. ; z=3. } |+ { x=2. ; y=3. ; z=1. }
|
|
||||||
);;
|
|
||||||
- : Coordinate.t = 3.0000 5.0000 4.0000
|
|
||||||
|
|
||||||
Coordinate.(
|
|
||||||
{ x=1. ; y=2. ; z=3. } |- { x=2. ; y=3. ; z=1. }
|
|
||||||
);;
|
|
||||||
- : Coordinate.t = -1.0000 -1.0000 2.0000
|
|
||||||
#+end_example
|
|
||||||
|
|
||||||
|
|
||||||
#+begin_src ocaml :tangle (eval ml) :exports none
|
|
||||||
let get axis { x ; y ; z } =
|
|
||||||
match axis with
|
|
||||||
| X -> x
|
|
||||||
| Y -> y
|
|
||||||
| Z -> z
|
|
||||||
|
|
||||||
|
|
||||||
let ( |. ) s { x ; y ; z } =
|
|
||||||
make { x = s *. x ;
|
|
||||||
y = s *. y ;
|
|
||||||
z = s *. z ; }
|
|
||||||
|
|
||||||
|
|
||||||
let ( |+ )
|
|
||||||
{ x = x1 ; y = y1 ; z = z1 }
|
|
||||||
{ x = x2 ; y = y2 ; z = z2 } =
|
|
||||||
make { x = x1 +. x2 ;
|
|
||||||
y = y1 +. y2 ;
|
|
||||||
z = z1 +. z2 ; }
|
|
||||||
|
|
||||||
|
|
||||||
let ( |- )
|
|
||||||
{ x = x1 ; y = y1 ; z = z1 }
|
|
||||||
{ x = x2 ; y = y2 ; z = z2 } =
|
|
||||||
make { x = x1 -. x2 ;
|
|
||||||
y = y1 -. y2 ;
|
|
||||||
z = z1 -. z2 ; }
|
|
||||||
|
|
||||||
|
|
||||||
let neg a = -1. |. a
|
|
||||||
|
|
||||||
|
|
||||||
let dot
|
|
||||||
{ x = x1 ; y = y1 ; z = z1 }
|
|
||||||
{ x = x2 ; y = y2 ; z = z2 } =
|
|
||||||
x1 *. x2 +.
|
|
||||||
y1 *. y2 +.
|
|
||||||
z1 *. z2
|
|
||||||
|
|
||||||
|
|
||||||
let norm u =
|
|
||||||
sqrt ( dot u u )
|
|
||||||
#+end_src
|
|
||||||
|
|
||||||
** Printers
|
|
||||||
|
|
||||||
#+begin_src ocaml :tangle (eval mli)
|
|
||||||
val pp : Format.formatter -> t -> unit
|
|
||||||
val pp_bohr: Format.formatter -> t -> unit
|
|
||||||
val pp_angstrom : Format.formatter -> t -> unit
|
|
||||||
#+end_src
|
|
||||||
|
|
||||||
Coordinates can be printed in bohr or angstrom.
|
|
||||||
|
|
||||||
#+begin_src ocaml :tangle (eval ml) :exports none
|
|
||||||
open Format
|
|
||||||
let pp ppf c =
|
|
||||||
fprintf ppf "@[@[%8.4f@] @[%8.4f@] @[%8.4f@]@]" c.x c.y c.z
|
|
||||||
|
|
||||||
let pp_bohr ppf c =
|
|
||||||
fprintf ppf "@[(@[%10f@], @[%10f@], @[%10f@] Bohr)@]" c.x c.y c.z
|
|
||||||
|
|
||||||
let pp_angstrom ppf c =
|
|
||||||
let c = bohr_to_angstrom c in
|
|
||||||
fprintf ppf "@[(@[%10f@], @[%10f@], @[%10f@] Angs)@]" c.x c.y c.z
|
|
||||||
#+end_src
|
|
||||||
|
|
@ -1,13 +1,7 @@
|
|||||||
|
|
||||||
|
|
||||||
(* This type should be used for all charges in the program (electrons, nuclei,...). *)
|
(* This type should be used for all charges in the program (electrons, nuclei,...). *)
|
||||||
|
|
||||||
|
|
||||||
(* [[file:~/QCaml/common/charge.org::*Type][Type:2]] *)
|
|
||||||
type t = float
|
type t = float
|
||||||
(* Type:2 ends here *)
|
|
||||||
|
|
||||||
(* [[file:~/QCaml/common/charge.org::*Conversions][Conversions:2]] *)
|
(** Conversions *)
|
||||||
external of_float : float -> t = "%identity"
|
external of_float : float -> t = "%identity"
|
||||||
external to_float : t -> float = "%identity"
|
external to_float : t -> float = "%identity"
|
||||||
|
|
||||||
@ -23,9 +17,8 @@ let to_string x =
|
|||||||
Printf.sprintf "%f" x
|
Printf.sprintf "%f" x
|
||||||
else
|
else
|
||||||
"0.0"
|
"0.0"
|
||||||
(* Conversions:2 ends here *)
|
|
||||||
|
|
||||||
(* [[file:~/QCaml/common/charge.org::*Simple operations][Simple operations:2]] *)
|
(** Simple operations *)
|
||||||
let gen_op op =
|
let gen_op op =
|
||||||
fun a b ->
|
fun a b ->
|
||||||
op (to_float a) (to_float b)
|
op (to_float a) (to_float b)
|
||||||
@ -37,9 +30,7 @@ let ( * ) = gen_op ( *. )
|
|||||||
let ( / ) = gen_op ( /. )
|
let ( / ) = gen_op ( /. )
|
||||||
|
|
||||||
let is_null t = t == 0.
|
let is_null t = t == 0.
|
||||||
(* Simple operations:2 ends here *)
|
|
||||||
|
|
||||||
(* [[file:~/QCaml/common/charge.org::*Printers][Printers:2]] *)
|
(** Printers *)
|
||||||
let pp ppf x =
|
let pp ppf x =
|
||||||
Format.fprintf ppf "@[%s@]" (to_string x)
|
Format.fprintf ppf "@[%s@]" (to_string x)
|
||||||
(* Printers:2 ends here *)
|
|
||||||
|
@ -1,15 +1,10 @@
|
|||||||
(* Type
|
(** Type *)
|
||||||
*
|
|
||||||
* <<<~Charge.t~>>> *)
|
|
||||||
|
|
||||||
(* [[file:~/QCaml/common/charge.org::*Type][Type:1]] *)
|
|
||||||
type t
|
type t
|
||||||
(* Type:1 ends here *)
|
|
||||||
|
|
||||||
(* Conversions *)
|
|
||||||
|
|
||||||
|
|
||||||
(* [[file:~/QCaml/common/charge.org::*Conversions][Conversions:1]] *)
|
(** Conversions *)
|
||||||
|
|
||||||
val of_float : float -> t
|
val of_float : float -> t
|
||||||
val to_float : t -> float
|
val to_float : t -> float
|
||||||
|
|
||||||
@ -18,22 +13,18 @@ val to_int : t -> int
|
|||||||
|
|
||||||
val of_string: string -> t
|
val of_string: string -> t
|
||||||
val to_string: t -> string
|
val to_string: t -> string
|
||||||
(* Conversions:1 ends here *)
|
|
||||||
|
|
||||||
(* Simple operations *)
|
|
||||||
|
|
||||||
|
|
||||||
(* [[file:~/QCaml/common/charge.org::*Simple operations][Simple operations:1]] *)
|
(** Simple operations *)
|
||||||
|
|
||||||
val ( + ) : t -> t -> t
|
val ( + ) : t -> t -> t
|
||||||
val ( - ) : t -> t -> t
|
val ( - ) : t -> t -> t
|
||||||
val ( * ) : t -> float -> t
|
val ( * ) : t -> float -> t
|
||||||
val ( / ) : t -> float -> t
|
val ( / ) : t -> float -> t
|
||||||
val is_null : t -> bool
|
val is_null : t -> bool
|
||||||
(* Simple operations:1 ends here *)
|
|
||||||
|
|
||||||
(* Printers *)
|
|
||||||
|
|
||||||
|
|
||||||
(* [[file:~/QCaml/common/charge.org::*Printers][Printers:1]] *)
|
(** Printers *)
|
||||||
|
|
||||||
val pp : Format.formatter -> t -> unit
|
val pp : Format.formatter -> t -> unit
|
||||||
(* Printers:1 ends here *)
|
|
||||||
|
@ -1,17 +1,4 @@
|
|||||||
|
(** Types *)
|
||||||
|
|
||||||
(* - <<<Short option>>>: in the command line, a dash with a single character
|
|
||||||
* (ex: =ls -l=)
|
|
||||||
* - <<<Long option>>>: in the command line, two dashes with a word
|
|
||||||
* (ex: =ls --directory=)
|
|
||||||
* - Command-line options can be ~Mandatory~ or ~Optional~
|
|
||||||
* - Documentation of the option is used in the help function
|
|
||||||
* - Some options require an argument (~ls --ignore="*.ml"~ ), some
|
|
||||||
* don't (~ls -l~) and for some arguments the argument is optional
|
|
||||||
* (~git --log[=<n>]~) *)
|
|
||||||
|
|
||||||
|
|
||||||
(* [[file:~/QCaml/common/command_line.org::*Types][Types:2]] *)
|
|
||||||
type short_opt = char
|
type short_opt = char
|
||||||
type long_opt = string
|
type long_opt = string
|
||||||
type optional = Mandatory | Optional
|
type optional = Mandatory | Optional
|
||||||
@ -27,51 +14,34 @@ type description = {
|
|||||||
doc : documentation ;
|
doc : documentation ;
|
||||||
arg : argument ;
|
arg : argument ;
|
||||||
}
|
}
|
||||||
(* Types:2 ends here *)
|
|
||||||
|
|
||||||
(* Mutable attributes
|
(** Mutable attributes
|
||||||
*
|
*
|
||||||
* All the options are stored in the hash table ~dict~ where the key
|
* All the options are stored in the hash table ~dict~ where the key
|
||||||
* is the long option and the value is a value of type ~description~. *)
|
* is the long option and the value is a value of type ~description~. *)
|
||||||
|
|
||||||
|
|
||||||
(* [[file:~/QCaml/common/command_line.org::*Mutable attributes][Mutable attributes:1]] *)
|
|
||||||
let header_doc = ref ""
|
let header_doc = ref ""
|
||||||
let description_doc = ref ""
|
let description_doc = ref ""
|
||||||
let footer_doc = ref ""
|
let footer_doc = ref ""
|
||||||
let anon_args_ref = ref []
|
let anon_args_ref = ref []
|
||||||
let specs = ref []
|
let specs = ref []
|
||||||
let dict = Hashtbl.create 67
|
let dict = Hashtbl.create 67
|
||||||
(* Mutable attributes:1 ends here *)
|
|
||||||
|
|
||||||
|
|
||||||
|
|
||||||
(* Functions to set the header, footer and main description of the
|
|
||||||
* documentation provided by the ~help~ function: *)
|
|
||||||
|
|
||||||
|
|
||||||
(* [[file:~/QCaml/common/command_line.org::*Mutable attributes][Mutable attributes:3]] *)
|
|
||||||
let set_header_doc s = header_doc := s
|
let set_header_doc s = header_doc := s
|
||||||
let set_description_doc s = description_doc := s
|
let set_description_doc s = description_doc := s
|
||||||
let set_footer_doc s = footer_doc := s
|
let set_footer_doc s = footer_doc := s
|
||||||
(* Mutable attributes:3 ends here *)
|
|
||||||
|
|
||||||
|
|
||||||
|
|
||||||
(* Function to create an anonymous argument. *)
|
|
||||||
|
|
||||||
|
|
||||||
(* [[file:~/QCaml/common/command_line.org::*Mutable attributes][Mutable attributes:5]] *)
|
|
||||||
let anonymous name opt doc =
|
let anonymous name opt doc =
|
||||||
{ short=' ' ; long=name; opt; doc; arg=Without_arg; }
|
{ short=' ' ; long=name; opt; doc; arg=Without_arg; }
|
||||||
(* Mutable attributes:5 ends here *)
|
|
||||||
|
|
||||||
(* Text formatting functions :noexport:
|
|
||||||
|
(* Text formatting functions
|
||||||
*
|
*
|
||||||
* Function to print some text such that it fits on the screen *)
|
* Function to print some text such that it fits on the screen *)
|
||||||
|
|
||||||
|
|
||||||
(* [[file:~/QCaml/common/command_line.org::*Text formatting functions][Text formatting functions:1]] *)
|
|
||||||
let output_text t =
|
let output_text t =
|
||||||
Format.printf "@[<v 0>";
|
Format.printf "@[<v 0>";
|
||||||
begin
|
begin
|
||||||
@ -90,8 +60,6 @@ let output_text t =
|
|||||||
) t
|
) t
|
||||||
end;
|
end;
|
||||||
Format.printf "@]"
|
Format.printf "@]"
|
||||||
(* Text formatting functions:1 ends here *)
|
|
||||||
|
|
||||||
|
|
||||||
|
|
||||||
|
|
||||||
@ -99,12 +67,11 @@ let output_text t =
|
|||||||
* arguments, such as
|
* arguments, such as
|
||||||
*
|
*
|
||||||
* Example:
|
* Example:
|
||||||
* #+begin_example
|
|
||||||
* my_program -b <string> [-h] [-u <float>] -x <string> [--]
|
* my_program -b <string> [-h] [-u <float>] -x <string> [--]
|
||||||
* #+end_example *)
|
*)
|
||||||
|
|
||||||
|
|
||||||
(* [[file:~/QCaml/common/command_line.org::*Text formatting functions][Text formatting functions:2]] *)
|
|
||||||
let output_short x =
|
let output_short x =
|
||||||
match x.short, x.opt, x.arg with
|
match x.short, x.opt, x.arg with
|
||||||
| ' ', Mandatory, _ -> Format.printf "@[%s@]" x.long
|
| ' ', Mandatory, _ -> Format.printf "@[%s@]" x.long
|
||||||
@ -115,8 +82,6 @@ let output_short x =
|
|||||||
| _ , Optional , With_arg arg -> Format.printf "@[[-%c %s]@]" x.short arg
|
| _ , Optional , With_arg arg -> Format.printf "@[[-%c %s]@]" x.short arg
|
||||||
| _ , Mandatory, With_opt_arg arg -> Format.printf "@[-%c [%s]@]" x.short arg
|
| _ , Mandatory, With_opt_arg arg -> Format.printf "@[-%c [%s]@]" x.short arg
|
||||||
| _ , Optional , With_opt_arg arg -> Format.printf "@[[-%c [%s]]@]" x.short arg
|
| _ , Optional , With_opt_arg arg -> Format.printf "@[[-%c [%s]]@]" x.short arg
|
||||||
(* Text formatting functions:2 ends here *)
|
|
||||||
|
|
||||||
|
|
||||||
|
|
||||||
|
|
||||||
@ -124,13 +89,12 @@ let output_short x =
|
|||||||
* arguments, such as
|
* arguments, such as
|
||||||
*
|
*
|
||||||
* Example:
|
* Example:
|
||||||
* #+begin_example
|
*
|
||||||
* -x --xyz=<string> Name of the file containing the nuclear
|
* -x --xyz=<string> Name of the file containing the nuclear
|
||||||
* coordinates in xyz format
|
* coordinates in xyz format
|
||||||
* #+end_example *)
|
*)
|
||||||
|
|
||||||
|
|
||||||
(* [[file:~/QCaml/common/command_line.org::*Text formatting functions][Text formatting functions:3]] *)
|
|
||||||
let output_long max_width x =
|
let output_long max_width x =
|
||||||
let arg =
|
let arg =
|
||||||
match x.short, x.arg with
|
match x.short, x.arg with
|
||||||
@ -151,17 +115,9 @@ let output_long max_width x =
|
|||||||
end;
|
end;
|
||||||
Format.printf "@]";
|
Format.printf "@]";
|
||||||
output_text x.doc
|
output_text x.doc
|
||||||
(* Text formatting functions:3 ends here *)
|
|
||||||
|
|
||||||
|
|
||||||
|
|
||||||
(* | ~get~ | Returns the argument associated with a long option |
|
|
||||||
* | ~get_bool~ | True if the ~Optional~ argument is present in the command-line |
|
|
||||||
* | ~anon_args~ | Returns the list of anonymous arguments | *)
|
|
||||||
|
|
||||||
|
|
||||||
|
|
||||||
(* [[file:~/QCaml/common/command_line.org::*Query functions][Query functions:2]] *)
|
|
||||||
let anon_args () = !anon_args_ref
|
let anon_args () = !anon_args_ref
|
||||||
|
|
||||||
let help () =
|
let help () =
|
||||||
@ -237,15 +193,8 @@ let get x =
|
|||||||
|
|
||||||
|
|
||||||
let get_bool x = Hashtbl.mem dict x
|
let get_bool x = Hashtbl.mem dict x
|
||||||
(* Query functions:2 ends here *)
|
|
||||||
|
|
||||||
|
|
||||||
|
|
||||||
(* Sets the specifications of the current program from a list of
|
|
||||||
* ~descrption~ variables. *)
|
|
||||||
|
|
||||||
|
|
||||||
(* [[file:~/QCaml/common/command_line.org::*Specification][Specification:2]] *)
|
|
||||||
let set_specs specs_in =
|
let set_specs specs_in =
|
||||||
specs := { short = 'h' ;
|
specs := { short = 'h' ;
|
||||||
long = "help" ;
|
long = "help" ;
|
||||||
@ -280,4 +229,4 @@ let set_specs specs_in =
|
|||||||
| Some _ -> ()
|
| Some _ -> ()
|
||||||
| None -> failwith ("Error: --"^x.long^" option is missing.")
|
| None -> failwith ("Error: --"^x.long^" option is missing.")
|
||||||
)
|
)
|
||||||
(* Specification:2 ends here *)
|
|
||||||
|
@ -1,8 +1,64 @@
|
|||||||
(* Types
|
(** Command line *)
|
||||||
*
|
|
||||||
* #+NAME:type *)
|
(* This module is a wrapper around the ~Getopt~ library and helps to
|
||||||
|
* define command-line arguments.
|
||||||
|
*
|
||||||
|
* Here is an example of how to use this module.
|
||||||
|
* First, define the specification:
|
||||||
|
*
|
||||||
|
* let open Command_line in
|
||||||
|
* begin
|
||||||
|
* set_header_doc (Sys.argv.(0) ^ " - One-line description");
|
||||||
|
* set_description_doc "Long description of the command.";
|
||||||
|
* set_specs
|
||||||
|
* [ { short='c'; long="check"; opt=Optional;
|
||||||
|
* doc="Checks the input data";
|
||||||
|
* arg=Without_arg; };
|
||||||
|
*
|
||||||
|
* { short='b' ; long="basis" ; opt=Mandatory;
|
||||||
|
* arg=With_arg "<string>";
|
||||||
|
* doc="Name of the file containing the basis set"; } ;
|
||||||
|
*
|
||||||
|
* { short='m' ; long="multiplicity" ; opt=Optional;
|
||||||
|
* arg=With_arg "<int>";
|
||||||
|
* doc="Spin multiplicity (2S+1). Default is singlet"; } ;
|
||||||
|
* ]
|
||||||
|
* end;
|
||||||
|
*
|
||||||
|
* Then, define what to do with the arguments:
|
||||||
|
*
|
||||||
|
* let c =
|
||||||
|
* Command_line.get_bool "check"
|
||||||
|
* in
|
||||||
|
*
|
||||||
|
* let basis =
|
||||||
|
* match Command_line.get "basis" with
|
||||||
|
* | Some x -> x
|
||||||
|
* | None -> assert false
|
||||||
|
* in
|
||||||
|
*
|
||||||
|
* let multiplicity =
|
||||||
|
* match Command_line.get "multiplicity" with
|
||||||
|
* | None -> 1
|
||||||
|
* | Some n -> int_of_string n
|
||||||
|
* in
|
||||||
|
* ...
|
||||||
|
*)
|
||||||
|
|
||||||
|
|
||||||
|
(* - <<<Short option>>>: in the command line, a dash with a single character
|
||||||
|
* (ex: =ls -l=)
|
||||||
|
* - <<<Long option>>>: in the command line, two dashes with a word
|
||||||
|
* (ex: =ls --directory=)
|
||||||
|
* - Command-line options can be `Mandatory` or `Optional`
|
||||||
|
* - Documentation of the option is used in the help function
|
||||||
|
* - Some options require an argument (`ls --ignore="*.ml"`), some
|
||||||
|
* don't (`ls -l`) and for some arguments the argument is optional
|
||||||
|
* (`git --log[=<n>]`) *)
|
||||||
|
|
||||||
|
|
||||||
|
(** Types *)
|
||||||
|
|
||||||
(* [[file:~/QCaml/common/command_line.org::type][type]] *)
|
|
||||||
type short_opt = char
|
type short_opt = char
|
||||||
type long_opt = string
|
type long_opt = string
|
||||||
type optional = Mandatory | Optional
|
type optional = Mandatory | Optional
|
||||||
@ -18,30 +74,38 @@ type description = {
|
|||||||
doc : documentation ;
|
doc : documentation ;
|
||||||
arg : argument ;
|
arg : argument ;
|
||||||
}
|
}
|
||||||
(* type ends here *)
|
|
||||||
|
|
||||||
(* [[file:~/QCaml/common/command_line.org::*Mutable attributes][Mutable attributes:2]] *)
|
|
||||||
|
(** Mutable attributes *)
|
||||||
|
|
||||||
val set_header_doc : string -> unit
|
val set_header_doc : string -> unit
|
||||||
|
(** Sets the header of the documentation provided by the ~help~ function: *)
|
||||||
|
|
||||||
val set_description_doc : string -> unit
|
val set_description_doc : string -> unit
|
||||||
|
(** Sets the description of the documentation provided by the ~help~ function: *)
|
||||||
|
|
||||||
val set_footer_doc : string -> unit
|
val set_footer_doc : string -> unit
|
||||||
(* Mutable attributes:2 ends here *)
|
(** Sets the footer of the documentation provided by the ~help~ function: *)
|
||||||
|
|
||||||
(* [[file:~/QCaml/common/command_line.org::*Mutable attributes][Mutable attributes:4]] *)
|
|
||||||
val anonymous : long_opt -> optional -> documentation -> description
|
val anonymous : long_opt -> optional -> documentation -> description
|
||||||
(* Mutable attributes:4 ends here *)
|
(** Creates an anonymous argument. *)
|
||||||
|
|
||||||
(* Query functions *)
|
|
||||||
|
|
||||||
|
|
||||||
(* [[file:~/QCaml/common/command_line.org::*Query functions][Query functions:1]] *)
|
(** Query functions *)
|
||||||
|
|
||||||
val get : long_opt -> string option
|
val get : long_opt -> string option
|
||||||
|
(** Returns the argument associated with a long option *)
|
||||||
|
|
||||||
val get_bool : long_opt -> bool
|
val get_bool : long_opt -> bool
|
||||||
|
(** True if the ~Optional~ argument is present in the command-line *)
|
||||||
|
|
||||||
val anon_args : unit -> string list
|
val anon_args : unit -> string list
|
||||||
(* Query functions:1 ends here *)
|
(** Returns the list of anonymous arguments *)
|
||||||
|
|
||||||
(* Specification *)
|
|
||||||
|
|
||||||
|
|
||||||
(* [[file:~/QCaml/common/command_line.org::*Specification][Specification:1]] *)
|
(** Specification *)
|
||||||
|
|
||||||
val set_specs : description list -> unit
|
val set_specs : description list -> unit
|
||||||
(* Specification:1 ends here *)
|
(** Sets the specifications of the current program from a list of
|
||||||
|
* ~descrption~ variables. *)
|
||||||
|
|
||||||
|
@ -1,44 +1,21 @@
|
|||||||
|
(** Thresholds *)
|
||||||
|
|
||||||
(* | ~epsilon~ | Value below which a float is considered null. Default is \epsilon = 2.10^{-15} |
|
|
||||||
* | ~integrals_cutoff~ | Cutoff value for integrals. Default is \epsilon | *)
|
|
||||||
|
|
||||||
|
|
||||||
(* [[file:~/QCaml/common/constants.org::*Thresholds][Thresholds:2]] *)
|
|
||||||
let epsilon = 2.e-15
|
let epsilon = 2.e-15
|
||||||
let integrals_cutoff = epsilon
|
let integrals_cutoff = epsilon
|
||||||
(* Thresholds:2 ends here *)
|
|
||||||
|
|
||||||
|
|
||||||
|
(** Mathematical constants *)
|
||||||
|
|
||||||
(* | ~pi~ | $\pi = 3.141~592~653~589~793~12$ |
|
|
||||||
* | ~two_pi~ | $2 \pi$ |
|
|
||||||
* | ~sq_pi~ | $\sqrt{\pi}$ |
|
|
||||||
* | ~sq_pi_over_two~ | $\sqrt{\pi} / 2$ |
|
|
||||||
* | ~pi_inv~ | $1 / \pi$ |
|
|
||||||
* | ~two_over_sq_pi~ | $2 / \sqrt{\pi}$ | *)
|
|
||||||
|
|
||||||
|
|
||||||
(* [[file:~/QCaml/common/constants.org::*Mathematical constants][Mathematical constants:2]] *)
|
|
||||||
let pi = acos (-1.)
|
let pi = acos (-1.)
|
||||||
let two_pi = 2. *. pi
|
let two_pi = 2. *. pi
|
||||||
let sq_pi = sqrt pi
|
let sq_pi = sqrt pi
|
||||||
let sq_pi_over_two = sq_pi *. 0.5
|
let sq_pi_over_two = sq_pi *. 0.5
|
||||||
let pi_inv = 1. /. pi
|
let pi_inv = 1. /. pi
|
||||||
let two_over_sq_pi = 2. /. sq_pi
|
let two_over_sq_pi = 2. /. sq_pi
|
||||||
(* Mathematical constants:2 ends here *)
|
|
||||||
|
|
||||||
|
|
||||||
|
(** Physical constants *)
|
||||||
|
|
||||||
(* | ~a0~ | Bohr's radius : $a_0 = 0.529~177~210~67(23)$ angstrom |
|
|
||||||
* | ~a0_inv~ | $1 / a_0$ |
|
|
||||||
* | ~ha_to_ev~ | Hartree to eV conversion factor : $27.211~386~02(17)$ |
|
|
||||||
* | ~ev_to_ha~ | eV to Hartree conversion factor : 1 / ~ha_to_ev~ | *)
|
|
||||||
|
|
||||||
|
|
||||||
(* [[file:~/QCaml/common/constants.org::*Physical constants][Physical constants:2]] *)
|
|
||||||
let a0 = 0.529_177_210_67
|
let a0 = 0.529_177_210_67
|
||||||
let a0_inv = 1. /. a0
|
let a0_inv = 1. /. a0
|
||||||
let ha_to_ev = 27.211_386_02
|
let ha_to_ev = 27.211_386_02
|
||||||
let ev_to_ha = 1. /. ha_to_ev
|
let ev_to_ha = 1. /. ha_to_ev
|
||||||
(* Physical constants:2 ends here *)
|
|
||||||
|
@ -1,29 +1,43 @@
|
|||||||
(* Thresholds *)
|
(* Thresholds *)
|
||||||
|
|
||||||
|
|
||||||
(* [[file:~/QCaml/common/constants.org::*Thresholds][Thresholds:1]] *)
|
|
||||||
val epsilon : float
|
val epsilon : float
|
||||||
|
(** Value below which a float is considered null. Default is \epsilon = 2.10^{-15}. *)
|
||||||
|
|
||||||
val integrals_cutoff : float
|
val integrals_cutoff : float
|
||||||
(* Thresholds:1 ends here *)
|
(** Cutoff value for integrals. Default is \epsilon. *)
|
||||||
|
|
||||||
(* Mathematical constants *)
|
|
||||||
|
|
||||||
|
|
||||||
(* [[file:~/QCaml/common/constants.org::*Mathematical constants][Mathematical constants:1]] *)
|
(** Mathematical constants *)
|
||||||
val pi : float
|
val pi : float
|
||||||
|
(** $\pi = 3.141~592~653~589~793~12$ *)
|
||||||
|
|
||||||
val two_pi : float
|
val two_pi : float
|
||||||
|
(** $2 \pi$ *)
|
||||||
|
|
||||||
val sq_pi : float
|
val sq_pi : float
|
||||||
|
(** $\sqrt{\pi}$ *)
|
||||||
|
|
||||||
val sq_pi_over_two : float
|
val sq_pi_over_two : float
|
||||||
|
(** $\sqrt{\pi} / 2$ *)
|
||||||
|
|
||||||
val pi_inv : float
|
val pi_inv : float
|
||||||
|
(** $1 / \pi$ *)
|
||||||
|
|
||||||
val two_over_sq_pi : float
|
val two_over_sq_pi : float
|
||||||
(* Mathematical constants:1 ends here *)
|
(** $2 / \sqrt{\pi}$ *)
|
||||||
|
|
||||||
(* Physical constants *)
|
|
||||||
|
|
||||||
|
|
||||||
(* [[file:~/QCaml/common/constants.org::*Physical constants][Physical constants:1]] *)
|
(** Physical constants *)
|
||||||
|
|
||||||
val a0 : float
|
val a0 : float
|
||||||
|
(** Bohr's radius : $a_0 = 0.529~177~210~67(23)$ angstrom. *)
|
||||||
|
|
||||||
val a0_inv : float
|
val a0_inv : float
|
||||||
|
(** $1 / a_0$ *)
|
||||||
|
|
||||||
val ha_to_ev : float
|
val ha_to_ev : float
|
||||||
|
(** Hartree to eV conversion factor : $27.211~386~02(17)$ *)
|
||||||
|
|
||||||
val ev_to_ha : float
|
val ev_to_ha : float
|
||||||
(* Physical constants:1 ends here *)
|
(** eV to Hartree conversion factor : 1 / ~ha_to_ev~ *)
|
||||||
|
|
||||||
|
@ -1,4 +1,5 @@
|
|||||||
(* [[file:~/QCaml/common/coordinate.org::*Type][Type:2]] *)
|
(** Types *)
|
||||||
|
|
||||||
type bohr
|
type bohr
|
||||||
type angstrom
|
type angstrom
|
||||||
|
|
||||||
@ -13,30 +14,22 @@ type 'a point = xyz
|
|||||||
type t = bohr point
|
type t = bohr point
|
||||||
|
|
||||||
type axis = X | Y | Z
|
type axis = X | Y | Z
|
||||||
(* Type:2 ends here *)
|
|
||||||
|
|
||||||
|
|
||||||
|
|
||||||
(* | ~make~ | Creates a point in atomic units |
|
|
||||||
* | ~make_angstrom~ | Creates a point in angstrom |
|
|
||||||
* | ~zero~ | $(0., 0., 0.)$ | *)
|
|
||||||
|
|
||||||
|
|
||||||
(* [[file:~/QCaml/common/coordinate.org::*Creation][Creation:2]] *)
|
(** Creation *)
|
||||||
external make : 'a point -> t = "%identity"
|
external make : 'a point -> t = "%identity"
|
||||||
external make_angstrom : 'a point -> angstrom point = "%identity"
|
external make_angstrom : 'a point -> angstrom point = "%identity"
|
||||||
|
|
||||||
let zero =
|
let zero =
|
||||||
make { x = 0. ; y = 0. ; z = 0. }
|
make { x = 0. ; y = 0. ; z = 0. }
|
||||||
(* Creation:2 ends here *)
|
|
||||||
|
|
||||||
|
|
||||||
|
|
||||||
(* | ~bohr_to_angstrom~ | Converts a point in bohr to angstrom |
|
(** Conversion *)
|
||||||
* | ~angstrom_to_bohr~ | Converts a point in angstrom to bohr | *)
|
|
||||||
|
|
||||||
|
|
||||||
(* [[file:~/QCaml/common/coordinate.org::*Conversion][Conversion:2]] *)
|
|
||||||
let b_to_a b = Constants.a0 *. b
|
let b_to_a b = Constants.a0 *. b
|
||||||
let bohr_to_angstrom { x ; y ; z } =
|
let bohr_to_angstrom { x ; y ; z } =
|
||||||
make { x = b_to_a x ;
|
make { x = b_to_a x ;
|
||||||
@ -49,45 +42,9 @@ let angstrom_to_bohr { x ; y ; z } =
|
|||||||
make { x = a_to_b x ;
|
make { x = a_to_b x ;
|
||||||
y = a_to_b y ;
|
y = a_to_b y ;
|
||||||
z = a_to_b z ; }
|
z = a_to_b z ; }
|
||||||
(* Conversion:2 ends here *)
|
|
||||||
|
|
||||||
|
|
||||||
|
|
||||||
(* | ~neg~ | Negative of a point |
|
|
||||||
* | ~get~ | Extracts the projection of the coordinate on an axis |
|
|
||||||
* | ~dot~ | Dot product |
|
|
||||||
* | ~norm~ | $\ell{^2}$ norm of the vector |
|
|
||||||
* | $\vert .$ | Scales the vector by a constant |
|
|
||||||
* | $\vert +$ | Adds two vectors |
|
|
||||||
* | $\vert -$ | Subtracts two vectors |
|
|
||||||
*
|
|
||||||
* Example:
|
|
||||||
* #+begin_example
|
|
||||||
* Coordinate.neg { x=1. ; y=2. ; z=3. } ;;
|
|
||||||
* - : Coordinate.t = -1.0000 -2.0000 -3.0000
|
|
||||||
*
|
|
||||||
* Coordinate.(get Y { x=1. ; y=2. ; z=3. }) ;;
|
|
||||||
* - : float = 2.
|
|
||||||
*
|
|
||||||
* Coordinate.(
|
|
||||||
* 2. |. { x=1. ; y=2. ; z=3. }
|
|
||||||
* ) ;;
|
|
||||||
* - : Coordinate.t = 2.0000 4.0000 6.0000
|
|
||||||
*
|
|
||||||
* Coordinate.(
|
|
||||||
* { x=1. ; y=2. ; z=3. } |+ { x=2. ; y=3. ; z=1. }
|
|
||||||
* );;
|
|
||||||
* - : Coordinate.t = 3.0000 5.0000 4.0000
|
|
||||||
*
|
|
||||||
* Coordinate.(
|
|
||||||
* { x=1. ; y=2. ; z=3. } |- { x=2. ; y=3. ; z=1. }
|
|
||||||
* );;
|
|
||||||
* - : Coordinate.t = -1.0000 -1.0000 2.0000
|
|
||||||
* #+end_example *)
|
|
||||||
|
|
||||||
|
|
||||||
|
|
||||||
(* [[file:~/QCaml/common/coordinate.org::*Vector operations][Vector operations:2]] *)
|
|
||||||
let get axis { x ; y ; z } =
|
let get axis { x ; y ; z } =
|
||||||
match axis with
|
match axis with
|
||||||
| X -> x
|
| X -> x
|
||||||
@ -130,14 +87,12 @@ let dot
|
|||||||
|
|
||||||
let norm u =
|
let norm u =
|
||||||
sqrt ( dot u u )
|
sqrt ( dot u u )
|
||||||
(* Vector operations:2 ends here *)
|
|
||||||
|
|
||||||
|
|
||||||
|
|
||||||
(* Coordinates can be printed in bohr or angstrom. *)
|
|
||||||
|
|
||||||
|
(** Printers *)
|
||||||
|
|
||||||
(* [[file:~/QCaml/common/coordinate.org::*Printers][Printers:2]] *)
|
|
||||||
open Format
|
open Format
|
||||||
let pp ppf c =
|
let pp ppf c =
|
||||||
fprintf ppf "@[@[%8.4f@] @[%8.4f@] @[%8.4f@]@]" c.x c.y c.z
|
fprintf ppf "@[@[%8.4f@] @[%8.4f@] @[%8.4f@]@]" c.x c.y c.z
|
||||||
@ -148,4 +103,3 @@ let pp_bohr ppf c =
|
|||||||
let pp_angstrom ppf c =
|
let pp_angstrom ppf c =
|
||||||
let c = bohr_to_angstrom c in
|
let c = bohr_to_angstrom c in
|
||||||
fprintf ppf "@[(@[%10f@], @[%10f@], @[%10f@] Angs)@]" c.x c.y c.z
|
fprintf ppf "@[(@[%10f@], @[%10f@], @[%10f@] Angs)@]" c.x c.y c.z
|
||||||
(* Printers:2 ends here *)
|
|
||||||
|
@ -1,9 +1,14 @@
|
|||||||
(* Type
|
(** Coordinates
|
||||||
*
|
*
|
||||||
* <<<~Coordinate.t~>>>
|
* Coordinates in 3D space.
|
||||||
* #+NAME: types *)
|
*
|
||||||
|
* All operations on points are done in atomic units.
|
||||||
|
* Therefore, all coordinates are given in bohr and
|
||||||
|
* manipulated with this module.
|
||||||
|
*)
|
||||||
|
|
||||||
|
(** Types *)
|
||||||
|
|
||||||
(* [[file:~/QCaml/common/coordinate.org::types][types]] *)
|
|
||||||
type bohr
|
type bohr
|
||||||
type angstrom
|
type angstrom
|
||||||
|
|
||||||
@ -18,43 +23,85 @@ type 'a point = xyz
|
|||||||
type t = bohr point
|
type t = bohr point
|
||||||
|
|
||||||
type axis = X | Y | Z
|
type axis = X | Y | Z
|
||||||
(* types ends here *)
|
|
||||||
|
|
||||||
(* Creation *)
|
|
||||||
|
|
||||||
|
|
||||||
(* [[file:~/QCaml/common/coordinate.org::*Creation][Creation:1]] *)
|
(** Creation *)
|
||||||
|
|
||||||
val make : 'a point -> t
|
val make : 'a point -> t
|
||||||
|
(** Creates a point in atomic units *)
|
||||||
|
|
||||||
val make_angstrom : 'a point -> angstrom point
|
val make_angstrom : 'a point -> angstrom point
|
||||||
|
(** Creates a point in angstrom *)
|
||||||
|
|
||||||
val zero : bohr point
|
val zero : bohr point
|
||||||
(* Creation:1 ends here *)
|
(** (0., 0., 0.) *)
|
||||||
|
|
||||||
(* Conversion *)
|
|
||||||
|
|
||||||
|
|
||||||
(* [[file:~/QCaml/common/coordinate.org::*Conversion][Conversion:1]] *)
|
(** Conversion *)
|
||||||
|
|
||||||
val bohr_to_angstrom : bohr point -> angstrom point
|
val bohr_to_angstrom : bohr point -> angstrom point
|
||||||
|
(** Converts a point in bohr to angstrom *)
|
||||||
|
|
||||||
val angstrom_to_bohr : angstrom point -> bohr point
|
val angstrom_to_bohr : angstrom point -> bohr point
|
||||||
(* Conversion:1 ends here *)
|
(** Converts a point in angstrom to bohr *)
|
||||||
|
|
||||||
(* Vector operations *)
|
(* Vector operations *)
|
||||||
|
|
||||||
|
|
||||||
(* [[file:~/QCaml/common/coordinate.org::*Vector operations][Vector operations:1]] *)
|
(** Vector operations *)
|
||||||
|
|
||||||
val neg : t -> t
|
val neg : t -> t
|
||||||
|
(** Negative of a point *)
|
||||||
|
|
||||||
val get : axis -> bohr point -> float
|
val get : axis -> bohr point -> float
|
||||||
|
(** Extracts the projection of the coordinate on an axis *)
|
||||||
|
|
||||||
val dot : t -> t -> float
|
val dot : t -> t -> float
|
||||||
|
(** Dot product *)
|
||||||
|
|
||||||
val norm : t -> float
|
val norm : t -> float
|
||||||
|
(** $\ell{^2}$ norm of the vector *)
|
||||||
|
|
||||||
val ( |. ) : float -> t -> t
|
val ( |. ) : float -> t -> t
|
||||||
|
(** Scales the vector by a constant *)
|
||||||
|
|
||||||
val ( |+ ) : t -> t -> t
|
val ( |+ ) : t -> t -> t
|
||||||
|
(** Adds two vectors *)
|
||||||
|
|
||||||
val ( |- ) : t -> t -> t
|
val ( |- ) : t -> t -> t
|
||||||
(* Vector operations:1 ends here *)
|
(** Subtracts two vectors *)
|
||||||
|
|
||||||
(* Printers *)
|
|
||||||
|
|
||||||
|
|
||||||
(* [[file:~/QCaml/common/coordinate.org::*Printers][Printers:1]] *)
|
(** Example
|
||||||
|
|
||||||
|
* Coordinate.neg { x=1. ; y=2. ; z=3. } ;;
|
||||||
|
* - : Coordinate.t = -1.0000 -2.0000 -3.0000
|
||||||
|
*
|
||||||
|
* Coordinate.(get Y { x=1. ; y=2. ; z=3. }) ;;
|
||||||
|
* - : float = 2.
|
||||||
|
*
|
||||||
|
* Coordinate.(
|
||||||
|
* 2. |. { x=1. ; y=2. ; z=3. }
|
||||||
|
* ) ;;
|
||||||
|
* - : Coordinate.t = 2.0000 4.0000 6.0000
|
||||||
|
*
|
||||||
|
* Coordinate.(
|
||||||
|
* { x=1. ; y=2. ; z=3. } |+ { x=2. ; y=3. ; z=1. }
|
||||||
|
* );;
|
||||||
|
* - : Coordinate.t = 3.0000 5.0000 4.0000
|
||||||
|
*
|
||||||
|
* Coordinate.(
|
||||||
|
* { x=1. ; y=2. ; z=3. } |- { x=2. ; y=3. ; z=1. }
|
||||||
|
* );;
|
||||||
|
* - : Coordinate.t = -1.0000 -1.0000 2.0000
|
||||||
|
*)
|
||||||
|
|
||||||
|
|
||||||
|
|
||||||
|
(** Printers *)
|
||||||
|
|
||||||
|
(* Coordinates can be printed in bohr or angstrom. *)
|
||||||
|
|
||||||
val pp : Format.formatter -> t -> unit
|
val pp : Format.formatter -> t -> unit
|
||||||
val pp_bohr: Format.formatter -> t -> unit
|
val pp_bohr: Format.formatter -> t -> unit
|
||||||
val pp_angstrom : Format.formatter -> t -> unit
|
val pp_angstrom : Format.formatter -> t -> unit
|
||||||
(* Printers:1 ends here *)
|
|
||||||
|
@ -1,51 +1,31 @@
|
|||||||
(* [[file:~/QCaml/common/util.org::*Erf][Erf:3]] *)
|
(** Utility functions *)
|
||||||
|
|
||||||
external erf_float : float -> float
|
external erf_float : float -> float
|
||||||
= "erf_float_bytecode" "erf_float" [@@unboxed] [@@noalloc]
|
= "erf_float_bytecode" "erf_float" [@@unboxed] [@@noalloc]
|
||||||
(* Erf:3 ends here *)
|
|
||||||
|
|
||||||
(* [[file:~/QCaml/common/util.org::*Erfc][Erfc:3]] *)
|
|
||||||
external erfc_float : float -> float = "erfc_float_bytecode" "erfc_float" [@@unboxed] [@@noalloc]
|
external erfc_float : float -> float = "erfc_float_bytecode" "erfc_float" [@@unboxed] [@@noalloc]
|
||||||
(* Erfc:3 ends here *)
|
|
||||||
|
|
||||||
(* [[file:~/QCaml/common/util.org::*Gamma][Gamma:3]] *)
|
|
||||||
external gamma_float : float -> float
|
external gamma_float : float -> float
|
||||||
= "gamma_float_bytecode" "gamma_float" [@@unboxed] [@@noalloc]
|
= "gamma_float_bytecode" "gamma_float" [@@unboxed] [@@noalloc]
|
||||||
(* Gamma:3 ends here *)
|
|
||||||
|
|
||||||
(* [[file:~/QCaml/common/util.org::*Popcnt][Popcnt:3]] *)
|
|
||||||
external popcnt : int64 -> int32 = "popcnt_bytecode" "popcnt"
|
external popcnt : int64 -> int32 = "popcnt_bytecode" "popcnt"
|
||||||
[@@unboxed] [@@noalloc]
|
[@@unboxed] [@@noalloc]
|
||||||
|
|
||||||
let popcnt i = (popcnt [@inlined] ) i |> Int32.to_int
|
let popcnt i = (popcnt [@inlined] ) i |> Int32.to_int
|
||||||
(* Popcnt:3 ends here *)
|
|
||||||
|
|
||||||
(* [[file:~/QCaml/common/util.org::*Trailz][Trailz:3]] *)
|
|
||||||
external trailz : int64 -> int32 = "trailz_bytecode" "trailz" "int"
|
external trailz : int64 -> int32 = "trailz_bytecode" "trailz" "int"
|
||||||
[@@unboxed] [@@noalloc]
|
[@@unboxed] [@@noalloc]
|
||||||
|
|
||||||
let trailz i = trailz i |> Int32.to_int
|
let trailz i = trailz i |> Int32.to_int
|
||||||
(* Trailz:3 ends here *)
|
|
||||||
|
|
||||||
(* [[file:~/QCaml/common/util.org::*Leadz][Leadz:3]] *)
|
|
||||||
external leadz : int64 -> int32 = "leadz_bytecode" "leadz" "int"
|
external leadz : int64 -> int32 = "leadz_bytecode" "leadz" "int"
|
||||||
[@@unboxed] [@@noalloc]
|
[@@unboxed] [@@noalloc]
|
||||||
|
|
||||||
let leadz i = leadz i |> Int32.to_int
|
let leadz i = leadz i |> Int32.to_int
|
||||||
(* Leadz:3 ends here *)
|
|
||||||
|
|
||||||
|
|
||||||
|
|
||||||
(* | ~fact~ | Factorial function. |
|
|
||||||
* | ~binom~ | Binomial coefficient. ~binom n k~ = $C_n^k$ |
|
|
||||||
* | ~binom_float~ | float variant of ~binom~ |
|
|
||||||
* | ~pow~ | Fast implementation of the power function for small integer powers |
|
|
||||||
* | ~chop~ | In ~chop a f~, evaluate ~f~ only if the absolute value of ~a~ is larger than ~Constants.epsilon~, and return ~a *. f ()~. |
|
|
||||||
* | ~float_of_int_fast~ | Faster implementation of float_of_int for small positive ints |
|
|
||||||
* | ~not_implemented~ | Fails if some functionality is not implemented |
|
|
||||||
* | ~of_some~ | Extracts the value of an option | *)
|
|
||||||
|
|
||||||
|
|
||||||
(* [[file:~/QCaml/common/util.org::*General functions][General functions:2]] *)
|
|
||||||
let memo_float_of_int =
|
let memo_float_of_int =
|
||||||
Array.init 64 float_of_int
|
Array.init 64 float_of_int
|
||||||
|
|
||||||
@ -133,26 +113,11 @@ let not_implemented string =
|
|||||||
let of_some = function
|
let of_some = function
|
||||||
| Some a -> a
|
| Some a -> a
|
||||||
| None -> assert false
|
| None -> assert false
|
||||||
(* General functions:2 ends here *)
|
|
||||||
|
|
||||||
|
|
||||||
|
|
||||||
(* The lower [[https://en.wikipedia.org/wiki/Incomplete_gamma_function][Incomplete Gamma function]] is implemented :
|
|
||||||
* \[
|
|
||||||
* \gamma(\alpha,x) = \int_0^x e^{-t} t^{\alpha-1} dt
|
|
||||||
* \]
|
|
||||||
*
|
|
||||||
* p: $\frac{1}{\Gamma(\alpha)} \int_0^x e^{-t} t^{\alpha-1} dt$
|
|
||||||
*
|
|
||||||
* q: $\frac{1}{\Gamma(\alpha)} \int_x^\infty e^{-t} t^{\alpha-1} dt$
|
|
||||||
*
|
|
||||||
* Reference : Haruhiko Okumura: C-gengo niyoru saishin algorithm jiten
|
|
||||||
* (New Algorithm handbook in C language) (Gijyutsu hyouron sha,
|
|
||||||
* Tokyo, 1991) p.227 [in Japanese] *)
|
|
||||||
|
|
||||||
|
|
||||||
|
|
||||||
(* [[file:~/QCaml/common/util.org::*Functions related to the Boys function][Functions related to the Boys function:2]] *)
|
|
||||||
let incomplete_gamma ~alpha x =
|
let incomplete_gamma ~alpha x =
|
||||||
assert (alpha >= 0.);
|
assert (alpha >= 0.);
|
||||||
assert (x >= 0.);
|
assert (x >= 0.);
|
||||||
@ -195,26 +160,8 @@ let incomplete_gamma ~alpha x =
|
|||||||
qg_loop min_float (w /. lb) 1. lb w 2.0
|
qg_loop min_float (w /. lb) 1. lb w 2.0
|
||||||
in
|
in
|
||||||
gf *. p_gamma x
|
gf *. p_gamma x
|
||||||
(* Functions related to the Boys function:2 ends here *)
|
|
||||||
|
|
||||||
|
|
||||||
|
|
||||||
(* The [[https://link.springer.com/article/10.1007/s10910-005-9023-3][Generalized Boys function]] is implemented,
|
|
||||||
* ~maxm~ is the maximum total angular momentum.
|
|
||||||
*
|
|
||||||
* \[
|
|
||||||
* F_m(x) = \frac{\gamma(m+1/2,x)}{2x^{m+1/2}}
|
|
||||||
* \]
|
|
||||||
* where $\gamma$ is the incomplete gamma function.
|
|
||||||
*
|
|
||||||
* - $F_0(0.) = 1$
|
|
||||||
* - $F_0(t) = \frac{\sqrt{\pi}}{2\sqrt{t}} \text{erf} ( \sqrt{t} )$
|
|
||||||
* - $F_m(0.) = \frac{1}{2m+1}$
|
|
||||||
* - $F_m(t) = \frac{\gamma{m+1/2,t}}{2t^{m+1/2}}$
|
|
||||||
* - $F_m(t) = \frac{ 2t\, F_{m+1}(t) + e^{-t} }{2m+1}$ *)
|
|
||||||
|
|
||||||
|
|
||||||
(* [[file:~/QCaml/common/util.org::*Functions related to the Boys function][Functions related to the Boys function:4]] *)
|
|
||||||
let boys_function ~maxm t =
|
let boys_function ~maxm t =
|
||||||
assert (t >= 0.);
|
assert (t >= 0.);
|
||||||
match maxm with
|
match maxm with
|
||||||
@ -251,16 +198,8 @@ let boys_function ~maxm t =
|
|||||||
result
|
result
|
||||||
with Exit -> result
|
with Exit -> result
|
||||||
end
|
end
|
||||||
(* Functions related to the Boys function:4 ends here *)
|
|
||||||
|
|
||||||
|
|
||||||
|
|
||||||
(* | ~list_some~ | Filters out all ~None~ elements of the list, and returns the elements without the ~Some~ |
|
|
||||||
* | ~list_range~ | Creates a list of consecutive integers |
|
|
||||||
* | ~list_pack~ | ~list_pack n l~ Creates a list of ~n~-elements lists | *)
|
|
||||||
|
|
||||||
|
|
||||||
(* [[file:~/QCaml/common/util.org::*List functions][List functions:2]] *)
|
|
||||||
let list_some l =
|
let list_some l =
|
||||||
List.filter (function None -> false | _ -> true) l
|
List.filter (function None -> false | _ -> true) l
|
||||||
|> List.rev_map (function Some x -> x | _ -> assert false)
|
|> List.rev_map (function Some x -> x | _ -> assert false)
|
||||||
@ -289,16 +228,9 @@ let list_pack n l =
|
|||||||
| _ -> (aux [@tailcall]) (i-1) (a::accu1) accu2 rest
|
| _ -> (aux [@tailcall]) (i-1) (a::accu1) accu2 rest
|
||||||
in
|
in
|
||||||
aux (n-1) [] [] l
|
aux (n-1) [] [] l
|
||||||
(* List functions:2 ends here *)
|
|
||||||
|
|
||||||
|
|
||||||
|
|
||||||
(* | ~array_range~ | Creates an array of consecutive integers |
|
|
||||||
* | ~array_sum~ | Returns the sum of all the elements of the array |
|
|
||||||
* | ~array_product~ | Returns the product of all the elements of the array | *)
|
|
||||||
|
|
||||||
|
|
||||||
(* [[file:~/QCaml/common/util.org::*Array functions][Array functions:2]] *)
|
|
||||||
let array_range first last =
|
let array_range first last =
|
||||||
if last < first then [| |] else
|
if last < first then [| |] else
|
||||||
Array.init (last-first+1) (fun i -> i+first)
|
Array.init (last-first+1) (fun i -> i+first)
|
||||||
@ -310,16 +242,8 @@ let array_sum a =
|
|||||||
|
|
||||||
let array_product a =
|
let array_product a =
|
||||||
Array.fold_left ( *. ) 1. a
|
Array.fold_left ( *. ) 1. a
|
||||||
(* Array functions:2 ends here *)
|
|
||||||
|
|
||||||
|
|
||||||
|
|
||||||
(* | ~seq_range~ | Creates a sequence returning consecutive integers |
|
|
||||||
* | ~seq_to_list~ | Read a sequence and put items in a list |
|
|
||||||
* | ~seq_fold~ | Apply a fold to the elements of the sequence | *)
|
|
||||||
|
|
||||||
|
|
||||||
(* [[file:~/QCaml/common/util.org::*Seq functions][Seq functions:2]] *)
|
|
||||||
let seq_range first last =
|
let seq_range first last =
|
||||||
Seq.init (last-first) (fun i -> i+first)
|
Seq.init (last-first) (fun i -> i+first)
|
||||||
|
|
||||||
@ -334,39 +258,8 @@ let seq_to_list seq =
|
|||||||
|
|
||||||
let seq_fold f init seq =
|
let seq_fold f init seq =
|
||||||
Seq.fold_left f init seq
|
Seq.fold_left f init seq
|
||||||
(* Seq functions:2 ends here *)
|
|
||||||
|
|
||||||
|
|
||||||
|
|
||||||
(* | ~pp_float_array~ | Printer for float arrays |
|
|
||||||
* | ~pp_float_array_size~ | Printer for float arrays with size |
|
|
||||||
* | ~pp_float_2darray~ | Printer for matrices |
|
|
||||||
* | ~pp_float_2darray_size~ | Printer for matrices with size |
|
|
||||||
* | ~pp_bitstring~ | Printer for bit strings (used by ~Bitstring~ module) |
|
|
||||||
*
|
|
||||||
* Example:
|
|
||||||
* #+begin_example
|
|
||||||
* pp_float_array_size:
|
|
||||||
* [ 6: 1.000000 1.732051 1.732051 1.000000 1.732051 1.000000 ]
|
|
||||||
*
|
|
||||||
* pp_float_array:
|
|
||||||
* [ 1.000000 1.732051 1.732051 1.000000 1.732051 1.000000 ]
|
|
||||||
*
|
|
||||||
* pp_float_2darray_size
|
|
||||||
* [
|
|
||||||
* 2:[ 6: 1.000000 1.732051 1.732051 1.000000 1.732051 1.000000 ]
|
|
||||||
* [ 4: 1.000000 2.000000 3.000000 4.000000 ] ]
|
|
||||||
*
|
|
||||||
* pp_float_2darray:
|
|
||||||
* [ [ 1.000000 1.732051 1.732051 1.000000 1.732051 1.000000 ]
|
|
||||||
* [ 1.000000 2.000000 3.000000 4.000000 ] ]
|
|
||||||
*
|
|
||||||
* pp_bitstring 14:
|
|
||||||
* +++++------+--
|
|
||||||
* #+end_example *)
|
|
||||||
|
|
||||||
|
|
||||||
(* [[file:~/QCaml/common/util.org::*Printers][Printers:2]] *)
|
|
||||||
let pp_float_array ppf a =
|
let pp_float_array ppf a =
|
||||||
Format.fprintf ppf "@[<2>[@ ";
|
Format.fprintf ppf "@[<2>[@ ";
|
||||||
Array.iter (fun f -> Format.fprintf ppf "@[%10f@]@ " f) a;
|
Array.iter (fun f -> Format.fprintf ppf "@[%10f@]@ " f) a;
|
||||||
@ -390,4 +283,3 @@ let pp_float_2darray_size ppf a =
|
|||||||
let pp_bitstring n ppf bs =
|
let pp_bitstring n ppf bs =
|
||||||
String.init n (fun i -> if (Z.testbit bs i) then '+' else '-')
|
String.init n (fun i -> if (Z.testbit bs i) then '+' else '-')
|
||||||
|> Format.fprintf ppf "@[<h>%s@]"
|
|> Format.fprintf ppf "@[<h>%s@]"
|
||||||
(* Printers:2 ends here *)
|
|
||||||
|
@ -1,96 +1,157 @@
|
|||||||
(* [[file:~/QCaml/common/util.org::*Erf][Erf:2]] *)
|
(** Error function *)
|
||||||
external erf_float : float -> float
|
external erf_float : float -> float
|
||||||
= "erf_float_bytecode" "erf_float" [@@unboxed] [@@noalloc]
|
= "erf_float_bytecode" "erf_float" [@@unboxed] [@@noalloc]
|
||||||
(* Erf:2 ends here *)
|
|
||||||
|
|
||||||
(* [[file:~/QCaml/common/util.org::*Erfc][Erfc:2]] *)
|
|
||||||
external erfc_float : float -> float
|
external erfc_float : float -> float
|
||||||
= "erfc_float_bytecode" "erfc_float" [@@unboxed] [@@noalloc]
|
= "erfc_float_bytecode" "erfc_float" [@@unboxed] [@@noalloc]
|
||||||
(* Erfc:2 ends here *)
|
|
||||||
|
|
||||||
(* [[file:~/QCaml/common/util.org::*Gamma][Gamma:2]] *)
|
|
||||||
external gamma_float : float -> float
|
external gamma_float : float -> float
|
||||||
= "gamma_float_bytecode" "gamma_float" [@@unboxed] [@@noalloc]
|
= "gamma_float_bytecode" "gamma_float" [@@unboxed] [@@noalloc]
|
||||||
(* Gamma:2 ends here *)
|
|
||||||
|
|
||||||
(* [[file:~/QCaml/common/util.org::*Popcnt][Popcnt:2]] *)
|
|
||||||
|
(** Bit manipulation functions *)
|
||||||
val popcnt : int64 -> int
|
val popcnt : int64 -> int
|
||||||
(* Popcnt:2 ends here *)
|
|
||||||
|
|
||||||
(* [[file:~/QCaml/common/util.org::*Trailz][Trailz:2]] *)
|
|
||||||
val trailz : int64 -> int
|
val trailz : int64 -> int
|
||||||
(* Trailz:2 ends here *)
|
|
||||||
|
|
||||||
(* [[file:~/QCaml/common/util.org::*Leadz][Leadz:2]] *)
|
|
||||||
val leadz : int64 -> int
|
val leadz : int64 -> int
|
||||||
(* Leadz:2 ends here *)
|
|
||||||
|
|
||||||
(* General functions *)
|
|
||||||
|
|
||||||
|
|
||||||
(* [[file:~/QCaml/common/util.org::*General functions][General functions:1]] *)
|
(** General functions *)
|
||||||
|
|
||||||
val fact : int -> float
|
val fact : int -> float
|
||||||
(* @raise Invalid_argument for negative arguments or arguments >100. *)
|
(** Factorial function.
|
||||||
|
* @raise Invalid_argument for negative arguments or arguments >100. *)
|
||||||
|
|
||||||
val binom : int -> int -> int
|
val binom : int -> int -> int
|
||||||
|
(** Binomial coefficient. ~binom n k~ = $C_n^k$ *)
|
||||||
|
|
||||||
val binom_float : int -> int -> float
|
val binom_float : int -> int -> float
|
||||||
|
(** Binomial coefficient (float). ~binom n k~ = $C_n^k$ *)
|
||||||
|
|
||||||
val chop : float -> (unit -> float) -> float
|
val chop : float -> (unit -> float) -> float
|
||||||
|
(** In ~chop a f~, evaluate ~f~ only if the absolute value of ~a~ is larger than ~Constants.epsilon~, and return ~a *. f ()~. *)
|
||||||
|
|
||||||
val pow : float -> int -> float
|
val pow : float -> int -> float
|
||||||
|
(** Fast implementation of the power function for small integer powers *)
|
||||||
|
|
||||||
val float_of_int_fast : int -> float
|
val float_of_int_fast : int -> float
|
||||||
|
(** Faster implementation of float_of_int for small positive ints *)
|
||||||
|
|
||||||
val of_some : 'a option -> 'a
|
val of_some : 'a option -> 'a
|
||||||
|
(** Extracts the value of an option *)
|
||||||
|
|
||||||
exception Not_implemented of string
|
exception Not_implemented of string
|
||||||
val not_implemented : string -> 'a
|
val not_implemented : string -> 'a
|
||||||
(* @raise Not_implemented. *)
|
(** Fails if some functionality is not implemented
|
||||||
(* General functions:1 ends here *)
|
* @raise Not_implemented. *)
|
||||||
|
|
||||||
(* Functions related to the Boys function *)
|
|
||||||
|
(** Functions related to the Boys function *)
|
||||||
|
|
||||||
|
|
||||||
(* [[file:~/QCaml/common/util.org::*Functions related to the Boys function][Functions related to the Boys function:1]] *)
|
|
||||||
val incomplete_gamma : alpha:float -> float -> float
|
val incomplete_gamma : alpha:float -> float -> float
|
||||||
(* @raise Failure when the calculation doesn't converge. *)
|
(** The lower [[https://en.wikipedia.org/wiki/Incomplete_gamma_function][Incomplete Gamma function]] is implemented :
|
||||||
(* Functions related to the Boys function:1 ends here *)
|
* \[
|
||||||
|
* \gamma(\alpha,x) = \int_0^x e^{-t} t^{\alpha-1} dt
|
||||||
|
* \]
|
||||||
|
*
|
||||||
|
* p: $\frac{1}{\Gamma(\alpha)} \int_0^x e^{-t} t^{\alpha-1} dt$
|
||||||
|
*
|
||||||
|
* q: $\frac{1}{\Gamma(\alpha)} \int_x^\infty e^{-t} t^{\alpha-1} dt$
|
||||||
|
*
|
||||||
|
* Reference : Haruhiko Okumura: C-gengo niyoru saishin algorithm jiten
|
||||||
|
* (New Algorithm handbook in C language) (Gijyutsu hyouron sha,
|
||||||
|
* Tokyo, 1991) p.227 [in Japanese].
|
||||||
|
*
|
||||||
|
* @raise Failure when the calculation doesn't converge. *)
|
||||||
|
|
||||||
(* [[file:~/QCaml/common/util.org::*Functions related to the Boys function][Functions related to the Boys function:3]] *)
|
|
||||||
val boys_function : maxm:int -> float -> float array
|
val boys_function : maxm:int -> float -> float array
|
||||||
(* Functions related to the Boys function:3 ends here *)
|
(** Functions related to the Boys function:3 ends here
|
||||||
|
|
||||||
(* List functions *)
|
The [[https://link.springer.com/article/10.1007/s10910-005-9023-3][Generalized Boys function]] is implemented,
|
||||||
|
~maxm~ is the maximum total angular momentum.
|
||||||
|
|
||||||
|
\[
|
||||||
|
F_m(x) = \frac{\gamma(m+1/2,x)}{2x^{m+1/2}}
|
||||||
|
\]
|
||||||
|
where $\gamma$ is the incomplete gamma function.
|
||||||
|
|
||||||
|
- $F_0(0.) = 1$
|
||||||
|
- $F_0(t) = \frac{\sqrt{\pi}}{2\sqrt{t}} \text{erf} ( \sqrt{t} )$
|
||||||
|
- $F_m(0.) = \frac{1}{2m+1}$
|
||||||
|
- $F_m(t) = \frac{\gamma{m+1/2,t}}{2t^{m+1/2}}$
|
||||||
|
- $F_m(t) = \frac{ 2t\, F_{m+1}(t) + e^{-t} }{2m+1}$
|
||||||
|
*)
|
||||||
|
|
||||||
|
|
||||||
(* [[file:~/QCaml/common/util.org::*List functions][List functions:1]] *)
|
(** List functions *)
|
||||||
|
|
||||||
val list_some : 'a option list -> 'a list
|
val list_some : 'a option list -> 'a list
|
||||||
|
(** Filters out all ~None~ elements of the list, and returns the elements without the ~Some~ *)
|
||||||
|
|
||||||
val list_range : int -> int -> int list
|
val list_range : int -> int -> int list
|
||||||
|
(** Creates a list of consecutive integers *)
|
||||||
|
|
||||||
val list_pack : int -> 'a list -> 'a list list
|
val list_pack : int -> 'a list -> 'a list list
|
||||||
(* List functions:1 ends here *)
|
(** ~list_pack n l~ Creates a list of ~n~-elements lists *)
|
||||||
|
|
||||||
(* Array functions *)
|
|
||||||
|
|
||||||
|
|
||||||
(* [[file:~/QCaml/common/util.org::*Array functions][Array functions:1]] *)
|
(** Array functions *)
|
||||||
|
|
||||||
val array_range : int -> int -> int array
|
val array_range : int -> int -> int array
|
||||||
|
(** Creates an array of consecutive integers *)
|
||||||
|
|
||||||
val array_sum : float array -> float
|
val array_sum : float array -> float
|
||||||
|
(** Returns the sum of all the elements of the array *)
|
||||||
|
|
||||||
val array_product : float array -> float
|
val array_product : float array -> float
|
||||||
(* Array functions:1 ends here *)
|
(** Returns the product of all the elements of the array *)
|
||||||
|
|
||||||
(* Seq functions *)
|
|
||||||
|
|
||||||
|
|
||||||
(* [[file:~/QCaml/common/util.org::*Seq functions][Seq functions:1]] *)
|
(** Seq functions *)
|
||||||
|
|
||||||
val seq_range : int -> int -> int Seq.t
|
val seq_range : int -> int -> int Seq.t
|
||||||
|
(** Creates a sequence returning consecutive integers *)
|
||||||
|
|
||||||
val seq_to_list : 'a Seq.t -> 'a list
|
val seq_to_list : 'a Seq.t -> 'a list
|
||||||
|
(** Read a sequence and put items in a list *)
|
||||||
|
|
||||||
val seq_fold : ('a -> 'b -> 'a) -> 'a -> 'b Seq.t -> 'a
|
val seq_fold : ('a -> 'b -> 'a) -> 'a -> 'b Seq.t -> 'a
|
||||||
(* Seq functions:1 ends here *)
|
(** Apply a fold to the elements of the sequence *)
|
||||||
|
|
||||||
(* Printers *)
|
|
||||||
|
|
||||||
|
|
||||||
(* [[file:~/QCaml/common/util.org::*Printers][Printers:1]] *)
|
(** Printers *)
|
||||||
|
|
||||||
|
(**
|
||||||
|
| ~pp_float_array~ | Printer for float arrays |
|
||||||
|
| ~pp_float_array_size~ | Printer for float arrays with size |
|
||||||
|
| ~pp_float_2darray~ | Printer for matrices |
|
||||||
|
| ~pp_float_2darray_size~ | Printer for matrices with size |
|
||||||
|
| ~pp_bitstring~ | Printer for bit strings (used by ~Bitstring~ module) |
|
||||||
|
|
||||||
|
Example:
|
||||||
|
#+begin_example
|
||||||
|
pp_float_array_size:
|
||||||
|
[ 6: 1.000000 1.732051 1.732051 1.000000 1.732051 1.000000 ]
|
||||||
|
|
||||||
|
pp_float_array:
|
||||||
|
[ 1.000000 1.732051 1.732051 1.000000 1.732051 1.000000 ]
|
||||||
|
|
||||||
|
pp_float_2darray_size
|
||||||
|
[
|
||||||
|
2:[ 6: 1.000000 1.732051 1.732051 1.000000 1.732051 1.000000 ]
|
||||||
|
[ 4: 1.000000 2.000000 3.000000 4.000000 ] ]
|
||||||
|
|
||||||
|
pp_float_2darray:
|
||||||
|
[ [ 1.000000 1.732051 1.732051 1.000000 1.732051 1.000000 ]
|
||||||
|
[ 1.000000 2.000000 3.000000 4.000000 ] ]
|
||||||
|
|
||||||
|
pp_bitstring 14:
|
||||||
|
+++++------+--
|
||||||
|
#+end_example
|
||||||
|
*)
|
||||||
|
|
||||||
val pp_float_array_size : Format.formatter -> float array -> unit
|
val pp_float_array_size : Format.formatter -> float array -> unit
|
||||||
val pp_float_array : Format.formatter -> float array -> unit
|
val pp_float_array : Format.formatter -> float array -> unit
|
||||||
val pp_float_2darray_size : Format.formatter -> float array array -> unit
|
val pp_float_2darray_size : Format.formatter -> float array array -> unit
|
||||||
val pp_float_2darray : Format.formatter -> float array array -> unit
|
val pp_float_2darray : Format.formatter -> float array array -> unit
|
||||||
val pp_bitstring : int -> Format.formatter -> Z.t -> unit
|
val pp_bitstring : int -> Format.formatter -> Z.t -> unit
|
||||||
(* Printers:1 ends here *)
|
|
||||||
|
672
common/util.org
672
common/util.org
@ -1,672 +0,0 @@
|
|||||||
#+begin_src elisp tangle: no :results none :exports none
|
|
||||||
(setq pwd (file-name-directory buffer-file-name))
|
|
||||||
(setq name (file-name-nondirectory (substring buffer-file-name 0 -4)))
|
|
||||||
(setq lib (concat pwd "lib/"))
|
|
||||||
(setq testdir (concat pwd "test/"))
|
|
||||||
(setq mli (concat lib name ".mli"))
|
|
||||||
(setq ml (concat lib name ".ml"))
|
|
||||||
(setq c (concat lib name ".c"))
|
|
||||||
(setq test-ml (concat testdir name ".ml"))
|
|
||||||
(org-babel-tangle)
|
|
||||||
#+end_src
|
|
||||||
|
|
||||||
* Util
|
|
||||||
:PROPERTIES:
|
|
||||||
:header-args: :noweb yes :comments both
|
|
||||||
:END:
|
|
||||||
|
|
||||||
Utility functions.
|
|
||||||
|
|
||||||
|
|
||||||
** Test header :noexport:
|
|
||||||
|
|
||||||
#+begin_src ocaml :tangle (eval test-ml) :exports none
|
|
||||||
open Common.Util
|
|
||||||
open Alcotest
|
|
||||||
#+end_src
|
|
||||||
|
|
||||||
** External C functions
|
|
||||||
|
|
||||||
| ~erf_float~ | Error function ~erf~ from =libm= |
|
|
||||||
| ~erfc_float~ | Complementary error function ~erfc~ from =libm= |
|
|
||||||
| ~gamma_float~ | Gamma function ~gamma~ from =libm= |
|
|
||||||
| ~popcnt~ | ~popcnt~ instruction |
|
|
||||||
| ~trailz~ | ~ctz~ instruction |
|
|
||||||
| ~leadz~ | ~bsf~ instruction |
|
|
||||||
|
|
||||||
#+begin_src c :tangle (eval c) :exports none
|
|
||||||
#include <math.h>
|
|
||||||
#include <caml/mlvalues.h>
|
|
||||||
#include <caml/alloc.h>
|
|
||||||
#+end_src
|
|
||||||
|
|
||||||
*** Erf
|
|
||||||
|
|
||||||
#+begin_src c :tangle (eval c) :exports none
|
|
||||||
CAMLprim value erf_float_bytecode(value x) {
|
|
||||||
return caml_copy_double(erf(Double_val(x)));
|
|
||||||
}
|
|
||||||
|
|
||||||
CAMLprim double erf_float(double x) {
|
|
||||||
return erf(x);
|
|
||||||
}
|
|
||||||
#+end_src
|
|
||||||
|
|
||||||
#+begin_src ocaml :tangle (eval mli)
|
|
||||||
external erf_float : float -> float
|
|
||||||
= "erf_float_bytecode" "erf_float" [@@unboxed] [@@noalloc]
|
|
||||||
#+end_src
|
|
||||||
|
|
||||||
#+begin_src ocaml :tangle (eval ml) :exports none
|
|
||||||
external erf_float : float -> float
|
|
||||||
= "erf_float_bytecode" "erf_float" [@@unboxed] [@@noalloc]
|
|
||||||
#+end_src
|
|
||||||
|
|
||||||
*** Erfc
|
|
||||||
|
|
||||||
#+begin_src c :tangle (eval c) :exports none
|
|
||||||
CAMLprim value erfc_float_bytecode(value x) {
|
|
||||||
return caml_copy_double(erfc(Double_val(x)));
|
|
||||||
}
|
|
||||||
|
|
||||||
CAMLprim double erfc_float(double x) {
|
|
||||||
return erfc(x);
|
|
||||||
}
|
|
||||||
#+end_src
|
|
||||||
|
|
||||||
#+begin_src ocaml :tangle (eval mli)
|
|
||||||
external erfc_float : float -> float
|
|
||||||
= "erfc_float_bytecode" "erfc_float" [@@unboxed] [@@noalloc]
|
|
||||||
#+end_src
|
|
||||||
|
|
||||||
#+begin_src ocaml :tangle (eval ml) :exports none
|
|
||||||
external erfc_float : float -> float = "erfc_float_bytecode" "erfc_float" [@@unboxed] [@@noalloc]
|
|
||||||
#+end_src
|
|
||||||
|
|
||||||
*** Gamma
|
|
||||||
|
|
||||||
#+begin_src c :tangle (eval c) :exports none
|
|
||||||
CAMLprim value gamma_float_bytecode(value x) {
|
|
||||||
return caml_copy_double(tgamma(Double_val(x)));
|
|
||||||
}
|
|
||||||
|
|
||||||
|
|
||||||
CAMLprim double gamma_float(double x) {
|
|
||||||
return tgamma(x);
|
|
||||||
}
|
|
||||||
#+end_src
|
|
||||||
|
|
||||||
#+begin_src ocaml :tangle (eval mli)
|
|
||||||
external gamma_float : float -> float
|
|
||||||
= "gamma_float_bytecode" "gamma_float" [@@unboxed] [@@noalloc]
|
|
||||||
#+end_src
|
|
||||||
|
|
||||||
#+begin_src ocaml :tangle (eval ml) :exports none
|
|
||||||
external gamma_float : float -> float
|
|
||||||
= "gamma_float_bytecode" "gamma_float" [@@unboxed] [@@noalloc]
|
|
||||||
#+end_src
|
|
||||||
|
|
||||||
*** Popcnt
|
|
||||||
|
|
||||||
#+begin_src c :tangle (eval c) :exports none
|
|
||||||
CAMLprim int32_t popcnt(int64_t i) {
|
|
||||||
return __builtin_popcountll (i);
|
|
||||||
}
|
|
||||||
|
|
||||||
|
|
||||||
CAMLprim value popcnt_bytecode(value i) {
|
|
||||||
return caml_copy_int32(__builtin_popcountll (Int64_val(i)));
|
|
||||||
}
|
|
||||||
#+end_src
|
|
||||||
|
|
||||||
#+begin_src ocaml :tangle (eval mli)
|
|
||||||
val popcnt : int64 -> int
|
|
||||||
#+end_src
|
|
||||||
|
|
||||||
#+begin_src ocaml :tangle (eval ml) :exports none
|
|
||||||
external popcnt : int64 -> int32 = "popcnt_bytecode" "popcnt"
|
|
||||||
[@@unboxed] [@@noalloc]
|
|
||||||
|
|
||||||
let popcnt i = (popcnt [@inlined] ) i |> Int32.to_int
|
|
||||||
#+end_src
|
|
||||||
|
|
||||||
*** Trailz
|
|
||||||
|
|
||||||
#+begin_src c :tangle (eval c) :exports none
|
|
||||||
CAMLprim int32_t trailz(int64_t i) {
|
|
||||||
return i == 0L ? 64 : __builtin_ctzll (i);
|
|
||||||
}
|
|
||||||
|
|
||||||
|
|
||||||
CAMLprim value trailz_bytecode(value i) {
|
|
||||||
return caml_copy_int32(i == 0L ? 64 : __builtin_ctzll (Int64_val(i)));
|
|
||||||
}
|
|
||||||
#+end_src
|
|
||||||
|
|
||||||
#+begin_src ocaml :tangle (eval mli)
|
|
||||||
val trailz : int64 -> int
|
|
||||||
#+end_src
|
|
||||||
|
|
||||||
#+begin_src ocaml :tangle (eval ml) :exports none
|
|
||||||
external trailz : int64 -> int32 = "trailz_bytecode" "trailz" "int"
|
|
||||||
[@@unboxed] [@@noalloc]
|
|
||||||
|
|
||||||
let trailz i = trailz i |> Int32.to_int
|
|
||||||
#+end_src
|
|
||||||
|
|
||||||
*** Leadz
|
|
||||||
|
|
||||||
#+begin_src c :tangle (eval c) :exports none
|
|
||||||
CAMLprim int32_t leadz(int64_t i) {
|
|
||||||
return i == 0L ? 64 : __builtin_clzll(i);
|
|
||||||
}
|
|
||||||
|
|
||||||
|
|
||||||
CAMLprim value leadz_bytecode(value i) {
|
|
||||||
return caml_copy_int32(i == 0L ? 64 : __builtin_clzll (Int64_val(i)));
|
|
||||||
}
|
|
||||||
#+end_src
|
|
||||||
|
|
||||||
#+begin_src ocaml :tangle (eval mli)
|
|
||||||
val leadz : int64 -> int
|
|
||||||
#+end_src
|
|
||||||
|
|
||||||
#+begin_src ocaml :tangle (eval ml) :exports none
|
|
||||||
external leadz : int64 -> int32 = "leadz_bytecode" "leadz" "int"
|
|
||||||
[@@unboxed] [@@noalloc]
|
|
||||||
|
|
||||||
let leadz i = leadz i |> Int32.to_int
|
|
||||||
#+end_src
|
|
||||||
|
|
||||||
*** Test
|
|
||||||
|
|
||||||
#+begin_src ocaml :tangle (eval test-ml) :exports none
|
|
||||||
let test_external () =
|
|
||||||
check (float 1.e-15) "erf" 0.842700792949715 (erf_float 1.0);
|
|
||||||
check (float 1.e-15) "erf" 0.112462916018285 (erf_float 0.1);
|
|
||||||
check (float 1.e-15) "erf" (-0.112462916018285) (erf_float (-0.1));
|
|
||||||
check (float 1.e-15) "erfc" 0.157299207050285 (erfc_float 1.0);
|
|
||||||
check (float 1.e-15) "erfc" 0.887537083981715 (erfc_float 0.1);
|
|
||||||
check (float 1.e-15) "erfc" (1.112462916018285) (erfc_float (-0.1));
|
|
||||||
check (float 1.e-14) "gamma" (1.77245385090552) (gamma_float 0.5);
|
|
||||||
check (float 1.e-14) "gamma" (9.51350769866873) (gamma_float (0.1));
|
|
||||||
check (float 1.e-14) "gamma" (-3.54490770181103) (gamma_float (-0.5));
|
|
||||||
check int "popcnt" 6 (popcnt @@ Int64.of_int 63);
|
|
||||||
check int "popcnt" 8 (popcnt @@ Int64.of_int 299605);
|
|
||||||
check int "popcnt" 1 (popcnt @@ Int64.of_int 65536);
|
|
||||||
check int "popcnt" 0 (popcnt @@ Int64.of_int 0);
|
|
||||||
check int "trailz" 3 (trailz @@ Int64.of_int 8);
|
|
||||||
check int "trailz" 2 (trailz @@ Int64.of_int 12);
|
|
||||||
check int "trailz" 0 (trailz @@ Int64.of_int 1);
|
|
||||||
check int "trailz" 64 (trailz @@ Int64.of_int 0);
|
|
||||||
check int "leadz" 60 (leadz @@ Int64.of_int 8);
|
|
||||||
check int "leadz" 60 (leadz @@ Int64.of_int 12);
|
|
||||||
check int "leadz" 63 (leadz @@ Int64.of_int 1);
|
|
||||||
check int "leadz" 64 (leadz @@ Int64.of_int 0);
|
|
||||||
()
|
|
||||||
#+end_src
|
|
||||||
|
|
||||||
** General functions
|
|
||||||
|
|
||||||
#+begin_src ocaml :tangle (eval mli)
|
|
||||||
val fact : int -> float
|
|
||||||
(* @raise Invalid_argument for negative arguments or arguments >100. *)
|
|
||||||
val binom : int -> int -> int
|
|
||||||
val binom_float : int -> int -> float
|
|
||||||
|
|
||||||
val chop : float -> (unit -> float) -> float
|
|
||||||
val pow : float -> int -> float
|
|
||||||
val float_of_int_fast : int -> float
|
|
||||||
|
|
||||||
val of_some : 'a option -> 'a
|
|
||||||
|
|
||||||
exception Not_implemented of string
|
|
||||||
val not_implemented : string -> 'a
|
|
||||||
(* @raise Not_implemented. *)
|
|
||||||
#+end_src
|
|
||||||
|
|
||||||
| ~fact~ | Factorial function. |
|
|
||||||
| ~binom~ | Binomial coefficient. ~binom n k~ = $C_n^k$ |
|
|
||||||
| ~binom_float~ | float variant of ~binom~ |
|
|
||||||
| ~pow~ | Fast implementation of the power function for small integer powers |
|
|
||||||
| ~chop~ | In ~chop a f~, evaluate ~f~ only if the absolute value of ~a~ is larger than ~Constants.epsilon~, and return ~a *. f ()~. |
|
|
||||||
| ~float_of_int_fast~ | Faster implementation of float_of_int for small positive ints |
|
|
||||||
| ~not_implemented~ | Fails if some functionality is not implemented |
|
|
||||||
| ~of_some~ | Extracts the value of an option |
|
|
||||||
|
|
||||||
#+begin_src ocaml :tangle (eval ml) :exports none
|
|
||||||
let memo_float_of_int =
|
|
||||||
Array.init 64 float_of_int
|
|
||||||
|
|
||||||
let float_of_int_fast i =
|
|
||||||
if Int.logand i 63 = i then
|
|
||||||
memo_float_of_int.(i)
|
|
||||||
else
|
|
||||||
float_of_int i
|
|
||||||
|
|
||||||
|
|
||||||
let factmax = 150
|
|
||||||
|
|
||||||
let fact_memo =
|
|
||||||
let rec aux accu_l accu = function
|
|
||||||
| 0 -> (aux [@tailcall]) [1.] 1. 1
|
|
||||||
| i when (i = factmax) ->
|
|
||||||
let x = (float_of_int factmax) *. accu in
|
|
||||||
List.rev (x::accu_l)
|
|
||||||
| i -> let x = (float_of_int i) *. accu in
|
|
||||||
(aux [@tailcall]) (x::accu_l) x (i+1)
|
|
||||||
in
|
|
||||||
aux [] 0. 0
|
|
||||||
|> Array.of_list
|
|
||||||
|
|
||||||
let fact = function
|
|
||||||
| i when (i < 0) ->
|
|
||||||
raise (Invalid_argument "Argument of factorial should be non-negative")
|
|
||||||
| i when (i > 150) ->
|
|
||||||
raise (Invalid_argument "Result of factorial is infinite")
|
|
||||||
| i -> fact_memo.(i)
|
|
||||||
|
|
||||||
|
|
||||||
let binom =
|
|
||||||
let memo =
|
|
||||||
let m = Array.make_matrix 64 64 0 in
|
|
||||||
for n=0 to Array.length m - 1 do
|
|
||||||
m.(n).(0) <- 1;
|
|
||||||
m.(n).(n) <- 1;
|
|
||||||
for k=1 to (n - 1) do
|
|
||||||
m.(n).(k) <- m.(n-1).(k-1) + m.(n-1).(k)
|
|
||||||
done
|
|
||||||
done;
|
|
||||||
m
|
|
||||||
in
|
|
||||||
let rec f n k =
|
|
||||||
assert (k >= 0);
|
|
||||||
assert (n >= k);
|
|
||||||
if k = 0 || k = n then
|
|
||||||
1
|
|
||||||
else if n < 64 then
|
|
||||||
memo.(n).(k)
|
|
||||||
else
|
|
||||||
f (n-1) (k-1) + f (n-1) k
|
|
||||||
in f
|
|
||||||
|
|
||||||
|
|
||||||
let binom_float n k =
|
|
||||||
binom n k
|
|
||||||
|> float_of_int_fast
|
|
||||||
|
|
||||||
|
|
||||||
let rec pow a = function
|
|
||||||
| 0 -> 1.
|
|
||||||
| 1 -> a
|
|
||||||
| 2 -> a *. a
|
|
||||||
| 3 -> a *. a *. a
|
|
||||||
| -1 -> 1. /. a
|
|
||||||
| n when n > 0 ->
|
|
||||||
let b = pow a (n / 2) in
|
|
||||||
b *. b *. (if n mod 2 = 0 then 1. else a)
|
|
||||||
| n when n < 0 -> (pow [@tailcall]) (1./.a) (-n)
|
|
||||||
| _ -> assert false
|
|
||||||
|
|
||||||
|
|
||||||
let chop f g =
|
|
||||||
if (abs_float f) < Constants.epsilon then 0.
|
|
||||||
else f *. (g ())
|
|
||||||
|
|
||||||
|
|
||||||
exception Not_implemented of string
|
|
||||||
let not_implemented string =
|
|
||||||
raise (Not_implemented string)
|
|
||||||
|
|
||||||
|
|
||||||
let of_some = function
|
|
||||||
| Some a -> a
|
|
||||||
| None -> assert false
|
|
||||||
|
|
||||||
#+end_src
|
|
||||||
|
|
||||||
|
|
||||||
#+begin_src ocaml :tangle (eval test-ml) :exports none
|
|
||||||
let test_general () =
|
|
||||||
check int "of_some_of_int_fast" 1 (of_some (Some 1)) ;
|
|
||||||
check int "binom" 35 (binom 7 4);
|
|
||||||
check (float 1.e-15) "fact" 5040. (fact 7);
|
|
||||||
check (float 1.e-15) "binom_float" 35.0 (binom_float 7 4);
|
|
||||||
check (float 1.e-15) "pow" 729.0 (pow 3.0 6);
|
|
||||||
check (float 1.e-15) "float_of_int_fast" 10.0 (float_of_int_fast 10);
|
|
||||||
()
|
|
||||||
#+end_src
|
|
||||||
|
|
||||||
** Functions related to the Boys function
|
|
||||||
|
|
||||||
#+begin_src ocaml :tangle (eval mli)
|
|
||||||
val incomplete_gamma : alpha:float -> float -> float
|
|
||||||
(* @raise Failure when the calculation doesn't converge. *)
|
|
||||||
#+end_src
|
|
||||||
|
|
||||||
The lower [[https://en.wikipedia.org/wiki/Incomplete_gamma_function][Incomplete Gamma function]] is implemented :
|
|
||||||
\[
|
|
||||||
\gamma(\alpha,x) = \int_0^x e^{-t} t^{\alpha-1} dt
|
|
||||||
\]
|
|
||||||
|
|
||||||
p: $\frac{1}{\Gamma(\alpha)} \int_0^x e^{-t} t^{\alpha-1} dt$
|
|
||||||
|
|
||||||
q: $\frac{1}{\Gamma(\alpha)} \int_x^\infty e^{-t} t^{\alpha-1} dt$
|
|
||||||
|
|
||||||
Reference : Haruhiko Okumura: C-gengo niyoru saishin algorithm jiten
|
|
||||||
(New Algorithm handbook in C language) (Gijyutsu hyouron sha,
|
|
||||||
Tokyo, 1991) p.227 [in Japanese]
|
|
||||||
|
|
||||||
|
|
||||||
#+begin_src ocaml :tangle (eval ml) :exports none
|
|
||||||
let incomplete_gamma ~alpha x =
|
|
||||||
assert (alpha >= 0.);
|
|
||||||
assert (x >= 0.);
|
|
||||||
let a = alpha in
|
|
||||||
let a_inv = 1./. a in
|
|
||||||
let gf = gamma_float alpha in
|
|
||||||
let loggamma_a = log gf in
|
|
||||||
let rec p_gamma x =
|
|
||||||
if x >= 1. +. a then 1. -. q_gamma x
|
|
||||||
else if x = 0. then 0.
|
|
||||||
else
|
|
||||||
let rec pg_loop prev res term k =
|
|
||||||
if k > 1000. then failwith "p_gamma did not converge."
|
|
||||||
else if prev = res then res
|
|
||||||
else
|
|
||||||
let term = term *. x /. (a +. k) in
|
|
||||||
(pg_loop [@tailcall]) res (res +. term) term (k +. 1.)
|
|
||||||
in
|
|
||||||
let r0 = exp (a *. log x -. x -. loggamma_a) *. a_inv in
|
|
||||||
pg_loop min_float r0 r0 1.
|
|
||||||
|
|
||||||
and q_gamma x =
|
|
||||||
if x < 1. +. a then 1. -. p_gamma x
|
|
||||||
else
|
|
||||||
let rec qg_loop prev res la lb w k =
|
|
||||||
if k > 1000. then failwith "q_gamma did not converge."
|
|
||||||
else if prev = res then res
|
|
||||||
else
|
|
||||||
let k_inv = 1. /. k in
|
|
||||||
let kma = (k -. 1. -. a) *. k_inv in
|
|
||||||
let la, lb =
|
|
||||||
lb, kma *. (lb -. la) +. (k +. x) *. lb *. k_inv
|
|
||||||
in
|
|
||||||
let w = w *. kma in
|
|
||||||
let prev, res = res, res +. w /. (la *. lb) in
|
|
||||||
(qg_loop [@tailcall]) prev res la lb w (k +. 1.)
|
|
||||||
in
|
|
||||||
let w = exp (a *. log x -. x -. loggamma_a) in
|
|
||||||
let lb = (1. +. x -. a) in
|
|
||||||
qg_loop min_float (w /. lb) 1. lb w 2.0
|
|
||||||
in
|
|
||||||
gf *. p_gamma x
|
|
||||||
#+end_src
|
|
||||||
|
|
||||||
#+begin_src ocaml :tangle (eval mli)
|
|
||||||
val boys_function : maxm:int -> float -> float array
|
|
||||||
#+end_src
|
|
||||||
|
|
||||||
The [[https://link.springer.com/article/10.1007/s10910-005-9023-3][Generalized Boys function]] is implemented,
|
|
||||||
~maxm~ is the maximum total angular momentum.
|
|
||||||
|
|
||||||
\[
|
|
||||||
F_m(x) = \frac{\gamma(m+1/2,x)}{2x^{m+1/2}}
|
|
||||||
\]
|
|
||||||
where $\gamma$ is the incomplete gamma function.
|
|
||||||
|
|
||||||
- $F_0(0.) = 1$
|
|
||||||
- $F_0(t) = \frac{\sqrt{\pi}}{2\sqrt{t}} \text{erf} ( \sqrt{t} )$
|
|
||||||
- $F_m(0.) = \frac{1}{2m+1}$
|
|
||||||
- $F_m(t) = \frac{\gamma{m+1/2,t}}{2t^{m+1/2}}$
|
|
||||||
- $F_m(t) = \frac{ 2t\, F_{m+1}(t) + e^{-t} }{2m+1}$
|
|
||||||
|
|
||||||
#+begin_src ocaml :tangle (eval ml) :exports none
|
|
||||||
let boys_function ~maxm t =
|
|
||||||
assert (t >= 0.);
|
|
||||||
match maxm with
|
|
||||||
| 0 ->
|
|
||||||
begin
|
|
||||||
if t = 0. then [| 1. |] else
|
|
||||||
let sq_t = sqrt t in
|
|
||||||
[| (Constants.sq_pi_over_two /. sq_t) *. erf_float sq_t |]
|
|
||||||
end
|
|
||||||
| _ ->
|
|
||||||
begin
|
|
||||||
assert (maxm > 0);
|
|
||||||
let result =
|
|
||||||
Array.init (maxm+1) (fun m -> 1. /. float_of_int (2*m+1))
|
|
||||||
in
|
|
||||||
let power_t_inv = (maxm+maxm+1) in
|
|
||||||
try
|
|
||||||
let fmax =
|
|
||||||
let t_inv = sqrt (1. /. t) in
|
|
||||||
let n = float_of_int maxm in
|
|
||||||
let dm = 0.5 +. n in
|
|
||||||
let f = (pow t_inv power_t_inv ) in
|
|
||||||
match classify_float f with
|
|
||||||
| FP_normal -> (incomplete_gamma ~alpha:dm t) *. 0.5 *. f
|
|
||||||
| FP_zero
|
|
||||||
| FP_subnormal -> 0.
|
|
||||||
| _ -> raise Exit
|
|
||||||
in
|
|
||||||
let emt = exp (-. t) in
|
|
||||||
result.(maxm) <- fmax;
|
|
||||||
for n=maxm-1 downto 0 do
|
|
||||||
result.(n) <- ( (t+.t) *. result.(n+1) +. emt) *. result.(n)
|
|
||||||
done;
|
|
||||||
result
|
|
||||||
with Exit -> result
|
|
||||||
end
|
|
||||||
#+end_src
|
|
||||||
|
|
||||||
#+begin_src ocaml :tangle (eval test-ml) :exports none
|
|
||||||
let test_boys () =
|
|
||||||
check (float 1.e-15) "incomplete_gamma" 0.0 (incomplete_gamma ~alpha:0.5 0.);
|
|
||||||
check (float 1.e-15) "incomplete_gamma" 1.114707979049507 (incomplete_gamma ~alpha:0.5 0.4);
|
|
||||||
check (float 1.e-15) "incomplete_gamma" 1.4936482656248544 (incomplete_gamma ~alpha:0.5 1.);
|
|
||||||
check (float 1.e-15) "incomplete_gamma" 1.7724401246392805 (incomplete_gamma ~alpha:0.5 10.);
|
|
||||||
check (float 1.e-15) "incomplete_gamma" 1.7724538509055159 (incomplete_gamma ~alpha:0.5 100.);
|
|
||||||
|
|
||||||
check (float 1.e-15) "boys" 1.0 (boys_function ~maxm:0 0.).(0);
|
|
||||||
check (float 1.e-15) "boys" 0.2 (boys_function ~maxm:2 0.).(2);
|
|
||||||
check (float 1.e-15) "boys" (1./.3.) (boys_function ~maxm:2 0.).(1);
|
|
||||||
check (float 1.e-15) "boys" 0.8556243918921488 (boys_function ~maxm:0 0.5).(0);
|
|
||||||
check (float 1.e-15) "boys" 0.14075053682591263 (boys_function ~maxm:2 0.5).(2);
|
|
||||||
check (float 1.e-15) "boys" 0.00012711171070276764 (boys_function ~maxm:3 15.).(3);
|
|
||||||
()
|
|
||||||
#+end_src
|
|
||||||
|
|
||||||
** List functions
|
|
||||||
|
|
||||||
#+begin_src ocaml :tangle (eval mli)
|
|
||||||
val list_some : 'a option list -> 'a list
|
|
||||||
val list_range : int -> int -> int list
|
|
||||||
val list_pack : int -> 'a list -> 'a list list
|
|
||||||
#+end_src
|
|
||||||
|
|
||||||
| ~list_some~ | Filters out all ~None~ elements of the list, and returns the elements without the ~Some~ |
|
|
||||||
| ~list_range~ | Creates a list of consecutive integers |
|
|
||||||
| ~list_pack~ | ~list_pack n l~ Creates a list of ~n~-elements lists |
|
|
||||||
|
|
||||||
#+begin_src ocaml :tangle (eval ml) :exports none
|
|
||||||
let list_some l =
|
|
||||||
List.filter (function None -> false | _ -> true) l
|
|
||||||
|> List.rev_map (function Some x -> x | _ -> assert false)
|
|
||||||
|> List.rev
|
|
||||||
|
|
||||||
|
|
||||||
let list_range first last =
|
|
||||||
if last < first then [] else
|
|
||||||
let rec aux accu = function
|
|
||||||
| 0 -> first :: accu
|
|
||||||
| i -> (aux [@tailcall]) ( (first+i)::accu ) (i-1)
|
|
||||||
in
|
|
||||||
aux [] (last-first)
|
|
||||||
|
|
||||||
|
|
||||||
let list_pack n l =
|
|
||||||
assert (n>=0);
|
|
||||||
let rec aux i accu1 accu2 = function
|
|
||||||
| [] -> if accu1 = [] then
|
|
||||||
List.rev accu2
|
|
||||||
else
|
|
||||||
List.rev ((List.rev accu1) :: accu2)
|
|
||||||
| a :: rest ->
|
|
||||||
match i with
|
|
||||||
| 0 -> (aux [@tailcall]) (n-1) [] ((List.rev (a::accu1)) :: accu2) rest
|
|
||||||
| _ -> (aux [@tailcall]) (i-1) (a::accu1) accu2 rest
|
|
||||||
in
|
|
||||||
aux (n-1) [] [] l
|
|
||||||
|
|
||||||
#+end_src
|
|
||||||
|
|
||||||
#+begin_src ocaml :tangle (eval test-ml) :exports none
|
|
||||||
let test_list () =
|
|
||||||
check bool "list_range" true ([ 2; 3; 4 ] = list_range 2 4);
|
|
||||||
check bool "list_some" true ([ 2; 3; 4 ] =
|
|
||||||
list_some ([ None ; Some 2 ; None ; Some 3 ; None ; None ; Some 4]) );
|
|
||||||
check bool "list_pack" true (list_pack 3 (list_range 1 20) =
|
|
||||||
[[1; 2; 3]; [4; 5; 6]; [7; 8; 9]; [10; 11; 12]; [13; 14; 15];
|
|
||||||
[16; 17; 18]; [19; 20]]);
|
|
||||||
()
|
|
||||||
#+end_src
|
|
||||||
|
|
||||||
** Array functions
|
|
||||||
|
|
||||||
#+begin_src ocaml :tangle (eval mli)
|
|
||||||
val array_range : int -> int -> int array
|
|
||||||
val array_sum : float array -> float
|
|
||||||
val array_product : float array -> float
|
|
||||||
#+end_src
|
|
||||||
|
|
||||||
| ~array_range~ | Creates an array of consecutive integers |
|
|
||||||
| ~array_sum~ | Returns the sum of all the elements of the array |
|
|
||||||
| ~array_product~ | Returns the product of all the elements of the array |
|
|
||||||
|
|
||||||
#+begin_src ocaml :tangle (eval ml) :exports none
|
|
||||||
let array_range first last =
|
|
||||||
if last < first then [| |] else
|
|
||||||
Array.init (last-first+1) (fun i -> i+first)
|
|
||||||
|
|
||||||
|
|
||||||
let array_sum a =
|
|
||||||
Array.fold_left ( +. ) 0. a
|
|
||||||
|
|
||||||
|
|
||||||
let array_product a =
|
|
||||||
Array.fold_left ( *. ) 1. a
|
|
||||||
#+end_src
|
|
||||||
|
|
||||||
#+begin_src ocaml :tangle (eval test-ml) :exports none
|
|
||||||
let test_array () =
|
|
||||||
check bool "array_range" true ([| 2; 3; 4 |] = array_range 2 4);
|
|
||||||
check (float 1.e-15) "array_sum" 9. (array_sum [| 2.; 3.; 4. |]);
|
|
||||||
check (float 1.e-15) "array_product" 24. (array_product [| 2.; 3.; 4. |]);
|
|
||||||
()
|
|
||||||
#+end_src
|
|
||||||
|
|
||||||
** Seq functions
|
|
||||||
|
|
||||||
#+begin_src ocaml :tangle (eval mli)
|
|
||||||
val seq_range : int -> int -> int Seq.t
|
|
||||||
val seq_to_list : 'a Seq.t -> 'a list
|
|
||||||
val seq_fold : ('a -> 'b -> 'a) -> 'a -> 'b Seq.t -> 'a
|
|
||||||
#+end_src
|
|
||||||
|
|
||||||
| ~seq_range~ | Creates a sequence returning consecutive integers |
|
|
||||||
| ~seq_to_list~ | Read a sequence and put items in a list |
|
|
||||||
| ~seq_fold~ | Apply a fold to the elements of the sequence |
|
|
||||||
|
|
||||||
#+begin_src ocaml :tangle (eval ml) :exports none
|
|
||||||
let seq_range first last =
|
|
||||||
Seq.init (last-first) (fun i -> i+first)
|
|
||||||
|
|
||||||
let seq_to_list seq =
|
|
||||||
let rec aux accu xs =
|
|
||||||
match Seq.uncons xs with
|
|
||||||
| Some (x, xs) -> aux (x::accu) xs
|
|
||||||
| None -> List.rev accu
|
|
||||||
in
|
|
||||||
aux [] seq
|
|
||||||
|
|
||||||
|
|
||||||
let seq_fold f init seq =
|
|
||||||
Seq.fold_left f init seq
|
|
||||||
#+end_src
|
|
||||||
|
|
||||||
** Printers
|
|
||||||
|
|
||||||
#+begin_src ocaml :tangle (eval mli)
|
|
||||||
val pp_float_array_size : Format.formatter -> float array -> unit
|
|
||||||
val pp_float_array : Format.formatter -> float array -> unit
|
|
||||||
val pp_float_2darray_size : Format.formatter -> float array array -> unit
|
|
||||||
val pp_float_2darray : Format.formatter -> float array array -> unit
|
|
||||||
val pp_bitstring : int -> Format.formatter -> Z.t -> unit
|
|
||||||
#+end_src
|
|
||||||
|
|
||||||
| ~pp_float_array~ | Printer for float arrays |
|
|
||||||
| ~pp_float_array_size~ | Printer for float arrays with size |
|
|
||||||
| ~pp_float_2darray~ | Printer for matrices |
|
|
||||||
| ~pp_float_2darray_size~ | Printer for matrices with size |
|
|
||||||
| ~pp_bitstring~ | Printer for bit strings (used by ~Bitstring~ module) |
|
|
||||||
|
|
||||||
Example:
|
|
||||||
#+begin_example
|
|
||||||
pp_float_array_size:
|
|
||||||
[ 6: 1.000000 1.732051 1.732051 1.000000 1.732051 1.000000 ]
|
|
||||||
|
|
||||||
pp_float_array:
|
|
||||||
[ 1.000000 1.732051 1.732051 1.000000 1.732051 1.000000 ]
|
|
||||||
|
|
||||||
pp_float_2darray_size
|
|
||||||
[
|
|
||||||
2:[ 6: 1.000000 1.732051 1.732051 1.000000 1.732051 1.000000 ]
|
|
||||||
[ 4: 1.000000 2.000000 3.000000 4.000000 ] ]
|
|
||||||
|
|
||||||
pp_float_2darray:
|
|
||||||
[ [ 1.000000 1.732051 1.732051 1.000000 1.732051 1.000000 ]
|
|
||||||
[ 1.000000 2.000000 3.000000 4.000000 ] ]
|
|
||||||
|
|
||||||
pp_bitstring 14:
|
|
||||||
+++++------+--
|
|
||||||
#+end_example
|
|
||||||
|
|
||||||
#+begin_src ocaml :tangle (eval ml) :exports none
|
|
||||||
let pp_float_array ppf a =
|
|
||||||
Format.fprintf ppf "@[<2>[@ ";
|
|
||||||
Array.iter (fun f -> Format.fprintf ppf "@[%10f@]@ " f) a;
|
|
||||||
Format.fprintf ppf "]@]"
|
|
||||||
|
|
||||||
let pp_float_array_size ppf a =
|
|
||||||
Format.fprintf ppf "@[<2>@[ %d:@[<2>" (Array.length a);
|
|
||||||
Array.iter (fun f -> Format.fprintf ppf "@[%10f@]@ " f) a;
|
|
||||||
Format.fprintf ppf "]@]@]"
|
|
||||||
|
|
||||||
let pp_float_2darray ppf a =
|
|
||||||
Format.fprintf ppf "@[<2>[@ ";
|
|
||||||
Array.iter (fun f -> Format.fprintf ppf "@[%a@]@ " pp_float_array f) a;
|
|
||||||
Format.fprintf ppf "]@]"
|
|
||||||
|
|
||||||
let pp_float_2darray_size ppf a =
|
|
||||||
Format.fprintf ppf "@[<2>@[ %d:@[" (Array.length a);
|
|
||||||
Array.iter (fun f -> Format.fprintf ppf "@[%a@]@ " pp_float_array_size f) a;
|
|
||||||
Format.fprintf ppf "]@]@]"
|
|
||||||
|
|
||||||
let pp_bitstring n ppf bs =
|
|
||||||
String.init n (fun i -> if (Z.testbit bs i) then '+' else '-')
|
|
||||||
|> Format.fprintf ppf "@[<h>%s@]"
|
|
||||||
#+end_src
|
|
||||||
|
|
||||||
|
|
||||||
** Test footer :noexport:
|
|
||||||
|
|
||||||
#+begin_src ocaml :tangle (eval test-ml) :exports none
|
|
||||||
let tests = [
|
|
||||||
"External", `Quick, test_external;
|
|
||||||
"General" , `Quick, test_general;
|
|
||||||
"Boys" , `Quick, test_boys;
|
|
||||||
"List" , `Quick, test_list;
|
|
||||||
"Array" , `Quick, test_array;
|
|
||||||
]
|
|
||||||
#+end_src
|
|
@ -1,3 +1,5 @@
|
|||||||
|
[@@@landmark "auto-off"]
|
||||||
|
|
||||||
open Common
|
open Common
|
||||||
|
|
||||||
type t = {
|
type t = {
|
||||||
@ -16,7 +18,7 @@ module Co = Coordinate
|
|||||||
module Ps = Primitive_shell
|
module Ps = Primitive_shell
|
||||||
|
|
||||||
|
|
||||||
let make ?(index=0) lc =
|
let[@landmark] make ?(index=0) lc =
|
||||||
assert (Array.length lc > 0);
|
assert (Array.length lc > 0);
|
||||||
|
|
||||||
let coef = Array.map fst lc
|
let coef = Array.map fst lc
|
||||||
@ -76,7 +78,7 @@ let primitives x = x.prim
|
|||||||
|
|
||||||
let zkey_array x = Ps.zkey_array x.prim.(0)
|
let zkey_array x = Ps.zkey_array x.prim.(0)
|
||||||
|
|
||||||
let values t point =
|
let[@landmark] values t point =
|
||||||
(* Radial part *)
|
(* Radial part *)
|
||||||
let r = Co.( point |- t.center ) in
|
let r = Co.( point |- t.center ) in
|
||||||
let r2 = Co.dot r r in
|
let r2 = Co.dot r r in
|
||||||
|
@ -1,3 +1,4 @@
|
|||||||
|
[@@@landmark "auto-off"]
|
||||||
open Common
|
open Common
|
||||||
|
|
||||||
type t =
|
type t =
|
||||||
@ -18,7 +19,7 @@ module Psp = Primitive_shell_pair
|
|||||||
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=Constants.epsilon) s_a s_b =
|
let[@landmark] 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
|
||||||
|
|
||||||
@ -49,15 +50,15 @@ 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
|
||||||
|
|
||||||
let shell_pairs x =
|
let[@landmark] shell_pairs x =
|
||||||
List.map snd x.coefs_and_shell_pairs
|
List.map snd x.coefs_and_shell_pairs
|
||||||
|> Array.of_list
|
|> Array.of_list
|
||||||
|
|
||||||
let coefficients x =
|
let[@landmark] coefficients x =
|
||||||
List.map fst x.coefs_and_shell_pairs
|
List.map fst x.coefs_and_shell_pairs
|
||||||
|> Array.of_list
|
|> Array.of_list
|
||||||
|
|
||||||
let exponents_inv x =
|
let[@landmark] 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
|
||||||
|
|
||||||
@ -89,12 +90,12 @@ let monocentric x =
|
|||||||
|
|
||||||
|
|
||||||
(** Returns an integer characteristic of a contracted shell pair *)
|
(** Returns an integer characteristic of a contracted shell pair *)
|
||||||
let hash a =
|
let[@landmark] hash a =
|
||||||
List.rev_map Hashtbl.hash a
|
List.rev_map Hashtbl.hash a
|
||||||
|> Array.of_list
|
|> Array.of_list
|
||||||
|
|
||||||
(** Comparison function, used for sorting *)
|
(** Comparison function, used for sorting *)
|
||||||
let compare t t' =
|
let[@landmark] compare t t' =
|
||||||
let a = hash t.coefs_and_shell_pairs in
|
let a = hash t.coefs_and_shell_pairs in
|
||||||
let b = hash t'.coefs_and_shell_pairs in
|
let b = hash t'.coefs_and_shell_pairs in
|
||||||
if a = b then 0
|
if a = b then 0
|
||||||
@ -118,7 +119,7 @@ let compare t t' =
|
|||||||
(** 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 ?(cutoff=Constants.epsilon) basis =
|
let[@landmark] of_contracted_shell_array ?(cutoff=Constants.epsilon) basis =
|
||||||
let rec loop accu = function
|
let rec loop accu = function
|
||||||
| [] -> accu
|
| [] -> accu
|
||||||
| (s_a :: rest) as l ->
|
| (s_a :: rest) as l ->
|
||||||
@ -165,7 +166,7 @@ let unique sp =
|
|||||||
*)
|
*)
|
||||||
|
|
||||||
|
|
||||||
let zkey_array x =
|
let[@landmark] zkey_array x =
|
||||||
Am.zkey_array (Am.Doublet
|
Am.zkey_array (Am.Doublet
|
||||||
Cs.(ang_mom x.shell_a, ang_mom x.shell_b)
|
Cs.(ang_mom x.shell_a, ang_mom x.shell_b)
|
||||||
)
|
)
|
||||||
|
@ -1,3 +1,5 @@
|
|||||||
|
[@@@landmark "auto-off"]
|
||||||
|
|
||||||
open Common
|
open Common
|
||||||
|
|
||||||
type t =
|
type t =
|
||||||
@ -18,7 +20,7 @@ module Cs = Contracted_shell
|
|||||||
module Csp = Contracted_shell_pair
|
module Csp = Contracted_shell_pair
|
||||||
module Pspc = Primitive_shell_pair_couple
|
module Pspc = Primitive_shell_pair_couple
|
||||||
|
|
||||||
let make ?(cutoff=Constants.epsilon) shell_pair_p shell_pair_q =
|
let[@landmark] make ?(cutoff=Constants.epsilon) shell_pair_p shell_pair_q =
|
||||||
let ang_mom =
|
let ang_mom =
|
||||||
Am.(Csp.ang_mom shell_pair_p + Csp.ang_mom shell_pair_q)
|
Am.(Csp.ang_mom shell_pair_p + Csp.ang_mom shell_pair_q)
|
||||||
in
|
in
|
||||||
|
@ -1,3 +1,5 @@
|
|||||||
|
[@@@landmark "auto-off"]
|
||||||
|
|
||||||
open Common
|
open Common
|
||||||
open Constants
|
open Constants
|
||||||
|
|
||||||
@ -21,6 +23,24 @@ module Am = Angular_momentum
|
|||||||
module Co = Coordinate
|
module Co = Coordinate
|
||||||
module Ps = Primitive_shell
|
module Ps = Primitive_shell
|
||||||
|
|
||||||
|
let ang_mom x = x.ang_mom
|
||||||
|
|
||||||
|
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 normalization x = x.normalization
|
||||||
|
|
||||||
|
let exponent x = x.exponent
|
||||||
|
|
||||||
|
let center x = x.center
|
||||||
|
|
||||||
|
let shell_a x = x.shell_a
|
||||||
|
|
||||||
|
let shell_b x = x.shell_b
|
||||||
|
|
||||||
|
|
||||||
let hash a =
|
let hash a =
|
||||||
Hashtbl.hash a
|
Hashtbl.hash a
|
||||||
@ -39,14 +59,14 @@ let cmp a b =
|
|||||||
hash a - hash b
|
hash a - hash b
|
||||||
|
|
||||||
|
|
||||||
let compute_norm_scales p_a p_b =
|
let[@landmark] compute_norm_scales p_a p_b =
|
||||||
Array.map (fun v1 ->
|
Array.map (fun v1 ->
|
||||||
Array.map (fun v2 -> v1 *. v2) (Ps.norm_scales p_b)
|
Array.map (fun v2 -> v1 *. v2) (Ps.norm_scales p_b)
|
||||||
) (Ps.norm_scales p_a)
|
) (Ps.norm_scales p_a)
|
||||||
|> Array.to_list
|
|> Array.to_list
|
||||||
|> Array.concat
|
|> Array.concat
|
||||||
|
|
||||||
let create_make_of p_a p_b =
|
let[@landmark] create_make_of p_a p_b =
|
||||||
|
|
||||||
let a_minus_b =
|
let a_minus_b =
|
||||||
Co.( Ps.center p_a |- Ps.center p_b )
|
Co.( Ps.center p_a |- Ps.center p_b )
|
||||||
@ -119,7 +139,7 @@ let create_make_of p_a p_b =
|
|||||||
else None
|
else None
|
||||||
|
|
||||||
|
|
||||||
let make p_a p_b =
|
let[@landmark] make p_a p_b =
|
||||||
let f =
|
let f =
|
||||||
create_make_of p_a p_b
|
create_make_of p_a p_b
|
||||||
in
|
in
|
||||||
@ -128,7 +148,7 @@ let make p_a p_b =
|
|||||||
| None -> assert false
|
| None -> assert false
|
||||||
|
|
||||||
|
|
||||||
let norm_scales x =
|
let[@landmark] norm_scales x =
|
||||||
try
|
try
|
||||||
Lazy.force x.norm_scales
|
Lazy.force x.norm_scales
|
||||||
with Lazy.Undefined -> compute_norm_scales x.shell_a x.shell_b
|
with Lazy.Undefined -> compute_norm_scales x.shell_a x.shell_b
|
||||||
@ -139,26 +159,8 @@ let monocentric x =
|
|||||||
Ps.center x.shell_a = Ps.center x.shell_b
|
Ps.center x.shell_a = Ps.center x.shell_b
|
||||||
|
|
||||||
|
|
||||||
let ang_mom x = x.ang_mom
|
|
||||||
|
|
||||||
let a_minus_b x = x.a_minus_b
|
let[@landmark] zkey_array x =
|
||||||
|
|
||||||
let a_minus_b_sq x = x.a_minus_b_sq
|
|
||||||
|
|
||||||
let center_minus_a x = x.center_minus_a
|
|
||||||
|
|
||||||
let normalization x = x.normalization
|
|
||||||
|
|
||||||
let exponent x = x.exponent
|
|
||||||
|
|
||||||
let center x = x.center
|
|
||||||
|
|
||||||
let shell_a x = x.shell_a
|
|
||||||
|
|
||||||
let shell_b x = x.shell_b
|
|
||||||
|
|
||||||
|
|
||||||
let zkey_array x =
|
|
||||||
Am.zkey_array (Am.Doublet
|
Am.zkey_array (Am.Doublet
|
||||||
Ps.(ang_mom x.shell_a, ang_mom x.shell_b)
|
Ps.(ang_mom x.shell_a, ang_mom x.shell_b)
|
||||||
)
|
)
|
||||||
|
@ -1,3 +1,5 @@
|
|||||||
|
[@@@landmark "auto-off"]
|
||||||
|
|
||||||
open Common
|
open Common
|
||||||
|
|
||||||
type t =
|
type t =
|
||||||
@ -17,7 +19,7 @@ module Co = Coordinate
|
|||||||
module Ps = Primitive_shell
|
module Ps = Primitive_shell
|
||||||
module Psp = Primitive_shell_pair
|
module Psp = Primitive_shell_pair
|
||||||
|
|
||||||
let make shell_pair_p shell_pair_q =
|
let[@landmark] make shell_pair_p shell_pair_q =
|
||||||
let ang_mom =
|
let ang_mom =
|
||||||
Am.(Psp.ang_mom shell_pair_p + Psp.ang_mom shell_pair_q)
|
Am.(Psp.ang_mom shell_pair_p + Psp.ang_mom shell_pair_q)
|
||||||
in
|
in
|
||||||
@ -27,8 +29,9 @@ let make shell_pair_p shell_pair_q =
|
|||||||
and shell_d = Psp.shell_b shell_pair_q
|
and shell_d = Psp.shell_b shell_pair_q
|
||||||
in
|
in
|
||||||
let zkey_array = lazy (
|
let zkey_array = lazy (
|
||||||
|
let open Ps in
|
||||||
Am.zkey_array (Am.Quartet
|
Am.zkey_array (Am.Quartet
|
||||||
Ps.(ang_mom shell_a, ang_mom shell_b,
|
(ang_mom shell_a, ang_mom shell_b,
|
||||||
ang_mom shell_c, ang_mom shell_d)
|
ang_mom shell_c, ang_mom shell_d)
|
||||||
)
|
)
|
||||||
)
|
)
|
||||||
@ -62,7 +65,7 @@ let p_minus_q t =
|
|||||||
|
|
||||||
let zkey_array t = Lazy.force t.zkey_array
|
let zkey_array t = Lazy.force t.zkey_array
|
||||||
|
|
||||||
let norm_scales t =
|
let[@landmark] norm_scales t =
|
||||||
let norm_coef_scale_p_list = Array.to_list (Psp.norm_scales t.shell_pair_p) in
|
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
|
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)
|
List.map (fun v1 -> Array.map (fun v2 -> v1 *. v2) norm_coef_scale_q)
|
||||||
|
@ -1,5 +1,7 @@
|
|||||||
(** Electron-electron repulsion integrals *)
|
(** Electron-electron repulsion integrals *)
|
||||||
|
|
||||||
|
[@@@landmark "auto-off"]
|
||||||
|
|
||||||
open Common
|
open Common
|
||||||
open Gaussian
|
open Gaussian
|
||||||
|
|
||||||
@ -12,7 +14,16 @@ module T = struct
|
|||||||
|
|
||||||
open Zero_m_parameters
|
open Zero_m_parameters
|
||||||
|
|
||||||
let zero_m z =
|
let rec aux_zero_m result expo_pq accu k = function
|
||||||
|
| 0 -> result.(k) <- result.(k) *. accu
|
||||||
|
| l ->
|
||||||
|
begin
|
||||||
|
result.(k) <- result.(k) *. accu;
|
||||||
|
let new_accu = -. accu *. expo_pq in
|
||||||
|
(aux_zero_m [@tailcall]) result expo_pq new_accu (k+1) (l-1)
|
||||||
|
end
|
||||||
|
|
||||||
|
let[@landmark] zero_m z =
|
||||||
let expo_pq_inv = z.expo_p_inv +. z.expo_q_inv in
|
let expo_pq_inv = z.expo_p_inv +. z.expo_q_inv in
|
||||||
assert (expo_pq_inv <> 0.);
|
assert (expo_pq_inv <> 0.);
|
||||||
let expo_pq = 1. /. expo_pq_inv in
|
let expo_pq = 1. /. expo_pq_inv in
|
||||||
@ -23,20 +34,11 @@ module T = struct
|
|||||||
in
|
in
|
||||||
let maxm = z.maxm in
|
let maxm = z.maxm in
|
||||||
let result = Util.boys_function ~maxm t in
|
let result = Util.boys_function ~maxm t in
|
||||||
let rec aux accu k = function
|
|
||||||
| 0 -> result.(k) <- result.(k) *. accu
|
|
||||||
| l ->
|
|
||||||
begin
|
|
||||||
result.(k) <- result.(k) *. accu;
|
|
||||||
let new_accu = -. accu *. expo_pq in
|
|
||||||
(aux [@tailcall]) new_accu (k+1) (l-1)
|
|
||||||
end
|
|
||||||
in
|
|
||||||
let f = Constants.two_over_sq_pi *. (sqrt expo_pq) in
|
let f = Constants.two_over_sq_pi *. (sqrt expo_pq) in
|
||||||
aux f 0 maxm;
|
aux_zero_m result expo_pq f 0 maxm;
|
||||||
result
|
result
|
||||||
|
|
||||||
let class_of_contracted_shell_pair_couple ?operator shell_pair_couple =
|
let[@landmark] class_of_contracted_shell_pair_couple ?operator shell_pair_couple =
|
||||||
assert (operator = None);
|
assert (operator = None);
|
||||||
let shell_p = Cspc.shell_pair_p shell_pair_couple
|
let shell_p = Cspc.shell_pair_p shell_pair_couple
|
||||||
and shell_q = Cspc.shell_pair_q shell_pair_couple
|
and shell_q = Cspc.shell_pair_q shell_pair_couple
|
||||||
|
@ -96,8 +96,9 @@ let hvrr_two_e_vector (angMom_a, angMom_b, angMom_c, angMom_d)
|
|||||||
end;
|
end;
|
||||||
let amxyz = Po.get xyz am in
|
let amxyz = Po.get xyz am in
|
||||||
if amxyz < 1 then
|
if amxyz < 1 then
|
||||||
|
let center_pq_xyz = center_pq xyz in
|
||||||
Array.iteri (fun l expo_inv_p_l ->
|
Array.iteri (fun l expo_inv_p_l ->
|
||||||
let center_pq_xyz_l = (center_pq xyz).(l) in
|
let center_pq_xyz_l = center_pq_xyz.(l) in
|
||||||
Array.iteri (fun m result_m ->
|
Array.iteri (fun m result_m ->
|
||||||
let result_ml = result_m.(l) in
|
let result_ml = result_m.(l) in
|
||||||
let p0 = v_am.(m+1) in
|
let p0 = v_am.(m+1) in
|
||||||
@ -114,10 +115,10 @@ let hvrr_two_e_vector (angMom_a, angMom_b, angMom_c, angMom_d)
|
|||||||
let amm = Po.decr xyz am in
|
let amm = Po.decr xyz am in
|
||||||
let amxyz = Util.float_of_int_fast amxyz in
|
let amxyz = Util.float_of_int_fast amxyz in
|
||||||
let v_amm = vrr0_v amm in
|
let v_amm = vrr0_v amm in
|
||||||
|
let center_pq_xyz = center_pq xyz in
|
||||||
Array.iteri (fun l expo_inv_p_l ->
|
Array.iteri (fun l expo_inv_p_l ->
|
||||||
let f = amxyz *. expo_p_inv.(l) *. 0.5
|
let f = amxyz *. expo_p_inv.(l) *. 0.5
|
||||||
and center_pq_xyz_l = (center_pq xyz).(l)
|
and center_pq_xyz_l = center_pq_xyz.(l) in
|
||||||
in
|
|
||||||
Array.iteri (fun m result_m ->
|
Array.iteri (fun m result_m ->
|
||||||
let v1 = v_amm.(m) in
|
let v1 = v_amm.(m) in
|
||||||
let v1_l = v1.(l) in
|
let v1_l = v1.(l) in
|
||||||
@ -182,8 +183,9 @@ let hvrr_two_e_vector (angMom_a, angMom_b, angMom_c, angMom_d)
|
|||||||
|
|
||||||
let v2 =
|
let v2 =
|
||||||
let f2 =
|
let f2 =
|
||||||
|
let center_pq_xyz = center_pq xyz in
|
||||||
Array.init np (fun l ->
|
Array.init np (fun l ->
|
||||||
let cpq_l = (center_pq xyz).(l) in
|
let cpq_l = center_pq_xyz.(l) in
|
||||||
Array.init nq (fun k ->
|
Array.init nq (fun k ->
|
||||||
let x = expo_q_inv.(k) *. cpq_l.(k) in
|
let x = expo_q_inv.(k) *. cpq_l.(k) in
|
||||||
if (!do_compute) then x
|
if (!do_compute) then x
|
||||||
@ -197,8 +199,7 @@ let hvrr_two_e_vector (angMom_a, angMom_b, angMom_c, angMom_d)
|
|||||||
begin
|
begin
|
||||||
for l=0 to np-1 do
|
for l=0 to np-1 do
|
||||||
let f2_l = f2.(l)
|
let f2_l = f2.(l)
|
||||||
and v2_l = v2.(l)
|
and v2_l = v2.(l) in
|
||||||
in
|
|
||||||
for k=0 to nq-1 do
|
for k=0 to nq-1 do
|
||||||
f2_l.(k) <- -. v2_l.(k) *. f2_l.(k)
|
f2_l.(k) <- -. v2_l.(k) *. f2_l.(k)
|
||||||
done
|
done
|
||||||
@ -217,8 +218,7 @@ let hvrr_two_e_vector (angMom_a, angMom_b, angMom_c, angMom_d)
|
|||||||
begin
|
begin
|
||||||
for l=0 to np-1 do
|
for l=0 to np-1 do
|
||||||
let v1_l = v1.(l)
|
let v1_l = v1.(l)
|
||||||
and v2_l = v2.(l)
|
and v2_l = v2.(l) in
|
||||||
in
|
|
||||||
for k=0 to nq-1 do
|
for k=0 to nq-1 do
|
||||||
v2_l.(k) <- v2_l.(k) +. v1_l.(k)
|
v2_l.(k) <- v2_l.(k) +. v1_l.(k)
|
||||||
done
|
done
|
||||||
@ -248,8 +248,7 @@ let hvrr_two_e_vector (angMom_a, angMom_b, angMom_c, angMom_d)
|
|||||||
let result = Array.make_matrix np nq 0. in
|
let result = Array.make_matrix np nq 0. in
|
||||||
for l=0 to np-1 do
|
for l=0 to np-1 do
|
||||||
let v1_l = v1.(l)
|
let v1_l = v1.(l)
|
||||||
and result_l = result.(l)
|
and result_l = result.(l) in
|
||||||
in
|
|
||||||
for k=0 to nq-1 do
|
for k=0 to nq-1 do
|
||||||
result_l.(k) <- v1_l.(k) *. f1.(k)
|
result_l.(k) <- v1_l.(k) *. f1.(k)
|
||||||
done;
|
done;
|
||||||
@ -295,8 +294,7 @@ let hvrr_two_e_vector (angMom_a, angMom_b, angMom_c, angMom_d)
|
|||||||
for l=0 to np-1 do
|
for l=0 to np-1 do
|
||||||
let v3_l = v3.(l)
|
let v3_l = v3.(l)
|
||||||
and v1_l = v1.(l)
|
and v1_l = v1.(l)
|
||||||
and p1_l = p1.(l)
|
and p1_l = p1.(l) in
|
||||||
in
|
|
||||||
for k=0 to nq-1 do
|
for k=0 to nq-1 do
|
||||||
v3_l.(k) <- p1_l.(k) +. v1_l.(k) +. v3_l.(k)
|
v3_l.(k) <- p1_l.(k) +. v1_l.(k) +. v3_l.(k)
|
||||||
done
|
done
|
||||||
@ -307,8 +305,7 @@ let hvrr_two_e_vector (angMom_a, angMom_b, angMom_c, angMom_d)
|
|||||||
begin
|
begin
|
||||||
for l=0 to np-1 do
|
for l=0 to np-1 do
|
||||||
let v1_l = v1.(l)
|
let v1_l = v1.(l)
|
||||||
and p1_l = p1.(l)
|
and p1_l = p1.(l) in
|
||||||
in
|
|
||||||
for k=0 to nq-1 do
|
for k=0 to nq-1 do
|
||||||
p1_l.(k) <- v1_l.(k) +. p1_l.(k)
|
p1_l.(k) <- v1_l.(k) +. p1_l.(k)
|
||||||
done
|
done
|
||||||
@ -319,8 +316,7 @@ let hvrr_two_e_vector (angMom_a, angMom_b, angMom_c, angMom_d)
|
|||||||
begin
|
begin
|
||||||
for l=0 to np-1 do
|
for l=0 to np-1 do
|
||||||
let v3_l = v3.(l)
|
let v3_l = v3.(l)
|
||||||
and p1_l = p1.(l)
|
and p1_l = p1.(l) in
|
||||||
in
|
|
||||||
for k=0 to nq-1 do
|
for k=0 to nq-1 do
|
||||||
p1_l.(k) <- p1_l.(k) +. v3_l.(k)
|
p1_l.(k) <- p1_l.(k) +. v3_l.(k)
|
||||||
done
|
done
|
||||||
@ -331,8 +327,7 @@ let hvrr_two_e_vector (angMom_a, angMom_b, angMom_c, angMom_d)
|
|||||||
begin
|
begin
|
||||||
for l=0 to np-1 do
|
for l=0 to np-1 do
|
||||||
let v3_l = v3.(l)
|
let v3_l = v3.(l)
|
||||||
and v1_l = v1.(l)
|
and v1_l = v1.(l) in
|
||||||
in
|
|
||||||
for k=0 to nq-1 do
|
for k=0 to nq-1 do
|
||||||
v3_l.(k) <- v1_l.(k) +. v3_l.(k)
|
v3_l.(k) <- v1_l.(k) +. v3_l.(k)
|
||||||
done
|
done
|
||||||
@ -637,10 +632,8 @@ let contracted_class_shell_pairs ?operator ~zero_m ?schwartz_p ?schwartz_q shell
|
|||||||
if (abs_float coefx.{j,i} ) < 1.e-3*.cutoff then
|
if (abs_float coefx.{j,i} ) < 1.e-3*.cutoff then
|
||||||
raise NullQuartet;
|
raise NullQuartet;
|
||||||
|
|
||||||
let expo_p_inv, expo_q_inv =
|
let expo_p_inv = expo_p_inv%.(i) in
|
||||||
(expo_p_inv%.(i)),
|
let expo_q_inv = expo_q_inv%.(j) in
|
||||||
(expo_q_inv%.(j))
|
|
||||||
in
|
|
||||||
|
|
||||||
let center_pq =
|
let center_pq =
|
||||||
Co.(Psp.center sp.(i-1) |- Psp.center sq.(j-1))
|
Co.(Psp.center sp.(i-1) |- Psp.center sq.(j-1))
|
||||||
@ -671,7 +664,10 @@ let contracted_class_shell_pairs ?operator ~zero_m ?schwartz_p ?schwartz_q shell
|
|||||||
| _ ->
|
| _ ->
|
||||||
|
|
||||||
let coef =
|
let coef =
|
||||||
Array.init np (fun l -> Array.init nq (fun k -> cq.(k) *. cp.(l)) )
|
Array.init np (fun l ->
|
||||||
|
let cpl = cp.(l) in
|
||||||
|
Array.map (fun cqk -> cqk *. cpl) cq
|
||||||
|
)
|
||||||
in
|
in
|
||||||
|
|
||||||
let norm = Cspc.norm_scales shell_pair_couple in
|
let norm = Cspc.norm_scales shell_pair_couple in
|
||||||
@ -688,99 +684,98 @@ let contracted_class_shell_pairs ?operator ~zero_m ?schwartz_p ?schwartz_q shell
|
|||||||
Array.map (fun shell_cd -> Ps.exponent (Psp.shell_b shell_cd) ) sq
|
Array.map (fun shell_cd -> Ps.exponent (Psp.shell_b shell_cd) ) sq
|
||||||
in
|
in
|
||||||
|
|
||||||
let center_pq =
|
let center_pq_x, center_pq_y, center_pq_z =
|
||||||
let result =
|
let result =
|
||||||
Array.init 3 (fun xyz ->
|
Array.init 3 (fun xyz ->
|
||||||
|
let xyz = match xyz with
|
||||||
|
| 0 -> Co.X
|
||||||
|
| 1 -> Co.Y
|
||||||
|
| _ -> Co.Z
|
||||||
|
in
|
||||||
Array.init np (fun ab ->
|
Array.init np (fun ab ->
|
||||||
let shell_ab = sp.(ab) in
|
let shell_ab = sp.(ab) in
|
||||||
Array.init nq (fun cd ->
|
Array.init nq (fun cd ->
|
||||||
let shell_cd = sq.(cd)
|
let shell_cd = sq.(cd) in
|
||||||
in
|
|
||||||
let cpq =
|
let cpq =
|
||||||
Co.(Psp.center shell_ab |- Psp.center shell_cd)
|
Co.(Psp.center shell_ab |- Psp.center shell_cd)
|
||||||
in
|
in
|
||||||
match xyz with
|
Co.get xyz cpq;
|
||||||
| 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
|
in
|
||||||
let center_pa =
|
result.(0), result.(1), result.(2)
|
||||||
|
in
|
||||||
|
let center_pa_x, center_pa_y, center_pa_z =
|
||||||
let result =
|
let result =
|
||||||
Array.init 3 (fun xyz ->
|
Array.init 3 (fun xyz ->
|
||||||
|
let xyz = match xyz with
|
||||||
|
| 0 -> Co.X
|
||||||
|
| 1 -> Co.Y
|
||||||
|
| _ -> Co.Z
|
||||||
|
in
|
||||||
Array.init np (fun ab ->
|
Array.init np (fun ab ->
|
||||||
let shell_ab = sp.(ab) in
|
let shell_ab = sp.(ab) in
|
||||||
let cpa =
|
let cpa =
|
||||||
Co.(Psp.center shell_ab |- Cs.center shell_a)
|
Co.(Psp.center shell_ab |- Cs.center shell_a)
|
||||||
in
|
in
|
||||||
match xyz with
|
Co.get xyz cpa;
|
||||||
| 0 -> Co.(get X cpa);
|
|
||||||
| 1 -> Co.(get Y cpa);
|
|
||||||
| _ -> Co.(get Z cpa);
|
|
||||||
)
|
)
|
||||||
)
|
)
|
||||||
in function
|
in result.(0), result.(1), result.(2)
|
||||||
| Co.X -> result.(0)
|
|
||||||
| Co.Y -> result.(1)
|
|
||||||
| Co.Z -> result.(2)
|
|
||||||
in
|
in
|
||||||
let center_qc =
|
let center_qc_x, center_qc_y, center_qc_z =
|
||||||
let result =
|
let result =
|
||||||
Array.init 3 (fun xyz ->
|
Array.init 3 (fun xyz ->
|
||||||
|
let xyz = match xyz with
|
||||||
|
| 0 -> Co.X
|
||||||
|
| 1 -> Co.Y
|
||||||
|
| _ -> Co.Z
|
||||||
|
in
|
||||||
Array.init nq (fun cd ->
|
Array.init nq (fun cd ->
|
||||||
let shell_cd = sq.(cd) in
|
let shell_cd = sq.(cd) in
|
||||||
let cqc =
|
let cqc =
|
||||||
Co.(Psp.center shell_cd |- Cs.center shell_c)
|
Co.(Psp.center shell_cd |- Cs.center shell_c)
|
||||||
in
|
in
|
||||||
match xyz with
|
Co.get xyz cqc;
|
||||||
| 0 -> Co.(get X cqc);
|
|
||||||
| 1 -> Co.(get Y cqc);
|
|
||||||
| _ -> Co.(get Z cqc);
|
|
||||||
)
|
)
|
||||||
)
|
)
|
||||||
in function
|
in result.(0), result.(1), result.(2)
|
||||||
| Co.X -> result.(0)
|
|
||||||
| Co.Y -> result.(1)
|
|
||||||
| Co.Z -> result.(2)
|
|
||||||
in
|
in
|
||||||
let zero_m_array =
|
let zero_m_array =
|
||||||
let result =
|
let result =
|
||||||
Array.init (maxm+1) (fun _ ->
|
Array.init (maxm+1) (fun _ ->
|
||||||
Array.init np (fun _ -> Array.make nq 0. ) )
|
Array.make_matrix np nq 0. )
|
||||||
in
|
in
|
||||||
let empty = Array.make (maxm+1) 0. in
|
let empty = Array.make (maxm+1) 0. in
|
||||||
let center_qc_tmp = Array.init nq (fun cd ->
|
let center_qc_tmp = Array.init nq (fun cd ->
|
||||||
Coordinate.make { Coordinate.
|
Coordinate.make { Coordinate.
|
||||||
x = (center_qc Co.X).(cd) ;
|
x = center_qc_x.(cd) ;
|
||||||
y = (center_qc Co.Y).(cd) ;
|
y = center_qc_y.(cd) ;
|
||||||
z = (center_qc Co.Z).(cd) ;
|
z = center_qc_z.(cd) ;
|
||||||
})
|
})
|
||||||
in
|
in
|
||||||
Array.iteri (fun ab _shell_ab ->
|
Array.iteri (fun ab _shell_ab ->
|
||||||
let center_pa = Coordinate.make { Coordinate.
|
let center_pa = Coordinate.make { Coordinate.
|
||||||
x = (center_pa Co.X).(ab) ;
|
x = center_pa_x.(ab) ;
|
||||||
y = (center_pa Co.Y).(ab) ;
|
y = center_pa_y.(ab) ;
|
||||||
z = (center_pa Co.Z).(ab) ;
|
z = center_pa_z.(ab) ;
|
||||||
}
|
}
|
||||||
in
|
in
|
||||||
|
let coef_ab = coef.(ab) in
|
||||||
|
let expo_p_inv = expo_p_inv.(ab) in
|
||||||
let zero_m_array_tmp =
|
let zero_m_array_tmp =
|
||||||
|
let xab = center_pq_x.(ab)
|
||||||
|
and yab = center_pq_y.(ab)
|
||||||
|
and zab = center_pq_z.(ab) in
|
||||||
Array.mapi (fun cd _shell_cd ->
|
Array.mapi (fun cd _shell_cd ->
|
||||||
if (abs_float coef.(ab).(cd) < cutoff) then
|
if (abs_float coef_ab.(cd) < cutoff) then
|
||||||
empty
|
empty
|
||||||
else
|
else
|
||||||
let expo_p_inv, expo_q_inv =
|
let expo_q_inv = expo_q_inv.(cd) in
|
||||||
expo_p_inv.(ab), expo_q_inv.(cd)
|
let x = xab.(cd)
|
||||||
in
|
and y = yab.(cd)
|
||||||
let x = (center_pq X).(ab).(cd)
|
and z = zab.(cd) in
|
||||||
and y = (center_pq Y).(ab).(cd)
|
|
||||||
and z = (center_pq Z).(ab).(cd)
|
|
||||||
in
|
|
||||||
let norm_pq_sq =
|
let norm_pq_sq =
|
||||||
x *. x +. y *. y +. z *. z
|
x *. x +. y *. y +. z *. z
|
||||||
in
|
in
|
||||||
@ -795,8 +790,7 @@ let contracted_class_shell_pairs ?operator ~zero_m ?schwartz_p ?schwartz_q shell
|
|||||||
(* Transpose result *)
|
(* Transpose result *)
|
||||||
let coef_ab = coef.(ab) in
|
let coef_ab = coef.(ab) in
|
||||||
for m=0 to maxm do
|
for m=0 to maxm do
|
||||||
let result_m_ab = result.(m).(ab)
|
let result_m_ab = result.(m).(ab) in
|
||||||
in
|
|
||||||
for cd=0 to nq-1 do
|
for cd=0 to nq-1 do
|
||||||
result_m_ab.(cd) <- zero_m_array_tmp.(cd).(m) *. coef_ab.(cd)
|
result_m_ab.(cd) <- zero_m_array_tmp.(cd).(m) *. coef_ab.(cd)
|
||||||
done
|
done
|
||||||
@ -848,6 +842,21 @@ let contracted_class_shell_pairs ?operator ~zero_m ?schwartz_p ?schwartz_q shell
|
|||||||
if schwartz_p *. schwartz_q < cutoff2 then raise NullQuartet;
|
if schwartz_p *. schwartz_q < cutoff2 then raise NullQuartet;
|
||||||
);
|
);
|
||||||
|
|
||||||
|
let center_pq = function
|
||||||
|
| Co.X -> center_pq_x
|
||||||
|
| Co.Y -> center_pq_y
|
||||||
|
| Co.Z -> center_pq_z
|
||||||
|
in
|
||||||
|
let center_pa = function
|
||||||
|
| Co.X -> center_pa_x
|
||||||
|
| Co.Y -> center_pa_y
|
||||||
|
| Co.Z -> center_pa_z
|
||||||
|
in
|
||||||
|
let center_qc = function
|
||||||
|
| Co.X -> center_qc_x
|
||||||
|
| Co.Y -> center_qc_y
|
||||||
|
| Co.Z -> center_qc_z
|
||||||
|
in
|
||||||
let abcd =
|
let abcd =
|
||||||
{ expo_b ; expo_d ; expo_p_inv ; expo_q_inv ;
|
{ expo_b ; expo_d ; expo_p_inv ; expo_q_inv ;
|
||||||
center_ab = Csp.a_minus_b shell_p;
|
center_ab = Csp.a_minus_b shell_p;
|
||||||
|
Loading…
Reference in New Issue
Block a user