quantum_package/plugins/shiftedbk/shifted_bk_routines.irp.f

 BEGIN_PROVIDER [ double precision, fock_diag_tmp_, (2,mo_tot_num+1,Nproc) ]
&BEGIN_PROVIDER [ double precision, a_h_i, (N_det, Nproc) ]
&BEGIN_PROVIDER [ double precision, a_s2_i, (N_det, Nproc) ]
   implicit none
   integer                        :: i
   
   fock_diag_tmp_(:,:,:) = 0.d0
   a_h_i = 0d0
   a_s2_i = 0d0
END_PROVIDER


subroutine generator_start(i_gen, iproc)
  implicit none
  integer, intent(in) :: i_gen, iproc
  integer :: i
  
  call build_fock_tmp(fock_diag_tmp_(1,1,iproc),psi_det_generators(1,1,i_gen),N_int)
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
  BEGIN_DOC
  !delta_ij_loc(:,:,1) : dressing column for H
  !delta_ij_loc(:,:,2) : dressing column for S2
  !i_gen : generator index in psi_det_generators
  !minilist : indices of determinants connected to alpha ( in psi_det )
  !n_minilist : size of minilist
  !alpha : alpha determinant
  END_DOC
  integer, intent(in)             :: Nint, Ndet, Nstates, n_minilist, iproc, i_gen
  integer(bit_kind), intent(in)   :: alpha(Nint,2), det_minilist(Nint, 2, n_minilist)
  integer,intent(in)              :: minilist(n_minilist)
  double precision, intent(inout) :: delta_ij_loc(Nstates,N_det,2)
  double precision :: hij, sij
  double precision, external :: diag_H_mat_elem_fock
  double precision :: haa, contrib, c_alpha(N_states)
  double precision :: de, a_h_psi(N_states)
  double precision :: hdress, sdress
  integer :: i, l_sd

  
  haa =  diag_H_mat_elem_fock(psi_det_generators(1,1,i_gen),alpha,fock_diag_tmp_(1,1,iproc),N_int)

  a_h_psi = 0d0
  

  do l_sd=1,n_minilist
    call i_h_j_s2(alpha,det_minilist(1,1,l_sd),N_int,hij, sij)
    a_h_i(l_sd, iproc) = hij
    a_s2_i(l_sd, iproc) = sij
    do i=1,Nstates
      a_h_psi(i) += hij * psi_coef(minilist(l_sd), i)
    end do
  end do

  contrib = 0d0

  do i=1,Nstates
    de = dress_E0_denominator(i) - haa
    if(DABS(de) < 1D-5) cycle

    c_alpha(i) = a_h_psi(i) / de
    contrib = min(contrib, c_alpha(i) * a_h_psi(i))
    
    do l_sd=1,n_minilist
      hdress = c_alpha(i) * a_h_i(l_sd, iproc)
      sdress = c_alpha(i) * a_s2_i(l_sd, iproc)
      delta_ij_loc(i, minilist(l_sd), 1) += hdress
      delta_ij_loc(i, minilist(l_sd), 2) += sdress
    end do
  end do

end subroutine


BEGIN_PROVIDER [ logical, initialize_E0_denominator ]
 implicit none
 BEGIN_DOC
 ! If true, initialize pt2_E0_denominator
 END_DOC
 initialize_E0_denominator = .True.
END_PROVIDER