From 470ad73484de6d0dc33189f6ee696ae1bd6eb2a5 Mon Sep 17 00:00:00 2001
From: Anthony Scemama <scemama@irsamc.ups-tlse.fr>
Date: Fri, 18 May 2018 23:12:19 +0200
Subject: [PATCH] Fixed bug in MPI multistate

---
 plugins/Full_CI_ZMQ/selection_slave.irp.f | 57 +++++++++++++++++------
 src/Determinants/zmq.irp.f                |  4 +-
 2 files changed, 44 insertions(+), 17 deletions(-)

diff --git a/plugins/Full_CI_ZMQ/selection_slave.irp.f b/plugins/Full_CI_ZMQ/selection_slave.irp.f
index aa749151..c1712b2d 100644
--- a/plugins/Full_CI_ZMQ/selection_slave.irp.f
+++ b/plugins/Full_CI_ZMQ/selection_slave.irp.f
@@ -13,49 +13,60 @@ program selection_slave
 end
 
 subroutine provide_everything
-  PROVIDE H_apply_buffer_allocated mo_bielec_integrals_in_map psi_det_generators psi_coef_generators psi_det_sorted_bit psi_selectors n_det_generators n_states generators_bitmask zmq_context
-  PROVIDE pt2_e0_denominator mo_tot_num N_int fragment_count 
+  PROVIDE H_apply_buffer_allocated mo_bielec_integrals_in_map psi_det_generators psi_coef_generators psi_det_sorted_bit psi_selectors n_det_generators n_states generators_bitmask zmq_context n_states_diag
+  PROVIDE pt2_e0_denominator mo_tot_num N_int fragment_count ci_energy mpi_master zmq_state zmq_context
+  PROVIDE psi_det psi_coef
 end
 
 subroutine run_wf
   use f77_zmq
-
+  
   implicit none
+  IRP_IF MPI
+    include 'mpif.h'
+  IRP_ENDIF
 
   integer(ZMQ_PTR), external :: new_zmq_to_qp_run_socket
   integer(ZMQ_PTR) :: zmq_to_qp_run_socket
   double precision :: energy(N_states)
-  character*(64) :: states(4)
+  character*(64) :: states(2)
   integer :: rc, i, ierr
-
-  integer, external              :: zmq_get_dvector
-  integer, external              :: zmq_get_psi
+  double precision :: t0, t1
   
+  integer, external              :: zmq_get_dvector, zmq_get_N_det_generators 
+  integer, external              :: zmq_get_psi, zmq_get_N_det_selectors
+  integer, external              :: zmq_get_N_states_diag
+
   call provide_everything
   
   zmq_context = f77_zmq_ctx_new ()
   states(1) = 'selection'
-  states(2) = 'davidson'
-  states(3) = 'pt2'
+  states(2) = 'pt2'
 
   zmq_to_qp_run_socket = new_zmq_to_qp_run_socket()
 
   do
 
-    call wait_for_states(states,zmq_state,3)
+    call wait_for_states(states,zmq_state,size(states))
+    print *,  trim(zmq_state)
 
-    if(trim(zmq_state) == 'Stopped') then
+    if(zmq_state(1:7) == 'Stopped') then
 
       exit
 
-    else if (trim(zmq_state) == 'selection') then
+    else if (zmq_state(1:9) == 'selection') then
 
       ! Selection
       ! ---------
 
-      print *,  'Selection'
+      call wall_time(t0)
       if (zmq_get_psi(zmq_to_qp_run_socket,1) == -1) cycle
+      if (zmq_get_N_det_generators (zmq_to_qp_run_socket, 1) == -1) cycle
+      if (zmq_get_N_det_selectors(zmq_to_qp_run_socket, 1) == -1) cycle
       if (zmq_get_dvector(zmq_to_qp_run_socket,1,'energy',energy,N_states) == -1) cycle
+
+      call wall_time(t1)
+      call write_double(6,(t1-t0),'Broadcast time')
   
       !$OMP PARALLEL PRIVATE(i)
       i = omp_get_thread_num()
@@ -63,15 +74,21 @@ subroutine run_wf
       !$OMP END PARALLEL
       print *,  'Selection done'
 
-    else if (trim(zmq_state) == 'pt2') then
+    else if (zmq_state(1:3) == 'pt2') then
 
       ! PT2
       ! ---
 
       print *,  'PT2'
+      call wall_time(t0)
       if (zmq_get_psi(zmq_to_qp_run_socket,1) == -1) cycle
       if (zmq_get_dvector(zmq_to_qp_run_socket,1,'energy',energy,N_states) == -1) cycle
-  
+      if (zmq_get_N_det_generators (zmq_to_qp_run_socket, 1) == -1) cycle
+      if (zmq_get_N_det_selectors(zmq_to_qp_run_socket, 1) == -1) cycle
+
+      call wall_time(t1)
+      call write_double(6,(t1-t0),'Broadcast time')
+
       logical :: lstop
       lstop = .False.
       !$OMP PARALLEL PRIVATE(i)
@@ -82,7 +99,17 @@ subroutine run_wf
 
     endif
 
+    IRP_IF MPI
+      call MPI_BARRIER(MPI_COMM_WORLD, ierr)
+      if (ierr /= MPI_SUCCESS) then
+        print *,  irp_here, 'error in barrier'
+      endif
+    IRP_ENDIF
+
   end do
+  IRP_IF MPI
+    call MPI_finalize(i)
+  IRP_ENDIF
 end
 
 
diff --git a/src/Determinants/zmq.irp.f b/src/Determinants/zmq.irp.f
index 5e42cff5..e8edc1a8 100644
--- a/src/Determinants/zmq.irp.f
+++ b/src/Determinants/zmq.irp.f
@@ -304,7 +304,7 @@ integer function zmq_get_psi_det(zmq_to_qp_run_socket, worker_id)
     if (ierr /= MPI_SUCCESS) then
       stop 'Unable to broadcast zmq_get_psi_det'
     endif
-    call broadcast_chunks_bit_kind(psi_det,N_det*N_int*2)
+    call broadcast_chunks_bit_kind(psi_det,size(psi_det))
   IRP_ENDIF
 
 end
@@ -353,7 +353,7 @@ integer function zmq_get_psi_coef(zmq_to_qp_run_socket, worker_id)
     if (ierr /= MPI_SUCCESS) then
       stop 'Unable to broadcast zmq_get_psi_coef'
     endif
-    call broadcast_chunks_double(psi_coef,N_states*N_det)
+    call broadcast_chunks_double(psi_coef,size(psi_coef))
   IRP_ENDIF
 
 end