QCaml/CI/SpindeterminantSpace.ml

type t =
  {
    elec_num          : int;
    mo_basis          : MOBasis.t;
    mo_class          : MOClass.t;
    spin_determinants : Spindeterminant.t array;
  }


let spin_determinants t = t.spin_determinants
let elec_num t = t.elec_num
let mo_basis t = t.mo_basis
let mo_class t = t.mo_class
let size     t = Array.length t.spin_determinants

let fci_of_mo_basis ~frozen_core mo_basis elec_num =
  let mo_num = MOBasis.size mo_basis in
  let mo_class = MOClass.fci ~frozen_core mo_basis in
  let m l = 
    List.fold_left (fun accu i -> let j = i-1 in
      Bitstring.logor accu (Bitstring.shift_left_one mo_num j)
                   ) (Bitstring.zero mo_num) l
  in
  let occ_mask    = m (MOClass.core_mos    mo_class)
  and active_mask = m (MOClass.active_mos  mo_class)
  in
  let neg_active_mask = Bitstring.lognot active_mask in
  (* Here we generate the FCI space and filter out unwanted determinants
     with excitations involving the core electrons. This should be improved. *)
  let spin_determinants = 
    Bitstring.permtutations elec_num mo_num 
    |> List.filter (fun b -> Bitstring.logand neg_active_mask b = occ_mask)
    |> Array.of_list
    |> Array.map (fun b -> Spindeterminant.of_bitstring b)
  in
  { elec_num ; mo_basis ; mo_class ; spin_determinants }


let cas_of_mo_basis mo_basis ~frozen_core elec_num n m =
  let mo_num = MOBasis.size mo_basis in
  let mo_class = MOClass.cas_sd ~frozen_core mo_basis n m in
  let m l = 
    List.fold_left (fun accu i -> let j = i-1 in
      Bitstring.logor accu (Bitstring.shift_left_one mo_num j)
                   ) (Bitstring.zero mo_num) l
  in
  let active_mask   = m (MOClass.active_mos   mo_class) in
  let occ_mask      = m (MOClass.core_mos     mo_class) in
  let inactive_mask = m (MOClass.inactive_mos mo_class) in
  let occ_mask = Bitstring.logor occ_mask inactive_mask in
  let neg_active_mask = Bitstring.lognot active_mask in
  (* Here we generate the FCI space and filter out all the unwanted determinants.
     This should be improved. *)
  let spin_determinants = 
    Bitstring.permtutations elec_num mo_num 
    |> List.filter (fun b -> Bitstring.logand neg_active_mask b = occ_mask)
    |> Array.of_list
    |> Array.map (fun b -> Spindeterminant.of_bitstring b)
  in
  { elec_num ; mo_basis ; mo_class ; spin_determinants }



let pp ppf t =
  Format.fprintf ppf "@[<v 2> [";
  let pp = Spindeterminant.pp @@ MOBasis.size (mo_basis t) in
  Array.iteri (fun i d ->
    Format.fprintf ppf "@[<v>@[%8d@] @[%a@]@]@;" i pp d)
    (spin_determinants t) ;
  Format.fprintf ppf "]@]"