Added GTOs in Ocaml

ocaml/Makefile

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

ocaml/_tags

@@ -0,0 +1,3 @@
+true: package(core)
+true: thread
+

ocaml/elements.ml

@@ -1,4 +1,7 @@
+exception ElementError of string
+
 type t =
+|X
 |H                                                 |He
 |Li|Be                              |B |C |N |O |F |Ne
 |Na|Mg                              |Al|Si|P |S |Cl|Ar
@@ -6,6 +9,7 @@ type t =
 ;;
 
 let of_string = function
+| "X"  | "Dummy" -> X
 | "H"  | "Hydrogen" -> H
 | "He" | "Helium" -> He
 | "Li" | "Lithium" -> Li
@@ -42,9 +46,11 @@ let of_string = function
 | "Se" | "Selenium" -> Se
 | "Br" | "Bromine" -> Br
 | "Kr" | "Krypton" -> Kr
+| x -> raise (ElementError ("Atom "^x^" unknown"))
 ;;
 
 let to_string = function
+| X   -> "X"
 | H   -> "H"
 | He  -> "He"
 | Li  -> "Li"
@@ -84,6 +90,7 @@ let to_string = function
 ;;
 
 let to_long_string = function
+| X   -> "Dummy"
 | H   -> "Hydrogen"
 | He  -> "Helium"
 | Li  -> "Lithium"
@@ -121,3 +128,44 @@ let to_long_string = function
 | Br  -> "Bromine"
 | 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
+;;
+

ocaml/gto.ml

@@ -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 ", "))
+;;

ocaml/primitive.ml

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

ocaml/qptypes.ml

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

ocaml/symmetry.ml

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

ocaml/test_elements.ml

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

ocaml/test_gto.ml

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