72 lines
2.0 KiB
OCaml
72 lines
2.0 KiB
OCaml
open Qptypes
|
|
|
|
module Hole = struct
|
|
type t = MO_class.t [@@deriving sexp]
|
|
let of_mo_class x = x
|
|
let to_mo_class x = x
|
|
end
|
|
|
|
module Particle = struct
|
|
type t = MO_class.t [@@deriving sexp]
|
|
let of_mo_class x = x
|
|
let to_mo_class x = x
|
|
end
|
|
|
|
type t =
|
|
| Single of Hole.t*Particle.t
|
|
| Double of Hole.t*Particle.t*Hole.t*Particle.t
|
|
[@@deriving sexp]
|
|
|
|
let create_single ~hole ~particle =
|
|
MO_class.(
|
|
match (hole,particle) with
|
|
| ( Core _, _ ) -> failwith "Holes can not be in core MOs"
|
|
| ( _, Core _ ) -> failwith "Particles can not be in core MOs"
|
|
| ( Deleted _, _ ) -> failwith "Holes can not be in deleted MOs"
|
|
| ( _, Deleted _ ) -> failwith "Particles can not be in deleted MOs"
|
|
| ( Virtual _, _ ) -> failwith "Holes can not be in virtual MOs"
|
|
| ( _, Inactive _ ) -> failwith "Particles can not be in virtual MOs"
|
|
| (h, p) -> Single ( (Hole.of_mo_class h), (Particle.of_mo_class p) )
|
|
)
|
|
|
|
|
|
let double_of_singles s1 s2 =
|
|
let (h1,p1) = match s1 with
|
|
| Single (h,p) -> (h,p)
|
|
| _ -> assert false
|
|
and (h2,p2) = match s2 with
|
|
| Single (h,p) -> (h,p)
|
|
| _ -> assert false
|
|
in
|
|
Double (h1,p1,h2,p2)
|
|
|
|
|
|
let create_double ~hole1 ~particle1 ~hole2 ~particle2 =
|
|
let s1 = create_single ~hole:hole1 ~particle:particle1
|
|
and s2 = create_single ~hole:hole2 ~particle:particle2
|
|
in
|
|
double_of_singles s1 s2
|
|
|
|
|
|
let to_string = function
|
|
| Single (h,p) ->
|
|
[ "Single Exc. : [" ;
|
|
(MO_class.to_string (Hole.to_mo_class h));
|
|
"," ;
|
|
(MO_class.to_string (Particle.to_mo_class p));
|
|
"]"]
|
|
|> String.concat " "
|
|
| Double (h1,p1,h2,p2) ->
|
|
[ "Double Exc. : [" ;
|
|
(MO_class.to_string (Hole.to_mo_class h1));
|
|
"," ;
|
|
(MO_class.to_string (Particle.to_mo_class p1));
|
|
";" ;
|
|
(MO_class.to_string (Hole.to_mo_class h2));
|
|
"," ;
|
|
(MO_class.to_string (Particle.to_mo_class p2));
|
|
"]"]
|
|
|> String.concat " "
|
|
|
|
|