2018-01-17 18:19:38 +01:00
|
|
|
open Util
|
2018-02-02 01:25:10 +01:00
|
|
|
open Constants
|
2018-01-17 18:19:38 +01:00
|
|
|
|
2018-02-08 01:00:54 +01:00
|
|
|
exception Null_contribution
|
|
|
|
|
2018-02-09 19:41:22 +01:00
|
|
|
type t =
|
|
|
|
{
|
2018-02-23 18:41:30 +01:00
|
|
|
shell_a : ContractedShell.t;
|
|
|
|
shell_b : ContractedShell.t;
|
2018-02-09 19:41:22 +01:00
|
|
|
shell_pairs : ShellPair.t array;
|
|
|
|
coef : float array;
|
|
|
|
expo_inv : float array;
|
|
|
|
center_ab : Coordinate.t; (* A-B *)
|
|
|
|
norm_sq : float; (* |A-B|^2 *)
|
|
|
|
norm_coef_scale : float array; (* norm_coef.(i) / norm_coef.(0) *)
|
2018-02-11 23:41:18 +01:00
|
|
|
totAngMomInt : int; (* Total angular Momentum *)
|
2018-02-09 19:41:22 +01:00
|
|
|
}
|
2018-01-17 18:19:38 +01:00
|
|
|
|
|
|
|
|
2018-03-15 15:25:49 +01:00
|
|
|
module Am = AngularMomentum
|
|
|
|
module Co = Coordinate
|
|
|
|
module Cs = ContractedShell
|
|
|
|
module Ps = PrimitiveShell
|
|
|
|
module Psp = PrimitiveShellPair
|
|
|
|
module Sp = ShellPair
|
2018-02-23 15:49:27 +01:00
|
|
|
|
2018-02-07 17:07:05 +01:00
|
|
|
(** Creates an contracted shell pair : an array of pairs of primitive shells.
|
|
|
|
A contracted shell with N functions combined with a contracted
|
|
|
|
shell with M functions generates a NxM array of shell pairs.
|
|
|
|
*)
|
2018-03-15 15:25:49 +01:00
|
|
|
let create ?(cutoff=1.e-32) s_a s_b =
|
|
|
|
|
|
|
|
(*
|
|
|
|
Format.printf "@[<2>shell_a :@ %a@]@;" Cs.pp s_a;
|
|
|
|
Format.printf "@[<2>shell_b :@ %a@]@;" Cs.pp s_b;
|
|
|
|
*)
|
|
|
|
|
|
|
|
let make = Psp.create_make_of (Cs.prim s_a).(0) (Cs.prim s_b).(0) in
|
|
|
|
|
|
|
|
let center_ab = Co.( Cs.center s_a |- Cs.center s_b ) in
|
|
|
|
|
|
|
|
(*
|
|
|
|
Format.printf "@[center_ab :@ %a@]@;" Coordinate.pp_angstrom center_ab;
|
|
|
|
Format.printf "@[a_minus_b :@ %a@]@." Coordinate.pp_angstrom (Psp.a_minus_b (
|
|
|
|
match make 0 (Cs.prim s_a).(0) 0 (Cs.prim s_b).(0) 0.
|
|
|
|
with Some x -> x | _ -> assert false));
|
|
|
|
*)
|
|
|
|
|
|
|
|
let norm_sq = Co.dot center_ab center_ab in
|
|
|
|
|
|
|
|
let norm_coef_scale_a =
|
|
|
|
Cs.norm_coef_scale s_a
|
|
|
|
and norm_coef_scale_b =
|
|
|
|
Cs.norm_coef_scale s_b
|
|
|
|
in
|
|
|
|
let norm_coef_scale =
|
|
|
|
Array.map (fun v1 ->
|
|
|
|
Array.map (fun v2 -> v1 *. v2) norm_coef_scale_b
|
|
|
|
) norm_coef_scale_a
|
|
|
|
|> Array.to_list
|
|
|
|
|> Array.concat
|
|
|
|
in
|
|
|
|
|
|
|
|
assert (norm_coef_scale = Psp.norm_coef_scale (
|
|
|
|
match make 0 (Cs.prim s_a).(0) 0 (Cs.prim s_b).(0) 0.
|
|
|
|
with Some x -> x | _ -> assert false));
|
2018-01-17 18:19:38 +01:00
|
|
|
|
2018-02-09 19:41:22 +01:00
|
|
|
let shell_pairs =
|
2018-03-15 15:25:49 +01:00
|
|
|
Array.init (Cs.size s_a) (fun i ->
|
|
|
|
let p_a = (Cs.prim s_a).(i) in
|
|
|
|
let p_a_expo_center = Co.( (Cs.expo s_a).(i) |. Cs.center s_a ) in
|
|
|
|
let norm_coef_a = (Cs.norm_coef s_a).(i) in
|
|
|
|
assert (norm_coef_a = Ps.norm_coef p_a);
|
|
|
|
|
|
|
|
let make = make 0 p_a in
|
|
|
|
|
|
|
|
Array.init (Cs.size s_b) (fun j ->
|
|
|
|
let p_b = (Cs.prim s_b).(j) in
|
2018-02-23 15:49:27 +01:00
|
|
|
|
2018-02-09 19:41:22 +01:00
|
|
|
try
|
2018-03-15 15:25:49 +01:00
|
|
|
let sp = make 0 p_b cutoff in
|
|
|
|
|
|
|
|
let sp_ = match sp with Some x -> x | None -> raise Null_contribution in
|
|
|
|
|
|
|
|
let norm_coef_b = (Cs.norm_coef s_b).(j) in
|
|
|
|
assert (norm_coef_b = Ps.norm_coef p_b);
|
|
|
|
|
|
|
|
let norm_coef = norm_coef_a *. norm_coef_b in
|
|
|
|
|
2018-02-23 15:49:27 +01:00
|
|
|
if norm_coef < cutoff then
|
2018-02-09 19:41:22 +01:00
|
|
|
raise Null_contribution;
|
2018-03-15 15:25:49 +01:00
|
|
|
let p_b_expo_center = Co.( (Cs.expo s_b).(j) |. Cs.center s_b ) in
|
|
|
|
let expo = (Cs.expo s_a).(i) +. (Cs.expo s_b).(j) in
|
2018-02-09 19:41:22 +01:00
|
|
|
let expo_inv = 1. /. expo in
|
2018-02-23 15:49:27 +01:00
|
|
|
let center = Co.(expo_inv |. (p_a_expo_center |+ p_b_expo_center ) )
|
2018-02-09 19:41:22 +01:00
|
|
|
in
|
|
|
|
let argexpo =
|
2018-03-15 15:25:49 +01:00
|
|
|
(Cs.expo s_a).(i) *. (Cs.expo s_b).(j) *. norm_sq *. expo_inv
|
2018-02-09 19:41:22 +01:00
|
|
|
in
|
|
|
|
let g =
|
2018-02-23 15:49:27 +01:00
|
|
|
(pi *. expo_inv)**(1.5) *. exp (-. argexpo)
|
2018-02-09 19:41:22 +01:00
|
|
|
in
|
|
|
|
let coef =
|
2018-03-15 15:25:49 +01:00
|
|
|
norm_coef *. g
|
2018-02-09 19:41:22 +01:00
|
|
|
in
|
2018-02-23 15:49:27 +01:00
|
|
|
if abs_float coef < cutoff then
|
2018-02-09 19:41:22 +01:00
|
|
|
raise Null_contribution;
|
|
|
|
let center_a =
|
2018-03-15 15:25:49 +01:00
|
|
|
Co.(center |- Cs.center s_a)
|
2018-02-09 19:41:22 +01:00
|
|
|
in
|
|
|
|
let monocentric =
|
2018-03-15 15:25:49 +01:00
|
|
|
Cs.(center s_a = center s_b)
|
2018-02-09 19:41:22 +01:00
|
|
|
in
|
2018-02-10 03:37:00 +01:00
|
|
|
let totAngMomInt =
|
2018-03-15 15:25:49 +01:00
|
|
|
Am.(Cs.totAngMom s_a + Cs.totAngMom s_b)
|
2018-03-14 21:58:55 +01:00
|
|
|
|> Am.to_int
|
2018-02-10 03:37:00 +01:00
|
|
|
in
|
2018-03-15 15:25:49 +01:00
|
|
|
assert (expo= Psp.expo sp_ );
|
|
|
|
assert (expo_inv= Psp.expo_inv sp_ );
|
|
|
|
assert (center= Psp.center sp_ );
|
|
|
|
Some ( (Cs.coef s_a).(i) *. (Cs.coef s_b).(j), {
|
2018-02-23 15:49:27 +01:00
|
|
|
Sp.i ; j ;
|
2018-03-15 15:25:49 +01:00
|
|
|
shell_a=s_a ; shell_b=s_b ;
|
|
|
|
coef ;
|
2018-02-23 15:49:27 +01:00
|
|
|
expo ; expo_inv ;
|
|
|
|
center ; center_a ; center_ab ;
|
|
|
|
norm_sq ; monocentric ; totAngMomInt
|
2018-03-15 15:25:49 +01:00
|
|
|
})
|
2018-02-09 19:41:22 +01:00
|
|
|
with
|
|
|
|
| Null_contribution -> None
|
|
|
|
)
|
|
|
|
)
|
|
|
|
|> Array.to_list
|
|
|
|
|> Array.concat
|
|
|
|
|> Array.to_list
|
|
|
|
|> List.filter (function Some _ -> true | None -> false)
|
|
|
|
|> List.map (function Some x -> x | None -> assert false)
|
|
|
|
|> Array.of_list
|
|
|
|
in
|
2018-03-15 15:25:49 +01:00
|
|
|
let coef = Array.map (fun (c,y) -> c *. y.Sp.coef) shell_pairs
|
|
|
|
and expo_inv = Array.map (fun (_,y) -> y.Sp.expo_inv) shell_pairs
|
2018-02-09 19:41:22 +01:00
|
|
|
in
|
2018-03-15 15:25:49 +01:00
|
|
|
let shell_pairs = Array.map snd shell_pairs in
|
2018-02-09 19:41:22 +01:00
|
|
|
{
|
2018-03-15 15:25:49 +01:00
|
|
|
shell_a = s_a ; shell_b = s_b ; coef ; expo_inv ;
|
2018-02-09 19:41:22 +01:00
|
|
|
shell_pairs ; center_ab=shell_pairs.(0).center_ab;
|
2018-02-10 03:37:00 +01:00
|
|
|
norm_coef_scale ; norm_sq=shell_pairs.(0).norm_sq;
|
2018-02-23 15:49:27 +01:00
|
|
|
totAngMomInt = shell_pairs.(0).Sp.totAngMomInt;
|
2018-02-09 19:41:22 +01:00
|
|
|
}
|
2018-01-17 18:19:38 +01:00
|
|
|
|
2018-02-07 13:33:25 +01:00
|
|
|
|
2018-03-14 14:39:22 +01:00
|
|
|
let shell_a x = x.shell_a
|
|
|
|
let shell_b x = x.shell_b
|
|
|
|
let shell_pairs x = x.shell_pairs
|
|
|
|
let coef x = x.coef
|
|
|
|
let expo_inv x = x.expo_inv
|
|
|
|
let center_ab x = x.center_ab
|
|
|
|
let norm_sq x = x.norm_sq
|
|
|
|
let totAngMomInt x = x.totAngMomInt
|
|
|
|
let norm_coef_scale x = x.norm_coef_scale
|
|
|
|
|
|
|
|
let monocentric x = x.shell_pairs.(0).Sp.monocentric
|
|
|
|
|
2018-02-07 17:07:05 +01:00
|
|
|
(** Returns an integer characteristic of a contracted shell pair *)
|
2018-02-07 13:33:25 +01:00
|
|
|
let hash a =
|
2018-02-08 01:00:54 +01:00
|
|
|
Array.map Hashtbl.hash a
|
2018-02-07 13:33:25 +01:00
|
|
|
|
2018-02-07 17:07:05 +01:00
|
|
|
|
|
|
|
(** Comparison function, used for sorting *)
|
2018-02-07 13:33:25 +01:00
|
|
|
let cmp a b =
|
2018-02-08 01:00:54 +01:00
|
|
|
if a = b then 0
|
|
|
|
else if (Array.length a < Array.length b) then -1
|
|
|
|
else if (Array.length a > Array.length b) then 1
|
|
|
|
else
|
|
|
|
let out = ref 0 in
|
|
|
|
begin
|
|
|
|
try
|
|
|
|
for k=0 to (Array.length a - 1) do
|
|
|
|
if a.(k) < b.(k) then
|
|
|
|
(out := (-1); raise Not_found)
|
|
|
|
else if a.(k) > b.(k) then
|
|
|
|
(out := 1; raise Not_found);
|
|
|
|
done
|
|
|
|
with Not_found -> ();
|
|
|
|
end;
|
|
|
|
!out
|
|
|
|
|
|
|
|
|
|
|
|
(** The array of all shell pairs with their correspondance in the list
|
|
|
|
of contracted shells.
|
|
|
|
*)
|
2018-03-14 14:39:22 +01:00
|
|
|
let of_basis basis =
|
2018-02-08 01:00:54 +01:00
|
|
|
Array.mapi (fun i shell_a ->
|
|
|
|
Array.mapi (fun j shell_b ->
|
|
|
|
create shell_a shell_b)
|
|
|
|
(Array.sub basis 0 (i+1))
|
|
|
|
) basis
|
2018-02-07 13:33:25 +01:00
|
|
|
|
|
|
|
|
2018-02-08 01:00:54 +01:00
|
|
|
let equivalent x y =
|
|
|
|
(Array.length x = Array.length y) &&
|
2018-02-23 15:49:27 +01:00
|
|
|
(Array.init (Array.length x) (fun k -> Sp.equivalent x.(k) y.(k))
|
2018-02-08 01:00:54 +01:00
|
|
|
|> Array.fold_left (fun accu x -> x && accu) true)
|
2018-02-07 17:07:05 +01:00
|
|
|
|
|
|
|
|
|
|
|
(** A list of unique shell pairs *)
|
2018-02-08 01:00:54 +01:00
|
|
|
let unique sp =
|
|
|
|
let sp =
|
|
|
|
Array.to_list sp
|
|
|
|
|> Array.concat
|
|
|
|
|> Array.to_list
|
|
|
|
in
|
|
|
|
let rec aux accu = function
|
|
|
|
| [] -> accu
|
|
|
|
| x::rest ->
|
|
|
|
try ignore @@ List.find (fun y -> equivalent x y) accu; aux accu rest
|
|
|
|
with Not_found -> aux (x::accu) rest
|
|
|
|
in
|
|
|
|
aux [] sp
|
2018-02-07 13:33:25 +01:00
|
|
|
|
|
|
|
|
2018-02-08 01:00:54 +01:00
|
|
|
(** A map from a shell pair hash to the list of indices in the array
|
|
|
|
of shell pairs.
|
|
|
|
*)
|
|
|
|
let indices sp =
|
2018-02-07 17:07:05 +01:00
|
|
|
let map =
|
2018-02-07 13:33:25 +01:00
|
|
|
Hashtbl.create 129
|
|
|
|
in
|
2018-02-07 17:07:05 +01:00
|
|
|
Array.iteri (fun i s ->
|
|
|
|
Array.iteri (fun j shell_p ->
|
|
|
|
let key =
|
|
|
|
hash shell_p
|
|
|
|
in
|
2018-02-08 01:00:54 +01:00
|
|
|
Hashtbl.add map key (i,j); ) s
|
|
|
|
) sp;
|
2018-02-07 13:33:25 +01:00
|
|
|
map
|
2018-02-07 17:07:05 +01:00
|
|
|
|
|
|
|
|
|
|
|
|
2018-01-22 23:19:24 +01:00
|
|
|
|