(git:f6e87dc)
Loading...
Searching...
No Matches
kpoint_methods.F
Go to the documentation of this file.
1!--------------------------------------------------------------------------------------------------!
2! CP2K: A general program to perform molecular dynamics simulations !
3! Copyright 2000-2026 CP2K developers group <https://cp2k.org> !
4! !
5! SPDX-License-Identifier: GPL-2.0-or-later !
6!--------------------------------------------------------------------------------------------------!
7
8! **************************************************************************************************
9!> \brief Routines needed for kpoint calculation
10!> \par History
11!> 2014.07 created [JGH]
12!> 2014.11 unified k-point and gamma-point code [Ole Schuett]
13!> \author JGH
14! **************************************************************************************************
15MODULE kpoint_methods
16 USE atomic_kind_types, ONLY: get_atomic_kind
17 USE cell_types, ONLY: cell_type,&
18 real_to_scaled
19 USE cp_blacs_env, ONLY: cp_blacs_env_create,&
20 cp_blacs_env_type
21 USE cp_cfm_types, ONLY: cp_cfm_create,&
22 cp_cfm_get_info,&
23 cp_cfm_release,&
24 cp_cfm_to_fm,&
25 cp_cfm_type,&
26 cp_fm_to_cfm
27 USE cp_control_types, ONLY: hairy_probes_type
28 USE cp_dbcsr_api, ONLY: &
29 dbcsr_copy, dbcsr_create, dbcsr_deallocate_matrix, dbcsr_distribute, &
30 dbcsr_distribution_get, dbcsr_distribution_type, dbcsr_get_block_p, dbcsr_get_info, &
31 dbcsr_get_stored_coordinates, dbcsr_iterator_blocks_left, dbcsr_iterator_next_block, &
32 dbcsr_iterator_start, dbcsr_iterator_stop, dbcsr_iterator_type, dbcsr_p_type, &
33 dbcsr_replicate_all, dbcsr_set, dbcsr_type, dbcsr_type_antisymmetric, &
34 dbcsr_type_no_symmetry, dbcsr_type_symmetric
35 USE cp_dbcsr_cp2k_link, ONLY: cp_dbcsr_alloc_block_from_nbl
36 USE cp_dbcsr_operations, ONLY: copy_fm_to_dbcsr
37 USE cp_fm_basic_linalg, ONLY: cp_fm_column_scale
38 USE cp_fm_pool_types, ONLY: cp_fm_pool_p_type,&
39 fm_pool_create_fm,&
40 fm_pool_give_back_fm
41 USE cp_fm_struct, ONLY: cp_fm_struct_type
42 USE cp_fm_types, ONLY: &
43 copy_info_type, cp_fm_cleanup_copy_general, cp_fm_create, cp_fm_finish_copy_general, &
44 cp_fm_get_diag, cp_fm_get_info, cp_fm_get_submatrix, cp_fm_release, &
45 cp_fm_start_copy_general, cp_fm_to_fm, cp_fm_type
46 USE cp_log_handling, ONLY: cp_logger_get_default_io_unit
47 USE cryssym, ONLY: crys_sym_gen,&
48 csym_type,&
49 kpoint_gen,&
50 kpoint_gen_general,&
51 print_crys_symmetry,&
52 print_kp_symmetry,&
53 release_csym_type
54 USE hairy_probes, ONLY: probe_occupancy_kp
55 USE input_constants, ONLY: smear_fermi_dirac,&
56 smear_gaussian,&
57 smear_mp,&
58 smear_mv
59 USE input_cp2k_kpoints, ONLY: use_spglib_kpoint_backend,&
60 use_spglib_kpoint_symmetry
61 USE kinds, ONLY: dp
62 USE kpoint_types, ONLY: get_kpoint_info,&
63 kind_rotmat_type,&
64 kpoint_env_create,&
65 kpoint_env_p_type,&
66 kpoint_env_type,&
67 kpoint_sym_create,&
68 kpoint_sym_type,&
69 kpoint_type
70 USE mathconstants, ONLY: twopi
71 USE mathlib, ONLY: inv_3x3
72 USE memory_utilities, ONLY: reallocate
73 USE message_passing, ONLY: mp_cart_type,&
74 mp_para_env_type
75 USE parallel_gemm_api, ONLY: parallel_gemm
76 USE particle_types, ONLY: particle_type
77 USE qs_matrix_pools, ONLY: mpools_create,&
78 mpools_get,&
79 mpools_rebuild_fm_pools,&
80 qs_matrix_pools_type
81 USE qs_mo_types, ONLY: allocate_mo_set,&
82 get_mo_set,&
83 init_mo_set,&
84 mo_set_type,&
85 set_mo_set
86 USE qs_neighbor_list_types, ONLY: get_iterator_info,&
87 get_neighbor_list_set_p,&
88 neighbor_list_iterate,&
89 neighbor_list_iterator_create,&
90 neighbor_list_iterator_p_type,&
91 neighbor_list_iterator_release,&
92 neighbor_list_set_p_type
93 USE scf_control_types, ONLY: smear_type
94 USE smearing_utils, ONLY: smearkp,&
95 smearkp2
96 USE util, ONLY: get_limit
97#include "./base/base_uses.f90"
98
99 IMPLICIT NONE
100
101 PRIVATE
102
103 CHARACTER(len=*), PARAMETER, PRIVATE :: moduleN = 'kpoint_methods'
104
105 PUBLIC :: kpoint_initialize, kpoint_env_initialize, kpoint_initialize_mos, kpoint_initialize_mo_set
106 PUBLIC :: kpoint_init_cell_index, kpoint_set_mo_occupation
107 PUBLIC :: kpoint_density_matrices, kpoint_density_transform
108 PUBLIC :: rskp_transform, lowdin_kp_trans, lowdin_kp_mo_coeff
109
110! **************************************************************************************************
111
112CONTAINS
113
114! **************************************************************************************************
115!> \brief Generate the kpoints and initialize the kpoint environment
116!> \param kpoint The kpoint environment
117!> \param particle_set Particle types and coordinates
118!> \param cell Computational cell information
119! **************************************************************************************************
120 SUBROUTINE kpoint_initialize(kpoint, particle_set, cell)
121
122 TYPE(kpoint_type), POINTER :: kpoint
123 TYPE(particle_type), DIMENSION(:), POINTER :: particle_set
124 TYPE(cell_type), POINTER :: cell
125
126 CHARACTER(LEN=*), PARAMETER :: routinen = 'kpoint_initialize'
127
128 INTEGER :: handle, i, ic, ik, iounit, ir, ira, is, &
129 isign, j, natom, nkind, nr, ns
130 INTEGER, ALLOCATABLE, DIMENSION(:) :: atype
131 INTEGER, ALLOCATABLE, DIMENSION(:, :) :: agauge
132 INTEGER, DIMENSION(3, 3) :: frot, krot
133 LOGICAL :: spez
134 REAL(kind=dp) :: eps_kpoint, wsum
135 REAL(kind=dp), ALLOCATABLE, DIMENSION(:, :) :: coord, scoord
136 REAL(kind=dp), DIMENSION(3) :: diff, kgvec, srot
137 REAL(kind=dp), DIMENSION(3, 3) :: srotmat
138 REAL(kind=dp), DIMENSION(:), POINTER :: wkp_full
139 REAL(kind=dp), DIMENSION(:, :), POINTER :: xkp_full
140 TYPE(csym_type) :: crys_sym
141 TYPE(kpoint_sym_type), POINTER :: kpsym
142
143 CALL timeset(routinen, handle)
144
145 cpassert(ASSOCIATED(kpoint))
146
147 SELECT CASE (kpoint%kp_scheme)
148 CASE ("NONE")
149 ! do nothing
150 CASE ("GAMMA")
151 kpoint%nkp = 1
152 ALLOCATE (kpoint%xkp(3, 1), kpoint%wkp(1))
153 kpoint%xkp(1:3, 1) = 0.0_dp
154 kpoint%wkp(1) = 1.0_dp
155 ALLOCATE (kpoint%kp_sym(1))
156 NULLIFY (kpoint%kp_sym(1)%kpoint_sym)
157 CALL kpoint_sym_create(kpoint%kp_sym(1)%kpoint_sym)
158 CASE ("MONKHORST-PACK", "MACDONALD")
159
160 IF (.NOT. kpoint%symmetry) THEN
161 ! we set up a random molecule to avoid any possible symmetry
162 natom = 10
163 ALLOCATE (coord(3, natom), scoord(3, natom), atype(natom))
164 DO i = 1, natom
165 atype(i) = i
166 coord(1, i) = sin(i*0.12345_dp)
167 coord(2, i) = cos(i*0.23456_dp)
168 coord(3, i) = sin(i*0.34567_dp)
169 CALL real_to_scaled(scoord(1:3, i), coord(1:3, i), cell)
170 END DO
171 ELSE
172 natom = SIZE(particle_set)
173 ALLOCATE (scoord(3, natom), atype(natom))
174 DO i = 1, natom
175 CALL get_atomic_kind(atomic_kind=particle_set(i)%atomic_kind, kind_number=atype(i))
176 CALL real_to_scaled(scoord(1:3, i), particle_set(i)%r(1:3), cell)
177 END DO
178 END IF
179 IF (kpoint%verbose) THEN
180 iounit = cp_logger_get_default_io_unit()
181 ELSE
182 iounit = -1
183 END IF
184 ! kind type list
185 ALLOCATE (kpoint%atype(natom))
186 kpoint%atype = atype
187 ! Match the periodic gauge used by the k-space matrices.
188 ALLOCATE (agauge(3, natom))
189 DO i = 1, natom
190 agauge(1:3, i) = -floor(scoord(1:3, i) + 0.5_dp - kpoint%eps_geo)
191 END DO
192
193 CALL crys_sym_gen(crys_sym, scoord, atype, cell%hmat, delta=kpoint%eps_geo, iounit=iounit, &
194 use_spglib=kpoint%symmetry)
195 CALL kpoint_gen(crys_sym, kpoint%nkp_grid, symm=kpoint%symmetry, shift=kpoint%kp_shift, &
196 full_grid=kpoint%full_grid, gamma_centered=kpoint%gamma_centered, &
197 inversion_symmetry_only=kpoint%inversion_symmetry_only, &
198 use_spglib_reduction= &
199 kpoint%symmetry_reduction_method == use_spglib_kpoint_symmetry, &
200 use_spglib_backend=kpoint%symmetry_backend == use_spglib_kpoint_backend)
201 kpoint%nkp = crys_sym%nkpoint
202 ALLOCATE (kpoint%xkp(3, kpoint%nkp), kpoint%wkp(kpoint%nkp))
203 wsum = sum(crys_sym%wkpoint)
204 DO ik = 1, kpoint%nkp
205 kpoint%xkp(1:3, ik) = crys_sym%xkpoint(1:3, ik)
206 kpoint%wkp(ik) = crys_sym%wkpoint(ik)/wsum
207 END DO
208
209 eps_kpoint = max(1.e-12_dp, 10.0_dp*kpoint%eps_geo)
210 ! print output
211 IF (kpoint%symmetry) CALL print_crys_symmetry(crys_sym)
212 IF (kpoint%symmetry) CALL print_kp_symmetry(crys_sym)
213
214 ! transfer symmetry information
215 ALLOCATE (kpoint%kp_sym(kpoint%nkp))
216 DO ik = 1, kpoint%nkp
217 NULLIFY (kpoint%kp_sym(ik)%kpoint_sym)
218 CALL kpoint_sym_create(kpoint%kp_sym(ik)%kpoint_sym)
219 kpsym => kpoint%kp_sym(ik)%kpoint_sym
220 IF (crys_sym%nrtot > 0 .AND. .NOT. crys_sym%fullgrid .AND. &
221 crys_sym%istriz == 1 .AND. .NOT. crys_sym%inversion_only) THEN
222 ! set up the symmetrization information
223 kpsym%nwght = nint(crys_sym%wkpoint(ik))
224 ns = kpsym%nwght
225 !
226 IF (ns > 1) THEN
227 DO is = 1, SIZE(crys_sym%kplink, 2)
228 IF (crys_sym%kplink(2, is) == ik) THEN
229 DO ic = 1, crys_sym%nrtot
230 srotmat = matmul(cell%h_inv, matmul(crys_sym%rt(1:3, 1:3, ic), cell%hmat))
231 frot(1:3, 1:3) = nint(srotmat(1:3, 1:3))
232 krot(1:3, 1:3) = nint(transpose(inv_3x3(real(frot(1:3, 1:3), kind=dp))))
233 DO isign = 1, 2
234 ir = merge(crys_sym%ibrot(ic), -crys_sym%ibrot(ic), isign == 1)
235 IF (ir == crys_sym%kpop(is)) cycle
236 kgvec(1:3) = crys_sym%kpmesh(1:3, is) - &
237 matmul(real(merge(krot(1:3, 1:3), -krot(1:3, 1:3), &
238 isign == 1), kind=dp), &
239 kpoint%xkp(1:3, ik))
240 diff(1:3) = kgvec(1:3) - anint(kgvec(1:3))
241 IF (all(abs(diff(1:3)) < eps_kpoint)) ns = ns + 1
242 END DO
243 END DO
244 END IF
245 END DO
246 kpsym%apply_symmetry = .true.
247 natom = SIZE(particle_set)
248 ALLOCATE (kpsym%rot(3, 3, ns))
249 ALLOCATE (kpsym%xkp(3, ns))
250 ALLOCATE (kpsym%rotp(ns))
251 ALLOCATE (kpsym%f0(natom, ns))
252 ALLOCATE (kpsym%fcell(3, natom, ns))
253 ALLOCATE (kpsym%kgphase(natom, ns))
254 nr = 0
255 DO is = 1, SIZE(crys_sym%kplink, 2)
256 IF (crys_sym%kplink(2, is) == ik) THEN
257 nr = nr + 1
258 ir = crys_sym%kpop(is)
259 ira = abs(ir)
260 DO ic = 1, crys_sym%nrtot
261 IF (crys_sym%ibrot(ic) == ira) THEN
262 kpsym%rotp(nr) = ir
263 kpsym%rot(1:3, 1:3, nr) = crys_sym%rt(1:3, 1:3, ic)
264 srotmat = matmul(cell%h_inv, matmul(crys_sym%rt(1:3, 1:3, ic), cell%hmat))
265 frot(1:3, 1:3) = nint(srotmat(1:3, 1:3))
266 kpsym%xkp(1:3, nr) = crys_sym%kpmesh(1:3, is)
267 krot(1:3, 1:3) = nint(transpose(inv_3x3(real(frot(1:3, 1:3), kind=dp))))
268 IF (ir < 0) krot(1:3, 1:3) = -krot(1:3, 1:3)
269 kgvec(1:3) = kpsym%xkp(1:3, nr) - &
270 matmul(real(krot(1:3, 1:3), kind=dp), &
271 kpoint%xkp(1:3, ik))
272 kgvec(1:3) = anint(kgvec(1:3))
273 kpsym%f0(1:natom, nr) = crys_sym%f0(1:natom, ic)
274 DO j = 1, natom
275 srot(1:3) = matmul(srotmat, scoord(1:3, j)) + crys_sym%vt(1:3, ic)
276 kpsym%fcell(1:3, j, nr) = &
277 nint(srot(1:3) - scoord(1:3, kpsym%f0(j, nr))) + &
278 matmul(frot(1:3, 1:3), agauge(1:3, j)) - &
279 agauge(1:3, kpsym%f0(j, nr))
280 kpsym%kgphase(j, nr) = dot_product(kgvec(1:3), &
281 scoord(1:3, j) + &
282 REAL(agauge(1:3, j), kind=dp))
283 END DO
284 EXIT
285 END IF
286 END DO
287 cpassert(ic <= crys_sym%nrtot)
288 END IF
289 END DO
290 DO is = 1, SIZE(crys_sym%kplink, 2)
291 IF (crys_sym%kplink(2, is) == ik) THEN
292 DO ic = 1, crys_sym%nrtot
293 srotmat = matmul(cell%h_inv, matmul(crys_sym%rt(1:3, 1:3, ic), cell%hmat))
294 frot(1:3, 1:3) = nint(srotmat(1:3, 1:3))
295 krot(1:3, 1:3) = nint(transpose(inv_3x3(real(frot(1:3, 1:3), kind=dp))))
296 DO isign = 1, 2
297 ir = merge(crys_sym%ibrot(ic), -crys_sym%ibrot(ic), isign == 1)
298 IF (ir == crys_sym%kpop(is)) cycle
299 kgvec(1:3) = crys_sym%kpmesh(1:3, is) - &
300 matmul(real(merge(krot(1:3, 1:3), -krot(1:3, 1:3), &
301 isign == 1), kind=dp), &
302 kpoint%xkp(1:3, ik))
303 diff(1:3) = kgvec(1:3) - anint(kgvec(1:3))
304 IF (all(abs(diff(1:3)) < eps_kpoint)) THEN
305 nr = nr + 1
306 kpsym%rotp(nr) = ir
307 kpsym%rot(1:3, 1:3, nr) = crys_sym%rt(1:3, 1:3, ic)
308 kpsym%xkp(1:3, nr) = crys_sym%kpmesh(1:3, is)
309 kgvec(1:3) = anint(kgvec(1:3))
310 kpsym%f0(1:natom, nr) = crys_sym%f0(1:natom, ic)
311 DO j = 1, natom
312 srot(1:3) = matmul(srotmat, scoord(1:3, j)) + crys_sym%vt(1:3, ic)
313 kpsym%fcell(1:3, j, nr) = &
314 nint(srot(1:3) - scoord(1:3, kpsym%f0(j, nr))) + &
315 matmul(frot(1:3, 1:3), agauge(1:3, j)) - &
316 agauge(1:3, kpsym%f0(j, nr))
317 kpsym%kgphase(j, nr) = dot_product(kgvec(1:3), &
318 scoord(1:3, j) + &
319 REAL(agauge(1:3, j), kind=dp))
320 END DO
321 END IF
322 END DO
323 END DO
324 END IF
325 END DO
326 kpsym%nwred = nr
327 END IF
328 END IF
329 END DO
330 IF (kpoint%symmetry) THEN
331 nkind = maxval(atype)
332 ns = crys_sym%nrtot
333 ALLOCATE (kpoint%kind_rotmat(ns, nkind))
334 DO i = 1, ns
335 DO j = 1, nkind
336 NULLIFY (kpoint%kind_rotmat(i, j)%rmat)
337 END DO
338 END DO
339 ALLOCATE (kpoint%ibrot(ns))
340 kpoint%ibrot(1:ns) = crys_sym%ibrot(1:ns)
341 END IF
342
343 CALL release_csym_type(crys_sym)
344 DEALLOCATE (scoord, atype)
345 DEALLOCATE (agauge)
346
347 CASE ("GENERAL")
348 NULLIFY (xkp_full, wkp_full)
349 IF (ASSOCIATED(kpoint%xkp_input)) THEN
350 xkp_full => kpoint%xkp_input
351 wkp_full => kpoint%wkp_input
352 ELSE
353 xkp_full => kpoint%xkp
354 wkp_full => kpoint%wkp
355 END IF
356 cpassert(ASSOCIATED(xkp_full))
357 cpassert(ASSOCIATED(wkp_full))
358 IF (.NOT. ASSOCIATED(kpoint%xkp_input)) THEN
359 ALLOCATE (kpoint%xkp_input(3, SIZE(wkp_full)), kpoint%wkp_input(SIZE(wkp_full)))
360 kpoint%xkp_input(1:3, 1:SIZE(wkp_full)) = xkp_full(1:3, 1:SIZE(wkp_full))
361 kpoint%wkp_input(1:SIZE(wkp_full)) = wkp_full(1:SIZE(wkp_full))
362 xkp_full => kpoint%xkp_input
363 wkp_full => kpoint%wkp_input
364 END IF
365 IF (.NOT. kpoint%symmetry) THEN
366 IF (.NOT. ASSOCIATED(kpoint%xkp)) THEN
367 kpoint%nkp = SIZE(wkp_full)
368 ALLOCATE (kpoint%xkp(3, kpoint%nkp), kpoint%wkp(kpoint%nkp))
369 kpoint%xkp(1:3, 1:kpoint%nkp) = xkp_full(1:3, 1:kpoint%nkp)
370 kpoint%wkp(1:kpoint%nkp) = wkp_full(1:kpoint%nkp)
371 END IF
372 ! default: no symmetry settings
373 ALLOCATE (kpoint%kp_sym(kpoint%nkp))
374 DO i = 1, kpoint%nkp
375 NULLIFY (kpoint%kp_sym(i)%kpoint_sym)
376 CALL kpoint_sym_create(kpoint%kp_sym(i)%kpoint_sym)
377 END DO
378 ELSE
379 IF (kpoint%verbose) THEN
380 iounit = cp_logger_get_default_io_unit()
381 ELSE
382 iounit = -1
383 END IF
384 natom = SIZE(particle_set)
385 ALLOCATE (scoord(3, natom), atype(natom))
386 DO i = 1, natom
387 CALL get_atomic_kind(atomic_kind=particle_set(i)%atomic_kind, kind_number=atype(i))
388 CALL real_to_scaled(scoord(1:3, i), particle_set(i)%r(1:3), cell)
389 END DO
390 ALLOCATE (kpoint%atype(natom))
391 kpoint%atype = atype
392 ALLOCATE (agauge(3, natom))
393 DO i = 1, natom
394 agauge(1:3, i) = -floor(scoord(1:3, i) + 0.5_dp - kpoint%eps_geo)
395 END DO
396
397 CALL crys_sym_gen(crys_sym, scoord, atype, cell%hmat, delta=kpoint%eps_geo, iounit=iounit, &
398 use_spglib=(kpoint%symmetry_backend == use_spglib_kpoint_backend .OR. &
399 kpoint%symmetry_reduction_method == use_spglib_kpoint_symmetry))
400 CALL kpoint_gen_general(crys_sym, xkp_full, wkp_full, symm=kpoint%symmetry, &
401 full_grid=kpoint%full_grid, &
402 inversion_symmetry_only=kpoint%inversion_symmetry_only, &
403 use_spglib_reduction= &
404 kpoint%symmetry_reduction_method == use_spglib_kpoint_symmetry, &
405 use_spglib_backend=kpoint%symmetry_backend == use_spglib_kpoint_backend)
406 IF (ASSOCIATED(kpoint%xkp)) THEN
407 DEALLOCATE (kpoint%xkp)
408 NULLIFY (kpoint%xkp)
409 END IF
410 IF (ASSOCIATED(kpoint%wkp)) THEN
411 DEALLOCATE (kpoint%wkp)
412 NULLIFY (kpoint%wkp)
413 END IF
414 kpoint%nkp = crys_sym%nkpoint
415 ALLOCATE (kpoint%xkp(3, kpoint%nkp), kpoint%wkp(kpoint%nkp))
416 wsum = sum(crys_sym%wkpoint)
417 DO ik = 1, kpoint%nkp
418 kpoint%xkp(1:3, ik) = crys_sym%xkpoint(1:3, ik)
419 kpoint%wkp(ik) = crys_sym%wkpoint(ik)/wsum
420 END DO
421
422 eps_kpoint = max(1.e-12_dp, 10.0_dp*kpoint%eps_geo)
423 CALL print_crys_symmetry(crys_sym)
424 CALL print_kp_symmetry(crys_sym)
425
426 ALLOCATE (kpoint%kp_sym(kpoint%nkp))
427 DO ik = 1, kpoint%nkp
428 NULLIFY (kpoint%kp_sym(ik)%kpoint_sym)
429 CALL kpoint_sym_create(kpoint%kp_sym(ik)%kpoint_sym)
430 kpsym => kpoint%kp_sym(ik)%kpoint_sym
431 IF (crys_sym%nrtot > 0 .AND. .NOT. crys_sym%fullgrid .AND. &
432 crys_sym%istriz == 1 .AND. .NOT. crys_sym%inversion_only) THEN
433 kpsym%nwght = nint(crys_sym%wkpoint(ik))
434 ns = kpsym%nwght
435 IF (ns > 1) THEN
436 DO is = 1, SIZE(crys_sym%kplink, 2)
437 IF (crys_sym%kplink(2, is) == ik) THEN
438 DO ic = 1, crys_sym%nrtot
439 srotmat = matmul(cell%h_inv, matmul(crys_sym%rt(1:3, 1:3, ic), cell%hmat))
440 frot(1:3, 1:3) = nint(srotmat(1:3, 1:3))
441 krot(1:3, 1:3) = nint(transpose(inv_3x3(real(frot(1:3, 1:3), kind=dp))))
442 DO isign = 1, 2
443 ir = merge(crys_sym%ibrot(ic), -crys_sym%ibrot(ic), isign == 1)
444 IF (ir == crys_sym%kpop(is)) cycle
445 kgvec(1:3) = crys_sym%kpmesh(1:3, is) - &
446 matmul(real(merge(krot(1:3, 1:3), -krot(1:3, 1:3), &
447 isign == 1), kind=dp), &
448 kpoint%xkp(1:3, ik))
449 diff(1:3) = kgvec(1:3) - anint(kgvec(1:3))
450 IF (all(abs(diff(1:3)) < eps_kpoint)) ns = ns + 1
451 END DO
452 END DO
453 END IF
454 END DO
455 kpsym%apply_symmetry = .true.
456 ALLOCATE (kpsym%rot(3, 3, ns))
457 ALLOCATE (kpsym%xkp(3, ns))
458 ALLOCATE (kpsym%rotp(ns))
459 ALLOCATE (kpsym%f0(natom, ns))
460 ALLOCATE (kpsym%fcell(3, natom, ns))
461 ALLOCATE (kpsym%kgphase(natom, ns))
462 nr = 0
463 DO is = 1, SIZE(crys_sym%kplink, 2)
464 IF (crys_sym%kplink(2, is) == ik) THEN
465 nr = nr + 1
466 ir = crys_sym%kpop(is)
467 ira = abs(ir)
468 DO ic = 1, crys_sym%nrtot
469 IF (crys_sym%ibrot(ic) == ira) THEN
470 kpsym%rotp(nr) = ir
471 kpsym%rot(1:3, 1:3, nr) = crys_sym%rt(1:3, 1:3, ic)
472 srotmat = matmul(cell%h_inv, matmul(crys_sym%rt(1:3, 1:3, ic), cell%hmat))
473 frot(1:3, 1:3) = nint(srotmat(1:3, 1:3))
474 kpsym%xkp(1:3, nr) = crys_sym%kpmesh(1:3, is)
475 krot(1:3, 1:3) = nint(transpose(inv_3x3(real(frot(1:3, 1:3), kind=dp))))
476 IF (ir < 0) krot(1:3, 1:3) = -krot(1:3, 1:3)
477 kgvec(1:3) = kpsym%xkp(1:3, nr) - &
478 matmul(real(krot(1:3, 1:3), kind=dp), &
479 kpoint%xkp(1:3, ik))
480 kgvec(1:3) = anint(kgvec(1:3))
481 kpsym%f0(1:natom, nr) = crys_sym%f0(1:natom, ic)
482 DO j = 1, natom
483 srot(1:3) = matmul(srotmat, scoord(1:3, j)) + crys_sym%vt(1:3, ic)
484 kpsym%fcell(1:3, j, nr) = &
485 nint(srot(1:3) - scoord(1:3, kpsym%f0(j, nr))) + &
486 matmul(frot(1:3, 1:3), agauge(1:3, j)) - &
487 agauge(1:3, kpsym%f0(j, nr))
488 kpsym%kgphase(j, nr) = dot_product(kgvec(1:3), &
489 scoord(1:3, j) + &
490 REAL(agauge(1:3, j), kind=dp))
491 END DO
492 EXIT
493 END IF
494 END DO
495 cpassert(ic <= crys_sym%nrtot)
496 END IF
497 END DO
498 DO is = 1, SIZE(crys_sym%kplink, 2)
499 IF (crys_sym%kplink(2, is) == ik) THEN
500 DO ic = 1, crys_sym%nrtot
501 srotmat = matmul(cell%h_inv, matmul(crys_sym%rt(1:3, 1:3, ic), cell%hmat))
502 frot(1:3, 1:3) = nint(srotmat(1:3, 1:3))
503 krot(1:3, 1:3) = nint(transpose(inv_3x3(real(frot(1:3, 1:3), kind=dp))))
504 DO isign = 1, 2
505 ir = merge(crys_sym%ibrot(ic), -crys_sym%ibrot(ic), isign == 1)
506 IF (ir == crys_sym%kpop(is)) cycle
507 kgvec(1:3) = crys_sym%kpmesh(1:3, is) - &
508 matmul(real(merge(krot(1:3, 1:3), -krot(1:3, 1:3), &
509 isign == 1), kind=dp), &
510 kpoint%xkp(1:3, ik))
511 diff(1:3) = kgvec(1:3) - anint(kgvec(1:3))
512 IF (all(abs(diff(1:3)) < eps_kpoint)) THEN
513 nr = nr + 1
514 kpsym%rotp(nr) = ir
515 kpsym%rot(1:3, 1:3, nr) = crys_sym%rt(1:3, 1:3, ic)
516 kpsym%xkp(1:3, nr) = crys_sym%kpmesh(1:3, is)
517 kgvec(1:3) = anint(kgvec(1:3))
518 kpsym%f0(1:natom, nr) = crys_sym%f0(1:natom, ic)
519 DO j = 1, natom
520 srot(1:3) = matmul(srotmat, scoord(1:3, j)) + crys_sym%vt(1:3, ic)
521 kpsym%fcell(1:3, j, nr) = &
522 nint(srot(1:3) - scoord(1:3, kpsym%f0(j, nr))) + &
523 matmul(frot(1:3, 1:3), agauge(1:3, j)) - &
524 agauge(1:3, kpsym%f0(j, nr))
525 kpsym%kgphase(j, nr) = dot_product(kgvec(1:3), &
526 scoord(1:3, j) + &
527 REAL(agauge(1:3, j), kind=dp))
528 END DO
529 END IF
530 END DO
531 END DO
532 END IF
533 END DO
534 kpsym%nwred = nr
535 END IF
536 END IF
537 END DO
538 nkind = maxval(atype)
539 ns = crys_sym%nrtot
540 ALLOCATE (kpoint%kind_rotmat(ns, nkind))
541 DO i = 1, ns
542 DO j = 1, nkind
543 NULLIFY (kpoint%kind_rotmat(i, j)%rmat)
544 END DO
545 END DO
546 ALLOCATE (kpoint%ibrot(ns))
547 kpoint%ibrot(1:ns) = crys_sym%ibrot(1:ns)
548
549 CALL release_csym_type(crys_sym)
550 DEALLOCATE (scoord, atype)
551 DEALLOCATE (agauge)
552 END IF
553 CASE DEFAULT
554 cpabort("Option invalid or unavailable for kpoint%kp_scheme")
555 END SELECT
556
557 ! check for consistency of options
558 SELECT CASE (kpoint%kp_scheme)
559 CASE ("NONE")
560 ! don't use k-point code
561 CASE ("GAMMA")
562 cpassert(kpoint%nkp == 1)
563 cpassert(sum(abs(kpoint%xkp)) <= 1.e-12_dp)
564 cpassert(kpoint%wkp(1) == 1.0_dp)
565 cpassert(.NOT. kpoint%symmetry)
566 CASE ("GENERAL")
567 cpassert(kpoint%nkp >= 1)
568 CASE ("MONKHORST-PACK", "MACDONALD")
569 cpassert(kpoint%nkp >= 1)
570 END SELECT
571 IF (kpoint%use_real_wfn) THEN
572 ! what about inversion symmetry?
573 ikloop: DO ik = 1, kpoint%nkp
574 DO i = 1, 3
575 spez = (kpoint%xkp(i, ik) == 0.0_dp .OR. kpoint%xkp(i, ik) == 0.5_dp)
576 IF (.NOT. spez) EXIT ikloop
577 END DO
578 END DO ikloop
579 IF (.NOT. spez) THEN
580 ! Warning: real wfn might be wrong for this system
581 CALL cp_warn(__location__, &
582 "A calculation using real wavefunctions is requested. "// &
583 "We could not determine if the symmetry of the system allows real wavefunctions. ")
584 END IF
585 END IF
586
587 CALL timestop(handle)
588
589 END SUBROUTINE kpoint_initialize
590
591! **************************************************************************************************
592!> \brief Initialize the kpoint environment
593!> \param kpoint Kpoint environment
594!> \param para_env ...
595!> \param blacs_env ...
596!> \param with_aux_fit ...
597! **************************************************************************************************
598 SUBROUTINE kpoint_env_initialize(kpoint, para_env, blacs_env, with_aux_fit)
599
600 TYPE(kpoint_type), INTENT(INOUT) :: kpoint
601 TYPE(mp_para_env_type), INTENT(IN), TARGET :: para_env
602 TYPE(cp_blacs_env_type), INTENT(IN), TARGET :: blacs_env
603 LOGICAL, INTENT(IN), OPTIONAL :: with_aux_fit
604
605 CHARACTER(LEN=*), PARAMETER :: routinen = 'kpoint_env_initialize'
606
607 INTEGER :: handle, igr, ik, ikk, ngr, niogrp, nkp, &
608 nkp_grp, nkp_loc, npe, unit_nr
609 INTEGER, DIMENSION(2) :: dims, pos
610 LOGICAL :: aux_fit
611 TYPE(kpoint_env_p_type), DIMENSION(:), POINTER :: kp_aux_env, kp_env
612 TYPE(kpoint_env_type), POINTER :: kp
613 TYPE(mp_cart_type) :: comm_cart
614 TYPE(mp_para_env_type), POINTER :: para_env_inter_kp, para_env_kp
615
616 CALL timeset(routinen, handle)
617
618 IF (PRESENT(with_aux_fit)) THEN
619 aux_fit = with_aux_fit
620 ELSE
621 aux_fit = .false.
622 END IF
623
624 kpoint%para_env => para_env
625 CALL kpoint%para_env%retain()
626 kpoint%blacs_env_all => blacs_env
627 CALL kpoint%blacs_env_all%retain()
628
629 cpassert(.NOT. ASSOCIATED(kpoint%kp_env))
630 IF (aux_fit) THEN
631 cpassert(.NOT. ASSOCIATED(kpoint%kp_aux_env))
632 END IF
633
634 NULLIFY (kp_env, kp_aux_env)
635 nkp = kpoint%nkp
636 npe = para_env%num_pe
637 IF (npe == 1) THEN
638 ! only one process available -> owns all kpoints
639 ALLOCATE (kp_env(nkp))
640 DO ik = 1, nkp
641 NULLIFY (kp_env(ik)%kpoint_env)
642 CALL kpoint_env_create(kp_env(ik)%kpoint_env)
643 kp => kp_env(ik)%kpoint_env
644 kp%nkpoint = ik
645 kp%wkp = kpoint%wkp(ik)
646 kp%xkp(1:3) = kpoint%xkp(1:3, ik)
647 kp%is_local = .true.
648 END DO
649 kpoint%kp_env => kp_env
650
651 IF (aux_fit) THEN
652 ALLOCATE (kp_aux_env(nkp))
653 DO ik = 1, nkp
654 NULLIFY (kp_aux_env(ik)%kpoint_env)
655 CALL kpoint_env_create(kp_aux_env(ik)%kpoint_env)
656 kp => kp_aux_env(ik)%kpoint_env
657 kp%nkpoint = ik
658 kp%wkp = kpoint%wkp(ik)
659 kp%xkp(1:3) = kpoint%xkp(1:3, ik)
660 kp%is_local = .true.
661 END DO
662
663 kpoint%kp_aux_env => kp_aux_env
664 END IF
665
666 ALLOCATE (kpoint%kp_dist(2, 1))
667 kpoint%kp_dist(1, 1) = 1
668 kpoint%kp_dist(2, 1) = nkp
669 kpoint%kp_range(1) = 1
670 kpoint%kp_range(2) = nkp
671
672 ! parallel environments
673 kpoint%para_env_kp => para_env
674 CALL kpoint%para_env_kp%retain()
675 kpoint%para_env_inter_kp => para_env
676 CALL kpoint%para_env_inter_kp%retain()
677 kpoint%iogrp = .true.
678 kpoint%nkp_groups = 1
679 ELSE
680 IF (kpoint%parallel_group_size == -1) THEN
681 ! maximum parallelization over kpoints
682 ! making sure that the group size divides the npe and the nkp_grp the nkp
683 ! in the worst case, there will be no parallelism over kpoints.
684 DO igr = npe, 1, -1
685 IF (mod(npe, igr) /= 0) cycle
686 nkp_grp = npe/igr
687 IF (mod(nkp, nkp_grp) /= 0) cycle
688 ngr = igr
689 END DO
690 ELSE IF (kpoint%parallel_group_size == 0) THEN
691 ! no parallelization over kpoints
692 ngr = npe
693 ELSE IF (kpoint%parallel_group_size > 0) THEN
694 ngr = min(kpoint%parallel_group_size, npe)
695 ELSE
696 cpabort("kpoint%parallel_group_size cannot be smaller than -1")
697 END IF
698 nkp_grp = npe/ngr
699 ! processor dimensions
700 dims(1) = ngr
701 dims(2) = nkp_grp
702 cpassert(mod(nkp, nkp_grp) == 0)
703 nkp_loc = nkp/nkp_grp
704
705 IF ((dims(1)*dims(2) /= npe)) THEN
706 cpabort("Number of processors is not divisible by the kpoint group size.")
707 END IF
708
709 ! Create the subgroups, one for each k-point group and one interconnecting group
710 CALL comm_cart%create(comm_old=para_env, ndims=2, dims=dims)
711 pos = comm_cart%mepos_cart
712 ALLOCATE (para_env_kp)
713 CALL para_env_kp%from_split(comm_cart, pos(2))
714 ALLOCATE (para_env_inter_kp)
715 CALL para_env_inter_kp%from_split(comm_cart, pos(1))
716 CALL comm_cart%free()
717
718 niogrp = 0
719 IF (para_env%is_source()) niogrp = 1
720 CALL para_env_kp%sum(niogrp)
721 kpoint%iogrp = (niogrp == 1)
722
723 ! parallel groups
724 kpoint%para_env_kp => para_env_kp
725 kpoint%para_env_inter_kp => para_env_inter_kp
726
727 ! distribution of kpoints
728 ALLOCATE (kpoint%kp_dist(2, nkp_grp))
729 DO igr = 1, nkp_grp
730 kpoint%kp_dist(1:2, igr) = get_limit(nkp, nkp_grp, igr - 1)
731 END DO
732 ! local kpoints
733 kpoint%kp_range(1:2) = kpoint%kp_dist(1:2, para_env_inter_kp%mepos + 1)
734
735 ALLOCATE (kp_env(nkp_loc))
736 DO ik = 1, nkp_loc
737 NULLIFY (kp_env(ik)%kpoint_env)
738 ikk = kpoint%kp_range(1) + ik - 1
739 CALL kpoint_env_create(kp_env(ik)%kpoint_env)
740 kp => kp_env(ik)%kpoint_env
741 kp%nkpoint = ikk
742 kp%wkp = kpoint%wkp(ikk)
743 kp%xkp(1:3) = kpoint%xkp(1:3, ikk)
744 kp%is_local = (ngr == 1)
745 END DO
746 kpoint%kp_env => kp_env
747
748 IF (aux_fit) THEN
749 ALLOCATE (kp_aux_env(nkp_loc))
750 DO ik = 1, nkp_loc
751 NULLIFY (kp_aux_env(ik)%kpoint_env)
752 ikk = kpoint%kp_range(1) + ik - 1
753 CALL kpoint_env_create(kp_aux_env(ik)%kpoint_env)
754 kp => kp_aux_env(ik)%kpoint_env
755 kp%nkpoint = ikk
756 kp%wkp = kpoint%wkp(ikk)
757 kp%xkp(1:3) = kpoint%xkp(1:3, ikk)
758 kp%is_local = (ngr == 1)
759 END DO
760 kpoint%kp_aux_env => kp_aux_env
761 END IF
762
763 unit_nr = cp_logger_get_default_io_unit()
764
765 IF (unit_nr > 0 .AND. kpoint%verbose) THEN
766 WRITE (unit_nr, *)
767 WRITE (unit_nr, fmt="(T2,A,T71,I10)") "KPOINTS| Number of kpoint groups ", nkp_grp
768 WRITE (unit_nr, fmt="(T2,A,T71,I10)") "KPOINTS| Size of each kpoint group", ngr
769 WRITE (unit_nr, fmt="(T2,A,T71,I10)") "KPOINTS| Number of kpoints per group", nkp_loc
770 END IF
771 kpoint%nkp_groups = nkp_grp
772
773 END IF
774
775 CALL timestop(handle)
776
777 END SUBROUTINE kpoint_env_initialize
778
779! **************************************************************************************************
780!> \brief Initialize a set of MOs and density matrix for each kpoint (kpoint group)
781!> \param kpoint Kpoint environment
782!> \param mos Reference MOs (global)
783!> \param added_mos ...
784!> \param for_aux_fit ...
785! **************************************************************************************************
786 SUBROUTINE kpoint_initialize_mos(kpoint, mos, added_mos, for_aux_fit)
787
788 TYPE(kpoint_type), POINTER :: kpoint
789 TYPE(mo_set_type), DIMENSION(:), INTENT(INOUT) :: mos
790 INTEGER, INTENT(IN), OPTIONAL :: added_mos
791 LOGICAL, OPTIONAL :: for_aux_fit
792
793 CHARACTER(LEN=*), PARAMETER :: routinen = 'kpoint_initialize_mos'
794
795 INTEGER :: handle, ic, ik, is, nadd, nao, nc, &
796 nelectron, nkp_loc, nmo, nmorig(2), &
797 nspin
798 LOGICAL :: aux_fit
799 REAL(kind=dp) :: flexible_electron_count, maxocc, n_el_f
800 TYPE(cp_blacs_env_type), POINTER :: blacs_env
801 TYPE(cp_fm_pool_p_type), DIMENSION(:), POINTER :: ao_ao_fm_pools
802 TYPE(cp_fm_struct_type), POINTER :: matrix_struct
803 TYPE(cp_fm_type), POINTER :: fmlocal
804 TYPE(kpoint_env_type), POINTER :: kp
805 TYPE(qs_matrix_pools_type), POINTER :: mpools
806
807 CALL timeset(routinen, handle)
808
809 IF (PRESENT(for_aux_fit)) THEN
810 aux_fit = for_aux_fit
811 ELSE
812 aux_fit = .false.
813 END IF
814
815 cpassert(ASSOCIATED(kpoint))
816
817 IF (.true. .OR. ASSOCIATED(mos(1)%mo_coeff)) THEN
818 IF (aux_fit) THEN
819 cpassert(ASSOCIATED(kpoint%kp_aux_env))
820 END IF
821
822 IF (PRESENT(added_mos)) THEN
823 nadd = added_mos
824 ELSE
825 nadd = 0
826 END IF
827
828 IF (kpoint%use_real_wfn) THEN
829 nc = 1
830 ELSE
831 nc = 2
832 END IF
833 nspin = SIZE(mos, 1)
834 nkp_loc = kpoint%kp_range(2) - kpoint%kp_range(1) + 1
835 IF (nkp_loc > 0) THEN
836 IF (aux_fit) THEN
837 cpassert(SIZE(kpoint%kp_aux_env) == nkp_loc)
838 ELSE
839 cpassert(SIZE(kpoint%kp_env) == nkp_loc)
840 END IF
841 ! allocate the mo sets, correct number of kpoints (local), real/complex, spin
842 DO ik = 1, nkp_loc
843 IF (aux_fit) THEN
844 kp => kpoint%kp_aux_env(ik)%kpoint_env
845 ELSE
846 kp => kpoint%kp_env(ik)%kpoint_env
847 END IF
848 ALLOCATE (kp%mos(nc, nspin))
849 DO is = 1, nspin
850 CALL get_mo_set(mos(is), nao=nao, nmo=nmo, nelectron=nelectron, &
851 n_el_f=n_el_f, maxocc=maxocc, flexible_electron_count=flexible_electron_count)
852 nmo = min(nao, nmo + nadd)
853 DO ic = 1, nc
854 CALL allocate_mo_set(kp%mos(ic, is), nao, nmo, nelectron, n_el_f, maxocc, &
855 flexible_electron_count)
856 END DO
857 END DO
858 END DO
859
860 ! generate the blacs environment for the kpoint group
861 ! we generate a blacs env for each kpoint group in parallel
862 ! we assume here that the group para_env_inter_kp will connect
863 ! equivalent parts of fm matrices, i.e. no reshuffeling of processors
864 NULLIFY (blacs_env)
865 IF (ASSOCIATED(kpoint%blacs_env)) THEN
866 blacs_env => kpoint%blacs_env
867 ELSE
868 CALL cp_blacs_env_create(blacs_env=blacs_env, para_env=kpoint%para_env_kp)
869 kpoint%blacs_env => blacs_env
870 END IF
871
872 ! set possible new number of MOs
873 DO is = 1, nspin
874 CALL get_mo_set(mos(is), nmo=nmorig(is))
875 nmo = min(nao, nmorig(is) + nadd)
876 CALL set_mo_set(mos(is), nmo=nmo)
877 END DO
878 ! matrix pools for the kpoint group, information on MOs is transferred using
879 ! generic mos structure
880 NULLIFY (mpools)
881 CALL mpools_create(mpools=mpools)
882 CALL mpools_rebuild_fm_pools(mpools=mpools, mos=mos, &
883 blacs_env=blacs_env, para_env=kpoint%para_env_kp)
884
885 IF (aux_fit) THEN
886 kpoint%mpools_aux_fit => mpools
887 ELSE
888 kpoint%mpools => mpools
889 END IF
890
891 ! reset old number of MOs
892 DO is = 1, nspin
893 CALL set_mo_set(mos(is), nmo=nmorig(is))
894 END DO
895
896 ! allocate density matrices
897 CALL mpools_get(mpools, ao_ao_fm_pools=ao_ao_fm_pools)
898 ALLOCATE (fmlocal)
899 CALL fm_pool_create_fm(ao_ao_fm_pools(1)%pool, fmlocal)
900 CALL cp_fm_get_info(fmlocal, matrix_struct=matrix_struct)
901 DO ik = 1, nkp_loc
902 IF (aux_fit) THEN
903 kp => kpoint%kp_aux_env(ik)%kpoint_env
904 ELSE
905 kp => kpoint%kp_env(ik)%kpoint_env
906 END IF
907 ! density matrix
908 CALL cp_fm_release(kp%pmat)
909 ALLOCATE (kp%pmat(nc, nspin))
910 DO is = 1, nspin
911 DO ic = 1, nc
912 CALL cp_fm_create(kp%pmat(ic, is), matrix_struct)
913 END DO
914 END DO
915 ! energy weighted density matrix
916 CALL cp_fm_release(kp%wmat)
917 ALLOCATE (kp%wmat(nc, nspin))
918 DO is = 1, nspin
919 DO ic = 1, nc
920 CALL cp_fm_create(kp%wmat(ic, is), matrix_struct)
921 END DO
922 END DO
923 END DO
924 CALL fm_pool_give_back_fm(ao_ao_fm_pools(1)%pool, fmlocal)
925 DEALLOCATE (fmlocal)
926
927 END IF
928
929 END IF
930
931 CALL timestop(handle)
932
933 END SUBROUTINE kpoint_initialize_mos
934
935! **************************************************************************************************
936!> \brief ...
937!> \param kpoint ...
938! **************************************************************************************************
939 SUBROUTINE kpoint_initialize_mo_set(kpoint)
940 TYPE(kpoint_type), POINTER :: kpoint
941
942 CHARACTER(LEN=*), PARAMETER :: routinen = 'kpoint_initialize_mo_set'
943
944 INTEGER :: handle, ic, ik, ikk, ispin
945 TYPE(cp_fm_pool_p_type), DIMENSION(:), POINTER :: ao_mo_fm_pools
946 TYPE(cp_fm_type), POINTER :: mo_coeff
947 TYPE(mo_set_type), DIMENSION(:, :), POINTER :: moskp
948
949 CALL timeset(routinen, handle)
950
951 DO ik = 1, SIZE(kpoint%kp_env)
952 CALL mpools_get(kpoint%mpools, ao_mo_fm_pools=ao_mo_fm_pools)
953 moskp => kpoint%kp_env(ik)%kpoint_env%mos
954 ikk = kpoint%kp_range(1) + ik - 1
955 cpassert(ASSOCIATED(moskp))
956 DO ispin = 1, SIZE(moskp, 2)
957 DO ic = 1, SIZE(moskp, 1)
958 CALL get_mo_set(moskp(ic, ispin), mo_coeff=mo_coeff)
959 IF (.NOT. ASSOCIATED(mo_coeff)) THEN
960 CALL init_mo_set(moskp(ic, ispin), &
961 fm_pool=ao_mo_fm_pools(ispin)%pool, name="kpoints")
962 END IF
963 END DO
964 END DO
965 END DO
966
967 CALL timestop(handle)
968
969 END SUBROUTINE kpoint_initialize_mo_set
970
971! **************************************************************************************************
972!> \brief Generates the mapping of cell indices and linear RS index
973!> CELL (0,0,0) is always mapped to index 1
974!> \param kpoint Kpoint environment
975!> \param sab_nl Defining neighbour list
976!> \param para_env Parallel environment
977!> \param nimages [output]
978! **************************************************************************************************
979 SUBROUTINE kpoint_init_cell_index(kpoint, sab_nl, para_env, nimages)
980
981 TYPE(kpoint_type), POINTER :: kpoint
982 TYPE(neighbor_list_set_p_type), DIMENSION(:), &
983 POINTER :: sab_nl
984 TYPE(mp_para_env_type), POINTER :: para_env
985 INTEGER, INTENT(OUT) :: nimages
986
987 CHARACTER(LEN=*), PARAMETER :: routinen = 'kpoint_init_cell_index'
988
989 INTEGER :: handle, i1, i2, i3, ic, icount, it, &
990 ncount
991 INTEGER, DIMENSION(3) :: cell, itm
992 INTEGER, DIMENSION(:, :), POINTER :: index_to_cell, list
993 INTEGER, DIMENSION(:, :, :), POINTER :: cell_to_index, cti
994 LOGICAL :: new
995 TYPE(neighbor_list_iterator_p_type), &
996 DIMENSION(:), POINTER :: nl_iterator
997
998 NULLIFY (cell_to_index, index_to_cell)
999
1000 CALL timeset(routinen, handle)
1001
1002 cpassert(ASSOCIATED(kpoint))
1003
1004 ALLOCATE (list(3, 125))
1005 list = 0
1006 icount = 1
1007
1008 CALL neighbor_list_iterator_create(nl_iterator, sab_nl)
1009 DO WHILE (neighbor_list_iterate(nl_iterator) == 0)
1010 CALL get_iterator_info(nl_iterator, cell=cell)
1011
1012 new = .true.
1013 DO ic = 1, icount
1014 IF (cell(1) == list(1, ic) .AND. cell(2) == list(2, ic) .AND. &
1015 cell(3) == list(3, ic)) THEN
1016 new = .false.
1017 EXIT
1018 END IF
1019 END DO
1020 IF (new) THEN
1021 icount = icount + 1
1022 IF (icount > SIZE(list, 2)) THEN
1023 CALL reallocate(list, 1, 3, 1, 2*SIZE(list, 2))
1024 END IF
1025 list(1:3, icount) = cell(1:3)
1026 END IF
1027
1028 END DO
1029 CALL neighbor_list_iterator_release(nl_iterator)
1030
1031 itm(1) = maxval(abs(list(1, 1:icount)))
1032 itm(2) = maxval(abs(list(2, 1:icount)))
1033 itm(3) = maxval(abs(list(3, 1:icount)))
1034 CALL para_env%max(itm)
1035 it = maxval(itm(1:3))
1036 IF (ASSOCIATED(kpoint%cell_to_index)) THEN
1037 DEALLOCATE (kpoint%cell_to_index)
1038 END IF
1039 ALLOCATE (kpoint%cell_to_index(-itm(1):itm(1), -itm(2):itm(2), -itm(3):itm(3)))
1040 cell_to_index => kpoint%cell_to_index
1041 cti => cell_to_index
1042 cti(:, :, :) = 0
1043 DO ic = 1, icount
1044 i1 = list(1, ic)
1045 i2 = list(2, ic)
1046 i3 = list(3, ic)
1047 cti(i1, i2, i3) = ic
1048 END DO
1049 CALL para_env%sum(cti)
1050 ncount = 0
1051 DO i1 = -itm(1), itm(1)
1052 DO i2 = -itm(2), itm(2)
1053 DO i3 = -itm(3), itm(3)
1054 IF (cti(i1, i2, i3) == 0) THEN
1055 cti(i1, i2, i3) = 1000000
1056 ELSE
1057 ncount = ncount + 1
1058 cti(i1, i2, i3) = (abs(i1) + abs(i2) + abs(i3))*1000 + abs(i3)*100 + abs(i2)*10 + abs(i1)
1059 cti(i1, i2, i3) = cti(i1, i2, i3) + (i1 + i2 + i3)
1060 END IF
1061 END DO
1062 END DO
1063 END DO
1064
1065 IF (ASSOCIATED(kpoint%index_to_cell)) THEN
1066 DEALLOCATE (kpoint%index_to_cell)
1067 END IF
1068 ALLOCATE (kpoint%index_to_cell(3, ncount))
1069 index_to_cell => kpoint%index_to_cell
1070 DO ic = 1, ncount
1071 cell = minloc(cti)
1072 i1 = cell(1) - 1 - itm(1)
1073 i2 = cell(2) - 1 - itm(2)
1074 i3 = cell(3) - 1 - itm(3)
1075 cti(i1, i2, i3) = 1000000
1076 index_to_cell(1, ic) = i1
1077 index_to_cell(2, ic) = i2
1078 index_to_cell(3, ic) = i3
1079 END DO
1080 cti(:, :, :) = 0
1081 DO ic = 1, ncount
1082 i1 = index_to_cell(1, ic)
1083 i2 = index_to_cell(2, ic)
1084 i3 = index_to_cell(3, ic)
1085 cti(i1, i2, i3) = ic
1086 END DO
1087
1088 ! keep pointer to this neighborlist
1089 kpoint%sab_nl => sab_nl
1090
1091 ! set number of images
1092 nimages = SIZE(index_to_cell, 2)
1093
1094 DEALLOCATE (list)
1095
1096 CALL timestop(handle)
1097
1098 END SUBROUTINE kpoint_init_cell_index
1099
1100! **************************************************************************************************
1101!> \brief Transformation of real space matrices to a kpoint
1102!> \param rmatrix Real part of kpoint matrix
1103!> \param cmatrix Complex part of kpoint matrix (optional)
1104!> \param rsmat Real space matrices
1105!> \param ispin Spin index
1106!> \param xkp Kpoint coordinates
1107!> \param cell_to_index mapping of cell indices to RS index
1108!> \param sab_nl Defining neighbor list
1109!> \param is_complex Matrix to be transformed is imaginary
1110!> \param rs_sign Matrix to be transformed is csaled by rs_sign
1111! **************************************************************************************************
1112 SUBROUTINE rskp_transform(rmatrix, cmatrix, rsmat, ispin, &
1113 xkp, cell_to_index, sab_nl, is_complex, rs_sign)
1114
1115 TYPE(dbcsr_type) :: rmatrix
1116 TYPE(dbcsr_type), OPTIONAL :: cmatrix
1117 TYPE(dbcsr_p_type), DIMENSION(:, :), POINTER :: rsmat
1118 INTEGER, INTENT(IN) :: ispin
1119 REAL(kind=dp), DIMENSION(3), INTENT(IN) :: xkp
1120 INTEGER, DIMENSION(:, :, :), POINTER :: cell_to_index
1121 TYPE(neighbor_list_set_p_type), DIMENSION(:), &
1122 POINTER :: sab_nl
1123 LOGICAL, INTENT(IN), OPTIONAL :: is_complex
1124 REAL(kind=dp), INTENT(IN), OPTIONAL :: rs_sign
1125
1126 CHARACTER(LEN=*), PARAMETER :: routinen = 'rskp_transform'
1127
1128 INTEGER :: handle, iatom, ic, icol, irow, jatom, &
1129 nimg
1130 INTEGER, DIMENSION(3) :: cell
1131 LOGICAL :: do_symmetric, found, my_complex, &
1132 wfn_real_only
1133 REAL(kind=dp) :: arg, coskl, fsign, fsym, sinkl
1134 REAL(kind=dp), DIMENSION(:, :), POINTER :: cblock, rblock, rsblock
1135 TYPE(neighbor_list_iterator_p_type), &
1136 DIMENSION(:), POINTER :: nl_iterator
1137
1138 CALL timeset(routinen, handle)
1139
1140 my_complex = .false.
1141 IF (PRESENT(is_complex)) my_complex = is_complex
1142
1143 fsign = 1.0_dp
1144 IF (PRESENT(rs_sign)) fsign = rs_sign
1145
1146 wfn_real_only = .true.
1147 IF (PRESENT(cmatrix)) wfn_real_only = .false.
1148
1149 nimg = SIZE(rsmat, 2)
1150
1151 CALL get_neighbor_list_set_p(neighbor_list_sets=sab_nl, symmetric=do_symmetric)
1152
1153 CALL neighbor_list_iterator_create(nl_iterator, sab_nl)
1154 DO WHILE (neighbor_list_iterate(nl_iterator) == 0)
1155 CALL get_iterator_info(nl_iterator, iatom=iatom, jatom=jatom, cell=cell)
1156
1157 ! fsym = +- 1 is due to real space matrices being non-symmetric (although in a symmtric type)
1158 ! with the link S_mu^0,nu^b = S_nu^0,mu^-b, and the KP matrices beeing Hermitian
1159 fsym = 1.0_dp
1160 irow = iatom
1161 icol = jatom
1162 IF (do_symmetric .AND. (iatom > jatom)) THEN
1163 irow = jatom
1164 icol = iatom
1165 fsym = -1.0_dp
1166 END IF
1167
1168 ic = cell_to_index(cell(1), cell(2), cell(3))
1169 IF (ic < 1 .OR. ic > nimg) cycle
1170
1171 arg = real(cell(1), dp)*xkp(1) + real(cell(2), dp)*xkp(2) + real(cell(3), dp)*xkp(3)
1172 IF (my_complex) THEN
1173 coskl = fsign*fsym*cos(twopi*arg)
1174 sinkl = fsign*sin(twopi*arg)
1175 ELSE
1176 coskl = fsign*cos(twopi*arg)
1177 sinkl = fsign*fsym*sin(twopi*arg)
1178 END IF
1179
1180 CALL dbcsr_get_block_p(matrix=rsmat(ispin, ic)%matrix, row=irow, col=icol, &
1181 block=rsblock, found=found)
1182 IF (.NOT. found) cycle
1183
1184 IF (wfn_real_only) THEN
1185 CALL dbcsr_get_block_p(matrix=rmatrix, row=irow, col=icol, &
1186 block=rblock, found=found)
1187 IF (.NOT. found) cycle
1188 rblock = rblock + coskl*rsblock
1189 ELSE
1190 CALL dbcsr_get_block_p(matrix=rmatrix, row=irow, col=icol, &
1191 block=rblock, found=found)
1192 IF (.NOT. found) cycle
1193 CALL dbcsr_get_block_p(matrix=cmatrix, row=irow, col=icol, &
1194 block=cblock, found=found)
1195 IF (.NOT. found) cycle
1196 rblock = rblock + coskl*rsblock
1197 cblock = cblock + sinkl*rsblock
1198 END IF
1199
1200 END DO
1201 CALL neighbor_list_iterator_release(nl_iterator)
1202
1203 CALL timestop(handle)
1204
1205 END SUBROUTINE rskp_transform
1206
1207! **************************************************************************************************
1208!> \brief Given the eigenvalues of all kpoints, calculates the occupation numbers
1209!> \param kpoint Kpoint environment
1210!> \param smear Smearing information
1211!> \param probe ...
1212! **************************************************************************************************
1213 SUBROUTINE kpoint_set_mo_occupation(kpoint, smear, probe)
1214
1215 TYPE(kpoint_type), POINTER :: kpoint
1216 TYPE(smear_type) :: smear
1217 TYPE(hairy_probes_type), DIMENSION(:), OPTIONAL, &
1218 POINTER :: probe
1219
1220 CHARACTER(LEN=*), PARAMETER :: routinen = 'kpoint_set_mo_occupation'
1221
1222 INTEGER :: handle, ik, ikpgr, ispin, kplocal, nao, &
1223 nb, ncol_global, ne_a, ne_b, &
1224 nelectron, nkp, nmo, nrow_global, nspin
1225 INTEGER, DIMENSION(2) :: kp_range
1226 REAL(kind=dp) :: kts, kts_spin(2), mu, mus(2), nel
1227 REAL(kind=dp), ALLOCATABLE, DIMENSION(:, :) :: smatrix
1228 REAL(kind=dp), ALLOCATABLE, DIMENSION(:, :, :) :: weig, wocc
1229 REAL(kind=dp), ALLOCATABLE, DIMENSION(:, :, :, :) :: icoeff, rcoeff
1230 REAL(kind=dp), DIMENSION(:), POINTER :: eigenvalues, occupation, wkp
1231 TYPE(cp_fm_type), POINTER :: mo_coeff
1232 TYPE(kpoint_env_type), POINTER :: kp
1233 TYPE(mo_set_type), POINTER :: mo_set
1234 TYPE(mp_para_env_type), POINTER :: para_env_inter_kp
1235
1236 CALL timeset(routinen, handle)
1237
1238 ! first collect all the eigenvalues
1239 CALL get_kpoint_info(kpoint, nkp=nkp)
1240 kp => kpoint%kp_env(1)%kpoint_env
1241 nspin = SIZE(kp%mos, 2)
1242 mo_set => kp%mos(1, 1)
1243 CALL get_mo_set(mo_set, nmo=nmo, nao=nao, nelectron=nelectron)
1244 ne_a = nelectron
1245 IF (nspin == 2) THEN
1246 CALL get_mo_set(kp%mos(1, 2), nmo=nb, nelectron=ne_b)
1247 cpassert(nmo == nb)
1248 END IF
1249 ALLOCATE (weig(nmo, nkp, nspin), wocc(nmo, nkp, nspin))
1250 weig = 0.0_dp
1251 wocc = 0.0_dp
1252 IF (PRESENT(probe)) THEN
1253 ALLOCATE (rcoeff(nao, nmo, nkp, nspin), icoeff(nao, nmo, nkp, nspin))
1254 rcoeff = 0.0_dp !coeff, real part
1255 icoeff = 0.0_dp !coeff, imaginary part
1256 END IF
1257 CALL get_kpoint_info(kpoint, kp_range=kp_range)
1258 kplocal = kp_range(2) - kp_range(1) + 1
1259 DO ikpgr = 1, kplocal
1260 ik = kp_range(1) + ikpgr - 1
1261 kp => kpoint%kp_env(ikpgr)%kpoint_env
1262 DO ispin = 1, nspin
1263 mo_set => kp%mos(1, ispin)
1264 CALL get_mo_set(mo_set, eigenvalues=eigenvalues)
1265 weig(1:nmo, ik, ispin) = eigenvalues(1:nmo)
1266 IF (PRESENT(probe)) THEN
1267 CALL get_mo_set(mo_set, mo_coeff=mo_coeff)
1268 CALL cp_fm_get_info(mo_coeff, &
1269 nrow_global=nrow_global, &
1270 ncol_global=ncol_global)
1271 ALLOCATE (smatrix(nrow_global, ncol_global))
1272 CALL cp_fm_get_submatrix(mo_coeff, smatrix)
1273
1274 rcoeff(1:nao, 1:nmo, ik, ispin) = smatrix(1:nrow_global, 1:ncol_global)
1275
1276 DEALLOCATE (smatrix)
1277
1278 mo_set => kp%mos(2, ispin)
1279
1280 CALL get_mo_set(mo_set, mo_coeff=mo_coeff)
1281 CALL cp_fm_get_info(mo_coeff, &
1282 nrow_global=nrow_global, &
1283 ncol_global=ncol_global)
1284 ALLOCATE (smatrix(nrow_global, ncol_global))
1285 CALL cp_fm_get_submatrix(mo_coeff, smatrix)
1286
1287 icoeff(1:nao, 1:nmo, ik, ispin) = smatrix(1:nrow_global, 1:ncol_global)
1288
1289 mo_set => kp%mos(1, ispin)
1290
1291 DEALLOCATE (smatrix)
1292 END IF
1293 END DO
1294 END DO
1295 CALL get_kpoint_info(kpoint, para_env_inter_kp=para_env_inter_kp)
1296 CALL para_env_inter_kp%sum(weig)
1297
1298 IF (PRESENT(probe)) THEN
1299 CALL para_env_inter_kp%sum(rcoeff)
1300 CALL para_env_inter_kp%sum(icoeff)
1301 END IF
1302
1303 CALL get_kpoint_info(kpoint, wkp=wkp)
1304 kts_spin = 0.0_dp
1305
1306!calling of HP module HERE, before smear
1307 IF (PRESENT(probe)) THEN
1308 smear%do_smear = .false. !ensures smearing is switched off
1309
1310 IF (nspin == 1) THEN
1311 nel = real(nelectron, kind=dp)
1312 CALL probe_occupancy_kp(wocc(:, :, :), mus(1), kts, weig(:, :, :), rcoeff(:, :, :, :), icoeff(:, :, :, :), 2.0d0, &
1313 probe, nel, wkp)
1314 ELSE
1315 nel = real(ne_a, kind=dp) + real(ne_b, kind=dp)
1316 CALL probe_occupancy_kp(wocc(:, :, :), mu, kts, weig(:, :, :), rcoeff(:, :, :, :), icoeff(:, :, :, :), 1.0d0, &
1317 probe, nel, wkp)
1318 kts = kts/2._dp
1319 mus(1:2) = mu
1320 END IF
1321
1322 DO ikpgr = 1, kplocal
1323 ik = kp_range(1) + ikpgr - 1
1324 kp => kpoint%kp_env(ikpgr)%kpoint_env
1325 DO ispin = 1, nspin
1326 mo_set => kp%mos(1, ispin)
1327 CALL get_mo_set(mo_set, eigenvalues=eigenvalues, occupation_numbers=occupation)
1328 eigenvalues(1:nmo) = weig(1:nmo, ik, ispin)
1329 occupation(1:nmo) = wocc(1:nmo, ik, ispin)
1330 mo_set%kTS = kts
1331 mo_set%mu = mus(ispin)
1332
1333 CALL get_mo_set(mo_set, mo_coeff=mo_coeff)
1334 !get smatrix for kpoint_env ikp
1335 CALL cp_fm_get_info(mo_coeff, &
1336 nrow_global=nrow_global, &
1337 ncol_global=ncol_global)
1338 ALLOCATE (smatrix(nrow_global, ncol_global))
1339 CALL cp_fm_get_submatrix(mo_coeff, smatrix)
1340
1341 smatrix(1:nrow_global, 1:ncol_global) = rcoeff(1:nao, 1:nmo, ik, ispin)
1342 DEALLOCATE (smatrix)
1343
1344 mo_set => kp%mos(2, ispin)
1345
1346 CALL get_mo_set(mo_set, mo_coeff=mo_coeff)
1347 !get smatrix for kpoint_env ikp
1348 CALL cp_fm_get_info(mo_coeff, &
1349 nrow_global=nrow_global, &
1350 ncol_global=ncol_global)
1351 ALLOCATE (smatrix(nrow_global, ncol_global))
1352 CALL cp_fm_get_submatrix(mo_coeff, smatrix)
1353
1354 smatrix(1:nrow_global, 1:ncol_global) = icoeff(1:nao, 1:nmo, ik, ispin)
1355 DEALLOCATE (smatrix)
1356
1357 mo_set => kp%mos(1, ispin)
1358
1359 END DO
1360 END DO
1361
1362 DEALLOCATE (weig, wocc, rcoeff, icoeff)
1363
1364 END IF
1365
1366 IF (PRESENT(probe) .EQV. .false.) THEN
1367 IF (smear%do_smear) THEN
1368 SELECT CASE (smear%method)
1369 CASE (smear_fermi_dirac)
1370 ! finite electronic temperature
1371 IF (nspin == 1) THEN
1372 nel = real(nelectron, kind=dp)
1373 CALL smearkp(wocc(:, :, 1), mus(1), kts, weig(:, :, 1), nel, wkp, &
1374 smear%electronic_temperature, 2.0_dp, smear_fermi_dirac)
1375 kts_spin(1) = kts
1376 ELSE IF (smear%fixed_mag_mom > 0.0_dp) THEN
1377 nel = real(ne_a, kind=dp)
1378 CALL smearkp(wocc(:, :, 1), mus(1), kts, weig(:, :, 1), nel, wkp, &
1379 smear%electronic_temperature, 1.0_dp, smear_fermi_dirac)
1380 kts_spin(1) = kts
1381 nel = real(ne_b, kind=dp)
1382 CALL smearkp(wocc(:, :, 2), mus(2), kts, weig(:, :, 2), nel, wkp, &
1383 smear%electronic_temperature, 1.0_dp, smear_fermi_dirac)
1384 kts_spin(2) = kts
1385 ELSE
1386 nel = real(ne_a, kind=dp) + real(ne_b, kind=dp)
1387 CALL smearkp2(wocc(:, :, :), mu, kts, weig(:, :, :), nel, wkp, &
1388 smear%electronic_temperature, smear_fermi_dirac)
1389 kts = kts/2._dp
1390 kts_spin(1:2) = kts
1391 mus(1:2) = mu
1392 END IF
1393 CASE (smear_gaussian, smear_mp, smear_mv)
1394 IF (nspin == 1) THEN
1395 nel = real(nelectron, kind=dp)
1396 CALL smearkp(wocc(:, :, 1), mus(1), kts, weig(:, :, 1), nel, wkp, &
1397 smear%smearing_width, 2.0_dp, smear%method)
1398 kts_spin(1) = kts
1399 ELSE IF (smear%fixed_mag_mom > 0.0_dp) THEN
1400 nel = real(ne_a, kind=dp)
1401 CALL smearkp(wocc(:, :, 1), mus(1), kts, weig(:, :, 1), nel, wkp, &
1402 smear%smearing_width, 1.0_dp, smear%method)
1403 kts_spin(1) = kts
1404 nel = real(ne_b, kind=dp)
1405 CALL smearkp(wocc(:, :, 2), mus(2), kts, weig(:, :, 2), nel, wkp, &
1406 smear%smearing_width, 1.0_dp, smear%method)
1407 kts_spin(2) = kts
1408 ELSE
1409 nel = real(ne_a, kind=dp) + real(ne_b, kind=dp)
1410 CALL smearkp2(wocc(:, :, :), mu, kts, weig(:, :, :), nel, wkp, &
1411 smear%smearing_width, smear%method)
1412 kts = kts/2._dp
1413 kts_spin(1:2) = kts
1414 mus(1:2) = mu
1415 END IF
1416 CASE DEFAULT
1417 cpabort("kpoints: Selected smearing not (yet) supported")
1418 END SELECT
1419 ELSE
1420 ! fixed occupations (2/1)
1421 IF (nspin == 1) THEN
1422 nel = real(nelectron, kind=dp)
1423 CALL smearkp(wocc(:, :, 1), mus(1), kts, weig(:, :, 1), nel, wkp, &
1424 0.0_dp, 2.0_dp, smear_gaussian)
1425 kts_spin(1) = kts
1426 ELSE
1427 nel = real(ne_a, kind=dp)
1428 CALL smearkp(wocc(:, :, 1), mus(1), kts, weig(:, :, 1), nel, wkp, &
1429 0.0_dp, 1.0_dp, smear_gaussian)
1430 kts_spin(1) = kts
1431 nel = real(ne_b, kind=dp)
1432 CALL smearkp(wocc(:, :, 2), mus(2), kts, weig(:, :, 2), nel, wkp, &
1433 0.0_dp, 1.0_dp, smear_gaussian)
1434 kts_spin(2) = kts
1435 END IF
1436 END IF
1437 DO ikpgr = 1, kplocal
1438 ik = kp_range(1) + ikpgr - 1
1439 kp => kpoint%kp_env(ikpgr)%kpoint_env
1440 DO ispin = 1, nspin
1441 mo_set => kp%mos(1, ispin)
1442 CALL get_mo_set(mo_set, eigenvalues=eigenvalues, occupation_numbers=occupation)
1443 eigenvalues(1:nmo) = weig(1:nmo, ik, ispin)
1444 occupation(1:nmo) = wocc(1:nmo, ik, ispin)
1445 mo_set%kTS = kts_spin(ispin)
1446 mo_set%mu = mus(ispin)
1447 END DO
1448 END DO
1449
1450 DEALLOCATE (weig, wocc)
1451
1452 END IF
1453
1454 CALL timestop(handle)
1455
1456 END SUBROUTINE kpoint_set_mo_occupation
1457
1458! **************************************************************************************************
1459!> \brief Calculate kpoint density matrices (rho(k), owned by kpoint groups)
1460!> \param kpoint kpoint environment
1461!> \param energy_weighted calculate energy weighted density matrix
1462!> \param for_aux_fit ...
1463! **************************************************************************************************
1464 SUBROUTINE kpoint_density_matrices(kpoint, energy_weighted, for_aux_fit)
1465
1466 TYPE(kpoint_type), POINTER :: kpoint
1467 LOGICAL, OPTIONAL :: energy_weighted, for_aux_fit
1468
1469 CHARACTER(LEN=*), PARAMETER :: routinen = 'kpoint_density_matrices'
1470
1471 INTEGER :: handle, ikpgr, ispin, kplocal, nao, nmo, &
1472 nspin
1473 INTEGER, DIMENSION(2) :: kp_range
1474 LOGICAL :: aux_fit, wtype
1475 REAL(kind=dp), DIMENSION(:), POINTER :: eigenvalues, occupation
1476 TYPE(cp_fm_struct_type), POINTER :: matrix_struct
1477 TYPE(cp_fm_type) :: fwork
1478 TYPE(cp_fm_type), POINTER :: cpmat, pmat, rpmat
1479 TYPE(kpoint_env_type), POINTER :: kp
1480 TYPE(mo_set_type), POINTER :: mo_set
1481
1482 CALL timeset(routinen, handle)
1483
1484 IF (PRESENT(energy_weighted)) THEN
1485 wtype = energy_weighted
1486 ELSE
1487 ! default is normal density matrix
1488 wtype = .false.
1489 END IF
1490
1491 IF (PRESENT(for_aux_fit)) THEN
1492 aux_fit = for_aux_fit
1493 ELSE
1494 aux_fit = .false.
1495 END IF
1496
1497 IF (aux_fit) THEN
1498 cpassert(ASSOCIATED(kpoint%kp_aux_env))
1499 END IF
1500
1501 ! work matrix
1502 IF (aux_fit) THEN
1503 mo_set => kpoint%kp_aux_env(1)%kpoint_env%mos(1, 1)
1504 ELSE
1505 mo_set => kpoint%kp_env(1)%kpoint_env%mos(1, 1)
1506 END IF
1507 CALL get_mo_set(mo_set, nao=nao, nmo=nmo)
1508 CALL cp_fm_get_info(mo_set%mo_coeff, matrix_struct=matrix_struct)
1509 CALL cp_fm_create(fwork, matrix_struct)
1510
1511 CALL get_kpoint_info(kpoint, kp_range=kp_range)
1512 kplocal = kp_range(2) - kp_range(1) + 1
1513 DO ikpgr = 1, kplocal
1514 IF (aux_fit) THEN
1515 kp => kpoint%kp_aux_env(ikpgr)%kpoint_env
1516 ELSE
1517 kp => kpoint%kp_env(ikpgr)%kpoint_env
1518 END IF
1519 nspin = SIZE(kp%mos, 2)
1520 DO ispin = 1, nspin
1521 mo_set => kp%mos(1, ispin)
1522 IF (wtype) THEN
1523 CALL get_mo_set(mo_set, eigenvalues=eigenvalues)
1524 END IF
1525 IF (kpoint%use_real_wfn) THEN
1526 IF (wtype) THEN
1527 pmat => kp%wmat(1, ispin)
1528 ELSE
1529 pmat => kp%pmat(1, ispin)
1530 END IF
1531 CALL get_mo_set(mo_set, occupation_numbers=occupation)
1532 CALL cp_fm_to_fm(mo_set%mo_coeff, fwork)
1533 CALL cp_fm_column_scale(fwork, occupation)
1534 IF (wtype) THEN
1535 CALL cp_fm_column_scale(fwork, eigenvalues)
1536 END IF
1537 CALL parallel_gemm("N", "T", nao, nao, nmo, 1.0_dp, mo_set%mo_coeff, fwork, 0.0_dp, pmat)
1538 ELSE
1539 IF (wtype) THEN
1540 rpmat => kp%wmat(1, ispin)
1541 cpmat => kp%wmat(2, ispin)
1542 ELSE
1543 rpmat => kp%pmat(1, ispin)
1544 cpmat => kp%pmat(2, ispin)
1545 END IF
1546 CALL get_mo_set(mo_set, occupation_numbers=occupation)
1547 CALL cp_fm_to_fm(mo_set%mo_coeff, fwork)
1548 CALL cp_fm_column_scale(fwork, occupation)
1549 IF (wtype) THEN
1550 CALL cp_fm_column_scale(fwork, eigenvalues)
1551 END IF
1552 ! Re(c)*Re(c)
1553 CALL parallel_gemm("N", "T", nao, nao, nmo, 1.0_dp, mo_set%mo_coeff, fwork, 0.0_dp, rpmat)
1554 mo_set => kp%mos(2, ispin)
1555 ! Im(c)*Re(c)
1556 CALL parallel_gemm("N", "T", nao, nao, nmo, 1.0_dp, mo_set%mo_coeff, fwork, 0.0_dp, cpmat)
1557 ! Re(c)*Im(c)
1558 CALL parallel_gemm("N", "T", nao, nao, nmo, -1.0_dp, fwork, mo_set%mo_coeff, 1.0_dp, cpmat)
1559 CALL cp_fm_to_fm(mo_set%mo_coeff, fwork)
1560 CALL cp_fm_column_scale(fwork, occupation)
1561 IF (wtype) THEN
1562 CALL cp_fm_column_scale(fwork, eigenvalues)
1563 END IF
1564 ! Im(c)*Im(c)
1565 CALL parallel_gemm("N", "T", nao, nao, nmo, 1.0_dp, mo_set%mo_coeff, fwork, 1.0_dp, rpmat)
1566 END IF
1567 END DO
1568 END DO
1569
1570 CALL cp_fm_release(fwork)
1571
1572 CALL timestop(handle)
1573
1574 END SUBROUTINE kpoint_density_matrices
1575
1576! **************************************************************************************************
1577!> \brief Calculate Lowdin transformation of density matrix S^1/2 P S^1/2
1578!> Integrate diagonal elements over k-points to get Lowdin charges
1579!> \param kpoint kpoint environment
1580!> \param pmat_diag Sum over kpoints of diagonal elements
1581!> \par History
1582!> 04.2026 created [JGH]
1583! **************************************************************************************************
1584 SUBROUTINE lowdin_kp_trans(kpoint, pmat_diag)
1585
1586 TYPE(kpoint_type), POINTER :: kpoint
1587 REAL(kind=dp), DIMENSION(:, :), INTENT(INOUT) :: pmat_diag
1588
1589 CHARACTER(LEN=*), PARAMETER :: routinen = 'lowdin_kp_trans'
1590 COMPLEX(KIND=dp), PARAMETER :: cone = (1.0_dp, 0.0_dp), &
1591 czero = (0.0_dp, 0.0_dp)
1592
1593 INTEGER :: handle, ikpgr, ispin, kplocal, nao, nspin
1594 INTEGER, DIMENSION(2) :: kp_range
1595 REAL(kind=dp), ALLOCATABLE, DIMENSION(:) :: dele
1596 TYPE(cp_cfm_type) :: cf1work, cf2work
1597 TYPE(cp_cfm_type), POINTER :: cshalf
1598 TYPE(cp_fm_struct_type), POINTER :: matrix_struct
1599 TYPE(cp_fm_type) :: f1work, f2work
1600 TYPE(cp_fm_type), POINTER :: cpmat, pmat, rpmat, shalf
1601 TYPE(kpoint_env_type), POINTER :: kp
1602 TYPE(mp_para_env_type), POINTER :: para_env_inter_kp
1603
1604 CALL timeset(routinen, handle)
1605
1606 nspin = SIZE(pmat_diag, 2)
1607 pmat_diag = 0.0_dp
1608
1609 ! work matrix
1610 CALL cp_fm_get_info(kpoint%kp_env(1)%kpoint_env%pmat(1, 1), &
1611 matrix_struct=matrix_struct, nrow_global=nao)
1612 IF (kpoint%use_real_wfn) THEN
1613 CALL cp_fm_create(f1work, matrix_struct, nrow=nao, ncol=nao)
1614 CALL cp_fm_create(f2work, matrix_struct, nrow=nao, ncol=nao)
1615 ELSE
1616 CALL cp_fm_create(f2work, matrix_struct, nrow=nao, ncol=nao)
1617 CALL cp_cfm_create(cf1work, matrix_struct, nrow=nao, ncol=nao)
1618 CALL cp_cfm_create(cf2work, matrix_struct, nrow=nao, ncol=nao)
1619 END IF
1620 ALLOCATE (dele(nao))
1621
1622 CALL get_kpoint_info(kpoint, kp_range=kp_range)
1623 kplocal = kp_range(2) - kp_range(1) + 1
1624 DO ikpgr = 1, kplocal
1625 kp => kpoint%kp_env(ikpgr)%kpoint_env
1626 DO ispin = 1, nspin
1627 IF (kpoint%use_real_wfn) THEN
1628 pmat => kp%pmat(1, ispin)
1629 shalf => kp%shalf
1630 CALL parallel_gemm("N", "N", nao, nao, nao, 1.0_dp, pmat, shalf, 0.0_dp, f1work)
1631 CALL parallel_gemm("N", "N", nao, nao, nao, 1.0_dp, shalf, f1work, 0.0_dp, f2work)
1632 ELSE
1633 rpmat => kp%pmat(1, ispin)
1634 cpmat => kp%pmat(2, ispin)
1635 cshalf => kp%cshalf
1636 CALL cp_fm_to_cfm(rpmat, cpmat, cf1work)
1637 CALL parallel_gemm("N", "N", nao, nao, nao, cone, cf1work, cshalf, czero, cf2work)
1638 CALL parallel_gemm("N", "N", nao, nao, nao, cone, cshalf, cf2work, czero, cf1work)
1639 CALL cp_cfm_to_fm(cf1work, mtargetr=f2work)
1640 END IF
1641 CALL cp_fm_get_diag(f2work, dele)
1642 pmat_diag(1:nao, ispin) = pmat_diag(1:nao, ispin) + kp%wkp*dele(1:nao)
1643 END DO
1644 END DO
1645
1646 CALL get_kpoint_info(kpoint, para_env_inter_kp=para_env_inter_kp)
1647 CALL para_env_inter_kp%sum(pmat_diag)
1648
1649 IF (kpoint%use_real_wfn) THEN
1650 CALL cp_fm_release(f1work)
1651 CALL cp_fm_release(f2work)
1652 ELSE
1653 CALL cp_fm_release(f2work)
1654 CALL cp_cfm_release(cf1work)
1655 CALL cp_cfm_release(cf2work)
1656 END IF
1657 DEALLOCATE (dele)
1658
1659 CALL timestop(handle)
1660
1661 END SUBROUTINE lowdin_kp_trans
1662
1663! **************************************************************************************************
1664!> \brief Calculate S(k)^1/2 C(k) for real or complex k-point wavefunctions
1665!> \param kp K-point environment for one local k point
1666!> \param ispin Spin index
1667!> \param use_real_wfn Use real k-point wavefunctions
1668!> \param shalfc Output matrix containing S(k)^1/2 C(k) for real wavefunctions
1669!> \param cshalfc Output matrix containing S(k)^1/2 C(k) for complex wavefunctions
1670! **************************************************************************************************
1671 SUBROUTINE lowdin_kp_mo_coeff(kp, ispin, use_real_wfn, shalfc, cshalfc)
1672
1673 TYPE(kpoint_env_type), POINTER :: kp
1674 INTEGER, INTENT(IN) :: ispin
1675 LOGICAL, INTENT(IN) :: use_real_wfn
1676 TYPE(cp_fm_type), INTENT(INOUT), OPTIONAL :: shalfc
1677 TYPE(cp_cfm_type), INTENT(INOUT), OPTIONAL :: cshalfc
1678
1679 INTEGER :: nao, nmo
1680 TYPE(cp_fm_struct_type), POINTER :: matrix_struct_mo, matrix_struct_shalf
1681 TYPE(cp_fm_type) :: cshalf_im, cshalf_re, shalf_im, shalf_re
1682 TYPE(mo_set_type), POINTER :: mo_set, mo_set_im, mo_set_re
1683
1684 IF (use_real_wfn) THEN
1685 cpassert(PRESENT(shalfc))
1686 mo_set => kp%mos(1, ispin)
1687 CALL get_mo_set(mo_set, nao=nao, nmo=nmo)
1688
1689 CALL parallel_gemm("N", "N", nao, nmo, nao, 1.0_dp, kp%shalf, &
1690 mo_set%mo_coeff, 0.0_dp, shalfc)
1691 ELSE
1692 cpassert(PRESENT(cshalfc))
1693 mo_set_re => kp%mos(1, ispin)
1694 mo_set_im => kp%mos(2, ispin)
1695 CALL get_mo_set(mo_set_re, nao=nao, nmo=nmo)
1696 CALL cp_fm_get_info(mo_set_re%mo_coeff, matrix_struct=matrix_struct_mo)
1697 CALL cp_cfm_get_info(kp%cshalf, matrix_struct=matrix_struct_shalf)
1698
1699 CALL cp_fm_create(shalf_re, matrix_struct_shalf, nrow=nao, ncol=nao)
1700 CALL cp_fm_create(shalf_im, matrix_struct_shalf, nrow=nao, ncol=nao)
1701 CALL cp_fm_create(cshalf_re, matrix_struct_mo, nrow=nao, ncol=nmo)
1702 CALL cp_fm_create(cshalf_im, matrix_struct_mo, nrow=nao, ncol=nmo)
1703
1704 CALL cp_cfm_to_fm(kp%cshalf, mtargetr=shalf_re, mtargeti=shalf_im)
1705
1706 ! Re[S(k)^1/2 C(k)] = Re[S(k)^1/2] C_re(k) - Im[S(k)^1/2] C_im(k)
1707 CALL parallel_gemm("N", "N", nao, nmo, nao, 1.0_dp, shalf_re, &
1708 mo_set_re%mo_coeff, 0.0_dp, cshalf_re)
1709 CALL parallel_gemm("N", "N", nao, nmo, nao, -1.0_dp, shalf_im, &
1710 mo_set_im%mo_coeff, 1.0_dp, cshalf_re)
1711
1712 ! Im[S(k)^1/2 C(k)] = Re[S(k)^1/2] C_im(k) + Im[S(k)^1/2] C_re(k)
1713 CALL parallel_gemm("N", "N", nao, nmo, nao, 1.0_dp, shalf_re, &
1714 mo_set_im%mo_coeff, 0.0_dp, cshalf_im)
1715 CALL parallel_gemm("N", "N", nao, nmo, nao, 1.0_dp, shalf_im, &
1716 mo_set_re%mo_coeff, 1.0_dp, cshalf_im)
1717
1718 CALL cp_fm_to_cfm(cshalf_re, cshalf_im, cshalfc)
1719
1720 CALL cp_fm_release(shalf_re)
1721 CALL cp_fm_release(shalf_im)
1722 CALL cp_fm_release(cshalf_re)
1723 CALL cp_fm_release(cshalf_im)
1724 END IF
1725
1726 END SUBROUTINE lowdin_kp_mo_coeff
1727
1728! **************************************************************************************************
1729!> \brief generate real space density matrices in DBCSR format
1730!> \param kpoint Kpoint environment
1731!> \param denmat Real space (DBCSR) density matrices
1732!> \param wtype True = energy weighted density matrix
1733!> False = normal density matrix
1734!> \param tempmat DBCSR matrix to be used as template
1735!> \param sab_nl ...
1736!> \param fmwork FM work matrices (kpoint group)
1737!> \param for_aux_fit ...
1738!> \param pmat_ext ...
1739! **************************************************************************************************
1740 SUBROUTINE kpoint_density_transform(kpoint, denmat, wtype, tempmat, sab_nl, fmwork, for_aux_fit, pmat_ext)
1741
1742 TYPE(kpoint_type), POINTER :: kpoint
1743 TYPE(dbcsr_p_type), DIMENSION(:, :) :: denmat
1744 LOGICAL, INTENT(IN) :: wtype
1745 TYPE(dbcsr_type), POINTER :: tempmat
1746 TYPE(neighbor_list_set_p_type), DIMENSION(:), &
1747 POINTER :: sab_nl
1748 TYPE(cp_fm_type), DIMENSION(:), INTENT(IN) :: fmwork
1749 LOGICAL, OPTIONAL :: for_aux_fit
1750 TYPE(cp_fm_type), DIMENSION(:, :, :), INTENT(IN), &
1751 OPTIONAL :: pmat_ext
1752
1753 CHARACTER(LEN=*), PARAMETER :: routinen = 'kpoint_density_transform'
1754
1755 INTEGER :: handle, ic, ik, ikk, indx, ir, ira, is, &
1756 ispin, jr, nc, nimg, nkp, nspin
1757 INTEGER, DIMENSION(:, :, :), POINTER :: cell_to_index
1758 LOGICAL :: aux_fit, do_ext, do_symmetric, my_kpgrp, &
1759 real_only, reverse_phase
1760 REAL(kind=dp) :: wkpx
1761 REAL(kind=dp), DIMENSION(:), POINTER :: wkp
1762 REAL(kind=dp), DIMENSION(:, :), POINTER :: xkp
1763 TYPE(copy_info_type), ALLOCATABLE, DIMENSION(:) :: info
1764 TYPE(cp_fm_type) :: fmdummy
1765 TYPE(dbcsr_type), POINTER :: cpmat, rpmat, scpmat, srpmat
1766 TYPE(kind_rotmat_type), DIMENSION(:), POINTER :: kind_rot
1767 TYPE(kpoint_env_type), POINTER :: kp
1768 TYPE(kpoint_sym_type), POINTER :: kpsym
1769 TYPE(mp_para_env_type), POINTER :: para_env
1770
1771 CALL timeset(routinen, handle)
1772
1773 CALL get_neighbor_list_set_p(neighbor_list_sets=sab_nl, symmetric=do_symmetric)
1774
1775 IF (PRESENT(for_aux_fit)) THEN
1776 aux_fit = for_aux_fit
1777 ELSE
1778 aux_fit = .false.
1779 END IF
1780
1781 do_ext = .false.
1782 IF (PRESENT(pmat_ext)) do_ext = .true.
1783
1784 IF (aux_fit) THEN
1785 cpassert(ASSOCIATED(kpoint%kp_aux_env))
1786 END IF
1787
1788 ! work storage
1789 ALLOCATE (rpmat)
1790 CALL dbcsr_create(rpmat, template=tempmat, &
1791 matrix_type=merge(dbcsr_type_symmetric, dbcsr_type_no_symmetry, do_symmetric))
1792 CALL cp_dbcsr_alloc_block_from_nbl(rpmat, sab_nl)
1793 CALL dbcsr_set(rpmat, 0.0_dp)
1794 ALLOCATE (cpmat)
1795 CALL dbcsr_create(cpmat, template=tempmat, &
1796 matrix_type=merge(dbcsr_type_antisymmetric, dbcsr_type_no_symmetry, do_symmetric))
1797 CALL cp_dbcsr_alloc_block_from_nbl(cpmat, sab_nl)
1798 CALL dbcsr_set(cpmat, 0.0_dp)
1799 IF (.NOT. kpoint%full_grid) THEN
1800 ALLOCATE (srpmat)
1801 CALL dbcsr_create(srpmat, template=rpmat)
1802 CALL cp_dbcsr_alloc_block_from_nbl(srpmat, sab_nl)
1803 CALL dbcsr_set(srpmat, 0.0_dp)
1804 ALLOCATE (scpmat)
1805 CALL dbcsr_create(scpmat, template=cpmat)
1806 CALL cp_dbcsr_alloc_block_from_nbl(scpmat, sab_nl)
1807 CALL dbcsr_set(scpmat, 0.0_dp)
1808 END IF
1809
1810 CALL get_kpoint_info(kpoint, nkp=nkp, xkp=xkp, wkp=wkp, &
1811 cell_to_index=cell_to_index)
1812 ! initialize real space density matrices
1813 IF (aux_fit) THEN
1814 kp => kpoint%kp_aux_env(1)%kpoint_env
1815 ELSE
1816 kp => kpoint%kp_env(1)%kpoint_env
1817 END IF
1818 nspin = SIZE(kp%mos, 2)
1819 nc = SIZE(kp%mos, 1)
1820 nimg = SIZE(denmat, 2)
1821 real_only = (nc == 1)
1822 ! Gamma-centered even grids store atom-cell shifts in the opposite Bloch-phase convention.
1823 reverse_phase = kpoint%gamma_centered .AND. any(mod(kpoint%nkp_grid(1:3), 2) == 0)
1824
1825 para_env => kpoint%blacs_env_all%para_env
1826 ALLOCATE (info(nspin*nkp*nc))
1827
1828 ! Start all the communication
1829 indx = 0
1830 DO ispin = 1, nspin
1831 DO ic = 1, nimg
1832 CALL dbcsr_set(denmat(ispin, ic)%matrix, 0.0_dp)
1833 END DO
1834 !
1835 DO ik = 1, nkp
1836 my_kpgrp = (ik >= kpoint%kp_range(1) .AND. ik <= kpoint%kp_range(2))
1837 IF (my_kpgrp) THEN
1838 ikk = ik - kpoint%kp_range(1) + 1
1839 IF (aux_fit) THEN
1840 kp => kpoint%kp_aux_env(ikk)%kpoint_env
1841 ELSE
1842 kp => kpoint%kp_env(ikk)%kpoint_env
1843 END IF
1844 ELSE
1845 NULLIFY (kp)
1846 END IF
1847 ! collect this density matrix on all processors
1848 cpassert(SIZE(fmwork) >= nc)
1849
1850 IF (my_kpgrp) THEN
1851 DO ic = 1, nc
1852 indx = indx + 1
1853 IF (do_ext) THEN
1854 CALL cp_fm_start_copy_general(pmat_ext(ikk, ic, ispin), fmwork(ic), para_env, info(indx))
1855 ELSE
1856 IF (wtype) THEN
1857 CALL cp_fm_start_copy_general(kp%wmat(ic, ispin), fmwork(ic), para_env, info(indx))
1858 ELSE
1859 CALL cp_fm_start_copy_general(kp%pmat(ic, ispin), fmwork(ic), para_env, info(indx))
1860 END IF
1861 END IF
1862 END DO
1863 ELSE
1864 DO ic = 1, nc
1865 indx = indx + 1
1866 CALL cp_fm_start_copy_general(fmdummy, fmwork(ic), para_env, info(indx))
1867 END DO
1868 END IF
1869 END DO
1870 END DO
1871
1872 ! Finish communication and transform the received matrices
1873 indx = 0
1874 DO ispin = 1, nspin
1875 DO ik = 1, nkp
1876 DO ic = 1, nc
1877 indx = indx + 1
1878 CALL cp_fm_finish_copy_general(fmwork(ic), info(indx))
1879 END DO
1880
1881 ! reduce to dbcsr storage
1882 IF (real_only) THEN
1883 CALL copy_fm_to_dbcsr(fmwork(1), rpmat, keep_sparsity=.true.)
1884 ELSE
1885 CALL copy_fm_to_dbcsr(fmwork(1), rpmat, keep_sparsity=.true.)
1886 CALL copy_fm_to_dbcsr(fmwork(2), cpmat, keep_sparsity=.true.)
1887 END IF
1888
1889 ! symmetrization
1890 kpsym => kpoint%kp_sym(ik)%kpoint_sym
1891 cpassert(ASSOCIATED(kpsym))
1892
1893 IF (kpsym%apply_symmetry) THEN
1894 wkpx = wkp(ik)/real(kpsym%nwght, kind=dp)
1895 DO is = 1, kpsym%nwght
1896 ir = abs(kpsym%rotp(is))
1897 ira = 0
1898 DO jr = 1, SIZE(kpoint%ibrot)
1899 IF (ir == kpoint%ibrot(jr)) ira = jr
1900 END DO
1901 cpassert(ira > 0)
1902 kind_rot => kpoint%kind_rotmat(ira, :)
1903 CALL symtrans_phase(srpmat, scpmat, rpmat, cpmat, real_only, kind_rot, &
1904 kpsym%rot(1:3, 1:3, is), kpsym%f0(:, is), &
1905 kpsym%fcell(:, :, is), kpoint%atype, kpsym%xkp(1:3, is), &
1906 kpsym%rotp(is) < 0, reverse_phase)
1907 CALL transform_dmat(denmat, srpmat, scpmat, ispin, real_only, sab_nl, &
1908 cell_to_index, kpsym%xkp(1:3, is), wkpx)
1909 END DO
1910 ELSE
1911 ! transformation
1912 CALL transform_dmat(denmat, rpmat, cpmat, ispin, real_only, sab_nl, &
1913 cell_to_index, xkp(1:3, ik), wkp(ik))
1914 END IF
1915 END DO
1916 END DO
1917
1918 ! Clean up communication
1919 indx = 0
1920 DO ispin = 1, nspin
1921 DO ik = 1, nkp
1922 my_kpgrp = (ik >= kpoint%kp_range(1) .AND. ik <= kpoint%kp_range(2))
1923 IF (my_kpgrp) THEN
1924 ikk = ik - kpoint%kp_range(1) + 1
1925 IF (aux_fit) THEN
1926 kp => kpoint%kp_aux_env(ikk)%kpoint_env
1927 ELSE
1928 kp => kpoint%kp_env(ikk)%kpoint_env
1929 END IF
1930
1931 DO ic = 1, nc
1932 indx = indx + 1
1933 CALL cp_fm_cleanup_copy_general(info(indx))
1934 END DO
1935 ELSE
1936 ! calls with dummy arguments, so not included
1937 ! therefore just increment counter by trip count
1938 indx = indx + nc
1939 END IF
1940 END DO
1941 END DO
1942
1943 ! All done
1944 DEALLOCATE (info)
1945
1946 CALL dbcsr_deallocate_matrix(rpmat)
1947 CALL dbcsr_deallocate_matrix(cpmat)
1948 IF (.NOT. kpoint%full_grid) THEN
1949 CALL dbcsr_deallocate_matrix(srpmat)
1950 CALL dbcsr_deallocate_matrix(scpmat)
1951 END IF
1952
1953 CALL timestop(handle)
1954
1955 END SUBROUTINE kpoint_density_transform
1956
1957! **************************************************************************************************
1958!> \brief real space density matrices in DBCSR format
1959!> \param denmat Real space (DBCSR) density matrix
1960!> \param rpmat ...
1961!> \param cpmat ...
1962!> \param ispin ...
1963!> \param real_only ...
1964!> \param sab_nl ...
1965!> \param cell_to_index ...
1966!> \param xkp ...
1967!> \param wkp ...
1968! **************************************************************************************************
1969 SUBROUTINE transform_dmat(denmat, rpmat, cpmat, ispin, real_only, sab_nl, cell_to_index, xkp, wkp)
1970
1971 TYPE(dbcsr_p_type), DIMENSION(:, :) :: denmat
1972 TYPE(dbcsr_type), POINTER :: rpmat, cpmat
1973 INTEGER, INTENT(IN) :: ispin
1974 LOGICAL, INTENT(IN) :: real_only
1975 TYPE(neighbor_list_set_p_type), DIMENSION(:), &
1976 POINTER :: sab_nl
1977 INTEGER, DIMENSION(:, :, :), POINTER :: cell_to_index
1978 REAL(kind=dp), DIMENSION(3), INTENT(IN) :: xkp
1979 REAL(kind=dp), INTENT(IN) :: wkp
1980
1981 CHARACTER(LEN=*), PARAMETER :: routinen = 'transform_dmat'
1982
1983 INTEGER :: handle, iatom, icell, icol, irow, jatom, &
1984 nimg
1985 INTEGER, DIMENSION(3) :: cell
1986 LOGICAL :: do_symmetric, found
1987 REAL(kind=dp) :: arg, coskl, fc, sinkl
1988 REAL(kind=dp), DIMENSION(:, :), POINTER :: cblock, dblock, rblock
1989 TYPE(neighbor_list_iterator_p_type), &
1990 DIMENSION(:), POINTER :: nl_iterator
1991
1992 CALL timeset(routinen, handle)
1993
1994 nimg = SIZE(denmat, 2)
1995
1996 ! transformation
1997 CALL get_neighbor_list_set_p(neighbor_list_sets=sab_nl, symmetric=do_symmetric)
1998 CALL neighbor_list_iterator_create(nl_iterator, sab_nl)
1999 DO WHILE (neighbor_list_iterate(nl_iterator) == 0)
2000 CALL get_iterator_info(nl_iterator, iatom=iatom, jatom=jatom, cell=cell)
2001
2002 !We have a FT from KP to real-space: S(R) = sum_k S(k)*exp(-i*k*R), with S(k) a complex number
2003 !Therefore, we have: S(R) = sum_k Re(S(k))*cos(k*R) -i^2*Im(S(k))*sin(k*R)
2004 ! = sum_k Re(S(k))*cos(k*R) + Im(S(k))*sin(k*R)
2005 !fc = +- 1 is due to the usual non-symmetric real-space matrices stored as symmetric ones
2006
2007 irow = iatom
2008 icol = jatom
2009 fc = 1.0_dp
2010 IF (do_symmetric .AND. iatom > jatom) THEN
2011 irow = jatom
2012 icol = iatom
2013 fc = -1.0_dp
2014 END IF
2015
2016 icell = cell_to_index(cell(1), cell(2), cell(3))
2017 IF (icell < 1 .OR. icell > nimg) cycle
2018
2019 arg = real(cell(1), dp)*xkp(1) + real(cell(2), dp)*xkp(2) + real(cell(3), dp)*xkp(3)
2020 coskl = wkp*cos(twopi*arg)
2021 sinkl = wkp*fc*sin(twopi*arg)
2022
2023 CALL dbcsr_get_block_p(matrix=denmat(ispin, icell)%matrix, row=irow, col=icol, &
2024 block=dblock, found=found)
2025 IF (.NOT. found) cycle
2026
2027 IF (real_only) THEN
2028 CALL dbcsr_get_block_p(matrix=rpmat, row=irow, col=icol, block=rblock, found=found)
2029 IF (.NOT. found) cycle
2030 dblock = dblock + coskl*rblock
2031 ELSE
2032 CALL dbcsr_get_block_p(matrix=rpmat, row=irow, col=icol, block=rblock, found=found)
2033 IF (.NOT. found) cycle
2034 CALL dbcsr_get_block_p(matrix=cpmat, row=irow, col=icol, block=cblock, found=found)
2035 IF (.NOT. found) cycle
2036 dblock = dblock + coskl*rblock
2037 dblock = dblock + sinkl*cblock
2038 END IF
2039 END DO
2040 CALL neighbor_list_iterator_release(nl_iterator)
2041
2042 CALL timestop(handle)
2043
2044 END SUBROUTINE transform_dmat
2045
2046! **************************************************************************************************
2047!> \brief Allocate a dense work matrix with the requested shape
2048!> \param work dense work matrix
2049!> \param nrow number of rows
2050!> \param ncol number of columns
2051! **************************************************************************************************
2052 SUBROUTINE ensure_work_matrix(work, nrow, ncol)
2053
2054 REAL(kind=dp), ALLOCATABLE, DIMENSION(:, :), &
2055 INTENT(INOUT) :: work
2056 INTEGER, INTENT(IN) :: nrow, ncol
2057
2058 IF (ALLOCATED(work)) THEN
2059 IF (SIZE(work, 1) == nrow .AND. SIZE(work, 2) == ncol) RETURN
2060 DEALLOCATE (work)
2061 END IF
2062 ALLOCATE (work(nrow, ncol))
2063
2064 END SUBROUTINE ensure_work_matrix
2065
2066! **************************************************************************************************
2067!> \brief Symmetrize a complex k-point matrix including Bloch phase shifts
2068!> \param srpmat real part of transformed matrix
2069!> \param scpmat imaginary part of transformed matrix
2070!> \param rpmat real part of reference matrix
2071!> \param cpmat imaginary part of reference matrix
2072!> \param real_only ...
2073!> \param kmat kind type rotation matrix
2074!> \param rot rotation matrix
2075!> \param f0 atom permutation
2076!> \param fcell atom cell shifts generated by the symmetry operation
2077!> \param atype atom to kind pointer
2078!> \param xkp target k-point coordinates
2079!> \param time_reversal ...
2080!> \param reverse_phase ...
2081! **************************************************************************************************
2082 SUBROUTINE symtrans_phase(srpmat, scpmat, rpmat, cpmat, real_only, kmat, rot, f0, fcell, atype, &
2083 xkp, time_reversal, reverse_phase)
2084
2085 TYPE(dbcsr_type), POINTER :: srpmat, scpmat, rpmat, cpmat
2086 LOGICAL, INTENT(IN) :: real_only
2087 TYPE(kind_rotmat_type), DIMENSION(:), POINTER :: kmat
2088 REAL(kind=dp), DIMENSION(3, 3), INTENT(IN) :: rot
2089 INTEGER, DIMENSION(:), INTENT(IN) :: f0
2090 INTEGER, DIMENSION(:, :), INTENT(IN) :: fcell
2091 INTEGER, DIMENSION(:), INTENT(IN) :: atype
2092 REAL(kind=dp), DIMENSION(3), INTENT(IN) :: xkp
2093 LOGICAL, INTENT(IN) :: time_reversal, reverse_phase
2094
2095 CHARACTER(LEN=*), PARAMETER :: routinen = 'symtrans_phase'
2096
2097 INTEGER :: handle, iatom, icol, ikind, ip, irow, &
2098 jcol, jkind, jp, jrow, mynode, natom, &
2099 numnodes, owner
2100 INTEGER, DIMENSION(3) :: shift
2101 LOGICAL :: dorot, found, has_phase, perm, trans
2102 REAL(kind=dp) :: arg, coskl, dr, sinkl
2103 REAL(kind=dp), ALLOCATABLE, DIMENSION(:, :) :: cwork, rwork, twork
2104 REAL(kind=dp), DIMENSION(:, :), POINTER :: cblock, kroti, krotj, rblock, scblock, &
2105 srblock
2106 TYPE(dbcsr_distribution_type) :: dist
2107 TYPE(dbcsr_iterator_type) :: iter
2108
2109 CALL timeset(routinen, handle)
2110
2111 natom = SIZE(f0)
2112 perm = .false.
2113 DO iatom = 1, natom
2114 IF (f0(iatom) == iatom) cycle
2115 perm = .true.
2116 EXIT
2117 END DO
2118
2119 dorot = .false.
2120 IF (abs(sum(abs(rot)) - 3.0_dp) > 1.e-12_dp) dorot = .true.
2121 dr = abs(rot(1, 1) - 1.0_dp) + abs(rot(2, 2) - 1.0_dp) + abs(rot(3, 3) - 1.0_dp)
2122 IF (abs(dr) > 1.e-12_dp) dorot = .true.
2123 has_phase = any(fcell /= 0) .OR. time_reversal
2124
2125 IF (.NOT. (dorot .OR. perm .OR. has_phase)) THEN
2126 CALL dbcsr_copy(srpmat, rpmat)
2127 IF (.NOT. real_only) CALL dbcsr_copy(scpmat, cpmat)
2128 CALL timestop(handle)
2129 RETURN
2130 END IF
2131
2132 CALL dbcsr_get_info(rpmat, distribution=dist)
2133 CALL dbcsr_distribution_get(dist, mynode=mynode, numnodes=numnodes)
2134 IF (numnodes /= 1 .AND. (perm .OR. has_phase)) THEN
2135 CALL dbcsr_replicate_all(rpmat)
2136 IF (.NOT. real_only) CALL dbcsr_replicate_all(cpmat)
2137 END IF
2138
2139 CALL dbcsr_set(srpmat, 0.0_dp)
2140 IF (.NOT. real_only) CALL dbcsr_set(scpmat, 0.0_dp)
2141
2142 CALL dbcsr_iterator_start(iter, rpmat)
2143 DO WHILE (dbcsr_iterator_blocks_left(iter))
2144 CALL dbcsr_iterator_next_block(iter, irow, icol, rblock)
2145 IF (.NOT. ALLOCATED(rwork)) THEN
2146 ALLOCATE (rwork(SIZE(rblock, 1), SIZE(rblock, 2)))
2147 ELSEIF (SIZE(rwork, 1) /= SIZE(rblock, 1) .OR. SIZE(rwork, 2) /= SIZE(rblock, 2)) THEN
2148 DEALLOCATE (rwork)
2149 ALLOCATE (rwork(SIZE(rblock, 1), SIZE(rblock, 2)))
2150 END IF
2151 IF (.NOT. real_only) THEN
2152 IF (.NOT. ALLOCATED(cwork)) THEN
2153 ALLOCATE (cwork(SIZE(rblock, 1), SIZE(rblock, 2)))
2154 ELSEIF (SIZE(cwork, 1) /= SIZE(rblock, 1) .OR. SIZE(cwork, 2) /= SIZE(rblock, 2)) THEN
2155 DEALLOCATE (cwork)
2156 ALLOCATE (cwork(SIZE(rblock, 1), SIZE(rblock, 2)))
2157 END IF
2158 END IF
2159
2160 ikind = atype(irow)
2161 jkind = atype(icol)
2162 kroti => kmat(ikind)%rmat
2163 krotj => kmat(jkind)%rmat
2164
2165 IF (reverse_phase) THEN
2166 shift = fcell(1:3, irow) - fcell(1:3, icol)
2167 ELSE
2168 shift = fcell(1:3, icol) - fcell(1:3, irow)
2169 END IF
2170 arg = real(shift(1), dp)*xkp(1) + real(shift(2), dp)*xkp(2) + real(shift(3), dp)*xkp(3)
2171 ! The Bloch phase depends only on the mapped atom-cell shifts and the target k-point.
2172 coskl = cos(twopi*arg)
2173 sinkl = sin(twopi*arg)
2174 IF (real_only) THEN
2175 IF (abs(sinkl) > 1.e-12_dp) THEN
2176 CALL cp_abort(__location__, "Real k-point wavefunctions cannot represent symmetry phases")
2177 END IF
2178 rwork(:, :) = coskl*rblock
2179 ELSE
2180 CALL dbcsr_get_block_p(matrix=cpmat, row=irow, col=icol, block=cblock, found=found)
2181 rwork(:, :) = coskl*rblock
2182 IF (time_reversal) THEN
2183 cwork(:, :) = -sinkl*rblock
2184 IF (found) THEN
2185 rwork(:, :) = rwork - sinkl*cblock
2186 cwork(:, :) = cwork - coskl*cblock
2187 END IF
2188 ELSE
2189 cwork(:, :) = -sinkl*rblock
2190 IF (found) THEN
2191 rwork(:, :) = rwork + sinkl*cblock
2192 cwork(:, :) = cwork + coskl*cblock
2193 END IF
2194 END IF
2195 END IF
2196
2197 ip = f0(irow)
2198 jp = f0(icol)
2199 IF (ip <= jp) THEN
2200 jrow = ip
2201 jcol = jp
2202 trans = .false.
2203 ELSE
2204 jrow = jp
2205 jcol = ip
2206 trans = .true.
2207 END IF
2208
2209 CALL dbcsr_get_block_p(matrix=srpmat, row=jrow, col=jcol, block=srblock, found=found)
2210 IF (.NOT. found) THEN
2211 CALL dbcsr_get_stored_coordinates(srpmat, jrow, jcol, owner)
2212 cpassert(owner /= mynode)
2213 cycle
2214 END IF
2215 IF (trans) THEN
2216 CALL ensure_work_matrix(twork, SIZE(krotj, 1), SIZE(rwork, 1))
2217 CALL dgemm('N', 'T', SIZE(krotj, 1), SIZE(rwork, 1), SIZE(krotj, 2), &
2218 1.0_dp, krotj, SIZE(krotj, 1), rwork, SIZE(rwork, 1), &
2219 0.0_dp, twork, SIZE(twork, 1))
2220 CALL dgemm('N', 'T', SIZE(twork, 1), SIZE(kroti, 1), SIZE(twork, 2), &
2221 1.0_dp, twork, SIZE(twork, 1), kroti, SIZE(kroti, 1), &
2222 1.0_dp, srblock, SIZE(srblock, 1))
2223 ELSE
2224 CALL ensure_work_matrix(twork, SIZE(kroti, 1), SIZE(rwork, 2))
2225 CALL dgemm('N', 'N', SIZE(kroti, 1), SIZE(rwork, 2), SIZE(kroti, 2), &
2226 1.0_dp, kroti, SIZE(kroti, 1), rwork, SIZE(rwork, 1), &
2227 0.0_dp, twork, SIZE(twork, 1))
2228 CALL dgemm('N', 'T', SIZE(twork, 1), SIZE(krotj, 1), SIZE(twork, 2), &
2229 1.0_dp, twork, SIZE(twork, 1), krotj, SIZE(krotj, 1), &
2230 1.0_dp, srblock, SIZE(srblock, 1))
2231 END IF
2232
2233 IF (.NOT. real_only) THEN
2234 CALL dbcsr_get_block_p(matrix=scpmat, row=jrow, col=jcol, block=scblock, found=found)
2235 cpassert(found)
2236 IF (trans) THEN
2237 CALL ensure_work_matrix(twork, SIZE(krotj, 1), SIZE(cwork, 1))
2238 CALL dgemm('N', 'T', SIZE(krotj, 1), SIZE(cwork, 1), SIZE(krotj, 2), &
2239 1.0_dp, krotj, SIZE(krotj, 1), cwork, SIZE(cwork, 1), &
2240 0.0_dp, twork, SIZE(twork, 1))
2241 CALL dgemm('N', 'T', SIZE(twork, 1), SIZE(kroti, 1), SIZE(twork, 2), &
2242 -1.0_dp, twork, SIZE(twork, 1), kroti, SIZE(kroti, 1), &
2243 1.0_dp, scblock, SIZE(scblock, 1))
2244 ELSE
2245 CALL ensure_work_matrix(twork, SIZE(kroti, 1), SIZE(cwork, 2))
2246 CALL dgemm('N', 'N', SIZE(kroti, 1), SIZE(cwork, 2), SIZE(kroti, 2), &
2247 1.0_dp, kroti, SIZE(kroti, 1), cwork, SIZE(cwork, 1), &
2248 0.0_dp, twork, SIZE(twork, 1))
2249 CALL dgemm('N', 'T', SIZE(twork, 1), SIZE(krotj, 1), SIZE(twork, 2), &
2250 1.0_dp, twork, SIZE(twork, 1), krotj, SIZE(krotj, 1), &
2251 1.0_dp, scblock, SIZE(scblock, 1))
2252 END IF
2253 END IF
2254 END DO
2255 CALL dbcsr_iterator_stop(iter)
2256 IF (numnodes /= 1 .AND. (perm .OR. has_phase)) THEN
2257 CALL dbcsr_distribute(rpmat)
2258 IF (.NOT. real_only) CALL dbcsr_distribute(cpmat)
2259 END IF
2260
2261 CALL timestop(handle)
2262
2263 END SUBROUTINE symtrans_phase
2264
2265! **************************************************************************************************
2266!> \brief Symmetrization of density matrix - transform to new k-point
2267!> \param smat density matrix at new kpoint
2268!> \param pmat reference density matrix
2269!> \param kmat Kind type rotation matrix
2270!> \param rot Rotation matrix
2271!> \param f0 Permutation of atoms under transformation
2272!> \param atype Atom to kind pointer
2273!> \param symmetric Symmetric matrix
2274!> \param antisymmetric Anti-Symmetric matrix
2275! **************************************************************************************************
2276 SUBROUTINE symtrans(smat, pmat, kmat, rot, f0, atype, symmetric, antisymmetric)
2277 TYPE(dbcsr_type), POINTER :: smat, pmat
2278 TYPE(kind_rotmat_type), DIMENSION(:), POINTER :: kmat
2279 REAL(kind=dp), DIMENSION(3, 3), INTENT(IN) :: rot
2280 INTEGER, DIMENSION(:), INTENT(IN) :: f0, atype
2281 LOGICAL, INTENT(IN), OPTIONAL :: symmetric, antisymmetric
2282
2283 CHARACTER(LEN=*), PARAMETER :: routinen = 'symtrans'
2284
2285 INTEGER :: handle, iatom, icol, ikind, ip, irow, &
2286 jcol, jkind, jp, jrow, natom, numnodes
2287 LOGICAL :: asym, dorot, found, perm, sym, trans
2288 REAL(kind=dp) :: dr, fsign
2289 REAL(kind=dp), ALLOCATABLE, DIMENSION(:, :) :: work
2290 REAL(kind=dp), DIMENSION(:, :), POINTER :: kroti, krotj, pblock, sblock
2291 TYPE(dbcsr_distribution_type) :: dist
2292 TYPE(dbcsr_iterator_type) :: iter
2293
2294 CALL timeset(routinen, handle)
2295
2296 ! check symmetry options
2297 sym = .false.
2298 IF (PRESENT(symmetric)) sym = symmetric
2299 asym = .false.
2300 IF (PRESENT(antisymmetric)) asym = antisymmetric
2301
2302 cpassert(.NOT. (sym .AND. asym))
2303 cpassert((sym .OR. asym))
2304
2305 ! do we have permutation of atoms
2306 natom = SIZE(f0)
2307 perm = .false.
2308 DO iatom = 1, natom
2309 IF (f0(iatom) == iatom) cycle
2310 perm = .true.
2311 EXIT
2312 END DO
2313
2314 ! do we have a real rotation
2315 dorot = .false.
2316 IF (abs(sum(abs(rot)) - 3.0_dp) > 1.e-12_dp) dorot = .true.
2317 dr = abs(rot(1, 1) - 1.0_dp) + abs(rot(2, 2) - 1.0_dp) + abs(rot(3, 3) - 1.0_dp)
2318 IF (abs(dr) > 1.e-12_dp) dorot = .true.
2319
2320 fsign = 1.0_dp
2321 IF (asym) fsign = -1.0_dp
2322
2323 IF (dorot .OR. perm) THEN
2324 CALL cp_abort(__location__, "k-points need FULL_GRID currently. "// &
2325 "Reduced grids not yet working correctly")
2326 CALL dbcsr_set(smat, 0.0_dp)
2327 IF (perm) THEN
2328 CALL dbcsr_get_info(pmat, distribution=dist)
2329 CALL dbcsr_distribution_get(dist, numnodes=numnodes)
2330 IF (numnodes == 1) THEN
2331 ! the matrices are local to this process
2332 CALL dbcsr_iterator_start(iter, pmat)
2333 DO WHILE (dbcsr_iterator_blocks_left(iter))
2334 CALL dbcsr_iterator_next_block(iter, irow, icol, pblock)
2335 ip = f0(irow)
2336 jp = f0(icol)
2337 IF (ip <= jp) THEN
2338 jrow = ip
2339 jcol = jp
2340 trans = .false.
2341 ELSE
2342 jrow = jp
2343 jcol = ip
2344 trans = .true.
2345 END IF
2346 CALL dbcsr_get_block_p(matrix=smat, row=jrow, col=jcol, block=sblock, found=found)
2347 cpassert(found)
2348 ikind = atype(irow)
2349 jkind = atype(icol)
2350 kroti => kmat(ikind)%rmat
2351 krotj => kmat(jkind)%rmat
2352 ! rotation
2353 IF (trans) THEN
2354 CALL ensure_work_matrix(work, SIZE(krotj, 2), SIZE(pblock, 1))
2355 CALL dgemm('T', 'T', SIZE(krotj, 2), SIZE(pblock, 1), SIZE(krotj, 1), &
2356 1.0_dp, krotj, SIZE(krotj, 1), pblock, SIZE(pblock, 1), &
2357 0.0_dp, work, SIZE(work, 1))
2358 CALL dgemm('N', 'N', SIZE(work, 1), SIZE(kroti, 2), SIZE(work, 2), &
2359 fsign, work, SIZE(work, 1), kroti, SIZE(kroti, 1), &
2360 0.0_dp, sblock, SIZE(sblock, 1))
2361 ELSE
2362 CALL ensure_work_matrix(work, SIZE(kroti, 2), SIZE(pblock, 2))
2363 CALL dgemm('T', 'N', SIZE(kroti, 2), SIZE(pblock, 2), SIZE(kroti, 1), &
2364 1.0_dp, kroti, SIZE(kroti, 1), pblock, SIZE(pblock, 1), &
2365 0.0_dp, work, SIZE(work, 1))
2366 CALL dgemm('N', 'N', SIZE(work, 1), SIZE(krotj, 2), SIZE(work, 2), &
2367 fsign, work, SIZE(work, 1), krotj, SIZE(krotj, 1), &
2368 0.0_dp, sblock, SIZE(sblock, 1))
2369 END IF
2370 END DO
2371 CALL dbcsr_iterator_stop(iter)
2372 !
2373 ELSE
2374 ! distributed matrices, most general code needed
2375 CALL cp_abort(__location__, "k-points need FULL_GRID currently. "// &
2376 "Reduced grids not yet working correctly")
2377 END IF
2378 ELSE
2379 ! no atom permutations, this is always local
2380 CALL dbcsr_copy(smat, pmat)
2381 CALL dbcsr_iterator_start(iter, smat)
2382 DO WHILE (dbcsr_iterator_blocks_left(iter))
2383 CALL dbcsr_iterator_next_block(iter, irow, icol, sblock)
2384 ip = f0(irow)
2385 jp = f0(icol)
2386 IF (ip <= jp) THEN
2387 jrow = ip
2388 jcol = jp
2389 trans = .false.
2390 ELSE
2391 jrow = jp
2392 jcol = ip
2393 trans = .true.
2394 END IF
2395 ikind = atype(irow)
2396 jkind = atype(icol)
2397 kroti => kmat(ikind)%rmat
2398 krotj => kmat(jkind)%rmat
2399 ! rotation
2400 IF (trans) THEN
2401 CALL ensure_work_matrix(work, SIZE(krotj, 2), SIZE(sblock, 1))
2402 CALL dgemm('T', 'T', SIZE(krotj, 2), SIZE(sblock, 1), SIZE(krotj, 1), &
2403 1.0_dp, krotj, SIZE(krotj, 1), sblock, SIZE(sblock, 1), &
2404 0.0_dp, work, SIZE(work, 1))
2405 CALL dgemm('N', 'N', SIZE(work, 1), SIZE(kroti, 2), SIZE(work, 2), &
2406 fsign, work, SIZE(work, 1), kroti, SIZE(kroti, 1), &
2407 0.0_dp, sblock, SIZE(sblock, 1))
2408 ELSE
2409 CALL ensure_work_matrix(work, SIZE(kroti, 2), SIZE(sblock, 2))
2410 CALL dgemm('T', 'N', SIZE(kroti, 2), SIZE(sblock, 2), SIZE(kroti, 1), &
2411 1.0_dp, kroti, SIZE(kroti, 1), sblock, SIZE(sblock, 1), &
2412 0.0_dp, work, SIZE(work, 1))
2413 CALL dgemm('N', 'N', SIZE(work, 1), SIZE(krotj, 2), SIZE(work, 2), &
2414 fsign, work, SIZE(work, 1), krotj, SIZE(krotj, 1), &
2415 0.0_dp, sblock, SIZE(sblock, 1))
2416 END IF
2417 END DO
2418 CALL dbcsr_iterator_stop(iter)
2419 !
2420 END IF
2421 ELSE
2422 ! this is the identity operation, just copy the matrix
2423 CALL dbcsr_copy(smat, pmat)
2424 END IF
2425
2426 CALL timestop(handle)
2427
2428 END SUBROUTINE symtrans
2429
2430! **************************************************************************************************
2431!> \brief ...
2432!> \param mat ...
2433! **************************************************************************************************
2434 SUBROUTINE matprint(mat)
2435 TYPE(dbcsr_type), POINTER :: mat
2436
2437 INTEGER :: i, icol, iounit, irow
2438 REAL(kind=dp), DIMENSION(:, :), POINTER :: mblock
2439 TYPE(dbcsr_iterator_type) :: iter
2440
2441 iounit = cp_logger_get_default_io_unit()
2442 CALL dbcsr_iterator_start(iter, mat)
2443 DO WHILE (dbcsr_iterator_blocks_left(iter))
2444 CALL dbcsr_iterator_next_block(iter, irow, icol, mblock)
2445 !
2446 IF (iounit > 0) THEN
2447 WRITE (iounit, '(A,2I4)') 'BLOCK ', irow, icol
2448 DO i = 1, SIZE(mblock, 1)
2449 WRITE (iounit, '(8F12.6)') mblock(i, :)
2450 END DO
2451 END IF
2452 !
2453 END DO
2454 CALL dbcsr_iterator_stop(iter)
2455
2456 END SUBROUTINE matprint
2457! **************************************************************************************************
2458
2459END MODULE kpoint_methods
dgemm
static void dgemm(const char transa, const char transb, const int m, const int n, const int k, const double alpha, const double *a, const int lda, const double *b, const int ldb, const double beta, double *c, const int ldc)
Convenient wrapper to hide Fortran nature of dgemm_, swapping a and b.
Definition grid_cpu_task_list.c:225
cp_dbcsr_api::dbcsr_create
Definition cp_dbcsr_api.F:194
cp_fm_types::cp_fm_release
Definition cp_fm_types.F:88
cp_fm_types::cp_fm_to_fm
Definition cp_fm_types.F:83
memory_utilities::reallocate
Definition memory_utilities.F:27
parallel_gemm_api::parallel_gemm
Definition parallel_gemm_api.F:39
atomic_kind_types
Define the atomic kind types and their sub types.
Definition atomic_kind_types.F:23
atomic_kind_types::get_atomic_kind
subroutine, public get_atomic_kind(atomic_kind, fist_potential, element_symbol, name, mass, kind_number, natom, atom_list, rcov, rvdw, z, qeff, apol, cpol, mm_radius, shell, shell_active, damping)
Get attributes of an atomic kind.
Definition atomic_kind_types.F:138
cell_types
Handles all functions related to the CELL.
Definition cell_types.F:15
cell_types::real_to_scaled
subroutine, public real_to_scaled(s, r, cell)
Transform real to scaled cell coordinates. s=h_inv*r.
Definition cell_types.F:535
cp_blacs_env
methods related to the blacs parallel environment
Definition cp_blacs_env.F:15
cp_blacs_env::cp_blacs_env_create
subroutine, public cp_blacs_env_create(blacs_env, para_env, blacs_grid_layout, blacs_repeatable, row_major, grid_2d)
allocates and initializes a type that represent a blacs context
Definition cp_blacs_env.F:123
cp_cfm_types
Represents a complex full matrix distributed on many processors.
Definition cp_cfm_types.F:12
cp_cfm_types::cp_cfm_release
subroutine, public cp_cfm_release(matrix)
Releases a full matrix.
Definition cp_cfm_types.F:182
cp_cfm_types::cp_fm_to_cfm
subroutine, public cp_fm_to_cfm(msourcer, msourcei, mtarget)
Construct a complex full matrix by taking its real and imaginary parts from two separate real-value f...
Definition cp_cfm_types.F:840
cp_cfm_types::cp_cfm_create
subroutine, public cp_cfm_create(matrix, matrix_struct, name, nrow, ncol, set_zero)
Creates a new full matrix with the given structure.
Definition cp_cfm_types.F:125
cp_cfm_types::cp_cfm_get_info
subroutine, public cp_cfm_get_info(matrix, name, nrow_global, ncol_global, nrow_block, ncol_block, nrow_local, ncol_local, row_indices, col_indices, local_data, context, matrix_struct, para_env)
Returns information about a full matrix.
Definition cp_cfm_types.F:630
cp_cfm_types::cp_cfm_to_fm
subroutine, public cp_cfm_to_fm(msource, mtargetr, mtargeti)
Copy real and imaginary parts of a complex full matrix into separate real-value full matrices.
Definition cp_cfm_types.F:788
cp_control_types
Defines control structures, which contain the parameters and the settings for the DFT-based calculati...
Definition cp_control_types.F:12
cp_dbcsr_api
Definition cp_dbcsr_api.F:8
cp_dbcsr_api::dbcsr_deallocate_matrix
subroutine, public dbcsr_deallocate_matrix(matrix)
...
Definition cp_dbcsr_api.F:235
cp_dbcsr_api::dbcsr_iterator_blocks_left
logical function, public dbcsr_iterator_blocks_left(iterator)
...
Definition cp_dbcsr_api.F:943
cp_dbcsr_api::dbcsr_iterator_stop
subroutine, public dbcsr_iterator_stop(iterator)
...
Definition cp_dbcsr_api.F:1049
cp_dbcsr_api::dbcsr_copy
subroutine, public dbcsr_copy(matrix_b, matrix_a, name, keep_sparsity, keep_imaginary)
...
Definition cp_dbcsr_api.F:370
cp_dbcsr_api::dbcsr_get_block_p
subroutine, public dbcsr_get_block_p(matrix, row, col, block, found, row_size, col_size)
...
Definition cp_dbcsr_api.F:692
cp_dbcsr_api::dbcsr_replicate_all
subroutine, public dbcsr_replicate_all(matrix)
...
Definition cp_dbcsr_api.F:1155
cp_dbcsr_api::dbcsr_get_info
subroutine, public dbcsr_get_info(matrix, nblkrows_total, nblkcols_total, nfullrows_total, nfullcols_total, nblkrows_local, nblkcols_local, nfullrows_local, nfullcols_local, my_prow, my_pcol, local_rows, local_cols, proc_row_dist, proc_col_dist, row_blk_size, col_blk_size, row_blk_offset, col_blk_offset, distribution, name, matrix_type, group)
...
Definition cp_dbcsr_api.F:807
cp_dbcsr_api::dbcsr_get_stored_coordinates
subroutine, public dbcsr_get_stored_coordinates(matrix, row, column, processor)
...
Definition cp_dbcsr_api.F:910
cp_dbcsr_api::dbcsr_distribute
subroutine, public dbcsr_distribute(matrix)
...
Definition cp_dbcsr_api.F:539
cp_dbcsr_api::dbcsr_iterator_next_block
subroutine, public dbcsr_iterator_next_block(iterator, row, column, block, block_number_argument_has_been_removed, row_size, col_size, row_offset, col_offset, transposed)
...
Definition cp_dbcsr_api.F:970
cp_dbcsr_api::dbcsr_iterator_start
subroutine, public dbcsr_iterator_start(iterator, matrix, shared, dynamic, dynamic_byrows)
...
Definition cp_dbcsr_api.F:1011
cp_dbcsr_api::dbcsr_set
subroutine, public dbcsr_set(matrix, alpha)
...
Definition cp_dbcsr_api.F:1203
cp_dbcsr_api::dbcsr_distribution_get
subroutine, public dbcsr_distribution_get(dist, row_dist, col_dist, nrows, ncols, has_threads, group, mynode, numnodes, nprows, npcols, myprow, mypcol, pgrid, subgroups_defined, prow_group, pcol_group)
...
Definition cp_dbcsr_api.F:571
cp_dbcsr_cp2k_link
Routines that link DBCSR and CP2K concepts together.
Definition cp_dbcsr_cp2k_link.F:14
cp_dbcsr_cp2k_link::cp_dbcsr_alloc_block_from_nbl
subroutine, public cp_dbcsr_alloc_block_from_nbl(matrix, sab_orb, desymmetrize)
allocate the blocks of a dbcsr based on the neighbor list
Definition cp_dbcsr_cp2k_link.F:445
cp_dbcsr_operations
DBCSR operations in CP2K.
Definition cp_dbcsr_operations.F:18
cp_dbcsr_operations::copy_fm_to_dbcsr
subroutine, public copy_fm_to_dbcsr(fm, matrix, keep_sparsity)
Copy a BLACS matrix to a dbcsr matrix.
Definition cp_dbcsr_operations.F:111
cp_fm_basic_linalg
Basic linear algebra operations for full matrices.
Definition cp_fm_basic_linalg.F:14
cp_fm_basic_linalg::cp_fm_column_scale
subroutine, public cp_fm_column_scale(matrixa, scaling)
scales column i of matrix a with scaling(i)
Definition cp_fm_basic_linalg.F:1690
cp_fm_pool_types
pool for for elements that are retained and released
Definition cp_fm_pool_types.F:14
cp_fm_pool_types::fm_pool_create_fm
subroutine, public fm_pool_create_fm(pool, element, name)
returns an element, allocating it if none is in the pool
Definition cp_fm_pool_types.F:185
cp_fm_pool_types::fm_pool_give_back_fm
subroutine, public fm_pool_give_back_fm(pool, element)
returns the element to the pool
Definition cp_fm_pool_types.F:224
cp_fm_struct
represent the structure of a full matrix
Definition cp_fm_struct.F:14
cp_fm_types
represent a full matrix distributed on many processors
Definition cp_fm_types.F:15
cp_fm_types::cp_fm_get_diag
subroutine, public cp_fm_get_diag(matrix, diag)
returns the diagonal elements of a fm
Definition cp_fm_types.F:563
cp_fm_types::cp_fm_start_copy_general
subroutine, public cp_fm_start_copy_general(source, destination, para_env, info)
Initiates the copy operation: get distribution data, post MPI isend and irecvs.
Definition cp_fm_types.F:1548
cp_fm_types::cp_fm_cleanup_copy_general
subroutine, public cp_fm_cleanup_copy_general(info)
Completes the copy operation: wait for comms clean up MPI state.
Definition cp_fm_types.F:1922
cp_fm_types::cp_fm_get_info
subroutine, public cp_fm_get_info(matrix, name, nrow_global, ncol_global, nrow_block, ncol_block, nrow_local, ncol_local, row_indices, col_indices, local_data, context, nrow_locals, ncol_locals, matrix_struct, para_env)
returns all kind of information about the full matrix
Definition cp_fm_types.F:1037
cp_fm_types::cp_fm_create
subroutine, public cp_fm_create(matrix, matrix_struct, name, nrow, ncol, set_zero)
creates a new full matrix with the given structure
Definition cp_fm_types.F:165
cp_fm_types::cp_fm_finish_copy_general
subroutine, public cp_fm_finish_copy_general(destination, info)
Completes the copy operation: wait for comms, unpack, clean up MPI state.
Definition cp_fm_types.F:1858
cp_fm_types::cp_fm_get_submatrix
subroutine, public cp_fm_get_submatrix(fm, target_m, start_row, start_col, n_rows, n_cols, transpose)
gets a submatrix of a full matrix op(target_m)(1:n_rows,1:n_cols) =fm(start_row:start_row+n_rows,...
Definition cp_fm_types.F:924
cp_log_handling
various routines to log and control the output. The idea is that decisions about where to log should ...
Definition cp_log_handling.F:41
cp_log_handling::cp_logger_get_default_io_unit
integer function, public cp_logger_get_default_io_unit(logger)
returns the unit nr for the ionode (-1 on all other processors) skips as well checks if the procs cal...
Definition cp_log_handling.F:515
cryssym
K-points and crystal symmetry routines.
Definition cryssym.F:12
cryssym::print_crys_symmetry
subroutine, public print_crys_symmetry(csym)
...
Definition cryssym.F:1886
cryssym::kpoint_gen
subroutine, public kpoint_gen(csym, nk, symm, shift, full_grid, gamma_centered, inversion_symmetry_only, use_spglib_reduction, use_spglib_backend)
...
Definition cryssym.F:253
cryssym::release_csym_type
subroutine, public release_csym_type(csym)
Release the CSYM type.
Definition cryssym.F:90
cryssym::kpoint_gen_general
subroutine, public kpoint_gen_general(csym, xkp_in, wkp_in, symm, full_grid, inversion_symmetry_only, use_spglib_reduction, use_spglib_backend)
Reduce an explicitly supplied GENERAL k-point set.
Definition cryssym.F:462
cryssym::print_kp_symmetry
subroutine, public print_kp_symmetry(csym)
...
Definition cryssym.F:1923
cryssym::crys_sym_gen
subroutine, public crys_sym_gen(csym, scoor, types, hmat, delta, iounit, use_spglib)
...
Definition cryssym.F:145
hairy_probes
Definition hairy_probes.F:8
hairy_probes::probe_occupancy_kp
subroutine, public probe_occupancy_kp(occ, fermi, kts, energies, rcoeff, icoeff, maxocc, probe, n, wk)
subroutine to calculate occupation number and 'Fermi' level using the
Definition hairy_probes.F:194
input_constants
collects all constants needed in input so that they can be used without circular dependencies
Definition input_constants.F:18
input_constants::smear_fermi_dirac
integer, parameter, public smear_fermi_dirac
Definition input_constants.F:928
input_constants::smear_gaussian
integer, parameter, public smear_gaussian
Definition input_constants.F:928
input_constants::smear_mv
integer, parameter, public smear_mv
Definition input_constants.F:928
input_constants::smear_mp
integer, parameter, public smear_mp
Definition input_constants.F:928
input_cp2k_kpoints
function that build the kpoints section of the input
Definition input_cp2k_kpoints.F:14
input_cp2k_kpoints::use_spglib_kpoint_symmetry
integer, parameter, public use_spglib_kpoint_symmetry
Definition input_cp2k_kpoints.F:37
input_cp2k_kpoints::use_real_wfn
integer, parameter, public use_real_wfn
Definition input_cp2k_kpoints.F:37
input_cp2k_kpoints::use_spglib_kpoint_backend
integer, parameter, public use_spglib_kpoint_backend
Definition input_cp2k_kpoints.F:37
kinds
Defines the basic variable types.
Definition kinds.F:23
kinds::dp
integer, parameter, public dp
Definition kinds.F:34
kpoint_methods
Routines needed for kpoint calculation.
Definition kpoint_methods.F:15
kpoint_methods::lowdin_kp_mo_coeff
subroutine, public lowdin_kp_mo_coeff(kp, ispin, use_real_wfn, shalfc, cshalfc)
Calculate S(k)^1/2 C(k) for real or complex k-point wavefunctions.
Definition kpoint_methods.F:1672
kpoint_methods::kpoint_initialize_mo_set
subroutine, public kpoint_initialize_mo_set(kpoint)
...
Definition kpoint_methods.F:940
kpoint_methods::rskp_transform
subroutine, public rskp_transform(rmatrix, cmatrix, rsmat, ispin, xkp, cell_to_index, sab_nl, is_complex, rs_sign)
Transformation of real space matrices to a kpoint.
Definition kpoint_methods.F:1114
kpoint_methods::kpoint_init_cell_index
subroutine, public kpoint_init_cell_index(kpoint, sab_nl, para_env, nimages)
Generates the mapping of cell indices and linear RS index CELL (0,0,0) is always mapped to index 1.
Definition kpoint_methods.F:980
kpoint_methods::kpoint_initialize_mos
subroutine, public kpoint_initialize_mos(kpoint, mos, added_mos, for_aux_fit)
Initialize a set of MOs and density matrix for each kpoint (kpoint group)
Definition kpoint_methods.F:787
kpoint_methods::kpoint_initialize
subroutine, public kpoint_initialize(kpoint, particle_set, cell)
Generate the kpoints and initialize the kpoint environment.
Definition kpoint_methods.F:121
kpoint_methods::kpoint_density_transform
subroutine, public kpoint_density_transform(kpoint, denmat, wtype, tempmat, sab_nl, fmwork, for_aux_fit, pmat_ext)
generate real space density matrices in DBCSR format
Definition kpoint_methods.F:1741
kpoint_methods::kpoint_density_matrices
subroutine, public kpoint_density_matrices(kpoint, energy_weighted, for_aux_fit)
Calculate kpoint density matrices (rho(k), owned by kpoint groups)
Definition kpoint_methods.F:1465
kpoint_methods::lowdin_kp_trans
subroutine, public lowdin_kp_trans(kpoint, pmat_diag)
Calculate Lowdin transformation of density matrix S^1/2 P S^1/2 Integrate diagonal elements over k-po...
Definition kpoint_methods.F:1585
kpoint_methods::kpoint_env_initialize
subroutine, public kpoint_env_initialize(kpoint, para_env, blacs_env, with_aux_fit)
Initialize the kpoint environment.
Definition kpoint_methods.F:599
kpoint_methods::kpoint_set_mo_occupation
subroutine, public kpoint_set_mo_occupation(kpoint, smear, probe)
Given the eigenvalues of all kpoints, calculates the occupation numbers.
Definition kpoint_methods.F:1214
kpoint_types
Types and basic routines needed for a kpoint calculation.
Definition kpoint_types.F:15
kpoint_types::kpoint_sym_create
subroutine, public kpoint_sym_create(kp_sym)
Create a single kpoint symmetry environment.
Definition kpoint_types.F:1132
kpoint_types::kpoint_env_create
subroutine, public kpoint_env_create(kp_env)
Create a single kpoint environment.
Definition kpoint_types.F:1045
kpoint_types::get_kpoint_info
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, inversion_symmetry_only, symmetry_backend, symmetry_reduction_method, gamma_centered)
Retrieve information from a kpoint environment.
Definition kpoint_types.F:525
kpsym
K-points and crystal symmetry routines based on.
Definition kpsym.F:28
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::twopi
real(kind=dp), parameter, public twopi
Definition mathconstants.F:112
mathlib
Collection of simple mathematical functions and subroutines.
Definition mathlib.F:15
mathlib::inv_3x3
pure real(kind=dp) function, dimension(3, 3), public inv_3x3(a)
Returns the inverse of the 3 x 3 matrix a.
Definition mathlib.F:523
memory_utilities
Utility routines for the memory handling.
Definition memory_utilities.F:14
message_passing
Interface to the message passing library MPI.
Definition message_passing.F:23
parallel_gemm_api
basic linear algebra operations for full matrixes
Definition parallel_gemm_api.F:14
particle_types
Define the data structure for the particle information.
Definition particle_types.F:19
qs_matrix_pools
wrapper for the pools of matrixes
Definition qs_matrix_pools.F:14
qs_matrix_pools::mpools_create
subroutine, public mpools_create(mpools)
creates a mpools
Definition qs_matrix_pools.F:184
qs_matrix_pools::mpools_rebuild_fm_pools
subroutine, public mpools_rebuild_fm_pools(mpools, mos, blacs_env, para_env, nmosub)
rebuilds the pools of the (ao x mo, ao x ao , mo x mo) full matrixes
Definition qs_matrix_pools.F:209
qs_matrix_pools::mpools_get
subroutine, public mpools_get(mpools, ao_mo_fm_pools, ao_ao_fm_pools, mo_mo_fm_pools, ao_mosub_fm_pools, mosub_mosub_fm_pools, maxao_maxmo_fm_pool, maxao_maxao_fm_pool, maxmo_maxmo_fm_pool)
returns various attributes of the mpools (notably the pools contained in it)
Definition qs_matrix_pools.F:139
qs_mo_types
Definition and initialisation of the mo data type.
Definition qs_mo_types.F:22
qs_mo_types::set_mo_set
subroutine, public set_mo_set(mo_set, maxocc, homo, lfomo, nao, nelectron, n_el_f, nmo, eigenvalues, occupation_numbers, uniform_occupation, kts, mu, flexible_electron_count)
Set the components of a MO set data structure.
Definition qs_mo_types.F:456
qs_mo_types::init_mo_set
subroutine, public init_mo_set(mo_set, fm_pool, fm_ref, fm_struct, name, counter)
initializes an allocated mo_set. eigenvalues, mo_coeff, occupation_numbers are valid only after this ...
Definition qs_mo_types.F:247
qs_mo_types::allocate_mo_set
subroutine, public allocate_mo_set(mo_set, nao, nmo, nelectron, n_el_f, maxocc, flexible_electron_count)
Allocates a mo set and partially initializes it (nao,nmo,nelectron, and flexible_electron_count are v...
Definition qs_mo_types.F:207
qs_mo_types::get_mo_set
subroutine, public get_mo_set(mo_set, maxocc, homo, lfomo, nao, nelectron, n_el_f, nmo, eigenvalues, occupation_numbers, mo_coeff, mo_coeff_b, uniform_occupation, kts, mu, flexible_electron_count)
Get the components of a MO set data structure.
Definition qs_mo_types.F:401
qs_neighbor_list_types
Define the neighbor list data types and the corresponding functionality.
Definition qs_neighbor_list_types.F:17
qs_neighbor_list_types::neighbor_list_iterator_create
subroutine, public neighbor_list_iterator_create(iterator_set, nl, search, nthread)
Neighbor list iterator functions.
Definition qs_neighbor_list_types.F:165
qs_neighbor_list_types::neighbor_list_iterator_release
subroutine, public neighbor_list_iterator_release(iterator_set)
...
Definition qs_neighbor_list_types.F:251
qs_neighbor_list_types::get_neighbor_list_set_p
subroutine, public get_neighbor_list_set_p(neighbor_list_sets, nlist, symmetric)
Return the components of the first neighbor list set.
Definition qs_neighbor_list_types.F:995
qs_neighbor_list_types::neighbor_list_iterate
integer function, public neighbor_list_iterate(iterator_set, mepos)
...
Definition qs_neighbor_list_types.F:351
qs_neighbor_list_types::get_iterator_info
subroutine, public get_iterator_info(iterator_set, mepos, ikind, jkind, nkind, ilist, nlist, inode, nnode, iatom, jatom, r, cell)
...
Definition qs_neighbor_list_types.F:549
scf_control_types
parameters that control an scf iteration
Definition scf_control_types.F:17
smearing_utils
Unified smearing module supporting four methods: smear_fermi_dirac — Fermi-Dirac distribution smear_g...
Definition smearing_utils.F:24
smearing_utils::smearkp
subroutine, public smearkp(f, mu, kts, e, nel, wk, sigma, maxocc, method)
Bisection search for mu given a target electron count (k-point case, single spin channel or spin-dege...
Definition smearing_utils.F:497
smearing_utils::smearkp2
subroutine, public smearkp2(f, mu, kts, e, nel, wk, sigma, method)
Bisection search for mu (k-point, spin-polarised with a shared chemical potential across both spin ch...
Definition smearing_utils.F:641
util
All kind of helpful little routines.
Definition util.F:14
util::get_limit
pure integer function, dimension(2), public get_limit(m, n, me)
divide m entries into n parts, return size of part me
Definition util.F:333
cell_types::cell_type
Type defining parameters related to the simulation cell.
Definition cell_types.F:60
cp_blacs_env::cp_blacs_env_type
represent a blacs multidimensional parallel environment (for the mpi corrispective see cp_paratypes/m...
Definition cp_blacs_env.F:53
cp_cfm_types::cp_cfm_type
Represent a complex full matrix.
Definition cp_cfm_types.F:69
cp_control_types::hairy_probes_type
Definition cp_control_types.F:48
cp_dbcsr_api::dbcsr_distribution_type
Definition cp_dbcsr_api.F:182
cp_dbcsr_api::dbcsr_iterator_type
Definition cp_dbcsr_api.F:188
cp_dbcsr_api::dbcsr_p_type
Definition cp_dbcsr_api.F:172
cp_dbcsr_api::dbcsr_type
Definition cp_dbcsr_api.F:176
cp_fm_pool_types::cp_fm_pool_p_type
to create arrays of pools
Definition cp_fm_pool_types.F:70
cp_fm_struct::cp_fm_struct_type
keeps the information about the structure of a full matrix
Definition cp_fm_struct.F:82
cp_fm_types::copy_info_type
Stores the state of a copy between cp_fm_start_copy_general and cp_fm_finish_copy_general.
Definition cp_fm_types.F:138
cp_fm_types::cp_fm_type
represent a full matrix
Definition cp_fm_types.F:114
cryssym::csym_type
CSM type.
Definition cryssym.F:44
kpoint_types::kind_rotmat_type
Rotation matrices for basis sets.
Definition kpoint_types.F:106
kpoint_types::kpoint_env_p_type
Definition kpoint_types.F:97
kpoint_types::kpoint_env_type
Keeps information about a specific k-point.
Definition kpoint_types.F:83
kpoint_types::kpoint_sym_type
Keeps symmetry information about a specific k-point.
Definition kpoint_types.F:121
kpoint_types::kpoint_type
Contains information about kpoints.
Definition kpoint_types.F:171
message_passing::mp_cart_type
Definition message_passing.F:720
message_passing::mp_para_env_type
stores all the informations relevant to an mpi environment
Definition message_passing.F:743
particle_types::particle_type
Definition particle_types.F:35
qs_matrix_pools::qs_matrix_pools_type
container for the pools of matrixes used by qs
Definition qs_matrix_pools.F:66
qs_mo_types::mo_set_type
Definition qs_mo_types.F:47
qs_neighbor_list_types::neighbor_list_iterator_p_type
Definition qs_neighbor_list_types.F:117
qs_neighbor_list_types::neighbor_list_set_p_type
Definition qs_neighbor_list_types.F:67
scf_control_types::smear_type
contains the parameters needed by a scf run
Definition scf_control_types.F:92