(git:04040e4)
Loading...
Searching...
No Matches
qs_scf_csr_write.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 Functions to print the KS and S matrix in the CSR format to file
10!> \par History
11!> Started as a copy from the relevant part of qs_scf_post_gpw
12!> \author Fabian Ducry (05.2020)
13! **************************************************************************************************
15 USE cp_dbcsr_api, ONLY: &
18 dbcsr_csr_dbcsr_blkrow_dist, dbcsr_csr_destroy, dbcsr_csr_type, dbcsr_csr_write, &
20 dbcsr_put_block, dbcsr_release, dbcsr_set, dbcsr_type, dbcsr_type_antisymmetric, &
21 dbcsr_type_no_symmetry, dbcsr_type_symmetric
28 USE cp_output_handling, ONLY: cp_p_file,&
35 USE kinds, ONLY: default_path_length,&
36 dp
38 USE kpoint_types, ONLY: get_kpoint_info,&
49 USE qs_rho_types, ONLY: qs_rho_get,&
51#include "./base/base_uses.f90"
52
53 IMPLICIT NONE
54 PRIVATE
55
56 ! Global parameters
57 CHARACTER(len=*), PARAMETER, PRIVATE :: moduleN = 'qs_scf_csr_write'
58 PUBLIC :: write_ks_matrix_csr, &
62
63! **************************************************************************************************
64
65CONTAINS
66
67!**************************************************************************************************
68!> \brief writing the KS matrix in csr format into a file
69!> \param qs_env qs environment
70!> \param input the input
71!> \par History
72!> Moved to module qs_scf_csr_write (05.2020)
73!> \author Mohammad Hossein Bani-Hashemian
74! **************************************************************************************************
75 SUBROUTINE write_ks_matrix_csr(qs_env, input)
76 TYPE(qs_environment_type), POINTER :: qs_env
77 TYPE(section_vals_type), POINTER :: input
78
79 CHARACTER(len=*), PARAMETER :: routinen = 'write_ks_matrix_csr'
80
81 INTEGER :: handle, output_unit
82 LOGICAL :: do_kpoints, do_ks_csr_write, real_space
83 TYPE(cp_logger_type), POINTER :: logger
84 TYPE(dbcsr_p_type), DIMENSION(:, :), POINTER :: matrix_ks
85 TYPE(kpoint_type), POINTER :: kpoints
86 TYPE(section_vals_type), POINTER :: dft_section
87
88 CALL timeset(routinen, handle)
89
90 NULLIFY (dft_section)
91
92 logger => cp_get_default_logger()
93 output_unit = cp_logger_get_default_io_unit(logger)
94
95 dft_section => section_vals_get_subs_vals(input, "DFT")
96 do_ks_csr_write = btest(cp_print_key_should_output(logger%iter_info, dft_section, &
97 "PRINT%KS_CSR_WRITE"), cp_p_file)
98
99 IF (do_ks_csr_write) THEN
100 CALL get_qs_env(qs_env=qs_env, kpoints=kpoints, matrix_ks_kp=matrix_ks, do_kpoints=do_kpoints)
101 CALL section_vals_val_get(dft_section, "PRINT%KS_CSR_WRITE%REAL_SPACE", &
102 l_val=real_space)
103
104 IF (do_kpoints .AND. .NOT. real_space) THEN
105 CALL write_matrix_kp_csr(mat=matrix_ks, dft_section=dft_section, &
106 kpoints=kpoints, prefix="KS")
107 ELSE
108 CALL write_matrix_csr(dft_section, mat=matrix_ks, kpoints=kpoints, do_kpoints=do_kpoints, &
109 prefix="KS")
110 END IF
111 END IF
112
113 CALL timestop(handle)
114
115 END SUBROUTINE write_ks_matrix_csr
116
117!**************************************************************************************************
118!> \brief writing the overlap matrix in csr format into a file
119!> \param qs_env qs environment
120!> \param input the input
121!> \par History
122!> Moved to module qs_scf_csr_write
123!> \author Mohammad Hossein Bani-Hashemian
124! **************************************************************************************************
125 SUBROUTINE write_s_matrix_csr(qs_env, input)
126 TYPE(qs_environment_type), POINTER :: qs_env
127 TYPE(section_vals_type), POINTER :: input
128
129 CHARACTER(len=*), PARAMETER :: routinen = 'write_s_matrix_csr'
130
131 INTEGER :: handle, output_unit
132 LOGICAL :: do_kpoints, do_s_csr_write, real_space
133 TYPE(cp_logger_type), POINTER :: logger
134 TYPE(dbcsr_p_type), DIMENSION(:, :), POINTER :: matrix_s
135 TYPE(kpoint_type), POINTER :: kpoints
136 TYPE(section_vals_type), POINTER :: dft_section
137
138 CALL timeset(routinen, handle)
139
140 NULLIFY (dft_section)
141
142 logger => cp_get_default_logger()
143 output_unit = cp_logger_get_default_io_unit(logger)
144
145 dft_section => section_vals_get_subs_vals(input, "DFT")
146 do_s_csr_write = btest(cp_print_key_should_output(logger%iter_info, dft_section, &
147 "PRINT%S_CSR_WRITE"), cp_p_file)
148
149 IF (do_s_csr_write) THEN
150 CALL get_qs_env(qs_env=qs_env, kpoints=kpoints, matrix_s_kp=matrix_s, do_kpoints=do_kpoints)
151 CALL section_vals_val_get(dft_section, "PRINT%S_CSR_WRITE%REAL_SPACE", &
152 l_val=real_space)
153
154 IF (do_kpoints .AND. .NOT. real_space) THEN
155 CALL write_matrix_kp_csr(mat=matrix_s, dft_section=dft_section, &
156 kpoints=kpoints, prefix="S")
157 ELSE
158 CALL write_matrix_csr(dft_section, mat=matrix_s, kpoints=kpoints, do_kpoints=do_kpoints, &
159 prefix="S")
160 END IF
161 END IF
162
163 CALL timestop(handle)
164
165 END SUBROUTINE write_s_matrix_csr
166
167!**************************************************************************************************
168!> \brief writing the density matrix in csr format into a file
169!> \param qs_env qs environment
170!> \param input the input
171!> \par History
172!> \author Mohammad Hossein Bani-Hashemian
173! **************************************************************************************************
174 SUBROUTINE write_p_matrix_csr(qs_env, input)
175 TYPE(qs_environment_type), POINTER :: qs_env
176 TYPE(section_vals_type), POINTER :: input
177
178 CHARACTER(len=*), PARAMETER :: routinen = 'write_p_matrix_csr'
179
180 INTEGER :: handle, output_unit
181 LOGICAL :: do_kpoints, do_p_csr_write, real_space
182 TYPE(cp_logger_type), POINTER :: logger
183 TYPE(dbcsr_p_type), DIMENSION(:, :), POINTER :: rho_ao_kp
184 TYPE(kpoint_type), POINTER :: kpoints
185 TYPE(qs_rho_type), POINTER :: rho
186 TYPE(section_vals_type), POINTER :: dft_section
187
188 CALL timeset(routinen, handle)
189
190 NULLIFY (dft_section)
191
192 logger => cp_get_default_logger()
193 output_unit = cp_logger_get_default_io_unit(logger)
194
195 dft_section => section_vals_get_subs_vals(input, "DFT")
196 do_p_csr_write = btest(cp_print_key_should_output(logger%iter_info, dft_section, &
197 "PRINT%P_CSR_WRITE"), cp_p_file)
198
199 IF (do_p_csr_write) THEN
200 CALL get_qs_env(qs_env=qs_env, kpoints=kpoints, rho=rho, do_kpoints=do_kpoints)
201 CALL qs_rho_get(rho, rho_ao_kp=rho_ao_kp)
202 CALL section_vals_val_get(dft_section, "PRINT%P_CSR_WRITE%REAL_SPACE", &
203 l_val=real_space)
204
205 IF (do_kpoints .AND. .NOT. real_space) THEN
206 CALL write_matrix_kp_csr(mat=rho_ao_kp, dft_section=dft_section, &
207 kpoints=kpoints, prefix="P")
208 ELSE
209 CALL write_matrix_csr(dft_section, mat=rho_ao_kp, kpoints=kpoints, do_kpoints=do_kpoints, &
210 prefix="P")
211 END IF
212 END IF
213
214 CALL timestop(handle)
215
216 END SUBROUTINE write_p_matrix_csr
217
218!**************************************************************************************************
219!> \brief writing the core Hamiltonian matrix in csr format into a file
220!> \param qs_env qs environment
221!> \param input the input
222!> \par History
223!> \author Mohammad Hossein Bani-Hashemian
224! **************************************************************************************************
225 SUBROUTINE write_hcore_matrix_csr(qs_env, input)
226 TYPE(qs_environment_type), POINTER :: qs_env
227 TYPE(section_vals_type), POINTER :: input
228
229 CHARACTER(len=*), PARAMETER :: routinen = 'write_hcore_matrix_csr'
230
231 INTEGER :: handle, output_unit
232 LOGICAL :: do_h_csr_write, do_kpoints, real_space
233 TYPE(cp_logger_type), POINTER :: logger
234 TYPE(dbcsr_p_type), DIMENSION(:, :), POINTER :: matrix_h
235 TYPE(kpoint_type), POINTER :: kpoints
236 TYPE(section_vals_type), POINTER :: dft_section
237
238 CALL timeset(routinen, handle)
239
240 NULLIFY (dft_section)
241
242 logger => cp_get_default_logger()
243 output_unit = cp_logger_get_default_io_unit(logger)
244
245 dft_section => section_vals_get_subs_vals(input, "DFT")
246 do_h_csr_write = btest(cp_print_key_should_output(logger%iter_info, dft_section, &
247 "PRINT%HCORE_CSR_WRITE"), cp_p_file)
248
249 IF (do_h_csr_write) THEN
250 CALL get_qs_env(qs_env=qs_env, kpoints=kpoints, matrix_h_kp=matrix_h, do_kpoints=do_kpoints)
251 CALL section_vals_val_get(dft_section, "PRINT%HCORE_CSR_WRITE%REAL_SPACE", &
252 l_val=real_space)
253
254 IF (do_kpoints .AND. .NOT. real_space) THEN
255 CALL write_matrix_kp_csr(mat=matrix_h, dft_section=dft_section, &
256 kpoints=kpoints, prefix="HCORE")
257 ELSE
258 CALL write_matrix_csr(dft_section, mat=matrix_h, kpoints=kpoints, do_kpoints=do_kpoints, &
259 prefix="HCORE")
260 END IF
261 END IF
262
263 CALL timestop(handle)
264
265 END SUBROUTINE write_hcore_matrix_csr
266
267! **************************************************************************************************
268!> \brief helper function to print the real space representation of KS or S matrix to file
269!> \param dft_section the dft_section
270!> \param mat Hamiltonian or overlap matrix
271!> \param kpoints Kpoint environment
272!> \param prefix string to distinguish between KS and S matrix
273!> \param do_kpoints Whether it is a gamma-point or k-point calculation
274!> \par History
275!> Moved most of the code from write_ks_matrix_csr and write_s_matrix_csr
276!> Removed the code for printing k-point dependent matrices and added
277!> printing of the real space representation
278! **************************************************************************************************
279 SUBROUTINE write_matrix_csr(dft_section, mat, kpoints, prefix, do_kpoints)
280 TYPE(section_vals_type), INTENT(IN), POINTER :: dft_section
281 TYPE(dbcsr_p_type), DIMENSION(:, :), INTENT(IN), &
282 POINTER :: mat
283 TYPE(kpoint_type), INTENT(IN), POINTER :: kpoints
284 CHARACTER(*), INTENT(in) :: prefix
285 LOGICAL, INTENT(IN) :: do_kpoints
286
287 CHARACTER(len=*), PARAMETER :: routinen = 'write_matrix_csr'
288
289 CHARACTER(LEN=default_path_length) :: file_name, fileformat, subs_string
290 INTEGER :: handle, ic, ispin, ncell, nspin, &
291 output_unit, unit_nr
292 INTEGER, ALLOCATABLE, DIMENSION(:, :) :: index_to_cell
293 INTEGER, ALLOCATABLE, DIMENSION(:, :, :) :: cell_to_index
294 INTEGER, DIMENSION(:, :), POINTER :: i2c
295 INTEGER, DIMENSION(:, :, :), POINTER :: c2i
296 LOGICAL :: bin, do_symmetric, uptr
297 REAL(kind=dp) :: thld
298 TYPE(cp_logger_type), POINTER :: logger
299 TYPE(dbcsr_csr_type) :: mat_csr
300 TYPE(dbcsr_p_type), DIMENSION(:, :), POINTER :: mat_nosym
301 TYPE(dbcsr_type) :: matrix_nosym
302 TYPE(neighbor_list_set_p_type), DIMENSION(:), &
303 POINTER :: sab_nl
304
305 CALL timeset(routinen, handle)
306
307 logger => cp_get_default_logger()
308 output_unit = cp_logger_get_default_io_unit(logger)
309
310 subs_string = "PRINT%"//prefix//"_CSR_WRITE"
311
312 CALL section_vals_val_get(dft_section, subs_string//"%THRESHOLD", r_val=thld)
313 CALL section_vals_val_get(dft_section, subs_string//"%UPPER_TRIANGULAR", l_val=uptr)
314 CALL section_vals_val_get(dft_section, subs_string//"%BINARY", l_val=bin)
315
316 IF (bin) THEN
317 fileformat = "UNFORMATTED"
318 ELSE
319 fileformat = "FORMATTED"
320 END IF
321
322 nspin = SIZE(mat, 1)
323 ncell = SIZE(mat, 2)
324
325 IF (do_kpoints) THEN
326
327 i2c => kpoints%index_to_cell
328 c2i => kpoints%cell_to_index
329
330 NULLIFY (sab_nl)
331 CALL get_kpoint_info(kpoints, sab_nl=sab_nl)
332 CALL get_neighbor_list_set_p(neighbor_list_sets=sab_nl, symmetric=do_symmetric)
333
334 ! desymmetrize the KS or S matrices if necessary
335 IF (do_symmetric) THEN
336 CALL desymmetrize_rs_matrix(mat, mat_nosym, cell_to_index, index_to_cell, kpoints)
337 ncell = SIZE(index_to_cell, 2) ! update the number of cells
338 ELSE
339 ALLOCATE (cell_to_index(lbound(c2i, 1):ubound(c2i, 1), &
340 lbound(c2i, 2):ubound(c2i, 2), &
341 lbound(c2i, 3):ubound(c2i, 3)))
342 cell_to_index(lbound(c2i, 1):ubound(c2i, 1), &
343 lbound(c2i, 2):ubound(c2i, 2), &
344 lbound(c2i, 3):ubound(c2i, 3)) = c2i
345
346 ALLOCATE (index_to_cell(3, ncell))
347 index_to_cell(1:3, 1:ncell) = i2c
348
349 mat_nosym => mat
350 END IF
351
352 ! print the index to cell mapping to the output
353 IF (output_unit > 0) THEN
354 WRITE (output_unit, "(/,A15,T15,I4,A)") prefix//" CSR write| ", &
355 ncell, " periodic images"
356 WRITE (output_unit, "(T7,A,T17,A,T24,A,T31,A)") "Number", "X", "Y", "Z"
357 DO ic = 1, ncell
358 WRITE (output_unit, "(T8,I3,T15,I3,T22,I3,T29,I3)") ic, index_to_cell(:, ic)
359 END DO
360 END IF
361 END IF
362
363 ! write the csr file(s)
364 DO ispin = 1, nspin
365 DO ic = 1, ncell
366 IF (do_kpoints) THEN
367 CALL dbcsr_copy(matrix_nosym, mat_nosym(ispin, ic)%matrix)
368 WRITE (file_name, '(2(A,I0))') prefix//"_SPIN_", ispin, "_R_", ic
369 ELSE
370 IF (dbcsr_has_symmetry(mat(ispin, ic)%matrix)) THEN
371 CALL dbcsr_desymmetrize(mat(ispin, ic)%matrix, matrix_nosym)
372 ELSE
373 CALL dbcsr_copy(matrix_nosym, mat(ispin, ic)%matrix)
374 END IF
375 WRITE (file_name, '(A,I0)') prefix//"_SPIN_", ispin
376 END IF
377 ! Convert dbcsr to csr
378 CALL dbcsr_csr_create_from_dbcsr(matrix_nosym, &
379 mat_csr, dbcsr_csr_dbcsr_blkrow_dist)
380 CALL dbcsr_convert_dbcsr_to_csr(matrix_nosym, mat_csr)
381 ! Write to file
382 unit_nr = cp_print_key_unit_nr(logger, dft_section, subs_string, &
383 extension=".csr", middle_name=trim(file_name), &
384 file_status="REPLACE", file_form=fileformat)
385 CALL dbcsr_csr_write(mat_csr, unit_nr, upper_triangle=uptr, threshold=thld, binary=bin)
386
387 CALL cp_print_key_finished_output(unit_nr, logger, dft_section, subs_string)
388 CALL dbcsr_csr_destroy(mat_csr)
389 CALL dbcsr_release(matrix_nosym)
390 END DO
391 END DO
392
393 ! clean up
394 IF (do_kpoints) THEN
395 DEALLOCATE (cell_to_index, index_to_cell)
396 IF (do_symmetric) THEN
397 DO ispin = 1, nspin
398 DO ic = 1, ncell
399 CALL dbcsr_release(mat_nosym(ispin, ic)%matrix)
400 END DO
401 END DO
402 CALL dbcsr_deallocate_matrix_set(mat_nosym)
403 END IF
404 END IF
405 CALL timestop(handle)
406
407 END SUBROUTINE write_matrix_csr
408
409! **************************************************************************************************
410!> \brief helper function to print the k-dependent KS or S matrix to file
411!> \param mat Hamiltonian or overlap matrix for k-point calculations
412!> \param dft_section the dft_section
413!> \param kpoints Kpoint environment
414!> \param prefix string to distinguish between KS and S matrix
415!> \par History
416!> Moved the code from write_matrix_csr to write_matrix_kp_csr
417!> \author Fabian Ducry
418! **************************************************************************************************
419 SUBROUTINE write_matrix_kp_csr(mat, dft_section, kpoints, prefix)
420 TYPE(dbcsr_p_type), DIMENSION(:, :), INTENT(IN), &
421 POINTER :: mat
422 TYPE(section_vals_type), INTENT(IN), POINTER :: dft_section
423 TYPE(kpoint_type), INTENT(IN), POINTER :: kpoints
424 CHARACTER(*), INTENT(in) :: prefix
425
426 CHARACTER(len=*), PARAMETER :: routinen = 'write_matrix_kp_csr'
427
428 CHARACTER(LEN=default_path_length) :: file_name, fileformat, subs_string
429 INTEGER :: handle, igroup, ik, ikp, ispin, kplocal, &
430 nkp_groups, output_unit, unit_nr
431 INTEGER, DIMENSION(2) :: kp_range
432 INTEGER, DIMENSION(:, :), POINTER :: kp_dist
433 LOGICAL :: bin, uptr, use_real_wfn
434 REAL(kind=dp) :: thld
435 REAL(kind=dp), DIMENSION(:, :), POINTER :: xkp
436 TYPE(cp_logger_type), POINTER :: logger
437 TYPE(dbcsr_csr_type) :: mat_csr
438 TYPE(dbcsr_type) :: matrix_nosym
439 TYPE(dbcsr_type), POINTER :: imatrix, imatrix_nosym, rmatrix, &
440 rmatrix_nosym
441 TYPE(neighbor_list_set_p_type), DIMENSION(:), &
442 POINTER :: sab_nl
443
444 CALL timeset(routinen, handle)
445
446 logger => cp_get_default_logger()
447 output_unit = cp_logger_get_default_io_unit(logger)
448
449 subs_string = "PRINT%"//prefix//"_CSR_WRITE"
450
451 CALL section_vals_val_get(dft_section, subs_string//"%THRESHOLD", r_val=thld)
452 CALL section_vals_val_get(dft_section, subs_string//"%UPPER_TRIANGULAR", l_val=uptr)
453 CALL section_vals_val_get(dft_section, subs_string//"%BINARY", l_val=bin)
454
455 IF (bin) THEN
456 fileformat = "UNFORMATTED"
457 ELSE
458 fileformat = "FORMATTED"
459 END IF
460
461 NULLIFY (sab_nl)
462
463 ! Calculate the Hamiltonian at the k-points
464 CALL get_kpoint_info(kpoints, xkp=xkp, use_real_wfn=use_real_wfn, kp_range=kp_range, &
465 nkp_groups=nkp_groups, kp_dist=kp_dist, sab_nl=sab_nl)
466
467 ALLOCATE (rmatrix)
468 CALL dbcsr_create(rmatrix, template=mat(1, 1)%matrix, &
469 matrix_type=dbcsr_type_symmetric)
470 CALL cp_dbcsr_alloc_block_from_nbl(rmatrix, sab_nl)
471
472 IF (.NOT. use_real_wfn) THEN
473 ! Allocate temporary variables
474 ALLOCATE (rmatrix_nosym, imatrix, imatrix_nosym)
475 CALL dbcsr_create(rmatrix_nosym, template=mat(1, 1)%matrix, &
476 matrix_type=dbcsr_type_no_symmetry)
477 CALL dbcsr_create(imatrix, template=mat(1, 1)%matrix, &
478 matrix_type=dbcsr_type_antisymmetric)
479 CALL dbcsr_create(imatrix_nosym, template=mat(1, 1)%matrix, &
480 matrix_type=dbcsr_type_no_symmetry)
481 CALL cp_dbcsr_alloc_block_from_nbl(rmatrix_nosym, sab_nl)
482 CALL cp_dbcsr_alloc_block_from_nbl(imatrix, sab_nl)
483 CALL cp_dbcsr_alloc_block_from_nbl(imatrix_nosym, sab_nl)
484 END IF
485
486 kplocal = kp_range(2) - kp_range(1) + 1
487 DO ikp = 1, kplocal
488 DO ispin = 1, SIZE(mat, 1)
489 DO igroup = 1, nkp_groups
490 ! number of current kpoint
491 ik = kp_dist(1, igroup) + ikp - 1
492 CALL dbcsr_set(rmatrix, 0.0_dp)
493 IF (use_real_wfn) THEN
494 ! FT of the matrix
495 CALL rskp_transform(rmatrix=rmatrix, rsmat=mat, ispin=ispin, &
496 xkp=xkp(1:3, ik), cell_to_index=kpoints%cell_to_index, sab_nl=sab_nl)
497 ! Convert to desymmetrized csr matrix
498 CALL dbcsr_desymmetrize(rmatrix, matrix_nosym)
499 CALL dbcsr_csr_create_from_dbcsr(matrix_nosym, mat_csr, dbcsr_csr_dbcsr_blkrow_dist)
500 CALL dbcsr_convert_dbcsr_to_csr(matrix_nosym, mat_csr)
501 CALL dbcsr_release(matrix_nosym)
502 ELSE
503 ! FT of the matrix
504 CALL dbcsr_set(imatrix, 0.0_dp)
505 CALL rskp_transform(rmatrix=rmatrix, cmatrix=imatrix, rsmat=mat, ispin=ispin, &
506 xkp=xkp(1:3, ik), cell_to_index=kpoints%cell_to_index, sab_nl=sab_nl)
507
508 ! Desymmetrize and sum the real and imaginary part into
509 ! cmatrix
510 CALL dbcsr_desymmetrize(rmatrix, rmatrix_nosym)
511 CALL dbcsr_desymmetrize(imatrix, imatrix_nosym)
512 ! Convert to csr
513 CALL dbcsr_csr_create_and_convert_complex(rmatrix=rmatrix_nosym, &
514 imatrix=imatrix_nosym, &
515 csr_mat=mat_csr, &
516 dist_format=dbcsr_csr_dbcsr_blkrow_dist)
517 END IF
518 ! Write to file
519 WRITE (file_name, '(2(A,I0))') prefix//"_SPIN_", ispin, "_K_", ik
520 unit_nr = cp_print_key_unit_nr(logger, dft_section, subs_string, &
521 extension=".csr", middle_name=trim(file_name), &
522 file_status="REPLACE", file_form=fileformat)
523 CALL dbcsr_csr_write(mat_csr, unit_nr, upper_triangle=uptr, threshold=thld, binary=bin)
524
525 CALL cp_print_key_finished_output(unit_nr, logger, dft_section, subs_string)
526
527 CALL dbcsr_csr_destroy(mat_csr)
528 END DO
529 END DO
530 END DO
531 CALL dbcsr_release(rmatrix)
532 DEALLOCATE (rmatrix)
533 IF (.NOT. use_real_wfn) THEN
534 CALL dbcsr_release(rmatrix_nosym)
535 CALL dbcsr_release(imatrix)
536 CALL dbcsr_release(imatrix_nosym)
537 DEALLOCATE (rmatrix_nosym, imatrix, imatrix_nosym)
538 END IF
539 CALL timestop(handle)
540
541 END SUBROUTINE write_matrix_kp_csr
542
543! **************************************************************************************************
544!> \brief Desymmetrizes the KS or S matrices which are stored in symmetric !matrices
545!> \param mat Hamiltonian or overlap matrices
546!> \param mat_nosym Desymmetrized Hamiltonian or overlap matrices
547!> \param cell_to_index Mapping of cell indices to linear RS indices
548!> \param index_to_cell Mapping of linear RS indices to cell indices
549!> \param kpoints Kpoint environment
550!> \author Fabian Ducry
551! **************************************************************************************************
552 SUBROUTINE desymmetrize_rs_matrix(mat, mat_nosym, cell_to_index, index_to_cell, kpoints)
553 TYPE(dbcsr_p_type), DIMENSION(:, :), INTENT(IN), &
554 POINTER :: mat
555 TYPE(dbcsr_p_type), DIMENSION(:, :), &
556 INTENT(INOUT), POINTER :: mat_nosym
557 INTEGER, ALLOCATABLE, DIMENSION(:, :, :), &
558 INTENT(OUT) :: cell_to_index
559 INTEGER, ALLOCATABLE, DIMENSION(:, :), INTENT(OUT) :: index_to_cell
560 TYPE(kpoint_type), INTENT(IN), POINTER :: kpoints
561
562 CHARACTER(len=*), PARAMETER :: routinen = 'desymmetrize_rs_matrix'
563
564 INTEGER :: handle, iatom, ic, icn, icol, irow, &
565 ispin, jatom, ncell, nomirror, nspin, &
566 nx, ny, nz
567 INTEGER, DIMENSION(3) :: cell
568 INTEGER, DIMENSION(:, :), POINTER :: i2c
569 INTEGER, DIMENSION(:, :, :), POINTER :: c2i
570 LOGICAL :: found, lwtr
571 REAL(kind=dp), DIMENSION(:, :), POINTER :: block
573 DIMENSION(:), POINTER :: nl_iterator
574 TYPE(neighbor_list_set_p_type), DIMENSION(:), &
575 POINTER :: sab_nl
576
577 CALL timeset(routinen, handle)
578
579 i2c => kpoints%index_to_cell
580 c2i => kpoints%cell_to_index
581
582 ncell = SIZE(i2c, 2)
583 nspin = SIZE(mat, 1)
584
585 nx = max(abs(lbound(c2i, 1)), abs(ubound(c2i, 1)))
586 ny = max(abs(lbound(c2i, 2)), abs(ubound(c2i, 3)))
587 nz = max(abs(lbound(c2i, 3)), abs(ubound(c2i, 3)))
588 ALLOCATE (cell_to_index(-nx:nx, -ny:ny, -nz:nz))
589 cell_to_index(lbound(c2i, 1):ubound(c2i, 1), &
590 lbound(c2i, 2):ubound(c2i, 2), &
591 lbound(c2i, 3):ubound(c2i, 3)) = c2i
592
593 ! identify cells with no mirror img
594 nomirror = 0
595 DO ic = 1, ncell
596 cell = i2c(:, ic)
597 IF (cell_to_index(-cell(1), -cell(2), -cell(3)) == 0) &
598 nomirror = nomirror + 1
599 END DO
600
601 ! create the mirror imgs
602 ALLOCATE (index_to_cell(3, ncell + nomirror))
603 index_to_cell(:, 1:ncell) = i2c
604
605 nomirror = 0 ! count the imgs without mirror
606 DO ic = 1, ncell
607 cell = index_to_cell(:, ic)
608 IF (cell_to_index(-cell(1), -cell(2), -cell(3)) == 0) THEN
609 nomirror = nomirror + 1
610 index_to_cell(:, ncell + nomirror) = -cell
611 cell_to_index(-cell(1), -cell(2), -cell(3)) = ncell + nomirror
612 END IF
613 END DO
614 ncell = ncell + nomirror
615
616 CALL get_kpoint_info(kpoints, sab_nl=sab_nl)
617 ! allocate the nonsymmetric matrices
618 NULLIFY (mat_nosym)
619 CALL dbcsr_allocate_matrix_set(mat_nosym, nspin, ncell)
620 DO ispin = 1, nspin
621 DO ic = 1, ncell
622 ALLOCATE (mat_nosym(ispin, ic)%matrix)
623 CALL dbcsr_create(matrix=mat_nosym(ispin, ic)%matrix, &
624 template=mat(1, 1)%matrix, &
625 matrix_type=dbcsr_type_no_symmetry)
626 CALL cp_dbcsr_alloc_block_from_nbl(mat_nosym(ispin, ic)%matrix, &
627 sab_nl, desymmetrize=.true.)
628 CALL dbcsr_set(mat_nosym(ispin, ic)%matrix, 0.0_dp)
629 END DO
630 END DO
631
632 DO ispin = 1, nspin
633 ! desymmetrize the matrix for real space printing
634 CALL neighbor_list_iterator_create(nl_iterator, sab_nl)
635 DO WHILE (neighbor_list_iterate(nl_iterator) == 0)
636 CALL get_iterator_info(nl_iterator, iatom=iatom, jatom=jatom, cell=cell)
637
638 ic = cell_to_index(cell(1), cell(2), cell(3))
639 icn = cell_to_index(-cell(1), -cell(2), -cell(3))
640 cpassert(icn > 0)
641
642 irow = iatom
643 icol = jatom
644 lwtr = .false.
645 ! always copy from the top
646 IF (iatom > jatom) THEN
647 irow = jatom
648 icol = iatom
649 lwtr = .true.
650 END IF
651
652 CALL dbcsr_get_block_p(matrix=mat(ispin, ic)%matrix, &
653 row=irow, col=icol, block=block, found=found)
654 cpassert(found)
655
656 ! copy to M(R) at (iatom,jatom)
657 ! copy to M(-R) at (jatom,iatom)
658 IF (lwtr) THEN
659 CALL dbcsr_put_block(matrix=mat_nosym(ispin, ic)%matrix, &
660 row=iatom, col=jatom, block=transpose(block))
661 CALL dbcsr_put_block(matrix=mat_nosym(ispin, icn)%matrix, &
662 row=jatom, col=iatom, block=block)
663 ELSE
664 CALL dbcsr_put_block(matrix=mat_nosym(ispin, ic)%matrix, &
665 row=iatom, col=jatom, block=block)
666 CALL dbcsr_put_block(matrix=mat_nosym(ispin, icn)%matrix, &
667 row=jatom, col=iatom, block=transpose(block))
668 END IF
669 END DO
670 CALL neighbor_list_iterator_release(nl_iterator)
671 END DO
672
673 DO ispin = 1, nspin
674 DO ic = 1, ncell
675 CALL dbcsr_finalize(mat_nosym(ispin, ic)%matrix)
676 END DO
677 END DO
678
679 CALL timestop(handle)
680
681 END SUBROUTINE desymmetrize_rs_matrix
682
683END MODULE qs_scf_csr_write
logical function, public dbcsr_has_symmetry(matrix)
...
subroutine, public dbcsr_convert_dbcsr_to_csr(dbcsr_mat, csr_mat)
...
subroutine, public dbcsr_desymmetrize(matrix_a, matrix_b)
...
subroutine, public dbcsr_copy(matrix_b, matrix_a, name, keep_sparsity, keep_imaginary)
...
subroutine, public dbcsr_get_block_p(matrix, row, col, block, found, row_size, col_size)
...
subroutine, public dbcsr_csr_create_and_convert_complex(rmatrix, imatrix, csr_mat, dist_format)
Combines csr_create_from_dbcsr and convert_dbcsr_to_csr to produce a complex CSR matrix.
subroutine, public dbcsr_csr_create_from_dbcsr(dbcsr_mat, csr_mat, dist_format, csr_sparsity, numnodes)
...
subroutine, public dbcsr_finalize(matrix)
...
subroutine, public dbcsr_set(matrix, alpha)
...
subroutine, public dbcsr_release(matrix)
...
subroutine, public dbcsr_put_block(matrix, row, col, block, summation)
...
DBCSR operations in CP2K.
various routines to log and control the output. The idea is that decisions about where to log should ...
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...
type(cp_logger_type) function, pointer, public cp_get_default_logger()
returns the default logger
routines to handle the output, The idea is to remove the decision of wheter to output and what to out...
integer function, public cp_print_key_unit_nr(logger, basis_section, print_key_path, extension, middle_name, local, log_filename, ignore_should_output, file_form, file_position, file_action, file_status, do_backup, on_file, is_new_file, mpi_io, fout)
...
subroutine, public cp_print_key_finished_output(unit_nr, logger, basis_section, print_key_path, local, ignore_should_output, on_file, mpi_io)
should be called after you finish working with a unit obtained with cp_print_key_unit_nr,...
integer, parameter, public cp_p_file
integer function, public cp_print_key_should_output(iteration_info, basis_section, print_key_path, used_print_key, first_time)
returns what should be done with the given property if btest(res,cp_p_store) then the property should...
objects that represent the structure of input sections and the data contained in an input section
recursive type(section_vals_type) function, pointer, public section_vals_get_subs_vals(section_vals, subsection_name, i_rep_section, can_return_null)
returns the values of the requested subsection
subroutine, public section_vals_val_get(section_vals, keyword_name, i_rep_section, i_rep_val, n_rep_val, val, l_val, i_val, r_val, c_val, l_vals, i_vals, r_vals, c_vals, explicit)
returns the requested value
Defines the basic variable types.
Definition kinds.F:23
integer, parameter, public dp
Definition kinds.F:34
integer, parameter, public default_path_length
Definition kinds.F:58
Routines needed for kpoint calculation.
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.
Types and basic routines needed for a kpoint calculation.
subroutine, public get_kpoint_info(kpoint, kp_scheme, nkp_grid, kp_shift, symmetry, verbose, full_grid, use_real_wfn, eps_geo, parallel_group_size, kp_range, nkp, xkp, wkp, para_env, blacs_env_all, para_env_kp, para_env_inter_kp, blacs_env, kp_env, kp_aux_env, mpools, iogrp, nkp_groups, kp_dist, cell_to_index, index_to_cell, sab_nl, sab_nl_nosym)
Retrieve information from a kpoint environment.
subroutine, public get_qs_env(qs_env, atomic_kind_set, qs_kind_set, cell, super_cell, cell_ref, use_ref_cell, kpoints, dft_control, mos, sab_orb, sab_all, qmmm, qmmm_periodic, mimic, sac_ae, sac_ppl, sac_lri, sap_ppnl, sab_vdw, sab_scp, sap_oce, sab_lrc, sab_se, sab_xtbe, sab_tbe, sab_core, sab_xb, sab_xtb_pp, sab_xtb_nonbond, sab_almo, sab_kp, sab_kp_nosym, sab_cneo, particle_set, energy, force, matrix_h, matrix_h_im, matrix_ks, matrix_ks_im, matrix_vxc, run_rtp, rtp, matrix_h_kp, matrix_h_im_kp, matrix_ks_kp, matrix_ks_im_kp, matrix_vxc_kp, kinetic_kp, matrix_s_kp, matrix_w_kp, matrix_s_ri_aux_kp, matrix_s, matrix_s_ri_aux, matrix_w, matrix_p_mp2, matrix_p_mp2_admm, rho, rho_xc, pw_env, ewald_env, ewald_pw, active_space, mpools, input, para_env, blacs_env, scf_control, rel_control, kinetic, qs_charges, vppl, rho_core, rho_nlcc, rho_nlcc_g, ks_env, ks_qmmm_env, wf_history, scf_env, local_particles, local_molecules, distribution_2d, dbcsr_dist, molecule_kind_set, molecule_set, subsys, cp_subsys, oce, local_rho_set, rho_atom_set, task_list, task_list_soft, rho0_atom_set, rho0_mpole, rhoz_set, rhoz_cneo_set, ecoul_1c, rho0_s_rs, rho0_s_gs, rhoz_cneo_s_rs, rhoz_cneo_s_gs, do_kpoints, has_unit_metric, requires_mo_derivs, mo_derivs, mo_loc_history, nkind, natom, nelectron_total, nelectron_spin, efield, neighbor_list_id, linres_control, xas_env, virial, cp_ddapc_env, cp_ddapc_ewald, outer_scf_history, outer_scf_ihistory, x_data, et_coupling, dftb_potential, results, se_taper, se_store_int_env, se_nddo_mpole, se_nonbond_env, admm_env, lri_env, lri_density, exstate_env, ec_env, harris_env, dispersion_env, gcp_env, vee, rho_external, external_vxc, mask, mp2_env, bs_env, kg_env, wanniercentres, atprop, ls_scf_env, do_transport, transport_env, v_hartree_rspace, s_mstruct_changed, rho_changed, potential_changed, forces_up_to_date, mscfg_env, almo_scf_env, gradient_history, variable_history, embed_pot, spin_embed_pot, polar_env, mos_last_converged, eeq, rhs, do_rixs, tb_tblite)
Get the QUICKSTEP environment.
Define the neighbor list data types and the corresponding functionality.
subroutine, public neighbor_list_iterator_create(iterator_set, nl, search, nthread)
Neighbor list iterator functions.
subroutine, public neighbor_list_iterator_release(iterator_set)
...
subroutine, public get_neighbor_list_set_p(neighbor_list_sets, nlist, symmetric)
Return the components of the first neighbor list set.
integer function, public neighbor_list_iterate(iterator_set, mepos)
...
subroutine, public get_iterator_info(iterator_set, mepos, ikind, jkind, nkind, ilist, nlist, inode, nnode, iatom, jatom, r, cell)
...
superstucture that hold various representations of the density and keeps track of which ones are vali...
subroutine, public qs_rho_get(rho_struct, rho_ao, rho_ao_im, rho_ao_kp, rho_ao_im_kp, rho_r, drho_r, rho_g, drho_g, tau_r, tau_g, rho_r_valid, drho_r_valid, rho_g_valid, drho_g_valid, tau_r_valid, tau_g_valid, tot_rho_r, tot_rho_g, rho_r_sccs, soft_valid, complex_rho_ao)
returns info about the density described by this object. If some representation is not available an e...
Functions to print the KS and S matrix in the CSR format to file.
subroutine, public write_s_matrix_csr(qs_env, input)
writing the overlap matrix in csr format into a file
subroutine, public write_ks_matrix_csr(qs_env, input)
writing the KS matrix in csr format into a file
subroutine, public write_p_matrix_csr(qs_env, input)
writing the density matrix in csr format into a file
subroutine, public write_hcore_matrix_csr(qs_env, input)
writing the core Hamiltonian matrix in csr format into a file
type of a logger, at the moment it contains just a print level starting at which level it should be l...
Contains information about kpoints.
keeps the density in various representations, keeping track of which ones are valid.