(git:374b731)
Loading...
Searching...
No Matches
hfx_pair_list_methods.F
Go to the documentation of this file.
1!--------------------------------------------------------------------------------------------------!
2! CP2K: A general program to perform molecular dynamics simulations !
3! Copyright 2000-2024 CP2K developers group <https://cp2k.org> !
4! !
5! SPDX-License-Identifier: GPL-2.0-or-later !
6!--------------------------------------------------------------------------------------------------!
7
8! **************************************************************************************************
9!> \brief Routines for optimizing load balance between processes in HFX calculations
10!> \par History
11!> 04.2008 created [Manuel Guidon]
12!> 11.2019 fixed initial value for potential_id (A. Bussy)
13!> \author Manuel Guidon
14! **************************************************************************************************
15MODULE hfx_pair_list_methods
16 USE cell_types, ONLY: cell_type,&
17 pbc
18 USE gamma, ONLY: fgamma => fgamma_0
19 USE hfx_types, ONLY: &
20 hfx_basis_type, hfx_block_range_type, hfx_cell_type, hfx_pgf_list, hfx_pgf_product_list, &
21 hfx_potential_type, hfx_screen_coeff_type, pair_list_type, pair_set_list_type
22 USE input_constants, ONLY: &
23 do_potential_tshpsc, do_potential_coulomb, do_potential_gaussian, do_potential_id, &
24 do_potential_long, do_potential_mix_cl, do_potential_mix_cl_trunc, do_potential_mix_lg, &
25 do_potential_short, do_potential_truncated
26 USE kinds, ONLY: dp
27 USE libint_wrapper, ONLY: prim_data_f_size
28 USE mathconstants, ONLY: pi
29 USE mp2_types, ONLY: pair_list_type_mp2
30 USE particle_types, ONLY: particle_type
31 USE t_c_g0, ONLY: t_c_g0_n
32 USE t_sh_p_s_c, ONLY: trunc_cs_poly_n20
33#include "./base/base_uses.f90"
34
35 IMPLICIT NONE
36 PRIVATE
37
38 PUBLIC :: build_pair_list, &
39 build_pair_list_mp2, &
40 build_pair_list_pgf, &
41 build_pgf_product_list, &
42 build_atomic_pair_list, &
43 pgf_product_list_size
44
45 ! an initial estimate for the size of the product list
46 INTEGER, SAVE :: pgf_product_list_size = 128
47
48!***
49
50CONTAINS
51
52! **************************************************************************************************
53!> \brief ...
54!> \param list1 ...
55!> \param list2 ...
56!> \param product_list ...
57!> \param nproducts ...
58!> \param log10_pmax ...
59!> \param log10_eps_schwarz ...
60!> \param neighbor_cells ...
61!> \param cell ...
62!> \param potential_parameter ...
63!> \param m_max ...
64!> \param do_periodic ...
65! **************************************************************************************************
66 SUBROUTINE build_pgf_product_list(list1, list2, product_list, nproducts, &
67 log10_pmax, log10_eps_schwarz, neighbor_cells, &
68 cell, potential_parameter, m_max, do_periodic)
69
70 TYPE(hfx_pgf_list) :: list1, list2
71 TYPE(hfx_pgf_product_list), ALLOCATABLE, &
72 DIMENSION(:), INTENT(INOUT) :: product_list
73 INTEGER, INTENT(OUT) :: nproducts
74 REAL(dp), INTENT(IN) :: log10_pmax, log10_eps_schwarz
75 TYPE(hfx_cell_type), DIMENSION(:), POINTER :: neighbor_cells
76 TYPE(cell_type), POINTER :: cell
77 TYPE(hfx_potential_type) :: potential_parameter
78 INTEGER, INTENT(IN) :: m_max
79 LOGICAL, INTENT(IN) :: do_periodic
80
81 INTEGER :: i, j, k, l, nimages1, nimages2, tmp_i4
82 LOGICAL :: use_gamma
83 REAL(dp) :: c11(3), den, eta, etainv, factor, fm(prim_data_f_size), g(3), num, omega2, &
84 omega_corr, omega_corr2, p(3), pgf_max_1, pgf_max_2, pq(3), q(3), r, r1, r2, ra(3), &
85 rb(3), rc(3), rd(3), rho, rhoinv, rpq2, s1234, s1234a, s1234b, shift(3), ssss, t, &
86 temp(3), temp_cc(3), temp_dd(3), tmp, tmp_d(3), w(3), zeta1, zeta_c, zeta_d, zetapetainv
87 TYPE(hfx_pgf_product_list), ALLOCATABLE, &
88 DIMENSION(:) :: tmp_product_list
89
90 nimages1 = list1%nimages
91 nimages2 = list2%nimages
92 nproducts = 0
93 zeta1 = list1%zetapzetb
94 eta = list2%zetapzetb
95 etainv = list2%ZetaInv
96 zeta_c = list2%zeta
97 zeta_d = list2%zetb
98 temp_cc = 0.0_dp
99 temp_dd = 0.0_dp
100 DO i = 1, nimages1
101 p = list1%image_list(i)%P
102 r1 = list1%image_list(i)%R
103 s1234a = list1%image_list(i)%S1234
104 pgf_max_1 = list1%image_list(i)%pgf_max
105 ra = list1%image_list(i)%ra
106 rb = list1%image_list(i)%rb
107 DO j = 1, nimages2
108 pgf_max_2 = list2%image_list(j)%pgf_max
109 IF (pgf_max_1 + pgf_max_2 + log10_pmax < log10_eps_schwarz) cycle
110 q = list2%image_list(j)%P
111 r2 = list2%image_list(j)%R
112 s1234b = list2%image_list(j)%S1234
113 rc = list2%image_list(j)%ra
114 rd = list2%image_list(j)%rb
115
116 zetapetainv = zeta1 + eta
117 zetapetainv = 1.0_dp/zetapetainv
118 rho = zeta1*eta*zetapetainv
119 rhoinv = 1.0_dp/rho
120 s1234 = exp(s1234a + s1234b)
121 IF (do_periodic) THEN
122 temp = p - q
123 pq = pbc(temp, cell)
124 shift = -pq + temp
125 temp_cc = rc + shift
126 temp_dd = rd + shift
127 END IF
128
129 DO k = 1, SIZE(neighbor_cells)
130 IF (do_periodic) THEN
131 c11 = temp_cc + neighbor_cells(k)%cell_r(:)
132 tmp_d = temp_dd + neighbor_cells(k)%cell_r(:)
133 ELSE
134 c11 = rc
135 tmp_d = rd
136 END IF
137 q = (zeta_c*c11 + zeta_d*tmp_d)*etainv
138 rpq2 = (p(1) - q(1))**2 + (p(2) - q(2))**2 + (p(3) - q(3))**2
139 IF (potential_parameter%potential_type == do_potential_truncated .OR. &
140 potential_parameter%potential_type == do_potential_short .OR. &
141 potential_parameter%potential_type == do_potential_mix_cl_trunc) THEN
142 IF (rpq2 > (r1 + r2 + potential_parameter%cutoff_radius)**2) cycle
143 END IF
144 IF (potential_parameter%potential_type == do_potential_tshpsc) THEN
145 IF (rpq2 > (r1 + r2 + potential_parameter%cutoff_radius*2.0_dp)**2) cycle
146 END IF
147 nproducts = nproducts + 1
148
149 ! allocate size as needed,
150 ! updating the global size estimate to make this a rare event in longer simulations
151 IF (nproducts > SIZE(product_list)) THEN
152!$OMP ATOMIC READ
153 tmp_i4 = pgf_product_list_size
154 tmp_i4 = max(pgf_product_list_size, (3*nproducts + 1)/2)
155!$OMP ATOMIC WRITE
156 pgf_product_list_size = tmp_i4
157 ALLOCATE (tmp_product_list(SIZE(product_list)))
158 tmp_product_list(:) = product_list
159 DEALLOCATE (product_list)
160 ALLOCATE (product_list(tmp_i4))
161 product_list(1:SIZE(tmp_product_list)) = tmp_product_list
162 DEALLOCATE (tmp_product_list)
163 END IF
164
165 t = rho*rpq2
166 SELECT CASE (potential_parameter%potential_type)
167 CASE (do_potential_truncated)
168 r = potential_parameter%cutoff_radius*sqrt(rho)
169 CALL t_c_g0_n(product_list(nproducts)%Fm(1), use_gamma, r, t, m_max)
170 IF (use_gamma) CALL fgamma(m_max, t, product_list(nproducts)%Fm(1))
171 factor = 2.0_dp*pi*rhoinv
172 CASE (do_potential_tshpsc)
173 r = potential_parameter%cutoff_radius*sqrt(rho)
174 product_list(nproducts)%Fm = 0.0_dp
175 CALL trunc_cs_poly_n20(product_list(nproducts)%Fm(1), r, t, m_max)
176 factor = 2.0_dp*pi*rhoinv
177 CASE (do_potential_coulomb)
178 CALL fgamma(m_max, t, product_list(nproducts)%Fm(1))
179 factor = 2.0_dp*pi*rhoinv
180 CASE (do_potential_short)
181 CALL fgamma(m_max, t, product_list(nproducts)%Fm(1))
182 omega2 = potential_parameter%omega**2
183 omega_corr2 = omega2/(omega2 + rho)
184 omega_corr = sqrt(omega_corr2)
185 t = t*omega_corr2
186 CALL fgamma(m_max, t, fm)
187 tmp = -omega_corr
188 DO l = 1, m_max + 1
189 product_list(nproducts)%Fm(l) = product_list(nproducts)%Fm(l) + fm(l)*tmp
190 tmp = tmp*omega_corr2
191 END DO
192 factor = 2.0_dp*pi*rhoinv
193 CASE (do_potential_long)
194 omega2 = potential_parameter%omega**2
195 omega_corr2 = omega2/(omega2 + rho)
196 omega_corr = sqrt(omega_corr2)
197 t = t*omega_corr2
198 CALL fgamma(m_max, t, product_list(nproducts)%Fm(1))
199 tmp = omega_corr
200 DO l = 1, m_max + 1
201 product_list(nproducts)%Fm(l) = product_list(nproducts)%Fm(l)*tmp
202 tmp = tmp*omega_corr2
203 END DO
204 factor = 2.0_dp*pi*rhoinv
205 CASE (do_potential_mix_cl)
206 CALL fgamma(m_max, t, product_list(nproducts)%Fm(1))
207 omega2 = potential_parameter%omega**2
208 omega_corr2 = omega2/(omega2 + rho)
209 omega_corr = sqrt(omega_corr2)
210 t = t*omega_corr2
211 CALL fgamma(m_max, t, fm)
212 tmp = omega_corr
213 DO l = 1, m_max + 1
214 product_list(nproducts)%Fm(l) = &
215 product_list(nproducts)%Fm(l)*potential_parameter%scale_coulomb &
216 + fm(l)*tmp*potential_parameter%scale_longrange
217 tmp = tmp*omega_corr2
218 END DO
219 factor = 2.0_dp*pi*rhoinv
220 CASE (do_potential_mix_cl_trunc)
221
222 ! truncated
223 r = potential_parameter%cutoff_radius*sqrt(rho)
224 CALL t_c_g0_n(product_list(nproducts)%Fm(1), use_gamma, r, t, m_max)
225 IF (use_gamma) CALL fgamma(m_max, t, product_list(nproducts)%Fm(1))
226
227 ! Coulomb
228 CALL fgamma(m_max, t, fm)
229
230 DO l = 1, m_max + 1
231 product_list(nproducts)%Fm(l) = product_list(nproducts)%Fm(l)* &
232 (potential_parameter%scale_coulomb + potential_parameter%scale_longrange) - &
233 fm(l)*potential_parameter%scale_longrange
234 END DO
235
236 ! longrange
237 omega2 = potential_parameter%omega**2
238 omega_corr2 = omega2/(omega2 + rho)
239 omega_corr = sqrt(omega_corr2)
240 t = t*omega_corr2
241 CALL fgamma(m_max, t, fm)
242 tmp = omega_corr
243 DO l = 1, m_max + 1
244 product_list(nproducts)%Fm(l) = product_list(nproducts)%Fm(l) + fm(l)*tmp*potential_parameter%scale_longrange
245 tmp = tmp*omega_corr2
246 END DO
247 factor = 2.0_dp*pi*rhoinv
248
249 CASE (do_potential_gaussian)
250 omega2 = potential_parameter%omega**2
251 t = -omega2*t/(rho + omega2)
252 tmp = 1.0_dp
253 DO l = 1, m_max + 1
254 product_list(nproducts)%Fm(l) = exp(t)*tmp
255 tmp = tmp*omega2/(rho + omega2)
256 END DO
257 factor = (pi/(rho + omega2))**(1.5_dp)
258 CASE (do_potential_mix_lg)
259 omega2 = potential_parameter%omega**2
260 omega_corr2 = omega2/(omega2 + rho)
261 omega_corr = sqrt(omega_corr2)
262 t = t*omega_corr2
263 CALL fgamma(m_max, t, fm)
264 tmp = omega_corr*2.0_dp*pi*rhoinv*potential_parameter%scale_longrange
265 DO l = 1, m_max + 1
266 fm(l) = fm(l)*tmp
267 tmp = tmp*omega_corr2
268 END DO
269 t = rho*rpq2
270 t = -omega2*t/(rho + omega2)
271 tmp = (pi/(rho + omega2))**(1.5_dp)*potential_parameter%scale_gaussian
272 DO l = 1, m_max + 1
273 product_list(nproducts)%Fm(l) = exp(t)*tmp + fm(l)
274 tmp = tmp*omega2/(rho + omega2)
275 END DO
276 factor = 1.0_dp
277 CASE (do_potential_id)
278 num = list1%zeta*list1%zetb
279 den = list1%zeta + list1%zetb
280 ssss = -num/den*sum((ra - rb)**2)
281
282 num = den*zeta_c
283 den = den + zeta_c
284 ssss = ssss - num/den*sum((p - rc)**2)
285
286 g(:) = (list1%zeta*ra(:) + list1%zetb*rb(:) + zeta_c*rc(:))/den
287 num = den*zeta_d
288 den = den + zeta_d
289 ssss = ssss - num/den*sum((g - rd)**2)
290
291 product_list(nproducts)%Fm(:) = exp(ssss)
292 factor = 1.0_dp
293 IF (s1234 > epsilon(0.0_dp)) factor = 1.0_dp/s1234
294 END SELECT
295
296 tmp = (pi*zetapetainv)**3
297 factor = factor*s1234*sqrt(tmp)
298
299 DO l = 1, m_max + 1
300 product_list(nproducts)%Fm(l) = product_list(nproducts)%Fm(l)*factor
301 END DO
302
303 w = (zeta1*p + eta*q)*zetapetainv
304 product_list(nproducts)%ra = ra
305 product_list(nproducts)%rb = rb
306 product_list(nproducts)%rc = c11
307 product_list(nproducts)%rd = tmp_d
308 product_list(nproducts)%ZetapEtaInv = zetapetainv
309 product_list(nproducts)%Rho = rho
310 product_list(nproducts)%RhoInv = rhoinv
311 product_list(nproducts)%P = p
312 product_list(nproducts)%Q = q
313 product_list(nproducts)%W = w
314 product_list(nproducts)%AB = ra - rb
315 product_list(nproducts)%CD = c11 - tmp_d
316 END DO
317 END DO
318 END DO
319
320 END SUBROUTINE build_pgf_product_list
321
322! **************************************************************************************************
323!> \brief ...
324!> \param npgfa ...
325!> \param npgfb ...
326!> \param list ...
327!> \param zeta ...
328!> \param zetb ...
329!> \param screen1 ...
330!> \param screen2 ...
331!> \param pgf ...
332!> \param R_pgf ...
333!> \param log10_pmax ...
334!> \param log10_eps_schwarz ...
335!> \param ra ...
336!> \param rb ...
337!> \param nelements ...
338!> \param neighbor_cells ...
339!> \param nimages ...
340!> \param do_periodic ...
341! **************************************************************************************************
342 SUBROUTINE build_pair_list_pgf(npgfa, npgfb, list, zeta, zetb, screen1, screen2, pgf, R_pgf, &
343 log10_pmax, log10_eps_schwarz, ra, rb, nelements, &
344 neighbor_cells, nimages, do_periodic)
345 INTEGER, INTENT(IN) :: npgfa, npgfb
346 TYPE(hfx_pgf_list), DIMENSION(npgfa*npgfb) :: list
347 REAL(dp), DIMENSION(1:npgfa), INTENT(IN) :: zeta
348 REAL(dp), DIMENSION(1:npgfb), INTENT(IN) :: zetb
349 REAL(dp), INTENT(IN) :: screen1(2), screen2(2)
350 TYPE(hfx_screen_coeff_type), DIMENSION(:, :), &
351 POINTER :: pgf, r_pgf
352 REAL(dp), INTENT(IN) :: log10_pmax, log10_eps_schwarz, ra(3), &
353 rb(3)
354 INTEGER, INTENT(OUT) :: nelements
355 TYPE(hfx_cell_type), DIMENSION(:), POINTER :: neighbor_cells
356 INTEGER :: nimages(npgfa*npgfb)
357 LOGICAL, INTENT(IN) :: do_periodic
358
359 INTEGER :: element_counter, i, ipgf, j, jpgf
360 REAL(dp) :: ab(3), im_b(3), pgf_max, rab2, zeta1, &
361 zeta_a, zeta_b, zetainv
362
363 nimages = 0
364 ! ** inner loop may never be reached
365 nelements = npgfa*npgfb
366 DO i = 1, SIZE(neighbor_cells)
367 IF (do_periodic) THEN
368 im_b = rb + neighbor_cells(i)%cell_r(:)
369 ELSE
370 im_b = rb
371 END IF
372 ab = ra - im_b
373 rab2 = ab(1)**2 + ab(2)**2 + ab(3)**2
374 IF (screen1(1)*rab2 + screen1(2) + screen2(2) + log10_pmax < log10_eps_schwarz) cycle
375 element_counter = 0
376 DO ipgf = 1, npgfa
377 DO jpgf = 1, npgfb
378 element_counter = element_counter + 1
379 pgf_max = pgf(jpgf, ipgf)%x(1)*rab2 + pgf(jpgf, ipgf)%x(2)
380 IF (pgf_max + screen2(2) + log10_pmax < log10_eps_schwarz) THEN
381 cycle
382 END IF
383 nimages(element_counter) = nimages(element_counter) + 1
384 list(element_counter)%image_list(nimages(element_counter))%pgf_max = pgf_max
385 list(element_counter)%image_list(nimages(element_counter))%ra = ra
386 list(element_counter)%image_list(nimages(element_counter))%rb = im_b
387 list(element_counter)%image_list(nimages(element_counter))%rab2 = rab2
388
389 zeta_a = zeta(ipgf)
390 zeta_b = zetb(jpgf)
391 zeta1 = zeta_a + zeta_b
392 zetainv = 1.0_dp/zeta1
393
394 IF (nimages(element_counter) == 1) THEN
395 list(element_counter)%ipgf = ipgf
396 list(element_counter)%jpgf = jpgf
397 list(element_counter)%zetaInv = zetainv
398 list(element_counter)%zetapzetb = zeta1
399 list(element_counter)%zeta = zeta_a
400 list(element_counter)%zetb = zeta_b
401 END IF
402
403 list(element_counter)%image_list(nimages(element_counter))%S1234 = (-zeta_a*zeta_b*zetainv*rab2)
404 list(element_counter)%image_list(nimages(element_counter))%P = (zeta_a*ra + zeta_b*im_b)*zetainv
405 list(element_counter)%image_list(nimages(element_counter))%R = &
406 max(0.0_dp, r_pgf(jpgf, ipgf)%x(1)*rab2 + r_pgf(jpgf, ipgf)%x(2))
407 list(element_counter)%image_list(nimages(element_counter))%ra = ra
408 list(element_counter)%image_list(nimages(element_counter))%rb = im_b
409 list(element_counter)%image_list(nimages(element_counter))%rab2 = rab2
410 list(element_counter)%image_list(nimages(element_counter))%bcell = neighbor_cells(i)%cell
411 END DO
412 END DO
413 nelements = max(nelements, element_counter)
414 END DO
415 DO j = 1, nelements
416 list(j)%nimages = nimages(j)
417 END DO
418 ! ** Remove unused elements
419
420 element_counter = 0
421 DO j = 1, nelements
422 IF (list(j)%nimages == 0) cycle
423 element_counter = element_counter + 1
424 list(element_counter)%nimages = list(j)%nimages
425 list(element_counter)%zetapzetb = list(j)%zetapzetb
426 list(element_counter)%ZetaInv = list(j)%ZetaInv
427 list(element_counter)%zeta = list(j)%zeta
428 list(element_counter)%zetb = list(j)%zetb
429 list(element_counter)%ipgf = list(j)%ipgf
430 list(element_counter)%jpgf = list(j)%jpgf
431 DO i = 1, list(j)%nimages
432 list(element_counter)%image_list(i) = list(j)%image_list(i)
433 END DO
434 END DO
435
436 nelements = element_counter
437
438 END SUBROUTINE build_pair_list_pgf
439
440! **************************************************************************************************
441!> \brief ...
442!> \param natom ...
443!> \param list ...
444!> \param set_list ...
445!> \param i_start ...
446!> \param i_end ...
447!> \param j_start ...
448!> \param j_end ...
449!> \param kind_of ...
450!> \param basis_parameter ...
451!> \param particle_set ...
452!> \param do_periodic ...
453!> \param coeffs_set ...
454!> \param coeffs_kind ...
455!> \param coeffs_kind_max0 ...
456!> \param log10_eps_schwarz ...
457!> \param cell ...
458!> \param pmax_blocks ...
459!> \param atomic_pair_list ...
460! **************************************************************************************************
461 SUBROUTINE build_pair_list(natom, list, set_list, i_start, i_end, j_start, j_end, kind_of, basis_parameter, particle_set, &
462 do_periodic, coeffs_set, coeffs_kind, coeffs_kind_max0, log10_eps_schwarz, cell, &
463 pmax_blocks, atomic_pair_list)
464
465 INTEGER, INTENT(IN) :: natom
466 TYPE(pair_list_type), INTENT(OUT) :: list
467 TYPE(pair_set_list_type), DIMENSION(:), &
468 INTENT(OUT) :: set_list
469 INTEGER, INTENT(IN) :: i_start, i_end, j_start, j_end
470 INTEGER :: kind_of(*)
471 TYPE(hfx_basis_type), DIMENSION(:), POINTER :: basis_parameter
472 TYPE(particle_type), DIMENSION(:), POINTER :: particle_set
473 LOGICAL, INTENT(IN) :: do_periodic
474 TYPE(hfx_screen_coeff_type), &
475 DIMENSION(:, :, :, :), POINTER :: coeffs_set
476 TYPE(hfx_screen_coeff_type), DIMENSION(:, :) :: coeffs_kind
477 REAL(kind=dp), INTENT(IN) :: coeffs_kind_max0, log10_eps_schwarz
478 TYPE(cell_type), POINTER :: cell
479 REAL(dp) :: pmax_blocks
480 LOGICAL, DIMENSION(natom, natom) :: atomic_pair_list
481
482 INTEGER :: iatom, ikind, iset, jatom, jkind, jset, &
483 n_element, nset_ij, nseta, nsetb
484 REAL(kind=dp) :: rab2
485 REAL(kind=dp), DIMENSION(3) :: b11, pbc_b, ra, rb, temp
486
487 n_element = 0
488 nset_ij = 0
489
490 DO iatom = i_start, i_end
491 DO jatom = j_start, j_end
492 IF (atomic_pair_list(jatom, iatom) .EQV. .false.) cycle
493
494 ikind = kind_of(iatom)
495 nseta = basis_parameter(ikind)%nset
496 ra = particle_set(iatom)%r(:)
497
498 IF (jatom < iatom) cycle
499 jkind = kind_of(jatom)
500 nsetb = basis_parameter(jkind)%nset
501 rb = particle_set(jatom)%r(:)
502
503 IF (do_periodic) THEN
504 temp = rb - ra
505 pbc_b = pbc(temp, cell)
506 b11 = ra + pbc_b
507 rab2 = (ra(1) - b11(1))**2 + (ra(2) - b11(2))**2 + (ra(3) - b11(3))**2
508 ELSE
509 rab2 = (ra(1) - rb(1))**2 + (ra(2) - rb(2))**2 + (ra(3) - rb(3))**2
510 b11 = rb ! ra - rb
511 END IF
512 IF ((coeffs_kind(jkind, ikind)%x(1)*rab2 + &
513 coeffs_kind(jkind, ikind)%x(2)) + coeffs_kind_max0 + pmax_blocks < log10_eps_schwarz) cycle
514
515 n_element = n_element + 1
516 list%elements(n_element)%pair(1) = iatom
517 list%elements(n_element)%pair(2) = jatom
518 list%elements(n_element)%kind_pair(1) = ikind
519 list%elements(n_element)%kind_pair(2) = jkind
520 list%elements(n_element)%r1 = ra
521 list%elements(n_element)%r2 = b11
522 list%elements(n_element)%dist2 = rab2
523 ! build a list of guaranteed overlapping sets
524 list%elements(n_element)%set_bounds(1) = nset_ij + 1
525 DO iset = 1, nseta
526 DO jset = 1, nsetb
527 IF (coeffs_set(jset, iset, jkind, ikind)%x(1)*rab2 + coeffs_set(jset, iset, jkind, ikind)%x(2) + &
528 coeffs_kind_max0 + pmax_blocks < log10_eps_schwarz) cycle
529 nset_ij = nset_ij + 1
530 set_list(nset_ij)%pair(1) = iset
531 set_list(nset_ij)%pair(2) = jset
532 END DO
533 END DO
534 list%elements(n_element)%set_bounds(2) = nset_ij
535 END DO
536 END DO
537
538 list%n_element = n_element
539
540 END SUBROUTINE build_pair_list
541
542! **************************************************************************************************
543!> \brief ...
544!> \param natom ...
545!> \param atomic_pair_list ...
546!> \param kind_of ...
547!> \param basis_parameter ...
548!> \param particle_set ...
549!> \param do_periodic ...
550!> \param coeffs_kind ...
551!> \param coeffs_kind_max0 ...
552!> \param log10_eps_schwarz ...
553!> \param cell ...
554!> \param blocks ...
555! **************************************************************************************************
556 SUBROUTINE build_atomic_pair_list(natom, atomic_pair_list, kind_of, basis_parameter, particle_set, &
557 do_periodic, coeffs_kind, coeffs_kind_max0, log10_eps_schwarz, cell, &
558 blocks)
559 INTEGER, INTENT(IN) :: natom
560 LOGICAL, DIMENSION(natom, natom) :: atomic_pair_list
561 INTEGER :: kind_of(*)
562 TYPE(hfx_basis_type), DIMENSION(:), POINTER :: basis_parameter
563 TYPE(particle_type), DIMENSION(:), POINTER :: particle_set
564 LOGICAL, INTENT(IN) :: do_periodic
565 TYPE(hfx_screen_coeff_type), DIMENSION(:, :) :: coeffs_kind
566 REAL(kind=dp), INTENT(IN) :: coeffs_kind_max0, log10_eps_schwarz
567 TYPE(cell_type), POINTER :: cell
568 TYPE(hfx_block_range_type), DIMENSION(:), POINTER :: blocks
569
570 INTEGER :: iatom, iatom_end, iatom_start, iblock, &
571 ikind, jatom, jatom_end, jatom_start, &
572 jblock, jkind, nseta, nsetb
573 REAL(kind=dp) :: rab2
574 REAL(kind=dp), DIMENSION(3) :: b11, pbc_b, ra, rb, temp
575
576 atomic_pair_list = .false.
577
578 DO iblock = 1, SIZE(blocks)
579 iatom_start = blocks(iblock)%istart
580 iatom_end = blocks(iblock)%iend
581 DO jblock = 1, SIZE(blocks)
582 jatom_start = blocks(jblock)%istart
583 jatom_end = blocks(jblock)%iend
584
585 DO iatom = iatom_start, iatom_end
586 ikind = kind_of(iatom)
587 nseta = basis_parameter(ikind)%nset
588 ra = particle_set(iatom)%r(:)
589 DO jatom = jatom_start, jatom_end
590 IF (jatom < iatom) cycle
591 jkind = kind_of(jatom)
592 nsetb = basis_parameter(jkind)%nset
593 rb = particle_set(jatom)%r(:)
594
595 IF (do_periodic) THEN
596 temp = rb - ra
597 pbc_b = pbc(temp, cell)
598 b11 = ra + pbc_b
599 rab2 = (ra(1) - b11(1))**2 + (ra(2) - b11(2))**2 + (ra(3) - b11(3))**2
600 ELSE
601 rab2 = (ra(1) - rb(1))**2 + (ra(2) - rb(2))**2 + (ra(3) - rb(3))**2
602 b11 = rb ! ra - rb
603 END IF
604 IF ((coeffs_kind(jkind, ikind)%x(1)*rab2 + &
605 coeffs_kind(jkind, ikind)%x(2)) + coeffs_kind_max0 < log10_eps_schwarz) cycle
606
607 atomic_pair_list(jatom, iatom) = .true.
608 atomic_pair_list(iatom, jatom) = .true.
609 END DO
610 END DO
611 END DO
612 END DO
613
614 END SUBROUTINE build_atomic_pair_list
615
616! **************************************************************************************************
617!> \brief ...
618!> \param natom ...
619!> \param list ...
620!> \param set_list ...
621!> \param i_start ...
622!> \param i_end ...
623!> \param j_start ...
624!> \param j_end ...
625!> \param kind_of ...
626!> \param basis_parameter ...
627!> \param particle_set ...
628!> \param do_periodic ...
629!> \param coeffs_set ...
630!> \param coeffs_kind ...
631!> \param coeffs_kind_max0 ...
632!> \param log10_eps_schwarz ...
633!> \param cell ...
634!> \param pmax_blocks ...
635!> \param atomic_pair_list ...
636!> \param skip_atom_symmetry ...
637! **************************************************************************************************
638 SUBROUTINE build_pair_list_mp2(natom, list, set_list, i_start, i_end, j_start, j_end, kind_of, basis_parameter, particle_set, &
639 do_periodic, coeffs_set, coeffs_kind, coeffs_kind_max0, log10_eps_schwarz, cell, &
640 pmax_blocks, atomic_pair_list, skip_atom_symmetry)
641
642 INTEGER, INTENT(IN) :: natom
643 TYPE(pair_list_type_mp2) :: list
644 TYPE(pair_set_list_type), DIMENSION(:), &
645 INTENT(OUT) :: set_list
646 INTEGER, INTENT(IN) :: i_start, i_end, j_start, j_end
647 INTEGER :: kind_of(*)
648 TYPE(hfx_basis_type), DIMENSION(:), POINTER :: basis_parameter
649 TYPE(particle_type), DIMENSION(:), POINTER :: particle_set
650 LOGICAL, INTENT(IN) :: do_periodic
651 TYPE(hfx_screen_coeff_type), &
652 DIMENSION(:, :, :, :), POINTER :: coeffs_set
653 TYPE(hfx_screen_coeff_type), DIMENSION(:, :) :: coeffs_kind
654 REAL(kind=dp), INTENT(IN) :: coeffs_kind_max0, log10_eps_schwarz
655 TYPE(cell_type), POINTER :: cell
656 REAL(dp) :: pmax_blocks
657 LOGICAL, DIMENSION(natom, natom) :: atomic_pair_list
658 LOGICAL, OPTIONAL :: skip_atom_symmetry
659
660 INTEGER :: iatom, ikind, iset, jatom, jkind, jset, &
661 n_element, nset_ij, nseta, nsetb
662 LOGICAL :: my_skip_atom_symmetry
663 REAL(kind=dp) :: rab2
664 REAL(kind=dp), DIMENSION(3) :: b11, pbc_b, ra, rb, temp
665
666 n_element = 0
667 nset_ij = 0
668
669 my_skip_atom_symmetry = .false.
670 IF (PRESENT(skip_atom_symmetry)) my_skip_atom_symmetry = skip_atom_symmetry
671
672 DO iatom = i_start, i_end
673 DO jatom = j_start, j_end
674 IF (atomic_pair_list(jatom, iatom) .EQV. .false.) cycle
675
676 ikind = kind_of(iatom)
677 nseta = basis_parameter(ikind)%nset
678 ra = particle_set(iatom)%r(:)
679
680 IF (jatom < iatom .AND. (.NOT. my_skip_atom_symmetry)) cycle
681 jkind = kind_of(jatom)
682 nsetb = basis_parameter(jkind)%nset
683 rb = particle_set(jatom)%r(:)
684
685 IF (do_periodic) THEN
686 temp = rb - ra
687 pbc_b = pbc(temp, cell)
688 b11 = ra + pbc_b
689 rab2 = (ra(1) - b11(1))**2 + (ra(2) - b11(2))**2 + (ra(3) - b11(3))**2
690 ELSE
691 rab2 = (ra(1) - rb(1))**2 + (ra(2) - rb(2))**2 + (ra(3) - rb(3))**2
692 b11 = rb ! ra - rb
693 END IF
694 IF ((coeffs_kind(jkind, ikind)%x(1)*rab2 + &
695 coeffs_kind(jkind, ikind)%x(2)) + coeffs_kind_max0 + pmax_blocks < log10_eps_schwarz) cycle
696
697 n_element = n_element + 1
698 list%elements(n_element)%pair(1) = iatom
699 list%elements(n_element)%pair(2) = jatom
700 list%elements(n_element)%kind_pair(1) = ikind
701 list%elements(n_element)%kind_pair(2) = jkind
702 list%elements(n_element)%r1 = ra
703 list%elements(n_element)%r2 = b11
704 list%elements(n_element)%dist2 = rab2
705 ! build a list of guaranteed overlapping sets
706 list%elements(n_element)%set_bounds(1) = nset_ij + 1
707 DO iset = 1, nseta
708 DO jset = 1, nsetb
709 IF (coeffs_set(jset, iset, jkind, ikind)%x(1)*rab2 + coeffs_set(jset, iset, jkind, ikind)%x(2) + &
710 coeffs_kind_max0 + pmax_blocks < log10_eps_schwarz) cycle
711 nset_ij = nset_ij + 1
712 set_list(nset_ij)%pair(1) = iset
713 set_list(nset_ij)%pair(2) = jset
714 END DO
715 END DO
716 list%elements(n_element)%set_bounds(2) = nset_ij
717 END DO
718 END DO
719
720 list%n_element = n_element
721
722 END SUBROUTINE build_pair_list_mp2
723
724END MODULE hfx_pair_list_methods
cell_types::pbc
Definition cell_types.F:92
cell_types
Handles all functions related to the CELL.
Definition cell_types.F:15
gamma
Calculation of the incomplete Gamma function F_n(t) for multi-center integrals over Cartesian Gaussia...
Definition gamma.F:15
gamma::fgamma_0
subroutine, public fgamma_0(nmax, t, f)
Calculation of the incomplete Gamma function F(t) for multicenter integrals over Gaussian functions....
Definition gamma.F:154
hfx_pair_list_methods
Routines for optimizing load balance between processes in HFX calculations.
Definition hfx_pair_list_methods.F:15
hfx_pair_list_methods::build_pgf_product_list
subroutine, public build_pgf_product_list(list1, list2, product_list, nproducts, log10_pmax, log10_eps_schwarz, neighbor_cells, cell, potential_parameter, m_max, do_periodic)
...
Definition hfx_pair_list_methods.F:69
hfx_pair_list_methods::build_atomic_pair_list
subroutine, public build_atomic_pair_list(natom, atomic_pair_list, kind_of, basis_parameter, particle_set, do_periodic, coeffs_kind, coeffs_kind_max0, log10_eps_schwarz, cell, blocks)
...
Definition hfx_pair_list_methods.F:559
hfx_pair_list_methods::build_pair_list
subroutine, public build_pair_list(natom, list, set_list, i_start, i_end, j_start, j_end, kind_of, basis_parameter, particle_set, do_periodic, coeffs_set, coeffs_kind, coeffs_kind_max0, log10_eps_schwarz, cell, pmax_blocks, atomic_pair_list)
...
Definition hfx_pair_list_methods.F:464
hfx_pair_list_methods::build_pair_list_pgf
subroutine, public build_pair_list_pgf(npgfa, npgfb, list, zeta, zetb, screen1, screen2, pgf, r_pgf, log10_pmax, log10_eps_schwarz, ra, rb, nelements, neighbor_cells, nimages, do_periodic)
...
Definition hfx_pair_list_methods.F:345
hfx_pair_list_methods::build_pair_list_mp2
subroutine, public build_pair_list_mp2(natom, list, set_list, i_start, i_end, j_start, j_end, kind_of, basis_parameter, particle_set, do_periodic, coeffs_set, coeffs_kind, coeffs_kind_max0, log10_eps_schwarz, cell, pmax_blocks, atomic_pair_list, skip_atom_symmetry)
...
Definition hfx_pair_list_methods.F:641
hfx_pair_list_methods::pgf_product_list_size
integer, save, public pgf_product_list_size
Definition hfx_pair_list_methods.F:46
hfx_types
Types and set/get functions for HFX.
Definition hfx_types.F:15
input_constants
collects all constants needed in input so that they can be used without circular dependencies
Definition input_constants.F:17
input_constants::do_potential_mix_cl
integer, parameter, public do_potential_mix_cl
Definition input_constants.F:801
input_constants::do_potential_gaussian
integer, parameter, public do_potential_gaussian
Definition input_constants.F:801
input_constants::do_potential_truncated
integer, parameter, public do_potential_truncated
Definition input_constants.F:801
input_constants::do_potential_mix_lg
integer, parameter, public do_potential_mix_lg
Definition input_constants.F:801
input_constants::do_potential_id
integer, parameter, public do_potential_id
Definition input_constants.F:801
input_constants::do_potential_coulomb
integer, parameter, public do_potential_coulomb
Definition input_constants.F:801
input_constants::do_potential_short
integer, parameter, public do_potential_short
Definition input_constants.F:801
input_constants::do_potential_mix_cl_trunc
integer, parameter, public do_potential_mix_cl_trunc
Definition input_constants.F:801
input_constants::do_potential_long
integer, parameter, public do_potential_long
Definition input_constants.F:801
input_constants::do_potential_tshpsc
integer, parameter, public do_potential_tshpsc
Definition input_constants.F:801
kinds
Defines the basic variable types.
Definition kinds.F:23
kinds::dp
integer, parameter, public dp
Definition kinds.F:34
libint_wrapper
Interface to the Libint-Library or a c++ wrapper.
Definition libint_wrapper.F:15
libint_wrapper::prim_data_f_size
integer, parameter, public prim_data_f_size
Definition libint_wrapper.F:63
list
An array-based list which grows on demand. When the internal array is full, a new array of twice the ...
Definition list.F:24
mathconstants
Definition of mathematical constants and functions.
Definition mathconstants.F:16
mathconstants::pi
real(kind=dp), parameter, public pi
Definition mathconstants.F:110
mp2_types
Types needed for MP2 calculations.
Definition mp2_types.F:14
particle_types
Define the data structure for the particle information.
Definition particle_types.F:19
t_c_g0
This module computes the basic integrals for the truncated coulomb operator.
Definition t_c_g0.F:57
t_c_g0::t_c_g0_n
subroutine, public t_c_g0_n(res, use_gamma, r, t, nderiv)
...
Definition t_c_g0.F:84
t_sh_p_s_c
...
Definition t_sh_p_s_c.F:39
t_sh_p_s_c::trunc_cs_poly_n20
subroutine, public trunc_cs_poly_n20(res, r, t, nderiv)
...
Definition t_sh_p_s_c.F:65
cell_types::cell_type
Type defining parameters related to the simulation cell.
Definition cell_types.F:55
hfx_types::hfx_basis_type
Definition hfx_types.F:263
hfx_types::hfx_block_range_type
Definition hfx_types.F:339
hfx_types::hfx_cell_type
Definition hfx_types.F:204
hfx_types::hfx_pgf_list
Definition hfx_types.F:318
hfx_types::hfx_pgf_product_list
Definition hfx_types.F:329
hfx_types::hfx_potential_type
Definition hfx_types.F:138
hfx_types::hfx_screen_coeff_type
Definition hfx_types.F:291
hfx_types::pair_list_type
Definition hfx_types.F:235
hfx_types::pair_set_list_type
Definition hfx_types.F:230
mp2_types::pair_list_type_mp2
Definition mp2_types.F:391
particle_types::particle_type
Definition particle_types.F:35