LCPQ/qp2
9
1
Fork 0
mirror of https://github.com/QuantumPackage/qp2.git synced 2024-12-21 19:13:29 +01:00
Code Releases Activity

Merge branch 'dev' into dev-lct

Browse Source
This commit is contained in:
Emmanuel Giner 2019-03-21 00:14:17 +01:00
commit 24acfa6938
47 changed files with 661 additions and 906 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

2
INSTALL.rst
View File

@ -291,7 +291,7 @@ OCaml
.. code:: bash .. code:: bash
opam install ocamlbuild cryptokit zmq core sexplib ppx_sexp_conv ppx_deriving getopt opam install ocamlbuild cryptokit zmq sexplib ppx_sexp_conv ppx_deriving getopt
EZFIO EZFIO

2
configure vendored
View File

@ -60,7 +60,7 @@ function execute () {
} }
PACKAGES="" PACKAGES=""
OCAML_PACKAGES="ocamlbuild cryptokit zmq core.v0.11.3 sexplib ppx_sexp_conv ppx_deriving getopt" OCAML_PACKAGES="ocamlbuild cryptokit zmq sexplib ppx_sexp_conv ppx_deriving getopt"
while true ; do while true ; do
case "$1" in case "$1" in

43
ocaml/.gitignore vendored
View File

@ -1,43 +0,0 @@
_build
element_create_db
element_create_db.byte
ezfio.ml
.gitignore
Git.ml
Input_ao_one_e_ints.ml
Input_ao_two_e_erf_ints.ml
Input_ao_two_e_ints.ml
Input_auto_generated.ml
Input_becke_numerical_grid.ml
Input_davidson.ml
Input_density_for_dft.ml
Input_determinants.ml
Input_dft_keywords.ml
Input_dft_mu_of_r.ml
Input_dressing.ml
Input_firth_order_der.ml
Input_ijkl_ints_in_r3.ml
Input_mo_one_e_ints.ml
Input_mo_two_e_erf_ints.ml
Input_mo_two_e_ints.ml
Input_mu_of_r_ints.ml
Input_mu_of_r.ml
Input_nuclei.ml
Input_perturbation.ml
Input_pseudo.ml
Input_rsdft_ecmd.ml
Input_scf_utils.ml
Input_two_body_dm.ml
qp_create_ezfio
qp_create_ezfio.native
qp_edit
qp_edit.ml
qp_edit.native
qp_print_basis
qp_print_basis.native
qp_run
qp_run.native
qp_set_mo_class
qp_set_mo_class.native
qptypes_generator.byte
Qptypes.ml

12
ocaml/Atom.ml
View File

@ -1,4 +1,4 @@
open Core open Sexplib.Std
exception AtomError of string exception AtomError of string
@ -11,20 +11,20 @@ type t =
(** Read xyz coordinates of the atom *) (** Read xyz coordinates of the atom *)
let of_string ~units s = let of_string ~units s =
let buffer = s let buffer = s
|> String.split ~on:' ' |> String_ext.split ~on:' '
|> List.filter ~f:(fun x -> x <> "") |> List.filter (fun x -> x <> "")
in in
match buffer with match buffer with
| [ name; charge; x; y; z ] -> | [ name; charge; x; y; z ] ->
{ element = Element.of_string name ; { element = Element.of_string name ;
charge = Charge.of_string charge ; charge = Charge.of_string charge ;
coord = Point3d.of_string ~units (String.concat [x; y; z] ~sep:" ") coord = Point3d.of_string ~units (String.concat " " [x; y; z] )
} }
| [ name; x; y; z ] -> | [ name; x; y; z ] ->
let e = Element.of_string name in let e = Element.of_string name in
{ element = e ; { element = e ;
charge = Element.to_charge e; charge = Element.to_charge e;
coord = Point3d.of_string ~units (String.concat [x; y; z] ~sep:" ") coord = Point3d.of_string ~units (String.concat " " [x; y; z])
} }
| _ -> raise (AtomError s) | _ -> raise (AtomError s)
@ -33,7 +33,7 @@ let to_string ~units a =
[ Element.to_string a.element ; [ Element.to_string a.element ;
Charge.to_string a.charge ; Charge.to_string a.charge ;
Point3d.to_string ~units a.coord ] Point3d.to_string ~units a.coord ]
|> String.concat ~sep:" " |> String.concat " "
let to_xyz a = let to_xyz a =

12
ocaml/Bit.ml
View File

@ -1,4 +1,4 @@
open Core;; open Sexplib.Std
(* (*
Type for bits Type for bits
@ -16,31 +16,31 @@ type t =
let to_string = function let to_string = function
| Zero -> "0" | Zero -> "0"
| One -> "1" | One -> "1"
;;
let and_operator a b = let and_operator a b =
match a, b with match a, b with
| Zero, _ -> Zero | Zero, _ -> Zero
| _, Zero -> Zero | _, Zero -> Zero
| _, _ -> One | _, _ -> One
;;
let or_operator a b = let or_operator a b =
match a, b with match a, b with
| One, _ -> One | One, _ -> One
| _, One -> One | _, One -> One
| _, _ -> Zero | _, _ -> Zero
;;
let xor_operator a b = let xor_operator a b =
match a, b with match a, b with
| One, Zero -> One | One, Zero -> One
| Zero, One -> One | Zero, One -> One
| _, _ -> Zero | _, _ -> Zero
;;
let not_operator = function let not_operator = function
| One -> Zero | One -> Zero
| Zero -> One | Zero -> One
;;

27
ocaml/Bitlist.ml
View File

@ -1,5 +1,4 @@
open Qptypes open Qptypes
open Core
(* (*
Type for bits strings Type for bits strings
@ -22,15 +21,15 @@ let to_string b =
let of_string ?(zero='0') ?(one='1') s = let of_string ?(zero='0') ?(one='1') s =
String.to_list s List.init (String.length s) (String.get s)
|> List.rev_map ~f:( fun c -> |> List.rev_map ( fun c ->
if (c = zero) then Bit.Zero if (c = zero) then Bit.Zero
else if (c = one) then Bit.One else if (c = one) then Bit.One
else (failwith ("Error in bitstring ") ) ) else (failwith ("Error in bitstring ") ) )
let of_string_mp s = let of_string_mp s =
String.to_list s List.init (String.length s) (String.get s)
|> List.rev_map ~f:(function |> List.rev_map (function
| '-' -> Bit.Zero | '-' -> Bit.Zero
| '+' -> Bit.One | '+' -> Bit.One
| _ -> failwith ("Error in bitstring ") ) | _ -> failwith ("Error in bitstring ") )
@ -44,7 +43,7 @@ let of_int64 i =
| 1L -> Bit.One :: accu |> List.rev | 1L -> Bit.One :: accu |> List.rev
| i -> | i ->
let b = let b =
match (Int64.bit_and i 1L ) with match (Int64.logand i 1L ) with
| 0L -> Bit.Zero | 0L -> Bit.Zero
| 1L -> Bit.One | 1L -> Bit.One
| _ -> raise (Failure "i land 1 not in (0,1)") | _ -> raise (Failure "i land 1 not in (0,1)")
@ -70,18 +69,18 @@ let to_int64 l =
let rec do_work accu = function let rec do_work accu = function
| [] -> accu | [] -> accu
| Bit.Zero::tail -> do_work Int64.(shift_left accu 1) tail | Bit.Zero::tail -> do_work Int64.(shift_left accu 1) tail
| Bit.One::tail -> do_work Int64.(bit_or one (shift_left accu 1)) tail | Bit.One::tail -> do_work Int64.(logor one (shift_left accu 1)) tail
in do_work Int64.zero (List.rev l) in do_work Int64.zero (List.rev l)
(* Create a bit list from a list of int64 *) (* Create a bit list from a list of int64 *)
let of_int64_list l = let of_int64_list l =
List.map ~f:of_int64 l List.map of_int64 l
|> List.concat |> List.concat
(* Create a bit list from an array of int64 *) (* Create a bit list from an array of int64 *)
let of_int64_array l = let of_int64_array l =
Array.map ~f:of_int64 l Array.map of_int64 l
|> Array.to_list |> Array.to_list
|> List.concat |> List.concat
@ -116,7 +115,7 @@ let to_int64_list l =
in in
let l = do_work [] [] 1 l let l = do_work [] [] 1 l
in in
List.rev_map ~f:to_int64 l List.rev_map to_int64 l
(* Create an array of int64 from a bit list *) (* Create an array of int64 from a bit list *)
let to_int64_array l = let to_int64_array l =
@ -127,8 +126,8 @@ let to_int64_array l =
let of_mo_number_list n_int l = let of_mo_number_list n_int l =
let n_int = N_int_number.to_int n_int in let n_int = N_int_number.to_int n_int in
let length = n_int*64 in let length = n_int*64 in
let a = Array.create length (Bit.Zero) in let a = Array.make length (Bit.Zero) in
List.iter ~f:(fun i-> a.((MO_number.to_int i)-1) <- Bit.One) l; List.iter (fun i-> a.((MO_number.to_int i)-1) <- Bit.One) l;
Array.to_list a Array.to_list a
@ -183,10 +182,10 @@ let not_operator b = logical_operator1 Bit.not_operator b
let popcnt b = let popcnt b =
List.fold_left b ~init:0 ~f:(fun accu -> function List.fold_left (fun accu -> function
| Bit.One -> accu+1 | Bit.One -> accu+1
| Bit.Zero -> accu | Bit.Zero -> accu
) ) 0 b

12
ocaml/Charge.ml
View File

@ -1,14 +1,14 @@
open Core open Sexplib.Std
type t = float [@@deriving sexp] type t = float [@@deriving sexp]
let of_float x = x let of_float x = x
let of_int i = Float.of_int i let of_int i = float_of_int i
let of_string s = Float.of_string s let of_string s = float_of_string s
let to_float x = x let to_float x = x
let to_int x = Float.to_int x let to_int x = int_of_float x
let to_string x = let to_string x =
if x >= 0. then if x >= 0. then
Printf.sprintf "+%f" x Printf.sprintf "+%f" x

4
ocaml/Element.ml
View File

@ -1,4 +1,4 @@
open Core open Sexplib.Std
open Qptypes open Qptypes
exception ElementError of string exception ElementError of string
@ -14,7 +14,7 @@ type t =
[@@deriving sexp] [@@deriving sexp]
let of_string x = let of_string x =
match (String.capitalize (String.lowercase x)) with match (String.capitalize_ascii (String.lowercase_ascii x)) with
| "X" | "Dummy" -> X | "X" | "Dummy" -> X
| "H" | "Hydrogen" -> H | "H" | "Hydrogen" -> H
| "He" | "Helium" -> He | "He" | "Helium" -> He

5
ocaml/Excitation.ml
View File

@ -1,4 +1,3 @@
open Core
open Qptypes open Qptypes
module Hole = struct module Hole = struct
@ -56,7 +55,7 @@ let to_string = function
"," ; "," ;
(MO_class.to_string (Particle.to_mo_class p)); (MO_class.to_string (Particle.to_mo_class p));
"]"] "]"]
|> String.concat ~sep:" " |> String.concat " "
| Double (h1,p1,h2,p2) -> | Double (h1,p1,h2,p2) ->
[ "Double Exc. : [" ; [ "Double Exc. : [" ;
(MO_class.to_string (Hole.to_mo_class h1)); (MO_class.to_string (Hole.to_mo_class h1));
@ -67,6 +66,6 @@ let to_string = function
"," ; "," ;
(MO_class.to_string (Particle.to_mo_class p2)); (MO_class.to_string (Particle.to_mo_class p2));
"]"] "]"]
|> String.concat ~sep:" " |> String.concat " "

9
ocaml/Gamess.ml
View File

@ -1,5 +1,6 @@
(** CONTRL *) (** CONTRL *)
type scftyp_t = RHF | ROHF | MCSCF | NONE type scftyp_t = RHF | ROHF | MCSCF | NONE
let string_of_scftyp = function let string_of_scftyp = function
| RHF -> "RHF" | RHF -> "RHF"
| ROHF -> "ROHF" | ROHF -> "ROHF"
@ -79,14 +80,14 @@ let read_until_found f tries =
begin begin
try try
Some (read_mos x f) Some (read_mos x f)
with Caml.Not_found -> with Not_found ->
None None
end end
) None tries ) None tries
in in
match result with match result with
| Some mos -> mos | Some mos -> mos
| None -> raise Caml.Not_found | None -> raise Not_found
let read_natural_mos f = let read_natural_mos f =
let tries = [ let tries = [
@ -116,7 +117,7 @@ type guess_t =
| Natural of (int*string) | Natural of (int*string)
let guess_of_string s = let guess_of_string s =
match String.lowercase s with match String.lowercase_ascii s with
| "huckel" -> Huckel | "huckel" -> Huckel
| "hcore" -> Hcore | "hcore" -> Hcore
| _ -> raise (Invalid_argument "Bad MO guess") | _ -> raise (Invalid_argument "Bad MO guess")
@ -430,7 +431,7 @@ let create_cas_input ?(vecfile="") ~guess ~nstate s n_e n_a =
in in
try try
string_of_guess (Natural (norb, vecfile)) string_of_guess (Natural (norb, vecfile))
with Caml.Not_found -> with Not_found ->
string_of_guess (Canonical (norb, vecfile)) string_of_guess (Canonical (norb, vecfile))
end end
; ;

12
ocaml/GaussianPrimitive.ml
View File

@ -1,16 +1,16 @@
open Qptypes open Qptypes
open Core open Sexplib.Std
type t = type t =
{ sym : Symmetry.t ; { sym : Symmetry.t ;
expo : AO_expo.t ; expo : AO_expo.t ;
} [@@deriving sexp] } [@@deriving sexp]
let to_string p = let to_string p =
let { sym = s ; expo = e } = p in let { sym = s ; expo = e } = p in
Printf.sprintf "(%s, %22e)" Printf.sprintf "(%s, %22e)"
(Symmetry.to_string s) (Symmetry.to_string s)
(AO_expo.to_float e) (AO_expo.to_float e)
let of_sym_expo s e = let of_sym_expo s e =

44
ocaml/Generic_input_of_rst.ml
View File

@ -1,5 +1,6 @@
open Core;; open Sexplib
open Qptypes;; open Sexplib.Std
open Qptypes
let fail_msg str (ex,range) = let fail_msg str (ex,range) =
@ -15,25 +16,25 @@ let fail_msg str (ex,range) =
let start_pos = range.start_pos.offset let start_pos = range.start_pos.offset
and end_pos = range.end_pos.offset and end_pos = range.end_pos.offset
in in
let pre = String.sub ~pos:0 ~len:start_pos str let pre = String.sub str 0 start_pos
and mid = String.sub ~pos:start_pos ~len:(end_pos-start_pos) str and mid = String.sub str start_pos (end_pos-start_pos)
and post = String.sub ~pos:(end_pos) and post = String.sub str (end_pos)
~len:((String.length str)-(end_pos)) str ((String.length str)-(end_pos))
in in
let str = Printf.sprintf "%s ## %s ## %s" pre mid post let str = Printf.sprintf "%s ## %s ## %s" pre mid post
in in
let str = String.tr str ~target:'(' ~replacement:' ' let str = String_ext.tr str ~target:'(' ~replacement:' '
|> String.split ~on:')' |> String_ext.split ~on:')'
|> List.map ~f:String.strip |> List.map String_ext.strip
|> List.filter ~f:(fun x -> |> List.filter (fun x ->
match String.substr_index x ~pos:0 ~pattern:"##" with match String_ext.substr_index ~pos:0 ~pattern:"##" x with
| None -> false | None -> false
| Some _ -> true | Some _ -> true
) )
|> String.concat ~sep:"\n" |> String.concat "\n"
in in
Printf.eprintf "Error: (%s)\n\n %s\n\n" msg str; Printf.eprintf "Error: (%s)\n\n %s\n\n" msg str
;;
let evaluate_sexp t_of_sexp s = let evaluate_sexp t_of_sexp s =
@ -41,20 +42,19 @@ let evaluate_sexp t_of_sexp s =
match ( Sexp.of_string_conv sexp t_of_sexp ) with match ( Sexp.of_string_conv sexp t_of_sexp ) with
| `Result r -> Some r | `Result r -> Some r
| `Error ex -> ( fail_msg sexp ex; None) | `Error ex -> ( fail_msg sexp ex; None)
;;
let of_rst t_of_sexp s = let of_rst t_of_sexp s =
Rst_string.to_string s Rst_string.to_string s
|> String.split ~on:'\n' |> String_ext.split ~on:'\n'
|> List.filter ~f:(fun line -> |> List.filter (fun line -> String.contains line '=')
String.contains line '=') |> List.map (fun line ->
|> List.map ~f:(fun line ->
"("^( "("^(
String.tr line ~target:'=' ~replacement:' ' String_ext.tr ~target:'=' ~replacement:' ' line
)^")" ) )^")" )
|> String.concat |> String.concat ""
|> evaluate_sexp t_of_sexp |> evaluate_sexp t_of_sexp
;;

1
ocaml/Input.ml
View File

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

132
ocaml/Input_ao_basis.ml
View File

@ -1,6 +1,6 @@
open Qptypes;; open Qptypes;;
open Qputils;; open Qputils;;
open Core;; open Sexplib.Std;;
module Ao_basis : sig module Ao_basis : sig
type t = type t =
@ -52,13 +52,13 @@ end = struct
let read_ao_prim_num () = let read_ao_prim_num () =
Ezfio.get_ao_basis_ao_prim_num () Ezfio.get_ao_basis_ao_prim_num ()
|> Ezfio.flattened_ezfio |> Ezfio.flattened_ezfio
|> Array.map ~f:AO_prim_number.of_int |> Array.map AO_prim_number.of_int
;; ;;
let read_ao_prim_num_max () = let read_ao_prim_num_max () =
Ezfio.get_ao_basis_ao_prim_num () Ezfio.get_ao_basis_ao_prim_num ()
|> Ezfio.flattened_ezfio |> Ezfio.flattened_ezfio
|> Array.fold ~f:(fun x y -> if x>y then x else y) ~init:0 |> Array.fold_left (fun x y -> if x>y then x else y) 0
|> AO_prim_number.of_int |> AO_prim_number.of_int
;; ;;
@ -66,42 +66,42 @@ end = struct
let nmax = Nucl_number.get_max () in let nmax = Nucl_number.get_max () in
Ezfio.get_ao_basis_ao_nucl () Ezfio.get_ao_basis_ao_nucl ()
|> Ezfio.flattened_ezfio |> Ezfio.flattened_ezfio
|> Array.map ~f:(fun x-> Nucl_number.of_int ~max:nmax x) |> Array.map (fun x-> Nucl_number.of_int ~max:nmax x)
;; ;;
let read_ao_power () = let read_ao_power () =
let x = Ezfio.get_ao_basis_ao_power () in let x = Ezfio.get_ao_basis_ao_power () in
let dim = x.Ezfio.dim.(0) in let dim = x.Ezfio.dim.(0) in
let data = Ezfio.flattened_ezfio x in let data = Ezfio.flattened_ezfio x in
let result = Array.init dim ~f:(fun x -> "") in let result = Array.init dim (fun x -> "") in
for i=1 to dim for i=1 to dim
do do
if (data.(i-1) > 0) then if (data.(i-1) > 0) then
result.(i-1) <- result.(i-1)^"x"^(Int.to_string data.(i-1)); result.(i-1) <- result.(i-1)^"x"^(string_of_int data.(i-1));
if (data.(dim+i-1) > 0) then if (data.(dim+i-1) > 0) then
result.(i-1) <- result.(i-1)^"y"^(Int.to_string data.(dim+i-1)); result.(i-1) <- result.(i-1)^"y"^(string_of_int data.(dim+i-1));
if (data.(2*dim+i-1) > 0) then if (data.(2*dim+i-1) > 0) then
result.(i-1) <- result.(i-1)^"z"^(Int.to_string data.(2*dim+i-1)); result.(i-1) <- result.(i-1)^"z"^(string_of_int data.(2*dim+i-1));
done; done;
Array.map ~f:Symmetry.Xyz.of_string result Array.map Symmetry.Xyz.of_string result
;; ;;
let read_ao_coef () = let read_ao_coef () =
Ezfio.get_ao_basis_ao_coef () Ezfio.get_ao_basis_ao_coef ()
|> Ezfio.flattened_ezfio |> Ezfio.flattened_ezfio
|> Array.map ~f:AO_coef.of_float |> Array.map AO_coef.of_float
;; ;;
let read_ao_expo () = let read_ao_expo () =
Ezfio.get_ao_basis_ao_expo () Ezfio.get_ao_basis_ao_expo ()
|> Ezfio.flattened_ezfio |> Ezfio.flattened_ezfio
|> Array.map ~f:AO_expo.of_float |> Array.map AO_expo.of_float
;; ;;
let read_ao_cartesian () = let read_ao_cartesian () =
if not (Ezfio.has_ao_basis_ao_cartesian ()) then if not (Ezfio.has_ao_basis_ao_cartesian ()) then
get_default "ao_cartesian" get_default "ao_cartesian"
|> Bool.of_string |> bool_of_string
|> Ezfio.set_ao_basis_ao_cartesian |> Ezfio.set_ao_basis_ao_cartesian
; ;
Ezfio.get_ao_basis_ao_cartesian () Ezfio.get_ao_basis_ao_cartesian ()
@ -110,10 +110,10 @@ end = struct
let to_long_basis b = let to_long_basis b =
let ao_num = AO_number.to_int b.ao_num in let ao_num = AO_number.to_int b.ao_num in
let gto_array = Array.init (AO_number.to_int b.ao_num) let gto_array = Array.init (AO_number.to_int b.ao_num)
~f:(fun i -> (fun i ->
let s = Symmetry.Xyz.to_symmetry b.ao_power.(i) in let s = Symmetry.Xyz.to_symmetry b.ao_power.(i) in
let ao_prim_num = AO_prim_number.to_int b.ao_prim_num.(i) in let ao_prim_num = AO_prim_number.to_int b.ao_prim_num.(i) in
let prims = List.init ao_prim_num ~f:(fun j -> let prims = List.init ao_prim_num (fun j ->
let prim = { GaussianPrimitive.sym = s ; let prim = { GaussianPrimitive.sym = s ;
GaussianPrimitive.expo = b.ao_expo.(ao_num*j+i) GaussianPrimitive.expo = b.ao_expo.(ao_num*j+i)
} }
@ -178,14 +178,14 @@ end = struct
in in
let ao_prim_num = let ao_prim_num =
Array.to_list ao_prim_num Array.to_list ao_prim_num
|> List.map ~f:AO_prim_number.to_int |> List.map AO_prim_number.to_int
in in
Ezfio.set_ao_basis_ao_prim_num (Ezfio.ezfio_array_of_list Ezfio.set_ao_basis_ao_prim_num (Ezfio.ezfio_array_of_list
~rank:1 ~dim:[| ao_num |] ~data:ao_prim_num) ; ~rank:1 ~dim:[| ao_num |] ~data:ao_prim_num) ;
let ao_nucl = let ao_nucl =
Array.to_list ao_nucl Array.to_list ao_nucl
|> List.map ~f:Nucl_number.to_int |> List.map Nucl_number.to_int
in in
Ezfio.set_ao_basis_ao_nucl(Ezfio.ezfio_array_of_list Ezfio.set_ao_basis_ao_nucl(Ezfio.ezfio_array_of_list
~rank:1 ~dim:[| ao_num |] ~data:ao_nucl) ; ~rank:1 ~dim:[| ao_num |] ~data:ao_nucl) ;
@ -193,9 +193,9 @@ end = struct
let ao_power = let ao_power =
let l = Array.to_list ao_power in let l = Array.to_list ao_power in
List.concat [ List.concat [
(List.map ~f:(fun a -> Positive_int.to_int a.Symmetry.Xyz.x) l) ; (List.map (fun a -> Positive_int.to_int a.Symmetry.Xyz.x) l) ;
(List.map ~f:(fun a -> Positive_int.to_int a.Symmetry.Xyz.y) l) ; (List.map (fun a -> Positive_int.to_int a.Symmetry.Xyz.y) l) ;
(List.map ~f:(fun a -> Positive_int.to_int a.Symmetry.Xyz.z) l) ] (List.map (fun a -> Positive_int.to_int a.Symmetry.Xyz.z) l) ]
in in
Ezfio.set_ao_basis_ao_power(Ezfio.ezfio_array_of_list Ezfio.set_ao_basis_ao_power(Ezfio.ezfio_array_of_list
~rank:2 ~dim:[| ao_num ; 3 |] ~data:ao_power) ; ~rank:2 ~dim:[| ao_num ; 3 |] ~data:ao_power) ;
@ -204,14 +204,14 @@ end = struct
let ao_coef = let ao_coef =
Array.to_list ao_coef Array.to_list ao_coef
|> List.map ~f:AO_coef.to_float |> List.map AO_coef.to_float
in in
Ezfio.set_ao_basis_ao_coef(Ezfio.ezfio_array_of_list Ezfio.set_ao_basis_ao_coef(Ezfio.ezfio_array_of_list
~rank:2 ~dim:[| ao_num ; ao_prim_num_max |] ~data:ao_coef) ; ~rank:2 ~dim:[| ao_num ; ao_prim_num_max |] ~data:ao_coef) ;
let ao_expo = let ao_expo =
Array.to_list ao_expo Array.to_list ao_expo
|> List.map ~f:AO_expo.to_float |> List.map AO_expo.to_float
in in
Ezfio.set_ao_basis_ao_expo(Ezfio.ezfio_array_of_list Ezfio.set_ao_basis_ao_expo(Ezfio.ezfio_array_of_list
~rank:2 ~dim:[| ao_num ; ao_prim_num_max |] ~data:ao_expo) ; ~rank:2 ~dim:[| ao_num ; ao_prim_num_max |] ~data:ao_expo) ;
@ -271,58 +271,56 @@ end = struct
| Some (s', g', n') -> | Some (s', g', n') ->
if s <> s' || n <> n' then find2 (s,g,n) a (i+1) if s <> s' || n <> n' then find2 (s,g,n) a (i+1)
else else
let lc = List.map ~f:(fun (prim, _) -> prim) g.Gto.lc let lc = List.map (fun (prim, _) -> prim) g.Gto.lc
and lc' = List.map ~f:(fun (prim, _) -> prim) g'.Gto.lc and lc' = List.map (fun (prim, _) -> prim) g'.Gto.lc
in in
if lc <> lc' then find2 (s,g,n) a (i+1) else (a.(i) <- None ; i) if lc <> lc' then find2 (s,g,n) a (i+1) else (a.(i) <- None ; i)
in in
find x a 0 find x a 0
in in
let search_array = Array.map ~f:(fun i -> Some i) unordered_basis in let search_array = Array.map (fun i -> Some i) unordered_basis in
Array.map ~f:(fun x -> find x search_array) ordered_basis Array.map (fun x -> find x search_array) ordered_basis
;; ;;
let of_long_basis long_basis name ao_cartesian = let of_long_basis long_basis name ao_cartesian =
let ao_num = List.length long_basis |> AO_number.of_int in let ao_num = List.length long_basis |> AO_number.of_int in
let ao_prim_num = let ao_prim_num =
List.map long_basis ~f:(fun (_,g,_) -> List.length g.Gto.lc List.map (fun (_,g,_) -> List.length g.Gto.lc
|> AO_prim_number.of_int ) |> AO_prim_number.of_int ) long_basis
|> Array.of_list |> Array.of_list
and ao_nucl = and ao_nucl =
List.map long_basis ~f:(fun (_,_,n) -> n) List.map (fun (_,_,n) -> n) long_basis
|> Array.of_list |> Array.of_list
and ao_power = and ao_power =
List.map ~f:(fun (x,_,_) -> x) long_basis List.map (fun (x,_,_) -> x) long_basis
|> Array.of_list |> Array.of_list
in in
let ao_prim_num_max = Array.fold ~init:0 ~f:(fun s x -> let ao_prim_num_max = Array.fold_left (fun s x ->
if AO_prim_number.to_int x > s then AO_prim_number.to_int x else s) if AO_prim_number.to_int x > s then AO_prim_number.to_int x else s) 0
ao_prim_num ao_prim_num
|> AO_prim_number.of_int |> AO_prim_number.of_int
in in
let gtos = let gtos =
List.map long_basis ~f:(fun (_,x,_) -> x) List.map (fun (_,x,_) -> x) long_basis
in in
let create_expo_coef ec = let create_expo_coef ec =
let coefs = let coefs =
begin match ec with begin match ec with
| `Coefs -> List.map gtos ~f:(fun x-> | `Coefs -> List.map (fun x->
List.map x.Gto.lc ~f:(fun (_,coef) -> AO_coef.to_float coef) ) List.map (fun (_,coef) -> AO_coef.to_float coef) x.Gto.lc ) gtos
| `Expos -> List.map gtos ~f:(fun x-> | `Expos -> List.map (fun x->
List.map x.Gto.lc ~f:(fun (prim,_) -> AO_expo.to_float List.map (fun (prim,_) -> AO_expo.to_float
prim.GaussianPrimitive.expo) ) prim.GaussianPrimitive.expo) x.Gto.lc ) gtos
end end
in in
let rec get_n n accu = function let rec get_n n accu = function
| [] -> List.rev accu | [] -> List.rev accu
| h::tail -> | h::tail ->
let y = let y =
begin match List.nth h n with try List.nth h n
| Some x -> x with _ -> 0.
| None -> 0.
end
in in
get_n n (y::accu) tail get_n n (y::accu) tail
in in
@ -335,10 +333,10 @@ end = struct
let ao_coef = create_expo_coef `Coefs let ao_coef = create_expo_coef `Coefs
|> Array.of_list |> Array.of_list
|> Array.map ~f:AO_coef.of_float |> Array.map AO_coef.of_float
and ao_expo = create_expo_coef `Expos and ao_expo = create_expo_coef `Expos
|> Array.of_list |> Array.of_list
|> Array.map ~f:AO_expo.of_float |> Array.map AO_expo.of_float
in in
{ ao_basis = name ; { ao_basis = name ;
ao_num ; ao_prim_num ; ao_prim_num_max ; ao_nucl ; ao_num ; ao_prim_num ; ao_prim_num_max ; ao_nucl ;
@ -347,17 +345,17 @@ end = struct
let reorder b = let reorder b =
let order = ordering b in let order = ordering b in
let f a = Array.init (Array.length a) ~f:(fun i -> a.(order.(i))) in let f a = Array.init (Array.length a) (fun i -> a.(order.(i))) in
let ao_prim_num_max = AO_prim_number.to_int b.ao_prim_num_max let ao_prim_num_max = AO_prim_number.to_int b.ao_prim_num_max
and ao_num = AO_number.to_int b.ao_num in and ao_num = AO_number.to_int b.ao_num in
let ao_coef = let ao_coef =
Array.init ao_prim_num_max ~f:(fun i -> Array.init ao_prim_num_max (fun i ->
f @@ Array.init ao_num ~f:(fun j -> b.ao_coef.(i*ao_num + j) ) f @@ Array.init ao_num (fun j -> b.ao_coef.(i*ao_num + j) )
) |> Array.to_list |> Array.concat ) |> Array.to_list |> Array.concat
in in
let ao_expo = let ao_expo =
Array.init ao_prim_num_max ~f:(fun i -> Array.init ao_prim_num_max (fun i ->
f @@ Array.init ao_num ~f:(fun j -> b.ao_expo.(i*ao_num + j) ) f @@ Array.init ao_num (fun j -> b.ao_expo.(i*ao_num + j) )
) |> Array.to_list |> Array.concat ) |> Array.to_list |> Array.concat
in in
{ b with { b with
@ -373,7 +371,7 @@ end = struct
let to_rst b = let to_rst b =
let print_sym = let print_sym =
let l = List.init (Array.length b.ao_power) ~f:( let l = List.init (Array.length b.ao_power) (
fun i -> ( (i+1),b.ao_nucl.(i),b.ao_power.(i) ) ) fun i -> ( (i+1),b.ao_nucl.(i),b.ao_power.(i) ) )
in in
let rec do_work = function let rec do_work = function
@ -383,7 +381,7 @@ end = struct
(Symmetry.Xyz.to_string x) (Symmetry.Xyz.to_string x)
)::(do_work tail) )::(do_work tail)
in do_work l in do_work l
|> String.concat |> String.concat ""
in in
let short_basis = to_basis b in let short_basis = to_basis b in
@ -408,11 +406,11 @@ Basis set (read-only) ::
======= ========= =========== ======= ========= ===========
" (AO_basis_name.to_string b.ao_basis) " (AO_basis_name.to_string b.ao_basis)
(Bool.to_string b.ao_cartesian) (string_of_bool b.ao_cartesian)
(Basis.to_string short_basis (Basis.to_string short_basis
|> String.split ~on:'\n' |> String_ext.split ~on:'\n'
|> List.map ~f:(fun x-> " "^x) |> List.map (fun x-> " "^x)
|> String.concat ~sep:"\n" |> String.concat "\n"
) print_sym ) print_sym
|> Rst_string.of_string |> Rst_string.of_string
@ -420,14 +418,14 @@ Basis set (read-only) ::
let read_rst s = let read_rst s =
let s = Rst_string.to_string s let s = Rst_string.to_string s
|> String.split ~on:'\n' |> String_ext.split ~on:'\n'
in in
let rec extract_basis = function let rec extract_basis = function
| [] -> failwith "Error in basis set" | [] -> failwith "Error in basis set"
| line :: tail -> | line :: tail ->
let line = String.strip line in let line = String.trim line in
if line = "Basis set (read-only) ::" then if line = "Basis set (read-only) ::" then
String.concat tail ~sep:"\n" String.concat "\n" tail
else else
extract_basis tail extract_basis tail
in in
@ -450,17 +448,17 @@ md5 = %s
(AO_basis_name.to_string b.ao_basis) (AO_basis_name.to_string b.ao_basis)
(AO_number.to_string b.ao_num) (AO_number.to_string b.ao_num)
(b.ao_prim_num |> Array.to_list |> List.map (b.ao_prim_num |> Array.to_list |> List.map
~f:(AO_prim_number.to_string) |> String.concat ~sep:", " ) (AO_prim_number.to_string) |> String.concat ", " )
(AO_prim_number.to_string b.ao_prim_num_max) (AO_prim_number.to_string b.ao_prim_num_max)
(b.ao_nucl |> Array.to_list |> List.map ~f:Nucl_number.to_string |> (b.ao_nucl |> Array.to_list |> List.map Nucl_number.to_string |>
String.concat ~sep:", ") String.concat ", ")
(b.ao_power |> Array.to_list |> List.map ~f:(fun x-> (b.ao_power |> Array.to_list |> List.map (fun x->
"("^(Symmetry.Xyz.to_string x)^")" )|> String.concat ~sep:", ") "("^(Symmetry.Xyz.to_string x)^")" )|> String.concat ", ")
(b.ao_coef |> Array.to_list |> List.map ~f:AO_coef.to_string (b.ao_coef |> Array.to_list |> List.map AO_coef.to_string
|> String.concat ~sep:", ") |> String.concat ", ")
(b.ao_expo |> Array.to_list |> List.map ~f:AO_expo.to_string (b.ao_expo |> Array.to_list |> List.map AO_expo.to_string
|> String.concat ~sep:", ") |> String.concat ", ")
(b.ao_cartesian |> Bool.to_string) (b.ao_cartesian |> string_of_bool)
(to_md5 b |> MD5.to_string ) (to_md5 b |> MD5.to_string )
;; ;;

228
ocaml/Input_bi_integrals.ml
View File

@ -1,228 +0,0 @@
open Qptypes;;
open Qputils;;
open Core;;
module Bielec_integrals : sig
type t =
{ read_ao_integrals : bool;
read_mo_integrals : bool;
write_ao_integrals : bool;
write_mo_integrals : bool;
threshold_ao : Threshold.t;
threshold_mo : Threshold.t;
direct : bool;
} [@@deriving sexp]
;;
val read : unit -> t option
val write : t -> unit
val to_string : t -> string
val to_rst : t -> Rst_string.t
val of_rst : Rst_string.t -> t option
end = struct
type t =
{ read_ao_integrals : bool;
read_mo_integrals : bool;
write_ao_integrals : bool;
write_mo_integrals : bool;
threshold_ao : Threshold.t;
threshold_mo : Threshold.t;
direct : bool;
} [@@deriving sexp]
;;
let get_default = Qpackage.get_ezfio_default "bielec_integrals";;
let read_read_ao_integrals () =
if not (Ezfio.has_bielec_integrals_read_ao_integrals ()) then
get_default "read_ao_integrals"
|> Bool.of_string
|> Ezfio.set_bielec_integrals_read_ao_integrals
;
Ezfio.get_bielec_integrals_read_ao_integrals ()
;;
let write_read_ao_integrals =
Ezfio.set_bielec_integrals_read_ao_integrals
;;
let read_read_mo_integrals () =
if not (Ezfio.has_bielec_integrals_read_mo_integrals ()) then
get_default "read_mo_integrals"
|> Bool.of_string
|> Ezfio.set_bielec_integrals_read_mo_integrals
;
Ezfio.get_bielec_integrals_read_mo_integrals ()
;;
let write_read_mo_integrals =
Ezfio.set_bielec_integrals_read_mo_integrals
;;
let read_write_ao_integrals () =
if not (Ezfio.has_bielec_integrals_write_ao_integrals ()) then
get_default "write_ao_integrals"
|> Bool.of_string
|> Ezfio.set_bielec_integrals_write_ao_integrals
;
Ezfio.get_bielec_integrals_write_ao_integrals ()
;;
let write_write_ao_integrals =
Ezfio.set_bielec_integrals_write_ao_integrals
;;
let read_write_mo_integrals () =
if not (Ezfio.has_bielec_integrals_write_mo_integrals ()) then
get_default "write_mo_integrals"
|> Bool.of_string
|> Ezfio.set_bielec_integrals_write_mo_integrals
;
Ezfio.get_bielec_integrals_write_mo_integrals ()
;;
let write_write_mo_integrals =
Ezfio.set_bielec_integrals_write_mo_integrals
;;
let read_direct () =
if not (Ezfio.has_bielec_integrals_direct ()) then
get_default "direct"
|> Bool.of_string
|> Ezfio.set_bielec_integrals_direct
;
Ezfio.get_bielec_integrals_direct ()
;;
let write_direct =
Ezfio.set_bielec_integrals_direct
;;
let read_threshold_ao () =
if not (Ezfio.has_bielec_integrals_threshold_ao ()) then
get_default "threshold_ao"
|> Float.of_string
|> Ezfio.set_bielec_integrals_threshold_ao
;
Ezfio.get_bielec_integrals_threshold_ao ()
|> Threshold.of_float
;;
let write_threshold_ao t =
Threshold.to_float t
|> Ezfio.set_bielec_integrals_threshold_ao
;;
let read_threshold_mo () =
if not (Ezfio.has_bielec_integrals_threshold_mo ()) then
get_default "threshold_mo"
|> Float.of_string
|> Ezfio.set_bielec_integrals_threshold_mo
;
Ezfio.get_bielec_integrals_threshold_mo ()
|> Threshold.of_float
;;
let write_threshold_mo t =
Threshold.to_float t
|> Ezfio.set_bielec_integrals_threshold_mo
;;
let read ()=
let result =
{ read_ao_integrals = read_read_ao_integrals();
read_mo_integrals = read_read_mo_integrals () ;
write_ao_integrals = read_write_ao_integrals ();
write_mo_integrals = read_write_mo_integrals ();
threshold_ao = read_threshold_ao ();
threshold_mo = read_threshold_mo ();
direct = read_direct () ;
} in
if (result.read_ao_integrals &&
result.write_ao_integrals) then
failwith "Read and Write AO integrals are both true.";
if (result.read_mo_integrals &&
result.write_mo_integrals) then
failwith "Read and Write MO integrals are both true.";
Some result
;;
let write b =
if (b.read_ao_integrals &&
b.write_ao_integrals) then
failwith "Read and Write AO integrals are both true.";
if (b.read_mo_integrals &&
b.write_mo_integrals) then
failwith "Read and Write MO integrals are both true.";
write_read_ao_integrals b.read_ao_integrals;
write_read_mo_integrals b.read_mo_integrals;
write_write_ao_integrals b.write_ao_integrals ;
write_write_mo_integrals b.write_mo_integrals ;
write_threshold_ao b.threshold_ao;
write_threshold_mo b.threshold_mo;
write_direct b.direct;
;;
let to_string b =
Printf.sprintf "
read_ao_integrals = %s
read_mo_integrals = %s
write_ao_integrals = %s
write_mo_integrals = %s
threshold_ao = %s
threshold_mo = %s
direct = %s
"
(Bool.to_string b.read_ao_integrals)
(Bool.to_string b.read_mo_integrals)
(Bool.to_string b.write_ao_integrals)
(Bool.to_string b.write_mo_integrals)
(Threshold.to_string b.threshold_ao)
(Threshold.to_string b.threshold_mo)
(Bool.to_string b.direct)
;;
let to_rst b =
Printf.sprintf "
Read AO/MO integrals from disk ::
read_ao_integrals = %s
read_mo_integrals = %s
Write AO/MO integrals to disk ::
write_ao_integrals = %s
write_mo_integrals = %s
Thresholds on integrals ::
threshold_ao = %s
threshold_mo = %s
Direct calculation of integrals ::
direct = %s
"
(Bool.to_string b.read_ao_integrals)
(Bool.to_string b.read_mo_integrals)
(Bool.to_string b.write_ao_integrals)
(Bool.to_string b.write_mo_integrals)
(Threshold.to_string b.threshold_ao)
(Threshold.to_string b.threshold_mo)
(Bool.to_string b.direct)
|> Rst_string.of_string
;;
include Generic_input_of_rst;;
let of_rst = of_rst t_of_sexp;;
end

20
ocaml/Input_bitmasks.ml
View File

@ -1,6 +1,6 @@
open Qptypes;; open Qptypes
open Qputils;; open Qputils
open Core;; open Sexplib.Std
module Bitmasks : sig module Bitmasks : sig
type t = type t =
@ -59,7 +59,7 @@ end = struct
let full_mask n_int = let full_mask n_int =
let range = "[1-"^ let range = "[1-"^
(Int.to_string (Ezfio.get_mo_basis_mo_num ()))^"]" (string_of_int (Ezfio.get_mo_basis_mo_num ()))^"]"
in in
MO_class.create_active range MO_class.create_active range
|> MO_class.to_bitlist n_int |> MO_class.to_bitlist n_int
@ -75,7 +75,7 @@ end = struct
full_mask n_int full_mask n_int
in in
let result = [ act ; act ; act ; act ; act ; act ] let result = [ act ; act ; act ; act ; act ; act ]
|> List.map ~f:(fun x -> |> List.map (fun x ->
let y = Bitlist.to_int64_list x in y@y ) let y = Bitlist.to_int64_list x in y@y )
|> List.concat |> List.concat
in in
@ -107,7 +107,7 @@ end = struct
full_mask n_int full_mask n_int
in in
let result = [ act ; act ] let result = [ act ; act ]
|> List.map ~f:(fun x -> |> List.map (fun x ->
let y = Bitlist.to_int64_list x in y@y ) let y = Bitlist.to_int64_list x in y@y )
|> List.concat |> List.concat
in in
@ -147,12 +147,12 @@ cas = %s
(Bit_kind.to_string b.bit_kind) (Bit_kind.to_string b.bit_kind)
(Bitmask_number.to_string b.n_mask_gen) (Bitmask_number.to_string b.n_mask_gen)
(Array.to_list b.generators (Array.to_list b.generators
|> List.map ~f:(fun x-> Int64.to_string x) |> List.map (fun x-> Int64.to_string x)
|> String.concat ~sep:", ") |> String.concat ", ")
(Bitmask_number.to_string b.n_mask_cas) (Bitmask_number.to_string b.n_mask_cas)
(Array.to_list b.cas (Array.to_list b.cas
|> List.map ~f:(fun x-> Int64.to_string x) |> List.map (fun x-> Int64.to_string x)
|> String.concat ~sep:", ") |> String.concat ", ")
end end

103
ocaml/Input_determinants_by_hand.ml
View File

@ -1,6 +1,6 @@
open Qptypes;; open Qptypes;;
open Qputils;; open Qputils;;
open Core;; open Sexplib.Std;;
module Determinants_by_hand : sig module Determinants_by_hand : sig
type t = type t =
@ -112,7 +112,7 @@ end = struct
begin begin
Ezfio.set_determinants_n_states n_states; Ezfio.set_determinants_n_states n_states;
let data = let data =
Array.create n_states 1. Array.make n_states 1.
|> Array.to_list |> Array.to_list
in in
Ezfio.ezfio_array_of_list ~rank:1 ~dim:[| n_states |] ~data Ezfio.ezfio_array_of_list ~rank:1 ~dim:[| n_states |] ~data
@ -126,7 +126,7 @@ end = struct
|> States_number.to_int |> States_number.to_int
in in
let data = let data =
Array.map ~f:Positive_float.to_float data Array.map Positive_float.to_float data
|> Array.to_list |> Array.to_list
in in
Ezfio.ezfio_array_of_list ~rank:1 ~dim:[| n_states |] ~data Ezfio.ezfio_array_of_list ~rank:1 ~dim:[| n_states |] ~data
@ -142,21 +142,21 @@ end = struct
begin begin
let data = let data =
Array.init n_states (fun _ -> 1./.(float_of_int n_states)) Array.init n_states (fun _ -> 1./.(float_of_int n_states))
|> Array.map ~f:Positive_float.of_float |> Array.map Positive_float.of_float
in in
write_state_average_weight data write_state_average_weight data
end; end;
let result = let result =
Ezfio.get_determinants_state_average_weight () Ezfio.get_determinants_state_average_weight ()
|> Ezfio.flattened_ezfio |> Ezfio.flattened_ezfio
|> Array.map ~f:Positive_float.of_float |> Array.map Positive_float.of_float
in in
if Array.length result = n_states then if Array.length result = n_states then
result result
else else
let data = let data =
Array.init n_states (fun _ -> 1./.(float_of_int n_states)) Array.init n_states (fun _ -> 1./.(float_of_int n_states))
|> Array.map ~f:Positive_float.of_float |> Array.map Positive_float.of_float
in in
(write_state_average_weight data; data) (write_state_average_weight data; data)
;; ;;
@ -189,18 +189,18 @@ end = struct
|> States_number.to_int |> States_number.to_int
in in
Ezfio.ezfio_array_of_list ~rank:2 ~dim:[| 1 ; n_states |] Ezfio.ezfio_array_of_list ~rank:2 ~dim:[| 1 ; n_states |]
~data:(List.init n_states ~f:(fun i -> if (i=0) then 1. else 0. )) ~data:(List.init n_states (fun i -> if (i=0) then 1. else 0. ))
|> Ezfio.set_determinants_psi_coef |> Ezfio.set_determinants_psi_coef
end; end;
Ezfio.get_determinants_psi_coef () Ezfio.get_determinants_psi_coef ()
|> Ezfio.flattened_ezfio |> Ezfio.flattened_ezfio
|> Array.map ~f:Det_coef.of_float |> Array.map Det_coef.of_float
;; ;;
let write_psi_coef ~n_det ~n_states c = let write_psi_coef ~n_det ~n_states c =
let n_det = Det_number.to_int n_det let n_det = Det_number.to_int n_det
and c = Array.to_list c and c = Array.to_list c
|> List.map ~f:Det_coef.to_float |> List.map Det_coef.to_float
and n_states = and n_states =
States_number.to_int n_states States_number.to_int n_states
in in
@ -242,9 +242,9 @@ end = struct
assert (n_int = dim.(0)); assert (n_int = dim.(0));
assert (dim.(1) = 2); assert (dim.(1) = 2);
assert (dim.(2) = (Det_number.to_int (read_n_det ()))); assert (dim.(2) = (Det_number.to_int (read_n_det ())));
List.init dim.(2) ~f:(fun i -> List.init dim.(2) (fun i ->
Array.sub ~pos:(2*n_int*i) ~len:(2*n_int) data) Array.sub data (2*n_int*i) (2*n_int) )
|> List.map ~f:(Determinant.of_int64_array |> List.map (Determinant.of_int64_array
~n_int:(N_int_number.of_int n_int) ~n_int:(N_int_number.of_int n_int)
~alpha:n_alpha ~beta:n_beta ) ~alpha:n_alpha ~beta:n_beta )
|> Array.of_list |> Array.of_list
@ -332,18 +332,19 @@ end = struct
else else
"0." "0."
) )
|> String.concat_array ~sep:"\t" |> Array.to_list |> String.concat "\t"
in in
Array.init ndet ~f:(fun i -> Array.init ndet (fun i ->
Printf.sprintf " %s\n%s\n" Printf.sprintf " %s\n%s\n"
(coefs_string i) (coefs_string i)
(Determinant.to_string ~mo_num:mo_num b.psi_det.(i) (Determinant.to_string ~mo_num:mo_num b.psi_det.(i)
|> String.split ~on:'\n' |> String_ext.split ~on:'\n'
|> List.map ~f:(fun x -> " "^x) |> List.map (fun x -> " "^x)
|> String.concat ~sep:"\n" |> String.concat "\n"
) )
) )
|> String.concat_array ~sep:"\n" |> Array.to_list
|> String.concat "\n"
in in
Printf.sprintf " Printf.sprintf "
Force the selected wave function to be an eigenfunction of S^2. Force the selected wave function to be an eigenfunction of S^2.
@ -365,7 +366,7 @@ Determinants ::
" "
(b.expected_s2 |> Positive_float.to_string) (b.expected_s2 |> Positive_float.to_string)
(b.n_det |> Det_number.to_string) (b.n_det |> Det_number.to_string)
(b.state_average_weight |> Array.to_list |> List.map ~f:Positive_float.to_string |> String.concat ~sep:"\t") (b.state_average_weight |> Array.to_list |> List.map Positive_float.to_string |> String.concat "\t")
det_text det_text
|> Rst_string.of_string |> Rst_string.of_string
;; ;;
@ -388,11 +389,11 @@ psi_det = %s
(b.n_det |> Det_number.to_string) (b.n_det |> Det_number.to_string)
(b.n_states |> States_number.to_string) (b.n_states |> States_number.to_string)
(b.expected_s2 |> Positive_float.to_string) (b.expected_s2 |> Positive_float.to_string)
(b.state_average_weight |> Array.to_list |> List.map ~f:Positive_float.to_string |> String.concat ~sep:",") (b.state_average_weight |> Array.to_list |> List.map Positive_float.to_string |> String.concat ",")
(b.psi_coef |> Array.to_list |> List.map ~f:Det_coef.to_string (b.psi_coef |> Array.to_list |> List.map Det_coef.to_string
|> String.concat ~sep:", ") |> String.concat ", ")
(b.psi_det |> Array.to_list |> List.map ~f:(Determinant.to_string (b.psi_det |> Array.to_list |> List.map (Determinant.to_string
~mo_num) |> String.concat ~sep:"\n\n") ~mo_num) |> String.concat "\n\n")
;; ;;
let of_rst r = let of_rst r =
@ -400,33 +401,36 @@ psi_det = %s
in in
(* Split into header and determinants data *) (* Split into header and determinants data *)
let idx = String.substr_index_exn r ~pos:0 ~pattern:"\nDeterminants" let idx =
match String_ext.substr_index r ~pos:0 ~pattern:"\nDeterminants" with
| Some x -> x
| None -> assert false
in in
let (header, dets) = let (header, dets) =
(String.prefix r idx, String.suffix r ((String.length r)-idx) ) (String.sub r 0 idx, String.sub r idx (String.length r - idx) )
in in
(* Handle header *) (* Handle header *)
let header = r let header = r
|> String.split ~on:'\n' |> String_ext.split ~on:'\n'
|> List.filter ~f:(fun line -> |> List.filter (fun line ->
if (line = "") then if (line = "") then
false false
else else
( (String.contains line '=') && (line.[0] = ' ') ) ( (String.contains line '=') && (line.[0] = ' ') )
) )
|> List.map ~f:(fun line -> |> List.map (fun line ->
"("^( "("^(
String.tr line ~target:'=' ~replacement:' ' String_ext.tr line ~target:'=' ~replacement:' '
|> String.strip |> String.trim
)^")" ) )^")" )
|> String.concat |> String.concat ""
in in
(* Handle determinant coefs *) (* Handle determinant coefs *)
let dets = match ( dets let dets = match ( dets
|> String.split ~on:'\n' |> String_ext.split ~on:'\n'
|> List.map ~f:(String.strip) |> List.map String.trim
) with ) with
| _::lines -> lines | _::lines -> lines
| _ -> failwith "Error in determinants" | _ -> failwith "Error in determinants"
@ -438,8 +442,8 @@ psi_det = %s
| ""::""::tail -> read_coefs accu tail | ""::""::tail -> read_coefs accu tail
| ""::c::tail -> | ""::c::tail ->
let c = let c =
String.split ~on:'\t' c String_ext.split ~on:'\t' c
|> List.map ~f:(fun x -> Det_coef.of_float (Float.of_string x)) |> List.map (fun x -> Det_coef.of_float (Float.of_string x))
|> Array.of_list |> Array.of_list
in in
read_coefs (c::accu) tail read_coefs (c::accu) tail
@ -450,15 +454,15 @@ psi_det = %s
read_coefs [] dets read_coefs [] dets
in in
let nstates = let nstates =
List.hd_exn buffer List.hd buffer
|> Array.length |> Array.length
in in
let extract_state i = let extract_state i =
let i = let i =
i-1 i-1
in in
List.map ~f:(fun x -> Det_coef.to_string x.(i)) buffer List.map (fun x -> Det_coef.to_string x.(i)) buffer
|> String.concat ~sep:" " |> String.concat " "
in in
let rec build_result = function let rec build_result = function
| 1 -> extract_state 1 | 1 -> extract_state 1
@ -492,21 +496,12 @@ psi_det = %s
| _::tail -> read_dets accu tail | _::tail -> read_dets accu tail
in in
let dets = let dets =
List.map ~f:String.rev dets List.map String_ext.rev dets
in in
let sze =
List.fold ~init:0 ~f:(fun accu x -> accu + (String.length x)) dets
in
let control =
Gc.get ()
in
Gc.tune ~minor_heap_size:(sze) ~space_overhead:(sze/10)
~max_overhead:100000 ~major_heap_increment:(sze/10) ();
let a = let a =
read_dets [] dets read_dets [] dets
|> String.concat |> String.concat ""
in in
Gc.set control;
"(psi_det ("^a^"))" "(psi_det ("^a^"))"
in in
@ -520,7 +515,7 @@ psi_det = %s
Printf.sprintf "(n_states %d)" (States_number.to_int @@ read_n_states ()) Printf.sprintf "(n_states %d)" (States_number.to_int @@ read_n_states ())
in in
let s = let s =
String.concat [ header ; bitkind ; n_int ; n_states ; psi_coef ; psi_det] String.concat "" [ header ; bitkind ; n_int ; n_states ; psi_coef ; psi_det]
in in
@ -603,16 +598,16 @@ psi_det = %s
States_number.to_int det.n_states States_number.to_int det.n_states
in in
Range.to_int_list range Range.to_int_list range
|> List.iter ~f:(fun istate -> |> List.iter (fun istate ->
if istate > n_states then if istate > n_states then
failwith "State to extract should not be greater than n_states") failwith "State to extract should not be greater than n_states")
; ;
let sorted_list = let sorted_list =
Range.to_int_list range Range.to_int_list range
|> List.sort ~compare |> List.sort compare
in in
let state_shift = ref 0 in let state_shift = ref 0 in
List.iter ~f:(fun istate -> List.iter (fun istate ->
let j = let j =
istate - 1 istate - 1
in in

6
ocaml/Input_electrons.ml
View File

@ -1,6 +1,6 @@
open Qptypes;; open Qptypes
open Qputils;; open Qputils
open Core;; open Sexplib.Std
module Electrons : sig module Electrons : sig
type t = type t =

55
ocaml/Input_mo_basis.ml
View File

@ -1,6 +1,6 @@
open Qptypes open Qptypes
open Qputils open Qputils
open Core open Sexplib.Std
module Mo_basis : sig module Mo_basis : sig
@ -38,9 +38,10 @@ end = struct
let reorder b ordering = let reorder b ordering =
{ b with mo_coef = { b with mo_coef =
Array.map ~f:(fun mo -> Array.map (fun mo ->
Array.init ~f:(fun i -> mo.(ordering.(i))) (Array.length mo) ) Array.init (Array.length mo)
b.mo_coef (fun i -> mo.(ordering.(i)))
) b.mo_coef
} }
let read_ao_md5 () = let read_ao_md5 () =
@ -73,7 +74,7 @@ end = struct
begin begin
let mo_num = MO_number.to_int (read_mo_num ()) in let mo_num = MO_number.to_int (read_mo_num ()) in
let data = let data =
Array.init mo_num ~f:(fun _ -> MO_class.(to_string (Active []))) Array.init mo_num (fun _ -> MO_class.(to_string (Active [])))
|> Array.to_list |> Array.to_list
in in
Ezfio.ezfio_array_of_list ~rank:1 Ezfio.ezfio_array_of_list ~rank:1
@ -81,7 +82,7 @@ end = struct
|> Ezfio.set_mo_basis_mo_class |> Ezfio.set_mo_basis_mo_class
end; end;
Ezfio.flattened_ezfio (Ezfio.get_mo_basis_mo_class () ) Ezfio.flattened_ezfio (Ezfio.get_mo_basis_mo_class () )
|> Array.map ~f:MO_class.of_string |> Array.map MO_class.of_string
let read_mo_occ () = let read_mo_occ () =
@ -90,7 +91,7 @@ end = struct
let elec_alpha_num = Ezfio.get_electrons_elec_alpha_num () let elec_alpha_num = Ezfio.get_electrons_elec_alpha_num ()
and elec_beta_num = Ezfio.get_electrons_elec_beta_num () and elec_beta_num = Ezfio.get_electrons_elec_beta_num ()
and mo_num = MO_number.to_int (read_mo_num ()) in and mo_num = MO_number.to_int (read_mo_num ()) in
let data = Array.init mo_num ~f:(fun i -> let data = Array.init mo_num (fun i ->
if (i<elec_beta_num) then 2. if (i<elec_beta_num) then 2.
else if (i < elec_alpha_num) then 1. else if (i < elec_alpha_num) then 1.
else 0.) |> Array.to_list in else 0.) |> Array.to_list in
@ -99,18 +100,18 @@ end = struct
|> Ezfio.set_mo_basis_mo_occ |> Ezfio.set_mo_basis_mo_occ
end; end;
Ezfio.flattened_ezfio (Ezfio.get_mo_basis_mo_occ () ) Ezfio.flattened_ezfio (Ezfio.get_mo_basis_mo_occ () )
|> Array.map ~f:MO_occ.of_float |> Array.map MO_occ.of_float
let read_mo_coef () = let read_mo_coef () =
let a = Ezfio.get_mo_basis_mo_coef () let a = Ezfio.get_mo_basis_mo_coef ()
|> Ezfio.flattened_ezfio |> Ezfio.flattened_ezfio
|> Array.map ~f:MO_coef.of_float |> Array.map MO_coef.of_float
in in
let mo_num = read_mo_num () |> MO_number.to_int in let mo_num = read_mo_num () |> MO_number.to_int in
let ao_num = (Array.length a)/mo_num in let ao_num = (Array.length a)/mo_num in
Array.init mo_num ~f:(fun j -> Array.init mo_num (fun j ->
Array.sub ~pos:(j*ao_num) ~len:(ao_num) a Array.sub a (j*ao_num) (ao_num)
) )
@ -136,14 +137,14 @@ end = struct
| 1 -> | 1 ->
let header = [ Printf.sprintf " #%15d" (imin+1) ; ] in let header = [ Printf.sprintf " #%15d" (imin+1) ; ] in
let new_lines = let new_lines =
List.init ao_num ~f:(fun i -> List.init ao_num (fun i ->
Printf.sprintf " %3d %15.10f " (i+1) Printf.sprintf " %3d %15.10f " (i+1)
(MO_coef.to_float mo_coef.(imin ).(i)) ) (MO_coef.to_float mo_coef.(imin ).(i)) )
in header @ new_lines in header @ new_lines
| 2 -> | 2 ->
let header = [ Printf.sprintf " #%15d %15d" (imin+1) (imin+2) ; ] in let header = [ Printf.sprintf " #%15d %15d" (imin+1) (imin+2) ; ] in
let new_lines = let new_lines =
List.init ao_num ~f:(fun i -> List.init ao_num (fun i ->
Printf.sprintf " %3d %15.10f %15.10f" (i+1) Printf.sprintf " %3d %15.10f %15.10f" (i+1)
(MO_coef.to_float mo_coef.(imin ).(i)) (MO_coef.to_float mo_coef.(imin ).(i))
(MO_coef.to_float mo_coef.(imin+1).(i)) ) (MO_coef.to_float mo_coef.(imin+1).(i)) )
@ -152,7 +153,7 @@ end = struct
let header = [ Printf.sprintf " #%15d %15d %15d" let header = [ Printf.sprintf " #%15d %15d %15d"
(imin+1) (imin+2) (imin+3); ] in (imin+1) (imin+2) (imin+3); ] in
let new_lines = let new_lines =
List.init ao_num ~f:(fun i -> List.init ao_num (fun i ->
Printf.sprintf " %3d %15.10f %15.10f %15.10f" (i+1) Printf.sprintf " %3d %15.10f %15.10f %15.10f" (i+1)
(MO_coef.to_float mo_coef.(imin ).(i)) (MO_coef.to_float mo_coef.(imin ).(i))
(MO_coef.to_float mo_coef.(imin+1).(i)) (MO_coef.to_float mo_coef.(imin+1).(i))
@ -162,7 +163,7 @@ end = struct
let header = [ Printf.sprintf " #%15d %15d %15d %15d" let header = [ Printf.sprintf " #%15d %15d %15d %15d"
(imin+1) (imin+2) (imin+3) (imin+4) ; ] in (imin+1) (imin+2) (imin+3) (imin+4) ; ] in
let new_lines = let new_lines =
List.init ao_num ~f:(fun i -> List.init ao_num (fun i ->
Printf.sprintf " %3d %15.10f %15.10f %15.10f %15.10f" (i+1) Printf.sprintf " %3d %15.10f %15.10f %15.10f %15.10f" (i+1)
(MO_coef.to_float mo_coef.(imin ).(i)) (MO_coef.to_float mo_coef.(imin ).(i))
(MO_coef.to_float mo_coef.(imin+1).(i)) (MO_coef.to_float mo_coef.(imin+1).(i))
@ -173,7 +174,7 @@ end = struct
let header = [ Printf.sprintf " #%15d %15d %15d %15d %15d" let header = [ Printf.sprintf " #%15d %15d %15d %15d %15d"
(imin+1) (imin+2) (imin+3) (imin+4) (imin+5) ; ] in (imin+1) (imin+2) (imin+3) (imin+4) (imin+5) ; ] in
let new_lines = let new_lines =
List.init ao_num ~f:(fun i -> List.init ao_num (fun i ->
Printf.sprintf " %3d %15.10f %15.10f %15.10f %15.10f %15.10f" (i+1) Printf.sprintf " %3d %15.10f %15.10f %15.10f %15.10f %15.10f" (i+1)
(MO_coef.to_float mo_coef.(imin ).(i)) (MO_coef.to_float mo_coef.(imin ).(i))
(MO_coef.to_float mo_coef.(imin+1).(i)) (MO_coef.to_float mo_coef.(imin+1).(i))
@ -185,11 +186,11 @@ end = struct
in in
let rec create_list accu i = let rec create_list accu i =
if (i+4 < mo_num) then if (i+4 < mo_num) then
create_list ( (print_five i (i+3) |> String.concat ~sep:"\n")::accu ) (i+4) create_list ( (print_five i (i+3) |> String.concat "\n")::accu ) (i+4)
else else
(print_five i (mo_num-1) |> String.concat ~sep:"\n")::accu |> List.rev (print_five i (mo_num-1) |> String.concat "\n")::accu |> List.rev
in in
create_list [] 0 |> String.concat ~sep:"\n\n" create_list [] 0 |> String.concat "\n\n"
let to_rst b = let to_rst b =
@ -224,13 +225,13 @@ mo_coef = %s
(MO_label.to_string b.mo_label) (MO_label.to_string b.mo_label)
(MO_number.to_string b.mo_num) (MO_number.to_string b.mo_num)
(b.mo_class |> Array.to_list |> List.map (b.mo_class |> Array.to_list |> List.map
~f:(MO_class.to_string) |> String.concat ~sep:", " ) (MO_class.to_string) |> String.concat ", " )
(b.mo_occ |> Array.to_list |> List.map (b.mo_occ |> Array.to_list |> List.map
~f:(MO_occ.to_string) |> String.concat ~sep:", " ) (MO_occ.to_string) |> String.concat ", " )
(b.mo_coef |> Array.map (b.mo_coef |> Array.map
~f:(fun x-> Array.map ~f:MO_coef.to_string x |> String.concat_array (fun x-> Array.map MO_coef.to_string x |>
~sep:"," ) |> Array.to_list |> String.concat "," ) |>
String.concat_array ~sep:"\n" ) Array.to_list |> String.concat "\n" )
let write_mo_num n = let write_mo_num n =
@ -245,7 +246,7 @@ mo_coef = %s
let write_mo_class a = let write_mo_class a =
let mo_num = Array.length a in let mo_num = Array.length a in
let data = Array.map ~f:MO_class.to_string a let data = Array.map MO_class.to_string a
|> Array.to_list |> Array.to_list
in Ezfio.ezfio_array_of_list ~rank:1 ~dim:[| mo_num |] ~data in Ezfio.ezfio_array_of_list ~rank:1 ~dim:[| mo_num |] ~data
|> Ezfio.set_mo_basis_mo_class |> Ezfio.set_mo_basis_mo_class
@ -253,7 +254,7 @@ mo_coef = %s
let write_mo_occ a = let write_mo_occ a =
let mo_num = Array.length a in let mo_num = Array.length a in
let data = Array.map ~f:MO_occ.to_float a let data = Array.map MO_occ.to_float a
|> Array.to_list |> Array.to_list
in Ezfio.ezfio_array_of_list ~rank:1 ~dim:[| mo_num |] ~data in Ezfio.ezfio_array_of_list ~rank:1 ~dim:[| mo_num |] ~data
|> Ezfio.set_mo_basis_mo_occ |> Ezfio.set_mo_basis_mo_occ
@ -268,7 +269,7 @@ mo_coef = %s
let mo_num = Array.length a in let mo_num = Array.length a in
let ao_num = Array.length a.(0) in let ao_num = Array.length a.(0) in
let data = let data =
Array.map ~f:(fun mo -> Array.map ~f:MO_coef.to_float mo Array.map (fun mo -> Array.map MO_coef.to_float mo
|> Array.to_list) a |> Array.to_list) a
|> Array.to_list |> Array.to_list
|> List.concat |> List.concat

55
ocaml/Input_nuclei_by_hand.ml
View File

@ -1,6 +1,6 @@
open Qptypes;; open Qptypes;;
open Qputils;; open Qputils;;
open Core;; open Sexplib.Std;;
module Nuclei_by_hand : sig module Nuclei_by_hand : sig
type t = type t =
@ -41,7 +41,7 @@ end = struct
let read_nucl_label () = let read_nucl_label () =
Ezfio.get_nuclei_nucl_label () Ezfio.get_nuclei_nucl_label ()
|> Ezfio.flattened_ezfio |> Ezfio.flattened_ezfio
|> Array.map ~f:Element.of_string |> Array.map Element.of_string
;; ;;
let write_nucl_label ~nucl_num labels = let write_nucl_label ~nucl_num labels =
@ -50,7 +50,7 @@ end = struct
in in
let labels = let labels =
Array.to_list labels Array.to_list labels
|> List.map ~f:Element.to_string |> List.map Element.to_string
in in
Ezfio.ezfio_array_of_list ~rank:1 Ezfio.ezfio_array_of_list ~rank:1
~dim:[| nucl_num |] ~data:labels ~dim:[| nucl_num |] ~data:labels
@ -61,7 +61,7 @@ end = struct
let read_nucl_charge () = let read_nucl_charge () =
Ezfio.get_nuclei_nucl_charge () Ezfio.get_nuclei_nucl_charge ()
|> Ezfio.flattened_ezfio |> Ezfio.flattened_ezfio
|> Array.map ~f:Charge.of_float |> Array.map Charge.of_float
;; ;;
let write_nucl_charge ~nucl_num charges = let write_nucl_charge ~nucl_num charges =
@ -70,7 +70,7 @@ end = struct
in in
let charges = let charges =
Array.to_list charges Array.to_list charges
|> List.map ~f:Charge.to_float |> List.map Charge.to_float
in in
Ezfio.ezfio_array_of_list ~rank:1 Ezfio.ezfio_array_of_list ~rank:1
~dim:[| nucl_num |] ~data:charges ~dim:[| nucl_num |] ~data:charges
@ -85,7 +85,7 @@ end = struct
|> Ezfio.flattened_ezfio |> Ezfio.flattened_ezfio
in in
let zero = Point3d.of_string Units.Bohr "0. 0. 0." in let zero = Point3d.of_string Units.Bohr "0. 0. 0." in
let result = Array.create nucl_num zero in let result = Array.make nucl_num zero in
for i=0 to (nucl_num-1) for i=0 to (nucl_num-1)
do do
result.(i) <- Point3d.({ x=raw_data.(i); result.(i) <- Point3d.({ x=raw_data.(i);
@ -101,9 +101,9 @@ end = struct
in in
let coord = Array.to_list coord in let coord = Array.to_list coord in
let coord = let coord =
(List.map ~f:(fun x-> x.Point3d.x) coord) @ (List.map (fun x-> x.Point3d.x) coord) @
(List.map ~f:(fun x-> x.Point3d.y) coord) @ (List.map (fun x-> x.Point3d.y) coord) @
(List.map ~f:(fun x-> x.Point3d.z) coord) (List.map (fun x-> x.Point3d.z) coord)
in in
Ezfio.ezfio_array_of_list ~rank:2 Ezfio.ezfio_array_of_list ~rank:2
~dim:[| nucl_num ; 3 |] ~data:coord ~dim:[| nucl_num ; 3 |] ~data:coord
@ -160,11 +160,11 @@ nucl_coord = %s
" "
(Nucl_number.to_string b.nucl_num) (Nucl_number.to_string b.nucl_num)
(b.nucl_label |> Array.to_list |> List.map (b.nucl_label |> Array.to_list |> List.map
~f:(Element.to_string) |> String.concat ~sep:", " ) (Element.to_string) |> String.concat ", " )
(b.nucl_charge |> Array.to_list |> List.map (b.nucl_charge |> Array.to_list |> List.map
~f:(Charge.to_string) |> String.concat ~sep:", " ) (Charge.to_string) |> String.concat ", " )
(b.nucl_coord |> Array.to_list |> List.map (b.nucl_coord |> Array.to_list |> List.map
~f:(Point3d.to_string ~units:Units.Bohr) |> String.concat ~sep:"\n" ) (Point3d.to_string ~units:Units.Bohr) |> String.concat "\n" )
;; ;;
@ -174,12 +174,12 @@ nucl_coord = %s
( Printf.sprintf " %d\n " ( Printf.sprintf " %d\n "
nucl_num nucl_num
) :: ( ) :: (
List.init nucl_num ~f:(fun i-> List.init nucl_num (fun i->
Printf.sprintf " %-3s %d %s" Printf.sprintf " %-3s %d %s"
(b.nucl_label.(i) |> Element.to_string) (b.nucl_label.(i) |> Element.to_string)
(b.nucl_charge.(i) |> Charge.to_int ) (b.nucl_charge.(i) |> Charge.to_int )
(b.nucl_coord.(i) |> Point3d.to_string ~units:Units.Angstrom) ) (b.nucl_coord.(i) |> Point3d.to_string ~units:Units.Angstrom) )
) |> String.concat ~sep:"\n" ) |> String.concat "\n"
in in
Printf.sprintf " Printf.sprintf "
Nuclear coordinates in xyz format (Angstroms) :: Nuclear coordinates in xyz format (Angstroms) ::
@ -192,16 +192,15 @@ Nuclear coordinates in xyz format (Angstroms) ::
let of_rst s = let of_rst s =
let l = Rst_string.to_string s let l = Rst_string.to_string s
|> String.split ~on:'\n' |> String_ext.split ~on:'\n'
in in
(* Find lines containing the xyz data *) (* Find lines containing the xyz data *)
let rec extract_begin = function let rec extract_begin = function
| [] -> raise Caml.Not_found | [] -> raise Not_found
| line::tail -> | line::tail ->
let line = String.strip line in let line = String.trim line in
if (String.length line > 3) && if (String.length line > 3) &&
(String.sub line ~pos:((String.length line)-2) (String.sub line ((String.length line)-2) 2 = "::") then
~len:2 = "::") then
tail tail
else else
extract_begin tail extract_begin tail
@ -213,12 +212,12 @@ Nuclear coordinates in xyz format (Angstroms) ::
| _ :: nucl_num :: title :: lines -> | _ :: nucl_num :: title :: lines ->
begin begin
let nucl_num = nucl_num let nucl_num = nucl_num
|> String.strip |> String.trim
|> Int.of_string |> int_of_string
|> Nucl_number.of_int ~max:nmax |> Nucl_number.of_int ~max:nmax
and lines = Array.of_list lines and lines = Array.of_list lines
in in
List.init (Nucl_number.to_int nucl_num) ~f:(fun i -> List.init (Nucl_number.to_int nucl_num) (fun i ->
Atom.of_string Units.Angstrom lines.(i)) Atom.of_string Units.Angstrom lines.(i))
end end
| _ -> failwith "Error in xyz format" | _ -> failwith "Error in xyz format"
@ -227,12 +226,12 @@ Nuclear coordinates in xyz format (Angstroms) ::
let result = let result =
{ nucl_num = List.length atom_list { nucl_num = List.length atom_list
|> Nucl_number.of_int ~max:nmax; |> Nucl_number.of_int ~max:nmax;
nucl_label = List.map atom_list ~f:(fun x -> nucl_label = List.map (fun x ->
x.Atom.element) |> Array.of_list ; x.Atom.element) atom_list |> Array.of_list ;
nucl_charge = List.map atom_list ~f:(fun x -> nucl_charge = List.map (fun x ->
x.Atom.charge ) |> Array.of_list ; x.Atom.charge ) atom_list |> Array.of_list ;
nucl_coord = List.map atom_list ~f:(fun x -> nucl_coord = List.map (fun x ->
x.Atom.coord ) |> Array.of_list ; x.Atom.coord ) atom_list |> Array.of_list ;
} }
in Some result in Some result
;; ;;

11
ocaml/MO_class.ml
View File

@ -1,5 +1,6 @@
open Core
open Qptypes open Qptypes
open Sexplib.Std
type t = type t =
| Core of MO_number.t list | Core of MO_number.t list
@ -12,8 +13,8 @@ type t =
let to_string x = let to_string x =
let print_list l = let print_list l =
let s = List.map ~f:(fun x-> MO_number.to_int x |> string_of_int )l let s = List.map (fun x-> MO_number.to_int x |> string_of_int ) l
|> (String.concat ~sep:", ") |> (String.concat ", ")
in in
"("^s^")" "("^s^")"
in in
@ -32,7 +33,7 @@ let to_string x =
let of_string s = let of_string s =
match (String.lowercase s) with match (String.lowercase_ascii s) with
| "core" -> Core [] | "core" -> Core []
| "inactive" -> Inactive [] | "inactive" -> Inactive []
| "active" -> Active [] | "active" -> Active []
@ -42,7 +43,7 @@ let of_string s =
let _mo_number_list_of_range range = let _mo_number_list_of_range range =
Range.of_string range |> List.map ~f:MO_number.of_int Range.of_string range |> List.map MO_number.of_int
let create_core range = Core (_mo_number_list_of_range range) let create_core range = Core (_mo_number_list_of_range range)

6
ocaml/MO_label.ml
View File

@ -1,4 +1,4 @@
open Core;; open Sexplib.Std
type t = type t =
| Guess | Guess
@ -8,7 +8,7 @@ type t =
| Orthonormalized | Orthonormalized
| None | None
[@@deriving sexp] [@@deriving sexp]
;;
let to_string = function let to_string = function
| Guess -> "Guess" | Guess -> "Guess"
@ -20,7 +20,7 @@ let to_string = function
;; ;;
let of_string s = let of_string s =
match String.lowercase (String.strip s) with match String.lowercase_ascii (String.trim s) with
| "guess" -> Guess | "guess" -> Guess
| "canonical" -> Canonical | "canonical" -> Canonical
| "natural" -> Natural | "natural" -> Natural

20
ocaml/Message.ml
View File

@ -1,4 +1,4 @@
open Core open Sexplib.Std
open Qptypes open Qptypes
(** New job : Request to create a new multi-tasked job *) (** New job : Request to create a new multi-tasked job *)
@ -161,7 +161,7 @@ end = struct
} }
let create ~state ~tasks = { state = State.of_string state ; tasks } let create ~state ~tasks = { state = State.of_string state ; tasks }
let to_string x = let to_string x =
Printf.sprintf "add_task %s %s" (State.to_string x.state) (String.concat ~sep:"|" x.tasks) Printf.sprintf "add_task %s %s" (State.to_string x.state) (String.concat "|" x.tasks)
end end
@ -193,12 +193,12 @@ end = struct
} }
let create ~state ~task_ids = let create ~state ~task_ids =
{ state = State.of_string state ; { state = State.of_string state ;
task_ids = List.map ~f:Id.Task.of_int task_ids task_ids = List.map Id.Task.of_int task_ids
} }
let to_string x = let to_string x =
Printf.sprintf "del_task %s %s" Printf.sprintf "del_task %s %s"
(State.to_string x.state) (State.to_string x.state)
(String.concat ~sep:"|" @@ List.map ~f:Id.Task.to_string x.task_ids) (String.concat "|" @@ List.map Id.Task.to_string x.task_ids)
end end
@ -219,7 +219,7 @@ end = struct
else "done" else "done"
in in
Printf.sprintf "del_task_reply %s %s" Printf.sprintf "del_task_reply %s %s"
more (String.concat ~sep:"|" @@ List.map ~f:Id.Task.to_string x.task_ids) more (String.concat "|" @@ List.map Id.Task.to_string x.task_ids)
end end
@ -303,11 +303,11 @@ end = struct
"get_tasks_reply ok" "get_tasks_reply ok"
let to_string_list x = let to_string_list x =
"get_tasks_reply ok" :: ( "get_tasks_reply ok" :: (
List.map x ~f:(fun (task_id, task) -> List.map (fun (task_id, task) ->
match task_id with match task_id with
| Some task_id -> Printf.sprintf "%d %s" (Id.Task.to_int task_id) task | Some task_id -> Printf.sprintf "%d %s" (Id.Task.to_int task_id) task
| None -> Printf.sprintf "0 terminate" | None -> Printf.sprintf "0 terminate"
) ) ) x )
end end
@ -408,14 +408,14 @@ end = struct
let create ~state ~client_id ~task_ids = let create ~state ~client_id ~task_ids =
{ client_id = Id.Client.of_int client_id ; { client_id = Id.Client.of_int client_id ;
state = State.of_string state ; state = State.of_string state ;
task_ids = List.map ~f:Id.Task.of_int task_ids; task_ids = List.map Id.Task.of_int task_ids;
} }
let to_string x = let to_string x =
Printf.sprintf "task_done %s %d %s" Printf.sprintf "task_done %s %d %s"
(State.to_string x.state) (State.to_string x.state)
(Id.Client.to_int x.client_id) (Id.Client.to_int x.client_id)
(String.concat ~sep:"|" @@ List.map ~f:Id.Task.to_string x.task_ids) (String.concat "|" @@ List.map Id.Task.to_string x.task_ids)
end end
(** Terminate *) (** Terminate *)
@ -460,7 +460,7 @@ end = struct
type t = string type t = string
let create x = x let create x = x
let to_string x = let to_string x =
String.concat ~sep:" " [ "error" ; x ] String.concat " " [ "error" ; x ]
end end

4
ocaml/Molecule.ml
View File

@ -62,7 +62,7 @@ let name m =
try try
let i = List.assoc e accu in let i = List.assoc e accu in
build_list ( (e,i+1)::(List.remove_assoc e accu) ) rest build_list ( (e,i+1)::(List.remove_assoc e accu) ) rest
with Caml.Not_found -> build_list ( (e,1)::accu ) rest with Not_found -> build_list ( (e,1)::accu ) rest
end end
| [] -> accu | [] -> accu
in in
@ -207,7 +207,7 @@ let distance_matrix molecule =
open Core ;;
include To_md5 include To_md5
let to_md5 = to_md5 sexp_of_t let to_md5 = to_md5 sexp_of_t

15
ocaml/Multiplicity.ml
View File

@ -1,10 +1,11 @@
open Core;; open Qptypes
open Qptypes ;; open Sexplib.Std
type t = Strictly_positive_int.t [@@deriving sexp] type t = Strictly_positive_int.t [@@deriving sexp]
let of_int = Strictly_positive_int.of_int ;; let of_int = Strictly_positive_int.of_int
let to_int = Strictly_positive_int.to_int ;;
let to_int = Strictly_positive_int.to_int
let to_string m = let to_string m =
match (to_int m) with match (to_int m) with
@ -18,7 +19,7 @@ let to_string m =
| 8 -> "Octet" | 8 -> "Octet"
| 9 -> "Nonet" | 9 -> "Nonet"
| i -> Printf.sprintf "%d-et" i | i -> Printf.sprintf "%d-et" i
;;
let of_alpha_beta a b = let of_alpha_beta a b =
let a = Elec_alpha_number.to_int a let a = Elec_alpha_number.to_int a
@ -26,11 +27,11 @@ let of_alpha_beta a b =
in in
assert (a >= b); assert (a >= b);
of_int (1 + a - b) of_int (1 + a - b)
;;
let to_alpha_beta ne m = let to_alpha_beta ne m =
let ne = Elec_number.to_int ne in let ne = Elec_number.to_int ne in
let nb = (ne-(to_int m)+1)/2 in let nb = (ne-(to_int m)+1)/2 in
let na = ne - nb in let na = ne - nb in
(Elec_alpha_number.of_int na, Elec_beta_number.of_int nb) (Elec_alpha_number.of_int na, Elec_beta_number.of_int nb)
;;

12
ocaml/Point3d.ml
View File

@ -1,5 +1,5 @@
open Core;; open Qptypes
open Qptypes;; open Sexplib.Std
type t = { type t = {
x : float ; x : float ;
@ -21,10 +21,10 @@ let of_string ~units s =
| Units.Angstrom -> Units.angstrom_to_bohr | Units.Angstrom -> Units.angstrom_to_bohr
in in
let l = s let l = s
|> String.split ~on:' ' |> String_ext.split ~on:' '
|> List.filter ~f:(fun x -> x <> "") |> List.filter (fun x -> x <> "")
|> List.map ~f:Float.of_string |> List.map float_of_string
|> Array.of_list |> Array.of_list
in in
{ x = l.(0) *. f ; { x = l.(0) *. f ;
y = l.(1) *. f ; y = l.(1) *. f ;

30
ocaml/Progress_bar.ml
View File

@ -1,5 +1,3 @@
open Core
type t = type t =
{ {
title: string; title: string;
@ -7,14 +5,14 @@ type t =
cur_value : float; cur_value : float;
end_value : float; end_value : float;
bar_length : int; bar_length : int;
init_time : Time.t; init_time : float;
dirty : bool; dirty : bool;
next : Time.t; next : float;
} }
let init ?(bar_length=20) ?(start_value=0.) ?(end_value=1.) ~title = let init ?(bar_length=20) ?(start_value=0.) ?(end_value=1.) ~title =
{ title ; start_value ; end_value ; bar_length ; cur_value=start_value ; { title ; start_value ; end_value ; bar_length ; cur_value=start_value ;
init_time= Time.now () ; dirty = false ; next = Time.now () } init_time= Unix.time () ; dirty = false ; next = Unix.time () }
let update ~cur_value bar = let update ~cur_value bar =
{ bar with cur_value ; dirty=true } { bar with cur_value ; dirty=true }
@ -40,23 +38,23 @@ let display_tty bar =
|> Float.to_int |> Float.to_int
in in
let hashes = let hashes =
String.init bar.bar_length ~f:(fun i -> String.init bar.bar_length (fun i ->
if (i < n_hashes) then '#' if (i < n_hashes) then '#'
else ' ' else ' '
) )
in in
let now = let now =
Time.now () Unix.time ()
in in
let running_time = let running_time =
Time.abs_diff now bar.init_time now -. bar.init_time
in in
Printf.eprintf "%s : [%s] %4.1f%% | %10s\r%!" Printf.eprintf "%s : [%s] %4.1f%% | %8.0f s\r%!"
bar.title bar.title
hashes hashes
percent percent
(Time.Span.to_string running_time); running_time;
{ bar with dirty = false ; next = Time.add now (Time.Span.of_sec 0.1) } { bar with dirty = false ; next = now +. 0.1 }
let display_file bar = let display_file bar =
@ -65,19 +63,19 @@ let display_file bar =
(bar.end_value -. bar.start_value) (bar.end_value -. bar.start_value)
in in
let running_time = let running_time =
Time.abs_diff (Time.now ()) bar.init_time (Unix.time ()) -. bar.init_time
in in
Printf.eprintf "%5.2f %% in %20s \n%!" Printf.eprintf "%5.2f %% in %20.0f seconds \n%!"
percent percent
(Time.Span.to_string running_time); running_time;
{ bar with dirty = false ; next = Time.add (Time.now ()) (Time.Span.of_sec 10.) } { bar with dirty = false ; next = (Unix.time ()) +. 10. }
let display bar = let display bar =
if (not bar.dirty) then if (not bar.dirty) then
bar bar
else if (Time.now () < bar.next) then else if (Unix.time () < bar.next) then
bar bar
else else
begin begin

69
ocaml/Pseudo.ml
View File

@ -1,4 +1,4 @@
open Core open Sexplib.Std
open Qptypes open Qptypes
@ -81,12 +81,12 @@ let to_string_local = function
| t -> | t ->
"Local component:" :: "Local component:" ::
( Printf.sprintf "%20s %8s %20s" "Coeff." "r^n" "Exp." ) :: ( Printf.sprintf "%20s %8s %20s" "Coeff." "r^n" "Exp." ) ::
( List.map t ~f:(fun (l,c) -> Printf.sprintf "%20f %8d %20f" ( List.map (fun (l,c) -> Printf.sprintf "%20f %8d %20f"
(AO_coef.to_float c) (AO_coef.to_float c)
(R_power.to_int l.GaussianPrimitive_local.r_power) (R_power.to_int l.GaussianPrimitive_local.r_power)
(AO_expo.to_float l.GaussianPrimitive_local.expo) (AO_expo.to_float l.GaussianPrimitive_local.expo)
) ) ) t )
|> String.concat ~sep:"\n" |> String.concat "\n"
(** Transform the non-local component of the pseudopotential to a string *) (** Transform the non-local component of the pseudopotential to a string *)
@ -95,7 +95,7 @@ let to_string_non_local = function
| t -> | t ->
"Non-local component:" :: "Non-local component:" ::
( Printf.sprintf "%20s %8s %20s %8s" "Coeff." "r^n" "Exp." "Proj") :: ( Printf.sprintf "%20s %8s %20s %8s" "Coeff." "r^n" "Exp." "Proj") ::
( List.map t ~f:(fun (l,c) -> ( List.map (fun (l,c) ->
let p = let p =
Positive_int.to_int l.GaussianPrimitive_non_local.proj Positive_int.to_int l.GaussianPrimitive_non_local.proj
in in
@ -104,8 +104,8 @@ let to_string_non_local = function
(R_power.to_int l.GaussianPrimitive_non_local.r_power) (R_power.to_int l.GaussianPrimitive_non_local.r_power)
(AO_expo.to_float l.GaussianPrimitive_non_local.expo) (AO_expo.to_float l.GaussianPrimitive_non_local.expo)
p p p p
) ) ) t )
|> String.concat ~sep:"\n" |> String.concat "\n"
(** Transform the Pseudopotential to a string *) (** Transform the Pseudopotential to a string *)
let to_string t = let to_string t =
@ -116,29 +116,30 @@ let to_string t =
:: to_string_local t.local :: to_string_local t.local
:: to_string_non_local t.non_local :: to_string_non_local t.non_local
:: [] :: []
|> List.filter ~f:(fun x -> x <> "") |> List.filter (fun x -> x <> "")
|> String.concat ~sep:"\n" |> String.concat "\n"
(** Find an element in the file *) (** Find an element in the file *)
let find in_channel element = let find in_channel element =
In_channel.seek in_channel 0L; seek_in in_channel 0;
let loop, element_read, old_pos = let loop, element_read, old_pos =
ref true, ref true,
ref None, ref None,
ref (In_channel.pos in_channel) ref (pos_in in_channel)
in in
while !loop while !loop
do do
try try
let buffer = let buffer =
old_pos := In_channel.pos in_channel; old_pos := pos_in in_channel;
match In_channel.input_line in_channel with try
| Some line -> String.split ~on:' ' line input_line in_channel
|> List.hd_exn |> String_ext.split ~on:' '
| None -> raise End_of_file |> List.hd
with _ -> raise End_of_file
in in
element_read := Some (Element.of_string buffer); element_read := Some (Element.of_string buffer);
loop := !element_read <> (Some element) loop := !element_read <> (Some element)
@ -146,7 +147,7 @@ let find in_channel element =
| Element.ElementError _ -> () | Element.ElementError _ -> ()
| End_of_file -> loop := false | End_of_file -> loop := false
done ; done ;
In_channel.seek in_channel !old_pos; seek_in in_channel !old_pos;
!element_read !element_read
@ -156,13 +157,13 @@ let read_element in_channel element =
| Some e when e = element -> | Some e when e = element ->
begin begin
let rec read result = let rec read result =
match In_channel.input_line in_channel with try
| None -> result let line = input_line in_channel in
| Some line -> if (String.trim line = "") then
if (String.strip line = "") then
result result
else else
read (line::result) read (line::result)
with _ -> result
in in
let data = let data =
@ -171,20 +172,20 @@ let read_element in_channel element =
in in
let debug_data = let debug_data =
String.concat ~sep:"\n" data String.concat "\n" data
in in
let decode_first_line = function let decode_first_line = function
| first_line :: rest -> | first_line :: rest ->
begin begin
let first_line_split = let first_line_split =
String.split first_line ~on:' ' String_ext.split first_line ~on:' '
|> List.filter ~f:(fun x -> (String.strip x) <> "") |> List.filter (fun x -> (String.trim x) <> "")
in in
match first_line_split with match first_line_split with
| e :: "GEN" :: n :: p -> | e :: "GEN" :: n :: p ->
{ element = Element.of_string e ; { element = Element.of_string e ;
n_elec = Int.of_string n |> Positive_int.of_int ; n_elec = int_of_string n |> Positive_int.of_int ;
local = [] ; local = [] ;
non_local = [] non_local = []
}, rest }, rest
@ -200,18 +201,18 @@ let read_element in_channel element =
| (n,line::rest) -> | (n,line::rest) ->
begin begin
match match
String.split line ~on:' ' String_ext.split line ~on:' '
|> List.filter ~f:(fun x -> String.strip x <> "") |> List.filter (fun x -> String.trim x <> "")
with with
| c :: i :: e :: [] -> | c :: i :: e :: [] ->
let i = let i =
Int.of_string i int_of_string i
in in
let elem = let elem =
( create_primitive ( create_primitive
(Float.of_string e |> AO_expo.of_float) (float_of_string e |> AO_expo.of_float)
(i-2 |> R_power.of_int), (i-2 |> R_power.of_int),
Float.of_string c |> AO_coef.of_float float_of_string c |> AO_coef.of_float
) )
in in
loop create_primitive (elem::accu) (n-1, rest) loop create_primitive (elem::accu) (n-1, rest)
@ -230,8 +231,8 @@ let read_element in_channel element =
match data with match data with
| n :: rest -> | n :: rest ->
let n = let n =
String.strip n String.trim n
|> Int.of_string |> int_of_string
|> Positive_int.of_int |> Positive_int.of_int
in in
decode_local_n n rest decode_local_n n rest
@ -250,8 +251,8 @@ let read_element in_channel element =
match data with match data with
| n :: rest -> | n :: rest ->
let n = let n =
String.strip n String.trim n
|> Int.of_string |> int_of_string
|> Positive_int.of_int |> Positive_int.of_int
in in
let result = let result =

108
ocaml/Qpackage.ml
View File

@ -1,45 +1,45 @@
open Core;; open Qptypes
open Qptypes;; open Qputils
open Qputils;;
(** Variables related to the quantum package installation *) (** Variables related to the quantum package installation *)
let root = let root =
match (Sys.getenv "QP_ROOT") with match (Sys.getenv_opt "QP_ROOT") with
| None -> failwith "QP_ROOT environment variable is not set. | None -> failwith "QP_ROOT environment variable is not set.
Please source the quantum_package.rc file." Please source the quantum_package.rc file."
| Some x -> x | Some x -> x
;;
let bit_kind_size = lazy ( let bit_kind_size = lazy (
let filename = root^"/src/bitmask/bitmasks_module.f90" in let filename = root^"/src/bitmask/bitmasks_module.f90" in
if not (Sys.file_exists_exn filename) then if not (Sys.file_exists filename) then
raise (Failure ("File "^filename^" not found")); raise (Failure ("File "^filename^" not found"));
let in_channel = In_channel.create filename in let in_channel = open_in filename in
let lines = In_channel.input_lines in_channel in let lines = input_lines in_channel in
In_channel.close in_channel; close_in in_channel;
let rec get_data = function let rec get_data = function
| [] -> raise (Failure ("bit_kind_size not found in "^filename)) | [] -> raise (Failure ("bit_kind_size not found in "^filename))
| line::tail -> | line::tail ->
let line = let line =
begin match String.split ~on:'!' line |> List.hd with try
| Some x -> x String_ext.split ~on:'!' line
| None -> "" |> List.hd
end in with _ -> line
begin match (String.rsplit2 ~on:':' line) with in
| Some (_ ,buffer) -> begin match (String_ext.rsplit2 ~on:':' line) with
begin match (String.split ~on:'=' buffer |> List.map ~f:String.strip) with | Some (_ ,buffer) ->
| ["bit_kind_size"; x] -> begin match (String_ext.split ~on:'=' buffer |> List.map String.trim) with
Int.of_string x |> Bit_kind_size.of_int | ["bit_kind_size"; x] ->
| _ -> get_data tail int_of_string x |> Bit_kind_size.of_int
end | _ -> get_data tail
| _ -> get_data tail end
end | _ -> get_data tail
end
in in
get_data lines ) get_data lines )
;;
let bit_kind = lazy ( let bit_kind = lazy (
Lazy.force bit_kind_size Lazy.force bit_kind_size
@ -47,23 +47,26 @@ let bit_kind = lazy (
|> fun x -> x / 8 |> fun x -> x / 8
|> Bit_kind.of_int |> Bit_kind.of_int
) )
;;
let executables = lazy ( let executables = lazy (
let filename = root^"/data/executables" let filename = root^"/data/executables" in
and func in_channel = let lines =
In_channel.input_lines in_channel let in_channel = open_in filename in
|> List.map ~f:(fun x -> let result = input_lines in_channel in
let e = String.split ~on:' ' x close_in in_channel;
|> List.filter ~f:(fun x -> x <> "") result
in
lines
|> List.map (fun x ->
let e = String_ext.split ~on:' ' x
|> List.filter (fun x -> x <> "")
in in
match e with match e with
| [a;b] -> (a,String.substr_replace_all ~pattern:"$QP_ROOT" ~with_:root b) | [a;b] -> (a,String_ext.substr_replace_all ~pattern:"$QP_ROOT" ~with_:root b)
| _ -> ("","") | _ -> ("","")
) )
in |> List.sort (fun (x,_) (y,_) ->
In_channel.with_file filename ~f:func
|> List.sort ~compare:(fun (x,_) (y,_) ->
if x < y then -1 if x < y then -1
else if x > y then 1 else if x > y then 1
else 0) else 0)
@ -72,33 +75,37 @@ let executables = lazy (
let get_ezfio_default_in_file ~directory ~data ~filename = let get_ezfio_default_in_file ~directory ~data ~filename =
let lines = In_channel.with_file filename ~f:(fun in_channel -> let lines =
In_channel.input_lines in_channel) in let in_channel = open_in filename in
let result = input_lines in_channel in
close_in in_channel;
result
in
let rec find_dir = function let rec find_dir = function
| line :: rest -> | line :: rest ->
if ((String.strip line) = directory) then if ((String.trim line) = directory) then
rest rest
else else
find_dir rest find_dir rest
| [] -> raise Caml.Not_found | [] -> raise Not_found
in in
let rec find_data = function let rec find_data = function
| line :: rest -> | line :: rest ->
if (line = "") then if (line = "") then
raise Caml.Not_found raise Not_found
else if (line.[0] <> ' ') then else if (line.[0] <> ' ') then
raise Caml.Not_found raise Not_found
else else
begin begin
match (String.lsplit2 ~on:' ' (String.strip line)) with match (String_ext.lsplit2 ~on:' ' (String.trim line)) with
| Some (l,r) -> | Some (l,r) ->
if (l = data) then if (l = data) then
String.strip r String.trim r
else else
find_data rest find_data rest
| None -> raise Caml.Not_found | None -> raise Not_found
end end
| [] -> raise Caml.Not_found | [] -> raise Not_found
in in
find_dir lines find_dir lines
|> find_data ; |> find_data ;
@ -111,7 +118,7 @@ let get_ezfio_default directory data =
| [] -> | [] ->
begin begin
Printf.printf "%s/%s not found\n%!" directory data; Printf.printf "%s/%s not found\n%!" directory data;
raise Caml.Not_found raise Not_found
end end
| filename :: tail -> | filename :: tail ->
let filename = let filename =
@ -120,7 +127,7 @@ let get_ezfio_default directory data =
try try
get_ezfio_default_in_file ~directory ~data ~filename get_ezfio_default_in_file ~directory ~data ~filename
with with
| Caml.Not_found -> aux tail | Not_found -> aux tail
in in
Sys.readdir dirname Sys.readdir dirname
|> Array.to_list |> Array.to_list
@ -131,10 +138,7 @@ let ezfio_work ezfio_file =
let result = let result =
Filename.concat ezfio_file "work" Filename.concat ezfio_file "work"
in in
begin if not (Sys.file_exists result) then
match Sys.is_directory result with ( Ezfio.set_file ezfio_file ; Ezfio.set_work_empty false);
| `Yes -> ()
| _ -> ( Ezfio.set_file ezfio_file ; Ezfio.set_work_empty false)
end;
result result
;; ;;

11
ocaml/Qputils.ml
View File

@ -42,3 +42,14 @@ let rmdir dirname =
let input_lines ic =
let n = in_channel_length ic in
let s = Bytes.create n in
really_input ic s 0 n;
close_in ic;
Bytes.to_string s
|> String_ext.split ~on:'\n'
let string_of_string s = s

4
ocaml/Queuing_system.ml
View File

@ -83,7 +83,7 @@ let pop_task ~client_id q =
} }
and found = and found =
try Some (TasksMap.find task_id q.tasks) try Some (TasksMap.find task_id q.tasks)
with Caml.Not_found -> None with Not_found -> None
in new_q, Some task_id, found in new_q, Some task_id, found
| [] -> q, None, None | [] -> q, None, None
@ -104,7 +104,7 @@ let end_task ~task_id ~client_id q =
let () = let () =
let client_id_check = let client_id_check =
try RunningMap.find task_id running with try RunningMap.find task_id running with
Caml.Not_found -> failwith "Task already finished" Not_found -> failwith "Task already finished"
in in
assert (client_id_check = client_id) assert (client_id_check = client_id)
in in

52
ocaml/String_ext.ml
View File

@ -3,27 +3,6 @@ include String
(** Split a string on a given character *) (** Split a string on a given character *)
let split ?(on=' ') str = let split ?(on=' ') str =
split_on_char on str split_on_char 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 *) (** Strip blanks on the left of a string *)
@ -101,7 +80,7 @@ let rsplit2_exn ?(on=' ') s =
else else
do_work (i-1) do_work (i-1)
in in
do_work length do_work (length-1)
let lsplit2 ?(on=' ') s = let lsplit2 ?(on=' ') s =
@ -123,6 +102,15 @@ let to_list s =
|> Array.to_list |> Array.to_list
let of_list l =
let a = Array.of_list l in
String.init (Array.length a) (fun i -> a.(i))
let rev s =
to_list s
|> List.rev
|> of_list
let fold ~init ~f s = let fold ~init ~f s =
to_list s to_list s
|> List.fold_left f init |> List.fold_left f init
@ -140,3 +128,23 @@ let is_prefix ~prefix s =
let of_char c = let of_char c =
String.make 1 c String.make 1 c
let tr ~target ~replacement s =
String.map (fun c -> if c = target then replacement else c) s
let substr_index ?(pos=0) ~pattern s =
try
let regexp =
Str.regexp pattern
in
Some (Str.search_forward regexp s pos)
with Not_found -> None
let substr_replace_all ~pattern ~with_ s =
let regexp =
Str.regexp pattern
in
Str.global_replace regexp with_ s

2
ocaml/TaskServer.ml
View File

@ -33,7 +33,7 @@ type t =
let debug_env = let debug_env =
try try
Sys.getenv "QP_TASK_DEBUG"; true Sys.getenv "QP_TASK_DEBUG" = "1"
with Not_found -> false with Not_found -> false

2
ocaml/_tags
View File

@ -1,4 +1,4 @@
true: package(core,cryptokit,zmq,str,ppx_sexp_conv,ppx_deriving,getopt) true: package(cryptokit,zmq,str,sexplib,ppx_sexp_conv,ppx_deriving,getopt)
true: thread true: thread
false: profile false: profile
<*byte> : linkdep(c_bindings.o), custom <*byte> : linkdep(c_bindings.o), custom

7
ocaml/create_git_sha1.sh
View File

@ -4,9 +4,8 @@ SHA1=$(git log -1 | head -1 | cut -d ' ' -f 2)
DATE=$(git log -1 | grep Date | cut -d ':' -f 2-) DATE=$(git log -1 | grep Date | cut -d ':' -f 2-)
MESSAGE=$(git log -1 | tail -1 | sed 's/"/\\"/g') MESSAGE=$(git log -1 | tail -1 | sed 's/"/\\"/g')
cat << EOF > Git.ml cat << EOF > Git.ml
open Core let sha1 = "$SHA1" |> String.trim
let sha1 = "$SHA1" |> String_ext.strip let date = "$DATE" |> String.trim
let date = "$DATE" |> String_ext.strip let message = "$MESSAGE" |> String.trim
let message = "$MESSAGE" |> String_ext.strip
EOF EOF

35
ocaml/element_create_db.ml
View File

@ -1,4 +1,3 @@
open Core
open Qptypes open Qptypes
open Element open Element
@ -6,22 +5,22 @@ let () =
let indices = let indices =
Array.init 78 (fun i -> i) Array.init 78 (fun i -> i)
in in
Out_channel.with_file (Qpackage.root ^ "/data/list_element.txt") let out_channel =
~f:(fun out_channel -> open_out (Qpackage.root ^ "/data/list_element.txt")
Array.init 110 ~f:(fun i -> in
let element = Array.init 110 (fun i ->
try let element =
Some (of_charge (Charge.of_int i)) try
with Some (of_charge (Charge.of_int i))
| _ -> None with
in | _ -> None
match element with in
| None -> "" match element with
| Some x -> Printf.sprintf "%3d %3s %s %f\n" | None -> ""
i (to_string x) (to_long_string x) (Positive_float.to_float @@ mass x ) | Some x -> Printf.sprintf "%3d %3s %s %f\n"
) i (to_string x) (to_long_string x) (Positive_float.to_float @@ mass x )
|> Array.to_list
|> String.concat ~sep:""
|> Out_channel.output_string out_channel
) )
|> Array.to_list
|> String.concat ""
|> Printf.fprintf out_channel "%s"

256
ocaml/qp_create_ezfio.ml
View File

@ -1,6 +1,6 @@
open Qputils open Qputils
open Qptypes open Qptypes
open Core open Sexplib.Std
type element = type element =
| Element of Element.t | Element of Element.t
@ -38,7 +38,7 @@ let dummy_centers ~threshold ~molecule ~nuclei =
| _ -> assert false | _ -> assert false
in in
aux [] (n-1,n-1) aux [] (n-1,n-1)
|> List.map ~f:(fun (i,x,j,y,r) -> |> List.map (fun (i,x,j,y,r) ->
let f = let f =
x /. (x +. y) x /. (x +. y)
in in
@ -58,22 +58,22 @@ let dummy_centers ~threshold ~molecule ~nuclei =
(** Returns the list of available basis sets *) (** Returns the list of available basis sets *)
let list_basis () = let list_basis () =
let basis_list = let basis_list =
let ic = Pervasives.open_in (Qpackage.root ^ "/data/basis/00_README.rst") in let ic = open_in (Qpackage.root ^ "/data/basis/00_README.rst") in
let n = Pervasives.in_channel_length ic in let n = in_channel_length ic in
let s = Bytes.create n in let s = Bytes.create n in
Pervasives.really_input ic s 0 n; really_input ic s 0 n;
Pervasives.close_in ic; close_in ic;
Bytes.to_string s Bytes.to_string s
|> String.split ~on:'\n' |> String_ext.split ~on:'\n'
|> List.filter ~f:(fun line -> String.length line > 1 && line.[0] <> '#') |> List.filter (fun line -> String.length line > 1 && line.[0] <> '#')
|> List.map ~f:(fun line -> |> List.map (fun line ->
match String.split ~on:'\'' line with match String_ext.split ~on:'\'' line with
| file :: name :: descr :: _ -> | file :: name :: descr :: _ ->
Printf.sprintf "%s\n %s\n %s\n\n" file name (String.strip descr) Printf.sprintf "%s\n %s\n %s\n\n" file name (String.trim descr)
| _ -> assert false | _ -> assert false
) )
in in
List.sort basis_list ~compare:String.ascending List.sort compare basis_list
(** Run the program *) (** Run the program *)
@ -101,7 +101,7 @@ let run ?o b au c d m p cart xyz_file =
**********) **********)
let basis_table = let basis_table =
Hashtbl.Poly.create () Hashtbl.create 63
in in
(* Open basis set channels *) (* Open basis set channels *)
@ -111,10 +111,7 @@ let run ?o b au c d m p cart xyz_file =
| Element e -> Element.to_string e | Element e -> Element.to_string e
| Int_elem (i,e) -> Printf.sprintf "%d,%s" (Nucl_number.to_int i) (Element.to_string e) | Int_elem (i,e) -> Printf.sprintf "%d,%s" (Nucl_number.to_int i) (Element.to_string e)
in in
match Hashtbl.find basis_table key with Hashtbl.find basis_table key
| Some in_channel ->
in_channel
| None -> raise Caml.Not_found
in in
let temp_filename = let temp_filename =
@ -129,11 +126,11 @@ let run ?o b au c d m p cart xyz_file =
Qpackage.root ^ "/data/basis/" ^ basis Qpackage.root ^ "/data/basis/" ^ basis
in in
match match
Sys.is_file basis, Sys.file_exists basis,
Sys.is_file long_basis Sys.file_exists long_basis
with with
| `Yes, _ -> In_channel.create basis | true , _ -> open_in basis
| `No , `Yes -> In_channel.create long_basis | false, true -> open_in long_basis
| _ -> failwith ("Basis "^basis^" not found") | _ -> failwith ("Basis "^basis^" not found")
in in
@ -141,7 +138,7 @@ let run ?o b au c d m p cart xyz_file =
| [] -> () | [] -> ()
| elem_and_basis_name :: rest -> | elem_and_basis_name :: rest ->
begin begin
match (String.lsplit2 ~on:':' elem_and_basis_name) with match (String_ext.lsplit2 ~on:':' elem_and_basis_name) with
| None -> (* Principal basis *) | None -> (* Principal basis *)
begin begin
let basis = let basis =
@ -150,14 +147,12 @@ let run ?o b au c d m p cart xyz_file =
let new_channel = let new_channel =
fetch_channel basis fetch_channel basis
in in
List.iter nuclei ~f:(fun elem-> List.iter (fun elem->
let key = let key =
Element.to_string elem.Atom.element Element.to_string elem.Atom.element
in in
match Hashtbl.add basis_table ~key:key ~data:new_channel with Hashtbl.add basis_table key new_channel
| `Ok -> () ) nuclei
| `Duplicate -> ()
)
end end
| Some (key, basis) -> (*Aux basis *) | Some (key, basis) -> (*Aux basis *)
begin begin
@ -166,12 +161,12 @@ let run ?o b au c d m p cart xyz_file =
Element (Element.of_string key) Element (Element.of_string key)
with Element.ElementError _ -> with Element.ElementError _ ->
let result = let result =
match (String.split ~on:',' key) with match (String_ext.split ~on:',' key) with
| i :: k :: [] -> (Nucl_number.of_int @@ int_of_string i, Element.of_string k) | i :: k :: [] -> (Nucl_number.of_int @@ int_of_string i, Element.of_string k)
| _ -> failwith "Expected format is int,Element:basis" | _ -> failwith "Expected format is int,Element:basis"
in Int_elem result in Int_elem result
and basis = and basis =
String.lowercase basis String.lowercase_ascii basis
in in
let key = let key =
match elem with match elem with
@ -181,23 +176,13 @@ let run ?o b au c d m p cart xyz_file =
let new_channel = let new_channel =
fetch_channel basis fetch_channel basis
in in
begin Hashtbl.add basis_table key new_channel
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
end; end;
build_basis rest build_basis rest
in in
String.split ~on:'|' b String_ext.split ~on:'|' b
|> List.rev_map ~f:String.strip |> List.rev_map String.trim
|> build_basis; |> build_basis;
@ -207,7 +192,7 @@ let run ?o b au c d m p cart xyz_file =
***************) ***************)
let pseudo_table = let pseudo_table =
Hashtbl.Poly.create () Hashtbl.create 63
in in
(* Open pseudo channels *) (* Open pseudo channels *)
@ -215,7 +200,7 @@ let run ?o b au c d m p cart xyz_file =
let key = let key =
Element.to_string element Element.to_string element
in in
Hashtbl.find pseudo_table key Hashtbl.find_opt pseudo_table key
in in
let temp_filename = let temp_filename =
Filename.temp_file "qp_create_" ".pseudo" Filename.temp_file "qp_create_" ".pseudo"
@ -229,11 +214,11 @@ let run ?o b au c d m p cart xyz_file =
Qpackage.root ^ "/data/pseudo/" ^ pseudo Qpackage.root ^ "/data/pseudo/" ^ pseudo
in in
match match
Sys.is_file pseudo, Sys.file_exists pseudo,
Sys.is_file long_pseudo Sys.file_exists long_pseudo
with with
| `Yes, _ -> In_channel.create pseudo | true , _ -> open_in pseudo
| `No , `Yes -> In_channel.create long_pseudo | false, true-> open_in long_pseudo
| _ -> failwith ("Pseudo file "^pseudo^" not found.") | _ -> failwith ("Pseudo file "^pseudo^" not found.")
in in
@ -241,7 +226,7 @@ let run ?o b au c d m p cart xyz_file =
| [] -> () | [] -> ()
| elem_and_pseudo_name :: rest -> | elem_and_pseudo_name :: rest ->
begin begin
match (String.lsplit2 ~on:':' elem_and_pseudo_name) with match (String_ext.lsplit2 ~on:':' elem_and_pseudo_name) with
| None -> (* Principal pseudo *) | None -> (* Principal pseudo *)
begin begin
let pseudo = let pseudo =
@ -250,21 +235,19 @@ let run ?o b au c d m p cart xyz_file =
let new_channel = let new_channel =
fetch_channel pseudo fetch_channel pseudo
in in
List.iter nuclei ~f:(fun elem-> List.iter (fun elem->
let key = let key =
Element.to_string elem.Atom.element Element.to_string elem.Atom.element
in in
match Hashtbl.add pseudo_table ~key:key ~data:new_channel with Hashtbl.add pseudo_table key new_channel
| `Ok -> () ) nuclei
| `Duplicate -> ()
)
end end
| Some (key, pseudo) -> (*Aux pseudo *) | Some (key, pseudo) -> (*Aux pseudo *)
begin begin
let elem = let elem =
Element.of_string key Element.of_string key
and pseudo = and pseudo =
String.lowercase pseudo String.lowercase_ascii pseudo
in in
let key = let key =
Element.to_string elem Element.to_string elem
@ -272,11 +255,7 @@ let run ?o b au c d m p cart xyz_file =
let new_channel = let new_channel =
fetch_channel pseudo fetch_channel pseudo
in in
begin Hashtbl.add pseudo_table key new_channel
match Hashtbl.add pseudo_table ~key:key ~data:new_channel with
| `Ok -> ()
| `Duplicate -> failwith ("Duplicate definition of pseudo for "^(Element.to_long_string elem))
end
end end
end; end;
build_pseudo rest build_pseudo rest
@ -285,8 +264,8 @@ let run ?o b au c d m p cart xyz_file =
match p with match p with
| None -> () | None -> ()
| Some p -> | Some p ->
String.split ~on:'|' p String_ext.split ~on:'|' p
|> List.rev_map ~f:String.strip |> List.rev_map String.trim
|> build_pseudo |> build_pseudo
in in
@ -296,13 +275,13 @@ let run ?o b au c d m p cart xyz_file =
| Some x -> x | Some x -> x
| None -> | None ->
begin begin
match String.rsplit2 ~on:'.' xyz_file with match String_ext.rsplit2 ~on:'.' xyz_file with
| Some (x,"xyz") | Some (x,"xyz")
| Some (x,"zmt") -> x^".ezfio" | Some (x,"zmt") -> x^".ezfio"
| _ -> xyz_file^".ezfio" | _ -> xyz_file^".ezfio"
end end
in in
if Sys.file_exists_exn ezfio_file then if Sys.file_exists ezfio_file then
failwith (ezfio_file^" already exists"); failwith (ezfio_file^" already exists");
let write_file () = let write_file () =
@ -311,17 +290,17 @@ let run ?o b au c d m p cart xyz_file =
(* Write Pseudo *) (* Write Pseudo *)
let pseudo = let pseudo =
List.map nuclei ~f:(fun x -> List.map (fun x ->
match pseudo_channel x.Atom.element with match pseudo_channel x.Atom.element with
| Some channel -> Pseudo.read_element channel x.Atom.element | Some channel -> Pseudo.read_element channel x.Atom.element
| None -> Pseudo.empty x.Atom.element | None -> Pseudo.empty x.Atom.element
) ) nuclei
in in
let molecule = let molecule =
let n_elec_to_remove = let n_elec_to_remove =
List.fold pseudo ~init:0 ~f:(fun accu x -> List.fold_left (fun accu x ->
accu + (Positive_int.to_int x.Pseudo.n_elec)) accu + (Positive_int.to_int x.Pseudo.n_elec)) 0 pseudo
in in
{ Molecule.elec_alpha = { Molecule.elec_alpha =
(Elec_alpha_number.to_int molecule.Molecule.elec_alpha) (Elec_alpha_number.to_int molecule.Molecule.elec_alpha)
@ -333,14 +312,14 @@ let run ?o b au c d m p cart xyz_file =
|> Elec_beta_number.of_int; |> Elec_beta_number.of_int;
Molecule.nuclei = Molecule.nuclei =
let charges = let charges =
List.map pseudo ~f:(fun x -> Positive_int.to_int x.Pseudo.n_elec List.map (fun x -> Positive_int.to_int x.Pseudo.n_elec
|> Float.of_int) |> Float.of_int) pseudo
|> Array.of_list |> Array.of_list
in in
List.mapi molecule.Molecule.nuclei ~f:(fun i x -> List.mapi (fun i x ->
{ x with Atom.charge = (Charge.to_float x.Atom.charge) -. charges.(i) { x with Atom.charge = (Charge.to_float x.Atom.charge) -. charges.(i)
|> Charge.of_float } |> Charge.of_float }
) ) molecule.Molecule.nuclei
} }
in in
let nuclei = let nuclei =
@ -356,13 +335,13 @@ let run ?o b au c d m p cart xyz_file =
(* Write Nuclei *) (* Write Nuclei *)
let labels = let labels =
List.map ~f:(fun x->Element.to_string x.Atom.element) nuclei List.map (fun x->Element.to_string x.Atom.element) nuclei
and charges = and charges =
List.map ~f:(fun x-> Atom.(Charge.to_float x.charge)) nuclei List.map (fun x-> Atom.(Charge.to_float x.charge)) nuclei
and coords = and coords =
(List.map ~f:(fun x-> x.Atom.coord.Point3d.x) nuclei) @ (List.map (fun x-> x.Atom.coord.Point3d.x) nuclei) @
(List.map ~f:(fun x-> x.Atom.coord.Point3d.y) nuclei) @ (List.map (fun x-> x.Atom.coord.Point3d.y) nuclei) @
(List.map ~f:(fun x-> x.Atom.coord.Point3d.z) nuclei) in (List.map (fun x-> x.Atom.coord.Point3d.z) nuclei) in
let nucl_num = (List.length labels) in let nucl_num = (List.length labels) in
Ezfio.set_nuclei_nucl_num nucl_num ; Ezfio.set_nuclei_nucl_num nucl_num ;
Ezfio.set_nuclei_nucl_label (Ezfio.ezfio_array_of_list Ezfio.set_nuclei_nucl_label (Ezfio.ezfio_array_of_list
@ -381,40 +360,41 @@ let run ?o b au c d m p cart xyz_file =
in in
let klocmax = let klocmax =
List.fold pseudo ~init:0 ~f:(fun accu x -> List.fold_left (fun accu x ->
let x = let x =
List.length x.Pseudo.local List.length x.Pseudo.local
in in
if (x > accu) then x if (x > accu) then x
else accu else accu
) ) 0 pseudo
and lmax = and lmax =
List.fold pseudo ~init:0 ~f:(fun accu x -> List.fold_left (fun accu x ->
let x = let x =
List.fold x.Pseudo.non_local ~init:0 ~f:(fun accu (x,_) -> List.fold_left (fun accu (x,_) ->
let x = let x =
Positive_int.to_int x.Pseudo.GaussianPrimitive_non_local.proj Positive_int.to_int x.Pseudo.GaussianPrimitive_non_local.proj
in in
if (x > accu) then x if (x > accu) then x
else accu else accu
) ) 0 x.Pseudo.non_local
in in
if (x > accu) then x if (x > accu) then x
else accu else accu
) ) 0 pseudo
in in
let kmax = let kmax =
Array.init (lmax+1) ~f:(fun i-> Array.init (lmax+1) (fun i->
List.map pseudo ~f:(fun x -> List.map (fun x ->
List.filter x.Pseudo.non_local ~f:(fun (y,_) -> List.filter (fun (y,_) ->
(Positive_int.to_int y.Pseudo.GaussianPrimitive_non_local.proj) = i) (Positive_int.to_int y.Pseudo.GaussianPrimitive_non_local.proj) = i)
|> List.length ) x.Pseudo.non_local
|> List.fold ~init:0 ~f:(fun accu x -> |> List.length ) pseudo
if accu > x then accu else x) |> List.fold_left (fun accu x ->
) if accu > x then accu else x) 0
|> Array.fold ~init:0 ~f:(fun accu i -> )
if i > accu then i else accu) |> Array.fold_left (fun accu i ->
if i > accu then i else accu) 0
in in
@ -423,12 +403,12 @@ let run ?o b au c d m p cart xyz_file =
Ezfio.set_pseudo_pseudo_kmax kmax; Ezfio.set_pseudo_pseudo_kmax kmax;
Ezfio.set_pseudo_pseudo_lmax lmax; Ezfio.set_pseudo_pseudo_lmax lmax;
let tmp_array_v_k, tmp_array_dz_k, tmp_array_n_k = let tmp_array_v_k, tmp_array_dz_k, tmp_array_n_k =
Array.make_matrix ~dimx:klocmax ~dimy:nucl_num 0. , Array.make_matrix klocmax nucl_num 0. ,
Array.make_matrix ~dimx:klocmax ~dimy:nucl_num 0. , Array.make_matrix klocmax nucl_num 0. ,
Array.make_matrix ~dimx:klocmax ~dimy:nucl_num 0 Array.make_matrix klocmax nucl_num 0
in in
List.iteri pseudo ~f:(fun j x -> List.iteri (fun j x ->
List.iteri x.Pseudo.local ~f:(fun i (y,c) -> List.iteri (fun i (y,c) ->
tmp_array_v_k.(i).(j) <- AO_coef.to_float c; tmp_array_v_k.(i).(j) <- AO_coef.to_float c;
let y, z = let y, z =
AO_expo.to_float y.Pseudo.GaussianPrimitive_local.expo, AO_expo.to_float y.Pseudo.GaussianPrimitive_local.expo,
@ -436,11 +416,11 @@ let run ?o b au c d m p cart xyz_file =
in in
tmp_array_dz_k.(i).(j) <- y; tmp_array_dz_k.(i).(j) <- y;
tmp_array_n_k.(i).(j) <- z; tmp_array_n_k.(i).(j) <- z;
) ) x.Pseudo.local
); ) pseudo ;
let concat_2d tmp_array = let concat_2d tmp_array =
let data = let data =
Array.map tmp_array ~f:Array.to_list Array.map Array.to_list tmp_array
|> Array.to_list |> Array.to_list
|> List.concat |> List.concat
in in
@ -454,18 +434,18 @@ let run ?o b au c d m p cart xyz_file =
|> Ezfio.set_pseudo_pseudo_n_k; |> Ezfio.set_pseudo_pseudo_n_k;
let tmp_array_v_kl, tmp_array_dz_kl, tmp_array_n_kl = let tmp_array_v_kl, tmp_array_dz_kl, tmp_array_n_kl =
Array.init (lmax+1) ~f:(fun _ -> Array.init (lmax+1) (fun _ ->
(Array.make_matrix ~dimx:kmax ~dimy:nucl_num 0. )), (Array.make_matrix kmax nucl_num 0. )),
Array.init (lmax+1) ~f:(fun _ -> Array.init (lmax+1) (fun _ ->
(Array.make_matrix ~dimx:kmax ~dimy:nucl_num 0. )), (Array.make_matrix kmax nucl_num 0. )),
Array.init (lmax+1) ~f:(fun _ -> Array.init (lmax+1) (fun _ ->
(Array.make_matrix ~dimx:kmax ~dimy:nucl_num 0 )) (Array.make_matrix kmax nucl_num 0 ))
in in
List.iteri pseudo ~f:(fun j x -> List.iteri (fun j x ->
let last_idx = let last_idx =
Array.create ~len:(lmax+1) 0 Array.make (lmax+1) 0
in in
List.iter x.Pseudo.non_local ~f:(fun (y,c) -> List.iter (fun (y,c) ->
let k, y, z = let k, y, z =
Positive_int.to_int y.Pseudo.GaussianPrimitive_non_local.proj, Positive_int.to_int y.Pseudo.GaussianPrimitive_non_local.proj,
AO_expo.to_float y.Pseudo.GaussianPrimitive_non_local.expo, AO_expo.to_float y.Pseudo.GaussianPrimitive_non_local.expo,
@ -478,14 +458,14 @@ let run ?o b au c d m p cart xyz_file =
tmp_array_dz_kl.(k).(i).(j) <- y; tmp_array_dz_kl.(k).(i).(j) <- y;
tmp_array_n_kl.(k).(i).(j) <- z; tmp_array_n_kl.(k).(i).(j) <- z;
last_idx.(k) <- i+1; last_idx.(k) <- i+1;
) ) x.Pseudo.non_local
); ) pseudo ;
let concat_3d tmp_array = let concat_3d tmp_array =
let data = let data =
Array.map tmp_array ~f:(fun x -> Array.map (fun x ->
Array.map x ~f:Array.to_list Array.map Array.to_list x
|> Array.to_list |> Array.to_list
|> List.concat) |> List.concat) tmp_array
|> Array.to_list |> Array.to_list
|> List.concat |> List.concat
in in
@ -518,7 +498,7 @@ let run ?o b au c d m p cart xyz_file =
in in
let result = do_work [] 1 nuclei let result = do_work [] 1 nuclei
|> List.rev |> List.rev
|> List.map ~f:(fun (x,i) -> |> List.map (fun (x,i) ->
try try
let e = let e =
match x.Atom.element with match x.Atom.element with
@ -530,13 +510,13 @@ let run ?o b au c d m p cart xyz_file =
in in
try try
Basis.read_element (basis_channel key) i e Basis.read_element (basis_channel key) i e
with Caml.Not_found -> with Not_found ->
let key = let key =
Element x.Atom.element Element x.Atom.element
in in
try try
Basis.read_element (basis_channel key) i e Basis.read_element (basis_channel key) i e
with Caml.Not_found -> with Not_found ->
failwith (Printf.sprintf "Basis not found for atom %d (%s)" (Nucl_number.to_int i) failwith (Printf.sprintf "Basis not found for atom %d (%s)" (Nucl_number.to_int i)
(Element.to_string x.Atom.element) ) (Element.to_string x.Atom.element) )
with with
@ -552,37 +532,38 @@ let run ?o b au c d m p cart xyz_file =
let ao_num = List.length long_basis in let ao_num = List.length long_basis in
Ezfio.set_ao_basis_ao_num ao_num; Ezfio.set_ao_basis_ao_num ao_num;
Ezfio.set_ao_basis_ao_basis b; Ezfio.set_ao_basis_ao_basis b;
let ao_prim_num = List.map long_basis ~f:(fun (_,g,_) -> List.length g.Gto.lc) let ao_prim_num = List.map (fun (_,g,_) -> List.length g.Gto.lc) long_basis
and ao_nucl = List.map long_basis ~f:(fun (_,_,n) -> Nucl_number.to_int n) and ao_nucl = List.map (fun (_,_,n) -> Nucl_number.to_int n) long_basis
and ao_power= and ao_power=
let l = List.map long_basis ~f:(fun (x,_,_) -> x) in let l = List.map (fun (x,_,_) -> x) long_basis in
(List.map l ~f:(fun t -> Positive_int.to_int Symmetry.Xyz.(t.x)) )@ (List.map (fun t -> Positive_int.to_int Symmetry.Xyz.(t.x)) l)@
(List.map l ~f:(fun t -> Positive_int.to_int Symmetry.Xyz.(t.y)) )@ (List.map (fun t -> Positive_int.to_int Symmetry.Xyz.(t.y)) l)@
(List.map l ~f:(fun t -> Positive_int.to_int Symmetry.Xyz.(t.z)) ) (List.map (fun t -> Positive_int.to_int Symmetry.Xyz.(t.z)) l)
in in
let ao_prim_num_max = List.fold ~init:0 ~f:(fun s x -> let ao_prim_num_max = List.fold_left (fun s x ->
if x > s then x if x > s then x
else s) ao_prim_num else s) 0 ao_prim_num
in in
let gtos = let gtos =
List.map long_basis ~f:(fun (_,x,_) -> x) List.map (fun (_,x,_) -> x) long_basis
in in
let create_expo_coef ec = let create_expo_coef ec =
let coefs = let coefs =
begin match ec with begin match ec with
| `Coefs -> List.map gtos ~f:(fun x-> | `Coefs -> List.map (fun x->
List.map x.Gto.lc ~f:(fun (_,coef) -> AO_coef.to_float coef) ) List.map (fun (_,coef) ->
| `Expos -> List.map gtos ~f:(fun x-> AO_coef.to_float coef) x.Gto.lc) gtos
List.map x.Gto.lc ~f:(fun (prim,_) -> AO_expo.to_float | `Expos -> List.map (fun x->
prim.GaussianPrimitive.expo) ) List.map (fun (prim,_) -> AO_expo.to_float
prim.GaussianPrimitive.expo) x.Gto.lc) gtos
end end
in in
let rec get_n n accu = function let rec get_n n accu = function
| [] -> List.rev accu | [] -> List.rev accu
| h::tail -> | h::tail ->
let y = let y =
begin match List.nth h n with begin match List.nth_opt h n with
| Some x -> x | Some x -> x
| None -> 0. | None -> 0.
end end
@ -621,9 +602,10 @@ let run ?o b au c d m p cart xyz_file =
| ex -> | ex ->
begin begin
begin begin
match Sys.is_directory ezfio_file with try
| `Yes -> rmdir ezfio_file if Sys.is_directory ezfio_file then
| _ -> () rmdir ezfio_file
with _ -> ()
end; end;
raise ex; raise ex;
end end
@ -730,7 +712,7 @@ If a file with the same name as the basis set exists, this file will be read. O
if basis = "show" then if basis = "show" then
begin begin
list_basis () list_basis ()
|> List.iter ~f:print_endline; |> List.iter print_endline;
exit 0 exit 0
end; end;

37
ocaml/qp_run.ml
View File

@ -46,7 +46,7 @@ let run slave ?prefix exe ezfio_file =
in in
let time_start = let time_start =
Core.Time.now () Unix.time ()
in in
if (not (Sys.file_exists ezfio_file)) then if (not (Sys.file_exists ezfio_file)) then
@ -65,7 +65,15 @@ let run slave ?prefix exe ezfio_file =
failwith ("Executable "^exe^" not found") failwith ("Executable "^exe^" not found")
end; end;
Printf.printf "%s\n" (Core.Time.to_string time_start); let tm = Unix.localtime time_start in
Printf.printf "Date: %2.2d/%2.2d/%4d %2.2d:%2.2d:%2.2d\n"
tm.Unix.tm_mday
(tm.Unix.tm_mon+1)
(tm.Unix.tm_year+1900)
(tm.Unix.tm_hour + if tm.Unix.tm_isdst then 1 else 0)
tm.Unix.tm_min
tm.Unix.tm_sec
;
Printf.printf "===============\nQuantum Package\n===============\n\n"; Printf.printf "===============\nQuantum Package\n===============\n\n";
Printf.printf "Git Commit: %s\n" Git.message; Printf.printf "Git Commit: %s\n" Git.message;
Printf.printf "Git Date : %s\n" Git.date; Printf.printf "Git Date : %s\n" Git.date;
@ -89,10 +97,12 @@ let run slave ?prefix exe ezfio_file =
if slave then if slave then
try try
let address = let address =
Core.In_channel.read_all qp_run_address_filename let ic = open_in qp_run_address_filename in
|> String.trim let result = input_line ic in
close_in ic;
String.trim result
in in
Unix.putenv "QP_RUN_ADDRESS_MASTER" address Unix.putenv "QP_RUN_ADDRESS_MASTER" address;
with Sys_error _ -> failwith "No master is not running" with Sys_error _ -> failwith "No master is not running"
in in
@ -110,8 +120,11 @@ let run slave ?prefix exe ezfio_file =
Unix.putenv "QP_RUN_ADDRESS" address; Unix.putenv "QP_RUN_ADDRESS" address;
let () = let () =
if (not slave) then if (not slave) then
Core.Out_channel.with_file qp_run_address_filename ~f:( begin
fun oc -> Core.Out_channel.output_lines oc [address]) let oc = open_out qp_run_address_filename in
Printf.fprintf oc "%s\n" address;
close_out oc;
end
in in
@ -135,9 +148,13 @@ let run slave ?prefix exe ezfio_file =
if (not slave) then if (not slave) then
Sys.remove qp_run_address_filename; Sys.remove qp_run_address_filename;
let duration = Core.Time.diff (Core.Time.now()) time_start let duration = Unix.time () -. time_start |> Unix.gmtime in
|> Core.Time.Span.to_string in let open Unix in
Printf.printf "Wall time : %s\n\n" duration; let d, h, m, s =
duration.tm_yday, duration.tm_hour, duration.tm_min, duration.tm_sec
in
Printf.printf "Wall time: %d:%2.2d:%2.2d" (d*24+h) m s ;
Printf.printf "\n\n";
if (exit_code <> 0) then if (exit_code <> 0) then
exit exit_code exit exit_code

13
scripts/ezfio_interface/ei_handler.py
View File

@ -556,7 +556,7 @@ def create_ocaml_input(dict_ezfio_cfg, module_lower):
template += ["open Qptypes;;", template += ["open Qptypes;;",
"open Qputils;;", "open Qputils;;",
"open Core;;", "open Sexplib.Std;;",
"", "",
"module {0} : sig".format(module_lower.capitalize())] "module {0} : sig".format(module_lower.capitalize())]
@ -611,7 +611,16 @@ def create_ocaml_input(dict_ezfio_cfg, module_lower):
"", "",
"end"] "end"]
return "\n".join(template) result = "\n".join(template)
result = result.replace("String.of_string","string_of_string")
result = result.replace("String.to_string","string_of_string")
result = result.replace("Int.of_string","int_of_string")
result = result.replace("Int.to_string","string_of_int")
result = result.replace("Float.of_string","float_of_string")
result = result.replace("Float.to_string","string_of_float")
result = result.replace("Bool.of_string","bool_of_string")
result = result.replace("Bool.to_string","string_of_bool")
return result
def save_ocaml_input(module_lower, str_ocaml_input): def save_ocaml_input(module_lower, str_ocaml_input):

1
scripts/ezfio_interface/ezfio_generate_ocaml.py
View File

@ -352,7 +352,6 @@ class EZFIO_ocaml(object):
l_template = ['open Qputils;;', l_template = ['open Qputils;;',
'open Qptypes;;', 'open Qptypes;;',
'open Core;;',
''] '']
for m in self.l_module_lower: for m in self.l_module_lower:

58
scripts/ezfio_interface/qp_edit_template
View File

@ -4,7 +4,7 @@
open Qputils open Qputils
open Qptypes open Qptypes
open Core open Sexplib.Std
(** Interactive editing of the input. (** Interactive editing of the input.
@ -53,7 +53,7 @@ Editing file `%s`
let make_header kw = let make_header kw =
let s = keyword_to_string kw in let s = keyword_to_string kw in
let l = String.length s in let l = String.length s in
"\n\n"^s^"\n"^(String.init l ~f:(fun _ -> '='))^"\n\n" "\n\n"^s^"\n"^(String.init l (fun _ -> '='))^"\n\n"
@ -92,19 +92,19 @@ let get s =
(** Applies the changes from the string [str] corresponding to section [s] *) (** Applies the changes from the string [str] corresponding to section [s] *)
let set str s = let set str s =
let header = (make_header s) in let header = (make_header s) in
match String.substr_index ~pos:0 ~pattern:header str with match String_ext.substr_index ~pos:0 ~pattern:header str with
| None -> () | None -> ()
| Some idx -> | Some idx ->
begin begin
let index_begin = idx + (String.length header) in let index_begin = idx + (String.length header) in
let index_end = let index_end =
match ( String.substr_index ~pos:(index_begin+(String.length header)+1) match ( String_ext.substr_index ~pos:(index_begin+(String.length header)+1)
~pattern:"==" str) with ~pattern:"==" str) with
| Some i -> i | Some i -> i
| None -> String.length str | None -> String.length str
in in
let l = index_end - index_begin in let l = index_end - index_begin in
let str = String.sub ~pos:index_begin ~len:l str let str = String.sub str index_begin l
|> Rst_string.of_string |> Rst_string.of_string
in in
let write (of_rst,w) s = let write (of_rst,w) s =
@ -132,11 +132,11 @@ let set str s =
let create_temp_file ezfio_filename fields = let create_temp_file ezfio_filename fields =
let temp_filename = Filename.temp_file "qp_edit_" ".rst" in let temp_filename = Filename.temp_file "qp_edit_" ".rst" in
begin begin
Out_channel.with_file temp_filename ~f:(fun out_channel -> let oc = open_out temp_filename in
(file_header ezfio_filename) :: (List.map ~f:get fields) (file_header ezfio_filename) :: (List.map get fields)
|> String.concat ~sep:"\n" |> String.concat "\n"
|> Out_channel.output_string out_channel |> Printf.fprintf oc "%s";
); close_out oc;
at_exit (fun () -> Sys.remove temp_filename); at_exit (fun () -> Sys.remove temp_filename);
temp_filename temp_filename
end end
@ -155,20 +155,19 @@ let run check_only ?ndet ?state ezfio_filename =
in in
(* Open EZFIO *) (* Open EZFIO *)
if (not (Sys.file_exists_exn ezfio_filename)) then if (not (Sys.file_exists ezfio_filename)) then
failwith (ezfio_filename^" does not exists"); failwith (ezfio_filename^" does not exists");
Ezfio.set_file ezfio_filename; Ezfio.set_file ezfio_filename;
(* Clean qp_stop status *) (* Clean qp_stop status *)
[ "qpstop" ; "qpkill" ] [ "qpstop" ; "qpkill" ]
|> List.iter ~f:(fun f -> |> List.iter (fun f ->
let stopfile = let stopfile =
Filename.concat (Qpackage.ezfio_work ezfio_filename) f Filename.concat (Qpackage.ezfio_work ezfio_filename) f
in in
match Sys.file_exists stopfile with if Sys.file_exists stopfile then
| `Yes -> Sys.remove stopfile Sys.remove stopfile
| _ -> ()
); );
(* Reorder basis set *) (* Reorder basis set *)
@ -180,7 +179,7 @@ let run check_only ?ndet ?state ezfio_filename =
in in
let ordering = Input.Ao_basis.ordering aos in let ordering = Input.Ao_basis.ordering aos in
let test = Array.copy ordering in let test = Array.copy ordering in
Array.sort ~compare test ; Array.sort compare test ;
if test <> ordering then if test <> ordering then
begin begin
Printf.eprintf "Warning: Basis set is not properly ordered. Redordering.\n"; Printf.eprintf "Warning: Basis set is not properly ordered. Redordering.\n";
@ -212,7 +211,7 @@ let run check_only ?ndet ?state ezfio_filename =
(* (*
let output = (file_header ezfio_filename) :: ( let output = (file_header ezfio_filename) :: (
List.map ~f:get [ List.map get [
Ao_basis ; Ao_basis ;
Mo_basis ; Mo_basis ;
]) ])
@ -238,24 +237,28 @@ let run check_only ?ndet ?state ezfio_filename =
(* Open the temp file with external editor *) (* Open the temp file with external editor *)
let editor = let editor =
match Sys.getenv "EDITOR" with try Sys.getenv "EDITOR"
| Some editor -> editor with Not_found -> "vi"
| None -> "vi"
in in
match check_only with match check_only with
| true -> () | true -> ()
| false -> | false ->
Printf.sprintf "%s %s" editor temp_filename Printf.sprintf "%s %s" editor temp_filename
|> Sys.command_exn |> Sys.command |> ignore
; ;
(* Re-read the temp file *) (* Re-read the temp file *)
let temp_string = let temp_string =
In_channel.with_file temp_filename ~f:(fun in_channel -> let ic = open_in temp_filename in
In_channel.input_all in_channel) let result =
input_lines ic
|> String.concat "\n"
in
close_in ic;
result
in in
List.iter ~f:(fun x -> set temp_string x) tasks List.iter (fun x -> set temp_string x) tasks
@ -281,7 +284,8 @@ let create_backup ezfio_filename =
tar -cf .backup.tar --exclude=\"work/*\" %s && (mv .backup.tar %s || rm .backup.tar) tar -cf .backup.tar --exclude=\"work/*\" %s && (mv .backup.tar %s || rm .backup.tar)
" "
ezfio_filename ezfio_filename backup_filename ezfio_filename ezfio_filename backup_filename
|> Sys.command_exn |> Sys.command
|> ignore
with _ -> () with _ -> ()
@ -290,10 +294,10 @@ let restore_backup ezfio_filename =
let filename = let filename =
Printf.sprintf "%s/work/backup.tar" ezfio_filename Printf.sprintf "%s/work/backup.tar" ezfio_filename
in in
if Sys.file_exists_exn filename then if Sys.file_exists filename then
begin begin
Printf.sprintf "tar -xf %s" filename Printf.sprintf "tar -xf %s" filename
|> Sys.command_exn; |> Sys.command |> ignore;
remove_backup ezfio_filename remove_backup ezfio_filename
end end

5
scripts/perturbation.py
View File

@ -1,14 +1,15 @@
#!/usr/bin/env python2 #!/usr/bin/env python2
import os import os
from qp_path import QP_SRC
Pert_dir = os.environ["QP_ROOT"]+"/src/perturbation/" Pert_dir = os.path.join(QP_SRC,"perturbation")
perturbations = [] perturbations = []
for filename in filter(lambda x: x.endswith(".irp.f"), os.listdir(Pert_dir)): for filename in filter(lambda x: x.endswith(".irp.f"), os.listdir(Pert_dir)):
filename = Pert_dir+filename filename = os.path.join(Pert_dir,filename)
file = open(filename,'r') file = open(filename,'r')
lines = file.readlines() lines = file.readlines()
file.close() file.close()

2
src/cipsi/stochastic_cipsi.irp.f
View File

@ -70,7 +70,7 @@ subroutine run_stochastic_cipsi
write(*,'(A)') '--------------------------------------------------------------------------------' write(*,'(A)') '--------------------------------------------------------------------------------'
to_select = N_det to_select = N_det*int(sqrt(dble(N_states)))
to_select = max(N_states_diag, to_select) to_select = max(N_states_diag, to_select)
pt2 = 0.d0 pt2 = 0.d0

13
src/davidson/diagonalization_hs2_dressed.irp.f
View File

@ -408,10 +408,6 @@ subroutine davidson_diag_hjj_sjj(dets_in,u_in,H_jj,s2_out,energies,dim_in,sze,N_
! Compute s_kl = <u_k | S_l> = <u_k| S2 |u_l> ! Compute s_kl = <u_k | S_l> = <u_k| S2 |u_l>
! ------------------------------------------- ! -------------------------------------------
! call dgemm('T','N', shift2, shift2, sze, &
! 1.d0, U, size(U,1), S, size(S,1), &
! 0.d0, s_, size(s_,1))
!$OMP PARALLEL DO DEFAULT(SHARED) PRIVATE(i,j,k) !$OMP PARALLEL DO DEFAULT(SHARED) PRIVATE(i,j,k)
do j=1,shift2 do j=1,shift2
do i=1,shift2 do i=1,shift2
@ -438,8 +434,13 @@ subroutine davidson_diag_hjj_sjj(dets_in,u_in,H_jj,s2_out,energies,dim_in,sze,N_
do k=1,shift2 do k=1,shift2
h_p(k,k) = h_p(k,k) + S_z2_Sz - expected_s2 h_p(k,k) = h_p(k,k) + S_z2_Sz - expected_s2
enddo enddo
alpha = 0.1d0 if (only_expected_s2) then
h_p = h + alpha*h_p alpha = 0.1d0
h_p = h + alpha*h_p
else
alpha = 0.0001d0
h_p = h + alpha*h_p
endif
else else
h_p = h h_p = h
alpha = 0.d0 alpha = 0.d0

2
src/fci/fci.irp.f
View File

@ -48,7 +48,7 @@ program fci
else else
PROVIDE mo_two_e_integrals_in_map PROVIDE mo_two_e_integrals_in_map
call run_slave_cipsi call run_slave_cipsi
endif endif
end end

4
src/mo_basis/mos.irp.f
View File

@ -45,9 +45,9 @@ BEGIN_PROVIDER [ double precision, mo_coef, (ao_num,mo_num) ]
BEGIN_DOC BEGIN_DOC
! Molecular orbital coefficients on |AO| basis set ! Molecular orbital coefficients on |AO| basis set
! !
! mo_coef(i,j) = coefficient of the i-th |AO| on the jth mo ! mo_coef(i,j) = coefficient of the i-th |AO| on the jth |MO|
! !
! mo_label : Label characterizing the MOS (local, canonical, natural, etc) ! mo_label : Label characterizing the |MOs| (local, canonical, natural, etc)
END_DOC END_DOC
integer :: i, j integer :: i, j
double precision, allocatable :: buffer(:,:) double precision, allocatable :: buffer(:,:)

2
src/scf_utils/diagonalize_fock.irp.f
View File

@ -1,7 +1,7 @@
BEGIN_PROVIDER [ double precision, eigenvectors_Fock_matrix_mo, (ao_num,mo_num) ] BEGIN_PROVIDER [ double precision, eigenvectors_Fock_matrix_mo, (ao_num,mo_num) ]
implicit none implicit none
BEGIN_DOC BEGIN_DOC
! Eigenvectors of the Fock matrix in the MO basis obtained with level shift. ! Eigenvectors of the Fock matrix in the |MO| basis obtained with level shift.
END_DOC END_DOC
integer :: i,j integer :: i,j