mirror of
https://gitlab.com/scemama/qp_plugins_scemama.git
synced 2024-07-26 04:37:31 +02:00
64 lines
1.9 KiB
FortranFixed
64 lines
1.9 KiB
FortranFixed
|
program e_curve
|
||
|
|
use bitmasks
|
||
|
|
implicit none
|
||
|
|
integer :: i,j,k, kk, nab, m, l
|
||
|
|
double precision :: norm, E, hij, num, ci, cj
|
||
|
|
double precision :: e_0(N_states)
|
||
|
|
PROVIDE mo_two_e_integrals_in_map mo_one_e_integrals
|
||
|
|
|
||
|
|
if (.not.read_wf) then
|
||
|
|
stop 'Please set read_wf to true'
|
||
|
|
endif
|
||
|
|
|
||
|
|
PROVIDE psi_bilinear_matrix nuclear_repulsion
|
||
|
|
PROVIDE psi_coef_sorted psi_det psi_coef
|
||
|
|
print *, ''
|
||
|
|
print *, '=============================='
|
||
|
|
print *, 'Energies at different cut-offs'
|
||
|
|
print *, '=============================='
|
||
|
|
print *, ''
|
||
|
|
print *, '=========================================================='
|
||
|
|
print '(A8,2X,A8,2X,A12,2X,A10,2X,A12)', 'Thresh.', 'Ndet', 'Cost', 'Norm', 'E'
|
||
|
|
print *, '=========================================================='
|
||
|
|
double precision :: thresh
|
||
|
|
integer(bit_kind), allocatable :: det_i(:,:), det_j(:,:)
|
||
|
|
thresh = 1.d-10
|
||
|
|
|
||
|
|
nab = n_det_alpha_unique+n_det_beta_unique
|
||
|
|
|
||
|
|
|
||
|
|
do while (thresh < 1.d0)
|
||
|
|
norm = 0.d0
|
||
|
|
do k=1,n_det
|
||
|
|
if (dabs(psi_coef(k,1)) < thresh) then
|
||
|
|
psi_coef(k,1) = 0.d0
|
||
|
|
endif
|
||
|
|
norm = norm + psi_coef(k,1)**2
|
||
|
|
enddo
|
||
|
|
TOUCH psi_coef
|
||
|
|
norm = norm/dsqrt(norm)
|
||
|
|
|
||
|
|
psi_coef(1:N_det,1) = psi_coef_sorted(1:N_det,1)
|
||
|
|
psi_det(1:N_int,1:2,1:N_det) = psi_det_sorted(1:N_int,1:2,1:N_det)
|
||
|
|
do k=1,n_det
|
||
|
|
if (psi_coef(k,1) == 0.d0) then
|
||
|
|
exit
|
||
|
|
endif
|
||
|
|
enddo
|
||
|
|
n_det = k-1
|
||
|
|
TOUCH n_det psi_coef psi_det
|
||
|
|
|
||
|
|
j = n_det_alpha_unique+n_det_beta_unique
|
||
|
|
call u_0_H_u_0(E,psi_coef,n_det,psi_det,N_int,1,size(psi_coef,1))
|
||
|
|
|
||
|
|
print '(E9.1,2X,I8,2X,F10.2,2X,F10.8,2X,F15.10)', thresh, n_det, &
|
||
|
|
dble( elec_alpha_num**3 + elec_alpha_num**2 * (nab-1) ) / &
|
||
|
|
dble( elec_alpha_num**3 + elec_alpha_num**2 * (nab-j)), norm, &
|
||
|
|
psi_energy(1)
|
||
|
|
thresh = thresh * dsqrt(10.d0)
|
||
|
|
enddo
|
||
|
|
print *, '=========================================================='
|
||
|
|
|
||
|
|
end
|
||
|
|
|