Fixed MPI parallelism

plugins/Full_CI_ZMQ/pt2_slave.irp.f

@@ -47,7 +47,8 @@ subroutine run_wf
       ! ---------
 
       print *,  'PT2'
-      call zmq_get_psi(zmq_to_qp_run_socket,1,energy,N_states)
+      call zmq_get_psi(zmq_to_qp_run_socket,1)
+      call zmq_get_dvector(zmq_to_qp_run_socket,1,'energy',energy,N_states)
 
       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

plugins/Full_CI_ZMQ/pt2_stoch_routines.irp.f

@@ -61,7 +61,8 @@ subroutine ZMQ_pt2(E, pt2,relative_error, absolute_error, error)
       print *, '========== ================= ================= ================='
       
       call new_parallel_job(zmq_to_qp_run_socket,'pt2')
-      call zmq_put_psi(zmq_to_qp_run_socket,1,pt2_e0_denominator,size(pt2_e0_denominator))
+      call zmq_put_psi(zmq_to_qp_run_socket,1)
+      call zmq_put_dvector(zmq_to_qp_run_socket,1,'energy',pt2_e0_denominator,size(pt2_e0_denominator))
       call create_selection_buffer(1, 1*2, b)
       
       Ncomb=size(comb)

plugins/Full_CI_ZMQ/selection_davidson_slave.irp.f

@@ -54,7 +54,8 @@ subroutine run_wf
 
       print *,  'Selection'
       if (mpi_master) then
-        call zmq_get_psi(zmq_to_qp_run_socket,1,energy,N_states)
+        call zmq_get_psi(zmq_to_qp_run_socket,1)
+        call zmq_get_dvector(zmq_to_qp_run_socket,1,'energy',energy,N_states)
       endif
       call mpi_bcast_psi(energy,N_states)
   
@@ -77,11 +78,13 @@ subroutine run_wf
 
       print *,  'Davidson'
       if (mpi_master) then
-        call zmq_get_psi(zmq_to_qp_run_socket,1,energy,N_states)
+        call zmq_get_psi(zmq_to_qp_run_socket,1)
+        call zmq_get_N_states_diag(zmq_to_qp_run_socket,1)
+        call zmq_get_dvector(zmq_to_qp_run_socket,1,'energy',energy,N_states_diag)
       endif
       double precision :: t0, t1
       call wall_time(t0)
-      call mpi_bcast_psi(energy,N_states)
+      call mpi_bcast_psi(energy,N_states_diag)
       call wall_time(t1)
       call write_double(6,(t1-t0),'Broadcast time')
 
@@ -104,7 +107,8 @@ subroutine run_wf
 
       print *,  'PT2'
       if (mpi_master) then
-        call zmq_get_psi(zmq_to_qp_run_socket,1,energy,N_states)
+        call zmq_get_psi(zmq_to_qp_run_socket,1)
+        call zmq_get_dvector(zmq_to_qp_run_socket,1,'energy',energy,N_states)
       endif
       call mpi_bcast_psi(energy,N_states)
   

plugins/Full_CI_ZMQ/selection_slave.irp.f

@@ -51,7 +51,8 @@ subroutine run_wf
       ! ---------
 
       print *,  'Selection'
-      call zmq_get_psi(zmq_to_qp_run_socket,1,energy,N_states)
+      call zmq_get_psi(zmq_to_qp_run_socket,1)
+      call zmq_get_dvector(zmq_to_qp_run_socket,1,'energy',energy,N_states)
   
       !$OMP PARALLEL PRIVATE(i)
       i = omp_get_thread_num()
@@ -65,7 +66,8 @@ subroutine run_wf
       ! ---
 
       print *,  'PT2'
-      call zmq_get_psi(zmq_to_qp_run_socket,1,energy,N_states)
+      call zmq_get_psi(zmq_to_qp_run_socket,1)
+      call zmq_get_dvector(zmq_to_qp_run_socket,1,'energy',energy,N_states)
   
       logical :: lstop
       lstop = .False.

plugins/Full_CI_ZMQ/zmq_selection.irp.f

@@ -24,7 +24,8 @@ subroutine ZMQ_selection(N_in, pt2)
     PROVIDE psi_bilinear_matrix_transp_order
 
     call new_parallel_job(zmq_to_qp_run_socket,"selection")
-    call zmq_put_psi(zmq_to_qp_run_socket,1,pt2_e0_denominator,size(pt2_e0_denominator))
+    call zmq_put_psi(zmq_to_qp_run_socket,1)
+    call zmq_put_dvector(zmq_to_qp_run_socket,1,'energy',pt2_e0_denominator,size(pt2_e0_denominator))
     call create_selection_buffer(N, N*2, b)
   endif
 

plugins/Selectors_full/zmq.irp.f

@@ -1,4 +1,4 @@
-subroutine zmq_put_psi(zmq_to_qp_run_socket,worker_id, energy, size_energy)
+subroutine zmq_put_psi(zmq_to_qp_run_socket,worker_id)
   use f77_zmq
   implicit none
   BEGIN_DOC
@@ -6,10 +6,6 @@ subroutine zmq_put_psi(zmq_to_qp_run_socket,worker_id, energy, size_energy)
   END_DOC
   integer(ZMQ_PTR), intent(in)   :: zmq_to_qp_run_socket
   integer, intent(in)            :: worker_id
-  integer, intent(in)            :: size_energy
-  double precision, intent(out)  :: energy(size_energy)
-  integer                        :: rc
-  integer*8                      :: rc8
   character*(256)                :: msg
 
   call zmq_put_N_states(zmq_to_qp_run_socket, worker_id)
@@ -19,7 +15,6 @@ subroutine zmq_put_psi(zmq_to_qp_run_socket,worker_id, energy, size_energy)
   call zmq_put_psi_coef(zmq_to_qp_run_socket, worker_id)
   call zmq_put_N_det_generators(zmq_to_qp_run_socket, worker_id)
   call zmq_put_N_det_selectors(zmq_to_qp_run_socket, worker_id)
-  call zmq_put_dvector(zmq_to_qp_run_socket, worker_id, 'energy', energy, size_energy)
 
 end
 
@@ -208,7 +203,7 @@ end
 !---------------------------------------------------------------------------
 
 
-subroutine zmq_get_psi(zmq_to_qp_run_socket, worker_id, energy, size_energy)
+subroutine zmq_get_psi(zmq_to_qp_run_socket, worker_id)
   use f77_zmq
   implicit none
   BEGIN_DOC
@@ -216,10 +211,6 @@ subroutine zmq_get_psi(zmq_to_qp_run_socket, worker_id, energy, size_energy)
   END_DOC
   integer(ZMQ_PTR), intent(in)   :: zmq_to_qp_run_socket
   integer, intent(in)            :: worker_id
-  integer, intent(in)            :: size_energy
-  double precision, intent(out)  :: energy(size_energy)
-  integer                        :: rc
-  integer*8                      :: rc8
   character*(64)                 :: msg
 
   call zmq_get_N_states(zmq_to_qp_run_socket, worker_id)
@@ -237,8 +228,6 @@ subroutine zmq_get_psi(zmq_to_qp_run_socket, worker_id, energy, size_energy)
   call zmq_get_N_det_selectors(zmq_to_qp_run_socket, worker_id)
   TOUCH N_det_selectors
 
-  call zmq_get_dvector(zmq_to_qp_run_socket, worker_id, 'energy', energy, size_energy)
-
 end
 
 
@@ -271,7 +260,7 @@ subroutine zmq_get_psi_det(zmq_to_qp_run_socket, worker_id)
 
   rc8 = f77_zmq_recv8(zmq_to_qp_run_socket,psi_det,int(N_int*2_8*N_det*bit_kind,8),0)
   if (rc8 /= N_int*2_8*N_det*bit_kind) then
-    print *,  irp_here, ': Error getting psi_det'
+    print *,  irp_here, ': Error getting psi_det', rc8, N_int*2_8*N_det*bit_kind
     stop 'error'
   endif
 

src/Davidson/davidson_parallel.irp.f

@@ -90,24 +90,7 @@ subroutine davidson_slave_work(zmq_to_qp_run_socket, zmq_socket_push, N_st, sze,
     integer :: ierr
 
     call broadcast_chunks_double(u_t,size(u_t))
-
     
-    call MPI_BCAST (N_st, 1, MPI_INTEGER, 0, MPI_COMM_WORLD, ierr)
-    if (ierr /= MPI_SUCCESS) then
-      print *,  irp_here//': Unable to broadcast N_st'
-      stop -1
-    endif
-
-    if (.not.mpi_master) then
-      allocate (energy(N_st))
-    endif
-
-    call MPI_BCAST (energy, N_st, MPI_DOUBLE_PRECISION, 0, MPI_COMM_WORLD, ierr)
-    if (ierr /= MPI_SUCCESS) then
-      print *,  irp_here//': Unable to broadcast energy'
-      stop -1
-    endif
-
   IRP_ENDIF
 
   ! Run tasks
@@ -312,9 +295,9 @@ subroutine H_S2_u_0_nstates_zmq(v_0,s_0,u_0,N_st,sze)
   energy = 0.d0
 
   call zmq_put_N_states_diag(zmq_to_qp_run_socket, 1)
-  call zmq_put_psi_det(zmq_to_qp_run_socket, 1)
+  call zmq_put_psi(zmq_to_qp_run_socket,1)
+  call zmq_put_dvector(zmq_to_qp_run_socket,1,'energy',energy,size(energy))
   call zmq_put_dvector(zmq_to_qp_run_socket, 1, 'u_t', u_t, size(u_t))
-  call zmq_put_dvector(zmq_to_qp_run_socket, 1, 'energy', energy, size(energy))
 
   deallocate(u_t)
 

src/Determinants/H_apply_zmq.template.f

@@ -33,7 +33,8 @@ subroutine $subroutine($params_main)
   call new_parallel_job(zmq_to_qp_run_socket,'$subroutine')
   zmq_socket_pair = new_zmq_pair_socket(.True.)
 
-  call zmq_put_psi(zmq_to_qp_run_socket,1,energy,size(energy))
+  call zmq_put_psi(zmq_to_qp_run_socket,1)
+  call zmq_put_dvector(zmq_to_qp_run_socket,1,'energy',energy,size(energy))
 
   do i_generator=1,N_det_generators
     $skip