mirror of
https://gitlab.com/scemama/QCaml.git
synced 2024-08-30 00:03:42 +02:00
Matrix product in batches
This commit is contained in:
parent
69faafb6f7
commit
f77b7f07d5
129
CI/F12CI.ml
129
CI/F12CI.ml
@ -20,11 +20,16 @@ let f12_integrals mo_basis =
|
|||||||
let two_e_ints = MOBasis.f12_ints mo_basis in
|
let two_e_ints = MOBasis.f12_ints mo_basis in
|
||||||
( (fun _ _ _ -> 0.),
|
( (fun _ _ _ -> 0.),
|
||||||
(fun i j k l s s' ->
|
(fun i j k l s s' ->
|
||||||
if s' = Spin.other s then
|
if (i=k && j<>l) || (j=l && i<>k) then
|
||||||
F12.get_phys two_e_ints i j k l
|
0.
|
||||||
else
|
else
|
||||||
(F12.get_phys two_e_ints i j k l) -.
|
begin
|
||||||
(F12.get_phys two_e_ints i j l k)
|
if s' = Spin.other s then
|
||||||
|
0.5 *. (F12.get_phys two_e_ints i j k l)
|
||||||
|
else
|
||||||
|
0.25 *. ((F12.get_phys two_e_ints i j k l) -.
|
||||||
|
(F12.get_phys two_e_ints i j l k))
|
||||||
|
end
|
||||||
) )
|
) )
|
||||||
|
|
||||||
|
|
||||||
@ -70,16 +75,18 @@ let is_internal det_space =
|
|||||||
Determinant.alfa a
|
Determinant.alfa a
|
||||||
|> Spindeterminant.bitstring
|
|> Spindeterminant.bitstring
|
||||||
in
|
in
|
||||||
(*
|
|
||||||
let beta =
|
let beta =
|
||||||
Determinant.beta a
|
Determinant.beta a
|
||||||
|> Spindeterminant.bitstring
|
|> Spindeterminant.bitstring
|
||||||
in
|
in
|
||||||
let a = Bitstring.logand aux_mask alfa
|
let a = Bitstring.logand aux_mask alfa
|
||||||
and b = Bitstring.logand aux_mask beta
|
and b = Bitstring.logand aux_mask beta
|
||||||
in Bitstring.popcount a + Bitstring.popcount b < 2
|
in
|
||||||
*)
|
match Bitstring.popcount a + Bitstring.popcount b with
|
||||||
|
| 1 | 2 -> false
|
||||||
|
| _ -> true
|
||||||
|
|
||||||
|
(*
|
||||||
if not (Bitstring.logand aux_mask alfa |> Bitstring.is_zero ) then
|
if not (Bitstring.logand aux_mask alfa |> Bitstring.is_zero ) then
|
||||||
false
|
false
|
||||||
else
|
else
|
||||||
@ -88,6 +95,7 @@ let is_internal det_space =
|
|||||||
|> Spindeterminant.bitstring
|
|> Spindeterminant.bitstring
|
||||||
in
|
in
|
||||||
Bitstring.logand aux_mask beta |> Bitstring.is_zero
|
Bitstring.logand aux_mask beta |> Bitstring.is_zero
|
||||||
|
*)
|
||||||
|
|
||||||
|
|
||||||
let dressing_vector ~frozen_core aux_basis f12_amplitudes ci =
|
let dressing_vector ~frozen_core aux_basis f12_amplitudes ci =
|
||||||
@ -118,49 +126,88 @@ let dressing_vector ~frozen_core aux_basis f12_amplitudes ci =
|
|||||||
|
|
||||||
Printf.printf "Building matrix\n%!";
|
Printf.printf "Building matrix\n%!";
|
||||||
|
|
||||||
|
(* Determinants of the FCI space as a list *)
|
||||||
|
let in_dets =
|
||||||
|
DeterminantSpace.determinants_array ci.CI.det_space
|
||||||
|
|> Array.to_list
|
||||||
|
in
|
||||||
|
|
||||||
let m_H_aux, m_F_aux =
|
(* Stream that generates only singly and doubly excited determinants
|
||||||
let out_dets_stream =
|
wrt FCI space *)
|
||||||
|
let out_dets_stream =
|
||||||
|
|
||||||
|
(* Stream that generates all determinants of FCI space *)
|
||||||
|
let s =
|
||||||
DeterminantSpace.fci_of_mo_basis ~frozen_core aux_basis
|
DeterminantSpace.fci_of_mo_basis ~frozen_core aux_basis
|
||||||
|> DeterminantSpace.determinant_stream
|
|> DeterminantSpace.determinant_stream
|
||||||
in
|
|
||||||
|
|
||||||
let in_dets =
|
|
||||||
DeterminantSpace.determinants_array ci.CI.det_space
|
|
||||||
|> Array.to_list
|
|
||||||
in
|
in
|
||||||
|
(* Select only singly and doubly excited determinants
|
||||||
|
wrt FCI space *)
|
||||||
|
Stream.from (fun _ ->
|
||||||
|
try
|
||||||
|
let rec result () =
|
||||||
|
let ki = Stream.next s in
|
||||||
|
if is_internal ci.CI.det_space ki then
|
||||||
|
result ()
|
||||||
|
else
|
||||||
|
Some ki
|
||||||
|
in
|
||||||
|
result ()
|
||||||
|
with Stream.Failure -> None
|
||||||
|
)
|
||||||
|
in
|
||||||
|
|
||||||
let rec col_vecs_list accu_H accu_F =
|
let make_h_and_f n =
|
||||||
|
|
||||||
|
let rec col_vecs_list accu_H accu_F = function
|
||||||
|
| 0 ->
|
||||||
|
List.rev accu_H,
|
||||||
|
List.rev accu_F
|
||||||
|
| n ->
|
||||||
try
|
try
|
||||||
let ki = Stream.next out_dets_stream in
|
let ki = Stream.next out_dets_stream in
|
||||||
if is_internal ci.CI.det_space ki then
|
let h, f =
|
||||||
raise Exit
|
List.map (fun kj ->
|
||||||
else
|
match hf_ij aux_basis ki kj with
|
||||||
let h, f =
|
| [ a ; b ] -> a, b
|
||||||
List.map (fun kj ->
|
| _ -> assert false ) in_dets
|
||||||
match hf_ij aux_basis ki kj with
|
|> List.split
|
||||||
| [ a ; b ] -> a, b
|
in
|
||||||
| _ -> assert false ) in_dets
|
let h =
|
||||||
|> List.split
|
Vec.of_list h
|
||||||
in
|
and f =
|
||||||
col_vecs_list (h::accu_H) (f::accu_F)
|
Vec.of_list f
|
||||||
|
in
|
||||||
|
col_vecs_list (h::accu_H) (f::accu_F) (n-1)
|
||||||
with
|
with
|
||||||
| Exit -> col_vecs_list accu_H accu_F
|
| Stream.Failure -> col_vecs_list accu_H accu_F 0
|
||||||
| Stream.Failure ->
|
|
||||||
List.rev_map Vec.of_list accu_H,
|
|
||||||
List.rev_map Vec.of_list accu_F
|
|
||||||
in
|
in
|
||||||
let h, f =
|
let h, f =
|
||||||
col_vecs_list [] []
|
col_vecs_list [] [] n
|
||||||
in
|
in
|
||||||
Mat.of_col_vecs_list h,
|
Mat.of_col_vecs_list h,
|
||||||
Mat.of_col_vecs_list f
|
Mat.of_col_vecs_list f
|
||||||
in
|
in
|
||||||
|
|
||||||
|
|
||||||
Printf.printf "Matrix product\n%!";
|
Printf.printf "Matrix product\n%!";
|
||||||
let m_HF =
|
let m_HF =
|
||||||
gemm m_H_aux m_F_aux ~transb:`T
|
let batch_size = 10_000_000 / (Mat.dim1 f12_amplitudes) in
|
||||||
|
let result =
|
||||||
|
let m_H_aux, m_F_aux = make_h_and_f batch_size in
|
||||||
|
gemm m_H_aux m_F_aux ~transb:`T
|
||||||
|
in
|
||||||
|
while (Stream.peek out_dets_stream <> None)
|
||||||
|
do
|
||||||
|
Printf.printf "gemm\n%!";
|
||||||
|
let m_H_aux, m_F_aux = make_h_and_f batch_size in
|
||||||
|
let hf =
|
||||||
|
gemm m_H_aux m_F_aux ~transb:`T
|
||||||
|
in
|
||||||
|
ignore @@ Mat.add result hf ~c:result
|
||||||
|
done;
|
||||||
|
result
|
||||||
in
|
in
|
||||||
|
|
||||||
|
|
||||||
@ -200,7 +247,7 @@ let dressing_vector ~frozen_core aux_basis f12_amplitudes ci =
|
|||||||
|
|
||||||
Printf.printf "Done\n%!";
|
Printf.printf "Done\n%!";
|
||||||
gemm m_HF f12_amplitudes
|
gemm m_HF f12_amplitudes
|
||||||
|> Matrix.sparse_of_mat
|
|> Matrix.dense_of_mat
|
||||||
|
|
||||||
|
|
||||||
|
|
||||||
@ -211,6 +258,7 @@ let make ~simulation ?(threshold=1.e-12) ~frozen_core ~mo_basis ~aux_basis_filen
|
|||||||
let f12 = Util.of_some @@ Simulation.f12 simulation in
|
let f12 = Util.of_some @@ Simulation.f12 simulation in
|
||||||
let mo_num = MOBasis.size mo_basis in
|
let mo_num = MOBasis.size mo_basis in
|
||||||
|
|
||||||
|
Printf.printf "Add aux basis\n%!";
|
||||||
(* Add auxiliary basis set *)
|
(* Add auxiliary basis set *)
|
||||||
let s =
|
let s =
|
||||||
let charge = Charge.to_int @@ Simulation.charge simulation
|
let charge = Charge.to_int @@ Simulation.charge simulation
|
||||||
@ -230,7 +278,16 @@ let make ~simulation ?(threshold=1.e-12) ~frozen_core ~mo_basis ~aux_basis_filen
|
|||||||
let aux_basis =
|
let aux_basis =
|
||||||
MOBasis.of_mo_basis s mo_basis
|
MOBasis.of_mo_basis s mo_basis
|
||||||
in
|
in
|
||||||
|
let () =
|
||||||
|
Printf.printf "F12 ints\n%!";
|
||||||
|
ignore @@ MOBasis.f12_ints aux_basis
|
||||||
|
in
|
||||||
|
let () =
|
||||||
|
Printf.printf "2e ints\n%!";
|
||||||
|
ignore @@ MOBasis.two_e_ints aux_basis
|
||||||
|
in
|
||||||
|
|
||||||
|
Printf.printf "det space\n%!";
|
||||||
let det_space =
|
let det_space =
|
||||||
DeterminantSpace.fci_f12_of_mo_basis aux_basis ~frozen_core mo_num
|
DeterminantSpace.fci_f12_of_mo_basis aux_basis ~frozen_core mo_num
|
||||||
in
|
in
|
||||||
@ -243,12 +300,12 @@ let make ~simulation ?(threshold=1.e-12) ~frozen_core ~mo_basis ~aux_basis_filen
|
|||||||
in
|
in
|
||||||
|
|
||||||
|
|
||||||
|
(*
|
||||||
let f12_amplitudes =
|
let f12_amplitudes =
|
||||||
fun c ->
|
fun c ->
|
||||||
let result = lacpy c in
|
let result = lacpy c in
|
||||||
Mat.scal (0.5) result ;
|
Mat.scal (0.5) result ;
|
||||||
result
|
result
|
||||||
(*
|
|
||||||
(* While in a sequential region, initiate the parallel
|
(* While in a sequential region, initiate the parallel
|
||||||
4-idx transformation to avoid nested parallel jobs
|
4-idx transformation to avoid nested parallel jobs
|
||||||
*)
|
*)
|
||||||
@ -276,8 +333,8 @@ let make ~simulation ?(threshold=1.e-12) ~frozen_core ~mo_basis ~aux_basis_filen
|
|||||||
if abs_float norm.{1,1} > 1. then
|
if abs_float norm.{1,1} > 1. then
|
||||||
failwith "Norm of |F> > 1";
|
failwith "Norm of |F> > 1";
|
||||||
result
|
result
|
||||||
*)
|
|
||||||
in
|
in
|
||||||
|
*)
|
||||||
|
|
||||||
let e_shift =
|
let e_shift =
|
||||||
let det =
|
let det =
|
||||||
@ -294,7 +351,7 @@ let make ~simulation ?(threshold=1.e-12) ~frozen_core ~mo_basis ~aux_basis_filen
|
|||||||
|
|
||||||
let rec iteration ?(state=1) psi =
|
let rec iteration ?(state=1) psi =
|
||||||
let delta =
|
let delta =
|
||||||
dressing_vector ~frozen_core aux_basis (f12_amplitudes psi) ci
|
dressing_vector ~frozen_core aux_basis psi ci
|
||||||
in
|
in
|
||||||
|
|
||||||
let f = 1.0 /. psi.{1,1} in
|
let f = 1.0 /. psi.{1,1} in
|
||||||
|
@ -76,7 +76,7 @@ let () =
|
|||||||
in
|
in
|
||||||
|
|
||||||
let fcif12 =
|
let fcif12 =
|
||||||
F12CI.make ~simulation ~frozen_core:true ~mo_basis ~aux_basis_filename ()
|
F12CI.make ~simulation ~frozen_core:false ~mo_basis ~aux_basis_filename ()
|
||||||
in
|
in
|
||||||
|
|
||||||
let ci = F12CI.ci fcif12 in
|
let ci = F12CI.ci fcif12 in
|
||||||
|
Loading…
Reference in New Issue
Block a user