Working on MPI

Parallel_mpi/Parallel.ml

@@ -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.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 = 
+    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
+    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
 
-    let name = Unix.gethostname () in
       Mpi.allgather (name, rank) Mpi.comm_world
       |> Array.to_list
       |> List.sort compare
       |> 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 = 
+    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
 
 

Parallel_mpi/Parallel.mli

@@ -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