(git:f2099e5)
Loading...
Searching...
No Matches
qs_tddfpt2_soc_utils.F
Go to the documentation of this file.
1!--------------------------------------------------------------------------------------------------!
2! CP2K: A general program to perform molecular dynamics simulations !
3! Copyright 2000-2026 CP2K developers group <https://cp2k.org> !
4! !
5! SPDX-License-Identifier: GPL-2.0-or-later !
6!--------------------------------------------------------------------------------------------------!
7
8! **************************************************************************************************
9!> \brief Utilities absorption spectroscopy using TDDFPT with SOC
10!> \author JRVogt (12.2023)
11! **************************************************************************************************
12
13MODULE qs_tddfpt2_soc_utils
14 USE cp_blacs_env, ONLY: cp_blacs_env_type
15 USE cp_cfm_types, ONLY: cp_cfm_get_info,&
16 cp_cfm_get_submatrix,&
17 cp_cfm_type
18 USE cp_control_types, ONLY: tddfpt2_control_type
19 USE cp_dbcsr_api, ONLY: dbcsr_copy,&
20 dbcsr_create,&
21 dbcsr_desymmetrize,&
22 dbcsr_get_info,&
23 dbcsr_p_type,&
24 dbcsr_release,&
25 dbcsr_type
26 USE cp_dbcsr_operations, ONLY: copy_dbcsr_to_fm,&
27 copy_fm_to_dbcsr,&
28 cp_dbcsr_sm_fm_multiply,&
29 dbcsr_allocate_matrix_set,&
30 dbcsr_deallocate_matrix_set
31 USE cp_fm_basic_linalg, ONLY: cp_fm_schur_product
32 USE cp_fm_struct, ONLY: cp_fm_struct_create,&
33 cp_fm_struct_release,&
34 cp_fm_struct_type
35 USE cp_fm_types, ONLY: cp_fm_create,&
36 cp_fm_get_info,&
37 cp_fm_release,&
38 cp_fm_set_all,&
39 cp_fm_to_fm,&
40 cp_fm_to_fm_submat,&
41 cp_fm_type
42 USE input_constants, ONLY: tddfpt_dipole_berry,&
43 tddfpt_dipole_length,&
44 tddfpt_dipole_velocity
45 USE kinds, ONLY: dp
46 USE message_passing, ONLY: mp_para_env_type
47 USE moments_utils, ONLY: get_reference_point
48 USE parallel_gemm_api, ONLY: parallel_gemm
49 USE qs_environment_types, ONLY: get_qs_env,&
50 qs_environment_type
51 USE qs_ks_types, ONLY: qs_ks_env_type
52 USE qs_moments, ONLY: build_local_moment_matrix
53 USE qs_neighbor_list_types, ONLY: neighbor_list_set_p_type
54 USE qs_operators_ao, ONLY: build_lin_mom_matrix
55 USE qs_overlap, ONLY: build_overlap_matrix
56 USE qs_tddfpt2_soc_types, ONLY: soc_env_type
57 USE qs_tddfpt2_types, ONLY: tddfpt_ground_state_mos
58
59!$ USE OMP_LIB, ONLY: omp_get_max_threads, omp_get_thread_num
60#include "./base/base_uses.f90"
61
62 IMPLICIT NONE
63 PRIVATE
64
65 CHARACTER(len=*), PARAMETER, PRIVATE :: moduleN = 'qs_tddfpt2_soc_utils'
66
67 PUBLIC :: soc_dipole_operator, soc_contract_evect, resort_evects, dip_vel_op
68
69 !A helper type for SOC
70 TYPE dbcsr_soc_package_type
71 TYPE(dbcsr_type), POINTER :: dbcsr_sg => null()
72 TYPE(dbcsr_type), POINTER :: dbcsr_tp => null()
73 TYPE(dbcsr_type), POINTER :: dbcsr_sc => null()
74 TYPE(dbcsr_type), POINTER :: dbcsr_sf => null()
75 TYPE(dbcsr_type), POINTER :: dbcsr_prod => null()
76 TYPE(dbcsr_type), POINTER :: dbcsr_ovlp => null()
77 TYPE(dbcsr_type), POINTER :: dbcsr_tmp => null()
78 TYPE(dbcsr_type), POINTER :: dbcsr_work => null()
79 END TYPE dbcsr_soc_package_type
80
81CONTAINS
82
83! **************************************************************************************************
84!> \brief Build the atomic dipole operator
85!> \param soc_env ...
86!> \param tddfpt_control informations on how to build the operaot
87!> \param qs_env Qucikstep environment
88!> \param gs_mos ...
89! **************************************************************************************************
90 SUBROUTINE soc_dipole_operator(soc_env, tddfpt_control, qs_env, gs_mos)
91 TYPE(soc_env_type), TARGET :: soc_env
92 TYPE(tddfpt2_control_type), POINTER :: tddfpt_control
93 TYPE(qs_environment_type), INTENT(IN), POINTER :: qs_env
94 TYPE(tddfpt_ground_state_mos), DIMENSION(:), &
95 INTENT(in) :: gs_mos
96
97 CHARACTER(len=*), PARAMETER :: routinen = 'soc_dipole_operator'
98
99 INTEGER :: dim_op, handle, i_dim, nao, nspin
100 REAL(kind=dp), DIMENSION(3) :: reference_point
101 TYPE(dbcsr_p_type), DIMENSION(:), POINTER :: matrix_s
102
103 CALL timeset(routinen, handle)
104
105 NULLIFY (matrix_s)
106
107 IF (tddfpt_control%dipole_form == tddfpt_dipole_berry) THEN
108 cpabort("BERRY DIPOLE FORM NOT IMPLEMENTED FOR SOC")
109 END IF
110 !! ONLY RCS have been implemented, Therefore, nspin sould always be 1!
111 nspin = 1
112 !! Number of dimensions should be 3, unless multipole is implemented in the future
113 dim_op = 3
114
115 !! Initzilize the dipmat structure
116 CALL get_qs_env(qs_env, matrix_s=matrix_s)
117 CALL dbcsr_get_info(matrix_s(1)%matrix, nfullrows_total=nao)
118
119 ALLOCATE (soc_env%dipmat_ao(dim_op))
120 DO i_dim = 1, dim_op
121 ALLOCATE (soc_env%dipmat_ao(i_dim)%matrix)
122 CALL dbcsr_copy(soc_env%dipmat_ao(i_dim)%matrix, &
123 matrix_s(1)%matrix, &
124 name="dipole operator matrix")
125 END DO
126
127 SELECT CASE (tddfpt_control%dipole_form)
128 CASE (tddfpt_dipole_length)
129 CALL get_reference_point(reference_point, qs_env=qs_env, &
130 reference=tddfpt_control%dipole_reference, &
131 ref_point=tddfpt_control%dipole_ref_point)
132
133 CALL build_local_moment_matrix(qs_env, soc_env%dipmat_ao, 1, &
134 ref_point=reference_point, all_images=.true.)
135 !! This will lead to S C^virt C^virt,T Q_q (vgl Strand et al., J. Chem Phys. 150, 044702, 2019)
136 CALL length_rep(qs_env, gs_mos, soc_env)
137 CASE (tddfpt_dipole_velocity)
138 !!This Routine calcluates the dipole Operator within the velocity-form within the ao basis
139 !!This operation is only used in xas_tdp and qs_tddfpt_soc.
140 CALL build_lin_mom_matrix(qs_env, soc_env%dipmat_ao, minimum_image=.false.)
141 !! This will precomute SC^virt, (omega^a-omega^i)^-1 and C^virt dS/dq
142 CALL velocity_rep(qs_env, gs_mos, soc_env)
143 CASE DEFAULT
144 cpabort("Unimplemented form of the dipole operator")
145 END SELECT
146
147 CALL timestop(handle)
148
149 END SUBROUTINE soc_dipole_operator
150
151! **************************************************************************************************
152!> \brief ...
153!> \param qs_env ...
154!> \param gs_mos ...
155!> \param soc_env ...
156! **************************************************************************************************
157 SUBROUTINE length_rep(qs_env, gs_mos, soc_env)
158 TYPE(qs_environment_type), POINTER :: qs_env
159 TYPE(tddfpt_ground_state_mos), DIMENSION(:), &
160 INTENT(in) :: gs_mos
161 TYPE(soc_env_type), TARGET :: soc_env
162
163 INTEGER :: ideriv, ispin, nao, nderivs, nspins
164 INTEGER, ALLOCATABLE, DIMENSION(:) :: nmo_virt
165 TYPE(cp_blacs_env_type), POINTER :: blacs_env
166 TYPE(cp_fm_struct_type), POINTER :: dip_struct, fm_struct
167 TYPE(cp_fm_type), ALLOCATABLE, DIMENSION(:) :: s_mos_virt
168 TYPE(cp_fm_type), ALLOCATABLE, DIMENSION(:, :) :: dipole_op_mos_occ
169 TYPE(cp_fm_type), POINTER :: dipmat_tmp, wfm_ao_ao
170 TYPE(dbcsr_p_type), DIMENSION(:), POINTER :: matrix_s
171 TYPE(dbcsr_type), POINTER :: symm_tmp
172 TYPE(mp_para_env_type), POINTER :: para_env
173
174 CALL get_qs_env(qs_env, matrix_s=matrix_s, blacs_env=blacs_env, para_env=para_env)
175
176 nderivs = 3
177 nspins = 1 !!We only account for rcs, will be changed in the future
178 CALL dbcsr_get_info(matrix_s(1)%matrix, nfullrows_total=nao)
179 ALLOCATE (s_mos_virt(nspins), dipole_op_mos_occ(3, nspins), &
180 wfm_ao_ao, nmo_virt(nspins), symm_tmp, dipmat_tmp)
181
182 CALL cp_fm_struct_create(dip_struct, context=blacs_env, ncol_global=nao, nrow_global=nao, para_env=para_env)
183
184 CALL dbcsr_allocate_matrix_set(soc_env%dipmat, nderivs)
185 CALL dbcsr_desymmetrize(matrix_s(1)%matrix, symm_tmp)
186 DO ideriv = 1, nderivs
187 ALLOCATE (soc_env%dipmat(ideriv)%matrix)
188 CALL dbcsr_create(soc_env%dipmat(ideriv)%matrix, template=symm_tmp, &
189 name="contracted operator", matrix_type="N")
190 DO ispin = 1, nspins
191 CALL cp_fm_create(dipole_op_mos_occ(ideriv, ispin), matrix_struct=dip_struct)
192 END DO
193 END DO
194
195 CALL dbcsr_release(symm_tmp)
196 DEALLOCATE (symm_tmp)
197
198 DO ispin = 1, nspins
199 nmo_virt(ispin) = SIZE(gs_mos(ispin)%evals_virt)
200 CALL cp_fm_get_info(gs_mos(ispin)%mos_virt, matrix_struct=fm_struct)
201 CALL cp_fm_create(wfm_ao_ao, dip_struct)
202 CALL cp_fm_create(s_mos_virt(ispin), fm_struct)
203
204 CALL cp_dbcsr_sm_fm_multiply(matrix_s(1)%matrix, &
205 gs_mos(ispin)%mos_virt, &
206 s_mos_virt(ispin), &
207 ncol=nmo_virt(ispin), alpha=1.0_dp, beta=0.0_dp)
208 CALL parallel_gemm('N', 'T', nao, nao, nmo_virt(ispin), &
209 1.0_dp, s_mos_virt(ispin), gs_mos(ispin)%mos_virt, &
210 0.0_dp, wfm_ao_ao)
211
212 DO ideriv = 1, nderivs
213 CALL cp_fm_create(dipmat_tmp, dip_struct)
214 CALL copy_dbcsr_to_fm(soc_env%dipmat_ao(ideriv)%matrix, dipmat_tmp)
215 CALL parallel_gemm('N', 'T', nao, nao, nao, &
216 1.0_dp, wfm_ao_ao, dipmat_tmp, &
217 0.0_dp, dipole_op_mos_occ(ideriv, ispin))
218 CALL copy_fm_to_dbcsr(dipole_op_mos_occ(ideriv, ispin), soc_env%dipmat(ideriv)%matrix)
219 CALL cp_fm_release(dipmat_tmp)
220 END DO
221 CALL cp_fm_release(wfm_ao_ao)
222 DEALLOCATE (wfm_ao_ao)
223 END DO
224
225 CALL cp_fm_struct_release(dip_struct)
226 DO ispin = 1, nspins
227 CALL cp_fm_release(s_mos_virt(ispin))
228 DO ideriv = 1, nderivs
229 CALL cp_fm_release(dipole_op_mos_occ(ideriv, ispin))
230 END DO
231 END DO
232 DEALLOCATE (s_mos_virt, dipole_op_mos_occ, nmo_virt, dipmat_tmp)
233
234 END SUBROUTINE length_rep
235
236! **************************************************************************************************
237!> \brief ...
238!> \param qs_env ...
239!> \param gs_mos ...
240!> \param soc_env ...
241! **************************************************************************************************
242 SUBROUTINE velocity_rep(qs_env, gs_mos, soc_env)
243 TYPE(qs_environment_type), POINTER :: qs_env
244 TYPE(tddfpt_ground_state_mos), DIMENSION(:), &
245 INTENT(in) :: gs_mos
246 TYPE(soc_env_type), TARGET :: soc_env
247
248 INTEGER :: ici, icol, ideriv, irow, ispin, n_act, &
249 n_virt, nao, ncols_local, nderivs, &
250 nrows_local, nspins
251 INTEGER, DIMENSION(:), POINTER :: col_indices, row_indices
252 REAL(kind=dp) :: eval_occ
253 REAL(kind=dp), CONTIGUOUS, DIMENSION(:, :), &
254 POINTER :: local_data_ediff
255 TYPE(cp_blacs_env_type), POINTER :: blacs_env
256 TYPE(cp_fm_struct_type), POINTER :: ao_cvirt_struct, cvirt_ao_struct, &
257 fm_struct, scrm_struct
258 TYPE(cp_fm_type) :: scrm_fm
259 TYPE(dbcsr_p_type), DIMENSION(:), POINTER :: matrix_s, scrm
260 TYPE(neighbor_list_set_p_type), DIMENSION(:), &
261 POINTER :: sab_orb
262 TYPE(qs_ks_env_type), POINTER :: ks_env
263
264 NULLIFY (scrm, scrm_struct, blacs_env, matrix_s, ao_cvirt_struct, cvirt_ao_struct)
265 nspins = 1
266 nderivs = 3
267 ALLOCATE (soc_env%SC(nspins), soc_env%CdS(nspins, nderivs), soc_env%ediff(nspins))
268
269 CALL get_qs_env(qs_env, ks_env=ks_env, sab_orb=sab_orb, blacs_env=blacs_env, matrix_s=matrix_s)
270 CALL dbcsr_get_info(matrix_s(1)%matrix, nfullrows_total=nao)
271 CALL cp_fm_struct_create(scrm_struct, nrow_global=nao, ncol_global=nao, &
272 context=blacs_env)
273 CALL cp_fm_get_info(gs_mos(1)%mos_virt, matrix_struct=ao_cvirt_struct)
274
275 CALL build_overlap_matrix(ks_env, matrix_s=scrm, nderivative=1, &
276 basis_type_a="ORB", basis_type_b="ORB", &
277 sab_nl=sab_orb)
278
279 DO ispin = 1, nspins
280 NULLIFY (fm_struct)
281!deb n_occ = SIZE(gs_mos(ispin)%evals_occ)
282 n_act = gs_mos(ispin)%nmo_active
283 n_virt = SIZE(gs_mos(ispin)%evals_virt)
284 CALL cp_fm_struct_create(fm_struct, nrow_global=n_virt, &
285 ncol_global=n_act, context=blacs_env)
286 CALL cp_fm_struct_create(cvirt_ao_struct, nrow_global=n_virt, &
287 ncol_global=nao, context=blacs_env)
288 CALL cp_fm_create(soc_env%ediff(ispin), fm_struct)
289 CALL cp_fm_create(soc_env%SC(ispin), ao_cvirt_struct)
290
291 CALL cp_dbcsr_sm_fm_multiply(matrix_s(1)%matrix, &
292 gs_mos(ispin)%mos_virt, &
293 soc_env%SC(ispin), &
294 ncol=n_virt, alpha=1.0_dp, beta=0.0_dp)
295
296 CALL cp_fm_get_info(soc_env%ediff(ispin), nrow_local=nrows_local, ncol_local=ncols_local, &
297 row_indices=row_indices, col_indices=col_indices, local_data=local_data_ediff)
298
299!$OMP PARALLEL DO DEFAULT(NONE), &
300!$OMP PRIVATE(eval_occ, ici, icol, irow), &
301!$OMP SHARED(col_indices, gs_mos, ispin, local_data_ediff, ncols_local, nrows_local, row_indices)
302 DO icol = 1, ncols_local
303 ! E_occ_i ; imo_occ = col_indices(icol)
304 ici = gs_mos(ispin)%index_active(col_indices(icol))
305 eval_occ = gs_mos(ispin)%evals_occ(ici)
306
307 DO irow = 1, nrows_local
308 ! ediff_inv_weights(a, i) = 1.0 / (E_virt_a - E_occ_i)
309 ! imo_virt = row_indices(irow)
310 local_data_ediff(irow, icol) = 1.0_dp/(gs_mos(ispin)%evals_virt(row_indices(irow)) - eval_occ)
311 END DO
312 END DO
313!$OMP END PARALLEL DO
314
315 DO ideriv = 1, nderivs
316 CALL cp_fm_create(soc_env%CdS(ispin, ideriv), cvirt_ao_struct)
317 CALL cp_fm_create(scrm_fm, scrm_struct)
318 CALL copy_dbcsr_to_fm(scrm(ideriv + 1)%matrix, scrm_fm)
319 CALL parallel_gemm('T', 'N', n_virt, nao, nao, 1.0_dp, gs_mos(ispin)%mos_virt, &
320 scrm_fm, 0.0_dp, soc_env%CdS(ispin, ideriv))
321 CALL cp_fm_release(scrm_fm)
322
323 END DO
324
325 CALL cp_fm_struct_release(fm_struct)
326 END DO
327 CALL dbcsr_deallocate_matrix_set(scrm)
328 CALL cp_fm_struct_release(scrm_struct)
329 CALL cp_fm_struct_release(cvirt_ao_struct)
330
331 END SUBROUTINE velocity_rep
332
333! **************************************************************************************************
334!> \brief This routine will construct the dipol operator within velocity representation
335!> \param soc_env ..
336!> \param qs_env ...
337!> \param evec_fm ...
338!> \param op ...
339!> \param ideriv ...
340!> \param tp ...
341!> \param gs_coeffs ...
342!> \param sggs_fm ...
343! **************************************************************************************************
344 SUBROUTINE dip_vel_op(soc_env, qs_env, evec_fm, op, ideriv, tp, gs_coeffs, sggs_fm)
345 TYPE(soc_env_type), TARGET :: soc_env
346 TYPE(qs_environment_type), POINTER :: qs_env
347 TYPE(cp_fm_type), DIMENSION(:, :), INTENT(IN) :: evec_fm
348 TYPE(dbcsr_type), INTENT(INOUT) :: op
349 INTEGER, INTENT(IN) :: ideriv
350 LOGICAL, INTENT(IN) :: tp
351 TYPE(cp_fm_type), OPTIONAL, POINTER :: gs_coeffs
352 TYPE(cp_fm_type), INTENT(INOUT), OPTIONAL :: sggs_fm
353
354 INTEGER :: iex, ispin, n_act, n_virt, nao, nex
355 LOGICAL :: sggs
356 TYPE(cp_blacs_env_type), POINTER :: blacs_env
357 TYPE(cp_fm_struct_type), POINTER :: op_struct, virt_occ_struct
358 TYPE(cp_fm_type) :: cdsc, op_fm, scwcdsc, wcdsc
359 TYPE(cp_fm_type), ALLOCATABLE, DIMENSION(:, :) :: wcdsc_tmp
360 TYPE(cp_fm_type), POINTER :: coeff
361 TYPE(mp_para_env_type), POINTER :: para_env
362
363 NULLIFY (virt_occ_struct, virt_occ_struct, op_struct, blacs_env, para_env, coeff)
364
365 IF (tp) THEN
366 coeff => soc_env%b_coeff
367 ELSE
368 coeff => soc_env%a_coeff
369 END IF
370
371 sggs = .false.
372 IF (PRESENT(gs_coeffs)) sggs = .true.
373
374 ispin = 1 !! only rcs availble
375 nex = SIZE(evec_fm, 2)
376 IF (.NOT. sggs) ALLOCATE (wcdsc_tmp(ispin, nex))
377 CALL get_qs_env(qs_env, blacs_env=blacs_env, para_env=para_env)
378 CALL cp_fm_get_info(soc_env%CdS(ispin, ideriv), ncol_global=nao, nrow_global=n_virt)
379 CALL cp_fm_get_info(evec_fm(1, 1), ncol_global=n_act)
380
381 IF (sggs) THEN
382 CALL cp_fm_struct_create(virt_occ_struct, context=blacs_env, para_env=para_env, nrow_global=n_virt, &
383 ncol_global=n_act)
384 CALL cp_fm_struct_create(op_struct, context=blacs_env, para_env=para_env, nrow_global=n_act*nex, &
385 ncol_global=n_act)
386 ELSE
387 CALL cp_fm_struct_create(virt_occ_struct, context=blacs_env, para_env=para_env, nrow_global=n_virt, &
388 ncol_global=n_act*nex)
389 CALL cp_fm_struct_create(op_struct, context=blacs_env, para_env=para_env, nrow_global=n_act*nex, &
390 ncol_global=n_act*nex)
391 END IF
392
393 CALL cp_fm_create(cdsc, soc_env%ediff(ispin)%matrix_struct)
394 CALL cp_fm_create(op_fm, op_struct)
395
396 IF (sggs) THEN
397 CALL cp_fm_create(scwcdsc, gs_coeffs%matrix_struct)
398 CALL cp_fm_create(wcdsc, soc_env%ediff(ispin)%matrix_struct)
399 CALL parallel_gemm('N', 'N', n_virt, n_act, nao, 1.0_dp, soc_env%CdS(ispin, ideriv), &
400 gs_coeffs, 0.0_dp, cdsc)
401 CALL cp_fm_schur_product(cdsc, soc_env%ediff(ispin), wcdsc)
402 ELSE
403 CALL cp_fm_create(scwcdsc, coeff%matrix_struct)
404 DO iex = 1, nex
405 CALL cp_fm_create(wcdsc_tmp(ispin, iex), soc_env%ediff(ispin)%matrix_struct)
406 CALL parallel_gemm('N', 'N', n_virt, n_act, nao, 1.0_dp, soc_env%CdS(ispin, ideriv), &
407 evec_fm(ispin, iex), 0.0_dp, cdsc)
408 CALL cp_fm_schur_product(cdsc, soc_env%ediff(ispin), wcdsc_tmp(ispin, iex))
409 END DO
410 CALL cp_fm_create(wcdsc, virt_occ_struct)
411 CALL soc_contract_evect(wcdsc_tmp, wcdsc)
412 DO iex = 1, nex
413 CALL cp_fm_release(wcdsc_tmp(ispin, iex))
414 END DO
415 DEALLOCATE (wcdsc_tmp)
416 END IF
417
418 IF (sggs) THEN
419 CALL parallel_gemm('N', 'N', nao, n_act, n_virt, 1.0_dp, soc_env%SC(ispin), wcdsc, 0.0_dp, scwcdsc)
420 CALL parallel_gemm('T', 'N', n_act*nex, n_act, nao, 1.0_dp, soc_env%a_coeff, scwcdsc, 0.0_dp, op_fm)
421 ELSE
422 CALL parallel_gemm('N', 'N', nao, n_act*nex, n_virt, 1.0_dp, soc_env%SC(ispin), wcdsc, 0.0_dp, scwcdsc)
423 CALL parallel_gemm('T', 'N', n_act*nex, n_act*nex, nao, 1.0_dp, coeff, scwcdsc, 0.0_dp, op_fm)
424 END IF
425
426 IF (sggs) THEN
427 CALL cp_fm_to_fm(op_fm, sggs_fm)
428 ELSE
429 CALL copy_fm_to_dbcsr(op_fm, op)
430 END IF
431
432 CALL cp_fm_release(op_fm)
433 CALL cp_fm_release(wcdsc)
434 CALL cp_fm_release(scwcdsc)
435 CALL cp_fm_release(cdsc)
436 CALL cp_fm_struct_release(virt_occ_struct)
437 CALL cp_fm_struct_release(op_struct)
438
439 END SUBROUTINE dip_vel_op
440
441! **************************************************************************************************
442!> \brief ...
443!> \param fm_start ...
444!> \param fm_res ...
445! **************************************************************************************************
446 SUBROUTINE soc_contract_evect(fm_start, fm_res)
447
448 TYPE(cp_fm_type), DIMENSION(:, :), INTENT(in) :: fm_start
449 TYPE(cp_fm_type), INTENT(inout) :: fm_res
450
451 CHARACTER(len=*), PARAMETER :: routinen = 'soc_contract_evect'
452
453 INTEGER :: handle, ii, jj, nactive, nao, nspins, &
454 nstates, ntmp1, ntmp2
455
456 CALL timeset(routinen, handle)
457
458 nstates = SIZE(fm_start, 2)
459 nspins = SIZE(fm_start, 1)
460
461 CALL cp_fm_set_all(fm_res, 0.0_dp)
462 !! Evects are written into one matrix.
463 DO ii = 1, nstates
464 DO jj = 1, nspins
465 CALL cp_fm_get_info(fm_start(jj, ii), nrow_global=nao, ncol_global=nactive)
466 CALL cp_fm_get_info(fm_res, nrow_global=ntmp1, ncol_global=ntmp2)
467 CALL cp_fm_to_fm_submat(fm_start(jj, ii), &
468 fm_res, &
469 nao, nactive, &
470 1, 1, 1, &
471 1 + nactive*(ii - 1) + (jj - 1)*nao*nstates)
472 END DO !nspins
473 END DO !nsstates
474
475 CALL timestop(handle)
476
477 END SUBROUTINE soc_contract_evect
478
479! **************************************************************************************************
480!> \brief ...
481!> \param vec ...
482!> \param new_entry ...
483!> \param res ...
484!> \param res_int ...
485! **************************************************************************************************
486 SUBROUTINE test_repetition(vec, new_entry, res, res_int)
487 INTEGER, DIMENSION(:), INTENT(IN) :: vec
488 INTEGER, INTENT(IN) :: new_entry
489 LOGICAL, INTENT(OUT) :: res
490 INTEGER, INTENT(OUT), OPTIONAL :: res_int
491
492 INTEGER :: i
493
494 res = .true.
495 IF (PRESENT(res_int)) res_int = -1
496
497 DO i = 1, SIZE(vec)
498 IF (vec(i) == new_entry) THEN
499 res = .false.
500 IF (PRESENT(res_int)) res_int = i
501 EXIT
502 END IF
503 END DO
504
505 END SUBROUTINE test_repetition
506
507! **************************************************************************************************
508!> \brief Used to find out, which state has which spin-multiplicity
509!> \param evects_cfm ...
510!> \param sort ...
511! **************************************************************************************************
512 SUBROUTINE resort_evects(evects_cfm, sort)
513 TYPE(cp_cfm_type), INTENT(INOUT) :: evects_cfm
514 INTEGER, ALLOCATABLE, DIMENSION(:), INTENT(OUT) :: sort
515
516 COMPLEX(dp), ALLOCATABLE, DIMENSION(:, :) :: cpl_tmp
517 INTEGER :: i_rep, ii, jj, ntot, tmp
518 INTEGER, ALLOCATABLE, DIMENSION(:) :: rep_int
519 LOGICAL :: rep
520 REAL(dp) :: max_dev, max_wfn, wfn_sq
521
522 CALL cp_cfm_get_info(evects_cfm, nrow_global=ntot)
523 ALLOCATE (cpl_tmp(ntot, ntot))
524 ALLOCATE (sort(ntot), rep_int(ntot))
525 cpl_tmp = 0_dp
526 sort = 0
527 max_dev = 0.5_dp
528 CALL cp_cfm_get_submatrix(evects_cfm, cpl_tmp)
529
530 DO jj = 1, ntot
531 rep_int = 0
532 tmp = 0
533 max_wfn = 0_dp
534 DO ii = 1, ntot
535 wfn_sq = abs(real(cpl_tmp(ii, jj)**2 - aimag(cpl_tmp(ii, jj)**2)))
536 IF (max_wfn <= wfn_sq) THEN
537 CALL test_repetition(sort, ii, rep, rep_int(ii))
538 IF (rep) THEN
539 max_wfn = wfn_sq
540 tmp = ii
541 END IF
542 END IF
543 END DO
544 IF (tmp > 0) THEN
545 sort(jj) = tmp
546 ELSE
547 DO i_rep = 1, ntot
548 IF (rep_int(i_rep) > 0) THEN
549 max_wfn = abs(real(cpl_tmp(sort(i_rep), jj)**2 - aimag(cpl_tmp(sort(i_rep), jj)**2))) - max_dev
550 DO ii = 1, ntot
551 wfn_sq = abs(real(cpl_tmp(ii, jj)**2 - aimag(cpl_tmp(ii, jj)**2)))
552 IF ((max_wfn - wfn_sq)/max_wfn <= max_dev) THEN
553 CALL test_repetition(sort, ii, rep)
554 IF (rep .AND. ii /= i_rep) THEN
555 sort(jj) = sort(i_rep)
556 sort(i_rep) = ii
557 END IF
558 END IF
559 END DO
560 END IF
561 END DO
562 END IF
563 END DO
564
565 DEALLOCATE (cpl_tmp, rep_int)
566
567 END SUBROUTINE resort_evects
568
569END MODULE qs_tddfpt2_soc_utils
cp_dbcsr_api::dbcsr_create
Definition cp_dbcsr_api.F:194
cp_dbcsr_operations::dbcsr_allocate_matrix_set
Definition cp_dbcsr_operations.F:95
cp_dbcsr_operations::dbcsr_deallocate_matrix_set
Definition cp_dbcsr_operations.F:103
cp_fm_types::cp_fm_release
Definition cp_fm_types.F:88
cp_fm_types::cp_fm_to_fm
Definition cp_fm_types.F:83
parallel_gemm_api::parallel_gemm
Definition parallel_gemm_api.F:39
cp_blacs_env
methods related to the blacs parallel environment
Definition cp_blacs_env.F:15
cp_cfm_types
Represents a complex full matrix distributed on many processors.
Definition cp_cfm_types.F:12
cp_cfm_types::cp_cfm_get_submatrix
subroutine, public cp_cfm_get_submatrix(fm, target_m, start_row, start_col, n_rows, n_cols, transpose)
Extract a sub-matrix from the full matrix: op(target_m)(1:n_rows,1:n_cols) = fm(start_row:start_row+n...
Definition cp_cfm_types.F:357
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:632
cp_control_types
Defines control structures, which contain the parameters and the settings for the DFT-based calculati...
Definition cp_control_types.F:12
cp_dbcsr_api
Definition cp_dbcsr_api.F:8
cp_dbcsr_api::dbcsr_desymmetrize
subroutine, public dbcsr_desymmetrize(matrix_a, matrix_b)
...
Definition cp_dbcsr_api.F:525
cp_dbcsr_api::dbcsr_copy
subroutine, public dbcsr_copy(matrix_b, matrix_a, name, keep_sparsity, keep_imaginary)
...
Definition cp_dbcsr_api.F:371
cp_dbcsr_api::dbcsr_get_info
subroutine, public dbcsr_get_info(matrix, nblkrows_total, nblkcols_total, nfullrows_total, nfullcols_total, nblkrows_local, nblkcols_local, nfullrows_local, nfullcols_local, my_prow, my_pcol, local_rows, local_cols, proc_row_dist, proc_col_dist, row_blk_size, col_blk_size, row_blk_offset, col_blk_offset, distribution, name, matrix_type, group)
...
Definition cp_dbcsr_api.F:808
cp_dbcsr_api::dbcsr_release
subroutine, public dbcsr_release(matrix)
...
Definition cp_dbcsr_api.F:1142
cp_dbcsr_operations
DBCSR operations in CP2K.
Definition cp_dbcsr_operations.F:18
cp_dbcsr_operations::cp_dbcsr_sm_fm_multiply
subroutine, public cp_dbcsr_sm_fm_multiply(matrix, fm_in, fm_out, ncol, alpha, beta)
multiply a dbcsr with a fm matrix
Definition cp_dbcsr_operations.F:799
cp_dbcsr_operations::copy_dbcsr_to_fm
subroutine, public copy_dbcsr_to_fm(matrix, fm, plan)
Copy a DBCSR matrix to a BLACS matrix.
Definition cp_dbcsr_operations.F:232
cp_dbcsr_operations::copy_fm_to_dbcsr
subroutine, public copy_fm_to_dbcsr(fm, matrix, keep_sparsity)
Copy a BLACS matrix to a dbcsr matrix.
Definition cp_dbcsr_operations.F:129
cp_fm_basic_linalg
Basic linear algebra operations for full matrices.
Definition cp_fm_basic_linalg.F:14
cp_fm_basic_linalg::cp_fm_schur_product
subroutine, public cp_fm_schur_product(matrix_a, matrix_b, matrix_c)
computes the schur product of two matrices c_ij = a_ij * b_ij
Definition cp_fm_basic_linalg.F:724
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:355
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:1038
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:1455
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:534
cp_fm_types::cp_fm_create
subroutine, public cp_fm_create(matrix, matrix_struct, name, nrow, ncol, set_zero)
creates a new full matrix with the given structure
Definition cp_fm_types.F:165
input_constants
collects all constants needed in input so that they can be used without circular dependencies
Definition input_constants.F:18
input_constants::tddfpt_dipole_berry
integer, parameter, public tddfpt_dipole_berry
Definition input_constants.F:744
input_constants::tddfpt_dipole_velocity
integer, parameter, public tddfpt_dipole_velocity
Definition input_constants.F:744
input_constants::tddfpt_dipole_length
integer, parameter, public tddfpt_dipole_length
Definition input_constants.F:744
kinds
Defines the basic variable types.
Definition kinds.F:23
kinds::dp
integer, parameter, public dp
Definition kinds.F:34
message_passing
Interface to the message passing library MPI.
Definition message_passing.F:27
moments_utils
Calculates the moment integrals <a|r^m|b>.
Definition moments_utils.F:15
moments_utils::get_reference_point
subroutine, public get_reference_point(rpoint, drpoint, qs_env, fist_env, reference, ref_point, ifirst, ilast)
...
Definition moments_utils.F:61
parallel_gemm_api
basic linear algebra operations for full matrixes
Definition parallel_gemm_api.F:14
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, mimic, sac_ae, sac_ppl, sac_lri, sap_ppnl, sab_vdw, sab_scp, sap_oce, sab_lrc, sab_se, sab_xtbe, sab_tbe, sab_core, sab_xb, sab_xtb_pp, sab_xtb_nonbond, sab_almo, sab_kp, sab_kp_nosym, sab_cneo, particle_set, energy, force, matrix_h, matrix_h_im, matrix_ks, matrix_ks_im, matrix_vxc, run_rtp, rtp, matrix_h_kp, matrix_h_im_kp, matrix_ks_kp, matrix_ks_im_kp, matrix_vxc_kp, kinetic_kp, matrix_s_kp, matrix_w_kp, matrix_s_ri_aux_kp, matrix_s, matrix_s_ri_aux, matrix_w, matrix_p_mp2, matrix_p_mp2_admm, matrix_vhxc, 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, xcint_weights, rho_core, rho_nlcc, rho_nlcc_g, ks_env, ks_qmmm_env, wf_history, scf_env, local_particles, local_molecules, distribution_2d, dbcsr_dist, molecule_kind_set, molecule_set, subsys, cp_subsys, oce, local_rho_set, rho_atom_set, task_list, task_list_soft, rho0_atom_set, rho0_mpole, rhoz_set, rhoz_cneo_set, ecoul_1c, rho0_s_rs, rho0_s_gs, rhoz_cneo_s_rs, rhoz_cneo_s_gs, do_kpoints, has_unit_metric, requires_mo_derivs, mo_derivs, mo_loc_history, nkind, natom, nelectron_total, nelectron_spin, efield, neighbor_list_id, linres_control, xas_env, virial, cp_ddapc_env, cp_ddapc_ewald, outer_scf_history, outer_scf_ihistory, x_data, et_coupling, dftb_potential, results, se_taper, se_store_int_env, se_nddo_mpole, se_nonbond_env, admm_env, lri_env, lri_density, exstate_env, ec_env, harris_env, dispersion_env, gcp_env, vee, rho_external, external_vxc, mask, mp2_env, bs_env, kg_env, wanniercentres, atprop, ls_scf_env, do_transport, transport_env, v_hartree_rspace, s_mstruct_changed, rho_changed, potential_changed, forces_up_to_date, mscfg_env, almo_scf_env, gradient_history, variable_history, embed_pot, spin_embed_pot, polar_env, mos_last_converged, eeq, rhs, do_rixs, tb_tblite)
Get the QUICKSTEP environment.
Definition qs_environment_types.F:545
qs_ks_types
Definition qs_ks_types.F:15
qs_moments
Calculates the moment integrals <a|r^m|b> and <a|r x d/dr|b>.
Definition qs_moments.F:14
qs_moments::build_local_moment_matrix
subroutine, public build_local_moment_matrix(qs_env, moments, nmoments, ref_point, ref_points, basis_type, all_images, minimum_image, neighbor_image, first_component)
...
Definition qs_moments.F:166
qs_neighbor_list_types
Define the neighbor list data types and the corresponding functionality.
Definition qs_neighbor_list_types.F:17
qs_operators_ao
Definition qs_operators_ao.F:13
qs_operators_ao::build_lin_mom_matrix
subroutine, public build_lin_mom_matrix(qs_env, matrix, minimum_image)
Calculation of the linear momentum matrix <mu|∂|nu> over Cartesian Gaussian functions.
Definition qs_operators_ao.F:275
qs_overlap
Calculation of overlap matrix, its derivatives and forces.
Definition qs_overlap.F:19
qs_overlap::build_overlap_matrix
subroutine, public build_overlap_matrix(ks_env, matrix_s, matrixkp_s, matrix_name, nderivative, basis_type_a, basis_type_b, sab_nl, calculate_forces, matrix_p, matrixkp_p, ext_kpoints)
Calculation of the overlap matrix over Cartesian Gaussian functions.
Definition qs_overlap.F:121
qs_tddfpt2_soc_types
Definition qs_tddfpt2_soc_types.F:7
qs_tddfpt2_soc_utils
Utilities absorption spectroscopy using TDDFPT with SOC.
Definition qs_tddfpt2_soc_utils.F:13
qs_tddfpt2_soc_utils::soc_dipole_operator
subroutine, public soc_dipole_operator(soc_env, tddfpt_control, qs_env, gs_mos)
Build the atomic dipole operator.
Definition qs_tddfpt2_soc_utils.F:91
qs_tddfpt2_soc_utils::resort_evects
subroutine, public resort_evects(evects_cfm, sort)
Used to find out, which state has which spin-multiplicity.
Definition qs_tddfpt2_soc_utils.F:513
qs_tddfpt2_soc_utils::soc_contract_evect
subroutine, public soc_contract_evect(fm_start, fm_res)
...
Definition qs_tddfpt2_soc_utils.F:447
qs_tddfpt2_soc_utils::dip_vel_op
subroutine, public dip_vel_op(soc_env, qs_env, evec_fm, op, ideriv, tp, gs_coeffs, sggs_fm)
This routine will construct the dipol operator within velocity representation.
Definition qs_tddfpt2_soc_utils.F:345
qs_tddfpt2_types
Definition qs_tddfpt2_types.F:8
cp_blacs_env::cp_blacs_env_type
represent a blacs multidimensional parallel environment (for the mpi corrispective see cp_paratypes/m...
Definition cp_blacs_env.F:53
cp_cfm_types::cp_cfm_type
Represent a complex full matrix.
Definition cp_cfm_types.F:70
cp_control_types::tddfpt2_control_type
Definition cp_control_types.F:656
cp_dbcsr_api::dbcsr_p_type
Definition cp_dbcsr_api.F:172
cp_dbcsr_api::dbcsr_type
Definition cp_dbcsr_api.F:176
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:114
message_passing::mp_para_env_type
stores all the informations relevant to an mpi environment
Definition message_passing.F:768
qs_environment_types::qs_environment_type
Definition qs_environment_types.F:224
qs_ks_types::qs_ks_env_type
calculation environment to calculate the ks matrix, holds all the needed vars. assumes that the core ...
Definition qs_ks_types.F:137
qs_neighbor_list_types::neighbor_list_set_p_type
Definition qs_neighbor_list_types.F:67
qs_tddfpt2_soc_types::soc_env_type
Definition qs_tddfpt2_soc_types.F:49
qs_tddfpt2_types::tddfpt_ground_state_mos
Ground state molecular orbitals.
Definition qs_tddfpt2_types.F:85