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