mirror of
https://gitlab.com/scemama/QCaml.git
synced 2024-11-19 04:22:21 +01:00
147 lines
3.7 KiB
OCaml
147 lines
3.7 KiB
OCaml
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.map (fun x ->
|
|
match x with
|
|
| Core i -> Some i
|
|
| _ -> None) t
|
|
|> Util.list_some
|
|
|
|
|
|
let inactive_mos t =
|
|
List.map (fun x ->
|
|
match x with
|
|
| Inactive i -> Some i
|
|
| _ -> None ) t
|
|
|> Util.list_some
|
|
|
|
|
|
let active_mos t =
|
|
List.map (fun x ->
|
|
match x with
|
|
| Active i -> Some i
|
|
| _ -> None ) t
|
|
|> Util.list_some
|
|
|
|
|
|
let virtual_mos t =
|
|
List.map (fun x ->
|
|
match x with
|
|
| Virtual i -> Some i
|
|
| _ -> None ) t
|
|
|> Util.list_some
|
|
|
|
|
|
let deleted_mos t =
|
|
List.map (fun x ->
|
|
match x with
|
|
| Deleted i -> Some i
|
|
| _ -> None ) t
|
|
|> Util.list_some
|
|
|
|
|
|
let auxiliary_mos t =
|
|
List.map (fun x ->
|
|
match x with
|
|
| Auxiliary i -> Some i
|
|
| _ -> None ) t
|
|
|> Util.list_some
|
|
|
|
|
|
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 = MOBasis.size mo_basis in
|
|
let ncore = (Nuclei.small_core @@ Simulation.nuclei @@ MOBasis.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 = MOBasis.size mo_basis in
|
|
let n_alfa = MOBasis.simulation mo_basis |> Simulation.electrons |> Electrons.n_alfa in
|
|
let n_beta = MOBasis.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 @@ MOBasis.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)
|
|
]
|
|
)
|
|
|
|
|