From 5cc48e59d721baf9f35d84ce1344309dba49b077 Mon Sep 17 00:00:00 2001 From: Anthony Scemama Date: Wed, 24 Jan 2018 16:29:48 +0100 Subject: [PATCH] Accelerated HRR and VRR --- Basis/TwoElectronRR.ml | 354 ++++++++++++++++++++++------------------- Utils/Zkey.ml | 1 - 2 files changed, 191 insertions(+), 164 deletions(-) diff --git a/Basis/TwoElectronRR.ml b/Basis/TwoElectronRR.ml index 5124026..7619f88 100644 --- a/Basis/TwoElectronRR.ml +++ b/Basis/TwoElectronRR.ml @@ -21,12 +21,13 @@ let hvrr_two_e m (angMom_a, angMom_b, angMom_c, angMom_d) in (** Vertical recurrence relations *) - let rec vrr m angMom_a angMom_c totAngMom_a totAngMom_c = - - match (totAngMom_a, totAngMom_c) with - | (0,0) -> zero_m_array.(m) - | (_,0) -> + let rec vrr0 m angMom_a = function + | 0 -> zero_m_array.(m) + | 1 -> let i = if angMom_a.(0) = 1 then 0 else if angMom_a.(1) = 1 then 1 else 2 + in expo_inv_p *.( (Coordinate.coord center_pq i) *. zero_m_array.(m+1) + -. expo_b *. (Coordinate.coord center_ab i) *. zero_m_array.(m) ) + | totAngMom_a -> let key = Zkey.of_int_tuple (Zkey.Three (angMom_a.(0)+1, angMom_a.(1)+1, angMom_a.(2)+1) ) in @@ -37,7 +38,6 @@ let hvrr_two_e m (angMom_a, angMom_b, angMom_c, angMom_d) 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 @@ -46,19 +46,25 @@ let hvrr_two_e m (angMom_a, angMom_b, angMom_c, angMom_d) 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 ) + (fun () -> vrr0 m am (totAngMom_a-1) ) +. chop (expo_inv_p *. (Coordinate.coord center_pq xyz)) - (fun () -> vrr (m+1) am angMom_c (totAngMom_a-1) totAngMom_c ) + (fun () -> vrr0 (m+1) am (totAngMom_a-1) ) +. (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 + (fun () -> vrr0 m amm (totAngMom_a-2) +. chop expo_inv_p (fun () -> - vrr (m+1) amm angMom_c (totAngMom_a-2) totAngMom_c) ) ) ) + vrr0 (m+1) amm (totAngMom_a-2) ) ) ) + ) in if not found then Zmap.add map.(m) key result; result + and vrr m angMom_a angMom_c totAngMom_a totAngMom_c = + + match (totAngMom_a, totAngMom_c) with + | (0,0) -> zero_m_array.(m) + | (_,0) -> vrr0 m angMom_a totAngMom_a | (_,_) -> let key = Zkey.of_int_tuple (Zkey.Six @@ -104,65 +110,57 @@ let hvrr_two_e m (angMom_a, angMom_b, angMom_c, angMom_d) (** Horizontal recurrence relations *) + and hrr0 m angMom_a angMom_b angMom_c + totAngMom_a totAngMom_b totAngMom_c = + + match totAngMom_b with + | 0 -> vrr m angMom_a angMom_c totAngMom_a totAngMom_c + | 1 -> let xyz = if angMom_b.(0) = 1 then 0 else if angMom_b.(1) = 1 then 1 else 2 in + let ap = [| angMom_a.(0) ; angMom_a.(1) ; angMom_a.(2) |] in + ap.(xyz) <- ap.(xyz) + 1; + vrr m ap angMom_c (totAngMom_a+1) totAngMom_c + +. chop (Coordinate.coord center_ab xyz) (fun () -> + vrr m angMom_a angMom_c totAngMom_a totAngMom_c) + | _ -> + 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 + hrr0 m ap bm angMom_c (totAngMom_a+1) (totAngMom_b-1) totAngMom_c + +. chop (Coordinate.coord center_ab xyz) (fun () -> + hrr0 m angMom_a bm angMom_c totAngMom_a (totAngMom_b-1) + totAngMom_c ) + and hrr m angMom_a angMom_b angMom_c angMom_d totAngMom_a totAngMom_b totAngMom_c totAngMom_d = match (totAngMom_b, totAngMom_d) with - | (0,0) -> vrr m angMom_a angMom_c totAngMom_a totAngMom_c + | (0,0) -> + vrr m angMom_a angMom_c totAngMom_a totAngMom_c + | (_,0) -> hrr0 m angMom_a angMom_b angMom_c totAngMom_a totAngMom_b totAngMom_c | (_,_) -> - - let key = Zkey.of_int_tuple (Zkey.Twelve - (( 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)) ) - + 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 - - 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 - + 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) ) in hrr m angMom_a angMom_b angMom_c angMom_d totAngMom_a totAngMom_b totAngMom_c totAngMom_d @@ -197,109 +195,139 @@ let contracted_class_shell_pairs ~zero_m ?schwartz_p ?schwartz_q shell_p shell_q (* Compute all integrals in the shell for each pair of significant shell pairs *) - for ab=0 to (Array.length shell_p - 1) - do - let b = shell_p.(ab).Shell_pair.j in - - for cd=0 to (Array.length shell_q - 1) - do - 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 - - 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 -> + begin + match Contracted_shell.(totAngMom shell_a, totAngMom shell_b, + totAngMom shell_c, totAngMom shell_d) with + | Angular_momentum.(S,S,S,S) -> + begin + for ab=0 to (Array.length shell_p - 1) do + 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 + 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 a = Zkey.to_int_array Zkey.Kind_12 key in - let (angMomA,angMomB,angMomC,angMomD) = - ( [| 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 = - let key = - Zkey.of_int_array Zkey.Kind_12 - [| a.(0) ; a.(1) ; a.(2) ; - a.(3) ; a.(4) ; a.(5) ; - a.(0) ; a.(1) ; a.(2) ; - a.(3) ; a.(4) ; a.(5) |] - in - match schwartz_p with - | None -> 1. - | Some schwartz_p -> Zmap.find schwartz_p key - in - if schwartz_p < cutoff then raise NullQuartet; - let schwartz_q = - let key = - Zkey.of_int_array Zkey.Kind_12 - [| a.(6) ; a.(7) ; a.(8) ; - a.(9) ; a.(10) ; a.(11) ; - a.(6) ; a.(7) ; a.(8) ; - a.(9) ; a.(10) ; a.(11) |] - in - match schwartz_q with - | None -> 1. - | Some schwartz_q -> Zmap.find schwartz_q key - in - if schwartz_p *. schwartz_q < cutoff2 then raise NullQuartet; - *) + (** Screening on the product of coefficients *) + try + 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 coef_prod = + shell_p.(ab).Shell_pair.coef *. shell_q.(cd).Shell_pair.coef + in + let integral = + zero_m_array.(0) + in + contracted_class.(0) <- contracted_class.(0) +. coef_prod *. integral + with NullQuartet -> () + done + done; + end + + | _ -> + begin + for ab=0 to (Array.length shell_p - 1) do + let b = shell_p.(ab).Shell_pair.j in + for cd=0 to (Array.length shell_q - 1) do + 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 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 a = Zkey.to_int_array Zkey.Kind_12 key in + let (angMomA,angMomB,angMomC,angMomD) = + ( [| 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 = + let key = + Zkey.of_int_array Zkey.Kind_12 + [| a.(0) ; a.(1) ; a.(2) ; + a.(3) ; a.(4) ; a.(5) ; + a.(0) ; a.(1) ; a.(2) ; + a.(3) ; a.(4) ; a.(5) |] + in + match schwartz_p with + | None -> 1. + | Some schwartz_p -> Zmap.find schwartz_p key + in + if schwartz_p < cutoff then raise NullQuartet; + let schwartz_q = + let key = + Zkey.of_int_array Zkey.Kind_12 + [| a.(6) ; a.(7) ; a.(8) ; + a.(9) ; a.(10) ; a.(11) ; + a.(6) ; a.(7) ; a.(8) ; + a.(9) ; a.(10) ; a.(11) |] + in + match schwartz_q with + | None -> 1. + | Some schwartz_q -> Zmap.find schwartz_q key + in + if schwartz_p *. schwartz_q < cutoff2 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 + with NullQuartet -> () + ) class_indices + with NullQuartet -> () + done + done; + end + end; - - 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 - with NullQuartet -> () - ) class_indices - with NullQuartet -> () - done - done; let result = Zmap.create (Array.length contracted_class) in diff --git a/Utils/Zkey.ml b/Utils/Zkey.ml index 12ae8cd..eb3cb62 100644 --- a/Utils/Zkey.ml +++ b/Utils/Zkey.ml @@ -1,6 +1,5 @@ (** Key for hastables that contain tuples of integers encoded in a Zarith integer *) - type kind_array = | Kind_3 | Kind_6