mirror of
https://gitlab.com/scemama/QCaml.git
synced 2024-08-30 16:23:41 +02:00
Improved arbitrary space
This commit is contained in:
parent
b72a1e251e
commit
0f2285b557
175
CI/CI.ml
175
CI/CI.ml
@ -1,6 +1,6 @@
|
|||||||
open Lacaml.D
|
open Lacaml.D
|
||||||
|
|
||||||
module Ds = Determinant_space
|
module Ds = DeterminantSpace
|
||||||
|
|
||||||
type t =
|
type t =
|
||||||
{
|
{
|
||||||
@ -53,24 +53,165 @@ let h_ij mo_basis ki kj =
|
|||||||
|
|
||||||
let create_matrix_arbitrary f det_space =
|
let create_matrix_arbitrary f det_space =
|
||||||
lazy (
|
lazy (
|
||||||
let det =
|
let ndet = Ds.size det_space in
|
||||||
|
let data =
|
||||||
match Ds.determinants det_space with
|
match Ds.determinants det_space with
|
||||||
| Ds.Arbitrary _ -> Ds.determinants_array det_space
|
| Ds.Arbitrary a -> a
|
||||||
| _ -> assert false
|
| _ -> assert false
|
||||||
in
|
in
|
||||||
|
let det_alfa = data.Ds.det_alfa
|
||||||
|
and det_beta = data.Ds.det_beta
|
||||||
|
and det = data.Ds.det
|
||||||
|
and index_start = data.Ds.index_start
|
||||||
|
in
|
||||||
|
|
||||||
let ndet = Ds.size det_space in
|
|
||||||
|
|
||||||
let v = Vec.make0 ndet 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
|
||||||
|
) det_beta
|
||||||
|
|> 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)
|
||||||
|
) det_beta
|
||||||
|
in
|
||||||
|
|
||||||
Array.init ndet
|
let task (i,i_dets) =
|
||||||
(fun i -> let ki = det.(i) in
|
let shift = index_start.(i) in
|
||||||
Printf.eprintf "%8d / %8d\r%!" i ndet;
|
|
||||||
let j = ref 1 in
|
let result =
|
||||||
Ds.determinant_stream det_space
|
Array.init (index_start.(i+1) - shift)
|
||||||
|> Stream.iter (fun kj -> v.{!j} <- f ki kj ; incr j);
|
(fun _ -> [])
|
||||||
Vector.sparse_of_vec v)
|
in
|
||||||
|> Matrix.sparse_of_vector_array
|
|
||||||
|
(** Update function when ki and kj are connected *)
|
||||||
|
let update i j ki kj =
|
||||||
|
let x = f ki kj in
|
||||||
|
if abs_float x > Constants.epsilon then
|
||||||
|
result.(i - shift) <- (j, x) :: result.(i - shift) ;
|
||||||
|
in
|
||||||
|
|
||||||
|
let i_alfa = det_alfa.(i) in
|
||||||
|
let deg_a = Spindeterminant.degree i_alfa in
|
||||||
|
|
||||||
|
Array.iteri (fun j j_dets ->
|
||||||
|
let j_alfa = det_alfa.(j) in
|
||||||
|
let degree_a = deg_a j_alfa in
|
||||||
|
|
||||||
|
begin
|
||||||
|
match degree_a with
|
||||||
|
| 2 ->
|
||||||
|
Array.iteri (fun i' i_b ->
|
||||||
|
try
|
||||||
|
Array.iteri (fun j' j_b ->
|
||||||
|
if j_b >= i_b then
|
||||||
|
( if j_b = i_b then
|
||||||
|
( let i_beta = det_beta.(i_b) in
|
||||||
|
let ki = Determinant.of_spindeterminants i_alfa i_beta in
|
||||||
|
let kj = Determinant.of_spindeterminants j_alfa i_beta in
|
||||||
|
update (index_start.(i) + i')
|
||||||
|
(index_start.(j) + j' + 1) ki kj);
|
||||||
|
raise Exit)
|
||||||
|
) j_dets
|
||||||
|
with Exit -> ()
|
||||||
|
) i_dets
|
||||||
|
| 1 ->
|
||||||
|
Array.iteri (fun i' i_b ->
|
||||||
|
let i_beta = det_beta.(i_b) in
|
||||||
|
let ki = Determinant.of_spindeterminants i_alfa i_beta in
|
||||||
|
let singles, _ = degree_bb.(i_b) in
|
||||||
|
let rec aux singles j' =
|
||||||
|
match singles with
|
||||||
|
| [] -> ()
|
||||||
|
| (js, j_beta)::r_singles ->
|
||||||
|
begin
|
||||||
|
match compare js j_dets.(j') with
|
||||||
|
| -1 -> aux r_singles j'
|
||||||
|
| 0 ->
|
||||||
|
let kj =
|
||||||
|
Determinant.of_spindeterminants j_alfa j_beta
|
||||||
|
in (update
|
||||||
|
(index_start.(i) + i') (index_start.(j) + j' + 1)
|
||||||
|
ki kj;
|
||||||
|
aux r_singles (j'+1);)
|
||||||
|
| 1 -> if (j' < Array.length j_dets) then aux singles (j'+1)
|
||||||
|
| _ -> assert false
|
||||||
|
end
|
||||||
|
in aux singles 0
|
||||||
|
) i_dets
|
||||||
|
| 0 ->
|
||||||
|
Array.iteri (fun i' i_b ->
|
||||||
|
let i_beta = det_beta.(i_b) in
|
||||||
|
let ki = Determinant.of_spindeterminants i_alfa i_beta in
|
||||||
|
let _, doubles = degree_bb.(i_b) in
|
||||||
|
let rec aux doubles j' =
|
||||||
|
match doubles with
|
||||||
|
| [] -> ()
|
||||||
|
| (js, j_beta)::r_doubles ->
|
||||||
|
begin
|
||||||
|
match compare js j_dets.(j') with
|
||||||
|
| -1 -> aux r_doubles j'
|
||||||
|
| 0 ->
|
||||||
|
let kj =
|
||||||
|
Determinant.of_spindeterminants j_alfa j_beta
|
||||||
|
in (update
|
||||||
|
(index_start.(i) + i') (index_start.(j) + j' + 1)
|
||||||
|
ki kj;
|
||||||
|
aux r_doubles (j'+1);)
|
||||||
|
| 1 -> if (j' < Array.length j_dets) then aux doubles (j'+1)
|
||||||
|
| _ -> assert false
|
||||||
|
end
|
||||||
|
in aux doubles 0
|
||||||
|
) i_dets
|
||||||
|
| _ -> ();
|
||||||
|
end
|
||||||
|
) det;
|
||||||
|
let r =
|
||||||
|
Array.map (fun l ->
|
||||||
|
List.rev l
|
||||||
|
|> Vector.sparse_of_assoc_list ndet
|
||||||
|
) result
|
||||||
|
in (i,r)
|
||||||
|
in
|
||||||
|
|
||||||
|
|
||||||
|
let result =
|
||||||
|
if Parallel.master then
|
||||||
|
Array.init ndet (fun _ -> Vector.sparse_of_assoc_list ndet [])
|
||||||
|
else
|
||||||
|
Array.init ndet (fun _ -> Vector.sparse_of_assoc_list ndet [])
|
||||||
|
in
|
||||||
|
|
||||||
|
let n_det_alfa =
|
||||||
|
Array.length det_alfa
|
||||||
|
in
|
||||||
|
Array.mapi (fun i i_dets -> i, i_dets) det
|
||||||
|
|> Array.to_list
|
||||||
|
|> Stream.of_list
|
||||||
|
|> Farm.run ~ordered:false ~f:task
|
||||||
|
|> Stream.iter (fun (k, r) ->
|
||||||
|
let shift = index_start.(k) in
|
||||||
|
let det_k = det.(k) in
|
||||||
|
Array.iteri (fun j r_j -> result.(shift+det_k.(j)) <- r_j) r;
|
||||||
|
Printf.eprintf "%8d / %8d\r%!" (k+1) n_det_alfa;
|
||||||
|
) ;
|
||||||
|
Matrix.sparse_of_vector_array result
|
||||||
)
|
)
|
||||||
|
|
||||||
|
|
||||||
@ -117,13 +258,17 @@ let create_matrix_spin f det_space =
|
|||||||
in
|
in
|
||||||
|
|
||||||
let task (i,i_alfa) =
|
let task (i,i_alfa) =
|
||||||
let result = Array.init n_beta (fun _ -> []) in
|
let result =
|
||||||
|
Array.init n_beta (fun _ -> [])
|
||||||
|
in
|
||||||
|
|
||||||
(** Update function when ki and kj are connected *)
|
(** Update function when ki and kj are connected *)
|
||||||
let update i j ki kj =
|
let update i j ki kj =
|
||||||
let x = f ki kj in
|
let x = f ki kj in
|
||||||
if abs_float x > Constants.epsilon then
|
if abs_float x > Constants.epsilon then
|
||||||
result.(i) <- (j, x) :: result.(i) ;
|
result.(i) <- (j, x) :: result.(i) ;
|
||||||
in
|
in
|
||||||
|
|
||||||
let j = ref 1 in
|
let j = ref 1 in
|
||||||
let deg_a = Spindeterminant.degree i_alfa in
|
let deg_a = Spindeterminant.degree i_alfa in
|
||||||
List.iter (fun j_alfa ->
|
List.iter (fun j_alfa ->
|
||||||
@ -198,7 +343,7 @@ let make ?(n_states=1) det_space =
|
|||||||
let mo_basis = Ds.mo_basis det_space in
|
let mo_basis = Ds.mo_basis det_space in
|
||||||
|
|
||||||
(* While in a sequential region, initiate the parallel
|
(* While in a sequential region, initiate the parallel
|
||||||
4-idx transformation
|
4-idx transformation to avoid nested parallel jobs
|
||||||
*)
|
*)
|
||||||
ignore @@ MOBasis.two_e_ints mo_basis;
|
ignore @@ MOBasis.two_e_ints mo_basis;
|
||||||
|
|
||||||
|
@ -32,7 +32,7 @@ type t =
|
|||||||
}
|
}
|
||||||
|
|
||||||
|
|
||||||
module Ss = Spindeterminant_space
|
module Ss = SpindeterminantSpace
|
||||||
|
|
||||||
let n_alfa t = t.n_alfa
|
let n_alfa t = t.n_alfa
|
||||||
let n_beta t = t.n_beta
|
let n_beta t = t.n_beta
|
||||||
@ -44,8 +44,8 @@ let size t =
|
|||||||
match t.determinants with
|
match t.determinants with
|
||||||
| Spin (a,b) -> (Array.length a) * (Array.length b)
|
| Spin (a,b) -> (Array.length a) * (Array.length b)
|
||||||
| Arbitrary a ->
|
| Arbitrary a ->
|
||||||
let ndet_a = Array.length a.det_alfa in
|
let ndet_a = Array.length a.det_alfa in
|
||||||
a.index_start.(ndet_a - 1) + Array.length a.det.(ndet_a - 1)
|
a.index_start.(ndet_a)
|
||||||
|
|
||||||
|
|
||||||
let determinant_stream t =
|
let determinant_stream t =
|
||||||
@ -150,15 +150,27 @@ let fci_of_mo_basis ?(frozen_core=true) mo_basis =
|
|||||||
let det_alfa = Ss.spin_determinants det_a
|
let det_alfa = Ss.spin_determinants det_a
|
||||||
and det_beta = Ss.spin_determinants det_b
|
and det_beta = Ss.spin_determinants det_b
|
||||||
in
|
in
|
||||||
Spin (det_alfa, det_beta)
|
|
||||||
(*
|
|
||||||
let n_det_beta = Array.length det_beta in
|
let n_det_beta = Array.length det_beta in
|
||||||
Arbitrary {
|
let n_det_alfa = Array.length det_alfa in
|
||||||
det_alfa ; det_beta ;
|
|
||||||
det = Array.make (Array.length det_alfa) (Array.init (Array.length det_beta) (fun i -> i));
|
(*
|
||||||
index_start = Array.mapi (fun i _ -> i*n_det_beta) det_alfa;
|
let ndet = n_det_alfa * n_det_beta in
|
||||||
}
|
Format.printf "Number of determinants : %d %d %d\n%!"
|
||||||
|
n_det_alfa n_det_beta ndet;
|
||||||
|
Spin (det_alfa, det_beta)
|
||||||
*)
|
*)
|
||||||
|
|
||||||
|
let det = Array.make n_det_alfa
|
||||||
|
(Array.init n_det_beta (fun i -> i))
|
||||||
|
in
|
||||||
|
let index_start = Array.init (n_det_alfa+1) (fun i -> i*n_det_beta) in
|
||||||
|
let ndet = (index_start.(n_det_alfa)) in
|
||||||
|
|
||||||
|
Format.printf "Number of determinants : %d %d %d\n%!"
|
||||||
|
n_det_alfa n_det_beta ndet;
|
||||||
|
Arbitrary {
|
||||||
|
det_alfa ; det_beta ; det ; index_start
|
||||||
|
}
|
||||||
in
|
in
|
||||||
{ n_alfa ; n_beta ; mo_class ; mo_basis ; determinants }
|
{ n_alfa ; n_beta ; mo_class ; mo_basis ; determinants }
|
||||||
|
|
@ -49,7 +49,7 @@ doc: QCaml.odocl
|
|||||||
$(OCAMLBUILD) -ocamlc ocamlcp $*.byte -use-ocamlfind $(PKGS)
|
$(OCAMLBUILD) -ocamlc ocamlcp $*.byte -use-ocamlfind $(PKGS)
|
||||||
|
|
||||||
clean:
|
clean:
|
||||||
$(OCAMLBUILD) -clean # rm -rf _build $(ALL_EXE) *.native *.byte
|
rm QCaml.odocl && $(OCAMLBUILD) -clean
|
||||||
|
|
||||||
debug: run_integrals.native
|
debug: run_integrals.native
|
||||||
./debug.sh
|
./debug.sh
|
||||||
|
@ -56,13 +56,13 @@ let () =
|
|||||||
in
|
in
|
||||||
|
|
||||||
let space =
|
let space =
|
||||||
Determinant_space.fci_of_mo_basis ~frozen_core:false mos
|
DeterminantSpace.fci_of_mo_basis ~frozen_core:false mos
|
||||||
in
|
in
|
||||||
let ci = CI.make space in
|
let ci = CI.make space in
|
||||||
Format.fprintf ppf "FCI energy : %20.16f@." ((CI.eigenvalues ci).{1} +. Simulation.nuclear_repulsion s);
|
Format.fprintf ppf "FCI energy : %20.16f@." ((CI.eigenvalues ci).{1} +. Simulation.nuclear_repulsion s);
|
||||||
(*
|
(*
|
||||||
let s2 = Util.xt_o_x ~o:(CI.s2_matrix ci) ~x:(CI.eigenvectors ci) in
|
let s2 = Util.xt_o_x ~o:(CI.s2_matrix ci) ~x:(CI.eigenvectors ci) in
|
||||||
Util.list_range 1 (Determinant_space.size space)
|
Util.list_range 1 (DeterminantSpace.size space)
|
||||||
|> List.iter (fun i -> Format.printf "@[%f@]@;" s2.{i,i});
|
|> List.iter (fun i -> Format.printf "@[%f@]@;" s2.{i,i});
|
||||||
*)
|
*)
|
||||||
|
|
||||||
|
Loading…
Reference in New Issue
Block a user