scemama/qp_plugins_scemama
1
0
Fork 0
mirror of https://gitlab.com/scemama/qp_plugins_scemama.git synced 2024-12-22 04:13:40 +01:00
Code Issues Releases Wiki Activity

Introduced small mu correction

Browse Source
This commit is contained in:
Anthony Scemama 2023-10-19 23:21:48 +02:00
parent f0a02e3cf2
commit c4794b62ba
3 changed files with 134 additions and 2 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

86
devel/sr_correction/alpha.irp.f
View File

@ -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

42
devel/sr_correction/energy_mu.irp.f
View File

@ -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

8
devel/sr_correction/sr_correction.irp.f
View File

@ -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