(git:e7e05ae)
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-2024 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 ! **************************************************************************************************
14 MODULE qs_scf_csr_write
15  USE cp_dbcsr_cp2k_link, ONLY: cp_dbcsr_alloc_block_from_nbl
16  USE cp_dbcsr_operations, ONLY: dbcsr_allocate_matrix_set,&
17  dbcsr_deallocate_matrix_set
18  USE cp_log_handling, ONLY: cp_get_default_logger,&
19  cp_logger_get_default_io_unit,&
20  cp_logger_type
21  USE cp_output_handling, ONLY: cp_p_file,&
22  cp_print_key_finished_output,&
23  cp_print_key_should_output,&
24  cp_print_key_unit_nr
25  USE dbcsr_api, ONLY: &
26  dbcsr_add, dbcsr_convert_dbcsr_to_csr, dbcsr_copy, dbcsr_create, &
27  dbcsr_csr_create_from_dbcsr, dbcsr_csr_dbcsr_blkrow_dist, dbcsr_csr_destroy, &
28  dbcsr_csr_type, dbcsr_csr_write, dbcsr_desymmetrize, dbcsr_finalize, dbcsr_get_block_p, &
29  dbcsr_has_symmetry, dbcsr_p_type, dbcsr_put_block, dbcsr_release, dbcsr_set, dbcsr_type, &
30  dbcsr_type_antisymmetric, dbcsr_type_complex_8, dbcsr_type_no_symmetry, dbcsr_type_real_8, &
31  dbcsr_type_symmetric
32  USE input_section_types, ONLY: section_vals_get_subs_vals,&
33  section_vals_type,&
34  section_vals_val_get
35  USE kinds, ONLY: default_path_length,&
36  dp
37  USE kpoint_methods, ONLY: rskp_transform
38  USE kpoint_types, ONLY: get_kpoint_info,&
39  kpoint_type
40  USE qs_environment_types, ONLY: get_qs_env,&
41  qs_environment_type
42  USE qs_neighbor_list_types, ONLY: get_iterator_info,&
43  get_neighbor_list_set_p,&
44  neighbor_list_iterate,&
45  neighbor_list_iterator_create,&
46  neighbor_list_iterator_p_type,&
47  neighbor_list_iterator_release,&
48  neighbor_list_set_p_type
49 #include "./base/base_uses.f90"
50 
51  IMPLICIT NONE
52  PRIVATE
53 
54  ! Global parameters
55  CHARACTER(len=*), PARAMETER, PRIVATE :: moduleN = 'qs_scf_csr_write'
56  PUBLIC :: write_ks_matrix_csr, &
57  write_s_matrix_csr
58 
59 ! **************************************************************************************************
60 
61 CONTAINS
62 
63 !**************************************************************************************************
64 !> \brief writing the KS matrix in csr format into a file
65 !> \param qs_env qs environment
66 !> \param input the input
67 !> \par History
68 !> Moved to module qs_scf_csr_write (05.2020)
69 !> \author Mohammad Hossein Bani-Hashemian
70 ! **************************************************************************************************
71  SUBROUTINE write_ks_matrix_csr(qs_env, input)
72  TYPE(qs_environment_type), POINTER :: qs_env
73  TYPE(section_vals_type), POINTER :: input
74 
75  CHARACTER(len=*), PARAMETER :: routinen = 'write_ks_matrix_csr'
76 
77  INTEGER :: handle, output_unit
78  LOGICAL :: do_kpoints, do_ks_csr_write, real_space
79  TYPE(cp_logger_type), POINTER :: logger
80  TYPE(dbcsr_p_type), DIMENSION(:, :), POINTER :: matrix_ks
81  TYPE(kpoint_type), POINTER :: kpoints
82  TYPE(section_vals_type), POINTER :: dft_section
83 
84  CALL timeset(routinen, handle)
85 
86  NULLIFY (dft_section)
87 
88  logger => cp_get_default_logger()
89  output_unit = cp_logger_get_default_io_unit(logger)
90 
91  dft_section => section_vals_get_subs_vals(input, "DFT")
92  do_ks_csr_write = btest(cp_print_key_should_output(logger%iter_info, dft_section, &
93  "PRINT%KS_CSR_WRITE"), cp_p_file)
94 
95  IF (do_ks_csr_write) THEN
96  CALL get_qs_env(qs_env=qs_env, kpoints=kpoints, matrix_ks_kp=matrix_ks, do_kpoints=do_kpoints)
97  CALL section_vals_val_get(dft_section, "PRINT%KS_CSR_WRITE%REAL_SPACE", &
98  l_val=real_space)
99 
100  IF (do_kpoints .AND. .NOT. real_space) THEN
101  CALL write_matrix_kp_csr(mat=matrix_ks, dft_section=dft_section, &
102  kpoints=kpoints, prefix="KS")
103  ELSE
104  CALL write_matrix_csr(dft_section, mat=matrix_ks, kpoints=kpoints, do_kpoints=do_kpoints, &
105  prefix="KS")
106  END IF
107  END IF
108 
109  CALL timestop(handle)
110 
111  END SUBROUTINE write_ks_matrix_csr
112 
113 !**************************************************************************************************
114 !> \brief writing the overlap matrix in csr format into a file
115 !> \param qs_env qs environment
116 !> \param input the input
117 !> \par History
118 !> Moved to module qs_scf_csr_write
119 !> \author Mohammad Hossein Bani-Hashemian
120 ! **************************************************************************************************
121  SUBROUTINE write_s_matrix_csr(qs_env, input)
122  TYPE(qs_environment_type), POINTER :: qs_env
123  TYPE(section_vals_type), POINTER :: input
124 
125  CHARACTER(len=*), PARAMETER :: routinen = 'write_s_matrix_csr'
126 
127  INTEGER :: handle, output_unit
128  LOGICAL :: do_kpoints, do_s_csr_write, real_space
129  TYPE(cp_logger_type), POINTER :: logger
130  TYPE(dbcsr_p_type), DIMENSION(:, :), POINTER :: matrix_s
131  TYPE(kpoint_type), POINTER :: kpoints
132  TYPE(section_vals_type), POINTER :: dft_section
133 
134  CALL timeset(routinen, handle)
135 
136  NULLIFY (dft_section)
137 
138  logger => cp_get_default_logger()
139  output_unit = cp_logger_get_default_io_unit(logger)
140 
141  dft_section => section_vals_get_subs_vals(input, "DFT")
142  do_s_csr_write = btest(cp_print_key_should_output(logger%iter_info, dft_section, &
143  "PRINT%S_CSR_WRITE"), cp_p_file)
144 
145  IF (do_s_csr_write) THEN
146  CALL get_qs_env(qs_env=qs_env, kpoints=kpoints, matrix_s_kp=matrix_s, do_kpoints=do_kpoints)
147  CALL section_vals_val_get(dft_section, "PRINT%S_CSR_WRITE%REAL_SPACE", &
148  l_val=real_space)
149 
150  IF (do_kpoints .AND. .NOT. real_space) THEN
151  CALL write_matrix_kp_csr(mat=matrix_s, dft_section=dft_section, &
152  kpoints=kpoints, prefix="S")
153  ELSE
154  CALL write_matrix_csr(dft_section, mat=matrix_s, kpoints=kpoints, do_kpoints=do_kpoints, &
155  prefix="S")
156  END IF
157  END IF
158 
159  CALL timestop(handle)
160 
161  END SUBROUTINE write_s_matrix_csr
162 
163 ! **************************************************************************************************
164 !> \brief helper function to print the real space representation of KS or S matrix to file
165 !> \param dft_section the dft_section
166 !> \param mat Hamiltonian or overlap matrix
167 !> \param kpoints Kpoint environment
168 !> \param prefix string to distinguish between KS and S matrix
169 !> \param do_kpoints Whether it is a gamma-point or k-point calculation
170 !> \par History
171 !> Moved most of the code from write_ks_matrix_csr and write_s_matrix_csr
172 !> Removed the code for printing k-point dependent matrices and added
173 !> printing of the real space representation
174 ! **************************************************************************************************
175  SUBROUTINE write_matrix_csr(dft_section, mat, kpoints, prefix, do_kpoints)
176  TYPE(section_vals_type), INTENT(IN), POINTER :: dft_section
177  TYPE(dbcsr_p_type), DIMENSION(:, :), INTENT(IN), &
178  POINTER :: mat
179  TYPE(kpoint_type), INTENT(IN), POINTER :: kpoints
180  CHARACTER(*), INTENT(in) :: prefix
181  LOGICAL, INTENT(IN) :: do_kpoints
182 
183  CHARACTER(len=*), PARAMETER :: routinen = 'write_matrix_csr'
184 
185  CHARACTER(LEN=default_path_length) :: file_name, fileformat, subs_string
186  INTEGER :: handle, ic, ispin, ncell, nspin, &
187  output_unit, unit_nr
188  INTEGER, ALLOCATABLE, DIMENSION(:, :) :: index_to_cell
189  INTEGER, ALLOCATABLE, DIMENSION(:, :, :) :: cell_to_index
190  INTEGER, DIMENSION(:, :), POINTER :: i2c
191  INTEGER, DIMENSION(:, :, :), POINTER :: c2i
192  LOGICAL :: bin, do_symmetric, uptr
193  REAL(kind=dp) :: thld
194  TYPE(cp_logger_type), POINTER :: logger
195  TYPE(dbcsr_csr_type) :: mat_csr
196  TYPE(dbcsr_p_type), DIMENSION(:, :), POINTER :: mat_nosym
197  TYPE(dbcsr_type) :: matrix_nosym
198  TYPE(neighbor_list_set_p_type), DIMENSION(:), &
199  POINTER :: sab_nl
200 
201  CALL timeset(routinen, handle)
202 
203  logger => cp_get_default_logger()
204  output_unit = cp_logger_get_default_io_unit(logger)
205 
206  subs_string = "PRINT%"//prefix//"_CSR_WRITE"
207 
208  CALL section_vals_val_get(dft_section, subs_string//"%THRESHOLD", r_val=thld)
209  CALL section_vals_val_get(dft_section, subs_string//"%UPPER_TRIANGULAR", l_val=uptr)
210  CALL section_vals_val_get(dft_section, subs_string//"%BINARY", l_val=bin)
211 
212  IF (bin) THEN
213  fileformat = "UNFORMATTED"
214  ELSE
215  fileformat = "FORMATTED"
216  END IF
217 
218  nspin = SIZE(mat, 1)
219  ncell = SIZE(mat, 2)
220 
221  IF (do_kpoints) THEN
222 
223  i2c => kpoints%index_to_cell
224  c2i => kpoints%cell_to_index
225 
226  NULLIFY (sab_nl)
227  CALL get_kpoint_info(kpoints, sab_nl=sab_nl)
228  CALL get_neighbor_list_set_p(neighbor_list_sets=sab_nl, symmetric=do_symmetric)
229 
230  ! desymmetrize the KS or S matrices if necessary
231  IF (do_symmetric) THEN
232  CALL desymmetrize_rs_matrix(mat, mat_nosym, cell_to_index, index_to_cell, kpoints)
233  ncell = SIZE(index_to_cell, 2) ! update the number of cells
234  ELSE
235  ALLOCATE (cell_to_index(lbound(c2i, 1):ubound(c2i, 1), &
236  lbound(c2i, 2):ubound(c2i, 2), &
237  lbound(c2i, 3):ubound(c2i, 3)))
238  cell_to_index(lbound(c2i, 1):ubound(c2i, 1), &
239  lbound(c2i, 2):ubound(c2i, 2), &
240  lbound(c2i, 3):ubound(c2i, 3)) = c2i
241 
242  ALLOCATE (index_to_cell(3, ncell))
243  index_to_cell(1:3, 1:ncell) = i2c
244 
245  mat_nosym => mat
246  END IF
247 
248  ! print the index to cell mapping to the output
249  IF (output_unit > 0) THEN
250  WRITE (output_unit, "(/,A15,T15,I4,A)") prefix//" CSR write| ", &
251  ncell, " periodic images"
252  WRITE (output_unit, "(T7,A,T17,A,T24,A,T31,A)") "Number", "X", "Y", "Z"
253  DO ic = 1, ncell
254  WRITE (output_unit, "(T8,I3,T15,I3,T22,I3,T29,I3)") ic, index_to_cell(:, ic)
255  END DO
256  END IF
257  END IF
258 
259  ! write the csr file(s)
260  DO ispin = 1, nspin
261  DO ic = 1, ncell
262  IF (do_kpoints) THEN
263  CALL dbcsr_copy(matrix_nosym, mat_nosym(ispin, ic)%matrix)
264  WRITE (file_name, '(2(A,I0))') prefix//"_SPIN_", ispin, "_R_", ic
265  ELSE
266  IF (dbcsr_has_symmetry(mat(ispin, ic)%matrix)) THEN
267  CALL dbcsr_desymmetrize(mat(ispin, ic)%matrix, matrix_nosym)
268  ELSE
269  CALL dbcsr_copy(matrix_nosym, mat(ispin, ic)%matrix)
270  END IF
271  WRITE (file_name, '(A,I0)') prefix//"_SPIN_", ispin
272  END IF
273  ! Convert dbcsr to csr
274  CALL dbcsr_csr_create_from_dbcsr(matrix_nosym, &
275  mat_csr, dbcsr_csr_dbcsr_blkrow_dist)
276  CALL dbcsr_convert_dbcsr_to_csr(matrix_nosym, mat_csr)
277  ! Write to file
278  unit_nr = cp_print_key_unit_nr(logger, dft_section, subs_string, &
279  extension=".csr", middle_name=trim(file_name), &
280  file_status="REPLACE", file_form=fileformat)
281  CALL dbcsr_csr_write(mat_csr, unit_nr, upper_triangle=uptr, threshold=thld, binary=bin)
282 
283  CALL cp_print_key_finished_output(unit_nr, logger, dft_section, subs_string)
284  CALL dbcsr_csr_destroy(mat_csr)
285  CALL dbcsr_release(matrix_nosym)
286  END DO
287  END DO
288 
289  ! clean up
290  IF (do_kpoints) THEN
291  DEALLOCATE (cell_to_index, index_to_cell)
292  IF (do_symmetric) THEN
293  DO ispin = 1, nspin
294  DO ic = 1, ncell
295  CALL dbcsr_release(mat_nosym(ispin, ic)%matrix)
296  END DO
297  END DO
298  CALL dbcsr_deallocate_matrix_set(mat_nosym)
299  END IF
300  END IF
301  CALL timestop(handle)
302 
303  END SUBROUTINE write_matrix_csr
304 
305 ! **************************************************************************************************
306 !> \brief helper function to print the k-dependent KS or S matrix to file
307 !> \param mat Hamiltonian or overlap matrix for k-point calculations
308 !> \param dft_section the dft_section
309 !> \param kpoints Kpoint environment
310 !> \param prefix string to distinguish between KS and S matrix
311 !> \par History
312 !> Moved the code from write_matrix_csr to write_matrix_kp_csr
313 !> \author Fabian Ducry
314 ! **************************************************************************************************
315  SUBROUTINE write_matrix_kp_csr(mat, dft_section, kpoints, prefix)
316  TYPE(dbcsr_p_type), DIMENSION(:, :), INTENT(IN), &
317  POINTER :: mat
318  TYPE(section_vals_type), INTENT(IN), POINTER :: dft_section
319  TYPE(kpoint_type), INTENT(IN), POINTER :: kpoints
320  CHARACTER(*), INTENT(in) :: prefix
321 
322  CHARACTER(len=*), PARAMETER :: routinen = 'write_matrix_kp_csr'
323  COMPLEX(KIND=dp), PARAMETER :: cone = cmplx(1.0_dp, 0.0_dp, kind=dp), &
324  ione = cmplx(0.0_dp, 1.0_dp, kind=dp)
325 
326  CHARACTER(LEN=default_path_length) :: file_name, fileformat, subs_string
327  INTEGER :: handle, igroup, ik, ikp, ispin, kplocal, &
328  nkp_groups, output_unit, unit_nr
329  INTEGER, DIMENSION(2) :: kp_range
330  INTEGER, DIMENSION(:, :), POINTER :: kp_dist
331  LOGICAL :: bin, uptr, use_real_wfn
332  REAL(kind=dp) :: thld
333  REAL(kind=dp), DIMENSION(:, :), POINTER :: xkp
334  TYPE(cp_logger_type), POINTER :: logger
335  TYPE(dbcsr_csr_type) :: mat_csr
336  TYPE(dbcsr_type) :: matrix_nosym
337  TYPE(dbcsr_type), POINTER :: cmatrix, imatrix, imatrix_nosym, &
338  rmatrix, rmatrix_nosym, tmatrix
339  TYPE(neighbor_list_set_p_type), DIMENSION(:), &
340  POINTER :: sab_nl
341 
342  CALL timeset(routinen, handle)
343 
344  logger => cp_get_default_logger()
345  output_unit = cp_logger_get_default_io_unit(logger)
346 
347  subs_string = "PRINT%"//prefix//"_CSR_WRITE"
348 
349  CALL section_vals_val_get(dft_section, subs_string//"%THRESHOLD", r_val=thld)
350  CALL section_vals_val_get(dft_section, subs_string//"%UPPER_TRIANGULAR", l_val=uptr)
351  CALL section_vals_val_get(dft_section, subs_string//"%BINARY", l_val=bin)
352 
353  IF (bin) THEN
354  fileformat = "UNFORMATTED"
355  ELSE
356  fileformat = "FORMATTED"
357  END IF
358 
359  NULLIFY (sab_nl)
360 
361  ! Calculate the Hamiltonian at the k-points
362  CALL get_kpoint_info(kpoints, xkp=xkp, use_real_wfn=use_real_wfn, kp_range=kp_range, &
363  nkp_groups=nkp_groups, kp_dist=kp_dist, sab_nl=sab_nl)
364 
365  ALLOCATE (rmatrix)
366  CALL dbcsr_create(rmatrix, template=mat(1, 1)%matrix, &
367  matrix_type=dbcsr_type_symmetric)
368  CALL cp_dbcsr_alloc_block_from_nbl(rmatrix, sab_nl)
369 
370  IF (.NOT. use_real_wfn) THEN
371  ! Allocate temporary variables
372  ALLOCATE (rmatrix_nosym, imatrix, imatrix_nosym, cmatrix, tmatrix)
373  CALL dbcsr_create(rmatrix_nosym, template=mat(1, 1)%matrix, &
374  matrix_type=dbcsr_type_no_symmetry)
375  CALL dbcsr_create(imatrix, template=mat(1, 1)%matrix, &
376  matrix_type=dbcsr_type_antisymmetric)
377  CALL dbcsr_create(imatrix_nosym, template=mat(1, 1)%matrix, &
378  matrix_type=dbcsr_type_no_symmetry)
379  CALL dbcsr_create(cmatrix, template=mat(1, 1)%matrix, &
380  matrix_type=dbcsr_type_no_symmetry, &
381  data_type=dbcsr_type_complex_8)
382  CALL dbcsr_create(tmatrix, template=mat(1, 1)%matrix, &
383  matrix_type=dbcsr_type_no_symmetry, &
384  data_type=dbcsr_type_complex_8)
385  CALL cp_dbcsr_alloc_block_from_nbl(rmatrix_nosym, sab_nl)
386  CALL cp_dbcsr_alloc_block_from_nbl(imatrix, sab_nl)
387  CALL cp_dbcsr_alloc_block_from_nbl(imatrix_nosym, sab_nl)
388  CALL cp_dbcsr_alloc_block_from_nbl(cmatrix, sab_nl)
389  CALL cp_dbcsr_alloc_block_from_nbl(tmatrix, sab_nl)
390  END IF
391 
392  kplocal = kp_range(2) - kp_range(1) + 1
393  DO ikp = 1, kplocal
394  DO ispin = 1, SIZE(mat, 1)
395  DO igroup = 1, nkp_groups
396  ! number of current kpoint
397  ik = kp_dist(1, igroup) + ikp - 1
398  CALL dbcsr_set(rmatrix, 0.0_dp)
399  IF (use_real_wfn) THEN
400  ! FT of the matrix
401  CALL rskp_transform(rmatrix=rmatrix, rsmat=mat, ispin=ispin, &
402  xkp=xkp(1:3, ik), cell_to_index=kpoints%cell_to_index, sab_nl=sab_nl)
403  ! Convert to desymmetrized csr matrix
404  CALL dbcsr_desymmetrize(rmatrix, matrix_nosym)
405  CALL dbcsr_csr_create_from_dbcsr(matrix_nosym, mat_csr, dbcsr_csr_dbcsr_blkrow_dist)
406  CALL dbcsr_convert_dbcsr_to_csr(matrix_nosym, mat_csr)
407  CALL dbcsr_release(matrix_nosym)
408  ELSE
409  ! FT of the matrix
410  CALL dbcsr_set(imatrix, 0.0_dp)
411  CALL rskp_transform(rmatrix=rmatrix, cmatrix=imatrix, rsmat=mat, ispin=ispin, &
412  xkp=xkp(1:3, ik), cell_to_index=kpoints%cell_to_index, sab_nl=sab_nl)
413 
414  ! Desymmetrize and sum the real and imaginary part into
415  ! cmatrix
416  CALL dbcsr_desymmetrize(rmatrix, rmatrix_nosym)
417  CALL dbcsr_desymmetrize(imatrix, imatrix_nosym)
418  CALL dbcsr_copy(cmatrix, rmatrix_nosym)
419  CALL dbcsr_copy(tmatrix, imatrix_nosym)
420  CALL dbcsr_add(cmatrix, tmatrix, cone, ione)
421  ! Convert to csr
422  CALL dbcsr_csr_create_from_dbcsr(cmatrix, mat_csr, dbcsr_csr_dbcsr_blkrow_dist)
423  CALL dbcsr_convert_dbcsr_to_csr(cmatrix, mat_csr)
424  END IF
425  ! Write to file
426  WRITE (file_name, '(2(A,I0))') prefix//"_SPIN_", ispin, "_K_", ik
427  unit_nr = cp_print_key_unit_nr(logger, dft_section, subs_string, &
428  extension=".csr", middle_name=trim(file_name), &
429  file_status="REPLACE", file_form=fileformat)
430  CALL dbcsr_csr_write(mat_csr, unit_nr, upper_triangle=uptr, threshold=thld, binary=bin)
431 
432  CALL cp_print_key_finished_output(unit_nr, logger, dft_section, subs_string)
433 
434  CALL dbcsr_csr_destroy(mat_csr)
435  END DO
436  END DO
437  END DO
438  CALL dbcsr_release(rmatrix)
439  DEALLOCATE (rmatrix)
440  IF (.NOT. use_real_wfn) THEN
441  CALL dbcsr_release(rmatrix_nosym)
442  CALL dbcsr_release(imatrix)
443  CALL dbcsr_release(imatrix_nosym)
444  CALL dbcsr_release(cmatrix)
445  CALL dbcsr_release(tmatrix)
446  DEALLOCATE (rmatrix_nosym, imatrix, imatrix_nosym, cmatrix, tmatrix)
447  END IF
448  CALL timestop(handle)
449 
450  END SUBROUTINE write_matrix_kp_csr
451 
452 ! **************************************************************************************************
453 !> \brief Desymmetrizes the KS or S matrices which are stored in symmetric !matrices
454 !> \param mat Hamiltonian or overlap matrices
455 !> \param mat_nosym Desymmetrized Hamiltonian or overlap matrices
456 !> \param cell_to_index Mapping of cell indices to linear RS indices
457 !> \param index_to_cell Mapping of linear RS indices to cell indices
458 !> \param kpoints Kpoint environment
459 !> \author Fabian Ducry
460 ! **************************************************************************************************
461  SUBROUTINE desymmetrize_rs_matrix(mat, mat_nosym, cell_to_index, index_to_cell, kpoints)
462  TYPE(dbcsr_p_type), DIMENSION(:, :), INTENT(IN), &
463  POINTER :: mat
464  TYPE(dbcsr_p_type), DIMENSION(:, :), &
465  INTENT(INOUT), POINTER :: mat_nosym
466  INTEGER, ALLOCATABLE, DIMENSION(:, :, :), &
467  INTENT(OUT) :: cell_to_index
468  INTEGER, ALLOCATABLE, DIMENSION(:, :), INTENT(OUT) :: index_to_cell
469  TYPE(kpoint_type), INTENT(IN), POINTER :: kpoints
470 
471  CHARACTER(len=*), PARAMETER :: routinen = 'desymmetrize_rs_matrix'
472 
473  INTEGER :: handle, iatom, ic, icn, icol, irow, &
474  ispin, jatom, ncell, nomirror, nspin, &
475  nx, ny, nz
476  INTEGER, DIMENSION(3) :: cell
477  INTEGER, DIMENSION(:, :), POINTER :: i2c
478  INTEGER, DIMENSION(:, :, :), POINTER :: c2i
479  LOGICAL :: found, lwtr
480  REAL(kind=dp), DIMENSION(:, :), POINTER :: block
481  TYPE(neighbor_list_iterator_p_type), &
482  DIMENSION(:), POINTER :: nl_iterator
483  TYPE(neighbor_list_set_p_type), DIMENSION(:), &
484  POINTER :: sab_nl
485 
486  CALL timeset(routinen, handle)
487 
488  i2c => kpoints%index_to_cell
489  c2i => kpoints%cell_to_index
490 
491  ncell = SIZE(i2c, 2)
492  nspin = SIZE(mat, 1)
493 
494  nx = max(abs(lbound(c2i, 1)), abs(ubound(c2i, 1)))
495  ny = max(abs(lbound(c2i, 2)), abs(ubound(c2i, 3)))
496  nz = max(abs(lbound(c2i, 3)), abs(ubound(c2i, 3)))
497  ALLOCATE (cell_to_index(-nx:nx, -ny:ny, -nz:nz))
498  cell_to_index(lbound(c2i, 1):ubound(c2i, 1), &
499  lbound(c2i, 2):ubound(c2i, 2), &
500  lbound(c2i, 3):ubound(c2i, 3)) = c2i
501 
502  ! identify cells with no mirror img
503  nomirror = 0
504  DO ic = 1, ncell
505  cell = i2c(:, ic)
506  IF (cell_to_index(-cell(1), -cell(2), -cell(3)) == 0) &
507  nomirror = nomirror + 1
508  END DO
509 
510  ! create the mirror imgs
511  ALLOCATE (index_to_cell(3, ncell + nomirror))
512  index_to_cell(:, 1:ncell) = i2c
513 
514  nomirror = 0 ! count the imgs without mirror
515  DO ic = 1, ncell
516  cell = index_to_cell(:, ic)
517  IF (cell_to_index(-cell(1), -cell(2), -cell(3)) == 0) THEN
518  nomirror = nomirror + 1
519  index_to_cell(:, ncell + nomirror) = -cell
520  cell_to_index(-cell(1), -cell(2), -cell(3)) = ncell + nomirror
521  END IF
522  END DO
523  ncell = ncell + nomirror
524 
525  CALL get_kpoint_info(kpoints, sab_nl=sab_nl)
526  ! allocate the nonsymmetric matrices
527  NULLIFY (mat_nosym)
528  CALL dbcsr_allocate_matrix_set(mat_nosym, nspin, ncell)
529  DO ispin = 1, nspin
530  DO ic = 1, ncell
531  ALLOCATE (mat_nosym(ispin, ic)%matrix)
532  CALL dbcsr_create(matrix=mat_nosym(ispin, ic)%matrix, &
533  template=mat(1, 1)%matrix, &
534  matrix_type=dbcsr_type_no_symmetry, &
535  data_type=dbcsr_type_real_8)
536  CALL cp_dbcsr_alloc_block_from_nbl(mat_nosym(ispin, ic)%matrix, &
537  sab_nl, desymmetrize=.true.)
538  CALL dbcsr_set(mat_nosym(ispin, ic)%matrix, 0.0_dp)
539  END DO
540  END DO
541 
542  DO ispin = 1, nspin
543  ! desymmetrize the matrix for real space printing
544  CALL neighbor_list_iterator_create(nl_iterator, sab_nl)
545  DO WHILE (neighbor_list_iterate(nl_iterator) == 0)
546  CALL get_iterator_info(nl_iterator, iatom=iatom, jatom=jatom, cell=cell)
547 
548  ic = cell_to_index(cell(1), cell(2), cell(3))
549  icn = cell_to_index(-cell(1), -cell(2), -cell(3))
550  cpassert(icn > 0)
551 
552  irow = iatom
553  icol = jatom
554  lwtr = .false.
555  ! always copy from the top
556  IF (iatom > jatom) THEN
557  irow = jatom
558  icol = iatom
559  lwtr = .true.
560  END IF
561 
562  CALL dbcsr_get_block_p(matrix=mat(ispin, ic)%matrix, &
563  row=irow, col=icol, block=block, found=found)
564  cpassert(found)
565 
566  ! copy to M(R) at (iatom,jatom)
567  ! copy to M(-R) at (jatom,iatom)
568  IF (lwtr) THEN
569  CALL dbcsr_put_block(matrix=mat_nosym(ispin, ic)%matrix, &
570  row=iatom, col=jatom, block=transpose(block))
571  CALL dbcsr_put_block(matrix=mat_nosym(ispin, icn)%matrix, &
572  row=jatom, col=iatom, block=block)
573  ELSE
574  CALL dbcsr_put_block(matrix=mat_nosym(ispin, ic)%matrix, &
575  row=iatom, col=jatom, block=block)
576  CALL dbcsr_put_block(matrix=mat_nosym(ispin, icn)%matrix, &
577  row=jatom, col=iatom, block=transpose(block))
578  END IF
579  END DO
580  CALL neighbor_list_iterator_release(nl_iterator)
581  END DO
582 
583  DO ispin = 1, nspin
584  DO ic = 1, ncell
585  CALL dbcsr_finalize(mat_nosym(ispin, ic)%matrix)
586  END DO
587  END DO
588 
589  CALL timestop(handle)
590 
591  END SUBROUTINE desymmetrize_rs_matrix
592 
593 END MODULE qs_scf_csr_write
cp_dbcsr_operations::dbcsr_allocate_matrix_set
Definition: cp_dbcsr_operations.F:81
cp_dbcsr_operations::dbcsr_deallocate_matrix_set
Definition: cp_dbcsr_operations.F:89
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_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
cp_log_handling::cp_get_default_logger
type(cp_logger_type) function, pointer, public cp_get_default_logger()
returns the default logger
Definition: cp_log_handling.F:234
cp_output_handling
routines to handle the output, The idea is to remove the decision of wheter to output and what to out...
Definition: cp_output_handling.F:25
cp_output_handling::cp_print_key_unit_nr
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)
...
Definition: cp_output_handling.F:803
cp_output_handling::cp_print_key_finished_output
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,...
Definition: cp_output_handling.F:1013
cp_output_handling::cp_p_file
integer, parameter, public cp_p_file
Definition: cp_output_handling.F:103
cp_output_handling::cp_print_key_should_output
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...
Definition: cp_output_handling.F:345
input_section_types
objects that represent the structure of input sections and the data contained in an input section
Definition: input_section_types.F:15
input_section_types::section_vals_get_subs_vals
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
Definition: input_section_types.F:724
input_section_types::section_vals_val_get
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
Definition: input_section_types.F:1040
kinds
Defines the basic variable types.
Definition: kinds.F:23
kinds::dp
integer, parameter, public dp
Definition: kinds.F:34
kinds::default_path_length
integer, parameter, public default_path_length
Definition: kinds.F:58
kpoint_methods
Routines needed for kpoint calculation.
Definition: kpoint_methods.F:15
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:780
kpoint_types
Types and basic routines needed for a kpoint calculation.
Definition: kpoint_types.F:15
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)
Retrieve information from a kpoint environment.
Definition: kpoint_types.F:333
qs_environment_types
Definition: qs_environment_types.F:14
qs_environment_types::get_qs_env
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, 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_nonbond, sab_almo, sab_kp, sab_kp_nosym, 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, ecoul_1c, rho0_s_rs, rho0_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, 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, rhs)
Get the QUICKSTEP environment.
Definition: qs_environment_types.F:502
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:993
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
qs_scf_csr_write
Functions to print the KS and S matrix in the CSR format to file.
Definition: qs_scf_csr_write.F:14
qs_scf_csr_write::write_s_matrix_csr
subroutine, public write_s_matrix_csr(qs_env, input)
writing the overlap matrix in csr format into a file
Definition: qs_scf_csr_write.F:122
qs_scf_csr_write::write_ks_matrix_csr
subroutine, public write_ks_matrix_csr(qs_env, input)
writing the KS matrix in csr format into a file
Definition: qs_scf_csr_write.F:72