LCPQ
/
QCaml
mirror of https://gitlab.com/scemama/QCaml.git
10
1
Fork 0
Code Releases Activity

PT2 is not working yet

This commit is contained in:
Anthony Scemama 2019-03-18 19:17:15 +01:00
parent 2c8a303e40
commit bf3ffb652d
5 changed files with 203 additions and 40 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

163
CI/CI.ml
View File

@ -385,12 +385,14 @@ let make ?(n_states=1) det_space =
(*
let pt2 { det_space ; m_H ; m_S2 ; eigensystem ; n_states } =
let mo_basis = Ds.mo_basis det_space in
let mo_class = DeterminantSpace.mo_class det_space in
let mo_indices =
let cls = MOClass.mo_class_array (DeterminantSpace.mo_class det_space) in
Util.list_range 1 (Ds.mo_basis det_space |> MOBasis.size)
let cls = MOClass.mo_class_array mo_class in
Util.list_range 1 (MOBasis.size mo_basis)
|> List.filter (fun i -> match cls.(i) with
| MOClass.Deleted _
| MOClass.Core _ -> false
@ -398,6 +400,7 @@ let pt2 { det_space ; m_H ; m_S2 ; eigensystem ; n_states } =
)
in
(* Only the gournd state is computed here *)
let psi0, e0 = Lazy.force eigensystem in
let psi0 =
@ -405,44 +408,128 @@ let pt2 { det_space ; m_H ; m_S2 ; eigensystem ; n_states } =
Ds.determinant_stream det_space
in
Array.init (Ds.size det_space) (fun i ->
(Stream.next stream, psi0.{i,1})
Stream.next stream, psi0.{i+1,1})
in
let e0 = e0.{1} in
let det_contribution i =
let psi_filtered =
List.filter (fun (det, _) ->
Determinant.degree det i < 4) psi0
(*
let is_internal =
let m l =
List.fold_left (fun accu i ->
let j = i-1 in Z.(logor accu (shift_left one j))
) Z.zero l
in
List.fold_left (fun accu spin1 ->
accu +.
List.fold_left (fun accu particle ->
accu +.
List.fold_left (fun accu hole ->
let alfa =
Determinant.single_excitation spin1 hole particle i
in
if Determinant.is_none alfa then
accu
else
let psi_h_alfa =
Array.fold_left (fun (det, coef) ->
coef *. (h_ij det alfa)
) 0. psi_filtered
in
let h_aa = h_ij alfa alfa in
accu +. psi_h_alfa *. psi_h_alfa / (e0 - h_aa)
) 0. mo_indices
) 0. mo_indices
) 0. [ Spin.Alfa ; Spin.Beta ]
let active_mask = m (MOClass.active_mos mo_class) in
let occ_mask = m (MOClass.core_mos mo_class) in
let inactive_mask = m (MOClass.inactive_mos mo_class) in
let occ_mask = Z.logor occ_mask inactive_mask in
let neg_active_mask = Z.lognot active_mask in
fun a ->
let alfa =
Determinant.alfa a
|> Spindeterminant.bitstring
in
if Z.logand neg_active_mask alfa <> occ_mask then
false
else
let beta =
Determinant.beta a
|> Spindeterminant.bitstring
in
Z.logand neg_active_mask beta = occ_mask
in
*)
let det_contribution i =
let psi_filtered_idx =
let rec aux accu = function
| j when j <= i -> List.rev accu
| j -> if Determinant.degree (fst psi0.(i)) (fst psi0.(j)) < 4 then
aux (j::accu) (j-1)
else
aux accu (j-1)
in aux [] (Array.length psi0 - 1)
in
let psi_filtered =
List.map (fun i -> psi0.(i)) psi_filtered_idx
in
let psi_h alfa =
let hij = h_ij mo_basis alfa in
List.fold_left (fun accu (det, coef) ->
accu +. coef *. (hij det)) 0. psi_filtered
in
let is_internal alfa =
let rec aux = function
| -1 -> false
| j -> Determinant.degree (fst psi0.(j)) alfa = 0 || aux (j-1)
in
aux (Array.length psi0 - 1)
in
let already_generated alfa =
if is_internal alfa then
true
else
let rec aux = function
| -1 -> false
| j -> Determinant.degree (fst psi0.(j)) alfa <= 2 || aux (j-1)
in
aux (i-1)
in
let det_i = fst psi0.(i) in
List.fold_left (fun accu particle ->
accu +.
List.fold_left (fun accu hole ->
if hole = particle then accu else
accu +.
List.fold_left (fun accu spin ->
let alfa =
Determinant.single_excitation spin hole particle det_i
in
if Determinant.is_none alfa then accu else
let single =
if already_generated alfa then 0. else
let h_aa = h_ij mo_basis alfa alfa in
let psi_h_alfa = psi_h alfa in
psi_h_alfa *. psi_h_alfa /. (e0 -. h_aa)
in
let double =
List.fold_left (fun accu particle' ->
accu +.
List.fold_left (fun accu hole' ->
accu +.
List.fold_left (fun accu spin' ->
let alfa =
Determinant.double_excitation
spin hole particle
spin' hole' particle' det_i
in
if Determinant.is_none alfa ||
already_generated alfa then
accu
else
let h_aa = h_ij mo_basis alfa alfa in
let psi_h_alfa = psi_h alfa in
accu +. psi_h_alfa *. psi_h_alfa /. (e0 -. h_aa)
) 0. [ Spin.Alfa ; Spin.Beta ]
) 0. mo_indices
) 0. mo_indices
in
accu +. single +. double
) 0. [ Spin.Alfa ; Spin.Beta ]
) 0. mo_indices
) 0. mo_indices
in
Array.mapi (fun i (_,c_i) -> c_i *. det_contribution i) psi0
|> Array.fold_left (+.) 0.
match det_space with
| Ds.Arbitrary -> assert false
| Ds.Spin alfa_dets beta_dets ->
Array.map ( fun alfa ->
Array.map ( fun beta ->
) beta_dets
) alfa_dets
*)

40
CI/DeterminantSpace.ml
View File

@ -154,6 +154,46 @@ let determinant t i =
Determinant.of_spindeterminants alfa beta
let cas_of_mo_basis mo_basis n m =
let s = MOBasis.simulation mo_basis in
let e = Simulation.electrons s in
let n_alfa = Electrons.n_alfa e
and n_beta = Electrons.n_beta e in
let det_a =
Ss.cas_of_mo_basis mo_basis n_alfa n m
and det_b =
Ss.cas_of_mo_basis mo_basis n_beta n m
in
let mo_class = Ss.mo_class det_a in
let determinants =
let det_alfa = Ss.spin_determinants det_a
and det_beta = Ss.spin_determinants det_b
in
let n_det_beta = Array.length det_beta in
let n_det_alfa = Array.length det_alfa in
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
{ n_alfa ; n_beta ; mo_class ; mo_basis ; determinants }
let fci_of_mo_basis ?(frozen_core=true) mo_basis =
let s = MOBasis.simulation mo_basis in
let e = Simulation.electrons s in

4
CI/DeterminantSpace.mli
View File

@ -51,6 +51,10 @@ val fci_of_mo_basis : ?frozen_core:bool -> MOBasis.t -> t
All other MOs are untouched.
*)
val cas_of_mo_basis : MOBasis.t -> int -> int -> t
(** Creates a CAS(n,m) space of determinants.
*)
(** {2 Printing} *)
val pp_det_space : Format.formatter -> t -> unit

26
CI/SpindeterminantSpace.ml
View File

@ -24,6 +24,8 @@ let fci_of_mo_basis ?(frozen_core=true) mo_basis elec_num =
and active_mask = m (MOClass.active_mos mo_class)
in
let neg_active_mask = Z.lognot active_mask in
(* Here we generate the FCI space and filter out unwanted determinants
with excitations involving the core electrons. This should be improved. *)
let spin_determinants =
Util.bit_permtutations elec_num mo_num
|> List.filter (fun b -> Z.logand neg_active_mask b = occ_mask)
@ -33,6 +35,30 @@ let fci_of_mo_basis ?(frozen_core=true) mo_basis elec_num =
{ elec_num ; mo_basis ; mo_class ; spin_determinants }
let cas_of_mo_basis mo_basis elec_num n m =
let mo_num = MOBasis.size mo_basis in
let mo_class = MOClass.cas_sd mo_basis n m in
let m l =
List.fold_left (fun accu i -> let j = i-1 in Z.(logor accu (shift_left one j))
) Z.zero l
in
let active_mask = m (MOClass.active_mos mo_class) in
let occ_mask = m (MOClass.core_mos mo_class) in
let inactive_mask = m (MOClass.inactive_mos mo_class) in
let occ_mask = Z.logor occ_mask inactive_mask in
let neg_active_mask = Z.lognot active_mask in
(* Here we generate the FCI space and filter out all the unwanted determinants.
This should be improved. *)
let spin_determinants =
Util.bit_permtutations elec_num mo_num
|> List.filter (fun b -> Z.logand neg_active_mask b = occ_mask)
|> List.map (fun b -> Spindeterminant.of_bitstring b)
|> Array.of_list
in
{ elec_num ; mo_basis ; mo_class ; spin_determinants }
let pp_spindet_space ppf t =
Format.fprintf ppf "@[<v 2>[ ";
Array.iteri (fun i d -> Format.fprintf ppf "@[<v>@[%8d@] @[%a@]@]@;" i

10
CI/SpindeterminantSpace.mli
View File

@ -25,8 +25,14 @@ val mo_basis : t -> MOBasis.t
(** {1 Creation} *)
val fci_of_mo_basis : ?frozen_core:bool -> MOBasis.t -> int -> t
(** Create a space of all possible ways to put [n_elec] electrons in the [Active] MOs.
All other MOs are untouched.
(** Create a space of all possible ways to put [n_elec-ncore] electrons in the
[Active] MOs. All other MOs are untouched.
*)
val cas_of_mo_basis : MOBasis.t -> int -> int -> int -> t
(** [cas_of_mo_basis mo_basis n_elec n m] creates a CAS(n,m) space of
[Active] MOs. The unoccupied MOs are [Virtual], and the occupied MOs
are [Core] and [Inactive].
*)