open Lacaml.D open Simulation open Constants open Util type t = { fock : Mat.t ; core : Mat.t ; coulomb : Mat.t ; exchange : Mat.t ; } module Ao = AOBasis let make ~density ao_basis = let m_P = density and m_T = Lazy.force ao_basis.Ao.kin_ints |> KinInt.matrix and m_V = Lazy.force ao_basis.Ao.eN_ints |> NucInt.matrix and m_G = Lazy.force ao_basis.Ao.ee_ints in let nBas = Mat.dim1 m_T in let m_Hc = Mat.add m_T m_V and m_J = Array.make_matrix nBas nBas 0. and m_K = Array.make_matrix nBas nBas 0. in (* let permutations i j k l = [ [ i ; j ; k ; l ] ; [ k ; j ; i ; l ] ; [ i ; l ; k ; j ] ; [ k ; l ; i ; j ] ; [ j ; i ; l ; k ] ; [ j ; k ; l ; i ] ; [ l ; i ; j ; k ] ; [ l ; k ; j ; i ] ] in ERI.to_stream m_G |> Stream.iter (fun { ERI.i_r1 ; j_r2 ; k_r1 ; l_r2 ; value } -> permutations i_r1 j_r2 k_r1 l_r2 |> List.iter ( fun ijkl -> match ijkl with | mu :: lambda :: nu :: sigma :: [] -> let p = m_P.{lambda,sigma} in if abs_float p > epsilon then let m_Jnu = m_J.(nu-1) in m_Jnu.(mu-1) <- m_Jnu.(mu-1) +. p *. value | _ -> assert false )); *) for sigma = 1 to nBas do for nu = 1 to nBas do let m_Jnu = m_J.(nu-1) in for lambda = 1 to sigma do let p = if lambda < sigma then 2. *. m_P.{lambda,sigma} else m_P.{lambda,sigma} in if abs_float p > epsilon then for mu = 1 to nu do m_Jnu.(mu-1) <- m_Jnu.(mu-1) +. p *. ERI.get_phys m_G mu lambda nu sigma done done done done; for nu = 1 to nBas do for mu = 1 to nu-1 do m_J.(mu-1).(nu-1) <- m_J.(nu-1).(mu-1); done done; for nu = 1 to nBas do let m_Knu = m_K.(nu-1) in for sigma = 1 to nBas do for lambda = 1 to nBas do let p = 0.5 *. m_P.{lambda,sigma} in if abs_float p > epsilon then for mu = 1 to nu do m_Knu.(mu-1) <- m_Knu.(mu-1) -. p *. ERI.get_phys m_G mu lambda sigma nu done done done; for mu = 1 to nu-1 do m_K.(mu-1).(nu-1) <- m_Knu.(mu-1); done done; let m_J = Mat.of_array m_J and m_K = Mat.of_array m_K in { fock = Mat.add m_Hc (Mat.add m_J m_K) ; core = m_Hc ; coulomb = m_J ; exchange = m_K } let pp_fock ppf a = Format.fprintf ppf "@[<2>"; Format.fprintf ppf "@[ Fock matrix:@[<2>@[%a@]@.]@]" pp_matrix a.fock; Format.fprintf ppf "@[ Core Hamiltonian:@[<2>@[%a@]@.]@]" pp_matrix a.core; Format.fprintf ppf "@[ Coulomb matrix:@[<2>@[%a@]@.]@]" pp_matrix a.coulomb; Format.fprintf ppf "@[ Exchange matrix:@[<2>@[%a@]@.]@]" pp_matrix a.exchange; Format.fprintf ppf "@]"