10
0
mirror of https://github.com/QuantumPackage/qp2.git synced 2024-12-23 12:55:37 +01:00
QuantumPackage/plugins/local/tc_bi_ortho/diagonalize_tc_h.irp.f

123 lines
3.2 KiB
Fortran
Raw Normal View History

2023-02-07 17:07:49 +01:00
program tc_bi_ortho
2023-04-03 14:55:02 +02:00
2023-02-07 17:07:49 +01:00
BEGIN_DOC
2023-04-03 14:55:02 +02:00
!
! TODO : Reads psi_det in the EZFIO folder and prints out the left- and right-eigenvectors together
! with the energy. Saves the left-right wave functions at the end.
!
2023-02-07 17:07:49 +01:00
END_DOC
2023-04-03 14:55:02 +02:00
2024-03-01 13:37:46 +01:00
implicit none
PROVIDE N_int
2023-02-07 17:07:49 +01:00
my_grid_becke = .True.
2023-07-02 21:49:25 +02:00
PROVIDE tc_grid1_a tc_grid1_r
my_n_pt_r_grid = tc_grid1_r
my_n_pt_a_grid = tc_grid1_a
touch my_grid_becke my_n_pt_r_grid my_n_pt_a_grid
2024-01-15 12:02:38 +01:00
if(tc_integ_type .eq. "numeric") then
2023-09-22 16:26:58 +02:00
my_extra_grid_becke = .True.
PROVIDE tc_grid2_a tc_grid2_r
my_n_pt_r_extra_grid = tc_grid2_r
my_n_pt_a_extra_grid = tc_grid2_a
touch my_extra_grid_becke my_n_pt_r_extra_grid my_n_pt_a_extra_grid
call write_int(6, my_n_pt_r_extra_grid, 'radial internal grid over')
call write_int(6, my_n_pt_a_extra_grid, 'angular internal grid over')
endif
2023-02-07 17:07:49 +01:00
read_wf = .True.
touch read_wf
2023-03-28 12:02:28 +02:00
print*, ' nb of states = ', N_states
print*, ' nb of det = ', N_det
call routine_diag()
! call write_tc_energy()
! call save_tc_bi_ortho_wavefunction()
2023-07-02 21:49:25 +02:00
2023-02-07 17:07:49 +01:00
end
2023-07-02 21:49:25 +02:00
! ---
subroutine test()
use bitmasks
implicit none
integer :: i, j
double precision :: hmono, htwoe, hthree, htot
print*, 'reading the wave function '
do i = 1, N_det
call debug_det(psi_det(1,1,i), N_int)
print*, i, psi_l_coef_bi_ortho(i,1)*psi_r_coef_bi_ortho(i,1)
print*, i, psi_l_coef_bi_ortho(i,1),psi_r_coef_bi_ortho(i,1)
enddo
2023-02-07 17:07:49 +01:00
end
2023-07-02 21:49:25 +02:00
! ---
2023-03-28 12:02:28 +02:00
subroutine routine_diag()
implicit none
2023-04-13 13:03:10 +02:00
integer :: i, j, k
2023-03-28 12:02:28 +02:00
double precision :: dE
! provide eigval_right_tc_bi_orth
! provide overlap_bi_ortho
! provide htilde_matrix_elmt_bi_ortho
2024-03-01 13:37:46 +01:00
if(noL_standard) then
PROVIDE noL_0e
PROVIDE noL_1e
PROVIDE noL_2e
endif
2023-03-28 12:02:28 +02:00
if(N_states .eq. 1) then
2023-05-01 14:00:04 +02:00
print*,'eigval_right_tc_bi_orth = ',eigval_right_tc_bi_orth(1)
! print*,'e_tc_left_right = ',e_tc_left_right
! print*,'e_tilde_bi_orth_00 = ',e_tilde_bi_orth_00
! print*,'e_pt2_tc_bi_orth = ',e_pt2_tc_bi_orth
! print*,'e_pt2_tc_bi_orth_single = ',e_pt2_tc_bi_orth_single
! print*,'e_pt2_tc_bi_orth_double = ',e_pt2_tc_bi_orth_double
! print*,'***'
! print*,'e_corr_bi_orth = ',e_corr_bi_orth
! print*,'e_corr_bi_orth_proj = ',e_corr_bi_orth_proj
! print*,'e_corr_bi_orth_proj_abs = ',e_corr_bi_orth_proj_abs
! print*,'e_corr_single_bi_orth = ',e_corr_single_bi_orth
! print*,'e_corr_double_bi_orth = ',e_corr_double_bi_orth
! print*,'e_corr_single_bi_orth_abs = ',e_corr_single_bi_orth_abs
! print*,'e_corr_double_bi_orth_abs = ',e_corr_double_bi_orth_abs
2023-03-28 12:02:28 +02:00
print*,'Left/right eigenvectors'
do i = 1,N_det
write(*,'(I6,X,(100(F12.7,X)))')i,leigvec_tc_bi_orth(i,1),reigvec_tc_bi_orth(i,1),leigvec_tc_bi_orth(i,1)*reigvec_tc_bi_orth(i,1)
2023-03-28 12:02:28 +02:00
enddo
else
print*,'eigval_right_tc_bi_orth : '
do i = 1, N_states
print*, i, eigval_right_tc_bi_orth(i)
enddo
print*,''
print*,'******************************************************'
2023-04-01 22:05:34 +02:00
print*,'TC Excitation energies (au) (eV)'
2023-03-28 12:02:28 +02:00
do i = 2, N_states
dE = eigval_right_tc_bi_orth(i) - eigval_right_tc_bi_orth(1)
print*, i, dE, dE/0.0367502d0
enddo
print*,''
endif
2023-02-07 17:07:49 +01:00
end
2023-03-28 12:02:28 +02:00