(git:b195825)
kpoint_coulomb_2c.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 to compute the Coulomb integral V_(alpha beta)(k) for a k-point k using lattice
10 !> summation in real space. These integrals are e.g. needed in periodic RI for RPA, GW
11 !> \par History
12 !> 2018.05 created [Jan Wilhelm]
13 !> \author Jan Wilhelm
14 ! **************************************************************************************************
16  USE atomic_kind_types, ONLY: atomic_kind_type,&
18  USE basis_set_types, ONLY: gto_basis_set_type
19  USE cell_types, ONLY: cell_type,&
20  get_cell,&
21  pbc
22  USE dbcsr_api, ONLY: &
23  dbcsr_create, dbcsr_init_p, dbcsr_iterator_blocks_left, dbcsr_iterator_next_block, &
24  dbcsr_iterator_start, dbcsr_iterator_stop, dbcsr_iterator_type, dbcsr_p_type, &
25  dbcsr_release_p, dbcsr_reserve_all_blocks, dbcsr_set, dbcsr_type, dbcsr_type_no_symmetry
28  USE kinds, ONLY: dp
29  USE kpoint_types, ONLY: get_kpoint_info,&
30  kpoint_type
31  USE mathconstants, ONLY: twopi
32  USE particle_types, ONLY: particle_type
33  USE qs_kind_types, ONLY: get_qs_kind,&
34  qs_kind_type
35 #include "./base/base_uses.f90"
36 
37  IMPLICIT NONE
38 
39  PRIVATE
40 
41  CHARACTER(len=*), PARAMETER, PRIVATE :: moduleN = 'kpoint_coulomb_2c'
42 
44 
45 ! **************************************************************************************************
46 
47  TYPE two_d_util_type
48  REAL(KIND=dp), ALLOCATABLE, DIMENSION(:, :) :: block
49  END TYPE
50 
51 CONTAINS
52 
53 ! **************************************************************************************************
54 !> \brief ...
55 !> \param matrix_v_kp ...
56 !> \param kpoints ...
57 !> \param basis_type ...
58 !> \param cell ...
59 !> \param particle_set ...
60 !> \param qs_kind_set ...
61 !> \param atomic_kind_set ...
62 !> \param size_lattice_sum ...
63 !> \param operator_type ...
64 !> \param ikp_start ...
65 !> \param ikp_end ...
66 ! **************************************************************************************************
67  SUBROUTINE build_2c_coulomb_matrix_kp(matrix_v_kp, kpoints, basis_type, cell, particle_set, qs_kind_set, &
68  atomic_kind_set, size_lattice_sum, operator_type, ikp_start, ikp_end)
69 
70  TYPE(dbcsr_p_type), DIMENSION(:, :), POINTER :: matrix_v_kp
71  TYPE(kpoint_type), POINTER :: kpoints
72  CHARACTER(LEN=*), INTENT(IN) :: basis_type
73  TYPE(cell_type), POINTER :: cell
74  TYPE(particle_type), DIMENSION(:), POINTER :: particle_set
75  TYPE(qs_kind_type), DIMENSION(:), POINTER :: qs_kind_set
76  TYPE(atomic_kind_type), DIMENSION(:), POINTER :: atomic_kind_set
77  INTEGER :: size_lattice_sum, operator_type, &
78  ikp_start, ikp_end
79 
80  CHARACTER(LEN=*), PARAMETER :: routinen = 'build_2c_coulomb_matrix_kp'
81 
82  INTEGER :: handle, total_periodicity
83  TYPE(dbcsr_type), POINTER :: matrix_v_l_tmp
84 
85  CALL timeset(routinen, handle)
86 
87  CALL check_periodicity(cell, kpoints, total_periodicity)
88 
89  CALL allocate_tmp(matrix_v_l_tmp, matrix_v_kp, ikp_start)
90 
91  CALL lattice_sum(matrix_v_kp, kpoints, basis_type, cell, particle_set, &
92  qs_kind_set, atomic_kind_set, size_lattice_sum, matrix_v_l_tmp, &
93  operator_type, ikp_start, ikp_end)
94 
95  CALL deallocate_tmp(matrix_v_l_tmp)
96 
97  CALL timestop(handle)
98 
99  END SUBROUTINE build_2c_coulomb_matrix_kp
100 
101 ! **************************************************************************************************
102 !> \brief ...
103 !> \param matrix_v_kp ...
104 !> \param kpoints ...
105 !> \param basis_type ...
106 !> \param cell ...
107 !> \param particle_set ...
108 !> \param qs_kind_set ...
109 !> \param atomic_kind_set ...
110 !> \param size_lattice_sum ...
111 !> \param matrix_v_L_tmp ...
112 !> \param operator_type ...
113 !> \param ikp_start ...
114 !> \param ikp_end ...
115 ! **************************************************************************************************
116  SUBROUTINE lattice_sum(matrix_v_kp, kpoints, basis_type, cell, particle_set, &
117  qs_kind_set, atomic_kind_set, size_lattice_sum, matrix_v_L_tmp, &
118  operator_type, ikp_start, ikp_end)
119 
120  TYPE(dbcsr_p_type), DIMENSION(:, :), POINTER :: matrix_v_kp
121  TYPE(kpoint_type), POINTER :: kpoints
122  CHARACTER(LEN=*), INTENT(IN) :: basis_type
123  TYPE(cell_type), POINTER :: cell
124  TYPE(particle_type), DIMENSION(:), POINTER :: particle_set
125  TYPE(qs_kind_type), DIMENSION(:), POINTER :: qs_kind_set
126  TYPE(atomic_kind_type), DIMENSION(:), POINTER :: atomic_kind_set
127  INTEGER :: size_lattice_sum
128  TYPE(dbcsr_type), POINTER :: matrix_v_l_tmp
129  INTEGER :: operator_type, ikp_start, ikp_end
130 
131  CHARACTER(LEN=*), PARAMETER :: routinen = 'lattice_sum'
132 
133  INTEGER :: factor, handle, i_block, i_x, i_x_inner, i_x_outer, ik, j_y, j_y_inner, &
134  j_y_outer, k_z, k_z_inner, k_z_outer, nkp, x_max, x_min, y_max, y_min, z_max, z_min
135  INTEGER, DIMENSION(3) :: nkp_grid, periodic
136  REAL(kind=dp) :: coskl, sinkl
137  REAL(kind=dp), DIMENSION(3) :: vec_l, vec_s
138  REAL(kind=dp), DIMENSION(3, 3) :: hmat
139  TYPE(two_d_util_type), ALLOCATABLE, DIMENSION(:) :: blocks_v_l, blocks_v_l_store
140  TYPE(two_d_util_type), ALLOCATABLE, &
141  DIMENSION(:, :, :) :: blocks_v_kp
142 
143  CALL timeset(routinen, handle)
144 
145  CALL get_kpoint_info(kpoints, nkp_grid=nkp_grid, nkp=nkp)
146  CALL get_cell(cell=cell, h=hmat, periodic=periodic)
147 
148  IF (modulo(nkp_grid(1), 2) == 1) THEN
149  factor = 3**(size_lattice_sum - 1)
150  ELSE IF (modulo(nkp_grid(1), 2) == 0) THEN
151  factor = 2**(size_lattice_sum - 1)
152  END IF
153 
154  IF (modulo(nkp_grid(1), 2) == 1) THEN
155  x_min = -(factor*nkp_grid(1) - 1)/2
156  x_max = (factor*nkp_grid(1) - 1)/2
157  ELSE IF (modulo(nkp_grid(1), 2) == 0) THEN
158  x_min = -factor*nkp_grid(1)/2
159  x_max = factor*nkp_grid(1)/2 - 1
160  END IF
161  IF (periodic(1) == 0) THEN
162  x_min = 0
163  x_max = 0
164  END IF
165 
166  IF (modulo(nkp_grid(2), 2) == 1) THEN
167  y_min = -(factor*nkp_grid(2) - 1)/2
168  y_max = (factor*nkp_grid(2) - 1)/2
169  ELSE IF (modulo(nkp_grid(2), 2) == 0) THEN
170  y_min = -factor*nkp_grid(2)/2
171  y_max = factor*nkp_grid(2)/2 - 1
172  END IF
173  IF (periodic(2) == 0) THEN
174  y_min = 0
175  y_max = 0
176  END IF
177 
178  IF (modulo(nkp_grid(3), 2) == 1) THEN
179  z_min = -(factor*nkp_grid(3) - 1)/2
180  z_max = (factor*nkp_grid(3) - 1)/2
181  ELSE IF (modulo(nkp_grid(3), 2) == 0) THEN
182  z_min = -factor*nkp_grid(3)/2
183  z_max = factor*nkp_grid(3)/2 - 1
184  END IF
185  IF (periodic(3) == 0) THEN
186  z_min = 0
187  z_max = 0
188  END IF
189 
190  CALL allocate_blocks_v_kp(blocks_v_kp, matrix_v_kp, ikp_start, ikp_end)
191  CALL allocate_blocks_v_l(blocks_v_l, matrix_v_l_tmp)
192  CALL allocate_blocks_v_l(blocks_v_l_store, matrix_v_l_tmp)
193 
194  DO i_x_inner = 0, 2*nkp_grid(1) - 1
195  DO j_y_inner = 0, 2*nkp_grid(2) - 1
196  DO k_z_inner = 0, 2*nkp_grid(3) - 1
197 
198  DO i_x_outer = x_min, x_max + nkp_grid(1), 2*nkp_grid(1)
199  DO j_y_outer = y_min, y_max + nkp_grid(2), 2*nkp_grid(2)
200  DO k_z_outer = z_min, z_max + nkp_grid(3), 2*nkp_grid(3)
201 
202  i_x = i_x_inner + i_x_outer
203  j_y = j_y_inner + j_y_outer
204  k_z = k_z_inner + k_z_outer
205 
206  IF (i_x > x_max .OR. i_x < x_min .OR. &
207  j_y > y_max .OR. j_y < y_min .OR. &
208  k_z > z_max .OR. k_z < z_min) cycle
209 
210  vec_s = [real(i_x, dp), real(j_y, dp), real(k_z, dp)]
211 
212  vec_l = matmul(hmat, vec_s)
213 
214  ! Compute (P 0 | Q vec_L) and store it in matrix_v_L_tmp
215  CALL compute_v_transl(matrix_v_l_tmp, blocks_v_l, vec_l, particle_set, &
216  qs_kind_set, atomic_kind_set, basis_type, cell, &
217  operator_type)
218 
219  DO i_block = 1, SIZE(blocks_v_l)
220  blocks_v_l_store(i_block)%block(:, :) = blocks_v_l_store(i_block)%block(:, :) &
221  + blocks_v_l(i_block)%block(:, :)
222  END DO
223 
224  END DO
225  END DO
226  END DO
227 
228  ! add exp(iq*vec_L) * (P 0 | Q vec_L) to V_PQ(q)
229  DO ik = ikp_start, ikp_end
230 
231  ! coskl and sinkl are identical for all i_x_outer, j_y_outer, k_z_outer
232  coskl = cos(twopi*dot_product(vec_s(1:3), kpoints%xkp(1:3, ik)))
233  sinkl = sin(twopi*dot_product(vec_s(1:3), kpoints%xkp(1:3, ik)))
234 
235  DO i_block = 1, SIZE(blocks_v_l)
236 
237  blocks_v_kp(ik, 1, i_block)%block(:, :) = blocks_v_kp(ik, 1, i_block)%block(:, :) &
238  + coskl*blocks_v_l_store(i_block)%block(:, :)
239  blocks_v_kp(ik, 2, i_block)%block(:, :) = blocks_v_kp(ik, 2, i_block)%block(:, :) &
240  + sinkl*blocks_v_l_store(i_block)%block(:, :)
241 
242  END DO
243 
244  END DO
245 
246  DO i_block = 1, SIZE(blocks_v_l)
247 
248  blocks_v_l_store(i_block)%block(:, :) = 0.0_dp
249 
250  END DO
251 
252  END DO
253  END DO
254  END DO
255 
256  CALL set_blocks_to_matrix_v_kp(matrix_v_kp, blocks_v_kp, ikp_start, ikp_end)
257 
258  CALL deallocate_blocks_v_kp(blocks_v_kp)
259  CALL deallocate_blocks_v_l(blocks_v_l)
260  CALL deallocate_blocks_v_l(blocks_v_l_store)
261 
262  CALL timestop(handle)
263 
264  END SUBROUTINE
265 
266 ! **************************************************************************************************
267 !> \brief ...
268 !> \param matrix_v_kp ...
269 !> \param blocks_v_kp ...
270 !> \param ikp_start ...
271 !> \param ikp_end ...
272 ! **************************************************************************************************
273  SUBROUTINE set_blocks_to_matrix_v_kp(matrix_v_kp, blocks_v_kp, ikp_start, ikp_end)
274 
275  TYPE(dbcsr_p_type), DIMENSION(:, :), POINTER :: matrix_v_kp
276  TYPE(two_d_util_type), ALLOCATABLE, &
277  DIMENSION(:, :, :) :: blocks_v_kp
278  INTEGER :: ikp_start, ikp_end
279 
280  CHARACTER(LEN=*), PARAMETER :: routinen = 'set_blocks_to_matrix_v_kp'
281 
282  INTEGER :: col, handle, i_block, i_real_im, ik, row
283  REAL(kind=dp), DIMENSION(:, :), POINTER :: data_block
284  TYPE(dbcsr_iterator_type) :: iter
285 
286  CALL timeset(routinen, handle)
287 
288  DO ik = ikp_start, ikp_end
289 
290  DO i_real_im = 1, 2
291 
292  i_block = 1
293 
294  CALL dbcsr_iterator_start(iter, matrix_v_kp(ik, i_real_im)%matrix)
295 
296  DO WHILE (dbcsr_iterator_blocks_left(iter))
297 
298  CALL dbcsr_iterator_next_block(iter, row, col, data_block)
299 
300  data_block(:, :) = blocks_v_kp(ik, i_real_im, i_block)%block(:, :)
301 
302  i_block = i_block + 1
303 
304  END DO
305 
306  CALL dbcsr_iterator_stop(iter)
307 
308  END DO
309 
310  END DO
311 
312  CALL timestop(handle)
313 
314  END SUBROUTINE
315 
316 ! **************************************************************************************************
317 !> \brief ...
318 !> \param matrix_v_L_tmp ...
319 !> \param blocks_v_L ...
320 !> \param vec_L ...
321 !> \param particle_set ...
322 !> \param qs_kind_set ...
323 !> \param atomic_kind_set ...
324 !> \param basis_type ...
325 !> \param cell ...
326 !> \param operator_type ...
327 ! **************************************************************************************************
328  SUBROUTINE compute_v_transl(matrix_v_L_tmp, blocks_v_L, vec_L, particle_set, &
329  qs_kind_set, atomic_kind_set, basis_type, cell, operator_type)
330 
331  TYPE(dbcsr_type), POINTER :: matrix_v_l_tmp
332  TYPE(two_d_util_type), ALLOCATABLE, DIMENSION(:) :: blocks_v_l
333  REAL(kind=dp), DIMENSION(3) :: vec_l
334  TYPE(particle_type), DIMENSION(:), POINTER :: particle_set
335  TYPE(qs_kind_type), DIMENSION(:), POINTER :: qs_kind_set
336  TYPE(atomic_kind_type), DIMENSION(:), POINTER :: atomic_kind_set
337  CHARACTER(LEN=*), INTENT(IN) :: basis_type
338  TYPE(cell_type), POINTER :: cell
339  INTEGER :: operator_type
340 
341  CHARACTER(LEN=*), PARAMETER :: routinen = 'compute_v_transl'
342 
343  INTEGER :: col, handle, i_block, kind_a, kind_b, row
344  INTEGER, ALLOCATABLE, DIMENSION(:) :: kind_of
345  REAL(dp), DIMENSION(3) :: ra, rab_l, rb
346  REAL(kind=dp), DIMENSION(:, :), POINTER :: data_block
347  REAL(kind=dp), DIMENSION(:, :, :), POINTER :: contr_a, contr_b
348  TYPE(dbcsr_iterator_type) :: iter
349  TYPE(gto_basis_set_type), POINTER :: basis_set_a, basis_set_b
350 
351  CALL timeset(routinen, handle)
352 
353  NULLIFY (basis_set_a, basis_set_b, data_block)
354 
355  CALL get_atomic_kind_set(atomic_kind_set, kind_of=kind_of)
356 
357  CALL dbcsr_set(matrix_v_l_tmp, 0.0_dp)
358 
359  i_block = 1
360 
361  CALL dbcsr_iterator_start(iter, matrix_v_l_tmp)
362 
363  DO WHILE (dbcsr_iterator_blocks_left(iter))
364 
365  CALL dbcsr_iterator_next_block(iter, row, col, data_block)
366 
367  kind_a = kind_of(row)
368  kind_b = kind_of(col)
369 
370  CALL get_qs_kind(qs_kind=qs_kind_set(kind_a), basis_set=basis_set_a, basis_type=basis_type)
371  CALL get_qs_kind(qs_kind=qs_kind_set(kind_b), basis_set=basis_set_b, basis_type=basis_type)
372 
373  ra(1:3) = pbc(particle_set(row)%r(1:3), cell)
374  rb(1:3) = pbc(particle_set(col)%r(1:3), cell)
375 
376  rab_l(1:3) = rb(1:3) - ra(1:3) + vec_l(1:3)
377 
378  CALL contraction_matrix_shg(basis_set_a, contr_a)
379  CALL contraction_matrix_shg(basis_set_b, contr_b)
380 
381  blocks_v_l(i_block)%block = 0.0_dp
382 
383  CALL int_operators_r12_ab_shg(operator_type, blocks_v_l(i_block)%block, rab=rab_l, &
384  fba=basis_set_a, fbb=basis_set_b, scona_shg=contr_a, sconb_shg=contr_b, &
385  calculate_forces=.false.)
386 
387  i_block = i_block + 1
388 
389  DEALLOCATE (contr_a, contr_b)
390 
391  END DO
392 
393  CALL dbcsr_iterator_stop(iter)
394 
395  DEALLOCATE (kind_of)
396 
397  CALL timestop(handle)
398 
399  END SUBROUTINE
400 
401 ! **************************************************************************************************
402 !> \brief ...
403 !> \param blocks_v_kp ...
404 ! **************************************************************************************************
405  SUBROUTINE deallocate_blocks_v_kp(blocks_v_kp)
406  TYPE(two_d_util_type), ALLOCATABLE, &
407  DIMENSION(:, :, :) :: blocks_v_kp
408 
409  CHARACTER(LEN=*), PARAMETER :: routinen = 'deallocate_blocks_v_kp'
410 
411  INTEGER :: handle, i_block, i_real_img, ik
412 
413  CALL timeset(routinen, handle)
414 
415  DO ik = lbound(blocks_v_kp, 1), ubound(blocks_v_kp, 1)
416  DO i_real_img = 1, SIZE(blocks_v_kp, 2)
417  DO i_block = 1, SIZE(blocks_v_kp, 3)
418  DEALLOCATE (blocks_v_kp(ik, i_real_img, i_block)%block)
419  END DO
420  END DO
421  END DO
422 
423  DEALLOCATE (blocks_v_kp)
424 
425  CALL timestop(handle)
426 
427  END SUBROUTINE
428 
429 ! **************************************************************************************************
430 !> \brief ...
431 !> \param blocks_v_L ...
432 ! **************************************************************************************************
433  SUBROUTINE deallocate_blocks_v_l(blocks_v_L)
434  TYPE(two_d_util_type), ALLOCATABLE, DIMENSION(:) :: blocks_v_l
435 
436  CHARACTER(LEN=*), PARAMETER :: routinen = 'deallocate_blocks_v_L'
437 
438  INTEGER :: handle, i_block
439 
440  CALL timeset(routinen, handle)
441 
442  DO i_block = 1, SIZE(blocks_v_l, 1)
443  DEALLOCATE (blocks_v_l(i_block)%block)
444  END DO
445 
446  DEALLOCATE (blocks_v_l)
447 
448  CALL timestop(handle)
449 
450  END SUBROUTINE
451 
452 ! **************************************************************************************************
453 !> \brief ...
454 !> \param blocks_v_L ...
455 !> \param matrix_v_L_tmp ...
456 ! **************************************************************************************************
457  SUBROUTINE allocate_blocks_v_l(blocks_v_L, matrix_v_L_tmp)
458  TYPE(two_d_util_type), ALLOCATABLE, DIMENSION(:) :: blocks_v_l
459  TYPE(dbcsr_type), POINTER :: matrix_v_l_tmp
460 
461  CHARACTER(LEN=*), PARAMETER :: routinen = 'allocate_blocks_v_L'
462 
463  INTEGER :: col, handle, i_block, nblocks, row
464  REAL(kind=dp), DIMENSION(:, :), POINTER :: data_block
465  TYPE(dbcsr_iterator_type) :: iter
466 
467  CALL timeset(routinen, handle)
468 
469  nblocks = 0
470 
471  CALL dbcsr_iterator_start(iter, matrix_v_l_tmp)
472 
473  DO WHILE (dbcsr_iterator_blocks_left(iter))
474 
475  CALL dbcsr_iterator_next_block(iter, row, col, data_block)
476 
477  nblocks = nblocks + 1
478 
479  END DO
480 
481  CALL dbcsr_iterator_stop(iter)
482 
483  ALLOCATE (blocks_v_l(nblocks))
484 
485  i_block = 1
486 
487  CALL dbcsr_iterator_start(iter, matrix_v_l_tmp)
488 
489  DO WHILE (dbcsr_iterator_blocks_left(iter))
490 
491  CALL dbcsr_iterator_next_block(iter, row, col, data_block)
492 
493  ALLOCATE (blocks_v_l(i_block)%block(SIZE(data_block, 1), SIZE(data_block, 2)))
494  blocks_v_l(i_block)%block = 0.0_dp
495 
496  i_block = i_block + 1
497 
498  END DO
499 
500  CALL dbcsr_iterator_stop(iter)
501 
502  CALL timestop(handle)
503 
504  END SUBROUTINE
505 
506 ! **************************************************************************************************
507 !> \brief ...
508 !> \param blocks_v_kp ...
509 !> \param matrix_v_kp ...
510 !> \param ikp_start ...
511 !> \param ikp_end ...
512 ! **************************************************************************************************
513  SUBROUTINE allocate_blocks_v_kp(blocks_v_kp, matrix_v_kp, ikp_start, ikp_end)
514  TYPE(two_d_util_type), ALLOCATABLE, &
515  DIMENSION(:, :, :) :: blocks_v_kp
516  TYPE(dbcsr_p_type), DIMENSION(:, :), POINTER :: matrix_v_kp
517  INTEGER :: ikp_start, ikp_end
518 
519  CHARACTER(LEN=*), PARAMETER :: routinen = 'allocate_blocks_v_kp'
520 
521  INTEGER :: col, handle, i_block, i_real_img, ik, &
522  nblocks, row
523  REAL(kind=dp), DIMENSION(:, :), POINTER :: data_block
524  TYPE(dbcsr_iterator_type) :: iter
525 
526  CALL timeset(routinen, handle)
527 
528  nblocks = 0
529 
530  CALL dbcsr_iterator_start(iter, matrix_v_kp(ikp_start, 1)%matrix)
531 
532  DO WHILE (dbcsr_iterator_blocks_left(iter))
533 
534  CALL dbcsr_iterator_next_block(iter, row, col, data_block)
535 
536  nblocks = nblocks + 1
537 
538  END DO
539 
540  CALL dbcsr_iterator_stop(iter)
541 
542  ALLOCATE (blocks_v_kp(ikp_start:ikp_end, SIZE(matrix_v_kp, 2), nblocks))
543 
544  DO ik = ikp_start, ikp_end
545 
546  DO i_real_img = 1, SIZE(matrix_v_kp, 2)
547 
548  i_block = 1
549 
550  CALL dbcsr_iterator_start(iter, matrix_v_kp(ik, i_real_img)%matrix)
551 
552  DO WHILE (dbcsr_iterator_blocks_left(iter))
553 
554  CALL dbcsr_iterator_next_block(iter, row, col, data_block)
555 
556  ALLOCATE (blocks_v_kp(ik, i_real_img, i_block)%block(SIZE(data_block, 1), &
557  SIZE(data_block, 2)))
558  blocks_v_kp(ik, i_real_img, i_block)%block = 0.0_dp
559 
560  i_block = i_block + 1
561 
562  END DO
563 
564  CALL dbcsr_iterator_stop(iter)
565 
566  END DO
567 
568  END DO
569 
570  CALL timestop(handle)
571 
572  END SUBROUTINE
573 
574 ! **************************************************************************************************
575 !> \brief ...
576 !> \param cell ...
577 !> \param kpoints ...
578 !> \param total_periodicity ...
579 ! **************************************************************************************************
580  SUBROUTINE check_periodicity(cell, kpoints, total_periodicity)
581  TYPE(cell_type), POINTER :: cell
582  TYPE(kpoint_type), POINTER :: kpoints
583  INTEGER :: total_periodicity
584 
585  CHARACTER(LEN=*), PARAMETER :: routinen = 'check_periodicity'
586 
587  INTEGER :: handle
588  INTEGER, DIMENSION(3) :: nkp_grid, periodic
589 
590  CALL timeset(routinen, handle)
591 
592  CALL get_cell(cell=cell, periodic=periodic)
593  CALL get_kpoint_info(kpoints, nkp_grid=nkp_grid)
594 
595  IF (periodic(1) == 0) THEN
596  cpassert(nkp_grid(1) == 1)
597  END IF
598  IF (periodic(2) == 0) THEN
599  cpassert(nkp_grid(2) == 1)
600  END IF
601  IF (periodic(3) == 0) THEN
602  cpassert(nkp_grid(3) == 1)
603  END IF
604 
605  total_periodicity = sum(periodic)
606 
607  CALL timestop(handle)
608 
609  END SUBROUTINE
610 
611 ! **************************************************************************************************
612 !> \brief ...
613 !> \param matrix_v_L_tmp ...
614 !> \param matrix_v_kp ...
615 !> \param ikp_start ...
616 ! **************************************************************************************************
617  SUBROUTINE allocate_tmp(matrix_v_L_tmp, matrix_v_kp, ikp_start)
618 
619  TYPE(dbcsr_type), POINTER :: matrix_v_l_tmp
620  TYPE(dbcsr_p_type), DIMENSION(:, :), POINTER :: matrix_v_kp
621  INTEGER :: ikp_start
622 
623  CHARACTER(LEN=*), PARAMETER :: routinen = 'allocate_tmp'
624 
625  INTEGER :: handle
626 
627  CALL timeset(routinen, handle)
628 
629  NULLIFY (matrix_v_l_tmp)
630  CALL dbcsr_init_p(matrix_v_l_tmp)
631  CALL dbcsr_create(matrix=matrix_v_l_tmp, &
632  template=matrix_v_kp(ikp_start, 1)%matrix, &
633  matrix_type=dbcsr_type_no_symmetry)
634  CALL dbcsr_reserve_all_blocks(matrix_v_l_tmp)
635  CALL dbcsr_set(matrix_v_l_tmp, 0.0_dp)
636 
637  CALL timestop(handle)
638 
639  END SUBROUTINE
640 
641 ! **************************************************************************************************
642 !> \brief ...
643 !> \param matrix_v_L_tmp ...
644 ! **************************************************************************************************
645  SUBROUTINE deallocate_tmp(matrix_v_L_tmp)
646 
647  TYPE(dbcsr_type), POINTER :: matrix_v_l_tmp
648 
649  CHARACTER(LEN=*), PARAMETER :: routinen = 'deallocate_tmp'
650 
651  INTEGER :: handle
652 
653  CALL timeset(routinen, handle)
654 
655  CALL dbcsr_release_p(matrix_v_l_tmp)
656 
657  CALL timestop(handle)
658 
659  END SUBROUTINE
660 
661 END MODULE kpoint_coulomb_2c
subroutine pbc(r, r_pbc, s, s_pbc, a, b, c, alpha, beta, gamma, debug, info, pbc0, h, hinv)
...
Definition: dumpdcd.F:1203
static GRID_HOST_DEVICE int modulo(int a, int m)
Equivalent of Fortran's MODULO, which always return a positive number. https://gcc....
Definition: grid_common.h:117
Define the atomic kind types and their sub types.
subroutine, public get_atomic_kind_set(atomic_kind_set, atom_of_kind, kind_of, natom_of_kind, maxatom, natom, nshell, fist_potential_present, shell_present, shell_adiabatic, shell_check_distance, damping_present)
Get attributes of an atomic kind set.
Handles all functions related to the CELL.
Definition: cell_types.F:15
subroutine, public get_cell(cell, alpha, beta, gamma, deth, orthorhombic, abc, periodic, h, h_inv, symmetry_id, tag)
Get informations about a simulation cell.
Definition: cell_types.F:195
Initialization for solid harmonic Gaussian (SHG) integral scheme. Scheme for calculation of contracte...
subroutine, public contraction_matrix_shg(basis, scon_shg)
contraction matrix for SHG integrals
Calculation of contracted, spherical Gaussian integrals using the solid harmonic Gaussian (SHG) integ...
subroutine, public int_operators_r12_ab_shg(r12_operator, vab, dvab, rab, fba, fbb, scona_shg, sconb_shg, omega, calculate_forces)
Calcululates the two-center integrals of the type (a|O(r12)|b) using the SHG scheme.
Defines the basic variable types.
Definition: kinds.F:23
integer, parameter, public dp
Definition: kinds.F:34
Routines to compute the Coulomb integral V_(alpha beta)(k) for a k-point k using lattice summation in...
subroutine, public build_2c_coulomb_matrix_kp(matrix_v_kp, kpoints, basis_type, cell, particle_set, qs_kind_set, atomic_kind_set, size_lattice_sum, operator_type, ikp_start, ikp_end)
...
Types and basic routines needed for a kpoint calculation.
Definition: kpoint_types.F:15
subroutine, public get_kpoint_info(kpoint, kp_scheme, nkp_grid, kp_shift, symmetry, verbose, full_grid, use_real_wfn, eps_geo, parallel_group_size, kp_range, nkp, xkp, wkp, para_env, blacs_env_all, para_env_kp, para_env_inter_kp, blacs_env, kp_env, kp_aux_env, mpools, iogrp, nkp_groups, kp_dist, cell_to_index, index_to_cell, sab_nl, sab_nl_nosym)
Retrieve information from a kpoint environment.
Definition: kpoint_types.F:333
Definition of mathematical constants and functions.
Definition: mathconstants.F:16
real(kind=dp), parameter, public twopi
Define the data structure for the particle information.
Define the quickstep kind type and their sub types.
Definition: qs_kind_types.F:23
subroutine, public get_qs_kind(qs_kind, basis_set, basis_type, ncgf, nsgf, all_potential, tnadd_potential, gth_potential, sgp_potential, upf_potential, se_parameter, dftb_parameter, xtb_parameter, dftb3_param, zeff, elec_conf, mao, lmax_dftb, alpha_core_charge, ccore_charge, core_charge, core_charge_radius, paw_proj_set, paw_atom, hard_radius, hard0_radius, max_rad_local, covalent_radius, vdw_radius, gpw_r3d_rs_type_forced, harmonics, max_iso_not0, max_s_harm, grid_atom, ngrid_ang, ngrid_rad, lmax_rho0, dft_plus_u_atom, l_of_dft_plus_u, n_of_dft_plus_u, u_minus_j, U_of_dft_plus_u, J_of_dft_plus_u, alpha_of_dft_plus_u, beta_of_dft_plus_u, J0_of_dft_plus_u, occupation_of_dft_plus_u, dispersion, bs_occupation, magnetization, no_optimize, addel, laddel, naddel, orbitals, max_scf, eps_scf, smear, u_ramping, u_minus_j_target, eps_u_ramping, init_u_ramping_each_scf, reltmat, ghost, floating, name, element_symbol, pao_basis_size, pao_potentials, pao_descriptors, nelec)
Get attributes of an atomic kind.