1
0
mirror of https://gitlab.com/scemama/qp_plugins_scemama.git synced 2024-11-08 23:23:42 +01:00

Compare commits

..

2 Commits

Author SHA1 Message Date
531cabe735 Merge branch 'master' of https://gitlab.com/scemama/qp_plugins_scemama
Conflicts:
	devel/dmc_dress/dressing_vector.irp.f
	devel/trexio/uninstall
2023-05-24 15:24:48 +02:00
8efcf7a649 Rewrote qmc_e_curve 2023-05-24 15:23:39 +02:00

View File

@ -1,19 +1,42 @@
program e_curve program e_curve
use bitmasks use bitmasks
implicit none implicit none
integer :: i,j,k, kk, nab, m, l integer :: i,j,k, nab, m, l
double precision :: norm, E, hij, num, ci, cj double precision :: norm
integer, allocatable :: iorder(:) integer, allocatable :: iorder(:)
double precision , allocatable :: norm_sort(:) double precision , allocatable :: norm_sort(:)
double precision :: e_0(N_states)
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
stop 'Please set read_wf to true'
endif
PROVIDE psi_bilinear_matrix_values nuclear_repulsion
if (.True.) then
print *, ''
print *, 'Energy: ', psi_energy(1)+nuclear_repulsion
endif
print *, ''
print *, '=============================='
print *, 'Energies at different cut-offs'
print *, '=============================='
print *, ''
print *, '=============================================================================='
print '(A8,2X,A8,A8,A8,2X,A12,2X,A10,2X,A12)', 'Thresh.', 'Ndet', 'Na', 'Nb', 'Cost', 'Norm', 'E'
print *, '=============================================================================='
double precision :: thresh
integer(bit_kind), allocatable :: det_i(:,:), det_j(:,:)
integer :: na, nb
nab = n_det_alpha_unique+n_det_beta_unique nab = n_det_alpha_unique+n_det_beta_unique
allocate ( norm_sort(0:nab), iorder(0:nab) ) allocate ( norm_sort(0:nab), iorder(0:nab) )
thresh = 1.d-8
double precision, allocatable :: u_t(:,:), v_t(:,:), s_t(:,:) do while (N_det > 1)
double precision, allocatable :: u_0(:,:), v_0(:,:) nab = n_det_alpha_unique+n_det_beta_unique
norm_sort(0) = 0.d0 norm_sort(0) = 0.d0
iorder(0) = 0 iorder(0) = 0
@ -29,36 +52,18 @@ program e_curve
call dsort(norm_sort(1),iorder(1),nab) call dsort(norm_sort(1),iorder(1),nab)
if (.not.read_wf) then
stop 'Please set read_wf to true'
endif
PROVIDE psi_bilinear_matrix_values nuclear_repulsion
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(:,:)
integer :: na, nb
thresh = 1.d-10
na = n_det_alpha_unique na = n_det_alpha_unique
nb = n_det_beta_unique nb = n_det_beta_unique
do j=0,nab do j=1,nab
i = iorder(j) i = iorder(j)
if (i<0) then if ((i<0).and.(nb>1)) then
nb -= 1 nb -= 1
do k=1,n_det do k=1,n_det
if (psi_bilinear_matrix_columns(k) == -i) then if (psi_bilinear_matrix_columns(k) == -i) then
psi_bilinear_matrix_values(k,1) = 0.d0 psi_bilinear_matrix_values(k,1) = 0.d0
endif endif
enddo enddo
else else if ((i>0).and.(na>1)) then
na -= 1 na -= 1
do k=1,n_det do k=1,n_det
if (psi_bilinear_matrix_rows(k) == i) then if (psi_bilinear_matrix_rows(k) == i) then
@ -66,9 +71,10 @@ program e_curve
endif endif
enddo enddo
endif endif
if (thresh > norm_sort(j)) then if (thresh < norm_sort(j)) then
cycle exit
endif endif
enddo
do k=1,N_states do k=1,N_states
psi_coef(1:N_det,k) = psi_bilinear_matrix_values(1:N_det,k) psi_coef(1:N_det,k) = psi_bilinear_matrix_values(1:N_det,k)
@ -76,18 +82,18 @@ program e_curve
enddo enddo
TOUCH psi_det psi_coef TOUCH psi_det psi_coef
m = 0 psi_det = psi_det_sorted
do k=1,n_det psi_coef = psi_coef_sorted
if (psi_bilinear_matrix_values(k,1) /= 0.d0) then
m = m+1 do m=1,n_det
endif if (psi_coef_sorted(m,1) == 0.d0) exit
enddo enddo
if (m == 0) then N_det = m-1
exit TOUCH psi_det psi_coef N_det
endif
E = E_0(1) + nuclear_repulsion
! Avoid providing psi_energy
if (.True.) then
double precision :: cost0, cost double precision :: cost0, cost
cost0 = elec_alpha_num**3 + elec_beta_num**3 cost0 = elec_alpha_num**3 + elec_beta_num**3
cost = (na-1) * elec_alpha_num**2 + & cost = (na-1) * elec_alpha_num**2 + &
@ -97,9 +103,10 @@ program e_curve
double precision :: u_dot_u double precision :: u_dot_u
norm = dsqrt(u_dot_u(psi_coef(1,1),N_det)) norm = dsqrt(u_dot_u(psi_coef(1,1),N_det))
print '(E9.1,2X,I8,2X,F10.2,2X,F10.8,2X,F15.10)', thresh, m, & print '(E9.1,2X,I8,I8,I8,2X,F10.2,2X,F10.8,2X,F15.10)', thresh, N_det, &
cost, norm, psi_energy(1) na, nb, cost, norm, psi_energy(1) + nuclear_repulsion
thresh = thresh * dsqrt(10.d0) thresh = thresh * dsqrt(10.d0)
endif
enddo enddo
print *, '==========================================================' print *, '=========================================================='