10
1
mirror of https://gitlab.com/scemama/QCaml.git synced 2024-06-17 02:35:18 +02:00
QCaml/Parallel/Farm.ml

101 lines
1.9 KiB
OCaml

(* Single process function *)
let run_sequential f stream =
let rec next _ =
try
let task = Stream.next stream in
Some (f task)
with Stream.Failure -> None in
Stream.from next
(* Multi-process functions *)
(* Server side *)
let run_parallel_server stream =
let fetch_result () =
let result, rank, _tag =
Mpi.receive_status Mpi.any_source Mpi.any_tag Mpi.comm_world
in
result, rank
in
let send_task client_rank =
let task =
try Some (Stream.next stream)
with Stream.Failure -> None
in
Mpi.send task client_rank 0 Mpi.comm_world
in
let rec run result_list n_todo =
let n_todo =
match Stream.peek stream with
| None -> n_todo-1
| _ -> n_todo
in
match n_todo with
| 0 -> result_list
| _ ->
begin
let result, client = fetch_result () in
let new_result_list =
match result with
| None -> result_list
| Some result -> result :: result_list
in
send_task client;
run new_result_list n_todo
end
in
let result =
let n_todo = Mpi.comm_size Mpi.comm_world in
run [] n_todo
|> Stream.of_list
in
Mpi.barrier Mpi.comm_world;
result
(** Client side *)
let run_parallel_client f =
Mpi.send None 0 0 Mpi.comm_world;
let rec run () =
let task =
Mpi.receive 0 Mpi.any_tag Mpi.comm_world
in
match task with
| None -> Mpi.barrier Mpi.comm_world
| Some task ->
let result = f task in
begin
Mpi.send (Some result) 0 0 Mpi.comm_world;
run ()
end
in
run ();
Stream.of_list []
let run_parallel f stream =
match Mpi.comm_rank Mpi.comm_world with
| 0 -> run_parallel_server stream
| _ -> run_parallel_client f
let run f stream =
match Mpi.comm_size Mpi.comm_world with
| 1 -> run_sequential f stream
| _ -> run_parallel f stream