Parallelized FCI and 4idx

Basis/ERI.ml

@@ -257,8 +257,9 @@ let of_basis_parallel basis =
     |> filter_contracted_shell_pairs ~cutoff
   in
 
-  Printf.printf "%d significant shell pairs computed in %f seconds\n"
+  if Parallel.master then
-    (List.length shell_pairs) (Unix.gettimeofday () -. t0);
+    Printf.printf "%d significant shell pairs computed in %f seconds\n"
+      (List.length shell_pairs) (Unix.gettimeofday () -. t0);
 
 
   let t0 = Unix.gettimeofday () in
@@ -315,7 +316,8 @@ let of_basis_parallel basis =
      Array.iter (fun (i_c,j_c,k_c,l_c,value) ->
       set_chem eri_array i_c j_c k_c l_c value) l);
 
-  Printf.printf "Computed ERIs in parallel in %f seconds\n%!" (Unix.gettimeofday () -. t0);
+  if Parallel.master then
+    Printf.printf "Computed ERIs in parallel in %f seconds\n%!" (Unix.gettimeofday () -. t0);
   Parallel.broadcast (lazy eri_array)
 
 

CI/CI.ml

@@ -84,7 +84,6 @@ let create_matrix_spin f det_space =
       | Ds.Spin (a,b) -> (a,b)
       | _ -> assert false
     in
-    let n_alfa = Array.length a in
     let n_beta = Array.length b in
 
 
@@ -116,7 +115,8 @@ let create_matrix_spin f det_space =
     let a = Array.to_list a
     and b = Array.to_list b
     in
-    let task i_alfa = 
+
+    let task (i,i_alfa) = 
         let result = Array.init n_beta (fun _ -> []) in
         (** Update function when ki and kj are connected *)
         let update i j ki kj =
@@ -164,21 +164,28 @@ let create_matrix_spin f det_space =
             end;
             j := !j + n_beta
           ) a;
-          Array.map (fun l ->
+          let r = 
-              List.rev l
+            Array.map (fun l ->
-              |> Vector.sparse_of_assoc_list ndet
+                List.rev l
-          ) result 
+                |> Vector.sparse_of_assoc_list ndet
+            ) result 
+          in (i,r)
     in
+
     let result =
-      Array.init ndet (fun _ -> Vector.sparse_of_assoc_list 0 [])
+      if Parallel.master then
+        Array.init ndet (fun _ -> Vector.sparse_of_assoc_list ndet [])
+      else
+        Array.init ndet (fun _ -> Vector.sparse_of_assoc_list ndet [])
     in
-    let i = ref 0 in
+
-    List.iteri (fun ia i_alfa ->
+    List.mapi (fun i i_alfa -> i*n_beta, i_alfa) a
-        task i_alfa 
+    |> Stream.of_list
-        |> Array.iteri (fun j x -> result.(!i+j) <- x);
+    |> Farm.run ~ordered:false ~f:task
-        Printf.eprintf "%8d / %8d\r%!" (ia+1) n_alfa;
+    |> Stream.iter (fun (k, r) ->
-        i := !i + n_beta
+        Array.iteri (fun j r_j -> result.(k+j) <- r_j) r;
-      ) a;
+        Printf.eprintf "%8d / %8d\r%!" (k+1) ndet;
+      ) ;
     Matrix.sparse_of_vector_array result
   )
 
@@ -187,7 +194,13 @@ let create_matrix_spin f det_space =
 let make ?(n_states=1) det_space = 
 
   let m_H = 
+
     let mo_basis = Ds.mo_basis det_space in
+
+    (* While in a sequential region, initiate the parallel
+       4-idx transformation *)
+    ignore @@ MOBasis.two_e_ints mo_basis;
+
     let f = 
       match Ds.determinants det_space with
       | Ds.Arbitrary _ -> create_matrix_arbitrary

MOBasis/MOBasis.ml

@@ -68,7 +68,9 @@ let four_index_transform ~mo_coef eri_ao =
 
   let ao_num = Mat.dim1 mo_coef in
   let mo_num = Mat.dim2 mo_coef in
-  let eri_mo = ERI.create ~size:mo_num `Dense in
+  let eri_mo =
+      ERI.create ~size:mo_num `Dense
+  in
 
   let mo_num_2  = mo_num * mo_num in
   let ao_num_2  = ao_num * ao_num in
@@ -82,9 +84,10 @@ let four_index_transform ~mo_coef eri_ao =
   and p = Mat.create ao_num_2 mo_num
   and q = Mat.create ao_mo_num mo_num
   in
-  Printf.eprintf "Transforming %d integrals : %!" mo_num;
+
-  List.iter (fun delta ->
+  if Parallel.master then Printf.eprintf "4-idx transformation \n%!";
-      Printf.eprintf "%d %!" delta;
+
+  let task delta =
       Mat.fill u 0.;
 
       List.iter (fun l ->
@@ -129,18 +132,29 @@ let four_index_transform ~mo_coef eri_ao =
           [| mo_num ; mo_num ; mo_num |]
         |> Bigarray.array3_of_genarray 
       in
+      let result = ref [] in
       List.iter (fun gamma ->
           List.iter (fun beta ->
               List.iter (fun alpha ->
                   let x = u.{alpha,beta,gamma} in
                   if x <> 0. then
-                    ERI.set_chem eri_mo alpha beta gamma delta x
+                    result := (alpha, beta, gamma, delta, x) :: !result;
                 ) (list_range 1 beta) 
             ) range_mo
-        ) (list_range 1 delta)  
+        ) (list_range 1 delta);
-    ) range_mo;
+      Array.of_list !result
-  Printf.eprintf "\n%!";
+  in
-  eri_mo
+
+  let n = ref 0 in
+  Stream.of_list range_mo
+  |> Farm.run ~f:task ~ordered:false
+  |> Stream.iter (fun l ->
+     if Parallel.master then (Printf.eprintf "\r%d / %d%!" !n mo_num; incr n);
+     Array.iter (fun (alpha, beta, gamma, delta, x) ->
+      ERI.set_chem eri_mo alpha beta gamma delta x) l);
+
+  if Parallel.master then Printf.eprintf "\n";
+  Parallel.broadcast (lazy eri_mo) 
 
 
 let make ~simulation ~mo_type ~mo_occupation ~mo_coef ()  =

run_fci.ml

@@ -39,19 +39,27 @@ let () =
     | None -> 1
   in
 
+  let ppf = 
+    if Parallel.master then Format.std_formatter
+    else Printing.ppf_dev_null
+  in
+
   let s =
     Simulation.of_filenames ~charge ~multiplicity ~nuclei:nuclei_file basis_file
   in
 
   let hf = HartreeFock.make s in
+  Format.fprintf ppf "@[%a@]@." HartreeFock.pp_hf hf;
+
   let mos =
     MOBasis.of_hartree_fock hf
   in
+
   let space =
     Determinant_space.fci_of_mo_basis ~frozen_core:false mos
   in
   let ci = CI.make space in
-  Format.printf "FCI energy : %20.16f@." ((CI.eigenvalues ci).{1} +. Simulation.nuclear_repulsion s);
+  Format.fprintf ppf "FCI energy : %20.16f@." ((CI.eigenvalues ci).{1} +. Simulation.nuclear_repulsion s);
   (*
   let s2 = Util.xt_o_x ~o:(CI.s2_matrix ci) ~x:(CI.eigenvectors ci) in
   Util.list_range 1 (Determinant_space.size space)