From ff2dcf069ecfb908b9e9ed72387906885f893bf6 Mon Sep 17 00:00:00 2001
From: Anthony Scemama <scemama@irsamc.ups-tlse.fr>
Date: Wed, 3 Aug 2016 00:18:53 +0200
Subject: [PATCH] Multiple generators per task

---
 plugins/Full_CI_ZMQ/fci_zmq.irp.f         | 12 ++++++++--
 plugins/Full_CI_ZMQ/selection.irp.f       |  8 ++++---
 plugins/Full_CI_ZMQ/selection_slave.irp.f |  2 --
 plugins/MRCC_Utils/mrcc_utils.irp.f       | 28 ++++++++++++++++++++---
 plugins/mrcepa0/dressing.irp.f            |  2 +-
 5 files changed, 41 insertions(+), 11 deletions(-)

diff --git a/plugins/Full_CI_ZMQ/fci_zmq.irp.f b/plugins/Full_CI_ZMQ/fci_zmq.irp.f
index 02461ee3..0577a408 100644
--- a/plugins/Full_CI_ZMQ/fci_zmq.irp.f
+++ b/plugins/Full_CI_ZMQ/fci_zmq.irp.f
@@ -132,8 +132,16 @@ subroutine ZMQ_selection(N, pt2)
   call zmq_put_psi(zmq_to_qp_run_socket,1,ci_electronic_energy,size(ci_electronic_energy))
   call zmq_set_running(zmq_to_qp_run_socket)
   call create_selection_buffer(N, N*2, b)
-  do i= N_det_generators, 1, -1
-    write(task,*) i, N
+
+  integer :: i_generator, i_generator_start, i_generator_max, step
+!  step = int(max(1.,10*elec_num/mo_tot_num)
+
+  step = int(10000000.d0 / dble(N_int * N_states * elec_num * elec_num * mo_tot_num * mo_tot_num ))
+  step = max(1,step)
+  do i= N_det_generators, 1, -step
+    i_generator_start = max(i-step+1,1)
+    i_generator_max = i
+    write(task,*) i_generator_start, i_generator_max, 1, N
     call add_task_to_taskserver(zmq_to_qp_run_socket,task)
   end do
 
diff --git a/plugins/Full_CI_ZMQ/selection.irp.f b/plugins/Full_CI_ZMQ/selection.irp.f
index 13dcdc26..b31e1977 100644
--- a/plugins/Full_CI_ZMQ/selection.irp.f
+++ b/plugins/Full_CI_ZMQ/selection.irp.f
@@ -53,8 +53,8 @@ subroutine selection_slaved(thread,iproc,energy)
     if (done) then
       ctask = ctask - 1
     else
-      integer :: i_generator, N
-      read (task,*) i_generator, N
+      integer :: i_generator, i_generator_start, i_generator_max, step, N
+      read (task,*) i_generator_start, i_generator_max, step, N
       if(buf%N == 0) then
         ! Only first time 
         call create_selection_buffer(N, N*2, buf)
@@ -64,7 +64,9 @@ subroutine selection_slaved(thread,iproc,energy)
       end if
       !print *, "psi_selectors_coef ", psi_selectors_coef(N_det_selectors-5:N_det_selectors, 1)
       !call debug_det(psi_selectors(1,1,N_det_selectors), N_int)
-      call select_connected(i_generator,energy,pt2,buf)
+      do i_generator=i_generator_start,i_generator_max,step
+        call select_connected(i_generator,energy,pt2,buf)
+      enddo
     endif
 
     if(done .or. ctask == size(task_id)) then
diff --git a/plugins/Full_CI_ZMQ/selection_slave.irp.f b/plugins/Full_CI_ZMQ/selection_slave.irp.f
index bdb76db4..7eeae798 100644
--- a/plugins/Full_CI_ZMQ/selection_slave.irp.f
+++ b/plugins/Full_CI_ZMQ/selection_slave.irp.f
@@ -25,9 +25,7 @@ subroutine run_wf
   integer(ZMQ_PTR) :: zmq_to_qp_run_socket
   double precision :: energy(N_states_diag)
   character*(64) :: state
-  integer :: oki
   
-  oki = 0
   call provide_everything
   
   zmq_context = f77_zmq_ctx_new ()
diff --git a/plugins/MRCC_Utils/mrcc_utils.irp.f b/plugins/MRCC_Utils/mrcc_utils.irp.f
index 4b6203cb..1d12d569 100644
--- a/plugins/MRCC_Utils/mrcc_utils.irp.f
+++ b/plugins/MRCC_Utils/mrcc_utils.irp.f
@@ -718,10 +718,32 @@ END_PROVIDER
      
      dIj_unique(:size(X), s) = X(:)
      
-     do i=1,N_det_non_ref
-       rho_mrcc(i,s) = psi_non_ref_coef(i,s) / rho_mrcc(i,s)
+     norm = 0.d0
+     do i=1,N_det_ref
+       norm = norm + psi_ref_coef(i,s)*psi_ref_coef(i,s)
      enddo
-     
+     double precision :: f
+     do i=1,N_det_non_ref
+       f = psi_non_ref_coef(i,s) / rho_mrcc(i,s)
+       ! Avoid numerical instabilities
+       f = min(f, 3.d0)
+       f = max(f,-3.d0)
+!       norm = norm + (psi_non_ref_coef(i,s) * f * rho_mrcc(i,s))
+       norm = norm + ( f * rho_mrcc(i,s))**2
+       rho_mrcc(i,s) = f
+     enddo
+
+     print *,  '<Psi | (1+T) Psi_0> = ', norm
+
+     f = 1.d0/norm
+     norm = 0.d0
+     do i=1,N_det_ref
+       norm = norm + psi_ref_coef(i,s)*psi_ref_coef(i,s)
+     enddo
+     do i=1,N_det_non_ref
+       rho_mrcc(i,s) = rho_mrcc(i,s) * f
+     enddo
+
    end do
    
    print *, "done"
diff --git a/plugins/mrcepa0/dressing.irp.f b/plugins/mrcepa0/dressing.irp.f
index 3a91f42e..88cd2c85 100644
--- a/plugins/mrcepa0/dressing.irp.f
+++ b/plugins/mrcepa0/dressing.irp.f
@@ -23,7 +23,7 @@ use bitmasks
   do gen= 1, N_det_generators
     allocate(buf(N_int, 2, N_det_non_ref))
     iproc = omp_get_thread_num() + 1
-    if(mod(gen, 10) == 0) print *, "mrcc ", gen, "/", N_det_generators
+    if(mod(gen, 1000) == 0) print *, "mrcc ", gen, "/", N_det_generators
     do h=1, hh_shortcut(0)
       call apply_hole(psi_det_generators(1,1,gen), hh_exists(1, h), mask, ok, N_int)
       if(.not. ok) cycle