LCPQ/qmcchem
10
1
Fork 1
mirror of https://gitlab.com/scemama/qmcchem.git synced 2024-06-26 15:12:04 +02:00
Code Releases Activity

Removing core

Browse Source
This commit is contained in:
Anthony Scemama 2019-07-19 17:06:01 +02:00
parent a719c694ce
commit a13410d277
10 changed files with 353 additions and 327 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

74
ocaml/Message.ml
View File

@ -1,15 +1,14 @@
open Core
open Qptypes open Qptypes
type t = type t =
| Property of Block.t | Property of Block.t
| Walkers of Compute_node.t * Pid.t * (float array) array | Walkers of Compute_node.t * int * (float array) array
| Register of Compute_node.t * Pid.t | Register of Compute_node.t * int
| Unregister of Compute_node.t * Pid.t | Unregister of Compute_node.t * int
| Test | Test
| GetWalkers of Strictly_positive_int.t | GetWalkers of Strictly_positive_int.t
| Ezfio of string | Ezfio of string
| Error of string | Error of string
let create m = let create m =
@ -19,45 +18,45 @@ let create m =
let open Block in let open Block in
Property Property
{ property = Property.Cpu; { property = Property.Cpu;
value = Sample.of_float (Float.of_string v) ; value = Sample.of_float (float_of_string v) ;
weight = Weight.of_float 1.; weight = Weight.of_float 1.;
compute_node = Compute_node.of_string c; compute_node = Compute_node.of_string c;
pid = Pid.of_string pid; pid = int_of_string pid;
block_id = Block_id.of_int (Int.of_string b); block_id = Block_id.of_int (int_of_string b);
} }
| [ "accep" ; c ; pid ; b ; "1" ; v ] -> | [ "accep" ; c ; pid ; b ; "1" ; v ] ->
let open Block in let open Block in
Property Property
{ property = Property.Accep; { property = Property.Accep;
value = Sample.of_float (Float.of_string v) ; value = Sample.of_float (float_of_string v) ;
weight = Weight.of_float 1.; weight = Weight.of_float 1.;
compute_node = Compute_node.of_string c; compute_node = Compute_node.of_string c;
pid = Pid.of_string pid; pid = int_of_string pid;
block_id = Block_id.of_int (Int.of_string b); block_id = Block_id.of_int (int_of_string b);
} }
| [ prop ; c ; pid ; b ; w ; v ] -> | [ prop ; c ; pid ; b ; w ; v ] ->
let open Block in let open Block in
Property Property
{ property = Property.of_string prop; { property = Property.of_string prop;
value = Sample.of_float (Float.of_string v); value = Sample.of_float (float_of_string v);
weight = Weight.of_float (Float.of_string w); weight = Weight.of_float (float_of_string w);
compute_node = Compute_node.of_string c; compute_node = Compute_node.of_string c;
pid = Pid.of_string pid; pid = int_of_string pid;
block_id = Block_id.of_int (Int.of_string b); block_id = Block_id.of_int (int_of_string b);
} }
| "elec_coord" :: c :: pid :: _ :: n ::walkers -> | "elec_coord" :: c :: pid :: _ :: n ::walkers ->
begin begin
let elec_num = let elec_num =
Lazy.force Qputils.elec_num Lazy.force Qputils.elec_num
and n = and n =
Int.of_string n int_of_string n
in in
assert (n = List.length walkers); assert (n = List.length walkers);
let rec build_walker accu = function let rec build_walker accu = function
| (0,tail) -> | (0,tail) ->
let result = let result =
List.rev accu List.rev accu
|> List.map ~f:Float.of_string |> List.map float_of_string
|> Array.of_list |> Array.of_list
in in
(result, tail) (result, tail)
@ -73,11 +72,11 @@ let create m =
in in
build (result::accu) tail build (result::accu) tail
in in
Walkers (Compute_node.of_string c, Pid.of_string pid, build [] walkers) Walkers (Compute_node.of_string c, int_of_string pid, build [] walkers)
end end
| [ "get_walkers" ; n ] -> GetWalkers (n |> Int.of_string |> Strictly_positive_int.of_int) | [ "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) | [ "register" ; c ; pid ] -> Register (Compute_node.of_string c, int_of_string pid)
| [ "unregister" ; c ; pid ] -> Unregister (Compute_node.of_string c, Pid.of_string pid) | [ "unregister" ; c ; pid ] -> Unregister (Compute_node.of_string c, int_of_string pid)
| [ "Test" ] -> Test | [ "Test" ] -> Test
| [ "Ezfio" ; ezfio_msg ] -> Ezfio ezfio_msg | [ "Ezfio" ; ezfio_msg ] -> Ezfio ezfio_msg
| prop :: c :: pid :: b :: d :: w :: l -> | prop :: c :: pid :: b :: d :: w :: l ->
@ -88,22 +87,22 @@ let create m =
assert (not (Property.is_scalar property)); assert (not (Property.is_scalar property));
let a = let a =
Array.of_list l Array.of_list l
|> Array.map ~f:Float.of_string |> Array.map float_of_string
and dim = and dim =
Int.of_string d int_of_string d
in in
assert (Array.length a = dim); assert (Array.length a = dim);
let open Block in let open Block in
Property Property
{ property = property ; { property = property ;
value = Sample.of_float_array ~dim a; value = Sample.of_float_array ~dim a;
weight = Weight.of_float (Float.of_string w); weight = Weight.of_float (float_of_string w);
compute_node = Compute_node.of_string c; compute_node = Compute_node.of_string c;
pid = Pid.of_string pid; pid = int_of_string pid;
block_id = Block_id.of_int (Int.of_string b); block_id = Block_id.of_int (int_of_string b);
} }
end end
| l -> Error (String.concat ~sep:":" l) | l -> Error (String.concat ":" l)
with with
| Assert_failure (l,_,_) -> Error l | Assert_failure (l,_,_) -> Error l
| _ -> Error "Unknown error" | _ -> Error "Unknown error"
@ -111,14 +110,13 @@ let create m =
let to_string = function let to_string = function
| Property b -> "Property : "^(Block.to_string b) | Property b -> "Property : "^(Block.to_string b)
| Walkers (h,p,w) -> Printf.sprintf "Walkers : %s %s : %d walkers" | Walkers (h,p,w) -> Printf.sprintf "Walkers : %s %d : %d walkers"
(Compute_node.to_string h) (Pid.to_string p) (Compute_node.to_string h) p (Array.length w)
(Array.length w)
| GetWalkers n -> Printf.sprintf "GetWalkers %d" (Strictly_positive_int.to_int n) | GetWalkers n -> Printf.sprintf "GetWalkers %d" (Strictly_positive_int.to_int n)
| Register (h,p) -> Printf.sprintf "Register : %s %s" | Register (h,p) -> Printf.sprintf "Register : %s %d"
(Compute_node.to_string h) (Pid.to_string p) (Compute_node.to_string h) p
| Unregister (h,p) -> Printf.sprintf "Unregister : %s %s" | Unregister (h,p) -> Printf.sprintf "Unregister : %s %d"
(Compute_node.to_string h) (Pid.to_string p) (Compute_node.to_string h) p
| Test -> "Test" | Test -> "Test"
| Ezfio msg -> "Ezfio "^msg | Ezfio msg -> "Ezfio "^msg
| Error msg -> "Error "^msg | Error msg -> "Error "^msg

231
ocaml/Qmcchem_dataserver.ml
View File

@ -1,4 +1,3 @@
open Core
open Qptypes open Qptypes
(** Data server of QMC=Chem. (** Data server of QMC=Chem.
@ -35,20 +34,27 @@ let run ?(daemon=true) ezfio_filename =
if ( not(Ezfio.has_electrons_elec_coord_pool ()) ) then if ( not(Ezfio.has_electrons_elec_coord_pool ()) ) then
begin begin
Printf.printf "Generating initial walkers...\n%!"; Printf.printf "Generating initial walkers...\n%!";
Unix.fork_exec ~prog:(Lazy.force Qmcchem_config.qmc_create_walkers) match Unix.fork () with
~argv:["qmc_create_walkers" ; ezfio_filename] () | 0 ->
|> Unix.waitpid_exn ; Unix.execv
(Lazy.force Qmcchem_config.qmc_create_walkers)
[|"qmc_create_walkers" ; ezfio_filename|]
| pid ->
begin
let pid', status = Unix.waitpid [] pid in
assert (status = Unix.WEXITED 0);
Printf.printf "Initial walkers ready\n%!" Printf.printf "Initial walkers ready\n%!"
end ; end
end
in in
(** Measures the time difference between [t0] and [Time.now ()] *) (** Measures the time difference between [t0] and [Unix.time ()] *)
let delta_t t0 = let delta_t t0 =
let t1 = let t1 =
Time.now () Unix.time ()
in in
Time.abs_diff t1 t0 t1 -. t0
in in
(** {2 ZeroMQ initialization} *) (** {2 ZeroMQ initialization} *)
@ -60,8 +66,7 @@ let run ?(daemon=true) ezfio_filename =
(** Maximum size of the blocks file before compressing *) (** Maximum size of the blocks file before compressing *)
let max_file_size = ref ( let max_file_size = ref ( 64 * 1024 )
Byte_units.create `Kilobytes 64.)
in in
@ -88,9 +93,9 @@ let run ?(daemon=true) ezfio_filename =
"tcp://*:" "tcp://*:"
in in
let result = let result =
List.fold [0;1;2;3] ~init:true ~f:(fun accu i -> List.fold_left (fun accu i ->
let address = let address =
adress_prefix ^ (Int.to_string (n+i)) adress_prefix ^ (string_of_int (n+i))
in in
let socket = let socket =
Zmq.Socket.create zmq_context Zmq.Socket.rep Zmq.Socket.create zmq_context Zmq.Socket.rep
@ -104,7 +109,7 @@ let run ?(daemon=true) ezfio_filename =
in in
Zmq.Socket.close socket; Zmq.Socket.close socket;
result result
) ) true [0;1;2;3]
in in
if (result) then if (result) then
`Available `Available
@ -145,8 +150,8 @@ let run ?(daemon=true) ezfio_filename =
delta_t t0 delta_t t0
in in
let message = let message =
Printf.sprintf "%20s : %8d : %10s : %s" Printf.sprintf "%20s : %8d : %10s : %f"
socket size text (Time.Span.to_string dt) socket size text dt
in in
Zmq.Socket.send debug_socket message Zmq.Socket.send debug_socket message
in in
@ -179,7 +184,7 @@ let run ?(daemon=true) ezfio_filename =
(** Array of walkers. The size is [walk_num_tot]. *) (** Array of walkers. The size is [walk_num_tot]. *)
let walkers_array = let walkers_array =
let t0 = let t0 =
Time.now () Unix.time ()
in in
let j = let j =
3*elec_num + 3 3*elec_num + 3
@ -190,17 +195,17 @@ let run ?(daemon=true) ezfio_filename =
and ez = and ez =
Ezfio.get_electrons_elec_coord_pool () Ezfio.get_electrons_elec_coord_pool ()
|> Ezfio.flattened_ezfio |> Ezfio.flattened_ezfio
|> Array.map ~f:Float.to_string |> Array.map string_of_float
in in
try try
Array.init walk_num_tot ~f:(fun i -> Array.init walk_num_tot (fun i ->
Array.sub ~pos:(j*(i mod size)) ~len:j ez) Array.sub ez (j*(i mod size)) j )
with with
| Invalid_argument _ -> | Invalid_argument _ ->
failwith "Walkers file is broken." failwith "Walkers file is broken."
in in
String.concat [ "Read " ; Int.to_string (Array.length result) ; String.concat " " [ "Read" ; string_of_int (Array.length result) ;
" walkers"] "walkers"]
|> send_log "status" 0 t0 ; |> send_log "status" 0 t0 ;
result result
in in
@ -214,28 +219,28 @@ let run ?(daemon=true) ezfio_filename =
(** Last time when the walkers were saved to disk. *) (** Last time when the walkers were saved to disk. *)
let last_save_walkers = let last_save_walkers =
ref (Time.now ()) ref (Unix.time ())
in in
(** Saves the walkers to disk. *) (** Saves the walkers to disk. *)
let save_walkers () = let save_walkers () =
if (delta_t !last_save_walkers > (Time.Span.of_sec 10.) ) then if (delta_t !last_save_walkers > 10. ) then
begin begin
let t0 = let t0 =
Time.now () Unix.time ()
in in
Ezfio.set_electrons_elec_coord_pool_size walk_num_tot ; Ezfio.set_electrons_elec_coord_pool_size walk_num_tot ;
let walkers_list = let walkers_list =
Array.map walkers_array ~f:Array.to_list Array.map Array.to_list walkers_array
|> Array.to_list |> Array.to_list
|> List.concat |> List.concat
|> List.map ~f:Float.of_string |> List.map float_of_string
in in
Ezfio.set_electrons_elec_coord_pool (Ezfio.ezfio_array_of_list Ezfio.set_electrons_elec_coord_pool (Ezfio.ezfio_array_of_list
~rank:3 ~dim:[| elec_num+1 ; 3 ; walk_num_tot |] ~data:walkers_list); ~rank:3 ~dim:[| elec_num+1 ; 3 ; walk_num_tot |] ~data:walkers_list);
send_log "status" walk_num_tot t0 "Saved walkers"; send_log "status" walk_num_tot t0 "Saved walkers";
last_save_walkers := Time.now (); last_save_walkers := Unix.time ();
end end
in in
@ -245,7 +250,7 @@ let run ?(daemon=true) ezfio_filename =
disk if the array of walkers is filled. In that case, sets the last_walker to 0. disk if the array of walkers is filled. In that case, sets the last_walker to 0.
*) *)
let increment_last_walker () = let increment_last_walker () =
last_walker := !last_walker + 1; incr last_walker;
if (!last_walker = walk_num_tot) then if (!last_walker = walk_num_tot) then
begin begin
last_walker := 0 ; last_walker := 0 ;
@ -266,16 +271,16 @@ let run ?(daemon=true) ezfio_filename =
(** The hash table for workers *) (** The hash table for workers *)
let workers_hash = let workers_hash =
String.Table.create () Hashtbl.create 63
in in
(** Creates a key using the couple ([Compute_node], [PID]) *) (** Creates a key using the couple ([Compute_node], [PID]) *)
let key compute_node pid = let key compute_node pid =
String.concat [ String.concat " " [
(Compute_node.to_string compute_node); " "; (Compute_node.to_string compute_node);
(Pid.to_string pid) ] (string_of_int pid) ]
in in
@ -286,9 +291,9 @@ let run ?(daemon=true) ezfio_filename =
let s = let s =
key w pid key w pid
in in
match Hashtbl.add workers_hash ~key:s ~data:(Time.now ()) with match Hashtbl.find_opt workers_hash s with
| `Ok -> () | Some _ -> failwith (s^" already registered")
| `Duplicate -> failwith (s^" already registered") | None -> Hashtbl.add workers_hash s (Unix.time ())
in in
@ -299,29 +304,33 @@ let run ?(daemon=true) ezfio_filename =
let s = let s =
key w pid key w pid
in in
match Hashtbl.find workers_hash s with match Hashtbl.find_opt workers_hash s with
| Some x -> Hashtbl.remove workers_hash s | Some x -> Hashtbl.remove workers_hash s
| None -> failwith (s^" not registered") | None -> failwith (s^" not registered")
in in
(** Sets the last access of the worker to [Time.now ()] *) (** Sets the last access of the worker to [Unix.time ()] *)
let touch_worker w pid = let touch_worker w pid =
let s = let s =
key w pid key w pid
in in
Hashtbl.set workers_hash ~key:s ~data:(Time.now ()) Hashtbl.replace workers_hash s (Unix.time ())
in in
(** Returns the number of connected workers *) (** Returns the number of connected workers *)
let n_connected hash now = let n_connected hash now =
let delta = let delta =
Time.Span.of_sec (initialization_timeout +. block_time *. 2.) initialization_timeout +. block_time *. 2.
in in
Hashtbl.filter hash ~f:(fun x -> (Time.abs_diff now x) <= delta) Hashtbl.fold (fun k v accu ->
|> Hashtbl.length if (now -. v) <= delta then
v :: accu
else
accu ) hash []
|> List.length
in in
@ -339,12 +348,11 @@ let run ?(daemon=true) ezfio_filename =
Lazy.force Block.dir_name Lazy.force Block.dir_name
in in
let () = let () =
match Sys.is_directory dirname with if not (Sys.is_directory dirname) then
| `Yes -> () Unix.mkdir dirname 0o600
| _ -> Unix.mkdir_p dirname
in in
Filename.concat dirname ( Filename.concat dirname (
hostname ^ "." ^ (Pid.to_string dataserver_pid) hostname ^ "." ^ (string_of_int dataserver_pid)
) )
in in
@ -361,14 +369,14 @@ let run ?(daemon=true) ezfio_filename =
(** [Out_channel] corresponding to the blocks file written by the current process. *) (** [Out_channel] corresponding to the blocks file written by the current process. *)
let block_channel = let block_channel =
try try
ref (Out_channel.create block_channel_filename_locked) ref (open_out block_channel_filename_locked)
with with
| Sys_error _ -> | Sys_error _ ->
begin begin
(* NFS Stale file handle : (* NFS Stale file handle :
* Wait 5 seconds, and retry *) * Wait 5 seconds, and retry *)
Time.Span.of_sec 5. |> Time.pause; Unix.sleep 5;
ref (Out_channel.create block_channel_filename_locked) ref (open_out block_channel_filename_locked)
end end
in in
@ -379,13 +387,13 @@ let run ?(daemon=true) ezfio_filename =
*) *)
let compress_block_file filename = let compress_block_file filename =
let t0 = let t0 =
Time.now () Unix.time ()
in in
Out_channel.close !block_channel; close_out !block_channel;
Unix.rename ~src:block_channel_filename_locked ~dst:block_channel_filename_tmp; Unix.rename block_channel_filename_locked block_channel_filename_tmp;
Random_variable.compress_files (); Random_variable.compress_files ();
send_log "status" 0 t0 "Compressed block file"; send_log "status" 0 t0 "Compressed block file";
block_channel := Out_channel.create ~append:true block_channel_filename_locked block_channel := open_out_gen [ Open_append ] 0o660 block_channel_filename_locked
in in
@ -396,7 +404,7 @@ let run ?(daemon=true) ezfio_filename =
let start_status_thread = let start_status_thread =
let t0 = let t0 =
Time.now () Unix.time ()
in in
Thread.create (fun () -> Thread.create (fun () ->
send_log "status" 0 t0 "Starting status thread"; send_log "status" 0 t0 "Starting status thread";
@ -407,16 +415,14 @@ let run ?(daemon=true) ezfio_filename =
Printf.sprintf "tcp://*:%d" (port+1) Printf.sprintf "tcp://*:%d" (port+1)
in in
bind_socket "PUB" socket address; bind_socket "PUB" socket address;
let delay = let delay = 0.3
Time.Span.of_ms 300. and delay_read = 2.
and delay_read =
Time.Span.of_sec 2.
in in
let start_time = let start_time =
Time.now () Unix.time ()
and stop_time = and stop_time =
ref (Time.Span.of_sec Input.Stop_time.(read () |> to_float) ) ref (Input.Stop_time.(read () |> to_float) )
in in
let last_update = let last_update =
@ -425,9 +431,9 @@ let run ?(daemon=true) ezfio_filename =
while (!status <> Status.Stopped) while (!status <> Status.Stopped)
do do
Time.pause delay; Unix.sleepf delay;
let now = let now =
Time.now () Unix.time ()
in in
let status_string = let status_string =
Status.to_string !status Status.to_string !status
@ -436,14 +442,14 @@ let run ?(daemon=true) ezfio_filename =
send_log "status" (String.length status_string) now status_string; send_log "status" (String.length status_string) now status_string;
let test = let test =
if (Time.abs_diff now !last_update > delay_read) then if (now -. !last_update > delay_read) then
let n_connect = let n_connect =
n_connected workers_hash now n_connected workers_hash now
in in
`Update n_connect `Update n_connect
else if (Time.abs_diff now start_time > !stop_time) then else if (now -. start_time > !stop_time) then
`Terminate `Terminate
else if (Time.abs_diff now start_time > Time.Span.of_sec initialization_timeout) then else if (now -. start_time > initialization_timeout) then
`Timeout `Timeout
else else
`None `None
@ -458,7 +464,7 @@ let run ?(daemon=true) ezfio_filename =
begin begin
status := Status.read (); status := Status.read ();
last_update := now; last_update := now;
stop_time := Time.Span.of_sec Input.Stop_time.(read () |> to_float) ; stop_time := Input.Stop_time.(read () |> to_float) ;
let n_tot = let n_tot =
Hashtbl.length workers_hash Hashtbl.length workers_hash
in in
@ -482,7 +488,7 @@ let run ?(daemon=true) ezfio_filename =
let start_log_thread = let start_log_thread =
let t0 = let t0 =
Time.now () Unix.time ()
in in
Thread.create (fun () -> Thread.create (fun () ->
send_log "status" 0 t0 "Starting log thread"; send_log "status" 0 t0 "Starting log thread";
@ -509,10 +515,10 @@ let run ?(daemon=true) ezfio_filename =
begin begin
let message = let message =
Zmq.Socket.recv_all ~block:false socket Zmq.Socket.recv_all ~block:false socket
|> String.concat ~sep:" " |> String.concat " "
in in
let now = let now =
Time.now () Unix.time ()
in in
send_log "log" 0 now message send_log "log" 0 now message
end end
@ -548,7 +554,7 @@ let run ?(daemon=true) ezfio_filename =
let start_main_thread = let start_main_thread =
let wall0 = let wall0 =
Time.now () Unix.time ()
in in
let f () = let f () =
@ -569,19 +575,18 @@ let run ?(daemon=true) ezfio_filename =
(** EZFIO Cache *) (** EZFIO Cache *)
let ezfio_cache = let ezfio_cache =
String.Table.create () Hashtbl.create 63
in in
let handle_ezfio msg = let handle_ezfio msg =
match Hashtbl.find ezfio_cache msg with match Hashtbl.find_opt ezfio_cache msg with
| Some result -> result | Some result -> result
| None -> | None ->
begin begin
let result = let result =
decode_ezfio_message msg decode_ezfio_message msg
in in
match (Hashtbl.add ezfio_cache ~key:msg ~data:result) with Hashtbl.add ezfio_cache msg result;
| `Ok -> result result
| `Duplicate -> result
end end
in in
@ -620,13 +625,13 @@ let run ?(daemon=true) ezfio_filename =
Zmq.Socket.recv_all ~block:false rep_socket Zmq.Socket.recv_all ~block:false rep_socket
in in
let t0 = let t0 =
Time.now () Unix.time ()
in in
let msg = let msg =
List.map ~f:String.strip raw_msg List.map String.trim raw_msg
|> Message.create |> Message.create
and msg_size = and msg_size =
List.fold ~init:0 ~f:(fun accu x -> accu + (String.length x)) raw_msg List.fold_left (fun accu x -> accu + (String.length x)) 0 raw_msg
in in
let handle = function let handle = function
| Message.Error _ -> () | Message.Error _ -> ()
@ -654,9 +659,9 @@ let run ?(daemon=true) ezfio_filename =
| Status.Queued | Status.Queued
| Status.Running -> | Status.Running ->
begin begin
String.concat [ "Register : " ; String.concat " " [ "Register :" ;
(Compute_node.to_string w) ; " " ; Compute_node.to_string w ;
(Pid.to_string pid) ] string_of_int pid ]
|> send_log "req" msg_size t0; |> send_log "req" msg_size t0;
add_worker w pid; add_worker w pid;
if (!status = Status.Queued) then if (!status = Status.Queued) then
@ -670,15 +675,15 @@ let run ?(daemon=true) ezfio_filename =
end end
| Message.Unregister (w,pid) -> | Message.Unregister (w,pid) ->
begin begin
String.concat [ "Unregister : " ; String.concat " " [ "Unregister :" ;
(Compute_node.to_string w) ; " " ; (Compute_node.to_string w) ;
(Pid.to_string pid) ] (string_of_int pid) ]
|> send_log "req" msg_size t0; |> send_log "req" msg_size t0;
Zmq.Socket.send rep_socket "OK"; Zmq.Socket.send rep_socket "OK";
del_worker w pid; del_worker w pid;
String.concat [ "Unregister : "; String.concat " " [ "Unregister :";
(Hashtbl.length workers_hash) |> Int.to_string ; (Hashtbl.length workers_hash) |> string_of_int ;
" remaining" ] "remaining" ]
|> send_log "rep" 2 t0 ; |> send_log "rep" 2 t0 ;
let n_connect = let n_connect =
n_connected workers_hash t0 n_connected workers_hash t0
@ -705,13 +710,13 @@ let run ?(daemon=true) ezfio_filename =
Zmq.Socket.recv_all ~block:false pull_socket Zmq.Socket.recv_all ~block:false pull_socket
in in
let t0 = let t0 =
Time.now () Unix.time ()
in in
let msg = let msg =
List.map ~f:String.strip raw_msg List.map String.trim raw_msg
|> Message.create |> Message.create
and msg_size = and msg_size =
List.fold ~init:0 ~f:(fun accu x -> accu + (String.length x)) raw_msg List.fold_left (fun accu x -> accu + (String.length x)) 0 raw_msg
in in
let recv_log = let recv_log =
send_log "pull" msg_size t0 send_log "pull" msg_size t0
@ -730,22 +735,25 @@ let run ?(daemon=true) ezfio_filename =
recv_log log_msg ; recv_log log_msg ;
for i=0 to ((Array.length w)-1) for i=0 to ((Array.length w)-1)
do do
(*
Array.replace walkers_array (!last_walker) (fun _ -> Array.map Array.replace walkers_array (!last_walker) (fun _ -> Array.map
~f:Float.to_string w.(i)); string_of_float w.(i));
*)
walkers_array.(!last_walker) <- Array.map string_of_float w.(i);
increment_last_walker (); increment_last_walker ();
done; done;
let wall = let wall =
Printf.sprintf "%f %f # %s %s %s %d" Printf.sprintf "%f %f # %s %s %s %d"
(Time.Span.to_sec (Time.abs_diff (Time.now ()) wall0)) (Unix.time () -. wall0)
1. (Property.to_string Property.Wall) 1. (Property.to_string Property.Wall)
hostname (Pid.to_string dataserver_pid) 1 hostname (string_of_int dataserver_pid) 1
|> Block.of_string |> Block.of_string
in in
match wall with match wall with
| Some wall -> | Some wall ->
begin begin
Out_channel.output_string !block_channel (Block.to_string wall); output_string !block_channel (Block.to_string wall);
Out_channel.output_char !block_channel '\n'; output_char !block_channel '\n';
end end
| _ -> () | _ -> ()
end end
@ -753,8 +761,8 @@ let run ?(daemon=true) ezfio_filename =
begin begin
if (status = Status.Running) then if (status = Status.Running) then
touch_worker b.Block.compute_node b.Block.pid ; touch_worker b.Block.compute_node b.Block.pid ;
Out_channel.output_string !block_channel (Block.to_string b); output_string !block_channel (Block.to_string b);
Out_channel.output_char !block_channel '\n'; output_char !block_channel '\n';
recv_log (Block.to_string b) recv_log (Block.to_string b)
end end
| Message.Test | Message.Test
@ -780,22 +788,20 @@ let run ?(daemon=true) ezfio_filename =
| Some Zmq.Poll.In -> handle_rep () | Some Zmq.Poll.In -> handle_rep ()
| _ -> | _ ->
begin begin
Out_channel.flush !block_channel ; flush !block_channel ;
let file_size = let file_size =
(Unix.stat block_channel_filename_locked).Unix.st_size (Unix.stat block_channel_filename_locked).Unix.st_size
|> Float.of_int64
|> Byte_units.create `Bytes
in in
if (file_size > !max_file_size) then if (file_size > !max_file_size) then
begin begin
compress_block_file (); compress_block_file ();
max_file_size := Byte_units.scale file_size 1.2; max_file_size := (file_size * 12) / 10;
end end
end end
end end
done; done;
List.iter ~f:(fun socket -> List.iter (fun socket ->
Zmq.Socket.set_linger_period socket 1000 ; Zmq.Socket.set_linger_period socket 1000 ;
Zmq.Socket.close socket) Zmq.Socket.close socket)
[ rep_socket ; pull_socket ] [ rep_socket ; pull_socket ]
@ -819,8 +825,8 @@ let run ?(daemon=true) ezfio_filename =
Zmq.Context.terminate zmq_context; Zmq.Context.terminate zmq_context;
begin begin
try try
Out_channel.close !block_channel; close_out !block_channel;
Unix.remove block_channel_filename_locked Unix.unlink block_channel_filename_locked
with with
| _ -> () | _ -> ()
end; end;
@ -830,27 +836,28 @@ let run ?(daemon=true) ezfio_filename =
(** {3 Main function} *) (** {3 Main function} *)
let t0 = let t0 =
Time.now () Unix.time ()
in in
(* Handle signals *) (* Handle signals *)
let handler s = let handler s =
Printf.printf "Dataserver received the %s signal... killing\n%!" (Signal.to_string s); Printf.printf "Dataserver received signal %d... killing\n%!" s;
Watchdog.kill (); Watchdog.kill ();
in in
List.iter [ List.iter (fun s -> ignore @@ Sys.signal s (Sys.Signal_handle handler))
Signal.int ; [
Signal.term ; Sys.sigint ;
Signal.quit ; Sys.sigterm ;
Sys.sigquit ;
] ]
~f:(fun x -> Signal.Expert.handle x handler)
; ;
(* Run threads *) (* Run threads *)
begin begin
try try
(List.iter ~f:Thread.join (List.iter Thread.join
[ start_status_thread () ; [ start_status_thread () ;
start_log_thread () ; start_log_thread () ;
start_main_thread () ; start_main_thread () ;
@ -860,7 +867,7 @@ let run ?(daemon=true) ezfio_filename =
begin begin
print_endline "Trapped error. Waiting 10 seconds..."; print_endline "Trapped error. Waiting 10 seconds...";
change_status Status.Stopping; change_status Status.Stopping;
Time.Span.of_sec 10. |> Time.pause; Unix.sleep 10;
finalize ~t0; finalize ~t0;
raise err raise err
end end

5
ocaml/Qmcchem_debug.ml
View File

@ -1,6 +1,3 @@
open Core
let run ~t ezfio_filename= let run ~t ezfio_filename=
Qputils.set_ezfio_filename ezfio_filename; Qputils.set_ezfio_filename ezfio_filename;
@ -20,7 +17,7 @@ let run ~t ezfio_filename=
let address = let address =
match (Ezfio.get_simulation_http_server () match (Ezfio.get_simulation_http_server ()
|> String.rsplit2 ~on:':' ) |> String_ext.rsplit2 ~on:':' )
with with
| Some (a,p) -> a^":"^( (Int.of_string p)+4 |> Int.to_string ) | Some (a,p) -> a^":"^( (Int.of_string p)+4 |> Int.to_string )
| None -> failwith "Badly formed address" | None -> failwith "Badly formed address"

2
ocaml/Qmcchem_edit.ml
View File

@ -339,7 +339,7 @@ let () =
anonymous "EZFIO_DIR" Mandatory "EZFIO directory"; anonymous "EZFIO_DIR" Mandatory "EZFIO directory";
anonymous "FILE" Optional "Name of the input file"; anonymous "FILE" Optional "Name of the input file";
] ]
|> set_specs ; |> set_specs
end; end;
let c = Command_line.get_bool "clear" in let c = Command_line.get_bool "clear" in

102
ocaml/Qmcchem_forwarder.ml
View File

@ -1,5 +1,3 @@
open Core
let bind_socket ~socket_type ~socket ~address = let bind_socket ~socket_type ~socket ~address =
let rec loop = function let rec loop = function
| 0 -> failwith @@ Printf.sprintf | 0 -> failwith @@ Printf.sprintf
@ -11,7 +9,7 @@ let bind_socket ~socket_type ~socket ~address =
Zmq.Socket.bind socket address; Zmq.Socket.bind socket address;
loop (-1) loop (-1)
with with
| Unix.Unix_error _ -> (Time.pause @@ Time.Span.of_sec 1. ; loop (i-1) ) | Unix.Unix_error _ -> (Unix.sleep 1 ; loop (i-1) )
| other_exception -> raise other_exception | other_exception -> raise other_exception
in loop 10 in loop 10
@ -20,9 +18,8 @@ let bind_socket ~socket_type ~socket ~address =
let run ezfio_filename dataserver = let run ezfio_filename dataserver =
let dataserver_address, dataserver_port = let dataserver_address, dataserver_port =
Substring.create ~pos:6 (Bytes.of_string dataserver) String.sub dataserver 6 (String.length dataserver - 6)
|> Substring.to_string |> String_ext.lsplit2_exn ~on:':'
|> String.lsplit2_exn ~on:':'
and qmc = and qmc =
Lazy.force Qmcchem_config.qmc Lazy.force Qmcchem_config.qmc
in in
@ -36,14 +33,14 @@ let run ezfio_filename dataserver =
(* Port of the data server *) (* Port of the data server *)
let port = let port =
(Int.of_string dataserver_port)+10 (int_of_string dataserver_port)+10
in in
(* Build qmc executable command *) (* Build qmc executable command *)
let prog, argv = let prog, argv =
qmc, qmc,
[ qmc ; ezfio_filename ; [| qmc ; ezfio_filename ;
Printf.sprintf "ipc://%s:%d" Qmcchem_config.dev_shm port ]; Printf.sprintf "ipc://%s:%d" Qmcchem_config.dev_shm port |];
in in
(* Create the temporary directory. If it is possible, then the process is a (* Create the temporary directory. If it is possible, then the process is a
@ -51,47 +48,44 @@ let run ezfio_filename dataserver =
*) *)
let () = let () =
try try
Unix.mkdir tmpdir; Unix.mkdir tmpdir 0o600;
Unix.chdir tmpdir Unix.chdir tmpdir
with with
| Unix.Unix_error _ -> | Unix.Unix_error _ ->
begin begin
Unix.chdir tmpdir; Unix.chdir tmpdir;
Time.pause @@ Time.Span.of_sec 0.1; Unix.sleepf 0.1 ;
match (Sys.file_exists "PID") with if Sys.file_exists "PID" then
| `No begin
| `Unknown -> ()
| `Yes ->
let pid = let pid =
In_channel.with_file "PID" ~f:(fun ic -> let ic = open_in "PID" in
match (In_channel.input_line ic) with try
| Some x -> x int_of_string (input_line ic)
| None -> "-1" ) with
|> Int.of_string | End_of_file -> -1
in in
match pid with match pid with
| -1 -> () | -1 -> ()
| pid -> | pid ->
begin try
match Signal.send (Signal.of_system_int 0) (`Pid (Pid.of_int pid)) with Unix.kill pid 0 ;
| `No_such_process -> () ignore @@ Unix.execv prog argv
| _ -> ignore @@ Unix.exec ~prog ~argv () with
| Unix.Unix_error (Unix.ESRCH, _, _) -> ()
end end
end end
in in
(* Now, only one forwarder will execute the following code *) (* Now, only one forwarder will execute the following code *)
Out_channel.with_file "PID" ~f:(fun oc -> let oc = open_out "PID" in
Unix.getpid () Unix.getpid ()
|> Pid.to_int
|> Printf.sprintf "%d\n" |> Printf.sprintf "%d\n"
|> Out_channel.output_string oc); |> output_string oc
;
(* Fork a qmc *) (* Fork a qmc *)
ignore @@ ignore @@
Watchdog.fork_exec ~prog ~argv (); Watchdog.fork_exec ~prog ~args:argv ();
(* If there are MICs, use them here (TODO) *)
(* Fetch input *) (* Fetch input *)
let zmq_context = let zmq_context =
@ -104,9 +98,10 @@ let run ezfio_filename dataserver =
let command = let command =
Printf.sprintf "rm -rf -- \"%s\" " tmpdir Printf.sprintf "rm -rf -- \"%s\" " tmpdir
in in
match Unix.system command with try
| Ok _ -> () ignore @@ Unix.system command
| _ -> print_endline "Unable to remove temporary directory" with
| Unix.Unix_error _ -> print_endline "Unable to remove temporary directory"
; ;
Zmq.Context.terminate zmq_context ; Zmq.Context.terminate zmq_context ;
for i=port to port+4 for i=port to port+4
@ -126,15 +121,15 @@ let run ezfio_filename dataserver =
(* Signal handler to Kill properly all the processes *) (* Signal handler to Kill properly all the processes *)
let handler s = let handler s =
Printf.printf "Forwarder received the %s signal... killing\n%!" (Signal.to_string s); Printf.printf "Forwarder received signal %d... killing\n%!" s;
terminate (); terminate ();
in in
List.iter [ List.iter (fun s -> ignore @@ Sys.signal s (Sys.Signal_handle handler))
Signal.int ; [
Signal.term ; Sys.sigint ;
Signal.quit ; Sys.sigterm ;
Sys.sigquit ;
] ]
~f:(fun x -> Signal.Expert.handle x handler)
; ;
@ -189,7 +184,7 @@ let run ezfio_filename dataserver =
status := Status.of_string msg; status := Status.of_string msg;
end; end;
done; done;
List.iter ~f:(fun socket -> List.iter (fun socket ->
Zmq.Socket.set_linger_period socket 1000 ; Zmq.Socket.set_linger_period socket 1000 ;
Zmq.Socket.close socket) Zmq.Socket.close socket)
[ sub_socket ; pub_socket ] [ sub_socket ; pub_socket ]
@ -239,7 +234,7 @@ let run ezfio_filename dataserver =
|> Zmq.Socket.send sub_socket ; |> Zmq.Socket.send sub_socket ;
end end
done; done;
List.iter ~f:(fun socket -> List.iter (fun socket ->
Zmq.Socket.set_linger_period socket 1000 ; Zmq.Socket.set_linger_period socket 1000 ;
Zmq.Socket.close socket) Zmq.Socket.close socket)
[ sub_socket ; pub_socket ] [ sub_socket ; pub_socket ]
@ -268,7 +263,7 @@ let run ezfio_filename dataserver =
Zmq.Socket.set_linger_period dealer_socket 600_000; Zmq.Socket.set_linger_period dealer_socket 600_000;
let fetch_walkers () = let fetch_walkers () =
Zmq.Socket.send_all req_socket ["get_walkers" ; Int.to_string !walk_num ]; Zmq.Socket.send_all req_socket ["get_walkers" ; string_of_int !walk_num ];
Zmq.Socket.recv_all req_socket Zmq.Socket.recv_all req_socket
in in
@ -280,10 +275,10 @@ let run ezfio_filename dataserver =
(* EZFIO Cache *) (* EZFIO Cache *)
let ezfio_cache = let ezfio_cache =
String.Table.create () Hashtbl.create 63
in in
let handle_ezfio msg = let handle_ezfio msg =
match Hashtbl.find ezfio_cache msg with match Hashtbl.find_opt ezfio_cache msg with
| Some result -> result | Some result -> result
| None -> | None ->
begin begin
@ -291,9 +286,8 @@ let run ezfio_filename dataserver =
let result = let result =
Zmq.Socket.recv_all req_socket Zmq.Socket.recv_all req_socket
in in
match (Hashtbl.add ezfio_cache ~key:msg ~data:result) with Hashtbl.add ezfio_cache msg result;
| `Ok -> result result
| `Duplicate -> result
end end
in in
@ -315,7 +309,7 @@ let run ezfio_filename dataserver =
| head :: tail -> aux (head::header) tail | head :: tail -> aux (head::header) tail
| _ -> failwith "Too many routers in the middle" | _ -> failwith "Too many routers in the middle"
in in
aux [] (List.map ~f:String.strip raw_msg) aux [] (List.map String.trim raw_msg)
in in
let handle message = let handle message =
match message with match message with
@ -407,7 +401,7 @@ let run ezfio_filename dataserver =
| head :: tail -> aux (head::header) tail | head :: tail -> aux (head::header) tail
| _ -> failwith "Too many routers in the middle" | _ -> failwith "Too many routers in the middle"
in in
aux [] (List.map ~f:String.strip raw_msg) aux [] (List.map String.trim raw_msg)
in in
let handle message = let handle message =
match message with match message with
@ -469,7 +463,7 @@ let run ezfio_filename dataserver =
match message with match message with
| "elec_coord":: hostname :: pid :: id :: n_str :: rest -> | "elec_coord":: hostname :: pid :: id :: n_str :: rest ->
let n = let n =
Int.of_string n_str int_of_string n_str
in in
let len = let len =
n / !walk_num n / !walk_num
@ -478,7 +472,7 @@ let run ezfio_filename dataserver =
message message
else else
List.concat [ [ "elec_coord" ; hostname ; pid ; id ; List.concat [ [ "elec_coord" ; hostname ; pid ; id ;
Int.to_string (5*len)] ; ( select_n_of ~n:5 ~len rest ) ] string_of_int (5*len)] ; ( select_n_of ~n:5 ~len rest ) ]
| _ -> message | _ -> message
in in
Zmq.Socket.send_all push_socket new_message Zmq.Socket.send_all push_socket new_message
@ -508,7 +502,7 @@ let run ezfio_filename dataserver =
if (polling.(3) = Some Zmq.Poll.In) then if (polling.(3) = Some Zmq.Poll.In) then
handle_proxy (); handle_proxy ();
done; done;
List.iter ~f:(fun socket -> List.iter (fun socket ->
Zmq.Socket.set_linger_period socket 1000 ; Zmq.Socket.set_linger_period socket 1000 ;
Zmq.Socket.close socket) Zmq.Socket.close socket)
[ router_socket ; dealer_socket ; push_socket ; pull_socket ; proxy_socket ] [ router_socket ; dealer_socket ; push_socket ; pull_socket ; proxy_socket ]
@ -520,7 +514,7 @@ let run ezfio_filename dataserver =
(* Start the status thread and the main thread *) (* Start the status thread and the main thread *)
begin begin
try try
(List.iter ~f:Thread.join (List.iter Thread.join
[ start_status_thread (); [ start_status_thread ();
start_log_thread (); start_log_thread ();
start_proxy_thread (); start_proxy_thread ();
@ -531,7 +525,7 @@ let run ezfio_filename dataserver =
begin begin
print_endline "Trapped error. Waiting 10 seconds..."; print_endline "Trapped error. Waiting 10 seconds...";
status := Status.Stopping; status := Status.Stopping;
Time.Span.of_sec 10. |> Time.pause; Unix.sleep 10 ;
raise err raise err
end end
end; end;

5
ocaml/Qmcchem_info.ml
View File

@ -1,4 +1,3 @@
open Core
let run ezfio_filename = let run ezfio_filename =
@ -8,10 +7,10 @@ let run ezfio_filename =
in in
let prog, argv = let prog, argv =
qmcchem_info, qmcchem_info,
[ qmcchem_info ; ezfio_filename ] [| qmcchem_info ; ezfio_filename |]
in in
ignore @@ ignore @@
Unix.exec ~prog ~argv () Unix.exec prog argv
let spec = let spec =

80
ocaml/Qmcchem_md5.ml
View File

@ -1,4 +1,3 @@
open Core
let run ?c ?d ~l ~update ezfio_filename = let run ?c ?d ~l ~update ezfio_filename =
@ -22,7 +21,7 @@ let run ?c ?d ~l ~update ezfio_filename =
let filename = let filename =
filename_of_key key filename_of_key key
in in
Sys.file_exists_exn filename Sys.file_exists filename
in in
if (update) then if (update) then
@ -37,27 +36,28 @@ let run ?c ?d ~l ~update ezfio_filename =
if (old_key <> new_key) then if (old_key <> new_key) then
begin begin
let prefix =
Filename.concat ezfio_filename "blocks"
in
let new_name = let new_name =
String.concat ~sep:"/" [ ezfio_filename; "blocks"; new_key ] Filename.concat prefix new_key
and old_name = and old_name =
String.concat ~sep:"/" [ ezfio_filename; "blocks"; old_key ] Filename.concat prefix old_key
in in
Printf.printf "Renaming %s -> %s\n" old_name new_name; Printf.printf "Renaming %s -> %s\n" old_name new_name;
try Sys.rename old_name new_name with try Sys.rename old_name new_name with
| Sys_error _ -> (); | Sys_error _ -> ();
let old_name = let old_name =
String.concat ~sep:"/" [ ezfio_filename; "input"; old_key ] String.concat "/" [ ezfio_filename; "input"; old_key ]
in in
Printf.printf "Removing %s\n%!" old_name; Printf.printf "Removing %s\n%!" old_name;
try Sys.remove old_name with try Sys.unlink old_name with
| Sys_error _ -> (); | Sys_error _ -> ();
end end
in in
let l = Sys.readdir input_directory
Sys.ls_dir input_directory |> Array.iter (fun x -> update_one x) ;
in
List.iter l ~f:(fun x -> update_one x) ;
Printf.printf "Done\n%!" ; Printf.printf "Done\n%!" ;
end end
; ;
@ -76,8 +76,8 @@ let run ?c ?d ~l ~update ezfio_filename =
match l with match l with
| false -> () | false -> ()
| true -> | true ->
Sys.ls_dir input_directory Sys.readdir input_directory
|> List.iter ~f:(fun md5 -> |> Array.iter (fun md5 ->
let filename = let filename =
Filename.concat input_directory md5 Filename.concat input_directory md5
in in
@ -102,13 +102,12 @@ let run ?c ?d ~l ~update ezfio_filename =
| Some other_key -> | Some other_key ->
if (key_is_valid other_key) then if (key_is_valid other_key) then
let command = let command =
String.concat ~sep:" " String.concat " "
[ "diff" ; "-u" ; "-w" ; [ "diff" ; "-u" ; "-w" ;
(filename_of_key current_md5) ; (filename_of_key current_md5) ;
(filename_of_key other_key) ] (filename_of_key other_key) ]
in in
match (Unix.system command) with ignore @@ Unix.system command
| _ -> ()
else else
failwith ("Error: " ^ other_key ^ " does not exist") failwith ("Error: " ^ other_key ^ " does not exist")
in in
@ -122,30 +121,39 @@ let run ?c ?d ~l ~update ezfio_filename =
| _ -> handle_options () | _ -> handle_options ()
let spec = let () =
let open Command.Spec in let open Command_line in
empty begin
+> flag "c" (optional string) set_header_doc (Sys.argv.(0) ^ " - QMC=Chem command");
~doc:("<key> Change to input to <key>") set_description_doc "Manipulate input MD5 keys";
+> flag "d" (optional string)
~doc:("<key> Show input differences with <key>")
+> flag "l" no_arg
~doc:(" List all the saved MD5 keys.")
+> flag "update" no_arg
~doc:(" Update to the latest MD5 format.")
+> anon ("ezfio_file" %: string)
[ { short='c' ; long="clear" ; opt=Optional ;
doc="Change to input to <key>" ;
arg=With_arg "<string>" ; };
{ short='d' ; long="diff" ; opt=Optional ;
doc="Show input differences with <key>" ;
arg=With_arg "<string>" ; };
let command = { short='l' ; long="list" ; opt=Optional ;
Command.basic_spec doc="List all the saved MD5 keys." ;
~summary: "Manipulate input MD5 keys" arg=Without_arg ; };
~readme:(fun () ->
" { short='u' ; long="update" ; opt=Optional ;
Manipulate input MD5 keys doc="Update to the latest MD5 format." ;
") arg=Without_arg ; };
spec
(fun c d l update ezfio_file () -> run ?c ?d ~l ~update ezfio_file ) anonymous "EZFIO_DIR" Mandatory "EZFIO directory";
]
|> set_specs
end;
let update = Command_line.get_bool "update" in
let c = Command_line.get "clear" in
let d = Command_line.get "diff" in
let l = Command_line.get_bool "list" in
run ?c ?d ~l ~update ezfio_file

139
ocaml/Qmcchem_result.ml
View File

@ -1,4 +1,3 @@
open Core
open Qptypes open Qptypes
(** Display a table that can be plotted by gnuplot *) (** Display a table that can be plotted by gnuplot *)
@ -12,19 +11,17 @@ let display_table ~range property =
and data = p.Random_variable.data and data = p.Random_variable.data
in in
let results = let results =
List.map2_exn conv rconv ~f:(fun (val1, err1) (val2,err2) -> (val1, err1, val2, err2)) List.map2 (fun (val1, err1) (val2,err2) -> (val1, err1, val2, err2)) conv rconv
in in
List.iter2_exn results data ~f:(fun (val1, err1, val2, err2) block -> List.iter2 (fun (val1, err1, val2, err2) block ->
Printf.printf "%10.6f %10.6f %10.6f %10.6f %10.6f\n" Printf.printf "%10.6f %10.6f %10.6f %10.6f %10.6f\n"
val1 err1 val2 err2 (Sample.to_float block.Block.value) val1 err1 val2 err2 (Sample.to_float block.Block.value)
) ) results data
;;
(** Display a convergence plot of the requested property *) (** Display a convergence plot of the requested property *)
let display_plot ~range property = let display_plot ~range property =
print_string ("display_plot "^property^".\n") print_string ("display_plot "^property^".\n")
;;
(** Display a convergence table of the error *) (** Display a convergence table of the error *)
@ -51,7 +48,7 @@ let display_err_convergence ~range property =
| (ave, None) -> () | (ave, None) -> ()
in in
aux 1 p aux 1 p
;;
(** Display the centered cumulants of a property *) (** Display the centered cumulants of a property *)
let display_cumulants ~range property = let display_cumulants ~range property =
@ -71,7 +68,7 @@ let display_cumulants ~range property =
1. /. 48. *. cum.(3) *. cum.(3) 1. /. 48. *. cum.(3) *. cum.(3)
in in
Printf.printf "Non-gaussianity = %16.10f\n" n Printf.printf "Non-gaussianity = %16.10f\n" n
;;
(** Display a table for the autocovariance of the property *) (** Display a table for the autocovariance of the property *)
@ -81,9 +78,9 @@ let display_autocovariance ~range property =
|> Random_variable.of_raw_data ~range |> Random_variable.of_raw_data ~range
in in
Random_variable.autocovariance p Random_variable.autocovariance p
|> List.iteri ~f:(fun i x -> |> List.iteri (fun i x ->
Printf.printf "%10d %16.10f\n" i x) Printf.printf "%10d %16.10f\n" i x)
;;
(** Display a histogram of the property *) (** Display a histogram of the property *)
let display_histogram ~range property = let display_histogram ~range property =
@ -104,8 +101,8 @@ let display_histogram ~range property =
let g = let g =
Random_variable.GaussianDist.eval ~g Random_variable.GaussianDist.eval ~g
in in
List.iter histo ~f:( fun (x,y) -> List.iter ( fun (x,y) ->
Printf.printf "%16.10f %16.10f %16.10f\n" x y (g ~x)) Printf.printf "%16.10f %16.10f %16.10f\n" x y (g ~x)) histo
(* (*
and sigma2 = and sigma2 =
(Random_variable.centered_cumulants p).(1) (Random_variable.centered_cumulants p).(1)
@ -128,7 +125,7 @@ let display_histogram ~range property =
|> List.iter ~f:(fun (x,y,g) -> |> List.iter ~f:(fun (x,y,g) ->
Printf.printf "%16.10f %16.10f %16.10f\n" x y g) Printf.printf "%16.10f %16.10f %16.10f\n" x y g)
*) *)
;;
@ -144,7 +141,7 @@ let display_summary ~range =
(Property.to_string property) (Property.to_string property)
(Random_variable.to_string p) (Random_variable.to_string p)
in in
List.iter properties ~f:print_property ; List.iter print_property properties ;
let cpu = let cpu =
@ -159,8 +156,8 @@ let display_summary ~range =
let speedup = let speedup =
cpu /. wall cpu /. wall
in in
Printf.printf "%20s : %10.2f x\n" "Speedup" speedup; Printf.printf "%20s : %10.2f x\n" "Speedup" speedup
;;
let run ?a ?c ?e ?h ?t ?p ?rmin ?rmax ezfio_file = let run ?a ?c ?e ?h ?t ?p ?rmin ?rmax ezfio_file =
@ -170,15 +167,15 @@ let run ?a ?c ?e ?h ?t ?p ?rmin ?rmax ezfio_file =
let rmin = let rmin =
match rmin with match rmin with
| None -> 0. | None -> 0.
| Some x when (x<0) -> failwith "rmin should be >= 0" | Some x when (float_of_string x < 0.) -> failwith "rmin should be >= 0"
| Some x when (x>100) -> failwith "rmin should be <= 100" | Some x when (float_of_string x > 100.) -> failwith "rmin should be <= 100"
| Some x -> Float.of_int x | Some x -> float_of_string x
and rmax = and rmax =
match rmax with match rmax with
| None -> 100. | None -> 100.
| Some x when (x<0) -> failwith "rmax should be >= 0" | Some x when (float_of_string x < 0.) -> failwith "rmax should be >= 0"
| Some x when (x>100) -> failwith "rmax should be <= 100" | Some x when (float_of_string x > 100.) -> failwith "rmax should be <= 100"
| Some x -> Float.of_int x | Some x -> float_of_string x
in in
let range = let range =
(rmin, rmax) (rmin, rmax)
@ -194,54 +191,80 @@ let run ?a ?c ?e ?h ?t ?p ?rmin ?rmax ezfio_file =
] ]
in in
let f (x,func) = List.iter (fun (x,func) ->
match x with match x with
| Some property -> func ~range property | Some property -> func ~range property
| None -> () | None -> ()
in ) l;
List.iter ~f l if (List.fold_left (fun accu x ->
;
if (List.fold ~init:true ~f:(fun accu x ->
match x with match x with
| (None, _) -> accu && true | (None, _) -> accu && true
| (Some _,_) -> false | (Some _,_) -> false
) l ) true l
) then ) then
display_summary ~range display_summary ~range
;;
let spec = let () =
let open Command.Spec in let open Command_line in
empty begin
+> flag "a" (optional string) set_header_doc (Sys.argv.(0) ^ " - QMC=Chem command");
~doc:"property Display the autcovariance function of the property" set_description_doc "Displays the results computed in an EZFIO directory.";
+> 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 "rmin" (optional int)
~doc:"int Lower bound of the percentage of the total weight to consider (default 0)"
+> flag "rmax" (optional int)
~doc:"int Upper bound of the percentage of the total weight to consider (default 100)"
+> flag "t" (optional string)
~doc:"property Print a table for the convergence of a property"
+> anon ("ezfio_file" %: string)
;;
let command = [ { short='a' ; long="autocovariance" ; opt=Optional ;
Command.basic_spec doc="Display the autcovariance function of the property";
~summary: "Displays the results computed in an EZFIO directory." arg=With_arg "<string>" ; };
~readme:(fun () -> "Displays the results computed in an EZFIO directory.")
spec { short='c' ; long="centered-cumulants" ; opt=Optional ;
(fun a c e h p rmin rmax t ezfio_file () -> run ?a ?c ?e ?h ?t ?p ?rmin ?rmax ezfio_file ) doc="Print the centered cumulants of a property" ;
;; arg=With_arg "<string>"; };
{ short='e' ; long="error" ; opt=Optional ;
doc="Display the convergence of the error of the property by merging blocks";
arg=With_arg "<string>"; };
{ short='h' ; long="histogram" ; opt=Optional ;
doc="Display the histogram of the property blocks" ;
arg=With_arg "<string>"; };
{ short='p' ; long="plot" ; opt=Optional ;
doc="Display a convergence plot for a property";
arg=With_arg "<string>"; };
{ short='m' ; long="rmin" ; opt=Optional ;
doc="Lower bound of the percentage of the total weight to consider (default 0)" ;
arg=With_arg "<int>"; };
{ short='n' ; long="rmax" ; opt=Optional ;
doc="Upper bound of the percentage of the total weight to consider (default 100)" ;
arg=With_arg "<int>"; };
{ short='t' ; long="table" ; opt=Optional ;
doc="Print a table for the convergence of a property" ;
arg=With_arg "<string>"; };
anonymous "EZFIO_DIR" Mandatory "EZFIO directory";
]
|> set_specs ;
end;
let a = Command_line.get "autocovariance" in
let c = Command_line.get "centered-cumulants" in
let e = Command_line.get "error" in
let h = Command_line.get "histogram" in
let t = Command_line.get "table" in
let p = Command_line.get "plot" in
let rmin = Command_line.get "m" in
let rmax = Command_line.get "n" in
let ezfio_file =
match Command_line.anon_args () with
| ezfio_file :: [] -> ezfio_file
| _ -> (Command_line.help () ; failwith "Inconsistent command line")
in
run ?a ?c ?e ?h ?t ?p ?rmin ?rmax ezfio_file

2
ocaml/Qmcchem_stop.ml
View File

@ -1,5 +1,3 @@
open Core
let run ezfio_filename = let run ezfio_filename =
Qputils.set_ezfio_filename ezfio_filename; Qputils.set_ezfio_filename ezfio_filename;

4
ocaml/qptypes_generator.ml
View File

@ -344,12 +344,14 @@ match msg with " ] @
) @ [" | x -> failwith (x^\" : Unknown EZFIO function\")\n;;"] ) @ [" | x -> failwith (x^\" : Unknown EZFIO function\")\n;;"]
in in
String.concat "\n" result String.concat "\n" result
|> print_endline
(** Main *) (** Main *)
let () = let () =
parse_input input_data ; parse_input input_data ;
parse_input_ezfio input_ezfio; parse_input_ezfio input_ezfio;
print_endline untouched print_endline untouched;
create_ezfio_handler ()