2020-09-26 12:02:53 +02:00
|
|
|
open Qcaml_common
|
|
|
|
open Qcaml_linear_algebra
|
|
|
|
open Qcaml_gaussian_basis
|
2018-01-22 23:19:24 +01:00
|
|
|
open Util
|
2018-02-03 23:26:20 +01:00
|
|
|
open Constants
|
2018-02-09 00:37:25 +01:00
|
|
|
|
2020-09-26 12:02:53 +02:00
|
|
|
module Am = Angular_momentum
|
2018-02-23 15:49:27 +01:00
|
|
|
module Bs = Basis
|
|
|
|
module Co = Coordinate
|
2020-09-26 12:02:53 +02:00
|
|
|
module Cs = Contracted_shell
|
|
|
|
module Csp = Contracted_shell_pair
|
2018-02-25 01:40:12 +01:00
|
|
|
module Po = Powers
|
2020-09-26 12:02:53 +02:00
|
|
|
module Psp = Primitive_shell_pair
|
2018-01-22 23:19:24 +01:00
|
|
|
|
2020-10-02 18:55:19 +02:00
|
|
|
type t = (Basis.t, Basis.t) Matrix.t
|
|
|
|
external matrix : t -> (Basis.t, Basis.t) Matrix.t = "%identity"
|
|
|
|
external of_matrix : (Basis.t, Basis.t) Matrix.t -> t = "%identity"
|
2018-06-13 19:03:42 +02:00
|
|
|
|
2018-02-24 23:57:38 +01:00
|
|
|
let cutoff = integrals_cutoff
|
|
|
|
|
2020-04-16 19:49:23 +02:00
|
|
|
let to_powers x =
|
2018-02-25 01:40:12 +01:00
|
|
|
let open Zkey in
|
|
|
|
match to_powers x with
|
|
|
|
| Six x -> x
|
|
|
|
| _ -> assert false
|
|
|
|
|
2018-01-22 23:19:24 +01:00
|
|
|
(** Computes all the overlap integrals of the contracted shell pair *)
|
2020-04-16 19:49:23 +02:00
|
|
|
let contracted_class shell_a shell_b : float Zmap.t =
|
2018-01-22 23:19:24 +01:00
|
|
|
|
2018-03-20 15:16:24 +01:00
|
|
|
match Csp.make shell_a shell_b with
|
2020-04-16 19:49:23 +02:00
|
|
|
| None -> Zmap.create 0
|
|
|
|
| Some shell_p ->
|
2018-03-15 19:35:10 +01:00
|
|
|
begin
|
2018-01-22 23:19:24 +01:00
|
|
|
|
2020-04-16 19:49:23 +02:00
|
|
|
(* Pre-computation of integral class indices *)
|
|
|
|
let class_indices = Csp.zkey_array shell_p in
|
2018-01-22 23:19:24 +01:00
|
|
|
|
2020-04-16 19:49:23 +02:00
|
|
|
let contracted_class =
|
|
|
|
Array.make (Array.length class_indices) 0.
|
|
|
|
in
|
2018-01-22 23:19:24 +01:00
|
|
|
|
2020-04-16 19:49:23 +02:00
|
|
|
let a_minus_b =
|
|
|
|
Csp.a_minus_b shell_p
|
|
|
|
in
|
|
|
|
let norm_coef_scales =
|
|
|
|
Csp.norm_scales shell_p
|
|
|
|
in
|
2018-02-09 19:41:22 +01:00
|
|
|
|
2020-04-16 19:49:23 +02:00
|
|
|
(* Compute all integrals in the shell for each pair of significant shell pairs *)
|
2018-01-22 23:19:24 +01:00
|
|
|
|
2020-04-16 19:49:23 +02:00
|
|
|
let xyz_of_int k =
|
|
|
|
match k with
|
|
|
|
| 0 -> Co.X
|
|
|
|
| 1 -> Co.Y
|
|
|
|
| _ -> Co.Z
|
|
|
|
in
|
2018-02-06 17:39:14 +01:00
|
|
|
|
2020-04-16 19:49:23 +02:00
|
|
|
List.iter (fun (coef_prod, psp) ->
|
2020-09-26 12:02:53 +02:00
|
|
|
(* Screening on the product of coefficients *)
|
2020-04-16 19:49:23 +02:00
|
|
|
if (abs_float coef_prod) > 1.e-6*.cutoff then
|
|
|
|
begin
|
|
|
|
let expo_inv = Psp.exponent_inv psp
|
|
|
|
and center_pa = Psp.center_minus_a psp
|
2018-03-20 19:02:58 +01:00
|
|
|
in
|
2020-04-16 19:49:23 +02:00
|
|
|
|
|
|
|
Array.iteri (fun i key ->
|
|
|
|
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 a_minus_b,
|
|
|
|
Co.get xyz center_pa)
|
|
|
|
in
|
|
|
|
let norm = norm_coef_scales.(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
|
|
|
|
) (Csp.coefs_and_shell_pairs shell_p);
|
2020-09-27 23:55:42 +02:00
|
|
|
|
2020-04-16 19:49:23 +02:00
|
|
|
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
|
2018-01-22 23:19:24 +01:00
|
|
|
|
|
|
|
|
2018-02-09 00:37:25 +01:00
|
|
|
(** Create overlap matrix *)
|
|
|
|
let of_basis basis =
|
2020-04-16 19:49:23 +02:00
|
|
|
let to_powers x =
|
2018-01-22 23:19:24 +01:00
|
|
|
let open Zkey in
|
2018-02-25 01:40:12 +01:00
|
|
|
match to_powers x with
|
2018-01-22 23:19:24 +01:00
|
|
|
| Three x -> x
|
|
|
|
| _ -> assert false
|
|
|
|
in
|
|
|
|
|
2018-03-20 14:11:31 +01:00
|
|
|
let n = Bs.size basis
|
|
|
|
and shell = Bs.contracted_shells basis
|
2018-02-09 00:37:25 +01:00
|
|
|
in
|
|
|
|
|
2020-09-26 12:02:53 +02:00
|
|
|
let result = Matrix.create n n in
|
|
|
|
let result_x = Matrix.to_bigarray_inplace result in
|
2018-02-09 00:37:25 +01:00
|
|
|
for j=0 to (Array.length shell) - 1 do
|
|
|
|
for i=0 to j do
|
2018-01-22 23:19:24 +01:00
|
|
|
(* Compute all the integrals of the class *)
|
|
|
|
let cls =
|
2020-04-16 19:49:23 +02:00
|
|
|
contracted_class shell.(i) shell.(j)
|
2018-01-22 23:19:24 +01:00
|
|
|
in
|
|
|
|
|
2018-02-09 00:37:25 +01:00
|
|
|
Array.iteri (fun j_c powers_j ->
|
2018-03-13 18:56:28 +01:00
|
|
|
let j_c = Cs.index shell.(j) + j_c + 1 in
|
2018-02-19 16:01:13 +01:00
|
|
|
let xj = to_powers powers_j in
|
2018-02-09 00:37:25 +01:00
|
|
|
Array.iteri (fun i_c powers_i ->
|
2018-03-13 18:56:28 +01:00
|
|
|
let i_c = Cs.index shell.(i) + i_c + 1 in
|
2018-02-19 16:01:13 +01:00
|
|
|
let xi = to_powers powers_i in
|
2020-04-16 19:49:23 +02:00
|
|
|
let key =
|
2018-02-25 00:53:09 +01:00
|
|
|
Zkey.of_powers_six xi xj
|
2018-01-22 23:19:24 +01:00
|
|
|
in
|
2020-04-16 19:49:23 +02:00
|
|
|
let value =
|
|
|
|
try Zmap.find cls key
|
2018-03-15 19:35:10 +01:00
|
|
|
with Not_found -> 0.
|
2018-01-22 23:19:24 +01:00
|
|
|
in
|
2020-09-26 12:02:53 +02:00
|
|
|
result_x.{i_c,j_c} <- value;
|
|
|
|
result_x.{j_c,i_c} <- value;
|
2018-03-21 15:01:39 +01:00
|
|
|
) (Am.zkey_array (Singlet (Cs.ang_mom shell.(i))))
|
|
|
|
) (Am.zkey_array (Singlet (Cs.ang_mom shell.(j))))
|
2018-02-09 00:37:25 +01:00
|
|
|
done;
|
|
|
|
done;
|
2020-09-26 12:02:53 +02:00
|
|
|
Matrix.detri_inplace result;
|
2018-02-09 00:37:25 +01:00
|
|
|
result
|
|
|
|
|
|
|
|
|
2019-03-04 19:01:54 +01:00
|
|
|
(** Create mixed overlap matrix *)
|
|
|
|
let of_basis_pair first_basis second_basis =
|
2020-04-16 19:49:23 +02:00
|
|
|
let to_powers x =
|
2019-03-04 19:01:54 +01:00
|
|
|
let open Zkey in
|
|
|
|
match to_powers x with
|
|
|
|
| Three x -> x
|
|
|
|
| _ -> assert false
|
|
|
|
in
|
|
|
|
|
|
|
|
let n = Bs.size first_basis
|
2020-04-16 19:49:23 +02:00
|
|
|
and m = Bs.size second_basis
|
2019-03-04 19:01:54 +01:00
|
|
|
and first = Bs.contracted_shells first_basis
|
|
|
|
and second = Bs.contracted_shells second_basis
|
|
|
|
in
|
|
|
|
|
2020-09-26 12:02:53 +02:00
|
|
|
let result = Matrix.create n m in
|
|
|
|
let result_x = Matrix.to_bigarray_inplace result in
|
2019-03-04 19:01:54 +01:00
|
|
|
for j=0 to (Array.length second) - 1 do
|
|
|
|
for i=0 to (Array.length first) - 1 do
|
|
|
|
(* Compute all the integrals of the class *)
|
|
|
|
let cls =
|
2020-04-16 19:49:23 +02:00
|
|
|
contracted_class first.(i) second.(j)
|
2019-03-04 19:01:54 +01:00
|
|
|
in
|
|
|
|
|
|
|
|
Array.iteri (fun j_c powers_j ->
|
|
|
|
let j_c = Cs.index second.(j) + j_c + 1 in
|
|
|
|
let xj = to_powers powers_j in
|
|
|
|
Array.iteri (fun i_c powers_i ->
|
|
|
|
let i_c = Cs.index first.(i) + i_c + 1 in
|
|
|
|
let xi = to_powers powers_i in
|
2020-04-16 19:49:23 +02:00
|
|
|
let key =
|
2019-03-04 19:01:54 +01:00
|
|
|
Zkey.of_powers_six xi xj
|
|
|
|
in
|
2020-04-16 19:49:23 +02:00
|
|
|
let value =
|
|
|
|
try Zmap.find cls key
|
2019-03-04 19:01:54 +01:00
|
|
|
with Not_found -> 0.
|
|
|
|
in
|
2020-09-26 12:02:53 +02:00
|
|
|
result_x.{i_c,j_c} <- value;
|
2019-03-04 19:01:54 +01:00
|
|
|
) (Am.zkey_array (Singlet (Cs.ang_mom first.(i))))
|
|
|
|
) (Am.zkey_array (Singlet (Cs.ang_mom second.(j))))
|
|
|
|
done;
|
|
|
|
done;
|
|
|
|
result
|
|
|
|
|
|
|
|
|
2018-02-09 00:37:25 +01:00
|
|
|
|
|
|
|
(** Write all overlap integrals to a file *)
|
|
|
|
let to_file ~filename overlap =
|
|
|
|
|
|
|
|
let oc = open_out filename in
|
|
|
|
let n =
|
2020-09-26 12:02:53 +02:00
|
|
|
Matrix.dim1 overlap
|
2018-02-09 00:37:25 +01:00
|
|
|
in
|
|
|
|
|
2020-09-26 12:02:53 +02:00
|
|
|
let overlap_x = Matrix.to_bigarray_inplace overlap in
|
2018-02-09 00:37:25 +01:00
|
|
|
for j=1 to n do
|
|
|
|
for i=1 to j do
|
2020-09-26 12:02:53 +02:00
|
|
|
if (abs_float overlap_x.{i,j} > cutoff) then
|
|
|
|
Printf.fprintf oc "%4d %4d %20.12e\n" i j overlap_x.{i,j}
|
2018-01-22 23:19:24 +01:00
|
|
|
done;
|
|
|
|
done;
|
|
|
|
close_out oc
|
|
|
|
|
2018-02-21 17:06:24 +01:00
|
|
|
|
|
|
|
|