Added Parallel.InterNode

MOBasis/HF12.ml

@@ -44,13 +44,14 @@ let array_3_init d1 d2 d3 fx =
         done)
   ;
   if Parallel.master then Printf.printf "Broadcast d3\n" ;
-  Parallel.Node.broadcast (lazy result)
+  Parallel.InterNode.broadcast (lazy result)
 
 let array_4_init d1 d2 d3 d4 fx =
   let f (k,l) = 
     let x = 
       Bigarray.(Array2.create Float64 fortran_layout d1 d2)
     in
+    Printf.printf "Array 4: %d %d %d\n%!" Parallel.rank k l;
     for j=1 to d2 do
       for i=1 to d1 do
         x.{i,j} <-  fx i j k l
@@ -76,13 +77,14 @@ let array_4_init d1 d2 d3 d4 fx =
         done)
   ;
   if Parallel.master then Printf.printf "Broadcast d4\n" ;
-  Parallel.Node.broadcast (lazy result)
+  Parallel.InterNode.broadcast (lazy result)
 
 let array_5_init d1 d2 d3 d4 d5 fx =
   let f (l,m) =
     let x = 
       Bigarray.(Array3.create Float64 fortran_layout d1 d2 d3)
     in
+    Printf.printf "Array 5: %d %d %d\n%!" Parallel.rank l m;
     for k=1 to d3 do
       for j=1 to d2 do
         for i=1 to d1 do
@@ -113,7 +115,7 @@ let array_5_init d1 d2 d3 d4 d5 fx =
   ;
   if Parallel.master then Printf.printf "Broadcast d5\n" ;
   try
-    Parallel.Node.broadcast (lazy result)
+    Parallel.InterNode.broadcast (lazy result)
   with Invalid_argument _ ->
     begin
       Printf.eprintf "Array too large... splitting.\n%!";
@@ -132,11 +134,11 @@ let array_5_init d1 d2 d3 d4 d5 fx =
                 done
               done
             done;
-            ignore @@ Parallel.Node.broadcast (lazy x)
+            ignore @@ Parallel.InterNode.broadcast (lazy x)
           end
         else 
           begin
-            ignore @@ Parallel.Node.broadcast (lazy x);
+            ignore @@ Parallel.InterNode.broadcast (lazy x);
             for l=1 to d4 do
               for k=1 to d3 do
                 for j=1 to d2 do
@@ -671,9 +673,11 @@ let make ~simulation ~mo_basis ~aux_basis_filename () =
           h_one a i Spin.Alfa *. f_two a j k l Spin.Alfa Spin.Alfa +.
           h_one a j Spin.Alfa *. f_two i a k l Spin.Alfa Spin.Alfa +. 
           h_two a l i j Spin.Alfa Spin.Alfa *. f_one a k Spin.Alfa +.
-          h_two a k j i Spin.Alfa Spin.Alfa *. f_one a l Spin.Alfa +.
+          h_two a k j i Spin.Alfa Spin.Alfa *. f_one a l Spin.Alfa ) +.
+      sum mos_cabs (fun a ->
           sum mos_in  (fun m -> -. h_two m a j i Spin.Alfa Spin.Alfa *.
-                                  f_two m a k l Spin.Alfa Spin.Alfa) +.
+                                  f_two m a k l Spin.Alfa Spin.Alfa) ) +.
+      sum mos_cabs (fun a ->
           sum mos_cabs (fun b -> if b >= a then 0. else
               h_two b a j i Spin.Alfa Spin.Alfa *. f_two b a l k Spin.Alfa Spin.Alfa 
           )
@@ -688,10 +692,12 @@ let make ~simulation ~mo_basis ~aux_basis_filename () =
           h_one a i Spin.Alfa *. f_two a j k l Spin.Alfa Spin.Beta +.
           h_one a j Spin.Alfa *. f_two a i l k Spin.Alfa Spin.Beta +.
           h_two a l i j Spin.Alfa Spin.Beta *. f_one a k Spin.Alfa +.
-          h_two a k j i Spin.Alfa Spin.Beta *. f_one a l Spin.Alfa +.
+          h_two a k j i Spin.Alfa Spin.Beta *. f_one a l Spin.Alfa ) +.
+      sum mos_cabs (fun a ->
           sum mos_in (fun m ->
             h_two m a j i Spin.Alfa Spin.Beta *.  f_two m a l k Spin.Alfa Spin.Beta +.
-            h_two m a i j Spin.Alfa Spin.Beta *.  f_two m a k l Spin.Alfa Spin.Beta ) +.
+            h_two m a i j Spin.Alfa Spin.Beta *.  f_two m a k l Spin.Alfa Spin.Beta ) ) +.
+      sum mos_cabs (fun a ->
           sum mos_cabs (fun b -> 
               h_two b a j i Spin.Alfa Spin.Beta *. f_two b a l k Spin.Alfa Spin.Beta 
           )

Parallel_mpi/Parallel.ml

@@ -88,6 +88,44 @@ module Node = struct
 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
+    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)
+
+  let rank = 
+    Mpi.comm_rank comm
+
+  let master = rank = 0
+  
+  let broadcast_generic broadcast x =
+    let x = 
+      if master then Some (Lazy.force x)
+      else None
+    in
+    match broadcast x 0 comm with
+    | Some x -> x
+    | None -> assert false
+
+  let broadcast x = broadcast_generic Mpi.broadcast x
+
+  let barrier () = Mpi.barrier comm 
+end
+
+
 module Vec = struct
 
   type t = 

Parallel_mpi/Parallel.mli

@@ -57,7 +57,6 @@ module Node : sig
 end
 
 
-(*
 (** {5 Inter-node  operations} *)
 module InterNode : sig
 
@@ -72,8 +71,10 @@ module InterNode : sig
 
   val broadcast : 'a lazy_t -> 'a
   (** Broadcasts data to all the processes of the inter-node communicator. *)
+
+  val barrier : unit -> unit
+  (** Wait for all processes among the node to reach this point. *)
 end
-*)
 
 (** {5 Vector operations} *)
 module Vec : sig

Utils/FourIdxStorage.ml

@@ -391,7 +391,7 @@ let to_list data =
 
 
 let broadcast t = 
-t
+    Parallel.InterNode.broadcast (lazy t)
 (*
   let size =
     Parallel.broadcast (lazy t.size)