10
0
mirror of https://github.com/LCPQ/quantum_package synced 2024-12-25 05:43:47 +01:00
This commit is contained in:
Anthony Scemama 2018-03-07 19:01:19 +01:00
parent b509cb183b
commit 5dabd614f8
3 changed files with 29 additions and 10 deletions

View File

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

View File

@ -1 +1 @@
dress_zmq
dress_zmq DavidsonDressed MRCC_Utils

View File

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