LCPQ/QCaml
10
1
Fork 0
mirror of https://gitlab.com/scemama/QCaml.git synced 2024-08-30 16:23:41 +02:00
Code Releases Activity

Accelerated CI

Browse Source
This commit is contained in:
Anthony Scemama 2019-02-28 18:18:26 +01:00
parent e1aafcbd32
commit bb677d4f3a
2 changed files with 90 additions and 24 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

109
CI/CI.ml
View File

@ -70,30 +70,95 @@ let make ?(n_states=1) det_space =
in in
let m_H_spin a b = lazy ( let m_H_spin a b = lazy (
let v = Vec.make0 ndet in let n_alfa = Array.length a in
let n_beta = Array.length b in
let result = Array.init ndet (fun _ -> []) in
(** Update function when ki and kj are connected *)
let update i j ki kj =
let x = h_ij mo_basis ki kj in
if x <> 0. then
result.(i) <- (j, x) :: result.(i) ;
in
(** Array of (list of singles, list of doubles) in the beta spin *)
let degree_bb =
Array.map (fun det_i ->
let deg = Spindeterminant.degree det_i in
let doubles =
Array.mapi (fun i det_j ->
let d = deg det_j in
if d < 3 then
Some (i,d,det_j)
else
None
) b
|> Array.to_list
|> Util.list_some
in
let singles =
List.filter (fun (i,d,det_j) -> d < 2) doubles
|> List.map (fun (i,_,det_j) -> (i,det_j))
in
let doubles =
List.map (fun (i,_,det_j) -> (i,det_j)) doubles
in
(singles, doubles)
) b
in
let a = Array.to_list a
and b = Array.to_list b
in
let i = ref 0 in let i = ref 0 in
let result = Array.make ndet (Vector.sparse_of_vec @@ Vec.make0 1) in List.iteri (fun ia i_alfa ->
Array.iteri (fun ia i_alfa -> Printf.eprintf "%8d / %8d\r%!" ia n_alfa;
Array.iteri (fun ib i_beta -> let j = ref 1 in
Printf.eprintf "%8d / %8d\r%!" !i ndet; let deg_a = Spindeterminant.degree i_alfa in
let ki = List.iter (fun j_alfa ->
Determinant.of_spindeterminants i_alfa i_beta let degree_a = deg_a j_alfa in
in begin
let j = ref 0 in match degree_a with
Array.iteri (fun ja j_alfa -> | 2 ->
Array.iteri (fun jb j_beta -> let i' = ref !i in
let kj = List.iteri (fun ib i_beta ->
Determinant.of_spindeterminants j_alfa j_beta let ki = Determinant.of_spindeterminants i_alfa i_beta in
in let kj = Determinant.of_spindeterminants j_alfa i_beta in
incr j; update !i' (ib + !j) ki kj;
v.{!j} <- h_ij mo_basis ki kj incr i';
) b; ) b;
) a; | 1 ->
result.(!i) <- Vector.sparse_of_vec v; let i' = ref !i in
incr i; List.iteri (fun ib i_beta ->
) b let ki = Determinant.of_spindeterminants i_alfa i_beta in
let singles, _ = degree_bb.(ib) in
List.iter (fun (j', j_beta) ->
let kj = Determinant.of_spindeterminants j_alfa j_beta in
update !i' (j' + !j) ki kj
) singles;
incr i';
) b;
| 0 ->
let i' = ref !i in
List.iteri (fun ib i_beta ->
let ki = Determinant.of_spindeterminants i_alfa i_beta in
let _singles, doubles = degree_bb.(ib) in
List.iter (fun (j', j_beta) ->
let kj = Determinant.of_spindeterminants j_alfa j_beta in
update !i' (j' + !j) ki kj
) doubles;
incr i';
) b;
| _ -> ();
end;
j := !j + n_beta
) a;
i := !i + n_beta
) a; ) a;
Matrix.sparse_of_vector_array result
Array.map (fun l ->
List.sort compare l
|> Vector.sparse_of_assoc_list ndet ) result
|> Matrix.sparse_of_vector_array
) )
in in

5
CI/Spindeterminant.ml
View File

@ -80,8 +80,9 @@ let rec bits_to_list accu = function
in in
bits_to_list newlist Z.(logand t (t-one)) bits_to_list newlist Z.(logand t (t-one))
let degree t t' = let degree t =
Z.hamdist (bitstring t) (bitstring t') / 2 let bt = bitstring t in
fun t' -> Z.hamdist bt (bitstring t') / 2
let holes_of t t' = let holes_of t t' =
Z.logand (bitstring t) (Z.logxor (bitstring t) (bitstring t')) Z.logand (bitstring t) (Z.logxor (bitstring t) (bitstring t'))