Fixing Ocaml

This commit is contained in:
Anthony Scemama 2019-07-23 17:27:02 +02:00
parent 5e25738f53
commit 380169d219
24 changed files with 121 additions and 225 deletions

View File

@ -28,7 +28,7 @@ rule compile_ocaml_dep
pool = console pool = console
rule compile_ocaml rule compile_ocaml
command = cd ocaml ; ninja $target command = cd ocaml ; make $target
description = Compiling OCaml tools description = Compiling OCaml tools
pool = console pool = console
@ -77,7 +77,7 @@ build ocaml/qmcchem : compile_ocaml | EZFIO/Ocaml/ezfio.ml ocaml/Property.ml
build bin/qmc: copy_to_bin src/MAIN/qmc build bin/qmc: copy_to_bin src/MAIN/qmc
build bin/qmcchem_info: copy_to_bin src/MAIN/qmcchem_info build bin/qmcchem_info: copy_to_bin src/MAIN/qmcchem_info
build bin/qmc_create_walkers: copy_to_bin src/MAIN/qmc_create_walkers build bin/qmc_create_walkers: copy_to_bin src/MAIN/qmc_create_walkers
build bin/qmcchem: copy_to_bin ocaml/qmcchem build bin/qmcchem: copy_to_bin ocaml/qmcchem
default bin/qmc bin/qmcchem_info bin/qmc_create_walkers bin/qmcchem default bin/qmc bin/qmcchem_info bin/qmc_create_walkers bin/qmcchem

View File

@ -8,12 +8,12 @@ ao_basis
ao_expo 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_basis
mo_tot_num integer mo_num integer
mo_coef real (ao_basis_ao_num,mo_basis_mo_tot_num) mo_coef real (ao_basis_ao_num,mo_basis_mo_num)
mo_classif character (mo_basis_mo_tot_num) mo_classif character (mo_basis_mo_num)
mo_energy real (mo_basis_mo_tot_num) mo_energy real (mo_basis_mo_num)
mo_occ real (mo_basis_mo_tot_num) mo_occ real (mo_basis_mo_num)
mo_symmetry character*(8) (mo_basis_mo_tot_num) mo_symmetry character*(8) (mo_basis_mo_num)
electrons electrons
elec_alpha_num integer elec_alpha_num integer

View File

@ -86,7 +86,7 @@ let update_raw_data ?(locked=true) () =
in in
let files = let files =
let result = let result =
if Sys.is_directory dir_name then if Sys.file_exists dir_name && Sys.is_directory dir_name then
begin begin
Sys.readdir dir_name Sys.readdir dir_name
|> Array.map (fun x -> dir_name^x) |> Array.map (fun x -> dir_name^x)

View File

@ -166,7 +166,7 @@ let help () =
let set_specs specs_in = let set_specs ?(no_help=false) specs_in =
specs := { short='h' ; specs := { short='h' ;
long ="help" ; long ="help" ;
doc ="Prints the help message." ; doc ="Prints the help message." ;
@ -188,11 +188,20 @@ let set_specs specs_in =
) )
in in
Getopt.parse_cmdline cmd_specs (fun x -> anon_args := !anon_args @ [x]); let cmdline =
Sys.argv
|> Array.to_list
|> List.filter (fun x -> x <> "")
|> Array.of_list
in
Getopt.parse cmd_specs (fun x -> anon_args := !anon_args @ [x])
cmdline 1 (Array.length cmdline -1);
if show_help () then
if not no_help && (show_help ()) then
(help () ; exit 0); (help () ; exit 0);
(* Check that all mandatory arguments are set *) (* Check that all mandatory arguments are set *)
List.filter (fun x -> x.short <> ' ' && x.opt = Mandatory) !specs List.filter (fun x -> x.short <> ' ' && x.opt = Mandatory) !specs
|> List.iter (fun x -> |> List.iter (fun x ->

View File

@ -117,7 +117,7 @@ val help : unit -> unit
(** Sets the specification list as a list of tuples: (** Sets the specification list as a list of tuples:
( short option, long option, documentation, argument ) *) ( short option, long option, documentation, argument ) *)
val set_specs : description list -> unit val set_specs : ?no_help:bool -> description list -> unit
(** Returns the list of anonymous arguments *) (** Returns the list of anonymous arguments *)

View File

@ -788,7 +788,7 @@ end = struct
let doc = "Type of Jastrow factor [ None | Core | Simple ]" let doc = "Type of Jastrow factor [ None | Core | Simple ]"
let of_string s = let of_string s =
match String.capitalize (String.trim s) with match String.capitalize_ascii (String.trim s) with
| "Core" -> Core | "Core" -> Core
| "Simple" -> Simple | "Simple" -> Simple
| "None" -> None | "None" -> None

View File

@ -24,7 +24,6 @@ ALL_EXE=$(patsubst %.ml,%.native,$(wildcard qp_*.ml)) qmcchem.native
default: $(ALL_EXE) default: $(ALL_EXE)
mv qmcchem.native $(QMCCHEM_PATH)/bin/qmcchem
tests: $(ALL_TESTS) tests: $(ALL_TESTS)

View File

@ -1,149 +0,0 @@
open Core
(** 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" ;
"electrons/elec_walk_num" ;
"jastrow/jast_type" ;
"mo_basis/mo_coef.gz" ;
"mo_basis/mo_tot_num" ;
"nuclei/nucl_charge.gz" ;
"nuclei/nucl_coord.gz" ;
"nuclei/nucl_num" ;
"simulation/ci_threshold" ;
"simulation/nucl_fitcusp_factor" ;
"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" ;
"simulation/dmc_projection_time" ;
"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 md5_string =
files_to_track
|> List.map ~f:(fun x -> Printf.sprintf "%s/%s" ezfio_filename x)
|> List.map ~f:hash_file
|> String.concat
in
let new_md5 =
md5_string
|> 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 ())

View File

@ -10,7 +10,7 @@ let input_directory = lazy (
in in
begin begin
if not (Sys.is_directory dirname) then if not (Sys.file_exists dirname && Sys.is_directory dirname) then
Unix.mkdir dirname 0o777 Unix.mkdir dirname 0o777
end ; end ;

View File

@ -36,13 +36,12 @@ let run ?(daemon=true) ezfio_filename =
Printf.printf "Generating initial walkers...\n%!"; Printf.printf "Generating initial walkers...\n%!";
match Unix.fork () with match Unix.fork () with
| 0 -> | 0 ->
Unix.execv Unix.execvp
(Lazy.force Qmcchem_config.qmc_create_walkers) (Lazy.force Qmcchem_config.qmc_create_walkers)
[|"qmc_create_walkers" ; ezfio_filename|] [|"qmc_create_walkers" ; ezfio_filename|]
| pid -> | pid ->
begin begin
let pid', status = Unix.waitpid [] pid in ignore @@ Unix.waitpid [] pid;
assert (status = Unix.WEXITED 0);
Printf.printf "Initial walkers ready\n%!" Printf.printf "Initial walkers ready\n%!"
end end
end end
@ -348,8 +347,8 @@ let run ?(daemon=true) ezfio_filename =
Lazy.force Block.dir_name Lazy.force Block.dir_name
in in
let () = let () =
if not (Sys.is_directory dirname) then if not ( Sys.file_exists dirname && Sys.is_directory dirname ) then
Unix.mkdir dirname 0o600 Unix.mkdir dirname 0o755
in in
Filename.concat dirname ( Filename.concat dirname (
hostname ^ "." ^ (string_of_int dataserver_pid) hostname ^ "." ^ (string_of_int dataserver_pid)

View File

@ -252,12 +252,12 @@ let run ~c ?f ?t ?l ?m ?e ?et ?s ?ts ?w ?wt ?n ?j ?p ?input ezfio_filename =
Filename.concat (Filename.concat ezfio_filename "blocks") (QmcMd5.hash ()) Filename.concat (Filename.concat ezfio_filename "blocks") (QmcMd5.hash ())
in in
let rec clean_dir y = let rec clean_dir y =
if Sys.is_directory y then if Sys.file_exists y && Sys.is_directory y then
begin begin
Sys.readdir y Sys.readdir y
|> Array.map (fun x -> Filename.concat y x) |> Array.map (fun x -> Filename.concat y x)
|> Array.iter (function x -> |> Array.iter (function x ->
if Sys.is_directory x then if Sys.file_exists x && Sys.is_directory x then
clean_dir x clean_dir x
else else
Sys.remove x Sys.remove x

View File

@ -48,7 +48,7 @@ let run ezfio_filename dataserver =
*) *)
let () = let () =
try try
Unix.mkdir tmpdir 0o600; Unix.mkdir tmpdir 0o755;
Unix.chdir tmpdir Unix.chdir tmpdir
with with
| Unix.Unix_error _ -> | Unix.Unix_error _ ->
@ -69,7 +69,7 @@ let run ezfio_filename dataserver =
| pid -> | pid ->
try try
Unix.kill pid 0 ; Unix.kill pid 0 ;
ignore @@ Unix.execv prog argv ignore @@ Unix.execvp prog argv
with with
| Unix.Unix_error (Unix.ESRCH, _, _) -> () | Unix.Unix_error (Unix.ESRCH, _, _) -> ()
end end

View File

@ -10,7 +10,7 @@ let run ezfio_filename =
[| qmcchem_info ; ezfio_filename |] [| qmcchem_info ; ezfio_filename |]
in in
ignore @@ ignore @@
Unix.execv prog argv Unix.execvp prog argv
let command () = let command () =
let open Command_line in let open Command_line in

View File

@ -224,7 +224,7 @@ let command () =
doc="Display the convergence of the error of the property by merging blocks"; doc="Display the convergence of the error of the property by merging blocks";
arg=With_arg "<string>"; }; arg=With_arg "<string>"; };
{ short='h' ; long="histogram" ; opt=Optional ; { short='i' ; long="histogram" ; opt=Optional ;
doc="Display the histogram of the property blocks" ; doc="Display the histogram of the property blocks" ;
arg=With_arg "<string>"; }; arg=With_arg "<string>"; };

View File

@ -48,7 +48,6 @@ let full_run ?(start_dataserver=true) ezfio_filename =
end; end;
(*
(* Check if the Zmq Rep socket is open *) (* Check if the Zmq Rep socket is open *)
let test_open_rep_socket () = let test_open_rep_socket () =
let zmq_context = let zmq_context =
@ -86,7 +85,7 @@ let full_run ?(start_dataserver=true) ezfio_filename =
| n -> | n ->
if (not (test_open_rep_socket ())) then if (not (test_open_rep_socket ())) then
begin begin
Unix.sleepf 0.5; Unix.sleep 2;
count (n-1); count (n-1);
end end
else else
@ -94,7 +93,6 @@ let full_run ?(start_dataserver=true) ezfio_filename =
in in
if (not (count 300)) then if (not (count 300)) then
Watchdog.kill (); Watchdog.kill ();
*)
Unix.sleep 3; Unix.sleep 3;

View File

@ -13,7 +13,7 @@ let set_ezfio_filename ezfio_filename =
failwith (ezfio_filename^" does not exist") failwith (ezfio_filename^" does not exist")
in in
let () = let () =
if Sys.is_directory ezfio_filename then if Sys.file_exists ezfio_filename && Sys.is_directory ezfio_filename then
Ezfio.set_file ezfio_filename Ezfio.set_file ezfio_filename
else else
failwith ("Error : "^ezfio_filename^" is not a directory") failwith ("Error : "^ezfio_filename^" is not a directory")
@ -34,13 +34,30 @@ let ezfio_filename = lazy (
match f with match f with
| "EZFIO_File" -> | "EZFIO_File" ->
begin begin
if (Array.length Sys.argv = 1) then let args =
Command_line.anon_args ()
|> Array.of_list
in
if (Array.length args < 1) then
failwith "Error : EZFIO directory not specified on the command line\n"; failwith "Error : EZFIO directory not specified on the command line\n";
Sys.argv.(1) args.(0)
end end
| f -> f | f -> f
in in
set_ezfio_filename full_path; set_ezfio_filename full_path;
(*
(* Check if input directory is present *)
let dirname = Filename.concat full_path "input" in
if not (Sys.file_exists dirname) then
Unix.mkdir dirname 0o755;
(* Check if blocks directory is present *)
let dirname = Filename.concat full_path "blocks" in
if not (Sys.file_exists dirname) then
Unix.mkdir dirname 0o755;
*)
!Ezfio.ezfio_filename !Ezfio.ezfio_filename
) )

View File

@ -686,7 +686,7 @@ let compress_files () =
Filename.concat "qmc" rand_num Filename.concat "qmc" rand_num
in in
try try
Unix.mkdir tmp_dir 0o600; Unix.mkdir tmp_dir 0o755;
tmp_dir tmp_dir
with _ -> raise (Sys_error "Cannot create temp dir") with _ -> raise (Sys_error "Cannot create temp dir")
in in

View File

@ -1,16 +1,16 @@
let _list = ref [] ;; let _list = ref []
let _running = ref false;; let _running = ref false
let _threads = ref [] ;; let _threads = ref []
(** Kill the current process and all children *) (** Kill the current process and all children *)
let kill () = let kill () =
let kill pid = let kill pid =
Unix.kill pid Sys.sigint; Unix.kill pid Sys.sigkill;
Printf.printf "Killed %d\n%!" pid Printf.printf "Killed %d\n%!" pid
in in
List.iter kill (!_list); List.iter kill (!_list);
exit 1 exit 1
;;
(** Start watchdog *) (** Start watchdog *)
@ -50,7 +50,7 @@ let start () =
in in
_threads := ( (Thread.create f) () ) :: (!_threads) _threads := ( (Thread.create f) () ) :: (!_threads)
end end
;;
(** Stop watchdog *) (** Stop watchdog *)
let stop () = let stop () =
@ -58,14 +58,14 @@ let stop () =
_running := false _running := false
else else
failwith "Watchdog error: Already stopped" failwith "Watchdog error: Already stopped"
;;
(** Add a PID to tracking *) (** Add a PID to tracking *)
let add pid = let add pid =
if (not !_running) then if (not !_running) then
start (); start ();
_list := pid :: (!_list) _list := pid :: (!_list)
;;
(** Remove a PID from tracking *) (** Remove a PID from tracking *)
let del pid = let del pid =
@ -82,14 +82,13 @@ let del pid =
match (!_list) with match (!_list) with
| [] -> if (!_running) then stop () | [] -> if (!_running) then stop ()
| _ -> () | _ -> ()
;;
(** Fork and exec a new process *) (** Fork and exec a new process *)
let fork_exec ~prog ~args () = let fork_exec ~prog ~args () =
let pid = let pid =
match Unix.fork () with match Unix.fork () with
| 0 -> (* Chile process *) | 0 -> Unix.execvp prog args
let _ = Unix.execv prog args in 0
| pid -> pid | pid -> pid
in in
@ -111,11 +110,11 @@ let fork_exec ~prog ~args () =
in in
_threads := ( (Thread.create f) () ) :: (!_threads); _threads := ( (Thread.create f) () ) :: (!_threads);
pid pid
;;
(** Wait for threads to finish *) (** Wait for threads to finish *)
let join () = let join () =
(* if (!_running) then stop (); *) (* if (!_running) then stop (); *)
List.iter Thread.join (!_threads); List.iter Thread.join (!_threads);
assert (not !_running) assert (not !_running)
;;

View File

@ -1,36 +1,60 @@
let update_command_line () = let update_command_line () =
let last = (Array.length Sys.argv) - 2 in let last = (Array.length Sys.argv) - 2 in
Sys.argv.(0) <- Sys.argv.(0) ^ " " ^ Sys.argv.(1); Sys.argv.(0) <- Sys.argv.(0) ^ "_" ^ Sys.argv.(1);
for i=1 to last do for i=1 to last do
Sys.argv.(i) <- Sys.argv.(i+1) Sys.argv.(i) <- Sys.argv.(i+1)
done; done;
Sys.argv.(last+1) <- "--" Sys.argv.(last+1) <- ""
let help () =
Printf.printf "
qmcchem - QMC=Chem command
Usage:
qmcchem [-h] COMMAND
Arguments:
COMMAND QMC=Chem command to run :
[run|edit|stop|result|md5|info|debug]
Options:
-h --help Prints the help message.
Description:
Driver for subcommands.
"
let () = let () =
let open Command_line in
begin
set_header_doc (Sys.argv.(0) ^ " - QMC=Chem command");
set_description_doc "Driver for subcommands.";
set_specs []
end;
if Array.length Sys.argv < 2 then if Array.length Sys.argv < 2 then
(Command_line.help (); failwith "Inconsistent command line"); (help (); failwith "Inconsistent command line") ;
let command = Sys.argv.(1) in match String.trim Sys.argv.(1) with
update_command_line (); | "-h" | "--help" ->
Command_line.reset (); begin
help () ;
match command with exit 0
| "debug" -> let open Qmcchem_debug in command () end
| "edit" -> let open Qmcchem_edit in command () | _ ->
| "info" -> let open Qmcchem_info in command () begin
| "md5" -> let open Qmcchem_md5 in command () let command =
| "result" -> let open Qmcchem_result in command () Sys.argv.(1)
| "run" -> let open Qmcchem_run in command () in
| "stop" -> let open Qmcchem_stop in command () update_command_line ();
| _ -> (Command_line.help () ; failwith "Inconsistent command line")
match command with
| "debug" -> let open Qmcchem_debug in command ()
| "edit" -> let open Qmcchem_edit in command ()
| "info" -> let open Qmcchem_info in command ()
| "md5" -> let open Qmcchem_md5 in command ()
| "result" -> let open Qmcchem_result in command ()
| "run" -> let open Qmcchem_run in command ()
| "stop" -> let open Qmcchem_stop in command ()
| _ -> (help () ; failwith "Inconsistent command line")
end

View File

@ -296,7 +296,7 @@ let input_lines filename =
let create_ezfio_handler () = let create_ezfio_handler () =
let lines = let lines =
input_lines "ezfio.ml" input_lines "ezfio.ml"
|> List.mapi (fun i l -> if i > 470 then Some l else None) |> List.mapi (fun i l -> if i > 474 then Some l else None)
|> List.filter (fun x -> x <> None) |> List.filter (fun x -> x <> None)
|> List.map (fun x -> |> List.map (fun x ->
match x with match x with

View File

@ -1,7 +1,7 @@
#!/bin/bash #!/bin/bash
# This script is supposed to run in $QMCCHEM_PATH # This script is supposed to run in $QMCCHEM_PATH
ninja -C ocaml clean make -C ocaml clean
if [[ -d src/IRPF90_temp ]] if [[ -d src/IRPF90_temp ]]
then then
ninja -C src/IRPF90_temp -t clean ninja -C src/IRPF90_temp -t clean

View File

@ -8,4 +8,4 @@ fi
cd ${QMCCHEM_PATH}/ocaml || exit -1 cd ${QMCCHEM_PATH}/ocaml || exit -1
exec ninja -f generated.ninja ${@} || exit -1 exec make

View File

@ -52,7 +52,7 @@ data = [ \
] ]
data_no_set = [\ data_no_set = [\
("mo_basis_mo_tot_num" , "integer" , ""), ("mo_basis_mo_num" , "integer" , ""),
("pseudo_ao_pseudo_grid" , "double precision" , "(ao_num,pseudo_lmax+pseudo_lmax+1,pseudo_lmax-0+1,nucl_num,pseudo_grid_size)"), ("pseudo_ao_pseudo_grid" , "double precision" , "(ao_num,pseudo_lmax+pseudo_lmax+1,pseudo_lmax-0+1,nucl_num,pseudo_grid_size)"),
("pseudo_mo_pseudo_grid" , "double precision" , "(ao_num,pseudo_lmax+pseudo_lmax+1,pseudo_lmax-0+1,nucl_num,pseudo_grid_size)"), ("pseudo_mo_pseudo_grid" , "double precision" , "(ao_num,pseudo_lmax+pseudo_lmax+1,pseudo_lmax-0+1,nucl_num,pseudo_grid_size)"),
("pseudo_pseudo_dz_k" , "double precision" , "(nucl_num,pseudo_klocmax)"), ("pseudo_pseudo_dz_k" , "double precision" , "(nucl_num,pseudo_klocmax)"),

View File

@ -410,7 +410,7 @@ BEGIN_PROVIDER [ integer, mo_tot_num ]
END_DOC END_DOC
mo_tot_num = -1 mo_tot_num = -1
call get_mo_basis_mo_tot_num(mo_tot_num) call get_mo_basis_mo_num(mo_tot_num)
if (mo_tot_num <= 0) then if (mo_tot_num <= 0) then
call abrt(irp_here,'Total number of MOs can''t be <0') call abrt(irp_here,'Total number of MOs can''t be <0')
endif endif