(git:34ef472)
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 ! **************************************************************************************************
15 MODULE 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 
50 CONTAINS
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 
724 END MODULE hfx_pair_list_methods
pbc
subroutine pbc(r, r_pbc, s, s_pbc, a, b, c, alpha, beta, gamma, debug, info, pbc0, h, hinv)
...
Definition: dumpdcd.F:1203
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_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_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_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