LCPQ/qp2
9
1
Fork 0
mirror of https://github.com/QuantumPackage/qp2.git synced 2025-01-03 09:05:39 +01:00
Code Releases Activity

working on TC Slater matrix elements

Browse Source
This commit is contained in:
eginer 2023-01-20 11:31:28 +01:00
parent 7a144bc1a2
commit 721e0963b9
1 changed files with 8 additions and 9 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

17
src/tc_bi_ortho/test_tc_bi_ortho.irp.f
View File

@ -40,22 +40,21 @@ subroutine test_slater_tc_opt
if(i==j)cycle
integer :: degree
call get_excitation_degree(psi_det(1,1,j), psi_det(1,1,i),degree,N_int)
if(degree .ne. 1)cycle
! if(degree .ne. 1)cycle
call htilde_mu_mat_bi_ortho(psi_det(1,1,j), psi_det(1,1,i), N_int, hmono, htwoe, hthree, htot)
call single_htilde_mu_mat_fock_bi_ortho (N_int, psi_det(1,1,j), psi_det(1,1,i), hnewmono, hnewtwoe, hnewthree, hnewtot)
! print*,'j,i',j,i
! print*,htot,hnewtot,dabs(htot-hnewtot)
! print*,hthree,hnewthree,dabs(hthree-hnewthree)
if(dabs(hthree).gt.1.d-15)then
call htilde_mu_mat_opt_bi_ortho(psi_det(1,1,j), psi_det(1,1,i), N_int, hnewmono, hnewtwoe, hnewthree, hnewtot)
! if(dabs(hthree).gt.1.d-15)then
if(dabs(htot).gt.1.d-15)then
! if(dabs(htot-hnewtot).gt.1.d-8.or.dabs(htot-hnewtot).gt.dabs(htot))then
i_count += 1.D0
accu += dabs(htot-hnewtot)
if(dabs(hthree-hnewthree).gt.1.d-8.or.dabs(hthree-hnewthree).gt.dabs(hthree))then
! if(dabs(hthree-hnewthree).gt.1.d-8.or.dabs(hthree-hnewthree).gt.dabs(hthree))then
if(dabs(htot-hnewtot).gt.1.d-8.or.dabs(htot-hnewtot).gt.dabs(htot))then
print*,j,i
call debug_det(psi_det(1,1,i),N_int)
call debug_det(psi_det(1,1,j),N_int)
! print*,htot,hnewtot,dabs(htot-hnewtot)
print*,hthree,hnewthree,dabs(hthree-hnewthree)
print*,htot,hnewtot,dabs(htot-hnewtot)
! print*,hthree,hnewthree,dabs(hthree-hnewthree)
stop
endif
endif