Introduced small mu correction

devel/sr_correction/alpha.irp.f

@@ -16,3 +16,89 @@ BEGIN_PROVIDER [ double precision, alpha_coef, (0:1) ]
 END_PROVIDER
 
 
+BEGIN_PROVIDER [ double precision, alpha_coef_r, (0:1) ]
+ implicit none
+ BEGIN_DOC
+ ! SavCar-JCP-23, corrected for small mu
+ END_DOC
+
+ double precision :: num, den
+ double precision :: a0, b0, delta_E, E
+
+ E = energy_mu + correction_alpha_1
+
+ delta_E = E - energy_mu0
+
+ a0 = delta_E * correction_mu0 + 2.d0/dsqrt(dacos(-1.d0))*(delta_E - correction_mu0) * mu_erf
+ b0 = correction_mu0*correction_mu0
+
+ num = 0.319820d0 + mu_erf * (1.063846d0 + mu_erf)
+ den = 0.487806d0 + mu_erf * (1.375439d0 + mu_erf)
+ alpha_coef_r(0) = (a0 + mu_erf*num)/(b0 + mu_erf*den)
+
+ num = 0.113074d0 + mu_erf * (0.638308d0 + mu_erf)
+ den = 0.122652d0 + mu_erf * (0.674813d0 + mu_erf)
+ alpha_coef_r(1) = (a0 + mu_erf*num)/(b0 + mu_erf*den)
+
+
+END_PROVIDER
+
+BEGIN_PROVIDER [ double precision, energy_mu0 ]
+ implicit none
+ BEGIN_DOC
+ ! E(mu=0)
+ END_DOC
+
+ integer :: l
+ double precision, external :: ddot
+
+ energy_mu0 = 0.d0
+ do l=1,mo_num
+   energy_mu0 += ddot(mo_num, one_e_dm_mo(1,l), 1, mo_one_e_integrals(1,l), 1)
+ enddo
+ energy_mu0 = energy_mu0 + nuclear_repulsion
+
+END_PROVIDER
+
+BEGIN_PROVIDER [ double precision, correction_alpha_0_r ]
+ implicit none
+ BEGIN_DOC
+ ! alpha_0r(mu) * <Psi(mu)|W_bar_mu|Psi(mu)>
+ END_DOC
+
+ integer :: k,l
+ double precision :: c0
+ double precision, external :: ddot
+
+ c0 = 0.5d0 * alpha_coef_r(0)
+ correction_alpha_0_r = 0.d0
+ do l=1,mo_num
+   do k=1,mo_num
+     correction_alpha_0_r += c0 * ddot (mo_num*mo_num, two_e_dm_mo(1,1,k,l), 1, W_bar_mu(1,1,k,l), 1)
+   enddo
+ enddo
+END_PROVIDER
+
+BEGIN_PROVIDER [ double precision, correction_alpha_1_r ]
+ implicit none
+ BEGIN_DOC
+ ! alpha_0(mu) * <Psi(mu)|W_bar_mu|Psi(mu)>_s + alpha_1(mu) * <Psi(mu)|W_bar_mu|Psi(mu)>_t
+ END_DOC
+
+ double precision :: c1, c0
+
+ integer :: k,l
+ double precision, external :: ddot
+
+ c0 = 0.5d0 * alpha_coef_r(0)
+ c1 = 0.5d0 * alpha_coef_r(1)
+
+ correction_alpha_1_r = 0.d0
+ do l=1,mo_num
+   do k=1,mo_num
+     correction_alpha_1_r += c0 * ddot (mo_num*mo_num, two_e_dm_mo_singlet(1,1,k,l), 1, W_bar_mu(1,1,k,l), 1)
+     correction_alpha_1_r += c1 * ddot (mo_num*mo_num, two_e_dm_mo_triplet(1,1,k,l), 1, W_bar_mu(1,1,k,l), 1)
+   enddo
+ enddo
+END_PROVIDER
+

devel/sr_correction/energy_mu.irp.f

@@ -1,3 +1,22 @@
+BEGIN_PROVIDER [ double precision, W_bar_mu0, (mo_num, mo_num, mo_num, mo_num) ]
+ implicit none
+ BEGIN_DOC
+ ! $<ij|W(mu=0)|kl> = <ij|W|kl>$ in MO basis
+ END_DOC
+
+ integer :: i,j,k,l
+ do l=1,mo_num
+   do k=1,mo_num
+     do j=1,mo_num
+       do i=1,mo_num
+         double precision, external :: mo_two_e_integral
+         W_bar_mu0(i,j,k,l) = mo_two_e_integral(i,j,k,l)
+       enddo
+     enddo
+   enddo
+ enddo
+END_PROVIDER
+
 BEGIN_PROVIDER [ double precision, W_mu, (mo_num, mo_num, mo_num, mo_num) ]
  implicit none
  BEGIN_DOC
@@ -51,7 +70,7 @@ BEGIN_PROVIDER [ double precision, energy_mu ]
  two_e = 0.d0
  do l=1,mo_num
    one_e += ddot(mo_num, one_e_dm_mo(1,l), 1, mo_one_e_integrals(1,l), 1)
-   do k=1,mo_num
+  do k=1,mo_num
      two_e += 0.5d0 * ddot (mo_num*mo_num, two_e_dm_mo(1,1,k,l), 1, W_mu(1,1,k,l), 1)
    enddo
  enddo
@@ -103,7 +122,7 @@ END_PROVIDER
 BEGIN_PROVIDER [ double precision, correction_mu ]
  implicit none
  BEGIN_DOC
- ! alpha_0(mu) * <Psi(mu)|W_bar_mu|Psi(mu)>
+ ! <Psi(mu)|W_bar_mu|Psi(mu)>
  END_DOC
 
  integer :: k,l
@@ -118,3 +137,22 @@ BEGIN_PROVIDER [ double precision, correction_mu ]
    enddo
  enddo
 END_PROVIDER
+
+BEGIN_PROVIDER [ double precision, correction_mu0 ]
+ implicit none
+ BEGIN_DOC
+ ! <Psi(mu)|W|Psi(mu)> : Should be <Psi(0)|W|Psi(0)>
+ END_DOC
+
+ integer :: k,l
+ double precision :: c0
+ double precision, external :: ddot
+
+ c0 = 0.5d0
+ correction_mu0 = 0.d0
+ do l=1,mo_num
+   do k=1,mo_num
+     correction_mu0 += c0 * ddot (mo_num*mo_num, two_e_dm_mo(1,1,k,l), 1, W_bar_mu0(1,1,k,l), 1)
+   enddo
+ enddo
+END_PROVIDER

devel/sr_correction/sr_correction.irp.f

@@ -23,4 +23,12 @@ subroutine run
  print *, 'correction 1', correction_alpha_1
  print *, 'E(mu) + alpha_0 <W_bar(mu)>_s + alpha_1 <W_bar(mu)>_t = ', energy_mu + correction_alpha_1
  print *, '---'
+ print *, 'alpha_0_r', alpha_coef_r(0)
+ print *, 'correction 0', correction_alpha_0_r
+ print *, 'E(mu) + alpha_0_r <W_bar(mu)> = ', energy_mu + correction_alpha_0_r
+ print *, '---'
+ print *, 'alpha_1_r', alpha_coef_r(1)
+ print *, 'correction 1', correction_alpha_1_r
+ print *, 'E(mu) + alpha_0_r <W_bar(mu)>_s + alpha_1_r <W_bar(mu)>_t = ', energy_mu + correction_alpha_1_r
+ print *, '---'
 end