scemama/qp_plugins_scemama
1
0
Fork 0
mirror of https://gitlab.com/scemama/qp_plugins_scemama.git synced 2024-12-22 12:23:37 +01:00
Code Issues Releases Wiki Activity

Estimate cost

Browse Source
This commit is contained in:
Anthony Scemama 2021-06-27 23:45:30 +02:00
parent 0ac591c407
commit b430721eb4
2 changed files with 35 additions and 5 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

16
devel/qmcchem/qmc_e_curve.irp.f
View File

@ -45,16 +45,21 @@ program e_curve
print *, '==========================================================' print *, '=========================================================='
double precision :: thresh double precision :: thresh
integer(bit_kind), allocatable :: det_i(:,:), det_j(:,:) integer(bit_kind), allocatable :: det_i(:,:), det_j(:,:)
integer :: na, nb
thresh = 1.d-10 thresh = 1.d-10
na = n_det_alpha_unique
nb = n_det_beta_unique
do j=0,nab do j=0,nab
i = iorder(j) i = iorder(j)
if (i<0) then if (i<0) then
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
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
psi_bilinear_matrix_values(k,1) = 0.d0 psi_bilinear_matrix_values(k,1) = 0.d0
@ -82,11 +87,18 @@ program e_curve
exit exit
endif endif
E = E_0(1) + nuclear_repulsion E = E_0(1) + nuclear_repulsion
double precision :: cost0, cost
cost0 = elec_alpha_num**3 + elec_beta_num**3
cost = (na-1) * elec_alpha_num**2 + &
(nb-1) * elec_beta_num**2 + &
elec_alpha_num**3 + elec_beta_num**3
cost = cost/cost0
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,2X,F10.2,2X,F10.8,2X,F15.10)', thresh, m, &
dble( elec_alpha_num**3 + elec_alpha_num**2 * (nab-1) ) / & cost, norm, psi_energy(1)
dble( elec_alpha_num**3 + elec_alpha_num**2 * (j-1)), norm, psi_energy(1)
thresh = thresh * dsqrt(10.d0) thresh = thresh * dsqrt(10.d0)
enddo enddo
print *, '==========================================================' print *, '=========================================================='

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

@ -45,10 +45,28 @@ program e_curve
norm = norm/dsqrt(norm) norm = norm/dsqrt(norm)
psi_coef(:,1) = psi_coef(:,1)/norm psi_coef(:,1) = psi_coef(:,1)/norm
integer :: na, nb
na = 0
do k=1,n_det_alpha_unique
if (det_alpha_norm(k) > 0.d0) then
na += 1
endif
enddo
nb = 0
do k=1,n_det_beta_unique
if (det_beta_norm(k) > 0.d0) then
nb += 1
endif
enddo
E = psi_energy(1) E = psi_energy(1)
double precision :: cost0, cost
print '(E9.1,2X,I8,2X,2X,F10.8,2X,F15.10)', thresh, n_det_prime, & cost0 = elec_alpha_num**3 + elec_beta_num**3
norm, E cost = (na-1) * elec_alpha_num**2 + &
(nb-1) * elec_beta_num**2 + &
elec_alpha_num**3 + elec_beta_num**3
cost = cost/cost0
print '(E9.1,2X,I8,2X,F10.2,2X,F10.8,2X,F15.10)', thresh, n_det_prime, &
cost, norm, E
thresh = thresh * dsqrt(10.d0) thresh = thresh * dsqrt(10.d0)
enddo enddo
print *, '==========================================================' print *, '=========================================================='