10
1
mirror of https://gitlab.com/scemama/QCaml.git synced 2024-12-22 20:33:36 +01:00

Working on MPI

This commit is contained in:
Anthony Scemama 2020-01-23 21:24:05 +01:00
parent b0135a48f4
commit 7808e28ae7
2 changed files with 68 additions and 30 deletions

View File

@ -60,15 +60,16 @@ module Node = struct
let name = Unix.gethostname () let name = Unix.gethostname ()
let comm = let comm =
let _, color =
Mpi.allgather (name, rank) Mpi.comm_world Mpi.allgather (name, rank) Mpi.comm_world
|> Array.to_list |> Array.to_list
|> List.filter (fun (n, r) -> name = n) |> List.sort compare
|> List.map snd |> List.find (fun (n, r) -> n = name)
|> Array.of_list in
|> Mpi.(group_incl (comm_group comm_world)) Mpi.(comm_split comm_world color 0)
|> Mpi.(comm_create comm_world)
let rank = let rank =
Printf.printf "Node: %d %d\n%!" rank (Mpi.comm_rank comm);
Mpi.comm_rank comm Mpi.comm_rank comm
let master = rank = 0 let master = rank = 0
@ -85,33 +86,64 @@ module Node = struct
let broadcast x = broadcast_generic Mpi.broadcast x let broadcast x = broadcast_generic Mpi.broadcast x
let barrier () = Mpi.barrier comm let barrier () = Mpi.barrier comm
end end
module InterNode = struct module InterNode = struct
let comm = let comm =
let rec aux accu name = function
| [] -> List.rev accu let ranks =
| (newname, rank) :: rest when newname = name -> aux accu name rest let name = Unix.gethostname () in
| (newname, rank) :: rest -> aux (rank :: accu) newname rest
let rec aux accu old_name = function
| [] -> List.rev accu |> Array.of_list
| (new_name, r) :: rest when new_name <> old_name ->
aux (r::accu) new_name rest
| (new_name, r) :: rest -> aux accu new_name rest
in in
let name = Unix.gethostname () in
Mpi.allgather (name, rank) Mpi.comm_world Mpi.allgather (name, rank) Mpi.comm_world
|> Array.to_list |> Array.to_list
|> List.sort compare |> List.sort compare
|> aux [] "" |> aux [] ""
|> Array.of_list in
|> Mpi.(group_incl (comm_group comm_world))
|> Mpi.(comm_create comm_world) let world_group =
Mpi.comm_group Mpi.comm_world
in
let new_group =
Mpi.group_incl world_group ranks
in
let result =
let g =
Mpi.comm_create Mpi.comm_world new_group
in
try
ignore @@ List.find (fun x -> x = rank) @@ Array.to_list ranks;
Some g
with Not_found -> None
in
result
let rank = let rank =
match comm with
| Some comm ->
Printf.printf "InterNode: %d %d\n%!" rank (Mpi.comm_rank comm);
Mpi.comm_rank comm Mpi.comm_rank comm
| None -> -1
let master = rank = 0 let master = rank = 0
let broadcast_generic broadcast x = let broadcast_generic broadcast x =
match comm with
| Some comm ->
begin
let x = let x =
if master then Some (Lazy.force x) if master then Some (Lazy.force x)
else None else None
@ -119,10 +151,16 @@ module InterNode = struct
match broadcast x 0 comm with match broadcast x 0 comm with
| Some x -> x | Some x -> x
| None -> assert false | None -> assert false
end
| None -> Lazy.force x
let broadcast x = broadcast_generic Mpi.broadcast x let broadcast x = broadcast_generic Mpi.broadcast x
let barrier () = Mpi.barrier comm let barrier () =
match comm with
| Some comm -> Mpi.barrier comm
| None -> ()
end end

View File

@ -60,7 +60,7 @@ end
(** {5 Inter-node operations} *) (** {5 Inter-node operations} *)
module InterNode : sig module InterNode : sig
val comm : Mpi.communicator val comm : Mpi.communicator option
(** MPI Communicator among the master processes of the each node *) (** MPI Communicator among the master processes of the each node *)
val rank : Mpi.rank val rank : Mpi.rank