Added clean context termination to ZMQ

This commit is contained in:
Anthony Scemama 2016-02-22 20:17:48 +01:00
parent d49dcb7d8f
commit d17af2fdc7
3 changed files with 27 additions and 6 deletions

View File

@ -24,10 +24,10 @@ subroutine $subroutine($params_main)
integer(ZMQ_PTR), external :: new_zmq_pair_socket
integer(ZMQ_PTR) :: zmq_socket_pair
zmq_socket_pair = new_zmq_pair_socket(.True.)
integer(ZMQ_PTR) :: zmq_to_qp_run_socket
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)
@ -55,13 +55,9 @@ subroutine $subroutine($params_main)
rc = pthread_join(collector_thread)
call end_zmq_pair_socket(zmq_socket_pair)
call end_parallel_job(zmq_to_qp_run_socket,'$subroutine')
rc = f77_zmq_close(zmq_socket_pair)
if (rc /= 0) then
print *, 'f77_zmq_close(zmq_socket_pair)'
stop 'error'
endif
$copy_buffer
$generate_psi_guess
@ -182,6 +178,7 @@ subroutine $subroutine_slave(thread, iproc)
deallocate( mask, fock_diag_tmp, pt2, norm_pert, H_pert_diag )
call end_zmq_push_socket(zmq_socket_push,thread)
call end_zmq_to_qp_run_socket(zmq_to_qp_run_socket)
end

View File

@ -114,6 +114,7 @@ subroutine ao_bielec_integrals_in_map_slave(thread,iproc)
deallocate( buffer_i, buffer_value )
call disconnect_from_taskserver(zmq_to_qp_run_socket,zmq_socket_push,worker_id)
call end_zmq_to_qp_run_socket(zmq_to_qp_run_socket)
call end_zmq_push_socket(zmq_socket_push,thread)
end

View File

@ -324,6 +324,11 @@ subroutine end_zmq_pair_socket(zmq_socket_pair)
! stop 'error'
! endif
rc = f77_zmq_setsockopt(zmq_socket_pair,ZMQ_LINGER,0,4)
if (rc /= 0) then
stop 'Unable to set ZMQ_LINGER on zmq_socket_pair'
endif
rc = f77_zmq_close(zmq_socket_pair)
if (rc /= 0) then
print *, 'f77_zmq_close(zmq_socket_pair)'
@ -356,6 +361,11 @@ subroutine end_zmq_pull_socket(zmq_socket_pull)
stop 'error'
endif
rc = f77_zmq_setsockopt(zmq_socket_pull,ZMQ_LINGER,0,4)
if (rc /= 0) then
stop 'Unable to set ZMQ_LINGER on zmq_socket_pull'
endif
rc = f77_zmq_close(zmq_socket_pull)
if (rc /= 0) then
print *, 'f77_zmq_close(zmq_socket_pull)'
@ -391,6 +401,11 @@ subroutine end_zmq_push_socket(zmq_socket_push,thread)
endif
rc = f77_zmq_setsockopt(zmq_socket_push,ZMQ_LINGER,0,4)
if (rc /= 0) then
stop 'Unable to set ZMQ_LINGER on push socket'
endif
rc = f77_zmq_close(zmq_socket_push)
if (rc /= 0) then
print *, 'f77_zmq_close(zmq_socket_push)'
@ -423,6 +438,9 @@ subroutine new_parallel_job(zmq_to_qp_run_socket,name_in)
integer(ZMQ_PTR), intent(out) :: zmq_to_qp_run_socket
zmq_context = f77_zmq_ctx_new ()
if (zmq_context == 0_ZMQ_PTR) then
stop 'ZMQ_PTR is null'
endif
zmq_to_qp_run_socket = new_zmq_to_qp_run_socket()
name = name_in
sze = len(trim(name))
@ -685,6 +703,11 @@ subroutine end_zmq_to_qp_run_socket(zmq_to_qp_run_socket)
! stop 'error'
! endif
rc = f77_zmq_setsockopt(zmq_to_qp_run_socket,ZMQ_LINGER,0,4)
if (rc /= 0) then
stop 'Unable to set ZMQ_LINGER on zmq_to_qp_run_socket'
endif
rc = f77_zmq_close(zmq_to_qp_run_socket)
if (rc /= 0) then
print *, 'f77_zmq_close(zmq_to_qp_run_socket)'