ShellPair option

Basis/ContractedShellPair.ml

@@ -59,8 +59,11 @@ Format.printf "@[<2>shell_b :@ %a@]@;" Cs.pp s_b;
   and expo_inv = Array.map (fun (_,y) -> Psp.expo_inv y) shell_pairs
   in
   let shell_pairs = Array.map snd shell_pairs in
+  if Array.length shell_pairs = 0 then
+    None
+  else
     let root = shell_pairs.(0) in
-  {
+    Some {
       shell_a = s_a ; shell_b = s_b ; coef ; expo_inv ; shell_pairs ;
       center_ab = Psp.a_minus_b root;
       norm_coef_scale = Psp.norm_coef_scale root;

Basis/ContractedShellPair.mli

@@ -14,18 +14,22 @@ A contracted shell pair is a product of two {!ContractedShell.t}:
 type t
 
 
-val create : ?cutoff:float -> ContractedShell.t -> ContractedShell.t -> t
+val create : ?cutoff:float -> ContractedShell.t -> ContractedShell.t -> t option
 (** Creates an contracted shell pair {% $\varphi_{ab}$ %} from a contracted
     shell {% $\chi_a$ %} (first argument) and a contracted shell {% $\chi_b$ %}
     (second argument).
 
-    The contracted shell pair contains the pairs of primitives for which
+    The contracted shell pair contains the only pairs of primitives for which
-    the norm is greater than [cutoff], and for which ... TODO ....
+    the norm is greater than [cutoff]. 
-    All other pairs are discarded.
+
+    If all the primitive shell pairs are not significant, the function returns
+    [None].
 *)
 
-val of_basis : ContractedShell.t array -> t array array
+val of_basis : ContractedShell.t array -> t option array array
-(** Creates all possible contracted shell pairs from the basis set. *)
+(** Creates all possible contracted shell pairs from the basis set.
+    If the shell pair is not significant, sets the value to [None].
+*)
 
 val shell_a : t -> ContractedShell.t
 (** Returns the first {!ContractedShell.t}  {% $\chi_a$ %} which was used to

Basis/ERI.ml

@@ -98,7 +98,9 @@ let of_basis basis =
   let t0 = Unix.gettimeofday () in
 
   let schwartz = 
-    Array.map (fun pair_array -> Array.map (fun pair ->
+    Array.map (fun pair_array -> Array.map (function 
+        | None -> (Zmap.create 0, 0.)
+        | Some pair ->
           let cls = 
             contracted_class_shell_pairs pair pair
           in
@@ -138,8 +140,10 @@ let of_basis basis =
       try
         if (schwartz_p_max < cutoff) then raise NullIntegral;
 
-        let
+        let shell_p = 
-          shell_p = shell_pairs.(i).(j)
+          match shell_pairs.(i).(j) with
+          | None -> raise NullIntegral
+          | Some x -> x
         in
 
         let sp =
@@ -152,9 +156,13 @@ let of_basis basis =
             try
             if schwartz_p_max *. schwartz_q_max < cutoff2 then
               raise NullIntegral;
-            let
+
-              shell_q = shell_pairs.(k).(l)
+            let shell_q =
+              match shell_pairs.(k).(l) with
+              | None -> raise NullIntegral
+              | Some x -> x
             in
+
             let sq =
               Csp.shell_pairs shell_q
             in

Basis/KinInt.ml

@@ -24,10 +24,9 @@ let to_powers x =
 (** Computes all the kinetic integrals of the contracted shell pair *)
 let contracted_class shell_a shell_b : float Zmap.t = 
 
-  let shell_p =
+  match Csp.create shell_a shell_b with
-    Csp.create shell_a shell_b
+  | Some shell_p ->
-  in
+    begin
-
       (* Pre-computation of integral class indices *)
       let class_indices = 
         Am.zkey_array (Am.Doublet Cs.(totAngMom shell_a, totAngMom shell_b))
@@ -115,6 +114,8 @@ let contracted_class shell_a shell_b : float Zmap.t =
       in
       Array.iteri (fun i key -> Zmap.add result key contracted_class.(i)) class_indices;
       result
+    end
+  | None -> Zmap.create 0
 
 
 (** Create kinetic energy matrix *)
@@ -149,7 +150,7 @@ let of_basis basis =
               in
               let value =
                 try Zmap.find cls key
-                with Not_found -> failwith "Bug in kinetic integrals"
+                with Not_found -> 0.
               in
               result.{i_c,j_c} <- value;
               result.{j_c,i_c} <- value;

Basis/NucInt.ml

@@ -64,10 +64,9 @@ let of_basis_nuclei basis nuclei =
   (* Compute Integrals *)
   for i=0 to (Array.length shell) - 1 do
     for j=0 to i do
-      let
+      match shell_pairs.(i).(j) with
-        shell_p = shell_pairs.(i).(j)
+      | None -> ()
-      in
+      | Some shell_p ->
-
         (* Compute all the integrals of the class *)
         let cls =
           contracted_class_shell_pair shell_p nuclei

Basis/Overlap.ml

@@ -23,9 +23,9 @@ let to_powers x =
 (** Computes all the overlap integrals of the contracted shell pair *)
 let contracted_class shell_a shell_b : float Zmap.t = 
 
-  let shell_p =
+  match Csp.create shell_a shell_b with
-    Csp.create shell_a shell_b
+  | Some shell_p -> 
-  in
+    begin
 
   (* Pre-computation of integral class indices *)
   let class_indices = 
@@ -39,6 +39,7 @@ let contracted_class shell_a shell_b : float Zmap.t =
   let sp =
     Csp.shell_pairs shell_p
   in
+
       let center_ab = 
         Csp.center_ab shell_p
       in
@@ -89,6 +90,8 @@ let contracted_class shell_a shell_b : float Zmap.t =
       in
       Array.iteri (fun i key -> Zmap.add result key contracted_class.(i)) class_indices;
       result
+    end
+  | None -> Zmap.create 0
 
 
 (** Create overlap matrix *)
@@ -123,7 +126,7 @@ let of_basis basis =
               in
               let value = 
                 try Zmap.find cls key 
-                with Not_found -> failwith "Bug in overlap integrals"
+                with Not_found -> 0.
               in
               result.{i_c,j_c} <- value;
               result.{j_c,i_c} <- value;

Basis/TwoElectronRR.ml

@@ -432,6 +432,9 @@ let contracted_class ~zero_m shell_a shell_b shell_c shell_d : float Zmap.t =
   let shell_p = Csp.create ~cutoff shell_a shell_b
   and shell_q = Csp.create ~cutoff shell_c shell_d
   in
+  match shell_p, shell_q with
+  | Some shell_p, Some shell_q -> 
     contracted_class_shell_pairs ~zero_m shell_p shell_q 
+  | _ -> Zmap.create 0
 
 

Basis/TwoElectronRRVectorized.ml

@@ -873,5 +873,8 @@ let contracted_class ~zero_m shell_a shell_b shell_c shell_d : float Zmap.t =
   let shell_p = Csp.create ~cutoff shell_a shell_b
   and shell_q = Csp.create ~cutoff shell_c shell_d
   in
+  match shell_p, shell_q with
+  | Some shell_p, Some shell_q ->
     contracted_class_shell_pairs ~zero_m shell_p shell_q
+  | _ -> Zmap.create 0