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

23 KiB
Raw Blame History

None <html> <head> </head>

Test of F12 matrix elements

Initialization

In [ ]:
#cd "/home/scemama/QCaml";;
#use "topfind";;
#require "jupyter.notebook";;

let png_image name = 
    Jupyter_notebook.display_file ~base64:true "image/png" ("Notebooks/images/"^name)
;;

#require "lacaml.top";;
#require "alcotest";;
#require "str";;
#require "bigarray";;
#require "zarith";;
#require "getopt";;
#directory "_build";;
#directory "_build/Basis";;
#directory "_build/CI";;
#directory "_build/MOBasis";;
#directory "_build/Nuclei";;
#directory "_build/Parallel";;
#directory "_build/Perturbation";;
#directory "_build/SCF";;
#directory "_build/Utils";;

Modules to load

In [ ]:
#load "Constants.cmo";;
#load_rec "Util.cma";;
#load_rec "Matrix.cmo";;
#load_rec "Simulation.cmo";;
#load_rec "Spindeterminant.cmo";;
#load_rec "Determinant.cmo";;
#load_rec "HartreeFock.cmo";;
#load_rec "MOBasis.cmo";;
#load_rec "F12CI.cmo";;

open Lacaml.D;;

Printers

In [ ]:
#install_printer AngularMomentum.pp_string ;;
#install_printer Basis.pp ;;
#install_printer Charge.pp ;;
#install_printer Coordinate.pp ;;
#install_printer Vector.pp;;
#install_printer Matrix.pp;;
#install_printer Util.pp_float_2darray;;
#install_printer Util.pp_float_array;;
#install_printer Util.pp_matrix;;
#install_printer HartreeFock.pp ;;
#install_printer Fock.pp ;;
#install_printer MOClass.pp ;;
let pp_mo ppf t = MOBasis.pp ~start:1 ~finish:0 ppf t ;;
#install_printer pp_mo;;
#install_printer DeterminantSpace.pp;;
#install_printer SpindeterminantSpace.pp;;
#install_printer Bitstring.pp;;

Run

Simulation

In [ ]:
let basis_filename  = "/home/scemama/qp2/data/basis/6-31g" 
let aux_basis_filename = "/home/scemama/qp2/data/basis/cc-pvdz" 
let nuclei = Nuclei.of_zmt_string "be" 
let frozen_core = false
let multiplicity = 1
let state = 1

let basis =  Basis.of_nuclei_and_basis_filenames ~nuclei [basis_filename] 
let aux_basis =  Basis.of_nuclei_and_basis_filenames ~nuclei (basis_filename :: aux_basis_filename :: []) 
let f12 = F12factor.gaussian_geminal 1.0 
let charge = 0 


let simulation =
    Simulation.make 
        ~f12 ~charge ~multiplicity ~nuclei
        ~cartesian:true
        basis

Hartree-Fock

In [ ]:
let hf =  HartreeFock.make ~guess:`Hcore  simulation  ;;

let mo_basis = MOBasis.of_hartree_fock hf

FCI-F12

Notations:

  • $\langle ij || kl \rangle = \int \phi_i(r_1) \phi_j(r_2) \frac{1}{r_{12}} \phi_k(r1) \phi_l(r2) $
  • $\left[ ij || kl \right] = \int \phi_i(r_1) \phi_j(r_2) f_{12} \phi_k(r1) \phi_l(r2) $

Common functions

In [ ]:
let f12 = Util.of_some @@ Simulation.f12 simulation 

let mo_num = MOBasis.size mo_basis 

let pp_spindet = Spindeterminant.pp mo_num

let pp_det = Determinant.pp mo_num

;;

#install_printer pp_spindet ;;
#install_printer pp_det ;;
In [ ]:
let simulation_aux = 
    let charge        = Charge.to_int @@ Simulation.charge simulation 
    and multiplicity  = Electrons.multiplicity @@ Simulation.electrons simulation
    and nuclei        = Simulation.nuclei simulation
    in
    let general_basis = 
      Basis.general_basis @@ Simulation.basis simulation
    in
    GeneralBasis.combine [
      general_basis ; GeneralBasis.read aux_basis_filename
    ]
    |> Basis.of_nuclei_and_general_basis nuclei
    |> Simulation.make ~f12 ~charge ~multiplicity ~nuclei 


let aux_basis = 
  MOBasis.of_mo_basis simulation_aux mo_basis

let aux_num = 
  MOBasis.size aux_basis

let () = ignore @@ MOBasis.f12_ints aux_basis let () = ignore @@ MOBasis.two_e_ints aux_basis

Determinant-based functions

Integrals

\begin{equation} \langle I | \hat{H} | J \rangle = \begin{cases} \sum_i h_{ii} + \frac{1}{2} \sum_{ij} \langle ij || ij \rangle \text{ when } |J\rangle = |I\rangle \\ h_{ik} + \sum_{j} \langle ij || kj \rangle \text{ when } |J\rangle = \hat{T}_i^k |I\rangle \\ \langle ij || kl \rangle \text{ when } |J\rangle = \hat{T}_{ij}^{kl} |I\rangle \\ \end{cases} \end{equation}\begin{equation} \langle I | \hat{F} | J \rangle = \begin{cases} \sum_i f_{ii} + \frac{1}{2} \sum_{ij} \langle ij || ij \rangle \text{ when } |J\rangle = |I\rangle \\ f_{ik} + \sum_{j} \langle ij || kj \rangle \text{ when } |J\rangle = \hat{T}_i^k |I\rangle \\ \langle ij || kl \rangle \text{ when } |J\rangle = \hat{T}_{ij}^{kl} |I\rangle \\ \end{cases} \end{equation}
In [ ]:
let cancel_singles = false 

let f12_integrals mo_basis =

  
  let two_e_ints  = MOBasis.f12_ints mo_basis in
  let f2 i j k l s s' =
      let ijkl = F12.get_phys two_e_ints i j k l in
      let ijlk = F12.get_phys two_e_ints i j l k in
      if s' <> s then
        ijkl 
      else
        (ijkl -. ijlk) 
  in
  ( (fun _ _ _ -> 0.),
    (if cancel_singles then
        (fun i j k l s s' ->
        (* Required to cancel out single excitations *)
           if (i=k && j<>l) || (j=l && i<>k) then
              0.
           else
              f2 i j k l s s'
        ) 
    else f2),
    None
  )

let h_ij mo_basis ki kj =
  let integrals =
    List.map (fun f -> f mo_basis)
      [ CI.h_integrals ]
  in
  CIMatrixElement.make integrals ki kj 
  |> List.hd


let f_ij mo_basis ki kj =
  let integrals =
    List.map (fun f -> f mo_basis)
      [ f12_integrals ]
  in
  CIMatrixElement.make integrals ki kj 
  |> List.hd                                                                                  


let hf_ij mo_basis ki kj =
  let integrals =
    List.map (fun f -> f mo_basis)
      [ CI.h_integrals ; f12_integrals ]
  in
  CIMatrixElement.make integrals ki kj

Determinant space

In [ ]:
let is_a_double det_space =
    let mo_class      = DeterminantSpace.mo_class det_space in
    let mo_num = Array.length @@ MOClass.mo_class_array mo_class in
    let m l =
      List.fold_left (fun accu i ->
          let j = i-1 in Bitstring.logor accu (Bitstring.shift_left_one mo_num j)
        ) (Bitstring.zero mo_num) l
    in
    let aux_mask   = m (MOClass.auxiliary_mos mo_class) in
    fun k ->                                                                                  
      let alfa =
        Determinant.alfa k
        |> Spindeterminant.bitstring
      in
      let beta =
        Determinant.beta k
        |> Spindeterminant.bitstring
      in
      let a = Bitstring.logand aux_mask alfa
      and b = Bitstring.logand aux_mask beta
      in
      match Bitstring.popcount a + Bitstring.popcount b with
      | 2 | 1 -> true
      | 0 | _ -> false
In [ ]:
let in_space = 
    DeterminantSpace.fci_f12_of_mo_basis aux_basis ~frozen_core mo_num
    
let aux_space = 
    DeterminantSpace.fci_of_mo_basis aux_basis ~frozen_core 

let det_space_in () =
    DeterminantSpace.determinant_stream in_space

let det_space_out () =
    let s = 
        DeterminantSpace.determinant_stream aux_space
    in
    Stream.from (fun _ ->
        try
          let is_a_double = is_a_double in_space in
          let rec result () =
            let ki = Stream.next s in
            if is_a_double ki then
              Some (ki,ki)
            else
              result ()
          in
          result ()
        with Stream.Failure -> None
      )
In [ ]:
let ci = CI.make ~n_states:state in_space

let ci_coef, ci_energy = Lazy.force ci.eigensystem

Permutation operator $p_{12}$ that generates a new determinant with electrons 1 and 2 swapped.

let p12 det_space = let mo_class = DeterminantSpace.mo_class det_space in let mo_num = Array.length @@ MOClass.mo_class_array mo_class in let m l = List.fold_left (fun accu i -> let j = i-1 in Bitstring.logor accu (Bitstring.shift_left_one mo_num j) ) (Bitstring.zero mo_num) l in let aux_mask = m (MOClass.auxiliary_mos mo_class) in let not_aux_mask = Bitstring.(shift_left_one mo_num (mo_num-1) |> minus_one |> logxor aux_mask) in fun k -> let alfa = Determinant.alfa k |> Spindeterminant.bitstring in let beta = Determinant.beta k |> Spindeterminant.bitstring in let a = Bitstring.logand aux_mask alfa and b = Bitstring.logand aux_mask beta in match Bitstring.popcount a, Bitstring.popcount b with | 2, 0 | 0, 2 -> Some (Determinant.negate_phase k) | 1, 1 -> Some (Determinant.of_spindeterminants (Spindeterminant.of_bitstring @@ Bitstring.(logor b (logand not_aux_mask alfa)) ) (Spindeterminant.of_bitstring @@ Bitstring.(logor a (logand not_aux_mask beta)) ) ) | 1, 0 | 0, 1 -> Some k | _ -> None

Integral-based functions

In [ ]:

Matrices $\langle I | H | \alpha \rangle$ and $\langle I | F | \alpha \rangle$

In [ ]:
let out_list =
    Util.stream_to_list (det_space_out ())
    
let in_list =
    Util.stream_to_list (det_space_in ())
    
let det_a = Array.of_list out_list
            |> Array.map (fun (i,_) -> i)

let det_I = Array.of_list in_list

let m_H_aux, m_F_aux = let rec col_vecs_list accu_H accu_F = function | [] -> List.rev accu_H, List.rev accu_F | (ki, ki') :: rest when ki = ki' -> begin let h, f = List.map (fun kj -> match hf_ij aux_basis kj ki with | [ a ; b ] -> a, b | _ -> assert false ) in_list |> List.split in let h = Vec.of_list h in let f = Vec.of_list f in scal 0.5 f; (* Specific to He singlet *) col_vecs_list (h::accu_H) (f::accu_F) rest end | (ki, ki') :: rest -> begin assert false; end in let h, f = col_vecs_list [] [] out_list in Mat.of_col_vecs_list h, Mat.of_col_vecs_list f

Function to generate all intermediate external determinants $|\alpha \rangle$ between $|I\rangle$ and $|J\rangle$, with a positive phase factor.

  • exc is the degree of excitation between $|I\rangle$ and $|J\rangle$
  • cabs is the number of electrons in the CABS
  • l is the degree of excitation between $|I\rangle$ and $|\alpha \rangle$
  • r is the degree of excitation between $|\alpha \rangle$ and $|J\rangle$
In [ ]:
let mos_cabs = 
  Util.list_range (mo_num+1) aux_num


let generate_alphas ki kj exc cabs l r =
  (* Check input excitation degree *)
  let d = Determinant.degree ki kj in
  if d <> exc then
    Printf.sprintf "Invalid excitation degree. Expected %d and found %d." exc d
    |> failwith;
    
  (* Generate single excitations *)
  let all_singles ki =
      let mos_a, mos_b = Determinant.to_lists ki in
      [ List.map (fun hole -> 
          List.map (fun particle ->
                  Determinant.single_excitation Spin.Alfa hole particle ki
              ) mos_cabs
          ) mos_a
      ;
        List.map (fun hole -> 
          List.map (fun particle ->
                  Determinant.single_excitation Spin.Beta hole particle ki
              ) mos_cabs
          ) mos_b 
      ]
      |> List.concat
      |> List.concat
      |> List.map (fun x -> Determinant.set_phase Phase.Pos x)
  in
  
  (* Generate double excitations *)
  let all_doubles ki =
      let mos_a, mos_b = Determinant.to_lists ki in
      [ List.map (fun hole ->  (* Alpha-Alpha *)
          List.map (fun particle ->
            List.map (fun hole' -> 
              List.map (fun particle' ->
                if hole' > hole && particle' < particle then
                  Some (Determinant.double_excitation Spin.Alfa hole particle Spin.Alfa hole' particle' ki)
                else None
                      ) mos_cabs
                  ) mos_a 
              ) mos_cabs
          ) mos_a
        ; 
        List.map (fun hole ->  (* Beta-Beta *)
          List.map (fun particle ->
            List.map (fun hole' -> 
              List.map (fun particle' ->
                if hole' > hole && particle' < particle then
                  Some (Determinant.double_excitation Spin.Beta hole particle Spin.Beta hole' particle' ki)
                else None
                      ) mos_cabs
                  ) mos_b 
              ) mos_cabs
          ) mos_b
        ;
        List.map (fun hole ->  (* Alpha-Beta *)
          List.map (fun particle ->
            List.map (fun hole' -> 
              List.map (fun particle' ->
                  Some (Determinant.double_excitation Spin.Alfa hole particle Spin.Beta hole' particle' ki)
                      ) mos_cabs
                  ) mos_a 
              ) mos_cabs
          ) mos_a
      ]
      |> List.concat
      |> List.concat
      |> List.concat
      |> List.concat
      |> Util.list_some
      |> List.map (fun x -> Determinant.set_phase Phase.Pos x)
  in

  (* Generate left and right excitations *)
  let al = 
      match l with
      | 1 -> all_singles ki
      | 2 -> all_doubles ki
      | _ -> assert false
  in
  let ar = 
      match r with
      | 1 -> all_singles kj
      | 2 -> all_doubles kj
      | _ -> assert false
  in
  
  let mo_class = DeterminantSpace.mo_class in_space in
  let m l =
    List.fold_left (fun accu i ->
        let j = i-1 in Bitstring.logor accu (Bitstring.shift_left_one mo_num j)
      ) (Bitstring.zero mo_num) l
  in
  let aux_mask = m (MOClass.auxiliary_mos mo_class) in
  let good_cabs k = 
      let alfa =
        Determinant.alfa k
        |> Spindeterminant.bitstring
      in
      let beta =
        Determinant.beta k
        |> Spindeterminant.bitstring
      in
      let a = Bitstring.logand aux_mask alfa
      and b = Bitstring.logand aux_mask beta
      in
      Bitstring.popcount a + Bitstring.popcount b = cabs
  in
  let good_lr k =
    Determinant.degree ki k = l &&
    Determinant.degree k kj = r 
  in


  
  (* Merge lists in a set of unique determinants *)
  List.concat [ al; ar ]
  |> List.sort_uniq compare
  
  (* Filter out all determinants with incorrect numbers of electrons in the CABS *)
  |> List.filter good_cabs
  
  (* Filter out all determinants with incorrect excitation numbers *)
  |> List.filter good_lr
  
  
let compute_HaaF ki alphas kj =
  List.fold_left (fun accu alpha -> accu
      +. h_ij aux_basis ki alpha
      *. f_ij aux_basis alpha kj
    ) 0. alphas
In [ ]:
In [ ]:
let ki = det_I.(0) 
let kj = det_I.(0)
let alphas =
    generate_alphas ki kj 0 1 1 1

let _ =
    compute_HaaF ki alphas kj

    
(*
|> SetDet.iter (fun x -> Format.printf "@[%a@]@;" (Determinant.pp 24) x)
*)
In [ ]:
In [ ]:
String.concat

0 1 11

In [ ]:
png_image "0_1_11.png"
In [ ]:
</html>