mirror of
https://github.com/LCPQ/quantum_package
synced 2024-12-23 04:43:50 +01:00
Accelerated qp_edit with large multi-determinant wave functions
This commit is contained in:
parent
21143afb4f
commit
e4043cda0d
@ -28,20 +28,30 @@ let of_string ?(zero='0') ?(one='1') s =
|
||||
else if (c = one) then Bit.One
|
||||
else (failwith ("Error in bitstring ") ) )
|
||||
|
||||
let of_string_mp s =
|
||||
String.to_list s
|
||||
|> List.rev_map ~f:(function
|
||||
| '-' -> Bit.Zero
|
||||
| '+' -> Bit.One
|
||||
| _ -> failwith ("Error in bitstring ") )
|
||||
|
||||
|
||||
(* Create a bit list from an int64 *)
|
||||
let of_int64 i =
|
||||
let rec do_work = function
|
||||
| 0L -> [ Bit.Zero ]
|
||||
| 1L -> [ Bit.One ]
|
||||
| i -> let b =
|
||||
|
||||
let rec do_work accu = function
|
||||
| 0L -> Bit.Zero :: accu |> List.rev
|
||||
| 1L -> Bit.One :: accu |> List.rev
|
||||
| i ->
|
||||
let b =
|
||||
match (Int64.bit_and i 1L ) with
|
||||
| 0L -> Bit.Zero
|
||||
| 1L -> Bit.One
|
||||
| _ -> raise (Failure "i land 1 not in (0,1)")
|
||||
in b:: ( do_work (Int64.shift_right_logical i 1) )
|
||||
in
|
||||
do_work (b :: accu) (Int64.shift_right_logical i 1)
|
||||
in
|
||||
|
||||
let adjust_length result =
|
||||
let rec do_work accu = function
|
||||
| 64 -> List.rev accu
|
||||
@ -51,7 +61,7 @@ let of_int64 i =
|
||||
in
|
||||
do_work (List.rev result) (List.length result)
|
||||
in
|
||||
adjust_length (do_work i)
|
||||
adjust_length (do_work [] i)
|
||||
|
||||
|
||||
(* Create an int64 from a bit list *)
|
||||
@ -102,6 +112,10 @@ let to_int64_list l =
|
||||
in
|
||||
List.rev_map ~f:to_int64 l
|
||||
|
||||
(* Create an array of int64 from a bit list *)
|
||||
let to_int64_array l =
|
||||
to_int64_list l
|
||||
|> Array.of_list
|
||||
|
||||
(* Create a bit list from a list of MO indices *)
|
||||
let of_mo_number_list n_int l =
|
||||
@ -163,11 +177,10 @@ let not_operator b = logical_operator1 Bit.not_operator b
|
||||
|
||||
|
||||
let popcnt b =
|
||||
let rec popcnt accu = function
|
||||
| [] -> accu
|
||||
| Bit.One::rest -> popcnt (accu+1) rest
|
||||
| Bit.Zero::rest -> popcnt (accu) rest
|
||||
in popcnt 0 b
|
||||
List.fold_left b ~init:0 ~f:(fun accu -> function
|
||||
| Bit.One -> accu+1
|
||||
| Bit.Zero -> accu
|
||||
)
|
||||
|
||||
|
||||
|
||||
|
@ -6,9 +6,12 @@ val zero : Qptypes.N_int_number.t -> t
|
||||
(** Convert to a string for printing *)
|
||||
val to_string : t -> string
|
||||
|
||||
(** Convert to a string for printing *)
|
||||
(** Read from a string *)
|
||||
val of_string : ?zero:char -> ?one:char -> string -> t
|
||||
|
||||
(** Read from a string with the ++-- notation *)
|
||||
val of_string_mp : string -> t
|
||||
|
||||
(** int64 conversion functions *)
|
||||
|
||||
val of_int64 : int64 -> t
|
||||
@ -16,6 +19,7 @@ val to_int64 : t -> int64
|
||||
|
||||
val of_int64_list : int64 list -> t
|
||||
val to_int64_list : t -> int64 list
|
||||
val to_int64_array : t -> int64 array
|
||||
|
||||
(** Get the number of needed int64 elements to encode the bit list *)
|
||||
val n_int_of_mo_tot_num : int -> Qptypes.N_int_number.t
|
||||
|
@ -55,12 +55,18 @@ let of_int64_array ~n_int ~alpha ~beta x =
|
||||
end;
|
||||
x
|
||||
|
||||
let of_int64_array_no_check x = x
|
||||
|
||||
let of_bitlist_couple ~alpha ~beta (xa,xb) =
|
||||
let ba = Bitlist.to_int64_list xa in
|
||||
let bb = Bitlist.to_int64_list xb in
|
||||
let n_int = Bitlist.n_int_of_mo_tot_num (List.length xa) in
|
||||
of_int64_array ~n_int:n_int ~alpha:alpha ~beta:beta (Array.of_list (ba@bb))
|
||||
let of_bitlist_couple ?n_int ~alpha ~beta (xa,xb) =
|
||||
let ba, bb =
|
||||
Bitlist.to_int64_array xa ,
|
||||
Bitlist.to_int64_array xb
|
||||
and n_int =
|
||||
match n_int with
|
||||
| Some x -> x
|
||||
| None -> Bitlist.n_int_of_mo_tot_num (List.length xa)
|
||||
in
|
||||
of_int64_array ~n_int ~alpha ~beta (Array.concat [ba;bb])
|
||||
|
||||
|
||||
let to_string ~mo_tot_num x =
|
||||
|
@ -24,7 +24,8 @@ val to_alpha_beta : t -> (int64 array)*(int64 array)
|
||||
val to_bitlist_couple : t -> Bitlist.t * Bitlist.t
|
||||
|
||||
(** Create from a bit list *)
|
||||
val of_bitlist_couple : alpha:Qptypes.Elec_alpha_number.t ->
|
||||
val of_bitlist_couple : ?n_int:Qptypes.N_int_number.t ->
|
||||
alpha:Qptypes.Elec_alpha_number.t ->
|
||||
beta:Qptypes.Elec_beta_number.t ->
|
||||
Bitlist.t * Bitlist.t -> t
|
||||
|
||||
|
@ -157,44 +157,58 @@ end = struct
|
||||
|
||||
|
||||
let read_psi_det () =
|
||||
let n_int = read_n_int ()
|
||||
and n_alpha = Ezfio.get_electrons_elec_alpha_num ()
|
||||
let n_int =
|
||||
read_n_int ()
|
||||
and alpha =
|
||||
Ezfio.get_electrons_elec_alpha_num ()
|
||||
|> Elec_alpha_number.of_int
|
||||
and n_beta = Ezfio.get_electrons_elec_beta_num ()
|
||||
and beta =
|
||||
Ezfio.get_electrons_elec_beta_num ()
|
||||
|> Elec_beta_number.of_int
|
||||
in
|
||||
if not (Ezfio.has_determinants_psi_det ()) then
|
||||
begin
|
||||
let mo_tot_num = MO_number.get_max () in
|
||||
let mo_tot_num =
|
||||
MO_number.get_max ()
|
||||
in
|
||||
let rec build_data accu = function
|
||||
| 0 -> accu
|
||||
| n -> build_data ((MO_number.of_int ~max:mo_tot_num n)::accu) (n-1)
|
||||
in
|
||||
let det_a = build_data [] (Elec_alpha_number.to_int n_alpha)
|
||||
let det_a =
|
||||
build_data [] (Elec_alpha_number.to_int alpha)
|
||||
|> Bitlist.of_mo_number_list n_int
|
||||
and det_b = build_data [] (Elec_beta_number.to_int n_beta)
|
||||
and det_b =
|
||||
build_data [] (Elec_beta_number.to_int beta)
|
||||
|> Bitlist.of_mo_number_list n_int
|
||||
in
|
||||
let data = ( (Bitlist.to_int64_list det_a) @
|
||||
let data =
|
||||
( (Bitlist.to_int64_list det_a) @
|
||||
(Bitlist.to_int64_list det_b) )
|
||||
in
|
||||
Ezfio.ezfio_array_of_list ~rank:3 ~dim:[| N_int_number.to_int n_int ; 2 ; 1 |] ~data:data
|
||||
|> Ezfio.set_determinants_psi_det ;
|
||||
end ;
|
||||
let n_int = N_int_number.to_int n_int in
|
||||
let psi_det_array = Ezfio.get_determinants_psi_det () in
|
||||
let dim = psi_det_array.Ezfio.dim
|
||||
and data = Ezfio.flattened_ezfio psi_det_array
|
||||
let n_int_i =
|
||||
N_int_number.to_int n_int in
|
||||
let psi_det_array =
|
||||
Ezfio.get_determinants_psi_det ()
|
||||
in
|
||||
assert (n_int = dim.(0));
|
||||
let dim =
|
||||
psi_det_array.Ezfio.dim
|
||||
and data =
|
||||
Ezfio.flattened_ezfio psi_det_array
|
||||
in
|
||||
assert (n_int_i = dim.(0));
|
||||
assert (dim.(1) = 2);
|
||||
assert (dim.(2) = (Det_number.to_int (read_n_det ())));
|
||||
List.init dim.(2) ~f:(fun i ->
|
||||
Array.sub ~pos:(2*n_int*i) ~len:(2*n_int) data)
|
||||
|> List.map ~f:(Determinant.of_int64_array
|
||||
~n_int:(N_int_number.of_int n_int)
|
||||
~alpha:n_alpha ~beta:n_beta )
|
||||
|> Array.of_list
|
||||
let len =
|
||||
2 * n_int_i
|
||||
in
|
||||
Array.init dim.(2) ~f:(fun i ->
|
||||
Array.sub ~pos:(len * i) ~len data
|
||||
|> Determinant.of_int64_array ~n_int ~alpha ~beta
|
||||
)
|
||||
;;
|
||||
|
||||
let write_psi_det ~n_int ~n_det d =
|
||||
@ -380,35 +394,49 @@ psi_det = %s
|
||||
let i =
|
||||
i-1
|
||||
in
|
||||
List.map ~f:(fun x -> Det_coef.to_string x.(i)) buffer
|
||||
|> String.concat ~sep:" "
|
||||
List.map ~f:(fun x -> x.(i)) buffer
|
||||
in
|
||||
let rec build_result = function
|
||||
| 1 -> extract_state 1
|
||||
| i -> (build_result (i-1))^" "^(extract_state i)
|
||||
let rec build_result accu = function
|
||||
| 0 -> accu
|
||||
| i ->
|
||||
let new_accu =
|
||||
(extract_state i) :: accu
|
||||
in
|
||||
build_result nstates
|
||||
build_result new_accu (i-1)
|
||||
in
|
||||
"(psi_coef ("^a^"))"
|
||||
build_result [] nstates
|
||||
in
|
||||
List.concat a
|
||||
|> Array.of_list
|
||||
in
|
||||
|
||||
(*
|
||||
let dets = match ( dets
|
||||
|> String.split ~on:'\n'
|
||||
|> List.map ~f:(String.strip)
|
||||
) with
|
||||
| _::lines -> lines
|
||||
| _ -> failwith "Error in determinants"
|
||||
in
|
||||
*)
|
||||
|
||||
(* Handle determinants *)
|
||||
let psi_det =
|
||||
let n_alpha = Ezfio.get_electrons_elec_alpha_num ()
|
||||
let alpha = Ezfio.get_electrons_elec_alpha_num ()
|
||||
|> Elec_alpha_number.of_int
|
||||
and n_beta = Ezfio.get_electrons_elec_beta_num ()
|
||||
and beta = Ezfio.get_electrons_elec_beta_num ()
|
||||
|> Elec_beta_number.of_int
|
||||
and n_int =
|
||||
N_int_number.get_max ()
|
||||
|> N_int_number.of_int
|
||||
in
|
||||
let rec read_dets accu = function
|
||||
| [] -> List.rev accu
|
||||
| ""::_::alpha::beta::tail ->
|
||||
| ""::_::alpha_str::beta_str::tail ->
|
||||
begin
|
||||
let newdet =
|
||||
(Bitlist.of_string ~zero:'-' ~one:'+' alpha ,
|
||||
Bitlist.of_string ~zero:'-' ~one:'+' beta)
|
||||
|> Determinant.of_bitlist_couple ~alpha:n_alpha ~beta:n_beta
|
||||
|> Determinant.sexp_of_t
|
||||
|> Sexplib.Sexp.to_string
|
||||
(Bitlist.of_string_mp alpha_str, Bitlist.of_string_mp beta_str)
|
||||
|> Determinant.of_bitlist_couple ~n_int ~alpha ~beta
|
||||
in
|
||||
read_dets (newdet::accu) tail
|
||||
end
|
||||
@ -417,29 +445,26 @@ psi_det = %s
|
||||
let dets =
|
||||
List.map ~f:String.rev dets
|
||||
in
|
||||
let sze =
|
||||
List.fold ~init:0 ~f:(fun accu x -> accu + (String.length x)) dets
|
||||
in
|
||||
let control =
|
||||
Gc.get ()
|
||||
in
|
||||
Gc.tune ~minor_heap_size:(sze) ~space_overhead:(sze/10)
|
||||
~max_overhead:100000 ~major_heap_increment:(sze/10) ();
|
||||
let a =
|
||||
read_dets [] dets
|
||||
|> Array.of_list
|
||||
in
|
||||
|
||||
let bitkind =
|
||||
Printf.sprintf "(bit_kind %d)" (Lazy.force Qpackage.bit_kind
|
||||
|> Bit_kind.to_int)
|
||||
and n_int =
|
||||
Printf.sprintf "(n_int %d)" (N_int_number.get_max ())
|
||||
in
|
||||
let s =
|
||||
[ header ; bitkind ; n_int ; "(psi_coef ())" ; "(psi_det ())"]
|
||||
|> String.concat
|
||||
in
|
||||
Gc.set control;
|
||||
"(psi_det ("^a^"))"
|
||||
in
|
||||
|
||||
let bitkind = Printf.sprintf "(bit_kind %d)" (Lazy.force Qpackage.bit_kind
|
||||
|> Bit_kind.to_int)
|
||||
and n_int = Printf.sprintf "(n_int %d)" (N_int_number.get_max ()) in
|
||||
let s = String.concat [ header ; bitkind ; n_int ; psi_coef ; psi_det]
|
||||
in
|
||||
|
||||
let result =
|
||||
Generic_input_of_rst.evaluate_sexp t_of_sexp s
|
||||
in
|
||||
match result with
|
||||
| Some x -> Some { x with psi_coef ; psi_det }
|
||||
| None -> None
|
||||
;;
|
||||
|
||||
end
|
||||
|
@ -1,2 +1,3 @@
|
||||
true: package(core,sexplib.syntax,cryptokit,ZMQ)
|
||||
true: thread
|
||||
false: profile
|
||||
|
Loading…
Reference in New Issue
Block a user