mirror of
https://gitlab.com/scemama/QCaml.git
synced 2024-12-23 04:43:32 +01:00
284 lines
9.7 KiB
OCaml
284 lines
9.7 KiB
OCaml
|
open Common
|
||
|
|
|
||
|
|
module De = Determinant
|
||
|
|
module Ex = Excitation
|
||
|
|
module Sp = Spindeterminant
|
||
|
|
|
||
|
|
type t = float list
|
||
|
|
|
||
|
|
|
||
|
|
|
||
|
|
(** Computes non-zero integral values.
|
||
|
|
|
||
|
|
@param integrals A list of tuples containing one-electron, two-electron integrals, and optionally three-electron integrals.
|
||
|
|
@param degree_a The degree of excitation in alpha spin orbitals.
|
||
|
|
@param degree_b The degree of excitation in beta spin orbitals.
|
||
|
|
@param ki The initial Slater determinant.
|
||
|
|
@param kj The final Slater determinant.
|
||
|
|
|
||
|
|
|
||
|
|
@return TODO A list of computed integral values based on the specified degrees and molecular orbitals.
|
||
|
|
|
||
|
|
This function performs the following operations:
|
||
|
|
- Converts spin determinants to lists of molecular orbitals for alpha and beta spins.
|
||
|
|
- Defines helper functions for singly and doubly excited determinants, and diagonal elements
|
||
|
|
- Uses lazy evaluation to defer computations until required.
|
||
|
|
- Supports both two-electron and three-electron integrals, handling phase factors appropriately.
|
||
|
|
|
||
|
|
Example usage:
|
||
|
|
{[
|
||
|
|
let integrals = [(one_e_integral, two_e_integral, None); (one_e_integral, two_e_integral, Some three_e_integral)] in
|
||
|
|
let result = non_zero integrals 1 1 ki kj
|
||
|
|
]}
|
||
|
|
|
||
|
|
*)
|
||
|
|
|
||
|
|
let non_zero integrals degree_a degree_b ki kj =
|
||
|
|
let kia = De.alfa ki and kib = De.beta ki
|
||
|
|
and kja = De.alfa kj and kjb = De.beta kj
|
||
|
|
in
|
||
|
|
|
||
|
|
let single h p spin same opposite =
|
||
|
|
let same_spin_mo_list =
|
||
|
|
Sp.to_list same
|
||
|
|
and opposite_spin_mo_list =
|
||
|
|
Sp.to_list opposite
|
||
|
|
in
|
||
|
|
fun one_e two_e ->
|
||
|
|
let same_spin =
|
||
|
|
List.fold_left (fun accu i -> accu +. two_e h i p i spin spin) 0. same_spin_mo_list
|
||
|
|
and opposite_spin =
|
||
|
|
List.fold_left (fun accu i -> accu +. two_e h i p i spin (Spin.other spin) ) 0. opposite_spin_mo_list
|
||
|
|
in (one_e h p spin) +. same_spin +. opposite_spin
|
||
|
|
in
|
||
|
|
|
||
|
|
let diag_element =
|
||
|
|
let mo_a = Sp.to_list kia
|
||
|
|
and mo_b = Sp.to_list kib
|
||
|
|
in
|
||
|
|
fun one_e two_e ->
|
||
|
|
let one =
|
||
|
|
(List.fold_left (fun accu i -> accu +. one_e i i Spin.Alfa) 0. mo_a)
|
||
|
|
+.
|
||
|
|
(List.fold_left (fun accu i -> accu +. one_e i i Spin.Beta) 0. mo_b)
|
||
|
|
in
|
||
|
|
let two =
|
||
|
|
let rec aux_same spin accu = function
|
||
|
|
| [] -> accu
|
||
|
|
| i :: rest ->
|
||
|
|
let new_accu =
|
||
|
|
List.fold_left (fun accu j -> accu +. two_e i j i j spin spin) accu rest
|
||
|
|
in
|
||
|
|
(aux_same [@tailcall]) spin new_accu rest
|
||
|
|
in
|
||
|
|
let rec aux_opposite accu other = function
|
||
|
|
| [] -> accu
|
||
|
|
| i :: rest ->
|
||
|
|
let new_accu =
|
||
|
|
List.fold_left (fun accu j -> accu +. two_e i j i j Spin.Alfa Spin.Beta) accu other
|
||
|
|
in
|
||
|
|
(aux_opposite [@tailcall]) new_accu other rest
|
||
|
|
in
|
||
|
|
(aux_same Spin.Alfa 0. mo_a) +. (aux_same Spin.Beta 0. mo_b) +.
|
||
|
|
(aux_opposite 0. mo_a mo_b)
|
||
|
|
in
|
||
|
|
one +. two
|
||
|
|
in
|
||
|
|
|
||
|
|
let result_2e = lazy (
|
||
|
|
match degree_a, degree_b with
|
||
|
|
| 1, 1 -> (* alpha-beta double *)
|
||
|
|
begin
|
||
|
|
let ha, pa, phase_a = Ex.single_of_spindet kia kja in
|
||
|
|
let hb, pb, phase_b = Ex.single_of_spindet kib kjb in
|
||
|
|
match phase_a, phase_b with
|
||
|
|
| Phase.Pos, Phase.Pos
|
||
|
|
| Phase.Neg, Phase.Neg -> fun _ two_e -> two_e ha hb pa pb Spin.Alfa Spin.Beta
|
||
|
|
| Phase.Neg, Phase.Pos
|
||
|
|
| Phase.Pos, Phase.Neg -> fun _ two_e -> -. two_e ha hb pa pb Spin.Alfa Spin.Beta
|
||
|
|
end
|
||
|
|
|
||
|
|
| 2, 0 -> (* alpha double *)
|
||
|
|
begin
|
||
|
|
let h1, p1, h2, p2, phase = Ex.double_of_spindet kia kja in
|
||
|
|
match phase with
|
||
|
|
| Phase.Pos -> fun _ two_e -> two_e h1 h2 p1 p2 Spin.Alfa Spin.Alfa
|
||
|
|
| Phase.Neg -> fun _ two_e -> -. two_e h1 h2 p1 p2 Spin.Alfa Spin.Alfa
|
||
|
|
end
|
||
|
|
|
||
|
|
| 0, 2 -> (* beta double *)
|
||
|
|
begin
|
||
|
|
let h1, p1, h2, p2, phase = Ex.double_of_spindet kib kjb in
|
||
|
|
match phase with
|
||
|
|
| Phase.Pos -> fun _ two_e -> two_e h1 h2 p1 p2 Spin.Beta Spin.Beta
|
||
|
|
| Phase.Neg -> fun _ two_e -> -. two_e h1 h2 p1 p2 Spin.Beta Spin.Beta
|
||
|
|
end
|
||
|
|
|
||
|
|
| 1, 0 -> (* alpha single *)
|
||
|
|
begin
|
||
|
|
let h, p, phase = Ex.single_of_spindet kia kja in
|
||
|
|
match phase with
|
||
|
|
| Phase.Pos -> fun one_e two_e -> single h p Spin.Alfa kia kib one_e two_e
|
||
|
|
| Phase.Neg -> fun one_e two_e -> -. single h p Spin.Alfa kia kib one_e two_e
|
||
|
|
end
|
||
|
|
|
||
|
|
| 0, 1 -> (* beta single *)
|
||
|
|
begin
|
||
|
|
let h, p, phase = Ex.single_of_spindet kib kjb in
|
||
|
|
match phase with
|
||
|
|
| Phase.Pos -> fun one_e two_e -> single h p Spin.Beta kib kia one_e two_e
|
||
|
|
| Phase.Neg -> fun one_e two_e -> -. single h p Spin.Beta kib kia one_e two_e
|
||
|
|
end
|
||
|
|
|
||
|
|
| 0, 0 -> (* diagonal element *)
|
||
|
|
diag_element
|
||
|
|
|
||
|
|
| _ -> assert false
|
||
|
|
) in
|
||
|
|
|
||
|
|
let result_3e = lazy (
|
||
|
|
match degree_a, degree_b with
|
||
|
|
| 1, 1 -> (* alpha-beta double *)
|
||
|
|
begin
|
||
|
|
let ha, pa, phase_a = Ex.single_of_spindet kia kja in
|
||
|
|
let hb, pb, phase_b = Ex.single_of_spindet kib kjb in
|
||
|
|
match phase_a, phase_b with
|
||
|
|
| Phase.Pos, Phase.Pos
|
||
|
|
| Phase.Neg, Phase.Neg -> fun _ two_e _ -> two_e ha hb pa pb Spin.Alfa Spin.Beta
|
||
|
|
| Phase.Neg, Phase.Pos
|
||
|
|
| Phase.Pos, Phase.Neg -> fun _ two_e _ -> -. two_e ha hb pa pb Spin.Alfa Spin.Beta
|
||
|
|
end
|
||
|
|
|
||
|
|
| 2, 0 -> (* alpha double *)
|
||
|
|
begin
|
||
|
|
let h1, p1, h2, p2, phase = Ex.double_of_spindet kia kja in
|
||
|
|
match phase with
|
||
|
|
| Phase.Pos -> fun _ two_e _ -> two_e h1 h2 p1 p2 Spin.Alfa Spin.Alfa
|
||
|
|
| Phase.Neg -> fun _ two_e _ -> -. two_e h1 h2 p1 p2 Spin.Alfa Spin.Alfa
|
||
|
|
end
|
||
|
|
|
||
|
|
| 0, 2 -> (* beta double *)
|
||
|
|
begin
|
||
|
|
let h1, p1, h2, p2, phase = Ex.double_of_spindet kib kjb in
|
||
|
|
match phase with
|
||
|
|
| Phase.Pos -> fun _ two_e _ -> two_e h1 h2 p1 p2 Spin.Beta Spin.Beta
|
||
|
|
| Phase.Neg -> fun _ two_e _ -> -. two_e h1 h2 p1 p2 Spin.Beta Spin.Beta
|
||
|
|
end
|
||
|
|
|
||
|
|
| 1, 0 -> (* alpha single *)
|
||
|
|
begin
|
||
|
|
let h, p, phase = Ex.single_of_spindet kia kja in
|
||
|
|
match phase with
|
||
|
|
| Phase.Pos -> fun one_e two_e _ -> single h p Spin.Alfa kia kib one_e two_e
|
||
|
|
| Phase.Neg -> fun one_e two_e _ -> -. single h p Spin.Alfa kia kib one_e two_e
|
||
|
|
end
|
||
|
|
|
||
|
|
| 0, 1 -> (* beta single *)
|
||
|
|
begin
|
||
|
|
let h, p, phase = Ex.single_of_spindet kib kjb in
|
||
|
|
match phase with
|
||
|
|
| Phase.Pos -> fun one_e two_e _ -> single h p Spin.Beta kib kia one_e two_e
|
||
|
|
| Phase.Neg -> fun one_e two_e _ -> -. single h p Spin.Beta kib kia one_e two_e
|
||
|
|
end
|
||
|
|
|
||
|
|
| 0, 0 -> (* diagonal element *)
|
||
|
|
fun one_e two_e _ -> diag_element one_e two_e
|
||
|
|
|
||
|
|
| 3, 0 -> (* alpha triple *)
|
||
|
|
begin
|
||
|
|
let h1, p1, h2, p2, h3, p3, phase = Ex.triple_of_spindet kia kja in
|
||
|
|
match phase with
|
||
|
|
| Phase.Pos -> fun _ _ three_e -> three_e h1 h2 h3 p1 p2 p3 Spin.Alfa Spin.Alfa Spin.Alfa
|
||
|
|
| Phase.Neg -> fun _ _ three_e -> -. three_e h1 h2 h3 p1 p2 p3 Spin.Alfa Spin.Alfa Spin.Alfa
|
||
|
|
end
|
||
|
|
|
||
|
|
| 0, 3 -> (* beta triple *)
|
||
|
|
begin
|
||
|
|
let h1, p1, h2, p2, h3, p3, phase = Ex.triple_of_spindet kib kja in
|
||
|
|
match phase with
|
||
|
|
| Phase.Pos -> fun _ _ three_e -> three_e h1 h2 h3 p1 p2 p3 Spin.Beta Spin.Beta Spin.Beta
|
||
|
|
| Phase.Neg -> fun _ _ three_e -> -. three_e h1 h2 h3 p1 p2 p3 Spin.Beta Spin.Beta Spin.Beta
|
||
|
|
end
|
||
|
|
|
||
|
|
| 2, 1 -> (* alpha2 beta triple *)
|
||
|
|
begin
|
||
|
|
let h1, p1, h2, p2, phase = Ex.double_of_spindet kia kja in
|
||
|
|
let h3, p3, phase' = Ex.single_of_spindet kib kjb in
|
||
|
|
match phase, phase' with
|
||
|
|
| Phase.Pos, Phase.Pos
|
||
|
|
| Phase.Neg, Phase.Neg ->
|
||
|
|
fun _ _ three_e -> three_e h1 h2 h3 p1 p2 p3 Spin.Alfa Spin.Alfa Spin.Beta
|
||
|
|
| Phase.Neg, Phase.Pos
|
||
|
|
| Phase.Pos, Phase.Neg ->
|
||
|
|
fun _ _ three_e -> -. three_e h1 h2 h3 p1 p2 p3 Spin.Alfa Spin.Alfa Spin.Beta
|
||
|
|
end
|
||
|
|
|
||
|
|
| 1, 2 -> (* alpha beta2 triple *)
|
||
|
|
begin
|
||
|
|
let h1, p1, phase = Ex.single_of_spindet kia kja in
|
||
|
|
let h2, p2, h3, p3, phase' = Ex.double_of_spindet kib kjb in
|
||
|
|
match phase, phase' with
|
||
|
|
| Phase.Pos, Phase.Pos
|
||
|
|
| Phase.Neg, Phase.Neg ->
|
||
|
|
fun _ _ three_e -> three_e h1 h2 h3 p1 p2 p3 Spin.Alfa Spin.Beta Spin.Beta
|
||
|
|
| Phase.Neg, Phase.Pos
|
||
|
|
| Phase.Pos, Phase.Neg ->
|
||
|
|
fun _ _ three_e -> -. three_e h1 h2 h3 p1 p2 p3 Spin.Alfa Spin.Beta Spin.Beta
|
||
|
|
end
|
||
|
|
|
||
|
|
| _ -> fun _ _ _ -> 0.
|
||
|
|
) in
|
||
|
|
|
||
|
|
List.map (fun (one_e, two_e, x) ->
|
||
|
|
match x with
|
||
|
|
| None -> (Lazy.force result_2e) one_e two_e
|
||
|
|
| Some three_e -> (Lazy.force result_3e) one_e two_e three_e
|
||
|
|
) integrals
|
||
|
|
|
||
|
|
|
||
|
|
|
||
|
|
let make integrals ki kj =
|
||
|
|
let degree_a, degree_b =
|
||
|
|
De.excitation_levels ki kj
|
||
|
|
in
|
||
|
|
if degree_a+degree_b > 2 then
|
||
|
|
List.map (fun _ -> 0.) integrals
|
||
|
|
else
|
||
|
|
non_zero integrals degree_a degree_b ki kj
|
||
|
|
|
||
|
|
|
||
|
|
|
||
|
|
|
||
|
|
let make_s2 ki kj =
|
||
|
|
let degree_a = De.excitation_level_alfa ki kj in
|
||
|
|
let kia = De.alfa ki in
|
||
|
|
let kja = De.alfa kj in
|
||
|
|
if degree_a > 1 then 0.
|
||
|
|
else
|
||
|
|
let degree_b = De.excitation_level_beta ki kj in
|
||
|
|
let kib = De.beta ki in
|
||
|
|
let kjb = De.beta kj in
|
||
|
|
match degree_a, degree_b with
|
||
|
|
| 1, 1 -> (* alpha-beta double *)
|
||
|
|
let ha, pa, phase_a = Ex.single_of_spindet kia kja in
|
||
|
|
let hb, pb, phase_b = Ex.single_of_spindet kib kjb in
|
||
|
|
if ha = pb && hb = pa then
|
||
|
|
begin
|
||
|
|
match phase_a, phase_b with
|
||
|
|
| Phase.Pos, Phase.Pos
|
||
|
|
| Phase.Neg, Phase.Neg -> -1.
|
||
|
|
| Phase.Neg, Phase.Pos
|
||
|
|
| Phase.Pos, Phase.Neg -> 1.
|
||
|
|
end
|
||
|
|
else 0.
|
||
|
|
| 0, 0 ->
|
||
|
|
let ba = Sp.bitstring kia and bb = Sp.bitstring kib in
|
||
|
|
let tmp = Bitstring.logxor ba bb in
|
||
|
|
let n_a = Bitstring.logand ba tmp |> Bitstring.popcount in
|
||
|
|
let n_b = Bitstring.logand bb tmp |> Bitstring.popcount in
|
||
|
|
let s_z = 0.5 *. float_of_int (n_a - n_b) in
|
||
|
|
float_of_int n_a +. s_z *. (s_z -. 1.)
|
||
|
|
| _ -> 0.
|
||
|
|
|
||
|
|
|