(git:374b731)
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-2024 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_operations, ONLY: copy_dbcsr_to_fm
21 USE cp_fm_struct, ONLY: cp_fm_struct_create,&
22 cp_fm_struct_release,&
23 cp_fm_struct_type
24 USE cp_fm_types, ONLY: cp_fm_create,&
25 cp_fm_get_info,&
26 cp_fm_release,&
27 cp_fm_set_all,&
28 cp_fm_to_fm_submat,&
29 cp_fm_type
30 USE dbcsr_api, ONLY: dbcsr_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, get_cfm_submat, create_cfm_double, &
44 add_cfm_submat
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
95 CALL cp_cfm_scale_and_add_fm(z_zero, cfm_mat_work_double, gaussi, fm_mat_work_double_im)
96
97 CALL cp_cfm_scale(factor, cfm_mat_work_double)
98
99 CALL cp_cfm_scale_and_add(z_one, cfm_mat_target, z_one, cfm_mat_work_double)
100
101 IF (add_also_herm_conj) THEN
102 CALL cp_cfm_transpose(cfm_mat_work_double, 'C', cfm_mat_work_double_2)
103 CALL cp_cfm_scale_and_add(z_one, cfm_mat_target, z_one, cfm_mat_work_double_2)
104 END IF
105
106 CALL cp_fm_release(fm_mat_work_double_im)
107 CALL cp_cfm_release(cfm_mat_work_double)
108 CALL cp_cfm_release(cfm_mat_work_double_2)
109 CALL cp_fm_release(fm_mat_work_im)
110
111 CALL timestop(handle)
112
113 END SUBROUTINE add_dbcsr_submat
114
115! **************************************************************************************************
116!> \brief ...
117!> \param cfm ...
118!> \param alpha ...
119! **************************************************************************************************
120 SUBROUTINE cfm_add_on_diag(cfm, alpha)
121
122 TYPE(cp_cfm_type) :: cfm
123 REAL(kind=dp), DIMENSION(:) :: alpha
124
125 CHARACTER(LEN=*), PARAMETER :: routinen = 'cfm_add_on_diag'
126
127 INTEGER :: handle, i_global, i_row, j_col, &
128 j_global, nao, ncol_local, nrow_local
129 INTEGER, DIMENSION(:), POINTER :: col_indices, row_indices
130
131 CALL timeset(routinen, handle)
132
133 CALL cp_cfm_get_info(matrix=cfm, &
134 nrow_local=nrow_local, &
135 ncol_local=ncol_local, &
136 row_indices=row_indices, &
137 col_indices=col_indices)
138
139 nao = SIZE(alpha)
140
141 DO j_col = 1, ncol_local
142 j_global = col_indices(j_col)
143 DO i_row = 1, nrow_local
144 i_global = row_indices(i_row)
145 IF (j_global == i_global) THEN
146 IF (i_global .LE. nao) THEN
147 cfm%local_data(i_row, j_col) = cfm%local_data(i_row, j_col) + alpha(i_global)*z_one
148 ELSE
149 cfm%local_data(i_row, j_col) = cfm%local_data(i_row, j_col) + alpha(i_global - nao)*z_one
150 END IF
151 END IF
152 END DO
153 END DO
154
155 CALL timestop(handle)
156
157 END SUBROUTINE cfm_add_on_diag
158
159! **************************************************************************************************
160!> \brief ...
161!> \param cfm_mat_target ...
162!> \param fm_mat_source ...
163!> \param nstart_row ...
164!> \param nstart_col ...
165! **************************************************************************************************
166 SUBROUTINE add_fm_submat(cfm_mat_target, fm_mat_source, nstart_row, nstart_col)
167
168 TYPE(cp_cfm_type) :: cfm_mat_target
169 TYPE(cp_fm_type) :: fm_mat_source
170 INTEGER :: nstart_row, nstart_col
171
172 CHARACTER(LEN=*), PARAMETER :: routinen = 'add_fm_submat'
173
174 INTEGER :: handle, nao
175 TYPE(cp_fm_type) :: fm_mat_work_double_re
176
177 CALL timeset(routinen, handle)
178
179 CALL cp_fm_create(fm_mat_work_double_re, cfm_mat_target%matrix_struct)
180 CALL cp_fm_set_all(fm_mat_work_double_re, 0.0_dp)
181
182 CALL cp_fm_get_info(fm_mat_source, nrow_global=nao)
183
184 CALL cp_fm_to_fm_submat(msource=fm_mat_source, mtarget=fm_mat_work_double_re, &
185 nrow=nao, ncol=nao, &
186 s_firstrow=1, s_firstcol=1, &
187 t_firstrow=nstart_row, t_firstcol=nstart_col)
188
189 CALL cp_cfm_scale_and_add_fm(z_one, cfm_mat_target, z_one, fm_mat_work_double_re)
190
191 CALL cp_fm_release(fm_mat_work_double_re)
192
193 CALL timestop(handle)
194
195 END SUBROUTINE add_fm_submat
196
197! **************************************************************************************************
198!> \brief ...
199!> \param cfm_mat_target ...
200!> \param cfm_mat_source ...
201!> \param nstart_row ...
202!> \param nstart_col ...
203!> \param factor ...
204! **************************************************************************************************
205 SUBROUTINE add_cfm_submat(cfm_mat_target, cfm_mat_source, nstart_row, nstart_col, factor)
206
207 TYPE(cp_cfm_type) :: cfm_mat_target, cfm_mat_source
208 INTEGER :: nstart_row, nstart_col
209 COMPLEX(KIND=dp), OPTIONAL :: factor
210
211 CHARACTER(LEN=*), PARAMETER :: routinen = 'add_cfm_submat'
212
213 COMPLEX(KIND=dp) :: factor_im, factor_re
214 INTEGER :: handle, nao
215 TYPE(cp_fm_type) :: fm_mat_source_im, fm_mat_source_re, &
216 fm_mat_work_double_im, &
217 fm_mat_work_double_re
218
219 CALL timeset(routinen, handle)
220
221 CALL cp_fm_create(fm_mat_work_double_re, cfm_mat_target%matrix_struct)
222 CALL cp_fm_create(fm_mat_work_double_im, cfm_mat_target%matrix_struct)
223 CALL cp_fm_set_all(fm_mat_work_double_re, 0.0_dp)
224 CALL cp_fm_set_all(fm_mat_work_double_im, 0.0_dp)
225
226 CALL cp_fm_create(fm_mat_source_re, cfm_mat_source%matrix_struct)
227 CALL cp_fm_create(fm_mat_source_im, cfm_mat_source%matrix_struct)
228 CALL cp_cfm_to_fm(cfm_mat_source, fm_mat_source_re, fm_mat_source_im)
229
230 CALL cp_cfm_get_info(cfm_mat_source, nrow_global=nao)
231
232 CALL cp_fm_to_fm_submat(msource=fm_mat_source_re, mtarget=fm_mat_work_double_re, &
233 nrow=nao, ncol=nao, &
234 s_firstrow=1, s_firstcol=1, &
235 t_firstrow=nstart_row, t_firstcol=nstart_col)
236
237 CALL cp_fm_to_fm_submat(msource=fm_mat_source_im, mtarget=fm_mat_work_double_im, &
238 nrow=nao, ncol=nao, &
239 s_firstrow=1, s_firstcol=1, &
240 t_firstrow=nstart_row, t_firstcol=nstart_col)
241
242 IF (PRESENT(factor)) THEN
243 factor_re = factor
244 factor_im = gaussi*factor
245 ELSE
246 factor_re = z_one
247 factor_im = gaussi
248 END IF
249
250 CALL cp_cfm_scale_and_add_fm(z_one, cfm_mat_target, factor_re, fm_mat_work_double_re)
251 CALL cp_cfm_scale_and_add_fm(z_one, cfm_mat_target, factor_im, fm_mat_work_double_im)
252
253 CALL cp_fm_release(fm_mat_work_double_re)
254 CALL cp_fm_release(fm_mat_work_double_im)
255 CALL cp_fm_release(fm_mat_source_re)
256 CALL cp_fm_release(fm_mat_source_im)
257
258 CALL timestop(handle)
259
260 END SUBROUTINE add_cfm_submat
261
262! **************************************************************************************************
263!> \brief ...
264!> \param cfm_mat_target ...
265!> \param cfm_mat_source ...
266!> \param nstart_row ...
267!> \param nstart_col ...
268! **************************************************************************************************
269 SUBROUTINE get_cfm_submat(cfm_mat_target, cfm_mat_source, nstart_row, nstart_col)
270
271 TYPE(cp_cfm_type) :: cfm_mat_target, cfm_mat_source
272 INTEGER :: nstart_row, nstart_col
273
274 CHARACTER(LEN=*), PARAMETER :: routinen = 'get_cfm_submat'
275
276 INTEGER :: handle, nao
277 TYPE(cp_fm_type) :: fm_mat_source_double_im, &
278 fm_mat_source_double_re, &
279 fm_mat_work_im, fm_mat_work_re
280
281 CALL timeset(routinen, handle)
282
283 CALL cp_fm_create(fm_mat_source_double_re, cfm_mat_source%matrix_struct)
284 CALL cp_fm_create(fm_mat_source_double_im, cfm_mat_source%matrix_struct)
285 CALL cp_cfm_to_fm(cfm_mat_source, fm_mat_source_double_re, fm_mat_source_double_im)
286
287 CALL cp_fm_create(fm_mat_work_re, cfm_mat_target%matrix_struct)
288 CALL cp_fm_create(fm_mat_work_im, cfm_mat_target%matrix_struct)
289 CALL cp_fm_set_all(fm_mat_work_re, 0.0_dp)
290 CALL cp_fm_set_all(fm_mat_work_im, 0.0_dp)
291
292 CALL cp_cfm_get_info(cfm_mat_target, nrow_global=nao)
293
294 CALL cp_fm_to_fm_submat(msource=fm_mat_source_double_re, mtarget=fm_mat_work_re, &
295 nrow=nao, ncol=nao, &
296 s_firstrow=nstart_row, s_firstcol=nstart_col, &
297 t_firstrow=1, t_firstcol=1)
298
299 CALL cp_fm_to_fm_submat(msource=fm_mat_source_double_im, mtarget=fm_mat_work_im, &
300 nrow=nao, ncol=nao, &
301 s_firstrow=nstart_row, s_firstcol=nstart_col, &
302 t_firstrow=1, t_firstcol=1)
303
304 CALL cp_fm_to_cfm(fm_mat_work_re, fm_mat_work_im, cfm_mat_target)
305
306 CALL cp_fm_release(fm_mat_work_re)
307 CALL cp_fm_release(fm_mat_work_im)
308 CALL cp_fm_release(fm_mat_source_double_re)
309 CALL cp_fm_release(fm_mat_source_double_im)
310
311 CALL timestop(handle)
312
313 END SUBROUTINE get_cfm_submat
314
315! **************************************************************************************************
316!> \brief ...
317!> \param fm_orig ...
318!> \param cfm_double ...
319! **************************************************************************************************
320 SUBROUTINE create_cfm_double(fm_orig, cfm_double)
321 TYPE(cp_fm_type) :: fm_orig
322 TYPE(cp_cfm_type) :: cfm_double
323
324 CHARACTER(LEN=*), PARAMETER :: routinen = 'create_cfm_double'
325
326 INTEGER :: handle, ncol_global_orig, &
327 nrow_global_orig
328 TYPE(cp_fm_struct_type), POINTER :: fm_struct_double
329
330 CALL timeset(routinen, handle)
331
332 CALL cp_fm_get_info(matrix=fm_orig, nrow_global=nrow_global_orig, ncol_global=ncol_global_orig)
333
334 CALL cp_fm_struct_create(fm_struct_double, &
335 nrow_global=2*nrow_global_orig, &
336 ncol_global=2*ncol_global_orig, &
337 template_fmstruct=fm_orig%matrix_struct)
338
339 CALL cp_cfm_create(cfm_double, fm_struct_double)
340
341 CALL cp_fm_struct_release(fm_struct_double)
342
343 CALL timestop(handle)
344
345 END SUBROUTINE create_cfm_double
346
347END MODULE soc_pseudopotential_utils
cp_cfm_basic_linalg::cp_cfm_scale
Definition cp_cfm_basic_linalg.F:61
cp_fm_types::cp_fm_release
Definition cp_fm_types.F:90
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:244
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:1239
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:355
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:159
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:817
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:607
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:179
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:765
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:208
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:125
cp_fm_struct::cp_fm_struct_release
subroutine, public cp_fm_struct_release(fmstruct)
releases a full matrix structure
Definition cp_fm_struct.F:320
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:1016
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:1473
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:535
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:167
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::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:206
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:270
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:167
soc_pseudopotential_utils::cfm_add_on_diag
subroutine, public cfm_add_on_diag(cfm, alpha)
...
Definition soc_pseudopotential_utils.F:121
soc_pseudopotential_utils::create_cfm_double
subroutine, public create_cfm_double(fm_orig, cfm_double)
...
Definition soc_pseudopotential_utils.F:321
cp_cfm_types::cp_cfm_type
Represent a complex full matrix.
Definition cp_cfm_types.F:68
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:116