mirror of
https://gitlab.com/scemama/qp_plugins_scemama.git
synced 2024-12-22 20:34:05 +01:00
Merge branch 'master' of gitlab.com:scemama/qp_plugins_scemama
This commit is contained in:
commit
a264f8bb6f
@ -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 *, '=========================================================='
|
||||||
|
|
||||||
|
Loading…
Reference in New Issue
Block a user