Cleaning

CI/CI.ml

@@ -51,32 +51,46 @@ let h_ij mo_basis ki kj =
   |> List.hd
 
 
+let create_matrix_arbitrary f det_space =
+  lazy (
+    let det = 
+      match Ds.determinants det_space with
+      | Ds.Arbitrary a -> a
+      | _ -> assert false
+    in
 
-let make ?(n_states=1) det_space = 
     let ndet = Ds.size det_space in
-  let mo_basis = Ds.mo_basis det_space in
 
-  let m_H = 
-    let m_H_arbitrary det = lazy (
     let v = Vec.make0 ndet in
-      Array.init ndet (fun i -> let ki = det.(i) in
+
+    Array.init ndet
+      (fun i -> let ki = det.(i) in
         Printf.eprintf "%8d / %8d\r%!" i ndet;
         let j = ref 1 in
         Ds.determinant_stream det_space
-        |> Stream.iter (fun kj ->
-          v.{!j} <- h_ij mo_basis ki kj ; incr j);
+        |> Stream.iter (fun kj -> v.{!j} <- f ki kj ; incr j);
         Vector.sparse_of_vec v)
-      |> Matrix.sparse_of_vector_array)
-    in
+    |> Matrix.sparse_of_vector_array
+  )
 
-    let m_H_spin a b = lazy (
+
+(* Create a matrix using the fact that the determinant space is made of
+   the outer product of spindeterminants.  *)
+let create_matrix_spin f det_space = 
+  lazy (
+    let ndet = Ds.size det_space in
+    let a, b = 
+      match Ds.determinants det_space with
+      | Ds.Spin (a,b) -> (a,b)
+      | _ -> assert false
+    in
     let n_alfa = Array.length a in
     let n_beta = Array.length b in
     let result = Array.init ndet (fun _ -> []) in
 
     (** Update function when ki and kj are connected *)
     let update i j ki kj =
-        let x = h_ij mo_basis ki kj in
+      let x = f ki kj in
       if x <> 0. then
         result.(i) <- (j, x) :: result.(i) ;
     in
@@ -160,24 +174,28 @@ let make ?(n_states=1) det_space =
         |> Vector.sparse_of_assoc_list ndet ) result
     |> Matrix.sparse_of_vector_array
   )
+
+
+
+let make ?(n_states=1) det_space = 
+
+  let m_H = 
+    let mo_basis = Ds.mo_basis det_space in
+    let f = 
+      match Ds.determinants det_space with
+      | Ds.Arbitrary _ -> create_matrix_arbitrary
+      | Ds.Spin      _ -> create_matrix_spin
+    in
+    f (fun ki kj -> h_ij mo_basis ki kj) det_space 
   in
 
+  let m_S2 =
+    let f = 
       match Ds.determinants det_space with
-    | Ds.Arbitrary a -> m_H_arbitrary a
-    | Ds.Spin  (a,b) -> m_H_spin a b 
+      | Ds.Arbitrary _ -> create_matrix_arbitrary
+      | Ds.Spin      _ -> create_matrix_spin
     in
-
-  let m_S2 = lazy (
-    match Ds.determinants det_space with
-    | Ds.Spin  (a,b) -> failwith "Not implemented"
-    | Ds.Arbitrary det -> 
-      let v = Vec.make0 ndet in
-      Array.init ndet (fun i -> let ki = det.(i) in
-        Array.iteri (fun j kj ->
-          v.{j+1} <- CIMatrixElement.make_s2 ki kj) det;
-        Vector.sparse_of_vec v)
-      |> Matrix.sparse_of_vector_array
-  )
+    f (fun ki kj -> CIMatrixElement.make_s2 ki kj) det_space 
   in
 
   let eigensystem = lazy (