mirror of
https://github.com/LCPQ/quantum_package
synced 2024-12-23 04:43:50 +01:00
Corrected bug in pt2_find
This commit is contained in:
parent
832585a6ca
commit
ca0f0732c2
@ -276,17 +276,17 @@ subroutine pt2_collector(b, tbc, comb, Ncomb, computed, pt2_detail, sumabove, su
|
|||||||
call sort_selection_buffer(b)
|
call sort_selection_buffer(b)
|
||||||
end subroutine
|
end subroutine
|
||||||
|
|
||||||
|
|
||||||
integer function pt2_find(v, w, sze, imin, imax)
|
integer function pt2_find(v, w, sze, imin, imax)
|
||||||
implicit none
|
implicit none
|
||||||
integer, intent(in) :: sze, imin, imax
|
integer, intent(in) :: sze, imin, imax
|
||||||
double precision, intent(in) :: v, w(sze)
|
double precision, intent(in) :: v, w(sze)
|
||||||
integer :: i,l,h
|
integer :: i,l,h
|
||||||
|
integer, parameter :: block=64
|
||||||
|
|
||||||
l = imin
|
l = imin
|
||||||
h = imax
|
h = imax-1
|
||||||
|
|
||||||
do while(h-l > 4)
|
do while(h-l >= block)
|
||||||
i = ishft(h+l,-1)
|
i = ishft(h+l,-1)
|
||||||
if(w(i+1) > v) then
|
if(w(i+1) > v) then
|
||||||
h = i-1
|
h = i-1
|
||||||
@ -294,14 +294,12 @@ integer function pt2_find(v, w, sze, imin, imax)
|
|||||||
l = i+1
|
l = i+1
|
||||||
end if
|
end if
|
||||||
end do
|
end do
|
||||||
do i=l,h
|
!DIR$ LOOP COUNT (64)
|
||||||
if ( w(i) <= v) then
|
do pt2_find=l,min(l+block,h)
|
||||||
cycle
|
if(w(pt2_find+1) > v) then
|
||||||
else
|
exit
|
||||||
pt2_find = i-1
|
end if
|
||||||
return
|
end do
|
||||||
endif
|
|
||||||
enddo
|
|
||||||
end function
|
end function
|
||||||
|
|
||||||
|
|
||||||
|
Loading…
Reference in New Issue
Block a user