Line data Source code
1 : !--------------------------------------------------------------------------------------------------!
2 : ! CP2K: A general program to perform molecular dynamics simulations !
3 : ! Copyright 2000-2025 CP2K developers group <https://cp2k.org> !
4 : ! !
5 : ! SPDX-License-Identifier: GPL-2.0-or-later !
6 : !--------------------------------------------------------------------------------------------------!
7 :
8 : ! **************************************************************************************************
9 : !> \brief Methods for Resonant Inelastic XRAY Scattering (RIXS) calculations
10 : !> \author BSG (02.2025)
11 : ! **************************************************************************************************
12 : MODULE rixs_methods
13 : USE bibliography, ONLY: VazdaCruz2021,&
14 : cite_reference
15 : USE cp_blacs_env, ONLY: cp_blacs_env_type
16 : USE cp_control_types, ONLY: dft_control_type,&
17 : rixs_control_create,&
18 : rixs_control_release,&
19 : rixs_control_type
20 : USE cp_control_utils, ONLY: read_rixs_control
21 : USE cp_dbcsr_api, ONLY: dbcsr_p_type,&
22 : dbcsr_type
23 : USE cp_dbcsr_operations, ONLY: cp_dbcsr_sm_fm_multiply
24 : USE cp_fm_struct, ONLY: cp_fm_struct_create,&
25 : cp_fm_struct_release,&
26 : cp_fm_struct_type
27 : USE cp_fm_types, ONLY: cp_fm_create,&
28 : cp_fm_get_info,&
29 : cp_fm_get_submatrix,&
30 : cp_fm_release,&
31 : cp_fm_to_fm,&
32 : cp_fm_to_fm_submat,&
33 : cp_fm_type
34 : USE cp_log_handling, ONLY: cp_get_default_logger,&
35 : cp_logger_get_default_io_unit,&
36 : cp_logger_type
37 : USE cp_output_handling, ONLY: cp_print_key_finished_output,&
38 : cp_print_key_unit_nr
39 : USE header, ONLY: rixs_header
40 : USE input_section_types, ONLY: section_vals_get_subs_vals,&
41 : section_vals_type
42 : USE kinds, ONLY: dp
43 : USE message_passing, ONLY: mp_para_env_type
44 : USE parallel_gemm_api, ONLY: parallel_gemm
45 : USE physcon, ONLY: evolt
46 : USE qs_environment_types, ONLY: get_qs_env,&
47 : qs_environment_type
48 : USE qs_tddfpt2_methods, ONLY: tddfpt
49 : USE rixs_types, ONLY: rixs_env_create,&
50 : rixs_env_release,&
51 : rixs_env_type,&
52 : tddfpt2_valence_type
53 : USE xas_tdp_methods, ONLY: xas_tdp
54 : USE xas_tdp_types, ONLY: donor_state_type,&
55 : xas_tdp_env_type
56 : #include "./base/base_uses.f90"
57 :
58 : IMPLICIT NONE
59 : PRIVATE
60 :
61 : CHARACTER(len=*), PARAMETER, PRIVATE :: moduleN = 'rixs_methods'
62 :
63 : PUBLIC :: rixs, rixs_core
64 :
65 : CONTAINS
66 :
67 : ! **************************************************************************************************
68 : !> \brief Driver for RIXS calculations.
69 : !> \param qs_env the inherited qs_environment
70 : !> \author BSG
71 : ! **************************************************************************************************
72 :
73 14 : SUBROUTINE rixs(qs_env)
74 :
75 : TYPE(qs_environment_type), POINTER :: qs_env
76 :
77 : CHARACTER(len=*), PARAMETER :: routineN = 'rixs'
78 :
79 : INTEGER :: handle, output_unit
80 : TYPE(dft_control_type), POINTER :: dft_control
81 : TYPE(section_vals_type), POINTER :: rixs_section, tddfp2_section, &
82 : xas_tdp_section
83 :
84 14 : CALL timeset(routineN, handle)
85 :
86 14 : NULLIFY (rixs_section)
87 14 : rixs_section => section_vals_get_subs_vals(qs_env%input, "PROPERTIES%RIXS")
88 14 : output_unit = cp_logger_get_default_io_unit()
89 :
90 14 : qs_env%do_rixs = .TRUE.
91 :
92 14 : CALL cite_reference(VazdaCruz2021)
93 :
94 14 : CALL get_qs_env(qs_env, dft_control=dft_control)
95 :
96 14 : xas_tdp_section => section_vals_get_subs_vals(rixs_section, "XAS_TDP")
97 14 : tddfp2_section => section_vals_get_subs_vals(rixs_section, "TDDFPT")
98 :
99 14 : CALL rixs_core(rixs_section, qs_env)
100 :
101 14 : IF (output_unit > 0) THEN
102 : WRITE (UNIT=output_unit, FMT="(/,(T2,A79))") &
103 7 : "*******************************************************************************", &
104 7 : "! Normal termination of Resonant Inelastic X-RAY Scattering calculation !", &
105 14 : "*******************************************************************************"
106 : END IF
107 :
108 14 : CALL timestop(handle)
109 :
110 14 : END SUBROUTINE rixs
111 :
112 : ! **************************************************************************************************
113 : !> \brief Perform RIXS calculation.
114 : !> \param rixs_section ...
115 : !> \param qs_env ...
116 : ! **************************************************************************************************
117 14 : SUBROUTINE rixs_core(rixs_section, qs_env)
118 :
119 : TYPE(section_vals_type), POINTER :: rixs_section
120 : TYPE(qs_environment_type), POINTER :: qs_env
121 :
122 : CHARACTER(len=*), PARAMETER :: routineN = 'rixs_core'
123 :
124 : INTEGER :: ax, current_state_index, fstate, handle, iatom, ispin, istate, nao, nex_atoms, &
125 : nocc_max, nspins, nstates, nvirt, output_unit, td_state
126 14 : INTEGER, ALLOCATABLE, DIMENSION(:) :: nocc
127 : LOGICAL :: do_sc, do_sg, roks, uks
128 : REAL(dp) :: mu_xyz
129 14 : REAL(dp), ALLOCATABLE, DIMENSION(:) :: w_i0, w_if
130 14 : REAL(dp), ALLOCATABLE, DIMENSION(:, :) :: dip_block, mu_i0
131 14 : REAL(dp), ALLOCATABLE, DIMENSION(:, :, :) :: mu_if
132 : TYPE(cp_blacs_env_type), POINTER :: blacs_env
133 : TYPE(cp_fm_struct_type), POINTER :: core_evect_struct, dip_0_struct, &
134 : dip_f_struct, gs_coeff_struct, &
135 : i_dip_0_struct, i_dip_f_struct
136 : TYPE(cp_fm_type) :: dip_0
137 14 : TYPE(cp_fm_type), ALLOCATABLE, DIMENSION(:) :: core_evects, dip_f, i_dip_0, i_dip_f, &
138 14 : state_gs_coeffs
139 14 : TYPE(cp_fm_type), DIMENSION(:), POINTER :: local_gs_coeffs, mo_coeffs
140 14 : TYPE(cp_fm_type), DIMENSION(:, :), POINTER :: valence_evects
141 : TYPE(cp_fm_type), POINTER :: target_ex_coeffs
142 14 : TYPE(dbcsr_p_type), DIMENSION(:), POINTER :: dipmat, matrix_s
143 : TYPE(dft_control_type), POINTER :: dft_control
144 : TYPE(donor_state_type), POINTER :: current_state
145 : TYPE(mp_para_env_type), POINTER :: para_env
146 : TYPE(rixs_control_type), POINTER :: rixs_control
147 : TYPE(rixs_env_type), POINTER :: rixs_env
148 : TYPE(tddfpt2_valence_type), POINTER :: valence_state
149 : TYPE(xas_tdp_env_type), POINTER :: core_state
150 :
151 14 : NULLIFY (rixs_control, dft_control, rixs_env)
152 14 : NULLIFY (valence_state, core_state)
153 14 : NULLIFY (para_env, blacs_env)
154 14 : NULLIFY (local_gs_coeffs, mo_coeffs, valence_evects)
155 14 : NULLIFY (dipmat, dip_0_struct, i_dip_0_struct, dip_f_struct, i_dip_f_struct, &
156 14 : core_evect_struct, gs_coeff_struct)
157 :
158 28 : output_unit = cp_logger_get_default_io_unit()
159 :
160 : CALL get_qs_env(qs_env, &
161 : dft_control=dft_control, &
162 : matrix_s=matrix_s, &
163 : para_env=para_env, &
164 14 : blacs_env=blacs_env)
165 14 : CALL rixs_control_create(rixs_control)
166 14 : CALL read_rixs_control(rixs_control, rixs_section, dft_control%qs_control)
167 :
168 : ! create rixs_env
169 14 : CALL rixs_env_create(rixs_env)
170 :
171 : ! first, xas_tdp calculation
172 14 : CALL xas_tdp(qs_env, rixs_env)
173 :
174 14 : do_sg = rixs_control%xas_tdp_control%do_singlet
175 14 : do_sc = rixs_control%xas_tdp_control%do_spin_cons
176 :
177 14 : IF (rixs_control%xas_tdp_control%check_only) THEN
178 0 : CPWARN("CHECK_ONLY run for XAS_TDP requested, RIXS and TDDFPT will not be performed.")
179 : ELSE
180 :
181 : ! then, tddfpt calculation
182 14 : CALL tddfpt(qs_env, calc_forces=.FALSE., rixs_env=rixs_env)
183 :
184 14 : IF (output_unit > 0) THEN
185 7 : CALL rixs_header(output_unit)
186 : END IF
187 :
188 : ! timings for rixs only, excluding xas_tdp and tddft calls
189 14 : CALL timeset(routineN, handle)
190 :
191 14 : IF (do_sg) THEN ! singlet
192 : nspins = 1
193 4 : ELSE IF (do_sc) THEN ! spin-conserving
194 : nspins = 2
195 : ELSE
196 0 : CPABORT("RIXS only implemented for singlet and spin-conserving excitations")
197 : END IF
198 :
199 14 : IF (output_unit > 0) THEN
200 7 : IF (dft_control%uks) THEN
201 1 : uks = .TRUE.
202 1 : WRITE (UNIT=output_unit, FMT="(T2,A)") "RIXS| Unrestricted Open-Shell Kohn-Sham"
203 6 : ELSE IF (dft_control%roks) THEN
204 1 : roks = .TRUE.
205 1 : WRITE (UNIT=output_unit, FMT="(T2,A)") "RIXS| Restricted Open-Shell Kohn-Sham"
206 : END IF
207 : END IF
208 :
209 14 : core_state => rixs_env%core_state
210 14 : valence_state => rixs_env%valence_state
211 :
212 : ! gs coefficients from tddfpt
213 14 : mo_coeffs => valence_state%mos_occ
214 : ! localised gs coefficients from xas_tdp
215 14 : local_gs_coeffs => core_state%mo_coeff
216 14 : valence_evects => valence_state%evects
217 :
218 14 : IF (rixs_control%xas_tdp_control%do_loc) THEN
219 2 : IF (output_unit > 0) THEN
220 : WRITE (UNIT=output_unit, FMT="(T2,A)") &
221 1 : "RIXS| Found localised XAS_TDP orbitals"
222 : WRITE (UNIT=output_unit, FMT="(T2,A)") &
223 1 : "RIXS| Rotating TDDFPT vectors..."
224 : END IF
225 2 : CALL rotate_vectors(valence_state%evects, local_gs_coeffs, mo_coeffs, matrix_s(1)%matrix, output_unit)
226 : END IF
227 :
228 : ! find max nocc for open-shell cases
229 28 : ALLOCATE (nocc(nspins))
230 32 : DO ispin = 1, nspins
231 32 : CALL cp_fm_get_info(matrix=valence_state%mos_occ(ispin), nrow_global=nao, ncol_global=nocc(ispin))
232 : END DO
233 32 : nocc_max = MAXVAL(nocc)
234 :
235 14 : nex_atoms = core_state%nex_atoms
236 14 : nstates = valence_state%nstates
237 14 : dipmat => core_state%dipmat
238 :
239 78 : ALLOCATE (core_evects(nspins), state_gs_coeffs(nspins))
240 14 : nvirt = core_state%nvirt
241 154 : ALLOCATE (dip_block(1, nspins), mu_i0(4, nvirt), mu_if(4, nvirt, nstates), w_i0(nvirt), w_if(nstates))
242 984 : mu_i0 = 0.0_dp
243 3322 : mu_if = 0.0_dp
244 62 : w_if(:) = valence_state%evals(:)*evolt
245 46 : ALLOCATE (i_dip_0(nspins))
246 78 : ALLOCATE (dip_f(nspins), i_dip_f(nspins))
247 :
248 : CALL cp_fm_struct_create(core_evect_struct, para_env=para_env, context=blacs_env, &
249 14 : nrow_global=nao, ncol_global=nvirt)
250 : CALL cp_fm_struct_create(gs_coeff_struct, para_env=para_env, context=blacs_env, &
251 14 : nrow_global=nao, ncol_global=1)
252 :
253 : ! looping over ex_atoms and ex_kinds is enough as excited atoms have to be unique
254 14 : current_state_index = 1
255 30 : DO iatom = 1, nex_atoms
256 16 : current_state => core_state%donor_states(current_state_index)
257 16 : IF (output_unit > 0) THEN
258 : WRITE (UNIT=output_unit, FMT="(T2,A,A,A,A,A,I5)") &
259 8 : "RIXS| Calculating dipole moment from core-excited state ", &
260 8 : core_state%state_type_char(current_state%state_type), " of ", TRIM(current_state%at_symbol), &
261 16 : " with index ", current_state%kind_index
262 : END IF
263 :
264 16 : IF (do_sg) THEN ! singlet
265 12 : target_ex_coeffs => current_state%sg_coeffs
266 180 : w_i0(:) = current_state%sg_evals(:)*evolt
267 4 : ELSE IF (do_sc) THEN ! spin-conserving
268 4 : target_ex_coeffs => current_state%sc_coeffs
269 52 : w_i0(:) = current_state%sc_evals(:)*evolt
270 : END IF
271 :
272 : ! reshape sc and sg coeffs (separate spins to columns)
273 36 : DO ispin = 1, nspins
274 20 : CALL cp_fm_create(core_evects(ispin), core_evect_struct)
275 : CALL cp_fm_to_fm_submat(msource=target_ex_coeffs, mtarget=core_evects(ispin), s_firstrow=1, &
276 36 : s_firstcol=(nvirt*(ispin - 1) + 1), t_firstrow=1, t_firstcol=1, nrow=nao, ncol=nvirt)
277 : END DO
278 36 : DO ispin = 1, nspins
279 20 : CALL cp_fm_create(state_gs_coeffs(ispin), gs_coeff_struct)
280 16 : IF (roks) THEN
281 : ! store same coeffs for both spins, easier later on
282 : CALL cp_fm_to_fm_submat(msource=current_state%gs_coeffs, mtarget=state_gs_coeffs(ispin), s_firstrow=1, &
283 20 : s_firstcol=1, t_firstrow=1, t_firstcol=1, nrow=nao, ncol=1)
284 : ELSE
285 : CALL cp_fm_to_fm_submat(msource=current_state%gs_coeffs, mtarget=state_gs_coeffs(ispin), s_firstrow=1, &
286 : s_firstcol=ispin, t_firstrow=1, t_firstcol=1, nrow=nao, ncol=1)
287 : END IF
288 : END DO
289 :
290 : ! initialise matrices for i->0
291 : CALL cp_fm_struct_create(dip_0_struct, para_env=para_env, context=blacs_env, &
292 16 : nrow_global=nao, ncol_global=1)
293 16 : CALL cp_fm_create(dip_0, dip_0_struct)
294 : CALL cp_fm_struct_create(i_dip_0_struct, para_env=para_env, context=blacs_env, &
295 16 : nrow_global=nvirt, ncol_global=1)
296 36 : DO ispin = 1, nspins
297 36 : CALL cp_fm_create(i_dip_0(ispin), i_dip_0_struct)
298 : END DO
299 :
300 : ! initialise matrices for i->f
301 36 : DO ispin = 1, nspins
302 : CALL cp_fm_struct_create(dip_f_struct, para_env=para_env, context=blacs_env, &
303 20 : nrow_global=nao, ncol_global=nocc(ispin))
304 : CALL cp_fm_struct_create(i_dip_f_struct, para_env=para_env, context=blacs_env, &
305 20 : nrow_global=nvirt, ncol_global=nocc(ispin))
306 20 : CALL cp_fm_create(dip_f(ispin), dip_f_struct)
307 20 : CALL cp_fm_create(i_dip_f(ispin), i_dip_f_struct)
308 20 : CALL cp_fm_struct_release(i_dip_f_struct)
309 36 : CALL cp_fm_struct_release(dip_f_struct)
310 : END DO
311 :
312 : ! 0 -> i
313 64 : DO ax = 1, 3
314 :
315 : ! i*R*0
316 108 : DO ispin = 1, nspins
317 60 : CALL cp_dbcsr_sm_fm_multiply(dipmat(ax)%matrix, state_gs_coeffs(ispin), dip_0, ncol=1)
318 108 : CALL parallel_gemm('T', 'N', nvirt, 1, nao, 1.0_dp, core_evects(ispin), dip_0, 0.0_dp, i_dip_0(ispin))
319 : END DO
320 :
321 712 : DO istate = 1, nvirt
322 2232 : dip_block = 0.0_dp
323 1440 : DO ispin = 1, nspins
324 : CALL cp_fm_get_submatrix(fm=i_dip_0(ispin), target_m=dip_block, start_row=istate, &
325 792 : start_col=1, n_rows=1, n_cols=1)
326 1440 : mu_i0(ax, istate) = dip_block(1, 1)
327 : END DO ! ispin
328 648 : mu_xyz = mu_i0(ax, istate)
329 696 : mu_i0(4, istate) = mu_i0(4, istate) + mu_xyz
330 : END DO ! istate
331 :
332 : END DO ! ax
333 :
334 : ! i -> f
335 70 : DO td_state = 1, nstates
336 :
337 54 : IF (output_unit > 0) THEN
338 : WRITE (UNIT=output_unit, FMT="(T9,A,I3,A,F10.4)") &
339 27 : "to valence-excited state ", td_state, " with energy ", w_if(td_state)
340 : END IF
341 :
342 232 : DO ax = 1, 3
343 :
344 : ! core_evects x dipmat x valence_evects (per spin)
345 384 : DO ispin = 1, nspins
346 : CALL cp_dbcsr_sm_fm_multiply(dipmat(ax)%matrix, valence_evects(ispin, td_state), dip_f(ispin), &
347 222 : ncol=nocc(ispin))
348 : CALL parallel_gemm('T', 'N', nvirt, nocc(ispin), nao, 1.0_dp, core_evects(ispin), &
349 384 : dip_f(ispin), 0.0_dp, i_dip_f(ispin))
350 : END DO
351 :
352 2370 : DO istate = 1, nvirt
353 12252 : DO fstate = 1, nocc_max
354 37494 : dip_block = 0.0_dp
355 25950 : DO ispin = 1, nspins
356 23796 : IF (fstate <= nocc(ispin)) THEN
357 : CALL cp_fm_get_submatrix(fm=i_dip_f(ispin), target_m=dip_block, start_row=istate, &
358 12978 : start_col=fstate, n_rows=1, n_cols=1)
359 12978 : mu_if(ax, istate, td_state) = mu_if(ax, istate, td_state) + dip_block(1, 1)
360 : END IF
361 : END DO ! ispin
362 : END DO ! fstate (tddft)
363 2154 : mu_xyz = mu_if(ax, istate, td_state)
364 2316 : mu_if(4, istate, td_state) = mu_if(4, istate, td_state) + mu_xyz
365 : END DO ! istate (core)
366 :
367 : END DO ! ax
368 :
369 : END DO ! td_state
370 :
371 16 : IF (output_unit > 0) THEN
372 8 : WRITE (UNIT=output_unit, FMT="(/,T2,A,/)") "RIXS| Printing spectrum to file"
373 : END IF
374 16 : CALL print_rixs_to_file(current_state, mu_i0, mu_if, w_i0, w_if, rixs_env, rixs_section)
375 :
376 16 : current_state_index = current_state_index + 1
377 :
378 : ! cleanup
379 36 : DO ispin = 1, nspins
380 20 : CALL cp_fm_release(core_evects(ispin))
381 20 : CALL cp_fm_release(state_gs_coeffs(ispin))
382 20 : CALL cp_fm_release(i_dip_0(ispin))
383 20 : CALL cp_fm_release(i_dip_f(ispin))
384 36 : CALL cp_fm_release(dip_f(ispin))
385 : END DO
386 16 : CALL cp_fm_struct_release(i_dip_0_struct)
387 16 : CALL cp_fm_struct_release(dip_0_struct)
388 46 : CALL cp_fm_release(dip_0)
389 :
390 : END DO ! iatom
391 :
392 : NULLIFY (current_state)
393 :
394 : ! cleanup
395 14 : CALL cp_fm_struct_release(core_evect_struct)
396 28 : CALL cp_fm_struct_release(gs_coeff_struct)
397 :
398 : END IF
399 :
400 : ! more cleanup
401 14 : CALL rixs_control_release(rixs_control)
402 14 : CALL rixs_env_release(rixs_env)
403 14 : NULLIFY (valence_state, core_state)
404 :
405 14 : CALL timestop(handle)
406 :
407 28 : END SUBROUTINE rixs_core
408 :
409 : ! **************************************************************************************************
410 : !> \brief Rotate vectors. Returns rotated mo_occ and evects.
411 : !> \param evects ...
412 : !> \param mo_ref ...
413 : !> \param mo_occ ...
414 : !> \param overlap_matrix ...
415 : !> \param unit_nr ...
416 : ! **************************************************************************************************
417 :
418 2 : SUBROUTINE rotate_vectors(evects, mo_ref, mo_occ, overlap_matrix, unit_nr)
419 : TYPE(cp_fm_type), DIMENSION(:, :) :: evects
420 : TYPE(cp_fm_type), DIMENSION(:) :: mo_ref, mo_occ
421 : TYPE(dbcsr_type), POINTER :: overlap_matrix
422 : INTEGER :: unit_nr
423 :
424 : INTEGER :: ispin, istate, nactive, ncol, nrow, &
425 : nspins, nstates
426 : REAL(kind=dp) :: diff
427 : TYPE(cp_blacs_env_type), POINTER :: blacs_env
428 : TYPE(cp_fm_struct_type), POINTER :: emat_struct
429 : TYPE(cp_fm_type) :: emat, rotated_mo_coeffs, smo
430 : TYPE(cp_fm_type), POINTER :: current_evect
431 : TYPE(mp_para_env_type), POINTER :: para_env
432 :
433 2 : NULLIFY (emat_struct, para_env, blacs_env, current_evect)
434 :
435 2 : nspins = SIZE(evects, DIM=1)
436 4 : DO ispin = 1, nspins
437 :
438 : CALL cp_fm_get_info(matrix=mo_occ(ispin), nrow_global=nrow, ncol_global=ncol, &
439 2 : para_env=para_env, context=blacs_env)
440 2 : CALL cp_fm_create(smo, mo_occ(ispin)%matrix_struct)
441 :
442 : ! rotate mo_occ
443 : ! smo = matrix_s x mo_occ
444 2 : CALL cp_dbcsr_sm_fm_multiply(overlap_matrix, mo_occ(ispin), smo, ncol, alpha=1.0_dp, beta=0.0_dp)
445 : CALL cp_fm_struct_create(emat_struct, nrow_global=ncol, ncol_global=ncol, &
446 2 : para_env=para_env, context=blacs_env)
447 2 : CALL cp_fm_create(emat, emat_struct)
448 : ! emat = mo_ref^T x smo
449 2 : CALL parallel_gemm('T', 'N', ncol, ncol, nrow, 1.0_dp, mo_ref(ispin), smo, 0.0_dp, emat)
450 2 : CALL cp_fm_create(rotated_mo_coeffs, mo_occ(ispin)%matrix_struct)
451 : ! rotated_mo_coeffs = cpmos x emat
452 2 : CALL parallel_gemm('N', 'N', nrow, ncol, ncol, 1.0_dp, mo_occ(ispin), emat, 0.0_dp, rotated_mo_coeffs)
453 :
454 77 : diff = MAXVAL(ABS(rotated_mo_coeffs%local_data - mo_occ(ispin)%local_data))
455 2 : IF (unit_nr > 0) THEN
456 1 : WRITE (unit_nr, FMT="(T9,A,I2,A,F10.6,/)") "For spin ", ispin, ": Max difference between orbitals = ", diff
457 : END IF
458 :
459 2 : CALL cp_fm_to_fm(rotated_mo_coeffs, mo_occ(ispin))
460 :
461 : ! rotation of transition vectors
462 2 : CALL cp_fm_get_info(matrix=evects(ispin, 1), ncol_global=nactive)
463 2 : IF (nactive /= ncol) THEN
464 0 : CALL cp_warn(__LOCATION__, "RIXS with reduced occupied state TDDFPT not possible")
465 0 : CPABORT("rotate_vectors in rixs_method")
466 : END IF
467 :
468 2 : nstates = SIZE(evects, DIM=2)
469 8 : DO istate = 1, nstates
470 2 : ASSOCIATE (current_evect => evects(ispin, istate))
471 6 : CALL parallel_gemm('N', 'N', nrow, ncol, ncol, 1.0_dp, current_evect, emat, 0.0_dp, smo)
472 6 : CALL cp_fm_to_fm(smo, current_evect)
473 : END ASSOCIATE
474 : END DO
475 :
476 2 : CALL cp_fm_struct_release(emat_struct)
477 2 : CALL cp_fm_release(smo)
478 2 : CALL cp_fm_release(emat)
479 12 : CALL cp_fm_release(rotated_mo_coeffs)
480 :
481 : END DO ! ispin
482 :
483 2 : END SUBROUTINE rotate_vectors
484 :
485 : !**************************************************************************************************
486 : !> \brief Print RIXS spectrum.
487 : !> \param donor_state ...
488 : !> \param mu_i0 ...
489 : !> \param mu_if ...
490 : !> \param w_i0 ...
491 : !> \param w_if ...
492 : !> \param rixs_env ...
493 : !> \param rixs_section ...
494 : ! **************************************************************************************************
495 16 : SUBROUTINE print_rixs_to_file(donor_state, mu_i0, mu_if, w_i0, w_if, &
496 : rixs_env, rixs_section)
497 :
498 : TYPE(donor_state_type), POINTER :: donor_state
499 : REAL(dp), DIMENSION(:, :) :: mu_i0
500 : REAL(dp), DIMENSION(:, :, :) :: mu_if
501 : REAL(dp), DIMENSION(:) :: w_i0, w_if
502 : TYPE(rixs_env_type), POINTER :: rixs_env
503 : TYPE(section_vals_type), POINTER :: rixs_section
504 :
505 : INTEGER :: f, i, output_unit, rixs_unit
506 : TYPE(cp_logger_type), POINTER :: logger
507 :
508 16 : NULLIFY (logger)
509 16 : logger => cp_get_default_logger()
510 :
511 : rixs_unit = cp_print_key_unit_nr(logger, rixs_section, "PRINT%SPECTRUM", &
512 : extension=".rixs", file_position="APPEND", &
513 16 : file_action="WRITE", file_form="FORMATTED")
514 :
515 16 : output_unit = cp_logger_get_default_io_unit()
516 :
517 16 : IF (rixs_unit > 0) THEN
518 :
519 : WRITE (rixs_unit, FMT="(A,/,T2,A,A,A,A,A,I5,A/,A)") &
520 8 : "====================================================================================", &
521 8 : "Excitation from ground-state (", &
522 8 : rixs_env%core_state%state_type_char(donor_state%state_type), " of kind ", &
523 8 : TRIM(donor_state%at_symbol), " with index ", donor_state%kind_index, &
524 8 : ") to core-excited state i ", &
525 16 : "===================================================================================="
526 :
527 : WRITE (rixs_unit, FMT="(T3,A)") &
528 8 : "w_0i (eV) mu^x_0i (a.u.) mu^y_0i (a.u.) mu^z_0i (a.u.) mu^2_0i (a.u.)"
529 116 : DO i = 1, SIZE(mu_i0, DIM=2)
530 : WRITE (rixs_unit, FMT="(T2,F10.4,T26,E12.5,T42,E12.5,T58,E12.5,T74,E12.5)") &
531 116 : w_i0(i), mu_i0(1, i), mu_i0(2, i), mu_i0(3, i), mu_i0(4, i)
532 : END DO
533 :
534 : WRITE (rixs_unit, FMT="(A,/,T2,A,/,A)") &
535 8 : "====================================================================================", &
536 8 : "Emission from core-excited state i to valence-excited state f ", &
537 16 : "===================================================================================="
538 :
539 : WRITE (rixs_unit, FMT="(T3,A)") &
540 8 : "w_0i (eV) w_if (eV) mu^x_if (a.u.) mu^y_if (a.u.) mu^z_if (a.u.) mu^2_if (a.u.)"
541 :
542 116 : DO i = 1, SIZE(mu_if, DIM=2)
543 475 : DO f = 1, SIZE(mu_if, DIM=3)
544 : WRITE (rixs_unit, FMT="(T2,F10.4,T14,F8.4,T26,E12.5,T42,E12.5,T58,E12.5,T74,E12.5)") &
545 467 : w_i0(i), w_if(f), mu_if(1, i, f), mu_if(2, i, f), mu_if(3, i, f), mu_if(4, i, f)
546 : END DO
547 : END DO
548 :
549 : END IF
550 :
551 16 : CALL cp_print_key_finished_output(rixs_unit, logger, rixs_section, "PRINT%SPECTRUM")
552 :
553 16 : END SUBROUTINE print_rixs_to_file
554 :
555 : END MODULE rixs_methods
|
