10
0
mirror of https://github.com/LCPQ/quantum_package synced 2024-06-25 22:52:15 +02:00

More ZMQ threads

This commit is contained in:
Anthony Scemama 2017-04-07 18:58:08 +02:00
parent 93f750d38f
commit 5261a572e7
2 changed files with 16 additions and 0 deletions

View File

@ -47,6 +47,14 @@ let debug str =
let zmq_context =
ZMQ.Context.create ()
let () =
let nproc =
match Sys.getenv "OMP_NUM_THREADS" with
| Some m -> int_of_string m
| None -> 2
in
ZMQ.Context.set_io_threads zmq_context nproc
let bind_socket ~socket_type ~socket ~port =
let rec loop = function

View File

@ -504,6 +504,11 @@ subroutine new_parallel_job(zmq_to_qp_run_socket,name_in)
if (zmq_context == 0_ZMQ_PTR) then
stop 'ZMQ_PTR is null'
endif
rc = f77_zmq_ctx_set(zmq_context, ZMQ_IO_THREADS, nproc)
if (rc /= 0) then
print *, 'Unable to set the number of ZMQ IO threads to', nproc
endif
zmq_to_qp_run_socket = new_zmq_to_qp_run_socket()
name = name_in
sze = len(trim(name))
@ -584,7 +589,10 @@ subroutine end_parallel_job(zmq_to_qp_run_socket,name_in)
zmq_state = 'No_state'
call end_zmq_to_qp_run_socket(zmq_to_qp_run_socket)
call omp_set_lock(zmq_lock)
rc = f77_zmq_ctx_term(zmq_context)
zmq_context = 0_ZMQ_PTR
call omp_unset_lock(zmq_lock)
if (rc /= 0) then
print *, 'Unable to terminate ZMQ context'
stop 'error'