LCPQ/qp2
9
1
Fork 0
mirror of https://github.com/QuantumPackage/qp2.git synced 2024-12-21 11:03:29 +01:00
Code Releases Activity

print tc energy: OK

Browse Source
This commit is contained in:
AbdAmmar 2023-04-05 15:59:38 +02:00
parent ad893e4df4
commit 5aed62450e
3 changed files with 32 additions and 65 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

32
src/tc_bi_ortho/print_tc_energy.irp.f
View File

@ -13,35 +13,3 @@ program print_tc_energy
call write_tc_energy
end
subroutine write_tc_energy()
implicit none
integer :: i, j, k
double precision :: hmono, htwoe, htot
double precision :: E_TC, O_TC
do k = 1, n_states
E_TC = 0.d0
do i = 1, N_det
do j = 1, N_det
call hmat_bi_ortho(psi_det(1,1,i), psi_det(1,1,j), N_int, hmono, htwoe, htot)
E_TC = E_TC + psi_l_coef_bi_ortho(i,k) * psi_r_coef_bi_ortho(j,k) * htot
!E_TC = E_TC + leigvec_tc_bi_orth(i,k) * reigvec_tc_bi_orth(j,k) * htot
enddo
enddo
O_TC = 0.d0
do i = 1, N_det
O_TC = O_TC + psi_l_coef_bi_ortho(i,k) * psi_r_coef_bi_ortho(i,k)
!O_TC = O_TC + leigvec_tc_bi_orth(i,k) * reigvec_tc_bi_orth(i,k)
enddo
print *, ' state :', k
print *, " E_TC = ", E_TC
print *, " O_TC = ", O_TC
enddo
end

33
src/tc_bi_ortho/tc_bi_ortho.irp.f
View File

@ -89,36 +89,3 @@ end
subroutine write_tc_energy()
implicit none
integer :: i, j, k
double precision :: hmono, htwoe, htot
double precision :: E_TC, O_TC
do k = 1, n_states
E_TC = 0.d0
do i = 1, N_det
do j = 1, N_det
htot = htilde_matrix_elmt_bi_ortho(j,i)
!call hmat_bi_ortho(psi_det(1,1,i), psi_det(1,1,j), N_int, hmono, htwoe, htot)
E_TC = E_TC + psi_l_coef_bi_ortho(i,k) * psi_r_coef_bi_ortho(j,k) * htot
!E_TC = E_TC + leigvec_tc_bi_orth(i,k) * reigvec_tc_bi_orth(j,k) * htot
enddo
enddo
O_TC = 0.d0
do i = 1, N_det
O_TC = O_TC + psi_l_coef_bi_ortho(i,k) * psi_r_coef_bi_ortho(i,k)
!O_TC = O_TC + leigvec_tc_bi_orth(i,k) * reigvec_tc_bi_orth(i,k)
enddo
print *, ' state :', k
print *, " E_TC = ", E_TC
print *, " O_TC = ", O_TC
enddo
end

32
src/tc_bi_ortho/tc_utils.irp.f Normal file
View File

@ -0,0 +1,32 @@
subroutine write_tc_energy()
implicit none
integer :: i, j, k
double precision :: hmono, htwoe, hthree, htot
double precision :: E_TC, O_TC
do k = 1, n_states
E_TC = 0.d0
do i = 1, N_det
do j = 1, N_det
!htot = htilde_matrix_elmt_bi_ortho(i,j)
call htilde_mu_mat_bi_ortho(psi_det(1,1,i), psi_det(1,1,j), N_int, hmono, htwoe, hthree, htot)
E_TC = E_TC + psi_l_coef_bi_ortho(i,k) * psi_r_coef_bi_ortho(j,k) * htot
enddo
enddo
O_TC = 0.d0
do i = 1, N_det
O_TC = O_TC + psi_l_coef_bi_ortho(i,k) * psi_r_coef_bi_ortho(i,k)
enddo
print *, ' state :', k
print *, " E_TC = ", E_TC / O_TC
print *, " O_TC = ", O_TC
enddo
end