LCPQ/quantum_package
10
0
Fork 0
mirror of https://github.com/LCPQ/quantum_package synced 2024-12-22 12:23:48 +01:00
Code Issues Releases Wiki Activity

Parallelism OK with 50 nodes

Browse Source
This commit is contained in:
Anthony Scemama 2017-11-29 19:10:27 +01:00
parent db0e74bf37
commit 2e5752f8f5
9 changed files with 183 additions and 166 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

2
config/ifort_mpi.cfg
View File

@ -9,7 +9,7 @@
FC : mpiifort FC : mpiifort
LAPACK_LIB : -mkl=parallel LAPACK_LIB : -mkl=parallel
IRPF90 : irpf90 IRPF90 : irpf90
IRPF90_FLAGS : --ninja --align=32 -DMPI -DZMQ_PUSH IRPF90_FLAGS : --ninja --align=32 -DMPI
# Global options # Global options
################ ################

148
ocaml/TaskServer.ml
View File

@ -21,13 +21,14 @@ let string_of_pub_state = function
type t = type t =
{ {
queue : Queuing_system.t ; queue : Queuing_system.t ;
state : Message.State.t option ; state : Message.State.t option ;
address_tcp : Address.Tcp.t option ; address_tcp : Address.Tcp.t option ;
address_inproc : Address.Inproc.t option ; address_inproc : Address.Inproc.t option ;
progress_bar : Progress_bar.t option ; progress_bar : Progress_bar.t option ;
running : bool; running : bool;
data : (string, string) Hashtbl.t; accepting_clients : bool;
data : (string, string) Hashtbl.t;
} }
@ -159,6 +160,7 @@ let new_job msg program_state rep_socket pair_socket =
progress_bar = Some progress_bar ; progress_bar = Some progress_bar ;
address_tcp = Some msg.Message.Newjob_msg.address_tcp; address_tcp = Some msg.Message.Newjob_msg.address_tcp;
address_inproc = Some msg.Message.Newjob_msg.address_inproc; address_inproc = Some msg.Message.Newjob_msg.address_inproc;
accepting_clients = true;
} }
in in
reply_ok rep_socket; reply_ok rep_socket;
@ -198,9 +200,15 @@ let end_job msg program_state rep_socket pair_socket =
and success () = and success () =
reply_ok rep_socket; reply_ok rep_socket;
{ program_state with {
state = None ; queue = Queuing_system.create ();
progress_bar = Progress_bar.clear (); state = None ;
progress_bar = Progress_bar.clear ();
address_tcp = None;
address_inproc = None;
running = true;
accepting_clients = false;
data = Hashtbl.create ~hashable:String.hashable ();
} }
and wait n = and wait n =
@ -215,7 +223,7 @@ let end_job msg program_state rep_socket pair_socket =
| None -> failure () | None -> failure ()
| Some state -> | Some state ->
begin begin
if (state = force_state) then if (msg.Message.Endjob_msg.state = force_state) then
begin begin
string_of_pub_state Waiting string_of_pub_state Waiting
|> ZMQ.Socket.send pair_socket ; |> ZMQ.Socket.send pair_socket ;
@ -231,48 +239,50 @@ let end_job msg program_state rep_socket pair_socket =
wait (Queuing_system.number_of_clients program_state.queue) wait (Queuing_system.number_of_clients program_state.queue)
end end
else else
(
Printf.eprintf "STATE:%s%!" (Message.State.to_string state);
failure () failure ()
)
end end
let connect msg program_state rep_socket = let connect msg program_state rep_socket =
let state = let failure () =
match program_state.state with reply_wrong_state rep_socket;
| Some state -> state program_state
| None -> assert false
in in
let push_address = if (not program_state.accepting_clients) then
match msg with failure ()
| Message.Connect_msg.Tcp -> else
begin match program_state.state with
match program_state.address_tcp with | None -> failure ()
| Some address -> Address.Tcp address | Some state ->
| None -> failwith "Error: No TCP address" let push_address =
end match msg with
| Message.Connect_msg.Inproc -> | Message.Connect_msg.Tcp ->
begin begin
match program_state.address_inproc with match program_state.address_tcp with
| Some address -> Address.Inproc address | Some address -> Address.Tcp address
| None -> failwith "Error: No inproc address" | None -> failwith "Error: No TCP address"
end end
| Message.Connect_msg.Ipc -> assert false | Message.Connect_msg.Inproc ->
in begin
match program_state.address_inproc with
let new_queue, client_id = | Some address -> Address.Inproc address
Queuing_system.add_client program_state.queue | None -> failwith "Error: No inproc address"
in end
Message.ConnectReply (Message.ConnectReply_msg.create | Message.Connect_msg.Ipc -> assert false
~state:state ~client_id ~push_address) in
|> Message.to_string
|> ZMQ.Socket.send rep_socket ; let new_queue, client_id =
{ program_state with Queuing_system.add_client program_state.queue
queue = new_queue in
} Message.ConnectReply (Message.ConnectReply_msg.create
~state:state ~client_id ~push_address)
|> Message.to_string
|> ZMQ.Socket.send rep_socket ;
{ program_state with
queue = new_queue
}
let disconnect msg program_state rep_socket = let disconnect msg program_state rep_socket =
@ -323,14 +333,21 @@ let del_task msg program_state rep_socket =
and success () = and success () =
let queue =
List.fold ~f:(fun queue task_id -> Queuing_system.del_task ~task_id queue)
~init:program_state.queue task_ids
in
let accepting_clients =
(Queuing_system.number_of_queued queue > Queuing_system.number_of_clients queue)
in
let new_program_state = let new_program_state =
{ program_state with { program_state with
queue = List.fold ~f:(fun queue task_id -> Queuing_system.del_task ~task_id queue) accepting_clients ;
~init:program_state.queue task_ids queue ;
} }
in in
let more = let more =
(Queuing_system.number_of_tasks new_program_state.queue > 0) (Queuing_system.number_of_tasks queue > 0)
in in
Message.DelTaskReply (Message.DelTaskReply_msg.create ~task_ids ~more) Message.DelTaskReply (Message.DelTaskReply_msg.create ~task_ids ~more)
|> Message.to_string |> Message.to_string
@ -393,12 +410,17 @@ let get_task msg program_state rep_socket pair_socket =
and success () = and success () =
let new_queue, task_id, task = let queue, task_id, task =
Queuing_system.pop_task ~client_id program_state.queue Queuing_system.pop_task ~client_id program_state.queue
in in
let accepting_clients =
(Queuing_system.number_of_queued queue >
Queuing_system.number_of_clients queue)
in
let no_task = let no_task =
Queuing_system.number_of_queued new_queue = 0 Queuing_system.number_of_queued queue = 0
in in
if no_task then if no_task then
@ -410,7 +432,8 @@ let get_task msg program_state rep_socket pair_socket =
let new_program_state = let new_program_state =
{ program_state with { program_state with
queue = new_queue queue ;
accepting_clients;
} }
in in
@ -467,6 +490,11 @@ let get_tasks msg program_state rep_socket pair_socket =
Queuing_system.number_of_queued new_queue = 0 Queuing_system.number_of_queued new_queue = 0
in in
let accepting_clients =
(Queuing_system.number_of_queued new_queue >
Queuing_system.number_of_clients new_queue)
in
if no_task then if no_task then
string_of_pub_state Waiting string_of_pub_state Waiting
|> ZMQ.Socket.send pair_socket |> ZMQ.Socket.send pair_socket
@ -476,7 +504,8 @@ let get_tasks msg program_state rep_socket pair_socket =
let new_program_state = let new_program_state =
{ program_state with { program_state with
queue = new_queue queue = new_queue;
accepting_clients;
} }
in in
@ -522,10 +551,17 @@ let task_done msg program_state rep_socket =
increment_progress_bar bar) increment_progress_bar bar)
~init:(program_state.queue, program_state.progress_bar) task_ids ~init:(program_state.queue, program_state.progress_bar) task_ids
in in
let accepting_clients =
(Queuing_system.number_of_queued new_queue >
Queuing_system.number_of_clients new_queue)
in
let result = let result =
{ program_state with { program_state with
queue = new_queue; queue = new_queue;
progress_bar = new_bar progress_bar = new_bar;
accepting_clients
} }
in in
reply_ok rep_socket; reply_ok rep_socket;
@ -654,7 +690,8 @@ let abort program_state rep_socket =
reply_ok rep_socket; reply_ok rep_socket;
{ program_state with { program_state with
queue queue ;
accepting_clients = false;
} }
@ -738,6 +775,7 @@ let run ~port =
address_tcp = None; address_tcp = None;
address_inproc = None; address_inproc = None;
progress_bar = None ; progress_bar = None ;
accepting_clients = false;
data = Hashtbl.create ~hashable:String.hashable (); data = Hashtbl.create ~hashable:String.hashable ();
} }
in in

15
ocaml/TaskServer.mli
View File

@ -1,12 +1,13 @@
type t = type t =
{ {
queue : Queuing_system.t ; queue : Queuing_system.t ;
state : Message.State.t option ; state : Message.State.t option ;
address_tcp : Address.Tcp.t option ; address_tcp : Address.Tcp.t option ;
address_inproc : Address.Inproc.t option ; address_inproc : Address.Inproc.t option ;
progress_bar : Progress_bar.t option ; progress_bar : Progress_bar.t option ;
running : bool; running : bool;
data : (string, string) Core.Hashtbl.t ; accepting_clients : bool;
data : (string, string) Core.Hashtbl.t ;
} }

2
plugins/Full_CI_ZMQ/pt2_stoch_routines.irp.f
View File

@ -130,8 +130,8 @@ subroutine ZMQ_pt2(E, pt2,relative_error, absolute_error, error)
call pt2_slave_inproc(i) call pt2_slave_inproc(i)
endif endif
!$OMP END PARALLEL !$OMP END PARALLEL
call delete_selection_buffer(b)
call end_parallel_job(zmq_to_qp_run_socket, zmq_socket_pull, 'pt2') call end_parallel_job(zmq_to_qp_run_socket, zmq_socket_pull, 'pt2')
call delete_selection_buffer(b)
print *, '========== ================= ================= =================' print *, '========== ================= ================= ================='

2
plugins/Full_CI_ZMQ/zmq_selection.irp.f
View File

@ -66,11 +66,11 @@ subroutine ZMQ_selection(N_in, pt2)
stop 'Unable to add task to task server' stop 'Unable to add task to task server'
endif endif
endif endif
call zmq_set_running(zmq_to_qp_run_socket)
ASSERT (associated(b%det)) ASSERT (associated(b%det))
ASSERT (associated(b%val)) ASSERT (associated(b%val))
call zmq_set_running(zmq_to_qp_run_socket)
!$OMP PARALLEL DEFAULT(shared) SHARED(b, pt2) PRIVATE(i) NUM_THREADS(nproc+1) !$OMP PARALLEL DEFAULT(shared) SHARED(b, pt2) PRIVATE(i) NUM_THREADS(nproc+1)
i = omp_get_thread_num() i = omp_get_thread_num()
if (i==0) then if (i==0) then

35
plugins/Selectors_Utils/zmq.irp.f
View File

@ -50,17 +50,26 @@ integer function zmq_get_$X(zmq_to_qp_run_socket, worker_id)
write(msg,'(A,1X,I8,1X,A200)') 'get_data '//trim(zmq_state), worker_id, '$X' write(msg,'(A,1X,I8,1X,A200)') 'get_data '//trim(zmq_state), worker_id, '$X'
rc = f77_zmq_send(zmq_to_qp_run_socket,trim(msg),len(trim(msg)),0) rc = f77_zmq_send(zmq_to_qp_run_socket,trim(msg),len(trim(msg)),0)
if (rc /= len(trim(msg))) go to 10 if (rc /= len(trim(msg))) then
zmq_get_$X = -1
go to 10
endif
rc = f77_zmq_recv(zmq_to_qp_run_socket,msg,len(msg),0) rc = f77_zmq_recv(zmq_to_qp_run_socket,msg,len(msg),0)
if (msg(1:14) /= 'get_data_reply') go to 10 if (msg(1:14) /= 'get_data_reply') then
zmq_get_$X = -1
go to 10
endif
rc = f77_zmq_recv(zmq_to_qp_run_socket,$X,4,0) rc = f77_zmq_recv(zmq_to_qp_run_socket,$X,4,0)
if (rc /= 4) go to 10 if (rc /= 4) then
zmq_get_$X = -1
go to 10
endif
endif endif
! Normal exit 10 continue
IRP_IF MPI IRP_IF MPI
include 'mpif.h' include 'mpif.h'
@ -71,27 +80,13 @@ integer function zmq_get_$X(zmq_to_qp_run_socket, worker_id)
print *, irp_here//': Unable to broadcast N_det_generators' print *, irp_here//': Unable to broadcast N_det_generators'
stop -1 stop -1
endif endif
if (zmq_get_$X == 0) then call MPI_BCAST ($X, 1, MPI_INTEGER, 0, MPI_COMM_WORLD, ierr)
call MPI_BCAST ($X, 1, MPI_INTEGER, 0, MPI_COMM_WORLD, ierr)
if (ierr /= MPI_SUCCESS) then
print *, irp_here//': Unable to broadcast N_det_generators'
stop -1
endif
endif
IRP_ENDIF
return
! Exception
10 continue
zmq_get_$X = -1
IRP_IF MPI
call MPI_BCAST (zmq_get_$X, 1, MPI_INTEGER, 0, MPI_COMM_WORLD, ierr)
if (ierr /= MPI_SUCCESS) then if (ierr /= MPI_SUCCESS) then
print *, irp_here//': Unable to broadcast N_det_generators' print *, irp_here//': Unable to broadcast N_det_generators'
stop -1 stop -1
endif endif
IRP_ENDIF IRP_ENDIF
end end
SUBST [ X ] SUBST [ X ]

104
src/Determinants/zmq.irp.f
View File

@ -87,21 +87,30 @@ integer function zmq_get_$X(zmq_to_qp_run_socket, worker_id)
integer :: rc integer :: rc
character*(256) :: msg character*(256) :: msg
zmq_get_$X = 0
if (mpi_master) then if (mpi_master) then
write(msg,'(A,1X,I8,1X,A200)') 'get_data '//trim(zmq_state), worker_id, '$X' write(msg,'(A,1X,I8,1X,A200)') 'get_data '//trim(zmq_state), worker_id, '$X'
rc = f77_zmq_send(zmq_to_qp_run_socket,trim(msg),len(trim(msg)),0) rc = f77_zmq_send(zmq_to_qp_run_socket,trim(msg),len(trim(msg)),0)
if (rc /= len(trim(msg))) go to 10 if (rc /= len(trim(msg))) then
zmq_get_$X = -1
go to 10
endif
rc = f77_zmq_recv(zmq_to_qp_run_socket,msg,len(msg),0) rc = f77_zmq_recv(zmq_to_qp_run_socket,msg,len(msg),0)
if (msg(1:14) /= 'get_data_reply') go to 10 if (msg(1:14) /= 'get_data_reply') then
zmq_get_$X = -1
go to 10
endif
rc = f77_zmq_recv(zmq_to_qp_run_socket,$X,4,0) rc = f77_zmq_recv(zmq_to_qp_run_socket,$X,4,0)
if (rc /= 4) go to 10 if (rc /= 4) then
zmq_get_$X = -1
go to 10
endif
endif endif
! Normal exit 10 continue
zmq_get_$X = 0
IRP_IF MPI IRP_IF MPI
include 'mpif.h' include 'mpif.h'
integer :: ierr integer :: ierr
@ -110,25 +119,12 @@ integer function zmq_get_$X(zmq_to_qp_run_socket, worker_id)
if (ierr /= MPI_SUCCESS) then if (ierr /= MPI_SUCCESS) then
stop 'Unable to broadcast zmq_get_psi_det' stop 'Unable to broadcast zmq_get_psi_det'
endif endif
if (zmq_get_$X == 0) then call MPI_BCAST ($X, 1, MPI_INTEGER, 0, MPI_COMM_WORLD, ierr)
call MPI_BCAST ($X, 1, MPI_INTEGER, 0, MPI_COMM_WORLD, ierr)
if (ierr /= MPI_SUCCESS) then
stop 'Unable to broadcast zmq_get_psi_det'
endif
endif
IRP_ENDIF
return
! Exception
10 continue
zmq_get_$X = -1
IRP_IF MPI
call MPI_BCAST (zmq_get_$X, 1, MPI_INTEGER, 0, MPI_COMM_WORLD, ierr)
if (ierr /= MPI_SUCCESS) then if (ierr /= MPI_SUCCESS) then
stop 'Unable to broadcast zmq_get_psi_det' stop 'Unable to broadcast zmq_get_psi_det'
endif endif
IRP_ENDIF IRP_ENDIF
end end
SUBST [ X ] SUBST [ X ]
@ -276,20 +272,29 @@ integer function zmq_get_psi_det(zmq_to_qp_run_socket, worker_id)
integer*8 :: rc8 integer*8 :: rc8
character*(256) :: msg character*(256) :: msg
zmq_get_psi_det = 0
if (mpi_master) then if (mpi_master) then
write(msg,'(A,1X,I8,1X,A200)') 'get_data '//trim(zmq_state), worker_id, 'psi_det' write(msg,'(A,1X,I8,1X,A200)') 'get_data '//trim(zmq_state), worker_id, 'psi_det'
rc = f77_zmq_send(zmq_to_qp_run_socket,trim(msg),len(trim(msg)),0) rc = f77_zmq_send(zmq_to_qp_run_socket,trim(msg),len(trim(msg)),0)
if (rc /= len(trim(msg))) go to 10 if (rc /= len(trim(msg))) then
zmq_get_psi_det = -1
go to 10
endif
rc = f77_zmq_recv(zmq_to_qp_run_socket,msg,len(msg),0) rc = f77_zmq_recv(zmq_to_qp_run_socket,msg,len(msg),0)
if (msg(1:14) /= 'get_data_reply') go to 10 if (msg(1:14) /= 'get_data_reply') then
zmq_get_psi_det = -1
go to 10
endif
rc8 = f77_zmq_recv8(zmq_to_qp_run_socket,psi_det,int(N_int*2_8*N_det*bit_kind,8),0) rc8 = f77_zmq_recv8(zmq_to_qp_run_socket,psi_det,int(N_int*2_8*N_det*bit_kind,8),0)
if (rc8 /= N_int*2_8*N_det*bit_kind) go to 10 if (rc8 /= N_int*2_8*N_det*bit_kind) then
zmq_get_psi_det = -1
go to 10
endif
endif endif
! Normal exit 10 continue
zmq_get_psi_det = 0
IRP_IF MPI IRP_IF MPI
include 'mpif.h' include 'mpif.h'
integer :: ierr integer :: ierr
@ -297,22 +302,9 @@ integer function zmq_get_psi_det(zmq_to_qp_run_socket, worker_id)
if (ierr /= MPI_SUCCESS) then if (ierr /= MPI_SUCCESS) then
stop 'Unable to broadcast zmq_get_psi_det' stop 'Unable to broadcast zmq_get_psi_det'
endif endif
if (zmq_get_psi_det == 0) then call broadcast_chunks_bit_kind(psi_det,N_det*N_int*2)
call broadcast_chunks_bit_kind(psi_det,N_det*N_int*2)
endif
IRP_ENDIF IRP_ENDIF
return
! Exception
10 continue
zmq_get_psi_det = -1
IRP_IF MPI
call MPI_BCAST (zmq_get_psi_det, 1, MPI_INTEGER, 0, MPI_COMM_WORLD, ierr)
if (ierr /= MPI_SUCCESS) then
stop 'Unable to broadcast zmq_get_psi_det'
endif
IRP_ENDIF
end end
integer function zmq_get_psi_coef(zmq_to_qp_run_socket, worker_id) integer function zmq_get_psi_coef(zmq_to_qp_run_socket, worker_id)
@ -327,20 +319,29 @@ integer function zmq_get_psi_coef(zmq_to_qp_run_socket, worker_id)
integer*8 :: rc8 integer*8 :: rc8
character*(256) :: msg character*(256) :: msg
zmq_get_psi_coef = 0
if (mpi_master) then if (mpi_master) then
write(msg,'(A,1X,I8,1X,A200)') 'get_data '//trim(zmq_state), worker_id, 'psi_coef' write(msg,'(A,1X,I8,1X,A200)') 'get_data '//trim(zmq_state), worker_id, 'psi_coef'
rc = f77_zmq_send(zmq_to_qp_run_socket,trim(msg),len(trim(msg)),0) rc = f77_zmq_send(zmq_to_qp_run_socket,trim(msg),len(trim(msg)),0)
if (rc /= len(trim(msg))) go to 10 if (rc /= len(trim(msg))) then
zmq_get_psi_coef = -1
go to 10
endif
rc = f77_zmq_recv(zmq_to_qp_run_socket,msg,len(msg),0) rc = f77_zmq_recv(zmq_to_qp_run_socket,msg,len(msg),0)
if (msg(1:14) /= 'get_data_reply') go to 10 if (msg(1:14) /= 'get_data_reply') then
zmq_get_psi_coef = -1
go to 10
endif
rc8 = f77_zmq_recv8(zmq_to_qp_run_socket,psi_coef,int(psi_det_size*N_states*8_8,8),0) rc8 = f77_zmq_recv8(zmq_to_qp_run_socket,psi_coef,int(psi_det_size*N_states*8_8,8),0)
if (rc8 /= psi_det_size*N_states*8_8) go to 10 if (rc8 /= psi_det_size*N_states*8_8) then
zmq_get_psi_coef = -1
go to 10
endif
endif endif
! Normal exit 10 continue
zmq_get_psi_coef = 0
IRP_IF MPI IRP_IF MPI
include 'mpif.h' include 'mpif.h'
@ -349,22 +350,9 @@ integer function zmq_get_psi_coef(zmq_to_qp_run_socket, worker_id)
if (ierr /= MPI_SUCCESS) then if (ierr /= MPI_SUCCESS) then
stop 'Unable to broadcast zmq_get_psi_coef' stop 'Unable to broadcast zmq_get_psi_coef'
endif endif
if (zmq_get_psi_coef == 0) then call broadcast_chunks_double(psi_coef,N_states*N_det)
call broadcast_chunks_double(psi_coef,N_states*N_det)
endif
IRP_ENDIF IRP_ENDIF
return
! Exception
10 continue
zmq_get_psi_coef = -1
IRP_IF MPI
call MPI_BCAST (zmq_get_psi_coef, 1, MPI_INTEGER, 0, MPI_COMM_WORLD, ierr)
if (ierr /= MPI_SUCCESS) then
stop 'Unable to broadcast zmq_get_psi_coef'
endif
IRP_ENDIF
end end

38
src/ZMQ/put_get.irp.f
View File

@ -57,16 +57,25 @@ integer function zmq_get_dvector(zmq_to_qp_run_socket, worker_id, name, x, size_
if (mpi_master) then if (mpi_master) then
write(msg,'(A,1X,I8,1X,A200)') 'get_data '//trim(zmq_state), worker_id, name write(msg,'(A,1X,I8,1X,A200)') 'get_data '//trim(zmq_state), worker_id, name
rc = f77_zmq_send(zmq_to_qp_run_socket,trim(msg),len(trim(msg)),0) rc = f77_zmq_send(zmq_to_qp_run_socket,trim(msg),len(trim(msg)),0)
if (rc /= len(trim(msg))) go to 10 if (rc /= len(trim(msg))) then
zmq_get_dvector = -1
go to 10
endif
rc = f77_zmq_recv(zmq_to_qp_run_socket,msg,len(msg),0) rc = f77_zmq_recv(zmq_to_qp_run_socket,msg,len(msg),0)
if (msg(1:14) /= 'get_data_reply') go to 10 if (msg(1:14) /= 'get_data_reply') then
zmq_get_dvector = -1
go to 10
endif
rc = f77_zmq_recv(zmq_to_qp_run_socket,x,size_x*8,0) rc = f77_zmq_recv(zmq_to_qp_run_socket,x,size_x*8,0)
if (rc /= size_x*8) go to 10 if (rc /= size_x*8) then
zmq_get_dvector = -1
go to 10
endif
endif endif
! Normal exit 10 continue
IRP_IF MPI IRP_IF MPI
integer :: ierr integer :: ierr
@ -76,28 +85,13 @@ integer function zmq_get_dvector(zmq_to_qp_run_socket, worker_id, name, x, size_
print *, irp_here//': Unable to broadcast zmq_get_dvector' print *, irp_here//': Unable to broadcast zmq_get_dvector'
stop -1 stop -1
endif endif
if (zmq_get_dvector == 0) then call MPI_BCAST (x, size_x, MPI_DOUBLE_PRECISION, 0, MPI_COMM_WORLD, ierr)
call MPI_BCAST (x, size_x, MPI_DOUBLE_PRECISION, 0, MPI_COMM_WORLD, ierr)
if (ierr /= MPI_SUCCESS) then
print *, irp_here//': Unable to broadcast dvector'
stop -1
endif
endif
IRP_ENDIF
return
! Exception
10 continue
zmq_get_dvector = -1
IRP_IF MPI
call MPI_BCAST (zmq_get_dvector, 1, MPI_INTEGER, 0, MPI_COMM_WORLD, ierr)
if (ierr /= MPI_SUCCESS) then if (ierr /= MPI_SUCCESS) then
print *, irp_here//': Unable to broadcast zmq_get_dvector' print *, irp_here//': Unable to broadcast dvector'
stop -1 stop -1
endif endif
IRP_ENDIF IRP_ENDIF
end end

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

@ -620,6 +620,7 @@ subroutine end_parallel_job(zmq_to_qp_run_socket,zmq_socket_pull,name_in)
rc = f77_zmq_send(zmq_to_qp_run_socket, 'end_job '//trim(zmq_state),8+len(trim(zmq_state)),0) rc = f77_zmq_send(zmq_to_qp_run_socket, 'end_job '//trim(zmq_state),8+len(trim(zmq_state)),0)
rc = f77_zmq_recv(zmq_to_qp_run_socket, message, 512, 0) rc = f77_zmq_recv(zmq_to_qp_run_socket, message, 512, 0)
if (trim(message(1:13)) == 'error waiting') then if (trim(message(1:13)) == 'error waiting') then
print *, trim(message(1:rc))
call sleep(1) call sleep(1)
cycle cycle
else if (message(1:2) == 'ok') then else if (message(1:2) == 'ok') then
@ -630,11 +631,11 @@ subroutine end_parallel_job(zmq_to_qp_run_socket,zmq_socket_pull,name_in)
rc = f77_zmq_send(zmq_to_qp_run_socket, 'end_job force',13,0) rc = f77_zmq_send(zmq_to_qp_run_socket, 'end_job force',13,0)
rc = f77_zmq_recv(zmq_to_qp_run_socket, message, 512, 0) rc = f77_zmq_recv(zmq_to_qp_run_socket, message, 512, 0)
endif endif
zmq_state = 'No_state'
call end_zmq_to_qp_run_socket(zmq_to_qp_run_socket) call end_zmq_to_qp_run_socket(zmq_to_qp_run_socket)
call end_zmq_pull_socket(zmq_socket_pull) call end_zmq_pull_socket(zmq_socket_pull)
call omp_set_lock(zmq_lock) call omp_set_lock(zmq_lock)
zmq_state = 'No_state'
rc = f77_zmq_ctx_term(zmq_context) rc = f77_zmq_ctx_term(zmq_context)
zmq_context = 0_ZMQ_PTR zmq_context = 0_ZMQ_PTR
call omp_unset_lock(zmq_lock) call omp_unset_lock(zmq_lock)