LCPQ/quantum_package
10
0
Fork 0
mirror of https://github.com/LCPQ/quantum_package synced 2024-07-23 11:17:33 +02:00
Code Issues Releases Wiki Activity

corrected pt2_find_sample

Browse Source
This commit is contained in:
Yann Garniron 2018-09-03 17:48:04 +02:00
parent a521f0cb82
commit dda0dc34df
1 changed files with 13 additions and 16 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

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

@ -240,28 +240,22 @@ end subroutine
integer function pt2_find_sample(v, w) integer function pt2_find_sample(v, w)
implicit none implicit none
double precision, intent(in) :: v, w(0:N_det_generators) double precision, intent(in) :: v, w(0:N_det_generators)
integer :: i,l,h integer :: i,l,r
integer, parameter :: block=64
l = 0 l = 0
h = N_det_generators r = N_det_generators
do while(h-l >= block) do while(r-l > 1)
i = ishft(h+l,-1) i = (r+l) / 2
if(w(i+1) > v) then if(w(i) < v) then
h = i-1 l = i
else else
l = i+1 r = i
end if end if
end do end do
!DIR$ LOOP COUNT (64)
do pt2_find_sample=l,h
if(w(pt2_find_sample) >= v) then
exit
end if
end do
end function
pt2_find_sample = r
end function
BEGIN_PROVIDER[ integer, pt2_J, (N_det_generators)] BEGIN_PROVIDER[ integer, pt2_J, (N_det_generators)]
@ -284,8 +278,11 @@ end function
d(i) = .true. d(i) = .true.
pt2_J(i) = i pt2_J(i) = i
end do end do
call random_seed(put=(/3211,64,6566,321,65,321,654,65,321,6321,654,65,321,621,654,65,321,65,654,65,321,65/))
call RANDOM_NUMBER(pt2_u) call RANDOM_NUMBER(pt2_u)
call RANDOM_NUMBER(pt2_u)
U = 0 U = 0