diff --git a/plugins/Full_CI_ZMQ/run_selection_slave.irp.f b/plugins/Full_CI_ZMQ/run_selection_slave.irp.f index 9ea942a5..bfc099e2 100644 --- a/plugins/Full_CI_ZMQ/run_selection_slave.irp.f +++ b/plugins/Full_CI_ZMQ/run_selection_slave.irp.f @@ -61,6 +61,9 @@ subroutine run_selection_slave(thread,iproc,energy) call push_selection_results(zmq_socket_push, pt2, buf, task_id(1), ctask) do i=1,buf%cur call add_to_selection_buffer(buf2, buf%det(1,1,i), buf%val(i)) + if (buf2%cur == buf2%N) then + call sort_selection_buffer(buf2) + endif enddo buf%mini = buf2%mini pt2 = 0d0 diff --git a/plugins/Full_CI_ZMQ/selection_buffer.irp.f b/plugins/Full_CI_ZMQ/selection_buffer.irp.f index 28ceaae3..8a067357 100644 --- a/plugins/Full_CI_ZMQ/selection_buffer.irp.f +++ b/plugins/Full_CI_ZMQ/selection_buffer.irp.f @@ -41,6 +41,7 @@ subroutine sort_selection_buffer(b) implicit none type(selection_buffer), intent(inout) :: b + double precision, allocatable:: absval(:) integer, allocatable :: iorder(:) double precision, pointer :: vals(:) integer(bit_kind), pointer :: detmp(:,:,:) @@ -48,23 +49,25 @@ subroutine sort_selection_buffer(b) logical, external :: detEq nmwen = min(b%N, b%cur) - allocate(iorder(b%cur), detmp(N_int, 2, size(b%det,3)), vals(size(b%val))) + + allocate(iorder(b%cur), detmp(N_int, 2, size(b%det,3)), absval(b%cur), vals(size(b%val))) + absval = -dabs(b%val(:b%cur)) do i=1,b%cur iorder(i) = i end do - call dsort(b%val, iorder, b%cur) + call dsort(absval, iorder, b%cur) do i=1, nmwen detmp(1:N_int,1,i) = b%det(1:N_int,1,iorder(i)) detmp(1:N_int,2,i) = b%det(1:N_int,2,iorder(i)) vals(i) = b%val(iorder(i)) end do - if (nmwen < b%N) then - vals(nmwen+1) = 0.d0 - endif + do i=nmwen+1, size(vals) + vals(i) = 0.d0 + enddo deallocate(b%det, b%val) b%det => detmp b%val => vals - b%mini = min(b%mini,b%val(1)) + b%mini = max(b%mini,dabs(b%val(b%N))) b%cur = nmwen end subroutine diff --git a/src/Utils/sort.irp.f b/src/Utils/sort.irp.f index f31627f0..7572bc27 100644 --- a/src/Utils/sort.irp.f +++ b/src/Utils/sort.irp.f @@ -15,17 +15,18 @@ BEGIN_TEMPLATE do i=2,isize xtmp = x(i) i0 = iorder(i) - do j = i-1,1,-1 + j=i-1 + do while (j>0) if ((x(j) <= xtmp)) exit x(j+1) = x(j) iorder(j+1) = iorder(j) + j=j-1 enddo x(j+1) = xtmp iorder(j+1) = i0 enddo end subroutine insertion_$Xsort - subroutine heap_$Xsort(x,iorder,isize) implicit none BEGIN_DOC @@ -314,15 +315,15 @@ BEGIN_TEMPLATE $type :: xtmp integer*8 :: i, i0, j, jmax - do i=1_8,isize + do i=2_8,isize xtmp = x(i) i0 = iorder(i) j = i-1_8 - do while (x(j)0_8) + if (x(j)<=xtmp) exit x(j+1_8) = x(j) iorder(j+1_8) = iorder(j) j = j-1_8 - if (j<1_8) exit enddo x(j+1_8) = xtmp iorder(j+1_8) = i0