9
1
mirror of https://github.com/QuantumPackage/qp2.git synced 2024-12-09 13:13:29 +01:00
qp2/src/tc_bi_ortho/tc_utils.irp.f

62 lines
1.4 KiB
Fortran
Raw Normal View History

2023-04-05 15:59:38 +02:00
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_slow(psi_det(1,1,i), psi_det(1,1,j), N_int, hmono, htwoe, hthree, htot)
2023-04-05 15:59:38 +02:00
E_TC = E_TC + psi_l_coef_bi_ortho(i,k) * psi_r_coef_bi_ortho(j,k) * htot
2023-04-13 13:03:10 +02:00
!E_TC = E_TC + leigvec_tc_bi_orth(i,k) * reigvec_tc_bi_orth(j,k) * htot
2023-04-05 15:59:38 +02:00
enddo
enddo
O_TC = 0.d0
do i = 1, N_det
2023-04-13 13:03:10 +02:00
!O_TC = O_TC + leigvec_tc_bi_orth(i,k) * reigvec_tc_bi_orth(i,k)
2023-04-05 15:59:38 +02:00
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
2023-05-01 09:15:58 +02:00
! ---
subroutine write_tc_var()
implicit none
integer :: i, j, k
2023-06-02 20:19:25 +02:00
double precision :: hmono, htwoe, hthree, htot_1j, htot_j1
2023-05-01 09:15:58 +02:00
double precision :: SIGMA_TC
do k = 1, n_states
SIGMA_TC = 0.d0
do j = 2, N_det
2023-06-02 20:55:51 +02:00
call htilde_mu_mat_bi_ortho_slow(psi_det(1,1,1), psi_det(1,1,j), N_int, hmono, htwoe, hthree, htot_1j)
call htilde_mu_mat_bi_ortho_slow(psi_det(1,1,j), psi_det(1,1,1), N_int, hmono, htwoe, hthree, htot_j1)
2023-06-02 20:19:25 +02:00
SIGMA_TC = SIGMA_TC + htot_1j * htot_j1
2023-05-01 09:15:58 +02:00
enddo
print *, " state : ", k
print *, " SIGMA_TC = ", SIGMA_TC
enddo
end
! ---