mirror of
https://gitlab.com/scemama/QCaml.git
synced 2024-08-28 23:42:00 +02:00
Fixed overflow in Boys function
This commit is contained in:
parent
8e4173bc6e
commit
e4a3e1da97
40
Basis/ERI.ml
40
Basis/ERI.ml
@ -38,6 +38,10 @@ let cutoff = integrals_cutoff
|
|||||||
*)
|
*)
|
||||||
|
|
||||||
let zero_m ~maxm ~expo_pq_inv ~norm_pq_sq =
|
let zero_m ~maxm ~expo_pq_inv ~norm_pq_sq =
|
||||||
|
assert (expo_pq_inv <> 0.);
|
||||||
|
let norm_pq_sq =
|
||||||
|
if norm_pq_sq > integrals_cutoff then norm_pq_sq else 0.
|
||||||
|
in
|
||||||
let exp_pq = 1. /. expo_pq_inv in
|
let exp_pq = 1. /. expo_pq_inv in
|
||||||
let t = norm_pq_sq *. exp_pq in
|
let t = norm_pq_sq *. exp_pq in
|
||||||
let f = two_over_sq_pi *. (sqrt exp_pq) in
|
let f = two_over_sq_pi *. (sqrt exp_pq) in
|
||||||
@ -124,7 +128,7 @@ let store_class ?(cutoff=integrals_cutoff) data contracted_shell_pair_couple cls
|
|||||||
let xl = to_powers powers_l in
|
let xl = to_powers powers_l in
|
||||||
let key = Zkey.of_powers_twelve xi xj xk xl in
|
let key = Zkey.of_powers_twelve xi xj xk xl in
|
||||||
let value = Zmap.find cls key in
|
let value = Zmap.find cls key in
|
||||||
set_chem data i_c j_c k_c l_c value;
|
set_chem data i_c j_c k_c l_c value
|
||||||
) (Cs.zkey_array (Csp.shell_b shell_q))
|
) (Cs.zkey_array (Csp.shell_b shell_q))
|
||||||
) (Cs.zkey_array (Csp.shell_a shell_q))
|
) (Cs.zkey_array (Csp.shell_a shell_q))
|
||||||
) (Cs.zkey_array (Csp.shell_b shell_p))
|
) (Cs.zkey_array (Csp.shell_b shell_p))
|
||||||
@ -135,7 +139,7 @@ let store_class ?(cutoff=integrals_cutoff) data contracted_shell_pair_couple cls
|
|||||||
|
|
||||||
|
|
||||||
|
|
||||||
let of_basis_serial basis =
|
let of_basis basis =
|
||||||
|
|
||||||
let n = Bs.size basis
|
let n = Bs.size basis
|
||||||
and shell = Bs.contracted_shells basis
|
and shell = Bs.contracted_shells basis
|
||||||
@ -188,7 +192,10 @@ let of_basis_serial basis =
|
|||||||
in
|
in
|
||||||
|
|
||||||
match cspc with
|
match cspc with
|
||||||
| Some cspc -> let cls = class_of_contracted_shell_pair_couple cspc in
|
| Some cspc ->
|
||||||
|
let cls =
|
||||||
|
class_of_contracted_shell_pair_couple cspc
|
||||||
|
in
|
||||||
store_class ~cutoff eri_array cspc cls
|
store_class ~cutoff eri_array cspc cls
|
||||||
| None -> ()
|
| None -> ()
|
||||||
) shell_pairs
|
) shell_pairs
|
||||||
@ -199,7 +206,7 @@ let of_basis_serial basis =
|
|||||||
|
|
||||||
|
|
||||||
|
|
||||||
|
(*
|
||||||
let of_basis_parallel basis =
|
let of_basis_parallel basis =
|
||||||
|
|
||||||
let store_class ?(cutoff=integrals_cutoff) push_socket contracted_shell_pair_couple cls =
|
let store_class ?(cutoff=integrals_cutoff) push_socket contracted_shell_pair_couple cls =
|
||||||
@ -256,7 +263,7 @@ let of_basis_parallel basis =
|
|||||||
|> filter_contracted_shell_pairs ~cutoff
|
|> filter_contracted_shell_pairs ~cutoff
|
||||||
in
|
in
|
||||||
|
|
||||||
Printf.printf "%d significant shell pairs computed in %f seconds\n"
|
Printf.printf "%d significant shell pairs computed in %f seconds\n%!"
|
||||||
(List.length shell_pairs) (Unix.gettimeofday () -. t0);
|
(List.length shell_pairs) (Unix.gettimeofday () -. t0);
|
||||||
|
|
||||||
|
|
||||||
@ -265,20 +272,29 @@ let of_basis_parallel basis =
|
|||||||
|
|
||||||
|
|
||||||
|
|
||||||
let zmq_addr = Printf.sprintf "ipc://%d" (Unix.getpid ()) in
|
let zmq_port = 12345 in
|
||||||
let () =
|
begin
|
||||||
|
match Unix.fork () with
|
||||||
|
| 0 -> Printf.printf "pouet\n%!"
|
||||||
|
| pid -> Printf.printf "coucou\n%!"
|
||||||
|
end;
|
||||||
|
begin
|
||||||
|
|
||||||
match Unix.fork () with
|
match Unix.fork () with
|
||||||
| 0 -> begin
|
| 0 -> begin
|
||||||
|
let zmq_addr = Printf.sprintf "tcp://localhost:%d" zmq_port in
|
||||||
let zmq = ref None in
|
let zmq = ref None in
|
||||||
|
Printf.printf "PID %d OK\n%!" 0;
|
||||||
|
|
||||||
Parmap.pariter ~chunksize:1
|
Parmap.pariter ~chunksize:1
|
||||||
~init:(fun _ ->
|
~init:(fun rank ->
|
||||||
let zmq_context =
|
let zmq_context =
|
||||||
Zmq.Context.create ()
|
Zmq.Context.create ()
|
||||||
in
|
in
|
||||||
let push_socket =
|
let push_socket =
|
||||||
Zmq.Socket.create zmq_context Zmq.Socket.push
|
Zmq.Socket.create zmq_context Zmq.Socket.push
|
||||||
in
|
in
|
||||||
|
Printf.printf "Init %d OK\n%!" rank;
|
||||||
Zmq.Socket.connect push_socket zmq_addr;
|
Zmq.Socket.connect push_socket zmq_addr;
|
||||||
zmq := Some (zmq_context, push_socket)
|
zmq := Some (zmq_context, push_socket)
|
||||||
)
|
)
|
||||||
@ -341,6 +357,8 @@ let of_basis_parallel basis =
|
|||||||
end
|
end
|
||||||
|
|
||||||
| pid -> begin
|
| pid -> begin
|
||||||
|
Printf.printf "PID %d OK\n%!" pid;
|
||||||
|
let zmq_addr = Printf.sprintf "tcp://*:%d" zmq_port in
|
||||||
let zmq_context =
|
let zmq_context =
|
||||||
Zmq.Context.create ()
|
Zmq.Context.create ()
|
||||||
in
|
in
|
||||||
@ -364,10 +382,8 @@ let of_basis_parallel basis =
|
|||||||
Zmq.Context.terminate zmq_context;
|
Zmq.Context.terminate zmq_context;
|
||||||
ignore (Unix.wait ())
|
ignore (Unix.wait ())
|
||||||
end
|
end
|
||||||
in
|
end;
|
||||||
Printf.printf "Computed ERIs in %f seconds\n%!" (Unix.gettimeofday () -. t0);
|
Printf.printf "Computed ERIs in %f seconds\n%!" (Unix.gettimeofday () -. t0);
|
||||||
eri_array
|
eri_array
|
||||||
|
*)
|
||||||
|
|
||||||
|
|
||||||
|
|
||||||
let of_basis = of_basis_parallel
|
|
||||||
|
@ -631,7 +631,8 @@ let contracted_class_shell_pairs ~zero_m ?schwartz_p ?schwartz_q shell_p shell_q
|
|||||||
in
|
in
|
||||||
zero_m_array.(0)
|
zero_m_array.(0)
|
||||||
with NullQuartet -> 0.
|
with NullQuartet -> 0.
|
||||||
) in
|
)
|
||||||
|
in
|
||||||
Mat.gemm_trace zm_array coef
|
Mat.gemm_trace zm_array coef
|
||||||
with (Invalid_argument _) -> 0.
|
with (Invalid_argument _) -> 0.
|
||||||
end
|
end
|
||||||
|
@ -21,15 +21,6 @@ export LACAML_LIBS="-L${MKLROOT}/lib/intel64 -Wl,--no-as-needed -lmkl_rt -lpthr
|
|||||||
opam install lacaml
|
opam install lacaml
|
||||||
```
|
```
|
||||||
|
|
||||||
# Parmap
|
|
||||||
|
|
||||||
Multicore library.
|
|
||||||
|
|
||||||
```bash
|
|
||||||
opam install parmap
|
|
||||||
```
|
|
||||||
|
|
||||||
|
|
||||||
# odoc-ltxhtml
|
# odoc-ltxhtml
|
||||||
|
|
||||||
This plugin allows to embed equations in the documentation generated by Ocamldoc.
|
This plugin allows to embed equations in the documentation generated by Ocamldoc.
|
||||||
|
12
SCF/Fock.ml
12
SCF/Fock.ml
@ -1,6 +1,7 @@
|
|||||||
open Lacaml.D
|
open Lacaml.D
|
||||||
open Simulation
|
open Simulation
|
||||||
open Constants
|
open Constants
|
||||||
|
open Util
|
||||||
|
|
||||||
|
|
||||||
type t =
|
type t =
|
||||||
@ -61,6 +62,15 @@ let make ~density ao_basis =
|
|||||||
let m_J = Mat.of_array m_J
|
let m_J = Mat.of_array m_J
|
||||||
and m_K = Mat.of_array m_K
|
and m_K = Mat.of_array m_K
|
||||||
in
|
in
|
||||||
{ fock = Mat.add m_Hc @@ Mat.add m_J m_K ;
|
{ fock = Mat.add m_Hc (Mat.add m_J m_K) ;
|
||||||
core = m_Hc ; coulomb = m_J ; exchange = m_K }
|
core = m_Hc ; coulomb = m_J ; exchange = m_K }
|
||||||
|
|
||||||
|
|
||||||
|
let pp_fock ppf a =
|
||||||
|
Format.fprintf ppf "@[<2>";
|
||||||
|
Format.fprintf ppf "@[ Fock matrix:@[<2>@[%a@]@.]@]" pp_matrix a.fock;
|
||||||
|
Format.fprintf ppf "@[ Core Hamiltonian:@[<2>@[%a@]@.]@]" pp_matrix a.core;
|
||||||
|
Format.fprintf ppf "@[ Coulomb matrix:@[<2>@[%a@]@.]@]" pp_matrix a.coulomb;
|
||||||
|
Format.fprintf ppf "@[ Exchange matrix:@[<2>@[%a@]@.]@]" pp_matrix a.exchange;
|
||||||
|
Format.fprintf ppf "@]"
|
||||||
|
|
||||||
|
@ -33,7 +33,9 @@ let huckel_guess ao_basis =
|
|||||||
function
|
function
|
||||||
| 0 -> invalid_arg "Huckel guess needs a non-zero number of occupied MOs."
|
| 0 -> invalid_arg "Huckel guess needs a non-zero number of occupied MOs."
|
||||||
| nocc ->
|
| nocc ->
|
||||||
let m_F = (Fock.make ~density:(gemm ~alpha:2. ~transb:`T ~k:nocc m_X m_X) ao_basis).Fock.fock in
|
let density = gemm ~alpha:2. ~transb:`T ~k:nocc m_X m_X in
|
||||||
|
let fock = Fock.make ~density ao_basis in
|
||||||
|
let m_F = fock.Fock.fock in
|
||||||
for j=1 to ao_num do
|
for j=1 to ao_num do
|
||||||
for i=1 to ao_num do
|
for i=1 to ao_num do
|
||||||
if (i <> j) then
|
if (i <> j) then
|
||||||
|
@ -19,7 +19,7 @@ with a Langrange multiplier {% $\lambda$ %}.
|
|||||||
{%
|
{%
|
||||||
\begin{align*}
|
\begin{align*}
|
||||||
\mathcal{L} & = ||\sum_i c_i \mathbf{e}_i||^2 - \lambda \left(\sum_i c_i - 1\right) \\
|
\mathcal{L} & = ||\sum_i c_i \mathbf{e}_i||^2 - \lambda \left(\sum_i c_i - 1\right) \\
|
||||||
& = \sum_{ij} c_i c_j B_{ij} - \lambda \left(\sum_i c_i - 1\right)
|
& = \sum_{ij} c_i c_j B_{ij} - \lambda \left(\sum_{i=1}^m c_i - 1\right)
|
||||||
\end{align*}
|
\end{align*}
|
||||||
%}
|
%}
|
||||||
with
|
with
|
||||||
|
@ -104,11 +104,21 @@ let increment_four_index ~r1 ~r2 ~value t =
|
|||||||
in
|
in
|
||||||
Hashtbl.replace a key (old_value +. value)
|
Hashtbl.replace a key (old_value +. value)
|
||||||
|
|
||||||
let get ~r1 ~r2 =
|
let get ~r1 ~r2 a =
|
||||||
get_four_index ~r1 ~r2
|
get_four_index ~r1 ~r2 a
|
||||||
|
|
||||||
let set ~r1 ~r2 =
|
let set ~r1 ~r2 ~value =
|
||||||
set_four_index ~r1 ~r2
|
match classify_float value with
|
||||||
|
| FP_normal -> set_four_index ~r1 ~r2 ~value
|
||||||
|
| FP_zero
|
||||||
|
| FP_subnormal -> fun _ -> ()
|
||||||
|
| FP_infinite
|
||||||
|
| FP_nan ->
|
||||||
|
let msg =
|
||||||
|
Printf.sprintf "FourIdxStorage.ml : set : r1 = (%d,%d) ; r2 = (%d,%d)"
|
||||||
|
r1.first r1.second r2.first r2.second
|
||||||
|
in
|
||||||
|
raise (Invalid_argument msg)
|
||||||
|
|
||||||
let increment ~r1 ~r2 =
|
let increment ~r1 ~r2 =
|
||||||
increment_four_index ~r1 ~r2
|
increment_four_index ~r1 ~r2
|
||||||
|
@ -133,6 +133,9 @@ let boys_function ~maxm t =
|
|||||||
let result =
|
let result =
|
||||||
Array.init (maxm+1) (fun m -> 1. /. float_of_int (2*m+1))
|
Array.init (maxm+1) (fun m -> 1. /. float_of_int (2*m+1))
|
||||||
in
|
in
|
||||||
|
(*
|
||||||
|
assert (abs_float t > 1.e-10);
|
||||||
|
*)
|
||||||
if t <> 0. then
|
if t <> 0. then
|
||||||
begin
|
begin
|
||||||
let fmax =
|
let fmax =
|
||||||
@ -140,7 +143,12 @@ let boys_function ~maxm t =
|
|||||||
let n = float_of_int maxm in
|
let n = float_of_int maxm in
|
||||||
let dm = 0.5 +. n in
|
let dm = 0.5 +. n in
|
||||||
let f = (pow t_inv (maxm+maxm+1) ) in
|
let f = (pow t_inv (maxm+maxm+1) ) in
|
||||||
|
match classify_float f with
|
||||||
|
| FP_zero
|
||||||
|
| FP_subnormal
|
||||||
|
| FP_normal ->
|
||||||
(incomplete_gamma dm t) *. 0.5 *. f
|
(incomplete_gamma dm t) *. 0.5 *. f
|
||||||
|
| _ -> invalid_arg "zero_m overflow"
|
||||||
in
|
in
|
||||||
let emt = exp (-. t) in
|
let emt = exp (-. t) in
|
||||||
result.(maxm) <- fmax;
|
result.(maxm) <- fmax;
|
||||||
@ -199,34 +207,6 @@ let canonical_ortho ?thresh:(thresh=1.e-6) ~overlap c =
|
|||||||
gemm c u
|
gemm c u
|
||||||
|
|
||||||
|
|
||||||
let string_of_matrix m =
|
|
||||||
let open Lacaml.Io in
|
|
||||||
let rows = Mat.dim1 m
|
|
||||||
and cols = Mat.dim2 m
|
|
||||||
in
|
|
||||||
let rec aux accu first last =
|
|
||||||
|
|
||||||
if (first > last) then String.concat "\n" (List.rev accu)
|
|
||||||
else
|
|
||||||
let nw =
|
|
||||||
Format.asprintf "\n\n %a\n" (Lacaml.Io.pp_lfmat
|
|
||||||
~row_labels:
|
|
||||||
(Array.init rows (fun i -> Printf.sprintf "%d " (i + 1)))
|
|
||||||
~col_labels:
|
|
||||||
(Array.init (min 5 (cols-first+1)) (fun i -> Printf.sprintf "-- %d --" (i + first) ))
|
|
||||||
~print_right:false
|
|
||||||
~print_foot:false
|
|
||||||
() ) (lacpy ~ac:first ~n:(min 5 (cols-first+1)) m)
|
|
||||||
in
|
|
||||||
aux (nw :: accu) (first+5) last
|
|
||||||
in
|
|
||||||
aux [] 1 cols
|
|
||||||
|
|
||||||
|
|
||||||
let debug_matrix name a =
|
|
||||||
Printf.printf "%s =\n%s\n" name (string_of_matrix a)
|
|
||||||
|
|
||||||
|
|
||||||
|
|
||||||
(** {2 Printers} *)
|
(** {2 Printers} *)
|
||||||
|
|
||||||
@ -250,3 +230,33 @@ let pp_float_2darray_size ppf a =
|
|||||||
Array.iter (fun f -> Format.fprintf ppf "@[%a@]@ " pp_float_array_size f) a;
|
Array.iter (fun f -> Format.fprintf ppf "@[%a@]@ " pp_float_array_size f) a;
|
||||||
Format.fprintf ppf "]@]@]"
|
Format.fprintf ppf "]@]@]"
|
||||||
|
|
||||||
|
let pp_matrix ppf m =
|
||||||
|
let open Lacaml.Io in
|
||||||
|
let rows = Mat.dim1 m
|
||||||
|
and cols = Mat.dim2 m
|
||||||
|
in
|
||||||
|
let rec aux first last =
|
||||||
|
if (first <= last) then begin
|
||||||
|
Format.fprintf ppf "@[\n\n %a@]@ " (Lacaml.Io.pp_lfmat
|
||||||
|
~row_labels:
|
||||||
|
(Array.init rows (fun i -> Printf.sprintf "%d " (i + 1)))
|
||||||
|
~col_labels:
|
||||||
|
(Array.init (min 5 (cols-first+1)) (fun i -> Printf.sprintf "-- %d --" (i + first) ))
|
||||||
|
~print_right:false
|
||||||
|
~print_foot:false
|
||||||
|
() ) (lacpy ~ac:first ~n:(min 5 (cols-first+1)) m);
|
||||||
|
aux (first+5) last
|
||||||
|
end
|
||||||
|
in
|
||||||
|
aux 1 cols
|
||||||
|
|
||||||
|
|
||||||
|
|
||||||
|
|
||||||
|
let string_of_matrix m =
|
||||||
|
Format.asprintf "%a" pp_matrix m
|
||||||
|
|
||||||
|
let debug_matrix name a =
|
||||||
|
Format.printf "@[%s =\n@[%a@]@]@ " name pp_matrix a
|
||||||
|
|
||||||
|
|
||||||
|
@ -122,3 +122,5 @@ val pp_float_2darray : Format.formatter -> float array array -> unit
|
|||||||
]}
|
]}
|
||||||
*)
|
*)
|
||||||
|
|
||||||
|
val pp_matrix : Format.formatter -> Lacaml.D.mat -> unit
|
||||||
|
|
||||||
|
2
_tags
2
_tags
@ -1,4 +1,4 @@
|
|||||||
true: package(str,unix,bigarray,lacaml,parmap,zmq)
|
true: package(str,unix,bigarray,lacaml)
|
||||||
<*.byte> : linkdep(Utils/math_functions.o), custom
|
<*.byte> : linkdep(Utils/math_functions.o), custom
|
||||||
<*.native>: linkdep(Utils/math_functions.o)
|
<*.native>: linkdep(Utils/math_functions.o)
|
||||||
<odoc-ltxhtml>: not_hygienic
|
<odoc-ltxhtml>: not_hygienic
|
||||||
|
Loading…
Reference in New Issue
Block a user