mirror of
https://gitlab.com/scemama/QCaml.git
synced 2024-08-30 16:23:41 +02:00
Cleaned RHF
This commit is contained in:
parent
622650a280
commit
bdb547c346
321
SCF/RHF.ml
321
SCF/RHF.ml
@ -7,6 +7,31 @@ module El = Electrons
|
|||||||
module Ao = AOBasis
|
module Ao = AOBasis
|
||||||
module Ov = Overlap
|
module Ov = Overlap
|
||||||
|
|
||||||
|
|
||||||
|
type hartree_fock_data =
|
||||||
|
{
|
||||||
|
iteration : int ;
|
||||||
|
coefficients : Mat.t option ;
|
||||||
|
eigenvalues : Vec.t option ;
|
||||||
|
error : float option ;
|
||||||
|
diis : DIIS.t option ;
|
||||||
|
energy : float option ;
|
||||||
|
density : Mat.t option ;
|
||||||
|
fock : Fock.t option ;
|
||||||
|
}
|
||||||
|
|
||||||
|
let empty =
|
||||||
|
{
|
||||||
|
iteration = 0 ;
|
||||||
|
coefficients = None ;
|
||||||
|
eigenvalues = None ;
|
||||||
|
error = None ;
|
||||||
|
diis = None ;
|
||||||
|
energy = None ;
|
||||||
|
density = None ;
|
||||||
|
fock = None ;
|
||||||
|
}
|
||||||
|
|
||||||
let make ~guess ~max_scf ~level_shift ~threshold_SCF simulation =
|
let make ~guess ~max_scf ~level_shift ~threshold_SCF simulation =
|
||||||
(* Number of occupied MOs *)
|
(* Number of occupied MOs *)
|
||||||
let nocc =
|
let nocc =
|
||||||
@ -45,138 +70,162 @@ let make ~guess ~max_scf ~level_shift ~threshold_SCF simulation =
|
|||||||
(* Level shift in MO basis *)
|
(* Level shift in MO basis *)
|
||||||
let m_LSmo =
|
let m_LSmo =
|
||||||
Array.init (Mat.dim2 m_X) (fun i ->
|
Array.init (Mat.dim2 m_X) (fun i ->
|
||||||
if i > nocc then level_shift else 0.)
|
if i > nocc then level_shift else 0.)
|
||||||
|> Vec.of_array
|
|> Vec.of_array
|
||||||
|> Mat.of_diag
|
|> Mat.of_diag
|
||||||
in
|
in
|
||||||
|
|
||||||
(* SCF iterations *)
|
|
||||||
let rec loop nSCF iterations energy_prev m_C m_P_prev fock_prev threshold diis =
|
|
||||||
|
|
||||||
(* Density matrix over nocc occupied MOs *)
|
(* A single SCF iteration *)
|
||||||
let m_P =
|
let scf_iteration data =
|
||||||
gemm ~alpha:2. ~transb:`T ~k:nocc m_C m_C
|
|
||||||
|
let nSCF = data.iteration + 1
|
||||||
|
and m_C = of_some data.coefficients
|
||||||
|
and m_P_prev = data.density
|
||||||
|
and fock_prev = data.fock
|
||||||
|
and diis =
|
||||||
|
match data.diis with
|
||||||
|
| Some diis -> diis
|
||||||
|
| None -> DIIS.make ()
|
||||||
|
and threshold =
|
||||||
|
match data.error with
|
||||||
|
| Some error -> error
|
||||||
|
| None -> threshold_SCF *. 2.
|
||||||
|
in
|
||||||
|
|
||||||
|
(* Density matrix over nocc occupied MOs *)
|
||||||
|
let m_P =
|
||||||
|
gemm ~alpha:2. ~transb:`T ~k:nocc m_C m_C
|
||||||
|
in
|
||||||
|
|
||||||
|
(* Fock matrix in AO basis *)
|
||||||
|
let fock =
|
||||||
|
match fock_prev, m_P_prev, threshold > 100. *. threshold_SCF with
|
||||||
|
| Some fock_prev, Some m_P_prev, true ->
|
||||||
|
let threshold = 1.e-8 in
|
||||||
|
Fock.make_rhf ~density:(Mat.sub m_P m_P_prev) ~threshold ao_basis
|
||||||
|
|> Fock.add fock_prev
|
||||||
|
| _ -> Fock.make_rhf ~density:m_P ao_basis
|
||||||
|
in
|
||||||
|
|
||||||
|
let m_F, m_Hc, m_J, m_K =
|
||||||
|
let x = fock in
|
||||||
|
Fock.(fock x, core x, coulomb x, exchange x)
|
||||||
|
in
|
||||||
|
|
||||||
|
(* Add level shift in AO basis *)
|
||||||
|
let m_F =
|
||||||
|
let m_SC =
|
||||||
|
gemm m_S m_C
|
||||||
in
|
in
|
||||||
|
gemm m_SC (gemm m_LSmo m_SC ~transb:`T)
|
||||||
|
|> Mat.add m_F
|
||||||
|
in
|
||||||
|
|
||||||
(* Fock matrix in AO basis *)
|
|
||||||
let fock =
|
(* Fock matrix in orthogonal basis *)
|
||||||
match fock_prev, threshold > 100. *. threshold_SCF with
|
let m_F_ortho =
|
||||||
| Some fock_prev, true ->
|
xt_o_x m_F m_X
|
||||||
let threshold = 1.e-8 in
|
in
|
||||||
Fock.make_rhf ~density:(Mat.sub m_P m_P_prev) ~threshold ao_basis
|
|
||||||
|> Fock.add fock_prev
|
let error_fock =
|
||||||
| _ -> Fock.make_rhf ~density:m_P ao_basis
|
let fps =
|
||||||
|
gemm m_F (gemm m_P m_S)
|
||||||
|
and spf =
|
||||||
|
gemm m_S (gemm m_P m_F)
|
||||||
in
|
in
|
||||||
|
xt_o_x (Mat.sub fps spf) m_X
|
||||||
|
in
|
||||||
|
|
||||||
let m_F, m_Hc, m_J, m_K =
|
let diis =
|
||||||
let x = fock in
|
DIIS.append ~p:(Mat.as_vec m_F_ortho) ~e:(Mat.as_vec error_fock) diis
|
||||||
Fock.(fock x, core x, coulomb x, exchange x)
|
in
|
||||||
in
|
|
||||||
|
let m_F_diis =
|
||||||
(* Add level shift in AO basis *)
|
let x =
|
||||||
let m_F =
|
Bigarray.genarray_of_array1 (DIIS.next diis)
|
||||||
let m_SC =
|
|
||||||
gemm m_S m_C
|
|
||||||
in
|
|
||||||
gemm m_SC (gemm m_LSmo m_SC ~transb:`T)
|
|
||||||
|> Mat.add m_F
|
|
||||||
in
|
in
|
||||||
|
Bigarray.reshape_2 x (Mat.dim1 m_F_ortho) (Mat.dim2 m_F_ortho)
|
||||||
|
in
|
||||||
|
|
||||||
|
|
||||||
(* Fock matrix in orthogonal basis *)
|
(* MOs in orthogonal MO basis *)
|
||||||
let m_F_ortho =
|
let m_C', eigenvalues =
|
||||||
xt_o_x m_F m_X
|
diagonalize_symm m_F_diis
|
||||||
in
|
in
|
||||||
|
|
||||||
let error_fock =
|
(* MOs in AO basis *)
|
||||||
let fps =
|
let m_C =
|
||||||
gemm m_F (gemm m_P m_S)
|
gemm m_X m_C'
|
||||||
and spf =
|
in
|
||||||
gemm m_S (gemm m_P m_F)
|
|
||||||
in
|
|
||||||
xt_o_x (Mat.sub fps spf) m_X
|
|
||||||
in
|
|
||||||
|
|
||||||
let diis =
|
(* Hartree-Fock energy *)
|
||||||
DIIS.append ~p:(Mat.as_vec m_F_ortho) ~e:(Mat.as_vec error_fock) diis
|
let energy =
|
||||||
in
|
nuclear_repulsion +. 0.5 *.
|
||||||
|
Mat.gemm_trace m_P (Mat.add m_Hc m_F)
|
||||||
|
in
|
||||||
|
|
||||||
let m_F_diis =
|
(* Convergence criterion *)
|
||||||
let x =
|
let error =
|
||||||
Bigarray.genarray_of_array1 (DIIS.next diis)
|
error_fock
|
||||||
in
|
|> Mat.as_vec
|
||||||
Bigarray.reshape_2 x (Mat.dim1 m_F_ortho) (Mat.dim2 m_F_ortho)
|
|> amax
|
||||||
in
|
|> abs_float
|
||||||
|
in
|
||||||
|
{
|
||||||
|
iteration = nSCF ;
|
||||||
|
eigenvalues = Some eigenvalues ;
|
||||||
|
coefficients = Some m_C ;
|
||||||
|
error = Some error ;
|
||||||
|
diis = Some diis ;
|
||||||
|
energy = Some energy ;
|
||||||
|
density = Some m_P ;
|
||||||
|
fock = Some fock ;
|
||||||
|
}
|
||||||
|
|
||||||
|
|
||||||
(* MOs in orthogonal MO basis *)
|
|
||||||
let m_C', eigenvalues =
|
|
||||||
diagonalize_symm m_F_diis
|
|
||||||
in
|
|
||||||
|
|
||||||
(* MOs in AO basis *)
|
|
||||||
let m_C =
|
|
||||||
gemm m_X m_C'
|
|
||||||
in
|
|
||||||
|
|
||||||
(* Hartree-Fock energy *)
|
|
||||||
let energy =
|
|
||||||
nuclear_repulsion +. 0.5 *.
|
|
||||||
Mat.gemm_trace m_P (Mat.add m_Hc m_F)
|
|
||||||
in
|
|
||||||
|
|
||||||
(* Convergence criterion *)
|
|
||||||
let error =
|
|
||||||
error_fock
|
|
||||||
|> Mat.as_vec
|
|
||||||
|> amax
|
|
||||||
|> abs_float
|
|
||||||
in
|
|
||||||
|
|
||||||
let converged =
|
|
||||||
nSCF = max_scf || error < threshold_SCF
|
|
||||||
in
|
|
||||||
|
|
||||||
let gap =
|
|
||||||
if nocc < Vec.dim eigenvalues then
|
|
||||||
eigenvalues.{nocc+1} -. eigenvalues.{nocc}
|
|
||||||
else 0.
|
|
||||||
in
|
|
||||||
|
|
||||||
let () =
|
|
||||||
match energy_prev with
|
|
||||||
| Some energy_prev ->
|
|
||||||
Printf.eprintf "%3d %16.10f %16.10f %11.4e %10.4f\n%!" nSCF energy (energy -. energy_prev) error gap
|
|
||||||
| None ->
|
|
||||||
Printf.eprintf "%3d %16.10f %16s %11.4e %10.4f\n%!" nSCF energy "" error gap
|
|
||||||
in
|
|
||||||
|
|
||||||
if not converged then
|
|
||||||
loop (nSCF+1) ( (energy, error, gap) :: iterations) (Some energy) m_C m_P (Some fock) error diis
|
|
||||||
else
|
|
||||||
let iterations =
|
|
||||||
List.rev ( (energy, error, gap) :: iterations )
|
|
||||||
|> Array.of_list
|
|
||||||
in
|
|
||||||
HartreeFock_type.(RHF
|
|
||||||
{
|
|
||||||
simulation;
|
|
||||||
nocc;
|
|
||||||
guess ;
|
|
||||||
eigenvectors = m_C ;
|
|
||||||
eigenvalues ;
|
|
||||||
energy ;
|
|
||||||
nuclear_repulsion;
|
|
||||||
iterations ;
|
|
||||||
kin_energy = Mat.gemm_trace m_P m_T;
|
|
||||||
eN_energy = Mat.gemm_trace m_P m_V;
|
|
||||||
coulomb_energy = 0.5 *. Mat.gemm_trace m_P m_J;
|
|
||||||
exchange_energy = 0.5 *. Mat.gemm_trace m_P m_K;
|
|
||||||
occupation = Mat.copy_diag m_P;
|
|
||||||
})
|
|
||||||
in
|
in
|
||||||
|
|
||||||
|
|
||||||
|
let rec make_iterations_list data =
|
||||||
|
|
||||||
|
let energy_prev = data.energy in
|
||||||
|
|
||||||
|
(** Perform SCF iteration *)
|
||||||
|
let data = scf_iteration data in
|
||||||
|
|
||||||
|
(** Check convergence *)
|
||||||
|
let converged, error =
|
||||||
|
match data.error with
|
||||||
|
| None -> false, 0.
|
||||||
|
| Some error -> (data.iteration = max_scf || error < threshold_SCF), error
|
||||||
|
in
|
||||||
|
|
||||||
|
(** Print values *)
|
||||||
|
let nSCF = data.iteration in
|
||||||
|
|
||||||
|
let energy = of_some data.energy in
|
||||||
|
|
||||||
|
let () =
|
||||||
|
match energy_prev with
|
||||||
|
| Some energy_prev ->
|
||||||
|
Printf.eprintf "%3d %16.10f %16.10f %11.4e\n%!" nSCF energy (energy -. energy_prev) error
|
||||||
|
| None ->
|
||||||
|
Printf.eprintf "%3d %16.10f %16s %11.4e\n%!" nSCF energy "" error
|
||||||
|
in
|
||||||
|
|
||||||
|
if converged then
|
||||||
|
[ data ]
|
||||||
|
else
|
||||||
|
{ empty with
|
||||||
|
iteration = data.iteration;
|
||||||
|
energy = data.energy ;
|
||||||
|
eigenvalues = data.eigenvalues ;
|
||||||
|
error = data.error ;
|
||||||
|
} :: (make_iterations_list data)
|
||||||
|
in
|
||||||
|
|
||||||
|
|
||||||
|
|
||||||
(* Guess coefficients *)
|
(* Guess coefficients *)
|
||||||
let m_H =
|
let m_H =
|
||||||
match guess with
|
match guess with
|
||||||
@ -193,8 +242,50 @@ let make ~guess ~max_scf ~level_shift ~threshold_SCF simulation =
|
|||||||
gemm m_X m_C'
|
gemm m_X m_C'
|
||||||
in
|
in
|
||||||
|
|
||||||
let diis = DIIS.make () in
|
let iterations_list =
|
||||||
loop 1 [] None m_C m_C None threshold_SCF diis
|
make_iterations_list { empty with coefficients = Some m_C }
|
||||||
|
in
|
||||||
|
|
||||||
|
let iterations, data =
|
||||||
|
List.map (fun data ->
|
||||||
|
let gap =
|
||||||
|
let eigenvalues = of_some data.eigenvalues in
|
||||||
|
if nocc < Vec.dim eigenvalues then
|
||||||
|
eigenvalues.{nocc+1} -. eigenvalues.{nocc}
|
||||||
|
else 0.
|
||||||
|
and energy = of_some data.energy
|
||||||
|
and error = of_some data.error
|
||||||
|
in
|
||||||
|
(energy, error, gap)
|
||||||
|
) iterations_list
|
||||||
|
|> Array.of_list,
|
||||||
|
List.hd (List.rev iterations_list)
|
||||||
|
in
|
||||||
|
|
||||||
|
|
||||||
|
let energy = of_some data.energy in
|
||||||
|
let m_P = of_some data.density in
|
||||||
|
let fock = of_some data.fock in
|
||||||
|
let m_J = Fock.coulomb fock in
|
||||||
|
let m_K = Fock.exchange fock in
|
||||||
|
|
||||||
|
HartreeFock_type.(
|
||||||
|
RHF {
|
||||||
|
simulation;
|
||||||
|
nocc;
|
||||||
|
guess ;
|
||||||
|
eigenvectors = of_some data.coefficients ;
|
||||||
|
eigenvalues = of_some data.eigenvalues ;
|
||||||
|
energy ;
|
||||||
|
nuclear_repulsion;
|
||||||
|
iterations ;
|
||||||
|
kin_energy = Mat.gemm_trace m_P m_T;
|
||||||
|
eN_energy = Mat.gemm_trace m_P m_V;
|
||||||
|
coulomb_energy = 0.5 *. Mat.gemm_trace m_P m_J;
|
||||||
|
exchange_energy = 0.5 *. Mat.gemm_trace m_P m_K;
|
||||||
|
occupation = Mat.copy_diag m_P;
|
||||||
|
}
|
||||||
|
)
|
||||||
|
|
||||||
|
|
||||||
|
|
||||||
|
@ -171,6 +171,11 @@ let boys_function ~maxm t =
|
|||||||
end
|
end
|
||||||
|
|
||||||
|
|
||||||
|
let of_some = function
|
||||||
|
| Some a -> a
|
||||||
|
| None -> assert false
|
||||||
|
|
||||||
|
|
||||||
(** {2 List functions} *)
|
(** {2 List functions} *)
|
||||||
|
|
||||||
let list_some l =
|
let list_some l =
|
||||||
|
@ -36,6 +36,7 @@ val chop : float -> (unit -> float) -> float
|
|||||||
than {!Constants.epsilon}, and return [a *. f ()].
|
than {!Constants.epsilon}, and return [a *. f ()].
|
||||||
*)
|
*)
|
||||||
|
|
||||||
|
val of_some : 'a option -> 'a
|
||||||
|
|
||||||
|
|
||||||
(** {2 Functions related to the Boys function} *)
|
(** {2 Functions related to the Boys function} *)
|
||||||
|
Loading…
Reference in New Issue
Block a user