mirror of
https://gitlab.com/scemama/QCaml.git
synced 2024-08-30 00:03:42 +02:00
Implemented fast f12 in native code
This commit is contained in:
parent
85a4425a6e
commit
a20ec08125
1
CI/CI.ml
1
CI/CI.ml
@ -290,6 +290,7 @@ let create_matrix_spin ?(nmax=2) f det_space =
|
|||||||
let singles =
|
let singles =
|
||||||
List.filter (fun (i,d,det_j) -> d < 2) doubles
|
List.filter (fun (i,d,det_j) -> d < 2) doubles
|
||||||
in
|
in
|
||||||
|
|
||||||
let triples =
|
let triples =
|
||||||
List.map (fun (i,_,det_j) -> (i,det_j)) triples
|
List.map (fun (i,_,det_j) -> (i,det_j)) triples
|
||||||
in
|
in
|
||||||
|
@ -1,147 +0,0 @@
|
|||||||
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 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
|
|
||||||
let s1 =
|
|
||||||
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
|
|
||||||
in
|
|
||||||
let kk = Determinant.double_excitation Spin.Alfa ha pb Spin.Beta hb pa ki in
|
|
||||||
let kka = De.alfa kk and kkb = De.beta kk in
|
|
||||||
match Spindeterminant.(degree kia kka, degree kib kkb) with
|
|
||||||
| (1,1) ->
|
|
||||||
let s2 =
|
|
||||||
begin
|
|
||||||
let ha, pa, phase_a = Ex.single_of_spindet kia kka in
|
|
||||||
let hb, pb, phase_b = Ex.single_of_spindet kib kkb 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
|
|
||||||
in fun x two_e -> 0.75 *. (s1 x two_e) +. 0.25 *. (s2 x two_e)
|
|
||||||
| _ -> fun x two_e -> 0.
|
|
||||||
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 *)
|
|
||||||
| 0, 1 (* beta single *)
|
|
||||||
-> fun _ _ -> 0.
|
|
||||||
| 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.
|
|
||||||
|
|
||||||
|
|
301
CI/F12CI.ml
301
CI/F12CI.ml
@ -20,245 +20,6 @@ let mo_class t = Ds.mo_class @@ det_space t
|
|||||||
let eigensystem t = Lazy.force t.eigensystem
|
let eigensystem t = Lazy.force t.eigensystem
|
||||||
|
|
||||||
|
|
||||||
(*
|
|
||||||
|
|
||||||
let single_matrices hf12_integrals density =
|
|
||||||
let nocc = Mat.dim1 density in
|
|
||||||
let nvir = Mat.dim2 density in
|
|
||||||
let { HF12.
|
|
||||||
simulation ; aux_basis ;
|
|
||||||
hf12 ; hf12_anti ;
|
|
||||||
hf12_single ; hf12_single_anti } = hf12_integrals
|
|
||||||
in
|
|
||||||
let f12 = MOBasis.f12_ints aux_basis in
|
|
||||||
let eri = MOBasis.two_e_ints aux_basis in
|
|
||||||
|
|
||||||
let d = Mat.as_vec density in
|
|
||||||
let v_s = Mat.create nocc nvir in
|
|
||||||
let v_o = Mat.create nocc nvir in
|
|
||||||
let h_o, h_s, f_o, f_s =
|
|
||||||
Mat.create nocc nvir ,
|
|
||||||
Mat.create nocc nvir ,
|
|
||||||
Mat.create nocc nvir ,
|
|
||||||
Mat.create nocc nvir ,
|
|
||||||
in
|
|
||||||
for a=1 to nvir do
|
|
||||||
for m=1 to occ do
|
|
||||||
for u=1 to nocc do
|
|
||||||
for t=1 to nocc do
|
|
||||||
let hmtau = ERI.get_phys eri m t a u
|
|
||||||
and hmtua = ERI.get_phys eri m t u a
|
|
||||||
in
|
|
||||||
v_o.{t,u} <- hmtau;
|
|
||||||
v_s.{t,u} <- hmtau -. hmtua;
|
|
||||||
done
|
|
||||||
done;
|
|
||||||
h_o.{m,a} <- dot d_o @@ Mat.as_vec v_o;
|
|
||||||
h_s.{m,a} <- dot d_s @@ Mat.as_vec v_s
|
|
||||||
for u=1 to nocc do
|
|
||||||
for t=1 to nocc do
|
|
||||||
let fmtau = ERI.get_phys f12 m t a u
|
|
||||||
and fmtua = ERI.get_phys f12 m t u a
|
|
||||||
in
|
|
||||||
v_o.{t,u} <- 0.375 *. fmtau +. 0.125 *. fmtua;
|
|
||||||
v_s.{t,u} <- 0.25 *, (fmtau -. fmtua);
|
|
||||||
done
|
|
||||||
done;
|
|
||||||
f_o.{m,a} <- dot d_o @@ Mat.as_vec v_o;
|
|
||||||
f_s.{m,a} <- dot d_s @@ Mat.as_vec v_s
|
|
||||||
done
|
|
||||||
done;
|
|
||||||
*)
|
|
||||||
|
|
||||||
(*---
|
|
||||||
let hf_ij_non_zero mo_basis hf12_integrals deg_a deg_b ki kj =
|
|
||||||
let integrals = [
|
|
||||||
|
|
||||||
let { HF12.
|
|
||||||
simulation ; aux_basis ;
|
|
||||||
hf12 ; hf12_anti ;
|
|
||||||
hf12_single ; hf12_single_anti } = hf12_integrals
|
|
||||||
in
|
|
||||||
|
|
||||||
let kia = De.alfa ki and kib = De.beta ki in
|
|
||||||
let kja = De.alfa kj and kjb = De.beta kj in
|
|
||||||
|
|
||||||
let mo_a =
|
|
||||||
Bitstring.logand (Sp.bitstring kia) (Sp.bitstring kja)
|
|
||||||
|> Bitstring.to_list
|
|
||||||
|> Array.of_list
|
|
||||||
and mo_b =
|
|
||||||
Bitstring.logand (Sp.bitstring kib) (Sp.bitstring kjb)
|
|
||||||
|> Bitstring.to_list
|
|
||||||
|> Array.of_list
|
|
||||||
in
|
|
||||||
|
|
||||||
let aux_mos =
|
|
||||||
Util.list_range (MOBasis.size mo_basis) (MOBasis.size aux_basis)
|
|
||||||
|> Array.of_list
|
|
||||||
in
|
|
||||||
|
|
||||||
let one_e _ _ _ = 0. in
|
|
||||||
|
|
||||||
let h = MOBasis.ee_ints aux_basis in
|
|
||||||
let two_e_h i j k l s s' =
|
|
||||||
if s' <> s then
|
|
||||||
ERI.get_phys h i j k l
|
|
||||||
else
|
|
||||||
(ERI.get_phys h i j k l) -. (ERI.get_phys h i j l k)
|
|
||||||
in
|
|
||||||
|
|
||||||
let f = MOBasis.f12_ints aux_basis in
|
|
||||||
let two_e_f i j k l s s' =
|
|
||||||
let fijkl = F12.get_phys f i j k l
|
|
||||||
and fijlk = F12.get_phys f i j l k
|
|
||||||
in
|
|
||||||
if s' <> s then
|
|
||||||
0.325 *. fijkl +. 0.125 *. fijlk
|
|
||||||
else
|
|
||||||
0.25 *. (fijkl -. fijlk)
|
|
||||||
in
|
|
||||||
|
|
||||||
(*
|
|
||||||
let mo_of_s = function
|
|
||||||
| Spin.Alfa -> mo_a
|
|
||||||
| Spin.Beta -> mo_b
|
|
||||||
in
|
|
||||||
*)
|
|
||||||
|
|
||||||
let two_e i j k l s s' =
|
|
||||||
(
|
|
||||||
if s = s' then
|
|
||||||
hf12_anti.{i,j,k,l} -. (
|
|
||||||
(Array.fold_left (fun accu m -> accu +. hf12_single_anti.{m,i,j,k,l}) 0. mo_a) +.
|
|
||||||
(Array.fold_left (fun accu m -> accu +. hf12_single_anti.{m,j,i,l,k}) 0. mo_b) )
|
|
||||||
else
|
|
||||||
hf12.{i,j,k,l} -. (
|
|
||||||
(Array.fold_left (fun accu m -> accu +. hf12_single.{m,i,j,k,l}) 0. mo_a) +.
|
|
||||||
(Array.fold_left (fun accu m -> accu +. hf12_single.{m,j,i,l,k}) 0. mo_b) )
|
|
||||||
)
|
|
||||||
(*
|
|
||||||
+. Array.fold_left ( fun accu a -> accu +.
|
|
||||||
(Array.fold_left ( fun accu m -> accu +. two_e_h m i m a s s) 0. (mo_of_s s) +.
|
|
||||||
Array.fold_left ( fun accu m -> accu +. two_e_h m i m a s s) 0. (mo_of_s @@ Spin.other s) )
|
|
||||||
*. (two_e_f a j k l s s') ) 0. aux_mos
|
|
||||||
*)
|
|
||||||
in
|
|
||||||
|
|
||||||
let three_e i j k l m n s s' s'' =
|
|
||||||
Array.fold_left (fun accu a -> accu +. two_e_h i j l a s s' *. two_e_f a k m n s' s'') 0. aux_mos
|
|
||||||
-. Array.fold_left (fun accu a -> accu +. two_e_h j i m a s' s *. two_e_f a k l n s s'') 0. aux_mos
|
|
||||||
+. Array.fold_left (fun accu a -> accu +. two_e_h j k m a s' s'' *. two_e_f a i n l s'' s ) 0. aux_mos
|
|
||||||
-. Array.fold_left (fun accu a -> accu +. two_e_h k j n a s'' s' *. two_e_f a i m l s' s ) 0. aux_mos
|
|
||||||
+. Array.fold_left (fun accu a -> accu +. two_e_h k i n a s'' s *. two_e_f a j l m s s' ) 0. aux_mos
|
|
||||||
-. Array.fold_left (fun accu a -> accu +. two_e_h i k l a s s'' *. two_e_f a j n m s'' s' ) 0. aux_mos
|
|
||||||
in
|
|
||||||
(one_e, two_e, Some three_e)
|
|
||||||
]
|
|
||||||
in
|
|
||||||
CIMatrixElement.non_zero integrals deg_a deg_b ki kj
|
|
||||||
|> List.hd
|
|
||||||
|
|
||||||
|
|
||||||
let dressing_vector ~frozen_core hf12_integrals f12_amplitudes ci =
|
|
||||||
|
|
||||||
if Parallel.master then
|
|
||||||
Printf.printf "Building matrix\n%!";
|
|
||||||
let det_space =
|
|
||||||
ci.CI.det_space
|
|
||||||
in
|
|
||||||
let mo_basis =
|
|
||||||
Ds.mo_basis det_space
|
|
||||||
in
|
|
||||||
|
|
||||||
let m_HF =
|
|
||||||
|
|
||||||
let f =
|
|
||||||
match Ds.determinants det_space with
|
|
||||||
| Ds.Arbitrary _ -> CI.create_matrix_arbitrary
|
|
||||||
| Ds.Spin _ -> CI.create_matrix_spin_computed ~nmax:3
|
|
||||||
in
|
|
||||||
f (fun deg_a deg_b ki kj ->
|
|
||||||
hf_ij_non_zero mo_basis hf12_integrals deg_a deg_b ki kj
|
|
||||||
) det_space
|
|
||||||
|
|
||||||
in
|
|
||||||
|
|
||||||
Matrix.mm (Lazy.force m_HF) (Matrix.dense_of_mat f12_amplitudes)
|
|
||||||
|
|
||||||
--- *)
|
|
||||||
|
|
||||||
|
|
||||||
let hf_ij_non_zero hf12_integrals deg_a deg_b ki kj =
|
|
||||||
let integrals = [
|
|
||||||
|
|
||||||
let { HF12.
|
|
||||||
simulation ; aux_basis ;
|
|
||||||
hf12 ; hf12_anti ;
|
|
||||||
hf12_single ; hf12_single_anti } = hf12_integrals
|
|
||||||
in
|
|
||||||
|
|
||||||
let kia = De.alfa ki and kib = De.beta ki in
|
|
||||||
let kja = De.alfa kj and kjb = De.beta kj in
|
|
||||||
|
|
||||||
let mo_a =
|
|
||||||
Bitstring.logand (Sp.bitstring kia) (Sp.bitstring kja)
|
|
||||||
|> Bitstring.to_list
|
|
||||||
and mo_b =
|
|
||||||
Bitstring.logand (Sp.bitstring kib) (Sp.bitstring kjb)
|
|
||||||
|> Bitstring.to_list
|
|
||||||
in
|
|
||||||
|
|
||||||
let one_e _ _ _ = 0. in
|
|
||||||
|
|
||||||
let two_e i j k l s s' =
|
|
||||||
if s = s' then
|
|
||||||
hf12_anti.{i,j,k,l} -. (
|
|
||||||
(List.fold_left (fun accu m -> accu +. hf12_single_anti.{m,i,j,k,l}) 0. mo_a) +.
|
|
||||||
(List.fold_left (fun accu m -> accu +. hf12_single_anti.{m,j,i,l,k}) 0. mo_b)
|
|
||||||
)
|
|
||||||
else
|
|
||||||
hf12.{i,j,k,l} -. (
|
|
||||||
(List.fold_left (fun accu m -> accu +. hf12_single.{m,i,j,k,l}) 0. mo_a) +.
|
|
||||||
(List.fold_left (fun accu m -> accu +. hf12_single.{m,j,i,l,k}) 0. mo_b)
|
|
||||||
)
|
|
||||||
in
|
|
||||||
|
|
||||||
let h = MOBasis.ee_ints aux_basis in
|
|
||||||
let two_e_h i j k l s s' =
|
|
||||||
if s' <> s then
|
|
||||||
ERI.get_phys h l k j i
|
|
||||||
else
|
|
||||||
(ERI.get_phys h l k j i) -. (ERI.get_phys h k l j i)
|
|
||||||
in
|
|
||||||
|
|
||||||
let f = MOBasis.f12_ints aux_basis in
|
|
||||||
let two_e_f i j k l s s' =
|
|
||||||
if s' <> s then
|
|
||||||
F12.get_phys f i j k l
|
|
||||||
else
|
|
||||||
(F12.get_phys f i j k l) -. (F12.get_phys f i j l k)
|
|
||||||
in
|
|
||||||
|
|
||||||
let mo_of_s = function
|
|
||||||
| Spin.Alfa -> mo_a
|
|
||||||
| Spin.Beta -> mo_b
|
|
||||||
in
|
|
||||||
|
|
||||||
let three_e i j k l m n s s' s'' =
|
|
||||||
List.fold_left (fun accu a -> accu +. two_e_h i j l a s s' *. two_e_f a k m n s' s'') 0. (mo_of_s s' )
|
|
||||||
-. List.fold_left (fun accu a -> accu +. two_e_h j i m a s' s *. two_e_f a k l n s s'') 0. (mo_of_s s )
|
|
||||||
+. List.fold_left (fun accu a -> accu +. two_e_h j k m a s' s'' *. two_e_f a i n l s'' s ) 0. (mo_of_s s'')
|
|
||||||
-. List.fold_left (fun accu a -> accu +. two_e_h k j n a s'' s' *. two_e_f a i m l s' s ) 0. (mo_of_s s' )
|
|
||||||
+. List.fold_left (fun accu a -> accu +. two_e_h k i n a s'' s *. two_e_f a j l m s s' ) 0. (mo_of_s s )
|
|
||||||
-. List.fold_left (fun accu a -> accu +. two_e_h i k l a s s'' *. two_e_f a j n m s'' s' ) 0. (mo_of_s s'')
|
|
||||||
in
|
|
||||||
|
|
||||||
(one_e, two_e, Some three_e)
|
|
||||||
]
|
|
||||||
in
|
|
||||||
CIMatrixElement.non_zero integrals deg_a deg_b ki kj
|
|
||||||
|> List.hd
|
|
||||||
|
|
||||||
|
|
||||||
let dressing_vector ~frozen_core hf12_integrals f12_amplitudes ci =
|
let dressing_vector ~frozen_core hf12_integrals f12_amplitudes ci =
|
||||||
@ -269,6 +30,11 @@ let dressing_vector ~frozen_core hf12_integrals f12_amplitudes ci =
|
|||||||
ci.CI.det_space
|
ci.CI.det_space
|
||||||
in
|
in
|
||||||
|
|
||||||
|
let { HF12.
|
||||||
|
simulation ; aux_basis ;
|
||||||
|
f_0 ; f_1 ; f_2 ; f_3 } = hf12_integrals
|
||||||
|
in
|
||||||
|
|
||||||
let m_HF =
|
let m_HF =
|
||||||
|
|
||||||
let f =
|
let f =
|
||||||
@ -277,7 +43,12 @@ let dressing_vector ~frozen_core hf12_integrals f12_amplitudes ci =
|
|||||||
| Ds.Spin _ -> CI.create_matrix_spin_computed ~nmax:3
|
| Ds.Spin _ -> CI.create_matrix_spin_computed ~nmax:3
|
||||||
in
|
in
|
||||||
f (fun deg_a deg_b ki kj ->
|
f (fun deg_a deg_b ki kj ->
|
||||||
hf_ij_non_zero hf12_integrals deg_a deg_b ki kj
|
match deg_a + deg_b with
|
||||||
|
| 0 -> f_0 ki
|
||||||
|
| 1 -> f_1 ki kj
|
||||||
|
| 2 -> f_2 ki kj
|
||||||
|
| 3 -> f_3 ki kj
|
||||||
|
| _ -> assert false
|
||||||
) det_space
|
) det_space
|
||||||
|
|
||||||
in
|
in
|
||||||
@ -285,6 +56,55 @@ let dressing_vector ~frozen_core hf12_integrals f12_amplitudes ci =
|
|||||||
Matrix.mm (Lazy.force m_HF) (Matrix.dense_of_mat f12_amplitudes)
|
Matrix.mm (Lazy.force m_HF) (Matrix.dense_of_mat f12_amplitudes)
|
||||||
|
|
||||||
|
|
||||||
|
let sum l f = List.fold_left (fun accu i -> accu +. f i) 0. l
|
||||||
|
|
||||||
|
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
|
||||||
|
|
||||||
|
|
||||||
|
|
||||||
let make ~simulation ?(threshold=1.e-12) ~frozen_core ~mo_basis ~aux_basis_filename ?(state=1) () =
|
let make ~simulation ?(threshold=1.e-12) ~frozen_core ~mo_basis ~aux_basis_filename ?(state=1) () =
|
||||||
|
|
||||||
let det_space =
|
let det_space =
|
||||||
@ -302,6 +122,7 @@ let make ~simulation ?(threshold=1.e-12) ~frozen_core ~mo_basis ~aux_basis_filen
|
|||||||
Parallel.broadcast (lazy x)
|
Parallel.broadcast (lazy x)
|
||||||
in
|
in
|
||||||
|
|
||||||
|
|
||||||
let eigensystem = lazy (
|
let eigensystem = lazy (
|
||||||
let m_H =
|
let m_H =
|
||||||
Lazy.force ci.CI.m_H
|
Lazy.force ci.CI.m_H
|
||||||
|
991
MOBasis/HF12.ml
991
MOBasis/HF12.ml
File diff suppressed because it is too large
Load Diff
Loading…
Reference in New Issue
Block a user