From a629b30051815eb820b5846920b233327647f44a Mon Sep 17 00:00:00 2001 From: Anthony Scemama Date: Sat, 19 Dec 2015 02:35:13 +0100 Subject: [PATCH] Added ocaml files --- ezfio_config/qmc.config | 105 ++++ install/scripts/install_ocaml.sh | 2 + ocaml/Block.ml | 150 +++++ ocaml/Default.ml | 37 ++ ocaml/Input.ml | 865 +++++++++++++++++++++++++++++ ocaml/Launcher.ml | 79 +++ ocaml/Md5.ml | 143 +++++ ocaml/Message.ml | 126 +++++ ocaml/Property.ml | 629 +++++++++++++++++++++ ocaml/Qmcchem_config.ml | 112 ++++ ocaml/Qmcchem_dataserver.ml | 865 +++++++++++++++++++++++++++++ ocaml/Qmcchem_debug.ml | 84 +++ ocaml/Qmcchem_edit.ml | 310 +++++++++++ ocaml/Qmcchem_forwarder.ml | 453 +++++++++++++++ ocaml/Qmcchem_md5.ml | 113 ++++ ocaml/Qmcchem_result.ml | 225 ++++++++ ocaml/Qmcchem_run.ml | 217 ++++++++ ocaml/Qmcchem_stop.ml | 24 + ocaml/Qptypes.ml | 830 +++++++++++++++++++++++++++ ocaml/Qputils.ml | 61 ++ ocaml/Random_variable.ml | 712 ++++++++++++++++++++++++ ocaml/Sample.ml | 46 ++ ocaml/Sample.mli | 8 + ocaml/Scheduler.ml | 40 ++ ocaml/Status.ml | 52 ++ ocaml/Watchdog.ml | 126 +++++ ocaml/compile.sh | 33 ++ ocaml/ninja_ocaml.py | 288 ++++++++++ ocaml/qmcchem.ml | 15 + ocaml/qptypes_generator.ml | 336 +++++++++++ scripts/create_properties_ezfio.py | 177 ++++++ 31 files changed, 7263 insertions(+) create mode 100644 ezfio_config/qmc.config create mode 100644 ocaml/Block.ml create mode 100644 ocaml/Default.ml create mode 100644 ocaml/Input.ml create mode 100644 ocaml/Launcher.ml create mode 100644 ocaml/Md5.ml create mode 100644 ocaml/Message.ml create mode 100644 ocaml/Property.ml create mode 100644 ocaml/Qmcchem_config.ml create mode 100644 ocaml/Qmcchem_dataserver.ml create mode 100644 ocaml/Qmcchem_debug.ml create mode 100644 ocaml/Qmcchem_edit.ml create mode 100644 ocaml/Qmcchem_forwarder.ml create mode 100644 ocaml/Qmcchem_md5.ml create mode 100644 ocaml/Qmcchem_result.ml create mode 100644 ocaml/Qmcchem_run.ml create mode 100644 ocaml/Qmcchem_stop.ml create mode 100644 ocaml/Qptypes.ml create mode 100644 ocaml/Qputils.ml create mode 100644 ocaml/Random_variable.ml create mode 100644 ocaml/Sample.ml create mode 100644 ocaml/Sample.mli create mode 100644 ocaml/Scheduler.ml create mode 100644 ocaml/Status.ml create mode 100644 ocaml/Watchdog.ml create mode 100755 ocaml/compile.sh create mode 100755 ocaml/ninja_ocaml.py create mode 100644 ocaml/qmcchem.ml create mode 100644 ocaml/qptypes_generator.ml create mode 100755 scripts/create_properties_ezfio.py diff --git a/ezfio_config/qmc.config b/ezfio_config/qmc.config new file mode 100644 index 0000000..05a7e4b --- /dev/null +++ b/ezfio_config/qmc.config @@ -0,0 +1,105 @@ +ao_basis + ao_num integer + ao_prim_num integer (ao_basis_ao_num) + ao_nucl integer (ao_basis_ao_num) + ao_power integer (ao_basis_ao_num,3) + ao_prim_num_max integer = maxval(ao_basis_ao_prim_num) + ao_coef real (ao_basis_ao_num,ao_basis_ao_prim_num_max) + ao_expo real (ao_basis_ao_num,ao_basis_ao_prim_num_max) + +mo_basis + mo_tot_num integer + mo_coef real (ao_basis_ao_num,mo_basis_mo_tot_num) + mo_classif character (mo_basis_mo_tot_num) + mo_closed_num integer =n_count_ch(mo_basis_mo_classif,size(mo_basis_mo_classif),'c') + mo_active_num integer =n_count_ch(mo_basis_mo_classif,size(mo_basis_mo_classif),'a') + mo_virtual_num integer =n_count_ch(mo_basis_mo_classif,size(mo_basis_mo_classif),'v') + mo_energy real (mo_basis_mo_tot_num) + mo_occ real (mo_basis_mo_tot_num) + mo_symmetry character*(8) (mo_basis_mo_tot_num) + +electrons + elec_alpha_num integer + elec_beta_num integer + elec_num integer = electrons_elec_alpha_num + electrons_elec_beta_num + elec_walk_num_tot integer + elec_walk_num integer + elec_coord_pool real (electrons_elec_num+1,3,electrons_elec_coord_pool_size) + elec_coord_pool_size integer + elec_fitcusp_radius real + +nuclei + nucl_num integer + nucl_label character*(32) (nuclei_nucl_num) + nucl_charge real (nuclei_nucl_num) + nucl_coord real (nuclei_nucl_num,3) + nucl_fitcusp_radius real (nuclei_nucl_num) + +spindeterminants + n_det_alpha integer + n_det_beta integer + n_det integer + n_int integer + bit_kind integer + n_states integer + psi_det_alpha integer*8 (spindeterminants_n_int*spindeterminants_bit_kind/8,spindeterminants_n_det_alpha) + psi_det_beta integer*8 (spindeterminants_n_int*spindeterminants_bit_kind/8,spindeterminants_n_det_beta) + psi_coef_matrix_rows integer (spindeterminants_n_det) + psi_coef_matrix_columns integer (spindeterminants_n_det) + psi_coef_matrix_values double precision (spindeterminants_n_det,spindeterminants_n_states) + + +simulation + do_run integer + stop_time integer + equilibration logical + title character*(128) + http_server character*(128) + do_jast logical + do_nucl_fitcusp logical + method character*(32) + block_time integer + sampling character*(32) + save_data logical + time_step real + print_level integer + ci_threshold double precision + md5_key character*(32) + orig_time double precision + E_ref double precision + +jastrow + jast_type character*(32) + jast_a_up_up real + jast_a_up_dn real + jast_b_up_up real + jast_b_up_dn real + jast_pen real (nuclei_nucl_num) + jast_eeN_e_a real (nuclei_nucl_num) + jast_eeN_e_b real (nuclei_nucl_num) + jast_eeN_N real (nuclei_nucl_num) + jast_core_a1 real (nuclei_nucl_num) + jast_core_a2 real (nuclei_nucl_num) + jast_core_b1 real (nuclei_nucl_num) + jast_core_b2 real (nuclei_nucl_num) + +blocks + empty integer + +pseudo + ao_pseudo_grid double precision (ao_basis_ao_num,pseudo_pseudo_lmax+pseudo_pseudo_lmax+1,pseudo_pseudo_lmax-0+1,nuclei_nucl_num,pseudo_pseudo_grid_size) + do_pseudo logical + mo_pseudo_grid double precision (ao_basis_ao_num,pseudo_pseudo_lmax+pseudo_pseudo_lmax+1,pseudo_pseudo_lmax-0+1,nuclei_nucl_num,pseudo_pseudo_grid_size) + pseudo_dz_k double precision (nuclei_nucl_num,pseudo_pseudo_klocmax) + pseudo_dz_kl double precision (nuclei_nucl_num,pseudo_pseudo_kmax,pseudo_pseudo_lmax+1) + pseudo_grid_rmax double precision + pseudo_grid_size integer + pseudo_klocmax integer + pseudo_kmax integer + pseudo_lmax integer + pseudo_n_k integer (nuclei_nucl_num,pseudo_pseudo_klocmax) + pseudo_n_kl integer (nuclei_nucl_num,pseudo_pseudo_kmax,pseudo_pseudo_lmax+1) + pseudo_v_k double precision (nuclei_nucl_num,pseudo_pseudo_klocmax) + pseudo_v_kl double precision (nuclei_nucl_num,pseudo_pseudo_kmax,pseudo_pseudo_lmax+1) + + diff --git a/install/scripts/install_ocaml.sh b/install/scripts/install_ocaml.sh index 8a4ce0d..7feeb24 100755 --- a/install/scripts/install_ocaml.sh +++ b/install/scripts/install_ocaml.sh @@ -14,7 +14,9 @@ then exit 1 fi +set +u source "${QMCCHEM_PATH}"/qmcchemrc +set -u cd Downloads chmod +x opam_installer.sh diff --git a/ocaml/Block.ml b/ocaml/Block.ml new file mode 100644 index 0000000..b78eabe --- /dev/null +++ b/ocaml/Block.ml @@ -0,0 +1,150 @@ +open Core.Std;; +open Qptypes;; + +type t = + { property : Property.t ; + value : Sample.t ; + weight : Weight.t ; + compute_node : Compute_node.t ; + pid : Pid.t ; + block_id : Block_id.t ; + } + +let re = + Str.regexp "[ |#|\n]+" + +let of_string s = + + try + let lst = + Str.split re s + |> List.rev + in + match lst with + | b :: pid :: c:: p :: w :: v :: [] -> Some + { property = Property.of_string p ; + value = Sample.of_float (Float.of_string v) ; + weight = Weight.of_float (Float.of_string w) ; + compute_node = Compute_node.of_string c; + pid = Pid.of_string pid; + block_id = Block_id.of_int (Int.of_string b) ; + } + | b :: pid :: c:: p :: w :: v -> + let v = + List.rev v + |> Array.of_list + |> Array.map ~f:Float.of_string + in + let dim = + Array.length v + in + Some + { property = Property.of_string p ; + value = Sample.of_float_array ~dim v ; + weight = Weight.of_float (Float.of_string w) ; + compute_node = Compute_node.of_string c; + pid = Pid.of_string pid; + block_id = Block_id.of_int (Int.of_string b) ; + } + | _ -> None + with + | _ -> None + + + +let to_string b = + Printf.sprintf "%s %s # %s %s %s %d" + (Sample.to_string b.value ) + (Weight.to_float b.weight |> Float.to_string) + (Property.to_string b.property) + (Compute_node.to_string b.compute_node) + (Pid.to_string b.pid) + (Block_id.to_int b.block_id) + + + +let dir_name = lazy( + let ezfio_filename = + Lazy.force Qputils.ezfio_filename + in + let md5 = + Md5.hash () + in + List.fold_right ~init:"" ~f:Filename.concat + [ ezfio_filename ; "blocks" ; md5 ; Filename.dir_sep ] +) + + +(* Fetch raw data from the EZFIO file *) +let _raw_data = + ref None + + +let update_raw_data ?(locked=true) () = + (* Create array of files to read *) + let dir_name = + Lazy.force dir_name + in + let files = + let result = + match Sys.is_directory dir_name with + | `Yes -> + begin + Sys.readdir dir_name + |> Array.map ~f:(fun x -> dir_name^x) + |> Array.to_list + end + | _ -> [] + in + if locked then + result + else + List.filter result ~f:(fun x -> + match String.substr_index ~pattern:"locked" x with + | Some x -> false + | None -> true + ) + in + + let rec transform new_list = function + | [] -> new_list + | head :: tail -> + let head = String.strip head in + let item = of_string head in + match item with + | None -> transform new_list tail + | Some x -> transform (x::new_list) tail + in + + let result = + List.map files ~f:(fun filename -> + In_channel.with_file filename ~f:(fun in_channel -> + In_channel.input_all in_channel) + ) + |> String.concat + |> String.split_lines + |> List.rev + |> transform [] + in + result + + +let raw_data ?(locked=true) () = + match !_raw_data with + | Some x -> x + | None -> + let result = + update_raw_data ~locked () + in + _raw_data := Some result; + result + + + +let properties = lazy ( + let set = Set.empty ~comparator:Comparator.Poly.comparator in + List.fold (raw_data ()) ~init:set ~f:(fun s x -> Set.add s x.property) + |> Set.to_list +) + + diff --git a/ocaml/Default.ml b/ocaml/Default.ml new file mode 100644 index 0000000..7046276 --- /dev/null +++ b/ocaml/Default.ml @@ -0,0 +1,37 @@ +open Core.Std;; + +let simulation_do_nucl_fitcusp = + if (not (Ezfio.has_simulation_do_nucl_fitcusp ())) then + begin + if (not (Ezfio.has_pseudo_do_pseudo ())) then + true + else + not (Ezfio.get_pseudo_do_pseudo ()) + end + else + Ezfio.get_simulation_do_nucl_fitcusp () + + +let electrons_elec_walk_num = 30 +let electrons_elec_walk_num_tot = 10000 +let jastrow_jast_type = "None" +let simulation_block_time = 30 +let simulation_ci_threshold = 1.e-8 +let simulation_method = "VMC" +let simulation_sampling = "Langevin" +let simulation_stop_time = 3600 +let simulation_time_step = 0.15 + +let reset_defaults () = + List.iter ~f:(fun x -> Sys.remove ( (Lazy.force Qputils.ezfio_filename) ^ x)) + [ "/electrons/elec_walk_num" ; + "/electrons/elec_walk_num_tot" ; + "/jastrow/jast_type" ; + "/simulation/block_time" ; + "/simulation/ci_threshold" ; + "/simulation/do_nucl_fitcusp" ; + "/simulation/method" ; + "/simulation/sampling" ; + "/simulation/stop_time" ; + "/simulation/time_step" ] + diff --git a/ocaml/Input.ml b/ocaml/Input.ml new file mode 100644 index 0000000..2c2fe33 --- /dev/null +++ b/ocaml/Input.ml @@ -0,0 +1,865 @@ +open Core.Std +open Qptypes +open Qputils + + + +module Pseudo: sig + + type t = bool + val doc : string + val read : unit -> t + val to_bool : t -> bool + val of_bool : bool -> t + val to_int : t -> int + val of_int : int -> t + val to_string : t -> string + val of_string : string -> t + +end = struct + + type t = bool + + let doc = "Correct wave function to verify electron-nucleus cusp condition" + + let of_bool x = x + + let to_bool x = x + + let read () = + let _ = + Lazy.force Qputils.ezfio_filename + in + if (not (Ezfio.has_pseudo_do_pseudo ())) then + Ezfio.set_pseudo_do_pseudo false; + Ezfio.get_pseudo_do_pseudo () + |> of_bool + + + let to_string t = + to_bool t + |> Bool.to_string + + + let of_string t = + try + String.lowercase t + |> Bool.of_string + |> of_bool + with + | Invalid_argument msg -> failwith msg + + + let to_int t = + let t = + to_bool t + in + if t then 1 + else 0 + + + let of_int = function + | 0 -> false + | 1 -> true + | _ -> failwith "Expected 0 or 1" + + +end + +module Fitcusp : sig + + type t = bool + val doc : string + val read : unit -> t + val write : t -> unit + val to_bool : t -> bool + val of_bool : bool -> t + val to_int : t -> int + val of_int : int -> t + val to_string : t -> string + val of_string : string -> t + +end = struct + + type t = bool + + let doc = "Correct wave function to verify electron-nucleus cusp condition" + + let of_bool x = x + + let to_bool x = x + + let read () = + let _ = + Lazy.force Qputils.ezfio_filename + in + if (not (Ezfio.has_simulation_do_nucl_fitcusp ())) then + Ezfio.set_simulation_do_nucl_fitcusp Default.simulation_do_nucl_fitcusp; + Ezfio.get_simulation_do_nucl_fitcusp () + |> of_bool + + + let write t = + let _ = + Lazy.force Qputils.ezfio_filename + in + let () = + match (Pseudo.read () |> Pseudo.to_bool, to_bool t) with + | (true, true) -> failwith "Pseudopotentials and Fitcusp are incompatible" + | _ -> () + in + to_bool t + |> Ezfio.set_simulation_do_nucl_fitcusp + + + let to_string t = + to_bool t + |> Bool.to_string + + + let of_string t = + try + String.lowercase t + |> Bool.of_string + |> of_bool + with + | Invalid_argument msg -> failwith msg + + + let to_int t = + let t = + to_bool t + in + if t then 1 + else 0 + + + let of_int = function + | 0 -> false + | 1 -> true + | _ -> failwith "Expected 0 or 1" + + +end + +module Block_time : sig + + type t = int + val doc : string + val read : unit -> t + val write : t -> unit + val to_int : t -> int + val of_int : int -> t + val to_string : t -> string + val of_string : string -> t + val to_float : t -> float + val of_float : float-> t + +end = struct + + type t = int + + let doc = "Length (seconds) of a block" + + let of_int x = + if (x < 1) then + failwith "Block time should be >=1"; + if (x > 36000) then + failwith "Block time is too large (<= 36000)"; + x + + + let to_int x = x + + let read () = + let _ = + Lazy.force Qputils.ezfio_filename + in + if (not (Ezfio.has_simulation_block_time ())) then + Ezfio.set_simulation_block_time Default.simulation_block_time; + Ezfio.get_simulation_block_time () + |> of_int + + + let write t = + let _ = + Lazy.force Qputils.ezfio_filename + in + to_int t + |> Ezfio.set_simulation_block_time + + + let to_string t = + to_int t + |> Int.to_string + + + let of_string t = + Int.of_string t + |> of_int + + + let to_float t = + to_int t + |> Float.of_int + + + let of_float t = + Int.of_float t + |> of_int + + +end + +module Walk_num : sig + + type t = int + val doc : string + val read : unit -> t + val write : t -> unit + val to_int : t -> int + val of_int : int -> t + val to_string : t -> string + val of_string : string -> t + +end = struct + + type t = int + let doc = "Number of walkers per CPU core" + + let of_int x = + if (x < 1) then + failwith "Number of walkers should be >=1"; + if (x > 100_000) then + failwith "Number of walkers is too large (<= 100_000)"; + x + + + let to_int x = x + + let read () = + let _ = + Lazy.force Qputils.ezfio_filename + in + if (not (Ezfio.has_electrons_elec_walk_num () )) then + Ezfio.set_electrons_elec_walk_num Default.electrons_elec_walk_num; + Ezfio.get_electrons_elec_walk_num () + |> of_int + + + let write t = + let _ = + Lazy.force Qputils.ezfio_filename + in + to_int t + |> Ezfio.set_electrons_elec_walk_num + + + let to_string t = + to_int t + |> Int.to_string + + + let of_string t = + Int.of_string t + |> of_int + + +end + +module Walk_num_tot : sig + + type t = int + val doc : string + val read : unit -> t + val write : t -> unit + val to_int : t -> int + val of_int : int -> t + val to_string : t -> string + val of_string : string -> t + +end = struct + + type t = int + let doc = "Total number of stored walkers for restart" + + let of_int x = + if (x < 2) then + failwith "Total number of stored walkers should be > 1"; + if (x > 100_000_000) then + failwith "Number of walkers to store too large (<= 100.10^6)"; + x + + + let to_int x = x + + let read () = + let _ = + Lazy.force Qputils.ezfio_filename + in + if (not (Ezfio.has_electrons_elec_walk_num_tot () )) then + Ezfio.set_electrons_elec_walk_num_tot Default.electrons_elec_walk_num_tot; + Ezfio.get_electrons_elec_walk_num_tot () + |> of_int + + + let write t = + let _ = + Lazy.force Qputils.ezfio_filename + in + to_int t + |> Ezfio.set_electrons_elec_walk_num_tot + + + let to_string t = + to_int t + |> Int.to_string + + + let of_string t = + Int.of_string t + |> of_int + + +end + + +module Stop_time : sig + + type t = int + val read : unit -> t + val doc : string + val write : t -> unit + val to_int : t -> int + val of_int : int -> t + val to_float : t -> float + val of_float : float -> t + val to_string : t -> string + val of_string : string -> t + +end = struct + + type t = int + + let doc = "Requested simulation time (seconds)" + + let of_int x = + if (x < 1) then + failwith "Simulation time too short (>=1 s)"; + x + + + let to_int x = x + + let read () = + let _ = + Lazy.force Qputils.ezfio_filename + in + if (not (Ezfio.has_simulation_stop_time ())) then + Ezfio.set_simulation_stop_time Default.simulation_stop_time; + Ezfio.get_simulation_stop_time () + |> of_int + + + let write t = + let _ = + Lazy.force Qputils.ezfio_filename + in + to_int t + |> Ezfio.set_simulation_stop_time + + + let to_string t = + to_int t + |> Int.to_string + + + let of_string t = + Int.of_string t + |> of_int + + + let to_float t = + to_int t + |> Float.of_int + + + let of_float t = + Int.of_float t + |> of_int + +end + + + +module Method : sig + + type t = VMC | DMC + val doc : string + val read : unit -> t + val write : t -> unit + val to_string : t -> string + val of_string : string -> t + +end = struct + + type t = VMC | DMC + + let doc = "QMC Method : [ VMC | DMC ]" + + let of_string = function + | "VMC" | "vmc" -> VMC + | "DMC" | "dmc" -> DMC + | x -> failwith ("Method should be [ VMC | DMC ], not "^x^".") + + + let to_string = function + | VMC -> "VMC" + | DMC -> "DMC" + + + let read () = + let _ = + Lazy.force Qputils.ezfio_filename + in + if (not (Ezfio.has_simulation_method ())) then + Ezfio.set_simulation_method Default.simulation_method; + Ezfio.get_simulation_method () + |> of_string + + + let write t = + let _ = + Lazy.force Qputils.ezfio_filename + in + to_string t + |> Ezfio.set_simulation_method + + +end + + + +module Sampling : sig + + type t = Brownian | Langevin + val doc : string + val read : unit -> t + val write : t -> unit + val to_string : t -> string + val of_string : string -> t + +end = struct + + type t = Brownian | Langevin + + let doc = "Sampling algorithm : [ Langevin | Brownian ]" + + let of_string s = + match String.capitalize (String.strip s) with + | "Langevin" -> Langevin + | "Brownian" -> Brownian + | x -> failwith ("Sampling should be [ Brownian | Langevin ], not "^x^".") + + + let to_string = function + | Langevin -> "Langevin" + | Brownian -> "Brownian" + + + let read () = + let _ = + Lazy.force Qputils.ezfio_filename + in + if (not (Ezfio.has_simulation_sampling ())) then + Ezfio.set_simulation_sampling Default.simulation_sampling; + Ezfio.get_simulation_sampling () + |> of_string + + + let write t = + let _ = + Lazy.force Qputils.ezfio_filename + in + to_string t + |> Ezfio.set_simulation_sampling + + +end + + + +module Ref_energy : sig + + type t = float + val doc : string + val read : unit -> t + val write : t -> unit + val to_float : t -> float + val of_float : float -> t + val to_string : t -> string + val of_string : string -> t + +end = struct + + type t = float + let doc = "Fixed reference energy to normalize DMC weights" + + let of_float x = + if (x > 0.) then + failwith "Reference energy should not be positive."; + if (x <= -1_000_000.) then + failwith "Reference energy is too low."; + x + + + let to_float x = x + + let read () = + let _ = + Lazy.force Qputils.ezfio_filename + in + if (not (Ezfio.has_simulation_e_ref ())) then + to_float 0. + |> Ezfio.set_simulation_e_ref; + Ezfio.get_simulation_e_ref () + |> of_float + + + let write t = + let _ = + Lazy.force Qputils.ezfio_filename + in + to_float t + |> Ezfio.set_simulation_e_ref + + + let of_string x = + Float.of_string x + |> of_float + + + let to_string x = + to_float x + |> Float.to_string + + +end + + +module CI_threshold : sig + + type t = float + val doc : string + val read : unit -> t + val write : t -> unit + val to_float : t -> float + val of_float : float -> t + val to_string : t -> string + val of_string : string -> t + +end = struct + + type t = float + let doc = "Truncation t of the wave function : Remove determinants with a +contribution to the norm less than t" + + let of_float x = + if (x >= 1.) then + failwith "Truncation of the wave function should be < 1."; + if (x < 0.) then + failwith "Truncation of the wave function should be positive."; + x + + + let to_float x = x + + let read () = + let _ = + Lazy.force Qputils.ezfio_filename + in + if (not (Ezfio.has_simulation_ci_threshold ())) then + Ezfio.set_simulation_ci_threshold Default.simulation_ci_threshold ; + Ezfio.get_simulation_ci_threshold () + |> of_float + + + let write t = + let _ = + Lazy.force Qputils.ezfio_filename + in + to_float t + |> Ezfio.set_simulation_ci_threshold + + + let of_string x = + Float.of_string x + |> of_float + + + let to_string x = + to_float x + |> Float.to_string + +end + +module Time_step : sig + + type t = float + val doc : string + val read : unit -> t + val write : t -> unit + val to_float : t -> float + val of_float : float -> t + val to_string : t -> string + val of_string : string -> t + +end = struct + + type t = float + let doc = "Simulation time step" + + let of_float x = + if (x >= 10.) then + failwith "Time step should be < 10."; + if (x <= 0.) then + failwith "Time step should be positive."; + x + + + let to_float x = x + + let read () = + let _ = + Lazy.force Qputils.ezfio_filename + in + if (not (Ezfio.has_simulation_time_step ())) then + Ezfio.set_simulation_time_step Default.simulation_time_step; + Ezfio.get_simulation_time_step () + |> of_float + + + let write t = + let _ = + Lazy.force Qputils.ezfio_filename + in + to_float t + |> Ezfio.set_simulation_time_step + + + let of_string x = + Float.of_string x + |> of_float + + + let to_string x = + to_float x + |> Float.to_string + +end + +module Jastrow_type : sig + + type t = None | Core | Simple + val doc : string + val read : unit -> t + val write : t -> unit + val to_string : t -> string + val of_string : string -> t + +end = struct + + type t = None | Core | Simple + let doc = "Type of Jastrow factor [ None | Core | Simple ]" + + let of_string s = + match String.capitalize (String.strip s) with + | "Core" -> Core + | "Simple" -> Simple + | "None" -> None + | _ -> failwith "Jastrow type should be [ None | Core | Simple ]" + + + let to_string = function + | Core -> "Core" + | Simple -> "Simple" + | None -> "None" + + + let read () = + let _ = + Lazy.force Qputils.ezfio_filename + in + if (not (Ezfio.has_jastrow_jast_type ())) then + Ezfio.set_jastrow_jast_type Default.jastrow_jast_type; + Ezfio.get_jastrow_jast_type (); + |> of_string + + + let write t = + let _ = + Lazy.force Qputils.ezfio_filename + in + let () = + match (Pseudo.read () |> Pseudo.to_bool, t) with + | (false, _) + | (true , None) -> () + | _ -> failwith "Jastrow and Pseudopotentials are incompatible" + in + + to_string t + |> Ezfio.set_jastrow_jast_type + + +end + +module Properties: sig + + type t = (Property.t * bool) list + val doc : string + val read : unit -> t + val write : t -> unit + val to_string : t -> string + val of_string : string -> t + +end = struct + + type t = (Property.t * bool) list + + let doc = + "Properties to sample. (X) is true and ( ) is false" + + + let read () = + List.map Property.all ~f:(fun x -> (x, Property.calc x)) + + + let write l = + List.iter l ~f:(fun (x,b) -> Property.set_calc x b) + + + let to_string l = + List.map l ~f:(fun (x,b) -> + let ch = + if b then "X" else " " + in + Printf.sprintf "(%s) %s" ch (Property.to_string x)) + |> String.concat ~sep:"\n" + + + let of_string s = + String.split s ~on:'\n' + |> List.map ~f:(fun x -> + let (calc,prop) = + String.strip x + |> String.rsplit2_exn ~on:' ' + in + let prop = + String.strip prop + |> Property.of_string + and calc = + match calc with + | "(X)" -> true + | "( )" -> false + | _ -> failwith " (X) or ( ) expected" + in + (prop, calc) + ) + +end + +(** Check if everything is correct in the input file. *) +let validate () = + + let _ = + Lazy.force Qputils.ezfio_filename + in + + (* Check if walkers are present *) + if (not (Ezfio.has_electrons_elec_coord_pool ())) then + Printf.printf "Warning: No initial walkers\n"; + + let meth = + Method.read () + and sampling = + Sampling.read () + and ts = + Time_step.read () + and jast_type = + Jastrow_type.read () + and do_fitcusp = + Fitcusp.read () + and do_pseudo = + Pseudo.read () + in + + (* Check sampling and time steps *) + let () = + match (sampling, meth, Pseudo.to_bool do_pseudo) with + | (Sampling.Brownian, Method.DMC, true) -> + if ( (Time_step.to_float ts) >= 0.5 ) then + warn "Time step seems large for DMC."; + | (Sampling.Brownian, Method.DMC, false) -> + if ( (Time_step.to_float ts) >= 0.01 ) then + warn "Time step seems large for DMC."; + | (Sampling.Brownian, Method.VMC, _) -> + if ( (Time_step.to_float ts) >= 10. ) then + warn "Time step seems large for VMC."; + | (Sampling.Langevin, Method.VMC, _) -> + if ( (Time_step.to_float ts) <= 0.01 ) then + warn "Time step seems small for Langevin sampling." + | (Sampling.Langevin, Method.DMC, _) -> + failwith "Lanvegin sampling is incompatible with DMC" + in + + + (* Check E_ref is not zero *) + let () = + match (meth, Ref_energy.(read () |> to_float) ) with + | (Method.DMC,0.) -> failwith "E_ref should not be zero in DMC" + | _ -> () + in + + (* Set block and total time*) + let () = + if ( (Block_time.read ()) > Stop_time.read ()) then + failwith "Block time is longer than total time" + in + + (* Check if E_loc if computed *) + let () = + match (meth, Property.(calc E_loc)) with + | (Method.DMC, false) -> failwith "E_loc should be sampled in DMC" + | (Method.VMC, false) -> warn "Sampling of E_loc is not activated in input" + | _ -> () + in + + (* Pseudo and Jastrow are incompatible *) + let () = + match (Pseudo.to_bool do_pseudo, jast_type) with + | (true, Jastrow_type.Core ) + | (true, Jastrow_type.Simple) -> failwith "Jastrow and Pseudopotentials are incompatible" + | _ -> () + in + + (* Fitcusp is not recommended with pseudo *) + let () = + match (Pseudo.to_bool do_pseudo, Fitcusp.to_bool do_fitcusp) with + | (true, true) -> warn "Fitcusp is incompatible with Pseudopotentials" + | _ -> () + in + + (* Other Checks *) + let () = + let _ = + Walk_num.read () + and _ = + Walk_num_tot.read () + and _ = + CI_threshold.read () + in () + in + () + + + diff --git a/ocaml/Launcher.ml b/ocaml/Launcher.ml new file mode 100644 index 0000000..4b9de5a --- /dev/null +++ b/ocaml/Launcher.ml @@ -0,0 +1,79 @@ +open Core.Std;; + +type t = + | Srun + | MPI + | Bash + +let to_string = function + | Srun -> "srun" + | Bash -> "env" + | MPI -> Lazy.force Qmcchem_config.mpirun + + +(** Find the launcher for the current job scheduler *) +let find () = + + let result = + match Scheduler.find () with + | Scheduler.SLURM -> Srun + | Scheduler.Batch + | Scheduler.PBS + | Scheduler.SGE -> + if Lazy.force Qmcchem_config.has_mpirun then + MPI + else + Bash + in + result + + +(** Create a file contaning the list of nodes and the number of available CPUs *) +let create_nodefile () = + + let launcher = + find () + in + + let launcher_command = + to_string launcher + in + + let h = + Hashtbl.create ~hashable:String.hashable ~size:1000 () + in + + let in_channel = + Unix.open_process_in (launcher_command^" hostname -s") + in + In_channel.input_lines in_channel + |> List.map ~f:String.strip + |> List.iter ~f:( fun host -> + Hashtbl.change h host (function + | Some x -> Some (x+1) + | None -> Some 1 + ) + ); + match + Unix.close_process_in in_channel + with + | _ -> (); + + + let f = + match launcher with + | MPI -> + fun (node, n) -> + Printf.sprintf "%s slots=%d\n" node n + | Srun + | Bash -> + fun (node, n) -> + Printf.sprintf "%s %d\n" node n + in + Hashtbl.to_alist h + |> List.map ~f + |> String.concat + + + + diff --git a/ocaml/Md5.ml b/ocaml/Md5.ml new file mode 100644 index 0000000..54afbca --- /dev/null +++ b/ocaml/Md5.ml @@ -0,0 +1,143 @@ +open Core.Std + +(** Directory containing the list of input files. The directory is created is inexistant. *) +let input_directory = lazy ( + + let ezfio_filename = + Lazy.force Qputils.ezfio_filename + in + + let dirname = + Filename.concat ezfio_filename "input" + in + + begin + match ( Sys.is_directory dirname ) with + | `No -> Unix.mkdir dirname + | _ -> () + end ; + + dirname +) + + +(** List of files responsible for the MD5 key of the input *) +let files_to_track = [ + "ao_basis/ao_coef.gz" ; + "ao_basis/ao_expo.gz" ; + "ao_basis/ao_nucl.gz" ; + "ao_basis/ao_num" ; + "ao_basis/ao_power.gz" ; + "ao_basis/ao_prim_num.gz" ; + "electrons/elec_alpha_num" ; + "electrons/elec_beta_num" ; + "jastrow/jast_type" ; + "mo_basis/mo_coef.gz" ; + "mo_basis/mo_tot_num" ; + "nuclei/nucl_charge.gz" ; + "nuclei/nucl_coord.gz" ; + "nuclei/nucl_fitcusp_radius.gz" ; + "nuclei/nucl_num" ; + "simulation/ci_threshold" ; + "simulation/do_nucl_fitcusp" ; + "simulation/jast_a_up_dn" ; + "simulation/jast_a_up_up" ; + "simulation/jast_b_up_dn" ; + "simulation/jast_b_up_up" ; + "simulation/jast_core_a1" ; + "simulation/jast_core_a2" ; + "simulation/jast_core_b1" ; + "simulation/jast_core_b2" ; + "simulation/jast_een_e_a.gz" ; + "simulation/jast_een_e_b.gz" ; + "simulation/jast_een_n.gz" ; + "simulation/jast_pen.gz" ; + "simulation/method" ; + "simulation/time_step" ; + "spindeterminants/bit_kind" ; + "spindeterminants/n_det" ; + "spindeterminants/n_det_alpha" ; + "spindeterminants/n_det_beta" ; + "spindeterminants/n_int" ; + "spindeterminants/n_states" ; + "spindeterminants/psi_coef_matrix_columns.gz" ; + "spindeterminants/psi_coef_matrix_rows.gz" ; + "spindeterminants/psi_coef_matrix_values.gz" ; + "spindeterminants/psi_det_alpha.gz" ; + "spindeterminants/psi_det_beta.gz" ; + "/pseudo/do_pseudo" ; + "/pseudo/mo_pseudo_grid.gz" ; + "/pseudo/pseudo_dz_kl.gz"; + "/pseudo/pseudo_klocmax" ; + "/pseudo/pseudo_n_k.gz" ; + "/pseudo/pseudo_v_kl.gz" ; + "/pseudo/pseudo_grid_rmax" ; + "/pseudo/pseudo_kmax" ; + "/pseudo/pseudo_n_kl.gz" ; + "/pseudo/pseudo_dz_k.gz" ; + "/pseudo/pseudo_grid_size" ; + "/pseudo/pseudo_v_k.gz" ; + ] + + +(** Get an MD5 ke from the content of a file. *) +let hash_file filename = + match Sys.is_file filename with + | `Yes -> + begin + In_channel.with_file filename ~f:(fun ic -> + Cryptokit.hash_channel (Cryptokit.Hash.md5 ()) ic + |> Cryptokit.transform_string (Cryptokit.Hexa.encode ()) ) + end + | _ -> "" + + +(** Cache containing the current value of the MD5 hash. *) +let _hash = + ref None + +(** Get the hash correcponding to the EZFIO file. *) +let hash () = + let compute_hash () = + let ezfio_filename = + Lazy.force Qputils.ezfio_filename + in + let old_md5 = + if Ezfio.has_simulation_md5_key () then + Ezfio.get_simulation_md5_key () + else + "" + in + let new_md5 = files_to_track + |> List.map ~f:(fun x -> Printf.sprintf "%s/%s" ezfio_filename x) + |> List.map ~f:hash_file + |> String.concat + |> Cryptokit.hash_string (Cryptokit.Hash.md5 ()) + |> Cryptokit.transform_string (Cryptokit.Hexa.encode ()) + in + if (new_md5 <> old_md5) then + begin + Printf.eprintf "Info : MD5 key changed\n %s\n-> %s\n%!" old_md5 new_md5 ; + Ezfio.set_simulation_md5_key new_md5 + end + ; + new_md5 + in + match (!_hash) with + | Some key -> key + | None -> + begin + let key = + compute_hash () + in + _hash := Some key ; + key + end + +(** Reset the cache of the MD5 hash. *) +let reset_hash () = + _hash := None; + ignore (hash ()) + + + diff --git a/ocaml/Message.ml b/ocaml/Message.ml new file mode 100644 index 0000000..397f004 --- /dev/null +++ b/ocaml/Message.ml @@ -0,0 +1,126 @@ +open Core.Std +open Qptypes + +type t = +| Property of Block.t +| Walkers of Compute_node.t * Pid.t * (float array) array +| Register of Compute_node.t * Pid.t +| Unregister of Compute_node.t * Pid.t +| Test +| GetWalkers of Strictly_positive_int.t +| Ezfio of string + + +let create = function + | [ "cpu" ; c ; pid ; b ; "1" ; v ] -> + let open Block in + Property + { property = Property.Cpu; + value = Sample.of_float (Float.of_string v) ; + weight = Weight.of_float 1.; + compute_node = Compute_node.of_string c; + pid = Pid.of_string pid; + block_id = Block_id.of_int (Int.of_string b); + } + | [ "accep" ; c ; pid ; b ; "1" ; v ] -> + let open Block in + Property + { property = Property.Accep; + value = Sample.of_float (Float.of_string v) ; + weight = Weight.of_float 1.; + compute_node = Compute_node.of_string c; + pid = Pid.of_string pid; + block_id = Block_id.of_int (Int.of_string b); + } + | [ prop ; c ; pid ; b ; w ; v ] -> + let open Block in + Property + { property = Property.of_string prop; + value = Sample.of_float (Float.of_string v); + weight = Weight.of_float (Float.of_string w); + compute_node = Compute_node.of_string c; + pid = Pid.of_string pid; + block_id = Block_id.of_int (Int.of_string b); + } + | "elec_coord" :: c :: pid :: _ :: n ::walkers -> + begin + let walk_num = + Lazy.force Qputils.walk_num + and elec_num = + Lazy.force Qputils.elec_num + and n = + Int.of_string n + in + assert (n = List.length walkers); + assert (n = walk_num*(elec_num+1)*3); + let rec build_walker accu = function + | (0,tail) -> + let result = + List.rev accu + |> List.map ~f:Float.of_string + |> Array.of_list + in + (result, tail) + | (n,head::tail) -> + build_walker (head::accu) (n-1, tail) + | _ -> failwith "Bad walkers" + in + let rec build accu = function + | [] -> Array.of_list accu + | w -> + let (result, tail) = + build_walker [] (3*elec_num+3, w) + in + build (result::accu) tail + in + Walkers (Compute_node.of_string c, Pid.of_string pid, build [] walkers) + end + | [ "get_walkers" ; n ] -> GetWalkers (n |> Int.of_string |> Strictly_positive_int.of_int) + | [ "register" ; c ; pid ] -> Register (Compute_node.of_string c, Pid.of_string pid) + | [ "unregister" ; c ; pid ] -> Unregister (Compute_node.of_string c, Pid.of_string pid) + | [ "Test" ] -> Test + | [ "Ezfio" ; ezfio_msg ] -> Ezfio ezfio_msg + | prop :: c :: pid :: b :: d :: w :: l -> + let property = + Property.of_string prop + in + begin + assert (not (Property.is_scalar property)); + let a = + Array.of_list l + |> Array.map ~f:Float.of_string + and dim = + Int.of_string d + in + assert (Array.length a = dim); + let open Block in + Property + { property = property ; + value = Sample.of_float_array ~dim a; + weight = Weight.of_float (Float.of_string w); + compute_node = Compute_node.of_string c; + pid = Pid.of_string pid; + block_id = Block_id.of_int (Int.of_string b); + } + end + | l -> + begin + List.iter ~f:(Printf.printf ":%s:") l; + failwith "Message not understood" + end + + +let to_string = function + | Property b -> "Property : "^(Block.to_string b) + | Walkers (h,p,w) -> Printf.sprintf "Walkers : %s %s : %d walkers" + (Compute_node.to_string h) (Pid.to_string p) + (Array.length w) + | GetWalkers n -> Printf.sprintf "GetWalkers %d" (Strictly_positive_int.to_int n) + | Register (h,p) -> Printf.sprintf "Register : %s %s" + (Compute_node.to_string h) (Pid.to_string p) + | Unregister (h,p) -> Printf.sprintf "Unregister : %s %s" + (Compute_node.to_string h) (Pid.to_string p) + | Test -> "Test" + | Ezfio msg -> "Ezfio "^msg + + diff --git a/ocaml/Property.ml b/ocaml/Property.ml new file mode 100644 index 0000000..f71daad --- /dev/null +++ b/ocaml/Property.ml @@ -0,0 +1,629 @@ + +(* File generated by ${QMCCHEM_PATH}/src/create_properties.py. Do not + modify here + *) + +type t = +| Cpu +| Wall +| Accep +| D_var_jast_a_up_dn +| D_var_jast_a_up_up +| D_var_jast_b_up_dn +| D_var_jast_b_up_up +| D_var_jast_core_a1 +| D_var_jast_core_b1 +| D_var_jast_een_e_a +| D_var_jast_een_e_b +| D_var_jast_een_n +| D_var_jast_pen +| Density1d +| Dipole +| Drift_mod +| E_kin +| E_loc +| E_loc_one +| E_loc_per_electron +| E_loc_split_core +| E_loc_two +| E_nucl +| E_pot +| E_pot_one +| N_s_inverted +| N_s_updated +| N_s_updates +| Voronoi_charges +| Voronoi_charges_covariance +| Voronoi_dipoles +| Wf_extension +| D_var_jast_a_up_dn_qmcvar +| D_var_jast_a_up_up_qmcvar +| D_var_jast_b_up_dn_qmcvar +| D_var_jast_b_up_up_qmcvar +| D_var_jast_core_a1_qmcvar +| D_var_jast_core_b1_qmcvar +| D_var_jast_een_e_a_qmcvar +| D_var_jast_een_e_b_qmcvar +| D_var_jast_een_n_qmcvar +| D_var_jast_pen_qmcvar +| Density1d_qmcvar +| Dipole_qmcvar +| Drift_mod_qmcvar +| E_kin_qmcvar +| E_loc_qmcvar +| E_loc_one_qmcvar +| E_loc_per_electron_qmcvar +| E_loc_split_core_qmcvar +| E_loc_two_qmcvar +| E_nucl_qmcvar +| E_pot_qmcvar +| E_pot_one_qmcvar +| N_s_inverted_qmcvar +| N_s_updated_qmcvar +| N_s_updates_qmcvar +| Voronoi_charges_qmcvar +| Voronoi_charges_covariance_qmcvar +| Voronoi_dipoles_qmcvar +| Wf_extension_qmcvar +;; + +let calc = function +| Cpu +| Wall +| Accep -> true +| D_var_jast_a_up_dn +| D_var_jast_a_up_dn_qmcvar -> + begin + if (Ezfio.has_properties_d_var_jast_a_up_dn ()) then + Ezfio.get_properties_d_var_jast_a_up_dn () + else + false + end + +| D_var_jast_a_up_up +| D_var_jast_a_up_up_qmcvar -> + begin + if (Ezfio.has_properties_d_var_jast_a_up_up ()) then + Ezfio.get_properties_d_var_jast_a_up_up () + else + false + end + +| D_var_jast_b_up_dn +| D_var_jast_b_up_dn_qmcvar -> + begin + if (Ezfio.has_properties_d_var_jast_b_up_dn ()) then + Ezfio.get_properties_d_var_jast_b_up_dn () + else + false + end + +| D_var_jast_b_up_up +| D_var_jast_b_up_up_qmcvar -> + begin + if (Ezfio.has_properties_d_var_jast_b_up_up ()) then + Ezfio.get_properties_d_var_jast_b_up_up () + else + false + end + +| D_var_jast_core_a1 +| D_var_jast_core_a1_qmcvar -> + begin + if (Ezfio.has_properties_d_var_jast_core_a1 ()) then + Ezfio.get_properties_d_var_jast_core_a1 () + else + false + end + +| D_var_jast_core_b1 +| D_var_jast_core_b1_qmcvar -> + begin + if (Ezfio.has_properties_d_var_jast_core_b1 ()) then + Ezfio.get_properties_d_var_jast_core_b1 () + else + false + end + +| D_var_jast_een_e_a +| D_var_jast_een_e_a_qmcvar -> + begin + if (Ezfio.has_properties_d_var_jast_een_e_a ()) then + Ezfio.get_properties_d_var_jast_een_e_a () + else + false + end + +| D_var_jast_een_e_b +| D_var_jast_een_e_b_qmcvar -> + begin + if (Ezfio.has_properties_d_var_jast_een_e_b ()) then + Ezfio.get_properties_d_var_jast_een_e_b () + else + false + end + +| D_var_jast_een_n +| D_var_jast_een_n_qmcvar -> + begin + if (Ezfio.has_properties_d_var_jast_een_n ()) then + Ezfio.get_properties_d_var_jast_een_n () + else + false + end + +| D_var_jast_pen +| D_var_jast_pen_qmcvar -> + begin + if (Ezfio.has_properties_d_var_jast_pen ()) then + Ezfio.get_properties_d_var_jast_pen () + else + false + end + +| Density1d +| Density1d_qmcvar -> + begin + if (Ezfio.has_properties_density1d ()) then + Ezfio.get_properties_density1d () + else + false + end + +| Dipole +| Dipole_qmcvar -> + begin + if (Ezfio.has_properties_dipole ()) then + Ezfio.get_properties_dipole () + else + false + end + +| Drift_mod +| Drift_mod_qmcvar -> + begin + if (Ezfio.has_properties_drift_mod ()) then + Ezfio.get_properties_drift_mod () + else + false + end + +| E_kin +| E_kin_qmcvar -> + begin + if (Ezfio.has_properties_e_kin ()) then + Ezfio.get_properties_e_kin () + else + false + end + +| E_loc +| E_loc_qmcvar -> + begin + if (Ezfio.has_properties_e_loc ()) then + Ezfio.get_properties_e_loc () + else + true + end + +| E_loc_one +| E_loc_one_qmcvar -> + begin + if (Ezfio.has_properties_e_loc_one ()) then + Ezfio.get_properties_e_loc_one () + else + false + end + +| E_loc_per_electron +| E_loc_per_electron_qmcvar -> + begin + if (Ezfio.has_properties_e_loc_per_electron ()) then + Ezfio.get_properties_e_loc_per_electron () + else + false + end + +| E_loc_split_core +| E_loc_split_core_qmcvar -> + begin + if (Ezfio.has_properties_e_loc_split_core ()) then + Ezfio.get_properties_e_loc_split_core () + else + false + end + +| E_loc_two +| E_loc_two_qmcvar -> + begin + if (Ezfio.has_properties_e_loc_two ()) then + Ezfio.get_properties_e_loc_two () + else + false + end + +| E_nucl +| E_nucl_qmcvar -> + begin + if (Ezfio.has_properties_e_nucl ()) then + Ezfio.get_properties_e_nucl () + else + false + end + +| E_pot +| E_pot_qmcvar -> + begin + if (Ezfio.has_properties_e_pot ()) then + Ezfio.get_properties_e_pot () + else + false + end + +| E_pot_one +| E_pot_one_qmcvar -> + begin + if (Ezfio.has_properties_e_pot_one ()) then + Ezfio.get_properties_e_pot_one () + else + false + end + +| N_s_inverted +| N_s_inverted_qmcvar -> + begin + if (Ezfio.has_properties_n_s_inverted ()) then + Ezfio.get_properties_n_s_inverted () + else + false + end + +| N_s_updated +| N_s_updated_qmcvar -> + begin + if (Ezfio.has_properties_n_s_updated ()) then + Ezfio.get_properties_n_s_updated () + else + false + end + +| N_s_updates +| N_s_updates_qmcvar -> + begin + if (Ezfio.has_properties_n_s_updates ()) then + Ezfio.get_properties_n_s_updates () + else + false + end + +| Voronoi_charges +| Voronoi_charges_qmcvar -> + begin + if (Ezfio.has_properties_voronoi_charges ()) then + Ezfio.get_properties_voronoi_charges () + else + false + end + +| Voronoi_charges_covariance +| Voronoi_charges_covariance_qmcvar -> + begin + if (Ezfio.has_properties_voronoi_charges_covariance ()) then + Ezfio.get_properties_voronoi_charges_covariance () + else + false + end + +| Voronoi_dipoles +| Voronoi_dipoles_qmcvar -> + begin + if (Ezfio.has_properties_voronoi_dipoles ()) then + Ezfio.get_properties_voronoi_dipoles () + else + false + end + +| Wf_extension +| Wf_extension_qmcvar -> + begin + if (Ezfio.has_properties_wf_extension ()) then + Ezfio.get_properties_wf_extension () + else + false + end + +;; + +let u _ = ();; + +let set_calc = function +| Cpu +| Wall +| Accep -> u +| D_var_jast_a_up_dn +| D_var_jast_a_up_dn_qmcvar -> + Ezfio.set_properties_d_var_jast_a_up_dn + +| D_var_jast_a_up_up +| D_var_jast_a_up_up_qmcvar -> + Ezfio.set_properties_d_var_jast_a_up_up + +| D_var_jast_b_up_dn +| D_var_jast_b_up_dn_qmcvar -> + Ezfio.set_properties_d_var_jast_b_up_dn + +| D_var_jast_b_up_up +| D_var_jast_b_up_up_qmcvar -> + Ezfio.set_properties_d_var_jast_b_up_up + +| D_var_jast_core_a1 +| D_var_jast_core_a1_qmcvar -> + Ezfio.set_properties_d_var_jast_core_a1 + +| D_var_jast_core_b1 +| D_var_jast_core_b1_qmcvar -> + Ezfio.set_properties_d_var_jast_core_b1 + +| D_var_jast_een_e_a +| D_var_jast_een_e_a_qmcvar -> + Ezfio.set_properties_d_var_jast_een_e_a + +| D_var_jast_een_e_b +| D_var_jast_een_e_b_qmcvar -> + Ezfio.set_properties_d_var_jast_een_e_b + +| D_var_jast_een_n +| D_var_jast_een_n_qmcvar -> + Ezfio.set_properties_d_var_jast_een_n + +| D_var_jast_pen +| D_var_jast_pen_qmcvar -> + Ezfio.set_properties_d_var_jast_pen + +| Density1d +| Density1d_qmcvar -> + Ezfio.set_properties_density1d + +| Dipole +| Dipole_qmcvar -> + Ezfio.set_properties_dipole + +| Drift_mod +| Drift_mod_qmcvar -> + Ezfio.set_properties_drift_mod + +| E_kin +| E_kin_qmcvar -> + Ezfio.set_properties_e_kin + +| E_loc +| E_loc_qmcvar -> + Ezfio.set_properties_e_loc + +| E_loc_one +| E_loc_one_qmcvar -> + Ezfio.set_properties_e_loc_one + +| E_loc_per_electron +| E_loc_per_electron_qmcvar -> + Ezfio.set_properties_e_loc_per_electron + +| E_loc_split_core +| E_loc_split_core_qmcvar -> + Ezfio.set_properties_e_loc_split_core + +| E_loc_two +| E_loc_two_qmcvar -> + Ezfio.set_properties_e_loc_two + +| E_nucl +| E_nucl_qmcvar -> + Ezfio.set_properties_e_nucl + +| E_pot +| E_pot_qmcvar -> + Ezfio.set_properties_e_pot + +| E_pot_one +| E_pot_one_qmcvar -> + Ezfio.set_properties_e_pot_one + +| N_s_inverted +| N_s_inverted_qmcvar -> + Ezfio.set_properties_n_s_inverted + +| N_s_updated +| N_s_updated_qmcvar -> + Ezfio.set_properties_n_s_updated + +| N_s_updates +| N_s_updates_qmcvar -> + Ezfio.set_properties_n_s_updates + +| Voronoi_charges +| Voronoi_charges_qmcvar -> + Ezfio.set_properties_voronoi_charges + +| Voronoi_charges_covariance +| Voronoi_charges_covariance_qmcvar -> + Ezfio.set_properties_voronoi_charges_covariance + +| Voronoi_dipoles +| Voronoi_dipoles_qmcvar -> + Ezfio.set_properties_voronoi_dipoles + +| Wf_extension +| Wf_extension_qmcvar -> + Ezfio.set_properties_wf_extension + +;; + +let of_string s = + match (String.lowercase s) with + | "cpu" -> Cpu + | "wall" -> Wall + | "accep" -> Accep + | "d_var_jast_a_up_dn" -> D_var_jast_a_up_dn + | "d_var_jast_a_up_up" -> D_var_jast_a_up_up + | "d_var_jast_b_up_dn" -> D_var_jast_b_up_dn + | "d_var_jast_b_up_up" -> D_var_jast_b_up_up + | "d_var_jast_core_a1" -> D_var_jast_core_a1 + | "d_var_jast_core_b1" -> D_var_jast_core_b1 + | "d_var_jast_een_e_a" -> D_var_jast_een_e_a + | "d_var_jast_een_e_b" -> D_var_jast_een_e_b + | "d_var_jast_een_n" -> D_var_jast_een_n + | "d_var_jast_pen" -> D_var_jast_pen + | "density1d" -> Density1d + | "dipole" -> Dipole + | "drift_mod" -> Drift_mod + | "e_kin" -> E_kin + | "e_loc" -> E_loc + | "e_loc_one" -> E_loc_one + | "e_loc_per_electron" -> E_loc_per_electron + | "e_loc_split_core" -> E_loc_split_core + | "e_loc_two" -> E_loc_two + | "e_nucl" -> E_nucl + | "e_pot" -> E_pot + | "e_pot_one" -> E_pot_one + | "n_s_inverted" -> N_s_inverted + | "n_s_updated" -> N_s_updated + | "n_s_updates" -> N_s_updates + | "voronoi_charges" -> Voronoi_charges + | "voronoi_charges_covariance" -> Voronoi_charges_covariance + | "voronoi_dipoles" -> Voronoi_dipoles + | "wf_extension" -> Wf_extension + | "d_var_jast_a_up_dn_qmcvar" -> D_var_jast_a_up_dn_qmcvar + | "d_var_jast_a_up_up_qmcvar" -> D_var_jast_a_up_up_qmcvar + | "d_var_jast_b_up_dn_qmcvar" -> D_var_jast_b_up_dn_qmcvar + | "d_var_jast_b_up_up_qmcvar" -> D_var_jast_b_up_up_qmcvar + | "d_var_jast_core_a1_qmcvar" -> D_var_jast_core_a1_qmcvar + | "d_var_jast_core_b1_qmcvar" -> D_var_jast_core_b1_qmcvar + | "d_var_jast_een_e_a_qmcvar" -> D_var_jast_een_e_a_qmcvar + | "d_var_jast_een_e_b_qmcvar" -> D_var_jast_een_e_b_qmcvar + | "d_var_jast_een_n_qmcvar" -> D_var_jast_een_n_qmcvar + | "d_var_jast_pen_qmcvar" -> D_var_jast_pen_qmcvar + | "density1d_qmcvar" -> Density1d_qmcvar + | "dipole_qmcvar" -> Dipole_qmcvar + | "drift_mod_qmcvar" -> Drift_mod_qmcvar + | "e_kin_qmcvar" -> E_kin_qmcvar + | "e_loc_qmcvar" -> E_loc_qmcvar + | "e_loc_one_qmcvar" -> E_loc_one_qmcvar + | "e_loc_per_electron_qmcvar" -> E_loc_per_electron_qmcvar + | "e_loc_split_core_qmcvar" -> E_loc_split_core_qmcvar + | "e_loc_two_qmcvar" -> E_loc_two_qmcvar + | "e_nucl_qmcvar" -> E_nucl_qmcvar + | "e_pot_qmcvar" -> E_pot_qmcvar + | "e_pot_one_qmcvar" -> E_pot_one_qmcvar + | "n_s_inverted_qmcvar" -> N_s_inverted_qmcvar + | "n_s_updated_qmcvar" -> N_s_updated_qmcvar + | "n_s_updates_qmcvar" -> N_s_updates_qmcvar + | "voronoi_charges_qmcvar" -> Voronoi_charges_qmcvar + | "voronoi_charges_covariance_qmcvar" -> Voronoi_charges_covariance_qmcvar + | "voronoi_dipoles_qmcvar" -> Voronoi_dipoles_qmcvar + | "wf_extension_qmcvar" -> Wf_extension_qmcvar + | p -> failwith ("unknown property "^p) ;; + + +let to_string = function +| Cpu -> "Cpu" +| Wall -> "Wall" +| Accep -> "Accep" +| D_var_jast_a_up_dn -> "D_var_jast_a_up_dn" +| D_var_jast_a_up_up -> "D_var_jast_a_up_up" +| D_var_jast_b_up_dn -> "D_var_jast_b_up_dn" +| D_var_jast_b_up_up -> "D_var_jast_b_up_up" +| D_var_jast_core_a1 -> "D_var_jast_core_a1" +| D_var_jast_core_b1 -> "D_var_jast_core_b1" +| D_var_jast_een_e_a -> "D_var_jast_een_e_a" +| D_var_jast_een_e_b -> "D_var_jast_een_e_b" +| D_var_jast_een_n -> "D_var_jast_een_n" +| D_var_jast_pen -> "D_var_jast_pen" +| Density1d -> "Density1d" +| Dipole -> "Dipole" +| Drift_mod -> "Drift_mod" +| E_kin -> "E_kin" +| E_loc -> "E_loc" +| E_loc_one -> "E_loc_one" +| E_loc_per_electron -> "E_loc_per_electron" +| E_loc_split_core -> "E_loc_split_core" +| E_loc_two -> "E_loc_two" +| E_nucl -> "E_nucl" +| E_pot -> "E_pot" +| E_pot_one -> "E_pot_one" +| N_s_inverted -> "N_s_inverted" +| N_s_updated -> "N_s_updated" +| N_s_updates -> "N_s_updates" +| Voronoi_charges -> "Voronoi_charges" +| Voronoi_charges_covariance -> "Voronoi_charges_covariance" +| Voronoi_dipoles -> "Voronoi_dipoles" +| Wf_extension -> "Wf_extension" +| D_var_jast_a_up_dn_qmcvar -> "D_var_jast_a_up_dn_qmcvar" +| D_var_jast_a_up_up_qmcvar -> "D_var_jast_a_up_up_qmcvar" +| D_var_jast_b_up_dn_qmcvar -> "D_var_jast_b_up_dn_qmcvar" +| D_var_jast_b_up_up_qmcvar -> "D_var_jast_b_up_up_qmcvar" +| D_var_jast_core_a1_qmcvar -> "D_var_jast_core_a1_qmcvar" +| D_var_jast_core_b1_qmcvar -> "D_var_jast_core_b1_qmcvar" +| D_var_jast_een_e_a_qmcvar -> "D_var_jast_een_e_a_qmcvar" +| D_var_jast_een_e_b_qmcvar -> "D_var_jast_een_e_b_qmcvar" +| D_var_jast_een_n_qmcvar -> "D_var_jast_een_n_qmcvar" +| D_var_jast_pen_qmcvar -> "D_var_jast_pen_qmcvar" +| Density1d_qmcvar -> "Density1d_qmcvar" +| Dipole_qmcvar -> "Dipole_qmcvar" +| Drift_mod_qmcvar -> "Drift_mod_qmcvar" +| E_kin_qmcvar -> "E_kin_qmcvar" +| E_loc_qmcvar -> "E_loc_qmcvar" +| E_loc_one_qmcvar -> "E_loc_one_qmcvar" +| E_loc_per_electron_qmcvar -> "E_loc_per_electron_qmcvar" +| E_loc_split_core_qmcvar -> "E_loc_split_core_qmcvar" +| E_loc_two_qmcvar -> "E_loc_two_qmcvar" +| E_nucl_qmcvar -> "E_nucl_qmcvar" +| E_pot_qmcvar -> "E_pot_qmcvar" +| E_pot_one_qmcvar -> "E_pot_one_qmcvar" +| N_s_inverted_qmcvar -> "N_s_inverted_qmcvar" +| N_s_updated_qmcvar -> "N_s_updated_qmcvar" +| N_s_updates_qmcvar -> "N_s_updates_qmcvar" +| Voronoi_charges_qmcvar -> "Voronoi_charges_qmcvar" +| Voronoi_charges_covariance_qmcvar -> "Voronoi_charges_covariance_qmcvar" +| Voronoi_dipoles_qmcvar -> "Voronoi_dipoles_qmcvar" +| Wf_extension_qmcvar -> "Wf_extension_qmcvar" +;; + + +let is_scalar = function +| Cpu -> true +| Wall -> true +| Accep -> true +| D_var_jast_a_up_dn | D_var_jast_a_up_dn_qmcvar -> false +| D_var_jast_a_up_up | D_var_jast_a_up_up_qmcvar -> false +| D_var_jast_b_up_dn | D_var_jast_b_up_dn_qmcvar -> false +| D_var_jast_b_up_up | D_var_jast_b_up_up_qmcvar -> false +| D_var_jast_core_a1 | D_var_jast_core_a1_qmcvar -> false +| D_var_jast_core_b1 | D_var_jast_core_b1_qmcvar -> false +| D_var_jast_een_e_a | D_var_jast_een_e_a_qmcvar -> false +| D_var_jast_een_e_b | D_var_jast_een_e_b_qmcvar -> false +| D_var_jast_een_n | D_var_jast_een_n_qmcvar -> false +| D_var_jast_pen | D_var_jast_pen_qmcvar -> false +| Density1d | Density1d_qmcvar -> false +| Dipole | Dipole_qmcvar -> false +| Drift_mod | Drift_mod_qmcvar -> false +| E_kin | E_kin_qmcvar -> true +| E_loc | E_loc_qmcvar -> true +| E_loc_one | E_loc_one_qmcvar -> true +| E_loc_per_electron | E_loc_per_electron_qmcvar -> false +| E_loc_split_core | E_loc_split_core_qmcvar -> false +| E_loc_two | E_loc_two_qmcvar -> true +| E_nucl | E_nucl_qmcvar -> true +| E_pot | E_pot_qmcvar -> true +| E_pot_one | E_pot_one_qmcvar -> true +| N_s_inverted | N_s_inverted_qmcvar -> true +| N_s_updated | N_s_updated_qmcvar -> true +| N_s_updates | N_s_updates_qmcvar -> true +| Voronoi_charges | Voronoi_charges_qmcvar -> false +| Voronoi_charges_covariance | Voronoi_charges_covariance_qmcvar -> false +| Voronoi_dipoles | Voronoi_dipoles_qmcvar -> false +| Wf_extension | Wf_extension_qmcvar -> true +;; + + +let all = [ Cpu ; Wall ; Accep ; + D_var_jast_a_up_dn ; D_var_jast_a_up_up ; D_var_jast_b_up_dn ; D_var_jast_b_up_up ; D_var_jast_core_a1 ; D_var_jast_core_b1 ; D_var_jast_een_e_a ; D_var_jast_een_e_b ; D_var_jast_een_n ; D_var_jast_pen ; Density1d ; Dipole ; Drift_mod ; E_kin ; E_loc ; E_loc_one ; E_loc_per_electron ; E_loc_split_core ; E_loc_two ; E_nucl ; E_pot ; E_pot_one ; N_s_inverted ; N_s_updated ; N_s_updates ; Voronoi_charges ; Voronoi_charges_covariance ; Voronoi_dipoles ; Wf_extension ; ];; diff --git a/ocaml/Qmcchem_config.ml b/ocaml/Qmcchem_config.ml new file mode 100644 index 0000000..372aac9 --- /dev/null +++ b/ocaml/Qmcchem_config.ml @@ -0,0 +1,112 @@ +open Core.Std;; + + +(** QMC=Chem installation directory *) +let root = lazy ( + match ( Sys.getenv "QMCCHEM_PATH" ) with + | Some x -> x + | None -> failwith "QMCCHEM_PATH environment variable not set" +) + + +(* PATH environment variable as a list of strings *) +let path = lazy ( + let p = + match Sys.getenv "PATH" with + | None -> failwith "PATH environment variable is not set" + | Some p -> p + in + String.split ~on:':' p +) + + + +(* Full path of a binary taken from the PATH *) +let full_path exe = + let rec in_path_rec = function + | [] -> None + | head :: tail -> + begin + let fp = + Filename.concat head exe + in + match (Sys.is_file fp) with + | `Yes -> Some fp + | _ -> in_path_rec tail + end + in + Lazy.force path + |> in_path_rec + + + +(* True if an executable is in the PATH *) +let in_path x = + match (full_path x) with + | Some _ -> true + | None -> false + + +let has_parallel = lazy( in_path "parallel" ) +let has_mpirun = lazy( in_path "mpirun" ) +let has_srun = lazy( in_path "parallel" ) +let has_qmc = lazy( in_path "qmc" ) +let has_qmc_mic = lazy( in_path "qmc_mic" ) + + +let mpirun = lazy ( + match Sys.getenv "QMCCHEM_MPIRUN" with + | None -> "mpirun" + | Some p -> p +) + +let qmcchem = lazy( + Filename.concat (Lazy.force root) "bin/qmcchem" +) +and qmc = lazy( + Filename.concat (Lazy.force root) "bin/qmc" +) +and qmc_mic = lazy( + Filename.concat (Lazy.force root) "bin/qmc_mic" +) +and qmc_create_walkers = lazy( + Filename.concat (Lazy.force root) "bin/qmc_create_walkers" +) + +let dev_shm = "/dev/shm/" + +(** Name of the host on which the data server runs *) +let hostname = lazy ( + try + Unix.gethostname () + with + | _ -> "localhost" +) + + +let ip_address = lazy ( + match Sys.getenv "QMCCHEM_NIC" with + | None -> + begin + try + Lazy.force hostname + |> Unix.Inet_addr.of_string_or_getbyname + |> Unix.Inet_addr.to_string + with + | Unix.Unix_error _ -> + failwith "Unable to find IP address from host name." + end + | Some interface -> + begin + try + ok_exn Linux_ext.get_ipv4_address_for_interface interface + with + | Unix.Unix_error _ -> + Lazy.force hostname + |> Unix.Inet_addr.of_string_or_getbyname + |> Unix.Inet_addr.to_string + end +) + + + diff --git a/ocaml/Qmcchem_dataserver.ml b/ocaml/Qmcchem_dataserver.ml new file mode 100644 index 0000000..7faf160 --- /dev/null +++ b/ocaml/Qmcchem_dataserver.ml @@ -0,0 +1,865 @@ +open Core.Std +open Qptypes + +(** Data server of QMC=Chem. + +5 ZeroMQ sockets are opened: +- a REP socket used for registering/unregisterning the walkers and for the clients to fetch the initial walkers positions +- a PULL socket to pull the results computed by the clients +- a PUB socket to send the status to the clients for the termination +- a XSUB socket for receiving debug +- a XPUB socket for sending debug + +@author A. Scemama +*) + +let initialization_timeout = 600. + +let bind_socket ~socket_type ~socket ~address = + try + ZMQ.Socket.bind socket address + with + | Unix.Unix_error (_, message, f) -> + failwith @@ Printf.sprintf + "\n%s\nUnable to bind the dataserver's %s socket :\n %s\n%s" + f socket_type address message + | other_exception -> raise other_exception + + +let run ?(daemon=true) ezfio_filename = + + Ezfio.set_file ezfio_filename ; + + (** Measures the time difference between [t0] and [Time.now ()] *) + let delta_t t0 = + let t1 = + Time.now () + in + Time.abs_diff t1 t0 + in + + + (** {2 ZeroMQ initialization} *) + + let zmq_context = + ZMQ.Context.create () + in + + + + (** Maximum size of the blocks file before compressing *) + let max_file_size = ref ( + Byte_units.create `Kilobytes 64.) + in + + + let hostname = + Lazy.force Qmcchem_config.hostname + in + + (** Status variable (mutable) *) + let status = + ref Status.Queued + in + + let change_status s = + status := s; + Status.write s; + Printf.printf "Status : %s\n%!" (Status.to_string s) + in + change_status Status.Queued; + + + + (* + (** Checks if the port is already open (not working properly yet) *) + let check_port n = + let adress_prefix = + "tcp://*:" + in + let result = + List.fold [0;1;2;3] ~init:true ~f:(fun accu i -> + let address = + adress_prefix ^ (Int.to_string (n+i)) + in + let socket = + ZMQ.Socket.create zmq_context ZMQ.Socket.rep + in + let result = + try + (ZMQ.Socket.bind socket address; accu ); + with + | _ -> false; + in + ZMQ.Socket.close socket; + result + ) + in + if (result) then + `Available + else + `Unavailable + in + *) + + + + (** Random port number between 49152 and 65535 *) + let port = + let newport = + (* ref (49152 + (Random.int 16383)) *) + ref ( 1024 + (Random.int (49151-1024))) + in + (* + while ((check_port !newport) = `Unavailable) + do + newport := 49152 + (Random.int 16383) + done; + *) + !newport + in + + + let debug_socket = + ZMQ.Socket.create zmq_context ZMQ.Socket.xpub + and address = + Printf.sprintf "tcp://*:%d" (port+4) + in + bind_socket "XPUB" debug_socket address; + + let close_debug_socket () = + ZMQ.Socket.set_linger_period debug_socket 1000 ; + ZMQ.Socket.close debug_socket + in + + (** Sends a log text to the debug socket *) + let send_log socket size t0 text = + let dt = + delta_t t0 + in + let message = + Printf.sprintf "%20s : %8d : %10s : %s" + socket size text (Time.Span.to_string dt) + in + ZMQ.Socket.send debug_socket message + in + + + (** {2 Walkers} *) + + (** Number of electrons *) + let elec_num = + Lazy.force Qputils.elec_num + in + + + (** Size of the walkers message *) + let walkers_size = + 20*3*(elec_num+1) + in + + (** Seconds after when the block is ended on the worker. *) + let block_time = + Input.Block_time.read () + |> Input.Block_time.to_float + in + + (** Total number of walkers to keep for restart *) + let walk_num_tot = + Input.Walk_num_tot.read () + in + + (** Array of walkers. The size is [walk_num_tot]. *) + let walkers_array = + let t0 = + Time.now () + in + let j = + 3*elec_num + 3 + in + let result = + if ( not(Ezfio.has_electrons_elec_coord_pool ()) ) then + begin + Printf.printf "Generating initial walkers...\n%!"; + Unix.fork_exec ~prog:(Lazy.force Qmcchem_config.qmc_create_walkers) + ~args:["qmc_create_walkers" ; ezfio_filename] () + |> Unix.waitpid_exn ; + Printf.printf "Initial walkers ready\n%!" + end ; + + let size = + Ezfio.get_electrons_elec_coord_pool_size () + and ez = + Ezfio.get_electrons_elec_coord_pool () + |> Ezfio.flattened_ezfio + in + try + Array.init walk_num_tot ~f:(fun i -> + Array.sub ~pos:(j*(i mod size)) ~len:j ez) + with + | Invalid_argument _ -> + failwith "Walkers file is broken." + in + String.concat [ "Read " ; Int.to_string (Array.length result) ; + " walkers"] + |> send_log "status" 0 t0 ; + result + in + + + (** Id of the last saved walker (mutable). *) + let last_walker = + ref 0 + in + + + (** Last time when the walkers were saved to disk. *) + let last_save_walkers = + ref (Time.now ()) + in + + + (** Saves the walkers to disk. *) + let save_walkers () = + if (delta_t !last_save_walkers > (Time.Span.of_sec 10.) ) then + begin + let t0 = + Time.now () + in + Ezfio.set_electrons_elec_coord_pool_size walk_num_tot ; + let walkers_list = + Array.map walkers_array ~f:Array.to_list + |> Array.to_list + |> List.concat + in + Ezfio.set_electrons_elec_coord_pool (Ezfio.ezfio_array_of_list + ~rank:3 ~dim:[| elec_num+1 ; 3 ; walk_num_tot |] ~data:walkers_list); + send_log "status" walk_num_tot t0 "Saved walkers"; + last_save_walkers := Time.now (); + end + in + + + + (** Increments the [last_walker] mutable value, and saves the walkers to + disk if the array of walkers is filled. In that case, sets the last_walker to 0. + *) + let increment_last_walker () = + last_walker := !last_walker + 1; + if (!last_walker = walk_num_tot) then + begin + last_walker := 0 ; + save_walkers () + end + in + + + + (** {2 Set of workers} *) + + (** A hash table is kept to track the running workers. The keys are the + built as string containing the couple ([Compute_node], [PID]), and + the values are the last communication time. + *) + + + + (** The hash table for workers *) + let workers_hash = + String.Table.create () + in + + + + (** Creates a key using the couple ([Compute_node], [PID]) *) + let key compute_node pid = + String.concat [ + (Compute_node.to_string compute_node); " "; + (Pid.to_string pid) ] + in + + + + (** Adds a new worker to the hash table. + @raise Failure when the worker is already in the table. *) + let add_worker w pid = + let s = + key w pid + in + match Hashtbl.add workers_hash ~key:s ~data:(Time.now ()) with + | `Ok -> () + | `Duplicate -> failwith (s^" already registered") + in + + + + (** Deletes a new worker from the hash table. + @raise Failure when the worker is not in the table. *) + let del_worker w pid = + let s = + key w pid + in + match Hashtbl.find workers_hash s with + | Some x -> Hashtbl.remove workers_hash s + | None -> failwith (s^" not registered") + in + + + + (** Sets the last access of the worker to [Time.now ()] *) + let touch_worker w pid = + let s = + key w pid + in + Hashtbl.set workers_hash ~key:s ~data:(Time.now ()) + in + + + (** Returns the number of connected workers *) + let n_connected hash now = + let delta = + Time.Span.of_sec (initialization_timeout +. block_time *. 2.) + in + Hashtbl.filter hash ~f:(fun x -> (Time.abs_diff now x) <= delta) + |> Hashtbl.length + in + + + + + (** Current PID. *) + let dataserver_pid = + Unix.getpid () + in + + + (** Name of the blocks file written by the current process. *) + let block_channel_filename = + let dirname = + Lazy.force Block.dir_name + in + let () = + match Sys.is_directory dirname with + | `Yes -> () + | _ -> Unix.mkdir_p dirname + in + Filename.concat dirname ( + hostname ^ "." ^ (Pid.to_string dataserver_pid) + ) + in + + (** Name of the blocks file written by the current process, currently locked *) + let block_channel_filename_locked = + block_channel_filename ^ ".locked" + in + + let block_channel_filename_tmp = + block_channel_filename ^ ".tmp" + in + + + (** [Out_channel] corresponding to the blocks file written by the current process. *) + let block_channel = + try + ref (Out_channel.create block_channel_filename_locked) + with + | Sys_error _ -> + begin + (* NFS Stale file handle : + * Wait 5 seconds, and retry *) + Time.Span.of_sec 5. |> Time.pause; + ref (Out_channel.create block_channel_filename_locked) + end + in + + + (** Compresses the blocks file by merging all blocks with the same block ID and the + same host name, but different PIDs. The result is merging all the CPU cores of + the compute nodes. Happens when [max_file_size] is reached. + *) + let compress_block_file filename = + let t0 = + Time.now () + in + Out_channel.close !block_channel; + Unix.rename ~src:block_channel_filename_locked ~dst:block_channel_filename_tmp; + Random_variable.compress_files (); + send_log "status" 0 t0 "Compressed block file"; + block_channel := Out_channel.create ~append:true block_channel_filename_locked + in + + + + (** {2 Threads} *) + + (** {3 Status thread} *) + + let start_status_thread = + let t0 = + Time.now () + in + Thread.create (fun () -> + send_log "status" 0 t0 "Starting status thread"; + + let socket = + ZMQ.Socket.create zmq_context ZMQ.Socket.pub + and address = + Printf.sprintf "tcp://*:%d" (port+1) + in + bind_socket "PUB" socket address; + let delay = + Time.Span.of_ms 300. + and delay_read = + Time.Span.of_sec 2. + in + + let start_time = + Time.now () + and stop_time = + ref (Time.Span.of_sec Input.Stop_time.(read () |> to_float) ) + in + + let last_update = + ref start_time + in + + while (!status <> Status.Stopped) + do + Time.pause delay; + let now = + Time.now () + in + let status_string = + Status.to_string !status + in + ZMQ.Socket.send socket status_string; + send_log "status" (String.length status_string) now status_string; + + let test = + if (Time.abs_diff now !last_update > delay_read) then + let n_connect = + n_connected workers_hash now + in + `Update n_connect + else if (Time.abs_diff now start_time > !stop_time) then + `Terminate + else if (Time.abs_diff now start_time > Time.Span.of_sec initialization_timeout) then + `Timeout + else + `None + in + + match (daemon, !status, test) with + | (_ , _ , `None ) -> () + | (_ , Status.Running , `Terminate ) -> change_status Status.Stopping + | (false, Status.Running , `Update 0 ) -> change_status Status.Stopped + | (true , Status.Running , `Update 0 ) -> change_status Status.Queued + | (_ , _ , `Update i ) -> + begin + status := Status.read (); + last_update := now; + stop_time := Time.Span.of_sec Input.Stop_time.(read () |> to_float) ; + let n_tot = + Hashtbl.length workers_hash + in + if (i <> n_tot) then + begin + Printf.sprintf "Connected workers : %d / %d" i n_tot + |> send_log "status" 0 now + end + end + | (false, Status.Queued , `Timeout ) -> change_status Status.Stopped + | (_, _, _) -> () + ; + done; + ZMQ.Socket.send socket (Status.to_string !status); + ZMQ.Socket.set_linger_period socket 1000 ; + ZMQ.Socket.close socket + ) + in + + (** {3 Log thread} *) + + let start_log_thread = + let t0 = + Time.now () + in + Thread.create (fun () -> + send_log "status" 0 t0 "Starting log thread"; + + let socket = + ZMQ.Socket.create zmq_context ZMQ.Socket.xsub + and address = + Printf.sprintf "tcp://*:%d" (port+3) + in + bind_socket "XSUB" socket address; + + let pollitem = + ZMQ.Poll.mask_of + [| (socket , ZMQ.Poll.In) ; + (debug_socket , ZMQ.Poll.In) + |] + in + while (!status <> Status.Stopped) + do + let polling = + ZMQ.Poll.poll ~timeout:1000 pollitem + in + if (polling.(0) = Some ZMQ.Poll.In) then + begin + let message = + ZMQ.Socket.recv_all ~block:false socket + |> String.concat ~sep:" " + in + let now = + Time.now () + in + send_log "log" 0 now message + end + else if (polling.(1) = Some ZMQ.Poll.In) then + begin + (* Forward subscription from XPUB to XSUB *) + ZMQ.Socket.recv_all ~block:false debug_socket + |> ZMQ.Socket.send_all socket + end + done; + ZMQ.Socket.set_linger_period socket 1000 ; + ZMQ.Socket.close socket + ) + in + (** {3 Main thread} *) + + let random_walkers n_walks = + let rec walkers accu = function + | 0 -> accu + | n -> + let random_int = + Random.int (Strictly_positive_int.to_int n_walks) + in + (Array.to_list (walkers_array.(random_int)) ) :: (walkers accu (n-1)) + in + walkers [] (Strictly_positive_int.to_int n_walks) + |> List.concat + |> List.map ~f:(fun x-> Printf.sprintf "%20.14f" x) + (* + |> List.map ~f:Float.to_string + *) + in + + let start_main_thread = + let wall0 = + Time.now () + in + let f () = + + change_status Status.Queued; + send_log "status" 0 wall0 "Starting main thread"; + + (** Reply socket *) + let rep_socket = + ZMQ.Socket.create zmq_context ZMQ.Socket.rep + and address = + Printf.sprintf "tcp://*:%d" port + in + bind_socket "REP" rep_socket address; + ZMQ.Socket.set_receive_high_water_mark rep_socket 100000; + ZMQ.Socket.set_send_high_water_mark rep_socket 100000; + ZMQ.Socket.set_immediate rep_socket true; + + (** EZFIO Cache *) + let ezfio_cache = + String.Table.create () + in + let handle_ezfio msg = + match Hashtbl.find ezfio_cache msg with + | Some result -> result + | None -> + begin + let result = + decode_ezfio_message msg + in + match (Hashtbl.add ezfio_cache ~key:msg ~data:result) with + | `Ok -> result + | `Duplicate -> result + end + in + + (** Pull socket for computed data *) + let pull_socket = + ZMQ.Socket.create zmq_context ZMQ.Socket.pull + and address = + Printf.sprintf "tcp://*:%d" (port+2) + in + bind_socket "PULL" pull_socket address; + + + (** Address of the dataserver *) + let server_address = + let ip = + Lazy.force Qmcchem_config.ip_address + in + Printf.sprintf "tcp://%s:%d" ip port + in + Ezfio.set_simulation_http_server server_address; + Printf.printf "Server address: %s\n%!" server_address; + + + (** Polling item to poll REP and PULL sockets. *) + let pollitem = + ZMQ.Poll.mask_of + [| ( rep_socket, ZMQ.Poll.In) ; + ( pull_socket, ZMQ.Poll.In) ; + |] + in + + + (** Handles messages coming into the REP socket. *) + let handle_rep () = + let raw_msg = + ZMQ.Socket.recv_all ~block:false rep_socket + in + let t0 = + Time.now () + in + let msg = + List.map ~f:String.strip raw_msg + |> Message.create + and msg_size = + List.fold ~init:0 ~f:(fun accu x -> accu + (String.length x)) raw_msg + in + let handle = function + | Message.Ezfio ezfio_msg -> + let result = + handle_ezfio ezfio_msg + in + ZMQ.Socket.send_all rep_socket + [ String.length result + |> Printf.sprintf "%d " ; + result ] ; + send_log "rep" (String.length result) t0 ezfio_msg + | Message.GetWalkers n_walks -> + begin + send_log "req" msg_size t0 "get_walkers"; + let result = + random_walkers n_walks + in + ZMQ.Socket.send_all rep_socket result; + send_log "rep" walkers_size t0 "get_walkers" + end + | Message.Register (w,pid) -> + begin + match !status with + | Status.Queued + | Status.Running -> + begin + String.concat [ "Register : " ; + (Compute_node.to_string w) ; " " ; + (Pid.to_string pid) ] + |> send_log "req" msg_size t0; + add_worker w pid; + if (!status = Status.Queued) then + change_status Status.Running ; + ZMQ.Socket.send rep_socket "OK"; + send_log "rep" 2 t0 "Register : OK" + end + | Status.Stopping + | Status.Stopped -> + ZMQ.Socket.send rep_socket "Failed"; + end + | Message.Unregister (w,pid) -> + begin + String.concat [ "Unregister : " ; + (Compute_node.to_string w) ; " " ; + (Pid.to_string pid) ] + |> send_log "req" msg_size t0; + ZMQ.Socket.send rep_socket "OK"; + del_worker w pid; + String.concat [ "Unregister : "; + (Hashtbl.length workers_hash) |> Int.to_string ; + " remaining" ] + |> send_log "rep" 2 t0 ; + let n_connect = + n_connected workers_hash t0 + in + match (daemon,n_connect) with + | (false,0) -> change_status Status.Stopped + | (true ,0) -> change_status Status.Queued + | _ -> () + end + | Message.Test -> + begin + ZMQ.Socket.send rep_socket "OK"; + send_log "rep" 2 t0 "Test" + end + | Message.Walkers (_, _, _) + | Message.Property _ + -> failwith "Bad message" + in handle msg + in + + (** Handles messages coming into the PULL socket. *) + let handle_pull status = + let raw_msg = + ZMQ.Socket.recv_all ~block:false pull_socket + in + let t0 = + Time.now () + in + let msg = + List.map ~f:String.strip raw_msg + |> Message.create + and msg_size = + List.fold ~init:0 ~f:(fun accu x -> accu + (String.length x)) raw_msg + in + let recv_log = + send_log "pull" msg_size t0 + in + + let handle = function + | Message.Walkers (h,pid,w) -> + begin + if (status = Status.Running) then + touch_worker h pid ; + let log_msg = + Printf.sprintf "Walkers from %s : %d / %d / %d" + (key h pid) (Array.length w) (!last_walker) walk_num_tot + in + recv_log log_msg ; + for i=0 to ((Array.length w)-1) + do + Array.replace walkers_array (!last_walker) (fun _ -> w.(i)); + increment_last_walker (); + done; + let wall = + Printf.sprintf "%f %f # %s %s %s %d" + (Time.Span.to_sec (Time.abs_diff (Time.now ()) wall0)) + 1. (Property.to_string Property.Wall) + hostname (Pid.to_string dataserver_pid) 1 + |> Block.of_string + in + match wall with + | Some wall -> + begin + Out_channel.output_string !block_channel (Block.to_string wall); + Out_channel.output_char !block_channel '\n'; + end + | _ -> () + end + | Message.Property b -> + begin + if (status = Status.Running) then + touch_worker b.Block.compute_node b.Block.pid ; + Out_channel.output_string !block_channel (Block.to_string b); + Out_channel.output_char !block_channel '\n'; + recv_log (Block.to_string b) + end + | Message.Test + | Message.GetWalkers _ + | Message.Ezfio _ + | Message.Register (_, _) + | Message.Unregister (_, _) + -> failwith "Bad message" + in handle msg + in + + (* Main loop *) + while (!status <> Status.Stopped) + do + let polling = + ZMQ.Poll.poll ~timeout:1000 pollitem + in + match polling.(1) with + | Some ZMQ.Poll.In -> handle_pull !status + | _ -> + begin + match polling.(0) with + | Some ZMQ.Poll.In -> handle_rep () + | _ -> + begin + Out_channel.flush !block_channel ; + let file_size = + (Unix.stat block_channel_filename_locked).Unix.st_size + |> Float.of_int64 + |> Byte_units.create `Bytes + in + if (file_size > !max_file_size) then + begin + compress_block_file (); + max_file_size := Byte_units.scale file_size 1.2; + end + end + end + done; + + List.iter ~f:(fun socket -> + ZMQ.Socket.set_linger_period socket 1000 ; + ZMQ.Socket.close socket) + [ rep_socket ; pull_socket ] + in + Thread.create f + in + + + + (** {2 Finalization} *) + + (** Cleans all the open files, sockets, etc. + @param t0 is the initial time of the run, such that the wall time can be computed. + *) + let finalize ~t0 = + print_string "Finalizing..."; + change_status Status.Stopped; + compress_block_file (); + send_log "status" 0 t0 "Done"; + close_debug_socket (); + ZMQ.Context.terminate zmq_context; + begin + try + Out_channel.close !block_channel; + Unix.remove block_channel_filename_locked + with + | _ -> () + end; + Qmcchem_result.display_summary (); + in + + (** {3 Main function} *) + + let t0 = + Time.now () + in + + (* Handle signals *) + let handler s = + Watchdog.kill (); + in + List.iter [ + Signal.term ; + Signal.quit ; + Signal.int + ] + ~f:(fun x -> Signal.Expert.handle x handler) + ; + + (* Run threads *) + begin + + try + (List.iter ~f:Thread.join + [ start_status_thread () ; + start_log_thread () ; + start_main_thread () ; + ]) + with + | err -> + begin + print_endline "Trapped error. Waiting 10 seconds..."; + change_status Status.Stopping; + Time.Span.of_sec 10. |> Time.pause; + finalize ~t0; + raise err + end + end; + finalize ~t0 + + diff --git a/ocaml/Qmcchem_debug.ml b/ocaml/Qmcchem_debug.ml new file mode 100644 index 0000000..c3cc9e2 --- /dev/null +++ b/ocaml/Qmcchem_debug.ml @@ -0,0 +1,84 @@ +open Core.Std + + +let run ~t filename= + + Ezfio.set_file filename; + + if (not (Ezfio.has_simulation_http_server ())) then + failwith "QMC=Chem is not running" + ; + + let zmq_context = + ZMQ.Context.create () + in + + Printf.printf "Debugging %s\n%!" filename; + let socket = + ZMQ.Socket.create zmq_context ZMQ.Socket.sub + in + + let address = + match (Ezfio.get_simulation_http_server () + |> String.rsplit2 ~on:':' ) + with + | Some (a,p) -> a^":"^( (Int.of_string p)+4 |> Int.to_string ) + | None -> failwith "Badly formed address" + in + ZMQ.Socket.connect socket address; + ZMQ.Socket.subscribe socket ""; + + if t then + begin + let re_split = + Str.regexp " *: *" + in + let tot_size = + ref (Byte_units.create `Bytes 0.) + in + while true + do + let msg = + ZMQ.Socket.recv socket + in + let (socket, bytes) = + match Str.split re_split msg with + | socket :: bytes :: _ -> + (socket, Byte_units.create `Bytes (Float.of_string bytes)) + | _ -> (print_endline msg ; ("", Byte_units.create `Bytes 0.)) + in + tot_size := Byte_units.create `Bytes ((Byte_units.bytes !tot_size) +. (Byte_units.bytes bytes)); + Printf.printf "%s\n%!" (Byte_units.to_string !tot_size); + Time.pause (Time.Span.of_float 1.) + done + end + else + begin + while true + do + let msg = + ZMQ.Socket.recv socket + in + Printf.printf "%s\n%!" msg; + done + end + + + +let spec = + let open Command.Spec in + empty + +> flag "t" no_arg + ~doc:"Measure the throughput" + +> anon ("filename" %: string) + + +let command = + Command.basic + ~summary: "Debug ZeroMQ communications" + ~readme:(fun () -> "Gets debug information from the ZMQ debug sockets.") + spec + (fun t filename () -> run t filename) + + + diff --git a/ocaml/Qmcchem_edit.ml b/ocaml/Qmcchem_edit.ml new file mode 100644 index 0000000..02c618b --- /dev/null +++ b/ocaml/Qmcchem_edit.ml @@ -0,0 +1,310 @@ +open Core.Std + +let file_header filename = Printf.sprintf +" ++----------------------------------------------------------------+ +| QMC=Chem | ++----------------------------------------------------------------+ + +Editing file `%s` + +" filename + +let make_header s = + let l = String.length s in + "\n\n"^s^"\n"^(String.init l ~f:(fun _ -> '='))^"\n\n" + + +type field = + | Block_time + | Walk_num + | Walk_num_tot + | Stop_time + | Fitcusp + | Method + | Sampling + | Ref_energy + | CI_threshold + | Time_step + | Jastrow_type + | Properties + + +let get field = + let option_to_string read to_string doc = + let value = + read () |> to_string + in + Printf.sprintf "%s ::\n\n %s\n\n" doc value + in + let option_to_string_prop read to_string doc = + let value = + read () |> to_string + in + Printf.sprintf "%s :\n\n%s\n\n" doc value + in + let open Input in + match field with + | Block_time -> + option_to_string Block_time.read Block_time.to_string Block_time.doc + | Walk_num -> + option_to_string Walk_num.read Walk_num.to_string Walk_num.doc + | Walk_num_tot -> + option_to_string Walk_num_tot.read Walk_num_tot.to_string Walk_num_tot.doc + | Stop_time -> + option_to_string Stop_time.read Stop_time.to_string Stop_time.doc + | Fitcusp -> + option_to_string Fitcusp.read Fitcusp.to_string Fitcusp.doc + | Method -> + option_to_string Method.read Method.to_string Method.doc + | Sampling -> + option_to_string Sampling.read Sampling.to_string Sampling.doc + | Ref_energy -> + option_to_string Ref_energy.read Ref_energy.to_string Ref_energy.doc + | CI_threshold -> + option_to_string CI_threshold.read CI_threshold.to_string CI_threshold.doc + | Time_step -> + option_to_string Time_step.read Time_step.to_string Time_step.doc + | Jastrow_type -> + option_to_string Jastrow_type.read Jastrow_type.to_string Jastrow_type.doc + | Properties -> + option_to_string_prop Properties.read Properties.to_string Properties.doc + + + +let create_temp_file ?temp_filename ezfio_filename fields = + let filename = + match temp_filename with + | None -> Filename.temp_file "qmcchem_edit_" ".rst" + | Some name -> name + in + Out_channel.with_file filename ~f:(fun out_channel -> + (file_header ezfio_filename) :: (List.map ~f:get fields) + |> String.concat ~sep:"\n" + |> Out_channel.output_string out_channel + ) + ; filename + + +(** Write the input file corresponding to the MD5 key *) +let write_input_in_ezfio ezfio_filename fields = + let dirname = + Lazy.force Md5.input_directory + in + let temp_filename = + Md5.hash () + |> Filename.concat dirname + in + let input_filename = + create_temp_file ~temp_filename ezfio_filename fields + in + assert (Sys.file_exists_exn input_filename) + + +(** Run the edit command *) +let run ~c ?f ?t ?l ?m ?e ?s ?ts ?w ?wt ?n ?j ?input ezfio_filename = + + let interactive = ref ( + if c then + false + else + true + ) + in + + (* Open EZFIO *) + if (not (Sys.file_exists_exn ezfio_filename)) then + failwith (ezfio_filename^" does not exist"); + + Ezfio.set_file ezfio_filename; + + let handle_option (type_conv, write) x = + let () = + match x with + | Some x -> + begin + type_conv x |> write; + interactive := false; + end + | None -> () + in (); + in + + handle_option Input.Ref_energy.(of_float , write) e; + handle_option Input.Jastrow_type.(of_string, write) j; + handle_option Input.Block_time.(of_int , write) l; + handle_option Input.Method.(of_string, write) m; + handle_option Input.Stop_time.(of_int , write) t; + handle_option Input.Sampling.(of_string, write) s; + handle_option Input.Fitcusp.(of_int , write) f; + handle_option Input.Time_step.(of_float , write) ts; + handle_option Input.Walk_num.(of_int , write) w; + handle_option Input.Walk_num_tot.(of_int , write) wt; + handle_option Input.CI_threshold.(of_float , write) n; + + + let fields = + [ + Stop_time ; + Block_time ; + Method ; + Ref_energy ; + Sampling ; + Time_step ; + Walk_num ; + Walk_num_tot ; + Fitcusp ; + CI_threshold ; + Jastrow_type ; + Properties ; + ] + in + + if (!interactive) then + begin + let temp_filename = + create_temp_file ezfio_filename fields + in + let () = + match input with + | Some filename -> + begin + if (not !interactive) then + failwith "Input file not allowed with command line arguments" + else + begin + Printf.sprintf "cp %s %s" filename temp_filename + |> Sys.command_exn ; + end + end + | None -> + begin + (* Open the temp file with external editor *) + let editor = + match Sys.getenv "EDITOR" with + | Some editor -> editor + | None -> "vi" + in + Printf.sprintf "%s %s ; tput sgr0 2> /dev/null" editor temp_filename + |> Sys.command_exn + end + in + + (* Re-read the temp file *) + let re_data = + Str.regexp " .+ *$" + and re_prop = + Str.regexp "([ xX]) .*$" + and raw_data = + In_channel.with_file temp_filename ~f:In_channel.input_lines + in + let data = + ( List.filter raw_data ~f:(fun x -> Str.string_match re_data x 0) + |> List.map ~f:String.strip ) @ + [ + List.filter raw_data ~f:(fun x -> Str.string_match re_prop x 0) + |> List.map ~f:String.strip + |> String.concat ~sep:"\n" ] + in + let open Input in + List.iter2_exn data fields ~f:(fun s f -> + try + begin + match f with + | Stop_time -> Stop_time.(of_string s |> write) + | Fitcusp -> Fitcusp.(of_string s |> write) + | Block_time -> Block_time.(of_string s |> write) + | Method -> Method.(of_string s |> write) + | Ref_energy -> Ref_energy.(of_string s |> write) + | Sampling -> Sampling.(of_string s |> write) + | Time_step -> Time_step.(of_string s |> write) + | Walk_num -> Walk_num.(of_string s |> write) + | Walk_num_tot -> Walk_num_tot.(of_string s |> write) + | CI_threshold -> CI_threshold.(of_string s |> write) + | Jastrow_type -> Jastrow_type.(of_string s |> write) + | Properties -> Properties.(of_string s |> write) + end + with + | Failure msg -> Printf.eprintf "%s\n" msg + ); + + (* Remove temp_file *) + Sys.remove temp_filename; + + end + ; + + if c then + begin + let dirname = + Filename.concat (Filename.concat ezfio_filename "blocks") (Md5.hash ()) + in + let rec clean_dir y = + match Sys.is_directory y with + | `Yes -> + Sys.ls_dir y + |> List.map ~f:(Filename.concat y) + |> List.iter ~f:(function x -> + match ( Sys.is_directory x, Sys.is_file x ) with + | (`Yes, _) -> clean_dir x + | (_, `Yes) -> Sys.remove x + | (_,_) -> () + ); + Unix.rmdir y + | `Unknown + | `No -> () + in clean_dir dirname; + Printf.printf "Blocks cleared\n" + end + ; + + Input.validate (); + Md5.reset_hash (); + write_input_in_ezfio ezfio_filename fields + + +let spec = + let open Command.Spec in + empty + +> flag "c" no_arg + ~doc:(" Clear blocks") + +> flag "f" (optional int) + ~doc:("0|1 "^Input.Fitcusp.doc) + +> flag "t" (optional int) + ~doc:("seconds "^Input.Stop_time.doc) + +> flag "l" (optional int) + ~doc:("seconds "^Input.Block_time.doc) + +> flag "m" (optional string) + ~doc:("method "^Input.Method.doc) + +> flag "e" (optional float) + ~doc:("energy "^Input.Ref_energy.doc) + +> flag "s" (optional string) + ~doc:("sampling "^Input.Sampling.doc) + +> flag "ts" (optional float) + ~doc:("time_step "^Input.Time_step.doc) + +> flag "w" (optional int) + ~doc:("walk_num "^Input.Walk_num.doc) + +> flag "wt" (optional int) + ~doc:("walk_num_tot "^Input.Walk_num_tot.doc) + +> flag "n" (optional float) + ~doc:("norm "^Input.CI_threshold.doc) + +> flag "j" (optional string) + ~doc:("jastrow_type "^Input.Jastrow_type.doc) + +> anon ("ezfio_file" %: string) + +> anon (maybe ("input" %: string)) +;; + +let command = + Command.basic + ~summary: "Edit input data" + ~readme:(fun () -> + " +Edit input data + ") + spec + (fun c f t l m e s ts w wt n j ezfio_file input () -> + run ~c ?f ?t ?l ?m ?e ?s ?ts ?w ?wt ?n ?j ?input ezfio_file ) + + + + diff --git a/ocaml/Qmcchem_forwarder.ml b/ocaml/Qmcchem_forwarder.ml new file mode 100644 index 0000000..e886093 --- /dev/null +++ b/ocaml/Qmcchem_forwarder.ml @@ -0,0 +1,453 @@ +open Core.Std;; + +let bind_socket ~socket_type ~socket ~address = + try + ZMQ.Socket.bind socket address + with + | Unix.Unix_error (_, message, f) -> + failwith @@ Printf.sprintf + "\n%s\nUnable to bind the forwarder's %s socket :\n %s\n%s" + f socket_type address message + | other_exception -> raise other_exception + + +let run ezfio_filename dataserver = + + let dataserver_address, dataserver_port = + Substring.create ~pos:6 dataserver + |> Substring.to_string + |> String.lsplit2_exn ~on:':' + and qmc = + Lazy.force Qmcchem_config.qmc + in + + (* Go into /dev/shm *) + Unix.chdir Qmcchem_config.dev_shm; + + let tmpdir = + ezfio_filename ^ "_" ^ dataserver_port + in + + (* Port of the data server *) + let port = + (Int.of_string dataserver_port)+10 + in + + (* Build qmc executable command *) + let prog, args = + qmc, + [ qmc ; ezfio_filename ; + Printf.sprintf "ipc://%s:%d" Qmcchem_config.dev_shm port ]; + in + + (* Create the temporary directory. If it is possible, then the process is a + * master and the forwarder will start. Otherwise, only start a qmc process. + *) + let () = + try + Unix.mkdir tmpdir + with + | Unix.Unix_error _ -> + (* TODO : wait until the forwarder has started *) + begin + Unix.chdir tmpdir; + ignore @@ Unix.exec ~prog ~args () + end + in + Unix.chdir tmpdir; + + (* Now, only one forwarder will execute the following code *) + + (* Fork a qmc *) + ignore @@ + Watchdog.fork_exec ~prog ~args (); + + (* If there are MICs, use them here (TODO) *) + + (* Fetch input *) + let zmq_context = + ZMQ.Context.create () + in + + let terminate () = + (* Clean up the temp directory *) + Unix.chdir Qmcchem_config.dev_shm; + let command = + Printf.sprintf "rm -rf -- \"%s\" " tmpdir + in + match Unix.system command with + | Ok _ -> () + | _ -> print_endline "Unable to remove temporary directory" + ; + ZMQ.Context.terminate zmq_context + in + + + (* Signal handler to Kill properly all the processes *) + let handler s = + Printf.printf "Forwarder received the %s signal... killing\n" (Signal.to_string s); + terminate (); + Watchdog.kill (); + in + List.iter [ + Signal.term ; + Signal.quit ; + Signal.int + ] + ~f:(fun x -> Signal.Expert.handle x handler) + ; + + + (* Fetch walkers *) + let walk_num = + ref 0 + and walkers = + ref [] + in + + + (* Status thread *) + let status = + ref Status.Running + in + + let start_status_thread = + + let f () = + let pub_socket = + ZMQ.Socket.create zmq_context ZMQ.Socket.pub + and address = + Printf.sprintf "ipc://%s:%d" Qmcchem_config.dev_shm (port+1); + in + bind_socket "PUB" pub_socket address; + + let sub_socket = + ZMQ.Socket.create zmq_context ZMQ.Socket.sub + and address = + Printf.sprintf "tcp://%s:%d" dataserver_address (port+1-10) + in + ZMQ.Socket.connect sub_socket address; + ZMQ.Socket.subscribe sub_socket ""; + + let pollitem = + ZMQ.Poll.mask_of + [| (sub_socket, ZMQ.Poll.In) ; + |] + in + + while (!status <> Status.Stopped) + do + let polling = + ZMQ.Poll.poll ~timeout:1000 pollitem + in + if (polling.(0) = Some ZMQ.Poll.In) then + begin + let msg = + ZMQ.Socket.recv ~block:false sub_socket + in + ZMQ.Socket.send pub_socket msg; + status := Status.of_string msg; + end; + done; + List.iter ~f:(fun socket -> + ZMQ.Socket.set_linger_period socket 1000 ; + ZMQ.Socket.close socket) + [ sub_socket ; pub_socket ] + in + Thread.create f + in + + let start_log_thread = + + let f () = + let sub_socket = + ZMQ.Socket.create zmq_context ZMQ.Socket.xsub + and address = + Printf.sprintf "ipc://%s:%d" Qmcchem_config.dev_shm (port+3); + in + bind_socket "XSUB" sub_socket address; + + let pub_socket = + ZMQ.Socket.create zmq_context ZMQ.Socket.xpub + and address = + Printf.sprintf "tcp://%s:%d" dataserver_address (port+3-10) + in + ZMQ.Socket.connect pub_socket address; + + let pollitem = + ZMQ.Poll.mask_of + [| (sub_socket, ZMQ.Poll.In) ; + (pub_socket, ZMQ.Poll.In) ; + |] + in + + (* Main loop *) + while (!status <> Status.Stopped) + do + let polling = + ZMQ.Poll.poll ~timeout:1000 pollitem + in + if (polling.(0) = Some ZMQ.Poll.In) then + begin + ZMQ.Socket.recv ~block:false sub_socket + |> ZMQ.Socket.send pub_socket ; + end + else if (polling.(1) = Some ZMQ.Poll.In) then + begin + Printf.printf "Forwarder subscribe\n%!"; + ZMQ.Socket.recv ~block:false pub_socket + |> ZMQ.Socket.send sub_socket ; + end + done; + List.iter ~f:(fun socket -> + ZMQ.Socket.set_linger_period socket 1000 ; + ZMQ.Socket.close socket) + [ sub_socket ; pub_socket ] + in + Thread.create f + in + + (* Proxy thread *) + let start_proxy_thread = + let f () = + + let req_socket = + ZMQ.Socket.create zmq_context ZMQ.Socket.req + in + ZMQ.Socket.connect req_socket dataserver; + ZMQ.Socket.set_receive_timeout req_socket 180_000; + + let dealer_socket = + ZMQ.Socket.create zmq_context ZMQ.Socket.dealer + in + + bind_socket "PROXY" dealer_socket "inproc://dealer"; + ZMQ.Socket.set_receive_high_water_mark dealer_socket 100000; + ZMQ.Socket.set_send_high_water_mark dealer_socket 100000; + ZMQ.Socket.set_immediate dealer_socket true; + + let fetch_walkers () = + ZMQ.Socket.send_all req_socket ["get_walkers" ; Int.to_string !walk_num ]; + ZMQ.Socket.recv_all req_socket + in + + let pollitem = + ZMQ.Poll.mask_of + [| (dealer_socket, ZMQ.Poll.In) ; + |] + in + + (* EZFIO Cache *) + let ezfio_cache = + String.Table.create () + in + let handle_ezfio msg = + match Hashtbl.find ezfio_cache msg with + | Some result -> result + | None -> + begin + ZMQ.Socket.send_all req_socket ["Ezfio" ; msg]; + let result = + ZMQ.Socket.recv_all req_socket + in + match (Hashtbl.add ezfio_cache ~key:msg ~data:result) with + | `Ok -> result + | `Duplicate -> result + end + in + + + (* Main loop *) + while (!status <> Status.Stopped) + do + let polling = + ZMQ.Poll.poll ~timeout:1000 pollitem + in + if (polling.(0) = Some ZMQ.Poll.In) then + begin + let raw_msg = + ZMQ.Socket.recv_all ~block:false dealer_socket + in + let header, msg = + let rec aux header = function + | "" :: msg -> List.rev ("" :: header), Message.create msg + | head :: tail -> aux (head::header) tail + | _ -> failwith "Too many routers in the middle" + in + aux [] (List.map ~f:String.strip raw_msg) + in + let handle message = + match message with + | Message.Ezfio ezfio_msg -> + let result = + handle_ezfio ezfio_msg + in + ZMQ.Socket.send_all dealer_socket (header @ result) ; + | Message.GetWalkers n_walks -> + begin + if (!walk_num = 0) then + begin + walk_num := Qptypes.Strictly_positive_int.to_int n_walks; + walkers := fetch_walkers (); + end; + ZMQ.Socket.send_all dealer_socket (header @ !walkers); + walkers := fetch_walkers (); + end + | Message.Test -> + ZMQ.Socket.send_all dealer_socket (header @ [ "OK" ]); + | Message.Register _ + | Message.Unregister _ + | Message.Walkers _ + | Message.Property _ -> + failwith "Bad message" + in handle msg + end; + done; + ZMQ.Socket.set_linger_period dealer_socket 1000 ; + ZMQ.Socket.close dealer_socket; + ZMQ.Socket.set_linger_period req_socket 1000 ; + ZMQ.Socket.close req_socket; + in + Thread.create f + in + + (* Main thread *) + let start_main_thread = + let f () = + + let dealer_socket = + ZMQ.Socket.create zmq_context ZMQ.Socket.dealer + in + ZMQ.Socket.connect dealer_socket dataserver; + + let proxy_socket = + ZMQ.Socket.create zmq_context ZMQ.Socket.dealer + in + ZMQ.Socket.connect proxy_socket "inproc://dealer"; + + let router_socket = + ZMQ.Socket.create zmq_context ZMQ.Socket.router + and address = + Printf.sprintf "ipc://%s:%d" Qmcchem_config.dev_shm (port); + in + bind_socket "ROUTER" router_socket address; + ZMQ.Socket.set_receive_high_water_mark router_socket 100000; + ZMQ.Socket.set_send_high_water_mark router_socket 100000; + ZMQ.Socket.set_immediate router_socket true; + + (* Pull socket for computed data *) + let push_socket = + ZMQ.Socket.create zmq_context ZMQ.Socket.push + and address = + Printf.sprintf "tcp://%s:%d" dataserver_address (port+2-10) + in + ZMQ.Socket.connect push_socket address; + + let pull_socket = + ZMQ.Socket.create zmq_context ZMQ.Socket.pull + and address = + Printf.sprintf "ipc://%s:%d" Qmcchem_config.dev_shm (port+2); + in + bind_socket "PULL" pull_socket address; + + + (* Handles messages coming into the ROUTER socket. *) + let handle_router () = + let raw_msg = + ZMQ.Socket.recv_all ~block:false router_socket + in + let header, msg = + let rec aux header = function + | "" :: msg -> List.rev ("" :: header), Message.create msg + | head :: tail -> aux (head::header) tail + | _ -> failwith "Too many routers in the middle" + in + aux [] (List.map ~f:String.strip raw_msg) + in + let handle message = + match message with + | Message.GetWalkers _ + | Message.Ezfio _ + | Message.Test -> + ZMQ.Socket.send_all proxy_socket raw_msg; + | Message.Register _ + | Message.Unregister _ -> + ZMQ.Socket.send_all dealer_socket raw_msg; + | Message.Walkers (_, _, _) + | Message.Property _ -> + failwith "Bad message" + in handle msg + in + + let handle_dealer () = + ZMQ.Socket.recv_all ~block:false dealer_socket + |> ZMQ.Socket.send_all router_socket + in + + let handle_proxy () = + ZMQ.Socket.recv_all ~block:false proxy_socket + |> ZMQ.Socket.send_all router_socket + in + + (* Handles messages coming into the PULL socket. *) + let handle_pull () = + ZMQ.Socket.recv_all ~block:false pull_socket + |> ZMQ.Socket.send_all push_socket + in + + (* Polling item to poll ROUTER and PULL sockets. *) + let pollitem = + ZMQ.Poll.mask_of + [| (router_socket , ZMQ.Poll.In) ; + (pull_socket , ZMQ.Poll.In) ; + (dealer_socket, ZMQ.Poll.In) ; + (proxy_socket , ZMQ.Poll.In) + |] + in + (* Main loop *) + while (!status <> Status.Stopped) + do + let polling = + ZMQ.Poll.poll ~timeout:1000 pollitem + in + if (polling.(0) = Some ZMQ.Poll.In) then + handle_router (); + if (polling.(1) = Some ZMQ.Poll.In) then + handle_pull (); + if (polling.(2) = Some ZMQ.Poll.In) then + handle_dealer (); + if (polling.(3) = Some ZMQ.Poll.In) then + handle_proxy (); + done; + List.iter ~f:(fun socket -> + ZMQ.Socket.set_linger_period socket 1000 ; + ZMQ.Socket.close socket) + [ router_socket ; dealer_socket ; push_socket ; pull_socket ; proxy_socket ] + in + Thread.create f + in + + + (* Start the status thread and the main thread *) + begin + try + (List.iter ~f:Thread.join + [ start_status_thread (); + start_log_thread (); + start_proxy_thread (); + start_main_thread (); + ]) + with + | err -> + begin + print_endline "Trapped error. Waiting 10 seconds..."; + status := Status.Stopping; + Time.Span.of_sec 10. |> Time.pause; + raise err + end + end; + + (* Wait for the qmc process to complete *) + ignore (Watchdog.join ()); + terminate () + diff --git a/ocaml/Qmcchem_md5.ml b/ocaml/Qmcchem_md5.ml new file mode 100644 index 0000000..2374b6e --- /dev/null +++ b/ocaml/Qmcchem_md5.ml @@ -0,0 +1,113 @@ +open Core.Std + +let run ?c ?d ~l ezfio_filename = + + Ezfio.set_file ezfio_filename; + + let input_directory = + Lazy.force Md5.input_directory + in + + let handle_options () = + + let current_md5 = + Md5.hash () + in + + let filename_of_key key = + Filename.concat input_directory key + in + + let key_is_valid key = + let filename = + filename_of_key key + in + Sys.file_exists_exn filename + in + + let () = + match c with + | None -> () + | Some new_md5 -> + if (key_is_valid new_md5) then + Qmcchem_edit.run ~c:false ~input:(filename_of_key new_md5) ezfio_filename + else + failwith ("Error: " ^ new_md5 ^ " does not exist") + in + + let () = + match l with + | false -> () + | true -> + Sys.ls_dir input_directory + |> List.iter ~f:(fun md5 -> + let filename = + Filename.concat input_directory md5 + in + let this = + if (md5 = current_md5) then + "<-" + else + "" + in + let date = + (Unix.stat filename).Unix.st_mtime + in + let date = + Unix.strftime (Unix.localtime date) "%a, %d %b %Y %T %z" + in + Printf.printf "%s : %s %s\n" md5 date this) + in + + let () = + match d with + | None -> () + | Some other_key -> + if (key_is_valid other_key) then + let command = + String.concat ~sep:" " + [ "diff" ; "-u" ; "-w" ; + (filename_of_key current_md5) ; + (filename_of_key other_key) ] + in + match (Unix.system command) with + | _ -> () + else + failwith ("Error: " ^ other_key ^ " does not exist") + in + () + + in + + match (c,d,l) with + | (None,None,false) -> + Printf.printf "Current key :\n%s\n" (Md5.hash ()) + | _ -> handle_options () + + +let spec = + let open Command.Spec in + empty + +> flag "c" (optional string) + ~doc:(" Change to input to ") + +> flag "d" (optional string) + ~doc:(" Show input differences with ") + +> flag "l" no_arg + ~doc:(" List all the saved MD5 keys.") + +> anon ("ezfio_file" %: string) + + + +let command = + Command.basic + ~summary: "Manipulate input MD5 keys" + ~readme:(fun () -> + " +Manipulate input MD5 keys + ") + spec + (fun c d l ezfio_file () -> run ?c ?d ~l ezfio_file ) + + + + diff --git a/ocaml/Qmcchem_result.ml b/ocaml/Qmcchem_result.ml new file mode 100644 index 0000000..973e849 --- /dev/null +++ b/ocaml/Qmcchem_result.ml @@ -0,0 +1,225 @@ +open Core.Std +open Qptypes + +(** Display a table that can be plotted by gnuplot *) +let display_table property = + let p = Property.of_string property + |> Random_variable.of_raw_data + in + let conv = Random_variable.convergence p + and rconv = Random_variable.rev_convergence p + and data = p.Random_variable.data + in + let results = + List.map2_exn conv rconv ~f:(fun (val1, err1) (val2,err2) -> (val1, err1, val2, err2)) + in + List.iter2_exn results data ~f:(fun (val1, err1, val2, err2) block -> + Printf.printf "%10.6f %10.6f %10.6f %10.6f %10.6f\n" + val1 err1 val2 err2 (Sample.to_float block.Block.value) + ) +;; + + +(** Display a convergence plot of the requested property *) +let display_plot property = + print_string ("display_plot "^property^".\n") +;; + + +(** Display a convergence table of the error *) +let display_err_convergence property = + let p = + Property.of_string property + |> Random_variable.of_raw_data + in + let rec aux n p = + match Random_variable.ave_error p with + | (ave, Some error) -> + let (ave, error) = + Random_variable.Average.to_float ave, + Random_variable.Error.to_float error + in + Printf.printf "%10d %16.10f %16.10f\n" n ave error ; + begin + if ((3*n) < (List.length p.Random_variable.data)) then + let new_p = + Random_variable.compress p + in + aux (n+n) new_p + end + | (ave, None) -> () + in + aux 1 p +;; + +(** Display the centered cumulants of a property *) +let display_cumulants property = + let p = + Property.of_string property + |> Random_variable.of_raw_data + in + let cum = + Random_variable.centered_cumulants p + in + Printf.printf "Average = %16.10f\n" cum.(0); + Printf.printf "Variance = %16.10f\n" cum.(1); + Printf.printf "Centered k3 = %16.10f\n" cum.(2); + Printf.printf "Centered k4 = %16.10f\n" cum.(3); + print_newline (); + let n = 1. /. 12. *. cum.(2) *. cum.(2) +. + 1. /. 48. *. cum.(3) *. cum.(3) + in + Printf.printf "Non-gaussianity = %16.10f\n" n +;; + + +(** Display a table for the autocovariance of the property *) +let display_autocovariance property = + let p = + Property.of_string property + |> Random_variable.of_raw_data + in + Random_variable.autocovariance p + |> List.iteri ~f:(fun i x -> + Printf.printf "%10d %16.10f\n" i x) +;; + +(** Display a histogram of the property *) +let display_histogram property = + let p = + Property.of_string property + |> Random_variable.of_raw_data + in + let histo = + Random_variable.histogram p + + in + let g = + Random_variable.GaussianDist.create + ~mu:(Random_variable.average p) + ~sigma2:((Random_variable.centered_cumulants p).(1) + |> Random_variable.Variance.of_float) + in + let g = + Random_variable.GaussianDist.eval ~g + in + List.iter histo ~f:( fun (x,y) -> + Printf.printf "%16.10f %16.10f %16.10f\n" x y (g ~x)) + (* + and sigma2 = + (Random_variable.centered_cumulants p).(1) + and pi = + acos(-1.) + in + let one_over_2sigma2 = + 1. /. ( 2. *. sigma2 ) + and mu = + Random_variable.average p + and norm = + 1. /. (sqrt(sigma2 *. 2.*.pi)) + in + List.map histo ~f:(fun (x,y) -> + let g = + norm *. exp(-.((x-.mu)*.(x-.mu)*.one_over_2sigma2)) + in + (x,y,g) + ) + |> List.iter ~f:(fun (x,y,g) -> + Printf.printf "%16.10f %16.10f %16.10f\n" x y g) + *) +;; + + + +(** Display a summary of all the cmoputed quantities *) +let display_summary () = + + let properties = + Lazy.force Block.properties + and print_property property = + let p = Random_variable.of_raw_data property + in + Printf.printf "%20s : %s\n" + (Property.to_string property) + (Random_variable.to_string p) + in + List.iter properties ~f:print_property ; + + + let cpu = + Random_variable.of_raw_data Property.Cpu + |> Random_variable.sum + and wall = + Random_variable.of_raw_data Property.Wall + |> Random_variable.max_value_per_compute_node + |> Random_variable.sum + in + + let speedup = + cpu /. wall + in + Printf.printf "%20s : %10.2f x\n" "Speedup" speedup; +;; + + +let run ?a ?c ?e ?h ?t ?p ezfio_file = + + Ezfio.set_file ezfio_file; + let f (x,func) = + match x with + | Some property -> func property + | None -> () + in + + let l = + [ (a, display_autocovariance) ; + (c, display_cumulants) ; + (e, display_err_convergence) ; + (h, display_histogram) ; + (p, display_plot) ; + (t, display_table) ; + ] + in + + List.iter ~f l + ; + + if (List.fold ~init:true ~f:(fun accu x -> + match x with + | (None, _) -> accu && true + | (Some _,_) -> false + ) l + ) then + display_summary () +;; + + +let spec = + let open Command.Spec in + empty + +> flag "a" (optional string) + ~doc:"property Display the autcovariance function of the property" + +> flag "c" (optional string) + ~doc:"property Print the centered cumulants of a property" + +> flag "e" (optional string) + ~doc:"property Display the convergence of the error of the property by merging blocks" + +> flag "h" (optional string) + ~doc:"property Display the histogram of the property blocks" + +> flag "p" (optional string) + ~doc:"property Display a convergence plot for a property" + +> flag "t" (optional string) + ~doc:"property Print a table for the convergence of a property" + +> anon ("ezfio_file" %: string) +;; + +let command = + Command.basic + ~summary: "Displays the results computed in an EZFIO directory." + ~readme:(fun () -> "Displays the results computed in an EZFIO directory.") + spec + (fun a c e h p t ezfio_file () -> run ?a ?c ?e ?h ?t ?p ezfio_file ) +;; + + + + diff --git a/ocaml/Qmcchem_run.ml b/ocaml/Qmcchem_run.ml new file mode 100644 index 0000000..0ca3546 --- /dev/null +++ b/ocaml/Qmcchem_run.ml @@ -0,0 +1,217 @@ +open Core.Std + +let full_run ?(start_dataserver=true) ezfio_filename = + (* Identify the job scheduler *) + let launcher = + Launcher.find () + and scheduler = + Scheduler.find () + in + Printf.printf "Scheduler : %s\n" (Scheduler.to_string scheduler); + Printf.printf "Launcher : %s\n" (Launcher.to_string launcher ); + + + (* Create the node file *) + let server_file = + Filename.concat ezfio_filename "nodefile" + in + Out_channel.with_file server_file ~f:(fun out_channel -> + Launcher.create_nodefile () + |> Out_channel.output_string out_channel + ) ; + + + (* Get the configuration of executables *) + let qmcchem = + Lazy.force Qmcchem_config.qmcchem + and qmc = + [ Lazy.force Qmcchem_config.qmcchem ; "run" ; "-q" ] + in + + + if (start_dataserver) then + begin + (* Reset socket address in EZFIO *) + Ezfio.set_simulation_http_server "tcp://localhost:65534"; + + + (* Start the data server *) + let prog, args = + qmcchem, [ qmcchem; "run" ; "-d" ; ezfio_filename] + in + let pid_dataserver = + Watchdog.fork_exec ~prog ~args () + in + Printf.printf "%7d : %s\n%!" (Pid.to_int pid_dataserver) (String.concat ~sep:" " args) + end; + + + (* Check if the ZMQ Rep socket is open *) + let test_open_rep_socket () = + let zmq_context = + ZMQ.Context.create () + in + let socket = + ZMQ.Socket.create zmq_context ZMQ.Socket.req + and address = + Ezfio.get_simulation_http_server () + in + let reply = + try + ( + ZMQ.Socket.set_receive_timeout socket 100; + ZMQ.Socket.connect socket address; + ZMQ.Socket.send socket (Message.(to_string Test)); + ZMQ.Socket.recv socket + ) with + | Unix.Unix_error _ -> + begin + ZMQ.Socket.set_linger_period socket 1 ; + ZMQ.Socket.close socket; + ZMQ.Context.terminate zmq_context; + "Failed" + end + in + reply = "OK" + in + + + (* Wait until the rep socket is open *) + let rec count = function + | 0 -> false + | -1 -> true + | n -> + if (not (test_open_rep_socket ())) then + begin + Time.pause (Time.Span.of_float 0.5); + count (n-1); + end + else + count (-1); + in + if (not (count 300)) then + Watchdog.kill (); + + + (* Start the qmc processes *) + let prog, args = + let launcher = + Launcher.(find () |> to_string) + in + match launcher + |> String.split ~on:' ' + |> List.map ~f:String.strip + |> List.filter ~f:(fun x -> x <> "") + with + | launcher_exe::launcher_flags -> + launcher_exe, launcher_exe :: launcher_flags @ qmc @ [ + Ezfio.get_simulation_http_server () ; ezfio_filename ] + | _ -> failwith "Error in launcher" + in + let pid_qmc = + try + Watchdog.fork_exec ~prog ~args () + with + | Unix.Unix_error _ -> + begin + let command = + String.concat ~sep:" " args + in + Printf.printf " +============================================================ +Error: Unable to run the following command + %s +============================================================ +\n%!" command ; + Watchdog.kill () + end + in + Printf.printf "%7d : %s\n%!" (Pid.to_int pid_qmc) (String.concat ~sep:" " args); + + (* Wait for processes to finish *) + Watchdog.join () + + +let data_run ezfio_filename = + Qmcchem_dataserver.run ezfio_filename ~daemon:false + +let qmc_run dataserver ezfio_filename = + Qmcchem_forwarder.run ezfio_filename dataserver + +let ssh_run host dataserver ezfio_filename = + print_endline ("ssh "^host^" "^ezfio_filename^" "^dataserver) + +let run a d ?q ?s ezfio_filename = + + Ezfio.set_file ezfio_filename; + let ezfio_filename = + Lazy.force Qputils.ezfio_filename + in + + (* Signal handler to Kill properly all the processes *) + let handler s = + Printf.printf "Received the %s signal... killing\n" (Signal.to_string s); + Watchdog.kill (); + in + List.iter [ + Signal.term ; + Signal.quit ; + Signal.int + ] + ~f:(fun x -> Signal.Expert.handle x handler) + ; + + (* Validate input *) + Input.validate (); +(* Printf.printf "MD5 : %s\n" (Lazy.force Md5.hash) ; *) + + let runtype = + match (a,d,q,s) with + | (false,false, None, None) -> `Run + | (false,true, None, None) -> `Data + | (true,false, None, None) -> `Add + | (false,false, Some dataserver, None) -> `Qmc dataserver + | (false,false, Some dataserver, Some host) -> `Ssh (host, dataserver) + | _ -> failwith "Options (-a|-d|-q [-s]) are mutually exclusive" + in + + let run = + match runtype with + | `Run -> full_run ~start_dataserver:true + | `Data -> data_run + | `Add -> full_run ~start_dataserver:false + | `Qmc dataserver -> qmc_run dataserver + | `Ssh (host,dataserver) -> ssh_run host dataserver + in + run ezfio_filename + + + + +let spec = + let open Command.Spec in + empty + +> flag "a" no_arg + ~doc:(" Add more resources to a running calculation.") + +> flag "d" no_arg + ~doc:(" Start a dataserver process on the local host.") + +> flag "q" (optional string) + ~doc:(" Start a qmc process on the local host.") + +> flag "s" (optional string) + ~doc:(" Start a qmc process on .") + +> anon ("ezfio_file" %: string) + + + +let command = + Command.basic + ~summary: "Run a calculation" + ~readme:(fun () -> + " +Run QMC=Chem + ") + spec + (fun a d q s ezfio_file () -> run a d ?q ?s ezfio_file ) + + + diff --git a/ocaml/Qmcchem_stop.ml b/ocaml/Qmcchem_stop.ml new file mode 100644 index 0000000..8b6b77c --- /dev/null +++ b/ocaml/Qmcchem_stop.ml @@ -0,0 +1,24 @@ +open Core.Std + + +let run ezfio_filename = + Ezfio.set_file ezfio_filename ; + Status.write Status.Stopping + + +let spec = + let open Command.Spec in + empty + +> anon ("ezfio_file" %: string) + +let command = + Command.basic + ~summary: "Stop a running calculation" + ~readme:(fun () -> + " +Stop a running calculation + ") + spec + (fun ezfio_file () -> run ezfio_file ) + + diff --git a/ocaml/Qptypes.ml b/ocaml/Qptypes.ml new file mode 100644 index 0000000..091df99 --- /dev/null +++ b/ocaml/Qptypes.ml @@ -0,0 +1,830 @@ +open Core.Std +let warning = print_string + + + +module Positive_float : sig + type t with sexp + val to_float : t -> float + val of_float : float -> t + val to_string : t -> string +end = struct + type t = float with sexp + let to_float x = x + let of_float x = ( assert (x >= 0.) ; x ) + let to_string x = Float.to_string x +end + + +module Strictly_positive_float : sig + type t with sexp + val to_float : t -> float + val of_float : float -> t + val to_string : t -> string +end = struct + type t = float with sexp + let to_float x = x + let of_float x = ( assert (x > 0.) ; x ) + let to_string x = Float.to_string x +end + + +module Negative_float : sig + type t with sexp + val to_float : t -> float + val of_float : float -> t + val to_string : t -> string +end = struct + type t = float with sexp + let to_float x = x + let of_float x = ( assert (x <= 0.) ; x ) + let to_string x = Float.to_string x +end + + +module Strictly_negative_float : sig + type t with sexp + val to_float : t -> float + val of_float : float -> t + val to_string : t -> string +end = struct + type t = float with sexp + let to_float x = x + let of_float x = ( assert (x < 0.) ; x ) + let to_string x = Float.to_string x +end + + +module Positive_int : sig + type t with sexp + val to_int : t -> int + val of_int : int -> t + val to_string : t -> string +end = struct + type t = int with sexp + let to_int x = x + let of_int x = ( assert (x >= 0) ; x ) + let to_string x = Int.to_string x +end + + +module Strictly_positive_int : sig + type t with sexp + val to_int : t -> int + val of_int : int -> t + val to_string : t -> string +end = struct + type t = int with sexp + let to_int x = x + let of_int x = ( assert (x > 0) ; x ) + let to_string x = Int.to_string x +end + + +module Negative_int : sig + type t with sexp + val to_int : t -> int + val of_int : int -> t + val to_string : t -> string +end = struct + type t = int with sexp + let to_int x = x + let of_int x = ( assert (x <= 0) ; x ) + let to_string x = Int.to_string x +end + + +module Det_coef : sig + type t with sexp + val to_float : t -> float + val of_float : float -> t + val to_string : t -> string +end = struct + type t = float with sexp + let to_float x = x + let of_float x = ( assert (x >= -1.) ; + assert (x <= 1.) ; x ) + let to_string x = Float.to_string x +end + + +module Normalized_float : sig + type t with sexp + val to_float : t -> float + val of_float : float -> t + val to_string : t -> string +end = struct + type t = float with sexp + let to_float x = x + let of_float x = ( assert (x <= 1.) ; + assert (x >= 0.) ; x ) + let to_string x = Float.to_string x +end + + +module Strictly_negative_int : sig + type t with sexp + val to_int : t -> int + val of_int : int -> t + val to_string : t -> string +end = struct + type t = int with sexp + let to_int x = x + let of_int x = ( assert (x < 0) ; x ) + let to_string x = Int.to_string x +end + + +module Non_empty_string : sig + type t with sexp + val to_string : t -> string + val of_string : string -> t + val to_string : t -> string +end = struct + type t = string with sexp + let to_string x = x + let of_string x = ( assert (x <> "") ; x ) + let to_string x = String.to_string x +end + + +module Det_number_max : sig + type t with sexp + val to_int : t -> int + val of_int : int -> t + val to_string : t -> string +end = struct + type t = int with sexp + let to_int x = x + let of_int x = ( assert (x > 0) ; + if (x > 100000000) then + warning "More than 100 million determinants"; x ) + let to_string x = Int.to_string x +end + + +module MO_coef : sig + type t with sexp + val to_float : t -> float + val of_float : float -> t + val to_string : t -> string +end = struct + type t = float with sexp + let to_float x = x + let of_float x = ( x ) + let to_string x = Float.to_string x +end + + +module MO_occ : sig + type t with sexp + val to_float : t -> float + val of_float : float -> t + val to_string : t -> string +end = struct + type t = float with sexp + let to_float x = x + let of_float x = ( assert (x >= 0.); x ) + let to_string x = Float.to_string x +end + + +module AO_coef : sig + type t with sexp + val to_float : t -> float + val of_float : float -> t + val to_string : t -> string +end = struct + type t = float with sexp + let to_float x = x + let of_float x = ( x ) + let to_string x = Float.to_string x +end + + +module AO_expo : sig + type t with sexp + val to_float : t -> float + val of_float : float -> t + val to_string : t -> string +end = struct + type t = float with sexp + let to_float x = x + let of_float x = ( assert (x >= 0.) ; x ) + let to_string x = Float.to_string x +end + + +module AO_prim_number : sig + type t with sexp + val to_int : t -> int + val of_int : int -> t + val to_string : t -> string +end = struct + type t = int with sexp + let to_int x = x + let of_int x = ( assert (x > 0) ; x ) + let to_string x = Int.to_string x +end + + +module Threshold : sig + type t with sexp + val to_float : t -> float + val of_float : float -> t + val to_string : t -> string +end = struct + type t = float with sexp + let to_float x = x + let of_float x = ( assert (x >= 0.) ; + assert (x <= 1.) ; x ) + let to_string x = Float.to_string x +end + + +module PT2_energy : sig + type t with sexp + val to_float : t -> float + val of_float : float -> t + val to_string : t -> string +end = struct + type t = float with sexp + let to_float x = x + let of_float x = ( assert (x >=0.) ; x ) + let to_string x = Float.to_string x +end + + +module Elec_alpha_number : sig + type t with sexp + val to_int : t -> int + val of_int : int -> t + val to_string : t -> string +end = struct + type t = int with sexp + let to_int x = x + let of_int x = ( assert (x > 0) ; x ) + let to_string x = Int.to_string x +end + + +module Elec_beta_number : sig + type t with sexp + val to_int : t -> int + val of_int : int -> t + val to_string : t -> string +end = struct + type t = int with sexp + let to_int x = x + let of_int x = ( assert (x >= 0) ; x ) + let to_string x = Int.to_string x +end + + +module Elec_number : sig + type t with sexp + val to_int : t -> int + val of_int : int -> t + val to_string : t -> string +end = struct + type t = int with sexp + let to_int x = x + let of_int x = ( assert (x > 0) ; x ) + let to_string x = Int.to_string x +end + + +module MD5 : sig + type t with sexp + val to_string : t -> string + val of_string : string -> t + val to_string : t -> string +end = struct + type t = string with sexp + let to_string x = x + let of_string x = ( assert ((String.length x) = 32); x ) + let to_string x = String.to_string x +end + + +module Rst_string : sig + type t with sexp + val to_string : t -> string + val of_string : string -> t + val to_string : t -> string +end = struct + type t = string with sexp + let to_string x = x + let of_string x = ( x ) + let to_string x = String.to_string x +end + + +module Weight : sig + type t with sexp + val to_float : t -> float + val of_float : float -> t + val to_string : t -> string +end = struct + type t = float with sexp + let to_float x = x + let of_float x = ( assert (x >= 0.) ; x ) + let to_string x = Float.to_string x +end + + +module Block_id : sig + type t with sexp + val to_int : t -> int + val of_int : int -> t + val to_string : t -> string +end = struct + type t = int with sexp + let to_int x = x + let of_int x = ( assert (x > 0) ; x ) + let to_string x = Int.to_string x +end + + +module Compute_node : sig + type t with sexp + val to_string : t -> string + val of_string : string -> t + val to_string : t -> string +end = struct + type t = string with sexp + let to_string x = x + let of_string x = ( assert (x <> "") ; x ) + let to_string x = String.to_string x +end + + + +module MO_number : sig + type t with sexp + val to_int : t -> int + val get_max : unit -> int + val of_int : ?min:int -> ?max:int -> int -> t + val to_string : t -> string +end = struct + type t = int with sexp + let to_string x = Int.to_string x + let get_max () = + if (Ezfio.has_mo_basis_mo_tot_num ()) then + Ezfio.get_mo_basis_mo_tot_num () + else + 10000 + let get_min () = + 1 + let to_int x = x + let of_int ?(min=get_min ()) ?(max=get_max ()) x = + begin + assert (x >= min) ; + if (x > 10000) then + warning "More than 10000 MOs"; + begin + match max with + | 1 -> () + | i -> assert ( x <= i ) + end ; + x + end +end + +module AO_number : sig + type t with sexp + val to_int : t -> int + val get_max : unit -> int + val of_int : ?min:int -> ?max:int -> int -> t + val to_string : t -> string +end = struct + type t = int with sexp + let to_string x = Int.to_string x + let get_max () = + if (Ezfio.has_ao_basis_ao_num ()) then + Ezfio.get_ao_basis_ao_num () + else + 10000 + let get_min () = + 1 + let to_int x = x + let of_int ?(min=get_min ()) ?(max=get_max ()) x = + begin + assert (x >= min) ; + if (x > 10000) then + warning "More than 10000 AOs"; + begin + match max with + | 1 -> () + | i -> assert ( x <= i ) + end ; + x + end +end + +module Nucl_number : sig + type t with sexp + val to_int : t -> int + val get_max : unit -> int + val of_int : ?min:int -> ?max:int -> int -> t + val to_string : t -> string +end = struct + type t = int with sexp + let to_string x = Int.to_string x + let get_max () = + if (Ezfio.has_nuclei_nucl_num ()) then + Ezfio.get_nuclei_nucl_num () + else + 10000 + let get_min () = + 1 + let to_int x = x + let of_int ?(min=get_min ()) ?(max=get_max ()) x = + begin + assert (x >= min) ; + if (x > 10000) then + warning "More than 10000 nuclei"; + begin + match max with + | 1 -> () + | i -> assert ( x <= i ) + end ; + x + end +end + +let decode_ezfio_message msg = +match msg with + | "get_blocks_empty" -> Ezfio.read_string "blocks" "empty" + | "get_mo_basis_mo_tot_num" -> Ezfio.read_string "mo_basis" "mo_tot_num" + | "get_mo_basis_mo_coef" -> + Ezfio.read_string_array "mo_basis" "mo_coef" + |> Ezfio.flattened_ezfio + |> Array.to_list + |> String.concat ~sep:" " + | "get_mo_basis_mo_classif" -> + Ezfio.read_string_array "mo_basis" "mo_classif" + |> Ezfio.flattened_ezfio + |> Array.to_list + |> String.concat ~sep:" " + | "get_mo_basis_mo_energy" -> + Ezfio.read_string_array "mo_basis" "mo_energy" + |> Ezfio.flattened_ezfio + |> Array.to_list + |> String.concat ~sep:" " + | "get_mo_basis_mo_occ" -> + Ezfio.read_string_array "mo_basis" "mo_occ" + |> Ezfio.flattened_ezfio + |> Array.to_list + |> String.concat ~sep:" " + | "get_mo_basis_mo_symmetry" -> + Ezfio.read_string_array "mo_basis" "mo_symmetry" + |> Ezfio.flattened_ezfio + |> Array.to_list + |> String.concat ~sep:" " + | "get_pseudo_ao_pseudo_grid" -> + Ezfio.read_string_array "pseudo" "ao_pseudo_grid" + |> Ezfio.flattened_ezfio + |> Array.to_list + |> String.concat ~sep:" " + | "get_pseudo_do_pseudo" -> Ezfio.read_string "pseudo" "do_pseudo" + | "get_pseudo_mo_pseudo_grid" -> + Ezfio.read_string_array "pseudo" "mo_pseudo_grid" + |> Ezfio.flattened_ezfio + |> Array.to_list + |> String.concat ~sep:" " + | "get_pseudo_pseudo_dz_k" -> + Ezfio.read_string_array "pseudo" "pseudo_dz_k" + |> Ezfio.flattened_ezfio + |> Array.to_list + |> String.concat ~sep:" " + | "get_pseudo_pseudo_dz_kl" -> + Ezfio.read_string_array "pseudo" "pseudo_dz_kl" + |> Ezfio.flattened_ezfio + |> Array.to_list + |> String.concat ~sep:" " + | "get_pseudo_pseudo_grid_rmax" -> Ezfio.read_string "pseudo" "pseudo_grid_rmax" + | "get_pseudo_pseudo_grid_size" -> Ezfio.read_string "pseudo" "pseudo_grid_size" + | "get_pseudo_pseudo_klocmax" -> Ezfio.read_string "pseudo" "pseudo_klocmax" + | "get_pseudo_pseudo_kmax" -> Ezfio.read_string "pseudo" "pseudo_kmax" + | "get_pseudo_pseudo_lmax" -> Ezfio.read_string "pseudo" "pseudo_lmax" + | "get_pseudo_pseudo_n_k" -> + Ezfio.read_string_array "pseudo" "pseudo_n_k" + |> Ezfio.flattened_ezfio + |> Array.to_list + |> String.concat ~sep:" " + | "get_pseudo_pseudo_n_kl" -> + Ezfio.read_string_array "pseudo" "pseudo_n_kl" + |> Ezfio.flattened_ezfio + |> Array.to_list + |> String.concat ~sep:" " + | "get_pseudo_pseudo_v_k" -> + Ezfio.read_string_array "pseudo" "pseudo_v_k" + |> Ezfio.flattened_ezfio + |> Array.to_list + |> String.concat ~sep:" " + | "get_pseudo_pseudo_v_kl" -> + Ezfio.read_string_array "pseudo" "pseudo_v_kl" + |> Ezfio.flattened_ezfio + |> Array.to_list + |> String.concat ~sep:" " + | "get_ezfio_creation" -> Ezfio.read_string "ezfio" "creation" + | "get_ezfio_user" -> Ezfio.read_string "ezfio" "user" + | "get_ezfio_library" -> Ezfio.read_string "ezfio" "library" + | "get_ezfio_last_library" -> Ezfio.read_string "ezfio" "last_library" + | "get_simulation_do_run" -> Ezfio.read_string "simulation" "do_run" + | "get_simulation_stop_time" -> Ezfio.read_string "simulation" "stop_time" + | "get_simulation_equilibration" -> Ezfio.read_string "simulation" "equilibration" + | "get_simulation_title" -> Ezfio.read_string "simulation" "title" + | "get_simulation_http_server" -> Ezfio.read_string "simulation" "http_server" + | "get_simulation_do_jast" -> Ezfio.read_string "simulation" "do_jast" + | "get_simulation_do_nucl_fitcusp" -> Ezfio.read_string "simulation" "do_nucl_fitcusp" + | "get_simulation_method" -> Ezfio.read_string "simulation" "method" + | "get_simulation_block_time" -> Ezfio.read_string "simulation" "block_time" + | "get_simulation_sampling" -> Ezfio.read_string "simulation" "sampling" + | "get_simulation_save_data" -> Ezfio.read_string "simulation" "save_data" + | "get_simulation_time_step" -> Ezfio.read_string "simulation" "time_step" + | "get_simulation_print_level" -> Ezfio.read_string "simulation" "print_level" + | "get_simulation_ci_threshold" -> Ezfio.read_string "simulation" "ci_threshold" + | "get_simulation_md5_key" -> Ezfio.read_string "simulation" "md5_key" + | "get_simulation_orig_time" -> Ezfio.read_string "simulation" "orig_time" + | "get_simulation_e_ref" -> Ezfio.read_string "simulation" "e_ref" + | "get_spindeterminants_n_det_alpha" -> Ezfio.read_string "spindeterminants" "n_det_alpha" + | "get_spindeterminants_n_det_beta" -> Ezfio.read_string "spindeterminants" "n_det_beta" + | "get_spindeterminants_n_det" -> Ezfio.read_string "spindeterminants" "n_det" + | "get_spindeterminants_n_int" -> Ezfio.read_string "spindeterminants" "n_int" + | "get_spindeterminants_bit_kind" -> Ezfio.read_string "spindeterminants" "bit_kind" + | "get_spindeterminants_n_states" -> Ezfio.read_string "spindeterminants" "n_states" + | "get_spindeterminants_psi_det_alpha" -> + Ezfio.read_string_array "spindeterminants" "psi_det_alpha" + |> Ezfio.flattened_ezfio + |> Array.to_list + |> String.concat ~sep:" " + | "get_spindeterminants_psi_det_beta" -> + Ezfio.read_string_array "spindeterminants" "psi_det_beta" + |> Ezfio.flattened_ezfio + |> Array.to_list + |> String.concat ~sep:" " + | "get_spindeterminants_psi_coef_matrix_rows" -> + Ezfio.read_string_array "spindeterminants" "psi_coef_matrix_rows" + |> Ezfio.flattened_ezfio + |> Array.to_list + |> String.concat ~sep:" " + | "get_spindeterminants_psi_coef_matrix_columns" -> + Ezfio.read_string_array "spindeterminants" "psi_coef_matrix_columns" + |> Ezfio.flattened_ezfio + |> Array.to_list + |> String.concat ~sep:" " + | "get_spindeterminants_psi_coef_matrix_values" -> + Ezfio.read_string_array "spindeterminants" "psi_coef_matrix_values" + |> Ezfio.flattened_ezfio + |> Array.to_list + |> String.concat ~sep:" " + | "get_ao_basis_ao_num" -> Ezfio.read_string "ao_basis" "ao_num" + | "get_ao_basis_ao_prim_num" -> + Ezfio.read_string_array "ao_basis" "ao_prim_num" + |> Ezfio.flattened_ezfio + |> Array.to_list + |> String.concat ~sep:" " + | "get_ao_basis_ao_nucl" -> + Ezfio.read_string_array "ao_basis" "ao_nucl" + |> Ezfio.flattened_ezfio + |> Array.to_list + |> String.concat ~sep:" " + | "get_ao_basis_ao_power" -> + Ezfio.read_string_array "ao_basis" "ao_power" + |> Ezfio.flattened_ezfio + |> Array.to_list + |> String.concat ~sep:" " + | "get_ao_basis_ao_coef" -> + Ezfio.read_string_array "ao_basis" "ao_coef" + |> Ezfio.flattened_ezfio + |> Array.to_list + |> String.concat ~sep:" " + | "get_ao_basis_ao_expo" -> + Ezfio.read_string_array "ao_basis" "ao_expo" + |> Ezfio.flattened_ezfio + |> Array.to_list + |> String.concat ~sep:" " + | "get_electrons_elec_alpha_num" -> Ezfio.read_string "electrons" "elec_alpha_num" + | "get_electrons_elec_beta_num" -> Ezfio.read_string "electrons" "elec_beta_num" + | "get_electrons_elec_walk_num_tot" -> Ezfio.read_string "electrons" "elec_walk_num_tot" + | "get_electrons_elec_walk_num" -> Ezfio.read_string "electrons" "elec_walk_num" + | "get_electrons_elec_coord_pool" -> + Ezfio.read_string_array "electrons" "elec_coord_pool" + |> Ezfio.flattened_ezfio + |> Array.to_list + |> String.concat ~sep:" " + | "get_electrons_elec_coord_pool_size" -> Ezfio.read_string "electrons" "elec_coord_pool_size" + | "get_electrons_elec_fitcusp_radius" -> Ezfio.read_string "electrons" "elec_fitcusp_radius" + | "get_jastrow_jast_type" -> Ezfio.read_string "jastrow" "jast_type" + | "get_jastrow_jast_a_up_up" -> Ezfio.read_string "jastrow" "jast_a_up_up" + | "get_jastrow_jast_a_up_dn" -> Ezfio.read_string "jastrow" "jast_a_up_dn" + | "get_jastrow_jast_b_up_up" -> Ezfio.read_string "jastrow" "jast_b_up_up" + | "get_jastrow_jast_b_up_dn" -> Ezfio.read_string "jastrow" "jast_b_up_dn" + | "get_jastrow_jast_pen" -> + Ezfio.read_string_array "jastrow" "jast_pen" + |> Ezfio.flattened_ezfio + |> Array.to_list + |> String.concat ~sep:" " + | "get_jastrow_jast_een_e_a" -> + Ezfio.read_string_array "jastrow" "jast_een_e_a" + |> Ezfio.flattened_ezfio + |> Array.to_list + |> String.concat ~sep:" " + | "get_jastrow_jast_een_e_b" -> + Ezfio.read_string_array "jastrow" "jast_een_e_b" + |> Ezfio.flattened_ezfio + |> Array.to_list + |> String.concat ~sep:" " + | "get_jastrow_jast_een_n" -> + Ezfio.read_string_array "jastrow" "jast_een_n" + |> Ezfio.flattened_ezfio + |> Array.to_list + |> String.concat ~sep:" " + | "get_jastrow_jast_core_a1" -> + Ezfio.read_string_array "jastrow" "jast_core_a1" + |> Ezfio.flattened_ezfio + |> Array.to_list + |> String.concat ~sep:" " + | "get_jastrow_jast_core_a2" -> + Ezfio.read_string_array "jastrow" "jast_core_a2" + |> Ezfio.flattened_ezfio + |> Array.to_list + |> String.concat ~sep:" " + | "get_jastrow_jast_core_b1" -> + Ezfio.read_string_array "jastrow" "jast_core_b1" + |> Ezfio.flattened_ezfio + |> Array.to_list + |> String.concat ~sep:" " + | "get_jastrow_jast_core_b2" -> + Ezfio.read_string_array "jastrow" "jast_core_b2" + |> Ezfio.flattened_ezfio + |> Array.to_list + |> String.concat ~sep:" " + | "get_nuclei_nucl_num" -> Ezfio.read_string "nuclei" "nucl_num" + | "get_nuclei_nucl_label" -> + Ezfio.read_string_array "nuclei" "nucl_label" + |> Ezfio.flattened_ezfio + |> Array.to_list + |> String.concat ~sep:" " + | "get_nuclei_nucl_charge" -> + Ezfio.read_string_array "nuclei" "nucl_charge" + |> Ezfio.flattened_ezfio + |> Array.to_list + |> String.concat ~sep:" " + | "get_nuclei_nucl_coord" -> + Ezfio.read_string_array "nuclei" "nucl_coord" + |> Ezfio.flattened_ezfio + |> Array.to_list + |> String.concat ~sep:" " + | "get_nuclei_nucl_fitcusp_radius" -> + Ezfio.read_string_array "nuclei" "nucl_fitcusp_radius" + |> Ezfio.flattened_ezfio + |> Array.to_list + |> String.concat ~sep:" " + | "get_properties_d_var_jast_a_up_dn" -> Ezfio.read_string "properties" "d_var_jast_a_up_dn" + | "get_properties_d_var_jast_a_up_up" -> Ezfio.read_string "properties" "d_var_jast_a_up_up" + | "get_properties_d_var_jast_b_up_dn" -> Ezfio.read_string "properties" "d_var_jast_b_up_dn" + | "get_properties_d_var_jast_b_up_up" -> Ezfio.read_string "properties" "d_var_jast_b_up_up" + | "get_properties_d_var_jast_core_a1" -> Ezfio.read_string "properties" "d_var_jast_core_a1" + | "get_properties_d_var_jast_core_b1" -> Ezfio.read_string "properties" "d_var_jast_core_b1" + | "get_properties_d_var_jast_een_e_a" -> Ezfio.read_string "properties" "d_var_jast_een_e_a" + | "get_properties_d_var_jast_een_e_b" -> Ezfio.read_string "properties" "d_var_jast_een_e_b" + | "get_properties_d_var_jast_een_n" -> Ezfio.read_string "properties" "d_var_jast_een_n" + | "get_properties_d_var_jast_pen" -> Ezfio.read_string "properties" "d_var_jast_pen" + | "get_properties_density1d" -> Ezfio.read_string "properties" "density1d" + | "get_properties_dipole" -> Ezfio.read_string "properties" "dipole" + | "get_properties_drift_mod" -> Ezfio.read_string "properties" "drift_mod" + | "get_properties_e_kin" -> Ezfio.read_string "properties" "e_kin" + | "get_properties_e_loc" -> Ezfio.read_string "properties" "e_loc" + | "get_properties_e_loc_one" -> Ezfio.read_string "properties" "e_loc_one" + | "get_properties_e_loc_per_electron" -> Ezfio.read_string "properties" "e_loc_per_electron" + | "get_properties_e_loc_split_core" -> Ezfio.read_string "properties" "e_loc_split_core" + | "get_properties_e_loc_two" -> Ezfio.read_string "properties" "e_loc_two" + | "get_properties_e_nucl" -> Ezfio.read_string "properties" "e_nucl" + | "get_properties_e_pot" -> Ezfio.read_string "properties" "e_pot" + | "get_properties_e_pot_one" -> Ezfio.read_string "properties" "e_pot_one" + | "get_properties_n_s_inverted" -> Ezfio.read_string "properties" "n_s_inverted" + | "get_properties_n_s_updated" -> Ezfio.read_string "properties" "n_s_updated" + | "get_properties_n_s_updates" -> Ezfio.read_string "properties" "n_s_updates" + | "get_properties_voronoi_charges" -> Ezfio.read_string "properties" "voronoi_charges" + | "get_properties_voronoi_charges_covariance" -> Ezfio.read_string "properties" "voronoi_charges_covariance" + | "get_properties_voronoi_dipoles" -> Ezfio.read_string "properties" "voronoi_dipoles" + | "get_properties_wf_extension" -> Ezfio.read_string "properties" "wf_extension" + | "has_blocks_empty" -> if (Ezfio.has_blocks_empty ()) then "T" else "F" + | "has_mo_basis_mo_tot_num" -> if (Ezfio.has_mo_basis_mo_tot_num ()) then "T" else "F" + | "has_mo_basis_mo_coef" -> if (Ezfio.has_mo_basis_mo_coef ()) then "T" else "F" + | "has_mo_basis_mo_classif" -> if (Ezfio.has_mo_basis_mo_classif ()) then "T" else "F" + | "has_mo_basis_mo_energy" -> if (Ezfio.has_mo_basis_mo_energy ()) then "T" else "F" + | "has_mo_basis_mo_occ" -> if (Ezfio.has_mo_basis_mo_occ ()) then "T" else "F" + | "has_mo_basis_mo_symmetry" -> if (Ezfio.has_mo_basis_mo_symmetry ()) then "T" else "F" + | "has_pseudo_ao_pseudo_grid" -> if (Ezfio.has_pseudo_ao_pseudo_grid ()) then "T" else "F" + | "has_pseudo_do_pseudo" -> if (Ezfio.has_pseudo_do_pseudo ()) then "T" else "F" + | "has_pseudo_mo_pseudo_grid" -> if (Ezfio.has_pseudo_mo_pseudo_grid ()) then "T" else "F" + | "has_pseudo_pseudo_dz_k" -> if (Ezfio.has_pseudo_pseudo_dz_k ()) then "T" else "F" + | "has_pseudo_pseudo_dz_kl" -> if (Ezfio.has_pseudo_pseudo_dz_kl ()) then "T" else "F" + | "has_pseudo_pseudo_grid_rmax" -> if (Ezfio.has_pseudo_pseudo_grid_rmax ()) then "T" else "F" + | "has_pseudo_pseudo_grid_size" -> if (Ezfio.has_pseudo_pseudo_grid_size ()) then "T" else "F" + | "has_pseudo_pseudo_klocmax" -> if (Ezfio.has_pseudo_pseudo_klocmax ()) then "T" else "F" + | "has_pseudo_pseudo_kmax" -> if (Ezfio.has_pseudo_pseudo_kmax ()) then "T" else "F" + | "has_pseudo_pseudo_lmax" -> if (Ezfio.has_pseudo_pseudo_lmax ()) then "T" else "F" + | "has_pseudo_pseudo_n_k" -> if (Ezfio.has_pseudo_pseudo_n_k ()) then "T" else "F" + | "has_pseudo_pseudo_n_kl" -> if (Ezfio.has_pseudo_pseudo_n_kl ()) then "T" else "F" + | "has_pseudo_pseudo_v_k" -> if (Ezfio.has_pseudo_pseudo_v_k ()) then "T" else "F" + | "has_pseudo_pseudo_v_kl" -> if (Ezfio.has_pseudo_pseudo_v_kl ()) then "T" else "F" + | "has_ezfio_creation" -> if (Ezfio.has_ezfio_creation ()) then "T" else "F" + | "has_ezfio_user" -> if (Ezfio.has_ezfio_user ()) then "T" else "F" + | "has_ezfio_library" -> if (Ezfio.has_ezfio_library ()) then "T" else "F" + | "has_ezfio_last_library" -> if (Ezfio.has_ezfio_last_library ()) then "T" else "F" + | "has_simulation_do_run" -> if (Ezfio.has_simulation_do_run ()) then "T" else "F" + | "has_simulation_stop_time" -> if (Ezfio.has_simulation_stop_time ()) then "T" else "F" + | "has_simulation_equilibration" -> if (Ezfio.has_simulation_equilibration ()) then "T" else "F" + | "has_simulation_title" -> if (Ezfio.has_simulation_title ()) then "T" else "F" + | "has_simulation_http_server" -> if (Ezfio.has_simulation_http_server ()) then "T" else "F" + | "has_simulation_do_jast" -> if (Ezfio.has_simulation_do_jast ()) then "T" else "F" + | "has_simulation_do_nucl_fitcusp" -> if (Ezfio.has_simulation_do_nucl_fitcusp ()) then "T" else "F" + | "has_simulation_method" -> if (Ezfio.has_simulation_method ()) then "T" else "F" + | "has_simulation_block_time" -> if (Ezfio.has_simulation_block_time ()) then "T" else "F" + | "has_simulation_sampling" -> if (Ezfio.has_simulation_sampling ()) then "T" else "F" + | "has_simulation_save_data" -> if (Ezfio.has_simulation_save_data ()) then "T" else "F" + | "has_simulation_time_step" -> if (Ezfio.has_simulation_time_step ()) then "T" else "F" + | "has_simulation_print_level" -> if (Ezfio.has_simulation_print_level ()) then "T" else "F" + | "has_simulation_ci_threshold" -> if (Ezfio.has_simulation_ci_threshold ()) then "T" else "F" + | "has_simulation_md5_key" -> if (Ezfio.has_simulation_md5_key ()) then "T" else "F" + | "has_simulation_orig_time" -> if (Ezfio.has_simulation_orig_time ()) then "T" else "F" + | "has_simulation_e_ref" -> if (Ezfio.has_simulation_e_ref ()) then "T" else "F" + | "has_spindeterminants_n_det_alpha" -> if (Ezfio.has_spindeterminants_n_det_alpha ()) then "T" else "F" + | "has_spindeterminants_n_det_beta" -> if (Ezfio.has_spindeterminants_n_det_beta ()) then "T" else "F" + | "has_spindeterminants_n_det" -> if (Ezfio.has_spindeterminants_n_det ()) then "T" else "F" + | "has_spindeterminants_n_int" -> if (Ezfio.has_spindeterminants_n_int ()) then "T" else "F" + | "has_spindeterminants_bit_kind" -> if (Ezfio.has_spindeterminants_bit_kind ()) then "T" else "F" + | "has_spindeterminants_n_states" -> if (Ezfio.has_spindeterminants_n_states ()) then "T" else "F" + | "has_spindeterminants_psi_det_alpha" -> if (Ezfio.has_spindeterminants_psi_det_alpha ()) then "T" else "F" + | "has_spindeterminants_psi_det_beta" -> if (Ezfio.has_spindeterminants_psi_det_beta ()) then "T" else "F" + | "has_spindeterminants_psi_coef_matrix_rows" -> if (Ezfio.has_spindeterminants_psi_coef_matrix_rows ()) then "T" else "F" + | "has_spindeterminants_psi_coef_matrix_columns" -> if (Ezfio.has_spindeterminants_psi_coef_matrix_columns ()) then "T" else "F" + | "has_spindeterminants_psi_coef_matrix_values" -> if (Ezfio.has_spindeterminants_psi_coef_matrix_values ()) then "T" else "F" + | "has_ao_basis_ao_num" -> if (Ezfio.has_ao_basis_ao_num ()) then "T" else "F" + | "has_ao_basis_ao_prim_num" -> if (Ezfio.has_ao_basis_ao_prim_num ()) then "T" else "F" + | "has_ao_basis_ao_nucl" -> if (Ezfio.has_ao_basis_ao_nucl ()) then "T" else "F" + | "has_ao_basis_ao_power" -> if (Ezfio.has_ao_basis_ao_power ()) then "T" else "F" + | "has_ao_basis_ao_coef" -> if (Ezfio.has_ao_basis_ao_coef ()) then "T" else "F" + | "has_ao_basis_ao_expo" -> if (Ezfio.has_ao_basis_ao_expo ()) then "T" else "F" + | "has_electrons_elec_alpha_num" -> if (Ezfio.has_electrons_elec_alpha_num ()) then "T" else "F" + | "has_electrons_elec_beta_num" -> if (Ezfio.has_electrons_elec_beta_num ()) then "T" else "F" + | "has_electrons_elec_walk_num_tot" -> if (Ezfio.has_electrons_elec_walk_num_tot ()) then "T" else "F" + | "has_electrons_elec_walk_num" -> if (Ezfio.has_electrons_elec_walk_num ()) then "T" else "F" + | "has_electrons_elec_coord_pool" -> if (Ezfio.has_electrons_elec_coord_pool ()) then "T" else "F" + | "has_electrons_elec_coord_pool_size" -> if (Ezfio.has_electrons_elec_coord_pool_size ()) then "T" else "F" + | "has_electrons_elec_fitcusp_radius" -> if (Ezfio.has_electrons_elec_fitcusp_radius ()) then "T" else "F" + | "has_jastrow_jast_type" -> if (Ezfio.has_jastrow_jast_type ()) then "T" else "F" + | "has_jastrow_jast_a_up_up" -> if (Ezfio.has_jastrow_jast_a_up_up ()) then "T" else "F" + | "has_jastrow_jast_a_up_dn" -> if (Ezfio.has_jastrow_jast_a_up_dn ()) then "T" else "F" + | "has_jastrow_jast_b_up_up" -> if (Ezfio.has_jastrow_jast_b_up_up ()) then "T" else "F" + | "has_jastrow_jast_b_up_dn" -> if (Ezfio.has_jastrow_jast_b_up_dn ()) then "T" else "F" + | "has_jastrow_jast_pen" -> if (Ezfio.has_jastrow_jast_pen ()) then "T" else "F" + | "has_jastrow_jast_een_e_a" -> if (Ezfio.has_jastrow_jast_een_e_a ()) then "T" else "F" + | "has_jastrow_jast_een_e_b" -> if (Ezfio.has_jastrow_jast_een_e_b ()) then "T" else "F" + | "has_jastrow_jast_een_n" -> if (Ezfio.has_jastrow_jast_een_n ()) then "T" else "F" + | "has_jastrow_jast_core_a1" -> if (Ezfio.has_jastrow_jast_core_a1 ()) then "T" else "F" + | "has_jastrow_jast_core_a2" -> if (Ezfio.has_jastrow_jast_core_a2 ()) then "T" else "F" + | "has_jastrow_jast_core_b1" -> if (Ezfio.has_jastrow_jast_core_b1 ()) then "T" else "F" + | "has_jastrow_jast_core_b2" -> if (Ezfio.has_jastrow_jast_core_b2 ()) then "T" else "F" + | "has_nuclei_nucl_num" -> if (Ezfio.has_nuclei_nucl_num ()) then "T" else "F" + | "has_nuclei_nucl_label" -> if (Ezfio.has_nuclei_nucl_label ()) then "T" else "F" + | "has_nuclei_nucl_charge" -> if (Ezfio.has_nuclei_nucl_charge ()) then "T" else "F" + | "has_nuclei_nucl_coord" -> if (Ezfio.has_nuclei_nucl_coord ()) then "T" else "F" + | "has_nuclei_nucl_fitcusp_radius" -> if (Ezfio.has_nuclei_nucl_fitcusp_radius ()) then "T" else "F" + | "has_properties_d_var_jast_a_up_dn" -> if (Ezfio.has_properties_d_var_jast_a_up_dn ()) then "T" else "F" + | "has_properties_d_var_jast_a_up_up" -> if (Ezfio.has_properties_d_var_jast_a_up_up ()) then "T" else "F" + | "has_properties_d_var_jast_b_up_dn" -> if (Ezfio.has_properties_d_var_jast_b_up_dn ()) then "T" else "F" + | "has_properties_d_var_jast_b_up_up" -> if (Ezfio.has_properties_d_var_jast_b_up_up ()) then "T" else "F" + | "has_properties_d_var_jast_core_a1" -> if (Ezfio.has_properties_d_var_jast_core_a1 ()) then "T" else "F" + | "has_properties_d_var_jast_core_b1" -> if (Ezfio.has_properties_d_var_jast_core_b1 ()) then "T" else "F" + | "has_properties_d_var_jast_een_e_a" -> if (Ezfio.has_properties_d_var_jast_een_e_a ()) then "T" else "F" + | "has_properties_d_var_jast_een_e_b" -> if (Ezfio.has_properties_d_var_jast_een_e_b ()) then "T" else "F" + | "has_properties_d_var_jast_een_n" -> if (Ezfio.has_properties_d_var_jast_een_n ()) then "T" else "F" + | "has_properties_d_var_jast_pen" -> if (Ezfio.has_properties_d_var_jast_pen ()) then "T" else "F" + | "has_properties_density1d" -> if (Ezfio.has_properties_density1d ()) then "T" else "F" + | "has_properties_dipole" -> if (Ezfio.has_properties_dipole ()) then "T" else "F" + | "has_properties_drift_mod" -> if (Ezfio.has_properties_drift_mod ()) then "T" else "F" + | "has_properties_e_kin" -> if (Ezfio.has_properties_e_kin ()) then "T" else "F" + | "has_properties_e_loc" -> if (Ezfio.has_properties_e_loc ()) then "T" else "F" + | "has_properties_e_loc_one" -> if (Ezfio.has_properties_e_loc_one ()) then "T" else "F" + | "has_properties_e_loc_per_electron" -> if (Ezfio.has_properties_e_loc_per_electron ()) then "T" else "F" + | "has_properties_e_loc_split_core" -> if (Ezfio.has_properties_e_loc_split_core ()) then "T" else "F" + | "has_properties_e_loc_two" -> if (Ezfio.has_properties_e_loc_two ()) then "T" else "F" + | "has_properties_e_nucl" -> if (Ezfio.has_properties_e_nucl ()) then "T" else "F" + | "has_properties_e_pot" -> if (Ezfio.has_properties_e_pot ()) then "T" else "F" + | "has_properties_e_pot_one" -> if (Ezfio.has_properties_e_pot_one ()) then "T" else "F" + | "has_properties_n_s_inverted" -> if (Ezfio.has_properties_n_s_inverted ()) then "T" else "F" + | "has_properties_n_s_updated" -> if (Ezfio.has_properties_n_s_updated ()) then "T" else "F" + | "has_properties_n_s_updates" -> if (Ezfio.has_properties_n_s_updates ()) then "T" else "F" + | "has_properties_voronoi_charges" -> if (Ezfio.has_properties_voronoi_charges ()) then "T" else "F" + | "has_properties_voronoi_charges_covariance" -> if (Ezfio.has_properties_voronoi_charges_covariance ()) then "T" else "F" + | "has_properties_voronoi_dipoles" -> if (Ezfio.has_properties_voronoi_dipoles ()) then "T" else "F" + | "has_properties_wf_extension" -> if (Ezfio.has_properties_wf_extension ()) then "T" else "F" + | x -> failwith (x^" : Unknown EZFIO function") +;; + diff --git a/ocaml/Qputils.ml b/ocaml/Qputils.ml new file mode 100644 index 0000000..2ce41d9 --- /dev/null +++ b/ocaml/Qputils.ml @@ -0,0 +1,61 @@ +open Core.Std + +let split_re = + Str.regexp " +" + + +let split s = + String.strip s + |> Str.split split_re + + +let ezfio_filename = lazy ( + let f = + !Ezfio.ezfio_filename + in + let full_path = + begin + if f = "EZFIO_File" then + begin + if (Array.length Sys.argv = 1) then + failwith "Error : EZFIO directory not specified on the command line\n"; + let ezfio_filename = Sys.argv.(1) + in + let () = + match (Sys.is_directory ezfio_filename) with + | `Yes -> Ezfio.set_file ezfio_filename ; + | _ -> failwith ("Error : "^ezfio_filename^" not found") + in ezfio_filename + end + else + f + end + in + let dir, result = + Filename.realpath full_path + |> Filename.split + in + Unix.chdir dir; + result +) + + +let elec_num = lazy ( + Ezfio.set_file (Lazy.force ezfio_filename); + Ezfio.get_electrons_elec_alpha_num () + + Ezfio.get_electrons_elec_beta_num () +) + + +let walk_num = lazy ( + Ezfio.set_file (Lazy.force ezfio_filename); + Ezfio.get_electrons_elec_walk_num () +) + + +let warn msg = + Printf.printf "Warning : %s\n%!" msg + +let () = + Random.self_init () + diff --git a/ocaml/Random_variable.ml b/ocaml/Random_variable.ml new file mode 100644 index 0000000..34efff3 --- /dev/null +++ b/ocaml/Random_variable.ml @@ -0,0 +1,712 @@ +open Core.Std;; +open Qptypes;; + +type t = + { property : Property.t ; + data : Block.t list; + } + + +module Average = struct + include Sample +end + +module Error = struct + include Sample +end + +module Variance = struct + include Sample +end + +module Skewness: sig + type t + val to_float : t -> float + val of_float : float -> t + val to_string : t -> string +end = struct + type t = float + let to_string = Float.to_string + let to_float x = x + let of_float x = x +end + +module Kurtosis: sig + type t + val to_float : t -> float + val of_float : float -> t + val to_string : t -> string +end = struct + type t = float + let to_string = Float.to_string + let to_float x = x + let of_float x = x +end + +module GaussianDist: sig + type t + val create : mu:Average.t -> sigma2:Variance.t -> t + val eval : g:t -> x:float -> float +end = struct + type t = { mu: Average.t ; sigma2: Variance.t } + let create ~mu ~sigma2 = + { mu ; sigma2 } + let eval ~g ~x = + let { mu ; sigma2 } = + g + in + let mu = + Average.to_float mu + and sigma2 = + Variance.to_float sigma2 + in + let x2 = + (x -. mu) *. ( x -. mu) /. sigma2 + in + let pi = + acos (-1.) + in + let c = + 1. /. (sqrt (sigma2 *. (pi +. pi))) + in + c *. exp ( -0.5 *. x2) + +end + + + +(** Build from raw data *) +let of_raw_data ?(locked=true) property = + let data = + Block.raw_data ~locked () + |> List.filter ~f:(fun x -> x.Block.property = property) + in + { property ; data } +;; + + +(** Compute average *) +let average { property ; data } = + if Property.is_scalar property then + let (num,denom) = + List.fold ~init:(0., 0.) ~f:(fun (an, ad) x -> + let num = + (Weight.to_float x.Block.weight) *. (Sample.to_float x.Block.value) + and den = + (Weight.to_float x.Block.weight) + in (an +. num, ad +. den) + ) data + in + num /. denom + |> Average.of_float + else + let dim = + match data with + | [] -> 1 + | x :: tl -> Sample.dimension x.Block.value + in + let (num,denom) = + List.fold ~init:(Array.create ~len:dim 0. , 0.) ~f:(fun (an, ad) x -> + let num = + Array.map (Sample.to_float_array x.Block.value) ~f:(fun y -> + (Weight.to_float x.Block.weight) *. y) + and den = (Weight.to_float x.Block.weight) + in ( + Array.mapi an ~f:(fun i y -> y +. num.(i)) , + ad +. den) + ) data + in + let denom_inv = + 1. /. denom + in + Array.map num ~f:(fun x -> x *. denom_inv) + |> Average.of_float_array ~dim +;; + + +(** Compute sum (for CPU/Wall time) *) +let sum { property ; data } = + List.fold data ~init:0. ~f:(fun accu x -> + let num = (Weight.to_float x.Block.weight) *. (Sample.to_float x.Block.value) + in accu +. num + ) +;; + + +(** Calculation of the average and error bar *) +let ave_error { property ; data } = + + let rec loop ~sum ~avsq ~ansum ~avsum ~n ?idx = function + | [] -> + begin + if (n > 0.) then + ( Average.of_float (sum /. ansum), + Some (Error.of_float (sqrt ( Float.abs ( avsq /.( ansum *. n)))) )) + else + ( Average.of_float (sum /. ansum), None) + end + | (x,w) :: tail -> + begin + let avcu0 = + avsum /. ansum + in + let xw = + x *. w + in + let ansum, avsum, sum = + ansum +. w , + avsum +. xw , + sum +. xw + in + loop tail + ~sum:sum + ~avsq:(avsq +. (1. -. (w /. ansum)) *. (x -. avcu0) + *. (x -. avcu0) *. w) + ~avsum:avsum + ~ansum:ansum + ~n:(n +. 1.) + end + in + + let ave_error_scalar = function + | [] -> (Average.of_float 0., None) + | (x,w) :: tail -> + loop tail + ~sum:(x *. w) + ~avsq:0. + ~ansum:w + ~avsum:(x *. w) + ~n:0. + in + + if (Property.is_scalar property) then + List.map data ~f:(fun x -> + (Sample.to_float x.Block.value, + Weight.to_float x.Block.weight) + ) + |> ave_error_scalar + else + match data with + | [] -> (Average.of_float 0., None) + | head::tail as list_of_samples -> + let dim = + head.Block.value + |> Sample.dimension + in + let result = + Array.init dim ~f:(fun idx -> + List.map list_of_samples ~f:(fun x -> + (Sample.to_float ~idx x.Block.value, + Weight.to_float x.Block.weight) + ) + |> ave_error_scalar + ) + in + ( Array.map result ~f:(fun (x,_) -> Average.to_float x) + |> Average.of_float_array ~dim , + if (Array.length result < 2) then + None + else + Some (Array.map result ~f:(function + | (_,Some y) -> Error.to_float y + | (_,None) -> 0.) + |> Average.of_float_array ~dim) + ) +;; + + + +(** Fold function for block values *) +let fold_blocks ~f { property ; data } = + let init = match List.hd data with + | None -> 0. + | Some block -> Sample.to_float block.Block.value + in + List.fold_left data ~init:init ~f:(fun accu block -> + let x = Sample.to_float block.Block.value + in f accu x + ) +;; + + +(** Convergence plot *) +let convergence { property ; data } = + + let rec loop ~sum ~avsq ~ansum ~avsum ~n ~accu = function + | [] -> List.rev accu + | head :: tail -> + begin + let x = Sample.to_float head.Block.value + and w = Weight.to_float head.Block.weight + and avcu0 = avsum /. ansum + in + let xw = x *. w + in + let ansum = ansum +. w + and avsum = avsum +. xw + and sum = sum +. xw + in + let accu = + if (n > 0.) then + (sum /. ansum, sqrt ( Float.abs ( avsq /.( ansum *. n))))::accu + else + (sum /. ansum, 0.)::accu + in + loop tail + ~sum:sum + ~avsq:(avsq +. (1. -. (w /. ansum)) *. (x -. avcu0) + *. (x -. avcu0) *. w) + ~avsum:avsum + ~ansum:ansum + ~n:(n +. 1.) + ~accu:accu + end + in + match data with + | [] -> [] + | head :: tail -> + begin + let x = Sample.to_float head.Block.value + and w = Weight.to_float head.Block.weight + in + let s = x *. w in + loop tail + ~sum:s + ~avsq:0. + ~ansum:w + ~avsum:s + ~n:0. + ~accu:[ (s /. w, 0.) ] + end +;; + +let rev_convergence { property ; data } = + let p = { property=property ; data = List.rev data } in + convergence p + |> List.rev +;; + + +(** Min and max of block *) +let min_block = + fold_blocks ~f:(fun accu x -> + if (x < accu) then x + else accu + ) +;; + +let max_block = + fold_blocks ~f:(fun accu x -> + if (x > accu) then x + else accu + ) +;; + + +(** Create a hash table for merging *) +let create_hash ~hashable ~create_key ?(update_block_id=(fun x->x)) t = + let table = Hashtbl.create ~hashable:hashable () + in + List.iter t.data ~f:(fun block -> + let key = create_key block + in + let open Block in + Hashtbl.change table key (function + | Some current -> + let wc, wb = + Weight.to_float current.weight, + Weight.to_float block.weight + in + let sw = + wc +. wb + in + if (Property.is_scalar current.property) then + let vc, vb = + Sample.to_float current.value, + Sample.to_float block.value + in Some + { property = current.property ; + weight = Weight.of_float sw ; + value = Sample.of_float ((wc *. vc +. wb *. vb) /. sw); + block_id = update_block_id block.block_id; + pid = block.pid ; + compute_node = block.compute_node; + } + else + let vc, vb = + Sample.to_float_array current.value, + Sample.to_float_array block.value + and dim = + Sample.dimension current.value + in Some + { property = current.property ; + weight = Weight.of_float sw ; + value = + Array.init dim ~f:(fun i -> ((wc *. vc.(i) +. wb *. vb.(i)) /. sw)) + |> Sample.of_float_array ~dim ; + block_id = update_block_id block.block_id; + pid = block.pid ; + compute_node = block.compute_node; + } + | None -> Some + { property = block.property ; + weight = block.weight; + value = block.value ; + block_id = update_block_id block.block_id; + pid = block.pid ; + compute_node = block.compute_node; + } + ) + ); + table +;; + + +(** Genergic merge function *) +let merge ~hashable ~create_key ?update_block_id t = + let table = create_hash ~hashable:hashable ~create_key:create_key + ?update_block_id:update_block_id t + in + { property = t.property ; + data = Hashtbl.to_alist table + |> List.sort ~cmp:(fun x y -> + if (x>y) then 1 + else if (x List.map ~f:(fun (x,y) -> y) + } +;; + + +(** Merge per block id *) +let merge_per_block_id = + merge + ~hashable:Int.hashable + ~create_key:(fun block -> Block_id.to_int block.Block.block_id) +;; + +(** Merge per compute_node *) +let merge_per_compute_node = + merge + ~hashable:String.hashable + ~create_key:(fun block -> + Printf.sprintf "%s" + (Compute_node.to_string block.Block.compute_node) ) +;; + + +(** Merge per Compute_node and PID *) +let merge_per_compute_node_and_pid = + merge + ~hashable:String.hashable + ~create_key:(fun block -> + Printf.sprintf "%s %10.10d" + (Compute_node.to_string block.Block.compute_node) + (Pid.to_int block.Block.pid) ) +;; + + +(** Merge per Compute_node and BlockId *) +let merge_per_compute_node_and_block_id = + merge + ~hashable:String.hashable + ~create_key:(fun block -> + Printf.sprintf "%s %10.10d" + (Compute_node.to_string block.Block.compute_node) + (Block_id.to_int block.Block.block_id) ) +;; + + + +(** Merge two consecutive blocks *) +let compress = + merge + ~hashable:String.hashable + ~create_key:(fun block -> + Printf.sprintf "%s %10.10d" (Compute_node.to_string block.Block.compute_node) + (((Block_id.to_int block.Block.block_id)+1)/2)) + ~update_block_id:(fun block_id -> + ((Block_id.to_int block_id)+1)/2 + |> Block_id.of_int ) +;; + + + +(** Last value on each compute node (for wall_time) *) +let max_value_per_compute_node t = + let table = Hashtbl.create ~hashable:String.hashable () + in + let create_key block = + Printf.sprintf "%s %10.10d" + (Compute_node.to_string block.Block.compute_node) + (Pid.to_int block.Block.pid) + in + List.iter t.data ~f:(fun block -> + let key = create_key block + in + let open Block in + Hashtbl.change table key (function + | Some current -> + let vc = Sample.to_float current.value + and vb = Sample.to_float block.value + in + if (vc > vb) then + Some current + else + Some block + | None -> Some block + ) + ); + { property = t.property ; + data = Hashtbl.to_alist table + |> List.sort ~cmp:(fun x y -> + if (x>y) then 1 + else if (x List.map ~f:(fun (x,y) -> y) + } +;; + + + +(** String representation *) +let to_string p = + match p.property with + | Property.Cpu -> Printf.sprintf "%s" (Time.Span.to_string (Time.Span.of_sec (sum p))) + | Property.Wall -> Printf.sprintf "%s" (Time.Span.to_string (Time.Span.of_sec (sum (max_value_per_compute_node p)))) + | Property.Accep -> Printf.sprintf "%16.10f" (average p |> Average.to_float) + | _ -> + begin + if Property.is_scalar p.property then + match ave_error p with + | (ave, Some error) -> + let (ave, error) = + Average.to_float ave, + Error.to_float error + in + Printf.sprintf "%16.10f +/- %16.10f" ave error + | (ave, None) -> + let ave = + Average.to_float ave + in + Printf.sprintf "%16.10f" ave + else + match ave_error p with + | (ave, Some error) -> + let idxmax = + Average.dimension ave + in + let rec f accu idx = + if (idx < idxmax) then + let (ave, error) = + Average.to_float ~idx ave, + Error.to_float ~idx error + in + let s = + Printf.sprintf "%8d : %16.10f +/- %16.10f ;\n" (idx+1) ave error + in + f (accu ^ s) (idx+1) + else + accu + in + (f "[ \n" 0) ^ " ]" + | (ave, None) -> + Average.to_float ave + |> Printf.sprintf "%16.10f" + end +;; + + + +(** Compress block files : Merge all the blocks computed on the same host *) +let compress_files () = + + Block._raw_data := None; + + let properties = + Lazy.force Block.properties + in + + (* Create temporary file *) + let dir_name = + Block.dir_name + in + + let dir_name = + Lazy.force dir_name + in + let files = + Sys.ls_dir dir_name + |> List.filter ~f:(fun x -> + match String.substr_index ~pattern:"locked" x with + | Some x -> false + | None -> true + ) + |> List.map ~f:(fun x -> dir_name^x) + in + + let out_channel_dir = + Filename.temp_dir ~in_dir:(!Ezfio.ezfio_filename ^ "/blocks/") "qmc" "" + in + + let out_channel_name = + let hostname = + Lazy.force Qmcchem_config.hostname + and suffix = + Unix.getpid () + |> Pid.to_string + in + String.concat [ hostname ; "." ; suffix ] + in + + let block_channel = + Out_channel.create (out_channel_dir ^ out_channel_name) + in + + List.iter properties ~f:(fun p -> + let l = + match p with + | Property.Cpu + | Property.Accep -> + of_raw_data ~locked:false p + |> merge_per_compute_node + | Property.Wall -> + of_raw_data ~locked:false p + |> max_value_per_compute_node + | _ -> + of_raw_data ~locked:false p + |> merge_per_compute_node_and_block_id + in + List.iter l.data ~f:(fun x -> + Out_channel.output_string block_channel (Block.to_string x); + Out_channel.output_char block_channel '\n'; + ); + ); + Out_channel.close block_channel; + + List.iter files ~f:Unix.remove ; + Unix.rename ~src:(out_channel_dir^out_channel_name) ~dst:(dir_name^out_channel_name); + Unix.rmdir out_channel_dir +;; + + +(** Autocovariance function (not weighted) *) +let autocovariance { property ; data } = + let ave = + average { property ; data } + |> Average.to_float + and data = + match (merge_per_block_id { property ; data }) + with { property ; data } -> Array.of_list data + in + let x_t = + Array.map ~f:(fun x -> (Sample.to_float x.Block.value) -. ave) data + in + let f i = + let denom = + if (i > 1) then (Float.of_int i) else 1. + in + let r = + Array.sub ~pos:0 ~len:i x_t + |> Array.fold ~init:0. ~f:(fun accu x -> + accu +. x *. x_t.(i)) + in + r /. denom + in + Array.init ~f (Array.length data) + |> Array.to_list +;; + + +(** Computes the first 4 centered cumulants (zero mean) *) +let centered_cumulants { property ; data } = + let ave = + average { property ; data } + |> Average.to_float + in + let centered_data = + List.map ~f:(fun x -> + ( (Weight.to_float x.Block.weight), + (Sample.to_float x.Block.value) -. ave ) + ) + data + in + let var = + let (num, denom) = + List.fold ~init:(0., 0.) ~f:(fun (a2, ad) (w,x) -> + let x2 = x *. x + in + let var = w *. x2 + and den = w + in (a2 +. var, ad +. den) + ) centered_data + in num /. denom + in + let centered_data = + let sigma_inv = + 1. /. (sqrt var) + in + List.map ~f:(fun x -> + ( (Weight.to_float x.Block.weight), + ( (Sample.to_float x.Block.value) -. ave ) *. sigma_inv ) + ) + data + in + let (cum3,cum4) = + let (cum3, cum4, denom) = + List.fold ~init:(0., 0., 0.) ~f:(fun (a3, a4, ad) (w,x) -> + let x2 = x *. x + in + let cum3 = w *. x2 *. x + and cum4 = w *. x2 *. x2 + and den = w + in (a3 +. cum3, a4 +. cum4, ad +. den) + ) centered_data + in + ( cum3 /. denom, cum4 /. denom -. 3. ) + in + [| ave ; var ; cum3 ; cum4 |] +;; + + + +(** Computes a histogram *) +let histogram { property ; data } = + let min, max = + (min_block { property ; data }), + (max_block { property ; data }) + in + let length = + max -. min + and n = + List.length data + |> Float.of_int + |> sqrt + in + let delta_x = + length /. (n-.1.) + and result = + Array.init ~f:(fun _ -> 0.) (Int.of_float (n +. 1.)) + in + List.iter ~f:(fun x -> + let w = + (Weight.to_float x.Block.weight) + and x = + (Sample.to_float x.Block.value) + in + let i = + (x -. min) /. delta_x +. 0.5 + |> Float.to_int + in + result.(i) <- result.(i) +. w + ) data + ; + let norm = + 1. /. ( delta_x *. ( + Array.fold ~init:0. ~f:(fun accu x -> accu +. x) result + ) ) + in + Array.mapi ~f:(fun i x -> (min +. (Float.of_int i)*.delta_x, x *. norm) ) result + |> Array.to_list +;; + diff --git a/ocaml/Sample.ml b/ocaml/Sample.ml new file mode 100644 index 0000000..14b709d --- /dev/null +++ b/ocaml/Sample.ml @@ -0,0 +1,46 @@ +open Core.Std + +type t = + | One_dimensional of float + | Multidimensional of (float array * int) +with sexp + +let dimension = function + | One_dimensional _ -> 1 + | Multidimensional (_,d) -> d + +let to_float ?idx x = + match (idx,x) with + | None , One_dimensional x + | Some 0, One_dimensional x -> x + | Some i, One_dimensional x -> + failwith "Index should not be specified in One_dimensional" + | None , Multidimensional (x,_) -> x.(0) + | Some i, Multidimensional (x,s) when i < s -> x.(i) + | Some i, Multidimensional (x,s) -> + Printf.sprintf "Index out of bounds in Multidimensional + %d not in [0,%d[ " i s + |> failwith + +let to_float_array = function + | One_dimensional _ -> failwith "Should be Multidimensional" + | Multidimensional (x,_) -> x + +let of_float x = + One_dimensional x + +let of_float_array ~dim x = + if (Array.length x) <> dim then + failwith "Inconsistent array size in of_float_array" + else + match dim with + | 1 -> One_dimensional x.(0) + | _ -> Multidimensional (x, dim) + +let to_string = function + | One_dimensional x -> Float.to_string x + | Multidimensional (x,_) -> + Array.map x ~f:Float.to_string + |> String.concat_array ~sep:" " + |> Printf.sprintf "%s" + diff --git a/ocaml/Sample.mli b/ocaml/Sample.mli new file mode 100644 index 0000000..27c965c --- /dev/null +++ b/ocaml/Sample.mli @@ -0,0 +1,8 @@ +type t with sexp +val to_float : ?idx:int -> t -> float +val to_float_array : t -> float array +val of_float : float -> t +val of_float_array : dim:int -> float array -> t +val to_string : t -> string +val dimension : t -> int + diff --git a/ocaml/Scheduler.ml b/ocaml/Scheduler.ml new file mode 100644 index 0000000..06084c6 --- /dev/null +++ b/ocaml/Scheduler.ml @@ -0,0 +1,40 @@ +open Core.Std;; + +type t = + | SGE + | PBS + | SLURM + | Batch + + +let to_string = function + | SGE -> "SGE" + | PBS -> "PBS" + | SLURM -> "SLURM" + | Batch -> "Batch" + + + +let find () = + let scheduler = + [ "SLURM_NODELIST" ; "PE_HOSTFILE" ; "PBS_NODEFILE" ] + |> List.map ~f:(function x -> + match (Sys.getenv x) with + | Some _ -> x + | None -> "" + ) + |> List.filter ~f:(function x -> x <> "") + |> List.hd + in + let result = + match scheduler with + | Some "SLURM_NODELIST" -> SLURM + | Some "PE_HOSTFILE" -> SGE + | Some "PBS_NODEFILE" -> PBS + | None -> Batch + | Some x -> failwith (Printf.sprintf "Scheduler %s not found" x) + in + result + + + diff --git a/ocaml/Status.ml b/ocaml/Status.ml new file mode 100644 index 0000000..af10168 --- /dev/null +++ b/ocaml/Status.ml @@ -0,0 +1,52 @@ +open Qputils + +type t = +| Stopped +| Queued +| Running +| Stopping +;; + +let of_string = function +| "Stopped" -> Stopped +| "Queued" -> Queued +| "Running" -> Running +| "Stopping" -> Stopping +| _ -> failwith "Invalid status" +;; + +let of_int = function +| 0 -> Stopped +| 1 -> Queued +| 2 -> Running +| 3 -> Stopping +| _ -> failwith "Invalid status" +;; + +let to_string = function +| Stopped -> "Stopped" +| Queued -> "Queued" +| Running -> "Running" +| Stopping -> "Stopping" +;; + +let to_int = function +| Stopped -> 0 +| Queued -> 1 +| Running -> 2 +| Stopping -> 3 +;; + + +let read () = + Ezfio.set_file (Lazy.force ezfio_filename); + Ezfio.get_simulation_do_run () + |> of_int +;; + +let write x = + Ezfio.set_file (Lazy.force ezfio_filename); + to_int x + |> Ezfio.set_simulation_do_run +;; + diff --git a/ocaml/Watchdog.ml b/ocaml/Watchdog.ml new file mode 100644 index 0000000..fbdfbab --- /dev/null +++ b/ocaml/Watchdog.ml @@ -0,0 +1,126 @@ +open Core.Std;; + +let _list = ref [] ;; +let _running = ref false;; +let _threads = ref [] ;; + +(** Kill the current process and all children *) +let kill () = + let kill pid = + Printf.printf "Killed %d\n" (Pid.to_int pid); + Signal.send_i Signal.term (`Pid pid) + in + List.iter ~f:kill (!_list); + exit 1 +;; + + +(** Start watchdog *) +let start () = + + if (!_running) then + failwith "Watchdog error: Already running" + else + begin + _running := true; + + let pause () = + Time.Span.of_sec 1. + |> Time.pause + in + + let pid_is_running pid = + match (Sys.file_exists ("/proc/"^(Pid.to_string pid)^"/stat")) with + | `No | `Unknown -> false + | `Yes -> true + in + + let f () = + while (!_running) + do + pause () ; + +(*DEBUG + List.iter (!_list) ~f:(fun x -> Printf.printf "%d\n%!" (Pid.to_int x)); + *) + + let continue () = + List.fold_left (!_list) ~init:true ~f:( + fun accu x -> accu && (pid_is_running x) + ) + in + if ( not (continue ()) ) then + kill () + done + in + _threads := ( (Thread.create f) () ) :: (!_threads) + end +;; + +(** Stop watchdog *) +let stop () = + if (!_running) then + _running := false + else + failwith "Watchdog error: Already stopped" +;; + +(** Add a PID to tracking *) +let add pid = + if (not !_running) then + start (); + _list := pid :: (!_list) +;; + +(** Remove a PID from tracking *) +let del pid = + let rec aux accu = function + | [] -> accu + | a :: rest -> + if (a <> pid) then + aux (a::accu) rest + else + aux accu rest + in + _list := aux [] (!_list); + + match (!_list) with + | [] -> if (!_running) then stop () + | _ -> () +;; + +(** Fork and exec a new process *) +let fork_exec ~prog ~args () = + let pid = + Unix.fork_exec ~prog ~args () + in + + let f () = + add pid; + let success = + match (Unix.waitpid pid) with + | Core_kernel.Std.Result.Ok () -> true + | Core_kernel.Std.Result.Error (`Exit_non_zero n) -> + ( Printf.printf "PID %d exited with code %d\n%!" + (Pid.to_int pid) n ; + false ) + | Core_kernel.Std.Result.Error (`Signal n) -> + ( Printf.printf "PID %d killed with signal %d (%s)\n%!" + (Pid.to_int pid) (Signal.to_system_int n) + (Signal.to_string n) ; + false ) + in + del pid ; + if (not success) then + kill () + in + _threads := ( (Thread.create f) () ) :: (!_threads); + pid +;; + +(** Wait for threads to finish *) +let join () = +(* if (!_running) then stop (); *) + List.iter ~f:Thread.join (!_threads); + assert (not !_running) +;; diff --git a/ocaml/compile.sh b/ocaml/compile.sh new file mode 100755 index 0000000..19ae8c6 --- /dev/null +++ b/ocaml/compile.sh @@ -0,0 +1,33 @@ +#!/bin/bash + +if [[ -z ${QMCCHEM_PATH} ]] +then + echo "Error: qmcchemrc not loaded" + exit -1 +fi + +cd ${QMCCHEM_PATH}/ocaml + +LSMD5_FILE=${QMCCHEM_PATH}/ocaml/.ls_md5 +FILES="*.ml *.mli" +MD5=$(ls -ltr --full-time ${FILES} 2>/dev/null | md5sum | cut -d ' ' -f 1) + +REF=0 + +if [[ -f ${LSMD5_FILE} ]] +then + REF=$(cat ${LSMD5_FILE}) +fi + +if [[ ${MD5} != ${REF} ]] +then + echo ${MD5} > ${LSMD5_FILE} + echo Finding dependencies in OCaml files + python ./ninja_ocaml.py +fi + +ninja ${@} + + + + diff --git a/ocaml/ninja_ocaml.py b/ocaml/ninja_ocaml.py new file mode 100755 index 0000000..00d992e --- /dev/null +++ b/ocaml/ninja_ocaml.py @@ -0,0 +1,288 @@ +#!/usr/bin/env python +# +# Copyright 2015 Anthony Scemama +# +# Licensed under the Apache License, Version 2.0 (the "License"); +# you may not use this file except in compliance with the License. +# You may obtain a copy of the License at +# +# http://www.apache.org/licenses/LICENSE-2.0 +# +# Unless required by applicable law or agreed to in writing, software +# distributed under the License is distributed on an "AS IS" BASIS, +# WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. +# See the License for the specific language governing permissions and +# limitations under the License. +# +# This file can be downloaded here: +# https://raw.githubusercontent.com/scemama/ninja_ocaml/master/ninja_ocaml.py +# + +"""Build OCaml projects using ninja.""" + +__author__ = """Anthony Scemama """ + +import os +import sys +import subprocess + +def _help_ (): + print """ + 1) Download and install ninja : + https://github.com/martine/ninja/releases/latest + 2) Copy the script into your OCaml project. + 3) Run the script. It will build a default build.ninja file + 4) Edit the build.ninja file + 5) Compile the main target using `ninja` + 6) Compile all the targets using `ninja all` + """ + +def create_generated_ninja(): + """Creates the generated.ninja file""" + + # Header + PACKAGES="" + THREAD="" + SYNTAX="" + OCAMLC_FLAGS="" + GENERATED_NINJA="generated.ninja" + with open('build.ninja','r') as f: + for line in f: + if line.startswith("PACKAGES"): + PACKAGES=line.split('=',1)[1].strip() + elif line.startswith("THREAD"): + THREAD=line.split('=',1)[1].strip() + elif line.startswith("SYNTAX"): + SYNTAX=line.split('=',1)[1].strip() + elif line.startswith("OCAMLC_FLAGS"): + OCAMLC_FLAGS=line.split('=',1)[1].strip() + elif line.startswith("LINK_FLAGS"): + LINK_FLAGS=line.split('=',1)[1].strip() + elif line.startswith("GENERATED_NINJA"): + GENERATED_NINJA=line.split('=',1)[1].strip() + + if PACKAGES != "": + LINK_FLAGS = "-linkpkg "+PACKAGES + + header = [ +""" +######################################################## +# This file was auto-generated. # +# This file will be overwritten. Don't edit this file! # +# Changes should be done in the build.ninja file. # +######################################################## + +""", + + "PACKAGES=%s"%(PACKAGES), + "THREAD=%s"%(THREAD), + "SYNTAX=%s"%(SYNTAX), + "OCAMLC_FLAGS=%s"%(OCAMLC_FLAGS), + "LINK_FLAGS=%s"%(LINK_FLAGS), + "GENERATED_NINJA=%s"%(GENERATED_NINJA), + ] + + header += """ +rule ocamlc + command = ocamlfind ocamlc -c $OCAMLC_FLAGS $THREAD $PACKAGES $SYNTAX -o $out $in + description = Compiling $out (bytecode) + +rule ocamlopt + command = ocamlfind ocamlopt -c $OCAMLC_FLAGS $THREAD $PACKAGES $SYNTAX -o $o $in + description = Compiling $out (native) + +rule ocamlc_link + command = ocamlfind ocamlc $OCAMLC_FLAGS $THREAD $LINK_FLAGS $PACKAGES $SYNTAX -o $out $in + description = Compiling $out (bytecode) + +rule ocamlopt_link + command = ocamlfind ocamlopt $OCAMLC_FLAGS $THREAD $LINK_FLAGS $PACKAGES $SYNTAX -o $out $in + description = Compiling $out (native) + +""".splitlines() + + # Get the list of .ml files + all_files = os.listdir(os.getcwd()) + files = [ os.path.splitext(i)[0] for i in all_files if i.endswith('.ml') ] + while "myocamlbuild" in files: + files.remove("myocamlbuild") + ml_files = ' '.join( [ '%s.ml'%i for i in files ] ) + + # Dependencies + result = subprocess.Popen( + ("ocamlfind ocamldep {0} {1} {2}".format(PACKAGES,SYNTAX,ml_files)).split() + ,stdout=subprocess.PIPE).communicate()[0] + result = result.replace('\\\n',' ') + dependencies = {} + for line in result.splitlines(): + key, value = line.split(':') + dependencies[key.strip()] = value.strip() + + result = header + template = """ +build {0}.cmi: ocamlc {0}.mli | $GENERATED_NINJA +build {0}.cmo: ocamlc {0}.ml | $GENERATED_NINJA {1} +build {0}.cmx {0}.o: ocamlopt {0}.ml | $GENERATED_NINJA {2} + o = {0}.o +""" + + template_root_byte = """ +build {2}.byte: ocamlc_link {1} {0} +""" + + template_root_native = """ +build {2}: ocamlopt_link {1} {0} +""" + + # Find roots + dep = {} + for f in dependencies: + dep[f] = [ i.strip() for i in dependencies[f].split() ] + + roots = {} + for f in dependencies: + Found = False + for g,l in dep.iteritems(): + if f in l: + Found = True + if not Found: + roots[f] = [] + + def get_deps(l): + result = [] + for i in l: + if i in dep: + result += get_deps(dep[i]) + result += l + newresult = [] + for r in result: + if r not in newresult: + newresult.append(r) + return newresult + + for r in roots: + roots[r] = [ i for i in get_deps(dep[r]) if not i.endswith(".cmi") ] + + # Write the $GENERATED_NINJA file + result += [ template.format(basename, + dependencies["%s.cmo"%basename], + dependencies["%s.cmx"%basename] + ) for basename in files ] + result += [ template_root_byte.format(basename, + ' '.join(roots[basename]), + os.path.splitext(basename)[0] + ) for basename in roots if basename.endswith('.cmo')] + result += [ template_root_native.format(basename, + ' '.join(roots[basename]), + os.path.splitext(basename)[0] + ) for basename in roots if basename.endswith('.cmx')] + + output = '\n'.join(result) + try: + with open(GENERATED_NINJA,'r') as f: + inp = f.read() + except IOError: + inp = "" + + if inp != output: + with open(GENERATED_NINJA,'w') as f: + f.write(output) + +def create_build_ninja (): + with open('build.ninja','w') as f: + f.write(""" +MAIN= +# Main program to build + +PACKAGES= +# Required opam packages, for example: +# PACKAGES=-package core,sexplib.syntax + +THREAD= +# If you need threding support, use: +# THREAD=-thread + +SYNTAX= +# If you need pre-processing, use: +# SYNTAX=-syntax camlp4o + +OCAMLC_FLAGS= +# Flags to give to ocamlc, for example: +# OCAMLC_FLAGS=-g -warn-error A + +LINK_FLAGS= +# Flags to give to the linker, for example: +# LINK_FLAGS=-cclib '-Wl,-rpath=../lib,--enable-new-dtags' + +GENERATED_NINJA=generated.ninja +# Name of the auto-generated ninja file + +rule create_generated + command = python ./ninja_ocaml.py + description = Finding dependencies between modules + +rule run_ninja + command = ninja -f $in $target + description = Compiling OCaml executables + pool = console + +rule run_clean + command = ninja -f $GENERATED_NINJA -t clean ; rm $GENERATED_NINJA + pool = console + description = Cleaning directory + +rule ocamlc + command = ocamlfind ocamlc -c $OCAMLC_FLAGS $THREAD $PACKAGES $SYNTAX -o $out $in + description = Compiling $in (bytecode) + +rule ocamlopt + command = ocamlfind ocamlopt -c $OCAMLC_FLAGS $THREAD $PACKAGES $SYNTAX -o $out $in + description = Compiling $in (native) + +rule ocamlc_link + command = ocamlfind ocamlc $OCAMLC_FLAGS $THREAD $LINK_FLAGS $PACKAGES $SYNTAX -o $out $in + description = Compiling $out (bytecode) + +rule ocamlopt_link + command = ocamlfind ocamlopt $OCAMLC_FLAGS $THREAD $LINK_FLAGS $PACKAGES $SYNTAX -o $out $in + description = Compiling $out (native) + + +build clean: run_clean +build always $GENERATED_NINJA: create_generated + +build $MAIN: run_ninja $GENERATED_NINJA + target = $MAIN + +build all: run_ninja $GENERATED_NINJA + target = + +default $MAIN + +""") + + +def main(): + + for h in "help -h -help --help ?".split(): + if h in sys.argv: + _help_ () + return + + if "build.ninja" in os.listdir(os.getcwd()): + create_generated_ninja () + else: + create_build_ninja () + print """ +========================================================== +A default build.ninja file was created. +Now, edit build.ninja and compile your project using: + + ninja + +========================================================== +""" + +if __name__ == '__main__': + main() + diff --git a/ocaml/qmcchem.ml b/ocaml/qmcchem.ml new file mode 100644 index 0000000..fb34616 --- /dev/null +++ b/ocaml/qmcchem.ml @@ -0,0 +1,15 @@ +open Core.Std + + +let command = + Command.group ~summary:"QMC=Chem command" [ + "debug" , Qmcchem_debug.command ; + "edit" , Qmcchem_edit.command ; + "md5" , Qmcchem_md5.command ; + "result", Qmcchem_result.command ; + "run" , Qmcchem_run.command ; + "stop" , Qmcchem_stop.command ; + ] + +let () = + Command.run command diff --git a/ocaml/qptypes_generator.ml b/ocaml/qptypes_generator.ml new file mode 100644 index 0000000..cbcbd26 --- /dev/null +++ b/ocaml/qptypes_generator.ml @@ -0,0 +1,336 @@ +open Core.Std;; + +let input_data = " +* Positive_float : float + assert (x >= 0.) ; + +* Strictly_positive_float : float + assert (x > 0.) ; + +* Negative_float : float + assert (x <= 0.) ; + +* Strictly_negative_float : float + assert (x < 0.) ; + +* Positive_int : int + assert (x >= 0) ; + +* Strictly_positive_int : int + assert (x > 0) ; + +* Negative_int : int + assert (x <= 0) ; + +* Det_coef : float + assert (x >= -1.) ; + assert (x <= 1.) ; + +* Normalized_float : float + assert (x <= 1.) ; + assert (x >= 0.) ; + +* Strictly_negative_int : int + assert (x < 0) ; + +* Non_empty_string : string + assert (x <> \"\") ; + + +* Det_number_max : int + assert (x > 0) ; + if (x > 100000000) then + warning \"More than 100 million determinants\"; +"^ +(* +" +* States_number : int + assert (x > 0) ; + if (x > 100) then + warning \"More than 100 states\"; + if (Ezfio.has_determinants_n_states_diag ()) then + assert (x <= (Ezfio.get_determinants_n_states_diag ())) + else if (Ezfio.has_determinants_n_states ()) then + assert (x <= (Ezfio.get_determinants_n_states ())); + +* Bit_kind_size : int + begin match x with + | 8 | 16 | 32 | 64 -> () + | _ -> raise (Failure \"Bit_kind_size should be (8|16|32|64).\") + end; + +* Bit_kind : int + begin match x with + | 1 | 2 | 4 | 8 -> () + | _ -> raise (Failure \"Bit_kind should be (1|2|4|8).\") + end; + +* Bitmask_number : int + assert (x > 0) ; +"^ +*) +" + +* MO_coef : float + +* MO_occ : float + assert (x >= 0.); + +* AO_coef : float + +* AO_expo : float + assert (x >= 0.) ; + +* AO_prim_number : int + assert (x > 0) ; + +* Threshold : float + assert (x >= 0.) ; + assert (x <= 1.) ; + +* PT2_energy : float + assert (x >=0.) ; + +* Elec_alpha_number : int + assert (x > 0) ; + +* Elec_beta_number : int + assert (x >= 0) ; + +* Elec_number : int + assert (x > 0) ; + +* MD5 : string + assert ((String.length x) = 32); + +* Rst_string : string + + +* Weight : float + assert (x >= 0.) ; + +* Block_id : int + assert (x > 0) ; + +* Compute_node : string + assert (x <> \"\") ; + +" +;; + +let input_ezfio = " +* MO_number : int + mo_basis_mo_tot_num + 1 : 10000 + More than 10000 MOs + +* AO_number : int + ao_basis_ao_num + 1 : 10000 + More than 10000 AOs + +* Nucl_number : int + nuclei_nucl_num + 1 : 10000 + More than 10000 nuclei + +"^ +(* +" +* N_int_number : int + determinants_n_int + 1 : 30 + N_int > 30 + +* Det_number : int + determinants_n_det + 1 : 100000000 + More than 100 million determinants +" +*) +"" +;; + +let untouched = " +" + +let template = format_of_string " +module %s : sig + type t with sexp + val to_%s : t -> %s + val of_%s : %s %s -> t + val to_string : t -> string +end = struct + type t = %s with sexp + let to_%s x = x + let of_%s %s x = ( %s x ) + let to_string x = %s.to_string x +end + +" +;; + +let parse_input input= + let rec parse result = function + | [] -> result + | ( "" , "" )::tail -> parse result tail + | ( t , text )::tail -> + let name,typ,params,params_val = + match String.split ~on:':' t with + | [name;typ] -> (name,typ,"","") + | name::typ::params::params_val -> (name,typ,params, + (String.concat params_val ~sep:":") ) + | _ -> assert false + in + let typ = String.strip typ + and name = String.strip name in + let typ_cap = String.capitalize typ in + let newstring = Printf.sprintf template name typ typ typ params_val typ typ + typ typ params ( String.strip text ) typ_cap + in + List.rev (parse (newstring::result) tail ) + in + String.split ~on:'*' input + |> List.map ~f:(String.lsplit2_exn ~on:'\n') + |> parse [] + |> String.concat +;; + + +let ezfio_template = format_of_string " +module %s : sig + type t with sexp + val to_%s : t -> %s + val get_max : unit -> %s + val of_%s : ?min:%s -> ?max:%s -> %s -> t + val to_string : t -> string +end = struct + type t = %s with sexp + let to_string x = %s.to_string x + let get_max () = + if (Ezfio.has_%s ()) then + Ezfio.get_%s () + else + %s + let get_min () = + %s + let to_%s x = x + let of_%s ?(min=get_min ()) ?(max=get_max ()) x = + begin + assert (x >= min) ; + if (x > %s) then + warning \"%s\"; + begin + match max with + | %s -> () + | i -> assert ( x <= i ) + end ; + x + end +end +" + + +let parse_input_ezfio input= + let parse s = + match ( + String.split s ~on:'\n' + |> List.filter ~f:(fun x -> (String.strip x) <> "") + ) with + | [] -> "" + | a :: b :: c :: d :: [] -> + begin + let (name,typ) = String.lsplit2_exn ~on:':' a + and ezfio_func = b + and (min, max) = String.lsplit2_exn ~on:':' c + and msg = d + in + let (name, typ, ezfio_func, min, max, msg) = + match (List.map [ name ; typ ; ezfio_func ; min ; max ; msg ] ~f:String.strip) with + | [ name ; typ ; ezfio_func ; min ; max ; msg ] -> (name, typ, ezfio_func, min, max, msg) + | _ -> assert false + in + Printf.sprintf ezfio_template + name typ typ typ typ typ typ typ typ (String.capitalize typ) + ezfio_func ezfio_func max min typ typ max msg min + end + | _ -> failwith "Error in input_ezfio" + in + String.split ~on:'*' input + |> List.map ~f:parse + |> String.concat + + +(** EZFIO *) +let create_ezfio_handler () = + let lines = + In_channel.with_file "ezfio.ml" ~f:In_channel.input_lines + |> List.filteri ~f:(fun i _ -> i > 470) + in + let functions = + List.map lines ~f:(fun x -> + match String.split x ~on:' ' with + | _ :: x :: "()" :: "=" :: f :: dir :: item :: _-> (x, f, dir, item) + | _ :: x :: "=" :: f :: dir :: item :: _-> (x, f, dir, item) + | _ -> ("","","","") + ) + in + let has_functions = + List.filter functions ~f:(fun (x,_,_,_) -> String.is_prefix ~prefix:"has_" x) + and get_functions = + List.filter functions ~f:(fun (x,_,_,_) -> String.is_prefix ~prefix:"get_" x) + in + let result = + [ "let decode_ezfio_message msg = +match msg with " ] @ + ( + List.map get_functions ~f:(fun (x,f,d,i) -> + let i = + match (String.chop_suffix i ~suffix:";;") with + | Some x -> x + | None -> i + in + if (String.is_suffix f ~suffix:"_array") then + Printf.sprintf " | \"%s\" -> + Ezfio.read_string_array %s %s + |> Ezfio.flattened_ezfio + |> Array.to_list + |> String.concat ~sep:\" \"" x d i + else + Printf.sprintf " | \"%s\" -> Ezfio.read_string %s %s" x d i + ) + ) @ ( + List.map has_functions ~f:(fun (x,_,_,_) -> + Printf.sprintf " | \"%s\" -> if (Ezfio.%s ()) then \"T\" else \"F\"" x x + ) + ) @ [" | x -> failwith (x^\" : Unknown EZFIO function\")\n;;"] + in + String.concat result ~sep:"\n" + +(** Main *) + +let () = + let input = + String.concat ~sep:"\n" + [ "open Core.Std\nlet warning = print_string\n\n" ; + parse_input input_data ; + parse_input_ezfio input_ezfio ; + create_ezfio_handler (); + untouched ] + + and old_input = + let filename = + "Qptypes.ml" + in + match Sys.file_exists filename with + | `Yes -> In_channel.read_all "Qptypes.ml" + | `No | `Unknown -> "empty" + + in + + if input <> old_input then + Out_channel.write_all "Qptypes.ml" ~data:input + + + + diff --git a/scripts/create_properties_ezfio.py b/scripts/create_properties_ezfio.py new file mode 100755 index 0000000..6872232 --- /dev/null +++ b/scripts/create_properties_ezfio.py @@ -0,0 +1,177 @@ +#!/usr/bin/env python +# +# Creates the properties.config file in the EZFIO directory. This is +# done by reading all the properties written in the src/PROPERTIES +# directory. +# + +import os, sys +root = os.environ['QMCCHEM_PATH'] + +os.chdir(root+'/src/') +sys.path.insert(0,'./') + +from properties import properties + +# Write file if file has changed +# ============================== + +def write_if_modified(filename,tmp_filename): + try: + file = open(filename,'r') + except IOError: + f1 = "" + else: + f1 = file.read() + file.close() + + file = open(tmp_filename,'r') + f2 = file.read() + file.close() + + if f1 != f2: + os.rename(tmp_filename,filename) + else: + os.remove(tmp_filename) + + +# Create the EZFIO file for properties +# ==================================== + +filename = root+'/ezfio_config/properties.config' +tmp_filename = filename + '.new' + + +# Write temporary file +# -------------------- + +file = open(tmp_filename,'w') +print >>file, 'properties' +for p in properties: + print >>file, ' %30s logical'%(p[1].ljust(30)) +file.close() + +write_if_modified(filename,tmp_filename) + +# Create the ${QMCCHEM_PATH}/ocaml/Property.ml file +# ================================================= + +filename = root+'/ocaml/Property.ml' +tmp_filename = filename + '.new' + +properties_qmcvar = properties + map(lambda x: (x[0], x[1]+"_qmcvar", x[2]), properties) + +file = open(tmp_filename,'w') + +# type +# ---- + +print >>file, """ +(* File generated by ${QMCCHEM_PATH}/src/create_properties.py. Do not + modify here + *) + +type t = +| Cpu +| Wall +| Accep""" +for p in properties_qmcvar: + print >>file, "| %s"%(p[1].capitalize()) + +# calc function +# ------------- + +print >>file, """;; + +let calc = function +| Cpu +| Wall +| Accep -> true""" +for p in properties: + if p[1] == "e_loc": + tf = "true" + else: + tf = "false" + print >>file, """| %(P)s +| %(P)s_qmcvar -> + begin + if (Ezfio.has_properties_%(p)s ()) then + Ezfio.get_properties_%(p)s () + else + %(true_false)s + end +"""%{'P':p[1].capitalize(), 'p':p[1], 'true_false': tf} + +# set_calc +# -------- + +print >>file, """;; + +let u _ = ();; + +let set_calc = function +| Cpu +| Wall +| Accep -> u""" +for p in properties: + print >>file, """| %(P)s +| %(P)s_qmcvar -> + Ezfio.set_properties_%(p)s +"""%{'P':p[1].capitalize(), 'p':p[1]} + +# of_string +# --------- + +print >>file, """;; + +let of_string s = + match (String.lowercase s) with + | "cpu" -> Cpu + | "wall" -> Wall + | "accep" -> Accep""" +for p in properties_qmcvar: + print >>file, """ | "%(p)s" -> %(P)s"""%{'P':p[1].capitalize(), 'p':p[1]} +print >>file, """ | p -> failwith ("unknown property "^p) ;; +""" + +# to_string +# --------- + +print >>file, """ +let to_string = function +| Cpu -> "Cpu" +| Wall -> "Wall" +| Accep -> "Accep" """ +for p in properties_qmcvar: + print >>file, """| %(P)s -> "%(P)s" """%{'P':p[1].capitalize(), 'p':p[1]} +print >>file, """;; +""" + +# is_scalar +# --------- + +print >>file, """ +let is_scalar = function +| Cpu -> true +| Wall -> true +| Accep -> true """ +for p in properties: + if p[2] == "": + print >>file, """| %(P)s | %(P)s_qmcvar -> true """%{'P':p[1].capitalize()} + else: + print >>file, """| %(P)s | %(P)s_qmcvar -> false """%{'P':p[1].capitalize()} +print >>file, """;; +""" + +# all properties +# -------------- + +print >>file, """ +let all = [ Cpu ; Wall ; Accep ; """ +for p in properties: + print >>file, " %s ;"%(p[1].capitalize()), +print >>file, "];;" +file.close() + +write_if_modified(filename,tmp_filename) +