mirror of
https://gitlab.com/scemama/QCaml.git
synced 2024-08-30 00:03:42 +02:00
Merge branch 'master' of gitlab.com:scemama/QCaml
This commit is contained in:
commit
1e778594ec
89
CI/F12CI.ml
89
CI/F12CI.ml
@ -26,20 +26,24 @@ let f12_integrals mo_basis =
|
||||
begin
|
||||
let ijkl = F12.get_phys two_e_ints i j k l
|
||||
in
|
||||
let ijlk = F12.get_phys two_e_ints i j l k
|
||||
in
|
||||
(*
|
||||
if s' = Spin.other s then
|
||||
(* Minus sign because we swap spin variables
|
||||
instead of orbital variables *)
|
||||
0.375 *. ijkl +. 0.125 *. ijlk
|
||||
else
|
||||
0.25 *. (ijkl -. ijlk)
|
||||
*)
|
||||
if s' = Spin.other s then
|
||||
ijkl
|
||||
else
|
||||
let ijlk = F12.get_phys two_e_ints i j l k
|
||||
in
|
||||
ijkl -. ijlk
|
||||
end
|
||||
) )
|
||||
|
||||
|
||||
|
||||
|
||||
let h_ij mo_basis ki kj =
|
||||
let integrals =
|
||||
List.map (fun f -> f mo_basis)
|
||||
@ -57,8 +61,14 @@ let f_ij mo_basis ki kj =
|
||||
CIMatrixElement.make integrals ki kj
|
||||
|> List.hd
|
||||
|
||||
|
||||
|
||||
let hf_ij mo_basis ki kj =
|
||||
[ h_ij mo_basis ki kj ; f_ij mo_basis ki kj ]
|
||||
let integrals =
|
||||
List.map (fun f -> f mo_basis)
|
||||
[ CI.h_integrals ; f12_integrals ]
|
||||
in
|
||||
CIMatrixElement.make integrals ki kj
|
||||
|
||||
|
||||
let is_a_double det_space =
|
||||
@ -70,13 +80,13 @@ let is_a_double det_space =
|
||||
) (Bitstring.zero mo_num) l
|
||||
in
|
||||
let aux_mask = m (MOClass.auxiliary_mos mo_class) in
|
||||
fun a ->
|
||||
fun k ->
|
||||
let alfa =
|
||||
Determinant.alfa a
|
||||
Determinant.alfa k
|
||||
|> Spindeterminant.bitstring
|
||||
in
|
||||
let beta =
|
||||
Determinant.beta a
|
||||
Determinant.beta k
|
||||
|> Spindeterminant.bitstring
|
||||
in
|
||||
let a = Bitstring.logand aux_mask alfa
|
||||
@ -87,6 +97,43 @@ let is_a_double det_space =
|
||||
| _ -> false
|
||||
|
||||
|
||||
let p12 det_space =
|
||||
let mo_class = DeterminantSpace.mo_class det_space in
|
||||
let mo_num = 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 mo_num j)
|
||||
) (Bitstring.zero mo_num) l
|
||||
in
|
||||
let aux_mask = m (MOClass.auxiliary_mos mo_class) in
|
||||
let not_aux_mask =
|
||||
Bitstring.(shift_left_one mo_num mo_num |> minus_one)
|
||||
in
|
||||
fun k ->
|
||||
let alfa =
|
||||
Determinant.alfa k
|
||||
|> Spindeterminant.bitstring
|
||||
in
|
||||
let beta =
|
||||
Determinant.beta k
|
||||
|> Spindeterminant.bitstring
|
||||
in
|
||||
let a = Bitstring.logand aux_mask alfa
|
||||
and b = Bitstring.logand aux_mask beta
|
||||
in
|
||||
match Bitstring.popcount a, Bitstring.popcount b with
|
||||
| 2, 0
|
||||
| 0, 2 -> Some (Determinant.negate_phase k)
|
||||
| 1, 1 -> Some (Determinant.of_spindeterminants
|
||||
(Spindeterminant.of_bitstring @@
|
||||
Bitstring.(logor b (logand not_aux_mask alfa)) )
|
||||
(Spindeterminant.of_bitstring @@
|
||||
Bitstring.(logor a (logand not_aux_mask beta))
|
||||
) )
|
||||
| _ -> None
|
||||
|
||||
|
||||
|
||||
let dressing_vector ~frozen_core aux_basis f12_amplitudes ci =
|
||||
|
||||
if Parallel.master then
|
||||
@ -110,12 +157,12 @@ let dressing_vector ~frozen_core aux_basis f12_amplitudes ci =
|
||||
(* Select only doubly excited determinants wrt FCI space *)
|
||||
Stream.from (fun _ ->
|
||||
try
|
||||
let p12 = p12 ci.CI.det_space in
|
||||
let rec result () =
|
||||
let ki = Stream.next s in
|
||||
if not (is_a_double ci.CI.det_space ki) then
|
||||
result ()
|
||||
else
|
||||
Some ki
|
||||
match p12 ki with
|
||||
| Some ki' -> Some (ki, ki')
|
||||
| None -> result ()
|
||||
in
|
||||
result ()
|
||||
with Stream.Failure -> None
|
||||
@ -128,20 +175,26 @@ let dressing_vector ~frozen_core aux_basis f12_amplitudes ci =
|
||||
| [] ->
|
||||
List.rev accu_H,
|
||||
List.rev accu_F
|
||||
| ki :: rest ->
|
||||
| (ki, ki') :: rest ->
|
||||
begin
|
||||
let h, f =
|
||||
List.map (fun kj ->
|
||||
match hf_ij aux_basis ki kj with
|
||||
match hf_ij aux_basis kj ki with
|
||||
| [ a ; b ] -> a, b
|
||||
| _ -> assert false ) in_dets
|
||||
|> List.split
|
||||
in
|
||||
let h =
|
||||
Vec.of_list h
|
||||
and f =
|
||||
Vec.of_list f
|
||||
let f' =
|
||||
List.map (fun kj -> f_ij aux_basis kj ki') in_dets
|
||||
in
|
||||
let h = Vec.of_list h in
|
||||
let f = Vec.of_list f in
|
||||
let f' = Vec.of_list f' in
|
||||
scal 0.375 f;
|
||||
scal 0.125 f';
|
||||
let f = Vec.add f f' in
|
||||
col_vecs_list (h::accu_H) (f::accu_F) rest
|
||||
end
|
||||
in
|
||||
let h, f =
|
||||
col_vecs_list [] [] alpha_list
|
||||
|
Loading…
Reference in New Issue
Block a user