diff --git a/Basis/ERI.ml b/Basis/ERI.ml index fddcc96..a6782c9 100644 --- a/Basis/ERI.ml +++ b/Basis/ERI.ml @@ -22,12 +22,18 @@ let zero_m ~maxm ~expo_pq_inv ~norm_pq_sq = (** Compute all the integrals of a contracted class *) +(* let contracted_class shell_a shell_b shell_c shell_d : float Zmap.t = TwoElectronRRVectorized.contracted_class ~zero_m shell_a shell_b shell_c shell_d + *) +let contracted_class shell_a shell_b shell_c shell_d : float Zmap.t = + TwoElectronRR.contracted_class ~zero_m shell_a shell_b shell_c shell_d (** Compute all the integrals of a contracted class *) -let contracted_class_shell_pairs ?schwartz_p ?schwartz_q shell_p shell_q : float Zmap.t = +let contracted_class_shell_pairs_vec ?schwartz_p ?schwartz_q shell_p shell_q : float Zmap.t = TwoElectronRRVectorized.contracted_class_shell_pairs ~zero_m ?schwartz_p ?schwartz_q shell_p shell_q +let contracted_class_shell_pairs ?schwartz_p ?schwartz_q shell_p shell_q : float Zmap.t = + TwoElectronRR.contracted_class_shell_pairs ~zero_m ?schwartz_p ?schwartz_q shell_p shell_q let cutoff2 = cutoff *. cutoff @@ -85,7 +91,10 @@ let to_file ~filename basis = in (* Compute all the integrals of the class *) let cls = - contracted_class_shell_pairs ~schwartz_p ~schwartz_q shell_p shell_q + if Array.length shell_q < 2 then + contracted_class_shell_pairs ~schwartz_p ~schwartz_q shell_p shell_q + else + contracted_class_shell_pairs_vec ~schwartz_p ~schwartz_q shell_p shell_q in (* Write the data in the output file *) diff --git a/Basis/TwoElectronRRVectorized.ml b/Basis/TwoElectronRRVectorized.ml index 84b66d9..4babfc8 100644 --- a/Basis/TwoElectronRRVectorized.ml +++ b/Basis/TwoElectronRRVectorized.ml @@ -5,7 +5,7 @@ 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) +let hvrr_two_e_vector m (angMom_a, angMom_b, angMom_c, angMom_d) (totAngMom_a, totAngMom_b, totAngMom_c, totAngMom_d) (maxm, zero_m_array) (expo_b, expo_d) @@ -14,6 +14,11 @@ let hvrr_two_e m (angMom_a, angMom_b, angMom_c, angMom_d) coef_prod map = + let ncoef = (Array.length coef_prod) in + let empty = + Array.make ncoef 0. + in + let totAngMom_a = Angular_momentum.to_int totAngMom_a and totAngMom_b = Angular_momentum.to_int totAngMom_b and totAngMom_c = Angular_momentum.to_int totAngMom_c @@ -21,13 +26,14 @@ let hvrr_two_e m (angMom_a, angMom_b, angMom_c, angMom_d) in (** Vertical recurrence relations *) - let rec vrr0 m angMom_a = function + let rec vrr0_v m angMom_a = function | 0 -> Array.mapi (fun k c -> c *. zero_m_array.(k).(m)) coef_prod | 1 -> let i = if angMom_a.(0) = 1 then 0 else if angMom_a.(1) = 1 then 1 else 2 in + let f = expo_b *. (Coordinate.coord center_ab i) in Array.mapi (fun k c -> c *. expo_inv_p *. ( (Coordinate.coord center_pq.(k) i) *. zero_m_array.(k).(m+1) - -. expo_b *. (Coordinate.coord center_ab i) *. zero_m_array.(k).(m) ) ) coef_prod + -. f *. zero_m_array.(k).(m) ) ) coef_prod | totAngMom_a -> let key = Zkey.of_int_tuple (Zkey.Three @@ -48,37 +54,36 @@ let hvrr_two_e m (angMom_a, angMom_b, angMom_c, angMom_d) am.(xyz) <- am.(xyz) - 1; amm.(xyz) <- amm.(xyz) - 2; if am.(xyz) < 0 then - Array.map (fun _ -> 0.) coef_prod + empty else let v1 = - vrr0 m am (totAngMom_a-1) - and v2 = - vrr0 (m+1) am (totAngMom_a-1) + let f = + -. expo_b *. expo_inv_p *. (Coordinate.coord center_ab xyz) + in + Array.mapi (fun k v1k -> f *. v1k) (vrr0_v m am (totAngMom_a-1) ) in let p1 = - Array.mapi (fun k _ -> - (-. expo_b *. expo_inv_p *. (Coordinate.coord center_ab xyz)) *. v1.(k) - +. (expo_inv_p *. (Coordinate.coord center_pq.(k) xyz)) *. v2.(k) - ) coef_prod + + Array.mapi (fun k v2k -> v1.(k) +. expo_inv_p *. (Coordinate.coord center_pq.(k) xyz) *. v2k) (vrr0_v (m+1) am (totAngMom_a-1)) in if amm.(xyz) < 0 then p1 else - let v1 = vrr0 m amm (totAngMom_a-2) - and v2 = vrr0 (m+1) amm (totAngMom_a-2) + let v1 = vrr0_v m amm (totAngMom_a-2) + and v2 = vrr0_v (m+1) amm (totAngMom_a-2) + and f = (float_of_int am.(xyz)) *. expo_inv_p *. 0.5 in Array.mapi (fun k _ -> p1.(k) +. - (float_of_int am.(xyz)) *. expo_inv_p *. 0.5 - *. (v1.(k) +. v2.(k) *. expo_inv_p ) ) coef_prod + f *. (v1.(k) +. v2.(k) *. expo_inv_p ) ) coef_prod ) in if not found then Zmap.add map.(m) key result; result - and vrr m angMom_a angMom_c totAngMom_a totAngMom_c = + and vrr_v m angMom_a angMom_c totAngMom_a totAngMom_c = match (totAngMom_a, totAngMom_c) with | (0,0) -> Array.mapi (fun k c -> c *. zero_m_array.(k).(m)) coef_prod - | (_,0) -> vrr0 m angMom_a totAngMom_a + | (_,0) -> vrr0_v m angMom_a totAngMom_a | (_,_) -> let key = Zkey.of_int_tuple (Zkey.Six @@ -103,12 +108,12 @@ let hvrr_two_e m (angMom_a, angMom_b, angMom_c, angMom_d) cm.(xyz) <- cm.(xyz) - 1; cmm.(xyz) <- cmm.(xyz) - 2; if cm.(xyz) < 0 then - Array.map (fun _ -> 0.) coef_prod + empty else let v1 = - vrr m angMom_a cm totAngMom_a (totAngMom_c-1) + vrr_v m angMom_a cm totAngMom_a (totAngMom_c-1) and v2 = - vrr (m+1) angMom_a cm totAngMom_a (totAngMom_c-1) + vrr_v (m+1) angMom_a cm totAngMom_a (totAngMom_c-1) in let p1 = Array.mapi (fun k _ -> @@ -119,21 +124,24 @@ let hvrr_two_e m (angMom_a, angMom_b, angMom_c, angMom_d) let p2 = if cmm.(xyz) < 0 then p1 else let v1 = - vrr m angMom_a cmm totAngMom_a (totAngMom_c-2) + vrr_v m angMom_a cmm totAngMom_a (totAngMom_c-2) and v2 = - vrr (m+1) angMom_a cmm totAngMom_a (totAngMom_c-2) + vrr_v (m+1) angMom_a cmm totAngMom_a (totAngMom_c-2) + and fcm = + (float_of_int cm.(xyz)) *. 0.5 in - Array.mapi (fun k _ -> p1.(k) +. - ((float_of_int cm.(xyz)) *. expo_inv_q.(k) *. 0.5 ) + Array.mapi (fun k _ -> p1.(k) +. fcm *. expo_inv_q.(k) *. (v1.(k) +. expo_inv_q.(k) *. v2.(k)) ) coef_prod in if (am.(xyz) < 0) || (cm.(xyz) < 0) then p2 else let v = - vrr (m+1) am cm (totAngMom_a-1) (totAngMom_c-1) + vrr_v (m+1) am cm (totAngMom_a-1) (totAngMom_c-1) + and fa = + (float_of_int angMom_a.(xyz)) *. expo_inv_p *. 0.5 in Array.mapi (fun k _ -> - p2.(k) -. (float_of_int angMom_a.(xyz)) *. expo_inv_p *. expo_inv_q.(k) *. 0.5 *.v.(k) + p2.(k) -. fa *. expo_inv_q.(k) *. v.(k) ) coef_prod ) in @@ -145,19 +153,27 @@ 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 + and hrr0_v 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 + | 0 -> + begin + match (totAngMom_a, totAngMom_c) with + | (0,0) -> Array.mapi (fun k c -> c *. zero_m_array.(k).(m)) coef_prod + | (_,0) -> vrr0_v m angMom_a totAngMom_a + | (_,_) -> vrr_v m angMom_a angMom_c totAngMom_a totAngMom_c + end | 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; let v1 = - vrr m ap angMom_c (totAngMom_a+1) totAngMom_c + vrr_v m ap angMom_c (totAngMom_a+1) totAngMom_c and v2 = - vrr m angMom_a angMom_c totAngMom_a totAngMom_c - in Array.map2 (fun v1 v2 -> v1 +. v2 *. (Coordinate.coord center_ab xyz) ) v1 v2 + vrr_v m angMom_a angMom_c totAngMom_a totAngMom_c + and f = Coordinate.coord center_ab xyz + in + Array.map2 (fun v1 v2 -> v1 +. v2 *. f) v1 v2 | _ -> let ap = [| angMom_a.(0) ; angMom_a.(1) ; angMom_a.(2) |] and bm = [| angMom_b.(0) ; angMom_b.(1) ; angMom_b.(2) |] @@ -169,19 +185,20 @@ let hvrr_two_e m (angMom_a, angMom_b, angMom_c, angMom_d) in ap.(xyz) <- ap.(xyz) + 1; bm.(xyz) <- bm.(xyz) - 1; - if (bm.(xyz) < 0) then Array.map (fun _ -> 0.) coef_prod else + if (bm.(xyz) < 0) then empty else let h1 = - hrr0 m ap bm angMom_c (totAngMom_a+1) (totAngMom_b-1) totAngMom_c + hrr0_v m ap bm angMom_c (totAngMom_a+1) (totAngMom_b-1) totAngMom_c and h2 = - hrr0 m angMom_a bm angMom_c totAngMom_a (totAngMom_b-1) totAngMom_c - in Array.map2 (fun h1 h2 -> h1 +. h2 *. (Coordinate.coord center_ab xyz)) h1 h2 + hrr0_v m angMom_a bm angMom_c totAngMom_a (totAngMom_b-1) totAngMom_c + and f = (Coordinate.coord center_ab xyz) + in Array.map2 (fun h1 h2 -> h1 +. h2 *. f) h1 h2 - and hrr m angMom_a angMom_b angMom_c angMom_d + and hrr_v 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) -> hrr0 m angMom_a angMom_b angMom_c totAngMom_a totAngMom_b totAngMom_c + | (0,0) -> vrr_v m angMom_a angMom_c totAngMom_a totAngMom_c + | (_,0) -> hrr0_v m angMom_a angMom_b angMom_c totAngMom_a totAngMom_b totAngMom_c | (_,_) -> let cp = [| angMom_c.(0) ; angMom_c.(1) ; angMom_c.(2) |] and dm = [| angMom_d.(0) ; angMom_d.(1) ; angMom_d.(2) |] @@ -193,18 +210,22 @@ let hvrr_two_e m (angMom_a, angMom_b, angMom_c, angMom_d) in cp.(xyz) <- cp.(xyz) + 1; dm.(xyz) <- dm.(xyz) - 1; - let h1, h2 = - hrr m angMom_a angMom_b cp dm totAngMom_a totAngMom_b (totAngMom_c+1) (totAngMom_d-1) , - hrr m angMom_a angMom_b angMom_c dm totAngMom_a totAngMom_b totAngMom_c (totAngMom_d-1) + let h1 = + hrr_v m angMom_a angMom_b cp dm totAngMom_a totAngMom_b (totAngMom_c+1) (totAngMom_d-1) + and h2 = + hrr_v m angMom_a angMom_b angMom_c dm totAngMom_a totAngMom_b totAngMom_c (totAngMom_d-1) in Array.mapi (fun k center_cd -> h1.(k) +. h2.(k) *. (Coordinate.coord center_cd xyz)) center_cd in - hrr m angMom_a angMom_b angMom_c angMom_d totAngMom_a totAngMom_b + hrr_v m angMom_a angMom_b angMom_c angMom_d totAngMom_a totAngMom_b totAngMom_c totAngMom_d + + + let contracted_class_shell_pairs ~zero_m ?schwartz_p ?schwartz_q shell_p shell_q : float Zmap.t = let shell_a = shell_p.(0).Shell_pair.shell_a @@ -237,39 +258,34 @@ let contracted_class_shell_pairs ~zero_m ?schwartz_p ?schwartz_q shell_p shell_q totAngMom shell_c, totAngMom shell_d) with | Angular_momentum.(S,S,S,S) -> contracted_class.(0) <- - Array.fold_left (fun accu shell_ab -> accu +. - Array.fold_left (fun accu shell_cd -> - let coef_prod = - shell_ab.Shell_pair.coef *. shell_cd.Shell_pair.coef - in - (** Screening on the product of coefficients *) - try - if (abs_float coef_prod) < 1.e-3*.cutoff then - raise NullQuartet; + Array.fold_left + (fun accu shell_ab -> accu +. + Array.fold_left (fun accu shell_cd -> + let coef_prod = + shell_ab.Shell_pair.coef *. shell_cd.Shell_pair.coef + in + (** Screening on the product of coefficients *) + try + if (abs_float coef_prod) < 1.e-3*.cutoff then + raise NullQuartet; - let expo_pq_inv = - shell_ab.Shell_pair.expo_inv +. shell_cd.Shell_pair.expo_inv - in - let center_pq = - Coordinate.(shell_ab.Shell_pair.center |- shell_cd.Shell_pair.center) - in - let norm_pq_sq = - Coordinate.dot center_pq center_pq - in + let expo_pq_inv = + shell_ab.Shell_pair.expo_inv +. shell_cd.Shell_pair.expo_inv + in + let center_pq = + Coordinate.(shell_ab.Shell_pair.center |- shell_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 zero_m_array = + zero_m ~maxm ~expo_pq_inv ~norm_pq_sq + in - let coef_prod = - shell_ab.Shell_pair.coef *. shell_cd.Shell_pair.coef - in - let integral = - zero_m_array.(0) - in - accu +. coef_prod *. integral - with NullQuartet -> accu - ) 0. shell_q + accu +. coef_prod *. zero_m_array.(0) + with NullQuartet -> accu + ) 0. shell_q ) 0. shell_p | _ -> @@ -297,8 +313,8 @@ let contracted_class_shell_pairs ~zero_m ?schwartz_p ?schwartz_q shell_p shell_q let d = shell_cd.Shell_pair.j in (zero_m_array, shell_cd.Shell_pair.expo_inv, - Contracted_shell.expo shell_d d, shell_cd.Shell_pair.center_ab, - center_pq,coef_prod,idx) + Contracted_shell.expo shell_d d, shell_cd.Shell_pair.center_ab, + center_pq,coef_prod,idx) ) shell_q |> Array.to_list |> List.filter (fun (zero_m_array, expo_inv, d, center_cd, @@ -306,9 +322,9 @@ let contracted_class_shell_pairs ~zero_m ?schwartz_p ?schwartz_q shell_p shell_q |> Array.of_list in let zero_m_array = Array.map (fun (zero_m_array, expo_inv, d, center_cd, - center_pq,coef_prod,idx) -> zero_m_array) common + center_pq,coef_prod,idx) -> zero_m_array) common and expo_inv = Array.map (fun (zero_m_array, expo_inv, d, center_cd, - center_pq,coef_prod,idx) -> expo_inv ) common + center_pq,coef_prod,idx) -> expo_inv ) common and d = Array.map (fun (zero_m_array, expo_inv, d, center_cd, center_pq,coef_prod,idx) -> d) common and center_cd = Array.map (fun (zero_m_array, expo_inv, d, center_cd, @@ -320,37 +336,35 @@ let contracted_class_shell_pairs ~zero_m ?schwartz_p ?schwartz_q shell_p shell_q and idx = Array.map (fun (zero_m_array, expo_inv, d, center_cd, center_pq,coef_prod,idx) -> idx) common in + (* Compute the integral class from the primitive shell quartet *) 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 - let norm = - Array.map (fun shell_cd -> - shell_ab.Shell_pair.norm_fun angMomA angMomB *. shell_cd.Shell_pair.norm_fun angMomC angMomD - ) shell_q - in - try + 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 + let norm = + Array.map (fun shell_cd -> + shell_ab.Shell_pair.norm_fun angMomA angMomB *. shell_cd.Shell_pair.norm_fun angMomC angMomD + ) shell_q + in let integral = - 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, d) - (shell_ab.Shell_pair.expo_inv, expo_inv) - (shell_ab.Shell_pair.center_ab, center_cd, center_pq) - coef_prod map - |> Array.mapi (fun i x -> x *. norm.(idx.(i)) ) + hvrr_two_e_vector 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, d) + (shell_ab.Shell_pair.expo_inv, expo_inv) + (shell_ab.Shell_pair.center_ab, center_cd, center_pq) + coef_prod map + |> Array.mapi (fun i x -> x *. norm.(idx.(i)) ) in let x = Array.fold_left (+.) 0. integral in contracted_class.(i) <- contracted_class.(i) +. x - with NullQuartet -> () - ) class_indices + ) class_indices ) shell_p end; diff --git a/Makefile b/Makefile index df0872a..b9b4652 100644 --- a/Makefile +++ b/Makefile @@ -41,3 +41,5 @@ doc: qpackage.odocl clean: rm -rf _build $(ALL_EXE) $(ALL_TESTS) *.native *.byte +debug: run_integrals.native + time ./run_integrals -c h2o.xyz -b ~/quantum_package/data/basis/cc-pvtz -o /dev/shm/out ; sleep 2 ; diff /dev/shm/out.eri REF | head -30