Line data Source code
1 : !--------------------------------------------------------------------------------------------------!
2 : ! CP2K: A general program to perform molecular dynamics simulations !
3 : ! Copyright 2000-2025 CP2K developers group <https://cp2k.org> !
4 : ! !
5 : ! SPDX-License-Identifier: GPL-2.0-or-later !
6 : !--------------------------------------------------------------------------------------------------!
7 :
8 : ! **************************************************************************************************
9 : !> \brief Implements transformations from k-space to R-space for Fortran array matrices
10 : !> \note This code is less performant/more memory consuming than the methods in kpoint_methods.F
11 : !> Use only when transformations are not the computational bottleneck.
12 : !> \par History
13 : !> 11.2025 created [Stepan Marek]
14 : !> \author Stepan Marek
15 : ! **************************************************************************************************
16 : MODULE kpoint_k_r_trafo_simple
17 : USE cp_cfm_types, ONLY: cp_cfm_type
18 : USE cp_dbcsr_api, ONLY: dbcsr_get_info,&
19 : dbcsr_get_readonly_block_p,&
20 : dbcsr_p_type,&
21 : dbcsr_type,&
22 : dbcsr_type_no_symmetry
23 : USE cp_fm_types, ONLY: cp_fm_type
24 : USE kinds, ONLY: dp
25 : USE kpoint_types, ONLY: kpoint_type
26 : USE mathconstants, ONLY: twopi,&
27 : z_zero
28 : USE message_passing, ONLY: mp_comm_type
29 : USE qs_neighbor_list_types, ONLY: get_iterator_info,&
30 : neighbor_list_iterate,&
31 : neighbor_list_iterator_create,&
32 : neighbor_list_iterator_p_type,&
33 : neighbor_list_iterator_release,&
34 : neighbor_list_set_p_type
35 : #include "./base/base_uses.f90"
36 :
37 : IMPLICIT NONE
38 :
39 : PRIVATE
40 :
41 : CHARACTER(len=*), PARAMETER, PRIVATE :: moduleN = 'kpoint_k_r_trafo_simple'
42 :
43 : PUBLIC :: replicate_rs_matrices, &
44 : rs_to_kp, &
45 : fm_rs_to_kp, &
46 : add_kp_to_all_rs, &
47 : fm_add_kp_to_all_rs, &
48 : add_kp_to_rs
49 :
50 : CONTAINS
51 : ! **************************************************************************************************
52 : !> \brief Convert dbcsr matrices representing operators in real-space image cells to arrays
53 : !> \param rs_dbcsr_in Array of dbcsr matrices
54 : !> \param kpoint_in The kpoint environment of the source matrix (providing neighbor list and cell_to_index)
55 : !> \param rs_array_out Multidimensional array - matrices are duplicated on each MPI rank
56 : !> dim 1 : spin, dim 2 : rows, dim 3 : cols, dim 4 : image index
57 : !> \param cell_to_index_out Cell to index array for the destination array
58 : !> \date 11.2025
59 : !> \author Stepan Marek
60 : ! **************************************************************************************************
61 0 : SUBROUTINE replicate_rs_matrices(rs_dbcsr_in, kpoint_in, rs_array_out, cell_to_index_out)
62 : ! dimension 1 : spin, dimension 2 : image cell index
63 : TYPE(dbcsr_p_type), DIMENSION(:, :), POINTER :: rs_dbcsr_in
64 : TYPE(kpoint_type), POINTER :: kpoint_in
65 : REAL(kind=dp), DIMENSION(:, :, :, :) :: rs_array_out
66 : INTEGER, DIMENSION(:, :, :), POINTER :: cell_to_index_out
67 :
68 : CHARACTER(len=*), PARAMETER :: routineN = 'replicate_rs_matrices'
69 :
70 : CHARACTER :: matrix_sym
71 : INTEGER :: handle, iatom, ispin, jatom, n_spin, &
72 : src_index
73 : INTEGER, DIMENSION(3) :: cell
74 : TYPE(mp_comm_type) :: group
75 : TYPE(neighbor_list_iterator_p_type), &
76 0 : DIMENSION(:), POINTER :: iterator
77 : TYPE(neighbor_list_set_p_type), DIMENSION(:), &
78 0 : POINTER :: sab_kp_src
79 :
80 0 : CALL timeset(routineN, handle)
81 :
82 0 : IF (SIZE(rs_dbcsr_in, 2) < 1) THEN
83 0 : CALL cp_abort(__LOCATION__, "No source image cells provided!")
84 : END IF
85 : ! Start by constructing the cell_to_index_src
86 0 : sab_kp_src => kpoint_in%sab_nl
87 : ! NOTE : The first index in matrix_s_kp is not spin index, but number of derivatives.
88 : ! But, for matrix_ks_kp, this is indeed the spin index.
89 0 : n_spin = SIZE(rs_dbcsr_in, 1)
90 0 : CALL dbcsr_get_info(rs_dbcsr_in(1, 1)%matrix, group=group, matrix_type=matrix_sym)
91 0 : DO ispin = 1, n_spin
92 0 : CALL neighbor_list_iterator_create(iterator, sab_kp_src)
93 0 : DO WHILE (neighbor_list_iterate(iterator) == 0)
94 0 : CALL get_iterator_info(iterator, cell=cell, iatom=iatom, jatom=jatom)
95 0 : src_index = kpoint_in%cell_to_index(cell(1), cell(2), cell(3))
96 0 : IF (src_index == 0) THEN
97 0 : CALL cp_abort(__LOCATION__, "Image not found in the source array.")
98 : END IF
99 : ! NOTE : Expect only specific symmetry storage relevant for kpoint calculations
100 0 : IF (matrix_sym == dbcsr_type_no_symmetry) THEN
101 : CALL write_block_no_sym(iatom, jatom, cell, rs_dbcsr_in(ispin, src_index)%matrix, &
102 0 : rs_array_out(ispin, :, :, :), cell_to_index_out)
103 : ELSE
104 : CALL write_block_symmetric(iatom, jatom, cell, rs_dbcsr_in(ispin, src_index)%matrix, &
105 0 : rs_array_out(ispin, :, :, :), cell_to_index_out)
106 : END IF
107 : END DO
108 0 : CALL neighbor_list_iterator_release(iterator)
109 : END DO
110 0 : CALL group%sum(rs_array_out(:, :, :, :))
111 0 : CALL timestop(handle)
112 0 : END SUBROUTINE replicate_rs_matrices
113 : ! **************************************************************************************************
114 : !> \brief Write a single block from the dbcsr matrix to correct place, with assumed symmetric dbcsr
115 : !> \param iatom first atom index
116 : !> \param jatom second atom index
117 : !> \param cell Current cell (of second atom)
118 : !> \param matrix_in DBCSR matrix input, symmetric assumed (A_(mu nu)^(R) = A_(nu mu)^(-R))
119 : !> \param array_out Multidimensional array - dim 1 : rows, dim 2 : cols, dim 3 : rs_index
120 : !> \param cell_to_index_out Mapping of cell coords to rs_indices
121 : !> \date 11.2025
122 : !> \author Stepan Marek
123 : ! **************************************************************************************************
124 0 : SUBROUTINE write_block_symmetric(iatom, jatom, cell, matrix_in, array_out, cell_to_index_out)
125 : INTEGER, INTENT(IN) :: iatom, jatom
126 : INTEGER, DIMENSION(3), INTENT(IN) :: cell
127 : TYPE(dbcsr_type), INTENT(IN) :: matrix_in
128 : REAL(kind=dp), DIMENSION(:, :, :), INTENT(INOUT) :: array_out
129 : INTEGER, DIMENSION(:, :, :), INTENT(IN), POINTER :: cell_to_index_out
130 :
131 : INTEGER :: col_offset, col_size, dest_index, &
132 : dest_index_t, i, i_g, j, j_g, &
133 : row_offset, row_size
134 0 : INTEGER, DIMENSION(:), POINTER :: col_offsets, row_offsets
135 : LOGICAL :: found
136 0 : REAL(kind=dp), DIMENSION(:, :), POINTER :: block
137 :
138 0 : CALL dbcsr_get_info(matrix_in, row_blk_offset=row_offsets, col_blk_offset=col_offsets)
139 0 : IF (iatom > jatom) THEN
140 : CALL dbcsr_get_readonly_block_p(matrix_in, row=jatom, col=iatom, block=block, &
141 0 : row_size=row_size, col_size=col_size, found=found)
142 0 : IF (.NOT. found) RETURN
143 : ! Block found, prepare for write
144 0 : dest_index = cell_to_index_out(-cell(1), -cell(2), -cell(3))
145 0 : IF (dest_index == 0) CPABORT("Mirror image index not present.")
146 0 : dest_index_t = cell_to_index_out(cell(1), cell(2), cell(3))
147 0 : IF (dest_index_t == 0) CPABORT("Image index not present.")
148 0 : row_offset = row_offsets(jatom)
149 0 : col_offset = col_offsets(iatom)
150 : ELSE
151 : CALL dbcsr_get_readonly_block_p(matrix_in, row=iatom, col=jatom, block=block, &
152 0 : row_size=row_size, col_size=col_size, found=found)
153 0 : IF (.NOT. found) RETURN
154 : ! Block found, prepare for write
155 0 : dest_index = cell_to_index_out(cell(1), cell(2), cell(3))
156 0 : IF (dest_index == 0) CPABORT("Image index not present.")
157 0 : dest_index_t = cell_to_index_out(-cell(1), -cell(2), -cell(3))
158 0 : IF (dest_index_t == 0) CPABORT("Mirror image index not present.")
159 0 : row_offset = row_offsets(iatom)
160 0 : col_offset = col_offsets(jatom)
161 : END IF
162 : ! Do the write
163 : !$OMP PARALLEL DO DEFAULT(NONE) PRIVATE(i,j,i_g,j_g) &
164 : !$OMP SHARED(row_size, col_size, row_offset, col_offset, array_out, &
165 0 : !$OMP dest_index, dest_index_t, block, iatom, jatom)
166 : DO i = 1, row_size
167 : i_g = i + row_offset - 1
168 : DO j = 1, col_size
169 : j_g = j + col_offset - 1
170 : array_out(i_g, j_g, dest_index) = block(i, j)
171 : IF (iatom /= jatom) array_out(j_g, i_g, dest_index_t) = block(i, j)
172 : END DO
173 : END DO
174 : !$OMP END PARALLEL DO
175 0 : END SUBROUTINE write_block_symmetric
176 : ! **************************************************************************************************
177 : !> \brief Write a single block from the dbcsr matrix to correct place, assuming no symmetry dbcsr
178 : !> \param iatom first atom index
179 : !> \param jatom second atom index
180 : !> \param cell Current cell (of second atom)
181 : !> \param matrix_in DBCSR matrix input, symmetric assumed (A_(mu nu)^(R) = A_(nu mu)^(-R))
182 : !> \param array_out Multidimensional array - dim 1 : rows, dim 2 : cols, dim 3 : rs_index
183 : !> \param cell_to_index_out Mapping of cell coords to rs_indices
184 : !> \date 11.2025
185 : !> \author Stepan Marek
186 : ! **************************************************************************************************
187 0 : SUBROUTINE write_block_no_sym(iatom, jatom, cell, matrix_in, array_out, cell_to_index_out)
188 : INTEGER, INTENT(IN) :: iatom, jatom
189 : INTEGER, DIMENSION(3), INTENT(IN) :: cell
190 : TYPE(dbcsr_type), INTENT(IN) :: matrix_in
191 : REAL(kind=dp), DIMENSION(:, :, :), INTENT(INOUT) :: array_out
192 : INTEGER, DIMENSION(:, :, :), INTENT(IN), POINTER :: cell_to_index_out
193 :
194 : INTEGER :: col_offset, col_size, dest_index, i, &
195 : i_g, j, j_g, row_offset, row_size
196 0 : INTEGER, DIMENSION(:), POINTER :: col_offsets, row_offsets
197 : LOGICAL :: found
198 0 : REAL(kind=dp), DIMENSION(:, :), POINTER :: block
199 :
200 0 : dest_index = cell_to_index_out(cell(1), cell(2), cell(3))
201 0 : IF (dest_index == 0) CPABORT("Image index not present.")
202 0 : CALL dbcsr_get_info(matrix_in, row_blk_offset=row_offsets, col_blk_offset=col_offsets)
203 0 : row_offset = row_offsets(iatom)
204 0 : col_offset = col_offsets(jatom)
205 : CALL dbcsr_get_readonly_block_p(matrix_in, row=iatom, col=jatom, block=block, found=found, &
206 0 : row_size=row_size, col_size=col_size)
207 : !$OMP PARALLEL DO DEFAULT(NONE) PRIVATE(i, j, i_g, j_g) &
208 0 : !$OMP SHARED(row_size, col_size, row_offset, col_offset, dest_index, block, array_out)
209 : DO i = 1, row_size
210 : i_g = i + row_offset - 1
211 : DO j = 1, col_size
212 : j_g = j + col_offset - 1
213 : array_out(i_g, j_g, dest_index) = block(i, j)
214 : END DO
215 : END DO
216 : !$OMP END PARALLEL DO
217 0 : END SUBROUTINE write_block_no_sym
218 : ! **************************************************************************************************
219 : !> \brief Integrate RS matrices (stored as Fortran array) into a kpoint matrix at given kp
220 : !> \param rs_real Multidimensional array of real parts of the matrix, dim 1 : rows, dim 2 : cols, dim 3 : image index
221 : !> \param ks_complex Target complex k-space matrix
222 : !> \param index_to_cell Gets the image cell coordinates from the rs_dbcsr index
223 : !> \param xkp Single kpoint where the transformation is evalued at
224 : !> \param deriv_direction Derivative direction - indicates along which cartesian direction to take the derivative
225 : !> \param hmat Cell size matrix, required for the derivative
226 : !> \date 11.2025
227 : !> \author Stepan Marek
228 : ! **************************************************************************************************
229 18720 : SUBROUTINE rs_to_kp(rs_real, ks_complex, index_to_cell, xkp, deriv_direction, hmat)
230 : REAL(kind=dp), DIMENSION(:, :, :), INTENT(IN) :: rs_real
231 : COMPLEX(kind=dp), DIMENSION(:, :), INTENT(OUT) :: ks_complex
232 : INTEGER, DIMENSION(:, :), POINTER :: index_to_cell
233 : REAL(kind=dp), DIMENSION(3), INTENT(IN) :: xkp
234 : INTEGER, INTENT(IN), OPTIONAL :: deriv_direction
235 : REAL(kind=dp), DIMENSION(3, 3), INTENT(IN), &
236 : OPTIONAL :: hmat
237 :
238 : CHARACTER(len=*), PARAMETER :: routineN = 'rs_to_kp'
239 :
240 : INTEGER :: handle, i, n_images
241 :
242 18720 : CALL timeset(routineN, handle)
243 : ! Get matrix constants
244 18720 : n_images = SIZE(rs_real, 3)
245 : ! Get the required derivatives for the deriv direction
246 18720 : IF (PRESENT(deriv_direction)) THEN
247 0 : IF (.NOT. PRESENT(hmat) .AND. deriv_direction /= 0) THEN
248 0 : CALL cp_abort(__LOCATION__, "Derivative requested but h matrix not provided!")
249 : END IF
250 : END IF
251 : ! Now, iterate over realspace and build the sum
252 708576 : ks_complex(:, :) = CMPLX(0.0, 0.0, kind=dp)
253 187200 : DO i = 1, n_images
254 187200 : CALL add_rs_to_kp(ks_complex, rs_real(:, :, i), xkp, i, index_to_cell, deriv_direction, hmat)
255 : END DO
256 18720 : CALL timestop(handle)
257 18720 : END SUBROUTINE rs_to_kp
258 : ! **************************************************************************************************
259 : !> \brief Transforms array of fm RS matrices into cfm k-space matrix, at given kpoint index
260 : !> \param cfm_kp The resulting complex fm matrix, containing the k-space matrix elements
261 : !> \param fm_rs The real space matrix array
262 : !> \param kpoints Structure containing information about number, positions, weights etc. of kpoints
263 : !> \param ikp Index of the target kpoint at which the transformation is evaluated
264 : !> \par History
265 : !> 05.2024 Created [Jan Wilhelm]
266 : !> 11.2025 Moved to general file [Stepan Marek]
267 : ! **************************************************************************************************
268 2806 : SUBROUTINE fm_rs_to_kp(cfm_kp, fm_rs, kpoints, ikp)
269 : TYPE(cp_cfm_type) :: cfm_kp
270 : TYPE(cp_fm_type), DIMENSION(:) :: fm_rs
271 : TYPE(kpoint_type), POINTER :: kpoints
272 : INTEGER :: ikp
273 :
274 : CHARACTER(LEN=*), PARAMETER :: routineN = 'fm_rs_to_kp'
275 :
276 : INTEGER :: handle, img, nimages, nimages_fm_rs
277 :
278 2806 : CALL timeset(routineN, handle)
279 :
280 2806 : nimages = SIZE(kpoints%index_to_cell, 2)
281 2806 : nimages_fm_rs = SIZE(fm_rs)
282 :
283 2806 : IF (nimages /= nimages_fm_rs) CALL cp_abort(__LOCATION__, "Index to cell and provided fm "// &
284 0 : "array are inconsistent.")
285 :
286 193703 : cfm_kp%local_data(:, :) = z_zero
287 28060 : DO img = 1, nimages
288 :
289 : CALL add_rs_to_kp(cfm_kp%local_data, fm_rs(img)%local_data, kpoints%xkp(1:3, ikp), &
290 28060 : img, kpoints%index_to_cell)
291 :
292 : END DO
293 :
294 2806 : CALL timestop(handle)
295 2806 : END SUBROUTINE fm_rs_to_kp
296 : ! **************************************************************************************************
297 : !> \brief Adds a single RS array with correct phase factor to the target k-space argument
298 : !> \param ks_array_out The array representing (part) of the complex k-space matrix
299 : !> \param rs_array_in The RS input array
300 : !> \param xkp The kpoint coordinates, in units of unit cell
301 : !> \param imindex The RS index, used for index to cell determination
302 : !> \param index_to_cell Getting cell coordinates from the imindex
303 : !> \param deriv_direction The cartesian direction of the derivative
304 : !> \param hmat The unit cell dimensions
305 : !> \par History
306 : !> 05.2024 Created [Jan Wilhelm]
307 : !> 11.2025 Added k-derivative option [Shridhar Shanbhag]
308 : !> 11.2025 Moved to general file [Stepan Marek]
309 : !> \note Always produces non-symmetric matrix, given a non-symmetric RS array
310 : ! **************************************************************************************************
311 193734 : SUBROUTINE add_rs_to_kp(ks_array_out, rs_array_in, xkp, imindex, index_to_cell, deriv_direction, hmat)
312 : COMPLEX(kind=dp), DIMENSION(:, :), INTENT(INOUT) :: ks_array_out
313 : REAL(kind=dp), DIMENSION(:, :), INTENT(IN) :: rs_array_in
314 : REAL(kind=dp), DIMENSION(3), INTENT(IN) :: xkp
315 : INTEGER, INTENT(IN) :: imindex
316 : INTEGER, DIMENSION(:, :), INTENT(IN) :: index_to_cell
317 : INTEGER, INTENT(IN), OPTIONAL :: deriv_direction
318 : REAL(kind=dp), DIMENSION(3, 3), INTENT(IN), &
319 : OPTIONAL :: hmat
320 :
321 : COMPLEX(kind=dp) :: phase_factor
322 : INTEGER :: i, j
323 : REAL(kind=dp) :: deriv_factor
324 : REAL(kind=dp), DIMENSION(3) :: cell_vector
325 :
326 193734 : IF (PRESENT(deriv_direction) .AND. (.NOT. PRESENT(hmat))) THEN
327 0 : CALL cp_abort(__LOCATION__, "Deriv. direction given but no hmat provided")
328 : END IF
329 :
330 193734 : deriv_factor = 1.0_dp
331 193734 : IF (PRESENT(deriv_direction)) THEN
332 0 : cell_vector = MATMUL(hmat, index_to_cell(1:3, imindex))
333 0 : deriv_factor = cell_vector(deriv_direction)
334 : END IF
335 :
336 : phase_factor = CMPLX(COS(twopi*SUM(xkp(:)*index_to_cell(:, imindex))), &
337 1356138 : SIN(twopi*SUM(xkp(:)*index_to_cell(:, imindex))), kind=dp)
338 :
339 1264689 : DO i = 1, SIZE(ks_array_out, 1)
340 7988148 : DO j = 1, SIZE(ks_array_out, 2)
341 : ks_array_out(i, j) = ks_array_out(i, j) + &
342 7794414 : deriv_factor*phase_factor*rs_array_in(i, j)
343 : END DO
344 : END DO
345 193734 : END SUBROUTINE add_rs_to_kp
346 : ! **************************************************************************************************
347 : !> \brief Adds given kpoint matrix to all rs matrices
348 : !> \param array_kp Input k-space matrix array
349 : !> \param array_rs Output rs arrays
350 : !> \param kpoints Structure containing information about number, positions, weights etc. of kpoints
351 : !> \param ikp Index of the target kpoint at which the transformation is evaluated
352 : !> \param index_to_cell_ext External supplied index_to_cell
353 : !> \par History
354 : !> 05.2024 Created [Jan Wilhelm]
355 : !> 11.2025 Moved to general file [Stepan Marek]
356 : !> \note Part of transform in parallelism over k-points (hence why not for a single rs cell)
357 : ! **************************************************************************************************
358 14480 : SUBROUTINE add_kp_to_all_rs(array_kp, array_rs, kpoints, ikp, index_to_cell_ext)
359 : COMPLEX(kind=dp), DIMENSION(:, :) :: array_kp
360 : REAL(kind=dp), DIMENSION(:, :, :) :: array_rs
361 : TYPE(kpoint_type), POINTER :: kpoints
362 : INTEGER :: ikp
363 : INTEGER, DIMENSION(:, :), OPTIONAL, POINTER :: index_to_cell_ext
364 :
365 : CHARACTER(len=*), PARAMETER :: routineN = 'add_kp_to_all_rs'
366 :
367 : INTEGER :: handle, img
368 : INTEGER, DIMENSION(3) :: cell
369 14480 : INTEGER, DIMENSION(:, :), POINTER :: index_to_cell
370 :
371 14480 : index_to_cell => kpoints%index_to_cell
372 14080 : IF (PRESENT(index_to_cell_ext)) index_to_cell => index_to_cell_ext
373 :
374 14480 : CALL timeset(routineN, handle)
375 :
376 14480 : IF (SIZE(array_rs, 3) /= SIZE(index_to_cell, 2)) CALL cp_abort(__LOCATION__, &
377 0 : "The provided RS array and cell_to_index array are inconsistent.")
378 :
379 144800 : DO img = 1, SIZE(array_rs, 3)
380 521280 : cell(:) = index_to_cell(:, img)
381 144800 : CALL add_kp_to_rs(array_kp, array_rs(:, :, img), cell, kpoints, ikp)
382 : END DO
383 :
384 14480 : CALL timestop(handle)
385 14480 : END SUBROUTINE add_kp_to_all_rs
386 : ! **************************************************************************************************
387 : !> \brief Adds given kpoint matrix to a single rs matrix
388 : !> \param cfm_kp The input complex fm matrix, containing the k-space matrix elements
389 : !> \param fm_rs The real space matrix array
390 : !> \param kpoints Structure containing information about number, positions, weights etc. of kpoints
391 : !> \param ikp Index of the target kpoint at which the transformation is evaluated
392 : !> \par History
393 : !> 05.2024 Created [Jan Wilhelm]
394 : !> 11.2025 Moved to general file [Stepan Marek]
395 : !> \note Part of transform in parallelism over k-points (hence why not for a single rs cell)
396 : ! **************************************************************************************************
397 2912 : SUBROUTINE fm_add_kp_to_all_rs(cfm_kp, fm_rs, kpoints, ikp)
398 : TYPE(cp_cfm_type) :: cfm_kp
399 : TYPE(cp_fm_type), DIMENSION(:) :: fm_rs
400 : TYPE(kpoint_type), POINTER :: kpoints
401 : INTEGER :: ikp
402 :
403 : CHARACTER(len=*), PARAMETER :: routineN = 'fm_add_kp_to_all_rs'
404 :
405 : INTEGER :: handle, img
406 : INTEGER, DIMENSION(3) :: cell
407 :
408 2912 : CALL timeset(routineN, handle)
409 :
410 2912 : IF (SIZE(fm_rs, 1) /= SIZE(kpoints%index_to_cell, 2)) CALL cp_abort(__LOCATION__, &
411 0 : "The provided RS array and cell_to_index array are inconsistent.")
412 :
413 29120 : DO img = 1, SIZE(fm_rs, 1)
414 104832 : cell(:) = kpoints%index_to_cell(:, img)
415 29120 : CALL add_kp_to_rs(cfm_kp%local_data, fm_rs(img)%local_data, cell, kpoints, ikp)
416 : END DO
417 2912 : CALL timestop(handle)
418 2912 : END SUBROUTINE fm_add_kp_to_all_rs
419 : ! **************************************************************************************************
420 : !> \brief Adds given kpoint matrix to a single rs matrix
421 : !> \param array_kp The resulting complex fm matrix, containing the k-space matrix elements
422 : !> \param array_rs The real space matrix array
423 : !> \param cell The image cell of the target RS matrix
424 : !> \param kpoints Structure containing information about number, positions, weights etc. of kpoints
425 : !> \param ikp Index of the target kpoint at which the transformation is evaluated
426 : !> \par History
427 : !> 05.2024 Created [Jan Wilhelm]
428 : !> 11.2025 Moved to general file [Stepan Marek]
429 : !> \note Part of transform in parallelism over k-points (hence why not for a single rs cell)
430 : ! **************************************************************************************************
431 156528 : SUBROUTINE add_kp_to_rs(array_kp, array_rs, cell, kpoints, ikp)
432 : COMPLEX(kind=dp), DIMENSION(:, :) :: array_kp
433 : REAL(kind=dp), DIMENSION(:, :) :: array_rs
434 : INTEGER, DIMENSION(3) :: cell
435 : TYPE(kpoint_type), POINTER :: kpoints
436 : INTEGER :: ikp
437 :
438 : REAL(kind=dp) :: phase
439 :
440 : ! Determine the phase
441 626112 : phase = twopi*SUM(kpoints%xkp(:, ikp)*cell(:))
442 : ! The array is real - it is assumed that imaginary parts cancel each other, so they are not handled
443 : ! Then e^(-i phi) S(k) = Re(S(k)) cos(phi) - i sin (phi) i Im(S(k)) =
444 : ! = Re(S(k)) cos(phi) + Im(S(k)) sin(phi)
445 : array_rs(:, :) = array_rs(:, :) + (REAL(array_kp(:, :))*COS(phase) + &
446 7117056 : AIMAG(array_kp(:, :))*SIN(phase))*kpoints%wkp(ikp)
447 156528 : END SUBROUTINE add_kp_to_rs
448 : ! **************************************************************************************************
449 : !> \brief Calculates the inverse transform, assuming all kpoints are present on the given rank
450 : !> \param array_kp The input complex fm matrix, containing the k-space matrix elements
451 : !> \param array_rs The output real space matrix array
452 : !> \param cell The image cell of the target RS matrix
453 : !> \param kpoints Structure containing information about number, positions, weights etc. of kpoints
454 : !> \par History
455 : !> 05.2024 Created [Jan Wilhelm]
456 : !> 11.2025 Moved to general file [Stepan Marek]
457 : !> \note Part of transform in parallelism over k-points
458 : ! **************************************************************************************************
459 0 : SUBROUTINE kp_to_rs(array_kp, array_rs, cell, kpoints)
460 : COMPLEX(kind=dp), DIMENSION(:, :, :) :: array_kp
461 : REAL(kind=dp), DIMENSION(:, :) :: array_rs
462 : INTEGER, DIMENSION(3) :: cell
463 : TYPE(kpoint_type), POINTER :: kpoints
464 :
465 : CHARACTER(len=*), PARAMETER :: routineN = 'kp_to_rs'
466 :
467 : INTEGER :: handle, ikp
468 :
469 0 : IF (kpoints%nkp /= SIZE(array_kp, 3)) CALL cp_abort(__LOCATION__, &
470 0 : "Provided kpoints and array_kp are inconsistent.")
471 :
472 0 : CALL timeset(routineN, handle)
473 :
474 0 : array_rs(:, :) = 0.0_dp
475 0 : DO ikp = 1, kpoints%nkp
476 0 : CALL add_kp_to_rs(array_kp(:, :, ikp), array_rs, cell, kpoints, ikp)
477 : END DO
478 :
479 0 : CALL timestop(handle)
480 0 : END SUBROUTINE kp_to_rs
481 : END MODULE kpoint_k_r_trafo_simple
|
