mirror of
https://github.com/QuantumPackage/qp2.git
synced 2024-12-23 04:43:45 +01:00
print tc energy: OK
This commit is contained in:
parent
ad893e4df4
commit
5aed62450e
@ -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
|
||||
|
||||
|
@ -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
32
src/tc_bi_ortho/tc_utils.irp.f
Normal 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
|
||||
|
Loading…
Reference in New Issue
Block a user