mirror of
https://gitlab.com/scemama/qp_plugins_scemama.git
synced 2024-06-02 11:25:23 +02:00
171 lines
4.1 KiB
Fortran
171 lines
4.1 KiB
Fortran
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
|
|
! $<ij|W(mu)|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_erf
|
|
W_mu(i,j,k,l) = mo_two_e_integral_erf(i,j,k,l)
|
|
enddo
|
|
enddo
|
|
enddo
|
|
enddo
|
|
END_PROVIDER
|
|
|
|
BEGIN_PROVIDER [ double precision, W_bar_mu, (mo_num, mo_num, mo_num, mo_num) ]
|
|
implicit none
|
|
BEGIN_DOC
|
|
! $<ij|\bar{W}(mu)|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_mu(i,j,k,l) = mo_two_e_integral(i,j,k,l) - W_mu(i,j,k,l)
|
|
enddo
|
|
enddo
|
|
enddo
|
|
enddo
|
|
END_PROVIDER
|
|
|
|
BEGIN_PROVIDER [ double precision, energy_mu, (N_states) ]
|
|
implicit none
|
|
BEGIN_DOC
|
|
! E(mu)
|
|
END_DOC
|
|
|
|
double precision :: one_e, two_e
|
|
|
|
integer :: k,l, istate
|
|
double precision, external :: ddot
|
|
|
|
do istate = 1,N_states
|
|
one_e = 0.d0
|
|
two_e = 0.d0
|
|
do l=1,mo_num
|
|
one_e += ddot(mo_num, one_e_dm_mo_alpha(1,l,istate), 1, mo_one_e_integrals(1,l), 1)
|
|
one_e += ddot(mo_num, one_e_dm_mo_beta (1,l,istate), 1, mo_one_e_integrals(1,l), 1)
|
|
do k=1,mo_num
|
|
two_e += 0.5d0 * ddot (mo_num*mo_num, full_occ_2_rdm_spin_trace_mo(1,1,k,l,istate), 1, W_mu(1,1,k,l), 1)
|
|
enddo
|
|
enddo
|
|
energy_mu(istate) = one_e + two_e + nuclear_repulsion
|
|
enddo
|
|
END_PROVIDER
|
|
|
|
BEGIN_PROVIDER [ double precision, correction_alpha_0, (N_states) ]
|
|
implicit none
|
|
BEGIN_DOC
|
|
! alpha_0(mu) * <Psi(mu)|W_bar_mu|Psi(mu)>
|
|
END_DOC
|
|
|
|
integer :: k,l, istate
|
|
double precision :: c0
|
|
double precision, external :: ddot
|
|
|
|
c0 = 0.5d0 * alpha_coef(0)
|
|
do istate=1,N_states
|
|
correction_alpha_0(istate) = 0.d0
|
|
do l=1,mo_num
|
|
do k=1,mo_num
|
|
correction_alpha_0(istate) += c0 * ddot (mo_num*mo_num, full_occ_2_rdm_spin_trace_mo(1,1,k,l,istate), 1, W_bar_mu(1,1,k,l), 1)
|
|
enddo
|
|
enddo
|
|
enddo
|
|
END_PROVIDER
|
|
|
|
BEGIN_PROVIDER [ double precision, correction_alpha_1, (N_states) ]
|
|
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, istate
|
|
double precision, external :: ddot
|
|
|
|
c0 = 0.5d0 * alpha_coef(0)
|
|
c1 = 0.5d0 * alpha_coef(1)
|
|
|
|
do istate=1,N_states
|
|
correction_alpha_1(istate) = 0.d0
|
|
do l=1,mo_num
|
|
do k=1,mo_num
|
|
correction_alpha_1(istate) += c0 * ddot (mo_num*mo_num, two_e_dm_mo_singlet(1,1,k,l,istate), 1, W_bar_mu(1,1,k,l), 1)
|
|
correction_alpha_1(istate) += c1 * ddot (mo_num*mo_num, two_e_dm_mo_triplet(1,1,k,l,istate), 1, W_bar_mu(1,1,k,l), 1)
|
|
enddo
|
|
enddo
|
|
enddo
|
|
END_PROVIDER
|
|
|
|
BEGIN_PROVIDER [ double precision, correction_mu, (N_states) ]
|
|
implicit none
|
|
BEGIN_DOC
|
|
! <Psi(mu)|W_bar_mu|Psi(mu)>
|
|
END_DOC
|
|
|
|
integer :: k,l, istate
|
|
double precision :: c0
|
|
double precision, external :: ddot
|
|
|
|
c0 = 0.5d0
|
|
|
|
do istate=1,N_states
|
|
correction_mu(istate) = 0.d0
|
|
do l=1,mo_num
|
|
do k=1,mo_num
|
|
correction_mu(istate) += c0 * ddot (mo_num*mo_num, full_occ_2_rdm_spin_trace_mo(1,1,k,l,istate), 1, W_bar_mu(1,1,k,l), 1)
|
|
enddo
|
|
enddo
|
|
enddo
|
|
END_PROVIDER
|
|
|
|
BEGIN_PROVIDER [ double precision, correction_mu0, (N_states) ]
|
|
implicit none
|
|
BEGIN_DOC
|
|
! <Psi(mu)|W|Psi(mu)> : Should be <Psi(0)|W|Psi(0)>
|
|
END_DOC
|
|
|
|
integer :: k,l,istate
|
|
double precision :: c0
|
|
double precision, external :: ddot
|
|
|
|
c0 = 0.5d0
|
|
do istate=1,N_states
|
|
correction_mu0(istate) = 0.d0
|
|
do l=1,mo_num
|
|
do k=1,mo_num
|
|
correction_mu0(istate) += c0 * ddot (mo_num*mo_num, full_occ_2_rdm_spin_trace_mo(1,1,k,l,istate), 1, W_bar_mu0(1,1,k,l), 1)
|
|
enddo
|
|
enddo
|
|
enddo
|
|
END_PROVIDER
|