mirror of
https://gitlab.com/scemama/QCaml.git
synced 2024-09-01 09:13:40 +02:00
Reimplemented arbitrary space
This commit is contained in:
parent
cadfbb1eef
commit
ce49b45449
2
CI/CI.ml
2
CI/CI.ml
@ -55,7 +55,7 @@ let create_matrix_arbitrary f det_space =
|
|||||||
lazy (
|
lazy (
|
||||||
let det =
|
let det =
|
||||||
match Ds.determinants det_space with
|
match Ds.determinants det_space with
|
||||||
| Ds.Arbitrary a -> a
|
| Ds.Arbitrary _ -> Ds.determinants_array det_space
|
||||||
| _ -> assert false
|
| _ -> assert false
|
||||||
in
|
in
|
||||||
|
|
||||||
|
@ -1,7 +1,27 @@
|
|||||||
|
(** Data structures for storing the determinant space.
|
||||||
|
|
||||||
|
If the space is built as the outer product of all {% $\alpha$ %} and {%
|
||||||
|
$\beta$ %} determinants, the storage is of type [Spin]. It is sufficient
|
||||||
|
to have the arrays of {% $\alpha$ %} and {% $\beta$ %} spindeterminants.
|
||||||
|
|
||||||
|
Otherwise, the space is of type [Arbitrary].
|
||||||
|
|
||||||
|
*)
|
||||||
|
|
||||||
|
type arbitrary_space =
|
||||||
|
{
|
||||||
|
det : int array array ;
|
||||||
|
det_alfa : Spindeterminant.t array ;
|
||||||
|
det_beta : Spindeterminant.t array ;
|
||||||
|
index_start : int array;
|
||||||
|
}
|
||||||
|
|
||||||
|
|
||||||
type determinant_storage =
|
type determinant_storage =
|
||||||
| Arbitrary of Determinant.t array
|
| Arbitrary of arbitrary_space
|
||||||
| Spin of (Spindeterminant.t array * Spindeterminant.t array)
|
| Spin of (Spindeterminant.t array * Spindeterminant.t array)
|
||||||
|
|
||||||
|
|
||||||
type t =
|
type t =
|
||||||
{
|
{
|
||||||
n_alfa : int ;
|
n_alfa : int ;
|
||||||
@ -22,16 +42,47 @@ let mo_basis t = t.mo_basis
|
|||||||
|
|
||||||
let size t =
|
let size t =
|
||||||
match t.determinants with
|
match t.determinants with
|
||||||
| Arbitrary a -> Array.length a
|
|
||||||
| Spin (a,b) -> (Array.length a) * (Array.length b)
|
| Spin (a,b) -> (Array.length a) * (Array.length b)
|
||||||
|
| Arbitrary a ->
|
||||||
|
let ndet_a = Array.length a.det_alfa in
|
||||||
|
a.index_start.(ndet_a - 1) + Array.length a.det.(ndet_a - 1)
|
||||||
|
|
||||||
|
|
||||||
let determinant_stream t =
|
let determinant_stream t =
|
||||||
let imax = size t in
|
|
||||||
match t.determinants with
|
match t.determinants with
|
||||||
| Arbitrary a ->
|
| Arbitrary a ->
|
||||||
Stream.from (fun i ->
|
let det_beta = a.det_beta
|
||||||
if i < imax then Some a.(i) else None)
|
and det_alfa = a.det_alfa
|
||||||
|
and det = a.det in
|
||||||
|
let n_alfa = Array.length det_alfa in
|
||||||
|
let alfa = ref det_alfa.(0)
|
||||||
|
and det_i_alfa = ref det.(0) in
|
||||||
|
let i_alfa = ref 0
|
||||||
|
and k_beta = ref 0
|
||||||
|
in
|
||||||
|
Stream.from (fun _ ->
|
||||||
|
if !i_alfa = n_alfa then None else
|
||||||
|
begin
|
||||||
|
let i_beta = (!det_i_alfa).(!k_beta) in
|
||||||
|
let beta = det_beta.(i_beta) in
|
||||||
|
let result =
|
||||||
|
Some (Determinant.of_spindeterminants (!alfa) beta)
|
||||||
|
in
|
||||||
|
incr k_beta;
|
||||||
|
if !k_beta = Array.length !det_i_alfa then
|
||||||
|
begin
|
||||||
|
k_beta := 0;
|
||||||
|
incr i_alfa;
|
||||||
|
if !i_alfa < n_alfa then
|
||||||
|
begin
|
||||||
|
alfa := det_alfa.(!i_alfa);
|
||||||
|
det_i_alfa := det.(!i_alfa)
|
||||||
|
end
|
||||||
|
end;
|
||||||
|
result
|
||||||
|
end
|
||||||
|
)
|
||||||
|
|
||||||
| Spin (a,b) ->
|
| Spin (a,b) ->
|
||||||
let na = Array.length a
|
let na = Array.length a
|
||||||
and nb = Array.length b in
|
and nb = Array.length b in
|
||||||
@ -53,31 +104,35 @@ let determinants t = t.determinants
|
|||||||
|
|
||||||
|
|
||||||
let determinants_array t =
|
let determinants_array t =
|
||||||
match t.determinants with
|
|
||||||
| Arbitrary a -> a
|
|
||||||
| Spin (a,b) ->
|
|
||||||
let s = determinant_stream t in
|
let s = determinant_stream t in
|
||||||
Array.init (Array.length a * Array.length b) (fun _ ->
|
Array.init (size t) (fun _ -> Stream.next s)
|
||||||
Stream.next s)
|
|
||||||
(*
|
|
||||||
Array.to_list b
|
|
||||||
|> List.map (fun det_b ->
|
|
||||||
Array.map (fun det_a ->
|
|
||||||
Determinant.of_spindeterminants det_a det_b
|
|
||||||
) a
|
|
||||||
)
|
|
||||||
|> Array.concat
|
|
||||||
*)
|
|
||||||
|
|
||||||
|
|
||||||
let determinant t i =
|
let determinant t i =
|
||||||
|
let alfa, beta =
|
||||||
match t.determinants with
|
match t.determinants with
|
||||||
| Arbitrary a -> a.(i)
|
| Arbitrary a ->
|
||||||
|
let i_alfa =
|
||||||
|
let index_start = a.index_start in
|
||||||
|
let rec loop i_alfa =
|
||||||
|
if index_start.(i_alfa) <= i then
|
||||||
|
loop (i_alfa+1)
|
||||||
|
else i_alfa
|
||||||
|
in loop 0
|
||||||
|
in
|
||||||
|
let i_beta = i - a.index_start.(i_alfa) in
|
||||||
|
let alfa = a.det_alfa.(i_alfa) in
|
||||||
|
let beta = a.det_beta.(i_beta) in
|
||||||
|
alfa, beta
|
||||||
|
|
||||||
| Spin (a,b) ->
|
| Spin (a,b) ->
|
||||||
let nb = Array.length b in
|
let nb = Array.length b in
|
||||||
let k = i / nb in
|
let k = i / nb in
|
||||||
let j = i - k * nb in
|
let j = i - k * nb in
|
||||||
Determinant.of_spindeterminants a.(j) b.(k)
|
a.(j), b.(k)
|
||||||
|
|
||||||
|
in
|
||||||
|
Determinant.of_spindeterminants alfa beta
|
||||||
|
|
||||||
|
|
||||||
let fci_of_mo_basis ?(frozen_core=true) mo_basis =
|
let fci_of_mo_basis ?(frozen_core=true) mo_basis =
|
||||||
@ -92,9 +147,18 @@ let fci_of_mo_basis ?(frozen_core=true) mo_basis =
|
|||||||
in
|
in
|
||||||
let mo_class = Ss.mo_class det_a in
|
let mo_class = Ss.mo_class det_a in
|
||||||
let determinants =
|
let determinants =
|
||||||
let a = Ss.spin_determinants det_a
|
let det_alfa = Ss.spin_determinants det_a
|
||||||
and b = Ss.spin_determinants det_b
|
and det_beta = Ss.spin_determinants det_b
|
||||||
in Spin (a,b)
|
in
|
||||||
|
(*
|
||||||
|
in Spin (det_alfa, det_beta)
|
||||||
|
*)
|
||||||
|
let n_det_beta = Array.length det_beta in
|
||||||
|
Arbitrary {
|
||||||
|
det_alfa ; det_beta ;
|
||||||
|
det = Array.make (Array.length det_alfa) (Array.init (Array.length det_beta) (fun i -> i));
|
||||||
|
index_start = Array.mapi (fun i _ -> i*n_det_beta) det_alfa;
|
||||||
|
}
|
||||||
in
|
in
|
||||||
{ n_alfa ; n_beta ; mo_class ; mo_basis ; determinants }
|
{ n_alfa ; n_beta ; mo_class ; mo_basis ; determinants }
|
||||||
|
|
||||||
|
@ -4,10 +4,20 @@ The determinant space in which we solve the Schrodinger equation.
|
|||||||
|
|
||||||
type t
|
type t
|
||||||
|
|
||||||
|
type arbitrary_space =
|
||||||
|
{
|
||||||
|
det : int array array ;
|
||||||
|
det_alfa : Spindeterminant.t array ;
|
||||||
|
det_beta : Spindeterminant.t array ;
|
||||||
|
index_start : int array;
|
||||||
|
}
|
||||||
|
|
||||||
|
|
||||||
type determinant_storage =
|
type determinant_storage =
|
||||||
| Arbitrary of Determinant.t array
|
| Arbitrary of arbitrary_space
|
||||||
| Spin of (Spindeterminant.t array * Spindeterminant.t array)
|
| Spin of (Spindeterminant.t array * Spindeterminant.t array)
|
||||||
|
|
||||||
|
|
||||||
(** {1 Accessors} *)
|
(** {1 Accessors} *)
|
||||||
|
|
||||||
val n_alfa : t -> int
|
val n_alfa : t -> int
|
||||||
|
@ -16,7 +16,23 @@ external erfc_float : float -> float = "erfc_float_bytecode" "erfc_float"
|
|||||||
external gamma_float : float -> float = "gamma_float_bytecode" "gamma_float"
|
external gamma_float : float -> float = "gamma_float_bytecode" "gamma_float"
|
||||||
[@@unboxed] [@@noalloc]
|
[@@unboxed] [@@noalloc]
|
||||||
|
|
||||||
|
external popcnt : int64 -> int32 = "popcnt_bytecode" "popcnt"
|
||||||
|
[@@unboxed] [@@noalloc]
|
||||||
|
(** popcnt instruction *)
|
||||||
|
|
||||||
|
let popcnt i = popcnt i |> Int32.to_int
|
||||||
|
|
||||||
|
external trailz : int64 -> int32 = "trailz_bytecode" "trailz"
|
||||||
|
[@@unboxed] [@@noalloc]
|
||||||
|
(** ctz instruction *)
|
||||||
|
|
||||||
|
let trailz i = trailz i |> Int32.to_int
|
||||||
|
|
||||||
|
external leadz : int64 -> int32 = "leadz_bytecode" "leadz"
|
||||||
|
[@@unboxed] [@@noalloc]
|
||||||
|
(** bsf instruction *)
|
||||||
|
|
||||||
|
let leadz i = leadz i |> Int32.to_int
|
||||||
|
|
||||||
|
|
||||||
|
|
||||||
@ -399,3 +415,27 @@ let sym_matrix_of_file filename =
|
|||||||
done;
|
done;
|
||||||
done;
|
done;
|
||||||
result
|
result
|
||||||
|
|
||||||
|
|
||||||
|
|
||||||
|
let test_case () =
|
||||||
|
|
||||||
|
let test_external () =
|
||||||
|
Alcotest.(check (float 1.e-15)) "erf" 0.842700792949715 (erf_float 1.0);
|
||||||
|
Alcotest.(check (float 1.e-15)) "erf" 0.112462916018285 (erf_float 0.1);
|
||||||
|
Alcotest.(check (float 1.e-15)) "erf" (-0.112462916018285) (erf_float (-0.1));
|
||||||
|
Alcotest.(check (float 1.e-15)) "erfc" 0.157299207050285 (erfc_float 1.0);
|
||||||
|
Alcotest.(check (float 1.e-15)) "erfc" 0.887537083981715 (erfc_float 0.1);
|
||||||
|
Alcotest.(check (float 1.e-15)) "erfc" (1.112462916018285) (erfc_float (-0.1));
|
||||||
|
Alcotest.(check (float 1.e-14)) "gamma" (1.77245385090552) (gamma_float 0.5);
|
||||||
|
Alcotest.(check (float 1.e-14)) "gamma" (9.51350769866873) (gamma_float (0.1));
|
||||||
|
Alcotest.(check (float 1.e-14)) "gamma" (-3.54490770181103) (gamma_float (-0.5));
|
||||||
|
Alcotest.(check int) "popcnt" 6 (popcnt @@ Int64.of_int 63);
|
||||||
|
Alcotest.(check int) "popcnt" 8 (popcnt @@ Int64.of_int 299605);
|
||||||
|
Alcotest.(check int) "popcnt" 1 (popcnt @@ Int64.of_int 65536);
|
||||||
|
Alcotest.(check int) "popcnt" 0 (popcnt @@ Int64.of_int 0);
|
||||||
|
in
|
||||||
|
[
|
||||||
|
"External", `Quick, test_external;
|
||||||
|
]
|
||||||
|
|
||||||
|
@ -16,6 +16,22 @@ external gamma_float : float -> float = "gamma_float_bytecode" "gamma_float"
|
|||||||
[@@unboxed] [@@noalloc]
|
[@@unboxed] [@@noalloc]
|
||||||
(** Gamma function [gamma] from [libm] *)
|
(** Gamma function [gamma] from [libm] *)
|
||||||
|
|
||||||
|
(*
|
||||||
|
external popcnt : int64 -> int32 = "popcnt_bytecode" "popcnt"
|
||||||
|
[@@unboxed] [@@noalloc]
|
||||||
|
(** popcnt instruction *)
|
||||||
|
|
||||||
|
external trailz : int64 -> int32 = "trailz_bytecode" "trailz"
|
||||||
|
[@@unboxed] [@@noalloc]
|
||||||
|
(** ctz instruction *)
|
||||||
|
*)
|
||||||
|
|
||||||
|
val popcnt : int64 -> int
|
||||||
|
(** popcnt instruction *)
|
||||||
|
|
||||||
|
val trailz : int64 -> int
|
||||||
|
(** ctz instruction *)
|
||||||
|
|
||||||
|
|
||||||
|
|
||||||
(** {2 General functions} *)
|
(** {2 General functions} *)
|
||||||
@ -187,3 +203,8 @@ val pp_bitstring : int -> Format.formatter -> Z.t -> unit
|
|||||||
|
|
||||||
val pp_matrix : Format.formatter -> Mat.t -> unit
|
val pp_matrix : Format.formatter -> Mat.t -> unit
|
||||||
|
|
||||||
|
|
||||||
|
(** {1 Unit tests} *)
|
||||||
|
|
||||||
|
val test_case : unit -> (string * [> `Quick ] * (unit -> unit)) list
|
||||||
|
|
||||||
|
@ -30,8 +30,44 @@ CAMLprim value gamma_float_bytecode(value x)
|
|||||||
return copy_double(tgamma(Double_val(x)));
|
return copy_double(tgamma(Double_val(x)));
|
||||||
}
|
}
|
||||||
|
|
||||||
|
|
||||||
CAMLprim double gamma_float(double x)
|
CAMLprim double gamma_float(double x)
|
||||||
{
|
{
|
||||||
return tgamma(x);
|
return tgamma(x);
|
||||||
}
|
}
|
||||||
|
|
||||||
|
|
||||||
|
CAMLprim int32_t popcnt(int64_t i)
|
||||||
|
{
|
||||||
|
return __builtin_popcountll (i);
|
||||||
|
}
|
||||||
|
|
||||||
|
|
||||||
|
CAMLprim value popcnt_bytecode(value i)
|
||||||
|
{
|
||||||
|
return copy_int32(__builtin_popcountll (i));
|
||||||
|
}
|
||||||
|
|
||||||
|
|
||||||
|
CAMLprim int32_t trailz(int64_t i)
|
||||||
|
{
|
||||||
|
return __builtin_ctzll (i);
|
||||||
|
}
|
||||||
|
|
||||||
|
|
||||||
|
CAMLprim value trailz_bytecode(value i)
|
||||||
|
{
|
||||||
|
return copy_int32(__builtin_ctzll (i));
|
||||||
|
}
|
||||||
|
|
||||||
|
CAMLprim int32_t leadz(int64_t i)
|
||||||
|
{
|
||||||
|
return __builtin_clzll(i);
|
||||||
|
}
|
||||||
|
|
||||||
|
|
||||||
|
CAMLprim value leadz_bytecode(value i)
|
||||||
|
{
|
||||||
|
return copy_int32(__builtin_clzll (i));
|
||||||
|
}
|
||||||
|
|
||||||
|
@ -13,6 +13,7 @@ let test_water_dz () =
|
|||||||
Simulation.ao_basis simulation_closed_shell
|
Simulation.ao_basis simulation_closed_shell
|
||||||
in
|
in
|
||||||
Alcotest.run "Unit tests" [
|
Alcotest.run "Unit tests" [
|
||||||
|
"Util", Util.test_case ();
|
||||||
"Spindeterminant", Spindeterminant.test_case ();
|
"Spindeterminant", Spindeterminant.test_case ();
|
||||||
"Determinant", Determinant.test_case ();
|
"Determinant", Determinant.test_case ();
|
||||||
"Excitation", Excitation.test_case ();
|
"Excitation", Excitation.test_case ();
|
||||||
|
Loading…
Reference in New Issue
Block a user