mirror of
https://gitlab.com/scemama/QCaml.git
synced 2024-12-22 12:23:31 +01:00
Optimizations
This commit is contained in:
parent
0e694adf84
commit
bba7b6e8e4
@ -94,36 +94,21 @@ let zkey_array a =
|
|||||||
begin
|
begin
|
||||||
match a with
|
match a with
|
||||||
| Singlet l1 ->
|
| Singlet l1 ->
|
||||||
|
List.map (fun x -> Zkey.of_int_tuple (Zkey.Three x)) (keys_1d @@ to_int 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)
|
|
||||||
|
|
||||||
| Doublet (l1, l2) ->
|
| Doublet (l1, l2) ->
|
||||||
|
List.map (fun a ->
|
||||||
let a = Array.init 6 (fun _ -> 0) in
|
List.map (fun b ->
|
||||||
List.map (fun (cx,cy,cz) ->
|
Zkey.of_int_tuple (Zkey.Six (a,b))) (keys_1d @@ to_int l1)
|
||||||
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)
|
) (keys_1d @@ to_int l2)
|
||||||
|> List.concat
|
|> List.concat
|
||||||
|
|
||||||
| Triplet (l1, l2, l3) ->
|
| Triplet (l1, l2, l3) ->
|
||||||
|
|
||||||
let a = Array.init 9 (fun _ -> 0) in
|
List.map (fun a ->
|
||||||
List.map (fun (ax,ay,az) ->
|
List.map (fun b ->
|
||||||
a.(0) <- ax ; a.(1) <- ay ; a.(2) <- az ;
|
List.map (fun c ->
|
||||||
List.map (fun (bx,by,bz) ->
|
Zkey.of_int_tuple (Zkey.Nine (a,b,c))) (keys_1d @@ to_int l3)
|
||||||
a.(3) <- bx ; a.(4) <- by ; a.(5) <- bz ;
|
|
||||||
List.map (fun (cx,cy,cz) ->
|
|
||||||
a.(6) <- cx ; a.(7) <- cy ; a.(8) <- cz ;
|
|
||||||
Zkey.(of_int_array Kind_9 a)
|
|
||||||
) (keys_1d @@ to_int l3)
|
|
||||||
) (keys_1d @@ to_int l2)
|
) (keys_1d @@ to_int l2)
|
||||||
|> List.concat
|
|> List.concat
|
||||||
) (keys_1d @@ to_int l1)
|
) (keys_1d @@ to_int l1)
|
||||||
@ -131,17 +116,11 @@ let zkey_array a =
|
|||||||
|
|
||||||
| Quartet (l1, l2, l3, l4) ->
|
| Quartet (l1, l2, l3, l4) ->
|
||||||
|
|
||||||
let a = Array.init 12 (fun _ -> 0) in
|
List.map (fun a ->
|
||||||
List.map (fun (ax,ay,az) ->
|
List.map (fun b ->
|
||||||
a.(0) <- ax ; a.(1) <- ay ; a.(2) <- az ;
|
List.map (fun c ->
|
||||||
List.map (fun (bx,by,bz) ->
|
List.map (fun d ->
|
||||||
a.(3) <- bx ; a.(4) <- by ; a.(5) <- bz ;
|
Zkey.of_int_tuple (Zkey.Twelve (a,b,c,d))) (keys_1d @@ to_int l4)
|
||||||
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)
|
) (keys_1d @@ to_int l3)
|
||||||
|> List.concat
|
|> List.concat
|
||||||
) (keys_1d @@ to_int l2)
|
) (keys_1d @@ to_int l2)
|
||||||
|
@ -2,7 +2,7 @@
|
|||||||
|
|
||||||
include Z
|
include Z
|
||||||
|
|
||||||
type kind =
|
type kind_array =
|
||||||
| Kind_3
|
| Kind_3
|
||||||
| Kind_6
|
| Kind_6
|
||||||
| Kind_12
|
| Kind_12
|
||||||
@ -12,7 +12,7 @@ type kind =
|
|||||||
| Kind_1
|
| Kind_1
|
||||||
|
|
||||||
|
|
||||||
(** Build a Zkey from an array or 1, 2, 3, 4, 6, or 12 integers *)
|
(** Build a Zkey from an array or 1, 2, 3, 4, 6, 9, or 12 integers *)
|
||||||
let of_int_array ~kind a =
|
let of_int_array ~kind a =
|
||||||
let (<|) x a =
|
let (<|) x a =
|
||||||
Z.logor (Z.shift_left x 64) a
|
Z.logor (Z.shift_left x 64) a
|
||||||
@ -48,6 +48,47 @@ let of_int_array ~kind a =
|
|||||||
| Kind_1 -> Z.of_int a.(0)
|
| Kind_1 -> Z.of_int a.(0)
|
||||||
|
|
||||||
|
|
||||||
|
type kind =
|
||||||
|
| One of (int)
|
||||||
|
| Two of (int*int)
|
||||||
|
| Three of (int*int*int)
|
||||||
|
| Four of ((int*int)*(int*int))
|
||||||
|
| Six of ((int*int*int)*(int*int*int))
|
||||||
|
| Nine of ((int*int*int)*(int*int*int)*(int*int*int))
|
||||||
|
| Twelve of ((int*int*int)*(int*int*int)*(int*int*int)*(int*int*int))
|
||||||
|
|
||||||
|
let (<|) x a =
|
||||||
|
Z.logor (Z.shift_left x 64) a
|
||||||
|
|
||||||
|
let (<<) x a =
|
||||||
|
Int64.logor (Int64.shift_left x 10) (Int64.of_int a)
|
||||||
|
|
||||||
|
let (<+) x a =
|
||||||
|
Int64.logor (Int64.shift_left x 16) (Int64.of_int a)
|
||||||
|
|
||||||
|
let of_int_tuple a =
|
||||||
|
match a with
|
||||||
|
| One (a) -> Z.of_int a
|
||||||
|
| Two (a,b) -> (Int64.of_int a) <+ b |> Z.of_int64
|
||||||
|
| Three (a,b,c) -> (Int64.of_int a) << b << c |> Z.of_int64
|
||||||
|
| Four ((a,b),(c,d)) ->
|
||||||
|
(Int64.of_int a) <+ b <+ c <+ d |> Z.of_int64
|
||||||
|
| Six ((a,b,c),(d,e,f)) ->
|
||||||
|
(Int64.of_int a) << b << c << d << e << f |> Z.of_int64
|
||||||
|
| Twelve ((a,b,c),(d,e,f),(g,h,i),(j,k,l)) ->
|
||||||
|
let a =
|
||||||
|
(Int64.of_int a) << b << c << d << e << f |> Z.of_int64
|
||||||
|
and b =
|
||||||
|
(Int64.of_int g) << h << i << j << k << l |> Z.of_int64
|
||||||
|
in a <| b
|
||||||
|
| Nine ((a,b,c),(d,e,f),(g,h,i)) ->
|
||||||
|
let a =
|
||||||
|
(Int64.of_int a) << b << c << d << e << f |> Z.of_int64
|
||||||
|
and b =
|
||||||
|
(Int64.of_int g) << h << i |> Z.of_int64
|
||||||
|
in a <| b
|
||||||
|
|
||||||
|
|
||||||
(** Transform the Zkey into an int array *)
|
(** Transform the Zkey into an int array *)
|
||||||
let to_int_array ~kind a =
|
let to_int_array ~kind a =
|
||||||
match kind with
|
match kind with
|
||||||
@ -89,6 +130,7 @@ let to_int_array ~kind a =
|
|||||||
Z.to_int @@ Z.extract a 0 16 |]
|
Z.to_int @@ Z.extract a 0 16 |]
|
||||||
| Kind_1 -> [| Z.to_int a |]
|
| Kind_1 -> [| Z.to_int a |]
|
||||||
|
|
||||||
|
|
||||||
let to_string ~kind a =
|
let to_string ~kind a =
|
||||||
"< " ^ ( Z.to_string a ) ^ " | " ^ (
|
"< " ^ ( Z.to_string a ) ^ " | " ^ (
|
||||||
to_int_array kind a
|
to_int_array kind a
|
||||||
@ -98,6 +140,53 @@ let to_string ~kind a =
|
|||||||
) ^ " >"
|
) ^ " >"
|
||||||
|
|
||||||
|
|
||||||
|
(** Transform the Zkey into an int array *)
|
||||||
|
let to_int_tuple ~kind a =
|
||||||
|
match kind with
|
||||||
|
| Kind_3 -> Three ( Z.to_int @@ Z.extract a 20 10 ,
|
||||||
|
Z.to_int @@ Z.extract a 10 10 ,
|
||||||
|
Z.to_int @@ Z.extract a 0 10 )
|
||||||
|
|
||||||
|
| Kind_6 -> Six ((Z.to_int @@ Z.extract a 50 10 ,
|
||||||
|
Z.to_int @@ Z.extract a 40 10 ,
|
||||||
|
Z.to_int @@ Z.extract a 30 10),
|
||||||
|
(Z.to_int @@ Z.extract a 20 10 ,
|
||||||
|
Z.to_int @@ Z.extract a 10 10 ,
|
||||||
|
Z.to_int @@ Z.extract a 0 10))
|
||||||
|
|
||||||
|
| Kind_12 -> Twelve ((Z.to_int @@ Z.extract a 114 10 ,
|
||||||
|
Z.to_int @@ Z.extract a 104 10 ,
|
||||||
|
Z.to_int @@ Z.extract a 94 10),
|
||||||
|
(Z.to_int @@ Z.extract a 84 10 ,
|
||||||
|
Z.to_int @@ Z.extract a 74 10 ,
|
||||||
|
Z.to_int @@ Z.extract a 64 10),
|
||||||
|
(Z.to_int @@ Z.extract a 50 10 ,
|
||||||
|
Z.to_int @@ Z.extract a 40 10 ,
|
||||||
|
Z.to_int @@ Z.extract a 30 10),
|
||||||
|
(Z.to_int @@ Z.extract a 20 10 ,
|
||||||
|
Z.to_int @@ Z.extract a 10 10 ,
|
||||||
|
Z.to_int @@ Z.extract a 0 10))
|
||||||
|
|
||||||
|
| Kind_9 -> Nine ((Z.to_int @@ Z.extract a 84 10 ,
|
||||||
|
Z.to_int @@ Z.extract a 74 10 ,
|
||||||
|
Z.to_int @@ Z.extract a 64 10),
|
||||||
|
(Z.to_int @@ Z.extract a 50 10 ,
|
||||||
|
Z.to_int @@ Z.extract a 40 10 ,
|
||||||
|
Z.to_int @@ Z.extract a 30 10),
|
||||||
|
(Z.to_int @@ Z.extract a 20 10 ,
|
||||||
|
Z.to_int @@ Z.extract a 10 10 ,
|
||||||
|
Z.to_int @@ Z.extract a 0 10))
|
||||||
|
|
||||||
|
| Kind_4 -> Four ((Z.to_int @@ Z.extract a 48 16 ,
|
||||||
|
Z.to_int @@ Z.extract a 32 16),
|
||||||
|
(Z.to_int @@ Z.extract a 16 16 ,
|
||||||
|
Z.to_int @@ Z.extract a 0 16))
|
||||||
|
|
||||||
|
| Kind_2 -> Two ( Z.to_int @@ Z.extract a 16 16,
|
||||||
|
Z.to_int @@ Z.extract a 0 16 )
|
||||||
|
|
||||||
|
| Kind_1 -> One ( Z.to_int a )
|
||||||
|
|
||||||
(*
|
(*
|
||||||
let debug () =
|
let debug () =
|
||||||
let k2 = of_int_array Kind_2 [| 1 ; 2 |]
|
let k2 = of_int_array Kind_2 [| 1 ; 2 |]
|
||||||
|
@ -47,12 +47,14 @@ let run ~coord ~basis ~out =
|
|||||||
let () =
|
let () =
|
||||||
let usage_msg = "Available options:" in
|
let usage_msg = "Available options:" in
|
||||||
Arg.parse speclist (fun _ -> ()) usage_msg;
|
Arg.parse speclist (fun _ -> ()) usage_msg;
|
||||||
try
|
|
||||||
run ~coord:!coord_file ~basis:!basis_file ~out:!out_file
|
run ~coord:!coord_file ~basis:!basis_file ~out:!out_file
|
||||||
|
(*
|
||||||
|
try
|
||||||
with
|
with
|
||||||
| Invalid_argument e ->
|
| Invalid_argument e ->
|
||||||
begin
|
begin
|
||||||
print_string "Error: " ; print_endline e; print_newline ();
|
print_string "Error: " ; print_endline e; print_newline ();
|
||||||
Arg.usage speclist usage_msg
|
Arg.usage speclist usage_msg
|
||||||
end
|
end
|
||||||
|
*)
|
||||||
|
|
||||||
|
Loading…
Reference in New Issue
Block a user