(git:ed6f26b)
Loading...
Searching...
No Matches
soc_pseudopotential_utils.F
Go to the documentation of this file.
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
8MODULE soc_pseudopotential_utils
9 USE cp_cfm_basic_linalg, ONLY: cp_cfm_scale,&
10 cp_cfm_scale_and_add,&
11 cp_cfm_scale_and_add_fm,&
12 cp_cfm_transpose
13 USE cp_cfm_types, ONLY: cp_cfm_create,&
14 cp_cfm_get_info,&
15 cp_cfm_release,&
16 cp_cfm_set_all,&
17 cp_cfm_to_fm,&
18 cp_cfm_type,&
19 cp_fm_to_cfm
20 USE cp_dbcsr_api, ONLY: dbcsr_type
21 USE cp_dbcsr_operations, ONLY: copy_dbcsr_to_fm
22 USE cp_fm_struct, ONLY: cp_fm_struct_create,&
23 cp_fm_struct_release,&
24 cp_fm_struct_type
25 USE cp_fm_types, ONLY: cp_fm_create,&
26 cp_fm_get_info,&
27 cp_fm_release,&
28 cp_fm_set_all,&
29 cp_fm_to_fm_submat,&
30 cp_fm_type
31 USE kinds, ONLY: dp
32 USE mathconstants, ONLY: gaussi,&
33 z_one,&
34 z_zero
35#include "./base/base_uses.f90"
36
37 IMPLICIT NONE
38
39 PRIVATE
40
41 CHARACTER(len=*), PARAMETER, PRIVATE :: moduleN = 'soc_pseudopotential_utils'
42
43 PUBLIC :: add_dbcsr_submat, cfm_add_on_diag, add_fm_submat, add_cfm_submat, &
44 get_cfm_submat, create_cfm_double
45
46CONTAINS
47
48! **************************************************************************************************
49!> \brief ...
50!> \param cfm_mat_target ...
51!> \param mat_source ...
52!> \param fm_struct_source ...
53!> \param nstart_row ...
54!> \param nstart_col ...
55!> \param factor ...
56!> \param add_also_herm_conj ...
57! **************************************************************************************************
58 SUBROUTINE add_dbcsr_submat(cfm_mat_target, mat_source, fm_struct_source, &
59 nstart_row, nstart_col, factor, add_also_herm_conj)
60 TYPE(cp_cfm_type) :: cfm_mat_target
61 TYPE(dbcsr_type) :: mat_source
62 TYPE(cp_fm_struct_type), POINTER :: fm_struct_source
63 INTEGER :: nstart_row, nstart_col
64 COMPLEX(KIND=dp) :: factor
65 LOGICAL :: add_also_herm_conj
66
67 CHARACTER(LEN=*), PARAMETER :: routinen = 'add_dbcsr_submat'
68
69 INTEGER :: handle, nao
70 TYPE(cp_cfm_type) :: cfm_mat_work_double, &
71 cfm_mat_work_double_2
72 TYPE(cp_fm_type) :: fm_mat_work_double_im, fm_mat_work_im
73
74 CALL timeset(routinen, handle)
75
76 CALL cp_fm_create(fm_mat_work_double_im, cfm_mat_target%matrix_struct)
77 CALL cp_fm_set_all(fm_mat_work_double_im, 0.0_dp)
78
79 CALL cp_cfm_create(cfm_mat_work_double, cfm_mat_target%matrix_struct)
80 CALL cp_cfm_create(cfm_mat_work_double_2, cfm_mat_target%matrix_struct)
81 CALL cp_cfm_set_all(cfm_mat_work_double, z_zero)
82 CALL cp_cfm_set_all(cfm_mat_work_double_2, z_zero)
83
84 CALL cp_fm_create(fm_mat_work_im, fm_struct_source)
85
86 CALL copy_dbcsr_to_fm(mat_source, fm_mat_work_im)
87
88 CALL cp_fm_get_info(fm_mat_work_im, nrow_global=nao)
89
90 CALL cp_fm_to_fm_submat(msource=fm_mat_work_im, mtarget=fm_mat_work_double_im, &
91 nrow=nao, ncol=nao, &
92 s_firstrow=1, s_firstcol=1, &
93 t_firstrow=nstart_row, t_firstcol=nstart_col)
94 ! careful: inside add_dbcsr_submat, mat_V_SOC_xyz is multiplied by i because the real matrix
95 ! mat_V_SOC_xyz is antisymmetric as V_SOC matrix is purely imaginary and Hermitian
96 CALL cp_cfm_scale_and_add_fm(z_zero, cfm_mat_work_double, gaussi, fm_mat_work_double_im)
97
98 CALL cp_cfm_scale(factor, cfm_mat_work_double)
99
100 CALL cp_cfm_scale_and_add(z_one, cfm_mat_target, z_one, cfm_mat_work_double)
101
102 IF (add_also_herm_conj) THEN
103 CALL cp_cfm_transpose(cfm_mat_work_double, 'C', cfm_mat_work_double_2)
104 CALL cp_cfm_scale_and_add(z_one, cfm_mat_target, z_one, cfm_mat_work_double_2)
105 END IF
106
107 CALL cp_fm_release(fm_mat_work_double_im)
108 CALL cp_cfm_release(cfm_mat_work_double)
109 CALL cp_cfm_release(cfm_mat_work_double_2)
110 CALL cp_fm_release(fm_mat_work_im)
111
112 CALL timestop(handle)
113
114 END SUBROUTINE add_dbcsr_submat
115
116! **************************************************************************************************
117!> \brief ...
118!> \param cfm ...
119!> \param alpha ...
120! **************************************************************************************************
121 SUBROUTINE cfm_add_on_diag(cfm, alpha)
122
123 TYPE(cp_cfm_type) :: cfm
124 REAL(kind=dp), DIMENSION(:) :: alpha
125
126 CHARACTER(LEN=*), PARAMETER :: routinen = 'cfm_add_on_diag'
127
128 INTEGER :: handle, i_global, i_row, j_col, &
129 j_global, nao, ncol_local, nrow_local
130 INTEGER, DIMENSION(:), POINTER :: col_indices, row_indices
131
132 CALL timeset(routinen, handle)
133
134 CALL cp_cfm_get_info(matrix=cfm, &
135 nrow_local=nrow_local, &
136 ncol_local=ncol_local, &
137 row_indices=row_indices, &
138 col_indices=col_indices)
139
140 nao = SIZE(alpha)
141
142 DO j_col = 1, ncol_local
143 j_global = col_indices(j_col)
144 DO i_row = 1, nrow_local
145 i_global = row_indices(i_row)
146 IF (j_global == i_global) THEN
147 IF (i_global .LE. nao) THEN
148 cfm%local_data(i_row, j_col) = cfm%local_data(i_row, j_col) + &
149 alpha(i_global)*z_one
150 ELSE
151 cfm%local_data(i_row, j_col) = cfm%local_data(i_row, j_col) + &
152 alpha(i_global - nao)*z_one
153 END IF
154 END IF
155 END DO
156 END DO
157
158 CALL timestop(handle)
159
160 END SUBROUTINE cfm_add_on_diag
161
162! **************************************************************************************************
163!> \brief ...
164!> \param cfm_mat_target ...
165!> \param fm_mat_source ...
166!> \param nstart_row ...
167!> \param nstart_col ...
168! **************************************************************************************************
169 SUBROUTINE add_fm_submat(cfm_mat_target, fm_mat_source, nstart_row, nstart_col)
170
171 TYPE(cp_cfm_type) :: cfm_mat_target
172 TYPE(cp_fm_type) :: fm_mat_source
173 INTEGER :: nstart_row, nstart_col
174
175 CHARACTER(LEN=*), PARAMETER :: routinen = 'add_fm_submat'
176
177 INTEGER :: handle, nao
178 TYPE(cp_fm_type) :: fm_mat_work_double_re
179
180 CALL timeset(routinen, handle)
181
182 CALL cp_fm_create(fm_mat_work_double_re, cfm_mat_target%matrix_struct)
183 CALL cp_fm_set_all(fm_mat_work_double_re, 0.0_dp)
184
185 CALL cp_fm_get_info(fm_mat_source, nrow_global=nao)
186
187 CALL cp_fm_to_fm_submat(msource=fm_mat_source, mtarget=fm_mat_work_double_re, &
188 nrow=nao, ncol=nao, &
189 s_firstrow=1, s_firstcol=1, &
190 t_firstrow=nstart_row, t_firstcol=nstart_col)
191
192 CALL cp_cfm_scale_and_add_fm(z_one, cfm_mat_target, z_one, fm_mat_work_double_re)
193
194 CALL cp_fm_release(fm_mat_work_double_re)
195
196 CALL timestop(handle)
197
198 END SUBROUTINE add_fm_submat
199
200! **************************************************************************************************
201!> \brief ...
202!> \param cfm_mat_target ...
203!> \param cfm_mat_source ...
204!> \param nstart_row ...
205!> \param nstart_col ...
206!> \param factor ...
207! **************************************************************************************************
208 SUBROUTINE add_cfm_submat(cfm_mat_target, cfm_mat_source, nstart_row, nstart_col, factor)
209
210 TYPE(cp_cfm_type) :: cfm_mat_target, cfm_mat_source
211 INTEGER :: nstart_row, nstart_col
212 COMPLEX(KIND=dp), OPTIONAL :: factor
213
214 CHARACTER(LEN=*), PARAMETER :: routinen = 'add_cfm_submat'
215
216 COMPLEX(KIND=dp) :: factor_im, factor_re
217 INTEGER :: handle, nao
218 TYPE(cp_fm_type) :: fm_mat_source_im, fm_mat_source_re, &
219 fm_mat_work_double_im, &
220 fm_mat_work_double_re
221
222 CALL timeset(routinen, handle)
223
224 CALL cp_fm_create(fm_mat_work_double_re, cfm_mat_target%matrix_struct)
225 CALL cp_fm_create(fm_mat_work_double_im, cfm_mat_target%matrix_struct)
226 CALL cp_fm_set_all(fm_mat_work_double_re, 0.0_dp)
227 CALL cp_fm_set_all(fm_mat_work_double_im, 0.0_dp)
228
229 CALL cp_fm_create(fm_mat_source_re, cfm_mat_source%matrix_struct)
230 CALL cp_fm_create(fm_mat_source_im, cfm_mat_source%matrix_struct)
231 CALL cp_cfm_to_fm(cfm_mat_source, fm_mat_source_re, fm_mat_source_im)
232
233 CALL cp_cfm_get_info(cfm_mat_source, nrow_global=nao)
234
235 CALL cp_fm_to_fm_submat(msource=fm_mat_source_re, mtarget=fm_mat_work_double_re, &
236 nrow=nao, ncol=nao, &
237 s_firstrow=1, s_firstcol=1, &
238 t_firstrow=nstart_row, t_firstcol=nstart_col)
239
240 CALL cp_fm_to_fm_submat(msource=fm_mat_source_im, mtarget=fm_mat_work_double_im, &
241 nrow=nao, ncol=nao, &
242 s_firstrow=1, s_firstcol=1, &
243 t_firstrow=nstart_row, t_firstcol=nstart_col)
244
245 IF (PRESENT(factor)) THEN
246 factor_re = factor
247 factor_im = gaussi*factor
248 ELSE
249 factor_re = z_one
250 factor_im = gaussi
251 END IF
252
253 CALL cp_cfm_scale_and_add_fm(z_one, cfm_mat_target, factor_re, fm_mat_work_double_re)
254 CALL cp_cfm_scale_and_add_fm(z_one, cfm_mat_target, factor_im, fm_mat_work_double_im)
255
256 CALL cp_fm_release(fm_mat_work_double_re)
257 CALL cp_fm_release(fm_mat_work_double_im)
258 CALL cp_fm_release(fm_mat_source_re)
259 CALL cp_fm_release(fm_mat_source_im)
260
261 CALL timestop(handle)
262
263 END SUBROUTINE add_cfm_submat
264
265! **************************************************************************************************
266!> \brief ...
267!> \param cfm_mat_target ...
268!> \param cfm_mat_source ...
269!> \param nstart_row ...
270!> \param nstart_col ...
271! **************************************************************************************************
272 SUBROUTINE get_cfm_submat(cfm_mat_target, cfm_mat_source, nstart_row, nstart_col)
273
274 TYPE(cp_cfm_type) :: cfm_mat_target, cfm_mat_source
275 INTEGER :: nstart_row, nstart_col
276
277 CHARACTER(LEN=*), PARAMETER :: routinen = 'get_cfm_submat'
278
279 INTEGER :: handle, nao
280 TYPE(cp_fm_type) :: fm_mat_source_double_im, &
281 fm_mat_source_double_re, &
282 fm_mat_work_im, fm_mat_work_re
283
284 CALL timeset(routinen, handle)
285
286 CALL cp_fm_create(fm_mat_source_double_re, cfm_mat_source%matrix_struct)
287 CALL cp_fm_create(fm_mat_source_double_im, cfm_mat_source%matrix_struct)
288 CALL cp_cfm_to_fm(cfm_mat_source, fm_mat_source_double_re, fm_mat_source_double_im)
289
290 CALL cp_fm_create(fm_mat_work_re, cfm_mat_target%matrix_struct)
291 CALL cp_fm_create(fm_mat_work_im, cfm_mat_target%matrix_struct)
292 CALL cp_fm_set_all(fm_mat_work_re, 0.0_dp)
293 CALL cp_fm_set_all(fm_mat_work_im, 0.0_dp)
294
295 CALL cp_cfm_get_info(cfm_mat_target, nrow_global=nao)
296
297 CALL cp_fm_to_fm_submat(msource=fm_mat_source_double_re, mtarget=fm_mat_work_re, &
298 nrow=nao, ncol=nao, &
299 s_firstrow=nstart_row, s_firstcol=nstart_col, &
300 t_firstrow=1, t_firstcol=1)
301
302 CALL cp_fm_to_fm_submat(msource=fm_mat_source_double_im, mtarget=fm_mat_work_im, &
303 nrow=nao, ncol=nao, &
304 s_firstrow=nstart_row, s_firstcol=nstart_col, &
305 t_firstrow=1, t_firstcol=1)
306
307 CALL cp_fm_to_cfm(fm_mat_work_re, fm_mat_work_im, cfm_mat_target)
308
309 CALL cp_fm_release(fm_mat_work_re)
310 CALL cp_fm_release(fm_mat_work_im)
311 CALL cp_fm_release(fm_mat_source_double_re)
312 CALL cp_fm_release(fm_mat_source_double_im)
313
314 CALL timestop(handle)
315
316 END SUBROUTINE get_cfm_submat
317
318! **************************************************************************************************
319!> \brief ...
320!> \param cfm_double ...
321!> \param fm_orig ...
322!> \param cfm_orig ...
323! **************************************************************************************************
324 SUBROUTINE create_cfm_double(cfm_double, fm_orig, cfm_orig)
325 TYPE(cp_cfm_type) :: cfm_double
326 TYPE(cp_fm_type), OPTIONAL :: fm_orig
327 TYPE(cp_cfm_type), OPTIONAL :: cfm_orig
328
329 CHARACTER(LEN=*), PARAMETER :: routinen = 'create_cfm_double'
330
331 INTEGER :: handle, ncol_global_orig, &
332 nrow_global_orig
333 LOGICAL :: do_cfm_templ, do_fm_templ
334 TYPE(cp_fm_struct_type), POINTER :: matrix_struct, matrix_struct_double
335
336 CALL timeset(routinen, handle)
337
338 do_fm_templ = PRESENT(fm_orig)
339 do_cfm_templ = PRESENT(cfm_orig)
340
341 ! either fm template or cfm template
342 cpassert(do_fm_templ .NEQV. do_cfm_templ)
343
344 IF (do_fm_templ) THEN
345 CALL cp_fm_get_info(matrix=fm_orig, nrow_global=nrow_global_orig, &
346 ncol_global=ncol_global_orig)
347 matrix_struct => fm_orig%matrix_struct
348 END IF
349 IF (do_cfm_templ) THEN
350 CALL cp_cfm_get_info(matrix=cfm_orig, nrow_global=nrow_global_orig, &
351 ncol_global=ncol_global_orig)
352 matrix_struct => cfm_orig%matrix_struct
353 END IF
354
355 CALL cp_fm_struct_create(matrix_struct_double, &
356 nrow_global=2*nrow_global_orig, &
357 ncol_global=2*ncol_global_orig, &
358 template_fmstruct=matrix_struct)
359
360 CALL cp_cfm_create(cfm_double, matrix_struct_double)
361
362 CALL cp_cfm_set_all(cfm_double, z_zero)
363
364 CALL cp_fm_struct_release(matrix_struct_double)
365
366 CALL timestop(handle)
367
368 END SUBROUTINE create_cfm_double
369
370END MODULE soc_pseudopotential_utils
cp_cfm_basic_linalg::cp_cfm_scale
Definition cp_cfm_basic_linalg.F:60
cp_fm_types::cp_fm_release
Definition cp_fm_types.F:87
cp_cfm_basic_linalg
Basic linear algebra operations for complex full matrices.
Definition cp_cfm_basic_linalg.F:16
cp_cfm_basic_linalg::cp_cfm_scale_and_add
subroutine, public cp_cfm_scale_and_add(alpha, matrix_a, beta, matrix_b)
Scale and add two BLACS matrices (a = alpha*a + beta*b).
Definition cp_cfm_basic_linalg.F:240
cp_cfm_basic_linalg::cp_cfm_transpose
subroutine, public cp_cfm_transpose(matrix, trans, matrixt)
Transposes a BLACS distributed complex matrix.
Definition cp_cfm_basic_linalg.F:1111
cp_cfm_basic_linalg::cp_cfm_scale_and_add_fm
subroutine, public cp_cfm_scale_and_add_fm(alpha, matrix_a, beta, matrix_b)
Scale and add two BLACS matrices (a = alpha*a + beta*b). where b is a real matrix (adapted from cp_cf...
Definition cp_cfm_basic_linalg.F:351
cp_cfm_types
Represents a complex full matrix distributed on many processors.
Definition cp_cfm_types.F:12
cp_cfm_types::cp_cfm_create
subroutine, public cp_cfm_create(matrix, matrix_struct, name)
Creates a new full matrix with the given structure.
Definition cp_cfm_types.F:121
cp_cfm_types::cp_cfm_release
subroutine, public cp_cfm_release(matrix)
Releases a full matrix.
Definition cp_cfm_types.F:155
cp_cfm_types::cp_fm_to_cfm
subroutine, public cp_fm_to_cfm(msourcer, msourcei, mtarget)
Construct a complex full matrix by taking its real and imaginary parts from two separate real-value f...
Definition cp_cfm_types.F:813
cp_cfm_types::cp_cfm_get_info
subroutine, public cp_cfm_get_info(matrix, name, nrow_global, ncol_global, nrow_block, ncol_block, nrow_local, ncol_local, row_indices, col_indices, local_data, context, matrix_struct, para_env)
Returns information about a full matrix.
Definition cp_cfm_types.F:603
cp_cfm_types::cp_cfm_set_all
subroutine, public cp_cfm_set_all(matrix, alpha, beta)
Set all elements of the full matrix to alpha. Besides, set all diagonal matrix elements to beta (if g...
Definition cp_cfm_types.F:175
cp_cfm_types::cp_cfm_to_fm
subroutine, public cp_cfm_to_fm(msource, mtargetr, mtargeti)
Copy real and imaginary parts of a complex full matrix into separate real-value full matrices.
Definition cp_cfm_types.F:761
cp_dbcsr_api
Definition cp_dbcsr_api.F:8
cp_dbcsr_operations
DBCSR operations in CP2K.
Definition cp_dbcsr_operations.F:18
cp_dbcsr_operations::copy_dbcsr_to_fm
subroutine, public copy_dbcsr_to_fm(matrix, fm)
Copy a DBCSR matrix to a BLACS matrix.
Definition cp_dbcsr_operations.F:214
cp_fm_struct
represent the structure of a full matrix
Definition cp_fm_struct.F:14
cp_fm_struct::cp_fm_struct_create
subroutine, public cp_fm_struct_create(fmstruct, para_env, context, nrow_global, ncol_global, nrow_block, ncol_block, descriptor, first_p_pos, local_leading_dimension, template_fmstruct, square_blocks, force_block)
allocates and initializes a full matrix structure
Definition cp_fm_struct.F:132
cp_fm_struct::cp_fm_struct_release
subroutine, public cp_fm_struct_release(fmstruct)
releases a full matrix structure
Definition cp_fm_struct.F:351
cp_fm_types
represent a full matrix distributed on many processors
Definition cp_fm_types.F:15
cp_fm_types::cp_fm_get_info
subroutine, public cp_fm_get_info(matrix, name, nrow_global, ncol_global, nrow_block, ncol_block, nrow_local, ncol_local, row_indices, col_indices, local_data, context, nrow_locals, ncol_locals, matrix_struct, para_env)
returns all kind of information about the full matrix
Definition cp_fm_types.F:1009
cp_fm_types::cp_fm_to_fm_submat
subroutine, public cp_fm_to_fm_submat(msource, mtarget, nrow, ncol, s_firstrow, s_firstcol, t_firstrow, t_firstcol)
copy just a part ot the matrix
Definition cp_fm_types.F:1472
cp_fm_types::cp_fm_set_all
subroutine, public cp_fm_set_all(matrix, alpha, beta)
set all elements of a matrix to the same value, and optionally the diagonal to a different one
Definition cp_fm_types.F:528
cp_fm_types::cp_fm_create
subroutine, public cp_fm_create(matrix, matrix_struct, name, use_sp)
creates a new full matrix with the given structure
Definition cp_fm_types.F:164
kinds
Defines the basic variable types.
Definition kinds.F:23
kinds::dp
integer, parameter, public dp
Definition kinds.F:34
mathconstants
Definition of mathematical constants and functions.
Definition mathconstants.F:16
mathconstants::z_one
complex(kind=dp), parameter, public z_one
Definition mathconstants.F:143
mathconstants::gaussi
complex(kind=dp), parameter, public gaussi
Definition mathconstants.F:142
mathconstants::z_zero
complex(kind=dp), parameter, public z_zero
Definition mathconstants.F:143
soc_pseudopotential_utils
Definition soc_pseudopotential_utils.F:8
soc_pseudopotential_utils::create_cfm_double
subroutine, public create_cfm_double(cfm_double, fm_orig, cfm_orig)
...
Definition soc_pseudopotential_utils.F:325
soc_pseudopotential_utils::add_dbcsr_submat
subroutine, public add_dbcsr_submat(cfm_mat_target, mat_source, fm_struct_source, nstart_row, nstart_col, factor, add_also_herm_conj)
...
Definition soc_pseudopotential_utils.F:60
soc_pseudopotential_utils::add_cfm_submat
subroutine, public add_cfm_submat(cfm_mat_target, cfm_mat_source, nstart_row, nstart_col, factor)
...
Definition soc_pseudopotential_utils.F:209
soc_pseudopotential_utils::get_cfm_submat
subroutine, public get_cfm_submat(cfm_mat_target, cfm_mat_source, nstart_row, nstart_col)
...
Definition soc_pseudopotential_utils.F:273
soc_pseudopotential_utils::add_fm_submat
subroutine, public add_fm_submat(cfm_mat_target, fm_mat_source, nstart_row, nstart_col)
...
Definition soc_pseudopotential_utils.F:170
soc_pseudopotential_utils::cfm_add_on_diag
subroutine, public cfm_add_on_diag(cfm, alpha)
...
Definition soc_pseudopotential_utils.F:122
cp_cfm_types::cp_cfm_type
Represent a complex full matrix.
Definition cp_cfm_types.F:68
cp_dbcsr_api::dbcsr_type
Definition cp_dbcsr_api.F:174
cp_fm_struct::cp_fm_struct_type
keeps the information about the structure of a full matrix
Definition cp_fm_struct.F:82
cp_fm_types::cp_fm_type
represent a full matrix
Definition cp_fm_types.F:113