LCPQ
/
quantum_package
mirror of https://github.com/LCPQ/quantum_package
10
0
Fork 0
Code Issues Releases Wiki Activity

Modified for ocaml 4.04

This commit is contained in:
Anthony Scemama 2017-08-18 18:28:33 +02:00
parent 6c7d768730
commit 8523096a90
71 changed files with 304 additions and 369 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

2
ocaml/Address.ml
View File

@ -1,4 +1,4 @@
open Core.Std
open Core
module Tcp : sig
type t

4
ocaml/Atom.ml
View File

@ -1,4 +1,4 @@
open Core.Std
open Core
exception AtomError of string
@ -6,7 +6,7 @@ type t =
{ element : Element.t ;
charge : Charge.t ;
coord : Point3d.t ;
} with sexp
} [@@deriving sexp]
(** Read xyz coordinates of the atom *)
let of_string ~units s =

4
ocaml/Basis.ml
View File

@ -1,7 +1,7 @@
open Core.Std
open Core
open Qptypes
type t = (Gto.t * Nucl_number.t) list with sexp
type t = (Gto.t * Nucl_number.t) list [@@deriving sexp]
(** Read all the basis functions of an element *)
let read in_channel at_number =

4
ocaml/Bit.ml
View File

@ -1,4 +1,4 @@
open Core.Std;;
open Core;;
(*
Type for bits
@ -11,7 +11,7 @@ Zero | One
type t =
| One
| Zero
with sexp
[@@deriving sexp]
let to_string = function
| Zero -> "0"

2
ocaml/Bit.mli
View File

@ -1,4 +1,4 @@
type t = One | Zero with sexp
type t = One | Zero [@@deriving sexp]
(** String conversions for printing *)
val to_string : t -> string

2
ocaml/Bitlist.ml
View File

@ -1,5 +1,5 @@
open Qptypes
open Core.Std
open Core
(*
Type for bits strings

4
ocaml/Charge.ml
View File

@ -1,6 +1,6 @@
open Core.Std
open Core
type t = float with sexp
type t = float [@@deriving sexp]
let of_float x = x
let of_int i = Float.of_int i

2
ocaml/Charge.mli
View File

@ -1,4 +1,4 @@
type t = float with sexp
type t = float [@@deriving sexp]
(** Float conversion functions *)
val to_float : t -> float

4
ocaml/Determinant.ml
View File

@ -1,7 +1,7 @@
open Core.Std;;
open Core;;
open Qptypes;;
type t = int64 array with sexp
type t = int64 array [@@deriving sexp]
let to_int64_array (x:t) = (x:int64 array)

2
ocaml/Determinant.mli
View File

@ -5,7 +5,7 @@
* where each int64 is a list of 64 MOs. When the bit is set
* to 1, the MO is occupied.
*)
type t = int64 array with sexp
type t = int64 array [@@deriving sexp]
(** Transform to an int64 array *)
val to_int64_array : t -> int64 array

4
ocaml/Element.ml
View File

@ -1,4 +1,4 @@
open Core.Std
open Core
open Qptypes
exception ElementError of string
@ -11,7 +11,7 @@ type t =
|K |Ca|Sc|Ti|V |Cr|Mn|Fe|Co|Ni|Cu|Zn|Ga|Ge|As|Se|Br|Kr
|Rb|Sr|Y |Zr|Nb|Mo|Tc|Ru|Rh|Pd|Ag|Cd|In|Sn|Sb|Te|I |Xe
|Pt
with sexp
[@@deriving sexp]
let of_string x =
match (String.capitalize (String.lowercase x)) with

2
ocaml/Element.mli
View File

@ -8,7 +8,7 @@ type t =
|K |Ca|Sc|Ti|V |Cr|Mn|Fe|Co|Ni|Cu|Zn|Ga|Ge|As|Se|Br|Kr
|Rb|Sr|Y |Zr|Nb|Mo|Tc|Ru|Rh|Pd|Ag|Cd|In|Sn|Sb|Te|I |Xe
|Pt
with sexp
[@@deriving sexp]
(** String conversion functions *)
val of_string : string -> t

18
ocaml/Excitation.ml
View File

@ -1,14 +1,14 @@
open Core.Std;;
open Qptypes;;
open Core
open Qptypes
module Hole = struct
type t = MO_class.t with sexp
type t = MO_class.t [@@deriving sexp]
let of_mo_class x = x
let to_mo_class x = x
end
module Particle = struct
type t = MO_class.t with sexp
type t = MO_class.t [@@deriving sexp]
let of_mo_class x = x
let to_mo_class x = x
end
@ -16,7 +16,7 @@ end
type t =
| Single of Hole.t*Particle.t
| Double of Hole.t*Particle.t*Hole.t*Particle.t
with sexp;;
[@@deriving sexp]
let create_single ~hole ~particle =
MO_class.(
@ -29,7 +29,7 @@ let create_single ~hole ~particle =
| ( _, Inactive _ ) -> failwith "Particles can not be in virtual MOs"
| (h, p) -> Single ( (Hole.of_mo_class h), (Particle.of_mo_class p) )
)
;;
let double_of_singles s1 s2 =
let (h1,p1) = match s1 with
@ -40,14 +40,14 @@ let double_of_singles s1 s2 =
| _ -> assert false
in
Double (h1,p1,h2,p2)
;;
let create_double ~hole1 ~particle1 ~hole2 ~particle2 =
let s1 = create_single ~hole:hole1 ~particle:particle1
and s2 = create_single ~hole:hole2 ~particle:particle2
in
double_of_singles s1 s2
;;
let to_string = function
| Single (h,p) ->
@ -68,5 +68,5 @@ let to_string = function
(MO_class.to_string (Particle.to_mo_class p2));
"]"]
|> String.concat ~sep:" "
;;

2
ocaml/Excitation.mli
View File

@ -18,7 +18,7 @@ module Particle :
type t =
| Single of Hole.t * Particle.t
| Double of Hole.t * Particle.t * Hole.t * Particle.t
with sexp
[@@deriving sexp]
val create_single : hole:MO_class.t -> particle:MO_class.t -> t

4
ocaml/GaussianPrimitive.ml
View File

@ -1,10 +1,10 @@
open Qptypes
open Core.Std
open Core
type t =
{ sym : Symmetry.t ;
expo : AO_expo.t ;
} with sexp
} [@@deriving sexp]
let to_string p =
let { sym = s ; expo = e } = p in

2
ocaml/Generic_input_of_rst.ml
View File

@ -1,4 +1,4 @@
open Core.Std;;
open Core;;
open Qptypes;;

4
ocaml/Gto.ml
View File

@ -1,4 +1,4 @@
open Core.Std
open Core
open Qptypes
exception GTO_Read_Failure of string
@ -11,7 +11,7 @@ type fmt =
type t =
{ sym : Symmetry.t ;
lc : ((GaussianPrimitive.t * AO_coef.t) list)
} with sexp
} [@@deriving sexp]
let of_prim_coef_list pc =

2
ocaml/Gto.mli
View File

@ -7,7 +7,7 @@ type fmt =
type t =
{ sym : Symmetry.t ;
lc : (GaussianPrimitive.t * Qptypes.AO_coef.t) list;
} with sexp
} [@@deriving sexp]
(** Create from a list of GaussianPrimitive.t * Qptypes.AO_coef.t *)
val of_prim_coef_list :

2
ocaml/Input.ml
View File

@ -1,6 +1,6 @@
open Qputils;;
open Qptypes;;
open Core.Std;;
open Core;;
include Input_ao_basis;;
include Input_bitmasks;;

6
ocaml/Input_ao_basis.ml
View File

@ -1,6 +1,6 @@
open Qptypes;;
open Qputils;;
open Core.Std;;
open Core;;
module Ao_basis : sig
type t =
@ -13,7 +13,7 @@ module Ao_basis : sig
ao_coef : AO_coef.t array;
ao_expo : AO_expo.t array;
ao_cartesian : bool;
} with sexp
} [@@deriving sexp]
;;
val read : unit -> t option
val to_string : t -> string
@ -32,7 +32,7 @@ end = struct
ao_coef : AO_coef.t array;
ao_expo : AO_expo.t array;
ao_cartesian : bool;
} with sexp
} [@@deriving sexp]
;;
let get_default = Qpackage.get_ezfio_default "ao_basis";;

6
ocaml/Input_bi_integrals.ml
View File

@ -1,6 +1,6 @@
open Qptypes;;
open Qputils;;
open Core.Std;;
open Core;;
module Bielec_integrals : sig
type t =
@ -11,7 +11,7 @@ module Bielec_integrals : sig
threshold_ao : Threshold.t;
threshold_mo : Threshold.t;
direct : bool;
} with sexp
} [@@deriving sexp]
;;
val read : unit -> t option
val write : t -> unit
@ -27,7 +27,7 @@ end = struct
threshold_ao : Threshold.t;
threshold_mo : Threshold.t;
direct : bool;
} with sexp
} [@@deriving sexp]
;;
let get_default = Qpackage.get_ezfio_default "bielec_integrals";;

6
ocaml/Input_bitmasks.ml
View File

@ -1,6 +1,6 @@
open Qptypes;;
open Qputils;;
open Core.Std;;
open Core;;
module Bitmasks : sig
type t =
@ -10,7 +10,7 @@ module Bitmasks : sig
generators : int64 array;
n_mask_cas : Bitmask_number.t;
cas : int64 array;
} with sexp
} [@@deriving sexp]
;;
val read : unit -> t option
val to_string : t -> string
@ -22,7 +22,7 @@ end = struct
generators : int64 array;
n_mask_cas : Bitmask_number.t;
cas : int64 array;
} with sexp
} [@@deriving sexp]
;;
let get_default = Qpackage.get_ezfio_default "bitmasks";;

6
ocaml/Input_determinants_by_hand.ml
View File

@ -1,6 +1,6 @@
open Qptypes;;
open Qputils;;
open Core.Std;;
open Core;;
module Determinants_by_hand : sig
type t =
@ -11,7 +11,7 @@ module Determinants_by_hand : sig
expected_s2 : Positive_float.t;
psi_coef : Det_coef.t array;
psi_det : Determinant.t array;
} with sexp
} [@@deriving sexp]
val read : unit -> t
val read_maybe : unit -> t option
val write : t -> unit
@ -30,7 +30,7 @@ end = struct
expected_s2 : Positive_float.t;
psi_coef : Det_coef.t array;
psi_det : Determinant.t array;
} with sexp
} [@@deriving sexp]
;;
let get_default = Qpackage.get_ezfio_default "determinants";;

6
ocaml/Input_electrons.ml
View File

@ -1,12 +1,12 @@
open Qptypes;;
open Qputils;;
open Core.Std;;
open Core;;
module Electrons : sig
type t =
{ elec_alpha_num : Elec_alpha_number.t;
elec_beta_num : Elec_beta_number.t;
} with sexp
} [@@deriving sexp]
;;
val read : unit -> t option
val write : t -> unit
@ -18,7 +18,7 @@ end = struct
type t =
{ elec_alpha_num : Elec_alpha_number.t;
elec_beta_num : Elec_beta_number.t;
} with sexp
} [@@deriving sexp]
;;
let get_default = Qpackage.get_ezfio_default "electrons";;

4
ocaml/Input_mo_basis.ml
View File

@ -1,6 +1,6 @@
open Qptypes
open Qputils
open Core.Std
open Core
type t_mo =
{ mo_tot_num : MO_number.t ;
@ -9,7 +9,7 @@ type t_mo =
mo_occ : MO_occ.t array;
mo_coef : (MO_coef.t array) array;
ao_md5 : MD5.t;
} with sexp
} [@@deriving sexp]
module Mo_basis : sig
type t = t_mo

6
ocaml/Input_nuclei_by_hand.ml
View File

@ -1,6 +1,6 @@
open Qptypes;;
open Qputils;;
open Core.Std;;
open Core;;
module Nuclei_by_hand : sig
type t =
@ -8,7 +8,7 @@ module Nuclei_by_hand : sig
nucl_label : Element.t array;
nucl_charge : Charge.t array;
nucl_coord : Point3d.t array;
} with sexp
} [@@deriving sexp]
;;
val read : unit -> t option
val write : t -> unit
@ -22,7 +22,7 @@ end = struct
nucl_label : Element.t array;
nucl_charge : Charge.t array;
nucl_coord : Point3d.t array;
} with sexp
} [@@deriving sexp]
;;
let get_default = Qpackage.get_ezfio_default "nuclei";;

24
ocaml/Io_ext.ml Normal file
View File

@ -0,0 +1,24 @@
let input_lines filename =
let in_channel =
open_in filename
in
let rec aux accu =
try
let newline =
input_line in_channel
in
aux (newline::accu)
with End_of_file -> accu
in
let result =
List.rev (aux [])
in
close_in in_channel;
result
let read_all filename =
input_lines filename
|> String.concat "\n"

4
ocaml/Long_basis.ml
View File

@ -1,7 +1,7 @@
open Core.Std;;
open Core;;
open Qptypes;;
type t = (Symmetry.Xyz.t * Gto.t * Nucl_number.t ) list with sexp
type t = (Symmetry.Xyz.t * Gto.t * Nucl_number.t ) list [@@deriving sexp]
let of_basis b =
let rec do_work accu = function

2
ocaml/Long_basis.mli
View File

@ -5,7 +5,7 @@ open Qptypes;;
* all the D orbitals are converted to xx, xy, xz, yy, yx
* etc
*)
type t = (Symmetry.Xyz.t * Gto.t * Nucl_number.t) list with sexp
type t = (Symmetry.Xyz.t * Gto.t * Nucl_number.t) list [@@deriving sexp]
(** Transform a basis to a long basis *)
val of_basis :

4
ocaml/MO_class.ml
View File

@ -1,4 +1,4 @@
open Core.Std
open Core
open Qptypes
type t =
@ -7,7 +7,7 @@ type t =
| Active of MO_number.t list
| Virtual of MO_number.t list
| Deleted of MO_number.t list
with sexp
[@@deriving sexp]
let to_string x =

2
ocaml/MO_class.mli
View File

@ -4,7 +4,7 @@ type t =
| Active of Qptypes.MO_number.t list
| Virtual of Qptypes.MO_number.t list
| Deleted of Qptypes.MO_number.t list
with sexp
[@@deriving sexp]
(** Create different excitation classes *)

4
ocaml/MO_label.ml
View File

@ -1,4 +1,4 @@
open Core.Std;;
open Core;;
type t =
| Guess
@ -7,7 +7,7 @@ type t =
| Localized
| Orthonormalized
| None
with sexp
[@@deriving sexp]
;;
let to_string = function

2
ocaml/MO_label.mli
View File

@ -5,7 +5,7 @@ type t =
| Localized
| Orthonormalized
| None
with sexp
[@@deriving sexp]
(** String representation *)
val to_string : t -> string

4
ocaml/Makefile
View File

@ -11,8 +11,8 @@ endif
LIBS=
PKGS=
OCAMLCFLAGS="-g -warn-error A"
OCAMLBUILD=ocamlbuild -j 0 -syntax camlp4o -cflags $(OCAMLCFLAGS) -lflags $(OCAMLCFLAGS)
OCAMLCFLAGS="-g"
OCAMLBUILD=ocamlbuild -j 0 -cflags $(OCAMLCFLAGS) -lflags $(OCAMLCFLAGS)
MLLFILES=$(wildcard *.mll)
MLFILES=$(wildcard *.ml) ezfio.ml Qptypes.ml Input_auto_generated.ml qp_edit.ml
MLIFILES=$(wildcard *.mli) git

2
ocaml/Message.ml
View File

@ -1,4 +1,4 @@
open Core.Std
open Core
open Qptypes
(** New job : Request to create a new multi-tasked job *)

63
ocaml/Molecule.ml
View File

@ -1,14 +1,14 @@
open Core.Std ;;
open Qptypes ;;
open Qptypes
open Sexplib.Std
exception MultiplicityError of string;;
exception XYZError ;;
exception MultiplicityError of string
exception XYZError
type t = {
nuclei : Atom.t list ;
elec_alpha : Elec_alpha_number.t ;
elec_beta : Elec_beta_number.t ;
} with sexp
} [@@deriving sexp]
let get_charge { nuclei ; elec_alpha ; elec_beta } =
let result =
@ -19,7 +19,7 @@ let get_charge { nuclei ; elec_alpha ; elec_beta } =
| a::rest -> (Charge.to_float a.Atom.charge) +. nucl_charge rest
| [] -> 0.
in
Charge.of_float (nucl_charge nuclei -. (Float.of_int result))
Charge.of_float (nucl_charge nuclei -. (float_of_int result))
let get_multiplicity m =
@ -59,9 +59,10 @@ let name m =
| 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
try
let i = List.assoc e accu in
build_list ( (e,i+1)::(List.remove_assoc e accu) ) rest
with Not_found -> build_list ( (e,1)::accu ) rest
end
| [] -> accu
in
@ -83,7 +84,7 @@ let name m =
let result =
build_list [] nuclei |> build_name [c ; ", " ; mult]
in
String.concat (result)
String.concat "" result
let to_string_general ~f m =
@ -95,8 +96,8 @@ let to_string_general ~f m =
let title =
name m
in
[ Int.to_string n ; title ] @ (List.map ~f nuclei)
|> String.concat ~sep:"\n"
[ string_of_int n ; title ] @ (List.map f nuclei)
|> String.concat "\n"
let to_string =
to_string_general ~f:(fun x -> Atom.to_string Units.Angstrom x)
@ -109,9 +110,9 @@ let of_xyz_string
?(charge=(Charge.of_int 0)) ?(multiplicity=(Multiplicity.of_int 1))
?(units=Units.Angstrom)
s =
let l = String.split s ~on:'\n'
|> List.filter ~f:(fun x -> x <> "")
|> List.map ~f:(fun x -> Atom.of_string units x)
let l = String_ext.split s ~on:'\n'
|> List.filter (fun x -> x <> "")
|> List.map (fun x -> Atom.of_string units x)
in
let ne = ( get_charge {
nuclei=l ;
@ -145,25 +146,28 @@ let of_xyz_file
?(charge=(Charge.of_int 0)) ?(multiplicity=(Multiplicity.of_int 1))
?(units=Units.Angstrom)
filename =
let (x,buffer) = In_channel.read_all filename
|> String.lsplit2_exn ~on:'\n'
let lines =
match Io_ext.input_lines filename with
| natoms :: title :: rest ->
begin
try
if (int_of_string @@ String_ext.strip natoms) <= 0 then
raise XYZError
with
| _ -> raise XYZError
end;
String.concat "\n" rest
| _ -> failwith ("Problem in xyz file "^filename)
in
let result =
try
(int_of_string @@ String.strip x) > 0
with
| Failure "int_of_string" -> false
in
if not result then raise XYZError;
let (_,buffer) = String.lsplit2_exn buffer ~on:'\n' in
of_xyz_string ~charge ~multiplicity ~units buffer
of_xyz_string ~charge:charge ~multiplicity:multiplicity
~units:units lines
let of_zmt_file
?(charge=(Charge.of_int 0)) ?(multiplicity=(Multiplicity.of_int 1))
?(units=Units.Angstrom)
filename =
In_channel.read_all filename
Io_ext.read_all filename
|> Zmatrix.of_string
|> Zmatrix.to_xyz_string
|> of_xyz_string ~charge ~multiplicity ~units
@ -182,14 +186,14 @@ let of_file
let distance_matrix molecule =
let coord =
molecule.nuclei
|> List.map ~f:(fun x -> x.Atom.coord)
|> List.map (fun x -> x.Atom.coord)
|> Array.of_list
in
let n =
Array.length coord
in
let result =
Array.make_matrix ~dimx:n ~dimy:n 0.
Array.make_matrix n n 0.
in
for i = 0 to (n-1)
do
@ -203,6 +207,7 @@ let distance_matrix molecule =
open Core ;;
include To_md5
let to_md5 = to_md5 sexp_of_t

2
ocaml/Molecule.mli
View File

@ -4,7 +4,7 @@ type t = {
nuclei : Atom.t list;
elec_alpha : Qptypes.Elec_alpha_number.t;
elec_beta : Qptypes.Elec_beta_number.t;
} with sexp
} [@@deriving sexp]
(** Returns the charge of the molecule *)
val get_charge : t -> Charge.t

4
ocaml/Multiplicity.ml
View File

@ -1,7 +1,7 @@
open Core.Std;;
open Core;;
open Qptypes ;;
type t = Strictly_positive_int.t with sexp
type t = Strictly_positive_int.t [@@deriving sexp]
let of_int = Strictly_positive_int.of_int ;;
let to_int = Strictly_positive_int.to_int ;;

2
ocaml/Multiplicity.mli
View File

@ -1,4 +1,4 @@
type t = Qptypes.Strictly_positive_int.t with sexp
type t = Qptypes.Strictly_positive_int.t [@@deriving sexp]
(** Conversion from int *)
val of_int : int -> t

4
ocaml/Point3d.ml
View File

@ -1,11 +1,11 @@
open Core.Std;;
open Core;;
open Qptypes;;
type t = {
x : float ;
y : float ;
z : float ;
} with sexp
} [@@deriving sexp]
let of_tuple ~units (x,y,z) =
let f = match units with

2
ocaml/Point3d.mli
View File

@ -2,7 +2,7 @@ type t =
{ x : float;
y : float;
z : float;
} with sexp
} [@@deriving sexp]
(** Create from a tuple of floats *)
val of_tuple : units:Units.units -> float*float*float -> t

2
ocaml/Primitive.mli
View File

@ -1,7 +1,7 @@
type t =
{ sym : Symmetry.t;
expo : Qptypes.AO_expo.t;
} with sexp
} [@@deriving sexp]
(** Conversion to string for printing *)
val to_string : t -> string

18
ocaml/Progress_bar.ml
View File

@ -1,4 +1,4 @@
open Core.Std
open Core
type t =
{
@ -53,13 +53,13 @@ let display_tty bar =
in
let stop_time =
let x =
Time.Span.to_float running_time
Time.Span.to_sec running_time
in
if (percent > 0.) then
x *. 100. /. percent -. x
|> Time.Span.of_float
|> Time.Span.of_sec
else
Time.Span.of_float 0.
Time.Span.of_sec 0.
in
Printf.eprintf "%s : [%s] %4.1f%% | %10s, ~%10s left\r%!"
bar.title
@ -67,7 +67,7 @@ let display_tty bar =
percent
(Time.Span.to_string running_time)
(stop_time |> Time.Span.to_string );
{ bar with dirty = false ; next = Time.add now (Time.Span.of_float 0.1) }
{ bar with dirty = false ; next = Time.add now (Time.Span.of_sec 0.1) }
let display_file bar =
@ -80,19 +80,19 @@ let display_file bar =
in
let stop_time =
let x =
Time.Span.to_float running_time
Time.Span.to_sec running_time
in
if (percent > 0.) then
x *. 100. /. percent -. x
|> Time.Span.of_float
|> Time.Span.of_sec
else
Time.Span.of_float 0.
Time.Span.of_sec 0.
in
Printf.eprintf "%5.2f %% in %20s, ~%20s left\n%!"
percent
(Time.Span.to_string running_time)
(Time.Span.to_string stop_time);
{ bar with dirty = false ; next = Time.add (Time.now ()) (Time.Span.of_float 2.) }
{ bar with dirty = false ; next = Time.add (Time.now ()) (Time.Span.of_sec 2.) }

12
ocaml/Pseudo.ml
View File

@ -1,4 +1,4 @@
open Core.Std
open Core
open Qptypes
@ -7,7 +7,7 @@ module GaussianPrimitive_local : sig
type t = {
expo : AO_expo.t ;
r_power : R_power.t ;
} with sexp
} [@@deriving sexp]
val of_expo_r_power : AO_expo.t -> R_power.t -> t
val to_string : t -> string
@ -17,7 +17,7 @@ end = struct
type t = {
expo : AO_expo.t ;
r_power : R_power.t ;
} with sexp
} [@@deriving sexp]
let of_expo_r_power dz n =
{ expo = dz ; r_power = n }
@ -35,7 +35,7 @@ module GaussianPrimitive_non_local : sig
expo : AO_expo.t ;
r_power : R_power.t ;
proj : Positive_int.t
} with sexp
} [@@deriving sexp]
val of_proj_expo_r_power : Positive_int.t -> AO_expo.t -> R_power.t -> t
val to_string : t -> string
@ -46,7 +46,7 @@ end = struct
expo : AO_expo.t ;
r_power : R_power.t ;
proj : Positive_int.t
} with sexp
} [@@deriving sexp]
let of_proj_expo_r_power p dz n =
{ expo = dz ; r_power = n ; proj = p }
@ -66,7 +66,7 @@ type t = {
n_elec : Positive_int.t ;
local : (GaussianPrimitive_local.t * AO_coef.t ) list ;
non_local : (GaussianPrimitive_non_local.t * AO_coef.t ) list
} with sexp
} [@@deriving sexp]
let empty e =
{ element = e;

2
ocaml/Qpackage.ml
View File

@ -1,4 +1,4 @@
open Core.Std;;
open Core;;
open Qptypes;;
open Qputils;;

2
ocaml/Qputils.ml
View File

@ -1,4 +1,4 @@
open Core.Std
open Core
(*
let rec transpose = function

4
ocaml/README_qp_edit.rst
View File

@ -19,7 +19,7 @@ of the block.
r_y : Y_type.t
...
last_r : bool
} with sexp
} [@@deriving sexp]
;;
val read : unit -> t
val write : t -> unit
@ -31,7 +31,7 @@ of the block.
r_y : Y_type.t
...
last_r : bool
} with sexp
} [@@deriving sexp]
;;
let get_default = Qpackage.get_ezfio_default "new_keyword";;

10
ocaml/Range.ml
View File

@ -1,4 +1,4 @@
open Core.Std;;
open Core;;
(* A range is a string of the type:
*
@ -12,7 +12,7 @@ open Core.Std;;
*)
type t = int list with sexp
type t = int list [@@deriving sexp]
let expand_range r =
match String.lsplit2 ~on:'-' r with
@ -71,8 +71,8 @@ let to_string l =
let test_module () =
let s = "[72-107,36-53,126-131]" in
let l = of_string s in
print_string s ; print_newline () ;
List.iter ~f:(fun x -> Printf.printf "%d, " x) l ; print_newline () ;
to_string l |> print_string ; print_newline () ;
print_string s ; Out_channel.newline stdout ;
List.iter ~f:(fun x -> Printf.printf "%d, " x) l ; Out_channel.newline stdout ;
to_string l |> print_string ; Out_channel.newline stdout
;;

2
ocaml/Range.mli
View File

@ -1,4 +1,4 @@
type t = int list with sexp
type t = int list [@@deriving sexp]
(** A range is a sorted list of ints in an interval.
It is created using a string :

112
ocaml/String_ext.ml Normal file
View File

@ -0,0 +1,112 @@
include String
(** Split a string on a given character *)
let split ?(on=' ') str =
let rec do_work ?(accu=[]) ?(left="") = function
| "" -> List.rev (left::accu)
| s ->
let new_s =
(length s) - 1
|> sub s 1
in
if (s.[0] = on) then
let new_accu =
left :: accu
in
do_work ~accu:new_accu new_s
else
let new_left =
concat "" [ left ; make 1 s.[0] ]
in
do_work ~accu ~left:new_left new_s
in
do_work str
(** Strip blanks on the left of a string *)
let ltrim s =
let rec do_work s l =
match s.[0] with
| '\n'
| ' ' -> do_work (sub s 1 (l-1)) (l-1)
| _ -> s
in
let l =
length s
in
if (l > 0) then
do_work s l
else
s
(** Strip blanks on the right of a string *)
let rtrim s =
let rec do_work s l =
let newl =
l-1
in
match s.[newl] with
| '\n'
| ' ' -> do_work (sub s 0 (newl)) (newl)
| _ -> s
in
let l =
length s
in
if (l > 0) then
do_work s l
else
s
(** Strip blanks on the right and left of a string *)
let strip = String.trim
(** Split a string in two pieces when a character is found the 1st time from the left *)
let lsplit2_exn ?(on=' ') s =
let length =
String.length s
in
let rec do_work i =
if (i = length) then
begin
raise Not_found
end
else if (s.[i] = on) then
( String.sub s 0 i,
String.sub s (i+1) (length-i-1) )
else
do_work (i+1)
in
do_work 0
(** Split a string in two pieces when a character is found the 1st time from the right *)
let rsplit2_exn ?(on=' ') s =
let length =
String.length s
in
let rec do_work i =
if (i = -1) then
begin
raise Not_found
end
else if (s.[i] = on) then
( String.sub s 0 i,
String.sub s (i+1) (length-i-1) )
else
do_work (i-1)
in
do_work length
let to_list s =
Array.init (String.length s) (fun i -> s.[i])
|> Array.to_list
let fold ~init ~f s =
to_list s
|> List.fold_left f init

6
ocaml/Symmetry.ml
View File

@ -1,7 +1,7 @@
open Qptypes
open Core.Std
open Core
type t = S|P|D|F|G|H|I|J|K|L with sexp
type t = S|P|D|F|G|H|I|J|K|L [@@deriving sexp]
let to_string = function
| S -> "S"
@ -77,7 +77,7 @@ type st = t
module Xyz = struct
type t = { x: Positive_int.t ;
y: Positive_int.t ;
z: Positive_int.t } with sexp
z: Positive_int.t } [@@deriving sexp]
type state_type = Null | X | Y | Z
(** Builds an XYZ triplet from a string.

4
ocaml/Symmetry.mli
View File

@ -1,4 +1,4 @@
type t = S | P | D | F | G | H | I | J | K | L with sexp
type t = S | P | D | F | G | H | I | J | K | L [@@deriving sexp]
(** Creatio from strings *)
val to_string : t -> string
@ -16,7 +16,7 @@ module Xyz :
x : Qptypes.Positive_int.t;
y : Qptypes.Positive_int.t;
z : Qptypes.Positive_int.t;
} with sexp
} [@@deriving sexp]
(** The string format contains the powers of x,y and z in a
format like "x2z3" *)

4
ocaml/TaskServer.ml
View File

@ -1,4 +1,4 @@
open Core.Std
open Core
open Qptypes
@ -63,7 +63,7 @@ let bind_socket ~socket_type ~socket ~port =
ZMQ.Socket.bind socket @@ Printf.sprintf "tcp://*:%d" port;
loop (-1)
with
| Unix.Unix_error _ -> (Time.pause @@ Time.Span.of_float 1. ; loop (i-1) )
| Unix.Unix_error _ -> (Time.pause @@ Time.Span.of_sec 1. ; loop (i-1) )
| other_exception -> raise other_exception
in loop 60

2
ocaml/To_md5.ml
View File

@ -1,4 +1,4 @@
open Core.Std;;
open Core;;
open Qptypes;;
let to_md5 sexp_of_t t =

2
ocaml/_tags
View File

@ -1,3 +1,3 @@
true: package(core,cryptokit,ZMQ,sexplib.syntax,str)
true: package(core,cryptokit,ZMQ,str,ppx_sexp_conv,ppx_deriving)
true: thread
false: profile

206
ocaml/qp_add_aux_basis.ml
View File

@ -1,206 +0,0 @@
open Qputils
open Qptypes
open Core.Std
let spec =
let open Command.Spec in
empty
+> flag "o" (optional string)
~doc:"file Name of the new EZFIO file. Default is suffixed by .RI"
+> flag "b" (required string)
~doc:"string Name of basis set."
+> anon (" EZFIO file)" %: file )
type element =
| Element of Element.t
| Int_elem of (Nucl_number.t * Element.t)
(** Returns the list of available basis sets *)
let list_basis () =
let basis_list =
Qpackage.root ^ "/install/emsl/EMSL_api.py list_basis | grep \"-RI\" "
|> Unix.open_process_in
|> In_channel.input_lines
|> List.map ~f:(fun x ->
match String.split x ~on:'\'' with
| [] -> ""
| a :: []
| _ :: a :: _ -> String.strip a
)
in
List.sort basis_list ~cmp:String.ascending
|> String.concat ~sep:"\n"
(** Run the program *)
let run ?o b ezfio_file =
let new_filename =
match o with
| Some filename -> filename
| None -> ezfio_file ^ ".RI"
in
let () =
match Sys.is_directory new_filename with
| `Yes -> failwith "Output directory exists"
| _ -> ()
in
let status =
Printf.sprintf "cp -r %s %s" ezfio_file new_filename
|> Unix.system
in
ignore status;
Ezfio.set_file new_filename;
(**********
Basis set
**********)
let basis_table =
Hashtbl.Poly.create ()
in
(* Open basis set channels *)
let basis_channel element =
let key =
match element with
| Element e -> Element.to_string e
| Int_elem (i,e) -> Printf.sprintf "%d,%s" (Nucl_number.to_int i) (Element.to_string e)
in
match Hashtbl.find basis_table key with
| Some in_channel ->
in_channel
| None -> raise Not_found
in
let temp_filename =
Filename.temp_file "qp_create_" ".basis"
in
let () =
Sys.remove temp_filename
in
let fetch_channel basis =
let command =
Qpackage.root ^ "/scripts/get_basis.sh \"" ^ temp_filename
^ "." ^ basis ^ "\" \"" ^ basis ^"\""
in
let long_basis =
Qpackage.root ^ "/data/basis/" ^ basis
in
match
Sys.is_file basis,
Sys.is_file long_basis
with
| `Yes, _ -> In_channel.create basis
| `No , `Yes -> In_channel.create long_basis
| _ ->
begin
let filename =
Unix.open_process_in command
|> In_channel.input_all
|> String.strip
in
let new_channel =
In_channel.create filename
in
Unix.unlink filename;
new_channel
end
in
let rec build_basis = function
| [] -> ()
| elem_and_basis_name :: rest ->
begin
match (String.lsplit2 ~on:':' elem_and_basis_name) with
| None -> (* Principal basis *)
begin
let basis =
elem_and_basis_name
in
let new_channel =
fetch_channel basis
in
List.iter nuclei ~f:(fun elem->
let key =
Element.to_string elem.Atom.element
in
match Hashtbl.add basis_table ~key:key ~data:new_channel with
| `Ok -> ()
| `Duplicate -> ()
)
end
| Some (key, basis) -> (*Aux basis *)
begin
let elem =
try
Element (Element.of_string key)
with Element.ElementError _ ->
let result =
match (String.split ~on:',' key) with
| i :: k :: [] -> (Nucl_number.of_int @@ int_of_string i, Element.of_string k)
| _ -> failwith "Expected format is int,Element:basis"
in Int_elem result
and basis =
String.lowercase basis
in
let key =
match elem with
| Element e -> Element.to_string e
| Int_elem (i,e) -> Printf.sprintf "%d,%s" (Nucl_number.to_int i) (Element.to_string e)
in
let new_channel =
fetch_channel basis
in
begin
match Hashtbl.add basis_table ~key:key ~data:new_channel with
| `Ok -> ()
| `Duplicate ->
let e =
match elem with
| Element e -> e
| Int_elem (_,e) -> e
in
failwith ("Duplicate definition of basis for "^(Element.to_long_string e))
end
end
end;
build_basis rest
in
String.split ~on:'|' b
|> List.rev_map ~f:String.strip
|> build_basis
in
let basis =
Input.AO_basis.read ()
in
()
let command =
Command.basic
~summary: "Quantum Package command"
~readme:(fun () -> "
=== Available basis sets ===
" ^ (list_basis ()) ^ "
============================
Extents the basis set to add an auxiliary basis set.
" )
spec
(fun o b ezfio_file () -> run ?o b ezfio_file )
let () =
Command.run command

2
ocaml/qp_basis_clean.ml
View File

@ -1,4 +1,4 @@
open Core.Std
open Core
let filenames =
let dir_name = Qpackage.root^"/data/basis/"

2
ocaml/qp_create_ezfio_from_xyz.ml
View File

@ -1,6 +1,6 @@
open Qputils
open Qptypes
open Core.Std
open Core
let spec =
let open Command.Spec in

2
ocaml/qp_create_guess.ml
View File

@ -1,6 +1,6 @@
open Qputils
open Qptypes
open Core.Std
open Core
let run ~multiplicity ezfio_file =
if (not (Sys.file_exists_exn ezfio_file)) then

2
ocaml/qp_print.ml
View File

@ -1,6 +1,6 @@
open Qputils;;
open Qptypes;;
open Core.Std;;
open Core;;
type input_action =
| Basis

2
ocaml/qp_print_basis.ml
View File

@ -1,4 +1,4 @@
open Core.Std
open Core
open Qptypes
let basis () =

4
ocaml/qp_run.ml
View File

@ -1,4 +1,4 @@
open Core.Std
open Core
open Qputils
(* Environment variables :
@ -132,7 +132,7 @@ let run slave exe ezfio_file =
Sys.remove qp_run_address_filename;
let duration = Time.diff (Time.now()) time_start
|> Core.Span.to_string in
|> Time.Span.to_string in
Printf.printf "Wall time : %s\n\n" duration;
if (exit_code <> 0) then
exit exit_code

2
ocaml/qp_set_mo_class.ml
View File

@ -1,6 +1,6 @@
open Qputils
open Qptypes
open Core.Std
open Core
(*
* Command-line arguments

20
ocaml/qptypes_generator.ml
View File

@ -1,4 +1,4 @@
open Core.Std;;
open Core;;
let input_data = "
* Positive_float : float
@ -160,14 +160,14 @@ let input_ezfio = "
let untouched = "
module MO_guess : sig
type t with sexp
type t [@@deriving sexp]
val to_string : t -> string
val of_string : string -> t
end = struct
type t =
| Huckel
| HCore
with sexp
[@@deriving sexp]
let to_string = function
| Huckel -> \"Huckel\"
@ -182,7 +182,7 @@ end = struct
end
module Disk_access : sig
type t with sexp
type t [@@deriving sexp]
val to_string : t -> string
val of_string : string -> t
end = struct
@ -190,7 +190,7 @@ end = struct
| Read
| Write
| None
with sexp
[@@deriving sexp]
let to_string = function
| Read -> \"Read\"
@ -210,12 +210,12 @@ end
let template = format_of_string "
module %s : sig
type t with sexp
type t [@@deriving sexp]
val to_%s : t -> %s
val of_%s : %s %s -> t
val to_string : t -> string
end = struct
type t = %s with sexp
type t = %s [@@deriving sexp]
let to_%s x = x
let of_%s %s x = ( %s x )
let to_string x = %s.to_string x
@ -225,7 +225,7 @@ end
;;
let parse_input input=
print_string "open Core.Std;;\nlet warning = print_string;;\n" ;
print_string "open Core;;\nlet warning = print_string;;\n" ;
let rec parse result = function
| [] -> result
| ( "" , "" )::tail -> parse result tail
@ -255,13 +255,13 @@ let parse_input input=
let ezfio_template = format_of_string "
module %s : sig
type t with sexp
type t [@@deriving sexp]
val to_%s : t -> %s
val get_max : unit -> %s
val of_%s : ?min:%s -> ?max:%s -> %s -> t
val to_string : t -> string
end = struct
type t = %s with sexp
type t = %s [@@deriving sexp]
let to_string x = %s.to_string x
let get_max () =
if (Ezfio.has_%s ()) then

2
ocaml/test_basis.ml
View File

@ -1,4 +1,4 @@
open Core.Std;;
open Core;;
open Qputils;;
open Qptypes;;

2
ocaml/test_gto.ml
View File

@ -1,4 +1,4 @@
open Core.Std
open Core
open Qptypes
let test_prim () =

2
ocaml/test_message.ml
View File

@ -1,4 +1,4 @@
open Core.Std
open Core
let () =
Message.of_string "new_job ao_integrals tcp://127.0.0.1 inproc://ao_ints:12345"

2
ocaml/test_molecule.ml
View File

@ -1,4 +1,4 @@
open Core.Std ;;
open Core ;;
open Qptypes ;;
let test_molecule () =

2
ocaml/test_pseudo.ml
View File

@ -1,4 +1,4 @@
open Core.Std
open Core
open Qputils
open Qptypes

2
ocaml/test_queuing_system.ml
View File

@ -1,4 +1,4 @@
open Core.Std
open Core
let () =

2
ocaml/test_symmetry.ml
View File

@ -1,4 +1,4 @@
open Core.Std
open Core
open Qputils
open Qptypes
open Symmetry