10
1
mirror of https://gitlab.com/scemama/QCaml.git synced 2024-12-22 12:23:31 +01:00

Added Angstrom

This commit is contained in:
Anthony Scemama 2018-01-18 14:56:08 +01:00
parent 0687671098
commit 72eb1ce5c3
4 changed files with 89 additions and 42 deletions

View File

@ -49,10 +49,10 @@ atoms_xyz:
atoms_list: atoms_list:
| { [] } | { [] }
| atoms_list WORD SPACE FLOAT SPACE FLOAT SPACE FLOAT EOL { (Element.of_string $2, Coordinate.of_3_floats $4 $6 $8 ) :: $1 } | atoms_list WORD SPACE FLOAT SPACE FLOAT SPACE FLOAT EOL { (Element.of_string $2, Coordinate.of_3_floats $4 $6 $8 `Angstrom ) :: $1 }
| atoms_list WORD SPACE FLOAT SPACE FLOAT SPACE FLOAT SPACE EOL { (Element.of_string $2, Coordinate.of_3_floats $4 $6 $8 ) :: $1 } | atoms_list WORD SPACE FLOAT SPACE FLOAT SPACE FLOAT SPACE EOL { (Element.of_string $2, Coordinate.of_3_floats $4 $6 $8 `Angstrom ) :: $1 }
| atoms_list INTEGER SPACE FLOAT SPACE FLOAT SPACE FLOAT EOL { (Element.of_int $2, Coordinate.of_3_floats $4 $6 $8 ) :: $1 } | atoms_list INTEGER SPACE FLOAT SPACE FLOAT SPACE FLOAT EOL { (Element.of_int $2, Coordinate.of_3_floats $4 $6 $8 `Angstrom ) :: $1 }
| atoms_list INTEGER SPACE FLOAT SPACE FLOAT SPACE FLOAT SPACE EOL { (Element.of_int $2, Coordinate.of_3_floats $4 $6 $8 ) :: $1 } | atoms_list INTEGER SPACE FLOAT SPACE FLOAT SPACE FLOAT SPACE EOL { (Element.of_int $2, Coordinate.of_3_floats $4 $6 $8 `Angstrom ) :: $1 }

View File

@ -1,55 +1,97 @@
type t = float array type t =
| Bohr of float array
| Angstrom of float array
let zero = (** Bohr radius, taken from https://physics.nist.gov/cgi-bin/cuu/Value?bohrrada0 *)
[| 0. ; 0. ; 0. |] let a0 =
0.529_177_210_67
let of_float_triplet (x,y,z) = let zero = Bohr [| 0. ; 0. ; 0. |]
[|x;y;z|]
let of_float_triplet (x,y,z) = function
| `Bohr -> Bohr [|x;y;z|]
| `Angstrom -> Angstrom [|x;y;z|]
let of_3_floats x y z = let of_3_floats x y z =
[|x;y;z|] of_float_triplet (x,y,z)
let to_string x = let to_string y =
(string_of_float x.(0))^" "^(string_of_float x.(1))^" "^(string_of_float x.(2)) let result x =
(string_of_float x.(0))^" "^(string_of_float x.(1))^" "^(string_of_float x.(2))
in
match y with
| Bohr x -> (result x) ^ " Bohr"
| Angstrom x -> (result x) ^ " Angstrom"
let to_float_array = function
| Bohr a
| Angstrom a -> a
let x a = (to_float_array a).(0)
let y a = (to_float_array a).(1)
let z a = (to_float_array a).(2)
let x a = a.(0)
let y a = a.(1)
let z a = a.(2)
let coord a = function let coord a = function
| 0 -> a.(0) | 0 -> (to_float_array a).(0)
| 1 -> a.(1) | 1 -> (to_float_array a).(1)
| 2 -> a.(2) | 2 -> (to_float_array a).(2)
| _ -> raise (Invalid_argument "Coordinate") | _ -> raise (Invalid_argument "Coordinate")
let to_float_array a = a
(** Linear algebra *) (** Linear algebra *)
let (|-) a b =
match a,b with
| [|x;y;z|], [|x';y';z'|] -> [| x-.x'; y-.y'; z-.z' |]
| _ -> assert false
let (|+) a b =
match a,b with
| [|x;y;z|], [|x';y';z'|] -> [| x+.x'; y+.y'; z+.z' |]
| _ -> assert false
let (|.) s a = let (|.) s a =
match a with match a with
| [|x;y;z|] -> [| s*.x; s*.y; s*.z |] | Bohr [|x;y;z|] -> Bohr [| s*.x; s*.y; s*.z |]
| Angstrom [|x;y;z|] -> Angstrom [| s*.x; s*.y; s*.z |]
| _ -> assert false | _ -> assert false
let to_Angstrom = function
| Angstrom a -> Angstrom a
| Bohr a -> Angstrom (a0 |. Bohr a |> to_float_array)
let dot a b = let to_Bohr = function
match a,b with | Angstrom a -> Bohr (1./.a0 |. Angstrom a |> to_float_array)
| [|x;y;z|], [|x';y';z'|] -> x*.x' +. y*.y' +. z*.z' | Bohr a -> Bohr a
| _ -> assert false
let (|-), (|+) =
let rec op f p q =
match (p, q) with
| (Angstrom a, Angstrom b) -> Angstrom (f a b)
| (Bohr a, Bohr b) -> Bohr (f a b)
| (Angstrom a, Bohr b) -> op f (to_Bohr p) q
| (Bohr a, Angstrom b) -> op f p (to_Bohr q)
in
(op (fun a b ->
match a,b with
| [|x;y;z|], [|x';y';z'|] -> [| x-.x'; y-.y'; z-.z' |]
| _ -> assert false
) ,
op (fun a b ->
match a,b with
| [|x;y;z|], [|x';y';z'|] -> [| x+.x'; y+.y'; z+.z' |]
| _ -> assert false
)
)
let dot =
let rec op f p q =
match (p, q) with
| (Angstrom a, Angstrom b)
| (Bohr a, Bohr b) -> f a b
| (Angstrom a, Bohr b) -> op f (to_Bohr p) q
| (Bohr a, Angstrom b) -> op f p (to_Bohr q)
in
op (fun a b ->
match a,b with
| [|x;y;z|], [|x';y';z'|] -> x*.x' +. y*.y' +. z*.z'
| _ -> assert false
)
let norm u = let norm u =
sqrt @@ dot u u sqrt @@ dot u u

View File

@ -1,7 +1,7 @@
type t type t
val zero : t val zero : t
val of_float_triplet : float * float * float -> t val of_float_triplet : float * float * float -> [< `Angstrom | `Bohr ] -> t
val of_3_floats : float -> float -> float -> t val of_3_floats : float -> float -> float -> [< `Angstrom | `Bohr ] -> t
val to_string : t -> string val to_string : t -> string
val x : t -> float val x : t -> float
val y : t -> float val y : t -> float

View File

@ -32,6 +32,11 @@ let run ~coord ~basis =
let () = let () =
let usage_msg = "Quantum Chemistry Package. Options available:" in let usage_msg = "Available options:" in
Arg.parse speclist (fun _ -> ()) usage_msg; Arg.parse speclist (fun _ -> ()) usage_msg;
run ~coord:!coord_file ~basis:!basis_file try
run ~coord:!coord_file ~basis:!basis_file
with
| Invalid_argument e ->
(print_string "Error: " ; print_endline e; print_newline () ; Arg.usage speclist usage_msg)
;