diff --git a/ocaml/Makefile b/ocaml/Makefile new file mode 100644 index 00000000..cbc4d1a3 --- /dev/null +++ b/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 diff --git a/ocaml/_tags b/ocaml/_tags new file mode 100644 index 00000000..55cb5085 --- /dev/null +++ b/ocaml/_tags @@ -0,0 +1,3 @@ +true: package(core) +true: thread + diff --git a/ocaml/elements.ml b/ocaml/elements.ml index 1c5448b8..490742f4 100644 --- a/ocaml/elements.ml +++ b/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 +;; + diff --git a/ocaml/gto.ml b/ocaml/gto.ml new file mode 100644 index 00000000..aee082f8 --- /dev/null +++ b/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 ", ")) +;; diff --git a/ocaml/primitive.ml b/ocaml/primitive.ml new file mode 100644 index 00000000..1f52b0d9 --- /dev/null +++ b/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) +;; + diff --git a/ocaml/qptypes.ml b/ocaml/qptypes.ml new file mode 100644 index 00000000..da712868 --- /dev/null +++ b/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 +*) diff --git a/ocaml/symmetry.ml b/ocaml/symmetry.ml new file mode 100644 index 00000000..881bcf99 --- /dev/null +++ b/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")) diff --git a/ocaml/test_elements.ml b/ocaml/test_elements.ml new file mode 100644 index 00000000..676e9835 --- /dev/null +++ b/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 ();; diff --git a/ocaml/test_gto.ml b/ocaml/test_gto.ml new file mode 100644 index 00000000..22477939 --- /dev/null +++ b/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 ();;