LCPQ/QCaml
10
1
Fork 0
mirror of https://gitlab.com/scemama/QCaml.git synced 2024-07-25 12:17:25 +02:00
Code Releases Activity

ShellPair option

Browse Source
This commit is contained in:
Anthony Scemama 2018-03-15 19:35:10 +01:00
parent 80f00debe8
commit 7cccb60549
9 changed files with 209 additions and 185 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

2
Basis/ContractedShell.mli
View File

@ -32,7 +32,7 @@ val to_string : t -> string
(** Pretty-printing of the contracted shell in a string. *) (** Pretty-printing of the contracted shell in a string. *)
val make : ?index:int -> (float * PrimitiveShell.t) array -> t val make : ?index:int -> (float * PrimitiveShell.t) array -> t
(** Creates a contracted shell from a list of coefficients and primitives. *) (** Creates a contracted shell from a list of coefficients and primitives. *)
val with_index : t -> int -> t val with_index : t -> int -> t
(** Returns a copy of the contracted shell with a modified index. *) (** Returns a copy of the contracted shell with a modified index. *)

19
Basis/ContractedShellPair.ml
View File

@ -59,14 +59,17 @@ Format.printf "@[<2>shell_b :@ %a@]@;" Cs.pp s_b;
and expo_inv = Array.map (fun (_,y) -> Psp.expo_inv y) shell_pairs and expo_inv = Array.map (fun (_,y) -> Psp.expo_inv y) shell_pairs
in in
let shell_pairs = Array.map snd shell_pairs in let shell_pairs = Array.map snd shell_pairs in
let root = shell_pairs.(0) in if Array.length shell_pairs = 0 then
{ None
shell_a = s_a ; shell_b = s_b ; coef ; expo_inv ; shell_pairs ; else
center_ab = Psp.a_minus_b root; let root = shell_pairs.(0) in
norm_coef_scale = Psp.norm_coef_scale root; Some {
norm_sq=Psp.a_minus_b_sq root; shell_a = s_a ; shell_b = s_b ; coef ; expo_inv ; shell_pairs ;
totAngMomInt = Psp.totAngMom root |> Am.to_int; center_ab = Psp.a_minus_b root;
} norm_coef_scale = Psp.norm_coef_scale root;
norm_sq=Psp.a_minus_b_sq root;
totAngMomInt = Psp.totAngMom root |> Am.to_int;
}
let shell_a x = x.shell_a let shell_a x = x.shell_a

16
Basis/ContractedShellPair.mli
View File

@ -14,18 +14,22 @@ A contracted shell pair is a product of two {!ContractedShell.t}:
type t type t
val create : ?cutoff:float -> ContractedShell.t -> ContractedShell.t -> t val create : ?cutoff:float -> ContractedShell.t -> ContractedShell.t -> t option
(** Creates an contracted shell pair {% $\varphi_{ab}$ %} from a contracted (** Creates an contracted shell pair {% $\varphi_{ab}$ %} from a contracted
shell {% $\chi_a$ %} (first argument) and a contracted shell {% $\chi_b$ %} shell {% $\chi_a$ %} (first argument) and a contracted shell {% $\chi_b$ %}
(second argument). (second argument).
The contracted shell pair contains the pairs of primitives for which The contracted shell pair contains the only pairs of primitives for which
the norm is greater than [cutoff], and for which ... TODO .... the norm is greater than [cutoff].
All other pairs are discarded.
If all the primitive shell pairs are not significant, the function returns
[None].
*) *)
val of_basis : ContractedShell.t array -> t array array val of_basis : ContractedShell.t array -> t option array array
(** Creates all possible contracted shell pairs from the basis set. *) (** Creates all possible contracted shell pairs from the basis set.
If the shell pair is not significant, sets the value to [None].
*)
val shell_a : t -> ContractedShell.t val shell_a : t -> ContractedShell.t
(** Returns the first {!ContractedShell.t} {% $\chi_a$ %} which was used to (** Returns the first {!ContractedShell.t} {% $\chi_a$ %} which was used to

26
Basis/ERI.ml
View File

@ -98,11 +98,13 @@ let of_basis basis =
let t0 = Unix.gettimeofday () in let t0 = Unix.gettimeofday () in
let schwartz = let schwartz =
Array.map (fun pair_array -> Array.map (fun pair -> Array.map (fun pair_array -> Array.map (function
let cls = | None -> (Zmap.create 0, 0.)
contracted_class_shell_pairs pair pair | Some pair ->
in let cls =
(cls, Zmap.fold (fun key value accu -> max (abs_float value) accu) cls 0. ) contracted_class_shell_pairs pair pair
in
(cls, Zmap.fold (fun key value accu -> max (abs_float value) accu) cls 0. )
) pair_array ) shell_pairs ) pair_array ) shell_pairs
in in
@ -138,8 +140,10 @@ let of_basis basis =
try try
if (schwartz_p_max < cutoff) then raise NullIntegral; if (schwartz_p_max < cutoff) then raise NullIntegral;
let let shell_p =
shell_p = shell_pairs.(i).(j) match shell_pairs.(i).(j) with
| None -> raise NullIntegral
| Some x -> x
in in
let sp = let sp =
@ -152,9 +156,13 @@ let of_basis basis =
try try
if schwartz_p_max *. schwartz_q_max < cutoff2 then if schwartz_p_max *. schwartz_q_max < cutoff2 then
raise NullIntegral; raise NullIntegral;
let
shell_q = shell_pairs.(k).(l) let shell_q =
match shell_pairs.(k).(l) with
| None -> raise NullIntegral
| Some x -> x
in in
let sq = let sq =
Csp.shell_pairs shell_q Csp.shell_pairs shell_q
in in

169
Basis/KinInt.ml
View File

@ -24,97 +24,98 @@ let to_powers x =
(** Computes all the kinetic integrals of the contracted shell pair *) (** Computes all the kinetic integrals of the contracted shell pair *)
let contracted_class shell_a shell_b : float Zmap.t = let contracted_class shell_a shell_b : float Zmap.t =
let shell_p = match Csp.create shell_a shell_b with
Csp.create shell_a shell_b | Some shell_p ->
in begin
(* Pre-computation of integral class indices *)
let class_indices =
Am.zkey_array (Am.Doublet Cs.(totAngMom shell_a, totAngMom shell_b))
in
(* Pre-computation of integral class indices *) let contracted_class =
let class_indices = Array.make (Array.length class_indices) 0.
Am.zkey_array (Am.Doublet Cs.(totAngMom shell_a, totAngMom shell_b)) in
in
let contracted_class = (* Compute all integrals in the shell for each pair of significant shell pairs *)
Array.make (Array.length class_indices) 0.
in
(* Compute all integrals in the shell for each pair of significant shell pairs *) let sp = Csp.shell_pairs shell_p in
let center_ab =
Csp.center_ab shell_p
in
let norm_coef_scale =
Csp.norm_coef_scale shell_p
in
let sp = Csp.shell_pairs shell_p in for ab=0 to (Array.length sp - 1)
let center_ab = do
Csp.center_ab shell_p let coef_prod =
in (Csp.coef shell_p).(ab)
let norm_coef_scale =
Csp.norm_coef_scale shell_p
in
for ab=0 to (Array.length sp - 1)
do
let coef_prod =
(Csp.coef shell_p).(ab)
in
(** Screening on thr product of coefficients *)
if (abs_float coef_prod) > 1.e-4*.cutoff then
begin
let center_pa =
Psp.center_minus_a sp.(ab)
in in
let expo_inv = (** Screening on thr product of coefficients *)
(Csp.expo_inv shell_p).(ab) if (abs_float coef_prod) > 1.e-4*.cutoff then
in begin
let expo_a = let center_pa =
Ps.expo (Psp.shell_a sp.(ab)) Psp.center_minus_a sp.(ab)
and expo_b =
Ps.expo (Psp.shell_b sp.(ab))
in
let xyz_of_int k =
match k with
| 0 -> Co.X
| 1 -> Co.Y
| _ -> Co.Z
in
Array.iteri (fun i key ->
let (angMomA,angMomB) = to_powers key in
let ov a b k =
let xyz = xyz_of_int k in
Overlap_primitives.hvrr (a, b)
expo_inv
(Co.get xyz center_ab,
Co.get xyz center_pa)
in in
let f k = let expo_inv =
let xyz = xyz_of_int k in (Csp.expo_inv shell_p).(ab)
ov (Po.get xyz angMomA) (Po.get xyz angMomB) k
and g k =
let xyz = xyz_of_int k in
let s1 = ov (Po.get xyz angMomA - 1) (Po.get xyz angMomB - 1) k
and s2 = ov (Po.get xyz angMomA + 1) (Po.get xyz angMomB - 1) k
and s3 = ov (Po.get xyz angMomA - 1) (Po.get xyz angMomB + 1) k
and s4 = ov (Po.get xyz angMomA + 1) (Po.get xyz angMomB + 1) k
and a = float_of_int (Po.get xyz angMomA)
and b = float_of_int (Po.get xyz angMomB)
in
0.5 *. a *. b *. s1 -. expo_a *. b *. s2 -. expo_b *. a *. s3 +.
2.0 *. expo_a *. expo_b *. s4
in in
let s = Array.init 3 f let expo_a =
and k = Array.init 3 g Ps.expo (Psp.shell_a sp.(ab))
and expo_b =
Ps.expo (Psp.shell_b sp.(ab))
in in
let norm = norm_coef_scale.(i) in
let integral = chop norm (fun () -> let xyz_of_int k =
k.(0)*.s.(1)*.s.(2) +. match k with
s.(0)*.k.(1)*.s.(2) +. | 0 -> Co.X
s.(0)*.s.(1)*.k.(2) | 1 -> Co.Y
) in | _ -> Co.Z
contracted_class.(i) <- contracted_class.(i) +. coef_prod *. integral in
) class_indices Array.iteri (fun i key ->
end let (angMomA,angMomB) = to_powers key in
done; let ov a b k =
let result = let xyz = xyz_of_int k in
Zmap.create (Array.length contracted_class) Overlap_primitives.hvrr (a, b)
in expo_inv
Array.iteri (fun i key -> Zmap.add result key contracted_class.(i)) class_indices; (Co.get xyz center_ab,
result Co.get xyz center_pa)
in
let f k =
let xyz = xyz_of_int k in
ov (Po.get xyz angMomA) (Po.get xyz angMomB) k
and g k =
let xyz = xyz_of_int k in
let s1 = ov (Po.get xyz angMomA - 1) (Po.get xyz angMomB - 1) k
and s2 = ov (Po.get xyz angMomA + 1) (Po.get xyz angMomB - 1) k
and s3 = ov (Po.get xyz angMomA - 1) (Po.get xyz angMomB + 1) k
and s4 = ov (Po.get xyz angMomA + 1) (Po.get xyz angMomB + 1) k
and a = float_of_int (Po.get xyz angMomA)
and b = float_of_int (Po.get xyz angMomB)
in
0.5 *. a *. b *. s1 -. expo_a *. b *. s2 -. expo_b *. a *. s3 +.
2.0 *. expo_a *. expo_b *. s4
in
let s = Array.init 3 f
and k = Array.init 3 g
in
let norm = norm_coef_scale.(i) in
let integral = chop norm (fun () ->
k.(0)*.s.(1)*.s.(2) +.
s.(0)*.k.(1)*.s.(2) +.
s.(0)*.s.(1)*.k.(2)
) in
contracted_class.(i) <- contracted_class.(i) +. coef_prod *. integral
) class_indices
end
done;
let result =
Zmap.create (Array.length contracted_class)
in
Array.iteri (fun i key -> Zmap.add result key contracted_class.(i)) class_indices;
result
end
| None -> Zmap.create 0
(** Create kinetic energy matrix *) (** Create kinetic energy matrix *)
@ -149,7 +150,7 @@ let of_basis basis =
in in
let value = let value =
try Zmap.find cls key try Zmap.find cls key
with Not_found -> failwith "Bug in kinetic integrals" with Not_found -> 0.
in in
result.{i_c,j_c} <- value; result.{i_c,j_c} <- value;
result.{j_c,i_c} <- value; result.{j_c,i_c} <- value;

49
Basis/NucInt.ml
View File

@ -64,32 +64,31 @@ let of_basis_nuclei basis nuclei =
(* Compute Integrals *) (* Compute Integrals *)
for i=0 to (Array.length shell) - 1 do for i=0 to (Array.length shell) - 1 do
for j=0 to i do for j=0 to i do
let match shell_pairs.(i).(j) with
shell_p = shell_pairs.(i).(j) | None -> ()
in | Some shell_p ->
(* Compute all the integrals of the class *)
let cls =
contracted_class_shell_pair shell_p nuclei
in
(* Compute all the integrals of the class *) (* Write the data in the output file *)
let cls = Array.iteri (fun i_c powers_i ->
contracted_class_shell_pair shell_p nuclei let i_c = Cs.index shell.(i) + i_c + 1 in
in let xi = to_powers powers_i in
Array.iteri (fun j_c powers_j ->
(* Write the data in the output file *) let j_c = Cs.index shell.(j) + j_c + 1 in
Array.iteri (fun i_c powers_i -> let xj = to_powers powers_j in
let i_c = Cs.index shell.(i) + i_c + 1 in let key =
let xi = to_powers powers_i in Zkey.of_powers_six xi xj
Array.iteri (fun j_c powers_j -> in
let j_c = Cs.index shell.(j) + j_c + 1 in let value =
let xj = to_powers powers_j in Zmap.find cls key
let key = in
Zkey.of_powers_six xi xj eni_array.{j_c,i_c} <- value;
in eni_array.{i_c,j_c} <- value;
let value = ) (Am.zkey_array (Singlet (Cs.totAngMom shell.(j))))
Zmap.find cls key ) (Am.zkey_array (Singlet (Cs.totAngMom shell.(i))))
in
eni_array.{j_c,i_c} <- value;
eni_array.{i_c,j_c} <- value;
) (Am.zkey_array (Singlet (Cs.totAngMom shell.(j))))
) (Am.zkey_array (Singlet (Cs.totAngMom shell.(i))))
done; done;
done; done;
Mat.detri eni_array; Mat.detri eni_array;

103
Basis/Overlap.ml
View File

@ -23,9 +23,9 @@ let to_powers x =
(** Computes all the overlap integrals of the contracted shell pair *) (** Computes all the overlap integrals of the contracted shell pair *)
let contracted_class shell_a shell_b : float Zmap.t = let contracted_class shell_a shell_b : float Zmap.t =
let shell_p = match Csp.create shell_a shell_b with
Csp.create shell_a shell_b | Some shell_p ->
in begin
(* Pre-computation of integral class indices *) (* Pre-computation of integral class indices *)
let class_indices = let class_indices =
@ -39,56 +39,59 @@ let contracted_class shell_a shell_b : float Zmap.t =
let sp = let sp =
Csp.shell_pairs shell_p Csp.shell_pairs shell_p
in in
let center_ab =
Csp.center_ab shell_p
in
let norm_coef_scale =
Csp.norm_coef_scale shell_p
in
(* Compute all integrals in the shell for each pair of significant shell pairs *) let center_ab =
Csp.center_ab shell_p
in
let norm_coef_scale =
Csp.norm_coef_scale shell_p
in
let xyz_of_int k = (* Compute all integrals in the shell for each pair of significant shell pairs *)
match k with
| 0 -> Co.X let xyz_of_int k =
| 1 -> Co.Y match k with
| _ -> Co.Z | 0 -> Co.X
in | 1 -> Co.Y
for ab=0 to (Array.length sp - 1) | _ -> Co.Z
do in
let coef_prod = for ab=0 to (Array.length sp - 1)
(Csp.coef shell_p).(ab) do
in let coef_prod =
(** Screening on thr product of coefficients *) (Csp.coef shell_p).(ab)
if (abs_float coef_prod) > 1.e-3*.cutoff then
begin
let expo_inv =
(Csp.expo_inv shell_p).(ab)
in in
let center_pa = (** Screening on thr product of coefficients *)
Psp.center_minus_a sp.(ab) if (abs_float coef_prod) > 1.e-3*.cutoff then
in begin
let expo_inv =
Array.iteri (fun i key -> (Csp.expo_inv shell_p).(ab)
let (angMomA,angMomB) = to_powers key in
let f k =
let xyz = xyz_of_int k in
Overlap_primitives.hvrr (Po.get xyz angMomA, Po.get xyz angMomB)
expo_inv
(Co.get xyz center_ab,
Co.get xyz center_pa)
in in
let norm = norm_coef_scale.(i) in let center_pa =
let integral = chop norm (fun () -> (f 0)*.(f 1)*.(f 2)) in Psp.center_minus_a sp.(ab)
contracted_class.(i) <- contracted_class.(i) +. coef_prod *. integral in
) class_indices
end Array.iteri (fun i key ->
done; let (angMomA,angMomB) = to_powers key in
let result = let f k =
Zmap.create (Array.length contracted_class) let xyz = xyz_of_int k in
in Overlap_primitives.hvrr (Po.get xyz angMomA, Po.get xyz angMomB)
Array.iteri (fun i key -> Zmap.add result key contracted_class.(i)) class_indices; expo_inv
result (Co.get xyz center_ab,
Co.get xyz center_pa)
in
let norm = norm_coef_scale.(i) in
let integral = chop norm (fun () -> (f 0)*.(f 1)*.(f 2)) in
contracted_class.(i) <- contracted_class.(i) +. coef_prod *. integral
) class_indices
end
done;
let result =
Zmap.create (Array.length contracted_class)
in
Array.iteri (fun i key -> Zmap.add result key contracted_class.(i)) class_indices;
result
end
| None -> Zmap.create 0
(** Create overlap matrix *) (** Create overlap matrix *)
@ -123,7 +126,7 @@ let of_basis basis =
in in
let value = let value =
try Zmap.find cls key try Zmap.find cls key
with Not_found -> failwith "Bug in overlap integrals" with Not_found -> 0.
in in
result.{i_c,j_c} <- value; result.{i_c,j_c} <- value;
result.{j_c,i_c} <- value; result.{j_c,i_c} <- value;

5
Basis/TwoElectronRR.ml
View File

@ -432,6 +432,9 @@ let contracted_class ~zero_m shell_a shell_b shell_c shell_d : float Zmap.t =
let shell_p = Csp.create ~cutoff shell_a shell_b let shell_p = Csp.create ~cutoff shell_a shell_b
and shell_q = Csp.create ~cutoff shell_c shell_d and shell_q = Csp.create ~cutoff shell_c shell_d
in in
contracted_class_shell_pairs ~zero_m shell_p shell_q match shell_p, shell_q with
| Some shell_p, Some shell_q ->
contracted_class_shell_pairs ~zero_m shell_p shell_q
| _ -> Zmap.create 0

5
Basis/TwoElectronRRVectorized.ml
View File

@ -873,5 +873,8 @@ let contracted_class ~zero_m shell_a shell_b shell_c shell_d : float Zmap.t =
let shell_p = Csp.create ~cutoff shell_a shell_b let shell_p = Csp.create ~cutoff shell_a shell_b
and shell_q = Csp.create ~cutoff shell_c shell_d and shell_q = Csp.create ~cutoff shell_c shell_d
in in
contracted_class_shell_pairs ~zero_m shell_p shell_q match shell_p, shell_q with
| Some shell_p, Some shell_q ->
contracted_class_shell_pairs ~zero_m shell_p shell_q
| _ -> Zmap.create 0