LCPQ/quantum_package
10
0
Fork 0
mirror of https://github.com/LCPQ/quantum_package synced 2024-07-03 01:45:59 +02:00
Code Issues Releases Wiki Activity

Corrected bug in pt2_find

Browse Source
This commit is contained in:
Anthony Scemama 2017-02-01 16:35:47 +01:00
parent 832585a6ca
commit ca0f0732c2
1 changed files with 9 additions and 11 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

20
plugins/Full_CI_ZMQ/pt2_stoch_routines.irp.f
View File

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