mirror of
https://gitlab.com/scemama/qmcchem.git
synced 2024-11-15 02:23:38 +01:00
316 lines
9.6 KiB
OCaml
316 lines
9.6 KiB
OCaml
open Core.Std
|
|
|
|
let file_header filename = Printf.sprintf
|
|
"
|
|
+----------------------------------------------------------------+
|
|
| QMC=Chem |
|
|
+----------------------------------------------------------------+
|
|
|
|
Editing file `%s`
|
|
|
|
" filename
|
|
|
|
let make_header s =
|
|
let l = String.length s in
|
|
"\n\n"^s^"\n"^(String.init l ~f:(fun _ -> '='))^"\n\n"
|
|
|
|
|
|
type field =
|
|
| Block_time
|
|
| Walk_num
|
|
| Walk_num_tot
|
|
| Stop_time
|
|
| Fitcusp_factor
|
|
| Method
|
|
| Sampling
|
|
| Ref_energy
|
|
| CI_threshold
|
|
| Time_step
|
|
| SRMC_projection_time
|
|
| Jastrow_type
|
|
| Properties
|
|
|
|
|
|
let get field =
|
|
let option_to_string read to_string doc =
|
|
let value =
|
|
read () |> to_string
|
|
in
|
|
Printf.sprintf "%s ::\n\n %s\n\n" doc value
|
|
in
|
|
let option_to_string_prop read to_string doc =
|
|
let value =
|
|
read () |> to_string
|
|
in
|
|
Printf.sprintf "%s :\n\n%s\n\n" doc value
|
|
in
|
|
let open Input in
|
|
match field with
|
|
| Block_time ->
|
|
option_to_string Block_time.read Block_time.to_string Block_time.doc
|
|
| Walk_num ->
|
|
option_to_string Walk_num.read Walk_num.to_string Walk_num.doc
|
|
| Walk_num_tot ->
|
|
option_to_string Walk_num_tot.read Walk_num_tot.to_string Walk_num_tot.doc
|
|
| Stop_time ->
|
|
option_to_string Stop_time.read Stop_time.to_string Stop_time.doc
|
|
| Fitcusp_factor ->
|
|
option_to_string Fitcusp_factor.read Fitcusp_factor.to_string Fitcusp_factor.doc
|
|
| Method ->
|
|
option_to_string Method.read Method.to_string Method.doc
|
|
| Sampling ->
|
|
option_to_string Sampling.read Sampling.to_string Sampling.doc
|
|
| Ref_energy ->
|
|
option_to_string Ref_energy.read Ref_energy.to_string Ref_energy.doc
|
|
| CI_threshold ->
|
|
option_to_string CI_threshold.read CI_threshold.to_string CI_threshold.doc
|
|
| Time_step ->
|
|
option_to_string Time_step.read Time_step.to_string Time_step.doc
|
|
| SRMC_projection_time ->
|
|
option_to_string SRMC_projection_time.read SRMC_projection_time.to_string SRMC_projection_time.doc
|
|
| Jastrow_type ->
|
|
option_to_string Jastrow_type.read Jastrow_type.to_string Jastrow_type.doc
|
|
| Properties ->
|
|
option_to_string_prop Properties.read Properties.to_string Properties.doc
|
|
|
|
|
|
|
|
let create_temp_file ?temp_filename ezfio_filename fields =
|
|
let filename =
|
|
match temp_filename with
|
|
| None -> Filename.temp_file "qmcchem_edit_" ".rst"
|
|
| Some name -> name
|
|
in
|
|
Out_channel.with_file filename ~f:(fun out_channel ->
|
|
(file_header ezfio_filename) :: (List.map ~f:get fields)
|
|
|> String.concat ~sep:"\n"
|
|
|> Out_channel.output_string out_channel
|
|
)
|
|
; filename
|
|
|
|
|
|
(** Write the input file corresponding to the MD5 key *)
|
|
let write_input_in_ezfio ezfio_filename fields =
|
|
let dirname =
|
|
Lazy.force Md5.input_directory
|
|
in
|
|
let temp_filename =
|
|
Md5.hash ()
|
|
|> Filename.concat dirname
|
|
in
|
|
let input_filename =
|
|
create_temp_file ~temp_filename ezfio_filename fields
|
|
in
|
|
assert (Sys.file_exists_exn input_filename)
|
|
|
|
|
|
(** Run the edit command *)
|
|
let run ~c ?f ?t ?l ?m ?e ?s ?ts ?w ?wt ?n ?j ?p ?input ezfio_filename =
|
|
|
|
let interactive = ref (
|
|
if c then
|
|
false
|
|
else
|
|
true
|
|
)
|
|
in
|
|
|
|
(* Open EZFIO *)
|
|
Qputils.set_ezfio_filename ezfio_filename;
|
|
|
|
let handle_option (type_conv, write) x =
|
|
let () =
|
|
match x with
|
|
| Some x ->
|
|
begin
|
|
type_conv x |> write;
|
|
interactive := false;
|
|
end
|
|
| None -> ()
|
|
in ();
|
|
in
|
|
|
|
handle_option Input.Ref_energy.(of_float , write) e;
|
|
handle_option Input.Jastrow_type.(of_string, write) j;
|
|
handle_option Input.Block_time.(of_int , write) l;
|
|
handle_option Input.Method.(of_string, write) m;
|
|
handle_option Input.Stop_time.(of_int , write) t;
|
|
handle_option Input.Sampling.(of_string, write) s;
|
|
handle_option Input.Fitcusp_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;
|
|
|
|
|
|
let fields =
|
|
[
|
|
Stop_time ;
|
|
Block_time ;
|
|
Method ;
|
|
Sampling ;
|
|
Time_step ;
|
|
SRMC_projection_time ;
|
|
Ref_energy ;
|
|
Walk_num ;
|
|
Walk_num_tot ;
|
|
Fitcusp_factor ;
|
|
CI_threshold ;
|
|
Jastrow_type ;
|
|
Properties ;
|
|
]
|
|
in
|
|
|
|
if (!interactive) then
|
|
begin
|
|
let temp_filename =
|
|
create_temp_file ezfio_filename fields
|
|
in
|
|
let () =
|
|
match input with
|
|
| Some filename ->
|
|
begin
|
|
if (not !interactive) then
|
|
failwith "Input file not allowed with command line arguments"
|
|
else
|
|
begin
|
|
Printf.sprintf "cp %s %s" filename temp_filename
|
|
|> Sys.command_exn ;
|
|
end
|
|
end
|
|
| None ->
|
|
begin
|
|
(* Open the temp file with external editor *)
|
|
let editor =
|
|
match Sys.getenv "EDITOR" with
|
|
| Some editor -> editor
|
|
| None -> "vi"
|
|
in
|
|
Printf.sprintf "%s %s ; tput sgr0 2> /dev/null" editor temp_filename
|
|
|> Sys.command_exn
|
|
end
|
|
in
|
|
|
|
(* Re-read the temp file *)
|
|
let re_data =
|
|
Str.regexp " .+ *$"
|
|
and re_prop =
|
|
Str.regexp "([ xX]) .*$"
|
|
and raw_data =
|
|
In_channel.with_file temp_filename ~f:In_channel.input_lines
|
|
in
|
|
let data =
|
|
( List.filter raw_data ~f:(fun x -> Str.string_match re_data x 0)
|
|
|> List.map ~f:String.strip ) @
|
|
[
|
|
List.filter raw_data ~f:(fun x -> Str.string_match re_prop x 0)
|
|
|> List.map ~f:String.strip
|
|
|> String.concat ~sep:"\n" ]
|
|
in
|
|
let open Input in
|
|
List.iter2_exn data fields ~f:(fun s f ->
|
|
try
|
|
begin
|
|
match f with
|
|
| Stop_time -> Stop_time.(of_string s |> write)
|
|
| Fitcusp_factor -> Fitcusp_factor.(of_string s |> write)
|
|
| Block_time -> Block_time.(of_string s |> write)
|
|
| Method -> Method.(of_string s |> write)
|
|
| Ref_energy -> Ref_energy.(of_string s |> write)
|
|
| Sampling -> Sampling.(of_string s |> write)
|
|
| Time_step -> Time_step.(of_string s |> write)
|
|
| SRMC_projection_time -> SRMC_projection_time.(of_string s |> write)
|
|
| Walk_num -> Walk_num.(of_string s |> write)
|
|
| Walk_num_tot -> Walk_num_tot.(of_string s |> write)
|
|
| CI_threshold -> CI_threshold.(of_string s |> write)
|
|
| Jastrow_type -> Jastrow_type.(of_string s |> write)
|
|
| Properties -> Properties.(of_string s |> write)
|
|
end
|
|
with
|
|
| Failure msg -> Printf.eprintf "%s\n" msg
|
|
);
|
|
|
|
(* Remove temp_file *)
|
|
Sys.remove temp_filename;
|
|
|
|
end
|
|
;
|
|
|
|
if c then
|
|
begin
|
|
let dirname =
|
|
Filename.concat (Filename.concat ezfio_filename "blocks") (Md5.hash ())
|
|
in
|
|
let rec clean_dir y =
|
|
match Sys.is_directory y with
|
|
| `Yes ->
|
|
Sys.ls_dir y
|
|
|> List.map ~f:(Filename.concat y)
|
|
|> List.iter ~f:(function x ->
|
|
match ( Sys.is_directory x, Sys.is_file x ) with
|
|
| (`Yes, _) -> clean_dir x
|
|
| (_, `Yes) -> Sys.remove x
|
|
| (_,_) -> ()
|
|
);
|
|
Unix.rmdir y
|
|
| `Unknown
|
|
| `No -> ()
|
|
in clean_dir dirname;
|
|
Printf.printf "Blocks cleared\n"
|
|
end
|
|
;
|
|
|
|
Input.validate ();
|
|
Md5.reset_hash ();
|
|
write_input_in_ezfio ezfio_filename fields
|
|
|
|
|
|
let spec =
|
|
let open Command.Spec in
|
|
empty
|
|
+> flag "c" no_arg
|
|
~doc:(" Clear blocks")
|
|
+> flag "f" (optional 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 "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 command =
|
|
Command.basic
|
|
~summary: "Edit input data"
|
|
~readme:(fun () ->
|
|
"
|
|
Edit input data
|
|
")
|
|
spec
|
|
(fun c f t l m e s ts w wt n j p ezfio_file input () ->
|
|
run ~c ?f ?t ?l ?m ?e ?s ?ts ?w ?wt ?n ?j ?p ?input ezfio_file )
|
|
|
|
|
|
|
|
|