mirror of
https://github.com/LCPQ/quantum_package
synced 2024-12-29 15:45:51 +01:00
172 lines
5.4 KiB
Fortran
172 lines
5.4 KiB
Fortran
program test_wf
|
|
implicit none
|
|
read_wf = .True.
|
|
touch read_wf
|
|
call routine
|
|
end
|
|
|
|
|
|
|
|
subroutine routine
|
|
use bitmasks
|
|
implicit none
|
|
integer :: iref
|
|
print*, 'which reference slater determinant dou you want ?'
|
|
read(5,*)iref
|
|
integer :: i
|
|
double precision :: delta_e,h0i
|
|
double precision :: accu_e, hiiref,accu_coef,hij
|
|
double precision, allocatable :: contrib(:)
|
|
integer, allocatable :: iorder(:)
|
|
integer, allocatable :: idx(:)
|
|
allocate(idx(0:N_det))
|
|
print*, '***********************'
|
|
print*, '***********************'
|
|
print*, '***********************'
|
|
print*, 'You chose that SD :'
|
|
call debug_det(psi_det(1,1,iref),N_int)
|
|
call get_excitation_degree(ref_bitmask,psi_det(1,1,iref),degree,N_int)
|
|
call i_H_j(ref_bitmask,psi_det(1,1,iref),N_int,h0i)
|
|
call i_H_j(psi_ref(1,1,iref),psi_det(1,1,iref),N_int,hii)
|
|
call get_excitation(ref_bitmask,psi_det(1,1,iref),exc,degree,phase,N_int)
|
|
call decode_exc(exc,degree,h1,p1,h2,p2,s1,s2)
|
|
|
|
print*,'degree =',degree
|
|
print*,'phase =',phase
|
|
if(degree == 1)then
|
|
print*,'s1',s1
|
|
print*,'h1,p1 = ',h1,p1
|
|
else if (degree ==2)then
|
|
print*,'s1',s1
|
|
print*,'h1,p1 = ',h1,p1
|
|
print*,'s2',s2
|
|
print*,'h2,p2 = ',h2,p2
|
|
endif
|
|
if(degree.ne.0)then
|
|
delta_e = hii - ref_bitmask_energy
|
|
if(h0i.ne.0.d0)then
|
|
if (delta_e > 0.d0) then
|
|
coef_2_2 = 0.5d0 * (delta_e - dsqrt(delta_e * delta_e + 4.d0 * h0i * h0i ))/ h0i
|
|
else
|
|
coef_2_2 = 0.5d0 * (delta_e + dsqrt(delta_e * delta_e + 4.d0 * h0i * h0i )) /h0i
|
|
endif
|
|
endif
|
|
endif
|
|
print*,'h0i =',h0i
|
|
print*,'delta E =',delta_e
|
|
print*,'coef 2x2 =',coef_2_2!*psi_coef(1,1)
|
|
print*,'amplitude =',psi_coef(iref,1)/psi_coef(1,1)
|
|
print*, '***********************'
|
|
print*, '***********************'
|
|
print*, '***********************'
|
|
|
|
call filter_connected_i_H_psi0(psi_det,psi_det(1,1,iref),N_int,N_det,idx)
|
|
|
|
|
|
call i_H_j(psi_det(1,1,iref),psi_det(1,1,iref),N_int,hiiref)
|
|
print*, 'passed the connection browsing'
|
|
allocate(contrib(idx(0)-1),iorder(idx(0)-1))
|
|
|
|
accu_e = 0.d0
|
|
accu_coef = 0.d0
|
|
print*, iref
|
|
print*, idx(0)
|
|
do i = 1, idx(0)
|
|
contrib(i) = 0.d0
|
|
iorder(i) = idx(i)
|
|
if(idx(i)==iref)then
|
|
cycle
|
|
else
|
|
call get_excitation_degree(psi_det(1,1,iref),psi_det(1,1,idx(i)),degree,N_int)
|
|
if(degree.gt.2)cycle
|
|
call i_H_j(psi_det(1,1,iref),psi_det(1,1,idx(i)),N_int,hij)
|
|
accu_coef += psi_coef(idx(i),1) * hij / (var_energy_mr(1) - hiiref)
|
|
contrib(i) = -dabs(psi_coef(idx(i),1) * hij / (var_energy_mr(1) - hiiref))
|
|
accu_e += psi_coef(idx(i),1) * hij
|
|
endif
|
|
enddo
|
|
print*, 'passed the contributions '
|
|
|
|
integer :: degree
|
|
integer :: exc(0:2,2,2)
|
|
double precision :: phase
|
|
integer :: h1,h2,p1,p2,s1,s2
|
|
accu_e += psi_coef(iref,1) * hiiref
|
|
accu_e = accu_e / psi_coef(iref,1)
|
|
print*, psi_coef(iref,1),accu_coef
|
|
print*, var_energy_mr(1),accu_e
|
|
call dsort(contrib,iorder,idx(0)-1)
|
|
print*, 'passed sorting the contributions'
|
|
accu_coef = 0.d0
|
|
double precision :: accu_second_order,coef_2_2, hii
|
|
accu_second_order = 0.d0
|
|
|
|
print*, ''
|
|
do i = 1, idx(0)
|
|
if (iorder(i)==iref)cycle
|
|
call get_excitation_degree(psi_det(1,1,iref),psi_det(1,1,iorder(i)),degree,N_int)
|
|
if(degree.gt.2)cycle
|
|
print*, ''
|
|
print*, '==============================================='
|
|
print*, ' i ',i,iorder(i)
|
|
call debug_det(psi_det(1,1,iorder(i)),N_int)
|
|
call i_H_j(psi_det(1,1,iorder(i)),psi_det(1,1,iorder(i)),N_int,hii)
|
|
call i_H_j(psi_det(1,1,iref),psi_det(1,1,iorder(i)),N_int,hij)
|
|
call get_excitation(psi_det(1,1,iref),psi_det(1,1,iorder(i)),exc,degree,phase,N_int)
|
|
call decode_exc(exc,degree,h1,p1,h2,p2,s1,s2)
|
|
print*,'Info with respect to the chosen ref determinant'
|
|
print*,'degree =',degree
|
|
if(degree == 1)then
|
|
print*,'s1',s1
|
|
print*,'h1,p1 = ',h1,p1
|
|
else
|
|
print*,'s1',s1
|
|
print*,'h1,p1 = ',h1,p1
|
|
print*,'s2',s2
|
|
print*,'h2,p2 = ',h2,p2
|
|
endif
|
|
print*,'coef =',psi_coef(iorder(i),1)
|
|
print*,'phase =',phase
|
|
print*,'hij =',hij
|
|
print*,'contrib =',psi_coef(iorder(i),1) * hij / (var_energy_mr(1) - hiiref)
|
|
print*,'relative contrib =',psi_coef(iorder(i),1) * hij / (var_energy_mr(1) - hiiref)/psi_coef(iref,1)
|
|
accu_coef += psi_coef(iorder(i),1) * hij / (var_energy_mr(1) - hiiref)
|
|
|
|
print*,'Info with respect to the HF-like determinant '
|
|
call get_excitation_degree(ref_bitmask,psi_det(1,1,iorder(i)),degree,N_int)
|
|
call i_H_j(ref_bitmask,psi_det(1,1,iorder(i)),N_int,h0i)
|
|
call get_excitation(ref_bitmask,psi_det(1,1,iorder(i)),exc,degree,phase,N_int)
|
|
call decode_exc(exc,degree,h1,p1,h2,p2,s1,s2)
|
|
print*,'degree =',degree
|
|
if(degree == 1)then
|
|
print*,'s1',s1
|
|
print*,'h1,p1 = ',h1,p1
|
|
else if (degree ==2)then
|
|
print*,'s1',s1
|
|
print*,'h1,p1 = ',h1,p1
|
|
print*,'s2',s2
|
|
print*,'h2,p2 = ',h2,p2
|
|
endif
|
|
if(degree.ne.0)then
|
|
delta_e = hii - ref_bitmask_energy
|
|
if(h0i.ne.0.d0)then
|
|
if (delta_e > 0.d0) then
|
|
coef_2_2 = 0.5d0 * (delta_e - dsqrt(delta_e * delta_e + 4.d0 * h0i * h0i ))/ h0i
|
|
else
|
|
coef_2_2 = 0.5d0 * (delta_e + dsqrt(delta_e * delta_e + 4.d0 * h0i * h0i )) /h0i
|
|
endif
|
|
endif
|
|
print*,'h0i =',h0i
|
|
print*,'coef 2x2 =',coef_2_2*psi_coef(1,1)
|
|
print*,'delta E =',delta_e
|
|
print*,'sec order conrib =',coef_2_2 * hij/(var_energy_mr(1) - hiiref) * psi_coef(1,1)
|
|
accu_second_order += coef_2_2 * hij/(var_energy_mr(1) - hiiref) * psi_coef(1,1)
|
|
endif
|
|
enddo
|
|
print*, 'Total comparison ....'
|
|
print*, psi_coef(iref,1),accu_coef,accu_second_order
|
|
|
|
|
|
end
|
|
|