Line data Source code
1 : !--------------------------------------------------------------------------------------------------!
2 : ! CP2K: A general program to perform molecular dynamics simulations !
3 : ! Copyright 2000-2024 CP2K developers group <https://cp2k.org> !
4 : ! !
5 : ! SPDX-License-Identifier: GPL-2.0-or-later !
6 : !--------------------------------------------------------------------------------------------------!
7 :
8 : ! **************************************************************************************************
9 : !> \brief Routines for printing information in context of the BSE calculation
10 : !> \par History
11 : !> 10.2024 created [Maximilian Graml]
12 : ! **************************************************************************************************
13 : MODULE bse_print
14 :
15 : USE atomic_kind_types, ONLY: get_atomic_kind
16 : USE bse_properties, ONLY: compute_absorption_spectrum,&
17 : exciton_descr_type
18 : USE bse_util, ONLY: filter_eigvec_contrib
19 : USE cp_fm_types, ONLY: cp_fm_get_info,&
20 : cp_fm_type
21 : USE kinds, ONLY: dp
22 : USE mp2_types, ONLY: mp2_type
23 : USE particle_types, ONLY: particle_type
24 : USE physcon, ONLY: angstrom,&
25 : evolt
26 : USE qs_environment_types, ONLY: get_qs_env,&
27 : qs_environment_type
28 : #include "./base/base_uses.f90"
29 :
30 : IMPLICIT NONE
31 :
32 : PRIVATE
33 :
34 : CHARACTER(len=*), PARAMETER, PRIVATE :: moduleN = 'bse_print'
35 :
36 : PUBLIC :: print_BSE_start_flag, fm_write_thresh, print_excitation_energies, &
37 : print_output_header, print_transition_amplitudes, print_optical_properties, &
38 : print_exciton_descriptors
39 :
40 : CONTAINS
41 :
42 : ! **************************************************************************************************
43 : !> \brief ...
44 : !> \param bse_tda ...
45 : !> \param bse_abba ...
46 : !> \param unit_nr ...
47 : ! **************************************************************************************************
48 32 : SUBROUTINE print_BSE_start_flag(bse_tda, bse_abba, unit_nr)
49 :
50 : LOGICAL, INTENT(IN) :: bse_tda, bse_abba
51 : INTEGER, INTENT(IN) :: unit_nr
52 :
53 : CHARACTER(LEN=*), PARAMETER :: routineN = 'print_BSE_start_flag'
54 :
55 : INTEGER :: handle
56 :
57 32 : CALL timeset(routineN, handle)
58 :
59 32 : IF (unit_nr > 0) THEN
60 16 : WRITE (unit_nr, *) ' '
61 16 : WRITE (unit_nr, '(T2,A79)') '*******************************************************************************'
62 16 : WRITE (unit_nr, '(T2,A79)') '** **'
63 16 : WRITE (unit_nr, '(T2,A79)') '** Bethe Salpeter equation (BSE) for excitation energies **'
64 16 : IF (bse_tda .AND. bse_abba) THEN
65 0 : WRITE (unit_nr, '(T2,A79)') '** solved with and without Tamm-Dancoff approximation (TDA) **'
66 16 : ELSE IF (bse_tda) THEN
67 8 : WRITE (unit_nr, '(T2,A79)') '** solved with Tamm-Dancoff approximation (TDA) **'
68 : ELSE
69 8 : WRITE (unit_nr, '(T2,A79)') '** solved without Tamm-Dancoff approximation (TDA) **'
70 : END IF
71 :
72 16 : WRITE (unit_nr, '(T2,A79)') '** **'
73 16 : WRITE (unit_nr, '(T2,A79)') '*******************************************************************************'
74 16 : WRITE (unit_nr, *) ' '
75 : END IF
76 :
77 32 : CALL timestop(handle)
78 :
79 32 : END SUBROUTINE
80 :
81 : ! **************************************************************************************************
82 : !> \brief ...
83 : !> \param homo ...
84 : !> \param virtual ...
85 : !> \param homo_irred ...
86 : !> \param flag_TDA ...
87 : !> \param multiplet ...
88 : !> \param alpha ...
89 : !> \param unit_nr ...
90 : ! **************************************************************************************************
91 32 : SUBROUTINE print_output_header(homo, virtual, homo_irred, flag_TDA, &
92 : multiplet, alpha, unit_nr)
93 :
94 : INTEGER, INTENT(IN) :: homo, virtual, homo_irred
95 : LOGICAL, INTENT(IN) :: flag_TDA
96 : CHARACTER(LEN=10), INTENT(IN) :: multiplet
97 : REAL(KIND=dp), INTENT(IN) :: alpha
98 : INTEGER, INTENT(IN) :: unit_nr
99 :
100 : CHARACTER(LEN=*), PARAMETER :: routineN = 'print_output_header'
101 :
102 : INTEGER :: handle
103 :
104 32 : CALL timeset(routineN, handle)
105 :
106 32 : IF (unit_nr > 0) THEN
107 16 : WRITE (unit_nr, '(T2,A4)') 'BSE|'
108 16 : WRITE (unit_nr, '(T2,A4)') 'BSE|'
109 16 : IF (flag_TDA) THEN
110 8 : WRITE (unit_nr, '(T2,A4,T7,A74)') 'BSE|', '**************************************************************************'
111 8 : WRITE (unit_nr, '(T2,A4,T7,A74)') 'BSE|', '* Bethe Salpeter equation (BSE) with Tamm Dancoff approximation (TDA) *'
112 8 : WRITE (unit_nr, '(T2,A4,T7,A74)') 'BSE|', '**************************************************************************'
113 8 : WRITE (unit_nr, '(T2,A4)') 'BSE|'
114 8 : WRITE (unit_nr, '(T2,A4,T7,A48,A23)') 'BSE|', 'The excitations are calculated by diagonalizing ', &
115 16 : 'the BSE within the TDA:'
116 8 : WRITE (unit_nr, '(T2,A4)') 'BSE|'
117 8 : WRITE (unit_nr, '(T2,A4,T29,A16)') 'BSE|', 'A X^n = Ω^n X^n'
118 8 : WRITE (unit_nr, '(T2,A4)') 'BSE|'
119 8 : WRITE (unit_nr, '(T2,A4,T7,A23)') 'BSE|', 'i.e. in index notation:'
120 8 : WRITE (unit_nr, '(T2,A4)') 'BSE|'
121 8 : WRITE (unit_nr, '(T2,A4,T7,A41)') 'BSE|', 'sum_jb ( A_ia,jb X_jb^n ) = Ω^n X_ia^n'
122 8 : WRITE (unit_nr, '(T2,A4)') 'BSE|'
123 8 : WRITE (unit_nr, '(T2,A4,T7,A30)') 'BSE|', 'prelim Ref.: Eq. (36) with B=0'
124 8 : WRITE (unit_nr, '(T2,A4,T7,A71)') 'BSE|', 'in PRB 92,045209 (2015); http://dx.doi.org/10.1103/PhysRevB.92.045209 .'
125 : ELSE
126 8 : WRITE (unit_nr, '(T2,A4,T7,A74)') 'BSE|', '**************************************************************************'
127 8 : WRITE (unit_nr, '(T2,A4,T7,A74)') 'BSE|', '* Full ("ABBA") Bethe Salpeter equation (BSE) (i.e. without TDA) *'
128 8 : WRITE (unit_nr, '(T2,A4,T7,A74)') 'BSE|', '**************************************************************************'
129 8 : WRITE (unit_nr, '(T2,A4)') 'BSE|'
130 8 : WRITE (unit_nr, '(T2,A4,T7,A48,A24)') 'BSE|', 'The excitations are calculated by diagonalizing ', &
131 16 : 'the BSE without the TDA:'
132 8 : WRITE (unit_nr, '(T2,A4)') 'BSE|'
133 8 : WRITE (unit_nr, '(T2,A4,T22,A30)') 'BSE|', '|A B| |X^n| |1 0| |X^n|'
134 8 : WRITE (unit_nr, '(T2,A4,T22,A31)') 'BSE|', '|B A| |Y^n| = Ω^n |0 -1| |Y^n|'
135 8 : WRITE (unit_nr, '(T2,A4)') 'BSE|'
136 8 : WRITE (unit_nr, '(T2,A4,T7,A23)') 'BSE|', 'i.e. in index notation:'
137 8 : WRITE (unit_nr, '(T2,A4)') 'BSE|'
138 8 : WRITE (unit_nr, '(T2,A4,T7,A62)') 'BSE|', ' sum_jb ( A_ia,jb X_jb^n + B_ia,jb Y_jb^n ) = Ω^n X_ia^n'
139 8 : WRITE (unit_nr, '(T2,A4,T7,A62)') 'BSE|', '- sum_jb ( B_ia,jb X_jb^n + A_ia,jb Y_jb^n ) = Ω^n Y_ia^n'
140 : END IF
141 16 : WRITE (unit_nr, '(T2,A4)') 'BSE|'
142 16 : WRITE (unit_nr, '(T2,A4)') 'BSE|'
143 16 : WRITE (unit_nr, '(T2,A4,T7,A4,T18,A42,T70,A1,I4,A1,I4,A1)') 'BSE|', 'i,j:', &
144 32 : 'occupied molecular orbitals, i.e. state in', '[', homo_irred - homo + 1, ',', homo_irred, ']'
145 16 : WRITE (unit_nr, '(T2,A4,T7,A4,T18,A44,T70,A1,I4,A1,I4,A1)') 'BSE|', 'a,b:', &
146 32 : 'unoccupied molecular orbitals, i.e. state in', '[', homo_irred + 1, ',', homo_irred + virtual, ']'
147 16 : WRITE (unit_nr, '(T2,A4,T7,A2,T18,A16)') 'BSE|', 'n:', 'Excitation index'
148 16 : WRITE (unit_nr, '(T2,A4)') 'BSE|'
149 16 : WRITE (unit_nr, '(T2,A4,T7,A58)') 'BSE|', 'A_ia,jb = (ε_a-ε_i) δ_ij δ_ab + α * v_ia,jb - W_ij,ab'
150 16 : IF (.NOT. flag_TDA) THEN
151 8 : WRITE (unit_nr, '(T2,A4,T7,A32)') 'BSE|', 'B_ia,jb = α * v_ia,jb - W_ib,aj'
152 8 : WRITE (unit_nr, '(T2,A4)') 'BSE|'
153 8 : WRITE (unit_nr, '(T2,A4,T7,A35)') 'BSE|', 'prelim Ref.: Eqs. (24-27),(30),(35)'
154 8 : WRITE (unit_nr, '(T2,A4,T7,A71)') 'BSE|', 'in PRB 92,045209 (2015); http://dx.doi.org/10.1103/PhysRevB.92.045209 .'
155 : END IF
156 16 : IF (.NOT. flag_TDA) THEN
157 8 : WRITE (unit_nr, '(T2,A4)') 'BSE|'
158 8 : WRITE (unit_nr, '(T2,A4,T7,A74)') 'BSE|', 'The BSE is solved for Ω^n and X_ia^n as a hermitian problem, e.g. Eq.(42)'
159 8 : WRITE (unit_nr, '(T2,A4,T7,A71)') 'BSE|', 'in PRB 92,045209 (2015); http://dx.doi.org/10.1103/PhysRevB.92.045209 .'
160 : END IF
161 16 : WRITE (unit_nr, '(T2,A4)') 'BSE|'
162 16 : WRITE (unit_nr, '(T2,A4,T7,A7,T19,A23)') 'BSE|', 'ε_...:', 'GW quasiparticle energy'
163 16 : WRITE (unit_nr, '(T2,A4,T7,A7,T19,A15)') 'BSE|', 'δ_...:', 'Kronecker delta'
164 16 : WRITE (unit_nr, '(T2,A4,T7,A3,T19,A21)') 'BSE|', 'α:', 'spin-dependent factor (Singlet/Triplet)'
165 16 : WRITE (unit_nr, '(T2,A4,T7,A6,T18,A34)') 'BSE|', 'v_...:', 'Electron-hole exchange interaction'
166 16 : WRITE (unit_nr, '(T2,A4,T7,A6,T18,A27)') 'BSE|', 'W_...:', 'Screened direct interaction'
167 16 : WRITE (unit_nr, '(T2,A4)') 'BSE|'
168 16 : WRITE (unit_nr, '(T2,A4)') 'BSE|'
169 16 : WRITE (unit_nr, '(T2,A4,T7,A47,A7,A9,F3.1)') 'BSE|', &
170 32 : 'The spin-dependent factor is for the requested ', multiplet, " is α = ", alpha
171 16 : WRITE (unit_nr, '(T2,A4)') 'BSE|'
172 : END IF
173 :
174 32 : CALL timestop(handle)
175 :
176 32 : END SUBROUTINE
177 :
178 : ! **************************************************************************************************
179 : !> \brief ...
180 : !> \param Exc_ens ...
181 : !> \param homo ...
182 : !> \param virtual ...
183 : !> \param flag_TDA ...
184 : !> \param multiplet ...
185 : !> \param info_approximation ...
186 : !> \param mp2_env ...
187 : !> \param unit_nr ...
188 : ! **************************************************************************************************
189 32 : SUBROUTINE print_excitation_energies(Exc_ens, homo, virtual, flag_TDA, multiplet, &
190 : info_approximation, mp2_env, unit_nr)
191 :
192 : REAL(KIND=dp), ALLOCATABLE, DIMENSION(:) :: Exc_ens
193 : INTEGER, INTENT(IN) :: homo, virtual
194 : LOGICAL, INTENT(IN) :: flag_TDA
195 : CHARACTER(LEN=10), INTENT(IN) :: multiplet, info_approximation
196 : TYPE(mp2_type), INTENT(INOUT) :: mp2_env
197 : INTEGER, INTENT(IN) :: unit_nr
198 :
199 : CHARACTER(LEN=*), PARAMETER :: routineN = 'print_excitation_energies'
200 :
201 : INTEGER :: handle, i_exc
202 :
203 32 : CALL timeset(routineN, handle)
204 :
205 32 : IF (unit_nr > 0) THEN
206 16 : IF (flag_TDA) THEN
207 8 : WRITE (unit_nr, '(T2,A4,T7,A56)') 'BSE|', 'Excitation energies from solving the BSE within the TDA:'
208 : ELSE
209 8 : WRITE (unit_nr, '(T2,A4,T7,A57)') 'BSE|', 'Excitation energies from solving the BSE without the TDA:'
210 : END IF
211 16 : WRITE (unit_nr, '(T2,A4)') 'BSE|'
212 16 : WRITE (unit_nr, '(T2,A4,T11,A12,T26,A11,T44,A8,T55,A27)') 'BSE|', &
213 32 : 'Excitation n', "Spin Config", 'TDA/ABBA', 'Excitation energy Ω^n (eV)'
214 : END IF
215 : !prints actual energies values
216 32 : IF (unit_nr > 0) THEN
217 416 : DO i_exc = 1, MIN(homo*virtual, mp2_env%bse%num_print_exc)
218 : WRITE (unit_nr, '(T2,A4,T7,I16,T30,A7,T46,A6,T59,F22.4)') &
219 416 : 'BSE|', i_exc, multiplet, info_approximation, Exc_ens(i_exc)*evolt
220 : END DO
221 : END IF
222 :
223 32 : CALL timestop(handle)
224 :
225 32 : END SUBROUTINE print_excitation_energies
226 :
227 : ! **************************************************************************************************
228 : !> \brief ...
229 : !> \param fm_eigvec_X ...
230 : !> \param homo ...
231 : !> \param virtual ...
232 : !> \param homo_irred ...
233 : !> \param info_approximation ...
234 : !> \param mp2_env ...
235 : !> \param unit_nr ...
236 : !> \param fm_eigvec_Y ...
237 : ! **************************************************************************************************
238 32 : SUBROUTINE print_transition_amplitudes(fm_eigvec_X, homo, virtual, homo_irred, &
239 : info_approximation, mp2_env, unit_nr, fm_eigvec_Y)
240 :
241 : TYPE(cp_fm_type), INTENT(IN) :: fm_eigvec_X
242 : INTEGER, INTENT(IN) :: homo, virtual, homo_irred
243 : CHARACTER(LEN=10), INTENT(IN) :: info_approximation
244 : TYPE(mp2_type), INTENT(INOUT) :: mp2_env
245 : INTEGER, INTENT(IN) :: unit_nr
246 : TYPE(cp_fm_type), INTENT(IN), OPTIONAL :: fm_eigvec_Y
247 :
248 : CHARACTER(LEN=*), PARAMETER :: routineN = 'print_transition_amplitudes'
249 :
250 : INTEGER :: handle, i_exc
251 :
252 32 : CALL timeset(routineN, handle)
253 :
254 32 : IF (unit_nr > 0) THEN
255 16 : WRITE (unit_nr, '(T2,A4)') 'BSE|'
256 : WRITE (unit_nr, '(T2,A4,T7,A61)') &
257 16 : 'BSE|', "Single-particle transitions are built up by (de-)excitations,"
258 : WRITE (unit_nr, '(T2,A4,T7,A18)') &
259 16 : 'BSE|', "which we denote by"
260 16 : WRITE (unit_nr, '(T2,A4)') 'BSE|'
261 : WRITE (unit_nr, '(T2,A4,T20,A2,T30,A40)') &
262 16 : 'BSE|', "=>", "for excitations, i.e. entries of X_ia^n,"
263 : WRITE (unit_nr, '(T2,A4,T20,A2,T30,A42)') &
264 16 : 'BSE|', "<=", "for deexcitations, i.e. entries of Y_ia^n."
265 : WRITE (unit_nr, '(T2,A4)') &
266 16 : 'BSE|'
267 : WRITE (unit_nr, '(T2,A4,T7,A73)') &
268 16 : 'BSE|', "The following single-particle transitions have significant contributions,"
269 : WRITE (unit_nr, '(T2,A4,T7,A16,F5.3,A15,F5.3,A16)') &
270 16 : 'BSE|', "i.e. |X_ia^n| > ", mp2_env%bse%eps_x, " or |Y_ia^n| > ", &
271 32 : mp2_env%bse%eps_x, ", respectively :"
272 :
273 16 : WRITE (unit_nr, '(T2,A4,T15,A27,I5,A13,I5,A3)') 'BSE|', '-- Quick reminder: HOMO i =', &
274 32 : homo_irred, ' and LUMO a =', homo_irred + 1, " --"
275 16 : WRITE (unit_nr, '(T2,A4)') 'BSE|'
276 : WRITE (unit_nr, '(T2,A4,T7,A12,T30,A1,T32,A5,T42,A1,T49,A8,T64,A17)') &
277 16 : "BSE|", "Excitation n", "i", "=>/<=", "a", 'TDA/ABBA', "|X_ia^n|/|Y_ia^n|"
278 : END IF
279 832 : DO i_exc = 1, MIN(homo*virtual, mp2_env%bse%num_print_exc)
280 800 : IF (unit_nr > 0) THEN
281 400 : WRITE (unit_nr, '(T2,A4)') 'BSE|'
282 : END IF
283 : !Iterate through eigenvector and print values above threshold
284 : CALL print_transition_amplitudes_core(fm_eigvec_X, "=>", info_approximation, &
285 : i_exc, virtual, homo, homo_irred, &
286 800 : unit_nr, mp2_env)
287 832 : IF (PRESENT(fm_eigvec_Y)) THEN
288 : CALL print_transition_amplitudes_core(fm_eigvec_Y, "<=", info_approximation, &
289 : i_exc, virtual, homo, homo_irred, &
290 400 : unit_nr, mp2_env)
291 : END IF
292 : END DO
293 :
294 32 : CALL timestop(handle)
295 :
296 32 : END SUBROUTINE print_transition_amplitudes
297 :
298 : ! **************************************************************************************************
299 : !> \brief ...
300 : !> \param Exc_ens ...
301 : !> \param oscill_str ...
302 : !> \param trans_mom_bse ...
303 : !> \param polarizability_residues ...
304 : !> \param homo ...
305 : !> \param virtual ...
306 : !> \param homo_irred ...
307 : !> \param flag_TDA ...
308 : !> \param info_approximation ...
309 : !> \param mp2_env ...
310 : !> \param unit_nr ...
311 : ! **************************************************************************************************
312 32 : SUBROUTINE print_optical_properties(Exc_ens, oscill_str, trans_mom_bse, polarizability_residues, &
313 : homo, virtual, homo_irred, flag_TDA, &
314 : info_approximation, mp2_env, unit_nr)
315 :
316 : REAL(KIND=dp), ALLOCATABLE, DIMENSION(:) :: Exc_ens, oscill_str
317 : REAL(KIND=dp), ALLOCATABLE, DIMENSION(:, :, :) :: trans_mom_bse, polarizability_residues
318 : INTEGER, INTENT(IN) :: homo, virtual, homo_irred
319 : LOGICAL, INTENT(IN) :: flag_TDA
320 : CHARACTER(LEN=10), INTENT(IN) :: info_approximation
321 : TYPE(mp2_type), INTENT(INOUT) :: mp2_env
322 : INTEGER, INTENT(IN) :: unit_nr
323 :
324 : CHARACTER(LEN=*), PARAMETER :: routineN = 'print_optical_properties'
325 :
326 : INTEGER :: handle, i_exc
327 :
328 32 : CALL timeset(routineN, handle)
329 :
330 : ! Discriminate between singlet and triplet, since triplet state can't couple to light
331 : ! and therefore calculations of dipoles etc are not necessary
332 32 : IF (mp2_env%bse%bse_spin_config == 0) THEN
333 32 : IF (unit_nr > 0) THEN
334 16 : WRITE (unit_nr, '(T2,A4)') 'BSE|'
335 : WRITE (unit_nr, '(T2,A4,T7,A60)') &
336 16 : 'BSE|', "Transition moments d_r^n (with r∈(x,y,z), in atomic units)"
337 : WRITE (unit_nr, '(T2,A4,T7,A67)') &
338 16 : 'BSE|', "and oscillator strength f^n of excitation level n are obtained from"
339 16 : WRITE (unit_nr, '(T2,A4)') 'BSE|'
340 16 : IF (flag_TDA) THEN
341 : WRITE (unit_nr, '(T2,A4,T10,A)') &
342 8 : 'BSE|', "d_r^n = sqrt(2) sum_ia < ψ_i | r | ψ_a > X_ia^n"
343 : ELSE
344 : WRITE (unit_nr, '(T2,A4,T10,A)') &
345 8 : 'BSE|', "d_r^n = sum_ia sqrt(2) < ψ_i | r | ψ_a > ( X_ia^n + Y_ia^n )"
346 : END IF
347 16 : WRITE (unit_nr, '(T2,A4)') 'BSE|'
348 : WRITE (unit_nr, '(T2,A4,T14,A)') &
349 16 : 'BSE|', "f^n = 2/3 * Ω^n sum_r∈(x,y,z) ( d_r^n )^2"
350 16 : WRITE (unit_nr, '(T2,A4)') 'BSE|'
351 : WRITE (unit_nr, '(T2,A4,T7,A19)') &
352 16 : 'BSE|', "where we introduced"
353 16 : WRITE (unit_nr, '(T2,A4)') 'BSE|'
354 : WRITE (unit_nr, '(T2,A4,T7,A5,T15,A28)') &
355 16 : 'BSE|', "ψ_i:", "occupied molecular orbitals,"
356 : WRITE (unit_nr, '(T2,A4,T7,A5,T15,A28)') &
357 16 : 'BSE|', "ψ_a:", "empty molecular orbitals and"
358 : WRITE (unit_nr, '(T2,A4,T9,A2,T14,A18)') &
359 16 : 'BSE|', "r:", "position operator."
360 16 : WRITE (unit_nr, '(T2,A4)') 'BSE|'
361 : WRITE (unit_nr, '(T2,A4,T7,A28)') &
362 16 : 'BSE|', "prelim Ref.: Eqs. (23), (24)"
363 : WRITE (unit_nr, '(T2,A4,T7,A71)') &
364 16 : 'BSE|', "in J. Chem. Phys. 152, 044105 (2020); https://doi.org/10.1063/1.5123290"
365 16 : WRITE (unit_nr, '(T2,A4)') 'BSE|'
366 16 : IF (flag_TDA) THEN
367 8 : WRITE (unit_nr, '(T2,A4,T7,A55)') 'BSE|', &
368 16 : 'Optical properties from solving the BSE within the TDA:'
369 : ELSE
370 8 : WRITE (unit_nr, '(T2,A4,T7,A56)') 'BSE|', &
371 16 : 'Optical properties from solving the BSE without the TDA:'
372 : END IF
373 16 : WRITE (unit_nr, '(T2,A4)') 'BSE|'
374 16 : WRITE (unit_nr, '(T2,A4,T8,A12,T22,A8,T38,A5,T48,A5,T58,A5,T64,A17)') 'BSE|', &
375 32 : 'Excitation n', "TDA/ABBA", "d_x^n", "d_y^n", "d_z^n", 'Osc. strength f^n'
376 416 : DO i_exc = 1, MIN(homo*virtual, mp2_env%bse%num_print_exc)
377 : WRITE (unit_nr, '(T2,A4,T8,I12,T24,A6,T35,F8.3,T45,F8.3,T55,F8.3,T65,F16.3)') &
378 400 : 'BSE|', i_exc, info_approximation, trans_mom_bse(1, 1, i_exc), trans_mom_bse(2, 1, i_exc), &
379 816 : trans_mom_bse(3, 1, i_exc), oscill_str(i_exc)
380 : END DO
381 16 : WRITE (unit_nr, '(T2,A4)') 'BSE|'
382 16 : WRITE (unit_nr, '(T2,A4,T7,A)') 'BSE|', &
383 32 : 'Check for Thomas-Reiche-Kuhn sum rule'
384 16 : WRITE (unit_nr, '(T2,A4)') 'BSE|'
385 16 : WRITE (unit_nr, '(T2,A4,T35,A)') 'BSE|', &
386 32 : 'N_e = Σ_n f^n'
387 16 : WRITE (unit_nr, '(T2,A4)') 'BSE|'
388 16 : WRITE (unit_nr, '(T2,A4,T7,A24,T65,I16)') 'BSE|', &
389 32 : 'Number of electrons N_e:', homo_irred*2
390 16 : WRITE (unit_nr, '(T2,A4,T7,A,T66,F16.3)') 'BSE|', &
391 800 : 'Sum over oscillator strengths Σ_n f^n :', SUM(oscill_str)
392 16 : WRITE (unit_nr, '(T2,A4)') 'BSE|'
393 16 : IF (mp2_env%bse%bse_cutoff_occ > 0 .OR. mp2_env%bse%bse_cutoff_empty > 0) THEN
394 : CALL cp_warn(__LOCATION__, &
395 16 : "Accuracy of TRK sum rule might suffer from cutoffs.")
396 : END IF
397 : END IF
398 :
399 : ! Compute and print the absorption spectrum to external file
400 32 : IF (mp2_env%bse%bse_print_spectrum) THEN
401 : CALL compute_absorption_spectrum(oscill_str, polarizability_residues, Exc_ens, &
402 0 : info_approximation, unit_nr, mp2_env)
403 : END IF
404 :
405 : ELSE
406 0 : IF (unit_nr > 0) THEN
407 0 : WRITE (unit_nr, '(T2,A4)') 'BSE|'
408 0 : WRITE (unit_nr, '(T2,A4)') 'BSE|'
409 : CALL cp_warn(__LOCATION__, &
410 : "Requested triplet excitation cannot couple to light. "// &
411 : "Skipping calculation of transition moments, "// &
412 0 : "oscillator strengths, and spectrum.")
413 : END IF
414 : END IF
415 :
416 32 : CALL timestop(handle)
417 :
418 32 : END SUBROUTINE print_optical_properties
419 :
420 : ! **************************************************************************************************
421 : !> \brief ...
422 : !> \param fm_eigvec ...
423 : !> \param direction_excitation ...
424 : !> \param info_approximation ...
425 : !> \param i_exc ...
426 : !> \param virtual ...
427 : !> \param homo ...
428 : !> \param homo_irred ...
429 : !> \param unit_nr ...
430 : !> \param mp2_env ...
431 : ! **************************************************************************************************
432 1200 : SUBROUTINE print_transition_amplitudes_core(fm_eigvec, direction_excitation, info_approximation, &
433 : i_exc, virtual, homo, homo_irred, &
434 : unit_nr, mp2_env)
435 :
436 : TYPE(cp_fm_type), INTENT(IN) :: fm_eigvec
437 : CHARACTER(LEN=2), INTENT(IN) :: direction_excitation
438 : CHARACTER(LEN=10), INTENT(IN) :: info_approximation
439 : INTEGER :: i_exc, virtual, homo, homo_irred
440 : INTEGER, INTENT(IN) :: unit_nr
441 : TYPE(mp2_type), INTENT(INOUT) :: mp2_env
442 :
443 : CHARACTER(LEN=*), PARAMETER :: routineN = 'print_transition_amplitudes_core'
444 :
445 : INTEGER :: handle, k, num_entries
446 1200 : INTEGER, ALLOCATABLE, DIMENSION(:) :: idx_homo, idx_virt
447 1200 : REAL(KIND=dp), ALLOCATABLE, DIMENSION(:) :: eigvec_entries
448 :
449 1200 : CALL timeset(routineN, handle)
450 :
451 : CALL filter_eigvec_contrib(fm_eigvec, idx_homo, idx_virt, eigvec_entries, &
452 1200 : i_exc, virtual, num_entries, mp2_env)
453 : ! direction_excitation can be either => (means excitation; from fm_eigvec_X)
454 : ! or <= (means deexcitation; from fm_eigvec_Y)
455 1200 : IF (unit_nr > 0) THEN
456 1552 : DO k = 1, num_entries
457 : WRITE (unit_nr, '(T2,A4,T14,I5,T26,I5,T35,A2,T38,I5,T51,A6,T65,F16.4)') &
458 952 : "BSE|", i_exc, homo_irred - homo + idx_homo(k), direction_excitation, &
459 2504 : homo_irred + idx_virt(k), info_approximation, ABS(eigvec_entries(k))
460 : END DO
461 : END IF
462 1200 : DEALLOCATE (idx_homo)
463 1200 : DEALLOCATE (idx_virt)
464 1200 : DEALLOCATE (eigvec_entries)
465 1200 : CALL timestop(handle)
466 :
467 1200 : END SUBROUTINE
468 :
469 : ! **************************************************************************************************
470 : !> \brief ...
471 : !> \param exc_descr ...
472 : !> \param ref_point_multipole ...
473 : !> \param unit_nr ...
474 : !> \param mp2_env ...
475 : !> \param qs_env ...
476 : ! **************************************************************************************************
477 4 : SUBROUTINE print_exciton_descriptors(exc_descr, ref_point_multipole, unit_nr, mp2_env, qs_env)
478 :
479 : TYPE(exciton_descr_type), ALLOCATABLE, &
480 : DIMENSION(:) :: exc_descr
481 : REAL(KIND=dp), ALLOCATABLE, DIMENSION(:), &
482 : INTENT(IN) :: ref_point_multipole
483 : INTEGER, INTENT(IN) :: unit_nr
484 : TYPE(mp2_type), INTENT(INOUT) :: mp2_env
485 : TYPE(qs_environment_type), POINTER :: qs_env
486 :
487 : CHARACTER(LEN=*), PARAMETER :: routineN = 'print_exciton_descriptors'
488 :
489 : CHARACTER(LEN=1), DIMENSION(3) :: array_direction_str
490 : INTEGER :: handle, i_dir, i_exc
491 : REAL(KIND=dp) :: d_eh_dir, d_exc_dir, sigma_e_dir, &
492 : sigma_h_dir
493 4 : TYPE(particle_type), DIMENSION(:), POINTER :: particle_set
494 :
495 4 : CALL timeset(routineN, handle)
496 4 : CALL get_qs_env(qs_env, particle_set=particle_set)
497 4 : IF (unit_nr > 0) THEN
498 2 : WRITE (unit_nr, '(T2,A4,T7,A)') 'BSE|', &
499 4 : 'Exciton descriptors for excitation level n are given by'
500 2 : WRITE (unit_nr, '(T2,A4)') 'BSE|'
501 2 : WRITE (unit_nr, '(T2,A4,T15,A)') 'BSE|', &
502 4 : 'd_eh = | <r_h - r_e>_exc |'
503 2 : WRITE (unit_nr, '(T2,A4)') 'BSE|'
504 2 : WRITE (unit_nr, '(T2,A4,T15,A)') 'BSE|', &
505 4 : 'σ_e = sqrt( <r_e^2>_exc - <r_e>_exc^2 )'
506 2 : WRITE (unit_nr, '(T2,A4)') 'BSE|'
507 2 : WRITE (unit_nr, '(T2,A4,T15,A)') 'BSE|', &
508 4 : 'σ_h = sqrt( <r_h^2>_exc - <r_h>_exc^2 )'
509 2 : WRITE (unit_nr, '(T2,A4)') 'BSE|'
510 2 : WRITE (unit_nr, '(T2,A4,T15,A)') 'BSE|', &
511 4 : 'COV_eh = <r_e r_h>_exc - <r_e>_exc <r_h>_exc'
512 2 : WRITE (unit_nr, '(T2,A4)') 'BSE|'
513 2 : WRITE (unit_nr, '(T2,A4,T15,A)') 'BSE|', &
514 4 : 'd_exc = sqrt( | < |r_h - r_e|^2 >_exc )'
515 2 : WRITE (unit_nr, '(T2,A4,T15,A)') 'BSE|', &
516 4 : ' = sqrt( d_eh^2 + σ_e^2 + σ_h^2 - 2 * COV_eh )'
517 2 : WRITE (unit_nr, '(T2,A4)') 'BSE|'
518 2 : WRITE (unit_nr, '(T2,A4,T15,A)') 'BSE|', &
519 4 : 'R_eh = COV_eh / (σ_e * σ_h)'
520 2 : WRITE (unit_nr, '(T2,A4)') 'BSE|'
521 2 : WRITE (unit_nr, '(T2,A4,T7,A)') 'BSE|', &
522 4 : 'where the expectation values <.>_exc are taken with respect to the '
523 2 : WRITE (unit_nr, '(T2,A4,T7,A)') 'BSE|', &
524 4 : 'exciton wavefunction of excitation n:'
525 2 : WRITE (unit_nr, '(T2,A4)') 'BSE|'
526 :
527 2 : IF (exc_descr(1)%flag_TDA) THEN
528 1 : WRITE (unit_nr, '(T2,A4,T20,A)') 'BSE|', &
529 2 : '𝚿_n(r_e,r_h) = Σ_{i,a} X_ia^n ψ_i(r_h) ψ_a(r_e) ,'
530 : ELSE
531 1 : WRITE (unit_nr, '(T2,A4,T20,A)') 'BSE|', &
532 2 : '𝚿_n(r_e,r_h) = Σ_{i,a} X_ia^n ψ_i(r_h) ψ_a(r_e)'
533 1 : WRITE (unit_nr, '(T2,A4,T40,A)') 'BSE|', &
534 2 : '+ Y_ia^n ψ_a(r_h) ψ_i(r_e) ,'
535 : END IF
536 2 : WRITE (unit_nr, '(T2,A4)') 'BSE|'
537 2 : WRITE (unit_nr, '(T2,A4,T7,A)') 'BSE|', &
538 4 : 'i.e.'
539 2 : WRITE (unit_nr, '(T2,A4)') 'BSE|'
540 2 : WRITE (unit_nr, '(T2,A4,T20,A)') 'BSE|', &
541 4 : '< O >_exc = < 𝚿_n | O | 𝚿_n > / < 𝚿_n | 𝚿_n > ,'
542 2 : WRITE (unit_nr, '(T2,A4)') 'BSE|'
543 2 : IF (exc_descr(1)%flag_TDA) THEN
544 1 : WRITE (unit_nr, '(T2,A4,T7,A)') 'BSE|', &
545 2 : 'where c_n = < 𝚿_n | 𝚿_n > = 1 within TDA.'
546 : ELSE
547 1 : WRITE (unit_nr, '(T2,A4,T7,A)') 'BSE|', &
548 2 : 'where c_n = < 𝚿_n | 𝚿_n > deviates from 1 without TDA.'
549 : END IF
550 2 : WRITE (unit_nr, '(T2,A4)') 'BSE|'
551 2 : WRITE (unit_nr, '(T2,A4)') 'BSE|'
552 2 : WRITE (unit_nr, '(T2,A4,T7,A)') 'BSE|', &
553 4 : 'Here, we introduced'
554 2 : WRITE (unit_nr, '(T2,A4)') 'BSE|'
555 : WRITE (unit_nr, '(T2,A4,T7,A5,T15,A)') &
556 2 : 'BSE|', "ψ_i:", "occupied molecular orbitals,"
557 : WRITE (unit_nr, '(T2,A4,T7,A5,T15,A)') &
558 2 : 'BSE|', "ψ_a:", "empty molecular orbitals and"
559 : WRITE (unit_nr, '(T2,A4,T9,A2,T14,A)') &
560 2 : 'BSE|', "r:", "position operator."
561 2 : WRITE (unit_nr, '(T2,A4)') 'BSE|'
562 2 : WRITE (unit_nr, '(T2,A4,T7,A)') 'BSE|', &
563 4 : 'prelim Ref.: Eqs. (15)-(22)'
564 2 : WRITE (unit_nr, '(T2,A4,T7,A,A)') 'BSE|', &
565 2 : 'JCTC 2018, 14, 710-725; ', &
566 4 : 'http://doi.org/10.1021/acs.jctc.7b01145'
567 2 : WRITE (unit_nr, '(T2,A4)') 'BSE|'
568 2 : WRITE (unit_nr, '(T2,A4)') 'BSE|'
569 2 : IF (exc_descr(1)%flag_TDA) THEN
570 1 : WRITE (unit_nr, '(T2,A4,T7,A)') 'BSE|', &
571 2 : 'Exciton descriptors from solving the BSE within the TDA:'
572 : ELSE
573 1 : WRITE (unit_nr, '(T2,A4,T7,A)') 'BSE|', &
574 2 : 'Exciton descriptors from solving the BSE without the TDA:'
575 : END IF
576 2 : WRITE (unit_nr, '(T2,A4)') 'BSE|'
577 2 : WRITE (unit_nr, '(T2,A4,T10,A1,6X,A3,1X,4X,A10,5X,A10,5X,A10,3X,A11,8X,A4)') 'BSE|', &
578 4 : 'n', 'c_n', 'd_eh [Å]', 'σ_e [Å]', 'σ_h [Å]', 'd_exc [Å]', 'R_eh'
579 52 : DO i_exc = 1, mp2_env%bse%num_print_exc_descr
580 : WRITE (unit_nr, '(T2,A4,T7,I4,4X,F5.3,1X,5(2X,F10.4))') &
581 50 : 'BSE|', i_exc, exc_descr(i_exc)%norm_XpY, &
582 50 : exc_descr(i_exc)%diff_r_abs*angstrom, &
583 50 : exc_descr(i_exc)%sigma_e*angstrom, exc_descr(i_exc)%sigma_h*angstrom, &
584 102 : exc_descr(i_exc)%diff_r_sqr*angstrom, exc_descr(i_exc)%corr_e_h*angstrom
585 : END DO
586 2 : WRITE (unit_nr, '(T2,A4)') 'BSE|'
587 : ! For debug runs, print first d_exc separately to allow the regtests to read in
588 2 : IF (mp2_env%bse%bse_debug_print) THEN
589 2 : IF (exc_descr(1)%flag_TDA) THEN
590 1 : WRITE (unit_nr, '(T2,A10,T13,A,T65,F16.4)') 'BSE|DEBUG|', &
591 2 : 'Exciton descriptor d_exc with TDA for n=1 is', exc_descr(1)%diff_r_sqr*angstrom
592 : ELSE
593 1 : WRITE (unit_nr, '(T2,A10,T13,A,T65,F16.4)') 'BSE|DEBUG|', &
594 2 : 'Exciton descriptor d_exc without TDA for n=1 is', exc_descr(1)%diff_r_sqr*angstrom
595 : END IF
596 2 : WRITE (unit_nr, '(T2,A4)') 'BSE|'
597 : END IF
598 2 : WRITE (unit_nr, '(T2,A4)') 'BSE|'
599 : ! Print exciton descriptor resolved per direction
600 2 : IF (mp2_env%bse%print_directional_exc_descr) THEN
601 0 : WRITE (unit_nr, '(T2,A4,T7,A)') 'BSE|', &
602 0 : 'We can restrict the exciton descriptors to a specific direction,'
603 0 : WRITE (unit_nr, '(T2,A4,T7,A)') 'BSE|', &
604 0 : 'e.g. the x-components are:'
605 0 : WRITE (unit_nr, '(T2,A4)') 'BSE|'
606 0 : WRITE (unit_nr, '(T2,A4,T15,A)') 'BSE|', &
607 0 : 'd_eh^x = | <x_h - x_e>_exc |'
608 0 : WRITE (unit_nr, '(T2,A4)') 'BSE|'
609 0 : WRITE (unit_nr, '(T2,A4,T15,A)') 'BSE|', &
610 0 : 'σ_e^x = sqrt( <x_e^2>_exc - <x_e>_exc^2 )'
611 0 : WRITE (unit_nr, '(T2,A4)') 'BSE|'
612 0 : WRITE (unit_nr, '(T2,A4,T15,A)') 'BSE|', &
613 0 : 'σ_h^x = sqrt( <x_h^2>_exc - <x_h>_exc^2 )'
614 0 : WRITE (unit_nr, '(T2,A4)') 'BSE|'
615 0 : WRITE (unit_nr, '(T2,A4,T15,A)') 'BSE|', &
616 0 : 'COV_eh^x = <x_e x_h>_exc - <x_e>_exc <x_h>_exc'
617 0 : WRITE (unit_nr, '(T2,A4)') 'BSE|'
618 0 : WRITE (unit_nr, '(T2,A4,T15,A)') 'BSE|', &
619 0 : 'd_exc^x = sqrt( | < |x_h - x_e|^2 >_exc )'
620 0 : WRITE (unit_nr, '(T2,A4,T15,A)') 'BSE|', &
621 0 : ' = sqrt( (d_eh^x)^2 + (σ_e^x)^2'
622 0 : WRITE (unit_nr, '(T2,A4,T15,A)') 'BSE|', &
623 0 : ' + (σ_h^x)^2 - 2 * (COV_eh^x) )'
624 0 : WRITE (unit_nr, '(T2,A4)') 'BSE|'
625 0 : WRITE (unit_nr, '(T2,A4)') 'BSE|'
626 0 : IF (exc_descr(1)%flag_TDA) THEN
627 0 : WRITE (unit_nr, '(T2,A4,T7,A)') 'BSE|', &
628 0 : 'Exciton descriptors per direction from solving the BSE within the TDA:'
629 : ELSE
630 0 : WRITE (unit_nr, '(T2,A4,T7,A)') 'BSE|', &
631 0 : 'Exciton descriptors per direction from solving the BSE without the TDA:'
632 : END IF
633 0 : WRITE (unit_nr, '(T2,A4)') 'BSE|'
634 0 : WRITE (unit_nr, '(T2,A4,T12,A1,2X,A9,5X,A12,5X,A12,5X,A12,3X,A13)') 'BSE|', &
635 0 : 'n', 'r = x/y/z', 'd_eh^r [Å]', 'σ_e^r [Å]', 'σ_h^r [Å]', 'd_exc^r [Å]'
636 0 : DO i_exc = 1, mp2_env%bse%num_print_exc_descr
637 0 : DO i_dir = 1, 3
638 0 : array_direction_str = (/"x", "y", "z"/)
639 0 : d_eh_dir = ABS(exc_descr(i_exc)%r_h(i_dir) - exc_descr(i_exc)%r_e(i_dir))
640 0 : sigma_e_dir = SQRT(exc_descr(i_exc)%r_e_sq(i_dir) - exc_descr(i_exc)%r_e(i_dir)**2)
641 0 : sigma_h_dir = SQRT(exc_descr(i_exc)%r_h_sq(i_dir) - exc_descr(i_exc)%r_h(i_dir)**2)
642 : d_exc_dir = SQRT(d_eh_dir**2 + sigma_e_dir**2 + sigma_h_dir**2 &
643 0 : - 2*exc_descr(i_exc)%cov_e_h(i_dir))
644 : WRITE (unit_nr, '(T2,A4,T9,I4,10X,A1,1X,4(4X,F10.4))') &
645 0 : 'BSE|', i_exc, array_direction_str(i_dir), &
646 0 : d_eh_dir*angstrom, &
647 0 : sigma_e_dir*angstrom, sigma_h_dir*angstrom, &
648 0 : d_exc_dir*angstrom
649 : END DO
650 0 : WRITE (unit_nr, '(T2,A4)') 'BSE|'
651 : END DO
652 0 : WRITE (unit_nr, '(T2,A4)') 'BSE|'
653 : END IF
654 : ! Print the reference atomic geometry for the exciton descriptors
655 2 : WRITE (unit_nr, '(T2,A4,T7,A)') 'BSE|', &
656 4 : 'With the center of charge as reference point r_0,'
657 2 : WRITE (unit_nr, '(T2,A4,T15,A7,F10.4,A2,F10.4,A2,F10.4,A1)') 'BSE|', &
658 2 : 'r_0 = (', ref_point_multipole(1)*angstrom, ', ', ref_point_multipole(2)*angstrom, ', ', &
659 4 : ref_point_multipole(3)*angstrom, ')'
660 2 : WRITE (unit_nr, '(T2,A4,T7,A)') 'BSE|', &
661 4 : 'we further obtain r_e and r_h from solving the BSE within the TDA'
662 2 : WRITE (unit_nr, '(T2,A4)') 'BSE|'
663 2 : WRITE (unit_nr, '(T2,A4,T8,A12,1X,13X,A9,13X,A9,13X,A9)') 'BSE|', &
664 4 : 'Excitation n', 'x_e [Å]', 'y_e [Å]', 'z_e [Å]'
665 52 : DO i_exc = 1, mp2_env%bse%num_print_exc_descr
666 : WRITE (unit_nr, '(T2,A4,T8,I12,1X,3(5X,F15.4))') &
667 50 : 'BSE|', i_exc, &
668 252 : exc_descr(i_exc)%r_e_shift(:)*angstrom
669 : END DO
670 2 : WRITE (unit_nr, '(T2,A4)') 'BSE|'
671 2 : WRITE (unit_nr, '(T2,A4,T8,A12,1X,13X,A9,13X,A9,13X,A9)') 'BSE|', &
672 4 : 'Excitation n', 'x_h [Å]', 'y_h [Å]', 'z_h [Å]'
673 52 : DO i_exc = 1, mp2_env%bse%num_print_exc_descr
674 : WRITE (unit_nr, '(T2,A4,T8,I12,1X,3(5X,F15.4))') &
675 50 : 'BSE|', i_exc, &
676 252 : exc_descr(i_exc)%r_h_shift(:)*angstrom
677 : END DO
678 2 : WRITE (unit_nr, '(T2,A4)') 'BSE|'
679 2 : WRITE (unit_nr, '(T2,A4,T7,A)') 'BSE|', &
680 4 : 'The reference atomic geometry for these values is given by'
681 : END IF
682 4 : CALL write_qs_particle_coordinates_bse(particle_set, unit_nr)
683 4 : IF (unit_nr > 0) THEN
684 2 : WRITE (unit_nr, '(T2,A4)') 'BSE|'
685 : END IF
686 4 : CALL timestop(handle)
687 :
688 4 : END SUBROUTINE print_exciton_descriptors
689 :
690 : ! **************************************************************************************************
691 : !> \brief Debug function to write elements of a full matrix to file, if they are larger than a given threshold
692 : !> \param fm ...
693 : !> \param thresh ...
694 : !> \param header ...
695 : !> \param unit_nr ...
696 : !> \param abs_vals ...
697 : ! **************************************************************************************************
698 0 : SUBROUTINE fm_write_thresh(fm, thresh, header, unit_nr, abs_vals)
699 :
700 : TYPE(cp_fm_type), INTENT(IN) :: fm
701 : REAL(KIND=dp), INTENT(IN) :: thresh
702 : CHARACTER(LEN=*), INTENT(IN) :: header
703 : INTEGER, INTENT(IN) :: unit_nr
704 : LOGICAL, OPTIONAL :: abs_vals
705 :
706 : CHARACTER(LEN=*), PARAMETER :: my_footer = " | ENDING WRITING OF MATRIX", &
707 : routineN = 'fm_write_thresh'
708 :
709 : INTEGER :: handle, i, j, ncol_local, nrow_local
710 0 : INTEGER, DIMENSION(:), POINTER :: col_indices, row_indices
711 : LOGICAL :: my_abs_vals
712 :
713 0 : CALL timeset(routineN, handle)
714 :
715 0 : IF (PRESENT(abs_vals)) THEN
716 0 : my_abs_vals = abs_vals
717 : ELSE
718 : my_abs_vals = .FALSE.
719 : END IF
720 :
721 : CALL cp_fm_get_info(matrix=fm, &
722 : nrow_local=nrow_local, &
723 : ncol_local=ncol_local, &
724 : row_indices=row_indices, &
725 0 : col_indices=col_indices)
726 :
727 0 : IF (unit_nr > 0) THEN
728 0 : WRITE (unit_nr, *) header
729 : END IF
730 0 : IF (my_abs_vals) THEN
731 0 : DO i = 1, nrow_local
732 0 : DO j = 1, ncol_local
733 0 : IF (ABS(fm%local_data(i, j)) > thresh) THEN
734 0 : WRITE (unit_nr, "(A7,T10,I5,T20,I5,T30,F13.5)") header, row_indices(i), col_indices(j), &
735 0 : ABS(fm%local_data(i, j))
736 : END IF
737 : END DO
738 : END DO
739 : ELSE
740 0 : DO i = 1, nrow_local
741 0 : DO j = 1, ncol_local
742 0 : IF (ABS(fm%local_data(i, j)) > thresh) THEN
743 0 : WRITE (unit_nr, "(A7,T10,I5,T20,I5,T30,F13.5)") header, row_indices(i), col_indices(j), &
744 0 : fm%local_data(i, j)
745 : END IF
746 : END DO
747 : END DO
748 : END IF
749 0 : CALL fm%matrix_struct%para_env%sync()
750 0 : IF (unit_nr > 0) THEN
751 0 : WRITE (unit_nr, *) my_footer
752 : END IF
753 :
754 0 : CALL timestop(handle)
755 :
756 0 : END SUBROUTINE
757 :
758 : ! **************************************************************************************************
759 : !> \brief Write the atomic coordinates to the output unit.
760 : !> \param particle_set ...
761 : !> \note Adapted from particle_methods.F [MG]
762 : !> \param unit_nr ...
763 : ! **************************************************************************************************
764 4 : SUBROUTINE write_qs_particle_coordinates_bse(particle_set, unit_nr)
765 :
766 : TYPE(particle_type), DIMENSION(:), POINTER :: particle_set
767 : INTEGER, INTENT(IN) :: unit_nr
768 :
769 : CHARACTER(len=*), PARAMETER :: routineN = 'write_qs_particle_coordinates_bse'
770 :
771 : CHARACTER(LEN=2) :: element_symbol
772 : INTEGER :: handle, iatom, natom
773 :
774 4 : CALL timeset(routineN, handle)
775 :
776 4 : IF (unit_nr > 0) THEN
777 2 : WRITE (unit_nr, '(T2,A4)') 'BSE|'
778 2 : WRITE (unit_nr, '(T2,A4,T13,A7,16X,A7,15X,A7,15X,A7)') 'BSE|', &
779 4 : 'Element', 'x [Å]', 'y [Å]', 'z [Å]'
780 2 : natom = SIZE(particle_set)
781 8 : DO iatom = 1, natom
782 : CALL get_atomic_kind(atomic_kind=particle_set(iatom)%atomic_kind, &
783 6 : element_symbol=element_symbol)
784 : WRITE (unit_nr, '(T2,A4,T8,A12,1X,3(5X,F15.4))') &
785 26 : 'BSE|', element_symbol, particle_set(iatom)%r(1:3)*angstrom
786 : END DO
787 : END IF
788 :
789 4 : CALL timestop(handle)
790 :
791 4 : END SUBROUTINE write_qs_particle_coordinates_bse
792 :
793 : END MODULE bse_print
|
