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

few modif for excisted states

Browse Source
This commit is contained in:
Abdallah Ammar 2023-03-28 12:02:28 +02:00
parent 6370d7fce5
commit db7384c18e
2 changed files with 103 additions and 53 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

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

@ -10,8 +10,12 @@ program tc_bi_ortho
read_wf = .True.
touch read_wf
touch my_grid_becke my_n_pt_r_grid my_n_pt_a_grid
call routine_diag
call save_tc_bi_ortho_wavefunction
print*, ' nb of states = ', N_states
print*, ' nb of det = ', N_det
call routine_diag()
call save_tc_bi_ortho_wavefunction()
end
subroutine test
@ -28,12 +32,18 @@ subroutine test
end
subroutine routine_diag
subroutine routine_diag()
implicit none
integer :: i, j
double precision :: dE
! provide eigval_right_tc_bi_orth
! provide overlap_bi_ortho
! provide htilde_matrix_elmt_bi_ortho
integer ::i,j
if(N_states .eq. 1) then
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
@ -49,5 +59,26 @@ subroutine routine_diag
do i = 1,N_det
write(*,'(I5,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)
enddo
else
print*,'eigval_right_tc_bi_orth : '
do i = 1, N_states
print*, i, eigval_right_tc_bi_orth(i)
enddo
print*,''
print*,'******************************************************'
print*,'Excitation energies (au) (eV)'
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
end

31
src/tc_bi_ortho/tc_h_eigvectors.irp.f
View File

@ -47,17 +47,19 @@ end
integer :: i, idx_dress, j, istate
logical :: converged, dagger
integer :: n_real_tc_bi_orth_eigval_right,igood_r,igood_l
integer, allocatable :: iorder(:)
double precision, allocatable :: reigvec_tc_bi_orth_tmp(:,:), leigvec_tc_bi_orth_tmp(:,:), eigval_right_tmp(:)
double precision, allocatable :: coef_hf_r(:),coef_hf_l(:), Stmp(:,:)
PROVIDE N_det N_int
if(n_det .le. N_det_max_full) then
allocate(reigvec_tc_bi_orth_tmp(N_det,N_det), leigvec_tc_bi_orth_tmp(N_det,N_det), eigval_right_tmp(N_det))
call non_hrmt_real_diag(N_det,htilde_matrix_elmt_bi_ortho,&
leigvec_tc_bi_orth_tmp,reigvec_tc_bi_orth_tmp,&
n_real_tc_bi_orth_eigval_right,eigval_right_tmp)
double precision, allocatable :: coef_hf_r(:),coef_hf_l(:)
integer, allocatable :: iorder(:)
call non_hrmt_real_diag( N_det, htilde_matrix_elmt_bi_ortho &
, leigvec_tc_bi_orth_tmp, reigvec_tc_bi_orth_tmp, n_real_tc_bi_orth_eigval_right, eigval_right_tmp)
allocate(coef_hf_r(N_det), coef_hf_l(N_det), iorder(N_det))
do i = 1, N_det
iorder(i) = i
@ -83,21 +85,24 @@ end
print *,'State with largest LEFT coefficient of HF ',igood_l
print *,'coef of HF in LEFT eigenvector = ',leigvec_tc_bi_orth_tmp(index_HF_psi_det,igood_l)
endif
if(state_following_tc) then
print *,'Following the states with the largest coef on HF'
print *,'igood_r,igood_l',igood_r,igood_l
i= igood_r
eigval_right_tc_bi_orth(1) = eigval_right_tmp(i)
do j = 1, N_det
reigvec_tc_bi_orth(j,1) = reigvec_tc_bi_orth_tmp(j,i)
! print*,reigvec_tc_bi_orth(j,1)
enddo
i= igood_l
eigval_left_tc_bi_orth(1) = eigval_right_tmp(i)
do j = 1, N_det
leigvec_tc_bi_orth(j,1) = leigvec_tc_bi_orth_tmp(j,i)
enddo
else
do i = 1, N_states
eigval_right_tc_bi_orth(i) = eigval_right_tmp(i)
eigval_left_tc_bi_orth(i) = eigval_right_tmp(i)
@ -106,8 +111,22 @@ end
leigvec_tc_bi_orth(j,i) = leigvec_tc_bi_orth_tmp(j,i)
enddo
enddo
! check bi-orthogonality
allocate(Stmp(N_states,N_states))
call dgemm( 'T', 'N', N_states, N_states, N_det, 1.d0 &
, leigvec_tc_bi_orth(1,1), size(leigvec_tc_bi_orth, 1), reigvec_tc_bi_orth(1,1), size(reigvec_tc_bi_orth, 1) &
, 0.d0, Stmp, size(Stmp, 1) )
print *, ' overlap matrix between states:'
do i = 1, N_states
write(*,'(1000(F16.10,X))') Stmp(i,:)
enddo
deallocate(Stmp)
endif
else
double precision, allocatable :: H_jj(:),vec_tmp(:,:)
external htc_bi_ortho_calc_tdav
external htcdag_bi_ortho_calc_tdav