mirror of
https://gitlab.com/scemama/QCaml.git
synced 2024-11-09 07:33:40 +01:00
330 KiB
330 KiB
None
<html>
<head>
</head>
</html>
Test of F12 matrix elements¶
Initialization¶
In [5]:
let png_image = print_endline ;;
(* --------- *)
#cd "/home/scemama/QCaml";;
#use "topfind";;
#require "jupyter.notebook";;
let png_image name =
Jupyter_notebook.display_file ~base64:true "image/png" ("Notebooks/images/"^name)
;;
#require "lacaml.top";;
#require "alcotest";;
#require "str";;
#require "bigarray";;
#require "zarith";;
#require "getopt";;
#directory "_build";;
#directory "_build/Basis";;
#directory "_build/CI";;
#directory "_build/MOBasis";;
#directory "_build/Nuclei";;
#directory "_build/Parallel";;
#directory "_build/Perturbation";;
#directory "_build/SCF";;
#directory "_build/Utils";;
Out[5]:
Out[5]:
Modules¶
In [6]:
#load "Constants.cmo";;
#load_rec "Util.cma";;
#load_rec "Matrix.cmo";;
#load_rec "Simulation.cmo";;
#load_rec "Spindeterminant.cmo";;
#load_rec "Determinant.cmo";;
#load_rec "HartreeFock.cmo";;
#load_rec "MOBasis.cmo";;
#load_rec "F12CI.cmo";;
Printers¶
In [7]:
#install_printer AngularMomentum.pp_string ;;
#install_printer Basis.pp ;;
#install_printer Charge.pp ;;
#install_printer Coordinate.pp ;;
#install_printer Vector.pp;;
#install_printer Matrix.pp;;
#install_printer Util.pp_float_2darray;;
#install_printer Util.pp_float_array;;
#install_printer Util.pp_matrix;;
#install_printer HartreeFock.pp ;;
#install_printer Fock.pp ;;
#install_printer MOClass.pp ;;
let pp_mo ppf t = MOBasis.pp ~start:1 ~finish:0 ppf t ;;
#install_printer pp_mo;;
(*
#install_printer DeterminantSpace.pp;;
*)
#install_printer SpindeterminantSpace.pp;;
#install_printer Bitstring.pp;;
(* --------- *)
open Lacaml.D
Out[7]:
Run¶
Simulation¶
In [10]:
let basis_filename = "/home/scemama/qp2/data/basis/6-31g"
let aux_basis_filename = "/home/scemama/qp2/data/basis/cc-pvdz"
let nuclei = Nuclei.of_zmt_string "c"
let frozen_core = false
let multiplicity = 1
let state = 1
let f12 = F12factor.gaussian_geminal 1.0
let basis = Basis.of_nuclei_and_basis_filenames ~f12 ~nuclei [basis_filename]
let aux_basis = Basis.of_nuclei_and_basis_filenames ~nuclei (basis_filename :: aux_basis_filename :: [])
let charge = 0
let simulation =
Simulation.make
~charge ~multiplicity ~nuclei
~cartesian:true
basis
Out[10]:
Out[10]:
Out[10]:
Out[10]:
Out[10]:
Out[10]:
Out[10]:
Out[10]:
Out[10]:
Out[10]:
Out[10]:
In [11]:
let n_elec_alfa, n_elec_beta, n_elec =
let e = Simulation.electrons simulation in
Electrons.(n_alfa e, n_beta e, n_elec e)
Out[11]:
Hartree-Fock¶
In [12]:
let hf = HartreeFock.make ~guess:`Hcore ~max_scf:1 simulation ;;
let mo_basis = MOBasis.of_hartree_fock hf
Out[12]:
Out[12]:
FCI-F12¶
Common functions¶
In [13]:
let f12 = Util.of_some @@ Simulation.f12 simulation
let mo_num = MOBasis.size mo_basis
let pp_spindet = Spindeterminant.pp mo_num
let pp_det = Determinant.pp mo_num
;;
#install_printer pp_spindet ;;
#install_printer pp_det ;;
Out[13]:
Out[13]:
Out[13]:
Out[13]:
In [17]:
let simulation_aux =
let charge = Charge.to_int @@ Simulation.charge simulation
and multiplicity = Electrons.multiplicity @@ Simulation.electrons simulation
and nuclei = Simulation.nuclei simulation
in
let general_basis =
Basis.general_basis @@ Simulation.basis simulation
in
GeneralBasis.combine [
general_basis ; GeneralBasis.read aux_basis_filename
]
|> Basis.of_nuclei_and_general_basis ~f12 nuclei
|> Simulation.make ~charge ~multiplicity ~nuclei
let aux_basis =
MOBasis.of_mo_basis simulation_aux mo_basis
let aux_num =
MOBasis.size aux_basis
Out[17]:
Out[17]:
Out[17]:
In [18]:
let () = ignore @@ MOBasis.f12_ints aux_basis
let () = ignore @@ MOBasis.two_e_ints aux_basis
Integral-based functions¶
\begin{equation}
\langle I | \hat{H} | J \rangle = \begin{cases}
\sum_i h_{ii} + \frac{1}{2} \sum_{ij} \langle ij || ij \rangle \text{ when } |J\rangle = |I\rangle \\
h_{ik} + \sum_{j} \langle ij || kj \rangle \text{ when } |J\rangle = \hat{T}_i^k |I\rangle \\
\langle ij || kl \rangle \text{ when } |J\rangle = \hat{T}_{ij}^{kl} |I\rangle \\
\end{cases}
\end{equation}\begin{equation}
\langle I | \hat{F} | J \rangle = \begin{cases}
\sum_i f_{ii} + \frac{1}{2} \sum_{ij} \langle ij || ij \rangle \text{ when } |J\rangle = |I\rangle \\
f_{ik} + \sum_{j} \langle ij || kj \rangle \text{ when } |J\rangle = \hat{T}_i^k |I\rangle \\
\langle ij || kl \rangle \text{ when } |J\rangle = \hat{T}_{ij}^{kl} |I\rangle \\
\end{cases}
\end{equation}
In [19]:
let cancel_singles = false
let mos_cabs =
Util.list_range (mo_num+1) aux_num
let mos_abs =
Util.list_range 1 aux_num
let mos_in =
Util.list_range 1 mo_num
let mos_a k =
Determinant.alfa k
|> Spindeterminant.to_list
let mos_b k =
Determinant.beta k
|> Spindeterminant.to_list
Out[19]:
Out[19]:
Out[19]:
Out[19]:
Out[19]:
Out[19]:
H integrals¶
In [20]:
let h_one =
let h =
MOBasis.one_e_ints aux_basis
in fun i j _ -> h.{i,j}
let h_two =
let two_e_ints = MOBasis.two_e_ints aux_basis in
let h2 i j k l (s:Spin.t) (s':Spin.t) =
if s' <> s then
ERI.get_phys two_e_ints i j k l
else
(ERI.get_phys two_e_ints i j k l) -.
(ERI.get_phys two_e_ints i j l k)
in
h2
Out[20]:
Out[20]:
F12 integrals¶
In [21]:
let f_two =
let two_e_ints = MOBasis.f12_ints aux_basis in
let f2 i j k l (s:Spin.t) (s':Spin.t) =
if s' <> s then
0.5 *. F12.get_phys two_e_ints i j k l
else
0.5 *. (
(F12.get_phys two_e_ints i j k l) -.
(F12.get_phys two_e_ints i j l k) )
in
let f3 i j k l (s:Spin.t) (s':Spin.t) =
if (i=k && j<>l) || (j=l && i<>k) then
0.
else
f2 i j k l s s'
in
if cancel_singles then f3 else f2
let f_one = fun _ _ _ -> 0.
(*
let f_two = h_two
let f_one = h_one
*)
Out[21]:
Out[21]:
Determinant-based functions¶
Integrals¶
In [22]:
let f12_integrals mo_basis =
( f_one, f_two, None )
let h_ij mo_basis ki kj =
let integrals =
List.map (fun f -> f mo_basis)
[ CI.h_integrals ]
in
CIMatrixElement.make integrals ki kj
|> List.hd
let f_ij mo_basis ki kj =
let integrals =
List.map (fun f -> f mo_basis)
[ f12_integrals ]
in
CIMatrixElement.make integrals ki kj
|> List.hd
let hf_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
Out[22]:
Out[22]:
Out[22]:
Out[22]:
Determinant space¶
In [23]:
let is_a_double 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
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 | 1 -> true
| 0 | _ -> false
Out[23]:
In [24]:
let in_space =
DeterminantSpace.fci_f12_of_mo_basis aux_basis ~frozen_core mo_num
let aux_space =
DeterminantSpace.fci_of_mo_basis aux_basis ~frozen_core
let det_space_in () =
DeterminantSpace.determinant_stream in_space
let det_space_out () =
let s =
DeterminantSpace.determinant_stream aux_space
in
Stream.from (fun _ ->
try
let is_a_double = is_a_double in_space in
let rec result () =
let ki = Stream.next s in
if is_a_double ki then
Some (ki,ki)
else
result ()
in
result ()
with Stream.Failure -> None
)
Out[24]:
Out[24]:
Out[24]:
Out[24]:
In [25]:
let ci = CI.make ~n_states:state in_space
let ci_coef, ci_energy = Lazy.force ci.eigensystem
let _ = print_newline ()
Out[25]:
Out[25]:
Out[25]:
Permutation operator $p_{12}$ that generates a new determinant with electrons 1 and 2 swapped.
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-1) |> minus_one |> logxor aux_mask) 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)) ) ) | 1, 0 | 0, 1 -> Some k | _ -> None
Matrices $\langle I | H | \alpha \rangle$ and $\langle I | F | \alpha \rangle$¶
In [26]:
let randomize = false
let out_list =
Util.stream_to_list (det_space_out ())
let in_list =
Util.stream_to_list (det_space_in ())
let det_a = Array.of_list out_list
|> Array.map (fun (i,_) -> i)
let det_I =
if randomize then
let n = 123456789 in
in_list
|> List.map (fun k -> (Random.int n, k))
|> List.sort compare
|> List.map (fun (_,k) -> k)
|> Array.of_list
else
Array.of_list in_list
Out[26]:
Out[26]:
Out[26]:
Out[26]:
Out[26]:
Function to generate all intermediate external determinants $|\alpha \rangle$ between $|I\rangle$ and $|J\rangle$, with a positive phase factor.
excis the degree of excitation between $|I\rangle$ and $|J\rangle$
In [27]:
let generate_alphas ki kj exc =
(* Check input excitation degree *)
let d = Determinant.degree ki kj in
if d <> exc then
Printf.sprintf "Invalid excitation degree. Expected %d and found %d." exc d
|> failwith;
(* Generate single excitations *)
let all_singles ki =
let mos_a, mos_b = Determinant.to_lists ki in
[ List.map (fun hole ->
List.map (fun particle ->
if hole = particle then None else
Some (Determinant.single_excitation Spin.Alfa hole particle ki)
) mos_abs
) mos_a
;
List.map (fun hole ->
List.map (fun particle ->
if hole = particle then None else
Some (Determinant.single_excitation Spin.Beta hole particle ki)
) mos_abs
) mos_b
]
|> List.concat
|> List.concat
|> Util.list_some
|> List.filter (fun x -> Determinant.is_none x = false)
|> List.map (fun x -> Determinant.set_phase Phase.Pos x)
in
(* Generate double excitations *)
let all_doubles ki =
let mos_a, mos_b = Determinant.to_lists ki in
[ List.map (fun hole -> (* Alpha-Alpha *)
List.map (fun particle ->
List.map (fun hole' ->
List.map (fun particle' ->
if hole = particle || hole' = particle' then None else
if hole' > hole && particle' < particle then
Some (Determinant.double_excitation Spin.Alfa hole particle Spin.Alfa hole' particle' ki)
else None
) mos_abs
) mos_a
) mos_abs
) mos_a
;
List.map (fun hole -> (* Beta-Beta *)
List.map (fun particle ->
List.map (fun hole' ->
List.map (fun particle' ->
if hole' > hole && particle' < particle && hole <> particle && hole' <> particle' then
Some (Determinant.double_excitation Spin.Beta hole particle Spin.Beta hole' particle' ki)
else None
) mos_abs
) mos_b
) mos_abs
) mos_b
;
List.map (fun hole -> (* Alpha-Beta *)
List.map (fun particle ->
List.map (fun hole' ->
List.map (fun particle' ->
if hole = particle || hole' = particle' then None else
Some (Determinant.double_excitation Spin.Alfa hole particle Spin.Beta hole' particle' ki)
) mos_abs
) mos_b
) mos_abs
) mos_a
]
|> List.concat
|> List.concat
|> List.concat
|> List.concat
|> Util.list_some
|> List.filter (fun x -> Determinant.is_none x = false)
|> List.map (fun x -> Determinant.set_phase Phase.Pos x)
in
(* Generate left and right excitations *)
let al = List.concat [ all_singles ki ; all_doubles ki ] in
let ar = List.concat [ all_singles kj ; all_doubles kj ] in
let mo_class = DeterminantSpace.mo_class in_space 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 good_cabs 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
| 1 | 2 -> true
| _ -> false
in
(* Merge lists in a set of unique determinants *)
List.concat [ al; ar ]
|> List.sort_uniq compare
(* Filter out all determinants with incorrect numbers of electrons in the CABS *)
|> List.filter good_cabs
let compute_HaaF ki alphas kj =
List.fold_left (fun accu alpha -> accu
+. h_ij aux_basis ki alpha
*. f_ij aux_basis alpha kj
) 0. alphas
Out[27]:
Out[27]:
In [28]:
let check n integral_value exc =
let cpudet, cpuint = ref 0., ref 0. in
let det_list =
match n with
| 0 -> det_I
| n -> Array.sub det_I 0 n
in
let result =
Printf.printf "Checking ... \n%!";
let percent = ref 0 in
let task (i,ki) =
(let p = (10 * (i+1))/(Array.length det_list) in
if p <> !percent then
( percent := p ; Printf.printf " - %3d %%\n%!" (p*10) ));
Array.mapi (fun j kj ->
if i > j || Determinant.degree ki kj <> exc then
(0,0,0.,0.)
else
begin
let alphas = generate_alphas ki kj exc in
let det_value =
let t0 = Unix.gettimeofday () in
let result = compute_HaaF ki alphas kj in
cpudet := !cpudet +. Unix.gettimeofday () -. t0;
result
in
let int_value =
let t0 = Unix.gettimeofday () in
let result = integral_value ki kj in
cpuint := !cpuint +. Unix.gettimeofday () -. t0;
result
in
(* Printf.printf "%d %d %e %e\n%!" i j det_value int_value; *)
(i,j,det_value,int_value)
end
) det_list
in
det_list
|> Array.mapi (fun i ki -> (i,ki))
|> Array.to_list
|> Stream.of_list
|> Farm.run ~f:task
|> Util.stream_to_list
|> Array.concat
in
let i,j,d,v =
let rec aux k imax jmax emax dmax vmax =
if k = -1 then
imax, jmax, dmax, vmax
else
let i, j, d, v = result.(k) in
let e = abs_float (d -. v) in
if e >= emax then
aux (k-1) i j e d v
else
aux (k-1) imax jmax emax dmax vmax
in
aux (Array.length result - 1) 0 0 0. 0. 0.
in
let error = abs_float (d -. v) in
if error < epsilon_float then
(*
Printf.printf "OK: %e\n%!" error
*)
Printf.printf "OK: (%d, %d) | %e %e | %e | cpu : %f %f\n%!" i j d v error !cpudet !cpuint
else
Printf.printf "Failed: (%d, %d) | %e %e | %e | cpu : %f %f\n%!" i j d v error !cpudet !cpuint
let sum l f = List.fold_left (fun accu i -> accu +. f i) 0. l
Out[28]:
Out[28]:
In [29]:
let array_3_init d1 d2 d3 f =
let result =
Bigarray.(Array3.create Float64 fortran_layout) d1 d2 d3
in
for k=1 to d3 do
for j=1 to d2 do
for i=1 to d1 do
result.{i,j,k} <- f i j k
done
done
done;
result
let array_4_init d1 d2 d3 d4 f =
let result =
Bigarray.(Genarray.create Float64 fortran_layout) [| d1;d2;d3;d4 |]
in
for l=1 to d4 do
for k=1 to d3 do
for j=1 to d2 do
for i=1 to d1 do
result.{i,j,k,l} <- f i j k l
done
done
done
done;
result
let array_5_init d1 d2 d3 d4 d5 f =
let result =
Bigarray.(Genarray.create Float64 fortran_layout) [| d1;d2;d3;d4;d5 |]
in
for m=1 to d5 do
for l=1 to d4 do
for k=1 to d3 do
for j=1 to d2 do
for i=1 to d1 do
result.{i,j,k,l,m} <- f i j k l m
done
done
done
done
done;
result
(* ----- *)
Out[29]:
Out[29]:
Out[29]:
1. 0¶
In [30]:
let m_0111_1H_1F =
Vec.init mo_num (fun i ->
sum mos_cabs (fun a ->
h_one i a Spin.Alfa *. f_one a i Spin.Alfa ))
let m_0111_1H_2Fa, m_0111_2Ha_2Fa =
let m_0122_Haa =
array_3_init mo_num mo_num mo_num (fun i j k ->
sum mos_cabs (fun a ->
h_two i j a k Spin.Alfa Spin.Alfa *. f_two a k i j Spin.Alfa Spin.Alfa
) )
in
let m_0111_1H_2Fa =
Mat.init_cols mo_num mo_num (fun i j ->
sum mos_cabs (fun a ->
h_one i a Spin.Alfa *. f_two a j i j Spin.Alfa Spin.Alfa +.
h_two i j a j Spin.Alfa Spin.Alfa *. f_one a i Spin.Alfa
) +.
if i < j then 0. else
begin
sum mos_cabs (fun a ->
sum mos_cabs (fun b -> if b >= a then 0. else
h_two i j a b Spin.Alfa Spin.Alfa *. f_two a b i j Spin.Alfa Spin.Alfa
)
) +.
sum mos_in (fun k -> m_0122_Haa.{i,j,k})
end
)
in
let m_0111_2Ha_2Fa =
array_3_init mo_num mo_num mo_num (fun i j k ->
sum mos_cabs (fun a ->
h_two i j a j Spin.Alfa Spin.Alfa *.
f_two a k i k Spin.Alfa Spin.Alfa
) -. if i < j then 0. else m_0122_Haa.{i,j,k}
)
in m_0111_1H_2Fa, m_0111_2Ha_2Fa
let m_0111_1H_2Fb, m_0111_2Hb_2Fb =
let m_0122_Hab =
array_3_init mo_num mo_num mo_num (fun i j k ->
sum mos_cabs (fun a ->
h_two i j a k Spin.Alfa Spin.Beta *. f_two a k i j Spin.Alfa Spin.Beta
) )
in
let m_0111_1H_2Fb =
Mat.init_cols mo_num mo_num (fun i j ->
sum mos_cabs (fun a ->
h_one i a Spin.Alfa *. f_two a j i j Spin.Alfa Spin.Beta +.
h_two i j a j Spin.Alfa Spin.Beta *. f_one a i Spin.Alfa +.
h_one j a Spin.Alfa *. f_two a i j i Spin.Alfa Spin.Beta +.
h_two j i a i Spin.Alfa Spin.Beta *. f_one a j Spin.Alfa
) +.
sum mos_in (fun k -> m_0122_Hab.{i,j,k} +. m_0122_Hab.{j,i,k} ) +.
sum mos_cabs (fun a ->
sum mos_cabs (fun b ->
h_two i j a b Spin.Alfa Spin.Beta *. f_two a b i j Spin.Alfa Spin.Beta
)
)
)
in
let m_0111_2Hb_2Fb =
array_3_init mo_num mo_num mo_num (fun i j k ->
sum mos_cabs (fun a ->
h_two k i a i Spin.Alfa Spin.Beta *.
f_two a j k j Spin.Alfa Spin.Beta +.
h_two i k a k Spin.Alfa Spin.Beta *.
f_two a j i j Spin.Alfa Spin.Alfa
) -. m_0122_Hab.{k,i,j}
)
in
m_0111_1H_2Fb, m_0111_2Hb_2Fb
let m_0111_2Ha_2Fb =
array_3_init mo_num mo_num mo_num (fun i j k ->
sum mos_cabs (fun a ->
h_two i j a j Spin.Alfa Spin.Alfa *.
f_two a k i k Spin.Alfa Spin.Beta
)
)
let integral_value ki kj =
let mos_i, mos_i' = mos_a ki, mos_b ki in
let same = (mos_i = mos_i') in
(* Alpha *)
let a =
sum mos_i (fun i -> m_0111_1H_1F.{i})
in
let b =
if same then a else
sum mos_i' (fun i -> m_0111_1H_1F.{i})
in
let aa =
sum mos_i (fun j ->
sum mos_i (fun i -> m_0111_1H_2Fa.{i,j} ))
in
let bb =
if same then aa else
sum mos_i' (fun j ->
sum mos_i' (fun i -> m_0111_1H_2Fa.{i,j} ))
in
let ab =
sum mos_i' (fun j ->
sum mos_i (fun i -> m_0111_1H_2Fb.{i,j} ))
in
let aaa =
sum mos_i (fun k ->
sum mos_i (fun j ->
sum mos_i (fun i -> m_0111_2Ha_2Fa.{i,j,k} )))
in
let bbb =
if same then aaa else
sum mos_i' (fun k ->
sum mos_i' (fun j ->
sum mos_i' (fun i -> m_0111_2Ha_2Fa.{i,j,k} )))
in
let baa =
sum mos_i' (fun k ->
sum mos_i (fun j ->
sum mos_i (fun i ->
m_0111_2Ha_2Fb.{i,j,k} +. m_0111_2Hb_2Fb.{i,j,k}
)))
in
let bba =
sum mos_i (fun k ->
sum mos_i' (fun j ->
sum mos_i' (fun i ->
m_0111_2Ha_2Fb.{i,j,k} +. m_0111_2Hb_2Fb.{j,i,k}
)))
in
a +. b +. aa +. bb +. ab +. aaa +. baa +. bba +. bbb
let _ =
check 0 integral_value 0
Out[30]:
Out[30]:
Out[30]:
Out[30]:
Out[30]:
Out[30]:
2. 1¶
In [31]:
let m_1111_1H_1F =
Mat.init_cols mo_num mo_num (fun i k ->
sum mos_cabs (fun a -> h_one i a Spin.Alfa *. f_one a k Spin.Alfa ))
let m_1111_2Ha_2Fa =
array_4_init mo_num mo_num mo_num mo_num (fun l j i k ->
if l=i then
sum mos_cabs (fun a ->
h_two j l a l Spin.Alfa Spin.Alfa *.
f_two a i j k Spin.Alfa Spin.Alfa
)
else
sum mos_cabs (fun a ->
h_two i j a j Spin.Alfa Spin.Alfa *.
f_two a l k l Spin.Alfa Spin.Alfa +.
h_two j l a l Spin.Alfa Spin.Alfa *.
f_two a i j k Spin.Alfa Spin.Alfa )
)
let m_1111_2Hb_2Fa =
array_4_init mo_num mo_num mo_num mo_num (fun l j i k ->
if l=i then
sum mos_cabs (fun a ->
h_two j l a l Spin.Alfa Spin.Beta *.
f_two a i j k Spin.Alfa Spin.Beta
)
else
sum mos_cabs (fun a ->
h_two i j a j Spin.Alfa Spin.Beta *.
f_two a l k l Spin.Alfa Spin.Alfa +.
h_two j l a l Spin.Alfa Spin.Beta *.
f_two a i j k Spin.Alfa Spin.Beta
)
)
let m_1111_2Ha_2Fb =
array_4_init mo_num mo_num mo_num mo_num (fun l j i k ->
sum mos_cabs (fun a ->
h_two i j a j Spin.Alfa Spin.Alfa *.
f_two a l k l Spin.Alfa Spin.Beta +.
h_two j l a l Spin.Alfa Spin.Beta *.
f_two a i j k Spin.Alfa Spin.Alfa
)
)
let m_1111_2Hb_2Fb =
array_4_init mo_num mo_num mo_num mo_num (fun l j i k ->
sum mos_cabs (fun a ->
h_two i j a j Spin.Alfa Spin.Beta *.
f_two a l k l Spin.Alfa Spin.Beta +.
h_two j l a l Spin.Alfa Spin.Alfa *.
f_two a i j k Spin.Alfa Spin.Beta
)
)
let m_1121_2Ha_2Fa =
array_4_init mo_num mo_num mo_num mo_num (fun l j i k ->
sum mos_cabs (fun a ->
h_two i j k a Spin.Alfa Spin.Alfa *.
f_two l a l j Spin.Alfa Spin.Alfa
)
)
let m_1121_2Hb_2Fa =
array_4_init mo_num mo_num mo_num mo_num (fun l j i k ->
sum mos_cabs (fun a ->
h_two i j k a Spin.Alfa Spin.Beta *.
f_two l a l j Spin.Alfa Spin.Alfa
)
)
let m_1121_2Ha_2Fb =
array_4_init mo_num mo_num mo_num mo_num (fun l j i k ->
sum mos_cabs (fun a ->
h_two i j k a Spin.Alfa Spin.Alfa *.
f_two l a l j Spin.Alfa Spin.Beta
)
)
let m_1121_2Hb_2Fb =
array_4_init mo_num mo_num mo_num mo_num (fun l j i k ->
sum mos_cabs (fun a ->
h_two i j k a Spin.Alfa Spin.Beta *.
f_two l a l j Spin.Alfa Spin.Beta
)
)
let m_1122_va =
array_4_init mo_num mo_num mo_num mo_num (fun l j i k ->
sum mos_cabs (fun a ->
h_two j i a l Spin.Alfa Spin.Alfa *.
f_two l a k j Spin.Alfa Spin.Alfa
)
)
let m_1111_1H_2Fa =
array_3_init mo_num mo_num mo_num (fun j i k ->
sum mos_in (fun l -> m_1122_va.{l,j,i,k}) +.
sum mos_cabs (fun a ->
h_one i a Spin.Alfa *. f_two a j k j Spin.Alfa Spin.Alfa +.
h_two i j a j Spin.Alfa Spin.Alfa *. f_one a k Spin.Alfa +.
h_one j a Spin.Alfa *. f_two a i j k Spin.Alfa Spin.Alfa +.
h_two i j k a Spin.Alfa Spin.Alfa *. f_one a j Spin.Alfa +.
sum mos_cabs (fun b -> if b > a then 0. else
h_two i j a b Spin.Alfa Spin.Alfa *.
f_two a b k j Spin.Alfa Spin.Alfa )
)
)
let m_1122_v2 =
array_4_init mo_num mo_num mo_num mo_num (fun l j i k ->
sum mos_cabs (fun a ->
h_two i j l a Spin.Alfa Spin.Beta *.
f_two l a k j Spin.Alfa Spin.Beta
)
)
let m_1122_v3 =
array_4_init mo_num mo_num mo_num mo_num (fun l j i k ->
sum mos_cabs (fun a ->
h_two i j a l Spin.Alfa Spin.Beta *.
f_two a l k j Spin.Alfa Spin.Beta
)
)
let m_1111_1H_2Fb =
array_3_init mo_num mo_num mo_num (fun j i k ->
sum mos_in (fun l -> m_1122_v2.{l,j,i,k} +. m_1122_v3.{l,j,i,k}) +.
sum mos_cabs (fun a ->
h_one i a Spin.Alfa *. f_two a j k j Spin.Alfa Spin.Beta +.
h_two i j a j Spin.Alfa Spin.Beta *. f_one a k Spin.Alfa +.
h_one j a Spin.Beta *. f_two a i j k Spin.Alfa Spin.Beta +.
h_two i j k a Spin.Alfa Spin.Beta *. f_one a j Spin.Beta +.
sum mos_cabs (fun b ->
h_two i j a b Spin.Alfa Spin.Beta *.
f_two a b k j Spin.Alfa Spin.Beta
)
)
)
let m_1122_oa =
array_4_init mo_num mo_num mo_num mo_num (fun l j i k ->
if l > j then
sum mos_cabs (fun a ->
h_two j l a k Spin.Alfa Spin.Alfa *.
f_two i a l j Spin.Alfa Spin.Alfa
)
else 0.
)
let m_1122_o =
array_4_init mo_num mo_num mo_num mo_num (fun l j i k ->
sum mos_cabs (fun a ->
h_two l j k a Spin.Alfa Spin.Beta *.
f_two i a l j Spin.Alfa Spin.Beta
)
)
(*----*)
let integral_value ki kj =
let i, k, s, phase =
match Excitation.of_det ki kj with
| Excitation.(Single (phase, { hole ; particle ; spin })) ->
hole, particle, spin, phase
| _ -> assert false
in
let mos_novirt, mos_novirt' =
let alfa =
let i = Spindeterminant.bitstring @@ Determinant.alfa ki in
let j = Spindeterminant.bitstring @@ Determinant.alfa kj in
Bitstring.to_list (Bitstring.logor i j)
in
let beta =
let i = Spindeterminant.bitstring @@ Determinant.beta ki in
let j = Spindeterminant.bitstring @@ Determinant.beta kj in
Bitstring.to_list (Bitstring.logor i j)
in
match s with
| Spin.Alfa -> alfa, beta
| Spin.Beta -> beta, alfa
in
let mos_ij, mos_ij' =
let alfa =
let i = Spindeterminant.bitstring @@ Determinant.alfa ki in
let j = Spindeterminant.bitstring @@ Determinant.alfa kj in
Bitstring.to_list (Bitstring.logand i j)
in
let beta =
let i = Spindeterminant.bitstring @@ Determinant.beta ki in
let j = Spindeterminant.bitstring @@ Determinant.beta kj in
Bitstring.to_list (Bitstring.logand i j)
in
match s with
| Spin.Alfa -> alfa, beta
| Spin.Beta -> beta, alfa
in
let mos_i, mos_i' =
match s with
| Spin.Alfa -> mos_a ki, mos_b ki
| Spin.Beta -> mos_b ki, mos_a ki
in
let mos_j, mos_j' =
match s with
| Spin.Alfa -> mos_a kj, mos_b kj
| Spin.Beta -> mos_b kj, mos_a kj
in
let result =
m_1111_1H_1F.{i,k} +.
sum mos_ij (fun j ->
m_1111_1H_2Fa.{j,i,k}
+. sum mos_i (fun l -> m_1111_2Ha_2Fa.{l,j,i,k})
+. sum mos_i' (fun l -> m_1111_2Ha_2Fb.{l,j,i,k})
+. sum mos_j (fun l -> m_1121_2Ha_2Fa.{l,j,i,k})
+. sum mos_j' (fun l -> m_1121_2Ha_2Fb.{l,j,i,k})
-. sum mos_novirt (fun l -> m_1122_va.{l,j,i,k})
-. sum mos_ij (fun l -> m_1122_oa.{l,j,i,k} )
) +.
sum mos_ij' (fun j ->
m_1111_1H_2Fb.{j,i,k}
+. sum mos_i (fun l -> m_1111_2Hb_2Fa.{l,j,i,k})
+. sum mos_i' (fun l -> m_1111_2Hb_2Fb.{l,j,i,k})
+. sum mos_j (fun l -> m_1121_2Hb_2Fb.{l,j,i,k})
+. sum mos_j' (fun l -> m_1121_2Hb_2Fa.{l,j,i,k})
-. sum mos_novirt (fun l -> m_1122_v2.{l,j,i,k})
-. sum mos_novirt' (fun l -> m_1122_v3.{l,j,i,k})
-. sum mos_ij (fun l -> m_1122_o.{l,j,i,k})
)
in
match phase with
| Phase.Pos -> result
| Phase.Neg -> -. result
(*
let ki = det_I.(77)
let kj = det_I.(83)
let _ = integral_value ki kj
let _ =
let alphas = generate_alphas ki kj 1 1
in compute_HaaF ki alphas kj
*)
let _ = check 100 integral_value 1
Out[31]:
Out[31]:
Out[31]:
Out[31]:
Out[31]:
Out[31]:
Out[31]:
Out[31]:
Out[31]:
Out[31]:
Out[31]:
Out[31]:
Out[31]:
Out[31]:
Out[31]:
Out[31]:
Out[31]:
Out[31]:
Timing : 40.020974 0.019294
3. 2¶
In [129]:
let m_2112_1H_2Fa =
array_4_init mo_num mo_num mo_num mo_num (fun i j k l ->
sum mos_cabs (fun a ->
h_one i a Spin.Alfa *. f_two a j k l Spin.Alfa Spin.Alfa +.
h_one j a Spin.Alfa *. f_two i a k l Spin.Alfa Spin.Alfa +.
h_two i j a l Spin.Alfa Spin.Alfa *. f_one a k Spin.Alfa +.
h_two i j k a Spin.Alfa Spin.Alfa *. f_one a l Spin.Alfa +.
sum mos_in (fun m -> -. h_two i j a m Spin.Alfa Spin.Alfa *.
f_two m a k l Spin.Alfa Spin.Alfa) +.
sum mos_cabs (fun b -> if b >= a then 0. else
h_two i j a b Spin.Alfa Spin.Alfa *. f_two a b k l Spin.Alfa Spin.Alfa
)
)
)
let m_2112_1H_2Fb =
array_4_init mo_num mo_num mo_num mo_num (fun i j k l ->
sum mos_cabs (fun a ->
h_one i a Spin.Alfa *. f_two a j k l Spin.Alfa Spin.Beta +.
h_one j a Spin.Alfa *. f_two i a k l Spin.Alfa Spin.Beta +.
h_two i j a l Spin.Alfa Spin.Beta *. f_one a k Spin.Alfa +.
h_two i j k a Spin.Alfa Spin.Beta *. f_one a l Spin.Alfa +.
sum mos_in (fun m ->
h_two i j a m Spin.Alfa Spin.Beta *. f_two a m k l Spin.Alfa Spin.Beta +.
h_two i j m a Spin.Alfa Spin.Beta *. f_two m a k l Spin.Alfa Spin.Beta ) +.
sum mos_cabs (fun b ->
h_two i j a b Spin.Alfa Spin.Beta *. f_two a b k l Spin.Alfa Spin.Beta
)
)
)
let m_2112_2Ha_2Fa =
array_5_init mo_num mo_num mo_num mo_num mo_num (fun n i j k l ->
sum mos_cabs (fun a ->
h_two i n a n Spin.Alfa Spin.Alfa *. f_two a j k l Spin.Alfa Spin.Alfa +.
h_two j n a n Spin.Alfa Spin.Alfa *. f_two a i l k Spin.Alfa Spin.Alfa
)
)
let m_2112_2Hb_2Fa =
array_5_init mo_num mo_num mo_num mo_num mo_num (fun n i j k l ->
sum mos_cabs (fun a ->
h_two i n a n Spin.Alfa Spin.Beta *. f_two a j k l Spin.Alfa Spin.Alfa +.
h_two j n a n Spin.Alfa Spin.Beta *. f_two a i l k Spin.Alfa Spin.Alfa
)
)
let m_2112_2Ha_2Fb =
array_5_init mo_num mo_num mo_num mo_num mo_num (fun n i j k l ->
sum mos_cabs (fun a ->
h_two i n a n Spin.Alfa Spin.Alfa *. f_two a j k l Spin.Alfa Spin.Beta +.
h_two j n a n Spin.Alfa Spin.Beta *. f_two a i l k Spin.Alfa Spin.Beta )
)
let m_2121_2Ha_2Fa =
array_5_init mo_num mo_num mo_num mo_num mo_num (fun n i j k l ->
sum mos_cabs (fun a ->
h_two i j a l Spin.Alfa Spin.Alfa *. f_two a n k n Spin.Alfa Spin.Alfa +.
h_two j i a k Spin.Alfa Spin.Alfa *. f_two a n l n Spin.Alfa Spin.Alfa
)
)
let m_2121_2Hb_2Fa =
array_5_init mo_num mo_num mo_num mo_num mo_num (fun n i j k l ->
sum mos_cabs (fun a ->
h_two i j a l Spin.Alfa Spin.Beta *. f_two a n k n Spin.Alfa Spin.Alfa +.
h_two j i a k Spin.Alfa Spin.Beta *. f_two a n l n Spin.Alfa Spin.Beta
)
)
let m_2121_2Ha_2Fb =
array_5_init mo_num mo_num mo_num mo_num mo_num (fun n i j k l ->
sum mos_cabs (fun a ->
h_two i j a l Spin.Alfa Spin.Alfa *. f_two a n k n Spin.Alfa Spin.Beta +.
h_two j i a k Spin.Alfa Spin.Alfa *. f_two a n l n Spin.Alfa Spin.Beta
)
)
let m_2122_2Ha_2Fa_ij =
let s = Spin.Alfa in
array_5_init mo_num mo_num mo_num mo_num mo_num (fun n i j k l ->
sum mos_cabs (fun a ->
h_two i n a k s s *. f_two j a n l s s
+. h_two i n a l s s *. f_two j a k n s s
-. h_two j n a k s s *. f_two i a n l s s
-. h_two j n a l s s *. f_two i a k n s s
)
)
let m_2122_2Hb_2Fb_ij =
let s, s' = Spin.(Alfa, Beta) in
array_5_init mo_num mo_num mo_num mo_num mo_num (fun n i j k l ->
sum mos_cabs (fun a ->
h_two n i a k s s *. f_two a j n l s s'
+. h_two n j a l s s' *. f_two i a k n s s
-. h_two n j k a s s' *. f_two i a n l s s'
)
)
let m_2122_2Hb_2Fb_ij2 =
let s, s' = Spin.(Alfa, Beta) in
array_5_init mo_num mo_num mo_num mo_num mo_num (fun n i j k l ->
sum mos_cabs (fun a ->
-. h_two i n a l s s' *. f_two a j k n s s' +.
(if n < j then
h_two i n k a s s' *. f_two j a l n s' s'
+. h_two n j a l s' s' *. f_two i a k n s s'
else
-. h_two i n k a s s' *. f_two j a n l s' s'
-. h_two j n a l s' s' *. f_two i a k n s s'
)
)
)
let m_2122_2Ha_2Fa_ij2 =
let s, s' = Spin.(Alfa, Beta) in
array_5_init mo_num mo_num mo_num mo_num mo_num (fun n i j k l ->
sum mos_cabs (fun a ->
h_two i n k a s s' *. f_two j a l n s s'
+. h_two j n l a s s' *. f_two i a k n s s'
-. h_two i n l a s s' *. f_two j a k n s s'
-. h_two j n k a s s' *. f_two i a l n s s'
)
)
let m_2122_2Ha_2Fa_nv =
let s = Spin.Alfa in
array_5_init mo_num mo_num mo_num mo_num mo_num (fun n i j k l ->
sum mos_cabs (fun a -> h_two i j a n s s *. f_two n a k l s s ) )
let m_2122_2Hb_2Fb_nv =
let s, s' = Spin.(Alfa, Beta) in
array_5_init mo_num mo_num mo_num mo_num mo_num (fun n i j k l ->
sum mos_cabs (fun a -> -. h_two i j a n s s' *. f_two a n k l s s' ) )
let m_2122_2Hb_2Fb_nv2 =
let s, s' = Spin.(Alfa, Beta) in
array_5_init mo_num mo_num mo_num mo_num mo_num (fun n i j k l ->
sum mos_cabs (fun a -> -. h_two i j n a s s' *. f_two n a k l s s' ) )
let integral_value ki kj =
let i, j, k, l, s, s', phase =
match Excitation.of_det ki kj with
| Excitation.(Double (phase, { hole ; particle ; spin }, {hole=hole' ; particle=particle' ; spin=spin' })) ->
hole, hole', particle, particle', spin, spin', phase
| _ -> assert false
in
let mos_i, mos_i' =
match s with
| Spin.Alfa -> mos_a ki, mos_b ki
| Spin.Beta -> mos_b ki, mos_a ki
in
let mos_j, mos_j' =
match s with
| Spin.Alfa -> mos_a kj, mos_b kj
| Spin.Beta -> mos_b kj, mos_a kj
in
let mos_ij, mos_ij' =
let alfa =
let i = Spindeterminant.bitstring @@ Determinant.alfa ki in
let j = Spindeterminant.bitstring @@ Determinant.alfa kj in
Bitstring.to_list (Bitstring.logand i j)
in
let beta =
let i = Spindeterminant.bitstring @@ Determinant.beta ki in
let j = Spindeterminant.bitstring @@ Determinant.beta kj in
Bitstring.to_list (Bitstring.logand i j)
in
match s with
| Spin.Alfa -> alfa, beta
| Spin.Beta -> beta, alfa
in
let mos_novirt, mos_novirt' =
let alfa =
let i = Spindeterminant.bitstring @@ Determinant.alfa ki in
let j = Spindeterminant.bitstring @@ Determinant.alfa kj in
Bitstring.to_list (Bitstring.logor i j)
in
let beta =
let i = Spindeterminant.bitstring @@ Determinant.beta ki in
let j = Spindeterminant.bitstring @@ Determinant.beta kj in
Bitstring.to_list (Bitstring.logor i j)
in
match s with
| Spin.Alfa -> alfa, beta
| Spin.Beta -> beta, alfa
in
let result =
if s = s' then
m_2112_1H_2Fa.{i,j,k,l} +.
sum mos_i (fun n -> m_2112_2Ha_2Fa.{n,i,j,k,l} ) +.
sum mos_i' (fun n -> m_2112_2Hb_2Fa.{n,i,j,k,l} ) +.
sum mos_j (fun n -> m_2121_2Ha_2Fa.{n,i,j,k,l} ) +.
sum mos_j' (fun n -> m_2121_2Ha_2Fb.{n,i,j,k,l} ) +.
sum mos_ij (fun n -> m_2122_2Ha_2Fa_ij.{n,i,j,k,l} ) +.
sum mos_ij' (fun n -> m_2122_2Ha_2Fa_ij2.{n,i,j,k,l} ) +.
sum mos_novirt (fun n -> m_2122_2Ha_2Fa_nv.{n,i,j,k,l} )
else
m_2112_1H_2Fb.{i,j,k,l} +.
sum mos_i (fun n -> m_2112_2Ha_2Fb.{n,i,j,k,l} ) +.
sum mos_i' (fun n -> m_2112_2Ha_2Fb.{n,j,i,l,k} ) +.
sum mos_j (fun n -> m_2121_2Hb_2Fa.{n,i,j,k,l} ) +.
sum mos_j' (fun n -> m_2121_2Hb_2Fa.{n,j,i,l,k} ) +.
sum mos_novirt'(fun n -> m_2122_2Hb_2Fb_nv.{n,i,j,k,l} ) +.
sum mos_novirt (fun n -> m_2122_2Hb_2Fb_nv2.{n,i,j,k,l} )+.
sum mos_ij (fun n -> m_2122_2Hb_2Fb_ij.{n,i,j,k,l} ) +.
sum mos_ij' (fun n -> m_2122_2Hb_2Fb_ij2.{n,i,j,k,l} )
in
match phase with
| Phase.Pos -> result
| Phase.Neg -> -. result
let _ = check 100 integral_value 2
let ki = det_I.(7)
let kj = det_I.(89)
let _ = integral_value ki kj
let _ =
let alphas = generate_alphas ki kj 2
in compute_HaaF ki alphas kj
Out[129]:
Out[129]:
Out[129]:
Out[129]:
Out[129]:
Out[129]:
Out[129]:
Out[129]:
Out[129]:
Out[129]:
Out[129]:
Out[129]:
Out[129]:
Out[129]:
Out[129]:
Out[129]:
Out[129]:
Out[129]:
Out[129]:
Out[129]:
Out[129]:
4. 3¶
In [130]:
let integral_value ki kj =
let i, j, m, k, l, n, s1, s2, s3, phase =
match Excitation.of_det ki kj with
| Excitation.(Triple (phase,
{ hole=h1 ; particle=p1 ; spin=s1 },
{ hole=h2 ; particle=p2 ; spin=s2 },
{ hole=h3 ; particle=p3 ; spin=s3 }) ) -> h1, h2, h3, p1, p2, p3, s1, s2, s3, phase
| _ -> assert false
in
let result =
let open Spin in
match s1, s2, s3 with
| Alfa, Alfa, Alfa
| Beta, Beta, Beta ->
sum mos_cabs (fun a ->
h_two i j a k s1 s2 *. f_two m a l n s3 s3
+. h_two i j a n s1 s2 *. f_two m a k l s3 s2
+. h_two i m a l s1 s3 *. f_two j a k n s2 s3
+. h_two j m a k s2 s3 *. f_two i a l n s1 s3
+. h_two j m a n s2 s3 *. f_two i a k l s1 s2
-. h_two i j a l s1 s2 *. f_two m a k n s3 s3
-. h_two i m a k s1 s3 *. f_two j a l n s2 s3
-. h_two i m a n s1 s3 *. f_two j a k l s2 s2
-. h_two j m a l s2 s3 *. f_two i a k n s1 s3 )
| Alfa, Alfa, Beta
| Beta, Beta, Alfa ->
sum mos_cabs (fun a ->
h_two i j a l s1 s2 *. f_two a m k n s1 s3
+. h_two i m k a s1 s3 *. f_two j a l n s2 s3
+. h_two j m a n s2 s3 *. f_two i a k l s1 s2
+. h_two j m l a s2 s3 *. f_two i a k n s1 s3
-. h_two i j a k s1 s2 *. f_two a m l n s1 s3
-. h_two i m a n s1 s3 *. f_two j a k l s2 s2
-. h_two i m l a s1 s3 *. f_two j a k n s2 s3
-. h_two j m k a s2 s3 *. f_two i a l n s1 s3
)
| Alfa, Beta, Beta
| Beta, Alfa, Alfa ->
sum mos_cabs (fun a ->
h_two i j a l s1 s2 *. f_two a m k n s1 s3
+. h_two i m a n s1 s3 *. f_two a j k l s1 s2
+. h_two i m k a s1 s3 *. f_two j a l n s2 s3
+. h_two j m a n s2 s3 *. f_two i a k l s1 s2
-. h_two i j a n s1 s2 *. f_two a m k l s1 s2
-. h_two i j k a s1 s2 *. f_two m a l n s2 s3
-. h_two i m a l s1 s3 *. f_two a j k n s1 s3
-. h_two j m a l s2 s3 *. f_two i a k n s1 s3
)
| Beta, Alfa, Beta
| Alfa, Beta, Alfa -> assert false (*TODO *)
in
match phase with
| Phase.Pos -> result
| Phase.Neg -> -. result
let _ = check 100 integral_value 3
Out[130]:
Out[130]:
In [ ]:
let ki = det_I.(129)
let kj = det_I.(349)
let alpha_to_string alpha =
let exc0 = Array.init (aux_num+1) (fun _ -> [|"-";"-"|]) in
let i, j, m, k, l, n, s, s', s'', phase =
match Excitation.of_det ki kj with
| Excitation.(Triple (phase,
{ hole ; particle ; spin },
{hole=hole' ; particle=particle' ; spin=spin' },
{hole=hole''; particle=particle''; spin=spin''} )) ->
hole, hole', hole'', particle, particle', particle'', spin, spin', spin'', phase
| _ -> assert false
in
let spin = function
| Spin.Alfa -> 0
| _ -> 1
in
exc0.(i).(spin s ) <- "i"
; exc0.(j).(spin s' ) <- "j"
; exc0.(k).(spin s ) <- "k"
; exc0.(l).(spin s' ) <- "l"
; exc0.(m).(spin s'') <- "m"
; exc0.(n).(spin s'') <- "n"
;
let s0, s0', s0'' = s, s', s'' in
let i, j, k, l, s, s', p1 =
match Excitation.of_det ki alpha with
| Excitation.(Double (phase, { hole ; particle ; spin }, {hole=hole' ; particle=particle' ; spin=spin' })) ->
hole, hole', particle, particle', spin, spin', phase
| _ -> assert false
in
if exc0.(i).(spin s ) = "-" then exc0.(i).(spin s ) <- "p";
if exc0.(j).(spin s') = "-" then exc0.(j).(spin s') <- "p";
if exc0.(k).(spin s ) = "-" then exc0.(k).(spin s ) <- if k > mo_num then "a" else "q";
if exc0.(l).(spin s') = "-" then exc0.(l).(spin s') <- if l > mo_num then "a" else "q";
let string_h =
Printf.sprintf "h_two %s %s %s %s %s %s *. "
exc0.(i).(spin s )
exc0.(j).(spin s')
exc0.(k).(spin s )
exc0.(l).(spin s')
(if s = s0 then "s " else if s = s0' then "s'" else "s''")
(if s' = s0' then "s'" else if s = s0'' then "s''" else "s" )
in
let i, j, k, l, s, s', p2 =
match Excitation.of_det alpha kj with
| Excitation.(Double (phase, { hole ; particle ; spin }, {hole=hole' ; particle=particle' ; spin=spin' })) ->
hole, hole', particle, particle', spin, spin', phase
| _ -> assert false
in
let string_f =
Printf.sprintf "f_two %s %s %s %s %s %s"
exc0.(i).(spin s )
exc0.(j).(spin s')
exc0.(k).(spin s )
exc0.(l).(spin s')
(if s = s0 then "s " else if s = s0' then "s'" else "s''")
(if s' = s0' then "s'" else if s = s0'' then "s''" else "s" )
in
(*
Format.printf "|I> -> |a> : %a | %s\n@." Excitation.pp (Excitation.of_det ki alpha) string_h ;
Format.printf "|a> -> |J> : %a | %s\n@." Excitation.pp (Excitation.of_det alpha kj) string_f ;
*)
let sign =
if Phase.add p1 p2 = phase then "+." else "-."
in
sign ^ string_h ^ string_f
let alpha_debug alpha =
let i, j, k, l, s, s', p1 =
match Excitation.of_det ki alpha with
| Excitation.(Double (phase, { hole ; particle ; spin }, {hole=hole' ; particle=particle' ; spin=spin' })) ->
hole, hole', particle, particle', spin, spin', phase
| _ -> assert false
in
Printf.printf "%d %d %d %d " i j k l;
let i, j, k, l, s, s', p2 =
match Excitation.of_det alpha kj with
| Excitation.(Double (phase, { hole ; particle ; spin }, {hole=hole' ; particle=particle' ; spin=spin' })) ->
hole, hole', particle, particle', spin, spin', phase
| _ -> assert false
in
(*
Format.printf "|I> -> |a> : %a | \n@." Excitation.pp (Excitation.of_det ki alpha) ;
Format.printf "|a> -> |J> : %a | \n@." Excitation.pp (Excitation.of_det alpha kj) ;
*)
Printf.printf "%d %d %d %d \n%!" i j k l
let strings =
Format.printf "|I> -> |J> : %a |\n@." Excitation.pp (Excitation.of_det ki kj) ;
generate_alphas ki kj 3 1 2 2
|> Array.of_list
|> Array.mapi (fun kk alpha -> alpha_to_string alpha)
|> Array.to_list
|> List.sort_uniq compare
|> Array.of_list
let _ = Array.iteri (fun i x -> Printf.printf "%d %s \n%!" i x) strings
let _ =
let v =
let alphas =
generate_alphas ki kj 3 1 2 2
(*
|> List.filter (fun alpha ->
let x = alpha_to_string alpha in
x = strings.(6)
)
*)
in
(*
List.iter alpha_debug alphas ;
Printf.printf "\n%!";
*)
compute_HaaF ki alphas kj
in
let x = (integral_value ki kj) in
Printf.printf "%20.8e %20.8e %20.8e\n%!" x v (v-. x)