LCPQ/QCaml
10
1
Fork 0
mirror of https://gitlab.com/scemama/QCaml.git synced 2024-11-07 22:53:41 +01:00
Code Releases Activity

F12-FCI maybe works

Browse Source
This commit is contained in:
Anthony Scemama 2019-03-22 00:34:00 +01:00
parent 0d935ea354
commit e09a9011e4
4 changed files with 85 additions and 35 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

8
CI/CI.ml
View File

@ -410,7 +410,7 @@ let make ?(n_states=1) det_space =
let second_order_sum { det_space ; m_H ; m_S2 ; eigensystem ; n_states }
list_holes1 list_particles1
list_holes1 list_particles1 ?(unique=true)
list_holes2 list_particles2
i_o1_alfa alfa_o2_i w_alfa psi0 =
@ -462,7 +462,9 @@ let second_order_sum { det_space ; m_H ; m_S2 ; eigensystem ; n_states }
let det_contribution i =
let already_generated alfa =
let already_generated =
if unique then
(fun alfa ->
if is_internal alfa then
true
else
@ -472,6 +474,8 @@ let second_order_sum { det_space ; m_H ; m_S2 ; eigensystem ; n_states }
|| aux (j-1)
in
aux (i-1)
) else
is_internal
in
let psi_filtered_idx =

82
CI/F12CI.ml
View File

@ -1,3 +1,6 @@
let debug s =
Printf.printf "%s\n%!" s;
open Lacaml.D
type t =
@ -7,13 +10,13 @@ type t =
det_space : DeterminantSpace.t ;
ci : CI.t ;
eigensystem : (Mat.t * Vec.t) lazy_t;
f12_amplitudes : Mat.t;
}
let ci t = t.ci
let mo_basis t = t.mo_basis
let det_space t = t.det_space
let mo_class t = DeterminantSpace.mo_class @@ det_space t
let eigensystem t = Lazy.force t.eigensystem
let f12_integrals mo_basis =
@ -50,6 +53,7 @@ let f_ij mo_basis ki kj =
let dressing_vector f12_amplitudes ci =
debug "Computing dressing vector";
let mo_basis = DeterminantSpace.mo_basis ci.CI.det_space in
let i_o1_alfa = h_ij mo_basis in
@ -65,10 +69,11 @@ let dressing_vector f12_amplitudes ci =
and list_particles2 = List.concat
[ MOClass.active_mos mo_class ; MOClass.virtual_mos mo_class ; MOClass.auxiliary_mos mo_class ]
in
Util.debug_matrix "f12 amplitudes" f12_amplitudes;
(* Single state here *)
let result =
CI.second_order_sum ci list_holes list_particles1 list_holes list_particles2
i_o1_alfa alfa_o2_i w_alfa f12_amplitudes
i_o1_alfa alfa_o2_i w_alfa f12_amplitudes ~unique:false
|> Vec.of_list
in
Matrix.sparse_of_vector_array [| Vector.sparse_of_vec result |]
@ -108,51 +113,94 @@ let make ~simulation ?(threshold=1.e-12) ?(frozen_core=true) ~mo_basis ~aux_basi
let ci = CI.make det_space in
let ci_coef, ci_energy = Parallel.broadcast ci.eigensystem in
let ci_coef, ci_energy =
let x = Lazy.force ci.eigensystem in
Parallel.broadcast (lazy x)
in
let f12_amplitudes =
(* While in a sequential region, initiate the parallel
4-idx transformation to avoid nested parallel jobs
*)
ignore @@ MOBasis.f12_ints mo_basis;
debug "Four-idx transform of f12 intergals";
ignore @@ MOBasis.f12_ints aux_basis;
let f = fun ki kj ->
if ki <> kj then
f_ij mo_basis ki kj
f_ij aux_basis ki kj
else
f_ij mo_basis ki kj +. 1.
f_ij aux_basis ki kj +. 1.
in
debug "Computing F matrix";
let m_F =
CI.create_matrix_spin f det_space
|> Lazy.force
in
fun ci_coef ->
debug "Solving linear system";
Matrix.ax_eq_b m_F (Matrix.dense_of_mat ci_coef)
|> Matrix.to_mat
in
let f_11, e_shift =
let e_shift =
let det =
DeterminantSpace.determinant_stream det_space
|> Stream.next
in
f_ij mo_basis det det,
h_ij mo_basis det det
h_ij aux_basis det det
in
let eigensystem = lazy (
let m_H =
Lazy.force ci.CI.m_H
in
let n_states = ci.CI.n_states in
let rec iteration ?(state=1) psi =
let diagonal =
Vec.init (Matrix.dim1 m_H) (fun i -> Matrix.get m_H i i +. if i=1 then f_11 /. (Matrix.get psi 1 state) else 0. )
debug "Iteration";
let delta =
dressing_vector (f12_amplitudes psi) ci
in
let matrix_prod psi =
Format.printf "Dressing vector : %a\n@." Matrix.pp_matrix delta;
(*------
(*TODO : enlever le double comptage de la symmetrisation*)
*)
let m_H_dressed = Matrix.to_mat m_H in
(Matrix.dim1 delta) (Matrix.dim2 delta) (Mat.dim1 psi) (Mat.dim2 psi) ;
Util.list_range 1 (Mat.dim1 psi)
|> List.iter (fun i -> m_H_dressed.{i,1} <- m_H_dressed.{i,1} +. (Matrix.get delta i 1) /. (psi.{1,1}));
let eigenvectors, eigenvalues =
Util.diagonalize_symm m_H_dressed
in
let m =
gemm ~transa:`T psi eigenvectors
|> Mat.abs
in
let conv =
Mat.sum m -. (Vec.sum (Mat.copy_diag m))
in
Printf.printf "Convergence : %f %f\n" conv eigenvalues.{1};
if conv > threshold then
iteration eigenvectors
else
let eigenvalues =
Vec.map (fun x -> x +. e_shift) eigenvalues
in
eigenvectors, eigenvalues
in
iteration ci_coef
(*
------- *)
(*
let n_states = ci.CI.n_states in
let diagonal =
Vec.init (Matrix.dim1 m_H) (fun i -> Matrix.get m_H i i +. (if i=1 then Matrix.get delta 1 1 else 0.) )
in
let matrix_prod c =
Matrix.add
(Matrix.mm ~transa:`T m_H psi)
(dressing_vector f12_amplitudes ci)
(Matrix.mm ~transa:`T m_H c)
delta
in
let eigenvectors, eigenvalues =
Parallel.broadcast (lazy (
@ -174,8 +222,10 @@ let make ~simulation ?(threshold=1.e-12) ?(frozen_core=true) ~mo_basis ~aux_basi
eigenvectors, eigenvalues
in
iteration (Matrix.dense_of_mat ci_coef)
*)
)
in
{ mo_basis ; aux_basis ; det_space ; ci ; f12_amplitudes ; eigensystem }
{ mo_basis ; aux_basis ; det_space ; ci ; eigensystem }

2
Utils/Matrix.ml
View File

@ -35,7 +35,7 @@ let dim2 = function
let get = function
| Dense m -> (fun i j -> m.{i,j})
| Sparse {m ; n ; v } -> (fun i j -> Vector.get v.(i-1) j)
| Sparse {m ; n ; v } -> (fun i j -> Vector.get v.(j-1) i)
let sparse_of_dense ?(threshold=epsilon) = function

8
run_fci_f12.ml
View File

@ -66,9 +66,5 @@ let () =
in
let ci = F12CI.ci fcif12 in
Format.fprintf ppf "FCI energy : %20.16f@." ((CI.eigenvalues ci).{1} +. Simulation.nuclear_repulsion simulation);
(*
let s2 = Util.xt_o_x ~o:(CI.s2_matrix ci) ~x:(CI.eigenvectors ci) in
Util.list_range 1 (DeterminantSpace.size space)
|> List.iter (fun i -> Format.printf "@[%f@]@;" s2.{i,i});
*)
let _, e_cif12 = F12CI.eigensystem fcif12 in
Format.fprintf ppf "FCI-F12 energy : %20.16f@." (e_cif12.{1} +. Simulation.nuclear_repulsion simulation);