mirror of
https://github.com/LCPQ/quantum_package
synced 2024-08-25 05:51:46 +02:00
Added molecule in ocaml
This commit is contained in:
parent
96de00ea77
commit
9bffc0883b
5
ocaml/.gitignore
vendored
Normal file
5
ocaml/.gitignore
vendored
Normal file
@ -0,0 +1,5 @@
|
||||
ezfio.ml
|
||||
*.byte
|
||||
*.native
|
||||
_build
|
||||
|
@ -1,19 +1,37 @@
|
||||
# Check if QPACKAGE_ROOT is defined
|
||||
|
||||
ifndef QPACKAGE_ROOT
|
||||
$(info -------------------- Error --------------------)
|
||||
$(info QPACKAGE_ROOT undefined. Source the quantum_package.rc script)
|
||||
$(info -----------------------------------------------)
|
||||
$(error )
|
||||
endif
|
||||
|
||||
LIBS=
|
||||
PKGS=
|
||||
OCAMLCFLAGS=-g
|
||||
OCAMLBUILD=ocamlbuild -cflags $(OCAMLCFLAGS) -lflags -g
|
||||
MLFILES=$(wildcard *.ml) ezfio.ml
|
||||
MLIFILES=$(wildcard *.mli)
|
||||
ALL_TESTS=$(patsubst %.ml,%.byte,$(wildcard test_*.ml))
|
||||
|
||||
|
||||
test_elements.byte:
|
||||
default: $(ALL_TESTS)
|
||||
|
||||
%.inferred.mli: $(wildcard *.ml)
|
||||
%.inferred.mli: $(MLFILES)
|
||||
$(OCAMLBUILD) $*.inferred.mli -cflags -i -use-ocamlfind $(PKGS)
|
||||
|
||||
%.byte: $(wildcard *.ml) $(wildcard *.mli)
|
||||
%.byte: $(MLFILES) $(MLIFILES)
|
||||
$(OCAMLBUILD) $*.byte -use-ocamlfind $(PKGS)
|
||||
|
||||
%.native: $(wildcard *.ml) $(wildcard *.mli)
|
||||
%.native: $(MLFILES) $(MLIFILES)
|
||||
$(OCAMLBUILD) $*.native -use-ocamlfind $(PKGS)
|
||||
|
||||
ezfio.ml: ${QPACKAGE_ROOT}/EZFIO/Ocaml/ezfio.ml
|
||||
cp ${QPACKAGE_ROOT}/EZFIO/Ocaml/ezfio.ml .
|
||||
|
||||
${QPACKAGE_ROOT}/EZFIO/Ocaml/ezfio.ml:
|
||||
$(MAKE) -C ${QPACKAGE_ROOT}/src ezfio
|
||||
|
||||
clean:
|
||||
rm -rf _build
|
||||
|
6
ocaml/README.rst
Normal file
6
ocaml/README.rst
Normal file
@ -0,0 +1,6 @@
|
||||
===============
|
||||
Ocaml scripts
|
||||
===============
|
||||
|
||||
This directory contains all the scripts that control the input/output
|
||||
with the user.
|
@ -35,6 +35,12 @@ let of_string s =
|
||||
charge = Charge.of_string charge ;
|
||||
coord = Point3d.of_string (String.concat [x; y; z] ?sep:(Some " "))
|
||||
}
|
||||
| [ name; x; y; z ] ->
|
||||
let e = Element.of_string name in
|
||||
{ element = e ;
|
||||
charge = Charge.of_int (Element.charge e);
|
||||
coord = Point3d.of_string (String.concat [x; y; z] ?sep:(Some " "))
|
||||
}
|
||||
| _ -> raise (AtomError s)
|
||||
;;
|
||||
|
||||
|
101
ocaml/molecule.ml
Normal file
101
ocaml/molecule.ml
Normal file
@ -0,0 +1,101 @@
|
||||
open Core.Std ;;
|
||||
open Qptypes ;;
|
||||
|
||||
exception MultiplicityError of string;;
|
||||
|
||||
type t = {
|
||||
nuclei : Atom.t list ;
|
||||
elec_alpha : Positive_int.t ;
|
||||
elec_beta : Positive_int.t ;
|
||||
}
|
||||
|
||||
let charge { nuclei ; elec_alpha ; elec_beta } =
|
||||
let result = Positive_int.(to_int elec_alpha + to_int elec_beta) in
|
||||
let rec nucl_charge = function
|
||||
| a::rest -> Atom.(Charge.to_float a.charge) +. nucl_charge rest
|
||||
| [] -> 0.
|
||||
in
|
||||
nucl_charge nuclei -. (Float.of_int result)
|
||||
;;
|
||||
|
||||
let multiplicity m =
|
||||
Multiplicity.of_alpha_beta m.elec_alpha m.elec_beta
|
||||
;;
|
||||
|
||||
let name m =
|
||||
let cm = Float.to_int (charge m) in
|
||||
let c =
|
||||
match cm with
|
||||
| 0 -> ""
|
||||
| 1 -> " (+)"
|
||||
| (-1) -> " (-)"
|
||||
| i when i>1 -> Printf.sprintf " (%d+)" i
|
||||
| i -> Printf.sprintf " (%d-)" (-i)
|
||||
in
|
||||
let mult = Multiplicity.to_string (multiplicity m) in
|
||||
let { nuclei ; elec_alpha ; elec_beta } = m in
|
||||
let rec build_list accu = function
|
||||
| a::rest ->
|
||||
begin
|
||||
let e = a.Atom.element in
|
||||
match (List.Assoc.find accu e) with
|
||||
| None -> build_list (List.Assoc.add accu e 1) rest
|
||||
| Some i -> build_list (List.Assoc.add accu e (i+1)) rest
|
||||
end
|
||||
| [] -> accu
|
||||
in
|
||||
let rec build_name accu = function
|
||||
| (a, n)::rest ->
|
||||
let a = Element.to_string a in
|
||||
begin
|
||||
match n with
|
||||
| 1 -> build_name (a::accu) rest
|
||||
| i when i>1 ->
|
||||
let tmp = Printf.sprintf "%s%d" a i
|
||||
in build_name (tmp::accu) rest
|
||||
| _ -> assert false
|
||||
end
|
||||
| [] -> accu
|
||||
in
|
||||
let result = build_list [] nuclei |> build_name [c ; ", " ; mult]
|
||||
in
|
||||
String.concat (result)
|
||||
;;
|
||||
|
||||
let to_string m =
|
||||
let { nuclei ; elec_alpha ; elec_beta } = m in
|
||||
let n = List.length nuclei in
|
||||
let title = name m in
|
||||
[ Int.to_string n ; title ] @ (List.map ~f:Atom.to_string nuclei)
|
||||
|> String.concat ?sep:(Some "\n")
|
||||
;;
|
||||
|
||||
let of_xyz_string s charge' multiplicity' =
|
||||
let l = String.split s ~on:'\n'
|
||||
|> List.filter ~f:(fun x -> x <> "")
|
||||
|> List.map ~f:Atom.of_string
|
||||
in
|
||||
let ne = ( charge {
|
||||
nuclei=l ;
|
||||
elec_alpha=(Positive_int.of_int 0) ;
|
||||
elec_beta=(Positive_int.of_int 0) }
|
||||
|> Float.to_int
|
||||
)- charge'
|
||||
|> Positive_int.of_int
|
||||
in
|
||||
let (na,nb) = Multiplicity.to_alpha_beta ne multiplicity' in
|
||||
let result =
|
||||
{ nuclei = l ;
|
||||
elec_alpha = (Positive_int.of_int na) ;
|
||||
elec_beta = (Positive_int.of_int nb) }
|
||||
in
|
||||
if ((multiplicity result) <> multiplicity') then
|
||||
let msg = Printf.sprintf
|
||||
"With %d electrons multiplicity %d is impossible"
|
||||
(Positive_int.to_int ne)
|
||||
(Multiplicity.to_int multiplicity')
|
||||
in
|
||||
raise (MultiplicityError msg);
|
||||
else () ;
|
||||
result
|
||||
;;
|
35
ocaml/multiplicity.ml
Normal file
35
ocaml/multiplicity.ml
Normal file
@ -0,0 +1,35 @@
|
||||
open Qptypes ;;
|
||||
|
||||
type t = Strictly_positive_int.t;;
|
||||
let of_int = Strictly_positive_int.of_int ;;
|
||||
let to_int = Strictly_positive_int.to_int ;;
|
||||
|
||||
let to_string m =
|
||||
match (to_int m) with
|
||||
| 1 -> "Singlet"
|
||||
| 2 -> "Doublet"
|
||||
| 3 -> "Triplet"
|
||||
| 4 -> "Quartet"
|
||||
| 5 -> "Quintet"
|
||||
| 6 -> "Sextet"
|
||||
| 7 -> "Septet"
|
||||
| 8 -> "Octet"
|
||||
| 9 -> "Nonet"
|
||||
| i -> Printf.sprintf "%d-et" i
|
||||
;;
|
||||
|
||||
let of_alpha_beta a b =
|
||||
let a = Positive_int.to_int a
|
||||
and b = Positive_int.to_int b
|
||||
in
|
||||
assert (a >= b);
|
||||
of_int (1 + a - b)
|
||||
;;
|
||||
|
||||
let to_alpha_beta ne m =
|
||||
let ne = Positive_int.to_int ne in
|
||||
let nb = (ne-(to_int m)+1)/2 in
|
||||
let na = ne - nb in
|
||||
assert (na >= nb) ;
|
||||
(na,nb)
|
||||
;;
|
@ -5,7 +5,7 @@ module Positive_float : sig
|
||||
end = struct
|
||||
type t = float
|
||||
let to_float x = x
|
||||
let of_float x = ( assert (x > 0.) ; x )
|
||||
let of_float x = ( assert (x >= 0.) ; x )
|
||||
end
|
||||
|
||||
|
||||
@ -16,7 +16,7 @@ module Strictly_positive_float : sig
|
||||
end = struct
|
||||
type t =float
|
||||
let to_float x = x
|
||||
let of_float x = ( assert (x >= 0.) ; x )
|
||||
let of_float x = ( assert (x > 0.) ; x )
|
||||
end
|
||||
|
||||
|
||||
@ -27,7 +27,7 @@ module Positive_int : sig
|
||||
end = struct
|
||||
type t = int
|
||||
let to_int x = x
|
||||
let of_int x = ( assert (x > 0) ; x )
|
||||
let of_int x = ( assert (x >= 0) ; x )
|
||||
end
|
||||
|
||||
|
||||
@ -38,7 +38,7 @@ module Strictly_positive_int : sig
|
||||
end = struct
|
||||
type t = int
|
||||
let to_int x = x
|
||||
let of_int x = ( assert (x >= 0) ; x )
|
||||
let of_int x = ( assert (x > 0) ; x )
|
||||
end
|
||||
|
||||
|
||||
|
@ -1,6 +1,6 @@
|
||||
let test_module () =
|
||||
let atom = Elements.of_string "Cobalt" in
|
||||
Printf.printf "%s %d\n" (Elements.to_string atom) (Elements.charge atom)
|
||||
let atom = Element.of_string "Cobalt" in
|
||||
Printf.printf "%s %d\n" (Element.to_string atom) (Element.charge atom)
|
||||
;;
|
||||
|
||||
test_module ();;
|
||||
|
35
ocaml/test_molecule.ml
Normal file
35
ocaml/test_molecule.ml
Normal file
@ -0,0 +1,35 @@
|
||||
open Core.Std ;;
|
||||
open Qptypes ;;
|
||||
|
||||
let test_molecule () =
|
||||
let xyz =
|
||||
"
|
||||
H 1.0 0.54386314 0.00000000 -3.78645152
|
||||
O 8.0 1.65102147 0.00000000 -2.35602344
|
||||
H 1.0 0.54386314 0.00000000 -0.92559535
|
||||
"
|
||||
in
|
||||
|
||||
try ignore (Molecule.of_xyz_string xyz 1 (Strictly_positive_int.of_int 1))
|
||||
with
|
||||
| Molecule.MultiplicityError _ -> print_string "OK\n"
|
||||
;
|
||||
print_string "---\n";
|
||||
let m = Molecule.of_xyz_string xyz 0 (Strictly_positive_int.of_int 1)
|
||||
in print_endline (Molecule.name m) ;
|
||||
let m = Molecule.of_xyz_string xyz 1 (Strictly_positive_int.of_int 2)
|
||||
in print_endline (Molecule.name m) ;
|
||||
|
||||
let xyz =
|
||||
"
|
||||
H 0.54386314 0.00000000 -3.78645152
|
||||
O 1.65102147 0.00000000 -2.35602344
|
||||
H 0.54386314 0.00000000 -0.92559535
|
||||
"
|
||||
in
|
||||
let m = Molecule.of_xyz_string xyz (-2) (Strictly_positive_int.of_int 1)
|
||||
in print_endline (Molecule.name m) ;
|
||||
print_string (Molecule.to_string m);
|
||||
;;
|
||||
|
||||
test_molecule ();;
|
@ -96,6 +96,7 @@ $(EZFIO): $(wildcard $(QPACKAGE_ROOT)/src/*.ezfio_config) $(wildcard $(QPACKAGE_
|
||||
@cp $(wildcard $(QPACKAGE_ROOT)/src/*.ezfio_config) $(wildcard $(QPACKAGE_ROOT)/src/*/*.ezfio_config) $(EZFIO_DIR)/config
|
||||
@cd $(EZFIO_DIR) ; export FC="$(FC)" ; export FCFLAGS="$(FCFLAGS)" ; export IRPF90="$(IRPF90)" ; $(MAKE) ; $(MAKE) Python
|
||||
|
||||
ezfio: $(EZFIO)
|
||||
|
||||
# Create symbolic links of other modules
|
||||
|
||||
|
@ -1,2 +0,0 @@
|
||||
AOs BiInts Bitmask CISD CISD_SC2_selected CISD_selected DensityMatrix Dets Electrons Ezfio_files Full_CI Generators_full Hartree_Fock MOGuess MonoInts MOs MP2 Nuclei Output Perturbation SC2 Selectors_full SingleRefMethod Utils
|
||||
|
Loading…
Reference in New Issue
Block a user