(git:ab76537)
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-2025 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_neighbor_list_types, ONLY: neighbor_list_set_p_type
53 USE qs_operators_ao, ONLY: p_xyz_ao,&
54 rrc_xyz_ao
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 !!This routine is analog to qs_tddfpt_prperties but only until the rRc_xyz_ao routine
130 !! This will lead to an operator within the nao x nao basis
131 !! qs_tddpft_properies uses nvirt x nocc
132 CALL get_reference_point(reference_point, qs_env=qs_env, &
133 reference=tddfpt_control%dipole_reference, &
134 ref_point=tddfpt_control%dipole_ref_point)
135
136 CALL rrc_xyz_ao(op=soc_env%dipmat_ao, qs_env=qs_env, rc=reference_point, order=1, &
137 minimum_image=.false., soft=.false.)
138 !! This will lead to S C^virt C^virt,T Q_q (vgl Strand et al., J. Chem Phys. 150, 044702, 2019)
139 CALL length_rep(qs_env, gs_mos, soc_env)
140 CASE (tddfpt_dipole_velocity)
141 !!This Routine calcluates the dipole Operator within the velocity-form within the ao basis
142 !!This Operation is only used in xas_tdp and qs_tddfpt_soc, lines uses rmc_x_p_xyz_ao
143 CALL p_xyz_ao(soc_env%dipmat_ao, qs_env, minimum_image=.false.)
144 !! This will precomute SC^virt, (omega^a-omega^i)^-1 and C^virt dS/dq
145 CALL velocity_rep(qs_env, gs_mos, soc_env)
146 CASE DEFAULT
147 cpabort("Unimplemented form of the dipole operator")
148 END SELECT
149
150 CALL timestop(handle)
151
152 END SUBROUTINE soc_dipole_operator
153
154! **************************************************************************************************
155!> \brief ...
156!> \param qs_env ...
157!> \param gs_mos ...
158!> \param soc_env ...
159! **************************************************************************************************
160 SUBROUTINE length_rep(qs_env, gs_mos, soc_env)
161 TYPE(qs_environment_type), POINTER :: qs_env
162 TYPE(tddfpt_ground_state_mos), DIMENSION(:), &
163 INTENT(in) :: gs_mos
164 TYPE(soc_env_type), TARGET :: soc_env
165
166 INTEGER :: ideriv, ispin, nao, nderivs, nspins
167 INTEGER, ALLOCATABLE, DIMENSION(:) :: nmo_virt
168 TYPE(cp_blacs_env_type), POINTER :: blacs_env
169 TYPE(cp_fm_struct_type), POINTER :: dip_struct, fm_struct
170 TYPE(cp_fm_type), ALLOCATABLE, DIMENSION(:) :: s_mos_virt
171 TYPE(cp_fm_type), ALLOCATABLE, DIMENSION(:, :) :: dipole_op_mos_occ
172 TYPE(cp_fm_type), POINTER :: dipmat_tmp, wfm_ao_ao
173 TYPE(dbcsr_p_type), DIMENSION(:), POINTER :: matrix_s
174 TYPE(dbcsr_type), POINTER :: symm_tmp
175 TYPE(mp_para_env_type), POINTER :: para_env
176
177 CALL get_qs_env(qs_env, matrix_s=matrix_s, blacs_env=blacs_env, para_env=para_env)
178
179 nderivs = 3
180 nspins = 1 !!We only account for rcs, will be changed in the future
181 CALL dbcsr_get_info(matrix_s(1)%matrix, nfullrows_total=nao)
182 ALLOCATE (s_mos_virt(nspins), dipole_op_mos_occ(3, nspins), &
183 wfm_ao_ao, nmo_virt(nspins), symm_tmp, dipmat_tmp)
184
185 CALL cp_fm_struct_create(dip_struct, context=blacs_env, ncol_global=nao, nrow_global=nao, para_env=para_env)
186
187 CALL dbcsr_allocate_matrix_set(soc_env%dipmat, nderivs)
188 CALL dbcsr_desymmetrize(matrix_s(1)%matrix, symm_tmp)
189 DO ideriv = 1, nderivs
190 ALLOCATE (soc_env%dipmat(ideriv)%matrix)
191 CALL dbcsr_create(soc_env%dipmat(ideriv)%matrix, template=symm_tmp, &
192 name="contracted operator", matrix_type="N")
193 DO ispin = 1, nspins
194 CALL cp_fm_create(dipole_op_mos_occ(ideriv, ispin), matrix_struct=dip_struct)
195 END DO
196 END DO
197
198 CALL dbcsr_release(symm_tmp)
199 DEALLOCATE (symm_tmp)
200
201 DO ispin = 1, nspins
202 nmo_virt(ispin) = SIZE(gs_mos(ispin)%evals_virt)
203 CALL cp_fm_get_info(gs_mos(ispin)%mos_virt, matrix_struct=fm_struct)
204 CALL cp_fm_create(wfm_ao_ao, dip_struct)
205 CALL cp_fm_create(s_mos_virt(ispin), fm_struct)
206
207 CALL cp_dbcsr_sm_fm_multiply(matrix_s(1)%matrix, &
208 gs_mos(ispin)%mos_virt, &
209 s_mos_virt(ispin), &
210 ncol=nmo_virt(ispin), alpha=1.0_dp, beta=0.0_dp)
211 CALL parallel_gemm('N', 'T', nao, nao, nmo_virt(ispin), &
212 1.0_dp, s_mos_virt(ispin), gs_mos(ispin)%mos_virt, &
213 0.0_dp, wfm_ao_ao)
214
215 DO ideriv = 1, nderivs
216 CALL cp_fm_create(dipmat_tmp, dip_struct)
217 CALL copy_dbcsr_to_fm(soc_env%dipmat_ao(ideriv)%matrix, dipmat_tmp)
218 CALL parallel_gemm('N', 'T', nao, nao, nao, &
219 1.0_dp, wfm_ao_ao, dipmat_tmp, &
220 0.0_dp, dipole_op_mos_occ(ideriv, ispin))
221 CALL copy_fm_to_dbcsr(dipole_op_mos_occ(ideriv, ispin), soc_env%dipmat(ideriv)%matrix)
222 CALL cp_fm_release(dipmat_tmp)
223 END DO
224 CALL cp_fm_release(wfm_ao_ao)
225 DEALLOCATE (wfm_ao_ao)
226 END DO
227
228 CALL cp_fm_struct_release(dip_struct)
229 DO ispin = 1, nspins
230 CALL cp_fm_release(s_mos_virt(ispin))
231 DO ideriv = 1, nderivs
232 CALL cp_fm_release(dipole_op_mos_occ(ideriv, ispin))
233 END DO
234 END DO
235 DEALLOCATE (s_mos_virt, dipole_op_mos_occ, nmo_virt, dipmat_tmp)
236
237 END SUBROUTINE length_rep
238
239! **************************************************************************************************
240!> \brief ...
241!> \param qs_env ...
242!> \param gs_mos ...
243!> \param soc_env ...
244! **************************************************************************************************
245 SUBROUTINE velocity_rep(qs_env, gs_mos, soc_env)
246 TYPE(qs_environment_type), POINTER :: qs_env
247 TYPE(tddfpt_ground_state_mos), DIMENSION(:), &
248 INTENT(in) :: gs_mos
249 TYPE(soc_env_type), TARGET :: soc_env
250
251 INTEGER :: ici, icol, ideriv, irow, ispin, n_act, &
252 n_virt, nao, ncols_local, nderivs, &
253 nrows_local, nspins
254 INTEGER, DIMENSION(:), POINTER :: col_indices, row_indices
255 REAL(kind=dp) :: eval_occ
256 REAL(kind=dp), CONTIGUOUS, DIMENSION(:, :), &
257 POINTER :: local_data_ediff
258 TYPE(cp_blacs_env_type), POINTER :: blacs_env
259 TYPE(cp_fm_struct_type), POINTER :: ao_cvirt_struct, cvirt_ao_struct, &
260 fm_struct, scrm_struct
261 TYPE(cp_fm_type) :: scrm_fm
262 TYPE(dbcsr_p_type), DIMENSION(:), POINTER :: matrix_s, scrm
263 TYPE(neighbor_list_set_p_type), DIMENSION(:), &
264 POINTER :: sab_orb
265 TYPE(qs_ks_env_type), POINTER :: ks_env
266
267 NULLIFY (scrm, scrm_struct, blacs_env, matrix_s, ao_cvirt_struct, cvirt_ao_struct)
268 nspins = 1
269 nderivs = 3
270 ALLOCATE (soc_env%SC(nspins), soc_env%CdS(nspins, nderivs), soc_env%ediff(nspins))
271
272 CALL get_qs_env(qs_env, ks_env=ks_env, sab_orb=sab_orb, blacs_env=blacs_env, matrix_s=matrix_s)
273 CALL dbcsr_get_info(matrix_s(1)%matrix, nfullrows_total=nao)
274 CALL cp_fm_struct_create(scrm_struct, nrow_global=nao, ncol_global=nao, &
275 context=blacs_env)
276 CALL cp_fm_get_info(gs_mos(1)%mos_virt, matrix_struct=ao_cvirt_struct)
277
278 CALL build_overlap_matrix(ks_env, matrix_s=scrm, nderivative=1, &
279 basis_type_a="ORB", basis_type_b="ORB", &
280 sab_nl=sab_orb)
281
282 DO ispin = 1, nspins
283 NULLIFY (fm_struct)
284!deb n_occ = SIZE(gs_mos(ispin)%evals_occ)
285 n_act = gs_mos(ispin)%nmo_active
286 n_virt = SIZE(gs_mos(ispin)%evals_virt)
287 CALL cp_fm_struct_create(fm_struct, nrow_global=n_virt, &
288 ncol_global=n_act, context=blacs_env)
289 CALL cp_fm_struct_create(cvirt_ao_struct, nrow_global=n_virt, &
290 ncol_global=nao, context=blacs_env)
291 CALL cp_fm_create(soc_env%ediff(ispin), fm_struct)
292 CALL cp_fm_create(soc_env%SC(ispin), ao_cvirt_struct)
293
294 CALL cp_dbcsr_sm_fm_multiply(matrix_s(1)%matrix, &
295 gs_mos(ispin)%mos_virt, &
296 soc_env%SC(ispin), &
297 ncol=n_virt, alpha=1.0_dp, beta=0.0_dp)
298
299 CALL cp_fm_get_info(soc_env%ediff(ispin), nrow_local=nrows_local, ncol_local=ncols_local, &
300 row_indices=row_indices, col_indices=col_indices, local_data=local_data_ediff)
301
302!$OMP PARALLEL DO DEFAULT(NONE), &
303!$OMP PRIVATE(eval_occ, ici, icol, irow), &
304!$OMP SHARED(col_indices, gs_mos, ispin, local_data_ediff, ncols_local, nrows_local, row_indices)
305 DO icol = 1, ncols_local
306 ! E_occ_i ; imo_occ = col_indices(icol)
307 ici = gs_mos(ispin)%index_active(col_indices(icol))
308 eval_occ = gs_mos(ispin)%evals_occ(ici)
309
310 DO irow = 1, nrows_local
311 ! ediff_inv_weights(a, i) = 1.0 / (E_virt_a - E_occ_i)
312 ! imo_virt = row_indices(irow)
313 local_data_ediff(irow, icol) = 1.0_dp/(gs_mos(ispin)%evals_virt(row_indices(irow)) - eval_occ)
314 END DO
315 END DO
316!$OMP END PARALLEL DO
317
318 DO ideriv = 1, nderivs
319 CALL cp_fm_create(soc_env%CdS(ispin, ideriv), cvirt_ao_struct)
320 CALL cp_fm_create(scrm_fm, scrm_struct)
321 CALL copy_dbcsr_to_fm(scrm(ideriv + 1)%matrix, scrm_fm)
322 CALL parallel_gemm('T', 'N', n_virt, nao, nao, 1.0_dp, gs_mos(ispin)%mos_virt, &
323 scrm_fm, 0.0_dp, soc_env%CdS(ispin, ideriv))
324 CALL cp_fm_release(scrm_fm)
325
326 END DO
327
328 CALL cp_fm_struct_release(fm_struct)
329 END DO
330 CALL dbcsr_deallocate_matrix_set(scrm)
331 CALL cp_fm_struct_release(scrm_struct)
332 CALL cp_fm_struct_release(cvirt_ao_struct)
333
334 END SUBROUTINE velocity_rep
335
336! **************************************************************************************************
337!> \brief This routine will construct the dipol operator within velocity representation
338!> \param soc_env ..
339!> \param qs_env ...
340!> \param evec_fm ...
341!> \param op ...
342!> \param ideriv ...
343!> \param tp ...
344!> \param gs_coeffs ...
345!> \param sggs_fm ...
346! **************************************************************************************************
347 SUBROUTINE dip_vel_op(soc_env, qs_env, evec_fm, op, ideriv, tp, gs_coeffs, sggs_fm)
348 TYPE(soc_env_type), TARGET :: soc_env
349 TYPE(qs_environment_type), POINTER :: qs_env
350 TYPE(cp_fm_type), DIMENSION(:, :), INTENT(IN) :: evec_fm
351 TYPE(dbcsr_type), INTENT(INOUT) :: op
352 INTEGER, INTENT(IN) :: ideriv
353 LOGICAL, INTENT(IN) :: tp
354 TYPE(cp_fm_type), OPTIONAL, POINTER :: gs_coeffs
355 TYPE(cp_fm_type), INTENT(INOUT), OPTIONAL :: sggs_fm
356
357 INTEGER :: iex, ispin, n_act, n_virt, nao, nex
358 LOGICAL :: sggs
359 TYPE(cp_blacs_env_type), POINTER :: blacs_env
360 TYPE(cp_fm_struct_type), POINTER :: op_struct, virt_occ_struct
361 TYPE(cp_fm_type) :: cdsc, op_fm, scwcdsc, wcdsc
362 TYPE(cp_fm_type), ALLOCATABLE, DIMENSION(:, :) :: wcdsc_tmp
363 TYPE(cp_fm_type), POINTER :: coeff
364 TYPE(mp_para_env_type), POINTER :: para_env
365
366 NULLIFY (virt_occ_struct, virt_occ_struct, op_struct, blacs_env, para_env, coeff)
367
368 IF (tp) THEN
369 coeff => soc_env%b_coeff
370 ELSE
371 coeff => soc_env%a_coeff
372 END IF
373
374 sggs = .false.
375 IF (PRESENT(gs_coeffs)) sggs = .true.
376
377 ispin = 1 !! only rcs availble
378 nex = SIZE(evec_fm, 2)
379 IF (.NOT. sggs) ALLOCATE (wcdsc_tmp(ispin, nex))
380 CALL get_qs_env(qs_env, blacs_env=blacs_env, para_env=para_env)
381 CALL cp_fm_get_info(soc_env%CdS(ispin, ideriv), ncol_global=nao, nrow_global=n_virt)
382 CALL cp_fm_get_info(evec_fm(1, 1), ncol_global=n_act)
383
384 IF (sggs) THEN
385 CALL cp_fm_struct_create(virt_occ_struct, context=blacs_env, para_env=para_env, nrow_global=n_virt, &
386 ncol_global=n_act)
387 CALL cp_fm_struct_create(op_struct, context=blacs_env, para_env=para_env, nrow_global=n_act*nex, &
388 ncol_global=n_act)
389 ELSE
390 CALL cp_fm_struct_create(virt_occ_struct, context=blacs_env, para_env=para_env, nrow_global=n_virt, &
391 ncol_global=n_act*nex)
392 CALL cp_fm_struct_create(op_struct, context=blacs_env, para_env=para_env, nrow_global=n_act*nex, &
393 ncol_global=n_act*nex)
394 END IF
395
396 CALL cp_fm_create(cdsc, soc_env%ediff(ispin)%matrix_struct)
397 CALL cp_fm_create(op_fm, op_struct)
398
399 IF (sggs) THEN
400 CALL cp_fm_create(scwcdsc, gs_coeffs%matrix_struct)
401 CALL cp_fm_create(wcdsc, soc_env%ediff(ispin)%matrix_struct)
402 CALL parallel_gemm('N', 'N', n_virt, n_act, nao, 1.0_dp, soc_env%CdS(ispin, ideriv), &
403 gs_coeffs, 0.0_dp, cdsc)
404 CALL cp_fm_schur_product(cdsc, soc_env%ediff(ispin), wcdsc)
405 ELSE
406 CALL cp_fm_create(scwcdsc, coeff%matrix_struct)
407 DO iex = 1, nex
408 CALL cp_fm_create(wcdsc_tmp(ispin, iex), soc_env%ediff(ispin)%matrix_struct)
409 CALL parallel_gemm('N', 'N', n_virt, n_act, nao, 1.0_dp, soc_env%CdS(ispin, ideriv), &
410 evec_fm(ispin, iex), 0.0_dp, cdsc)
411 CALL cp_fm_schur_product(cdsc, soc_env%ediff(ispin), wcdsc_tmp(ispin, iex))
412 END DO
413 CALL cp_fm_create(wcdsc, virt_occ_struct)
414 CALL soc_contract_evect(wcdsc_tmp, wcdsc)
415 DO iex = 1, nex
416 CALL cp_fm_release(wcdsc_tmp(ispin, iex))
417 END DO
418 DEALLOCATE (wcdsc_tmp)
419 END IF
420
421 IF (sggs) THEN
422 CALL parallel_gemm('N', 'N', nao, n_act, 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, nao, 1.0_dp, soc_env%a_coeff, scwcdsc, 0.0_dp, op_fm)
424 ELSE
425 CALL parallel_gemm('N', 'N', nao, n_act*nex, n_virt, 1.0_dp, soc_env%SC(ispin), wcdsc, 0.0_dp, scwcdsc)
426 CALL parallel_gemm('T', 'N', n_act*nex, n_act*nex, nao, 1.0_dp, coeff, scwcdsc, 0.0_dp, op_fm)
427 END IF
428
429 IF (sggs) THEN
430 CALL cp_fm_to_fm(op_fm, sggs_fm)
431 ELSE
432 CALL copy_fm_to_dbcsr(op_fm, op)
433 END IF
434
435 CALL cp_fm_release(op_fm)
436 CALL cp_fm_release(wcdsc)
437 CALL cp_fm_release(scwcdsc)
438 CALL cp_fm_release(cdsc)
439 CALL cp_fm_struct_release(virt_occ_struct)
440 CALL cp_fm_struct_release(op_struct)
441
442 END SUBROUTINE dip_vel_op
443
444! **************************************************************************************************
445!> \brief ...
446!> \param fm_start ...
447!> \param fm_res ...
448! **************************************************************************************************
449 SUBROUTINE soc_contract_evect(fm_start, fm_res)
450
451 TYPE(cp_fm_type), DIMENSION(:, :), INTENT(in) :: fm_start
452 TYPE(cp_fm_type), INTENT(inout) :: fm_res
453
454 CHARACTER(len=*), PARAMETER :: routinen = 'soc_contract_evect'
455
456 INTEGER :: handle, ii, jj, nactive, nao, nspins, &
457 nstates, ntmp1, ntmp2
458
459 CALL timeset(routinen, handle)
460
461 nstates = SIZE(fm_start, 2)
462 nspins = SIZE(fm_start, 1)
463
464 CALL cp_fm_set_all(fm_res, 0.0_dp)
465 !! Evects are written into one matrix.
466 DO ii = 1, nstates
467 DO jj = 1, nspins
468 CALL cp_fm_get_info(fm_start(jj, ii), nrow_global=nao, ncol_global=nactive)
469 CALL cp_fm_get_info(fm_res, nrow_global=ntmp1, ncol_global=ntmp2)
470 CALL cp_fm_to_fm_submat(fm_start(jj, ii), &
471 fm_res, &
472 nao, nactive, &
473 1, 1, 1, &
474 1 + nactive*(ii - 1) + (jj - 1)*nao*nstates)
475 END DO !nspins
476 END DO !nsstates
477
478 CALL timestop(handle)
479
480 END SUBROUTINE soc_contract_evect
481
482! **************************************************************************************************
483!> \brief ...
484!> \param vec ...
485!> \param new_entry ...
486!> \param res ...
487!> \param res_int ...
488! **************************************************************************************************
489 SUBROUTINE test_repetition(vec, new_entry, res, res_int)
490 INTEGER, DIMENSION(:), INTENT(IN) :: vec
491 INTEGER, INTENT(IN) :: new_entry
492 LOGICAL, INTENT(OUT) :: res
493 INTEGER, INTENT(OUT), OPTIONAL :: res_int
494
495 INTEGER :: i
496
497 res = .true.
498 IF (PRESENT(res_int)) res_int = -1
499
500 DO i = 1, SIZE(vec)
501 IF (vec(i) == new_entry) THEN
502 res = .false.
503 IF (PRESENT(res_int)) res_int = i
504 EXIT
505 END IF
506 END DO
507
508 END SUBROUTINE test_repetition
509
510! **************************************************************************************************
511!> \brief Used to find out, which state has which spin-multiplicity
512!> \param evects_cfm ...
513!> \param sort ...
514! **************************************************************************************************
515 SUBROUTINE resort_evects(evects_cfm, sort)
516 TYPE(cp_cfm_type), INTENT(INOUT) :: evects_cfm
517 INTEGER, ALLOCATABLE, DIMENSION(:), INTENT(OUT) :: sort
518
519 COMPLEX(dp), ALLOCATABLE, DIMENSION(:, :) :: cpl_tmp
520 INTEGER :: i_rep, ii, jj, ntot, tmp
521 INTEGER, ALLOCATABLE, DIMENSION(:) :: rep_int
522 LOGICAL :: rep
523 REAL(dp) :: max_dev, max_wfn, wfn_sq
524
525 CALL cp_cfm_get_info(evects_cfm, nrow_global=ntot)
526 ALLOCATE (cpl_tmp(ntot, ntot))
527 ALLOCATE (sort(ntot), rep_int(ntot))
528 cpl_tmp = 0_dp
529 sort = 0
530 max_dev = 0.5
531 CALL cp_cfm_get_submatrix(evects_cfm, cpl_tmp)
532
533 DO jj = 1, ntot
534 rep_int = 0
535 tmp = 0
536 max_wfn = 0_dp
537 DO ii = 1, ntot
538 wfn_sq = abs(real(cpl_tmp(ii, jj)**2 - aimag(cpl_tmp(ii, jj)**2)))
539 IF (max_wfn <= wfn_sq) THEN
540 CALL test_repetition(sort, ii, rep, rep_int(ii))
541 IF (rep) THEN
542 max_wfn = wfn_sq
543 tmp = ii
544 END IF
545 END IF
546 END DO
547 IF (tmp > 0) THEN
548 sort(jj) = tmp
549 ELSE
550 DO i_rep = 1, ntot
551 IF (rep_int(i_rep) > 0) THEN
552 max_wfn = abs(real(cpl_tmp(sort(i_rep), jj)**2 - aimag(cpl_tmp(sort(i_rep), jj)**2))) - max_dev
553 DO ii = 1, ntot
554 wfn_sq = abs(real(cpl_tmp(ii, jj)**2 - aimag(cpl_tmp(ii, jj)**2)))
555 IF ((max_wfn - wfn_sq)/max_wfn <= max_dev) THEN
556 CALL test_repetition(sort, ii, rep)
557 IF (rep .AND. ii /= i_rep) THEN
558 sort(jj) = sort(i_rep)
559 sort(i_rep) = ii
560 END IF
561 END IF
562 END DO
563 END IF
564 END DO
565 END IF
566 END DO
567
568 DEALLOCATE (cpl_tmp, rep_int)
569
570 END SUBROUTINE resort_evects
571
572END 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:77
cp_dbcsr_operations::dbcsr_deallocate_matrix_set
Definition cp_dbcsr_operations.F:85
cp_fm_types::cp_fm_release
Definition cp_fm_types.F:89
cp_fm_types::cp_fm_to_fm
Definition cp_fm_types.F:84
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:356
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:630
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:524
cp_dbcsr_api::dbcsr_copy
subroutine, public dbcsr_copy(matrix_b, matrix_a, name, keep_sparsity, keep_imaginary)
...
Definition cp_dbcsr_api.F:370
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:807
cp_dbcsr_api::dbcsr_release
subroutine, public dbcsr_release(matrix)
...
Definition cp_dbcsr_api.F:1132
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:552
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_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:111
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:770
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:1087
cp_fm_types::cp_fm_create
subroutine, public cp_fm_create(matrix, matrix_struct, name, use_sp, nrow, ncol, set_zero)
creates a new full matrix with the given structure
Definition cp_fm_types.F:169
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:1550
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:556
input_constants
collects all constants needed in input so that they can be used without circular dependencies
Definition input_constants.F:17
input_constants::tddfpt_dipole_berry
integer, parameter, public tddfpt_dipole_berry
Definition input_constants.F:705
input_constants::tddfpt_dipole_velocity
integer, parameter, public tddfpt_dipole_velocity
Definition input_constants.F:705
input_constants::tddfpt_dipole_length
integer, parameter, public tddfpt_dipole_length
Definition input_constants.F:705
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:23
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, 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, rho, rho_xc, pw_env, ewald_env, ewald_pw, active_space, mpools, input, para_env, blacs_env, scf_control, rel_control, kinetic, qs_charges, vppl, rho_core, rho_nlcc, rho_nlcc_g, ks_env, ks_qmmm_env, wf_history, scf_env, local_particles, local_molecules, distribution_2d, dbcsr_dist, molecule_kind_set, molecule_set, subsys, cp_subsys, oce, local_rho_set, rho_atom_set, task_list, task_list_soft, rho0_atom_set, rho0_mpole, rhoz_set, 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:526
qs_ks_types
Definition qs_ks_types.F:15
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::p_xyz_ao
subroutine, public p_xyz_ao(op, qs_env, minimum_image)
Calculation of the components of the dipole operator in the velocity form The elements of the sparse ...
Definition qs_operators_ao.F:818
qs_operators_ao::rrc_xyz_ao
subroutine, public rrc_xyz_ao(op, qs_env, rc, order, minimum_image, soft)
Calculation of the components of the dipole operator in the length form by taking the relative positi...
Definition qs_operators_ao.F:1084
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)
Calculation of the overlap matrix over Cartesian Gaussian functions.
Definition qs_overlap.F:120
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:516
qs_tddfpt2_soc_utils::soc_contract_evect
subroutine, public soc_contract_evect(fm_start, fm_res)
...
Definition qs_tddfpt2_soc_utils.F:450
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:348
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:69
cp_control_types::tddfpt2_control_type
Definition cp_control_types.F:507
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:115
message_passing::mp_para_env_type
stores all the informations relevant to an mpi environment
Definition message_passing.F:721
qs_environment_types::qs_environment_type
Definition qs_environment_types.F:220
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