diff --git a/INSTALL.rst b/INSTALL.rst index acf918f8..cc5b512a 100644 --- a/INSTALL.rst +++ b/INSTALL.rst @@ -291,7 +291,7 @@ OCaml .. 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 diff --git a/configure b/configure index 9a4bbbc2..1e6af5e7 100755 --- a/configure +++ b/configure @@ -60,7 +60,7 @@ function execute () { } 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 case "$1" in diff --git a/ocaml/.gitignore b/ocaml/.gitignore deleted file mode 100644 index 683292ee..00000000 --- a/ocaml/.gitignore +++ /dev/null @@ -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 diff --git a/ocaml/Atom.ml b/ocaml/Atom.ml index bfe71c4c..d02b20d8 100644 --- a/ocaml/Atom.ml +++ b/ocaml/Atom.ml @@ -1,4 +1,4 @@ -open Core +open Sexplib.Std exception AtomError of string @@ -11,20 +11,20 @@ type t = (** Read xyz coordinates of the atom *) let of_string ~units s = let buffer = s - |> String.split ~on:' ' - |> List.filter ~f:(fun x -> x <> "") + |> String_ext.split ~on:' ' + |> List.filter (fun x -> x <> "") in match buffer with | [ name; charge; x; y; z ] -> { element = Element.of_string name ; 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 ] -> let e = Element.of_string name in { element = 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) @@ -33,7 +33,7 @@ let to_string ~units a = [ Element.to_string a.element ; Charge.to_string a.charge ; Point3d.to_string ~units a.coord ] - |> String.concat ~sep:" " + |> String.concat " " let to_xyz a = diff --git a/ocaml/Bit.ml b/ocaml/Bit.ml index ad532a44..4be0584d 100644 --- a/ocaml/Bit.ml +++ b/ocaml/Bit.ml @@ -1,4 +1,4 @@ -open Core;; +open Sexplib.Std (* Type for bits @@ -16,31 +16,31 @@ type t = let to_string = function | Zero -> "0" | One -> "1" -;; + let and_operator a b = match a, b with | Zero, _ -> Zero | _, Zero -> Zero | _, _ -> One -;; + let or_operator a b = match a, b with | One, _ -> One | _, One -> One | _, _ -> Zero -;; + let xor_operator a b = match a, b with | One, Zero -> One | Zero, One -> One | _, _ -> Zero -;; + let not_operator = function | One -> Zero | Zero -> One -;; + diff --git a/ocaml/Bitlist.ml b/ocaml/Bitlist.ml index 0a230d57..88f9b4dd 100644 --- a/ocaml/Bitlist.ml +++ b/ocaml/Bitlist.ml @@ -1,5 +1,4 @@ open Qptypes -open Core (* Type for bits strings @@ -22,15 +21,15 @@ let to_string b = let of_string ?(zero='0') ?(one='1') s = - String.to_list s - |> List.rev_map ~f:( fun c -> + List.init (String.length s) (String.get s) + |> List.rev_map ( fun c -> if (c = zero) then Bit.Zero else if (c = one) then Bit.One else (failwith ("Error in bitstring ") ) ) let of_string_mp s = - String.to_list s - |> List.rev_map ~f:(function + List.init (String.length s) (String.get s) + |> List.rev_map (function | '-' -> Bit.Zero | '+' -> Bit.One | _ -> failwith ("Error in bitstring ") ) @@ -44,7 +43,7 @@ let of_int64 i = | 1L -> Bit.One :: accu |> List.rev | i -> let b = - match (Int64.bit_and i 1L ) with + match (Int64.logand i 1L ) with | 0L -> Bit.Zero | 1L -> Bit.One | _ -> raise (Failure "i land 1 not in (0,1)") @@ -70,18 +69,18 @@ let to_int64 l = let rec do_work accu = function | [] -> accu | 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) (* Create a bit list from a list of int64 *) let of_int64_list l = - List.map ~f:of_int64 l + List.map of_int64 l |> List.concat (* Create a bit list from an array of int64 *) let of_int64_array l = - Array.map ~f:of_int64 l + Array.map of_int64 l |> Array.to_list |> List.concat @@ -116,7 +115,7 @@ let to_int64_list l = in let l = do_work [] [] 1 l in - List.rev_map ~f:to_int64 l + List.rev_map to_int64 l (* Create an array of int64 from a bit list *) let to_int64_array l = @@ -127,8 +126,8 @@ let to_int64_array l = let of_mo_number_list n_int l = let n_int = N_int_number.to_int n_int in let length = n_int*64 in - let a = Array.create length (Bit.Zero) in - List.iter ~f:(fun i-> a.((MO_number.to_int i)-1) <- Bit.One) l; + let a = Array.make length (Bit.Zero) in + List.iter (fun i-> a.((MO_number.to_int i)-1) <- Bit.One) l; Array.to_list a @@ -183,10 +182,10 @@ let not_operator b = logical_operator1 Bit.not_operator 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.Zero -> accu - ) + ) 0 b diff --git a/ocaml/Charge.ml b/ocaml/Charge.ml index 64ecbd81..076fd61e 100644 --- a/ocaml/Charge.ml +++ b/ocaml/Charge.ml @@ -1,14 +1,14 @@ -open Core +open Sexplib.Std type t = float [@@deriving sexp] -let of_float x = x -let of_int i = Float.of_int i -let of_string s = Float.of_string s +let of_float x = x +let of_int i = float_of_int i +let of_string s = float_of_string s -let to_float x = x -let to_int x = Float.to_int x +let to_float x = x +let to_int x = int_of_float x let to_string x = if x >= 0. then Printf.sprintf "+%f" x diff --git a/ocaml/Element.ml b/ocaml/Element.ml index 9bede291..bd080f00 100644 --- a/ocaml/Element.ml +++ b/ocaml/Element.ml @@ -1,4 +1,4 @@ -open Core +open Sexplib.Std open Qptypes exception ElementError of string @@ -14,7 +14,7 @@ type t = [@@deriving sexp] let of_string x = - match (String.capitalize (String.lowercase x)) with + match (String.capitalize_ascii (String.lowercase_ascii x)) with | "X" | "Dummy" -> X | "H" | "Hydrogen" -> H | "He" | "Helium" -> He diff --git a/ocaml/Excitation.ml b/ocaml/Excitation.ml index 58e18b11..5897cff2 100644 --- a/ocaml/Excitation.ml +++ b/ocaml/Excitation.ml @@ -1,4 +1,3 @@ -open Core open Qptypes module Hole = struct @@ -56,7 +55,7 @@ let to_string = function "," ; (MO_class.to_string (Particle.to_mo_class p)); "]"] - |> String.concat ~sep:" " + |> String.concat " " | Double (h1,p1,h2,p2) -> [ "Double Exc. : [" ; (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)); "]"] - |> String.concat ~sep:" " + |> String.concat " " diff --git a/ocaml/Gamess.ml b/ocaml/Gamess.ml index e0f07957..8129bc96 100644 --- a/ocaml/Gamess.ml +++ b/ocaml/Gamess.ml @@ -1,5 +1,6 @@ (** CONTRL *) type scftyp_t = RHF | ROHF | MCSCF | NONE + let string_of_scftyp = function | RHF -> "RHF" | ROHF -> "ROHF" @@ -79,14 +80,14 @@ let read_until_found f tries = begin try Some (read_mos x f) - with Caml.Not_found -> + with Not_found -> None end ) None tries in match result with | Some mos -> mos - | None -> raise Caml.Not_found + | None -> raise Not_found let read_natural_mos f = let tries = [ @@ -116,7 +117,7 @@ type guess_t = | Natural of (int*string) let guess_of_string s = - match String.lowercase s with + match String.lowercase_ascii s with | "huckel" -> Huckel | "hcore" -> Hcore | _ -> raise (Invalid_argument "Bad MO guess") @@ -430,7 +431,7 @@ let create_cas_input ?(vecfile="") ~guess ~nstate s n_e n_a = in try string_of_guess (Natural (norb, vecfile)) - with Caml.Not_found -> + with Not_found -> string_of_guess (Canonical (norb, vecfile)) end ; diff --git a/ocaml/GaussianPrimitive.ml b/ocaml/GaussianPrimitive.ml index 0b5e910c..d2144dec 100644 --- a/ocaml/GaussianPrimitive.ml +++ b/ocaml/GaussianPrimitive.ml @@ -1,16 +1,16 @@ open Qptypes -open Core +open Sexplib.Std type t = -{ sym : Symmetry.t ; - expo : AO_expo.t ; -} [@@deriving sexp] + { sym : Symmetry.t ; + expo : AO_expo.t ; + } [@@deriving sexp] let to_string p = let { sym = s ; expo = e } = p in Printf.sprintf "(%s, %22e)" - (Symmetry.to_string s) - (AO_expo.to_float e) + (Symmetry.to_string s) + (AO_expo.to_float e) let of_sym_expo s e = diff --git a/ocaml/Generic_input_of_rst.ml b/ocaml/Generic_input_of_rst.ml index cd2607b6..ec7de8c9 100644 --- a/ocaml/Generic_input_of_rst.ml +++ b/ocaml/Generic_input_of_rst.ml @@ -1,5 +1,6 @@ -open Core;; -open Qptypes;; +open Sexplib +open Sexplib.Std +open Qptypes let fail_msg str (ex,range) = @@ -15,25 +16,25 @@ let fail_msg str (ex,range) = let start_pos = range.start_pos.offset and end_pos = range.end_pos.offset in - let pre = String.sub ~pos:0 ~len:start_pos str - and mid = String.sub ~pos:start_pos ~len:(end_pos-start_pos) str - and post = String.sub ~pos:(end_pos) - ~len:((String.length str)-(end_pos)) str + let pre = String.sub str 0 start_pos + and mid = String.sub str start_pos (end_pos-start_pos) + and post = String.sub str (end_pos) + ((String.length str)-(end_pos)) in let str = Printf.sprintf "%s ## %s ## %s" pre mid post in - let str = String.tr str ~target:'(' ~replacement:' ' - |> String.split ~on:')' - |> List.map ~f:String.strip - |> List.filter ~f:(fun x -> - match String.substr_index x ~pos:0 ~pattern:"##" with + let str = String_ext.tr str ~target:'(' ~replacement:' ' + |> String_ext.split ~on:')' + |> List.map String_ext.strip + |> List.filter (fun x -> + match String_ext.substr_index ~pos:0 ~pattern:"##" x with | None -> false | Some _ -> true ) - |> String.concat ~sep:"\n" + |> String.concat "\n" 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 = @@ -41,20 +42,19 @@ let evaluate_sexp t_of_sexp s = match ( Sexp.of_string_conv sexp t_of_sexp ) with | `Result r -> Some r | `Error ex -> ( fail_msg sexp ex; None) -;; + let of_rst t_of_sexp s = Rst_string.to_string s - |> String.split ~on:'\n' - |> List.filter ~f:(fun line -> - String.contains line '=') - |> List.map ~f:(fun line -> + |> String_ext.split ~on:'\n' + |> List.filter (fun line -> String.contains line '=') + |> List.map (fun line -> "("^( - String.tr line ~target:'=' ~replacement:' ' + String_ext.tr ~target:'=' ~replacement:' ' line )^")" ) - |> String.concat + |> String.concat "" |> evaluate_sexp t_of_sexp -;; + diff --git a/ocaml/Input.ml b/ocaml/Input.ml index 65155f7c..f5b5a97f 100644 --- a/ocaml/Input.ml +++ b/ocaml/Input.ml @@ -1,6 +1,5 @@ open Qputils;; open Qptypes;; -open Core;; include Input_ao_basis;; include Input_bitmasks;; diff --git a/ocaml/Input_ao_basis.ml b/ocaml/Input_ao_basis.ml index 0b339654..b0a66b75 100644 --- a/ocaml/Input_ao_basis.ml +++ b/ocaml/Input_ao_basis.ml @@ -1,6 +1,6 @@ open Qptypes;; open Qputils;; -open Core;; +open Sexplib.Std;; module Ao_basis : sig type t = @@ -52,13 +52,13 @@ end = struct let read_ao_prim_num () = Ezfio.get_ao_basis_ao_prim_num () |> Ezfio.flattened_ezfio - |> Array.map ~f:AO_prim_number.of_int + |> Array.map AO_prim_number.of_int ;; let read_ao_prim_num_max () = Ezfio.get_ao_basis_ao_prim_num () |> 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 ;; @@ -66,42 +66,42 @@ end = struct let nmax = Nucl_number.get_max () in Ezfio.get_ao_basis_ao_nucl () |> 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 x = Ezfio.get_ao_basis_ao_power () in let dim = x.Ezfio.dim.(0) 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 do 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 - 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 - 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; - Array.map ~f:Symmetry.Xyz.of_string result + Array.map Symmetry.Xyz.of_string result ;; let read_ao_coef () = Ezfio.get_ao_basis_ao_coef () |> Ezfio.flattened_ezfio - |> Array.map ~f:AO_coef.of_float + |> Array.map AO_coef.of_float ;; let read_ao_expo () = Ezfio.get_ao_basis_ao_expo () |> Ezfio.flattened_ezfio - |> Array.map ~f:AO_expo.of_float + |> Array.map AO_expo.of_float ;; let read_ao_cartesian () = if not (Ezfio.has_ao_basis_ao_cartesian ()) then get_default "ao_cartesian" - |> Bool.of_string + |> bool_of_string |> Ezfio.set_ao_basis_ao_cartesian ; Ezfio.get_ao_basis_ao_cartesian () @@ -110,10 +110,10 @@ end = struct let to_long_basis b = let ao_num = AO_number.to_int b.ao_num in 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 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 ; GaussianPrimitive.expo = b.ao_expo.(ao_num*j+i) } @@ -178,14 +178,14 @@ end = struct in let 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 Ezfio.set_ao_basis_ao_prim_num (Ezfio.ezfio_array_of_list ~rank:1 ~dim:[| ao_num |] ~data:ao_prim_num) ; let ao_nucl = Array.to_list ao_nucl - |> List.map ~f:Nucl_number.to_int + |> List.map Nucl_number.to_int in Ezfio.set_ao_basis_ao_nucl(Ezfio.ezfio_array_of_list ~rank:1 ~dim:[| ao_num |] ~data:ao_nucl) ; @@ -193,9 +193,9 @@ end = struct let ao_power = let l = Array.to_list ao_power in List.concat [ - (List.map ~f:(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 ~f:(fun a -> Positive_int.to_int a.Symmetry.Xyz.z) l) ] + (List.map (fun a -> Positive_int.to_int a.Symmetry.Xyz.x) l) ; + (List.map (fun a -> Positive_int.to_int a.Symmetry.Xyz.y) l) ; + (List.map (fun a -> Positive_int.to_int a.Symmetry.Xyz.z) l) ] in Ezfio.set_ao_basis_ao_power(Ezfio.ezfio_array_of_list ~rank:2 ~dim:[| ao_num ; 3 |] ~data:ao_power) ; @@ -204,14 +204,14 @@ end = struct let ao_coef = Array.to_list ao_coef - |> List.map ~f:AO_coef.to_float + |> List.map AO_coef.to_float in Ezfio.set_ao_basis_ao_coef(Ezfio.ezfio_array_of_list ~rank:2 ~dim:[| ao_num ; ao_prim_num_max |] ~data:ao_coef) ; let ao_expo = Array.to_list ao_expo - |> List.map ~f:AO_expo.to_float + |> List.map AO_expo.to_float in Ezfio.set_ao_basis_ao_expo(Ezfio.ezfio_array_of_list ~rank:2 ~dim:[| ao_num ; ao_prim_num_max |] ~data:ao_expo) ; @@ -271,58 +271,56 @@ end = struct | Some (s', g', n') -> if s <> s' || n <> n' then find2 (s,g,n) a (i+1) else - let lc = List.map ~f:(fun (prim, _) -> prim) g.Gto.lc - and lc' = List.map ~f:(fun (prim, _) -> prim) g'.Gto.lc + let lc = List.map (fun (prim, _) -> prim) g.Gto.lc + and lc' = List.map (fun (prim, _) -> prim) g'.Gto.lc in if lc <> lc' then find2 (s,g,n) a (i+1) else (a.(i) <- None ; i) in find x a 0 in - let search_array = Array.map ~f:(fun i -> Some i) unordered_basis in - Array.map ~f:(fun x -> find x search_array) ordered_basis + let search_array = Array.map (fun i -> Some i) unordered_basis in + Array.map (fun x -> find x search_array) ordered_basis ;; let of_long_basis long_basis name ao_cartesian = let ao_num = List.length long_basis |> AO_number.of_int in let ao_prim_num = - List.map long_basis ~f:(fun (_,g,_) -> List.length g.Gto.lc - |> AO_prim_number.of_int ) + List.map (fun (_,g,_) -> List.length g.Gto.lc + |> AO_prim_number.of_int ) long_basis |> Array.of_list and ao_nucl = - List.map long_basis ~f:(fun (_,_,n) -> n) + List.map (fun (_,_,n) -> n) long_basis |> Array.of_list and ao_power = - List.map ~f:(fun (x,_,_) -> x) long_basis + List.map (fun (x,_,_) -> x) long_basis |> Array.of_list in - let ao_prim_num_max = Array.fold ~init:0 ~f:(fun s x -> - if AO_prim_number.to_int x > s then AO_prim_number.to_int x else s) + 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) 0 ao_prim_num |> AO_prim_number.of_int in let gtos = - List.map long_basis ~f:(fun (_,x,_) -> x) + List.map (fun (_,x,_) -> x) long_basis in let create_expo_coef ec = let coefs = begin match ec with - | `Coefs -> List.map gtos ~f:(fun x-> - List.map x.Gto.lc ~f:(fun (_,coef) -> AO_coef.to_float coef) ) - | `Expos -> List.map gtos ~f:(fun x-> - List.map x.Gto.lc ~f:(fun (prim,_) -> AO_expo.to_float - prim.GaussianPrimitive.expo) ) + | `Coefs -> List.map (fun x-> + List.map (fun (_,coef) -> AO_coef.to_float coef) x.Gto.lc ) gtos + | `Expos -> List.map (fun x-> + List.map (fun (prim,_) -> AO_expo.to_float + prim.GaussianPrimitive.expo) x.Gto.lc ) gtos end in let rec get_n n accu = function | [] -> List.rev accu | h::tail -> let y = - begin match List.nth h n with - | Some x -> x - | None -> 0. - end + try List.nth h n + with _ -> 0. in get_n n (y::accu) tail in @@ -335,10 +333,10 @@ end = struct let ao_coef = create_expo_coef `Coefs |> Array.of_list - |> Array.map ~f:AO_coef.of_float + |> Array.map AO_coef.of_float and ao_expo = create_expo_coef `Expos |> Array.of_list - |> Array.map ~f:AO_expo.of_float + |> Array.map AO_expo.of_float in { ao_basis = name ; ao_num ; ao_prim_num ; ao_prim_num_max ; ao_nucl ; @@ -347,17 +345,17 @@ end = struct let reorder b = 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 and ao_num = AO_number.to_int b.ao_num in let ao_coef = - Array.init ao_prim_num_max ~f:(fun i -> - f @@ Array.init ao_num ~f:(fun j -> b.ao_coef.(i*ao_num + j) ) + Array.init ao_prim_num_max (fun i -> + f @@ Array.init ao_num (fun j -> b.ao_coef.(i*ao_num + j) ) ) |> Array.to_list |> Array.concat in let ao_expo = - Array.init ao_prim_num_max ~f:(fun i -> - f @@ Array.init ao_num ~f:(fun j -> b.ao_expo.(i*ao_num + j) ) + Array.init ao_prim_num_max (fun i -> + f @@ Array.init ao_num (fun j -> b.ao_expo.(i*ao_num + j) ) ) |> Array.to_list |> Array.concat in { b with @@ -373,7 +371,7 @@ end = struct let to_rst b = 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) ) ) in let rec do_work = function @@ -383,7 +381,7 @@ end = struct (Symmetry.Xyz.to_string x) )::(do_work tail) in do_work l - |> String.concat + |> String.concat "" in let short_basis = to_basis b in @@ -408,11 +406,11 @@ Basis set (read-only) :: ======= ========= =========== " (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 - |> String.split ~on:'\n' - |> List.map ~f:(fun x-> " "^x) - |> String.concat ~sep:"\n" + |> String_ext.split ~on:'\n' + |> List.map (fun x-> " "^x) + |> String.concat "\n" ) print_sym |> Rst_string.of_string @@ -420,14 +418,14 @@ Basis set (read-only) :: let read_rst s = let s = Rst_string.to_string s - |> String.split ~on:'\n' + |> String_ext.split ~on:'\n' in let rec extract_basis = function | [] -> failwith "Error in basis set" | line :: tail -> - let line = String.strip line in + let line = String.trim line in if line = "Basis set (read-only) ::" then - String.concat tail ~sep:"\n" + String.concat "\n" tail else extract_basis tail in @@ -450,17 +448,17 @@ md5 = %s (AO_basis_name.to_string b.ao_basis) (AO_number.to_string b.ao_num) (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) - (b.ao_nucl |> Array.to_list |> List.map ~f:Nucl_number.to_string |> - String.concat ~sep:", ") - (b.ao_power |> Array.to_list |> List.map ~f:(fun x-> - "("^(Symmetry.Xyz.to_string x)^")" )|> String.concat ~sep:", ") - (b.ao_coef |> Array.to_list |> List.map ~f:AO_coef.to_string - |> String.concat ~sep:", ") - (b.ao_expo |> Array.to_list |> List.map ~f:AO_expo.to_string - |> String.concat ~sep:", ") - (b.ao_cartesian |> Bool.to_string) + (b.ao_nucl |> Array.to_list |> List.map Nucl_number.to_string |> + String.concat ", ") + (b.ao_power |> Array.to_list |> List.map (fun x-> + "("^(Symmetry.Xyz.to_string x)^")" )|> String.concat ", ") + (b.ao_coef |> Array.to_list |> List.map AO_coef.to_string + |> String.concat ", ") + (b.ao_expo |> Array.to_list |> List.map AO_expo.to_string + |> String.concat ", ") + (b.ao_cartesian |> string_of_bool) (to_md5 b |> MD5.to_string ) ;; diff --git a/ocaml/Input_bi_integrals.ml b/ocaml/Input_bi_integrals.ml deleted file mode 100644 index 40605572..00000000 --- a/ocaml/Input_bi_integrals.ml +++ /dev/null @@ -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 - - diff --git a/ocaml/Input_bitmasks.ml b/ocaml/Input_bitmasks.ml index f7ecbf2a..944a80ff 100644 --- a/ocaml/Input_bitmasks.ml +++ b/ocaml/Input_bitmasks.ml @@ -1,6 +1,6 @@ -open Qptypes;; -open Qputils;; -open Core;; +open Qptypes +open Qputils +open Sexplib.Std module Bitmasks : sig type t = @@ -59,7 +59,7 @@ end = struct let full_mask n_int = let range = "[1-"^ - (Int.to_string (Ezfio.get_mo_basis_mo_num ()))^"]" + (string_of_int (Ezfio.get_mo_basis_mo_num ()))^"]" in MO_class.create_active range |> MO_class.to_bitlist n_int @@ -75,7 +75,7 @@ end = struct full_mask n_int in 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 ) |> List.concat in @@ -107,7 +107,7 @@ end = struct full_mask n_int in let result = [ act ; act ] - |> List.map ~f:(fun x -> + |> List.map (fun x -> let y = Bitlist.to_int64_list x in y@y ) |> List.concat in @@ -147,12 +147,12 @@ cas = %s (Bit_kind.to_string b.bit_kind) (Bitmask_number.to_string b.n_mask_gen) (Array.to_list b.generators - |> List.map ~f:(fun x-> Int64.to_string x) - |> String.concat ~sep:", ") + |> List.map (fun x-> Int64.to_string x) + |> String.concat ", ") (Bitmask_number.to_string b.n_mask_cas) (Array.to_list b.cas - |> List.map ~f:(fun x-> Int64.to_string x) - |> String.concat ~sep:", ") + |> List.map (fun x-> Int64.to_string x) + |> String.concat ", ") end diff --git a/ocaml/Input_determinants_by_hand.ml b/ocaml/Input_determinants_by_hand.ml index 4e37732d..e1ac3566 100644 --- a/ocaml/Input_determinants_by_hand.ml +++ b/ocaml/Input_determinants_by_hand.ml @@ -1,6 +1,6 @@ open Qptypes;; open Qputils;; -open Core;; +open Sexplib.Std;; module Determinants_by_hand : sig type t = @@ -112,7 +112,7 @@ end = struct begin Ezfio.set_determinants_n_states n_states; let data = - Array.create n_states 1. + Array.make n_states 1. |> Array.to_list in Ezfio.ezfio_array_of_list ~rank:1 ~dim:[| n_states |] ~data @@ -126,7 +126,7 @@ end = struct |> States_number.to_int in let data = - Array.map ~f:Positive_float.to_float data + Array.map Positive_float.to_float data |> Array.to_list in Ezfio.ezfio_array_of_list ~rank:1 ~dim:[| n_states |] ~data @@ -142,21 +142,21 @@ end = struct begin let data = 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 write_state_average_weight data end; let result = Ezfio.get_determinants_state_average_weight () |> Ezfio.flattened_ezfio - |> Array.map ~f:Positive_float.of_float + |> Array.map Positive_float.of_float in if Array.length result = n_states then result else let data = 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 (write_state_average_weight data; data) ;; @@ -189,18 +189,18 @@ end = struct |> States_number.to_int in 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 end; Ezfio.get_determinants_psi_coef () |> 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 n_det = Det_number.to_int n_det and c = Array.to_list c - |> List.map ~f:Det_coef.to_float + |> List.map Det_coef.to_float and n_states = States_number.to_int n_states in @@ -242,9 +242,9 @@ end = struct assert (n_int = dim.(0)); assert (dim.(1) = 2); assert (dim.(2) = (Det_number.to_int (read_n_det ()))); - List.init dim.(2) ~f:(fun i -> - Array.sub ~pos:(2*n_int*i) ~len:(2*n_int) data) - |> List.map ~f:(Determinant.of_int64_array + List.init dim.(2) (fun i -> + Array.sub data (2*n_int*i) (2*n_int) ) + |> List.map (Determinant.of_int64_array ~n_int:(N_int_number.of_int n_int) ~alpha:n_alpha ~beta:n_beta ) |> Array.of_list @@ -332,18 +332,19 @@ end = struct else "0." ) - |> String.concat_array ~sep:"\t" + |> Array.to_list |> String.concat "\t" in - Array.init ndet ~f:(fun i -> + Array.init ndet (fun i -> Printf.sprintf " %s\n%s\n" (coefs_string i) (Determinant.to_string ~mo_num:mo_num b.psi_det.(i) - |> String.split ~on:'\n' - |> List.map ~f:(fun x -> " "^x) - |> String.concat ~sep:"\n" + |> String_ext.split ~on:'\n' + |> List.map (fun x -> " "^x) + |> String.concat "\n" ) ) - |> String.concat_array ~sep:"\n" + |> Array.to_list + |> String.concat "\n" in Printf.sprintf " 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.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 |> Rst_string.of_string ;; @@ -388,11 +389,11 @@ psi_det = %s (b.n_det |> Det_number.to_string) (b.n_states |> States_number.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.psi_coef |> Array.to_list |> List.map ~f:Det_coef.to_string - |> String.concat ~sep:", ") - (b.psi_det |> Array.to_list |> List.map ~f:(Determinant.to_string - ~mo_num) |> String.concat ~sep:"\n\n") + (b.state_average_weight |> Array.to_list |> List.map Positive_float.to_string |> String.concat ",") + (b.psi_coef |> Array.to_list |> List.map Det_coef.to_string + |> String.concat ", ") + (b.psi_det |> Array.to_list |> List.map (Determinant.to_string + ~mo_num) |> String.concat "\n\n") ;; let of_rst r = @@ -400,33 +401,36 @@ psi_det = %s in (* 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 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 (* Handle header *) let header = r - |> String.split ~on:'\n' - |> List.filter ~f:(fun line -> + |> String_ext.split ~on:'\n' + |> List.filter (fun line -> if (line = "") then false else ( (String.contains line '=') && (line.[0] = ' ') ) ) - |> List.map ~f:(fun line -> + |> List.map (fun line -> "("^( - String.tr line ~target:'=' ~replacement:' ' - |> String.strip + String_ext.tr line ~target:'=' ~replacement:' ' + |> String.trim )^")" ) - |> String.concat + |> String.concat "" in (* Handle determinant coefs *) let dets = match ( dets - |> String.split ~on:'\n' - |> List.map ~f:(String.strip) + |> String_ext.split ~on:'\n' + |> List.map String.trim ) with | _::lines -> lines | _ -> failwith "Error in determinants" @@ -438,8 +442,8 @@ psi_det = %s | ""::""::tail -> read_coefs accu tail | ""::c::tail -> let c = - String.split ~on:'\t' c - |> List.map ~f:(fun x -> Det_coef.of_float (Float.of_string x)) + String_ext.split ~on:'\t' c + |> List.map (fun x -> Det_coef.of_float (Float.of_string x)) |> Array.of_list in read_coefs (c::accu) tail @@ -450,15 +454,15 @@ psi_det = %s read_coefs [] dets in let nstates = - List.hd_exn buffer + List.hd buffer |> Array.length in let extract_state i = let i = i-1 in - List.map ~f:(fun x -> Det_coef.to_string x.(i)) buffer - |> String.concat ~sep:" " + List.map (fun x -> Det_coef.to_string x.(i)) buffer + |> String.concat " " in let rec build_result = function | 1 -> extract_state 1 @@ -492,21 +496,12 @@ psi_det = %s | _::tail -> read_dets accu tail in let dets = - List.map ~f:String.rev dets + List.map String_ext.rev dets 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 = read_dets [] dets - |> String.concat + |> String.concat "" in - Gc.set control; "(psi_det ("^a^"))" in @@ -520,7 +515,7 @@ psi_det = %s Printf.sprintf "(n_states %d)" (States_number.to_int @@ read_n_states ()) in 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 @@ -603,16 +598,16 @@ psi_det = %s States_number.to_int det.n_states in Range.to_int_list range - |> List.iter ~f:(fun istate -> + |> List.iter (fun istate -> if istate > n_states then failwith "State to extract should not be greater than n_states") ; let sorted_list = Range.to_int_list range - |> List.sort ~compare + |> List.sort compare in let state_shift = ref 0 in - List.iter ~f:(fun istate -> + List.iter (fun istate -> let j = istate - 1 in diff --git a/ocaml/Input_electrons.ml b/ocaml/Input_electrons.ml index 8eef8c68..ff80745f 100644 --- a/ocaml/Input_electrons.ml +++ b/ocaml/Input_electrons.ml @@ -1,6 +1,6 @@ -open Qptypes;; -open Qputils;; -open Core;; +open Qptypes +open Qputils +open Sexplib.Std module Electrons : sig type t = diff --git a/ocaml/Input_mo_basis.ml b/ocaml/Input_mo_basis.ml index 7697c73d..1402845f 100644 --- a/ocaml/Input_mo_basis.ml +++ b/ocaml/Input_mo_basis.ml @@ -1,6 +1,6 @@ open Qptypes open Qputils -open Core +open Sexplib.Std module Mo_basis : sig @@ -38,9 +38,10 @@ end = struct let reorder b ordering = { b with mo_coef = - Array.map ~f:(fun mo -> - Array.init ~f:(fun i -> mo.(ordering.(i))) (Array.length mo) ) - b.mo_coef + Array.map (fun mo -> + Array.init (Array.length mo) + (fun i -> mo.(ordering.(i))) + ) b.mo_coef } let read_ao_md5 () = @@ -73,7 +74,7 @@ end = struct begin let mo_num = MO_number.to_int (read_mo_num ()) in 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 in Ezfio.ezfio_array_of_list ~rank:1 @@ -81,7 +82,7 @@ end = struct |> Ezfio.set_mo_basis_mo_class end; 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 () = @@ -90,7 +91,7 @@ end = struct let elec_alpha_num = Ezfio.get_electrons_elec_alpha_num () and elec_beta_num = Ezfio.get_electrons_elec_beta_num () 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 Array.to_list in @@ -99,18 +100,18 @@ end = struct |> Ezfio.set_mo_basis_mo_occ end; 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 a = Ezfio.get_mo_basis_mo_coef () |> Ezfio.flattened_ezfio - |> Array.map ~f:MO_coef.of_float + |> Array.map MO_coef.of_float in let mo_num = read_mo_num () |> MO_number.to_int in let ao_num = (Array.length a)/mo_num in - Array.init mo_num ~f:(fun j -> - Array.sub ~pos:(j*ao_num) ~len:(ao_num) a + Array.init mo_num (fun j -> + Array.sub a (j*ao_num) (ao_num) ) @@ -136,14 +137,14 @@ end = struct | 1 -> let header = [ Printf.sprintf " #%15d" (imin+1) ; ] in let new_lines = - List.init ao_num ~f:(fun i -> + List.init ao_num (fun i -> Printf.sprintf " %3d %15.10f " (i+1) (MO_coef.to_float mo_coef.(imin ).(i)) ) in header @ new_lines | 2 -> let header = [ Printf.sprintf " #%15d %15d" (imin+1) (imin+2) ; ] in 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) (MO_coef.to_float mo_coef.(imin ).(i)) (MO_coef.to_float mo_coef.(imin+1).(i)) ) @@ -152,7 +153,7 @@ end = struct let header = [ Printf.sprintf " #%15d %15d %15d" (imin+1) (imin+2) (imin+3); ] in 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) (MO_coef.to_float mo_coef.(imin ).(i)) (MO_coef.to_float mo_coef.(imin+1).(i)) @@ -162,7 +163,7 @@ end = struct let header = [ Printf.sprintf " #%15d %15d %15d %15d" (imin+1) (imin+2) (imin+3) (imin+4) ; ] in 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) (MO_coef.to_float mo_coef.(imin ).(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" (imin+1) (imin+2) (imin+3) (imin+4) (imin+5) ; ] in 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) (MO_coef.to_float mo_coef.(imin ).(i)) (MO_coef.to_float mo_coef.(imin+1).(i)) @@ -185,11 +186,11 @@ end = struct in let rec create_list accu i = 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 - (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 - create_list [] 0 |> String.concat ~sep:"\n\n" + create_list [] 0 |> String.concat "\n\n" let to_rst b = @@ -224,13 +225,13 @@ mo_coef = %s (MO_label.to_string b.mo_label) (MO_number.to_string b.mo_num) (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 - ~f:(MO_occ.to_string) |> String.concat ~sep:", " ) + (MO_occ.to_string) |> String.concat ", " ) (b.mo_coef |> Array.map - ~f:(fun x-> Array.map ~f:MO_coef.to_string x |> String.concat_array - ~sep:"," ) |> - String.concat_array ~sep:"\n" ) + (fun x-> Array.map MO_coef.to_string x |> + Array.to_list |> String.concat "," ) |> + Array.to_list |> String.concat "\n" ) let write_mo_num n = @@ -245,7 +246,7 @@ mo_coef = %s let write_mo_class a = 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 in Ezfio.ezfio_array_of_list ~rank:1 ~dim:[| mo_num |] ~data |> Ezfio.set_mo_basis_mo_class @@ -253,7 +254,7 @@ mo_coef = %s let write_mo_occ a = 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 in Ezfio.ezfio_array_of_list ~rank:1 ~dim:[| mo_num |] ~data |> Ezfio.set_mo_basis_mo_occ @@ -268,7 +269,7 @@ mo_coef = %s let mo_num = Array.length a in let ao_num = Array.length a.(0) in 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 |> List.concat diff --git a/ocaml/Input_nuclei_by_hand.ml b/ocaml/Input_nuclei_by_hand.ml index 3783613d..520b4f05 100644 --- a/ocaml/Input_nuclei_by_hand.ml +++ b/ocaml/Input_nuclei_by_hand.ml @@ -1,6 +1,6 @@ open Qptypes;; open Qputils;; -open Core;; +open Sexplib.Std;; module Nuclei_by_hand : sig type t = @@ -41,7 +41,7 @@ end = struct let read_nucl_label () = Ezfio.get_nuclei_nucl_label () |> Ezfio.flattened_ezfio - |> Array.map ~f:Element.of_string + |> Array.map Element.of_string ;; let write_nucl_label ~nucl_num labels = @@ -50,7 +50,7 @@ end = struct in let labels = Array.to_list labels - |> List.map ~f:Element.to_string + |> List.map Element.to_string in Ezfio.ezfio_array_of_list ~rank:1 ~dim:[| nucl_num |] ~data:labels @@ -61,7 +61,7 @@ end = struct let read_nucl_charge () = Ezfio.get_nuclei_nucl_charge () |> Ezfio.flattened_ezfio - |> Array.map ~f:Charge.of_float + |> Array.map Charge.of_float ;; let write_nucl_charge ~nucl_num charges = @@ -70,7 +70,7 @@ end = struct in let charges = Array.to_list charges - |> List.map ~f:Charge.to_float + |> List.map Charge.to_float in Ezfio.ezfio_array_of_list ~rank:1 ~dim:[| nucl_num |] ~data:charges @@ -85,7 +85,7 @@ end = struct |> Ezfio.flattened_ezfio 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) do result.(i) <- Point3d.({ x=raw_data.(i); @@ -101,9 +101,9 @@ end = struct in let coord = Array.to_list coord in let coord = - (List.map ~f:(fun x-> x.Point3d.x) coord) @ - (List.map ~f:(fun x-> x.Point3d.y) coord) @ - (List.map ~f:(fun x-> x.Point3d.z) coord) + (List.map (fun x-> x.Point3d.x) coord) @ + (List.map (fun x-> x.Point3d.y) coord) @ + (List.map (fun x-> x.Point3d.z) coord) in Ezfio.ezfio_array_of_list ~rank:2 ~dim:[| nucl_num ; 3 |] ~data:coord @@ -160,11 +160,11 @@ nucl_coord = %s " (Nucl_number.to_string b.nucl_num) (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 - ~f:(Charge.to_string) |> String.concat ~sep:", " ) + (Charge.to_string) |> String.concat ", " ) (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 " nucl_num ) :: ( - List.init nucl_num ~f:(fun i-> + List.init nucl_num (fun i-> Printf.sprintf " %-3s %d %s" (b.nucl_label.(i) |> Element.to_string) (b.nucl_charge.(i) |> Charge.to_int ) (b.nucl_coord.(i) |> Point3d.to_string ~units:Units.Angstrom) ) - ) |> String.concat ~sep:"\n" + ) |> String.concat "\n" in Printf.sprintf " Nuclear coordinates in xyz format (Angstroms) :: @@ -192,16 +192,15 @@ Nuclear coordinates in xyz format (Angstroms) :: let of_rst s = let l = Rst_string.to_string s - |> String.split ~on:'\n' + |> String_ext.split ~on:'\n' in (* Find lines containing the xyz data *) let rec extract_begin = function - | [] -> raise Caml.Not_found + | [] -> raise Not_found | line::tail -> - let line = String.strip line in + let line = String.trim line in if (String.length line > 3) && - (String.sub line ~pos:((String.length line)-2) - ~len:2 = "::") then + (String.sub line ((String.length line)-2) 2 = "::") then tail else extract_begin tail @@ -213,12 +212,12 @@ Nuclear coordinates in xyz format (Angstroms) :: | _ :: nucl_num :: title :: lines -> begin let nucl_num = nucl_num - |> String.strip - |> Int.of_string + |> String.trim + |> int_of_string |> Nucl_number.of_int ~max:nmax and lines = Array.of_list lines 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)) end | _ -> failwith "Error in xyz format" @@ -227,12 +226,12 @@ Nuclear coordinates in xyz format (Angstroms) :: let result = { nucl_num = List.length atom_list |> Nucl_number.of_int ~max:nmax; - nucl_label = List.map atom_list ~f:(fun x -> - x.Atom.element) |> Array.of_list ; - nucl_charge = List.map atom_list ~f:(fun x -> - x.Atom.charge ) |> Array.of_list ; - nucl_coord = List.map atom_list ~f:(fun x -> - x.Atom.coord ) |> Array.of_list ; + nucl_label = List.map (fun x -> + x.Atom.element) atom_list |> Array.of_list ; + nucl_charge = List.map (fun x -> + x.Atom.charge ) atom_list |> Array.of_list ; + nucl_coord = List.map (fun x -> + x.Atom.coord ) atom_list |> Array.of_list ; } in Some result ;; diff --git a/ocaml/MO_class.ml b/ocaml/MO_class.ml index 9df80240..f4a2d7d2 100644 --- a/ocaml/MO_class.ml +++ b/ocaml/MO_class.ml @@ -1,5 +1,6 @@ -open Core open Qptypes +open Sexplib.Std + type t = | Core of MO_number.t list @@ -12,8 +13,8 @@ type t = let to_string x = let print_list l = - let s = List.map ~f:(fun x-> MO_number.to_int x |> string_of_int )l - |> (String.concat ~sep:", ") + let s = List.map (fun x-> MO_number.to_int x |> string_of_int ) l + |> (String.concat ", ") in "("^s^")" in @@ -32,7 +33,7 @@ let to_string x = let of_string s = - match (String.lowercase s) with + match (String.lowercase_ascii s) with | "core" -> Core [] | "inactive" -> Inactive [] | "active" -> Active [] @@ -42,7 +43,7 @@ let of_string s = 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) diff --git a/ocaml/MO_label.ml b/ocaml/MO_label.ml index ea917fbc..e23b2542 100644 --- a/ocaml/MO_label.ml +++ b/ocaml/MO_label.ml @@ -1,4 +1,4 @@ -open Core;; +open Sexplib.Std type t = | Guess @@ -8,7 +8,7 @@ type t = | Orthonormalized | None [@@deriving sexp] -;; + let to_string = function | Guess -> "Guess" @@ -20,7 +20,7 @@ let to_string = function ;; let of_string s = - match String.lowercase (String.strip s) with + match String.lowercase_ascii (String.trim s) with | "guess" -> Guess | "canonical" -> Canonical | "natural" -> Natural diff --git a/ocaml/Message.ml b/ocaml/Message.ml index beffc436..2ea1d38c 100644 --- a/ocaml/Message.ml +++ b/ocaml/Message.ml @@ -1,4 +1,4 @@ -open Core +open Sexplib.Std open Qptypes (** 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 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 @@ -193,12 +193,12 @@ end = struct } let create ~state ~task_ids = { 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 = Printf.sprintf "del_task %s %s" (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 @@ -219,7 +219,7 @@ end = struct else "done" in 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 @@ -303,11 +303,11 @@ end = struct "get_tasks_reply ok" let to_string_list x = "get_tasks_reply ok" :: ( - List.map x ~f:(fun (task_id, task) -> + List.map (fun (task_id, task) -> match task_id with | Some task_id -> Printf.sprintf "%d %s" (Id.Task.to_int task_id) task | None -> Printf.sprintf "0 terminate" - ) ) + ) x ) end @@ -408,14 +408,14 @@ end = struct let create ~state ~client_id ~task_ids = { client_id = Id.Client.of_int client_id ; 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 = Printf.sprintf "task_done %s %d %s" (State.to_string x.state) (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 (** Terminate *) @@ -460,7 +460,7 @@ end = struct type t = string let create x = x let to_string x = - String.concat ~sep:" " [ "error" ; x ] + String.concat " " [ "error" ; x ] end diff --git a/ocaml/Molecule.ml b/ocaml/Molecule.ml index 94d937dd..78ceff0c 100644 --- a/ocaml/Molecule.ml +++ b/ocaml/Molecule.ml @@ -62,7 +62,7 @@ let name m = try let i = List.assoc e accu in 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 | [] -> accu in @@ -207,7 +207,7 @@ let distance_matrix molecule = -open Core ;; + include To_md5 let to_md5 = to_md5 sexp_of_t diff --git a/ocaml/Multiplicity.ml b/ocaml/Multiplicity.ml index 1a64954a..9b5549e9 100644 --- a/ocaml/Multiplicity.ml +++ b/ocaml/Multiplicity.ml @@ -1,10 +1,11 @@ -open Core;; -open Qptypes ;; +open Qptypes +open Sexplib.Std type t = Strictly_positive_int.t [@@deriving sexp] -let of_int = Strictly_positive_int.of_int ;; -let to_int = Strictly_positive_int.to_int ;; +let of_int = Strictly_positive_int.of_int + +let to_int = Strictly_positive_int.to_int let to_string m = match (to_int m) with @@ -18,7 +19,7 @@ let to_string m = | 8 -> "Octet" | 9 -> "Nonet" | i -> Printf.sprintf "%d-et" i -;; + let of_alpha_beta a b = let a = Elec_alpha_number.to_int a @@ -26,11 +27,11 @@ let of_alpha_beta a b = in assert (a >= b); of_int (1 + a - b) -;; + let to_alpha_beta ne m = let ne = Elec_number.to_int ne in let nb = (ne-(to_int m)+1)/2 in let na = ne - nb in (Elec_alpha_number.of_int na, Elec_beta_number.of_int nb) -;; + diff --git a/ocaml/Point3d.ml b/ocaml/Point3d.ml index b31ece94..ab086dee 100644 --- a/ocaml/Point3d.ml +++ b/ocaml/Point3d.ml @@ -1,5 +1,5 @@ -open Core;; -open Qptypes;; +open Qptypes +open Sexplib.Std type t = { x : float ; @@ -21,10 +21,10 @@ let of_string ~units s = | Units.Angstrom -> Units.angstrom_to_bohr in let l = s - |> String.split ~on:' ' - |> List.filter ~f:(fun x -> x <> "") - |> List.map ~f:Float.of_string - |> Array.of_list + |> String_ext.split ~on:' ' + |> List.filter (fun x -> x <> "") + |> List.map float_of_string + |> Array.of_list in { x = l.(0) *. f ; y = l.(1) *. f ; diff --git a/ocaml/Progress_bar.ml b/ocaml/Progress_bar.ml index 13b7b9df..bc720b95 100644 --- a/ocaml/Progress_bar.ml +++ b/ocaml/Progress_bar.ml @@ -1,5 +1,3 @@ -open Core - type t = { title: string; @@ -7,14 +5,14 @@ type t = cur_value : float; end_value : float; bar_length : int; - init_time : Time.t; + init_time : float; dirty : bool; - next : Time.t; + next : float; } let init ?(bar_length=20) ?(start_value=0.) ?(end_value=1.) ~title = { 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 = { bar with cur_value ; dirty=true } @@ -40,23 +38,23 @@ let display_tty bar = |> Float.to_int in let hashes = - String.init bar.bar_length ~f:(fun i -> + String.init bar.bar_length (fun i -> if (i < n_hashes) then '#' else ' ' ) in let now = - Time.now () + Unix.time () in let running_time = - Time.abs_diff now bar.init_time + now -. bar.init_time in - Printf.eprintf "%s : [%s] %4.1f%% | %10s\r%!" + Printf.eprintf "%s : [%s] %4.1f%% | %8.0f s\r%!" bar.title hashes percent - (Time.Span.to_string running_time); - { bar with dirty = false ; next = Time.add now (Time.Span.of_sec 0.1) } + running_time; + { bar with dirty = false ; next = now +. 0.1 } let display_file bar = @@ -65,19 +63,19 @@ let display_file bar = (bar.end_value -. bar.start_value) in let running_time = - Time.abs_diff (Time.now ()) bar.init_time + (Unix.time ()) -. bar.init_time in - Printf.eprintf "%5.2f %% in %20s \n%!" + Printf.eprintf "%5.2f %% in %20.0f seconds \n%!" percent - (Time.Span.to_string running_time); - { bar with dirty = false ; next = Time.add (Time.now ()) (Time.Span.of_sec 10.) } + running_time; + { bar with dirty = false ; next = (Unix.time ()) +. 10. } let display bar = if (not bar.dirty) then bar - else if (Time.now () < bar.next) then + else if (Unix.time () < bar.next) then bar else begin diff --git a/ocaml/Pseudo.ml b/ocaml/Pseudo.ml index 976f119d..0fd2c263 100644 --- a/ocaml/Pseudo.ml +++ b/ocaml/Pseudo.ml @@ -1,4 +1,4 @@ -open Core +open Sexplib.Std open Qptypes @@ -81,12 +81,12 @@ let to_string_local = function | t -> "Local component:" :: ( 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) (R_power.to_int l.GaussianPrimitive_local.r_power) (AO_expo.to_float l.GaussianPrimitive_local.expo) - ) ) - |> String.concat ~sep:"\n" + ) t ) + |> String.concat "\n" (** Transform the non-local component of the pseudopotential to a string *) @@ -95,7 +95,7 @@ let to_string_non_local = function | t -> "Non-local component:" :: ( 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 = Positive_int.to_int l.GaussianPrimitive_non_local.proj in @@ -104,8 +104,8 @@ let to_string_non_local = function (R_power.to_int l.GaussianPrimitive_non_local.r_power) (AO_expo.to_float l.GaussianPrimitive_non_local.expo) p p - ) ) - |> String.concat ~sep:"\n" + ) t ) + |> String.concat "\n" (** Transform the Pseudopotential to a string *) let to_string t = @@ -116,29 +116,30 @@ let to_string t = :: to_string_local t.local :: to_string_non_local t.non_local :: [] - |> List.filter ~f:(fun x -> x <> "") - |> String.concat ~sep:"\n" + |> List.filter (fun x -> x <> "") + |> String.concat "\n" (** Find an element in the file *) let find in_channel element = - In_channel.seek in_channel 0L; + seek_in in_channel 0; let loop, element_read, old_pos = ref true, ref None, - ref (In_channel.pos in_channel) + ref (pos_in in_channel) in while !loop do try let buffer = - old_pos := In_channel.pos in_channel; - match In_channel.input_line in_channel with - | Some line -> String.split ~on:' ' line - |> List.hd_exn - | None -> raise End_of_file + old_pos := pos_in in_channel; + try + input_line in_channel + |> String_ext.split ~on:' ' + |> List.hd + with _ -> raise End_of_file in element_read := Some (Element.of_string buffer); loop := !element_read <> (Some element) @@ -146,7 +147,7 @@ let find in_channel element = | Element.ElementError _ -> () | End_of_file -> loop := false done ; - In_channel.seek in_channel !old_pos; + seek_in in_channel !old_pos; !element_read @@ -156,13 +157,13 @@ let read_element in_channel element = | Some e when e = element -> begin let rec read result = - match In_channel.input_line in_channel with - | None -> result - | Some line -> - if (String.strip line = "") then + try + let line = input_line in_channel in + if (String.trim line = "") then result else read (line::result) + with _ -> result in let data = @@ -171,20 +172,20 @@ let read_element in_channel element = in let debug_data = - String.concat ~sep:"\n" data + String.concat "\n" data in let decode_first_line = function | first_line :: rest -> begin let first_line_split = - String.split first_line ~on:' ' - |> List.filter ~f:(fun x -> (String.strip x) <> "") + String_ext.split first_line ~on:' ' + |> List.filter (fun x -> (String.trim x) <> "") in match first_line_split with | e :: "GEN" :: n :: p -> { 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 = [] ; non_local = [] }, rest @@ -200,18 +201,18 @@ let read_element in_channel element = | (n,line::rest) -> begin match - String.split line ~on:' ' - |> List.filter ~f:(fun x -> String.strip x <> "") + String_ext.split line ~on:' ' + |> List.filter (fun x -> String.trim x <> "") with | c :: i :: e :: [] -> let i = - Int.of_string i + int_of_string i in let elem = ( create_primitive - (Float.of_string e |> AO_expo.of_float) + (float_of_string e |> AO_expo.of_float) (i-2 |> R_power.of_int), - Float.of_string c |> AO_coef.of_float + float_of_string c |> AO_coef.of_float ) in loop create_primitive (elem::accu) (n-1, rest) @@ -230,8 +231,8 @@ let read_element in_channel element = match data with | n :: rest -> let n = - String.strip n - |> Int.of_string + String.trim n + |> int_of_string |> Positive_int.of_int in decode_local_n n rest @@ -250,8 +251,8 @@ let read_element in_channel element = match data with | n :: rest -> let n = - String.strip n - |> Int.of_string + String.trim n + |> int_of_string |> Positive_int.of_int in let result = diff --git a/ocaml/Qpackage.ml b/ocaml/Qpackage.ml index b766d066..5099a231 100644 --- a/ocaml/Qpackage.ml +++ b/ocaml/Qpackage.ml @@ -1,45 +1,45 @@ -open Core;; -open Qptypes;; -open Qputils;; +open Qptypes +open Qputils (** Variables related to the quantum package installation *) let root = - match (Sys.getenv "QP_ROOT") with + match (Sys.getenv_opt "QP_ROOT") with | None -> failwith "QP_ROOT environment variable is not set. Please source the quantum_package.rc file." | Some x -> x -;; + let bit_kind_size = lazy ( 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")); - let in_channel = In_channel.create filename in - let lines = In_channel.input_lines in_channel in - In_channel.close in_channel; + let in_channel = open_in filename in + let lines = input_lines in_channel in + close_in in_channel; let rec get_data = function | [] -> raise (Failure ("bit_kind_size not found in "^filename)) | line::tail -> - let line = - begin match String.split ~on:'!' line |> List.hd with - | Some x -> x - | None -> "" - end in - begin match (String.rsplit2 ~on:':' line) with - | Some (_ ,buffer) -> - begin match (String.split ~on:'=' buffer |> List.map ~f:String.strip) with - | ["bit_kind_size"; x] -> - Int.of_string x |> Bit_kind_size.of_int - | _ -> get_data tail - end - | _ -> get_data tail - end + let line = + try + String_ext.split ~on:'!' line + |> List.hd + with _ -> line + in + begin match (String_ext.rsplit2 ~on:':' line) with + | Some (_ ,buffer) -> + begin match (String_ext.split ~on:'=' buffer |> List.map String.trim) with + | ["bit_kind_size"; x] -> + int_of_string x |> Bit_kind_size.of_int + | _ -> get_data tail + end + | _ -> get_data tail + end in get_data lines ) -;; + let bit_kind = lazy ( Lazy.force bit_kind_size @@ -47,23 +47,26 @@ let bit_kind = lazy ( |> fun x -> x / 8 |> Bit_kind.of_int ) -;; + let executables = lazy ( - let filename = root^"/data/executables" - and func in_channel = - In_channel.input_lines in_channel - |> List.map ~f:(fun x -> - let e = String.split ~on:' ' x - |> List.filter ~f:(fun x -> x <> "") + let filename = root^"/data/executables" in + let lines = + let in_channel = open_in filename in + let result = input_lines in_channel in + close_in in_channel; + result + in + lines + |> List.map (fun x -> + let e = String_ext.split ~on:' ' x + |> List.filter (fun x -> x <> "") in 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 - In_channel.with_file filename ~f:func - |> List.sort ~compare:(fun (x,_) (y,_) -> + |> List.sort (fun (x,_) (y,_) -> if x < y then -1 else if x > y then 1 else 0) @@ -72,33 +75,37 @@ let executables = lazy ( let get_ezfio_default_in_file ~directory ~data ~filename = - let lines = In_channel.with_file filename ~f:(fun in_channel -> - In_channel.input_lines in_channel) in + let lines = + 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 | line :: rest -> - if ((String.strip line) = directory) then + if ((String.trim line) = directory) then rest else find_dir rest - | [] -> raise Caml.Not_found + | [] -> raise Not_found in let rec find_data = function | line :: rest -> if (line = "") then - raise Caml.Not_found + raise Not_found else if (line.[0] <> ' ') then - raise Caml.Not_found + raise Not_found else begin - match (String.lsplit2 ~on:' ' (String.strip line)) with + match (String_ext.lsplit2 ~on:' ' (String.trim line)) with | Some (l,r) -> if (l = data) then - String.strip r + String.trim r else find_data rest - | None -> raise Caml.Not_found + | None -> raise Not_found end - | [] -> raise Caml.Not_found + | [] -> raise Not_found in find_dir lines |> find_data ; @@ -111,7 +118,7 @@ let get_ezfio_default directory data = | [] -> begin Printf.printf "%s/%s not found\n%!" directory data; - raise Caml.Not_found + raise Not_found end | filename :: tail -> let filename = @@ -120,7 +127,7 @@ let get_ezfio_default directory data = try get_ezfio_default_in_file ~directory ~data ~filename with - | Caml.Not_found -> aux tail + | Not_found -> aux tail in Sys.readdir dirname |> Array.to_list @@ -131,10 +138,7 @@ let ezfio_work ezfio_file = let result = Filename.concat ezfio_file "work" in - begin - match Sys.is_directory result with - | `Yes -> () - | _ -> ( Ezfio.set_file ezfio_file ; Ezfio.set_work_empty false) - end; + if not (Sys.file_exists result) then + ( Ezfio.set_file ezfio_file ; Ezfio.set_work_empty false); result ;; diff --git a/ocaml/Qputils.ml b/ocaml/Qputils.ml index 9601d875..392a6764 100644 --- a/ocaml/Qputils.ml +++ b/ocaml/Qputils.ml @@ -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 + diff --git a/ocaml/Queuing_system.ml b/ocaml/Queuing_system.ml index e7b31cab..82ac1846 100644 --- a/ocaml/Queuing_system.ml +++ b/ocaml/Queuing_system.ml @@ -83,7 +83,7 @@ let pop_task ~client_id q = } and found = try Some (TasksMap.find task_id q.tasks) - with Caml.Not_found -> None + with Not_found -> None in new_q, Some task_id, found | [] -> q, None, None @@ -104,7 +104,7 @@ let end_task ~task_id ~client_id q = let () = let client_id_check = try RunningMap.find task_id running with - Caml.Not_found -> failwith "Task already finished" + Not_found -> failwith "Task already finished" in assert (client_id_check = client_id) in diff --git a/ocaml/String_ext.ml b/ocaml/String_ext.ml index a2911ebe..53bccdf8 100644 --- a/ocaml/String_ext.ml +++ b/ocaml/String_ext.ml @@ -3,27 +3,6 @@ include String (** Split a string on a given character *) let split ?(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 *) @@ -88,7 +67,7 @@ let lsplit2_exn ?(on=' ') s = (** Split a string in two pieces when a character is found the 1st time from the right *) let rsplit2_exn ?(on=' ') s = let length = - String.length s + String.length s in let rec do_work i = if (i = -1) then @@ -101,7 +80,7 @@ let rsplit2_exn ?(on=' ') s = else do_work (i-1) in - do_work length + do_work (length-1) let lsplit2 ?(on=' ') s = @@ -123,6 +102,15 @@ let to_list s = |> 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 = to_list s |> List.fold_left f init @@ -140,3 +128,23 @@ let is_prefix ~prefix s = let of_char 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 + diff --git a/ocaml/TaskServer.ml b/ocaml/TaskServer.ml index 0d457e38..6f2d01f7 100644 --- a/ocaml/TaskServer.ml +++ b/ocaml/TaskServer.ml @@ -33,7 +33,7 @@ type t = let debug_env = try - Sys.getenv "QP_TASK_DEBUG"; true + Sys.getenv "QP_TASK_DEBUG" = "1" with Not_found -> false diff --git a/ocaml/_tags b/ocaml/_tags index 1ed06ebb..8c354c8b 100644 --- a/ocaml/_tags +++ b/ocaml/_tags @@ -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 false: profile <*byte> : linkdep(c_bindings.o), custom diff --git a/ocaml/create_git_sha1.sh b/ocaml/create_git_sha1.sh index 35cbb7d5..64f08442 100755 --- a/ocaml/create_git_sha1.sh +++ b/ocaml/create_git_sha1.sh @@ -4,9 +4,8 @@ SHA1=$(git log -1 | head -1 | cut -d ' ' -f 2) DATE=$(git log -1 | grep Date | cut -d ':' -f 2-) MESSAGE=$(git log -1 | tail -1 | sed 's/"/\\"/g') cat << EOF > Git.ml -open Core -let sha1 = "$SHA1" |> String_ext.strip -let date = "$DATE" |> String_ext.strip -let message = "$MESSAGE" |> String_ext.strip +let sha1 = "$SHA1" |> String.trim +let date = "$DATE" |> String.trim +let message = "$MESSAGE" |> String.trim EOF diff --git a/ocaml/element_create_db.ml b/ocaml/element_create_db.ml index 7d3e26f4..36f0e58a 100644 --- a/ocaml/element_create_db.ml +++ b/ocaml/element_create_db.ml @@ -1,4 +1,3 @@ -open Core open Qptypes open Element @@ -6,22 +5,22 @@ let () = let indices = Array.init 78 (fun i -> i) in - Out_channel.with_file (Qpackage.root ^ "/data/list_element.txt") - ~f:(fun out_channel -> - Array.init 110 ~f:(fun i -> - let element = - try - Some (of_charge (Charge.of_int i)) - with - | _ -> None - in - match element with - | None -> "" - | 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 + let out_channel = + open_out (Qpackage.root ^ "/data/list_element.txt") + in + Array.init 110 (fun i -> + let element = + try + Some (of_charge (Charge.of_int i)) + with + | _ -> None + in + match element with + | None -> "" + | 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 "" + |> Printf.fprintf out_channel "%s" diff --git a/ocaml/qp_create_ezfio.ml b/ocaml/qp_create_ezfio.ml index c31bf933..083db4de 100644 --- a/ocaml/qp_create_ezfio.ml +++ b/ocaml/qp_create_ezfio.ml @@ -1,6 +1,6 @@ open Qputils open Qptypes -open Core +open Sexplib.Std type element = | Element of Element.t @@ -38,7 +38,7 @@ let dummy_centers ~threshold ~molecule ~nuclei = | _ -> assert false in aux [] (n-1,n-1) - |> List.map ~f:(fun (i,x,j,y,r) -> + |> List.map (fun (i,x,j,y,r) -> let f = x /. (x +. y) in @@ -58,22 +58,22 @@ let dummy_centers ~threshold ~molecule ~nuclei = (** Returns the list of available basis sets *) let list_basis () = let basis_list = - let ic = Pervasives.open_in (Qpackage.root ^ "/data/basis/00_README.rst") in - let n = Pervasives.in_channel_length ic in + let ic = open_in (Qpackage.root ^ "/data/basis/00_README.rst") in + let n = in_channel_length ic in let s = Bytes.create n in - Pervasives.really_input ic s 0 n; - Pervasives.close_in ic; + really_input ic s 0 n; + close_in ic; Bytes.to_string s - |> String.split ~on:'\n' - |> List.filter ~f:(fun line -> String.length line > 1 && line.[0] <> '#') - |> List.map ~f:(fun line -> - match String.split ~on:'\'' line with + |> String_ext.split ~on:'\n' + |> List.filter (fun line -> String.length line > 1 && line.[0] <> '#') + |> List.map (fun line -> + match String_ext.split ~on:'\'' line with | 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 ) in - List.sort basis_list ~compare:String.ascending + List.sort compare basis_list (** Run the program *) @@ -101,7 +101,7 @@ let run ?o b au c d m p cart xyz_file = **********) let basis_table = - Hashtbl.Poly.create () + Hashtbl.create 63 in (* 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 | Int_elem (i,e) -> Printf.sprintf "%d,%s" (Nucl_number.to_int i) (Element.to_string e) in - match Hashtbl.find basis_table key with - | Some in_channel -> - in_channel - | None -> raise Caml.Not_found + Hashtbl.find basis_table key in let temp_filename = @@ -129,11 +126,11 @@ let run ?o b au c d m p cart xyz_file = Qpackage.root ^ "/data/basis/" ^ basis in match - Sys.is_file basis, - Sys.is_file long_basis + Sys.file_exists basis, + Sys.file_exists long_basis with - | `Yes, _ -> In_channel.create basis - | `No , `Yes -> In_channel.create long_basis + | true , _ -> open_in basis + | false, true -> open_in long_basis | _ -> failwith ("Basis "^basis^" not found") in @@ -141,7 +138,7 @@ let run ?o b au c d m p cart xyz_file = | [] -> () | elem_and_basis_name :: rest -> begin - match (String.lsplit2 ~on:':' elem_and_basis_name) with + match (String_ext.lsplit2 ~on:':' elem_and_basis_name) with | None -> (* Principal basis *) begin let basis = @@ -150,14 +147,12 @@ let run ?o b au c d m p cart xyz_file = let new_channel = fetch_channel basis in - List.iter nuclei ~f:(fun elem-> + List.iter (fun elem-> let key = Element.to_string elem.Atom.element in - match Hashtbl.add basis_table ~key:key ~data:new_channel with - | `Ok -> () - | `Duplicate -> () - ) + Hashtbl.add basis_table key new_channel + ) nuclei end | Some (key, basis) -> (*Aux basis *) begin @@ -166,12 +161,12 @@ let run ?o b au c d m p cart xyz_file = Element (Element.of_string key) with Element.ElementError _ -> 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) | _ -> failwith "Expected format is int,Element:basis" in Int_elem result and basis = - String.lowercase basis + String.lowercase_ascii basis in let key = match elem with @@ -181,23 +176,13 @@ let run ?o b au c d m p cart xyz_file = let new_channel = fetch_channel basis in - begin - match Hashtbl.add basis_table ~key:key ~data:new_channel with - | `Ok -> () - | `Duplicate -> - let e = - match elem with - | Element e -> e - | Int_elem (_,e) -> e - in - failwith ("Duplicate definition of basis for "^(Element.to_long_string e)) - end + Hashtbl.add basis_table key new_channel end end; build_basis rest in - String.split ~on:'|' b - |> List.rev_map ~f:String.strip + String_ext.split ~on:'|' b + |> List.rev_map String.trim |> build_basis; @@ -207,7 +192,7 @@ let run ?o b au c d m p cart xyz_file = ***************) let pseudo_table = - Hashtbl.Poly.create () + Hashtbl.create 63 in (* Open pseudo channels *) @@ -215,7 +200,7 @@ let run ?o b au c d m p cart xyz_file = let key = Element.to_string element in - Hashtbl.find pseudo_table key + Hashtbl.find_opt pseudo_table key in let temp_filename = 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 in match - Sys.is_file pseudo, - Sys.is_file long_pseudo + Sys.file_exists pseudo, + Sys.file_exists long_pseudo with - | `Yes, _ -> In_channel.create pseudo - | `No , `Yes -> In_channel.create long_pseudo + | true , _ -> open_in pseudo + | false, true-> open_in long_pseudo | _ -> failwith ("Pseudo file "^pseudo^" not found.") in @@ -241,7 +226,7 @@ let run ?o b au c d m p cart xyz_file = | [] -> () | elem_and_pseudo_name :: rest -> begin - match (String.lsplit2 ~on:':' elem_and_pseudo_name) with + match (String_ext.lsplit2 ~on:':' elem_and_pseudo_name) with | None -> (* Principal pseudo *) begin let pseudo = @@ -250,21 +235,19 @@ let run ?o b au c d m p cart xyz_file = let new_channel = fetch_channel pseudo in - List.iter nuclei ~f:(fun elem-> + List.iter (fun elem-> let key = Element.to_string elem.Atom.element in - match Hashtbl.add pseudo_table ~key:key ~data:new_channel with - | `Ok -> () - | `Duplicate -> () - ) + Hashtbl.add pseudo_table key new_channel + ) nuclei end | Some (key, pseudo) -> (*Aux pseudo *) begin let elem = Element.of_string key and pseudo = - String.lowercase pseudo + String.lowercase_ascii pseudo in let key = Element.to_string elem @@ -272,11 +255,7 @@ let run ?o b au c d m p cart xyz_file = let new_channel = fetch_channel pseudo in - begin - 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 + Hashtbl.add pseudo_table key new_channel end end; build_pseudo rest @@ -285,8 +264,8 @@ let run ?o b au c d m p cart xyz_file = match p with | None -> () | Some p -> - String.split ~on:'|' p - |> List.rev_map ~f:String.strip + String_ext.split ~on:'|' p + |> List.rev_map String.trim |> build_pseudo in @@ -296,13 +275,13 @@ let run ?o b au c d m p cart xyz_file = | Some x -> x | None -> begin - match String.rsplit2 ~on:'.' xyz_file with + match String_ext.rsplit2 ~on:'.' xyz_file with | Some (x,"xyz") | Some (x,"zmt") -> x^".ezfio" | _ -> xyz_file^".ezfio" end in - if Sys.file_exists_exn ezfio_file then + if Sys.file_exists ezfio_file then failwith (ezfio_file^" already exists"); let write_file () = @@ -311,17 +290,17 @@ let run ?o b au c d m p cart xyz_file = (* Write Pseudo *) let pseudo = - List.map nuclei ~f:(fun x -> + List.map (fun x -> match pseudo_channel x.Atom.element with | Some channel -> Pseudo.read_element channel x.Atom.element | None -> Pseudo.empty x.Atom.element - ) + ) nuclei in let molecule = let n_elec_to_remove = - List.fold pseudo ~init:0 ~f:(fun accu x -> - accu + (Positive_int.to_int x.Pseudo.n_elec)) + List.fold_left (fun accu x -> + accu + (Positive_int.to_int x.Pseudo.n_elec)) 0 pseudo in { 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; Molecule.nuclei = let charges = - List.map pseudo ~f:(fun x -> Positive_int.to_int x.Pseudo.n_elec - |> Float.of_int) + List.map (fun x -> Positive_int.to_int x.Pseudo.n_elec + |> Float.of_int) pseudo |> Array.of_list 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) |> Charge.of_float } - ) + ) molecule.Molecule.nuclei } in let nuclei = @@ -356,13 +335,13 @@ let run ?o b au c d m p cart xyz_file = (* Write Nuclei *) 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 = - 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 = - (List.map ~f:(fun x-> x.Atom.coord.Point3d.x) nuclei) @ - (List.map ~f:(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.x) nuclei) @ + (List.map (fun x-> x.Atom.coord.Point3d.y) nuclei) @ + (List.map (fun x-> x.Atom.coord.Point3d.z) nuclei) in let nucl_num = (List.length labels) in Ezfio.set_nuclei_nucl_num nucl_num ; 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 let klocmax = - List.fold pseudo ~init:0 ~f:(fun accu x -> + List.fold_left (fun accu x -> let x = List.length x.Pseudo.local in if (x > accu) then x else accu - ) + ) 0 pseudo and lmax = - List.fold pseudo ~init:0 ~f:(fun accu x -> + List.fold_left (fun accu x -> let x = - List.fold x.Pseudo.non_local ~init:0 ~f:(fun accu (x,_) -> + List.fold_left (fun accu (x,_) -> let x = Positive_int.to_int x.Pseudo.GaussianPrimitive_non_local.proj in if (x > accu) then x else accu - ) + ) 0 x.Pseudo.non_local in if (x > accu) then x else accu - ) + ) 0 pseudo in let kmax = - Array.init (lmax+1) ~f:(fun i-> - List.map pseudo ~f:(fun x -> - List.filter x.Pseudo.non_local ~f:(fun (y,_) -> - (Positive_int.to_int y.Pseudo.GaussianPrimitive_non_local.proj) = i) - |> List.length ) - |> List.fold ~init:0 ~f:(fun accu x -> - if accu > x then accu else x) - ) - |> Array.fold ~init:0 ~f:(fun accu i -> - if i > accu then i else accu) + Array.init (lmax+1) (fun i-> + List.map (fun x -> + List.filter (fun (y,_) -> + (Positive_int.to_int y.Pseudo.GaussianPrimitive_non_local.proj) = i) + x.Pseudo.non_local + |> List.length ) pseudo + |> List.fold_left (fun accu x -> + if accu > x then accu else x) 0 + ) + |> Array.fold_left (fun accu i -> + if i > accu then i else accu) 0 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_lmax lmax; 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 ~dimx:klocmax ~dimy:nucl_num 0. , - Array.make_matrix ~dimx:klocmax ~dimy:nucl_num 0 + Array.make_matrix klocmax nucl_num 0. , + Array.make_matrix klocmax nucl_num 0. , + Array.make_matrix klocmax nucl_num 0 in - List.iteri pseudo ~f:(fun j x -> - List.iteri x.Pseudo.local ~f:(fun i (y,c) -> + List.iteri (fun j x -> + List.iteri (fun i (y,c) -> tmp_array_v_k.(i).(j) <- AO_coef.to_float c; let y, z = 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 tmp_array_dz_k.(i).(j) <- y; tmp_array_n_k.(i).(j) <- z; - ) - ); + ) x.Pseudo.local + ) pseudo ; let concat_2d tmp_array = let data = - Array.map tmp_array ~f:Array.to_list + Array.map Array.to_list tmp_array |> Array.to_list |> List.concat in @@ -454,18 +434,18 @@ let run ?o b au c d m p cart xyz_file = |> Ezfio.set_pseudo_pseudo_n_k; let tmp_array_v_kl, tmp_array_dz_kl, tmp_array_n_kl = - Array.init (lmax+1) ~f:(fun _ -> - (Array.make_matrix ~dimx:kmax ~dimy:nucl_num 0. )), - Array.init (lmax+1) ~f:(fun _ -> - (Array.make_matrix ~dimx:kmax ~dimy:nucl_num 0. )), - Array.init (lmax+1) ~f:(fun _ -> - (Array.make_matrix ~dimx:kmax ~dimy:nucl_num 0 )) + Array.init (lmax+1) (fun _ -> + (Array.make_matrix kmax nucl_num 0. )), + Array.init (lmax+1) (fun _ -> + (Array.make_matrix kmax nucl_num 0. )), + Array.init (lmax+1) (fun _ -> + (Array.make_matrix kmax nucl_num 0 )) in - List.iteri pseudo ~f:(fun j x -> + List.iteri (fun j x -> let last_idx = - Array.create ~len:(lmax+1) 0 + Array.make (lmax+1) 0 in - List.iter x.Pseudo.non_local ~f:(fun (y,c) -> + List.iter (fun (y,c) -> let k, y, z = Positive_int.to_int y.Pseudo.GaussianPrimitive_non_local.proj, 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_n_kl.(k).(i).(j) <- z; last_idx.(k) <- i+1; - ) - ); + ) x.Pseudo.non_local + ) pseudo ; let concat_3d tmp_array = let data = - Array.map tmp_array ~f:(fun x -> - Array.map x ~f:Array.to_list + Array.map (fun x -> + Array.map Array.to_list x |> Array.to_list - |> List.concat) + |> List.concat) tmp_array |> Array.to_list |> List.concat in @@ -518,7 +498,7 @@ let run ?o b au c d m p cart xyz_file = in let result = do_work [] 1 nuclei |> List.rev - |> List.map ~f:(fun (x,i) -> + |> List.map (fun (x,i) -> try let e = match x.Atom.element with @@ -530,13 +510,13 @@ let run ?o b au c d m p cart xyz_file = in try Basis.read_element (basis_channel key) i e - with Caml.Not_found -> + with Not_found -> let key = Element x.Atom.element in try 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) (Element.to_string x.Atom.element) ) 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 Ezfio.set_ao_basis_ao_num ao_num; Ezfio.set_ao_basis_ao_basis b; - let ao_prim_num = List.map long_basis ~f:(fun (_,g,_) -> List.length g.Gto.lc) - and ao_nucl = List.map long_basis ~f:(fun (_,_,n) -> Nucl_number.to_int n) + let ao_prim_num = List.map (fun (_,g,_) -> List.length g.Gto.lc) long_basis + and ao_nucl = List.map (fun (_,_,n) -> Nucl_number.to_int n) long_basis and ao_power= - let l = List.map long_basis ~f:(fun (x,_,_) -> x) in - (List.map l ~f:(fun t -> Positive_int.to_int Symmetry.Xyz.(t.x)) )@ - (List.map l ~f:(fun t -> Positive_int.to_int Symmetry.Xyz.(t.y)) )@ - (List.map l ~f:(fun t -> Positive_int.to_int Symmetry.Xyz.(t.z)) ) + let l = List.map (fun (x,_,_) -> x) long_basis in + (List.map (fun t -> Positive_int.to_int Symmetry.Xyz.(t.x)) l)@ + (List.map (fun t -> Positive_int.to_int Symmetry.Xyz.(t.y)) l)@ + (List.map (fun t -> Positive_int.to_int Symmetry.Xyz.(t.z)) l) 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 - else s) ao_prim_num + else s) 0 ao_prim_num in let gtos = - List.map long_basis ~f:(fun (_,x,_) -> x) + List.map (fun (_,x,_) -> x) long_basis in let create_expo_coef ec = let coefs = begin match ec with - | `Coefs -> List.map gtos ~f:(fun x-> - List.map x.Gto.lc ~f:(fun (_,coef) -> AO_coef.to_float coef) ) - | `Expos -> List.map gtos ~f:(fun x-> - List.map x.Gto.lc ~f:(fun (prim,_) -> AO_expo.to_float - prim.GaussianPrimitive.expo) ) + | `Coefs -> List.map (fun x-> + List.map (fun (_,coef) -> + AO_coef.to_float coef) x.Gto.lc) gtos + | `Expos -> List.map (fun x-> + List.map (fun (prim,_) -> AO_expo.to_float + prim.GaussianPrimitive.expo) x.Gto.lc) gtos end in let rec get_n n accu = function | [] -> List.rev accu | h::tail -> let y = - begin match List.nth h n with + begin match List.nth_opt h n with | Some x -> x | None -> 0. end @@ -621,9 +602,10 @@ let run ?o b au c d m p cart xyz_file = | ex -> begin begin - match Sys.is_directory ezfio_file with - | `Yes -> rmdir ezfio_file - | _ -> () + try + if Sys.is_directory ezfio_file then + rmdir ezfio_file + with _ -> () end; raise ex; 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 begin list_basis () - |> List.iter ~f:print_endline; + |> List.iter print_endline; exit 0 end; diff --git a/ocaml/qp_run.ml b/ocaml/qp_run.ml index 54029940..d096b15b 100644 --- a/ocaml/qp_run.ml +++ b/ocaml/qp_run.ml @@ -46,7 +46,7 @@ let run slave ?prefix exe ezfio_file = in let time_start = - Core.Time.now () + Unix.time () in if (not (Sys.file_exists ezfio_file)) then @@ -65,7 +65,15 @@ let run slave ?prefix exe ezfio_file = failwith ("Executable "^exe^" not found") 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 "Git Commit: %s\n" Git.message; Printf.printf "Git Date : %s\n" Git.date; @@ -89,10 +97,12 @@ let run slave ?prefix exe ezfio_file = if slave then try let address = - Core.In_channel.read_all qp_run_address_filename - |> String.trim + let ic = open_in qp_run_address_filename in + let result = input_line ic in + close_in ic; + String.trim result in - Unix.putenv "QP_RUN_ADDRESS_MASTER" address + Unix.putenv "QP_RUN_ADDRESS_MASTER" address; with Sys_error _ -> failwith "No master is not running" in @@ -110,8 +120,11 @@ let run slave ?prefix exe ezfio_file = Unix.putenv "QP_RUN_ADDRESS" address; let () = if (not slave) then - Core.Out_channel.with_file qp_run_address_filename ~f:( - fun oc -> Core.Out_channel.output_lines oc [address]) + begin + let oc = open_out qp_run_address_filename in + Printf.fprintf oc "%s\n" address; + close_out oc; + end in @@ -135,9 +148,13 @@ let run slave ?prefix exe ezfio_file = if (not slave) then Sys.remove qp_run_address_filename; - let duration = Core.Time.diff (Core.Time.now()) time_start - |> Core.Time.Span.to_string in - Printf.printf "Wall time : %s\n\n" duration; + let duration = Unix.time () -. time_start |> Unix.gmtime in + let open Unix in + 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 exit exit_code diff --git a/scripts/ezfio_interface/ei_handler.py b/scripts/ezfio_interface/ei_handler.py index 709c26f6..23a0ce53 100755 --- a/scripts/ezfio_interface/ei_handler.py +++ b/scripts/ezfio_interface/ei_handler.py @@ -556,7 +556,7 @@ def create_ocaml_input(dict_ezfio_cfg, module_lower): template += ["open Qptypes;;", "open Qputils;;", - "open Core;;", + "open Sexplib.Std;;", "", "module {0} : sig".format(module_lower.capitalize())] @@ -611,7 +611,16 @@ def create_ocaml_input(dict_ezfio_cfg, module_lower): "", "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): diff --git a/scripts/ezfio_interface/ezfio_generate_ocaml.py b/scripts/ezfio_interface/ezfio_generate_ocaml.py index deea0463..3c905122 100755 --- a/scripts/ezfio_interface/ezfio_generate_ocaml.py +++ b/scripts/ezfio_interface/ezfio_generate_ocaml.py @@ -352,7 +352,6 @@ class EZFIO_ocaml(object): l_template = ['open Qputils;;', 'open Qptypes;;', - 'open Core;;', ''] for m in self.l_module_lower: diff --git a/scripts/ezfio_interface/qp_edit_template b/scripts/ezfio_interface/qp_edit_template index 51da005b..b5196294 100644 --- a/scripts/ezfio_interface/qp_edit_template +++ b/scripts/ezfio_interface/qp_edit_template @@ -4,7 +4,7 @@ open Qputils open Qptypes -open Core +open Sexplib.Std (** Interactive editing of the input. @@ -53,7 +53,7 @@ Editing file `%s` let make_header kw = let s = keyword_to_string kw 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] *) let set str s = 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 -> () | Some idx -> begin let index_begin = idx + (String.length header) in 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 | Some i -> i | None -> String.length str 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 in let write (of_rst,w) s = @@ -132,11 +132,11 @@ let set str s = let create_temp_file ezfio_filename fields = let temp_filename = Filename.temp_file "qp_edit_" ".rst" in begin - Out_channel.with_file temp_filename ~f:(fun out_channel -> - (file_header ezfio_filename) :: (List.map ~f:get fields) - |> String.concat ~sep:"\n" - |> Out_channel.output_string out_channel - ); + let oc = open_out temp_filename in + (file_header ezfio_filename) :: (List.map get fields) + |> String.concat "\n" + |> Printf.fprintf oc "%s"; + close_out oc; at_exit (fun () -> Sys.remove temp_filename); temp_filename end @@ -155,20 +155,19 @@ let run check_only ?ndet ?state ezfio_filename = in (* 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"); Ezfio.set_file ezfio_filename; (* Clean qp_stop status *) [ "qpstop" ; "qpkill" ] - |> List.iter ~f:(fun f -> + |> List.iter (fun f -> let stopfile = Filename.concat (Qpackage.ezfio_work ezfio_filename) f in - match Sys.file_exists stopfile with - | `Yes -> Sys.remove stopfile - | _ -> () + if Sys.file_exists stopfile then + Sys.remove stopfile ); (* Reorder basis set *) @@ -180,7 +179,7 @@ let run check_only ?ndet ?state ezfio_filename = in let ordering = Input.Ao_basis.ordering aos in let test = Array.copy ordering in - Array.sort ~compare test ; + Array.sort compare test ; if test <> ordering then begin 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) :: ( - List.map ~f:get [ + List.map get [ Ao_basis ; Mo_basis ; ]) @@ -238,24 +237,28 @@ let run check_only ?ndet ?state ezfio_filename = (* Open the temp file with external editor *) let editor = - match Sys.getenv "EDITOR" with - | Some editor -> editor - | None -> "vi" + try Sys.getenv "EDITOR" + with Not_found -> "vi" in match check_only with | true -> () | false -> Printf.sprintf "%s %s" editor temp_filename - |> Sys.command_exn + |> Sys.command |> ignore ; (* Re-read the temp file *) let temp_string = - In_channel.with_file temp_filename ~f:(fun in_channel -> - In_channel.input_all in_channel) + let ic = open_in temp_filename in + let result = + input_lines ic + |> String.concat "\n" + in + close_in ic; + result 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) " ezfio_filename ezfio_filename backup_filename - |> Sys.command_exn + |> Sys.command + |> ignore with _ -> () @@ -290,10 +294,10 @@ let restore_backup ezfio_filename = let filename = Printf.sprintf "%s/work/backup.tar" ezfio_filename in - if Sys.file_exists_exn filename then + if Sys.file_exists filename then begin Printf.sprintf "tar -xf %s" filename - |> Sys.command_exn; + |> Sys.command |> ignore; remove_backup ezfio_filename end diff --git a/scripts/perturbation.py b/scripts/perturbation.py index 225fcc1d..cefb89b2 100644 --- a/scripts/perturbation.py +++ b/scripts/perturbation.py @@ -1,14 +1,15 @@ #!/usr/bin/env python2 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 = [] 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') lines = file.readlines() file.close() diff --git a/src/cipsi/stochastic_cipsi.irp.f b/src/cipsi/stochastic_cipsi.irp.f index 3cda76e3..157479d9 100644 --- a/src/cipsi/stochastic_cipsi.irp.f +++ b/src/cipsi/stochastic_cipsi.irp.f @@ -70,7 +70,7 @@ subroutine run_stochastic_cipsi write(*,'(A)') '--------------------------------------------------------------------------------' - to_select = N_det + to_select = N_det*int(sqrt(dble(N_states))) to_select = max(N_states_diag, to_select) pt2 = 0.d0 diff --git a/src/davidson/diagonalization_hs2_dressed.irp.f b/src/davidson/diagonalization_hs2_dressed.irp.f index f70fe78b..47052595 100644 --- a/src/davidson/diagonalization_hs2_dressed.irp.f +++ b/src/davidson/diagonalization_hs2_dressed.irp.f @@ -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 = = ! ------------------------------------------- -! 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) do j=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 h_p(k,k) = h_p(k,k) + S_z2_Sz - expected_s2 enddo - alpha = 0.1d0 - h_p = h + alpha*h_p + if (only_expected_s2) then + alpha = 0.1d0 + h_p = h + alpha*h_p + else + alpha = 0.0001d0 + h_p = h + alpha*h_p + endif else h_p = h alpha = 0.d0 diff --git a/src/fci/fci.irp.f b/src/fci/fci.irp.f index 6c836bb4..5c747081 100644 --- a/src/fci/fci.irp.f +++ b/src/fci/fci.irp.f @@ -48,7 +48,7 @@ program fci else PROVIDE mo_two_e_integrals_in_map - call run_slave_cipsi + call run_slave_cipsi endif end diff --git a/src/mo_basis/mos.irp.f b/src/mo_basis/mos.irp.f index 5547de0c..610e9a8c 100644 --- a/src/mo_basis/mos.irp.f +++ b/src/mo_basis/mos.irp.f @@ -45,9 +45,9 @@ BEGIN_PROVIDER [ double precision, mo_coef, (ao_num,mo_num) ] BEGIN_DOC ! 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 integer :: i, j double precision, allocatable :: buffer(:,:) diff --git a/src/scf_utils/diagonalize_fock.irp.f b/src/scf_utils/diagonalize_fock.irp.f index 8186037b..865b4d31 100644 --- a/src/scf_utils/diagonalize_fock.irp.f +++ b/src/scf_utils/diagonalize_fock.irp.f @@ -1,7 +1,7 @@ BEGIN_PROVIDER [ double precision, eigenvectors_Fock_matrix_mo, (ao_num,mo_num) ] implicit none 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 integer :: i,j