Line data Source code
1 : !--------------------------------------------------------------------------------------------------!
2 : ! CP2K: A general program to perform molecular dynamics simulations !
3 : ! Copyright 2000-2026 CP2K developers group <https://cp2k.org> !
4 : ! !
5 : ! SPDX-License-Identifier: GPL-2.0-or-later !
6 : !--------------------------------------------------------------------------------------------------!
7 :
8 : ! **************************************************************************************************
9 : !> \brief Interface to the Libint-Library
10 : !> \par History
11 : !> 11.2006 created [Manuel Guidon]
12 : !> 11.2019 Fixed potential_id initial values (A. Bussy)
13 : !> \author Manuel Guidon
14 : ! **************************************************************************************************
15 : MODULE hfx_libint_interface
16 :
17 : USE cell_types, ONLY: cell_type,&
18 : real_to_scaled
19 : USE gamma, ONLY: fgamma => fgamma_0
20 : USE hfx_contraction_methods, ONLY: contract
21 : USE hfx_types, ONLY: hfx_pgf_product_list,&
22 : hfx_potential_type
23 : USE input_constants, ONLY: &
24 : do_potential_coulomb, do_potential_gaussian, do_potential_id, do_potential_long, &
25 : do_potential_mix_cl, do_potential_mix_cl_trunc, do_potential_mix_lg, do_potential_short, &
26 : do_potential_truncated
27 : USE kinds, ONLY: dp,&
28 : int_8
29 : USE libint_wrapper, ONLY: cp_libint_get_derivs,&
30 : cp_libint_get_eris,&
31 : cp_libint_set_params_eri,&
32 : cp_libint_set_params_eri_deriv,&
33 : cp_libint_set_params_eri_screen,&
34 : cp_libint_t,&
35 : get_ssss_f_val,&
36 : prim_data_f_size
37 : USE mathconstants, ONLY: pi
38 : USE orbital_pointers, ONLY: nco
39 : USE t_c_g0, ONLY: t_c_g0_n
40 : #include "./base/base_uses.f90"
41 :
42 : IMPLICIT NONE
43 : PRIVATE
44 : PUBLIC :: evaluate_eri, &
45 : evaluate_deriv_eri, &
46 : evaluate_eri_screen
47 :
48 : INTEGER, DIMENSION(12), PARAMETER :: full_perm1 = [1, 2, 3, 4, 5, 6, 7, 8, 9, 10, 11, 12]
49 : INTEGER, DIMENSION(12), PARAMETER :: full_perm2 = [4, 5, 6, 1, 2, 3, 7, 8, 9, 10, 11, 12]
50 : INTEGER, DIMENSION(12), PARAMETER :: full_perm3 = [1, 2, 3, 4, 5, 6, 10, 11, 12, 7, 8, 9]
51 : INTEGER, DIMENSION(12), PARAMETER :: full_perm4 = [4, 5, 6, 1, 2, 3, 10, 11, 12, 7, 8, 9]
52 : INTEGER, DIMENSION(12), PARAMETER :: full_perm5 = [7, 8, 9, 10, 11, 12, 1, 2, 3, 4, 5, 6]
53 : INTEGER, DIMENSION(12), PARAMETER :: full_perm6 = [7, 8, 9, 10, 11, 12, 4, 5, 6, 1, 2, 3]
54 : INTEGER, DIMENSION(12), PARAMETER :: full_perm7 = [10, 11, 12, 7, 8, 9, 1, 2, 3, 4, 5, 6]
55 : INTEGER, DIMENSION(12), PARAMETER :: full_perm8 = [10, 11, 12, 7, 8, 9, 4, 5, 6, 1, 2, 3]
56 :
57 : !***
58 :
59 : CONTAINS
60 :
61 : ! **************************************************************************************************
62 : !> \brief Fill data structure used in libint
63 : !> \param A ...
64 : !> \param B ...
65 : !> \param C ...
66 : !> \param D ...
67 : !> \param Zeta_A ...
68 : !> \param Zeta_B ...
69 : !> \param Zeta_C ...
70 : !> \param Zeta_D ...
71 : !> \param m_max ...
72 : !> \param potential_parameter ...
73 : !> \param libint ...
74 : !> \param R11 ...
75 : !> \param R22 ...
76 : !> \par History
77 : !> 03.2007 created [Manuel Guidon]
78 : !> \author Manuel Guidon
79 : ! **************************************************************************************************
80 96382482 : SUBROUTINE build_quartet_data_screen(A, B, C, D, Zeta_A, Zeta_B, Zeta_C, Zeta_D, m_max, &
81 : potential_parameter, libint, R11, R22)
82 :
83 : REAL(KIND=dp) :: A(3), B(3), C(3), D(3)
84 : REAL(KIND=dp), INTENT(IN) :: Zeta_A, Zeta_B, Zeta_C, Zeta_D
85 : INTEGER, INTENT(IN) :: m_max
86 : TYPE(hfx_potential_type) :: potential_parameter
87 : TYPE(cp_libint_t) :: libint
88 : REAL(dp) :: R11, R22
89 :
90 : INTEGER :: i
91 : LOGICAL :: use_gamma
92 : REAL(KIND=dp) :: AB(3), AB2, CD(3), CD2, den, Eta, EtaInv, factor, G(3), num, omega2, &
93 : omega_corr, omega_corr2, P(3), PQ(3), PQ2, Q(3), R, R1, R2, Rho, RhoInv, S1234, ssss, T, &
94 : tmp, W(3), Zeta, ZetaInv, ZetapEtaInv
95 : REAL(KIND=dp), DIMENSION(prim_data_f_size) :: F, Fm
96 :
97 96382482 : Zeta = Zeta_A + Zeta_B
98 96382482 : ZetaInv = 1.0_dp/Zeta
99 96382482 : Eta = Zeta_C + Zeta_D
100 96382482 : EtaInv = 1.0_dp/Eta
101 96382482 : ZetapEtaInv = Zeta + Eta
102 96382482 : ZetapEtaInv = 1.0_dp/ZetapEtaInv
103 96382482 : Rho = Zeta*Eta*ZetapEtaInv
104 96382482 : RhoInv = 1.0_dp/Rho
105 :
106 385529928 : DO i = 1, 3
107 289147446 : P(i) = (Zeta_A*A(i) + Zeta_B*B(i))*ZetaInv
108 289147446 : Q(i) = (Zeta_C*C(i) + Zeta_D*D(i))*EtaInv
109 289147446 : AB(i) = A(i) - B(i)
110 289147446 : CD(i) = C(i) - D(i)
111 289147446 : PQ(i) = P(i) - Q(i)
112 385529928 : W(i) = (Zeta*P(i) + Eta*Q(i))*ZetapEtaInv
113 : END DO
114 :
115 385529928 : AB2 = DOT_PRODUCT(AB, AB)
116 385529928 : CD2 = DOT_PRODUCT(CD, CD)
117 385529928 : PQ2 = DOT_PRODUCT(PQ, PQ)
118 :
119 96382482 : S1234 = EXP((-Zeta_A*Zeta_B*ZetaInv*AB2) + (-Zeta_C*Zeta_D*EtaInv*CD2))
120 96382482 : T = Rho*PQ2
121 :
122 109708422 : SELECT CASE (potential_parameter%potential_type)
123 : CASE (do_potential_truncated)
124 13325940 : R = potential_parameter%cutoff_radius*SQRT(rho)
125 13325940 : R1 = R11
126 13325940 : R2 = R22
127 13325940 : IF (PQ2 > (R1 + R2 + potential_parameter%cutoff_radius)**2) THEN
128 0 : RETURN
129 : END IF
130 13325940 : CALL t_c_g0_n(F(1), use_gamma, R, T, m_max)
131 13325940 : IF (use_gamma) CALL fgamma(m_max, T, F(1))
132 13325940 : factor = 2.0_dp*Pi*RhoInv
133 : CASE (do_potential_coulomb)
134 74713134 : CALL fgamma(m_max, T, F(1))
135 74713134 : factor = 2.0_dp*Pi*RhoInv
136 : CASE (do_potential_short)
137 3091812 : R = potential_parameter%cutoff_radius*SQRT(rho)
138 3091812 : R1 = R11
139 3091812 : R2 = R22
140 3091812 : IF (PQ2 > (R1 + R2 + potential_parameter%cutoff_radius)**2) THEN
141 : RETURN
142 : END IF
143 3091812 : CALL fgamma(m_max, T, F(1))
144 3091812 : omega2 = potential_parameter%omega**2
145 3091812 : omega_corr2 = omega2/(omega2 + Rho)
146 3091812 : omega_corr = SQRT(omega_corr2)
147 3091812 : T = T*omega_corr2
148 3091812 : CALL fgamma(m_max, T, Fm)
149 3091812 : tmp = -omega_corr
150 11625504 : DO i = 1, m_max + 1
151 8533692 : F(i) = F(i) + Fm(i)*tmp
152 11625504 : tmp = tmp*omega_corr2
153 : END DO
154 3091812 : factor = 2.0_dp*Pi*RhoInv
155 : CASE (do_potential_long)
156 1007172 : omega2 = potential_parameter%omega**2
157 1007172 : omega_corr2 = omega2/(omega2 + Rho)
158 1007172 : omega_corr = SQRT(omega_corr2)
159 1007172 : T = T*omega_corr2
160 1007172 : CALL fgamma(m_max, T, F(1))
161 1007172 : tmp = omega_corr
162 3623880 : DO i = 1, m_max + 1
163 2616708 : F(i) = F(i)*tmp
164 3623880 : tmp = tmp*omega_corr2
165 : END DO
166 1007172 : factor = 2.0_dp*Pi*RhoInv
167 : CASE (do_potential_mix_cl)
168 2770026 : CALL fgamma(m_max, T, F(1))
169 2770026 : omega2 = potential_parameter%omega**2
170 2770026 : omega_corr2 = omega2/(omega2 + Rho)
171 2770026 : omega_corr = SQRT(omega_corr2)
172 2770026 : T = T*omega_corr2
173 2770026 : CALL fgamma(m_max, T, Fm)
174 2770026 : tmp = omega_corr
175 9537228 : DO i = 1, m_max + 1
176 6767202 : F(i) = F(i)*potential_parameter%scale_coulomb + Fm(i)*tmp*potential_parameter%scale_longrange
177 9537228 : tmp = tmp*omega_corr2
178 : END DO
179 2770026 : factor = 2.0_dp*Pi*RhoInv
180 : CASE (do_potential_mix_cl_trunc)
181 :
182 : ! truncated
183 959298 : R = potential_parameter%cutoff_radius*SQRT(rho)
184 959298 : R1 = R11
185 959298 : R2 = R22
186 959298 : IF (PQ2 > (R1 + R2 + potential_parameter%cutoff_radius)**2) THEN
187 : RETURN
188 : END IF
189 959298 : CALL t_c_g0_n(F(1), use_gamma, R, T, m_max)
190 959298 : IF (use_gamma) CALL fgamma(m_max, T, F(1))
191 :
192 : ! Coulomb
193 959298 : CALL fgamma(m_max, T, Fm)
194 :
195 3419052 : DO i = 1, m_max + 1
196 : F(i) = F(i)*(potential_parameter%scale_coulomb + potential_parameter%scale_longrange) - &
197 3419052 : Fm(i)*potential_parameter%scale_longrange
198 : END DO
199 :
200 : ! longrange
201 959298 : omega2 = potential_parameter%omega**2
202 959298 : omega_corr2 = omega2/(omega2 + Rho)
203 959298 : omega_corr = SQRT(omega_corr2)
204 959298 : T = T*omega_corr2
205 959298 : CALL fgamma(m_max, T, Fm)
206 959298 : tmp = omega_corr
207 3419052 : DO i = 1, m_max + 1
208 2459754 : F(i) = F(i) + Fm(i)*tmp*potential_parameter%scale_longrange
209 3419052 : tmp = tmp*omega_corr2
210 : END DO
211 959298 : factor = 2.0_dp*Pi*RhoInv
212 :
213 : CASE (do_potential_gaussian)
214 0 : omega2 = potential_parameter%omega**2
215 0 : T = -omega2*T/(Rho + omega2)
216 0 : tmp = 1.0_dp
217 0 : DO i = 1, m_max + 1
218 0 : F(i) = EXP(T)*tmp
219 0 : tmp = tmp*omega2/(Rho + omega2)
220 : END DO
221 0 : factor = (Pi/(Rho + omega2))**(1.5_dp)
222 : CASE (do_potential_mix_lg)
223 272700 : omega2 = potential_parameter%omega**2
224 272700 : omega_corr2 = omega2/(omega2 + Rho)
225 272700 : omega_corr = SQRT(omega_corr2)
226 272700 : T = T*omega_corr2
227 272700 : CALL fgamma(m_max, T, Fm)
228 272700 : tmp = omega_corr*2.0_dp*Pi*RhoInv*potential_parameter%scale_longrange
229 981720 : DO i = 1, m_max + 1
230 709020 : Fm(i) = Fm(i)*tmp
231 981720 : tmp = tmp*omega_corr2
232 : END DO
233 : T = Rho*PQ2
234 272700 : T = -omega2*T/(Rho + omega2)
235 272700 : tmp = (Pi/(Rho + omega2))**(1.5_dp)*potential_parameter%scale_gaussian
236 981720 : DO i = 1, m_max + 1
237 709020 : F(i) = EXP(T)*tmp + Fm(i)
238 981720 : tmp = tmp*omega2/(Rho + omega2)
239 : END DO
240 242400 : factor = 1.0_dp
241 : CASE (do_potential_id)
242 242400 : ssss = -Zeta_A*Zeta_B*ZetaInv*AB2
243 :
244 242400 : num = (Zeta_A + Zeta_B)*Zeta_C
245 242400 : den = Zeta_A + Zeta_B + Zeta_C
246 969600 : ssss = ssss - num/den*SUM((P - C)**2)
247 :
248 969600 : G(:) = (Zeta_A*A(:) + Zeta_B*B(:) + Zeta_C*C(:))/den
249 242400 : num = den*Zeta_D
250 242400 : den = den + Zeta_D
251 969600 : ssss = ssss - num/den*SUM((G - D)**2)
252 :
253 5332800 : F(:) = EXP(ssss)
254 242400 : factor = 1.0_dp
255 110910120 : IF (S1234 > EPSILON(0.0_dp)) factor = 1.0_dp/S1234
256 : END SELECT
257 :
258 96382482 : tmp = (Pi*ZetapEtaInv)**3
259 96382482 : factor = factor*S1234*SQRT(tmp)
260 :
261 370948356 : DO i = 1, m_max + 1
262 370948356 : F(i) = F(i)*factor
263 : END DO
264 :
265 96382482 : CALL cp_libint_set_params_eri_screen(libint, A, B, C, D, P, Q, W, ZetaInv, EtaInv, ZetapEtaInv, Rho, m_max, F)
266 :
267 : END SUBROUTINE build_quartet_data_screen
268 :
269 : ! **************************************************************************************************
270 : !> \brief Fill data structure used in libderiv
271 : !> \param libint ...
272 : !> \param A ...
273 : !> \param B ...
274 : !> \param C ...
275 : !> \param D ...
276 : !> \param Zeta_A ...
277 : !> \param Zeta_B ...
278 : !> \param Zeta_C ...
279 : !> \param Zeta_D ...
280 : !> \param ZetaInv ...
281 : !> \param EtaInv ...
282 : !> \param ZetapEtaInv ...
283 : !> \param Rho ...
284 : !> \param RhoInv ...
285 : !> \param P ...
286 : !> \param Q ...
287 : !> \param W ...
288 : !> \param m_max ...
289 : !> \param F ...
290 : !> \par History
291 : !> 03.2007 created [Manuel Guidon]
292 : !> \author Manuel Guidon
293 : ! **************************************************************************************************
294 106214495 : SUBROUTINE build_deriv_data(libint, A, B, C, D, &
295 : Zeta_A, Zeta_B, Zeta_C, Zeta_D, &
296 : ZetaInv, EtaInv, ZetapEtaInv, Rho, RhoInv, &
297 106214495 : P, Q, W, m_max, F)
298 :
299 : TYPE(cp_libint_t) :: libint
300 : REAL(KIND=dp), INTENT(IN) :: A(3), B(3), C(3), D(3)
301 : REAL(dp), INTENT(IN) :: Zeta_A, Zeta_B, Zeta_C, Zeta_D, ZetaInv, &
302 : EtaInv, ZetapEtaInv, Rho, RhoInv, &
303 : P(3), Q(3), W(3)
304 : INTEGER, INTENT(IN) :: m_max
305 : REAL(KIND=dp), DIMENSION(:) :: F
306 :
307 : MARK_USED(D) ! todo: fix
308 : MARK_USED(Zeta_C)
309 : MARK_USED(RhoInv)
310 :
311 : CALL cp_libint_set_params_eri_deriv(libint, A, B, C, D, P, Q, W, zeta_A, zeta_B, zeta_C, zeta_D, &
312 106214495 : ZetaInv, EtaInv, ZetapEtaInv, Rho, m_max, F)
313 :
314 106214495 : END SUBROUTINE build_deriv_data
315 :
316 : ! **************************************************************************************************
317 : !> \brief Evaluates derivatives of electron repulsion integrals for a primitive quartet
318 : !> \param deriv ...
319 : !> \param nproducts ...
320 : !> \param pgf_product_list ...
321 : !> \param n_a ...
322 : !> \param n_b ...
323 : !> \param n_c ...
324 : !> \param n_d ...
325 : !> \param ncoa ...
326 : !> \param ncob ...
327 : !> \param ncoc ...
328 : !> \param ncod ...
329 : !> \param nsgfa ...
330 : !> \param nsgfb ...
331 : !> \param nsgfc ...
332 : !> \param nsgfd ...
333 : !> \param primitives ...
334 : !> \param max_contraction ...
335 : !> \param tmp_max_all ...
336 : !> \param eps_schwarz ...
337 : !> \param neris ...
338 : !> \param Zeta_A ...
339 : !> \param Zeta_B ...
340 : !> \param Zeta_C ...
341 : !> \param Zeta_D ...
342 : !> \param ZetaInv ...
343 : !> \param EtaInv ...
344 : !> \param s_offset_a ...
345 : !> \param s_offset_b ...
346 : !> \param s_offset_c ...
347 : !> \param s_offset_d ...
348 : !> \param nl_a ...
349 : !> \param nl_b ...
350 : !> \param nl_c ...
351 : !> \param nl_d ...
352 : !> \param nsoa ...
353 : !> \param nsob ...
354 : !> \param nsoc ...
355 : !> \param nsod ...
356 : !> \param sphi_a ...
357 : !> \param sphi_b ...
358 : !> \param sphi_c ...
359 : !> \param sphi_d ...
360 : !> \param work ...
361 : !> \param work2 ...
362 : !> \param work_forces ...
363 : !> \param buffer1 ...
364 : !> \param buffer2 ...
365 : !> \param primitives_tmp ...
366 : !> \param use_virial ...
367 : !> \param work_virial ...
368 : !> \param work2_virial ...
369 : !> \param primitives_tmp_virial ...
370 : !> \param primitives_virial ...
371 : !> \param cell ...
372 : !> \param tmp_max_all_virial ...
373 : !> \par History
374 : !> 03.2007 created [Manuel Guidon]
375 : !> 08.2007 refactured permutation part [Manuel Guidon]
376 : !> \author Manuel Guidon
377 : ! **************************************************************************************************
378 34023121 : SUBROUTINE evaluate_deriv_eri(deriv, nproducts, pgf_product_list, &
379 : n_a, n_b, n_c, n_d, &
380 : ncoa, ncob, ncoc, ncod, &
381 : nsgfa, nsgfb, nsgfc, nsgfd, &
382 34023121 : primitives, max_contraction, tmp_max_all, &
383 : eps_schwarz, neris, &
384 : Zeta_A, Zeta_B, Zeta_C, Zeta_D, ZetaInv, EtaInv, &
385 : s_offset_a, s_offset_b, s_offset_c, s_offset_d, &
386 : nl_a, nl_b, nl_c, nl_d, nsoa, nsob, nsoc, nsod, &
387 34023121 : sphi_a, sphi_b, sphi_c, sphi_d, &
388 34023121 : work, work2, work_forces, buffer1, buffer2, primitives_tmp, &
389 34023121 : use_virial, work_virial, work2_virial, primitives_tmp_virial, &
390 34023121 : primitives_virial, cell, tmp_max_all_virial)
391 :
392 : TYPE(cp_libint_t) :: deriv
393 : INTEGER, INTENT(IN) :: nproducts
394 : TYPE(hfx_pgf_product_list), DIMENSION(nproducts) :: pgf_product_list
395 : INTEGER, INTENT(IN) :: n_a, n_b, n_c, n_d, ncoa, ncob, ncoc, &
396 : ncod, nsgfa, nsgfb, nsgfc, nsgfd
397 : REAL(dp), &
398 : DIMENSION(nsgfa, nsgfb, nsgfc, nsgfd, 12) :: primitives
399 : REAL(dp) :: max_contraction, tmp_max_all, eps_schwarz
400 : INTEGER(int_8) :: neris
401 : REAL(dp), INTENT(IN) :: Zeta_A, Zeta_B, Zeta_C, Zeta_D, ZetaInv, &
402 : EtaInv
403 : INTEGER :: s_offset_a, s_offset_b, s_offset_c, &
404 : s_offset_d, nl_a, nl_b, nl_c, nl_d, &
405 : nsoa, nsob, nsoc, nsod
406 : REAL(dp), DIMENSION(ncoa, nsoa*nl_a) :: sphi_a
407 : REAL(dp), DIMENSION(ncob, nsob*nl_b) :: sphi_b
408 : REAL(dp), DIMENSION(ncoc, nsoc*nl_c) :: sphi_c
409 : REAL(dp), DIMENSION(ncod, nsod*nl_d) :: sphi_d
410 : REAL(dp) :: work(ncoa*ncob*ncoc*ncod, 12), work2(ncoa, ncob, ncoc, ncod, 12), &
411 : work_forces(ncoa*ncob*ncoc*ncod, 12)
412 : REAL(dp), DIMENSION(ncoa*ncob*ncoc*ncod) :: buffer1, buffer2
413 : REAL(dp), DIMENSION(nsoa*nl_a, nsob*nl_b, nsoc*&
414 : nl_c, nsod*nl_d) :: primitives_tmp
415 : LOGICAL, INTENT(IN) :: use_virial
416 : REAL(dp) :: work_virial(ncoa*ncob*ncoc*ncod, 12, 3), &
417 : work2_virial(ncoa, ncob, ncoc, ncod, 12, 3)
418 : REAL(dp), DIMENSION(nsoa*nl_a, nsob*nl_b, nsoc*&
419 : nl_c, nsod*nl_d) :: primitives_tmp_virial
420 : REAL(dp), &
421 : DIMENSION(nsgfa, nsgfb, nsgfc, nsgfd, 12, 3) :: primitives_virial
422 : TYPE(cell_type), POINTER :: cell
423 : REAL(dp) :: tmp_max_all_virial
424 :
425 : INTEGER :: a_mysize(1), i, j, k, l, m, m_max, &
426 : mysize, n, p1, p2, p3, p4, perm_case
427 : LOGICAL :: direct_contract
428 : REAL(dp) :: A(3), AB(3), B(3), C(3), CD(3), D(3), &
429 : P(3), Q(3), Rho, RhoInv, scoord(12), &
430 : tmp_max, tmp_max_virial, W(3), &
431 : ZetapEtaInv
432 :
433 34023121 : m_max = n_a + n_b + n_c + n_d
434 34023121 : m_max = m_max + 1
435 34023121 : mysize = ncoa*ncob*ncoc*ncod
436 68046242 : a_mysize = mysize
437 :
438 4875120841 : work = 0.0_dp
439 9252283381 : work2 = 0.0_dp
440 :
441 34023121 : IF (use_virial) THEN
442 858372308 : work_virial = 0.0_dp
443 1480522004 : work2_virial = 0.0_dp
444 : END IF
445 :
446 34023121 : perm_case = 1
447 34023121 : IF (n_a < n_b) THEN
448 3455831 : perm_case = perm_case + 1
449 : END IF
450 34023121 : IF (n_c < n_d) THEN
451 5774825 : perm_case = perm_case + 2
452 : END IF
453 34023121 : IF (n_a + n_b > n_c + n_d) THEN
454 6474563 : perm_case = perm_case + 4
455 : END IF
456 :
457 : SELECT CASE (perm_case)
458 : CASE (1)
459 86051775 : DO i = 1, nproducts
460 259517456 : A = pgf_product_list(i)%ra
461 259517456 : B = pgf_product_list(i)%rb
462 259517456 : C = pgf_product_list(i)%rc
463 259517456 : D = pgf_product_list(i)%rd
464 64879364 : Rho = pgf_product_list(i)%Rho
465 : RhoInv = pgf_product_list(i)%RhoInv
466 259517456 : P = pgf_product_list(i)%P
467 259517456 : Q = pgf_product_list(i)%Q
468 259517456 : W = pgf_product_list(i)%W
469 259517456 : AB = pgf_product_list(i)%AB
470 259517456 : CD = pgf_product_list(i)%CD
471 64879364 : ZetapEtaInv = pgf_product_list(i)%ZetapEtaInv
472 :
473 : CALL build_deriv_data(deriv, A, B, C, D, &
474 : Zeta_A, Zeta_B, Zeta_C, Zeta_D, &
475 : ZetaInv, EtaInv, ZetapEtaInv, Rho, RhoInv, &
476 64879364 : P, Q, W, m_max, pgf_product_list(i)%Fm)
477 64879364 : CALL cp_libint_get_derivs(n_d, n_c, n_b, n_a, deriv, work_forces, a_mysize)
478 259517456 : DO k = 4, 6
479 1999320179 : DO j = 1, mysize
480 : work_forces(j, k) = -1.0_dp*(work_forces(j, k - 3) + &
481 : work_forces(j, k + 3) + &
482 1934440815 : work_forces(j, k + 6))
483 : END DO
484 : END DO
485 843431732 : DO k = 1, 12
486 7802642624 : DO j = 1, mysize
487 7737763260 : work(j, k) = work(j, k) + work_forces(j, k)
488 : END DO
489 : END DO
490 64879364 : neris = neris + 12*mysize
491 86051775 : IF (use_virial) THEN
492 13737793 : CALL real_to_scaled(scoord(1:3), A, cell)
493 13737793 : CALL real_to_scaled(scoord(4:6), B, cell)
494 13737793 : CALL real_to_scaled(scoord(7:9), C, cell)
495 13737793 : CALL real_to_scaled(scoord(10:12), D, cell)
496 178591309 : DO k = 1, 12
497 1426369861 : DO j = 1, mysize
498 5155967724 : DO m = 1, 3
499 4991114208 : work_virial(j, k, m) = work_virial(j, k, m) + work_forces(j, k)*scoord(INT((k - 1)/3)*3 + m)
500 : END DO
501 : END DO
502 : END DO
503 : END IF
504 : END DO
505 :
506 275241343 : DO n = 1, 12
507 : tmp_max = 0.0_dp
508 2347467036 : DO i = 1, mysize
509 2347467036 : tmp_max = MAX(tmp_max, ABS(work(i, n)))
510 : END DO
511 254068932 : tmp_max = tmp_max*max_contraction
512 254068932 : tmp_max_all = MAX(tmp_max_all, tmp_max)
513 :
514 634167859 : DO i = 1, ncoa
515 358926516 : p1 = (i - 1)*ncob
516 1012052748 : DO j = 1, ncob
517 399057300 : p2 = (p1 + j - 1)*ncoc
518 1864762248 : DO k = 1, ncoc
519 1106778432 : p3 = (p2 + k - 1)*ncod
520 3599233836 : DO l = 1, ncod
521 2093398104 : p4 = p3 + l
522 3200176536 : work2(i, j, k, l, full_perm1(n)) = work(p4, n)
523 : END DO
524 : END DO
525 : END DO
526 : END DO
527 : END DO
528 21172411 : IF (use_virial) THEN
529 6339801 : DO n = 1, 12
530 : tmp_max_virial = 0.0_dp
531 114225456 : DO i = 1, mysize
532 : tmp_max_virial = MAX(tmp_max_virial, &
533 114225456 : ABS(work_virial(i, n, 1)), ABS(work_virial(i, n, 2)), ABS(work_virial(i, n, 3)))
534 : END DO
535 5852124 : tmp_max_virial = tmp_max_virial*max_contraction
536 5852124 : tmp_max_all_virial = MAX(tmp_max_all_virial, tmp_max_virial)
537 :
538 16801569 : DO i = 1, ncoa
539 10461768 : p1 = (i - 1)*ncob
540 30447876 : DO j = 1, ncob
541 14133984 : p2 = (p1 + j - 1)*ncoc
542 70588716 : DO k = 1, ncoc
543 45992964 : p3 = (p2 + k - 1)*ncod
544 168500280 : DO l = 1, ncod
545 108373332 : p4 = p3 + l
546 479486292 : work2_virial(i, j, k, l, full_perm1(n), 1:3) = work_virial(p4, n, 1:3)
547 : END DO
548 : END DO
549 : END DO
550 : END DO
551 : END DO
552 : END IF
553 : CASE (2)
554 6242248 : DO i = 1, nproducts
555 19496868 : A = pgf_product_list(i)%ra
556 19496868 : B = pgf_product_list(i)%rb
557 19496868 : C = pgf_product_list(i)%rc
558 19496868 : D = pgf_product_list(i)%rd
559 4874217 : Rho = pgf_product_list(i)%Rho
560 : RhoInv = pgf_product_list(i)%RhoInv
561 19496868 : P = pgf_product_list(i)%P
562 19496868 : Q = pgf_product_list(i)%Q
563 19496868 : W = pgf_product_list(i)%W
564 19496868 : AB = pgf_product_list(i)%AB
565 19496868 : CD = pgf_product_list(i)%CD
566 4874217 : ZetapEtaInv = pgf_product_list(i)%ZetapEtaInv
567 :
568 : CALL build_deriv_data(deriv, B, A, C, D, &
569 : Zeta_B, Zeta_A, Zeta_C, Zeta_D, &
570 : ZetaInv, EtaInv, ZetapEtaInv, Rho, RhoInv, &
571 4874217 : P, Q, W, m_max, pgf_product_list(i)%Fm)
572 4874217 : CALL cp_libint_get_derivs(n_d, n_c, n_a, n_b, deriv, work_forces, a_mysize)
573 19496868 : DO k = 4, 6
574 350195730 : DO j = 1, mysize
575 : work_forces(j, k) = -1.0_dp*(work_forces(j, k - 3) + &
576 : work_forces(j, k + 3) + &
577 345321513 : work_forces(j, k + 6))
578 : END DO
579 : END DO
580 63364821 : DO k = 1, 12
581 1386160269 : DO j = 1, mysize
582 1381286052 : work(j, k) = work(j, k) + work_forces(j, k)
583 : END DO
584 : END DO
585 4874217 : neris = neris + 12*mysize
586 6242248 : IF (use_virial) THEN
587 796892 : CALL real_to_scaled(scoord(1:3), B, cell)
588 796892 : CALL real_to_scaled(scoord(4:6), A, cell)
589 796892 : CALL real_to_scaled(scoord(7:9), C, cell)
590 796892 : CALL real_to_scaled(scoord(10:12), D, cell)
591 10359596 : DO k = 1, 12
592 208367660 : DO j = 1, mysize
593 801594960 : DO m = 1, 3
594 792032256 : work_virial(j, k, m) = work_virial(j, k, m) + work_forces(j, k)*scoord(INT((k - 1)/3)*3 + m)
595 : END DO
596 : END DO
597 : END DO
598 : END IF
599 :
600 : END DO
601 17784403 : DO n = 1, 12
602 : tmp_max = 0.0_dp
603 442178724 : DO i = 1, mysize
604 442178724 : tmp_max = MAX(tmp_max, ABS(work(i, n)))
605 : END DO
606 16416372 : tmp_max = tmp_max*max_contraction
607 16416372 : tmp_max_all = MAX(tmp_max_all, tmp_max)
608 :
609 70203499 : DO j = 1, ncob
610 52419096 : p1 = (j - 1)*ncoa
611 123152772 : DO i = 1, ncoa
612 54317304 : p2 = (p1 + i - 1)*ncoc
613 304601256 : DO k = 1, ncoc
614 197864856 : p3 = (p2 + k - 1)*ncod
615 677944512 : DO l = 1, ncod
616 425762352 : p4 = p3 + l
617 623627208 : work2(i, j, k, l, full_perm2(n)) = work(p4, n)
618 : END DO
619 : END DO
620 : END DO
621 : END DO
622 : END DO
623 1368031 : IF (use_virial) THEN
624 1290653 : DO n = 1, 12
625 : tmp_max_virial = 0.0_dp
626 34981980 : DO i = 1, mysize
627 : tmp_max_virial = MAX(tmp_max_virial, &
628 34981980 : ABS(work_virial(i, n, 1)), ABS(work_virial(i, n, 2)), ABS(work_virial(i, n, 3)))
629 : END DO
630 1191372 : tmp_max_virial = tmp_max_virial*max_contraction
631 1191372 : tmp_max_all_virial = MAX(tmp_max_all_virial, tmp_max_virial)
632 :
633 5141141 : DO j = 1, ncob
634 3850488 : p1 = (j - 1)*ncoa
635 9076668 : DO i = 1, ncoa
636 4034808 : p2 = (p1 + i - 1)*ncoc
637 22502016 : DO k = 1, ncoc
638 14616720 : p3 = (p2 + k - 1)*ncod
639 52442136 : DO l = 1, ncod
640 33790608 : p4 = p3 + l
641 149779152 : work2_virial(i, j, k, l, full_perm2(n), 1:3) = work_virial(p4, n, 1:3)
642 : END DO
643 : END DO
644 : END DO
645 : END DO
646 : END DO
647 : END IF
648 : CASE (3)
649 17975483 : DO i = 1, nproducts
650 54892024 : A = pgf_product_list(i)%ra
651 54892024 : B = pgf_product_list(i)%rb
652 54892024 : C = pgf_product_list(i)%rc
653 54892024 : D = pgf_product_list(i)%rd
654 13723006 : Rho = pgf_product_list(i)%Rho
655 : RhoInv = pgf_product_list(i)%RhoInv
656 54892024 : P = pgf_product_list(i)%P
657 54892024 : Q = pgf_product_list(i)%Q
658 54892024 : W = pgf_product_list(i)%W
659 54892024 : AB = pgf_product_list(i)%AB
660 54892024 : CD = pgf_product_list(i)%CD
661 13723006 : ZetapEtaInv = pgf_product_list(i)%ZetapEtaInv
662 :
663 : CALL build_deriv_data(deriv, A, B, D, C, &
664 : Zeta_A, Zeta_B, Zeta_D, Zeta_C, &
665 : ZetaInv, EtaInv, ZetapEtaInv, Rho, RhoInv, &
666 13723006 : P, Q, W, m_max, pgf_product_list(i)%Fm)
667 13723006 : CALL cp_libint_get_derivs(n_c, n_d, n_b, n_a, deriv, work_forces, a_mysize)
668 54892024 : DO k = 4, 6
669 488335975 : DO j = 1, mysize
670 : work_forces(j, k) = -1.0_dp*(work_forces(j, k - 3) + &
671 : work_forces(j, k + 3) + &
672 474612969 : work_forces(j, k + 6))
673 : END DO
674 : END DO
675 178399078 : DO k = 1, 12
676 1912174882 : DO j = 1, mysize
677 1898451876 : work(j, k) = work(j, k) + work_forces(j, k)
678 : END DO
679 : END DO
680 13723006 : neris = neris + 12*mysize
681 17975483 : IF (use_virial) THEN
682 2206592 : CALL real_to_scaled(scoord(1:3), A, cell)
683 2206592 : CALL real_to_scaled(scoord(4:6), B, cell)
684 2206592 : CALL real_to_scaled(scoord(7:9), D, cell)
685 2206592 : CALL real_to_scaled(scoord(10:12), C, cell)
686 28685696 : DO k = 1, 12
687 233705804 : DO j = 1, mysize
688 846559536 : DO m = 1, 3
689 820080432 : work_virial(j, k, m) = work_virial(j, k, m) + work_forces(j, k)*scoord(INT((k - 1)/3)*3 + m)
690 : END DO
691 : END DO
692 : END DO
693 : END IF
694 :
695 : END DO
696 55282201 : DO n = 1, 12
697 : tmp_max = 0.0_dp
698 627248244 : DO i = 1, mysize
699 627248244 : tmp_max = MAX(tmp_max, ABS(work(i, n)))
700 : END DO
701 51029724 : tmp_max = tmp_max*max_contraction
702 51029724 : tmp_max_all = MAX(tmp_max_all, tmp_max)
703 :
704 145043641 : DO i = 1, ncoa
705 89761440 : p1 = (i - 1)*ncob
706 239793948 : DO j = 1, ncob
707 99002784 : p2 = (p1 + j - 1)*ncod
708 578537304 : DO l = 1, ncod
709 389773080 : p3 = (p2 + l - 1)*ncoc
710 1064994384 : DO k = 1, ncoc
711 576218520 : p4 = p3 + k
712 965991600 : work2(i, j, k, l, full_perm3(n)) = work(p4, n)
713 : END DO
714 : END DO
715 : END DO
716 : END DO
717 : END DO
718 4252477 : IF (use_virial) THEN
719 1864213 : DO n = 1, 12
720 : tmp_max_virial = 0.0_dp
721 32257128 : DO i = 1, mysize
722 : tmp_max_virial = MAX(tmp_max_virial, &
723 32257128 : ABS(work_virial(i, n, 1)), ABS(work_virial(i, n, 2)), ABS(work_virial(i, n, 3)))
724 : END DO
725 1720812 : tmp_max_virial = tmp_max_virial*max_contraction
726 1720812 : tmp_max_all_virial = MAX(tmp_max_all_virial, tmp_max_virial)
727 :
728 5377297 : DO i = 1, ncoa
729 3513084 : p1 = (i - 1)*ncob
730 9518388 : DO j = 1, ncob
731 4284492 : p2 = (p1 + j - 1)*ncod
732 26087412 : DO l = 1, ncod
733 18289836 : p3 = (p2 + l - 1)*ncoc
734 53110644 : DO k = 1, ncoc
735 30536316 : p4 = p3 + k
736 140435100 : work2_virial(i, j, k, l, full_perm3(n), 1:3) = work_virial(p4, n, 1:3)
737 : END DO
738 : END DO
739 : END DO
740 : END DO
741 : END DO
742 : END IF
743 : CASE (4)
744 3173155 : DO i = 1, nproducts
745 9670064 : A = pgf_product_list(i)%ra
746 9670064 : B = pgf_product_list(i)%rb
747 9670064 : C = pgf_product_list(i)%rc
748 9670064 : D = pgf_product_list(i)%rd
749 2417516 : Rho = pgf_product_list(i)%Rho
750 : RhoInv = pgf_product_list(i)%RhoInv
751 9670064 : P = pgf_product_list(i)%P
752 9670064 : Q = pgf_product_list(i)%Q
753 9670064 : W = pgf_product_list(i)%W
754 9670064 : AB = pgf_product_list(i)%AB
755 9670064 : CD = pgf_product_list(i)%CD
756 2417516 : ZetapEtaInv = pgf_product_list(i)%ZetapEtaInv
757 : CALL build_deriv_data(deriv, B, A, D, C, &
758 : Zeta_B, Zeta_A, Zeta_D, Zeta_C, &
759 : ZetaInv, EtaInv, ZetapEtaInv, Rho, RhoInv, &
760 2417516 : P, Q, W, m_max, pgf_product_list(i)%Fm)
761 2417516 : CALL cp_libint_get_derivs(n_c, n_d, n_a, n_b, deriv, work_forces, a_mysize)
762 9670064 : DO k = 4, 6
763 133711466 : DO j = 1, mysize
764 : work_forces(j, k) = -1.0_dp*(work_forces(j, k - 3) + &
765 : work_forces(j, k + 3) + &
766 131293950 : work_forces(j, k + 6))
767 : END DO
768 : END DO
769 31427708 : DO k = 1, 12
770 527593316 : DO j = 1, mysize
771 525175800 : work(j, k) = work(j, k) + work_forces(j, k)
772 : END DO
773 : END DO
774 2417516 : neris = neris + 12*mysize
775 3173155 : IF (use_virial) THEN
776 390264 : CALL real_to_scaled(scoord(1:3), B, cell)
777 390264 : CALL real_to_scaled(scoord(4:6), A, cell)
778 390264 : CALL real_to_scaled(scoord(7:9), D, cell)
779 390264 : CALL real_to_scaled(scoord(10:12), C, cell)
780 5073432 : DO k = 1, 12
781 67099776 : DO j = 1, mysize
782 252788544 : DO m = 1, 3
783 248105376 : work_virial(j, k, m) = work_virial(j, k, m) + work_forces(j, k)*scoord(INT((k - 1)/3)*3 + m)
784 : END DO
785 : END DO
786 : END DO
787 : END IF
788 :
789 : END DO
790 9823307 : DO n = 1, 12
791 : tmp_max = 0.0_dp
792 192620904 : DO i = 1, mysize
793 192620904 : tmp_max = MAX(tmp_max, ABS(work(i, n)))
794 : END DO
795 9067668 : tmp_max = tmp_max*max_contraction
796 9067668 : tmp_max_all = MAX(tmp_max_all, tmp_max)
797 :
798 38403383 : DO j = 1, ncob
799 28580076 : p1 = (j - 1)*ncoa
800 67785900 : DO i = 1, ncoa
801 30138156 : p2 = (p1 + i - 1)*ncod
802 177169932 : DO l = 1, ncod
803 118451700 : p3 = (p2 + l - 1)*ncoc
804 332143092 : DO k = 1, ncoc
805 183553236 : p4 = p3 + k
806 302004936 : work2(i, j, k, l, full_perm4(n)) = work(p4, n)
807 : END DO
808 : END DO
809 : END DO
810 : END DO
811 : END DO
812 755639 : IF (use_virial) THEN
813 671112 : DO n = 1, 12
814 : tmp_max_virial = 0.0_dp
815 14514984 : DO i = 1, mysize
816 : tmp_max_virial = MAX(tmp_max_virial, &
817 14514984 : ABS(work_virial(i, n, 1)), ABS(work_virial(i, n, 2)), ABS(work_virial(i, n, 3)))
818 : END DO
819 619488 : tmp_max_virial = tmp_max_virial*max_contraction
820 619488 : tmp_max_all_virial = MAX(tmp_max_all_virial, tmp_max_virial)
821 :
822 2640168 : DO j = 1, ncob
823 1969056 : p1 = (j - 1)*ncoa
824 4705056 : DO i = 1, ncoa
825 2116512 : p2 = (p1 + i - 1)*ncod
826 12508056 : DO l = 1, ncod
827 8422488 : p3 = (p2 + l - 1)*ncoc
828 24434496 : DO k = 1, ncoc
829 13895496 : p4 = p3 + k
830 64004472 : work2_virial(i, j, k, l, full_perm4(n), 1:3) = work_virial(p4, n, 1:3)
831 : END DO
832 : END DO
833 : END DO
834 : END DO
835 : END DO
836 : END IF
837 : CASE (5)
838 18697627 : DO i = 1, nproducts
839 56833804 : A = pgf_product_list(i)%ra
840 56833804 : B = pgf_product_list(i)%rb
841 56833804 : C = pgf_product_list(i)%rc
842 56833804 : D = pgf_product_list(i)%rd
843 14208451 : Rho = pgf_product_list(i)%Rho
844 : RhoInv = pgf_product_list(i)%RhoInv
845 56833804 : P = pgf_product_list(i)%P
846 56833804 : Q = pgf_product_list(i)%Q
847 56833804 : W = pgf_product_list(i)%W
848 56833804 : AB = pgf_product_list(i)%AB
849 56833804 : CD = pgf_product_list(i)%CD
850 14208451 : ZetapEtaInv = pgf_product_list(i)%ZetapEtaInv
851 : CALL build_deriv_data(deriv, C, D, A, B, &
852 : Zeta_C, Zeta_D, Zeta_A, Zeta_B, &
853 : EtaInv, ZetaInv, ZetapEtaInv, Rho, RhoInv, &
854 14208451 : Q, P, W, m_max, pgf_product_list(i)%Fm)
855 14208451 : CALL cp_libint_get_derivs(n_b, n_a, n_d, n_c, deriv, work_forces, a_mysize)
856 56833804 : DO k = 4, 6
857 546971905 : DO j = 1, mysize
858 : work_forces(j, k) = -1.0_dp*(work_forces(j, k - 3) + &
859 : work_forces(j, k + 3) + &
860 532763454 : work_forces(j, k + 6))
861 : END DO
862 : END DO
863 184709863 : DO k = 1, 12
864 2145262267 : DO j = 1, mysize
865 2131053816 : work(j, k) = work(j, k) + work_forces(j, k)
866 : END DO
867 : END DO
868 14208451 : neris = neris + 12*mysize
869 18697627 : IF (use_virial) THEN
870 2454373 : CALL real_to_scaled(scoord(1:3), C, cell)
871 2454373 : CALL real_to_scaled(scoord(4:6), D, cell)
872 2454373 : CALL real_to_scaled(scoord(7:9), A, cell)
873 2454373 : CALL real_to_scaled(scoord(10:12), B, cell)
874 31906849 : DO k = 1, 12
875 311832949 : DO j = 1, mysize
876 1149156876 : DO m = 1, 3
877 1119704400 : work_virial(j, k, m) = work_virial(j, k, m) + work_forces(j, k)*scoord(INT((k - 1)/3)*3 + m)
878 : END DO
879 : END DO
880 : END DO
881 : END IF
882 :
883 : END DO
884 58359288 : DO n = 1, 12
885 : tmp_max = 0.0_dp
886 691445016 : DO i = 1, mysize
887 691445016 : tmp_max = MAX(tmp_max, ABS(work(i, n)))
888 : END DO
889 53870112 : tmp_max = tmp_max*max_contraction
890 53870112 : tmp_max_all = MAX(tmp_max_all, tmp_max)
891 :
892 132292308 : DO k = 1, ncoc
893 73933020 : p1 = (k - 1)*ncod
894 206439480 : DO l = 1, ncod
895 78636348 : p2 = (p1 + l - 1)*ncoa
896 454252320 : DO i = 1, ncoa
897 301682952 : p3 = (p2 + i - 1)*ncob
898 1017894204 : DO j = 1, ncob
899 637574904 : p4 = p3 + j
900 939257856 : work2(i, j, k, l, full_perm5(n)) = work(p4, n)
901 : END DO
902 : END DO
903 : END DO
904 : END DO
905 : END DO
906 4489176 : IF (use_virial) THEN
907 2282215 : DO n = 1, 12
908 : tmp_max_virial = 0.0_dp
909 45229476 : DO i = 1, mysize
910 : tmp_max_virial = MAX(tmp_max_virial, &
911 45229476 : ABS(work_virial(i, n, 1)), ABS(work_virial(i, n, 2)), ABS(work_virial(i, n, 3)))
912 : END DO
913 2106660 : tmp_max_virial = tmp_max_virial*max_contraction
914 2106660 : tmp_max_all_virial = MAX(tmp_max_all_virial, tmp_max_virial)
915 :
916 5820403 : DO k = 1, ncoc
917 3538188 : p1 = (k - 1)*ncod
918 9603444 : DO l = 1, ncod
919 3958596 : p2 = (p1 + l - 1)*ncoa
920 23185224 : DO i = 1, ncoa
921 15688440 : p3 = (p2 + i - 1)*ncob
922 62769852 : DO j = 1, ncob
923 43122816 : p4 = p3 + j
924 188179704 : work2_virial(i, j, k, l, full_perm5(n), 1:3) = work_virial(p4, n, 1:3)
925 : END DO
926 : END DO
927 : END DO
928 : END DO
929 : END DO
930 : END IF
931 : CASE (6)
932 4871735 : DO i = 1, nproducts
933 14612228 : A = pgf_product_list(i)%ra
934 14612228 : B = pgf_product_list(i)%rb
935 14612228 : C = pgf_product_list(i)%rc
936 14612228 : D = pgf_product_list(i)%rd
937 3653057 : Rho = pgf_product_list(i)%Rho
938 : RhoInv = pgf_product_list(i)%RhoInv
939 14612228 : P = pgf_product_list(i)%P
940 14612228 : Q = pgf_product_list(i)%Q
941 14612228 : W = pgf_product_list(i)%W
942 14612228 : AB = pgf_product_list(i)%AB
943 14612228 : CD = pgf_product_list(i)%CD
944 3653057 : ZetapEtaInv = pgf_product_list(i)%ZetapEtaInv
945 :
946 : CALL build_deriv_data(deriv, C, D, B, A, &
947 : Zeta_C, Zeta_D, Zeta_B, Zeta_A, &
948 : EtaInv, ZetaInv, ZetapEtaInv, Rho, RhoInv, &
949 3653057 : Q, P, W, m_max, pgf_product_list(i)%Fm)
950 3653057 : CALL cp_libint_get_derivs(n_a, n_b, n_d, n_c, deriv, work_forces, a_mysize)
951 14612228 : DO k = 4, 6
952 139785551 : DO j = 1, mysize
953 : work_forces(j, k) = -1.0_dp*(work_forces(j, k - 3) + &
954 : work_forces(j, k + 3) + &
955 136132494 : work_forces(j, k + 6))
956 : END DO
957 : END DO
958 47489741 : DO k = 1, 12
959 548183033 : DO j = 1, mysize
960 544529976 : work(j, k) = work(j, k) + work_forces(j, k)
961 : END DO
962 : END DO
963 3653057 : neris = neris + 12*mysize
964 4871735 : IF (use_virial) THEN
965 439512 : CALL real_to_scaled(scoord(1:3), C, cell)
966 439512 : CALL real_to_scaled(scoord(4:6), D, cell)
967 439512 : CALL real_to_scaled(scoord(7:9), B, cell)
968 439512 : CALL real_to_scaled(scoord(10:12), A, cell)
969 5713656 : DO k = 1, 12
970 53754828 : DO j = 1, mysize
971 197438832 : DO m = 1, 3
972 192164688 : work_virial(j, k, m) = work_virial(j, k, m) + work_forces(j, k)*scoord(INT((k - 1)/3)*3 + m)
973 : END DO
974 : END DO
975 : END DO
976 : END IF
977 :
978 : END DO
979 15842814 : DO n = 1, 12
980 : tmp_max = 0.0_dp
981 201747672 : DO i = 1, mysize
982 201747672 : tmp_max = MAX(tmp_max, ABS(work(i, n)))
983 : END DO
984 14624136 : tmp_max = tmp_max*max_contraction
985 14624136 : tmp_max_all = MAX(tmp_max_all, tmp_max)
986 :
987 34585014 : DO k = 1, ncoc
988 18742200 : p1 = (k - 1)*ncod
989 55038144 : DO l = 1, ncod
990 21671808 : p2 = (p1 + l - 1)*ncob
991 137111160 : DO j = 1, ncob
992 96697152 : p3 = (p2 + j - 1)*ncoa
993 305492496 : DO i = 1, ncoa
994 187123536 : p4 = p3 + i
995 283820688 : work2(i, j, k, l, full_perm6(n)) = work(p4, n)
996 : END DO
997 : END DO
998 : END DO
999 : END DO
1000 : END DO
1001 1218678 : IF (use_virial) THEN
1002 843440 : DO n = 1, 12
1003 : tmp_max_virial = 0.0_dp
1004 16339668 : DO i = 1, mysize
1005 : tmp_max_virial = MAX(tmp_max_virial, &
1006 16339668 : ABS(work_virial(i, n, 1)), ABS(work_virial(i, n, 2)), ABS(work_virial(i, n, 3)))
1007 : END DO
1008 778560 : tmp_max_virial = tmp_max_virial*max_contraction
1009 778560 : tmp_max_all_virial = MAX(tmp_max_all_virial, tmp_max_virial)
1010 :
1011 1978136 : DO k = 1, ncoc
1012 1134696 : p1 = (k - 1)*ncod
1013 3342648 : DO l = 1, ncod
1014 1429392 : p2 = (p1 + l - 1)*ncob
1015 9578364 : DO j = 1, ncob
1016 7014276 : p3 = (p2 + j - 1)*ncoa
1017 24004776 : DO i = 1, ncoa
1018 15561108 : p4 = p3 + i
1019 69258708 : work2_virial(i, j, k, l, full_perm6(n), 1:3) = work_virial(p4, n, 1:3)
1020 : END DO
1021 : END DO
1022 : END DO
1023 : END DO
1024 : END DO
1025 : END IF
1026 : CASE (7)
1027 2841811 : DO i = 1, nproducts
1028 8754340 : A = pgf_product_list(i)%ra
1029 8754340 : B = pgf_product_list(i)%rb
1030 8754340 : C = pgf_product_list(i)%rc
1031 8754340 : D = pgf_product_list(i)%rd
1032 2188585 : Rho = pgf_product_list(i)%Rho
1033 : RhoInv = pgf_product_list(i)%RhoInv
1034 8754340 : P = pgf_product_list(i)%P
1035 8754340 : Q = pgf_product_list(i)%Q
1036 8754340 : W = pgf_product_list(i)%W
1037 8754340 : AB = pgf_product_list(i)%AB
1038 8754340 : CD = pgf_product_list(i)%CD
1039 2188585 : ZetapEtaInv = pgf_product_list(i)%ZetapEtaInv
1040 :
1041 : CALL build_deriv_data(deriv, D, C, A, B, &
1042 : Zeta_D, Zeta_C, Zeta_A, Zeta_B, &
1043 : EtaInv, ZetaInv, ZetapEtaInv, Rho, RhoInv, &
1044 2188585 : Q, P, W, m_max, pgf_product_list(i)%Fm)
1045 2188585 : CALL cp_libint_get_derivs(n_b, n_a, n_c, n_d, deriv, work_forces, a_mysize)
1046 8754340 : DO k = 4, 6
1047 213726838 : DO j = 1, mysize
1048 : work_forces(j, k) = -1.0_dp*(work_forces(j, k - 3) + &
1049 : work_forces(j, k + 3) + &
1050 211538253 : work_forces(j, k + 6))
1051 : END DO
1052 : END DO
1053 28451605 : DO k = 1, 12
1054 848341597 : DO j = 1, mysize
1055 846153012 : work(j, k) = work(j, k) + work_forces(j, k)
1056 : END DO
1057 : END DO
1058 2188585 : neris = neris + 12*mysize
1059 2841811 : IF (use_virial) THEN
1060 387133 : CALL real_to_scaled(scoord(1:3), D, cell)
1061 387133 : CALL real_to_scaled(scoord(4:6), C, cell)
1062 387133 : CALL real_to_scaled(scoord(7:9), A, cell)
1063 387133 : CALL real_to_scaled(scoord(10:12), B, cell)
1064 5032729 : DO k = 1, 12
1065 140390209 : DO j = 1, mysize
1066 546075516 : DO m = 1, 3
1067 541429920 : work_virial(j, k, m) = work_virial(j, k, m) + work_forces(j, k)*scoord(INT((k - 1)/3)*3 + m)
1068 : END DO
1069 : END DO
1070 : END DO
1071 : END IF
1072 :
1073 : END DO
1074 8491938 : DO n = 1, 12
1075 : tmp_max = 0.0_dp
1076 279958536 : DO i = 1, mysize
1077 279958536 : tmp_max = MAX(tmp_max, ABS(work(i, n)))
1078 : END DO
1079 7838712 : tmp_max = tmp_max*max_contraction
1080 7838712 : tmp_max_all = MAX(tmp_max_all, tmp_max)
1081 :
1082 32745030 : DO l = 1, ncod
1083 24253092 : p1 = (l - 1)*ncoc
1084 56789712 : DO k = 1, ncoc
1085 24697908 : p2 = (p1 + k - 1)*ncoa
1086 150110496 : DO i = 1, ncoa
1087 101159496 : p3 = (p2 + i - 1)*ncob
1088 397977228 : DO j = 1, ncob
1089 272119824 : p4 = p3 + j
1090 373279320 : work2(i, j, k, l, full_perm7(n)) = work(p4, n)
1091 : END DO
1092 : END DO
1093 : END DO
1094 : END DO
1095 : END DO
1096 653226 : IF (use_virial) THEN
1097 649454 : DO n = 1, 12
1098 : tmp_max_virial = 0.0_dp
1099 22159320 : DO i = 1, mysize
1100 : tmp_max_virial = MAX(tmp_max_virial, &
1101 22159320 : ABS(work_virial(i, n, 1)), ABS(work_virial(i, n, 2)), ABS(work_virial(i, n, 3)))
1102 : END DO
1103 599496 : tmp_max_virial = tmp_max_virial*max_contraction
1104 599496 : tmp_max_all_virial = MAX(tmp_max_all_virial, tmp_max_virial)
1105 :
1106 2504534 : DO l = 1, ncod
1107 1855080 : p1 = (l - 1)*ncoc
1108 4346520 : DO k = 1, ncoc
1109 1891944 : p2 = (p1 + k - 1)*ncoa
1110 10990800 : DO i = 1, ncoa
1111 7243776 : p3 = (p2 + i - 1)*ncob
1112 30695544 : DO j = 1, ncob
1113 21559824 : p4 = p3 + j
1114 93483072 : work2_virial(i, j, k, l, full_perm7(n), 1:3) = work_virial(p4, n, 1:3)
1115 : END DO
1116 : END DO
1117 : END DO
1118 : END DO
1119 : END DO
1120 : END IF
1121 : CASE (8)
1122 383782 : DO i = 1, nproducts
1123 1081196 : A = pgf_product_list(i)%ra
1124 1081196 : B = pgf_product_list(i)%rb
1125 1081196 : C = pgf_product_list(i)%rc
1126 1081196 : D = pgf_product_list(i)%rd
1127 270299 : Rho = pgf_product_list(i)%Rho
1128 : RhoInv = pgf_product_list(i)%RhoInv
1129 1081196 : P = pgf_product_list(i)%P
1130 1081196 : Q = pgf_product_list(i)%Q
1131 1081196 : W = pgf_product_list(i)%W
1132 1081196 : AB = pgf_product_list(i)%AB
1133 1081196 : CD = pgf_product_list(i)%CD
1134 270299 : ZetapEtaInv = pgf_product_list(i)%ZetapEtaInv
1135 :
1136 : CALL build_deriv_data(deriv, D, C, B, A, &
1137 : Zeta_D, Zeta_C, Zeta_B, Zeta_A, &
1138 : EtaInv, ZetaInv, ZetapEtaInv, Rho, RhoInv, &
1139 270299 : Q, P, W, m_max, pgf_product_list(i)%Fm)
1140 270299 : CALL cp_libint_get_derivs(n_a, n_b, n_c, n_d, deriv, work_forces, a_mysize)
1141 1081196 : DO k = 4, 6
1142 34572644 : DO j = 1, mysize
1143 : work_forces(j, k) = -1.0_dp*(work_forces(j, k - 3) + &
1144 : work_forces(j, k + 3) + &
1145 34302345 : work_forces(j, k + 6))
1146 : END DO
1147 : END DO
1148 3513887 : DO k = 1, 12
1149 137479679 : DO j = 1, mysize
1150 137209380 : work(j, k) = work(j, k) + work_forces(j, k)
1151 : END DO
1152 : END DO
1153 270299 : neris = neris + 12*mysize
1154 383782 : IF (use_virial) THEN
1155 22360 : CALL real_to_scaled(scoord(1:3), D, cell)
1156 22360 : CALL real_to_scaled(scoord(4:6), C, cell)
1157 22360 : CALL real_to_scaled(scoord(7:9), B, cell)
1158 22360 : CALL real_to_scaled(scoord(10:12), A, cell)
1159 290680 : DO k = 1, 12
1160 11617720 : DO j = 1, mysize
1161 45576480 : DO m = 1, 3
1162 45308160 : work_virial(j, k, m) = work_virial(j, k, m) + work_forces(j, k)*scoord(INT((k - 1)/3)*3 + m)
1163 : END DO
1164 : END DO
1165 : END DO
1166 : END IF
1167 :
1168 : END DO
1169 1475279 : DO n = 1, 12
1170 : tmp_max = 0.0_dp
1171 58431588 : DO i = 1, mysize
1172 58431588 : tmp_max = MAX(tmp_max, ABS(work(i, n)))
1173 : END DO
1174 1361796 : tmp_max = tmp_max*max_contraction
1175 1361796 : tmp_max_all = MAX(tmp_max_all, tmp_max)
1176 :
1177 5995655 : DO l = 1, ncod
1178 4520376 : p1 = (l - 1)*ncoc
1179 10402548 : DO k = 1, ncoc
1180 4520376 : p2 = (p1 + k - 1)*ncob
1181 36163008 : DO j = 1, ncob
1182 27122256 : p3 = (p2 + j - 1)*ncoa
1183 88712424 : DO i = 1, ncoa
1184 57069792 : p4 = p3 + i
1185 84192048 : work2(i, j, k, l, full_perm8(n)) = work(p4, n)
1186 : END DO
1187 : END DO
1188 : END DO
1189 : END DO
1190 : END DO
1191 34136604 : IF (use_virial) THEN
1192 119730 : DO n = 1, 12
1193 : tmp_max_virial = 0.0_dp
1194 4973976 : DO i = 1, mysize
1195 : tmp_max_virial = MAX(tmp_max_virial, &
1196 4973976 : ABS(work_virial(i, n, 1)), ABS(work_virial(i, n, 2)), ABS(work_virial(i, n, 3)))
1197 : END DO
1198 110520 : tmp_max_virial = tmp_max_virial*max_contraction
1199 110520 : tmp_max_all_virial = MAX(tmp_max_all_virial, tmp_max_virial)
1200 :
1201 488154 : DO l = 1, ncod
1202 368424 : p1 = (l - 1)*ncoc
1203 847368 : DO k = 1, ncoc
1204 368424 : p2 = (p1 + k - 1)*ncob
1205 2947392 : DO j = 1, ncob
1206 2210544 : p3 = (p2 + j - 1)*ncoa
1207 7442424 : DO i = 1, ncoa
1208 4863456 : p4 = p3 + i
1209 21664368 : work2_virial(i, j, k, l, full_perm8(n), 1:3) = work_virial(p4, n, 1:3)
1210 : END DO
1211 : END DO
1212 : END DO
1213 : END DO
1214 : END DO
1215 : END IF
1216 : END SELECT
1217 :
1218 34023121 : IF (.NOT. use_virial) THEN
1219 32941535 : IF (tmp_max_all < eps_schwarz) RETURN
1220 : END IF
1221 :
1222 : direct_contract = (s_offset_a == 0 .AND. s_offset_b == 0 .AND. &
1223 : s_offset_c == 0 .AND. s_offset_d == 0 .AND. &
1224 : nsgfa == nsoa*nl_a .AND. nsgfb == nsob*nl_b .AND. &
1225 29385084 : nsgfc == nsoc*nl_c .AND. nsgfd == nsod*nl_d)
1226 :
1227 29385084 : IF (tmp_max_all >= eps_schwarz) THEN
1228 29224671 : IF (direct_contract) THEN
1229 74823762 : DO i = 1, 12
1230 : CALL contract(ncoa, ncob, ncoc, ncod, nsoa, nsob, nsoc, nsod, &
1231 : n_a, n_b, n_c, n_d, nl_a, nl_b, nl_c, nl_d, work2(1, 1, 1, 1, i), &
1232 : sphi_a, &
1233 : sphi_b, &
1234 : sphi_c, &
1235 : sphi_d, &
1236 : primitives(1, 1, 1, 1, i), &
1237 74823762 : buffer1, buffer2)
1238 : END DO
1239 : ELSE
1240 305096961 : DO i = 1, 12
1241 19197727008 : primitives_tmp(:, :, :, :) = 0.0_dp
1242 : CALL contract(ncoa, ncob, ncoc, ncod, nsoa, nsob, nsoc, nsod, &
1243 : n_a, n_b, n_c, n_d, nl_a, nl_b, nl_c, nl_d, work2(1, 1, 1, 1, i), &
1244 : sphi_a, &
1245 : sphi_b, &
1246 : sphi_c, &
1247 : sphi_d, &
1248 : primitives_tmp(1, 1, 1, 1), &
1249 281627964 : buffer1, buffer2)
1250 :
1251 : primitives(s_offset_a + 1:s_offset_a + nsoa*nl_a, &
1252 : s_offset_b + 1:s_offset_b + nsob*nl_b, &
1253 : s_offset_c + 1:s_offset_c + nsoc*nl_c, &
1254 : s_offset_d + 1:s_offset_d + nsod*nl_d, i) = &
1255 : primitives(s_offset_a + 1:s_offset_a + nsoa*nl_a, &
1256 : s_offset_b + 1:s_offset_b + nsob*nl_b, &
1257 : s_offset_c + 1:s_offset_c + nsoc*nl_c, &
1258 19221196005 : s_offset_d + 1:s_offset_d + nsod*nl_d, i) + primitives_tmp(:, :, :, :)
1259 : END DO
1260 : END IF
1261 : END IF
1262 :
1263 29385084 : IF (use_virial .AND. tmp_max_all_virial >= eps_schwarz) THEN
1264 933078 : IF (direct_contract) THEN
1265 3254329 : DO i = 1, 12
1266 12266317 : DO m = 1, 3
1267 : CALL contract(ncoa, ncob, ncoc, ncod, nsoa, nsob, nsoc, nsod, &
1268 : n_a, n_b, n_c, n_d, nl_a, nl_b, nl_c, nl_d, work2_virial(1, 1, 1, 1, i, m), &
1269 : sphi_a, &
1270 : sphi_b, &
1271 : sphi_c, &
1272 : sphi_d, &
1273 : primitives_virial(1, 1, 1, 1, i, m), &
1274 12015984 : buffer1, buffer2)
1275 : END DO
1276 : END DO
1277 : ELSE
1278 8875685 : DO i = 1, 12
1279 33454505 : DO m = 1, 3
1280 4740944724 : primitives_tmp_virial(:, :, :, :) = 0.0_dp
1281 : CALL contract(ncoa, ncob, ncoc, ncod, nsoa, nsob, nsoc, nsod, &
1282 : n_a, n_b, n_c, n_d, nl_a, nl_b, nl_c, nl_d, work2_virial(1, 1, 1, 1, i, m), &
1283 : sphi_a, &
1284 : sphi_b, &
1285 : sphi_c, &
1286 : sphi_d, &
1287 : primitives_tmp_virial(1, 1, 1, 1), &
1288 24578820 : buffer1, buffer2)
1289 :
1290 : primitives_virial(s_offset_a + 1:s_offset_a + nsoa*nl_a, &
1291 : s_offset_b + 1:s_offset_b + nsob*nl_b, &
1292 : s_offset_c + 1:s_offset_c + nsoc*nl_c, &
1293 : s_offset_d + 1:s_offset_d + nsod*nl_d, i, m) = &
1294 : primitives_virial(s_offset_a + 1:s_offset_a + nsoa*nl_a, &
1295 : s_offset_b + 1:s_offset_b + nsob*nl_b, &
1296 : s_offset_c + 1:s_offset_c + nsoc*nl_c, &
1297 4749137664 : s_offset_d + 1:s_offset_d + nsod*nl_d, i, m) + primitives_tmp_virial(:, :, :, :)
1298 : END DO
1299 : END DO
1300 : END IF
1301 : END IF
1302 :
1303 : END SUBROUTINE evaluate_deriv_eri
1304 :
1305 : ! **************************************************************************************************
1306 : !> \brief Evaluates max-abs values of electron repulsion integrals for a primitive quartet
1307 : !> \param libint ...
1308 : !> \param A ...
1309 : !> \param B ...
1310 : !> \param C ...
1311 : !> \param D ...
1312 : !> \param Zeta_A ...
1313 : !> \param Zeta_B ...
1314 : !> \param Zeta_C ...
1315 : !> \param Zeta_D ...
1316 : !> \param n_a ...
1317 : !> \param n_b ...
1318 : !> \param n_c ...
1319 : !> \param n_d ...
1320 : !> \param max_val ...
1321 : !> \param potential_parameter ...
1322 : !> \param R1 ...
1323 : !> \param R2 ...
1324 : !> \param p_work ...
1325 : !> \par History
1326 : !> 03.2007 created [Manuel Guidon]
1327 : !> 08.2007 refactured permutation part [Manuel Guidon]
1328 : !> \author Manuel Guidon
1329 : ! **************************************************************************************************
1330 96382482 : SUBROUTINE evaluate_eri_screen(libint, A, B, C, D, Zeta_A, Zeta_B, Zeta_C, Zeta_D, &
1331 : n_a, n_b, n_c, n_d, &
1332 : max_val, potential_parameter, R1, R2, &
1333 : p_work)
1334 :
1335 : TYPE(cp_libint_t) :: libint
1336 : REAL(dp), INTENT(IN) :: A(3), B(3), C(3), D(3), Zeta_A, Zeta_B, &
1337 : Zeta_C, Zeta_D
1338 : INTEGER, INTENT(IN) :: n_a, n_b, n_c, n_d
1339 : REAL(dp), INTENT(INOUT) :: max_val
1340 : TYPE(hfx_potential_type) :: potential_parameter
1341 : REAL(dp) :: R1, R2
1342 : REAL(dp), DIMENSION(:), POINTER :: p_work
1343 :
1344 : INTEGER :: a_mysize(1), i, m_max, mysize, perm_case
1345 :
1346 96382482 : m_max = n_a + n_b + n_c + n_d
1347 96382482 : mysize = nco(n_a)*nco(n_b)*nco(n_c)*nco(n_d)
1348 192764964 : a_mysize = mysize
1349 :
1350 96382482 : IF (m_max /= 0) THEN
1351 60006726 : perm_case = 1
1352 60006726 : IF (n_a < n_b) THEN
1353 24401196 : perm_case = perm_case + 1
1354 : END IF
1355 60006726 : IF (n_c < n_d) THEN
1356 24401196 : perm_case = perm_case + 2
1357 : END IF
1358 60006726 : IF (n_a + n_b > n_c + n_d) THEN
1359 0 : perm_case = perm_case + 4
1360 : END IF
1361 :
1362 35605530 : SELECT CASE (perm_case)
1363 : CASE (1)
1364 : CALL build_quartet_data_screen(A, B, C, D, Zeta_A, Zeta_B, Zeta_C, Zeta_D, m_max, &
1365 35605530 : potential_parameter, libint, R1, R2)
1366 :
1367 35605530 : CALL cp_libint_get_eris(n_d, n_c, n_b, n_a, libint, p_work, a_mysize)
1368 3056048304 : DO i = 1, mysize
1369 3056048304 : max_val = MAX(max_val, ABS(p_work(i)))
1370 : END DO
1371 : CASE (2)
1372 : CALL build_quartet_data_screen(B, A, C, D, Zeta_B, Zeta_A, Zeta_C, Zeta_D, m_max, &
1373 0 : potential_parameter, libint, R1, R2)
1374 :
1375 0 : CALL cp_libint_get_eris(n_d, n_c, n_a, n_b, libint, p_work, a_mysize)
1376 0 : DO i = 1, mysize
1377 0 : max_val = MAX(max_val, ABS(p_work(i)))
1378 : END DO
1379 : CASE (3)
1380 : CALL build_quartet_data_screen(A, B, D, C, Zeta_A, Zeta_B, Zeta_D, Zeta_C, m_max, &
1381 0 : potential_parameter, libint, R1, R2)
1382 :
1383 0 : CALL cp_libint_get_eris(n_c, n_d, n_b, n_a, libint, p_work, a_mysize)
1384 0 : DO i = 1, mysize
1385 0 : max_val = MAX(max_val, ABS(p_work(i)))
1386 : END DO
1387 : CASE (4)
1388 : CALL build_quartet_data_screen(B, A, D, C, Zeta_B, Zeta_A, Zeta_D, Zeta_C, m_max, &
1389 24401196 : potential_parameter, libint, R1, R2)
1390 :
1391 24401196 : CALL cp_libint_get_eris(n_c, n_d, n_a, n_b, libint, p_work, a_mysize)
1392 1098038670 : DO i = 1, mysize
1393 1098038670 : max_val = MAX(max_val, ABS(p_work(i)))
1394 : END DO
1395 : CASE (5)
1396 : CALL build_quartet_data_screen(C, D, A, B, Zeta_C, Zeta_D, Zeta_A, Zeta_B, m_max, &
1397 0 : potential_parameter, libint, R1, R2)
1398 :
1399 0 : CALL cp_libint_get_eris(n_b, n_a, n_d, n_c, libint, p_work, a_mysize)
1400 0 : DO i = 1, mysize
1401 0 : max_val = MAX(max_val, ABS(p_work(i)))
1402 : END DO
1403 : CASE (6)
1404 : CALL build_quartet_data_screen(C, D, B, A, Zeta_C, Zeta_D, Zeta_B, Zeta_A, m_max, &
1405 0 : potential_parameter, libint, R1, R2)
1406 :
1407 0 : CALL cp_libint_get_eris(n_a, n_b, n_d, n_c, libint, p_work, a_mysize)
1408 0 : DO i = 1, mysize
1409 0 : max_val = MAX(max_val, ABS(p_work(i)))
1410 : END DO
1411 : CASE (7)
1412 : CALL build_quartet_data_screen(D, C, A, B, Zeta_D, Zeta_C, Zeta_A, Zeta_B, m_max, &
1413 0 : potential_parameter, libint, R1, R2)
1414 :
1415 0 : CALL cp_libint_get_eris(n_b, n_a, n_c, n_d, libint, p_work, a_mysize)
1416 0 : DO i = 1, mysize
1417 0 : max_val = MAX(max_val, ABS(p_work(i)))
1418 : END DO
1419 : CASE (8)
1420 : CALL build_quartet_data_screen(D, C, B, A, Zeta_D, Zeta_C, Zeta_B, Zeta_A, m_max, &
1421 0 : potential_parameter, libint, R1, R2)
1422 :
1423 0 : CALL cp_libint_get_eris(n_a, n_b, n_c, n_d, libint, p_work, a_mysize)
1424 60006726 : DO i = 1, mysize
1425 0 : max_val = MAX(max_val, ABS(p_work(i)))
1426 : END DO
1427 : END SELECT
1428 : ELSE
1429 : CALL build_quartet_data_screen(A, B, C, D, Zeta_A, Zeta_B, Zeta_C, Zeta_D, m_max, &
1430 36375756 : potential_parameter, libint, R1, R2)
1431 36375756 : max_val = ABS(get_ssss_f_val(libint))
1432 : END IF
1433 :
1434 96382482 : END SUBROUTINE evaluate_eri_screen
1435 :
1436 : ! **************************************************************************************************
1437 : !> \brief Evaluate electron repulsion integrals for a primitive quartet
1438 : !> \param libint ...
1439 : !> \param nproducts ...
1440 : !> \param pgf_product_list ...
1441 : !> \param n_a ...
1442 : !> \param n_b ...
1443 : !> \param n_c ...
1444 : !> \param n_d ...
1445 : !> \param ncoa ...
1446 : !> \param ncob ...
1447 : !> \param ncoc ...
1448 : !> \param ncod ...
1449 : !> \param nsgfa ...
1450 : !> \param nsgfb ...
1451 : !> \param nsgfc ...
1452 : !> \param nsgfd ...
1453 : !> \param primitives ...
1454 : !> \param max_contraction ...
1455 : !> \param tmp_max ...
1456 : !> \param eps_schwarz ...
1457 : !> \param neris ...
1458 : !> \param ZetaInv ...
1459 : !> \param EtaInv ...
1460 : !> \param s_offset_a ...
1461 : !> \param s_offset_b ...
1462 : !> \param s_offset_c ...
1463 : !> \param s_offset_d ...
1464 : !> \param nl_a ...
1465 : !> \param nl_b ...
1466 : !> \param nl_c ...
1467 : !> \param nl_d ...
1468 : !> \param nsoa ...
1469 : !> \param nsob ...
1470 : !> \param nsoc ...
1471 : !> \param nsod ...
1472 : !> \param sphi_a ...
1473 : !> \param sphi_b ...
1474 : !> \param sphi_c ...
1475 : !> \param sphi_d ...
1476 : !> \param work ...
1477 : !> \param work2 ...
1478 : !> \param buffer1 ...
1479 : !> \param buffer2 ...
1480 : !> \param primitives_tmp ...
1481 : !> \param p_work ...
1482 : !> \par History
1483 : !> 11.2006 created [Manuel Guidon]
1484 : !> 08.2007 refactured permutation part [Manuel Guidon]
1485 : !> \author Manuel Guidon
1486 : ! **************************************************************************************************
1487 173975894 : SUBROUTINE evaluate_eri(libint, nproducts, pgf_product_list, &
1488 : n_a, n_b, n_c, n_d, &
1489 : ncoa, ncob, ncoc, ncod, &
1490 : nsgfa, nsgfb, nsgfc, nsgfd, &
1491 173975894 : primitives, max_contraction, tmp_max, &
1492 : eps_schwarz, neris, &
1493 : ZetaInv, EtaInv, &
1494 : s_offset_a, s_offset_b, s_offset_c, s_offset_d, &
1495 : nl_a, nl_b, nl_c, nl_d, nsoa, nsob, nsoc, nsod, &
1496 173975894 : sphi_a, sphi_b, sphi_c, sphi_d, work, work2, buffer1, buffer2, &
1497 173975894 : primitives_tmp, p_work)
1498 :
1499 : TYPE(cp_libint_t) :: libint
1500 : INTEGER, INTENT(IN) :: nproducts
1501 : TYPE(hfx_pgf_product_list), DIMENSION(nproducts) :: pgf_product_list
1502 : INTEGER, INTENT(IN) :: n_a, n_b, n_c, n_d, ncoa, ncob, ncoc, &
1503 : ncod, nsgfa, nsgfb, nsgfc, nsgfd
1504 : REAL(dp), DIMENSION(nsgfa, nsgfb, nsgfc, nsgfd) :: primitives
1505 : REAL(dp) :: max_contraction, tmp_max, eps_schwarz
1506 : INTEGER(int_8) :: neris
1507 : REAL(dp), INTENT(IN) :: ZetaInv, EtaInv
1508 : INTEGER :: s_offset_a, s_offset_b, s_offset_c, &
1509 : s_offset_d, nl_a, nl_b, nl_c, nl_d, &
1510 : nsoa, nsob, nsoc, nsod
1511 : REAL(dp), DIMENSION(ncoa, nsoa*nl_a), INTENT(IN) :: sphi_a
1512 : REAL(dp), DIMENSION(ncob, nsob*nl_b), INTENT(IN) :: sphi_b
1513 : REAL(dp), DIMENSION(ncoc, nsoc*nl_c), INTENT(IN) :: sphi_c
1514 : REAL(dp), DIMENSION(ncod, nsod*nl_d), INTENT(IN) :: sphi_d
1515 : REAL(dp), TARGET :: work(ncoa*ncob*ncoc*ncod)
1516 : REAL(dp) :: work2(ncoa, ncob, ncoc, ncod)
1517 : REAL(dp), DIMENSION(ncoa*ncob*ncoc*ncod) :: buffer1, buffer2
1518 : REAL(dp), DIMENSION(nsoa*nl_a, nsob*nl_b, nsoc*&
1519 : nl_c, nsod*nl_d) :: primitives_tmp
1520 : REAL(dp), DIMENSION(:), POINTER :: p_work
1521 :
1522 : INTEGER :: a_mysize(1), i, j, k, l, m_max, mysize, &
1523 : p1, p2, p3, p4, perm_case
1524 : LOGICAL :: direct_contract
1525 : REAL(dp) :: A(3), AB(3), B(3), C(3), CD(3), D(3), &
1526 : P(3), Q(3), Rho, RhoInv, W(3), &
1527 : ZetapEtaInv
1528 173975894 : REAL(dp), DIMENSION(:), POINTER :: eri_src
1529 : REAL(KIND=dp), DIMENSION(prim_data_f_size) :: F
1530 :
1531 31024167 : IF (nproducts == 0) RETURN
1532 :
1533 173975894 : m_max = n_a + n_b + n_c + n_d
1534 173975894 : mysize = ncoa*ncob*ncoc*ncod
1535 347951788 : a_mysize = mysize
1536 :
1537 173975894 : IF (m_max /= 0) THEN
1538 258088063 : IF (nproducts > 1) work(1:mysize) = 0.0_dp
1539 137713987 : perm_case = 1
1540 137713987 : IF (n_a < n_b) THEN
1541 32338477 : perm_case = perm_case + 1
1542 : END IF
1543 137713987 : IF (n_c < n_d) THEN
1544 39426443 : perm_case = perm_case + 2
1545 : END IF
1546 137713987 : IF (n_a + n_b > n_c + n_d) THEN
1547 47546943 : perm_case = perm_case + 4
1548 : END IF
1549 : SELECT CASE (perm_case)
1550 : CASE (1)
1551 215137227 : DO i = 1, nproducts
1552 667038732 : A = pgf_product_list(i)%ra
1553 667038732 : B = pgf_product_list(i)%rb
1554 667038732 : C = pgf_product_list(i)%rc
1555 667038732 : D = pgf_product_list(i)%rd
1556 166759683 : Rho = pgf_product_list(i)%Rho
1557 166759683 : RhoInv = pgf_product_list(i)%RhoInv
1558 667038732 : P = pgf_product_list(i)%P
1559 667038732 : Q = pgf_product_list(i)%Q
1560 667038732 : W = pgf_product_list(i)%W
1561 667038732 : AB = pgf_product_list(i)%AB
1562 667038732 : CD = pgf_product_list(i)%CD
1563 166759683 : ZetapEtaInv = pgf_product_list(i)%ZetapEtaInv
1564 658616982 : F(1:m_max + 1) = pgf_product_list(i)%Fm(1:m_max + 1)
1565 :
1566 : CALL build_quartet_data(libint, A, B, C, D, ZetaInv, EtaInv, ZetapEtaInv, Rho, &
1567 166759683 : P, Q, W, m_max, F)
1568 166759683 : CALL cp_libint_get_eris(n_d, n_c, n_b, n_a, libint, p_work, a_mysize)
1569 3586600785 : IF (nproducts > 1) work(1:mysize) = work(1:mysize) + p_work(1:mysize)
1570 215137227 : neris = neris + mysize
1571 : END DO
1572 48377544 : IF (nproducts == 1) THEN
1573 45986415 : eri_src => p_work
1574 : ELSE
1575 2391129 : eri_src => work
1576 : END IF
1577 1204274484 : DO i = 1, mysize
1578 1204274484 : tmp_max = MAX(tmp_max, ABS(eri_src(i)))
1579 : END DO
1580 48377544 : tmp_max = tmp_max*max_contraction
1581 48377544 : IF (tmp_max < eps_schwarz) THEN
1582 : RETURN
1583 : END IF
1584 :
1585 119717839 : DO i = 1, ncoa
1586 78720148 : p1 = (i - 1)*ncob
1587 220534811 : DO j = 1, ncob
1588 100816972 : p2 = (p1 + j - 1)*ncoc
1589 585373571 : DO k = 1, ncoc
1590 405836451 : p3 = (p2 + k - 1)*ncod
1591 1535382360 : DO l = 1, ncod
1592 1028728937 : p4 = p3 + l
1593 1434565388 : work2(i, j, k, l) = eri_src(p4)
1594 : END DO
1595 : END DO
1596 : END DO
1597 : END DO
1598 : CASE (2)
1599 35978927 : DO i = 1, nproducts
1600 104174180 : A = pgf_product_list(i)%ra
1601 104174180 : B = pgf_product_list(i)%rb
1602 104174180 : C = pgf_product_list(i)%rc
1603 104174180 : D = pgf_product_list(i)%rd
1604 26043545 : Rho = pgf_product_list(i)%Rho
1605 26043545 : RhoInv = pgf_product_list(i)%RhoInv
1606 104174180 : P = pgf_product_list(i)%P
1607 104174180 : Q = pgf_product_list(i)%Q
1608 104174180 : W = pgf_product_list(i)%W
1609 104174180 : AB = pgf_product_list(i)%AB
1610 104174180 : CD = pgf_product_list(i)%CD
1611 26043545 : ZetapEtaInv = pgf_product_list(i)%ZetapEtaInv
1612 124114453 : F(1:m_max + 1) = pgf_product_list(i)%Fm(1:m_max + 1)
1613 :
1614 : CALL build_quartet_data(libint, B, A, C, D, &
1615 : ZetaInv, EtaInv, ZetapEtaInv, Rho, &
1616 26043545 : P, Q, W, m_max, F)
1617 :
1618 26043545 : CALL cp_libint_get_eris(n_d, n_c, n_a, n_b, libint, p_work, a_mysize)
1619 788821427 : IF (nproducts > 1) work(1:mysize) = work(1:mysize) + p_work(1:mysize)
1620 35978927 : neris = neris + mysize
1621 : END DO
1622 9935382 : IF (nproducts == 1) THEN
1623 9341391 : eri_src => p_work
1624 : ELSE
1625 593991 : eri_src => work
1626 : END IF
1627 427017532 : DO i = 1, mysize
1628 427017532 : tmp_max = MAX(tmp_max, ABS(eri_src(i)))
1629 : END DO
1630 9935382 : tmp_max = tmp_max*max_contraction
1631 9935382 : IF (tmp_max < eps_schwarz) THEN
1632 : RETURN
1633 : END IF
1634 :
1635 34555262 : DO j = 1, ncob
1636 26889440 : p1 = (j - 1)*ncoa
1637 64488980 : DO i = 1, ncoa
1638 29933718 : p2 = (p1 + i - 1)*ncoc
1639 184752369 : DO k = 1, ncoc
1640 127929211 : p3 = (p2 + k - 1)*ncod
1641 500488336 : DO l = 1, ncod
1642 342625407 : p4 = p3 + l
1643 470554618 : work2(i, j, k, l) = eri_src(p4)
1644 : END DO
1645 : END DO
1646 : END DO
1647 : END DO
1648 : CASE (3)
1649 92374290 : DO i = 1, nproducts
1650 269789016 : A = pgf_product_list(i)%ra
1651 269789016 : B = pgf_product_list(i)%rb
1652 269789016 : C = pgf_product_list(i)%rc
1653 269789016 : D = pgf_product_list(i)%rd
1654 67447254 : Rho = pgf_product_list(i)%Rho
1655 67447254 : RhoInv = pgf_product_list(i)%RhoInv
1656 269789016 : P = pgf_product_list(i)%P
1657 269789016 : Q = pgf_product_list(i)%Q
1658 269789016 : W = pgf_product_list(i)%W
1659 269789016 : AB = pgf_product_list(i)%AB
1660 269789016 : CD = pgf_product_list(i)%CD
1661 67447254 : ZetapEtaInv = pgf_product_list(i)%ZetapEtaInv
1662 254312765 : F(1:m_max + 1) = pgf_product_list(i)%Fm(1:m_max + 1)
1663 :
1664 : CALL build_quartet_data(libint, A, B, D, C, &
1665 : ZetaInv, EtaInv, ZetapEtaInv, Rho, &
1666 67447254 : P, Q, W, m_max, F)
1667 :
1668 67447254 : CALL cp_libint_get_eris(n_c, n_d, n_b, n_a, libint, p_work, a_mysize)
1669 1037295234 : IF (nproducts > 1) work(1:mysize) = work(1:mysize) + p_work(1:mysize)
1670 92374290 : neris = neris + mysize
1671 : END DO
1672 24927036 : IF (nproducts == 1) THEN
1673 23713563 : eri_src => p_work
1674 : ELSE
1675 1213473 : eri_src => work
1676 : END IF
1677 462156411 : DO i = 1, mysize
1678 462156411 : tmp_max = MAX(tmp_max, ABS(eri_src(i)))
1679 : END DO
1680 24927036 : tmp_max = tmp_max*max_contraction
1681 24927036 : IF (tmp_max < eps_schwarz) THEN
1682 : RETURN
1683 : END IF
1684 :
1685 57921660 : DO i = 1, ncoa
1686 38547224 : p1 = (i - 1)*ncob
1687 104643572 : DO j = 1, ncob
1688 46721912 : p2 = (p1 + j - 1)*ncod
1689 300393575 : DO l = 1, ncod
1690 215124439 : p3 = (p2 + l - 1)*ncoc
1691 627568124 : DO k = 1, ncoc
1692 365721773 : p4 = p3 + k
1693 580846212 : work2(i, j, k, l) = eri_src(p4)
1694 : END DO
1695 : END DO
1696 : END DO
1697 : END DO
1698 : CASE (4)
1699 21933328 : DO i = 1, nproducts
1700 60024984 : A = pgf_product_list(i)%ra
1701 60024984 : B = pgf_product_list(i)%rb
1702 60024984 : C = pgf_product_list(i)%rc
1703 60024984 : D = pgf_product_list(i)%rd
1704 15006246 : Rho = pgf_product_list(i)%Rho
1705 15006246 : RhoInv = pgf_product_list(i)%RhoInv
1706 60024984 : P = pgf_product_list(i)%P
1707 60024984 : Q = pgf_product_list(i)%Q
1708 60024984 : W = pgf_product_list(i)%W
1709 60024984 : AB = pgf_product_list(i)%AB
1710 60024984 : CD = pgf_product_list(i)%CD
1711 15006246 : ZetapEtaInv = pgf_product_list(i)%ZetapEtaInv
1712 68265950 : F(1:m_max + 1) = pgf_product_list(i)%Fm(1:m_max + 1)
1713 :
1714 : CALL build_quartet_data(libint, B, A, D, C, &
1715 : ZetaInv, EtaInv, ZetapEtaInv, Rho, &
1716 15006246 : P, Q, W, m_max, F)
1717 :
1718 15006246 : CALL cp_libint_get_eris(n_c, n_d, n_a, n_b, libint, p_work, a_mysize)
1719 323472516 : IF (nproducts > 1) work(1:mysize) = work(1:mysize) + p_work(1:mysize)
1720 21933328 : neris = neris + mysize
1721 : END DO
1722 6927082 : IF (nproducts == 1) THEN
1723 6576340 : eri_src => p_work
1724 : ELSE
1725 350742 : eri_src => work
1726 : END IF
1727 242205375 : DO i = 1, mysize
1728 242205375 : tmp_max = MAX(tmp_max, ABS(eri_src(i)))
1729 : END DO
1730 6927082 : tmp_max = tmp_max*max_contraction
1731 6927082 : IF (tmp_max < eps_schwarz) THEN
1732 : RETURN
1733 : END IF
1734 :
1735 25031141 : DO j = 1, ncob
1736 19453264 : p1 = (j - 1)*ncoa
1737 47388043 : DO i = 1, ncoa
1738 22356902 : p2 = (p1 + i - 1)*ncod
1739 147031228 : DO l = 1, ncod
1740 105221062 : p3 = (p2 + l - 1)*ncoc
1741 328520378 : DO k = 1, ncoc
1742 200942414 : p4 = p3 + k
1743 306163476 : work2(i, j, k, l) = eri_src(p4)
1744 : END DO
1745 : END DO
1746 : END DO
1747 : END DO
1748 : CASE (5)
1749 98786540 : DO i = 1, nproducts
1750 288709796 : A = pgf_product_list(i)%ra
1751 288709796 : B = pgf_product_list(i)%rb
1752 288709796 : C = pgf_product_list(i)%rc
1753 288709796 : D = pgf_product_list(i)%rd
1754 72177449 : Rho = pgf_product_list(i)%Rho
1755 72177449 : RhoInv = pgf_product_list(i)%RhoInv
1756 288709796 : P = pgf_product_list(i)%P
1757 288709796 : Q = pgf_product_list(i)%Q
1758 288709796 : W = pgf_product_list(i)%W
1759 288709796 : AB = pgf_product_list(i)%AB
1760 288709796 : CD = pgf_product_list(i)%CD
1761 72177449 : ZetapEtaInv = pgf_product_list(i)%ZetapEtaInv
1762 273788098 : F(1:m_max + 1) = pgf_product_list(i)%Fm(1:m_max + 1)
1763 :
1764 : CALL build_quartet_data(libint, C, D, A, B, &
1765 : EtaInv, ZetaInv, ZetapEtaInv, Rho, &
1766 72177449 : Q, P, W, m_max, F)
1767 :
1768 72177449 : CALL cp_libint_get_eris(n_b, n_a, n_d, n_c, libint, p_work, a_mysize)
1769 1176234881 : IF (nproducts > 1) work(1:mysize) = work(1:mysize) + p_work(1:mysize)
1770 98786540 : neris = neris + mysize
1771 : END DO
1772 26609091 : IF (nproducts == 1) THEN
1773 25241334 : eri_src => p_work
1774 : ELSE
1775 1367757 : eri_src => work
1776 : END IF
1777 587762658 : DO i = 1, mysize
1778 587762658 : tmp_max = MAX(tmp_max, ABS(eri_src(i)))
1779 : END DO
1780 26609091 : tmp_max = tmp_max*max_contraction
1781 26609091 : IF (tmp_max < eps_schwarz) THEN
1782 : RETURN
1783 : END IF
1784 :
1785 51699016 : DO k = 1, ncoc
1786 30746492 : p1 = (k - 1)*ncod
1787 86980216 : DO l = 1, ncod
1788 35281200 : p2 = (p1 + l - 1)*ncoa
1789 225920178 : DO i = 1, ncoa
1790 159892486 : p3 = (p2 + i - 1)*ncob
1791 658611942 : DO j = 1, ncob
1792 463438256 : p4 = p3 + j
1793 623330742 : work2(i, j, k, l) = eri_src(p4)
1794 : END DO
1795 : END DO
1796 : END DO
1797 : END DO
1798 : CASE (6)
1799 40462358 : DO i = 1, nproducts
1800 108387324 : A = pgf_product_list(i)%ra
1801 108387324 : B = pgf_product_list(i)%rb
1802 108387324 : C = pgf_product_list(i)%rc
1803 108387324 : D = pgf_product_list(i)%rd
1804 27096831 : Rho = pgf_product_list(i)%Rho
1805 27096831 : RhoInv = pgf_product_list(i)%RhoInv
1806 108387324 : P = pgf_product_list(i)%P
1807 108387324 : Q = pgf_product_list(i)%Q
1808 108387324 : W = pgf_product_list(i)%W
1809 108387324 : AB = pgf_product_list(i)%AB
1810 108387324 : CD = pgf_product_list(i)%CD
1811 27096831 : ZetapEtaInv = pgf_product_list(i)%ZetapEtaInv
1812 97609575 : F(1:m_max + 1) = pgf_product_list(i)%Fm(1:m_max + 1)
1813 :
1814 : CALL build_quartet_data(libint, C, D, B, A, &
1815 : EtaInv, ZetaInv, ZetapEtaInv, Rho, &
1816 27096831 : Q, P, W, m_max, F)
1817 :
1818 27096831 : CALL cp_libint_get_eris(n_a, n_b, n_d, n_c, libint, p_work, a_mysize)
1819 343528467 : IF (nproducts > 1) work(1:mysize) = work(1:mysize) + p_work(1:mysize)
1820 40462358 : neris = neris + mysize
1821 : END DO
1822 13365527 : IF (nproducts == 1) THEN
1823 12705188 : eri_src => p_work
1824 : ELSE
1825 660339 : eri_src => work
1826 : END IF
1827 219809296 : DO i = 1, mysize
1828 219809296 : tmp_max = MAX(tmp_max, ABS(eri_src(i)))
1829 : END DO
1830 13365527 : tmp_max = tmp_max*max_contraction
1831 13365527 : IF (tmp_max < eps_schwarz) THEN
1832 : RETURN
1833 : END IF
1834 :
1835 22460211 : DO k = 1, ncoc
1836 13064108 : p1 = (k - 1)*ncod
1837 37662233 : DO l = 1, ncod
1838 15202022 : p2 = (p1 + l - 1)*ncob
1839 104038669 : DO j = 1, ncob
1840 75772539 : p3 = (p2 + j - 1)*ncoa
1841 248657308 : DO i = 1, ncoa
1842 157682747 : p4 = p3 + i
1843 233455286 : work2(i, j, k, l) = eri_src(p4)
1844 : END DO
1845 : END DO
1846 : END DO
1847 : END DO
1848 : CASE (7)
1849 17741929 : DO i = 1, nproducts
1850 49120360 : A = pgf_product_list(i)%ra
1851 49120360 : B = pgf_product_list(i)%rb
1852 49120360 : C = pgf_product_list(i)%rc
1853 49120360 : D = pgf_product_list(i)%rd
1854 12280090 : Rho = pgf_product_list(i)%Rho
1855 12280090 : RhoInv = pgf_product_list(i)%RhoInv
1856 49120360 : P = pgf_product_list(i)%P
1857 49120360 : Q = pgf_product_list(i)%Q
1858 49120360 : W = pgf_product_list(i)%W
1859 49120360 : AB = pgf_product_list(i)%AB
1860 49120360 : CD = pgf_product_list(i)%CD
1861 12280090 : ZetapEtaInv = pgf_product_list(i)%ZetapEtaInv
1862 65760204 : F(1:m_max + 1) = pgf_product_list(i)%Fm(1:m_max + 1)
1863 :
1864 : CALL build_quartet_data(libint, D, C, A, B, &
1865 : EtaInv, ZetaInv, ZetapEtaInv, Rho, &
1866 12280090 : Q, P, W, m_max, F)
1867 :
1868 12280090 : CALL cp_libint_get_eris(n_b, n_a, n_c, n_d, libint, p_work, a_mysize)
1869 473619280 : IF (nproducts > 1) work(1:mysize) = work(1:mysize) + p_work(1:mysize)
1870 17741929 : neris = neris + mysize
1871 : END DO
1872 5461839 : IF (nproducts == 1) THEN
1873 5204308 : eri_src => p_work
1874 : ELSE
1875 257531 : eri_src => work
1876 : END IF
1877 356937860 : DO i = 1, mysize
1878 356937860 : tmp_max = MAX(tmp_max, ABS(eri_src(i)))
1879 : END DO
1880 5461839 : tmp_max = tmp_max*max_contraction
1881 5461839 : IF (tmp_max < eps_schwarz) THEN
1882 : RETURN
1883 : END IF
1884 :
1885 17633404 : DO l = 1, ncod
1886 13658476 : p1 = (l - 1)*ncoc
1887 32972424 : DO k = 1, ncoc
1888 15339020 : p2 = (p1 + k - 1)*ncoa
1889 108126153 : DO i = 1, ncoa
1890 79128657 : p3 = (p2 + i - 1)*ncob
1891 380920368 : DO j = 1, ncob
1892 286452691 : p4 = p3 + j
1893 365581348 : work2(i, j, k, l) = eri_src(p4)
1894 : END DO
1895 : END DO
1896 : END DO
1897 : END DO
1898 : CASE (8)
1899 5314258 : DO i = 1, nproducts
1900 12815088 : A = pgf_product_list(i)%ra
1901 12815088 : B = pgf_product_list(i)%rb
1902 12815088 : C = pgf_product_list(i)%rc
1903 12815088 : D = pgf_product_list(i)%rd
1904 3203772 : Rho = pgf_product_list(i)%Rho
1905 3203772 : RhoInv = pgf_product_list(i)%RhoInv
1906 12815088 : P = pgf_product_list(i)%P
1907 12815088 : Q = pgf_product_list(i)%Q
1908 12815088 : W = pgf_product_list(i)%W
1909 12815088 : AB = pgf_product_list(i)%AB
1910 12815088 : CD = pgf_product_list(i)%CD
1911 3203772 : ZetapEtaInv = pgf_product_list(i)%ZetapEtaInv
1912 18196977 : F(1:m_max + 1) = pgf_product_list(i)%Fm(1:m_max + 1)
1913 :
1914 : CALL build_quartet_data(libint, D, C, B, A, &
1915 : EtaInv, ZetaInv, ZetapEtaInv, Rho, &
1916 3203772 : Q, P, W, m_max, F)
1917 :
1918 3203772 : CALL cp_libint_get_eris(n_a, n_b, n_c, n_d, libint, p_work, a_mysize)
1919 95679816 : IF (nproducts > 1) work(1:mysize) = work(1:mysize) + p_work(1:mysize)
1920 5314258 : neris = neris + mysize
1921 : END DO
1922 2110486 : IF (nproducts == 1) THEN
1923 2050185 : eri_src => p_work
1924 : ELSE
1925 60301 : eri_src => work
1926 : END IF
1927 109939570 : DO i = 1, mysize
1928 109939570 : tmp_max = MAX(tmp_max, ABS(eri_src(i)))
1929 : END DO
1930 2110486 : tmp_max = tmp_max*max_contraction
1931 2110486 : IF (tmp_max < eps_schwarz) THEN
1932 : RETURN
1933 : END IF
1934 :
1935 145284148 : DO l = 1, ncod
1936 5906323 : p1 = (l - 1)*ncoc
1937 13536804 : DO k = 1, ncoc
1938 5966643 : p2 = (p1 + k - 1)*ncob
1939 48742708 : DO j = 1, ncob
1940 36869742 : p3 = (p2 + j - 1)*ncoa
1941 129303237 : DO i = 1, ncoa
1942 86466852 : p4 = p3 + i
1943 123336594 : work2(i, j, k, l) = eri_src(p4)
1944 : END DO
1945 : END DO
1946 : END DO
1947 : END DO
1948 : END SELECT
1949 : ELSE
1950 36261907 : work(1) = 0.0_dp
1951 160450054 : DO i = 1, nproducts
1952 496752588 : A = pgf_product_list(i)%ra
1953 496752588 : B = pgf_product_list(i)%rb
1954 496752588 : C = pgf_product_list(i)%rc
1955 496752588 : D = pgf_product_list(i)%rd
1956 124188147 : Rho = pgf_product_list(i)%Rho
1957 124188147 : RhoInv = pgf_product_list(i)%RhoInv
1958 496752588 : P = pgf_product_list(i)%P
1959 496752588 : Q = pgf_product_list(i)%Q
1960 496752588 : W = pgf_product_list(i)%W
1961 124188147 : ZetapEtaInv = pgf_product_list(i)%ZetapEtaInv
1962 248376294 : F(1:m_max + 1) = pgf_product_list(i)%Fm(1:m_max + 1)
1963 :
1964 : CALL build_quartet_data(libint, A, B, C, D, & !todo: check
1965 : ZetaInv, EtaInv, ZetapEtaInv, Rho, &
1966 124188147 : P, Q, W, m_max, F)
1967 124188147 : work(1) = work(1) + F(1)
1968 160450054 : neris = neris + mysize
1969 : END DO
1970 36261907 : work2(1, 1, 1, 1) = work(1)
1971 36261907 : tmp_max = max_contraction*ABS(work(1))
1972 36261907 : IF (tmp_max < eps_schwarz) RETURN
1973 : END IF
1974 :
1975 142951727 : IF (tmp_max < eps_schwarz) RETURN
1976 : direct_contract = (s_offset_a == 0 .AND. s_offset_b == 0 .AND. &
1977 : s_offset_c == 0 .AND. s_offset_d == 0 .AND. &
1978 : nsgfa == nsoa*nl_a .AND. nsgfb == nsob*nl_b .AND. &
1979 142951727 : nsgfc == nsoc*nl_c .AND. nsgfd == nsod*nl_d)
1980 : IF (direct_contract) THEN
1981 : CALL contract(ncoa, ncob, ncoc, ncod, nsoa, nsob, nsoc, nsod, &
1982 : n_a, n_b, n_c, n_d, nl_a, nl_b, nl_c, nl_d, work2, &
1983 : sphi_a, &
1984 : sphi_b, &
1985 : sphi_c, &
1986 : sphi_d, &
1987 : primitives, &
1988 30991082 : buffer1, buffer2)
1989 : ELSE
1990 8152798261 : primitives_tmp = 0.0_dp
1991 :
1992 : CALL contract(ncoa, ncob, ncoc, ncod, nsoa, nsob, nsoc, nsod, &
1993 : n_a, n_b, n_c, n_d, nl_a, nl_b, nl_c, nl_d, work2, &
1994 : sphi_a, &
1995 : sphi_b, &
1996 : sphi_c, &
1997 : sphi_d, &
1998 : primitives_tmp, &
1999 111960645 : buffer1, buffer2)
2000 :
2001 : primitives(s_offset_a + 1:s_offset_a + nsoa*nl_a, &
2002 : s_offset_b + 1:s_offset_b + nsob*nl_b, &
2003 : s_offset_c + 1:s_offset_c + nsoc*nl_c, &
2004 : s_offset_d + 1:s_offset_d + nsod*nl_d) = &
2005 : primitives(s_offset_a + 1:s_offset_a + nsoa*nl_a, &
2006 : s_offset_b + 1:s_offset_b + nsob*nl_b, &
2007 : s_offset_c + 1:s_offset_c + nsoc*nl_c, &
2008 8152798261 : s_offset_d + 1:s_offset_d + nsod*nl_d) + primitives_tmp(:, :, :, :)
2009 : END IF
2010 :
2011 173975894 : END SUBROUTINE evaluate_eri
2012 :
2013 : ! **************************************************************************************************
2014 : !> \brief Fill data structure used in libint
2015 : !> \param libint ...
2016 : !> \param A ...
2017 : !> \param B ...
2018 : !> \param C ...
2019 : !> \param D ...
2020 : !> \param ZetaInv ...
2021 : !> \param EtaInv ...
2022 : !> \param ZetapEtaInv ...
2023 : !> \param Rho ...
2024 : !> \param P ...
2025 : !> \param Q ...
2026 : !> \param W ...
2027 : !> \param m_max ...
2028 : !> \param F ...
2029 : !> \par History
2030 : !> 03.2007 created [Manuel Guidon]
2031 : !> \author Manuel Guidon
2032 : ! **************************************************************************************************
2033 514203017 : SUBROUTINE build_quartet_data(libint, A, B, C, D, &
2034 : ZetaInv, EtaInv, ZetapEtaInv, Rho, &
2035 514203017 : P, Q, W, m_max, F)
2036 :
2037 : TYPE(cp_libint_t) :: libint
2038 : REAL(KIND=dp), INTENT(IN) :: A(3), B(3), C(3), D(3)
2039 : REAL(dp), INTENT(IN) :: ZetaInv, EtaInv, ZetapEtaInv, Rho, P(3), &
2040 : Q(3), W(3)
2041 : INTEGER, INTENT(IN) :: m_max
2042 : REAL(KIND=dp), DIMENSION(:) :: F
2043 :
2044 514203017 : CALL cp_libint_set_params_eri(libint, A, B, C, D, ZetaInv, EtaInv, ZetapEtaInv, Rho, P, Q, W, m_max, F)
2045 514203017 : END SUBROUTINE build_quartet_data
2046 :
2047 : END MODULE hfx_libint_interface
|
