LCPQ
/
quantum_package
mirror of https://github.com/LCPQ/quantum_package
10
0
Fork 0
Code Issues Releases Wiki Activity

Added control ID in zmq_state

This commit is contained in:
Anthony Scemama 2017-11-29 12:49:26 +01:00
parent f7831c033a
commit 140a8e30fd
3 changed files with 26 additions and 30 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

1
ocaml/TaskServer.ml
View File

@ -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

40
plugins/Full_CI_ZMQ/selection_davidson_slave.irp.f
View File

@ -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)

15
src/ZMQ/utils.irp.f
View File

@ -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)