Restored ocaml changes present in dev

ocaml/Command_line.ml

@@ -1,3 +1,5 @@
+exception Error of string
+
 type short_opt     = char
 type long_opt      = string 
 type optional      = Mandatory | Optional 
@@ -181,15 +183,16 @@ let set_specs specs_in =
     Getopt.parse_cmdline cmd_specs (fun x -> anon_args := !anon_args @ [x]);
 
     if show_help () then
-        (help () ; exit 0);
+        help ()
+    else
+        (* 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 -> raise (Error ("--"^x.long^" option is missing."))
+            )
 
-    (* 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.")
-        )
 ;;
 
 

ocaml/Command_line.mli

@@ -59,6 +59,8 @@ let () =
 *)
 
 
+exception Error of string
+
 type short_opt = char
 
 type long_opt = string

ocaml/Molecule.ml

@@ -101,7 +101,7 @@ let to_string_general ~f m =
   |> String.concat "\n"
 
 let to_string =
-  to_string_general ~f:(fun x -> Atom.to_string Units.Angstrom x)
+  to_string_general ~f:(fun x -> Atom.to_string ~units:Units.Angstrom x)
 
 let to_xyz =
   to_string_general ~f:Atom.to_xyz
@@ -113,7 +113,7 @@ let of_xyz_string
     s =
   let l = String_ext.split s ~on:'\n'
        |> List.filter (fun x -> x <> "")
-       |> list_map (fun x -> Atom.of_string units x)
+       |> list_map (fun x -> Atom.of_string ~units x)
   in
   let ne = ( get_charge {
         nuclei=l ;

ocaml/Qputils.ml

@@ -56,3 +56,7 @@ let string_of_string s = s
 let list_map f l =
   List.rev_map f l
   |> List.rev
+
+let socket_convert socket =
+    ((Obj.magic (Obj.repr socket)) : [ `Xsub ] Zmq.Socket.t )
+

ocaml/qp_create_ezfio.ml

@@ -677,12 +677,15 @@ let run ?o b au c d m p cart xyz_file =
 
 let () =
 
+  try (
 
   let open Command_line in
   begin
     "Creates an EZFIO directory from a standard xyz file or from a z-matrix file in Gaussian format.  The basis set is defined as a single string if all the atoms are taken from the same basis set, otherwise specific elements can be defined as follows:
+
     -b \"cc-pcvdz | H:cc-pvdz | C:6-31g\"
     -b \"cc-pvtz | 1,H:sto-3g | 3,H:6-31g\"
+
 If a file with the same name as the basis set exists, this file will be read.  Otherwise, the basis set is obtained from the database.
 "   |> set_description_doc ;
     set_header_doc (Sys.argv.(0) ^ " - Quantum Package command");
@@ -732,7 +735,7 @@ If a file with the same name as the basis set exists, this file will be read.  O
 
   let basis =
     match Command_line.get "basis" with
-    | None -> assert false
+    | None -> ""
     | Some x -> x
   in
 
@@ -771,10 +774,14 @@ If a file with the same name as the basis set exists, this file will be read.  O
 
   let xyz_filename =
     match Command_line.anon_args () with
-    | [x] -> x
-    | _ -> (Command_line.help () ; failwith "input file is missing")
+    | []  -> failwith "input file is missing"
+    | x::_ -> x
   in
 
   run ?o:output basis au charge dummy multiplicity pseudo cart xyz_filename
+  )
+  with
+  | Failure txt  -> Printf.eprintf "Fatal error: %s\n%!" txt
+  | Command_line.Error txt  -> Printf.eprintf "Command line error: %s\n%!" txt
 
 

ocaml/qp_tunnel.ml

@@ -131,37 +131,64 @@ let () =
   Sys.set_signal  Sys.sigint   handler;
 
 
-  let new_thread req_or_sub addr_in addr_out =
+  let new_thread_req addr_in addr_out =
     let socket_in, socket_out =
-      match req_or_sub with
-      | REQ ->
           create_socket  Zmq.Socket.router  Zmq.Socket.bind     addr_in,
           create_socket  Zmq.Socket.dealer  Zmq.Socket.connect  addr_out
-      | SUB ->
-          create_socket  Zmq.Socket.sub  Zmq.Socket.connect  addr_in,
-          create_socket  Zmq.Socket.pub  Zmq.Socket.bind     addr_out
     in
 
-    if req_or_sub = SUB then
-        Zmq.Socket.subscribe  socket_in  "";
 
-
-
-   let action_in = 
-      match req_or_sub with
-        | REQ -> (fun () -> Zmq.Socket.recv_all  socket_in  |> Zmq.Socket.send_all  socket_out)
-        | SUB -> (fun () -> Zmq.Socket.recv_all  socket_in  |> Zmq.Socket.send_all  socket_out)
+    let action_in =
+        fun () -> Zmq.Socket.recv_all  socket_in  |> Zmq.Socket.send_all  socket_out
     in
 
     let action_out =
-      match req_or_sub with
-        | REQ -> (fun () -> Zmq.Socket.recv_all  socket_out |> Zmq.Socket.send_all  socket_in )
-        | SUB -> (fun () -> () )
+        fun () -> Zmq.Socket.recv_all  socket_out |> Zmq.Socket.send_all  socket_in
     in
 
     let pollitem =
       Zmq.Poll.mask_of
-        [| (socket_in,  Zmq.Poll.In) ; (socket_out, Zmq.Poll.In) |]
+        [| (socket_convert socket_in,  Zmq.Poll.In) ; (socket_convert socket_out, Zmq.Poll.In) |]
+    in
+
+    while !run_status do
+
+        let polling =
+          Zmq.Poll.poll  ~timeout:1000  pollitem
+        in
+
+        match polling with
+          | [| Some Zmq.Poll.In ; Some Zmq.Poll.In |]     -> ( action_out () ; action_in () )
+          | [| _                ; Some Zmq.Poll.In |]     ->   action_out ()
+          | [| Some Zmq.Poll.In ; _                |]     ->   action_in  ()
+          | _                    -> ()
+    done;
+
+    Zmq.Socket.close  socket_in;
+    Zmq.Socket.close  socket_out;
+  in
+
+  let new_thread_sub addr_in addr_out =
+    let socket_in, socket_out =
+          create_socket  Zmq.Socket.sub  Zmq.Socket.connect  addr_in,
+          create_socket  Zmq.Socket.pub  Zmq.Socket.bind     addr_out
+    in
+
+    Zmq.Socket.subscribe  socket_in  "";
+
+
+
+   let action_in =
+        fun () -> Zmq.Socket.recv_all  socket_in  |> Zmq.Socket.send_all  socket_out
+    in
+
+    let action_out =
+        fun () -> ()
+    in
+
+    let pollitem =
+      Zmq.Poll.mask_of
+        [| (socket_convert socket_in,  Zmq.Poll.In) ; (socket_convert socket_out, Zmq.Poll.In) |]
     in
 
 
@@ -194,7 +221,7 @@ let () =
     in
 
     let f () =
-      new_thread  REQ  addr_in  addr_out
+      new_thread_req  addr_in  addr_out
     in
 
     (Thread.create f) ()
@@ -212,7 +239,7 @@ let () =
     in
 
     let f () =
-      new_thread  REQ  addr_in  addr_out
+      new_thread_req  addr_in  addr_out
     in
     (Thread.create f) ()
   in
@@ -228,7 +255,7 @@ let () =
     in
 
     let f () =
-      new_thread  SUB  addr_in  addr_out
+      new_thread_sub  addr_in  addr_out
     in
     (Thread.create f) ()
   in