From cb509d2d9305092e8f606881018b89c40da91d8c Mon Sep 17 00:00:00 2001 From: Anthony Scemama Date: Tue, 16 Sep 2014 18:58:42 +0200 Subject: [PATCH] Changing qp_set_mo_class.ml. Not finished yet --- ocaml/MO_class.ml | 45 ++++ ocaml/Makefile | 7 +- ocaml/bitlist.ml | 17 ++ ocaml/excitation.ml | 83 +++++++ ocaml/mo_class.ml | 46 ++++ ...rom_xyz.ml => qp_create_ezfio_from_xyz.ml} | 0 ocaml/qp_set_mo_class.ml | 211 ++++++++++++++++++ ocaml/range.ml | 16 +- ocaml/set_mo_class.ml | 170 -------------- ocaml/test_excitation.ml | 20 ++ src/Bitmask/bitmasks.irp.f | 2 +- 11 files changed, 437 insertions(+), 180 deletions(-) create mode 100644 ocaml/MO_class.ml create mode 100644 ocaml/excitation.ml create mode 100644 ocaml/mo_class.ml rename ocaml/{create_ezfio_from_xyz.ml => qp_create_ezfio_from_xyz.ml} (100%) create mode 100644 ocaml/qp_set_mo_class.ml delete mode 100644 ocaml/set_mo_class.ml create mode 100644 ocaml/test_excitation.ml diff --git a/ocaml/MO_class.ml b/ocaml/MO_class.ml new file mode 100644 index 00000000..4e5a743a --- /dev/null +++ b/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) +;; + diff --git a/ocaml/Makefile b/ocaml/Makefile index aa4d1fcb..f1d95be7 100644 --- a/ocaml/Makefile +++ b/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 diff --git a/ocaml/bitlist.ml b/ocaml/bitlist.ml index 4f0643c0..dc69d25b 100644 --- a/ocaml/bitlist.ml +++ b/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 *) diff --git a/ocaml/excitation.ml b/ocaml/excitation.ml new file mode 100644 index 00000000..89d76f1f --- /dev/null +++ b/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:" " +;; + diff --git a/ocaml/mo_class.ml b/ocaml/mo_class.ml new file mode 100644 index 00000000..8af49f38 --- /dev/null +++ b/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 +;; diff --git a/ocaml/create_ezfio_from_xyz.ml b/ocaml/qp_create_ezfio_from_xyz.ml similarity index 100% rename from ocaml/create_ezfio_from_xyz.ml rename to ocaml/qp_create_ezfio_from_xyz.ml diff --git a/ocaml/qp_set_mo_class.ml b/ocaml/qp_set_mo_class.ml new file mode 100644 index 00000000..da322648 --- /dev/null +++ b/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 + + diff --git a/ocaml/range.ml b/ocaml/range.ml index 4d79f315..d93be879 100644 --- a/ocaml/range.ml +++ b/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,11 +36,15 @@ let expand_range r = ;; let of_string s = - assert (s.[0] = '[') ; - assert (s.[(String.length s)-1] = ']') ; - let s = String.sub s 1 ((String.length s) - 2) in - let l = String.split ~on:',' s in - let l = List.map ~f:expand_range l in + 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 + let l = String.split ~on:',' s in + let l = List.map ~f:expand_range l in List.concat l |> List.dedup ~compare:Int.compare |> List.sort ~cmp:Int.compare ;; diff --git a/ocaml/set_mo_class.ml b/ocaml/set_mo_class.ml deleted file mode 100644 index 099c4a2d..00000000 --- a/ocaml/set_mo_class.ml +++ /dev/null @@ -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 ();;*) diff --git a/ocaml/test_excitation.ml b/ocaml/test_excitation.ml new file mode 100644 index 00000000..8bd3b71c --- /dev/null +++ b/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 () ;; diff --git a/src/Bitmask/bitmasks.irp.f b/src/Bitmask/bitmasks.irp.f index 2f841a7d..353d6a3b 100644 --- a/src/Bitmask/bitmasks.irp.f +++ b/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