Added control ID in zmq_state

ocaml/TaskServer.ml

@@ -106,7 +106,6 @@ let reply_ok rep_socket =
     |> ZMQ.Socket.send rep_socket 
 
 let reply_wrong_state rep_socket =
-    Printf.printf "WRONG STATE\n%!";
     Message.Error_msg.create "Wrong state"
     |> Message.Error_msg.to_string
     |> ZMQ.Socket.send rep_socket 

plugins/Full_CI_ZMQ/selection_davidson_slave.irp.f

@@ -29,7 +29,7 @@ subroutine run_wf
   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(3)
   integer :: rc, i, ierr
   double precision :: t0, t1
   
@@ -44,18 +44,18 @@ subroutine run_wf
 
   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)
       call zmq_get_psi(zmq_to_qp_run_socket,1)
       call zmq_get_dvector(zmq_to_qp_run_socket,1,'energy',energy,N_states)
@@ -70,14 +70,8 @@ subroutine run_wf
       call run_selection_slave(0,i,energy)
       !$OMP END PARALLEL
       print *,  'Selection done'
-      IRP_IF MPI
-        call MPI_BARRIER(MPI_COMM_WORLD, ierr)
-        if (ierr /= MPI_SUCCESS) then
-          print *,  irp_here, 'error in barrier'
-        endif
-      IRP_ENDIF
 
-    else if (trim(zmq_state) == 'davidson') then
+    else if (zmq_state(1:8) == 'davidson') then
 
       ! Davidson
       ! --------
@@ -95,15 +89,8 @@ subroutine run_wf
       call davidson_slave_tcp(0)
       call omp_set_nested(.False.)
       print *,  'Davidson done'
-      IRP_IF MPI
-        call MPI_BARRIER(MPI_COMM_WORLD, ierr)
-        if (ierr /= MPI_SUCCESS) then
-          print *,  irp_here, 'error in barrier'
-        endif
-      IRP_ENDIF
 
-
+    else if (zmq_state(1:3) == 'pt2') then
-    else if (trim(zmq_state) == 'pt2') then
 
       ! PT2
       ! ---
@@ -125,15 +112,16 @@ subroutine run_wf
       call run_pt2_slave(0,i,energy,lstop)
       !$OMP END PARALLEL
       print *,  'PT2 done'
-      IRP_IF MPI
-        call MPI_BARRIER(MPI_COMM_WORLD, ierr)
-        if (ierr /= MPI_SUCCESS) then
-          print *,  irp_here, 'error in barrier'
-        endif
-      IRP_ENDIF
 
     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)

src/ZMQ/utils.irp.f

@@ -526,7 +526,9 @@ subroutine new_parallel_job(zmq_to_qp_run_socket,zmq_socket_pull,name_in)
   integer(ZMQ_PTR),external      :: new_zmq_to_qp_run_socket
   integer(ZMQ_PTR),external      :: new_zmq_pull_socket
   integer(ZMQ_PTR), intent(out)  :: zmq_to_qp_run_socket, zmq_socket_pull
+  integer, save                  :: icount=0
 
+  icount = icount+1
   call omp_set_lock(zmq_lock)
   zmq_context = f77_zmq_ctx_new ()
   call omp_unset_lock(zmq_lock)
@@ -541,7 +543,7 @@ subroutine new_parallel_job(zmq_to_qp_run_socket,zmq_socket_pull,name_in)
 
   zmq_to_qp_run_socket = new_zmq_to_qp_run_socket()
   zmq_socket_pull      = new_zmq_pull_socket ()
-  name = name_in
+  write(name,'(A,I8.8)') trim(name_in)//'.', icount
   sze = len(trim(name))
   call lowercase(name,sze)
   message = 'new_job '//trim(name)//' '//zmq_socket_push_tcp_address//' '//zmq_socket_pull_inproc_address
@@ -604,8 +606,10 @@ subroutine end_parallel_job(zmq_to_qp_run_socket,zmq_socket_pull,name_in)
 
   character*(512)                :: message, name
   integer                        :: i,rc, sze
+  integer, save                  :: icount=0
 
-  name = name_in
+  icount = icount+1
+  write(name,'(A,I8.8)') trim(name_in)//'.', icount
   sze = len(trim(name))
   call lowercase(name,sze)
   if (name /= zmq_state) then
@@ -1209,8 +1213,13 @@ subroutine wait_for_states(state_wait,state,n)
   integer(ZMQ_PTR)               :: zmq_socket_sub
   integer(ZMQ_PTR), external     :: new_zmq_sub_socket
   integer                        :: rc, i
+  integer                        :: sze(n)
   logical                        :: condition
 
+  do i=1,n
+    sze(i) = len(trim(state_wait(i)))
+  enddo
+
   zmq_socket_sub       = new_zmq_sub_socket()
   state = 'Waiting'
   condition = .True.
@@ -1224,7 +1233,7 @@ subroutine wait_for_states(state_wait,state,n)
     endif
     condition = trim(state) /= 'Stopped'
     do i=1,n
-      condition = condition .and. (trim(state) /= trim(state_wait(i)))
+      condition = condition .and. (state(1:sze(i)) /= state_wait(i)(1:sze(i)))
     enddo
   end do
   call end_zmq_sub_socket(zmq_socket_sub)