mirror of
https://gitlab.com/scemama/QCaml.git
synced 2024-11-19 04:22:21 +01:00
75 lines
1.8 KiB
OCaml
75 lines
1.8 KiB
OCaml
open Util
|
|
open Lacaml.D
|
|
|
|
type t =
|
|
| Lowdin of Mat.t
|
|
| Canonical of Mat.t
|
|
| Svd of Mat.t
|
|
|
|
module Am = AngularMomentum
|
|
module Bs = Basis
|
|
module Cs = ContractedShell
|
|
|
|
|
|
|
|
let make_canonical_spherical ~thresh ~overlap basis =
|
|
let ao_num = Bs.size basis in
|
|
let cart_sphe = Mat.make ao_num ao_num 0.
|
|
and i = ref 0
|
|
and n = ref 0 in
|
|
Array.iter (fun shell ->
|
|
let submatrix =
|
|
SphericalToCartesian.matrix (Cs.ang_mom shell)
|
|
in
|
|
ignore @@ lacpy ~b:cart_sphe ~br:(!i+1) ~bc:(!n+1) submatrix;
|
|
i := !i + Mat.dim1 submatrix;
|
|
n := !n + Mat.dim2 submatrix;
|
|
) (Bs.contracted_shells basis);
|
|
let s = gemm ~transa:`T ~m:!n cart_sphe overlap in
|
|
let overlap = gemm s ~n:!n cart_sphe in
|
|
let s = canonical_ortho ~thresh ~overlap (Mat.identity !n) in
|
|
gemm cart_sphe ~k:!n s
|
|
|
|
|
|
|
|
let make_canonical ~cartesian ~thresh ~basis ~overlap =
|
|
let result =
|
|
if cartesian then
|
|
canonical_ortho ~thresh ~overlap (Mat.identity @@ Mat.dim1 overlap)
|
|
else
|
|
match basis with
|
|
| None -> invalid_arg
|
|
"Basis.t is required when cartesian=false in make_canonical"
|
|
| Some basis ->
|
|
make_canonical_spherical ~thresh ~overlap basis
|
|
in
|
|
Canonical result
|
|
|
|
|
|
|
|
let make_lowdin ~thresh ~overlap =
|
|
|
|
let u_vec, u_val = diagonalize_symm overlap in
|
|
|
|
Vec.iter (fun x -> if x < thresh then
|
|
invalid_arg (__FILE__^": make_lowdin") ) u_val;
|
|
|
|
let u_val = Vec.reci (Vec.sqrt u_val) in
|
|
|
|
let u_vec' =
|
|
Mat.init_cols (Mat.dim1 u_vec) (Mat.dim2 u_vec) (fun i j -> u_vec.{i,j} *. u_val.{j})
|
|
in
|
|
let result =
|
|
gemm u_vec' ~transb:`T u_vec
|
|
in
|
|
|
|
Lowdin result
|
|
|
|
|
|
|
|
let make ~cartesian ?(thresh=1.e-12) ?basis overlap =
|
|
(*
|
|
make_lowdin ~thresh ~overlap
|
|
*)
|
|
make_canonical ~cartesian ~basis ~thresh ~overlap
|