Line data Source code
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 Types and basic routines needed for a 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 : ! **************************************************************************************************
15 : MODULE kpoint_types
16 : USE cell_types, ONLY: cell_type
17 : USE cp_blacs_env, ONLY: cp_blacs_env_release,&
18 : cp_blacs_env_type
19 : USE cp_cfm_types, ONLY: cp_cfm_release,&
20 : cp_cfm_type
21 : USE cp_fm_types, ONLY: cp_fm_release,&
22 : cp_fm_type
23 : USE cp_log_handling, ONLY: cp_get_default_logger,&
24 : cp_logger_get_default_unit_nr,&
25 : cp_logger_type
26 : USE cp_output_handling, ONLY: cp_print_key_finished_output,&
27 : cp_print_key_unit_nr
28 : USE input_cp2k_kpoints, ONLY: lattice_fft_auto,&
29 : use_complex_wfn,&
30 : use_k290_kpoint_backend,&
31 : use_k290_kpoint_symmetry,&
32 : use_real_wfn,&
33 : use_spglib_kpoint_backend,&
34 : use_spglib_kpoint_symmetry
35 : USE input_section_types, ONLY: section_vals_get,&
36 : section_vals_type,&
37 : section_vals_val_get
38 : USE kinds, ONLY: default_string_length,&
39 : dp
40 : USE local_gemm_api, ONLY: local_gemm_ctxt_type
41 : USE mathconstants, ONLY: twopi
42 : USE message_passing, ONLY: mp_para_env_release,&
43 : mp_para_env_type
44 : USE physcon, ONLY: angstrom
45 : USE qs_diis_types, ONLY: qs_diis_b_release_kp,&
46 : qs_diis_buffer_type_kp
47 : USE qs_matrix_pools, ONLY: mpools_release,&
48 : qs_matrix_pools_type
49 : USE qs_mo_types, ONLY: deallocate_mo_set,&
50 : mo_set_type
51 : USE qs_neighbor_list_types, ONLY: neighbor_list_set_p_type
52 : USE string_utilities, ONLY: uppercase
53 : #include "./base/base_uses.f90"
54 :
55 : IMPLICIT NONE
56 :
57 : PRIVATE
58 :
59 : CHARACTER(len=*), PARAMETER, PRIVATE :: moduleN = 'kpoint_types'
60 :
61 : PUBLIC :: kpoint_type
62 : PUBLIC :: kpoint_create, kpoint_release, kpoint_reset_initialization, get_kpoint_info, set_kpoint_info
63 : PUBLIC :: read_kpoint_section, write_kpoint_info
64 : PUBLIC :: kpoint_clear_scf_smat
65 : PUBLIC :: kpoint_env_type, kpoint_env_p_type
66 : PUBLIC :: kpoint_env_create, get_kpoint_env
67 : PUBLIC :: kind_rotmat_type
68 : PUBLIC :: kpoint_sym_type
69 : PUBLIC :: kpoint_sym_create, find_kpoint_rotation_slot
70 :
71 : ! **************************************************************************************************
72 : !> \brief Keeps information about a specific k-point
73 : !> \param nkpoint the kpoint index
74 : !> \param wkp weight of this kpoint
75 : !> \param xkp kpoint coordinates in units of b-vector
76 : !> \param is_local if this kpoint is calculated on a single thread
77 : !> \param mos associated MOs (spin); complex coefficients use native CFM storage
78 : !> \param mos_prefilled the MOS hold meaningful coefficients (refilled and
79 : !> reorthogonalized by wavefunction extrapolation for the
80 : !> current geometry) rather than being only allocated
81 : !> \param pmat associated density matrix (r/i,spin)
82 : !> \param wmat associated energy weighted density matrix (r/i,spin)
83 : !> \param smat real ADMM auxiliary overlap matrix
84 : !> \param amat real ADMM basis projection matrix
85 : !> \param csmat complex ADMM auxiliary overlap matrix
86 : !> \param camat complex ADMM basis projection matrix
87 : !> \param ot_hmat channel-local Kohn-Sham matrix for k-point OT (r/i,spin)
88 : !> \param ot_smat channel-local overlap matrix for k-point OT (r/i)
89 : !> \param ot_tmat channel-local kinetic-energy matrix for k-point OT (r/i)
90 : !> \param shalf S(K)^(1/2) DFT+U Lowdin method (real wfn)
91 : !> \param cshalf S(K)^(1/2) DFT+U Lowdin method (complex wfn)
92 : !> \author JGH
93 : ! **************************************************************************************************
94 : TYPE kpoint_env_type
95 : INTEGER :: nkpoint = -1
96 : REAL(KIND=dp) :: wkp = 0.0_dp
97 : REAL(KIND=dp), DIMENSION(3) :: xkp = 0.0_dp
98 : LOGICAL :: is_local = .FALSE.
99 : TYPE(mo_set_type), DIMENSION(:), POINTER :: mos => NULL()
100 : LOGICAL :: mos_prefilled = .FALSE.
101 : TYPE(cp_fm_type), DIMENSION(:, :), POINTER :: pmat => NULL()
102 : TYPE(cp_fm_type), DIMENSION(:, :), POINTER :: wmat => NULL()
103 : TYPE(cp_fm_type) :: smat, amat
104 : TYPE(cp_cfm_type) :: csmat, camat
105 : TYPE(cp_fm_type), DIMENSION(:, :), POINTER :: ot_hmat => NULL()
106 : TYPE(cp_fm_type), DIMENSION(:), POINTER :: ot_smat => NULL()
107 : TYPE(cp_fm_type), DIMENSION(:), POINTER :: ot_tmat => NULL()
108 : TYPE(cp_fm_type) :: shalf
109 : TYPE(cp_cfm_type) :: cshalf
110 : ! Selected columns of S(k)**(1/2), with one reusable product workspace.
111 : TYPE(cp_fm_type) :: lowdin_b, lowdin_work
112 : TYPE(cp_cfm_type) :: lowdin_cb, lowdin_cwork
113 : ! Spectrum of S for analytic Lowdin derivatives, retained only for force runs.
114 : TYPE(cp_cfm_type) :: lowdin_evec
115 : REAL(dp), ALLOCATABLE :: lowdin_sqrt(:)
116 : TYPE(local_gemm_ctxt_type) :: lowdin_gemm
117 : END TYPE kpoint_env_type
118 :
119 : TYPE kpoint_env_p_type
120 : TYPE(kpoint_env_type), POINTER :: kpoint_env => NULL()
121 : END TYPE kpoint_env_p_type
122 :
123 : ! **************************************************************************************************
124 : !> \brief Rotation matrices for basis sets
125 : !> \param rmat atom basis function rotation matrix
126 : !> \author JGH
127 : ! **************************************************************************************************
128 : TYPE kind_rotmat_type
129 : REAL(KIND=dp), DIMENSION(:, :), POINTER :: rmat => NULL()
130 : END TYPE kind_rotmat_type
131 :
132 : ! **************************************************************************************************
133 : !> \brief Keeps symmetry information about a specific k-point
134 : !> \param apply_symmetry ...
135 : !> \param nwght kpoint multiplicity
136 : !> \param xkp kpoint coordinates
137 : !> \param rot rotation matrices
138 : !> \param f0 atom permutation
139 : !> \param fcell atom cell shifts generated by the symmetry operation
140 : !> \param fcell_gauge atom cell shifts in CP2K's internal PBC gauge
141 : !> \param phase_mode Bloch phase direction selected from overlap covariance
142 : !> \author JGH
143 : ! **************************************************************************************************
144 : TYPE kpoint_sym_type
145 : LOGICAL :: apply_symmetry = .FALSE.
146 : INTEGER :: nwght = -1
147 : INTEGER :: nwred = -1
148 : REAL(KIND=dp), DIMENSION(:, :), POINTER :: xkp => NULL()
149 : REAL(KIND=dp), DIMENSION(:, :, :), POINTER :: rot => NULL()
150 : INTEGER, DIMENSION(:), POINTER :: rotp => NULL()
151 : INTEGER, DIMENSION(:, :), POINTER :: f0 => NULL()
152 : INTEGER, DIMENSION(:, :, :), POINTER :: fcell => NULL()
153 : INTEGER, DIMENSION(:, :, :), POINTER :: fcell_gauge => NULL()
154 : INTEGER, DIMENSION(:), POINTER :: phase_mode => NULL()
155 : END TYPE kpoint_sym_type
156 :
157 : TYPE kpoint_sym_p_type
158 : TYPE(kpoint_sym_type), POINTER :: kpoint_sym => NULL()
159 : END TYPE kpoint_sym_p_type
160 :
161 : ! **************************************************************************************************
162 : !> \brief Contains information about kpoints
163 : !> \par History
164 : !> 2014.07 created [JGH]
165 : !> \param kp_scheme [input] Type of kpoint grid
166 : !> \param nkp_grid [input] Grid points
167 : !> \param kp_shift [input] Shift of the grid
168 : !> \param use_real_wfn [input] real/complex wfn
169 : !> \param symmetry [input] use symmetry (atoms) to reduce kpoints
170 : !> \param full_grid [input] don't reduce kpoints at all
171 : !> \param lattice_fft [input] lattice FFT selection mode
172 : !> \param inversion_symmetry_only [input] reduce kpoints only by inversion symmetry
173 : !> \param symmetry_backend [input] k-point symmetry backend
174 : !> \param symmetry_reduction_method [input] k-point symmetry reduction method
175 : !> \param verbose [input] more output information
176 : !> \param eps_geo [input] accuracy of atom symmetry detection
177 : !> \param parallel_group_size [input] kpoint group size
178 : !> \param nkp number of kpoints
179 : !> \param xkp kpoint coordinates
180 : !> \param wkp kpoint weights
181 : !> \param xkp_input explicit GENERAL kpoint coordinates as read from the input
182 : !> \param wkp_input explicit GENERAL kpoint weights as read from the input
183 : !> \param para_env 'global' parallel environment
184 : !> \param para_env_kp parallel environment of the kpoint calculation
185 : !> \param para_env_inter_kp parallel environment between kpoints
186 : !> \param iogrp this kpoint group has the IO processor
187 : !> \param nkp_groups number of kpoint groups
188 : !> \param kp_dist kpoints distribution on groups
189 : !> \param kp_range kpoints distribution for local processor
190 : !> \param blacs_env BLACS env for the kpoint group
191 : !> \param opmats Operator matrices
192 : !> \param kp_env Information for each kpoint
193 : !> \param mpools FM matrix pools for kpoint groups
194 : !> \author JGH
195 : ! **************************************************************************************************
196 : TYPE kpoint_type
197 : CHARACTER(LEN=default_string_length) :: kp_scheme = ""
198 : INTEGER, DIMENSION(3) :: nkp_grid = -1
199 : REAL(KIND=dp), DIMENSION(3) :: kp_shift = 0.0_dp
200 : LOGICAL :: gamma_centered = .FALSE.
201 : LOGICAL :: use_real_wfn = .FALSE.
202 : LOGICAL :: symmetry = .FALSE.
203 : LOGICAL :: full_grid = .FALSE.
204 : INTEGER :: lattice_fft = lattice_fft_auto
205 : LOGICAL :: inversion_symmetry_only = .FALSE.
206 : INTEGER :: symmetry_backend = use_k290_kpoint_backend
207 : INTEGER :: symmetry_reduction_method = use_k290_kpoint_symmetry
208 : LOGICAL :: verbose = .FALSE.
209 : REAL(KIND=dp) :: eps_geo = 0.0_dp
210 : INTEGER :: parallel_group_size = -1
211 : INTEGER :: nkp = -1
212 : REAL(KIND=dp), DIMENSION(:, :), POINTER :: xkp => Null()
213 : REAL(KIND=dp), DIMENSION(:), POINTER :: wkp => Null()
214 : REAL(KIND=dp), DIMENSION(:, :), POINTER :: xkp_input => Null()
215 : REAL(KIND=dp), DIMENSION(:), POINTER :: wkp_input => Null()
216 : ! parallel environment
217 : TYPE(mp_para_env_type), POINTER :: para_env => Null()
218 : TYPE(cp_blacs_env_type), POINTER :: blacs_env_all => Null()
219 : TYPE(mp_para_env_type), POINTER :: para_env_kp => Null(), &
220 : para_env_inter_kp => Null()
221 : LOGICAL :: iogrp = .FALSE.
222 : INTEGER :: nkp_groups = -1
223 : INTEGER, DIMENSION(:, :), POINTER :: kp_dist => Null()
224 : INTEGER, DIMENSION(2) :: kp_range = -1
225 : TYPE(cp_blacs_env_type), POINTER :: blacs_env => Null()
226 : INTEGER, DIMENSION(:, :, :), POINTER :: cell_to_index => Null()
227 : INTEGER, DIMENSION(:, :), POINTER :: index_to_cell => Null()
228 : TYPE(neighbor_list_set_p_type), &
229 : DIMENSION(:), POINTER :: sab_nl => Null(), &
230 : sab_nl_nosym => Null()
231 : ! environment
232 : TYPE(kpoint_env_p_type), DIMENSION(:), &
233 : POINTER :: kp_env => Null()
234 : TYPE(kpoint_env_p_type), DIMENSION(:), &
235 : POINTER :: kp_aux_env => Null()
236 : ! symmetry
237 : TYPE(kpoint_sym_p_type), DIMENSION(:), &
238 : POINTER :: kp_sym => Null()
239 : LOGICAL :: phases_calibrated = .FALSE.
240 : INTEGER, DIMENSION(:), POINTER :: atype => Null()
241 : INTEGER, DIMENSION(:), POINTER :: ibrot => Null()
242 : TYPE(kind_rotmat_type), DIMENSION(:, :), &
243 : POINTER :: kind_rotmat => Null()
244 : TYPE(kind_rotmat_type), DIMENSION(:, :), &
245 : POINTER :: kind_rotmat_aux => Null()
246 : ! pools
247 : TYPE(qs_matrix_pools_type), POINTER :: mpools => Null()
248 : TYPE(qs_diis_buffer_type_kp), POINTER :: scf_diis_buffer => Null()
249 : ! Unmodified complex overlaps for the current SCF run, indexed by local k-point.
250 : TYPE(cp_cfm_type), ALLOCATABLE, DIMENSION(:) :: scf_smat
251 : ! Selected AO indices, accepted density/potential, and a separate cached trial density.
252 : INTEGER, ALLOCATABLE :: lowdin_orbitals(:)
253 : REAL(dp), ALLOCATABLE :: lowdin_q(:, :), lowdin_v(:, :), lowdin_q_new(:, :)
254 : LOGICAL :: lowdin_density_ready = .FALSE., lowdin_population_ready = .FALSE.
255 : TYPE(qs_matrix_pools_type), POINTER :: mpools_aux_fit => Null()
256 : END TYPE kpoint_type
257 :
258 : ! **************************************************************************************************
259 :
260 : CONTAINS
261 :
262 : ! **************************************************************************************************
263 : !> \brief Create a kpoint environment
264 : !> \param kpoint All the kpoint information
265 : !> \author JGH
266 : ! **************************************************************************************************
267 9914 : SUBROUTINE kpoint_create(kpoint)
268 : TYPE(kpoint_type), POINTER :: kpoint
269 :
270 9914 : CPASSERT(.NOT. ASSOCIATED(kpoint))
271 :
272 109054 : ALLOCATE (kpoint)
273 :
274 9914 : kpoint%kp_scheme = ""
275 39656 : kpoint%nkp_grid = 0
276 39656 : kpoint%kp_shift = 0.0_dp
277 9914 : kpoint%gamma_centered = .FALSE.
278 9914 : kpoint%symmetry = .FALSE.
279 9914 : kpoint%verbose = .FALSE.
280 9914 : kpoint%full_grid = .FALSE.
281 9914 : kpoint%lattice_fft = lattice_fft_auto
282 9914 : kpoint%inversion_symmetry_only = .FALSE.
283 9914 : kpoint%symmetry_backend = use_k290_kpoint_backend
284 9914 : kpoint%symmetry_reduction_method = use_k290_kpoint_symmetry
285 9914 : kpoint%use_real_wfn = .FALSE.
286 9914 : kpoint%eps_geo = 1.0e-6_dp
287 9914 : kpoint%parallel_group_size = -1
288 :
289 9914 : kpoint%nkp = 0
290 9914 : kpoint%phases_calibrated = .FALSE.
291 :
292 9914 : NULLIFY (kpoint%xkp, kpoint%wkp)
293 9914 : NULLIFY (kpoint%xkp_input, kpoint%wkp_input)
294 9914 : NULLIFY (kpoint%kp_dist)
295 :
296 9914 : NULLIFY (kpoint%para_env)
297 9914 : NULLIFY (kpoint%blacs_env_all)
298 9914 : NULLIFY (kpoint%para_env_kp, kpoint%para_env_inter_kp)
299 9914 : NULLIFY (kpoint%blacs_env)
300 9914 : kpoint%nkp_groups = 0
301 9914 : kpoint%iogrp = .FALSE.
302 29742 : kpoint%kp_range = 0
303 :
304 9914 : NULLIFY (kpoint%kp_env)
305 9914 : NULLIFY (kpoint%mpools)
306 :
307 9914 : ALLOCATE (kpoint%cell_to_index(0:0, 0:0, 0:0))
308 39656 : kpoint%cell_to_index(:, :, :) = 1
309 :
310 9914 : ALLOCATE (kpoint%index_to_cell(0:0, 0:0))
311 29742 : kpoint%index_to_cell(:, :) = 0
312 :
313 9914 : END SUBROUTINE kpoint_create
314 :
315 : ! **************************************************************************************************
316 : !> \brief Release a kpoint environment, deallocate all data
317 : !> \param kpoint The kpoint environment
318 : !> \author JGH
319 : ! **************************************************************************************************
320 19297 : SUBROUTINE kpoint_release(kpoint)
321 : TYPE(kpoint_type), POINTER :: kpoint
322 :
323 : INTEGER :: i, ik, j
324 :
325 19297 : IF (ASSOCIATED(kpoint)) THEN
326 9914 : CALL kpoint_clear_scf_smat(kpoint)
327 :
328 9914 : IF (ASSOCIATED(kpoint%xkp)) THEN
329 1278 : DEALLOCATE (kpoint%xkp)
330 : END IF
331 9914 : IF (ASSOCIATED(kpoint%wkp)) THEN
332 1278 : DEALLOCATE (kpoint%wkp)
333 : END IF
334 9914 : IF (ASSOCIATED(kpoint%xkp_input)) THEN
335 18 : DEALLOCATE (kpoint%xkp_input)
336 : END IF
337 9914 : IF (ASSOCIATED(kpoint%wkp_input)) THEN
338 18 : DEALLOCATE (kpoint%wkp_input)
339 : END IF
340 9914 : IF (ASSOCIATED(kpoint%kp_dist)) THEN
341 950 : DEALLOCATE (kpoint%kp_dist)
342 : END IF
343 :
344 9914 : CALL mpools_release(kpoint%mpools)
345 9914 : CALL mpools_release(kpoint%mpools_aux_fit)
346 :
347 9914 : CALL cp_blacs_env_release(kpoint%blacs_env)
348 9914 : CALL cp_blacs_env_release(kpoint%blacs_env_all)
349 :
350 9914 : CALL mp_para_env_release(kpoint%para_env)
351 9914 : CALL mp_para_env_release(kpoint%para_env_kp)
352 9914 : CALL mp_para_env_release(kpoint%para_env_inter_kp)
353 :
354 9914 : IF (ASSOCIATED(kpoint%cell_to_index)) DEALLOCATE (kpoint%cell_to_index)
355 9914 : IF (ASSOCIATED(kpoint%index_to_cell)) DEALLOCATE (kpoint%index_to_cell)
356 :
357 9914 : IF (ASSOCIATED(kpoint%kp_env)) THEN
358 4799 : DO ik = 1, SIZE(kpoint%kp_env)
359 4799 : CALL kpoint_env_release(kpoint%kp_env(ik)%kpoint_env)
360 : END DO
361 950 : DEALLOCATE (kpoint%kp_env)
362 : END IF
363 :
364 9914 : IF (ASSOCIATED(kpoint%kp_aux_env)) THEN
365 211 : DO ik = 1, SIZE(kpoint%kp_aux_env)
366 211 : CALL kpoint_env_release(kpoint%kp_aux_env(ik)%kpoint_env)
367 : END DO
368 36 : DEALLOCATE (kpoint%kp_aux_env)
369 : END IF
370 :
371 9914 : IF (ASSOCIATED(kpoint%kp_sym)) THEN
372 16880 : DO ik = 1, SIZE(kpoint%kp_sym)
373 16880 : CALL kpoint_sym_release(kpoint%kp_sym(ik)%kpoint_sym)
374 : END DO
375 938 : DEALLOCATE (kpoint%kp_sym)
376 : END IF
377 :
378 9914 : IF (ASSOCIATED(kpoint%atype)) DEALLOCATE (kpoint%atype)
379 9914 : IF (ASSOCIATED(kpoint%ibrot)) DEALLOCATE (kpoint%ibrot)
380 :
381 9914 : IF (ASSOCIATED(kpoint%kind_rotmat)) THEN
382 12412 : DO i = 1, SIZE(kpoint%kind_rotmat, 1)
383 24546 : DO j = 1, SIZE(kpoint%kind_rotmat, 2)
384 24002 : IF (ASSOCIATED(kpoint%kind_rotmat(i, j)%rmat)) THEN
385 10054 : DEALLOCATE (kpoint%kind_rotmat(i, j)%rmat)
386 : END IF
387 : END DO
388 : END DO
389 544 : DEALLOCATE (kpoint%kind_rotmat)
390 : END IF
391 :
392 9914 : IF (ASSOCIATED(kpoint%kind_rotmat_aux)) THEN
393 12412 : DO i = 1, SIZE(kpoint%kind_rotmat_aux, 1)
394 24546 : DO j = 1, SIZE(kpoint%kind_rotmat_aux, 2)
395 24002 : IF (ASSOCIATED(kpoint%kind_rotmat_aux(i, j)%rmat)) THEN
396 60 : DEALLOCATE (kpoint%kind_rotmat_aux(i, j)%rmat)
397 : END IF
398 : END DO
399 : END DO
400 544 : DEALLOCATE (kpoint%kind_rotmat_aux)
401 : END IF
402 :
403 9914 : IF (ASSOCIATED(kpoint%scf_diis_buffer)) THEN
404 374 : CALL qs_diis_b_release_kp(kpoint%scf_diis_buffer)
405 374 : DEALLOCATE (kpoint%scf_diis_buffer)
406 : END IF
407 :
408 9914 : DEALLOCATE (kpoint)
409 :
410 : END IF
411 :
412 19297 : END SUBROUTINE kpoint_release
413 :
414 : ! **************************************************************************************************
415 : !> \brief Release overlap matrices cached for a single SCF run.
416 : !> \param kpoint The kpoint environment
417 : ! **************************************************************************************************
418 16698 : SUBROUTINE kpoint_clear_scf_smat(kpoint)
419 : TYPE(kpoint_type), INTENT(INOUT) :: kpoint
420 :
421 : INTEGER :: ikp
422 :
423 16698 : IF (ALLOCATED(kpoint%scf_smat)) THEN
424 11496 : DO ikp = 1, SIZE(kpoint%scf_smat)
425 11496 : CALL cp_cfm_release(kpoint%scf_smat(ikp))
426 : END DO
427 3774 : DEALLOCATE (kpoint%scf_smat)
428 : END IF
429 :
430 16698 : END SUBROUTINE kpoint_clear_scf_smat
431 :
432 : ! **************************************************************************************************
433 : !> \brief Reset all data derived from a concrete k-point initialization.
434 : !> Input options such as the scheme, grid, shifts and symmetry settings are kept.
435 : !> \param kpoint The kpoint environment
436 : ! **************************************************************************************************
437 2678 : SUBROUTINE kpoint_reset_initialization(kpoint)
438 : TYPE(kpoint_type), INTENT(INOUT) :: kpoint
439 :
440 : INTEGER :: i, ik, j
441 :
442 2678 : CALL kpoint_clear_scf_smat(kpoint)
443 2678 : IF (ALLOCATED(kpoint%lowdin_orbitals)) THEN
444 0 : DEALLOCATE (kpoint%lowdin_orbitals, kpoint%lowdin_q, kpoint%lowdin_q_new, kpoint%lowdin_v)
445 : END IF
446 2678 : kpoint%lowdin_density_ready = .FALSE.
447 2678 : kpoint%lowdin_population_ready = .FALSE.
448 :
449 2678 : IF (ASSOCIATED(kpoint%xkp)) THEN
450 2678 : DEALLOCATE (kpoint%xkp)
451 : NULLIFY (kpoint%xkp)
452 : END IF
453 2678 : IF (ASSOCIATED(kpoint%wkp)) THEN
454 2678 : DEALLOCATE (kpoint%wkp)
455 : NULLIFY (kpoint%wkp)
456 : END IF
457 2678 : IF (kpoint%kp_scheme == "GENERAL" .AND. ASSOCIATED(kpoint%xkp_input) .AND. &
458 : ASSOCIATED(kpoint%wkp_input)) THEN
459 18 : kpoint%nkp = SIZE(kpoint%wkp_input)
460 90 : ALLOCATE (kpoint%xkp(3, kpoint%nkp), kpoint%wkp(kpoint%nkp))
461 594 : kpoint%xkp(1:3, 1:kpoint%nkp) = kpoint%xkp_input(1:3, 1:kpoint%nkp)
462 162 : kpoint%wkp(1:kpoint%nkp) = kpoint%wkp_input(1:kpoint%nkp)
463 : END IF
464 2678 : IF (ASSOCIATED(kpoint%kp_dist)) THEN
465 2354 : DEALLOCATE (kpoint%kp_dist)
466 : NULLIFY (kpoint%kp_dist)
467 : END IF
468 :
469 2678 : CALL mpools_release(kpoint%mpools)
470 2678 : CALL mpools_release(kpoint%mpools_aux_fit)
471 :
472 2678 : CALL cp_blacs_env_release(kpoint%blacs_env)
473 2678 : CALL cp_blacs_env_release(kpoint%blacs_env_all)
474 :
475 2678 : CALL mp_para_env_release(kpoint%para_env)
476 2678 : CALL mp_para_env_release(kpoint%para_env_kp)
477 2678 : CALL mp_para_env_release(kpoint%para_env_inter_kp)
478 :
479 2678 : IF (ASSOCIATED(kpoint%cell_to_index)) THEN
480 2678 : DEALLOCATE (kpoint%cell_to_index)
481 : NULLIFY (kpoint%cell_to_index)
482 : END IF
483 2678 : IF (ASSOCIATED(kpoint%index_to_cell)) THEN
484 2678 : DEALLOCATE (kpoint%index_to_cell)
485 : NULLIFY (kpoint%index_to_cell)
486 : END IF
487 :
488 2678 : IF (ASSOCIATED(kpoint%kp_env)) THEN
489 6140 : DO ik = 1, SIZE(kpoint%kp_env)
490 6140 : CALL kpoint_env_release(kpoint%kp_env(ik)%kpoint_env)
491 : END DO
492 2354 : DEALLOCATE (kpoint%kp_env)
493 : NULLIFY (kpoint%kp_env)
494 : END IF
495 :
496 2678 : IF (ASSOCIATED(kpoint%kp_aux_env)) THEN
497 0 : DO ik = 1, SIZE(kpoint%kp_aux_env)
498 0 : CALL kpoint_env_release(kpoint%kp_aux_env(ik)%kpoint_env)
499 : END DO
500 0 : DEALLOCATE (kpoint%kp_aux_env)
501 : NULLIFY (kpoint%kp_aux_env)
502 : END IF
503 :
504 2678 : IF (ASSOCIATED(kpoint%kp_sym)) THEN
505 10712 : DO ik = 1, SIZE(kpoint%kp_sym)
506 10712 : CALL kpoint_sym_release(kpoint%kp_sym(ik)%kpoint_sym)
507 : END DO
508 2678 : DEALLOCATE (kpoint%kp_sym)
509 : NULLIFY (kpoint%kp_sym)
510 : END IF
511 :
512 2678 : IF (ASSOCIATED(kpoint%atype)) THEN
513 2676 : DEALLOCATE (kpoint%atype)
514 : NULLIFY (kpoint%atype)
515 : END IF
516 2678 : IF (ASSOCIATED(kpoint%ibrot)) THEN
517 2668 : DEALLOCATE (kpoint%ibrot)
518 : NULLIFY (kpoint%ibrot)
519 : END IF
520 :
521 2678 : IF (ASSOCIATED(kpoint%kind_rotmat)) THEN
522 17154 : DO i = 1, SIZE(kpoint%kind_rotmat, 1)
523 33514 : DO j = 1, SIZE(kpoint%kind_rotmat, 2)
524 30846 : IF (ASSOCIATED(kpoint%kind_rotmat(i, j)%rmat)) THEN
525 6578 : DEALLOCATE (kpoint%kind_rotmat(i, j)%rmat)
526 6578 : NULLIFY (kpoint%kind_rotmat(i, j)%rmat)
527 : END IF
528 : END DO
529 : END DO
530 2668 : DEALLOCATE (kpoint%kind_rotmat)
531 : NULLIFY (kpoint%kind_rotmat)
532 : END IF
533 :
534 2678 : IF (ASSOCIATED(kpoint%kind_rotmat_aux)) THEN
535 17154 : DO i = 1, SIZE(kpoint%kind_rotmat_aux, 1)
536 33514 : DO j = 1, SIZE(kpoint%kind_rotmat_aux, 2)
537 30846 : IF (ASSOCIATED(kpoint%kind_rotmat_aux(i, j)%rmat)) THEN
538 0 : DEALLOCATE (kpoint%kind_rotmat_aux(i, j)%rmat)
539 0 : NULLIFY (kpoint%kind_rotmat_aux(i, j)%rmat)
540 : END IF
541 : END DO
542 : END DO
543 2668 : DEALLOCATE (kpoint%kind_rotmat_aux)
544 : NULLIFY (kpoint%kind_rotmat_aux)
545 : END IF
546 :
547 2678 : IF (ASSOCIATED(kpoint%scf_diis_buffer)) THEN
548 2186 : CALL qs_diis_b_release_kp(kpoint%scf_diis_buffer)
549 2186 : DEALLOCATE (kpoint%scf_diis_buffer)
550 : NULLIFY (kpoint%scf_diis_buffer)
551 : END IF
552 :
553 2678 : NULLIFY (kpoint%sab_nl)
554 2678 : NULLIFY (kpoint%sab_nl_nosym)
555 :
556 2678 : ALLOCATE (kpoint%cell_to_index(0:0, 0:0, 0:0))
557 10712 : kpoint%cell_to_index(:, :, :) = 1
558 :
559 2678 : ALLOCATE (kpoint%index_to_cell(0:0, 0:0))
560 8034 : kpoint%index_to_cell(:, :) = 0
561 :
562 2678 : IF (.NOT. ASSOCIATED(kpoint%wkp)) kpoint%nkp = 0
563 2678 : kpoint%nkp_groups = 0
564 8034 : kpoint%kp_range = 0
565 2678 : kpoint%iogrp = .FALSE.
566 :
567 2678 : END SUBROUTINE kpoint_reset_initialization
568 :
569 : ! **************************************************************************************************
570 : !> \brief Retrieve information from a kpoint environment
571 : !> \param kpoint The kpoint environment
572 : !> \param kp_scheme Type of kpoint grid
573 : !> \param nkp_grid Grid points
574 : !> \param kp_shift Shift of the grid
575 : !> \param symmetry use symmetry (atoms) to reduce kpoints
576 : !> \param verbose more output information
577 : !> \param full_grid don't reduce kpoints at all
578 : !> \param use_real_wfn real/complex wfn
579 : !> \param eps_geo accuracy of atom symmetry detection
580 : !> \param parallel_group_size kpoint group size
581 : !> \param kp_range kpoints distribution for local processor
582 : !> \param nkp number of kpoints
583 : !> \param xkp kpoint coordinates in units of b-vector
584 : !> \param wkp kpoint weights
585 : !> \param para_env 'global' parallel environment
586 : !> \param blacs_env_all BLACS env for the total environment
587 : !> \param para_env_kp parallel environment of the kpoint calculation
588 : !> \param para_env_inter_kp parallel environment between kpoints
589 : !> \param blacs_env BLACS env for the kpoint group
590 : !> \param kp_env Information for each kpoint
591 : !> \param kp_aux_env ...
592 : !> \param mpools FM matrix pools for kpoint groups
593 : !> \param iogrp this kpoint group has the IO processor
594 : !> \param nkp_groups number of kpoint groups
595 : !> \param kp_dist kpoints distribution on groups
596 : !> \param cell_to_index given a cell triple, returns the real space index
597 : !> \param index_to_cell ...
598 : !> \param sab_nl neighbourlist that defines real space matrices
599 : !> \param sab_nl_nosym neighbourlist that defines real space matrices, non-symmetric
600 : !> \param inversion_symmetry_only reduce kpoints only by inversion symmetry
601 : !> \param symmetry_backend k-point symmetry backend
602 : !> \param symmetry_reduction_method k-point symmetry reduction method
603 : !> \param gamma_centered ...
604 : !> \param lattice_fft lattice FFT selection mode
605 : !> \author JGH
606 : ! **************************************************************************************************
607 2774463 : SUBROUTINE get_kpoint_info(kpoint, kp_scheme, nkp_grid, kp_shift, symmetry, verbose, &
608 : full_grid, use_real_wfn, eps_geo, parallel_group_size, kp_range, nkp, xkp, wkp, &
609 : para_env, blacs_env_all, para_env_kp, para_env_inter_kp, blacs_env, &
610 : kp_env, kp_aux_env, mpools, iogrp, nkp_groups, kp_dist, cell_to_index, index_to_cell, &
611 : sab_nl, sab_nl_nosym, inversion_symmetry_only, symmetry_backend, &
612 : symmetry_reduction_method, gamma_centered, lattice_fft)
613 : TYPE(kpoint_type), INTENT(IN) :: kpoint
614 : CHARACTER(LEN=*), OPTIONAL :: kp_scheme
615 : INTEGER, DIMENSION(3), OPTIONAL :: nkp_grid
616 : REAL(KIND=dp), DIMENSION(3), OPTIONAL :: kp_shift
617 : LOGICAL, OPTIONAL :: symmetry, verbose, full_grid, &
618 : use_real_wfn
619 : REAL(KIND=dp), OPTIONAL :: eps_geo
620 : INTEGER, OPTIONAL :: parallel_group_size
621 : INTEGER, DIMENSION(2), OPTIONAL :: kp_range
622 : INTEGER, OPTIONAL :: nkp
623 : REAL(KIND=dp), DIMENSION(:, :), OPTIONAL, POINTER :: xkp
624 : REAL(KIND=dp), DIMENSION(:), OPTIONAL, POINTER :: wkp
625 : TYPE(mp_para_env_type), OPTIONAL, POINTER :: para_env
626 : TYPE(cp_blacs_env_type), OPTIONAL, POINTER :: blacs_env_all
627 : TYPE(mp_para_env_type), OPTIONAL, POINTER :: para_env_kp, para_env_inter_kp
628 : TYPE(cp_blacs_env_type), OPTIONAL, POINTER :: blacs_env
629 : TYPE(kpoint_env_p_type), DIMENSION(:), OPTIONAL, &
630 : POINTER :: kp_env, kp_aux_env
631 : TYPE(qs_matrix_pools_type), OPTIONAL, POINTER :: mpools
632 : LOGICAL, OPTIONAL :: iogrp
633 : INTEGER, OPTIONAL :: nkp_groups
634 : INTEGER, DIMENSION(:, :), OPTIONAL, POINTER :: kp_dist
635 : INTEGER, DIMENSION(:, :, :), OPTIONAL, POINTER :: cell_to_index
636 : INTEGER, DIMENSION(:, :), OPTIONAL, POINTER :: index_to_cell
637 : TYPE(neighbor_list_set_p_type), DIMENSION(:), &
638 : OPTIONAL, POINTER :: sab_nl, sab_nl_nosym
639 : LOGICAL, OPTIONAL :: inversion_symmetry_only
640 : INTEGER, OPTIONAL :: symmetry_backend, &
641 : symmetry_reduction_method
642 : LOGICAL, OPTIONAL :: gamma_centered
643 : INTEGER, OPTIONAL :: lattice_fft
644 :
645 7516 : IF (PRESENT(kp_scheme)) kp_scheme = kpoint%kp_scheme
646 2921663 : IF (PRESENT(nkp_grid)) nkp_grid = kpoint%nkp_grid
647 2775111 : IF (PRESENT(kp_shift)) kp_shift = kpoint%kp_shift
648 2774463 : IF (PRESENT(gamma_centered)) gamma_centered = kpoint%gamma_centered
649 2774463 : IF (PRESENT(symmetry)) symmetry = kpoint%symmetry
650 2774463 : IF (PRESENT(verbose)) verbose = kpoint%verbose
651 2774463 : IF (PRESENT(full_grid)) full_grid = kpoint%full_grid
652 2774463 : IF (PRESENT(lattice_fft)) lattice_fft = kpoint%lattice_fft
653 2774463 : IF (PRESENT(inversion_symmetry_only)) inversion_symmetry_only = kpoint%inversion_symmetry_only
654 2774463 : IF (PRESENT(symmetry_backend)) symmetry_backend = kpoint%symmetry_backend
655 2774463 : IF (PRESENT(symmetry_reduction_method)) THEN
656 0 : symmetry_reduction_method = kpoint%symmetry_reduction_method
657 : END IF
658 2774463 : IF (PRESENT(use_real_wfn)) use_real_wfn = kpoint%use_real_wfn
659 2774463 : IF (PRESENT(eps_geo)) eps_geo = kpoint%eps_geo
660 2774463 : IF (PRESENT(parallel_group_size)) parallel_group_size = kpoint%parallel_group_size
661 :
662 2774463 : IF (PRESENT(nkp)) nkp = kpoint%nkp
663 2774463 : IF (PRESENT(wkp)) wkp => kpoint%wkp
664 2774463 : IF (PRESENT(xkp)) xkp => kpoint%xkp
665 :
666 2774463 : IF (PRESENT(para_env)) para_env => kpoint%para_env
667 2774463 : IF (PRESENT(para_env_kp)) para_env_kp => kpoint%para_env_kp
668 2774463 : IF (PRESENT(para_env_inter_kp)) para_env_inter_kp => kpoint%para_env_inter_kp
669 2774463 : IF (PRESENT(blacs_env_all)) blacs_env_all => kpoint%blacs_env_all
670 2774463 : IF (PRESENT(blacs_env)) blacs_env => kpoint%blacs_env
671 :
672 2774463 : IF (PRESENT(iogrp)) iogrp = kpoint%iogrp
673 3047661 : IF (PRESENT(kp_range)) kp_range = kpoint%kp_range
674 2774463 : IF (PRESENT(nkp_groups)) nkp_groups = kpoint%nkp_groups
675 2774463 : IF (PRESENT(kp_dist)) kp_dist => kpoint%kp_dist
676 :
677 2774463 : IF (PRESENT(kp_env)) kp_env => kpoint%kp_env
678 2774463 : IF (PRESENT(kp_aux_env)) kp_aux_env => kpoint%kp_aux_env
679 2774463 : IF (PRESENT(mpools)) mpools => kpoint%mpools
680 :
681 2774463 : IF (PRESENT(cell_to_index)) cell_to_index => kpoint%cell_to_index
682 2774463 : IF (PRESENT(index_to_cell)) index_to_cell => kpoint%index_to_cell
683 2774463 : IF (PRESENT(sab_nl)) sab_nl => kpoint%sab_nl
684 2774463 : IF (PRESENT(sab_nl_nosym)) sab_nl_nosym => kpoint%sab_nl_nosym
685 :
686 2774463 : END SUBROUTINE get_kpoint_info
687 :
688 : ! **************************************************************************************************
689 : !> \brief Set information in a kpoint environment
690 : !> \param kpoint The kpoint environment
691 : !> \param kp_scheme Type of kpoint grid
692 : !> \param nkp_grid Grid points
693 : !> \param kp_shift Shift of the grid
694 : !> \param symmetry use symmetry (atoms) to reduce kpoints
695 : !> \param verbose more output information
696 : !> \param full_grid don't reduce kpoints at all
697 : !> \param use_real_wfn real/complex wfn
698 : !> \param eps_geo accuracy of atom symmetry detection
699 : !> \param parallel_group_size kpoint group size
700 : !> \param kp_range kpoints distribution for local processor
701 : !> \param nkp number of kpoints
702 : !> \param xkp kpoint coordinates
703 : !> \param wkp kpoint weights
704 : !> \param para_env 'global' parallel environment
705 : !> \param blacs_env_all BLACS env for the total environment
706 : !> \param para_env_kp parallel environment of the kpoint calculation
707 : !> \param para_env_inter_kp parallel environment between kpoints
708 : !> \param blacs_env BLACS env for the kpoint group
709 : !> \param kp_env Information for each kpoint
710 : !> \param kp_aux_env ...
711 : !> \param mpools FM matrix pools for kpoint groups
712 : !> \param iogrp this kpoint group has the IO processor
713 : !> \param nkp_groups number of kpoint groups
714 : !> \param kp_dist kpoints distribution on groups
715 : !> \param cell_to_index given a cell triple, returns the real space index
716 : !> \param index_to_cell ...
717 : !> \param sab_nl neighbourlist that defines real space matrices
718 : !> \param sab_nl_nosym neighbourlist that defines real space matrices
719 : !> \param inversion_symmetry_only reduce kpoints only by inversion symmetry
720 : !> \param symmetry_backend k-point symmetry backend
721 : !> \param symmetry_reduction_method k-point symmetry reduction method
722 : !> \param gamma_centered ...
723 : !> \author JGH
724 : ! **************************************************************************************************
725 7122 : SUBROUTINE set_kpoint_info(kpoint, kp_scheme, nkp_grid, kp_shift, symmetry, verbose, &
726 : full_grid, use_real_wfn, eps_geo, parallel_group_size, kp_range, nkp, xkp, wkp, &
727 : para_env, blacs_env_all, para_env_kp, para_env_inter_kp, blacs_env, &
728 : kp_env, kp_aux_env, mpools, iogrp, nkp_groups, kp_dist, cell_to_index, index_to_cell, &
729 : sab_nl, sab_nl_nosym, inversion_symmetry_only, symmetry_backend, &
730 : symmetry_reduction_method, gamma_centered)
731 : TYPE(kpoint_type), INTENT(INOUT) :: kpoint
732 : CHARACTER(LEN=*), OPTIONAL :: kp_scheme
733 : INTEGER, DIMENSION(3), OPTIONAL :: nkp_grid
734 : REAL(KIND=dp), DIMENSION(3), OPTIONAL :: kp_shift
735 : LOGICAL, OPTIONAL :: symmetry, verbose, full_grid, &
736 : use_real_wfn
737 : REAL(KIND=dp), OPTIONAL :: eps_geo
738 : INTEGER, OPTIONAL :: parallel_group_size
739 : INTEGER, DIMENSION(2), OPTIONAL :: kp_range
740 : INTEGER, OPTIONAL :: nkp
741 : REAL(KIND=dp), DIMENSION(:, :), OPTIONAL, POINTER :: xkp
742 : REAL(KIND=dp), DIMENSION(:), OPTIONAL, POINTER :: wkp
743 : TYPE(mp_para_env_type), OPTIONAL, POINTER :: para_env
744 : TYPE(cp_blacs_env_type), OPTIONAL, POINTER :: blacs_env_all
745 : TYPE(mp_para_env_type), OPTIONAL, POINTER :: para_env_kp, para_env_inter_kp
746 : TYPE(cp_blacs_env_type), OPTIONAL, POINTER :: blacs_env
747 : TYPE(kpoint_env_p_type), DIMENSION(:), OPTIONAL, &
748 : POINTER :: kp_env, kp_aux_env
749 : TYPE(qs_matrix_pools_type), OPTIONAL, POINTER :: mpools
750 : LOGICAL, OPTIONAL :: iogrp
751 : INTEGER, OPTIONAL :: nkp_groups
752 : INTEGER, DIMENSION(:, :), OPTIONAL, POINTER :: kp_dist
753 : INTEGER, DIMENSION(:, :, :), OPTIONAL, POINTER :: cell_to_index
754 : INTEGER, DIMENSION(:, :), OPTIONAL, POINTER :: index_to_cell
755 : TYPE(neighbor_list_set_p_type), DIMENSION(:), &
756 : OPTIONAL, POINTER :: sab_nl, sab_nl_nosym
757 : LOGICAL, OPTIONAL :: inversion_symmetry_only
758 : INTEGER, OPTIONAL :: symmetry_backend, &
759 : symmetry_reduction_method
760 : LOGICAL, OPTIONAL :: gamma_centered
761 :
762 2 : IF (PRESENT(kp_scheme)) kpoint%kp_scheme = kp_scheme
763 7122 : IF (PRESENT(nkp_grid)) kpoint%nkp_grid = nkp_grid
764 7122 : IF (PRESENT(kp_shift)) kpoint%kp_shift = kp_shift
765 7122 : IF (PRESENT(gamma_centered)) kpoint%gamma_centered = gamma_centered
766 7122 : IF (PRESENT(symmetry)) kpoint%symmetry = symmetry
767 7122 : IF (PRESENT(verbose)) kpoint%verbose = verbose
768 7122 : IF (PRESENT(full_grid)) kpoint%full_grid = full_grid
769 7122 : IF (PRESENT(inversion_symmetry_only)) kpoint%inversion_symmetry_only = inversion_symmetry_only
770 7122 : IF (PRESENT(symmetry_backend)) kpoint%symmetry_backend = symmetry_backend
771 7122 : IF (PRESENT(symmetry_reduction_method)) THEN
772 0 : kpoint%symmetry_reduction_method = symmetry_reduction_method
773 : END IF
774 7122 : IF (PRESENT(use_real_wfn)) kpoint%use_real_wfn = use_real_wfn
775 7122 : IF (PRESENT(eps_geo)) kpoint%eps_geo = eps_geo
776 7122 : IF (PRESENT(parallel_group_size)) kpoint%parallel_group_size = parallel_group_size
777 :
778 7122 : IF (PRESENT(nkp)) kpoint%nkp = nkp
779 7122 : IF (PRESENT(wkp)) kpoint%wkp => wkp
780 7122 : IF (PRESENT(xkp)) kpoint%xkp => xkp
781 :
782 7122 : IF (PRESENT(para_env)) kpoint%para_env => para_env
783 7122 : IF (PRESENT(para_env_kp)) kpoint%para_env_kp => para_env_kp
784 7122 : IF (PRESENT(para_env_inter_kp)) kpoint%para_env_inter_kp => para_env_inter_kp
785 7122 : IF (PRESENT(blacs_env_all)) kpoint%blacs_env_all => blacs_env_all
786 7122 : IF (PRESENT(blacs_env)) kpoint%blacs_env => blacs_env
787 :
788 7122 : IF (PRESENT(iogrp)) kpoint%iogrp = iogrp
789 7122 : IF (PRESENT(kp_range)) kpoint%kp_range = kp_range
790 7122 : IF (PRESENT(nkp_groups)) kpoint%nkp_groups = nkp_groups
791 7122 : IF (PRESENT(kp_dist)) kpoint%kp_dist => kp_dist
792 :
793 7122 : IF (PRESENT(kp_env)) kpoint%kp_env => kp_env
794 0 : IF (PRESENT(kp_env)) kpoint%kp_aux_env => kp_aux_env
795 7122 : IF (PRESENT(mpools)) kpoint%mpools => mpools
796 7122 : IF (PRESENT(sab_nl)) kpoint%sab_nl => sab_nl
797 7122 : IF (PRESENT(sab_nl_nosym)) kpoint%sab_nl_nosym => sab_nl_nosym
798 :
799 7122 : IF (PRESENT(cell_to_index)) THEN
800 0 : IF (ASSOCIATED(kpoint%cell_to_index)) DEALLOCATE (kpoint%cell_to_index)
801 0 : kpoint%cell_to_index => cell_to_index
802 : END IF
803 :
804 7122 : IF (PRESENT(index_to_cell)) THEN
805 0 : IF (ASSOCIATED(kpoint%index_to_cell)) DEALLOCATE (kpoint%index_to_cell)
806 0 : kpoint%index_to_cell => index_to_cell
807 : END IF
808 :
809 7122 : END SUBROUTINE set_kpoint_info
810 :
811 : ! **************************************************************************************************
812 : !> \brief Read the kpoint input section
813 : !> \param kpoint The kpoint environment
814 : !> \param kpoint_section The input section
815 : !> \param a_vec ...
816 : !> \param cell ...
817 : !> \author JGH
818 : ! **************************************************************************************************
819 9328 : SUBROUTINE read_kpoint_section(kpoint, kpoint_section, a_vec, cell)
820 : TYPE(kpoint_type), INTENT(INOUT) :: kpoint
821 : TYPE(section_vals_type), POINTER :: kpoint_section
822 : REAL(KIND=dp), DIMENSION(3, 3), INTENT(IN) :: a_vec
823 : TYPE(cell_type), OPTIONAL, POINTER :: cell
824 :
825 : REAL(KIND=dp), PARAMETER :: eps_cell = 1.0E-14_dp
826 :
827 : CHARACTER(LEN=default_string_length) :: ustr
828 : CHARACTER(LEN=default_string_length), &
829 9328 : DIMENSION(:), POINTER :: tmpstringlist
830 : INTEGER :: i, n_rep, nval, wfntype
831 : LOGICAL :: available, backend_explicit, &
832 : non_lower_triangular_cell, &
833 : reduction_explicit
834 : REAL(KIND=dp) :: ff
835 : REAL(KIND=dp), DIMENSION(3, 3) :: cart_a_vec
836 9328 : REAL(KIND=dp), DIMENSION(:), POINTER :: reallist
837 :
838 9328 : CALL section_vals_get(kpoint_section, explicit=available)
839 9328 : cart_a_vec(:, :) = a_vec(:, :)
840 9328 : IF (PRESENT(cell)) THEN
841 9328 : IF (ASSOCIATED(cell)) THEN
842 10048 : IF (cell%input_cell_canonicalized) cart_a_vec(:, :) = cell%input_hmat(:, :)
843 : END IF
844 : END IF
845 :
846 9328 : IF (available) THEN
847 836 : CALL section_vals_val_get(kpoint_section, "SCHEME", c_vals=tmpstringlist)
848 836 : nval = SIZE(tmpstringlist)
849 836 : CPASSERT(nval >= 1)
850 836 : kpoint%kp_scheme = tmpstringlist(1)
851 836 : CALL uppercase(kpoint%kp_scheme)
852 :
853 : ! SCHEME [None, Gamma, Monkhorst-Pack, MacDonald, General]
854 746 : SELECT CASE (kpoint%kp_scheme)
855 : CASE ("NONE")
856 : ! do nothing
857 : CASE ("GAMMA")
858 : ! do nothing
859 : CASE ("MONKHORST-PACK")
860 746 : CPASSERT(nval >= 4)
861 2984 : DO i = 2, 4
862 2984 : READ (tmpstringlist(i), *) kpoint%nkp_grid(i - 1)
863 : END DO
864 : CASE ("MACDONALD")
865 24 : CPASSERT(nval >= 7)
866 96 : DO i = 2, 4
867 96 : READ (tmpstringlist(i), *) kpoint%nkp_grid(i - 1)
868 : END DO
869 96 : DO i = 5, 7
870 96 : READ (tmpstringlist(i), *) kpoint%kp_shift(i - 4)
871 : END DO
872 : CASE ("GENERAL")
873 18 : CALL section_vals_val_get(kpoint_section, "UNITS", c_val=ustr)
874 18 : CALL uppercase(ustr)
875 18 : CALL section_vals_val_get(kpoint_section, "KPOINT", n_rep_val=n_rep)
876 18 : kpoint%nkp = n_rep
877 18 : IF (ASSOCIATED(kpoint%xkp_input)) THEN
878 0 : DEALLOCATE (kpoint%xkp_input)
879 : NULLIFY (kpoint%xkp_input)
880 : END IF
881 18 : IF (ASSOCIATED(kpoint%wkp_input)) THEN
882 0 : DEALLOCATE (kpoint%wkp_input)
883 : NULLIFY (kpoint%wkp_input)
884 : END IF
885 90 : ALLOCATE (kpoint%xkp(3, n_rep), kpoint%wkp(n_rep))
886 126 : DO i = 1, n_rep
887 : CALL section_vals_val_get(kpoint_section, "KPOINT", i_rep_val=i, &
888 108 : r_vals=reallist)
889 108 : nval = SIZE(reallist)
890 108 : CPASSERT(nval >= 4)
891 108 : SELECT CASE (ustr)
892 : CASE ("B_VECTOR")
893 432 : kpoint%xkp(1:3, i) = reallist(1:3)
894 : CASE ("CART_ANGSTROM")
895 : kpoint%xkp(1:3, i) = (reallist(1)*cart_a_vec(1, 1:3) + &
896 : reallist(2)*cart_a_vec(2, 1:3) + &
897 0 : reallist(3)*cart_a_vec(3, 1:3))/twopi*angstrom
898 : CASE ("CART_BOHR")
899 : kpoint%xkp(1:3, i) = (reallist(1)*cart_a_vec(1, 1:3) + &
900 : reallist(2)*cart_a_vec(2, 1:3) + &
901 0 : reallist(3)*cart_a_vec(3, 1:3))/twopi
902 : CASE DEFAULT
903 108 : CPABORT("Unknown Unit for kpoint definition")
904 : END SELECT
905 126 : kpoint%wkp(i) = reallist(4)
906 : END DO
907 126 : ff = 1.0_dp/SUM(kpoint%wkp(:))
908 126 : kpoint%wkp(:) = ff*kpoint%wkp(:)
909 54 : ALLOCATE (kpoint%xkp_input(3, n_rep), kpoint%wkp_input(n_rep))
910 450 : kpoint%xkp_input(1:3, 1:n_rep) = kpoint%xkp(1:3, 1:n_rep)
911 144 : kpoint%wkp_input(1:n_rep) = kpoint%wkp(1:n_rep)
912 : CASE DEFAULT
913 : CALL cp_abort(__LOCATION__, &
914 : "<NONE>, <GAMMA>, <MONKHORST-PACK>, <MACDONALD>, "// &
915 : "<GENERAL> are supported as the <kpoint%kp_scheme> for "// &
916 : "read_kpoint_section, found unknown option "// &
917 836 : "<"//TRIM(kpoint%kp_scheme)//">")
918 : END SELECT
919 :
920 836 : CALL section_vals_val_get(kpoint_section, "GAMMA_CENTERED", l_val=kpoint%gamma_centered)
921 836 : IF (kpoint%gamma_centered .AND. kpoint%kp_scheme /= "MONKHORST-PACK" .AND. &
922 : kpoint%kp_scheme /= "MACDONALD") THEN
923 : CALL cp_abort(__LOCATION__, &
924 0 : "KPOINTS%GAMMA_CENTERED is only supported with SCHEME MONKHORST-PACK or MACDONALD")
925 : END IF
926 :
927 836 : CALL section_vals_val_get(kpoint_section, "SYMMETRY", l_val=kpoint%symmetry)
928 836 : CALL section_vals_val_get(kpoint_section, "WAVEFUNCTIONS", i_val=wfntype)
929 836 : CALL section_vals_val_get(kpoint_section, "VERBOSE", l_val=kpoint%verbose)
930 836 : CALL section_vals_val_get(kpoint_section, "FULL_GRID", l_val=kpoint%full_grid)
931 836 : CALL section_vals_val_get(kpoint_section, "LATTICE_FFT", i_val=kpoint%lattice_fft)
932 : CALL section_vals_val_get(kpoint_section, "INVERSION_SYMMETRY_ONLY", &
933 836 : l_val=kpoint%inversion_symmetry_only)
934 : CALL section_vals_val_get(kpoint_section, "SYMMETRY_BACKEND", &
935 836 : i_val=kpoint%symmetry_backend, explicit=backend_explicit)
936 : CALL section_vals_val_get(kpoint_section, "SYMMETRY_REDUCTION_METHOD", &
937 836 : i_val=kpoint%symmetry_reduction_method, explicit=reduction_explicit)
938 836 : CALL resolve_kpoint_symmetry_settings(kpoint, backend_explicit, reduction_explicit)
939 836 : CALL section_vals_val_get(kpoint_section, "EPS_SYMMETRY", r_val=kpoint%eps_geo)
940 : IF ((kpoint%kp_scheme == "MONKHORST-PACK" .OR. kpoint%kp_scheme == "MACDONALD") .AND. &
941 836 : kpoint%symmetry .AND. .NOT. kpoint%full_grid .AND. &
942 : .NOT. kpoint%inversion_symmetry_only) THEN
943 : non_lower_triangular_cell = (ABS(a_vec(2, 1)) > eps_cell) .OR. &
944 : (ABS(a_vec(3, 1)) > eps_cell) .OR. &
945 408 : (ABS(a_vec(3, 2)) > eps_cell)
946 : IF (non_lower_triangular_cell) THEN
947 6 : kpoint%inversion_symmetry_only = .TRUE.
948 : CALL cp_warn(__LOCATION__, &
949 : "Full atomic k-point symmetry was requested for a cell matrix that does "// &
950 : "not follow the CP2K lower-triangular convention. Falling back to "// &
951 : "KPOINTS%INVERSION_SYMMETRY_ONLY. Use ABC/ALPHA_BETA_GAMMA or canonical "// &
952 6 : "A/B/C vectors to enable full point-group k-point reduction.")
953 : END IF
954 : END IF
955 : CALL section_vals_val_get(kpoint_section, "PARALLEL_GROUP_SIZE", &
956 836 : i_val=kpoint%parallel_group_size)
957 16 : SELECT CASE (wfntype)
958 : CASE (use_real_wfn)
959 16 : kpoint%use_real_wfn = .TRUE.
960 : CASE (use_complex_wfn)
961 820 : kpoint%use_real_wfn = .FALSE.
962 : CASE DEFAULT
963 836 : CPABORT("The WAVEFUNCTIONS option should be either REAL or COMPLEX")
964 : END SELECT
965 :
966 : ELSE
967 8492 : kpoint%kp_scheme = "NONE"
968 : END IF
969 :
970 9328 : END SUBROUTINE read_kpoint_section
971 :
972 : ! **************************************************************************************************
973 : !> \brief Resolve legacy and backend k-point symmetry settings
974 : !> \param kpoint ...
975 : !> \param backend_explicit whether SYMMETRY_BACKEND was given
976 : !> \param reduction_explicit whether SYMMETRY_REDUCTION_METHOD was given
977 : ! **************************************************************************************************
978 836 : SUBROUTINE resolve_kpoint_symmetry_settings(kpoint, backend_explicit, reduction_explicit)
979 : TYPE(kpoint_type), INTENT(INOUT) :: kpoint
980 : LOGICAL, INTENT(IN) :: backend_explicit, reduction_explicit
981 :
982 836 : IF (backend_explicit .AND. .NOT. reduction_explicit) THEN
983 186 : SELECT CASE (kpoint%symmetry_backend)
984 : CASE (use_k290_kpoint_backend)
985 50 : kpoint%symmetry_reduction_method = use_k290_kpoint_symmetry
986 : CASE (use_spglib_kpoint_backend)
987 86 : kpoint%symmetry_reduction_method = use_spglib_kpoint_symmetry
988 : CASE DEFAULT
989 136 : CPABORT("Unknown k-point symmetry backend")
990 : END SELECT
991 : END IF
992 :
993 836 : IF (kpoint%symmetry_backend == use_spglib_kpoint_backend .AND. &
994 : kpoint%symmetry_reduction_method /= use_spglib_kpoint_symmetry) THEN
995 : CALL cp_abort(__LOCATION__, &
996 0 : "SYMMETRY_BACKEND SPGLIB requires SYMMETRY_REDUCTION_METHOD SPGLIB")
997 : END IF
998 :
999 836 : END SUBROUTINE resolve_kpoint_symmetry_settings
1000 :
1001 : ! **************************************************************************************************
1002 : !> \brief Write information on the kpoints to output
1003 : !> \param kpoint The kpoint environment
1004 : !> \param iounit output unit
1005 : !> \param dft_section DFT section information for output unit
1006 : !> \author JGH
1007 : ! **************************************************************************************************
1008 9319 : SUBROUTINE write_kpoint_info(kpoint, iounit, dft_section)
1009 : TYPE(kpoint_type), INTENT(IN) :: kpoint
1010 : INTEGER, INTENT(IN), OPTIONAL :: iounit
1011 : TYPE(section_vals_type), INTENT(IN), OPTIONAL :: dft_section
1012 :
1013 : INTEGER :: i, punit
1014 : TYPE(cp_logger_type), POINTER :: logger
1015 :
1016 9319 : NULLIFY (logger)
1017 9319 : logger => cp_get_default_logger()
1018 :
1019 9319 : IF (PRESENT(dft_section)) THEN
1020 9312 : punit = cp_print_key_unit_nr(logger, dft_section, "PRINT%KPOINTS", extension=".Log")
1021 7 : ELSE IF (PRESENT(iounit)) THEN
1022 7 : punit = iounit
1023 : ELSE
1024 0 : punit = cp_logger_get_default_unit_nr(logger)
1025 : END IF
1026 :
1027 9319 : IF (punit > 0) THEN
1028 :
1029 2123 : IF (kpoint%kp_scheme /= "NONE") THEN
1030 111 : WRITE (punit, '(/," ",79("*"),/,T37,A,/," ",79("*"))') "Kpoints"
1031 : END IF
1032 1 : SELECT CASE (kpoint%kp_scheme)
1033 : CASE ("NONE")
1034 : ! be silent
1035 : CASE ("GAMMA")
1036 1 : WRITE (punit, '(A,T57,A)') ' BRILLOUIN|', ' Gamma-point calculation'
1037 : CASE ("MONKHORST-PACK")
1038 107 : WRITE (punit, '(A,T61,A20)') ' BRILLOUIN| K-point scheme ', ' Monkhorst-Pack'
1039 107 : WRITE (punit, '(A,T66,3I5)') ' BRILLOUIN| K-Point grid', kpoint%nkp_grid
1040 107 : IF (kpoint%gamma_centered) THEN
1041 1 : WRITE (punit, '(A,T76,A)') ' BRILLOUIN| Gamma-centered k-point mesh', ' ON'
1042 : END IF
1043 : WRITE (punit, '(A,T66,G15.6)') &
1044 107 : ' BRILLOUIN| K-point symmetry accuracy', kpoint%eps_geo
1045 : CASE ("MACDONALD")
1046 3 : WRITE (punit, '(A,T71,A10)') ' BRILLOUIN| K-point scheme ', ' MacDonald'
1047 3 : WRITE (punit, '(A,T66,3I5)') ' BRILLOUIN| K-Point grid', kpoint%nkp_grid
1048 3 : WRITE (punit, '(A,T51,3F10.4)') ' BRILLOUIN| K-Point shift', kpoint%kp_shift
1049 3 : IF (kpoint%gamma_centered) THEN
1050 0 : WRITE (punit, '(A,T76,A)') ' BRILLOUIN| Gamma-centered k-point mesh', ' ON'
1051 : END IF
1052 : WRITE (punit, '(A,T66,G15.6)') &
1053 3 : ' BRILLOUIN| K-point symmetry accuracy', kpoint%eps_geo
1054 : CASE ("GENERAL")
1055 0 : WRITE (punit, '(A,T71,A10)') ' BRILLOUIN| K-point scheme ', ' General'
1056 : CASE DEFAULT
1057 : CALL cp_abort(__LOCATION__, &
1058 : "<NONE>, <GAMMA>, <MONKHORST-PACK>, <MACDONALD>, "// &
1059 : "<GENERAL> are supported as the <kpoint%kp_scheme> for "// &
1060 : "write_kpoint_info, found unknown option "// &
1061 2123 : "<"//TRIM(kpoint%kp_scheme)//">")
1062 : END SELECT
1063 2123 : IF (kpoint%kp_scheme /= "NONE") THEN
1064 111 : IF (kpoint%symmetry) THEN
1065 79 : WRITE (punit, '(A,T76,A)') ' BRILLOUIN| K-Point point group symmetrization', ' ON'
1066 : ELSE
1067 32 : WRITE (punit, '(A,T76,A)') ' BRILLOUIN| K-Point point group symmetrization', ' OFF'
1068 : END IF
1069 111 : IF (kpoint%inversion_symmetry_only) THEN
1070 4 : WRITE (punit, '(A,T76,A)') ' BRILLOUIN| Restrict symmetry to inversion', ' ON'
1071 : END IF
1072 : IF (kpoint%symmetry .AND. .NOT. kpoint%full_grid .AND. &
1073 111 : .NOT. kpoint%inversion_symmetry_only .AND. &
1074 : (kpoint%kp_scheme == "MONKHORST-PACK" .OR. kpoint%kp_scheme == "MACDONALD" .OR. &
1075 : kpoint%kp_scheme == "GENERAL")) THEN
1076 86 : SELECT CASE (kpoint%symmetry_backend)
1077 : CASE (use_k290_kpoint_backend)
1078 30 : WRITE (punit, '(A,T73,A)') ' BRILLOUIN| Symmetry backend', ' K290'
1079 : CASE (use_spglib_kpoint_backend)
1080 26 : WRITE (punit, '(A,T73,A)') ' BRILLOUIN| Symmetry backend', ' SPGLIB'
1081 : CASE DEFAULT
1082 56 : CPABORT("Unknown k-point symmetry backend")
1083 : END SELECT
1084 86 : SELECT CASE (kpoint%symmetry_reduction_method)
1085 : CASE (use_k290_kpoint_symmetry)
1086 30 : WRITE (punit, '(A,T73,A)') ' BRILLOUIN| Symmetry reduction method', ' K290'
1087 : CASE (use_spglib_kpoint_symmetry)
1088 26 : WRITE (punit, '(A,T73,A)') ' BRILLOUIN| Symmetry reduction method', ' SPGLIB'
1089 : CASE DEFAULT
1090 111 : CPABORT("Unknown k-point symmetry reduction method")
1091 : END SELECT
1092 : END IF
1093 111 : IF (kpoint%use_real_wfn) THEN
1094 0 : WRITE (punit, '(A,T76,A)') ' BRILLOUIN| Wavefunction type', ' REAL'
1095 : ELSE
1096 111 : WRITE (punit, '(A,T73,A)') ' BRILLOUIN| Wavefunction type', ' COMPLEX'
1097 : END IF
1098 111 : IF (kpoint%full_grid) THEN
1099 19 : WRITE (punit, '(A,T76,A)') ' BRILLOUIN| Use full k-point grid '
1100 : END IF
1101 111 : IF (kpoint%kp_scheme /= "GAMMA") THEN
1102 110 : WRITE (punit, '(A,T71,I10)') ' BRILLOUIN| List of Kpoints [2 Pi/Bohr]', kpoint%nkp
1103 : WRITE (punit, '(A,T30,A,T48,A,T63,A,T78,A)') &
1104 110 : ' BRILLOUIN| Number ', 'Weight', 'X', 'Y', 'Z'
1105 882 : DO i = 1, kpoint%nkp
1106 772 : WRITE (punit, '(A,I5,3X,4F15.5)') ' BRILLOUIN| ', i, kpoint%wkp(i), &
1107 1654 : kpoint%xkp(1, i), kpoint%xkp(2, i), kpoint%xkp(3, i)
1108 : END DO
1109 : END IF
1110 111 : WRITE (punit, '(" ",79("*"))')
1111 : END IF
1112 :
1113 : END IF
1114 :
1115 9319 : IF (PRESENT(dft_section)) THEN
1116 9312 : CALL cp_print_key_finished_output(punit, logger, dft_section, "PRINT%KPOINTS")
1117 : END IF
1118 :
1119 9319 : END SUBROUTINE write_kpoint_info
1120 :
1121 : ! **************************************************************************************************
1122 : !> \brief Create a single kpoint environment
1123 : !> \param kp_env Single kpoint environment
1124 : !> \author JGH
1125 : ! **************************************************************************************************
1126 7810 : SUBROUTINE kpoint_env_create(kp_env)
1127 : TYPE(kpoint_env_type), POINTER :: kp_env
1128 :
1129 7810 : CPASSERT(.NOT. ASSOCIATED(kp_env))
1130 :
1131 39050 : ALLOCATE (kp_env)
1132 :
1133 7810 : kp_env%nkpoint = 0
1134 : kp_env%wkp = 0.0_dp
1135 31240 : kp_env%xkp = 0.0_dp
1136 7810 : kp_env%is_local = .FALSE.
1137 :
1138 7810 : NULLIFY (kp_env%mos)
1139 7810 : NULLIFY (kp_env%pmat)
1140 7810 : NULLIFY (kp_env%wmat)
1141 7810 : NULLIFY (kp_env%ot_hmat)
1142 7810 : NULLIFY (kp_env%ot_smat)
1143 7810 : NULLIFY (kp_env%ot_tmat)
1144 :
1145 7810 : END SUBROUTINE kpoint_env_create
1146 :
1147 : ! **************************************************************************************************
1148 : !> \brief Release a single kpoint environment
1149 : !> \param kp_env Single kpoint environment
1150 : !> \author JGH
1151 : ! **************************************************************************************************
1152 7810 : SUBROUTINE kpoint_env_release(kp_env)
1153 : TYPE(kpoint_env_type), POINTER :: kp_env
1154 :
1155 : INTEGER :: is
1156 :
1157 7810 : IF (ASSOCIATED(kp_env)) THEN
1158 :
1159 7810 : IF (ASSOCIATED(kp_env%mos)) THEN
1160 16356 : DO is = 1, SIZE(kp_env%mos)
1161 16356 : CALL deallocate_mo_set(kp_env%mos(is))
1162 : END DO
1163 7810 : DEALLOCATE (kp_env%mos)
1164 : END IF
1165 :
1166 7810 : CALL cp_fm_release(kp_env%pmat)
1167 7810 : CALL cp_fm_release(kp_env%wmat)
1168 7810 : CALL cp_fm_release(kp_env%smat)
1169 7810 : CALL cp_fm_release(kp_env%amat)
1170 7810 : CALL cp_cfm_release(kp_env%csmat)
1171 7810 : CALL cp_cfm_release(kp_env%camat)
1172 7810 : CALL cp_fm_release(kp_env%ot_hmat)
1173 7810 : CALL cp_fm_release(kp_env%ot_smat)
1174 7810 : CALL cp_fm_release(kp_env%ot_tmat)
1175 :
1176 7810 : CALL cp_fm_release(kp_env%shalf)
1177 7810 : CALL cp_cfm_release(kp_env%cshalf)
1178 7810 : CALL cp_fm_release(kp_env%lowdin_b)
1179 7810 : CALL cp_fm_release(kp_env%lowdin_work)
1180 7810 : CALL cp_cfm_release(kp_env%lowdin_cb)
1181 7810 : CALL cp_cfm_release(kp_env%lowdin_cwork)
1182 7810 : CALL cp_cfm_release(kp_env%lowdin_evec)
1183 7810 : CALL kp_env%lowdin_gemm%destroy()
1184 :
1185 7810 : DEALLOCATE (kp_env)
1186 :
1187 : END IF
1188 :
1189 7810 : END SUBROUTINE kpoint_env_release
1190 :
1191 : ! **************************************************************************************************
1192 : !> \brief Get information from a single kpoint environment
1193 : !> \param kpoint_env Single kpoint environment
1194 : !> \param nkpoint Index of kpoint
1195 : !> \param wkp Weight of kpoint
1196 : !> \param xkp Coordinates of kpoint
1197 : !> \param is_local Is this kpoint local (single cpu group)
1198 : !> \param mos MOs of this kpoint
1199 : !> \author JGH
1200 : ! **************************************************************************************************
1201 5214 : SUBROUTINE get_kpoint_env(kpoint_env, nkpoint, wkp, xkp, is_local, mos)
1202 : TYPE(kpoint_env_type), INTENT(IN) :: kpoint_env
1203 : INTEGER, OPTIONAL :: nkpoint
1204 : REAL(KIND=dp), OPTIONAL :: wkp
1205 : REAL(KIND=dp), DIMENSION(3), OPTIONAL :: xkp
1206 : LOGICAL, OPTIONAL :: is_local
1207 : TYPE(mo_set_type), DIMENSION(:), OPTIONAL, POINTER :: mos
1208 :
1209 5214 : IF (PRESENT(nkpoint)) nkpoint = kpoint_env%nkpoint
1210 5214 : IF (PRESENT(wkp)) wkp = kpoint_env%wkp
1211 5214 : IF (PRESENT(xkp)) xkp = kpoint_env%xkp
1212 5214 : IF (PRESENT(is_local)) is_local = kpoint_env%is_local
1213 5214 : IF (PRESENT(mos)) mos => kpoint_env%mos
1214 :
1215 5214 : END SUBROUTINE get_kpoint_env
1216 :
1217 : ! **************************************************************************************************
1218 : !> \brief Create a single kpoint symmetry environment
1219 : !> \param kp_sym ...
1220 : !> \author JGH
1221 : ! **************************************************************************************************
1222 23976 : SUBROUTINE kpoint_sym_create(kp_sym)
1223 : TYPE(kpoint_sym_type), POINTER :: kp_sym
1224 :
1225 23976 : CPASSERT(.NOT. ASSOCIATED(kp_sym))
1226 :
1227 23976 : ALLOCATE (kp_sym)
1228 :
1229 23976 : kp_sym%nwght = 0
1230 23976 : kp_sym%nwred = 0
1231 : kp_sym%apply_symmetry = .FALSE.
1232 :
1233 : NULLIFY (kp_sym%rot)
1234 : NULLIFY (kp_sym%xkp)
1235 : NULLIFY (kp_sym%rotp)
1236 : NULLIFY (kp_sym%f0)
1237 : NULLIFY (kp_sym%fcell)
1238 : NULLIFY (kp_sym%fcell_gauge)
1239 : NULLIFY (kp_sym%phase_mode)
1240 :
1241 23976 : END SUBROUTINE kpoint_sym_create
1242 :
1243 : ! **************************************************************************************************
1244 : !> \brief Release a single kpoint symmetry environment
1245 : !> \param kp_sym ...
1246 : !> \author JGH
1247 : ! **************************************************************************************************
1248 23976 : SUBROUTINE kpoint_sym_release(kp_sym)
1249 : TYPE(kpoint_sym_type), POINTER :: kp_sym
1250 :
1251 23976 : IF (ASSOCIATED(kp_sym)) THEN
1252 :
1253 23976 : IF (ASSOCIATED(kp_sym%rot)) THEN
1254 3722 : DEALLOCATE (kp_sym%rot)
1255 : END IF
1256 23976 : IF (ASSOCIATED(kp_sym%xkp)) THEN
1257 3722 : DEALLOCATE (kp_sym%xkp)
1258 : END IF
1259 23976 : IF (ASSOCIATED(kp_sym%f0)) THEN
1260 3722 : DEALLOCATE (kp_sym%f0)
1261 : END IF
1262 23976 : IF (ASSOCIATED(kp_sym%fcell)) THEN
1263 3722 : DEALLOCATE (kp_sym%fcell)
1264 : END IF
1265 23976 : IF (ASSOCIATED(kp_sym%fcell_gauge)) THEN
1266 3722 : DEALLOCATE (kp_sym%fcell_gauge)
1267 : END IF
1268 23976 : IF (ASSOCIATED(kp_sym%phase_mode)) THEN
1269 3722 : DEALLOCATE (kp_sym%phase_mode)
1270 : END IF
1271 23976 : IF (ASSOCIATED(kp_sym%rotp)) THEN
1272 3722 : DEALLOCATE (kp_sym%rotp)
1273 : END IF
1274 :
1275 23976 : DEALLOCATE (kp_sym)
1276 :
1277 : END IF
1278 :
1279 23976 : END SUBROUTINE kpoint_sym_release
1280 :
1281 : ! **************************************************************************************************
1282 : !> \brief Locate the basis-rotation slot corresponding to a signed k-point symmetry operation.
1283 : !> \param qs_kpoint SCF k-point object
1284 : !> \param rotp signed operation identifier
1285 : !> \return rotation slot, or zero when no slot matches
1286 : ! **************************************************************************************************
1287 392432 : INTEGER FUNCTION find_kpoint_rotation_slot(qs_kpoint, rotp) RESULT(rot_slot)
1288 : TYPE(kpoint_type), POINTER :: qs_kpoint
1289 : INTEGER, INTENT(IN) :: rotp
1290 :
1291 : INTEGER :: irot, rot_abs
1292 :
1293 392432 : rot_slot = 0
1294 392432 : rot_abs = ABS(rotp)
1295 392432 : IF (.NOT. ASSOCIATED(qs_kpoint%ibrot)) RETURN
1296 1710886 : DO irot = 1, SIZE(qs_kpoint%ibrot)
1297 1710886 : IF (rot_abs == qs_kpoint%ibrot(irot)) THEN
1298 392432 : rot_slot = irot
1299 : RETURN
1300 : END IF
1301 : END DO
1302 :
1303 : END FUNCTION find_kpoint_rotation_slot
1304 :
1305 0 : END MODULE kpoint_types
|
