mirror of
https://gitlab.com/scemama/QCaml.git
synced 2024-08-30 16:23:41 +02:00
81 lines
1.9 KiB
OCaml
81 lines
1.9 KiB
OCaml
open Lacaml.D
|
|
open Util
|
|
|
|
type guess =
|
|
| Hcore of Mat.t
|
|
| Huckel of Mat.t
|
|
|
|
type t = guess
|
|
|
|
module Ao = AOBasis
|
|
module El = Electrons
|
|
module Ov = Overlap
|
|
|
|
let hcore_guess ao_basis =
|
|
let eN_ints = Ao.eN_ints ao_basis |> NucInt.matrix
|
|
and kin_ints = Ao.kin_ints ao_basis |> KinInt.matrix
|
|
in
|
|
Mat.add eN_ints kin_ints
|
|
|
|
|
|
let huckel_guess ao_basis =
|
|
let c = 0.5 *. 1.75 in
|
|
let ao_num = Ao.basis ao_basis |> Basis.size in
|
|
let eN_ints = Ao.eN_ints ao_basis |> NucInt.matrix
|
|
and kin_ints = Ao.kin_ints ao_basis |> KinInt.matrix
|
|
and overlap = Ao.overlap ao_basis |> Ov.matrix
|
|
and m_X = Ao.ortho ao_basis
|
|
in
|
|
let diag = Array.init (ao_num+1) (fun i -> if i=0 then 0. else
|
|
eN_ints.{i,i} +. kin_ints.{i,i})
|
|
in
|
|
|
|
function
|
|
| 0 -> invalid_arg "Huckel guess needs a non-zero number of occupied MOs."
|
|
| nocc ->
|
|
let density = gemm ~alpha:2. ~transb:`T ~k:nocc m_X m_X in
|
|
let fock = Fock.make ~density ao_basis in
|
|
let m_F = fock.Fock.fock in
|
|
for j=1 to ao_num do
|
|
for i=1 to ao_num do
|
|
if (i <> j) then
|
|
m_F.{i,j} <- c *. overlap.{i,j} *. (diag.(i) +. diag.(j)) (*TODO Pseudo *)
|
|
done;
|
|
done;
|
|
m_F
|
|
|
|
|
|
let make ?(nocc=0) ~guess ao_basis =
|
|
match guess with
|
|
| `Hcore -> Hcore (hcore_guess ao_basis)
|
|
| `Huckel -> Huckel (huckel_guess ao_basis nocc)
|
|
|
|
|
|
|
|
|
|
|
|
let test_case ao_basis =
|
|
|
|
let test_hcore () =
|
|
match make ~guess:`Hcore ao_basis with
|
|
| Hcore matrix ->
|
|
let a = Lacaml.D.Mat.to_array matrix in
|
|
let reference =
|
|
Lacaml.D.Mat.add
|
|
(AOBasis.eN_ints ao_basis |> NucInt.matrix)
|
|
(AOBasis.kin_ints ao_basis |> KinInt.matrix)
|
|
|> Lacaml.D.Mat.to_array
|
|
in
|
|
Array.iteri (fun i x ->
|
|
let message =
|
|
Printf.sprintf "Guess line %d" (i)
|
|
in
|
|
Alcotest.(check (array (float 1.e-15))) message a.(i) x) reference
|
|
| _ -> assert false
|
|
|
|
in
|
|
[
|
|
"HCore", `Quick, test_hcore;
|
|
]
|
|
|