10
1
mirror of https://gitlab.com/scemama/QCaml.git synced 2024-12-21 20:03:32 +01:00

Improved EN

This commit is contained in:
Anthony Scemama 2020-03-27 18:20:52 +01:00
parent 3901749698
commit 0e2325bdf4
2 changed files with 170 additions and 118 deletions

View File

@ -973,7 +973,35 @@ let is_internal det_space =
Bitstring.logand neg_active_mask beta = occ_mask
let _pt2_en ci =
let is_external det_space =
let mo_class = DeterminantSpace.mo_class det_space in
let numbits = Array.length @@ MOClass.mo_class_array mo_class in
let m l =
List.fold_left (fun accu i ->
let j = i-1 in
Bitstring.logor accu (Bitstring.shift_left_one numbits j)
) (Bitstring.zero numbits) l
in
let inactive_mask = m (MOClass.inactive_mos mo_class) in
fun a ->
let alfa =
Determinant.alfa a
|> Spindeterminant.bitstring
in
let n_a =
Bitstring.(popcount @@ logand inactive_mask alfa)
in
match n_a with
| 0 | 1 | 2 ->
let beta =
Determinant.beta a
|> Spindeterminant.bitstring
in
n_a + Bitstring.(popcount @@ logand inactive_mask beta) < 3
| _ -> false
let pt2_en ci =
let mo_basis = Ds.mo_basis ci.det_space in
let psi0, e0 = Parallel.broadcast ci.eigensystem in
@ -1038,7 +1066,7 @@ let _pt2_en ci =
|> List.fold_left (+.) 0.
let pt2_en ci =
let _pt2_en ci =
let mo_basis = Ds.mo_basis ci.det_space in
let psi0, e0 = Parallel.broadcast ci.eigensystem in
@ -1117,11 +1145,37 @@ let pt2_en_reference ci =
let ds =
DeterminantSpace.fci_of_mo_basis ~frozen_core:false aux_basis
in
let det_stream =
let e =
let f = is_external ci.det_space in
function
| None -> false
| Some d -> f d
in
let stream =
DeterminantSpace.determinant_stream ds
in
let rec next i =
let det =
try
Some (Stream.next stream)
with Stream.Failure -> None
in
if det = None then
None
else
if e det then
det
else
(next [@tailcall]) i
in
Stream.from next
in
let out_dets =
ds
|> DeterminantSpace.determinants_array
|> Array.to_list
|> List.filter (fun i -> not (is_internal ci.det_space i))
det_stream
|> stream_to_list
|> Array.of_list
in

View File

@ -95,10 +95,8 @@ let () =
if Parallel.master then
Format.fprintf ppf "CAS-CI energy : %20.16f@." ((CI.eigenvalues ci).{1} +. Simulation.nuclear_repulsion s);
(*
let pt2 = CI.pt2_mp ci in
Format.fprintf ppf "CAS-MP2 energy : %20.16f@." ((CI.eigenvalues ci).{1} +. Simulation.nuclear_repulsion s +. pt2);
*)
let pt2 = CI.pt2_en ci in