mirror of
https://github.com/pfloos/quack
synced 2025-04-10 02:31:36 +02:00
Merge branch 'master' of github.com:pfloos/QuAcK
This commit is contained in:
Antoine Marie
commit
e37becbba4
3
.gitignore
vendored
3
.gitignore
vendored
@ -1,2 +1,5 @@
|
||||
*.o
|
||||
*.
|
||||
__pycache__
|
||||
|
||||
.ninja_deps
|
||||
|
||||
23
PyDuck.py
23
PyDuck.py
@ -18,6 +18,7 @@ parser.add_argument('-b', '--basis', type=str, required=True, help='Name of the
|
||||
parser.add_argument('--bohr', default='Angstrom', action='store_const', const='Bohr', help='By default QuAcK assumes that the xyz files are in Angstrom. Add this argument if your xyz file is in Bohr.')
|
||||
parser.add_argument('-c', '--charge', type=int, default=0, help='Total charge of the molecule. Specify negative charges with "m" instead of the minus sign, for example m1 instead of -1. Default is 0')
|
||||
parser.add_argument('--cartesian', default=False, action='store_true', help='Add this option if you want to use cartesian basis functions.')
|
||||
parser.add_argument('--print_2e', default=False, action='store_true', help='Add this option if you want to print 2e-integrals.')
|
||||
parser.add_argument('-fc', '--frozen_core', type=bool, default=False, help='Freeze core MOs. Default is false')
|
||||
parser.add_argument('-m', '--multiplicity', type=int, default=1, help='Spin multiplicity. Default is 1 therefore singlet')
|
||||
parser.add_argument('--working_dir', type=str, default=QuAcK_dir, help='Set a working directory to run the calculation.')
|
||||
@ -32,6 +33,7 @@ frozen_core=args.frozen_core
|
||||
multiplicity=args.multiplicity
|
||||
xyz=args.xyz + '.xyz'
|
||||
cartesian=args.cartesian
|
||||
print_2e=args.print_2e
|
||||
working_dir=args.working_dir
|
||||
|
||||
#Read molecule
|
||||
@ -90,11 +92,10 @@ t1e = mol.intor('int1e_kin') #Kinetic energy matrix elements
|
||||
dipole = mol.intor('int1e_r') #Matrix elements of the x, y, z operators
|
||||
x,y,z = dipole[0],dipole[1],dipole[2]
|
||||
|
||||
norb = len(ovlp)
|
||||
norb = len(ovlp) # nBAS_AOs
|
||||
subprocess.call(['rm', working_dir + '/int/nBas.dat'])
|
||||
f = open(working_dir+'/int/nBas.dat','w')
|
||||
f.write(str(norb))
|
||||
f.write(' ')
|
||||
f.write(" {} ".format(str(norb)))
|
||||
f.close()
|
||||
|
||||
|
||||
@ -122,7 +123,6 @@ write_matrix_to_file(y,norb,working_dir+'/int/y.dat')
|
||||
subprocess.call(['rm', working_dir + '/int/z.dat'])
|
||||
write_matrix_to_file(z,norb,working_dir+'/int/z.dat')
|
||||
|
||||
#Write two-electron integrals
|
||||
eri_ao = mol.intor('int2e')
|
||||
|
||||
def write_tensor_to_file(tensor,size,file,cutoff=1e-15):
|
||||
@ -132,12 +132,23 @@ def write_tensor_to_file(tensor,size,file,cutoff=1e-15):
|
||||
for k in range(i,size):
|
||||
for l in range(j,size):
|
||||
if abs(tensor[i][k][j][l]) > cutoff:
|
||||
#f.write(str(i+1)+' '+str(j+1)+' '+str(k+1)+' '+str(l+1)+' '+"{:.16E}".format(tensor[i][k][j][l]))
|
||||
f.write(str(i+1)+' '+str(j+1)+' '+str(k+1)+' '+str(l+1)+' '+"{:.16E}".format(tensor[i][k][j][l]))
|
||||
f.write('\n')
|
||||
f.close()
|
||||
|
||||
subprocess.call(['rm', working_dir + '/int/ERI.dat'])
|
||||
write_tensor_to_file(eri_ao,norb,working_dir+'/int/ERI.dat')
|
||||
# Write two-electron integrals
|
||||
if print_2e:
|
||||
# (formatted)
|
||||
subprocess.call(['rm', working_dir + '/int/ERI.dat'])
|
||||
write_tensor_to_file(eri_ao,norb,working_dir+'/int/ERI.dat')
|
||||
else:
|
||||
# (binary)
|
||||
subprocess.call(['rm', working_dir + '/int/ERI.bin'])
|
||||
# chem -> phys notation
|
||||
eri_ao = eri_ao.transpose(0, 2, 1, 3)
|
||||
eri_ao.tofile('int/ERI.bin')
|
||||
|
||||
|
||||
#Execute the QuAcK fortran program
|
||||
subprocess.call(QuAcK_dir+'/bin/QuAcK')
|
||||
|
||||
16
int/CAP.dat
16
int/CAP.dat
@ -1,16 +0,0 @@
|
||||
1 1 9.1642021581097924E-03 6.2961947849362709E-02 9.1642021581097941E-03
|
||||
1 2 2.9798815568270971E-02 1.0031339688416364E-01 2.9798815568270971E-02
|
||||
1 3 4.8078353659559226E-03 5.1255302523161485E-03 4.8078353659559234E-03
|
||||
1 4 2.3003539814844435E-02 4.1290024754715535E-02 2.3003539814844435E-02
|
||||
2 1 2.9798815568270971E-02 1.0031339688416364E-01 2.9798815568270971E-02
|
||||
2 2 3.5629639141443131E-01 5.7428563627799001E-01 3.5629639141443131E-01
|
||||
2 3 2.3003539814844435E-02 4.1290024754715576E-02 2.3003539814844435E-02
|
||||
2 4 3.0301481386007040E-01 3.0301481386007040E-01 3.0301481386007040E-01
|
||||
3 1 4.8078353659559226E-03 5.1255302523161485E-03 4.8078353659559234E-03
|
||||
3 2 2.3003539814844435E-02 4.1290024754715576E-02 2.3003539814844435E-02
|
||||
3 3 9.1642021581097924E-03 6.2961947849362682E-02 9.1642021581097941E-03
|
||||
3 4 2.9798815568270971E-02 1.0031339688416376E-01 2.9798815568270971E-02
|
||||
4 1 2.3003539814844435E-02 4.1290024754715535E-02 2.3003539814844435E-02
|
||||
4 2 3.0301481386007040E-01 3.0301481386007040E-01 3.0301481386007040E-01
|
||||
4 3 2.9798815568270971E-02 1.0031339688416376E-01 2.9798815568270971E-02
|
||||
4 4 3.5629639141443131E-01 5.7428563627799034E-01 3.5629639141443131E-01
|
||||
@ -1,4 +1,4 @@
|
||||
2
|
||||
|
||||
H 0.0000 0.0000 -0.37500000
|
||||
H 0.0000 0.0000 0.37500000
|
||||
H 0.00000000 -0.37500000 0.00000000
|
||||
H 0.00000000 0.37500000 0.00000000
|
||||
|
||||
@ -1,4 +1,4 @@
|
||||
2
|
||||
|
||||
N 0.0000 0.0000 0.0000
|
||||
N 0.0000 0.0000 1.1007
|
||||
N 0.0000 0.0000 -0.5475132
|
||||
N 0.0000 0.0000 0.5475132
|
||||
|
||||
@ -1,26 +1,31 @@
|
||||
subroutine AOtoMO(nBas,C,A,B)
|
||||
subroutine AOtoMO(nBas, nOrb, C, M_AOs, M_MOs)
|
||||
|
||||
! Perform AO to MO transformation of a matrix A for given coefficients c
|
||||
! Perform AO to MO transformation of a matrix M_AOs for given coefficients c
|
||||
! M_MOs = C.T M_AOs C
|
||||
|
||||
implicit none
|
||||
|
||||
! Input variables
|
||||
integer, intent(in) :: nBas, nOrb
|
||||
double precision, intent(in) :: C(nBas,nOrb)
|
||||
double precision, intent(in) :: M_AOs(nBas,nBas)
|
||||
|
||||
integer,intent(in) :: nBas
|
||||
double precision,intent(in) :: C(nBas,nBas)
|
||||
double precision,intent(in) :: A(nBas,nBas)
|
||||
double precision, intent(out) :: M_MOs(nOrb,nOrb)
|
||||
|
||||
! Local variables
|
||||
double precision, allocatable :: AC(:,:)
|
||||
|
||||
double precision,allocatable :: AC(:,:)
|
||||
allocate(AC(nBas,nOrb))
|
||||
|
||||
! Output variables
|
||||
!AC = matmul(M_AOs, C)
|
||||
!M_MOs = matmul(transpose(C), AC)
|
||||
|
||||
double precision,intent(out) :: B(nBas,nBas)
|
||||
call dgemm("N", "N", nBas, nOrb, nBas, 1.d0, &
|
||||
M_AOs(1,1), nBas, C(1,1), nBas, &
|
||||
0.d0, AC(1,1), nBas)
|
||||
|
||||
allocate(AC(nBas,nBas))
|
||||
call dgemm("T", "N", nOrb, nOrb, nBas, 1.d0, &
|
||||
C(1,1), nBas, AC(1,1), nBas, &
|
||||
0.d0, M_MOs(1,1), nOrb)
|
||||
|
||||
AC = matmul(A,C)
|
||||
B = matmul(transpose(C),AC)
|
||||
deallocate(AC)
|
||||
|
||||
end subroutine
|
||||
|
||||
@ -1,4 +1,7 @@
|
||||
subroutine AOtoMO_ERI_RHF(nBas,c,ERI_AO,ERI_MO)
|
||||
|
||||
! ---
|
||||
|
||||
subroutine AOtoMO_ERI_RHF(nBas, nOrb, c, ERI_AO, ERI_MO)
|
||||
|
||||
! AO to MO transformation of two-electron integrals via the semi-direct O(N^5) algorithm
|
||||
|
||||
@ -7,32 +10,51 @@ subroutine AOtoMO_ERI_RHF(nBas,c,ERI_AO,ERI_MO)
|
||||
|
||||
! Input variables
|
||||
|
||||
integer,intent(in) :: nBas
|
||||
integer,intent(in) :: nBas, nOrb
|
||||
double precision,intent(in) :: ERI_AO(nBas,nBas,nBas,nBas)
|
||||
double precision,intent(in) :: c(nBas,nBas)
|
||||
double precision,intent(in) :: c(nBas,nOrb)
|
||||
|
||||
! Local variables
|
||||
|
||||
double precision,allocatable :: scr(:,:,:,:)
|
||||
integer :: mu,nu,la,si
|
||||
integer :: i,j,k,l
|
||||
double precision,allocatable :: a1(:,:,:,:)
|
||||
double precision,allocatable :: a2(:,:,:,:)
|
||||
|
||||
! Output variables
|
||||
|
||||
double precision,intent(out) :: ERI_MO(nBas,nBas,nBas,nBas)
|
||||
double precision,intent(out) :: ERI_MO(nOrb,nOrb,nOrb,nOrb)
|
||||
|
||||
! Memory allocation
|
||||
|
||||
allocate(scr(nBas,nBas,nBas,nBas))
|
||||
allocate(a2(nBas,nBas,nBas,nOrb))
|
||||
allocate(a1(nBas,nBas,nOrb,nOrb))
|
||||
|
||||
! Four-index transform via semi-direct O(N^5) algorithm
|
||||
|
||||
call dgemm('T','N',nBas**3,nBas,nBas,1d0,ERI_AO,nBas,c(1,1),size(c,1),0d0,scr,nBas**3)
|
||||
|
||||
call dgemm('T','N',nBas**3,nBas,nBas,1d0,scr,nBas,c(1,1),size(c,1),0d0,ERI_MO,nBas**3)
|
||||
call dgemm( 'T', 'N', nBas*nBas*nBas, nOrb, nBas, 1.d0 &
|
||||
, ERI_AO(1,1,1,1), nBas, c(1,1), nBas &
|
||||
, 0.d0, a2(1,1,1,1), nBas*nBas*nBas)
|
||||
|
||||
call dgemm('T','N',nBas**3,nBas,nBas,1d0,ERI_MO,nBas,c(1,1),size(c,1),0d0,scr,nBas**3)
|
||||
call dgemm( 'T', 'N', nBas*nBas*nOrb, nOrb, nBas, 1.d0 &
|
||||
, a2(1,1,1,1), nBas, c(1,1), nBas &
|
||||
, 0.d0, a1(1,1,1,1), nBas*nBas*nOrb)
|
||||
|
||||
call dgemm('T','N',nBas**3,nBas,nBas,1d0,scr,nBas,c(1,1),size(c,1),0d0,ERI_MO,nBas**3)
|
||||
deallocate(a2)
|
||||
allocate(a2(nBas,nOrb,nOrb,nOrb))
|
||||
|
||||
call dgemm( 'T', 'N', nBas*nOrb*nOrb, nOrb, nBas, 1.d0 &
|
||||
, a1(1,1,1,1), nBas, c(1,1), nBas &
|
||||
, 0.d0, a2(1,1,1,1), nBas*nOrb*nOrb)
|
||||
|
||||
deallocate(a1)
|
||||
|
||||
call dgemm( 'T', 'N', nOrb*nOrb*nOrb, nOrb, nBas, 1.d0 &
|
||||
, a2(1,1,1,1), nBas, c(1,1), nBas &
|
||||
, 0.d0, ERI_MO(1,1,1,1), nOrb*nOrb*nOrb)
|
||||
|
||||
deallocate(a2)
|
||||
|
||||
end subroutine
|
||||
|
||||
|
||||
|
||||
|
||||
|
||||
@ -1,31 +1,39 @@
|
||||
subroutine MOtoAO(nBas,S,C,B,A)
|
||||
subroutine MOtoAO(nBas, nOrb, S, C, M_MOs, M_AOs)
|
||||
|
||||
! Perform MO to AO transformation of a matrix A for a given metric S
|
||||
! and coefficients c
|
||||
! Perform MO to AO transformation of a matrix M_AOs for a given metric S
|
||||
! and coefficients c
|
||||
!
|
||||
! M_AOs = S C M_MOs (S C).T
|
||||
|
||||
implicit none
|
||||
|
||||
! Input variables
|
||||
integer, intent(in) :: nBas, nOrb
|
||||
double precision, intent(in) :: S(nBas,nBas)
|
||||
double precision, intent(in) :: C(nBas,nOrb)
|
||||
double precision, intent(in) :: M_MOs(nOrb,nOrb)
|
||||
double precision, intent(out) :: M_AOs(nBas,nBas)
|
||||
|
||||
integer,intent(in) :: nBas
|
||||
double precision,intent(in) :: S(nBas,nBas)
|
||||
double precision,intent(in) :: C(nBas,nBas)
|
||||
double precision,intent(in) :: B(nBas,nBas)
|
||||
double precision, allocatable :: SC(:,:),BSC(:,:)
|
||||
|
||||
! Local variables
|
||||
|
||||
double precision,allocatable :: SC(:,:),BSC(:,:)
|
||||
allocate(SC(nBas,nOrb), BSC(nOrb,nBas))
|
||||
|
||||
! Output variables
|
||||
!SC = matmul(S, C)
|
||||
!BSC = matmul(M_MOs, transpose(SC))
|
||||
!M_AOs = matmul(SC, BSC)
|
||||
|
||||
double precision,intent(out) :: A(nBas,nBas)
|
||||
call dgemm("N", "N", nBas, nOrb, nBas, 1.d0, &
|
||||
S(1,1), nBas, C(1,1), nBas, &
|
||||
0.d0, SC(1,1), nBas)
|
||||
|
||||
! Memory allocation
|
||||
call dgemm("N", "T", nOrb, nBas, nOrb, 1.d0, &
|
||||
M_MOs(1,1), nOrb, SC(1,1), nBas, &
|
||||
0.d0, BSC(1,1), nOrb)
|
||||
|
||||
allocate(SC(nBas,nBas),BSC(nBas,nBas))
|
||||
call dgemm("N", "N", nBas, nBas, nOrb, 1.d0, &
|
||||
SC(1,1), nBas, BSC(1,1), nOrb, &
|
||||
0.d0, M_AOs(1,1), nBas)
|
||||
|
||||
SC = matmul(S,C)
|
||||
BSC = matmul(B,transpose(SC))
|
||||
A = matmul(SC,BSC)
|
||||
deallocate(SC, BSC)
|
||||
|
||||
end subroutine
|
||||
|
||||
@ -1,5 +1,8 @@
|
||||
subroutine RCC(dotest,doCCD,dopCCD,doDCD,doCCSD,doCCSDT,dodrCCD,dorCCD,docrCCD,dolCCD, &
|
||||
maxSCF,thresh,max_diis,nBas,nC,nO,nV,nR,ERI,ENuc,ERHF,eHF)
|
||||
|
||||
! ---
|
||||
|
||||
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)
|
||||
|
||||
! Coupled-cluster module
|
||||
|
||||
@ -24,15 +27,18 @@ subroutine RCC(dotest,doCCD,dopCCD,doDCD,doCCSD,doCCSDT,dodrCCD,dorCCD,docrCCD,d
|
||||
integer,intent(in) :: max_diis
|
||||
double precision,intent(in) :: thresh
|
||||
|
||||
integer,intent(in) :: nBas
|
||||
integer,intent(in) :: nBas, nOrb
|
||||
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) :: ERHF
|
||||
double precision,intent(in) :: eHF(nBas)
|
||||
double precision,intent(in) :: ERI(nBas,nBas,nBas,nBas)
|
||||
double precision,intent(in) :: eHF(nOrb)
|
||||
double precision,intent(in) :: cHF(nBas,nOrb)
|
||||
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)
|
||||
|
||||
! Local variables
|
||||
|
||||
@ -45,11 +51,11 @@ subroutine RCC(dotest,doCCD,dopCCD,doDCD,doCCSD,doCCSDT,dodrCCD,dorCCD,docrCCD,d
|
||||
if(doCCD) then
|
||||
|
||||
call wall_time(start_CC)
|
||||
call CCD(dotest,maxSCF,thresh,max_diis,nBas,nC,nO,nV,nR,ERI,ENuc,ERHF,eHF)
|
||||
call CCD(dotest,maxSCF,thresh,max_diis,nOrb,nC,nO,nV,nR,ERI_MO,ENuc,ERHF,eHF)
|
||||
call wall_time(end_CC)
|
||||
|
||||
t_CC = end_CC - start_CC
|
||||
write(*,'(A65,1X,F9.3,A8)') 'Total CPU time for CCD = ',t_CC,' seconds'
|
||||
write(*,'(A65,1X,F9.3,A8)') 'Total wall time for CCD = ',t_CC,' seconds'
|
||||
write(*,*)
|
||||
|
||||
end if
|
||||
@ -61,12 +67,12 @@ subroutine RCC(dotest,doCCD,dopCCD,doDCD,doCCSD,doCCSDT,dodrCCD,dorCCD,docrCCD,d
|
||||
if(doDCD) then
|
||||
|
||||
call wall_time(start_CC)
|
||||
call DCD(dotest,maxSCF,thresh,max_diis,nBas,nC,nO,nV,nR, &
|
||||
ERI,ENuc,ERHF,eHF)
|
||||
call DCD(dotest,maxSCF,thresh,max_diis,nOrb,nC,nO,nV,nR, &
|
||||
ERI_MO,ENuc,ERHF,eHF)
|
||||
call wall_time(end_CC)
|
||||
|
||||
t_CC = end_CC - start_CC
|
||||
write(*,'(A65,1X,F9.3,A8)') 'Total CPU time for DCD = ',t_CC,' seconds'
|
||||
write(*,'(A65,1X,F9.3,A8)') 'Total wall time for DCD = ',t_CC,' seconds'
|
||||
write(*,*)
|
||||
|
||||
end if
|
||||
@ -80,11 +86,11 @@ subroutine RCC(dotest,doCCD,dopCCD,doDCD,doCCSD,doCCSDT,dodrCCD,dorCCD,docrCCD,d
|
||||
if(doCCSD) then
|
||||
|
||||
call wall_time(start_CC)
|
||||
call CCSD(dotest,maxSCF,thresh,max_diis,doCCSDT,nBas,nC,nO,nV,nR,ERI,ENuc,ERHF,eHF)
|
||||
call CCSD(dotest,maxSCF,thresh,max_diis,doCCSDT,nOrb,nC,nO,nV,nR,ERI_MO,ENuc,ERHF,eHF)
|
||||
call wall_time(end_CC)
|
||||
|
||||
t_CC = end_CC - start_CC
|
||||
write(*,'(A65,1X,F9.3,A8)') 'Total CPU time for CCSD or CCSD(T)= ',t_CC,' seconds'
|
||||
write(*,'(A65,1X,F9.3,A8)') 'Total wall time for CCSD or CCSD(T)= ',t_CC,' seconds'
|
||||
write(*,*)
|
||||
|
||||
end if
|
||||
@ -96,11 +102,11 @@ subroutine RCC(dotest,doCCD,dopCCD,doDCD,doCCSD,doCCSDT,dodrCCD,dorCCD,docrCCD,d
|
||||
if(dodrCCD) then
|
||||
|
||||
call wall_time(start_CC)
|
||||
call drCCD(dotest,maxSCF,thresh,max_diis,nBas,nC,nO,nV,nR,ERI,ENuc,ERHF,eHF)
|
||||
call drCCD(dotest,maxSCF,thresh,max_diis,nOrb,nC,nO,nV,nR,ERI_MO,ENuc,ERHF,eHF)
|
||||
call wall_time(end_CC)
|
||||
|
||||
t_CC = end_CC - start_CC
|
||||
write(*,'(A65,1X,F9.3,A8)') 'Total CPU time for direct ring CCD = ',t_CC,' seconds'
|
||||
write(*,'(A65,1X,F9.3,A8)') 'Total wall time for direct ring CCD = ',t_CC,' seconds'
|
||||
write(*,*)
|
||||
|
||||
end if
|
||||
@ -112,11 +118,11 @@ subroutine RCC(dotest,doCCD,dopCCD,doDCD,doCCSD,doCCSDT,dodrCCD,dorCCD,docrCCD,d
|
||||
if(dorCCD) then
|
||||
|
||||
call wall_time(start_CC)
|
||||
call rCCD(dotest,maxSCF,thresh,max_diis,nBas,nC,nO,nV,nR,ERI,ENuc,ERHF,eHF)
|
||||
call rCCD(dotest,maxSCF,thresh,max_diis,nOrb,nC,nO,nV,nR,ERI_MO,ENuc,ERHF,eHF)
|
||||
call wall_time(end_CC)
|
||||
|
||||
t_CC = end_CC - start_CC
|
||||
write(*,'(A65,1X,F9.3,A8)') 'Total CPU time for rCCD = ',t_CC,' seconds'
|
||||
write(*,'(A65,1X,F9.3,A8)') 'Total wall time for rCCD = ',t_CC,' seconds'
|
||||
write(*,*)
|
||||
|
||||
end if
|
||||
@ -128,11 +134,11 @@ subroutine RCC(dotest,doCCD,dopCCD,doDCD,doCCSD,doCCSDT,dodrCCD,dorCCD,docrCCD,d
|
||||
if(docrCCD) then
|
||||
|
||||
call wall_time(start_CC)
|
||||
call crCCD(dotest,maxSCF,thresh,max_diis,nBas,nC,nO,nV,nR,ERI,ENuc,ERHF,eHF)
|
||||
call crCCD(dotest,maxSCF,thresh,max_diis,nOrb,nC,nO,nV,nR,ERI_MO,ENuc,ERHF,eHF)
|
||||
call wall_time(end_CC)
|
||||
|
||||
t_CC = end_CC - start_CC
|
||||
write(*,'(A65,1X,F9.3,A8)') 'Total CPU time for crossed-ring CCD = ',t_CC,' seconds'
|
||||
write(*,'(A65,1X,F9.3,A8)') 'Total wall time for crossed-ring CCD = ',t_CC,' seconds'
|
||||
write(*,*)
|
||||
|
||||
end if
|
||||
@ -144,11 +150,11 @@ subroutine RCC(dotest,doCCD,dopCCD,doDCD,doCCSD,doCCSDT,dodrCCD,dorCCD,docrCCD,d
|
||||
if(dolCCD) then
|
||||
|
||||
call wall_time(start_CC)
|
||||
call lCCD(dotest,maxSCF,thresh,max_diis,nBas,nC,nO,nV,nR,ERI,ENuc,ERHF,eHF)
|
||||
call lCCD(dotest,maxSCF,thresh,max_diis,nOrb,nC,nO,nV,nR,ERI_MO,ENuc,ERHF,eHF)
|
||||
call wall_time(end_CC)
|
||||
|
||||
t_CC = end_CC - start_CC
|
||||
write(*,'(A65,1X,F9.3,A8)') 'Total CPU time for ladder CCD = ',t_CC,' seconds'
|
||||
write(*,'(A65,1X,F9.3,A8)') 'Total wall time for ladder CCD = ',t_CC,' seconds'
|
||||
write(*,*)
|
||||
|
||||
end if
|
||||
@ -160,11 +166,13 @@ subroutine RCC(dotest,doCCD,dopCCD,doDCD,doCCSD,doCCSDT,dodrCCD,dorCCD,docrCCD,d
|
||||
if(dopCCD) then
|
||||
|
||||
call wall_time(start_CC)
|
||||
call pCCD(dotest,maxSCF,thresh,max_diis,nBas,nC,nO,nV,nR,ERI,ENuc,ERHF,eHF)
|
||||
call pCCD(dotest, maxSCF, thresh, max_diis, nBas, nOrb, &
|
||||
nC, nO, nV, nR, Hc, ERI_AO, ENuc, ERHF, eHF, cHF)
|
||||
|
||||
call wall_time(end_CC)
|
||||
|
||||
t_CC = end_CC - start_CC
|
||||
write(*,'(A65,1X,F9.3,A8)') 'Total CPU time for pair CCD = ',t_CC,' seconds'
|
||||
write(*,'(A65,1X,F9.3,A8)') 'Total wall time for pair CCD = ',t_CC,' seconds'
|
||||
write(*,*)
|
||||
|
||||
end if
|
||||
|
||||
820
src/CC/pCCD.f90
820
src/CC/pCCD.f90
@ -1,4 +1,8 @@
|
||||
subroutine pCCD(dotest,maxSCF,thresh,max_diis,nBas,nC,nO,nV,nR,ERI,ENuc,ERHF,eHF)
|
||||
|
||||
! ---
|
||||
|
||||
subroutine pCCD(dotest, maxIt, thresh, max_diis, nBas, nOrb, &
|
||||
nC, nO, nV, nR, Hc, ERI_AO, ENuc, ERHF, eHF, cHF)
|
||||
|
||||
! pair CCD module
|
||||
|
||||
@ -8,22 +12,29 @@ subroutine pCCD(dotest,maxSCF,thresh,max_diis,nBas,nC,nO,nV,nR,ERI,ENuc,ERHF,eHF
|
||||
|
||||
logical,intent(in) :: dotest
|
||||
|
||||
integer,intent(in) :: maxSCF
|
||||
integer,intent(in) :: maxIt
|
||||
integer,intent(in) :: max_diis
|
||||
double precision,intent(in) :: thresh
|
||||
|
||||
integer,intent(in) :: nBas,nC,nO,nV,nR
|
||||
integer,intent(in) :: nBas, nOrb, nC, nO, nV, nR
|
||||
double precision,intent(in) :: ENuc,ERHF
|
||||
double precision,intent(in) :: eHF(nBas)
|
||||
double precision,intent(in) :: ERI(nBas,nBas,nBas,nBas)
|
||||
double precision,intent(in) :: eHF(nOrb)
|
||||
double precision,intent(in) :: cHF(nBas,nOrb)
|
||||
double precision,intent(in) :: Hc(nBas,nBas)
|
||||
double precision,intent(in) :: ERI_AO(nBas,nBas,nBas,nBas)
|
||||
|
||||
! Local variables
|
||||
|
||||
integer :: p,q,r,s,t,u,w
|
||||
integer :: pq,rs
|
||||
integer :: i,j,a,b
|
||||
|
||||
integer :: nSCF
|
||||
double precision :: Conv
|
||||
double precision :: ECC,EcCC
|
||||
integer :: nItAmp
|
||||
integer :: nItOrb
|
||||
double precision :: CvgAmp
|
||||
double precision :: CvgOrb
|
||||
double precision :: ECC
|
||||
double precision :: EcCC
|
||||
|
||||
double precision,allocatable :: eO(:)
|
||||
double precision,allocatable :: eV(:)
|
||||
@ -35,184 +46,697 @@ subroutine pCCD(dotest,maxSCF,thresh,max_diis,nBas,nC,nO,nV,nR,ERI,ENuc,ERHF,eHF
|
||||
double precision,allocatable :: OVVO(:,:)
|
||||
double precision,allocatable :: VVVV(:,:)
|
||||
|
||||
double precision,allocatable :: y(:,:)
|
||||
double precision,allocatable :: yO(:,:)
|
||||
double precision,allocatable :: yV(:,:)
|
||||
|
||||
double precision,allocatable :: r(:,:)
|
||||
double precision,allocatable :: t(:,:)
|
||||
double precision,allocatable :: r2(:,:)
|
||||
double precision,allocatable :: t2(:,:)
|
||||
double precision,allocatable :: z2(:,:)
|
||||
|
||||
double precision,allocatable :: rdm1(:,:)
|
||||
double precision,allocatable :: rdm2(:,:,:,:)
|
||||
double precision,allocatable :: xOO(:,:)
|
||||
double precision,allocatable :: xVV(:,:)
|
||||
double precision,allocatable :: xOV(:,:)
|
||||
double precision :: tr_1rdm
|
||||
double precision :: tr_2rdm
|
||||
|
||||
double precision :: E1,E2
|
||||
double precision,allocatable :: c(:,:)
|
||||
double precision,allocatable :: h(:,:)
|
||||
double precision,allocatable :: ERI_MO(:,:,:,:)
|
||||
double precision,allocatable :: grad(:)
|
||||
double precision,allocatable :: tmp(:,:,:,:)
|
||||
double precision,allocatable :: hess(:,:)
|
||||
double precision,allocatable :: hessInv(:,:)
|
||||
double precision,allocatable :: Kap(:,:)
|
||||
double precision,allocatable :: ExpKap(:,:)
|
||||
|
||||
integer :: O,V,N
|
||||
integer :: n_diis
|
||||
double precision :: rcond
|
||||
double precision,allocatable :: error_diis(:,:)
|
||||
double precision,allocatable :: t_diis(:,:)
|
||||
double precision,allocatable :: err_diis(:,:)
|
||||
double precision,allocatable :: t2_diis(:,:)
|
||||
double precision,allocatable :: z2_diis(:,:)
|
||||
double precision,external :: trace_matrix
|
||||
double precision,external :: Kronecker_delta
|
||||
|
||||
! Hello world
|
||||
|
||||
write(*,*)
|
||||
write(*,*)'**************************************'
|
||||
write(*,*)'| pair CCD calculation |'
|
||||
write(*,*)'**************************************'
|
||||
write(*,*)'*******************************'
|
||||
write(*,*)'* Restricted pCCD Calculation *'
|
||||
write(*,*)'*******************************'
|
||||
write(*,*)
|
||||
|
||||
! Form energy denominator
|
||||
! Useful quantities
|
||||
|
||||
allocate(eO(nO-nC),eV(nV-nR),delta_OV(nO-nC,nV-nR))
|
||||
O = nO - nC
|
||||
V = nV - nR
|
||||
N = O + V ! nOrb - nC - nR
|
||||
|
||||
eO(:) = eHF(nC+1:nO)
|
||||
eV(:) = eHF(nO+1:nBas-nR)
|
||||
!------------------------------------!
|
||||
! Star Loop for orbital optimization !
|
||||
!------------------------------------!
|
||||
|
||||
call form_delta_OV(nC,nO,nV,nR,eO,eV,delta_OV)
|
||||
allocate(ERI_MO(N,N,N,N))
|
||||
allocate(c(nBas,N), h(N,N))
|
||||
allocate(eO(O), eV(V), delta_OV(O,V))
|
||||
allocate(OOOO(O,O), OOVV(O,V), OVOV(O,V), OVVO(O,V), VVVV(V,V))
|
||||
|
||||
! Create integral batches
|
||||
do i = 1, N
|
||||
c(:,i) = cHF(:,nC+i)
|
||||
enddo
|
||||
|
||||
allocate(OOOO(nO-nC,nO-nC),OOVV(nO-nC,nV-nR),OVOV(nO-nC,nV-nR),OVVO(nO-nC,nV-nR),VVVV(nV-nR,nV-nR))
|
||||
CvgOrb = 1d0
|
||||
nItOrb = 0
|
||||
|
||||
do i=1,nO-nC
|
||||
do j=1,nO-nC
|
||||
OOOO(i,j) = ERI(nC+i,nC+i,nC+j,nC+j)
|
||||
end do
|
||||
end do
|
||||
|
||||
do i=1,nO-nC
|
||||
do a=1,nV-nR
|
||||
OOVV(i,a) = ERI(nC+i,nC+i,nO+a,nO+a)
|
||||
OVOV(i,a) = ERI(nC+i,nO+a,nC+i,nO+a)
|
||||
OVVO(i,a) = ERI(nC+i,nO+a,nO+a,nC+i)
|
||||
end do
|
||||
end do
|
||||
|
||||
do a=1,nV-nR
|
||||
do b=1,nV-nR
|
||||
VVVV(a,b) = ERI(nO+a,nO+a,nO+b,nO+b)
|
||||
end do
|
||||
end do
|
||||
|
||||
! MP2 guess amplitudes
|
||||
|
||||
allocate(t(nO-nC,nV-nR))
|
||||
|
||||
t(:,:) = -0.5d0*OOVV(:,:)/delta_OV(:,:)
|
||||
|
||||
EcCC = 0d0
|
||||
do i=1,nO-nC
|
||||
do a=1,nV-nR
|
||||
EcCC = EcCC + OOVV(i,a)*t(i,a)
|
||||
end do
|
||||
end do
|
||||
|
||||
! Memory allocation for DIIS
|
||||
|
||||
allocate(error_diis((nO-nC)*(nV-nR),max_diis),t_diis((nO-nC)*(nV-nR),max_diis))
|
||||
|
||||
! Initialization
|
||||
|
||||
allocate(r(nO-nC,nV-nR),y(nO-nC,nO-nC))
|
||||
|
||||
Conv = 1d0
|
||||
nSCF = 0
|
||||
|
||||
n_diis = 0
|
||||
t_diis(:,:) = 0d0
|
||||
error_diis(:,:) = 0d0
|
||||
|
||||
!------------------------------------------------------------------------
|
||||
! Main SCF loop
|
||||
!------------------------------------------------------------------------
|
||||
write(*,*)
|
||||
write(*,*)'----------------------------------------------------'
|
||||
write(*,*)'| pair CCD calculation |'
|
||||
write(*,*)'----------------------------------------------------'
|
||||
write(*,'(1X,A1,1X,A3,1X,A1,1X,A16,1X,A1,1X,A10,1X,A1,1X,A10,1X,A1,1X)') &
|
||||
'|','#','|','E(pCCD)','|','Ec(pCCD)','|','Conv','|'
|
||||
write(*,*)'| Orbital Optimization for pCCD |'
|
||||
write(*,*)'----------------------------------------------------'
|
||||
|
||||
do while(Conv > thresh .and. nSCF < maxSCF)
|
||||
do while(CvgOrb > thresh .and. nItOrb < 1)
|
||||
|
||||
! Increment
|
||||
nItOrb = nItOrb + 1
|
||||
|
||||
nSCF = nSCF + 1
|
||||
! Transform integrals
|
||||
|
||||
! Form intermediate array
|
||||
|
||||
y(:,:) = 0d0
|
||||
do i=1,nO-nC
|
||||
do j=1,nO-nC
|
||||
do b=1,nV-nR
|
||||
y(i,j) = y(i,j) + OOVV(j,b)*t(i,b)
|
||||
end do
|
||||
end do
|
||||
end do
|
||||
|
||||
! Compute residual
|
||||
h = matmul(transpose(c), matmul(Hc, c))
|
||||
|
||||
do i=1,nO-nC
|
||||
do a=1,nV-nR
|
||||
call AOtoMO_ERI_RHF(nBas, N, c(1,1), ERI_AO(1,1,1,1), ERI_MO(1,1,1,1))
|
||||
|
||||
r(i,a) = OOVV(i,a) + 2d0*delta_OV(i,a)*t(i,a) &
|
||||
- 2d0*(2d0*OVOV(i,a) - OVVO(i,a) - OOVV(i,a)*t(i,a))*t(i,a)
|
||||
! Form energy denominator
|
||||
|
||||
do j=1,nO-nC
|
||||
r(i,a) = r(i,a) - 2d0*OOVV(j,a)*t(j,a)*t(i,a) + OOOO(j,i)*t(j,a) + y(i,j)*t(j,a)
|
||||
end do
|
||||
|
||||
do b=1,nV-nR
|
||||
r(i,a) = r(i,a) - 2d0*OOVV(i,b)*t(i,b)*t(i,a) + VVVV(a,b)*t(i,b)
|
||||
end do
|
||||
eO(:) = eHF(nC+1:nO)
|
||||
eV(:) = eHF(nO+1:nOrb-nR)
|
||||
|
||||
do i=1,O
|
||||
do a=1,V
|
||||
delta_OV(i,a) = eV(a) - eO(i)
|
||||
end do
|
||||
end do
|
||||
|
||||
! Check convergence
|
||||
! Create integral batches
|
||||
|
||||
Conv = maxval(abs(r(:,:)))
|
||||
do i=1,O
|
||||
do j=1,O
|
||||
OOOO(i,j) = ERI_MO(i,i,j,j)
|
||||
end do
|
||||
end do
|
||||
|
||||
do i=1,O
|
||||
do a=1,V
|
||||
OOVV(i,a) = ERI_MO(i,i,O+a,O+a)
|
||||
OVOV(i,a) = ERI_MO(i,O+a,i,O+a)
|
||||
OVVO(i,a) = ERI_MO(i,O+a,O+a,i)
|
||||
end do
|
||||
end do
|
||||
|
||||
do a=1,V
|
||||
do b=1,V
|
||||
VVVV(a,b) = ERI_MO(O+a,O+a,O+b,O+b)
|
||||
end do
|
||||
end do
|
||||
|
||||
!----------------------------!
|
||||
! Star Loop for t amplitudes !
|
||||
!----------------------------!
|
||||
|
||||
allocate(t2(O,V),r2(O,V),yO(O,O))
|
||||
allocate(err_diis(O*V,max_diis),t2_diis(O*V,max_diis))
|
||||
|
||||
CvgAmp = 1d0
|
||||
nItAmp = 0
|
||||
ECC = ERHF
|
||||
EcCC = 0d0
|
||||
|
||||
n_diis = 0
|
||||
t2(:,:) = 0d0
|
||||
t2_diis(:,:) = 0d0
|
||||
err_diis(:,:) = 0d0
|
||||
|
||||
write(*,*)
|
||||
write(*,*)'----------------------------------------------------'
|
||||
write(*,*)'| pCCD calculation: t amplitudes |'
|
||||
write(*,*)'----------------------------------------------------'
|
||||
write(*,'(1X,A1,1X,A3,1X,A1,1X,A16,1X,A1,1X,A10,1X,A1,1X,A10,1X,A1,1X)') &
|
||||
'|','#','|','E(pCCD)','|','Ec(pCCD)','|','Conv','|'
|
||||
write(*,*)'----------------------------------------------------'
|
||||
|
||||
do while(CvgAmp > thresh .and. nItAmp < maxIt)
|
||||
|
||||
! Increment
|
||||
|
||||
nItAmp = nItAmp + 1
|
||||
|
||||
! Form intermediate array
|
||||
|
||||
yO(:,:) = matmul(t2,transpose(OOVV))
|
||||
|
||||
! Compute residual
|
||||
|
||||
r2(:,:) = OOVV(:,:) + 2d0*delta_OV(:,:)*t2(:,:) &
|
||||
- 2d0*(2d0*OVOV(:,:) - OVVO(:,:) - OOVV(:,:)*t2(:,:))*t2(:,:)
|
||||
|
||||
do i=1,O
|
||||
do a=1,V
|
||||
|
||||
do j=1,O
|
||||
r2(i,a) = r2(i,a) - 2d0*OOVV(j,a)*t2(j,a)*t2(i,a) + OOOO(j,i)*t2(j,a) + yO(i,j)*t2(j,a)
|
||||
end do
|
||||
|
||||
do b=1,V
|
||||
r2(i,a) = r2(i,a) - 2d0*OOVV(i,b)*t2(i,b)*t2(i,a) + VVVV(a,b)*t2(i,b)
|
||||
end do
|
||||
|
||||
end do
|
||||
end do
|
||||
|
||||
! Check convergence
|
||||
|
||||
CvgAmp = maxval(abs(r2(:,:)))
|
||||
|
||||
! Update amplitudes
|
||||
|
||||
t2(:,:) = t2(:,:) - 0.5d0*r2(:,:)/delta_OV(:,:)
|
||||
|
||||
! Compute correlation energy
|
||||
|
||||
EcCC = 0d0
|
||||
do i=1,O
|
||||
do a=1,V
|
||||
EcCC = EcCC + OOVV(i,a)*t2(i,a)
|
||||
end do
|
||||
end do
|
||||
|
||||
! Dump results
|
||||
|
||||
ECC = ERHF + EcCC
|
||||
|
||||
! DIIS extrapolation
|
||||
|
||||
if(max_diis > 1) then
|
||||
|
||||
n_diis = min(n_diis+1,max_diis)
|
||||
call DIIS_extrapolation(rcond,nO*nV,nO*nV,n_diis,err_diis,t2_diis,-0.5d0*r2/delta_OV,t2)
|
||||
|
||||
end if
|
||||
|
||||
write(*,'(1X,A1,1X,I3,1X,A1,1X,F16.10,1X,A1,1X,F10.6,1X,A1,1X,F10.6,1X,A1,1X)') &
|
||||
'|',nItAmp,'|',ECC+ENuc,'|',EcCC,'|',CvgAmp,'|'
|
||||
|
||||
end do
|
||||
write(*,*)'----------------------------------------------------'
|
||||
|
||||
!---------------------------!
|
||||
! End Loop for t amplitudes !
|
||||
!---------------------------!
|
||||
|
||||
deallocate(r2,yO)
|
||||
deallocate(err_diis,t2_diis)
|
||||
|
||||
! Did it actually converge?
|
||||
|
||||
if(nItAmp == maxIt) then
|
||||
|
||||
write(*,*)
|
||||
write(*,*)'!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!'
|
||||
write(*,*)'! Convergence failed for t ampitudes !'
|
||||
write(*,*)'!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!'
|
||||
|
||||
stop
|
||||
|
||||
! Update amplitudes
|
||||
end if
|
||||
|
||||
!-----------------------------!
|
||||
! Start Loop for z amplitudes !
|
||||
!-----------------------------!
|
||||
|
||||
allocate(z2(O,V),r2(O,V),yO(O,O),yV(V,V))
|
||||
allocate(err_diis(O*V,max_diis),z2_diis(O*V,max_diis))
|
||||
|
||||
t(:,:) = t(:,:) - 0.5d0*r(:,:)/delta_OV(:,:)
|
||||
|
||||
! Compute correlation energy
|
||||
|
||||
EcCC = 0d0
|
||||
do i=1,nO-nC
|
||||
do a=1,nV-nR
|
||||
EcCC = EcCC + OOVV(i,a)*t(i,a)
|
||||
end do
|
||||
end do
|
||||
|
||||
! Dump results
|
||||
|
||||
ECC = ERHF + EcCC
|
||||
|
||||
! DIIS extrapolation
|
||||
|
||||
! n_diis = min(n_diis+1,max_diis)
|
||||
! call DIIS_extrapolation(rcond,nO*nV,nO*nV,n_diis,error_diis,t_diis,-0.5d0*r/delta_OV,t)
|
||||
|
||||
! Reset DIIS if required
|
||||
|
||||
! if(abs(rcond) < 1d-15) n_diis = 0
|
||||
|
||||
write(*,'(1X,A1,1X,I3,1X,A1,1X,F16.10,1X,A1,1X,F10.6,1X,A1,1X,F10.6,1X,A1,1X)') &
|
||||
'|',nSCF,'|',ECC+ENuc,'|',EcCC,'|',Conv,'|'
|
||||
|
||||
end do
|
||||
write(*,*)'----------------------------------------------------'
|
||||
!------------------------------------------------------------------------
|
||||
! End of SCF loop
|
||||
!------------------------------------------------------------------------
|
||||
|
||||
! Did it actually converge?
|
||||
|
||||
if(nSCF == maxSCF) then
|
||||
CvgAmp = 1d0
|
||||
nItAmp = 0
|
||||
|
||||
n_diis = 0
|
||||
z2_diis(:,:) = 0d0
|
||||
err_diis(:,:) = 0d0
|
||||
|
||||
write(*,*)
|
||||
write(*,*)'!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!'
|
||||
write(*,*)' Convergence failed '
|
||||
write(*,*)'!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!'
|
||||
write(*,*)'----------------------------------------------------'
|
||||
write(*,*)'| pCCD calculation: z amplitudes |'
|
||||
write(*,*)'----------------------------------------------------'
|
||||
write(*,'(1X,A1,1X,A3,1X,A1,1X,A16,1X,A1,1X,A10,1X,A1,1X,A10,1X,A1,1X)') &
|
||||
'|','#','|','E(pCCD)','|','Ec(pCCD)','|','Conv','|'
|
||||
write(*,*)'----------------------------------------------------'
|
||||
|
||||
do while(CvgAmp > thresh .and. nItAmp < maxIt)
|
||||
|
||||
! Increment
|
||||
|
||||
nItAmp = nItAmp + 1
|
||||
|
||||
! Form intermediate array
|
||||
|
||||
yO(:,:) = matmul(OOVV,transpose(t2))
|
||||
yV(:,:) = matmul(transpose(OOVV),t2)
|
||||
|
||||
! Compute residual
|
||||
|
||||
r2(:,:) = OOVV(:,:) + 2d0*delta_OV(:,:)*z2(:,:) &
|
||||
- 2d0*(2d0*OVOV(:,:) - OVVO(:,:) - 2d0*OOVV(:,:)*t2(:,:))*z2(:,:)
|
||||
|
||||
do i=1,O
|
||||
do a=1,V
|
||||
|
||||
do j=1,O
|
||||
r2(i,a) = r2(i,a) - 2d0*OOVV(j,a)*t2(j,a)*z2(i,a) - 2d0*OOVV(i,a)*z2(j,a)*t2(j,a) &
|
||||
+ OOOO(i,j)*z2(j,a) + yO(i,j)*z2(j,a)
|
||||
end do
|
||||
|
||||
do b=1,V
|
||||
r2(i,a) = r2(i,a) - 2d0*OOVV(i,b)*t2(i,b)*z2(i,a) - 2d0*OOVV(i,a)*z2(i,b)*t2(i,b) &
|
||||
+ VVVV(b,a)*z2(i,b) + yV(a,b)*z2(i,b)
|
||||
end do
|
||||
|
||||
end do
|
||||
end do
|
||||
|
||||
! Check convergence
|
||||
|
||||
CvgAmp = maxval(abs(r2(:,:)))
|
||||
|
||||
! Update amplitudes
|
||||
|
||||
z2(:,:) = z2(:,:) - 0.5d0*r2(:,:)/delta_OV(:,:)
|
||||
|
||||
! DIIS extrapolation
|
||||
|
||||
if(max_diis > 1) then
|
||||
|
||||
n_diis = min(n_diis+1,max_diis)
|
||||
call DIIS_extrapolation(rcond,O*V,O*V,n_diis,err_diis,z2_diis,-0.5d0*r2/delta_OV,z2)
|
||||
|
||||
end if
|
||||
|
||||
write(*,'(1X,A1,1X,I3,1X,A1,1X,F16.10,1X,A1,1X,F10.6,1X,A1,1X,F10.6,1X,A1,1X)') &
|
||||
'|',nItAmp,'|',ECC+ENuc,'|',EcCC,'|',CvgAmp,'|'
|
||||
|
||||
end do
|
||||
write(*,*)'----------------------------------------------------'
|
||||
write(*,*)
|
||||
|
||||
stop
|
||||
!---------------------------!
|
||||
! End Loop for z ampltiudes !
|
||||
!---------------------------!
|
||||
|
||||
end if
|
||||
deallocate(r2,yO,yV)
|
||||
deallocate(err_diis,z2_diis)
|
||||
|
||||
! Did it actually converge?
|
||||
|
||||
if(nItAmp == maxIt) then
|
||||
|
||||
write(*,*)
|
||||
write(*,*)'!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!'
|
||||
write(*,*)'! Convergence failed for z ampltiudes !'
|
||||
write(*,*)'!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!'
|
||||
|
||||
stop
|
||||
|
||||
end if
|
||||
|
||||
!--------------------------!
|
||||
! Compute density matrices !
|
||||
!--------------------------!
|
||||
|
||||
allocate(rdm1(N,N),rdm2(N,N,N,N))
|
||||
allocate(xOO(O,O),xVV(V,V),xOV(O,V))
|
||||
|
||||
xOO(:,:) = matmul(t2,transpose(z2))
|
||||
xVV(:,:) = matmul(transpose(z2),t2)
|
||||
xOV(:,:) = matmul(t2,matmul(transpose(z2),t2))
|
||||
|
||||
! Form 1RDM
|
||||
|
||||
rdm1(:,:) = 0d0
|
||||
|
||||
do i=1,O
|
||||
rdm1(i,i) = 2d0*(1d0 - xOO(i,i))
|
||||
end do
|
||||
|
||||
do a=1,V
|
||||
rdm1(O+a,O+a) = 2d0*xVV(a,a)
|
||||
end do
|
||||
|
||||
! Check 1RDM
|
||||
|
||||
tr_1rdm = trace_matrix(N,rdm1)
|
||||
write(*,'(A25,F16.10)') ' --> Trace of the 1RDM = ',tr_1rdm
|
||||
|
||||
if( abs(dble(2*O) - tr_1rdm) > thresh ) &
|
||||
write(*,*) ' !!! Your 1RDM seems broken !!! '
|
||||
write(*,*)
|
||||
|
||||
! write(*,*) '1RDM is diagonal at the pCCD level:'
|
||||
! call matout(N,N,rdm1)
|
||||
|
||||
! Form 2RM
|
||||
|
||||
rdm2(:,:,:,:) = 0d0
|
||||
|
||||
! iijj
|
||||
|
||||
do i=1,O
|
||||
do j=1,O
|
||||
rdm2(i,i,j,j) = 2d0*xOO(i,j)
|
||||
end do
|
||||
end do
|
||||
|
||||
! iiaa
|
||||
|
||||
do i=1,O
|
||||
do a=1,V
|
||||
rdm2(i,i,O+a,O+a) = 2d0*(t2(i,a) + xOV(i,a) - 2d0*t2(i,a)*(xVV(a,a) + xOO(i,i) - t2(i,a)*z2(i,a)))
|
||||
end do
|
||||
end do
|
||||
|
||||
! aaii
|
||||
|
||||
do i=1,O
|
||||
do a=1,V
|
||||
rdm2(O+a,O+a,i,i) = 2d0*z2(i,a)
|
||||
end do
|
||||
end do
|
||||
|
||||
! aabb
|
||||
|
||||
do a=1,V
|
||||
do b=1,V
|
||||
rdm2(O+a,O+a,O+b,O+b) = 2d0*xVV(a,b)
|
||||
end do
|
||||
end do
|
||||
|
||||
! ijij
|
||||
|
||||
do i=1,O
|
||||
do j=1,O
|
||||
rdm2(i,j,i,j) = 4d0*(1d0 - xOO(i,i) - xOO(j,j))
|
||||
end do
|
||||
end do
|
||||
|
||||
! ijji
|
||||
|
||||
do i=1,O
|
||||
do j=1,O
|
||||
rdm2(i,j,j,i) = - 2d0*(1d0 - xOO(i,i) - xOO(j,j))
|
||||
end do
|
||||
end do
|
||||
|
||||
! iiii
|
||||
|
||||
do i=1,O
|
||||
rdm2(i,i,i,i) = 2d0*(1d0 - xOO(i,i))
|
||||
end do
|
||||
|
||||
! iaia
|
||||
|
||||
do i=1,O
|
||||
do a=1,V
|
||||
rdm2(i,O+a,i,O+a) = 4d0*(xVV(a,a) - t2(i,a)*z2(i,a))
|
||||
end do
|
||||
end do
|
||||
|
||||
! iaai
|
||||
|
||||
do i=1,O
|
||||
do a=1,V
|
||||
rdm2(i,O+a,O+a,i) = - 2d0*(xVV(a,a) - t2(i,a)*z2(i,a))
|
||||
end do
|
||||
end do
|
||||
|
||||
! aiai
|
||||
|
||||
do i=1,O
|
||||
do a=1,V
|
||||
rdm2(O+a,i,O+a,i) = 4d0*(xVV(a,a) - t2(i,a)*z2(i,a))
|
||||
end do
|
||||
end do
|
||||
|
||||
! aiia
|
||||
|
||||
do i=1,O
|
||||
do a=1,V
|
||||
rdm2(O+a,i,i,O+a) = - 2d0*(xVV(a,a) - t2(i,a)*z2(i,a))
|
||||
end do
|
||||
end do
|
||||
|
||||
! abab
|
||||
|
||||
do a=1,V
|
||||
rdm2(O+a,O+a,O+a,O+a) = 2d0*xVV(a,a)
|
||||
end do
|
||||
|
||||
! Check 2RDM
|
||||
|
||||
tr_2rdm = trace_matrix(N**2,rdm2)
|
||||
write(*,'(A25,F16.10)') ' --> Trace of the 2RDM = ',tr_2rdm
|
||||
|
||||
if( abs(dble(2*O*(2*O-1)) - tr_2rdm) > thresh ) &
|
||||
write(*,*) ' !!! Your 2RDM seems broken !!! '
|
||||
write(*,*)
|
||||
|
||||
! write(*,*) '2RDM is not diagonal at the pCCD level:'
|
||||
! call matout(N**2,N**2,rdm2)
|
||||
|
||||
deallocate(xOO,xVV,xOV)
|
||||
deallocate(t2,z2)
|
||||
|
||||
! Compute electronic energy
|
||||
|
||||
E1 = 0d0
|
||||
E2 = 0d0
|
||||
|
||||
do p=1,N
|
||||
do q=1,N
|
||||
E1 = E1 + rdm1(p,q)*h(p,q)
|
||||
do r=1,N
|
||||
do s=1,N
|
||||
E2 = E2 + rdm2(p,q,r,s)*ERI_MO(p,q,r,s)
|
||||
end do
|
||||
end do
|
||||
end do
|
||||
end do
|
||||
|
||||
E2 = 0.5d0*E2
|
||||
|
||||
write(*,'(A25,F16.10)') ' One-electron energy = ',E1
|
||||
write(*,'(A25,F16.10)') ' Two-electron energy = ',E2
|
||||
write(*,'(A25,F16.10)') ' Electronic energy = ',E1 + E2
|
||||
write(*,'(A25,F16.10)') ' Total energy = ',E1 + E2 + ENuc
|
||||
write(*,*)
|
||||
|
||||
!--------------------------!
|
||||
! Compute orbital gradient !
|
||||
!--------------------------!
|
||||
|
||||
allocate(grad(N**2))
|
||||
|
||||
grad(:) = 0d0
|
||||
|
||||
pq = 0
|
||||
do p=1,N
|
||||
do q=1,N
|
||||
|
||||
pq = pq + 1
|
||||
|
||||
do r=1,N
|
||||
grad(pq) = grad(pq) + h(r,p)*rdm1(r,q) - h(q,r)*rdm1(p,r)
|
||||
end do
|
||||
|
||||
do r=1,N
|
||||
do s=1,N
|
||||
do t=1,N
|
||||
grad(pq) = grad(pq) + (ERI_MO(r,s,p,t)*rdm2(r,s,q,t) - ERI_MO(q,t,r,s)*rdm2(p,t,r,s))
|
||||
end do
|
||||
end do
|
||||
end do
|
||||
|
||||
end do
|
||||
end do
|
||||
|
||||
write(*,*) 'Orbital gradient at the pCCD level:'
|
||||
call matout(N,N,grad)
|
||||
write(*,*)
|
||||
|
||||
! Check convergence of orbital optimization
|
||||
|
||||
CvgOrb = maxval(abs(grad))
|
||||
write(*,*) ' Iteration',nItOrb,'for pCCD orbital optimization'
|
||||
write(*,*) ' Convergence of orbital gradient = ',CvgOrb
|
||||
write(*,*)
|
||||
|
||||
!-------------------------!
|
||||
! Compute orbital Hessian !
|
||||
!-------------------------!
|
||||
|
||||
allocate(hess(N**2,N**2),tmp(N,N,N,N))
|
||||
|
||||
tmp(:,:,:,:) = 0d0
|
||||
|
||||
do p=1,N
|
||||
do q=1,N
|
||||
|
||||
do r=1,N
|
||||
do s=1,N
|
||||
|
||||
tmp(p,q,r,s) = - h(s,p)*rdm1(r,q) - h(q,r)*rdm1(p,s)
|
||||
|
||||
do u=1,N
|
||||
|
||||
tmp(p,q,r,s) = tmp(p,q,r,s) + 0.5d0*( &
|
||||
Kronecker_delta(q,r)*(h(u,p)*rdm1(u,s) + h(s,u)*rdm1(p,u)) &
|
||||
+ Kronecker_delta(p,s)*(h(u,r)*rdm1(u,q) + h(q,u)*rdm1(r,u)) )
|
||||
|
||||
end do
|
||||
|
||||
do u=1,N
|
||||
do w=1,N
|
||||
|
||||
tmp(p,q,r,s) = tmp(p,q,r,s) + ERI_MO(u,w,p,r)*rdm2(u,w,q,s) + ERI_MO(q,s,u,w)*rdm2(p,r,u,w)
|
||||
|
||||
end do
|
||||
end do
|
||||
|
||||
do t=1,N
|
||||
do u=1,N
|
||||
|
||||
tmp(p,q,r,s) = tmp(p,q,r,s) - ( &
|
||||
ERI_MO(s,t,p,u)*rdm2(r,t,q,u) + ERI_MO(t,s,p,u)*rdm2(t,r,q,u) &
|
||||
+ ERI_MO(q,u,r,t)*rdm2(p,u,s,t) + ERI_MO(q,u,t,r)*rdm2(p,u,t,s) )
|
||||
|
||||
end do
|
||||
end do
|
||||
|
||||
do t=1,N
|
||||
do u=1,N
|
||||
do w=1,N
|
||||
|
||||
tmp(p,q,r,s) = tmp(p,q,r,s) + 0.5d0*( &
|
||||
Kronecker_delta(q,r)*(ERI_MO(u,w,p,t)*rdm2(u,w,s,t) + ERI_MO(s,t,u,w)*rdm2(p,t,u,w)) &
|
||||
+ Kronecker_delta(p,s)*(ERI_MO(q,t,u,w)*rdm2(r,t,u,w) + ERI_MO(u,w,r,t)*rdm2(u,w,q,t)) )
|
||||
|
||||
end do
|
||||
end do
|
||||
end do
|
||||
|
||||
end do
|
||||
end do
|
||||
|
||||
end do
|
||||
end do
|
||||
|
||||
! Flatten Hessian matrix and add permutations
|
||||
|
||||
pq = 0
|
||||
do p=1,N
|
||||
do q=1,N
|
||||
|
||||
pq = pq + 1
|
||||
|
||||
rs = 0
|
||||
do r=1,N
|
||||
do s=1,N
|
||||
|
||||
rs = rs + 1
|
||||
|
||||
hess(pq,rs) = tmp(p,r,q,s) - tmp(r,p,q,s) - tmp(p,r,s,q) + tmp(r,p,s,q)
|
||||
!! hess(pq,rs) = tmp(p,q,r,s) - tmp(q,p,r,s) - tmp(p,q,s,r) + tmp(q,p,s,r)
|
||||
|
||||
end do
|
||||
end do
|
||||
|
||||
end do
|
||||
end do
|
||||
|
||||
deallocate(rdm1,rdm2,tmp)
|
||||
|
||||
allocate(hessInv(N**2,N**2))
|
||||
|
||||
call inverse_matrix(N**2,hess,hessInv)
|
||||
|
||||
deallocate(hess)
|
||||
|
||||
allocate(Kap(N,N))
|
||||
|
||||
Kap(:,:) = 0d0
|
||||
|
||||
pq = 0
|
||||
do p=1,N
|
||||
do q=1,N
|
||||
|
||||
pq = pq + 1
|
||||
|
||||
rs = 0
|
||||
do r=1,N
|
||||
do s=1,N
|
||||
|
||||
rs = rs + 1
|
||||
|
||||
Kap(p,q) = Kap(p,q) - hessInv(pq,rs)*grad(rs)
|
||||
|
||||
end do
|
||||
end do
|
||||
|
||||
end do
|
||||
end do
|
||||
|
||||
deallocate(hessInv,grad)
|
||||
|
||||
write(*,*) 'kappa'
|
||||
call matout(N,N,Kap)
|
||||
write(*,*)
|
||||
|
||||
allocate(ExpKap(N,N))
|
||||
call matrix_exponential(N,Kap,ExpKap)
|
||||
deallocate(Kap)
|
||||
|
||||
write(*,*) 'e^kappa'
|
||||
call matout(N, N, ExpKap)
|
||||
write(*,*)
|
||||
|
||||
write(*,*) 'Old orbitals'
|
||||
call matout(nBas, N, c)
|
||||
write(*,*)
|
||||
|
||||
c = matmul(c, ExpKap)
|
||||
deallocate(ExpKap)
|
||||
|
||||
write(*,*) 'Rotated orbitals'
|
||||
call matout(nBas, N, c)
|
||||
write(*,*)
|
||||
|
||||
end do
|
||||
|
||||
!-----------------------------------!
|
||||
! End Loop for orbital optimization !
|
||||
!-----------------------------------!
|
||||
|
||||
! Did it actually converge?
|
||||
|
||||
if(nItOrb == maxIt) then
|
||||
|
||||
write(*,*)
|
||||
write(*,*)'!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!'
|
||||
write(*,*)'! Convergence failed for orbital optimization !'
|
||||
write(*,*)'!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!'
|
||||
|
||||
stop
|
||||
|
||||
end if
|
||||
|
||||
! Testing zone
|
||||
|
||||
if(dotest) then
|
||||
|
||||
|
||||
@ -1,5 +1,8 @@
|
||||
subroutine RCI(dotest,doCIS,doCIS_D,doCID,doCISD,doFCI,singlet,triplet,nBas,nC,nO,nV,nR,nS,ERI,dipole_int, &
|
||||
epsHF,EHF,cHF,S)
|
||||
|
||||
! ---
|
||||
|
||||
subroutine RCI(dotest, doCIS, doCIS_D, doCID, doCISD, doFCI, singlet, triplet, nOrb, &
|
||||
nC, nO, nV, nR, nS, ERI, dipole_int, epsHF, EHF)
|
||||
|
||||
! Configuration interaction module
|
||||
|
||||
@ -18,18 +21,16 @@ subroutine RCI(dotest,doCIS,doCIS_D,doCID,doCISD,doFCI,singlet,triplet,nBas,nC,n
|
||||
|
||||
logical,intent(in) :: singlet
|
||||
logical,intent(in) :: triplet
|
||||
integer,intent(in) :: nBas
|
||||
integer,intent(in) :: nOrb
|
||||
integer,intent(in) :: nC
|
||||
integer,intent(in) :: nO
|
||||
integer,intent(in) :: nV
|
||||
integer,intent(in) :: nR
|
||||
integer,intent(in) :: nS
|
||||
double precision,intent(in) :: EHF
|
||||
double precision,intent(in) :: epsHF(nBas)
|
||||
double precision,intent(in) :: cHF(nBas,nBas)
|
||||
double precision,intent(in) :: S(nBas,nBas)
|
||||
double precision,intent(in) :: ERI(nBas,nBas,nBas,nBas)
|
||||
double precision,intent(in) :: dipole_int(nBas,nBas,ncart)
|
||||
double precision,intent(in) :: epsHF(nOrb)
|
||||
double precision,intent(in) :: ERI(nOrb,nOrb,nOrb,nOrb)
|
||||
double precision,intent(in) :: dipole_int(nOrb,nOrb,ncart)
|
||||
|
||||
! Local variables
|
||||
|
||||
@ -42,11 +43,11 @@ subroutine RCI(dotest,doCIS,doCIS_D,doCID,doCISD,doFCI,singlet,triplet,nBas,nC,n
|
||||
if(doCIS) then
|
||||
|
||||
call wall_time(start_CI)
|
||||
call RCIS(dotest,singlet,triplet,doCIS_D,nBas,nC,nO,nV,nR,nS,ERI,dipole_int,epsHF)
|
||||
call RCIS(dotest,singlet,triplet,doCIS_D,nOrb,nC,nO,nV,nR,nS,ERI,dipole_int,epsHF)
|
||||
call wall_time(end_CI)
|
||||
|
||||
t_CI = end_CI - start_CI
|
||||
write(*,'(A65,1X,F9.3,A8)') 'Total CPU time for CIS = ',t_CI,' seconds'
|
||||
write(*,'(A65,1X,F9.3,A8)') 'Total wall time for CIS = ',t_CI,' seconds'
|
||||
write(*,*)
|
||||
|
||||
end if
|
||||
@ -58,11 +59,11 @@ subroutine RCI(dotest,doCIS,doCIS_D,doCID,doCISD,doFCI,singlet,triplet,nBas,nC,n
|
||||
if(doCID) then
|
||||
|
||||
call wall_time(start_CI)
|
||||
call CID(dotest,singlet,triplet,nBas,nC,nO,nV,nR,ERI,epsHF,EHF)
|
||||
call CID(dotest,singlet,triplet,nOrb,nC,nO,nV,nR,ERI,epsHF,EHF)
|
||||
call wall_time(end_CI)
|
||||
|
||||
t_CI = end_CI - start_CI
|
||||
write(*,'(A65,1X,F9.3,A8)') 'Total CPU time for CID = ',t_CI,' seconds'
|
||||
write(*,'(A65,1X,F9.3,A8)') 'Total wall time for CID = ',t_CI,' seconds'
|
||||
write(*,*)
|
||||
|
||||
end if
|
||||
@ -74,11 +75,11 @@ subroutine RCI(dotest,doCIS,doCIS_D,doCID,doCISD,doFCI,singlet,triplet,nBas,nC,n
|
||||
if(doCISD) then
|
||||
|
||||
call wall_time(start_CI)
|
||||
call CISD(dotest,singlet,triplet,nBas,nC,nO,nV,nR,ERI,epsHF,EHF)
|
||||
call CISD(dotest,singlet,triplet,nOrb,nC,nO,nV,nR,ERI,epsHF,EHF)
|
||||
call wall_time(end_CI)
|
||||
|
||||
t_CI = end_CI - start_CI
|
||||
write(*,'(A65,1X,F9.3,A8)') 'Total CPU time for CISD = ',t_CI,' seconds'
|
||||
write(*,'(A65,1X,F9.3,A8)') 'Total wall time for CISD = ',t_CI,' seconds'
|
||||
write(*,*)
|
||||
|
||||
end if
|
||||
@ -91,11 +92,11 @@ subroutine RCI(dotest,doCIS,doCIS_D,doCID,doCISD,doFCI,singlet,triplet,nBas,nC,n
|
||||
|
||||
call wall_time(start_CI)
|
||||
write(*,*) ' FCI is not yet implemented! Sorry.'
|
||||
! call FCI(nBas,nC,nO,nV,nR,ERI,epsHF)
|
||||
! call FCI(nOrb,nC,nO,nV,nR,ERI,epsHF)
|
||||
call wall_time(end_CI)
|
||||
|
||||
t_CI = end_CI - start_CI
|
||||
write(*,'(A65,1X,F9.3,A8)') 'Total CPU time for FCI = ',t_CI,' seconds'
|
||||
write(*,'(A65,1X,F9.3,A8)') 'Total wall time for FCI = ',t_CI,' seconds'
|
||||
write(*,*)
|
||||
|
||||
end if
|
||||
|
||||
@ -41,7 +41,7 @@ subroutine RCIS(dotest,singlet,triplet,doCIS_D,nBas,nC,nO,nV,nR,nS,ERI,dipole_in
|
||||
|
||||
! Memory allocation
|
||||
|
||||
allocate(A(nS,nS),Om(nS))
|
||||
allocate(A(nS,nS), Om(nS))
|
||||
|
||||
! Compute CIS matrix
|
||||
|
||||
@ -117,4 +117,6 @@ subroutine RCIS(dotest,singlet,triplet,doCIS_D,nBas,nC,nO,nV,nR,nS,ERI,dipole_in
|
||||
|
||||
end if
|
||||
|
||||
deallocate(A, Om)
|
||||
|
||||
end subroutine
|
||||
|
||||
@ -51,7 +51,7 @@ subroutine RG0F2(dotest,dophBSE,doppBSE,TDA,dBSE,dTDA,singlet,triplet,linearize,
|
||||
|
||||
! Memory allocation
|
||||
|
||||
allocate(SigC(nBas),Z(nBas),eGFlin(nBas),eGF(nBas))
|
||||
allocate(SigC(nBas), Z(nBas), eGFlin(nBas), eGF(nBas))
|
||||
|
||||
! Frequency-dependent second-order contribution
|
||||
|
||||
@ -133,4 +133,6 @@ subroutine RG0F2(dotest,dophBSE,doppBSE,TDA,dBSE,dTDA,singlet,triplet,linearize,
|
||||
|
||||
end if
|
||||
|
||||
deallocate(SigC, Z, eGFlin, eGF)
|
||||
|
||||
end subroutine
|
||||
|
||||
@ -1,7 +1,10 @@
|
||||
subroutine RGF(dotest,doG0F2,doevGF2,doqsGF2,doufG0F02,doG0F3,doevGF3,renorm,maxSCF,thresh,max_diis, &
|
||||
dophBSE,doppBSE,TDA,dBSE,dTDA,singlet,triplet,linearize,eta,regularize, &
|
||||
nNuc,ZNuc,rNuc,ENuc,nBas,nC,nO,nV,nR,nS,EHF,S,X,T,V,Hc,ERI_AO,ERI, &
|
||||
dipole_int_AO,dipole_int,PHF,cHF,epsHF)
|
||||
|
||||
! ---
|
||||
|
||||
subroutine RGF(dotest, doG0F2, doevGF2, doqsGF2, doufG0F02, doG0F3, doevGF3, renorm, maxSCF, &
|
||||
thresh, max_diis, dophBSE, doppBSE, TDA, dBSE, dTDA, singlet, triplet, linearize, &
|
||||
eta, regularize, nNuc, ZNuc, rNuc, ENuc, nBas, nOrb, nC, nO, nV, nR, nS, EHF, &
|
||||
S, X, T, V, Hc, ERI_AO, ERI_MO, dipole_int_AO, dipole_int_MO, PHF, cHF, epsHF)
|
||||
|
||||
! Green's function module
|
||||
|
||||
@ -39,7 +42,7 @@ subroutine RGF(dotest,doG0F2,doevGF2,doqsGF2,doufG0F02,doG0F3,doevGF3,renorm,max
|
||||
double precision,intent(in) :: rNuc(nNuc,ncart)
|
||||
double precision,intent(in) :: ENuc
|
||||
|
||||
integer,intent(in) :: nBas
|
||||
integer,intent(in) :: nBas, nOrb
|
||||
integer,intent(in) :: nC
|
||||
integer,intent(in) :: nO
|
||||
integer,intent(in) :: nV
|
||||
@ -47,18 +50,18 @@ subroutine RGF(dotest,doG0F2,doevGF2,doqsGF2,doufG0F02,doG0F3,doevGF3,renorm,max
|
||||
integer,intent(in) :: nS
|
||||
|
||||
double precision,intent(in) :: EHF
|
||||
double precision,intent(in) :: epsHF(nBas)
|
||||
double precision,intent(in) :: cHF(nBas,nBas)
|
||||
double precision,intent(in) :: epsHF(nOrb)
|
||||
double precision,intent(in) :: cHF(nBas,nOrb)
|
||||
double precision,intent(in) :: PHF(nBas,nBas)
|
||||
double precision,intent(in) :: S(nBas,nBas)
|
||||
double precision,intent(in) :: T(nBas,nBas)
|
||||
double precision,intent(in) :: V(nBas,nBas)
|
||||
double precision,intent(in) :: Hc(nBas,nBas)
|
||||
double precision,intent(in) :: X(nBas,nBas)
|
||||
double precision,intent(in) :: X(nBas,nOrb)
|
||||
double precision,intent(in) :: ERI_AO(nBas,nBas,nBas,nBas)
|
||||
double precision,intent(in) :: ERI(nBas,nBas,nBas,nBas)
|
||||
double precision,intent(in) :: ERI_MO(nOrb,nOrb,nOrb,nOrb)
|
||||
double precision,intent(in) :: dipole_int_AO(nBas,nBas,ncart)
|
||||
double precision,intent(in) :: dipole_int(nBas,nBas,ncart)
|
||||
double precision,intent(in) :: dipole_int_MO(nOrb,nOrb,ncart)
|
||||
|
||||
! Local variables
|
||||
|
||||
@ -71,12 +74,13 @@ subroutine RGF(dotest,doG0F2,doevGF2,doqsGF2,doufG0F02,doG0F3,doevGF3,renorm,max
|
||||
if(doG0F2) then
|
||||
|
||||
call wall_time(start_GF)
|
||||
call RG0F2(dotest,dophBSE,doppBSE,TDA,dBSE,dTDA,singlet,triplet,linearize,eta,regularize, &
|
||||
nBas,nC,nO,nV,nR,nS,ENuc,EHF,ERI,dipole_int,epsHF)
|
||||
call RG0F2(dotest, dophBSE, doppBSE, TDA, dBSE, dTDA, singlet, triplet, &
|
||||
linearize, eta, regularize, nOrb, nC, nO, nV, nR, nS, &
|
||||
ENuc, EHF, ERI_MO, dipole_int_MO, epsHF)
|
||||
call wall_time(end_GF)
|
||||
|
||||
t_GF = end_GF - start_GF
|
||||
write(*,'(A65,1X,F9.3,A8)') 'Total CPU time for GF2 = ',t_GF,' seconds'
|
||||
write(*,'(A65,1X,F9.3,A8)') 'Total wall time for GF2 = ',t_GF,' seconds'
|
||||
write(*,*)
|
||||
|
||||
end if
|
||||
@ -89,12 +93,12 @@ subroutine RGF(dotest,doG0F2,doevGF2,doqsGF2,doufG0F02,doG0F3,doevGF3,renorm,max
|
||||
|
||||
call wall_time(start_GF)
|
||||
call evRGF2(dotest,dophBSE,doppBSE,TDA,dBSE,dTDA,maxSCF,thresh,max_diis, &
|
||||
singlet,triplet,linearize,eta,regularize,nBas,nC,nO,nV,nR,nS,ENuc,EHF, &
|
||||
ERI,dipole_int,epsHF)
|
||||
singlet,triplet,linearize,eta,regularize,nOrb,nC,nO,nV,nR,nS,ENuc,EHF, &
|
||||
ERI_MO,dipole_int_MO,epsHF)
|
||||
call wall_time(end_GF)
|
||||
|
||||
t_GF = end_GF - start_GF
|
||||
write(*,'(A65,1X,F9.3,A8)') 'Total CPU time for GF2 = ',t_GF,' seconds'
|
||||
write(*,'(A65,1X,F9.3,A8)') 'Total wall time for GF2 = ',t_GF,' seconds'
|
||||
write(*,*)
|
||||
|
||||
end if
|
||||
@ -106,12 +110,14 @@ subroutine RGF(dotest,doG0F2,doevGF2,doqsGF2,doufG0F02,doG0F3,doevGF3,renorm,max
|
||||
if(doqsGF2) then
|
||||
|
||||
call wall_time(start_GF)
|
||||
call qsRGF2(dotest,maxSCF,thresh,max_diis,dophBSE,doppBSE,TDA,dBSE,dTDA,singlet,triplet,eta,regularize,nNuc,ZNuc,rNuc,ENuc, &
|
||||
nBas,nC,nO,nV,nR,nS,EHF,S,X,T,V,Hc,ERI_AO,ERI,dipole_int_AO,dipole_int,PHF,cHF,epsHF)
|
||||
call qsRGF2(dotest, maxSCF, thresh, max_diis, dophBSE, doppBSE, TDA, &
|
||||
dBSE, dTDA, singlet, triplet, eta, regularize, nNuc, ZNuc, &
|
||||
rNuc, ENuc, nBas, nOrb, nC, nO, nV, nR, nS, EHF, S, &
|
||||
X, T, V, Hc, ERI_AO, ERI_MO, dipole_int_AO, dipole_int_MO, PHF, cHF, epsHF)
|
||||
call wall_time(end_GF)
|
||||
|
||||
t_GF = end_GF - start_GF
|
||||
write(*,'(A65,1X,F9.3,A8)') 'Total CPU time for qsGF2 = ',t_GF,' seconds'
|
||||
write(*,'(A65,1X,F9.3,A8)') 'Total wall time for qsGF2 = ',t_GF,' seconds'
|
||||
write(*,*)
|
||||
|
||||
end if
|
||||
@ -123,11 +129,11 @@ subroutine RGF(dotest,doG0F2,doevGF2,doqsGF2,doufG0F02,doG0F3,doevGF3,renorm,max
|
||||
if(doufG0F02) then
|
||||
|
||||
call wall_time(start_GF)
|
||||
call ufRG0F02(dotest,nBas,nC,nO,nV,nR,nS,ENuc,EHF,ERI,epsHF)
|
||||
call ufRG0F02(dotest, nOrb, nC, nO, nV, nR, nS, ENuc, EHF, ERI_MO, epsHF)
|
||||
call wall_time(end_GF)
|
||||
|
||||
t_GF = end_GF - start_GF
|
||||
write(*,'(A65,1X,F9.3,A8)') 'Total CPU time for ufG0F02 = ',t_GF,' seconds'
|
||||
write(*,'(A65,1X,F9.3,A8)') 'Total wall time for ufG0F02 = ',t_GF,' seconds'
|
||||
write(*,*)
|
||||
|
||||
end if
|
||||
@ -139,11 +145,11 @@ subroutine RGF(dotest,doG0F2,doevGF2,doqsGF2,doufG0F02,doG0F3,doevGF3,renorm,max
|
||||
if(doG0F3) then
|
||||
|
||||
call wall_time(start_GF)
|
||||
call RG0F3(dotest,renorm,nBas,nC,nO,nV,nR,ERI,epsHF)
|
||||
call RG0F3(dotest, renorm, nOrb, nC, nO, nV, nR, ERI_MO, epsHF)
|
||||
call wall_time(end_GF)
|
||||
|
||||
t_GF = end_GF - start_GF
|
||||
write(*,'(A65,1X,F9.3,A8)') 'Total CPU time for GF3 = ',t_GF,' seconds'
|
||||
write(*,'(A65,1X,F9.3,A8)') 'Total wall time for GF3 = ',t_GF,' seconds'
|
||||
write(*,*)
|
||||
|
||||
end if
|
||||
@ -155,11 +161,11 @@ subroutine RGF(dotest,doG0F2,doevGF2,doqsGF2,doufG0F02,doG0F3,doevGF3,renorm,max
|
||||
if(doevGF3) then
|
||||
|
||||
call wall_time(start_GF)
|
||||
call evRGF3(dotest,maxSCF,thresh,max_diis,renorm,nBas,nC,nO,nV,nR,ERI,epsHF)
|
||||
call evRGF3(dotest, maxSCF, thresh, max_diis, renorm, nOrb, nC, nO, nV, nR, ERI_MO, epsHF)
|
||||
call wall_time(end_GF)
|
||||
|
||||
t_GF = end_GF - start_GF
|
||||
write(*,'(A65,1X,F9.3,A8)') 'Total CPU time for GF3 = ',t_GF,' seconds'
|
||||
write(*,'(A65,1X,F9.3,A8)') 'Total wall time for GF3 = ',t_GF,' seconds'
|
||||
write(*,*)
|
||||
|
||||
end if
|
||||
|
||||
@ -62,7 +62,7 @@ subroutine evRGF2(dotest,dophBSE,doppBSE,TDA,dBSE,dTDA,maxSCF,thresh,max_diis,si
|
||||
|
||||
! Memory allocation
|
||||
|
||||
allocate(SigC(nBas),Z(nBas),eGF(nBas),eOld(nBas),error_diis(nBas,max_diis),e_diis(nBas,max_diis))
|
||||
allocate(SigC(nBas), Z(nBas), eGF(nBas), eOld(nBas), error_diis(nBas,max_diis), e_diis(nBas,max_diis))
|
||||
|
||||
! Initialization
|
||||
|
||||
@ -189,4 +189,6 @@ subroutine evRGF2(dotest,dophBSE,doppBSE,TDA,dBSE,dTDA,maxSCF,thresh,max_diis,si
|
||||
|
||||
end if
|
||||
|
||||
deallocate(SigC, Z, eGF, eOld, error_diis, e_diis)
|
||||
|
||||
end subroutine
|
||||
|
||||
@ -1,4 +1,8 @@
|
||||
subroutine print_qsRGF2(nBas,nO,nSCF,Conv,thresh,eHF,eGF,c,SigC,Z,ENuc,ET,EV,EJ,Ex,Ec,EqsGF,dipole)
|
||||
|
||||
! ---
|
||||
|
||||
subroutine print_qsRGF2(nBas, nOrb, nO, nSCF, Conv, thresh, eHF, eGF, c, &
|
||||
SigC, Z, ENuc, ET, EV, EJ, Ex, Ec, EqsGF, dipole)
|
||||
|
||||
! Print one-electron energies and other stuff for qsGF2
|
||||
|
||||
@ -7,17 +11,17 @@ subroutine print_qsRGF2(nBas,nO,nSCF,Conv,thresh,eHF,eGF,c,SigC,Z,ENuc,ET,EV,EJ,
|
||||
|
||||
! Input variables
|
||||
|
||||
integer,intent(in) :: nBas
|
||||
integer,intent(in) :: nBas, nOrb
|
||||
integer,intent(in) :: nO
|
||||
integer,intent(in) :: nSCF
|
||||
double precision,intent(in) :: ENuc
|
||||
double precision,intent(in) :: Conv
|
||||
double precision,intent(in) :: thresh
|
||||
double precision,intent(in) :: eHF(nBas)
|
||||
double precision,intent(in) :: eGF(nBas)
|
||||
double precision,intent(in) :: c(nBas)
|
||||
double precision,intent(in) :: SigC(nBas,nBas)
|
||||
double precision,intent(in) :: Z(nBas)
|
||||
double precision,intent(in) :: eHF(nOrb)
|
||||
double precision,intent(in) :: eGF(nOrb)
|
||||
double precision,intent(in) :: c(nBas,nOrb)
|
||||
double precision,intent(in) :: SigC(nOrb,nOrb)
|
||||
double precision,intent(in) :: Z(nOrb)
|
||||
double precision,intent(in) :: ET
|
||||
double precision,intent(in) :: EV
|
||||
double precision,intent(in) :: EJ
|
||||
@ -53,7 +57,7 @@ subroutine print_qsRGF2(nBas,nO,nSCF,Conv,thresh,eHF,eGF,c,SigC,Z,ENuc,ET,EV,EJ,
|
||||
'|','#','|','e_HF (eV)','|','Sig_c (eV)','|','Z','|','e_QP (eV)','|'
|
||||
write(*,*)'-------------------------------------------------------------------------------'
|
||||
|
||||
do q=1,nBas
|
||||
do q = 1, nOrb
|
||||
write(*,'(1X,A1,1X,I3,1X,A1,1X,F15.6,1X,A1,1X,F15.6,1X,A1,1X,F15.6,1X,A1,1X,F15.6,1X,A1,1X)') &
|
||||
'|',q,'|',eHF(q)*HaToeV,'|',SigC(q,q)*HaToeV,'|',Z(q),'|',eGF(q)*HaToeV,'|'
|
||||
end do
|
||||
@ -102,12 +106,12 @@ subroutine print_qsRGF2(nBas,nO,nSCF,Conv,thresh,eHF,eGF,c,SigC,Z,ENuc,ET,EV,EJ,
|
||||
write(*,'(A50)') '---------------------------------------'
|
||||
write(*,'(A32)') ' qsGF2 MO coefficients'
|
||||
write(*,'(A50)') '---------------------------------------'
|
||||
call matout(nBas,nBas,c)
|
||||
call matout(nBas, nOrb, c)
|
||||
write(*,*)
|
||||
write(*,'(A50)') '---------------------------------------'
|
||||
write(*,'(A32)') ' qsGF2 MO energies'
|
||||
write(*,'(A50)') '---------------------------------------'
|
||||
call matout(nBas,1,eGF)
|
||||
call matout(nOrb, 1, eGF)
|
||||
write(*,*)
|
||||
|
||||
end if
|
||||
|
||||
@ -1,6 +1,10 @@
|
||||
subroutine qsRGF2(dotest,maxSCF,thresh,max_diis,dophBSE,doppBSE,TDA,dBSE,dTDA,singlet,triplet, &
|
||||
eta,regularize,nNuc,ZNuc,rNuc,ENuc,nBas,nC,nO,nV,nR,nS,ERHF, &
|
||||
S,X,T,V,Hc,ERI_AO,ERI_MO,dipole_int_AO,dipole_int_MO,PHF,cHF,eHF)
|
||||
|
||||
! ---
|
||||
|
||||
subroutine qsRGF2(dotest, maxSCF, thresh, max_diis, dophBSE, doppBSE, TDA, &
|
||||
dBSE, dTDA, singlet, triplet, eta, regularize, nNuc, ZNuc, &
|
||||
rNuc, ENuc, nBas, nOrb, nC, nO, nV, nR, nS, ERHF, &
|
||||
S, X, T, V, Hc, ERI_AO, ERI_MO, dipole_int_AO, dipole_int_MO, PHF, cHF, eHF)
|
||||
|
||||
! Perform a quasiparticle self-consistent GF2 calculation
|
||||
|
||||
@ -29,25 +33,25 @@ subroutine qsRGF2(dotest,maxSCF,thresh,max_diis,dophBSE,doppBSE,TDA,dBSE,dTDA,si
|
||||
double precision,intent(in) :: rNuc(nNuc,ncart)
|
||||
double precision,intent(in) :: ENuc
|
||||
|
||||
integer,intent(in) :: nBas,nC,nO,nV,nR,nS
|
||||
integer,intent(in) :: nBas,nOrb,nC,nO,nV,nR,nS
|
||||
double precision,intent(in) :: ERHF
|
||||
double precision,intent(in) :: eHF(nBas)
|
||||
double precision,intent(in) :: cHF(nBas,nBas)
|
||||
double precision,intent(in) :: eHF(nOrb)
|
||||
double precision,intent(in) :: cHF(nBas,nOrb)
|
||||
double precision,intent(in) :: PHF(nBas,nBas)
|
||||
double precision,intent(in) :: S(nBas,nBas)
|
||||
double precision,intent(in) :: T(nBas,nBas)
|
||||
double precision,intent(in) :: V(nBas,nBas)
|
||||
double precision,intent(in) :: Hc(nBas,nBas)
|
||||
double precision,intent(in) :: X(nBas,nBas)
|
||||
double precision,intent(in) :: X(nBas,nOrb)
|
||||
double precision,intent(in) :: ERI_AO(nBas,nBas,nBas,nBas)
|
||||
double precision,intent(inout):: ERI_MO(nBas,nBas,nBas,nBas)
|
||||
double precision,intent(inout):: ERI_MO(nOrb,nOrb,nOrb,nOrb)
|
||||
double precision,intent(in) :: dipole_int_AO(nBas,nBas,ncart)
|
||||
double precision,intent(in) :: dipole_int_MO(nBas,nBas,ncart)
|
||||
double precision,intent(in) :: dipole_int_MO(nOrb,nOrb,ncart)
|
||||
|
||||
! Local variables
|
||||
|
||||
integer :: nSCF
|
||||
integer :: nBasSq
|
||||
integer :: nBas_Sq
|
||||
integer :: ispin
|
||||
integer :: n_diis
|
||||
double precision :: EqsGF2
|
||||
@ -94,7 +98,7 @@ subroutine qsRGF2(dotest,maxSCF,thresh,max_diis,dophBSE,doppBSE,TDA,dBSE,dTDA,si
|
||||
|
||||
! Stuff
|
||||
|
||||
nBasSq = nBas*nBas
|
||||
nBas_Sq = nBas*nBas
|
||||
|
||||
! TDA
|
||||
|
||||
@ -105,9 +109,27 @@ subroutine qsRGF2(dotest,maxSCF,thresh,max_diis,dophBSE,doppBSE,TDA,dBSE,dTDA,si
|
||||
|
||||
! Memory allocation
|
||||
|
||||
allocate(eGF(nBas),eOld(nbas),c(nBas,nBas),cp(nBas,nBas),P(nBas,nBas),F(nBas,nBas),Fp(nBas,nBas), &
|
||||
J(nBas,nBas),K(nBas,nBas),SigC(nBas,nBas),SigCp(nBas,nBas),Z(nBas), &
|
||||
error(nBas,nBas),error_diis(nBasSq,max_diis),F_diis(nBasSq,max_diis))
|
||||
allocate(eGF(nOrb))
|
||||
allocate(eOld(nOrb))
|
||||
|
||||
allocate(c(nBas,nOrb))
|
||||
|
||||
allocate(cp(nOrb,nOrb))
|
||||
allocate(Fp(nOrb,nOrb))
|
||||
|
||||
allocate(P(nBas,nBas))
|
||||
allocate(F(nBas,nBas))
|
||||
allocate(J(nBas,nBas))
|
||||
allocate(K(nBas,nBas))
|
||||
allocate(error(nBas,nBas))
|
||||
|
||||
allocate(Z(nOrb))
|
||||
allocate(SigC(nOrb,nOrb))
|
||||
|
||||
allocate(SigCp(nBas,nBas))
|
||||
|
||||
allocate(error_diis(nBas_Sq,max_diis))
|
||||
allocate(F_diis(nBas_Sq,max_diis))
|
||||
|
||||
! Initialization
|
||||
|
||||
@ -117,7 +139,7 @@ subroutine qsRGF2(dotest,maxSCF,thresh,max_diis,dophBSE,doppBSE,TDA,dBSE,dTDA,si
|
||||
Conv = 1d0
|
||||
P(:,:) = PHF(:,:)
|
||||
eOld(:) = eHF(:)
|
||||
eGF(:) = eHF(:)
|
||||
eGF(:) = eHF(:)
|
||||
c(:,:) = cHF(:,:)
|
||||
F_diis(:,:) = 0d0
|
||||
error_diis(:,:) = 0d0
|
||||
@ -135,25 +157,25 @@ subroutine qsRGF2(dotest,maxSCF,thresh,max_diis,dophBSE,doppBSE,TDA,dBSE,dTDA,si
|
||||
|
||||
! Buid Hartree matrix
|
||||
|
||||
call Hartree_matrix_AO_basis(nBas,P,ERI_AO,J)
|
||||
call Hartree_matrix_AO_basis(nBas, P, ERI_AO, J)
|
||||
|
||||
! Compute exchange part of the self-energy
|
||||
|
||||
call exchange_matrix_AO_basis(nBas,P,ERI_AO,K)
|
||||
call exchange_matrix_AO_basis(nBas, P, ERI_AO, K)
|
||||
|
||||
! AO to MO transformation of two-electron integrals
|
||||
|
||||
call AOtoMO_ERI_RHF(nBas,c,ERI_AO,ERI_MO)
|
||||
call AOtoMO_ERI_RHF(nBas, nOrb, c, ERI_AO, ERI_MO)
|
||||
|
||||
! Compute self-energy and renormalization factor
|
||||
|
||||
if(regularize) then
|
||||
|
||||
call GF2_reg_self_energy(eta,nBas,nC,nO,nV,nR,eGF,ERI_MO,SigC,Z)
|
||||
call GF2_reg_self_energy(eta, nOrb, nC, nO, nV, nR, eGF, ERI_MO, SigC, Z)
|
||||
|
||||
else
|
||||
|
||||
call GF2_self_energy(eta,nBas,nC,nO,nV,nR,eGF,ERI_MO,SigC,Z)
|
||||
call GF2_self_energy(eta, nOrb, nC, nO, nV, nR, eGF, ERI_MO, SigC, Z)
|
||||
|
||||
end if
|
||||
|
||||
@ -161,36 +183,47 @@ subroutine qsRGF2(dotest,maxSCF,thresh,max_diis,dophBSE,doppBSE,TDA,dBSE,dTDA,si
|
||||
|
||||
SigC = 0.5d0*(SigC + transpose(SigC))
|
||||
|
||||
call MOtoAO(nBas,S,c,SigC,SigCp)
|
||||
call MOtoAO(nBas, nOrb, S, c, SigC, SigCp)
|
||||
|
||||
! Solve the quasi-particle equation
|
||||
|
||||
F(:,:) = Hc(:,:) + J(:,:) + 0.5d0*K(:,:) + SigCp(:,:)
|
||||
if(nBas .ne. nOrb) then
|
||||
call AOtoMO(nBas, nOrb, c(1,1), F(1,1), Fp(1,1))
|
||||
call MOtoAO(nBas, nOrb, S(1,1), c(1,1), Fp(1,1), F(1,1))
|
||||
endif
|
||||
|
||||
! Compute commutator and convergence criteria
|
||||
|
||||
error = matmul(F,matmul(P,S)) - matmul(matmul(S,P),F)
|
||||
error = matmul(F, matmul(P, S)) - matmul(matmul(S, P), F)
|
||||
|
||||
! DIIS extrapolation
|
||||
|
||||
n_diis = min(n_diis+1,max_diis)
|
||||
n_diis = min(n_diis+1, max_diis)
|
||||
if(abs(rcond) > 1d-7) then
|
||||
call DIIS_extrapolation(rcond,nBasSq,nBasSq,n_diis,error_diis,F_diis,error,F)
|
||||
call DIIS_extrapolation(rcond,nBas_Sq,nBas_Sq,n_diis,error_diis,F_diis,error,F)
|
||||
else
|
||||
n_diis = 0
|
||||
end if
|
||||
|
||||
! Diagonalize Hamiltonian in AO basis
|
||||
|
||||
Fp = matmul(transpose(X),matmul(F,X))
|
||||
cp(:,:) = Fp(:,:)
|
||||
call diagonalize_matrix(nBas,cp,eGF)
|
||||
c = matmul(X,cp)
|
||||
SigCp = matmul(transpose(c),matmul(SigCp,c))
|
||||
if(nBas .eq. nOrb) then
|
||||
Fp = matmul(transpose(X), matmul(F, X))
|
||||
cp(:,:) = Fp(:,:)
|
||||
call diagonalize_matrix(nOrb, cp, eGF)
|
||||
c = matmul(X, cp)
|
||||
else
|
||||
Fp = matmul(transpose(c), matmul(F, c))
|
||||
cp(:,:) = Fp(:,:)
|
||||
call diagonalize_matrix(nOrb, cp, eGF)
|
||||
c = matmul(c, cp)
|
||||
endif
|
||||
|
||||
|
||||
! Compute new density matrix in the AO basis
|
||||
|
||||
P(:,:) = 2d0*matmul(c(:,1:nO),transpose(c(:,1:nO)))
|
||||
P(:,:) = 2d0*matmul(c(:,1:nO), transpose(c(:,1:nO)))
|
||||
|
||||
! Save quasiparticles energy for next cycle
|
||||
|
||||
@ -203,23 +236,23 @@ subroutine qsRGF2(dotest,maxSCF,thresh,max_diis,dophBSE,doppBSE,TDA,dBSE,dTDA,si
|
||||
|
||||
! Kinetic energy
|
||||
|
||||
ET = trace_matrix(nBas,matmul(P,T))
|
||||
ET = trace_matrix(nBas, matmul(P, T))
|
||||
|
||||
! Potential energy
|
||||
|
||||
EV = trace_matrix(nBas,matmul(P,V))
|
||||
EV = trace_matrix(nBas, matmul(P, V))
|
||||
|
||||
! Hartree energy
|
||||
|
||||
EJ = 0.5d0*trace_matrix(nBas,matmul(P,J))
|
||||
EJ = 0.5d0*trace_matrix(nBas, matmul(P, J))
|
||||
|
||||
! Exchange energy
|
||||
|
||||
Ex = 0.25d0*trace_matrix(nBas,matmul(P,K))
|
||||
Ex = 0.25d0*trace_matrix(nBas, matmul(P, K))
|
||||
|
||||
! Correlation energy
|
||||
|
||||
call RMP2(.false.,regularize,nBas,nC,nO,nV,nR,ERI_MO,ENuc,EqsGF2,eGF,Ec)
|
||||
call RMP2(.false., regularize, nOrb, nC, nO, nV, nR, ERI_MO, ENuc, EqsGF2, eGF, Ec)
|
||||
|
||||
! Total energy
|
||||
|
||||
@ -230,8 +263,9 @@ subroutine qsRGF2(dotest,maxSCF,thresh,max_diis,dophBSE,doppBSE,TDA,dBSE,dTDA,si
|
||||
! Print results
|
||||
!------------------------------------------------------------------------
|
||||
|
||||
call dipole_moment(nBas,P,nNuc,ZNuc,rNuc,dipole_int_AO,dipole)
|
||||
call print_qsRGF2(nBas,nO,nSCF,Conv,thresh,eHF,eGF,c,SigCp,Z,ENuc,ET,EV,EJ,Ex,Ec,EqsGF2,dipole)
|
||||
call dipole_moment(nBas, P, nNuc, ZNuc, rNuc, dipole_int_AO, dipole)
|
||||
call print_qsRGF2(nBas, nOrb, nO, nSCF, Conv, thresh, eHF, eGF, &
|
||||
c, SigC, Z, ENuc, ET, EV, EJ, Ex, Ec, EqsGF2, dipole)
|
||||
|
||||
end do
|
||||
!------------------------------------------------------------------------
|
||||
@ -248,19 +282,21 @@ subroutine qsRGF2(dotest,maxSCF,thresh,max_diis,dophBSE,doppBSE,TDA,dBSE,dTDA,si
|
||||
write(*,*)'!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!'
|
||||
write(*,*)
|
||||
|
||||
deallocate(c, cp, P, F, Fp, J, K, SigC, SigCp, Z, error, error_diis, F_diis)
|
||||
stop
|
||||
|
||||
end if
|
||||
|
||||
! Deallocate memory
|
||||
|
||||
deallocate(c,cp,P,F,Fp,J,K,SigC,SigCp,Z,error,error_diis,F_diis)
|
||||
deallocate(c, cp, P, F, Fp, J, K, SigC, SigCp, Z, error, error_diis, F_diis)
|
||||
|
||||
! Perform BSE calculation
|
||||
|
||||
if(dophBSE) then
|
||||
|
||||
call GF2_phBSE2(TDA,dBSE,dTDA,singlet,triplet,eta,nBas,nC,nO,nV,nR,nS,ERI_MO,dipole_int_MO,eGF,EcBSE)
|
||||
call GF2_phBSE2(TDA, dBSE, dTDA, singlet, triplet, eta, nOrb, nC, nO, &
|
||||
nV, nR, nS, ERI_MO, dipole_int_MO, eGF, EcBSE)
|
||||
|
||||
write(*,*)
|
||||
write(*,*)'-------------------------------------------------------------------------------'
|
||||
@ -278,7 +314,8 @@ subroutine qsRGF2(dotest,maxSCF,thresh,max_diis,dophBSE,doppBSE,TDA,dBSE,dTDA,si
|
||||
|
||||
if(doppBSE) then
|
||||
|
||||
call GF2_ppBSE2(TDA,dBSE,dTDA,singlet,triplet,eta,nBas,nC,nO,nV,nR,ERI_MO,dipole_int_MO,eGF,EcBSE)
|
||||
call GF2_ppBSE2(TDA, dBSE, dTDA, singlet, triplet, eta, nOrb, &
|
||||
nC, nO, nV, nR, ERI_MO, dipole_int_MO, eGF, EcBSE)
|
||||
|
||||
write(*,*)
|
||||
write(*,*)'-------------------------------------------------------------------------------'
|
||||
|
||||
@ -197,7 +197,7 @@ subroutine qsUGF2(dotest,maxSCF,thresh,max_diis,BSE,TDA,dBSE,dTDA,spin_conserved
|
||||
end do
|
||||
|
||||
do is=1,nspin
|
||||
call MOtoAO(nBas,S,c(:,:,is),SigC(:,:,is),SigCp(:,:,is))
|
||||
call MOtoAO(nBas,nBas,S,c(:,:,is),SigC(:,:,is),SigCp(:,:,is))
|
||||
end do
|
||||
|
||||
! Solve the quasi-particle equation
|
||||
|
||||
@ -2,6 +2,12 @@ subroutine GTpp_excitation_density(ispin,nBas,nC,nO,nV,nR,nOO,nVV,ERI,X1,Y1,rho1
|
||||
|
||||
! Compute excitation densities for T-matrix self-energy
|
||||
|
||||
! TODO
|
||||
! debug DGEMM for nC != 0
|
||||
! and nR != 0
|
||||
|
||||
|
||||
|
||||
implicit none
|
||||
|
||||
! Input variables
|
||||
@ -33,6 +39,10 @@ subroutine GTpp_excitation_density(ispin,nBas,nC,nO,nV,nR,nOO,nVV,ERI,X1,Y1,rho1
|
||||
double precision,intent(out) :: rho1(nBas,nBas,nVV)
|
||||
double precision,intent(out) :: rho2(nBas,nBas,nOO)
|
||||
|
||||
integer :: dim_1, dim_2
|
||||
double precision, allocatable :: ERI_1(:,:,:)
|
||||
double precision, allocatable :: ERI_2(:,:,:)
|
||||
|
||||
! Initialization
|
||||
|
||||
rho1(:,:,:) = 0d0
|
||||
@ -44,11 +54,10 @@ subroutine GTpp_excitation_density(ispin,nBas,nC,nO,nV,nR,nOO,nVV,ERI,X1,Y1,rho1
|
||||
|
||||
if(ispin == 1) then
|
||||
|
||||
!$OMP PARALLEL &
|
||||
!$OMP SHARED(nC,nBas,nR,nO,nVV,nOO,rho1,rho2,ERI,X1,Y1,X2,Y2) &
|
||||
!$OMP PRIVATE(q,p,ab,cd,kl,ij) &
|
||||
!$OMP DEFAULT(NONE)
|
||||
!$OMP DO
|
||||
!$OMP PARALLEL DEFAULT(NONE) &
|
||||
!$OMP PRIVATE(p, q, a, b, ab, c, d, cd, i, j, ij, k, l, kl) &
|
||||
!$OMP SHARED(nC, nBas, nR, nO, rho1, rho2, ERI, X1, Y1, X2, Y2)
|
||||
!$OMP DO COLLAPSE(2)
|
||||
|
||||
do q=nC+1,nBas-nR
|
||||
do p=nC+1,nBas-nR
|
||||
@ -113,8 +122,8 @@ subroutine GTpp_excitation_density(ispin,nBas,nC,nO,nV,nR,nOO,nVV,ERI,X1,Y1,rho1
|
||||
|
||||
end do
|
||||
end do
|
||||
!$OMP END DO
|
||||
!$OMP END PARALLEL
|
||||
!$OMP END DO
|
||||
!$OMP END PARALLEL
|
||||
end if
|
||||
|
||||
!----------------------------------------------
|
||||
@ -123,138 +132,265 @@ subroutine GTpp_excitation_density(ispin,nBas,nC,nO,nV,nR,nOO,nVV,ERI,X1,Y1,rho1
|
||||
|
||||
if(ispin == 2 .or. ispin == 4) then
|
||||
|
||||
do q=nC+1,nBas-nR
|
||||
do p=nC+1,nBas-nR
|
||||
|
||||
! do ab=1,nVV
|
||||
ab = 0
|
||||
do a=nO+1,nBas-nR
|
||||
do b=a+1,nBas-nR
|
||||
ab = ab + 1
|
||||
|
||||
cd = 0
|
||||
do c=nO+1,nBas-nR
|
||||
do d=c+1,nBas-nR
|
||||
cd = cd + 1
|
||||
rho1(p,q,ab) = rho1(p,q,ab) &
|
||||
+ (ERI(p,q,c,d) - ERI(p,q,d,c))*X1(cd,ab)
|
||||
end do
|
||||
end do
|
||||
|
||||
kl = 0
|
||||
do k=nC+1,nO
|
||||
do l=k+1,nO
|
||||
kl = kl + 1
|
||||
rho1(p,q,ab) = rho1(p,q,ab) &
|
||||
+ (ERI(p,q,k,l) - ERI(p,q,l,k))*Y1(kl,ab)
|
||||
end do
|
||||
end do
|
||||
|
||||
end do
|
||||
end do
|
||||
|
||||
! do ij=1,nOO
|
||||
dim_1 = (nBas - nO) * (nBas - nO - 1) / 2
|
||||
dim_2 = nO * (nO - 1) / 2
|
||||
|
||||
if((dim_1 .eq. 0) .or. (dim_2 .eq. 0)) then
|
||||
|
||||
!$OMP PARALLEL DEFAULT(NONE) &
|
||||
!$OMP PRIVATE(p, q, a, b, ab, c, d, cd, i, j, ij, k, l, kl) &
|
||||
!$OMP SHARED(nC, nBas, nR, nO, rho1, rho2, ERI, X1, Y1, X2, Y2)
|
||||
!$OMP DO COLLAPSE(2)
|
||||
do q = nC+1, nBas-nR
|
||||
do p = nC+1, nBas-nR
|
||||
|
||||
ab = 0
|
||||
|
||||
do a = nO+1, nBas-nR
|
||||
do b = a+1, nBas-nR
|
||||
|
||||
ab = ab + 1
|
||||
|
||||
cd = 0
|
||||
do c = nO+1, nBas-nR
|
||||
do d = c+1, nBas-nR
|
||||
|
||||
cd = cd + 1
|
||||
|
||||
rho1(p,q,ab) = rho1(p,q,ab) &
|
||||
+ (ERI(p,q,c,d) - ERI(p,q,d,c))*X1(cd,ab)
|
||||
end do ! d
|
||||
end do ! c
|
||||
|
||||
kl = 0
|
||||
do k = nC+1, nO
|
||||
do l = k+1, nO
|
||||
|
||||
kl = kl + 1
|
||||
|
||||
rho1(p,q,ab) = rho1(p,q,ab) &
|
||||
+ (ERI(p,q,k,l) - ERI(p,q,l,k))*Y1(kl,ab)
|
||||
end do ! l
|
||||
end do ! k
|
||||
end do ! b
|
||||
end do ! a
|
||||
|
||||
ij = 0
|
||||
do i=nC+1,nO
|
||||
do j=i+1,nO
|
||||
ij = ij + 1
|
||||
|
||||
do i = nC+1, nO
|
||||
do j = i+1, nO
|
||||
|
||||
ij = ij + 1
|
||||
|
||||
cd = 0
|
||||
|
||||
do c = nO+1, nBas-nR
|
||||
do d = c+1, nBas-nR
|
||||
|
||||
cd = cd + 1
|
||||
|
||||
rho2(p,q,ij) = rho2(p,q,ij) &
|
||||
+ (ERI(p,q,c,d) - ERI(p,q,d,c))*X2(cd,ij)
|
||||
end do ! d
|
||||
end do ! c
|
||||
|
||||
kl = 0
|
||||
do k = nC+1, nO
|
||||
do l = k+1, nO
|
||||
|
||||
kl = kl + 1
|
||||
|
||||
rho2(p,q,ij) = rho2(p,q,ij) &
|
||||
+ (ERI(p,q,k,l) - ERI(p,q,l,k))*Y2(kl,ij)
|
||||
end do ! l
|
||||
end do ! k
|
||||
end do ! j
|
||||
end do ! i
|
||||
end do ! p
|
||||
end do ! q
|
||||
!$OMP END DO
|
||||
!$OMP END PARALLEL
|
||||
|
||||
else
|
||||
|
||||
allocate(ERI_1(nBas,nBas,dim_1), ERI_2(nBas,nBas,dim_2))
|
||||
ERI_1 = 0.d0
|
||||
ERI_2 = 0.d0
|
||||
|
||||
!$OMP PARALLEL DEFAULT(NONE) &
|
||||
!$OMP PRIVATE(p, q, c, d, cd, k, l, kl) &
|
||||
!$OMP SHARED(nC, nBas, nR, nO, ERI_1, ERI_2, ERI)
|
||||
!$OMP DO COLLAPSE(2)
|
||||
do q = nC+1, nBas-nR
|
||||
do p = nC+1, nBas-nR
|
||||
cd = 0
|
||||
do c=nO+1,nBas-nR
|
||||
do d=c+1,nBas-nR
|
||||
do c = nO+1, nBas-nR
|
||||
do d = c+1, nBas-nR
|
||||
cd = cd + 1
|
||||
rho2(p,q,ij) = rho2(p,q,ij) &
|
||||
+ (ERI(p,q,c,d) - ERI(p,q,d,c))*X2(cd,ij)
|
||||
end do
|
||||
end do
|
||||
|
||||
ERI_1(p,q,cd) = ERI(p,q,c,d) - ERI(p,q,d,c)
|
||||
enddo
|
||||
enddo
|
||||
kl = 0
|
||||
do k=nC+1,nO
|
||||
do l=k+1,nO
|
||||
do k = nC+1, nO
|
||||
do l = k+1, nO
|
||||
kl = kl + 1
|
||||
rho2(p,q,ij) = rho2(p,q,ij) &
|
||||
+ (ERI(p,q,k,l) - ERI(p,q,l,k))*Y2(kl,ij)
|
||||
ERI_2(p,q,kl) = ERI(p,q,k,l) - ERI(p,q,l,k)
|
||||
end do
|
||||
end do
|
||||
|
||||
end do
|
||||
end do
|
||||
enddo
|
||||
enddo
|
||||
!$OMP END DO
|
||||
!$OMP END PARALLEL
|
||||
|
||||
call dgemm("N", "N", nBas*nBas, dim_1, dim_1, 1.d0, &
|
||||
ERI_1(1,1,1), nBas*nBas, X1(1,1), dim_1, &
|
||||
0.d0, rho1(1,1,1), nBas*nBas)
|
||||
|
||||
call dgemm("N", "N", nBas*nBas, dim_1, dim_2, 1.d0, &
|
||||
ERI_2(1,1,1), nBas*nBas, Y1(1,1), dim_2, &
|
||||
1.d0, rho1(1,1,1), nBas*nBas)
|
||||
|
||||
call dgemm("N", "N", nBas*nBas, dim_2, dim_1, 1.d0, &
|
||||
ERI_1(1,1,1), nBas*nBas, X2(1,1), dim_1, &
|
||||
0.d0, rho2(1,1,1), nBas*nBas)
|
||||
|
||||
call dgemm("N", "N", nBas*nBas, dim_2, dim_2, 1.d0, &
|
||||
ERI_2(1,1,1), nBas*nBas, Y2(1,1), dim_2, &
|
||||
1.d0, rho2(1,1,1), nBas*nBas)
|
||||
|
||||
deallocate(ERI_1, ERI_2)
|
||||
|
||||
end do
|
||||
end do
|
||||
|
||||
end if
|
||||
endif
|
||||
endif
|
||||
|
||||
!----------------------------------------------
|
||||
! alpha-beta block
|
||||
!----------------------------------------------
|
||||
|
||||
if(ispin == 3) then
|
||||
|
||||
!$OMP PARALLEL &
|
||||
!$OMP SHARED(nC,nBas,nR,nO,nVV,nOO,rho1,rho2,ERI,X1,Y1,X2,Y2) &
|
||||
!$OMP PRIVATE(q,p,ab,cd,kl,ij,c,d,k,l) &
|
||||
!$OMP DEFAULT(NONE)
|
||||
!$OMP DO
|
||||
|
||||
do q=nC+1,nBas-nR
|
||||
do p=nC+1,nBas-nR
|
||||
|
||||
! do ab=1,nVV
|
||||
ab = 0
|
||||
do a=nO+1,nBas-nR
|
||||
do b=nO+1,nBas-nR
|
||||
ab = ab + 1
|
||||
|
||||
cd = 0
|
||||
do c=nO+1,nBas-nR
|
||||
do d=nO+1,nBas-nR
|
||||
cd = cd + 1
|
||||
rho1(p,q,ab) = rho1(p,q,ab) + ERI(p,q,c,d)*X1(cd,ab)
|
||||
end do
|
||||
end do
|
||||
|
||||
kl = 0
|
||||
do k=nC+1,nO
|
||||
do l=nC+1,nO
|
||||
kl = kl + 1
|
||||
rho1(p,q,ab) = rho1(p,q,ab) + ERI(p,q,k,l)*Y1(kl,ab)
|
||||
end do
|
||||
end do
|
||||
|
||||
end do
|
||||
end do
|
||||
|
||||
! do ij=1,nOO
|
||||
ij = 0
|
||||
do i=nC+1,nO
|
||||
do j=nC+1,nO
|
||||
ij = ij + 1
|
||||
|
||||
cd = 0
|
||||
do c=nO+1,nBas-nR
|
||||
do d=nO+1,nBas-nR
|
||||
cd = cd + 1
|
||||
rho2(p,q,ij) = rho2(p,q,ij) + ERI(p,q,c,d)*X2(cd,ij)
|
||||
end do
|
||||
end do
|
||||
|
||||
kl = 0
|
||||
do k=nC+1,nO
|
||||
do l=nC+1,nO
|
||||
kl = kl + 1
|
||||
rho2(p,q,ij) = rho2(p,q,ij) + ERI(p,q,k,l)*Y2(kl,ij)
|
||||
end do
|
||||
end do
|
||||
|
||||
end do
|
||||
end do
|
||||
|
||||
end do
|
||||
end do
|
||||
!$OMP END DO
|
||||
!$OMP END PARALLEL
|
||||
|
||||
end if
|
||||
dim_1 = (nBas - nO) * (nBas - nO)
|
||||
dim_2 = nO * nO
|
||||
|
||||
if((dim_1 .eq. 0) .or. (dim_2 .eq. 0)) then
|
||||
|
||||
!$OMP PARALLEL DEFAULT(NONE) &
|
||||
!$OMP PRIVATE(p, q, a, b, ab, c, d, cd, i, j, ij, k, l, kl) &
|
||||
!$OMP SHARED(nC, nBas, nR, nO, rho1, rho2, ERI, X1, Y1, X2, Y2)
|
||||
!$OMP DO COLLAPSE(2)
|
||||
|
||||
do q = nC+1, nBas-nR
|
||||
do p = nC+1, nBas-nR
|
||||
|
||||
ab = 0
|
||||
do a = nO+1, nBas-nR
|
||||
do b = nO+1, nBas-nR
|
||||
|
||||
ab = ab + 1
|
||||
|
||||
cd = 0
|
||||
do c = nO+1, nBas-nR
|
||||
do d = nO+1, nBas-nR
|
||||
|
||||
cd = cd + 1
|
||||
|
||||
rho1(p,q,ab) = rho1(p,q,ab) + ERI(p,q,c,d)*X1(cd,ab)
|
||||
end do
|
||||
end do
|
||||
|
||||
kl = 0
|
||||
do k = nC+1, nO
|
||||
do l = nC+1, nO
|
||||
|
||||
kl = kl + 1
|
||||
|
||||
rho1(p,q,ab) = rho1(p,q,ab) + ERI(p,q,k,l)*Y1(kl,ab)
|
||||
end do
|
||||
end do
|
||||
end do
|
||||
end do
|
||||
|
||||
ij = 0
|
||||
do i = nC+1, nO
|
||||
do j = nC+1, nO
|
||||
|
||||
ij = ij + 1
|
||||
|
||||
cd = 0
|
||||
do c = nO+1, nBas-nR
|
||||
do d = nO+1, nBas-nR
|
||||
|
||||
cd = cd + 1
|
||||
|
||||
rho2(p,q,ij) = rho2(p,q,ij) + ERI(p,q,c,d)*X2(cd,ij)
|
||||
end do
|
||||
end do
|
||||
|
||||
kl = 0
|
||||
do k = nC+1, nO
|
||||
do l = nC+1, nO
|
||||
|
||||
kl = kl + 1
|
||||
|
||||
rho2(p,q,ij) = rho2(p,q,ij) + ERI(p,q,k,l)*Y2(kl,ij)
|
||||
end do
|
||||
end do
|
||||
end do
|
||||
end do
|
||||
end do
|
||||
end do
|
||||
!$OMP END DO
|
||||
!$OMP END PARALLEL
|
||||
|
||||
else
|
||||
|
||||
allocate(ERI_1(nBas,nBas,dim_1), ERI_2(nBas,nBas,dim_2))
|
||||
ERI_1 = 0.d0
|
||||
ERI_2 = 0.d0
|
||||
|
||||
!$OMP PARALLEL DEFAULT(NONE) &
|
||||
!$OMP PRIVATE(p, q, c, d, cd, k, l, kl) &
|
||||
!$OMP SHARED(nC, nBas, nR, nO, ERI_1, ERI_2, ERI)
|
||||
!$OMP DO COLLAPSE(2)
|
||||
do q = nC+1, nBas-nR
|
||||
do p = nC+1, nBas-nR
|
||||
cd = 0
|
||||
do c = nO+1, nBas-nR
|
||||
do d = nO+1, nBas-nR
|
||||
cd = cd + 1
|
||||
ERI_1(p,q,cd) = ERI(p,q,c,d)
|
||||
enddo
|
||||
enddo
|
||||
kl = 0
|
||||
do k = nC+1, nO
|
||||
do l = nC+1, nO
|
||||
kl = kl + 1
|
||||
ERI_2(p,q,kl) = ERI(p,q,k,l)
|
||||
end do
|
||||
end do
|
||||
enddo
|
||||
enddo
|
||||
!$OMP END DO
|
||||
!$OMP END PARALLEL
|
||||
|
||||
call dgemm("N", "N", nBas*nBas, dim_1, dim_1, 1.d0, &
|
||||
ERI_1(1,1,1), nBas*nBas, X1(1,1), dim_1, &
|
||||
0.d0, rho1(1,1,1), nBas*nBas)
|
||||
|
||||
call dgemm("N", "N", nBas*nBas, dim_1, dim_2, 1.d0, &
|
||||
ERI_2(1,1,1), nBas*nBas, Y1(1,1), dim_2, &
|
||||
1.d0, rho1(1,1,1), nBas*nBas)
|
||||
|
||||
call dgemm("N", "N", nBas*nBas, dim_2, dim_1, 1.d0, &
|
||||
ERI_1(1,1,1), nBas*nBas, X2(1,1), dim_1, &
|
||||
0.d0, rho2(1,1,1), nBas*nBas)
|
||||
|
||||
call dgemm("N", "N", nBas*nBas, dim_2, dim_2, 1.d0, &
|
||||
ERI_2(1,1,1), nBas*nBas, Y2(1,1), dim_2, &
|
||||
1.d0, rho2(1,1,1), nBas*nBas)
|
||||
|
||||
deallocate(ERI_1, ERI_2)
|
||||
|
||||
endif
|
||||
endif
|
||||
|
||||
end subroutine
|
||||
|
||||
@ -64,6 +64,7 @@ subroutine RG0T0pp(dotest,doACFDT,exchange_kernel,doXBS,dophBSE,TDA_T,TDA,dBSE,d
|
||||
double precision,allocatable :: eGT(:)
|
||||
double precision,allocatable :: eGTlin(:)
|
||||
|
||||
|
||||
! Output variables
|
||||
|
||||
! Hello world
|
||||
@ -122,9 +123,9 @@ subroutine RG0T0pp(dotest,doACFDT,exchange_kernel,doXBS,dophBSE,TDA_T,TDA,dBSE,d
|
||||
|
||||
allocate(Bpp(nVVs,nOOs),Cpp(nVVs,nVVs),Dpp(nOOs,nOOs))
|
||||
|
||||
call ppLR_C(iblock,nBas,nC,nO,nV,nR,nVVs,1d0,eHF,ERI,Cpp)
|
||||
call ppLR_D(iblock,nBas,nC,nO,nV,nR,nOOs,1d0,eHF,ERI,Dpp)
|
||||
if(.not.TDA_T) call ppLR_B(iblock,nBas,nC,nO,nV,nR,nOOs,nVVs,1d0,ERI,Bpp)
|
||||
call ppLR_C(iblock,nBas,nC,nO,nV,nR,nVVs,1d0,eHF,ERI,Cpp)
|
||||
call ppLR_D(iblock,nBas,nC,nO,nV,nR,nOOs,1d0,eHF,ERI,Dpp)
|
||||
|
||||
call ppLR(TDA_T,nOOs,nVVs,Bpp,Cpp,Dpp,Om1s,X1s,Y1s,Om2s,X2s,Y2s,EcRPA(ispin))
|
||||
|
||||
@ -145,9 +146,9 @@ subroutine RG0T0pp(dotest,doACFDT,exchange_kernel,doXBS,dophBSE,TDA_T,TDA,dBSE,d
|
||||
|
||||
allocate(Bpp(nVVt,nOOt),Cpp(nVVt,nVVt),Dpp(nOOt,nOOt))
|
||||
|
||||
call ppLR_C(iblock,nBas,nC,nO,nV,nR,nVVt,1d0,eHF,ERI,Cpp)
|
||||
call ppLR_D(iblock,nBas,nC,nO,nV,nR,nOOt,1d0,eHF,ERI,Dpp)
|
||||
if(.not.TDA_T) call ppLR_B(iblock,nBas,nC,nO,nV,nR,nOOt,nVVt,1d0,ERI,Bpp)
|
||||
call ppLR_C(iblock,nBas,nC,nO,nV,nR,nVVt,1d0,eHF,ERI,Cpp)
|
||||
call ppLR_D(iblock,nBas,nC,nO,nV,nR,nOOt,1d0,eHF,ERI,Dpp)
|
||||
|
||||
call ppLR(TDA_T,nOOt,nVVt,Bpp,Cpp,Dpp,Om1t,X1t,Y1t,Om2t,X2t,Y2t,EcRPA(ispin))
|
||||
|
||||
@ -162,10 +163,12 @@ subroutine RG0T0pp(dotest,doACFDT,exchange_kernel,doXBS,dophBSE,TDA_T,TDA,dBSE,d
|
||||
|
||||
! iblock = 1
|
||||
iblock = 3
|
||||
|
||||
call GTpp_excitation_density(iblock,nBas,nC,nO,nV,nR,nOOs,nVVs,ERI,X1s,Y1s,rho1s,X2s,Y2s,rho2s)
|
||||
|
||||
! iblock = 2
|
||||
iblock = 4
|
||||
|
||||
call GTpp_excitation_density(iblock,nBas,nC,nO,nV,nR,nOOt,nVVt,ERI,X1t,Y1t,rho1t,X2t,Y2t,rho2t)
|
||||
|
||||
!----------------------------------------------
|
||||
@ -183,7 +186,7 @@ subroutine RG0T0pp(dotest,doACFDT,exchange_kernel,doXBS,dophBSE,TDA_T,TDA,dBSE,d
|
||||
!----------------------------------------------
|
||||
! Solve the quasi-particle equation
|
||||
!----------------------------------------------
|
||||
|
||||
|
||||
eGTlin(:) = eHF(:) + Z(:)*Sig(:)
|
||||
|
||||
if(linearize) then
|
||||
@ -218,9 +221,9 @@ subroutine RG0T0pp(dotest,doACFDT,exchange_kernel,doXBS,dophBSE,TDA_T,TDA,dBSE,d
|
||||
|
||||
allocate(Bpp(nVVs,nOOs),Cpp(nVVs,nVVs),Dpp(nOOs,nOOs))
|
||||
|
||||
call ppLR_C(iblock,nBas,nC,nO,nV,nR,nVVs,1d0,eGT,ERI,Cpp)
|
||||
call ppLR_D(iblock,nBas,nC,nO,nV,nR,nOOs,1d0,eGT,ERI,Dpp)
|
||||
if(.not.TDA_T) call ppLR_B(iblock,nBas,nC,nO,nV,nR,nOOs,nVVs,1d0,ERI,Bpp)
|
||||
call ppLR_C(iblock,nBas,nC,nO,nV,nR,nVVs,1d0,eGT,ERI,Cpp)
|
||||
call ppLR_D(iblock,nBas,nC,nO,nV,nR,nOOs,1d0,eGT,ERI,Dpp)
|
||||
|
||||
call ppLR(TDA_T,nOOs,nVVs,Bpp,Cpp,Dpp,Om1s,X1s,Y1s,Om2s,X2s,Y2s,EcRPA(ispin))
|
||||
|
||||
@ -232,9 +235,9 @@ subroutine RG0T0pp(dotest,doACFDT,exchange_kernel,doXBS,dophBSE,TDA_T,TDA,dBSE,d
|
||||
|
||||
allocate(Bpp(nVVt,nOOt),Cpp(nVVt,nVVt),Dpp(nOOt,nOOt))
|
||||
|
||||
call ppLR_C(iblock,nBas,nC,nO,nV,nR,nVVt,1d0,eGT,ERI,Cpp)
|
||||
call ppLR_D(iblock,nBas,nC,nO,nV,nR,nOOt,1d0,eGT,ERI,Dpp)
|
||||
if(.not.TDA_T) call ppLR_B(iblock,nBas,nC,nO,nV,nR,nOOt,nVVt,1d0,ERI,Bpp)
|
||||
call ppLR_C(iblock,nBas,nC,nO,nV,nR,nVVt,1d0,eGT,ERI,Cpp)
|
||||
call ppLR_D(iblock,nBas,nC,nO,nV,nR,nOOt,1d0,eGT,ERI,Dpp)
|
||||
|
||||
call ppLR(TDA_T,nOOt,nVVt,Bpp,Cpp,Dpp,Om1t,X1t,Y1t,Om2t,X2t,Y2t,EcRPA(ispin))
|
||||
|
||||
|
||||
@ -1,7 +1,11 @@
|
||||
subroutine RGT(dotest,doG0T0pp,doevGTpp,doqsGTpp,doufG0T0pp,doG0T0eh,doevGTeh,doqsGTeh,maxSCF,thresh,max_diis, &
|
||||
doACFDT,exchange_kernel,doXBS,dophBSE,dophBSE2,doppBSE,TDA_T,TDA,dBSE,dTDA,singlet,triplet, &
|
||||
linearize,eta,regularize,nNuc,ZNuc,rNuc,ENuc,nBas,nC,nO,nV,nR,nS,ERHF,S,X,T,V,Hc, &
|
||||
ERI_AO,ERI_MO,dipole_int_AO,dipole_int,PHF,cHF,eHF)
|
||||
|
||||
! ---
|
||||
|
||||
subroutine RGT(dotest, doG0T0pp, doevGTpp, doqsGTpp, doufG0T0pp, doG0T0eh, doevGTeh, doqsGTeh, &
|
||||
maxSCF, thresh, max_diis, doACFDT, exchange_kernel, doXBS, dophBSE, dophBSE2, &
|
||||
doppBSE, TDA_T, TDA, dBSE, dTDA, singlet, triplet, linearize, eta, regularize, &
|
||||
nNuc, ZNuc, rNuc, ENuc, nBas, nOrb, nC, nO, nV, nR, nS, ERHF, S, X, T, &
|
||||
V, Hc, ERI_AO, ERI_MO, dipole_int_AO, dipole_int_MO, PHF, cHF, eHF)
|
||||
|
||||
! T-matrix module
|
||||
|
||||
@ -44,7 +48,7 @@ subroutine RGT(dotest,doG0T0pp,doevGTpp,doqsGTpp,doufG0T0pp,doG0T0eh,doevGTeh,do
|
||||
double precision,intent(in) :: rNuc(nNuc,ncart)
|
||||
double precision,intent(in) :: ENuc
|
||||
|
||||
integer,intent(in) :: nBas
|
||||
integer,intent(in) :: nBas, nOrb
|
||||
integer,intent(in) :: nC
|
||||
integer,intent(in) :: nO
|
||||
integer,intent(in) :: nV
|
||||
@ -52,18 +56,18 @@ subroutine RGT(dotest,doG0T0pp,doevGTpp,doqsGTpp,doufG0T0pp,doG0T0eh,doevGTeh,do
|
||||
integer,intent(in) :: nS
|
||||
|
||||
double precision,intent(in) :: ERHF
|
||||
double precision,intent(in) :: eHF(nBas)
|
||||
double precision,intent(in) :: cHF(nBas,nBas)
|
||||
double precision,intent(in) :: eHF(nOrb)
|
||||
double precision,intent(in) :: cHF(nBas,nOrb)
|
||||
double precision,intent(in) :: PHF(nBas,nBas)
|
||||
double precision,intent(in) :: S(nBas,nBas)
|
||||
double precision,intent(in) :: T(nBas,nBas)
|
||||
double precision,intent(in) :: V(nBas,nBas)
|
||||
double precision,intent(in) :: Hc(nBas,nBas)
|
||||
double precision,intent(in) :: X(nBas,nBas)
|
||||
double precision,intent(in) :: X(nBas,nOrb)
|
||||
double precision,intent(in) :: ERI_AO(nBas,nBas,nBas,nBas)
|
||||
double precision,intent(in) :: ERI_MO(nBas,nBas,nBas,nBas)
|
||||
double precision,intent(in) :: ERI_MO(nOrb,nOrb,nOrb,nOrb)
|
||||
double precision,intent(in) :: dipole_int_AO(nBas,nBas,ncart)
|
||||
double precision,intent(in) :: dipole_int(nBas,nBas,ncart)
|
||||
double precision,intent(in) :: dipole_int_MO(nOrb,nOrb,ncart)
|
||||
|
||||
|
||||
! Local variables
|
||||
@ -78,11 +82,11 @@ subroutine RGT(dotest,doG0T0pp,doevGTpp,doqsGTpp,doufG0T0pp,doG0T0eh,doevGTeh,do
|
||||
|
||||
call wall_time(start_GT)
|
||||
call RG0T0pp(dotest,doACFDT,exchange_kernel,doXBS,dophBSE,TDA_T,TDA,dBSE,dTDA,doppBSE,singlet,triplet, &
|
||||
linearize,eta,regularize,nBas,nC,nO,nV,nR,nS,ENuc,ERHF,ERI_MO,dipole_int,eHF)
|
||||
linearize,eta,regularize,nOrb,nC,nO,nV,nR,nS,ENuc,ERHF,ERI_MO,dipole_int_MO,eHF)
|
||||
call wall_time(end_GT)
|
||||
|
||||
t_GT = end_GT - start_GT
|
||||
write(*,'(A65,1X,F9.3,A8)') 'Total CPU time for G0T0pp = ',t_GT,' seconds'
|
||||
write(*,'(A65,1X,F9.3,A8)') 'Total wall time for G0T0pp = ',t_GT,' seconds'
|
||||
write(*,*)
|
||||
|
||||
end if
|
||||
@ -95,11 +99,11 @@ subroutine RGT(dotest,doG0T0pp,doevGTpp,doqsGTpp,doufG0T0pp,doG0T0eh,doevGTeh,do
|
||||
|
||||
call wall_time(start_GT)
|
||||
call evRGTpp(dotest,maxSCF,thresh,max_diis,doACFDT,exchange_kernel,doXBS,dophBSE,TDA_T,TDA,dBSE,dTDA,singlet,triplet, &
|
||||
linearize,eta,regularize,nBas,nC,nO,nV,nR,nS,ENuc,ERHF,ERI_MO,dipole_int,eHF)
|
||||
linearize,eta,regularize,nOrb,nC,nO,nV,nR,nS,ENuc,ERHF,ERI_MO,dipole_int_MO,eHF)
|
||||
call wall_time(end_GT)
|
||||
|
||||
t_GT = end_GT - start_GT
|
||||
write(*,'(A65,1X,F9.3,A8)') 'Total CPU time for evGTpp = ',t_GT,' seconds'
|
||||
write(*,'(A65,1X,F9.3,A8)') 'Total wall time for evGTpp = ',t_GT,' seconds'
|
||||
write(*,*)
|
||||
|
||||
end if
|
||||
@ -111,13 +115,13 @@ subroutine RGT(dotest,doG0T0pp,doevGTpp,doqsGTpp,doufG0T0pp,doG0T0eh,doevGTeh,do
|
||||
if(doqsGTpp) then
|
||||
|
||||
call wall_time(start_GT)
|
||||
call qsRGTpp(dotest,maxSCF,thresh,max_diis,doACFDT,exchange_kernel,doXBS,dophBSE,TDA_T,TDA,dBSE,dTDA,singlet,triplet, &
|
||||
eta,regularize,nNuc,ZNuc,rNuc,ENuc,nBas,nC,nO,nV,nR,nS,ERHF,S,X,T,V,Hc,ERI_AO,ERI_MO,dipole_int_AO,dipole_int, &
|
||||
PHF,cHF,eHF)
|
||||
call qsRGTpp(dotest, maxSCF, thresh, max_diis, doACFDT, exchange_kernel, doXBS, dophBSE, TDA_T, TDA, dBSE, &
|
||||
dTDA, singlet, triplet, eta, regularize, nNuc, ZNuc, rNuc, ENuc, nBas, nOrb, nC, nO, &
|
||||
nV, nR, nS, ERHF, S, X, T, V, Hc, ERI_AO, ERI_MO, dipole_int_AO, dipole_int_MO, PHF, cHF, eHF)
|
||||
call wall_time(end_GT)
|
||||
|
||||
t_GT = end_GT - start_GT
|
||||
write(*,'(A65,1X,F9.3,A8)') 'Total CPU time for qsGTpp = ',t_GT,' seconds'
|
||||
write(*,'(A65,1X,F9.3,A8)') 'Total wall time for qsGTpp = ',t_GT,' seconds'
|
||||
write(*,*)
|
||||
|
||||
end if
|
||||
@ -129,11 +133,11 @@ subroutine RGT(dotest,doG0T0pp,doevGTpp,doqsGTpp,doufG0T0pp,doG0T0eh,doevGTeh,do
|
||||
if(doufG0T0pp) then
|
||||
|
||||
call wall_time(start_GT)
|
||||
call ufG0T0pp(dotest,TDA_T,nBas,nC,nO,nV,nR,nS,ENuc,ERHF,ERI_MO,eHF)
|
||||
call ufG0T0pp(dotest,TDA_T,nOrb,nC,nO,nV,nR,nS,ENuc,ERHF,ERI_MO,eHF)
|
||||
call wall_time(end_GT)
|
||||
|
||||
t_GT = end_GT - start_GT
|
||||
write(*,'(A65,1X,F9.3,A8)') 'Total CPU time for ufG0T0pp = ',t_GT,' seconds'
|
||||
write(*,'(A65,1X,F9.3,A8)') 'Total wall time for ufG0T0pp = ',t_GT,' seconds'
|
||||
write(*,*)
|
||||
|
||||
end if
|
||||
@ -146,11 +150,11 @@ subroutine RGT(dotest,doG0T0pp,doevGTpp,doqsGTpp,doufG0T0pp,doG0T0eh,doevGTeh,do
|
||||
|
||||
call wall_time(start_GT)
|
||||
call RG0T0eh(dotest,doACFDT,exchange_kernel,doXBS,dophBSE,dophBSE2,TDA_T,TDA,dBSE,dTDA,doppBSE,singlet,triplet, &
|
||||
linearize,eta,regularize,nBas,nC,nO,nV,nR,nS,ENuc,ERHF,ERI_MO,dipole_int,eHF)
|
||||
linearize,eta,regularize,nOrb,nC,nO,nV,nR,nS,ENuc,ERHF,ERI_MO,dipole_int_MO,eHF)
|
||||
call wall_time(end_GT)
|
||||
|
||||
t_GT = end_GT - start_GT
|
||||
write(*,'(A65,1X,F9.3,A8)') 'Total CPU time for G0T0eh = ',t_GT,' seconds'
|
||||
write(*,'(A65,1X,F9.3,A8)') 'Total wall time for G0T0eh = ',t_GT,' seconds'
|
||||
write(*,*)
|
||||
|
||||
end if
|
||||
@ -163,11 +167,11 @@ subroutine RGT(dotest,doG0T0pp,doevGTpp,doqsGTpp,doufG0T0pp,doG0T0eh,doevGTeh,do
|
||||
|
||||
call wall_time(start_GT)
|
||||
call evRGTeh(dotest,maxSCF,thresh,max_diis,doACFDT,exchange_kernel,doXBS,dophBSE,dophBSE2,TDA_T,TDA,dBSE,dTDA,doppBSE, &
|
||||
singlet,triplet,linearize,eta,regularize,nBas,nC,nO,nV,nR,nS,ENuc,ERHF,ERI_MO,dipole_int,eHF)
|
||||
singlet,triplet,linearize,eta,regularize,nOrb,nC,nO,nV,nR,nS,ENuc,ERHF,ERI_MO,dipole_int_MO,eHF)
|
||||
call wall_time(end_GT)
|
||||
|
||||
t_GT = end_GT - start_GT
|
||||
write(*,'(A65,1X,F9.3,A8)') 'Total CPU time for evGTeh = ',t_GT,' seconds'
|
||||
write(*,'(A65,1X,F9.3,A8)') 'Total wall time for evGTeh = ',t_GT,' seconds'
|
||||
write(*,*)
|
||||
|
||||
end if
|
||||
@ -179,13 +183,14 @@ subroutine RGT(dotest,doG0T0pp,doevGTpp,doqsGTpp,doufG0T0pp,doG0T0eh,doevGTeh,do
|
||||
if(doqsGTeh) then
|
||||
|
||||
call wall_time(start_GT)
|
||||
call qsRGTeh(dotest,maxSCF,thresh,max_diis,doACFDT,exchange_kernel,doXBS,dophBSE,dophBSE2,TDA_T,TDA,dBSE,dTDA,singlet,triplet, &
|
||||
eta,regularize,nNuc,ZNuc,rNuc,ENuc,nBas,nC,nO,nV,nR,nS,ERHF,S,X,T,V,Hc,ERI_AO,ERI_MO,dipole_int_AO,dipole_int, &
|
||||
PHF,cHF,eHF)
|
||||
call qsRGTeh(dotest, maxSCF, thresh, max_diis, doACFDT, exchange_kernel, doXBS, dophBSE, &
|
||||
dophBSE2, TDA_T, TDA, dBSE, dTDA, singlet, triplet, eta, regularize, nNuc, &
|
||||
ZNuc, rNuc, ENuc, nBas, nOrb, nC, nO, nV, nR, nS, ERHF, S, X, T, V, &
|
||||
Hc, ERI_AO, ERI_MO, dipole_int_AO, dipole_int_MO, PHF, cHF, eHF)
|
||||
call wall_time(end_GT)
|
||||
|
||||
t_GT = end_GT - start_GT
|
||||
write(*,'(A65,1X,F9.3,A8)') 'Total CPU time for qsGTeh = ',t_GT,' seconds'
|
||||
write(*,'(A65,1X,F9.3,A8)') 'Total wall time for qsGTeh = ',t_GT,' seconds'
|
||||
write(*,*)
|
||||
|
||||
end if
|
||||
|
||||
@ -1,4 +1,8 @@
|
||||
subroutine print_qsRGTeh(nBas,nO,nSCF,Conv,thresh,eHF,eGT,c,SigC,Z,ENuc,ET,EV,EJ,Ex,EcGM,EcRPA,EqsGT,dipole)
|
||||
|
||||
! ---
|
||||
|
||||
subroutine print_qsRGTeh(nBas, nOrb, nO, nSCF, Conv, thresh, eHF, eGT, c, SigC, &
|
||||
Z, ENuc, ET, EV, EJ, Ex, EcGM, EcRPA, EqsGT, dipole)
|
||||
|
||||
! Print one-electron energies and other stuff for qsGTeh
|
||||
|
||||
@ -7,7 +11,7 @@ subroutine print_qsRGTeh(nBas,nO,nSCF,Conv,thresh,eHF,eGT,c,SigC,Z,ENuc,ET,EV,EJ
|
||||
|
||||
! Input variables
|
||||
|
||||
integer,intent(in) :: nBas
|
||||
integer,intent(in) :: nBas, nOrb
|
||||
integer,intent(in) :: nO
|
||||
integer,intent(in) :: nSCF
|
||||
double precision,intent(in) :: ENuc
|
||||
@ -19,11 +23,11 @@ subroutine print_qsRGTeh(nBas,nO,nSCF,Conv,thresh,eHF,eGT,c,SigC,Z,ENuc,ET,EV,EJ
|
||||
double precision,intent(in) :: EcRPA(nspin)
|
||||
double precision,intent(in) :: Conv
|
||||
double precision,intent(in) :: thresh
|
||||
double precision,intent(in) :: eHF(nBas)
|
||||
double precision,intent(in) :: eGT(nBas)
|
||||
double precision,intent(in) :: c(nBas)
|
||||
double precision,intent(in) :: SigC(nBas,nBas)
|
||||
double precision,intent(in) :: Z(nBas)
|
||||
double precision,intent(in) :: eHF(nOrb)
|
||||
double precision,intent(in) :: eGT(nOrb)
|
||||
double precision,intent(in) :: c(nBas,nOrb)
|
||||
double precision,intent(in) :: SigC(nOrb,nOrb)
|
||||
double precision,intent(in) :: Z(nOrb)
|
||||
double precision,intent(in) :: EqsGT
|
||||
double precision,intent(in) :: dipole(ncart)
|
||||
|
||||
@ -58,7 +62,7 @@ subroutine print_qsRGTeh(nBas,nO,nSCF,Conv,thresh,eHF,eGT,c,SigC,Z,ENuc,ET,EV,EJ
|
||||
'|','#','|','e_HF (eV)','|','Sig_GTeh (eV)','|','Z','|','e_GTeh (eV)','|'
|
||||
write(*,*)'-------------------------------------------------------------------------------'
|
||||
|
||||
do p=1,nBas
|
||||
do p=1,nOrb
|
||||
write(*,'(1X,A1,1X,I3,1X,A1,1X,F15.6,1X,A1,1X,F15.6,1X,A1,1X,F15.6,1X,A1,1X,F15.6,1X,A1,1X)') &
|
||||
'|',p,'|',eHF(p)*HaToeV,'|',SigC(p,p)*HaToeV,'|',Z(p),'|',eGT(p)*HaToeV,'|'
|
||||
end do
|
||||
@ -109,13 +113,13 @@ subroutine print_qsRGTeh(nBas,nO,nSCF,Conv,thresh,eHF,eGT,c,SigC,Z,ENuc,ET,EV,EJ
|
||||
write(*,'(A50)') '---------------------------------------'
|
||||
write(*,'(A32)') ' qsGTeh MO coefficients'
|
||||
write(*,'(A50)') '---------------------------------------'
|
||||
call matout(nBas,nBas,c)
|
||||
call matout(nBas, nOrb, c)
|
||||
write(*,*)
|
||||
end if
|
||||
write(*,'(A50)') '---------------------------------------'
|
||||
write(*,'(A32)') ' qsGTeh MO energies'
|
||||
write(*,'(A50)') '---------------------------------------'
|
||||
call vecout(nBas,eGT)
|
||||
call vecout(nOrb, eGT)
|
||||
write(*,*)
|
||||
|
||||
end if
|
||||
|
||||
@ -1,4 +1,8 @@
|
||||
subroutine print_qsRGTpp(nBas,nO,nSCF,Conv,thresh,eHF,eGT,c,SigC,Z,ENuc,ET,EV,EJ,Ex,EcGM,EcRPA,EqsGT,dipole)
|
||||
|
||||
! ---
|
||||
|
||||
subroutine print_qsRGTpp(nBas, nOrb, nO, nSCF, Conv, thresh, eHF, eGT, c, SigC, Z, &
|
||||
ENuc, ET, EV, EJ, Ex, EcGM, EcRPA, EqsGT, dipole)
|
||||
|
||||
! Print one-electron energies and other stuff for qsGT
|
||||
|
||||
@ -7,7 +11,7 @@ subroutine print_qsRGTpp(nBas,nO,nSCF,Conv,thresh,eHF,eGT,c,SigC,Z,ENuc,ET,EV,EJ
|
||||
|
||||
! Input variables
|
||||
|
||||
integer,intent(in) :: nBas
|
||||
integer,intent(in) :: nBas, nOrb
|
||||
integer,intent(in) :: nO
|
||||
integer,intent(in) :: nSCF
|
||||
double precision,intent(in) :: ENuc
|
||||
@ -19,11 +23,11 @@ subroutine print_qsRGTpp(nBas,nO,nSCF,Conv,thresh,eHF,eGT,c,SigC,Z,ENuc,ET,EV,EJ
|
||||
double precision,intent(in) :: EcRPA(nspin)
|
||||
double precision,intent(in) :: Conv
|
||||
double precision,intent(in) :: thresh
|
||||
double precision,intent(in) :: eHF(nBas)
|
||||
double precision,intent(in) :: eGT(nBas)
|
||||
double precision,intent(in) :: c(nBas)
|
||||
double precision,intent(in) :: SigC(nBas,nBas)
|
||||
double precision,intent(in) :: Z(nBas)
|
||||
double precision,intent(in) :: eHF(nOrb)
|
||||
double precision,intent(in) :: eGT(nOrb)
|
||||
double precision,intent(in) :: c(nBas,nOrb)
|
||||
double precision,intent(in) :: SigC(nOrb,nOrb)
|
||||
double precision,intent(in) :: Z(nOrb)
|
||||
double precision,intent(in) :: EqsGT
|
||||
double precision,intent(in) :: dipole(ncart)
|
||||
|
||||
@ -58,7 +62,7 @@ subroutine print_qsRGTpp(nBas,nO,nSCF,Conv,thresh,eHF,eGT,c,SigC,Z,ENuc,ET,EV,EJ
|
||||
'|','#','|','e_HF (eV)','|','Sig_GTpp (eV)','|','Z','|','e_GTpp (eV)','|'
|
||||
write(*,*)'-------------------------------------------------------------------------------'
|
||||
|
||||
do p=1,nBas
|
||||
do p=1,nOrb
|
||||
write(*,'(1X,A1,1X,I3,1X,A1,1X,F15.6,1X,A1,1X,F15.6,1X,A1,1X,F15.6,1X,A1,1X,F15.6,1X,A1,1X)') &
|
||||
'|',p,'|',eHF(p)*HaToeV,'|',SigC(p,p)*HaToeV,'|',Z(p),'|',eGT(p)*HaToeV,'|'
|
||||
end do
|
||||
@ -109,13 +113,13 @@ subroutine print_qsRGTpp(nBas,nO,nSCF,Conv,thresh,eHF,eGT,c,SigC,Z,ENuc,ET,EV,EJ
|
||||
write(*,'(A50)') '---------------------------------------'
|
||||
write(*,'(A32)') ' qsGTpp MO coefficients'
|
||||
write(*,'(A50)') '---------------------------------------'
|
||||
call matout(nBas,nBas,c)
|
||||
call matout(nBas, nOrb, c)
|
||||
write(*,*)
|
||||
end if
|
||||
write(*,'(A50)') '---------------------------------------'
|
||||
write(*,'(A32)') ' qsGTpp MO energies'
|
||||
write(*,'(A50)') '---------------------------------------'
|
||||
call vecout(nBas,eGT)
|
||||
call vecout(nOrb, eGT)
|
||||
write(*,*)
|
||||
|
||||
end if
|
||||
|
||||
@ -1,6 +1,10 @@
|
||||
subroutine qsRGTeh(dotest,maxSCF,thresh,max_diis,doACFDT,exchange_kernel,doXBS,dophBSE,dophBSE2,TDA_T,TDA, &
|
||||
dBSE,dTDA,singlet,triplet,eta,regularize,nNuc,ZNuc,rNuc,ENuc,nBas,nC,nO,nV,nR,nS,ERHF, &
|
||||
S,X,T,V,Hc,ERI_AO,ERI_MO,dipole_int_AO,dipole_int_MO,PHF,cHF,eHF)
|
||||
|
||||
! ---
|
||||
|
||||
subroutine qsRGTeh(dotest, maxSCF, thresh, max_diis, doACFDT, exchange_kernel, doXBS, dophBSE, &
|
||||
dophBSE2, TDA_T, TDA, dBSE, dTDA, singlet, triplet, eta, regularize, nNuc, &
|
||||
ZNuc, rNuc, ENuc, nBas, nOrb, nC, nO, nV, nR, nS, ERHF, S, X, T, V, &
|
||||
Hc, ERI_AO, ERI_MO, dipole_int_AO, dipole_int_MO, PHF, cHF, eHF)
|
||||
|
||||
! Perform a quasiparticle self-consistent GTeh calculation
|
||||
|
||||
@ -33,31 +37,31 @@ subroutine qsRGTeh(dotest,maxSCF,thresh,max_diis,doACFDT,exchange_kernel,doXBS,d
|
||||
double precision,intent(in) :: rNuc(nNuc,ncart)
|
||||
double precision,intent(in) :: ENuc
|
||||
|
||||
integer,intent(in) :: nBas
|
||||
integer,intent(in) :: nBas, nOrb
|
||||
integer,intent(in) :: nC
|
||||
integer,intent(in) :: nO
|
||||
integer,intent(in) :: nV
|
||||
integer,intent(in) :: nR
|
||||
integer,intent(in) :: nS
|
||||
double precision,intent(in) :: ERHF
|
||||
double precision,intent(in) :: eHF(nBas)
|
||||
double precision,intent(in) :: cHF(nBas,nBas)
|
||||
double precision,intent(in) :: eHF(nOrb)
|
||||
double precision,intent(in) :: cHF(nBas,nOrb)
|
||||
double precision,intent(in) :: PHF(nBas,nBas)
|
||||
double precision,intent(in) :: S(nBas,nBas)
|
||||
double precision,intent(in) :: T(nBas,nBas)
|
||||
double precision,intent(in) :: V(nBas,nBas)
|
||||
double precision,intent(in) :: Hc(nBas,nBas)
|
||||
double precision,intent(in) :: X(nBas,nBas)
|
||||
double precision,intent(in) :: X(nBas,nOrb)
|
||||
double precision,intent(in) :: ERI_AO(nBas,nBas,nBas,nBas)
|
||||
double precision,intent(inout):: ERI_MO(nBas,nBas,nBas,nBas)
|
||||
double precision,intent(inout):: ERI_MO(nOrb,nOrb,nOrb,nOrb)
|
||||
double precision,intent(in) :: dipole_int_AO(nBas,nBas,ncart)
|
||||
double precision,intent(in) :: dipole_int_MO(nBas,nBas,ncart)
|
||||
double precision,intent(in) :: dipole_int_MO(nOrb,nOrb,ncart)
|
||||
|
||||
! Local variables
|
||||
|
||||
logical :: dRPA = .false.
|
||||
integer :: nSCF
|
||||
integer :: nBasSq
|
||||
integer :: nBas_Sq
|
||||
integer :: ispin
|
||||
integer :: n_diis
|
||||
double precision :: ET
|
||||
@ -113,7 +117,7 @@ subroutine qsRGTeh(dotest,maxSCF,thresh,max_diis,doACFDT,exchange_kernel,doXBS,d
|
||||
|
||||
! Stuff
|
||||
|
||||
nBasSq = nBas*nBas
|
||||
nBas_Sq = nBas*nBas
|
||||
|
||||
! TDA for T
|
||||
|
||||
@ -131,9 +135,29 @@ subroutine qsRGTeh(dotest,maxSCF,thresh,max_diis,doACFDT,exchange_kernel,doXBS,d
|
||||
|
||||
! Memory allocation
|
||||
|
||||
allocate(Aph(nS,nS),Bph(nS,nS),eGT(nBas),eOld(nBas),c(nBas,nBas),cp(nBas,nBas),P(nBas,nBas),F(nBas,nBas),Fp(nBas,nBas), &
|
||||
J(nBas,nBas),K(nBas,nBas),Sig(nBas,nBas),Sigp(nBas,nBas),Z(nBas),Om(nS),XpY(nS,nS),XmY(nS,nS), &
|
||||
rhoL(nBas,nBas,nS),rhoR(nBas,nBas,nS),err(nBas,nBas),err_diis(nBasSq,max_diis),F_diis(nBasSq,max_diis))
|
||||
allocate(Aph(nS,nS), Bph(nS,nS), Om(nS), XpY(nS,nS), XmY(nS,nS))
|
||||
|
||||
allocate(eGT(nOrb))
|
||||
allocate(eOld(nOrb))
|
||||
allocate(Z(nOrb))
|
||||
|
||||
allocate(c(nBas,nOrb))
|
||||
|
||||
allocate(cp(nOrb,nOrb))
|
||||
allocate(Fp(nOrb,nOrb))
|
||||
allocate(Sig(nOrb,nOrb))
|
||||
|
||||
allocate(P(nBas,nBas))
|
||||
allocate(F(nBas,nBas))
|
||||
allocate(J(nBas,nBas))
|
||||
allocate(K(nBas,nBas))
|
||||
allocate(Sigp(nBas,nBas))
|
||||
allocate(err(nBas,nBas))
|
||||
|
||||
allocate(err_diis(nBas_Sq,max_diis), F_diis(nBas_Sq,max_diis))
|
||||
|
||||
allocate(rhoL(nOrb,nOrb,nS), rhoR(nOrb,nOrb,nS))
|
||||
|
||||
|
||||
! Initialization
|
||||
|
||||
@ -169,12 +193,12 @@ subroutine qsRGTeh(dotest,maxSCF,thresh,max_diis,doACFDT,exchange_kernel,doXBS,d
|
||||
|
||||
! AO to MO transformation of two-electron integrals
|
||||
|
||||
call AOtoMO_ERI_RHF(nBas,c,ERI_AO,ERI_MO)
|
||||
call AOtoMO_ERI_RHF(nBas, nOrb, c, ERI_AO, ERI_MO)
|
||||
|
||||
! Compute linear response
|
||||
|
||||
call phLR_A(ispin,dRPA,nBas,nC,nO,nV,nR,nS,1d0,eGT,ERI_MO,Aph)
|
||||
if(.not.TDA_T) call phLR_B(ispin,dRPA,nBas,nC,nO,nV,nR,nS,1d0,ERI_MO,Bph)
|
||||
call phLR_A(ispin,dRPA,nOrb,nC,nO,nV,nR,nS,1d0,eGT,ERI_MO,Aph)
|
||||
if(.not.TDA_T) call phLR_B(ispin,dRPA,nOrb,nC,nO,nV,nR,nS,1d0,ERI_MO,Bph)
|
||||
|
||||
call phLR(TDA_T,nS,Aph,Bph,EcRPA,Om,XpY,XmY)
|
||||
|
||||
@ -182,21 +206,25 @@ subroutine qsRGTeh(dotest,maxSCF,thresh,max_diis,doACFDT,exchange_kernel,doXBS,d
|
||||
|
||||
! Compute correlation part of the self-energy
|
||||
|
||||
call GTeh_excitation_density(nBas,nC,nO,nR,nS,ERI_MO,XpY,XmY,rhoL,rhoR)
|
||||
call GTeh_excitation_density(nOrb,nC,nO,nR,nS,ERI_MO,XpY,XmY,rhoL,rhoR)
|
||||
|
||||
if(regularize) call GTeh_regularization(nBas,nC,nO,nV,nR,nS,eGT,Om,rhoL,rhoR)
|
||||
if(regularize) call GTeh_regularization(nOrb,nC,nO,nV,nR,nS,eGT,Om,rhoL,rhoR)
|
||||
|
||||
call GTeh_self_energy(eta,nBas,nC,nO,nV,nR,nS,eGT,Om,rhoL,rhoR,EcGM,Sig,Z)
|
||||
call GTeh_self_energy(eta,nOrb,nC,nO,nV,nR,nS,eGT,Om,rhoL,rhoR,EcGM,Sig,Z)
|
||||
|
||||
! Make correlation self-energy Hermitian and transform it back to AO basis
|
||||
|
||||
Sig = 0.5d0*(Sig + transpose(Sig))
|
||||
|
||||
call MOtoAO(nBas,S,c,Sig,Sigp)
|
||||
call MOtoAO(nBas, nOrb, S, c, Sig, Sigp)
|
||||
|
||||
! Solve the quasi-particle equation
|
||||
|
||||
F(:,:) = Hc(:,:) + J(:,:) + 0.5d0*K(:,:) + Sigp(:,:)
|
||||
if(nBas .ne. nOrb) then
|
||||
call AOtoMO(nBas, nOrb, c(1,1), F(1,1), Fp(1,1))
|
||||
call MOtoAO(nBas, nOrb, S(1,1), c(1,1), Fp(1,1), F(1,1))
|
||||
endif
|
||||
|
||||
! Compute commutator and convergence criteria
|
||||
|
||||
@ -207,17 +235,23 @@ subroutine qsRGTeh(dotest,maxSCF,thresh,max_diis,doACFDT,exchange_kernel,doXBS,d
|
||||
if(max_diis > 1) then
|
||||
|
||||
n_diis = min(n_diis+1,max_diis)
|
||||
call DIIS_extrapolation(rcond,nBasSq,nBasSq,n_diis,err_diis,F_diis,err,F)
|
||||
call DIIS_extrapolation(rcond,nBas_Sq,nBas_Sq,n_diis,err_diis,F_diis,err,F)
|
||||
|
||||
end if
|
||||
|
||||
! Diagonalize Hamiltonian in AO basis
|
||||
|
||||
Fp = matmul(transpose(X),matmul(F,X))
|
||||
cp(:,:) = Fp(:,:)
|
||||
call diagonalize_matrix(nBas,cp,eGT)
|
||||
c = matmul(X,cp)
|
||||
Sigp = matmul(transpose(c),matmul(Sigp,c))
|
||||
if(nBas .eq. nOrb) then
|
||||
Fp = matmul(transpose(X), matmul(F, X))
|
||||
cp(:,:) = Fp(:,:)
|
||||
call diagonalize_matrix(nOrb, cp, eGT)
|
||||
c = matmul(X, cp)
|
||||
else
|
||||
Fp = matmul(transpose(c), matmul(F, c))
|
||||
cp(:,:) = Fp(:,:)
|
||||
call diagonalize_matrix(nOrb, cp, eGT)
|
||||
c = matmul(c, cp)
|
||||
endif
|
||||
|
||||
! Compute new density matrix in the AO basis
|
||||
|
||||
@ -255,7 +289,8 @@ subroutine qsRGTeh(dotest,maxSCF,thresh,max_diis,doACFDT,exchange_kernel,doXBS,d
|
||||
! Print results
|
||||
|
||||
call dipole_moment(nBas,P,nNuc,ZNuc,rNuc,dipole_int_AO,dipole)
|
||||
call print_qsRGTeh(nBas,nO,nSCF,Conv,thresh,eHF,eGT,c,Sigp,Z,ENuc,ET,EV,EJ,Ex,EcGM,EcRPA,EqsGT,dipole)
|
||||
call print_qsRGTeh(nBas, nOrb, nO, nSCF, Conv, thresh, eHF, eGT, c, Sig, &
|
||||
Z, ENuc, ET, EV, EJ, Ex, EcGM, EcRPA, EqsGT, dipole)
|
||||
|
||||
end do
|
||||
!------------------------------------------------------------------------
|
||||
@ -272,13 +307,15 @@ subroutine qsRGTeh(dotest,maxSCF,thresh,max_diis,doACFDT,exchange_kernel,doXBS,d
|
||||
write(*,*)'!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!'
|
||||
write(*,*)
|
||||
|
||||
deallocate(c, cp, P, F, Fp, J, K, Sig, Sigp, Z, Om, XpY, XmY, rhoL, rhoR, err, err_diis, F_diis)
|
||||
|
||||
stop
|
||||
|
||||
end if
|
||||
|
||||
! Deallocate memory
|
||||
|
||||
deallocate(c,cp,P,F,Fp,J,K,Sig,Sigp,Z,Om,XpY,XmY,rhoL,rhoR,err,err_diis,F_diis)
|
||||
deallocate(c, cp, P, F, Fp, J, K, Sig, Sigp, Z, Om, XpY, XmY, rhoL, rhoR, err, err_diis, F_diis)
|
||||
|
||||
! Perform BSE calculation
|
||||
|
||||
|
||||
@ -1,6 +1,9 @@
|
||||
subroutine qsRGTpp(dotest,maxSCF,thresh,max_diis,doACFDT,exchange_kernel,doXBS,dophBSE,TDA_T,TDA, &
|
||||
dBSE,dTDA,singlet,triplet,eta,regularize,nNuc,ZNuc,rNuc,ENuc,nBas,nC,nO,nV,nR,nS,ERHF, &
|
||||
S,X,T,V,Hc,ERI_AO,ERI_MO,dipole_int_AO,dipole_int_MO,PHF,cHF,eHF)
|
||||
|
||||
! ---
|
||||
|
||||
subroutine qsRGTpp(dotest, maxSCF, thresh, max_diis, doACFDT, exchange_kernel, doXBS, dophBSE, TDA_T, TDA, &
|
||||
dBSE, dTDA, singlet, triplet, eta, regularize, nNuc, ZNuc, rNuc, ENuc, nBas, nOrb, &
|
||||
nC, nO, nV, nR, nS, ERHF, S, X, T, V, Hc, ERI_AO, ERI_MO, dipole_int_AO, dipole_int_MO, PHF, cHF, eHF)
|
||||
|
||||
! Perform a quasiparticle self-consistent GT calculation
|
||||
|
||||
@ -31,25 +34,26 @@ subroutine qsRGTpp(dotest,maxSCF,thresh,max_diis,doACFDT,exchange_kernel,doXBS,d
|
||||
double precision,intent(in) :: rNuc(nNuc,ncart)
|
||||
double precision,intent(in) :: ENuc
|
||||
|
||||
integer,intent(in) :: nBas,nC,nO,nV,nR,nS
|
||||
integer,intent(in) :: nBas, nOrb
|
||||
integer,intent(in) :: nC,nO,nV,nR,nS
|
||||
double precision,intent(in) :: ERHF
|
||||
double precision,intent(in) :: eHF(nBas)
|
||||
double precision,intent(in) :: cHF(nBas,nBas)
|
||||
double precision,intent(in) :: eHF(nOrb)
|
||||
double precision,intent(in) :: cHF(nBas,nOrb)
|
||||
double precision,intent(in) :: PHF(nBas,nBas)
|
||||
double precision,intent(in) :: S(nBas,nBas)
|
||||
double precision,intent(in) :: T(nBas,nBas)
|
||||
double precision,intent(in) :: V(nBas,nBas)
|
||||
double precision,intent(in) :: Hc(nBas,nBas)
|
||||
double precision,intent(in) :: X(nBas,nBas)
|
||||
double precision,intent(in) :: X(nBas,nOrb)
|
||||
double precision,intent(in) :: ERI_AO(nBas,nBas,nBas,nBas)
|
||||
double precision,intent(inout):: ERI_MO(nBas,nBas,nBas,nBas)
|
||||
double precision,intent(inout):: ERI_MO(nOrb,nOrb,nOrb,nOrb)
|
||||
double precision,intent(in) :: dipole_int_AO(nBas,nBas,ncart)
|
||||
double precision,intent(in) :: dipole_int_MO(nBas,nBas,ncart)
|
||||
double precision,intent(in) :: dipole_int_MO(nOrb,nOrb,ncart)
|
||||
|
||||
! Local variables
|
||||
|
||||
integer :: nSCF
|
||||
integer :: nBasSq
|
||||
integer :: nBas_Sq
|
||||
integer :: ispin
|
||||
integer :: iblock
|
||||
integer :: n_diis
|
||||
@ -119,7 +123,7 @@ subroutine qsRGTpp(dotest,maxSCF,thresh,max_diis,doACFDT,exchange_kernel,doXBS,d
|
||||
|
||||
! Stuff
|
||||
|
||||
nBasSq = nBas*nBas
|
||||
nBas_Sq = nBas*nBas
|
||||
|
||||
! TDA for T
|
||||
|
||||
@ -137,16 +141,30 @@ subroutine qsRGTpp(dotest,maxSCF,thresh,max_diis,doACFDT,exchange_kernel,doXBS,d
|
||||
|
||||
! Memory allocation
|
||||
|
||||
allocate(eGT(nBas),eOld(nBas),c(nBas,nBas),cp(nBas,nBas),P(nBas,nBas),F(nBas,nBas),Fp(nBas,nBas), &
|
||||
J(nBas,nBas),K(nBas,nBas),Sig(nBas,nBas),Sigp(nBas,nBas),Z(nBas), &
|
||||
error(nBas,nBas),error_diis(nBasSq,max_diis),F_diis(nBasSq,max_diis))
|
||||
allocate(eGT(nOrb))
|
||||
allocate(eOld(nOrb))
|
||||
allocate(Z(nOrb))
|
||||
|
||||
allocate(Om1s(nVVs),X1s(nVVs,nVVs),Y1s(nOOs,nVVs), &
|
||||
Om2s(nOOs),X2s(nVVs,nOOs),Y2s(nOOs,nOOs), &
|
||||
rho1s(nBas,nBas,nVVs),rho2s(nBas,nBas,nOOs), &
|
||||
Om1t(nVVt),X1t(nVVt,nVVt),Y1t(nOOt,nVVt), &
|
||||
Om2t(nOOt),X2t(nVVt,nOOt),Y2t(nOOt,nOOt), &
|
||||
rho1t(nBas,nBas,nVVt),rho2t(nBas,nBas,nOOt))
|
||||
allocate(c(nBas,nOrb))
|
||||
|
||||
allocate(Fp(nOrb,nOrb))
|
||||
allocate(cp(nOrb,nOrb))
|
||||
allocate(Sig(nOrb,nOrb))
|
||||
|
||||
allocate(P(nBas,nBas))
|
||||
allocate(F(nBas,nBas))
|
||||
allocate(J(nBas,nBas))
|
||||
allocate(K(nBas,nBas))
|
||||
allocate(error(nBas,nBas))
|
||||
allocate(Sigp(nBas,nBas))
|
||||
|
||||
allocate(error_diis(nBas_Sq,max_diis))
|
||||
allocate(F_diis(nBas_Sq,max_diis))
|
||||
|
||||
allocate(Om1s(nVVs), X1s(nVVs,nVVs), Y1s(nOOs,nVVs), rho1s(nOrb,nOrb,nVVs))
|
||||
allocate(Om2s(nOOs), X2s(nVVs,nOOs), Y2s(nOOs,nOOs), rho2s(nOrb,nOrb,nOOs))
|
||||
allocate(Om1t(nVVt), X1t(nVVt,nVVt), Y1t(nOOt,nVVt), rho1t(nOrb,nOrb,nVVt))
|
||||
allocate(Om2t(nOOt), X2t(nVVt,nOOt), Y2t(nOOt,nOOt), rho2t(nOrb,nOrb,nOOt))
|
||||
|
||||
! Initialization
|
||||
|
||||
@ -182,7 +200,7 @@ subroutine qsRGTpp(dotest,maxSCF,thresh,max_diis,doACFDT,exchange_kernel,doXBS,d
|
||||
|
||||
! AO to MO transformation of two-electron integrals
|
||||
|
||||
call AOtoMO_ERI_RHF(nBas,c,ERI_AO,ERI_MO)
|
||||
call AOtoMO_ERI_RHF(nBas, nOrb, c, ERI_AO, ERI_MO)
|
||||
|
||||
! Compute linear response
|
||||
|
||||
@ -191,9 +209,9 @@ subroutine qsRGTpp(dotest,maxSCF,thresh,max_diis,doACFDT,exchange_kernel,doXBS,d
|
||||
|
||||
allocate(Bpp(nVVs,nOOs),Cpp(nVVs,nVVs),Dpp(nOOs,nOOs))
|
||||
|
||||
if(.not.TDA_T) call ppLR_B(iblock,nBas,nC,nO,nV,nR,nOOs,nVVs,1d0,ERI_MO,Bpp)
|
||||
call ppLR_C(iblock,nBas,nC,nO,nV,nR,nVVs,1d0,eGT,ERI_MO,Cpp)
|
||||
call ppLR_D(iblock,nBas,nC,nO,nV,nR,nOOs,1d0,eGT,ERI_MO,Dpp)
|
||||
call ppLR_C(iblock,nOrb,nC,nO,nV,nR,nVVs,1d0,eGT,ERI_MO,Cpp)
|
||||
call ppLR_D(iblock,nOrb,nC,nO,nV,nR,nOOs,1d0,eGT,ERI_MO,Dpp)
|
||||
if(.not.TDA_T) call ppLR_B(iblock,nOrb,nC,nO,nV,nR,nOOs,nVVs,1d0,ERI_MO,Bpp)
|
||||
|
||||
call ppLR(TDA_T,nOOs,nVVs,Bpp,Cpp,Dpp,Om1s,X1s,Y1s,Om2s,X2s,Y2s,EcRPA(ispin))
|
||||
|
||||
@ -204,9 +222,9 @@ subroutine qsRGTpp(dotest,maxSCF,thresh,max_diis,doACFDT,exchange_kernel,doXBS,d
|
||||
|
||||
allocate(Bpp(nVVt,nOOt),Cpp(nVVt,nVVt),Dpp(nOOt,nOOt))
|
||||
|
||||
if(.not.TDA_T) call ppLR_B(iblock,nBas,nC,nO,nV,nR,nOOt,nVVt,1d0,ERI_MO,Bpp)
|
||||
call ppLR_C(iblock,nBas,nC,nO,nV,nR,nVVt,1d0,eGT,ERI_MO,Cpp)
|
||||
call ppLR_D(iblock,nBas,nC,nO,nV,nR,nOOt,1d0,eGT,ERI_MO,Dpp)
|
||||
call ppLR_C(iblock,nOrb,nC,nO,nV,nR,nVVt,1d0,eGT,ERI_MO,Cpp)
|
||||
call ppLR_D(iblock,nOrb,nC,nO,nV,nR,nOOt,1d0,eGT,ERI_MO,Dpp)
|
||||
if(.not.TDA_T) call ppLR_B(iblock,nOrb,nC,nO,nV,nR,nOOt,nVVt,1d0,ERI_MO,Bpp)
|
||||
|
||||
call ppLR(TDA_T,nOOt,nVVt,Bpp,Cpp,Dpp,Om1t,X1t,Y1t,Om2t,X2t,Y2t,EcRPA(ispin))
|
||||
|
||||
@ -217,29 +235,33 @@ subroutine qsRGTpp(dotest,maxSCF,thresh,max_diis,doACFDT,exchange_kernel,doXBS,d
|
||||
|
||||
! Compute correlation part of the self-energy
|
||||
|
||||
iblock = 3
|
||||
call GTpp_excitation_density(iblock,nBas,nC,nO,nV,nR,nOOs,nVVs,ERI_MO,X1s,Y1s,rho1s,X2s,Y2s,rho2s)
|
||||
iblock = 3
|
||||
call GTpp_excitation_density(iblock,nOrb,nC,nO,nV,nR,nOOs,nVVs,ERI_MO,X1s,Y1s,rho1s,X2s,Y2s,rho2s)
|
||||
|
||||
iblock = 4
|
||||
call GTpp_excitation_density(iblock,nBas,nC,nO,nV,nR,nOOt,nVVt,ERI_MO,X1t,Y1t,rho1t,X2t,Y2t,rho2t)
|
||||
iblock = 4
|
||||
call GTpp_excitation_density(iblock,nOrb,nC,nO,nV,nR,nOOt,nVVt,ERI_MO,X1t,Y1t,rho1t,X2t,Y2t,rho2t)
|
||||
|
||||
if(regularize) then
|
||||
call GTpp_regularization(eta,nBas,nC,nO,nV,nR,nOOs,nVVs,eGT,Om1s,rho1s,Om2s,rho2s)
|
||||
call GTpp_regularization(eta,nBas,nC,nO,nV,nR,nOOt,nVVt,eGT,Om1t,rho1t,Om2t,rho2t)
|
||||
call GTpp_regularization(eta,nOrb,nC,nO,nV,nR,nOOs,nVVs,eGT,Om1s,rho1s,Om2s,rho2s)
|
||||
call GTpp_regularization(eta,nOrb,nC,nO,nV,nR,nOOt,nVVt,eGT,Om1t,rho1t,Om2t,rho2t)
|
||||
end if
|
||||
|
||||
call GTpp_self_energy(eta,nBas,nC,nO,nV,nR,nOOs,nVVs,nOOt,nVVt,eGT,Om1s,rho1s,Om2s,rho2s, &
|
||||
call GTpp_self_energy(eta,nOrb,nC,nO,nV,nR,nOOs,nVVs,nOOt,nVVt,eGT,Om1s,rho1s,Om2s,rho2s, &
|
||||
Om1t,rho1t,Om2t,rho2t,EcGM,Sig,Z)
|
||||
|
||||
! Make correlation self-energy Hermitian and transform it back to AO basis
|
||||
|
||||
Sig = 0.5d0*(Sig + transpose(Sig))
|
||||
|
||||
call MOtoAO(nBas,S,c,Sig,Sigp)
|
||||
call MOtoAO(nBas, nOrb, S, c, Sig, Sigp)
|
||||
|
||||
! Solve the quasi-particle equation
|
||||
|
||||
F(:,:) = Hc(:,:) + J(:,:) + 0.5d0*K(:,:) + Sigp(:,:)
|
||||
if(nBas .ne. nOrb) then
|
||||
call AOtoMO(nBas, nOrb, c(1,1), F(1,1), Fp(1,1))
|
||||
call MOtoAO(nBas, nOrb, S(1,1), c(1,1), Fp(1,1), F(1,1))
|
||||
endif
|
||||
|
||||
! Compute commutator and convergence criteria
|
||||
|
||||
@ -249,22 +271,28 @@ subroutine qsRGTpp(dotest,maxSCF,thresh,max_diis,doACFDT,exchange_kernel,doXBS,d
|
||||
|
||||
n_diis = min(n_diis+1,max_diis)
|
||||
if(abs(rcond) > 1d-7) then
|
||||
call DIIS_extrapolation(rcond,nBasSq,nBasSq,n_diis,error_diis,F_diis,error,F)
|
||||
call DIIS_extrapolation(rcond,nBas_Sq,nBas_Sq,n_diis,error_diis,F_diis,error,F)
|
||||
else
|
||||
n_diis = 0
|
||||
end if
|
||||
|
||||
! Diagonalize Hamiltonian in AO basis
|
||||
|
||||
Fp = matmul(transpose(X),matmul(F,X))
|
||||
cp(:,:) = Fp(:,:)
|
||||
call diagonalize_matrix(nBas,cp,eGT)
|
||||
c = matmul(X,cp)
|
||||
Sigp = matmul(transpose(c),matmul(Sigp,c))
|
||||
if(nBas .eq. nOrb) then
|
||||
Fp = matmul(transpose(X), matmul(F, X))
|
||||
cp(:,:) = Fp(:,:)
|
||||
call diagonalize_matrix(nOrb, cp, eGT)
|
||||
c = matmul(X, cp)
|
||||
else
|
||||
Fp = matmul(transpose(c), matmul(F, c))
|
||||
cp(:,:) = Fp(:,:)
|
||||
call diagonalize_matrix(nOrb, cp, eGT)
|
||||
c = matmul(c, cp)
|
||||
endif
|
||||
|
||||
! Compute new density matrix in the AO basis
|
||||
|
||||
P(:,:) = 2d0*matmul(c(:,1:nO),transpose(c(:,1:nO)))
|
||||
P(:,:) = 2d0*matmul(c(:,1:nO), transpose(c(:,1:nO)))
|
||||
|
||||
! Save quasiparticles energy for next cycle
|
||||
|
||||
@ -298,7 +326,9 @@ subroutine qsRGTpp(dotest,maxSCF,thresh,max_diis,doACFDT,exchange_kernel,doXBS,d
|
||||
! Print results
|
||||
|
||||
call dipole_moment(nBas,P,nNuc,ZNuc,rNuc,dipole_int_AO,dipole)
|
||||
call print_qsRGTpp(nBas,nO,nSCF,Conv,thresh,eHF,eGT,c,Sigp,Z,ENuc,ET,EV,EJ,Ex,EcGM,EcRPA,EqsGT,dipole)
|
||||
call print_qsRGTpp(nBas, nOrb, nO, nSCF, Conv, thresh, eHF, &
|
||||
eGT, c, Sig, Z, ENuc, ET, EV, EJ, Ex, EcGM, EcRPA, &
|
||||
EqsGT, dipole)
|
||||
|
||||
end do
|
||||
!------------------------------------------------------------------------
|
||||
@ -315,19 +345,24 @@ subroutine qsRGTpp(dotest,maxSCF,thresh,max_diis,doACFDT,exchange_kernel,doXBS,d
|
||||
write(*,*)'!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!'
|
||||
write(*,*)
|
||||
|
||||
deallocate(c, cp, P, F, Fp, J, K, Sig, Sigp, Z, error, error_diis, F_diis)
|
||||
deallocate(Om1s, X1s, Y1s, rho1s)
|
||||
deallocate(Om2s, X2s, Y2s, rho2s)
|
||||
deallocate(Om1t, X1t, Y1t, rho1t)
|
||||
deallocate(Om2t, X2t, Y2t, rho2t)
|
||||
stop
|
||||
|
||||
end if
|
||||
|
||||
! Deallocate memory
|
||||
|
||||
deallocate(c,cp,P,F,Fp,J,K,Sig,Sigp,Z,error,error_diis,F_diis)
|
||||
deallocate(c, cp, P, F, Fp, J, K, Sig, Sigp, Z, error, error_diis, F_diis)
|
||||
|
||||
! Perform BSE calculation
|
||||
|
||||
if(dophBSE) then
|
||||
|
||||
call GTpp_phBSE(TDA_T,TDA,dBSE,dTDA,singlet,triplet,eta,nBas,nC,nO,nV,nR,nS,nOOs,nVVs,nOOt,nVVt, &
|
||||
call GTpp_phBSE(TDA_T,TDA,dBSE,dTDA,singlet,triplet,eta,nOrb,nC,nO,nV,nR,nS,nOOs,nVVs,nOOt,nVVt, &
|
||||
Om1s,X1s,Y1s,Om2s,X2s,Y2s,rho1s,rho2s,Om1t,X1t,Y1t,Om2t,X2t,Y2t,rho1t,rho2t, &
|
||||
ERI_MO,dipole_int_MO,eGT,eGT,EcBSE)
|
||||
|
||||
@ -363,7 +398,7 @@ subroutine qsRGTpp(dotest,maxSCF,thresh,max_diis,doACFDT,exchange_kernel,doXBS,d
|
||||
|
||||
end if
|
||||
|
||||
call GTpp_phACFDT(exchange_kernel,doXBS,.false.,TDA_T,TDA,dophBSE,singlet,triplet,eta,nBas,nC,nO,nV,nR,nS, &
|
||||
call GTpp_phACFDT(exchange_kernel,doXBS,.false.,TDA_T,TDA,dophBSE,singlet,triplet,eta,nOrb,nC,nO,nV,nR,nS, &
|
||||
nOOs,nVVs,nOOt,nVVt,Om1s,X1s,Y1s,Om2s,X2s,Y2s,rho1s,rho2s,Om1t,X1t,Y1t, &
|
||||
Om2t,X2t,Y2t,rho1t,rho2t,ERI_MO,eGT,eGT,EcBSE)
|
||||
|
||||
@ -391,4 +426,9 @@ subroutine qsRGTpp(dotest,maxSCF,thresh,max_diis,doACFDT,exchange_kernel,doXBS,d
|
||||
|
||||
end if
|
||||
|
||||
deallocate(Om1s, X1s, Y1s, rho1s)
|
||||
deallocate(Om2s, X2s, Y2s, rho2s)
|
||||
deallocate(Om1t, X1t, Y1t, rho1t)
|
||||
deallocate(Om2t, X2t, Y2t, rho2t)
|
||||
|
||||
end subroutine
|
||||
|
||||
@ -280,7 +280,7 @@ subroutine qsUGTpp(dotest,maxSCF,thresh,max_diis,doACFDT,exchange_kernel,doXBS,B
|
||||
end do
|
||||
|
||||
do ispin=1,nspin
|
||||
call MOtoAO(nBas,S,c(:,:,ispin),SigT(:,:,ispin),SigTp(:,:,ispin))
|
||||
call MOtoAO(nBas,nBas,S,c(:,:,ispin),SigT(:,:,ispin),SigTp(:,:,ispin))
|
||||
end do
|
||||
|
||||
! Solve the quasi-particle equation
|
||||
|
||||
@ -66,6 +66,7 @@ subroutine GW_ppBSE(TDA_W,TDA,dBSE,dTDA,singlet,triplet,eta,nBas,nC,nO,nV,nR,nS,
|
||||
|
||||
double precision,intent(out) :: EcBSE(nspin)
|
||||
|
||||
|
||||
!---------------------------------
|
||||
! Compute (singlet) RPA screening
|
||||
!---------------------------------
|
||||
@ -76,10 +77,12 @@ subroutine GW_ppBSE(TDA_W,TDA,dBSE,dTDA,singlet,triplet,eta,nBas,nC,nO,nV,nR,nS,
|
||||
allocate(OmRPA(nS),XpY_RPA(nS,nS),XmY_RPA(nS,nS),rho_RPA(nBas,nBas,nS), &
|
||||
Aph(nS,nS),Bph(nS,nS))
|
||||
|
||||
call phLR_A(isp_W,dRPA_W,nBas,nC,nO,nV,nR,nS,1d0,eW,ERI,Aph)
|
||||
call phLR_A(isp_W,dRPA_W,nBas,nC,nO,nV,nR,nS,1d0,eW,ERI,Aph)
|
||||
|
||||
if(.not.TDA_W) call phLR_B(isp_W,dRPA_W,nBas,nC,nO,nV,nR,nS,1d0,ERI,Bph)
|
||||
|
||||
call phLR(TDA_W,nS,Aph,Bph,EcRPA,OmRPA,XpY_RPA,XmY_RPA)
|
||||
|
||||
call GW_excitation_density(nBas,nC,nO,nR,nS,ERI,XpY_RPA,rho_RPA)
|
||||
|
||||
deallocate(XpY_RPA,XmY_RPA,Aph,Bph)
|
||||
@ -108,13 +111,13 @@ subroutine GW_ppBSE(TDA_W,TDA,dBSE,dTDA,singlet,triplet,eta,nBas,nC,nO,nV,nR,nS,
|
||||
|
||||
! Compute BSE excitation energies
|
||||
|
||||
call GW_ppBSE_static_kernel_C(ispin,eta,nBas,nC,nO,nV,nR,nS,nVV,1d0,ERI,OmRPA,rho_RPA,KC_sta)
|
||||
call GW_ppBSE_static_kernel_D(ispin,eta,nBas,nC,nO,nV,nR,nS,nOO,1d0,ERI,OmRPA,rho_RPA,KD_sta)
|
||||
if(.not.TDA) call GW_ppBSE_static_kernel_B(ispin,eta,nBas,nC,nO,nV,nR,nS,nOO,nVV,1d0,ERI,OmRPA,rho_RPA,KB_sta)
|
||||
call GW_ppBSE_static_kernel_C(ispin,eta,nBas,nC,nO,nV,nR,nS,nVV,1d0,ERI,OmRPA,rho_RPA,KC_sta)
|
||||
call GW_ppBSE_static_kernel_D(ispin,eta,nBas,nC,nO,nV,nR,nS,nOO,1d0,ERI,OmRPA,rho_RPA,KD_sta)
|
||||
|
||||
call ppLR_C(ispin,nBas,nC,nO,nV,nR,nVV,1d0,eGW,ERI,Cpp)
|
||||
call ppLR_D(ispin,nBas,nC,nO,nV,nR,nOO,1d0,eGW,ERI,Dpp)
|
||||
if(.not.TDA) call ppLR_B(ispin,nBas,nC,nO,nV,nR,nOO,nVV,1d0,ERI,Bpp)
|
||||
call ppLR_C(ispin,nBas,nC,nO,nV,nR,nVV,1d0,eGW,ERI,Cpp)
|
||||
call ppLR_D(ispin,nBas,nC,nO,nV,nR,nOO,1d0,eGW,ERI,Dpp)
|
||||
|
||||
Bpp(:,:) = Bpp(:,:) + KB_sta(:,:)
|
||||
Cpp(:,:) = Cpp(:,:) + KC_sta(:,:)
|
||||
@ -131,9 +134,9 @@ subroutine GW_ppBSE(TDA_W,TDA,dBSE,dTDA,singlet,triplet,eta,nBas,nC,nO,nV,nR,nS,
|
||||
if(dBSE) &
|
||||
call GW_ppBSE_dynamic_perturbation(ispin,dTDA,eta,nBas,nC,nO,nV,nR,nS,nOO,nVV,eW,eGW,ERI,dipole_int,OmRPA,rho_RPA, &
|
||||
Om1,X1,Y1,Om2,X2,Y2,KB_sta,KC_sta,KD_sta)
|
||||
write(*,*) "Deallocate not done"
|
||||
|
||||
|
||||
deallocate(Om1,X1,Y1,Om2,X2,Y2,Bpp,Cpp,Dpp,KB_sta,KC_sta,KD_sta)
|
||||
write(*,*) "Deallocate done"
|
||||
end if
|
||||
|
||||
!-------------------
|
||||
@ -160,14 +163,13 @@ subroutine GW_ppBSE(TDA_W,TDA,dBSE,dTDA,singlet,triplet,eta,nBas,nC,nO,nV,nR,nS,
|
||||
|
||||
! Compute BSE excitation energies
|
||||
|
||||
call GW_ppBSE_static_kernel_C(ispin,eta,nBas,nC,nO,nV,nR,nS,nVV,1d0,ERI,OmRPA,rho_RPA,KC_sta)
|
||||
call GW_ppBSE_static_kernel_D(ispin,eta,nBas,nC,nO,nV,nR,nS,nOO,1d0,ERI,OmRPA,rho_RPA,KD_sta)
|
||||
if(.not.TDA) call GW_ppBSE_static_kernel_B(ispin,eta,nBas,nC,nO,nV,nR,nS,nOO,nVV,1d0,ERI,OmRPA,rho_RPA,KB_sta)
|
||||
call GW_ppBSE_static_kernel_C(ispin,eta,nBas,nC,nO,nV,nR,nS,nVV,1d0,ERI,OmRPA,rho_RPA,KC_sta)
|
||||
call GW_ppBSE_static_kernel_D(ispin,eta,nBas,nC,nO,nV,nR,nS,nOO,1d0,ERI,OmRPA,rho_RPA,KD_sta)
|
||||
|
||||
|
||||
call ppLR_C(ispin,nBas,nC,nO,nV,nR,nVV,1d0,eGW,ERI,Cpp)
|
||||
call ppLR_D(ispin,nBas,nC,nO,nV,nR,nOO,1d0,eGW,ERI,Dpp)
|
||||
if(.not.TDA) call ppLR_B(ispin,nBas,nC,nO,nV,nR,nOO,nVV,1d0,ERI,Bpp)
|
||||
call ppLR_C(ispin,nBas,nC,nO,nV,nR,nVV,1d0,eGW,ERI,Cpp)
|
||||
call ppLR_D(ispin,nBas,nC,nO,nV,nR,nOO,1d0,eGW,ERI,Dpp)
|
||||
|
||||
Bpp(:,:) = Bpp(:,:) + KB_sta(:,:)
|
||||
Cpp(:,:) = Cpp(:,:) + KC_sta(:,:)
|
||||
|
||||
@ -26,44 +26,186 @@ subroutine GW_ppBSE_static_kernel_C(ispin,eta,nBas,nC,nO,nV,nR,nS,nVV,lambda,ERI
|
||||
double precision,external :: Kronecker_delta
|
||||
double precision :: chi
|
||||
double precision :: eps
|
||||
double precision :: tmp_ab, lambda4, eta2
|
||||
integer :: a,b,c,d,ab,cd,m
|
||||
integer :: a0, aa
|
||||
|
||||
double precision, allocatable :: Om_tmp(:)
|
||||
double precision, allocatable :: tmp_m(:,:,:)
|
||||
double precision, allocatable :: tmp(:,:,:,:)
|
||||
|
||||
! Output variables
|
||||
|
||||
double precision,intent(out) :: KC(nVV,nVV)
|
||||
|
||||
! Initialization
|
||||
|
||||
KC(:,:) = 0d0
|
||||
|
||||
!---------------!
|
||||
! Singlet block !
|
||||
!---------------!
|
||||
|
||||
if(ispin == 1) then
|
||||
|
||||
ab = 0
|
||||
do a=nO+1,nBas-nR
|
||||
do b=a,nBas-nR
|
||||
ab = ab + 1
|
||||
a0 = nBas - nR - nO
|
||||
lambda4 = 4.d0 * lambda
|
||||
eta2 = eta * eta
|
||||
|
||||
allocate(tmp_m(nBas,nBas,nS))
|
||||
allocate(tmp(nBas,nBas,nBas,nBas))
|
||||
|
||||
!$OMP PARALLEL DEFAULT(NONE) &
|
||||
!$OMP PRIVATE(m, c, a, eps) &
|
||||
!$OMP SHARED(nS, nBas, eta2, Om, rho, tmp_m)
|
||||
!$OMP DO
|
||||
do m = 1, nS
|
||||
eps = Om(m) / (Om(m)*Om(m) + eta2)
|
||||
do c = 1, nBas
|
||||
do a = 1, nBas
|
||||
tmp_m(a,c,m) = eps * rho(a,c,m)
|
||||
enddo
|
||||
enddo
|
||||
enddo
|
||||
!$OMP END DO
|
||||
!$OMP END PARALLEL
|
||||
|
||||
call dgemm("N", "T", nBas*nBas, nBas*nBas, nS, 1.d0, &
|
||||
tmp_m(1,1,1), nBas*nBas, rho(1,1,1), nBas*nBas, &
|
||||
0.d0, tmp(1,1,1,1), nBas*nBas)
|
||||
|
||||
deallocate(tmp_m)
|
||||
|
||||
!$OMP PARALLEL DEFAULT(NONE) &
|
||||
!$OMP PRIVATE(a, b, aa, ab, c, d, cd, tmp_ab) &
|
||||
!$OMP SHARED(nO, nBas, nR, nS, a0, lambda4, tmp, KC)
|
||||
!$OMP DO
|
||||
do a = nO+1, nBas-nR
|
||||
aa = a0 * (a - nO - 1) - (a - nO - 1) * (a - nO) / 2 - nO
|
||||
do b = a, nBas-nR
|
||||
ab = aa + b
|
||||
|
||||
tmp_ab = lambda4
|
||||
if(a .eq. b) then
|
||||
tmp_ab = 0.7071067811865475d0 * lambda4
|
||||
endif
|
||||
|
||||
cd = 0
|
||||
do c=nO+1,nBas-nR
|
||||
do d=c,nBas-nR
|
||||
do c = nO+1, nBas-nR
|
||||
do d = c, nBas-nR
|
||||
cd = cd + 1
|
||||
|
||||
chi = 0d0
|
||||
do m=1,nS
|
||||
eps = Om(m)**2 + eta**2
|
||||
chi = chi - rho(a,c,m)*rho(b,d,m)*Om(m)/eps &
|
||||
- rho(a,d,m)*rho(b,c,m)*Om(m)/eps
|
||||
end do
|
||||
KC(ab,cd) = -tmp_ab * (tmp(a,c,b,d) + tmp(a,d,b,c))
|
||||
if(c .eq. d) then
|
||||
KC(ab,cd) = 0.7071067811865475d0 * KC(ab,cd)
|
||||
endif
|
||||
enddo
|
||||
enddo
|
||||
enddo
|
||||
enddo
|
||||
!$OMP END DO
|
||||
!$OMP END PARALLEL
|
||||
|
||||
KC(ab,cd) = 4d0*lambda*chi/sqrt((1d0 + Kronecker_delta(a,b))*(1d0 + Kronecker_delta(c,d)))
|
||||
deallocate(tmp)
|
||||
|
||||
end do
|
||||
end do
|
||||
end do
|
||||
end do
|
||||
|
||||
! do a=nO+1,nBas-nR
|
||||
! do b=a,nBas-nR
|
||||
! ab = ab + 1
|
||||
! cd = 0
|
||||
! do c=nO+1,nBas-nR
|
||||
! do d=c,nBas-nR
|
||||
! cd = cd + 1
|
||||
!
|
||||
! chi = 0d0
|
||||
! do m=1,nS
|
||||
! eps = Om(m)**2 + eta**2
|
||||
! chi = chi - rho(a,c,m)*rho(b,d,m)*Om(m)/eps &
|
||||
! - rho(a,d,m)*rho(b,c,m)*Om(m)/eps
|
||||
! end do
|
||||
|
||||
|
||||
! --- --- ---
|
||||
! OpenMP implementation
|
||||
! --- --- ---
|
||||
!
|
||||
! a0 = nBas - nR - nO
|
||||
! lambda4 = 4.d0 * lambda
|
||||
! eta2 = eta * eta
|
||||
!
|
||||
! allocate(Om_tmp(nS))
|
||||
!
|
||||
! !$OMP PARALLEL DEFAULT(NONE) PRIVATE(m) SHARED(nS, eta2, Om, Om_tmp)
|
||||
! !$OMP DO
|
||||
! do m = 1, nS
|
||||
! Om_tmp(m) = Om(m) / (Om(m)*Om(m) + eta2)
|
||||
! enddo
|
||||
! !$OMP END DO
|
||||
! !$OMP END PARALLEL
|
||||
!
|
||||
! !$OMP PARALLEL DEFAULT(NONE) &
|
||||
! !$OMP PRIVATE(a, b, aa, ab, c, d, cd, m, tmp_ab) &
|
||||
! !$OMP SHARED(nO, nBas, nR, nS, a0, lambda4, Om_tmp, rho, KC)
|
||||
! !$OMP DO
|
||||
! do a = nO+1, nBas-nR
|
||||
! aa = a0 * (a - nO - 1) - (a - nO - 1) * (a - nO) / 2 - nO
|
||||
! do b = a, nBas-nR
|
||||
! ab = aa + b
|
||||
!
|
||||
! tmp_ab = lambda4
|
||||
! if(a .eq. b) then
|
||||
! tmp_ab = 0.7071067811865475d0 * lambda4
|
||||
! endif
|
||||
!
|
||||
! cd = 0
|
||||
! do c = nO+1, nBas-nR
|
||||
! do d = c, nBas-nR
|
||||
! cd = cd + 1
|
||||
!
|
||||
! KC(ab,cd) = 0d0
|
||||
! do m = 1, nS
|
||||
! KC(ab,cd) = KC(ab,cd) - rho(a,c,m) * rho(b,d,m) * Om_tmp(m) &
|
||||
! - rho(a,d,m) * rho(b,c,m) * Om_tmp(m)
|
||||
! end do
|
||||
!
|
||||
! KC(ab,cd) = tmp_ab * KC(ab,cd)
|
||||
! if(c .eq. d) then
|
||||
! KC(ab,cd) = 0.7071067811865475d0 * KC(ab,cd)
|
||||
! endif
|
||||
! enddo
|
||||
! enddo
|
||||
! enddo
|
||||
! enddo
|
||||
! !$OMP END DO
|
||||
! !$OMP END PARALLEL
|
||||
!
|
||||
! deallocate(Om_tmp)
|
||||
! --- --- ---
|
||||
|
||||
|
||||
! --- --- ---
|
||||
! Naive implementation
|
||||
! --- --- ---
|
||||
!
|
||||
! ab = 0
|
||||
! do a=nO+1,nBas-nR
|
||||
! do b=a,nBas-nR
|
||||
! ab = ab + 1
|
||||
! cd = 0
|
||||
! do c=nO+1,nBas-nR
|
||||
! do d=c,nBas-nR
|
||||
! cd = cd + 1
|
||||
!
|
||||
! chi = 0d0
|
||||
! do m=1,nS
|
||||
! eps = Om(m)**2 + eta**2
|
||||
! chi = chi - rho(a,c,m)*rho(b,d,m)*Om(m)/eps &
|
||||
! - rho(a,d,m)*rho(b,c,m)*Om(m)/eps
|
||||
! end do
|
||||
!
|
||||
! KC(ab,cd) = 4d0*lambda*chi/sqrt((1d0 + Kronecker_delta(a,b))*(1d0 + Kronecker_delta(c,d)))
|
||||
!
|
||||
! end do
|
||||
! end do
|
||||
! end do
|
||||
! end do
|
||||
! --- --- ---
|
||||
|
||||
end if
|
||||
|
||||
@ -73,28 +215,136 @@ subroutine GW_ppBSE_static_kernel_C(ispin,eta,nBas,nC,nO,nV,nR,nS,nVV,lambda,ERI
|
||||
|
||||
if(ispin == 2) then
|
||||
|
||||
ab = 0
|
||||
do a=nO+1,nBas-nR
|
||||
do b=a+1,nBas-nR
|
||||
ab = ab + 1
|
||||
a0 = nBas - nR - nO - 1
|
||||
lambda4 = 4.d0 * lambda
|
||||
eta2 = eta * eta
|
||||
|
||||
allocate(tmp_m(nBas,nBas,nS))
|
||||
allocate(tmp(nBas,nBas,nBas,nBas))
|
||||
|
||||
!$OMP PARALLEL DEFAULT(NONE) &
|
||||
!$OMP PRIVATE(m, c, a, eps) &
|
||||
!$OMP SHARED(nS, nBas, eta2, Om, rho, tmp_m)
|
||||
!$OMP DO
|
||||
do m = 1, nS
|
||||
eps = Om(m) / (Om(m)*Om(m) + eta2)
|
||||
do c = 1, nBas
|
||||
do a = 1, nBas
|
||||
tmp_m(a,c,m) = eps * rho(a,c,m)
|
||||
enddo
|
||||
enddo
|
||||
enddo
|
||||
!$OMP END DO
|
||||
!$OMP END PARALLEL
|
||||
|
||||
call dgemm("N", "T", nBas*nBas, nBas*nBas, nS, 1.d0, &
|
||||
tmp_m(1,1,1), nBas*nBas, rho(1,1,1), nBas*nBas, &
|
||||
0.d0, tmp(1,1,1,1), nBas*nBas)
|
||||
|
||||
deallocate(tmp_m)
|
||||
|
||||
!$OMP PARALLEL DEFAULT(NONE) &
|
||||
!$OMP PRIVATE(a, b, aa, ab, c, d, cd) &
|
||||
!$OMP SHARED(nO, nBas, nR, nS, a0, lambda4, tmp, KC)
|
||||
!$OMP DO
|
||||
do a = nO+1, nBas-nR
|
||||
aa = a0 * (a - nO - 1) - (a - nO - 1) * (a - nO) / 2 - nO - 1
|
||||
do b = a+1, nBas-nR
|
||||
ab = aa + b
|
||||
|
||||
cd = 0
|
||||
do c=nO+1,nBas-nR
|
||||
do d=c+1,nBas-nR
|
||||
do c = nO+1, nBas-nR
|
||||
do d = c+1, nBas-nR
|
||||
cd = cd + 1
|
||||
|
||||
chi = 0d0
|
||||
do m=1,nS
|
||||
eps = Om(m)**2 + eta**2
|
||||
chi = chi - rho(a,c,m)*rho(b,d,m)*Om(m)/eps &
|
||||
+ rho(a,d,m)*rho(b,c,m)*Om(m)/eps
|
||||
end do
|
||||
|
||||
KC(ab,cd) = 4d0*lambda*chi
|
||||
KC(ab,cd) = lambda4 * (-tmp(a,c,b,d) + tmp(a,d,b,c))
|
||||
enddo
|
||||
enddo
|
||||
enddo
|
||||
enddo
|
||||
!$OMP END DO
|
||||
!$OMP END PARALLEL
|
||||
|
||||
end do
|
||||
end do
|
||||
end do
|
||||
end do
|
||||
deallocate(tmp)
|
||||
|
||||
|
||||
! --- --- ---
|
||||
! OpenMP implementation
|
||||
! --- --- ---
|
||||
!
|
||||
! a0 = nBas - nR - nO - 1
|
||||
! lambda4 = 4.d0 * lambda
|
||||
! eta2 = eta * eta
|
||||
!
|
||||
! allocate(Om_tmp(nS))
|
||||
!
|
||||
! !$OMP PARALLEL DEFAULT(NONE) PRIVATE(m) SHARED(nS, eta2, Om, Om_tmp)
|
||||
! !$OMP DO
|
||||
! do m = 1, nS
|
||||
! Om_tmp(m) = Om(m) / (Om(m)*Om(m) + eta2)
|
||||
! enddo
|
||||
! !$OMP END DO
|
||||
! !$OMP END PARALLEL
|
||||
!
|
||||
! !$OMP PARALLEL DEFAULT(NONE) &
|
||||
! !$OMP PRIVATE(a, b, aa, ab, c, d, cd, m) &
|
||||
! !$OMP SHARED(nO, nBas, nR, nS, a0, lambda4, Om_tmp, rho, KC)
|
||||
! !$OMP DO
|
||||
! do a = nO+1, nBas-nR
|
||||
! aa = a0 * (a - nO - 1) - (a - nO - 1) * (a - nO) / 2 - nO - 1
|
||||
! do b = a+1, nBas-nR
|
||||
! ab = aa + b
|
||||
!
|
||||
! cd = 0
|
||||
! do c = nO+1, nBas-nR
|
||||
! do d = c+1, nBas-nR
|
||||
! cd = cd + 1
|
||||
!
|
||||
! KC(ab,cd) = 0d0
|
||||
! do m = 1, nS
|
||||
! KC(ab,cd) = KC(ab,cd) - rho(a,c,m) * rho(b,d,m) * Om_tmp(m) &
|
||||
! + rho(a,d,m) * rho(b,c,m) * Om_tmp(m)
|
||||
! end do
|
||||
!
|
||||
! KC(ab,cd) = lambda4 * KC(ab,cd)
|
||||
! enddo
|
||||
! enddo
|
||||
! enddo
|
||||
! enddo
|
||||
! !$OMP END DO
|
||||
! !$OMP END PARALLEL
|
||||
!
|
||||
! deallocate(Om_tmp)
|
||||
! --- --- ---
|
||||
|
||||
|
||||
! --- --- ---
|
||||
! Naive implementation
|
||||
! --- --- ---
|
||||
!
|
||||
! ab = 0
|
||||
! do a=nO+1,nBas-nR
|
||||
! do b=a+1,nBas-nR
|
||||
! ab = ab + 1
|
||||
! cd = 0
|
||||
! do c=nO+1,nBas-nR
|
||||
! do d=c+1,nBas-nR
|
||||
! cd = cd + 1
|
||||
!
|
||||
! chi = 0d0
|
||||
! do m=1,nS
|
||||
! eps = Om(m)**2 + eta**2
|
||||
! chi = chi - rho(a,c,m)*rho(b,d,m)*Om(m)/eps &
|
||||
! + rho(a,d,m)*rho(b,c,m)*Om(m)/eps
|
||||
! end do
|
||||
!
|
||||
! KC(ab,cd) = 4d0*lambda*chi
|
||||
!
|
||||
! end do
|
||||
! end do
|
||||
! end do
|
||||
! end do
|
||||
! --- --- ---
|
||||
|
||||
end if
|
||||
|
||||
|
||||
@ -59,6 +59,7 @@ subroutine RG0W0(dotest,doACFDT,exchange_kernel,doXBS,dophBSE,dophBSE2,TDA_W,TDA
|
||||
double precision,allocatable :: eGWlin(:)
|
||||
double precision,allocatable :: eGW(:)
|
||||
|
||||
|
||||
! Output variables
|
||||
|
||||
! Hello world
|
||||
@ -101,7 +102,8 @@ subroutine RG0W0(dotest,doACFDT,exchange_kernel,doXBS,dophBSE,dophBSE2,TDA_W,TDA
|
||||
! Compute screening !
|
||||
!-------------------!
|
||||
|
||||
call phLR_A(ispin,dRPA,nBas,nC,nO,nV,nR,nS,1d0,eHF,ERI,Aph)
|
||||
call phLR_A(ispin,dRPA,nBas,nC,nO,nV,nR,nS,1d0,eHF,ERI,Aph)
|
||||
|
||||
if(.not.TDA_W) call phLR_B(ispin,dRPA,nBas,nC,nO,nV,nR,nS,1d0,ERI,Bph)
|
||||
|
||||
call phLR(TDA_W,nS,Aph,Bph,EcRPA,Om,XpY,XmY)
|
||||
@ -159,6 +161,7 @@ subroutine RG0W0(dotest,doACFDT,exchange_kernel,doXBS,dophBSE,dophBSE2,TDA_W,TDA
|
||||
! Compute the RPA correlation energy
|
||||
|
||||
call phLR_A(ispin,dRPA,nBas,nC,nO,nV,nR,nS,1d0,eGW,ERI,Aph)
|
||||
|
||||
if(.not.TDA_W) call phLR_B(ispin,dRPA,nBas,nC,nO,nV,nR,nS,1d0,ERI,Bph)
|
||||
|
||||
call phLR(TDA_W,nS,Aph,Bph,EcRPA,Om,XpY,XmY)
|
||||
|
||||
@ -1,7 +1,10 @@
|
||||
subroutine RGW(dotest,doG0W0,doevGW,doqsGW,doufG0W0,doufGW,doSRGqsGW,maxSCF,thresh,max_diis,doACFDT, &
|
||||
exchange_kernel,doXBS,dophBSE,dophBSE2,doppBSE,TDA_W,TDA,dBSE,dTDA,singlet,triplet, &
|
||||
linearize,eta,regularize,nNuc,ZNuc,rNuc,ENuc,nBas,nC,nO,nV,nR,nS,ERHF,S,X,T,V,Hc, &
|
||||
ERI_AO,ERI_MO,dipole_int_AO,dipole_int,PHF,cHF,eHF)
|
||||
|
||||
! ---
|
||||
|
||||
subroutine RGW(dotest, doG0W0, doevGW, doqsGW, doufG0W0, doufGW, doSRGqsGW, maxSCF, thresh, max_diis, doACFDT, &
|
||||
exchange_kernel, doXBS, dophBSE, dophBSE2, doppBSE, TDA_W, TDA, dBSE, dTDA, singlet, triplet, &
|
||||
linearize, eta, regularize, nNuc, ZNuc, rNuc, ENuc, nBas, nOrb, nC, nO, nV, nR, nS, ERHF, &
|
||||
S, X, T, V, Hc, ERI_AO, ERI_MO, dipole_int_AO, dipole_int_MO, PHF, cHF, eHF)
|
||||
|
||||
! Restricted GW module
|
||||
|
||||
@ -43,7 +46,7 @@ subroutine RGW(dotest,doG0W0,doevGW,doqsGW,doufG0W0,doufGW,doSRGqsGW,maxSCF,thre
|
||||
double precision,intent(in) :: rNuc(nNuc,ncart)
|
||||
double precision,intent(in) :: ENuc
|
||||
|
||||
integer,intent(in) :: nBas
|
||||
integer,intent(in) :: nBas, nOrb
|
||||
integer,intent(in) :: nC
|
||||
integer,intent(in) :: nO
|
||||
integer,intent(in) :: nV
|
||||
@ -51,18 +54,18 @@ subroutine RGW(dotest,doG0W0,doevGW,doqsGW,doufG0W0,doufGW,doSRGqsGW,maxSCF,thre
|
||||
integer,intent(in) :: nS
|
||||
|
||||
double precision,intent(in) :: ERHF
|
||||
double precision,intent(in) :: eHF(nBas)
|
||||
double precision,intent(in) :: cHF(nBas,nBas)
|
||||
double precision,intent(in) :: eHF(nOrb)
|
||||
double precision,intent(in) :: cHF(nBas,nOrb)
|
||||
double precision,intent(in) :: PHF(nBas,nBas)
|
||||
double precision,intent(in) :: S(nBas,nBas)
|
||||
double precision,intent(in) :: T(nBas,nBas)
|
||||
double precision,intent(in) :: V(nBas,nBas)
|
||||
double precision,intent(in) :: Hc(nBas,nBas)
|
||||
double precision,intent(in) :: X(nBas,nBas)
|
||||
double precision,intent(in) :: X(nBas,nOrb)
|
||||
double precision,intent(in) :: ERI_AO(nBas,nBas,nBas,nBas)
|
||||
double precision,intent(in) :: ERI_MO(nBas,nBas,nBas,nBas)
|
||||
double precision,intent(in) :: ERI_MO(nOrb,nOrb,nOrb,nOrb)
|
||||
double precision,intent(in) :: dipole_int_AO(nBas,nBas,ncart)
|
||||
double precision,intent(in) :: dipole_int(nBas,nBas,ncart)
|
||||
double precision,intent(in) :: dipole_int_MO(nOrb,nOrb,ncart)
|
||||
|
||||
! Local variables
|
||||
|
||||
@ -76,11 +79,11 @@ subroutine RGW(dotest,doG0W0,doevGW,doqsGW,doufG0W0,doufGW,doSRGqsGW,maxSCF,thre
|
||||
|
||||
call wall_time(start_GW)
|
||||
call RG0W0(dotest,doACFDT,exchange_kernel,doXBS,dophBSE,dophBSE2,TDA_W,TDA,dBSE,dTDA,doppBSE,singlet,triplet, &
|
||||
linearize,eta,regularize,nBas,nC,nO,nV,nR,nS,ENuc,ERHF,ERI_MO,dipole_int,eHF)
|
||||
linearize,eta,regularize,nOrb,nC,nO,nV,nR,nS,ENuc,ERHF,ERI_MO,dipole_int_MO,eHF)
|
||||
call wall_time(end_GW)
|
||||
|
||||
t_GW = end_GW - start_GW
|
||||
write(*,'(A65,1X,F9.3,A8)') 'Total CPU time for G0W0 = ',t_GW,' seconds'
|
||||
write(*,'(A65,1X,F9.3,A8)') 'Total wall time for G0W0 = ',t_GW,' seconds'
|
||||
write(*,*)
|
||||
|
||||
end if
|
||||
@ -93,11 +96,11 @@ subroutine RGW(dotest,doG0W0,doevGW,doqsGW,doufG0W0,doufGW,doSRGqsGW,maxSCF,thre
|
||||
|
||||
call wall_time(start_GW)
|
||||
call evRGW(dotest,maxSCF,thresh,max_diis,doACFDT,exchange_kernel,doXBS,dophBSE,dophBSE2,TDA_W,TDA,dBSE,dTDA,doppBSE, &
|
||||
singlet,triplet,linearize,eta,regularize,nBas,nC,nO,nV,nR,nS,ENuc,ERHF,ERI_MO,dipole_int,eHF)
|
||||
singlet,triplet,linearize,eta,regularize,nBas,nC,nO,nV,nR,nS,ENuc,ERHF,ERI_MO,dipole_int_MO,eHF)
|
||||
call wall_time(end_GW)
|
||||
|
||||
t_GW = end_GW - start_GW
|
||||
write(*,'(A65,1X,F9.3,A8)') 'Total CPU time for evGW = ',t_GW,' seconds'
|
||||
write(*,'(A65,1X,F9.3,A8)') 'Total wall time for evGW = ',t_GW,' seconds'
|
||||
write(*,*)
|
||||
|
||||
end if
|
||||
@ -109,13 +112,14 @@ subroutine RGW(dotest,doG0W0,doevGW,doqsGW,doufG0W0,doufGW,doSRGqsGW,maxSCF,thre
|
||||
if(doqsGW) then
|
||||
|
||||
call wall_time(start_GW)
|
||||
call qsRGW(dotest,maxSCF,thresh,max_diis,doACFDT,exchange_kernel,doXBS,dophBSE,dophBSE2,TDA_W,TDA,dBSE,dTDA,doppBSE, &
|
||||
singlet,triplet,eta,regularize,nNuc,ZNuc,rNuc,ENuc,nBas,nC,nO,nV,nR,nS,ERHF,S,X,T,V,Hc,ERI_AO,ERI_MO, &
|
||||
dipole_int_AO,dipole_int,PHF,cHF,eHF)
|
||||
call qsRGW(dotest, maxSCF, thresh, max_diis, doACFDT, exchange_kernel, doXBS, dophBSE, dophBSE2, &
|
||||
TDA_W, TDA, dBSE, dTDA, doppBSE, singlet, triplet, eta, regularize, nNuc, ZNuc, rNuc, &
|
||||
ENuc, nBas, nOrb, nC, nO, nV, nR, nS, ERHF, S, X, T, V, Hc, ERI_AO, ERI_MO, &
|
||||
dipole_int_AO, dipole_int_MO, PHF, cHF, eHF)
|
||||
call wall_time(end_GW)
|
||||
|
||||
t_GW = end_GW - start_GW
|
||||
write(*,'(A65,1X,F9.3,A8)') 'Total CPU time for qsGW = ',t_GW,' seconds'
|
||||
write(*,'(A65,1X,F9.3,A8)') 'Total wall time for qsGW = ',t_GW,' seconds'
|
||||
write(*,*)
|
||||
|
||||
end if
|
||||
@ -127,13 +131,15 @@ subroutine RGW(dotest,doG0W0,doevGW,doqsGW,doufG0W0,doufGW,doSRGqsGW,maxSCF,thre
|
||||
if(doSRGqsGW) then
|
||||
|
||||
call wall_time(start_GW)
|
||||
call SRG_qsGW(dotest,maxSCF,thresh,max_diis,doACFDT,exchange_kernel,doXBS,dophBSE,dophBSE2,TDA_W,TDA,dBSE,dTDA, &
|
||||
singlet,triplet,eta,nNuc,ZNuc,rNuc,ENuc,nBas,nC,nO,nV,nR,nS,ERHF,S,X,T,V,Hc,ERI_AO,ERI_MO, &
|
||||
dipole_int_AO,dipole_int,PHF,cHF,eHF)
|
||||
call SRG_qsGW(dotest, maxSCF, thresh, max_diis, doACFDT, exchange_kernel, doXBS, &
|
||||
dophBSE, dophBSE2, TDA_W, TDA, dBSE, dTDA, singlet, triplet, eta, &
|
||||
nNuc, ZNuc, rNuc, ENuc, nBas, nOrb, nC, nO, nV, nR, nS, &
|
||||
ERHF, S, X, T, V, Hc, ERI_AO, ERI_MO, dipole_int_AO, dipole_int_MO, &
|
||||
PHF, cHF, eHF)
|
||||
call wall_time(end_GW)
|
||||
|
||||
t_GW = end_GW - start_GW
|
||||
write(*,'(A65,1X,F9.3,A8)') 'Total CPU time for qsGW = ',t_GW,' seconds'
|
||||
write(*,'(A65,1X,F9.3,A8)') 'Total wall time for qsGW = ',t_GW,' seconds'
|
||||
write(*,*)
|
||||
|
||||
end if
|
||||
@ -145,11 +151,12 @@ subroutine RGW(dotest,doG0W0,doevGW,doqsGW,doufG0W0,doufGW,doSRGqsGW,maxSCF,thre
|
||||
if(doufG0W0) then
|
||||
|
||||
call wall_time(start_GW)
|
||||
! TODO
|
||||
call ufG0W0(dotest,TDA_W,nBas,nC,nO,nV,nR,nS,ENuc,ERHF,ERI_MO,eHF)
|
||||
call wall_time(end_GW)
|
||||
|
||||
t_GW = end_GW - start_GW
|
||||
write(*,'(A65,1X,F9.3,A8)') 'Total CPU time for ufG0W0 = ',t_GW,' seconds'
|
||||
write(*,'(A65,1X,F9.3,A8)') 'Total wall time for ufG0W0 = ',t_GW,' seconds'
|
||||
write(*,*)
|
||||
|
||||
end if
|
||||
@ -161,11 +168,12 @@ subroutine RGW(dotest,doG0W0,doevGW,doqsGW,doufG0W0,doufGW,doSRGqsGW,maxSCF,thre
|
||||
if(doufGW) then
|
||||
|
||||
call wall_time(start_GW)
|
||||
! TODO
|
||||
call ufGW(dotest,TDA_W,nBas,nC,nO,nV,nR,nS,ENuc,ERHF,ERI_MO,eHF)
|
||||
call wall_time(end_GW)
|
||||
|
||||
t_GW = end_GW - start_GW
|
||||
write(*,'(A65,1X,F9.3,A8)') 'Total CPU time for ufGW = ',t_GW,' seconds'
|
||||
write(*,'(A65,1X,F9.3,A8)') 'Total wall time for ufGW = ',t_GW,' seconds'
|
||||
write(*,*)
|
||||
|
||||
end if
|
||||
|
||||
@ -1,6 +1,10 @@
|
||||
subroutine SRG_qsGW(dotest,maxSCF,thresh,max_diis,doACFDT,exchange_kernel,doXBS,BSE,BSE2,TDA_W,TDA, &
|
||||
dBSE,dTDA,singlet,triplet,eta,nNuc,ZNuc,rNuc,ENuc,nBas,nC,nO,nV,nR,nS,ERHF, &
|
||||
S,X,T,V,Hc,ERI_AO,ERI_MO,dipole_int_AO,dipole_int_MO,PHF,cHF,eHF)
|
||||
|
||||
! ---
|
||||
|
||||
subroutine SRG_qsGW(dotest, maxSCF, thresh, max_diis, doACFDT, exchange_kernel, doXBS, &
|
||||
BSE, BSE2, TDA_W, TDA, dBSE, dTDA, singlet, triplet, eta, nNuc, &
|
||||
ZNuc, rNuc, ENuc, nBas, nOrb, nC, nO, nV, nR, nS, ERHF, S, &
|
||||
X, T, V, Hc, ERI_AO, ERI_MO, dipole_int_AO, dipole_int_MO, PHF, cHF, eHF)
|
||||
|
||||
! Perform a quasiparticle self-consistent GW calculation
|
||||
|
||||
@ -32,30 +36,30 @@ subroutine SRG_qsGW(dotest,maxSCF,thresh,max_diis,doACFDT,exchange_kernel,doXBS,
|
||||
double precision,intent(in) :: rNuc(nNuc,ncart)
|
||||
double precision,intent(in) :: ENuc
|
||||
|
||||
integer,intent(in) :: nBas
|
||||
integer,intent(in) :: nBas, nOrb
|
||||
integer,intent(in) :: nC
|
||||
integer,intent(in) :: nO
|
||||
integer,intent(in) :: nV
|
||||
integer,intent(in) :: nR
|
||||
integer,intent(in) :: nS
|
||||
double precision,intent(in) :: ERHF
|
||||
double precision,intent(in) :: eHF(nBas)
|
||||
double precision,intent(in) :: cHF(nBas,nBas)
|
||||
double precision,intent(in) :: eHF(nOrb)
|
||||
double precision,intent(in) :: cHF(nBas,nOrb)
|
||||
double precision,intent(in) :: PHF(nBas,nBas)
|
||||
double precision,intent(in) :: S(nBas,nBas)
|
||||
double precision,intent(in) :: T(nBas,nBas)
|
||||
double precision,intent(in) :: V(nBas,nBas)
|
||||
double precision,intent(in) :: Hc(nBas,nBas)
|
||||
double precision,intent(in) :: X(nBas,nBas)
|
||||
double precision,intent(in) :: X(nBas,nOrb)
|
||||
double precision,intent(in) :: ERI_AO(nBas,nBas,nBas,nBas)
|
||||
double precision,intent(inout):: ERI_MO(nBas,nBas,nBas,nBas)
|
||||
double precision,intent(inout):: ERI_MO(nOrb,nOrb,nOrb,nOrb)
|
||||
double precision,intent(in) :: dipole_int_AO(nBas,nBas,ncart)
|
||||
double precision,intent(inout):: dipole_int_MO(nBas,nBas,ncart)
|
||||
double precision,intent(inout):: dipole_int_MO(nOrb,nOrb,ncart)
|
||||
|
||||
! Local variables
|
||||
|
||||
integer :: nSCF
|
||||
integer :: nBasSq
|
||||
integer :: nBas_Sq
|
||||
integer :: ispin
|
||||
integer :: ixyz
|
||||
integer :: n_diis
|
||||
@ -114,7 +118,7 @@ subroutine SRG_qsGW(dotest,maxSCF,thresh,max_diis,doACFDT,exchange_kernel,doXBS,
|
||||
|
||||
! Stuff
|
||||
|
||||
nBasSq = nBas*nBas
|
||||
nBas_Sq = nBas*nBas
|
||||
|
||||
! TDA for W
|
||||
|
||||
@ -132,9 +136,32 @@ subroutine SRG_qsGW(dotest,maxSCF,thresh,max_diis,doACFDT,exchange_kernel,doXBS,
|
||||
|
||||
! Memory allocation
|
||||
|
||||
allocate(eGW(nBas),eOld(nBas),c(nBas,nBas),cp(nBas,nBas),P(nBas,nBas),F(nBas,nBas),Fp(nBas,nBas), &
|
||||
J(nBas,nBas),K(nBas,nBas),SigC(nBas,nBas),SigCp(nBas,nBas),Z(nBas),Aph(nS,nS),Bph(nS,nS), &
|
||||
Om(nS),XpY(nS,nS),XmY(nS,nS),rho(nBas,nBas,nS),error(nBas,nBas),error_diis(nBasSq,max_diis),F_diis(nBasSq,max_diis))
|
||||
allocate(eGW(nOrb))
|
||||
allocate(eOld(nOrb))
|
||||
allocate(Z(nOrb))
|
||||
|
||||
allocate(c(nBas,nOrb))
|
||||
|
||||
allocate(cp(nOrb,nOrb))
|
||||
allocate(Fp(nOrb,nOrb))
|
||||
allocate(SigC(nOrb,nOrb))
|
||||
|
||||
allocate(P(nBas,nBas))
|
||||
allocate(F(nBas,nBas))
|
||||
allocate(J(nBas,nBas))
|
||||
allocate(K(nBas,nBas))
|
||||
allocate(error(nBas,nBas))
|
||||
allocate(SigCp(nBas,nBas))
|
||||
|
||||
allocate(Aph(nS,nS))
|
||||
allocate(Bph(nS,nS))
|
||||
allocate(Om(nS))
|
||||
allocate(XpY(nS,nS))
|
||||
allocate(XmY(nS,nS))
|
||||
allocate(rho(nOrb,nOrb,nS))
|
||||
|
||||
allocate(error_diis(nBas_Sq,max_diis))
|
||||
allocate(F_diis(nBas_Sq,max_diis))
|
||||
|
||||
! Initialization
|
||||
|
||||
@ -174,22 +201,22 @@ subroutine SRG_qsGW(dotest,maxSCF,thresh,max_diis,doACFDT,exchange_kernel,doXBS,
|
||||
|
||||
call wall_time(tao1)
|
||||
|
||||
do ixyz=1,ncart
|
||||
call AOtoMO(nBas,cHF,dipole_int_AO(:,:,ixyz),dipole_int_MO(:,:,ixyz))
|
||||
do ixyz = 1, ncart
|
||||
call AOtoMO(nBas, nOrb, cHF, dipole_int_AO(1,1,ixyz), dipole_int_MO(1,1,ixyz))
|
||||
end do
|
||||
|
||||
call AOtoMO_ERI_RHF(nBas,c,ERI_AO,ERI_MO)
|
||||
call AOtoMO_ERI_RHF(nBas, nOrb, c, ERI_AO, ERI_MO)
|
||||
|
||||
call wall_time(tao2)
|
||||
|
||||
tao = tao + tao2 -tao1
|
||||
tao = tao + tao2 - tao1
|
||||
|
||||
! Compute linear response
|
||||
|
||||
call wall_time(tlr1)
|
||||
|
||||
call phLR_A(ispin,dRPA,nBas,nC,nO,nV,nR,nS,1d0,eGW,ERI_MO,Aph)
|
||||
if(.not.TDA_W) call phLR_B(ispin,dRPA,nBas,nC,nO,nV,nR,nS,1d0,ERI_MO,Bph)
|
||||
call phLR_A(ispin,dRPA,nOrb,nC,nO,nV,nR,nS,1d0,eGW,ERI_MO,Aph)
|
||||
if(.not.TDA_W) call phLR_B(ispin,dRPA,nOrb,nC,nO,nV,nR,nS,1d0,ERI_MO,Bph)
|
||||
|
||||
call phLR(TDA_W,nS,Aph,Bph,EcRPA,Om,XpY,XmY)
|
||||
|
||||
@ -203,13 +230,13 @@ subroutine SRG_qsGW(dotest,maxSCF,thresh,max_diis,doACFDT,exchange_kernel,doXBS,
|
||||
|
||||
call wall_time(tex1)
|
||||
|
||||
call GW_excitation_density(nBas,nC,nO,nR,nS,ERI_MO,XpY,rho)
|
||||
call GW_excitation_density(nOrb,nC,nO,nR,nS,ERI_MO,XpY,rho)
|
||||
|
||||
call wall_time(tex2)
|
||||
tex=tex+tex2-tex1
|
||||
|
||||
call wall_time(tsrg1)
|
||||
call SRG_self_energy(flow,nBas,nC,nO,nV,nR,nS,eGW,Om,rho,EcGM,SigC,Z)
|
||||
call SRG_self_energy(flow,nOrb,nC,nO,nV,nR,nS,eGW,Om,rho,EcGM,SigC,Z)
|
||||
|
||||
call wall_time(tsrg2)
|
||||
|
||||
@ -218,7 +245,7 @@ subroutine SRG_qsGW(dotest,maxSCF,thresh,max_diis,doACFDT,exchange_kernel,doXBS,
|
||||
! Make correlation self-energy Hermitian and transform it back to AO basis
|
||||
|
||||
call wall_time(tmo1)
|
||||
call MOtoAO(nBas,S,c,SigC,SigCp)
|
||||
call MOtoAO(nBas, nOrb, S, c, SigC, SigCp)
|
||||
call wall_time(tmo2)
|
||||
tmo = tmo + tmo2 - tmo1
|
||||
! Solve the quasi-particle equation
|
||||
@ -234,18 +261,18 @@ subroutine SRG_qsGW(dotest,maxSCF,thresh,max_diis,doACFDT,exchange_kernel,doXBS,
|
||||
if(max_diis > 1) then
|
||||
|
||||
n_diis = min(n_diis+1,max_diis)
|
||||
call DIIS_extrapolation(rcond,nBasSq,nBasSq,n_diis,error_diis,F_diis,error,F)
|
||||
call DIIS_extrapolation(rcond,nBas_Sq,nBas_Sq,n_diis,error_diis,F_diis,error,F)
|
||||
|
||||
end if
|
||||
|
||||
! Diagonalize Hamiltonian in AO basis
|
||||
|
||||
Fp = matmul(transpose(X),matmul(F,X))
|
||||
Fp = matmul(transpose(X), matmul(F, X))
|
||||
cp(:,:) = Fp(:,:)
|
||||
call diagonalize_matrix(nBas,cp,eGW)
|
||||
c = matmul(X,cp)
|
||||
call diagonalize_matrix(nOrb, cp, eGW)
|
||||
c = matmul(X, cp)
|
||||
|
||||
call AOtoMO(nBas,c,SigCp,SigC)
|
||||
call AOtoMO(nBas, nOrb, c, SigCp, SigC)
|
||||
|
||||
! Compute new density matrix in the AO basis
|
||||
|
||||
@ -283,7 +310,8 @@ subroutine SRG_qsGW(dotest,maxSCF,thresh,max_diis,doACFDT,exchange_kernel,doXBS,
|
||||
! Print results
|
||||
|
||||
call dipole_moment(nBas,P,nNuc,ZNuc,rNuc,dipole_int_AO,dipole)
|
||||
call print_qsRGW(nBas,nO,nSCF,Conv,thresh,eHF,eGW,c,SigC,Z,ENuc,ET,EV,EJ,Ex,EcGM,EcRPA,EqsGW,dipole)
|
||||
call print_qsRGW(nBas, nOrb, nO, nSCF, Conv, thresh, eHF, eGW, c, &
|
||||
SigC, Z, ENuc, ET, EV, EJ, Ex, EcGM, EcRPA, EqsGW, dipole)
|
||||
|
||||
end do
|
||||
!------------------------------------------------------------------------
|
||||
@ -300,6 +328,8 @@ subroutine SRG_qsGW(dotest,maxSCF,thresh,max_diis,doACFDT,exchange_kernel,doXBS,
|
||||
write(*,*)'!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!'
|
||||
write(*,*)
|
||||
|
||||
deallocate(c, cp, P, F, Fp, J, K, SigC, Z, Om, XpY, XmY, rho, error, error_diis, F_diis)
|
||||
|
||||
stop
|
||||
|
||||
end if
|
||||
@ -313,17 +343,18 @@ subroutine SRG_qsGW(dotest,maxSCF,thresh,max_diis,doACFDT,exchange_kernel,doXBS,
|
||||
|
||||
! Cumulant expansion
|
||||
|
||||
call RGWC(dotest,eta,nBas,nC,nO,nV,nR,nS,Om,rho,eHF,eGW,eGW,Z)
|
||||
call RGWC(dotest,eta,nOrb,nC,nO,nV,nR,nS,Om,rho,eHF,eGW,eGW,Z)
|
||||
|
||||
! Deallocate memory
|
||||
|
||||
deallocate(c,cp,P,F,Fp,J,K,SigC,Z,Om,XpY,XmY,rho,error,error_diis,F_diis)
|
||||
deallocate(c, cp, P, F, Fp, J, K, SigC, Z, Om, XpY, XmY, rho, error, error_diis, F_diis)
|
||||
|
||||
! Perform BSE calculation
|
||||
|
||||
if(BSE) then
|
||||
|
||||
call GW_phBSE(BSE2,TDA_W,TDA,dBSE,dTDA,singlet,triplet,eta,nBas,nC,nO,nV,nR,nS,ERI_MO,dipole_int_MO,eGW,eGW,EcBSE)
|
||||
call GW_phBSE(BSE2, TDA_W, TDA, dBSE, dTDA, singlet, triplet, eta, nOrb, &
|
||||
nC, nO, nV, nR, nS, ERI_MO, dipole_int_MO, eGW, eGW, EcBSE)
|
||||
|
||||
if(exchange_kernel) then
|
||||
|
||||
@ -357,7 +388,8 @@ subroutine SRG_qsGW(dotest,maxSCF,thresh,max_diis,doACFDT,exchange_kernel,doXBS,
|
||||
|
||||
end if
|
||||
|
||||
call GW_phACFDT(exchange_kernel,doXBS,.true.,TDA_W,TDA,BSE,singlet,triplet,eta,nBas,nC,nO,nV,nR,nS,ERI_MO,eGW,eGW,EcBSE)
|
||||
call GW_phACFDT(exchange_kernel, doXBS, .true., TDA_W, TDA, BSE, singlet, triplet, &
|
||||
eta, nOrb, nC, nO, nV, nR, nS, ERI_MO, eGW, eGW, EcBSE)
|
||||
|
||||
write(*,*)
|
||||
write(*,*)'-------------------------------------------------------------------------------'
|
||||
|
||||
@ -184,8 +184,8 @@ subroutine SRG_qsUGW(dotest,maxSCF,thresh,max_diis,doACFDT,exchange_kernel,doXBS
|
||||
!--------------------------------------------------
|
||||
|
||||
do ixyz=1,ncart
|
||||
call AOtoMO(nBas,c(:,:,1),dipole_int_AO(:,:,ixyz),dipole_int_aa(:,:,ixyz))
|
||||
call AOtoMO(nBas,c(:,:,2),dipole_int_AO(:,:,ixyz),dipole_int_bb(:,:,ixyz))
|
||||
call AOtoMO(nBas,nBas,c(:,:,1),dipole_int_AO(:,:,ixyz),dipole_int_aa(:,:,ixyz))
|
||||
call AOtoMO(nBas,nBas,c(:,:,2),dipole_int_AO(:,:,ixyz),dipole_int_bb(:,:,ixyz))
|
||||
end do
|
||||
|
||||
! 4-index transform for (aa|aa) block
|
||||
@ -228,7 +228,7 @@ subroutine SRG_qsUGW(dotest,maxSCF,thresh,max_diis,doACFDT,exchange_kernel,doXBS
|
||||
! Make correlation self-energy Hermitian and transform it back to AO basis
|
||||
|
||||
do is=1,nspin
|
||||
call MOtoAO(nBas,S,c(:,:,is),SigC(:,:,is),SigCp(:,:,is))
|
||||
call MOtoAO(nBas,nBas,S,c(:,:,is),SigC(:,:,is),SigCp(:,:,is))
|
||||
end do
|
||||
|
||||
! Solve the quasi-particle equation
|
||||
@ -279,7 +279,7 @@ subroutine SRG_qsUGW(dotest,maxSCF,thresh,max_diis,doACFDT,exchange_kernel,doXBS
|
||||
! Back-transform self-energy
|
||||
|
||||
do is=1,nspin
|
||||
call AOtoMO(nBas,c(:,:,is),SigCp(:,:,is),SigC(:,:,is))
|
||||
call AOtoMO(nBas,nBas,c(:,:,is),SigCp(:,:,is),SigC(:,:,is))
|
||||
end do
|
||||
|
||||
! Compute density matrix
|
||||
|
||||
@ -209,7 +209,9 @@ subroutine evRGW(dotest,maxSCF,thresh,max_diis,doACFDT,exchange_kernel,doXBS,dop
|
||||
! Cumulant expansion !
|
||||
!--------------------!
|
||||
|
||||
call RGWC(dotest,nBas,nC,nO,nR,nS,Om,rho,eGW,Z)
|
||||
! TODO
|
||||
!call RGWC(dotest, eta, nBas, nC, nO, nV, nR, nS, Om, rho, eHF, eGW, eGW, Z)
|
||||
call RGWC(dotest, eta, nBas, nC, nO, nV, nR, nS, Om, rho, eHF, eHF, eGW, Z)
|
||||
|
||||
! Deallocate memory
|
||||
|
||||
|
||||
@ -1,4 +1,8 @@
|
||||
subroutine print_qsRGW(nBas,nO,nSCF,Conv,thresh,eHF,eGW,c,SigC,Z,ENuc,ET,EV,EJ,EK,EcGM,EcRPA,EqsGW,dipole)
|
||||
|
||||
! ---
|
||||
|
||||
subroutine print_qsRGW(nBas, nOrb, nO, nSCF, Conv, thresh, eHF, eGW, c, SigC, &
|
||||
Z, ENuc, ET, EV, EJ, EK, EcGM, EcRPA, EqsGW, dipole)
|
||||
|
||||
! Print useful information about qsRGW calculation
|
||||
|
||||
@ -7,7 +11,7 @@ subroutine print_qsRGW(nBas,nO,nSCF,Conv,thresh,eHF,eGW,c,SigC,Z,ENuc,ET,EV,EJ,E
|
||||
|
||||
! Input variables
|
||||
|
||||
integer,intent(in) :: nBas
|
||||
integer,intent(in) :: nBas, nOrb
|
||||
integer,intent(in) :: nO
|
||||
integer,intent(in) :: nSCF
|
||||
double precision,intent(in) :: ENuc
|
||||
@ -19,11 +23,11 @@ subroutine print_qsRGW(nBas,nO,nSCF,Conv,thresh,eHF,eGW,c,SigC,Z,ENuc,ET,EV,EJ,E
|
||||
double precision,intent(in) :: EcRPA
|
||||
double precision,intent(in) :: Conv
|
||||
double precision,intent(in) :: thresh
|
||||
double precision,intent(in) :: eHF(nBas)
|
||||
double precision,intent(in) :: eGW(nBas)
|
||||
double precision,intent(in) :: c(nBas)
|
||||
double precision,intent(in) :: SigC(nBas,nBas)
|
||||
double precision,intent(in) :: Z(nBas)
|
||||
double precision,intent(in) :: eHF(nOrb)
|
||||
double precision,intent(in) :: eGW(nOrb)
|
||||
double precision,intent(in) :: c(nBas,nOrb)
|
||||
double precision,intent(in) :: SigC(nOrb,nOrb)
|
||||
double precision,intent(in) :: Z(nOrb)
|
||||
double precision,intent(in) :: EqsGW
|
||||
double precision,intent(in) :: dipole(ncart)
|
||||
|
||||
@ -59,7 +63,7 @@ subroutine print_qsRGW(nBas,nO,nSCF,Conv,thresh,eHF,eGW,c,SigC,Z,ENuc,ET,EV,EJ,E
|
||||
'|','#','|','e_HF (eV)','|','Sig_GW (eV)','|','Z','|','e_GW (eV)','|'
|
||||
write(*,*)'-------------------------------------------------------------------------------'
|
||||
|
||||
do p=1,nBas
|
||||
do p=1,nOrb
|
||||
write(*,'(1X,A1,1X,I3,1X,A1,1X,F15.6,1X,A1,1X,F15.6,1X,A1,1X,F15.6,1X,A1,1X,F15.6,1X,A1,1X)') &
|
||||
'|',p,'|',eHF(p)*HaToeV,'|',SigC(p,p)*HaToeV,'|',Z(p),'|',eGW(p)*HaToeV,'|'
|
||||
end do
|
||||
@ -110,13 +114,13 @@ subroutine print_qsRGW(nBas,nO,nSCF,Conv,thresh,eHF,eGW,c,SigC,Z,ENuc,ET,EV,EJ,E
|
||||
write(*,'(A50)') '---------------------------------------'
|
||||
write(*,'(A50)') ' Restricted qsGW orbital coefficients'
|
||||
write(*,'(A50)') '---------------------------------------'
|
||||
call matout(nBas,nBas,c)
|
||||
call matout(nBas, nOrb, c)
|
||||
write(*,*)
|
||||
end if
|
||||
write(*,'(A50)') '---------------------------------------'
|
||||
write(*,'(A50)') ' Restricted qsGW orbital energies (au) '
|
||||
write(*,'(A50)') '---------------------------------------'
|
||||
call vecout(nBas,eGW)
|
||||
call vecout(nOrb, eGW)
|
||||
write(*,*)
|
||||
|
||||
end if
|
||||
|
||||
131
src/GW/qsRGW.f90
131
src/GW/qsRGW.f90
@ -1,6 +1,10 @@
|
||||
subroutine qsRGW(dotest,maxSCF,thresh,max_diis,doACFDT,exchange_kernel,doXBS,dophBSE,dophBSE2,TDA_W,TDA,dBSE,dTDA,doppBSE, &
|
||||
singlet,triplet,eta,regularize,nNuc,ZNuc,rNuc,ENuc,nBas,nC,nO,nV,nR,nS,ERHF,S,X,T,V,Hc,ERI_AO, &
|
||||
ERI_MO,dipole_int_AO,dipole_int_MO,PHF,cHF,eHF)
|
||||
|
||||
! ---
|
||||
|
||||
subroutine qsRGW(dotest, maxSCF, thresh, max_diis, doACFDT, exchange_kernel, doXBS, dophBSE, dophBSE2, &
|
||||
TDA_W, TDA, dBSE, dTDA, doppBSE, singlet, triplet, eta, regularize, nNuc, ZNuc, rNuc, &
|
||||
ENuc, nBas, nOrb, nC, nO, nV, nR, nS, ERHF, S, X, T, V, Hc, ERI_AO, &
|
||||
ERI_MO, dipole_int_AO, dipole_int_MO, PHF, cHF, eHF)
|
||||
|
||||
! Perform a quasiparticle self-consistent GW calculation
|
||||
|
||||
@ -34,15 +38,15 @@ subroutine qsRGW(dotest,maxSCF,thresh,max_diis,doACFDT,exchange_kernel,doXBS,dop
|
||||
double precision,intent(in) :: rNuc(nNuc,ncart)
|
||||
double precision,intent(in) :: ENuc
|
||||
|
||||
integer,intent(in) :: nBas
|
||||
integer,intent(in) :: nBas, nOrb
|
||||
integer,intent(in) :: nC
|
||||
integer,intent(in) :: nO
|
||||
integer,intent(in) :: nV
|
||||
integer,intent(in) :: nR
|
||||
integer,intent(in) :: nS
|
||||
double precision,intent(in) :: ERHF
|
||||
double precision,intent(in) :: eHF(nBas)
|
||||
double precision,intent(in) :: cHF(nBas,nBas)
|
||||
double precision,intent(in) :: eHF(nOrb)
|
||||
double precision,intent(in) :: cHF(nBas,nOrb)
|
||||
double precision,intent(in) :: PHF(nBas,nBas)
|
||||
double precision,intent(in) :: S(nBas,nBas)
|
||||
double precision,intent(in) :: T(nBas,nBas)
|
||||
@ -50,14 +54,14 @@ subroutine qsRGW(dotest,maxSCF,thresh,max_diis,doACFDT,exchange_kernel,doXBS,dop
|
||||
double precision,intent(in) :: Hc(nBas,nBas)
|
||||
double precision,intent(in) :: X(nBas,nBas)
|
||||
double precision,intent(in) :: ERI_AO(nBas,nBas,nBas,nBas)
|
||||
double precision,intent(inout):: ERI_MO(nBas,nBas,nBas,nBas)
|
||||
double precision,intent(inout):: ERI_MO(nOrb,nOrb,nOrb,nOrb)
|
||||
double precision,intent(in) :: dipole_int_AO(nBas,nBas,ncart)
|
||||
double precision,intent(inout):: dipole_int_MO(nBas,nBas,ncart)
|
||||
double precision,intent(inout):: dipole_int_MO(nOrb,nOrb,ncart)
|
||||
|
||||
! Local variables
|
||||
|
||||
integer :: nSCF
|
||||
integer :: nBasSq
|
||||
integer :: nBas_Sq
|
||||
integer :: ispin
|
||||
integer :: ixyz
|
||||
integer :: n_diis
|
||||
@ -112,7 +116,7 @@ subroutine qsRGW(dotest,maxSCF,thresh,max_diis,doACFDT,exchange_kernel,doXBS,dop
|
||||
|
||||
! Stuff
|
||||
|
||||
nBasSq = nBas*nBas
|
||||
nBas_Sq = nBas*nBas
|
||||
|
||||
! TDA for W
|
||||
|
||||
@ -130,10 +134,31 @@ subroutine qsRGW(dotest,maxSCF,thresh,max_diis,doACFDT,exchange_kernel,doXBS,dop
|
||||
|
||||
! Memory allocation
|
||||
|
||||
allocate(eGW(nBas),c(nBas,nBas),cp(nBas,nBas),P(nBas,nBas),F(nBas,nBas),Fp(nBas,nBas), &
|
||||
J(nBas,nBas),K(nBas,nBas),SigC(nBas,nBas),SigCp(nBas,nBas),Z(nBas), &
|
||||
Aph(nS,nS),Bph(nS,nS),Om(nS),XpY(nS,nS),XmY(nS,nS),rho(nBas,nBas,nS), &
|
||||
err(nBas,nBas),err_diis(nBasSq,max_diis),F_diis(nBasSq,max_diis))
|
||||
allocate(eGW(nOrb))
|
||||
allocate(Z(nOrb))
|
||||
|
||||
allocate(c(nBas,nOrb))
|
||||
|
||||
allocate(cp(nOrb,nOrb))
|
||||
allocate(Fp(nOrb,nOrb))
|
||||
allocate(SigC(nOrb,nOrb))
|
||||
|
||||
allocate(P(nBas,nBas))
|
||||
allocate(F(nBas,nBas))
|
||||
allocate(J(nBas,nBas))
|
||||
allocate(K(nBas,nBas))
|
||||
allocate(err(nBas,nBas))
|
||||
allocate(SigCp(nBas,nBas))
|
||||
|
||||
allocate(Aph(nS,nS))
|
||||
allocate(Bph(nS,nS))
|
||||
allocate(Om(nS))
|
||||
allocate(XpY(nS,nS))
|
||||
allocate(XmY(nS,nS))
|
||||
allocate(rho(nOrb,nOrb,nS))
|
||||
|
||||
allocate(err_diis(nBas_Sq,max_diis))
|
||||
allocate(F_diis(nBas_Sq,max_diis))
|
||||
|
||||
! Initialization
|
||||
|
||||
@ -160,64 +185,68 @@ subroutine qsRGW(dotest,maxSCF,thresh,max_diis,doACFDT,exchange_kernel,doXBS,dop
|
||||
|
||||
! Build Hartree-exchange matrix
|
||||
|
||||
call Hartree_matrix_AO_basis(nBas,P,ERI_AO,J)
|
||||
call exchange_matrix_AO_basis(nBas,P,ERI_AO,K)
|
||||
call Hartree_matrix_AO_basis(nBas, P, ERI_AO, J)
|
||||
call exchange_matrix_AO_basis(nBas, P, ERI_AO, K)
|
||||
|
||||
! AO to MO transformation of two-electron integrals
|
||||
|
||||
do ixyz=1,ncart
|
||||
call AOtoMO(nBas,c,dipole_int_AO(:,:,ixyz),dipole_int_MO(:,:,ixyz))
|
||||
do ixyz = 1, ncart
|
||||
call AOtoMO(nBas, nOrb, c, dipole_int_AO(1,1,ixyz), dipole_int_MO(1,1,ixyz))
|
||||
end do
|
||||
|
||||
call AOtoMO_ERI_RHF(nBas,c,ERI_AO,ERI_MO)
|
||||
call AOtoMO_ERI_RHF(nBas, nOrb, c, ERI_AO, ERI_MO)
|
||||
|
||||
! Compute linear response
|
||||
|
||||
call phLR_A(ispin,dRPA,nBas,nC,nO,nV,nR,nS,1d0,eGW,ERI_MO,Aph)
|
||||
if(.not.TDA_W) call phLR_B(ispin,dRPA,nBas,nC,nO,nV,nR,nS,1d0,ERI_MO,Bph)
|
||||
call phLR_A(ispin, dRPA, nOrb, nC, nO, nV, nR, nS, 1d0, eGW, ERI_MO, Aph)
|
||||
if(.not.TDA_W) call phLR_B(ispin, dRPA, nOrb, nC, nO, nV, nR, nS, 1d0, ERI_MO, Bph)
|
||||
|
||||
call phLR(TDA_W,nS,Aph,Bph,EcRPA,Om,XpY,XmY)
|
||||
call phLR(TDA_W, nS, Aph, Bph, EcRPA, Om, XpY, XmY)
|
||||
if(print_W) call print_excitation_energies('phRPA@GW@RHF','singlet',nS,Om)
|
||||
|
||||
! Compute correlation part of the self-energy
|
||||
|
||||
call GW_excitation_density(nBas,nC,nO,nR,nS,ERI_MO,XpY,rho)
|
||||
call GW_excitation_density(nOrb, nC, nO, nR, nS, ERI_MO, XpY, rho)
|
||||
|
||||
if(regularize) call GW_regularization(nBas,nC,nO,nV,nR,nS,eGW,Om,rho)
|
||||
if(regularize) call GW_regularization(nOrb, nC, nO, nV, nR, nS, eGW, Om, rho)
|
||||
|
||||
call GW_self_energy(eta,nBas,nC,nO,nV,nR,nS,eGW,Om,rho,EcGM,SigC,Z)
|
||||
call GW_self_energy(eta, nOrb, nC, nO, nV, nR, nS, eGW, Om, rho, EcGM, SigC, Z)
|
||||
|
||||
! Make correlation self-energy Hermitian and transform it back to AO basis
|
||||
|
||||
SigC = 0.5d0*(SigC + transpose(SigC))
|
||||
|
||||
call MOtoAO(nBas,S,c,SigC,SigCp)
|
||||
call MOtoAO(nBas, nOrb, S, c, SigC, SigCp)
|
||||
|
||||
! Solve the quasi-particle equation
|
||||
|
||||
F(:,:) = Hc(:,:) + J(:,:) + 0.5d0*K(:,:) + SigCp(:,:)
|
||||
if(nBas .ne. nOrb) then
|
||||
call AOtoMO(nBas, nOrb, c(1,1), F(1,1), Fp(1,1))
|
||||
call MOtoAO(nBas, nOrb, S(1,1), c(1,1), Fp(1,1), F(1,1))
|
||||
endif
|
||||
|
||||
! Compute commutator and convergence criteria
|
||||
|
||||
err = matmul(F,matmul(P,S)) - matmul(matmul(S,P),F)
|
||||
err = matmul(F, matmul(P, S)) - matmul(matmul(S, P), F)
|
||||
|
||||
if(nSCF > 1) Conv = maxval(abs(err))
|
||||
|
||||
! Kinetic energy
|
||||
|
||||
ET = trace_matrix(nBas,matmul(P,T))
|
||||
ET = trace_matrix(nBas, matmul(P, T))
|
||||
|
||||
! Potential energy
|
||||
|
||||
EV = trace_matrix(nBas,matmul(P,V))
|
||||
EV = trace_matrix(nBas, matmul(P, V))
|
||||
|
||||
! Hartree energy
|
||||
|
||||
EJ = 0.5d0*trace_matrix(nBas,matmul(P,J))
|
||||
EJ = 0.5d0*trace_matrix(nBas, matmul(P, J))
|
||||
|
||||
! Exchange energy
|
||||
|
||||
EK = 0.25d0*trace_matrix(nBas,matmul(P,K))
|
||||
EK = 0.25d0*trace_matrix(nBas, matmul(P, K))
|
||||
|
||||
! Total energy
|
||||
|
||||
@ -228,26 +257,36 @@ subroutine qsRGW(dotest,maxSCF,thresh,max_diis,doACFDT,exchange_kernel,doXBS,dop
|
||||
if(max_diis > 1) then
|
||||
|
||||
n_diis = min(n_diis+1,max_diis)
|
||||
call DIIS_extrapolation(rcond,nBasSq,nBasSq,n_diis,err_diis,F_diis,err,F)
|
||||
call DIIS_extrapolation(rcond,nBas_Sq,nBas_Sq,n_diis,err_diis,F_diis,err,F)
|
||||
|
||||
end if
|
||||
|
||||
! Diagonalize Hamiltonian in AO basis
|
||||
|
||||
Fp = matmul(transpose(X),matmul(F,X))
|
||||
cp(:,:) = Fp(:,:)
|
||||
call diagonalize_matrix(nBas,cp,eGW)
|
||||
c = matmul(X,cp)
|
||||
call AOtoMO(nBas,c,SigCp,SigC)
|
||||
if(nBas .eq. nOrb) then
|
||||
Fp = matmul(transpose(X), matmul(F, X))
|
||||
cp(:,:) = Fp(:,:)
|
||||
call diagonalize_matrix(nOrb, cp, eGW)
|
||||
c = matmul(X, cp)
|
||||
else
|
||||
Fp = matmul(transpose(c), matmul(F, c))
|
||||
cp(:,:) = Fp(:,:)
|
||||
call diagonalize_matrix(nOrb, cp, eGW)
|
||||
c = matmul(c, cp)
|
||||
endif
|
||||
|
||||
|
||||
call AOtoMO(nBas, nOrb, c, SigCp, SigC)
|
||||
|
||||
! Density matrix
|
||||
|
||||
P(:,:) = 2d0*matmul(c(:,1:nO),transpose(c(:,1:nO)))
|
||||
P(:,:) = 2d0*matmul(c(:,1:nO), transpose(c(:,1:nO)))
|
||||
|
||||
! Print results
|
||||
|
||||
call dipole_moment(nBas,P,nNuc,ZNuc,rNuc,dipole_int_AO,dipole)
|
||||
call print_qsRGW(nBas,nO,nSCF,Conv,thresh,eHF,eGW,c,SigCp,Z,ENuc,ET,EV,EJ,EK,EcGM,EcRPA,EqsGW,dipole)
|
||||
call dipole_moment(nBas, P, nNuc, ZNuc, rNuc, dipole_int_AO, dipole)
|
||||
call print_qsRGW(nBas, nOrb, nO, nSCF, Conv, thresh, eHF, eGW, c, SigC, Z, &
|
||||
ENuc, ET, EV, EJ, EK, EcGM, EcRPA, EqsGW, dipole)
|
||||
|
||||
end do
|
||||
!------------------------------------------------------------------------
|
||||
@ -264,19 +303,21 @@ subroutine qsRGW(dotest,maxSCF,thresh,max_diis,doACFDT,exchange_kernel,doXBS,dop
|
||||
write(*,*)'!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!'
|
||||
write(*,*)
|
||||
|
||||
deallocate(c, cp, P, F, Fp, J, K, SigC, SigCp, Z, Om, XpY, XmY, rho, err, err_diis, F_diis)
|
||||
stop
|
||||
|
||||
end if
|
||||
|
||||
! Deallocate memory
|
||||
|
||||
deallocate(c,cp,P,F,Fp,J,K,SigC,SigCp,Z,Om,XpY,XmY,rho,err,err_diis,F_diis)
|
||||
deallocate(c, cp, P, F, Fp, J, K, SigC, SigCp, Z, Om, XpY, XmY, rho, err, err_diis, F_diis)
|
||||
|
||||
! Perform BSE calculation
|
||||
|
||||
if(dophBSE) then
|
||||
|
||||
call GW_phBSE(dophBSE2,TDA_W,TDA,dBSE,dTDA,singlet,triplet,eta,nBas,nC,nO,nV,nR,nS,ERI_MO,dipole_int_MO,eGW,eGW,EcBSE)
|
||||
call GW_phBSE(dophBSE2, TDA_W, TDA, dBSE, dTDA, singlet, triplet, eta, &
|
||||
nOrb, nC, nO, nV, nR, nS, ERI_MO, dipole_int_MO, eGW, eGW, EcBSE)
|
||||
|
||||
if(exchange_kernel) then
|
||||
|
||||
@ -310,7 +351,8 @@ subroutine qsRGW(dotest,maxSCF,thresh,max_diis,doACFDT,exchange_kernel,doXBS,dop
|
||||
|
||||
end if
|
||||
|
||||
call GW_phACFDT(exchange_kernel,doXBS,.true.,TDA_W,TDA,dophBSE,singlet,triplet,eta,nBas,nC,nO,nV,nR,nS,ERI_MO,eGW,eGW,EcBSE)
|
||||
call GW_phACFDT(exchange_kernel, doXBS, .true., TDA_W, TDA, dophBSE, singlet, triplet, &
|
||||
eta, nOrb, nC, nO, nV, nR, nS, ERI_MO, eGW, eGW, EcBSE)
|
||||
|
||||
write(*,*)
|
||||
write(*,*)'-------------------------------------------------------------------------------'
|
||||
@ -327,7 +369,8 @@ subroutine qsRGW(dotest,maxSCF,thresh,max_diis,doACFDT,exchange_kernel,doXBS,dop
|
||||
|
||||
if(doppBSE) then
|
||||
|
||||
call GW_ppBSE(TDA_W,TDA,dBSE,dTDA,singlet,triplet,eta,nBas,nC,nO,nV,nR,nS,ERI_MO,dipole_int_MO,eHF,eGW,EcBSE)
|
||||
call GW_ppBSE(TDA_W, TDA, dBSE, dTDA, singlet, triplet, eta, nOrb, &
|
||||
nC, nO, nV, nR, nS, ERI_MO, dipole_int_MO, eHF, eGW, EcBSE)
|
||||
|
||||
EcBSE(2) = 3d0*EcBSE(2)
|
||||
|
||||
|
||||
@ -184,8 +184,8 @@ subroutine qsUGW(dotest,maxSCF,thresh,max_diis,doACFDT,exchange_kernel,doXBS,BSE
|
||||
!--------------------------------------------------
|
||||
|
||||
do ixyz=1,ncart
|
||||
call AOtoMO(nBas,c(:,:,1),dipole_int_AO(:,:,ixyz),dipole_int_aa(:,:,ixyz))
|
||||
call AOtoMO(nBas,c(:,:,2),dipole_int_AO(:,:,ixyz),dipole_int_bb(:,:,ixyz))
|
||||
call AOtoMO(nBas,nBas,c(:,:,1),dipole_int_AO(:,:,ixyz),dipole_int_aa(:,:,ixyz))
|
||||
call AOtoMO(nBas,nBas,c(:,:,2),dipole_int_AO(:,:,ixyz),dipole_int_bb(:,:,ixyz))
|
||||
end do
|
||||
|
||||
! 4-index transform for (aa|aa) block
|
||||
@ -232,7 +232,7 @@ subroutine qsUGW(dotest,maxSCF,thresh,max_diis,doACFDT,exchange_kernel,doXBS,BSE
|
||||
end do
|
||||
|
||||
do is=1,nspin
|
||||
call MOtoAO(nBas,S,c(:,:,is),SigC(:,:,is),SigCp(:,:,is))
|
||||
call MOtoAO(nBas,nBas,S,c(:,:,is),SigC(:,:,is),SigCp(:,:,is))
|
||||
end do
|
||||
|
||||
! Solve the quasi-particle equation
|
||||
@ -283,7 +283,7 @@ subroutine qsUGW(dotest,maxSCF,thresh,max_diis,doACFDT,exchange_kernel,doXBS,BSE
|
||||
! Back-transform self-energy
|
||||
|
||||
do is=1,nspin
|
||||
call AOtoMO(nBas,c(:,:,is),SigCp(:,:,is),SigC(:,:,is))
|
||||
call AOtoMO(nBas,nBas,c(:,:,is),SigCp(:,:,is),SigC(:,:,is))
|
||||
end do
|
||||
|
||||
! Compute density matrix
|
||||
|
||||
@ -123,7 +123,7 @@ subroutine GHF(dotest,maxSCF,thresh,max_diis,guess_type,mix,level_shift,nNuc,ZNu
|
||||
|
||||
! Guess coefficients and density matrices
|
||||
|
||||
call mo_guess(nBas2,guess_type,S,H,X,C)
|
||||
call mo_guess(nBas2,nBas2,guess_type,S,H,X,C)
|
||||
|
||||
! Construct super density matrix
|
||||
|
||||
@ -227,7 +227,7 @@ subroutine GHF(dotest,maxSCF,thresh,max_diis,guess_type,mix,level_shift,nNuc,ZNu
|
||||
|
||||
! Level-shifting
|
||||
|
||||
if(level_shift > 0d0 .and. Conv > thresh) call level_shifting(level_shift,nBas,nO,S,C,F)
|
||||
if(level_shift > 0d0 .and. Conv > thresh) call level_shifting(level_shift,nBas,nBas,nO,S,C,F)
|
||||
|
||||
! Transform Fock matrix in orthogonal basis
|
||||
|
||||
|
||||
@ -1,5 +1,8 @@
|
||||
subroutine RHF(dotest,maxSCF,thresh,max_diis,guess_type,level_shift,nNuc,ZNuc,rNuc,ENuc, &
|
||||
nBas,nO,S,T,V,Hc,ERI,dipole_int,X,ERHF,eHF,c,P)
|
||||
|
||||
! ---
|
||||
|
||||
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)
|
||||
|
||||
! Perform restricted Hartree-Fock calculation
|
||||
|
||||
@ -16,7 +19,7 @@ subroutine RHF(dotest,maxSCF,thresh,max_diis,guess_type,level_shift,nNuc,ZNuc,rN
|
||||
double precision,intent(in) :: thresh
|
||||
double precision,intent(in) :: level_shift
|
||||
|
||||
integer,intent(in) :: nBas
|
||||
integer,intent(in) :: nBas, nOrb
|
||||
integer,intent(in) :: nO
|
||||
integer,intent(in) :: nNuc
|
||||
double precision,intent(in) :: ZNuc(nNuc)
|
||||
@ -26,14 +29,14 @@ subroutine RHF(dotest,maxSCF,thresh,max_diis,guess_type,level_shift,nNuc,ZNuc,rN
|
||||
double precision,intent(in) :: T(nBas,nBas)
|
||||
double precision,intent(in) :: V(nBas,nBas)
|
||||
double precision,intent(in) :: Hc(nBas,nBas)
|
||||
double precision,intent(in) :: X(nBas,nBas)
|
||||
double precision,intent(in) :: X(nBas,nOrb)
|
||||
double precision,intent(in) :: ERI(nBas,nBas,nBas,nBas)
|
||||
double precision,intent(in) :: dipole_int(nBas,nBas,ncart)
|
||||
|
||||
! Local variables
|
||||
|
||||
integer :: nSCF
|
||||
integer :: nBasSq
|
||||
integer :: nBas_Sq
|
||||
integer :: n_diis
|
||||
double precision :: ET
|
||||
double precision :: EV
|
||||
@ -56,8 +59,8 @@ subroutine RHF(dotest,maxSCF,thresh,max_diis,guess_type,level_shift,nNuc,ZNuc,rN
|
||||
! Output variables
|
||||
|
||||
double precision,intent(out) :: ERHF
|
||||
double precision,intent(out) :: eHF(nBas)
|
||||
double precision,intent(inout):: c(nBas,nBas)
|
||||
double precision,intent(out) :: eHF(nOrb)
|
||||
double precision,intent(inout):: c(nBas,nOrb)
|
||||
double precision,intent(out) :: P(nBas,nBas)
|
||||
|
||||
! Hello world
|
||||
@ -70,24 +73,37 @@ subroutine RHF(dotest,maxSCF,thresh,max_diis,guess_type,level_shift,nNuc,ZNuc,rN
|
||||
|
||||
! Useful quantities
|
||||
|
||||
nBasSq = nBas*nBas
|
||||
nBas_Sq = nBas*nBas
|
||||
|
||||
! Memory allocation
|
||||
|
||||
allocate(J(nBas,nBas),K(nBas,nBas),err(nBas,nBas),cp(nBas,nBas),F(nBas,nBas), &
|
||||
Fp(nBas,nBas),err_diis(nBasSq,max_diis),F_diis(nBasSq,max_diis))
|
||||
allocate(J(nBas,nBas))
|
||||
allocate(K(nBas,nBas))
|
||||
|
||||
allocate(err(nBas,nBas))
|
||||
allocate(F(nBas,nBas))
|
||||
|
||||
allocate(cp(nOrb,nOrb))
|
||||
allocate(Fp(nOrb,nOrb))
|
||||
|
||||
allocate(err_diis(nBas_Sq,max_diis))
|
||||
allocate(F_diis(nBas_Sq,max_diis))
|
||||
|
||||
! Guess coefficients and density matrix
|
||||
|
||||
call mo_guess(nBas,guess_type,S,Hc,X,c)
|
||||
P(:,:) = 2d0*matmul(c(:,1:nO),transpose(c(:,1:nO)))
|
||||
call mo_guess(nBas, nOrb, guess_type, S, Hc, X, c)
|
||||
|
||||
!P(:,:) = 2d0 * matmul(c(:,1:nO), transpose(c(:,1:nO)))
|
||||
call dgemm('N', 'T', nBas, nBas, nO, 2.d0, &
|
||||
c(1,1), nBas, c(1,1), nBas, &
|
||||
0.d0, P(1,1), nBas)
|
||||
|
||||
! Initialization
|
||||
|
||||
n_diis = 0
|
||||
n_diis = 0
|
||||
F_diis(:,:) = 0d0
|
||||
err_diis(:,:) = 0d0
|
||||
rcond = 0d0
|
||||
rcond = 0d0
|
||||
|
||||
Conv = 1d0
|
||||
nSCF = 0
|
||||
@ -110,31 +126,35 @@ subroutine RHF(dotest,maxSCF,thresh,max_diis,guess_type,level_shift,nNuc,ZNuc,rN
|
||||
|
||||
! Build Fock matrix
|
||||
|
||||
call Hartree_matrix_AO_basis(nBas,P,ERI,J)
|
||||
call exchange_matrix_AO_basis(nBas,P,ERI,K)
|
||||
call Hartree_matrix_AO_basis(nBas, P, ERI, J)
|
||||
call exchange_matrix_AO_basis(nBas, P, ERI, K)
|
||||
|
||||
F(:,:) = Hc(:,:) + J(:,:) + 0.5d0*K(:,:)
|
||||
if(nBas .ne. nOrb) then
|
||||
call AOtoMO(nBas, nOrb, c(1,1), F(1,1), Fp(1,1))
|
||||
call MOtoAO(nBas, nOrb, S(1,1), c(1,1), Fp(1,1), F(1,1))
|
||||
endif
|
||||
|
||||
! Check convergence
|
||||
|
||||
err = matmul(F,matmul(P,S)) - matmul(matmul(S,P),F)
|
||||
err = matmul(F, matmul(P, S)) - matmul(matmul(S, P), F)
|
||||
if(nSCF > 1) Conv = maxval(abs(err))
|
||||
|
||||
! Kinetic energy
|
||||
|
||||
ET = trace_matrix(nBas,matmul(P,T))
|
||||
ET = trace_matrix(nBas, matmul(P, T))
|
||||
|
||||
! Potential energy
|
||||
|
||||
EV = trace_matrix(nBas,matmul(P,V))
|
||||
EV = trace_matrix(nBas, matmul(P, V))
|
||||
|
||||
! Hartree energy
|
||||
|
||||
EJ = 0.5d0*trace_matrix(nBas,matmul(P,J))
|
||||
EJ = 0.5d0*trace_matrix(nBas, matmul(P, J))
|
||||
|
||||
! Exchange energy
|
||||
|
||||
EK = 0.25d0*trace_matrix(nBas,matmul(P,K))
|
||||
EK = 0.25d0*trace_matrix(nBas, matmul(P, K))
|
||||
|
||||
! Total energy
|
||||
|
||||
@ -144,25 +164,37 @@ subroutine RHF(dotest,maxSCF,thresh,max_diis,guess_type,level_shift,nNuc,ZNuc,rN
|
||||
|
||||
if(max_diis > 1) then
|
||||
|
||||
n_diis = min(n_diis+1,max_diis)
|
||||
call DIIS_extrapolation(rcond,nBasSq,nBasSq,n_diis,err_diis,F_diis,err,F)
|
||||
n_diis = min(n_diis+1, max_diis)
|
||||
call DIIS_extrapolation(rcond, nBas_Sq, nBas_Sq, n_diis, err_diis, F_diis, err, F)
|
||||
|
||||
end if
|
||||
|
||||
! Level shift
|
||||
|
||||
if(level_shift > 0d0 .and. Conv > thresh) call level_shifting(level_shift,nBas,nO,S,c,F)
|
||||
if(level_shift > 0d0 .and. Conv > thresh) then
|
||||
call level_shifting(level_shift, nBas, nOrb, nO, S, c, F)
|
||||
endif
|
||||
|
||||
! Diagonalize Fock matrix
|
||||
|
||||
Fp = matmul(transpose(X),matmul(F,X))
|
||||
cp(:,:) = Fp(:,:)
|
||||
call diagonalize_matrix(nBas,cp,eHF)
|
||||
c = matmul(X,cp)
|
||||
if(nBas .eq. nOrb) then
|
||||
Fp = matmul(transpose(X), matmul(F, X))
|
||||
cp(:,:) = Fp(:,:)
|
||||
call diagonalize_matrix(nOrb, cp, eHF)
|
||||
c = matmul(X, cp)
|
||||
else
|
||||
Fp = matmul(transpose(c), matmul(F, c))
|
||||
cp(:,:) = Fp(:,:)
|
||||
call diagonalize_matrix(nOrb, cp, eHF)
|
||||
c = matmul(c, cp)
|
||||
endif
|
||||
|
||||
! Density matrix
|
||||
|
||||
P(:,:) = 2d0*matmul(c(:,1:nO),transpose(c(:,1:nO)))
|
||||
!P(:,:) = 2d0*matmul(c(:,1:nO), transpose(c(:,1:nO)))
|
||||
call dgemm('N', 'T', nBas, nBas, nO, 2.d0, &
|
||||
c(1,1), nBas, c(1,1), nBas, &
|
||||
0.d0, P(1,1), nBas)
|
||||
|
||||
! Dump results
|
||||
|
||||
@ -185,14 +217,16 @@ subroutine RHF(dotest,maxSCF,thresh,max_diis,guess_type,level_shift,nNuc,ZNuc,rN
|
||||
write(*,*)'!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!'
|
||||
write(*,*)
|
||||
|
||||
deallocate(J, K, err, F, cp, Fp, err_diis, F_diis)
|
||||
|
||||
stop
|
||||
|
||||
end if
|
||||
|
||||
! Compute dipole moments
|
||||
|
||||
call dipole_moment(nBas,P,nNuc,ZNuc,rNuc,dipole_int,dipole)
|
||||
call print_RHF(nBas,nO,eHF,C,ENuc,ET,EV,EJ,EK,ERHF,dipole)
|
||||
call dipole_moment(nBas, P, nNuc, ZNuc, rNuc, dipole_int, dipole)
|
||||
call print_RHF(nBas, nOrb, nO, eHF, c, ENuc, ET, EV, EJ, EK, ERHF, dipole)
|
||||
|
||||
! Testing zone
|
||||
|
||||
@ -205,4 +239,6 @@ subroutine RHF(dotest,maxSCF,thresh,max_diis,guess_type,level_shift,nNuc,ZNuc,rN
|
||||
|
||||
end if
|
||||
|
||||
deallocate(J, K, err, F, cp, Fp, err_diis, F_diis)
|
||||
|
||||
end subroutine
|
||||
|
||||
@ -1,6 +1,9 @@
|
||||
subroutine RHF_search(maxSCF,thresh,max_diis,guess_type,level_shift,nNuc,ZNuc,rNuc,ENuc, &
|
||||
nBas,nC,nO,nV,nR,S,T,V,Hc,ERI_AO,ERI_MO,dipole_int_AO,dipole_int_MO, &
|
||||
X,ERHF,e,c,P)
|
||||
|
||||
! ---
|
||||
|
||||
subroutine RHF_search(maxSCF, thresh, max_diis, guess_type, level_shift, nNuc, ZNuc, rNuc, ENuc, &
|
||||
nBas, nOrb, nC, nO, nV, nR, S, T, V, Hc, ERI_AO, ERI_MO, dipole_int_AO, dipole_int_MO, &
|
||||
X, ERHF, e, c, P)
|
||||
|
||||
! Search for RHF solutions
|
||||
|
||||
@ -13,7 +16,7 @@ subroutine RHF_search(maxSCF,thresh,max_diis,guess_type,level_shift,nNuc,ZNuc,rN
|
||||
double precision,intent(in) :: thresh
|
||||
double precision,intent(in) :: level_shift
|
||||
|
||||
integer,intent(in) :: nBas
|
||||
integer,intent(in) :: nBas, nOrb
|
||||
integer,intent(in) :: nC
|
||||
integer,intent(in) :: nO
|
||||
integer,intent(in) :: nV
|
||||
@ -26,11 +29,11 @@ subroutine RHF_search(maxSCF,thresh,max_diis,guess_type,level_shift,nNuc,ZNuc,rN
|
||||
double precision,intent(in) :: T(nBas,nBas)
|
||||
double precision,intent(in) :: V(nBas,nBas)
|
||||
double precision,intent(in) :: Hc(nBas,nBas)
|
||||
double precision,intent(in) :: X(nBas,nBas)
|
||||
double precision,intent(in) :: X(nBas,nOrb)
|
||||
double precision,intent(in) :: ERI_AO(nBas,nBas,nBas,nBas)
|
||||
double precision,intent(inout):: ERI_MO(nBas,nBas,nBas,nBas)
|
||||
double precision,intent(inout):: ERI_MO(nOrb,nOrb,nOrb,nOrb)
|
||||
double precision,intent(in) :: dipole_int_AO(nBas,nBas,ncart)
|
||||
double precision,intent(inout):: dipole_int_MO(nBas,nBas,ncart)
|
||||
double precision,intent(inout):: dipole_int_MO(nOrb,nOrb,ncart)
|
||||
|
||||
! Local variables
|
||||
|
||||
@ -59,8 +62,8 @@ subroutine RHF_search(maxSCF,thresh,max_diis,guess_type,level_shift,nNuc,ZNuc,rN
|
||||
! Output variables
|
||||
|
||||
double precision,intent(out) :: ERHF
|
||||
double precision,intent(out) :: e(nBas)
|
||||
double precision,intent(inout):: c(nBas,nBas)
|
||||
double precision,intent(out) :: e(nOrb)
|
||||
double precision,intent(inout):: c(nBas,nOrb)
|
||||
double precision,intent(out) :: P(nBas,nBas)
|
||||
|
||||
! Memory allocation
|
||||
@ -76,7 +79,8 @@ subroutine RHF_search(maxSCF,thresh,max_diis,guess_type,level_shift,nNuc,ZNuc,rN
|
||||
!-------------------!
|
||||
|
||||
nS = (nO - nC)*(nV - nR)
|
||||
allocate(Aph(nS,nS),Bph(nS,nS),AB(nS,nS),Om(nS),R(nBas,nBas),ExpR(nBas,nBas))
|
||||
allocate(Aph(nS,nS), Bph(nS,nS), AB(nS,nS), Om(nS))
|
||||
allocate(R(nOrb,nOrb), ExpR(nOrb,nOrb))
|
||||
|
||||
!------------------!
|
||||
! Search algorithm !
|
||||
@ -92,12 +96,12 @@ subroutine RHF_search(maxSCF,thresh,max_diis,guess_type,level_shift,nNuc,ZNuc,rN
|
||||
!---------------------!
|
||||
|
||||
call wall_time(start_HF)
|
||||
call RHF(.false.,maxSCF,thresh,max_diis,guess,level_shift,nNuc,ZNuc,rNuc,ENuc, &
|
||||
nBas,nO,S,T,V,Hc,ERI_AO,dipole_int_AO,X,ERHF,e,c,P)
|
||||
call RHF(.false., maxSCF, thresh, max_diis, guess, level_shift, nNuc, ZNuc, rNuc, ENuc, &
|
||||
nBas, nOrb, nO, S, T, V, Hc, ERI_AO, dipole_int_AO, X, ERHF, e, c, P)
|
||||
call wall_time(end_HF)
|
||||
|
||||
t_HF = end_HF - start_HF
|
||||
write(*,'(A65,1X,F9.3,A8)') 'Total CPU time for RHF = ',t_HF,' seconds'
|
||||
write(*,'(A65,1X,F9.3,A8)') 'Total wall time for RHF = ',t_HF,' seconds'
|
||||
write(*,*)
|
||||
|
||||
!----------------------------------!
|
||||
@ -108,14 +112,14 @@ subroutine RHF_search(maxSCF,thresh,max_diis,guess_type,level_shift,nNuc,ZNuc,rN
|
||||
write(*,*)
|
||||
write(*,*) 'AO to MO transformation... Please be patient'
|
||||
write(*,*)
|
||||
do ixyz=1,ncart
|
||||
call AOtoMO(nBas,c,dipole_int_AO(:,:,ixyz),dipole_int_MO(:,:,ixyz))
|
||||
do ixyz = 1, ncart
|
||||
call AOtoMO(nBas, nOrb, c, dipole_int_AO(1,1,ixyz), dipole_int_MO(1,1,ixyz))
|
||||
end do
|
||||
call AOtoMO_ERI_RHF(nBas,c,ERI_AO,ERI_MO)
|
||||
call AOtoMO_ERI_RHF(nBas, nOrb, c, ERI_AO, ERI_MO)
|
||||
call wall_time(end_AOtoMO)
|
||||
|
||||
t_AOtoMO = end_AOtoMO - start_AOtoMO
|
||||
write(*,'(A65,1X,F9.3,A8)') 'Total CPU time for AO to MO transformation = ',t_AOtoMO,' seconds'
|
||||
write(*,'(A65,1X,F9.3,A8)') 'Total wall time for AO to MO transformation = ',t_AOtoMO,' seconds'
|
||||
write(*,*)
|
||||
|
||||
!-------------------------------------------------------------!
|
||||
@ -124,12 +128,12 @@ subroutine RHF_search(maxSCF,thresh,max_diis,guess_type,level_shift,nNuc,ZNuc,rN
|
||||
|
||||
ispin = 1
|
||||
|
||||
call phLR_A(ispin,.false.,nBas,nC,nO,nV,nR,nS,1d0,e,ERI_MO,Aph)
|
||||
call phLR_B(ispin,.false.,nBas,nC,nO,nV,nR,nS,1d0,ERI_MO,Bph)
|
||||
call phLR_A(ispin,.false.,nOrb,nC,nO,nV,nR,nS,1d0,e,ERI_MO,Aph)
|
||||
call phLR_B(ispin,.false.,nOrb,nC,nO,nV,nR,nS,1d0,ERI_MO,Bph)
|
||||
|
||||
AB(:,:) = Aph(:,:) + Bph(:,:)
|
||||
|
||||
call diagonalize_matrix(nS,AB,Om)
|
||||
call diagonalize_matrix(nS, AB, Om)
|
||||
Om(:) = 2d0*Om(:)
|
||||
|
||||
write(*,*)'-------------------------------------------------------------'
|
||||
@ -156,6 +160,7 @@ subroutine RHF_search(maxSCF,thresh,max_diis,guess_type,level_shift,nNuc,ZNuc,rN
|
||||
if(eig < 0 .or. eig > nS) then
|
||||
write(*,'(1X,A40,1X,A10)') 'Invalid option...','Stop...'
|
||||
write(*,*)
|
||||
deallocate(Aph, Bph, AB, Om, R, ExpR)
|
||||
stop
|
||||
end if
|
||||
|
||||
@ -164,15 +169,15 @@ subroutine RHF_search(maxSCF,thresh,max_diis,guess_type,level_shift,nNuc,ZNuc,rN
|
||||
R(:,:) = 0d0
|
||||
ia = 0
|
||||
do i=nC+1,nO
|
||||
do a=nO+1,nBas-nR
|
||||
do a=nO+1,nOrb-nR
|
||||
ia = ia + 1
|
||||
R(a,i) = +AB(ia,eig)
|
||||
R(i,a) = -AB(ia,eig)
|
||||
end do
|
||||
end do
|
||||
|
||||
call matrix_exponential(nBas,R,ExpR)
|
||||
c = matmul(c,ExpR)
|
||||
call matrix_exponential(nOrb, R, ExpR)
|
||||
c = matmul(c, ExpR)
|
||||
|
||||
else
|
||||
|
||||
@ -191,4 +196,6 @@ subroutine RHF_search(maxSCF,thresh,max_diis,guess_type,level_shift,nNuc,ZNuc,rN
|
||||
!---------------!
|
||||
end do
|
||||
|
||||
deallocate(Aph, Bph, AB, Om, R, ExpR)
|
||||
|
||||
end subroutine
|
||||
|
||||
@ -30,7 +30,7 @@ subroutine RHF_stability(nBas,nC,nO,nV,nR,nS,eHF,ERI)
|
||||
|
||||
! Memory allocation
|
||||
|
||||
allocate(A(nS,nS),B(nS,nS),AB(nS,nS),Om(nS))
|
||||
allocate(A(nS,nS), B(nS,nS), AB(nS,nS), Om(nS))
|
||||
|
||||
!-------------------------------------------------------------!
|
||||
! Stability analysis: Real RHF -> Real RHF
|
||||
@ -148,5 +148,7 @@ subroutine RHF_stability(nBas,nC,nO,nV,nR,nS,eHF,ERI)
|
||||
end if
|
||||
write(*,*)'-------------------------------------------------------------'
|
||||
write(*,*)
|
||||
|
||||
deallocate(A, B, AB, Om)
|
||||
|
||||
end subroutine
|
||||
|
||||
@ -190,6 +190,6 @@ subroutine RMOM(maxSCF,thresh,max_diis,nBas,nO,S,T,V,Hc,ERI,X,ENuc,ERHF,c,e,P)
|
||||
EK = 0.5d0*trace_matrix(nBas,matmul(P,K))
|
||||
ERHF = ET + EV + EJ + EK
|
||||
|
||||
call print_RHF(nBas,nO,e,c,ENuc,ET,EV,EJ,EK,ERHF)
|
||||
call print_RHF(nBas,nBas,nO,e,c,ENuc,ET,EV,EJ,EK,ERHF)
|
||||
|
||||
end subroutine
|
||||
|
||||
@ -1,5 +1,8 @@
|
||||
subroutine ROHF(dotest,maxSCF,thresh,max_diis,guess_type,mix,level_shift,nNuc,ZNuc,rNuc,ENuc, &
|
||||
nBas,nO,S,T,V,Hc,ERI,dipole_int,X,EROHF,eHF,c,Ptot)
|
||||
|
||||
! ---
|
||||
|
||||
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)
|
||||
|
||||
! Perform restricted open-shell Hartree-Fock calculation
|
||||
|
||||
@ -16,7 +19,7 @@ subroutine ROHF(dotest,maxSCF,thresh,max_diis,guess_type,mix,level_shift,nNuc,ZN
|
||||
double precision,intent(in) :: mix
|
||||
double precision,intent(in) :: level_shift
|
||||
double precision,intent(in) :: thresh
|
||||
integer,intent(in) :: nBas
|
||||
integer,intent(in) :: nBas, nOrb
|
||||
|
||||
integer,intent(in) :: nNuc
|
||||
double precision,intent(in) :: ZNuc(nNuc)
|
||||
@ -28,14 +31,14 @@ subroutine ROHF(dotest,maxSCF,thresh,max_diis,guess_type,mix,level_shift,nNuc,ZN
|
||||
double precision,intent(in) :: T(nBas,nBas)
|
||||
double precision,intent(in) :: V(nBas,nBas)
|
||||
double precision,intent(in) :: Hc(nBas,nBas)
|
||||
double precision,intent(in) :: X(nBas,nBas)
|
||||
double precision,intent(in) :: X(nBas,nOrb)
|
||||
double precision,intent(in) :: ERI(nBas,nBas,nBas,nBas)
|
||||
double precision,intent(in) :: dipole_int(nBas,nBas,ncart)
|
||||
|
||||
! Local variables
|
||||
|
||||
integer :: nSCF
|
||||
integer :: nBasSq
|
||||
integer :: nBas_Sq
|
||||
integer :: n_diis
|
||||
double precision :: Conv
|
||||
double precision :: rcond
|
||||
@ -62,8 +65,8 @@ subroutine ROHF(dotest,maxSCF,thresh,max_diis,guess_type,mix,level_shift,nNuc,ZN
|
||||
! Output variables
|
||||
|
||||
double precision,intent(out) :: EROHF
|
||||
double precision,intent(out) :: eHF(nBas)
|
||||
double precision,intent(inout):: c(nBas,nBas)
|
||||
double precision,intent(out) :: eHF(nOrb)
|
||||
double precision,intent(inout):: c(nBas,nOrb)
|
||||
double precision,intent(out) :: Ptot(nBas,nBas)
|
||||
|
||||
! Hello world
|
||||
@ -76,19 +79,30 @@ subroutine ROHF(dotest,maxSCF,thresh,max_diis,guess_type,mix,level_shift,nNuc,ZN
|
||||
|
||||
! Useful stuff
|
||||
|
||||
nBasSq = nBas*nBas
|
||||
nBas_Sq = nBas*nBas
|
||||
|
||||
! Memory allocation
|
||||
|
||||
allocate(J(nBas,nBas,nspin),F(nBas,nBas,nspin),Fp(nBas,nBas),Ftot(nBas,nBas), &
|
||||
P(nBas,nBas,nspin),K(nBas,nBas,nspin),err(nBas,nBas),cp(nBas,nBas), &
|
||||
err_diis(nBasSq,max_diis),F_diis(nBasSq,max_diis))
|
||||
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))
|
||||
|
||||
allocate(Fp(nOrb,nOrb))
|
||||
allocate(cp(nOrb,nOrb))
|
||||
|
||||
allocate(err_diis(nBas_Sq,max_diis))
|
||||
allocate(F_diis(nBas_Sq,max_diis))
|
||||
|
||||
! Guess coefficients and demsity matrices
|
||||
|
||||
call mo_guess(nBas,guess_type,S,Hc,X,c)
|
||||
do ispin=1,nspin
|
||||
P(:,:,ispin) = matmul(c(:,1:nO(ispin)),transpose(c(:,1:nO(ispin))))
|
||||
call mo_guess(nBas, nOrb, guess_type, S, Hc, X, c)
|
||||
|
||||
do ispin = 1, nspin
|
||||
!P(:,:,ispin) = matmul(c(:,1:nO(ispin)), transpose(c(:,1:nO(ispin))))
|
||||
call dgemm('N', 'T', nBas, nBas, nO(ispin), 1.d0, c, nBas, c, nBas, 0.d0, P(1,1,ispin), nBas)
|
||||
end do
|
||||
Ptot(:,:) = P(:,:,1) + P(:,:,2)
|
||||
|
||||
@ -120,51 +134,51 @@ subroutine ROHF(dotest,maxSCF,thresh,max_diis,guess_type,mix,level_shift,nNuc,ZN
|
||||
|
||||
! Build Hartree repulsion
|
||||
|
||||
do ispin=1,nspin
|
||||
call Hartree_matrix_AO_basis(nBas,P(:,:,ispin),ERI(:,:,:,:),J(:,:,ispin))
|
||||
do ispin = 1, nspin
|
||||
call Hartree_matrix_AO_basis(nBas, P(:,:,ispin), ERI(:,:,:,:), J(:,:,ispin))
|
||||
end do
|
||||
|
||||
! Compute exchange potential
|
||||
|
||||
do ispin=1,nspin
|
||||
call exchange_matrix_AO_basis(nBas,P(:,:,ispin),ERI(:,:,:,:),K(:,:,ispin))
|
||||
do ispin = 1, nspin
|
||||
call exchange_matrix_AO_basis(nBas, P(:,:,ispin), ERI(:,:,:,:), K(:,:,ispin))
|
||||
end do
|
||||
|
||||
! Build Fock operator
|
||||
|
||||
do ispin=1,nspin
|
||||
do ispin = 1, nspin
|
||||
F(:,:,ispin) = Hc(:,:) + J(:,:,ispin) + J(:,:,mod(ispin,2)+1) + K(:,:,ispin)
|
||||
end do
|
||||
|
||||
call ROHF_fock_matrix(nBas,nO(1),nO(2),S,c,F(:,:,1),F(:,:,2),Ftot)
|
||||
call ROHF_fock_matrix(nBas, nOrb, nO(1), nO(2), S, c, F(:,:,1), F(:,:,2), Ftot)
|
||||
|
||||
! Check convergence
|
||||
|
||||
err(:,:) = matmul(Ftot,matmul(Ptot,S)) - matmul(matmul(S,Ptot),Ftot)
|
||||
err(:,:) = matmul(Ftot, matmul(Ptot, S)) - matmul(matmul(S, Ptot), Ftot)
|
||||
if(nSCF > 1) Conv = maxval(abs(err(:,:)))
|
||||
|
||||
! Kinetic energy
|
||||
|
||||
do ispin=1,nspin
|
||||
ET(ispin) = trace_matrix(nBas,matmul(P(:,:,ispin),T(:,:)))
|
||||
do ispin = 1, nspin
|
||||
ET(ispin) = trace_matrix(nBas, matmul(P(:,:,ispin), T(:,:)))
|
||||
end do
|
||||
|
||||
! Potential energy
|
||||
|
||||
do ispin=1,nspin
|
||||
EV(ispin) = trace_matrix(nBas,matmul(P(:,:,ispin),V(:,:)))
|
||||
do ispin = 1, nspin
|
||||
EV(ispin) = trace_matrix(nBas, matmul(P(:,:,ispin), V(:,:)))
|
||||
end do
|
||||
|
||||
! Hartree energy
|
||||
|
||||
EJ(1) = 0.5d0*trace_matrix(nBas,matmul(P(:,:,1),J(:,:,1)))
|
||||
EJ(2) = trace_matrix(nBas,matmul(P(:,:,1),J(:,:,2)))
|
||||
EJ(3) = 0.5d0*trace_matrix(nBas,matmul(P(:,:,2),J(:,:,2)))
|
||||
EJ(1) = 0.5d0*trace_matrix(nBas, matmul(P(:,:,1), J(:,:,1)))
|
||||
EJ(2) = trace_matrix(nBas, matmul(P(:,:,1), J(:,:,2)))
|
||||
EJ(3) = 0.5d0*trace_matrix(nBas, matmul(P(:,:,2), J(:,:,2)))
|
||||
|
||||
! Exchange energy
|
||||
|
||||
do ispin=1,nspin
|
||||
EK(ispin) = 0.5d0*trace_matrix(nBas,matmul(P(:,:,ispin),K(:,:,ispin)))
|
||||
do ispin = 1, nspin
|
||||
EK(ispin) = 0.5d0*trace_matrix(nBas, matmul(P(:,:,ispin), K(:,:,ispin)))
|
||||
end do
|
||||
|
||||
! Total energy
|
||||
@ -176,7 +190,7 @@ subroutine ROHF(dotest,maxSCF,thresh,max_diis,guess_type,mix,level_shift,nNuc,ZN
|
||||
if(max_diis > 1) then
|
||||
|
||||
n_diis = min(n_diis+1,max_diis)
|
||||
call DIIS_extrapolation(rcond,nBasSq,nBasSq,n_diis,err_diis,F_diis,err,Ftot)
|
||||
call DIIS_extrapolation(rcond,nBas_Sq,nBas_Sq,n_diis,err_diis,F_diis,err,Ftot)
|
||||
|
||||
end if
|
||||
|
||||
@ -185,28 +199,29 @@ subroutine ROHF(dotest,maxSCF,thresh,max_diis,guess_type,mix,level_shift,nNuc,ZN
|
||||
if(level_shift > 0d0 .and. Conv > thresh) then
|
||||
|
||||
do ispin=1,nspin
|
||||
call level_shifting(level_shift,nBas,maxval(nO),S,c,Ftot)
|
||||
call level_shifting(level_shift, nBas, nOrb, maxval(nO), S, c, Ftot)
|
||||
end do
|
||||
|
||||
end if
|
||||
|
||||
! Transform Fock matrix in orthogonal basis
|
||||
|
||||
Fp(:,:) = matmul(transpose(X(:,:)),matmul(Ftot(:,:),X(:,:)))
|
||||
Fp(:,:) = matmul(transpose(X(:,:)), matmul(Ftot(:,:), X(:,:)))
|
||||
|
||||
! Diagonalize Fock matrix to get eigenvectors and eigenvalues
|
||||
|
||||
cp(:,:) = Fp(:,:)
|
||||
call diagonalize_matrix(nBas,cp,eHF)
|
||||
call diagonalize_matrix(nOrb, cp, eHF)
|
||||
|
||||
! Back-transform eigenvectors in non-orthogonal basis
|
||||
|
||||
c(:,:) = matmul(X(:,:),cp(:,:))
|
||||
c(:,:) = matmul(X(:,:), cp(:,:))
|
||||
|
||||
! Compute density matrix
|
||||
|
||||
do ispin=1,nspin
|
||||
P(:,:,ispin) = matmul(c(:,1:nO(ispin)),transpose(c(:,1:nO(ispin))))
|
||||
do ispin = 1, nspin
|
||||
!P(:,:,ispin) = matmul(c(:,1:nO(ispin)), transpose(c(:,1:nO(ispin))))
|
||||
call dgemm('N', 'T', nBas, nBas, nO(ispin), 1.d0, c, nBas, c, nBas, 0.d0, P(1,1,ispin), nBas)
|
||||
end do
|
||||
Ptot(:,:) = P(:,:,1) + P(:,:,2)
|
||||
|
||||
@ -231,6 +246,8 @@ subroutine ROHF(dotest,maxSCF,thresh,max_diis,guess_type,mix,level_shift,nNuc,ZN
|
||||
write(*,*)'!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!'
|
||||
write(*,*)
|
||||
|
||||
deallocate(J, K, F, Ftot, P, err, Fp, cp, err_diis, F_diis)
|
||||
|
||||
stop
|
||||
|
||||
end if
|
||||
@ -238,7 +255,7 @@ subroutine ROHF(dotest,maxSCF,thresh,max_diis,guess_type,mix,level_shift,nNuc,ZN
|
||||
! Compute final UHF energy
|
||||
|
||||
call dipole_moment(nBas,Ptot,nNuc,ZNuc,rNuc,dipole_int,dipole)
|
||||
call print_ROHF(nBas,nO,eHF,c,ENuc,ET,EV,EJ,EK,EROHF,dipole)
|
||||
call print_ROHF(nBas, nOrb, nO, eHF, c, ENuc, ET, EV, EJ, EK, EROHF, dipole)
|
||||
|
||||
! Print test values
|
||||
|
||||
@ -248,4 +265,6 @@ subroutine ROHF(dotest,maxSCF,thresh,max_diis,guess_type,mix,level_shift,nNuc,ZN
|
||||
|
||||
end if
|
||||
|
||||
deallocate(J, K, F, Ftot, P, err, Fp, cp, err_diis, F_diis)
|
||||
|
||||
end subroutine
|
||||
|
||||
@ -1,4 +1,7 @@
|
||||
subroutine ROHF_fock_matrix(nBas,nOa,nOb,S,c,FaAO,FbAO,FAO)
|
||||
|
||||
! ---
|
||||
|
||||
subroutine ROHF_fock_matrix(nBas, nOrb, nOa, nOb, S, c, FaAO, FbAO, FAO)
|
||||
|
||||
! Construct the ROHF Fock matrix in the AO basis
|
||||
! For open shells, the ROHF Fock matrix in the MO basis reads
|
||||
@ -17,12 +20,12 @@ subroutine ROHF_fock_matrix(nBas,nOa,nOb,S,c,FaAO,FbAO,FAO)
|
||||
|
||||
! Input variables
|
||||
|
||||
integer,intent(in) :: nBas
|
||||
integer,intent(in) :: nBas, nOrb
|
||||
integer,intent(in) :: nOa
|
||||
integer,intent(in) :: nOb
|
||||
|
||||
double precision,intent(in) :: S(nBas,nBas)
|
||||
double precision,intent(in) :: c(nBas,nBas)
|
||||
double precision,intent(in) :: c(nBas,nOrb)
|
||||
double precision,intent(inout):: FaAO(nBas,nBas)
|
||||
double precision,intent(inout):: FbAO(nBas,nBas)
|
||||
|
||||
@ -46,7 +49,7 @@ subroutine ROHF_fock_matrix(nBas,nOa,nOb,S,c,FaAO,FbAO,FAO)
|
||||
|
||||
! Memory allocation
|
||||
|
||||
allocate(F(nBas,nBas),Fa(nBas,nBas),Fb(nBas,nBas))
|
||||
allocate(F(nOrb,nOrb), Fa(nOrb,nOrb), Fb(nOrb,nOrb))
|
||||
|
||||
! Roothan canonicalization parameters
|
||||
|
||||
@ -61,14 +64,14 @@ subroutine ROHF_fock_matrix(nBas,nOa,nOb,S,c,FaAO,FbAO,FAO)
|
||||
|
||||
! Number of closed, open, and virtual orbitals
|
||||
|
||||
nC = min(nOa,nOb)
|
||||
nC = min(nOa, nOb)
|
||||
nO = abs(nOa - nOb)
|
||||
nV = nBas - nC - nO
|
||||
|
||||
! Block-by-block Fock matrix
|
||||
|
||||
call AOtoMO(nBas,c,FaAO,Fa)
|
||||
call AOtoMO(nBas,c,FbAO,Fb)
|
||||
call AOtoMO(nBas, nOrb, c, FaAO, Fa)
|
||||
call AOtoMO(nBas, nOrb, c, FbAO, Fb)
|
||||
|
||||
F(1:nC, 1:nC ) = aC*Fa(1:nC, 1:nC ) + bC*Fb(1:nC, 1:nC )
|
||||
F(1:nC, nC+1:nC+nO ) = Fb(1:nC, nC+1:nC+nO )
|
||||
@ -82,8 +85,10 @@ subroutine ROHF_fock_matrix(nBas,nOa,nOb,S,c,FaAO,FbAO,FAO)
|
||||
F(nO+nC+1:nC+nO+nV, nC+1:nC+nO ) = Fa(nO+nC+1:nC+nO+nV, nC+1:nC+nO )
|
||||
F(nO+nC+1:nC+nO+nV,nO+nC+1:nC+nO+nV) = aV*Fa(nO+nC+1:nC+nO+nV,nO+nC+1:nC+nO+nV) + bV*Fb(nO+nC+1:nC+nO+nV,nO+nC+1:nC+nO+nV)
|
||||
|
||||
call MOtoAO(nBas,S,c,F,FAO)
|
||||
call MOtoAO(nBas,S,c,Fa,FaAO)
|
||||
call MOtoAO(nBas,S,c,Fb,FbAO)
|
||||
call MOtoAO(nBas, nOrb, S, c, F, FAO)
|
||||
call MOtoAO(nBas, nOrb, S, c, Fa, FaAO)
|
||||
call MOtoAO(nBas, nOrb, S, c, Fb, FbAO)
|
||||
|
||||
deallocate(F, Fa, Fb)
|
||||
|
||||
end subroutine
|
||||
|
||||
@ -85,7 +85,7 @@ subroutine UHF(dotest,maxSCF,thresh,max_diis,guess_type,mix,level_shift,nNuc,ZNu
|
||||
! Guess coefficients and demsity matrices
|
||||
|
||||
do ispin=1,nspin
|
||||
call mo_guess(nBas,guess_type,S,Hc,X,c(:,:,ispin))
|
||||
call mo_guess(nBas,nBas,guess_type,S,Hc,X,c(:,:,ispin))
|
||||
P(:,:,ispin) = matmul(c(:,1:nO(ispin),ispin),transpose(c(:,1:nO(ispin),ispin)))
|
||||
end do
|
||||
|
||||
@ -186,7 +186,7 @@ subroutine UHF(dotest,maxSCF,thresh,max_diis,guess_type,mix,level_shift,nNuc,ZNu
|
||||
if(level_shift > 0d0 .and. Conv > thresh) then
|
||||
|
||||
do ispin=1,nspin
|
||||
call level_shifting(level_shift,nBas,nO(ispin),S,c(:,:,ispin),F(:,:,ispin))
|
||||
call level_shifting(level_shift,nBas,nBas,nO(ispin),S,c(:,:,ispin),F(:,:,ispin))
|
||||
end do
|
||||
|
||||
end if
|
||||
|
||||
@ -124,8 +124,8 @@ subroutine UHF_search(maxSCF,thresh,max_diis,guess_type,mix,level_shift,nNuc,ZNu
|
||||
! Transform dipole-related integrals
|
||||
|
||||
do ixyz=1,ncart
|
||||
call AOtoMO(nBas,c(:,:,1),dipole_int_AO(:,:,ixyz),dipole_int_aa(:,:,ixyz))
|
||||
call AOtoMO(nBas,c(:,:,2),dipole_int_AO(:,:,ixyz),dipole_int_bb(:,:,ixyz))
|
||||
call AOtoMO(nBas,nBas,c(:,:,1),dipole_int_AO(:,:,ixyz),dipole_int_aa(:,:,ixyz))
|
||||
call AOtoMO(nBas,nBas,c(:,:,2),dipole_int_AO(:,:,ixyz),dipole_int_bb(:,:,ixyz))
|
||||
end do
|
||||
|
||||
! 4-index transform for (aa|aa) block
|
||||
|
||||
@ -94,7 +94,7 @@ subroutine cRHF(dotest,maxSCF,thresh,max_diis,guess_type,level_shift,nNuc,ZNuc,r
|
||||
|
||||
! Guess coefficients and density matrix
|
||||
|
||||
call mo_guess(nBas,guess_type,S,Hc,X,c)
|
||||
call mo_guess(nBas,nBas,guess_type,S,Hc,X,c)
|
||||
P(:,:) = 2d0*matmul(c(:,1:nO),transpose(c(:,1:nO)))
|
||||
|
||||
! Initialization
|
||||
@ -166,7 +166,7 @@ subroutine cRHF(dotest,maxSCF,thresh,max_diis,guess_type,level_shift,nNuc,ZNuc,r
|
||||
|
||||
! Level shift
|
||||
|
||||
if(level_shift > 0d0 .and. Conv > thresh) call level_shifting(level_shift,nBas,nO,S,c,F)
|
||||
if(level_shift > 0d0 .and. Conv > thresh) call level_shifting(level_shift,nBas,nBas,nO,S,c,F)
|
||||
|
||||
! Diagonalize Fock matrix
|
||||
|
||||
@ -207,7 +207,7 @@ subroutine cRHF(dotest,maxSCF,thresh,max_diis,guess_type,level_shift,nNuc,ZNuc,r
|
||||
! Compute dipole moments
|
||||
|
||||
call dipole_moment(nBas,P,nNuc,ZNuc,rNuc,dipole_int,dipole)
|
||||
call print_RHF(nBas,nO,eHF,C,ENuc,ET,EV,EJ,EK,ERHF,dipole)
|
||||
call print_RHF(nBas,nBas,nO,eHF,C,ENuc,ET,EV,EJ,EK,ERHF,dipole)
|
||||
|
||||
! Testing zone
|
||||
|
||||
|
||||
@ -1,4 +1,4 @@
|
||||
subroutine core_guess(nBas,Hc,X,c)
|
||||
subroutine core_guess(nBas, nOrb, Hc, X, c)
|
||||
|
||||
! Core guess of the molecular orbitals for HF calculation
|
||||
|
||||
@ -6,9 +6,9 @@ subroutine core_guess(nBas,Hc,X,c)
|
||||
|
||||
! Input variables
|
||||
|
||||
integer,intent(in) :: nBas
|
||||
integer,intent(in) :: nBas, nOrb
|
||||
double precision,intent(in) :: Hc(nBas,nBas)
|
||||
double precision,intent(in) :: X(nBas,nBas)
|
||||
double precision,intent(in) :: X(nBas,nOrb)
|
||||
|
||||
! Local variables
|
||||
|
||||
@ -18,16 +18,19 @@ subroutine core_guess(nBas,Hc,X,c)
|
||||
|
||||
! Output variables
|
||||
|
||||
double precision,intent(out) :: c(nBas,nBas)
|
||||
double precision,intent(out) :: c(nBas,nOrb)
|
||||
|
||||
! Memory allocation
|
||||
|
||||
allocate(cp(nBas,nBas),e(nBas))
|
||||
allocate(cp(nOrb,nOrb), e(nOrb))
|
||||
|
||||
! Core guess
|
||||
|
||||
cp(:,:) = matmul(transpose(X(:,:)),matmul(Hc(:,:),X(:,:)))
|
||||
call diagonalize_matrix(nBas,cp,e)
|
||||
c(:,:) = matmul(X(:,:),cp(:,:))
|
||||
cp(:,:) = matmul(transpose(X(:,:)), matmul(Hc(:,:), X(:,:)))
|
||||
|
||||
call diagonalize_matrix(nOrb, cp, e)
|
||||
c(:,:) = matmul(X(:,:), cp(:,:))
|
||||
|
||||
deallocate(cp, e)
|
||||
|
||||
end subroutine
|
||||
|
||||
@ -1,4 +1,4 @@
|
||||
subroutine huckel_guess(nBas,S,Hc,X,c)
|
||||
subroutine huckel_guess(nBas, nOrb, S, Hc, X, c)
|
||||
|
||||
! Hickel guess
|
||||
|
||||
@ -6,10 +6,10 @@ subroutine huckel_guess(nBas,S,Hc,X,c)
|
||||
|
||||
! Input variables
|
||||
|
||||
integer,intent(in) :: nBas
|
||||
integer,intent(in) :: nBas, nOrb
|
||||
double precision,intent(in) :: S(nBas,nBas)
|
||||
double precision,intent(in) :: Hc(nBas,nBas)
|
||||
double precision,intent(in) :: X(nBas,nBas)
|
||||
double precision,intent(in) :: X(nBas,nOrb)
|
||||
|
||||
! Local variables
|
||||
|
||||
@ -20,7 +20,7 @@ subroutine huckel_guess(nBas,S,Hc,X,c)
|
||||
|
||||
! Output variables
|
||||
|
||||
double precision,intent(out) :: c(nBas,nBas)
|
||||
double precision,intent(out) :: c(nBas,nOrb)
|
||||
|
||||
! Memory allocation
|
||||
|
||||
@ -32,9 +32,9 @@ subroutine huckel_guess(nBas,S,Hc,X,c)
|
||||
|
||||
! GWH approximation
|
||||
|
||||
do mu=1,nBas
|
||||
do mu = 1, nBas
|
||||
F(mu,mu) = Hc(mu,mu)
|
||||
do nu=mu+1,nBas
|
||||
do nu = mu+1, nBas
|
||||
|
||||
F(mu,nu) = 0.5d0*a*S(mu,nu)*(Hc(mu,mu) + Hc(nu,nu))
|
||||
F(nu,mu) = F(mu,nu)
|
||||
@ -42,6 +42,8 @@ subroutine huckel_guess(nBas,S,Hc,X,c)
|
||||
end do
|
||||
end do
|
||||
|
||||
call core_guess(nBas,F,X,c)
|
||||
call core_guess(nBas, nOrb, F, X, c)
|
||||
|
||||
deallocate(F)
|
||||
|
||||
end subroutine
|
||||
|
||||
@ -1,4 +1,7 @@
|
||||
subroutine mo_guess(nBas,guess_type,S,Hc,X,c)
|
||||
|
||||
! ---
|
||||
|
||||
subroutine mo_guess(nBas, nOrb, guess_type, S, Hc, X, c)
|
||||
|
||||
! Guess of the molecular orbitals for HF calculation
|
||||
|
||||
@ -6,15 +9,15 @@ subroutine mo_guess(nBas,guess_type,S,Hc,X,c)
|
||||
|
||||
! Input variables
|
||||
|
||||
integer,intent(in) :: nBas
|
||||
integer,intent(in) :: nBas, nOrb
|
||||
integer,intent(in) :: guess_type
|
||||
double precision,intent(in) :: S(nBas,nBas)
|
||||
double precision,intent(in) :: Hc(nBas,nBas)
|
||||
double precision,intent(in) :: X(nBas,nBas)
|
||||
double precision,intent(in) :: X(nBas,nOrb)
|
||||
|
||||
! Output variables
|
||||
|
||||
double precision,intent(inout) :: c(nBas,nBas)
|
||||
double precision,intent(inout) :: c(nBas,nOrb)
|
||||
|
||||
if(guess_type == 0) then
|
||||
|
||||
@ -24,12 +27,12 @@ subroutine mo_guess(nBas,guess_type,S,Hc,X,c)
|
||||
elseif(guess_type == 1) then
|
||||
|
||||
write(*,*) 'Core guess...'
|
||||
call core_guess(nBas,Hc,X,c)
|
||||
call core_guess(nBas, nOrb, Hc, X, c)
|
||||
|
||||
elseif(guess_type == 2) then
|
||||
|
||||
write(*,*) 'Huckel guess...'
|
||||
call huckel_guess(nBas,S,Hc,X,c)
|
||||
call huckel_guess(nBas, nOrb, S, Hc, X, c)
|
||||
|
||||
elseif(guess_type == 3) then
|
||||
|
||||
|
||||
@ -1,4 +1,7 @@
|
||||
subroutine print_RHF(nBas,nO,eHF,cHF,ENuc,ET,EV,EJ,EK,ERHF,dipole)
|
||||
|
||||
! ---
|
||||
|
||||
subroutine print_RHF(nBas, nOrb, nO, eHF, cHF, ENuc, ET, EV, EJ, EK, ERHF, dipole)
|
||||
|
||||
! Print one-electron energies and other stuff for G0W0
|
||||
|
||||
@ -7,10 +10,10 @@ subroutine print_RHF(nBas,nO,eHF,cHF,ENuc,ET,EV,EJ,EK,ERHF,dipole)
|
||||
|
||||
! Input variables
|
||||
|
||||
integer,intent(in) :: nBas
|
||||
integer,intent(in) :: nBas, nOrb
|
||||
integer,intent(in) :: nO
|
||||
double precision,intent(in) :: eHF(nBas)
|
||||
double precision,intent(in) :: cHF(nBas,nBas)
|
||||
double precision,intent(in) :: eHF(nOrb)
|
||||
double precision,intent(in) :: cHF(nBas,nOrb)
|
||||
double precision,intent(in) :: ENuc
|
||||
double precision,intent(in) :: ET
|
||||
double precision,intent(in) :: EV
|
||||
@ -75,13 +78,13 @@ subroutine print_RHF(nBas,nO,eHF,cHF,ENuc,ET,EV,EJ,EK,ERHF,dipole)
|
||||
write(*,'(A50)') '---------------------------------------'
|
||||
write(*,'(A50)') ' RHF orbital coefficients '
|
||||
write(*,'(A50)') '---------------------------------------'
|
||||
call matout(nBas,nBas,cHF)
|
||||
call matout(nBas, nOrb, cHF)
|
||||
write(*,*)
|
||||
end if
|
||||
write(*,'(A50)') '---------------------------------------'
|
||||
write(*,'(A50)') ' RHF orbital energies (au) '
|
||||
write(*,'(A50)') '---------------------------------------'
|
||||
call vecout(nBas,eHF)
|
||||
call vecout(nOrb, eHF)
|
||||
write(*,*)
|
||||
|
||||
end subroutine
|
||||
|
||||
@ -1,14 +1,17 @@
|
||||
subroutine print_ROHF(nBas,nO,eHF,c,ENuc,ET,EV,EJ,Ex,EROHF,dipole)
|
||||
|
||||
! ---
|
||||
|
||||
subroutine print_ROHF(nBas, nOrb, nO, eHF, c, ENuc, ET, EV, EJ, Ex, EROHF, dipole)
|
||||
|
||||
! Print one- and two-electron energies and other stuff for RoHF calculation
|
||||
|
||||
implicit none
|
||||
include 'parameters.h'
|
||||
|
||||
integer,intent(in) :: nBas
|
||||
integer,intent(in) :: nBas, nOrb
|
||||
integer,intent(in) :: nO(nspin)
|
||||
double precision,intent(in) :: eHF(nBas)
|
||||
double precision,intent(in) :: c(nBas,nBas)
|
||||
double precision,intent(in) :: eHF(nOrb)
|
||||
double precision,intent(in) :: c(nBas,nOrb)
|
||||
double precision,intent(in) :: ENuc
|
||||
double precision,intent(in) :: ET(nspin)
|
||||
double precision,intent(in) :: EV(nspin)
|
||||
@ -31,7 +34,7 @@ subroutine print_ROHF(nBas,nO,eHF,c,ENuc,ET,EV,EJ,Ex,EROHF,dipole)
|
||||
do ispin=1,nspin
|
||||
if(nO(ispin) > 0) then
|
||||
HOMO(ispin) = eHF(nO(ispin))
|
||||
if(nO(ispin) < nBas) then
|
||||
if(nO(ispin) < nOrb) then
|
||||
LUMO(ispin) = eHF(nO(ispin)+1)
|
||||
else
|
||||
LUMO(ispin) = 0d0
|
||||
@ -102,13 +105,13 @@ subroutine print_ROHF(nBas,nO,eHF,c,ENuc,ET,EV,EJ,Ex,EROHF,dipole)
|
||||
write(*,'(A50)') '-----------------------------------------'
|
||||
write(*,'(A50)') 'ROHF orbital coefficients '
|
||||
write(*,'(A50)') '-----------------------------------------'
|
||||
call matout(nBas,nBas,c)
|
||||
call matout(nBas, nOrb, c)
|
||||
write(*,*)
|
||||
end if
|
||||
write(*,'(A50)') '---------------------------------------'
|
||||
write(*,'(A50)') ' ROHF orbital energies (au) '
|
||||
write(*,'(A50)') '---------------------------------------'
|
||||
call vecout(nBas,eHF)
|
||||
call vecout(nOrb, eHF)
|
||||
write(*,*)
|
||||
|
||||
end subroutine
|
||||
|
||||
143
src/LR/ppLR.f90
143
src/LR/ppLR.f90
@ -1,93 +1,128 @@
|
||||
subroutine ppLR(TDA,nOO,nVV,Bpp,Cpp,Dpp,Om1,X1,Y1,Om2,X2,Y2,EcRPA)
|
||||
|
||||
! Solve the pp-RPA linear eigenvalue problem
|
||||
! ---
|
||||
|
||||
subroutine ppLR(TDA, nOO, nVV, Bpp, Cpp, Dpp, Om1, X1, Y1, Om2, X2, Y2, EcRPA)
|
||||
|
||||
!
|
||||
! Solve the pp-RPA linear eigenvalue problem
|
||||
!
|
||||
! right eigen-problem: H R = R w
|
||||
! left eigen-problem: H.T L = L w
|
||||
!
|
||||
! where L.T R = 1
|
||||
!
|
||||
!
|
||||
! (+C +B)
|
||||
! H = ( ) where C = C.T and D = D.T
|
||||
! (-B.T -D)
|
||||
!
|
||||
! (w1 0) (X1 X2) (+X1 +X2)
|
||||
! w = ( ), R = ( ) and L = ( )
|
||||
! (0 w2) (Y1 Y2) (-Y1 -Y2)
|
||||
!
|
||||
!
|
||||
! the normalisation condition reduces to
|
||||
!
|
||||
! X1.T X2 - Y1.T Y2 = 0
|
||||
! X1.T X1 - Y1.T Y1 = 1
|
||||
! X2.T X2 - Y2.T Y2 = 1
|
||||
!
|
||||
|
||||
implicit none
|
||||
include 'parameters.h'
|
||||
|
||||
! Input variables
|
||||
|
||||
logical,intent(in) :: TDA
|
||||
integer,intent(in) :: nOO
|
||||
integer,intent(in) :: nVV
|
||||
double precision,intent(in) :: Bpp(nVV,nOO)
|
||||
double precision,intent(in) :: Cpp(nVV,nVV)
|
||||
double precision,intent(in) :: Dpp(nOO,nOO)
|
||||
logical, intent(in) :: TDA
|
||||
integer, intent(in) :: nOO, nVV
|
||||
double precision, intent(in) :: Bpp(nVV,nOO), Cpp(nVV,nVV), Dpp(nOO,nOO)
|
||||
double precision, intent(out) :: Om1(nVV), X1(nVV,nVV), Y1(nOO,nVV)
|
||||
double precision, intent(out) :: Om2(nOO), X2(nVV,nOO), Y2(nOO,nOO)
|
||||
double precision, intent(out) :: EcRPA
|
||||
|
||||
! Local variables
|
||||
logical :: imp_bio, verbose
|
||||
integer :: i, j, N
|
||||
double precision :: EcRPA1, EcRPA2
|
||||
double precision :: thr_d, thr_nd, thr_deg
|
||||
double precision,allocatable :: M(:,:), Z(:,:), Om(:)
|
||||
|
||||
double precision :: trace_matrix
|
||||
double precision :: EcRPA1
|
||||
double precision :: EcRPA2
|
||||
double precision,allocatable :: M(:,:)
|
||||
double precision,allocatable :: Z(:,:)
|
||||
double precision,allocatable :: Om(:)
|
||||
double precision, external :: trace_matrix
|
||||
|
||||
! Output variables
|
||||
|
||||
double precision,intent(out) :: Om1(nVV)
|
||||
double precision,intent(out) :: X1(nVV,nVV)
|
||||
double precision,intent(out) :: Y1(nOO,nVV)
|
||||
double precision,intent(out) :: Om2(nOO)
|
||||
double precision,intent(out) :: X2(nVV,nOO)
|
||||
double precision,intent(out) :: Y2(nOO,nOO)
|
||||
double precision,intent(out) :: EcRPA
|
||||
|
||||
! Memory allocation
|
||||
N = nOO + nVV
|
||||
|
||||
allocate(M(nOO+nVV,nOO+nVV),Z(nOO+nVV,nOO+nVV),Om(nOO+nVV))
|
||||
|
||||
!-------------------------------------------------!
|
||||
! Solve the p-p eigenproblem !
|
||||
!-------------------------------------------------!
|
||||
! !
|
||||
! | C B | | X1 X2 | | w1 0 | | X1 X2 | !
|
||||
! | | | | = | | | | !
|
||||
! | -Bt -D | | Y1 Y2 | | 0 w2 | | Y1 Y2 | !
|
||||
! !
|
||||
!-------------------------------------------------!
|
||||
allocate(M(N,N), Z(N,N), Om(N))
|
||||
|
||||
if(TDA) then
|
||||
|
||||
X1(:,:) = +Cpp(:,:)
|
||||
Y1(:,:) = 0d0
|
||||
if(nVV > 0) call diagonalize_matrix(nVV,X1,Om1)
|
||||
if(nVV > 0) call diagonalize_matrix(nVV, X1, Om1)
|
||||
|
||||
X2(:,:) = 0d0
|
||||
Y2(:,:) = -Dpp(:,:)
|
||||
if(nOO > 0) call diagonalize_matrix(nOO,Y2,Om2)
|
||||
if(nOO > 0) call diagonalize_matrix(nOO, Y2, Om2)
|
||||
|
||||
else
|
||||
|
||||
! Diagonal blocks
|
||||
|
||||
! Diagonal blocks
|
||||
M( 1:nVV , 1:nVV) = + Cpp(1:nVV,1:nVV)
|
||||
M(nVV+1:nVV+nOO,nVV+1:nVV+nOO) = - Dpp(1:nOO,1:nOO)
|
||||
|
||||
! Off-diagonal blocks
|
||||
|
||||
! Off-diagonal blocks
|
||||
M( 1:nVV ,nVV+1:nOO+nVV) = - Bpp(1:nVV,1:nOO)
|
||||
M(nVV+1:nOO+nVV, 1:nVV) = + transpose(Bpp(1:nVV,1:nOO))
|
||||
|
||||
! call matout(nOO,nOO,Dpp)
|
||||
if((nOO .eq. 0) .or. (nVV .eq. 0)) then
|
||||
|
||||
! Diagonalize the p-p matrix
|
||||
! Diagonalize the p-p matrix
|
||||
if(nOO+nVV > 0) call diagonalize_general_matrix(nOO+nVV, M, Om, Z)
|
||||
! Split the various quantities in p-p and h-h parts
|
||||
call sort_ppRPA(nOO, nVV, Om, Z, Om1, X1, Y1, Om2, X2, Y2)
|
||||
|
||||
if(nOO+nVV > 0) call diagonalize_general_matrix(nOO+nVV,M,Om,Z)
|
||||
else
|
||||
|
||||
! Split the various quantities in p-p and h-h parts
|
||||
thr_d = 1d-6 ! to determine if diagonal elements of L.T x R are close enouph to 1
|
||||
thr_nd = 1d-6 ! to determine if non-diagonal elements of L.T x R are close enouph to 1
|
||||
thr_deg = 1d-8 ! to determine if two eigenvectors are degenerate or not
|
||||
imp_bio = .True. ! impose bi-orthogonality
|
||||
verbose = .False.
|
||||
call diagonalize_nonsym_matrix(N, M, Z, Om, thr_d, thr_nd, thr_deg, imp_bio, verbose)
|
||||
|
||||
do i = 1, nOO
|
||||
Om2(i) = Om(i)
|
||||
do j = 1, nVV
|
||||
X2(j,i) = Z(j,i)
|
||||
enddo
|
||||
do j = 1, nOO
|
||||
Y2(j,i) = Z(nVV+j,i)
|
||||
enddo
|
||||
enddo
|
||||
|
||||
do i = 1, nVV
|
||||
Om1(i) = Om(nOO+i)
|
||||
do j = 1, nVV
|
||||
X1(j,i) = M(j,nOO+i)
|
||||
enddo
|
||||
do j = 1, nOO
|
||||
Y1(j,i) = M(nVV+j,nOO+i)
|
||||
enddo
|
||||
enddo
|
||||
|
||||
call sort_ppRPA(nOO,nVV,Om,Z,Om1,X1,Y1,Om2,X2,Y2)
|
||||
endif
|
||||
|
||||
end if
|
||||
|
||||
! Compute the RPA correlation energy
|
||||
! Compute the RPA correlation energy
|
||||
EcRPA = 0.5d0 * (sum(Om1) - sum(Om2) - trace_matrix(nVV, Cpp) - trace_matrix(nOO, Dpp))
|
||||
EcRPA1 = +sum(Om1) - trace_matrix(nVV, Cpp)
|
||||
EcRPA2 = -sum(Om2) - trace_matrix(nOO, Dpp)
|
||||
|
||||
EcRPA = 0.5d0*( sum(Om1) - sum(Om2) - trace_matrix(nVV,Cpp) - trace_matrix(nOO,Dpp) )
|
||||
EcRPA1 = +sum(Om1) - trace_matrix(nVV,Cpp)
|
||||
EcRPA2 = -sum(Om2) - trace_matrix(nOO,Dpp)
|
||||
|
||||
if(abs(EcRPA - EcRPA1) > 1d-6 .or. abs(EcRPA - EcRPA2) > 1d-6) &
|
||||
if(abs(EcRPA - EcRPA1) > 1d-6 .or. abs(EcRPA - EcRPA2) > 1d-6) then
|
||||
print*,'!!! Issue in pp-RPA linear reponse calculation RPA1 != RPA2 !!!'
|
||||
endif
|
||||
|
||||
deallocate(M, Z, Om)
|
||||
|
||||
end subroutine
|
||||
|
||||
|
||||
|
||||
@ -23,6 +23,8 @@ subroutine ppLR_C(ispin,nBas,nC,nO,nV,nR,nVV,lambda,e,ERI,Cpp)
|
||||
double precision,external :: Kronecker_delta
|
||||
|
||||
integer :: a,b,c,d,ab,cd
|
||||
integer :: a0, aa
|
||||
double precision :: e_ab, tmp_ab, delta_ac, tmp_cd
|
||||
|
||||
! Output variables
|
||||
|
||||
@ -37,22 +39,70 @@ subroutine ppLR_C(ispin,nBas,nC,nO,nV,nR,nVV,lambda,e,ERI,Cpp)
|
||||
|
||||
if(ispin == 1) then
|
||||
|
||||
ab = 0
|
||||
do a=nO+1,nBas-nR
|
||||
do b=a,nBas-nR
|
||||
ab = ab + 1
|
||||
a0 = nBas - nR - nO
|
||||
|
||||
!$OMP PARALLEL DEFAULT(NONE) &
|
||||
!$OMP PRIVATE(a, b, aa, ab, c, d, cd, e_ab, tmp_ab, delta_ac, tmp_cd) &
|
||||
!$OMP SHARED(nO, nBas, nR, a0, eF, lambda, e, ERI, Cpp)
|
||||
!$OMP DO
|
||||
do a = nO+1, nBas-nR
|
||||
aa = a0 * (a - nO - 1) - (a - nO - 1) * (a - nO) / 2 - nO
|
||||
do b = a, nBas-nR
|
||||
ab = aa + b
|
||||
|
||||
e_ab = e(a) + e(b) - eF
|
||||
|
||||
tmp_ab = lambda
|
||||
if(a .eq. b) then
|
||||
tmp_ab = 0.7071067811865475d0 * lambda
|
||||
endif
|
||||
|
||||
cd = 0
|
||||
do c=nO+1,nBas-nR
|
||||
do d=c,nBas-nR
|
||||
do c = nO+1, nBas-nR
|
||||
|
||||
delta_ac = 0.d0
|
||||
if(a .eq. c) then
|
||||
delta_ac = 1.d0
|
||||
endif
|
||||
|
||||
do d = c, nBas-nR
|
||||
cd = cd + 1
|
||||
|
||||
tmp_cd = tmp_ab
|
||||
if(c .eq. d) then
|
||||
tmp_cd = 0.7071067811865475d0 * tmp_ab
|
||||
endif
|
||||
|
||||
Cpp(ab,cd) = 0.d0
|
||||
if(b .eq. d) then
|
||||
Cpp(ab,cd) = e_ab * delta_ac
|
||||
endif
|
||||
|
||||
Cpp(ab,cd) = + (e(a) + e(b) - eF)*Kronecker_delta(a,c)*Kronecker_delta(b,d) &
|
||||
+ lambda*(ERI(a,b,c,d) + ERI(a,b,d,c))/sqrt((1d0 + Kronecker_delta(a,b))*(1d0 + Kronecker_delta(c,d)))
|
||||
|
||||
end do
|
||||
end do
|
||||
end do
|
||||
end do
|
||||
Cpp(ab,cd) = Cpp(ab,cd) + tmp_cd * (ERI(a,b,c,d) + ERI(a,b,d,c))
|
||||
enddo
|
||||
enddo
|
||||
enddo
|
||||
enddo
|
||||
!$OMP END DO
|
||||
!$OMP END PARALLEL
|
||||
|
||||
|
||||
! ab = 0
|
||||
! do a=nO+1,nBas-nR
|
||||
! do b=a,nBas-nR
|
||||
! ab = ab + 1
|
||||
! cd = 0
|
||||
! do c=nO+1,nBas-nR
|
||||
! do d=c,nBas-nR
|
||||
! cd = cd + 1
|
||||
!
|
||||
! Cpp(ab,cd) = + (e(a) + e(b) - eF)*Kronecker_delta(a,c)*Kronecker_delta(b,d) &
|
||||
! + lambda*(ERI(a,b,c,d) + ERI(a,b,d,c))/sqrt((1d0 + Kronecker_delta(a,b))*(1d0 + Kronecker_delta(c,d)))
|
||||
!
|
||||
! end do
|
||||
! end do
|
||||
! end do
|
||||
! end do
|
||||
|
||||
end if
|
||||
|
||||
|
||||
@ -1,4 +1,4 @@
|
||||
subroutine RMP(dotest,doMP2,doMP3,regularize,nBas,nC,nO,nV,nR,ERI,ENuc,ERHF,eHF)
|
||||
subroutine RMP(dotest,doMP2,doMP3,regularize,nOrb,nC,nO,nV,nR,ERI,ENuc,ERHF,eHF)
|
||||
|
||||
! Moller-Plesset module
|
||||
|
||||
@ -13,15 +13,15 @@ subroutine RMP(dotest,doMP2,doMP3,regularize,nBas,nC,nO,nV,nR,ERI,ENuc,ERHF,eHF)
|
||||
logical,intent(in) :: doMP3
|
||||
|
||||
logical,intent(in) :: regularize
|
||||
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
|
||||
double precision,intent(in) :: ERHF
|
||||
double precision,intent(in) :: eHF(nBas)
|
||||
double precision,intent(in) :: ERI(nBas,nBas,nBas,nBas)
|
||||
double precision,intent(in) :: eHF(nOrb)
|
||||
double precision,intent(in) :: ERI(nOrb,nOrb,nOrb,nOrb)
|
||||
|
||||
! Local variables
|
||||
|
||||
@ -37,11 +37,11 @@ subroutine RMP(dotest,doMP2,doMP3,regularize,nBas,nC,nO,nV,nR,ERI,ENuc,ERHF,eHF)
|
||||
if(doMP2) then
|
||||
|
||||
call wall_time(start_MP)
|
||||
call RMP2(dotest,regularize,nBas,nC,nO,nV,nR,ERI,ENuc,ERHF,eHF,Ec)
|
||||
call RMP2(dotest,regularize,nOrb,nC,nO,nV,nR,ERI,ENuc,ERHF,eHF,Ec)
|
||||
call wall_time(end_MP)
|
||||
|
||||
t_MP = end_MP - start_MP
|
||||
write(*,'(A65,1X,F9.3,A8)') 'Total CPU time for MP2 = ',t_MP,' seconds'
|
||||
write(*,'(A65,1X,F9.3,A8)') 'Total wall time for MP2 = ',t_MP,' seconds'
|
||||
write(*,*)
|
||||
|
||||
end if
|
||||
@ -53,11 +53,11 @@ subroutine RMP(dotest,doMP2,doMP3,regularize,nBas,nC,nO,nV,nR,ERI,ENuc,ERHF,eHF)
|
||||
if(doMP3) then
|
||||
|
||||
call wall_time(start_MP)
|
||||
call RMP3(nBas,nC,nO,nV,nR,ERI,ENuc,ERHF,eHF)
|
||||
call RMP3(nOrb,nC,nO,nV,nR,ERI,ENuc,ERHF,eHF)
|
||||
call wall_time(end_MP)
|
||||
|
||||
t_MP = end_MP - start_MP
|
||||
write(*,'(A65,1X,F9.3,A8)') 'Total CPU time for MP2 = ',t_MP,' seconds'
|
||||
write(*,'(A65,1X,F9.3,A8)') 'Total wall time for MP2 = ',t_MP,' seconds'
|
||||
write(*,*)
|
||||
|
||||
end if
|
||||
|
||||
@ -15,7 +15,7 @@ program QuAcK
|
||||
logical :: doG0W0,doevGW,doqsGW,doufG0W0,doufGW,doSRGqsGW
|
||||
logical :: doG0T0pp,doevGTpp,doqsGTpp,doufG0T0pp,doG0T0eh,doevGTeh,doqsGTeh
|
||||
|
||||
integer :: nNuc,nBas
|
||||
integer :: nNuc, nBas, nOrb
|
||||
integer :: nC(nspin)
|
||||
integer :: nO(nspin)
|
||||
integer :: nV(nspin)
|
||||
@ -31,6 +31,7 @@ program QuAcK
|
||||
double precision,allocatable :: X(:,:)
|
||||
double precision,allocatable :: dipole_int_AO(:,:,:)
|
||||
double precision,allocatable :: ERI_AO(:,:,:,:)
|
||||
double precision,allocatable :: Uvec(:,:), Uval(:)
|
||||
|
||||
double precision :: start_QuAcK,end_QuAcK,t_QuAcK
|
||||
double precision :: start_int ,end_int ,t_int
|
||||
@ -68,6 +69,10 @@ program QuAcK
|
||||
|
||||
logical :: dotest,doRtest,doUtest,doGtest
|
||||
|
||||
integer :: i, j, j0
|
||||
double precision :: acc_d, acc_nd
|
||||
double precision, allocatable :: tmp1(:,:), tmp2(:,:)
|
||||
|
||||
!-------------!
|
||||
! Hello World !
|
||||
!-------------!
|
||||
@ -120,15 +125,16 @@ program QuAcK
|
||||
doACFDT,exchange_kernel,doXBS, &
|
||||
dophBSE,dophBSE2,doppBSE,dBSE,dTDA)
|
||||
|
||||
!------------------------------------------------!
|
||||
! Read input information !
|
||||
!------------------------------------------------!
|
||||
! nC = number of core orbitals !
|
||||
! nO = number of occupied orbitals !
|
||||
! nV = number of virtual orbitals (see below) !
|
||||
! nR = number of Rydberg orbitals !
|
||||
! nBas = number of basis functions (see below) !
|
||||
!------------------------------------------------!
|
||||
!-----------------------------------------------!
|
||||
! Read input information !
|
||||
!-----------------------------------------------!
|
||||
! nC = number of core orbitals !
|
||||
! nO = number of occupied orbitals !
|
||||
! nV = number of virtual orbitals (see below) !
|
||||
! nR = number of Rydberg orbitals !
|
||||
! nBas = number of basis functions !
|
||||
! nOrb = number of orbitals !
|
||||
!-----------------------------------------------!
|
||||
|
||||
call read_molecule(nNuc,nO,nC,nR)
|
||||
allocate(ZNuc(nNuc),rNuc(nNuc,ncart))
|
||||
@ -149,26 +155,84 @@ program QuAcK
|
||||
|
||||
! Memory allocation for one- and two-electron integrals
|
||||
|
||||
allocate(S(nBas,nBas),T(nBas,nBas),V(nBas,nBas),Hc(nBas,nBas),X(nBas,nBas), &
|
||||
ERI_AO(nBas,nBas,nBas,nBas),dipole_int_AO(nBas,nBas,ncart))
|
||||
allocate(S(nBas,nBas))
|
||||
allocate(T(nBas,nBas))
|
||||
allocate(V(nBas,nBas))
|
||||
allocate(Hc(nBas,nBas))
|
||||
allocate(ERI_AO(nBas,nBas,nBas,nBas))
|
||||
allocate(dipole_int_AO(nBas,nBas,ncart))
|
||||
|
||||
! Read integrals
|
||||
|
||||
call wall_time(start_int)
|
||||
|
||||
call read_integrals(nBas,S,T,V,Hc,ERI_AO)
|
||||
call read_dipole_integrals(nBas,dipole_int_AO)
|
||||
call read_integrals(nBas, S(1,1), T(1,1), V(1,1), Hc(1,1), ERI_AO(1,1,1,1))
|
||||
call read_dipole_integrals(nBas, dipole_int_AO)
|
||||
|
||||
call wall_time(end_int)
|
||||
|
||||
t_int = end_int - start_int
|
||||
write(*,*)
|
||||
write(*,'(A65,1X,F9.3,A8)') 'Total CPU time for reading integrals = ',t_int,' seconds'
|
||||
write(*,'(A65,1X,F9.3,A8)') 'Total wall time for reading integrals = ',t_int,' seconds'
|
||||
write(*,*)
|
||||
|
||||
! Compute orthogonalization matrix
|
||||
|
||||
call orthogonalization_matrix(nBas,S,X)
|
||||
!call orthogonalization_matrix(nBas, S, X)
|
||||
|
||||
allocate(Uvec(nBas,nBas), Uval(nBas))
|
||||
|
||||
Uvec(1:nBas,1:nBas) = S(1:nBas,1:nBas)
|
||||
call diagonalize_matrix(nBas, Uvec, Uval)
|
||||
|
||||
nOrb = 0
|
||||
do i = 1, nBas
|
||||
if(Uval(i) > 1d-6) then
|
||||
Uval(i) = 1d0 / dsqrt(Uval(i))
|
||||
nOrb = nOrb + 1
|
||||
else
|
||||
write(*,*) ' Eigenvalue',i,'too small for canonical orthogonalization'
|
||||
end if
|
||||
end do
|
||||
|
||||
write(*,'(A38)') '--------------------------------------'
|
||||
write(*,'(A38,1X,I16)') 'Number of basis functions (AOs)', nBas
|
||||
write(*,'(A38,1X,I16)') 'Number of basis functions (MOs)', nOrb
|
||||
write(*,'(A38,1X,F9.3)') ' % of discarded orbitals = ', 100.d0 * (1.d0 - dble(nOrb)/dble(nBas))
|
||||
write(*,'(A38)') '--------------------------------------'
|
||||
write(*,*)
|
||||
|
||||
j0 = nBas - nOrb
|
||||
allocate(X(nBas,nOrb))
|
||||
do j = j0+1, nBas
|
||||
do i = 1, nBas
|
||||
X(i,j-j0) = Uvec(i,j) * Uval(j)
|
||||
enddo
|
||||
enddo
|
||||
|
||||
deallocate(Uvec, Uval)
|
||||
|
||||
!! check if X.T S X = 1_(nOrb,nOrb)
|
||||
!allocate(tmp1(nOrb,nBas), tmp2(nOrb,nOrb))
|
||||
!call dgemm("T", "N", nOrb, nBas, nBas, 1.d0, &
|
||||
! X(1,1), nBas, S(1,1), nBas, &
|
||||
! 0.d0, tmp1(1,1), nOrb)
|
||||
!call dgemm("N", "N", nOrb, nOrb, nBas, 1.d0, &
|
||||
! tmp1(1,1), nOrb, X(1,1), nBas, &
|
||||
! 0.d0, tmp2(1,1), nOrb)
|
||||
!acc_d = 0.d0
|
||||
!acc_nd = 0.d0
|
||||
!do i = 1, nOrb
|
||||
! !write(*,'(1000(F15.7,2X))') (tmp2(i,j), j = 1, nOrb)
|
||||
! acc_d = acc_d + tmp2(i,i)
|
||||
! do j = 1, nOrb
|
||||
! if(j == i) cycle
|
||||
! acc_nd = acc_nd + dabs(tmp2(j,i))
|
||||
! enddo
|
||||
!enddo
|
||||
!print*, ' diag part: ', dabs(acc_d - dble(nOrb)) / dble(nOrb)
|
||||
!print*, ' non-diag part: ', acc_nd
|
||||
!deallocate(tmp1, tmp2)
|
||||
|
||||
!---------------------!
|
||||
! Choose QuAcK branch !
|
||||
@ -200,7 +264,7 @@ program QuAcK
|
||||
dodrCCD,dorCCD,docrCCD,dolCCD,doCIS,doCIS_D,doCID,doCISD,doFCI,dophRPA,dophRPAx,docrRPA,doppRPA, &
|
||||
doG0F2,doevGF2,doqsGF2,doufG0F02,doG0F3,doevGF3,doG0W0,doevGW,doqsGW,doufG0W0,doufGW,doSRGqsGW, &
|
||||
doG0T0pp,doevGTpp,doqsGTpp,doufG0T0pp,doG0T0eh,doevGTeh,doqsGTeh, &
|
||||
nNuc,nBas,nC,nO,nV,nR,ENuc,ZNuc,rNuc, &
|
||||
nNuc,nBas,nOrb,nC,nO,nV,nR,ENuc,ZNuc,rNuc, &
|
||||
S,T,V,Hc,X,dipole_int_AO,ERI_AO,maxSCF_HF,max_diis_HF,thresh_HF,level_shift, &
|
||||
guess_type,mix,reg_MP,maxSCF_CC,max_diis_CC,thresh_CC,spin_conserved,spin_flip,TDA, &
|
||||
maxSCF_GF,max_diis_GF,renorm_GF,thresh_GF,lin_GF,reg_GF,eta_GF,maxSCF_GW,max_diis_GW,thresh_GW, &
|
||||
@ -216,7 +280,7 @@ program QuAcK
|
||||
dodrCCD,dorCCD,docrCCD,dolCCD,doCIS,doCIS_D,doCID,doCISD,doFCI,dophRPA,dophRPAx,docrRPA,doppRPA, &
|
||||
doG0F2,doevGF2,doqsGF2,doufG0F02,doG0F3,doevGF3,doG0W0,doevGW,doqsGW,doufG0W0,doufGW,doSRGqsGW, &
|
||||
doG0T0pp,doevGTpp,doqsGTpp,doufG0T0pp,doG0T0eh,doevGTeh,doqsGTeh, &
|
||||
nNuc,nBas,nC,nO,nV,nR,ENuc,ZNuc,rNuc, &
|
||||
nNuc,nBas,nC,nO,nV,nR,ENuc,ZNuc,rNuc, &
|
||||
S,T,V,Hc,X,dipole_int_AO,ERI_AO,maxSCF_HF,max_diis_HF,thresh_HF,level_shift, &
|
||||
guess_type,mix,reg_MP,maxSCF_CC,max_diis_CC,thresh_CC,spin_conserved,spin_flip,TDA, &
|
||||
maxSCF_GF,max_diis_GF,renorm_GF,thresh_GF,lin_GF,reg_GF,eta_GF,maxSCF_GW,max_diis_GW,thresh_GW, &
|
||||
@ -228,13 +292,13 @@ program QuAcK
|
||||
!--------------------------!
|
||||
|
||||
if(doGQuAcK) &
|
||||
call GQuAcK(doGtest,doGHF,dostab,dosearch,doMP2,doMP3,doCCD,dopCCD,doDCD,doCCSD,doCCSDT, &
|
||||
dodrCCD,dorCCD,docrCCD,dolCCD,dophRPA,dophRPAx,docrRPA,doppRPA, &
|
||||
doG0W0,doevGW,doqsGW,doG0F2,doevGF2,doqsGF2, &
|
||||
call GQuAcK(doGtest,doGHF,dostab,dosearch,doMP2,doMP3,doCCD,dopCCD,doDCD,doCCSD,doCCSDT, &
|
||||
dodrCCD,dorCCD,docrCCD,dolCCD,dophRPA,dophRPAx,docrRPA,doppRPA, &
|
||||
doG0W0,doevGW,doqsGW,doG0F2,doevGF2,doqsGF2, &
|
||||
nNuc,nBas,sum(nC),sum(nO),sum(nV),sum(nR),ENuc,ZNuc,rNuc,S,T,V,Hc,X,dipole_int_AO,ERI_AO, &
|
||||
maxSCF_HF,max_diis_HF,thresh_HF,level_shift,guess_type,mix,reg_MP, &
|
||||
maxSCF_CC,max_diis_CC,thresh_CC,TDA,maxSCF_GF,max_diis_GF,thresh_GF,lin_GF,reg_GF,eta_GF, &
|
||||
maxSCF_GW,max_diis_GW,thresh_GW,TDA_W,lin_GW,reg_GW,eta_GW, &
|
||||
maxSCF_HF,max_diis_HF,thresh_HF,level_shift,guess_type,mix,reg_MP, &
|
||||
maxSCF_CC,max_diis_CC,thresh_CC,TDA,maxSCF_GF,max_diis_GF,thresh_GF,lin_GF,reg_GF,eta_GF, &
|
||||
maxSCF_GW,max_diis_GW,thresh_GW,TDA_W,lin_GW,reg_GW,eta_GW, &
|
||||
dophBSE,dophBSE2,doppBSE,dBSE,dTDA,doACFDT,exchange_kernel,doXBS)
|
||||
|
||||
!-----------!
|
||||
@ -256,7 +320,7 @@ program QuAcK
|
||||
call wall_time(end_QuAcK)
|
||||
|
||||
t_QuAcK = end_QuAcK - start_QuAcK
|
||||
write(*,'(A65,1X,F9.3,A8)') 'Total CPU time for QuAcK = ',t_QuAcK,' seconds'
|
||||
write(*,'(A65,1X,F9.3,A8)') 'Total wall time for QuAcK = ',t_QuAcK,' seconds'
|
||||
write(*,*)
|
||||
|
||||
end program
|
||||
|
||||
@ -2,7 +2,7 @@ subroutine RQuAcK(dotest,doRHF,doROHF,dostab,dosearch,doMP2,doMP3,doCCD,dopCCD,d
|
||||
dodrCCD,dorCCD,docrCCD,dolCCD,doCIS,doCIS_D,doCID,doCISD,doFCI,dophRPA,dophRPAx,docrRPA,doppRPA, &
|
||||
doG0F2,doevGF2,doqsGF2,doufG0F02,doG0F3,doevGF3,doG0W0,doevGW,doqsGW,doufG0W0,doufGW,doSRGqsGW, &
|
||||
doG0T0pp,doevGTpp,doqsGTpp,doufG0T0pp,doG0T0eh,doevGTeh,doqsGTeh, &
|
||||
nNuc,nBas,nC,nO,nV,nR,ENuc,ZNuc,rNuc, &
|
||||
nNuc,nBas,nOrb,nC,nO,nV,nR,ENuc,ZNuc,rNuc, &
|
||||
S,T,V,Hc,X,dipole_int_AO,ERI_AO,maxSCF_HF,max_diis_HF,thresh_HF,level_shift, &
|
||||
guess_type,mix,reg_MP,maxSCF_CC,max_diis_CC,thresh_CC,singlet,triplet,TDA, &
|
||||
maxSCF_GF,max_diis_GF,renorm_GF,thresh_GF,lin_GF,reg_GF,eta_GF,maxSCF_GW,max_diis_GW,thresh_GW, &
|
||||
@ -29,7 +29,7 @@ subroutine RQuAcK(dotest,doRHF,doROHF,dostab,dosearch,doMP2,doMP3,doCCD,dopCCD,d
|
||||
logical,intent(in) :: doG0T0pp,doevGTpp,doqsGTpp,doufG0T0pp
|
||||
logical,intent(in) :: doG0T0eh,doevGTeh,doqsGTeh
|
||||
|
||||
integer,intent(in) :: nNuc,nBas
|
||||
integer,intent(in) :: nNuc,nBas,nOrb
|
||||
integer,intent(in) :: nC
|
||||
integer,intent(in) :: nO
|
||||
integer,intent(in) :: nV
|
||||
@ -42,7 +42,7 @@ subroutine RQuAcK(dotest,doRHF,doROHF,dostab,dosearch,doMP2,doMP3,doCCD,dopCCD,d
|
||||
double precision,intent(in) :: T(nBas,nBas)
|
||||
double precision,intent(in) :: V(nBas,nBas)
|
||||
double precision,intent(in) :: Hc(nBas,nBas)
|
||||
double precision,intent(in) :: X(nBas,nBas)
|
||||
double precision,intent(in) :: X(nBas,nOrb)
|
||||
double precision,intent(in) :: dipole_int_AO(nBas,nBas,ncart)
|
||||
double precision,intent(in) :: ERI_AO(nBas,nBas,nBas,nBas)
|
||||
|
||||
@ -109,8 +109,11 @@ subroutine RQuAcK(dotest,doRHF,doROHF,dostab,dosearch,doMP2,doMP3,doCCD,dopCCD,d
|
||||
! Memory allocation !
|
||||
!-------------------!
|
||||
|
||||
allocate(cHF(nBas,nBas),eHF(nBas),PHF(nBas,nBas), &
|
||||
dipole_int_MO(nBas,nBas,ncart),ERI_MO(nBas,nBas,nBas,nBas))
|
||||
allocate(cHF(nBas,nOrb))
|
||||
allocate(eHF(nOrb))
|
||||
allocate(PHF(nBas,nBas))
|
||||
allocate(dipole_int_MO(nOrb,nOrb,ncart))
|
||||
allocate(ERI_MO(nOrb,nOrb,nOrb,nOrb))
|
||||
|
||||
!---------------------!
|
||||
! Hartree-Fock module !
|
||||
@ -119,12 +122,12 @@ subroutine RQuAcK(dotest,doRHF,doROHF,dostab,dosearch,doMP2,doMP3,doCCD,dopCCD,d
|
||||
if(doRHF) then
|
||||
|
||||
call wall_time(start_HF)
|
||||
call RHF(dotest,maxSCF_HF,thresh_HF,max_diis_HF,guess_type,level_shift,nNuc,ZNuc,rNuc,ENuc, &
|
||||
nBas,nO,S,T,V,Hc,ERI_AO,dipole_int_AO,X,ERHF,eHF,cHF,PHF)
|
||||
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)
|
||||
call wall_time(end_HF)
|
||||
|
||||
t_HF = end_HF - start_HF
|
||||
write(*,'(A65,1X,F9.3,A8)') 'Total CPU time for RHF = ',t_HF,' seconds'
|
||||
write(*,'(A65,1X,F9.3,A8)') 'Total wall time for RHF = ',t_HF,' seconds'
|
||||
write(*,*)
|
||||
|
||||
end if
|
||||
@ -132,12 +135,12 @@ subroutine RQuAcK(dotest,doRHF,doROHF,dostab,dosearch,doMP2,doMP3,doCCD,dopCCD,d
|
||||
if(doROHF) then
|
||||
|
||||
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,nO,S,T,V,Hc,ERI_AO,dipole_int_AO,X,ERHF,eHF,cHF,PHF)
|
||||
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)
|
||||
call wall_time(end_HF)
|
||||
|
||||
t_HF = end_HF - start_HF
|
||||
write(*,'(A65,1X,F9.3,A8)') 'Total CPU time for ROHF = ',t_HF,' seconds'
|
||||
write(*,'(A65,1X,F9.3,A8)') 'Total wall time for ROHF = ',t_HF,' seconds'
|
||||
write(*,*)
|
||||
|
||||
end if
|
||||
@ -154,18 +157,18 @@ subroutine RQuAcK(dotest,doRHF,doROHF,dostab,dosearch,doMP2,doMP3,doCCD,dopCCD,d
|
||||
|
||||
! Read and transform dipole-related integrals
|
||||
|
||||
do ixyz=1,ncart
|
||||
call AOtoMO(nBas,cHF,dipole_int_AO(:,:,ixyz),dipole_int_MO(:,:,ixyz))
|
||||
do ixyz = 1, ncart
|
||||
call AOtoMO(nBas, nOrb, cHF, dipole_int_AO(1,1,ixyz), dipole_int_MO(1,1,ixyz))
|
||||
end do
|
||||
|
||||
! 4-index transform
|
||||
|
||||
call AOtoMO_ERI_RHF(nBas,cHF,ERI_AO,ERI_MO)
|
||||
call AOtoMO_ERI_RHF(nBas, nOrb, cHF, ERI_AO, ERI_MO)
|
||||
|
||||
call wall_time(end_AOtoMO)
|
||||
|
||||
t_AOtoMO = end_AOtoMO - start_AOtoMO
|
||||
write(*,'(A65,1X,F9.3,A8)') 'Total CPU time for AO to MO transformation = ',t_AOtoMO,' seconds'
|
||||
write(*,'(A65,1X,F9.3,A8)') 'Total wall time for AO to MO transformation = ',t_AOtoMO,' seconds'
|
||||
write(*,*)
|
||||
|
||||
!-----------------------------------!
|
||||
@ -177,11 +180,11 @@ subroutine RQuAcK(dotest,doRHF,doROHF,dostab,dosearch,doMP2,doMP3,doCCD,dopCCD,d
|
||||
if(dostab) then
|
||||
|
||||
call wall_time(start_stab)
|
||||
call RHF_stability(nBas,nC,nO,nV,nR,nS,eHF,ERI_MO)
|
||||
call RHF_stability(nOrb, nC, nO, nV, nR, nS, eHF, ERI_MO)
|
||||
call wall_time(end_stab)
|
||||
|
||||
t_stab = end_stab - start_stab
|
||||
write(*,'(A65,1X,F9.3,A8)') 'Total CPU time for stability analysis = ',t_stab,' seconds'
|
||||
write(*,'(A65,1X,F9.3,A8)') 'Total wall time for stability analysis = ',t_stab,' seconds'
|
||||
write(*,*)
|
||||
|
||||
end if
|
||||
@ -189,12 +192,13 @@ subroutine RQuAcK(dotest,doRHF,doROHF,dostab,dosearch,doMP2,doMP3,doCCD,dopCCD,d
|
||||
if(dosearch) then
|
||||
|
||||
call wall_time(start_stab)
|
||||
call RHF_search(maxSCF_HF,thresh_HF,max_diis_HF,guess_type,level_shift,nNuc,ZNuc,rNuc,ENuc, &
|
||||
nBas,nC,nO,nV,nR,S,T,V,Hc,ERI_AO,ERI_MO,dipole_int_AO,dipole_int_MO,X,ERHF,eHF,cHF,PHF)
|
||||
call RHF_search(maxSCF_HF, thresh_HF, max_diis_HF, guess_type, level_shift, nNuc, ZNuc, rNuc, ENuc, &
|
||||
nBas, nOrb, nC, nO, nV, nR, S, T, V, Hc, ERI_AO, ERI_MO, dipole_int_AO, &
|
||||
dipole_int_MO, X, ERHF, eHF, cHF, PHF)
|
||||
call wall_time(end_stab)
|
||||
|
||||
t_stab = end_stab - start_stab
|
||||
write(*,'(A65,1X,F9.3,A8)') 'Total CPU time for stability analysis = ',t_stab,' seconds'
|
||||
write(*,'(A65,1X,F9.3,A8)') 'Total wall time for stability analysis = ',t_stab,' seconds'
|
||||
write(*,*)
|
||||
|
||||
end if
|
||||
@ -208,11 +212,11 @@ subroutine RQuAcK(dotest,doRHF,doROHF,dostab,dosearch,doMP2,doMP3,doCCD,dopCCD,d
|
||||
if(doMP) then
|
||||
|
||||
call wall_time(start_MP)
|
||||
call RMP(dotest,doMP2,doMP3,reg_MP,nBas,nC,nO,nV,nR,ERI_MO,ENuc,ERHF,eHF)
|
||||
call RMP(dotest, doMP2, doMP3, reg_MP, nOrb, nC, nO, nV, nR, ERI_MO, ENuc, ERHF, eHF)
|
||||
call wall_time(end_MP)
|
||||
|
||||
t_MP = end_MP - start_MP
|
||||
write(*,'(A65,1X,F9.3,A8)') 'Total CPU time for MP = ',t_MP,' seconds'
|
||||
write(*,'(A65,1X,F9.3,A8)') 'Total wall time for MP = ',t_MP,' seconds'
|
||||
write(*,*)
|
||||
|
||||
end if
|
||||
@ -227,12 +231,12 @@ subroutine RQuAcK(dotest,doRHF,doROHF,dostab,dosearch,doMP2,doMP3,doCCD,dopCCD,d
|
||||
if(doCC) then
|
||||
|
||||
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,nC,nO,nV,nR,ERI_MO,ENuc,ERHF,eHF)
|
||||
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)
|
||||
call wall_time(end_CC)
|
||||
|
||||
t_CC = end_CC - start_CC
|
||||
write(*,'(A65,1X,F9.3,A8)') 'Total CPU time for CC = ',t_CC,' seconds'
|
||||
write(*,'(A65,1X,F9.3,A8)') 'Total wall time for CC = ',t_CC,' seconds'
|
||||
write(*,*)
|
||||
|
||||
end if
|
||||
@ -246,12 +250,12 @@ subroutine RQuAcK(dotest,doRHF,doROHF,dostab,dosearch,doMP2,doMP3,doCCD,dopCCD,d
|
||||
if(doCI) then
|
||||
|
||||
call wall_time(start_CI)
|
||||
call RCI(dotest,doCIS,doCIS_D,doCID,doCISD,doFCI,singlet,triplet,nBas,nC,nO,nV,nR,nS,ERI_MO,dipole_int_MO, &
|
||||
eHF,ERHF,cHF,S)
|
||||
call RCI(dotest, doCIS, doCIS_D, doCID, doCISD, doFCI, singlet, triplet, nOrb, &
|
||||
nC, nO, nV, nR, nS, ERI_MO, dipole_int_MO, eHF, ERHF)
|
||||
call wall_time(end_CI)
|
||||
|
||||
t_CI = end_CI - start_CI
|
||||
write(*,'(A65,1X,F9.3,A8)') 'Total CPU time for CI = ',t_CI,' seconds'
|
||||
write(*,'(A65,1X,F9.3,A8)') 'Total wall time for CI = ',t_CI,' seconds'
|
||||
write(*,*)
|
||||
|
||||
end if
|
||||
@ -265,12 +269,12 @@ subroutine RQuAcK(dotest,doRHF,doROHF,dostab,dosearch,doMP2,doMP3,doCCD,dopCCD,d
|
||||
if(doRPA) then
|
||||
|
||||
call wall_time(start_RPA)
|
||||
call RRPA(dotest,dophRPA,dophRPAx,docrRPA,doppRPA,TDA,doACFDT,exchange_kernel,singlet,triplet, &
|
||||
nBas,nC,nO,nV,nR,nS,ENuc,ERHF,ERI_MO,dipole_int_MO,eHF,cHF,S)
|
||||
call RRPA(dotest, dophRPA, dophRPAx, docrRPA, doppRPA, TDA, doACFDT, exchange_kernel, singlet, triplet, &
|
||||
nOrb, nC, nO, nV, nR, nS, ENuc, ERHF, ERI_MO, dipole_int_MO, eHF)
|
||||
call wall_time(end_RPA)
|
||||
|
||||
t_RPA = end_RPA - start_RPA
|
||||
write(*,'(A65,1X,F9.3,A8)') 'Total CPU time for RPA = ',t_RPA,' seconds'
|
||||
write(*,'(A65,1X,F9.3,A8)') 'Total wall time for RPA = ',t_RPA,' seconds'
|
||||
write(*,*)
|
||||
|
||||
end if
|
||||
@ -284,14 +288,14 @@ subroutine RQuAcK(dotest,doRHF,doROHF,dostab,dosearch,doMP2,doMP3,doCCD,dopCCD,d
|
||||
if(doGF) then
|
||||
|
||||
call wall_time(start_GF)
|
||||
call RGF(dotest,doG0F2,doevGF2,doqsGF2,doufG0F02,doG0F3,doevGF3,renorm_GF,maxSCF_GF,thresh_GF,max_diis_GF, &
|
||||
dophBSE,doppBSE,TDA,dBSE,dTDA,singlet,triplet,lin_GF,eta_GF,reg_GF, &
|
||||
nNuc,ZNuc,rNuc,ENuc,nBas,nC,nO,nV,nR,nS,ERHF,S,X,T,V,Hc,ERI_AO,ERI_MO, &
|
||||
dipole_int_AO,dipole_int_MO,PHF,cHF,eHF)
|
||||
call RGF(dotest, doG0F2, doevGF2, doqsGF2, doufG0F02, doG0F3, doevGF3, renorm_GF, maxSCF_GF, &
|
||||
thresh_GF, max_diis_GF, dophBSE, doppBSE, TDA, dBSE, dTDA, singlet, triplet, lin_GF, &
|
||||
eta_GF, reg_GF, nNuc, ZNuc, rNuc, ENuc, nBas, nOrb, nC, nO, nV, nR, nS, ERHF, &
|
||||
S, X, T, V, Hc, ERI_AO, ERI_MO, dipole_int_AO, dipole_int_MO, PHF, cHF, eHF)
|
||||
call wall_time(end_GF)
|
||||
|
||||
t_GF = end_GF - start_GF
|
||||
write(*,'(A65,1X,F9.3,A8)') 'Total CPU time for GF2 = ',t_GF,' seconds'
|
||||
write(*,'(A65,1X,F9.3,A8)') 'Total wall time for GF2 = ',t_GF,' seconds'
|
||||
write(*,*)
|
||||
|
||||
end if
|
||||
@ -305,14 +309,14 @@ subroutine RQuAcK(dotest,doRHF,doROHF,dostab,dosearch,doMP2,doMP3,doCCD,dopCCD,d
|
||||
if(doGW) then
|
||||
|
||||
call wall_time(start_GW)
|
||||
call RGW(dotest,doG0W0,doevGW,doqsGW,doufG0W0,doufGW,doSRGqsGW,maxSCF_GW,thresh_GW,max_diis_GW, &
|
||||
doACFDT,exchange_kernel,doXBS,dophBSE,dophBSE2,doppBSE,TDA_W,TDA,dBSE,dTDA,singlet,triplet, &
|
||||
lin_GW,eta_GW,reg_GW,nNuc,ZNuc,rNuc,ENuc,nBas,nC,nO,nV,nR,nS,ERHF,S,X,T,V,Hc, &
|
||||
ERI_AO,ERI_MO,dipole_int_AO,dipole_int_MO,PHF,cHF,eHF)
|
||||
call RGW(dotest, doG0W0, doevGW, doqsGW, doufG0W0, doufGW, doSRGqsGW, maxSCF_GW, thresh_GW, max_diis_GW, &
|
||||
doACFDT, exchange_kernel, doXBS, dophBSE, dophBSE2, doppBSE, TDA_W, TDA, dBSE, dTDA, singlet, triplet, &
|
||||
lin_GW, eta_GW, reg_GW, nNuc, ZNuc, rNuc, ENuc, nBas, nOrb, nC, nO, nV, nR, nS, ERHF, S, X, T, &
|
||||
V, Hc, ERI_AO, ERI_MO, dipole_int_AO, dipole_int_MO, PHF, cHF, eHF)
|
||||
call wall_time(end_GW)
|
||||
|
||||
t_GW = end_GW - start_GW
|
||||
write(*,'(A65,1X,F9.3,A8)') 'Total CPU time for GW = ',t_GW,' seconds'
|
||||
write(*,'(A65,1X,F9.3,A8)') 'Total wall time for GW = ',t_GW,' seconds'
|
||||
write(*,*)
|
||||
|
||||
end if
|
||||
@ -326,14 +330,15 @@ subroutine RQuAcK(dotest,doRHF,doROHF,dostab,dosearch,doMP2,doMP3,doCCD,dopCCD,d
|
||||
if(doGT) then
|
||||
|
||||
call wall_time(start_GT)
|
||||
call RGT(dotest,doG0T0pp,doevGTpp,doqsGTpp,doufG0T0pp,doG0T0eh,doevGTeh,doqsGTeh, &
|
||||
maxSCF_GT,thresh_GT,max_diis_GT,doACFDT,exchange_kernel,doXBS,dophBSE,dophBSE2,doppBSE, &
|
||||
TDA_T,TDA,dBSE,dTDA,singlet,triplet,lin_GT,eta_GT,reg_GT,nNuc,ZNuc,rNuc,ENuc, &
|
||||
nBas,nC,nO,nV,nR,nS,ERHF,S,X,T,V,Hc,ERI_AO,ERI_MO,dipole_int_AO,dipole_int_MO,PHF,cHF,eHF)
|
||||
call RGT(dotest, doG0T0pp, doevGTpp, doqsGTpp, doufG0T0pp, doG0T0eh, doevGTeh, doqsGTeh, &
|
||||
maxSCF_GT, thresh_GT, max_diis_GT, doACFDT, exchange_kernel, doXBS, dophBSE, dophBSE2, doppBSE, &
|
||||
TDA_T, TDA, dBSE, dTDA, singlet, triplet, lin_GT, eta_GT, reg_GT, nNuc, ZNuc, rNuc, ENuc, &
|
||||
nBas, nOrb, nC, nO, nV, nR, nS, ERHF, S, X, T, V, Hc, ERI_AO, ERI_MO, dipole_int_AO, &
|
||||
dipole_int_MO, PHF, cHF, eHF)
|
||||
call wall_time(end_GT)
|
||||
|
||||
t_GT = end_GT - start_GT
|
||||
write(*,'(A65,1X,F9.3,A8)') 'Total CPU time for GT = ',t_GT,' seconds'
|
||||
write(*,'(A65,1X,F9.3,A8)') 'Total wall time for GT = ',t_GT,' seconds'
|
||||
write(*,*)
|
||||
|
||||
end if
|
||||
|
||||
@ -163,8 +163,8 @@ subroutine UQuAcK(dotest,doUHF,dostab,dosearch,doMP2,doMP3,doCCD,dopCCD,doDCD,do
|
||||
! Read and transform dipole-related integrals
|
||||
|
||||
do ixyz=1,ncart
|
||||
call AOtoMO(nBas,cHF(:,:,1),dipole_int_AO(:,:,ixyz),dipole_int_aa(:,:,ixyz))
|
||||
call AOtoMO(nBas,cHF(:,:,2),dipole_int_AO(:,:,ixyz),dipole_int_bb(:,:,ixyz))
|
||||
call AOtoMO(nBas,nBas,cHF(:,:,1),dipole_int_AO(:,:,ixyz),dipole_int_aa(:,:,ixyz))
|
||||
call AOtoMO(nBas,nBas,cHF(:,:,2),dipole_int_AO(:,:,ixyz),dipole_int_bb(:,:,ixyz))
|
||||
end do
|
||||
|
||||
! 4-index transform for (aa|aa) block
|
||||
|
||||
@ -1,5 +1,5 @@
|
||||
subroutine RRPA(dotest,dophRPA,dophRPAx,docrRPA,doppRPA,TDA,doACFDT,exchange_kernel,singlet,triplet, &
|
||||
nBas,nC,nO,nV,nR,nS,ENuc,ERHF,ERI,dipole_int,eHF,cHF,S)
|
||||
nBas,nC,nO,nV,nR,nS,ENuc,ERHF,ERI,dipole_int,eHF)
|
||||
|
||||
! Random-phase approximation module
|
||||
|
||||
@ -29,8 +29,6 @@ subroutine RRPA(dotest,dophRPA,dophRPAx,docrRPA,doppRPA,TDA,doACFDT,exchange_ker
|
||||
double precision,intent(in) :: ENuc
|
||||
double precision,intent(in) :: ERHF
|
||||
double precision,intent(in) :: eHF(nBas)
|
||||
double precision,intent(in) :: cHF(nBas,nBas)
|
||||
double precision,intent(in) :: S(nBas,nBas)
|
||||
double precision,intent(in) :: ERI(nBas,nBas,nBas,nBas)
|
||||
double precision,intent(in) :: dipole_int(nBas,nBas,ncart)
|
||||
|
||||
@ -49,7 +47,7 @@ subroutine RRPA(dotest,dophRPA,dophRPAx,docrRPA,doppRPA,TDA,doACFDT,exchange_ker
|
||||
call wall_time(end_RPA)
|
||||
|
||||
t_RPA = end_RPA - start_RPA
|
||||
write(*,'(A65,1X,F9.3,A8)') 'Total CPU time for RPA = ',t_RPA,' seconds'
|
||||
write(*,'(A65,1X,F9.3,A8)') 'Total wall time for RPA = ',t_RPA,' seconds'
|
||||
write(*,*)
|
||||
|
||||
end if
|
||||
@ -65,7 +63,7 @@ subroutine RRPA(dotest,dophRPA,dophRPAx,docrRPA,doppRPA,TDA,doACFDT,exchange_ker
|
||||
call wall_time(end_RPA)
|
||||
|
||||
t_RPA = end_RPA - start_RPA
|
||||
write(*,'(A65,1X,F9.3,A8)') 'Total CPU time for RPAx = ',t_RPA,' seconds'
|
||||
write(*,'(A65,1X,F9.3,A8)') 'Total wall time for RPAx = ',t_RPA,' seconds'
|
||||
write(*,*)
|
||||
|
||||
end if
|
||||
@ -81,7 +79,7 @@ subroutine RRPA(dotest,dophRPA,dophRPAx,docrRPA,doppRPA,TDA,doACFDT,exchange_ker
|
||||
call wall_time(end_RPA)
|
||||
|
||||
t_RPA = end_RPA - start_RPA
|
||||
write(*,'(A65,1X,F9.3,A8)') 'Total CPU time for pp-RPA = ',t_RPA,' seconds'
|
||||
write(*,'(A65,1X,F9.3,A8)') 'Total wall time for pp-RPA = ',t_RPA,' seconds'
|
||||
write(*,*)
|
||||
|
||||
end if
|
||||
@ -97,7 +95,7 @@ subroutine RRPA(dotest,dophRPA,dophRPAx,docrRPA,doppRPA,TDA,doACFDT,exchange_ker
|
||||
call wall_time(end_RPA)
|
||||
|
||||
t_RPA = end_RPA - start_RPA
|
||||
write(*,'(A65,1X,F9.3,A8)') 'Total CPU time for pp-RPA = ',t_RPA,' seconds'
|
||||
write(*,'(A65,1X,F9.3,A8)') 'Total wall time for pp-RPA = ',t_RPA,' seconds'
|
||||
write(*,*)
|
||||
|
||||
end if
|
||||
|
||||
@ -39,9 +39,10 @@ subroutine sort_ppRPA(nOO,nVV,Om,Z,Om1,X1,Y1,Om2,X2,Y2)
|
||||
double precision,intent(out) :: X2(nVV,nOO)
|
||||
double precision,intent(out) :: Y2(nOO,nOO)
|
||||
|
||||
|
||||
! Memory allocation
|
||||
|
||||
allocate(M(nOO+nVV,nOO+nVV),Z1(nOO+nVV,nVV),Z2(nOO+nVV,nOO),order1(nVV),order2(nOO))
|
||||
allocate(M(nOO+nVV,nOO+nVV),Z1(nOO+nVV,nVV),Z2(nOO+nVV,nOO),order1(nVV),order2(nOO))
|
||||
|
||||
! Initializatiom
|
||||
|
||||
@ -86,7 +87,7 @@ subroutine sort_ppRPA(nOO,nVV,Om,Z,Om1,X1,Y1,Om2,X2,Y2)
|
||||
|
||||
end if
|
||||
|
||||
end do
|
||||
end do
|
||||
|
||||
if(minval(Om1) < 0d0 .or. ab /= nVV) call print_warning('You may have instabilities in pp-RPA!!')
|
||||
if(maxval(Om2) > 0d0 .or. ij /= nOO) call print_warning('You may have instabilities in pp-RPA!!')
|
||||
@ -111,7 +112,8 @@ subroutine sort_ppRPA(nOO,nVV,Om,Z,Om1,X1,Y1,Om2,X2,Y2)
|
||||
call quick_sort(Om2,order2,nOO)
|
||||
call set_order(Z2,order2,nOO+nVV,nOO)
|
||||
|
||||
end if
|
||||
end if
|
||||
|
||||
|
||||
! Orthogonalize eigenvectors
|
||||
|
||||
@ -202,7 +204,6 @@ subroutine sort_ppRPA(nOO,nVV,Om,Z,Om1,X1,Y1,Om2,X2,Y2)
|
||||
|
||||
if(nVV > 0) call dgemm ('N', 'N', nOO+nVV, nVV, nOO+nVV, 1d0, M, nOO+nVV, Z1, nOO+nVV, 0d0, tmp1, nOO+nVV)
|
||||
if(nVV > 0) call dgemm ('T', 'N', nVV , nVV, nOO+nVV, 1d0, Z1, nOO+nVV, tmp1, nOO+nVV, 0d0, S1, nVV)
|
||||
|
||||
if(nOO > 0) call dgemm ('N', 'N', nOO+nVV, nOO, nOO+nVV, 1d0, M, nOO+nVV, -1d0*Z2, nOO+nVV, 0d0, tmp2, nOO+nVV)
|
||||
if(nOO > 0) call dgemm ('T', 'N', nOO , nOO, nOO+nVV, 1d0, Z2, nOO+nVV, tmp2, nOO+nVV, 0d0, S2, nOO)
|
||||
|
||||
|
||||
@ -76,10 +76,21 @@ STDCXX=-lstdc++
|
||||
FIX_ORDER_OF_LIBS=-Wl,--start-group
|
||||
"""
|
||||
|
||||
compile_olympe = """
|
||||
FC = ifort -mkl=parallel -qopenmp
|
||||
AR = ar crs
|
||||
FFLAGS = -I$IDIR -Ofast -traceback -xCORE-AVX512
|
||||
CC = icc
|
||||
CXX = icpc
|
||||
LAPACK=
|
||||
STDCXX=-lstdc++
|
||||
FIX_ORDER_OF_LIBS=-Wl,--start-group
|
||||
"""
|
||||
|
||||
if sys.platform in ["linux", "linux2"]:
|
||||
compiler = compile_gfortran_linux
|
||||
# compiler = compile_ifort_linux
|
||||
# compiler = compile_gfortran_linux
|
||||
compiler = compile_ifort_linux
|
||||
# compiler = compile_olympe
|
||||
elif sys.platform == "darwin":
|
||||
compiler = compile_gfortran_mac
|
||||
else:
|
||||
|
||||
@ -9,12 +9,12 @@ subroutine check_test_value(branch)
|
||||
! Local variables
|
||||
|
||||
character(len=30) :: description
|
||||
double precision :: value
|
||||
double precision :: val
|
||||
double precision :: reference
|
||||
character(len=15) :: answer
|
||||
|
||||
logical :: failed
|
||||
double precision,parameter :: cutoff = 1d-10
|
||||
double precision,parameter :: thresh = 1d-10
|
||||
|
||||
! Output variables
|
||||
|
||||
@ -45,19 +45,19 @@ subroutine check_test_value(branch)
|
||||
do
|
||||
|
||||
read(11,'(A30)',end=11) description
|
||||
read(11,'(F20.15)',end=11) value
|
||||
read(11,'(F20.15)',end=11) val
|
||||
|
||||
read(12,*,end=12)
|
||||
read(12,'(F20.15)',end=12) reference
|
||||
|
||||
if(abs(value-reference) < cutoff) then
|
||||
if(dabs(val-reference)/(1d-15+dabs(reference)) < thresh) then
|
||||
answer = '.......... :-)'
|
||||
else
|
||||
answer = '.......... :-( '
|
||||
failed = .true.
|
||||
end if
|
||||
write(*,'(1X,A1,1X,A30,1X,A1,1X,3F15.10,1X,A1,1X,A15,1X,A1)') &
|
||||
'|',description,'|',value,reference,abs(value-reference),'|',answer,'|'
|
||||
'|',description,'|',val,reference,abs(val-reference),'|',answer,'|'
|
||||
|
||||
end do
|
||||
|
||||
|
||||
@ -1,4 +1,4 @@
|
||||
subroutine dump_test_value(branch,description,value)
|
||||
subroutine dump_test_value(branch, description, val)
|
||||
|
||||
implicit none
|
||||
|
||||
@ -7,7 +7,7 @@ subroutine dump_test_value(branch,description,value)
|
||||
character(len=1),intent(in) :: branch
|
||||
character(len=*),intent(in) :: description
|
||||
|
||||
double precision,intent(in) :: value
|
||||
double precision,intent(in) :: val
|
||||
|
||||
! Local variables
|
||||
|
||||
@ -15,18 +15,19 @@ subroutine dump_test_value(branch,description,value)
|
||||
|
||||
if(branch == 'R') then
|
||||
|
||||
write(11,*) trim(description)
|
||||
write(11,'(F20.15)') value
|
||||
!write(1231597, '(A, ": ", F20.15)') '"' // trim(description) // '"', val
|
||||
write(1231597, *) trim(description)
|
||||
write(1231597, '(F20.15)') val
|
||||
|
||||
elseif(branch == 'U') then
|
||||
|
||||
write(12,*) trim(description)
|
||||
write(12,'(F20.15)') value
|
||||
write(1232584,*) trim(description)
|
||||
write(1232584,'(F20.15)') val
|
||||
|
||||
elseif(branch == 'G') then
|
||||
|
||||
write(13,*) trim(description)
|
||||
write(13,'(F20.15)') value
|
||||
write(1234181,*) trim(description)
|
||||
write(1234181,'(F20.15)') val
|
||||
|
||||
else
|
||||
|
||||
|
||||
@ -12,10 +12,10 @@ subroutine init_test(doRtest,doUtest,doGtest)
|
||||
|
||||
! Output variables
|
||||
|
||||
if(doRtest) open(unit=11,file='test/Rtest.dat')
|
||||
if(doRtest) open(unit=1231597, file='test/Rtest.dat')
|
||||
|
||||
if(doUtest) open(unit=12,file='test/Utest.dat')
|
||||
if(doUtest) open(unit=1232584, file='test/Utest.dat')
|
||||
|
||||
if(doGtest) open(unit=13,file='test/Gtest.dat')
|
||||
if(doGtest) open(unit=1234181, file='test/Gtest.dat')
|
||||
|
||||
end subroutine
|
||||
|
||||
@ -12,10 +12,10 @@ subroutine stop_test(doRtest,doUtest,doGtest)
|
||||
|
||||
! Output variables
|
||||
|
||||
if(doRtest) close(unit=11)
|
||||
if(doRtest) close(unit=1231597)
|
||||
|
||||
if(doUtest) close(unit=12)
|
||||
if(doUtest) close(unit=1231597)
|
||||
|
||||
if(doGtest) close(unit=13)
|
||||
if(doGtest) close(unit=1234181)
|
||||
|
||||
end subroutine
|
||||
|
||||
@ -1,4 +1,4 @@
|
||||
subroutine level_shifting(level_shift,nBas,nO,S,c,F)
|
||||
subroutine level_shifting(level_shift, nBas, nOrb, nO, S, c, F)
|
||||
|
||||
! Perform level-shifting on the Fock matrix
|
||||
|
||||
@ -7,10 +7,10 @@ subroutine level_shifting(level_shift,nBas,nO,S,c,F)
|
||||
! Input variables
|
||||
|
||||
double precision,intent(in) :: level_shift
|
||||
integer,intent(in) :: nBas
|
||||
integer,intent(in) :: nBas, nOrb
|
||||
integer,intent(in) :: nO
|
||||
double precision,intent(in) :: S(nBas,nBas)
|
||||
double precision,intent(in) :: c(nBas,nBas)
|
||||
double precision,intent(in) :: c(nBas,nOrb)
|
||||
|
||||
! Local variables
|
||||
|
||||
@ -23,15 +23,17 @@ subroutine level_shifting(level_shift,nBas,nO,S,c,F)
|
||||
|
||||
double precision,intent(inout):: F(nBas,nBas)
|
||||
|
||||
allocate(F_MO(nBas,nBas),Sc(nBas,nBas))
|
||||
allocate(F_MO(nOrb,nOrb), Sc(nBas,nOrb))
|
||||
|
||||
F_MO(:,:) = matmul(transpose(c),matmul(F,c))
|
||||
F_MO(:,:) = matmul(transpose(c), matmul(F, c))
|
||||
|
||||
do a=nO+1,nBas
|
||||
do a = nO+1, nOrb
|
||||
F_MO(a,a) = F_MO(a,a) + level_shift
|
||||
end do
|
||||
|
||||
Sc(:,:) = matmul(S,c)
|
||||
F(:,:) = matmul(Sc,matmul(F_MO,transpose(Sc)))
|
||||
Sc(:,:) = matmul(S, c)
|
||||
F(:,:) = matmul(Sc, matmul(F_MO, transpose(Sc)))
|
||||
|
||||
deallocate(F_MO, Sc)
|
||||
|
||||
end subroutine
|
||||
|
||||
571
src/utils/non_sym_diag.f90
Normal file
571
src/utils/non_sym_diag.f90
Normal file
@ -0,0 +1,571 @@
|
||||
|
||||
! ---
|
||||
|
||||
subroutine diagonalize_nonsym_matrix(N, A, L, e_re, thr_d, thr_nd, thr_deg, imp_bio, verbose)
|
||||
|
||||
! Diagonalize a non-symmetric matrix A
|
||||
!
|
||||
! Output
|
||||
! right-eigenvectors are saved in A
|
||||
! left-eigenvectors are saved in L
|
||||
! eigenvalues are saved in e = e_re + i e_im
|
||||
|
||||
implicit none
|
||||
|
||||
integer, intent(in) :: N
|
||||
logical, intent(in) :: imp_bio, verbose
|
||||
double precision, intent(in) :: thr_d, thr_nd, thr_deg
|
||||
double precision, intent(inout) :: A(N,N)
|
||||
double precision, intent(out) :: e_re(N), L(N,N)
|
||||
|
||||
integer :: i, j, ii
|
||||
integer :: lwork, info
|
||||
double precision :: accu_d, accu_nd
|
||||
integer, allocatable :: iorder(:), deg_num(:)
|
||||
double precision, allocatable :: Atmp(:,:), Ltmp(:,:), work(:), e_im(:)
|
||||
double precision, allocatable :: S(:,:)
|
||||
|
||||
if(verbose) then
|
||||
print*, ' Starting a non-Hermitian diagonalization ...'
|
||||
print*, ' Good Luck ;)'
|
||||
print*, ' imp_bio = ', imp_bio
|
||||
endif
|
||||
|
||||
! ---
|
||||
! diagonalize
|
||||
|
||||
allocate(Atmp(N,N), e_im(N))
|
||||
Atmp(1:N,1:N) = A(1:N,1:N)
|
||||
|
||||
allocate(work(1))
|
||||
lwork = -1
|
||||
call dgeev('V', 'V', N, Atmp, N, e_re, e_im, L, N, A, N, work, lwork, info)
|
||||
if(info .gt. 0) then
|
||||
print*,'dgeev failed !!', info
|
||||
stop
|
||||
endif
|
||||
|
||||
lwork = max(int(work(1)), 1)
|
||||
deallocate(work)
|
||||
allocate(work(lwork))
|
||||
|
||||
call dgeev('V', 'V', N, Atmp, N, e_re, e_im, L, N, A, N, work, lwork, info)
|
||||
if(info .ne. 0) then
|
||||
print*,'dgeev failed !!', info
|
||||
stop
|
||||
endif
|
||||
|
||||
deallocate(Atmp, WORK)
|
||||
|
||||
|
||||
! ---
|
||||
! check if eigenvalues are real
|
||||
|
||||
i = 1
|
||||
ii = 0
|
||||
do while(i .le. N)
|
||||
if(dabs(e_im(i)) .gt. 1.d-12) then
|
||||
ii = ii + 1
|
||||
if(verbose) then
|
||||
print*, ' Warning: complex eigenvalue !'
|
||||
print*, i, e_re(i), e_im(i)
|
||||
if(dabs(e_im(i)/e_re(i)) .lt. 1.d-6) then
|
||||
print*, ' small enouph to be igored'
|
||||
else
|
||||
print*, ' IMAGINARY PART IS SIGNIFANT !!!'
|
||||
endif
|
||||
endif
|
||||
endif
|
||||
i = i + 1
|
||||
enddo
|
||||
|
||||
if(verbose) then
|
||||
if(ii .eq. 0) print*, ' congratulations :) eigenvalues are real-valued !!'
|
||||
endif
|
||||
|
||||
|
||||
! ---
|
||||
! track & sort the real eigenvalues
|
||||
|
||||
allocate(Atmp(N,N), Ltmp(N,N), iorder(N))
|
||||
|
||||
do i = 1, N
|
||||
iorder(i) = i
|
||||
enddo
|
||||
call quick_sort(e_re, iorder, N)
|
||||
|
||||
Atmp(:,:) = A(:,:)
|
||||
Ltmp(:,:) = L(:,:)
|
||||
do i = 1, N
|
||||
do j = 1, N
|
||||
A(j,i) = Atmp(j,iorder(i))
|
||||
L(j,i) = Ltmp(j,iorder(i))
|
||||
enddo
|
||||
enddo
|
||||
|
||||
deallocate(Atmp, Ltmp, iorder)
|
||||
|
||||
|
||||
|
||||
|
||||
! ---
|
||||
! check bi-orthog
|
||||
|
||||
allocate(S(N,N))
|
||||
call check_biorthog(N, N, L, A, accu_d, accu_nd, S, thr_d, thr_nd, .false., verbose)
|
||||
|
||||
if((accu_nd .lt. thr_nd) .and. (dabs(accu_d-dble(N))/dble(N) .lt. thr_d)) then
|
||||
|
||||
if(verbose) then
|
||||
print *, ' lapack vectors are normalized and bi-orthogonalized'
|
||||
endif
|
||||
|
||||
elseif((accu_nd .lt. thr_nd) .and. (dabs(accu_d - dble(N)) .gt. thr_d)) then
|
||||
|
||||
if(verbose) then
|
||||
print *, ' lapack vectors are not normalized but bi-orthogonalized'
|
||||
endif
|
||||
|
||||
call check_biorthog_binormalize(N, N, L, A, thr_d, thr_nd, .true.)
|
||||
call check_biorthog(N, N, L, A, accu_d, accu_nd, S, thr_d, thr_nd, .true., verbose)
|
||||
|
||||
else
|
||||
|
||||
if(verbose) then
|
||||
print *, ' lapack vectors are not normalized neither bi-orthogonalized'
|
||||
endif
|
||||
|
||||
allocate(deg_num(N))
|
||||
call reorder_degen_eigvec(N, thr_deg, deg_num, e_re, L, A)
|
||||
call impose_biorthog_degen_eigvec(N, deg_num, e_re, L, A)
|
||||
deallocate(deg_num)
|
||||
|
||||
call check_biorthog(N, N, L, A, accu_d, accu_nd, S, thr_d, thr_nd, .false., verbose)
|
||||
if((accu_nd .lt. thr_nd) .and. (dabs(accu_d-dble(N))/dble(N) .lt. thr_d)) then
|
||||
if(verbose) then
|
||||
print *, ' lapack vectors are now normalized and bi-orthogonalized'
|
||||
endif
|
||||
elseif((accu_nd .lt. thr_nd) .and. (dabs(accu_d - dble(N)) .gt. thr_d)) then
|
||||
if(verbose) then
|
||||
print *, ' lapack vectors are now not normalized but bi-orthogonalized'
|
||||
endif
|
||||
call check_biorthog_binormalize(N, N, L, A, thr_d, thr_nd, .true.)
|
||||
call check_biorthog(N, N, L, A, accu_d, accu_nd, S, thr_d, thr_nd, .true., verbose)
|
||||
else
|
||||
if(verbose) then
|
||||
print*, ' bi-orthogonalization failed !'
|
||||
endif
|
||||
if(imp_bio) then
|
||||
print*, ' bi-orthogonalization failed !'
|
||||
deallocate(S)
|
||||
stop
|
||||
endif
|
||||
endif
|
||||
|
||||
endif
|
||||
|
||||
deallocate(S)
|
||||
return
|
||||
|
||||
end
|
||||
|
||||
! ---
|
||||
|
||||
subroutine check_biorthog(n, m, Vl, Vr, accu_d, accu_nd, S, thr_d, thr_nd, stop_ifnot, verbose)
|
||||
|
||||
implicit none
|
||||
|
||||
integer, intent(in) :: n, m
|
||||
logical, intent(in) :: stop_ifnot, verbose
|
||||
double precision, intent(in) :: Vl(n,m), Vr(n,m)
|
||||
double precision, intent(in) :: thr_d, thr_nd
|
||||
double precision, intent(out) :: accu_d, accu_nd, S(m,m)
|
||||
|
||||
integer :: i, j
|
||||
double precision, allocatable :: SS(:,:)
|
||||
|
||||
if(verbose) then
|
||||
print *, ' check bi-orthogonality'
|
||||
endif
|
||||
|
||||
! ---
|
||||
|
||||
call dgemm( 'T', 'N', m, m, n, 1.d0 &
|
||||
, Vl, size(Vl, 1), Vr, size(Vr, 1) &
|
||||
, 0.d0, S, size(S, 1) )
|
||||
|
||||
accu_d = 0.d0
|
||||
accu_nd = 0.d0
|
||||
do i = 1, m
|
||||
do j = 1, m
|
||||
if(i==j) then
|
||||
accu_d = accu_d + dabs(S(i,i))
|
||||
else
|
||||
accu_nd = accu_nd + S(j,i) * S(j,i)
|
||||
endif
|
||||
enddo
|
||||
enddo
|
||||
accu_nd = dsqrt(accu_nd) / dble(m)
|
||||
|
||||
if(verbose) then
|
||||
if((accu_nd .gt. thr_nd) .or. dabs(accu_d-dble(m))/dble(m) .gt. thr_d) then
|
||||
print *, ' non bi-orthogonal vectors !'
|
||||
print *, ' accu_nd = ', accu_nd
|
||||
print *, ' accu_d = ', dabs(accu_d-dble(m))/dble(m)
|
||||
else
|
||||
print *, ' vectors are bi-orthogonals'
|
||||
endif
|
||||
endif
|
||||
|
||||
! ---
|
||||
|
||||
if(stop_ifnot .and. ((accu_nd .gt. thr_nd) .or. dabs(accu_d-dble(m))/dble(m) .gt. thr_d)) then
|
||||
print *, ' non bi-orthogonal vectors !'
|
||||
print *, ' accu_nd = ', accu_nd
|
||||
print *, ' accu_d = ', dabs(accu_d-dble(m))/dble(m)
|
||||
stop
|
||||
endif
|
||||
|
||||
end
|
||||
|
||||
! ---
|
||||
|
||||
subroutine check_biorthog_binormalize(n, m, Vl, Vr, thr_d, thr_nd, stop_ifnot)
|
||||
|
||||
implicit none
|
||||
|
||||
integer, intent(in) :: n, m
|
||||
logical, intent(in) :: stop_ifnot
|
||||
double precision, intent(in) :: thr_d, thr_nd
|
||||
double precision, intent(inout) :: Vl(n,m), Vr(n,m)
|
||||
|
||||
integer :: i, j
|
||||
double precision :: accu_d, accu_nd, s_tmp
|
||||
double precision, allocatable :: S(:,:)
|
||||
|
||||
! ---
|
||||
|
||||
allocate(S(m,m))
|
||||
call dgemm( 'T', 'N', m, m, n, 1.d0 &
|
||||
, Vl, size(Vl, 1), Vr, size(Vr, 1) &
|
||||
, 0.d0, S, size(S, 1) )
|
||||
|
||||
do i = 1, m
|
||||
if(S(i,i) .lt. 0.d0) then
|
||||
do j = 1, n
|
||||
Vl(j,i) = -1.d0 * Vl(j,i)
|
||||
enddo
|
||||
S(i,i) = -S(i,i)
|
||||
endif
|
||||
enddo
|
||||
|
||||
accu_d = 0.d0
|
||||
accu_nd = 0.d0
|
||||
do i = 1, m
|
||||
do j = 1, m
|
||||
if(i==j) then
|
||||
accu_d = accu_d + S(i,i)
|
||||
else
|
||||
accu_nd = accu_nd + S(j,i) * S(j,i)
|
||||
endif
|
||||
enddo
|
||||
enddo
|
||||
accu_nd = dsqrt(accu_nd) / dble(m)
|
||||
|
||||
! ---
|
||||
|
||||
if( (accu_nd .lt. thr_nd) .and. (dabs(accu_d-dble(m))/dble(m) .gt. thr_d) ) then
|
||||
|
||||
do i = 1, m
|
||||
if(S(i,i) <= 0.d0) then
|
||||
print *, ' negative overlap !'
|
||||
print *, i, S(i,i)
|
||||
exit
|
||||
endif
|
||||
if(dabs(S(i,i) - 1.d0) .gt. thr_d) then
|
||||
s_tmp = 1.d0 / dsqrt(S(i,i))
|
||||
do j = 1, n
|
||||
Vl(j,i) = Vl(j,i) * s_tmp
|
||||
Vr(j,i) = Vr(j,i) * s_tmp
|
||||
enddo
|
||||
endif
|
||||
|
||||
enddo
|
||||
|
||||
endif
|
||||
|
||||
! ---
|
||||
|
||||
call dgemm( 'T', 'N', m, m, n, 1.d0 &
|
||||
, Vl, size(Vl, 1), Vr, size(Vr, 1) &
|
||||
, 0.d0, S, size(S, 1) )
|
||||
|
||||
accu_d = 0.d0
|
||||
accu_nd = 0.d0
|
||||
do i = 1, m
|
||||
do j = 1, m
|
||||
if(i==j) then
|
||||
accu_d = accu_d + S(i,i)
|
||||
else
|
||||
accu_nd = accu_nd + S(j,i) * S(j,i)
|
||||
endif
|
||||
enddo
|
||||
enddo
|
||||
accu_nd = dsqrt(accu_nd) / dble(m)
|
||||
|
||||
deallocate(S)
|
||||
|
||||
! ---
|
||||
|
||||
if( stop_ifnot .and. ((accu_nd .gt. thr_nd) .or. (dabs(accu_d-dble(m))/dble(m) .gt. thr_d)) ) then
|
||||
print *, accu_nd, thr_nd
|
||||
print *, dabs(accu_d-dble(m))/dble(m), thr_d
|
||||
print *, ' biorthog_binormalize failed !'
|
||||
stop
|
||||
endif
|
||||
|
||||
end
|
||||
|
||||
! ---
|
||||
|
||||
subroutine reorder_degen_eigvec(n, thr_deg, deg_num, e0, L0, R0)
|
||||
|
||||
implicit none
|
||||
|
||||
integer, intent(in) :: n
|
||||
double precision, intent(in) :: thr_deg
|
||||
double precision, intent(inout) :: e0(n), L0(n,n), R0(n,n)
|
||||
integer, intent(out) :: deg_num(n)
|
||||
|
||||
logical :: complex_root
|
||||
integer :: i, j, k, m, ii, j_tmp
|
||||
double precision :: ei, ej, de
|
||||
double precision :: accu_d, accu_nd
|
||||
double precision :: e0_tmp, L0_tmp(n), R0_tmp(n)
|
||||
double precision, allocatable :: L(:,:), R(:,:), S(:,:), S_inv_half(:,:)
|
||||
|
||||
do i = 1, n
|
||||
deg_num(i) = 1
|
||||
enddo
|
||||
|
||||
do i = 1, n-1
|
||||
ei = e0(i)
|
||||
|
||||
! already considered in degen vectors
|
||||
if(deg_num(i) .eq. 0) cycle
|
||||
|
||||
ii = 0
|
||||
do j = i+1, n
|
||||
ej = e0(j)
|
||||
de = dabs(ei - ej)
|
||||
|
||||
if(de .lt. thr_deg) then
|
||||
ii = ii + 1
|
||||
|
||||
j_tmp = i + ii
|
||||
|
||||
deg_num(j_tmp) = 0
|
||||
|
||||
e0_tmp = e0(j_tmp)
|
||||
e0(j_tmp) = e0(j)
|
||||
e0(j) = e0_tmp
|
||||
|
||||
L0_tmp(1:n) = L0(1:n,j_tmp)
|
||||
L0(1:n,j_tmp) = L0(1:n,j)
|
||||
L0(1:n,j) = L0_tmp(1:n)
|
||||
|
||||
R0_tmp(1:n) = R0(1:n,j_tmp)
|
||||
R0(1:n,j_tmp) = R0(1:n,j)
|
||||
R0(1:n,j) = R0_tmp(1:n)
|
||||
endif
|
||||
enddo
|
||||
|
||||
deg_num(i) = ii + 1
|
||||
enddo
|
||||
|
||||
ii = 0
|
||||
do i = 1, n
|
||||
if(deg_num(i) .gt. 1) then
|
||||
ii = ii + 1
|
||||
endif
|
||||
enddo
|
||||
|
||||
if(ii .eq. 0) then
|
||||
print*, ' WARNING: bi-orthogonality is lost but there is no degeneracies'
|
||||
print*, ' rotations may change energy'
|
||||
stop
|
||||
endif
|
||||
|
||||
end
|
||||
|
||||
! ---
|
||||
|
||||
subroutine impose_biorthog_degen_eigvec(n, deg_num, e0, L0, R0)
|
||||
|
||||
implicit none
|
||||
|
||||
integer, intent(in) :: n, deg_num(n)
|
||||
double precision, intent(in) :: e0(n)
|
||||
double precision, intent(inout) :: L0(n,n), R0(n,n)
|
||||
|
||||
logical :: complex_root
|
||||
integer :: i, j, k, m
|
||||
double precision :: ei, ej, de
|
||||
double precision :: accu_d, accu_nd
|
||||
double precision, allocatable :: L(:,:), R(:,:), S(:,:), S_inv_half(:,:)
|
||||
|
||||
!do i = 1, n
|
||||
! if(deg_num(i) .gt. 1) then
|
||||
! print *, ' degen on', i, deg_num(i), e0(i)
|
||||
! endif
|
||||
!enddo
|
||||
|
||||
! ---
|
||||
|
||||
do i = 1, n
|
||||
m = deg_num(i)
|
||||
|
||||
if(m .gt. 1) then
|
||||
|
||||
allocate(L(n,m), R(n,m), S(m,m))
|
||||
|
||||
do j = 1, m
|
||||
L(1:n,j) = L0(1:n,i+j-1)
|
||||
R(1:n,j) = R0(1:n,i+j-1)
|
||||
enddo
|
||||
|
||||
! ---
|
||||
|
||||
call dgemm( 'T', 'N', m, m, n, 1.d0 &
|
||||
, L, size(L, 1), R, size(R, 1) &
|
||||
, 0.d0, S, size(S, 1) )
|
||||
|
||||
accu_nd = 0.d0
|
||||
do j = 1, m
|
||||
do k = 1, m
|
||||
if(j==k) cycle
|
||||
accu_nd = accu_nd + dabs(S(j,k))
|
||||
enddo
|
||||
enddo
|
||||
|
||||
if(accu_nd .lt. 1d-12) then
|
||||
deallocate(S, L, R)
|
||||
cycle
|
||||
endif
|
||||
|
||||
call impose_biorthog_svd(n, m, L, R)
|
||||
|
||||
call dgemm( 'T', 'N', m, m, n, 1.d0 &
|
||||
, L, size(L, 1), R, size(R, 1) &
|
||||
, 0.d0, S, size(S, 1) )
|
||||
accu_nd = 0.d0
|
||||
do j = 1, m
|
||||
do k = 1, m
|
||||
if(j==k) cycle
|
||||
accu_nd = accu_nd + dabs(S(j,k))
|
||||
enddo
|
||||
enddo
|
||||
if(accu_nd .gt. 1d-12) then
|
||||
print*, ' accu_nd =', accu_nd
|
||||
print*, ' your strategy for degenerates orbitals failed !'
|
||||
print*, m, 'deg on', i
|
||||
stop
|
||||
endif
|
||||
|
||||
deallocate(S)
|
||||
|
||||
! ---
|
||||
|
||||
do j = 1, m
|
||||
L0(1:n,i+j-1) = L(1:n,j)
|
||||
R0(1:n,i+j-1) = R(1:n,j)
|
||||
enddo
|
||||
|
||||
deallocate(L, R)
|
||||
|
||||
endif
|
||||
enddo
|
||||
|
||||
end
|
||||
|
||||
! ---
|
||||
|
||||
subroutine impose_biorthog_svd(n, m, L, R)
|
||||
|
||||
implicit none
|
||||
|
||||
integer, intent(in) :: n, m
|
||||
double precision, intent(inout) :: L(n,m), R(n,m)
|
||||
|
||||
integer :: i, j, num_linear_dependencies
|
||||
double precision :: threshold
|
||||
double precision, allocatable :: S(:,:), tmp(:,:)
|
||||
double precision, allocatable :: U(:,:), V(:,:), Vt(:,:), D(:)
|
||||
|
||||
allocate(S(m,m))
|
||||
|
||||
call dgemm( 'T', 'N', m, m, n, 1.d0 &
|
||||
, L, size(L, 1), R, size(R, 1) &
|
||||
, 0.d0, S, size(S, 1) )
|
||||
|
||||
! ---
|
||||
|
||||
allocate(U(m,m), Vt(m,m), D(m))
|
||||
|
||||
call svd(S, m, U, m, D, Vt, m, m, m)
|
||||
|
||||
deallocate(S)
|
||||
|
||||
threshold = 1.d-6
|
||||
num_linear_dependencies = 0
|
||||
do i = 1, m
|
||||
if(abs(D(i)) <= threshold) then
|
||||
D(i) = 0.d0
|
||||
num_linear_dependencies = num_linear_dependencies + 1
|
||||
else
|
||||
D(i) = 1.d0 / dsqrt(D(i))
|
||||
endif
|
||||
enddo
|
||||
if(num_linear_dependencies > 0) then
|
||||
write(*,*) ' linear dependencies = ', num_linear_dependencies
|
||||
write(*,*) ' m = ', m
|
||||
stop
|
||||
endif
|
||||
|
||||
allocate(V(m,m))
|
||||
do i = 1, m
|
||||
do j = 1, m
|
||||
V(j,i) = Vt(i,j)
|
||||
enddo
|
||||
enddo
|
||||
deallocate(Vt)
|
||||
|
||||
! ---
|
||||
|
||||
! R <-- R x V x D^{-0.5}
|
||||
! L <-- L x U x D^{-0.5}
|
||||
|
||||
do i = 1, m
|
||||
do j = 1, m
|
||||
V(j,i) = V(j,i) * D(i)
|
||||
U(j,i) = U(j,i) * D(i)
|
||||
enddo
|
||||
enddo
|
||||
|
||||
allocate(tmp(n,m))
|
||||
tmp(:,:) = R(:,:)
|
||||
call dgemm( 'N', 'N', n, m, m, 1.d0 &
|
||||
, tmp, size(tmp, 1), V, size(V, 1) &
|
||||
, 0.d0, R, size(R, 1))
|
||||
|
||||
tmp(:,:) = L(:,:)
|
||||
call dgemm( 'N', 'N', n, m, m, 1.d0 &
|
||||
, tmp, size(tmp, 1), U, size(U, 1) &
|
||||
, 0.d0, L, size(L, 1))
|
||||
|
||||
deallocate(tmp, U, V, D)
|
||||
|
||||
end
|
||||
|
||||
! ---
|
||||
|
||||
@ -1,4 +1,7 @@
|
||||
subroutine orthogonalization_matrix(nBas,S,X)
|
||||
|
||||
! ---
|
||||
|
||||
subroutine orthogonalization_matrix(nBas, S, X)
|
||||
|
||||
! Compute the orthogonalization matrix X
|
||||
|
||||
@ -35,14 +38,32 @@ subroutine orthogonalization_matrix(nBas,S,X)
|
||||
|
||||
if(ortho_type == 1) then
|
||||
|
||||
!
|
||||
! S V = V s where
|
||||
!
|
||||
! V.T V = 1 and s > 0 (S is positive def)
|
||||
!
|
||||
! S = V s V.T
|
||||
! = V s^0.5 s^0.5 V.T
|
||||
! = V s^0.5 V.T V s^0.5 V.T
|
||||
! = S^0.5 S^0.5
|
||||
!
|
||||
! where
|
||||
!
|
||||
! S^0.5 = V s^0.5 V.T
|
||||
!
|
||||
! X = S^(-0.5)
|
||||
! = V s^(-0.5) V.T
|
||||
!
|
||||
|
||||
! write(*,*)
|
||||
! write(*,*) ' Lowdin orthogonalization'
|
||||
! write(*,*)
|
||||
|
||||
Uvec = S
|
||||
call diagonalize_matrix(nBas,Uvec,Uval)
|
||||
call diagonalize_matrix(nBas, Uvec, Uval)
|
||||
|
||||
do i=1,nBas
|
||||
do i = 1, nBas
|
||||
|
||||
if(Uval(i) < thresh) then
|
||||
|
||||
@ -50,11 +71,11 @@ subroutine orthogonalization_matrix(nBas,S,X)
|
||||
|
||||
end if
|
||||
|
||||
Uval(i) = 1d0/sqrt(Uval(i))
|
||||
Uval(i) = 1d0 / dsqrt(Uval(i))
|
||||
|
||||
end do
|
||||
|
||||
call ADAt(nBas,Uvec,Uval,X)
|
||||
call ADAt(nBas, Uvec(1,1), Uval(1), X(1,1))
|
||||
|
||||
elseif(ortho_type == 2) then
|
||||
|
||||
@ -63,13 +84,13 @@ subroutine orthogonalization_matrix(nBas,S,X)
|
||||
! write(*,*)
|
||||
|
||||
Uvec = S
|
||||
call diagonalize_matrix(nBas,Uvec,Uval)
|
||||
call diagonalize_matrix(nBas, Uvec, Uval)
|
||||
|
||||
do i=1,nBas
|
||||
do i = 1, nBas
|
||||
|
||||
if(Uval(i) > thresh) then
|
||||
|
||||
Uval(i) = 1d0/sqrt(Uval(i))
|
||||
Uval(i) = 1d0 / dsqrt(Uval(i))
|
||||
|
||||
else
|
||||
|
||||
@ -79,7 +100,7 @@ subroutine orthogonalization_matrix(nBas,S,X)
|
||||
|
||||
end do
|
||||
|
||||
call AD(nBas,Uvec,Uval)
|
||||
call AD(nBas, Uvec, Uval)
|
||||
X = Uvec
|
||||
|
||||
elseif(ortho_type == 3) then
|
||||
@ -117,3 +138,6 @@ subroutine orthogonalization_matrix(nBas,S,X)
|
||||
end if
|
||||
|
||||
end subroutine
|
||||
|
||||
! ---
|
||||
|
||||
|
||||
@ -21,13 +21,13 @@ subroutine read_basis_pyscf(nBas,nO,nV)
|
||||
!------------------------------------------------------------------------
|
||||
|
||||
open(unit=3,file='int/nBas.dat')
|
||||
read(3,*) nBas
|
||||
read(3, *) nBas
|
||||
close(unit=3)
|
||||
|
||||
write(*,'(A28)') '------------------'
|
||||
write(*,'(A28,1X,I16)') 'Number of basis functions',nBas
|
||||
write(*,'(A28)') '------------------'
|
||||
write(*,*)
|
||||
! write(*,'(A38)') '--------------------------------------'
|
||||
! write(*,'(A38,1X,I16)') 'Number of basis functions (AOs)', nBas
|
||||
! write(*,'(A38)') '--------------------------------------'
|
||||
! write(*,*)
|
||||
|
||||
! Number of virtual orbitals
|
||||
|
||||
|
||||
@ -1,4 +1,4 @@
|
||||
subroutine read_integrals(nBas,S,T,V,Hc,G)
|
||||
subroutine read_integrals(nBas_AOs, S, T, V, Hc, G)
|
||||
|
||||
! Read one- and two-electron integrals from files
|
||||
|
||||
@ -7,7 +7,7 @@ subroutine read_integrals(nBas,S,T,V,Hc,G)
|
||||
|
||||
! Input variables
|
||||
|
||||
integer,intent(in) :: nBas
|
||||
integer,intent(in) :: nBas_AOs
|
||||
|
||||
! Local variables
|
||||
|
||||
@ -18,11 +18,11 @@ subroutine read_integrals(nBas,S,T,V,Hc,G)
|
||||
|
||||
! Output variables
|
||||
|
||||
double precision,intent(out) :: S(nBas,nBas)
|
||||
double precision,intent(out) :: T(nBas,nBas)
|
||||
double precision,intent(out) :: V(nBas,nBas)
|
||||
double precision,intent(out) :: Hc(nBas,nBas)
|
||||
double precision,intent(out) :: G(nBas,nBas,nBas,nBas)
|
||||
double precision,intent(out) :: S(nBas_AOs,nBas_AOs)
|
||||
double precision,intent(out) :: T(nBas_AOs,nBas_AOs)
|
||||
double precision,intent(out) :: V(nBas_AOs,nBas_AOs)
|
||||
double precision,intent(out) :: Hc(nBas_AOs,nBas_AOs)
|
||||
double precision,intent(out) :: G(nBas_AOs,nBas_AOs,nBas_AOs,nBas_AOs)
|
||||
|
||||
! Open file with integrals
|
||||
|
||||
@ -35,7 +35,6 @@ subroutine read_integrals(nBas,S,T,V,Hc,G)
|
||||
open(unit=8 ,file='int/Ov.dat')
|
||||
open(unit=9 ,file='int/Kin.dat')
|
||||
open(unit=10,file='int/Nuc.dat')
|
||||
open(unit=11,file='int/ERI.dat')
|
||||
|
||||
open(unit=21,file='int/x.dat')
|
||||
open(unit=22,file='int/y.dat')
|
||||
@ -75,31 +74,29 @@ subroutine read_integrals(nBas,S,T,V,Hc,G)
|
||||
|
||||
Hc(:,:) = T(:,:) + V(:,:)
|
||||
|
||||
! Read nuclear integrals
|
||||
! Read 2e-integrals
|
||||
|
||||
G(:,:,:,:) = 0d0
|
||||
do
|
||||
read(11,*,end=11) mu,nu,la,si,ERI
|
||||
! ! formatted file
|
||||
! open(unit=11, file='int/ERI.dat')
|
||||
! G(:,:,:,:) = 0d0
|
||||
! do
|
||||
! read(11,*,end=11) mu, nu, la, si, ERI
|
||||
! ERI = lambda*ERI
|
||||
! G(mu,nu,la,si) = ERI ! <12|34>
|
||||
! G(la,nu,mu,si) = ERI ! <32|14>
|
||||
! G(mu,si,la,nu) = ERI ! <14|32>
|
||||
! G(la,si,mu,nu) = ERI ! <34|12>
|
||||
! G(si,mu,nu,la) = ERI ! <41|23>
|
||||
! G(nu,la,si,mu) = ERI ! <23|41>
|
||||
! G(nu,mu,si,la) = ERI ! <21|43>
|
||||
! G(si,la,nu,mu) = ERI ! <43|21>
|
||||
! end do
|
||||
! 11 close(unit=11)
|
||||
|
||||
ERI = lambda*ERI
|
||||
! <12|34>
|
||||
G(mu,nu,la,si) = ERI
|
||||
! <32|14>
|
||||
G(la,nu,mu,si) = ERI
|
||||
! <14|32>
|
||||
G(mu,si,la,nu) = ERI
|
||||
! <34|12>
|
||||
G(la,si,mu,nu) = ERI
|
||||
! <41|23>
|
||||
G(si,mu,nu,la) = ERI
|
||||
! <23|41>
|
||||
G(nu,la,si,mu) = ERI
|
||||
! <21|43>
|
||||
G(nu,mu,si,la) = ERI
|
||||
! <43|21>
|
||||
G(si,la,nu,mu) = ERI
|
||||
end do
|
||||
11 close(unit=11)
|
||||
! binary file
|
||||
open(unit=11, file='int/ERI.bin', form='unformatted', access='stream')
|
||||
read(11) G
|
||||
close(11)
|
||||
|
||||
|
||||
! Print results
|
||||
@ -107,24 +104,24 @@ subroutine read_integrals(nBas,S,T,V,Hc,G)
|
||||
write(*,'(A28)') '----------------------'
|
||||
write(*,'(A28)') 'Overlap integrals'
|
||||
write(*,'(A28)') '----------------------'
|
||||
call matout(nBas,nBas,S)
|
||||
call matout(nBas_AOs,nBas_AOs,S)
|
||||
write(*,*)
|
||||
write(*,'(A28)') '----------------------'
|
||||
write(*,'(A28)') 'Kinetic integrals'
|
||||
write(*,'(A28)') '----------------------'
|
||||
call matout(nBas,nBas,T)
|
||||
call matout(nBas_AOs,nBas_AOs,T)
|
||||
write(*,*)
|
||||
write(*,'(A28)') '----------------------'
|
||||
write(*,'(A28)') 'Nuclear integrals'
|
||||
write(*,'(A28)') '----------------------'
|
||||
call matout(nBas,nBas,V)
|
||||
call matout(nBas_AOs,nBas_AOs,V)
|
||||
write(*,*)
|
||||
write(*,'(A28)') '----------------------'
|
||||
write(*,'(A28)') 'Electron repulsion integrals'
|
||||
write(*,'(A28)') '----------------------'
|
||||
do la=1,nBas
|
||||
do si=1,nBas
|
||||
call matout(nBas,nBas,G(1,1,la,si))
|
||||
do la=1,nBas_AOs
|
||||
do si=1,nBas_AOs
|
||||
call matout(nBas_AOs, nBas_AOs, G(1,1,la,si))
|
||||
end do
|
||||
end do
|
||||
write(*,*)
|
||||
|
||||
@ -65,7 +65,7 @@ subroutine diagonal_matrix(N,D,A)
|
||||
end subroutine
|
||||
|
||||
!------------------------------------------------------------------------
|
||||
subroutine matrix_exponential(N,A,ExpA)
|
||||
subroutine matrix_exponential(N, A, ExpA)
|
||||
|
||||
! Compute Exp(A)
|
||||
|
||||
@ -81,7 +81,7 @@ subroutine matrix_exponential(N,A,ExpA)
|
||||
|
||||
! Memory allocation
|
||||
|
||||
allocate(W(N,N),tau(N),t(N,N))
|
||||
allocate(W(N,N), tau(N), t(N,N))
|
||||
|
||||
! Initialize
|
||||
|
||||
@ -89,8 +89,8 @@ subroutine matrix_exponential(N,A,ExpA)
|
||||
|
||||
! Diagonalize
|
||||
|
||||
W(:,:) = - matmul(A,A)
|
||||
call diagonalize_matrix(N,W,tau)
|
||||
W(:,:) = - matmul(A, A)
|
||||
call diagonalize_matrix(N, W, tau)
|
||||
|
||||
! do i=1,N
|
||||
! tau(i) = max(abs(tau(i)),1d-14)
|
||||
@ -99,16 +99,18 @@ subroutine matrix_exponential(N,A,ExpA)
|
||||
|
||||
! Construct cos part
|
||||
|
||||
call diagonal_matrix(N,cos(tau),t)
|
||||
t(:,:) = matmul(t,transpose(W))
|
||||
ExpA(:,:) = ExpA(:,:) + matmul(W,t)
|
||||
call diagonal_matrix(N, cos(tau), t)
|
||||
t(:,:) = matmul(t, transpose(W))
|
||||
ExpA(:,:) = ExpA(:,:) + matmul(W, t)
|
||||
|
||||
! Construct sin part
|
||||
|
||||
call diagonal_matrix(N,sin(tau)/tau,t)
|
||||
t(:,:) = matmul(t,transpose(W))
|
||||
t(:,:) = matmul(t,A)
|
||||
ExpA(:,:) = ExpA(:,:) + matmul(W,t)
|
||||
call diagonal_matrix(N, sin(tau)/tau, t)
|
||||
t(:,:) = matmul(t, transpose(W))
|
||||
t(:,:) = matmul(t, A)
|
||||
ExpA(:,:) = ExpA(:,:) + matmul(W, t)
|
||||
|
||||
deallocate(W, tau, t)
|
||||
|
||||
end subroutine
|
||||
|
||||
@ -375,15 +377,29 @@ subroutine ADAt(N,A,D,B)
|
||||
|
||||
double precision,intent(out) :: B(N,N)
|
||||
|
||||
B = 0d0
|
||||
double precision, allocatable :: tmp(:,:)
|
||||
|
||||
do i=1,N
|
||||
do j=1,N
|
||||
do k=1,N
|
||||
B(i,k) = B(i,k) + A(i,j)*D(j)*A(k,j)
|
||||
end do
|
||||
end do
|
||||
end do
|
||||
allocate(tmp(N,N))
|
||||
!$OMP PARALLEL DEFAULT(NONE) PRIVATE(i, j) SHARED(N, A, D, tmp)
|
||||
!$OMP DO
|
||||
do i = 1, N
|
||||
do j = 1, N
|
||||
tmp(i,j) = D(i) * A(j,i)
|
||||
enddo
|
||||
enddo
|
||||
!$OMP END DO
|
||||
!$OMP END PARALLEL
|
||||
call dgemm("N", "N", N, N, N, 1.d0, A(1,1), N, tmp(1,1), N, 0.d0, B(1,1), N)
|
||||
deallocate(tmp)
|
||||
|
||||
! B = 0d0
|
||||
! do i=1,N
|
||||
! do j=1,N
|
||||
! do k=1,N
|
||||
! B(i,k) = B(i,k) + A(i,j)*D(j)*A(k,j)
|
||||
! end do
|
||||
! end do
|
||||
! end do
|
||||
|
||||
end subroutine
|
||||
!------------------------------------------------------------------------
|
||||
|
||||
@ -31,6 +31,8 @@ subroutine diagonalize_general_matrix(N,A,WR,VR)
|
||||
|
||||
call dgeev('V','V',N,A,N,WR,WI,VL,N,VR,N,work,lwork,info)
|
||||
|
||||
deallocate(work, WI, VL)
|
||||
|
||||
if(info /= 0) then
|
||||
print*,'Problem in diagonalize_general_matrix (dgeev)!!'
|
||||
end if
|
||||
@ -67,6 +69,8 @@ subroutine diagonalize_matrix(N,A,e)
|
||||
allocate(work(lwork))
|
||||
|
||||
call dsyev('V','U',N,A,N,e,work,lwork,info)
|
||||
|
||||
deallocate(work)
|
||||
|
||||
if(info /= 0) then
|
||||
print*,'Problem in diagonalize_matrix (dsyev)!!'
|
||||
|
||||
26
test/export_tobench.py
Normal file
26
test/export_tobench.py
Normal file
@ -0,0 +1,26 @@
|
||||
|
||||
import sys
|
||||
|
||||
|
||||
def read_quantities_from_file(filename):
|
||||
quantities = {}
|
||||
|
||||
with open(filename, 'r') as file:
|
||||
lines = file.readlines()
|
||||
for i in range(0, len(lines), 2):
|
||||
# Remove any leading or trailing whitespace/newline characters
|
||||
quantity_name = lines[i].strip()
|
||||
quantity_value = float(lines[i+1].strip())
|
||||
quantities[quantity_name] = quantity_value
|
||||
|
||||
return quantities
|
||||
|
||||
def print_quantities(quantities):
|
||||
for key, value in quantities.items():
|
||||
print(f'"{key}": {value},')
|
||||
|
||||
filename = sys.argv[1]
|
||||
|
||||
quantities = read_quantities_from_file(filename)
|
||||
print_quantities(quantities)
|
||||
|
||||
7
tests/.gitignore
vendored
Normal file
7
tests/.gitignore
vendored
Normal file
@ -0,0 +1,7 @@
|
||||
|
||||
FeatherBench.db
|
||||
FeatherBench.json
|
||||
|
||||
*.xyz
|
||||
work
|
||||
|
||||
0
tests/balance_bench.py
Normal file
0
tests/balance_bench.py
Normal file
52
tests/create_database.py
Normal file
52
tests/create_database.py
Normal file
@ -0,0 +1,52 @@
|
||||
|
||||
import argparse
|
||||
|
||||
from molecule import save_molecules_to_json, load_molecules_from_json
|
||||
from molecule import create_database, add_molecule_to_db, remove_database
|
||||
|
||||
from feather_bench import FeatherBench
|
||||
|
||||
|
||||
parser = argparse.ArgumentParser(description="Benchmark Data Sets")
|
||||
|
||||
parser.add_argument(
|
||||
'-s', '--set_type',
|
||||
choices=['light', 'medium', 'heavy'],
|
||||
default='light',
|
||||
help="Specify the type of data set: light (default), medium, or heavy."
|
||||
)
|
||||
|
||||
|
||||
args = parser.parse_args()
|
||||
|
||||
if args.set_type == 'light':
|
||||
bench = 'FeatherBench'
|
||||
bench_title = "\n\nSelected Light Benchmark: {}\n\n".format(bench)
|
||||
elif args.set_type == 'medium':
|
||||
bench = 'BalanceBench'
|
||||
bench_title = "\n\nSelected Medium Benchmark: {}\n\n".format(bench)
|
||||
elif args.set_type == 'heavy':
|
||||
bench = 'TitanBench'
|
||||
bench_title = "\n\nSelected Heavy Benchmark: {}\n\n".format(bench)
|
||||
else:
|
||||
bench_title = "\n\nSelected Light Benchmark: {}\n\n".format(bench)
|
||||
|
||||
|
||||
db_name = '{}.db'.format(bench)
|
||||
|
||||
|
||||
# Save molecules to JSON
|
||||
#save_molecules_to_json(FeatherBench, 'FeatherBench.json')
|
||||
|
||||
# Load molecules from JSON
|
||||
#loaded_molecules = load_molecules_from_json('FeatherBench.json')
|
||||
#print(loaded_molecules)
|
||||
|
||||
#remove_database(db_name)
|
||||
|
||||
create_database(db_name)
|
||||
for molecule in FeatherBench:
|
||||
add_molecule_to_db(db_name, molecule)
|
||||
|
||||
|
||||
|
||||
113
tests/feather_bench.py
Normal file
113
tests/feather_bench.py
Normal file
@ -0,0 +1,113 @@
|
||||
|
||||
from molecule import Molecule
|
||||
|
||||
|
||||
He = Molecule(
|
||||
name="He",
|
||||
multiplicity=1,
|
||||
geometry=[
|
||||
{"element": "He", "x": 0.0, "y": 0.0, "z": 0.0}
|
||||
],
|
||||
properties={
|
||||
"properties_rhf":{
|
||||
"6-31g": {
|
||||
"RHF energy": -2.855160426154444,
|
||||
"RHF HOMO energy": -0.914126628640145,
|
||||
"RHF LUMO energy": 1.399859335255765,
|
||||
"RHF dipole moment": 0.0,
|
||||
"MP2 correlation energy": -0.011200122909934,
|
||||
"CCD correlation energy": -0.014985063116,
|
||||
"CCSD correlation energy": -0.015001711549092,
|
||||
"drCCD correlation energy": -0.01884537385338,
|
||||
"rCCD correlation energy": -0.016836322809386,
|
||||
"crCCD correlation energy": 0.008524676641474,
|
||||
"lCCD correlation energy": -0.00808242082105,
|
||||
"CIS singlet excitation energy": 1.911193619991987,
|
||||
"CIS triplet excitation energy": 1.455852629458543,
|
||||
"phRPA correlation energy": -0.018845374128748,
|
||||
"phRPAx correlation energy": -0.015760565120758,
|
||||
"crRPA correlation energy": -0.008868581132249,
|
||||
"ppRPA correlation energy": -0.008082420814972,
|
||||
"G0F2 correlation energy": -0.011438430540104,
|
||||
"G0F2 HOMO energy": -0.882696116274599,
|
||||
"G0F2 LUMO energy": 1.383080391842522,
|
||||
"G0W0 correlation energy": -0.019314094399372,
|
||||
"G0W0 HOMO energy": -0.87053388021722,
|
||||
"G0W0 LUMO energy": 1.377171287041735,
|
||||
"evGW correlation energy": -0.019335511771337,
|
||||
"evGW HOMO energy": -0.868460640984803,
|
||||
"evGW LUMO energy": 1.376287581502582,
|
||||
"G0T0pp correlation energy": -0.008161908540634,
|
||||
"G0T0pp HOMO energy": -0.898869172597701,
|
||||
"G0T0pp LUMO energy": 1.383928087417952,
|
||||
}
|
||||
},
|
||||
"properties_uhf":{
|
||||
"6-31g": {
|
||||
}
|
||||
},
|
||||
"properties_ghf":{
|
||||
"6-31g": {
|
||||
}
|
||||
},
|
||||
}
|
||||
)
|
||||
|
||||
# ---
|
||||
|
||||
H2O = Molecule(
|
||||
name="H2O",
|
||||
multiplicity=1,
|
||||
geometry=[
|
||||
{"element": "O", "x": 0.0000, "y": 0.0000, "z": 0.0000},
|
||||
{"element": "H", "x": 0.7571, "y": 0.0000, "z": 0.5861},
|
||||
{"element": "H", "x": -0.7571, "y": 0.0000, "z": 0.5861}
|
||||
],
|
||||
properties={
|
||||
"properties_rhf":{
|
||||
"cc-pvdz": {
|
||||
"RHF energy": -85.21935817501823,
|
||||
"RHF HOMO energy": -0.493132793449897,
|
||||
"RHF LUMO energy": 0.185534869842355,
|
||||
"RHF dipole moment": 0.233813698748474,
|
||||
"MP2 correlation energy": -0.203978216774657,
|
||||
"CCD correlation energy": -0.212571260121257,
|
||||
"CCSD correlation energy": -0.213302190845899,
|
||||
"drCCD correlation energy": -0.231281853419338,
|
||||
"rCCD correlation energy": -0.277238348710547,
|
||||
"crCCD correlation energy": 0.18014617422324,
|
||||
"lCCD correlation energy": -0.15128653432796,
|
||||
"CIS singlet excitation energy": 0.338828950934568,
|
||||
"CIS triplet excitation energy": 0.304873339484139,
|
||||
"phRPA correlation energy": -0.231281866582435,
|
||||
"phRPAx correlation energy": -0.310796738307943,
|
||||
"crRPA correlation energy": -0.246289801609294,
|
||||
"ppRPA correlation energy": -0.151286536255888,
|
||||
"G0F2 correlation energy": -0.217807591229668,
|
||||
"G0F2 HOMO energy": -0.404541451101377,
|
||||
"G0F2 LUMO energy": 0.16650398400197,
|
||||
"G0W0 correlation energy": -0.23853664665404,
|
||||
"G0W0 HOMO energy": -0.446828623007469,
|
||||
"G0W0 LUMO energy": 0.173026609033024,
|
||||
"evGW correlation energy": -0.239414217281308,
|
||||
"evGW HOMO energy": -0.443076613314424,
|
||||
"evGW LUMO energy": 0.172691758111392,
|
||||
"G0T0pp correlation energy": -0.156214864467344,
|
||||
"G0T0pp HOMO energy": -0.452117482732615,
|
||||
"G0T0pp LUMO energy": 0.16679206983464,
|
||||
}
|
||||
}
|
||||
}
|
||||
)
|
||||
|
||||
# ---
|
||||
|
||||
FeatherBench = [
|
||||
He,
|
||||
H2O
|
||||
]
|
||||
|
||||
|
||||
|
||||
|
||||
|
||||
22
tests/inp/methods.RHF
Normal file
22
tests/inp/methods.RHF
Normal file
@ -0,0 +1,22 @@
|
||||
# RHF UHF GHF ROHF
|
||||
T F F F
|
||||
# MP2 MP3
|
||||
T T
|
||||
# CCD pCCD DCD CCSD CCSD(T)
|
||||
T F F T F
|
||||
# drCCD rCCD crCCD lCCD
|
||||
T T T T
|
||||
# CIS CIS(D) CID CISD FCI
|
||||
T F F F F
|
||||
# phRPA phRPAx crRPA ppRPA
|
||||
T T T T
|
||||
# G0F2 evGF2 qsGF2 ufGF2 G0F3 evGF3
|
||||
T F F F F F
|
||||
# G0W0 evGW qsGW SRG-qsGW ufG0W0 ufGW
|
||||
T T F F F F
|
||||
# G0T0pp evGTpp qsGTpp ufG0T0pp
|
||||
T F F F
|
||||
# G0T0eh evGTeh qsGTeh
|
||||
F F F
|
||||
# Rtest Utest Gtest
|
||||
T F F
|
||||
18
tests/inp/options.RHF
Normal file
18
tests/inp/options.RHF
Normal file
@ -0,0 +1,18 @@
|
||||
# HF: maxSCF thresh DIIS guess mix shift stab search
|
||||
10000 0.0000001 5 1 0.0 0.0 F F
|
||||
# MP: reg
|
||||
F
|
||||
# CC: maxSCF thresh DIIS
|
||||
64 0.0000001 5
|
||||
# spin: TDA singlet triplet
|
||||
F T T
|
||||
# GF: maxSCF thresh DIIS lin eta renorm reg
|
||||
256 0.00001 5 F 0.0 0 F
|
||||
# GW: maxSCF thresh DIIS lin eta TDA_W reg
|
||||
256 0.00001 5 F 0.0 F F
|
||||
# GT: maxSCF thresh DIIS lin eta TDA_T reg
|
||||
256 0.00001 5 F 0.0 F F
|
||||
# ACFDT: AC Kx XBS
|
||||
F F T
|
||||
# BSE: phBSE phBSE2 ppBSE dBSE dTDA
|
||||
F F F F T
|
||||
246
tests/lunch_bench.py
Normal file
246
tests/lunch_bench.py
Normal file
@ -0,0 +1,246 @@
|
||||
|
||||
import time
|
||||
import threading
|
||||
import sys
|
||||
import os
|
||||
import shutil
|
||||
from pathlib import Path
|
||||
import subprocess
|
||||
import platform
|
||||
from datetime import datetime
|
||||
import argparse
|
||||
|
||||
from molecule import get_molecules_from_db
|
||||
from molecule import generate_xyz
|
||||
from utils import print_col, stdout_col
|
||||
|
||||
|
||||
current_date = datetime.now()
|
||||
|
||||
quack_root = os.getenv('QUACK_ROOT')
|
||||
|
||||
# User Name
|
||||
user_name = os.getlogin()
|
||||
|
||||
# Operating System
|
||||
os_name = platform.system()
|
||||
os_release = platform.release()
|
||||
os_version = platform.version()
|
||||
|
||||
# CPU Information
|
||||
machine = platform.machine()
|
||||
processor = platform.processor()
|
||||
|
||||
# System Architecture
|
||||
architecture = platform.architecture()[0]
|
||||
|
||||
# Python Version
|
||||
python_version_full = platform.python_version_tuple()
|
||||
PYTHON_VERSION = "{}.{}".format(python_version_full[0], python_version_full[1])
|
||||
|
||||
|
||||
|
||||
print(f"The current date and time is {current_date.strftime('%Y-%m-%d %H:%M:%S')}")
|
||||
print(f"User Name: {user_name}")
|
||||
print(f"Operating System: {os_name} {os_release} ({os_version})")
|
||||
print(f"CPU: {processor} ({machine})")
|
||||
print(f"System Architecture: {architecture}")
|
||||
print(f"QUACK_ROOT: {quack_root}")
|
||||
print(f"Python version: {python_version_full}\n\n")
|
||||
|
||||
|
||||
parser = argparse.ArgumentParser(description="Benchmark Data Sets")
|
||||
|
||||
parser.add_argument(
|
||||
'-s', '--set_type',
|
||||
choices=['light', 'medium', 'heavy'],
|
||||
default='light',
|
||||
help="Specify the type of data set: light (default), medium, or heavy."
|
||||
)
|
||||
parser.add_argument(
|
||||
'-t', '--thresh',
|
||||
type=float,
|
||||
default=1e-7,
|
||||
help='Threshold for acceptable difference (default: 1e-8)'
|
||||
)
|
||||
|
||||
|
||||
|
||||
|
||||
|
||||
args = parser.parse_args()
|
||||
|
||||
THRESH = args.thresh
|
||||
|
||||
if args.set_type == 'light':
|
||||
bench = 'FeatherBench'
|
||||
bench_title = "\n\nSelected Light Benchmark: {}\n\n".format(bench)
|
||||
elif args.set_type == 'medium':
|
||||
bench = 'BalanceBench'
|
||||
bench_title = "\n\nSelected Medium Benchmark: {}\n\n".format(bench)
|
||||
elif args.set_type == 'heavy':
|
||||
bench = 'TitanBench'
|
||||
bench_title = "\n\nSelected Heavy Benchmark: {}\n\n".format(bench)
|
||||
else:
|
||||
bench_title = "\n\nSelected Light Benchmark: {}\n\n".format(bench)
|
||||
|
||||
print(bench_title.center(150, '-'))
|
||||
print("\n\n")
|
||||
|
||||
# ---
|
||||
|
||||
class Quack_Job:
|
||||
|
||||
def __init__(self, mol, multip, basis, geom, methd):
|
||||
self.mol = mol
|
||||
self.multip = multip
|
||||
self.basis = basis
|
||||
self.geom = geom
|
||||
self.methd = methd
|
||||
|
||||
def prep_inp(self):
|
||||
|
||||
# geometry
|
||||
generate_xyz(self.geom, filename="{}/mol/{}.xyz".format(quack_root, self.mol))
|
||||
|
||||
# input files
|
||||
for inp in ["methods", "options"]:
|
||||
inp_file = "{}.{}".format(inp, self.methd.upper())
|
||||
if os.path.exists("inp/{}".format(inp_file)):
|
||||
shutil.copy("{}/tests/inp/{}".format(quack_root, inp_file),
|
||||
"{}/input/{}".format(quack_root, inp))
|
||||
else:
|
||||
print_col("File 'inp/{}' does not exist.".format(inp_file), "red")
|
||||
sys.exit(1)
|
||||
|
||||
def run(self, work_path):
|
||||
|
||||
def display_spinner():
|
||||
spinner = ['|', '/', '-', '\\']
|
||||
idx = 0
|
||||
while not done_event.is_set():
|
||||
stdout_col(f'\r Testing {self.methd} ({self.basis}) {spinner[idx]}', "cyan")
|
||||
sys.stdout.flush()
|
||||
idx = (idx + 1) % len(spinner)
|
||||
time.sleep(0.05)
|
||||
stdout_col(f'\r Testing {self.methd} ({self.basis}) \n\n', "cyan")
|
||||
|
||||
done_event = threading.Event()
|
||||
spinner_thread = threading.Thread(target=display_spinner)
|
||||
spinner_thread.start()
|
||||
|
||||
try:
|
||||
|
||||
os.chdir('..')
|
||||
#print_col(f" Starting QuAck..", "magenta")
|
||||
#print_col(f" $ cd ..", "magenta")
|
||||
|
||||
command = [
|
||||
'python{}'.format(PYTHON_VERSION), 'PyDuck.py',
|
||||
'-x', '{}'.format(self.mol),
|
||||
'-b', '{}'.format(self.basis),
|
||||
'-m', '{}'.format(self.multip)
|
||||
]
|
||||
#print_col(f" $ {' '.join(command)}", "magenta")
|
||||
|
||||
file_out = "{}/{}/{}_{}_{}.out".format(work_path, self.methd, self.mol, self.multip, self.basis)
|
||||
with open(file_out, 'w') as fobj:
|
||||
result = subprocess.run(command, stdout=fobj, stderr=subprocess.PIPE, text=True)
|
||||
if result.stderr:
|
||||
print("Error output:", result.stderr)
|
||||
|
||||
os.chdir('tests')
|
||||
#print_col(f" $ cd tests", "magenta")
|
||||
|
||||
except Exception as e:
|
||||
|
||||
print_col(f"An error occurred: {str(e)}", "red")
|
||||
|
||||
finally:
|
||||
|
||||
done_event.set()
|
||||
spinner_thread.join()
|
||||
|
||||
def check_data(self, data_ref):
|
||||
filepath = '../test/Rtest.dat'
|
||||
data_new = {}
|
||||
try:
|
||||
# read data_new
|
||||
with open(filepath, 'r') as f:
|
||||
lines = f.readlines()
|
||||
for i in range(0, len(lines) - 1, 2):
|
||||
key = lines[i].strip()
|
||||
value = lines[i + 1].strip()
|
||||
data_new[key] = float(value) # Convert value to float
|
||||
|
||||
# Compare with data_ref
|
||||
for key in data_ref:
|
||||
if key not in data_new:
|
||||
print_col(f" 😐 {key} missing ⚠️ ", "yellow")
|
||||
else:
|
||||
diff = abs(data_new[key] - data_ref[key]) / (1e-15 + abs(data_ref[key]))
|
||||
if(diff <= THRESH):
|
||||
print_col(f" 🙂 {key}", "green")
|
||||
else:
|
||||
print_col(f" ☹️ {key}: ❌ {data_ref[key]} ≠ {data_new[key]}", "red")
|
||||
except FileNotFoundError:
|
||||
print_col(f"Error: The file '{filepath}' does not exist.", "red")
|
||||
sys.exit(1)
|
||||
except Exception as e:
|
||||
print_col(f"An error occurred: {str(e)}", "red")
|
||||
sys.exit(1)
|
||||
|
||||
|
||||
# ---
|
||||
|
||||
|
||||
def main():
|
||||
|
||||
work_path = Path('{}/tests/work'.format(quack_root))
|
||||
if not work_path.exists():
|
||||
work_path.mkdir(parents=True, exist_ok=True)
|
||||
print(f"Directory '{work_path}' created.\n")
|
||||
|
||||
for mol in molecules:
|
||||
|
||||
mol_name = mol.name
|
||||
mol_mult = mol.multiplicity
|
||||
mol_geom = mol.geometry
|
||||
mol_data = mol.properties
|
||||
|
||||
print_col(" Molecule: {} (2S+1 = {})".format(mol_name, mol_mult), "blue")
|
||||
|
||||
for mol_prop_name, mol_prop_data in mol_data.items():
|
||||
|
||||
methd = mol_prop_name[len('properties_'):]
|
||||
|
||||
if(len(mol_prop_data) == 0):
|
||||
continue
|
||||
|
||||
for basis_name, basis_data in mol_prop_data.items():
|
||||
|
||||
if(len(basis_data) == 0):
|
||||
continue
|
||||
|
||||
work_methd = Path('{}/{}'.format(work_path, methd))
|
||||
if not work_methd.exists():
|
||||
work_methd.mkdir(parents=True, exist_ok=True)
|
||||
|
||||
New_Quack_Job = Quack_Job(mol_name, mol_mult, basis_name, mol_geom, methd)
|
||||
New_Quack_Job.prep_inp()
|
||||
New_Quack_Job.run(work_path)
|
||||
New_Quack_Job.check_data(basis_data)
|
||||
|
||||
print()
|
||||
print()
|
||||
print()
|
||||
|
||||
quit()
|
||||
|
||||
|
||||
db_name = '{}.db'.format(bench)
|
||||
|
||||
molecules = get_molecules_from_db(db_name)
|
||||
|
||||
main()
|
||||
|
||||
150
tests/molecule.py
Normal file
150
tests/molecule.py
Normal file
@ -0,0 +1,150 @@
|
||||
|
||||
import os
|
||||
import json
|
||||
import sqlite3
|
||||
|
||||
from utils import print_col
|
||||
|
||||
|
||||
class Molecule:
|
||||
def __init__(self, name, multiplicity, geometry, properties):
|
||||
self.name = name
|
||||
self.multiplicity = multiplicity
|
||||
self.geometry = geometry
|
||||
self.properties = properties
|
||||
|
||||
def to_dict(self):
|
||||
return {
|
||||
"name": self.name,
|
||||
"multiplicity": self.multiplicity,
|
||||
"geometry": self.geometry,
|
||||
"properties": self.properties,
|
||||
}
|
||||
|
||||
@staticmethod
|
||||
def from_dict(data):
|
||||
return Molecule(
|
||||
name=data["name"],
|
||||
multiplicity=data["multiplicity"],
|
||||
geometry=data["geometry"],
|
||||
properties=data["properties"]
|
||||
)
|
||||
|
||||
def save_molecules_to_json(molecules, filename):
|
||||
with open(filename, 'w') as f:
|
||||
json_data = [molecule.to_dict() for molecule in molecules]
|
||||
json.dump(json_data, f, indent=4)
|
||||
|
||||
def load_molecules_from_json(filename):
|
||||
with open(filename, 'r') as f:
|
||||
json_data = json.load(f)
|
||||
return [Molecule.from_dict(data) for data in json_data]
|
||||
|
||||
|
||||
def create_database(db_name):
|
||||
if os.path.exists(db_name):
|
||||
conn = sqlite3.connect(db_name)
|
||||
cursor = conn.cursor()
|
||||
# Check if the table already exists
|
||||
cursor.execute("SELECT name FROM sqlite_master WHERE type='table' AND name='molecules';")
|
||||
table_exists = cursor.fetchone()
|
||||
|
||||
if table_exists:
|
||||
print_col(f"Database '{db_name}' already exists and table 'molecules' is already created.", "yellow")
|
||||
else:
|
||||
# Create the table if it does not exist
|
||||
cursor.execute('''CREATE TABLE molecules
|
||||
(name TEXT, multiplicity INTEGER, geometry TEXT, properties TEXT)''')
|
||||
conn.commit()
|
||||
print_col(f"Table 'molecules' created in existing database '{db_name}' successfully.", "green")
|
||||
conn.close()
|
||||
else:
|
||||
# Create the database and table
|
||||
conn = sqlite3.connect(db_name)
|
||||
cursor = conn.cursor()
|
||||
cursor.execute('''CREATE TABLE molecules
|
||||
(name TEXT, multiplicity INTEGER, geometry TEXT, properties TEXT)''')
|
||||
conn.commit()
|
||||
conn.close()
|
||||
print_col(f"Database '{db_name}' created and table 'molecules' added successfully.", "green")
|
||||
|
||||
def add_molecule_to_db(db_name, molecule):
|
||||
|
||||
conn = sqlite3.connect(db_name)
|
||||
cursor = conn.cursor()
|
||||
|
||||
# Convert geometry and properties to JSON strings
|
||||
geometry_str = json.dumps(molecule.geometry)
|
||||
energies_str = json.dumps(molecule.properties)
|
||||
|
||||
# Check if the molecule already exists
|
||||
cursor.execute("SELECT COUNT(*) FROM molecules WHERE name = ?", (molecule.name,))
|
||||
count = cursor.fetchone()[0]
|
||||
|
||||
if count > 0:
|
||||
print_col(f"Molecule '{molecule.name}' already exists in {db_name}.", "yellow")
|
||||
else:
|
||||
# Insert the molecule if it does not exist
|
||||
cursor.execute("INSERT INTO molecules (name, multiplicity, geometry, properties) VALUES (?, ?, ?, ?)",
|
||||
(molecule.name, molecule.multiplicity, geometry_str, energies_str))
|
||||
conn.commit()
|
||||
print_col(f"'{molecule.name}' added to {db_name} successfully.", "green")
|
||||
|
||||
conn.close()
|
||||
|
||||
|
||||
def remove_database(db_name):
|
||||
if os.path.exists(db_name):
|
||||
os.remove(db_name)
|
||||
print_col(f"Database '{db_name}' removed successfully.", "red")
|
||||
else:
|
||||
print_col(f"Database '{db_name}' does not exist.", "red")
|
||||
|
||||
def get_molecules_from_db(db_name):
|
||||
conn = sqlite3.connect(db_name)
|
||||
cursor = conn.cursor()
|
||||
cursor.execute("SELECT name, multiplicity, geometry, properties FROM molecules")
|
||||
rows = cursor.fetchall()
|
||||
molecules = []
|
||||
for row in rows:
|
||||
name, multiplicity, geometry_str, energies_str = row
|
||||
geometry = json.loads(geometry_str)
|
||||
properties = json.loads(energies_str)
|
||||
molecules.append(Molecule(name, multiplicity, geometry, properties))
|
||||
conn.close()
|
||||
return molecules
|
||||
|
||||
|
||||
def generate_xyz(elements, filename="output.xyz", verbose=False):
|
||||
"""
|
||||
Generate an XYZ file from a list of elements.
|
||||
|
||||
Parameters:
|
||||
elements (list): A list of dictionaries, where each dictionary represents
|
||||
an atom with its element and x, y, z coordinates.
|
||||
filename (str): The name of the output XYZ file. Default is 'output.xyz'.
|
||||
"""
|
||||
|
||||
# Get the number of atoms
|
||||
num_atoms = len(elements)
|
||||
|
||||
# Open the file in write mode
|
||||
with open(filename, 'w') as f:
|
||||
# Write the number of atoms
|
||||
f.write(f"{num_atoms}\n")
|
||||
|
||||
# Write a comment line (can be left blank or customized)
|
||||
f.write("XYZ file generated by generate_xyz function\n")
|
||||
|
||||
# Write the element and coordinates
|
||||
for atom in elements:
|
||||
element = atom['element']
|
||||
x = atom['x']
|
||||
y = atom['y']
|
||||
z = atom['z']
|
||||
f.write(f"{element} {x:.6f} {y:.6f} {z:.6f}\n")
|
||||
|
||||
if(verbose):
|
||||
print(f"XYZ file '{filename}' generated successfully!")
|
||||
|
||||
|
||||
0
tests/titan_bench.py
Normal file
0
tests/titan_bench.py
Normal file
88
tests/utils.py
Normal file
88
tests/utils.py
Normal file
@ -0,0 +1,88 @@
|
||||
|
||||
import sys
|
||||
|
||||
|
||||
|
||||
|
||||
def print_col(text, color):
|
||||
|
||||
if(color == "black"):
|
||||
|
||||
print("\033[30m{}\033[0m".format(text))
|
||||
|
||||
elif(color == "red"):
|
||||
|
||||
print("\033[31m{}\033[0m".format(text))
|
||||
|
||||
elif(color == "green"):
|
||||
|
||||
print("\033[32m{}\033[0m".format(text))
|
||||
|
||||
elif(color == "yellow"):
|
||||
|
||||
print("\033[33m{}\033[0m".format(text))
|
||||
|
||||
elif(color == "blue"):
|
||||
|
||||
print("\033[34m{}\033[0m".format(text))
|
||||
|
||||
elif(color == "magenta"):
|
||||
|
||||
print("\033[35m{}\033[0m".format(text))
|
||||
|
||||
elif(color == "cyan"):
|
||||
|
||||
print("\033[36m{}\033[0m".format(text))
|
||||
|
||||
elif(color == "white"):
|
||||
|
||||
print("\033[37m{}\033[0m".format(text))
|
||||
|
||||
else:
|
||||
|
||||
print("{}".format(text))
|
||||
|
||||
|
||||
# ---
|
||||
|
||||
def stdout_col(text, color):
|
||||
|
||||
if(color == "black"):
|
||||
|
||||
sys.stdout.write("\033[30m{}\033[0m".format(text))
|
||||
|
||||
elif(color == "red"):
|
||||
|
||||
sys.stdout.write("\033[31m{}\033[0m".format(text))
|
||||
|
||||
elif(color == "green"):
|
||||
|
||||
sys.stdout.write("\033[32m{}\033[0m".format(text))
|
||||
|
||||
elif(color == "yellow"):
|
||||
|
||||
sys.stdout.write("\033[33m{}\033[0m".format(text))
|
||||
|
||||
elif(color == "blue"):
|
||||
|
||||
sys.stdout.write("\033[34m{}\033[0m".format(text))
|
||||
|
||||
elif(color == "magenta"):
|
||||
|
||||
sys.stdout.write("\033[35m{}\033[0m".format(text))
|
||||
|
||||
elif(color == "cyan"):
|
||||
|
||||
sys.stdout.write("\033[36m{}\033[0m".format(text))
|
||||
|
||||
elif(color == "white"):
|
||||
|
||||
sys.stdout.write("\033[37m{}\033[0m".format(text))
|
||||
|
||||
else:
|
||||
|
||||
sys.stdout.write("{}".format(text))
|
||||
|
||||
# ---
|
||||
|
||||
|
||||
Loading…
x
Reference in New Issue
Block a user