PTEROSOR/QuantumPackage
10
0
Fork 0
mirror of https://github.com/QuantumPackage/qp2.git synced 2024-11-14 01:53:49 +01:00
Code Releases Activity

fixed the bug of misalignement between coefs and determinants in fci_tc_bi_ortho

Browse Source
This commit is contained in:
eginer 2023-03-16 14:00:21 +01:00
parent d1068047e8
commit 22fb8c17e2
12 changed files with 124 additions and 165 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

1
src/cipsi_tc_bi_ortho/pt2_stoch_routines.irp.f
View File

@ -134,7 +134,6 @@ subroutine ZMQ_pt2(E, pt2_data, pt2_data_err, relative_error, N_in)
PROVIDE psi_det_hii selection_weight pseudo_sym
PROVIDE n_act_orb n_inact_orb n_core_orb n_virt_orb n_del_orb seniority_max
PROVIDE excitation_beta_max excitation_alpha_max excitation_max
PROVIDE psi_selectors_rcoef_bi_orth_transp psi_selectors_lcoef_bi_orth_transp
if (h0_type == 'CFG') then
PROVIDE psi_configuration_hii det_to_configuration

29
src/cipsi_tc_bi_ortho/selection.irp.f
View File

@ -181,7 +181,6 @@ subroutine select_singles_and_doubles(i_generator, hole_mask,particle_mask, fock
PROVIDE psi_bilinear_matrix_rows psi_det_sorted_tc_order psi_bilinear_matrix_order
PROVIDE psi_bilinear_matrix_transp_rows_loc psi_bilinear_matrix_transp_columns
PROVIDE psi_bilinear_matrix_transp_order psi_selectors_coef_transp_tc
PROVIDE psi_selectors_rcoef_bi_orth_transp psi_selectors_lcoef_bi_orth_transp
PROVIDE banned_excitation
@ -616,7 +615,6 @@ subroutine splash_pq(mask, sp, det, i_gen, N_sel, bannedOrb, banned, mat, intere
PROVIDE psi_selectors_coef_transp_tc psi_det_sorted_tc
PROVIDE psi_selectors_rcoef_bi_orth_transp psi_selectors_lcoef_bi_orth_transp
mat = 0d0
@ -628,7 +626,7 @@ subroutine splash_pq(mask, sp, det, i_gen, N_sel, bannedOrb, banned, mat, intere
negMask(i,2) = not(mask(i,2))
end do
print*,'in selection '
! print*,'in selection '
do i = 1, N_sel
! call debug_det(det(1,1,i),N_int)
! print*,i,dabs(psi_selectors_coef_transp_tc(1,2,i) * psi_selectors_coef_transp_tc(1,1,i))
@ -677,9 +675,6 @@ subroutine splash_pq(mask, sp, det, i_gen, N_sel, bannedOrb, banned, mat, intere
perMask(j,1) = iand(mask(j,1), not(det(j,1,i)))
perMask(j,2) = iand(mask(j,2), not(det(j,2,i)))
end do
! call get_d3_h ( det(1,1,i), bannedOrb, banned, mat , mask, p, sp, psi_selectors_coef_transp_tc (1, interesting(i)) )
! call get_d3_htc( det(1,1,i), bannedOrb, banned, mat_r, mat_l, mask, p, sp, psi_selectors_rcoef_bi_orth_transp(1, interesting(i)) &
! , psi_selectors_lcoef_bi_orth_transp(1, interesting(i)) )
call bitstring_to_list_in_selection(perMask(1,1), h(1,1), h(0,1), N_int)
call bitstring_to_list_in_selection(perMask(1,2), h(1,2), h(0,2), N_int)
@ -921,15 +916,26 @@ subroutine fill_buffer_double(i_generator, sp, h1, h2, bannedOrb, banned, fock_d
endif
val = 4.d0 * psi_h_alpha * alpha_h_psi
tmp = dsqrt(delta_E * delta_E + val)
if (delta_E < 0.d0) then
tmp = -tmp
endif
e_pert(istate) = 0.5d0 * (tmp - delta_E)
! if (delta_E < 0.d0) then
! tmp = -tmp
! endif
e_pert(istate) = 0.25 * val / delta_E
! e_pert(istate) = 0.5d0 * (tmp - delta_E)
if(dsqrt(dabs(tmp)).gt.1.d-4.and.dabs(alpha_h_psi).gt.1.d-4)then
coef(istate) = e_pert(istate) / alpha_h_psi
coef(istate) = e_pert(istate) / psi_h_alpha
else
coef(istate) = alpha_h_psi / delta_E
endif
if(selection_tc == 1)then
if(e_pert(istate).lt.0.d0)then
e_pert(istate)=0.d0
else
e_pert(istate)=-e_pert(istate)
endif
else if(selection_tc == -1)then
if(e_pert(istate).gt.0.d0)e_pert(istate)=0.d0
endif
! if(selection_tc == 1 )then
! if(e_pert(istate).lt.0.d0)then
@ -943,7 +949,6 @@ subroutine fill_buffer_double(i_generator, sp, h1, h2, bannedOrb, banned, fock_d
enddo
do_diag = sum(dabs(coef)) > 0.001d0 .and. N_states > 1
do istate = 1, N_states

12
src/cipsi_tc_bi_ortho/selection_buffer.irp.f
View File

@ -125,7 +125,11 @@ subroutine merge_selection_buffers(b1, b2)
enddo
b2%det => detmp
b2%val => val
b2%mini = min(b2%mini,b2%val(b2%N))
! if(selection_tc == 1)then
! b2%mini = max(b2%mini,b2%val(b2%N))
! else
b2%mini = min(b2%mini,b2%val(b2%N))
! endif
b2%cur = nmwen
end
@ -157,7 +161,11 @@ subroutine sort_selection_buffer(b)
end do
deallocate(b%det,iorder)
b%det => detmp
b%mini = min(b%mini,b%val(b%N))
! if(selection_tc == 1)then
! b%mini = max(b%mini,b%val(b%N))
! else
b%mini = min(b%mini,b%val(b%N))
! endif
b%cur = nmwen
end subroutine

2
src/cipsi_tc_bi_ortho/slave_cipsi.irp.f
View File

@ -17,7 +17,6 @@ end
subroutine provide_everything
PROVIDE H_apply_buffer_allocated mo_two_e_integrals_in_map psi_det_generators psi_coef_generators psi_det_sorted_bit psi_selectors n_det_generators n_states generators_bitmask zmq_context N_states_diag
PROVIDE psi_selectors_rcoef_bi_orth_transp psi_selectors_lcoef_bi_orth_transp
PROVIDE pt2_e0_denominator mo_num N_int ci_energy mpi_master zmq_state zmq_context
PROVIDE psi_det psi_coef threshold_generators state_average_weight
@ -312,7 +311,6 @@ subroutine run_slave_main
PROVIDE psi_bilinear_matrix_rows psi_det_sorted_tc_order psi_bilinear_matrix_order
PROVIDE psi_bilinear_matrix_transp_rows_loc psi_bilinear_matrix_transp_columns
PROVIDE psi_bilinear_matrix_transp_order psi_selectors_coef_transp psi_det_sorted_tc
PROVIDE psi_selectors_rcoef_bi_orth_transp psi_selectors_lcoef_bi_orth_transp
PROVIDE psi_det_hii selection_weight pseudo_sym pt2_min_parallel_tasks

1
src/cipsi_tc_bi_ortho/stochastic_cipsi.irp.f
View File

@ -108,6 +108,7 @@ subroutine run_stochastic_cipsi
ept2(N_iter-1) = E_tc + nuclear_repulsion + (pt2_data % pt2(1))/norm
pt1(N_iter-1) = dsqrt(pt2_data % overlap(1,1))
call diagonalize_CI_tc_bi_ortho(ndet, E_tc,norm,pt2_data,print_pt2)
! stop
if (qp_stop()) exit
enddo
! print*,'data to extrapolate '

8
src/fci_tc_bi/generators.irp.f
View File

@ -31,14 +31,6 @@ END_PROVIDER
END_DOC
psi_det_generators(1:N_int,1:2,1:N_det) = psi_det_sorted_tc(1:N_int,1:2,1:N_det)
psi_coef_generators(1:N_det,1:N_states) = psi_coef_sorted_tc(1:N_det,1:N_states)
integer :: i
! print*,'generators '
do i = 1, N_det
if(N_det.ne.1)then
print*,'writing generators'
write(33,*) psi_det_generators(1,1,i), psi_det_generators(1,2,i)
endif
enddo
END_PROVIDER

47
src/fci_tc_bi/selectors.irp.f
View File

@ -18,15 +18,6 @@ BEGIN_PROVIDER [ integer, N_det_selectors]
double precision :: norm, norm_max
call write_time(6)
N_det_selectors = N_det
! norm = 1.d0
! do i=1,N_det
! norm = norm - psi_average_norm_contrib_tc(i)
! if (norm - 1.d-10 < 1.d0 - threshold_selectors) then
! N_det_selectors = i
! exit
! endif
! enddo
N_det_selectors = max(N_det_selectors,N_det_generators)
call write_int(6,N_det_selectors,'Number of selectors')
END_PROVIDER
@ -43,27 +34,13 @@ END_PROVIDER
do k=1,N_int
psi_selectors(k,1,i) = psi_det_sorted_tc(k,1,i)
psi_selectors(k,2,i) = psi_det_sorted_tc(k,2,i)
! psi_selectors(k,2,i) = psi_det(k,2,i)
! psi_selectors(k,2,i) = psi_det(k,2,i)
enddo
enddo
print*,'selectors '
do k=1,N_states
do i=1,N_det_selectors
psi_selectors_coef(i,k) = psi_coef_sorted_tc_gen(i,k)
! psi_selectors_coef_tc(i,1,k) = psi_l_coef_bi_ortho(i,k)
! psi_selectors_coef_tc(i,2,k) = psi_r_coef_bi_ortho(i,k)
psi_selectors_coef(i,k) = psi_coef_sorted_tc_gen(i,k)
psi_selectors_coef_tc(i,1,k) = psi_l_coef_sorted_bi_ortho(i,k)
psi_selectors_coef_tc(i,2,k) = psi_r_coef_sorted_bi_ortho(i,k)
! call debug_det(psi_selectors(1,1,i),N_int)
if(N_det.ne.1)then
print*,'writing selectors'
write(34,*)psi_selectors(1,1,i),psi_selectors(1,2,i)
write(40,'(F10.7)')dabs(psi_selectors_coef_tc(i,1,1) * psi_selectors_coef_tc(i,2,1))
endif
! psi_selectors_coef_tc(i,1,k) = 1.d0
! psi_selectors_coef_tc(i,2,k) = 1.d0
enddo
enddo
@ -83,31 +60,9 @@ END_PROVIDER
psi_selectors_coef_transp_tc(k,1,i) = psi_selectors_coef_tc(i,1,k)
psi_selectors_coef_transp_tc(k,2,i) = psi_selectors_coef_tc(i,2,k)
enddo
if(N_det.ne.1)then
write(41,'(F10.7)')dabs(psi_selectors_coef_transp_tc(1,1,i)*psi_selectors_coef_transp_tc(1,2,i))
endif
enddo
END_PROVIDER
BEGIN_PROVIDER [ double precision, psi_selectors_rcoef_bi_orth_transp, (N_states, psi_det_size) ]
&BEGIN_PROVIDER [ double precision, psi_selectors_lcoef_bi_orth_transp, (N_states, psi_det_size) ]
implicit none
integer :: i, k
psi_selectors_rcoef_bi_orth_transp = 0.d0
psi_selectors_lcoef_bi_orth_transp = 0.d0
print*,'N_det,N_det_selectors',N_det,N_det_selectors
do i = 1, N_det_selectors
do k = 1, N_states
psi_selectors_rcoef_bi_orth_transp(k,i) = psi_r_coef_sorted_bi_ortho(i,k)
psi_selectors_lcoef_bi_orth_transp(k,i) = psi_l_coef_sorted_bi_ortho(i,k)
enddo
enddo
END_PROVIDER
BEGIN_PROVIDER [ integer, psi_selectors_size ]
implicit none
psi_selectors_size = psi_det_size

104
src/tc_bi_ortho/psi_det_tc_sorted.irp.f
View File

@ -11,7 +11,7 @@ BEGIN_PROVIDER [ double precision, psi_average_norm_contrib_tc, (psi_det_size) ]
psi_average_norm_contrib_tc(:) = 0.d0
do k=1,N_states
do i=1,N_det
psi_average_norm_contrib_tc(i) = psi_average_norm_contrib_tc(i) + &
psi_average_norm_contrib_tc(i) = &
dabs(psi_l_coef_bi_ortho(i,k)*psi_r_coef_bi_ortho(i,k))*state_average_weight(k)
enddo
enddo
@ -26,39 +26,54 @@ END_PROVIDER
&BEGIN_PROVIDER [ double precision, psi_coef_sorted_tc, (psi_det_size,N_states) ]
&BEGIN_PROVIDER [ double precision, psi_average_norm_contrib_sorted_tc, (psi_det_size) ]
&BEGIN_PROVIDER [ integer, psi_det_sorted_tc_order, (psi_det_size) ]
&BEGIN_PROVIDER [double precision, psi_r_coef_sorted_bi_ortho, (psi_det_size, N_states)]
&BEGIN_PROVIDER [double precision, psi_l_coef_sorted_bi_ortho, (psi_det_size, N_states)]
implicit none
BEGIN_DOC
! Wave function sorted by determinants contribution to the norm (state-averaged)
!
! psi_det_sorted_tc_order(i) -> k : index in psi_det
!
! psi_r_coef_sorted_bi_ortho : right coefficients corresponding to psi_det_sorted_tc
!
! psi_l_coef_sorted_bi_ortho : left coefficients corresponding to psi_det_sorted_tc
END_DOC
integer :: i,j,k
integer, allocatable :: iorder(:)
print *, 'providing psi_det_sorted_tc'
allocate ( iorder(N_det) )
print*,'before '
! print*,'before = '
do i=1,N_det
psi_average_norm_contrib_sorted_tc(i) = -psi_average_norm_contrib_tc(i)
iorder(i) = i
print*,i,iorder(i),psi_average_norm_contrib_sorted_tc(i)
psi_average_norm_contrib_sorted_tc(i) = -psi_average_norm_contrib_tc(i)
! print*,'------------'
! call debug_det(psi_det(1,1,i),N_int)
! print*,i,psi_average_norm_contrib_tc(i)
! print*,i,psi_l_coef_bi_ortho(iorder(i),1:N_states),psi_r_coef_bi_ortho(iorder(i),1:N_states)
! print*,'------------'
enddo
call dsort(psi_average_norm_contrib_sorted_tc,iorder,N_det)
print*,'after '
! print*,'after = '
do i=1,N_det
! iorder(i) = i
print*,i,iorder(i),psi_average_norm_contrib_sorted_tc(i)
psi_average_norm_contrib_sorted_tc(i) = -psi_average_norm_contrib_sorted_tc(i)
do j=1,N_int
psi_det_sorted_tc(j,1,i) = psi_det(j,1,iorder(i))
psi_det_sorted_tc(j,2,i) = psi_det(j,2,iorder(i))
enddo
psi_average_norm_contrib_sorted_tc(i) = -psi_average_norm_contrib_sorted_tc(i)
psi_det_sorted_tc_order(iorder(i)) = i
psi_det_sorted_tc_order(iorder(i)) = i
! if(iorder(i).ne.i)then
! print*,'changed the order for ',i,iorder(i)
! endif
! print*,'------------'
! call debug_det(psi_det_sorted_tc(1,1,i),N_int)
! print*,i,psi_average_norm_contrib_tc(i)
! print*,i,psi_l_coef_bi_ortho(iorder(i),1:N_states),psi_r_coef_bi_ortho(iorder(i),1:N_states)
! print*,'------------'
enddo
double precision :: accu
do k=1,N_states
accu = 0.d0
do i=1,N_det
psi_coef_sorted_tc(i,k) = dsqrt(dabs(psi_l_coef_bi_ortho(iorder(i),k)*psi_r_coef_bi_ortho(iorder(i),k)))
psi_coef_sorted_tc(i,k) = dsqrt(psi_average_norm_contrib_sorted_tc(i))
accu += psi_coef_sorted_tc(i,k)**2
enddo
accu = 1.d0/dsqrt(accu)
@ -72,60 +87,33 @@ END_PROVIDER
psi_average_norm_contrib_sorted_tc(N_det+1:psi_det_size) = 0.d0
psi_det_sorted_tc_order(N_det+1:psi_det_size) = 0
deallocate(iorder)
logical :: pouet
pouet = .true.
do i = 1, N_det
if(psi_average_norm_contrib_sorted_tc(i) == 0.d0)then
pouet = .False.
exit
endif
enddo
if(pouet.and.N_det.ne.1)then
print*,'writing sorted'
do i = 1, N_det
! call debug_det(psi_det_sorted_tc(1,1,i),N_int)
print*,i,psi_average_norm_contrib_sorted_tc(i)
write(35,*)psi_det_sorted_tc(1,1,i),psi_det_sorted_tc(1,2,i)
enddo
endif
END_PROVIDER
BEGIN_PROVIDER [double precision, psi_r_coef_sorted_bi_ortho, (psi_det_size, N_states)]
&BEGIN_PROVIDER [double precision, psi_l_coef_sorted_bi_ortho, (psi_det_size, N_states)]
BEGIN_DOC
! psi_r_coef_sorted_bi_ortho : right coefficients corresponding to psi_det_sorted_tc
! psi_l_coef_sorted_bi_ortho : left coefficients corresponding to psi_det_sorted_tc
END_DOC
implicit none
integer :: i, j, k
psi_r_coef_sorted_bi_ortho = 0.d0
psi_l_coef_sorted_bi_ortho = 0.d0
do i = 1, N_det
psi_r_coef_sorted_bi_ortho(i,1) = psi_r_coef_bi_ortho(psi_det_sorted_tc_order(i),1)
psi_l_coef_sorted_bi_ortho(i,1) = psi_l_coef_bi_ortho(psi_det_sorted_tc_order(i),1)
psi_r_coef_sorted_bi_ortho(i,1:N_states) = psi_r_coef_bi_ortho(iorder(i),1:N_states)
psi_l_coef_sorted_bi_ortho(i,1:N_states) = psi_l_coef_bi_ortho(iorder(i),1:N_states)
enddo
logical :: pouet
pouet = .true.
do i = 1, N_det
if(psi_l_coef_sorted_bi_ortho(i,1) == 0.d0)then
pouet = .False.
exit
endif
enddo
if(pouet.and.N_det.ne.1)then
print*,'psi_r_coef_sorted_bi_ortho'
do i = 1, N_det
print*,psi_r_coef_bi_ortho(psi_det_sorted_tc_order(i),1)
write(42,'(F10.7)')dabs(psi_r_coef_sorted_bi_ortho(i,1)*psi_l_coef_sorted_bi_ortho(i,1))
enddo
endif
deallocate(iorder)
! logical :: pouet
! pouet = .true.
! do i = 1, N_det
! if(psi_average_norm_contrib_sorted_tc(i) == 0.d0)then
! pouet = .False.
! exit
! endif
! enddo
!
! if(pouet.and.N_det.ne.1)then
! print*,'writing sorted'
! do i = 1, N_det
! print*,i,psi_average_norm_contrib_sorted_tc(i)
! write(35,*)psi_det_sorted_tc(1,1,i),psi_det_sorted_tc(1,2,i)
! enddo
! endif
END_PROVIDER
BEGIN_PROVIDER [ integer(bit_kind), psi_det_sorted_tc_bit, (N_int,2,psi_det_size) ]
&BEGIN_PROVIDER [ double precision, psi_coef_sorted_tc_bit, (psi_det_size,N_states) ]
implicit none

26
src/tc_bi_ortho/psi_r_l_prov.irp.f
View File

@ -136,15 +136,15 @@ BEGIN_PROVIDER [ double precision, psi_r_coef_bi_ortho, (psi_det_size,N_states)
END_PROVIDER
subroutine save_tc_wavefunction_general(ndet,nstates,psidet,dim_psicoef,psilcoef,psircoef)
subroutine save_tc_wavefunction_general(ndet,nstates,psidet,sze,dim_psicoef,psilcoef,psircoef)
implicit none
BEGIN_DOC
! Save the wave function into the |EZFIO| file
END_DOC
use bitmasks
include 'constants.include.F'
integer, intent(in) :: ndet,nstates,dim_psicoef
integer(bit_kind), intent(in) :: psidet(N_int,2,ndet)
integer, intent(in) :: ndet,nstates,dim_psicoef,sze
integer(bit_kind), intent(in) :: psidet(N_int,2,sze)
double precision, intent(in) :: psilcoef(dim_psicoef,nstates)
double precision, intent(in) :: psircoef(dim_psicoef,nstates)
integer*8, allocatable :: psi_det_save(:,:,:)
@ -188,23 +188,17 @@ subroutine save_tc_wavefunction_general(ndet,nstates,psidet,dim_psicoef,psilcoef
call ezfio_set_tc_bi_ortho_psi_r_coef_bi_ortho(psir_coef_save)
deallocate (psil_coef_save,psir_coef_save)
! allocate (psi_coef_save(ndet_qp_edit,nstates))
! do k=1,nstates
! do i=1,ndet_qp_edit
! psi_coef_save(i,k) = psicoef(i,k)
! enddo
! enddo
!
! call ezfio_set_determinants_psi_coef_qp_edit(psi_coef_save)
! deallocate (psi_coef_save)
call write_int(6,ndet,'Saved determinantsi and psi_r/psi_l coef')
endif
end
subroutine save_tc_bi_ortho_wavefunction
implicit none
call save_tc_wavefunction_general(N_det,N_states,psi_det,size(psi_l_coef_bi_ortho, 1),psi_l_coef_bi_ortho,psi_r_coef_bi_ortho)
if(save_sorted_tc_wf)then
call save_tc_wavefunction_general(N_det,N_states,psi_det_sorted_tc,size(psi_det_sorted_tc, 3),size(psi_l_coef_sorted_bi_ortho, 1),psi_l_coef_sorted_bi_ortho,psi_r_coef_sorted_bi_ortho)
else
call save_tc_wavefunction_general(N_det,N_states,psi_det,size(psi_det, 3), size(psi_l_coef_bi_ortho, 1),psi_l_coef_bi_ortho,psi_r_coef_bi_ortho)
endif
call routine_save_right_bi_ortho
end
@ -214,9 +208,9 @@ subroutine routine_save_right_bi_ortho
integer :: i
allocate(coef_tmp(N_det, N_states))
do i = 1, N_det
coef_tmp(i,1:N_states) = psi_r_coef_bi_ortho(i,1:N_states)
coef_tmp(i,1:N_states) = psi_r_coef_sorted_bi_ortho(i,1:N_states)
enddo
call save_wavefunction_general_unormalized(N_det,N_states,psi_det,size(coef_tmp,1),coef_tmp(1,1))
call save_wavefunction_general_unormalized(N_det,N_states,psi_det_sorted_tc,size(coef_tmp,1),coef_tmp(1,1))
end
subroutine routine_save_left_right_bi_ortho

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

@ -11,7 +11,7 @@ program tc_bi_ortho
touch read_wf
touch my_grid_becke my_n_pt_r_grid my_n_pt_a_grid
call routine_diag
! call test
call save_tc_bi_ortho_wavefunction
end
subroutine test
@ -19,18 +19,19 @@ subroutine test
integer :: i,j
double precision :: hmono,htwoe,hthree,htot
use bitmasks
print*,'test'
! call htilde_mu_mat_bi_ortho(psi_det(1,1,1), psi_det(1,1,2), N_int, hmono, htwoe, hthree, htot)
call double_htilde_mu_mat_bi_ortho(N_int,psi_det(1,1,1), psi_det(1,1,2), hmono, htwoe, htot)
print*,hmono, htwoe, 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
end
subroutine routine_diag
implicit none
! provide eigval_right_tc_bi_orth
provide overlap_bi_ortho
! provide overlap_bi_ortho
! provide htilde_matrix_elmt_bi_ortho
integer ::i,j
print*,'eigval_right_tc_bi_orth = ',eigval_right_tc_bi_orth(1)
@ -46,16 +47,7 @@ subroutine routine_diag
print*,'e_corr_double_bi_orth = ',e_corr_double_bi_orth
print*,'Left/right eigenvectors'
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)
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
do j=1,N_states
do i=1,N_det
psi_l_coef_bi_ortho(i,j) = leigvec_tc_bi_orth(i,j)
psi_r_coef_bi_ortho(i,j) = reigvec_tc_bi_orth(i,j)
enddo
enddo
SOFT_TOUCH psi_l_coef_bi_ortho psi_r_coef_bi_ortho
call save_tc_bi_ortho_wavefunction
! call routine_save_left_right_bi_ortho
end

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

@ -12,6 +12,25 @@
enddo
END_PROVIDER
subroutine diagonalize_CI_tc
implicit none
BEGIN_DOC
! Replace the coefficients of the |CI| states by the coefficients of the
! eigenstates of the |CI| matrix.
END_DOC
integer :: i,j
do j=1,N_states
do i=1,N_det
psi_l_coef_bi_ortho(i,j) = leigvec_tc_bi_orth(i,j)
psi_r_coef_bi_ortho(i,j) = reigvec_tc_bi_orth(i,j)
enddo
enddo
! psi_energy(1:N_states) = CI_electronic_energy(1:N_states)
! psi_s2(1:N_states) = CI_s2(1:N_states)
SOFT_TOUCH psi_l_coef_bi_ortho psi_r_coef_bi_ortho
end
BEGIN_PROVIDER [double precision, eigval_right_tc_bi_orth, (N_states)]
@ -133,10 +152,10 @@
call bi_normalize(leigvec_tc_bi_orth,reigvec_tc_bi_orth,size(reigvec_tc_bi_orth,1),N_det,N_states)
print*,'leigvec_tc_bi_orth(1,1),reigvec_tc_bi_orth(1,1) = ',leigvec_tc_bi_orth(1,1),reigvec_tc_bi_orth(1,1)
norm_ground_left_right_bi_orth = 0.d0
print*,'after diago'
! print*,'after diago'
do j = 1, N_det
call debug_det(psi_det(1,1,j),N_int)
print*,j,dabs(leigvec_tc_bi_orth(j,1) * reigvec_tc_bi_orth(j,1))
! call debug_det(psi_det(1,1,j),N_int)
! print*,j,dabs(leigvec_tc_bi_orth(j,1) * reigvec_tc_bi_orth(j,1))
norm_ground_left_right_bi_orth += leigvec_tc_bi_orth(j,1) * reigvec_tc_bi_orth(j,1)
enddo
print*,'norm l/r = ',norm_ground_left_right_bi_orth

8
src/tc_keywords/EZFIO.cfg
View File

@ -207,3 +207,11 @@ type: logical
doc: If |true|, only the right part of WF is used to compute spin dens
interface: ezfio,provider,ocaml
default: False
[save_sorted_tc_wf]
type: logical
doc: If |true|, save the bi-ortho wave functions in a sorted way
interface: ezfio,provider,ocaml
default: True