diff --git a/Basis/Overlap.ml b/Basis/Overlap.ml index 5c8b2cb..38dc425 100644 --- a/Basis/Overlap.ml +++ b/Basis/Overlap.ml @@ -1,10 +1,10 @@ open Util (** Computes all the overlap integrals of the contracted shell pair *) -let contracted_class shell_a shell_b : float Zmap.t = +let contracted_class shell_a shell_b : float Zmap.t = let shell_p = - Shell_pair.create_array shell_a shell_b + Shell_pair.create_array shell_a shell_b in (* Pre-computation of integral class indices *) diff --git a/Basis/Shell_pair.ml b/Basis/Shell_pair.ml index a770455..240604d 100644 --- a/Basis/Shell_pair.ml +++ b/Basis/Shell_pair.ml @@ -39,12 +39,6 @@ let create_array ?cutoff p_a p_b = Array.init (Contracted_shell.size p_b) (fun j -> try - if Contracted_shell.center p_a = Contracted_shell.center p_b && - ((Angular_momentum.to_int @@ Contracted_shell.totAngMom p_a) + - (Angular_momentum.to_int @@ Contracted_shell.totAngMom p_b)) land 1 = 1 - then - raise Null_contribution; - let f2 = Contracted_shell.norm_coef p_b j in diff --git a/Basis/TwoElectronRR.ml b/Basis/TwoElectronRR.ml index 3929e68..32de469 100644 --- a/Basis/TwoElectronRR.ml +++ b/Basis/TwoElectronRR.ml @@ -1,5 +1,8 @@ open Util +let cutoff2 = cutoff *. cutoff + +exception NullQuartet (** Horizontal and Vertical Recurrence Relations (HVRR) *) let hvrr_two_e m (angMom_a, angMom_b, angMom_c, angMom_d) @@ -20,79 +23,81 @@ let hvrr_two_e m (angMom_a, angMom_b, angMom_c, angMom_d) (** Vertical recurrence relations *) let rec vrr m angMom_a angMom_c totAngMom_a totAngMom_c = - if angMom_a.(0) < 0 || angMom_a.(1) < 0 || angMom_a.(2) < 0 - || angMom_c.(0) < 0 || angMom_c.(1) < 0 || angMom_c.(2) < 0 then 0. - else - match (totAngMom_a, totAngMom_c) with - | (0,0) -> zero_m_array.(m) - | (_,0) -> + match (totAngMom_a, totAngMom_c) with + | (0,0) -> zero_m_array.(m) + | (_,0) -> - let key = [| angMom_a.(0)+1; angMom_a.(1)+1; angMom_a.(2)+1; |] - |> Zkey.(of_int_array ~kind:Kind_3) - in + let key = [| angMom_a.(0)+1; angMom_a.(1)+1; angMom_a.(2)+1; |] + |> Zkey.(of_int_array ~kind:Kind_3) + in - let (found, result) = - try (true, Zmap.find map.(m) key) with - | Not_found -> (false, - let am = [| angMom_a.(0) ; angMom_a.(1) ; angMom_a.(2) |] - and amm = [| angMom_a.(0) ; angMom_a.(1) ; angMom_a.(2) |] - and xyz = - match angMom_a with - | [|0;0;_|] -> 2 - | [|0;_;_|] -> 1 - | _ -> 0 - in - am.(xyz) <- am.(xyz) - 1; - amm.(xyz) <- amm.(xyz) - 2; + let (found, result) = + try (true, Zmap.find map.(m) key) with + | Not_found -> (false, + let am = [| angMom_a.(0) ; angMom_a.(1) ; angMom_a.(2) |] + and amm = [| angMom_a.(0) ; angMom_a.(1) ; angMom_a.(2) |] + and xyz = + match angMom_a with + | [|0;0;_|] -> 2 + | [|0;_;_|] -> 1 + | _ -> 0 + in + am.(xyz) <- am.(xyz) - 1; + amm.(xyz) <- amm.(xyz) - 2; + if am.(xyz) < 0 then 0. else chop (-. expo_b *. expo_inv_p *. (Coordinate.coord center_ab xyz)) (fun () -> vrr m am angMom_c (totAngMom_a-1) totAngMom_c ) +. chop (expo_inv_p *. (Coordinate.coord center_pq xyz)) (fun () -> vrr (m+1) am angMom_c (totAngMom_a-1) totAngMom_c ) - +. chop ((float_of_int am.(xyz)) *. expo_inv_p *. 0.5) - (fun () -> vrr m amm angMom_c (totAngMom_a-2) totAngMom_c - +. chop expo_inv_p (fun () -> - vrr (m+1) amm angMom_c (totAngMom_a-2) totAngMom_c) ) ) - in - if not found then - Zmap.add map.(m) key result; - result + +. (if amm.(xyz) < 0 then 0. else + chop ((float_of_int am.(xyz)) *. expo_inv_p *. 0.5) + (fun () -> vrr m amm angMom_c (totAngMom_a-2) totAngMom_c + +. chop expo_inv_p (fun () -> + vrr (m+1) amm angMom_c (totAngMom_a-2) totAngMom_c) ) ) ) + in + if not found then + Zmap.add map.(m) key result; + result - | (_,_) -> + | (_,_) -> - let key = [| angMom_a.(0)+1; angMom_a.(1)+1; angMom_a.(2)+1; - angMom_c.(0)+1; angMom_c.(1)+1; angMom_c.(2)+1; |] - |> Zkey.(of_int_array ~kind:Kind_6) - in + let key = [| angMom_a.(0)+1; angMom_a.(1)+1; angMom_a.(2)+1; + angMom_c.(0)+1; angMom_c.(1)+1; angMom_c.(2)+1; |] + |> Zkey.(of_int_array ~kind:Kind_6) + in - let (found, result) = - try (true, Zmap.find map.(m) key) with - | Not_found -> (false, - let am = [| angMom_a.(0) ; angMom_a.(1) ; angMom_a.(2) |] - and cm = [| angMom_c.(0) ; angMom_c.(1) ; angMom_c.(2) |] - and cmm = [| angMom_c.(0) ; angMom_c.(1) ; angMom_c.(2) |] - and xyz = - match angMom_c with - | [|0;0;_|] -> 2 - | [|0;_;_|] -> 1 - | _ -> 0 - in - am.(xyz) <- am.(xyz) - 1; - cm.(xyz) <- cm.(xyz) - 1; - cmm.(xyz) <- cmm.(xyz) - 2; + let (found, result) = + try (true, Zmap.find map.(m) key) with + | Not_found -> (false, + let am = [| angMom_a.(0) ; angMom_a.(1) ; angMom_a.(2) |] + and cm = [| angMom_c.(0) ; angMom_c.(1) ; angMom_c.(2) |] + and cmm = [| angMom_c.(0) ; angMom_c.(1) ; angMom_c.(2) |] + and xyz = + match angMom_c with + | [|0;0;_|] -> 2 + | [|0;_;_|] -> 1 + | _ -> 0 + in + am.(xyz) <- am.(xyz) - 1; + cm.(xyz) <- cm.(xyz) - 1; + cmm.(xyz) <- cmm.(xyz) - 2; + if cm.(xyz) < 0 then 0. else chop (-. expo_d *. expo_inv_q *. (Coordinate.coord center_cd xyz) ) (fun () -> vrr m angMom_a cm totAngMom_a (totAngMom_c-1) ) -. chop (expo_inv_q *. (Coordinate.coord center_pq xyz)) (fun () -> vrr (m+1) angMom_a cm totAngMom_a (totAngMom_c-1) ) - +. chop ((float_of_int cm.(xyz)) *. expo_inv_q *. 0.5 ) - (fun () -> vrr m angMom_a cmm totAngMom_a (totAngMom_c-2) - +. chop expo_inv_q - (fun () -> vrr (m+1) angMom_a cmm totAngMom_a (totAngMom_c-2) ) ) - -. chop ((float_of_int angMom_a.(xyz)) *. expo_inv_p *. expo_inv_q *. 0.5 ) - (fun () -> vrr (m+1) am cm (totAngMom_a-1) (totAngMom_c-1) ) ) - in - if not found then - Zmap.add map.(m) key result; - result + +. (if cmm.(xyz) < 0 then 0. else + chop ((float_of_int cm.(xyz)) *. expo_inv_q *. 0.5 ) + (fun () -> vrr m angMom_a cmm totAngMom_a (totAngMom_c-2) + +. chop expo_inv_q + (fun () -> vrr (m+1) angMom_a cmm totAngMom_a (totAngMom_c-2) ) ) ) + -. (if am.(xyz) lor cm.(xyz) < 0 then 0. else + chop ((float_of_int angMom_a.(xyz)) *. expo_inv_p *. expo_inv_q *. 0.5 ) + (fun () -> vrr (m+1) am cm (totAngMom_a-1) (totAngMom_c-1) ) )) + in + if not found then + Zmap.add map.(m) key result; + result @@ -101,62 +106,60 @@ let hvrr_two_e m (angMom_a, angMom_b, angMom_c, angMom_d) and hrr m angMom_a angMom_b angMom_c angMom_d totAngMom_a totAngMom_b totAngMom_c totAngMom_d = - if angMom_b.(0) < 0 || angMom_b.(1) < 0 || angMom_b.(2) < 0 - || angMom_d.(0) < 0 || angMom_d.(1) < 0 || angMom_d.(2) < 0 then 0. - else - match (totAngMom_b, totAngMom_d) with - | (0,0) -> vrr m angMom_a angMom_c totAngMom_a totAngMom_c - | (_,_) -> + match (totAngMom_b, totAngMom_d) with + | (0,0) -> vrr m angMom_a angMom_c totAngMom_a totAngMom_c + | (_,_) -> - let key = [| angMom_a.(0)+1; angMom_a.(1)+1; angMom_a.(2)+1; - angMom_b.(0)+1; angMom_b.(1)+1; angMom_b.(2)+1; - angMom_c.(0)+1; angMom_c.(1)+1; angMom_c.(2)+1; - angMom_d.(0)+1; angMom_d.(1)+1; angMom_d.(2)+1; |] - |> Zkey.(of_int_array ~kind:Kind_12) - in + let key = [| angMom_a.(0)+1; angMom_a.(1)+1; angMom_a.(2)+1; + angMom_b.(0)+1; angMom_b.(1)+1; angMom_b.(2)+1; + angMom_c.(0)+1; angMom_c.(1)+1; angMom_c.(2)+1; + angMom_d.(0)+1; angMom_d.(1)+1; angMom_d.(2)+1; |] + |> Zkey.(of_int_array ~kind:Kind_12) + in - let (found, result) = - try (true, Zmap.find map.(m) key) with - | Not_found -> (false, - begin - match totAngMom_d with - | 0 -> - let ap = [| angMom_a.(0) ; angMom_a.(1) ; angMom_a.(2) |] - and bm = [| angMom_b.(0) ; angMom_b.(1) ; angMom_b.(2) |] - and xyz = - match angMom_b with - | [|0;0;_|] -> 2 - | [|0;_;_|] -> 1 - | _ -> 0 - in - ap.(xyz) <- ap.(xyz) + 1; - bm.(xyz) <- bm.(xyz) - 1; - hrr m ap bm angMom_c angMom_d (totAngMom_a+1) (totAngMom_b-1) - totAngMom_c totAngMom_d + let (found, result) = + try (true, Zmap.find map.(m) key) with + | Not_found -> (false, + begin + match totAngMom_d with + | 0 -> + let ap = [| angMom_a.(0) ; angMom_a.(1) ; angMom_a.(2) |] + and bm = [| angMom_b.(0) ; angMom_b.(1) ; angMom_b.(2) |] + and xyz = + match angMom_b with + | [|0;0;_|] -> 2 + | [|0;_;_|] -> 1 + | _ -> 0 + in + ap.(xyz) <- ap.(xyz) + 1; + bm.(xyz) <- bm.(xyz) - 1; + if (bm.(xyz) < 0) then 0. else + hrr m ap bm angMom_c angMom_d + (totAngMom_a+1) (totAngMom_b-1) totAngMom_c totAngMom_d +. chop (Coordinate.coord center_ab xyz) (fun () -> hrr m angMom_a bm angMom_c angMom_d totAngMom_a (totAngMom_b-1) totAngMom_c totAngMom_d ) - | _ -> - let cp = [| angMom_c.(0) ; angMom_c.(1) ; angMom_c.(2) |] - and dm = [| angMom_d.(0) ; angMom_d.(1) ; angMom_d.(2) |] - and xyz = - match angMom_d with - | [|0;0;_|] -> 2 - | [|0;_;_|] -> 1 - | _ -> 0 - in - cp.(xyz) <- cp.(xyz) + 1; - dm.(xyz) <- dm.(xyz) - 1; - hrr m angMom_a angMom_b cp dm totAngMom_a totAngMom_b - (totAngMom_c+1) (totAngMom_d-1) - +. chop (Coordinate.coord center_cd xyz) (fun () -> - hrr m angMom_a angMom_b angMom_c dm totAngMom_a totAngMom_b - totAngMom_c (totAngMom_d-1) ) - end) - in - if not found then - Zmap.add map.(m) key result; - result + | _ -> + let cp = [| angMom_c.(0) ; angMom_c.(1) ; angMom_c.(2) |] + and dm = [| angMom_d.(0) ; angMom_d.(1) ; angMom_d.(2) |] + and xyz = + match angMom_d with + | [|0;0;_|] -> 2 + | [|0;_;_|] -> 1 + | _ -> 0 + in + cp.(xyz) <- cp.(xyz) + 1; + dm.(xyz) <- dm.(xyz) - 1; + hrr m angMom_a angMom_b cp dm totAngMom_a totAngMom_b + (totAngMom_c+1) (totAngMom_d-1) + +. chop (Coordinate.coord center_cd xyz) (fun () -> + hrr m angMom_a angMom_b angMom_c dm totAngMom_a totAngMom_b + totAngMom_c (totAngMom_d-1) ) + end) + in + if not found then + Zmap.add map.(m) key result; + result in hrr m angMom_a angMom_b angMom_c angMom_d totAngMom_a totAngMom_b @@ -185,6 +188,15 @@ let contracted_class ~zero_m shell_a shell_b shell_c shell_d : float Zmap.t = totAngMom shell_c, totAngMom shell_d)) in + (* + (* Precomputation of overlaps *) + let overlaps_p = + Overlap.contracted_class shell_a shell_b + and overlaps_q = + Overlap.contracted_class shell_c shell_d + in + *) + let contracted_class = Array.make (Array.length class_indices) 0.; in @@ -197,66 +209,91 @@ let contracted_class ~zero_m shell_a shell_b shell_c shell_d : float Zmap.t = for cd=0 to (Array.length shell_q - 1) do - let coef_prod = - shell_p.(ab).Shell_pair.coef *. shell_q.(cd).Shell_pair.coef - in - (** Screening on thr product of coefficients *) - if (abs_float coef_prod) > 1.e-4*.cutoff then - begin + try + let coef_prod = + shell_p.(ab).Shell_pair.coef *. shell_q.(cd).Shell_pair.coef + in + (** Screening on the product of coefficients *) + if (abs_float coef_prod) < 1.e-4*.cutoff then + raise NullQuartet; - let expo_pq_inv = - shell_p.(ab).Shell_pair.expo_inv +. shell_q.(cd).Shell_pair.expo_inv - in - let center_pq = - Coordinate.(shell_p.(ab).Shell_pair.center |- shell_q.(cd).Shell_pair.center) - in - let norm_pq_sq = - Coordinate.dot center_pq center_pq - in - let zero_m_array = - zero_m ~maxm ~expo_pq_inv ~norm_pq_sq - in + let expo_pq_inv = + shell_p.(ab).Shell_pair.expo_inv +. shell_q.(cd).Shell_pair.expo_inv + in + let center_pq = + Coordinate.(shell_p.(ab).Shell_pair.center |- shell_q.(cd).Shell_pair.center) + in + let norm_pq_sq = + Coordinate.dot center_pq center_pq + in - match Contracted_shell.(totAngMom shell_a, totAngMom shell_b, - totAngMom shell_c, totAngMom shell_d) with - | Angular_momentum.(S,S,S,S) -> Array.iteri (fun i key -> - let coef_prod = - shell_p.(ab).Shell_pair.coef *. shell_q.(cd).Shell_pair.coef - in - let integral = - zero_m_array.(0) - in - contracted_class.(i) <- contracted_class.(i) +. coef_prod *. integral - ) class_indices - | _ -> - let d = shell_q.(cd).Shell_pair.j in - let map = Array.init maxm (fun _ -> Zmap.create (Array.length class_indices)) in - (* Compute the integral class from the primitive shell quartet *) - Array.iteri (fun i key -> - let (angMomA,angMomB,angMomC,angMomD) = - let a = Zkey.to_int_array Zkey.Kind_12 key in - ( [| a.(0) ; a.(1) ; a.(2) |], - [| a.(3) ; a.(4) ; a.(5) |], - [| a.(6) ; a.(7) ; a.(8) |], - [| a.(9) ; a.(10) ; a.(11) |] ) - in - let norm = - shell_p.(ab).Shell_pair.norm_fun angMomA angMomB *. shell_q.(cd).Shell_pair.norm_fun angMomC angMomD - in - let integral = chop norm (fun () -> - hvrr_two_e 0 (angMomA, angMomB, angMomC, angMomD) - (Contracted_shell.totAngMom shell_a, Contracted_shell.totAngMom shell_b, - Contracted_shell.totAngMom shell_c, Contracted_shell.totAngMom shell_d) - (maxm, zero_m_array) - (Contracted_shell.expo shell_b b, Contracted_shell.expo shell_d d) - (shell_p.(ab).Shell_pair.expo_inv, shell_q.(cd).Shell_pair.expo_inv) - (shell_p.(ab).Shell_pair.center_ab, shell_q.(cd).Shell_pair.center_ab, center_pq) - map ) - in - contracted_class.(i) <- contracted_class.(i) +. coef_prod *. integral - ) class_indices - end + let zero_m_array = + zero_m ~maxm ~expo_pq_inv ~norm_pq_sq + in + + match Contracted_shell.(totAngMom shell_a, totAngMom shell_b, + totAngMom shell_c, totAngMom shell_d) with + | Angular_momentum.(S,S,S,S) -> Array.iteri (fun i key -> + let coef_prod = + shell_p.(ab).Shell_pair.coef *. shell_q.(cd).Shell_pair.coef + in + let integral = + zero_m_array.(0) + in + contracted_class.(i) <- contracted_class.(i) +. coef_prod *. integral + ) class_indices + | _ -> + let d = shell_q.(cd).Shell_pair.j in + let map = Array.init maxm (fun _ -> Zmap.create (Array.length class_indices)) in + (* Compute the integral class from the primitive shell quartet *) + Array.iteri (fun i key -> + let (angMomA,angMomB,angMomC,angMomD) = + let a = Zkey.to_int_array Zkey.Kind_12 key in + ( [| a.(0) ; a.(1) ; a.(2) |], + [| a.(3) ; a.(4) ; a.(5) |], + [| a.(6) ; a.(7) ; a.(8) |], + [| a.(9) ; a.(10) ; a.(11) |] ) + in + try + (* + (* Schwartz screening *) + let schwartz_p = + Zmap.find overlaps_p @@ Zkey.of_int_array ~kind:Zkey.Kind_6 + [| angMomA.(0) ; angMomA.(1) ; angMomA.(2) ; + angMomB.(0) ; angMomB.(1) ; angMomB.(2) |] + |> abs_float + in + let schwartz_q = + Zmap.find overlaps_q @@ Zkey.of_int_array ~kind:Zkey.Kind_6 + [| angMomC.(0) ; angMomC.(1) ; angMomC.(2) ; + angMomD.(0) ; angMomD.(1) ; angMomD.(2) |] + |> abs_float + in + if schwartz_p*.schwartz_q = 0. then + () ; (*raise NullQuartet; *) + *) + + let norm = + shell_p.(ab).Shell_pair.norm_fun angMomA angMomB *. shell_q.(cd).Shell_pair.norm_fun angMomC angMomD + in + let integral = chop norm (fun () -> + hvrr_two_e 0 (angMomA, angMomB, angMomC, angMomD) + (Contracted_shell.totAngMom shell_a, Contracted_shell.totAngMom shell_b, + Contracted_shell.totAngMom shell_c, Contracted_shell.totAngMom shell_d) + (maxm, zero_m_array) + (Contracted_shell.expo shell_b b, Contracted_shell.expo shell_d d) + (shell_p.(ab).Shell_pair.expo_inv, shell_q.(cd).Shell_pair.expo_inv) + (shell_p.(ab).Shell_pair.center_ab, shell_q.(cd).Shell_pair.center_ab, center_pq) + map ) + in + contracted_class.(i) <- contracted_class.(i) +. coef_prod *. integral + (* +;if (schwartz_p*.schwartz_q < cutoff2) then Printf.printf "%e %e\n" (schwartz_p*.schwartz_q) integral; + *) + with NullQuartet -> () + ) class_indices + with NullQuartet -> () done done; let result =