10
1
mirror of https://gitlab.com/scemama/QCaml.git synced 2024-11-14 10:03:39 +01:00
QCaml/gaussian/lib/atomic_shell.ml

104 lines
2.6 KiB
OCaml
Raw Normal View History

2020-10-09 09:47:57 +02:00
open Common
2018-03-20 14:11:31 +01:00
type t = {
expo : float array array;
coef : float array array;
norm_coef : float array array;
norm_coef_scale : float array;
2020-09-26 12:02:53 +02:00
contr : Contracted_shell.t array;
2019-02-26 12:47:23 +01:00
index : int;
center : Coordinate.t;
2020-09-26 12:02:53 +02:00
ang_mom : Angular_momentum.t;
2018-03-20 14:11:31 +01:00
}
2020-09-26 12:02:53 +02:00
module Am = Angular_momentum
2018-03-20 14:11:31 +01:00
module Co = Coordinate
2020-09-26 12:02:53 +02:00
module Cs = Contracted_shell
2018-03-20 14:11:31 +01:00
let make ?(index=0) contr =
assert (Array.length contr > 0);
let coef = Array.map Cs.coefficients contr
and expo = Array.map Cs.exponents contr
in
let center = Cs.center contr.(0) in
let rec unique_center = function
| 0 -> true
2019-09-10 18:39:14 +02:00
| i -> if Cs.center contr.(i) = center then (unique_center [@tailcall]) (i-1) else false
2018-03-20 14:11:31 +01:00
in
if not (unique_center (Array.length contr - 1)) then
invalid_arg "ContractedAtomicShell.make Coordinate.t differ";
2018-03-21 15:01:39 +01:00
let ang_mom = Cs.ang_mom contr.(0) in
2018-03-20 14:11:31 +01:00
let rec unique_angmom = function
| 0 -> true
2019-09-10 18:39:14 +02:00
| i -> if Cs.ang_mom contr.(i) = ang_mom then (unique_angmom [@tailcall]) (i-1) else false
2018-03-20 14:11:31 +01:00
in
if not (unique_angmom (Array.length contr - 1)) then
2020-09-26 12:02:53 +02:00
invalid_arg "Contracted_shell.make: Angular_momentum.t differ";
2018-03-20 14:11:31 +01:00
let norm_coef =
Array.map Cs.normalizations contr
in
let norm_coef_scale = Cs.norm_scales contr.(0)
in
2018-03-21 15:01:39 +01:00
{ index ; expo ; coef ; center ; ang_mom ; norm_coef ;
2018-03-20 14:11:31 +01:00
norm_coef_scale ; contr }
let with_index a i =
{ a with index = i }
let exponents x = x.expo
let coefficients x = x.coef
let center x = x.center
2018-03-21 15:01:39 +01:00
let ang_mom x = x.ang_mom
2018-03-20 14:11:31 +01:00
let size x = Array.length x.contr
let normalizations x = x.norm_coef
let norm_scales x = x.norm_coef_scale
let index x = x.index
let size_of_shell x = Array.length x.norm_coef_scale
let contracted_shells x = x.contr
(** {2 Printers} *)
open Format
2020-09-26 12:02:53 +02:00
(*
2018-03-20 14:11:31 +01:00
let pp_debug ppf x =
fprintf ppf "@[<2>{@ ";
fprintf ppf "@[<2>expo =@ %a ;@]@ " pp_float_2darray_size x.expo;
fprintf ppf "@[<2>coef =@ %a ;@]@ " pp_float_2darray_size x.coef;
fprintf ppf "@[<2>center =@ %a ;@]@ " Co.pp_angstrom x.center;
2018-03-21 15:01:39 +01:00
fprintf ppf "@[<2>ang_mom =@ %a ;@]@ " Am.pp_string x.ang_mom;
2018-03-20 14:11:31 +01:00
fprintf ppf "@[<2>norm_coef =@ %a ;@]@ " pp_float_2darray_size x.norm_coef;
fprintf ppf "@[<2>norm_coef_scale =@ %a ;@]@ " pp_float_array_size x.norm_coef_scale;
fprintf ppf "@[<2>index =@ %d ;@]@ " x.index;
fprintf ppf "}@,@]"
2020-09-26 12:02:53 +02:00
*)
2018-03-20 14:11:31 +01:00
let pp ppf s =
2018-03-20 15:16:24 +01:00
fprintf ppf "@[%3d-%-3d@]" (s.index+1) (s.index+ (size_of_shell s)*(size s));
2018-03-21 15:01:39 +01:00
fprintf ppf "@[%a@ %a@] @[" Am.pp_string s.ang_mom Co.pp s.center;
2018-03-20 15:16:24 +01:00
Array.iter2 (fun e_arr c_arr -> fprintf ppf "@[<v>";
2018-03-20 14:11:31 +01:00
Array.iter2 (fun e c -> fprintf ppf "@[%16.8e %16.8e@]@;" e c)
e_arr c_arr;
2018-03-20 15:16:24 +01:00
fprintf ppf "@;@]") s.expo s.coef;
2018-03-20 14:11:31 +01:00
fprintf ppf "@]"