mirror of
https://gitlab.com/scemama/QCaml.git
synced 2024-08-30 00:03:42 +02:00
Merge branch 'master' of gitlab.com:scemama/QCaml
This commit is contained in:
commit
d6dd38d706
@ -47,14 +47,8 @@ let make ~cartesian ~basis ?f12 nuclei =
|
|||||||
) in
|
) in
|
||||||
|
|
||||||
let f12_ints = lazy (
|
let f12_ints = lazy (
|
||||||
let f12 =
|
F12.of_basis basis
|
||||||
match f12 with
|
) in
|
||||||
| Some f12 -> f12
|
|
||||||
| None -> failwith "Missing f12 factor"
|
|
||||||
in
|
|
||||||
F12.of_basis f12 basis
|
|
||||||
)
|
|
||||||
in
|
|
||||||
|
|
||||||
{ basis ; overlap ; ortho ; eN_ints ; kin_ints ; ee_ints ; f12_ints ;
|
{ basis ; overlap ; ortho ; eN_ints ; kin_ints ; ee_ints ; f12_ints ;
|
||||||
cartesian ;
|
cartesian ;
|
||||||
|
@ -31,7 +31,7 @@ val cartesian : t -> bool
|
|||||||
|
|
||||||
(** {1 Creators} *)
|
(** {1 Creators} *)
|
||||||
|
|
||||||
val make : cartesian:bool -> basis:Basis.t -> ?f12:F12.f12_factor -> Nuclei.t -> t
|
val make : cartesian:bool -> basis:Basis.t -> ?f12:F12factor.t -> Nuclei.t -> t
|
||||||
(** Creates the data structure for atomic orbitals from a {Basis.t} and the
|
(** Creates the data structure for atomic orbitals from a {Basis.t} and the
|
||||||
molecular geometry {Nuclei.t} *)
|
molecular geometry {Nuclei.t} *)
|
||||||
|
|
||||||
|
19
Basis/ERI.ml
19
Basis/ERI.ml
@ -3,9 +3,10 @@
|
|||||||
open Constants
|
open Constants
|
||||||
open Util
|
open Util
|
||||||
|
|
||||||
|
module Csp = ContractedShellPair
|
||||||
|
module Cspc = ContractedShellPairCouple
|
||||||
|
|
||||||
|
module T = struct
|
||||||
module Zm = struct
|
|
||||||
|
|
||||||
let name = "Electron repulsion integrals"
|
let name = "Electron repulsion integrals"
|
||||||
|
|
||||||
@ -35,8 +36,20 @@ module Zm = struct
|
|||||||
aux f 0 maxm;
|
aux f 0 maxm;
|
||||||
result
|
result
|
||||||
|
|
||||||
|
let class_of_contracted_shell_pair_couple shell_pair_couple =
|
||||||
|
let shell_p = Cspc.shell_pair_p shell_pair_couple
|
||||||
|
and shell_q = Cspc.shell_pair_q shell_pair_couple
|
||||||
|
in
|
||||||
|
if Array.length (Csp.shell_pairs shell_p) +
|
||||||
|
(Array.length (Csp.shell_pairs shell_q)) < 4 then
|
||||||
|
TwoElectronRR.contracted_class_shell_pair_couple
|
||||||
|
~zero_m shell_pair_couple
|
||||||
|
else
|
||||||
|
TwoElectronRRVectorized.contracted_class_shell_pairs
|
||||||
|
~zero_m shell_p shell_q
|
||||||
|
|
||||||
end
|
end
|
||||||
|
|
||||||
module M = TwoElectronIntegralsNonSeparable.Make(Zm)
|
module M = TwoElectronIntegrals.Make(T)
|
||||||
include M
|
include M
|
||||||
|
|
||||||
|
396
Basis/F12.ml
396
Basis/F12.ml
@ -5,397 +5,23 @@
|
|||||||
open Constants
|
open Constants
|
||||||
let cutoff = integrals_cutoff
|
let cutoff = integrals_cutoff
|
||||||
|
|
||||||
module Bs = Basis
|
module T = struct
|
||||||
module Cs = ContractedShell
|
|
||||||
module Csp = ContractedShellPair
|
|
||||||
module Cspc = ContractedShellPairCouple
|
|
||||||
module Fis = FourIdxStorage
|
|
||||||
|
|
||||||
|
|
||||||
include FourIdxStorage
|
|
||||||
|
|
||||||
type f12_factor =
|
|
||||||
{
|
|
||||||
expo_s : float ;
|
|
||||||
coef_g : float array;
|
|
||||||
expo_sg : float array;
|
|
||||||
expo_sg_inv : float array;
|
|
||||||
}
|
|
||||||
|
|
||||||
let make_gaussian_corr_factor expo_s coef_g expo_sg =
|
|
||||||
let expo_sg_inv =
|
|
||||||
Array.map (fun x -> 1. /. (x *. expo_s *. expo_s)) expo_sg
|
|
||||||
in
|
|
||||||
{
|
|
||||||
expo_s ; coef_g ; expo_sg ; expo_sg_inv
|
|
||||||
}
|
|
||||||
|
|
||||||
|
|
||||||
(* -1/expo_s *. exp (-expo_s r) *)
|
|
||||||
let gaussian_geminal expo_s =
|
|
||||||
let coef_g =
|
|
||||||
[| 0.3144 ; 0.3037 ; 0.1681 ; 0.09811 ; 0.06024 ; 0.03726 |]
|
|
||||||
|> Array.map (fun x -> -. x /. expo_s)
|
|
||||||
and expo_sg =
|
|
||||||
[| 0.2209 ; 1.004 ; 3.622 ; 12.16 ; 45.87 ; 254.4 |]
|
|
||||||
in
|
|
||||||
make_gaussian_corr_factor expo_s coef_g expo_sg
|
|
||||||
|
|
||||||
|
|
||||||
|
|
||||||
(* exp (-expo_s r) *)
|
|
||||||
let simple_gaussian_geminal expo_s =
|
|
||||||
let coef_g =
|
|
||||||
[| 0.3144 ; 0.3037 ; 0.1681 ; 0.09811 ; 0.06024 ; 0.03726 |]
|
|
||||||
and expo_sg =
|
|
||||||
[| 0.2209 ; 1.004 ; 3.622 ; 12.16 ; 45.87 ; 254.4 |]
|
|
||||||
in
|
|
||||||
make_gaussian_corr_factor expo_s coef_g expo_sg
|
|
||||||
|
|
||||||
|
|
||||||
|
|
||||||
(** r12 * exp ( -expo_s * r) *)
|
|
||||||
let gaussian_geminal_times_r12 expo_s =
|
|
||||||
let coef_g =
|
|
||||||
[| 0.2454 ; 0.2938 ; 0.1815 ; 0.11281 ; 0.07502 ; 0.05280 |]
|
|
||||||
and expo_sg =
|
|
||||||
[| 0.1824 ; 0.7118; 2.252 ; 6.474 ; 19.66 ; 77.92 |]
|
|
||||||
in make_gaussian_corr_factor expo_s coef_g expo_sg
|
|
||||||
|
|
||||||
|
|
||||||
(* exp (-expo_s r) *)
|
|
||||||
let simple_gaussian_geminal' expo_s =
|
|
||||||
let coef_g =
|
|
||||||
[|
|
|
||||||
-3.4793465193721626604883567779324948787689208984375 ;
|
|
||||||
-0.00571703486454788484955047422886309504974633455276489257812 ;
|
|
||||||
4.14878218728681513738365538301877677440643310546875 ;
|
|
||||||
0.202874298181392742623785352407139725983142852783203125 ;
|
|
||||||
0.0819187742387294803858566183407674543559551239013671875 ;
|
|
||||||
0.04225945671351955673644695821167260874062776565551757812 ;
|
|
||||||
|]
|
|
||||||
and expo_sg =
|
|
||||||
[|
|
|
||||||
0.63172472556807146570889699432882480323314666748046875;
|
|
||||||
26.3759196683467962429858744144439697265625;
|
|
||||||
0.63172102793029016876147352377302013337612152099609375;
|
|
||||||
7.08429025944207335641067402320913970470428466796875;
|
|
||||||
42.4442841447001910637482069432735443115234375;
|
|
||||||
391.44036073596890901171718724071979522705078125 ;
|
|
||||||
|]
|
|
||||||
in make_gaussian_corr_factor expo_s coef_g expo_sg
|
|
||||||
|
|
||||||
|
|
||||||
|
|
||||||
|
|
||||||
let one_over_r =
|
|
||||||
|
|
||||||
let coef_g = [|
|
|
||||||
841.88478132 ; 70.590185207 ; 18.3616020768 ; 7.2608642093 ;
|
|
||||||
3.57483416444 ; 2.01376031082 ; 1.24216542801 ; 0.81754348620 ;
|
|
||||||
0.564546514023 ; 0.404228610699 ; 0.297458536575 ; 0.223321219537 ;
|
|
||||||
0.169933732064 ; 0.130190978230 ; 0.099652303426 ; 0.075428246546 ;
|
|
||||||
0.0555635614051 ; 0.0386791283055 ; 0.0237550435652 ; 0.010006278387 ;
|
|
||||||
|]
|
|
||||||
and expo_sg_inv =
|
|
||||||
[| 84135.654509 ; 2971.58727634 ; 474.716025959 ; 130.676724560 ;
|
|
||||||
47.3938388887 ; 20.2078651631 ; 9.5411021938 ; 4.8109546955 ;
|
|
||||||
2.52795733067 ; 1.35894103210 ; 0.73586710268 ; 0.39557629706 ;
|
|
||||||
0.20785895177 ; 0.104809693858 ; 0.049485682527 ; 0.021099788990 ;
|
|
||||||
0.007652472186 ; 0.0021065225215 ; 0.0003365204879 ; 0.0000118855674 |]
|
|
||||||
in make_gaussian_corr_factor 1.0 coef_g expo_sg_inv
|
|
||||||
|
|
||||||
|
|
||||||
|
|
||||||
|
|
||||||
|
|
||||||
|
|
||||||
module Zero_m = struct
|
|
||||||
let name = "F12"
|
let name = "F12"
|
||||||
end
|
|
||||||
|
|
||||||
let class_of_contracted_shell_pair_couple f12 shell_pair_couple =
|
let f12_factor = F12factor.gaussian_geminal 1.0
|
||||||
|
|
||||||
|
let class_of_contracted_shell_pair_couple shell_pair_couple =
|
||||||
|
let g = f12_factor.F12factor.gaussian in
|
||||||
F12RR.contracted_class_shell_pair_couple
|
F12RR.contracted_class_shell_pair_couple
|
||||||
f12.expo_sg_inv f12.coef_g shell_pair_couple
|
g.GaussianOperator.expo_sg_inv
|
||||||
|
g.GaussianOperator.coef_g
|
||||||
|
shell_pair_couple
|
||||||
let filter_contracted_shell_pairs f12 ?(cutoff=integrals_cutoff) shell_pairs =
|
|
||||||
List.map (fun pair ->
|
|
||||||
match Cspc.make ~cutoff pair pair with
|
|
||||||
| Some cspc ->
|
|
||||||
let cls = class_of_contracted_shell_pair_couple f12 cspc in
|
|
||||||
(pair, Zmap.fold (fun key value accu -> max (abs_float value) accu) cls 0. )
|
|
||||||
(* TODO \sum_k |coef_k * integral_k| *)
|
|
||||||
| None -> (pair, -1.)
|
|
||||||
) shell_pairs
|
|
||||||
|> List.filter (fun (_, schwartz_p_max) -> schwartz_p_max >= cutoff)
|
|
||||||
|> List.map fst
|
|
||||||
|
|
||||||
|
|
||||||
(* TODO
|
|
||||||
let filter_contracted_shell_pair_couples
|
|
||||||
?(cutoff=integrals_cutoff) shell_pair_couples =
|
|
||||||
List.map (fun pair ->
|
|
||||||
let cls =
|
|
||||||
class_of_contracted_shell_pairs pair pair
|
|
||||||
in
|
|
||||||
(pair, Zmap.fold (fun key value accu -> max (abs_float value) accu) cls 0. )
|
|
||||||
) shell_pairs
|
|
||||||
|> List.filter (fun (_, schwartz_p_max) -> schwartz_p_max >= cutoff)
|
|
||||||
|> List.map fst
|
|
||||||
|
|
||||||
*)
|
|
||||||
|
|
||||||
|
|
||||||
let store_class basis ?(cutoff=integrals_cutoff) data f12 contracted_shell_pair_couple cls =
|
|
||||||
let to_powers x =
|
|
||||||
let open Zkey in
|
|
||||||
match to_powers x with
|
|
||||||
| Three x -> x
|
|
||||||
| _ -> assert false
|
|
||||||
in
|
|
||||||
|
|
||||||
let shell_p = Cspc.shell_pair_p contracted_shell_pair_couple
|
|
||||||
and shell_q = Cspc.shell_pair_q contracted_shell_pair_couple
|
|
||||||
in
|
|
||||||
|
|
||||||
(*
|
|
||||||
let lambda_inv = -. 1. /. f12.expo_s in
|
|
||||||
*)
|
|
||||||
Array.iteri (fun i_c powers_i ->
|
|
||||||
let i_c = Cs.index (Csp.shell_a shell_p) + i_c + 1 in
|
|
||||||
let xi = to_powers powers_i in
|
|
||||||
Array.iteri (fun j_c powers_j ->
|
|
||||||
let j_c = Cs.index (Csp.shell_b shell_p) + j_c + 1 in
|
|
||||||
let xj = to_powers powers_j in
|
|
||||||
Array.iteri (fun k_c powers_k ->
|
|
||||||
let k_c = Cs.index (Csp.shell_a shell_q) + k_c + 1 in
|
|
||||||
let xk = to_powers powers_k in
|
|
||||||
Array.iteri (fun l_c powers_l ->
|
|
||||||
let l_c = Cs.index (Csp.shell_b shell_q) + l_c + 1 in
|
|
||||||
let xl = to_powers powers_l in
|
|
||||||
let key = Zkey.of_powers_twelve xi xj xk xl in
|
|
||||||
let value = Zmap.find cls key in
|
|
||||||
(*
|
|
||||||
lambda_inv *. (s.{i_c,j_c} *. s.{k_c,l_c} -. value)
|
|
||||||
lambda_inv *. value
|
|
||||||
*)
|
|
||||||
value
|
|
||||||
|> set_chem data i_c j_c k_c l_c
|
|
||||||
) (Cs.zkey_array (Csp.shell_b shell_q))
|
|
||||||
) (Cs.zkey_array (Csp.shell_a shell_q))
|
|
||||||
) (Cs.zkey_array (Csp.shell_b shell_p))
|
|
||||||
) (Cs.zkey_array (Csp.shell_a shell_p))
|
|
||||||
|
|
||||||
|
|
||||||
|
|
||||||
|
|
||||||
|
|
||||||
|
|
||||||
let of_basis_serial f12 basis =
|
|
||||||
|
|
||||||
let n = Bs.size basis
|
|
||||||
and shell = Bs.contracted_shells basis
|
|
||||||
in
|
|
||||||
|
|
||||||
let eri_array =
|
|
||||||
Fis.create ~size:n `Dense
|
|
||||||
(*
|
|
||||||
Fis.create ~size:n `Sparse
|
|
||||||
*)
|
|
||||||
in
|
|
||||||
|
|
||||||
let t0 = Unix.gettimeofday () in
|
|
||||||
|
|
||||||
let shell_pairs =
|
|
||||||
Csp.of_contracted_shell_array shell
|
|
||||||
|> filter_contracted_shell_pairs f12 ~cutoff
|
|
||||||
in
|
|
||||||
|
|
||||||
Printf.printf "%d significant shell pairs computed in %f seconds\n"
|
|
||||||
(List.length shell_pairs) (Unix.gettimeofday () -. t0);
|
|
||||||
|
|
||||||
|
|
||||||
let t0 = Unix.gettimeofday () in
|
|
||||||
let ishell = ref 0 in
|
|
||||||
|
|
||||||
List.iter (fun shell_p ->
|
|
||||||
let () =
|
|
||||||
if (Cs.index (Csp.shell_a shell_p) > !ishell) then
|
|
||||||
(ishell := Cs.index (Csp.shell_a shell_p) ; print_int !ishell ; print_newline ())
|
|
||||||
in
|
|
||||||
|
|
||||||
let sp =
|
|
||||||
Csp.shell_pairs shell_p
|
|
||||||
in
|
|
||||||
|
|
||||||
try
|
|
||||||
List.iter (fun shell_q ->
|
|
||||||
let () =
|
|
||||||
if Cs.index (Csp.shell_a shell_q) >
|
|
||||||
Cs.index (Csp.shell_a shell_p) then
|
|
||||||
raise Exit
|
|
||||||
in
|
|
||||||
let sq = Csp.shell_pairs shell_q in
|
|
||||||
let cspc =
|
|
||||||
if Array.length sp < Array.length sq then
|
|
||||||
Cspc.make ~cutoff shell_p shell_q
|
|
||||||
else
|
|
||||||
Cspc.make ~cutoff shell_q shell_p
|
|
||||||
in
|
|
||||||
|
|
||||||
match cspc with
|
|
||||||
| Some cspc ->
|
|
||||||
let cls =
|
|
||||||
class_of_contracted_shell_pair_couple f12 cspc
|
|
||||||
in
|
|
||||||
store_class basis ~cutoff eri_array f12 cspc cls
|
|
||||||
| None -> ()
|
|
||||||
) shell_pairs
|
|
||||||
with Exit -> ()
|
|
||||||
) shell_pairs ;
|
|
||||||
Printf.printf "Computed ERIs in %f seconds\n%!" (Unix.gettimeofday () -. t0);
|
|
||||||
eri_array
|
|
||||||
|
|
||||||
|
|
||||||
|
|
||||||
|
|
||||||
|
|
||||||
|
|
||||||
|
|
||||||
(* Parallel functions *)
|
|
||||||
|
|
||||||
|
|
||||||
|
|
||||||
let of_basis_parallel f12 basis =
|
|
||||||
|
|
||||||
let n = Bs.size basis
|
|
||||||
and shell = Bs.contracted_shells basis
|
|
||||||
in
|
|
||||||
|
|
||||||
let store_class_parallel
|
|
||||||
?(cutoff=integrals_cutoff) contracted_shell_pair_couple cls =
|
|
||||||
let to_powers x =
|
|
||||||
let open Zkey in
|
|
||||||
match to_powers x with
|
|
||||||
| Three x -> x
|
|
||||||
| _ -> assert false
|
|
||||||
in
|
|
||||||
|
|
||||||
let shell_p = Cspc.shell_pair_p contracted_shell_pair_couple
|
|
||||||
and shell_q = Cspc.shell_pair_q contracted_shell_pair_couple
|
|
||||||
in
|
|
||||||
|
|
||||||
let result = ref [] in
|
|
||||||
Array.iteri (fun i_c powers_i ->
|
|
||||||
let i_c = Cs.index (Csp.shell_a shell_p) + i_c + 1 in
|
|
||||||
let xi = to_powers powers_i in
|
|
||||||
Array.iteri (fun j_c powers_j ->
|
|
||||||
let j_c = Cs.index (Csp.shell_b shell_p) + j_c + 1 in
|
|
||||||
let xj = to_powers powers_j in
|
|
||||||
Array.iteri (fun k_c powers_k ->
|
|
||||||
let k_c = Cs.index (Csp.shell_a shell_q) + k_c + 1 in
|
|
||||||
let xk = to_powers powers_k in
|
|
||||||
Array.iteri (fun l_c powers_l ->
|
|
||||||
let l_c = Cs.index (Csp.shell_b shell_q) + l_c + 1 in
|
|
||||||
let xl = to_powers powers_l in
|
|
||||||
let key = Zkey.of_powers_twelve xi xj xk xl in
|
|
||||||
let value = Zmap.find cls key in
|
|
||||||
result := (i_c, j_c, k_c, l_c, value) :: !result
|
|
||||||
) (Cs.zkey_array (Csp.shell_b shell_q))
|
|
||||||
) (Cs.zkey_array (Csp.shell_a shell_q))
|
|
||||||
) (Cs.zkey_array (Csp.shell_b shell_p))
|
|
||||||
) (Cs.zkey_array (Csp.shell_a shell_p));
|
|
||||||
!result
|
|
||||||
in
|
|
||||||
|
|
||||||
|
|
||||||
|
|
||||||
let t0 = Unix.gettimeofday () in
|
|
||||||
|
|
||||||
let shell_pairs =
|
|
||||||
Csp.of_contracted_shell_array shell
|
|
||||||
|> filter_contracted_shell_pairs f12 ~cutoff
|
|
||||||
in
|
|
||||||
|
|
||||||
if Parallel.master then
|
|
||||||
Printf.printf "%d significant shell pairs computed in %f seconds\n"
|
|
||||||
(List.length shell_pairs) (Unix.gettimeofday () -. t0);
|
|
||||||
|
|
||||||
|
|
||||||
let t0 = Unix.gettimeofday () in
|
|
||||||
let ishell = ref max_int in
|
|
||||||
|
|
||||||
let input_stream = Stream.of_list (List.rev shell_pairs) in
|
|
||||||
|
|
||||||
let f shell_p =
|
|
||||||
let () =
|
|
||||||
if Parallel.rank < 2 && Cs.index (Csp.shell_a shell_p) < !ishell then
|
|
||||||
(ishell := Cs.index (Csp.shell_a shell_p) ; print_int !ishell ; print_newline ())
|
|
||||||
in
|
|
||||||
|
|
||||||
let sp =
|
|
||||||
Csp.shell_pairs shell_p
|
|
||||||
in
|
|
||||||
|
|
||||||
let result = ref [] in
|
|
||||||
try
|
|
||||||
List.iter (fun shell_q ->
|
|
||||||
let () =
|
|
||||||
if Cs.index (Csp.shell_a shell_q) >
|
|
||||||
Cs.index (Csp.shell_a shell_p) then
|
|
||||||
raise Exit
|
|
||||||
in
|
|
||||||
let sq = Csp.shell_pairs shell_q in
|
|
||||||
let cspc =
|
|
||||||
if Array.length sp < Array.length sq then
|
|
||||||
Cspc.make ~cutoff shell_p shell_q
|
|
||||||
else
|
|
||||||
Cspc.make ~cutoff shell_q shell_p
|
|
||||||
in
|
|
||||||
|
|
||||||
match cspc with
|
|
||||||
| Some cspc ->
|
|
||||||
let cls =
|
|
||||||
class_of_contracted_shell_pair_couple f12 cspc
|
|
||||||
in
|
|
||||||
result := (store_class_parallel ~cutoff cspc cls) :: !result;
|
|
||||||
| None -> ()
|
|
||||||
) shell_pairs;
|
|
||||||
raise Exit
|
|
||||||
with Exit -> List.concat !result |> Array.of_list
|
|
||||||
in
|
|
||||||
|
|
||||||
let eri_array =
|
|
||||||
if Parallel.master then
|
|
||||||
Fis.create ~size:n `Dense
|
|
||||||
else
|
|
||||||
Fis.create ~size:n `Dense
|
|
||||||
in
|
|
||||||
|
|
||||||
Farm.run ~ordered:false ~f input_stream
|
|
||||||
|> Stream.iter (fun l ->
|
|
||||||
Array.iter (fun (i_c,j_c,k_c,l_c,value) ->
|
|
||||||
(*
|
|
||||||
lambda_inv *. (s.{i_c,j_c} *. s.{k_c,l_c} -. value)
|
|
||||||
lambda_inv *. value
|
|
||||||
*)
|
|
||||||
value
|
|
||||||
|> set_chem eri_array i_c j_c k_c l_c) l);
|
|
||||||
|
|
||||||
if Parallel.master then
|
|
||||||
Printf.printf
|
|
||||||
"Computed %s Integrals in parallel in %f seconds\n%!" Zero_m.name (Unix.gettimeofday () -. t0);
|
|
||||||
Fis.broadcast eri_array
|
|
||||||
|
|
||||||
|
|
||||||
|
|
||||||
let of_basis =
|
|
||||||
match Parallel.size with
|
|
||||||
| 1 -> of_basis_serial
|
|
||||||
| _ -> of_basis_parallel
|
|
||||||
|
|
||||||
|
end
|
||||||
|
|
||||||
|
module M = TwoElectronIntegrals.Make(T)
|
||||||
|
include M
|
||||||
|
|
||||||
|
|
||||||
|
|
||||||
|
78
Basis/F12factor.ml
Normal file
78
Basis/F12factor.ml
Normal file
@ -0,0 +1,78 @@
|
|||||||
|
(** Type for f12 correlation factors *)
|
||||||
|
|
||||||
|
open Constants
|
||||||
|
|
||||||
|
type t =
|
||||||
|
{
|
||||||
|
expo_s : float ;
|
||||||
|
gaussian : GaussianOperator.t
|
||||||
|
}
|
||||||
|
|
||||||
|
|
||||||
|
let make_gaussian_corr_factor expo_s coef_g expo_sg =
|
||||||
|
let expo_sg =
|
||||||
|
Array.map (fun x -> x *. expo_s *. expo_s) expo_sg
|
||||||
|
in
|
||||||
|
let gaussian = GaussianOperator.make coef_g expo_sg in
|
||||||
|
{ expo_s ; gaussian }
|
||||||
|
|
||||||
|
|
||||||
|
(* -1/expo_s *. exp (-expo_s r) *)
|
||||||
|
let gaussian_geminal expo_s =
|
||||||
|
let coef_g =
|
||||||
|
[| 0.3144 ; 0.3037 ; 0.1681 ; 0.09811 ; 0.06024 ; 0.03726 |]
|
||||||
|
|> Array.map (fun x -> -. x /. expo_s)
|
||||||
|
and expo_sg =
|
||||||
|
[| 0.2209 ; 1.004 ; 3.622 ; 12.16 ; 45.87 ; 254.4 |]
|
||||||
|
in
|
||||||
|
make_gaussian_corr_factor expo_s coef_g expo_sg
|
||||||
|
|
||||||
|
|
||||||
|
|
||||||
|
(* exp (-expo_s r) *)
|
||||||
|
let simple_gaussian_geminal expo_s =
|
||||||
|
let coef_g =
|
||||||
|
[| 0.3144 ; 0.3037 ; 0.1681 ; 0.09811 ; 0.06024 ; 0.03726 |]
|
||||||
|
and expo_sg =
|
||||||
|
[| 0.2209 ; 1.004 ; 3.622 ; 12.16 ; 45.87 ; 254.4 |]
|
||||||
|
in
|
||||||
|
make_gaussian_corr_factor expo_s coef_g expo_sg
|
||||||
|
|
||||||
|
|
||||||
|
|
||||||
|
(** r12 * exp ( -expo_s * r) *)
|
||||||
|
let gaussian_geminal_times_r12 expo_s =
|
||||||
|
let coef_g =
|
||||||
|
[| 0.2454 ; 0.2938 ; 0.1815 ; 0.11281 ; 0.07502 ; 0.05280 |]
|
||||||
|
and expo_sg =
|
||||||
|
[| 0.1824 ; 0.7118; 2.252 ; 6.474 ; 19.66 ; 77.92 |]
|
||||||
|
in make_gaussian_corr_factor expo_s coef_g expo_sg
|
||||||
|
|
||||||
|
|
||||||
|
(* exp (-expo_s r) *)
|
||||||
|
let simple_gaussian_geminal' expo_s =
|
||||||
|
let coef_g =
|
||||||
|
[|
|
||||||
|
-3.4793465193721626604883567779324948787689208984375 ;
|
||||||
|
-0.00571703486454788484955047422886309504974633455276489257812 ;
|
||||||
|
4.14878218728681513738365538301877677440643310546875 ;
|
||||||
|
0.202874298181392742623785352407139725983142852783203125 ;
|
||||||
|
0.0819187742387294803858566183407674543559551239013671875 ;
|
||||||
|
0.04225945671351955673644695821167260874062776565551757812 ;
|
||||||
|
|]
|
||||||
|
and expo_sg =
|
||||||
|
[|
|
||||||
|
0.63172472556807146570889699432882480323314666748046875;
|
||||||
|
26.3759196683467962429858744144439697265625;
|
||||||
|
0.63172102793029016876147352377302013337612152099609375;
|
||||||
|
7.08429025944207335641067402320913970470428466796875;
|
||||||
|
42.4442841447001910637482069432735443115234375;
|
||||||
|
391.44036073596890901171718724071979522705078125 ;
|
||||||
|
|]
|
||||||
|
in make_gaussian_corr_factor expo_s coef_g expo_sg
|
||||||
|
|
||||||
|
|
||||||
|
|
||||||
|
|
||||||
|
|
||||||
|
|
39
Basis/GaussianOperator.ml
Normal file
39
Basis/GaussianOperator.ml
Normal file
@ -0,0 +1,39 @@
|
|||||||
|
(** Representation for two-electron operators expressed in a Gaussian basis set. *)
|
||||||
|
|
||||||
|
open Constants
|
||||||
|
|
||||||
|
type t =
|
||||||
|
{
|
||||||
|
coef_g : float array;
|
||||||
|
expo_sg : float array;
|
||||||
|
expo_sg_inv : float array;
|
||||||
|
}
|
||||||
|
|
||||||
|
let make coef_g expo_sg =
|
||||||
|
let expo_sg_inv =
|
||||||
|
Array.map (fun x -> 1. /. x ) expo_sg
|
||||||
|
in
|
||||||
|
{ coef_g ; expo_sg ; expo_sg_inv }
|
||||||
|
|
||||||
|
|
||||||
|
let one_over_r =
|
||||||
|
|
||||||
|
let coef_g = [|
|
||||||
|
841.88478132 ; 70.590185207 ; 18.3616020768 ; 7.2608642093 ;
|
||||||
|
3.57483416444 ; 2.01376031082 ; 1.24216542801 ; 0.81754348620 ;
|
||||||
|
0.564546514023 ; 0.404228610699 ; 0.297458536575 ; 0.223321219537 ;
|
||||||
|
0.169933732064 ; 0.130190978230 ; 0.099652303426 ; 0.075428246546 ;
|
||||||
|
0.0555635614051 ; 0.0386791283055 ; 0.0237550435652 ; 0.010006278387 ;
|
||||||
|
|]
|
||||||
|
and expo_sg =
|
||||||
|
[| 84135.654509 ; 2971.58727634 ; 474.716025959 ; 130.676724560 ;
|
||||||
|
47.3938388887 ; 20.2078651631 ; 9.5411021938 ; 4.8109546955 ;
|
||||||
|
2.52795733067 ; 1.35894103210 ; 0.73586710268 ; 0.39557629706 ;
|
||||||
|
0.20785895177 ; 0.104809693858 ; 0.049485682527 ; 0.021099788990 ;
|
||||||
|
0.007652472186 ; 0.0021065225215 ; 0.0003365204879 ; 0.0000118855674 |]
|
||||||
|
in make coef_g expo_sg
|
||||||
|
|
||||||
|
|
||||||
|
|
||||||
|
|
||||||
|
|
@ -1,5 +1,4 @@
|
|||||||
(** Two electron integral functor for operators that are not separable among %{ $(x,y,z)$ %}.
|
(** Two electron integrals
|
||||||
It is parameterized by the [zero_m] function.
|
|
||||||
*)
|
*)
|
||||||
|
|
||||||
open Constants
|
open Constants
|
||||||
@ -11,30 +10,18 @@ module Csp = ContractedShellPair
|
|||||||
module Cspc = ContractedShellPairCouple
|
module Cspc = ContractedShellPairCouple
|
||||||
module Fis = FourIdxStorage
|
module Fis = FourIdxStorage
|
||||||
|
|
||||||
module type Zero_mType =
|
module type TwoEI_structure =
|
||||||
sig
|
sig
|
||||||
val name : string
|
val name : string
|
||||||
val zero_m : Zero_m_parameters.t -> float array
|
val class_of_contracted_shell_pair_couple : ContractedShellPairCouple.t -> float Zmap.t
|
||||||
end
|
end
|
||||||
|
|
||||||
|
|
||||||
module Make(Zero_m : Zero_mType) = struct
|
module Make(T : TwoEI_structure) = struct
|
||||||
|
|
||||||
include FourIdxStorage
|
include FourIdxStorage
|
||||||
|
|
||||||
let zero_m = Zero_m.zero_m
|
let class_of_contracted_shell_pair_couple = T.class_of_contracted_shell_pair_couple
|
||||||
|
|
||||||
let class_of_contracted_shell_pair_couple shell_pair_couple =
|
|
||||||
let shell_p = Cspc.shell_pair_p shell_pair_couple
|
|
||||||
and shell_q = Cspc.shell_pair_q shell_pair_couple
|
|
||||||
in
|
|
||||||
if Array.length (Csp.shell_pairs shell_p) +
|
|
||||||
(Array.length (Csp.shell_pairs shell_q)) < 4 then
|
|
||||||
TwoElectronRR.contracted_class_shell_pair_couple
|
|
||||||
~zero_m shell_pair_couple
|
|
||||||
else
|
|
||||||
TwoElectronRRVectorized.contracted_class_shell_pairs
|
|
||||||
~zero_m shell_p shell_q
|
|
||||||
|
|
||||||
let filter_contracted_shell_pairs ?(cutoff=integrals_cutoff) shell_pairs =
|
let filter_contracted_shell_pairs ?(cutoff=integrals_cutoff) shell_pairs =
|
||||||
List.map (fun pair ->
|
List.map (fun pair ->
|
||||||
@ -283,6 +270,7 @@ module Make(Zero_m : Zero_mType) = struct
|
|||||||
else
|
else
|
||||||
Fis.create ~size:n `Dense
|
Fis.create ~size:n `Dense
|
||||||
in
|
in
|
||||||
|
|
||||||
Farm.run ~ordered:true ~f input_stream
|
Farm.run ~ordered:true ~f input_stream
|
||||||
|> Stream.iter (fun l ->
|
|> Stream.iter (fun l ->
|
||||||
Array.iter (fun (i_c,j_c,k_c,l_c,value) ->
|
Array.iter (fun (i_c,j_c,k_c,l_c,value) ->
|
||||||
@ -290,7 +278,7 @@ module Make(Zero_m : Zero_mType) = struct
|
|||||||
|
|
||||||
if Parallel.master then
|
if Parallel.master then
|
||||||
Printf.printf
|
Printf.printf
|
||||||
"Computed %s Integrals in parallel in %f seconds\n%!" Zero_m.name (Unix.gettimeofday () -. t0);
|
"Computed %s Integrals in parallel in %f seconds\n%!" T.name (Unix.gettimeofday () -. t0);
|
||||||
Fis.broadcast eri_array
|
Fis.broadcast eri_array
|
||||||
|
|
||||||
|
|
@ -6,27 +6,20 @@
|
|||||||
*)
|
*)
|
||||||
|
|
||||||
|
|
||||||
module type Zero_mType =
|
module type TwoEI_structure =
|
||||||
sig
|
sig
|
||||||
val name : string
|
val name : string
|
||||||
(** Name of the kind of integrals, for printing purposes. *)
|
(** Name of the kind of integrals, for printing purposes. *)
|
||||||
|
|
||||||
val zero_m : Zero_m_parameters.t -> float array
|
val class_of_contracted_shell_pair_couple : ContractedShellPairCouple.t -> float Zmap.t
|
||||||
(** The returned float array contains all the {% $(00|00)^m$ %} values, where
|
(** Returns an integral class from a couple of contracted shells.
|
||||||
[m] is the index of the array.
|
The results is stored in a Zmap.
|
||||||
|
|
||||||
- [maxm] : Maximum total angular momentum
|
|
||||||
- [expo_pq_inv] : {% $1/p + 1/q$ %} where {% $p$ %} and {% $q$ %} are the
|
|
||||||
exponents of {% $\phi_p$ %} and {% $\phi_q$ %}
|
|
||||||
- [norm_pq_sq] : square of the distance between the centers of
|
|
||||||
{% $\phi_p$ %} and {% $\phi_q$ %}
|
|
||||||
|
|
||||||
*)
|
*)
|
||||||
|
|
||||||
end
|
end
|
||||||
|
|
||||||
|
|
||||||
module Make : functor (Zero_m : Zero_mType) ->
|
|
||||||
|
module Make : functor (T : TwoEI_structure) ->
|
||||||
sig
|
sig
|
||||||
include module type of FourIdxStorage
|
include module type of FourIdxStorage
|
||||||
|
|
@ -1,330 +0,0 @@
|
|||||||
(** Two electron integral functor for operators that are separable among %{ $(x,y,z)$ %}.
|
|
||||||
It is parameterized by the [zero_m] function.
|
|
||||||
*)
|
|
||||||
|
|
||||||
open Constants
|
|
||||||
let cutoff = integrals_cutoff
|
|
||||||
|
|
||||||
module Bs = Basis
|
|
||||||
module Cs = ContractedShell
|
|
||||||
module Csp = ContractedShellPair
|
|
||||||
module Cspc = ContractedShellPairCouple
|
|
||||||
module Fis = FourIdxStorage
|
|
||||||
|
|
||||||
|
|
||||||
include FourIdxStorage
|
|
||||||
|
|
||||||
(** Exponent of the geminal *)
|
|
||||||
let expo_s = 1.0
|
|
||||||
|
|
||||||
(** Coefficients and exponents of the Gaussian fit of the Slater Geminal*)
|
|
||||||
let coef_g =
|
|
||||||
[| 0.3144 ; 0.3037 ; 0.1681 ; 0.09811 ; 0.06024 ; 0.03726 |]
|
|
||||||
|
|
||||||
let expo_sg_inv =
|
|
||||||
Array.map (fun x -> 1. /. (x *. expo_s *. expo_s))
|
|
||||||
[| 0.2209 ; 1.004 ; 3.622 ; 12.16 ; 45.87 ; 254.4 |]
|
|
||||||
|
|
||||||
|
|
||||||
|
|
||||||
(*
|
|
||||||
|
|
||||||
Fit of 1/r:
|
|
||||||
|
|
||||||
let coef_g = [|
|
|
||||||
841.88478132 ; 70.590185207 ; 18.3616020768 ; 7.2608642093 ;
|
|
||||||
3.57483416444 ; 2.01376031082 ; 1.24216542801 ; 0.81754348620 ;
|
|
||||||
0.564546514023 ; 0.404228610699 ; 0.297458536575 ; 0.223321219537 ;
|
|
||||||
0.169933732064 ; 0.130190978230 ; 0.099652303426 ; 0.075428246546 ;
|
|
||||||
0.0555635614051 ; 0.0386791283055 ; 0.0237550435652 ; 0.010006278387 ;
|
|
||||||
|]
|
|
||||||
|
|
||||||
let expo_sg_inv =
|
|
||||||
Array.map (fun x -> 1. /. (x *. expo_s *. expo_s))
|
|
||||||
[| 84135.654509 ; 2971.58727634 ; 474.716025959 ; 130.676724560 ;
|
|
||||||
47.3938388887 ; 20.2078651631 ; 9.5411021938 ; 4.8109546955 ;
|
|
||||||
2.52795733067 ; 1.35894103210 ; 0.73586710268 ; 0.39557629706 ;
|
|
||||||
0.20785895177 ; 0.104809693858 ; 0.049485682527 ; 0.021099788990 ;
|
|
||||||
0.007652472186 ; 0.0021065225215 ; 0.0003365204879 ; 0.0000118855674 |]
|
|
||||||
*)
|
|
||||||
|
|
||||||
|
|
||||||
let class_of_contracted_shell_pair_couple shell_pair_couple =
|
|
||||||
F12RR.contracted_class_shell_pair_couple
|
|
||||||
expo_sg_inv coef_g shell_pair_couple
|
|
||||||
|
|
||||||
|
|
||||||
|
|
||||||
|
|
||||||
module Zero_m = struct
|
|
||||||
let name = "F12"
|
|
||||||
end
|
|
||||||
|
|
||||||
|
|
||||||
|
|
||||||
let filter_contracted_shell_pairs ?(cutoff=integrals_cutoff) shell_pairs =
|
|
||||||
List.map (fun pair ->
|
|
||||||
match Cspc.make ~cutoff pair pair with
|
|
||||||
| Some cspc ->
|
|
||||||
let cls = class_of_contracted_shell_pair_couple cspc in
|
|
||||||
(pair, Zmap.fold (fun key value accu -> max (abs_float value) accu) cls 0. )
|
|
||||||
(* TODO \sum_k |coef_k * integral_k| *)
|
|
||||||
| None -> (pair, -1.)
|
|
||||||
) shell_pairs
|
|
||||||
|> List.filter (fun (_, schwartz_p_max) -> schwartz_p_max >= cutoff)
|
|
||||||
|> List.map fst
|
|
||||||
|
|
||||||
|
|
||||||
(* TODO
|
|
||||||
let filter_contracted_shell_pair_couples
|
|
||||||
?(cutoff=integrals_cutoff) shell_pair_couples =
|
|
||||||
List.map (fun pair ->
|
|
||||||
let cls =
|
|
||||||
class_of_contracted_shell_pairs pair pair
|
|
||||||
in
|
|
||||||
(pair, Zmap.fold (fun key value accu -> max (abs_float value) accu) cls 0. )
|
|
||||||
) shell_pairs
|
|
||||||
|> List.filter (fun (_, schwartz_p_max) -> schwartz_p_max >= cutoff)
|
|
||||||
|> List.map fst
|
|
||||||
|
|
||||||
*)
|
|
||||||
|
|
||||||
|
|
||||||
let store_class ?(cutoff=integrals_cutoff) data contracted_shell_pair_couple cls =
|
|
||||||
let to_powers x =
|
|
||||||
let open Zkey in
|
|
||||||
match to_powers x with
|
|
||||||
| Three x -> x
|
|
||||||
| _ -> assert false
|
|
||||||
in
|
|
||||||
|
|
||||||
let shell_p = Cspc.shell_pair_p contracted_shell_pair_couple
|
|
||||||
and shell_q = Cspc.shell_pair_q contracted_shell_pair_couple
|
|
||||||
in
|
|
||||||
|
|
||||||
Array.iteri (fun i_c powers_i ->
|
|
||||||
let i_c = Cs.index (Csp.shell_a shell_p) + i_c + 1 in
|
|
||||||
let xi = to_powers powers_i in
|
|
||||||
Array.iteri (fun j_c powers_j ->
|
|
||||||
let j_c = Cs.index (Csp.shell_b shell_p) + j_c + 1 in
|
|
||||||
let xj = to_powers powers_j in
|
|
||||||
Array.iteri (fun k_c powers_k ->
|
|
||||||
let k_c = Cs.index (Csp.shell_a shell_q) + k_c + 1 in
|
|
||||||
let xk = to_powers powers_k in
|
|
||||||
Array.iteri (fun l_c powers_l ->
|
|
||||||
let l_c = Cs.index (Csp.shell_b shell_q) + l_c + 1 in
|
|
||||||
let xl = to_powers powers_l in
|
|
||||||
let key = Zkey.of_powers_twelve xi xj xk xl in
|
|
||||||
let value = Zmap.find cls key in
|
|
||||||
set_chem data i_c j_c k_c l_c value
|
|
||||||
) (Cs.zkey_array (Csp.shell_b shell_q))
|
|
||||||
) (Cs.zkey_array (Csp.shell_a shell_q))
|
|
||||||
) (Cs.zkey_array (Csp.shell_b shell_p))
|
|
||||||
) (Cs.zkey_array (Csp.shell_a shell_p))
|
|
||||||
|
|
||||||
|
|
||||||
|
|
||||||
|
|
||||||
|
|
||||||
|
|
||||||
let of_basis_serial basis =
|
|
||||||
|
|
||||||
let n = Bs.size basis
|
|
||||||
and shell = Bs.contracted_shells basis
|
|
||||||
in
|
|
||||||
|
|
||||||
let eri_array =
|
|
||||||
Fis.create ~size:n `Dense
|
|
||||||
(*
|
|
||||||
Fis.create ~size:n `Sparse
|
|
||||||
*)
|
|
||||||
in
|
|
||||||
|
|
||||||
let t0 = Unix.gettimeofday () in
|
|
||||||
|
|
||||||
let shell_pairs =
|
|
||||||
Csp.of_contracted_shell_array shell
|
|
||||||
|> filter_contracted_shell_pairs ~cutoff
|
|
||||||
in
|
|
||||||
|
|
||||||
Printf.printf "%d significant shell pairs computed in %f seconds\n"
|
|
||||||
(List.length shell_pairs) (Unix.gettimeofday () -. t0);
|
|
||||||
|
|
||||||
|
|
||||||
let t0 = Unix.gettimeofday () in
|
|
||||||
let ishell = ref 0 in
|
|
||||||
|
|
||||||
List.iter (fun shell_p ->
|
|
||||||
let () =
|
|
||||||
if (Cs.index (Csp.shell_a shell_p) > !ishell) then
|
|
||||||
(ishell := Cs.index (Csp.shell_a shell_p) ; print_int !ishell ; print_newline ())
|
|
||||||
in
|
|
||||||
|
|
||||||
let sp =
|
|
||||||
Csp.shell_pairs shell_p
|
|
||||||
in
|
|
||||||
|
|
||||||
try
|
|
||||||
List.iter (fun shell_q ->
|
|
||||||
let () =
|
|
||||||
if Cs.index (Csp.shell_a shell_q) >
|
|
||||||
Cs.index (Csp.shell_a shell_p) then
|
|
||||||
raise Exit
|
|
||||||
in
|
|
||||||
let sq = Csp.shell_pairs shell_q in
|
|
||||||
let cspc =
|
|
||||||
if Array.length sp < Array.length sq then
|
|
||||||
Cspc.make ~cutoff shell_p shell_q
|
|
||||||
else
|
|
||||||
Cspc.make ~cutoff shell_q shell_p
|
|
||||||
in
|
|
||||||
|
|
||||||
match cspc with
|
|
||||||
| Some cspc ->
|
|
||||||
let cls =
|
|
||||||
class_of_contracted_shell_pair_couple cspc
|
|
||||||
in
|
|
||||||
store_class ~cutoff eri_array cspc cls
|
|
||||||
| None -> ()
|
|
||||||
) shell_pairs
|
|
||||||
with Exit -> ()
|
|
||||||
) shell_pairs ;
|
|
||||||
Printf.printf "Computed ERIs in %f seconds\n%!" (Unix.gettimeofday () -. t0);
|
|
||||||
eri_array
|
|
||||||
|
|
||||||
|
|
||||||
|
|
||||||
|
|
||||||
|
|
||||||
|
|
||||||
|
|
||||||
(* Parallel functions *)
|
|
||||||
|
|
||||||
|
|
||||||
|
|
||||||
let of_basis_parallel basis =
|
|
||||||
|
|
||||||
let n = Bs.size basis
|
|
||||||
and shell = Bs.contracted_shells basis
|
|
||||||
in
|
|
||||||
|
|
||||||
let store_class_parallel
|
|
||||||
?(cutoff=integrals_cutoff) contracted_shell_pair_couple cls =
|
|
||||||
let to_powers x =
|
|
||||||
let open Zkey in
|
|
||||||
match to_powers x with
|
|
||||||
| Three x -> x
|
|
||||||
| _ -> assert false
|
|
||||||
in
|
|
||||||
|
|
||||||
let shell_p = Cspc.shell_pair_p contracted_shell_pair_couple
|
|
||||||
and shell_q = Cspc.shell_pair_q contracted_shell_pair_couple
|
|
||||||
in
|
|
||||||
|
|
||||||
let result = ref [] in
|
|
||||||
Array.iteri (fun i_c powers_i ->
|
|
||||||
let i_c = Cs.index (Csp.shell_a shell_p) + i_c + 1 in
|
|
||||||
let xi = to_powers powers_i in
|
|
||||||
Array.iteri (fun j_c powers_j ->
|
|
||||||
let j_c = Cs.index (Csp.shell_b shell_p) + j_c + 1 in
|
|
||||||
let xj = to_powers powers_j in
|
|
||||||
Array.iteri (fun k_c powers_k ->
|
|
||||||
let k_c = Cs.index (Csp.shell_a shell_q) + k_c + 1 in
|
|
||||||
let xk = to_powers powers_k in
|
|
||||||
Array.iteri (fun l_c powers_l ->
|
|
||||||
let l_c = Cs.index (Csp.shell_b shell_q) + l_c + 1 in
|
|
||||||
let xl = to_powers powers_l in
|
|
||||||
let key = Zkey.of_powers_twelve xi xj xk xl in
|
|
||||||
let value = Zmap.find cls key in
|
|
||||||
result := (i_c, j_c, k_c, l_c, value) :: !result
|
|
||||||
) (Cs.zkey_array (Csp.shell_b shell_q))
|
|
||||||
) (Cs.zkey_array (Csp.shell_a shell_q))
|
|
||||||
) (Cs.zkey_array (Csp.shell_b shell_p))
|
|
||||||
) (Cs.zkey_array (Csp.shell_a shell_p));
|
|
||||||
!result
|
|
||||||
in
|
|
||||||
|
|
||||||
|
|
||||||
|
|
||||||
let t0 = Unix.gettimeofday () in
|
|
||||||
|
|
||||||
let shell_pairs =
|
|
||||||
Csp.of_contracted_shell_array shell
|
|
||||||
|> filter_contracted_shell_pairs ~cutoff
|
|
||||||
in
|
|
||||||
|
|
||||||
if Parallel.master then
|
|
||||||
Printf.printf "%d significant shell pairs computed in %f seconds\n"
|
|
||||||
(List.length shell_pairs) (Unix.gettimeofday () -. t0);
|
|
||||||
|
|
||||||
|
|
||||||
let t0 = Unix.gettimeofday () in
|
|
||||||
let ishell = ref max_int in
|
|
||||||
|
|
||||||
let input_stream = Stream.of_list (List.rev shell_pairs) in
|
|
||||||
|
|
||||||
let f shell_p =
|
|
||||||
let () =
|
|
||||||
if Parallel.rank < 2 && Cs.index (Csp.shell_a shell_p) < !ishell then
|
|
||||||
(ishell := Cs.index (Csp.shell_a shell_p) ; print_int !ishell ; print_newline ())
|
|
||||||
in
|
|
||||||
|
|
||||||
let sp =
|
|
||||||
Csp.shell_pairs shell_p
|
|
||||||
in
|
|
||||||
|
|
||||||
let result = ref [] in
|
|
||||||
try
|
|
||||||
List.iter (fun shell_q ->
|
|
||||||
let () =
|
|
||||||
if Cs.index (Csp.shell_a shell_q) >
|
|
||||||
Cs.index (Csp.shell_a shell_p) then
|
|
||||||
raise Exit
|
|
||||||
in
|
|
||||||
let sq = Csp.shell_pairs shell_q in
|
|
||||||
let cspc =
|
|
||||||
if Array.length sp < Array.length sq then
|
|
||||||
Cspc.make ~cutoff shell_p shell_q
|
|
||||||
else
|
|
||||||
Cspc.make ~cutoff shell_q shell_p
|
|
||||||
in
|
|
||||||
|
|
||||||
match cspc with
|
|
||||||
| Some cspc ->
|
|
||||||
let cls =
|
|
||||||
class_of_contracted_shell_pair_couple cspc
|
|
||||||
in
|
|
||||||
result := (store_class_parallel ~cutoff cspc cls) :: !result;
|
|
||||||
| None -> ()
|
|
||||||
) shell_pairs;
|
|
||||||
raise Exit
|
|
||||||
with Exit -> List.concat !result |> Array.of_list
|
|
||||||
in
|
|
||||||
|
|
||||||
let eri_array =
|
|
||||||
if Parallel.master then
|
|
||||||
Fis.create ~size:n `Dense
|
|
||||||
else
|
|
||||||
Fis.create ~size:0 `Dense
|
|
||||||
in
|
|
||||||
Farm.run ~ordered:true ~f input_stream
|
|
||||||
|> Stream.iter (fun l ->
|
|
||||||
Array.iter (fun (i_c,j_c,k_c,l_c,value) ->
|
|
||||||
set_chem eri_array i_c j_c k_c l_c value) l);
|
|
||||||
|
|
||||||
if Parallel.master then
|
|
||||||
Printf.printf
|
|
||||||
"Computed %s Integrals in parallel in %f seconds\n%!" Zero_m.name (Unix.gettimeofday () -. t0);
|
|
||||||
Parallel.broadcast (lazy eri_array)
|
|
||||||
|
|
||||||
|
|
||||||
|
|
||||||
let of_basis =
|
|
||||||
match Parallel.size with
|
|
||||||
| 1 -> of_basis_serial
|
|
||||||
| _ -> of_basis_parallel
|
|
||||||
|
|
||||||
|
|
||||||
|
|
||||||
|
|
||||||
|
|
@ -4,7 +4,7 @@ type t = {
|
|||||||
nuclei : Nuclei.t;
|
nuclei : Nuclei.t;
|
||||||
basis : Basis.t;
|
basis : Basis.t;
|
||||||
ao_basis : AOBasis.t;
|
ao_basis : AOBasis.t;
|
||||||
f12 : F12.f12_factor option;
|
f12 : F12factor.t option;
|
||||||
nuclear_repulsion : float;
|
nuclear_repulsion : float;
|
||||||
}
|
}
|
||||||
|
|
||||||
|
@ -18,18 +18,18 @@ val ao_basis : t -> AOBasis.t
|
|||||||
val nuclear_repulsion : t -> float
|
val nuclear_repulsion : t -> float
|
||||||
(** Nuclear repulsion energy *)
|
(** Nuclear repulsion energy *)
|
||||||
|
|
||||||
val f12 : t -> F12.f12_factor option
|
val f12 : t -> F12factor.t option
|
||||||
(** f12 correlation factor *)
|
(** f12 correlation factor *)
|
||||||
|
|
||||||
(** {1 Creation} *)
|
(** {1 Creation} *)
|
||||||
|
|
||||||
val make :
|
val make :
|
||||||
?cartesian:bool ->
|
?cartesian:bool ->
|
||||||
?multiplicity:int -> ?charge:int -> ?f12:F12.f12_factor ->
|
?multiplicity:int -> ?charge:int -> ?f12:F12factor.t ->
|
||||||
nuclei:Nuclei.t -> Basis.t -> t
|
nuclei:Nuclei.t -> Basis.t -> t
|
||||||
|
|
||||||
val of_filenames :
|
val of_filenames :
|
||||||
?cartesian:bool ->
|
?cartesian:bool ->
|
||||||
?multiplicity:int -> ?charge:int -> ?f12:F12.f12_factor ->
|
?multiplicity:int -> ?charge:int -> ?f12:F12factor.t ->
|
||||||
nuclei:string -> ?aux_basis_filenames:string list -> string -> t
|
nuclei:string -> ?aux_basis_filenames:string list -> string -> t
|
||||||
|
|
||||||
|
@ -32,6 +32,8 @@ external leadz : int64 -> int32 = "leadz_bytecode" "leadz"
|
|||||||
[@@unboxed] [@@noalloc]
|
[@@unboxed] [@@noalloc]
|
||||||
(** bsf instruction *)
|
(** bsf instruction *)
|
||||||
|
|
||||||
|
external vfork : unit -> int = "unix_vfork" "unix_vfork"
|
||||||
|
|
||||||
let leadz i = leadz i |> Int32.to_int
|
let leadz i = leadz i |> Int32.to_int
|
||||||
|
|
||||||
|
|
||||||
@ -268,6 +270,12 @@ let stream_fold f init stream =
|
|||||||
in
|
in
|
||||||
aux init
|
aux init
|
||||||
|
|
||||||
|
(** {2 Array functions} *)
|
||||||
|
|
||||||
|
let array_range first last =
|
||||||
|
if last < first then [| |] else
|
||||||
|
Array.init (last-first+1) (fun i -> i+first)
|
||||||
|
|
||||||
|
|
||||||
(** {2 Linear algebra} *)
|
(** {2 Linear algebra} *)
|
||||||
|
|
||||||
|
@ -16,6 +16,8 @@ external gamma_float : float -> float = "gamma_float_bytecode" "gamma_float"
|
|||||||
[@@unboxed] [@@noalloc]
|
[@@unboxed] [@@noalloc]
|
||||||
(** Gamma function [gamma] from [libm] *)
|
(** Gamma function [gamma] from [libm] *)
|
||||||
|
|
||||||
|
external vfork : unit -> int = "unix_vfork" "unix_vfork"
|
||||||
|
|
||||||
(*
|
(*
|
||||||
external popcnt : int64 -> int32 = "popcnt_bytecode" "popcnt"
|
external popcnt : int64 -> int32 = "popcnt_bytecode" "popcnt"
|
||||||
[@@unboxed] [@@noalloc]
|
[@@unboxed] [@@noalloc]
|
||||||
|
@ -11,7 +11,7 @@ type index_value =
|
|||||||
type sparse_vector =
|
type sparse_vector =
|
||||||
{
|
{
|
||||||
n: int;
|
n: int;
|
||||||
v: index_value list
|
v: index_value array
|
||||||
}
|
}
|
||||||
|
|
||||||
type t =
|
type t =
|
||||||
@ -36,7 +36,7 @@ let get = function
|
|||||||
| Sparse { n ; v } -> (fun i ->
|
| Sparse { n ; v } -> (fun i ->
|
||||||
if i < 1 || i > n then invalid_arg "index out of bounds";
|
if i < 1 || i > n then invalid_arg "index out of bounds";
|
||||||
try
|
try
|
||||||
List.iter (fun {index ; value} ->
|
Array.iter (fun {index ; value} ->
|
||||||
if index=i then
|
if index=i then
|
||||||
raise (Found value)) v;
|
raise (Found value)) v;
|
||||||
raise Not_found
|
raise Not_found
|
||||||
@ -56,7 +56,7 @@ let sparse_of_dense ?(threshold=epsilon) = function
|
|||||||
| Sparse _ -> invalid_arg "Expected a dense vector"
|
| Sparse _ -> invalid_arg "Expected a dense vector"
|
||||||
| Dense v ->
|
| Dense v ->
|
||||||
let rec aux accu = function
|
let rec aux accu = function
|
||||||
| 0 -> accu
|
| 0 -> accu |> Array.of_list
|
||||||
| i ->
|
| i ->
|
||||||
let x = v.{i} in
|
let x = v.{i} in
|
||||||
if abs_float x < threshold then
|
if abs_float x < threshold then
|
||||||
@ -69,7 +69,7 @@ let sparse_of_dense ?(threshold=epsilon) = function
|
|||||||
|
|
||||||
|
|
||||||
let rec to_assoc_list ?(threshold=epsilon) = function
|
let rec to_assoc_list ?(threshold=epsilon) = function
|
||||||
| Sparse {n ; v} -> List.map (fun {index ; value} -> (index, value)) v
|
| Sparse {n ; v} -> Array.map (fun {index ; value} -> (index, value)) v |> Array.to_list
|
||||||
| Dense v -> to_assoc_list @@ sparse_of_dense ~threshold (Dense v)
|
| Dense v -> to_assoc_list @@ sparse_of_dense ~threshold (Dense v)
|
||||||
|
|
||||||
|
|
||||||
@ -77,7 +77,7 @@ let dense_of_sparse = function
|
|||||||
| Dense _ -> invalid_arg "Expected a sparse vector"
|
| Dense _ -> invalid_arg "Expected a sparse vector"
|
||||||
| Sparse {n ; v} ->
|
| Sparse {n ; v} ->
|
||||||
let v' = Vec.make0 n in
|
let v' = Vec.make0 n in
|
||||||
List.iter (fun {index ; value} -> v'.{index} <- value) v;
|
Array.iter (fun {index ; value} -> v'.{index} <- value) v;
|
||||||
Dense v'
|
Dense v'
|
||||||
|
|
||||||
|
|
||||||
@ -92,6 +92,7 @@ let sparse_of_vec ?(threshold=epsilon) v =
|
|||||||
let sparse_of_assoc_list n v =
|
let sparse_of_assoc_list n v =
|
||||||
Sparse { n ;
|
Sparse { n ;
|
||||||
v = List.map (fun (index, value) -> {index ; value}) v
|
v = List.map (fun (index, value) -> {index ; value}) v
|
||||||
|
|> Array.of_list
|
||||||
}
|
}
|
||||||
|
|
||||||
|
|
||||||
@ -104,19 +105,13 @@ let rec to_vec = function
|
|||||||
let scale ?(threshold=epsilon) x = function
|
let scale ?(threshold=epsilon) x = function
|
||||||
| Dense v -> let v' = copy v in (scal x v'; Dense v')
|
| Dense v -> let v' = copy v in (scal x v'; Dense v')
|
||||||
| Sparse {n ; v} ->
|
| Sparse {n ; v} ->
|
||||||
Sparse {n ; v=List.map (fun {index ; value} ->
|
Sparse {n ; v = Array.map (fun {index ; value} -> { index ; value=x *. value} ) v }
|
||||||
let z = x *. value in
|
|
||||||
if abs_float z > threshold then
|
|
||||||
Some {index ; value=z}
|
|
||||||
else
|
|
||||||
None
|
|
||||||
) v |> Util.list_some }
|
|
||||||
|
|
||||||
|
|
||||||
let rec neg = function
|
let rec neg = function
|
||||||
| Dense v -> Dense (Vec.neg v)
|
| Dense v -> Dense (Vec.neg v)
|
||||||
| Sparse {n ; v} ->
|
| Sparse {n ; v} ->
|
||||||
Sparse {n ; v=List.map (fun {index ; value} -> {index ; value = -. value}) v}
|
Sparse {n ; v = Array.map (fun {index ; value} -> {index ; value = -. value}) v}
|
||||||
|
|
||||||
|
|
||||||
|
|
||||||
@ -129,22 +124,25 @@ let axpy ?(threshold=epsilon) ?(alpha=1.) x y =
|
|||||||
| Sparse {n ; v}, Dense y ->
|
| Sparse {n ; v}, Dense y ->
|
||||||
begin
|
begin
|
||||||
let v' = copy y in
|
let v' = copy y in
|
||||||
List.iter (fun {index ; value} -> v'.{index} <- v'.{index} +. alpha *. value) v;
|
Array.iter (fun {index ; value} -> v'.{index} <- v'.{index} +. alpha *. value) v;
|
||||||
sparse_of_vec ~threshold v'
|
sparse_of_vec ~threshold v'
|
||||||
end
|
end
|
||||||
| Dense x , Sparse {n ; v} ->
|
| Dense x , Sparse {n ; v} ->
|
||||||
begin
|
begin
|
||||||
let v' = copy x in
|
let v' = copy x in
|
||||||
scal alpha v';
|
scal alpha v';
|
||||||
List.iter (fun {index ; value} -> v'.{index} <- v'.{index} +. value) v;
|
Array.iter (fun {index ; value} -> v'.{index} <- v'.{index} +. value) v;
|
||||||
sparse_of_vec ~threshold v'
|
sparse_of_vec ~threshold v'
|
||||||
end
|
end
|
||||||
| Sparse {n ; v}, Sparse {n=n' ; v=v'} ->
|
| Sparse {n ; v}, Sparse {n=n' ; v=v'} ->
|
||||||
begin
|
begin
|
||||||
let rec aux accu v1 v2 =
|
let rec aux accu k l =
|
||||||
match v1, v2 with
|
match k < Array.length v, l < Array.length v' with
|
||||||
| ({index=i ; value=x}::r1), ({index=j ; value=y}::r2) ->
|
| true, true ->
|
||||||
begin
|
begin
|
||||||
|
let {index=i ; value=x} = v.(k)
|
||||||
|
and {index=j ; value=y} = v'.(l)
|
||||||
|
in
|
||||||
match compare i j with
|
match compare i j with
|
||||||
| -1 ->
|
| -1 ->
|
||||||
let z = alpha *. x in
|
let z = alpha *. x in
|
||||||
@ -153,14 +151,14 @@ let axpy ?(threshold=epsilon) ?(alpha=1.) x y =
|
|||||||
{index=i ; value=z} :: accu
|
{index=i ; value=z} :: accu
|
||||||
else
|
else
|
||||||
accu
|
accu
|
||||||
in (aux [@tailcall]) new_accu r1 v2
|
in (aux [@tailcall]) new_accu (k+1) l
|
||||||
| 1 ->
|
| 1 ->
|
||||||
let new_accu =
|
let new_accu =
|
||||||
if abs_float y > threshold then
|
if abs_float y > threshold then
|
||||||
{index=j ; value=y} :: accu
|
{index=j ; value=y} :: accu
|
||||||
else
|
else
|
||||||
accu
|
accu
|
||||||
in (aux [@tailcall]) new_accu v1 r2
|
in (aux [@tailcall]) new_accu k (l+1)
|
||||||
| 0 ->
|
| 0 ->
|
||||||
let z = alpha *. x +. y in
|
let z = alpha *. x +. y in
|
||||||
let new_accu =
|
let new_accu =
|
||||||
@ -168,14 +166,20 @@ let axpy ?(threshold=epsilon) ?(alpha=1.) x y =
|
|||||||
{index=i ; value=z} :: accu
|
{index=i ; value=z} :: accu
|
||||||
else
|
else
|
||||||
accu
|
accu
|
||||||
in (aux [@tailcall]) new_accu r1 r2
|
in (aux [@tailcall]) new_accu (k+1) (l+1)
|
||||||
| _ -> assert false
|
| _ -> assert false
|
||||||
end
|
end
|
||||||
| ({index=i ; value=x}::r1), [] -> (aux [@tailcall]) ({index=i ; value=alpha *. x}::accu) r1 []
|
|
||||||
| [] , ({index=j ; value=y}::r2) -> (aux [@tailcall]) ({index=j ; value=y}::accu) [] r2
|
| true, false ->
|
||||||
| [] , [] -> {n ; v=List.rev accu}
|
let {index=i ; value=x} = v.(k) in
|
||||||
|
(aux [@tailcall]) ({index=i ; value=alpha *. x}::accu) (k+1) l
|
||||||
|
|
||||||
|
| false, true ->
|
||||||
|
(aux [@tailcall]) (v'.(l)::accu) k (l+1)
|
||||||
|
|
||||||
|
| false, false -> {n ; v=List.rev accu |> Array.of_list}
|
||||||
in
|
in
|
||||||
Sparse (aux [] v v')
|
Sparse (aux [] 0 0)
|
||||||
end
|
end
|
||||||
|
|
||||||
let add = axpy ~alpha:1.
|
let add = axpy ~alpha:1.
|
||||||
@ -187,7 +191,7 @@ let pp_vector ppf = function
|
|||||||
| Sparse {n ; v} ->
|
| Sparse {n ; v} ->
|
||||||
begin
|
begin
|
||||||
Format.fprintf ppf "@[[ %d | " n;
|
Format.fprintf ppf "@[[ %d | " n;
|
||||||
List.iter (fun {index ; value} -> Format.fprintf ppf "@[(%d, %f); @]" index value) v;
|
Array.iter (fun {index ; value} -> Format.fprintf ppf "@[(%d, %f); @]" index value) v;
|
||||||
Format.fprintf ppf "]@]"
|
Format.fprintf ppf "]@]"
|
||||||
end
|
end
|
||||||
|
|
||||||
@ -202,26 +206,29 @@ let dot v v' =
|
|||||||
let d_sp v' {n ; v} =
|
let d_sp v' {n ; v} =
|
||||||
if n <> Vec.dim v' then
|
if n <> Vec.dim v' then
|
||||||
invalid_arg "Inconsistent dimensions";
|
invalid_arg "Inconsistent dimensions";
|
||||||
List.fold_left (fun accu {index ; value} -> accu +. value *. v'.{index}) 0. v
|
Array.fold_left (fun accu {index ; value} -> accu +. value *. v'.{index}) 0. v
|
||||||
in
|
in
|
||||||
|
|
||||||
let sp_sp {n ; v} {n=n' ; v=v'} =
|
let sp_sp {n ; v} {n=n' ; v=v'} =
|
||||||
if n <> n' then
|
if n <> n' then
|
||||||
invalid_arg "Inconsistent dimensions";
|
invalid_arg "Inconsistent dimensions";
|
||||||
|
|
||||||
let rec aux accu = function
|
let rec aux accu k l =
|
||||||
| (({index=i ; value=v1} :: r1) as s1), (({index=j ; value=v2}::r2) as s2)->
|
match Array.length v > k, Array.length v' > l with
|
||||||
|
| true, true ->
|
||||||
|
let {index=i ; value=x} = v.(k)
|
||||||
|
and {index=j ; value=y} = v'.(l)
|
||||||
|
in
|
||||||
begin
|
begin
|
||||||
match compare i j with
|
match compare i j with
|
||||||
| -1 -> (aux [@tailcall]) accu (r1, s2)
|
| -1 -> (aux [@tailcall]) accu (k+1) l
|
||||||
| 1 -> (aux [@tailcall]) accu (s1, r2)
|
| 1 -> (aux [@tailcall]) accu k (l+1)
|
||||||
| 0 -> (aux [@tailcall]) (accu +. v1 *. v2) (r1, r2)
|
| 0 -> (aux [@tailcall]) (accu +. x *. y) (k+1) (l+1)
|
||||||
| _ -> assert false
|
| _ -> assert false
|
||||||
end
|
end
|
||||||
| ([], _ )
|
| _ -> accu
|
||||||
| (_ , []) -> accu
|
|
||||||
in
|
in
|
||||||
aux 0. (v, v')
|
aux 0. 0 0
|
||||||
in
|
in
|
||||||
|
|
||||||
match v, v' with
|
match v, v' with
|
||||||
|
@ -72,3 +72,14 @@ CAMLprim value leadz_bytecode(value i)
|
|||||||
return copy_int32(__builtin_clzll (i));
|
return copy_int32(__builtin_clzll (i));
|
||||||
}
|
}
|
||||||
|
|
||||||
|
|
||||||
|
|
||||||
|
#include <unistd.h>
|
||||||
|
|
||||||
|
CAMLprim value unix_vfork(value unit)
|
||||||
|
{
|
||||||
|
int ret;
|
||||||
|
ret = vfork();
|
||||||
|
return Val_int(ret);
|
||||||
|
}
|
||||||
|
|
||||||
|
@ -26,9 +26,11 @@ let () =
|
|||||||
arg=With_arg "<int>";
|
arg=With_arg "<int>";
|
||||||
doc="Total charge of the molecule. Default is 0"; } ;
|
doc="Total charge of the molecule. Default is 0"; } ;
|
||||||
|
|
||||||
|
(*
|
||||||
{ short='e' ; long="expo" ; opt=Optional;
|
{ short='e' ; long="expo" ; opt=Optional;
|
||||||
arg=With_arg "<float>";
|
arg=With_arg "<float>";
|
||||||
doc="Exponent of the Gaussian geminal"; } ;
|
doc="Exponent of the Gaussian geminal"; } ;
|
||||||
|
*)
|
||||||
|
|
||||||
{ short='s' ; long="state" ; opt=Optional;
|
{ short='s' ; long="state" ; opt=Optional;
|
||||||
arg=With_arg "<int>";
|
arg=With_arg "<int>";
|
||||||
@ -49,11 +51,13 @@ let () =
|
|||||||
| None -> 0
|
| None -> 0
|
||||||
in
|
in
|
||||||
|
|
||||||
|
(*
|
||||||
let expo =
|
let expo =
|
||||||
match Command_line.get "expo" with
|
match Command_line.get "expo" with
|
||||||
| Some x -> float_of_string x
|
| Some x -> float_of_string x
|
||||||
| None -> 1.0
|
| None -> 1.0
|
||||||
in
|
in
|
||||||
|
*)
|
||||||
|
|
||||||
let state =
|
let state =
|
||||||
match Command_line.get "state" with
|
match Command_line.get "state" with
|
||||||
@ -72,8 +76,13 @@ let () =
|
|||||||
else Printing.ppf_dev_null
|
else Printing.ppf_dev_null
|
||||||
in
|
in
|
||||||
|
|
||||||
|
(*
|
||||||
let f12 =
|
let f12 =
|
||||||
F12.gaussian_geminal expo
|
F12factor.gaussian_geminal expo
|
||||||
|
in
|
||||||
|
*)
|
||||||
|
let f12 =
|
||||||
|
F12factor.gaussian_geminal 1.0
|
||||||
in
|
in
|
||||||
|
|
||||||
let simulation =
|
let simulation =
|
||||||
|
@ -27,7 +27,7 @@ let run ~out =
|
|||||||
| Some x -> x
|
| Some x -> x
|
||||||
in
|
in
|
||||||
|
|
||||||
let f12 = F12.gaussian_geminal 1.0 in
|
let f12 = F12factor.gaussian_geminal 1.0 in
|
||||||
let s =
|
let s =
|
||||||
Simulation.of_filenames ~nuclei:nuclei_file ~f12 basis_file
|
Simulation.of_filenames ~nuclei:nuclei_file ~f12 basis_file
|
||||||
in
|
in
|
||||||
|
Loading…
Reference in New Issue
Block a user