diff --git a/ocaml/TaskServer.ml b/ocaml/TaskServer.ml index 1ec1bf7d..5bf2a5a3 100644 --- a/ocaml/TaskServer.ml +++ b/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 diff --git a/plugins/Full_CI_ZMQ/selection_davidson_slave.irp.f b/plugins/Full_CI_ZMQ/selection_davidson_slave.irp.f index 581e707c..33b3f205 100644 --- a/plugins/Full_CI_ZMQ/selection_davidson_slave.irp.f +++ b/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 (trim(zmq_state) == 'pt2') then + else if (zmq_state(1:3) == '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) diff --git a/src/ZMQ/utils.irp.f b/src/ZMQ/utils.irp.f index a9b692ee..1189803c 100644 --- a/src/ZMQ/utils.irp.f +++ b/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)