4
1
mirror of https://github.com/pfloos/quack synced 2024-06-26 15:12:17 +02:00

commit before removing restricted obselete routines

This commit is contained in:
Pierre-Francois Loos 2021-11-30 09:29:23 +01:00
parent bd8e827c1c
commit 329209cf9c
5 changed files with 22 additions and 57 deletions

View File

@ -22,8 +22,8 @@
1 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0
1 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0
1 1 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0
1 1 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0
1 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0
0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0
0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0
0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0

View File

@ -50,7 +50,7 @@ subroutine eDFT_UKS(x_rung,x_DFA,c_rung,c_DFA,nEns,wEns,nCC,aCC,nGrid,weight,max
double precision :: rcond(nspin)
double precision :: ET(nspin)
double precision :: EV(nspin)
double precision :: EJ(nsp)
double precision :: EH(nsp)
double precision :: Ex(nspin)
double precision :: Ec(nsp)
double precision :: dipole(ncart)
@ -250,7 +250,7 @@ subroutine eDFT_UKS(x_rung,x_DFA,c_rung,c_DFA,nEns,wEns,nCC,aCC,nGrid,weight,max
! Build Coulomb repulsion
do ispin=1,nspin
call hartree_coulomb(nBas,Pw(:,:,ispin),ERI(:,:,:,:),J(:,:,ispin))
call unrestricted_hartree_potential(nBas,Pw(:,:,ispin),ERI(:,:,:,:),J(:,:,ispin))
end do
! Compute exchange potential
@ -327,10 +327,7 @@ subroutine eDFT_UKS(x_rung,x_DFA,c_rung,c_DFA,nEns,wEns,nCC,aCC,nGrid,weight,max
! Coulomb energy
EJ(1) = 0.5d0*trace_matrix(nBas,matmul(Pw(:,:,1),J(:,:,1)))
EJ(2) = 0.5d0*trace_matrix(nBas,matmul(Pw(:,:,1),J(:,:,2))) &
+ 0.5d0*trace_matrix(nBas,matmul(Pw(:,:,2),J(:,:,1)))
EJ(3) = 0.5d0*trace_matrix(nBas,matmul(Pw(:,:,2),J(:,:,2)))
call unrestricted_hartree_energy(nBas,Pw,J,EH)
! Exchange energy
@ -346,7 +343,7 @@ subroutine eDFT_UKS(x_rung,x_DFA,c_rung,c_DFA,nEns,wEns,nCC,aCC,nGrid,weight,max
! Total energy
Ew = sum(ET(:)) + sum(EV(:)) + sum(EJ(:)) + sum(Ex(:)) + sum(Ec(:))
Ew = sum(ET(:)) + sum(EV(:)) + sum(EH(:)) + sum(Ex(:)) + sum(Ec(:))
! Check the grid accuracy by computing the number of electrons
@ -382,7 +379,7 @@ subroutine eDFT_UKS(x_rung,x_DFA,c_rung,c_DFA,nEns,wEns,nCC,aCC,nGrid,weight,max
! Compute final KS energy
call dipole_moment(nBas,Pw(:,:,1)+Pw(:,:,2),nNuc,ZNuc,rNuc,dipole_int,dipole)
call print_UKS(nBas,nEns,nO,S,wEns,eps,c,ENuc,ET,EV,EJ,Ex,Ec,Ew,dipole)
call print_UKS(nBas,nEns,nO,S,wEns,eps,c,ENuc,ET,EV,EH,Ex,Ec,Ew,dipole)
! Compute Vxc for post-HF calculations

View File

@ -1,33 +0,0 @@
subroutine hartree_coulomb(nBas,P,ERI,J)
! Compute Coulomb matrix
implicit none
! Input variables
integer,intent(in) :: nBas
double precision,intent(in) :: P(nBas,nBas)
double precision,intent(in) :: ERI(nBas,nBas,nBas,nBas)
! Local variables
integer :: mu,nu,la,si
! Output variables
double precision,intent(out) :: J(nBas,nBas)
J = 0d0
do si=1,nBas
do la=1,nBas
do nu=1,nBas
do mu=1,nBas
J(mu,nu) = J(mu,nu) + P(la,si)*ERI(mu,la,nu,si)
enddo
enddo
enddo
enddo
end subroutine hartree_coulomb

View File

@ -1,4 +1,4 @@
subroutine print_UKS(nBas,nEns,nO,Ov,wEns,eps,c,ENuc,ET,EV,EJ,Ex,Ec,Ew,dipole)
subroutine print_UKS(nBas,nEns,nO,Ov,wEns,eps,c,ENuc,ET,EV,EH,Ex,Ec,Ew,dipole)
! Print one- and two-electron energies and other stuff for KS calculation
@ -17,7 +17,7 @@ subroutine print_UKS(nBas,nEns,nO,Ov,wEns,eps,c,ENuc,ET,EV,EJ,Ex,Ec,Ew,dipole)
double precision,intent(in) :: ENuc
double precision,intent(in) :: ET(nspin)
double precision,intent(in) :: EV(nspin)
double precision,intent(in) :: EJ(nsp)
double precision,intent(in) :: EH(nsp)
double precision,intent(in) :: Ex(nspin)
double precision,intent(in) :: Ec(nsp)
double precision,intent(in) :: Ew
@ -69,14 +69,14 @@ subroutine print_UKS(nBas,nEns,nO,Ov,wEns,eps,c,ENuc,ET,EV,EJ,Ex,Ec,Ew,dipole)
write(*,'(A40,1X,F16.10,A3)') ' Potential a energy: ',EV(1),' au'
write(*,'(A40,1X,F16.10,A3)') ' Potential b energy: ',EV(2),' au'
write(*,'(A60)') '-------------------------------------------------'
write(*,'(A40,1X,F16.10,A3)') ' Two-electron a energy: ',sum(EJ(:)) + sum(Ex(:)) + sum(Ec(:)),' au'
write(*,'(A40,1X,F16.10,A3)') ' Two-electron aa energy: ',EJ(1) + Ex(1) + Ec(1),' au'
write(*,'(A40,1X,F16.10,A3)') ' Two-electron ab energy: ',EJ(2) + Ec(2),' au'
write(*,'(A40,1X,F16.10,A3)') ' Two-electron bb energy: ',EJ(3) + Ex(2) + Ec(3),' au'
write(*,'(A40,1X,F16.10,A3)') ' Coulomb energy: ',sum(EJ(:)),' au'
write(*,'(A40,1X,F16.10,A3)') ' Coulomb aa energy: ',EJ(1),' au'
write(*,'(A40,1X,F16.10,A3)') ' Coulomb ab energy: ',EJ(2),' au'
write(*,'(A40,1X,F16.10,A3)') ' Coulomb bb energy: ',EJ(3),' au'
write(*,'(A40,1X,F16.10,A3)') ' Two-electron a energy: ',sum(EH(:)) + sum(Ex(:)) + sum(Ec(:)),' au'
write(*,'(A40,1X,F16.10,A3)') ' Two-electron aa energy: ',EH(1) + Ex(1) + Ec(1),' au'
write(*,'(A40,1X,F16.10,A3)') ' Two-electron ab energy: ',EH(2) + Ec(2),' au'
write(*,'(A40,1X,F16.10,A3)') ' Two-electron bb energy: ',EH(3) + Ex(2) + Ec(3),' au'
write(*,'(A40,1X,F16.10,A3)') ' Hartree energy: ',sum(EH(:)),' au'
write(*,'(A40,1X,F16.10,A3)') ' Hartree aa energy: ',EH(1),' au'
write(*,'(A40,1X,F16.10,A3)') ' Hartree ab energy: ',EH(2),' au'
write(*,'(A40,1X,F16.10,A3)') ' Hartree bb energy: ',EH(3),' au'
write(*,'(A40,1X,F16.10,A3)') ' Exchange energy: ',sum(Ex(:)),' au'
write(*,'(A40,1X,F16.10,A3)') ' Exchange a energy: ',Ex(1),' au'
write(*,'(A40,1X,F16.10,A3)') ' Exchange b energy: ',Ex(2),' au'

View File

@ -117,11 +117,12 @@ subroutine unrestricted_individual_energy(x_rung,x_DFA,c_rung,c_DFA,LDA_centered
! Individual Hartree energy
!------------------------------------------------------------------------
do ispin=1,nspin
call unrestricted_hartree_potential(nBas,Pw(:,:,ispin),ERI,J(:,:,ispin))
end do
! do iEns=1,nEns
! do ispin=1,nspin
! call hartree_coulomb(nBas,Pw(:,:,ispin),ERI,J(:,:,ispin))
! end do
! if(doNcentered) then
!
@ -139,7 +140,7 @@ subroutine unrestricted_individual_energy(x_rung,x_DFA,c_rung,c_DFA,LDA_centered
! EJ(1,iEns) = trace_matrix(nBas,matmul(P(:,:,1,iEns),J(:,:,1))) &
! - 0.5d0*trace_matrix(nBas,matmul(Pw(:,:,1),J(:,:,1)))
! LZH(ispin) - 0.5d0*trace_matrix(nBas,matmul(Pw(:,:,1),J(:,:,1)))
! EJ(2,iEns) = trace_matrix(nBas,matmul(P(:,:,1,iEns),J(:,:,2))) &
! + trace_matrix(nBas,matmul(P(:,:,2,iEns),J(:,:,1))) &