mirror of
https://gitlab.com/scemama/qmcchem.git
synced 2024-12-21 11:53:30 +01:00
Added ocaml files
This commit is contained in:
parent
e49713ee98
commit
a629b30051
105
ezfio_config/qmc.config
Normal file
105
ezfio_config/qmc.config
Normal file
@ -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)
|
||||
|
||||
|
@ -14,7 +14,9 @@ then
|
||||
exit 1
|
||||
fi
|
||||
|
||||
set +u
|
||||
source "${QMCCHEM_PATH}"/qmcchemrc
|
||||
set -u
|
||||
cd Downloads
|
||||
chmod +x opam_installer.sh
|
||||
|
||||
|
150
ocaml/Block.ml
Normal file
150
ocaml/Block.ml
Normal file
@ -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
|
||||
)
|
||||
|
||||
|
37
ocaml/Default.ml
Normal file
37
ocaml/Default.ml
Normal file
@ -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" ]
|
||||
|
865
ocaml/Input.ml
Normal file
865
ocaml/Input.ml
Normal file
@ -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
|
||||
()
|
||||
|
||||
|
||||
|
79
ocaml/Launcher.ml
Normal file
79
ocaml/Launcher.ml
Normal file
@ -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
|
||||
|
||||
|
||||
|
||||
|
143
ocaml/Md5.ml
Normal file
143
ocaml/Md5.ml
Normal file
@ -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 ())
|
||||
|
||||
|
||||
|
126
ocaml/Message.ml
Normal file
126
ocaml/Message.ml
Normal file
@ -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
|
||||
|
||||
|
629
ocaml/Property.ml
Normal file
629
ocaml/Property.ml
Normal file
@ -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 ; ];;
|
112
ocaml/Qmcchem_config.ml
Normal file
112
ocaml/Qmcchem_config.ml
Normal file
@ -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
|
||||
)
|
||||
|
||||
|
||||
|
865
ocaml/Qmcchem_dataserver.ml
Normal file
865
ocaml/Qmcchem_dataserver.ml
Normal file
@ -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
|
||||
|
||||
|
84
ocaml/Qmcchem_debug.ml
Normal file
84
ocaml/Qmcchem_debug.ml
Normal file
@ -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)
|
||||
|
||||
|
||||
|
310
ocaml/Qmcchem_edit.ml
Normal file
310
ocaml/Qmcchem_edit.ml
Normal file
@ -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 )
|
||||
|
||||
|
||||
|
||||
|
453
ocaml/Qmcchem_forwarder.ml
Normal file
453
ocaml/Qmcchem_forwarder.ml
Normal file
@ -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 ()
|
||||
|
113
ocaml/Qmcchem_md5.ml
Normal file
113
ocaml/Qmcchem_md5.ml
Normal file
@ -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:("<key> Change to input to <key>")
|
||||
+> flag "d" (optional string)
|
||||
~doc:("<key> Show input differences with <key>")
|
||||
+> 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 )
|
||||
|
||||
|
||||
|
||||
|
225
ocaml/Qmcchem_result.ml
Normal file
225
ocaml/Qmcchem_result.ml
Normal file
@ -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 )
|
||||
;;
|
||||
|
||||
|
||||
|
||||
|
217
ocaml/Qmcchem_run.ml
Normal file
217
ocaml/Qmcchem_run.ml
Normal file
@ -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:("<dataserver_addr> Start a qmc process on the local host.")
|
||||
+> flag "s" (optional string)
|
||||
~doc:("<host> Start a qmc process on <host>.")
|
||||
+> 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 )
|
||||
|
||||
|
||||
|
24
ocaml/Qmcchem_stop.ml
Normal file
24
ocaml/Qmcchem_stop.ml
Normal file
@ -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 )
|
||||
|
||||
|
830
ocaml/Qptypes.ml
Normal file
830
ocaml/Qptypes.ml
Normal file
@ -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")
|
||||
;;
|
||||
|
61
ocaml/Qputils.ml
Normal file
61
ocaml/Qputils.ml
Normal file
@ -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 ()
|
||||
|
712
ocaml/Random_variable.ml
Normal file
712
ocaml/Random_variable.ml
Normal file
@ -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<y) then -1
|
||||
else 0)
|
||||
|> 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<y) then -1
|
||||
else 0)
|
||||
|> 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
|
||||
;;
|
||||
|
46
ocaml/Sample.ml
Normal file
46
ocaml/Sample.ml
Normal file
@ -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"
|
||||
|
8
ocaml/Sample.mli
Normal file
8
ocaml/Sample.mli
Normal file
@ -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
|
||||
|
40
ocaml/Scheduler.ml
Normal file
40
ocaml/Scheduler.ml
Normal file
@ -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
|
||||
|
||||
|
||||
|
52
ocaml/Status.ml
Normal file
52
ocaml/Status.ml
Normal file
@ -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
|
||||
;;
|
||||
|
126
ocaml/Watchdog.ml
Normal file
126
ocaml/Watchdog.ml
Normal file
@ -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)
|
||||
;;
|
33
ocaml/compile.sh
Executable file
33
ocaml/compile.sh
Executable file
@ -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 ${@}
|
||||
|
||||
|
||||
|
||||
|
288
ocaml/ninja_ocaml.py
Executable file
288
ocaml/ninja_ocaml.py
Executable file
@ -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 <scemama@irsamc.ups-tlse.fr>"""
|
||||
|
||||
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()
|
||||
|
15
ocaml/qmcchem.ml
Normal file
15
ocaml/qmcchem.ml
Normal file
@ -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
|
336
ocaml/qptypes_generator.ml
Normal file
336
ocaml/qptypes_generator.ml
Normal file
@ -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
|
||||
|
||||
|
||||
|
||||
|
177
scripts/create_properties_ezfio.py
Executable file
177
scripts/create_properties_ezfio.py
Executable file
@ -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)
|
||||
|
Loading…
Reference in New Issue
Block a user