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 :: iteration
|
||||||
|
|
||||||
integer :: n_it_dress_max
|
integer :: n_it_dress_max
|
||||||
double precision :: thresh_dress
|
double precision :: thresh_dress, dummy
|
||||||
|
|
||||||
thresh_dress = thresh_dressed_ci
|
thresh_dress = thresh_dressed_ci
|
||||||
n_it_dress_max = n_it_max_dressed_ci
|
n_it_dress_max = n_it_max_dressed_ci
|
||||||
|
|
||||||
if(n_it_dress_max == 1) then
|
if(n_it_dress_max == 1) then
|
||||||
do j=1,N_states
|
do j=1,N_states
|
||||||
do i=1,N_det
|
do i=1,N_det
|
||||||
@ -32,14 +31,19 @@ subroutine run_dressing(N_st,energy)
|
|||||||
delta_E = 1.d0
|
delta_E = 1.d0
|
||||||
iteration = 0
|
iteration = 0
|
||||||
do while (delta_E > thresh_dress)
|
do while (delta_E > thresh_dress)
|
||||||
|
N_det_delta_ij = N_det
|
||||||
|
touch N_det_delta_ij
|
||||||
iteration += 1
|
iteration += 1
|
||||||
print *, '==============================================='
|
print *, '==============================================='
|
||||||
print *, 'Iteration', iteration, '/', n_it_dress_max
|
print *, 'Iteration', iteration, '/', n_it_dress_max
|
||||||
print *, '==============================================='
|
print *, '==============================================='
|
||||||
print *, ''
|
print *, ''
|
||||||
E_old = dress_e0_denominator(1) !sum(ci_energy_dressed(1:N_states))
|
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
|
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
|
enddo
|
||||||
call diagonalize_ci_dressed
|
call diagonalize_ci_dressed
|
||||||
E_new = dress_e0_denominator(1) !sum(ci_energy_dressed(1:N_states))
|
E_new = dress_e0_denominator(1) !sum(ci_energy_dressed(1:N_states))
|
||||||
@ -55,8 +59,9 @@ subroutine run_dressing(N_st,energy)
|
|||||||
exit
|
exit
|
||||||
endif
|
endif
|
||||||
enddo
|
enddo
|
||||||
call write_double(6,ci_energy_dressed(1),"Final energy")
|
if(.true.) call write_double(6,ci_energy_dressed(1),"Final energy")
|
||||||
endif
|
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
|
end
|
||||||
|
|
||||||
|
@ -63,8 +63,18 @@ BEGIN_PROVIDER [ double precision, dress_norm_acc, (0:N_det, N_states) ]
|
|||||||
END_PROVIDER
|
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
|
use bitmasks
|
||||||
implicit none
|
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, allocatable :: dress(:), del(:,:), del_s2(:,:)
|
||||||
double precision :: E_CI_before(N_states), relative_error
|
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
|
||||||
|
|
||||||
|
if(.true.) then
|
||||||
|
allocate(dress(N_states), del(N_states, N_det_delta_ij), del_s2(N_states, N_det_delta_ij))
|
||||||
|
|
||||||
delta_ij = 0d0
|
delta_ij_tmp = 0d0
|
||||||
|
|
||||||
E_CI_before(:) = dress_E0_denominator(:) + nuclear_repulsion
|
E_CI_before(:) = dress_E0_denominator(:) + nuclear_repulsion
|
||||||
threshold_selectors = 1.d0
|
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 write_double(6,relative_error,"Convergence of the stochastic algorithm")
|
||||||
|
|
||||||
call ZMQ_dress(E_CI_before, dress, del, del_s2, abs(relative_error))
|
call ZMQ_dress(E_CI_before, dress, del, del_s2, abs(relative_error))
|
||||||
delta_ij(:,:,1) = del(:,:)
|
delta_ij_tmp(:,:,1) = del(:,:)
|
||||||
delta_ij(:,:,2) = del_s2(:,:)
|
delta_ij_tmp(:,:,2) = del_s2(:,:)
|
||||||
|
|
||||||
deallocate(dress, del, del_s2)
|
deallocate(dress, del, del_s2)
|
||||||
|
end if
|
||||||
END_PROVIDER
|
END_PROVIDER
|
||||||
|
|
||||||
|
|
||||||
|
@ -1,17 +1,56 @@
|
|||||||
|
use selection_types
|
||||||
|
|
||||||
BEGIN_PROVIDER [ double precision, fock_diag_tmp_, (2,mo_tot_num+1,Nproc) ]
|
BEGIN_PROVIDER [ double precision, fock_diag_tmp_, (2,mo_tot_num+1,Nproc) ]
|
||||||
&BEGIN_PROVIDER [ integer, current_generator_, (Nproc) ]
|
&BEGIN_PROVIDER [ integer, current_generator_, (Nproc) ]
|
||||||
&BEGIN_PROVIDER [ double precision, a_h_i, (N_det, Nproc) ]
|
&BEGIN_PROVIDER [ double precision, a_h_i, (N_det, Nproc) ]
|
||||||
&BEGIN_PROVIDER [ double precision, a_s2_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
|
implicit none
|
||||||
|
integer :: i
|
||||||
|
integer :: n_det_add
|
||||||
|
|
||||||
|
N_det_increase_factor = 1d0
|
||||||
|
|
||||||
current_generator_(:) = 0
|
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_h_i = 0d0
|
||||||
a_s2_i = 0d0
|
a_s2_i = 0d0
|
||||||
END_PROVIDER
|
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)
|
subroutine dress_with_alpha_buffer(Nstates,Ndet,Nint,delta_ij_loc, i_gen, minilist, det_minilist, n_minilist, alpha, iproc)
|
||||||
use bitmasks
|
use bitmasks
|
||||||
implicit none
|
implicit none
|
||||||
@ -31,8 +70,8 @@ subroutine dress_with_alpha_buffer(Nstates,Ndet,Nint,delta_ij_loc, i_gen, minili
|
|||||||
double precision, external :: diag_H_mat_elem_fock
|
double precision, external :: diag_H_mat_elem_fock
|
||||||
integer :: i,j,k,l,m, l_sd
|
integer :: i,j,k,l,m, l_sd
|
||||||
double precision :: hdress, sdress
|
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
|
a_h_psi = 0d0
|
||||||
|
|
||||||
@ -52,13 +91,15 @@ subroutine dress_with_alpha_buffer(Nstates,Ndet,Nint,delta_ij_loc, i_gen, minili
|
|||||||
end do
|
end do
|
||||||
end do
|
end do
|
||||||
|
|
||||||
|
contrib = 0d0
|
||||||
|
|
||||||
do i=1,Nstates
|
do i=1,Nstates
|
||||||
de = E0_denominator(i) - haa
|
de = E0_denominator(i) - haa
|
||||||
if(DABS(de) < 1D-5) cycle
|
if(DABS(de) < 1D-5) cycle
|
||||||
|
|
||||||
c_alpha = a_h_psi(i) / de
|
c_alpha = a_h_psi(i) / de
|
||||||
|
contrib = min(contrib, c_alpha * a_h_psi(i))
|
||||||
|
|
||||||
do l_sd=1,n_minilist
|
do l_sd=1,n_minilist
|
||||||
hdress = c_alpha * a_h_i(l_sd, iproc)
|
hdress = c_alpha * a_h_i(l_sd, iproc)
|
||||||
sdress = c_alpha * a_s2_i(l_sd, iproc)
|
sdress = c_alpha * a_s2_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
|
delta_ij_loc(i, minilist(l_sd), 2) += sdress
|
||||||
end do
|
end do
|
||||||
end do
|
end do
|
||||||
|
|
||||||
|
call add_to_selection_buffer(sb(iproc), alpha, contrib)
|
||||||
|
|
||||||
end subroutine
|
end subroutine
|
||||||
|
|
||||||
|
|
||||||
|
Loading…
Reference in New Issue
Block a user