mirror of
https://github.com/LCPQ/quantum_package
synced 2024-08-25 14:01:46 +02:00
Added GTOs in Ocaml
This commit is contained in:
parent
7c8a66c6e9
commit
256efa75b8
19
ocaml/Makefile
Normal file
19
ocaml/Makefile
Normal file
@ -0,0 +1,19 @@
|
|||||||
|
LIBS=
|
||||||
|
PKGS=
|
||||||
|
OCAMLCFLAGS=-g
|
||||||
|
OCAMLBUILD=ocamlbuild -cflags $(OCAMLCFLAGS) -lflags -g
|
||||||
|
|
||||||
|
|
||||||
|
test_elements.byte:
|
||||||
|
|
||||||
|
%.inferred.mli: $(wildcard *.ml)
|
||||||
|
$(OCAMLBUILD) $*.inferred.mli -cflags -i -use-ocamlfind $(PKGS)
|
||||||
|
|
||||||
|
%.byte: $(wildcard *.ml) $(wildcard *.mli)
|
||||||
|
$(OCAMLBUILD) $*.byte -use-ocamlfind $(PKGS)
|
||||||
|
|
||||||
|
%.native: $(wildcard *.ml) $(wildcard *.mli)
|
||||||
|
$(OCAMLBUILD) $*.native -use-ocamlfind $(PKGS)
|
||||||
|
|
||||||
|
clean:
|
||||||
|
rm -rf _build
|
3
ocaml/_tags
Normal file
3
ocaml/_tags
Normal file
@ -0,0 +1,3 @@
|
|||||||
|
true: package(core)
|
||||||
|
true: thread
|
||||||
|
|
@ -1,4 +1,7 @@
|
|||||||
|
exception ElementError of string
|
||||||
|
|
||||||
type t =
|
type t =
|
||||||
|
|X
|
||||||
|H |He
|
|H |He
|
||||||
|Li|Be |B |C |N |O |F |Ne
|
|Li|Be |B |C |N |O |F |Ne
|
||||||
|Na|Mg |Al|Si|P |S |Cl|Ar
|
|Na|Mg |Al|Si|P |S |Cl|Ar
|
||||||
@ -6,6 +9,7 @@ type t =
|
|||||||
;;
|
;;
|
||||||
|
|
||||||
let of_string = function
|
let of_string = function
|
||||||
|
| "X" | "Dummy" -> X
|
||||||
| "H" | "Hydrogen" -> H
|
| "H" | "Hydrogen" -> H
|
||||||
| "He" | "Helium" -> He
|
| "He" | "Helium" -> He
|
||||||
| "Li" | "Lithium" -> Li
|
| "Li" | "Lithium" -> Li
|
||||||
@ -42,9 +46,11 @@ let of_string = function
|
|||||||
| "Se" | "Selenium" -> Se
|
| "Se" | "Selenium" -> Se
|
||||||
| "Br" | "Bromine" -> Br
|
| "Br" | "Bromine" -> Br
|
||||||
| "Kr" | "Krypton" -> Kr
|
| "Kr" | "Krypton" -> Kr
|
||||||
|
| x -> raise (ElementError ("Atom "^x^" unknown"))
|
||||||
;;
|
;;
|
||||||
|
|
||||||
let to_string = function
|
let to_string = function
|
||||||
|
| X -> "X"
|
||||||
| H -> "H"
|
| H -> "H"
|
||||||
| He -> "He"
|
| He -> "He"
|
||||||
| Li -> "Li"
|
| Li -> "Li"
|
||||||
@ -84,6 +90,7 @@ let to_string = function
|
|||||||
;;
|
;;
|
||||||
|
|
||||||
let to_long_string = function
|
let to_long_string = function
|
||||||
|
| X -> "Dummy"
|
||||||
| H -> "Hydrogen"
|
| H -> "Hydrogen"
|
||||||
| He -> "Helium"
|
| He -> "Helium"
|
||||||
| Li -> "Lithium"
|
| Li -> "Lithium"
|
||||||
@ -121,3 +128,44 @@ let to_long_string = function
|
|||||||
| Br -> "Bromine"
|
| Br -> "Bromine"
|
||||||
| Kr -> "Krypton"
|
| Kr -> "Krypton"
|
||||||
;;
|
;;
|
||||||
|
|
||||||
|
let charge = function
|
||||||
|
| X -> 0
|
||||||
|
| H -> 1
|
||||||
|
| He -> 2
|
||||||
|
| Li -> 3
|
||||||
|
| Be -> 4
|
||||||
|
| B -> 5
|
||||||
|
| C -> 6
|
||||||
|
| N -> 7
|
||||||
|
| O -> 8
|
||||||
|
| F -> 9
|
||||||
|
| Ne -> 10
|
||||||
|
| Na -> 11
|
||||||
|
| Mg -> 12
|
||||||
|
| Al -> 13
|
||||||
|
| Si -> 14
|
||||||
|
| P -> 15
|
||||||
|
| S -> 16
|
||||||
|
| Cl -> 17
|
||||||
|
| Ar -> 18
|
||||||
|
| K -> 19
|
||||||
|
| Ca -> 20
|
||||||
|
| Sc -> 21
|
||||||
|
| Ti -> 22
|
||||||
|
| V -> 23
|
||||||
|
| Cr -> 24
|
||||||
|
| Mn -> 25
|
||||||
|
| Fe -> 26
|
||||||
|
| Co -> 27
|
||||||
|
| Ni -> 28
|
||||||
|
| Cu -> 29
|
||||||
|
| Zn -> 30
|
||||||
|
| Ga -> 31
|
||||||
|
| Ge -> 32
|
||||||
|
| As -> 33
|
||||||
|
| Se -> 34
|
||||||
|
| Br -> 35
|
||||||
|
| Kr -> 36
|
||||||
|
;;
|
||||||
|
|
||||||
|
71
ocaml/gto.ml
Normal file
71
ocaml/gto.ml
Normal file
@ -0,0 +1,71 @@
|
|||||||
|
open Core.Std;;
|
||||||
|
open Qptypes;;
|
||||||
|
|
||||||
|
exception GTO_Read_Failure of string
|
||||||
|
|
||||||
|
type t =
|
||||||
|
{ sym : Symmetry.t ;
|
||||||
|
lc : ((Primitive.t * float) list)
|
||||||
|
}
|
||||||
|
;;
|
||||||
|
|
||||||
|
let of_prim_coef_list pc =
|
||||||
|
let (p,c) = List.hd_exn pc in
|
||||||
|
let sym = p.Primitive.sym in
|
||||||
|
let rec check = function
|
||||||
|
| [] -> `OK
|
||||||
|
| (p,c)::tl ->
|
||||||
|
if p.Primitive.sym <> sym then
|
||||||
|
`Failed
|
||||||
|
else
|
||||||
|
check tl
|
||||||
|
in
|
||||||
|
match check pc with
|
||||||
|
| `Failed -> raise (Failure "Failed in of_prim_coef_list")
|
||||||
|
| `OK ->
|
||||||
|
{ sym = sym ;
|
||||||
|
lc = pc
|
||||||
|
}
|
||||||
|
;;
|
||||||
|
|
||||||
|
|
||||||
|
let read_one in_channel =
|
||||||
|
(* Fetch number of lines to read on first line *)
|
||||||
|
let buffer = input_line in_channel in
|
||||||
|
let sym_str = String.sub buffer 0 2 in
|
||||||
|
let n_str = String.sub buffer 2 ((String.length buffer)-2) in
|
||||||
|
let sym = Symmetry.of_string (String.strip sym_str) in
|
||||||
|
let n = Int.of_string (String.strip n_str) in
|
||||||
|
(* Read all the primitives *)
|
||||||
|
let rec read_lines result = function
|
||||||
|
| 0 -> result
|
||||||
|
| i ->
|
||||||
|
begin
|
||||||
|
let line_buffer = input_line in_channel in
|
||||||
|
let buffer = line_buffer
|
||||||
|
|> String.split ~on:' '
|
||||||
|
|> List.filter ~f:(fun x -> x <> "")
|
||||||
|
in
|
||||||
|
match buffer with
|
||||||
|
| [ j ; expo ; coef ] ->
|
||||||
|
begin
|
||||||
|
let p = { Primitive.sym = sym ;
|
||||||
|
Primitive.expo = Positive_float.of_float
|
||||||
|
(Float.of_string expo)
|
||||||
|
}
|
||||||
|
and c = Float.of_string coef in
|
||||||
|
read_lines ( (p,c)::result) (i-1)
|
||||||
|
end
|
||||||
|
| _ -> raise (GTO_Read_Failure line_buffer)
|
||||||
|
end
|
||||||
|
in read_lines [] n
|
||||||
|
|> of_prim_coef_list
|
||||||
|
;;
|
||||||
|
|
||||||
|
|
||||||
|
let to_string { sym = sym ; lc = lc } =
|
||||||
|
let f (p,c) = Printf.sprintf "( %s, %f )" (Primitive.to_string p) c
|
||||||
|
in
|
||||||
|
Printf.sprintf "[ %s : %s ]" (Symmetry.to_string sym)
|
||||||
|
(String.concat (List.map ~f:f lc) ?sep:(Some ", "))
|
||||||
|
;;
|
15
ocaml/primitive.ml
Normal file
15
ocaml/primitive.ml
Normal file
@ -0,0 +1,15 @@
|
|||||||
|
open Qptypes;;
|
||||||
|
open Core.Std;;
|
||||||
|
|
||||||
|
type t =
|
||||||
|
{ sym : Symmetry.t ;
|
||||||
|
expo : Positive_float.t ;
|
||||||
|
}
|
||||||
|
|
||||||
|
let to_string p =
|
||||||
|
let { sym = s ; expo = e } = p in
|
||||||
|
Printf.sprintf "(%s, %f)"
|
||||||
|
(Symmetry.to_string s)
|
||||||
|
(Positive_float.to_float e)
|
||||||
|
;;
|
||||||
|
|
105
ocaml/qptypes.ml
Normal file
105
ocaml/qptypes.ml
Normal file
@ -0,0 +1,105 @@
|
|||||||
|
module Positive_float : sig
|
||||||
|
type t
|
||||||
|
val to_float : t -> float
|
||||||
|
val of_float : float -> t
|
||||||
|
end = struct
|
||||||
|
type t = float
|
||||||
|
let to_float x = x
|
||||||
|
let of_float x = ( assert (x > 0.) ; x )
|
||||||
|
end
|
||||||
|
|
||||||
|
|
||||||
|
module Strictly_positive_float : sig
|
||||||
|
type t
|
||||||
|
val to_float : t ->float
|
||||||
|
val of_float : float -> t
|
||||||
|
end = struct
|
||||||
|
type t =float
|
||||||
|
let to_float x = x
|
||||||
|
let of_float x = ( assert (x >= 0.) ; x )
|
||||||
|
end
|
||||||
|
|
||||||
|
|
||||||
|
module Positive_int : sig
|
||||||
|
type t
|
||||||
|
val to_int : t -> int
|
||||||
|
val of_int : int -> t
|
||||||
|
end = struct
|
||||||
|
type t = int
|
||||||
|
let to_int x = x
|
||||||
|
let of_int x = ( assert (x > 0) ; x )
|
||||||
|
end
|
||||||
|
|
||||||
|
|
||||||
|
module Strictly_positive_int : sig
|
||||||
|
type t
|
||||||
|
val to_int : t -> int
|
||||||
|
val of_int : int -> t
|
||||||
|
end = struct
|
||||||
|
type t = int
|
||||||
|
let to_int x = x
|
||||||
|
let of_int x = ( assert (x >= 0) ; x )
|
||||||
|
end
|
||||||
|
|
||||||
|
|
||||||
|
module Non_empty_string : sig
|
||||||
|
type t
|
||||||
|
val to_string : t -> string
|
||||||
|
val of_string : string -> t
|
||||||
|
end = struct
|
||||||
|
type t = string
|
||||||
|
let to_string x = x
|
||||||
|
let of_string x = ( assert (x <> "") ; x )
|
||||||
|
end
|
||||||
|
|
||||||
|
(*
|
||||||
|
module MO_number : sig
|
||||||
|
type t
|
||||||
|
val to_int : t -> int
|
||||||
|
val of_int : int -> t
|
||||||
|
end = struct
|
||||||
|
type t = int
|
||||||
|
let to_int x = x
|
||||||
|
let of_int x = ( assert (x > 0) ;
|
||||||
|
if (Ezfio.has_mo_basis_mo_tot_num ()) then
|
||||||
|
assert (x <= (Ezfio.get_mo_basis_mo_tot_num ())); x )
|
||||||
|
end
|
||||||
|
|
||||||
|
|
||||||
|
module AO_number : sig
|
||||||
|
type t
|
||||||
|
val to_int : t -> int
|
||||||
|
val of_int : int -> t
|
||||||
|
end = struct
|
||||||
|
type t = int
|
||||||
|
let to_int x = x
|
||||||
|
let of_int x = ( assert (x > 0) ;
|
||||||
|
if (Ezfio.has_ao_basis_ao_num ()) then
|
||||||
|
assert (x <= (Ezfio.get_ao_basis_ao_num ())); x )
|
||||||
|
end
|
||||||
|
|
||||||
|
|
||||||
|
module N_int_number : sig
|
||||||
|
type t
|
||||||
|
val to_int : t -> int
|
||||||
|
val of_int : int -> t
|
||||||
|
end = struct
|
||||||
|
type t = int
|
||||||
|
let to_int x = x
|
||||||
|
let of_int x = ( assert (x > 0) ;
|
||||||
|
if (Ezfio.has_determinants_n_int ()) then
|
||||||
|
assert (x == (Ezfio.get_determinants_n_int ())); x )
|
||||||
|
end
|
||||||
|
|
||||||
|
module Det_number : sig
|
||||||
|
type t
|
||||||
|
val to_int : t -> int
|
||||||
|
val of_int : int -> t
|
||||||
|
end = struct
|
||||||
|
type t = int
|
||||||
|
let to_int x = x
|
||||||
|
let of_int x = ( assert (x > 0) ;
|
||||||
|
if (Ezfio.has_determinants_det_num ()) then
|
||||||
|
assert (x <= (Ezfio.get_determinants_det_num ())); x )
|
||||||
|
end
|
||||||
|
*)
|
40
ocaml/symmetry.ml
Normal file
40
ocaml/symmetry.ml
Normal file
@ -0,0 +1,40 @@
|
|||||||
|
type t = S|P|D|F|G|H|I|J|K|L
|
||||||
|
|
||||||
|
let to_string = function
|
||||||
|
| S -> "S"
|
||||||
|
| P -> "P"
|
||||||
|
| D -> "D"
|
||||||
|
| F -> "F"
|
||||||
|
| G -> "G"
|
||||||
|
| H -> "H"
|
||||||
|
| I -> "I"
|
||||||
|
| J -> "J"
|
||||||
|
| K -> "K"
|
||||||
|
| L -> "L"
|
||||||
|
|
||||||
|
let of_string = function
|
||||||
|
| "S" -> S
|
||||||
|
| "P" -> P
|
||||||
|
| "D" -> D
|
||||||
|
| "F" -> F
|
||||||
|
| "G" -> G
|
||||||
|
| "H" -> H
|
||||||
|
| "I" -> I
|
||||||
|
| "J" -> J
|
||||||
|
| "K" -> K
|
||||||
|
| "L" -> L
|
||||||
|
| x -> raise (Failure ("Symmetry should be S|P|D|F|G|H|I|J|K|L,
|
||||||
|
not "^x^"."))
|
||||||
|
|
||||||
|
let of_char = function
|
||||||
|
| 'S' -> S
|
||||||
|
| 'P' -> P
|
||||||
|
| 'D' -> D
|
||||||
|
| 'F' -> F
|
||||||
|
| 'G' -> G
|
||||||
|
| 'H' -> H
|
||||||
|
| 'I' -> I
|
||||||
|
| 'J' -> J
|
||||||
|
| 'K' -> K
|
||||||
|
| 'L' -> L
|
||||||
|
| x -> raise (Failure ("Symmetry should be S|P|D|F|G|H|I|J|K|L"))
|
6
ocaml/test_elements.ml
Normal file
6
ocaml/test_elements.ml
Normal file
@ -0,0 +1,6 @@
|
|||||||
|
let test_module () =
|
||||||
|
let atom = Elements.of_string "Cobalt" in
|
||||||
|
Printf.printf "%s %d\n" (Elements.to_string atom) (Elements.charge atom)
|
||||||
|
;;
|
||||||
|
|
||||||
|
test_module ();;
|
25
ocaml/test_gto.ml
Normal file
25
ocaml/test_gto.ml
Normal file
@ -0,0 +1,25 @@
|
|||||||
|
open Core.Std;;
|
||||||
|
open Qptypes;;
|
||||||
|
|
||||||
|
let test_prim () =
|
||||||
|
let p =
|
||||||
|
{ Primitive.sym = Symmetry.P ;
|
||||||
|
Primitive.expo = Positive_float.of_float 0.15} in
|
||||||
|
Primitive.to_string p
|
||||||
|
|> print_string
|
||||||
|
;;
|
||||||
|
|
||||||
|
let test_gto () =
|
||||||
|
let in_channel = open_in "/home/scemama/quantum_package/data/basis/cc-pVDZ" in
|
||||||
|
ignore (input_line in_channel);
|
||||||
|
let gto = Gto.read_one in_channel in
|
||||||
|
print_string (Gto.to_string gto);
|
||||||
|
let gto = Gto.read_one in_channel in
|
||||||
|
print_string (Gto.to_string gto);
|
||||||
|
;;
|
||||||
|
|
||||||
|
let test_module () =
|
||||||
|
test_gto()
|
||||||
|
;;
|
||||||
|
|
||||||
|
test_module ();;
|
Loading…
Reference in New Issue
Block a user