10
1
mirror of https://gitlab.com/scemama/QCaml.git synced 2024-11-06 22:23:42 +01:00
QCaml/Basis/ERI.ml

280 lines
9.0 KiB
OCaml
Raw Normal View History

2018-01-19 03:14:06 +01:00
(** Electron-electron repulsion integrals *)
2018-01-17 19:09:57 +01:00
open Util
2018-01-18 23:42:48 +01:00
(** (00|00)^m : Fundamental electron repulsion integral
2018-01-19 03:14:06 +01:00
$ \int \int \phi_p(r1) 1/r_{12} \phi_q(r2) dr_1 dr_2 $
2018-01-17 19:09:57 +01:00
2018-01-19 03:14:06 +01:00
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$
2018-01-17 19:09:57 +01:00
*)
let zero_m ~maxm ~expo_pq_inv ~norm_pq_sq =
let exp_pq =
1. /. expo_pq_inv
in
let t =
norm_pq_sq *. exp_pq
in
boys_function ~maxm t
|> Array.mapi (fun m fm ->
two_over_sq_pi *. (if m mod 2 = 0 then fm else -.fm) *.
(pow exp_pq m) *. (sqrt exp_pq)
)
2018-01-19 03:14:06 +01:00
(** Compute all the integrals of a contracted class *)
let contracted_class shell_a shell_b shell_c shell_d : float Zmap.t =
2018-01-18 23:42:48 +01:00
TwoElectronRR.contracted_class ~zero_m shell_a shell_b shell_c shell_d
2018-01-17 19:09:57 +01:00
2018-01-19 03:14:06 +01:00
type n_cls = { n : int ; cls : Z.t array }
2018-01-19 17:42:12 +01:00
(** Write all integrals to a file with the <ij|kl> convention *)
2018-01-19 03:14:06 +01:00
let to_file ~filename basis =
let oc = open_out filename in
let key_array = Array.make 12 0 in
for i=0 to (Array.length basis) - 1 do
2018-01-19 17:42:12 +01:00
print_int basis.(i).Contracted_shell.indice ; print_newline ();
2018-01-19 03:14:06 +01:00
for j=0 to i do
for k=0 to i do
for l=0 to k do
2018-01-19 17:42:12 +01:00
(* Compute all the integrals of the class *)
2018-01-19 03:14:06 +01:00
let cls =
contracted_class basis.(i) basis.(j) basis.(k) basis.(l)
in
2018-01-19 17:42:12 +01:00
for i_c = 0 to (Array.length basis.(i).Contracted_shell.powers) - 1 do
let x = Zkey.(to_int_array Kind_3 basis.(i).Contracted_shell.powers.(i_c)) in
2018-01-19 03:14:06 +01:00
key_array.(0) <- x.(0);
key_array.(1) <- x.(1);
key_array.(2) <- x.(2);
2018-01-19 17:42:12 +01:00
for j_c = 0 to (Array.length basis.(j).Contracted_shell.powers) - 1 do
let x = Zkey.(to_int_array Kind_3 basis.(j).Contracted_shell.powers.(j_c)) in
2018-01-19 03:14:06 +01:00
key_array.(3) <- x.(0);
key_array.(4) <- x.(1);
key_array.(5) <- x.(2);
2018-01-19 17:42:12 +01:00
for k_c = 0 to (Array.length basis.(k).Contracted_shell.powers) - 1 do
let x = Zkey.(to_int_array Kind_3 basis.(k).Contracted_shell.powers.(k_c)) in
2018-01-19 03:14:06 +01:00
key_array.(6) <- x.(0);
key_array.(7) <- x.(1);
key_array.(8) <- x.(2);
2018-01-19 17:42:12 +01:00
for l_c = 0 to (Array.length basis.(l).Contracted_shell.powers) - 1 do
let x = Zkey.(to_int_array Kind_3 basis.(l).Contracted_shell.powers.(l_c)) in
2018-01-19 03:14:06 +01:00
key_array.( 9) <- x.(0);
key_array.(10) <- x.(1);
key_array.(11) <- x.(2);
let key =
Zkey.(of_int_array Kind_12 key_array)
in
let value =
Zmap.find cls key
in
if (abs_float value > cutoff) then
Printf.fprintf oc "%4d %4d %4d %4d %20.12e\n"
2018-01-19 17:42:12 +01:00
(basis.(i).Contracted_shell.indice + i_c + 1)
(basis.(k).Contracted_shell.indice + k_c + 1)
(basis.(j).Contracted_shell.indice + j_c + 1)
(basis.(l).Contracted_shell.indice + l_c + 1)
2018-01-19 03:14:06 +01:00
value
done
done
done
done;
done;
done;
done;
done
;
close_out oc
(*
2018-01-19 17:42:12 +01:00
module IntegralMap = Zmap
let index i j k l =
Zkey.of_int_array Zkey.Kind_4 [| i;j;k;l |]
module Key = struct
type t=int
let equal (x:int) (y:int) = x = y
let hash (x:int) = x
end
module IntegralMap = Hashtbl.Make(Key)
let index i j k l =
let f i k =
let (p,r) =
if i <= k then (i,k) else (k,i)
in p+ (r*r-r)/2
in
let p = f i k and q = f j l in
f p q
2018-01-19 03:14:06 +01:00
let to_file ~filename basis =
let oc = open_out filename in
let zkey = Array.map (fun b ->
let result =
Angular_momentum.(zkey_array (Kind_1 b.Contracted_shell.totAngMom))
in
{ n=Array.length result ; cls=result }
) basis
in
let key_array = Array.make 12 0 in
let result = ref [] in
let i_shift = ref 1 in
for i=0 to (Array.length basis) - 1 do
print_int !i_shift ; print_newline ();
let j_shift = ref 1 in
for j=0 to i do
let k_shift = ref 1 in
for k=0 to i do
let l_shift = ref 1 in
for l=0 to k do
let cls =
contracted_class basis.(i) basis.(j) basis.(k) basis.(l)
in
for i_c = 0 to zkey.(i).n - 1 do
let x = Zkey.(to_int_array Kind_3 zkey.(i).cls.(i_c)) in
key_array.(0) <- x.(0);
key_array.(1) <- x.(1);
key_array.(2) <- x.(2);
for j_c = 0 to zkey.(j).n - 1 do
let x = Zkey.(to_int_array Kind_3 zkey.(j).cls.(j_c)) in
key_array.(3) <- x.(0);
key_array.(4) <- x.(1);
key_array.(5) <- x.(2);
for k_c = 0 to zkey.(k).n - 1 do
let x = Zkey.(to_int_array Kind_3 zkey.(k).cls.(k_c)) in
key_array.(6) <- x.(0);
key_array.(7) <- x.(1);
key_array.(8) <- x.(2);
for l_c = 0 to zkey.(l).n - 1 do
let x = Zkey.(to_int_array Kind_3 zkey.(l).cls.(l_c)) in
key_array.( 9) <- x.(0);
key_array.(10) <- x.(1);
key_array.(11) <- x.(2);
let key =
Zkey.(of_int_array Kind_12 key_array)
in
let value =
Zmap.find cls key
in
if (abs_float value > cutoff) then
let key =
2018-01-19 17:42:12 +01:00
index (!i_shift+i_c) (!j_shift+j_c) (!k_shift+k_c) (!l_shift+l_c)
2018-01-19 03:14:06 +01:00
in
result := (key, value) :: !result
done
done
done
done;
l_shift := !l_shift + zkey.(l).n
done;
k_shift := !k_shift + zkey.(k).n
done;
j_shift := !j_shift + zkey.(j).n
done;
i_shift := !i_shift + zkey.(i).n
done
;
2018-01-19 17:42:12 +01:00
print_endline "Computation Done";
2018-01-19 03:14:06 +01:00
let result = Array.of_list !result in
2018-01-19 17:42:12 +01:00
let result =
let a = IntegralMap.create (Array.length result) in
Array.iter (fun (k,v) -> IntegralMap.add a k v) result;
a
in
print_endline "Map formed";
2018-01-19 03:14:06 +01:00
2018-01-19 17:42:12 +01:00
for i=1 to !i_shift - 1 do
for k=1 to !i_shift - 1 do
for j=1 to !i_shift - 1 do
for l=1 to !i_shift - 1 do
2018-01-19 03:14:06 +01:00
let key =
2018-01-19 17:42:12 +01:00
index i j k l
2018-01-19 03:14:06 +01:00
in
try
let value =
2018-01-19 17:42:12 +01:00
IntegralMap.find result key
2018-01-19 03:14:06 +01:00
in
2018-01-19 17:42:12 +01:00
Printf.fprintf oc " %5d %5d %5d %5d%20.15f\n" i j k l value
2018-01-19 03:14:06 +01:00
with Not_found -> ()
done
done
done
done;
close_out oc
2018-01-19 17:42:12 +01:00
let xto_file ~filename basis =
let zkey = Array.map (fun b ->
let result =
Angular_momentum.(zkey_array (Kind_1 b.Contracted_shell.totAngMom))
in
{ n=Array.length result ; cls=result }
) basis
in
let key_array = Array.make 12 0 in
let result = ref [] in
let (i,j,k,l) = (1,1,1,18) in
let (i,j,k,l) = (i-1,j-1,k-1,l-1) in
basis.(i) |> Contracted_shell.to_string |> print_endline;
basis.(j) |> Contracted_shell.to_string |> print_endline;
basis.(k) |> Contracted_shell.to_string |> print_endline;
basis.(l) |> Contracted_shell.to_string |> print_endline;
let bi, bj, bk, bl =
basis.(i), basis.(j), basis.(k), basis.(l)
in
let cls =
(*contracted_class basis.(i) basis.(j) basis.(k) basis.(l) *)
contracted_class bi bj bk bl
in
Zmap.iter (fun k v -> Printf.printf "%50s %20e\n" Zkey.(to_string Kind_12 k) v) cls;
for i_c = 0 to zkey.(i).n - 1 do
let x = Zkey.(to_int_array Kind_3 zkey.(i).cls.(i_c)) in
key_array.(0) <- x.(0);
key_array.(1) <- x.(1);
key_array.(2) <- x.(2);
for j_c = 0 to zkey.(j).n - 1 do
let x = Zkey.(to_int_array Kind_3 zkey.(j).cls.(j_c)) in
key_array.(3) <- x.(0);
key_array.(4) <- x.(1);
key_array.(5) <- x.(2);
for k_c = 0 to zkey.(k).n - 1 do
let x = Zkey.(to_int_array Kind_3 zkey.(k).cls.(k_c)) in
key_array.(6) <- x.(0);
key_array.(7) <- x.(1);
key_array.(8) <- x.(2);
for l_c = 0 to zkey.(l).n - 1 do
let x = Zkey.(to_int_array Kind_3 zkey.(l).cls.(l_c)) in
key_array.( 9) <- x.(0);
key_array.(10) <- x.(1);
key_array.(11) <- x.(2);
let key =
Zkey.(of_int_array Kind_12 key_array)
in
let value =
Zmap.find cls key
in
if (abs_float value > cutoff) then
result := (key, value) :: !result
done
done
done
done;
List.iter (fun (k,v) -> Printf.printf "%60s %e\n" Zkey.(to_string Kind_12 k) v) !result
;
*)