unfinished shifted_bk stochastic selection - no undressing

plugins/dress_zmq/dress_general.irp.f

@@ -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
 

plugins/dress_zmq/dressing.irp.f

@@ -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) ]
+  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_tmp(:,:,1) = del(:,:)
-  delta_ij(:,:,2) = del_s2(:,:)
+  delta_ij_tmp(:,:,2) = del_s2(:,:)
 
   deallocate(dress, del, del_s2)
-  
+  end if
 END_PROVIDER
 
 

plugins/shiftedbk/shifted_bk_routines.irp.f

@@ -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