10
1
mirror of https://gitlab.com/scemama/qmcchem.git synced 2024-12-14 00:13:31 +01:00

Removed core

This commit is contained in:
Anthony Scemama 2019-07-14 18:50:44 +02:00
parent 5befb6dfe9
commit 16acf1fe89
23 changed files with 1162 additions and 556 deletions

View File

@ -1,3 +1,3 @@
PKG core cryptokit str zmq
PKG cryptokit str zmq
S .

View File

@ -1,4 +1,3 @@
open Core
open Qptypes
type t =
@ -6,7 +5,7 @@ type t =
value : Sample.t ;
weight : Weight.t ;
compute_node : Compute_node.t ;
pid : Pid.t ;
pid : int ;
block_id : Block_id.t ;
}
@ -23,17 +22,17 @@ let of_string s =
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) ;
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) ;
pid = int_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
|> Array.map float_of_string
in
let dim =
Array.length v
@ -41,10 +40,10 @@ let of_string s =
Some
{ property = Property.of_string p ;
value = Sample.of_float_array ~dim v ;
weight = Weight.of_float (Float.of_string w) ;
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) ;
pid = int_of_string pid;
block_id = Block_id.of_int (int_of_string b) ;
}
| _ -> None
with
@ -55,10 +54,10 @@ let of_string s =
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)
(Weight.to_float b.weight |> string_of_float)
(Property.to_string b.property)
(Compute_node.to_string b.compute_node)
(Pid.to_string b.pid)
(string_of_int b.pid)
(Block_id.to_int b.block_id)
@ -70,8 +69,8 @@ let dir_name = lazy(
let md5 =
QmcMd5.hash ()
in
List.fold_right ~init:"" ~f:Filename.concat
[ ezfio_filename ; "blocks" ; md5 ; Filename.dir_sep ]
List.fold_right Filename.concat
[ ezfio_filename ; "blocks" ; md5 ; Filename.dir_sep ] ""
)
@ -87,29 +86,31 @@ let update_raw_data ?(locked=true) () =
in
let files =
let result =
match Sys.is_directory dir_name with
| `Yes ->
if Sys.is_directory dir_name then
begin
Sys.readdir dir_name
|> Array.map ~f:(fun x -> dir_name^x)
|> Array.map (fun x -> dir_name^x)
|> Array.to_list
end
| _ -> []
else []
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
)
List.filter (fun x ->
try
let _ =
Str.search_backward (Str.regexp "locked") x ((String.length x) - 1)
in false
with
| Not_found -> true
) result
in
let rec transform new_list = function
| [] -> new_list
| head :: tail ->
let head = String.strip head in
let head = String.trim head in
let item = of_string head in
match item with
| None -> transform new_list tail
@ -117,14 +118,19 @@ let update_raw_data ?(locked=true) () =
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 []
let rec aux ic accu =
try
aux ic ( (input_line ic)::accu )
with
| End_of_file -> List.rev accu
in
List.map (fun filename ->
let ic = open_in filename in
let result = aux ic [] in
close_in ic;
result ) files
|> List.concat
|> transform []
in
result
@ -141,10 +147,11 @@ let raw_data ?(locked=true) () =
module StringSet = Set.Make(String)
let properties = lazy (
let set = Set.Poly.empty in
List.fold (raw_data ()) ~init:set ~f:(fun s x -> Set.add s x.property)
|> Set.to_list
List.fold_left (fun s x -> StringSet.add (Property.to_string x.property) s) StringSet.empty (raw_data ())
|> StringSet.elements
)

199
ocaml/Command_line.ml Normal file
View File

@ -0,0 +1,199 @@
type short_opt = char
type long_opt = string
type optional = Mandatory | Optional
type documentation = string
type argument = With_arg of string | Without_arg | With_opt_arg of string
type description = {
short: short_opt ;
long : long_opt ;
opt : optional ;
doc : documentation ;
arg : argument ;
}
let anon_args = ref []
and header_doc = ref ""
and description_doc = ref ""
and footer_doc = ref ""
and specs = ref []
let set_header_doc s = header_doc := s
let set_description_doc s = description_doc := s
let set_footer_doc s = footer_doc := s
(* Hash table containing all the options *)
let dict = Hashtbl.create 67
let get_bool x = Hashtbl.mem dict x
let show_help () = get_bool "help"
let get x =
try Some (Hashtbl.find dict x)
with Not_found -> None
let anonymous name opt doc =
{ short=' ' ; long=name; opt; doc; arg=Without_arg; }
let output_text t =
Format.printf "@[<v 0>";
begin
match Str.split (Str.regexp "\n") t with
| x :: [] -> Format.printf "@[<hov 0>";
Str.split (Str.regexp " ") x
|> List.iter (fun y -> Format.printf "@[%s@]@ " y) ;
Format.printf "@]"
| t -> List.iter (fun x ->
Format.printf "@[<hov 0>";
Str.split (Str.regexp " ") x
|> List.iter (fun y -> Format.printf "@[%s@]@ " y) ;
Format.printf "@]@;") t
end;
Format.printf "@]"
;;
let output_short x =
match x.short, x.opt, x.arg with
| ' ', Mandatory, _ -> Format.printf "@[%s@]" x.long
| ' ', Optional , _ -> Format.printf "@[[%s]@]" x.long
| _ , Mandatory, Without_arg -> Format.printf "@[-%c@]" x.short
| _ , Optional , Without_arg -> Format.printf "@[[-%c]@]" x.short
| _ , Mandatory, With_arg arg -> Format.printf "@[-%c %s@]" x.short arg
| _ , Optional , With_arg arg -> Format.printf "@[[-%c %s]@]" x.short arg
| _ , Mandatory, With_opt_arg arg -> Format.printf "@[-%c [%s]@]" x.short arg
| _ , Optional , With_opt_arg arg -> Format.printf "@[[-%c [%s]]@]" x.short arg
let output_long max_width x =
let arg =
match x.short, x.arg with
| ' ' , _ -> x.long
| _ , Without_arg -> x.long
| _ , With_arg arg -> Printf.sprintf "%s=%s" x.long arg
| _ , With_opt_arg arg -> Printf.sprintf "%s[=%s]" x.long arg
in
let long =
let l = String.length arg in
arg^(String.make (max_width-l) ' ')
in
Format.printf "@[<v 0>";
begin
match x.short with
| ' ' -> Format.printf "@[%s @]" long
| short -> Format.printf "@[-%c --%s @]" short long
end;
Format.printf "@]";
output_text x.doc
let help () =
(* Print the header *)
output_text !header_doc;
Format.printf "@.@.";
(* Find the anonymous arguments *)
let anon =
List.filter (fun x -> x.short = ' ') !specs
in
(* Find the options *)
let options =
List.filter (fun x -> x.short <> ' ') !specs
|> List.sort (fun x y -> Char.compare x.short y.short)
in
(* Find column lengths *)
let max_width =
List.map (fun x ->
( match x.arg with
| Without_arg -> String.length x.long
| With_arg arg -> String.length x.long + String.length arg
| With_opt_arg arg -> String.length x.long + String.length arg + 2
)
+ ( if x.opt = Optional then 2 else 0)
) !specs
|> List.fold_left max 0
in
(* Print usage *)
Format.printf "@[<v>@[<v 2>Usage:@,@,@[<hov 4>@[%s@]" Sys.argv.(0);
List.iter (fun x -> Format.printf "@ "; output_short x) options;
Format.printf "@ @[[--]@]";
List.iter (fun x -> Format.printf "@ "; output_short x;) anon;
Format.printf "@]@,@]@,";
(* Print arguments and doc *)
Format.printf "@[<v 2>Arguments:@,";
Format.printf "@[<v 0>" ;
List.iter (fun x -> Format.printf "@ "; output_long max_width x) anon;
Format.printf "@]@,@]@,";
(* Print options and doc *)
Format.printf "@[<v 2>Options:@,";
Format.printf "@[<v 0>" ;
List.iter (fun x -> Format.printf "@ "; output_long max_width x) options;
Format.printf "@]@,@]@,";
(* Print footer *)
if !description_doc <> "" then
begin
Format.printf "@[<v 2>Description:@,@,";
output_text !description_doc;
Format.printf "@,"
end;
(* Print footer *)
output_text !footer_doc;
Format.printf "@."
let set_specs specs_in =
specs := { short='h' ;
long ="help" ;
doc ="Prints the help message." ;
arg =Without_arg ;
opt =Optional ;
} :: specs_in;
let cmd_specs =
List.filter (fun x -> x.short != ' ') !specs
|> List.map (fun { short ; long ; opt ; doc ; arg } ->
match arg with
| With_arg _ ->
(short, long, None, Some (fun x -> Hashtbl.replace dict long x) )
| Without_arg ->
(short, long, Some (fun () -> Hashtbl.replace dict long ""), None)
| With_opt_arg _ ->
(short, long, Some (fun () -> Hashtbl.replace dict long ""),
Some (fun x -> Hashtbl.replace dict long x) )
)
in
Getopt.parse_cmdline cmd_specs (fun x -> anon_args := !anon_args @ [x]);
if show_help () then
(help () ; exit 0);
(* Check that all mandatory arguments are set *)
List.filter (fun x -> x.short <> ' ' && x.opt = Mandatory) !specs
|> List.iter (fun x ->
match get x.long with
| Some _ -> ()
| None -> failwith ("Error: --"^x.long^" option is missing.")
)
;;
let anon_args () = !anon_args

126
ocaml/Command_line.mli Normal file
View File

@ -0,0 +1,126 @@
(** Handles command-line arguments, using getopt.
Example:
let () =
(* Command-line specs *)
let open Command_line in
begin
set_header_doc (Sys.argv.(0) ^ " - quantum_package command");
set_description_doc
"Opens a text editor to edit the parameters of an EZFIO directory.";
[ { short='c'; long="check"; opt=Optional;
doc="Checks the input data";
arg=Without_arg; };
{ short='n'; long="ndet"; opt=Optional;
doc="Truncate the wavefunction to the target number of determinants";
arg=With_arg "<int>"; };
{ short='s'; long="state"; opt=Optional;
doc="Extract selected states, for example \"[1,3-5]\"";
arg=With_arg "<range>"; };
anonymous "EZFIO_DIR" Mandatory "EZFIO directory";
]
|> set_specs ;
end;
(* Handle options *)
let ndet =
match Command_line.get "ndet" with
| None -> None
| Some s -> (try Some (int_of_string s)
with _ -> failwith "[-n|--ndet] expects an integer")
in
let state =
match Command_line.get "state" with
| None -> None
| Some s -> (try Some (Range.of_string s)
with _ -> failwith "[-s|--state] expects a range")
in
let c = Command_line.get_bool "check" in
let filename =
match Command_line.anon_args () with
| [x] -> x
| _ -> (Command_line.help () ; failwith "EZFIO_DIR is missing")
in
(* Run the program *)
run c ?ndet ?state filename
*)
type short_opt = char
type long_opt = string
type optional = Mandatory
| Optional
type documentation = string
type argument = With_arg of string
| Without_arg
| With_opt_arg of string
type description =
{
short : short_opt;
long : long_opt;
opt : optional;
doc : documentation;
arg : argument;
}
(** Sets the header of the help message. *)
val set_header_doc : string -> unit
(** Sets the description of the help message. *)
val set_description_doc : string -> unit
(** Sets the footer of the help message. *)
val set_footer_doc : string -> unit
(** Gets the value of an option. If the option is not set, returns [None]. If
the option is set, returns Some <string>. *)
val get : string -> string option
(** Gets the value of an option with no argument. If the option is set, returns [true]. *)
val get_bool : string -> bool
(** True if the '-h' or "--help" option was found. *)
val show_help : unit -> bool
(** Creates a specification of an anonymous argument. *)
val anonymous : long_opt -> optional -> documentation -> description
(** Prints the help message *)
val help : unit -> unit
(** Sets the specification list as a list of tuples:
( short option, long option, documentation, argument ) *)
val set_specs : description list -> unit
(** Returns the list of anonymous arguments *)
val anon_args : unit -> string list

View File

@ -1,6 +1,3 @@
open Core
let simulation_nucl_fitcusp_factor = lazy(
let default =
1.
@ -26,7 +23,7 @@ let simulation_time_step = lazy ( 0.15 )
let simulation_srmc_projection_time = lazy ( 1. )
let reset_defaults () =
List.iter ~f:(fun x -> Sys.remove ( (Lazy.force Qputils.ezfio_filename) ^ x))
List.iter (fun x -> Sys.remove ( (Lazy.force Qputils.ezfio_filename) ^ x))
[ "/electrons/elec_walk_num" ;
"/electrons/elec_walk_num_tot" ;
"/jastrow/jast_type" ;

View File

@ -1,4 +1,3 @@
open Core
open Qptypes
open Qputils
@ -38,13 +37,13 @@ end = struct
let to_string t =
to_bool t
|> Bool.to_string
|> string_of_bool
let of_string t =
try
String.lowercase t
|> Bool.of_string
String.lowercase_ascii t
|> bool_of_string
|> of_bool
with
| Invalid_argument msg -> failwith msg
@ -119,12 +118,12 @@ Fit is done for r < r_c(f) where r_c(f) = (1s orbital radius) x f. Value of f"
let to_string t =
to_float t
|> Float.to_string
|> string_of_float
let of_string t =
try
Float.of_string t
float_of_string t
|> of_float
with
| Invalid_argument msg -> failwith msg
@ -181,21 +180,21 @@ end = struct
let to_string t =
to_int t
|> Int.to_string
|> string_of_int
let of_string t =
Int.of_string t
int_of_string t
|> of_int
let to_float t =
to_int t
|> Float.of_int
|> float_of_int
let of_float t =
Int.of_float t
int_of_float t
|> of_int
@ -248,11 +247,11 @@ end = struct
let to_string t =
to_int t
|> Int.to_string
|> string_of_int
let of_string t =
Int.of_string t
int_of_string t
|> of_int
@ -305,11 +304,11 @@ end = struct
let to_string t =
to_int t
|> Int.to_string
|> string_of_int
let of_string t =
Int.of_string t
int_of_string t
|> of_int
@ -364,21 +363,21 @@ end = struct
let to_string t =
to_int t
|> Int.to_string
|> string_of_int
let of_string t =
Int.of_string t
int_of_string t
|> of_int
let to_float t =
to_int t
|> Float.of_int
|> float_of_int
let of_float t =
Int.of_float t
int_of_float t
|> of_int
end
@ -456,7 +455,7 @@ end = struct
let doc = "Sampling algorithm : [ Langevin | Brownian ]"
let of_string s =
match String.capitalize (String.strip s) with
match String.capitalize_ascii (String.trim s) with
| "Langevin" -> Langevin
| "Brownian" -> Brownian
| x -> failwith ("Sampling should be [ Brownian | Langevin ], not "^x^".")
@ -536,13 +535,13 @@ end = struct
let of_string x =
Float.of_string x
float_of_string x
|> of_float
let to_string x =
to_float x
|> Float.to_string
|> string_of_float
end
@ -593,13 +592,13 @@ end = struct
let of_string x =
Float.of_string x
float_of_string x
|> of_float
let to_string x =
to_float x
|> Float.to_string
|> string_of_float
end
@ -652,13 +651,13 @@ contribution to the norm less than t (au)"
let of_string x =
Float.of_string x
float_of_string x
|> of_float
let to_string x =
to_float x
|> Float.to_string
|> string_of_float
end
@ -708,13 +707,13 @@ end = struct
let of_string x =
Float.of_string x
float_of_string x
|> of_float
let to_string x =
to_float x
|> Float.to_string
|> string_of_float
end
@ -764,13 +763,13 @@ end = struct
let of_string x =
Float.of_string x
float_of_string x
|> of_float
let to_string x =
to_float x
|> Float.to_string
|> string_of_float
end
@ -789,7 +788,7 @@ end = struct
let doc = "Type of Jastrow factor [ None | Core | Simple ]"
let of_string s =
match String.capitalize (String.strip s) with
match String.capitalize (String.trim s) with
| "Core" -> Core
| "Simple" -> Simple
| "None" -> None
@ -841,31 +840,31 @@ end = struct
let read () =
List.map Property.all ~f:(fun x -> (x, Property.calc x))
List.map (fun x -> (x, Property.calc x)) Property.all
let write l =
List.iter l ~f:(fun (x,b) -> Property.set_calc x b)
List.iter (fun (x,b) -> Property.set_calc x b) l
let to_string l =
List.map l ~f:(fun (x,b) ->
List.map (fun (x,b) ->
let ch =
if b then "X" else " "
in
Printf.sprintf "(%s) %s" ch (Property.to_string x))
|> String.concat ~sep:"\n"
Printf.sprintf "(%s) %s" ch (Property.to_string x)) l
|> String.concat "\n"
let of_string s =
String.split s ~on:'\n'
|> List.map ~f:(fun x ->
String.split_on_char '\n' s
|> List.map (fun x ->
let (calc,prop) =
String.strip x
|> String.rsplit2_exn ~on:' '
String.trim x
|> String_ext.rsplit2_exn ~on:' '
in
let prop =
String.strip prop
String.trim prop
|> Property.of_string
and calc =
match calc with

View File

@ -1,5 +1,3 @@
open Core
type t =
| Srun
| MPI
@ -50,19 +48,21 @@ let create_nodefile () =
in
let h =
String.Table.create ~size:1000 ()
Hashtbl.create 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
)
String_ext.input_lines in_channel
|> List.map String.trim
|> List.iter ( fun host ->
let n =
match Hashtbl.find_opt h host with
| Some x -> x+1
| None -> 1
in
Hashtbl.replace h host n
);
match
Unix.close_process_in in_channel
@ -80,9 +80,8 @@ let create_nodefile () =
fun (node, n) ->
Printf.sprintf "%s %d\n" node n
in
Hashtbl.to_alist h
|> List.map ~f
|> String.concat
Hashtbl.fold (fun k v a -> (f (k,v)) :: a) h []
|> String.concat "\n"

58
ocaml/Makefile Normal file
View File

@ -0,0 +1,58 @@
.NOPARALLEL:
# Check if QMCCHEM_PATH is defined
ifndef QMCCHEM_PATH
$(info -------------------- Error --------------------)
$(info QMCCHEM_PATH undefined. Source the qmcchem.rc script)
$(info -----------------------------------------------)
$(error )
endif
LIBS=
PKGS=
OCAMLCFLAGS="-g"
OCAMLOPTFLAGS="opt -O3 -remove-unused-arguments -rounds 16 -inline 100 -inline-max-unroll 100"
OCAMLBUILD=ocamlbuild -j 0 -cflags $(OCAMLCFLAGS) -lflags $(OCAMLCFLAGS) -ocamlopt $(OCAMLOPTFLAGS)
MLLFILES=$(wildcard *.mll)
MLFILES=$(wildcard *.ml) ezfio.ml Qptypes.ml
MLIFILES=$(wildcard *.mli)
ALL_TESTS=$(patsubst %.ml,%.byte,$(wildcard test_*.ml))
ALL_EXE=$(patsubst %.ml,%.native,$(wildcard qp_*.ml)) qmcchem.native
.PHONY: default
default: $(ALL_EXE)
tests: $(ALL_TESTS)
%.inferred.mli: $(MLFILES)
$(OCAMLBUILD) $*.inferred.mli -use-ocamlfind $(PKGS)
mv _build/$*.inferred.mli .
%.byte: $(MLFILES) $(MLIFILES)
rm -f -- $*
$(OCAMLBUILD) $*.byte -use-ocamlfind $(PKGS)
ln -s $*.byte $*
%.native: $(MLFILES) $(MLIFILES)
rm -f -- $*
$(OCAMLBUILD) $*.native -use-ocamlfind $(PKGS)
ln -s $*.native $*
ezfio.ml: ${QMCCHEM_PATH}/EZFIO/Ocaml/ezfio.ml
cp ${QMCCHEM_PATH}/EZFIO/Ocaml/ezfio.ml .
qptypes_generator.byte: qptypes_generator.ml
$(OCAMLBUILD) qptypes_generator.byte -use-ocamlfind
Qptypes.ml: qptypes_generator.byte
./qptypes_generator.byte > Qptypes.ml
${QMCCHEM_PATH}/EZFIO/Ocaml/ezfio.ml:
${MAKE) -C ${QMCCHEM_PATH}/EZFIO/
clean:
rm -rf _build Qptypes.ml $(ALL_EXE) $(ALL_TESTS)

View File

@ -1,5 +1,3 @@
open Core
(** Directory containing the list of input files. The directory is created is inexistant. *)
let input_directory = lazy (
@ -12,9 +10,8 @@ let input_directory = lazy (
in
begin
match ( Sys.is_directory dirname ) with
| `No -> Unix.mkdir dirname
| _ -> ()
if not (Sys.is_directory dirname) then
Unix.mkdir dirname 0o777
end ;
dirname
@ -83,14 +80,17 @@ let files_to_track = [
(** Get an MD5 ke from the content of a file. *)
let hash_file filename =
match Sys.is_file filename with
| `Yes ->
if Sys.file_exists filename then
begin
In_channel.with_file filename ~f:(fun ic ->
let ic = open_in filename in
let result =
Cryptokit.hash_channel (Cryptokit.Hash.md5 ()) ic
|> Cryptokit.transform_string (Cryptokit.Hexa.encode ()) )
|> Cryptokit.transform_string (Cryptokit.Hexa.encode ())
in
close_in ic;
result
end
| _ -> ""
else ""
(** Cache containing the current value of the MD5 hash. *)
@ -111,9 +111,9 @@ let hash () =
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
|> List.map (fun x -> Printf.sprintf "%s/%s" ezfio_filename x)
|> List.map hash_file
|> String.concat ""
in
let new_md5 =

View File

@ -1,22 +1,18 @@
open Core
(** QMC=Chem installation directory *)
let root = lazy (
match ( Sys.getenv "QMCCHEM_PATH" ) with
| Some x -> x
| None -> failwith "QMCCHEM_PATH environment variable not set"
try Sys.getenv "QMCCHEM_PATH" with
| Not_found -> 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
try Sys.getenv "PATH" with
| Not_found -> failwith "PATH environment variable is not set"
in
String.split ~on:':' p
String.split_on_char ':' p
)
@ -30,9 +26,10 @@ let full_path exe =
let fp =
Filename.concat head exe
in
match (Sys.is_file fp) with
| `Yes -> Some fp
| _ -> in_path_rec tail
if Sys.file_exists fp then
Some fp
else
in_path_rec tail
end
in
Lazy.force path
@ -42,7 +39,7 @@ let full_path exe =
(* True if an executable is in the PATH *)
let in_path x =
match (full_path x) with
match full_path x with
| Some _ -> true
| None -> false
@ -51,13 +48,13 @@ 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
try
Sys.getenv "QMCCHEM_MPIRUN"
with
| Not_found -> "mpirun"
)
let qmcchem = lazy(
@ -69,9 +66,7 @@ and qmc = lazy(
and qmcchem_info = lazy(
Filename.concat (Lazy.force root) "bin/qmcchem_info"
)
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"
)
@ -87,28 +82,35 @@ let hostname = lazy (
)
external get_ipv4_address_for_interface : string -> string =
"get_ipv4_address_for_interface"
let ip_address = lazy (
match Sys.getenv "QMCCHEM_NIC" with
| None ->
let interface =
try Some (Sys.getenv "QMCCHEM_NIC")
with Not_found -> None
in
match interface with
| None ->
begin
try
Lazy.force hostname
|> Unix.Inet_addr.of_string_or_getbyname
|> Unix.Inet_addr.to_string
let host =
Lazy.force hostname
|> Unix.gethostbyname
in
Unix.string_of_inet_addr host.h_addr_list.(0);
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
let result = get_ipv4_address_for_interface interface in
if String.sub result 0 5 = "error" then
Printf.sprintf "Unable to use network interface %s" interface
|> failwith
else
result
)

View File

@ -1,5 +1,3 @@
open Core
let file_header filename = Printf.sprintf
"
+----------------------------------------------------------------+
@ -12,7 +10,7 @@ Editing file `%s`
let make_header s =
let l = String.length s in
"\n\n"^s^"\n"^(String.init l ~f:(fun _ -> '='))^"\n\n"
"\n\n"^s^"\n"^(String.init l (fun _ -> '='))^"\n\n"
type field =
@ -84,11 +82,11 @@ let create_temp_file ?temp_filename ezfio_filename fields =
| 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
)
let out_channel = open_out filename in
(file_header ezfio_filename) :: (List.map get fields)
|> String.concat "\n"
|> output_string out_channel
; close_out out_channel
; filename
@ -104,7 +102,7 @@ let write_input_in_ezfio ezfio_filename fields =
let input_filename =
create_temp_file ~temp_filename ezfio_filename fields
in
assert (Sys.file_exists_exn input_filename)
assert (Sys.file_exists input_filename)
(** Run the edit command *)
@ -133,19 +131,19 @@ let run ~c ?f ?t ?l ?m ?e ?et ?s ?ts ?w ?wt ?n ?j ?p ?input ezfio_filename =
in ();
in
handle_option Input.Ref_energy.(of_float , write) e;
handle_option Input.Trial_wf_energy.(of_float , write) et;
handle_option Input.Ref_energy.(of_string, write) e;
handle_option Input.Trial_wf_energy.(of_string, write) et;
handle_option Input.Jastrow_type.(of_string, write) j;
handle_option Input.Block_time.(of_int , write) l;
handle_option Input.Block_time.(of_string, write) l;
handle_option Input.Method.(of_string, write) m;
handle_option Input.Stop_time.(of_int , write) t;
handle_option Input.Stop_time.(of_string, write) t;
handle_option Input.Sampling.(of_string, write) s;
handle_option Input.Fitcusp_factor.(of_float , 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;
handle_option Input.SRMC_projection_time.(of_float , write) p;
handle_option Input.Fitcusp_factor.(of_string, write) f;
handle_option Input.Time_step.(of_string, write) ts;
handle_option Input.Walk_num.(of_string, write) w;
handle_option Input.Walk_num_tot.(of_string, write) wt;
handle_option Input.CI_threshold.(of_string, write) n;
handle_option Input.SRMC_projection_time.(of_string, write) p;
let fields =
@ -179,21 +177,24 @@ let run ~c ?f ?t ?l ?m ?e ?et ?s ?ts ?w ?wt ?n ?j ?p ?input ezfio_filename =
if (not !interactive) then
failwith "Input file not allowed with command line arguments"
else
begin
let rc =
Printf.sprintf "cp %s %s" filename temp_filename
|> Sys.command_exn ;
end
|> Sys.command
in
assert (rc = 0)
end
| None ->
begin
(* Open the temp file with external editor *)
let editor =
match Sys.getenv "EDITOR" with
| Some editor -> editor
| None -> "vi"
try Sys.getenv "EDITOR" with
| Not_found -> "vi"
in
Printf.sprintf "%s %s ; tput sgr0 2> /dev/null" editor temp_filename
|> Sys.command_exn
let rc =
Printf.sprintf "%s %s ; tput sgr0 2> /dev/null" editor temp_filename
|> Sys.command
in
assert (rc = 0)
end
in
@ -203,18 +204,20 @@ let run ~c ?f ?t ?l ?m ?e ?et ?s ?ts ?w ?wt ?n ?j ?p ?input ezfio_filename =
and re_prop =
Str.regexp "([ xX]) .*$"
and raw_data =
In_channel.with_file temp_filename ~f:In_channel.input_lines
let ic = open_in temp_filename in
let result = String_ext.input_lines ic in
close_in ic ; result
in
let data =
( List.filter raw_data ~f:(fun x -> Str.string_match re_data x 0)
|> List.map ~f:String.strip ) @
( List.filter (fun x -> Str.string_match re_data x 0) raw_data
|> List.map String.trim ) @
[
List.filter raw_data ~f:(fun x -> Str.string_match re_prop x 0)
|> List.map ~f:String.strip
|> String.concat ~sep:"\n" ]
List.filter (fun x -> Str.string_match re_prop x 0) raw_data
|> List.map String.trim
|> String.concat "\n" ]
in
let open Input in
List.iter2_exn data fields ~f:(fun s f ->
List.iter2 (fun s f ->
try
begin
match f with
@ -235,7 +238,7 @@ let run ~c ?f ?t ?l ?m ?e ?et ?s ?ts ?w ?wt ?n ?j ?p ?input ezfio_filename =
end
with
| Failure msg -> Printf.eprintf "%s\n" msg
);
) data fields ;
(* Remove temp_file *)
Sys.remove temp_filename;
@ -244,27 +247,26 @@ let run ~c ?f ?t ?l ?m ?e ?et ?s ?ts ?w ?wt ?n ?j ?p ?input ezfio_filename =
;
if c then
begin
let dirname =
Filename.concat (Filename.concat ezfio_filename "blocks") (QmcMd5.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
| (_,_) -> ()
);
begin
let dirname =
Filename.concat (Filename.concat ezfio_filename "blocks") (QmcMd5.hash ())
in
let rec clean_dir y =
if Sys.is_directory y then
begin
Sys.readdir y
|> Array.map (fun x -> Filename.concat y x)
|> Array.iter (function x ->
if Sys.is_directory x then
clean_dir x
else
Sys.remove x
);
Unix.rmdir y
| `Unknown
| `No -> ()
in clean_dir dirname;
Printf.printf "Blocks cleared\n"
end
end
in clean_dir dirname;
Printf.printf "Blocks cleared\n"
end
;
Input.validate ();
@ -272,51 +274,96 @@ let run ~c ?f ?t ?l ?m ?e ?et ?s ?ts ?w ?wt ?n ?j ?p ?input ezfio_filename =
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 float)
~doc:("float "^Input.Fitcusp_factor.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 "et" (optional float)
~doc:("energy "^Input.Trial_wf_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)
+> flag "p" (optional float)
~doc:("projection_time "^Input.SRMC_projection_time.doc)
+> anon ("ezfio_file" %: string)
+> anon (maybe ("input" %: string))
;;
let () =
let open Command_line in
begin
set_header_doc (Sys.argv.(0) ^ " - QMC=Chem command");
set_description_doc "Edits input data";
let command =
Command.basic_spec
~summary: "Edit input data"
~readme:(fun () ->
"
Edit input data
")
spec
(fun c f t l m e et s ts w wt n j p ezfio_file input () ->
run ~c ?f ?t ?l ?m ?e ?et ?s ?ts ?w ?wt ?n ?j ?p ?input ezfio_file )
[ { short='c' ; long="clear" ; opt=Optional ;
doc="Clears blocks" ;
arg=Without_arg ; };
{ short='e' ; long="ref-energy" ; opt=Optional ;
doc=Input.Ref_energy.doc;
arg=With_arg "<float>"; };
{ short='f' ; long="fitcusp" ; opt=Optional ;
doc=Input.Fitcusp_factor.doc;
arg=With_arg "<float>"; };
{ short='i' ; long="time-step" ; opt=Optional ;
doc=Input.Time_step.doc;
arg=With_arg "<float>"; };
{ short='j' ; long="jastrow" ; opt=Optional ;
doc=Input.Jastrow_type.doc;
arg=With_arg "<string>"; };
{ short='l' ; long="block-time" ; opt=Optional ;
doc=Input.Block_time.doc;
arg=With_arg "<int>"; };
{ short='m' ; long="method" ; opt=Optional ;
doc=Input.Method.doc;
arg=With_arg "<string>"; };
{ short='n' ; long="norm" ; opt=Optional ;
doc=Input.CI_threshold.doc;
arg=With_arg "<float>"; };
{ short='p' ; long="projection-time" ; opt=Optional ;
doc=Input.SRMC_projection_time.doc;
arg=With_arg "<float>"; };
{ short='r' ; long="trial-energy" ; opt=Optional ;
doc=Input.Trial_wf_energy.doc;
arg=With_arg "<float>"; };
{ short='s' ; long="sampling" ; opt=Optional ;
doc=Input.Sampling.doc;
arg=With_arg "<string>"; };
{ short='t' ; long="stop-time" ; opt=Optional ;
doc=Input.Stop_time.doc;
arg=With_arg "<int>"; };
{ short='w' ; long="walk-num" ; opt=Optional ;
doc=Input.Walk_num.doc;
arg=With_arg "<int>"; };
{ short='x' ; long="walk-num-tot" ; opt=Optional ;
doc=Input.Walk_num_tot.doc;
arg=With_arg "<int>"; };
anonymous "EZFIO_DIR" Mandatory "EZFIO directory";
anonymous "FILE" Optional "Name of the input file";
]
|> set_specs ;
end;
let c = Command_line.get_bool "clear" in
let f = Command_line.get "fitcusp" in
let t = Command_line.get "stop-time" in
let l = Command_line.get "block-time" in
let m = Command_line.get "method" in
let e = Command_line.get "ref-energy" in
let et = Command_line.get "trial-energy" in
let s = Command_line.get "stop-time" in
let ts = Command_line.get "time-step" in
let w = Command_line.get "walk-num" in
let wt = Command_line.get "walk-num-tot" in
let n = Command_line.get "norm" in
let j = Command_line.get "jastrow" in