From 95893b861d78d579324df3f8c38c6039149c9cae Mon Sep 17 00:00:00 2001
From: Anthony Scemama <scemama@irsamc.ups-tlse.fr>
Date: Wed, 23 May 2018 13:49:37 +0200
Subject: [PATCH] fragmented selection

---
 plugins/Full_CI_ZMQ/run_selection_slave.irp.f |  6 +--
 plugins/Full_CI_ZMQ/zmq_selection.irp.f       | 46 +++++++++++++------
 2 files changed, 34 insertions(+), 18 deletions(-)

diff --git a/plugins/Full_CI_ZMQ/run_selection_slave.irp.f b/plugins/Full_CI_ZMQ/run_selection_slave.irp.f
index 464f0a9f..3f0e6865 100644
--- a/plugins/Full_CI_ZMQ/run_selection_slave.irp.f
+++ b/plugins/Full_CI_ZMQ/run_selection_slave.irp.f
@@ -50,8 +50,8 @@ subroutine run_selection_slave(thread,iproc,energy)
     if (done) then
       ctask = ctask - 1
     else
-      integer :: i_generator, N
-      read(task,*) i_generator, N
+      integer :: i_generator, N, subset
+      read(task,*) subset, i_generator, N
       if(buf%N == 0) then
         ! Only first time 
         call create_selection_buffer(N, N*2, buf)
@@ -60,7 +60,7 @@ subroutine run_selection_slave(thread,iproc,energy)
       else
         ASSERT (N == buf%N)
       end if
-      call select_connected(i_generator,energy,pt2,buf,0)
+      call select_connected(i_generator,energy,pt2,buf,subset)
     endif
 
     integer, external :: task_done_to_taskserver
diff --git a/plugins/Full_CI_ZMQ/zmq_selection.irp.f b/plugins/Full_CI_ZMQ/zmq_selection.irp.f
index fec28ba7..77a1457f 100644
--- a/plugins/Full_CI_ZMQ/zmq_selection.irp.f
+++ b/plugins/Full_CI_ZMQ/zmq_selection.irp.f
@@ -10,7 +10,6 @@ subroutine ZMQ_selection(N_in, pt2)
   integer                        :: i, N
   integer, external              :: omp_get_thread_num
   double precision, intent(out)  :: pt2(N_states)
-  integer, parameter             :: maxtasks=10000
   
   
   PROVIDE fragment_count
@@ -21,7 +20,7 @@ subroutine ZMQ_selection(N_in, pt2)
     PROVIDE psi_bilinear_matrix_columns_loc psi_det_alpha_unique psi_det_beta_unique
     PROVIDE psi_bilinear_matrix_rows psi_det_sorted_order psi_bilinear_matrix_order
     PROVIDE psi_bilinear_matrix_transp_rows_loc psi_bilinear_matrix_transp_columns
-    PROVIDE psi_bilinear_matrix_transp_order
+    PROVIDE psi_bilinear_matrix_transp_order fragment_count
 
     call new_parallel_job(zmq_to_qp_run_socket,zmq_socket_pull,'selection')
 
@@ -46,26 +45,40 @@ subroutine ZMQ_selection(N_in, pt2)
   endif
 
   integer, external :: add_task_to_taskserver
-  character*(20*maxtasks) :: task
+  character(len=64000)           :: task
+  integer :: j,k,ipos
+  ipos=1
   task = ' ' 
 
-  integer :: k
-  k=0
   do i= 1, N_det_generators
-    k = k+1
-    write(task(20*(k-1)+1:20*k),'(I9,1X,I9,''|'')') i, N
-    if (k>=maxtasks) then
-       k=0
-       if (add_task_to_taskserver(zmq_to_qp_run_socket,task) == -1) then
-         stop 'Unable to add task to task server'
-       endif
+    if (i>ishft(N_det_generators,-7)) then
+      write(task(ipos:ipos+30),'(I9,1X,I9,1X,I9,''|'')') 0, i, N
+      ipos += 30
+      if (ipos > 63970) then
+        if (add_task_to_taskserver(zmq_to_qp_run_socket,trim(task(1:ipos))) == -1) then
+          stop 'Unable to add task to task server'
+        endif
+        ipos=1
+      endif
+    else
+      do j=1,fragment_count
+        write(task(ipos:ipos+30),'(I9,1X,I9,1X,I9,''|'')') j, i, N
+        ipos += 30
+        if (ipos > 63970) then
+          if (add_task_to_taskserver(zmq_to_qp_run_socket,trim(task(1:ipos))) == -1) then
+            stop 'Unable to add task to task server'
+          endif
+          ipos=1
+        endif
+      end do
     endif
-  end do
-  if (k > 0) then
-    if (add_task_to_taskserver(zmq_to_qp_run_socket,task) == -1) then
+  enddo
+  if (ipos > 1) then
+    if (add_task_to_taskserver(zmq_to_qp_run_socket,trim(task(1:ipos))) == -1) then
       stop 'Unable to add task to task server'
     endif
   endif
+  
 
   ASSERT (associated(b%det))
   ASSERT (associated(b%val))
@@ -130,6 +143,9 @@ subroutine selection_collector(zmq_socket_pull, b, N, pt2)
   integer(bit_kind), pointer :: det(:,:,:)
   integer, allocatable :: task_id(:)
   type(selection_buffer) :: b2
+  
+  
+  
 
   zmq_to_qp_run_socket = new_zmq_to_qp_run_socket()
   call create_selection_buffer(N, N*2, b2)