4
1
mirror of https://github.com/pfloos/quack synced 2024-12-22 12:23:50 +01:00

added Hartree and EX terms with s8-sym

This commit is contained in:
Abdallah Ammar 2024-12-10 19:14:33 +01:00
parent 671c6f4f12
commit 37420d1207
4 changed files with 115 additions and 92 deletions

View File

@ -163,7 +163,6 @@ if print_2e:
output_file_path = working_dir + '/int/ERI_chem.bin' output_file_path = working_dir + '/int/ERI_chem.bin'
subprocess.call(['rm', '-f', output_file_path]) subprocess.call(['rm', '-f', output_file_path])
eri_ao = mol.intor('int2e', aosym='s8') eri_ao = mol.intor('int2e', aosym='s8')
print(eri_ao.shape)
f = open(output_file_path, 'w') f = open(output_file_path, 'w')
eri_ao.tofile(output_file_path) eri_ao.tofile(output_file_path)
f.close() f.close()

View File

@ -50,49 +50,48 @@ subroutine exchange_matrix_AO_basis_hpc(nBas, ERI_size, P, ERI_chem, K)
integer*8 :: nunununu, nulanula, lanulanu, nulanusi integer*8 :: nunununu, nulanula, lanulanu, nulanusi
integer*8 :: munulasi, lanunusi, lanusinu, numumumu integer*8 :: munulasi, lanunusi, lanusinu, numumumu
integer*8 :: nulamula, nulalamu, lanulamu, nulamusi integer*8 :: nulamula, nulalamu, lanulamu, nulamusi
integer*8 :: nulasimu, lanumusi, lanusimu integer*8 :: nulasimu, lanumusi, lanusimu, simunula
integer*8 :: simulanu
integer*8, external :: Yoshimine_4ind
do nu = 1, nBas do nu = 1, nBas
nunu = (nu * (nu - 1)) / 2 + nu nunu = shiftr(nu * (nu - 1), 1) + nu
nunununu = (nunu * (nunu - 1)) / 2 + nunu nunununu = shiftr(nunu * (nunu - 1), 1) + nunu
K(nu,nu) = -P(nu,nu) * ERI_chem(nunununu) K(nu,nu) = -P(nu,nu) * ERI_chem(nunununu)
do la = 1, nu - 1 do la = 1, nu - 1
nula = (nu * (nu - 1)) / 2 + la nula = shiftr(nu * (nu - 1), 1) + la
nulanula = (nula * (nula - 1)) / 2 + nula nulanula = shiftr(nula * (nula - 1), 1) + nula
K(nu,nu) = K(nu,nu) - P(la,la) * ERI_chem(nulanula) K(nu,nu) = K(nu,nu) - P(la,la) * ERI_chem(nulanula)
enddo enddo
do la = nu + 1, nBas do la = nu + 1, nBas
lanu = (la * (la - 1)) / 2 + nu lanu = shiftr(la * (la - 1), 1) + nu
lanulanu = (lanu * (lanu - 1)) / 2 + lanu lanulanu = shiftr(lanu * (lanu - 1), 1) + lanu
K(nu,nu) = K(nu,nu) - P(la,la) * ERI_chem(lanulanu) K(nu,nu) = K(nu,nu) - P(la,la) * ERI_chem(lanulanu)
enddo enddo
do la = 1, nu do la = 1, nu
nula = (nu * (nu - 1)) / 2 + la nula = shiftr(nu * (nu - 1), 1) + la
do si = 1, la - 1 do si = 1, la - 1
nusi = (nu * (nu - 1)) / 2 + si nusi = shiftr(nu * (nu - 1), 1) + si
nulanusi = (nula * (nula - 1)) / 2 + nusi nulanusi = shiftr(nula * (nula - 1), 1) + nusi
K(nu,nu) = K(nu,nu) - 2.d0 * P(si,la) * ERI_chem(nulanusi) K(nu,nu) = K(nu,nu) - 2.d0 * P(si,la) * ERI_chem(nulanusi)
enddo enddo
enddo enddo
do la = nu + 1, nBas do la = nu + 1, nBas
lanu = (la * (la - 1)) / 2 + nu lanu = shiftr(la * (la - 1), 1) + nu
do si = 1, nu do si = 1, nu
nusi = (nu * (nu - 1)) / 2 + si nusi = shiftr(nu * (nu - 1), 1) + si
lanunusi = (lanu * (lanu - 1)) / 2 + nusi lanunusi = shiftr(lanu * (lanu - 1), 1) + nusi
K(nu,nu) = K(nu,nu) - 2.d0 * P(si,la) * ERI_chem(lanunusi) K(nu,nu) = K(nu,nu) - 2.d0 * P(si,la) * ERI_chem(lanunusi)
enddo enddo
do si = nu + 1, la - 1 do si = nu + 1, la - 1
sinu = (si * (si - 1)) / 2 + nu sinu = shiftr(si * (si - 1), 1) + nu
lanusinu = (lanu * (lanu - 1)) / 2 + sinu lanusinu = shiftr(lanu * (lanu - 1), 1) + sinu
K(nu,nu) = K(nu,nu) - 2.d0 * P(si,la) * ERI_chem(lanusinu) K(nu,nu) = K(nu,nu) - 2.d0 * P(si,la) * ERI_chem(lanusinu)
enddo enddo
enddo enddo
@ -100,108 +99,104 @@ subroutine exchange_matrix_AO_basis_hpc(nBas, ERI_size, P, ERI_chem, K)
do mu = 1, nu - 1 do mu = 1, nu - 1
numu = (nu * (nu - 1)) / 2 + mu numu = shiftr(nu * (nu - 1), 1) + mu
mumu = (mu * (mu - 1)) / 2 + mu mumu = shiftr(mu * (mu - 1), 1) + mu
numumumu = (numu * (numu - 1)) / 2 + mumu numumumu = shiftr(numu * (numu - 1), 1) + mumu
K(mu,nu) = - P(mu,mu) * ERI_chem(numumumu) K(mu,nu) = - P(mu,mu) * ERI_chem(numumumu)
do la = 1, mu - 1 do la = 1, mu - 1
mula = (mu * (mu - 1)) / 2 + la mula = shiftr(mu * (mu - 1), 1) + la
nula = (nu * (nu - 1)) / 2 + la nula = shiftr(nu * (nu - 1), 1) + la
nulamula = (nula * (nula - 1)) / 2 + mula nulamula = shiftr(nula * (nula - 1), 1) + mula
K(mu,nu) = K(mu,nu) - P(la,la) * ERI_chem(nulamula) K(mu,nu) = K(mu,nu) - P(la,la) * ERI_chem(nulamula)
enddo enddo
do la = mu + 1, nu do la = mu + 1, nu
lamu = (la * (la - 1)) / 2 + mu lamu = shiftr(la * (la - 1), 1) + mu
nula = (nu * (nu - 1)) / 2 + la nula = shiftr(nu * (nu - 1), 1) + la
nulalamu = (nula * (nula - 1)) / 2 + lamu nulalamu = shiftr(nula * (nula - 1), 1) + lamu
K(mu,nu) = K(mu,nu) - P(la,la) * ERI_chem(nulalamu) K(mu,nu) = K(mu,nu) - P(la,la) * ERI_chem(nulalamu)
enddo enddo
do la = nu + 1, nBas do la = nu + 1, nBas
lamu = (la * (la - 1)) / 2 + mu lamu = shiftr(la * (la - 1), 1) + mu
lanu = (la * (la - 1)) / 2 + nu lanu = shiftr(la * (la - 1), 1) + nu
lanulamu = (lanu * (lanu - 1)) / 2 + lamu lanulamu = shiftr(lanu * (lanu - 1), 1) + lamu
K(mu,nu) = K(mu,nu) - P(la,la) * ERI_chem(lanulamu) K(mu,nu) = K(mu,nu) - P(la,la) * ERI_chem(lanulamu)
enddo enddo
do la = 1, mu do la = 1, mu
nula = (nu * (nu - 1)) / 2 + la nula = shiftr(nu * (nu - 1), 1) + la
do si = 1, la - 1 do si = 1, la - 1
musi = (mu * (mu - 1)) / 2 + si musi = shiftr(mu * (mu - 1), 1) + si
nulamusi = (nula * (nula - 1)) / 2 + musi nulamusi = shiftr(nula * (nula - 1), 1) + musi
K(mu,nu) = K(mu,nu) - P(si,la) * ERI_chem(nulamusi) K(mu,nu) = K(mu,nu) - P(si,la) * ERI_chem(nulamusi)
enddo enddo
enddo enddo
do la = mu + 1, nu do la = mu + 1, nu
nula = (nu * (nu - 1)) / 2 + la nula = shiftr(nu * (nu - 1), 1) + la
do si = 1, mu do si = 1, mu
musi = (mu * (mu - 1)) / 2 + si musi = shiftr(mu * (mu - 1), 1) + si
nulamusi = (nula * (nula - 1)) / 2 + musi nulamusi = shiftr(nula * (nula - 1), 1) + musi
K(mu,nu) = K(mu,nu) - P(si,la) * ERI_chem(nulamusi) K(mu,nu) = K(mu,nu) - P(si,la) * ERI_chem(nulamusi)
enddo enddo
do si = mu + 1, la - 1 do si = mu + 1, la - 1
simu = (si * (si - 1)) / 2 + mu simu = shiftr(si * (si - 1), 1) + mu
nulasimu = (nula * (nula - 1)) / 2 + simu nulasimu = shiftr(nula * (nula - 1), 1) + simu
K(mu,nu) = K(mu,nu) - P(si,la) * ERI_chem(nulasimu) K(mu,nu) = K(mu,nu) - P(si,la) * ERI_chem(nulasimu)
enddo enddo
enddo enddo
do la = nu + 1, nBas do la = nu + 1, nBas
lanu = (la * (la - 1)) / 2 + nu lanu = shiftr(la * (la - 1), 1) + nu
do si = 1, mu do si = 1, mu
musi = (mu * (mu - 1)) / 2 + si musi = shiftr(mu * (mu - 1), 1) + si
lanumusi = (lanu * (lanu - 1)) / 2 + musi lanumusi = shiftr(lanu * (lanu - 1), 1) + musi
K(mu,nu) = K(mu,nu) - P(si,la) * ERI_chem(lanumusi) K(mu,nu) = K(mu,nu) - P(si,la) * ERI_chem(lanumusi)
enddo enddo
do si = mu + 1, la - 1 do si = mu + 1, la - 1
simu = (si * (si - 1)) / 2 + mu simu = shiftr(si * (si - 1), 1) + mu
lanusimu = (lanu * (lanu - 1)) / 2 + simu lanusimu = shiftr(lanu * (lanu - 1), 1) + simu
K(mu,nu) = K(mu,nu) - P(si,la) * ERI_chem(lanusimu) K(mu,nu) = K(mu,nu) - P(si,la) * ERI_chem(lanusimu)
enddo enddo
enddo enddo
!TODO do la = 1, mu
! do la = 1, mu nula = shiftr(nu * (nu - 1), 1) + la
! nula = (nu * (nu - 1)) / 2 + la do si = la + 1, mu
! do si = la + 1, mu musi = shiftr(mu * (mu - 1) , 1) + si
! musi = (mu * (mu - 1)) / 2 + si nulamusi = shiftr(nula * (nula - 1), 1) + musi
! nulamusi = (nula * (nula - 1)) / 2 + musi K(mu,nu) = K(mu,nu) - P(si,la) * ERI_chem(nulamusi)
! !nulamusi = Yoshimine_4ind(nu, la, si, mu) enddo
! K(mu,nu) = K(mu,nu) - P(si,la) * ERI_chem(nulamusi) do si = mu + 1, nu - 1
! enddo simu = shiftr(si * (si - 1), 1) + mu
! do si = mu + 1, nBas nulasimu = shiftr(nula * (nula - 1), 1) + simu
! simu = (si * (si - 1)) / 2 + mu K(mu,nu) = K(mu,nu) - P(si,la) * ERI_chem(nulasimu)
! nulasimu = (nula * (nula - 1)) / 2 + simu enddo
! !nulasimu = Yoshimine_4ind(nu, la, si, mu) do si = nu, nBas
! K(mu,nu) = K(mu,nu) - P(si,la) * ERI_chem(nulasimu) simu = shiftr(si * (si - 1), 1) + mu
! enddo simunula = shiftr(simu * (simu - 1), 1) + nula
! enddo K(mu,nu) = K(mu,nu) - P(si,la) * ERI_chem(simunula)
! do la = mu + 1, nu enddo
! nula = (nu * (nu - 1)) / 2 + la enddo
! do si = la + 1, nu do la = mu + 1, nu
! simu = (si * (si - 1)) / 2 + mu nula = shiftr(nu * (nu - 1), 1) + la
! nulasimu = (nula * (nula - 1)) / 2 + simu do si = la + 1, nu
! !nulasimu = Yoshimine_4ind(nu, la, si, mu) simu = shiftr(si * (si - 1), 1) + mu
! K(mu,nu) = K(mu,nu) - P(si,la) * ERI_chem(nulasimu) nulasimu = shiftr(nula * (nula - 1), 1) + simu
! enddo K(mu,nu) = K(mu,nu) - P(si,la) * ERI_chem(nulasimu)
! do si = nu + 1, nBas enddo
! simu = (si * (si - 1)) / 2 + mu do si = nu + 1, nBas
! munulasi = Yoshimine_4ind(nu, la, si, mu) simu = shiftr(si * (si - 1), 1) + mu
! K(mu,nu) = K(mu,nu) - P(si,la) * ERI_chem(munulasi) simunula = shiftr(simu * (simu - 1), 1) + nula
! enddo K(mu,nu) = K(mu,nu) - P(si,la) * ERI_chem(simunula)
! enddo enddo
! do la = nu + 1, nBas enddo
! lanu = (la * (la - 1)) / 2 + nu do la = nu + 1, nBas
! do si = la + 1, mu lanu = shiftr(la * (la - 1), 1) + nu
! simu = (si * (si - 1)) / 2 + mu do si = la + 1, nBas
! munulasi = Yoshimine_4ind(nu, la, si, mu) simu = shiftr(si * (si - 1), 1) + mu
! K(mu,nu) = K(mu,nu) - P(si,la) * ERI_chem(munulasi) simulanu = shiftr(simu * (simu - 1), 1) + lanu
! enddo K(mu,nu) = K(mu,nu) - P(si,la) * ERI_chem(simulanu)
! do si = mu + 1, nBas enddo
! musi = (mu * (mu - 1)) / 2 + si enddo
! munulasi = Yoshimine_4ind(nu, la, si, mu)
! K(mu,nu) = K(mu,nu) - P(si,la) * ERI_chem(munulasi)
! enddo
! enddo
enddo ! mu enddo ! mu
enddo ! nu enddo ! nu

View File

@ -39,6 +39,7 @@ subroutine RHF_hpc(working_dir,dotest,maxSCF,thresh,max_diis,guess_type,level_sh
integer :: nBas_Sq integer :: nBas_Sq
integer :: n_diis integer :: n_diis
integer*8 :: ERI_size integer*8 :: ERI_size
double precision :: t1, t2
double precision :: diff, diff_loc double precision :: diff, diff_loc
double precision :: ET double precision :: ET
double precision :: EV double precision :: EV
@ -104,14 +105,42 @@ subroutine RHF_hpc(working_dir,dotest,maxSCF,thresh,max_diis,guess_type,level_sh
ERI_size = (ERI_size * (ERI_size + 1)) / 2 ERI_size = (ERI_size * (ERI_size + 1)) / 2
allocate(ERI_chem(ERI_size)) allocate(ERI_chem(ERI_size))
call read_2e_integrals_hpc(working_dir, ERI_size, ERI_chem) call read_2e_integrals_hpc(working_dir, ERI_size, ERI_chem)
call wall_time(t1)
do ii = 1, 5
call Hartree_matrix_AO_basis_hpc(nBas, ERI_size, P, ERI_chem, J) call Hartree_matrix_AO_basis_hpc(nBas, ERI_size, P, ERI_chem, J)
enddo
call wall_time(t2)
print*, " J built in (sec):", (t2-t1) / 5.d0
call wall_time(t1)
do ii = 1, 5
call exchange_matrix_AO_basis_hpc(nBas, ERI_size, P, ERI_chem, K)
enddo
call wall_time(t2)
print*, " K built in (sec):", (t2-t1) / 5.d0
allocate(ERI_phys(nBas,nBas,nBas,nBas)) allocate(ERI_phys(nBas,nBas,nBas,nBas))
allocate(J_deb(nBas,nBas)) allocate(J_deb(nBas,nBas))
allocate(K_deb(nBas,nBas)) allocate(K_deb(nBas,nBas))
call read_2e_integrals(working_dir, nBas, ERI_phys) call read_2e_integrals(working_dir, nBas, ERI_phys)
call wall_time(t1)
do ii = 1, 5
call Hartree_matrix_AO_basis(nBas, P, ERI_phys, J_deb) call Hartree_matrix_AO_basis(nBas, P, ERI_phys, J_deb)
enddo
call wall_time(t2)
print*, " J_deb built in (sec):", (t2-t1) / 5.d0
call wall_time(t1)
do ii = 1, 5
call exchange_matrix_AO_basis(nBas, P, ERI_phys, K_deb)
enddo
call wall_time(t2)
print*, " K_deb built in (sec):", (t2-t1) / 5.d0
print*, "max error on J = ", maxval(dabs(J - J_deb)) print*, "max error on J = ", maxval(dabs(J - J_deb))
diff = 0.d0 diff = 0.d0
do ii = 1, nBas do ii = 1, nBas
@ -127,8 +156,6 @@ subroutine RHF_hpc(working_dir,dotest,maxSCF,thresh,max_diis,guess_type,level_sh
enddo enddo
print*, 'total diff on J = ', diff print*, 'total diff on J = ', diff
call exchange_matrix_AO_basis_hpc(nBas, ERI_size, P, ERI_chem, K)
call exchange_matrix_AO_basis(nBas, P, ERI_phys, K_deb)
print*, "max error on K = ", maxval(dabs(K - K_deb)) print*, "max error on K = ", maxval(dabs(K - K_deb))
diff = 0.d0 diff = 0.d0
do ii = 1, nBas do ii = 1, nBas

View File

@ -929,9 +929,11 @@ integer*8 function Yoshimine_2ind(a, b)
integer*8, intent(in) :: a, b integer*8, intent(in) :: a, b
if(a > b) then if(a > b) then
Yoshimine_2ind = (a * (a - 1)) / 2 + b !Yoshimine_2ind = (a * (a - 1)) / 2 + b
Yoshimine_2ind = shiftr(a * (a - 1), 1) + b
else else
Yoshimine_2ind = (b * (b - 1)) / 2 + a !Yoshimine_2ind = (b * (b - 1)) / 2 + a
Yoshimine_2ind = shiftr(b * (b - 1), 1) + a
endif endif
return return