From e9d3d9a1f4c88eafef0b9961f4f260cbb2ad22f0 Mon Sep 17 00:00:00 2001 From: Anthony Scemama Date: Thu, 23 Jan 2020 17:30:01 +0100 Subject: [PATCH] Added Parallel.InterNode --- MOBasis/HF12.ml | 24 +++++++++++++++--------- Parallel_mpi/Parallel.ml | 38 ++++++++++++++++++++++++++++++++++++++ Parallel_mpi/Parallel.mli | 5 +++-- Utils/FourIdxStorage.ml | 2 +- 4 files changed, 57 insertions(+), 12 deletions(-) diff --git a/MOBasis/HF12.ml b/MOBasis/HF12.ml index 5abb7eb..995b14e 100644 --- a/MOBasis/HF12.ml +++ b/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 ) diff --git a/Parallel_mpi/Parallel.ml b/Parallel_mpi/Parallel.ml index fdef772..df0fa7a 100644 --- a/Parallel_mpi/Parallel.ml +++ b/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 = diff --git a/Parallel_mpi/Parallel.mli b/Parallel_mpi/Parallel.mli index 7856314..3ffc9aa 100644 --- a/Parallel_mpi/Parallel.mli +++ b/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 diff --git a/Utils/FourIdxStorage.ml b/Utils/FourIdxStorage.ml index d2188a8..63f043f 100644 --- a/Utils/FourIdxStorage.ml +++ b/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)