PTEROSOR/QuantumPackage
10
0
Fork 0
mirror of https://github.com/QuantumPackage/qp2.git synced 2024-12-22 20:34:58 +01:00
Code Releases Activity

Fixed bug in singles

Browse Source
This commit is contained in:
Anthony Scemama 2019-10-29 01:22:42 +01:00
parent 634aa4d7a3
commit b7fc1b94a6
2 changed files with 19 additions and 16 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

20
src/cipsi/selection.irp.f
View File

@ -740,6 +740,7 @@ subroutine fill_buffer_double(i_generator, sp, h1, h2, bannedOrb, banned, fock_d
! call occ_pattern_of_det(det,occ,N_int)
! call occ_pattern_to_dets_size(occ,n,elec_alpha_num,N_int)
do istate=1,N_states
delta_E = E0(istate) - Hii + E_shift
alpha_h_psi = mat(istate, p1, p2)
@ -1113,8 +1114,10 @@ subroutine get_d1(gen, phasemask, bannedOrb, banned, mat, mask, h, p, sp, coefs)
call get_mo_two_e_integrals(hfix,pfix,p2,mo_num,hij_cache(1,2),mo_integrals_map)
putj = p1
do puti=1,mo_num
if(lbanned(puti,mi)) cycle
!p1 fixed
if(.not.(banned(putj,puti,bant).or.lbanned(puti,mi))) then
putj = p1
if(.not. banned(putj,puti,bant)) then
hij = hij_cache(puti,2)
if (hij /= 0.d0) then
hij = hij * get_phase_bi(phasemask, ma, mi, hfix, p2, puti, pfix, N_int)
@ -1123,11 +1126,9 @@ subroutine get_d1(gen, phasemask, bannedOrb, banned, mat, mask, h, p, sp, coefs)
enddo
endif
end if
enddo
putj = p2
do puti=1,mo_num
if(.not.(banned(putj,puti,bant)).or.(lbanned(puti,mi))) then
if(.not. banned(putj,puti,bant)) then
hij = hij_cache(puti,1)
if (hij /= 0.d0) then
hij = hij * get_phase_bi(phasemask, ma, mi, hfix, p1, puti, pfix, N_int)
@ -1190,8 +1191,9 @@ subroutine get_d1(gen, phasemask, bannedOrb, banned, mat, mask, h, p, sp, coefs)
call get_mo_two_e_integrals(hfix,p2,pfix,mo_num,hij_cache(1,2),mo_integrals_map)
putj = p2
do puti=1,mo_num
if(.not. banned(puti,putj,1)) then
if(lbanned(puti,ma)) cycle
putj = p2
if(.not. banned(puti,putj,1)) then
hij = hij_cache(puti,1)
if (hij /= 0.d0) then
hij = hij * get_phase_bi(phasemask, mi, ma, hfix, pfix, puti, p1, N_int)
@ -1200,12 +1202,9 @@ subroutine get_d1(gen, phasemask, bannedOrb, banned, mat, mask, h, p, sp, coefs)
enddo
endif
end if
enddo
putj = p1
do puti=1,mo_num
if(.not. banned(puti,putj,1)) then
if(lbanned(puti,ma)) cycle
hij = hij_cache(puti,2)
if (hij /= 0.d0) then
hij = hij * get_phase_bi(phasemask, mi, ma, hfix, pfix, puti, p2, N_int)
@ -1234,12 +1233,11 @@ subroutine get_d1(gen, phasemask, bannedOrb, banned, mat, mask, h, p, sp, coefs)
do i1=1,p(0,s1)
ib = 1
p1 = p(i1,s1)
if(s1 == s2) ib = i1+1
if(bannedOrb(p1, s1)) cycle
do i2=ib,p(0,s2)
p1 = p(i1,s1)
p2 = p(i2,s2)
if(bannedOrb(p2, s2) .or. banned(p1, p2, 1)) cycle
if(bannedOrb(p1, s1) .or. bannedOrb(p2, s2) .or. banned(p1, p2, 1)) cycle
call apply_particles(mask, s1, p1, s2, p2, det, ok, N_int)
call i_h_j(gen, det, N_int, hij)
mat(:, p1, p2) = mat(:, p1, p2) + coefs(:) * hij

7
src/mo_two_e_ints/map_integrals.irp.f
View File

@ -145,7 +145,6 @@ subroutine get_mo_two_e_integrals(j,k,l,sze,out_val,map)
type(map_type), intent(inout) :: map
integer :: i
double precision, external :: get_two_e_integral
PROVIDE mo_two_e_integrals_in_map mo_integrals_cache
integer :: ii, ii0
integer*8 :: ii_8, ii0_8
@ -154,6 +153,12 @@ subroutine get_mo_two_e_integrals(j,k,l,sze,out_val,map)
integer(key_kind) :: p,q,r,s,i2
PROVIDE mo_two_e_integrals_in_map mo_integrals_cache
!TODO
do i=1,sze
out_val(i) = get_two_e_integral(i,j,k,l,map)
enddo
return
ii0 = l-mo_integrals_cache_min
ii0 = ior(ii0, k-mo_integrals_cache_min)
ii0 = ior(ii0, j-mo_integrals_cache_min)