mirror of
https://github.com/LCPQ/quantum_package
synced 2024-08-26 14:31:44 +02:00
unfinished shifted_bk stochastic selection - no undressing
This commit is contained in:
parent
c786e9fe58
commit
2bf17db149
@ -12,11 +12,10 @@ subroutine run_dressing(N_st,energy)
|
||||
integer :: iteration
|
||||
|
||||
integer :: n_it_dress_max
|
||||
double precision :: thresh_dress
|
||||
double precision :: thresh_dress, dummy
|
||||
|
||||
thresh_dress = thresh_dressed_ci
|
||||
n_it_dress_max = n_it_max_dressed_ci
|
||||
|
||||
if(n_it_dress_max == 1) then
|
||||
do j=1,N_states
|
||||
do i=1,N_det
|
||||
@ -32,14 +31,19 @@ subroutine run_dressing(N_st,energy)
|
||||
delta_E = 1.d0
|
||||
iteration = 0
|
||||
do while (delta_E > thresh_dress)
|
||||
N_det_delta_ij = N_det
|
||||
touch N_det_delta_ij
|
||||
iteration += 1
|
||||
print *, '==============================================='
|
||||
print *, 'Iteration', iteration, '/', n_it_dress_max
|
||||
print *, '==============================================='
|
||||
print *, ''
|
||||
E_old = dress_e0_denominator(1) !sum(ci_energy_dressed(1:N_states))
|
||||
!print *, "DELTA IJ", delta_ij(1,1,1)
|
||||
if(.true.) dummy = delta_ij_tmp(1,1,1)
|
||||
if(.true.) call delta_ij_done()
|
||||
do i=1,N_st
|
||||
call write_double(6,ci_energy_dressed(i),"Energy")
|
||||
if(.true.) call write_double(6,ci_energy_dressed(i),"Energy")
|
||||
enddo
|
||||
call diagonalize_ci_dressed
|
||||
E_new = dress_e0_denominator(1) !sum(ci_energy_dressed(1:N_states))
|
||||
@ -55,8 +59,9 @@ subroutine run_dressing(N_st,energy)
|
||||
exit
|
||||
endif
|
||||
enddo
|
||||
call write_double(6,ci_energy_dressed(1),"Final energy")
|
||||
if(.true.) call write_double(6,ci_energy_dressed(1),"Final energy")
|
||||
endif
|
||||
energy(1:N_st) = ci_energy_dressed(1:N_st)
|
||||
|
||||
if(.true.) energy(1:N_st) = 0d0 ! ci_energy_dressed(1:N_st)
|
||||
end
|
||||
|
||||
|
@ -63,8 +63,18 @@ BEGIN_PROVIDER [ double precision, dress_norm_acc, (0:N_det, N_states) ]
|
||||
END_PROVIDER
|
||||
|
||||
|
||||
BEGIN_PROVIDER [ integer , N_det_delta_ij ]
|
||||
implicit none
|
||||
!N_det_delta_ij = 0!N_det
|
||||
END_PROVIDER
|
||||
|
||||
BEGIN_PROVIDER [ double precision, delta_ij, (N_states,N_det,2) ]
|
||||
BEGIN_PROVIDER [ double precision, delta_ij, (N_states, N_det, 2) ]
|
||||
implicit none
|
||||
if(.true.) delta_ij(:,:N_det_delta_ij, :) = delta_ij_tmp(:,:,:)
|
||||
delta_ij(:,N_det_delta_ij+1:,:) = 0d0
|
||||
END_PROVIDER
|
||||
|
||||
BEGIN_PROVIDER [ double precision, delta_ij_tmp, (N_states,N_det_delta_ij,2) ]
|
||||
use bitmasks
|
||||
implicit none
|
||||
|
||||
@ -72,11 +82,15 @@ BEGIN_PROVIDER [ double precision, delta_ij, (N_states,N_det,2) ]
|
||||
|
||||
double precision, allocatable :: dress(:), del(:,:), del_s2(:,:)
|
||||
double precision :: E_CI_before(N_states), relative_error
|
||||
! double precision, save :: errr = 0d0
|
||||
|
||||
allocate(dress(N_states), del(N_states, N_det), del_s2(N_states, N_det))
|
||||
! prevents re-providing if delta_ij_tmp is
|
||||
! just being copied
|
||||
if(N_det_delta_ij /= N_det) return
|
||||
|
||||
delta_ij = 0d0
|
||||
if(.true.) then
|
||||
allocate(dress(N_states), del(N_states, N_det_delta_ij), del_s2(N_states, N_det_delta_ij))
|
||||
|
||||
delta_ij_tmp = 0d0
|
||||
|
||||
E_CI_before(:) = dress_E0_denominator(:) + nuclear_repulsion
|
||||
threshold_selectors = 1.d0
|
||||
@ -90,11 +104,11 @@ BEGIN_PROVIDER [ double precision, delta_ij, (N_states,N_det,2) ]
|
||||
call write_double(6,relative_error,"Convergence of the stochastic algorithm")
|
||||
|
||||
call ZMQ_dress(E_CI_before, dress, del, del_s2, abs(relative_error))
|
||||
delta_ij(:,:,1) = del(:,:)
|
||||
delta_ij(:,:,2) = del_s2(:,:)
|
||||
delta_ij_tmp(:,:,1) = del(:,:)
|
||||
delta_ij_tmp(:,:,2) = del_s2(:,:)
|
||||
|
||||
deallocate(dress, del, del_s2)
|
||||
|
||||
end if
|
||||
END_PROVIDER
|
||||
|
||||
|
||||
|
@ -1,17 +1,56 @@
|
||||
|
||||
use selection_types
|
||||
|
||||
BEGIN_PROVIDER [ double precision, fock_diag_tmp_, (2,mo_tot_num+1,Nproc) ]
|
||||
&BEGIN_PROVIDER [ integer, current_generator_, (Nproc) ]
|
||||
&BEGIN_PROVIDER [ double precision, a_h_i, (N_det, Nproc) ]
|
||||
&BEGIN_PROVIDER [ double precision, a_s2_i, (N_det, Nproc) ]
|
||||
&BEGIN_PROVIDER [ type(selection_buffer), sb, (Nproc) ]
|
||||
&BEGIN_PROVIDER [ double precision, N_det_increase_factor ]
|
||||
implicit none
|
||||
integer :: i
|
||||
integer :: n_det_add
|
||||
|
||||
N_det_increase_factor = 1d0
|
||||
|
||||
current_generator_(:) = 0
|
||||
do i=1,Nproc
|
||||
n_det_add = max(1, int(float(N_det) * N_det_increase_factor))
|
||||
call create_selection_buffer(n_det_add, n_det_add*2, sb(i))
|
||||
end do
|
||||
a_h_i = 0d0
|
||||
a_s2_i = 0d0
|
||||
END_PROVIDER
|
||||
|
||||
|
||||
|
||||
subroutine delta_ij_done()
|
||||
implicit none
|
||||
integer :: i, n_det_add
|
||||
|
||||
call sort_selection_buffer(sb(1))
|
||||
|
||||
do i=2,Nproc
|
||||
call sort_selection_buffer(sb(i))
|
||||
call merge_selection_buffers(sb(i), sb(1))
|
||||
end do
|
||||
|
||||
call sort_selection_buffer(sb(1))
|
||||
|
||||
call fill_H_apply_buffer_no_selection(sb(1)%cur,sb(1)%det,N_int,0)
|
||||
call copy_H_apply_buffer_to_wf()
|
||||
if (s2_eig.or.(N_states > 1) ) then
|
||||
call make_s2_eigenfunction
|
||||
endif
|
||||
!call save_wavefunction
|
||||
n_det_add = max(1, int(float(N_det) * N_det_increase_factor))
|
||||
do i=1,Nproc
|
||||
call delete_selection_buffer(sb(i))
|
||||
call create_selection_buffer(n_det_add, n_det_add*2, sb(i))
|
||||
end do
|
||||
!delta_ij = 0d0
|
||||
end subroutine
|
||||
|
||||
|
||||
subroutine dress_with_alpha_buffer(Nstates,Ndet,Nint,delta_ij_loc, i_gen, minilist, det_minilist, n_minilist, alpha, iproc)
|
||||
use bitmasks
|
||||
implicit none
|
||||
@ -31,7 +70,7 @@ subroutine dress_with_alpha_buffer(Nstates,Ndet,Nint,delta_ij_loc, i_gen, minili
|
||||
double precision, external :: diag_H_mat_elem_fock
|
||||
integer :: i,j,k,l,m, l_sd
|
||||
double precision :: hdress, sdress
|
||||
double precision :: de, a_h_psi(Nstates), c_alpha
|
||||
double precision :: de, a_h_psi(Nstates), c_alpha, contrib
|
||||
|
||||
|
||||
a_h_psi = 0d0
|
||||
@ -52,12 +91,14 @@ subroutine dress_with_alpha_buffer(Nstates,Ndet,Nint,delta_ij_loc, i_gen, minili
|
||||
end do
|
||||
end do
|
||||
|
||||
contrib = 0d0
|
||||
|
||||
do i=1,Nstates
|
||||
de = E0_denominator(i) - haa
|
||||
if(DABS(de) < 1D-5) cycle
|
||||
|
||||
c_alpha = a_h_psi(i) / de
|
||||
contrib = min(contrib, c_alpha * a_h_psi(i))
|
||||
|
||||
do l_sd=1,n_minilist
|
||||
hdress = c_alpha * a_h_i(l_sd, iproc)
|
||||
@ -66,6 +107,9 @@ subroutine dress_with_alpha_buffer(Nstates,Ndet,Nint,delta_ij_loc, i_gen, minili
|
||||
delta_ij_loc(i, minilist(l_sd), 2) += sdress
|
||||
end do
|
||||
end do
|
||||
|
||||
call add_to_selection_buffer(sb(iproc), alpha, contrib)
|
||||
|
||||
end subroutine
|
||||
|
||||
|
||||
|
Loading…
Reference in New Issue
Block a user