10
1
mirror of https://github.com/pfloos/quack synced 2024-12-22 20:34:46 +01:00

GW correction

This commit is contained in:
Pierre-Francois Loos 2019-07-09 17:25:21 +02:00
parent c477b848ac
commit ba070b3484
7 changed files with 74 additions and 60 deletions

View File

@ -1,29 +1,24 @@
1 6
S 8 1.00
17880.0000000 0.0007380
2683.0000000 0.0056770
611.5000000 0.0288830
173.5000000 0.1085400
56.6400000 0.2909070
20.4200000 0.4483240
7.8100000 0.2580260
1.6530000 0.0150630
S 8 1.00
17880.0000000 -0.0001720
2683.0000000 -0.0013570
611.5000000 -0.0067370
173.5000000 -0.0276630
56.6400000 -0.0762080
20.4200000 -0.1752270
7.8100000 -0.1070380
1.6530000 0.5670500
1 10
S 4 1.00
528.5000000 0.0009400
79.3100000 0.0072140
18.0500000 0.0359750
5.0850000 0.1277820
S 1 1.00
0.4869000 1.0000000
P 3 1.00
28.3900000 0.0460870
6.2700000 0.2401810
1.6950000 0.5087440
1.6090000 1.0000000
S 1 1.00
0.5363000 1.0000000
S 1 1.00
0.1833000 1.0000000
P 1 1.00
0.4317000 1.0000000
5.9940000 1.0000000
P 1 1.00
1.7450000 1.0000000
P 1 1.00
0.5600000 1.0000000
D 1 1.00
2.2020000 1.0000000
4.2990000 1.0000000
D 1 1.00
1.2230000 1.0000000
F 1 1.00
2.6800000 1.0000000

View File

@ -1,4 +1,4 @@
# nAt nEla nElb nCore nRyd
1 5 5 0 0
1 1 1 0 0
# Znuc x y z
Ne 0.0 0.0 0.0
He 0.0 0.0 0.0

View File

@ -1,29 +1,24 @@
1 6
S 8 1.00
17880.0000000 0.0007380
2683.0000000 0.0056770
611.5000000 0.0288830
173.5000000 0.1085400
56.6400000 0.2909070
20.4200000 0.4483240
7.8100000 0.2580260
1.6530000 0.0150630
S 8 1.00
17880.0000000 -0.0001720
2683.0000000 -0.0013570
611.5000000 -0.0067370
173.5000000 -0.0276630
56.6400000 -0.0762080
20.4200000 -0.1752270
7.8100000 -0.1070380
1.6530000 0.5670500
1 10
S 4 1.00
528.5000000 0.0009400
79.3100000 0.0072140
18.0500000 0.0359750
5.0850000 0.1277820
S 1 1.00
0.4869000 1.0000000
P 3 1.00
28.3900000 0.0460870
6.2700000 0.2401810
1.6950000 0.5087440
1.6090000 1.0000000
S 1 1.00
0.5363000 1.0000000
S 1 1.00
0.1833000 1.0000000
P 1 1.00
0.4317000 1.0000000
5.9940000 1.0000000
P 1 1.00
1.7450000 1.0000000
P 1 1.00
0.5600000 1.0000000
D 1 1.00
2.2020000 1.0000000
4.2990000 1.0000000
D 1 1.00
1.2230000 1.0000000
F 1 1.00
2.6800000 1.0000000

View File

@ -623,9 +623,10 @@ program QuAcK
call AO_values_grid(nBas,nShell,CenterShell,TotAngMomShell,KShell,DShell,ExpShell,nGrid,root,AO,dAO)
call density(nGrid,nBas,PHF(:,:,1),AO(:,:),rho(:))
call MO_values_grid(nBas,nGrid,cHF(:,:,1),AO,dAO,MO,dMO)
call f_grid(nBas,nO(1),nGrid,MO,ERI_MO_basis,f)
call f_grid(nBas,nO(1),nGrid,weight,MO,ERI_MO_basis,f)
call mu_grid(nGrid,rho,f,mu)
call ec_srlda(nGrid,weight,rho,mu)
call fc_srlda(nEl(1),nBas,nGrid,weight,MO,rho,mu)
!------------------------------------------------------------------------
! End of QuAcK

View File

@ -18,7 +18,7 @@ subroutine ec_srlda(nGrid,weight,rho,mu)
double precision :: r
double precision :: rs
double precision :: ecsr
double precision :: ec
double precision :: ec,vcup,vcdw
double precision,parameter :: thres = 1d-15
! Initialization
@ -33,9 +33,10 @@ subroutine ec_srlda(nGrid,weight,rho,mu)
rs = (4d0*pi*r/3d0)**(-1d0/3d0)
call srlda(rs,mu(iG),ecsr)
! call srlda(rs,mu(iG),ecsr)
call lsdsr(rs,0d0,mu(iG),ecsr,vcup,vcdw)
ec = ec + weight(iG)*ecsr*rho(iG)
ec = ec + weight(iG)*ecsr*r
end if

View File

@ -1,4 +1,4 @@
subroutine f_grid(nBas,nO,nGrid,MO,ERI,f)
subroutine f_grid(nBas,nO,nGrid,weight,MO,ERI,f)
! Compute f
@ -10,6 +10,7 @@ subroutine f_grid(nBas,nO,nGrid,MO,ERI,f)
integer,intent(in) :: nBas
integer,intent(in) :: nO
integer,intent(in) :: nGrid
double precision,intent(in) :: weight(nGrid)
double precision,intent(in) :: MO(nBas,nGrid)
double precision,intent(in) :: ERI(nBas,nBas,nBas,nBas)
@ -18,6 +19,7 @@ subroutine f_grid(nBas,nO,nGrid,MO,ERI,f)
integer :: p,q
integer :: i,j
integer :: iG
double precision :: toto
! Output variables
@ -27,6 +29,26 @@ subroutine f_grid(nBas,nO,nGrid,MO,ERI,f)
f(:) = 0d0
do p=1,nBas
do i=1,nO
do j=1,nO
do iG=1,ngrid
f(iG) = f(iG) + MO(i,iG)*MO(p,iG)*ERI(i,j,p,j)
end do
end do
end do
end do
toto=0d0
do iG=1,nGrid
toto = toto + weight(iG)*f(iG)
end do
print*,'toto=',toto
f(:) = 0d0
do p=1,nBas
do q=1,nBas
do i=1,nO

View File

@ -27,7 +27,7 @@ subroutine mu_grid(nGrid,rho,f,mu)
do iG=1,ngrid
n2 = rho(iG)**2
n2 = 0.25d0*rho(iG)**2
if(abs(n2) > thres) then