scemama/qp_plugins_scemama
1
0
Fork 0
mirror of https://gitlab.com/scemama/qp_plugins_scemama.git synced 2024-11-07 14:43:41 +01:00
Code Issues Releases Wiki Activity

Merge branch 'master' of gitlab.com:scemama/qp_plugins_scemama

Browse Source
This commit is contained in:
Anthony Scemama 2021-06-27 15:53:37 +02:00
commit 0ac591c407
1 changed files with 12 additions and 18 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

30
devel/qmcchem/qmc_e_curve2.irp.f
View File

@ -4,6 +4,7 @@ program e_curve
integer :: i,j,k, kk, nab, m, l integer :: i,j,k, kk, nab, m, l
double precision :: norm, E, hij, num, ci, cj double precision :: norm, E, hij, num, ci, cj
double precision :: e_0(N_states) double precision :: e_0(N_states)
double precision, allocatable :: psi_save(:)
PROVIDE mo_two_e_integrals_in_map mo_one_e_integrals PROVIDE mo_two_e_integrals_in_map mo_one_e_integrals
if (.not.read_wf) then if (.not.read_wf) then
@ -23,38 +24,31 @@ program e_curve
double precision :: thresh double precision :: thresh
integer(bit_kind), allocatable :: det_i(:,:), det_j(:,:) integer(bit_kind), allocatable :: det_i(:,:), det_j(:,:)
thresh = 1.d-10 thresh = 1.d-10
integer :: n_det_prime
nab = n_det_alpha_unique+n_det_beta_unique nab = n_det_alpha_unique+n_det_beta_unique
allocate(psi_save(1:N_det))
psi_save(1:N_det) = psi_coef(1:N_det,1)
do while (thresh < 1.d0) do while (thresh < 1.d0)
norm = 0.d0 norm = 0.d0
n_det_prime = n_det
do k=1,n_det do k=1,n_det
psi_coef(k,1) = psi_save(k)
if (dabs(psi_coef(k,1)) < thresh) then if (dabs(psi_coef(k,1)) < thresh) then
psi_coef(k,1) = 0.d0 psi_coef(k,1) = 0.d0
n_det_prime -= 1
endif endif
norm = norm + psi_coef(k,1)**2 norm = norm + psi_coef(k,1)**2
enddo enddo
TOUCH psi_coef TOUCH psi_coef psi_det
norm = norm/dsqrt(norm) norm = norm/dsqrt(norm)
psi_coef(:,1) = psi_coef(:,1)/norm
psi_coef(1:N_det,1) = psi_coef_sorted(1:N_det,1) E = psi_energy(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 print '(E9.1,2X,I8,2X,2X,F10.8,2X,F15.10)', thresh, n_det_prime, &
call u_0_H_u_0(E,psi_coef,n_det,psi_det,N_int,1,size(psi_coef,1)) norm, E
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) thresh = thresh * dsqrt(10.d0)
enddo enddo
print *, '==========================================================' print *, '=========================================================='