open Lacaml.D module De = Determinant module Ex = Excitation module Sp = Spindeterminant type t = float list 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 = 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 List.map (fun (one_e, two_e) -> result one_e two_e) integrals let make integrals ki kj = let degree_a, degree_b = De.degrees 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.degree_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.degree_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.