mirror of
https://gitlab.com/scemama/QCaml.git
synced 2024-08-30 00:03:42 +02:00
Working on MPI
This commit is contained in:
parent
b0135a48f4
commit
7808e28ae7
@ -60,15 +60,16 @@ module Node = struct
|
||||
let name = Unix.gethostname ()
|
||||
|
||||
let comm =
|
||||
let _, color =
|
||||
Mpi.allgather (name, rank) Mpi.comm_world
|
||||
|> Array.to_list
|
||||
|> List.filter (fun (n, r) -> name = n)
|
||||
|> List.map snd
|
||||
|> Array.of_list
|
||||
|> Mpi.(group_incl (comm_group comm_world))
|
||||
|> Mpi.(comm_create comm_world)
|
||||
|> List.sort compare
|
||||
|> List.find (fun (n, r) -> n = name)
|
||||
in
|
||||
Mpi.(comm_split comm_world color 0)
|
||||
|
||||
let rank =
|
||||
Printf.printf "Node: %d %d\n%!" rank (Mpi.comm_rank comm);
|
||||
Mpi.comm_rank comm
|
||||
|
||||
let master = rank = 0
|
||||
@ -85,33 +86,64 @@ module Node = struct
|
||||
let broadcast x = broadcast_generic Mpi.broadcast x
|
||||
|
||||
let barrier () = Mpi.barrier comm
|
||||
|
||||
|
||||
end
|
||||
|
||||
|
||||
module InterNode = struct
|
||||
|
||||
let comm =
|
||||
let rec aux accu name = function
|
||||
| [] -> List.rev accu
|
||||
| (newname, rank) :: rest when newname = name -> aux accu name rest
|
||||
| (newname, rank) :: rest -> aux (rank :: accu) newname rest
|
||||
|
||||
let ranks =
|
||||
let name = Unix.gethostname () in
|
||||
|
||||
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
|
||||
|
||||
let name = Unix.gethostname () in
|
||||
Mpi.allgather (name, rank) Mpi.comm_world
|
||||
|> Array.to_list
|
||||
|> List.sort compare
|
||||
|> aux [] ""
|
||||
|> Array.of_list
|
||||
|> Mpi.(group_incl (comm_group comm_world))
|
||||
|> Mpi.(comm_create comm_world)
|
||||
in
|
||||
|
||||
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 =
|
||||
match comm with
|
||||
| Some comm ->
|
||||
Printf.printf "InterNode: %d %d\n%!" rank (Mpi.comm_rank comm);
|
||||
Mpi.comm_rank comm
|
||||
| None -> -1
|
||||
|
||||
let master = rank = 0
|
||||
|
||||
let broadcast_generic broadcast x =
|
||||
match comm with
|
||||
| Some comm ->
|
||||
begin
|
||||
let x =
|
||||
if master then Some (Lazy.force x)
|
||||
else None
|
||||
@ -119,10 +151,16 @@ module InterNode = struct
|
||||
match broadcast x 0 comm with
|
||||
| Some x -> x
|
||||
| None -> assert false
|
||||
end
|
||||
| None -> Lazy.force 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
|
||||
|
||||
|
||||
|
@ -60,7 +60,7 @@ end
|
||||
(** {5 Inter-node operations} *)
|
||||
module InterNode : sig
|
||||
|
||||
val comm : Mpi.communicator
|
||||
val comm : Mpi.communicator option
|
||||
(** MPI Communicator among the master processes of the each node *)
|
||||
|
||||
val rank : Mpi.rank
|
||||
|
Loading…
Reference in New Issue
Block a user