mirror of
https://github.com/pfloos/quack
synced 2024-10-20 14:58:20 +02:00
Merge branch 'master' of github.com:pfloos/QuAcK
This commit is contained in:
commit
e37becbba4
3
.gitignore
vendored
3
.gitignore
vendored
@ -1,2 +1,5 @@
|
|||||||
*.o
|
*.o
|
||||||
*.
|
*.
|
||||||
|
__pycache__
|
||||||
|
|
||||||
|
.ninja_deps
|
||||||
|
19
PyDuck.py
19
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('--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('-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('--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('-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('-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.')
|
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
|
multiplicity=args.multiplicity
|
||||||
xyz=args.xyz + '.xyz'
|
xyz=args.xyz + '.xyz'
|
||||||
cartesian=args.cartesian
|
cartesian=args.cartesian
|
||||||
|
print_2e=args.print_2e
|
||||||
working_dir=args.working_dir
|
working_dir=args.working_dir
|
||||||
|
|
||||||
#Read molecule
|
#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
|
dipole = mol.intor('int1e_r') #Matrix elements of the x, y, z operators
|
||||||
x,y,z = dipole[0],dipole[1],dipole[2]
|
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'])
|
subprocess.call(['rm', working_dir + '/int/nBas.dat'])
|
||||||
f = open(working_dir+'/int/nBas.dat','w')
|
f = open(working_dir+'/int/nBas.dat','w')
|
||||||
f.write(str(norb))
|
f.write(" {} ".format(str(norb)))
|
||||||
f.write(' ')
|
|
||||||
f.close()
|
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'])
|
subprocess.call(['rm', working_dir + '/int/z.dat'])
|
||||||
write_matrix_to_file(z,norb,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')
|
eri_ao = mol.intor('int2e')
|
||||||
|
|
||||||
def write_tensor_to_file(tensor,size,file,cutoff=1e-15):
|
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 k in range(i,size):
|
||||||
for l in range(j,size):
|
for l in range(j,size):
|
||||||
if abs(tensor[i][k][j][l]) > cutoff:
|
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(str(i+1)+' '+str(j+1)+' '+str(k+1)+' '+str(l+1)+' '+"{:.16E}".format(tensor[i][k][j][l]))
|
||||||
f.write('\n')
|
f.write('\n')
|
||||||
f.close()
|
f.close()
|
||||||
|
|
||||||
|
# Write two-electron integrals
|
||||||
|
if print_2e:
|
||||||
|
# (formatted)
|
||||||
subprocess.call(['rm', working_dir + '/int/ERI.dat'])
|
subprocess.call(['rm', working_dir + '/int/ERI.dat'])
|
||||||
write_tensor_to_file(eri_ao,norb,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
|
#Execute the QuAcK fortran program
|
||||||
subprocess.call(QuAcK_dir+'/bin/QuAcK')
|
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
|
2
|
||||||
|
|
||||||
H 0.0000 0.0000 -0.37500000
|
H 0.00000000 -0.37500000 0.00000000
|
||||||
H 0.0000 0.0000 0.37500000
|
H 0.00000000 0.37500000 0.00000000
|
||||||
|
@ -1,4 +1,4 @@
|
|||||||
2
|
2
|
||||||
|
|
||||||
N 0.0000 0.0000 0.0000
|
N 0.0000 0.0000 -0.5475132
|
||||||
N 0.0000 0.0000 1.1007
|
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
|
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(out) :: M_MOs(nOrb,nOrb)
|
||||||
double precision,intent(in) :: C(nBas,nBas)
|
|
||||||
double precision,intent(in) :: A(nBas,nBas)
|
|
||||||
|
|
||||||
! Local variables
|
|
||||||
|
|
||||||
double precision, allocatable :: AC(:,:)
|
double precision, allocatable :: AC(:,:)
|
||||||
|
|
||||||
! Output variables
|
allocate(AC(nBas,nOrb))
|
||||||
|
|
||||||
double precision,intent(out) :: B(nBas,nBas)
|
!AC = matmul(M_AOs, C)
|
||||||
|
!M_MOs = matmul(transpose(C), AC)
|
||||||
|
|
||||||
allocate(AC(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)
|
||||||
|
|
||||||
AC = matmul(A,C)
|
call dgemm("T", "N", nOrb, nOrb, nBas, 1.d0, &
|
||||||
B = matmul(transpose(C),AC)
|
C(1,1), nBas, AC(1,1), nBas, &
|
||||||
|
0.d0, M_MOs(1,1), nOrb)
|
||||||
|
|
||||||
|
deallocate(AC)
|
||||||
|
|
||||||
end subroutine
|
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
|
! 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
|
! 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) :: ERI_AO(nBas,nBas,nBas,nBas)
|
||||||
double precision,intent(in) :: c(nBas,nBas)
|
double precision,intent(in) :: c(nBas,nOrb)
|
||||||
|
|
||||||
! Local variables
|
! Local variables
|
||||||
|
|
||||||
double precision,allocatable :: scr(:,:,:,:)
|
double precision,allocatable :: a1(:,:,:,:)
|
||||||
integer :: mu,nu,la,si
|
double precision,allocatable :: a2(:,:,:,:)
|
||||||
integer :: i,j,k,l
|
|
||||||
|
|
||||||
! Output variables
|
! Output variables
|
||||||
|
|
||||||
double precision,intent(out) :: ERI_MO(nBas,nBas,nBas,nBas)
|
double precision,intent(out) :: ERI_MO(nOrb,nOrb,nOrb,nOrb)
|
||||||
|
|
||||||
! Memory allocation
|
! 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
|
! 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*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,scr,nBas,c(1,1),size(c,1),0d0,ERI_MO,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,ERI_MO,nBas,c(1,1),size(c,1),0d0,scr,nBas**3)
|
deallocate(a2)
|
||||||
|
allocate(a2(nBas,nOrb,nOrb,nOrb))
|
||||||
|
|
||||||
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*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
|
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
|
! Perform MO to AO transformation of a matrix M_AOs for a given metric S
|
||||||
! and coefficients c
|
! and coefficients c
|
||||||
|
!
|
||||||
|
! M_AOs = S C M_MOs (S C).T
|
||||||
|
|
||||||
implicit none
|
implicit none
|
||||||
|
|
||||||
! Input variables
|
integer, intent(in) :: nBas, nOrb
|
||||||
|
|
||||||
integer,intent(in) :: nBas
|
|
||||||
double precision, intent(in) :: S(nBas,nBas)
|
double precision, intent(in) :: S(nBas,nBas)
|
||||||
double precision,intent(in) :: C(nBas,nBas)
|
double precision, intent(in) :: C(nBas,nOrb)
|
||||||
double precision,intent(in) :: B(nBas,nBas)
|
double precision, intent(in) :: M_MOs(nOrb,nOrb)
|
||||||
|
double precision, intent(out) :: M_AOs(nBas,nBas)
|
||||||
! Local variables
|
|
||||||
|
|
||||||
double precision, allocatable :: SC(:,:),BSC(:,:)
|
double precision, allocatable :: SC(:,:),BSC(:,:)
|
||||||
|
|
||||||
! Output variables
|
|
||||||
|
|
||||||
double precision,intent(out) :: A(nBas,nBas)
|
allocate(SC(nBas,nOrb), BSC(nOrb,nBas))
|
||||||
|
|
||||||
! Memory allocation
|
!SC = matmul(S, C)
|
||||||
|
!BSC = matmul(M_MOs, transpose(SC))
|
||||||
|
!M_AOs = matmul(SC, BSC)
|
||||||
|
|
||||||
allocate(SC(nBas,nBas),BSC(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)
|
||||||
|
|
||||||
SC = matmul(S,C)
|
call dgemm("N", "T", nOrb, nBas, nOrb, 1.d0, &
|
||||||
BSC = matmul(B,transpose(SC))
|
M_MOs(1,1), nOrb, SC(1,1), nBas, &
|
||||||
A = matmul(SC,BSC)
|
0.d0, BSC(1,1), nOrb)
|
||||||
|
|
||||||
|
call dgemm("N", "N", nBas, nBas, nOrb, 1.d0, &
|
||||||
|
SC(1,1), nBas, BSC(1,1), nOrb, &
|
||||||
|
0.d0, M_AOs(1,1), nBas)
|
||||||
|
|
||||||
|
deallocate(SC, BSC)
|
||||||
|
|
||||||
end subroutine
|
end subroutine
|
||||||
|
@ -1,5 +1,8 @@
|
|||||||
|
|
||||||
|
! ---
|
||||||
|
|
||||||
subroutine RCC(dotest, doCCD, dopCCD, doDCD, doCCSD, doCCSDT, dodrCCD, dorCCD, docrCCD, dolCCD, &
|
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)
|
maxSCF, thresh, max_diis, nBas, nOrb, nC, nO, nV, nR, Hc, ERI_AO, ERI_MO, ENuc, ERHF, eHF, cHF)
|
||||||
|
|
||||||
! Coupled-cluster module
|
! Coupled-cluster module
|
||||||
|
|
||||||
@ -24,15 +27,18 @@ subroutine RCC(dotest,doCCD,dopCCD,doDCD,doCCSD,doCCSDT,dodrCCD,dorCCD,docrCCD,d
|
|||||||
integer,intent(in) :: max_diis
|
integer,intent(in) :: max_diis
|
||||||
double precision,intent(in) :: thresh
|
double precision,intent(in) :: thresh
|
||||||
|
|
||||||
integer,intent(in) :: nBas
|
integer,intent(in) :: nBas, nOrb
|
||||||
integer,intent(in) :: nC
|
integer,intent(in) :: nC
|
||||||
integer,intent(in) :: nO
|
integer,intent(in) :: nO
|
||||||
integer,intent(in) :: nV
|
integer,intent(in) :: nV
|
||||||
integer,intent(in) :: nR
|
integer,intent(in) :: nR
|
||||||
double precision,intent(in) :: ENuc
|
double precision,intent(in) :: ENuc
|
||||||
double precision,intent(in) :: ERHF
|
double precision,intent(in) :: ERHF
|
||||||
double precision,intent(in) :: eHF(nBas)
|
double precision,intent(in) :: eHF(nOrb)
|
||||||
double precision,intent(in) :: ERI(nBas,nBas,nBas,nBas)
|
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
|
! Local variables
|
||||||
|
|
||||||
@ -45,11 +51,11 @@ subroutine RCC(dotest,doCCD,dopCCD,doDCD,doCCSD,doCCSDT,dodrCCD,dorCCD,docrCCD,d
|
|||||||
if(doCCD) then
|
if(doCCD) then
|
||||||
|
|
||||||
call wall_time(start_CC)
|
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)
|
call wall_time(end_CC)
|
||||||
|
|
||||||
t_CC = end_CC - start_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(*,*)
|
write(*,*)
|
||||||
|
|
||||||
end if
|
end if
|
||||||
@ -61,12 +67,12 @@ subroutine RCC(dotest,doCCD,dopCCD,doDCD,doCCSD,doCCSDT,dodrCCD,dorCCD,docrCCD,d
|
|||||||
if(doDCD) then
|
if(doDCD) then
|
||||||
|
|
||||||
call wall_time(start_CC)
|
call wall_time(start_CC)
|
||||||
call DCD(dotest,maxSCF,thresh,max_diis,nBas,nC,nO,nV,nR, &
|
call DCD(dotest,maxSCF,thresh,max_diis,nOrb,nC,nO,nV,nR, &
|
||||||
ERI,ENuc,ERHF,eHF)
|
ERI_MO,ENuc,ERHF,eHF)
|
||||||
call wall_time(end_CC)
|
call wall_time(end_CC)
|
||||||
|
|
||||||
t_CC = end_CC - start_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(*,*)
|
write(*,*)
|
||||||
|
|
||||||
end if
|
end if
|
||||||
@ -80,11 +86,11 @@ subroutine RCC(dotest,doCCD,dopCCD,doDCD,doCCSD,doCCSDT,dodrCCD,dorCCD,docrCCD,d
|
|||||||
if(doCCSD) then
|
if(doCCSD) then
|
||||||
|
|
||||||
call wall_time(start_CC)
|
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)
|
call wall_time(end_CC)
|
||||||
|
|
||||||
t_CC = end_CC - start_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(*,*)
|
write(*,*)
|
||||||
|
|
||||||
end if
|
end if
|
||||||
@ -96,11 +102,11 @@ subroutine RCC(dotest,doCCD,dopCCD,doDCD,doCCSD,doCCSDT,dodrCCD,dorCCD,docrCCD,d
|
|||||||
if(dodrCCD) then
|
if(dodrCCD) then
|
||||||
|
|
||||||
call wall_time(start_CC)
|
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)
|
call wall_time(end_CC)
|
||||||
|
|
||||||
t_CC = end_CC - start_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(*,*)
|
write(*,*)
|
||||||
|
|
||||||
end if
|
end if
|
||||||
@ -112,11 +118,11 @@ subroutine RCC(dotest,doCCD,dopCCD,doDCD,doCCSD,doCCSDT,dodrCCD,dorCCD,docrCCD,d
|
|||||||
if(dorCCD) then
|
if(dorCCD) then
|
||||||
|
|
||||||
call wall_time(start_CC)
|
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)
|
call wall_time(end_CC)
|
||||||
|
|
||||||
t_CC = end_CC - start_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(*,*)
|
write(*,*)
|
||||||
|
|
||||||
end if
|
end if
|
||||||
@ -128,11 +134,11 @@ subroutine RCC(dotest,doCCD,dopCCD,doDCD,doCCSD,doCCSDT,dodrCCD,dorCCD,docrCCD,d
|
|||||||
if(docrCCD) then
|
if(docrCCD) then
|
||||||
|
|
||||||
call wall_time(start_CC)
|
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)
|
call wall_time(end_CC)
|
||||||
|
|
||||||
t_CC = end_CC - start_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(*,*)
|
write(*,*)
|
||||||
|
|
||||||
end if
|
end if
|
||||||
@ -144,11 +150,11 @@ subroutine RCC(dotest,doCCD,dopCCD,doDCD,doCCSD,doCCSDT,dodrCCD,dorCCD,docrCCD,d
|
|||||||
if(dolCCD) then
|
if(dolCCD) then
|
||||||
|
|
||||||
call wall_time(start_CC)
|
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)
|
call wall_time(end_CC)
|
||||||
|
|
||||||
t_CC = end_CC - start_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(*,*)
|
write(*,*)
|
||||||
|
|
||||||
end if
|
end if
|
||||||
@ -160,11 +166,13 @@ subroutine RCC(dotest,doCCD,dopCCD,doDCD,doCCSD,doCCSDT,dodrCCD,dorCCD,docrCCD,d
|
|||||||
if(dopCCD) then
|
if(dopCCD) then
|
||||||
|
|
||||||
call wall_time(start_CC)
|
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)
|
call wall_time(end_CC)
|
||||||
|
|
||||||
t_CC = end_CC - start_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(*,*)
|
write(*,*)
|
||||||
|
|
||||||
end if
|
end if
|
||||||
|
712
src/CC/pCCD.f90
712
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
|
! 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
|
logical,intent(in) :: dotest
|
||||||
|
|
||||||
integer,intent(in) :: maxSCF
|
integer,intent(in) :: maxIt
|
||||||
integer,intent(in) :: max_diis
|
integer,intent(in) :: max_diis
|
||||||
double precision,intent(in) :: thresh
|
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) :: ENuc,ERHF
|
||||||
double precision,intent(in) :: eHF(nBas)
|
double precision,intent(in) :: eHF(nOrb)
|
||||||
double precision,intent(in) :: ERI(nBas,nBas,nBas,nBas)
|
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
|
! Local variables
|
||||||
|
|
||||||
|
integer :: p,q,r,s,t,u,w
|
||||||
|
integer :: pq,rs
|
||||||
integer :: i,j,a,b
|
integer :: i,j,a,b
|
||||||
|
|
||||||
integer :: nSCF
|
integer :: nItAmp
|
||||||
double precision :: Conv
|
integer :: nItOrb
|
||||||
double precision :: ECC,EcCC
|
double precision :: CvgAmp
|
||||||
|
double precision :: CvgOrb
|
||||||
|
double precision :: ECC
|
||||||
|
double precision :: EcCC
|
||||||
|
|
||||||
double precision,allocatable :: eO(:)
|
double precision,allocatable :: eO(:)
|
||||||
double precision,allocatable :: eV(:)
|
double precision,allocatable :: eV(:)
|
||||||
@ -35,128 +46,168 @@ subroutine pCCD(dotest,maxSCF,thresh,max_diis,nBas,nC,nO,nV,nR,ERI,ENuc,ERHF,eHF
|
|||||||
double precision,allocatable :: OVVO(:,:)
|
double precision,allocatable :: OVVO(:,:)
|
||||||
double precision,allocatable :: VVVV(:,:)
|
double precision,allocatable :: VVVV(:,:)
|
||||||
|
|
||||||
double precision,allocatable :: y(:,:)
|
double precision,allocatable :: yO(:,:)
|
||||||
|
double precision,allocatable :: yV(:,:)
|
||||||
|
|
||||||
double precision,allocatable :: r(:,:)
|
double precision,allocatable :: r2(:,:)
|
||||||
double precision,allocatable :: t(:,:)
|
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
|
integer :: n_diis
|
||||||
double precision :: rcond
|
double precision :: rcond
|
||||||
double precision,allocatable :: error_diis(:,:)
|
double precision,allocatable :: err_diis(:,:)
|
||||||
double precision,allocatable :: t_diis(:,:)
|
double precision,allocatable :: t2_diis(:,:)
|
||||||
|
double precision,allocatable :: z2_diis(:,:)
|
||||||
double precision,external :: trace_matrix
|
double precision,external :: trace_matrix
|
||||||
|
double precision,external :: Kronecker_delta
|
||||||
|
|
||||||
! Hello world
|
! Hello world
|
||||||
|
|
||||||
write(*,*)
|
write(*,*)
|
||||||
write(*,*)'**************************************'
|
write(*,*)'*******************************'
|
||||||
write(*,*)'| pair CCD calculation |'
|
write(*,*)'* Restricted pCCD Calculation *'
|
||||||
write(*,*)'**************************************'
|
write(*,*)'*******************************'
|
||||||
write(*,*)
|
write(*,*)
|
||||||
|
|
||||||
|
! Useful quantities
|
||||||
|
|
||||||
|
O = nO - nC
|
||||||
|
V = nV - nR
|
||||||
|
N = O + V ! nOrb - nC - nR
|
||||||
|
|
||||||
|
!------------------------------------!
|
||||||
|
! Star Loop for orbital optimization !
|
||||||
|
!------------------------------------!
|
||||||
|
|
||||||
|
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))
|
||||||
|
|
||||||
|
do i = 1, N
|
||||||
|
c(:,i) = cHF(:,nC+i)
|
||||||
|
enddo
|
||||||
|
|
||||||
|
CvgOrb = 1d0
|
||||||
|
nItOrb = 0
|
||||||
|
|
||||||
|
write(*,*)
|
||||||
|
write(*,*)'----------------------------------------------------'
|
||||||
|
write(*,*)'| Orbital Optimization for pCCD |'
|
||||||
|
write(*,*)'----------------------------------------------------'
|
||||||
|
|
||||||
|
do while(CvgOrb > thresh .and. nItOrb < 1)
|
||||||
|
|
||||||
|
nItOrb = nItOrb + 1
|
||||||
|
|
||||||
|
! Transform integrals
|
||||||
|
|
||||||
|
h = matmul(transpose(c), matmul(Hc, c))
|
||||||
|
|
||||||
|
call AOtoMO_ERI_RHF(nBas, N, c(1,1), ERI_AO(1,1,1,1), ERI_MO(1,1,1,1))
|
||||||
|
|
||||||
! Form energy denominator
|
! Form energy denominator
|
||||||
|
|
||||||
allocate(eO(nO-nC),eV(nV-nR),delta_OV(nO-nC,nV-nR))
|
|
||||||
|
|
||||||
eO(:) = eHF(nC+1:nO)
|
eO(:) = eHF(nC+1:nO)
|
||||||
eV(:) = eHF(nO+1:nBas-nR)
|
eV(:) = eHF(nO+1:nOrb-nR)
|
||||||
|
|
||||||
call form_delta_OV(nC,nO,nV,nR,eO,eV,delta_OV)
|
do i=1,O
|
||||||
|
do a=1,V
|
||||||
|
delta_OV(i,a) = eV(a) - eO(i)
|
||||||
|
end do
|
||||||
|
end do
|
||||||
|
|
||||||
! Create integral batches
|
! Create integral batches
|
||||||
|
|
||||||
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))
|
do i=1,O
|
||||||
|
do j=1,O
|
||||||
do i=1,nO-nC
|
OOOO(i,j) = ERI_MO(i,i,j,j)
|
||||||
do j=1,nO-nC
|
|
||||||
OOOO(i,j) = ERI(nC+i,nC+i,nC+j,nC+j)
|
|
||||||
end do
|
end do
|
||||||
end do
|
end do
|
||||||
|
|
||||||
do i=1,nO-nC
|
do i=1,O
|
||||||
do a=1,nV-nR
|
do a=1,V
|
||||||
OOVV(i,a) = ERI(nC+i,nC+i,nO+a,nO+a)
|
OOVV(i,a) = ERI_MO(i,i,O+a,O+a)
|
||||||
OVOV(i,a) = ERI(nC+i,nO+a,nC+i,nO+a)
|
OVOV(i,a) = ERI_MO(i,O+a,i,O+a)
|
||||||
OVVO(i,a) = ERI(nC+i,nO+a,nO+a,nC+i)
|
OVVO(i,a) = ERI_MO(i,O+a,O+a,i)
|
||||||
end do
|
end do
|
||||||
end do
|
end do
|
||||||
|
|
||||||
do a=1,nV-nR
|
do a=1,V
|
||||||
do b=1,nV-nR
|
do b=1,V
|
||||||
VVVV(a,b) = ERI(nO+a,nO+a,nO+b,nO+b)
|
VVVV(a,b) = ERI_MO(O+a,O+a,O+b,O+b)
|
||||||
end do
|
end do
|
||||||
end do
|
end do
|
||||||
|
|
||||||
! MP2 guess amplitudes
|
!----------------------------!
|
||||||
|
! Star Loop for t amplitudes !
|
||||||
|
!----------------------------!
|
||||||
|
|
||||||
allocate(t(nO-nC,nV-nR))
|
allocate(t2(O,V),r2(O,V),yO(O,O))
|
||||||
|
allocate(err_diis(O*V,max_diis),t2_diis(O*V,max_diis))
|
||||||
t(:,:) = -0.5d0*OOVV(:,:)/delta_OV(:,:)
|
|
||||||
|
|
||||||
|
CvgAmp = 1d0
|
||||||
|
nItAmp = 0
|
||||||
|
ECC = ERHF
|
||||||
EcCC = 0d0
|
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
|
n_diis = 0
|
||||||
t_diis(:,:) = 0d0
|
t2(:,:) = 0d0
|
||||||
error_diis(:,:) = 0d0
|
t2_diis(:,:) = 0d0
|
||||||
|
err_diis(:,:) = 0d0
|
||||||
|
|
||||||
!------------------------------------------------------------------------
|
|
||||||
! Main SCF loop
|
|
||||||
!------------------------------------------------------------------------
|
|
||||||
write(*,*)
|
write(*,*)
|
||||||
write(*,*)'----------------------------------------------------'
|
write(*,*)'----------------------------------------------------'
|
||||||
write(*,*)'| pair CCD calculation |'
|
write(*,*)'| pCCD calculation: t amplitudes |'
|
||||||
write(*,*)'----------------------------------------------------'
|
write(*,*)'----------------------------------------------------'
|
||||||
write(*,'(1X,A1,1X,A3,1X,A1,1X,A16,1X,A1,1X,A10,1X,A1,1X,A10,1X,A1,1X)') &
|
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','|'
|
'|','#','|','E(pCCD)','|','Ec(pCCD)','|','Conv','|'
|
||||||
write(*,*)'----------------------------------------------------'
|
write(*,*)'----------------------------------------------------'
|
||||||
|
|
||||||
do while(Conv > thresh .and. nSCF < maxSCF)
|
do while(CvgAmp > thresh .and. nItAmp < maxIt)
|
||||||
|
|
||||||
! Increment
|
! Increment
|
||||||
|
|
||||||
nSCF = nSCF + 1
|
nItAmp = nItAmp + 1
|
||||||
|
|
||||||
! Form intermediate array
|
! Form intermediate array
|
||||||
|
|
||||||
y(:,:) = 0d0
|
yO(:,:) = matmul(t2,transpose(OOVV))
|
||||||
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
|
! Compute residual
|
||||||
|
|
||||||
do i=1,nO-nC
|
r2(:,:) = OOVV(:,:) + 2d0*delta_OV(:,:)*t2(:,:) &
|
||||||
do a=1,nV-nR
|
- 2d0*(2d0*OVOV(:,:) - OVVO(:,:) - OOVV(:,:)*t2(:,:))*t2(:,:)
|
||||||
|
|
||||||
r(i,a) = OOVV(i,a) + 2d0*delta_OV(i,a)*t(i,a) &
|
do i=1,O
|
||||||
- 2d0*(2d0*OVOV(i,a) - OVVO(i,a) - OOVV(i,a)*t(i,a))*t(i,a)
|
do a=1,V
|
||||||
|
|
||||||
do j=1,nO-nC
|
do j=1,O
|
||||||
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)
|
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
|
end do
|
||||||
|
|
||||||
do b=1,nV-nR
|
do b=1,V
|
||||||
r(i,a) = r(i,a) - 2d0*OOVV(i,b)*t(i,b)*t(i,a) + VVVV(a,b)*t(i,b)
|
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
|
end do
|
||||||
@ -164,18 +215,18 @@ subroutine pCCD(dotest,maxSCF,thresh,max_diis,nBas,nC,nO,nV,nR,ERI,ENuc,ERHF,eHF
|
|||||||
|
|
||||||
! Check convergence
|
! Check convergence
|
||||||
|
|
||||||
Conv = maxval(abs(r(:,:)))
|
CvgAmp = maxval(abs(r2(:,:)))
|
||||||
|
|
||||||
! Update amplitudes
|
! Update amplitudes
|
||||||
|
|
||||||
t(:,:) = t(:,:) - 0.5d0*r(:,:)/delta_OV(:,:)
|
t2(:,:) = t2(:,:) - 0.5d0*r2(:,:)/delta_OV(:,:)
|
||||||
|
|
||||||
! Compute correlation energy
|
! Compute correlation energy
|
||||||
|
|
||||||
EcCC = 0d0
|
EcCC = 0d0
|
||||||
do i=1,nO-nC
|
do i=1,O
|
||||||
do a=1,nV-nR
|
do a=1,V
|
||||||
EcCC = EcCC + OOVV(i,a)*t(i,a)
|
EcCC = EcCC + OOVV(i,a)*t2(i,a)
|
||||||
end do
|
end do
|
||||||
end do
|
end do
|
||||||
|
|
||||||
@ -185,35 +236,508 @@ subroutine pCCD(dotest,maxSCF,thresh,max_diis,nBas,nC,nO,nV,nR,ERI,ENuc,ERHF,eHF
|
|||||||
|
|
||||||
! DIIS extrapolation
|
! DIIS extrapolation
|
||||||
|
|
||||||
! n_diis = min(n_diis+1,max_diis)
|
if(max_diis > 1) then
|
||||||
! call DIIS_extrapolation(rcond,nO*nV,nO*nV,n_diis,error_diis,t_diis,-0.5d0*r/delta_OV,t)
|
|
||||||
|
|
||||||
! Reset DIIS if required
|
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)
|
||||||
|
|
||||||
! if(abs(rcond) < 1d-15) n_diis = 0
|
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)') &
|
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,'|'
|
'|',nItAmp,'|',ECC+ENuc,'|',EcCC,'|',CvgAmp,'|'
|
||||||
|
|
||||||
end do
|
end do
|
||||||
write(*,*)'----------------------------------------------------'
|
write(*,*)'----------------------------------------------------'
|
||||||
!------------------------------------------------------------------------
|
|
||||||
! End of SCF loop
|
!---------------------------!
|
||||||
!------------------------------------------------------------------------
|
! End Loop for t amplitudes !
|
||||||
|
!---------------------------!
|
||||||
|
|
||||||
|
deallocate(r2,yO)
|
||||||
|
deallocate(err_diis,t2_diis)
|
||||||
|
|
||||||
! Did it actually converge?
|
! Did it actually converge?
|
||||||
|
|
||||||
if(nSCF == maxSCF) then
|
if(nItAmp == maxIt) then
|
||||||
|
|
||||||
write(*,*)
|
write(*,*)
|
||||||
write(*,*)'!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!'
|
write(*,*)'!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!'
|
||||||
write(*,*)' Convergence failed '
|
write(*,*)'! Convergence failed for t ampitudes !'
|
||||||
write(*,*)'!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!'
|
write(*,*)'!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!'
|
||||||
|
|
||||||
stop
|
stop
|
||||||
|
|
||||||
end if
|
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))
|
||||||
|
|
||||||
|
CvgAmp = 1d0
|
||||||
|
nItAmp = 0
|
||||||
|
|
||||||
|
n_diis = 0
|
||||||
|
z2_diis(:,:) = 0d0
|
||||||
|
err_diis(:,:) = 0d0
|
||||||
|
|
||||||
|
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(*,*)
|
||||||
|
|
||||||
|
!---------------------------!
|
||||||
|
! End Loop for z ampltiudes !
|
||||||
|
!---------------------------!
|
||||||
|
|
||||||
|
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
|
if(dotest) then
|
||||||
|
|
||||||
call dump_test_value('R','pCCD correlation energy',EcCC)
|
call dump_test_value('R','pCCD correlation energy',EcCC)
|
||||||
|
@ -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
|
! 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) :: singlet
|
||||||
logical,intent(in) :: triplet
|
logical,intent(in) :: triplet
|
||||||
integer,intent(in) :: nBas
|
integer,intent(in) :: nOrb
|
||||||
integer,intent(in) :: nC
|
integer,intent(in) :: nC
|
||||||
integer,intent(in) :: nO
|
integer,intent(in) :: nO
|
||||||
integer,intent(in) :: nV
|
integer,intent(in) :: nV
|
||||||
integer,intent(in) :: nR
|
integer,intent(in) :: nR
|
||||||
integer,intent(in) :: nS
|
integer,intent(in) :: nS
|
||||||
double precision,intent(in) :: EHF
|
double precision,intent(in) :: EHF
|
||||||
double precision,intent(in) :: epsHF(nBas)
|
double precision,intent(in) :: epsHF(nOrb)
|
||||||
double precision,intent(in) :: cHF(nBas,nBas)
|
double precision,intent(in) :: ERI(nOrb,nOrb,nOrb,nOrb)
|
||||||
double precision,intent(in) :: S(nBas,nBas)
|
double precision,intent(in) :: dipole_int(nOrb,nOrb,ncart)
|
||||||
double precision,intent(in) :: ERI(nBas,nBas,nBas,nBas)
|
|
||||||
double precision,intent(in) :: dipole_int(nBas,nBas,ncart)
|
|
||||||
|
|
||||||
! Local variables
|
! Local variables
|
||||||
|
|
||||||
@ -42,11 +43,11 @@ subroutine RCI(dotest,doCIS,doCIS_D,doCID,doCISD,doFCI,singlet,triplet,nBas,nC,n
|
|||||||
if(doCIS) then
|
if(doCIS) then
|
||||||
|
|
||||||
call wall_time(start_CI)
|
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)
|
call wall_time(end_CI)
|
||||||
|
|
||||||
t_CI = end_CI - start_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(*,*)
|
write(*,*)
|
||||||
|
|
||||||
end if
|
end if
|
||||||
@ -58,11 +59,11 @@ subroutine RCI(dotest,doCIS,doCIS_D,doCID,doCISD,doFCI,singlet,triplet,nBas,nC,n
|
|||||||
if(doCID) then
|
if(doCID) then
|
||||||
|
|
||||||
call wall_time(start_CI)
|
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)
|
call wall_time(end_CI)
|
||||||
|
|
||||||
t_CI = end_CI - start_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(*,*)
|
write(*,*)
|
||||||
|
|
||||||
end if
|
end if
|
||||||
@ -74,11 +75,11 @@ subroutine RCI(dotest,doCIS,doCIS_D,doCID,doCISD,doFCI,singlet,triplet,nBas,nC,n
|
|||||||
if(doCISD) then
|
if(doCISD) then
|
||||||
|
|
||||||
call wall_time(start_CI)
|
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)
|
call wall_time(end_CI)
|
||||||
|
|
||||||
t_CI = end_CI - start_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(*,*)
|
write(*,*)
|
||||||
|
|
||||||
end if
|
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)
|
call wall_time(start_CI)
|
||||||
write(*,*) ' FCI is not yet implemented! Sorry.'
|
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)
|
call wall_time(end_CI)
|
||||||
|
|
||||||
t_CI = end_CI - start_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(*,*)
|
write(*,*)
|
||||||
|
|
||||||
end if
|
end if
|
||||||
|
@ -117,4 +117,6 @@ subroutine RCIS(dotest,singlet,triplet,doCIS_D,nBas,nC,nO,nV,nR,nS,ERI,dipole_in
|
|||||||
|
|
||||||
end if
|
end if
|
||||||
|
|
||||||
|
deallocate(A, Om)
|
||||||
|
|
||||||
end subroutine
|
end subroutine
|
||||||
|
@ -133,4 +133,6 @@ subroutine RG0F2(dotest,dophBSE,doppBSE,TDA,dBSE,dTDA,singlet,triplet,linearize,
|
|||||||
|
|
||||||
end if
|
end if
|
||||||
|
|
||||||
|
deallocate(SigC, Z, eGFlin, eGF)
|
||||||
|
|
||||||
end subroutine
|
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
|
! 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) :: rNuc(nNuc,ncart)
|
||||||
double precision,intent(in) :: ENuc
|
double precision,intent(in) :: ENuc
|
||||||
|
|
||||||
integer,intent(in) :: nBas
|
integer,intent(in) :: nBas, nOrb
|
||||||
integer,intent(in) :: nC
|
integer,intent(in) :: nC
|
||||||
integer,intent(in) :: nO
|
integer,intent(in) :: nO
|
||||||
integer,intent(in) :: nV
|
integer,intent(in) :: nV
|
||||||
@ -47,18 +50,18 @@ subroutine RGF(dotest,doG0F2,doevGF2,doqsGF2,doufG0F02,doG0F3,doevGF3,renorm,max
|
|||||||
integer,intent(in) :: nS
|
integer,intent(in) :: nS
|
||||||
|
|
||||||
double precision,intent(in) :: EHF
|
double precision,intent(in) :: EHF
|
||||||
double precision,intent(in) :: epsHF(nBas)
|
double precision,intent(in) :: epsHF(nOrb)
|
||||||
double precision,intent(in) :: cHF(nBas,nBas)
|
double precision,intent(in) :: cHF(nBas,nOrb)
|
||||||
double precision,intent(in) :: PHF(nBas,nBas)
|
double precision,intent(in) :: PHF(nBas,nBas)
|
||||||
double precision,intent(in) :: S(nBas,nBas)
|
double precision,intent(in) :: S(nBas,nBas)
|
||||||
double precision,intent(in) :: T(nBas,nBas)
|
double precision,intent(in) :: T(nBas,nBas)
|
||||||
double precision,intent(in) :: V(nBas,nBas)
|
double precision,intent(in) :: V(nBas,nBas)
|
||||||
double precision,intent(in) :: Hc(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_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_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
|
! Local variables
|
||||||
|
|
||||||
@ -71,12 +74,13 @@ subroutine RGF(dotest,doG0F2,doevGF2,doqsGF2,doufG0F02,doG0F3,doevGF3,renorm,max
|
|||||||
if(doG0F2) then
|
if(doG0F2) then
|
||||||
|
|
||||||
call wall_time(start_GF)
|
call wall_time(start_GF)
|
||||||
call RG0F2(dotest,dophBSE,doppBSE,TDA,dBSE,dTDA,singlet,triplet,linearize,eta,regularize, &
|
call RG0F2(dotest, dophBSE, doppBSE, TDA, dBSE, dTDA, singlet, triplet, &
|
||||||
nBas,nC,nO,nV,nR,nS,ENuc,EHF,ERI,dipole_int,epsHF)
|
linearize, eta, regularize, nOrb, nC, nO, nV, nR, nS, &
|
||||||
|
ENuc, EHF, ERI_MO, dipole_int_MO, epsHF)
|
||||||
call wall_time(end_GF)
|
call wall_time(end_GF)
|
||||||
|
|
||||||
t_GF = end_GF - start_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(*,*)
|
write(*,*)
|
||||||
|
|
||||||
end if
|
end if
|
||||||
@ -89,12 +93,12 @@ subroutine RGF(dotest,doG0F2,doevGF2,doqsGF2,doufG0F02,doG0F3,doevGF3,renorm,max
|
|||||||
|
|
||||||
call wall_time(start_GF)
|
call wall_time(start_GF)
|
||||||
call evRGF2(dotest,dophBSE,doppBSE,TDA,dBSE,dTDA,maxSCF,thresh,max_diis, &
|
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, &
|
singlet,triplet,linearize,eta,regularize,nOrb,nC,nO,nV,nR,nS,ENuc,EHF, &
|
||||||
ERI,dipole_int,epsHF)
|
ERI_MO,dipole_int_MO,epsHF)
|
||||||
call wall_time(end_GF)
|
call wall_time(end_GF)
|
||||||
|
|
||||||
t_GF = end_GF - start_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(*,*)
|
write(*,*)
|
||||||
|
|
||||||
end if
|
end if
|
||||||
@ -106,12 +110,14 @@ subroutine RGF(dotest,doG0F2,doevGF2,doqsGF2,doufG0F02,doG0F3,doevGF3,renorm,max
|
|||||||
if(doqsGF2) then
|
if(doqsGF2) then
|
||||||
|
|
||||||
call wall_time(start_GF)
|
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, &
|
call qsRGF2(dotest, maxSCF, thresh, max_diis, dophBSE, doppBSE, TDA, &
|
||||||
nBas,nC,nO,nV,nR,nS,EHF,S,X,T,V,Hc,ERI_AO,ERI,dipole_int_AO,dipole_int,PHF,cHF,epsHF)
|
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)
|
call wall_time(end_GF)
|
||||||
|
|
||||||
t_GF = end_GF - start_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(*,*)
|
write(*,*)
|
||||||
|
|
||||||
end if
|
end if
|
||||||
@ -123,11 +129,11 @@ subroutine RGF(dotest,doG0F2,doevGF2,doqsGF2,doufG0F02,doG0F3,doevGF3,renorm,max
|
|||||||
if(doufG0F02) then
|
if(doufG0F02) then
|
||||||
|
|
||||||
call wall_time(start_GF)
|
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)
|
call wall_time(end_GF)
|
||||||
|
|
||||||
t_GF = end_GF - start_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(*,*)
|
write(*,*)
|
||||||
|
|
||||||
end if
|
end if
|
||||||
@ -139,11 +145,11 @@ subroutine RGF(dotest,doG0F2,doevGF2,doqsGF2,doufG0F02,doG0F3,doevGF3,renorm,max
|
|||||||
if(doG0F3) then
|
if(doG0F3) then
|
||||||
|
|
||||||
call wall_time(start_GF)
|
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)
|
call wall_time(end_GF)
|
||||||
|
|
||||||
t_GF = end_GF - start_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(*,*)
|
write(*,*)
|
||||||
|
|
||||||
end if
|
end if
|
||||||
@ -155,11 +161,11 @@ subroutine RGF(dotest,doG0F2,doevGF2,doqsGF2,doufG0F02,doG0F3,doevGF3,renorm,max
|
|||||||
if(doevGF3) then
|
if(doevGF3) then
|
||||||
|
|
||||||
call wall_time(start_GF)
|
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)
|
call wall_time(end_GF)
|
||||||
|
|
||||||
t_GF = end_GF - start_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(*,*)
|
write(*,*)
|
||||||
|
|
||||||
end if
|
end if
|
||||||
|
@ -189,4 +189,6 @@ subroutine evRGF2(dotest,dophBSE,doppBSE,TDA,dBSE,dTDA,maxSCF,thresh,max_diis,si
|
|||||||
|
|
||||||
end if
|
end if
|
||||||
|
|
||||||
|
deallocate(SigC, Z, eGF, eOld, error_diis, e_diis)
|
||||||
|
|
||||||
end subroutine
|
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
|
! 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
|
! Input variables
|
||||||
|
|
||||||
integer,intent(in) :: nBas
|
integer,intent(in) :: nBas, nOrb
|
||||||
integer,intent(in) :: nO
|
integer,intent(in) :: nO
|
||||||
integer,intent(in) :: nSCF
|
integer,intent(in) :: nSCF
|
||||||
double precision,intent(in) :: ENuc
|
double precision,intent(in) :: ENuc
|
||||||
double precision,intent(in) :: Conv
|
double precision,intent(in) :: Conv
|
||||||
double precision,intent(in) :: thresh
|
double precision,intent(in) :: thresh
|
||||||
double precision,intent(in) :: eHF(nBas)
|
double precision,intent(in) :: eHF(nOrb)
|
||||||
double precision,intent(in) :: eGF(nBas)
|
double precision,intent(in) :: eGF(nOrb)
|
||||||
double precision,intent(in) :: c(nBas)
|
double precision,intent(in) :: c(nBas,nOrb)
|
||||||
double precision,intent(in) :: SigC(nBas,nBas)
|
double precision,intent(in) :: SigC(nOrb,nOrb)
|
||||||
double precision,intent(in) :: Z(nBas)
|
double precision,intent(in) :: Z(nOrb)
|
||||||
double precision,intent(in) :: ET
|
double precision,intent(in) :: ET
|
||||||
double precision,intent(in) :: EV
|
double precision,intent(in) :: EV
|
||||||
double precision,intent(in) :: EJ
|
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)','|'
|
'|','#','|','e_HF (eV)','|','Sig_c (eV)','|','Z','|','e_QP (eV)','|'
|
||||||
write(*,*)'-------------------------------------------------------------------------------'
|
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)') &
|
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,'|'
|
'|',q,'|',eHF(q)*HaToeV,'|',SigC(q,q)*HaToeV,'|',Z(q),'|',eGF(q)*HaToeV,'|'
|
||||||
end do
|
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(*,'(A50)') '---------------------------------------'
|
||||||
write(*,'(A32)') ' qsGF2 MO coefficients'
|
write(*,'(A32)') ' qsGF2 MO coefficients'
|
||||||
write(*,'(A50)') '---------------------------------------'
|
write(*,'(A50)') '---------------------------------------'
|
||||||
call matout(nBas,nBas,c)
|
call matout(nBas, nOrb, c)
|
||||||
write(*,*)
|
write(*,*)
|
||||||
write(*,'(A50)') '---------------------------------------'
|
write(*,'(A50)') '---------------------------------------'
|
||||||
write(*,'(A32)') ' qsGF2 MO energies'
|
write(*,'(A32)') ' qsGF2 MO energies'
|
||||||
write(*,'(A50)') '---------------------------------------'
|
write(*,'(A50)') '---------------------------------------'
|
||||||
call matout(nBas,1,eGF)
|
call matout(nOrb, 1, eGF)
|
||||||
write(*,*)
|
write(*,*)
|
||||||
|
|
||||||
end if
|
end if
|
||||||
|
@ -1,5 +1,9 @@
|
|||||||
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, &
|
! ---
|
||||||
|
|
||||||
|
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)
|
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
|
! 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) :: rNuc(nNuc,ncart)
|
||||||
double precision,intent(in) :: ENuc
|
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) :: ERHF
|
||||||
double precision,intent(in) :: eHF(nBas)
|
double precision,intent(in) :: eHF(nOrb)
|
||||||
double precision,intent(in) :: cHF(nBas,nBas)
|
double precision,intent(in) :: cHF(nBas,nOrb)
|
||||||
double precision,intent(in) :: PHF(nBas,nBas)
|
double precision,intent(in) :: PHF(nBas,nBas)
|
||||||
double precision,intent(in) :: S(nBas,nBas)
|
double precision,intent(in) :: S(nBas,nBas)
|
||||||
double precision,intent(in) :: T(nBas,nBas)
|
double precision,intent(in) :: T(nBas,nBas)
|
||||||
double precision,intent(in) :: V(nBas,nBas)
|
double precision,intent(in) :: V(nBas,nBas)
|
||||||
double precision,intent(in) :: Hc(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_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_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
|
! Local variables
|
||||||
|
|
||||||
integer :: nSCF
|
integer :: nSCF
|
||||||
integer :: nBasSq
|
integer :: nBas_Sq
|
||||||
integer :: ispin
|
integer :: ispin
|
||||||
integer :: n_diis
|
integer :: n_diis
|
||||||
double precision :: EqsGF2
|
double precision :: EqsGF2
|
||||||
@ -94,7 +98,7 @@ subroutine qsRGF2(dotest,maxSCF,thresh,max_diis,dophBSE,doppBSE,TDA,dBSE,dTDA,si
|
|||||||
|
|
||||||
! Stuff
|
! Stuff
|
||||||
|
|
||||||
nBasSq = nBas*nBas
|
nBas_Sq = nBas*nBas
|
||||||
|
|
||||||
! TDA
|
! TDA
|
||||||
|
|
||||||
@ -105,9 +109,27 @@ subroutine qsRGF2(dotest,maxSCF,thresh,max_diis,dophBSE,doppBSE,TDA,dBSE,dTDA,si
|
|||||||
|
|
||||||
! Memory allocation
|
! Memory allocation
|
||||||
|
|
||||||
allocate(eGF(nBas),eOld(nbas),c(nBas,nBas),cp(nBas,nBas),P(nBas,nBas),F(nBas,nBas),Fp(nBas,nBas), &
|
allocate(eGF(nOrb))
|
||||||
J(nBas,nBas),K(nBas,nBas),SigC(nBas,nBas),SigCp(nBas,nBas),Z(nBas), &
|
allocate(eOld(nOrb))
|
||||||
error(nBas,nBas),error_diis(nBasSq,max_diis),F_diis(nBasSq,max_diis))
|
|
||||||
|
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
|
! Initialization
|
||||||
|
|
||||||
@ -143,17 +165,17 @@ subroutine qsRGF2(dotest,maxSCF,thresh,max_diis,dophBSE,doppBSE,TDA,dBSE,dTDA,si
|
|||||||
|
|
||||||
! AO to MO transformation of two-electron integrals
|
! 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
|
! Compute self-energy and renormalization factor
|
||||||
|
|
||||||
if(regularize) then
|
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
|
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
|
end if
|
||||||
|
|
||||||
@ -161,11 +183,15 @@ subroutine qsRGF2(dotest,maxSCF,thresh,max_diis,dophBSE,doppBSE,TDA,dBSE,dTDA,si
|
|||||||
|
|
||||||
SigC = 0.5d0*(SigC + transpose(SigC))
|
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
|
! Solve the quasi-particle equation
|
||||||
|
|
||||||
F(:,:) = Hc(:,:) + J(:,:) + 0.5d0*K(:,:) + SigCp(:,:)
|
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
|
! Compute commutator and convergence criteria
|
||||||
|
|
||||||
@ -175,18 +201,25 @@ subroutine qsRGF2(dotest,maxSCF,thresh,max_diis,dophBSE,doppBSE,TDA,dBSE,dTDA,si
|
|||||||
|
|
||||||
n_diis = min(n_diis+1, max_diis)
|
n_diis = min(n_diis+1, max_diis)
|
||||||
if(abs(rcond) > 1d-7) then
|
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
|
else
|
||||||
n_diis = 0
|
n_diis = 0
|
||||||
end if
|
end if
|
||||||
|
|
||||||
! Diagonalize Hamiltonian in AO basis
|
! Diagonalize Hamiltonian in AO basis
|
||||||
|
|
||||||
|
if(nBas .eq. nOrb) then
|
||||||
Fp = matmul(transpose(X), matmul(F, X))
|
Fp = matmul(transpose(X), matmul(F, X))
|
||||||
cp(:,:) = Fp(:,:)
|
cp(:,:) = Fp(:,:)
|
||||||
call diagonalize_matrix(nBas,cp,eGF)
|
call diagonalize_matrix(nOrb, cp, eGF)
|
||||||
c = matmul(X, cp)
|
c = matmul(X, cp)
|
||||||
SigCp = matmul(transpose(c),matmul(SigCp,c))
|
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
|
! Compute new density matrix in the AO basis
|
||||||
|
|
||||||
@ -219,7 +252,7 @@ subroutine qsRGF2(dotest,maxSCF,thresh,max_diis,dophBSE,doppBSE,TDA,dBSE,dTDA,si
|
|||||||
|
|
||||||
! Correlation energy
|
! 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
|
! Total energy
|
||||||
|
|
||||||
@ -231,7 +264,8 @@ subroutine qsRGF2(dotest,maxSCF,thresh,max_diis,dophBSE,doppBSE,TDA,dBSE,dTDA,si
|
|||||||
!------------------------------------------------------------------------
|
!------------------------------------------------------------------------
|
||||||
|
|
||||||
call dipole_moment(nBas, P, nNuc, ZNuc, rNuc, dipole_int_AO, dipole)
|
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 print_qsRGF2(nBas, nOrb, nO, nSCF, Conv, thresh, eHF, eGF, &
|
||||||
|
c, SigC, Z, ENuc, ET, EV, EJ, Ex, Ec, EqsGF2, dipole)
|
||||||
|
|
||||||
end do
|
end do
|
||||||
!------------------------------------------------------------------------
|
!------------------------------------------------------------------------
|
||||||
@ -248,6 +282,7 @@ subroutine qsRGF2(dotest,maxSCF,thresh,max_diis,dophBSE,doppBSE,TDA,dBSE,dTDA,si
|
|||||||
write(*,*)'!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!'
|
write(*,*)'!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!'
|
||||||
write(*,*)
|
write(*,*)
|
||||||
|
|
||||||
|
deallocate(c, cp, P, F, Fp, J, K, SigC, SigCp, Z, error, error_diis, F_diis)
|
||||||
stop
|
stop
|
||||||
|
|
||||||
end if
|
end if
|
||||||
@ -260,7 +295,8 @@ subroutine qsRGF2(dotest,maxSCF,thresh,max_diis,dophBSE,doppBSE,TDA,dBSE,dTDA,si
|
|||||||
|
|
||||||
if(dophBSE) then
|
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(*,*)
|
||||||
write(*,*)'-------------------------------------------------------------------------------'
|
write(*,*)'-------------------------------------------------------------------------------'
|
||||||
@ -278,7 +314,8 @@ subroutine qsRGF2(dotest,maxSCF,thresh,max_diis,dophBSE,doppBSE,TDA,dBSE,dTDA,si
|
|||||||
|
|
||||||
if(doppBSE) then
|
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(*,*)
|
||||||
write(*,*)'-------------------------------------------------------------------------------'
|
write(*,*)'-------------------------------------------------------------------------------'
|
||||||
|
@ -197,7 +197,7 @@ subroutine qsUGF2(dotest,maxSCF,thresh,max_diis,BSE,TDA,dBSE,dTDA,spin_conserved
|
|||||||
end do
|
end do
|
||||||
|
|
||||||
do is=1,nspin
|
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
|
end do
|
||||||
|
|
||||||
! Solve the quasi-particle equation
|
! 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
|
! Compute excitation densities for T-matrix self-energy
|
||||||
|
|
||||||
|
! TODO
|
||||||
|
! debug DGEMM for nC != 0
|
||||||
|
! and nR != 0
|
||||||
|
|
||||||
|
|
||||||
|
|
||||||
implicit none
|
implicit none
|
||||||
|
|
||||||
! Input variables
|
! 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) :: rho1(nBas,nBas,nVV)
|
||||||
double precision,intent(out) :: rho2(nBas,nBas,nOO)
|
double precision,intent(out) :: rho2(nBas,nBas,nOO)
|
||||||
|
|
||||||
|
integer :: dim_1, dim_2
|
||||||
|
double precision, allocatable :: ERI_1(:,:,:)
|
||||||
|
double precision, allocatable :: ERI_2(:,:,:)
|
||||||
|
|
||||||
! Initialization
|
! Initialization
|
||||||
|
|
||||||
rho1(:,:,:) = 0d0
|
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
|
if(ispin == 1) then
|
||||||
|
|
||||||
!$OMP PARALLEL &
|
!$OMP PARALLEL DEFAULT(NONE) &
|
||||||
!$OMP SHARED(nC,nBas,nR,nO,nVV,nOO,rho1,rho2,ERI,X1,Y1,X2,Y2) &
|
!$OMP PRIVATE(p, q, a, b, ab, c, d, cd, i, j, ij, k, l, kl) &
|
||||||
!$OMP PRIVATE(q,p,ab,cd,kl,ij) &
|
!$OMP SHARED(nC, nBas, nR, nO, rho1, rho2, ERI, X1, Y1, X2, Y2)
|
||||||
!$OMP DEFAULT(NONE)
|
!$OMP DO COLLAPSE(2)
|
||||||
!$OMP DO
|
|
||||||
|
|
||||||
do q=nC+1,nBas-nR
|
do q=nC+1,nBas-nR
|
||||||
do p=nC+1,nBas-nR
|
do p=nC+1,nBas-nR
|
||||||
@ -123,66 +132,134 @@ subroutine GTpp_excitation_density(ispin,nBas,nC,nO,nV,nR,nOO,nVV,ERI,X1,Y1,rho1
|
|||||||
|
|
||||||
if(ispin == 2 .or. ispin == 4) then
|
if(ispin == 2 .or. ispin == 4) then
|
||||||
|
|
||||||
|
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 q = nC+1, nBas-nR
|
||||||
do p = nC+1, nBas-nR
|
do p = nC+1, nBas-nR
|
||||||
|
|
||||||
! do ab=1,nVV
|
|
||||||
ab = 0
|
ab = 0
|
||||||
|
|
||||||
do a = nO+1, nBas-nR
|
do a = nO+1, nBas-nR
|
||||||
do b = a+1, nBas-nR
|
do b = a+1, nBas-nR
|
||||||
|
|
||||||
ab = ab + 1
|
ab = ab + 1
|
||||||
|
|
||||||
cd = 0
|
cd = 0
|
||||||
do c = nO+1, nBas-nR
|
do c = nO+1, nBas-nR
|
||||||
do d = c+1, nBas-nR
|
do d = c+1, nBas-nR
|
||||||
|
|
||||||
cd = cd + 1
|
cd = cd + 1
|
||||||
|
|
||||||
rho1(p,q,ab) = rho1(p,q,ab) &
|
rho1(p,q,ab) = rho1(p,q,ab) &
|
||||||
+ (ERI(p,q,c,d) - ERI(p,q,d,c))*X1(cd,ab)
|
+ (ERI(p,q,c,d) - ERI(p,q,d,c))*X1(cd,ab)
|
||||||
end do
|
end do ! d
|
||||||
end do
|
end do ! c
|
||||||
|
|
||||||
kl = 0
|
kl = 0
|
||||||
do k = nC+1, nO
|
do k = nC+1, nO
|
||||||
do l = k+1, nO
|
do l = k+1, nO
|
||||||
|
|
||||||
kl = kl + 1
|
kl = kl + 1
|
||||||
|
|
||||||
rho1(p,q,ab) = rho1(p,q,ab) &
|
rho1(p,q,ab) = rho1(p,q,ab) &
|
||||||
+ (ERI(p,q,k,l) - ERI(p,q,l,k))*Y1(kl,ab)
|
+ (ERI(p,q,k,l) - ERI(p,q,l,k))*Y1(kl,ab)
|
||||||
end do
|
end do ! l
|
||||||
end do
|
end do ! k
|
||||||
|
end do ! b
|
||||||
|
end do ! a
|
||||||
|
|
||||||
end do
|
|
||||||
end do
|
|
||||||
|
|
||||||
! do ij=1,nOO
|
|
||||||
ij = 0
|
ij = 0
|
||||||
do i = nC+1, nO
|
do i = nC+1, nO
|
||||||
do j = i+1, nO
|
do j = i+1, nO
|
||||||
|
|
||||||
ij = ij + 1
|
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
|
cd = 0
|
||||||
do c = nO+1, nBas-nR
|
do c = nO+1, nBas-nR
|
||||||
do d = c+1, nBas-nR
|
do d = c+1, nBas-nR
|
||||||
cd = cd + 1
|
cd = cd + 1
|
||||||
rho2(p,q,ij) = rho2(p,q,ij) &
|
ERI_1(p,q,cd) = ERI(p,q,c,d) - ERI(p,q,d,c)
|
||||||
+ (ERI(p,q,c,d) - ERI(p,q,d,c))*X2(cd,ij)
|
|
||||||
enddo
|
enddo
|
||||||
enddo
|
enddo
|
||||||
|
|
||||||
kl = 0
|
kl = 0
|
||||||
do k = nC+1, nO
|
do k = nC+1, nO
|
||||||
do l = k+1, nO
|
do l = k+1, nO
|
||||||
kl = kl + 1
|
kl = kl + 1
|
||||||
rho2(p,q,ij) = rho2(p,q,ij) &
|
ERI_2(p,q,kl) = ERI(p,q,k,l) - ERI(p,q,l,k)
|
||||||
+ (ERI(p,q,k,l) - ERI(p,q,l,k))*Y2(kl,ij)
|
|
||||||
end do
|
end do
|
||||||
end do
|
end do
|
||||||
|
enddo
|
||||||
|
enddo
|
||||||
|
!$OMP END DO
|
||||||
|
!$OMP END PARALLEL
|
||||||
|
|
||||||
end do
|
call dgemm("N", "N", nBas*nBas, dim_1, dim_1, 1.d0, &
|
||||||
end do
|
ERI_1(1,1,1), nBas*nBas, X1(1,1), dim_1, &
|
||||||
|
0.d0, rho1(1,1,1), nBas*nBas)
|
||||||
|
|
||||||
end do
|
call dgemm("N", "N", nBas*nBas, dim_1, dim_2, 1.d0, &
|
||||||
end do
|
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
|
endif
|
||||||
|
|
||||||
!----------------------------------------------
|
!----------------------------------------------
|
||||||
@ -191,25 +268,31 @@ subroutine GTpp_excitation_density(ispin,nBas,nC,nO,nV,nR,nOO,nVV,ERI,X1,Y1,rho1
|
|||||||
|
|
||||||
if(ispin == 3) then
|
if(ispin == 3) then
|
||||||
|
|
||||||
!$OMP PARALLEL &
|
dim_1 = (nBas - nO) * (nBas - nO)
|
||||||
!$OMP SHARED(nC,nBas,nR,nO,nVV,nOO,rho1,rho2,ERI,X1,Y1,X2,Y2) &
|
dim_2 = nO * nO
|
||||||
!$OMP PRIVATE(q,p,ab,cd,kl,ij,c,d,k,l) &
|
|
||||||
!$OMP DEFAULT(NONE)
|
if((dim_1 .eq. 0) .or. (dim_2 .eq. 0)) then
|
||||||
!$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 q = nC+1, nBas-nR
|
||||||
do p = nC+1, nBas-nR
|
do p = nC+1, nBas-nR
|
||||||
|
|
||||||
! do ab=1,nVV
|
|
||||||
ab = 0
|
ab = 0
|
||||||
do a = nO+1, nBas-nR
|
do a = nO+1, nBas-nR
|
||||||
do b = nO+1, nBas-nR
|
do b = nO+1, nBas-nR
|
||||||
|
|
||||||
ab = ab + 1
|
ab = ab + 1
|
||||||
|
|
||||||
cd = 0
|
cd = 0
|
||||||
do c = nO+1, nBas-nR
|
do c = nO+1, nBas-nR
|
||||||
do d = nO+1, nBas-nR
|
do d = nO+1, nBas-nR
|
||||||
|
|
||||||
cd = cd + 1
|
cd = cd + 1
|
||||||
|
|
||||||
rho1(p,q,ab) = rho1(p,q,ab) + ERI(p,q,c,d)*X1(cd,ab)
|
rho1(p,q,ab) = rho1(p,q,ab) + ERI(p,q,c,d)*X1(cd,ab)
|
||||||
end do
|
end do
|
||||||
end do
|
end do
|
||||||
@ -217,24 +300,27 @@ subroutine GTpp_excitation_density(ispin,nBas,nC,nO,nV,nR,nOO,nVV,ERI,X1,Y1,rho1
|
|||||||
kl = 0
|
kl = 0
|
||||||
do k = nC+1, nO
|
do k = nC+1, nO
|
||||||
do l = nC+1, nO
|
do l = nC+1, nO
|
||||||
|
|
||||||
kl = kl + 1
|
kl = kl + 1
|
||||||
|
|
||||||
rho1(p,q,ab) = rho1(p,q,ab) + ERI(p,q,k,l)*Y1(kl,ab)
|
rho1(p,q,ab) = rho1(p,q,ab) + ERI(p,q,k,l)*Y1(kl,ab)
|
||||||
end do
|
end do
|
||||||
end do
|
end do
|
||||||
|
|
||||||
end do
|
end do
|
||||||
end do
|
end do
|
||||||
|
|
||||||
! do ij=1,nOO
|
|
||||||
ij = 0
|
ij = 0
|
||||||
do i = nC+1, nO
|
do i = nC+1, nO
|
||||||
do j = nC+1, nO
|
do j = nC+1, nO
|
||||||
|
|
||||||
ij = ij + 1
|
ij = ij + 1
|
||||||
|
|
||||||
cd = 0
|
cd = 0
|
||||||
do c = nO+1, nBas-nR
|
do c = nO+1, nBas-nR
|
||||||
do d = nO+1, nBas-nR
|
do d = nO+1, nBas-nR
|
||||||
|
|
||||||
cd = cd + 1
|
cd = cd + 1
|
||||||
|
|
||||||
rho2(p,q,ij) = rho2(p,q,ij) + ERI(p,q,c,d)*X2(cd,ij)
|
rho2(p,q,ij) = rho2(p,q,ij) + ERI(p,q,c,d)*X2(cd,ij)
|
||||||
end do
|
end do
|
||||||
end do
|
end do
|
||||||
@ -242,19 +328,69 @@ subroutine GTpp_excitation_density(ispin,nBas,nC,nO,nV,nR,nOO,nVV,ERI,X1,Y1,rho1
|
|||||||
kl = 0
|
kl = 0
|
||||||
do k = nC+1, nO
|
do k = nC+1, nO
|
||||||
do l = nC+1, nO
|
do l = nC+1, nO
|
||||||
|
|
||||||
kl = kl + 1
|
kl = kl + 1
|
||||||
|
|
||||||
rho2(p,q,ij) = rho2(p,q,ij) + ERI(p,q,k,l)*Y2(kl,ij)
|
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
|
||||||
end do
|
end do
|
||||||
|
|
||||||
end do
|
end do
|
||||||
end do
|
end do
|
||||||
!$OMP END DO
|
!$OMP END DO
|
||||||
!$OMP END PARALLEL
|
!$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
|
endif
|
||||||
|
|
||||||
end subroutine
|
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 :: eGT(:)
|
||||||
double precision,allocatable :: eGTlin(:)
|
double precision,allocatable :: eGTlin(:)
|
||||||
|
|
||||||
|
|
||||||
! Output variables
|
! Output variables
|
||||||
|
|
||||||
! Hello world
|
! 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))
|
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,Bpp)
|
|
||||||
call ppLR_C(iblock,nBas,nC,nO,nV,nR,nVVs,1d0,eHF,ERI,Cpp)
|
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_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(TDA_T,nOOs,nVVs,Bpp,Cpp,Dpp,Om1s,X1s,Y1s,Om2s,X2s,Y2s,EcRPA(ispin))
|
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))
|
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,Bpp)
|
|
||||||
call ppLR_C(iblock,nBas,nC,nO,nV,nR,nVVt,1d0,eHF,ERI,Cpp)
|
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_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(TDA_T,nOOt,nVVt,Bpp,Cpp,Dpp,Om1t,X1t,Y1t,Om2t,X2t,Y2t,EcRPA(ispin))
|
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 = 1
|
||||||
iblock = 3
|
iblock = 3
|
||||||
|
|
||||||
call GTpp_excitation_density(iblock,nBas,nC,nO,nV,nR,nOOs,nVVs,ERI,X1s,Y1s,rho1s,X2s,Y2s,rho2s)
|
call GTpp_excitation_density(iblock,nBas,nC,nO,nV,nR,nOOs,nVVs,ERI,X1s,Y1s,rho1s,X2s,Y2s,rho2s)
|
||||||
|
|
||||||
! iblock = 2
|
! iblock = 2
|
||||||
iblock = 4
|
iblock = 4
|
||||||
|
|
||||||
call GTpp_excitation_density(iblock,nBas,nC,nO,nV,nR,nOOt,nVVt,ERI,X1t,Y1t,rho1t,X2t,Y2t,rho2t)
|
call GTpp_excitation_density(iblock,nBas,nC,nO,nV,nR,nOOt,nVVt,ERI,X1t,Y1t,rho1t,X2t,Y2t,rho2t)
|
||||||
|
|
||||||
!----------------------------------------------
|
!----------------------------------------------
|
||||||
@ -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))
|
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,Bpp)
|
|
||||||
call ppLR_C(iblock,nBas,nC,nO,nV,nR,nVVs,1d0,eGT,ERI,Cpp)
|
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_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(TDA_T,nOOs,nVVs,Bpp,Cpp,Dpp,Om1s,X1s,Y1s,Om2s,X2s,Y2s,EcRPA(ispin))
|
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))
|
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,Bpp)
|
|
||||||
call ppLR_C(iblock,nBas,nC,nO,nV,nR,nVVt,1d0,eGT,ERI,Cpp)
|
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_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(TDA_T,nOOt,nVVt,Bpp,Cpp,Dpp,Om1t,X1t,Y1t,Om2t,X2t,Y2t,EcRPA(ispin))
|
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
|
! 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) :: rNuc(nNuc,ncart)
|
||||||
double precision,intent(in) :: ENuc
|
double precision,intent(in) :: ENuc
|
||||||
|
|
||||||
integer,intent(in) :: nBas
|
integer,intent(in) :: nBas, nOrb
|
||||||
integer,intent(in) :: nC
|
integer,intent(in) :: nC
|
||||||
integer,intent(in) :: nO
|
integer,intent(in) :: nO
|
||||||
integer,intent(in) :: nV
|
integer,intent(in) :: nV
|
||||||
@ -52,18 +56,18 @@ subroutine RGT(dotest,doG0T0pp,doevGTpp,doqsGTpp,doufG0T0pp,doG0T0eh,doevGTeh,do
|
|||||||
integer,intent(in) :: nS
|
integer,intent(in) :: nS
|
||||||
|
|
||||||
double precision,intent(in) :: ERHF
|
double precision,intent(in) :: ERHF
|
||||||
double precision,intent(in) :: eHF(nBas)
|
double precision,intent(in) :: eHF(nOrb)
|
||||||
double precision,intent(in) :: cHF(nBas,nBas)
|
double precision,intent(in) :: cHF(nBas,nOrb)
|
||||||
double precision,intent(in) :: PHF(nBas,nBas)
|
double precision,intent(in) :: PHF(nBas,nBas)
|
||||||
double precision,intent(in) :: S(nBas,nBas)
|
double precision,intent(in) :: S(nBas,nBas)
|
||||||
double precision,intent(in) :: T(nBas,nBas)
|
double precision,intent(in) :: T(nBas,nBas)
|
||||||
double precision,intent(in) :: V(nBas,nBas)
|
double precision,intent(in) :: V(nBas,nBas)
|
||||||
double precision,intent(in) :: Hc(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_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_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
|
! Local variables
|
||||||
@ -78,11 +82,11 @@ subroutine RGT(dotest,doG0T0pp,doevGTpp,doqsGTpp,doufG0T0pp,doG0T0eh,doevGTeh,do
|
|||||||
|
|
||||||
call wall_time(start_GT)
|
call wall_time(start_GT)
|
||||||
call RG0T0pp(dotest,doACFDT,exchange_kernel,doXBS,dophBSE,TDA_T,TDA,dBSE,dTDA,doppBSE,singlet,triplet, &
|
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)
|
call wall_time(end_GT)
|
||||||
|
|
||||||
t_GT = end_GT - start_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(*,*)
|
write(*,*)
|
||||||
|
|
||||||
end if
|
end if
|
||||||
@ -95,11 +99,11 @@ subroutine RGT(dotest,doG0T0pp,doevGTpp,doqsGTpp,doufG0T0pp,doG0T0eh,doevGTeh,do
|
|||||||
|
|
||||||
call wall_time(start_GT)
|
call wall_time(start_GT)
|
||||||
call evRGTpp(dotest,maxSCF,thresh,max_diis,doACFDT,exchange_kernel,doXBS,dophBSE,TDA_T,TDA,dBSE,dTDA,singlet,triplet, &
|
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)
|
call wall_time(end_GT)
|
||||||
|
|
||||||
t_GT = end_GT - start_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(*,*)
|
write(*,*)
|
||||||
|
|
||||||
end if
|
end if
|
||||||
@ -111,13 +115,13 @@ subroutine RGT(dotest,doG0T0pp,doevGTpp,doqsGTpp,doufG0T0pp,doG0T0eh,doevGTeh,do
|
|||||||
if(doqsGTpp) then
|
if(doqsGTpp) then
|
||||||
|
|
||||||
call wall_time(start_GT)
|
call wall_time(start_GT)
|
||||||
call qsRGTpp(dotest,maxSCF,thresh,max_diis,doACFDT,exchange_kernel,doXBS,dophBSE,TDA_T,TDA,dBSE,dTDA,singlet,triplet, &
|
call qsRGTpp(dotest, maxSCF, thresh, max_diis, doACFDT, exchange_kernel, doXBS, dophBSE, TDA_T, TDA, dBSE, &
|
||||||
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, &
|
dTDA, singlet, triplet, eta, regularize, nNuc, ZNuc, rNuc, ENuc, nBas, nOrb, nC, nO, &
|
||||||
PHF,cHF,eHF)
|
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)
|
call wall_time(end_GT)
|
||||||
|
|
||||||
t_GT = end_GT - start_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(*,*)
|
write(*,*)
|
||||||
|
|
||||||
end if
|
end if
|
||||||
@ -129,11 +133,11 @@ subroutine RGT(dotest,doG0T0pp,doevGTpp,doqsGTpp,doufG0T0pp,doG0T0eh,doevGTeh,do
|
|||||||
if(doufG0T0pp) then
|
if(doufG0T0pp) then
|
||||||
|
|
||||||
call wall_time(start_GT)
|
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)
|
call wall_time(end_GT)
|
||||||
|
|
||||||
t_GT = end_GT - start_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(*,*)
|
write(*,*)
|
||||||
|
|
||||||
end if
|
end if
|
||||||
@ -146,11 +150,11 @@ subroutine RGT(dotest,doG0T0pp,doevGTpp,doqsGTpp,doufG0T0pp,doG0T0eh,doevGTeh,do
|
|||||||
|
|
||||||
call wall_time(start_GT)
|
call wall_time(start_GT)
|
||||||
call RG0T0eh(dotest,doACFDT,exchange_kernel,doXBS,dophBSE,dophBSE2,TDA_T,TDA,dBSE,dTDA,doppBSE,singlet,triplet, &
|
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)
|
call wall_time(end_GT)
|
||||||
|
|
||||||
t_GT = end_GT - start_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(*,*)
|
write(*,*)
|
||||||
|
|
||||||
end if
|
end if
|
||||||
@ -163,11 +167,11 @@ subroutine RGT(dotest,doG0T0pp,doevGTpp,doqsGTpp,doufG0T0pp,doG0T0eh,doevGTeh,do
|
|||||||
|
|
||||||
call wall_time(start_GT)
|
call wall_time(start_GT)
|
||||||
call evRGTeh(dotest,maxSCF,thresh,max_diis,doACFDT,exchange_kernel,doXBS,dophBSE,dophBSE2,TDA_T,TDA,dBSE,dTDA,doppBSE, &
|
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)
|
call wall_time(end_GT)
|
||||||
|
|
||||||
t_GT = end_GT - start_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(*,*)
|
write(*,*)
|
||||||
|
|
||||||
end if
|
end if
|
||||||
@ -179,13 +183,14 @@ subroutine RGT(dotest,doG0T0pp,doevGTpp,doqsGTpp,doufG0T0pp,doG0T0eh,doevGTeh,do
|
|||||||
if(doqsGTeh) then
|
if(doqsGTeh) then
|
||||||
|
|
||||||
call wall_time(start_GT)
|
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, &
|
call qsRGTeh(dotest, maxSCF, thresh, max_diis, doACFDT, exchange_kernel, doXBS, dophBSE, &
|
||||||
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, &
|
dophBSE2, TDA_T, TDA, dBSE, dTDA, singlet, triplet, eta, regularize, nNuc, &
|
||||||
PHF,cHF,eHF)
|
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)
|
call wall_time(end_GT)
|
||||||
|
|
||||||
t_GT = end_GT - start_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(*,*)
|
write(*,*)
|
||||||
|
|
||||||
end if
|
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
|
! 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
|
! Input variables
|
||||||
|
|
||||||
integer,intent(in) :: nBas
|
integer,intent(in) :: nBas, nOrb
|
||||||
integer,intent(in) :: nO
|
integer,intent(in) :: nO
|
||||||
integer,intent(in) :: nSCF
|
integer,intent(in) :: nSCF
|
||||||
double precision,intent(in) :: ENuc
|
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) :: EcRPA(nspin)
|
||||||
double precision,intent(in) :: Conv
|
double precision,intent(in) :: Conv
|
||||||
double precision,intent(in) :: thresh
|
double precision,intent(in) :: thresh
|
||||||
double precision,intent(in) :: eHF(nBas)
|
double precision,intent(in) :: eHF(nOrb)
|
||||||
double precision,intent(in) :: eGT(nBas)
|
double precision,intent(in) :: eGT(nOrb)
|
||||||
double precision,intent(in) :: c(nBas)
|
double precision,intent(in) :: c(nBas,nOrb)
|
||||||
double precision,intent(in) :: SigC(nBas,nBas)
|
double precision,intent(in) :: SigC(nOrb,nOrb)
|
||||||
double precision,intent(in) :: Z(nBas)
|
double precision,intent(in) :: Z(nOrb)
|
||||||
double precision,intent(in) :: EqsGT
|
double precision,intent(in) :: EqsGT
|
||||||
double precision,intent(in) :: dipole(ncart)
|
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)','|'
|
'|','#','|','e_HF (eV)','|','Sig_GTeh (eV)','|','Z','|','e_GTeh (eV)','|'
|
||||||
write(*,*)'-------------------------------------------------------------------------------'
|
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)') &
|
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,'|'
|
'|',p,'|',eHF(p)*HaToeV,'|',SigC(p,p)*HaToeV,'|',Z(p),'|',eGT(p)*HaToeV,'|'
|
||||||
end do
|
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(*,'(A50)') '---------------------------------------'
|
||||||
write(*,'(A32)') ' qsGTeh MO coefficients'
|
write(*,'(A32)') ' qsGTeh MO coefficients'
|
||||||
write(*,'(A50)') '---------------------------------------'
|
write(*,'(A50)') '---------------------------------------'
|
||||||
call matout(nBas,nBas,c)
|
call matout(nBas, nOrb, c)
|
||||||
write(*,*)
|
write(*,*)
|
||||||
end if
|
end if
|
||||||
write(*,'(A50)') '---------------------------------------'
|
write(*,'(A50)') '---------------------------------------'
|
||||||
write(*,'(A32)') ' qsGTeh MO energies'
|
write(*,'(A32)') ' qsGTeh MO energies'
|
||||||
write(*,'(A50)') '---------------------------------------'
|
write(*,'(A50)') '---------------------------------------'
|
||||||
call vecout(nBas,eGT)
|
call vecout(nOrb, eGT)
|
||||||
write(*,*)
|
write(*,*)
|
||||||
|
|
||||||
end if
|
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
|
! 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
|
! Input variables
|
||||||
|
|
||||||
integer,intent(in) :: nBas
|
integer,intent(in) :: nBas, nOrb
|
||||||
integer,intent(in) :: nO
|
integer,intent(in) :: nO
|
||||||
integer,intent(in) :: nSCF
|
integer,intent(in) :: nSCF
|
||||||
double precision,intent(in) :: ENuc
|
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) :: EcRPA(nspin)
|
||||||
double precision,intent(in) :: Conv
|
double precision,intent(in) :: Conv
|
||||||
double precision,intent(in) :: thresh
|
double precision,intent(in) :: thresh
|
||||||
double precision,intent(in) :: eHF(nBas)
|
double precision,intent(in) :: eHF(nOrb)
|
||||||
double precision,intent(in) :: eGT(nBas)
|
double precision,intent(in) :: eGT(nOrb)
|
||||||
double precision,intent(in) :: c(nBas)
|
double precision,intent(in) :: c(nBas,nOrb)
|
||||||
double precision,intent(in) :: SigC(nBas,nBas)
|
double precision,intent(in) :: SigC(nOrb,nOrb)
|
||||||
double precision,intent(in) :: Z(nBas)
|
double precision,intent(in) :: Z(nOrb)
|
||||||
double precision,intent(in) :: EqsGT
|
double precision,intent(in) :: EqsGT
|
||||||
double precision,intent(in) :: dipole(ncart)
|
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)','|'
|
'|','#','|','e_HF (eV)','|','Sig_GTpp (eV)','|','Z','|','e_GTpp (eV)','|'
|
||||||
write(*,*)'-------------------------------------------------------------------------------'
|
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)') &
|
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,'|'
|
'|',p,'|',eHF(p)*HaToeV,'|',SigC(p,p)*HaToeV,'|',Z(p),'|',eGT(p)*HaToeV,'|'
|
||||||
end do
|
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(*,'(A50)') '---------------------------------------'
|
||||||
write(*,'(A32)') ' qsGTpp MO coefficients'
|
write(*,'(A32)') ' qsGTpp MO coefficients'
|
||||||
write(*,'(A50)') '---------------------------------------'
|
write(*,'(A50)') '---------------------------------------'
|
||||||
call matout(nBas,nBas,c)
|
call matout(nBas, nOrb, c)
|
||||||
write(*,*)
|
write(*,*)
|
||||||
end if
|
end if
|
||||||
write(*,'(A50)') '---------------------------------------'
|
write(*,'(A50)') '---------------------------------------'
|
||||||
write(*,'(A32)') ' qsGTpp MO energies'
|
write(*,'(A32)') ' qsGTpp MO energies'
|
||||||
write(*,'(A50)') '---------------------------------------'
|
write(*,'(A50)') '---------------------------------------'
|
||||||
call vecout(nBas,eGT)
|
call vecout(nOrb, eGT)
|
||||||
write(*,*)
|
write(*,*)
|
||||||
|
|
||||||
end if
|
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
|
! 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) :: rNuc(nNuc,ncart)
|
||||||
double precision,intent(in) :: ENuc
|
double precision,intent(in) :: ENuc
|
||||||
|
|
||||||
integer,intent(in) :: nBas
|
integer,intent(in) :: nBas, nOrb
|
||||||
integer,intent(in) :: nC
|
integer,intent(in) :: nC
|
||||||
integer,intent(in) :: nO
|
integer,intent(in) :: nO
|
||||||
integer,intent(in) :: nV
|
integer,intent(in) :: nV
|
||||||
integer,intent(in) :: nR
|
integer,intent(in) :: nR
|
||||||
integer,intent(in) :: nS
|
integer,intent(in) :: nS
|
||||||
double precision,intent(in) :: ERHF
|
double precision,intent(in) :: ERHF
|
||||||
double precision,intent(in) :: eHF(nBas)
|
double precision,intent(in) :: eHF(nOrb)
|
||||||
double precision,intent(in) :: cHF(nBas,nBas)
|
double precision,intent(in) :: cHF(nBas,nOrb)
|
||||||
double precision,intent(in) :: PHF(nBas,nBas)
|
double precision,intent(in) :: PHF(nBas,nBas)
|
||||||
double precision,intent(in) :: S(nBas,nBas)
|
double precision,intent(in) :: S(nBas,nBas)
|
||||||
double precision,intent(in) :: T(nBas,nBas)
|
double precision,intent(in) :: T(nBas,nBas)
|
||||||
double precision,intent(in) :: V(nBas,nBas)
|
double precision,intent(in) :: V(nBas,nBas)
|
||||||
double precision,intent(in) :: Hc(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_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_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
|
! Local variables
|
||||||
|
|
||||||
logical :: dRPA = .false.
|
logical :: dRPA = .false.
|
||||||
integer :: nSCF
|
integer :: nSCF
|
||||||
integer :: nBasSq
|
integer :: nBas_Sq
|
||||||
integer :: ispin
|
integer :: ispin
|
||||||
integer :: n_diis
|
integer :: n_diis
|
||||||
double precision :: ET
|
double precision :: ET
|
||||||
@ -113,7 +117,7 @@ subroutine qsRGTeh(dotest,maxSCF,thresh,max_diis,doACFDT,exchange_kernel,doXBS,d
|
|||||||
|
|
||||||
! Stuff
|
! Stuff
|
||||||
|
|
||||||
nBasSq = nBas*nBas
|
nBas_Sq = nBas*nBas
|
||||||
|
|
||||||
! TDA for T
|
! TDA for T
|
||||||
|
|
||||||
@ -131,9 +135,29 @@ subroutine qsRGTeh(dotest,maxSCF,thresh,max_diis,doACFDT,exchange_kernel,doXBS,d
|
|||||||
|
|
||||||
! Memory allocation
|
! 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), &
|
allocate(Aph(nS,nS), Bph(nS,nS), Om(nS), XpY(nS,nS), XmY(nS,nS))
|
||||||
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(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
|
! 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
|
! 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
|
! Compute linear response
|
||||||
|
|
||||||
call phLR_A(ispin,dRPA,nBas,nC,nO,nV,nR,nS,1d0,eGT,ERI_MO,Aph)
|
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,nBas,nC,nO,nV,nR,nS,1d0,ERI_MO,Bph)
|
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)
|
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
|
! 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
|
! Make correlation self-energy Hermitian and transform it back to AO basis
|
||||||
|
|
||||||
Sig = 0.5d0*(Sig + transpose(Sig))
|
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
|
! Solve the quasi-particle equation
|
||||||
|
|
||||||
F(:,:) = Hc(:,:) + J(:,:) + 0.5d0*K(:,:) + Sigp(:,:)
|
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
|
! 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
|
if(max_diis > 1) then
|
||||||
|
|
||||||
n_diis = min(n_diis+1,max_diis)
|
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
|
end if
|
||||||
|
|
||||||
! Diagonalize Hamiltonian in AO basis
|
! Diagonalize Hamiltonian in AO basis
|
||||||
|
|
||||||
|
if(nBas .eq. nOrb) then
|
||||||
Fp = matmul(transpose(X), matmul(F, X))
|
Fp = matmul(transpose(X), matmul(F, X))
|
||||||
cp(:,:) = Fp(:,:)
|
cp(:,:) = Fp(:,:)
|
||||||
call diagonalize_matrix(nBas,cp,eGT)
|
call diagonalize_matrix(nOrb, cp, eGT)
|
||||||
c = matmul(X, cp)
|
c = matmul(X, cp)
|
||||||
Sigp = matmul(transpose(c),matmul(Sigp,c))
|
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
|
! 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
|
! Print results
|
||||||
|
|
||||||
call dipole_moment(nBas,P,nNuc,ZNuc,rNuc,dipole_int_AO,dipole)
|
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
|
end do
|
||||||
!------------------------------------------------------------------------
|
!------------------------------------------------------------------------
|
||||||
@ -272,6 +307,8 @@ subroutine qsRGTeh(dotest,maxSCF,thresh,max_diis,doACFDT,exchange_kernel,doXBS,d
|
|||||||
write(*,*)'!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!'
|
write(*,*)'!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!'
|
||||||
write(*,*)
|
write(*,*)
|
||||||
|
|
||||||
|
deallocate(c, cp, P, F, Fp, J, K, Sig, Sigp, Z, Om, XpY, XmY, rhoL, rhoR, err, err_diis, F_diis)
|
||||||
|
|
||||||
stop
|
stop
|
||||||
|
|
||||||
end if
|
end if
|
||||||
|
@ -1,6 +1,9 @@
|
|||||||
|
|
||||||
|
! ---
|
||||||
|
|
||||||
subroutine qsRGTpp(dotest, maxSCF, thresh, max_diis, doACFDT, exchange_kernel, doXBS, dophBSE, TDA_T, TDA, &
|
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, &
|
dBSE, dTDA, singlet, triplet, eta, regularize, nNuc, ZNuc, rNuc, ENuc, nBas, nOrb, &
|
||||||
S,X,T,V,Hc,ERI_AO,ERI_MO,dipole_int_AO,dipole_int_MO,PHF,cHF,eHF)
|
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
|
! 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) :: rNuc(nNuc,ncart)
|
||||||
double precision,intent(in) :: ENuc
|
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) :: ERHF
|
||||||
double precision,intent(in) :: eHF(nBas)
|
double precision,intent(in) :: eHF(nOrb)
|
||||||
double precision,intent(in) :: cHF(nBas,nBas)
|
double precision,intent(in) :: cHF(nBas,nOrb)
|
||||||
double precision,intent(in) :: PHF(nBas,nBas)
|
double precision,intent(in) :: PHF(nBas,nBas)
|
||||||
double precision,intent(in) :: S(nBas,nBas)
|
double precision,intent(in) :: S(nBas,nBas)
|
||||||
double precision,intent(in) :: T(nBas,nBas)
|
double precision,intent(in) :: T(nBas,nBas)
|
||||||
double precision,intent(in) :: V(nBas,nBas)
|
double precision,intent(in) :: V(nBas,nBas)
|
||||||
double precision,intent(in) :: Hc(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_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_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
|
! Local variables
|
||||||
|
|
||||||
integer :: nSCF
|
integer :: nSCF
|
||||||
integer :: nBasSq
|
integer :: nBas_Sq
|
||||||
integer :: ispin
|
integer :: ispin
|
||||||
integer :: iblock
|
integer :: iblock
|
||||||
integer :: n_diis
|
integer :: n_diis
|
||||||
@ -119,7 +123,7 @@ subroutine qsRGTpp(dotest,maxSCF,thresh,max_diis,doACFDT,exchange_kernel,doXBS,d
|
|||||||
|
|
||||||
! Stuff
|
! Stuff
|
||||||
|
|
||||||
nBasSq = nBas*nBas
|
nBas_Sq = nBas*nBas
|
||||||
|
|
||||||
! TDA for T
|
! TDA for T
|
||||||
|
|
||||||
@ -137,16 +141,30 @@ subroutine qsRGTpp(dotest,maxSCF,thresh,max_diis,doACFDT,exchange_kernel,doXBS,d
|
|||||||
|
|
||||||
! Memory allocation
|
! Memory allocation
|
||||||
|
|
||||||
allocate(eGT(nBas),eOld(nBas),c(nBas,nBas),cp(nBas,nBas),P(nBas,nBas),F(nBas,nBas),Fp(nBas,nBas), &
|
allocate(eGT(nOrb))
|
||||||
J(nBas,nBas),K(nBas,nBas),Sig(nBas,nBas),Sigp(nBas,nBas),Z(nBas), &
|
allocate(eOld(nOrb))
|
||||||
error(nBas,nBas),error_diis(nBasSq,max_diis),F_diis(nBasSq,max_diis))
|
allocate(Z(nOrb))
|
||||||
|
|
||||||
allocate(Om1s(nVVs),X1s(nVVs,nVVs),Y1s(nOOs,nVVs), &
|
allocate(c(nBas,nOrb))
|
||||||
Om2s(nOOs),X2s(nVVs,nOOs),Y2s(nOOs,nOOs), &
|
|
||||||
rho1s(nBas,nBas,nVVs),rho2s(nBas,nBas,nOOs), &
|
allocate(Fp(nOrb,nOrb))
|
||||||
Om1t(nVVt),X1t(nVVt,nVVt),Y1t(nOOt,nVVt), &
|
allocate(cp(nOrb,nOrb))
|
||||||
Om2t(nOOt),X2t(nVVt,nOOt),Y2t(nOOt,nOOt), &
|
allocate(Sig(nOrb,nOrb))
|
||||||
rho1t(nBas,nBas,nVVt),rho2t(nBas,nBas,nOOt))
|
|
||||||
|
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
|
! 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
|
! 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
|
! 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))
|
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,nOrb,nC,nO,nV,nR,nVVs,1d0,eGT,ERI_MO,Cpp)
|
||||||
call ppLR_C(iblock,nBas,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)
|
||||||
call ppLR_D(iblock,nBas,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))
|
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))
|
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,nOrb,nC,nO,nV,nR,nVVt,1d0,eGT,ERI_MO,Cpp)
|
||||||
call ppLR_C(iblock,nBas,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)
|
||||||
call ppLR_D(iblock,nBas,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))
|
call ppLR(TDA_T,nOOt,nVVt,Bpp,Cpp,Dpp,Om1t,X1t,Y1t,Om2t,X2t,Y2t,EcRPA(ispin))
|
||||||
|
|
||||||
@ -218,28 +236,32 @@ subroutine qsRGTpp(dotest,maxSCF,thresh,max_diis,doACFDT,exchange_kernel,doXBS,d
|
|||||||
! Compute correlation part of the self-energy
|
! Compute correlation part of the self-energy
|
||||||
|
|
||||||
iblock = 3
|
iblock = 3
|
||||||
call GTpp_excitation_density(iblock,nBas,nC,nO,nV,nR,nOOs,nVVs,ERI_MO,X1s,Y1s,rho1s,X2s,Y2s,rho2s)
|
call GTpp_excitation_density(iblock,nOrb,nC,nO,nV,nR,nOOs,nVVs,ERI_MO,X1s,Y1s,rho1s,X2s,Y2s,rho2s)
|
||||||
|
|
||||||
iblock = 4
|
iblock = 4
|
||||||
call GTpp_excitation_density(iblock,nBas,nC,nO,nV,nR,nOOt,nVVt,ERI_MO,X1t,Y1t,rho1t,X2t,Y2t,rho2t)
|
call GTpp_excitation_density(iblock,nOrb,nC,nO,nV,nR,nOOt,nVVt,ERI_MO,X1t,Y1t,rho1t,X2t,Y2t,rho2t)
|
||||||
|
|
||||||
if(regularize) then
|
if(regularize) then
|
||||||
call GTpp_regularization(eta,nBas,nC,nO,nV,nR,nOOs,nVVs,eGT,Om1s,rho1s,Om2s,rho2s)
|
call GTpp_regularization(eta,nOrb,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,nOOt,nVVt,eGT,Om1t,rho1t,Om2t,rho2t)
|
||||||
end if
|
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)
|
Om1t,rho1t,Om2t,rho2t,EcGM,Sig,Z)
|
||||||
|
|
||||||
! Make correlation self-energy Hermitian and transform it back to AO basis
|
! Make correlation self-energy Hermitian and transform it back to AO basis
|
||||||
|
|
||||||
Sig = 0.5d0*(Sig + transpose(Sig))
|
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
|
! Solve the quasi-particle equation
|
||||||
|
|
||||||
F(:,:) = Hc(:,:) + J(:,:) + 0.5d0*K(:,:) + Sigp(:,:)
|
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
|
! Compute commutator and convergence criteria
|
||||||
|
|
||||||
@ -249,18 +271,24 @@ subroutine qsRGTpp(dotest,maxSCF,thresh,max_diis,doACFDT,exchange_kernel,doXBS,d
|
|||||||
|
|
||||||
n_diis = min(n_diis+1,max_diis)
|
n_diis = min(n_diis+1,max_diis)
|
||||||
if(abs(rcond) > 1d-7) then
|
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
|
else
|
||||||
n_diis = 0
|
n_diis = 0
|
||||||
end if
|
end if
|
||||||
|
|
||||||
! Diagonalize Hamiltonian in AO basis
|
! Diagonalize Hamiltonian in AO basis
|
||||||
|
|
||||||
|
if(nBas .eq. nOrb) then
|
||||||
Fp = matmul(transpose(X), matmul(F, X))
|
Fp = matmul(transpose(X), matmul(F, X))
|
||||||
cp(:,:) = Fp(:,:)
|
cp(:,:) = Fp(:,:)
|
||||||
call diagonalize_matrix(nBas,cp,eGT)
|
call diagonalize_matrix(nOrb, cp, eGT)
|
||||||
c = matmul(X, cp)
|
c = matmul(X, cp)
|
||||||
Sigp = matmul(transpose(c),matmul(Sigp,c))
|
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
|
! Compute new density matrix in the AO basis
|
||||||
|
|
||||||
@ -298,7 +326,9 @@ subroutine qsRGTpp(dotest,maxSCF,thresh,max_diis,doACFDT,exchange_kernel,doXBS,d
|
|||||||
! Print results
|
! Print results
|
||||||
|
|
||||||
call dipole_moment(nBas,P,nNuc,ZNuc,rNuc,dipole_int_AO,dipole)
|
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
|
end do
|
||||||
!------------------------------------------------------------------------
|
!------------------------------------------------------------------------
|
||||||
@ -315,6 +345,11 @@ subroutine qsRGTpp(dotest,maxSCF,thresh,max_diis,doACFDT,exchange_kernel,doXBS,d
|
|||||||
write(*,*)'!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!'
|
write(*,*)'!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!'
|
||||||
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
|
stop
|
||||||
|
|
||||||
end if
|
end if
|
||||||
@ -327,7 +362,7 @@ subroutine qsRGTpp(dotest,maxSCF,thresh,max_diis,doACFDT,exchange_kernel,doXBS,d
|
|||||||
|
|
||||||
if(dophBSE) then
|
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, &
|
Om1s,X1s,Y1s,Om2s,X2s,Y2s,rho1s,rho2s,Om1t,X1t,Y1t,Om2t,X2t,Y2t,rho1t,rho2t, &
|
||||||
ERI_MO,dipole_int_MO,eGT,eGT,EcBSE)
|
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
|
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, &
|
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)
|
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
|
end if
|
||||||
|
|
||||||
|
deallocate(Om1s, X1s, Y1s, rho1s)
|
||||||
|
deallocate(Om2s, X2s, Y2s, rho2s)
|
||||||
|
deallocate(Om1t, X1t, Y1t, rho1t)
|
||||||
|
deallocate(Om2t, X2t, Y2t, rho2t)
|
||||||
|
|
||||||
end subroutine
|
end subroutine
|
||||||
|
@ -280,7 +280,7 @@ subroutine qsUGTpp(dotest,maxSCF,thresh,max_diis,doACFDT,exchange_kernel,doXBS,B
|
|||||||
end do
|
end do
|
||||||
|
|
||||||
do ispin=1,nspin
|
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
|
end do
|
||||||
|
|
||||||
! Solve the quasi-particle equation
|
! 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)
|
double precision,intent(out) :: EcBSE(nspin)
|
||||||
|
|
||||||
|
|
||||||
!---------------------------------
|
!---------------------------------
|
||||||
! Compute (singlet) RPA screening
|
! Compute (singlet) RPA screening
|
||||||
!---------------------------------
|
!---------------------------------
|
||||||
@ -77,9 +78,11 @@ subroutine GW_ppBSE(TDA_W,TDA,dBSE,dTDA,singlet,triplet,eta,nBas,nC,nO,nV,nR,nS,
|
|||||||
Aph(nS,nS),Bph(nS,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)
|
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 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)
|
call GW_excitation_density(nBas,nC,nO,nR,nS,ERI,XpY_RPA,rho_RPA)
|
||||||
|
|
||||||
deallocate(XpY_RPA,XmY_RPA,Aph,Bph)
|
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
|
! Compute BSE excitation energies
|
||||||
|
|
||||||
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_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 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)
|
||||||
|
|
||||||
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_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)
|
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)
|
||||||
|
|
||||||
Bpp(:,:) = Bpp(:,:) + KB_sta(:,:)
|
Bpp(:,:) = Bpp(:,:) + KB_sta(:,:)
|
||||||
Cpp(:,:) = Cpp(:,:) + KC_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) &
|
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, &
|
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)
|
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)
|
deallocate(Om1,X1,Y1,Om2,X2,Y2,Bpp,Cpp,Dpp,KB_sta,KC_sta,KD_sta)
|
||||||
write(*,*) "Deallocate done"
|
|
||||||
end if
|
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
|
! Compute BSE excitation energies
|
||||||
|
|
||||||
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_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 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)
|
||||||
|
|
||||||
|
|
||||||
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_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)
|
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)
|
||||||
|
|
||||||
Bpp(:,:) = Bpp(:,:) + KB_sta(:,:)
|
Bpp(:,:) = Bpp(:,:) + KB_sta(:,:)
|
||||||
Cpp(:,:) = Cpp(:,:) + KC_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,external :: Kronecker_delta
|
||||||
double precision :: chi
|
double precision :: chi
|
||||||
double precision :: eps
|
double precision :: eps
|
||||||
|
double precision :: tmp_ab, lambda4, eta2
|
||||||
integer :: a,b,c,d,ab,cd,m
|
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
|
! Output variables
|
||||||
|
|
||||||
double precision,intent(out) :: KC(nVV,nVV)
|
double precision,intent(out) :: KC(nVV,nVV)
|
||||||
|
|
||||||
! Initialization
|
|
||||||
|
|
||||||
KC(:,:) = 0d0
|
|
||||||
|
|
||||||
!---------------!
|
!---------------!
|
||||||
! Singlet block !
|
! Singlet block !
|
||||||
!---------------!
|
!---------------!
|
||||||
|
|
||||||
if(ispin == 1) then
|
if(ispin == 1) then
|
||||||
|
|
||||||
ab = 0
|
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
|
do a = nO+1, nBas-nR
|
||||||
|
aa = a0 * (a - nO - 1) - (a - nO - 1) * (a - nO) / 2 - nO
|
||||||
do b = a, nBas-nR
|
do b = a, nBas-nR
|
||||||
ab = ab + 1
|
ab = aa + b
|
||||||
|
|
||||||
|
tmp_ab = lambda4
|
||||||
|
if(a .eq. b) then
|
||||||
|
tmp_ab = 0.7071067811865475d0 * lambda4
|
||||||
|
endif
|
||||||
|
|
||||||
cd = 0
|
cd = 0
|
||||||
do c = nO+1, nBas-nR
|
do c = nO+1, nBas-nR
|
||||||
do d = c, nBas-nR
|
do d = c, nBas-nR
|
||||||
cd = cd + 1
|
cd = cd + 1
|
||||||
|
|
||||||
chi = 0d0
|
KC(ab,cd) = -tmp_ab * (tmp(a,c,b,d) + tmp(a,d,b,c))
|
||||||
do m=1,nS
|
if(c .eq. d) then
|
||||||
eps = Om(m)**2 + eta**2
|
KC(ab,cd) = 0.7071067811865475d0 * KC(ab,cd)
|
||||||
chi = chi - rho(a,c,m)*rho(b,d,m)*Om(m)/eps &
|
endif
|
||||||
- rho(a,d,m)*rho(b,c,m)*Om(m)/eps
|
|
||||||
enddo
|
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
|
! do a=nO+1,nBas-nR
|
||||||
end do
|
! do b=a,nBas-nR
|
||||||
end do
|
! 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
|
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
|
if(ispin == 2) then
|
||||||
|
|
||||||
ab = 0
|
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
|
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
|
do b = a+1, nBas-nR
|
||||||
ab = ab + 1
|
ab = aa + b
|
||||||
|
|
||||||
cd = 0
|
cd = 0
|
||||||
do c = nO+1, nBas-nR
|
do c = nO+1, nBas-nR
|
||||||
do d = c+1, nBas-nR
|
do d = c+1, nBas-nR
|
||||||
cd = cd + 1
|
cd = cd + 1
|
||||||
|
|
||||||
chi = 0d0
|
KC(ab,cd) = lambda4 * (-tmp(a,c,b,d) + tmp(a,d,b,c))
|
||||||
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
|
|
||||||
enddo
|
enddo
|
||||||
|
enddo
|
||||||
|
enddo
|
||||||
|
enddo
|
||||||
|
!$OMP END DO
|
||||||
|
!$OMP END PARALLEL
|
||||||
|
|
||||||
KC(ab,cd) = 4d0*lambda*chi
|
deallocate(tmp)
|
||||||
|
|
||||||
end do
|
|
||||||
end do
|
! --- --- ---
|
||||||
end do
|
! OpenMP implementation
|
||||||
end do
|
! --- --- ---
|
||||||
|
!
|
||||||
|
! 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
|
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 :: eGWlin(:)
|
||||||
double precision,allocatable :: eGW(:)
|
double precision,allocatable :: eGW(:)
|
||||||
|
|
||||||
|
|
||||||
! Output variables
|
! Output variables
|
||||||
|
|
||||||
! Hello world
|
! Hello world
|
||||||
@ -102,6 +103,7 @@ subroutine RG0W0(dotest,doACFDT,exchange_kernel,doXBS,dophBSE,dophBSE2,TDA_W,TDA
|
|||||||
!-------------------!
|
!-------------------!
|
||||||
|
|
||||||
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)
|
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)
|
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
|
! Compute the RPA correlation energy
|
||||||
|
|
||||||
call phLR_A(ispin,dRPA,nBas,nC,nO,nV,nR,nS,1d0,eGW,ERI,Aph)
|
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)
|
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)
|
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, &
|
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, &
|
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, &
|
linearize, eta, regularize, nNuc, ZNuc, rNuc, ENuc, nBas, nOrb, nC, nO, nV, nR, nS, ERHF, &
|
||||||
ERI_AO,ERI_MO,dipole_int_AO,dipole_int,PHF,cHF,eHF)
|
S, X, T, V, Hc, ERI_AO, ERI_MO, dipole_int_AO, dipole_int_MO, PHF, cHF, eHF)
|
||||||
|
|
||||||
! Restricted GW module
|
! 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) :: rNuc(nNuc,ncart)
|
||||||
double precision,intent(in) :: ENuc
|
double precision,intent(in) :: ENuc
|
||||||
|
|
||||||
integer,intent(in) :: nBas
|
integer,intent(in) :: nBas, nOrb
|
||||||
integer,intent(in) :: nC
|
integer,intent(in) :: nC
|
||||||
integer,intent(in) :: nO
|
integer,intent(in) :: nO
|
||||||
integer,intent(in) :: nV
|
integer,intent(in) :: nV
|
||||||
@ -51,18 +54,18 @@ subroutine RGW(dotest,doG0W0,doevGW,doqsGW,doufG0W0,doufGW,doSRGqsGW,maxSCF,thre
|
|||||||
integer,intent(in) :: nS
|
integer,intent(in) :: nS
|
||||||
|
|
||||||
double precision,intent(in) :: ERHF
|
double precision,intent(in) :: ERHF
|
||||||
double precision,intent(in) :: eHF(nBas)
|
double precision,intent(in) :: eHF(nOrb)
|
||||||
double precision,intent(in) :: cHF(nBas,nBas)
|
double precision,intent(in) :: cHF(nBas,nOrb)
|
||||||
double precision,intent(in) :: PHF(nBas,nBas)
|
double precision,intent(in) :: PHF(nBas,nBas)
|
||||||
double precision,intent(in) :: S(nBas,nBas)
|
double precision,intent(in) :: S(nBas,nBas)
|
||||||
double precision,intent(in) :: T(nBas,nBas)
|
double precision,intent(in) :: T(nBas,nBas)
|
||||||
double precision,intent(in) :: V(nBas,nBas)
|
double precision,intent(in) :: V(nBas,nBas)
|
||||||
double precision,intent(in) :: Hc(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_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_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
|
! Local variables
|
||||||
|
|
||||||
@ -76,11 +79,11 @@ subroutine RGW(dotest,doG0W0,doevGW,doqsGW,doufG0W0,doufGW,doSRGqsGW,maxSCF,thre
|
|||||||
|
|
||||||
call wall_time(start_GW)
|
call wall_time(start_GW)
|
||||||
call RG0W0(dotest,doACFDT,exchange_kernel,doXBS,dophBSE,dophBSE2,TDA_W,TDA,dBSE,dTDA,doppBSE,singlet,triplet, &
|
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)
|
call wall_time(end_GW)
|
||||||
|
|
||||||
t_GW = end_GW - start_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(*,*)
|
write(*,*)
|
||||||
|
|
||||||
end if
|
end if
|
||||||
@ -93,11 +96,11 @@ subroutine RGW(dotest,doG0W0,doevGW,doqsGW,doufG0W0,doufGW,doSRGqsGW,maxSCF,thre
|
|||||||
|
|
||||||
call wall_time(start_GW)
|
call wall_time(start_GW)
|
||||||
call evRGW(dotest,maxSCF,thresh,max_diis,doACFDT,exchange_kernel,doXBS,dophBSE,dophBSE2,TDA_W,TDA,dBSE,dTDA,doppBSE, &
|
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)
|
call wall_time(end_GW)
|
||||||
|
|
||||||
t_GW = end_GW - start_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(*,*)
|
write(*,*)
|
||||||
|
|
||||||
end if
|
end if
|
||||||
@ -109,13 +112,14 @@ subroutine RGW(dotest,doG0W0,doevGW,doqsGW,doufG0W0,doufGW,doSRGqsGW,maxSCF,thre
|
|||||||
if(doqsGW) then
|
if(doqsGW) then
|
||||||
|
|
||||||
call wall_time(start_GW)
|
call wall_time(start_GW)
|
||||||
call qsRGW(dotest,maxSCF,thresh,max_diis,doACFDT,exchange_kernel,doXBS,dophBSE,dophBSE2,TDA_W,TDA,dBSE,dTDA,doppBSE, &
|
call qsRGW(dotest, maxSCF, thresh, max_diis, doACFDT, exchange_kernel, doXBS, dophBSE, dophBSE2, &
|
||||||
singlet,triplet,eta,regularize,nNuc,ZNuc,rNuc,ENuc,nBas,nC,nO,nV,nR,nS,ERHF,S,X,T,V,Hc,ERI_AO,ERI_MO, &
|
TDA_W, TDA, dBSE, dTDA, doppBSE, singlet, triplet, eta, regularize, nNuc, ZNuc, rNuc, &
|
||||||
dipole_int_AO,dipole_int,PHF,cHF,eHF)
|
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)
|
call wall_time(end_GW)
|
||||||
|
|
||||||
t_GW = end_GW - start_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(*,*)
|
write(*,*)
|
||||||
|
|
||||||
end if
|
end if
|
||||||
@ -127,13 +131,15 @@ subroutine RGW(dotest,doG0W0,doevGW,doqsGW,doufG0W0,doufGW,doSRGqsGW,maxSCF,thre
|
|||||||
if(doSRGqsGW) then
|
if(doSRGqsGW) then
|
||||||
|
|
||||||
call wall_time(start_GW)
|
call wall_time(start_GW)
|
||||||
call SRG_qsGW(dotest,maxSCF,thresh,max_diis,doACFDT,exchange_kernel,doXBS,dophBSE,dophBSE2,TDA_W,TDA,dBSE,dTDA, &
|
call SRG_qsGW(dotest, maxSCF, thresh, max_diis, doACFDT, exchange_kernel, doXBS, &
|
||||||
singlet,triplet,eta,nNuc,ZNuc,rNuc,ENuc,nBas,nC,nO,nV,nR,nS,ERHF,S,X,T,V,Hc,ERI_AO,ERI_MO, &
|
dophBSE, dophBSE2, TDA_W, TDA, dBSE, dTDA, singlet, triplet, eta, &
|
||||||
dipole_int_AO,dipole_int,PHF,cHF,eHF)
|
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)
|
call wall_time(end_GW)
|
||||||
|
|
||||||
t_GW = end_GW - start_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(*,*)
|
write(*,*)
|
||||||
|
|
||||||
end if
|
end if
|
||||||
@ -145,11 +151,12 @@ subroutine RGW(dotest,doG0W0,doevGW,doqsGW,doufG0W0,doufGW,doSRGqsGW,maxSCF,thre
|
|||||||
if(doufG0W0) then
|
if(doufG0W0) then
|
||||||
|
|
||||||
call wall_time(start_GW)
|
call wall_time(start_GW)
|
||||||
|
! TODO
|
||||||
call ufG0W0(dotest,TDA_W,nBas,nC,nO,nV,nR,nS,ENuc,ERHF,ERI_MO,eHF)
|
call ufG0W0(dotest,TDA_W,nBas,nC,nO,nV,nR,nS,ENuc,ERHF,ERI_MO,eHF)
|
||||||
call wall_time(end_GW)
|
call wall_time(end_GW)
|
||||||
|
|
||||||
t_GW = end_GW - start_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(*,*)
|
write(*,*)
|
||||||
|
|
||||||
end if
|
end if
|
||||||
@ -161,11 +168,12 @@ subroutine RGW(dotest,doG0W0,doevGW,doqsGW,doufG0W0,doufGW,doSRGqsGW,maxSCF,thre
|
|||||||
if(doufGW) then
|
if(doufGW) then
|
||||||
|
|
||||||
call wall_time(start_GW)
|
call wall_time(start_GW)
|
||||||
|
! TODO
|
||||||
call ufGW(dotest,TDA_W,nBas,nC,nO,nV,nR,nS,ENuc,ERHF,ERI_MO,eHF)
|
call ufGW(dotest,TDA_W,nBas,nC,nO,nV,nR,nS,ENuc,ERHF,ERI_MO,eHF)
|
||||||
call wall_time(end_GW)
|
call wall_time(end_GW)
|
||||||
|
|
||||||
t_GW = end_GW - start_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(*,*)
|
write(*,*)
|
||||||
|
|
||||||
end if
|
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
|
! 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) :: rNuc(nNuc,ncart)
|
||||||
double precision,intent(in) :: ENuc
|
double precision,intent(in) :: ENuc
|
||||||
|
|
||||||
integer,intent(in) :: nBas
|
integer,intent(in) :: nBas, nOrb
|
||||||
integer,intent(in) :: nC
|
integer,intent(in) :: nC
|
||||||
integer,intent(in) :: nO
|
integer,intent(in) :: nO
|
||||||
integer,intent(in) :: nV
|
integer,intent(in) :: nV
|
||||||
integer,intent(in) :: nR
|
integer,intent(in) :: nR
|
||||||
integer,intent(in) :: nS
|
integer,intent(in) :: nS
|
||||||
double precision,intent(in) :: ERHF
|
double precision,intent(in) :: ERHF
|
||||||
double precision,intent(in) :: eHF(nBas)
|
double precision,intent(in) :: eHF(nOrb)
|
||||||
double precision,intent(in) :: cHF(nBas,nBas)
|
double precision,intent(in) :: cHF(nBas,nOrb)
|
||||||
double precision,intent(in) :: PHF(nBas,nBas)
|
double precision,intent(in) :: PHF(nBas,nBas)
|
||||||
double precision,intent(in) :: S(nBas,nBas)
|
double precision,intent(in) :: S(nBas,nBas)
|
||||||
double precision,intent(in) :: T(nBas,nBas)
|
double precision,intent(in) :: T(nBas,nBas)
|
||||||
double precision,intent(in) :: V(nBas,nBas)
|
double precision,intent(in) :: V(nBas,nBas)
|
||||||
double precision,intent(in) :: Hc(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_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_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
|
! Local variables
|
||||||
|
|
||||||
integer :: nSCF
|
integer :: nSCF
|
||||||
integer :: nBasSq
|
integer :: nBas_Sq
|
||||||
integer :: ispin
|
integer :: ispin
|
||||||
integer :: ixyz
|
integer :: ixyz
|
||||||
integer :: n_diis
|
integer :: n_diis
|
||||||
@ -114,7 +118,7 @@ subroutine SRG_qsGW(dotest,maxSCF,thresh,max_diis,doACFDT,exchange_kernel,doXBS,
|
|||||||
|
|
||||||
! Stuff
|
! Stuff
|
||||||
|
|
||||||
nBasSq = nBas*nBas
|
nBas_Sq = nBas*nBas
|
||||||
|
|
||||||
! TDA for W
|
! TDA for W
|
||||||
|
|
||||||
@ -132,9 +136,32 @@ subroutine SRG_qsGW(dotest,maxSCF,thresh,max_diis,doACFDT,exchange_kernel,doXBS,
|
|||||||
|
|
||||||
! Memory allocation
|
! Memory allocation
|
||||||
|
|
||||||
allocate(eGW(nBas),eOld(nBas),c(nBas,nBas),cp(nBas,nBas),P(nBas,nBas),F(nBas,nBas),Fp(nBas,nBas), &
|
allocate(eGW(nOrb))
|
||||||
J(nBas,nBas),K(nBas,nBas),SigC(nBas,nBas),SigCp(nBas,nBas),Z(nBas),Aph(nS,nS),Bph(nS,nS), &
|
allocate(eOld(nOrb))
|
||||||
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(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
|
! Initialization
|
||||||
|
|
||||||
@ -175,10 +202,10 @@ subroutine SRG_qsGW(dotest,maxSCF,thresh,max_diis,doACFDT,exchange_kernel,doXBS,
|
|||||||
call wall_time(tao1)
|
call wall_time(tao1)
|
||||||
|
|
||||||
do ixyz = 1, ncart
|
do ixyz = 1, ncart
|
||||||
call AOtoMO(nBas,cHF,dipole_int_AO(:,:,ixyz),dipole_int_MO(:,:,ixyz))
|
call AOtoMO(nBas, nOrb, cHF, dipole_int_AO(1,1,ixyz), dipole_int_MO(1,1,ixyz))
|
||||||
end do
|
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)
|
call wall_time(tao2)
|
||||||
|
|
||||||
@ -188,8 +215,8 @@ subroutine SRG_qsGW(dotest,maxSCF,thresh,max_diis,doACFDT,exchange_kernel,doXBS,
|
|||||||
|
|
||||||
call wall_time(tlr1)
|
call wall_time(tlr1)
|
||||||
|
|
||||||
call phLR_A(ispin,dRPA,nBas,nC,nO,nV,nR,nS,1d0,eGW,ERI_MO,Aph)
|
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,nBas,nC,nO,nV,nR,nS,1d0,ERI_MO,Bph)
|
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)
|
||||||
|
|
||||||
@ -203,13 +230,13 @@ subroutine SRG_qsGW(dotest,maxSCF,thresh,max_diis,doACFDT,exchange_kernel,doXBS,
|
|||||||
|
|
||||||
call wall_time(tex1)
|
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)
|
call wall_time(tex2)
|
||||||
tex=tex+tex2-tex1
|
tex=tex+tex2-tex1
|
||||||
|
|
||||||
call wall_time(tsrg1)
|
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)
|
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
|
! Make correlation self-energy Hermitian and transform it back to AO basis
|
||||||
|
|
||||||
call wall_time(tmo1)
|
call wall_time(tmo1)
|
||||||
call MOtoAO(nBas,S,c,SigC,SigCp)
|
call MOtoAO(nBas, nOrb, S, c, SigC, SigCp)
|
||||||
call wall_time(tmo2)
|
call wall_time(tmo2)
|
||||||
tmo = tmo + tmo2 - tmo1
|
tmo = tmo + tmo2 - tmo1
|
||||||
! Solve the quasi-particle equation
|
! Solve the quasi-particle equation
|
||||||
@ -234,7 +261,7 @@ subroutine SRG_qsGW(dotest,maxSCF,thresh,max_diis,doACFDT,exchange_kernel,doXBS,
|
|||||||
if(max_diis > 1) then
|
if(max_diis > 1) then
|
||||||
|
|
||||||
n_diis = min(n_diis+1,max_diis)
|
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
|
end if
|
||||||
|
|
||||||
@ -242,10 +269,10 @@ subroutine SRG_qsGW(dotest,maxSCF,thresh,max_diis,doACFDT,exchange_kernel,doXBS,
|
|||||||
|
|
||||||
Fp = matmul(transpose(X), matmul(F, X))
|
Fp = matmul(transpose(X), matmul(F, X))
|
||||||
cp(:,:) = Fp(:,:)
|
cp(:,:) = Fp(:,:)
|
||||||
call diagonalize_matrix(nBas,cp,eGW)
|
call diagonalize_matrix(nOrb, cp, eGW)
|
||||||
c = matmul(X, cp)
|
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
|
! 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
|
! Print results
|
||||||
|
|
||||||
call dipole_moment(nBas,P,nNuc,ZNuc,rNuc,dipole_int_AO,dipole)
|
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
|
end do
|
||||||
!------------------------------------------------------------------------
|
!------------------------------------------------------------------------
|
||||||
@ -300,6 +328,8 @@ subroutine SRG_qsGW(dotest,maxSCF,thresh,max_diis,doACFDT,exchange_kernel,doXBS,
|
|||||||
write(*,*)'!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!'
|
write(*,*)'!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!'
|
||||||
write(*,*)
|
write(*,*)
|
||||||
|
|
||||||
|
deallocate(c, cp, P, F, Fp, J, K, SigC, Z, Om, XpY, XmY, rho, error, error_diis, F_diis)
|
||||||
|
|
||||||
stop
|
stop
|
||||||
|
|
||||||
end if
|
end if
|
||||||
@ -313,7 +343,7 @@ subroutine SRG_qsGW(dotest,maxSCF,thresh,max_diis,doACFDT,exchange_kernel,doXBS,
|
|||||||
|
|
||||||
! Cumulant expansion
|
! 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 memory
|
||||||
|
|
||||||
@ -323,7 +353,8 @@ subroutine SRG_qsGW(dotest,maxSCF,thresh,max_diis,doACFDT,exchange_kernel,doXBS,
|
|||||||
|
|
||||||
if(BSE) then
|
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
|
if(exchange_kernel) then
|
||||||
|
|
||||||
@ -357,7 +388,8 @@ subroutine SRG_qsGW(dotest,maxSCF,thresh,max_diis,doACFDT,exchange_kernel,doXBS,
|
|||||||
|
|
||||||
end if
|
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(*,*)
|
||||||
write(*,*)'-------------------------------------------------------------------------------'
|
write(*,*)'-------------------------------------------------------------------------------'
|
||||||
|
@ -184,8 +184,8 @@ subroutine SRG_qsUGW(dotest,maxSCF,thresh,max_diis,doACFDT,exchange_kernel,doXBS
|
|||||||
!--------------------------------------------------
|
!--------------------------------------------------
|
||||||
|
|
||||||
do ixyz=1,ncart
|
do ixyz=1,ncart
|
||||||
call AOtoMO(nBas,c(:,:,1),dipole_int_AO(:,:,ixyz),dipole_int_aa(:,:,ixyz))
|
call AOtoMO(nBas,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(:,:,2),dipole_int_AO(:,:,ixyz),dipole_int_bb(:,:,ixyz))
|
||||||
end do
|
end do
|
||||||
|
|
||||||
! 4-index transform for (aa|aa) block
|
! 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
|
! Make correlation self-energy Hermitian and transform it back to AO basis
|
||||||
|
|
||||||
do is=1,nspin
|
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
|
end do
|
||||||
|
|
||||||
! Solve the quasi-particle equation
|
! 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
|
! Back-transform self-energy
|
||||||
|
|
||||||
do is=1,nspin
|
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
|
end do
|
||||||
|
|
||||||
! Compute density matrix
|
! Compute density matrix
|
||||||
|
@ -209,7 +209,9 @@ subroutine evRGW(dotest,maxSCF,thresh,max_diis,doACFDT,exchange_kernel,doXBS,dop
|
|||||||
! Cumulant expansion !
|
! 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
|
! 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
|
! 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
|
! Input variables
|
||||||
|
|
||||||
integer,intent(in) :: nBas
|
integer,intent(in) :: nBas, nOrb
|
||||||
integer,intent(in) :: nO
|
integer,intent(in) :: nO
|
||||||
integer,intent(in) :: nSCF
|
integer,intent(in) :: nSCF
|
||||||
double precision,intent(in) :: ENuc
|
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) :: EcRPA
|
||||||
double precision,intent(in) :: Conv
|
double precision,intent(in) :: Conv
|
||||||
double precision,intent(in) :: thresh
|
double precision,intent(in) :: thresh
|
||||||
double precision,intent(in) :: eHF(nBas)
|
double precision,intent(in) :: eHF(nOrb)
|
||||||
double precision,intent(in) :: eGW(nBas)
|
double precision,intent(in) :: eGW(nOrb)
|
||||||
double precision,intent(in) :: c(nBas)
|
double precision,intent(in) :: c(nBas,nOrb)
|
||||||
double precision,intent(in) :: SigC(nBas,nBas)
|
double precision,intent(in) :: SigC(nOrb,nOrb)
|
||||||
double precision,intent(in) :: Z(nBas)
|
double precision,intent(in) :: Z(nOrb)
|
||||||
double precision,intent(in) :: EqsGW
|
double precision,intent(in) :: EqsGW
|
||||||
double precision,intent(in) :: dipole(ncart)
|
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)','|'
|
'|','#','|','e_HF (eV)','|','Sig_GW (eV)','|','Z','|','e_GW (eV)','|'
|
||||||
write(*,*)'-------------------------------------------------------------------------------'
|
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)') &
|
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,'|'
|
'|',p,'|',eHF(p)*HaToeV,'|',SigC(p,p)*HaToeV,'|',Z(p),'|',eGW(p)*HaToeV,'|'
|
||||||
end do
|
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)') '---------------------------------------'
|
||||||
write(*,'(A50)') ' Restricted qsGW orbital coefficients'
|
write(*,'(A50)') ' Restricted qsGW orbital coefficients'
|
||||||
write(*,'(A50)') '---------------------------------------'
|
write(*,'(A50)') '---------------------------------------'
|
||||||
call matout(nBas,nBas,c)
|
call matout(nBas, nOrb, c)
|
||||||
write(*,*)
|
write(*,*)
|
||||||
end if
|
end if
|
||||||
write(*,'(A50)') '---------------------------------------'
|
write(*,'(A50)') '---------------------------------------'
|
||||||
write(*,'(A50)') ' Restricted qsGW orbital energies (au) '
|
write(*,'(A50)') ' Restricted qsGW orbital energies (au) '
|
||||||
write(*,'(A50)') '---------------------------------------'
|
write(*,'(A50)') '---------------------------------------'
|
||||||
call vecout(nBas,eGW)
|
call vecout(nOrb, eGW)
|
||||||
write(*,*)
|
write(*,*)
|
||||||
|
|
||||||
end if
|
end if
|
||||||
|
@ -1,5 +1,9 @@
|
|||||||
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, &
|
! ---
|
||||||
|
|
||||||
|
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)
|
ERI_MO, dipole_int_AO, dipole_int_MO, PHF, cHF, eHF)
|
||||||
|
|
||||||
! Perform a quasiparticle self-consistent GW calculation
|
! 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) :: rNuc(nNuc,ncart)
|
||||||
double precision,intent(in) :: ENuc
|
double precision,intent(in) :: ENuc
|
||||||
|
|
||||||
integer,intent(in) :: nBas
|
integer,intent(in) :: nBas, nOrb
|
||||||
integer,intent(in) :: nC
|
integer,intent(in) :: nC
|
||||||
integer,intent(in) :: nO
|
integer,intent(in) :: nO
|
||||||
integer,intent(in) :: nV
|
integer,intent(in) :: nV
|
||||||
integer,intent(in) :: nR
|
integer,intent(in) :: nR
|
||||||
integer,intent(in) :: nS
|
integer,intent(in) :: nS
|
||||||
double precision,intent(in) :: ERHF
|
double precision,intent(in) :: ERHF
|
||||||
double precision,intent(in) :: eHF(nBas)
|
double precision,intent(in) :: eHF(nOrb)
|
||||||
double precision,intent(in) :: cHF(nBas,nBas)
|
double precision,intent(in) :: cHF(nBas,nOrb)
|
||||||
double precision,intent(in) :: PHF(nBas,nBas)
|
double precision,intent(in) :: PHF(nBas,nBas)
|
||||||
double precision,intent(in) :: S(nBas,nBas)
|
double precision,intent(in) :: S(nBas,nBas)
|
||||||
double precision,intent(in) :: T(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) :: Hc(nBas,nBas)
|
||||||
double precision,intent(in) :: X(nBas,nBas)
|
double precision,intent(in) :: X(nBas,nBas)
|
||||||
double precision,intent(in) :: ERI_AO(nBas,nBas,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(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
|
! Local variables
|
||||||
|
|
||||||
integer :: nSCF
|
integer :: nSCF
|
||||||
integer :: nBasSq
|
integer :: nBas_Sq
|
||||||
integer :: ispin
|
integer :: ispin
|
||||||
integer :: ixyz
|
integer :: ixyz
|
||||||
integer :: n_diis
|
integer :: n_diis
|
||||||
@ -112,7 +116,7 @@ subroutine qsRGW(dotest,maxSCF,thresh,max_diis,doACFDT,exchange_kernel,doXBS,dop
|
|||||||
|
|
||||||
! Stuff
|
! Stuff
|
||||||
|
|
||||||
nBasSq = nBas*nBas
|
nBas_Sq = nBas*nBas
|
||||||
|
|
||||||
! TDA for W
|
! TDA for W
|
||||||
|
|
||||||
@ -130,10 +134,31 @@ subroutine qsRGW(dotest,maxSCF,thresh,max_diis,doACFDT,exchange_kernel,doXBS,dop
|
|||||||
|
|
||||||
! Memory allocation
|
! Memory allocation
|
||||||
|
|
||||||
allocate(eGW(nBas),c(nBas,nBas),cp(nBas,nBas),P(nBas,nBas),F(nBas,nBas),Fp(nBas,nBas), &
|
allocate(eGW(nOrb))
|
||||||
J(nBas,nBas),K(nBas,nBas),SigC(nBas,nBas),SigCp(nBas,nBas),Z(nBas), &
|
allocate(Z(nOrb))
|
||||||
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(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
|
! Initialization
|
||||||
|
|
||||||
@ -166,36 +191,40 @@ subroutine qsRGW(dotest,maxSCF,thresh,max_diis,doACFDT,exchange_kernel,doXBS,dop
|
|||||||
! AO to MO transformation of two-electron integrals
|
! AO to MO transformation of two-electron integrals
|
||||||
|
|
||||||
do ixyz = 1, ncart
|
do ixyz = 1, ncart
|
||||||
call AOtoMO(nBas,c,dipole_int_AO(:,:,ixyz),dipole_int_MO(:,:,ixyz))
|
call AOtoMO(nBas, nOrb, c, dipole_int_AO(1,1,ixyz), dipole_int_MO(1,1,ixyz))
|
||||||
end do
|
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
|
! Compute linear response
|
||||||
|
|
||||||
call phLR_A(ispin,dRPA,nBas,nC,nO,nV,nR,nS,1d0,eGW,ERI_MO,Aph)
|
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,nBas,nC,nO,nV,nR,nS,1d0,ERI_MO,Bph)
|
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)
|
if(print_W) call print_excitation_energies('phRPA@GW@RHF','singlet',nS,Om)
|
||||||
|
|
||||||
! Compute correlation part of the self-energy
|
! 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
|
! Make correlation self-energy Hermitian and transform it back to AO basis
|
||||||
|
|
||||||
SigC = 0.5d0*(SigC + transpose(SigC))
|
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
|
! Solve the quasi-particle equation
|
||||||
|
|
||||||
F(:,:) = Hc(:,:) + J(:,:) + 0.5d0*K(:,:) + SigCp(:,:)
|
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
|
! Compute commutator and convergence criteria
|
||||||
|
|
||||||
@ -228,17 +257,26 @@ subroutine qsRGW(dotest,maxSCF,thresh,max_diis,doACFDT,exchange_kernel,doXBS,dop
|
|||||||
if(max_diis > 1) then
|
if(max_diis > 1) then
|
||||||
|
|
||||||
n_diis = min(n_diis+1,max_diis)
|
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
|
end if
|
||||||
|
|
||||||
! Diagonalize Hamiltonian in AO basis
|
! Diagonalize Hamiltonian in AO basis
|
||||||
|
|
||||||
|
if(nBas .eq. nOrb) then
|
||||||
Fp = matmul(transpose(X), matmul(F, X))
|
Fp = matmul(transpose(X), matmul(F, X))
|
||||||
cp(:,:) = Fp(:,:)
|
cp(:,:) = Fp(:,:)
|
||||||
call diagonalize_matrix(nBas,cp,eGW)
|
call diagonalize_matrix(nOrb, cp, eGW)
|
||||||
c = matmul(X, cp)
|
c = matmul(X, cp)
|
||||||
call AOtoMO(nBas,c,SigCp,SigC)
|
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
|
! Density matrix
|
||||||
|
|
||||||
@ -247,7 +285,8 @@ subroutine qsRGW(dotest,maxSCF,thresh,max_diis,doACFDT,exchange_kernel,doXBS,dop
|
|||||||
! Print results
|
! Print results
|
||||||
|
|
||||||
call dipole_moment(nBas, P, nNuc, ZNuc, rNuc, dipole_int_AO, dipole)
|
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 print_qsRGW(nBas, nOrb, nO, nSCF, Conv, thresh, eHF, eGW, c, SigC, Z, &
|
||||||
|
ENuc, ET, EV, EJ, EK, EcGM, EcRPA, EqsGW, dipole)
|
||||||
|
|
||||||
end do
|
end do
|
||||||
!------------------------------------------------------------------------
|
!------------------------------------------------------------------------
|
||||||
@ -264,6 +303,7 @@ subroutine qsRGW(dotest,maxSCF,thresh,max_diis,doACFDT,exchange_kernel,doXBS,dop
|
|||||||
write(*,*)'!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!'
|
write(*,*)'!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!'
|
||||||
write(*,*)
|
write(*,*)
|
||||||
|
|
||||||
|
deallocate(c, cp, P, F, Fp, J, K, SigC, SigCp, Z, Om, XpY, XmY, rho, err, err_diis, F_diis)
|
||||||
stop
|
stop
|
||||||
|
|
||||||
end if
|
end if
|
||||||
@ -276,7 +316,8 @@ subroutine qsRGW(dotest,maxSCF,thresh,max_diis,doACFDT,exchange_kernel,doXBS,dop
|
|||||||
|
|
||||||
if(dophBSE) then
|
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
|
if(exchange_kernel) then
|
||||||
|
|
||||||
@ -310,7 +351,8 @@ subroutine qsRGW(dotest,maxSCF,thresh,max_diis,doACFDT,exchange_kernel,doXBS,dop
|
|||||||
|
|
||||||
end if
|
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(*,*)
|
||||||
write(*,*)'-------------------------------------------------------------------------------'
|
write(*,*)'-------------------------------------------------------------------------------'
|
||||||
@ -327,7 +369,8 @@ subroutine qsRGW(dotest,maxSCF,thresh,max_diis,doACFDT,exchange_kernel,doXBS,dop
|
|||||||
|
|
||||||
if(doppBSE) then
|
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)
|
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
|
do ixyz=1,ncart
|
||||||
call AOtoMO(nBas,c(:,:,1),dipole_int_AO(:,:,ixyz),dipole_int_aa(:,:,ixyz))
|
call AOtoMO(nBas,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(:,:,2),dipole_int_AO(:,:,ixyz),dipole_int_bb(:,:,ixyz))
|
||||||
end do
|
end do
|
||||||
|
|
||||||
! 4-index transform for (aa|aa) block
|
! 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
|
end do
|
||||||
|
|
||||||
do is=1,nspin
|
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
|
end do
|
||||||
|
|
||||||
! Solve the quasi-particle equation
|
! 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
|
! Back-transform self-energy
|
||||||
|
|
||||||
do is=1,nspin
|
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
|
end do
|
||||||
|
|
||||||
! Compute density matrix
|
! 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
|
! 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
|
! Construct super density matrix
|
||||||
|
|
||||||
@ -227,7 +227,7 @@ subroutine GHF(dotest,maxSCF,thresh,max_diis,guess_type,mix,level_shift,nNuc,ZNu
|
|||||||
|
|
||||||
! Level-shifting
|
! 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
|
! 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, &
|
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)
|
nBas, nOrb, nO, S, T, V, Hc, ERI, dipole_int, X, ERHF, eHF, c, P)
|
||||||
|
|
||||||
! Perform restricted Hartree-Fock calculation
|
! 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) :: thresh
|
||||||
double precision,intent(in) :: level_shift
|
double precision,intent(in) :: level_shift
|
||||||
|
|
||||||
integer,intent(in) :: nBas
|
integer,intent(in) :: nBas, nOrb
|
||||||
integer,intent(in) :: nO
|
integer,intent(in) :: nO
|
||||||
integer,intent(in) :: nNuc
|
integer,intent(in) :: nNuc
|
||||||
double precision,intent(in) :: ZNuc(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) :: T(nBas,nBas)
|
||||||
double precision,intent(in) :: V(nBas,nBas)
|
double precision,intent(in) :: V(nBas,nBas)
|
||||||
double precision,intent(in) :: Hc(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) :: ERI(nBas,nBas,nBas,nBas)
|
||||||
double precision,intent(in) :: dipole_int(nBas,nBas,ncart)
|
double precision,intent(in) :: dipole_int(nBas,nBas,ncart)
|
||||||
|
|
||||||
! Local variables
|
! Local variables
|
||||||
|
|
||||||
integer :: nSCF
|
integer :: nSCF
|
||||||
integer :: nBasSq
|
integer :: nBas_Sq
|
||||||
integer :: n_diis
|
integer :: n_diis
|
||||||
double precision :: ET
|
double precision :: ET
|
||||||
double precision :: EV
|
double precision :: EV
|
||||||
@ -56,8 +59,8 @@ subroutine RHF(dotest,maxSCF,thresh,max_diis,guess_type,level_shift,nNuc,ZNuc,rN
|
|||||||
! Output variables
|
! Output variables
|
||||||
|
|
||||||
double precision,intent(out) :: ERHF
|
double precision,intent(out) :: ERHF
|
||||||
double precision,intent(out) :: eHF(nBas)
|
double precision,intent(out) :: eHF(nOrb)
|
||||||
double precision,intent(inout):: c(nBas,nBas)
|
double precision,intent(inout):: c(nBas,nOrb)
|
||||||
double precision,intent(out) :: P(nBas,nBas)
|
double precision,intent(out) :: P(nBas,nBas)
|
||||||
|
|
||||||
! Hello world
|
! Hello world
|
||||||
@ -70,17 +73,30 @@ subroutine RHF(dotest,maxSCF,thresh,max_diis,guess_type,level_shift,nNuc,ZNuc,rN
|
|||||||
|
|
||||||
! Useful quantities
|
! Useful quantities
|
||||||
|
|
||||||
nBasSq = nBas*nBas
|
nBas_Sq = nBas*nBas
|
||||||
|
|
||||||
! Memory allocation
|
! Memory allocation
|
||||||
|
|
||||||
allocate(J(nBas,nBas),K(nBas,nBas),err(nBas,nBas),cp(nBas,nBas),F(nBas,nBas), &
|
allocate(J(nBas,nBas))
|
||||||
Fp(nBas,nBas),err_diis(nBasSq,max_diis),F_diis(nBasSq,max_diis))
|
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
|
! Guess coefficients and density matrix
|
||||||
|
|
||||||
call mo_guess(nBas,guess_type,S,Hc,X,c)
|
call mo_guess(nBas, nOrb, guess_type, S, Hc, X, c)
|
||||||
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)
|
||||||
|
|
||||||
! Initialization
|
! Initialization
|
||||||
|
|
||||||
@ -114,6 +130,10 @@ subroutine RHF(dotest,maxSCF,thresh,max_diis,guess_type,level_shift,nNuc,ZNuc,rN
|
|||||||
call exchange_matrix_AO_basis(nBas, P, ERI, K)
|
call exchange_matrix_AO_basis(nBas, P, ERI, K)
|
||||||
|
|
||||||
F(:,:) = Hc(:,:) + J(:,:) + 0.5d0*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
|
! Check convergence
|
||||||
|
|
||||||
@ -145,24 +165,36 @@ subroutine RHF(dotest,maxSCF,thresh,max_diis,guess_type,level_shift,nNuc,ZNuc,rN
|
|||||||
if(max_diis > 1) then
|
if(max_diis > 1) then
|
||||||
|
|
||||||
n_diis = min(n_diis+1, max_diis)
|
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
|
end if
|
||||||
|
|
||||||
! Level shift
|
! 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
|
! Diagonalize Fock matrix
|
||||||
|
|
||||||
|
if(nBas .eq. nOrb) then
|
||||||
Fp = matmul(transpose(X), matmul(F, X))
|
Fp = matmul(transpose(X), matmul(F, X))
|
||||||
cp(:,:) = Fp(:,:)
|
cp(:,:) = Fp(:,:)
|
||||||
call diagonalize_matrix(nBas,cp,eHF)
|
call diagonalize_matrix(nOrb, cp, eHF)
|
||||||
c = matmul(X, cp)
|
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
|
! 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
|
! Dump results
|
||||||
|
|
||||||
@ -185,6 +217,8 @@ subroutine RHF(dotest,maxSCF,thresh,max_diis,guess_type,level_shift,nNuc,ZNuc,rN
|
|||||||
write(*,*)'!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!'
|
write(*,*)'!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!'
|
||||||
write(*,*)
|
write(*,*)
|
||||||
|
|
||||||
|
deallocate(J, K, err, F, cp, Fp, err_diis, F_diis)
|
||||||
|
|
||||||
stop
|
stop
|
||||||
|
|
||||||
end if
|
end if
|
||||||
@ -192,7 +226,7 @@ subroutine RHF(dotest,maxSCF,thresh,max_diis,guess_type,level_shift,nNuc,ZNuc,rN
|
|||||||
! Compute dipole moments
|
! Compute dipole moments
|
||||||
|
|
||||||
call dipole_moment(nBas, P, nNuc, ZNuc, rNuc, dipole_int, dipole)
|
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, nOrb, nO, eHF, c, ENuc, ET, EV, EJ, EK, ERHF, dipole)
|
||||||
|
|
||||||
! Testing zone
|
! Testing zone
|
||||||
|
|
||||||
@ -205,4 +239,6 @@ subroutine RHF(dotest,maxSCF,thresh,max_diis,guess_type,level_shift,nNuc,ZNuc,rN
|
|||||||
|
|
||||||
end if
|
end if
|
||||||
|
|
||||||
|
deallocate(J, K, err, F, cp, Fp, err_diis, F_diis)
|
||||||
|
|
||||||
end subroutine
|
end subroutine
|
||||||
|
@ -1,5 +1,8 @@
|
|||||||
|
|
||||||
|
! ---
|
||||||
|
|
||||||
subroutine RHF_search(maxSCF, thresh, max_diis, guess_type, level_shift, nNuc, ZNuc, rNuc, ENuc, &
|
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, &
|
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)
|
X, ERHF, e, c, P)
|
||||||
|
|
||||||
! Search for RHF solutions
|
! 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) :: thresh
|
||||||
double precision,intent(in) :: level_shift
|
double precision,intent(in) :: level_shift
|
||||||
|
|
||||||
integer,intent(in) :: nBas
|
integer,intent(in) :: nBas, nOrb
|
||||||
integer,intent(in) :: nC
|
integer,intent(in) :: nC
|
||||||
integer,intent(in) :: nO
|
integer,intent(in) :: nO
|
||||||
integer,intent(in) :: nV
|
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) :: T(nBas,nBas)
|
||||||
double precision,intent(in) :: V(nBas,nBas)
|
double precision,intent(in) :: V(nBas,nBas)
|
||||||
double precision,intent(in) :: Hc(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_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_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
|
! Local variables
|
||||||
|
|
||||||
@ -59,8 +62,8 @@ subroutine RHF_search(maxSCF,thresh,max_diis,guess_type,level_shift,nNuc,ZNuc,rN
|
|||||||
! Output variables
|
! Output variables
|
||||||
|
|
||||||
double precision,intent(out) :: ERHF
|
double precision,intent(out) :: ERHF
|
||||||
double precision,intent(out) :: e(nBas)
|
double precision,intent(out) :: e(nOrb)
|
||||||
double precision,intent(inout):: c(nBas,nBas)
|
double precision,intent(inout):: c(nBas,nOrb)
|
||||||
double precision,intent(out) :: P(nBas,nBas)
|
double precision,intent(out) :: P(nBas,nBas)
|
||||||
|
|
||||||
! Memory allocation
|
! 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)
|
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 !
|
! Search algorithm !
|
||||||
@ -93,11 +97,11 @@ subroutine RHF_search(maxSCF,thresh,max_diis,guess_type,level_shift,nNuc,ZNuc,rN
|
|||||||
|
|
||||||
call wall_time(start_HF)
|
call wall_time(start_HF)
|
||||||
call RHF(.false., maxSCF, thresh, max_diis, guess, level_shift, nNuc, ZNuc, rNuc, ENuc, &
|
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)
|
nBas, nOrb, nO, S, T, V, Hc, ERI_AO, dipole_int_AO, X, ERHF, e, c, P)
|
||||||
call wall_time(end_HF)
|
call wall_time(end_HF)
|
||||||
|
|
||||||
t_HF = end_HF - start_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(*,*)
|
write(*,*)
|
||||||
|
|
||||||
!----------------------------------!
|
!----------------------------------!
|
||||||
@ -109,13 +113,13 @@ subroutine RHF_search(maxSCF,thresh,max_diis,guess_type,level_shift,nNuc,ZNuc,rN
|
|||||||
write(*,*) 'AO to MO transformation... Please be patient'
|
write(*,*) 'AO to MO transformation... Please be patient'
|
||||||
write(*,*)
|
write(*,*)
|
||||||
do ixyz = 1, ncart
|
do ixyz = 1, ncart
|
||||||
call AOtoMO(nBas,c,dipole_int_AO(:,:,ixyz),dipole_int_MO(:,:,ixyz))
|
call AOtoMO(nBas, nOrb, c, dipole_int_AO(1,1,ixyz), dipole_int_MO(1,1,ixyz))
|
||||||
end do
|
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)
|
call wall_time(end_AOtoMO)
|
||||||
|
|
||||||
t_AOtoMO = end_AOtoMO - start_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(*,*)
|
write(*,*)
|
||||||
|
|
||||||
!-------------------------------------------------------------!
|
!-------------------------------------------------------------!
|
||||||
@ -124,8 +128,8 @@ subroutine RHF_search(maxSCF,thresh,max_diis,guess_type,level_shift,nNuc,ZNuc,rN
|
|||||||
|
|
||||||
ispin = 1
|
ispin = 1
|
||||||
|
|
||||||
call phLR_A(ispin,.false.,nBas,nC,nO,nV,nR,nS,1d0,e,ERI_MO,Aph)
|
call phLR_A(ispin,.false.,nOrb,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_B(ispin,.false.,nOrb,nC,nO,nV,nR,nS,1d0,ERI_MO,Bph)
|
||||||
|
|
||||||
AB(:,:) = Aph(:,:) + Bph(:,:)
|
AB(:,:) = Aph(:,:) + Bph(:,:)
|
||||||
|
|
||||||
@ -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
|
if(eig < 0 .or. eig > nS) then
|
||||||
write(*,'(1X,A40,1X,A10)') 'Invalid option...','Stop...'
|
write(*,'(1X,A40,1X,A10)') 'Invalid option...','Stop...'
|
||||||
write(*,*)
|
write(*,*)
|
||||||
|
deallocate(Aph, Bph, AB, Om, R, ExpR)
|
||||||
stop
|
stop
|
||||||
end if
|
end if
|
||||||
|
|
||||||
@ -164,14 +169,14 @@ subroutine RHF_search(maxSCF,thresh,max_diis,guess_type,level_shift,nNuc,ZNuc,rN
|
|||||||
R(:,:) = 0d0
|
R(:,:) = 0d0
|
||||||
ia = 0
|
ia = 0
|
||||||
do i=nC+1,nO
|
do i=nC+1,nO
|
||||||
do a=nO+1,nBas-nR
|
do a=nO+1,nOrb-nR
|
||||||
ia = ia + 1
|
ia = ia + 1
|
||||||
R(a,i) = +AB(ia,eig)
|
R(a,i) = +AB(ia,eig)
|
||||||
R(i,a) = -AB(ia,eig)
|
R(i,a) = -AB(ia,eig)
|
||||||
end do
|
end do
|
||||||
end do
|
end do
|
||||||
|
|
||||||
call matrix_exponential(nBas,R,ExpR)
|
call matrix_exponential(nOrb, R, ExpR)
|
||||||
c = matmul(c, ExpR)
|
c = matmul(c, ExpR)
|
||||||
|
|
||||||
else
|
else
|
||||||
@ -191,4 +196,6 @@ subroutine RHF_search(maxSCF,thresh,max_diis,guess_type,level_shift,nNuc,ZNuc,rN
|
|||||||
!---------------!
|
!---------------!
|
||||||
end do
|
end do
|
||||||
|
|
||||||
|
deallocate(Aph, Bph, AB, Om, R, ExpR)
|
||||||
|
|
||||||
end subroutine
|
end subroutine
|
||||||
|
@ -149,4 +149,6 @@ subroutine RHF_stability(nBas,nC,nO,nV,nR,nS,eHF,ERI)
|
|||||||
write(*,*)'-------------------------------------------------------------'
|
write(*,*)'-------------------------------------------------------------'
|
||||||
write(*,*)
|
write(*,*)
|
||||||
|
|
||||||
|
deallocate(A, B, AB, Om)
|
||||||
|
|
||||||
end subroutine
|
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))
|
EK = 0.5d0*trace_matrix(nBas,matmul(P,K))
|
||||||
ERHF = ET + EV + EJ + EK
|
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
|
end subroutine
|
||||||
|
@ -1,5 +1,8 @@
|
|||||||
|
|
||||||
|
! ---
|
||||||
|
|
||||||
subroutine ROHF(dotest, maxSCF, thresh, max_diis, guess_type, mix, level_shift, nNuc, ZNuc, rNuc, ENuc, &
|
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)
|
nBas, nOrb, nO, S, T, V, Hc, ERI, dipole_int, X, EROHF, eHF, c, Ptot)
|
||||||
|
|
||||||
! Perform restricted open-shell Hartree-Fock calculation
|
! 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) :: mix
|
||||||
double precision,intent(in) :: level_shift
|
double precision,intent(in) :: level_shift
|
||||||
double precision,intent(in) :: thresh
|
double precision,intent(in) :: thresh
|
||||||
integer,intent(in) :: nBas
|
integer,intent(in) :: nBas, nOrb
|
||||||
|
|
||||||
integer,intent(in) :: nNuc
|
integer,intent(in) :: nNuc
|
||||||
double precision,intent(in) :: ZNuc(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) :: T(nBas,nBas)
|
||||||
double precision,intent(in) :: V(nBas,nBas)
|
double precision,intent(in) :: V(nBas,nBas)
|
||||||
double precision,intent(in) :: Hc(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) :: ERI(nBas,nBas,nBas,nBas)
|
||||||
double precision,intent(in) :: dipole_int(nBas,nBas,ncart)
|
double precision,intent(in) :: dipole_int(nBas,nBas,ncart)
|
||||||
|
|
||||||
! Local variables
|
! Local variables
|
||||||
|
|
||||||
integer :: nSCF
|
integer :: nSCF
|
||||||
integer :: nBasSq
|
integer :: nBas_Sq
|
||||||
integer :: n_diis
|
integer :: n_diis
|
||||||
double precision :: Conv
|
double precision :: Conv
|
||||||
double precision :: rcond
|
double precision :: rcond
|
||||||
@ -62,8 +65,8 @@ subroutine ROHF(dotest,maxSCF,thresh,max_diis,guess_type,mix,level_shift,nNuc,ZN
|
|||||||
! Output variables
|
! Output variables
|
||||||
|
|
||||||
double precision,intent(out) :: EROHF
|
double precision,intent(out) :: EROHF
|
||||||
double precision,intent(out) :: eHF(nBas)
|
double precision,intent(out) :: eHF(nOrb)
|
||||||
double precision,intent(inout):: c(nBas,nBas)
|
double precision,intent(inout):: c(nBas,nOrb)
|
||||||
double precision,intent(out) :: Ptot(nBas,nBas)
|
double precision,intent(out) :: Ptot(nBas,nBas)
|
||||||
|
|
||||||
! Hello world
|
! Hello world
|
||||||
@ -76,19 +79,30 @@ subroutine ROHF(dotest,maxSCF,thresh,max_diis,guess_type,mix,level_shift,nNuc,ZN
|
|||||||
|
|
||||||
! Useful stuff
|
! Useful stuff
|
||||||
|
|
||||||
nBasSq = nBas*nBas
|
nBas_Sq = nBas*nBas
|
||||||
|
|
||||||
! Memory allocation
|
! Memory allocation
|
||||||
|
|
||||||
allocate(J(nBas,nBas,nspin),F(nBas,nBas,nspin),Fp(nBas,nBas),Ftot(nBas,nBas), &
|
allocate(J(nBas,nBas,nspin))
|
||||||
P(nBas,nBas,nspin),K(nBas,nBas,nspin),err(nBas,nBas),cp(nBas,nBas), &
|
allocate(K(nBas,nBas,nspin))
|
||||||
err_diis(nBasSq,max_diis),F_diis(nBasSq,max_diis))
|
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
|
! Guess coefficients and demsity matrices
|
||||||
|
|
||||||
call mo_guess(nBas,guess_type,S,Hc,X,c)
|
call mo_guess(nBas, nOrb, guess_type, S, Hc, X, c)
|
||||||
|
|
||||||
do ispin = 1, nspin
|
do ispin = 1, nspin
|
||||||
P(:,:,ispin) = matmul(c(:,1:nO(ispin)),transpose(c(:,1:nO(ispin))))
|
!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
|
end do
|
||||||
Ptot(:,:) = P(:,:,1) + P(:,:,2)
|
Ptot(:,:) = P(:,:,1) + P(:,:,2)
|
||||||
|
|
||||||
@ -136,7 +150,7 @@ subroutine ROHF(dotest,maxSCF,thresh,max_diis,guess_type,mix,level_shift,nNuc,ZN
|
|||||||
F(:,:,ispin) = Hc(:,:) + J(:,:,ispin) + J(:,:,mod(ispin,2)+1) + K(:,:,ispin)
|
F(:,:,ispin) = Hc(:,:) + J(:,:,ispin) + J(:,:,mod(ispin,2)+1) + K(:,:,ispin)
|
||||||
end do
|
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
|
! Check convergence
|
||||||
|
|
||||||
@ -176,7 +190,7 @@ subroutine ROHF(dotest,maxSCF,thresh,max_diis,guess_type,mix,level_shift,nNuc,ZN
|
|||||||
if(max_diis > 1) then
|
if(max_diis > 1) then
|
||||||
|
|
||||||
n_diis = min(n_diis+1,max_diis)
|
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
|
end if
|
||||||
|
|
||||||
@ -185,7 +199,7 @@ subroutine ROHF(dotest,maxSCF,thresh,max_diis,guess_type,mix,level_shift,nNuc,ZN
|
|||||||
if(level_shift > 0d0 .and. Conv > thresh) then
|
if(level_shift > 0d0 .and. Conv > thresh) then
|
||||||
|
|
||||||
do ispin=1,nspin
|
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 do
|
||||||
|
|
||||||
end if
|
end if
|
||||||
@ -197,7 +211,7 @@ subroutine ROHF(dotest,maxSCF,thresh,max_diis,guess_type,mix,level_shift,nNuc,ZN
|
|||||||
! Diagonalize Fock matrix to get eigenvectors and eigenvalues
|
! Diagonalize Fock matrix to get eigenvectors and eigenvalues
|
||||||
|
|
||||||
cp(:,:) = Fp(:,:)
|
cp(:,:) = Fp(:,:)
|
||||||
call diagonalize_matrix(nBas,cp,eHF)
|
call diagonalize_matrix(nOrb, cp, eHF)
|
||||||
|
|
||||||
! Back-transform eigenvectors in non-orthogonal basis
|
! Back-transform eigenvectors in non-orthogonal basis
|
||||||
|
|
||||||
@ -206,7 +220,8 @@ subroutine ROHF(dotest,maxSCF,thresh,max_diis,guess_type,mix,level_shift,nNuc,ZN
|
|||||||
! Compute density matrix
|
! Compute density matrix
|
||||||
|
|
||||||
do ispin = 1, nspin
|
do ispin = 1, nspin
|
||||||
P(:,:,ispin) = matmul(c(:,1:nO(ispin)),transpose(c(:,1:nO(ispin))))
|
!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
|
end do
|
||||||
Ptot(:,:) = P(:,:,1) + P(:,:,2)
|
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(*,*)'!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!'
|
||||||
write(*,*)
|
write(*,*)
|
||||||
|
|
||||||
|
deallocate(J, K, F, Ftot, P, err, Fp, cp, err_diis, F_diis)
|
||||||
|
|
||||||
stop
|
stop
|
||||||
|
|
||||||
end if
|
end if
|
||||||
@ -238,7 +255,7 @@ subroutine ROHF(dotest,maxSCF,thresh,max_diis,guess_type,mix,level_shift,nNuc,ZN
|
|||||||
! Compute final UHF energy
|
! Compute final UHF energy
|
||||||
|
|
||||||
call dipole_moment(nBas,Ptot,nNuc,ZNuc,rNuc,dipole_int,dipole)
|
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
|
! Print test values
|
||||||
|
|
||||||
@ -248,4 +265,6 @@ subroutine ROHF(dotest,maxSCF,thresh,max_diis,guess_type,mix,level_shift,nNuc,ZN
|
|||||||
|
|
||||||
end if
|
end if
|
||||||
|
|
||||||
|
deallocate(J, K, F, Ftot, P, err, Fp, cp, err_diis, F_diis)
|
||||||
|
|
||||||
end subroutine
|
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
|
! Construct the ROHF Fock matrix in the AO basis
|
||||||
! For open shells, the ROHF Fock matrix in the MO basis reads
|
! 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
|
! Input variables
|
||||||
|
|
||||||
integer,intent(in) :: nBas
|
integer,intent(in) :: nBas, nOrb
|
||||||
integer,intent(in) :: nOa
|
integer,intent(in) :: nOa
|
||||||
integer,intent(in) :: nOb
|
integer,intent(in) :: nOb
|
||||||
|
|
||||||
double precision,intent(in) :: S(nBas,nBas)
|
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):: FaAO(nBas,nBas)
|
||||||
double precision,intent(inout):: FbAO(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
|
! 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
|
! Roothan canonicalization parameters
|
||||||
|
|
||||||
@ -67,8 +70,8 @@ subroutine ROHF_fock_matrix(nBas,nOa,nOb,S,c,FaAO,FbAO,FAO)
|
|||||||
|
|
||||||
! Block-by-block Fock matrix
|
! Block-by-block Fock matrix
|
||||||
|
|
||||||
call AOtoMO(nBas,c,FaAO,Fa)
|
call AOtoMO(nBas, nOrb, c, FaAO, Fa)
|
||||||
call AOtoMO(nBas,c,FbAO,Fb)
|
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, 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 )
|
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, 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)
|
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, nOrb, S, c, F, FAO)
|
||||||
call MOtoAO(nBas,S,c,Fa,FaAO)
|
call MOtoAO(nBas, nOrb, S, c, Fa, FaAO)
|
||||||
call MOtoAO(nBas,S,c,Fb,FbAO)
|
call MOtoAO(nBas, nOrb, S, c, Fb, FbAO)
|
||||||
|
|
||||||
|
deallocate(F, Fa, Fb)
|
||||||
|
|
||||||
end subroutine
|
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
|
! Guess coefficients and demsity matrices
|
||||||
|
|
||||||
do ispin=1,nspin
|
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)))
|
P(:,:,ispin) = matmul(c(:,1:nO(ispin),ispin),transpose(c(:,1:nO(ispin),ispin)))
|
||||||
end do
|
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
|
if(level_shift > 0d0 .and. Conv > thresh) then
|
||||||
|
|
||||||
do ispin=1,nspin
|
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 do
|
||||||
|
|
||||||
end if
|
end if
|
||||||
|
@ -124,8 +124,8 @@ subroutine UHF_search(maxSCF,thresh,max_diis,guess_type,mix,level_shift,nNuc,ZNu
|
|||||||
! Transform dipole-related integrals
|
! Transform dipole-related integrals
|
||||||
|
|
||||||
do ixyz=1,ncart
|
do ixyz=1,ncart
|
||||||
call AOtoMO(nBas,c(:,:,1),dipole_int_AO(:,:,ixyz),dipole_int_aa(:,:,ixyz))
|
call AOtoMO(nBas,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(:,:,2),dipole_int_AO(:,:,ixyz),dipole_int_bb(:,:,ixyz))
|
||||||
end do
|
end do
|
||||||
|
|
||||||
! 4-index transform for (aa|aa) block
|
! 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
|
! 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)))
|
P(:,:) = 2d0*matmul(c(:,1:nO),transpose(c(:,1:nO)))
|
||||||
|
|
||||||
! Initialization
|
! Initialization
|
||||||
@ -166,7 +166,7 @@ subroutine cRHF(dotest,maxSCF,thresh,max_diis,guess_type,level_shift,nNuc,ZNuc,r
|
|||||||
|
|
||||||
! Level shift
|
! 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
|
! Diagonalize Fock matrix
|
||||||
|
|
||||||
@ -207,7 +207,7 @@ subroutine cRHF(dotest,maxSCF,thresh,max_diis,guess_type,level_shift,nNuc,ZNuc,r
|
|||||||
! Compute dipole moments
|
! Compute dipole moments
|
||||||
|
|
||||||
call dipole_moment(nBas,P,nNuc,ZNuc,rNuc,dipole_int,dipole)
|
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
|
! 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
|
! Core guess of the molecular orbitals for HF calculation
|
||||||
|
|
||||||
@ -6,9 +6,9 @@ subroutine core_guess(nBas,Hc,X,c)
|
|||||||
|
|
||||||
! Input variables
|
! Input variables
|
||||||
|
|
||||||
integer,intent(in) :: nBas
|
integer,intent(in) :: nBas, nOrb
|
||||||
double precision,intent(in) :: Hc(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
|
! Local variables
|
||||||
|
|
||||||
@ -18,16 +18,19 @@ subroutine core_guess(nBas,Hc,X,c)
|
|||||||
|
|
||||||
! Output variables
|
! Output variables
|
||||||
|
|
||||||
double precision,intent(out) :: c(nBas,nBas)
|
double precision,intent(out) :: c(nBas,nOrb)
|
||||||
|
|
||||||
! Memory allocation
|
! Memory allocation
|
||||||
|
|
||||||
allocate(cp(nBas,nBas),e(nBas))
|
allocate(cp(nOrb,nOrb), e(nOrb))
|
||||||
|
|
||||||
! Core guess
|
! Core guess
|
||||||
|
|
||||||
cp(:,:) = matmul(transpose(X(:,:)), matmul(Hc(:,:), X(:,:)))
|
cp(:,:) = matmul(transpose(X(:,:)), matmul(Hc(:,:), X(:,:)))
|
||||||
call diagonalize_matrix(nBas,cp,e)
|
|
||||||
|
call diagonalize_matrix(nOrb, cp, e)
|
||||||
c(:,:) = matmul(X(:,:), cp(:,:))
|
c(:,:) = matmul(X(:,:), cp(:,:))
|
||||||
|
|
||||||
|
deallocate(cp, e)
|
||||||
|
|
||||||
end subroutine
|
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
|
! Hickel guess
|
||||||
|
|
||||||
@ -6,10 +6,10 @@ subroutine huckel_guess(nBas,S,Hc,X,c)
|
|||||||
|
|
||||||
! Input variables
|
! Input variables
|
||||||
|
|
||||||
integer,intent(in) :: nBas
|
integer,intent(in) :: nBas, nOrb
|
||||||
double precision,intent(in) :: S(nBas,nBas)
|
double precision,intent(in) :: S(nBas,nBas)
|
||||||
double precision,intent(in) :: Hc(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
|
! Local variables
|
||||||
|
|
||||||
@ -20,7 +20,7 @@ subroutine huckel_guess(nBas,S,Hc,X,c)
|
|||||||
|
|
||||||
! Output variables
|
! Output variables
|
||||||
|
|
||||||
double precision,intent(out) :: c(nBas,nBas)
|
double precision,intent(out) :: c(nBas,nOrb)
|
||||||
|
|
||||||
! Memory allocation
|
! Memory allocation
|
||||||
|
|
||||||
@ -42,6 +42,8 @@ subroutine huckel_guess(nBas,S,Hc,X,c)
|
|||||||
end do
|
end do
|
||||||
end do
|
end do
|
||||||
|
|
||||||
call core_guess(nBas,F,X,c)
|
call core_guess(nBas, nOrb, F, X, c)
|
||||||
|
|
||||||
|
deallocate(F)
|
||||||
|
|
||||||
end subroutine
|
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
|
! Guess of the molecular orbitals for HF calculation
|
||||||
|
|
||||||
@ -6,15 +9,15 @@ subroutine mo_guess(nBas,guess_type,S,Hc,X,c)
|
|||||||
|
|
||||||
! Input variables
|
! Input variables
|
||||||
|
|
||||||
integer,intent(in) :: nBas
|
integer,intent(in) :: nBas, nOrb
|
||||||
integer,intent(in) :: guess_type
|
integer,intent(in) :: guess_type
|
||||||
double precision,intent(in) :: S(nBas,nBas)
|
double precision,intent(in) :: S(nBas,nBas)
|
||||||
double precision,intent(in) :: Hc(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
|
! Output variables
|
||||||
|
|
||||||
double precision,intent(inout) :: c(nBas,nBas)
|
double precision,intent(inout) :: c(nBas,nOrb)
|
||||||
|
|
||||||
if(guess_type == 0) then
|
if(guess_type == 0) then
|
||||||
|
|
||||||
@ -24,12 +27,12 @@ subroutine mo_guess(nBas,guess_type,S,Hc,X,c)
|
|||||||
elseif(guess_type == 1) then
|
elseif(guess_type == 1) then
|
||||||
|
|
||||||
write(*,*) 'Core guess...'
|
write(*,*) 'Core guess...'
|
||||||
call core_guess(nBas,Hc,X,c)
|
call core_guess(nBas, nOrb, Hc, X, c)
|
||||||
|
|
||||||
elseif(guess_type == 2) then
|
elseif(guess_type == 2) then
|
||||||
|
|
||||||
write(*,*) 'Huckel guess...'
|
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
|
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
|
! 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
|
! Input variables
|
||||||
|
|
||||||
integer,intent(in) :: nBas
|
integer,intent(in) :: nBas, nOrb
|
||||||
integer,intent(in) :: nO
|
integer,intent(in) :: nO
|
||||||
double precision,intent(in) :: eHF(nBas)
|
double precision,intent(in) :: eHF(nOrb)
|
||||||
double precision,intent(in) :: cHF(nBas,nBas)
|
double precision,intent(in) :: cHF(nBas,nOrb)
|
||||||
double precision,intent(in) :: ENuc
|
double precision,intent(in) :: ENuc
|
||||||
double precision,intent(in) :: ET
|
double precision,intent(in) :: ET
|
||||||
double precision,intent(in) :: EV
|
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)') '---------------------------------------'
|
||||||
write(*,'(A50)') ' RHF orbital coefficients '
|
write(*,'(A50)') ' RHF orbital coefficients '
|
||||||
write(*,'(A50)') '---------------------------------------'
|
write(*,'(A50)') '---------------------------------------'
|
||||||
call matout(nBas,nBas,cHF)
|
call matout(nBas, nOrb, cHF)
|
||||||
write(*,*)
|
write(*,*)
|
||||||
end if
|
end if
|
||||||
write(*,'(A50)') '---------------------------------------'
|
write(*,'(A50)') '---------------------------------------'
|
||||||
write(*,'(A50)') ' RHF orbital energies (au) '
|
write(*,'(A50)') ' RHF orbital energies (au) '
|
||||||
write(*,'(A50)') '---------------------------------------'
|
write(*,'(A50)') '---------------------------------------'
|
||||||
call vecout(nBas,eHF)
|
call vecout(nOrb, eHF)
|
||||||
write(*,*)
|
write(*,*)
|
||||||
|
|
||||||
end subroutine
|
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
|
! Print one- and two-electron energies and other stuff for RoHF calculation
|
||||||
|
|
||||||
implicit none
|
implicit none
|
||||||
include 'parameters.h'
|
include 'parameters.h'
|
||||||
|
|
||||||
integer,intent(in) :: nBas
|
integer,intent(in) :: nBas, nOrb
|
||||||
integer,intent(in) :: nO(nspin)
|
integer,intent(in) :: nO(nspin)
|
||||||
double precision,intent(in) :: eHF(nBas)
|
double precision,intent(in) :: eHF(nOrb)
|
||||||
double precision,intent(in) :: c(nBas,nBas)
|
double precision,intent(in) :: c(nBas,nOrb)
|
||||||
double precision,intent(in) :: ENuc
|
double precision,intent(in) :: ENuc
|
||||||
double precision,intent(in) :: ET(nspin)
|
double precision,intent(in) :: ET(nspin)
|
||||||
double precision,intent(in) :: EV(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
|
do ispin=1,nspin
|
||||||
if(nO(ispin) > 0) then
|
if(nO(ispin) > 0) then
|
||||||
HOMO(ispin) = eHF(nO(ispin))
|
HOMO(ispin) = eHF(nO(ispin))
|
||||||
if(nO(ispin) < nBas) then
|
if(nO(ispin) < nOrb) then
|
||||||
LUMO(ispin) = eHF(nO(ispin)+1)
|
LUMO(ispin) = eHF(nO(ispin)+1)
|
||||||
else
|
else
|
||||||
LUMO(ispin) = 0d0
|
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)') '-----------------------------------------'
|
||||||
write(*,'(A50)') 'ROHF orbital coefficients '
|
write(*,'(A50)') 'ROHF orbital coefficients '
|
||||||
write(*,'(A50)') '-----------------------------------------'
|
write(*,'(A50)') '-----------------------------------------'
|
||||||
call matout(nBas,nBas,c)
|
call matout(nBas, nOrb, c)
|
||||||
write(*,*)
|
write(*,*)
|
||||||
end if
|
end if
|
||||||
write(*,'(A50)') '---------------------------------------'
|
write(*,'(A50)') '---------------------------------------'
|
||||||
write(*,'(A50)') ' ROHF orbital energies (au) '
|
write(*,'(A50)') ' ROHF orbital energies (au) '
|
||||||
write(*,'(A50)') '---------------------------------------'
|
write(*,'(A50)') '---------------------------------------'
|
||||||
call vecout(nBas,eHF)
|
call vecout(nOrb, eHF)
|
||||||
write(*,*)
|
write(*,*)
|
||||||
|
|
||||||
end subroutine
|
end subroutine
|
||||||
|
123
src/LR/ppLR.f90
123
src/LR/ppLR.f90
@ -1,51 +1,56 @@
|
|||||||
|
|
||||||
|
! ---
|
||||||
|
|
||||||
subroutine ppLR(TDA, nOO, nVV, Bpp, Cpp, Dpp, Om1, X1, Y1, Om2, X2, Y2, EcRPA)
|
subroutine ppLR(TDA, nOO, nVV, Bpp, Cpp, Dpp, Om1, X1, Y1, Om2, X2, Y2, EcRPA)
|
||||||
|
|
||||||
|
!
|
||||||
! Solve the pp-RPA linear eigenvalue problem
|
! 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
|
implicit none
|
||||||
include 'parameters.h'
|
include 'parameters.h'
|
||||||
|
|
||||||
! Input variables
|
|
||||||
|
|
||||||
logical, intent(in) :: TDA
|
logical, intent(in) :: TDA
|
||||||
integer,intent(in) :: nOO
|
integer, intent(in) :: nOO, nVV
|
||||||
integer,intent(in) :: nVV
|
double precision, intent(in) :: Bpp(nVV,nOO), Cpp(nVV,nVV), Dpp(nOO,nOO)
|
||||||
double precision,intent(in) :: Bpp(nVV,nOO)
|
double precision, intent(out) :: Om1(nVV), X1(nVV,nVV), Y1(nOO,nVV)
|
||||||
double precision,intent(in) :: Cpp(nVV,nVV)
|
double precision, intent(out) :: Om2(nOO), X2(nVV,nOO), Y2(nOO,nOO)
|
||||||
double precision,intent(in) :: Dpp(nOO,nOO)
|
|
||||||
|
|
||||||
! Local variables
|
|
||||||
|
|
||||||
double precision :: trace_matrix
|
|
||||||
double precision :: EcRPA1
|
|
||||||
double precision :: EcRPA2
|
|
||||||
double precision,allocatable :: M(:,:)
|
|
||||||
double precision,allocatable :: Z(:,:)
|
|
||||||
double precision,allocatable :: Om(:)
|
|
||||||
|
|
||||||
! 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
|
double precision, intent(out) :: EcRPA
|
||||||
|
|
||||||
! Memory allocation
|
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(:)
|
||||||
|
|
||||||
allocate(M(nOO+nVV,nOO+nVV),Z(nOO+nVV,nOO+nVV),Om(nOO+nVV))
|
double precision, external :: trace_matrix
|
||||||
|
|
||||||
!-------------------------------------------------!
|
|
||||||
! Solve the p-p eigenproblem !
|
|
||||||
!-------------------------------------------------!
|
N = nOO + nVV
|
||||||
! !
|
|
||||||
! | C B | | X1 X2 | | w1 0 | | X1 X2 | !
|
allocate(M(N,N), Z(N,N), Om(N))
|
||||||
! | | | | = | | | | !
|
|
||||||
! | -Bt -D | | Y1 Y2 | | 0 w2 | | Y1 Y2 | !
|
|
||||||
! !
|
|
||||||
!-------------------------------------------------!
|
|
||||||
|
|
||||||
if(TDA) then
|
if(TDA) then
|
||||||
|
|
||||||
@ -60,34 +65,64 @@ subroutine ppLR(TDA,nOO,nVV,Bpp,Cpp,Dpp,Om1,X1,Y1,Om2,X2,Y2,EcRPA)
|
|||||||
else
|
else
|
||||||
|
|
||||||
! Diagonal blocks
|
! Diagonal blocks
|
||||||
|
|
||||||
M( 1:nVV , 1:nVV) = + Cpp(1:nVV,1:nVV)
|
M( 1:nVV , 1:nVV) = + Cpp(1:nVV,1:nVV)
|
||||||
M(nVV+1:nVV+nOO,nVV+1:nVV+nOO) = - Dpp(1:nOO,1:nOO)
|
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( 1:nVV ,nVV+1:nOO+nVV) = - Bpp(1:nVV,1:nOO)
|
||||||
M(nVV+1:nOO+nVV, 1:nVV) = + transpose(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)
|
if(nOO+nVV > 0) call diagonalize_general_matrix(nOO+nVV, M, Om, Z)
|
||||||
|
|
||||||
! Split the various quantities in p-p and h-h parts
|
! Split the various quantities in p-p and h-h parts
|
||||||
|
|
||||||
call sort_ppRPA(nOO, nVV, Om, Z, Om1, X1, Y1, Om2, X2, Y2)
|
call sort_ppRPA(nOO, nVV, Om, Z, Om1, X1, Y1, Om2, X2, Y2)
|
||||||
|
|
||||||
|
else
|
||||||
|
|
||||||
|
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
|
||||||
|
|
||||||
|
endif
|
||||||
|
|
||||||
end if
|
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))
|
EcRPA = 0.5d0 * (sum(Om1) - sum(Om2) - trace_matrix(nVV, Cpp) - trace_matrix(nOO, Dpp))
|
||||||
EcRPA1 = +sum(Om1) - trace_matrix(nVV, Cpp)
|
EcRPA1 = +sum(Om1) - trace_matrix(nVV, Cpp)
|
||||||
EcRPA2 = -sum(Om2) - trace_matrix(nOO, Dpp)
|
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 !!!'
|
print*,'!!! Issue in pp-RPA linear reponse calculation RPA1 != RPA2 !!!'
|
||||||
|
endif
|
||||||
|
|
||||||
|
deallocate(M, Z, Om)
|
||||||
|
|
||||||
end subroutine
|
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
|
double precision,external :: Kronecker_delta
|
||||||
|
|
||||||
integer :: a,b,c,d,ab,cd
|
integer :: a,b,c,d,ab,cd
|
||||||
|
integer :: a0, aa
|
||||||
|
double precision :: e_ab, tmp_ab, delta_ac, tmp_cd
|
||||||
|
|
||||||
! Output variables
|
! Output variables
|
||||||
|
|
||||||
@ -37,22 +39,70 @@ subroutine ppLR_C(ispin,nBas,nC,nO,nV,nR,nVV,lambda,e,ERI,Cpp)
|
|||||||
|
|
||||||
if(ispin == 1) then
|
if(ispin == 1) then
|
||||||
|
|
||||||
ab = 0
|
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
|
do a = nO+1, nBas-nR
|
||||||
|
aa = a0 * (a - nO - 1) - (a - nO - 1) * (a - nO) / 2 - nO
|
||||||
do b = a, nBas-nR
|
do b = a, nBas-nR
|
||||||
ab = ab + 1
|
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
|
cd = 0
|
||||||
do c = nO+1, 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
|
do d = c, nBas-nR
|
||||||
cd = cd + 1
|
cd = cd + 1
|
||||||
|
|
||||||
Cpp(ab,cd) = + (e(a) + e(b) - eF)*Kronecker_delta(a,c)*Kronecker_delta(b,d) &
|
tmp_cd = tmp_ab
|
||||||
+ lambda*(ERI(a,b,c,d) + ERI(a,b,d,c))/sqrt((1d0 + Kronecker_delta(a,b))*(1d0 + Kronecker_delta(c,d)))
|
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) = Cpp(ab,cd) + tmp_cd * (ERI(a,b,c,d) + ERI(a,b,d,c))
|
||||||
enddo
|
enddo
|
||||||
enddo
|
enddo
|
||||||
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
|
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
|
! 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) :: doMP3
|
||||||
|
|
||||||
logical,intent(in) :: regularize
|
logical,intent(in) :: regularize
|
||||||
integer,intent(in) :: nBas
|
integer,intent(in) :: nOrb
|
||||||
integer,intent(in) :: nC
|
integer,intent(in) :: nC
|
||||||
integer,intent(in) :: nO
|
integer,intent(in) :: nO
|
||||||
integer,intent(in) :: nV
|
integer,intent(in) :: nV
|
||||||
integer,intent(in) :: nR
|
integer,intent(in) :: nR
|
||||||
double precision,intent(in) :: ENuc
|
double precision,intent(in) :: ENuc
|
||||||
double precision,intent(in) :: ERHF
|
double precision,intent(in) :: ERHF
|
||||||
double precision,intent(in) :: eHF(nBas)
|
double precision,intent(in) :: eHF(nOrb)
|
||||||
double precision,intent(in) :: ERI(nBas,nBas,nBas,nBas)
|
double precision,intent(in) :: ERI(nOrb,nOrb,nOrb,nOrb)
|
||||||
|
|
||||||
! Local variables
|
! Local variables
|
||||||
|
|
||||||
@ -37,11 +37,11 @@ subroutine RMP(dotest,doMP2,doMP3,regularize,nBas,nC,nO,nV,nR,ERI,ENuc,ERHF,eHF)
|
|||||||
if(doMP2) then
|
if(doMP2) then
|
||||||
|
|
||||||
call wall_time(start_MP)
|
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)
|
call wall_time(end_MP)
|
||||||
|
|
||||||
t_MP = end_MP - start_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(*,*)
|
write(*,*)
|
||||||
|
|
||||||
end if
|
end if
|
||||||
@ -53,11 +53,11 @@ subroutine RMP(dotest,doMP2,doMP3,regularize,nBas,nC,nO,nV,nR,ERI,ENuc,ERHF,eHF)
|
|||||||
if(doMP3) then
|
if(doMP3) then
|
||||||
|
|
||||||
call wall_time(start_MP)
|
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)
|
call wall_time(end_MP)
|
||||||
|
|
||||||
t_MP = end_MP - start_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(*,*)
|
write(*,*)
|
||||||
|
|
||||||
end if
|
end if
|
||||||
|
@ -15,7 +15,7 @@ program QuAcK
|
|||||||
logical :: doG0W0,doevGW,doqsGW,doufG0W0,doufGW,doSRGqsGW
|
logical :: doG0W0,doevGW,doqsGW,doufG0W0,doufGW,doSRGqsGW
|
||||||
logical :: doG0T0pp,doevGTpp,doqsGTpp,doufG0T0pp,doG0T0eh,doevGTeh,doqsGTeh
|
logical :: doG0T0pp,doevGTpp,doqsGTpp,doufG0T0pp,doG0T0eh,doevGTeh,doqsGTeh
|
||||||
|
|
||||||
integer :: nNuc,nBas
|
integer :: nNuc, nBas, nOrb
|
||||||
integer :: nC(nspin)
|
integer :: nC(nspin)
|
||||||
integer :: nO(nspin)
|
integer :: nO(nspin)
|
||||||
integer :: nV(nspin)
|
integer :: nV(nspin)
|
||||||
@ -31,6 +31,7 @@ program QuAcK
|
|||||||
double precision,allocatable :: X(:,:)
|
double precision,allocatable :: X(:,:)
|
||||||
double precision,allocatable :: dipole_int_AO(:,:,:)
|
double precision,allocatable :: dipole_int_AO(:,:,:)
|
||||||
double precision,allocatable :: ERI_AO(:,:,:,:)
|
double precision,allocatable :: ERI_AO(:,:,:,:)
|
||||||
|
double precision,allocatable :: Uvec(:,:), Uval(:)
|
||||||
|
|
||||||
double precision :: start_QuAcK,end_QuAcK,t_QuAcK
|
double precision :: start_QuAcK,end_QuAcK,t_QuAcK
|
||||||
double precision :: start_int ,end_int ,t_int
|
double precision :: start_int ,end_int ,t_int
|
||||||
@ -68,6 +69,10 @@ program QuAcK
|
|||||||
|
|
||||||
logical :: dotest,doRtest,doUtest,doGtest
|
logical :: dotest,doRtest,doUtest,doGtest
|
||||||
|
|
||||||
|
integer :: i, j, j0
|
||||||
|
double precision :: acc_d, acc_nd
|
||||||
|
double precision, allocatable :: tmp1(:,:), tmp2(:,:)
|
||||||
|
|
||||||
!-------------!
|
!-------------!
|
||||||
! Hello World !
|
! Hello World !
|
||||||
!-------------!
|
!-------------!
|
||||||
@ -120,15 +125,16 @@ program QuAcK
|
|||||||
doACFDT,exchange_kernel,doXBS, &
|
doACFDT,exchange_kernel,doXBS, &
|
||||||
dophBSE,dophBSE2,doppBSE,dBSE,dTDA)
|
dophBSE,dophBSE2,doppBSE,dBSE,dTDA)
|
||||||
|
|
||||||
!------------------------------------------------!
|
!-----------------------------------------------!
|
||||||
! Read input information !
|
! Read input information !
|
||||||
!------------------------------------------------!
|
!-----------------------------------------------!
|
||||||
! nC = number of core orbitals !
|
! nC = number of core orbitals !
|
||||||
! nO = number of occupied orbitals !
|
! nO = number of occupied orbitals !
|
||||||
! nV = number of virtual orbitals (see below) !
|
! nV = number of virtual orbitals (see below) !
|
||||||
! nR = number of Rydberg orbitals !
|
! nR = number of Rydberg orbitals !
|
||||||
! nBas = number of basis functions (see below) !
|
! nBas = number of basis functions !
|
||||||
!------------------------------------------------!
|
! nOrb = number of orbitals !
|
||||||
|
!-----------------------------------------------!
|
||||||
|
|
||||||
call read_molecule(nNuc,nO,nC,nR)
|
call read_molecule(nNuc,nO,nC,nR)
|
||||||
allocate(ZNuc(nNuc),rNuc(nNuc,ncart))
|
allocate(ZNuc(nNuc),rNuc(nNuc,ncart))
|
||||||
@ -149,26 +155,84 @@ program QuAcK
|
|||||||
|
|
||||||
! Memory allocation for one- and two-electron integrals
|
! Memory allocation for one- and two-electron integrals
|
||||||
|
|
||||||
allocate(S(nBas,nBas),T(nBas,nBas),V(nBas,nBas),Hc(nBas,nBas),X(nBas,nBas), &
|
allocate(S(nBas,nBas))
|
||||||
ERI_AO(nBas,nBas,nBas,nBas),dipole_int_AO(nBas,nBas,ncart))
|
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
|
! Read integrals
|
||||||
|
|
||||||
call wall_time(start_int)
|
call wall_time(start_int)
|
||||||
|
|
||||||
call read_integrals(nBas,S,T,V,Hc,ERI_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 read_dipole_integrals(nBas, dipole_int_AO)
|
||||||
|
|
||||||
call wall_time(end_int)
|
call wall_time(end_int)
|
||||||
|
|
||||||
t_int = end_int - start_int
|
t_int = end_int - start_int
|
||||||
write(*,*)
|
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(*,*)
|
write(*,*)
|
||||||
|
|
||||||
! Compute orthogonalization matrix
|
! 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 !
|
! Choose QuAcK branch !
|
||||||
@ -200,7 +264,7 @@ program QuAcK
|
|||||||
dodrCCD,dorCCD,docrCCD,dolCCD,doCIS,doCIS_D,doCID,doCISD,doFCI,dophRPA,dophRPAx,docrRPA,doppRPA, &
|
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, &
|
doG0F2,doevGF2,doqsGF2,doufG0F02,doG0F3,doevGF3,doG0W0,doevGW,doqsGW,doufG0W0,doufGW,doSRGqsGW, &
|
||||||
doG0T0pp,doevGTpp,doqsGTpp,doufG0T0pp,doG0T0eh,doevGTeh,doqsGTeh, &
|
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, &
|
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, &
|
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, &
|
maxSCF_GF,max_diis_GF,renorm_GF,thresh_GF,lin_GF,reg_GF,eta_GF,maxSCF_GW,max_diis_GW,thresh_GW, &
|
||||||
@ -256,7 +320,7 @@ program QuAcK
|
|||||||
call wall_time(end_QuAcK)
|
call wall_time(end_QuAcK)
|
||||||
|
|
||||||
t_QuAcK = end_QuAcK - start_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(*,*)
|
write(*,*)
|
||||||
|
|
||||||
end program
|
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, &
|
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, &
|
doG0F2,doevGF2,doqsGF2,doufG0F02,doG0F3,doevGF3,doG0W0,doevGW,doqsGW,doufG0W0,doufGW,doSRGqsGW, &
|
||||||
doG0T0pp,doevGTpp,doqsGTpp,doufG0T0pp,doG0T0eh,doevGTeh,doqsGTeh, &
|
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, &
|
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, &
|
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, &
|
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) :: doG0T0pp,doevGTpp,doqsGTpp,doufG0T0pp
|
||||||
logical,intent(in) :: doG0T0eh,doevGTeh,doqsGTeh
|
logical,intent(in) :: doG0T0eh,doevGTeh,doqsGTeh
|
||||||
|
|
||||||
integer,intent(in) :: nNuc,nBas
|
integer,intent(in) :: nNuc,nBas,nOrb
|
||||||
integer,intent(in) :: nC
|
integer,intent(in) :: nC
|
||||||
integer,intent(in) :: nO
|
integer,intent(in) :: nO
|
||||||
integer,intent(in) :: nV
|
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) :: T(nBas,nBas)
|
||||||
double precision,intent(in) :: V(nBas,nBas)
|
double precision,intent(in) :: V(nBas,nBas)
|
||||||
double precision,intent(in) :: Hc(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) :: dipole_int_AO(nBas,nBas,ncart)
|
||||||
double precision,intent(in) :: ERI_AO(nBas,nBas,nBas,nBas)
|
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 !
|
! Memory allocation !
|
||||||
!-------------------!
|
!-------------------!
|
||||||
|
|
||||||
allocate(cHF(nBas,nBas),eHF(nBas),PHF(nBas,nBas), &
|
allocate(cHF(nBas,nOrb))
|
||||||
dipole_int_MO(nBas,nBas,ncart),ERI_MO(nBas,nBas,nBas,nBas))
|
allocate(eHF(nOrb))
|
||||||
|
allocate(PHF(nBas,nBas))
|
||||||
|
allocate(dipole_int_MO(nOrb,nOrb,ncart))
|
||||||
|
allocate(ERI_MO(nOrb,nOrb,nOrb,nOrb))
|
||||||
|
|
||||||
!---------------------!
|
!---------------------!
|
||||||
! Hartree-Fock module !
|
! Hartree-Fock module !
|
||||||
@ -120,11 +123,11 @@ subroutine RQuAcK(dotest,doRHF,doROHF,dostab,dosearch,doMP2,doMP3,doCCD,dopCCD,d
|
|||||||
|
|
||||||
call wall_time(start_HF)
|
call wall_time(start_HF)
|
||||||
call RHF(dotest, maxSCF_HF, thresh_HF, max_diis_HF, guess_type, level_shift, nNuc, ZNuc, rNuc, ENuc, &
|
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)
|
nBas, nOrb, nO, S, T, V, Hc, ERI_AO, dipole_int_AO, X, ERHF, eHF, cHF, PHF)
|
||||||
call wall_time(end_HF)
|
call wall_time(end_HF)
|
||||||
|
|
||||||
t_HF = end_HF - start_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(*,*)
|
write(*,*)
|
||||||
|
|
||||||
end if
|
end if
|
||||||
@ -133,11 +136,11 @@ subroutine RQuAcK(dotest,doRHF,doROHF,dostab,dosearch,doMP2,doMP3,doCCD,dopCCD,d
|
|||||||
|
|
||||||
call wall_time(start_HF)
|
call wall_time(start_HF)
|
||||||
call ROHF(dotest, maxSCF_HF, thresh_HF, max_diis_HF, guess_type, mix, level_shift, nNuc, ZNuc, rNuc, ENuc, &
|
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)
|
nBas, nOrb, nO, S, T, V, Hc, ERI_AO, dipole_int_AO, X, ERHF, eHF, cHF, PHF)
|
||||||
call wall_time(end_HF)
|
call wall_time(end_HF)
|
||||||
|
|
||||||
t_HF = end_HF - start_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(*,*)
|
write(*,*)
|
||||||
|
|
||||||
end if
|
end if
|
||||||
@ -155,17 +158,17 @@ subroutine RQuAcK(dotest,doRHF,doROHF,dostab,dosearch,doMP2,doMP3,doCCD,dopCCD,d
|
|||||||
! Read and transform dipole-related integrals
|
! Read and transform dipole-related integrals
|
||||||
|
|
||||||
do ixyz = 1, ncart
|
do ixyz = 1, ncart
|
||||||
call AOtoMO(nBas,cHF,dipole_int_AO(:,:,ixyz),dipole_int_MO(:,:,ixyz))
|
call AOtoMO(nBas, nOrb, cHF, dipole_int_AO(1,1,ixyz), dipole_int_MO(1,1,ixyz))
|
||||||
end do
|
end do
|
||||||
|
|
||||||
! 4-index transform
|
! 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)
|
call wall_time(end_AOtoMO)
|
||||||
|
|
||||||
t_AOtoMO = end_AOtoMO - start_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(*,*)
|
write(*,*)
|
||||||
|
|
||||||
!-----------------------------------!
|
!-----------------------------------!
|
||||||
@ -177,11 +180,11 @@ subroutine RQuAcK(dotest,doRHF,doROHF,dostab,dosearch,doMP2,doMP3,doCCD,dopCCD,d
|
|||||||
if(dostab) then
|
if(dostab) then
|
||||||
|
|
||||||
call wall_time(start_stab)
|
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)
|
call wall_time(end_stab)
|
||||||
|
|
||||||
t_stab = end_stab - start_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(*,*)
|
write(*,*)
|
||||||
|
|
||||||
end if
|
end if
|
||||||
@ -190,11 +193,12 @@ subroutine RQuAcK(dotest,doRHF,doROHF,dostab,dosearch,doMP2,doMP3,doCCD,dopCCD,d
|
|||||||
|
|
||||||
call wall_time(start_stab)
|
call wall_time(start_stab)
|
||||||
call RHF_search(maxSCF_HF, thresh_HF, max_diis_HF, guess_type, level_shift, nNuc, ZNuc, rNuc, ENuc, &
|
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)
|
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)
|
call wall_time(end_stab)
|
||||||
|
|
||||||
t_stab = end_stab - start_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(*,*)
|
write(*,*)
|
||||||
|
|
||||||
end if
|
end if
|
||||||
@ -208,11 +212,11 @@ subroutine RQuAcK(dotest,doRHF,doROHF,dostab,dosearch,doMP2,doMP3,doCCD,dopCCD,d
|
|||||||
if(doMP) then
|
if(doMP) then
|
||||||
|
|
||||||
call wall_time(start_MP)
|
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)
|
call wall_time(end_MP)
|
||||||
|
|
||||||
t_MP = end_MP - start_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(*,*)
|
write(*,*)
|
||||||
|
|
||||||
end if
|
end if
|
||||||
@ -228,11 +232,11 @@ subroutine RQuAcK(dotest,doRHF,doROHF,dostab,dosearch,doMP2,doMP3,doCCD,dopCCD,d
|
|||||||
|
|
||||||
call wall_time(start_CC)
|
call wall_time(start_CC)
|
||||||
call RCC(dotest, doCCD, dopCCD, doDCD, doCCSD, doCCSDT, dodrCCD, dorCCD, docrCCD, dolCCD, &
|
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)
|
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)
|
call wall_time(end_CC)
|
||||||
|
|
||||||
t_CC = end_CC - start_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(*,*)
|
write(*,*)
|
||||||
|
|
||||||
end if
|
end if
|
||||||
@ -246,12 +250,12 @@ subroutine RQuAcK(dotest,doRHF,doROHF,dostab,dosearch,doMP2,doMP3,doCCD,dopCCD,d
|
|||||||
if(doCI) then
|
if(doCI) then
|
||||||
|
|
||||||
call wall_time(start_CI)
|
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, &
|
call RCI(dotest, doCIS, doCIS_D, doCID, doCISD, doFCI, singlet, triplet, nOrb, &
|
||||||
eHF,ERHF,cHF,S)
|
nC, nO, nV, nR, nS, ERI_MO, dipole_int_MO, eHF, ERHF)
|
||||||
call wall_time(end_CI)
|
call wall_time(end_CI)
|
||||||
|
|
||||||
t_CI = end_CI - start_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(*,*)
|
write(*,*)
|
||||||
|
|
||||||
end if
|
end if
|
||||||
@ -266,11 +270,11 @@ subroutine RQuAcK(dotest,doRHF,doROHF,dostab,dosearch,doMP2,doMP3,doCCD,dopCCD,d
|
|||||||
|
|
||||||
call wall_time(start_RPA)
|
call wall_time(start_RPA)
|
||||||
call RRPA(dotest, dophRPA, dophRPAx, docrRPA, doppRPA, TDA, doACFDT, exchange_kernel, singlet, triplet, &
|
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)
|
nOrb, nC, nO, nV, nR, nS, ENuc, ERHF, ERI_MO, dipole_int_MO, eHF)
|
||||||
call wall_time(end_RPA)
|
call wall_time(end_RPA)
|
||||||
|
|
||||||
t_RPA = end_RPA - start_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(*,*)
|
write(*,*)
|
||||||
|
|
||||||
end if
|
end if
|
||||||
@ -284,14 +288,14 @@ subroutine RQuAcK(dotest,doRHF,doROHF,dostab,dosearch,doMP2,doMP3,doCCD,dopCCD,d
|
|||||||
if(doGF) then
|
if(doGF) then
|
||||||
|
|
||||||
call wall_time(start_GF)
|
call wall_time(start_GF)
|
||||||
call RGF(dotest,doG0F2,doevGF2,doqsGF2,doufG0F02,doG0F3,doevGF3,renorm_GF,maxSCF_GF,thresh_GF,max_diis_GF, &
|
call RGF(dotest, doG0F2, doevGF2, doqsGF2, doufG0F02, doG0F3, doevGF3, renorm_GF, maxSCF_GF, &
|
||||||
dophBSE,doppBSE,TDA,dBSE,dTDA,singlet,triplet,lin_GF,eta_GF,reg_GF, &
|
thresh_GF, max_diis_GF, dophBSE, doppBSE, TDA, dBSE, dTDA, singlet, triplet, lin_GF, &
|
||||||
nNuc,ZNuc,rNuc,ENuc,nBas,nC,nO,nV,nR,nS,ERHF,S,X,T,V,Hc,ERI_AO,ERI_MO, &
|
eta_GF, reg_GF, nNuc, ZNuc, rNuc, ENuc, nBas, nOrb, nC, nO, nV, nR, nS, ERHF, &
|
||||||
dipole_int_AO,dipole_int_MO,PHF,cHF,eHF)
|
S, X, T, V, Hc, ERI_AO, ERI_MO, dipole_int_AO, dipole_int_MO, PHF, cHF, eHF)
|
||||||
call wall_time(end_GF)
|
call wall_time(end_GF)
|
||||||
|
|
||||||
t_GF = end_GF - start_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(*,*)
|
write(*,*)
|
||||||
|
|
||||||
end if
|
end if
|
||||||
@ -307,12 +311,12 @@ subroutine RQuAcK(dotest,doRHF,doROHF,dostab,dosearch,doMP2,doMP3,doCCD,dopCCD,d
|
|||||||
call wall_time(start_GW)
|
call wall_time(start_GW)
|
||||||
call RGW(dotest, doG0W0, doevGW, doqsGW, doufG0W0, doufGW, doSRGqsGW, maxSCF_GW, thresh_GW, max_diis_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, &
|
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, &
|
lin_GW, eta_GW, reg_GW, nNuc, ZNuc, rNuc, ENuc, nBas, nOrb, nC, nO, nV, nR, nS, ERHF, S, X, T, &
|
||||||
ERI_AO,ERI_MO,dipole_int_AO,dipole_int_MO,PHF,cHF,eHF)
|
V, Hc, ERI_AO, ERI_MO, dipole_int_AO, dipole_int_MO, PHF, cHF, eHF)
|
||||||
call wall_time(end_GW)
|
call wall_time(end_GW)
|
||||||
|
|
||||||
t_GW = end_GW - start_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(*,*)
|
write(*,*)
|
||||||
|
|
||||||
end if
|
end if
|
||||||
@ -329,11 +333,12 @@ subroutine RQuAcK(dotest,doRHF,doROHF,dostab,dosearch,doMP2,doMP3,doCCD,dopCCD,d
|
|||||||
call RGT(dotest, doG0T0pp, doevGTpp, doqsGTpp, doufG0T0pp, doG0T0eh, doevGTeh, doqsGTeh, &
|
call RGT(dotest, doG0T0pp, doevGTpp, doqsGTpp, doufG0T0pp, doG0T0eh, doevGTeh, doqsGTeh, &
|
||||||
maxSCF_GT, thresh_GT, max_diis_GT, doACFDT, exchange_kernel, doXBS, dophBSE, dophBSE2, doppBSE, &
|
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, &
|
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)
|
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)
|
call wall_time(end_GT)
|
||||||
|
|
||||||
t_GT = end_GT - start_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(*,*)
|
write(*,*)
|
||||||
|
|
||||||
end if
|
end if
|
||||||
|
@ -163,8 +163,8 @@ subroutine UQuAcK(dotest,doUHF,dostab,dosearch,doMP2,doMP3,doCCD,dopCCD,doDCD,do
|
|||||||
! Read and transform dipole-related integrals
|
! Read and transform dipole-related integrals
|
||||||
|
|
||||||
do ixyz=1,ncart
|
do ixyz=1,ncart
|
||||||
call AOtoMO(nBas,cHF(:,:,1),dipole_int_AO(:,:,ixyz),dipole_int_aa(:,:,ixyz))
|
call AOtoMO(nBas,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(:,:,2),dipole_int_AO(:,:,ixyz),dipole_int_bb(:,:,ixyz))
|
||||||
end do
|
end do
|
||||||
|
|
||||||
! 4-index transform for (aa|aa) block
|
! 4-index transform for (aa|aa) block
|
||||||
|
@ -1,5 +1,5 @@
|
|||||||
subroutine RRPA(dotest,dophRPA,dophRPAx,docrRPA,doppRPA,TDA,doACFDT,exchange_kernel,singlet,triplet, &
|
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
|
! 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) :: ENuc
|
||||||
double precision,intent(in) :: ERHF
|
double precision,intent(in) :: ERHF
|
||||||
double precision,intent(in) :: eHF(nBas)
|
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) :: ERI(nBas,nBas,nBas,nBas)
|
||||||
double precision,intent(in) :: dipole_int(nBas,nBas,ncart)
|
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)
|
call wall_time(end_RPA)
|
||||||
|
|
||||||
t_RPA = end_RPA - start_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(*,*)
|
write(*,*)
|
||||||
|
|
||||||
end if
|
end if
|
||||||
@ -65,7 +63,7 @@ subroutine RRPA(dotest,dophRPA,dophRPAx,docrRPA,doppRPA,TDA,doACFDT,exchange_ker
|
|||||||
call wall_time(end_RPA)
|
call wall_time(end_RPA)
|
||||||
|
|
||||||
t_RPA = end_RPA - start_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(*,*)
|
write(*,*)
|
||||||
|
|
||||||
end if
|
end if
|
||||||
@ -81,7 +79,7 @@ subroutine RRPA(dotest,dophRPA,dophRPAx,docrRPA,doppRPA,TDA,doACFDT,exchange_ker
|
|||||||
call wall_time(end_RPA)
|
call wall_time(end_RPA)
|
||||||
|
|
||||||
t_RPA = end_RPA - start_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(*,*)
|
write(*,*)
|
||||||
|
|
||||||
end if
|
end if
|
||||||
@ -97,7 +95,7 @@ subroutine RRPA(dotest,dophRPA,dophRPAx,docrRPA,doppRPA,TDA,doACFDT,exchange_ker
|
|||||||
call wall_time(end_RPA)
|
call wall_time(end_RPA)
|
||||||
|
|
||||||
t_RPA = end_RPA - start_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(*,*)
|
write(*,*)
|
||||||
|
|
||||||
end if
|
end if
|
||||||
|
@ -39,6 +39,7 @@ subroutine sort_ppRPA(nOO,nVV,Om,Z,Om1,X1,Y1,Om2,X2,Y2)
|
|||||||
double precision,intent(out) :: X2(nVV,nOO)
|
double precision,intent(out) :: X2(nVV,nOO)
|
||||||
double precision,intent(out) :: Y2(nOO,nOO)
|
double precision,intent(out) :: Y2(nOO,nOO)
|
||||||
|
|
||||||
|
|
||||||
! Memory allocation
|
! 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))
|
||||||
@ -113,6 +114,7 @@ subroutine sort_ppRPA(nOO,nVV,Om,Z,Om1,X1,Y1,Om2,X2,Y2)
|
|||||||
|
|
||||||
end if
|
end if
|
||||||
|
|
||||||
|
|
||||||
! Orthogonalize eigenvectors
|
! Orthogonalize eigenvectors
|
||||||
|
|
||||||
! deg1 = 1
|
! deg1 = 1
|
||||||
@ -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 ('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(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 ('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)
|
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
|
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"]:
|
if sys.platform in ["linux", "linux2"]:
|
||||||
compiler = compile_gfortran_linux
|
# compiler = compile_gfortran_linux
|
||||||
# compiler = compile_ifort_linux
|
compiler = compile_ifort_linux
|
||||||
|
# compiler = compile_olympe
|
||||||
elif sys.platform == "darwin":
|
elif sys.platform == "darwin":
|
||||||
compiler = compile_gfortran_mac
|
compiler = compile_gfortran_mac
|
||||||
else:
|
else:
|
||||||
|
@ -9,12 +9,12 @@ subroutine check_test_value(branch)
|
|||||||
! Local variables
|
! Local variables
|
||||||
|
|
||||||
character(len=30) :: description
|
character(len=30) :: description
|
||||||
double precision :: value
|
double precision :: val
|
||||||
double precision :: reference
|
double precision :: reference
|
||||||
character(len=15) :: answer
|
character(len=15) :: answer
|
||||||
|
|
||||||
logical :: failed
|
logical :: failed
|
||||||
double precision,parameter :: cutoff = 1d-10
|
double precision,parameter :: thresh = 1d-10
|
||||||
|
|
||||||
! Output variables
|
! Output variables
|
||||||
|
|
||||||
@ -45,19 +45,19 @@ subroutine check_test_value(branch)
|
|||||||
do
|
do
|
||||||
|
|
||||||
read(11,'(A30)',end=11) description
|
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,*,end=12)
|
||||||
read(12,'(F20.15)',end=12) reference
|
read(12,'(F20.15)',end=12) reference
|
||||||
|
|
||||||
if(abs(value-reference) < cutoff) then
|
if(dabs(val-reference)/(1d-15+dabs(reference)) < thresh) then
|
||||||
answer = '.......... :-)'
|
answer = '.......... :-)'
|
||||||
else
|
else
|
||||||
answer = '.......... :-( '
|
answer = '.......... :-( '
|
||||||
failed = .true.
|
failed = .true.
|
||||||
end if
|
end if
|
||||||
write(*,'(1X,A1,1X,A30,1X,A1,1X,3F15.10,1X,A1,1X,A15,1X,A1)') &
|
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
|
end do
|
||||||
|
|
||||||
|
@ -1,4 +1,4 @@
|
|||||||
subroutine dump_test_value(branch,description,value)
|
subroutine dump_test_value(branch, description, val)
|
||||||
|
|
||||||
implicit none
|
implicit none
|
||||||
|
|
||||||
@ -7,7 +7,7 @@ subroutine dump_test_value(branch,description,value)
|
|||||||
character(len=1),intent(in) :: branch
|
character(len=1),intent(in) :: branch
|
||||||
character(len=*),intent(in) :: description
|
character(len=*),intent(in) :: description
|
||||||
|
|
||||||
double precision,intent(in) :: value
|
double precision,intent(in) :: val
|
||||||
|
|
||||||
! Local variables
|
! Local variables
|
||||||
|
|
||||||
@ -15,18 +15,19 @@ subroutine dump_test_value(branch,description,value)
|
|||||||
|
|
||||||
if(branch == 'R') then
|
if(branch == 'R') then
|
||||||
|
|
||||||
write(11,*) trim(description)
|
!write(1231597, '(A, ": ", F20.15)') '"' // trim(description) // '"', val
|
||||||
write(11,'(F20.15)') value
|
write(1231597, *) trim(description)
|
||||||
|
write(1231597, '(F20.15)') val
|
||||||
|
|
||||||
elseif(branch == 'U') then
|
elseif(branch == 'U') then
|
||||||
|
|
||||||
write(12,*) trim(description)
|
write(1232584,*) trim(description)
|
||||||
write(12,'(F20.15)') value
|
write(1232584,'(F20.15)') val
|
||||||
|
|
||||||
elseif(branch == 'G') then
|
elseif(branch == 'G') then
|
||||||
|
|
||||||
write(13,*) trim(description)
|
write(1234181,*) trim(description)
|
||||||
write(13,'(F20.15)') value
|
write(1234181,'(F20.15)') val
|
||||||
|
|
||||||
else
|
else
|
||||||
|
|
||||||
|
@ -12,10 +12,10 @@ subroutine init_test(doRtest,doUtest,doGtest)
|
|||||||
|
|
||||||
! Output variables
|
! 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
|
end subroutine
|
||||||
|
@ -12,10 +12,10 @@ subroutine stop_test(doRtest,doUtest,doGtest)
|
|||||||
|
|
||||||
! Output variables
|
! 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
|
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
|
! Perform level-shifting on the Fock matrix
|
||||||
|
|
||||||
@ -7,10 +7,10 @@ subroutine level_shifting(level_shift,nBas,nO,S,c,F)
|
|||||||
! Input variables
|
! Input variables
|
||||||
|
|
||||||
double precision,intent(in) :: level_shift
|
double precision,intent(in) :: level_shift
|
||||||
integer,intent(in) :: nBas
|
integer,intent(in) :: nBas, nOrb
|
||||||
integer,intent(in) :: nO
|
integer,intent(in) :: nO
|
||||||
double precision,intent(in) :: S(nBas,nBas)
|
double precision,intent(in) :: S(nBas,nBas)
|
||||||
double precision,intent(in) :: c(nBas,nBas)
|
double precision,intent(in) :: c(nBas,nOrb)
|
||||||
|
|
||||||
! Local variables
|
! Local variables
|
||||||
|
|
||||||
@ -23,15 +23,17 @@ subroutine level_shifting(level_shift,nBas,nO,S,c,F)
|
|||||||
|
|
||||||
double precision,intent(inout):: F(nBas,nBas)
|
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
|
F_MO(a,a) = F_MO(a,a) + level_shift
|
||||||
end do
|
end do
|
||||||
|
|
||||||
Sc(:,:) = matmul(S, c)
|
Sc(:,:) = matmul(S, c)
|
||||||
F(:,:) = matmul(Sc, matmul(F_MO, transpose(Sc)))
|
F(:,:) = matmul(Sc, matmul(F_MO, transpose(Sc)))
|
||||||
|
|
||||||
|
deallocate(F_MO, Sc)
|
||||||
|
|
||||||
end subroutine
|
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,3 +1,6 @@
|
|||||||
|
|
||||||
|
! ---
|
||||||
|
|
||||||
subroutine orthogonalization_matrix(nBas, S, X)
|
subroutine orthogonalization_matrix(nBas, S, X)
|
||||||
|
|
||||||
! Compute the orthogonalization matrix X
|
! Compute the orthogonalization matrix X
|
||||||
@ -35,6 +38,24 @@ subroutine orthogonalization_matrix(nBas,S,X)
|
|||||||
|
|
||||||
if(ortho_type == 1) then
|
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(*,*)
|
||||||
! write(*,*) ' Lowdin orthogonalization'
|
! write(*,*) ' Lowdin orthogonalization'
|
||||||
! write(*,*)
|
! write(*,*)
|
||||||
@ -50,11 +71,11 @@ subroutine orthogonalization_matrix(nBas,S,X)
|
|||||||
|
|
||||||
end if
|
end if
|
||||||
|
|
||||||
Uval(i) = 1d0/sqrt(Uval(i))
|
Uval(i) = 1d0 / dsqrt(Uval(i))
|
||||||
|
|
||||||
end do
|
end do
|
||||||
|
|
||||||
call ADAt(nBas,Uvec,Uval,X)
|
call ADAt(nBas, Uvec(1,1), Uval(1), X(1,1))
|
||||||
|
|
||||||
elseif(ortho_type == 2) then
|
elseif(ortho_type == 2) then
|
||||||
|
|
||||||
@ -69,7 +90,7 @@ subroutine orthogonalization_matrix(nBas,S,X)
|
|||||||
|
|
||||||
if(Uval(i) > thresh) then
|
if(Uval(i) > thresh) then
|
||||||
|
|
||||||
Uval(i) = 1d0/sqrt(Uval(i))
|
Uval(i) = 1d0 / dsqrt(Uval(i))
|
||||||
|
|
||||||
else
|
else
|
||||||
|
|
||||||
@ -117,3 +138,6 @@ subroutine orthogonalization_matrix(nBas,S,X)
|
|||||||
end if
|
end if
|
||||||
|
|
||||||
end subroutine
|
end subroutine
|
||||||
|
|
||||||
|
! ---
|
||||||
|
|
||||||
|
@ -24,10 +24,10 @@ subroutine read_basis_pyscf(nBas,nO,nV)
|
|||||||
read(3, *) nBas
|
read(3, *) nBas
|
||||||
close(unit=3)
|
close(unit=3)
|
||||||
|
|
||||||
write(*,'(A28)') '------------------'
|
! write(*,'(A38)') '--------------------------------------'
|
||||||
write(*,'(A28,1X,I16)') 'Number of basis functions',nBas
|
! write(*,'(A38,1X,I16)') 'Number of basis functions (AOs)', nBas
|
||||||
write(*,'(A28)') '------------------'
|
! write(*,'(A38)') '--------------------------------------'
|
||||||
write(*,*)
|
! write(*,*)
|
||||||
|
|
||||||
! Number of virtual orbitals
|
! 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
|
! Read one- and two-electron integrals from files
|
||||||
|
|
||||||
@ -7,7 +7,7 @@ subroutine read_integrals(nBas,S,T,V,Hc,G)
|
|||||||
|
|
||||||
! Input variables
|
! Input variables
|
||||||
|
|
||||||
integer,intent(in) :: nBas
|
integer,intent(in) :: nBas_AOs
|
||||||
|
|
||||||
! Local variables
|
! Local variables
|
||||||
|
|
||||||
@ -18,11 +18,11 @@ subroutine read_integrals(nBas,S,T,V,Hc,G)
|
|||||||
|
|
||||||
! Output variables
|
! Output variables
|
||||||
|
|
||||||
double precision,intent(out) :: S(nBas,nBas)
|
double precision,intent(out) :: S(nBas_AOs,nBas_AOs)
|
||||||
double precision,intent(out) :: T(nBas,nBas)
|
double precision,intent(out) :: T(nBas_AOs,nBas_AOs)
|
||||||
double precision,intent(out) :: V(nBas,nBas)
|
double precision,intent(out) :: V(nBas_AOs,nBas_AOs)
|
||||||
double precision,intent(out) :: Hc(nBas,nBas)
|
double precision,intent(out) :: Hc(nBas_AOs,nBas_AOs)
|
||||||
double precision,intent(out) :: G(nBas,nBas,nBas,nBas)
|
double precision,intent(out) :: G(nBas_AOs,nBas_AOs,nBas_AOs,nBas_AOs)
|
||||||
|
|
||||||
! Open file with integrals
|
! 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=8 ,file='int/Ov.dat')
|
||||||
open(unit=9 ,file='int/Kin.dat')
|
open(unit=9 ,file='int/Kin.dat')
|
||||||
open(unit=10,file='int/Nuc.dat')
|
open(unit=10,file='int/Nuc.dat')
|
||||||
open(unit=11,file='int/ERI.dat')
|
|
||||||
|
|
||||||
open(unit=21,file='int/x.dat')
|
open(unit=21,file='int/x.dat')
|
||||||
open(unit=22,file='int/y.dat')
|
open(unit=22,file='int/y.dat')
|
||||||
@ -75,31 +74,29 @@ subroutine read_integrals(nBas,S,T,V,Hc,G)
|
|||||||
|
|
||||||
Hc(:,:) = T(:,:) + V(:,:)
|
Hc(:,:) = T(:,:) + V(:,:)
|
||||||
|
|
||||||
! Read nuclear integrals
|
! Read 2e-integrals
|
||||||
|
|
||||||
G(:,:,:,:) = 0d0
|
! ! formatted file
|
||||||
do
|
! open(unit=11, file='int/ERI.dat')
|
||||||
read(11,*,end=11) mu,nu,la,si,ERI
|
! 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
|
! binary file
|
||||||
! <12|34>
|
open(unit=11, file='int/ERI.bin', form='unformatted', access='stream')
|
||||||
G(mu,nu,la,si) = ERI
|
read(11) G
|
||||||
! <32|14>
|
close(11)
|
||||||
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)
|
|
||||||
|
|
||||||
|
|
||||||
! Print results
|
! Print results
|
||||||
@ -107,24 +104,24 @@ subroutine read_integrals(nBas,S,T,V,Hc,G)
|
|||||||
write(*,'(A28)') '----------------------'
|
write(*,'(A28)') '----------------------'
|
||||||
write(*,'(A28)') 'Overlap integrals'
|
write(*,'(A28)') 'Overlap integrals'
|
||||||
write(*,'(A28)') '----------------------'
|
write(*,'(A28)') '----------------------'
|
||||||
call matout(nBas,nBas,S)
|
call matout(nBas_AOs,nBas_AOs,S)
|
||||||
write(*,*)
|
write(*,*)
|
||||||
write(*,'(A28)') '----------------------'
|
write(*,'(A28)') '----------------------'
|
||||||
write(*,'(A28)') 'Kinetic integrals'
|
write(*,'(A28)') 'Kinetic integrals'
|
||||||
write(*,'(A28)') '----------------------'
|
write(*,'(A28)') '----------------------'
|
||||||
call matout(nBas,nBas,T)
|
call matout(nBas_AOs,nBas_AOs,T)
|
||||||
write(*,*)
|
write(*,*)
|
||||||
write(*,'(A28)') '----------------------'
|
write(*,'(A28)') '----------------------'
|
||||||
write(*,'(A28)') 'Nuclear integrals'
|
write(*,'(A28)') 'Nuclear integrals'
|
||||||
write(*,'(A28)') '----------------------'
|
write(*,'(A28)') '----------------------'
|
||||||
call matout(nBas,nBas,V)
|
call matout(nBas_AOs,nBas_AOs,V)
|
||||||
write(*,*)
|
write(*,*)
|
||||||
write(*,'(A28)') '----------------------'
|
write(*,'(A28)') '----------------------'
|
||||||
write(*,'(A28)') 'Electron repulsion integrals'
|
write(*,'(A28)') 'Electron repulsion integrals'
|
||||||
write(*,'(A28)') '----------------------'
|
write(*,'(A28)') '----------------------'
|
||||||
do la=1,nBas
|
do la=1,nBas_AOs
|
||||||
do si=1,nBas
|
do si=1,nBas_AOs
|
||||||
call matout(nBas,nBas,G(1,1,la,si))
|
call matout(nBas_AOs, nBas_AOs, G(1,1,la,si))
|
||||||
end do
|
end do
|
||||||
end do
|
end do
|
||||||
write(*,*)
|
write(*,*)
|
||||||
|
@ -110,6 +110,8 @@ subroutine matrix_exponential(N,A,ExpA)
|
|||||||
t(:,:) = matmul(t, A)
|
t(:,:) = matmul(t, A)
|
||||||
ExpA(:,:) = ExpA(:,:) + matmul(W, t)
|
ExpA(:,:) = ExpA(:,:) + matmul(W, t)
|
||||||
|
|
||||||
|
deallocate(W, tau, t)
|
||||||
|
|
||||||
end subroutine
|
end subroutine
|
||||||
|
|
||||||
!------------------------------------------------------------------------
|
!------------------------------------------------------------------------
|
||||||
@ -375,15 +377,29 @@ subroutine ADAt(N,A,D,B)
|
|||||||
|
|
||||||
double precision,intent(out) :: B(N,N)
|
double precision,intent(out) :: B(N,N)
|
||||||
|
|
||||||
B = 0d0
|
double precision, allocatable :: tmp(:,:)
|
||||||
|
|
||||||
|
allocate(tmp(N,N))
|
||||||
|
!$OMP PARALLEL DEFAULT(NONE) PRIVATE(i, j) SHARED(N, A, D, tmp)
|
||||||
|
!$OMP DO
|
||||||
do i = 1, N
|
do i = 1, N
|
||||||
do j = 1, N
|
do j = 1, N
|
||||||
do k=1,N
|
tmp(i,j) = D(i) * A(j,i)
|
||||||
B(i,k) = B(i,k) + A(i,j)*D(j)*A(k,j)
|
|
||||||
end do
|
|
||||||
enddo
|
enddo
|
||||||
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
|
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)
|
call dgeev('V','V',N,A,N,WR,WI,VL,N,VR,N,work,lwork,info)
|
||||||
|
|
||||||
|
deallocate(work, WI, VL)
|
||||||
|
|
||||||
if(info /= 0) then
|
if(info /= 0) then
|
||||||
print*,'Problem in diagonalize_general_matrix (dgeev)!!'
|
print*,'Problem in diagonalize_general_matrix (dgeev)!!'
|
||||||
end if
|
end if
|
||||||
@ -68,6 +70,8 @@ subroutine diagonalize_matrix(N,A,e)
|
|||||||
|
|
||||||
call dsyev('V','U',N,A,N,e,work,lwork,info)
|
call dsyev('V','U',N,A,N,e,work,lwork,info)
|
||||||
|
|
||||||
|
deallocate(work)
|
||||||
|
|
||||||
if(info /= 0) then
|
if(info /= 0) then
|
||||||
print*,'Problem in diagonalize_matrix (dsyev)!!'
|
print*,'Problem in diagonalize_matrix (dsyev)!!'
|
||||||
end if
|
end if
|
||||||
|
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…
Reference in New Issue
Block a user