Bk

plugins/Bk/dressing.irp.f

@@ -1,3 +1,13 @@
+ BEGIN_PROVIDER [ double precision, fock_diag_tmp_, (2,mo_tot_num+1,Nproc) ]
+&BEGIN_PROVIDER [ integer, current_generator_, (Nproc) ]
+  implicit none
+  BEGIN_DOC
+! Temporary arrays for speedup
+  END_DOC
+  current_generator_(:) = 0
+ END_PROVIDER
+
+
 subroutine dress_with_alpha_buffer(Nstates,Ndet,Nint,delta_ij_loc, i_gen, minilist, det_minilist, n_minilist, alpha, iproc)
  use bitmasks
  implicit none
@@ -17,14 +27,23 @@ subroutine dress_with_alpha_buffer(Nstates,Ndet,Nint,delta_ij_loc, i_gen, minili
   double precision :: c_alpha(N_states), h_alpha_alpha, hdress, sdress
   double precision :: i_h_alpha, i_s_alpha, alpha_h_psi(N_states)
 
-  double precision, external :: diag_H_mat_elem
+  double precision, external :: diag_H_mat_elem_fock
 
-  h_alpha_alpha = diag_h_mat_elem(alpha,N_int)
+  if(current_generator_(iproc) /= i_gen) then
+    current_generator_(iproc) = i_gen
+    call build_fock_tmp(fock_diag_tmp_(1,1,iproc),psi_det_generators(1,1,i_gen),N_int)
+  end if
+
+  h_alpha_alpha = diag_H_mat_elem_fock(psi_det_generators(1,1,i_gen),alpha,fock_diag_tmp_(1,1,iproc),N_int)
   call i_H_psi_minilist(alpha,det_minilist,minilist,n_minilist,psi_coef,N_int,n_minilist,size(psi_coef,1),N_states,alpha_h_psi)
 
   do i_state=1,N_states
+    if (h_alpha_alpha - dress_e0_denominator(i_state) > 0.1d0 ) then
       c_alpha(i_state) = alpha_h_psi(i_state) / &
         (dress_e0_denominator(i_state) - h_alpha_alpha) 
+    else
+      c_alpha(i_state) = 0.d0
+    endif
   enddo
 
   do j_mini=1,n_minilist

plugins/shiftedbk/NEEDED_CHILDREN_MODULES

@@ -1 +1 @@
-dress_zmq
+dress_zmq DavidsonDressed MRCC_Utils

plugins/shiftedbk/shifted_bk.irp.f

@@ -16,7 +16,7 @@ end
 
 
 
-subroutine dress_with_alpha_buffer(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
  implicit none
   BEGIN_DOC
@@ -27,16 +27,16 @@ subroutine dress_with_alpha_buffer(delta_ij_loc, i_gen, minilist, det_minilist,
   !n_minilist : size of minilist
   !alpha : alpha determinant
   END_DOC
-  integer(bit_kind), intent(in)   :: alpha(N_int,2), det_minilist(N_int, 2, n_minilist)
+  integer, intent(in)             :: Nint, Ndet, Nstates, n_minilist, iproc, i_gen
-  integer,intent(in)              :: minilist(n_minilist), n_minilist, iproc, i_gen
+  integer(bit_kind), intent(in)   :: alpha(Nint,2), det_minilist(Nint, 2, n_minilist)
-  double precision, intent(inout) :: delta_ij_loc(N_states,N_det,2)
+  integer,intent(in)              :: minilist(n_minilist)
+  double precision, intent(inout) :: delta_ij_loc(Nstates,N_det,2)
   double precision :: hii, hij, sij, delta_e
   double precision, external :: diag_H_mat_elem_fock
   integer                        :: i,j,k,l,m, l_sd
   double precision, save :: tot = 0d0
   double precision :: de(N_states), val, tmp
   
-  stop "shiftedbk currently does not work"
 
   if(current_generator_(iproc) /= i_gen) then
     current_generator_(iproc) = i_gen