10
1
mirror of https://gitlab.com/scemama/QCaml.git synced 2024-10-31 19:23:40 +01:00

Matrix product in batches

This commit is contained in:
Anthony Scemama 2019-03-28 09:37:43 +01:00
parent 69faafb6f7
commit f77b7f07d5
2 changed files with 94 additions and 37 deletions

View File

@ -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

View File

@ -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