Changing qp_set_mo_class.ml. Not finished yet

ocaml/MO_class.ml

@@ -0,0 +1,45 @@
+open Core.Std;;
+open Qptypes ;;
+
+type t = 
+| Core of MO_number.t list
+| Inactive of MO_number.t list
+| Active of MO_number.t list
+| Virtual of MO_number.t list
+| Deleted of MO_number.t list
+;;
+
+
+let to_string  x = 
+  let print_list l =
+    let s = List.map ~f:(fun x-> MO_number.to_int x |> string_of_int )l
+      |> (String.concat ~sep:", ")
+    in
+    "("^s^")"
+  in
+  
+  match x with
+  | Core     l ->  "Core : "^(print_list l) 
+  | Inactive l ->  "Inactive : "^(print_list l)
+  | Active   l ->  "Active : "^(print_list l)
+  | Virtual  l ->  "Virtual : "^(print_list l)
+  | Deleted  l ->  "Deleted : "^(print_list l)
+;;
+
+let _mo_number_list_of_range range = 
+ Range.of_string range |> List.map ~f:MO_number.of_int 
+;;
+
+let create_core     range = Core     (_mo_number_list_of_range range) ;;
+let create_inactive range = Inactive (_mo_number_list_of_range range) ;;
+let create_active   range = Active   (_mo_number_list_of_range range) ;;
+let create_virtual  range = Virtual  (_mo_number_list_of_range range) ;;
+let create_deleted  range = Deleted  (_mo_number_list_of_range range) ;;
+
+let to_bitlist holes particles =
+  let mask = Bitlist.of_int64 (Int64.of_int 513) in
+  let l = Bitlist.to_mo_number_list mask in
+  let i = Inactive l in
+  print_string (to_string i)
+;;
+

ocaml/Makefile

@@ -10,8 +10,6 @@ $(error )
 endif
 
 
-EXECUTABLES=set_mo_class
-
 LIBS=
 PKGS=
 OCAMLCFLAGS=-g
@@ -19,11 +17,12 @@ OCAMLBUILD=ocamlbuild -cflags $(OCAMLCFLAGS) -lflags -g
 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))
 
 
 default: $(ALL_TESTS) executables
 
-executables: $(patsubst %, %.native, $(EXECUTABLES))
+executables: $(ALL_EXE)
 
 %.inferred.mli: $(MLFILES)
 	$(OCAMLBUILD) $*.inferred.mli -cflags -i -use-ocamlfind  $(PKGS)
@@ -48,4 +47,4 @@ ${QPACKAGE_ROOT}/EZFIO/Ocaml/ezfio.ml:
 	$(MAKE) -C ${QPACKAGE_ROOT}/src ezfio
 
 clean: 
-	rm -rf _build
+	rm -rf _build *.native *.byte

ocaml/bitlist.ml

@@ -91,6 +91,23 @@ let of_mo_number_list n_int l =
   Array.to_list a
 ;;
 
+let to_mo_number_list l =
+  let a = Array.of_list l in
+  let rec do_work accu = function
+  | 0 -> accu
+  | i ->
+      begin
+        let new_accu = 
+        match a.(i-1) with
+        | Bit.One  -> (MO_number.of_int i)::accu 
+        | Bit.Zero -> accu 
+        in
+        do_work new_accu (i-1)
+      end
+  in
+  do_work [] (List.length l)
+;;
+
 
 
 (* logical operations on bit_list *)

ocaml/excitation.ml

@@ -0,0 +1,83 @@
+open Core.Std;;
+open Qptypes;;
+
+module Hole : sig
+    type t
+    val to_mo_class  : t -> MO_class.t
+    val of_mo_class  : MO_class.t -> t
+end = struct
+    type t = MO_class.t
+    let of_mo_class x = x
+    let to_mo_class x = x
+end
+
+module Particle : sig
+    type t
+    val to_mo_class  : t -> MO_class.t
+    val of_mo_class  : MO_class.t -> t
+end = struct
+    type t = MO_class.t
+    let of_mo_class x = x
+    let to_mo_class x = x
+end
+
+type t =
+| Single of Hole.t*Particle.t
+| Double of Hole.t*Particle.t*Hole.t*Particle.t
+;;
+
+let failwith s = raise (Failure s)
+;;
+
+let create_single ~hole ~particle =
+  MO_class.(
+  match (hole,particle) with
+  | ( Core     _,          _ ) -> failwith "Holes can not be in core MOs"
+  | (          _, Core     _ ) -> failwith "Particles can not be in core MOs"
+  | ( Deleted  _,          _ ) -> failwith "Holes can not be in deleted MOs"
+  | (          _, Deleted  _ ) -> failwith "Particles can not be in deleted MOs"
+  | ( Virtual  _,          _ ) -> failwith "Holes can not be in virtual MOs"
+  | (          _, Inactive _ ) -> failwith "Particles can not be in virtual MOs"
+  | (h, p) -> Single ( (Hole.of_mo_class h), (Particle.of_mo_class p) )
+  )
+;;
+
+let double_of_singles s1 s2 =
+  let (h1,p1) = match s1 with
+  | Single (h,p) -> (h,p)
+  | _ -> assert false
+  and (h2,p2) = match s2 with
+  | Single (h,p) -> (h,p)
+  | _ -> assert false
+  in
+  Double (h1,p1,h2,p2)
+;;
+
+let create_double ~hole1 ~particle1 ~hole2 ~particle2 =
+  let s1 = create_single ~hole:hole1 ~particle:particle1
+  and s2 =  create_single ~hole:hole2 ~particle:particle2
+  in
+  double_of_singles s1 s2
+;;
+
+let to_string = function
+  | Single (h,p) ->
+      [ "Single Exc. : [" ;
+        (MO_class.to_string (Hole.to_mo_class h));
+        "," ;
+        (MO_class.to_string (Particle.to_mo_class p));
+        "]"]
+      |> String.concat ~sep:" "
+  | Double (h1,p1,h2,p2) ->
+      [ "Double Exc. : [" ;
+        (MO_class.to_string (Hole.to_mo_class h1));
+        "," ;
+        (MO_class.to_string (Particle.to_mo_class p1));
+        ";" ;
+        (MO_class.to_string (Hole.to_mo_class h2));
+        "," ;
+        (MO_class.to_string (Particle.to_mo_class p2));
+        "]"]
+      |> String.concat ~sep:" "
+;;
+

ocaml/mo_class.ml

@@ -0,0 +1,46 @@
+open Core.Std;;
+open Qptypes ;;
+
+type t = 
+| Core of MO_number.t list
+| Inactive of MO_number.t list
+| Active of MO_number.t list
+| Virtual of MO_number.t list
+| Deleted of MO_number.t list
+;;
+
+
+let to_string  x = 
+  let print_list l =
+    let s = List.map ~f:(fun x-> MO_number.to_int x |> string_of_int )l
+      |> (String.concat ~sep:", ")
+    in
+    "("^s^")"
+  in
+  
+  match x with
+  | Core     l ->  "Core : "^(print_list l) 
+  | Inactive l ->  "Inactive : "^(print_list l)
+  | Active   l ->  "Active : "^(print_list l)
+  | Virtual  l ->  "Virtual : "^(print_list l)
+  | Deleted  l ->  "Deleted : "^(print_list l)
+;;
+
+let _mo_number_list_of_range range = 
+ Range.of_string range |> List.map ~f:MO_number.of_int 
+;;
+
+let create_core     range = Core     (_mo_number_list_of_range range) ;;
+let create_inactive range = Inactive (_mo_number_list_of_range range) ;;
+let create_active   range = Active   (_mo_number_list_of_range range) ;;
+let create_virtual  range = Virtual  (_mo_number_list_of_range range) ;;
+let create_deleted  range = Deleted  (_mo_number_list_of_range range) ;;
+
+let to_bitlist x =
+   match x with    
+   | Core     l 
+   | Inactive l 
+   | Active   l 
+   | Virtual  l 
+   | Deleted  l -> Bitlist.of_mo_number_list n_int l
+;;

ocaml/qp_set_mo_class.ml

@@ -0,0 +1,211 @@
+open Qputils;;
+open Qptypes;;
+open Core.Std;;
+
+(*
+ * Command-line arguments
+ * ----------------------
+ *)
+
+let build_mask from upto n_int =
+  let from  = MO_number.to_int from
+  and upto  = MO_number.to_int upto
+  and n_int = N_int_number.to_int n_int
+  in
+  let rec build_mask bit = function
+    | 0 -> []
+    | i -> 
+        if ( i = upto ) then
+          Bit.One::(build_mask Bit.One (i-1))
+        else if ( i = from ) then
+          Bit.One::(build_mask Bit.Zero (i-1))
+        else
+          bit::(build_mask bit (i-1))
+  in
+  let starting_bit = 
+    if ( (upto >= n_int*64) || (upto < 0) ) then Bit.One
+    else Bit.Zero
+  in
+  build_mask starting_bit (n_int*64)
+  |> List.rev
+;;
+
+let apply_mask mask n_int mo_tot_num = 
+  let full_mask  = build_mask (MO_number.of_int 1) (MO_number.of_int mo_tot_num) n_int in
+  let occ_mask   = build_mask (MO_number.of_int 1) (MO_number.of_int mo_tot_num) n_int in
+  let virt_mask  = Bitlist.not_operator occ_mask
+  in
+  let newmask = Bitlist.and_operator occ_mask mask
+  in
+  newmask |> Bitlist.to_string |> print_string;
+  Ezfio.set_bitmasks_n_int (N_int_number.to_int n_int);
+  Ezfio.set_bitmasks_bit_kind 8;
+  Ezfio.set_bitmasks_n_mask_gen 1;
+  let d =  newmask
+    |> Bitlist.to_int64_list
+  in 
+  let rec append_d = function
+    | 1 -> List.rev d
+    | n -> d@(append_d (n-1))
+  in
+  let d = append_d 12 in
+  Ezfio.ezfio_array_of_list ~rank:4 ~dim:([| (N_int_number.to_int n_int) ; 2; 6; 1|]) ~data:d 
+  |> Ezfio.set_bitmasks_generators ; 
+
+;;
+
+
+
+let failure s = 
+  raise (Failure s)
+;;
+
+type t = 
+  | Core
+  | Inactive
+  | Active
+  | Virtual
+  | Deleted
+  | None
+;;
+
+let t_to_string = function
+  | Core -> "core"
+  | Inactive -> "inactive"
+  | Active -> "active"
+  | Virtual -> "virtual"
+  | Deleted -> "deleted"
+  | None -> assert false
+;;
+
+let run ?(core="[]") ?(inact="[]") ?(act="[]") ?(virt="[]") ?(del="[]") ezfio_filename =
+
+  Ezfio.set_file ezfio_filename ;
+  if not (Ezfio.has_mo_basis_mo_tot_num ()) then
+    failure "mo_basis/mo_tot_num not found" ;
+
+  let mo_tot_num = Ezfio.get_mo_basis_mo_tot_num () in
+  let n_int = N_int_number.of_int (Ezfio.get_determinants_n_int ()) in
+
+
+  let mo_class = Array.init mo_tot_num ~f:(fun i -> None) in
+
+  let apply_class l = 
+    let rec apply_class t = function
+    | [] -> ()
+    | k::tail -> let i = MO_number.to_int k in
+        begin
+          match mo_class.(i-1) with
+          | None -> mo_class.(i-1) <- t ;
+            apply_class t tail;
+          | x -> failure 
+             (Printf.sprintf "Orbital %d is defined both in the %s and %s spaces"
+             i (t_to_string x) (t_to_string t))
+        end
+    in
+    match l with
+    | MO_class.Core     x -> apply_class Core      x
+    | MO_class.Inactive x -> apply_class Inactive  x
+    | MO_class.Active   x -> apply_class Active    x
+    | MO_class.Virtual  x -> apply_class Virtual   x
+    | MO_class.Deleted  x -> apply_class Deleted   x
+  in
+
+  MO_class.create_core     core  |> apply_class ;
+  MO_class.create_inactive inact |> apply_class ;
+  MO_class.create_active   act   |> apply_class ;
+  MO_class.create_virtual  virt  |> apply_class ;
+  MO_class.create_deleted  del   |> apply_class ;
+
+  for i=1 to (Array.length mo_class)
+  do
+    if (mo_class.(i-1) = None) then
+      failure (Printf.sprintf "Orbital %d is not specified (mo_tot_num = %d)" i mo_tot_num)
+  done;
+  
+  
+  MO_class.create_core     core  |> MO_class.to_string |> print_endline ;
+  MO_class.create_inactive inact |> MO_class.to_string |> print_endline ;
+  MO_class.create_active   act   |> MO_class.to_string |> print_endline ;
+  MO_class.create_virtual  virt  |> MO_class.to_string |> print_endline ;
+  MO_class.create_deleted  del   |> MO_class.to_string |> print_endline ;
+  (*
+
+
+  let inactive_mask = Range.of_string inact
+    |> List.map ~f:MO_number.of_int
+    |> Bitlist.of_mo_number_list n_int
+  and active_mask = 
+    let s = Range.of_string act
+    in
+      List.map ~f:MO_number.of_int s
+      |> Bitlist.of_mo_number_list n_int
+  in
+  let mask = 
+    Bitlist.not_operator inactive_mask
+    |> Bitlist.and_operator active_mask
+  in apply_mask mask n_int mo_tot_num
+*)
+;;
+
+let ezfio_file =
+  let failure filename = 
+        eprintf "'%s' is not an EZFIO file.\n%!" filename;
+        exit 1
+  in
+  Command.Spec.Arg_type.create
+  (fun filename ->
+    match Sys.is_directory filename with
+    | `Yes -> 
+        begin
+          match Sys.is_file (filename / ".version") with
+          | `Yes -> filename
+          | _ -> failure filename
+        end
+    | _ -> failure filename
+  )
+;;
+
+let default range =
+  let failure filename = 
+        eprintf "'%s' is not a regular file.\n%!" filename;
+        exit 1
+  in
+  Command.Spec.Arg_type.create
+  (fun filename ->
+    match Sys.is_directory filename with
+    | `Yes -> 
+        begin
+          match Sys.is_file (filename / ".version") with
+          | `Yes -> filename
+          | _ -> failure filename
+        end
+    | _ -> failure filename
+  )
+;;
+
+let spec =
+  let open Command.Spec in
+  empty 
+  +> flag "core"   (optional string) ~doc:"range Range of core orbitals"
+  +> flag "inact"  (optional string) ~doc:"range Range of inactive orbitals"
+  +> flag "act"    (optional string) ~doc:"range Range of active orbitals"
+  +> flag "virt"   (optional string) ~doc:"range Range of virtual orbitals"
+  +> flag "del"    (optional string) ~doc:"range Range of deleted orbitals"
+  +> anon ("ezfio_filename" %: ezfio_file)
+;;
+
+let command = 
+    Command.basic 
+    ~summary: "Set the orbital classes in an EZFIO directory"
+    ~readme:(fun () ->
+      "The range of MOs has the form : \"[36-53,72-107,126-131]\"
+        ")
+    spec
+    (fun core inact act virt del ezfio_filename () -> run ?core ?inact ?act ?virt ?del ezfio_filename )
+;;
+
+let () =
+    Command.run command
+
+

ocaml/range.ml

@@ -7,6 +7,8 @@ open Core.Std;;
  * that should represent the list of integers
  * [ 37 ; 37 ; 38 ; ... ; 52 ; 53 ; 72 ; 73 ; ... ; 106 ; 107 ; 126 ; 127 ; ...
  * ; 130 ; 131 ]
+ *
+ * or it can be an integer
 *)
 
 
@@ -34,6 +36,10 @@ let expand_range r =
 ;;
 
 let of_string s =
+  match s.[0] with
+  | '0' | '1' | '2' | '3' | '4' | '5' | '6' | '7' | '8' | '9' ->
+      [ int_of_string s ]
+  | _ ->
     assert (s.[0] = '[') ;
     assert (s.[(String.length s)-1] = ']') ;
     let s = String.sub s 1 ((String.length s) - 2) in

ocaml/set_mo_class.ml

@@ -1,170 +0,0 @@
-open Qputils;;
-open Qptypes;;
-open Core.Std;;
-
-(*
- * Command-line arguments
- * ----------------------
- *)
-
-let build_mask from upto n_int =
-  let from  = MO_number.to_int from
-  and upto  = MO_number.to_int upto
-  and n_int = N_int_number.to_int n_int
-  in
-  let rec build_mask bit = function
-    | 0 -> []
-    | i -> 
-        if ( i = upto ) then
-          Bit.One::(build_mask Bit.One (i-1))
-        else if ( i = from ) then
-          Bit.One::(build_mask Bit.Zero (i-1))
-        else
-          bit::(build_mask bit (i-1))
-  in
-  let starting_bit = 
-    if ( (upto >= n_int*64) || (upto < 0) ) then Bit.One
-    else Bit.Zero
-  in
-  build_mask starting_bit (n_int*64)
-  |> List.rev
-;;
-
-let mo_tot_num = ref 0;;
-let n_int      = ref (N_int_number.of_int 1);;
-
-let apply_mask mask = 
-  let full_mask = build_mask (MO_number.of_int 1) (MO_number.of_int !mo_tot_num) !n_int
-  in
-  let newmask = Bitlist.and_operator full_mask mask
-  in
-  (* TODO *)
-  newmask |> Bitlist.to_string |> print_endline;
-  string_of_int !mo_tot_num |> print_endline;
-;;
-
-
-
-let failure s = 
-  raise (Failure s)
-;;
-
-let run ?active ?(inactive="[]") ezfio_filename =
-
-  Ezfio.set_file ezfio_filename ;
-  if not (Ezfio.has_mo_basis_mo_tot_num ()) then
-    failure "mo_basis/mo_tot_num not found" ;
-
-  mo_tot_num := Ezfio.get_mo_basis_mo_tot_num () ;
-  n_int := N_int_number.of_int (Ezfio.get_determinants_n_int ()) ;
-
-  let inactive_mask = Range.of_string inactive
-    |> List.map ~f:MO_number.of_int
-    |> Bitlist.of_mo_number_list !n_int
-  and active_mask = 
-    let s = 
-    match active with
-    | Some range -> Range.of_string range
-    | None       -> Range.of_string ("[1-"^(Int.to_string !mo_tot_num)^"]")
-    in
-      List.map ~f:MO_number.of_int s
-      |> Bitlist.of_mo_number_list !n_int
-  in
-  let mask = 
-    Bitlist.not_operator inactive_mask
-    |> Bitlist.and_operator active_mask
-  in apply_mask mask
-;;
-
-let ezfio_file =
-  let failure filename = 
-        eprintf "'%s' is not an EZFIO file.\n%!" filename;
-        exit 1
-  in
-  Command.Spec.Arg_type.create
-  (fun filename ->
-    match Sys.is_directory filename with
-    | `Yes -> 
-        begin
-          match Sys.is_file (filename / ".version") with
-          | `Yes -> filename
-          | _ -> failure filename
-        end
-    | _ -> failure filename
-  )
-;;
-
-let default range =
-  let failure filename = 
-        eprintf "'%s' is not a regular file.\n%!" filename;
-        exit 1
-  in
-  Command.Spec.Arg_type.create
-  (fun filename ->
-    match Sys.is_directory filename with
-    | `Yes -> 
-        begin
-          match Sys.is_file (filename / ".version") with
-          | `Yes -> filename
-          | _ -> failure filename
-        end
-    | _ -> failure filename
-  )
-;;
-
-let spec =
-  let open Command.Spec in
-  empty 
-  +> flag "inactive"  (optional string) ~doc:"range Range of inactive orbitals"
-  +> flag "active"  (optional string)   ~doc:"range Range of active orbitals"
-  +> anon ("ezfio_filename" %: ezfio_file)
-;;
-
-let command = 
-    Command.basic 
-    ~summary: "Set the active/inactive orbitals in an EZFIO directory"
-    ~readme:(fun () ->
-      "The range of MOs has the form : \"[36-53,72-107,126-131]\"
-        ")
-    spec
-    (fun inactive active ezfio_filename () -> run ?inactive
-    ?active ezfio_filename )
-;;
-
-let () =
-    Command.run command
-
-
-(*
-let test_module () = 
-  let { Ezfio.rank ; Ezfio.dim ; Ezfio.data } = Ezfio.get_bitmasks_generators () in
-  let test = 
-    Ezfio.flattened_ezfio_data data 
-    |> Array.to_list 
-    |> List.map Int64.of_int 
-    |> Bitlist.of_int64_list 
-  in
-  print_string (Bitlist.to_string test);
-  print_newline ();
-  print_string (string_of_int (String.length (Bitlist.to_string test)));
-  print_newline ();
-
-  let a = Bitlist.of_int64_list ([-1L;0L]) 
-  and b = Bitlist.of_int64_list ([128L;127L])
-  in begin
-    print_newline ();
-    print_newline ();
-    Bitlist.to_string a |> print_string;
-    print_newline ();
-    Bitlist.to_string b |> print_string;
-    print_newline ();
-    Bitlist.and_operator a b |> Bitlist.to_string |> print_string;
-    print_newline ();
-    Bitlist.or_operator a b  |> Bitlist.to_string |> print_string;
-    print_newline ();
-    Bitlist.xor_operator a b |> Bitlist.to_string |> print_string;
-  end
-;;
-*)
-
-(*test_module ();;*)

ocaml/test_excitation.ml

@@ -0,0 +1,20 @@
+let test_module () =
+  let c = MO_class.create_core "[1-4]" in
+  let i = MO_class.create_inactive "[5-8]" in
+  let a = MO_class.create_active "[9-13]" in
+  let v = MO_class.create_virtual "[14-18]" in
+  let d = MO_class.create_deleted "[18-20]" in
+  c |> MO_class.to_string |> print_endline ;
+  i |> MO_class.to_string |> print_endline ;
+  a |> MO_class.to_string |> print_endline ;
+  v |> MO_class.to_string |> print_endline ;
+  d |> MO_class.to_string |> print_endline ;
+
+  let b1 = Excitation.create_single i v in
+  Excitation.to_string b1 |> print_endline;
+
+  let b2 = Excitation.create_double i v i a in
+  Excitation.to_string b2 |> print_endline;
+;;
+
+test_module () ;;

src/Bitmask/bitmasks.irp.f

@@ -103,7 +103,7 @@ BEGIN_PROVIDER [ integer(bit_kind), generators_bitmask, (N_int,2,6,N_generators_
  ! Bitmasks for generator determinants. (N_int, alpha/beta, hole/particle, generator).
  ! 3rd index is :
  ! * 1 : hole     for single exc
- ! * 1 : particle for single exc
+ ! * 2 : particle for single exc
  ! * 3 : hole     for 1st exc of double
  ! * 4 : particle for 1st exc of double
  ! * 5 : hole     for 2dn exc of double