LCPQ
/
QCaml
mirror of https://gitlab.com/scemama/QCaml.git
10
1
Fork 0
Code Releases Activity

Introduced infix operators for Vector and Matrices

This commit is contained in:
Anthony Scemama 2020-10-17 19:02:37 +02:00
parent 31f4270b35
commit 16adf48234
18 changed files with 637 additions and 34 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

8
gaussian_integrals/lib/electron_nucleus.ml
View File

@ -51,7 +51,6 @@ let of_basis_nuclei ~basis nuclei =
in
let eni_array = Matrix.create n n in
let eni_array_x = Matrix.to_bigarray_inplace eni_array in
(* Pre-compute all shell pairs *)
let shell_pairs =
@ -83,8 +82,8 @@ let of_basis_nuclei ~basis nuclei =
let value =
Zmap.find cls key
in
eni_array_x.{j_c,i_c} <- value;
eni_array_x.{i_c,j_c} <- value;
Matrix.set eni_array j_c i_c value;
Matrix.set eni_array i_c j_c value;
) (Am.zkey_array (Singlet (Cs.ang_mom shell.(j))))
) (Am.zkey_array (Singlet (Cs.ang_mom shell.(i))))
done;
@ -96,11 +95,10 @@ let of_basis_nuclei ~basis nuclei =
let to_file ~filename eni_array =
let n = Matrix.dim1 eni_array in
let oc = open_out filename in
let eni_array_x = Matrix.to_bigarray_inplace eni_array in
for j=1 to n do
for i=1 to j do
let value = eni_array_x.{i,j} in
let value = eni_array%:(i,j) in
if (value <> 0.) then
Printf.fprintf oc " %5d %5d %20.15f\n" i j value;
done;

10
gaussian_integrals/lib/kinetic.ml
View File

@ -134,7 +134,6 @@ let of_basis basis =
in
let result = Matrix.create n n in
let result_x = Matrix.to_bigarray_inplace result in
for j=0 to (Array.length shell) - 1 do
for i=0 to j do
(* Compute all the integrals of the class *)
@ -155,8 +154,8 @@ let of_basis basis =
try Zmap.find cls key
with Not_found -> 0.
in
result_x.{i_c,j_c} <- value;
result_x.{j_c,i_c} <- value;
Matrix.set result i_c j_c value;
Matrix.set result j_c i_c value;
) (Am.zkey_array (Singlet (Cs.ang_mom shell.(i))))
) (Am.zkey_array (Singlet (Cs.ang_mom shell.(j))))
done;
@ -175,11 +174,10 @@ let to_file ~filename kinetic =
Matrix.dim1 kinetic
in
let kinetic_x = Matrix.to_bigarray_inplace kinetic in
for j=1 to n do
for i=1 to j do
if (abs_float kinetic_x.{i,j} > cutoff) then
Printf.fprintf oc "%4d %4d %20.12e\n" i j kinetic_x.{i,j}
if (abs_float (kinetic%:(i,j)) > cutoff) then
Printf.fprintf oc "%4d %4d %20.12e\n" i j (kinetic%:(i,j))
done;
done;
close_out oc

3
gaussian_integrals/lib/orthonormalization.ml
View File

@ -50,7 +50,6 @@ let make_lowdin ~thresh ~overlap =
let u_vec, u_val =
Matrix.diagonalize_symm overlap
in
let u_vec_x = Matrix.to_bigarray_inplace u_vec in
Vector.iter (fun x -> if x < thresh then
invalid_arg (__FILE__^": make_lowdin") ) u_val;
@ -59,7 +58,7 @@ let make_lowdin ~thresh ~overlap =
let u_vec' =
Matrix.init_cols (Matrix.dim1 u_vec) (Matrix.dim2 u_vec)
(fun i j -> u_vec_x.{i,j} *. (Vector.at u_val j))
(fun i j -> u_vec%:(i,j) *. (u_val%.(j)) )
in
Matrix.gemm_nt u_vec' u_vec

13
gaussian_integrals/lib/overlap.ml
View File

@ -99,7 +99,6 @@ let of_basis basis =
in
let result = Matrix.create n n in
let result_x = Matrix.to_bigarray_inplace result in
for j=0 to (Array.length shell) - 1 do
for i=0 to j do
(* Compute all the integrals of the class *)
@ -120,8 +119,8 @@ let of_basis basis =
try Zmap.find cls key
with Not_found -> 0.
in
result_x.{i_c,j_c} <- value;
result_x.{j_c,i_c} <- value;
Matrix.set result i_c j_c value;
Matrix.set result j_c i_c value;
) (Am.zkey_array (Singlet (Cs.ang_mom shell.(i))))
) (Am.zkey_array (Singlet (Cs.ang_mom shell.(j))))
done;
@ -146,7 +145,6 @@ let of_basis_pair first_basis second_basis =
in
let result = Matrix.create n m in
let result_x = Matrix.to_bigarray_inplace result in
for j=0 to (Array.length second) - 1 do
for i=0 to (Array.length first) - 1 do
(* Compute all the integrals of the class *)
@ -167,7 +165,7 @@ let of_basis_pair first_basis second_basis =
try Zmap.find cls key
with Not_found -> 0.
in
result_x.{i_c,j_c} <- value;
Matrix.set result i_c j_c value;
) (Am.zkey_array (Singlet (Cs.ang_mom first.(i))))
) (Am.zkey_array (Singlet (Cs.ang_mom second.(j))))
done;
@ -184,11 +182,10 @@ let to_file ~filename overlap =
Matrix.dim1 overlap
in
let overlap_x = Matrix.to_bigarray_inplace overlap in
for j=1 to n do
for i=1 to j do
if (abs_float overlap_x.{i,j} > cutoff) then
Printf.fprintf oc "%4d %4d %20.12e\n" i j overlap_x.{i,j}
if (abs_float (overlap%:(i,j)) > cutoff) then
Printf.fprintf oc "%4d %4d %20.12e\n" i j (overlap%:(i,j))
done;
done;
close_out oc

4
gaussian_integrals/lib/two_electron_rr_vectorized.ml
View File

@ -638,8 +638,8 @@ let contracted_class_shell_pairs ?operator ~zero_m ?schwartz_p ?schwartz_q shell
raise NullQuartet;
let expo_p_inv, expo_q_inv =
(Vector.at expo_p_inv i),
(Vector.at expo_q_inv j)
(expo_p_inv%.(i)),
(expo_q_inv%.(j))
in
let center_pq =

6
linear_algebra/lib/conventions.ml
View File

@ -5,18 +5,20 @@
*)
open Vector
let in_phase vec =
let s = Vector.sum vec in
if s = 0. then
let rec first_non_zero k =
if k > Vector.dim vec then
k-1
else if Vector.at vec k = 0. then
else if vec%.(k) = 0. then
first_non_zero (k+1)
else k
in
let k = first_non_zero 1 in
Vector.at vec k >= 0.
vec%.(k) >= 0.
else
s > 0.

45
linear_algebra/lib/matrix.ml
View File

@ -41,8 +41,6 @@ let add_const_inplace x a =
let add_const x a =
Mat.add_const x a
let at t i j = t.{i,j}
external to_bigarray_inplace : ('a,'b) t -> (float, Stdlib.Bigarray.float64_elt, Stdlib.Bigarray.fortran_layout) Stdlib.Bigarray.Array2.t = "%identity"
external of_bigarray_inplace : (float, Stdlib.Bigarray.float64_elt, Stdlib.Bigarray.fortran_layout) Stdlib.Bigarray.Array2.t -> ('a,'b) t = "%identity"
@ -108,6 +106,43 @@ let scale_inplace x t =
let scale x t =
out_of_place (fun t -> scale_inplace x t) t
let of_diag v =
Vector.to_bigarray_inplace v
|> Mat.of_diag
let diag t =
Mat.copy_diag t
|> Vector.of_bigarray_inplace
let gemv_n_inplace ?m ?n ?(beta=0.) y ?(alpha=1.) ?(ar=1) ?(ac=1) t v =
let y = Vector.to_bigarray_inplace y in
let v = Vector.to_bigarray_inplace v in
ignore @@ gemv ?m ?n ~beta ~trans:`N ~y ~alpha ~ar ~ac t v
let gemv_t_inplace ?m ?n ?(beta=0.) y ?(alpha=1.) ?(ar=1) ?(ac=1) t v =
let y = Vector.to_bigarray_inplace y in
let v = Vector.to_bigarray_inplace v in
ignore @@ gemv ?m ?n ~beta ~trans:`T ~y ~alpha ~ar ~ac t v
let gemv_n ?m ?n ?(beta=0.) ?y ?(alpha=1.) ?(ar=1) ?(ac=1) t v =
let v = Vector.to_bigarray_inplace v in
let y =
match y with
| None -> None
| Some y -> Some (Vector.to_bigarray_inplace y)
in
gemv ?m ?n ~beta ?y ~trans:`N ~alpha ~ar ~ac t v
|> Vector.of_bigarray_inplace
let gemv_t ?m ?n ?(beta=0.) ?y ?(alpha=1.) ?(ar=1) ?(ac=1) t v =
let v = Vector.to_bigarray_inplace v in
let y =
match y with
| None -> None
| Some y -> Some (Vector.to_bigarray_inplace y)
in
gemv ?m ?n ~beta ?y ~trans:`T ~alpha ~ar ~ac t v
|> Vector.of_bigarray_inplace
let gemm_inplace ?m ?n ?k ?(beta=0.) ~c ?(transa=`N) ?(alpha=1.0) a ?(transb=`N) b =
ignore @@ gemm ?m ?n ?k ~beta ~c ~transa ~alpha a ~transb b
@ -312,3 +347,9 @@ let qr a =
orgqr ~tau result;
let q = result in
q, r
let (%:) t (i,j) = t.{i,j}
let set t i j v = t.{i,j} <- v

48
linear_algebra/lib/matrix.mli
View File

@ -26,6 +26,12 @@ val init_cols : int -> int -> (int -> int -> float) -> ('a,'b) t
val identity: int -> ('a,'b) t
(** Creates an identity matrix. *)
val of_diag: 'a Vector.t -> ('a,'a) t
(** Creates a diagonal matrix. *)
val diag: ('a,'a) t -> 'a Vector.t
(** Returns the diagonal of a matrix. *)
val fill_inplace: ('a,'b) t -> float -> unit
(** Fills the matrix with the give value. *)
@ -65,9 +71,6 @@ val mul_inplace : c:('a,'b) t -> ('a,'b) t -> ('a,'b) t -> unit
val div_inplace : c:('a,'b) t -> ('a,'b) t -> ('a,'b) t -> unit
(** [div_inplace c a b] : performs [c = a/b] element-wise in-place. *)
val at : ('a,'b) t -> int -> int -> float
(** [at i j] returns the element at i,j. *)
(*
val to_bigarray : ('a,'b) t -> (float, Stdlib.Bigarray.float64_elt, Stdlib.Bigarray.fortran_layout) Stdlib.Bigarray.Array2.t
(** Converts the matrix into a Bigarray in Fortran layout *)
@ -156,6 +159,39 @@ val outer_product_inplace : ('a,'b) t -> ?alpha:float -> 'a Vector.t -> 'b Vecto
(** Computes M = %{ $\alpha u.v^t$ %} *)
val gemv_n_inplace : ?m:int -> ?n:int -> ?beta:float -> 'a Vector.t ->
?alpha:float -> ?ar:int -> ?ac:int -> ('a,'b) t -> 'b Vector.t ->
unit
(** Performs the Lapack GEMV operation. Default values:
[beta=0.] [alpha=1.0].
[gemv ~beta y ~alpha m v]: %{ $Y = \beta Y + \alpha M V$
The vector Y is updated in-place.
*)
val gemv_t_inplace : ?m:int -> ?n:int -> ?beta:float -> 'b Vector.t ->
?alpha:float -> ?ar:int -> ?ac:int -> ('a,'b) t -> 'a Vector.t ->
unit
(** Performs the Lapack GEMV operation. Default values:
[beta=0.] [alpha=1.0].
[gemv ~beta y ~alpha m v]: %{ $Y = \beta Y + \alpha M^\dagger V$
The vector Y is updated in-place.
*)
val gemv_n : ?m:int -> ?n:int -> ?beta:float -> ?y:'a Vector.t ->
?alpha:float -> ?ar:int -> ?ac:int -> ('a,'b) t -> 'b Vector.t ->
'a Vector.t
(** Performs the Lapack GEMV operation. Default values:
[beta=0.] [alpha=1.0].
[gemv ~beta y ~alpha m v]: %{ $Y = \beta Y + \alpha M^\dagger V$ *)
val gemv_t : ?m:int -> ?n:int -> ?beta:float -> ?y:'b Vector.t ->
?alpha:float -> ?ar:int -> ?ac:int -> ('a,'b) t -> 'a Vector.t ->
'b Vector.t
(** Performs the Lapack GEMV operation. Default values:
[beta=0.] [alpha=1.0].
[gemv ~beta y ~alpha m v]: %{ $Y = \beta Y + \alpha M^\dagger V$
*)
val gemm_inplace : ?m:int -> ?n:int -> ?k:int -> ?beta:float ->
c:('a,'b) t -> ?transa:[`N | `T] -> ?alpha:float ->
('c,'d) t -> ?transb:[`N | `T] -> ('e,'f) t -> unit
@ -265,5 +301,11 @@ val sysv_inplace : b:('a,'b) t -> ('a,'a) t -> unit
val sysv : b:('a,'b) t -> ('a,'a) t -> ('a,'b) t
(** Solves %{ $AX=B$ %} when A is symmetric *)
val (%:) : ('a,'b) t -> (int*int) -> float
(** [t%.(i,j)] returns the element at i,j. *)
val set : ('a,'b) t -> int -> int -> float -> unit
(** [set t i j v] sets the (i,j)-th element to v *)
val pp : Format.formatter -> ('a,'b) t -> unit

3
linear_algebra/lib/vector.ml
View File

@ -65,5 +65,6 @@ let normalize v =
result
let at t i = t.{i}
let (%.) t i = t.{i}
let set t i v = t.{i} <- v

11
linear_algebra/lib/vector.mli
View File

@ -76,9 +76,6 @@ val init : int -> (int -> float) -> 'a t
val sum : 'a t -> float
(** Returns the sum of the elements of the vector *)
val at : 'a t -> int -> float
(** Returns t.{i} *)
val copy : ?n:int -> ?ofsy:int -> ?incy:int -> ?y:vec -> ?ofsx:int -> ?incx:int -> 'a t -> 'a t
(** Returns a copy of the vector X into Y. [ofs] controls the offset and [inc]
the increment. *)
@ -134,3 +131,11 @@ val of_bigarray_inplace : (float, Stdlib.Bigarray.float64_elt, Stdlib.Bigarray.f
val to_bigarray_inplace : 'a t -> (float, Stdlib.Bigarray.float64_elt, Stdlib.Bigarray.fortran_layout) Stdlib.Bigarray.Array1.t
(** Converts the vector into a Fortran bigarray *)
val (%.) : 'a t -> int -> float
(** [t%.(i)] Returns the i-th element of the vector *)
val set : 'a t -> int -> float -> unit
(** Modifies the value in-place at the i-th position *)

201
mo/lib/basis.ml Normal file
View File

@ -0,0 +1,201 @@
open Linear_algebra
open Common.Util
open Common.Constants
(** One-electron orthogonal basis set, corresponding to Molecular Orbitals. *)
module HF = HartreeFock
module Si = Simulation
type mo_type =
| RHF | ROHF | UHF | CASSCF | Projected
| Natural of string
| Localized of string
type t =
{
simulation : Simulation.t; (* Simulation which produced the MOs *)
mo_type : mo_type; (* Kind of MOs (RHF, CASSCF, Localized...) *)
mo_occupation : t Vector.t; (* Occupation numbers *)
mo_coef : (Ao.Basis.t,t) Matrix.t; (* Matrix of the MO coefficients in the AO basis *)
eN_ints : (t,t) Matrix.t lazy_t; (* Electron-nucleus potential integrals *)
ee_ints : t Four_idx_storage.t lazy_t; (* Electron-electron potential integrals *)
kin_ints : (t,t) Matrix.t lazy_t; (* Kinetic energy integrals *)
one_e_ints : (t,t) Matrix.t lazy_t; (* One-electron integrals *)
(* TODO
f12_ints : F12.t lazy_t; (* F12 integrals *)
*)
}
let size t =
Matrix.dim2 t.mo_coef
let simulation t = t.simulation
let mo_type t = t.mo_type
let ao_basis t = Si.ao_basis t.simulation
let mo_occupation t = t.mo_occupation
let mo_coef t = t.mo_coef
let eN_ints t = Lazy.force t.eN_ints
let ee_ints t = Lazy.force t.ee_ints
let kin_ints t = Lazy.force t.kin_ints
let two_e_ints t = Lazy.force t.ee_ints
(* TODO
let f12_ints t = Lazy.force t.f12_ints
*)
let one_e_ints t = Lazy.force t.one_e_ints
let mo_energies t =
let m_C = mo_coef t in
let f =
let m_N = Matrix.of_diag @@ mo_occupation t in
let m_P = Matrix.x_o_xt m_N m_C in
match t.mo_type with
| RHF -> Fock.make_rhf ~density:m_P (ao_basis t)
| Projected
| ROHF -> (Matrix.scal 0.5 m_P;
Fock.make_uhf ~density_same:m_P ~density_other:m_P (ao_basis t))
| _ -> failwith "Not implemented"
in
let m_F0 = Fock.fock f in
Matrix.xt_o_x m_F0 m_C
|> Matrix.diag
let mo_matrix_of_ao_matrix ~mo_coef ao_matrix =
Matrix.xt_o_x ~x:mo_coef ~o:ao_matrix
let ao_matrix_of_mo_matrix ~mo_coef ~ao_overlap mo_matrix =
let sc = Matrix.gemm ao_overlap mo_coef in
Matrix.x_o_xt ~x:sc ~o:mo_matrix
let make ~simulation ~mo_type ~mo_occupation ~mo_coef () =
let ao_basis =
Si.ao_basis simulation
in
let eN_ints = lazy (
Ao.Basis.eN_ints ao_basis
|> mo_matrix_of_ao_matrix ~mo_coef
)
and kin_ints = lazy (
Ao.Basis.kin_ints ao_basis
|> mo_matrix_of_ao_matrix ~mo_coef
)
and ee_ints = lazy (
Ao.Basis.ee_ints ao_basis
|> Eri.four_index_transform mo_coef
)
(*
and f12_ints = lazy (
Ao.Basis.f12_ints ao_basis
|> F12.four_index_transform mo_coef
)
*)
in
let one_e_ints = lazy (
Matrix.add (Lazy.force eN_ints) (Lazy.force kin_ints) )
in
{ simulation ; mo_type ; mo_occupation ; mo_coef ;
eN_ints ; ee_ints ; kin_ints ; one_e_ints ;
}
let values t point =
let c = mo_coef t in
let a = Ao.Basis.values (Simulation.ao_basis t.simulation) point in
Matrix.gemv ~trans:`T c a
let of_hartree_fock hf =
let mo_coef = HF.eigenvectors hf in
let simulation = HF.simulation hf in
let mo_occupation = HF.occupation hf in
let mo_type =
match HF.kind hf with
| HartreeFock.RHF -> RHF
| HartreeFock.ROHF -> ROHF
| HartreeFock.UHF -> UHF
in
make ~simulation ~mo_type ~mo_occupation ~mo_coef ()
let of_mo_basis simulation other =
let mo_coef =
let basis = Simulation.ao_basis simulation in
let basis_other = ao_basis other in
let m_S =
Overlap.(matrix @@ of_basis_pair
(AOBasis.basis basis)
(AOBasis.basis basis_other) )
in
let m_X = AOBasis.ortho basis in
(* Project other vectors in the current basis *)
let m_C =
gemm m_S @@ mo_coef other
in
(* Append dummy vectors to the input vectors *)
let result =
let vecs = Mat.to_col_vecs m_X in
Array.iteri (fun i v -> if (i < Array.length vecs) then vecs.(i) <- v)
(Mat.to_col_vecs m_C) ;
Mat.of_col_vecs vecs
in
(* Gram-Schmidt Orthonormalization *)
gemm m_X @@ (Util.qr_ortho @@ gemm ~transa:`T m_X result)
|> Util.remove_epsilons
|> Conventions.rephase
in
let mo_occupation =
let occ = mo_occupation other in
Vec.init (Mat.dim2 mo_coef) (fun i ->
if (i <= Vec.dim occ) then occ.{i}
else 0.)
in
make ~simulation ~mo_type:Projected ~mo_occupation ~mo_coef ()
let pp ?(start=1) ?(finish=0) ppf t =
let open Lacaml.Io in
let rows = Mat.dim1 t.mo_coef
and cols = Mat.dim2 t.mo_coef
in
let finish =
match finish with
| 0 -> cols
| x -> x
in
let rec aux first =
if (first > finish) then ()
else
begin
Format.fprintf ppf "@[<v>@[<v4>@[<h>%s@;" "Eigenvalues:";
Array.iteri (fun i x ->
if (i+1 >= first) && (i+1 <= first+4 ) then
Format.fprintf ppf "%12f@ " x)
(Vec.to_array @@ mo_energies t);
Format.fprintf ppf "@]@;";
Format.fprintf ppf "@[%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)) (t.mo_coef)) ;
Format.fprintf ppf "@]@;@;@]";
(aux [@tailcall]) (first+5)
end
in
aux start

97
mo/lib/basis.mli Normal file
View File

@ -0,0 +1,97 @@
(** Data structure to represent the molecular orbitals.
The MO indices start from 1.
*)
open Linear_algebra
open Common
type mo_type =
| RHF | ROHF | UHF | CASSCF | Projected
| Natural of string
| Localized of string
type t
(** {1 Accessors} *)
val simulation : t -> Simulation.t
(** Simulation which produced the MOs *)
val mo_type : t -> mo_type
(** Kind of MOs (RHF, CASSCF, Localized...) *)
val ao_basis : t -> Ao.Basis.t
(** Matrix of the MO coefficients in the AO basis *)
val mo_occupation : t -> t Vector.t
(** Occupation numbers *)
val mo_coef : t -> (Ao.Basis.t, t) Matrix.t
(** Molecular orbitcal coefficients *)
val eN_ints : t -> (t,t) Matrix.t
(** Electron-nucleus potential integrals *)
val ee_ints : t -> t Four_idx_storage.t
(** Electron-electron repulsion integrals *)
val kin_ints : t -> (t,t) Matrix.t
(** Kinetic energy integrals *)
val one_e_ints : t -> (t,t) Matrix.t
(** One-electron integrals {% $\hat{T} + V$ %} *)
val two_e_ints : t -> t Four_idx_storage.t
(** Electron-electron repulsion integrals *)
(* TODO
val f12_ints : t -> F12.t
(** F12 integrals *)
*)
val size : t -> int
(** Number of molecular orbitals in the basis *)
val mo_energies : t -> t Vector.t
(** Fock MO energies *)
val values : t -> Coordinate.t -> t Vector.t
(** Values of the MOs evaluated at a given coordinate. *)
(** {1 Creators} *)
val make : simulation:Simulation.t ->
mo_type:mo_type ->
mo_occupation:t Vector.t ->
mo_coef:(Ao.Basis.t,t) Matrix.t ->
unit -> t
(** Function to build a data structure representing the molecular orbitals. *)
val of_hartree_fock : HartreeFock.t -> t
(** Build MOs from a Restricted Hartree-Fock calculation. *)
val of_mo_basis : Simulation.t -> t -> t
(** Project the MOs of the other basis on the current one. *)
val mo_matrix_of_ao_matrix :
mo_coef:(Ao.Basis.t,t) Matrix.t ->
(Ao.Basis.t,Ao.Basis.t) Matrix.t ->
(t,t) Matrix.t
(** Build a matrix in MO basis from a matrix in AO basis. *)
val ao_matrix_of_mo_matrix :
mo_coef:(Ao.Basis.t,t) Matrix.t ->
ao_overlap:(Ao.Basis.t,Ao.Basis.t) Matrix.t ->
(t,t) Matrix.t ->
(Ao.Basis.t,Ao.Basis.t) Matrix.t
(** Build a matrix in AO basis from a matrix in MO basis. *)
(** {1 Printers} *)
val pp : ?start:int -> ?finish:int -> Format.formatter -> t -> unit

141
mo/lib/class.ml Normal file
View File

@ -0,0 +1,141 @@
open Particles
type mo_class =
| Core of int (* Always doubly occupied *)
| Inactive of int (* With 0,1 or 2 holes *)
| Active of int (* With 0,1 or 2 holes or particles *)
| Virtual of int (* With 0,1 or 2 particles *)
| Deleted of int (* Always unoccupied *)
| Auxiliary of int (* Auxiliary basis function *)
type t = mo_class list
let pp_mo_class ppf = function
| Core i -> Format.fprintf ppf "@[Core %d@]" i
| Inactive i -> Format.fprintf ppf "@[Inactive %d@]" i
| Active i -> Format.fprintf ppf "@[Active %d@]" i
| Virtual i -> Format.fprintf ppf "@[Virtual %d@]" i
| Deleted i -> Format.fprintf ppf "@[Deleted %d@]" i
| Auxiliary i -> Format.fprintf ppf "@[Auxiliary %d@]" i
let pp ppf t =
Format.fprintf ppf "@[[@,";
let rec aux = function
| [] -> Format.fprintf ppf "]@]"
| x :: [] -> Format.fprintf ppf "%a@,]@]" pp_mo_class x
| x :: rest -> ( Format.fprintf ppf "%a@,;@," pp_mo_class x; aux rest )
in
aux t
let of_list t = t
let to_list t = t
let core_mos t =
List.filter_map (fun x ->
match x with
| Core i -> Some i
| _ -> None) t
let inactive_mos t =
List.filter_map (fun x ->
match x with
| Inactive i -> Some i
| _ -> None ) t
let active_mos t =
List.filter_map (fun x ->
match x with
| Active i -> Some i
| _ -> None ) t
let virtual_mos t =
List.filter_map (fun x ->
match x with
| Virtual i -> Some i
| _ -> None ) t
let deleted_mos t =
List.filter_map (fun x ->
match x with
| Deleted i -> Some i
| _ -> None ) t
let auxiliary_mos t =
List.filter_map (fun x ->
match x with
| Auxiliary i -> Some i
| _ -> None ) t
let mo_class_array t =
let sze = List.length t + 1 in
let result = Array.make sze (Deleted 0) in
List.iter (fun c ->
match c with
| Core i -> result.(i) <- Core i
| Inactive i -> result.(i) <- Inactive i
| Active i -> result.(i) <- Active i
| Virtual i -> result.(i) <- Virtual i
| Deleted i -> result.(i) <- Deleted i
| Auxiliary i -> result.(i) <- Auxiliary i
) t;
result
let fci ~frozen_core mo_basis =
let mo_num = Basis.size mo_basis in
let ncore = (Nuclei.small_core @@ Simulation.nuclei @@ Basis.simulation mo_basis) / 2 in
of_list (
if frozen_core then
List.concat [
Util.list_range 1 ncore
|> List.map (fun i -> Core i) ;
Util.list_range (ncore+1) mo_num
|> List.map (fun i -> Active i)
]
else
Util.list_range 1 mo_num
|> List.map (fun i -> Active i)
)
let cas_sd mo_basis ~frozen_core n m =
let mo_num = Basis.size mo_basis in
let n_alfa = Basis.simulation mo_basis |> Simulation.electrons |> Electrons.n_alfa in
let n_beta = Basis.simulation mo_basis |> Simulation.electrons |> Electrons.n_beta in
let n_unpaired = n_alfa - n_beta in
let n_alfa_in_cas = (n - n_unpaired)/2 + n_unpaired in
let last_inactive = n_alfa - n_alfa_in_cas in
let last_active = last_inactive + m in
let ncore =
if frozen_core then
(Nuclei.small_core @@ Simulation.nuclei @@ Basis.simulation mo_basis) / 2
|> min last_inactive
else 0
in
of_list (
List.concat [
if ncore > 0 then
Util.list_range 1 ncore
|> List.map (fun i -> Core i)
else
[] ;
Util.list_range (ncore+1) last_inactive
|> List.map (fun i -> Inactive i) ;
Util.list_range (last_inactive+1) last_active
|> List.map (fun i -> Active i) ;
Util.list_range (last_active+1) mo_num
|> List.map (fun i -> Virtual i)
]
)

58
mo/lib/class.mli Normal file
View File

@ -0,0 +1,58 @@
(** Classes of MOs : active, inactive, etc *)
type mo_class =
| Core of int (* Always doubly occupied *)
| Inactive of int (* With 0,1 or 2 holes *)
| Active of int (* With 0,1 or 2 holes or particles *)
| Virtual of int (* With 0,1 or 2 particles *)
| Deleted of int (* Always unoccupied *)
| Auxiliary of int (* Function of the auxiliary basis set *)
type t
(** Creation *)
val of_list : mo_class list -> t
val to_list : t -> mo_class list
val fci : frozen_core:bool -> Basis.t -> t
(** Creates the MO classes for FCI calculations : all [Active]. The
[n] lowest MOs are [Core] if [frozen_core = true].
*)
val cas_sd: Basis.t -> frozen_core:bool -> int -> int -> t
(** [cas_sd mo_basis n m ] creates the MO classes for CAS(n,m) + SD
calculations. lowest MOs are [Core], then all the next MOs are [Inactive],
then [Active], then [Virtual].
*)
val core_mos : t -> int list
(** Returns a list containing the indices of the core MOs. *)
val active_mos : t -> int list
(** Returns a list containing the indices of the active MOs. *)
val virtual_mos : t -> int list
(** Returns a list containing the indices of the virtual MOs. *)
val inactive_mos : t -> int list
(** Returns a list containing the indices of the inactive MOs. *)
val deleted_mos : t -> int list
(** Returns a list containing the indices of the deleted MOs. *)
val auxiliary_mos : t -> int list
(** Returns a list containing the indices of the auxiliary MOs. *)
val mo_class_array : t -> mo_class array
(** Returns an array [a] such that [a.(i)] returns the class of MO [i].
As the MO indices start from [1], the array has an extra zero entry
that should be ignored. *)
(** {2 Printers} *)
val pp_mo_class : Format.formatter -> mo_class -> unit
val pp : Format.formatter -> t -> unit

9
mo/lib/dune Normal file
View File

@ -0,0 +1,9 @@
; name = name of the supermodule that will wrap all source files as submodules
; public_name = name of the library for ocamlfind and opam
(library
(name mo)
(public_name qcaml.mo)
(libraries
qcaml.simulation
)
(synopsis "Molecular orbitals."))

14
simulation/lib/dune Normal file
View File

@ -0,0 +1,14 @@
; name = name of the supermodule that will wrap all source files as submodules
; public_name = name of the library for ocamlfind and opam
(library
(name simulation)
(public_name qcaml.simulation)
(libraries
qcaml.common
qcaml.particles
qcaml.gaussian_basis
qcaml.gaussian_integrals
qcaml.operators
qcaml.ao
)
(synopsis "Contains data describing a simulation (AOs, operators, nuclear coordinate,...)"))

0
qcaml/lib/simulation.ml → simulation/lib/simulation.ml
View File

0
qcaml/lib/simulation.mli → simulation/lib/simulation.mli
View File