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
35 #include "./base/base_uses.f90"
41 CHARACTER(len=*),
PARAMETER,
PRIVATE :: moduleN =
'kpoint_coulomb_2c'
48 REAL(KIND=
dp),
ALLOCATABLE,
DIMENSION(:, :) :: block
68 atomic_kind_set, size_lattice_sum, operator_type, ikp_start, ikp_end)
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, &
80 CHARACTER(LEN=*),
PARAMETER :: routinen =
'build_2c_coulomb_matrix_kp'
82 INTEGER :: handle, total_periodicity
83 TYPE(dbcsr_type),
POINTER :: matrix_v_l_tmp
85 CALL timeset(routinen, handle)
87 CALL check_periodicity(cell, kpoints, total_periodicity)
89 CALL allocate_tmp(matrix_v_l_tmp, matrix_v_kp, ikp_start)
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)
95 CALL deallocate_tmp(matrix_v_l_tmp)
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)
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
131 CHARACTER(LEN=*),
PARAMETER :: routinen =
'lattice_sum'
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
143 CALL timeset(routinen, handle)
146 CALL get_cell(cell=cell, h=hmat, periodic=periodic)
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)
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
161 IF (periodic(1) == 0)
THEN
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
173 IF (periodic(2) == 0)
THEN
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
185 IF (periodic(3) == 0)
THEN
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)
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
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)
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
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
210 vec_s = [real(i_x,
dp), real(j_y,
dp), real(k_z,
dp)]
212 vec_l = matmul(hmat, vec_s)
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, &
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(:, :)
229 DO ik = ikp_start, ikp_end
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)))
235 DO i_block = 1,
SIZE(blocks_v_l)
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(:, :)
246 DO i_block = 1,
SIZE(blocks_v_l)
248 blocks_v_l_store(i_block)%block(:, :) = 0.0_dp
256 CALL set_blocks_to_matrix_v_kp(matrix_v_kp, blocks_v_kp, ikp_start, ikp_end)
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)
262 CALL timestop(handle)
273 SUBROUTINE set_blocks_to_matrix_v_kp(matrix_v_kp, blocks_v_kp, ikp_start, ikp_end)
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
280 CHARACTER(LEN=*),
PARAMETER :: routinen =
'set_blocks_to_matrix_v_kp'
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
286 CALL timeset(routinen, handle)
288 DO ik = ikp_start, ikp_end
294 CALL dbcsr_iterator_start(iter, matrix_v_kp(ik, i_real_im)%matrix)
296 DO WHILE (dbcsr_iterator_blocks_left(iter))
298 CALL dbcsr_iterator_next_block(iter, row, col, data_block)
300 data_block(:, :) = blocks_v_kp(ik, i_real_im, i_block)%block(:, :)
302 i_block = i_block + 1
306 CALL dbcsr_iterator_stop(iter)
312 CALL timestop(handle)
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)
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
341 CHARACTER(LEN=*),
PARAMETER :: routinen =
'compute_v_transl'
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
351 CALL timeset(routinen, handle)
353 NULLIFY (basis_set_a, basis_set_b, data_block)
357 CALL dbcsr_set(matrix_v_l_tmp, 0.0_dp)
361 CALL dbcsr_iterator_start(iter, matrix_v_l_tmp)
363 DO WHILE (dbcsr_iterator_blocks_left(iter))
365 CALL dbcsr_iterator_next_block(iter, row, col, data_block)
367 kind_a = kind_of(row)
368 kind_b = kind_of(col)
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)
373 ra(1:3) =
pbc(particle_set(row)%r(1:3), cell)
374 rb(1:3) =
pbc(particle_set(col)%r(1:3), cell)
376 rab_l(1:3) = rb(1:3) - ra(1:3) + vec_l(1:3)
381 blocks_v_l(i_block)%block = 0.0_dp
384 fba=basis_set_a, fbb=basis_set_b, scona_shg=contr_a, sconb_shg=contr_b, &
385 calculate_forces=.false.)
387 i_block = i_block + 1
389 DEALLOCATE (contr_a, contr_b)
393 CALL dbcsr_iterator_stop(iter)
397 CALL timestop(handle)
405 SUBROUTINE deallocate_blocks_v_kp(blocks_v_kp)
406 TYPE(two_d_util_type),
ALLOCATABLE, &
407 DIMENSION(:, :, :) :: blocks_v_kp
409 CHARACTER(LEN=*),
PARAMETER :: routinen =
'deallocate_blocks_v_kp'
411 INTEGER :: handle, i_block, i_real_img, ik
413 CALL timeset(routinen, handle)
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)
423 DEALLOCATE (blocks_v_kp)
425 CALL timestop(handle)
433 SUBROUTINE deallocate_blocks_v_l(blocks_v_L)
434 TYPE(two_d_util_type),
ALLOCATABLE,
DIMENSION(:) :: blocks_v_l
436 CHARACTER(LEN=*),
PARAMETER :: routinen =
'deallocate_blocks_v_L'
438 INTEGER :: handle, i_block
440 CALL timeset(routinen, handle)
442 DO i_block = 1,
SIZE(blocks_v_l, 1)
443 DEALLOCATE (blocks_v_l(i_block)%block)
446 DEALLOCATE (blocks_v_l)
448 CALL timestop(handle)
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
461 CHARACTER(LEN=*),
PARAMETER :: routinen =
'allocate_blocks_v_L'
463 INTEGER :: col, handle, i_block, nblocks, row
464 REAL(kind=
dp),
DIMENSION(:, :),
POINTER :: data_block
465 TYPE(dbcsr_iterator_type) :: iter
467 CALL timeset(routinen, handle)
471 CALL dbcsr_iterator_start(iter, matrix_v_l_tmp)
473 DO WHILE (dbcsr_iterator_blocks_left(iter))
475 CALL dbcsr_iterator_next_block(iter, row, col, data_block)
477 nblocks = nblocks + 1
481 CALL dbcsr_iterator_stop(iter)
483 ALLOCATE (blocks_v_l(nblocks))
487 CALL dbcsr_iterator_start(iter, matrix_v_l_tmp)
489 DO WHILE (dbcsr_iterator_blocks_left(iter))
491 CALL dbcsr_iterator_next_block(iter, row, col, data_block)
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
496 i_block = i_block + 1
500 CALL dbcsr_iterator_stop(iter)
502 CALL timestop(handle)
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
519 CHARACTER(LEN=*),
PARAMETER :: routinen =
'allocate_blocks_v_kp'
521 INTEGER :: col, handle, i_block, i_real_img, ik, &
523 REAL(kind=
dp),
DIMENSION(:, :),
POINTER :: data_block
524 TYPE(dbcsr_iterator_type) :: iter
526 CALL timeset(routinen, handle)
530 CALL dbcsr_iterator_start(iter, matrix_v_kp(ikp_start, 1)%matrix)
532 DO WHILE (dbcsr_iterator_blocks_left(iter))
534 CALL dbcsr_iterator_next_block(iter, row, col, data_block)
536 nblocks = nblocks + 1
540 CALL dbcsr_iterator_stop(iter)
542 ALLOCATE (blocks_v_kp(ikp_start:ikp_end,
SIZE(matrix_v_kp, 2), nblocks))
544 DO ik = ikp_start, ikp_end
546 DO i_real_img = 1,
SIZE(matrix_v_kp, 2)
550 CALL dbcsr_iterator_start(iter, matrix_v_kp(ik, i_real_img)%matrix)
552 DO WHILE (dbcsr_iterator_blocks_left(iter))
554 CALL dbcsr_iterator_next_block(iter, row, col, data_block)
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
560 i_block = i_block + 1
564 CALL dbcsr_iterator_stop(iter)
570 CALL timestop(handle)
580 SUBROUTINE check_periodicity(cell, kpoints, total_periodicity)
581 TYPE(cell_type),
POINTER :: cell
582 TYPE(kpoint_type),
POINTER :: kpoints
583 INTEGER :: total_periodicity
585 CHARACTER(LEN=*),
PARAMETER :: routinen =
'check_periodicity'
588 INTEGER,
DIMENSION(3) :: nkp_grid, periodic
590 CALL timeset(routinen, handle)
592 CALL get_cell(cell=cell, periodic=periodic)
595 IF (periodic(1) == 0)
THEN
596 cpassert(nkp_grid(1) == 1)
598 IF (periodic(2) == 0)
THEN
599 cpassert(nkp_grid(2) == 1)
601 IF (periodic(3) == 0)
THEN
602 cpassert(nkp_grid(3) == 1)
605 total_periodicity = sum(periodic)
607 CALL timestop(handle)
617 SUBROUTINE allocate_tmp(matrix_v_L_tmp, matrix_v_kp, ikp_start)
619 TYPE(dbcsr_type),
POINTER :: matrix_v_l_tmp
620 TYPE(dbcsr_p_type),
DIMENSION(:, :),
POINTER :: matrix_v_kp
623 CHARACTER(LEN=*),
PARAMETER :: routinen =
'allocate_tmp'
627 CALL timeset(routinen, handle)
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)
637 CALL timestop(handle)
645 SUBROUTINE deallocate_tmp(matrix_v_L_tmp)
647 TYPE(dbcsr_type),
POINTER :: matrix_v_l_tmp
649 CHARACTER(LEN=*),
PARAMETER :: routinen =
'deallocate_tmp'
653 CALL timeset(routinen, handle)
655 CALL dbcsr_release_p(matrix_v_l_tmp)
657 CALL timestop(handle)
subroutine pbc(r, r_pbc, s, s_pbc, a, b, c, alpha, beta, gamma, debug, info, pbc0, h, hinv)
...
static GRID_HOST_DEVICE int modulo(int a, int m)
Equivalent of Fortran's MODULO, which always return a positive number. https://gcc....
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.
subroutine, public get_cell(cell, alpha, beta, gamma, deth, orthorhombic, abc, periodic, h, h_inv, symmetry_id, tag)
Get informations about a simulation cell.
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.
integer, parameter, public dp
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.
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 of mathematical constants and functions.
real(kind=dp), parameter, public twopi
Define the data structure for the particle information.
Define the quickstep kind type and their sub types.
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.