diff --git a/plugins/Bk/dressing.irp.f b/plugins/Bk/dressing.irp.f index 7ad7c362..0fbefda5 100644 --- a/plugins/Bk/dressing.irp.f +++ b/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 - c_alpha(i_state) = alpha_h_psi(i_state) / & - (dress_e0_denominator(i_state) - h_alpha_alpha) + 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 diff --git a/plugins/shiftedbk/NEEDED_CHILDREN_MODULES b/plugins/shiftedbk/NEEDED_CHILDREN_MODULES index 5d17e71f..bebf68a2 100644 --- a/plugins/shiftedbk/NEEDED_CHILDREN_MODULES +++ b/plugins/shiftedbk/NEEDED_CHILDREN_MODULES @@ -1 +1 @@ -dress_zmq +dress_zmq DavidsonDressed MRCC_Utils diff --git a/plugins/shiftedbk/shifted_bk.irp.f b/plugins/shiftedbk/shifted_bk.irp.f index 4b9c7433..a2826aae 100644 --- a/plugins/shiftedbk/shifted_bk.irp.f +++ b/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) :: minilist(n_minilist), n_minilist, iproc, i_gen - double precision, intent(inout) :: delta_ij_loc(N_states,N_det,2) + 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 :: 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