QCaml/mo/lib/class.ml

open Particles
open Common
    
type mo_class =                                                                              
  | Core       of int  (* Always doubly occupied *)
  | Inactive   of int  (* With 0,1 or 2 holes *)
  | Active     of int  (* With 0,1 or 2 holes or particles *)
  | Virtual    of int  (* With 0,1 or 2 particles *)
  | Deleted    of int  (* Always unoccupied *)
  | Auxiliary  of int  (* Auxiliary basis function *)

type t = mo_class list


let pp_mo_class ppf = function
  | Core      i -> Format.fprintf ppf "@[Core %d@]" i
  | Inactive  i -> Format.fprintf ppf "@[Inactive %d@]" i
  | Active    i -> Format.fprintf ppf "@[Active %d@]" i
  | Virtual   i -> Format.fprintf ppf "@[Virtual %d@]" i
  | Deleted   i -> Format.fprintf ppf "@[Deleted %d@]" i
  | Auxiliary i -> Format.fprintf ppf "@[Auxiliary %d@]" i

let pp ppf t =
  Format.fprintf ppf "@[[@,";
  let rec aux = function
  | [] -> Format.fprintf ppf "]@]"
  | x :: [] -> Format.fprintf ppf "%a@,]@]" pp_mo_class x
  | x :: rest -> ( Format.fprintf ppf "%a@,;@," pp_mo_class x; aux rest )
  in
  aux t


let of_list t = t

let to_list t = t


let core_mos t =
  List.filter_map (fun x ->
      match x with 
      | Core i -> Some i
      | _ -> None) t


let inactive_mos t =
  List.filter_map (fun x ->
      match x with 
      | Inactive i -> Some i
      | _ -> None ) t


let active_mos t =
  List.filter_map (fun x ->
      match x with 
      | Active i -> Some i
      | _ -> None ) t


let virtual_mos t =
  List.filter_map (fun x ->
      match x with 
      | Virtual i -> Some i
      | _ -> None ) t


let deleted_mos t =
  List.filter_map (fun x ->
      match x with                                                                           
      | Deleted i -> Some i
      | _ -> None ) t



let auxiliary_mos t =
  List.filter_map (fun x ->
      match x with                                                                           
      | Auxiliary i -> Some i
      | _ -> None ) t


let mo_class_array t =
  let sze = List.length t + 1 in
  let result = Array.make sze (Deleted 0) in
  List.iter (fun c ->
      match c with
      |  Core      i  ->  result.(i)  <-  Core      i
      |  Inactive  i  ->  result.(i)  <-  Inactive  i
      |  Active    i  ->  result.(i)  <-  Active    i
      |  Virtual   i  ->  result.(i)  <-  Virtual   i
      |  Deleted   i  ->  result.(i)  <-  Deleted   i
      |  Auxiliary i  ->  result.(i)  <-  Auxiliary i
    ) t;
  result


let fci ~frozen_core mo_basis =
  let mo_num = Basis.size mo_basis in
  let ncore  = (Nuclei.small_core @@ Simulation.nuclei @@ Basis.simulation mo_basis) / 2 in
  of_list (
    if frozen_core then
      List.concat [
        Util.list_range 1 ncore
        |> List.map (fun i -> Core i) ;
        Util.list_range (ncore+1) mo_num
        |> List.map (fun i -> Active i) 
      ]
    else
      Util.list_range 1 mo_num
      |> List.map (fun i -> Active i)
  )

let cas_sd mo_basis ~frozen_core n m =
  let mo_num = Basis.size mo_basis in
  let n_alfa = Basis.simulation mo_basis |> Simulation.electrons |> Electrons.n_alfa in
  let n_beta = Basis.simulation mo_basis |> Simulation.electrons |> Electrons.n_beta in
  let n_unpaired = n_alfa - n_beta in
  let n_alfa_in_cas = (n - n_unpaired)/2 + n_unpaired in
  let last_inactive = n_alfa - n_alfa_in_cas in
  let last_active  = last_inactive + m in
  let ncore  =
    if frozen_core then
      (Nuclei.small_core @@ Simulation.nuclei @@ Basis.simulation mo_basis) / 2
      |> min last_inactive
    else 0
  in
  of_list (
    List.concat [
        if ncore > 0 then
          Util.list_range 1 ncore
          |> List.map (fun i -> Core i) 
        else
          [] ;
        Util.list_range (ncore+1) last_inactive
        |> List.map (fun i -> Inactive i) ;
        Util.list_range (last_inactive+1) last_active
        |> List.map (fun i -> Active i) ;
        Util.list_range (last_active+1) mo_num
        |> List.map (fun i -> Virtual i) 
      ]
  )