mirror of
https://gitlab.com/scemama/QCaml.git
synced 2024-11-06 22:23:42 +01:00
137 lines
3.5 KiB
OCaml
137 lines
3.5 KiB
OCaml
exception AngularMomentumError of string
|
|
|
|
type t =
|
|
| S | P | D | F | G | H | I | J | K | L | M | N | O
|
|
|
|
let of_char = function
|
|
| 's' | 'S' -> S | 'p' | 'P' -> P
|
|
| 'd' | 'D' -> D | 'f' | 'F' -> F
|
|
| 'g' | 'G' -> G | 'h' | 'H' -> H
|
|
| 'i' | 'I' -> I | 'j' | 'J' -> J
|
|
| 'k' | 'K' -> K | 'l' | 'L' -> L
|
|
| 'm' | 'M' -> M | 'n' | 'N' -> N
|
|
| 'o' | 'O' -> O
|
|
| c -> raise (AngularMomentumError (String.make 1 c))
|
|
|
|
let to_string = function
|
|
| S -> "S" | P -> "P"
|
|
| D -> "D" | F -> "F"
|
|
| G -> "G" | H -> "H"
|
|
| I -> "I" | J -> "J"
|
|
| K -> "K" | L -> "L"
|
|
| M -> "M" | N -> "N"
|
|
| O -> "O"
|
|
|
|
let to_char = function
|
|
| S -> 'S' | P -> 'P'
|
|
| D -> 'D' | F -> 'F'
|
|
| G -> 'G' | H -> 'H'
|
|
| I -> 'I' | J -> 'J'
|
|
| K -> 'K' | L -> 'L'
|
|
| M -> 'M' | N -> 'N'
|
|
| O -> 'O'
|
|
|
|
let to_int = function
|
|
| S -> 0 | P -> 1
|
|
| D -> 2 | F -> 3
|
|
| G -> 4 | H -> 5
|
|
| I -> 6 | J -> 7
|
|
| K -> 8 | L -> 9
|
|
| M -> 10 | N -> 11
|
|
| O -> 12
|
|
|
|
let of_int = function
|
|
| 0 -> S | 1 -> P
|
|
| 2 -> D | 3 -> F
|
|
| 4 -> G | 5 -> H
|
|
| 6 -> I | 7 -> J
|
|
| 8 -> K | 9 -> L
|
|
| 10 -> M | 11 -> N
|
|
| 12 -> O
|
|
| c -> raise (AngularMomentumError (string_of_int c))
|
|
|
|
|
|
|
|
type kind =
|
|
| Kind_1 of t
|
|
| Kind_2 of (t*t)
|
|
| Kind_4 of (t*t*t*t)
|
|
|
|
|
|
let n_functions a =
|
|
let a =
|
|
to_int a
|
|
in
|
|
(a*a + 3*a + 2)/2
|
|
|
|
|
|
(** Returns an array of Zkeys corresponding to all possible angular momenta *)
|
|
let zkey_array a =
|
|
let keys_1d l =
|
|
let create_z (x,y,_) =
|
|
(x,y,l-(x+y))
|
|
in
|
|
let rec create_y accu xyz =
|
|
let (x,y,z) = xyz in
|
|
match y with
|
|
| 0 -> (create_z xyz)::accu
|
|
| i -> let ynew = y-1 in
|
|
create_y ( (create_z xyz)::accu) (x,ynew,z)
|
|
in
|
|
let rec create_x accu xyz =
|
|
let (x,y,z) = xyz in
|
|
match x with
|
|
| 0 -> (create_y [] xyz)@accu
|
|
| i -> let xnew = x-1 in
|
|
let ynew = l-xnew in
|
|
create_x ((create_y [] xyz)@accu) (xnew, ynew, z)
|
|
in
|
|
create_x [] (l,0,0)
|
|
|> List.rev
|
|
in
|
|
|
|
begin
|
|
match a with
|
|
| Kind_1 l1 ->
|
|
|
|
let a = Array.init 3 (fun _ -> 0) in
|
|
List.map (fun (cx,cy,cz) ->
|
|
a.(0) <- cx ; a.(1) <- cy ; a.(2) <- cz ;
|
|
Zkey.(of_int_array Kind_3 a)
|
|
) (keys_1d @@ to_int l1)
|
|
|
|
| Kind_2 (l1, l2) ->
|
|
|
|
let a = Array.init 6 (fun _ -> 0) in
|
|
List.map (fun (cx,cy,cz) ->
|
|
a.(0) <- cx ; a.(1) <- cy ; a.(2) <- cz ;
|
|
List.map (fun (dx,dy,dz) ->
|
|
a.(3) <- dx ; a.(4) <- dy ; a.(5) <- dz ;
|
|
Zkey.(of_int_array Kind_6 a)
|
|
) (keys_1d @@ to_int l1)
|
|
) (keys_1d @@ to_int l2)
|
|
|> List.concat
|
|
|
|
| Kind_4 (l1, l2, l3, l4) ->
|
|
|
|
let a = Array.init 12 (fun _ -> 0) in
|
|
List.map (fun (ax,ay,az) ->
|
|
a.(0) <- ax ; a.(1) <- ay ; a.(2) <- az ;
|
|
List.map (fun (bx,by,bz) ->
|
|
a.(3) <- bx ; a.(4) <- by ; a.(5) <- bz ;
|
|
List.map (fun (cx,cy,cz) ->
|
|
a.(6) <- cx ; a.(7) <- cy ; a.(8) <- cz ;
|
|
List.map (fun (dx,dy,dz) ->
|
|
a.(9) <- dx ; a.(10) <- dy ; a.(11) <- dz ;
|
|
Zkey.(of_int_array Kind_12 a)
|
|
) (keys_1d @@ to_int l4)
|
|
) (keys_1d @@ to_int l3)
|
|
|> List.concat
|
|
) (keys_1d @@ to_int l2)
|
|
|> List.concat
|
|
) (keys_1d @@ to_int l1)
|
|
|> List.concat
|
|
end
|
|
|> Array.of_list
|
|
|