mirror of
https://gitlab.com/scemama/QCaml.git
synced 2024-12-06 20:43:33 +01:00
Added ERI type
This commit is contained in:
parent
031408f5ab
commit
b5b3e1fc98
107
Basis/ERI.ml
107
Basis/ERI.ml
@ -4,16 +4,88 @@ open Util
|
||||
open Constants
|
||||
open Bigarray
|
||||
|
||||
type t = (float, float32_elt, fortran_layout) Bigarray.Genarray.t
|
||||
let max_ao = 1 lsl 14
|
||||
|
||||
let get ~r1 ~r2 t =
|
||||
let i,k = r1
|
||||
and j,l = r2
|
||||
in
|
||||
t.{i,k,j,l}
|
||||
type index_pair = { first : int ; second : int }
|
||||
|
||||
let get_chem t i j k l = get ~r1:(i,j) ~r2:(k,l) t
|
||||
let get_phys t i j k l = get ~r1:(i,k) ~r2:(j,l) t
|
||||
type t =
|
||||
| Dense of (float, float64_elt, fortran_layout) Bigarray.Genarray.t
|
||||
| Sparse of (int, float) Hashtbl.t
|
||||
|
||||
|
||||
let key_of_indices ~r1 ~r2 =
|
||||
let { first=i ; second=k } = r1 and { first=j ; second=l } = r2 in
|
||||
let i,k = if i<=k then i,k else k,i
|
||||
and j,l = if j<=l then j,l else l,j in
|
||||
let i,k,j,l = if k<=l then i,k,j,l else j,l,i,k in
|
||||
((((((i lsl 15) lor k) lsl 15) lor j) lsl 15) lor l)
|
||||
|
||||
|
||||
let get ~r1 ~r2 = function
|
||||
| Dense t -> let { first=i ; second=k } = r1 and { first=j ; second=l } = r2 in t.{i,j,k,l}
|
||||
| Sparse t -> let key = key_of_indices ~r1 ~r2 in
|
||||
try Hashtbl.find t key
|
||||
with Not_found -> 0.
|
||||
|
||||
|
||||
let set ~r1 ~r2 ~value = function
|
||||
| Dense t -> let { first=i ; second=k } = r1 and { first=j ; second=l } = r2 in
|
||||
t.{i,j,k,l} <- value;
|
||||
t.{k,j,i,l} <- value;
|
||||
t.{i,l,k,j} <- value;
|
||||
t.{k,l,i,j} <- value;
|
||||
t.{j,i,l,k} <- value;
|
||||
t.{j,k,l,i} <- value;
|
||||
t.{l,i,j,k} <- value;
|
||||
t.{l,k,j,i} <- value;
|
||||
|
||||
| Sparse t -> let key = key_of_indices ~r1 ~r2 in
|
||||
Hashtbl.replace t key value
|
||||
|
||||
|
||||
let increment ~r1 ~r2 ~value = function
|
||||
| Dense t -> let { first=i ; second=k } = r1 and { first=j ; second=l } = r2 in
|
||||
t.{i,j,k,l} <- t.{i,j,k,l} +. value;
|
||||
t.{k,j,i,l} <- t.{k,j,i,l} +. value;
|
||||
t.{i,l,k,j} <- t.{i,l,k,j} +. value;
|
||||
t.{k,l,i,j} <- t.{k,l,i,j} +. value;
|
||||
t.{j,i,l,k} <- t.{j,i,l,k} +. value;
|
||||
t.{j,k,l,i} <- t.{j,k,l,i} +. value;
|
||||
t.{l,i,j,k} <- t.{l,i,j,k} +. value;
|
||||
t.{l,k,j,i} <- t.{l,k,j,i} +. value;
|
||||
| Sparse t -> let key = key_of_indices ~r1 ~r2 in
|
||||
let old_value =
|
||||
try Hashtbl.find t key
|
||||
with Not_found -> 0.
|
||||
in
|
||||
Hashtbl.replace t key (old_value +. value)
|
||||
|
||||
|
||||
let create = function
|
||||
| `Dense n ->
|
||||
let eri_array =
|
||||
Genarray.create Float64 fortran_layout [| n ; n ; n ; n|]
|
||||
in
|
||||
Genarray.fill eri_array 0.;
|
||||
Dense eri_array
|
||||
|
||||
| `Sparse n ->
|
||||
let eri_array = Hashtbl.create (n*n+13) in
|
||||
Hashtbl.add eri_array (-1) (float_of_int n);
|
||||
Sparse eri_array
|
||||
|
||||
let size = function
|
||||
| Dense t -> Genarray.nth_dim t 3
|
||||
| Sparse t -> Hashtbl.find t (-1) |> int_of_float
|
||||
|
||||
(** TODO : remove epsilons *)
|
||||
|
||||
|
||||
let get_chem t i j k l = get ~r1:{ first=i ; second=j } ~r2:{ first=k ; second=l } t
|
||||
let get_phys t i j k l = get ~r1:{ first=i ; second=k } ~r2:{ first=j ; second=l } t
|
||||
|
||||
let set_chem t i j k l value = set ~r1:{ first=i ; second=j } ~r2:{ first=k ; second=l } ~value t
|
||||
let set_phys t i j k l value = set ~r1:{ first=i ; second=k } ~r2:{ first=j ; second=l } ~value t
|
||||
|
||||
|
||||
module Am = AngularMomentum
|
||||
@ -140,9 +212,11 @@ let of_basis basis =
|
||||
|
||||
(* 4D data initialization *)
|
||||
let eri_array =
|
||||
Genarray.create Float32 fortran_layout [| n ; n ; n ; n|]
|
||||
(*
|
||||
create (`Dense n)
|
||||
*)
|
||||
create (`Sparse n)
|
||||
in
|
||||
Genarray.fill eri_array 0.;
|
||||
|
||||
(* Compute ERIs *)
|
||||
|
||||
@ -229,14 +303,7 @@ let of_basis basis =
|
||||
let value =
|
||||
Zmap.find cls key
|
||||
in
|
||||
eri_array.{i_c,k_c,j_c,l_c} <- value;
|
||||
eri_array.{j_c,k_c,i_c,l_c} <- value;
|
||||
eri_array.{i_c,l_c,j_c,k_c} <- value;
|
||||
eri_array.{j_c,l_c,i_c,k_c} <- value;
|
||||
eri_array.{k_c,i_c,l_c,j_c} <- value;
|
||||
eri_array.{k_c,j_c,l_c,i_c} <- value;
|
||||
eri_array.{l_c,i_c,k_c,j_c} <- value;
|
||||
eri_array.{l_c,j_c,k_c,i_c} <- value;
|
||||
set_chem eri_array i_c j_c k_c l_c value;
|
||||
if (abs_float value > cutoff) then
|
||||
(inn := !inn + 1;
|
||||
)
|
||||
@ -259,11 +326,11 @@ let of_basis basis =
|
||||
let to_file ~filename eri_array =
|
||||
let oc = open_out filename in
|
||||
(* Print ERIs *)
|
||||
for l_c=1 to (Genarray.nth_dim eri_array 3) do
|
||||
for l_c=1 to size eri_array do
|
||||
for k_c=1 to l_c do
|
||||
for j_c=1 to l_c do
|
||||
for i_c=1 to k_c do
|
||||
let value = eri_array.{i_c,j_c,k_c,l_c} in
|
||||
let value = get_phys eri_array i_c j_c k_c l_c in
|
||||
if (abs_float value > cutoff) then
|
||||
Printf.fprintf oc " %5d %5d %5d %5d%20.15f\n" i_c j_c k_c l_c value;
|
||||
done;
|
||||
|
@ -1,5 +1,4 @@
|
||||
type t
|
||||
val get : r1:int * int -> r2:int * int -> t -> float
|
||||
val get_chem : t -> int -> int -> int -> int -> float
|
||||
val get_phys : t -> int -> int -> int -> int -> float
|
||||
|
||||
|
@ -23,8 +23,8 @@ let make ~density simulation =
|
||||
if abs_float p > epsilon then
|
||||
for mu = 1 to nu do
|
||||
m_F.{mu,nu} <- m_F.{mu,nu} +. p *.
|
||||
(ERI.get_chem m_G mu lambda nu sigma
|
||||
-. 0.5 *. ERI.get_chem m_G mu lambda sigma nu)
|
||||
(ERI.get_phys m_G mu lambda nu sigma
|
||||
-. 0.5 *. ERI.get_phys m_G mu lambda sigma nu)
|
||||
done
|
||||
done
|
||||
done
|
||||
|
Loading…
Reference in New Issue
Block a user