LCPQ/QCaml
10
1
Fork 0
mirror of https://gitlab.com/scemama/QCaml.git synced 2024-11-07 14:43:41 +01:00
Code Releases Activity

Merge branch 'master' of gitlab.com:scemama/QCaml

Browse Source
This commit is contained in:
Anthony Scemama 2019-10-27 21:13:54 +01:00
commit d6dd38d706
17 changed files with 238 additions and 800 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

10
Basis/AOBasis.ml
View File

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

2
Basis/AOBasis.mli
View File

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

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

400
Basis/F12.ml
View File

@ -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"
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
g.GaussianOperator.expo_sg_inv
g.GaussianOperator.coef_g
shell_pair_couple
end end
let class_of_contracted_shell_pair_couple f12 shell_pair_couple = module M = TwoElectronIntegrals.Make(T)
F12RR.contracted_class_shell_pair_couple include M
f12.expo_sg_inv f12.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

78
Basis/F12factor.ml Normal file
View 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
View 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

26
Basis/TwoElectronIntegralsNonSeparable.ml → Basis/TwoElectronIntegrals.ml
View File

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

19
Basis/TwoElectronIntegralsNonSeparable.mli → Basis/TwoElectronIntegrals.mli
View File

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

330
Basis/TwoElectronIntegralsSeparable.ml
View File

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

2
Simulation.ml
View File

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

6
Simulation.mli
View File

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

8
Utils/Util.ml
View File

@ -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} *)

2
Utils/Util.mli
View File

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

77
Utils/Vector.ml
View File

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

11
Utils/math_functions.c
View File

@ -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);
}

11
run_fci_f12.ml
View File

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

2
run_integrals.ml
View File

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