PTEROSOR/QuAcK
10
1
Fork 0
mirror of https://github.com/pfloos/quack synced 2024-12-22 20:34:46 +01:00
Code Releases Activity

passing Fock matrix and others in R branch

Browse Source
This commit is contained in:
Pierre-Francois Loos 2024-09-02 22:18:53 +02:00
parent e37becbba4
commit fda6a45276
5 changed files with 129 additions and 105 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

16
src/CC/RCC.f90
View File

@ -1,8 +1,6 @@
! ---
subroutine RCC(dotest,doCCD,dopCCD,doDCD,doCCSD,doCCSDT,dodrCCD,dorCCD,docrCCD,dolCCD, &
maxSCF, thresh, max_diis, nBas, nOrb, nC, nO, nV, nR, Hc, ERI_AO, ERI_MO, ENuc, ERHF, eHF, cHF)
maxSCF,thresh,max_diis,nBas,nOrb,nC,nO,nV,nR,Hc,ERI_AO,ERI_MO,ENuc, &
ERHF,eHF,cHF,PHF,FHF)
! Coupled-cluster module
@ -27,7 +25,8 @@ subroutine RCC(dotest, doCCD, dopCCD, doDCD, doCCSD, doCCSDT, dodrCCD, dorCCD, d
integer,intent(in) :: max_diis
double precision,intent(in) :: thresh
integer,intent(in) :: nBas, nOrb
integer,intent(in) :: nBas
integer,intent(in) :: nOrb
integer,intent(in) :: nC
integer,intent(in) :: nO
integer,intent(in) :: nV
@ -36,6 +35,8 @@ subroutine RCC(dotest, doCCD, dopCCD, doDCD, doCCSD, doCCSDT, dodrCCD, dorCCD, d
double precision,intent(in) :: ERHF
double precision,intent(in) :: eHF(nOrb)
double precision,intent(in) :: cHF(nBas,nOrb)
double precision,intent(in) :: PHF(nBas,nBas)
double precision,intent(in) :: FHF(nBas,nBas)
double precision,intent(in) :: Hc(nBas,nBas)
double precision,intent(in) :: ERI_AO(nBas,nBas,nBas,nBas)
double precision,intent(in) :: ERI_MO(nOrb,nOrb,nOrb,nOrb)
@ -166,9 +167,8 @@ subroutine RCC(dotest, doCCD, dopCCD, doDCD, doCCSD, doCCSDT, dodrCCD, dorCCD, d
if(dopCCD) then
call wall_time(start_CC)
call pCCD(dotest, maxSCF, thresh, max_diis, nBas, nOrb, &
nC, nO, nV, nR, Hc, ERI_AO, ENuc, ERHF, eHF, cHF)
call pCCD(dotest,maxSCF,thresh,max_diis,nBas,nOrb,nC,nO,nV,nR, &
Hc,ERI_AO,ENuc,ERHF,eHF,cHF,PHF,FHF)
call wall_time(end_CC)
t_CC = end_CC - start_CC

49
src/CC/pCCD.f90
View File

@ -1,8 +1,5 @@
! ---
subroutine pCCD(dotest, maxIt, thresh, max_diis, nBas, nOrb, &
nC, nO, nV, nR, Hc, ERI_AO, ENuc, ERHF, eHF, cHF)
subroutine pCCD(dotest,maxIt,thresh,max_diis,nBas,nOrb,nC,nO,nV,nR, &
Hc,ERI_AO,ENuc,ERHF,eHF,cHF,PHF,FHF)
! pair CCD module
@ -16,15 +13,23 @@ subroutine pCCD(dotest, maxIt, thresh, max_diis, nBas, nOrb, &
integer,intent(in) :: max_diis
double precision,intent(in) :: thresh
integer,intent(in) :: nBas, nOrb, nC, nO, nV, nR
integer,intent(in) :: nBas
integer,intent(in) :: nOrb
integer,intent(in) :: nC
integer,intent(in) :: nO
integer,intent(in) :: nV
integer,intent(in) :: nR
double precision,intent(in) :: ENuc,ERHF
double precision,intent(in) :: eHF(nOrb)
double precision,intent(in) :: cHF(nBas,nOrb)
double precision,intent(in) :: PHF(nBas,nBas)
double precision,intent(in) :: FHF(nBas,nBas)
double precision,intent(in) :: Hc(nBas,nBas)
double precision,intent(in) :: ERI_AO(nBas,nBas,nBas,nBas)
! Local variables
integer :: mu,nu
integer :: p,q,r,s,t,u,w
integer :: pq,rs
integer :: i,j,a,b
@ -35,6 +40,7 @@ subroutine pCCD(dotest, maxIt, thresh, max_diis, nBas, nOrb, &
double precision :: CvgOrb
double precision :: ECC
double precision :: EcCC
double precision :: dECC
double precision,allocatable :: eO(:)
double precision,allocatable :: eV(:)
@ -93,7 +99,7 @@ subroutine pCCD(dotest, maxIt, thresh, max_diis, nBas, nOrb, &
O = nO - nC
V = nV - nR
N = O + V ! nOrb - nC - nR
N = O + V
!------------------------------------!
! Star Loop for orbital optimization !
@ -116,7 +122,7 @@ subroutine pCCD(dotest, maxIt, thresh, max_diis, nBas, nOrb, &
write(*,*)'| Orbital Optimization for pCCD |'
write(*,*)'----------------------------------------------------'
do while(CvgOrb > thresh .and. nItOrb < 1)
do while(CvgOrb > thresh .and. nItOrb < maxIt)
nItOrb = nItOrb + 1
@ -128,8 +134,22 @@ subroutine pCCD(dotest, maxIt, thresh, max_diis, nBas, nOrb, &
! Form energy denominator
eO(:) = eHF(nC+1:nO)
eV(:) = eHF(nO+1:nOrb-nR)
eO(:) = 0d0
eV(:) = 0d0
do mu=1,nBas
do nu=1,nBas
do i=1,O
eO(i) = eO(i) + c(mu,i)*FHF(mu,nu)*c(nu,i)
end do
do a=1,V
eV(a) = eV(a) + c(mu,O+a)*FHF(mu,nu)*c(nu,O+a)
end do
end do
end do
do i=1,O
do a=1,V
@ -170,6 +190,7 @@ subroutine pCCD(dotest, maxIt, thresh, max_diis, nBas, nOrb, &
nItAmp = 0
ECC = ERHF
EcCC = 0d0
dECC = ECC
n_diis = 0
t2(:,:) = 0d0
@ -573,10 +594,14 @@ subroutine pCCD(dotest, maxIt, thresh, max_diis, nBas, nOrb, &
! Check convergence of orbital optimization
CvgOrb = maxval(abs(grad))
write(*,*) ' Iteration',nItOrb,'for pCCD orbital optimization'
write(*,*) ' Convergence of orbital gradient = ',CvgOrb
write(*,'(A10,I4,A30)') ' Iteration',nItOrb,'for pCCD orbital optimization'
write(*,*) '----------------------------------------------------------'
write(*,'(A40,F16.10,A3)') ' Convergence of orbital gradient = ',CvgOrb,' au'
write(*,'(A40,F16.10,A3)') ' Energy difference = ',ECC-dECC,' au'
write(*,*)
dECC = ECC
!-------------------------!
! Compute orbital Hessian !
!-------------------------!

15
src/HF/RHF.f90
View File

@ -1,8 +1,5 @@
! ---
subroutine RHF(dotest,maxSCF,thresh,max_diis,guess_type,level_shift,nNuc,ZNuc,rNuc,ENuc, &
nBas, nOrb, nO, S, T, V, Hc, ERI, dipole_int, X, ERHF, eHF, c, P)
nBas,nOrb,nO,S,T,V,Hc,ERI,dipole_int,X,ERHF,eHF,c,P,F)
! Perform restricted Hartree-Fock calculation
@ -19,7 +16,8 @@ subroutine RHF(dotest, maxSCF, thresh, max_diis, guess_type, level_shift, nNuc,
double precision,intent(in) :: thresh
double precision,intent(in) :: level_shift
integer,intent(in) :: nBas, nOrb
integer,intent(in) :: nBas
integer,intent(in) :: nOrb
integer,intent(in) :: nO
integer,intent(in) :: nNuc
double precision,intent(in) :: ZNuc(nNuc)
@ -53,7 +51,6 @@ subroutine RHF(dotest, maxSCF, thresh, max_diis, guess_type, level_shift, nNuc,
double precision,allocatable :: J(:,:)
double precision,allocatable :: K(:,:)
double precision,allocatable :: cp(:,:)
double precision,allocatable :: F(:,:)
double precision,allocatable :: Fp(:,:)
! Output variables
@ -62,6 +59,7 @@ subroutine RHF(dotest, maxSCF, thresh, max_diis, guess_type, level_shift, nNuc,
double precision,intent(out) :: eHF(nOrb)
double precision,intent(inout):: c(nBas,nOrb)
double precision,intent(out) :: P(nBas,nBas)
double precision,intent(out) :: F(nBas,nBas)
! Hello world
@ -81,7 +79,6 @@ subroutine RHF(dotest, maxSCF, thresh, max_diis, guess_type, level_shift, nNuc,
allocate(K(nBas,nBas))
allocate(err(nBas,nBas))
allocate(F(nBas,nBas))
allocate(cp(nOrb,nOrb))
allocate(Fp(nOrb,nOrb))
@ -217,7 +214,7 @@ subroutine RHF(dotest, maxSCF, thresh, max_diis, guess_type, level_shift, nNuc,
write(*,*)'!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!'
write(*,*)
deallocate(J, K, err, F, cp, Fp, err_diis, F_diis)
deallocate(J,K,err,cp,Fp,err_diis,F_diis)
stop
@ -239,6 +236,6 @@ subroutine RHF(dotest, maxSCF, thresh, max_diis, guess_type, level_shift, nNuc,
end if
deallocate(J, K, err, F, cp, Fp, err_diis, F_diis)
deallocate(J,K,err,cp,Fp,err_diis,F_diis)
end subroutine

15
src/HF/ROHF.f90
View File

@ -1,8 +1,5 @@
! ---
subroutine ROHF(dotest,maxSCF,thresh,max_diis,guess_type,mix,level_shift,nNuc,ZNuc,rNuc,ENuc, &
nBas, nOrb, nO, S, T, V, Hc, ERI, dipole_int, X, EROHF, eHF, c, Ptot)
nBas,nOrb,nO,S,T,V,Hc,ERI,dipole_int,X,EROHF,eHF,c,Ptot,Ftot)
! Perform restricted open-shell Hartree-Fock calculation
@ -19,7 +16,8 @@ subroutine ROHF(dotest, maxSCF, thresh, max_diis, guess_type, mix, level_shift,
double precision,intent(in) :: mix
double precision,intent(in) :: level_shift
double precision,intent(in) :: thresh
integer,intent(in) :: nBas, nOrb
integer,intent(in) :: nOrb
integer,intent(in) :: nBas
integer,intent(in) :: nNuc
double precision,intent(in) :: ZNuc(nNuc)
@ -52,7 +50,6 @@ subroutine ROHF(dotest, maxSCF, thresh, max_diis, guess_type, mix, level_shift,
double precision,allocatable :: J(:,:,:)
double precision,allocatable :: F(:,:,:)
double precision,allocatable :: Fp(:,:)
double precision,allocatable :: Ftot(:,:)
double precision,allocatable :: P(:,:,:)
double precision,allocatable :: K(:,:,:)
double precision,allocatable :: err(:,:)
@ -68,6 +65,7 @@ subroutine ROHF(dotest, maxSCF, thresh, max_diis, guess_type, mix, level_shift,
double precision,intent(out) :: eHF(nOrb)
double precision,intent(inout):: c(nBas,nOrb)
double precision,intent(out) :: Ptot(nBas,nBas)
double precision,intent(out) :: Ftot(nBas,nBas)
! Hello world
@ -86,7 +84,6 @@ subroutine ROHF(dotest, maxSCF, thresh, max_diis, guess_type, mix, level_shift,
allocate(J(nBas,nBas,nspin))
allocate(K(nBas,nBas,nspin))
allocate(F(nBas,nBas,nspin))
allocate(Ftot(nBas,nBas))
allocate(P(nBas,nBas,nspin))
allocate(err(nBas,nBas))
@ -246,7 +243,7 @@ subroutine ROHF(dotest, maxSCF, thresh, max_diis, guess_type, mix, level_shift,
write(*,*)'!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!'
write(*,*)
deallocate(J, K, F, Ftot, P, err, Fp, cp, err_diis, F_diis)
deallocate(J,K,F,P,err,Fp,cp,err_diis,F_diis)
stop
@ -265,6 +262,6 @@ subroutine ROHF(dotest, maxSCF, thresh, max_diis, guess_type, mix, level_shift,
end if
deallocate(J, K, F, Ftot, P, err, Fp, cp, err_diis, F_diis)
deallocate(J,K,F,P,err,Fp,cp,err_diis,F_diis)
end subroutine

15
src/QuAcK/RQuAcK.f90
View File

@ -92,7 +92,10 @@ subroutine RQuAcK(dotest,doRHF,doROHF,dostab,dosearch,doMP2,doMP3,doCCD,dopCCD,d
double precision :: start_GW ,end_GW ,t_GW
double precision :: start_GT ,end_GT ,t_GT
double precision,allocatable :: cHF(:,:),eHF(:),PHF(:,:)
double precision,allocatable :: eHF(:)
double precision,allocatable :: cHF(:,:)
double precision,allocatable :: PHF(:,:)
double precision,allocatable :: FHF(:,:)
double precision :: ERHF
double precision,allocatable :: dipole_int_MO(:,:,:)
double precision,allocatable :: ERI_MO(:,:,:,:)
@ -109,9 +112,10 @@ subroutine RQuAcK(dotest,doRHF,doROHF,dostab,dosearch,doMP2,doMP3,doCCD,dopCCD,d
! Memory allocation !
!-------------------!
allocate(cHF(nBas,nOrb))
allocate(eHF(nOrb))
allocate(cHF(nBas,nOrb))
allocate(PHF(nBas,nBas))
allocate(FHF(nBas,nBas))
allocate(dipole_int_MO(nOrb,nOrb,ncart))
allocate(ERI_MO(nOrb,nOrb,nOrb,nOrb))
@ -123,7 +127,7 @@ subroutine RQuAcK(dotest,doRHF,doROHF,dostab,dosearch,doMP2,doMP3,doCCD,dopCCD,d
call wall_time(start_HF)
call RHF(dotest,maxSCF_HF,thresh_HF,max_diis_HF,guess_type,level_shift,nNuc,ZNuc,rNuc,ENuc, &
nBas, nOrb, nO, S, T, V, Hc, ERI_AO, dipole_int_AO, X, ERHF, eHF, cHF, PHF)
nBas,nOrb,nO,S,T,V,Hc,ERI_AO,dipole_int_AO,X,ERHF,eHF,cHF,PHF,FHF)
call wall_time(end_HF)
t_HF = end_HF - start_HF
@ -136,7 +140,7 @@ subroutine RQuAcK(dotest,doRHF,doROHF,dostab,dosearch,doMP2,doMP3,doCCD,dopCCD,d
call wall_time(start_HF)
call ROHF(dotest,maxSCF_HF,thresh_HF,max_diis_HF,guess_type,mix,level_shift,nNuc,ZNuc,rNuc,ENuc, &
nBas, nOrb, nO, S, T, V, Hc, ERI_AO, dipole_int_AO, X, ERHF, eHF, cHF, PHF)
nBas,nOrb,nO,S,T,V,Hc,ERI_AO,dipole_int_AO,X,ERHF,eHF,cHF,PHF,FHF)
call wall_time(end_HF)
t_HF = end_HF - start_HF
@ -232,7 +236,8 @@ subroutine RQuAcK(dotest,doRHF,doROHF,dostab,dosearch,doMP2,doMP3,doCCD,dopCCD,d
call wall_time(start_CC)
call RCC(dotest,doCCD,dopCCD,doDCD,doCCSD,doCCSDT,dodrCCD,dorCCD,docrCCD,dolCCD, &
maxSCF_CC, thresh_CC, max_diis_CC, nBas, nOrb, nC, nO, nV, nR, Hc, ERI_AO, ERI_MO, ENuc, ERHF, eHF, cHF)
maxSCF_CC,thresh_CC,max_diis_CC,nBas,nOrb,nC,nO,nV,nR,Hc,ERI_AO,ERI_MO, &
ENuc,ERHF,eHF,cHF,PHF,FHF)
call wall_time(end_CC)
t_CC = end_CC - start_CC