QCaml/Basis/Orthonormalization.ml

open Util
open Lacaml.D

type t = Mat.t

module Am  = AngularMomentum
module Bs  = Basis
module Cs  = ContractedShell
module Ov  = Overlap


  
let make_canonical ~thresh ~basis ~cartesian ~overlap =

  let overlap_matrix =  Ov.matrix overlap in

  let make_canonical_spherical 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_matrix in
    let overlap_matrix = gemm s ~n:!n cart_sphe in
    let s = canonical_ortho ~thresh ~overlap:overlap_matrix (Mat.identity !n) in
    gemm cart_sphe ~k:!n s
  in

  if cartesian then
    canonical_ortho ~thresh ~overlap:overlap_matrix (Mat.identity @@ Mat.dim1 overlap_matrix)
  else
    match basis with
    | None -> invalid_arg
              "Basis.t is required when cartesian=false in make_canonical"
    | Some basis -> make_canonical_spherical basis



let make_lowdin ~thresh ~overlap =
  
  let overlap_matrix = Ov.matrix overlap in
  let u_vec, u_val = diagonalize_symm overlap_matrix 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
  gemm u_vec' ~transb:`T u_vec



let make ?(thresh=1.e-12) ?basis ~cartesian overlap =
  (*
  make_lowdin ~thresh ~overlap
  *)
  make_canonical ~thresh ~basis ~cartesian ~overlap