2019-03-19 10:13:33 +01:00
|
|
|
subroutine MP2(nBas,nC,nO,nV,nR,ERI,ENuc,EHF,e,EcMP2)
|
|
|
|
|
|
2020-09-18 13:52:35 +02:00
|
|
|
! Perform second-order Moller-Plesset calculation
|
2019-03-19 10:13:33 +01:00
|
|
|
|
|
|
|
|
implicit none
|
|
|
|
|
|
|
|
|
|
! Input variables
|
|
|
|
|
|
2021-03-03 11:37:46 +01:00
|
|
|
integer,intent(in) :: nBas
|
|
|
|
|
integer,intent(in) :: nC
|
|
|
|
|
integer,intent(in) :: nO
|
|
|
|
|
integer,intent(in) :: nV
|
|
|
|
|
integer,intent(in) :: nR
|
|
|
|
|
double precision,intent(in) :: ENuc
|
|
|
|
|
double precision,intent(in) :: EHF
|
|
|
|
|
double precision,intent(in) :: e(nBas)
|
|
|
|
|
double precision,intent(in) :: ERI(nBas,nBas,nBas,nBas)
|
2019-03-19 10:13:33 +01:00
|
|
|
|
|
|
|
|
! Local variables
|
|
|
|
|
|
|
|
|
|
integer :: i,j,a,b
|
|
|
|
|
double precision :: eps,E2a,E2b
|
|
|
|
|
|
|
|
|
|
! Output variables
|
|
|
|
|
|
|
|
|
|
double precision,intent(out) :: EcMP2(3)
|
|
|
|
|
|
|
|
|
|
! Hello world
|
|
|
|
|
|
|
|
|
|
write(*,*)
|
|
|
|
|
write(*,*)'************************************************'
|
|
|
|
|
write(*,*)'| Moller-Plesset second-order calculation |'
|
|
|
|
|
write(*,*)'************************************************'
|
|
|
|
|
write(*,*)
|
|
|
|
|
|
|
|
|
|
! Compute MP2 energy
|
|
|
|
|
|
|
|
|
|
E2a = 0d0
|
|
|
|
|
E2b = 0d0
|
|
|
|
|
do i=nC+1,nO
|
|
|
|
|
do j=nC+1,nO
|
|
|
|
|
do a=nO+1,nBas-nR
|
|
|
|
|
do b=nO+1,nBas-nR
|
|
|
|
|
|
|
|
|
|
eps = e(i) + e(j) - e(a) - e(b)
|
|
|
|
|
|
|
|
|
|
! Second-order ring diagram
|
|
|
|
|
|
|
|
|
|
E2a = E2a + ERI(i,j,a,b)*ERI(i,j,a,b)/eps
|
|
|
|
|
|
|
|
|
|
! Second-order exchange diagram
|
|
|
|
|
|
|
|
|
|
E2b = E2b + ERI(i,j,a,b)*ERI(i,j,b,a)/eps
|
|
|
|
|
|
|
|
|
|
enddo
|
|
|
|
|
enddo
|
|
|
|
|
enddo
|
|
|
|
|
enddo
|
|
|
|
|
|
|
|
|
|
EcMP2(2) = 2d0*E2a
|
|
|
|
|
EcMP2(3) = -E2b
|
|
|
|
|
EcMP2(1) = EcMP2(2) + EcMP2(3)
|
|
|
|
|
|
|
|
|
|
write(*,*)
|
2020-01-15 22:29:43 +01:00
|
|
|
write(*,'(A32)') '--------------------------'
|
|
|
|
|
write(*,'(A32)') ' MP2 calculation '
|
|
|
|
|
write(*,'(A32)') '--------------------------'
|
|
|
|
|
write(*,'(A32,1X,F16.10)') ' MP2 correlation energy = ',EcMP2(1)
|
|
|
|
|
write(*,'(A32,1X,F16.10)') ' Direct part = ',EcMP2(2)
|
|
|
|
|
write(*,'(A32,1X,F16.10)') ' Exchange part = ',EcMP2(3)
|
|
|
|
|
write(*,'(A32)') '--------------------------'
|
|
|
|
|
write(*,'(A32,1X,F16.10)') ' MP2 electronic energy = ',EHF + EcMP2(1)
|
|
|
|
|
write(*,'(A32,1X,F16.10)') ' MP2 total energy = ',ENuc + EHF + EcMP2(1)
|
|
|
|
|
write(*,'(A32)') '--------------------------'
|
2019-03-19 10:13:33 +01:00
|
|
|
write(*,*)
|
|
|
|
|
|
|
|
|
|
end subroutine MP2
|
